maillist.pas

siMail, siMail, siMail, siMail

  TextType: TVSTTextType);
begin
  with PTreeMaillist((Sender as TVirtualStringTree).GetNodeData(Node))^ do begin
    if not (msgRead in status) then
      TargetCanvas.Font.Style := Canvas.Font.Style + [fsBold]
    else
      TargetCanvas.Font.Style := Canvas.Font.Style - [fsBold];
  end;
end;

procedure TfrmMaillist.lstMailListDblClick(Sender: TObject);
begin
  if not actMessageContinueEdit.Execute  then
    actMessageOpen.Execute;
end;

procedure TfrmMaillist.actMessageReplyExecute(Sender: TObject);
var nd: PTreeMaillist;
var frmNew: TfrmCompose;
begin
  if actMessageReply.Enabled = False then exit;
  nd := PTreeMaillist(lstMaillist.GetNodeData(lstMaillist.GetFirstSelected));
  if nd = nil then
    Exit;
  //mark as replied
  nd.status := nd.status + [msgReplied];
  Fmbox.ReplaceDescription(nd.id, nd^);
  frmNew := TfrmCompose.Create(nil);
  frmNew.Account := frmMailbox.SelectedAccount;
  frmNew.Mailbox := frmMailbox.SelectedMailbox;
  frmNew.MessageId := nd^.id;
  frmNew.EditType := tetReply;
  frmNew.Show;
  lstMaillist.Repaint;
end;

procedure TfrmMaillist.actMessageForwardExecute(Sender: TObject);
var nd: PTreeMaillist;
var frmNew: TfrmCompose;
begin
  if actMessageForward.Enabled = False then exit;
  nd := PTreeMaillist(lstMaillist.GetNodeData(lstMaillist.GetFirstSelected));
  if nd = nil then
    Exit;
  //mark as forwarded
  nd.status := nd.status + [msgForwarded];
  Fmbox.ReplaceDescription(nd.id, nd^);
  frmNew := TfrmCompose.Create(nil);
  frmNew.Account := frmMailbox.SelectedAccount;
  frmNew.Mailbox := frmMailbox.SelectedMailbox;
  frmNew.MessageId := nd^.id;
  frmNew.EditType := tetForward;
  frmNew.Show;
  lstMailList.Repaint;
end;

procedure TfrmMaillist.actMessageReplyUpdate(Sender: TObject);
begin
  if lstMaillist.RootNodeCount = 0 then begin
    actMessageReply.Enabled := False;
    frmMain.actTBMessageReply.Enabled := False;
    actMessageReplyAll.Enabled := False;
    frmMain.actTBMessageReplyAll.Enabled := False;
  end
  else begin
    if ( not ((Fmbox.id = -Integer(mboxUnfinished)) or
      (Fmbox.id = -Integer(mboxUnsent)))) and
      (lstMailList.SelectedCount = 1) then begin
      actMessageReply.Enabled := True;
      frmMain.actTBMessageReply.Enabled := True;
      actMessageReplyAll.Enabled := True;
      frmMain.actTBMessageReplyAll.Enabled := True;
    end;
  end;
end;

procedure TfrmMaillist.actMessageForwardUpdate(Sender: TObject);
begin
  if lstMaillist.RootNodeCount = 0 then begin
    actMessageForward.Enabled := False;
    frmMain.actTBMessageForward.Enabled := False;
  end
  else begin
    if ( not ((Fmbox.id = -Integer(mboxUnfinished)) or
      (Fmbox.id = -Integer(mboxUnsent)))) and
      (lstMailList.SelectedCount = 1) then begin
      actMessageForward.Enabled := True;
      frmMain.actTBMessageForward.Enabled := True;
    end;
  end;
end;

procedure TfrmMaillist.RemoveMessageWithInternalID(msgId: Integer);
var Node: PVirtualNode;
var nd: PTreeMaillist;
begin
  Node := lstMailList.GetFirst;
  while Node <> nil do begin
    nd := lstMailList.GetNodeData(Node);
    if nd.id = msgID then begin
      lstMailList.DeleteNode(Node);
      if vsSelected in Node.States then
        frmMailView.UnloadDoc;
      break;
    end;
    Node := lstMailList.GetNext(Node);
  end;
