[NumLock]

Код:

unit Unit1;

interface

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

type
  PRec1 = ^TRec1;
  TRec1 = record
    ID: Word;
    Data: String[32];
  end;

  PRec2 = ^TRec2;
  TRec2 = record
    ID: Word;
    Parent: Word;
    Data: String[32];
  end;

  TMyServerClientThread = class(TServerClientThread)
  private
    FPipeRead: THandle;
    FPipeWrite: THandle;
    FDataLen: DWORD;
    FStr: String;
    procedure Multiplex;
    procedure Notify(Buffer: PChar; Len: DWORD);
    procedure UpdateThread;
  protected
    procedure ClientExecute; override;
  public
    constructor Create(CreateSuspended: Boolean; ASocket: TServerClientWinSocket);
    destructor Destroy; override;
  end;

  TForm1 = class(TForm)
    ServerSocket1: TServerSocket;
    CheckBox1: TCheckBox;
    Memo1: TMemo;
    ClientSocket1: TClientSocket;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Memo2: TMemo;
    CheckBox2: TCheckBox;
    ClientSocket2: TClientSocket;
    procedure CheckBox1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ServerSocket1GetThread(Sender: TObject;
      ClientSocket: TServerClientWinSocket;
      var SocketThread: TServerClientThread);
    procedure CheckBox2Click(Sender: TObject);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientSocket2Read(Sender: TObject; Socket: TCustomWinSocket);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

const
  PipeSize: Cardinal = 1024*1024;

implementation

{$R *.dfm}

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  ServerSocket1.Active:=CheckBox1.Checked;
end;

procedure TForm1.CheckBox2Click(Sender: TObject);
begin
  ClientSocket1.Active:=CheckBox2.Checked;
  ClientSocket2.Active:=CheckBox2.Checked;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  rec1: TRec1;
  buf: DWORD;
begin
  rec1.ID:=$1;
  rec1.Data:='avatar';
  buf:=SizeOf(rec1);
  ClientSocket1.Socket.SendBuf(buf, SizeOf(DWORD));
  ClientSocket1.Socket.SendBuf(rec1, SizeOf(rec1));
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  rec2: TRec2;
  buf: DWORD;
begin
  rec2.ID:=$2;
  rec2.Parent:=$1;
  rec2.Data:='the stol';
  buf:=SizeOf(rec2);
  ClientSocket1.Socket.SendBuf(buf, SizeOf(DWORD));
  ClientSocket1.Socket.SendBuf(rec2, SizeOf(rec2));
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  rec1: TRec1;
  rec2: TRec2;
  buf: DWORD;
  i: Integer;
begin
  for i:=1 to 10 do
  begin
    rec1.ID:=i;
    rec1.Data:='many avatar';
    buf:=SizeOf(rec1);
    ClientSocket2.Socket.SendBuf(buf, SizeOf(DWORD));
    ClientSocket2.Socket.SendBuf(rec1, SizeOf(rec1));

    rec2.ID:=i*100;
    rec2.Parent:=i;
    rec2.Data:='many the stol';
    buf:=SizeOf(rec2);
    ClientSocket2.Socket.SendBuf(buf, SizeOf(DWORD));
    ClientSocket2.Socket.SendBuf(rec2, SizeOf(rec2));
  end;
end;

procedure TForm1.ServerSocket1GetThread(Sender: TObject;
  ClientSocket: TServerClientWinSocket;
  var SocketThread: TServerClientThread);
begin
  SocketThread:=TMyServerClientThread.Create(False, ClientSocket);
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Memo2.Lines.Add(Socket.ReceiveText);
end;

procedure TForm1.ClientSocket2Read(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Memo2.Lines.Add(Socket.ReceiveText);
end;

{ TMyServerClientThread }

constructor TMyServerClientThread.Create(CreateSuspended: Boolean; ASocket: TServerClientWinSocket);
begin
  CreatePipe(FPipeRead, FPipeWrite, nil, PipeSize);
  FDataLen:=0;
  FStr:='Create';
  Synchronize(UpdateThread);
  inherited Create(CreateSuspended, ASocket);
end;

destructor TMyServerClientThread.Destroy;
begin
  inherited Destroy;
  CloseHandle(FPipeWrite);
  CloseHandle(FPipeRead);
end;

procedure TMyServerClientThread.ClientExecute;
var
  Stream: TWinSocketStream;
  Buffer: array [0..$ff] of Char;
  Len: Integer;
  dummy: Cardinal;
begin
  while not Terminated and ClientSocket.Connected do
  begin
    Stream:=TWinSocketStream.Create(ClientSocket, 60000);
    try
      if Stream.WaitForData(60000) then
      begin
        Len:=Stream.Read(Buffer, Length(Buffer));
        if Len=0 then ClientSocket.Close;
        WriteFile(FPipeWrite, Buffer[0], Len, dummy, nil);
        Multiplex;
      end else ClientSocket.Close;
    finally
      Stream.Free;
    end;
  end;
end;

procedure TMyServerClientThread.Multiplex;
var
  len: DWORD;
  data: PChar;
  dummy: Cardinal;
begin
  while True do
  begin
    len:=GetFileSize(FPipeRead, nil);
    if len=0 then Break;
    if FDataLen=0 then
    begin
      if len<SizeOf(DWORD) then Break;
      ReadFile(FPipeRead, FDataLen, SizeOf(DWORD), dummy, nil);
    end else
    begin
      if len<FDataLen then Break;
      GetMem(data, FDataLen);
      ReadFile(FPipeRead, data^, FDataLen, dummy, nil);
      Notify(data, FDataLen);
      FreeMem(data);
      FDataLen:=0;
    end;
  end;
end;

procedure TMyServerClientThread.Notify(Buffer: PChar; Len: DWORD);
begin
  FStr:='--'#13#10;
  case len of
    SizeOf(TRec1): begin
      FStr:=FStr+'ID='+IntToStr(PRec1(Buffer)^.ID)+#13#10;
      FStr:=FStr+'Data='+PRec1(Buffer)^.Data+#13#10;
    end;
    SizeOf(TRec2): begin
      FStr:=FStr+'ID='+IntToStr(PRec2(Buffer)^.ID)+#13#10;
      FStr:=FStr+'Parent='+IntToStr(PRec2(Buffer)^.Parent)+#13#10;
      FStr:=FStr+'Data='+PRec2(Buffer)^.Data+#13#10;
    end;
  end;
  Synchronize(UpdateThread);
  ClientSocket.SendText(FStr);
end;

procedure TMyServerClientThread.UpdateThread;
begin
  Form1.Memo1.Lines.Add(FStr);
end;

end.

ServerSocket
ClientSocket
Open1 посылает 1 тип рекорда
Open2 посылает 2 тип рекорда
OpenMany посылает 10 раз [1 тип, 2 тип]

http://data.cod.ru/90607