mainform.pas

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

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ActnList, Menus, StdCtrls, ComCtrls, ToolWin, ImgList, ExtCtrls,
  SBIdSSHClient,
  SBSSHCommon, SBSSHConstants, SBUtils, SBSSHKeyStorage,
  ConnectionPropertiesForm, AboutForm;

type
  TfrmMain = class(TForm)
    MainMenu: TMainMenu;
    ActionList: TActionList;
    actConnect: TAction;
    actDisconnect: TAction;
    actExit: TAction;
    File1: TMenuItem;
    Connect1: TMenuItem;
    Disconnect1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    StatusBar1: TStatusBar;
    imgListViews: TImageList;
    tbToolbar: TToolBar;
    tbConnect: TToolButton;
    tbDisconnect: TToolButton;
    spLog: TSplitter;
    lvLog: TListView;
    Panel1: TPanel;
    actAbout: TAction;
    Help1: TMenuItem;
    About1: TMenuItem;
    reTerminal: TRichEdit;
    procedure Exit1Click(Sender: TObject);
    procedure actConnectExecute(Sender: TObject);
    procedure actDisconnectExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure actAboutExecute(Sender: TObject);
    procedure reTerminalKeyPress(Sender: TObject; var Key: Char);
  private
    FSSHClient: TElIdSSHClient;
    FShellSSHTunnel: TElShellSSHTunnel;
    FKeyStorage: TElSSHMemoryKeyStorage;
    FSSHTunnelConnection: TElSSHTunnelConnection;

  protected
    procedure Log(const S: string; Error: Boolean = False);

    procedure SSHClientAuthenticationFailed(Sender: TObject; AuthType: Integer);
    procedure SSHClientAuthenticationSuccess(Sender: TObject);
    procedure SSHClientAuthenticationKeyboard(Sender: TObject; Prompts: TStringList; Echo: TBits; Responses: TStringList);
    procedure SSHClientCloseConnection(Sender: TObject);
    procedure SSHClientOpenConnection(Sender: TObject);
    procedure SSHClientBanner(Sender: TObject; const Text: string; const Language: string);
    procedure SSHClientError(Sender: TObject; ErrorCode: Integer);
    procedure SSHKeyValidate(Sender: TObject; ServerKey: TElSSHKey; var Validate: Boolean);

    procedure ShellSSHTunnelOpen(Sender: TObject; TunnelConnection: TElSSHTunnelConnection);
    procedure ShellSSHTunnelError(Sender: TObject; ErrorCode: Integer; Data: Pointer);
    procedure SSHTunnelConnectionData(Sender: TObject; Buffer: Pointer; Size: Integer);
    procedure SSHTunnelConnectionClose(Sender: TObject; CloseType: TSSHCloseType);
    procedure SSHTunnelConnectionError(Sender: TObject; ErrorCode: Integer);
  public
    procedure Connect;
    procedure Disconnect;

    property SSHClient: TElIdSSHClient read FSSHClient;
    property ShellSSHTunnel: TElShellSSHTunnel read FShellSSHTunnel;
    property KeyStorage: TElSSHMemoryKeyStorage read FKeyStorage;
    property SSHTunnelConnection: TElSSHTunnelConnection read FSSHTunnelConnection;
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.Connect;
var
  Key : TElSSHKey;
begin
  if SSHClient.Active then
  begin
    MessageDlg('Already connected', mtInformation, [mbOk], 0);
    Exit;
  end;

  with frmConnectionProperties do
    if ShowModal = mrOK then
    begin
      reTerminal.Clear;
      Application.ProcessMessages;

      SSHClient.Host := edHost.Text;
      SSHClient.Port := StrToIntDef(edPort.Text, 22);
      SSHClient.Username := edUsername.Text;
      SSHClient.Password := edPassword.Text;
      SSHClient.SoftwareName := 'ElIdSSHClient demo application';

      SSHClient.Versions := [];
      if cbSSHv1.Checked then
        SSHClient.Versions := SSHClient.Versions + [sbSSH1];

      if cbSSHv2.Checked then
        SSHClient.Versions := SSHClient.Versions + [sbSSH2];

      KeyStorage.Clear;
      Key := TElSSHKey.Create;
      if (edPrivateKey.Text <> '') and FileExists(edPrivateKey.Text) and
         (Key.LoadPrivateKey(edPrivateKey.Text) = 0) then
      begin
        KeyStorage.Add(Key);
        SSHClient.AuthenticationTypes := SSHClient.AuthenticationTypes or SSH_AUTH_TYPE_PUBLICKEY;
      end
      else
        SSHClient.AuthenticationTypes := SSHClient.AuthenticationTypes and not SSH_AUTH_TYPE_PUBLICKEY;
        
      Key.Free;

      Log(Format('Connecting to %s:%u', [SSHClient.Host, SSHClient.Port]));

      try
        SSHClient.Connect;
      except
        on E: Exception do
        begin
          Log('SSH connection failed with message [' + E.Message + ']', true);
          Exit;
        end;
      end;

      Log('SSH connection established');
    end;
end;

procedure TfrmMain.Disconnect;
begin
  if not SSHClient.Active then
    Exit;

  Log('Disconnecting');
  SSHClient.Disconnect;
end;

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

procedure TfrmMain.actConnectExecute(Sender: TObject);
begin
  Connect;
end;

