frmmain.pas

著名的SecureBlackBox控件完整源码

procedure TMainForm.acUnmountStorageExecute(Sender: TObject);
var I : integer;
begin
  if Assigned(Storage) then
    if (Storage is TElFileCertStorage) or
      (Storage is TElMemoryCertStorage) then
    begin
      treeCert.Selected.Delete;
      I := 0;
      while I < StorageList.Count do
      begin
        if StorageList.Items[I] = Storage then
        begin
          StorageList.Delete(I);
          Break;
        end;
        Inc(I);
      end;
    end;
end;

procedure TMainForm.acImportFromWinStorageExecute(Sender: TObject);
var S : string;
    TmpMemStorage : TElMemoryCertStorage;
    ClickedOk : Boolean;
begin
  S := 'ROOT';
  ClickedOk := InputQuery('Store name','Enter Windows store name', S);
  if not ClickedOk then exit;
  TmpMemStorage := TElMemoryCertStorage.Create(self);
  WinStorage1.SystemStores.Clear;
  sbStatus.Panels[0].Text := 'Loading Windows Certificates...';
  WinStorage1.SystemStores.Add(S);
  WinStorage1.ExportTo(TmpMemStorage);
  Storage := TmpMemStorage;
  S := 'Storage' + IntToStr(StorageNumber);
  Inc(StorageNumber);
  LoadStorage(treeCert.Items[0].Item[2], S, Storage);
end;

procedure TMainForm.acExportToMemoryStorageExecute(Sender: TObject);
var TmpMemStorage : TElMemoryCertStorage;
    I : integer;
    S : String;
begin
  if (treeCert.Selected.Data <> nil) then
  begin
    TmpMemStorage := TElMemoryCertStorage.Create(self);
    for I := 0 to StorageList.Count - 1 do
      if Storage = StorageList.Items[I] then
      begin
        if Storage is TElWinCertStorage then
        begin
          TElWinCertStorage(Storage).SystemStores.Clear;
          TElWinCertStorage(Storage).SystemStores.Add(CurrStorageName[I]);
        end;
        Storage.ExportTo(TmpMemStorage);
        Break;
      end;

    Storage := TmpMemStorage;
    S := 'Storage' + IntToStr(StorageNumber);
    Inc(StorageNumber);
    LoadStorage(treeCert.Items[0].Item[2], S, Storage);
  end;
end;

procedure TMainForm.acNewCertificateExecute(Sender: TObject);
begin
  TfrmGenerateCert.DoCreateCertificate;
end;

procedure TMainForm.acLoadCertificateExecute(Sender: TObject);
var S : string;
    Cert : TElX509Certificate;
    Pwd : string;
    Stream : TFileStream;
    FileName,
    KeyFileName : string;
    ti,Parent :  TTreeNode;
    R : integer;
