Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 5

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