elmimeviewer_datacommon.pas

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

// File Version: 2004-04-16
unit ElMimeViewer_DataCommon;
{$DENYPACKAGEUNIT ON}

interface

uses
  // System units:
  SysUtils, Classes,
  {$IFDEF DELPHI_NET}
  System.ComponentModel,
  {$ENDIF}
  // ElMime units:
  SBMIMETypes,
  SBMIMEUtils,
  SBMIMEClasses,
  SBMIMEStream,
  SBMIME,
  // other units:
  {$IFNDEF D_6_UP}
  CommCtrl, Windows, Messages,
  {$ENDIF}
  Controls,
  Forms,
  ImgList,
  ComCtrls;

const
  cDemoVersion = '2004.04.16';

type

  TTagInfo = ( // identify type of nodes in TreeView
    tiNull, // non calculated child subnode
    tiOptions, // customize interface node
    tiError, tiWarning, tiText, // information node
    // message node
    tiParsedMessage, tiAssembledMessage,
    // message child subnodes
      tiHeaders, tiField, // header and field
        tiComment, // todo: comment to tiField
        tiParamList, tiParam, // field params
        tiFromList, tiGroup, tiFrom,
      tiBody, // body
        tiPartList, tiPart, // multipart body
        tiPartHandler, tiPartBodyHandler // part and body handlers
  );

const

  cTagInfoImages: array[TTagInfo] of Integer = ( // default Node image index
    -1, // tiNull                                // in dmElMime.ImageListNodes
     4, // tiOptions
     8, // tiError
     7, // tiWarning
    -1, // tiText
     6, // tiParsedMessage
     6, // tiAssembledMessage
    16, // tiHeaders
    17, // tiField
     4, // tiComment
    19, // tiParamList
    20, // tiParam
    47, // tiFromList {46}
    48, // tiFrom
    49, // tiGroup,
    11, // tiBody
    23, // tiPartList
    22, // tiPart
    24, // tiPartHandler
    25  // tiPartBodyHandler
  );

