mainform.pas

著名的SecureBlackBox控件完整源码

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  SBAuthenticode, ExtCtrls, ComCtrls, StdCtrls, SBX509, SBUtils,
  ImgList, SBSimpleSSL, SBHTTPSClient;


type
  TState = (stIntro, stSelectExecutableForSigning, stSelectExecutableForVerifying,
    stSelectExecutableForRemoval,
    stSelectCertificates, stVerify, stSelectSigningProperties, stSignPreview,
    stSignProcess, stVerifyProcess, stRemovalProcess, stVerifyResults, stFinished);

type
  TFormMain = class(TForm)
    ElAuthenticodeVerifier: TElAuthenticodeVerifier;
    ElAuthenticodeSigner: TElAuthenticodeSigner;
    PanelBottom: TPanel;
    PanelClient: TPanel;
    PanelImage: TPanel;
    Image: TImage;
    Bevel1: TBevel;
    PageControl: TPageControl;
    TabSheetIntro: TTabSheet;
    TabSheetFileSelect: TTabSheet;
    Label1: TLabel;
    RadioButtonSign: TRadioButton;
    RadioButtonVerify: TRadioButton;
    ButtonBack: TButton;
    ButtonNext: TButton;
    ButtonCancel: TButton;
    LabelSelectFilePrompt: TLabel;
    TabSheetCertificatesSelect: TTabSheet;
    EditPath: TEdit;
    ButtonBrowse: TButton;
    OpenDialog: TOpenDialog;
    ListViewCertificates: TListView;
    Label2: TLabel;
    ButtonAddCertificate: TButton;
    ButtonRemoveCertificate: TButton;
    OpenCertificateDialog: TOpenDialog;
    TabSheetSigningPropertiesSelect: TTabSheet;
    Label3: TLabel;
    RadioButtonMD5: TRadioButton;
    RadioButtonSHA1: TRadioButton;
    TabSheetSignPreview: TTabSheet;
    Label4: TLabel;
    Memo: TMemo;
    TabSheetProcess: TTabSheet;
    Label5: TLabel;
    Label6: TLabel;
    EditDescription: TEdit;
    Label7: TLabel;
    EditURL: TEdit;
    TabSheetFinished: TTabSheet;
    LabelFinished: TLabel;
    ImageSuccess: TImage;
    ImageWarning: TImage;
    TabSheetVerifyResults: TTabSheet;
    TreeViewResults: TTreeView;
    Label8: TLabel;
    ImageList: TImageList;
    RadioButtonRemove: TRadioButton;
    cbTimestamp: TCheckBox;
    Label9: TLabel;
    EditTSPURL: TEdit;
    HTTPSClient: TElHTTPSClient;
    procedure ButtonCancelClick(Sender: TObject);
    procedure ButtonNextClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ButtonBackClick(Sender: TObject);
    procedure ButtonBrowseClick(Sender: TObject);
    procedure ButtonAddCertificateClick(Sender: TObject);
    procedure ButtonRemoveCertificateClick(Sender: TObject);
    procedure ElAuthenticodeSignerTimestampNeeded(Sender: TObject;
      const Request: ByteArray; var Reply: ByteArray;
      var Succeeded: Boolean);
  private
    CurrentState : TState;
    procedure ChangeState(S : TState);
    procedure SetupButtons;
    procedure SetupView;
    function RequestPassword : string;
    function CertificateWithPrivateKeyExists: boolean;
    procedure OutputSignParameters;
    function PerformSign : integer;
    function PerformVerify : integer;
    function PerformRemoval : integer;
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;

implementation

uses PasswordForm;

{$R *.DFM}

procedure TFormMain.ButtonCancelClick(Sender: TObject);
begin
  FormMain.Close;
end;

procedure TFormMain.ButtonNextClick(Sender: TObject);
var
  R : integer;
begin
  case CurrentState of
    stIntro :
    begin
      if RadioButtonSign.Checked then
        ChangeState(stSelectExecutableForSigning)
      else
      if RadioButtonVerify.Checked then
        ChangeState(stSelectExecutableForVerifying)
      else
      if RadioButtonRemove.Checked then
        ChangeState(stSelectExecutableForRemoval);
    end;
    stSelectExecutableForSigning :
    begin
      if not FileExists(EditPath.Text) then
        MessageDlg('The specified file is not accessible', mtError, [mbOk], 0)
      else
        ChangeState(stSelectCertificates);
    end;
    stSelectExecutableForVerifying :
    begin
      if not FileExists(EditPath.Text) then
        MessageDlg('The specified file is not accessible', mtError, [mbOk], 0)
      else
      begin
        ChangeState(stVerifyProcess);
        R := PerformVerify;
        if R = 0 then
          ChangeState(stVerifyResults)
        else
        begin
          LabelFinished.Caption := 'Verification failed with error ' + IntToHex(R, 8);
          ChangeState(stFinished);
          ImageWarning.Visible := true;
        end;
      end;
    end;
    stSelectExecutableForRemoval :
    begin
      if not FileExists(EditPath.Text) then
        MessageDlg('The specified file is not accessible', mtError, [mbOk], 0)
      else
      begin
        ChangeState(stRemovalProcess);
        R := PerformRemoval;
        if R = 0 then
          LabelFinished.Caption := 'Removal succeeded'
        else
        begin
          LabelFinished.Caption := 'Removal failed with error ' + IntToHex(R, 8);
          ImageWarning.Visible := true;
        end;
        ChangeState(stFinished);
      end;
    end;
    stSelectCertificates :
    begin
      if not CertificateWithPrivateKeyExists then
        MessageDlg('At least one of selected certificates should have the corresponding private key',
          mtError, [mbOk], 0)
      else
        ChangeState(stSelectSigningProperties);
    end;
    stSelectSigningProperties :
    begin
      ChangeState(stSignPreview);
    end;
    stSignPreview :
    begin
      ChangeState(stSignProcess);
      R := PerformSign;
      ChangeState(stFinished);
      if R = 0 then
      begin
        LabelFinished.Caption := 'Signing operation successfully finished';
        ImageSuccess.Visible := true;
      end
      else
      begin
        LabelFinished.Caption := 'Signing process failed with error ' + IntToHex(R, 8);
        ImageWarning.Visible := true;
      end;
    end;
  end;
