elmimeviewer_mainform.pas

来自「著名的SecureBlackBox控件完整源码」· PAS 代码 · 共 1,038 行 · 第 1/3 页

// File Version: 2004-03-12
unit ElMimeViewer_MainForm;

{$i ElMimeViewer_Options.inc}

interface

uses
  {$IFDEF DELPHI_NET}
  System.Text,
  System.Collections,
  System.ComponentModel,
  {$ENDIF}
  // System units:
  Windows, Messages, SysUtils, {$IFDEF D_6_UP}Variants,{$ENDIF} Classes,
  SBUtils,
  // SB Unicode Library
  SBChSConvCharsets, // include all charsets
  // ElMime units:
  SBMIMETypes,
  SBMIMEUtils,
  SBMIMEClasses,
  SBMIMEStream,
  SBMIME,
  // optional ElMime units:
  {$IFDEF _UUE_}
  SBMIMEUUE,    // add support UUE
  ElMimeViewer_OptionsUUE,
  {$ENDIF}
  {$IFDEF _SMIME_}
  SBSMIMECore,  // add support SMIME
  ElMimeViewer_OptionsSMime,
  ElMimeViewer_CertDetails,
  {$ENDIF}
  {$IFDEF _PGP_}
  ElMimeViewer_OptionsPGPMime,
  SBPGPKeys,
  SBPGPMIME,
  SBPGPUtils,
  {$ENDIF}


  // Demo units:
  ElMimeViewer_DataCommon,
  // VCL units:
  Graphics, Controls, Forms,
  Dialogs, Menus, ComCtrls, ExtCtrls;

type
  TfrmMain = class(TForm)
    StatusBar: TStatusBar;
    mainMenu: TMainMenu;
    miFile: TMenuItem;
    miOpenLoadParse: TMenuItem;
    miSaveAssemble: TMenuItem;
    miEdit: TMenuItem;
    miDelete: TMenuItem;
    miCreate: TMenuItem;
    miView: TMenuItem;
    miHelp: TMenuItem;
    miAbout: TMenuItem;
    N1: TMenuItem;
    miExit: TMenuItem;
    TreeView: TTreeView;
    Splitter1: TSplitter;
    OD: TOpenDialog;
    miCollapseAll: TMenuItem;
    miExpandAll: TMenuItem;
    pDetailView: TPanel;
    pContainer: TPanel;
    pCap: TPanel;
    ShapeR: TShape;
    ShapeB: TShape;
    procedure miExitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure miOpenLoadParseClick(Sender: TObject);
    procedure miSaveAssembleClick(Sender: TObject);
    procedure miDeleteClick(Sender: TObject);
    procedure miCreateClick(Sender: TObject);
    procedure miAboutClick(Sender: TObject);
    procedure TreeViewExpanded(Sender: TObject; Node: TTreeNode);
    procedure TreeViewExpanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
    procedure miCollapseAllClick(Sender: TObject);
    procedure miExpandAllClick(Sender: TObject);
    procedure TreeViewChange(Sender: TObject; Node: TTreeNode);
    procedure miEditClick(Sender: TObject);
    procedure miViewClick(Sender: TObject);
    procedure TreeViewAdvancedCustomDrawItem(Sender: TCustomTreeView;
      Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage;
      var PaintImages, DefaultDraw: Boolean);
    {$IFDEF _PGP_}
    procedure HandleKeyPassphrase(Sender: TObject; Key : TElPGPCustomSecretKey;
      var Passphrase: string; var Cancel: boolean);
    {$ENDIF}
  private
    { Private declarations }
    fRootOptions :TTreeNode;
    fRootOptionsParser :TTreeNodeInfoOptions;
    fRootParseMessages :TTreeNode;
    {$IFDEF DEV_COMMENTS}
    fRootAssembleMessages: TTreeNode;
    {$ENDIF}
  public
    fOpParamsInTree: Boolean;
    fOpFieldsInTree: Boolean;
    fOpHeaderInTree: Boolean;
    fOpBodyInTree: Boolean;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

uses ElMimeViewer_OptionsParser;

{$R *.dfm}

