frmmain.pas

著名的SecureBlackBox控件完整源码

    cePrivateKeyUsagePeriod,GetUsagePeriodValue(Cert.Extensions.PrivateKeyUsagePeriod));
  AddExtension('SubjectAlternativeName',Cert.Extensions.SubjectAlternativeName,
    ceSubjectAlternativeName,GetSubjectAltNameValue(Cert.Extensions.SubjectAlternativeName));
  AddExtension('SubjectKeyIdentifier',Cert.Extensions.SubjectKeyIdentifier,
    ceSubjectKeyIdentifier,BuildHexString(Cert.Extensions.SubjectKeyIdentifier.KeyIdentifier));
  // Custom extensions
  For i:=0 to Cert.Extensions.OtherCount -1 do
    AddListValue(OIDToStr(Cert.Extensions.OtherExtensions[i].OID),
     BuildHexString(Cert.Extensions.OtherExtensions[i].Value),'',5);
end;

var Par1, Par2, Par3, Par4 : string;
    Sz1, Sz2, Sz3, Sz4 : integer;

begin
  lvCertProperties.Items.Clear;
  lvCertProperties.Items.BeginUpdate;
  // printing ALL certificate properties
  // Version
  AddListValue('Version',IntToStr(Cert.Version));
  // SerialNumber
  AddListValue('Serial number',BuildHexString(Cert.SerialNumber));
  // SignatureAlgorithm
  AddListValue('Signature algorithm',GetEncryptionAlghorithm(Cert.SignatureAlgorithm));
  // Issuer
  AddRDN('Issuer',Cert.IssuerRDN);
  // Use CommonName or Organization
  lblIssuedBy.Caption:=Trim(Cert.IssuerName.CommonName);
  if (lblIssuedBy.Caption = '') then lblIssuedBy.Caption:=Cert.IssuerName.Organization;
  // IssuerUniqueID
  AddListValue('IssuerUniqueID',BuildHexString(Cert.IssuerUniqueID));
  // ValidFrom
  lblValidFrom.Caption := DateToStr(Cert.ValidFrom);
  AddListValue('Valid from',lblValidFrom.Caption,DateTimeToStr(Cert.ValidFrom));
  // ValidTo
  lblValidTo.Caption := DateToStr(Cert.ValidTo);
  AddListValue('Valid to',lblValidTo.Caption,DateTimeToStr(Cert.ValidTo));
  // Subject
  AddRDN('Subject',Cert.SubjectRDN);
  // Use CommonName or Organization
  lblIssuedTo.Caption:=Trim(Cert.SubjectName.CommonName);
  if (lblIssuedTo.Caption = '') then lblIssuedTo.Caption:=Cert.SubjectName.Organization;
  // SubjectUniqueID
  AddListValue('SubjectUniqueID',BuildHexString(Cert.SubjectUniqueID));
  // CertificateSize
  AddListValue('Size',IntToStr(Cert.CertificateSize));
  // Signature
  AddListValue('Signature',BuildHexString(Cert.Signature));
  // SelfSigned
  if (Cert.SelfSigned) then AddListValue('Self-signed','True')
   else AddListValue('Self-signed','False');
  if Cert.PublicKeyAlgorithm = SB_CERT_ALGORITHM_ID_RSA_ENCRYPTION then
  begin
    Sz1 := 0;  Sz2:=0;
    Cert.GetRSAParams(nil, Sz1, nil, Sz2);
    SetLength(Par1, Sz1);  SetLength(Par2, Sz2);
    Cert.GetRSAParams(@Par1[1], Sz1, @Par2[1], Sz2);
    Sz3 := Cert.GetPublicKeySize;
    AddListValue('Public key','RSA (' + IntToStr(Sz3) + ')',
      'RSAModulus = ' + BuildHexString(Par1) + #13#10 +
      'RSAPublicKey = ' + BuildHexString(Par2));
  end
  else if Cert.PublicKeyAlgorithm = SB_CERT_ALGORITHM_ID_DSA then
  begin
    Sz1 := 0; Sz2:=0; Sz3:=0; Sz4:=0;
    Cert.GetDSSParams(nil, Sz1, nil, Sz2, nil, Sz3, nil, Sz4);
    SetLength(Par1, Sz1); SetLength(Par2, Sz2);  SetLength(Par3, Sz3);  SetLength(Par4, Sz4);
    Cert.GetDSSParams(@Par1[1], Sz1, @Par2[1], Sz2, @Par3[1], Sz3, @Par4[1], Sz4);
    AddListValue('Public key','DSA (' + IntToStr(Sz4*8) + ')',
      'DSSP = ' + BuildHexString(Par1) + #13#10 + 'DSSQ = ' + BuildHexString(Par2) + #13#10 +
      'DSSG = ' + BuildHexString(Par3) + #13#10 + 'DSSY = ' + BuildHexString(Par4));
  end
  else if Cert.PublicKeyAlgorithm = SB_CERT_ALGORITHM_DH_PUBLIC then
  begin
    Sz1 := 0; Sz2:=0; Sz3:=0;
    Cert.GetDHParams(nil, Sz1, nil, Sz2, nil, Sz3);
    SetLength(Par1, Sz1); SetLength(Par2, Sz2);  SetLength(Par3, Sz3);
    Cert.GetDHParams(@Par1[1], Sz1, @Par2[1], Sz2, @Par3[1], Sz3);
    AddListValue('Public key','DH (' + IntToStr(Sz3*8) + ')',
      'DHP = ' + BuildHexString(Par1) + #13#10 + 'DHG = ' + BuildHexString(Par2) + #13#10 +
      'DHY = ' + BuildHexString(Par3));
  end
  else
  begin
    Sz1 := 0;
    Cert.GetPublicKeyBlob(nil, Sz1);
    SetLength(Par1, Sz1);
    Cert.GetPublicKeyBlob(@Par1[1], Sz1);
    AddListValue('Public key', 'Unknown', 'Key blob = ' + BuildHexString(Par1));
  end;
  // Private key
  if not Cert.PrivateKeyExists then AddListValue('Private Key','Not Available') else
  begin
    if Cert.PrivateKeyExtractable then AddListValue('Private Key','Available, Exportable')
      else AddListValue('Private Key','Available, Not Exportable');
  end;
  // Extensions
  DisplayExtensions(Cert);
  try
    if Cert.Validate then
     sbStatus.SimpleText := 'Certificate is self signed'
    else
     sbStatus.SimpleText := 'Certificate is not self signed';
  except end;
  if Cert.PrivateKeyExists then
    sbStatus.SimpleText := sbStatus.SimpleText + ', Private Key exists'
  else
    sbStatus.SimpleText := sbStatus.SimpleText + ', Private Key does not exist';

  // The code below can be used to show private keys
  (*
  PrivateKeySize:=0;
  Cert.SaveKeyToBuffer(nil, PrivateKeySize);
  Cert.SaveKeyToBuffer(@GlobalPrivateKey[0], PrivateKeySize);
  if PrivateKeySize <> 0 then
  begin
    sbStatus.SimpleText := StatusBar1.SimpleText + ', Private Key exists';
    S := 'PrivateKey = ' + BuildHexString(GlobalPrivateKey);
  end
  else begin
    sbStatus.SimpleText := StatusBar1.SimpleText + ', Private Key does not exist';
    S := '';
  end;
  memContent.Lines.Add(S);
  *)
  lvCertProperties.Items.EndUpdate;
end;

procedure TMainForm.FormActivate(Sender: TObject);
begin
  if treeCert.Items[0].GetLastChild.AbsoluteIndex < 4 then
  begin
    sbStatus.Panels[0].Text := 'Loading Windows Certificates...';
    Screen.Cursor := crHourGlass;
    WinStorage1.SystemStores.Clear;
    // ROOT
    WinStorage1.SystemStores.Add('ROOT');
    LoadStorage(treeCert.Items[1],'ROOT',WinStorage1);
    // CA
    WinStorage2.SystemStores.Clear;
    WinStorage2.SystemStores.Add('CA');
    LoadStorage(treeCert.Items[1],'CA',WinStorage2);
    // MY
    WinStorage3.SystemStores.Clear;
    WinStorage3.SystemStores.Add('MY');
    LoadStorage(treeCert.Items[1],'MY',WinStorage3);
    // SPC
    WinStorage4.SystemStores.Clear;
    WinStorage4.SystemStores.Add('SPC');
    LoadStorage(treeCert.Items[1],'SPC',WinStorage4);

    Screen.Cursor := crDefault;
    sbStatus.Panels[0].Text := '';

    TreeCertChange(nil, TreeCert.Selected);
  end;
end;

function TMainForm.DoCopyToStorage: Boolean;
var J : integer;
    DestStorage : TElCustomCertStorage;
    SourceCert  : TElX509Certificate;
begin
  result := false;
  if (treeCert.Selected.Data <> nil) and
    (TObject(treeCert.Selected.Data) is TElX509Certificate) then
  begin
    SourceCert := TElX509Certificate(treeCert.Selected.Data);

    StorageSelectForm := TStorageSelectForm.Create(nil);
    try
      if StorageSelectForm.ShowModal = mrCancel then exit;
      DestStorage := TElCustomCertStorage(StorageSelectForm.treeStorage.Selected.Data);
    finally
      FreeAndNil(StorageSelectForm);
    end;

    J := 0;
    while J < treeCert.Items.Count do
    begin
      if (treeCert.Items[J].Data = DestStorage) then
        break;
      inc(j);
    end;

    if (j < treeCert.Items.Count) and (treeCert.Items[J].Data = DestStorage) then
    begin
      DestStorage.Add(SourceCert);
      treeCert.Items.AddChildObject(treeCert.Items[J], treeCert.Selected.Text, SourceCert);
      result := true;
    end;
  end;
end;

procedure TMainForm.mmiExitClick(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.treeCertChange(Sender: TObject; Node: TTreeNode);
begin
  // Disable all storages
  acNewMemStorage.Enabled := False;
  acNewFileStorage.Enabled := False;
  acMountStorage.Enabled := False;
  acUnmountStorage.Enabled := False;
  acImportFromWinStorage.Enabled := False;
  acSaveStorage.Enabled := False;
  acSaveStorageAs.Enabled := False;
  acExportToMemoryStorage.Enabled := False;
  acTrusted.Checked := False;
  acTrusted.Enabled := False;
  // Disable all certificates
  acNewCertificate.Enabled := False;
  acLoadCertificate.Enabled := False;
  acSaveCertificate.Enabled := False;
  acRemoveCertificate.Enabled := False;
  acValidate.Enabled := False;
  acLoadPrivateKey.Enabled := False;
  acMoveToStorage.Enabled := False;
  acCopyToStorage.Enabled := False;
  // Conditions check
  if (Node = nil) or (Node.Data = nil) then
  begin
    acNewMemStorage.Enabled := True;
    acNewFileStorage.Enabled := True;
    acMountStorage.Enabled := True;
    acImportFromWinStorage.Enabled := True;
    Storage := nil;
    GlobalCert := nil;
  end
  else
  begin
    if (TObject(Node.Data) is TElX509Certificate) then
    begin
      DisplayCertificateInfo(TElX509Certificate(Node.Data));
      acSaveStorageAs.Enabled := True;
      acExportToMemoryStorage.Enabled := True;
      acNewCertificate.Enabled := True;
      acLoadCertificate.Enabled := True;
      acSaveCertificate.Enabled := True;
      acRemoveCertificate.Enabled := True;
      acValidate.Enabled := True;
      acLoadPrivateKey.Enabled := True;
      acMoveToStorage.Enabled := True;
      acCopyToStorage.Enabled := True;
      Storage := treeCert.Selected.Parent.Data;
      GlobalCert := treeCert.Selected.Data;
      if not (TObject(Node.Parent.Data) is TElWinCertStorage) then
        acMoveToStorage.Enabled := True;
    end;
    if (TObject(Node.Data) is TElWinCertStorage) or (TObject(Node.Data) is TElFileCertStorage)
      or  (TObject(Node.Data) is TElMemoryCertStorage)then
    begin
      acSaveStorage.Enabled := True;
      acSaveStorageAs.Enabled := True;
      acExportToMemoryStorage.Enabled := True;
      acNewCertificate.Enabled := True;
      acLoadCertificate.Enabled := True;
      acTrusted.Enabled := True;
      acTrusted.Checked := Node.ImageIndex = 6; // Check for trusted storage
      Storage := treeCert.Selected.Data;
      GlobalCert := nil;
    end;
    if (TObject(Node.Data) is TElFileCertStorage)
      or  (TObject(Node.Data) is TElMemoryCertStorage) then  acUnmountStorage.Enabled := True;
  end;
  if ((Node <> nil) and (Node.Data <> nil) and
   (TObject(Node.Data) is TElX509Certificate)) then pcInfo.ActivePage:=tsCertificate
    else pcInfo.ActivePage:=tsNoInfo;
end;

procedure TMainForm.treeCertDeletion(Sender: TObject; Node: TTreeNode);
begin
  if (Node <> nil) and
     (TObject(Node.data) is TElX509Certificate) then
  begin
    if GlobalCert = Node.data then
      GlobalCert := nil;

    TObject(Node.Data).Free;
    Node.Data := nil;
  end;
end;

procedure TMainForm.acNewMemStorageExecute(Sender: TObject);
var MemoryStorage : TElMemoryCertStorage;
    S : String;
begin
  MemoryStorage := TElMemoryCertStorage.Create(self);
  Storage := MemoryStorage;
  S := 'Storage' + IntToStr(StorageNumber);
  Inc(StorageNumber);
  LoadStorage(treeCert.Items[0].Item[2], S, Storage);
end;

procedure TMainForm.acNewFileStorageExecute(Sender: TObject);
var FileStorage : TElFileCertStorage;
begin
  if (treeCert.Selected.Data = nil) and (SaveDlgStorage.Execute) then
  begin
    if Pos('.p7b',SaveDlgStorage.FileName) = 0 then
      SaveDlgStorage.FileName:=SaveDlgStorage.FileName + '.p7b';
    FileStorage := TElFileCertStorage.Create(nil);
    FileStorage.FileName := SaveDlgStorage.FileName;
    LoadStorage(treeCert.Items[0].Item[1],FileStorage.FileName, FileStorage);
  end;
end;

procedure TMainForm.acSaveStorageExecute(Sender: TObject);
begin
  if not Assigned(Storage) then exit;
  if Storage.Count = 0 then
  begin
    ShowMessage('This Storage is empty. Cannot save.');
    Exit;
  end;
  if Storage is TElFileCertStorage then
    TElFileCertStorage(Storage).SaveToFile(TElFileCertStorage(Storage).FileName)
  else
    acSaveStorageAsExecute(Self);
end;

procedure TMainForm.acSaveStorageAsExecute(Sender: TObject);
var TmpFileSt : TElFileCertStorage;
    Pwd : string;
    FileName : string;
    Stream : TFileStream;
begin
  if Storage.Count = 0 then
  begin
    ShowMessage('This Storage is empty. Cannot save.');
    Exit;
  end;
  if (treeCert.Selected.Data = nil) or (not Assigned(Storage)) then exit;
  if not SaveDlgStorage.Execute then exit;
  FileName := SaveDlgStorage.FileName;
  if SaveDlgStorage.FilterIndex = 1 then
  begin
    if lowercase(ExtractFileExt(FileName)) <> '.p7b' then
      FileName := FileName + '.p7b';

    if Storage is TElFileCertStorage then
         TElFileCertStorage(Storage).SaveToFile(FileName)
    else  begin
      TmpFileSt := TElFileCertStorage.Create(Self);
      Storage.ExportTo(TmpFileSt);
      TElFileCertStorage(TmpFileSt).SaveToFile(FileName);
      TmpFileSt.Free;
    end;
  end
  else begin
    if lowercase(ExtractFileExt(FileName)) <> '.pfx' then
      FileName := FileName + '.pfx';
    Pwd:='';
    if not (Storage is TElWinCertStorage) then
      if MessageDlg('Do you want to save private keys?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
        if not InputQuery('Enter password', 'Enter password for private keys', Pwd) then exit;
     Stream := TFileStream.Create(FileName, fmCreate or fmShareDenyWrite);
     try
       Storage.SaveToStreamPFX(Stream, Pwd, SB_ALGORITHM_PBE_SHA1_3DES, SB_ALGORITHM_PBE_SHA1_RC2_40)
     finally
       Stream.Free;
     end;
  end;
end;

procedure TMainForm.acMountStorageExecute(Sender: TObject);
var FileStorage : TElFileCertStorage;
begin
  if (treeCert.Selected.Data = nil) and (OpenDlgStorage.Execute) then
  begin
    FileStorage := TElFileCertStorage.Create(nil);
    FileStorage.FileName := OpenDlgStorage.FileName;
    LoadStorage(treeCert.Items[0].Item[1], OpenDlgStorage.FileName, FileStorage);
  end;
end;