fmailview.pas

siMail, siMail, siMail, siMail

(*
# (C) Copyright 2003
# Miha Vrhovnik, [e-mail]
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; either version 2 of
# the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
#
# The Initial Developer of the Original Code is Miha Vrhovnik (Slovenia).
# Portions created by Miha Vrhovnik are Copyright (c)2003.
# All Rights Reserved.
#==============================================================================
# Contributor(s):
#==============================================================================
# History: see whats new.txt from distribution package
#==============================================================================
*)
unit fMailView;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, GPanel, OleCtrls, ShellApi, synacode, pcre,
  ActiveX, GR32_Image, mimemess_siMail, mimepart, ActnList, VirtualTrees,
  Math, ImgList, TB2Item, TBX, TB2Dock, TB2Toolbar, Buttons, cidClass,
  pngimage, StrUtils, Menus, JvComponent, account, JclGraphUtils, SHDocVw,
  EmbeddedWB, MSHTML_TLB, TB2ToolWindow, TBXDkPanels;

type
  TfrmMailView = class(TForm)
    pnlDetails: TPanel;
    imgAuthor: TImage32;
    lblFrom: TLabel;
    lblSubject: TLabel;
    lblDate: TLabel;
    lblPriority: TLabel;
    alMenus: TActionList;
    lblWarning: TLabel;
    msgAttachments: TVirtualStringTree;
    ilFiles: TImageList;
    SaveDialog1: TSaveDialog;
    actSaveAttach: TAction;
    msgImage: TImgView32;
    cmdZoomPlus: TSpeedButton;
    cmdZoomMinus: TSpeedButton;
    popAttach: TTBXPopupMenu;
    Saveattachment1: TTBXItem;
    dckMenu: TTBXDock;
    tbToolbar: TTBXToolbar;
    tbMenu: TTBXToolbar;
    TBXItem1: TTBXItem;
    TBXItem2: TTBXItem;
    TBXItem3: TTBXItem;
    alToolbar: TActionList;
    actTBReply: TAction;
    actTBReplyAll: TAction;
    actTBForward: TAction;
    actTBPrint: TAction;
    actTBNext: TAction;
    actTBPrevious: TAction;
    actTBDelete: TAction;
    actTBAddressBook: TAction;
    TBXItem6: TTBXItem;
    TBXItem7: TTBXItem;
    TBXItem8: TTBXItem;
    TBXSeparatorItem1: TTBXSeparatorItem;
    actTBClose: TAction;
    TBXItem9: TTBXItem;
    TBXSeparatorItem2: TTBXSeparatorItem;
    TBXItem10: TTBXItem;
    TBXItem11: TTBXItem;
    TBXItem12: TTBXItem;
    TBXSeparatorItem3: TTBXSeparatorItem;
    TBXSubmenuItem1: TTBXSubmenuItem;
    TBXSubmenuItem2: TTBXSubmenuItem;
    actTBFlag: TAction;
    actTBCreateRule: TAction;
    TBXItem4: TTBXItem;
    TBXSubmenuItem3: TTBXSubmenuItem;
    actFilePrintPrint: TAction;
    Action2: TAction;
    Action3: TAction;
    Action4: TAction;
    Action5: TAction;
    dckBottom: TTBXDock;
    tbParts: TTBXToolbar;
    dckTop: TTBXDock;
    msgView: TEmbeddedWB;
    popDO: TTBXPopupMenu;
    actDOOffline: TAction;
    actDOImages: TAction;
    actDOBackgroundMusic: TAction;
    actDOVideos: TAction;
    actDOScripts: TAction;
    actDOJava: TAction;
    actDOActiveX: TAction;
    actDOActiveXRun: TAction;
    TBXItem5: TTBXItem;
    TBXItem13: TTBXItem;
    TBXItem14: TTBXItem;
    TBXItem15: TTBXItem;
    TBXItem16: TTBXItem;
    TBXItem17: TTBXItem;
    TBXItem18: TTBXItem;
    TBXItem19: TTBXItem;
    TBXItem20: TTBXItem;
    TBXItem21: TTBXItem;
    actDORemoveNonembedded: TAction;
    TBXItem22: TTBXItem;
    actFilePrintPreview: TAction;
    actFilePrintSetup: TAction;
    TBXToolWindow1: TTBXToolWindow;
    TBXToolbar1: TTBXToolbar;
    cmdShowMenu: TTBXItem;
    Label1: TLabel;
    chkHtmlAsText: TTBXCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure pnlDetailsResize(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure msgViewBeforeNavigate2(Sender: TObject;
      const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
      Headers: OleVariant; var Cancel: WordBool);
    procedure msgViewStatusTextChange(Sender: TObject;
      const Text: WideString);
    procedure msgAttachmentsGetImageIndex(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
      var Ghosted: Boolean; var ImageIndex: Integer);
    procedure msgAttachmentsGetNodeDataSize(Sender: TBaseVirtualTree;
      var NodeDataSize: Integer);
    procedure msgAttachmentsGetText(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
      var CellText: WideString);
    procedure msgAttachmentsGetPopupMenu(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Column: TColumnIndex; const P: TPoint;
      var AskParent: Boolean; var PopupMenu: TPopupMenu);
    procedure actSaveAttachExecute(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure msgAttachmentsDblClick(Sender: TObject);
    procedure cmdZoomPlusClick(Sender: TObject);
    procedure cmdZoomMinusClick(Sender: TObject);
    procedure actDOOfflineExecute(Sender: TObject);
    procedure actDOOfflineUpdate(Sender: TObject);
    procedure actDOImagesExecute(Sender: TObject);
    procedure actDOImagesUpdate(Sender: TObject);
    procedure actDOBackgroundMusicExecute(Sender: TObject);
    procedure actDOBackgroundMusicUpdate(Sender: TObject);
    procedure actDOVideosExecute(Sender: TObject);
    procedure actDOVideosUpdate(Sender: TObject);
    procedure actDOActiveXExecute(Sender: TObject);
    procedure actDOActiveXUpdate(Sender: TObject);
    procedure actDOScriptsExecute(Sender: TObject);
    procedure actDOScriptsUpdate(Sender: TObject);
    procedure actDOJavaExecute(Sender: TObject);
    procedure actDOJavaUpdate(Sender: TObject);
    procedure actDOActiveXRunExecute(Sender: TObject);
    procedure actDOActiveXRunUpdate(Sender: TObject);
    procedure actDORemoveNonembeddedExecute(Sender: TObject);
    procedure actDORemoveNonembeddedUpdate(Sender: TObject);
    procedure tbPartsDockChanged(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormConstrainedResize(Sender: TObject; var MinWidth,
      MinHeight, MaxWidth, MaxHeight: Integer);
    procedure actTBCloseExecute(Sender: TObject);
    procedure actTBAddressBookExecute(Sender: TObject);
    procedure FormShortCut(var Msg: TWMKey; var Handled: Boolean);
    procedure FormHide(Sender: TObject);
    procedure actTBReplyExecute(Sender: TObject);
    procedure actTBReplyUpdate(Sender: TObject);
    procedure actTBReplyAllExecute(Sender: TObject);
    procedure actTBForwardExecute(Sender: TObject);
    procedure actTBPrintExecute(Sender: TObject);
    procedure actTBPrintUpdate(Sender: TObject);
    procedure actFilePrintPrintUpdate(Sender: TObject);
    procedure msgViewDownloadComplete(Sender: TObject);
    procedure actFilePrintPreviewExecute(Sender: TObject);
    procedure actFilePrintPreviewUpdate(Sender: TObject);
    procedure actFilePrintPrintExecute(Sender: TObject);
    procedure actFilePrintSetupExecute(Sender: TObject);
    procedure actFilePrintSetupUpdate(Sender: TObject);
    procedure cmdShowMenuClick(Sender: TObject);
    procedure chkHtmlAsTextClick(Sender: TObject);
  private
    { Private declarations }
    Fmime: TMimeMess;
    FHeaders: TStringList;
    FdocFileName: String;
    FLargeHeaders: Boolean;
    Fcid2fn: TcidToFN;
    FPriority: Integer;
    FPriorityString: String;
    FMessageSize: Integer;
    FMimeParts: TList;
    FSelectedMessageMime: String;
    FMessageDescr: TMsgDescription;
    FMessageMailbox: Integer;
    FMessageAccount: Integer;
    Fmbox: TMailbox;
    regMail: IRegex;
    regUrl1: IRegex;
    regUrl2: IRegex;
    quotingStyles: String;
    selectedPartButton: TTBXItem;
    procedure SetSubject(const Value: String);
    function  GetSubject: String;
    function  GetDate: String;
    procedure SetDate(const Value: String);
    function  GetFrom: String;
    procedure SetFrom(const Value: String);
    procedure SetFromPicture(const Value: String);
    procedure SetPriority(const Value: Integer);
    procedure writePlain(strm: TFileStream; txt: String);
    function  doAnchors(str: String): String;
    procedure SetLargeHeaders(const Value: Boolean);
    procedure MessageBreakApart(mime_: TMimePart; attachment: Boolean);
    function  GetFileNameForCid(str1, str2: String): String;
    function  lTrimPunctuation(Value: String): String;
    function  rTrimPunctuation(Value: String): String;
    function  TrimPunctuation(Value: String): String;
    function  ExtractFileNameFromURL(Value: String): String;
    procedure clearMenus;
    procedure addNewMenu(caption: String; obj: TMimePart);
    procedure insertMenu(position: Integer; caption: String; obj: TMimePart);
    procedure tbPartsClick(Sender: TObject);
    procedure warningUpdate;
    procedure loadHtmlOptions;
    procedure hideIE;
    procedure doPrintOptions;
    procedure buildQuotingStyles;
  public
    { Public declarations }
    procedure LoadUserSettings;
    procedure LoadDoc(msg: TStream);
    procedure UnloadDoc;
    procedure LoadAttachments(lstAttach: TVirtualStringTree; iconList: TImageList;
      lstFiles: TStringList; fromHeader: Boolean);
    procedure WriteHtml(strm: TFileStream; txt: String);
    procedure Save(FileType: Integer; s: TStream);
    function ReadStringFromStream(stream: TStream; len: Integer): String;
    property Subject: String read GetSubject write SetSubject;
    property Date: String read GetDate write SetDate;
    property From: String read GetFrom write SetFrom;
    property FromPicture: String write SetFromPicture;
    property Priority: Integer read FPriority write SetPriority;
    property MessageSize: Integer read FMessageSize;
    property PriorityString: String read FPriorityString;
    property Headers: TStringList read FHeaders;
    property LargeHeaders: Boolean read FLargeHeaders write SetLargeHeaders;
    property MessageDescr: TMsgDescription write FMessageDescr;
    property MessageAccount: Integer write FMessageAccount;
    property MessageMailbox: Integer write FMessageMailbox;
    property Mailbox: TMailbox write Fmbox;
  end;

var
  frmMailView: TfrmMailView;

//tree type data
type TTreeAttach = record
    fileName: String;
    iconID: Integer;
    mime: TMimePart;
    size: Longword;
  end;

type PTreeAttach = ^TTreeAttach;

implementation

uses
  fMain, mailBox, gnugettext, defFldrs, dImages, uBoyerMoore, synachar,
  fCompose, maillist, fSettings, HtmlParser, DomCore, Formatter;

{$R *.dfm}

procedure TfrmMailView.FormCreate(Sender: TObject);
begin
  msgView.Align := alClient;
  msgImage.Align := alClient;
  msgAttachments.Align := alClient;
  Fmime := TMimeMess.Create;
  FHeaders := TstringList.Create;
  Fcid2fn := TcidToFN.Create;
  UnloadDoc;
  FdocFileName := '';
  FLargeHeaders := True;
  FMimeParts := TList.Create;
  selectedPartButton := nil;

  FSelectedMessageMime := '';
  FMessageMailbox := -1;
  FMessageAccount := -1;
  frmMain.ConvertToHighColor(ilFiles);

  regMail := nil;
  regUrl1 := nil;
  regUrl2 := nil;
end;

//we call function loadDoc after we finished loading all properties
procedure TfrmMailView.LoadDoc(msg: TStream);
var i: Integer;
var plainIdx, htmlIdx: Integer;
var size: Integer;
var at: PVirtualNode;
var messageMode: String;
begin
  if msg = nil then Exit;
  FSelectedMessageMime := '';
  Screen.Cursor := crHourGlass;
  Application.ProcessMessages;
  msgAttachments.Clear;
  ilFiles.Clear;
  FMimeParts.Clear;
  pnlDetailsResize(Self); //so all controls are aligned properly
  Fmime.Clear;
  for i := 0 to Fcid2fn.Count - 1 do begin
    DeleteFile(Fcid2fn.FileName(i));
  end;
  Fcid2fn.Clear;
  if msg <> nil then begin
    imgAuthor.Visible := True;
    //parse doc
    msg.Position := 0;
    FMessageSize := msg.Size;
    size := msg.Size;
    Fmime.Lines.LoadFromStream(msg);
    //Fmime.Lines.LoadFromFile('C:\Documents and Settings\Miha Vrhovnik\Desktop\test.eml');
    FreeAndNil(msg); //we don't need it anymore;
    Application.ProcessMessages; //let the application have time to clear all memory
    Fmime.DecodeMessage;
    FHeaders.Assign(Fmime.Header.FullHeaders);
    //we probably have only message
    clearMenus;
    addNewMenu(_('raw'), Fmime.MessagePart);
    //only message ?
    if ((Fmime.MessagePart.GetSubPartCount = 0) and (size > 0) and
      (Fmime.MessagePart.FileName = '')) then begin
      if Fmime.MessagePart.Secondary = '' then
        addNewMenu(_('Unknown'), Fmime.MessagePart)
      else addNewMenu(LowerCase(Fmime.MessagePart.Primary) + '/' +
          LowerCase(Fmime.MessagePart.Secondary), Fmime.MessagePart);
    end
    //only attachment ?
    else if ((Fmime.MessagePart.GetSubPartCount = 0) and (size > 0)) then begin
      //add attachment to list
      at := msgAttachments.AddChild(nil);
      with PTreeAttach(msgAttachments.GetNodeData(at))^ do begin
        mime := Fmime.MessagePart;
        iconID := frmMain.FindFileIcon(ilFiles, Fmime.MessagePart.FileName, False);
        size := mime.DecodedLines.Size;
      end;
    end
    //multipart message ?
    else begin
      //add tabs for all levels of message but filename for that part must be ''
      MessageBreakApart(Fmime.MessagePart, False);
    end;
    //load si.Mail stored attachments
    loadAttachments(msgAttachments, ilFiles, Fmime.Header.AttachList, True);
  end
  else imgAuthor.Visible := False;
  //show tabs
  plainIdx := -1;