Соединение 2х сокетов

[Slym]

unit Unit2;

interface

uses
  Classes,ScktComp,WinSock;

type
  TTunnel = class(TThread)
  private
    FClientTimeout:integer;
  protected
    procedure DoTunneling(Peer1,Peer2:TCustomWinSocket);
    procedure Execute; override;
  end;

implementation

{ TTunnel }
procedure TTunnel.DoTunneling(Peer1,Peer2:TCustomWinSocket);
  function SendBufFully(Peer:TCustomWinSocket;var Buf; Count: Integer):boolean;
  var pBuf:PByte;
    s:integer;
  begin
    result:=false;
    pBuf:=@Buf;
    while count>0 do
    begin
      s:=Peer.SendBuf(pBuf^,Count);
      if s=0 then exit;
      inc(pBuf,s);
      dec(Count,s);
    end;
    result:=true;
  end;
var
  FDSet: TFDSet;
  TimeVal: TTimeVal;
  Buf:array[0..4095] of char;
  r:integer;
begin
  TimeVal.tv_sec := FClientTimeout div 1000;
  TimeVal.tv_usec := (FClientTimeout mod 1000) * 1000;
  while Peer1.Connected and Peer2.Connected do
  begin
    FD_ZERO(FDSet);
    FD_SET(Peer1.SocketHandle, FDSet);
    FD_SET(Peer2.SocketHandle, FDSet);
    if select(0, @FDSet, nil, nil, @TimeVal)>0 then
    begin
      if FD_ISSET(Peer1.SocketHandle, FDSet) then
      begin
        r:=Peer1.ReceiveBuf(Buf,Length(Buf));
        if r=0 then exit;
        if not SendBufFully(Peer2,Buf,r) then exit;
      end;
      if FD_ISSET(Peer2.SocketHandle, FDSet) then
      begin
        r:=Peer2.ReceiveBuf(Buf,Length(Buf));
        if r=0 then exit;
        if not SendBufFully(Peer1,Buf,r) then exit;
      end;
    end else
      exit;
  end;
end;

procedure TTunnel.Execute;
var
  Sock1,Sock2:TClientWinSocket;
  Host1,Host2:string;
  Port1,Port2:word;
begin
  FClientTimeout:=60000;
  Sock1:=TClientWinSocket.Create(INVALID_SOCKET);
  Sock2:=TClientWinSocket.Create(INVALID_SOCKET);
  try
    Sock1.ClientType:=ctBlocking;
    Sock2.ClientType:=ctBlocking;
    Sock1.Open('',Host1,'',Port1);
    Sock2.Open('',Host2,'',Port2);
    DoTunneling(Sock1,Sock2);
  finally
    Sock1.Free;
    Sock2.Free;
  end;
end;

end.

[Пепел Феникса]

а как из этого массива прочитать в переменную некого типа данных

либо CopyMem, либо читать сразу в нее.(зависит все от типа)

[Лубышев]

//44
type mes=record
id:integer;//идентификатор команды
ed:integer;
values:array[0..9] of integer;
end;


//44
type mestext=record
id:integer;//идентификатор команды
ed:integer;
pd:integer;
text:string[16];
text2:string[16];
end;

Надо записать одновременно в две переменных разных типов данных

[Пепел Феникса]

сделайте case-тип, будет проще, раз по размеру одно и тоже.

[Aliens_wolfs]

На вашей схеме сервер может быть любым или он тоже должен быть написан?

[Лубышев]

сделайте case-тип, будет проще, раз по размеру одно и тоже.

если я правильно понял вас то как то так?
http://www.delphisources.ru/pages/fa.../Case.php.html

интересная конструкция. даже не знал что так можно. спасибо большое

[Slym]

кто мешает завести указатель на структуру?

type
  PMyType=^TMyType;
  TMyType=record
    a,b:integer;
  end;
PMySecondType=^TMySecondType;
  TMySecondType=record
    x,y,z:integer;
  end;

а потом приводить указатель на буфер к типу PMyType

var
  buf:PChar;
begin

PMyType(buf)^.a:=1;
PMySecondType(buf)^.x:=10;

[Пепел Феникса]

зачем применять указатели когда можно отлично обойтись без них?

[Slym]

ищащий просветления хочет потом строки передавать "разной" так сказать длинны
и тут case recordы уже с натяжкой пойдут, к тому же case на развивающемся протоколе превратятся в монстра
а указатели и сами типы можно легко добавить не ломая прочей логики, и при наличии разных версий клиентов сильно упрощают дальнейшую разработку

доп.
ищащий загнал себя в рамки 44 байт от неумения корректно разрезать входящий трафик. научится и статичных записей станет мало

[Maxxxtri23]

Сообщение от Slym

unit Unit2;

interface

uses
  Classes,ScktComp,WinSock;

type
  TTunnel = class(TThread)
  private
    FClientTimeout:integer;
  protected
    procedure DoTunneling(Peer1,Peer2:TCustomWinSocket);
    procedure Execute; override;
  end;

implementation

{ TTunnel }
procedure TTunnel.DoTunneling(Peer1,Peer2:TCustomWinSocket);
  function SendBufFully(Peer:TCustomWinSocket;var Buf; Count: Integer):boolean;
  var pBuf:PByte;
    s:integer;
  begin
    result:=false;
    pBuf:=@Buf;
    while count>0 do
    begin
      s:=Peer.SendBuf(pBuf^,Count);
      if s=0 then exit;
      inc(pBuf,s);
      dec(Count,s);
    end;
    result:=true;
  end;
var
  FDSet: TFDSet;
  TimeVal: TTimeVal;
  Buf:array[0..4095] of char;
  r:integer;
begin
  TimeVal.tv_sec := FClientTimeout div 1000;
  TimeVal.tv_usec := (FClientTimeout mod 1000) * 1000;
  while Peer1.Connected and Peer2.Connected do
  begin
    FD_ZERO(FDSet);
    FD_SET(Peer1.SocketHandle, FDSet);
    FD_SET(Peer2.SocketHandle, FDSet);
    if select(0, @FDSet, nil, nil, @TimeVal)>0 then
    begin
      if FD_ISSET(Peer1.SocketHandle, FDSet) then
      begin
        r:=Peer1.ReceiveBuf(Buf,Length(Buf));
        if r=0 then exit;
        if not SendBufFully(Peer2,Buf,r) then exit;
      end;
      if FD_ISSET(Peer2.SocketHandle, FDSet) then
      begin
        r:=Peer2.ReceiveBuf(Buf,Length(Buf));
        if r=0 then exit;
        if not SendBufFully(Peer1,Buf,r) then exit;
      end;
    end else
      exit;
  end;
end;

procedure TTunnel.Execute;
var
  Sock1,Sock2:TClientWinSocket;
  Host1,Host2:string;
  Port1,Port2:word;
begin
  FClientTimeout:=60000;
  Sock1:=TClientWinSocket.Create(INVALID_SOCKET);
  Sock2:=TClientWinSocket.Create(INVALID_SOCKET);
  try
    Sock1.ClientType:=ctBlocking;
    Sock2.ClientType:=ctBlocking;
    Sock1.Open('',Host1,'',Port1);
    Sock2.Open('',Host2,'',Port2);
    DoTunneling(Sock1,Sock2);
  finally
    Sock1.Free;
    Sock2.Free;
  end;
end;

end.

Ошибку кидает =( Может я его не правильно использую?