mainform.pas

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

unit MainForm;

interface

uses
  Windows, Messages, Graphics, Controls, Forms, Dialogs, ToolWin, ComCtrls,
  Menus, Buttons, Spin, SysUtils, Classes, IdBaseComponent,
  IdComponent, IdTCPConnection, IdTCPClient, ExtCtrls, StdCtrls,
  IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack, SBSSHCommon, SBSSHClient,
  Login, SBSSHConstants, SBSSHKeyStorage, SBUtils, SBIndySSHClientIOHandler10;

type
  TfrmChatClient = class(TForm)
    lServer: TLabel;
    edServer: TEdit;
    lOnline: TLabel;
    lbClients: TListBox;
    lMessages: TLabel;
    memMessages: TMemo;
    lYourMessage: TLabel;
    edMessage: TEdit;
    btnConnect: TSpeedButton;
    Timer1: TTimer;
    lPort: TLabel;
    sePort: TSpinEdit;
    btnRefresh: TButton;
    dlgCert: TOpenDialog;
    SSHTransport: TElClientIndySSHTransport;
    SSHClientIOHandler: TElClientIndySSHIOHandlerSocket;
    pTop: TPanel;
    procedure Timer1Timer(Sender: TObject);
    procedure btnConnectClick(Sender: TObject);
    procedure edMessageKeyPress(Sender: TObject; var Key: Char);
    procedure btnRefreshClick(Sender: TObject);
    procedure FormCanResize(Sender: TObject; var NewWidth,
      NewHeight: Integer; var Resize: Boolean);
    procedure SSHTransportAuthenticationFailed(Sender: TObject;
      AuthenticationType: Integer);
    procedure SSHTransportAuthenticationSuccess(Sender: TObject);
    procedure SSHTransportKeyValidate(Sender: TObject;
      ServerKey: TElSSHKey; var Validate: Boolean);
    procedure SSHTransportCloseConnection(Sender: TObject);
    procedure SSHTransportOpenConnection(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    Login : string;
    { Private declarations }
    procedure SendText(const Text : string);
    function ReceiveString : string;
  public
  end;

var
  frmChatClient: TfrmChatClient;

implementation

{$R *.DFM}

procedure TfrmChatClient.Timer1Timer(Sender: TObject);
var
  Com,
  Msg : String;
begin
  if not SSHTransport.Active then
    Exit;

  { trying to receive string }  
  Msg := ReceiveString;

  if Msg <> '' then
    if Msg[1] <> '@' then
      begin
      { Not a command }
        memMessages.Lines.Add(Msg);
      end
    else
      begin
      { command }
        Com := UpperCase(Trim(Copy(Msg, 2, Pos(':', Msg) -2)));
        Msg := Trim(Copy(Msg, Pos(':', Msg) +1, Length(Msg)));
        { clients list }
        if Com = 'CLIENTS' then
          lbClients.Items.CommaText := Msg;
      end;
end;

procedure TfrmChatClient.btnConnectClick(Sender: TObject);
var
  FrmResult : integer;
  Pass : string;
begin
  if (edServer.Text <> '') and (btnConnect.Down) then
    FrmResult := frmLogin.ShowModal
  else if edServer.Text = '' then
  begin
    btnConnect.Down := false;
    ShowMessage('Enter valid server name.');
    Exit;
  end
  else
  begin
    { disconnecting from server }
    try
      SSHClientIOHandler.Close;
      SSHTransport.Disconnect;
      lbClients.Items.Clear;
    finally
      btnConnect.Down := false;
      memMessages.Lines.Add('** Disconnected.');
    end;
    Exit;
  end;

  if FrmResult = 1 then
  begin
    { connecting to server }
    Login := frmLogin.edLogin.Text;
    Pass := frmLogin.edPassword.Text;
    frmLogin.edPassword.Text := '';
    memMessages.Lines.Add('** Connecting to ' + edServer.Text + ':'  + sePort.Text + '...');
    SSHTransport.Host := edServer.Text;
    SSHTransport.Port := sePort.Value;
    SSHTransport.Username := Login;
    SSHTransport.Password := Pass;
    try
      SSHTransport.Connect;
      { we are using subsystem ssh tunnel, named 'chat' }
      SSHClientIOHandler.Subsystem := 'chat';
      SSHClientIOHandler.Open;
      memMessages.Lines.Add('** SSH channel opened.');
    except
      on E : Exception do
      begin
        if SSHTransport.Active then
          SSHTransport.Disconnect;
        memMessages.Lines.Add('** Connection error : ' + E.Message);
        btnConnect.Down := false;
      end;
    end;
  end
  else
    btnConnect.Down := false;
end;

procedure TfrmChatClient.edMessageKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
    begin
      SendText('@MSG:' + edMessage.Text);
      edMessage.Text := '';
    end;
end;

procedure TfrmChatClient.btnRefreshClick(Sender: TObject);
begin
  if btnConnect.Down then
    SendText('@CLIENTS:REQUEST')
  else
    lbClients.Items.Clear;
end;

function TfrmChatClient.ReceiveString: string;
begin
  if SSHClientIOHandler.Connected then
    Result := SSHClientIOHandler.ReadLn('', 5)
  else
    Result := '';
end;

procedure TfrmChatClient.SendText(const Text: string);
begin
  if SSHClientIOHandler.Connected then
    SSHClientIOHandler.WriteLn(Text)
  else
    memMessages.Lines.Add('** You aren''t connected.');
end;

procedure TfrmChatClient.FormCanResize(Sender: TObject; var NewWidth,
  NewHeight: Integer; var Resize: Boolean);
begin
  Resize := true;
  if NewWidth < 467 then
    NewWidth := 467;
end;

procedure TfrmChatClient.SSHTransportAuthenticationFailed(Sender: TObject;
  AuthenticationType: Integer);
begin
  { notification about incorrect password or login }
  if AuthenticationType = SSH_AUTH_TYPE_PASSWORD then
    memMessages.Lines.Add('** Error : incorrect login or password.');
end;

procedure TfrmChatClient.SSHTransportAuthenticationSuccess(
  Sender: TObject);
begin
  { succesfull notification }
  memMessages.Lines.Add('** Authentication succesfull.');
end;

procedure TfrmChatClient.SSHTransportKeyValidate(Sender: TObject;
  ServerKey: TElSSHKey; var Validate: Boolean);
var
  Fingerprint, Str : string;
  Res : integer;
  KeyFile : TextFile;
begin
  Fingerprint := DigestToStr(ServerKey.FingerprintSHA1);

  { searching for cashed server key fingerprint in file }

  if FileExists('.chat_keys') then
  try
    System.Assign(KeyFile, '.chat_keys');
    ReSet(KeyFile);
    while not EOF(KeyFile) do
    begin
      ReadLn(KeyFile, Str);

      if Str = Fingerprint then
      begin
        Validate := true;
        System.Close(KeyFile);
        Exit;
      end;
    end;

    System.Close(KeyFile);
  finally
  end;

  { we are first time connecting to server - asking user about key }
  Res := MessageBox(0, PAnsiChar('Server key fingerprint is ' + Fingerprint +
    '.'#13#10'If it corresponds to server, you are connecting to, press yes.'),
    'Server key validation', MB_YESNO);
  if Res = ID_YES then
  begin
    Validate := true;
    try
      System.Assign(KeyFile, '.chat_keys');

      if not FileExists('.chat_keys') then
        ReWrite(KeyFile)
      else
        Append(KeyFile);
      WriteLn(KeyFile, Fingerprint);
      System.Close(KeyFile);
    finally
    end;
  end  
  else
  begin
    Validate := false;
    memMessages.Lines.Add('** Server key validation failed : unknown key.');
  end;
end;

procedure TfrmChatClient.SSHTransportCloseConnection(Sender: TObject);
begin
  if btnConnect.Down then
  begin
    memMessages.Lines.Add('** Disconnected.');

    btnConnect.Down := SSHClientIOHandler.Connected and SSHTransport.Active;
    lbClients.Items.Clear;
  end;  
end;

procedure TfrmChatClient.SSHTransportOpenConnection(Sender: TObject);
begin
  memMessages.Lines.Add('** SSH connection established. Opening channel...');
end;

procedure TfrmChatClient.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  if btnConnect.Down then
  try
    SSHClientIOHandler.Close;
    SSHTransport.Disconnect;
    lbClients.Items.Clear;
  finally
    btnConnect.Down := false;
    memMessages.Lines.Add('** Disconnected.');
  end;
end;


initialization

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

end.