xadesform.pas

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

unit XAdESForm;

interface

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

type
  TfrmXAdES = class(TForm)
    cbTimestamp: TCheckBox;
    edTimestampServer: TEdit;
    pProductionPlace: TPanel;
    cbProductionPlace: TCheckBox;
    lbCity: TLabel;
    edCity: TEdit;
    lbStateOrProvince: TLabel;
    edStateOrProvince: TEdit;
    lbPostalCode: TLabel;
    edPostalCode: TEdit;
    lbCountry: TLabel;
    edCountry: TEdit;
    btnOK: TButton;
    cbXAdES: TCheckBox;
    gbPolicyId: TGroupBox;
    lbDescription: TLabel;
    edDescription: TEdit;
    lbDocumentationReference: TLabel;
    edDocumentationReference: TEdit;
    lbIdentifier: TLabel;
    edIdentifier: TEdit;
    lbIdentifierQualifier: TLabel;
    edIdentifierQualifier: TEdit;
    lbSignedTime: TLabel;
    lbTimestamp: TLabel;
    lbTimestampSerial: TLabel;
    gbSigningCertificates: TGroupBox;
    lvSigningCertificates: TListView;
    btnRemove: TButton;
    btnAdd: TButton;
    DlgOpen: TOpenDialog;
    procedure cbProductionPlaceClick(Sender: TObject);
    procedure btnAddClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnRemoveClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    FCertStorage: TElMemoryCertStorage;
    FCertIDs: TElXMLCertIDList;
    FVerify : Boolean;

    function GetXAdESEnabled: Boolean;
    procedure SetVerify(const Value: Boolean);
    procedure UpdateCertificates;
  public
    property XAdESEnabled : Boolean read GetXAdESEnabled;
    property CertStorage : TElMemoryCertStorage read FCertStorage;
    property CertIDs : TElXMLCertIDList read FCertIDs write FCertIDs;
    property Verify : Boolean write SetVerify;
  end;

var
  frmXAdES: TfrmXAdES;

function GetOIDValue(NTS: TElRelativeDistinguishedName; const S: BufferType; const Delimeter: AnsiString = ' / '): AnsiString;

implementation

{$R *.DFM}

function GetOIDValue(NTS: TElRelativeDistinguishedName; const S: BufferType; const Delimeter: AnsiString = ' / '): AnsiString;
var
  i: Integer;
  t: AnsiString;
begin
  Result := '';
  for i := 0 to NTS.Count - 1 do
    if CompareContent(S, NTS.OIDs[i]) then
    begin
      t := AnsiString(NTS.Values[i]);
      if t = '' then
        Continue;

      if Result = '' then
      begin
        Result := t;
        if Delimeter = '' then
          Exit;
      end
      else
        Result := Result + Delimeter + t;
    end;
end;

procedure TfrmXAdES.cbProductionPlaceClick(Sender: TObject);
var
  Enable : Boolean;
begin
  Enable := cbProductionPlace.Checked;
  edCountry.Enabled := Enable;
  lbCountry.Enabled := Enable;
  edPostalCode.Enabled := Enable;
  lbPostalCode.Enabled := Enable;
  edStateOrProvince.Enabled := Enable;
  lbStateOrProvince.Enabled := Enable;
  edCity.Enabled := Enable;
  lbCity.Enabled := Enable;
end;

function TfrmXAdES.GetXAdESEnabled: Boolean;
begin
  Result := cbXAdES.Checked;
end;

procedure TfrmXAdES.SetVerify(const Value: Boolean);
begin
  FVerify := Value;
  cbTimestamp.Visible := not Value;
  edTimestampServer.Visible := not Value;
  btnAdd.Enabled := not Value;
  btnRemove.Enabled := not Value;

  lbSignedTime.Visible := Value;
  lbTimestamp.Visible := Value;
  lbTimestampSerial.Visible := Value;
end;

procedure TfrmXAdES.btnAddClick(Sender: TObject);
var
  F : TFileStream;
  Cert : TElX509Certificate;
  CertFormat : TSBCertFileFormat;
