如何通过套接字发送/接收元素列表？

Question

我有以下代码，我可以在其中绘制几个矩形并在每个矩形上打一个洞。

如何通过套接字 (TServerSocket) 发送 RectList 对象并将该对象直接恢复（在 TClientSocket 中接收）到相同类型的变量 (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.

Answer 1

我写了一些代码来告诉你怎么做。

在您的代码中，我在表单上添加了TClientSocket 并分配了一些事件。还添加了TButton 以通过TClientSocket 将RectList 发送到另一端（服务器端）。

我设计了一个新的简单服务器应用程序，它设置了一个TServerSocket 来侦听客户端连接并接受来自客户端的commands。我实现了两个命令：rectangle 和 clear。显然clear命令是用来清除矩形列表上的显示的。 rectangle 命令用于发送一个矩形（左、上、右、下为逗号分隔的整数）。

由于客户端和服务器必须相互理解，所以我设计了一个非常简单的通信协议。使用 ASCII 行在客户端和服务器之间交换数据。行是由 CRLF 对终止的任何字符集合。使用 TCP 端口 2500（几乎任何其他端口都可以）。

例如命令

矩形 10,20,30,40

将从客户端发送一个矩形到服务器（上面的行以CRLF终止）。

如果服务器接收到一个有效的命令，它会执行它然后发送

好的

上面的行由 CRLF 终止。如果发生错误，则会将错误消息发送回客户端。

当客户端建立连接时，服务器做的第一件事就是发送欢迎横幅。那是由 CRLF 终止的行。

客户端在发送任何命令之前等待接收横幅。然后它发送 clear 命令，等待 OK，然后发送一个 rectangle 命令，其中第一项在RectList 并等待 OK，然后循环发送所有 rectangle 命令并等待 OK 确认，直到发送完所有 RectList。客户端关闭连接。

当我说等待时，我并不完全正确。实际上套接字是事件驱动的。这意味着一切都已完成。例如，当一条线进来时——由另一端发送——套接字会触发一个 OnRead 事件。在相应的事件处理程序中，您会收到已经收到的行。

我使用了这个面向行的协议，因为它非常简单，易于调试和跨平台。实际上，if 看起来很像用于发送电子邮件的 SMTP 协议！发送二进制数据肯定更快，但有很多困难。二进制数据格式是编译器和平台特定的。这导致困难。二进制数据对于人类来说很难读取，因此也很难调试。

您将在下面找到您的增强源代码和 DFM（这是客户端），然后是服务器源代码和 DFM。

客户端源代码：

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.

客户端 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

服务器源代码：

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.

服务器 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