mainform.pas

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

PAS
250
字号
unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  OleCtrls, SHDocVw, ExtCtrls, StdCtrls, ComCtrls, SBSSHClient, ScktComp,
  SBSSHKeyStorage, SBUtils, Contnrs, SBSSHConstants, ImgList, SBSSHCommon,
  IdTCPServer, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  ClientThread, IdAntiFreezeBase, IdAntiFreeze, QueryThread, SqlExpr;
                              
type
  TFormMain = class(TForm)
    GroupBox1: TGroupBox;
    Panel1: TPanel;
    EditHost: TEdit;
    EditPort: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    EditUsername: TEdit;
    Label4: TLabel;
    EditPassword: TEdit;
    Panel2: TPanel;
    Label5: TLabel;
    EditLocalPort: TEdit;
    Label6: TLabel;
    EditRemoteHost: TEdit;
    EditRemotePort: TEdit;
    ButtonStart: TButton;
    ImageList: TImageList;
    PanelClient: TPanel;
    ListView: TListView;
    Splitter1: TSplitter;
    PanelStatus: TPanel;
    ListViewConnections: TListView;
    ImageListConns: TImageList;
    IdAntiFreeze1: TIdAntiFreeze;
    Panel3: TPanel;
    Label7: TLabel;
    EditDBUsername: TEdit;
    Label8: TLabel;
    EditDBPassword: TEdit;
    Label9: TLabel;
    EditDBName: TEdit;
    Panel4: TPanel;
    ListViewResults: TListView;
    Label10: TLabel;
    EditQuery: TEdit;
    btnExecute: TButton;
    procedure FormCreate(Sender: TObject);
    procedure ButtonStartClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnExecuteClick(Sender: TObject);
  private
    procedure Log(const S : string; AError : boolean = false);
    procedure RefreshListViewItem(Item: TListItem);
    procedure ThreadLog(Sender: TObject; const S : string; Error : boolean);
    procedure ThreadTerminate(Sender: TObject);
    procedure ThreadConnectionChange(Sender: TObject; Conn : TConnection);
    procedure ThreadConnectionAdd(Sender: TObject; Conn : TConnection);
    procedure ThreadConnectionRemove(Sender: TObject; Conn : TConnection);
    procedure QueryThreadTerminate(Sender: TObject);
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;
  ConnActive : boolean;
  Thread : TClientThread;

implementation

{$R *.DFM}

procedure TFormMain.FormCreate(Sender: TObject);
begin
  ConnActive := false;
end;

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

procedure TFormMain.ButtonStartClick(Sender: TObject);
begin
  if not ConnActive then
  begin
    ButtonStart.Caption := 'Stop';
    ConnActive := true;
    Thread := TClientThread.Create(EditHost.Text, StrToIntDef(EditPort.Text, 22),
      EditUsername.Text, EditPassword.Text, StrToInt(EditLocalPort.Text),
      EditRemoteHost.Text, StrToInt(EditRemotePort.Text), false);
    Thread.OnLog := ThreadLog;
    Thread.OnTerminate := ThreadTerminate;
    Thread.OnConnectionChange := ThreadConnectionChange;
    Thread.OnConnectionAdd := ThreadConnectionAdd;
    Thread.OnConnectionRemove := ThreadConnectionRemove;
    Thread.FreeOnTerminate := true;
    Thread.Resume;
  end
  else
  begin
    if Assigned(Thread) then
      Thread.Terminate;
    ButtonStart.Caption := 'Start';
    ConnActive := false;
  end;
end;

procedure TFormMain.RefreshListViewItem(Item : TListItem);
var
  S : string;
  Conn : TConnection;
begin
  Conn := Item.Data;
  Item.Caption := '';
  Item.SubItems.Clear;
  Item.SubItems.Add(Conn.RemoteHost + ':' +
    IntToStr(Conn.RemotePort));
  Item.SubItems.Add(IntToStr(Conn.Sent));
  Item.SubItems.Add(IntToStr(Conn.Received));
  if (Conn.InState = icsActive) and
    (Conn.OutState = ocsActive) then
  begin
    Item.ImageIndex := 0;
    S := 'Active';
  end
  else if (Conn.InState in [icsClosing, icsClosed]) or
    (Conn.OutState in [ocsClosing, ocsClosed]) then
  begin
    Item.ImageIndex := 2;
    S := 'Closing';
  end
  else if (Conn.OutState = ocsEstablishing) then
  begin
    Item.ImageIndex := 1;
    S := 'Setting up';
  end
  else
  begin
    Item.ImageIndex := -1;
    S := 'Unknown';
  end;
  Item.SubItems.Add(S);
end;

procedure TFormMain.ThreadLog(Sender: TObject; const S : string; Error : boolean);
begin
  Log(S, Error);
end;

procedure TFormMain.ThreadTerminate(Sender: TObject);
begin
  Thread := nil;
end;

procedure TFormMain.ThreadConnectionChange(Sender: TObject; Conn: TConnection);
var
  Item : TListItem;
begin
  Item := ListViewConnections.FindData(0, Conn, true, false);
  RefreshListViewItem(Item);
end;

procedure TFormMain.ThreadConnectionAdd(Sender: TObject; Conn : TConnection);
var
  Item : TListItem;
begin
  Item := ListViewConnections.Items.Add;
  Item.Data := Conn;
  RefreshListViewItem(Item);
end;

procedure TFormMain.ThreadConnectionRemove(Sender: TObject; Conn : TConnection);
var
  Item : TListItem;
begin
  Item := ListViewConnections.FindData(0, Conn, true, false);
  ListViewConnections.Items.Delete(ListViewConnections.Items.IndexOf(Item));
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
  if Thread <> nil then
    Thread.Terminate;
end;

procedure TFormMain.btnExecuteClick(Sender: TObject);
var
  Thread : TQueryThread;
begin
  Thread := TQueryThread.Create(EditDBName.Text, EditDBUsername.Text,
    EditDBPassword.Text, EditQuery.Text);
  Thread.FreeOnTerminate := true;
  Thread.OnTerminate := QueryThreadTerminate;
  Thread.Resume;
end;

procedure TFormMain.QueryThreadTerminate(Sender: TObject);
var
  DataSet : TSQLDataSet;
  I : integer;
  Column : TListColumn;
  Item : TListItem;
begin
  DataSet := TQueryThread(Sender).DataSet;
  Log('Rows affected: ' + IntToStr(TQueryThread(Sender).RowCount));
  ListViewResults.Items.Clear;
  ListViewResults.Columns.Clear;
  for I := 0 to DataSet.Fields.Count - 1 do
  begin
    Column := ListViewResults.Columns.Add;
    Column.Caption := DataSet.Fields.Fields[I].DisplayName;
  end;
  DataSet.First;
  while not DataSet.Eof do
  begin
    Item := ListViewResults.Items.Add;
    if (DataSet.Fields.Count > 0) then
      Item.Caption := DataSet.Fields[0].AsString;
    for I := 1 to DataSet.Fields.Count - 1 do
      Item.SubItems.Add(DataSet.Fields[I].AsString);
    DataSet.Next;
  end;
end;

initialization

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

end.

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?