Project Structure

• ClientDb.dpr
• ClientForm.pas
• ClientForm.dfm

program ClientDb;

uses
  Forms,
  ClientForm in 'ClientForm.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

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.

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 = '127.0.0.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