begin
  if (treeCert.Selected = nil) or (treeCert.Selected.Data = nil) then exit;
  if  not (OpenDlgCert.Execute) then exit;
  FileName := OpenDlgCert.FileName;
  Pwd:='';
  Cert := TElX509Certificate.Create(nil);
  case OpenDlgCert.FilterIndex of
   1: begin
        Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
        try
          Cert.LoadFromStream(Stream);
        finally
          Stream.Free;
        end;
        KeyFileName := ChangeFileExt(FileName, '.der');
        if not FileExists(KeyFileName) then
          KeyFileName := ChangeFileExt(FileName, '.key');
        if FileExists(KeyFileName) then
        begin
          if (MessageDlg('Do you want to load private key?', mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
          begin
            // Pwd := '';
            // if not InputQuery('Enter password', 'Enter password for private key', Pwd) then exit;
            Stream := TFileStream.Create(KeyFileName, fmOpenRead or fmShareDenyWrite);
            try
              Cert.LoadKeyFromStream(Stream);
            finally
              Stream.Free;
            end;
          end;
        end;
      end;
   2: begin
        if not InputQuery('Enter password', 'Enter password for private key', Pwd) then exit;
        Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
        try
          R := Cert.LoadFromStreamPEM(Stream, Pwd);
        finally
          Stream.Free;
        end;
        if R <> 0 then
        begin
          MessageDlg('Failed to load PEM certificate: error ' + IntToHex(R, 4),
            mtError, [mbOk], 0);
          Exit;
        end;
      end;
   3: begin
        if not InputQuery('Enter password', 'Enter password for private key', Pwd) then exit;
        Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
        try
          R := Cert.LoadFromStreamPFX(Stream, Pwd);
        finally
          Stream.Free;
        end;
        if R <> 0 then
        begin
          MessageDlg('Failed to load PFX certificate: error ' + IntToHex(R, 4),
            mtError, [mbOk], 0);
          Exit;
        end;
      end;
    end; { case }

    Storage.Add(Cert);

    S := GetOIDValue(Cert.SubjectRDN, SB_CERT_OID_COMMON_NAME);
    if s = '' then
      s := GetOIDValue(Cert.SubjectRDN, SB_CERT_OID_ORGANIZATION);

    if TObject(treeCert.Selected.Data) is TElCustomCertStorage then
      Parent := treeCert.Selected
    else
      Parent := treeCert.Selected.Parent;

    ti:=treeCert.Items.AddChildObject(Parent, S, Cert);
    ti.ImageIndex:=3;
    ti.SelectedIndex:=3;

    GlobalCert := Cert;
end;

procedure TMainForm.acSaveCertificateExecute(Sender: TObject);
var S : string;
    FileName,
    KeyFileName : string;
    SavePvtKey : boolean;
    Pwd : string;
    Stream : TFileStream;
begin
  if (TObject(treeCert.Selected.Data) is TElX509Certificate) and
    (SaveDlgCert.Execute) then
  begin
    FileName := SaveDlgCert.FileName;
    S := ''; Pwd := '';
    if GlobalCert.PrivateKeyExists then
    begin
      SavePvtKey := true;
      if SaveDlgCert.FilterIndex = 1 then
        SavePvtKey := MessageDlg('Do you want to save private key?',
          mtConfirmation, [mbYes, mbNo], 0) = mrYes;
    end else SavePvtKey := False;

    if SavePvtKey then
      if not InputQuery('Enter password', 'Enter password for private key', Pwd) then exit;

    if SaveDlgCert.FilterIndex = 1 then
    begin
      if lowercase(ExtractFileExt(FileName)) <> '.cer' then
        FileName := FileName + '.cer';
      Stream := TFileStream.Create(FileName, fmCreate or fmShareDenyWrite);
      try
        GlobalCert.SaveToStream(Stream);
      finally
        Stream.Free;
      end;

      if SavePvtKey and GlobalCert.PrivateKeyExists then
      begin
        KeyFileName := ChangeFileExt(FileName, '.key');
        Stream := TFileStream.Create(KeyFileName, fmCreate or fmShareDenyWrite);
        try
          GlobalCert.SaveKeyToStream(Stream);
        finally
          Stream.Free;
        end;
      end;
    end;
    // PEM format
    if SaveDlgCert.FilterIndex = 2 then
    begin
      if lowercase(ExtractFileExt(FileName)) <> '.pem' then
        FileName := FileName + '.pem';
      Stream := TFileStream.Create(FileName, fmCreate or fmShareDenyWrite);
      try
        GlobalCert.SaveToStreamPEM(Stream, '');
        if SavePvtKey then
          GlobalCert.SaveKeyToStreamPEM(Stream, Pwd);
      finally
        Stream.Free;
      end;
    end;
    // PFX format
    if SaveDlgCert.FilterIndex = 3 then
    begin
      if lowercase(ExtractFileExt(FileName)) <> '.pfx' then
        FileName := FileName + '.pfx';

      Stream := TFileStream.Create(FileName, fmCreate or fmShareDenyWrite);
      try
        GlobalCert.SaveToStreamPFX(Stream, Pwd, SB_ALGORITHM_PBE_SHA1_3DES, SB_ALGORITHM_PBE_SHA1_RC2_40);
      finally
        Stream.Free;
      end;
    end;
  end;
end;

procedure TMainForm.acRemoveCertificateExecute(Sender: TObject);
var I : integer;
begin
  if not Assigned(Storage) then exit;

  if (treeCert.Selected.Data <> nil) and
   (treeCert.Selected.Data = GlobalCert)
    and (treeCert.Selected.Parent.Data = Storage) then
  begin
    I := Storage.FindByHash(TElX509Certificate(treeCert.Selected.Data).GetHashSHA1);
    if i <> - 1 then
    begin
      treeCert.Selected.Delete;
      Storage.Remove(I);
    end;
  end;
end;

procedure TMainForm.acCreateCSRExecute(Sender: TObject);
begin
  TfrmGenerateCert.DoCreateCSR;
end;

procedure TMainForm.acValidateExecute(Sender: TObject);
var
  i : integer;
  TrustedList, NonTrustedList : TStringList;
  Item : TObject;
  Cert : TElX509Certificate;
begin
  if not (TObject(treeCert.Selected.Data) is TElX509Certificate) then exit;
  TrustedList := TStringList.Create();
  NonTrustedList := TStringList.Create();
  try
    Cert:=TElX509Certificate(treeCert.Selected.Data);
    for i:=0 to treeCert.Items.Count - 1 do
    try
      Item := TObject(treeCert.Items[i].Data);
      if (Item is TElWinCertStorage) or (Item is TElFileCertStorage)
       or  (Item is TElMemoryCertStorage) then
      begin
        if treeCert.Items[i].ImageIndex = 6 then
          TrustedList.AddObject(treeCert.Items[i].Text,Item)
        else
          NonTrustedList.AddObject(treeCert.Items[i].Text,Item);
      end;
    except end;
    TfrmValidate.ValidateCertificate(TrustedList, NonTrustedList, Cert);
  finally
    TrustedList.Free;
    NonTrustedList.Free;
  end;
end;

procedure TMainForm.acLoadPrivateKeyExecute(Sender: TObject);
var Stream : TFileStream;
    Cert : TElX509Certificate;
    Pwd  : string;
begin
  if (TObject(treeCert.Selected.Data) is TElX509Certificate) and
    (OpenDlgPvtKey.Execute) then
  begin
    Cert := TElX509Certificate(TObject(treeCert.Selected.Data));
    Pwd := '';
    if not InputQuery('Enter password', 'Enter password for private key', Pwd) then exit;

    Stream := TFileStream.Create(OpenDlgPvtKey.Filename, fmOpenRead or fmShareDenyWrite);
    try
      if OpenDlgPvtKey.FilterIndex = 1 then
        Cert.LoadKeyFromStream(Stream)
      else  begin
        Pwd := '';
        if not InputQuery('Enter password', 'Enter password for private key', Pwd) then exit;
        Cert.LoadKeyFromStreamPEM(Stream, Pwd);
      end;
    finally
      Stream.Free;
    end;
    TreeCertChange(nil, TreeCert.Selected);
  end;
end;

procedure TMainForm.acMoveToStorageExecute(Sender: TObject);
var Item : TTreeNode;
begin
  Item := treeCert.Selected;
  if DoCopyToStorage then
    Item.Delete;
end;

procedure TMainForm.acCopyToStorageExecute(Sender: TObject);
begin
  DoCopyToStorage;
end;

procedure TMainForm.mmiAboutClick(Sender: TObject);
begin
  TfrmAbout.ShowAboutBox
end;

procedure TMainForm.lvCertPropertiesChange(Sender: TObject;
  Item: TListItem; Change: TItemChange);
var i : integer;
begin
  If not Assigned(Item) then exit;
  memAdditional.Lines.Clear;
  for i:=1 to Item.SubItems.Count - 1 do
    memAdditional.Lines.Add(Item.SubItems[i]);
end;

procedure TMainForm.acTrustedExecute(Sender: TObject);
begin
  try
    case treeCert.Selected.ImageIndex of
     2 : treeCert.Selected.ImageIndex := 6;
     6 : treeCert.Selected.ImageIndex := 2;
    end;
    treeCert.Selected.SelectedIndex := treeCert.Selected.ImageIndex;
  except end;
end;

initialization

  SBUtils.SetLicenseKey(
  '39D1A4C4B5EA1E1B45CCE5736EDCE79DBD2357577527F1F212B3ACF62BA283F4' +
  'E7AE4FF6D5684B782ABBBE3D25AFEC69E9E175B3EE14640B15F9907D2F6A31C6' + 
  'F24EE1241DE4F4C1E58632BAF362B73B8F8970B9B51A3669F7A9269A8CB75272' + 
  '346D5BA20745B7570C3DB7A3FD31A0B6C0609304ABEC4601B659B1E7388CA217' + 
  'AAD7B17286A4E6B706B6D4F52A547296353628C007244710D6A3EB3EB9A4392B' + 
  '1BB09A851C1CC94250730F2A1F5391D37870A1739120DD4D059C68F33DD011DF' + 
  'D9D7B99D7490E4C9BACAE17E0AF11E88D8062EE5648F630AF7DDD5EB2B725EF7' + 
  'E59519B1ACC410DCBD8130084546C3906DFE0DC82E8E66044EFFA80056251C24'

  );

end.