fcompose.pas

siMail, siMail, siMail, siMail

end;

procedure TfrmCompose.actInsertComputerInfoExecute(Sender: TObject);
var sl: Integer;
begin

  sl := SendMessage(txtMessage.Handle, EM_LINEFROMCHAR, txtMessage.SelStart, 0);
  with txtMessage.Lines do begin
    //gettext: computer information
    Insert(sl, _('======================== System info ========================'));
    Inc(sl);
    //gettext: computer information
    Insert(sl, Format(_('si.Mail version: %s'), [frmMain.GetFileVersionAsString(Application.ExeName)]));
    Inc(sl);
    Insert(sl, '');
    Inc(sl);
    //gettext: computer information
    Insert(sl, '=> ' + _('Operating system specific information'));
    Inc(sl);
    //gettext: computer information
    Insert(sl, Format(_('Platform version: %s %s'), [frmMain.compInfo.OS.ProductName, frmMain.compInfo.OS.VersionCSDString]));
    Inc(sl);
    //gettext: computer information
    Insert(sl, Format(_('Windows folder: %s'), [frmMain.compInfo.Folders.Windows]));
    Inc(sl);
    //gettext: computer information
    Insert(sl, Format(_('Windows system folder: %s'), [frmMain.compInfo.Folders.System]));
    Inc(sl);
    Insert(sl, '');
    Inc(sl);
    //gettext: computer information
    Insert(sl, '=> ' + _('CPU information'));
    Inc(sl);
    //gettext: computer information
    Insert(sl, Format(_('Number of processors: %d'), [frmMain.compInfo.CPU.ProcessorCount]));
    Inc(sl);
    //gettext: computer information
    Insert(sl, Format(_('Processor type: %s'), [frmMain.compInfo.CPU.Name]));
    Inc(sl);
    //gettext: computer information
    Insert(sl, Format(_('Processor frequency: %dMHz'), [frmMain.compInfo.CPU.RawFreq]));
    Inc(sl);
    Insert(sl, '');
    Inc(sl);
    //gettext: computer information
    Insert(sl, '=> ' + _('Other information'));
    Inc(sl);
    //gettext: computer information
    Insert(sl, Format(_('Computer uptime: %s'), [frmMain.compInfo.Misc.TimeRunningAsString]));
    Inc(sl);
    //gettext: computer information
    Insert(sl, Format(_('Physical memory: %s'), [frmMain.sizeToString(frmMain.compInfo.Memory.TotalPhysicalMemory)]));
    Inc(sl);
    //gettext: computer information
    Insert(sl, Format(_('Free physical memory: %s'), [frmMain.sizeToString(frmMain.compInfo.Memory.FreePhysicalMemory)]));
    Inc(sl);
    //gettext: computer information
    Insert(sl, _('================= End of system information =================='));
  end;
end;

procedure TfrmCompose.actViewToolbarExecute(Sender: TObject);
begin
  tb1.Visible := actViewToolbar.Checked;
  frmMailbox.Profile.Config.WriteBool(Self.Name, 'viewToolbar', tb1.Visible);
end;

procedure TfrmCompose.actViewStatusbarExecute(Sender: TObject);
begin
  sb.Visible := actViewStatusbar.Checked;
  frmMailbox.Profile.Config.WriteBool(Self.Name, 'viewStatusbar', sb.Visible);
end;

procedure TfrmCompose.msgViewDocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var i: Integer;
var lst: TStringList;
begin
  lst := TStringList.Create;
  try
    lst.Text := (msgView.Document as IHTMLDocument2).Body.innerText;
   //quote it
    for i := 0 to lst.Count - 1 do
      txtMessage.Lines.Add('>' + lst.Strings[i]);
  finally
    FreeAndNil(lst);
    DeleteFile(URL);
    selectCorrectSignature;
    txtMessage.SelStart := 0;
    txtMessage.SelLength := 0;
  end;

end;

procedure TfrmCompose.processMimePart(mimePart: TMimePart);
var i: Integer;
var guid: TGUID;
var fn: String;
var fs: TFileStream;
var lst: TStringList;
begin
  mimePart.DecodePart;

  if UpperCase(mimePart.Secondary) = 'HTML' then begin
    CreateGUID(guid);
    fn := df.Temp + tmpFilePrefix + GUIDToString(guid) + '.html';
    fs := TFileStream.Create(fn, fmCreate);
    try
      frmMailView.WriteHtml(fs, frmMailView.ReadStringFromStream(
        mimePart.DecodedLines, mimePart.DecodedLines.Size))
    finally
      fs.Free;
    end;

    msgView.Navigate('file:///' + EncodeURL(fn));
  end
  else begin
    lst := TStringList.Create;
    try
      lst.LoadFromStream(mimePart.DecodedLines);
      for i := 0 to lst.Count - 1 do
        txtMessage.Lines.Add('>' + lst.Strings[i]);
      txtMessage.SelStart := 0;
      txtMessage.SelLength := 0;
    finally
      FreeAndNil(lst);
      selectCorrectSignature;
    end;
  end;