end;

procedure TfrmMaillist.FormDestroy(Sender: TObject);
var i: Integer;
begin

  //write sizes and positions maillist columns
  try
    for i := 0 to lstMailList.Header.Columns.Count - 1 do begin
      frmMailbox.Profile.Config.WriteInteger(Self.Name, Format(
        'maillistColumnWidth_%s', [IntToHex(i, 2)]), Trunc(10000 *
        (lstMailList.Header.Columns[i].Width / lstMailList.Width)));
      frmMailbox.Profile.Config.WriteInteger(Self.Name, Format(
        'maillistColumnPosition_%s', [IntToHex(i, 2)]), lstMailList.Header.Columns[i].Position);
    end;
  except
  end;

end;

procedure TfrmMaillist.FormResize(Sender: TObject);
var i: Integer;
begin
  if frmMailbox.Profile = nil then exit;
  //read sizes and positions maillist columns
  for i := 0 to lstMailList.Header.Columns.Count - 1 do begin
    lstMailList.Header.Columns[i].Width :=
      Trunc(Self.Width * (frmMailbox.Profile.Config.ReadInteger(
      Self.Name, Format('maillistColumnWidth_%s', [IntToHex(i, 2)]), 0) / 10000));
    lstMailList.Header.Columns[i].Position :=
      frmMailbox.Profile.Config.ReadInteger(Self.Name, Format(
      'maillistColumnPosition_%s', [IntToHex(i, 2)]), lstMailList.Header.Columns[i].Position);
  end;
end;

procedure TfrmMaillist.ComposeWindowsChangeFont(fnt: TFont);
var i: Integer;
begin
  for i := 0 to Application.ComponentCount - 1 do begin
    if Application.Components[i] is TfrmCompose then
      (Application.Components[i] as TfrmCompose).txtMessage.Font := fnt;
  end;

end;

procedure TfrmMaillist.ClearMaillist;
begin
  lstMailList.Clear;
  frmMailView.UnloadDoc;
  FaccountID := -1;
end;

procedure TfrmMaillist.actGroupByDateExecute(Sender: TObject);
begin
  FGroubBy := gbDate;
  ShowMailbox;
end;

procedure TfrmMaillist.showGroupByDate;
begin

end;

procedure TfrmMaillist.actMessageMarkAsRepliedExecute(Sender: TObject);
var Node: PVirtualNode;
var nd: PTreeMaillist;
begin
  if lstMaillist.SelectedCount = 0 then Exit;
  if not (Sender is TAction) then Exit;

  Node := lstMaillist.GetFirstSelected;
  while Node <> nil do begin
    nd := lstMaillist.GetNodeData(Node);
    if not (msgReplied in nd.status) then begin
      nd.status := nd.status + [msgReplied];
    end;
    Fmbox.ReplaceDescription(nd.id, nd^);
    Node := lstMaillist.GetNextSelected(Node);
  end;
  lstMaillist.Repaint;
  frmMailbox.trMailbox.Repaint;
  frmMailbox.actAccountRefreshTot.Execute; //refresh unread/total msg count
end;

procedure TfrmMaillist.actMessageMarkAsUnrepliedExecute(Sender: TObject);
var Node: PVirtualNode;
var nd: PTreeMaillist;
begin
  if lstMaillist.SelectedCount = 0 then Exit;
  if not (Sender is TAction) then Exit;

  Node := lstMaillist.GetFirstSelected;
  while Node <> nil do begin
    nd := lstMaillist.GetNodeData(Node);
    if (msgReplied in nd.status) then begin
      nd.status := nd.status - [msgReplied];
    end;
    Fmbox.ReplaceDescription(nd.id, nd^);
    Node := lstMaillist.GetNextSelected(Node);
  end;
  lstMaillist.Repaint;
  frmMailbox.trMailbox.Repaint;
  frmMailbox.actAccountRefreshTot.Execute; //refresh unread/total msg count
end;

