elmimeviewer_smime.pas

来自「著名的SecureBlackBox控件完整源码」· PAS 代码 · 共 295 行

// File Version: 2004-04-16
unit ElMimeViewer_SMime;

interface

uses
  {$IFDEF DELPHI_NET}
  System.Text,
  System.Collections,
  System.ComponentModel,
  System.Reflection,
  System.Runtime.InteropServices,
  {$ENDIF}
  // System units:
  SysUtils, Classes,
  // SB Unicode Library
  SBChSConv,
  // El Mime units:
  SBMIMETypes,
  SBMIMEUtils,
  SBMIMEClasses,
  SBMIMEStream,
  // SMime Units:
  SBMIME,
  SBX509,
  SBConstants,
  // SMime units:
  SBSMIMECore,
  SBCustomCertStorage,
  // ElMime Demo units:
  ElMimeViewer_DataCommon,
  ElMimeViewer_CertDetails,
  // other units:
  Windows, Messages, {$IFDEF D_6_UP}Variants,{$ENDIF} Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Grids, Buttons;

type
  TFrame = TElMimePlugFrame;

  TfraSMime = class(TFrame)
    PageControl: TPageControl;
    tsSignInfo: TTabSheet;
    tsCryptInfo: TTabSheet;
    pBtns: TPanel;
    btnViewCert: TBitBtn;
    tsErrorInfo: TTabSheet;
    mErr: TMemo;
    StringGridCertificates: TStringGrid;
    procedure PageControlChange(Sender: TObject);
    procedure btnViewCertClick(Sender: TObject);
  private
    { Private declarations }
    ph: TElMessagePartHandlerSMime;
    fDecoderIsSigned: Boolean;
    fDecoderIsCrypted: Boolean;
    procedure InitData;
    procedure InitStringGridCertificates(CertStorage: TElCustomCertStorage);
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    class function IsSupportedThisMessapePart(mp: TElMessagePart; TagInfo: TTagInfo; Node: TTreeNodeInfo): Boolean; override;
    class function SetNodeImageIndex(Node: TTreeNodeInfo; mp: TElMessagePart): Boolean; override;
    function GetCaption: string; override;
  protected
    procedure Init(mp: TElMessagePart; TagInfo: TTagInfo; Node: TTreeNodeInfo; bShow: Boolean); override;
  end;

implementation

{$R *.dfm}

{ TfraSMime }

constructor TfraSMime.Create(AOwner: TComponent);
begin
  inherited;
  StringGridCertificates.Cells[0, 0] := 'Certificates :';
end;

destructor TfraSMime.Destroy;
begin

  inherited;
end;

function TfraSMime.GetCaption: string;
begin
  Result := 'SMime Part';
end;

procedure TfraSMime.InitStringGridCertificates(CertStorage: TElCustomCertStorage);
var
  i: Integer;
  cer: TElX509Certificate;
  ws: WideString;
begin
  StringGridCertificates.RowCount := 2;
  StringGridCertificates.Cells[0, 1] := '';
  StringGridCertificates.Objects[0, 1] := nil;
  if (CertStorage=nil) or (CertStorage.Count = 0) then
    exit;
  for i := 0 to CertStorage.Count -1 do
  begin
    cer := CertStorage.Certificates[i];
    ws :=
      fraSMIMEViewCert.GetCertificateIssuedToCN( cer ) + ' / '+
      fraSMIMEViewCert.GetCertificateIssuedToE( cer );

    StringGridCertificates.RowCount := StringGridCertificates.RowCount + 1;

    StringGridCertificates.Cells[0, StringGridCertificates.RowCount-2] := ws;
    StringGridCertificates.Objects[0, StringGridCertificates.RowCount-2] := cer;

  end;
  if StringGridCertificates.RowCount > 2 then
    StringGridCertificates.RowCount := StringGridCertificates.RowCount - 1;
end;

procedure TfraSMime.InitData;
begin

  if (ph<> nil) and ph.IsError then
  begin
    tsErrorInfo.TabVisible := True;
    mErr.Lines.Text := ph.ErrorText;
  end
  else
    tsErrorInfo.TabVisible := False;

  if (ph<> nil) then
  begin
    fDecoderIsSigned := ph.DecoderIsSigned;
    fDecoderIsCrypted := ph.DecoderIsCrypted;
  end
  else
  begin
    fDecoderIsSigned := False;
    fDecoderIsCrypted := False;
  end;

end;

