mainform.pas

著名的SecureBlackBox控件完整源码

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, SBPDF, SBPDFSecurity, SBX509, SBCustomCertStorage, SBUtils,
  SBWinCertStorage, SBTSPCommon, SBTSPClient, SBHTTPTSPClient, SBSimpleSSL,
  SBHTTPSClient, SBConstants;

type
  TfrmMain = class(TForm)
    lSource: TLabel;
    editSource: TEdit;
    lDest: TLabel;
    editDest: TEdit;
    btnBrowseSource: TButton;
    btnBrowseDest: TButton;
    gbSigProps: TGroupBox;
    btnOK: TButton;
    btnCancel: TButton;
    editCert: TEdit;
    btnBrowseCert: TButton;
    lCertPassword: TLabel;
    editCertPassword: TEdit;
    lSignatureType: TLabel;
    cbSignatureType: TComboBox;
    lAuthorName: TLabel;
    editAuthorName: TEdit;
    lReason: TLabel;
    cbReason: TComboBox;
    OpenDialogPDF: TOpenDialog;
    SaveDialogPDF: TSaveDialog;
    OpenDialogCert: TOpenDialog;
    Document: TElPDFDocument;
    PublicKeyHandler: TElPDFPublicKeySecurityHandler;
    CertStorage: TElMemoryCertStorage;
    comboCertificate: TComboBox;
    rbWindowsCert: TRadioButton;
    rbFileCert: TRadioButton;
    WinCertStorage: TElWinCertStorage;
    cbTimestamp: TCheckBox;
    editTimestampServer: TEdit;
    HTTPClient: TElHTTPSClient;
    TSPClient: TElHttpTSPClient;
    lFont: TLabel;
    cbFont: TComboBox;
    procedure btnBrowseSourceClick(Sender: TObject);
    procedure btnBrowseDestClick(Sender: TObject);
    procedure btnBrowseCertClick(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure comboCertificateChange(Sender: TObject);
  private
    function GenerateTempFilename : string;
  protected
    procedure AddTrueTypeFont(const FontName: string; Wid: TElPDFSignatureWidgetProps);
    procedure PopulateCertList;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.DFM}

function MultiByteToUTF8(const Str: string): string;
var
  WStr: WideString;
  Size, Sz: integer;
begin
  Result := '';
  Size := Length(Str);
  if Size <= 0 then
    Exit;

  SetLength(WStr, Size);
  Sz := MultiByteToWideChar(CP_ACP, 0, @Str[1], Size, @WStr[1], Size);
  SetLength(WStr, Sz);
  Size := Length(WStr);
  if Size <= 0 then
    Exit;

  Sz := WideCharToMultiByte(CP_UTF8, 0, @WStr[1], Size, nil, 0, nil, nil);
  SetLength(Result, Sz);
  Sz := WideCharToMultiByte(CP_UTF8, 0, @WStr[1], Size, @Result[1], Length(Result),
    nil, nil);
  SetLength(Result, Sz);
end;

procedure TfrmMain.btnBrowseSourceClick(Sender: TObject);
begin
  if OpenDialogPDF.Execute then
    editSource.Text := OpenDialogPDF.Filename;
end;

procedure TfrmMain.btnBrowseDestClick(Sender: TObject);
begin
  if SaveDialogPDF.Execute then
    editDest.Text := SaveDialogPDF.Filename;
end;

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

function TfrmMain.GenerateTempFilename : string;
var
  Needed : DWORD;
  Path : string;
  Index : integer;
const
  SBB : string = 'sbb'#0;
