mainform.pas

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

{$A+,B-,C+,D+,E-,F-,G+,H+,I+,J+,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1}
{$MINSTACKSIZE $00004000}
{$MAXSTACKSIZE $00100000}
{$IMAGEBASE $00400000}
{$APPTYPE GUI}
unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ScktComp, Buttons, WinSock, ExtCtrls,
  SBSSHClient, SBSSHCommon, SBSSHConstants, SBSSHKeyStorage, SBUtils;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    Edit1: TEdit;
    Label1: TLabel;
    Edit2: TEdit;
    Label2: TLabel;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    GroupBox2: TGroupBox;
    Label3: TLabel;
    Edit3: TEdit;
    Edit4: TEdit;
    Label4: TLabel;
    Memo1: TMemo;
    Button1: TButton;
    Memo2: TMemo;
    Label5: TLabel;
    Edit5: TEdit;
    Button2: TButton;
    ClientSocket1: TClientSocket;
    Edit6: TEdit;
    Label6: TLabel;
    OpenDialog1: TOpenDialog;
    BrowseBtn: TButton;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure Button2Click(Sender: TObject);
    procedure BrowseBtnClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    ClientState : integer;
    procedure HandleClientSend(Sender : TObject; Buffer : pointer; Size : integer);
    procedure HandleClientReceive(Sender : TObject; Buffer : pointer; MaxSize : integer;
      out Written : integer);
    procedure HandleClientOpenConnection(Sender : TObject);
    procedure HandleClientCloseConnection(Sender : TObject);
    procedure HandleClientDebugData(Sender : TObject; Buffer : pointer;
      Size : integer);
    procedure HandleClientError(Sender : TObject; Error : integer);
    procedure HandleClientAuthenticationSuccess(Sender : TObject);
    procedure HandleClientAuthenticationFailed(Sender : TObject; AuthType : integer);
    procedure HandleClientAuthenticationKeyboard(Sender: TObject;
     Prompts : TStringList; Echo : TBits; Responses : TStringList);
    
    procedure HandleTunnelOpen(Sender : TObject; TunnelConnection :
      TElSSHTunnelConnection);
    procedure HandleTunnelClose(Sender : TObject; TunnelConnection :
      TElSSHTunnelConnection);
    procedure HandleTunnelError(Sender : TObject; Error : integer; Data : pointer);
    procedure HandleConnectionData(Sender : TObject; Buffer : pointer; Size : integer);
    procedure HandleConnectionError(Sender : TObject; Error : integer);
    procedure HandleConnectionClose(Sender : TObject; CloseType : TSSHCloseType);
    procedure HandleKeyValidate(Sender: TObject; ServerKey: TElSSHKey; var Validate: Boolean);
  protected
    FConnected: Boolean;
    procedure SetConnected(Value: Boolean);
    property Connected: Boolean read FConnected write SetConnected;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Client : TElSSHClient;
  Tunnel : TElShellSSHTunnel;
  TunnelList : TElSSHTunnelList;
  Connection : TElSSHTunnelConnection;
  KeyStorage : TElSSHMemoryKeyStorage;

implementation

uses PromptForm;

{$R *.DFM}

