Home: Code Repository: Mastering Delphi 5

Project CLIENT2

Project Structure

CLIENT2.DPR
CLIENTFORM.PAS
CLIBMP.PAS
CLITEXT.PAS
CLIENTFORM.DFM
CLIBMP.DFM
CLITEXT.DFM

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.

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.

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.

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.

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

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

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