frmmain.pas

著名的SecureBlackBox控件完整源码

unit frmMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, SBConstants, SBX509, SBX509Ext, SBPKCS12, SBCustomCertStorage, SBWinCertStorage,
  Grids,  Menus, GenerateCert, ToolWin, ExtCtrls, Buttons, SelectStorage, ComCtrls,
  ActnList, ImgList, SBRDN, SBMessages;

type
  TMainForm = class(TForm)
    OpenDlgCert: TOpenDialog;
    saveDlgCert: TSaveDialog;
    sbStatus: TStatusBar;
    OpenDlgStorage: TOpenDialog;
    SaveDlgStorage: TSaveDialog;
    mmMain: TMainMenu;
    mmiStorage: TMenuItem;
    mmiNewMemStorage: TMenuItem;
    mmiMountStorage: TMenuItem;
    mmiSaveStorage: TMenuItem;
    mmiSaveStorageAs: TMenuItem;
    mmiImportFromWinStorage: TMenuItem;
    mmiCertificate: TMenuItem;
    mmiRemoveCertificate: TMenuItem;
    mmiNewCertificate: TMenuItem;
    mmiSaveCertificate: TMenuItem;
    mmiLoadCertificate: TMenuItem;
    mmiValidate: TMenuItem;
    mmiLoadPrivateKey: TMenuItem;
    OpenDlgPvtKey: TOpenDialog;
    mmiUnmountStorage: TMenuItem;
    pmiMain: TPopupMenu;
    pmiNewMemoryStorage: TMenuItem;
    pmiMountStorage: TMenuItem;
    pmiSaveStorage: TMenuItem;
    pmiSaveStorageAs: TMenuItem;
    pmiImportFromWinStorage: TMenuItem;
    pmiUnmountStorage: TMenuItem;
    pmiNewCertificate: TMenuItem;
    pmiRemoveCertificate: TMenuItem;
    pmioLoadCertificate: TMenuItem;
    pmiSaveCertificate: TMenuItem;
    pmiValidate: TMenuItem;
    pmiLoadPrivateKey: TMenuItem;
    mmiMoveToStorage: TMenuItem;
    mmiCopyToStorage: TMenuItem;
    pmiMoveToStorage: TMenuItem;
    pmiCopyToStorage: TMenuItem;
    mmiExportToMemoryStorage: TMenuItem;
    pmiExportToMemoryStorage: TMenuItem;
    mmiNewFileStorage: TMenuItem;
    pmiNewFileStorage: TMenuItem;
    mmiSeparator1: TMenuItem;
    mmiSeparator2: TMenuItem;
    mmiSeparator5: TMenuItem;
    mmiSeparator6: TMenuItem;
    pmiSeparator1: TMenuItem;
    pmiSeparator2: TMenuItem;
    pmiSeparator3: TMenuItem;
    pmiSeparator5: TMenuItem;
    pmiSeparator6: TMenuItem;
    mmiSeparator3: TMenuItem;
    mmiExit: TMenuItem;
    mmiSeparator4: TMenuItem;
    mmiCreateCSR: TMenuItem;
    pmiSeparator4: TMenuItem;
    pmiCreateCSR: TMenuItem;
    alMain: TActionList;
    acNewMemStorage: TAction;
    acNewFileStorage: TAction;
    acSaveStorage: TAction;
    acSaveStorageAs: TAction;
    acMountStorage: TAction;
    acUnmountStorage: TAction;
    acImportFromWinStorage: TAction;
    acExportToMemoryStorage: TAction;
    acNewCertificate: TAction;
    acLoadCertificate: TAction;
    acSaveCertificate: TAction;
    acRemoveCertificate: TAction;
    acCreateCSR: TAction;
    acValidate: TAction;
    acLoadPrivateKey: TAction;
    acMoveToStorage: TAction;
    acCopyToStorage: TAction;
    treeCert: TTreeView;
    ilTree: TImageList;
    mmiHelp: TMenuItem;
    mmiAbout: TMenuItem;
    pcInfo: TPageControl;
    tsNoInfo: TTabSheet;
    tsCertificate: TTabSheet;
    imgCertificate: TImage;
    lblIssuedByLabel: TLabel;
    lnlIssuedToLabel: TLabel;
    lblIssuedBy: TLabel;
    lblIssuedTo: TLabel;
    memAdditional: TMemo;
    lblValidFromLabel: TLabel;
    lblValidFrom: TLabel;
    lblValidToLabel: TLabel;
    lblValidTo: TLabel;
    lvCertProperties: TListView;
    bvlCertInfoSeparator: TBevel;
    splTree: TSplitter;
    acTrusted: TAction;
    pmiTrusted: TMenuItem;
    mmiTrusted: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure mmiExitClick(Sender: TObject);
    procedure treeCertChange(Sender: TObject; Node: TTreeNode);
    procedure treeCertDeletion(Sender: TObject; Node: TTreeNode);
    procedure acNewMemStorageExecute(Sender: TObject);
    procedure acNewFileStorageExecute(Sender: TObject);
    procedure acSaveStorageExecute(Sender: TObject);
    procedure acSaveStorageAsExecute(Sender: TObject);
    procedure acMountStorageExecute(Sender: TObject);
    procedure acUnmountStorageExecute(Sender: TObject);
    procedure acImportFromWinStorageExecute(Sender: TObject);
    procedure acExportToMemoryStorageExecute(Sender: TObject);
    procedure acNewCertificateExecute(Sender: TObject);
    procedure acLoadCertificateExecute(Sender: TObject);
    procedure acSaveCertificateExecute(Sender: TObject);
    procedure acRemoveCertificateExecute(Sender: TObject);
    procedure acCreateCSRExecute(Sender: TObject);
    procedure acValidateExecute(Sender: TObject);
    procedure acLoadPrivateKeyExecute(Sender: TObject);
    procedure acMoveToStorageExecute(Sender: TObject);
    procedure acCopyToStorageExecute(Sender: TObject);
    procedure mmiAboutClick(Sender: TObject);
    procedure lvCertPropertiesChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure acTrustedExecute(Sender: TObject);
  private
  protected
    function DoCopyToStorage: Boolean;
    procedure LoadStorage(ParentNode: TTreeNode; StorageName: string;
      Storage: TElCustomCertStorage);
  public
    procedure DisplayCertificateInfo(Cert : TElX509Certificate);
  end;