procedure NotImplemented;
begin
  ShowMessage('This function has not been implemented.');
  Abort;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
{$IFDEF DEV_COMMENTS}
//var
//  Node: TTreeNodeInfoOptions;
{$ENDIF IFDEF DEV_COMMENTS}
begin

  // interface options for loaded/parsed messages
  fOpParamsInTree := True;
  fOpFieldsInTree := True;
  fOpHeaderInTree := True;
  fOpBodyInTree := True;

  // TreeView initialize
  fRootOptions := TreeView.Items.AddChild(nil, 'Options');
  fRootOptions.ImageIndex := 0;
  fRootOptions.SelectedIndex := 0;
  fRootParseMessages := TreeView.Items.AddChild(nil, 'Parsed Messages');
  fRootParseMessages.ImageIndex := 1;
  fRootParseMessages.SelectedIndex := 1;
  {$IFDEF DEV_COMMENTS}
  //todo:
  //fRootAssembleMessages := TreeView.Items.AddChild(nil, 'Assemble Messages');
  //fRootAssembleMessages.ImageIndex := 2;
  //fRootAssembleMessages.SelectedIndex := 2;

  //TTreeNodeInfoOptions
  {fRootOptionsParser := TreeView.Items.AddChild(fRootOptions, 'Parser');
  fRootOptionsParser.ImageIndex := 3;
  fRootOptionsParser.SelectedIndex := 3;}
  {$ENDIF IFDEF DEV_COMMENTS}
  fRootOptionsParser := TTreeNodeInfoOptions.Create(fRootOptions.Owner, tiOptions, TfraOptionsParser.Create(nil), True);
  TTreeNodesA(fRootOptionsParser.Owner).AddNode(fRootOptionsParser, fRootOptions, 'MIME', nil, naAddChild);
  fRootOptionsParser.PlugFrame := TfraOptionsParser(fRootOptionsParser.TagObj);
  fRootOptionsParser.ImageIndex := 3;
  fRootOptionsParser.SelectedIndex := 3;

  dmElMime.InitExtensions( fRootOptions );

  {$IFDEF DEV_COMMENTS}
  {$IFDEF _DEBUG_}
  //TElMessageThread.Create(fRootParseMessages, 'JPEG.eml', nil, dmElMime);
  //TElMessageThread.Create(fRootParseMessages, 'aa-bug.parse.subj.utf-16.eml', nil, dmElMime);
  //TElMessageThread.Create(fRootParseMessages, 'Message.eml', dmElMime);
  //TElMessageThread.Create(fRootParseMessages, 'Message.Header.Field.Comments.eml', nil, dmElMime);
  //TElMessageThread.Create(fRootParseMessages, 'Message.uue.1.eml', nil, dmElMime);
  //TElMessageThread.Create(fRootParseMessages, 'Message.e-mal.group.eml', nil, dmElMime);
  //TElMessageThread.Create(fRootParseMessages, 'Message.sign-a.eml', nil, dmElMime);
  //TElMessageThread.Create(fRootParseMessages, 'Message.html.plain.eml', nil, dmElMime);
  //TElMessageThread.Create(fRootParseMessages, 'Message.plain.html.eml', nil, dmElMime);
  //TElMessageThread.Create(fRootParseMessages, '__SPAM__.eml', nil, dmElMime);
  //fRootParseMessages.Expand(True);
  {$ENDIF}
  {$ENDIF IFDEF DEV_COMMENTS}
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  FreeAndNil(dmElMime);
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  {$IFDEF _DEBUG_}
  // quick exit:
  TerminateProcess(OpenProcess (PROCESS_TERMINATE, False, GetCurrentProcessID),0);
  {$ENDIF}
end;

procedure TfrmMain.miCollapseAllClick(Sender: TObject);
begin
  if Assigned(TreeView.Selected) then
    TreeView.Selected.Collapse(True);
end;

procedure TfrmMain.miExpandAllClick(Sender: TObject);
begin
  if Assigned(TreeView.Selected) then
    TreeView.Selected.Expand(True);
end;

procedure TfrmMain.miOpenLoadParseClick(Sender: TObject);
begin
  if not OD.Execute then
    exit;
  TElMessageThread.Create(fRootParseMessages, OD.FileName, nil, dmElMime);
end;

procedure TfrmMain.miSaveAssembleClick(Sender: TObject);
begin
  NotImplemented;
end;

procedure TfrmMain.miExitClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmMain.miDeleteClick(Sender: TObject);
var
  Node: TTreeNode;
  NodeInfo, NullNode: TTreeNodeInfo;
begin
  Node := TreeView.Selected;
  if (Node<>nil) and (Node is TTreeNodeInfo) then
  begin
    NodeInfo := TTreeNodeInfo(Node);
    //if NodeInfo.TagInfo in [tiParsedMessage, tiAssembledMessage] then
    if not NodeInfo.Locked then
    begin
      if (Node.Parent <> fRootParseMessages) and (Node.Parent<>nil) then
      begin
        if NodeInfo.TagObj is TElMessageDemo then
        begin
          NullNode := TTreeNodeInfo.Create(Node.Owner);
          TTreeNodesA(Node.Owner).AddNode(NullNode, Node.Parent, '...', nil, naAddChild);
          Node.Parent.Collapse(False);
        end;
      end;
      Node.Owner.Delete(Node);
    end;
  end;
