mainform.pas

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

unit MainForm;

interface

// EmulVT is a part of Internet Component Suite (ICS) which emulates terminal
// and understands escape sequences.

// If you get EElTerminalException error (Invalid OPCODE index), please add
// EElTerminalException to the list of ignored exceptions in your IDE.

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  EmulVT, ExtCtrls, SBSSHClient, StdCtrls, SBSSHTerm, ScktComp, ComCtrls,
  SBUtils, SBSSHKeyStorage, ImgList, SBSSHConstants, SBSSHCommon;

type
  TFormMain = class(TForm)
    ElSSHClient: TElSSHClient;
    ElShellSSHTunnel: TElShellSSHTunnel;
    ElSSHTunnelList: TElSSHTunnelList;
    PanelTop: TPanel;
    PanelClient: TPanel;
    EmulVT: TEmulVT;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    EditUsername: TEdit;
    Label2: TLabel;
    EditPassword: TEdit;
    GroupBox2: TGroupBox;
    Label3: TLabel;
    EditServer: TEdit;
    EditPort: TEdit;
    Label4: TLabel;
    ButtonConnect: TButton;
    ClientSocket: TClientSocket;
    PanelLog: TPanel;
    ListView: TListView;
    Splitter1: TSplitter;
    ImageList: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ButtonConnectClick(Sender: TObject);
    procedure ElSSHClientAuthenticationFailed(Sender: TObject;
      AuthenticationType: Integer);
    procedure ElSSHClientAuthenticationSuccess(Sender: TObject);
    procedure ElSSHClientCloseConnection(Sender: TObject);
    procedure ElSSHClientError(Sender: TObject; ErrorCode: Integer);
    procedure ElSSHClientKeyValidate(Sender: TObject; ServerKey: TElSSHKey;
      var Validate: Boolean);
    procedure ElSSHClientOpenConnection(Sender: TObject);
    procedure ElSSHClientReceive(Sender: TObject; Buffer: Pointer;
      MaxSize: Integer; out Written: Integer);
    procedure ElSSHClientSend(Sender: TObject; Buffer: Pointer;
      Size: Integer);
    procedure ElShellSSHTunnelClose(Sender: TObject;
      TunnelConnection: TElSSHTunnelConnection);
    procedure ElShellSSHTunnelOpen(Sender: TObject;
      TunnelConnection: TElSSHTunnelConnection);
    procedure ClientSocketConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure ConnData(Sender : TObject; Buffer: pointer; Size : integer);
    procedure ConnError(Sender: TObject; Error :integer);
    procedure ConnClose(Sender : TObject; CloseType : TSSHCloseType);
    procedure EmulVTKeyBuffer(Sender: TObject; Buffer: PChar;
      Len: Integer);
    procedure EmulVTKeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    procedure Log(const S : string; Flag : boolean = true);
    procedure ConnStateChanged(Conn : boolean);
  end;

var
  FormMain: TFormMain;
  TermInfo : TElTerminalInfo;
  Conn : TElSSHTunnelConnection;
  Connected : boolean;

implementation

{$R *.DFM}

procedure TFormMain.FormCreate(Sender: TObject);
begin
  TermInfo := TElTerminalInfo.Create(nil);
  TermInfo.TerminalType := 'vt220';
  ElShellSSHTunnel.TerminalInfo := TermInfo;

  TermInfo.Cols := 160;
  TermInfo.Rows := 40;
  EmulVT.Cols := 160;
  EmulVT.Rows := 40;

  EmulVT.Clear;
  EmulVT.Xlat := false;
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
  TermInfo.Free;
end;

procedure TFormMain.Log(const S : string; Flag : boolean = true);
var
  Item : TListItem;
begin
  Item := ListView.Items.Add;
  Item.SubItems.Add(DateTimeToStr(Now));
  Item.SubItems.Add(S);
  if Flag then
    Item.ImageIndex := 0
  else
    Item.ImageIndex := 1;
end;

procedure TFormMain.ButtonConnectClick(Sender: TObject);
begin
  ListView.Items.Clear;
  ElSSHClient.Username := EditUsername.Text;
  ElSSHClient.Password := EditPassword.Text;
  ClientSocket.Host := EditServer.Text;
  ClientSocket.Port := StrToInt(EditPort.Text);
  ClientSocket.Open;
