mainform.pas

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

unit MainForm;

interface

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

type
  TfrmMain = class(TForm)
    Forwarding: TElSSHLocalPortForwarding;
    pConnProps: TPanel;
    pClient: TPanel;
    pLog: TPanel;
    lvLog: TListView;
    splitterLogConns: TSplitter;
    lvConnections: TListView;
    pSSHSettings: TPanel;
    pForwardingSettings: TPanel;
    lblHost: TLabel;
    lblPort: TLabel;
    editHost: TEdit;
    editPort: TEdit;
    lblUsername: TLabel;
    editUsername: TEdit;
    lblPassword: TLabel;
    editPassword: TEdit;
    lblForwardedPort: TLabel;
    editForwardedPort: TEdit;
    lblDestHostAndPort: TLabel;
    editDestHost: TEdit;
    editDestPort: TEdit;
    btnStart: TButton;
    imgLog: TImageList;
    imgConns: TImageList;
    procedure btnStartClick(Sender: TObject);
    procedure ForwardingAuthenticationFailed(Sender: TObject;
      AuthenticationType: Integer);
    procedure ForwardingAuthenticationSuccess(Sender: TObject);
    procedure ForwardingError(Sender: TObject; ErrorCode: Integer);
    procedure ForwardingKeyValidate(Sender: TObject; ServerKey: TElSSHKey;
      var Validate: Boolean);
    procedure ForwardingConnectionOpen(Sender: TObject;
      Conn: TElSSHForwardedConnection);
    procedure ForwardingConnectionClose(Sender: TObject;
      Conn: TElSSHForwardedConnection);
    procedure ForwardingConnectionChange(Sender: TObject;
      Conn: TElSSHForwardedConnection);
    procedure ForwardingOpen(Sender: TObject);
    procedure ForwardingClose(Sender: TObject);
    procedure ForwardingConnectionError(Sender: TObject;
      Conn: TElSSHForwardedConnection; ErrorCode: Integer);
  private
    procedure Log(const S : string; Error : boolean);
    procedure RefreshConnection(Conn: TElSSHForwardedConnection; Item : TListItem);
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.DFM}

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 := 1
  else
    Item.ImageIndex := 0;
end;

procedure TfrmMain.RefreshConnection(Conn: TElSSHForwardedConnection; Item : TListItem);
var
  S : string;
begin
  lvConnections.Items.BeginUpdate;
  try
    Item.SubItems.Clear;
    if Conn.Socket <> nil then
      Item.Caption := Conn.Socket.Address
    else
      Item.Caption := 'N/A';
    Item.SubItems.Add(IntToStr(Conn.ReceivedFromSocket));
    Item.SubItems.Add(IntToStr(Conn.SentToSocket));
    Item.SubItems.Add(IntToStr(Conn.ReceivedFromChannel));
    Item.SubItems.Add(IntToStr(Conn.SentToChannel));
    case Conn.SocketState of
      fssEstablishing: S := 'Establishing';
      fssActive: S := 'Active';
      fssClosing: S := 'Closing';
      fssClosed: S := 'Closed';
    end;
    Item.SubItems.Add(S);
    case Conn.ChannelState of
      fcsEstablishing: S := 'Establishing';
      fcsActive: S := 'Active';
      fcsClosing: S := 'Closing';
      fcsClosed: S := 'Closed';
    end;
    Item.SubItems.Add(S);
    if (Conn.ChannelState = fcsActive) and (Conn.SocketState = fssActive) then
      Item.ImageIndex := 1
    else if (Conn.ChannelState = fcsEstablishing) or (Conn.SocketState = fssEstablishing) then
      Item.ImageIndex := 0
    else
      Item.ImageIndex := 2;
  finally
    lvConnections.Items.EndUpdate;
  end;
end;

procedure TfrmMain.btnStartClick(Sender: TObject);
var
  I : integer;
begin
  if not Forwarding.Active then
  begin
    Forwarding.Address := editHost.Text;
    Forwarding.Port := StrToIntDef(editPort.Text, 22);
    Forwarding.ForwardedPort := StrToIntDef(editForwardedPort.Text, 5001);
    Forwarding.ForwardedHost := '';
    Forwarding.DestHost := editDestHost.Text;
    Forwarding.DestPort := StrToIntDef(editDestPort.Text, 5001);
    Forwarding.Username := editUsername.Text;
    Forwarding.Password := editPassword.Text;
    Forwarding.Open;
  end
  else
  begin
    Forwarding.Close();
  end;
end;

procedure TfrmMain.ForwardingAuthenticationFailed(Sender: TObject;
  AuthenticationType: Integer);
begin
  Log('Authentication type ' + IntToStr(AuthenticationType) + ' failed', true);
end;

procedure TfrmMain.ForwardingAuthenticationSuccess(Sender: TObject);
begin
  Log('Authentication succeeded', false);
end;

procedure TfrmMain.ForwardingError(Sender: TObject; ErrorCode: Integer);
begin
  Log('SSH protocol error ' + IntToStr(ErrorCode), true);
end;

procedure TfrmMain.ForwardingKeyValidate(Sender: TObject;
  ServerKey: TElSSHKey; var Validate: Boolean);
begin
  Log('Server key received', false);
  Validate := true;
end;

procedure TfrmMain.ForwardingConnectionOpen(Sender: TObject;
  Conn: TElSSHForwardedConnection);
var
  Item : TListItem;
begin
  Log('New secure channel opened', false);
  Item := lvConnections.Items.Add();
  Item.Data := Conn;
  RefreshConnection(Conn, Item);
end;

procedure TfrmMain.ForwardingConnectionClose(Sender: TObject;
  Conn: TElSSHForwardedConnection);
var
  Item: TListItem;
begin
  Log('Secure channel closed', false);
  Item := lvConnections.FindData(0, Conn, true, false);
  lvConnections.Items.Delete(Item.Index);
end;

procedure TfrmMain.ForwardingConnectionChange(Sender: TObject;
  Conn: TElSSHForwardedConnection);
var
  Item : TListItem;
begin
  Item := lvConnections.FindData(0, Conn, true, false);
  RefreshConnection(Conn, Item);
end;

procedure TfrmMain.ForwardingOpen(Sender: TObject);
begin
  Log('SSH connection established', false);
end;

procedure TfrmMain.ForwardingClose(Sender: TObject);
begin
  Log('SSH connection closed', false);
end;

procedure TfrmMain.ForwardingConnectionError(Sender: TObject;
  Conn: TElSSHForwardedConnection; ErrorCode: Integer);
begin
  Log('SSH connection error: ' + IntToStr(ErrorCode), true);
end;

initialization

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


end.