fcompose.pas

siMail, siMail, siMail, siMail

end;

procedure TfrmCompose.addNewNodeToAddresses;
var Node: PVirtualNode;
var nd: PTreeAddresses;
begin
  Node := lstAddresses.GetLast(nil);
  //sometimes happen that there is no node in lstAddresses so we have to add it
  if Node = nil then begin
    addAddress(tatTo, '');
    Node := lstAddresses.GetLast(nil);
    if Node <> nil then
      lstAddresses.EditNode(Node ,1);
    Exit;
  end;

  nd := PTreeAddresses(lstAddresses.GetNodeData(Node));
  if nd.mail <> '' then begin
    with PTreeAddresses(lstAddresses.GetNodeData(lstAddresses.AddChild(nil)))^ do
    begin
      type_ := nd.type_;
      mail := '';
    end;
    lstAddresses.FocusedNode := Node;
  end;
end;

procedure TfrmCompose.cmboxSignatureChange(Sender: TObject);
var tmpStr: String;
begin
  with frmMailbox.Profile.Accounts[FAccount] do begin
    if cmboxSignature.ItemIndex = 0 then
      LastSignature := ''
    else begin
      LastSignature := cmboxSignature.Items[cmboxSignature.ItemIndex];
    end;
  end;

  tmpStr := frmMailbox.Profile.Signatures.Find(
    cmboxSignature.Items.Strings[cmboxSignature.ItemIndex]);
  if tmpStr <> '' then begin
    if Pos(#13#10, tmpStr) = 0 then
      tmpStr := StringReplace(tmpStr, #10, #13#10, [rfReplaceAll]);

    txtMessage.Lines.Add(#13#10#13#10 + tmpStr);
  end;
  askForSave := True;
end;

procedure TfrmCompose.actTBCloseExecute(Sender: TObject);
begin
  actFileClose.Execute;
end;

procedure TfrmCompose.actOptionsRequestReadRcptExecute(Sender: TObject);
begin
  actOptionsRequestReadRcpt.Checked := not actOptionsRequestReadRcpt.Checked;
  actTBReadReceipt.Checked := not actTBReadReceipt.Checked;
  askForSave := True;
end;

procedure TfrmCompose.actTBReadReceiptExecute(Sender: TObject);
begin
  actOptionsRequestReadRcpt.Execute;
end;

procedure TfrmCompose.buildEmailListUTF8(Value: string; lst: TStringList);
var i: Integer;
begin

  buildEmailList(Value, lst);

  for i := 0 to lst.Count - 1 do
    lst.Strings[i] := AnsiToUTF8(lst.Strings[i]);
end;

procedure TfrmCompose.buildEmailList(Value: string; lst: TStrings; justEmail: Boolean);
var theRegex: IRegex;
var strCol: IStringCollection;
var eml: String;
var i: Integer;
const expr = '(?imxs)(<{2}.*?>{2}) | ' + //this matches mail group
    '(".*?"\s*<[_A-Z\d\-\.]+@[_A-Z\d\-\.]+>) | '+ //this matches email with frendly name
    '([_A-Z\d\-\.]+@[_A-Z\d\-\.]+)'; //this matches email
begin
  theRegex := RegexCreate(expr, [], 'C');
  strCol := theRegex.Split(Value);

  for i := 0 to strCol.Count - 1 do begin
    //skip if string is empty
    if strCol.Strings[i] <> '' then begin
      if Pos('@', strCol.Strings[i]) <> 0 then begin
        eml := SeparateRight(strCol.Strings[i], '<');
        eml := SeparateLeft(eml, '>');
        frmMailbox.AutoCompleteList.Add(eml);
        if actOptionsAutoComplete.Checked then
          txtMail.Items.Add(eml);
        if justEmail then
          lst.Add(eml)
        else
          lst.Add(strCol.Strings[i]);
      end
      else if Pos('<<', strCol.Strings[i]) = 1 then begin
        lst.Add('<<' + TrimPunctuation(strCol.Strings[i]) + '>>');
      end;
    end;
  end;
end;

function TfrmCompose.lTrimPunctuation(Value: String): String;
var i: Integer;
begin
  //remove , , ; , <, >, ", ', ' ' from left
  Result := '';
  if Length(Value) = 0 then
    exit;

  i := 1;
  while (Value[i] = ',') or (Value[i] = ';') or (Value[i] = '<') or
    (Value[i] = '''') or
    (Value[i] = ' ') or (Value[i] = '"') or (Value[i] = '>') do Inc(i);

  Result := Copy(Value, i, Length(Value) - i + 1);
end;

function TfrmCompose.rTrimPunctuation(Value: String): String;
var i: Integer;
begin
  //remove , , ; , <, >, ", ', ' ' from right
  i := Length(Value);
  if i = 0 then
    exit;

  while (Value[i] = ',') or (Value[i] = ';') or (Value[i] = '<') or
    (Value[i] = '''') or
    (Value[i] = ' ') or (Value[i] = '"') or (Value[i] = '>') do Dec(i);

  Result := Copy(Value, 1, i);
end;

function TfrmCompose.TrimPunctuation(Value: String): String;
begin
  Result := lTrimPunctuation(Value);
  Result := rTrimPunctuation(Result);
end;

procedure TfrmCompose.txtSubjectClick(Sender: TObject);
begin
  txtSubject.SetFocus;
end;

procedure TfrmCompose.loadAddresses(mime: TMimeMess);
var i: Integer;
var tmpStr: String;
begin
  lstAddresses.Clear;
  for i := 0 to mime.Header.ToList.Count - 1 do begin
    addAddress(tatTo, UTF8Decode(mime.Header.ToList.Strings[i]));
  end;

  for i := 0 to mime.Header.CCList.Count - 1 do begin
    addAddress(tatCC, UTF8Decode(mime.Header.CCList.Strings[i]));
  end;

  for i := 0 to mime.Header.BCCList.Count - 1 do begin
    addAddress(tatBCC, UTF8Decode(mime.Header.BCCList.Strings[i]));
  end;

  //add reply-to only if diffrent from ReplyEmail or Email
  tmpStr := frmMailbox.Profile.Accounts[FAccount].ReplyEMail;
  if tmpStr = '' then
    tmpStr := '"' + frmMailbox.Profile.Accounts[FAccount].YourName + '"<' +
      frmMailbox.Profile.Accounts[FAccount].EMail + '>';

  if not SameText(UTF8Decode(mime.Header.ReplyTo), tmpStr) then
    addAddress(tatReplyTo, UTF8Decode(mime.Header.ReplyTo));
end;

function TfrmCompose.findAccountIndex(accountName: string): Integer;
var i: Integer;
begin
  Result := 0; //we always select 1st account
  for i := 0 to frmMailbox.Profile.Accounts.Count - 1 do begin
    if SameText(accountName, frmMailbox.Profile.Accounts[i].AccountName) then begin
      Result := i;
      break;
    end;
  end;
end;

function TfrmCompose.findAliasIndex(accountNo: Integer; alias: String): Integer;
var str: String;
begin
  str :=' - [' + frmMailbox.Profile.Accounts[accountNo].AccountName + ']';

  Result := Max(cmboxAccount.Items.IndexOf(alias + str), 0);
end;

function TfrmCompose.findAliasIndex(accountNo: Integer; emails1, emails2: String): Integer;
var str: String;
var lst: TStringList;
var i: Integer;
begin
  lst := TStringList.Create;
  buildEmailList(emails1, lst, True);
  buildEmailList(emails2, lst, True);
  str :=' - [' + frmMailbox.Profile.Accounts[accountNo].AccountName + ']';
  for i := 0 to lst.Count - 1 do begin
    Result := cmboxAccount.Items.IndexOf(lst[i] + str);
    if Result > 0 then
      Break;
  end;
  FreeAndNil(lst);
  Result := Max(Result, 0);
end;

function TfrmCompose.buildMessage(finnishLater: Boolean; saveStream: TStream): Integer;
var mime: TMimeMess;
var mimeMulti: TMimePart;
var msg: TMemoryStream;
var descr: TmsgDescription;
var Node: PVirtualNode;
var nd: PTreeAddresses;
var at: PTreeAttach;
var i: Integer;
var emailNo: Integer;
begin
  Result := -1;

  if lstAddresses.IsEditing then
    lstAddresses.EndEditNode;

  //is subject empty?
  if Trim(txtSubject.Text) = '' then begin
     txtSubject.Text := MyInputBox(_('Send message'),
    _('You did not specify a subject for this message.' + #13#10 +
      'If you would like to provide one, you may write it now in the field below.'),
    _('No subject') + ' - [si.Mail]', '', []);
  end;

  Screen.Cursor := crHourGlass;

  mime := TMimeMess.Create;

  //build headers
  node := lstAddresses.GetFirst;
  mime.Header.Clear;
  while node <> nil do begin
    nd := PTreeAddresses(lstAddresses.GetNodeData(node));
    case nd.type_ of
      tatTo:
      begin
        //build list just in case if user entred more than one address per field
        buildEmailListUTF8(nd.mail, mime.Header.ToList);
      end;
      tatCC:
      begin
        //build list just in case if user entred more than one address per field
        buildEmailListUTF8(nd.mail, mime.Header.CCList);
      end;
      tatBCC:
      begin
        //build list just in case if user entred more than one address per field
        buildEmailListUTF8(nd.mail, mime.Header.BCCList);
      end;
      tatReplyTo:
      begin
        mime.Header.ReplyTo := AnsiToUtf8(nd.mail);
      end
    end;
    node := lstAddresses.GetNext(node);
  end;

  //to fields cannot be empty
  if mime.Header.ToList.Count = 0 then begin
    MessageDlg(_('''To'' field cannot be empty.'), mtError, [mbOK], 0);
    lstAddresses.EditNode(lstAddresses.GetLast, 1);
    FreeAndNil(mime);
    Screen.Cursor := crDefault;
    Exit;
  end;

  emailNo := Integer(cmboxAccount.Items.Objects[cmboxAccount.ItemIndex]);
  with mime.Header do begin
    From := '"' + AnsiToUtf8(frmMailbox.Profile.Accounts[FAccount].YourName) +
      '" <' + AnsiToUtf8(emailList[emailNo]) + '>';
    if ReplyTo = '' then begin
      if frmMailbox.Profile.Accounts[FAccount].ReplyEMail = '' then
        ReplyTo := From
      else
        ReplyTo := AnsiToUtf8(
          frmMailbox.Profile.Accounts[FAccount].ReplyEMail);
    end;
    Subject := AnsiToUtf8(txtSubject.Text);
    Organization := AnsiToUtf8(
      frmMailbox.Profile.Accounts[FAccount].Organization);
    Date := Now;
    XMailer := 'si.Mail ' + frmMain.GetFileVersionAsString(Application.ExeName);
    Priority := TmailPriority(cmboxPriority.ItemIndex);
    if actOptionsRequestReadRcpt.Checked then
      Notification := From;
    if cmboxSignature.ItemIndex = 0 then
      Signature := ''
    else
      Signature := cmboxSignature.Items[cmboxSignature.ItemIndex];
  end;

  //save mail to file
  with descr do begin
    subject := UTF8Decode(mime.Header.Subject);
    for i := 0 to mime.Header.ToList.Count - 1 do
      if i = mime.Header.ToList.Count - 1 then
        from := from + UTF8Decode(mime.Header.ToList.Strings[i])
      else
        from := from + UTF8Decode(mime.Header.ToList.Strings[i]) + ',';
    comment := '';
    msgPart := Trim(Copy(txtMessage.Lines.Text, 0, 256));
    date := mime.Header.Date;
    size := 0;
    markId := 0;
    priority := Integer(mime.Header.Priority) + 1;
    status := status + [msgRead];
    replyDate := 0;
    forwardDate := 0;
    forwardedTo := '';
    account := frmMailbox.Profile.Accounts[FAccount].AccountName;
    uidl := '';
  end;

  if lstAttachments.RootNodeCount = 0 then begin //no attachments
    case cmboxMsgType.ItemIndex of
      0:
      begin //plain text only
        mime.AddPartText(txtMessage.Lines.Text, nil);
      end;
    end;
  end
  else begin
    mimeMulti := mime.AddPartMultipart('mixed', nil);
    case cmboxMsgType.ItemIndex of
      0:
      begin //plain text only
        mime.AddPartText(txtMessage.Lines.Text, mimeMulti);
      end
    end;

    //add attachments to list
    node := lstAttachments.GetFirst;
    while node <> nil do begin
      at := PTreeAttach(lstAttachments.GetNodeData(node));
      if at^.mime = nil then begin
        mime.Header.AttachList.Add(AnsiToUtf8(at^.fileName));
        descr.status := descr.status + [msgAttachmentOutside];
      end
      else begin
        descr.status := descr.status + [msgAttachmentInside];
        mime.AddPart(mimeMulti).Assign(at^.mime);
      end;
      node := lstAttachments.GetNext(node);
    end;
  end;


  mime.EncodeMessage;

  //save to file and exit
  if saveStream <> nil then
    mime.Lines.SaveToStream(saveStream)
  else begin
    msg := TMemoryStream.Create;
    mime.Lines.SaveToStream(msg);
    descr.size := msg.size;
    if ((FEditType <> tetContinue) or (FoldAccountIdx <> FAccount)) then
    begin //new message new msg is created also if diffrent account is selected
      if not finnishLater then
        Result := frmMailbox.Profile.Accounts[FAccount].Mailboxes[Integer(mboxUnsent) -
          1].AddMessage(msg, descr)
      else
        Result := frmMailbox.Profile.Accounts[FAccount].Mailboxes[Integer(mboxUnfinished) -
          1].AddMessage(msg, descr);

      //we must delete message in old account if account was changed
      if (FEditType = tetContinue) then begin
        frmMailbox.Profile.Accounts[FoldAccountIdx].Mailboxes[
          FMailbox].RemoveMessage(FmsgId);
      end;
    end
    else begin//update
      Result := FmsgID;
      frmMailbox.Profile.Accounts[FAccount].Mailboxes[Integer(mboxUnsent) -
        1].ReplaceMessage(FmsgID, msg, descr);
    end;
    if frmMailList.Mailbox = frmMailbox.Profile.Accounts[FAccount].Mailboxes[
      Integer(mboxUnsent) - 1] then
      frmMaillist.ShowMailbox;

    frmMailbox.trMailbox.Refresh;
    FreeAndNil(msg);
    frmMailbox.actAccountRefreshTot.Execute; //refresh unread/total msg count
  end;
  FreeAndNil(mime);
  Screen.Cursor := crDefault;