unit form;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, DateTimePicker, Forms, Controls, Graphics,
Dialogs, StdCtrls, Buttons, ComCtrls, tcpclient;
type
{ TClientItem }
TClientItem = class(TCollectionItem)
private
FHost, FPort: String;
FConn: TTCPClient;
public
constructor Create(ACollection: TCollection); override;
published
property Host: String read FHost write FHost;
property Port: String read FPort write FPort;
property Conn: TTCPClient read FConn write FConn;
end;
{ TClientList }
TClientList = class(TCollection)
private
function GetItem(Index: Integer): TClientItem;
procedure SetItem(Index: Integer; AValue: TClientItem);
protected
public
constructor Create;
function Add: TClientItem;
property Items[Index: Integer]: TClientItem
read GetItem write SetItem; default;
end;
{ TMainForm }
TMainForm = class(TForm)
HostComboBox: TComboBox;
ConnectButton: TButton;
StartDateTimePicker: TDateTimePicker;
StartButton: TButton;
ConnectionListView: TListView;
procedure ConnectButtonClick(Sender: TObject);
procedure ConnectionListViewData(Sender: TObject;
Item: TListItem);
procedure FormCreate(Sender: TObject);
private
Clients: TClientList;
procedure ClientError(Sender: TObject;
const Value: Integer;
const Desc: String);
procedure ClientConnect(Sender: TObject);
procedure ClientDisconnect(Sender: TObject);
public
end;
var
MainForm: TMainForm;
implementation
{$R *.lfm}
{ TClientItem }
constructor TClientItem.Create(ACollection: TCollection);
begin
if Assigned(ACollection) then
inherited Create(ACollection);
end;
{ TClientList }
constructor TClientList.Create;
begin
inherited Create(TClientItem);
end;
function TClientList.GetItem(Index: Integer): TClientItem;
begin
Result := TClientItem(inherited Items[Index]);
end;
procedure TClientList.SetItem(Index: Integer; AValue: TClientItem);
begin
Items[Index].Assign(AValue);
end;
function TClientList.Add: TClientItem;
begin
Result := inherited Add as TClientItem;
end;
{ TMainForm }
procedure TMainForm.ConnectButtonClick(Sender: TObject);
var
HostLen, DelimPos: Integer;
NewHost, NewPort: String;
NewClient: TTCPClient;
begin
// TODO: Insert unique hosts into the Items array.
HostLen := Length(HostComboBox.Text);
DelimPos := Pos(':', HostComboBox.Text);
if (DelimPos = 0) or (DelimPos = HostLen) then
NewPort := '2200'
else
NewPort := Copy(HostComboBox.Text, DelimPos + 1, HostLen);
if (DelimPos = 1) or (HostLen = 0) then
NewHost := 'localhost'
else
begin
if DelimPos = 0 then
DelimPos := HostLen + 1;
NewHost := Copy(HostComboBox.Text, 0, DelimPos - 1);
end;
// TODO: Allow customization of certificate file.
NewClient := TTCPClient.Create(True);
with NewClient do
begin
Host := NewHost;
Port := StrToInt(NewPort);
CertFile := 'keys/id_rsa.crt';
OnError := @ClientError;
OnConnect := @ClientConnect;
OnDisconnect := @ClientDisconnect;
Start;
end;
with Clients.Add do
begin
Host := NewHost;
Port := NewPort;
Conn := NewClient;
end;
ConnectionListView.Items.Count := ConnectionListView.Items.Count + 1;
end;
procedure TMainForm.ConnectionListViewData(Sender: TObject; Item: TListItem);
begin
Item.Caption := Clients.Items[Item.Index].Host + ':' +
Clients.Items[Item.Index].Port;
if not Clients.Items[Item.Index].Conn.Connected then
Item.Caption := Item.Caption + ' (disconnected)';
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
Clients := TClientList.Create;
end;
procedure TMainForm.ClientError(Sender: TObject;
const Value: Integer;
const Desc: String);
begin
end;
procedure TMainForm.ClientConnect(Sender: TObject);
begin
//ConnectionListView.Repaint;
//ConnectionListView.Invalidate;
//ConnectionListView.Update;
Repaint;
Invalidate;
end;
procedure TMainForm.ClientDisconnect(Sender: TObject);
begin
ConnectionListView.Repaint;
ConnectionListView.Invalidate;
end;
end.