procedure TfrmMaillist.actMessageMarkAsForwardedExecute(Sender: TObject);
var Node: PVirtualNode;
var nd: PTreeMaillist;
begin
  if lstMaillist.SelectedCount = 0 then Exit;
  if not (Sender is TAction) then Exit;

  Node := lstMaillist.GetFirstSelected;
  while Node <> nil do begin
    nd := lstMaillist.GetNodeData(Node);
    if not (msgForwarded in nd.status) then begin
      nd.status := nd.status + [msgForwarded];
    end;
    Fmbox.ReplaceDescription(nd.id, nd^);
    Node := lstMaillist.GetNextSelected(Node);
  end;
  lstMaillist.Repaint;
  frmMailbox.trMailbox.Repaint;
  frmMailbox.actAccountRefreshTot.Execute; //refresh unread/total msg count
end;

procedure TfrmMaillist.actMessageMarkAsUnforwardedExecute(Sender: TObject);
var Node: PVirtualNode;
var nd: PTreeMaillist;
begin
  if lstMaillist.SelectedCount = 0 then Exit;
  if not (Sender is TAction) then Exit;

  Node := lstMaillist.GetFirstSelected;
  while Node <> nil do begin
    nd := lstMaillist.GetNodeData(Node);
    if (msgForwarded in nd.status) then begin
      nd.status := nd.status - [msgForwarded];
    end;
    Fmbox.ReplaceDescription(nd.id, nd^);
    Node := lstMaillist.GetNextSelected(Node);
  end;
  lstMaillist.Repaint;
  frmMailbox.trMailbox.Repaint;
  frmMailbox.actAccountRefreshTot.Execute; //refresh unread/total msg count

end;

procedure TfrmMaillist.actMessageReplyAllExecute(Sender: TObject);
var nd: PTreeMaillist;
var frmNew: TfrmCompose;
begin
  if actMessageReply.Enabled = False then exit;
  nd := PTreeMaillist(lstMaillist.GetNodeData(lstMaillist.GetFirstSelected));
  if nd = nil then
    Exit;
  //mark as replied
  nd.status := nd.status + [msgReplied];
  Fmbox.ReplaceDescription(nd.id, nd^);
  frmNew := TfrmCompose.Create(nil);
  frmNew.Account := frmMailbox.SelectedAccount;
  frmNew.Mailbox := frmMailbox.SelectedMailbox;
  frmNew.MessageId := nd^.id;
  frmNew.EditType := tetReplyAll;
  frmNew.Show;
  lstMaillist.Repaint;
end;

procedure TfrmMaillist.actMessageOpenExecute(Sender: TObject);
begin
  if lstMailList.FocusedNode = nil then
    Exit;

    openMessage(lstMailList.FocusedNode, True);
end;

procedure TfrmMaillist.openMessage(Node: PVirtualNode; newWindow: Boolean);
var nd: PTreeMaillist;
var frm: TfrmMailView;
var msg: TMemoryStream;
begin
  tmrMark.Enabled := False; //disable timer
  Screen.Cursor := crHourGlass;
  Application.ProcessMessages;
  if not newWindow then
    frm := frmMailView
  else
    frm := TfrmMailView.Create(Application);

  //read mesage
  if vsSelected in Node.States then begin
    nd := lstMaillist.GetNodeData(Node);
    frmMain.StatusBar1.Panels[infoPanel].Caption :=
      Format(_('Loading message: %s'), [nd.subject]);
    Application.ProcessMessages;
    if not (msgRead in nd.status) then tmrMark.Enabled := True;
    msg := TMemoryStream(Fmbox.GetMessageContent(nd.id));

    //
    with frm do begin
      if CompareDate(nd.date, Now) = 0 then Date := _('Today ') + TimeToStr(nd.date)
      else if CompareDate(nd.date, IncDay(Now, -1)) = 0 then
        Date := _('Yesterday ') + TimeToStr(nd.date)
      else Date := DateTimeToStr(nd.date);

      frmMessageInfo.lblSubject.Caption := nd.subject;
      frmMessageInfo.lblAccount.Caption := nd.account;
      Subject := '[' + nd.subject + ']';
      From := nd.from;
      Priority := nd.priority;
      LoadDoc(msg);
    end;
  end
  else begin
    frm.UnloadDoc;
  end;
  if newWindow then begin
    frm.Mailbox := Fmbox;
    frm.MessageDescr := nd^;
    frm.MessageAccount := frmMailbox.SelectedAccount;
    frm.MessageMailbox := frmMailbox.SelectedMailbox;
    frm.Show;
  end;
  Screen.Cursor := crDefault;;
