
21.02.2011, 12:03
|
 |
Let Me Show You
|
|
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
|
|
один из вариантов мультиплексинга:
Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ScktComp;
type
PRec1 = ^TRec1;
TRec1 = record
ID: Word;
Data: String[32];
end;
PRec2 = ^TRec2;
TRec2 = record
ID: Word;
Parent: Word;
Data: String[32];
end;
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
CheckBox1: TCheckBox;
Memo1: TMemo;
ClientSocket1: TClientSocket;
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure CheckBox1Click(Sender: TObject);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
FPipeRead: THandle;
FPipeWrite: THandle;
FDataLen: DWORD;
procedure Multiplex;
procedure Notify(data: PChar; len: DWORD);
public
{ Public declarations }
end;
var
Form1: TForm1;
const
PipeSize: Cardinal = 1024*1024;
implementation
{$R *.dfm}
procedure TForm1.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 TForm1.Notify(data: PChar; len: DWORD);
begin
Memo1.Lines.Add('--');
case len of
SizeOf(TRec1): begin
Memo1.Lines.Add('ID='+IntToStr(PRec1(data)^.ID));
Memo1.Lines.Add('Data='+PRec1(data)^.Data);
end;
SizeOf(TRec2): begin
Memo1.Lines.Add('ID='+IntToStr(PRec2(data)^.ID));
Memo1.Lines.Add('Parent='+IntToStr(PRec2(data)^.Parent));
Memo1.Lines.Add('Data='+PRec2(data)^.Data);
end;
end;
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
ServerSocket1.Active:=CheckBox1.Checked;
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
len: DWORD;
data: PChar;
dummy: Cardinal;
begin
len:=Socket.ReceiveLength;
GetMem(data, len);
len:=Socket.ReceiveBuf(data^, len);
WriteFile(FPipeWrite, data^, len, dummy, nil);
FreeMem(data);
Multiplex;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
CreatePipe(FPipeRead, FPipeWrite, nil, PipeSize);
FDataLen:=0;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
CloseHandle(FPipeWrite);
CloseHandle(FPipeRead);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
rec1: TRec1;
buf: DWORD;
begin
ClientSocket1.Open;
rec1.ID:=$1;
rec1.Data:='avatar';
buf:=SizeOf(rec1);
ClientSocket1.Socket.SendBuf(buf, SizeOf(DWORD));
ClientSocket1.Socket.SendBuf(rec1, SizeOf(rec1));
ClientSocket1.Close;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
rec2: TRec2;
buf: DWORD;
begin
ClientSocket1.Open;
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));
ClientSocket1.Close;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
rec1: TRec1;
rec2: TRec2;
buf: DWORD;
i: Integer;
begin
ClientSocket1.Open;
for i:=1 to 10 do
begin
rec1.ID:=i;
rec1.Data:='avatar';
buf:=SizeOf(rec1);
ClientSocket1.Socket.SendBuf(buf, SizeOf(DWORD));
ClientSocket1.Socket.SendBuf(rec1, SizeOf(rec1));
rec2.ID:=i*100;
rec2.Parent:=i;
rec2.Data:='the stol';
buf:=SizeOf(rec2);
ClientSocket1.Socket.SendBuf(buf, SizeOf(DWORD));
ClientSocket1.Socket.SendBuf(rec2, SizeOf(rec2));
end;
ClientSocket1.Close;
end;
end.
http://data.cod.ru/90155
TCheckBox вкл/выкл сервер
Open1 посылает 1 тип рекорда
Open2 посылает 2 тип рекорда
OpenMany посылает 10 раз [1 тип, 2 тип]
__________________
Пишу программы за еду.
__________________
|