mainform.pas

著名的SecureBlackBox控件完整源码

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ImgList, ComCtrls, ToolWin, ExtCtrls, Buttons,
  SBUtils, SBPKCS11Base, SBPKCS11Manager, SBX509, StdCtrls;

type
  TfrmMain = class(TForm)
    MainMenu: TMainMenu;
    mnuFile: TMenuItem;
    mnuOpenStorage: TMenuItem;
    mnuCloseStorage: TMenuItem;
    mnuN: TMenuItem;
    mnuExit: TMenuItem;
    ImageList: TImageList;
    pClient: TPanel;
    lvObjects: TListView;
    mnuHelp: TMenuItem;
    mnuAbout: TMenuItem;
    OpenDialog: TOpenDialog;
    pToolbarButtons: TPanel;
    lSlots: TLabel;
    cbSlots: TComboBox;
    btnOpen: TBitBtn;
    btnAddAppData: TBitBtn;
    btnDelete: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure mnuOpenStorageClick(Sender: TObject);
    procedure mnuCloseStorageClick(Sender: TObject);
    procedure mnuExitClick(Sender: TObject);
    procedure cbSlotsDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure btnOpenClick(Sender: TObject);
    procedure cbSlotsChange(Sender: TObject);
    procedure mnuAboutClick(Sender: TObject);
    procedure btnAddAppDataClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
  private
    procedure OpenStorage;
    procedure CloseStorage;
    procedure ExitApp;
    procedure OpenSession;
    procedure RefreshObjects;
    procedure SetupButtons;
    function RequestPassword(const Caption: string; const Prompt: string;
      var Pass: string): boolean;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  Manager: TElPKCS11Manager;
  Session: TElPKCS11SessionInfo;

implementation

uses ProcessorForm, PinForm, AboutForm;

{$R *.DFM}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  Manager := nil;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  if Manager <> nil then
  begin
    Manager.Close;
    FreeAndNil(Manager);
    if Session <> nil then
      Session := nil;
  end;
//  ShowMessage('Not implemented');
end;

procedure TfrmMain.mnuOpenStorageClick(Sender: TObject);
begin
  if Manager <> nil then
    CloseStorage;
  OpenStorage;
end;

procedure TfrmMain.mnuCloseStorageClick(Sender: TObject);
begin
  CloseStorage;
end;

procedure TfrmMain.mnuExitClick(Sender: TObject);
begin
  ExitApp;
end;

procedure TfrmMain.OpenStorage;
var
  Path: string;
  i : integer;
  SlotInfo : TElPKCS11SlotInfo;
begin
  if OpenDialog.Execute then
  begin
    Manager := TElPKCS11Manager.Create(nil);
    Manager.DLLName := OpenDialog.Filename;
    Path := ExtractFilePath(Manager.DLLName);
    if Path <> '' then
      SetCurrentDir(Path);

    lvObjects.Items.Clear;
    cbSlots.Items.Clear;
    cbSlots.Items.Add('<Please select a slot>');

    try
      Manager.Open;

      for i := 0 to Manager.Module.SlotCount - 1 do
      begin
        SlotInfo := Manager.Module.Slot[i];
        cbSlots.Items.Add(SlotInfo.SlotDescription);
      end;

      cbSlots.ItemIndex := 0;

    except
      on E : Exception do
      begin
        FreeAndNil(Manager);
        MessageDlg('Error opening storage: ' + OpenDialog.Filename + #13#10 + E.Message,
          mtError, [mbOk], 0);
        Exit;
      end;
    end;

    SetupButtons;
  end;
end;

procedure TfrmMain.CloseStorage;
begin
  Manager.Close;
  cbSlots.Items.Clear;
  lvObjects.Items.Clear;
  FreeAndNil(Manager);
  if Session <> nil then
    Session := nil;
  SetupButtons;
end;

procedure TfrmMain.ExitApp;
begin
  if Manager <> nil then
    CloseStorage;
  Application.Terminate;
end;

procedure TfrmMain.OpenSession;
var
  Pin : string;
  RO  : boolean;
begin
  { Checking whether we can establish a new session }
  if cbSlots.ItemIndex <= 0 then
    Exit;
  if not Manager.Module.Slot[cbSlots.ItemIndex - 1].TokenPresent then
  begin
    MessageDlg('Token not found in specified slot', mtError, [mbOk], 0);
    Exit;
  end;
  { Closing current session }
  if Session <> nil then
  begin
    lvObjects.Items.Clear;
    Session.Logout;
    Manager.CloseSession;
    Session := nil;
  end;
  { Opening new session }
  RO := Manager.Module.Slot[cbSlots.ItemIndex - 1].ReadOnly;
  try
    Session := Manager.OpenSession(cbSlots.ItemIndex - 1, RO);
  except
    on E : ECertStorageError do
    begin
      if not RO then
        Session := Manager.OpenSession(cbSlots.ItemIndex - 1, true)
      else
        Raise;
    end;
  end;
  if (Session <> nil) and (RequestPassword('PIN request', 'Please enter your PIN:', Pin)) then
  begin
    try
      Session.Login(utUser, Pin);
    except
      Manager.CloseSession;
      Session := nil;
    end;
  end;
  RefreshObjects;
  SetupButtons;
