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 6

Chapter 21 - Project Client2

Project Structure

Client2.dpr
program Client2;

uses
  Forms,
  ClientForm in 'ClientForm.pas' {Form1},
  CliBmp in 'CliBmp.pas' {FormBmp},
  CliText in 'CliText.pas' {FormText};

{$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, ExtCtrls;

type
  TCliStatus = (csIdle, csList, csBitmap, csText, csError);

  TForm1 = class(TForm)
    ClientSocket1: TClientSocket;
    cbActivate: TCheckBox;
    EditServer: TEdit;
    Label4: TLabel;
    btnExec: TButton;
    EditServerFile: TEdit;
    Label2: TLabel;
    ListFiles: TListBox;
    Label1: TLabel;
    EditDir: TEdit;
    btnGetDir: TButton;
    LabelDir: TLabel;
    Bevel1: TBevel;
    btnBitmap: TButton;
    btnText: TButton;
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Disconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure cbActivateClick(Sender: TObject);
    procedure btnExecClick(Sender: TObject);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure btnGetDirClick(Sender: TObject);
    procedure ListFilesClick(Sender: TObject);
    procedure btnBitmapClick(Sender: TObject);
    procedure btnTextClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    CliStatus: TCliStatus;
    Buffer: array [0..9999] of Char;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
  CliBmp, CliText;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Caption := 'Connected';
end;

procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Caption := 'Disconnected';
end;

procedure TForm1.cbActivateClick(Sender: TObject);
begin
  if not ClientSocket1.Active then
    ClientSocket1.Address := EditServer.Text;
  ClientSocket1.Active := cbActivate.Checked;
end;

procedure TForm1.btnExecClick(Sender: TObject);
begin
  ClientSocket1.Socket.SendText ('EXEC!' + EditServerFile.Text);
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
var
  strIn: string;
  Stream: TMemoryStream;
  nReceived: Integer;
begin
  case CliStatus of
    // look for data to receive
    csIdle:
    begin
      Socket.ReceiveBuf (Buffer, 5);
      strIn := Copy (Buffer, 1, 5);
      if strIn = 'TEXT!' then
        CliStatus := csText
      else if strIn = 'BITM!' then
        CliStatus := csBitmap
      else if strIn = 'LIST!' then
        CliStatus := csList
      else if strIn = 'ERROR' then
        CliStatus := csError;
    end;
    // show the messages (might actually not be an error)
    csError:
    begin
      ShowMessage (Socket.ReceiveText);
      cliStatus := csIdle;
    end;
    // get a directory listing
    csList:
    begin
      ListFiles.Items.Text := Socket.ReceiveText;
      cliStatus := csIdle;
    end;
    // read a text file
    csText:
    begin
      with TFormText.Create (Application) do
      begin
        Memo1.Text := Socket.ReceiveText;
        Show;
      end;
      cliStatus := csIdle;
    end;
    // read a bitmap file
    csBitmap:
      with TFormBmp.Create (Application) do
      begin
        Stream := TMemoryStream.Create;
        Screen.Cursor := crHourglass;
        try
          while True do
          begin
            nReceived := Socket.ReceiveBuf (Buffer, sizeof (Buffer));
            if nReceived <= 0 then
              Break
            else
              Stream.Write (Buffer, nReceived);
            // delay (200 milliseconds)
            Sleep (200);
          end;
          // reset and load the temporary file
          Stream.Position := 0;
          Image1.Picture.Bitmap.LoadFromStream (Stream);
        finally
          Stream.Free;
          Screen.Cursor := crDefault;
        end;
        Show;
      cliStatus := csIdle;
      end;
  end; // case
end;

procedure TForm1.btnGetDirClick(Sender: TObject);
begin
  ClientSocket1.Socket.SendText ('LIST!' + EditDir.Text);
  LabelDir.Caption := EditDir.Text;
end;

procedure TForm1.ListFilesClick(Sender: TObject);
begin
  EditServerFile.Text := LabelDir.Caption + '\' +
    ListFiles.Items [ListFiles.ItemIndex];
end;

procedure TForm1.btnBitmapClick(Sender: TObject);
begin
  ClientSocket1.Socket.SendText ('BITM!' + EditServerFile.Text);
end;

procedure TForm1.btnTextClick(Sender: TObject);
begin
  ClientSocket1.Socket.SendText ('TEXT!' + EditServerFile.Text);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  CliStatus := csIdle;
end;

end.
CliBmp.pas
unit CliBmp;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls;

type
  TFormBmp = class(TForm)
    Image1: TImage;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormBmp: TFormBmp;

implementation

{$R *.DFM}

end.
CliText.pas
unit CliText;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TFormText = class(TForm)
    Memo1: TMemo;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormText: TFormText;

implementation

{$R *.DFM}

end.
ClientForm.dfm
object Form1: TForm1
  Left = 196
  Top = 109
  Width = 521
  Height = 322
  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 = 64
    Width = 313
    Height = 209
  end
  object Label4: TLabel
    Left = 16
    Top = 8
    Width = 87
    Height = 13
    Caption = 'Server IP address:'
  end
  object Label2: TLabel
    Left = 344
    Top = 64
    Width = 50
    Height = 13
    Caption = 'Server file:'
  end
  object Label1: TLabel
    Left = 40
    Top = 88
    Width = 45
    Height = 13
    Caption = 'Directory:'
  end
  object LabelDir: TLabel
    Left = 40
    Top = 120
    Width = 26
    Height = 13
    Caption = 'None'
  end
  object cbActivate: TCheckBox
    Left = 160
    Top = 24
    Width = 97
    Height = 17
    Caption = 'Activate'
    TabOrder = 0
    OnClick = cbActivateClick
  end
  object EditServer: TEdit
    Left = 16
    Top = 24
    Width = 121
    Height = 21
    TabOrder = 1
    Text = '222.1.1.1'
  end
  object btnExec: TButton
    Left = 376
    Top = 120
    Width = 75
    Height = 25
    Caption = '&Exec'
    TabOrder = 2
    OnClick = btnExecClick
  end
  object EditServerFile: TEdit
    Left = 344
    Top = 88
    Width = 145
    Height = 21
    TabOrder = 3
    Text = 'c:\windows\win.ini'
  end
  object ListFiles: TListBox
    Left = 40
    Top = 136
    Width = 257
    Height = 113
    ItemHeight = 13
    TabOrder = 4
    OnClick = ListFilesClick
  end
  object EditDir: TEdit
    Left = 93
    Top = 85
    Width = 121
    Height = 21
    TabOrder = 5
    Text = 'c:\windows'
  end
  object btnGetDir: TButton
    Left = 221
    Top = 84
    Width = 75
    Height = 23
    Caption = '&Get Dir'
    TabOrder = 6
    OnClick = btnGetDirClick
  end
  object btnBitmap: TButton
    Left = 376
    Top = 160
    Width = 75
    Height = 25
    Caption = '&Bitmap'
    TabOrder = 7
    OnClick = btnBitmapClick
  end
  object btnText: TButton
    Left = 376
    Top = 200
    Width = 75
    Height = 25
    Caption = '&Text'
    TabOrder = 8
    OnClick = btnTextClick
  end
  object ClientSocket1: TClientSocket
    Active = False
    Address = '222.1.1.1'
    ClientType = ctNonBlocking
    Port = 51
    OnConnect = ClientSocket1Connect
    OnDisconnect = ClientSocket1Disconnect
    OnRead = ClientSocket1Read
    Left = 272
    Top = 16
  end
end
CliBmp.dfm
object FormBmp: TFormBmp
  Left = 192
  Top = 107
  Width = 551
  Height = 348
  Caption = 'FormBmp'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Image1: TImage
    Left = 0
    Top = 0
    Width = 543
    Height = 321
    Align = alClient
  end
end
CliText.dfm
object FormText: TFormText
  Left = 233
  Top = 154
  Width = 696
  Height = 480
  Caption = 'FormText'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Memo1: TMemo
    Left = 0
    Top = 0
    Width = 688
    Height = 453
    Align = alClient
    TabOrder = 0
  end
end