end;

function TfrmCompose.getNumber(str: String; var len: Integer): Integer;
var tmpStr: String;
var i: Integer;
begin
  Result := 0;
  len := 0;
  if LeftStr(str, 1) = '[' then begin
    tmpStr := '';
    for i := 2 to Length(str) do begin
      case str[i] of
      '0'..'9': tmpStr := tmpStr + str[i];
      ']': begin
        try
          Result := StrToInt(tmpStr);
          len := i;
          if ((Length(str) - len) > 0) and (str[len + 1] = ':') then
            Inc(len);
          Break;
        except
          Result := -1; //failed
          Break;
        end;
      end
      else begin
        Result := -1; //failed
        Break;
      end
      end;
    end;
  end;
end;

function TfrmCompose.reformatReplies(Value: String): String;
var cnt: Byte;
var re1, re2, re3, re4: String;
var len1, len2, len3, len4: Integer;
var v1, v2, v3, v4: Boolean;
var lValue: String;
var i, d: Integer;
begin
  if not (frmMailbox.Profile.Config.ReadBool('frmCompose', 'countReplies', True)) then begin
    Result := Value;
    Exit;
  end;

  cnt := 1;
  Value := Trim(Value);
  //prepare
  re1 := LowerCase('Re:');
  re2 := LowerCase(_('Re:'));
  re3 := LowerCase('Re');
  re4 := LowerCase(_('Re'));
  len1 := Length(re1);
  len2 := Length(re2);
  len3 := Length(re3);
  len4 := Length(re4);
  lValue := LowerCase(Value);

  //try to format it
  while True do begin
    v1 := (LeftStr(lValue, len1) = re1);
    v2 := (LeftStr(lValue, len2) = re2);
    v3 := (LeftStr(lValue, len3) = re3);
    v4 := (LeftStr(lValue, len4) = re4);

    if v1 then
      lValue := TrimLeft(RightStr(lValue, Length(lValue) - len1))
    else if v2 then
      lValue := TrimLeft(RightStr(lValue, Length(lValue) - len2))
    else if v3 then
      lValue := TrimLeft(RightStr(lValue, Length(lValue) - len3))
    else if v4 then
      lValue := TrimLeft(RightStr(lValue, Length(lValue) - len4))
    else
      Break;

    if v1 or v2 or v3 or v4 then begin
      i := getNumber(lValue, d); //it is correct !!
      if i = 0 then begin
        Inc(cnt);
      end
      else if i > 0 then begin
        Inc(cnt, i);
        lValue := TrimLeft(RightStr(lValue, Length(lValue) - d));
      end
      else
        Break;
    end;
  end;

  if cnt = 1 then
    Result := _('Re:') + ' ' + Value
  else
    Result := _('Re') + '[' + IntToStr(cnt) + ']: ' + Trim(RightStr(Value, Length(lValue)));

end;

function TfrmCompose.reformatForwards(Value: String): String;
var cnt: Byte;
var re1, re2, re3, re4, re5, re6: String;
var len1, len2, len3, len4, len5, len6: Integer;
var v1, v2, v3, v4, v5, v6: Boolean;
var lValue: String;
var i, d: Integer;
begin
  if not (frmMailbox.Profile.Config.ReadBool('frmCompose', 'countForwards', True)) then begin
    Result := Value;
    Exit;
  end;

  cnt := 1;
  Value := Trim(Value);
  //prepare
  re1 := LowerCase('Fw:');
  re2 := LowerCase(_('Fw:'));
  re3 := LowerCase('Fw:');
  re4 := LowerCase(_('Fw:'));
  re5 := LowerCase('Fwd:');
  re6 := LowerCase('Fwd');
  len1 := Length(re1);
  len2 := Length(re2);
  len3 := Length(re3);
  len4 := Length(re4);
  len5 := Length(re5);
  len6 := Length(re6);
  lValue := LowerCase(Value);

  //try to format it
  while True do begin
    v1 := (LeftStr(lValue, len1) = re1);
    v2 := (LeftStr(lValue, len2) = re2);
    v3 := (LeftStr(lValue, len3) = re3);
    v4 := (LeftStr(lValue, len4) = re4);
    v5 := (LeftStr(lValue, len4) = re5);
    v6 := (LeftStr(lValue, len4) = re6);

    if v1 then
      lValue := TrimLeft(RightStr(lValue, Length(lValue) - len1))
    else if v2 then
      lValue := TrimLeft(RightStr(lValue, Length(lValue) - len2))
    else if v3 then
      lValue := TrimLeft(RightStr(lValue, Length(lValue) - len3))
    else if v4 then
      lValue := TrimLeft(RightStr(lValue, Length(lValue) - len4))
    else if v5 then
      lValue := TrimLeft(RightStr(lValue, Length(lValue) - len5))
    else if v6 then
      lValue := TrimLeft(RightStr(lValue, Length(lValue) - len6))
    else
      Break;

    if v1 or v2 or v3 or v4 or v5 or v6 then begin
      i := getNumber(lValue, d); //it is correct !!
      if i = 0 then begin
        Inc(cnt);
      end
      else if i > 0 then begin
        Inc(cnt, i);
        lValue := TrimLeft(RightStr(lValue, Length(lValue) - d));
      end
      else
        Break;
    end;
  end;

  if cnt = 1 then
    Result := _('Fw:') + ' ' + Value
  else
    Result := _('Fw') + '[' + IntToStr(cnt) + ']: ' + Trim(RightStr(Value, Length(lValue)));