end;

procedure TfrmMain.RefreshObjects;
var
  i : integer;
  Item: TListItem;
  S : string;
  AnObject : TElPKCS11Object;
begin
  Manager.RefreshObjects;
  lvObjects.Items.Clear;
  for i := 0 to Manager.Count - 1 do
  begin
    AnObject := Manager.Objects[i];
    Item := lvObjects.Items.Add;
    Item.Data := AnObject;
    //Item.ImageIndex := 3;
    Item.Caption := StringOfBytes(AnObject.ID);
    if AnObject is TElPKCS11DataObject then
      Item.SubItems.Add('User data')
    else
    if AnObject is TElPKCS11CertificateObject then
      Item.SubItems.Add('Certificate')
    else
    if AnObject is TElPKCS11PrivateKeyObject then
      Item.SubItems.Add('Private Key')
    else
    if AnObject is TElPKCS11PublicKeyObject then
      Item.SubItems.Add('Public Key')
    else
    if AnObject is TElPKCS11SecretKeyObject then
      Item.SubItems.Add('Secret Key')
    else
      Item.SubItems.Add('Unknown type');
    Item.SubItems.Add(AnObject.Label_);
    Item.SubItems.Add(IntToStr(AnObject.HWSize));
    (*
    if AnObject.Extractable then
      Item.SubItems.Add('Extractable')
    else
      Item.SubItems.Add('Not extractable');
    *)
  end;
end;

procedure TfrmMain.SetupButtons;
begin
  mnuCloseStorage.Enabled := (Manager <> nil);
  btnOpen.Enabled := Manager <> nil;
  btnAddAppData.Enabled := Manager <> nil;
  btnDelete.Enabled := Manager <> nil;
end;

function TfrmMain.RequestPassword(const Caption: string; const Prompt: string;
  var Pass: string): boolean;
begin
  frmPIN.lPrompt.Caption := Prompt;
  frmPIN.Caption := Caption;
  if frmPIN.ShowModal = mrOk then
  begin
    Pass := frmPIN.EditPin.Text;
    Result := true;
  end
  else
    Result := false;
end;

procedure TfrmMain.cbSlotsDrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  Img : integer;
begin
  cbSlots.Canvas.FillRect(Rect);
  if (Index <> 0) then
  begin
    if Manager.Module.Slot[Index - 1].TokenPresent then
      Img := 1
    else
      Img := 2;
    ImageList.Draw(cbSlots.Canvas, Rect.Left, Rect.Top, Img);
  end;
  cbSlots.Canvas.TextOut(Rect.Left + ImageList.Width + 2, Rect.Top,
    cbSlots.Items[Index]);
end;

procedure TfrmMain.btnOpenClick(Sender: TObject);
begin
  OpenSession;
end;

procedure TfrmMain.cbSlotsChange(Sender: TObject);
begin
  btnOpen.Enabled := cbSlots.ItemIndex > 0;
end;

procedure TfrmMain.mnuAboutClick(Sender: TObject);
begin
  frmAbout.ShowModal;
end;

procedure TfrmMain.btnAddAppDataClick(Sender: TObject);
var Obj : TElPKCS11DataObject;
begin
  Obj := TElPKCS11DataObject.Create(Manager);
  Obj.Label_ := 'Just a label';
  Obj.Application := 'CryptoTokenManagerDemo';
  Obj.Value := BytesOfString('Sample application-defined data');
  Manager.AddObject(Obj);
  RefreshObjects();
end;

procedure TfrmMain.btnDeleteClick(Sender: TObject);
begin
  if (lvObjects.Selected <> nil) then
  begin
    Manager.RemoveObject(TElPKCS11Object(lvObjects.Selected.Data));
    RefreshObjects;
  end;
end;

initialization

  SetLicenseKey('ADDCD14AD06709806817E0B3D7BFD0A2222D536FE156466C5D5FE65DB5DEAE76' + 
  'FFDEBC07E915A5751C12C01C783958872A38E4A5EDA140E7247E0F2E56442A3C' + 
  'F3E9347AD8FDE52083A0DFC86BC00ECB0FD0CF1B51159A2BCB84F6EA6349EF47' + 
  '5C15A59AFCC55F7C3AAD26C279628B5D91B1DC94BD2385354A70CCA3B76101D9' + 
  'F41C84A639FC3CCE4BA8F0CC4A66DCD150114A3F58C1AD46B7B94643741BC20A' + 
  '8DCA83AB921480951B423CAA19EF1863A47CA2C3422E7E5634BED98939A5AE43' + 
  'DE1E4BAD79E66D8A5C973B3455656C8C9B6FF024FADD6CDA02D0F506D98493C8' + 
  'BD1ED7B237DB75FA31F2C82654490CDDDEE24E19939137B9E1DB05508733B22F');

end.