var
  MainForm : TMainForm;
  Storage : TElCustomCertStorage;
  WinStorage1, WinStorage2, WinStorage3, WinStorage4 : TElWinCertStorage;
  GlobalCert : TElX509Certificate;
  GlobalPrivateKey : array[0..4095] of byte;
  PrivateKeySize : Word;
  StorageList : TList;
  CurrStorageName : TStringList;
  SelectedIndex : integer;

{$J+}

const StorageNumber : integer = 0;

implementation

uses
  SBPEM, SBUtils, AboutForm, ExtensionEncoder, uValidate;

{$R *.DFM}
//--------------- Helper function ------------------
// Get algorithm string
function GetEncryptionAlghorithm(Algorithm : integer) : string;
begin
  case (Algorithm) of
    SB_CERT_ALGORITHM_ID_RSA_ENCRYPTION     : Result := 'RSA';
    SB_CERT_ALGORITHM_MD2_RSA_ENCRYPTION    : Result := 'MD2 with RSA';
    SB_CERT_ALGORITHM_MD5_RSA_ENCRYPTION    : Result := 'MD5 with RSA';
    SB_CERT_ALGORITHM_SHA1_RSA_ENCRYPTION   : Result := 'SHA1 with RSA';
    SB_CERT_ALGORITHM_ID_DSA                : Result := 'DSA';
    SB_CERT_ALGORITHM_ID_DSA_SHA1           : Result := 'DSA with SHA1';
    SB_CERT_ALGORITHM_DH_PUBLIC             : Result := 'DH';
    SB_CERT_ALGORITHM_SHA224_RSA_ENCRYPTION : Result := 'SHA224 with RSA';
    SB_CERT_ALGORITHM_SHA256_RSA_ENCRYPTION : Result := 'SHA256 with RSA';
    SB_CERT_ALGORITHM_SHA384_RSA_ENCRYPTION : Result := 'SHA384 with RSA';
    SB_CERT_ALGORITHM_SHA512_RSA_ENCRYPTION : Result := 'SHA512 with RSA';
    SB_CERT_ALGORITHM_ID_RSAPSS             : Result := 'RSA-PSS';
    SB_CERT_ALGORITHM_ID_RSAOAEP            : Result := 'RSA-OAEP';
    SB_CERT_ALGORITHM_UNKNOWN               : Result := 'Unknown';
  end;
end;

//Get display name for certificate
function GetCertDisplayName(Cert : TelX509Certificate) : string;
begin
  try
    Result := GetOIDValue(Cert.SubjectRDN, SB_CERT_OID_COMMON_NAME);
    if Result = '' then
      Result := GetOIDValue(Cert.SubjectRDN, SB_CERT_OID_ORGANIZATION);
  except Result:=''; end;
