type TPacket: packed record
 case boolean of
 true: (buf: array[0..8191] of byte;);
 false: (len:word;
         typepack:byte;);
 end;

var
 Packet:TPacket;

...
begin
 while true do
   begin
     if recv(FSocket,Packet,2,MSG_PEEK)<2 then Exit;
     if recv(FSocket,Packet,Packet.len,MSG_PEEK)<packet.len then Exit;
     recv(FSocket,Packet,Packet.len,0);
     Obrabotka(Packet); // функция обработки пакета
   end;
end;

function RecvBufFully(Peer:TSocket;var Buf; Count: Integer):boolean;
var pBuf:PByte;
  s:integer;
begin
  result:=false;
  pBuf:=@Buf;
  while count>0 do
  begin
    s:=recv(Peer,pBuf,Count,0);
    if s=0 then exit;
    inc(pBuf,s);
    dec(Count,s);
  end;
  result:=true;
end;

if RecvBufFully(FSocket,Packet.len,SizeOf(Packet.len)) then
if not RecvBufFully(FSocket,Packet.typepack,Packet.len) then БитыйПакет;

// нам нужно считать только один пакет, чтобы обработать его,
// но мы не знаем имеется ли в принятых данных целый пакет.
// для начала пытаемся считать первых 2 байта (которые хранят длину пакета, включая и эти 2 байта)
if recv(FSocket,Packet,2,MSG_PEEK)<2 then Exit; // если данных меньше 2-х байт - дальше не читаем.

// длина пакета известна, проверяем или есть весь пакет целиком, если нет, то прекращаем обработку. будем ждать...
if recv(FSocket,Packet,Packet.len,MSG_PEEK)<packet.len then Exit;

// пакет есть целиком и мы его прочитали, однако нужно удалить эти данные в буфере сокета
recv(FSocket,Packet,Packet.len,0);

//вроде бы и лишние операции, но и без них не могу обойтись...

uses RTLConsts;

function RecvBufFully(Peer:TSocket;var Buf; Count: Integer):boolean;
var pBuf:PByte;
 s,err:integer;
begin
 result:=false;
 pBuf:=@Buf;
 while count>0 do
 begin
   s:=recv(Peer,pBuf,Count,0);
   if s=SOCKET_ERROR then
   begin
     err:=WSAGetLastError;
     raise Exception.CreateResFmt(@sWindowsSocketError, [SysErrorMessage(err), err, 'recv']);
   end else
     if s=0 then exit;// сокет клозед грацефули
   inc(pBuf,s);
   dec(Count,s);
 end;
 result:=true;
end;

if RecvBufFully(FSocket,Packet.len,SizeOf(Packet.len)) then
if not RecvBufFully(FSocket,Packet.typepack,Packet.len) then БитыйПакет;

recv() = 0

...
if  WSAAsyncSelect(FSocket,FWindowHandle,WM_SOCKET_AUTH_EVENT, FD_CONNECT or FD_READ or FD_WRITE or FD_CLOSE)= SOCKET_ERROR then
...

...
private
   FBuffer: packed array[0..8191] of byte;
   FStartBuffer:integer;
   FEndBuffer:integer;
...

procedure TMyClass.ReceivePackets;
var
 s:Integer;
begin
 s:=recv(FSocket,FBuffer[FEndBuffer],length(FBuffer)-FEndBuffer,0);

// тут нужно обработать возможные ошибки.

 inc(FEndBuffer,s);
 while true do
   begin
     if FEndBuffer-FStartBuffer<2 then Break;
     move(FBuffer[FStartBuffer],Fpacket,2);
     if FPacket.len>sizeof(FPacket) then
       begin
         // Тут нужно закрыть сокет, и сгенерировать исключение
         // так как прием таких пакетов не планируется
         Exit;
       end;
     if FEndBuffer-FStartBuffer<Fpacket.len then Break;
     move(FBuffer[FStartBuffer],FPacket,Fpacket.len);
     inc(FstartBuffer,Fpacket.len);  // увеличиваем значение стартовой позиции буфера на величину забранных данных
     if FGame then ProcessingGame else ProcessingAuth;  // обработка выделенного пакета
    end;

  // Оптимизация буфера (чтобы обойтись без постоянных сдвигов буфера
  // сдвигать будем только при крайней необходимости)

  // Если буфер пустой, устанавливаем позиции начала и конца на 0
  if FStartBuffer>=FEndBuffer then
  begin
    FStartBuffer:=0;
    FEndBuffer:=0;
  end;
  // Оцениваем длину свободного хвоста буфера, если он менее 2 кб, то сдвигаем данные к началу буфера
  if length(FBuffer)-FEndBuffer<2048 then
  begin
    move(FBuffer[FStartBuffer],FBuffer[0], FEndBuffer-FStartBuffer);
    FEndBuffer:=FEndBuffer-FStartBuffer;
    FStartBuffer:=0;
  end;