procedure TfraSMime.PageControlChange(Sender: TObject);
begin
  if PageControl.ActivePage = tsSignInfo then
  begin
    if fDecoderIsSigned and Assigned(ph.DecoderSignCertStorage)
      and (ph.DecoderSignCertStorage.Count>0) then
    begin

      InitStringGridCertificates(ph.DecoderSignCertStorage);

      StringGridCertificates.Parent := tsSignInfo;
      pBtns.Parent := tsSignInfo;
      StringGridCertificates.Visible := True;
      pBtns.Visible := True;
    end
    else
    begin
      if ph.IsError then
        tsErrorInfo.Visible := True;
      StringGridCertificates.Visible := False;
      pBtns.Visible := False;
    end;
  end
  else
  begin
    if fDecoderIsCrypted and Assigned(ph.DecoderCryptCertStorage)
      and (ph.DecoderCryptCertStorage.Count>0) then
    begin
      InitStringGridCertificates(ph.DecoderCryptCertStorage);

      StringGridCertificates.Parent := tsCryptInfo;
      pBtns.Parent := tsCryptInfo;
      StringGridCertificates.Visible := True;
      pBtns.Visible := True;
    end
    else
    begin
      if ph.IsError then
        tsErrorInfo.Visible := True;
      StringGridCertificates.Visible := False;
      pBtns.Visible := False;
    end;
  end;
end;

procedure TfraSMime.Init(mp: TElMessagePart; TagInfo: TTagInfo;
  Node: TTreeNodeInfo; bShow: Boolean);
begin
  inherited;
  if (Node = nil) then
    exit;

  if (mp.MessagePartHandler = nil) or not (mp.MessagePartHandler is TElMessagePartHandlerSMime) then
  begin
    PageControl.Visible := False;
    exit;

  end;
  ph := TElMessagePartHandlerSMime(mp.MessagePartHandler);
  PageControl.Visible := True;

  InitData;
  PageControl.OnChange := nil;
  if ph.IsError then
    PageControl.ActivePage := tsErrorInfo
  else
  if fDecoderIsSigned then
    PageControl.ActivePage := tsSignInfo
  else
  if fDecoderIsCrypted then
    PageControl.ActivePage := tsCryptInfo
  else
    PageControl.ActivePage := tsSignInfo;
  PageControl.OnChange := PageControlChange;
  if PageControl.ActivePage <> tsErrorInfo then
    PageControl.OnChange(Self);
  PageControl.Visible := True;

end;

class function TfraSMime.IsSupportedThisMessapePart(mp: TElMessagePart;
  TagInfo: TTagInfo; Node: TTreeNodeInfo): Boolean;
begin
  Result := False;
  if (TagInfo<>tiPartHandler) or (Node=nil) or (mp=nil){ or (mp.IsMultipart)} then
    exit;
  Result := Assigned(mp.MessagePartHandler)
    and ( mp.MessagePartHandler is TElMessagePartHandlerSMime);
end;

class function TfraSMime.SetNodeImageIndex(Node: TTreeNodeInfo;
  mp: TElMessagePart): Boolean;
begin
  Result := False;
end;

procedure TfraSMime.btnViewCertClick(Sender: TObject);
var
  f: TForm;
  bOK: TBitBtn;
  cer: TElX509Certificate;
  D: Integer;
begin

  if (StringGridCertificates.Row < 0) or
    ( StringGridCertificates.Objects[0, StringGridCertificates.Row] = nil )
  then
    exit;

  cer := TElX509Certificate(StringGridCertificates.Objects[0, StringGridCertificates.Row]);

  fraSMIMEViewCert.SetCertificate(cer);

  f := TForm.Create(Application);
  try
    fraSMIMEViewCert.Parent := f;
    fraSMIMEViewCert.Visible := True;
    fraSMIMEViewCert.Top := 1;
    fraSMIMEViewCert.Left := 1;

    f.Width := 2 * (fraSMIMEViewCert.Left + f.BorderWidth )+ fraSMIMEViewCert.Width + 2;

    D := f.Height - f.ClientHeight;
    f.Height := D + 2 * fraSMIMEViewCert.Top + f.BorderWidth +
      fraSMIMEViewCert.Height + btnViewCert.Height;

    f.BorderIcons := [biSystemMenu];
    f.BorderStyle := bsDialog;
    f.Position := poScreenCenter;

    bOK := TBitBtn.Create(f);
    bOK.Caption := '&Close';
    bOK.Width := 80;
    bOK.Parent := f;
    bOK.Top := fraSMIMEViewCert.Top + fraSMIMEViewCert.Height + 10;
    bOK.Left := fraSMIMEViewCert.Left + fraSMIMEViewCert.Width - 15 - bOK.Width;
    bOK.Visible := True;
    bOK.ModalResult := mrOK;
    bOK.Default := True;

    f.ShowModal;

  finally
    fraSMIMEViewCert.Parent := nil;
    f.Free;
  end;
end;

initialization
  TfraSMime.RegisterClass(TfraSMime);
end.