Project CLIENTDB
Project Structure
CLIENTDB.DPR
program ClientDb;
uses
Forms,
ClientForm in 'ClientForm.pas' {Form1};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
CLIENTFORM.PAS
unit ClientForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ScktComp, DBCtrls, ExtCtrls, Db, Mask, DBTables;
type
TForm1 = class(TForm)
ClientSocket1: TClientSocket;
EditServer: TEdit;
Server: TLabel;
Table1: TTable;
Table1Company: TStringField;
Table1CompID: TFloatField;
Table1Address: TStringField;
Table1State: TStringField;
Table1Country: TStringField;
Table1Email: TStringField;
Table1Contact: TStringField;
Label1: TLabel;
DBEdit1: TDBEdit;
DataSource1: TDataSource;
Label2: TLabel;
Label3: TLabel;
DBEdit3: TDBEdit;
Label4: TLabel;
DBEdit4: TDBEdit;
Label5: TLabel;
DBEdit5: TDBEdit;
Label6: TLabel;
DBEdit6: TDBEdit;
Label7: TLabel;
DBEdit7: TDBEdit;
DBNavigator1: TDBNavigator;
DBText1: TDBText;
btnSendAll: TButton;
lbLog: TListBox;
BtnStop: TButton;
BtnDelete: TButton;
Label8: TLabel;
Bevel1: TBevel;
procedure btnSendAllClick(Sender: TObject);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure BtnStopClick(Sender: TObject);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure BtnDeleteClick(Sender: TObject);
private
{ Private declarations }
public
fWaiting: Boolean;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.btnSendAllClick(Sender: TObject);
var
Data: TStringList;
I: Integer;
begin
// activate the connection
ClientSocket1.Address := EditServer.Text;
ClientSocket1.Active := True;
Application.ProcessMessages;
// save database data in a string list
Data := TStringList.Create;
try
table1.First;
while not Table1.Eof do
begin
// if the record is still not logged
if Table1CompID.IsNull or (Table1CompId.AsInteger = 0) then
begin
lbLog.Items.Add ('Sending ' + Table1Company.AsString);
Data.Clear;
// create strings with structure "FieldName=Value"
for I := 0 to Table1.FieldCount - 1 do
Data.Values [Table1.Fields[I].FieldName] :=
Table1.Fields [I].AsString;
// send the record
ClientSocket1.Socket.SendText (Data.Text);
// wait for reponse
fWaiting := True;
while fWaiting do
Application.ProcessMessages;
end;
Table1.Next;
end;
finally
// free the data and close the connection
Data.Free;
ClientSocket1.Active := False;
end;
end;
procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Caption := 'Connected';
end;
procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Caption := 'Disconnected';
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
fWaiting := False;
// use a table in the current directory
Table1.DatabaseName :=
ExtractFilePath (Application.ExeName);
// create it if it doesn't exist
if not Table1.Exists then
Table1.CreateTable;
Table1.Active := True;
end;
procedure TForm1.BtnStopClick(Sender: TObject);
begin
fWaiting := False;
end;
procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
begin
if fWaiting then
begin
Table1.Edit;
Table1CompId.AsString := Socket.ReceiveText;
Table1.Post;
lbLog.Items.Add (Table1Company.AsString +
' logged as ' + Table1CompId.AsString);
fWaiting := False;
end;
end;
procedure TForm1.BtnDeleteClick(Sender: TObject);
begin
table1.First;
while not Table1.Eof do
begin
// if the record is still logged
if not Table1CompID.IsNull and (Table1CompId.AsInteger <> 0) then
Table1.Delete;
Table1.Next;
end;
end;
end.
CLIENTFORM.DFM
object Form1: TForm1
Left = 202
Top = 119
Width = 581
Height = 430
Caption = 'Client'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = True
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Bevel1: TBevel
Left = 16
Top = 72
Width = 337
Height = 313
end
object Server: TLabel
Left = 16
Top = 16
Width = 31
Height = 13
Caption = 'Server'
end
object Label1: TLabel
Left = 32
Top = 152
Width = 44
Height = 13
Caption = 'Company'
FocusControl = DBEdit1
end
object Label2: TLabel
Left = 32
Top = 128
Width = 38
Height = 13
Caption = 'CompID'
end
object Label3: TLabel
Left = 32
Top = 200
Width = 38
Height = 13
Caption = 'Address'
FocusControl = DBEdit3
end
object Label4: TLabel
Left = 32
Top = 240
Width = 25
Height = 13
Caption = 'State'
FocusControl = DBEdit4
end
object Label5: TLabel
Left = 96
Top = 240
Width = 36
Height = 13
Caption = 'Country'
FocusControl = DBEdit5
end
object Label6: TLabel
Left = 32
Top = 288
Width = 25
Height = 13
Caption = 'Email'
FocusControl = DBEdit6
end
object Label7: TLabel
Left = 32
Top = 328
Width = 37
Height = 13
Caption = 'Contact'
FocusControl = DBEdit7
end
object DBText1: TDBText
Left = 80
Top = 128
Width = 65
Height = 17
DataField = 'CompID'
DataSource = DataSource1
end
object Label8: TLabel
Left = 368
Top = 120
Width = 21
Height = 13
Caption = 'Log:'
end
object EditServer: TEdit
Left = 56
Top = 13
Width = 121
Height = 21
TabOrder = 0
Text = '222.1.1.1'
end
object DBEdit1: TDBEdit
Left = 32
Top = 168
Width = 304
Height = 21
DataField = 'Company'
DataSource = DataSource1
TabOrder = 1
end
object DBEdit3: TDBEdit
Left = 32
Top = 216
Width = 305
Height = 21
DataField = 'Address'
DataSource = DataSource1
TabOrder = 2
end
object DBEdit4: TDBEdit
Left = 32
Top = 256
Width = 49
Height = 21
DataField = 'State'
DataSource = DataSource1
TabOrder = 3
end
object DBEdit5: TDBEdit
Left = 96
Top = 256
Width = 241
Height = 21
DataField = 'Country'
DataSource = DataSource1
TabOrder = 4
end
object DBEdit6: TDBEdit
Left = 32
Top = 304
Width = 305
Height = 21
DataField = 'Email'
DataSource = DataSource1
TabOrder = 5
end
object DBEdit7: TDBEdit
Left = 32
Top = 344
Width = 305
Height = 21
DataField = 'Contact'
DataSource = DataSource1
TabOrder = 6
end
object DBNavigator1: TDBNavigator
Left = 40
Top = 88
Width = 240
Height = 25
DataSource = DataSource1
TabOrder = 7
end
object btnSendAll: TButton
Left = 408
Top = 48
Width = 105
Height = 25
Caption = '&Send All'
TabOrder = 8
OnClick = btnSendAllClick
end
object lbLog: TListBox
Left = 368
Top = 136
Width = 185
Height = 249
ItemHeight = 13
TabOrder = 9
end
object BtnStop: TButton
Left = 408
Top = 80
Width = 105
Height = 25
Caption = '&Emergency Stop'
TabOrder = 10
OnClick = BtnStopClick
end
object BtnDelete: TButton
Left = 408
Top = 16
Width = 105
Height = 25
Caption = '&Delete All Sent'
TabOrder = 11
OnClick = BtnDeleteClick
end
object ClientSocket1: TClientSocket
Active = False
Address = '222.1.1.1'
ClientType = ctNonBlocking
Port = 51
OnConnect = ClientSocket1Connect
OnDisconnect = ClientSocket1Disconnect
OnRead = ClientSocket1Read
Left = 160
Top = 32
end
object Table1: TTable
FieldDefs = <
item
Name = 'Company'
DataType = ftString
Size = 50
end
item
Name = 'CompID'
DataType = ftFloat
end
item
Name = 'Address'
DataType = ftString
Size = 100
end
item
Name = 'State'
DataType = ftString
Size = 2
end
item
Name = 'Country'
DataType = ftString
Size = 20
end
item
Name = 'Email'
DataType = ftString
Size = 40
end
item
Name = 'Contact'
DataType = ftString
Size = 40
end>
StoreDefs = True
TableName = 'clientdb.DB'
Left = 220
Top = 32
object Table1Company: TStringField
FieldName = 'Company'
Size = 50
end
object Table1CompID: TFloatField
FieldName = 'CompID'
end
object Table1Address: TStringField
FieldName = 'Address'
Size = 100
end
object Table1State: TStringField
FieldName = 'State'
Size = 2
end
object Table1Country: TStringField
FieldName = 'Country'
end
object Table1Email: TStringField
FieldName = 'Email'
Size = 40
end
object Table1Contact: TStringField
FieldName = 'Contact'
Size = 40
end
end
object DataSource1: TDataSource
DataSet = Table1
Left = 96
Top = 35
end
end
|
Home:
Code Repository:
Mastering Delphi 5