end;

res:= recv(FSocket,F_rgbBuf[F_cbDepth],sizeof(F_rgbBuf) - F_cbDepth,0);
if( res > 0 )then begin
   inc(F_cbDepth, res);
   offs:= 0;
   while( (F_cbDepth >= sizeof(PPacket(@F_rgbBuf[offs]).len))  and
            (F_cbDepth >= PPacket(@F_rgbBuf[offs]).len)
   ) do begin
       _process(PPacket(@F_rgbBuf[offs])^);
       inc(offs, PPacket(@F_rgbBuf[offs]).len);
       dec(F_cbDepth, PPacket(@F_rgbBuf[offs]).len);
   end;
   if( (offs > 0) and (F_cbDepth > 0) )then
      move(F_rgbBuf[offs], F_cbDepth[0], F_cbDepth);
end else
   ...

recv

function ReceiveDataBlock(hSocket: THandle; DataBlockSize: Integer; out DataBlock; out ErrorCode: Integer): Boolean;
var
 i: Integer;
 BytesToRead, BytesRead: Integer;
begin
 Result := False;
 i := 0;
 while i < DataBlockSize do begin
   BytesToRead := DataBlockSize - i;
   BytesRead := Recv(hSocket, PByteArray(@DataBlock)[i], BytesToRead, 0);
   Inc(i, BytesRead);
   if BytesRead > 0 then Continue;
   case BytesRead of
     0: ErrorCode := 0;
     SOCKET_ERROR: ErrorCode := WSAGetLastError;
   end;
   Exit;
 end;
 Result := True;
end;

type
 TMyProtoReader=class
 private
   Socket:TClientSocket;
   Packet:Pointer;
 public
   constructor Create;
   destructor Destroy;override;
   function Connect:boolean;
   function GetPacket:Pointer;
 end;

{ TMyProtoReader }

constructor TMyProtoReader.Create;
begin
 Socket:=TClientSocket.Create(nil);
 Socket.ClientType:=ctBlocking;
end;

destructor TMyProtoReader.Destroy;
begin
 Socket.Free;
 FreeMem(Packet);
 inherited;
end;

function TMyProtoReader.Connect: boolean;
begin
 Socket.Address:='127.0.0.1';
 Socket.Port:=12345;
 Socket.Active:=true;
 result:=Socket.Active;
end;

function TMyProtoReader.GetPacket: Pointer;
type
 PPacket=^TPacket;
 TPacket=packed record
   Len:word;
   data:array[0..0] of byte;
 end;

 function RecvBufFully(Peer:TCustomWinSocket;var Buf; Count: Integer):boolean;
 var pBuf:PByte;
   s:integer;
 begin
   result:=false;
   pBuf:=@Buf;
   while count>0 do
   begin
     s:=Peer.ReceiveBuf(pBuf^,Count);
     if s=0 then exit;
     inc(pBuf,s);
     dec(Count,s);
   end;
   result:=true;
 end;

var len:word;
begin
 if not Socket.Active then
   raise Exception.Create('Not connected');

 if not RecvBufFully(Socket.Socket,len,SizeOf(len)) then
 begin
   Socket.Active:=false;
   raise Exception.Create('Bad packet');
 end;

 ReallocMem(Packet,len);
 PPacket(Packet).Len:=len;

 if not RecvBufFully(Socket.Socket,PPacket(Packet).Data,PPacket(Packet).len) then
 begin
   Socket.Active:=false;
   raise Exception.Create('Bad packet');
 end;

 result:=Packet;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 reader:TMyProtoReader;
 Packet:pointer;
begin
 reader:=TMyProtoReader.Create;
 try
   reader.Connect;
   while true do
   begin
     Packet:=reader.GetPacket;
     ProcessPacket(Packet);
     Application.ProcessMessages;
   end;
 finally
   reader.Free;
 end;

end;

...
procedure SocketEvent(var M:TMessage); message WM_SOCKET_AUTH_EVENT;
...

  if  WSAAsyncSelect(FSocket,FWindowHandle,WM_SOCKET_AUTH_EVENT, FD_CONNECT or FD_READ or FD_WRITE or FD_CLOSE)= SOCKET_ERROR then

...

procedure TXXX.SocketEvent(var M:TMessage);
begin
 case M.LParam of
 FD_CONNECT:;
 FD_READ:     ReceivePackets;
 FD_WRITE:    SendPackets;
 FD_CLOSE:    CloseConnection;
 end;
end;