CODEWITHSUNDEEP
socketsdelphidelphi-10.3-riotlist
user13342561
user13342561

Reputation:

How send/receive a List of elements over socket?

I have the following code, where I can draw several rectangles and make a hole to each.

How can I send the RectList object over a socket (TServerSocket) and recover (receive in a TClientSocket) this object directly to a variable of same type (var RectList: TList<TRect>)?

type
  TForm1 = class(TForm)
    ComboBox1: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
    Drawing: Boolean;
    RectList: TList<TRect>;
    Rectangle: TRect;
    FormRegion, HoleRegion: HRGN;
    function ClientToWindow(const P: TPoint): TPoint;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.ClientToWindow(const P: TPoint): TPoint;
begin
  Result := ClientToScreen(P);
  Dec(Result.X, Left);
  Dec(Result.Y, Top);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  RectList := TList<TRect>.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  RectList.Free;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Rectangle.Left := X;
  Rectangle.Top := Y;
  Drawing := True;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if Drawing then
  begin
    Rectangle.Right := X;
    Rectangle.Bottom := Y;
    Invalidate;
  end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  I: Integer;
begin
  Drawing := false;
  Rectangle.Right := X;
  Rectangle.Bottom := Y;
  Invalidate;

  if RectList.Count < StrToInt(ComboBox1.Text) then
  begin
    Rectangle.NormalizeRect;
    if not Rectangle.IsEmpty then
      RectList.Add(Rectangle)
    else
      SetWindowRgn(Handle, 0, True);
  end
  else
  begin
    FormRegion := CreateRectRgn(0, 0, Width, Height);
    for I := 0 to Pred(RectList.Count) do
    begin
      HoleRegion := CreateRectRgn(ClientToWindow(RectList.Items[I].TopLeft).X, ClientToWindow(RectList.Items[I].TopLeft).Y, ClientToWindow(RectList.Items[I].BottomRight).X, ClientToWindow(RectList.Items[I].BottomRight).Y);
      CombineRgn(FormRegion, FormRegion, HoleRegion, RGN_DIFF);
    end;
    SetWindowRgn(Handle, FormRegion, True);
    RectList.Clear;
  end;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  R: TRect;
begin
  Canvas.Brush.Style := bsClear;
  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Color := clRed;
  Canvas.Rectangle(Rectangle);

  for R in RectList do
    Canvas.Rectangle(R);
end;

end.

Upvotes: 1

Views: 764

Answers (1)

fpiette
fpiette

Reputation: 12292

I made some code to show you how to do it.

In your code, I added a TClientSocketon the form and assigned a few events. Also added a TButton to send the RectList to the other side (server side) thru the TClientSocket.

I designed a new simple server application having a TServerSocket set to listen for client connection and accepting commands from the client. I implemented two commands: rectangle and clear. Obviously clear command is implemented to clear the display on the rectangle list. The rectangle command is used to sent a rectangle (Left, top, right and bottom as coma delimited integers).

Since client and server must understand each other, I designed a very simple communication protocol. Data is exchanged between client and server using ASCII lines. A line is any character collection terminated by a CRLF pair. TCP port 2500 (Almost any other would do) is used.

For example, the command

rectangle 10,20,30,40

will sent a rectangle from client to server (The line above is terminated by CRLF).

If the server receive a valid command, it act on it and then send

OK

The line above is terminated by CRLF. In case of an error, an error message is sent back to the client.

When a client establish a connection, the first thing the server does is to send a welcome banner. That is a line terminated by CRLF.

The client wait to receive the banner before sending any command. Then it send the clear command, wait for OK, then send a rectangle command with first item in RectList and wait for OK, then loop sending all rectangle commands and waiting for OK acknowledge until all RectList has been sent. The the client close the connection.

I'm not completely correct when I say wait for. Actually the socket is event driven. That means everything is done thry events. For example, when a line comes in - sent by the other side - the socket triggers an OnRead event. In the corresponding event handler, you receive the line that is already received.

I used this line oriented protocol because it is really simple, easy to debug and cross platform. Actually, if looks much like the SMTP protocol which is used to send an email! Sending binary data is surely faster but has a lot of difficulties. Binary data format is compiler and platform specific. This result in difficulties. Binary data is diffcult to read for a human and so it is difficult to debug.

Below you'll find your enhanced source code and DFM (This is the client), then the server source code and DFM.

Client source code:

unit SktSocketClientDemoMain;

interface

uses
    Winapi.Windows, Winapi.Messages,
    System.SysUtils, System.Variants, System.Classes,
    System.Generics.Collections,
    Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
    System.Win.ScktComp;

