elmimeviewer_datacommon.pas

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

    finally
      Screen.Cursor := crDefault;
    end;
  end;
end;

destructor TElMessageThread.Destroy;
begin
  fDataStream.Free;
  inherited;
end;

procedure TElMessageThread.Execute;
const
  cwsHeaderAddressesFields: array[1..12] of TWideString = (
    'From',
    'To',
    'Reply-To',
    'Sender',
    'CC',
    'BCC',
    'Resent-From',
    'Resent-To',
    'Resent-Reply-To',
    'Resent-Sender',
    'Resent-CC',
    'Resent-BCC'
  );
var tF : TStream;
begin
  try
    fMsg := TElMessageDemo.Create;

    Synchronize(AddMessageToItems); // create node and add it to TreeView

    // initialize fields

    fMsg.fUseBackgroundParser := fUseBackgroundParser;
    fMsg.fParserThread := Self;
    fMsg.ProcessController := fProcessController;
    fMsg.fDataStream.ProcessController := fProcessController;

    if fDataStream = nil then
    begin
      fMsg.fDataFile := fFileName;
      fMsg.fDataStream.LoadFromFile(fMsg.fDataFile);
    end
    else
    begin
      fMsg.fDataStream.Memory := fDataStream.Memory;
    end;
    fStartTime := Now;

    fMsg.fResult :=
      fMsg.ParseMessage(
        fMsg.fDataStream,
        fDefaultHeaderCharset,
        fDefaultBodyCharset,
        [mpoStoreStream, mpoLoadData, mpoCalcDataSize, mpoRaiseError],
        False,
        False,
        fDefaultActivatePartHandlers
    );

    if fMsg.fResult in [EL_OK, EL_WARNING] then
    begin
      // parse rfc header fields to e-mail AddressList collections:
      fMsg.InitMailAdressFields(cwsHeaderAddressesFields);

      (*
      tF := TFileStream.Create('c:\temp\111.eml', fmCreate);
      try
        fMsg.fResult := fMsg.AssembleMessage(tF, '', heAutoDetect, '', '', true);
      finally
        tF.Free;
      end;
      *)
    end;

    if not (fMsg.fResult in [EL_OK, EL_WARNING]) then
    begin
      fErrorMsg := Format(
        'Error parsing mime/smime message "%s". ElMime error code: %d',
        [fFileName, fMsg.fResult]
      );
    end;

    Synchronize(UnlinkMessage);

  except
    on e:EAbort do
      Synchronize(UnlinkMessage);
    on e:Exception do
    begin
      fErrorMsg := e.Message;
      fErrorException := e;
      Synchronize(UnlinkMessage);
      Synchronize(ShowError);
    end;
  end;
end;

procedure TElMessageThread.AddMessageToItems;
var
  NullNode: TTreeNodeInfo;
  S: string;
const
  cAttachedMessage = '//Attached Message//';