end;

(*function TfrmCompose.PrepareEmail(Value: string): String;
var theMatch:IMatch;
var theRegex:IRegex;
var tmpStr:String;
var i,offset,offsetPrev:Integer;
const expr = '(?imxs)(<{2}.*?>{2}) | ([_A-Z\d\-\.]+@[_A-Z\d\-\.]+((,?)|(;?))?)';

begin
    Result:='';
    Value:=StringReplace(Value,#13#10,' ',[rfReplaceAll, rfIgnoreCase]);
    theRegex:=RegexCreate(expr, [], 'C');
    offset:=0;
    offsetPrev:=0;
    theMatch:=theRegex.Match(Value, offset, [rmoNotEmpty]);

    //if we have match then we put everything from last offset to
    //new offset into "" and match to <>
    while theMatch.Matched do begin
        offset  := Max(theMatch.Index + theMatch.Length + 1, offset + 1);
        if offsetPrev + 1 < theMatch.Index then begin
            tmpStr:=Copy(Value,offsetPrev + 1,theMatch.Index - offsetPrev - 1);
            tmpStr:=Trim(tmpStr);
        end
        else tmpStr:='';

        //remove , , ; , <, ", ', ' ' from left and right of Friendly Name
        i:=Length(tmpStr);
        if i > 0 then begin
            while (tmpStr[i] = ',') or (tmpStr[i] = ';') or (tmpStr[i] = '<') or
                  (tmpStr[i] = '''') or (tmpStr[i] = ' ') or (tmpStr[i] = '"') do Dec(i);
            if i <> Length(tmpStr) then tmpStr:=Copy(tmpStr,1,i);
            i:=1;
            while (tmpStr[i] = ',') or (tmpStr[i] = ';') or (tmpStr[i] = '<') or
                  (tmpStr[i] = '''') or (tmpStr[i] = ' ') or (tmpStr[i] = '"') do Inc(i);
            if i > 1 then tmpStr:=Copy(tmpStr,i,Length(tmpStr) - i + 1 );
        end;

        //"remove" , , ; ,>, ", ', ' ' from left string we are searching in
        i:=offset;
        while (Value[i] = ',') or (Value[i] = ';') or (Value[i] = '>') or
              (Value[i] = '''') or (Value[i] = ' ') or (Value[i] = '"') do Inc(i);
        offset:=i;

        //do we have friendly name ?
        if not(tmpStr = '') then begin
            Result:=Result + '"' + tmpStr + '" ';
        end;
        //copy e-mail
        if theMatch.Length > 2 then begin
            //if there is << then we have group
            if (theMatch.Value[1] = '<') and (theMatch.Value[2] = '<') then
                Result:=Result + Trim(theMatch.Value) + ','
            else Result:=Result + '<' + Trim(theMatch.Value) + '>,';
        end;
        offsetPrev:=offset;
        theMatch:=theRegex.Match(Value, offset-1, [rmoNotEmpty]);
    end;

    //remove final ,
    if Length(Result) > 0 then SetLength(Result,Length(Result) - 1);

end;
*)
procedure TfrmCompose.loadEmbededAttachments(fm: TFlatMsg);
var i: Integer;
var at: PVirtualNode;
begin
  for i := 0 to fm.AttachmentPartCount - 1 do begin
    at := lstAttachments.AddChild(nil);
    with PTreeAttach(lstAttachments.GetNodeData(at))^ do begin
      mime := fm.Attachments[i];
      iconID := frmMain.FindFileIcon(ilFiles, fm.Attachments[i].FileName, False);
      size := mime.DecodedLines.Size;
    end;
  end;
  updateAttachmentsSize;
end;

procedure TfrmCompose.actFileSaveToFileExecute(Sender: TObject);
var strm: TfileStream;
begin
  diSave.Filter := _('E-mail Files (*.eml)|*.eml');
  diSave.DefaultExt := '.eml';

  diSave.FileName := '';
  if not diSave.Execute then
    Exit;

  strm := TFileStream.Create(diSave.FileName, fmCreate, fmShareExclusive);
  try
    buildMessage(False, strm);
  finally
    FreeAndNil(strm);
  end;
end;

procedure TfrmCompose.actFileOpenFromFi