type
  TElMimePlugFrame = class;

  // ElMime Nodes:

  {$IFNDEF D_6_UP}
  TTreeNodesFix = class(ComCtrls.TTreeNodes) // delphi 5 simple extension
  private
    procedure Repaint(Node: TTreeNode);
    procedure AddedNode(Value: TTreeNode);
    function _AddNode(Node, Relative: TTreeNode; const S: string;
      Ptr: Pointer; Method: TNodeAttachMode): TTreeNode;
  public
    function AddNode(Node, Relative: TTreeNode; const S: string;
      Ptr: Pointer; Method: TNodeAttachMode): TTreeNode;
  end;
  {$ELSE}
  TTreeNodesFix = class(TTreeNodes)
  public
    // fixed: update Node.StateIndex
    function AddNode(Node, Relative: TTreeNode; const S: string;
      Ptr: {$IFDEF DELPHI_NET}TObject{$ELSE}Pointer{$ENDIF}; Method: TNodeAttachMode): TTreeNode;
  end;
  {$ENDIF}

  {$IFDEF DELPHI_NET}
  TTreeNodesA = TTreeNodes; // not applicable TTreeNodesFix :(
  {$ELSE}
  TTreeNodesA = TTreeNodesFix;
  {$ENDIF}

  TTreeNodeInfo = class(TTreeNode) // ElMime Node
  protected
    fLocked: Boolean;
    fTagInfo: TTagInfo;
    fTagObj: TObject;
    fFullControl: Boolean;
    fPlugFrame: TElMimePlugFrame;
    fLevel: Integer;
    procedure InitPlugFrame;
  public
    constructor Create(AOwner: TTreeNodes; ATagInfo: TTagInfo = tiNull;
      ATagObject: TObject = nil; bFullControl: Boolean = False);
    destructor Destroy; override;
    procedure LinkTagObj(ATagInfo: TTagInfo; ATagObj: TObject; bFullControl: Boolean);
    procedure UpdatePlugFrame;
    property TagInfo: TTagInfo read fTagInfo;
    property TagObj: TObject read fTagObj;
    property PlugFrame: TElMimePlugFrame read fPlugFrame write fPlugFrame;
    property Level: Integer read fLevel write fLevel;
    property Locked: Boolean read fLocked;// write fLocked;
  end;

  // Options Nodes:

  TTreeNodeInfoOptions = class(TTreeNodeInfo) // Static (Locked) Node linked to customization interface
  protected
    fOptions: TTagInfo;
  public
    constructor Create(AOwner: TTreeNodes; ATagInfo: TTagInfo = tiNull;
      ATagObject: TObject = nil; bFullControl: Boolean = False);
  end;

  TElMessageThread = class;

  TElMessageDemo = class(TElMessage) // parsed message
  private
    fDataFile: TWideString;
    fDataStream: TAnsiStringStream;
    fResult :ELMIMERESULT;
    fParserThread: TElMessageThread;
    fUseBackgroundParser: Boolean;
  public
    constructor Create; overload;
    destructor Destroy; override;
    procedure Clear(bClearMainPart: Boolean = True); override;
    procedure InitMailAdressFields(const aFields: array of TWideString);

    property DataFile: TWideString read fDataFile write fDataFile;
    property DataStream: TAnsiStringStream read fDataStream;
  end;

  TdmElMime = class;

  TElMessageThread = class(TThread) // allow parsing of messages in parallel
  private
    fParent: TTreeNode;
    fFileName: TWideString;
    fDataStream: TAnsiStringStream;
    fDefaultHeaderCharset: AnsiString;
    fDefaultBodyCharset: AnsiString;
    fDefaultActivatePartHandlers: Boolean;
    fErrorMsg: AnsiString;
    fMsg: TElMessageDemo;
    fErrorException: Exception;
    fProcessController: IElProcessController;
    fUseBackgroundParser: Boolean;
    fNode: TTreeNodeInfo;
    fStartTime: TDateTime;
    procedure ShowError;
    procedure AddMessageToItems;
    procedure UnlinkMessage;
  public
    constructor Create(AParent: TTreeNode; AFileName: TWideString;
      ADataStream: TAnsiStringStream; dmOptions: TdmElMime);
    destructor Destroy; override;
  protected
    procedure Execute; override;
  end;

  TdmElMime = class(TDataModule)
    ImageListNodes: TImageList;
    ImageListStates: TImageList; // identify options for message parser
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    fDefaultHeaderCharset: AnsiString;
    fDefaultBodyCharset: AnsiString;
    fDefaultActivatePartHandlers: Boolean;
    fUseBackgroundParser: Boolean;
  public
    { Public declarations }
    procedure InitExtensions(Node: TTreeNode);
  end;

  TElMimePlugFrameClass = class of TElMimePlugFrame;
  TElMimePlugFrame = class(TFrame) // interface for detailed view node
  private
    fFixedFirstInsert: Boolean;
  protected
    fTagInfo: TTagInfo;
    fElMessagePart: TElMessagePart;
    fNode: TTreeNodeInfo;
    class procedure RegisterClass(ClassInfo: TElMimePlugFrameClass);
    class procedure UnRegisterClass(ClassInfo: TElMimePlugFrameClass);
    procedure Init(mp: TElMessagePart; TagInfo: TTagInfo; Node: TTreeNodeInfo; bShow: Boolean); virtual;
    property FixedFirstInsert: Boolean read fFixedFirstInsert;
  public
    constructor Create(AOwner: TComponent); override;
    class function IsSupportedThisMessapePart(mp: TElMessagePart; TagInfo: TTagInfo; Node: TTreeNodeInfo): Boolean; virtual;
    procedure InitSafe(mp: TElMessagePart; TagInfo: TTagInfo; Node: TTreeNodeInfo; bShow: Boolean);
    function GetCaption: string; virtual;
    class function SetNodeImageIndex(Node: TTreeNodeInfo; mp: TElMessagePart): Boolean; virtual;
    procedure WriteHTMLCode(sm: TElCustomMemoryStream); virtual;
    procedure UpdateView; virtual;
    procedure BeforeRemoveParent; virtual;
  end;

  {$IFNDEF VCL60} {$warnings off} {$ENDIF}
  TElMimePlugFrameOptionsClass = class of TElMimePlugFrameOptions;
  TElMimePlugFrameOptions = class(TElMimePlugFrame) // interface for options frame
  protected
    fNodes: TTreeNodesA;
    fRootNode: TTreeNode;
    class procedure RegisterClass(ClassInfo: TElMimePlugFrameOptionsClass);
    class procedure UnRegisterClass(ClassInfo: TElMimePlugFrameOptionsClass);
  public
    constructor Create(AOwner: TComponent; RootNode: TTreeNode; Nodes: TTreeNodesA); {$IFDEF VCL60} reintroduce;{$ENDIF} overload; virtual;
  end;
  {$warnings on}