end;

procedure TfrmMaillist.actMessageOpenUpdate(Sender: TObject);
begin
  if lstMaillist.RootNodeCount = 0 then exit;
  if not (Fmbox.id = -Integer(mboxUnfinished)) or (Fmbox.id = -Integer(mboxUnsent)) then
    actMessageOpen.Enabled := True
  else actMessageOpen.Enabled := False;
end;

procedure TfrmMaillist.actMessageSaveExecute(Sender: TObject);
var strm: TFileStream;
var s:TStream;
var msgID: Integer;
begin
  diSaveDialog.FileName := '';
  if not diSaveDialog.Execute then
    Exit;

  //open file
  if (Sender as TAction).Tag = 1 then
    strm := TFileStream.Create(diSaveDialog.FileName, fmCreate, fmShareExclusive)
  else begin
    strm := TFileStream.Create(diSaveDialog.FileName, fmOpenWrite, fmShareExclusive);
    strm.Position := strm.Size;
  end;
  try
    case diSaveDialog.FilterIndex of
    1..2: frmMailView.Save(diSaveDialog.FilterIndex, strm);//html
    3: begin //eml
        msgID := PTreeMaillist(lstMaillist.GetNodeData(lstMaillist.GetFirstSelected))^.id;
        s := Fmbox.GetMessageContent(msgID);
        s.Position := 0;
        try
          strm.CopyFrom(s, s.Size);
        finally
          FreeandNil(s);
        end;
    end
    end;
  finally
    FreeAndNil(strm);
  end;
end;

procedure TfrmMaillist.actMessageAddSenderExecute(Sender: TObject);
var Node: PVirtualNode;
var nd: PTreeMaillist;
var n, e: String;
begin
  frmContact.AddressBook := frmAddressBook.SelectedAddressBook;
  Node := lstMailList.GetFirstSelected;
  while Node <> nil do begin
    nd := lstMailList.GetNodeData(Node);
    frmContact.ScheduleAsNew := True;
    frmContact.LoadPerson;
    parseMail(nd^.from, n, e);
    frmContact.txtFirstName.Text := n;
    frmContact.txtEmails.Text := e;
    frmContact.SavePerson;
    Node := lstMailList.GetNextSelected(Node);
  end;

  frmAddressBook.ReloadBook(rbmNewContact);

  if frmAddressBook.SelectedAddressBook = frmAddrBk.SelectedAddressBook then
    frmAddrBk.ReloadBook(rbmNewContact);

end;

procedure TfrmMaillist.actMessageAddSenderUpdate(Sender: TObject);
begin
  if (frmAddressBook.SelectedAddressBook = nil) or (lstMailList.SelectedCount = 0) then
    actMessageAddSender.Enabled := False
  else
    actMessageAddSender.Enabled := True;
end;

procedure TfrmMaillist.parseMail(Value: String; var name, email: String);
var theRegex: IRegex;
var strCol: IStringCollection;
var i: Integer;
var tmpStr: String;
const expr = '(?imxs)(<?[_A-Z\d\-\.]+@[_A-Z\d\-\.]+>?)'; //this matches email
begin
  theRegex := RegexCreate(expr, [], 'C');
  strCol := theRegex.Split(Value);

  name := '';
  email := '';
  for i := 0 to strCol.Count - 1 do begin
    //skip if string is empty
    tmpStr := Trim(strCol.Strings[i]);
    if tmpStr <> '' then begin
      if LeftStr(tmpStr, 1) = '"' then
        name := Copy(tmpStr, 2, Length(tmpStr) - 2)
      else if  Pos('@', tmpStr) = 0 then
        name := tmpStr
      else begin
        if LeftStr(tmpStr, 1) = '<' then
          email := Copy(tmpStr, 2, Length(tmpStr) - 2)
        else
          email := tmpStr;

        if name = '' then
          name := email;
      end;
    end;
  end;
  name := Trim(name);
  email := Trim(email);
  strCol := nil;
  theRegex := nil;
end;

end.