send/receive如何将一个List的元素over socket?
How send/receive a List of elements over socket?
我有以下代码,我可以在其中绘制多个矩形并在每个矩形上打一个洞。
如何通过套接字 (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.
我编写了一些代码来向您展示如何操作。
在您的代码中,我在表单上添加了一个 TClientSocket
并分配了一些事件。还添加了一个 TButton
以通过 TClientSocket
.
将 RectList
发送到另一端(服务器端)
我设计了一个新的简单服务器应用程序,其中设置了 TServerSocket
以侦听客户端连接并从客户端接受 commands
。我实现了两个命令:rectangle 和 clear。显然clear命令是为了清除矩形列表上的显示而执行的。 rectangle 命令用于发送一个矩形(左、上、右和下为逗号分隔的整数)。
由于客户端和服务器必须相互理解,所以我设计了一个非常简单的通信协议。使用 ASCII 行在客户端和服务器之间交换数据。行是由 CRLF 对终止的任何字符集合。使用 TCP 端口 2500(几乎任何其他端口都可以)。
例如,命令
rectangle 10,20,30,40
将从客户端向服务器发送一个矩形(上面的行以 CRLF 终止)。
如果服务器接收到一个有效的命令,它会执行并发送
OK
上面一行以 CRLF 结束。如果出现错误,则会将错误消息发送回客户端。
当客户端建立连接时,服务器做的第一件事就是发送欢迎横幅。这是由 CRLF 终止的行。
客户端在发送任何命令之前等待接收横幅。然后它发送 clear 命令,等待 OK,然后发送 rectangle 命令,其中第一项在 RectList
并等待 OK,然后循环发送所有 矩形 命令并等待 OK 确认,直到所有 RectList
已发送。客户端关闭连接。
我说的等待并不完全正确。实际上套接字是事件驱动。这意味着一切都在事件中完成。例如,当一条线进来时 - 由另一方发送 - 套接字触发 OnRead 事件。在相应的事件处理程序中,您收到已收到的行。
我使用这个面向行的协议是因为它非常简单,易于调试和跨平台。实际上,如果看起来很像用于发送电子邮件的 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
我有以下代码,我可以在其中绘制多个矩形并在每个矩形上打一个洞。
如何通过套接字 (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.
我编写了一些代码来向您展示如何操作。
在您的代码中,我在表单上添加了一个 TClientSocket
并分配了一些事件。还添加了一个 TButton
以通过 TClientSocket
.
RectList
发送到另一端(服务器端)
我设计了一个新的简单服务器应用程序,其中设置了 TServerSocket
以侦听客户端连接并从客户端接受 commands
。我实现了两个命令:rectangle 和 clear。显然clear命令是为了清除矩形列表上的显示而执行的。 rectangle 命令用于发送一个矩形(左、上、右和下为逗号分隔的整数)。
由于客户端和服务器必须相互理解,所以我设计了一个非常简单的通信协议。使用 ASCII 行在客户端和服务器之间交换数据。行是由 CRLF 对终止的任何字符集合。使用 TCP 端口 2500(几乎任何其他端口都可以)。
例如,命令
rectangle 10,20,30,40
将从客户端向服务器发送一个矩形(上面的行以 CRLF 终止)。
如果服务器接收到一个有效的命令,它会执行并发送
OK
上面一行以 CRLF 结束。如果出现错误,则会将错误消息发送回客户端。
当客户端建立连接时,服务器做的第一件事就是发送欢迎横幅。这是由 CRLF 终止的行。
客户端在发送任何命令之前等待接收横幅。然后它发送 clear 命令,等待 OK,然后发送 rectangle 命令,其中第一项在 RectList
并等待 OK,然后循环发送所有 矩形 命令并等待 OK 确认,直到所有 RectList
已发送。客户端关闭连接。
我说的等待并不完全正确。实际上套接字是事件驱动。这意味着一切都在事件中完成。例如,当一条线进来时 - 由另一方发送 - 套接字触发 OnRead 事件。在相应的事件处理程序中,您收到已收到的行。
我使用这个面向行的协议是因为它非常简单,易于调试和跨平台。实际上,如果看起来很像用于发送电子邮件的 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