procedure TfrmMain.actDisconnectExecute(Sender: TObject);
begin
  Disconnect;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  FSSHClient := TElIdSSHClient.Create(Self);
  FKeyStorage := TElSSHMemoryKeyStorage.Create(Self);
  FShellSSHTunnel := TElShellSSHTunnel.Create(Self);

  SSHClient.KeyStorage := KeyStorage;

  SSHClient.OnAuthenticationFailed := SSHClientAuthenticationFailed;
  SSHClient.OnAuthenticationSuccess := SSHClientAuthenticationSuccess;
  SSHClient.OnAuthenticationKeyboard := SSHClientAuthenticationKeyboard;
  SSHClient.OnCloseConnection := SSHClientCloseConnection;
  SSHClient.OnOpenConnection := SSHClientOpenConnection;
  SSHClient.OnBanner := SSHClientBanner;
  SSHClient.OnError := SSHClientError;
  SSHClient.OnKeyValidate := SSHKeyValidate;

  ShellSSHTunnel.TunnelList := FSSHClient.TunnelList;
  ShellSSHTunnel.OnOpen := ShellSSHTunnelOpen;
  ShellSSHTunnel.OnError := ShellSSHTunnelError;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  Disconnect;

  ShellSSHTunnel.TunnelList := nil;
  SSHClient.KeyStorage := nil;
  FreeAndNil(FShellSSHTunnel);
  FreeAndNil(FKeyStorage);
  FreeAndNil(FSSHClient);
end;

procedure TfrmMain.Log(const S: string; Error: Boolean);
var
  Item : TListItem;
begin
  Item := lvLog.Items.Add;
  Item.Caption := TimeToStr(Now);
  Item.SubItems.Add(S);
  if Error then
    Item.ImageIndex := 11
  else
    Item.ImageIndex := 10;

  Item.MakeVisible(False);
end;

procedure TfrmMain.SSHClientAuthenticationSuccess(Sender: TObject);
begin
  Log('Authentication succeeded');
end;

procedure TfrmMain.SSHClientAuthenticationFailed(Sender: TObject;
  AuthType: Integer);
begin
  Log(Format('Authentication attempt failed, AuthType = 0x%.2x', [AuthType]), True);
end;

procedure TfrmMain.SSHClientAuthenticationKeyboard(Sender: TObject;
  Prompts: TStringList; Echo: TBits; Responses: TStringList);
begin
  Log('AuthenticationKeyboard request');
end;

procedure TfrmMain.SSHClientBanner(Sender: TObject; const Text,
  Language: string);
begin
  Log('Banner Text: ' + Text);
  Log('Banner Language: ' + Language);
end;

procedure TfrmMain.SSHClientCloseConnection(Sender: TObject);
begin
  Log('Connection closed. ' + SSHClient.ServerCloseReason);
end;

procedure TfrmMain.SSHClientError(Sender: TObject; ErrorCode: Integer);
begin
  Log(Format('SSH Client Error: %u', [ErrorCode]), True);
end;

procedure TfrmMain.SSHClientOpenConnection(Sender: TObject);
begin
  Log('Connection opened.');
end;

procedure TfrmMain.SSHKeyValidate(Sender: TObject; ServerKey: TElSSHKey;
  var Validate: Boolean);
var
  AlgLine: string;
begin
  if ServerKey.Algorithm = ALGORITHM_RSA then
    AlgLine := 'RSA'
  else if ServerKey.Algorithm = ALGORITHM_DSS then
    AlgLine := 'DSS'
  else
    AlgLine := 'unknown';

  Log(Format('Server key received (%s). Fingerprint is %s', [AlgLine, BeautifyBinaryString(DigestToStr(ServerKey.FingerprintMD5), ':')]));
  Validate := True;
end;

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

procedure TfrmMain.ShellSSHTunnelOpen(Sender: TObject;
  TunnelConnection: TElSSHTunnelConnection);
begin
  Log('Tunnel connection opened.');
  FSSHTunnelConnection := TunnelConnection;
  SSHTunnelConnection.OnData := SSHTunnelConnectionData;
  SSHTunnelConnection.OnExtendedData := SSHTunnelConnectionData;
  SSHTunnelConnection.OnError := SSHTunnelConnectionError;
  SSHTunnelConnection.OnClose := SSHTunnelConnectionClose;
end;

procedure TfrmMain.ShellSSHTunnelError(Sender: TObject; ErrorCode: Integer;
  Data: Pointer);
begin
  Log(Format('Shell Tunnel Error: %u', [ErrorCode]), True);
end;

procedure TfrmMain.SSHTunnelConnectionClose(Sender: TObject;
  CloseType: TSSHCloseType);
var
  t: string;
  Error: Boolean;
begin
  if Sender = FSSHTunnelConnection then
    FSSHTunnelConnection := nil;
  Error := False;
  case CloseType of
    ctReturn: t := 'Return';
    ctSignal: t := 'Signal';
    ctError:
     begin
       t := 'Error';
       Error := True;
     end
  else
    t := 'Unknown';
  end;

  Log(Format('Tunnel connection closed. Type: %s', [t]), Error);
end;

procedure TfrmMain.SSHTunnelConnectionData(Sender: TObject;
  Buffer: Pointer; Size: Integer);
var
  Buf: string;
begin
  SetLength(Buf, Size);
  Move(Buffer^, Buf[1], Size);

  reTerminal.SelLength := 0;
  reTerminal.SelStart := Length(reTerminal.Text) + 1;
  reTerminal.SelText := Buf;
end;

procedure TfrmMain.SSHTunnelConnectionError(Sender: TObject;
  ErrorCode: Integer);
begin
  Log(Format('SSH Tunnel Connection Error: %u', [ErrorCode]), True);
end;

procedure TfrmMain.reTerminalKeyPress(Sender: TObject; var Key: Char);
begin
  if FSSHTunnelConnection <> nil then
    FSSHTunnelConnection.SendData(@Key, 1);
  Key := #0;
end;


initialization

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

end.