type
    TSktSocketClientMainForm = class(TForm)
        ComboBox1 : TComboBox;
        SocketSendButton : TButton;
        ClientSocket1 : TClientSocket;
        Memo1 : TMemo;
        procedure ClientSocket1Connect(
            Sender : TObject;
            Socket : TCustomWinSocket);
        procedure ClientSocket1Connecting(
            Sender : TObject;
            Socket : TCustomWinSocket);
        procedure ClientSocket1Read(
            Sender : TObject;
            Socket : TCustomWinSocket);
        procedure FormCreate(Sender : TObject);
        procedure FormDestroy(Sender : TObject);
        procedure FormMouseDown(
            Sender : TObject;
            Button : TMouseButton;
            Shift  : TShiftState;
            X, Y   : Integer);
        procedure FormMouseMove(
            Sender : TObject;
            Shift  : TShiftState;
            X, Y   : Integer);
        procedure FormMouseUp(
            Sender : TObject;
            Button : TMouseButton;
            Shift  : TShiftState;
            X, Y   : Integer);
        procedure FormPaint(Sender : TObject);
        procedure SocketSendButtonClick(Sender : TObject);
    private
        Drawing                : Boolean;
        RectList               : TList<TRect>;
        Rectangle              : TRect;
        FormRegion, HoleRegion : HRGN;
        FBanner                : string;
        FSendIndex             : Integer;
        function ClientToWindow(const P : TPoint) : TPoint;
    end;

var
    SktSocketClientMainForm : TSktSocketClientMainForm;

implementation

{$R *.dfm}


function TSktSocketClientMainForm.ClientToWindow(const P : TPoint) : TPoint;
begin
    Result := ClientToScreen(P);
    Dec(Result.X, Left);
    Dec(Result.Y, Top);
end;

procedure TSktSocketClientMainForm.FormCreate(Sender : TObject);
begin
    RectList := TList<TRect>.Create;
end;

procedure TSktSocketClientMainForm.FormDestroy(Sender : TObject);
begin
    RectList.Free;
end;

procedure TSktSocketClientMainForm.FormMouseDown(
    Sender : TObject;
    Button : TMouseButton;
    Shift  : TShiftState;
    X, Y   : Integer);
begin
    Rectangle.Left := X;
    Rectangle.Top  := Y;
    Drawing        := True;
end;

procedure TSktSocketClientMainForm.FormMouseMove(
    Sender : TObject;
    Shift  : TShiftState;
    X, Y   : Integer);
begin
    if Drawing then begin
        Rectangle.Right  := X;
        Rectangle.Bottom := Y;
        Invalidate;
    end;
end;

procedure TSktSocketClientMainForm.FormMouseUp(
    Sender : TObject;
    Button : TMouseButton;
    Shift  : TShiftState;
    X, Y   : Integer);
var
    I : Integer;
begin
    Drawing          := false;
    Rectangle.Right  := X;
    Rectangle.Bottom := Y;
    Invalidate;

    if RectList.Count < StrToInt(ComboBox1.Text) then begin
        Rectangle.NormalizeRect;
        if not Rectangle.IsEmpty then
            RectList.Add(Rectangle)
        else
            SetWindowRgn(Handle, 0, True);
    end
    else begin
        FormRegion := CreateRectRgn(0, 0, Width, Height);
        for I      := 0 to Pred(RectList.Count) do
        begin
            HoleRegion :=
                CreateRectRgn(ClientToWindow(RectList.Items[I].TopLeft).X,
                ClientToWindow(RectList.Items[I].TopLeft).Y,
                ClientToWindow(RectList.Items[I].BottomRight).X,
                ClientToWindow(RectList.Items[I].BottomRight).Y);
            CombineRgn(FormRegion, FormRegion, HoleRegion, RGN_DIFF);
        end;
        SetWindowRgn(Handle, FormRegion, True);
        RectList.Clear;
    end;
end;

procedure TSktSocketClientMainForm.FormPaint(Sender : TObject);
var
    R : TRect;
begin
    Canvas.Brush.Style := bsClear;
    Canvas.Pen.Style   := psSolid;
    Canvas.Pen.Color   := clRed;
    Canvas.Rectangle(Rectangle);

    for R in RectList do
        Canvas.Rectangle(R);
end;

procedure TSktSocketClientMainForm.SocketSendButtonClick(Sender : TObject);
begin
    FBanner               := '';
    FSendIndex            := 0;
    ClientSocket1.Port    := 2500; // Must be the same as server side
    ClientSocket1.Address := '127.0.0.1';
    ClientSocket1.Active  := True;