begin
  Needed := GetTempPathA(0, nil);
  SetLength(Path, Needed);
  Needed := GetTempPathA(Needed, @Path[1]);
  if Needed = 0 then
    raise Exception.Create('Failed to get temporary path');
  SetLength(Result, MAX_PATH);
  if GetTempFileNameA(@Path[1], @SBB[1], 0, @Result[1]) = 0 then
    raise Exception.Create('Failed to generate a temporary file name');
  Index := Pos(#0, Result);
  Result := Copy(Result, 1, Index - 1);
end;

procedure TfrmMain.AddTrueTypeFont(const FontName: string; Wid: TElPDFSignatureWidgetProps);
var
  Font0: TElPDFCompositeFont;
  CIDFont: TElPDFCIDFont;
  FontDescriptor: TElPDFCIDFontDescriptor;
  SystemInfo: TElPDFCIDSystemInfo;
  Stream: TFileStream;
  F: TextFile;
  Buf: ByteArray;
  FontsFolder, s: string;
  i, CIDFirst, CIDLast, Width: Integer;
begin
  Font0 := TElPDFCompositeFont.Create;
  CIDFont := TElPDFCIDFont.Create;
  SystemInfo := TElPDFCIDSystemInfo.Create;
  FontDescriptor := TElPDFCIDFontDescriptor.Create;

  // To embed .TTF files, you need to extract the font metrics
  FontsFolder := ExtractFilePath(Application.ExeName) + '\Fonts\';
  if FontName = 'FreeSerif' then
  begin
    FontDescriptor.Ascent := 1166;
    FontDescriptor.Descent := -446;
    FontDescriptor.CapHeight := 1166;
    FontDescriptor.Flags := 32;
    FontDescriptor.FontBBoxX1 := -672;
    FontDescriptor.FontBBoxY1 := -446;
    FontDescriptor.FontBBoxX2 := 1588;
    FontDescriptor.FontBBoxY2 := 1166;
    FontDescriptor.ItalicAngle := 0;
    FontDescriptor.StemV := 70;
    FontDescriptor.MissingWidth := 700;

    Stream := TFileStream.Create(FontsFolder + FontName + '.ttf', fmOpenRead);
    SetLength(Buf, Stream.Size);
    Stream.Read(Buf[0], Length(Buf));
    Stream.Free;
    FontDescriptor.FontFile2 := Buf;

    CIDFont.DW := 700;
    AssignFile(F, FontsFolder + FontName + '.w');
    Reset(F);
    while not EOF(F) do
    begin
      ReadLn(F, s);
      s := Trim(s);
      if s = '' then
        Continue;

      i := Pos(' ', s);
      if i > 0 then
      begin
        CIDFirst := StrToInt(Copy(s, 1, i - 1));
        s := Copy(s, i + 1, MaxInt);
        i := Pos(' ', s);
        if i > 0 then
        begin
          CIDLast := StrToInt(Copy(s, 1, i - 1));
          Width := StrToInt(Copy(s, i + 1, MaxInt));
          CIDFont.W.AddRange(CIDFirst, CIDLast, Width);
        end
        else
        begin
          Width := StrToInt(s);
          CIDFont.W.Add(CIDFirst, Width);
        end;
      end;
    end;
    CloseFile(F);

    Stream := TFileStream.Create(FontsFolder + FontName + '.ctg', fmOpenRead);
    Buf := nil;
    SetLength(Buf, Stream.Size);
    Stream.Read(Buf[0], Length(Buf));
    Stream.Free;
    CIDFont.CIDToGIDMapData := Buf;
  end;

  Font0.BaseFont := FontName;
  Font0.Encoding := 'Identity-H';
  Font0.ResourceName := 'T1_0'; // the name of font resource used by default signature widget
  Font0.DescendantFonts := CIDFont;
  SystemInfo.Registry := 'Adobe';
  SystemInfo.Ordering := 'UCS';
  FontDescriptor.FontName := FontName;
  CIDFont.Subtype := 'CIDFontType2';
  CIDFont.BaseFont := FontName;
  CIDFont.CIDSystemInfo := SystemInfo;
  CIDFont.FontDescriptor := FontDescriptor;

  Wid.AddFont(Font0);
  Wid.AddFont(CIDFont);
  Wid.AddFontObject(SystemInfo);
  Wid.AddFontObject(FontDescriptor);
end;

procedure TfrmMain.btnOKClick(Sender: TObject);
var
  TempPath : string;
  Success : boolean;
  F, CertF : TFileStream;
  Index : integer;
  Sig : TElPDFSignature;
  CertFormat : TSBCertFileFormat;
  Cert : TElX509Certificate;
  SimpleFont: TElPDFSimpleFont;
begin
  // creating a temporary file copy
  TempPath := GenerateTempFilename;
  if not CopyFile(PChar(editSource.Text), PChar(TempPath), false) then
  begin
    MessageDlg('Failed to create a temporary file', mtError, [mbOk], 0);
    Exit;
  end;
  // opening the temporary file
  Success := false;
  F := TFileStream.Create(TempPath, fmOpenReadWrite or fmShareDenyWrite);
  try
    try
      // opening the document
      Document.Open(F);
      try
        // checking if the document is already encrypted
        if Document.Encrypted then
        begin
          MessageDlg('Cannot sign the encrypted document', mtError, [mbOk], 0);
          Exit;
        end;
        // adding the signature and setting up property values
        Index := Document.AddSignature;
        Sig := Document.Signatures[Index];
        Sig.Handler := PublicKeyHandler;
        Sig.AuthorName := MultiByteToUTF8(editAuthorName.Text);
        Sig.SigningTime := Now;
        if CompareStr(cbReason.Text, '<none>') <> 0 then
          Sig.Reason := MultiByteToUTF8(cbReason.Text)
        else
          Sig.Reason := '';

        // configuring signature type
        Sig.SignatureType := stDocument;
        case cbSignatureType.ItemIndex of
          0 : // invisible document signature
            Sig.Invisible := true;
          1 : // visible document signature
            Sig.Invisible := false;
          2 :
          begin
            Sig.SignatureType := stMDP;
            Sig.Invisible := false;
          end;
        end;

        if not Sig.Invisible then
        begin
          if (cbFont.Text = 'Free Serif, Unicode') then
          begin
            AddTrueTypeFont('FreeSerif', Sig.WidgetProps);
          end
          else
          if (cbFont.Text = '') or (cbFont.Text = 'Helvetica') then
            // Helvetica font is default
          else
          begin
            SimpleFont := TElPDFSimpleFont.Create;
            SimpleFont.BaseFont := cbFont.Text;
            Sig.WidgetProps.AddFont(SimpleFont);
          end;
        end;

        // retrieving signing certificate
        CertStorage.Clear;
        PublicKeyHandler.SignatureType := pstPKCS7SHA1;
        if rbFileCert.Checked then
        begin
          Cert := TElX509Certificate.Create(nil);
          try
            // loading certificate
            CertF := TFileStream.Create(editCert.Text, fmOpenRead or fmShareDenyWrite);
            try
              CertFormat := Cert.DetectCertFileFormat(CertF);
              CertF.Position := 0;
              case CertFormat of
                cfDER : Cert.LoadFromStream(CertF);
                cfPEM : Cert.LoadFromStreamPEM(CertF, editCertPassword.Text);
                cfPFX : Cert.LoadFromStreamPFX(CertF, editCertPassword.Text);
                else
                begin
                  MessageDlg('Failed to load certificate', mtError, [mbOk], 0);
                  Exit;
                end;
              end;
            finally
              FreeAndNil(CertF);
            end;
            CertStorage.Add(Cert);
          finally
            Cert.Free;
          end;
        end
        else
        begin
          Cert := WinCertStorage.Certificates[comboCertificate.ItemIndex];
          CertStorage.Add(Cert);
	        PublicKeyHandler.SignatureType := pstPKCS7SHA1;
        end;
        PublicKeyHandler.CertStorage := CertStorage;
        PublicKeyHandler.CustomName := 'Adobe.PPKMS';
        
        // configuring timestamping properties
        if (cbTimestamp.Checked) then
        begin
          TSPClient.HttpClient := HTTPClient;
          TSPClient.URL := editTimestampServer.Text;
          TSPClient.HashAlgorithm := SB_ALGORITHM_DGST_SHA1;
          PublicKeyHandler.TSPClient := TSPClient;
        end;

        // allowing to save the document
        Success := true;
      finally
        // closing the document
        Document.Close(Success);
      end;
    finally
      FreeAndNil(F);
    end;
  except
    on E : Exception do
    begin
      MessageDlg('Error: ' + E.Message, mtError, [mbOk], 0);
      Success := false;
    end;
  end;
  // if signing process succeeded, moving the temporary file to the place
  // of destination file
  if Success then
  begin
    if not CopyFile(PChar(TempPath), PChar(editDest.Text), false) then
      MessageDlg('Failed to save temporary file', mtError, [mbOk], 0)
    else
      MessageDlg('Signing process successfully finished', mtInformation, [mbOk], 0);
  end
  (*
  else
    MessageDlg('Signing failed', mtError, [mbOk], 0)
  *);
  // deleting temporary file
  DeleteFile(TempPath);
  Close();
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  cbSignatureType.ItemIndex := 0;
  PopulateCertList;
end;

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

procedure TfrmMain.PopulateCertList;
var i : integer;
    Cert : TElX509Certificate;
begin
  rbWindowsCert.Enabled := WinCertStorage.Count > 0;
  for i := 0 to WinCertStorage.Count - 1 do
  begin
    Cert := WinCertStorage.Certificates[i];
    ComboCertificate.Items.Add('Subject: ' + Cert.SubjectName.CommonName + ', Issuer: ' + Cert.IssuerName.CommonName);
  end;
end;

procedure TfrmMain.comboCertificateChange(Sender: TObject);
begin
  if comboCertificate.ItemIndex = -1 then
    rbwindowsCert.Checked := false;
end;

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

end.