end;
//-----------------------------

procedure TMainForm.LoadStorage(ParentNode : TTreeNode;StorageName : string;
  Storage : TElCustomCertStorage);
var C : integer;
    S : String;
    Cert : TElX509Certificate;
    StorageNode,TI : TTreeNode;
begin
  treeCert.Items.BeginUpdate;
  treeCert.Enabled := False;
  try
    // Add Storage node
    StorageNode:=treeCert.Items.AddChildObject(ParentNode, StorageName, Storage);
    StorageNode.ImageIndex:=2;
    StorageNode.SelectedIndex:=2;
    // Windows storages assumed as trusted
    if Storage is TElWinCertStorage then
    begin
      StorageNode.ImageIndex:=6;
      StorageNode.SelectedIndex:=6;
    end;
    StorageNode.Selected:=True;
    StorageList.Add(Storage);
    CurrStorageName.Add(StorageName);
    // Add certificates
    C := 0;
    while C < Storage.Count do
    begin
      try
        Cert := TElX509Certificate.Create(nil);
        Cert.Assign(Storage.Certificates[C]);
        S := GetCertDisplayName(Cert);

        TI:=treeCert.Items.AddChildObject(StorageNode, S, Cert);
        TI.ImageIndex:=3; TI.SelectedIndex:=3;

        Inc(C);
        sbStatus.Panels[0].Text := 'Loading Certificates ' + StorageName + '...'
          + IntToStr(C * 100 div Storage.Count) + '%';
        Application.ProcessMessages;
      except
        on E : Exception do  Application.ShowException(E);
      end;
    end;
  finally
    treeCert.Enabled := True;
    treeCert.Items.EndUpdate;
  end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
var i : integer;
begin
  // Hide tabs
  For i:=0 to pcInfo.PageCount - 1 do
    pcInfo.Pages[i].TabVisible:=False;
  GlobalCert := TElX509Certificate.Create(nil);
  WinStorage1 := TElWinCertStorage.Create(nil);
  WinStorage2 := TElWinCertStorage.Create(nil);
  WinStorage3 := TElWinCertStorage.Create(nil);
  WinStorage4 := TElWinCertStorage.Create(nil);
  StorageList := TList.Create;
  CurrStorageName := TStringList.Create;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  treeCert.Items.Clear;
  treeCert.Free;
  WinStorage1.Free;
  WinStorage2.Free;
  WinStorage3.Free;
  WinStorage4.Free;
  StorageList.Free;
  CurrStorageName.Free;
end;

procedure TMainForm.DisplayCertificateInfo(Cert : TElX509Certificate);
// Add new line to detail listview
procedure AddListValue(FieldName,Value : string;
  Additional : string = '';ImageIndex : integer= 4);