end;

procedure TSktSocketClientMainForm.ClientSocket1Connect(
    Sender : TObject;
    Socket :
    TCustomWinSocket);
begin
    Memo1.Lines.Add('Connected');
end;

procedure TSktSocketClientMainForm.ClientSocket1Connecting(
    Sender : TObject;
    Socket : TCustomWinSocket);
begin
    Memo1.Lines.Add('Connecting...');
end;

procedure TSktSocketClientMainForm.ClientSocket1Read(
    Sender : TObject;
    Socket : TCustomWinSocket);
var
    Line    : string;
    CmdLine : string;
    R       : TRect;
begin
    Line := Trim(string(Socket.ReceiveText));
    Memo1.Lines.Add('Rcvd: "' + Line + '"');
    if FBanner = '' then begin
        FBanner := Line;
        Socket.SendText('Clear' + #13#10);
        Exit;
    end;
    if Line <> 'OK' then begin
        Memo1.Lines.Add('Expected "OK", received "' + Line + '"');
        Socket.Close;
        Exit;
    end;
    if FSendIndex >= RectList.Count then begin
        // We have sent everything in RectList
        Memo1.Lines.Add('Send completed OK');
        Socket.Close;
        Exit;
    end;
    // Send next item in RectList
    R       := RectList[FSendIndex];
    CmdLine := Format('Rectangle %d,%d,%d,%d' + #13#10,
        [R.Left, R.Top, R.Right, R.Bottom]);
    Inc(FSendIndex);
    Socket.SendText(AnsiString(CmdLine));
end;

end.

Client DFM:

object SktSocketClientMainForm: TSktSocketClientMainForm
  Left = 0
  Top = 0
  Caption = 'SktSocketClientMainForm'
  ClientHeight = 299
  ClientWidth = 635
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  OnMouseDown = FormMouseDown
  OnMouseMove = FormMouseMove
  OnMouseUp = FormMouseUp
  OnPaint = FormPaint
  DesignSize = (
    635
    299)
  PixelsPerInch = 96
  TextHeight = 13
  object ComboBox1: TComboBox
    Left = 24
    Top = 12
    Width = 145
    Height = 21
    Style = csDropDownList
    ItemIndex = 4
    TabOrder = 0
    Text = '5'
    Items.Strings = (
      '1'
      '2'
      '3'
      '4'
      '5'
      '6'
      '7'
      '8'
      '9')
  end
  object SocketSendButton: TButton
    Left = 188
    Top = 8
    Width = 75
    Height = 25
    Caption = 'Send'
    TabOrder = 1
    OnClick = SocketSendButtonClick
  end
  object Memo1: TMemo
    Left = 8
    Top = 192
    Width = 621
    Height = 101
    Anchors = [akLeft, akTop, akRight, akBottom]
    Lines.Strings = (
      'Memo1')
    TabOrder = 2
  end
  object ClientSocket1: TClientSocket
    Active = False
    ClientType = ctNonBlocking
    Port = 0
    OnConnecting = ClientSocket1Connecting
    OnConnect = ClientSocket1Connect
    OnRead = ClientSocket1Read
    Left = 44
    Top = 148
  end
end

Server source code:

unit SktSocketServerDemoMain;

interface

uses
  Winapi.Windows, Winapi.Messages,
  System.SysUtils, System.Variants, System.Classes,
  System.Generics.Collections,
  Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.Win.ScktComp,
  Vcl.ExtCtrls;

type
  TCmdProc = procedure (Socket       : TCustomWinSocket;
                        const Params : String) of object;
  TCmdItem = record
      Cmd  : String;
      Proc : TCmdProc;
      constructor Create(const ACmd : String; AProc : TCmdProc);
  end;

    TServerMainForm = class(TForm)
        ServerSocket1 : TServerSocket;
        Memo1 : TMemo;
        ServerStartButton : TButton;
        PaintBox1 : TPaintBox;
        ServerStopButton : TButton;
        procedure PaintBox1Paint(Sender : TObject);
        procedure ServerSocket1ClientConnect(
            Sender : TObject;
            Socket : TCustomWinSocket);
        procedure ServerSocket1ClientDisconnect(
            Sender : TObject;
            Socket :
            TCustomWinSocket);
        procedure ServerSocket1ClientRead(
            Sender : TObject;
            Socket : TCustomWinSocket);
        procedure ServerSocket1Listen(
            Sender : TObject;
            Socket : TCustomWinSocket);
        procedure ServerStartButtonClick(Sender : TObject);
        procedure ServerStopButtonClick(Sender : TObject);
    private
        RectList : TList<TRect>;
        CmdList  : TList<TCmdItem>;
        procedure ProcessCmd(
            Socket        : TCustomWinSocket;
            const CmdLine : string);
        procedure CmdNoop(
            Socket       : TCustomWinSocket;
            const Params : string);
        procedure CmdClear(
            Socket       : TCustomWinSocket;
            const Params : string);
        procedure CmdRectangle(
            Socket       : TCustomWinSocket;
            const Params : string);
    public
        constructor Create(AOwner : TComponent); override;
        destructor Destroy; override;
    end;

var
    ServerMainForm: TServerMainForm;

implementation

{$R *.dfm}

function SkipOverWhiteSpaces(const CmdLine : String; Index : Integer) : Integer;
var
    I : Integer;
begin
    I := Index;
    while (I <= Length(CmdLine)) and
          CharInSet(CmdLine[I], [' ', #13, #10, #9]) do
        Inc(I);
    Result := I;
end;

function SkipToNextWhiteSpace(const CmdLine : String; Index : Integer) : Integer;
var
    I : Integer;
begin
    I := Index;
    while (I <= Length(CmdLine)) and
          (not CharInSet(CmdLine[I], [' ', #13, #10, #9])) do
        Inc(I);
    Result := I;
end;

function SkipToNextDelimiter(
    const CmdLine : String;
    Index         : Integer;
    Delimiters    : array of const) : Integer;
var
    I    : Integer;
    nArg : Integer;
    V    : TVarRec;
begin
    I := Index;
    while I <= Length(CmdLine) do begin
        nArg := 0;
        while nArg <= High(Delimiters) do begin
            V       := Delimiters[nArg];
            case (V.VType and varTypeMask) of
            vtWideChar:
                begin
                    if CmdLine[I] = V.VWideChar then begin
                        Result := I;
                        Exit;
                    end;
                end;
            end;
            Inc(nArg);
        end;
        Inc(I);
    end;
    Result := I;
end;

function GetInteger(
    const CmdLine : String;
    Index         : Integer;
    out Value     : Integer) : Integer;
var
    I : Integer;
begin
    Value := 0;
    I := SkipOverWhiteSpaces(CmdLine, Index);
    while (I <= Length(CmdLine)) and
          CharInSet(CmdLine[I], ['0'..'9']) do begin
        Value := Value * 10 + Ord(CmdLine[I]) - Ord('0');
        Inc(I);
    end;
    Result := I;
end;

procedure TServerMainForm.CmdClear(Socket: TCustomWinSocket; const Params: String);
begin
    RectList.Clear;
    PaintBox1.Invalidate;
    Socket.SendText('OK' + #13#10);
end;

procedure TServerMainForm.CmdNoop(Socket: TCustomWinSocket; const Params: String);
begin
    Socket.SendText('OK' + #13#10);
end;

procedure TServerMainForm.CmdRectangle(Socket: TCustomWinSocket; const Params: String);
var
   Param : array [0..3] of Integer;
   I, J, K : Integer;
begin
    // Clear all parameters
    for K := Low(Param) to High(Param) do
        Param[K] := 0;

    // Parse all parameters
    J := 1;
    K := Low(Param);
    while K <= High(Param) do begin
        I := GetInteger(Params, J, Param[K]);
        J := SkipOverWhiteSpaces(Params, I);
        if J > Length(Params) then
            break;
        if K = High(Param) then       // Check if we got all
            break;
        if Params[J] <> ',' then      // Check for coma delimiter
            break;
        Inc(J);                       // Skip over coma
        Inc(K);
    end;
    if K <> High(Param) then begin
        Socket.SendText('Rectangle requires 4 parameters.'#13#10);
        Exit;
    end;

    RectList.Add(TRect.Create(Param[0], Param[1], Param[2], Param[3]));
    PaintBox1.Invalidate;
    Socket.SendText('OK'#13#10);
end;

constructor TServerMainForm.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);
    RectList := TList<TRect>.Create;

    RectList.Add(TRect.Create(10, 10, 50, 50));
    RectList.Add(TRect.Create(20, 30, 80, 100));

    CmdList  := TList<TCmdItem>.Create;
    CmdList.Add(TCmdItem.Create('',          CmdNoop));
    CmdList.Add(TCmdItem.Create('Clear',     CmdClear));
    CmdList.Add(TCmdItem.Create('Rectangle', CmdRectangle));
end;

destructor TServerMainForm.Destroy;
begin
    FreeAndNil(CmdList);
    FreeAndNil(RectList);
    inherited Destroy;
end;

procedure TServerMainForm.PaintBox1Paint(Sender: TObject);
var
    R: TRect;
    ACanvas : TCanvas;
begin
    ACanvas := (Sender as TPaintBox).Canvas;
    ACanvas.Brush.Style := bsClear;
    ACanvas.Pen.Style   := psSolid;
    ACanvas.Pen.Color   := clRed;

    for R in RectList do
        ACanvas.Rectangle(R);
end;

procedure TServerMainForm.ServerSocket1ClientConnect(
    Sender: TObject;
    Socket: TCustomWinSocket);
begin
    Memo1.Lines.Add('Client connected');
    Socket.SendText('Welcome to myServer' + #13#10);
end;

procedure TServerMainForm.ServerSocket1ClientRead(Sender: TObject; Socket:
    TCustomWinSocket);
var
    CmdLine : String;
begin
    CmdLine := String(Socket.ReceiveText);
    Memo1.Lines.Add('Rcvd: "' + CmdLine + '"');
    ProcessCmd(Socket, CmdLine);
end;

procedure TServerMainForm.ProcessCmd(
    Socket        : TCustomWinSocket;
    const CmdLine : String);
var
    Cmd    : String;
    Params : String;
    I, J   : Integer;
begin
    I := SkipOverWhiteSpaces(CmdLine, 1);
    J := SkipToNextWhiteSpace(CmdLine, I);
    // Split command and parameters
    Cmd    := UpperCase(Copy(CmdLine, I, J - I));
    Params := Copy(CmdLine, J, MAXINT);
    Memo1.Lines.Add(Format('Cmd="%s"  Params="%s"', [Cmd, Params]));
    for I := 0 to CmdList.Count - 1 do begin
        if CmdList[I].Cmd = Cmd then begin
            CmdList[I].Proc(Socket, Params);
            Exit;
        end;
    end;
    Socket.SendText('Unknown command' + #13#10);
end;

procedure TServerMainForm.ServerSocket1ClientDisconnect(Sender: TObject; Socket:
    TCustomWinSocket);
begin
    Memo1.Lines.Add('Client disconnected');
end;

procedure TServerMainForm.ServerSocket1Listen(Sender: TObject; Socket: TCustomWinSocket);
begin
    Memo1.Lines.Add('Waiting for client connection');
end;

procedure TServerMainForm.ServerStartButtonClick(Sender: TObject);
begin
    ServerSocket1.Port := 2500;   // Almost any (free) port is OK
    ServerSocket1.Open;           // Start listening for clients
end;

procedure TServerMainForm.ServerStopButtonClick(Sender: TObject);
begin
    ServerSocket1.Close;
    Memo1.Lines.Add('Server stopped');
end;

{ TCmdItem }

constructor TCmdItem.Create(const ACmd: String; AProc: TCmdProc);
begin
    Cmd  := UpperCase(ACmd);
    Proc := AProc;
end;

end.

Server DFM:

object ServerMainForm: TServerMainForm
  Left = 0
  Top = 0
  Caption = 'ServerMainForm'
  ClientHeight = 498
  ClientWidth = 635
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  DesignSize = (
    635
    498)
  PixelsPerInch = 96
  TextHeight = 13
  object PaintBox1: TPaintBox
    Left = 8
    Top = 48
    Width = 617
    Height = 273
    Anchors = [akLeft, akTop, akRight, akBottom]
    OnPaint = PaintBox1Paint
  end
  object Memo1: TMemo
    Left = 8
    Top = 329
    Width = 617
    Height = 161
    Anchors = [akLeft, akTop, akRight, akBottom]
    Lines.Strings = (
      'Memo1')
    TabOrder = 0
  end
  object ServerStartButton: TButton
    Left = 12
    Top = 8
    Width = 75
    Height = 25
    Caption = 'Server Start'
    TabOrder = 1
    OnClick = ServerStartButtonClick
  end
  object ServerStopButton: TButton
    Left = 93
    Top = 8
    Width = 75
    Height = 25
    Caption = 'Server Stop'
    TabOrder = 2
    OnClick = ServerStopButtonClick
  end
  object ServerSocket1: TServerSocket
    Active = False
    Port = 0
    ServerType = stNonBlocking
    OnListen = ServerSocket1Listen
    OnClientConnect = ServerSocket1ClientConnect
    OnClientDisconnect = ServerSocket1ClientDisconnect
    OnClientRead = ServerSocket1ClientRead
    Left = 64
    Top = 196
  end
end

Upvotes: 1

Related Questions