end;

procedure TfrmMain.miCreateClick(Sender: TObject);
begin
  NotImplemented;
end;

procedure TfrmMain.miAboutClick(Sender: TObject);
begin
  ShowMessage('ElMime Demo Application, version: '+cDemoVersion+#13#10#13#10+
  '  (' +cXMailerDefaultFieldValue + ')'#13#10#13#10+
  '    Home page: http://www.secureblackbox.com')
end;

procedure TfrmMain.TreeViewExpanding(Sender: TObject; Node: TTreeNode;
  var AllowExpansion: Boolean);
var
  NodeInfo, NodeInfoChild, NewNode, NullNode, tmpNode: TTreeNodeInfo;
  md: TElMessageDemo;
  mp, mpi: TElMessagePart;
  ma: TElMailAddress;
  f: TElMessageHeaderField;
  S: string;
  i, iCount, k, g, ig: Integer;

  al : TElMailAddressList;
  ag: TElMailAddressGroup;

  {---------------------------------------------------------------------------}
  procedure AddPartHandlerOnly(mp: TElMessagePart);
  begin
    if Assigned(mp) and Assigned(mp.MessagePartHandler) then
    begin
      NewNode := TTreeNodeInfo.Create(Node.Owner, tiPartHandler, mp, False);
      S := 'Part Handler: "'+mp.MessagePartHandler.GetDescription+'"';
      TTreeNodesA(Node.Owner).AddNode(NewNode, NodeInfo, S, nil, naAddChild);
      if not mp.IsActivatedMessagePartHandler then
      begin
        if mp.MessagePartHandler.IsError then
        begin
          NullNode := TTreeNodeInfo.Create(Node.Owner, tiError);
          TTreeNodesA(Node.Owner).AddNode(NullNode, NewNode, 'ERROR: '+mp.MessagePartHandler.ErrorText,
            nil, naAddChild);
        end
        else
        try
          {$ifdef _SMIME_}
          if mp.MessagePartHandler is TElMessagePartHandlerSMIME then
          begin
            SMIMECollectCertificates;
            TElMessagePartHandlerSMIME(mp.MessagePartHandler).CertificatesStorage := CurCertStorage; 
            //TElMessagePartHandlerPGPMIME(mp.MessagePartHandler).VerifyingKeys := Keyring;
            //TElMessagePartHandlerPGPMIME(mp.MessagePartHandler).OnKeyPassphrase := HandleKeyPassphrase;
          end;
          {$endif}
          {$IFDEF _PGP_}
          if mp.MessagePartHandler is TElMessagePartHandlerPGPMIME then
          begin
            TElMessagePartHandlerPGPMIME(mp.MessagePartHandler).DecryptingKeys := Keyring;
            TElMessagePartHandlerPGPMIME(mp.MessagePartHandler).VerifyingKeys := Keyring;
            TElMessagePartHandlerPGPMIME(mp.MessagePartHandler).OnKeyPassphrase := HandleKeyPassphrase;
          end;
          {$ENDIF}
          Screen.Cursor := crHourGlass;
          try
            mp.MessagePartHandler.Decode(False);
          finally
            Screen.Cursor := crDefault;
          end;
          if mp.MessagePartHandler.IsError then
          begin
            NullNode := TTreeNodeInfo.Create(Node.Owner, tiError);
            TTreeNodesA(Node.Owner).AddNode(NullNode, NewNode, 'ERROR: '+mp.MessagePartHandler.ErrorText,
              nil, naAddChild);
          end
          else
          begin
            if Assigned(mp.MessagePartHandler.DecodedPart) then
            begin
              NullNode := TTreeNodeInfo.Create(Node.Owner);
              TTreeNodesA(Node.Owner).AddNode(NullNode, NewNode, '...', nil, naAddChild);
            end;
            if mp.MessagePartHandler.ResultCode = EL_WARNING then
            begin
              if mp.MessagePartHandler.ErrorText<>'' then
                S := mp.MessagePartHandler.ErrorText
              else
                S := 'Warning given when handling the message part';
              NullNode := TTreeNodeInfo.Create(Node.Owner, tiWarning);
              TTreeNodesA(Node.Owner).AddNode(NullNode, NewNode, 'WARNING: '+S, nil, naAddChild);
            end;
          end;
        except
          on e:exception do
          begin