end;

procedure TFormMain.ElSSHClientAuthenticationFailed(Sender: TObject;
  AuthenticationType: Integer);
begin
  Log('Authentication type 0x' + IntToHex(AuthenticationType, 2) + ' failed', false);
end;

procedure TFormMain.ElSSHClientAuthenticationSuccess(Sender: TObject);
begin
  Log('Authentication succeeded');
end;

procedure TFormMain.ElSSHClientCloseConnection(Sender: TObject);
begin
  Log('SSH Connection closed');
  ConnStateChanged(false);
end;

procedure TFormMain.ElSSHClientError(Sender: TObject; ErrorCode: Integer);
begin
  Log('SSH Error ' + IntToStr(ErrorCode), false);
end;

procedure TFormMain.ElSSHClientKeyValidate(Sender: TObject;
  ServerKey: TElSSHKey; var Validate: Boolean);
var
  M128 : TMessageDigest128;
  AlgLine, S : string;
begin
  if ServerKey.Algorithm = ALGORITHM_RSA then
    AlgLine := 'RSA'
  else if ServerKey.Algorithm = ALGORITHM_DSS then
    AlgLine := 'DSS'
  else
    AlgLine := 'unknown';
  M128 := ServerKey.FingerprintMD5;
  S := DigestToStr(M128);
  Log('Server key received (' + AlgLine + '). Fingerprint is ' + BeautifyBinaryString(S, ':'));
end;

procedure TFormMain.ElSSHClientOpenConnection(Sender: TObject);
begin
  Log('SSH connection opened');
  ConnStateChanged(true);
end;

procedure TFormMain.ElSSHClientReceive(Sender: TObject; Buffer: Pointer;
  MaxSize: Integer; out Written: Integer);
begin
  Written := ClientSocket.Socket.ReceiveBuf(Buffer^, MaxSize);
  if Written < 0 then
    Written := 0;
end;

procedure TFormMain.ElSSHClientSend(Sender: TObject; Buffer: Pointer;
  Size: Integer);
begin
  ClientSocket.Socket.SendBuf(Buffer^, Size);
end;

procedure TFormMain.ElShellSSHTunnelClose(Sender: TObject;
  TunnelConnection: TElSSHTunnelConnection);
begin
  Log('Shell connection closed');
end;

procedure TFormMain.ElShellSSHTunnelOpen(Sender: TObject;
  TunnelConnection: TElSSHTunnelConnection);
begin
  Log('Shell connection opened');
  Conn := TunnelConnection;
  Conn.OnData := ConnData;
  Conn.OnError := ConnError;
  Conn.OnClose := ConnClose;
end;

procedure TFormMain.ClientSocketConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Log('Socket connection established');
  ElSSHClient.Open;
end;

procedure TFormMain.ClientSocketDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Log('Socket connection closed');
  ConnStateChanged(false);
end;

procedure TFormMain.ClientSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  ElSSHClient.DataAvailable;
end;

procedure TFormMain.ConnData(Sender : TObject; Buffer: pointer; Size : integer);
begin
  EmulVT.WriteBuffer(Buffer, Size);
end;

procedure TFormMain.ConnError(Sender: TObject; Error :integer);
begin
  Log('SSH Shell Connection error ' + IntToStr(Error), false);
end;

procedure TFormMain.ConnClose(Sender : TObject; CloseType : TSSHCloseType);
begin
  Log('SSH Shell Connection closed');
end;

procedure TFormMain.EmulVTKeyBuffer(Sender: TObject; Buffer: PChar;
  Len: Integer);
begin
  Conn.SendData(Buffer, Len);
end;

procedure TFormMain.EmulVTKeyPress(Sender: TObject; var Key: Char);
begin
  Conn.SendData(@Key, 1);
end;

procedure TFormMain.ConnStateChanged(Conn : boolean);
begin
  Connected := Conn;
  if Connected then
    ButtonConnect.Caption := 'Disconnect'
  else
  begin
    ButtonConnect.Caption := 'Connect';
    if ClientSocket.Active then
      ClientSocket.Close;
  end;
end;


initialization

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

end.