Indy10Demos/Demo Base/Client/Forms/MainForm.pas

{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  22954: MainForm.pas 
{
{   Rev 1.0    09/10/2003 3:10:44 PM  Jeremy Darling
{ Project Checked into TC for the first time
}
unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, StdCtrls, ClientThread,
  IdAntiFreezeBase, IdAntiFreeze, SyncObjs, ExtCtrls, ComCtrls, IniFiles;

type
  TfrmMain = class(TForm)
    SampleClient: TIdTCPClient;
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    edHost: TEdit;
    edPort: TEdit;
    Label4: TLabel;
    edThreads: TEdit;
    IdAntiFreeze1: TIdAntiFreeze;
    lblConCons: TLabel;
    lblMaxCons: TLabel;
    lblTotalCons: TLabel;
    lvStatus: TListView;
    Bevel1: TBevel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure edPortKeyPress(Sender: TObject; var Key: Char);
    procedure edThreadsKeyPress(Sender: TObject; var Key: Char);
    procedure edThreadsChange(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure SampleClientConnected(Sender: TObject);
    procedure SampleClientDisconnected(Sender: TObject);
    procedure SampleClientWork(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);
  private
    { Private declarations }
    FDefaultCaption   : String;
    fThreads          : TList;
    FClientsConnected : Boolean;
    uiLock            : TCriticalSection;
    CurrentConnections,
    MaxConnections,
    ConnectionsMade   : Integer;
    procedure SetClientsConnected(const Value: Boolean);
    procedure LoadIniSettings;
    procedure WriteIniSettings;
  public
    { Public declarations }
    procedure StartThreads;
    procedure StopThreads;
    property ClientsConnected : Boolean read FClientsConnected write SetClientsConnected;
  end;

var
  frmMain: TfrmMain;
  Ini    : TIniFile;

implementation

{$R *.DFM}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  Randomize;
  Ini := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
  LoadIniSettings;
  
  CurrentConnections := 0;
  ConnectionsMade    := 0;
  MaxConnections     := 0;

  lblConCons.Caption := 'Current Concurrent Connections: 0';
  lblMaxCons.Caption := 'Max Concurrent Connections: 0';
  lblTotalCons.Caption := 'Total Connections Made: 0';

  FDefaultCaption := Caption;
  uiLock := TCriticalSection.Create;
  fThreads := TList.Create;
end;

procedure TfrmMain.Button1Click(Sender: TObject);
begin
  SampleClient.Host := edHost.Text;
  SampleClient.Port := StrToIntDef(edPort.Text, 8800);
  if ClientsConnected then
    StopThreads
  else
    StartThreads;
end;

procedure TfrmMain.edPortKeyPress(Sender: TObject; var Key: Char);
begin
  if not (Key in ['0', '1'..'9', #8]) then
    Key := #0;
end;

procedure TfrmMain.edThreadsKeyPress(Sender: TObject; var Key: Char);
begin
  if not (Key in ['0', '1'..'9', #8]) then
    Key := #0;
end;

procedure TfrmMain.edThreadsChange(Sender: TObject);
begin
  if edThreads.Text = '' then
    edThreads.Text := '0';
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  StopThreads;
  fThreads.Free;
  uiLock.Free;
  WriteIniSettings;
  Ini.Free;
end;

procedure TfrmMain.StartThreads;
var
  i : Integer;
  st: Integer;
begin
  lvStatus.Items.Clear;

  CurrentConnections := 0;
  ConnectionsMade    := 0;
  MaxConnections     := 0;

  lblConCons.Caption := 'Current Concurrent Connections: 0';
  lblMaxCons.Caption := 'Max Concurrent Connections: 0';
  lblTotalCons.Caption := 'Total Connections Made: 0';

  st := StrToIntDef(edThreads.Text, 0);
  if st < 10 then
    st := 10;

  for i := 0 to StrToIntDef(edThreads.Text, 0) -1 do
    begin
      with TClientThread(fThreads[fThreads.Add(TClientThread.Create(true))]) do
        begin
          AssignClient(SampleClient);

          ListItem := lvStatus.Items.Add;
          ListItem.Caption := IntToStr(i);
          ListItem.SubItems.Add('Creating');
          SleepTime := random(st);
          if SleepTime < 5 then
            while SleepTime < 5 do
              SleepTime := random(st);

          uiLock := self.uiLock;

          Client.Tag := Integer(Pointer(TClientThread(fThreads[i])));
          State      := -2;
          Resume;
        end;
    end;

  ClientsConnected := true;
end;

procedure TfrmMain.StopThreads;
begin
  ClientsConnected := false;
  if fThreads.Count > 0 then
    while fThreads.Count > 0 do
      begin
        TClientThread(fThreads[0]).FreeOnTerminate := true;
        TClientThread(fThreads[0]).Terminate;
        fThreads.Delete(0);
      end;
end;

procedure TfrmMain.SampleClientConnected(Sender: TObject);
var
  ct : TClientThread;
begin
  uiLock.Enter;
  try
    ct := Pointer(TIdTCPClient(Sender).Tag);

    ct.State := 0;

    Inc(CurrentConnections);
    Inc(ConnectionsMade);

    lblConCons.Caption := 'Current Concurrent Connections: ' + IntToStr(CurrentConnections);
    if MaxConnections < CurrentConnections then
      begin
        MaxConnections := CurrentConnections;
        lblMaxCons.Caption := 'Max Concurrent Connections: ' + IntToStr(MaxConnections);
      end;
    lblTotalCons.Caption := 'Total Connections Made: ' + IntToStr(ConnectionsMade);

  finally
    uiLock.Leave;
  end;
end;

procedure TfrmMain.SetClientsConnected(const Value: Boolean);
begin
  FClientsConnected := Value;

  if Value then
    Button1.Caption := 'Disconnect'
  else
    Button1.Caption := 'Connect';

  edHost.Enabled := not Value;
  edPort.Enabled := not Value;
  edThreads.Enabled := not Value;
end;

procedure TfrmMain.SampleClientDisconnected(Sender: TObject);
var
  ct : TClientThread;
begin
  uiLock.Enter;
  try
    ct := Pointer(TIdTCPClient(Sender).Tag);

    ct.State := -2;

    Dec(CurrentConnections);
    lblConCons.Caption := 'Current Concurrent Connections: ' + IntToStr(CurrentConnections);
  finally
    uiLock.Leave;
  end;
end;

procedure TfrmMain.SampleClientWork(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
// Do Nothing
end;

procedure TfrmMain.LoadIniSettings;
begin
  edHost.Text    := Ini.ReadString('Connection', 'Host', edHost.Text);
  edPort.Text    := Ini.ReadString('Connection', 'Port', edPort.Text);
  edThreads.Text := Ini.ReadString('Threads', 'Threads', edThreads.Text);
end;

procedure TfrmMain.WriteIniSettings;
begin
  Ini.WriteString('Connection', 'Host', edHost.Text);
  Ini.WriteString('Connection', 'Port', edPort.Text);
  Ini.WriteString('Threads', 'Threads', edThreads.Text);
end;

end.