const
  CLIENT_STATE_NOT_CONNECTED            = 0;
  CLIENT_STATE_CONNECTING               = 1;
  CLIENT_STATE_ERROR                    = 2;
  CLIENT_STATE_DISCONNECTED             = 3;
  CLIENT_STATE_CONNECTED                = 4;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Client := TElSSHClient.Create(Self);
  Client.OnSend := HandleClientSend;
  Client.OnReceive := HandleClientReceive;
  Client.OnOpenConnection := HandleClientOpenConnection;
  Client.OnCloseConnection := HandleClientCloseConnection;
  Client.OnDebugData := HandleClientDebugData;
  Client.OnError := HandleClientError;
  Client.OnAuthenticationSuccess := HandleClientAuthenticationSuccess;
  Client.OnAuthenticationFailed := HandleClientAuthenticationFailed;
  Client.OnAuthenticationKeyboard := HandleClientAuthenticationKeyboard;

  Client.OnKeyValidate := HandleKeyValidate;

  Tunnel := TElShellSSHTunnel.Create(Self);
  Tunnel.OnOpen := HandleTunnelOpen;
  Tunnel.OnClose := HandleTunnelClose;
  Tunnel.OnError := HandleTunnelError;

  TunnelList := TElSSHTunnelList.Create(Self);
  Tunnel.TunnelList := TunnelList;
  Client.TunnelList := TunnelList;

  KeyStorage := TElSSHMemoryKeyStorage.Create(Self);
  Client.KeyStorage := KeyStorage;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Client.Free;
  TunnelList.Free;
  Tunnel.Free;
  KeyStorage.Free;
end;

////////////////////////////////////////////////////////////////////////////////
// Handlers

procedure TForm1.HandleClientSend(Sender : TObject; Buffer : pointer; Size : integer);
begin
  ClientSocket1.Socket.SendBuf(Buffer^, Size);
end;

procedure TForm1.HandleClientReceive(Sender : TObject; Buffer : pointer; MaxSize : integer;
  out Written : integer);
begin
  Written := ClientSocket1.Socket.ReceiveBuf(Buffer^, MaxSize);
  if Written < 0 then
    Written := 0;
end;

procedure TForm1.HandleClientOpenConnection(Sender : TObject);
begin
  ClientState := CLIENT_STATE_CONNECTED;
  Memo2.Lines.Add('Connection started');
  Memo2.Lines.Add('Server: ' + Client.ServerSoftwareName);
  case Client.Version of
    sbSSH1 : Memo2.Lines.Add('Version: SSHv1');
    sbSSH2 : Memo2.Lines.Add('Version: SSHv2');
  end;
  Memo2.Lines.Add('PublicKey algorithm: ' + IntToStr(Client.PublicKeyAlgorithm));
  Memo2.Lines.Add('Kex algorithm: ' + IntToStr(Client.KexAlgorithm));
  Memo2.Lines.Add('Block algorithm: ' + IntToStr(Client.EncryptionAlgorithmServerToClient));
  Memo2.Lines.Add('Compression algorithm: ' + IntToStr(Client.CompressionAlgorithmServerToClient));
  Memo2.Lines.Add('MAC algorithm: ' + IntToStr(Client.MacAlgorithmServerToClient));
end;

procedure TForm1.HandleClientCloseConnection(Sender : TObject);
begin
  ClientState := CLIENT_STATE_DISCONNECTED;
  Memo2.Lines.Add('Connection closed. ' + Client.ServerCloseReason);
  ClientSocket1.Close;
end;

procedure TForm1.HandleClientDebugData(Sender : TObject; Buffer : pointer;
  Size : integer);
var
  S : string;
begin
  SetLength(S, Size);
  Move(Buffer^, S[1], Size);
  Memo2.Lines.Add('Debug: ' + S);
end;

procedure TForm1.HandleClientError(Sender : TObject; Error : integer);
begin
  ClientState := CLIENT_STATE_ERROR;
  Memo2.Lines.Add('Error: ' + IntToStr(Error));
end;

procedure TForm1.HandleClientAuthenticationSuccess(Sender : TObject);
begin
  Memo2.Lines.Add('Authentication succeeded');
end;

procedure TForm1.HandleClientAuthenticationFailed(Sender : TObject; AuthType : integer);
begin
  Memo2.Lines.Add('Authentication attempt failed, AuthType=' + IntToStr(AuthType));
end;

procedure TForm1.HandleTunnelOpen(Sender : TObject; TunnelConnection :
  TElSSHTunnelConnection);
begin
  Connection := TunnelConnection;
  Connection.OnData := HandleConnectionData;
  Connection.OnError := HandleConnectionError;
  Connection.OnClose := HandleConnectionClose;
