umain.pas

来自「著名的SecureBlackBox控件完整源码」· PAS 代码 · 共 261 行

(******************************************************)
(*                                                    *)
(*            EldoS SecureBlackbox Library            *)
(*              SSH keys generation demo              *)
(*      Copyright (c) 2002-2007 EldoS Corporation     *)
(*           http://www.secureblackbox.com            *)
(*                                                    *)
(******************************************************)

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ImgList, ToolWin, StdCtrls, ExtCtrls, SBSSHKeyStorage, SBUtils;

type
  TfrmMain = class(TForm)
    rgAlgorithm: TRadioGroup;
    rgKeyFormat: TRadioGroup;
    tbTop: TToolBar;
    ilButtons: TImageList;
    tbGenerate: TToolButton;
    tbSavePrivate: TToolButton;
    tbSavePublic: TToolButton;
    tbExit: TToolButton;
    memPrivateKey: TMemo;
    lblPrivateKey: TLabel;
    lblPublicKey: TLabel;
    memPublicKey: TMemo;
    sdKeys: TSaveDialog;
    sbStatus: TStatusBar;
    Splitter1: TSplitter;
    pnlTop: TPanel;
    cbKeyLen: TComboBox;
    lblKeyLen: TLabel;
    lblSubject: TLabel;
    edtSubject: TEdit;
    lblComment: TLabel;
    edtComment: TEdit;
    tbLoadPrivate: TToolButton;
    tbLoadPublic: TToolButton;
    odKeys: TOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure tbSavePrivateClick(Sender: TObject);
    procedure tbSavePublicClick(Sender: TObject);
    procedure tbGenerateClick(Sender: TObject);
    procedure tbExitClick(Sender: TObject);
    procedure rgKeyFormatClick(Sender: TObject);
    procedure tbLoadPrivateClick(Sender: TObject);
    procedure tbLoadPublicClick(Sender: TObject);
  private
    FKey : TElSSHKey;  // Current key storage
    FKeyGenerated : boolean; // Check if current key generated
    function GetSaveFileName(DialogTitle : string) : boolean;
    function GetOpenFileName(DialogTitle : string) : boolean;
    procedure SetStatus(AStatus : string);
    procedure ShowStatus(Status : integer);
    procedure AllowKeySaving;
    procedure ShowKeys; // Show keys in memo
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

uses uGetPassword;

{$R *.DFM}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  FKey:=TElSSHKey.Create;
  FKeyGenerated:=False;
  cbKeyLen.ItemIndex:=2;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  FKey.Free;
end;

function TfrmMain.GetSaveFileName(DialogTitle: string): boolean;
begin
  Result:=False;
  sdKeys.Title:=DialogTitle;
  if not sdKeys.Execute then exit;
  Result:=True;
end;

procedure TfrmMain.tbSavePrivateClick(Sender: TObject);
var Password : string;
begin
  If not FKeyGenerated then exit;
  If not GetSaveFileName('Select file name for private key') then exit;
  TfrmGetPassword.GetPassword(Password);
  FKey.SavePrivateKey(sdKeys.FileName,Password);
end;

procedure TfrmMain.tbSavePublicClick(Sender: TObject);
begin
  If not FKeyGenerated then exit;
  If not GetSaveFileName('Select file name for public key') then exit;
  FKey.SavePublicKey(sdKeys.FileName);
end;

procedure TfrmMain.tbGenerateClick(Sender: TObject);
var Bits,KeySize,Status : integer;
    Key : string;
begin
  // Algorithm
  case rgAlgorithm.ItemIndex of
  0 : FKey.Algorithm:=ALGORITHM_RSA;
  1 : FKey.Algorithm:=ALGORITHM_DSS;
  end; //case
  // KeyFormat
  case rgKeyFormat.ItemIndex of
  0 : FKey.KeyFormat:=kfOpenSSH;
  1 : FKey.KeyFormat:=kfIETF;
  2 : FKey.KeyFormat:=kfPuTTY;
  3 : FKey.KeyFormat:=kfX509;
  end; //case
  FKey.Comment:=edtComment.Text;
  FKey.Subject:=edtSubject.Text;
  try
    Bits:=StrToInt(cbKeyLen.Text);
  except SetStatus('Invalid key length'); exit; end;  
  // Generating keys
  SetStatus('Please wait...Generating key...');
  Status:=FKey.Generate(FKey.Algorithm,Bits);
  ShowStatus(Status);
  if Status <> 0 then exit;
  SetStatus('Keys generated');
  ShowKeys;
  AllowKeySaving;
end;

procedure TfrmMain.SetStatus(AStatus: string);
begin
  sbStatus.SimpleText:=AStatus;
  Update;
  Application.ProcessMessages;
end;

procedure TfrmMain.tbExitClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmMain.ShowStatus(Status: integer);
begin
  case Status of
   SB_ERROR_SSH_KEYS_INVALID_PUBLIC_KEY : SetStatus('SB_ERROR_SSH_KEYS_INVALID_PUBLIC_KEY');
   SB_ERROR_SSH_KEYS_INVALID_PRIVATE_KEY : SetStatus('SB_ERROR_SSH_KEYS_INVALID_PRIVATE_KEY');
   SB_ERROR_SSH_KEYS_FILE_READ_ERROR : SetStatus('SB_ERROR_SSH_KEYS_FILE_READ_ERROR');
   SB_ERROR_SSH_KEYS_FILE_WRITE_ERROR : SetStatus('SB_ERROR_SSH_KEYS_FILE_WRITE_ERROR');
   SB_ERROR_SSH_KEYS_UNSUPPORTED_ALGORITHM : SetStatus('SB_ERROR_SSH_KEYS_UNSUPPORTED_ALGORITHM');
   SB_ERROR_SSH_KEYS_INTERNAL_ERROR : SetStatus('SB_ERROR_SSH_KEYS_INTERNAL_ERROR');
   SB_ERROR_SSH_KEYS_BUFFER_TOO_SMALL : SetStatus('SB_ERROR_SSH_KEYS_BUFFER_TOO_SMALL');
   SB_ERROR_SSH_KEYS_NO_PRIVATE_KEY : SetStatus('SB_ERROR_SSH_KEYS_NO_PRIVATE_KEY');
   SB_ERROR_SSH_KEYS_INVALID_PASSPHRASE : SetStatus('SB_ERROR_SSH_KEYS_INVALID_PASSPHRASE');
   SB_ERROR_SSH_KEYS_UNSUPPORTED_PEM_ALGORITHM : SetStatus('SB_ERROR_SSH_KEYS_UNSUPPORTED_PEM_ALGORITHM');
  end; //case
end;

procedure TfrmMain.rgKeyFormatClick(Sender: TObject);
begin
  edtSubject.Enabled:=rgKeyFormat.ItemIndex=1;
  If edtSubject.Enabled then edtSubject.Color:=clWindow
   else edtSubject.Color:=clGrayText;
end;

function TfrmMain.GetOpenFileName(DialogTitle: string): boolean;
begin
  odKeys.Title:=DialogTitle;
  Result:=odKeys.Execute;
end;

procedure TfrmMain.tbLoadPrivateClick(Sender: TObject);
var Status : integer;
    Password : string;
begin
  If not GetOpenFileName('Select private key') then exit;
  Status:=FKey.LoadPrivateKey(odKeys.FileName,Password);
  if Status <> 0 then
  begin
    Password:='';
    If not TfrmGetPassword.GetPassword(Password) then Password:='';
    Status:=FKey.LoadPrivateKey(odKeys.FileName,Password);
  end;  
  ShowStatus(Status);
  if Status=0 then
  begin
    ShowKeys;
    AllowKeySaving;
    SetStatus('Private key loaded.');
  end;
end;

procedure TfrmMain.tbLoadPublicClick(Sender: TObject);
var Status : integer;
begin
  If not GetOpenFileName('Select public key') then exit;
  Status:=FKey.LoadPublicKey(odKeys.FileName);
  ShowStatus(Status);
  if Status=0 then
  begin
    ShowKeys;
    AllowKeySaving;
    SetStatus('Public key loaded.');
  end;
end;

procedure TfrmMain.ShowKeys;
var KeySize : integer;
    Key : string;
begin
  KeySize:=0;
  FKey.SavePrivateKey(nil,KeySize);
  SetLength(Key,KeySize);
  FKey.SavePrivateKey(@Key[1],KeySize);
  SetLength(Key,KeySize);
  memPrivateKey.Lines.Text:=Key;
  KeySize:=0;
  FKey.SavePublicKey(nil,KeySize);
  SetLength(Key,KeySize);
  FKey.SavePublicKey(@Key[1],KeySize);
  SetLength(Key,KeySize);
  memPublicKey.Lines.Text:=Key;
  edtSubject.Text:=FKey.Subject;
  edtComment.Text:=FKey.Comment;
end;

procedure TfrmMain.AllowKeySaving;
begin
  FKeyGenerated:=True;
  tbSavePublic.Enabled:=True;
  tbSavePrivate.Enabled:=True;
end;

initialization

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



end.