begin
  DlgOpen.Title := 'Select certificate file';
  DlgOpen.Filter := 'PEM-encoded certificate (*.pem)|*.PEM|DER-encoded certificate (*.cer)|*.CER|PFX-encoded certificate (*.pfx)|*.PFX';
  if DlgOpen.Execute then
  begin
    F := TFileStream.Create(DlgOpen.Filename, fmOpenRead or fmShareDenyWrite);
    try
      Cert := TElX509Certificate.Create(nil);
      try
        CertFormat := Cert.DetectCertFileFormat(F);
        F.Position := 0;
        case CertFormat of
          cfDER : Cert.LoadFromStream(F);
          cfPEM : Cert.LoadFromStreamPEM(F, InputBox('Please enter passphrase:', '',''));
          cfPFX : Cert.LoadFromStreamPFX(F, InputBox('Please enter passphrase:', '',''));
        else
          begin
            MessageDlg('Failed to load certificate', mtError, [mbOk], 0);
            FreeAndNil(Cert);
            Exit;
          end;
        end;
      except
        FreeAndNil(Cert);
      end;

      FCertStorage.Add(Cert);
    finally
      FreeAndNil(F);
    end;
  end;

  UpdateCertificates;
end;

procedure TfrmXAdES.FormCreate(Sender: TObject);
begin
  FCertStorage := TElMemoryCertStorage.Create(nil);
end;

procedure TfrmXAdES.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FCertStorage);
end;

procedure TfrmXAdES.btnRemoveClick(Sender: TObject);
begin
  if Assigned(lvSigningCertificates.Selected) then
  begin
    FCertStorage.Remove(FCertStorage.IndexOf(TElX509Certificate(lvSigningCertificates.Selected.Data)));
    UpdateCertificates;
  end;
end;

procedure TfrmXAdES.UpdateCertificates;
var
  Item: TListItem;
  B: BufferType;
  i: Integer;
  s: string;
begin
  lvSigningCertificates.Items.BeginUpdate;
  lvSigningCertificates.Items.Clear;
  if not FVerify then
    for i := 0 to FCertStorage.Count - 1 do
    begin
      s := GetOIDValue(FCertStorage.Certificates[i].IssuerRDN, SB_CERT_OID_COMMON_NAME);
      if s = '' then
        s := GetOIDValue(FCertStorage.Certificates[i].IssuerRDN, SB_CERT_OID_ORGANIZATION);

      if s = '' then
        s := '<unknown>';

      B := FCertStorage.Certificates[i].SerialNumber;
      Item := lvSigningCertificates.Items.Add;
      Item.Caption := BeautifyBinaryString(BinaryToString({$IFDEF DELPHI_NET}B{$ELSE}@B[1], Length(B){$ENDIF}), ' ');
      Item.SubItems.Add(s);
      Item.Data := FCertStorage.Certificates[i];
    end
  else
  if Assigned(FCertIDs) then
    for i := 0 to FCertIDs.Count - 1 do
    begin
      s := GetOIDValue(FCertIDs.CertIDs[i].IssuerSerial.IssuerRDN, SB_CERT_OID_COMMON_NAME);
      if s = '' then
        s := GetOIDValue(FCertIDs.CertIDs[i].IssuerSerial.IssuerRDN, SB_CERT_OID_ORGANIZATION);

      if s = '' then
        s := '<unknown>';

      B := FCertIDs.CertIDs[i].IssuerSerial.SerialNumber;
      Item := lvSigningCertificates.Items.Add;
      Item.Caption := BeautifyBinaryString(BinaryToString({$IFDEF DELPHI_NET}B{$ELSE}@B[1], Length(B){$ENDIF}), ' ');
      Item.SubItems.Add(s);
    end;

  lvSigningCertificates.Items.EndUpdate;
end;

procedure TfrmXAdES.FormShow(Sender: TObject);
begin
  UpdateCertificates;
end;

end.