begin
  fParent.Owner.BeginUpdate;
  try
    if fNode = nil then
    begin // BEFORE PARSE
      DateTimeToString(S, 'hh:nn:ss.zzz', fStartTime);
      if Length(fFileName) > 0 then
        S := S+' | "'+ExtractFileName(fFileName)+'"'
      else
        S := S+' | "'+cAttachedMessage+'"';
      if fUseBackgroundParser then
        S := '...wait...'+S;
      fNode := TTreeNodeInfo.Create(fParent.Owner, tiParsedMessage, fMsg, True);
      fNode.ImageIndex := fNode.ImageIndex-1;
      fNode.SelectedIndex := fNode.ImageIndex;
      fNode.fLocked := True; // do not allow remove fro TreeView
      TTreeNodesA(fParent.Owner).AddNode(fNode, fParent, S, nil, naAddChild);
    end
    else
    begin // AFTER PARSE
      fNode.ImageIndex := fNode.ImageIndex+1;
      fNode.SelectedIndex := fNode.ImageIndex;
      fStartTime := Now - fStartTime;
      DateTimeToString(S, 'nn:ss.zzz', fStartTime);
      if Length(fFileName) > 0 then
        S := '[ ' + S + ' ] "'+ExtractFileName(fFileName)+'"'
      else
        S := '[ ' + S + ' ] "'+cAttachedMessage+'"';
      fNode.Text := S;

      //if fErrorMsg = '' then
      begin
        NullNode := TTreeNodeInfo.Create(fParent.Owner);
        TTreeNodesA(fParent.Owner).AddNode(NullNode, fNode, '...', nil, naAddChild);
      end;
      if fErrorMsg <> '' then
      begin
        NullNode := TTreeNodeInfo.Create(fParent.Owner, tiError);
        TTreeNodesA(fParent.Owner).AddNode(NullNode, fNode, fErrorMsg, nil, naAddChild);
      end;

      fNode.fLocked := False; // allow remove from TreeView
      {if (frmMain.TreeView.Selected = fNode) and Assigned(fNode.PlugFrame) then
      begin
        fNode.PlugFrame.InitSafe(
          fNode.PlugFrame.fElMessagePart,
          fNode.PlugFrame.fTagInfo,
          nil,
          False);
        fNode.PlugFrame.InitSafe(
          fNode.PlugFrame.fElMessagePart,
          fNode.PlugFrame.fTagInfo,
          fNode,
          True);
      end;{}
    end;
  finally
    fParent.Owner.EndUpdate;
  end;
  if (fNode <> nil){ and (fParent.Parent = nil)} then
    fParent.Expand(False);
end;

procedure TElMessageThread.UnlinkMessage;
begin
  FreeOnTerminate := True;
  if fMsg<>nil then
  begin
    if fDefaultActivatePartHandlers then
      FreeAndNil(fMsg.fDataStream)
    else
      fMsg.fDataStream.ProcessController := nil;

    fMsg.fParserThread := nil;
    fMsg.ProcessController := nil;
  end;
  if fNode<>nil then
    AddMessageToItems;
end;

procedure TElMessageThread.ShowError;
begin
  Application.ShowException(fErrorException);
end;

{ TTreeNodeInfo }

constructor TTreeNodeInfo.Create(AOwner: TTreeNodes; ATagInfo: TTagInfo;
  ATagObject: TObject; bFullControl: Boolean);
begin
  inherited Create(AOwner);
  LinkTagObj(ATagInfo, ATagObject, bFullControl);
end;

destructor TTreeNodeInfo.Destroy;
begin
  if Assigned(fPlugFrame) and (fPlugFrame.fNode=Self) then
  begin
    try
      // remove link from "linked frame to this node"
      //fPlugFrame.Init(fPlugFrame.fElMessagePart, fPlugFrame.fTagInfo, Self, False );
      fPlugFrame.Init(fPlugFrame.fElMessagePart, fPlugFrame.fTagInfo, nil, False );
    except
    end;
  end;
  if fFullControl then
    FreeAndNil(fTagObj);
  inherited;
end;

procedure TTreeNodeInfo.InitPlugFrame;
var
  mp: TElMessagePart;
begin
  fPlugFrame := nil;
  if (fTagInfo = tiNull)or(fTagObj=nil) then
    exit;

  if fTagObj is TElMessagePart then
    mp := TElMessagePart(fTagObj)
  else
  if fTagObj is TElMessageDemo then
    mp := TElMessageDemo(fTagObj).MainPart
  else
    exit;

  fPlugFrame := GetRegisteredPlugFrame(mp, fTagInfo, Self);

  if Assigned(fPlugFrame) then
  begin
    if not fPlugFrame.SetNodeImageIndex(Self, mp) then
    begin
      ImageIndex := cTagInfoImages[fTagInfo];
      SelectedIndex := ImageIndex;
    end;
  end
  else
  begin
    if not TElMimePlugFrame.SetNodeImageIndex(Self, mp) then
    begin
      ImageIndex := cTagInfoImages[fTagInfo];
      SelectedIndex := ImageIndex;
    end;
  end;
end;

procedure TTreeNodeInfo.LinkTagObj(ATagInfo: TTagInfo; ATagObj: TObject; bFullControl: Boolean);
begin
  fTagInfo := tiNull;
  if fFullControl then
    FreeAndNil(fTagObj);
  if fTagInfo <> ATagInfo then
  begin
    fTagInfo := ATagInfo;
    ImageIndex := cTagInfoImages[fTagInfo];
    SelectedIndex := ImageIndex;
  end;
  fTagObj := ATagObj;
  fFullControl := bFullControl;
  InitPlugFrame;
end;

procedure TdmElMime.DataModuleCreate(Sender: TObject);
begin
  //fDefaultActivatePartHandlers := True;
  fUseBackgroundParser := True;
  {$IFDEF _DEBUG_}
  fUseBackgroundParser := False;
  {$ENDIF}
end;

procedure TTreeNodeInfo.UpdatePlugFrame;
var
  mp: TElMessagePart;
begin
  if (fPlugFrame=nil)or(fTagInfo = tiNull)or(fTagObj=nil) then
    exit;

  if fTagObj = nil then
    mp := nil
  else
  if fTagObj is TElMessagePart then
    mp := TElMessagePart(fTagObj)
  else
  if fTagObj is TElMessageDemo then
    mp := TElMessageDemo(fTagObj).MainPart
  else
    mp := nil;

  fPlugFrame.InitSafe(mp, fTagInfo, Self, True);
end;

{ TElMimePlugFrame }

{$R ElMimeViewer_PluginFrame.dfm}

constructor TElMimePlugFrame.Create(AOwner: TComponent);
begin
  Name := 'fElMimePlugFrame';
  inherited;
  Align := alClient;
end;

procedure TElMimePlugFrame.BeforeRemoveParent;
begin
  {empty}
end;

function TElMimePlugFrame.GetCaption: string;
begin
  Result := ClassName;
end;

procedure TElMimePlugFrame.Init(mp: TElMessagePart; TagInfo: TTagInfo; Node: TTreeNodeInfo; bShow: Boolean);
begin
  fTagInfo := TagInfo;
  fElMessagePart := mp;
  fNode := Node;
end;

class function TElMimePlugFrame.SetNodeImageIndex(Node: TTreeNodeInfo; mp: TElMessagePart): Boolean;
var
  wsContentSubtype, wsName: TWideString;
  sName: AnsiString;
begin
  Result := False;
  if (Node=nil) then
    exit;
  Result := True;
  Node.ImageIndex := cTagInfoImages[Node.fTagInfo];
  try
    if (mp<>nil) then
    begin
      case Node.fTagInfo of
    //      tiHeaders, tiField, // header and field
    //        tiParamList, tiParam, // field params
        tiBody:
          with mp do
          begin
            if not IsMultipart then
            begin

              // set attachment StateIndex:
              if mp.IsAttachment then
                Node.StateIndex := 1;

              if IsTextHtml then
                Node.ImageIndex := 13
              else
              if IsText then
                Node.ImageIndex := 12
              else
              if IsImage then
                Node.ImageIndex := 14
              else
              if IsApplication then
              begin
                Node.ImageIndex := 28;
                wsContentSubtype := ContentSubtype;
                if WideSameText(wsContentSubtype, 'octet-stream') then
                begin
                  wsContentSubtype := '';
                  wsName := FileName;
                  DeleteQuotationMarks(wsName);