end;

procedure TFormMain.ButtonBackClick(Sender: TObject);
begin
  case CurrentState of
    stSelectExecutableForSigning,
    stSelectExecutableForRemoval,
    stSelectExecutableForVerifying:
      ChangeState(stIntro);
    stSelectCertificates:
      ChangeState(stSelectExecutableForSigning);
    stVerify:
      ChangeState(stSelectExecutableForVerifying);
    stSelectSigningProperties:
      ChangeState(stSelectCertificates);
    stSignPreview:
      ChangeState(stSelectSigningProperties);
    stSignProcess:
      ChangeState(stSignPreview);
  end;
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  EditPath.Text := '';
  ChangeState(stIntro);
end;

procedure TFormMain.ChangeState(S : TState);
begin
  CurrentState := S;
  SetupView;
  SetupButtons;
end;

procedure TFormMain.SetupButtons;
begin
  ButtonBack.Enabled := CurrentState in [stSelectExecutableForSigning,
    stSelectExecutableForVerifying, stSelectExecutableForRemoval, stSelectCertificates, stSelectSigningProperties,
    stSignPreview];
  ButtonNext.Enabled := CurrentState in [stIntro, stSelectExecutableForSigning,
    stSelectExecutableForVerifying, stSelectExecutableForRemoval, stSelectCertificates, stSelectSigningProperties,
    stSignPreview];
end;

procedure TFormMain.SetupView;
begin
  if CurrentState = stIntro then
    PageControl.ActivePage := TabSheetIntro
  else if CurrentState in [stSelectExecutableForSigning, stSelectExecutableForVerifying, stSelectExecutableForRemoval] then
    PageControl.ActivePage := TabSheetFileSelect
  else if CurrentState = stSelectCertificates then
    PageControl.ActivePage := TabSheetCertificatesSelect
  else if CurrentState = stSelectSigningProperties then
    PageControl.ActivePage := TabSheetSigningPropertiesSelect
  else if CurrentState = stSignPreview then
  begin
    PageControl.ActivePage := TabSheetSignPreview;
    OutputSignParameters;
  end
  else if (CurrentState = stSignProcess) or (CurrentState = stVerifyProcess) then
  begin
    PageControl.ActivePage := TabSheetProcess;
  end
  else if CurrentState = stFinished then
  begin
    ButtonCancel.Caption := 'Finish';
    ButtonCancel.Default := true;
    ImageWarning.Visible := false;
    ImageSuccess.Visible := false;
    PageControl.ActivePage := TabSheetFinished;
  end
  else if CurrentState = stVerifyResults then
  begin
    PageControl.ActivePage := TabSheetVerifyResults;
    ButtonCancel.Caption := 'Finish';
    ButtonCancel.Default := true;
  end;
  if CurrentState = stSelectExecutableForSigning then
    LabelSelectFilePrompt.Caption := 'Please select the executable file to be signed:'
  else
  if CurrentState = stSelectExecutableForVerifying then
    LabelSelectFilePrompt.Caption := 'Please select the executable file to be verified:'
  else
  if CurrentState = stSelectExecutableForRemoval then
    LabelSelectFilePrompt.Caption := 'Please select the executable file to remove the signature from:';
end;
           
procedure TFormMain.ButtonBrowseClick(Sender: TObject);
begin
  if OpenDialog.Execute then
    EditPath.Text := OpenDialog.Filename;
end;

procedure TFormMain.ButtonAddCertificateClick(Sender: TObject);
var
  Cert : TElX509Certificate;
  F : TFileStream;
  Msg, Pass : string;
  Success : boolean;
  Code : integer;
  Item : TListItem;
begin
  if OpenCertificateDialog.Execute then
  begin
    try
      F := TFileStream.Create(OpenCertificateDialog.Filename, fmOpenRead);
    except
      MessageDlg('The certificate file is not accessible', mtError, [mbOk], 0);