end;

procedure TForm1.HandleTunnelClose(Sender : TObject; TunnelConnection :
  TElSSHTunnelConnection);
begin
//
end;

procedure TForm1.HandleTunnelError(Sender : TObject; Error : integer; Data : pointer);
begin
  Memo2.Lines.Add('Tunnel error: ' + IntToStr(Error));
end;

procedure TForm1.HandleConnectionData(Sender : TObject; Buffer : pointer; Size : integer);
var
  S : string;
begin
  SetLength(S, Size);
  Move(Buffer^, S[1], Size);
  Memo1.Lines.Text := Memo1.Lines.Text + S;
end;

procedure TForm1.HandleConnectionError(Sender : TObject; Error : integer);
begin
  Memo2.Lines.Add('Connection error: ' + IntToStr(Error));
end;

procedure TForm1.HandleConnectionClose(Sender : TObject; CloseType : TSSHCloseType);
begin
  Memo2.Lines.Add('Shell connection closed');
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  Key : TElSSHKey;
begin
  if not Connected then
  begin
    Connection := nil;
    Client.Versions := [];
    if CheckBox1.Checked then
      Client.Versions := Client.Versions + [sbSSH1];
    if CheckBox2.Checked then
      Client.Versions := Client.Versions + [sbSSH2];
    Client.UserName := Edit3.Text;
    Client.Password := Edit4.Text;

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

    ClientSocket1.Host := Edit1.Text;
    ClientSocket1.Port := StrToInt(Edit2.Text);
    ClientSocket1.Open;
    ClientState := CLIENT_STATE_CONNECTING;
    Client.Open;
    while ClientState = CLIENT_STATE_CONNECTING do
      Client.DataAvailable;
    if ClientState <> CLIENT_STATE_CONNECTED then
    begin
      ShowMessage('Failed to establish SSH connection');
      exit;
    end;
    Button1.Caption := 'Disconnect';
    Connected := true;     
  end
  else
  begin
    ClientState := CLIENT_STATE_NOT_CONNECTED;
    if Assigned(Connection) then
      Client.Close;
    Button1.Caption := 'Connect';
    Connected := false;
  end;
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Memo2.Lines.Add('Client socket connected');
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  //Client.DataAvailable;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Connection.SendText(Edit5.Text + #13#10);
  Edit5.Text := '';
end;

procedure TForm1.BrowseBtnClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
    Edit6.Text := OpenDialog1.Filename;
end;

procedure TForm1.SetConnected(Value: Boolean);
begin
  FConnected := Value;
  Timer1.Enabled := Value;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var FDSet : TFDSet;
  TimeVal: TTimeVal;
  PTV: PTimeVal;

begin
  if ClientState = CLIENT_STATE_CONNECTED then
  begin
    FD_ZERO(FDSet);
    FD_SET(ClientSocket1.Socket.SocketHandle, FDSet);
    TimeVal.tv_sec := 0;
    TimeVal.tv_usec := 0;
    PTV := @TimeVal;
    case select(ClientSocket1.Socket.SocketHandle + 1, @FDSet, nil, nil, PTV) of
      -1:
        begin
          ClientState := CLIENT_STATE_NOT_CONNECTED;
          ClientSocket1.Close;
          Connected := false;
        end;
       0: begin end;
       1: Client.DataAvailable;
    end;
  end;
end;

procedure TForm1.HandleKeyValidate(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';

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


procedure TForm1.HandleClientAuthenticationKeyboard(Sender: TObject;
  Prompts: TStringList; Echo: TBits; Responses: TStringList);
var i : integer;
    S : string;
begin
  Responses.Clear;
  for i := 0 to Prompts.Count - 1 do
  begin
    if TfrmPrompt.Prompt(Prompts[i], Echo[i], S) then
      Responses.Add(S)
    else
      Responses.Add('');
  end;
end;

initialization

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

end.