var LI : TListItem;
begin
  If (Trim(Value) = '') and (Trim(Additional)='') then exit;
  LI:=lvCertProperties.Items.Add;
  LI.Caption:=FieldName;
  LI.ImageIndex:=ImageIndex;
  LI.SubItems.Add(StringReplace(Value,#13#10,' ',[rfReplaceAll]));
  If Additional<> '' then LI.SubItems.Add(Additional)
    else LI.SubItems.Add(Value);
end;

function ConcateString(SrcSt,AddSt,SeparatorSt : string; AddToStart : boolean) : string;
begin
  Result:='';
  if SrcSt<>'' then begin
    if AddToStart then Result:=AddSt + SeparatorSt + SrcSt
     else Result:=SrcSt + SeparatorSt + AddSt;
  end else Result:=AddSt;
end;

// Add RDN to list
procedure AddRDN(FieldName : string;Data : TElRelativeDistinguishedName);
var i : integer;
    Value,Add,OIDString : string;
    AddToStart,CommonAdded : boolean;
begin
  Value:=''; Add:=''; CommonAdded:=False;
  for i:=0 to Data.Count - 1 do
  begin
    OIDString := GetStringByOID(Data.OIDs[i]);
    // Put common name as first. If no this - add Organization
    AddToStart := AnsiUpperCase(OIDString) = 'COMMONNAME';
    if AddToStart then CommonAdded:=True;
    if not CommonAdded then
      AddToStart := AnsiUpperCase(OIDString) = 'ORGANIZATION';
    Add:=ConcateString(Add,OIDString + ' = ' + Data.Values[i],#13#10,AddToStart);
    Value:=ConcateString(Value,Data.Values[i],',',AddToStart);
  end;
  AddListValue(FieldName,Value,Add);
end;

procedure DisplayExtensions(Cert : TelX509Certificate);
var i : integer;
// Add extension in a case that  Value <>''
procedure AddExtension(Name : string; Ext : TElCustomExtension;
  CheckValue : TSBCertificateExtension; ValueSt : string='');
begin
  If not (CheckValue in Cert.Extensions.Included) then exit;
  if ValueSt='' then
    AddListValue(Name,BuildHexString(Ext.Value),'',5)
  else AddListValue(Name,ValueSt,ValueSt,5); 
end;

begin
  // Extensions
  AddExtension('AuthorityInformationAccess',Cert.Extensions.AuthorityInformationAccess,
    ceAuthorityInformationAccess,GetAuthorityInformationAccess(Cert.Extensions.AuthorityInformationAccess));
  AddExtension('Authority Key Identifier',Cert.Extensions.AuthorityKeyIdentifier,
    ceAuthorityKeyIdentifier,GetAuthorityKeyIdentifierValue(Cert.Extensions.AuthorityKeyIdentifier));
  AddExtension('Basic constraints',Cert.Extensions.BasicConstraints,
    ceBasicConstraints,GetBasicConstraintValue(Cert.Extensions.BasicConstraints));
  AddExtension('CertificatePolicies',Cert.Extensions.CertificatePolicies,
    ceCertificatePolicies,GetCertificatePoliciesValue(Cert.Extensions.CertificatePolicies));
  AddExtension('CommonName',Cert.Extensions.CommonName,
    ceCommonName,Cert.Extensions.CommonName.Content);
  AddExtension('CRLDistributionPoints',Cert.Extensions.CRLDistributionPoints,
    ceCRLDistributionPoints,GetDistributionPointValue(Cert.Extensions.CRLDistributionPoints));
  // Extended key usage
  AddExtension('Extended key usage',Cert.Extensions.ExtendedKeyUsage,
    ceExtendedKeyUsage,GetExtendedKeyUsageValue(Cert.Extensions.ExtendedKeyUsage));
  AddExtension('IssuerAlternativeName',Cert.Extensions.IssuerAlternativeName,
    ceIssuerAlternativeName,GetIssuerAlternativeNameValue(Cert.Extensions.IssuerAlternativeName));
  // Key usage
  AddExtension('Key usage',Cert.Extensions.KeyUsage,
    ceKeyUsage, GetKeyUsageValue(Cert.Extensions.KeyUsage));
  AddExtension('NameConstraints', Cert.Extensions.NameConstraints,
    ceNameConstraints,GetNameConstraints(Cert.Extensions.NameConstraints));
  AddExtension('NetscapeBaseURL', Cert.Extensions.NetscapeBaseURL,
    ceNetscapeBaseURL,Cert.Extensions.NetscapeBaseURL.Content);
  AddExtension('NetscapeCAPolicy', Cert.Extensions.NetscapeCAPolicy,
    ceNetscapeCAPolicyURL, Cert.Extensions.NetscapeCAPolicy.Content);
  AddExtension('NetscapeCARevokeURL',Cert.Extensions.NetscapeCARevokeURL,
    ceNetscapeCARevokeURL,Cert.Extensions.NetscapeCARevokeURL.Content);
  AddExtension('NetscapeCertType',Cert.Extensions.NetscapeCertType,
    ceNetscapeCertType, GetNetscapeCertType(Cert.Extensions.NetscapeCertType));
  AddExtension('NetscapeComment',Cert.Extensions.NetscapeComment,
    ceNetscapeComment,Cert.Extensions.NetscapeComment.Content);
  AddExtension('NetscapeRenewalURL',Cert.Extensions.NetscapeRenewalURL,
    ceNetscapeRenewalURL,Cert.Extensions.NetscapeRenewalURL.Content);
  AddExtension('NetscapeRevokeURL',Cert.Extensions.NetscapeRevokeURL,
    ceNetscapeRevokeURL,Cert.Extensions.NetscapeRevokeURL.Content);
  AddExtension('NetscapeServerName',Cert.Extensions.NetscapeServerName,
    ceNetscapeServerName,Cert.Extensions.NetscapeServerName.Content);
  AddExtension('PolicyConstraints',Cert.Extensions.PolicyConstraints,
    cePolicyConstraints,GetPolicyConstraintsValue(Cert.Extensions.PolicyConstraints));
  AddExtension('PolicyMappings',Cert.Extensions.PolicyMappings,
    cePolicyMappings,GetPoliciesMappingValue(Cert.Extensions.PolicyMappings));
  AddExtension('PrivateKeyUsagePeriod',Cert.Extensions.PrivateKeyUsagePeriod,