main.pas

这是一套全面的网络组件

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, clCert, clCryptAPI, exportfrm, importfrm, createfrm;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    cbLocation: TComboBox;
    Label2: TLabel;
    cbName: TComboBox;
    btnLoad: TButton;
    btnExport: TButton;
    btnImport: TButton;
    btnDelete: TButton;
    btnCreateSelfSigned: TButton;
    btnClose: TButton;
    lvCertificates: TListView;
    Label3: TLabel;
    clCertificateStore1: TclCertificateStore;
    procedure btnLoadClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure btnExportClick(Sender: TObject);
    procedure btnImportClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
    procedure btnCreateSelfSignedClick(Sender: TObject);
  private
    FIsOpened: Boolean;
    procedure LoadCertificateList;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btnLoadClick(Sender: TObject);
var
  store: HCERTSTORE;
begin
  btnCloseClick(nil);

  if cbLocation.ItemIndex = 0 then
  begin
    clCertificateStore1.LoadFromSystemStore(cbName.Text);
  end else
  begin
    store := CertOpenStore(CERT_STORE_PROV_SYSTEM, X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,
      0, CERT_SYSTEM_STORE_LOCAL_MACHINE, PWideChar(WideString(cbName.Text)));
    clCertificateStore1.LoadFromStore(store);
  end;

  LoadCertificateList();
  FIsOpened := True;
end;

procedure TForm1.LoadCertificateList;
var
  i: Integer;
  item: TListItem;
begin
  lvCertificates.Items.Clear();

  for i := 0 to clCertificateStore1.Count - 1 do
  begin
    item := lvCertificates.Items.Add();

    item.Data := clCertificateStore1[i];
    item.Caption := clCertificateStore1[i].IssuedTo;
    item.SubItems.Add(clCertificateStore1[i].IssuedBy);
    item.SubItems.Add(DateTimeToStr(clCertificateStore1[i].ValidTo));
    item.SubItems.Add(clCertificateStore1[i].FriendlyName);
    item.SubItems.Add(clCertificateStore1[i].Email);
  end;
end;

procedure TForm1.btnCloseClick(Sender: TObject);
begin
  clCertificateStore1.Close();
  LoadCertificateList();
  FIsOpened := False;
end;

procedure TForm1.btnExportClick(Sender: TObject);
var
  cert: TclCertificate;
  dlg: TExportForm;
begin
  if (lvCertificates.ItemIndex < 0) then Exit;

  cert := TclCertificate(lvCertificates.Items[lvCertificates.ItemIndex].Data);

  dlg := TExportForm.Create(nil);
  try
    dlg.edtName.Text := cert.FriendlyName;

    if dlg.ShowModal() = mrOk then
    begin
      clCertificateStore1.ExportToPFX(cert, dlg.edtFileName.Text,
        dlg.edtPassword.Text, dlg.cbExportPrivateKey.Checked);
    end;
  finally
    dlg.Free();
  end;
end;

procedure TForm1.btnImportClick(Sender: TObject);
var
  i: Integer;
  dlg: TImportForm;
begin
  if not FIsOpened then Exit;

  dlg := TImportForm.Create(nil);
  try
    dlg.edtStoreName.Text := cbLocation.Text + '; ' + cbName.Text;

    if dlg.ShowModal() = mrOk then
    begin
      clCertificateStore1.ImportFromPFX(dlg.edtFileName.Text, dlg.edtPassword.Text);

      for i := 0 to clCertificateStore1.Count - 1 do
      begin
        if not clCertificateStore1.IsInstalled(clCertificateStore1[i]) then
        begin
          clCertificateStore1.Install(clCertificateStore1[i]);
        end;
      end;

      btnLoadClick(nil);
    end;
  finally
    dlg.Free();
  end;
end;

procedure TForm1.btnDeleteClick(Sender: TObject);
var
  cert: TclCertificate;
begin
  if (lvCertificates.ItemIndex < 0) then Exit;

  cert := TclCertificate(lvCertificates.Items[lvCertificates.ItemIndex].Data);
  clCertificateStore1.Uninstall(cert);
  clCertificateStore1.Remove(cert);

  btnLoadClick(nil);
end;

procedure TForm1.btnCreateSelfSignedClick(Sender: TObject);
var
  i: Integer;
  dlg: TCreateCertForm;
begin
  if not FIsOpened then Exit;

  dlg := TCreateCertForm.Create(nil);
  try
    dlg.edtStoreName.Text := cbLocation.Text + '; ' + cbName.Text;

    if dlg.ShowModal() = mrOk then
    begin
      clCertificateStore1.AddSelfSigned(dlg.BuildSubjectString(),
        StrToInt(dlg.edtSerial.Text), StrToDateTime(dlg.edtValidFrom.Text), StrToDateTime(dlg.edtValidTo.Text));

      for i := 0 to clCertificateStore1.Count - 1 do
      begin
        if not clCertificateStore1.IsInstalled(clCertificateStore1[i]) then
        begin
          clCertificateStore1.Install(clCertificateStore1[i]);
        end;
      end;
        
      btnLoadClick(nil);
    end;
  finally
    dlg.Free();
  end;
end;

end.