Показать сообщение отдельно
  #4  
Старый 21.02.2011, 12:03
Аватар для NumLock
NumLock NumLock вне форума
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 тип]
__________________
Пишу программы за еду.
__________________
Ответить с цитированием