var
  dmElMime: TdmElMime = nil;

implementation

{$R *.dfm}

{ TElMessageDemo }

type
  TList = Classes.TList;

var
  RegisteredPlugFramesList: TList = nil;
  PlugFramesList: TList = nil;
  RegPlugOptFraClasses: TList = nil;
  RegPlugOptFra: TList = nil;

function GetRegisteredPlugFrameClass(mp: TElMessagePart; TagInfo: TTagInfo; Node: TTreeNodeInfo): TElMimePlugFrameClass;
var
  i: Integer;
  ci: TElMimePlugFrameClass;
begin
  Result := nil;
  for i:=RegisteredPlugFramesList.Count-1 downto 0 do
  begin
    ci := TElMimePlugFrameClass(RegisteredPlugFramesList[i]);
    if ci.IsSupportedThisMessapePart(mp, Taginfo, Node) then
    begin
      Result := ci;
      break;
    end;
  end;
end;

function GetRegisteredPlugFrame(mp: TElMessagePart; TagInfo: TTagInfo; Node: TTreeNodeInfo): TElMimePlugFrame;
var
  ci: TElMimePlugFrameClass;
  i: Integer;
  pf: TElMimePlugFrame;
begin
  ci := GetRegisteredPlugFrameClass(mp, TagInfo, Node);
  if Assigned(ci) then
  begin
    for i:=0 to PlugFramesList.Count-1 do
    begin
      pf := TElMimePlugFrame(PlugFramesList[i]);
      if ci = pf.ClassType then
      begin
        Result := pf;
        exit;
      end;
    end;
    Result := ci.Create(nil);
    PlugFramesList.Add(Result);
  end
  else
    Result := nil;
end;

procedure TElMessageDemo.Clear(bClearMainPart: Boolean);
begin
  inherited Create;
end;

procedure TElMessageDemo.InitMailAdressFields(const aFields: array of TWideString);
var
  i: Integer;
begin
  for i := Low(aFields) to High(aFields) do
    if Assigned( GetHeaderField(aFields[i]) ) then
      GetMailAddressList( aFields[i] );
  // or:
  // if Assigned( GetHeaderField('From') ) then
  //   From; // create and parse addrresses if it header field exists
  // ...          // same header field well be removed
end;

const

  cXMailerDemoFieldValue = 'EldoS ElMime Demos, ver: '+cDemoVersion +
    ' ( '+cXMailerDefaultFieldValue + ' )';

constructor TElMessageDemo.Create;
begin
  inherited Create(cXMailerDemoFieldValue);
  fDataStream := TAnsiStringStream.Create;
end;

destructor TElMessageDemo.Destroy;
begin
  if Assigned(fParserThread) then
  begin
    if fUseBackgroundParser then
    begin
      fParserThread.fProcessController.Status := pcsTerminate;
      fParserThread.Terminate;
      fParserThread.WaitFor;
    end;
    fParserThread.Free;
  end;
  fDataFile := '';
  FreeAndnil(fDataStream);
  inherited;
end;

{ TElMessageThread }

constructor TElMessageThread.Create(AParent: TTreeNode; AFileName: TWideString;
  ADataStream: TAnsiStringStream; dmOptions: TdmElMime);
begin
  inherited Create(True);

  fParent := AParent;
  fFileName := AFileName;
  fDataStream := ADataStream;

  fDefaultHeaderCharset := dmOptions.fDefaultHeaderCharset;
  fDefaultBodyCharset := dmOptions.fDefaultBodyCharset;
  fDefaultActivatePartHandlers := dmOptions.fDefaultActivatePartHandlers;
  fUseBackgroundParser := dmOptions.fUseBackgroundParser;

  FreeOnTerminate := False;

  if fUseBackgroundParser then
  begin
    fProcessController := TElSimpleProcessController.Create;
    fProcessController.Init;
    Resume;
  end
  else
  begin
    Screen.Cursor := crHourGlass;
    try
      Execute;