init

WsClient.pas

@@ -0,0 +1,175 @@
+unit WsClient;
+
+{
+  WsClient.pas — WebSocket клиент (одно соединение).
+
+  Инкапсулирует:
+    - TCP-сокет
+    - Состояние WS (handshake / open / closed)
+    - Буфер приёма
+    - Отправку raw-байт, WS-фреймов (text / binary)
+    - Basic-Auth флаг
+}
+
+{$IFDEF FPC}
+  {$MODE Delphi}
+  {$LONGSTRINGS ON}
+{$ENDIF}
+
+interface
+
+uses
+  SyncObjs, WebUtils
+  {$IFDEF WINDOWS}, WinSock2{$ELSE}, Sockets{$ENDIF};
+
+type
+  TWsState = (wsHandshake, wsOpen, wsClosed);
+
+  TWsClient = class
+  private
+    FSocket:  TSocket;
+    FState:   TWsState;
+    FLock:    TCriticalSection;
+    FBuf:     array[0..4095] of Byte;
+    FBufLen:  Integer;
+    FAuthed:  Boolean;
+  public
+    constructor Create(ASocket: TSocket);
+    destructor  Destroy; override;
+
+    { Отправка raw-байт (вызывать держа FLock) }
+    function SendRaw(const Data; Len: Integer): Boolean;
+
+    { Отправка WebSocket-фрейма (text или binary) }
+    function SendWsFrame(Opcode: Byte; const Data; Len: Integer): Boolean;
+
+    { Текстовый WS-фрейм (opcode $01) }
+    function SendText(const S: string): Boolean;
+
+    { Бинарный WS-фрейм (opcode $02) }
+    function SendBinary(const Data; Len: Integer): Boolean;
+
+    { Читает данные в FBuf, возвращает кол-во байт (-1 = ошибка/закрыто) }
+    function Recv: Integer;
+
+    { Указатель на начало буфера приёма }
+    function BufData: PByte; inline;
+
+    property Socket: TSocket read FSocket;
+    property State:  TWsState read FState write FState;
+    property Authed: Boolean  read FAuthed write FAuthed;
+    property Lock:   TCriticalSection read FLock;
+    property BufLen: Integer  read FBufLen write FBufLen;
+  end;
+
+implementation
+
+{ ═══════════════════════════════════════════════════════════════════════════
+  TWsClient
+  ═══════════════════════════════════════════════════════════════════════════ }
+
+constructor TWsClient.Create(ASocket: TSocket);
+begin
+  inherited Create;
+  FSocket  := ASocket;
+  FState   := wsHandshake;
+  FBufLen  := 0;
+  FAuthed  := False;
+  FLock    := TCriticalSection.Create;
+end;
+
+destructor TWsClient.Destroy;
+begin
+  if FSocket <> SOCK_INVALID then
+    SockClose(FSocket);
+  FLock.Free;
+  inherited;
+end;
+
+function TWsClient.SendRaw(const Data; Len: Integer): Boolean;
+var
+  Sent, R: Integer;
+  P: PByte;
+begin
+  Result := False;
+  if (FSocket = SOCK_INVALID) or (Len <= 0) then Exit;
+  P    := @Data;
+  Sent := 0;
+  while Sent < Len do
+  begin
+    R := SockSend(FSocket, P + Sent, Len - Sent, 0);
+    if R <= 0 then Exit;
+    Inc(Sent, R);
+  end;
+  Result := True;
+end;
+
+function TWsClient.SendWsFrame(Opcode: Byte; const Data; Len: Integer): Boolean;
+var
+  Header: array[0..9] of Byte;
+  HLen:   Integer;
+  P:      PByte;
+begin
+  Result := False;
+  if FState <> wsOpen then Exit;
+
+  // FIN=1 + opcode
+  Header[0] := $80 or (Opcode and $0F);
+
+  if Len <= 125 then
+  begin
+    Header[1] := Byte(Len);
+    HLen := 2;
+  end
+  else if Len <= 65535 then
+  begin
+    Header[1] := 126;
+    Header[2] := Byte(Len shr 8);
+    Header[3] := Byte(Len);
+    HLen := 4;
+  end
+  else
+  begin
+    Header[1] := 127;
+    Header[2] := 0; Header[3] := 0; Header[4] := 0; Header[5] := 0;
+    Header[6] := Byte(Len shr 24); Header[7] := Byte(Len shr 16);
+    Header[8] := Byte(Len shr  8); Header[9] := Byte(Len);
+    HLen := 10;
+  end;
+
+  FLock.Enter;
+  try
+    Result := SendRaw(Header[0], HLen);
+    if Result and (Len > 0) then
+    begin
+      P      := @Data;
+      Result := SendRaw(P^, Len);
+    end;
+  finally
+    FLock.Leave;
+  end;
+end;
+
+function TWsClient.SendText(const S: string): Boolean;
+begin
+  if Length(S) = 0 then begin Result := True; Exit; end;
+  Result := SendWsFrame($01, S[1], Length(S));
+end;
+
+function TWsClient.SendBinary(const Data; Len: Integer): Boolean;
+begin
+  Result := SendWsFrame($02, Data, Len);
+end;
+
+function TWsClient.Recv: Integer;
+begin
+  Result := SockRecv(FSocket, @FBuf[FBufLen], SizeOf(FBuf) - FBufLen, 0);
+  if Result > 0 then Inc(FBufLen, Result);
+end;
+
+function TWsClient.BufData: PByte;
+begin
+  Result := @FBuf[0];
+end;
+
+end.