mainform.pas

著名的SecureBlackBox控件完整源码

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, ExtCtrls, SBMessages, SBX509, SBCustomCertStorage,
  SBUtils;

type
  TfrmMain = class(TForm)
    PageControl: TPageControl;
    pBottom: TPanel;
    btnClose: TButton;
    tabSign: TTabSheet;
    tabVerify: TTabSheet;
    gbCSProps: TGroupBox;
    lblSigFile: TLabel;
    editSigFile: TEdit;
    btnBrowseSigFile: TButton;
    lblCertFile: TLabel;
    editCertFile: TEdit;
    btnBrowseCertFile: TButton;
    lblCertPass: TLabel;
    editCertPass: TEdit;
    lblOutputFile: TLabel;
    editOutputFile: TEdit;
    btnBrowseOutputFile: TButton;
    btnCountersign: TButton;
    OpenDialog: TOpenDialog;
    OpenDialogCert: TOpenDialog;
    SaveDialog: TSaveDialog;
    gbCVProps: TGroupBox;
    Label1: TLabel;
    editCountersignedFile: TEdit;
    btnBrowseCountersignature: TButton;
    Label2: TLabel;
    lvSigProps: TListView;
    btnVerify: TButton;
    procedure btnBrowseSigFileClick(Sender: TObject);
    procedure btnBrowseCertFileClick(Sender: TObject);
    procedure btnBrowseOutputFileClick(Sender: TObject);
    procedure btnCountersignClick(Sender: TObject);
    procedure btnBrowseCountersignatureClick(Sender: TObject);
    procedure btnVerifyClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
  private
    procedure Countersign;
    procedure VerifyCountersignatures;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.DFM}

procedure TfrmMain.btnBrowseSigFileClick(Sender: TObject);
begin
  if OpenDialog.Execute then
    editSigFile.Text := OpenDialog.Filename;
end;

procedure TfrmMain.btnBrowseCertFileClick(Sender: TObject);
begin
  if OpenDialogCert.Execute then
    editCertFile.Text := OpenDialogCert.Filename;
end;

procedure TfrmMain.btnBrowseOutputFileClick(Sender: TObject);
begin
  if SaveDialog.Execute then
    editOutputFile.Text := SaveDialog.Filename;
end;

procedure TfrmMain.btnCountersignClick(Sender: TObject);
begin
  Countersign;
end;

procedure TfrmMain.btnBrowseCountersignatureClick(Sender: TObject);
begin
  if OpenDialog.Execute then
    editCountersignedFile.Text := OpenDialog.Filename;
end;

procedure TfrmMain.btnVerifyClick(Sender: TObject);
begin
  VerifyCountersignatures;
end;

procedure TfrmMain.Countersign;
var
  Signer : TElMessageSigner;
  CertStorage : TElMemoryCertStorage;
  F : TFileStream;
  InBuf, OutBuf : ByteArray;
  OutSize : integer;
  R : integer;
begin
  Signer := TElMessageSigner.Create(nil);
  CertStorage := TElMemoryCertStorage.Create(nil);
  try
    F := TFileStream.Create(editCertFile.Text, fmOpenRead);
    try
      R := CertStorage.LoadFromStreamPFX(F, editCertPass.Text);
    finally
      FreeAndNil(F);
    end;
    if R <> 0 then
    begin
      MessageDlg('Failed to load certificate, error ' + IntToHex(R, 4), mtError, [mbOk], 0);
      Exit;
    end;
    F := TFileStream.Create(editSigFile.Text, fmOpenRead);
    try
      SetLength(InBuf, F.Size);
      F.Read(InBuf[0], Length(InBuf));
    finally
      FreeAndNil(F);
    end;
    Signer.CertStorage := CertStorage;
    OutSize := 0;
    Signer.Countersign(@InBuf[0], Length(InBuf), nil, OutSize);
    SetLength(OutBuf, OutSize);
    R := Signer.Countersign(@InBuf[0], Length(InBuf), @OutBuf[0], OutSize);
    if R = 0 then
    begin
      F := TFileStream.Create(editOutputFile.Text, fmCreate);
      try
        F.Write(OutBuf[0], OutSize);
      finally
        FreeAndNil(F);
      end;
      MessageDlg('Countersigning succeeded', mtInformation, [mbOk], 0);
    end
    else
      MessageDlg('Failed to countersign the signature, error ' + IntToHex(R, 4),
        mtError, [mbOk], 0);
  finally
    FreeAndNil(Signer);
    FreeAndNil(CertStorage);
  end;
end;

procedure TfrmMain.VerifyCountersignatures;
var
  Verifier : TElMessageVerifier;
  F : TFileStream;
  InBuf, OutBuf : ByteArray;
  OutSize : integer;
  R, I, J : integer;
  CertID : string;
  procedure AddPropertyValue(const Prop, Value: string);
  var
    Item : TListItem;
  begin
    Item := lvSigProps.Items.Add;
    Item.Caption := Prop;
    Item.SubItems.Add(Value);
  end;
begin
  lvSigProps.Items.Clear;
  Verifier := TElMessageVerifier.Create(nil);
  try
    F := TFileStream.Create(editCountersignedFile.Text, fmOpenRead);
    try
      SetLength(InBuf, F.Size);
      F.Read(InBuf[0], Length(InBuf));
    finally
      FreeAndNil(F);
    end;
    Verifier.VerifyCountersignatures := true;
    OutSize := 0;
    Verifier.Verify(@InBuf[0], Length(InBuf), nil, OutSize);
    SetLength(OutBuf, OutSize);
    R := Verifier.Verify(@InBuf[0], Length(InBuf), @OutBuf[0], OutSize);
    AddPropertyValue('Verification result', '0x' + IntToHex(R, 4));
    AddPropertyValue('Countersignatures count', IntToStr(Verifier.CountersignatureCertIDCount));
    for I := 0 to Verifier.CountersignatureCertIDCount - 1 do
    begin
      CertID := '';
      for J := 0 to Verifier.CountersignatureCertIDs[I].Issuer.Count - 1 do
        CertID := CertID + Verifier.CountersignatureCertIDs[I].Issuer.Values[J] + ', ';
      CertID := CertID + 'Validity: 0x' + IntToHex(Verifier.CountersignatureVerificationResults[I], 4);
      AddPropertyValue('Countersignature #' + IntToStr(I), CertID);
    end;
    MessageDlg('Verification finished', mtInformation, [mbOk], 0);
  finally
    FreeAndNil(Verifier);
  end;
end;

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


initialization

SetLicenseKey('ADDCD14AD06709806817E0B3D7BFD0A2222D536FE156466C5D5FE65DB5DEAE76' + 
  'FFDEBC07E915A5751C12C01C783958872A38E4A5EDA140E7247E0F2E56442A3C' + 
  'F3E9347AD8FDE52083A0DFC86BC00ECB0FD0CF1B51159A2BCB84F6EA6349EF47' + 
  '5C15A59AFCC55F7C3AAD26C279628B5D91B1DC94BD2385354A70CCA3B76101D9' + 
  'F41C84A639FC3CCE4BA8F0CC4A66DCD150114A3F58C1AD46B7B94643741BC20A' + 
  '8DCA83AB921480951B423CAA19EF1863A47CA2C3422E7E5634BED98939A5AE43' + 
  'DE1E4BAD79E66D8A5C973B3455656C8C9B6FF024FADD6CDA02D0F506D98493C8' + 
  'BD1ED7B237DB75FA31F2C82654490CDDDEE24E19939137B9E1DB05508733B22F');

end.