Статья VNC через Relay (Работа за NAT) или пробуем повторить AnyDesk на Паскале.[2]

[Admin]

VNC через Relay (Работа за NAT) или пробуем повторить AnyDesk на Паскале. [2]​

Исходник релея:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
  Windows, WinSock2, LMessages, SyncObjs, Contnrs;

const
  RELAY_PORT = 5500;
  MAX_CONNECTIONS = 100;
  ID_LENGTH = 9;
  WM_SOCKET = WM_USER + 1;

type
  TConnectionType = (ctUnknown, ctVncServer, ctVncClient);
  TPeerState = (psWaiting, psConnected, psDisconnected);

  TScreenHeader = packed record
    Width: DWORD;
    Height: DWORD;
    DataSize: DWORD;
    ImageFormat: Byte;  // 0 = RAW, 1 = JPEG, 2 = PNG
  end;

  TConnectionInfo = record
    Socket: TSocket;
    ConnectionType: TConnectionType;
    PeerID: array[0..ID_LENGTH-1] of Char;
    ConnectedTo: array[0..ID_LENGTH-1] of Char;
    RemoteIP: string;
    RemotePort: Integer;
    LastActive: TDateTime;
    PeerState: TPeerState;
    DataBuffer: TMemoryStream;
    CriticalSection: TCriticalSection;
    ExpectingHeader: Boolean;
    CurrentHeader: TScreenHeader;
    ImageDataReceived: Integer;
  end;
  PConnectionInfo = ^TConnectionInfo;

  TPeerConnection = record
    ID: array[0..ID_LENGTH-1] of Char;
    ServerConnection: TSocket;
    ClientConnection: TSocket;
    State: TPeerState;
    Created: TDateTime;
  end;
  PPeerConnection = ^TPeerConnection;

  { TRelayServerForm }

  TRelayServerForm = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Memo1: TMemo;
    Panel1: TPanel;
    Timer1: TTimer;

    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);

  private
    FServerSocket: TSocket;
    FWSAData: TWSADATA;
    FRunning: Boolean;
    FConnections: array[0..MAX_CONNECTIONS-1] of TConnectionInfo;
    FPeerConnections: TList;
    FCriticalSection: TCriticalSection;

    function GenerateID: string;
    function FindFreeConnectionSlot: Integer;
    function FindConnectionBySocket(Socket: TSocket): PConnectionInfo;
    function FindConnectionByID(const ID: string): PConnectionInfo;
    function FindPeerByID(const ID: string): PPeerConnection;
    function CreatePeer(const ID: string; ServerSocket: TSocket): PPeerConnection;
    procedure RemovePeer(Peer: PPeerConnection);
    procedure AcceptConnection;
    procedure ProcessConnection(Socket: TSocket);
    procedure HandleRegistration(Socket: TSocket; const Data: string);
    procedure HandleConnectRequest(Socket: TSocket; const Data: string);
    procedure RelayData(SourceSocket: TSocket; const Data: array of Byte; DataSize: Integer);
    procedure RelayDataStr(SourceSocket: TSocket; const Data: string);
    procedure DisconnectConnection(Socket: TSocket);
    procedure StartServer;
    procedure StopServer;
    procedure UpdateConnectionsCount;
    procedure SendResponse(Socket: TSocket; const Response: string);
    procedure AddLog(const Msg: string);
    procedure ClearLog(Sender: TObject);



  protected
    procedure WMSocket(var Message: TLMessage); message WM_SOCKET;

  public

  end;

var
  RelayServerForm: TRelayServerForm;

implementation

{$R *.lfm}

function RandomString(Length: Integer): string;
const
  Chars = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789';
var
  i, CharCount: Integer;
begin
  Result := '';
  CharCount := System.Length(Chars);
  for i := 1 to Length do
    Result := Result + Chars[Random(CharCount) + 1];
end;

{ TRelayServerForm }

procedure TRelayServerForm.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  Caption := 'VNC Relay Server (JPEG Support)';
  Button1.Caption := 'Start';
  Button2.Caption := 'Stop';
  Button2.Enabled := False;
  Button3.Caption := 'Clear Log';
  Edit1.Text := IntToStr(RELAY_PORT);
  Label1.Caption := 'Stopped';
  Label2.Caption := 'Connections: 0';
  Label3.Caption := 'Peers: 0';
  Label4.Caption := 'Port:';
  Label5.Caption := 'Server';

  FServerSocket := INVALID_SOCKET;
  FRunning := False;

  Randomize;

  for i := 0 to MAX_CONNECTIONS - 1 do
  begin
    FConnections[i].Socket := INVALID_SOCKET;
    FConnections[i].ConnectionType := ctUnknown;
    FillChar(FConnections[i].PeerID, ID_LENGTH, 0);
    FillChar(FConnections[i].ConnectedTo, ID_LENGTH, 0);
    FConnections[i].RemoteIP := '';
    FConnections[i].RemotePort := 0;
    FConnections[i].LastActive := Now;
    FConnections[i].PeerState := psDisconnected;
    FConnections[i].DataBuffer := TMemoryStream.Create;
    FConnections[i].CriticalSection := TCriticalSection.Create;
    FConnections[i].ExpectingHeader := True;
    FConnections[i].ImageDataReceived := 0;
  end;

  FPeerConnections := TList.Create;
  FCriticalSection := TCriticalSection.Create;

  if WSAStartup(MAKEWORD(2, 2), FWSAData) <> 0 then
  begin
    ShowMessage('Winsock init failed');
    Exit;
  end;

  Timer1.Interval := 10000;
  Timer1.Enabled := False;

  AddLog('JPEG Relay Server ready');
end;

procedure TRelayServerForm.FormDestroy(Sender: TObject);
var
  i: Integer;
  Peer: PPeerConnection;
begin
  StopServer;

  for i := 0 to MAX_CONNECTIONS - 1 do
  begin
    if FConnections[i].DataBuffer <> nil then
      FreeAndNil(FConnections[i].DataBuffer);
    if FConnections[i].CriticalSection <> nil then
      FreeAndNil(FConnections[i].CriticalSection);
  end;

  FCriticalSection.Enter;
  try
    for i := 0 to FPeerConnections.Count - 1 do
    begin
      Peer := PPeerConnection(FPeerConnections[i]);
      Dispose(Peer);
    end;
    FreeAndNil(FPeerConnections);
  finally
    FCriticalSection.Leave;
    FreeAndNil(FCriticalSection);
  end;

  WSACleanup;
end;

function TRelayServerForm.GenerateID: string;
begin
  Result := RandomString(8);
  AddLog('Generated new ID: ' + Result);
end;

function TRelayServerForm.FindFreeConnectionSlot: Integer;
var
  i: Integer;
begin
  for i := 0 to MAX_CONNECTIONS - 1 do
  begin
    if FConnections[i].Socket = INVALID_SOCKET then
    begin
      Result := i;
      Exit;
    end;
  end;
  Result := -1;
end;

function TRelayServerForm.FindConnectionBySocket(Socket: TSocket): PConnectionInfo;
var
  i: Integer;
begin
  for i := 0 to MAX_CONNECTIONS - 1 do
  begin
    if FConnections[i].Socket = Socket then
    begin
      Result := @FConnections[i];
      Exit;
    end;
  end;
  Result := nil;
end;

function TRelayServerForm.FindConnectionByID(const ID: string): PConnectionInfo;
var
  i: Integer;
begin
  for i := 0 to MAX_CONNECTIONS - 1 do
  begin
    if (FConnections[i].Socket <> INVALID_SOCKET) and
       (StrPas(FConnections[i].PeerID) = ID) then
    begin
      Result := @FConnections[i];
      Exit;
    end;
  end;
  Result := nil;
end;

function TRelayServerForm.FindPeerByID(const ID: string): PPeerConnection;
var
  i: Integer;
  Peer: PPeerConnection;
begin
  Result := nil;
  FCriticalSection.Enter;
  try
    for i := 0 to FPeerConnections.Count - 1 do
    begin
      Peer := PPeerConnection(FPeerConnections[i]);
      if StrPas(Peer^.ID) = ID then
      begin
        Result := Peer;
        Exit;
      end;
    end;
  finally
    FCriticalSection.Leave;
  end;
end;

function TRelayServerForm.CreatePeer(const ID: string; ServerSocket: TSocket): PPeerConnection;
begin
  New(Result);
  FillChar(Result^, SizeOf(TPeerConnection), 0);
  StrPCopy(Result^.ID, ID);
  Result^.ServerConnection := ServerSocket;
  Result^.ClientConnection := INVALID_SOCKET;
  Result^.State := psWaiting;
  Result^.Created := Now;

  FCriticalSection.Enter;
  try
    FPeerConnections.Add(Result);
    Label3.Caption := 'Peers: ' + IntToStr(FPeerConnections.Count);
  finally
    FCriticalSection.Leave;
  end;

  AddLog('Created peer for ID: ' + ID);
end;

procedure TRelayServerForm.RemovePeer(Peer: PPeerConnection);
begin
  FCriticalSection.Enter;
  try
    FPeerConnections.Remove(Peer);
    Dispose(Peer);
    Label3.Caption := 'Peers: ' + IntToStr(FPeerConnections.Count);
  finally
    FCriticalSection.Leave;
  end;
end;

procedure TRelayServerForm.Button1Click(Sender: TObject);
begin
  StartServer;
end;

procedure TRelayServerForm.Button2Click(Sender: TObject);
begin
  StopServer;
end;

procedure TRelayServerForm.Button3Click(Sender: TObject);
begin
  Memo1.Lines.Clear;
  AddLog('Log cleared');
end;

procedure TRelayServerForm.ClearLog(Sender: TObject);
begin
  Memo1.Lines.Clear;
  AddLog('Log cleared');
end;

procedure TRelayServerForm.Timer1Timer(Sender: TObject);
var
  i: Integer;
  Peer: PPeerConnection;
  j: Integer;
begin
  for i := 0 to MAX_CONNECTIONS - 1 do
  begin
    if FConnections[i].Socket <> INVALID_SOCKET then
    begin
      if (Now - FConnections[i].LastActive) > (5 / 1440) then
      begin
        AddLog('Disconnecting inactive connection: ' +
               StrPas(FConnections[i].PeerID));
        DisconnectConnection(FConnections[i].Socket);
      end;
    end;
  end;

  FCriticalSection.Enter;
  try
    for j := FPeerConnections.Count - 1 downto 0 do
    begin
      Peer := PPeerConnection(FPeerConnections[j]);
      if (Peer^.State = psWaiting) and
         ((Now - Peer^.Created) > (2 / 1440)) then
      begin
        AddLog('Removing expired peer: ' + StrPas(Peer^.ID));
        FPeerConnections.Delete(j);
        Dispose(Peer);
      end;
    end;
    Label3.Caption := 'Peers: ' + IntToStr(FPeerConnections.Count);
  finally
    FCriticalSection.Leave;
  end;
end;

procedure TRelayServerForm.StartServer;
var
  ServerAddr: TSockAddrIn;
  Port: Integer;
begin
  if FRunning then Exit;

  Port := StrToIntDef(Edit1.Text, RELAY_PORT);

  try
    FServerSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
    if FServerSocket = INVALID_SOCKET then
      raise Exception.Create('Socket creation failed');

    FillChar(ServerAddr, SizeOf(ServerAddr), 0);
    ServerAddr.sin_family := AF_INET;
    ServerAddr.sin_addr.s_addr := INADDR_ANY;
    ServerAddr.sin_port := htons(Port);

    if bind(FServerSocket, @ServerAddr, SizeOf(ServerAddr)) = SOCKET_ERROR then
      raise Exception.Create('Bind failed on port ' + IntToStr(Port));

    if listen(FServerSocket, SOMAXCONN) = SOCKET_ERROR then
      raise Exception.Create('Listen failed');

    if WSAAsyncSelect(FServerSocket, Handle, WM_SOCKET, FD_ACCEPT) = SOCKET_ERROR then
      raise Exception.Create('WSAAsyncSelect failed');

    FRunning := True;
    Button1.Enabled := False;
    Button2.Enabled := True;
    Timer1.Enabled := True;

    Label1.Caption := 'Running on port ' + IntToStr(Port);
    AddLog('JPEG Relay Server started on port ' + IntToStr(Port));

  except
    on E: Exception do
    begin
      AddLog('Start error: ' + E.Message);
      ShowMessage('Start error: ' + E.Message);
      if FServerSocket <> INVALID_SOCKET then
      begin
        closesocket(FServerSocket);
        FServerSocket := INVALID_SOCKET;
      end;
    end;
  end;
end;

procedure TRelayServerForm.StopServer;
var
  i: Integer;
  Peer: PPeerConnection;
  j: Integer;
begin
  if not FRunning then Exit;

  FRunning := False;
  Timer1.Enabled := False;

  for i := 0 to MAX_CONNECTIONS - 1 do
  begin
    if FConnections[i].Socket <> INVALID_SOCKET then
      DisconnectConnection(FConnections[i].Socket);
  end;

  FCriticalSection.Enter;
  try
    for j := 0 to FPeerConnections.Count - 1 do
    begin
      Peer := PPeerConnection(FPeerConnections[j]);
      Dispose(Peer);
    end;
    FPeerConnections.Clear;
    Label3.Caption := 'Peers: 0';
  finally
    FCriticalSection.Leave;
  end;

  if FServerSocket <> INVALID_SOCKET then
  begin
    closesocket(FServerSocket);
    FServerSocket := INVALID_SOCKET;
  end;

  Button1.Enabled := True;
  Button2.Enabled := False;
  Label1.Caption := 'Stopped';
  Label2.Caption := 'Connections: 0';
  AddLog('Relay Server stopped');
end;

procedure TRelayServerForm.AcceptConnection;
var
  ClientSocket: TSocket;
  ClientAddr: TSockAddrIn;
  AddrLen: Integer;
  Slot: Integer;
  Conn: PConnectionInfo;
  BufSize: Integer;
begin
  AddrLen := SizeOf(ClientAddr);
  ClientSocket := accept(FServerSocket, @ClientAddr, @AddrLen);

  if ClientSocket = INVALID_SOCKET then
  begin
    AddLog('Accept failed: ' + IntToStr(WSAGetLastError));
    Exit;
  end;

  BufSize := 1024 * 1024;
  setsockopt(ClientSocket, SOL_SOCKET, SO_RCVBUF, @BufSize, SizeOf(BufSize));
  setsockopt(ClientSocket, SOL_SOCKET, SO_SNDBUF, @BufSize, SizeOf(BufSize));

  Slot := FindFreeConnectionSlot;
  if Slot = -1 then
  begin
    AddLog('No free slots, rejecting connection');
    closesocket(ClientSocket);
    Exit;
  end;

  Conn := @FConnections[Slot];
  Conn^.Socket := ClientSocket;
  Conn^.ConnectionType := ctUnknown;
  FillChar(Conn^.PeerID, ID_LENGTH, 0);
  FillChar(Conn^.ConnectedTo, ID_LENGTH, 0);
  Conn^.RemoteIP := string(inet_ntoa(ClientAddr.sin_addr));
  Conn^.RemotePort := ntohs(ClientAddr.sin_port);
  Conn^.LastActive := Now;
  Conn^.PeerState := psDisconnected;
  Conn^.DataBuffer.Clear;
  Conn^.ExpectingHeader := True;
  Conn^.ImageDataReceived := 0;

  WSAAsyncSelect(ClientSocket, Self.Handle, WM_SOCKET, FD_READ or FD_CLOSE);

  UpdateConnectionsCount;

  AddLog('New connection from ' + Conn^.RemoteIP + ':' + IntToStr(Conn^.RemotePort) +
         ', socket: ' + IntToStr(ClientSocket));
end;


procedure TRelayServerForm.ProcessConnection(Socket: TSocket);
var
  Buffer: array[0..16383] of Byte;
  BytesReceived: Integer;
  DataStr: string;
  Lines: TStringList;
  i: Integer;
  Line: string;
  Conn: PConnectionInfo;
  DataStart: Integer;
  TargetSocket: TSocket;
  Peer: PPeerConnection;
  BytesSent: Integer;
begin
  Conn := FindConnectionBySocket(Socket);
  if Conn = nil then Exit;

  BytesReceived := recv(Socket, Buffer, SizeOf(Buffer), 0);

  if BytesReceived <= 0 then
  begin
    DisconnectConnection(Socket);
    Exit;
  end;

  Conn^.LastActive := Now;

  Conn^.CriticalSection.Enter;
  try
    if Conn^.PeerState = psConnected then
    begin
      TargetSocket := INVALID_SOCKET;

      if Conn^.ConnectionType = ctVncServer then
      begin
        Peer := FindPeerByID(StrPas(Conn^.PeerID));
        if (Peer <> nil) and (Peer^.State = psConnected) then
          TargetSocket := Peer^.ClientConnection;
      end
      else if Conn^.ConnectionType = ctVncClient then
      begin
        Peer := FindPeerByID(StrPas(Conn^.ConnectedTo));
        if (Peer <> nil) and (Peer^.State = psConnected) then
          TargetSocket := Peer^.ServerConnection;
      end;

      if TargetSocket <> INVALID_SOCKET then
      begin
        BytesSent := send(TargetSocket, Buffer, BytesReceived, 0);
        if BytesSent = SOCKET_ERROR then
        begin
          AddLog('Relay send error: ' + IntToStr(WSAGetLastError));
          DisconnectConnection(Socket);
          DisconnectConnection(TargetSocket);
        end
        else if BytesSent < BytesReceived then
        begin
          AddLog('Warning: Partial send: ' + IntToStr(BytesSent) + '/' + IntToStr(BytesReceived));
        end
        else
        begin
          AddLog(Format('Relayed %d bytes directly', [BytesSent]));
        end;
      end
      else
      begin
        AddLog('Error: No target socket for connected peer');
      end;
    end
    else
    begin
      Conn^.DataBuffer.Write(Buffer, BytesReceived);
      Conn^.DataBuffer.Position := 0;

      SetLength(DataStr, Conn^.DataBuffer.Size);
      Conn^.DataBuffer.Read(DataStr[1], Conn^.DataBuffer.Size);

      DataStart := Pos(#13#10, DataStr);

      if DataStart > 0 then
      begin
        Lines := TStringList.Create;
        try
          Lines.Text := Copy(DataStr, 1, DataStart + 1);

          for i := 0 to Lines.Count - 1 do
          begin
            Line := Trim(Lines[i]);
            if Line = '' then Continue;

            AddLog('Received: ' + Line);

            if Pos('REGISTER_SERVER', Line) = 1 then
            begin
              HandleRegistration(Socket, Line);
            end
            else if Pos('CONNECT_CLIENT', Line) = 1 then
            begin
              HandleConnectRequest(Socket, Line);
            end;
          end;
        finally
          Lines.Free;
        end;

        if DataStart + 2 <= Length(DataStr) then
        begin
          Conn^.DataBuffer.Clear;
          Conn^.DataBuffer.Write(DataStr[DataStart + 2], Length(DataStr) - DataStart - 1);
        end
        else
        begin
          Conn^.DataBuffer.Clear;
        end;
      end;
    end;
  finally
    Conn^.CriticalSection.Leave;
  end;
end;

procedure TRelayServerForm.HandleRegistration(Socket: TSocket; const Data: string);
var
  Conn: PConnectionInfo;
  ID: string;
  Peer: PPeerConnection;
  CmdParts: TStringList;
begin
  Conn := FindConnectionBySocket(Socket);
  if Conn = nil then Exit;

  CmdParts := TStringList.Create;
  try
    CmdParts.Delimiter := ' ';
    CmdParts.DelimitedText := Data;

    if CmdParts.Count >= 2 then
    begin
      ID := CmdParts[1];
    end
    else
    begin
      ID := GenerateID;
    end;

    if FindConnectionByID(ID) <> nil then
    begin
      AddLog('ID ' + ID + ' already registered, generating new one');
      ID := GenerateID;
    end;

    StrPCopy(Conn^.PeerID, ID);
    Conn^.ConnectionType := ctVncServer;

    Peer := CreatePeer(ID, Socket);

    SendResponse(Socket, 'REGISTERED ' + ID);

    AddLog('Server registered with ID: ' + ID);
  finally
    CmdParts.Free;
  end;
end;

procedure TRelayServerForm.HandleConnectRequest(Socket: TSocket; const Data: string);
var
  Conn: PConnectionInfo;
  TargetID: string;
  Peer: PPeerConnection;
  ServerConn: PConnectionInfo;
  CmdParts: TStringList;
begin
  Conn := FindConnectionBySocket(Socket);
  if Conn = nil then
  begin
    AddLog('HandleConnectRequest: Connection not found for socket ' + IntToStr(Socket));
    Exit;
  end;

  CmdParts := TStringList.Create;
  try
    CmdParts.Delimiter := ' ';
    CmdParts.DelimitedText := Data;

    if CmdParts.Count >= 2 then
    begin
      TargetID := CmdParts[1];
      AddLog('Looking for server with ID: ' + TargetID);

      Peer := FindPeerByID(TargetID);

      if (Peer <> nil) and (Peer^.State = psWaiting) then
      begin
        AddLog('Found waiting server: ' + TargetID);

        Peer^.ClientConnection := Socket;
        Peer^.State := psConnected;

        StrPCopy(Conn^.PeerID, 'CLIENT_' + TargetID);
        StrPCopy(Conn^.ConnectedTo, TargetID);
        Conn^.ConnectionType := ctVncClient;
        Conn^.PeerState := psConnected;

        ServerConn := FindConnectionBySocket(Peer^.ServerConnection);
        if ServerConn <> nil then
        begin
          StrPCopy(ServerConn^.ConnectedTo, 'CLIENT_' + TargetID);
          ServerConn^.PeerState := psConnected;

          ServerConn^.ExpectingHeader := True;
          ServerConn^.ImageDataReceived := 0;

          SendResponse(Peer^.ServerConnection, 'CLIENT_CONNECTED');
          AddLog('Sent CLIENT_CONNECTED to server');
        end
        else
        begin
          AddLog('Warning: Server connection not found');
        end;

        SendResponse(Socket, 'CONNECTED');
        AddLog('Sent CONNECTED to client');

        AddLog('Client connected to server ' + TargetID);
      end
      else if Peer = nil then
      begin
        SendResponse(Socket, 'ERROR Server not found: ' + TargetID);
        AddLog('Client requested connection to unknown ID: ' + TargetID);
      end
      else
      begin
        SendResponse(Socket, 'ERROR Server busy');
        AddLog('Server ' + TargetID + ' is busy');
      end;
    end
    else
    begin
      SendResponse(Socket, 'ERROR Invalid command format');
      AddLog('Invalid CONNECT_CLIENT command: ' + Data);
    end;
  finally
    CmdParts.Free;
  end;
end;

procedure TRelayServerForm.RelayData(SourceSocket: TSocket; const Data: array of Byte; DataSize: Integer);
begin
  RelayDataStr(SourceSocket, string(AnsiString(PAnsiChar(@Data[0]))));
end;

procedure TRelayServerForm.RelayDataStr(SourceSocket: TSocket; const Data: string);
var
  SourceConn, TargetConn: PConnectionInfo;
  TargetSocket: TSocket;
  BytesSent: Integer;
  Peer: PPeerConnection;
  DataToSend: AnsiString;
begin
  SourceConn := FindConnectionBySocket(SourceSocket);
  if SourceConn = nil then Exit;

  TargetSocket := INVALID_SOCKET;

  if SourceConn^.ConnectionType = ctVncServer then
  begin
    Peer := FindPeerByID(StrPas(SourceConn^.PeerID));
    if (Peer <> nil) and (Peer^.State = psConnected) then
      TargetSocket := Peer^.ClientConnection;
  end
  else if SourceConn^.ConnectionType = ctVncClient then
  begin
    Peer := FindPeerByID(StrPas(SourceConn^.ConnectedTo));
    if (Peer <> nil) and (Peer^.State = psConnected) then
      TargetSocket := Peer^.ServerConnection;
  end;

  if TargetSocket <> INVALID_SOCKET then
  begin
    DataToSend := AnsiString(Data);
    BytesSent := send(TargetSocket, DataToSend[1], Length(DataToSend), 0);
    if BytesSent = SOCKET_ERROR then
    begin
      AddLog('Relay error: ' + IntToStr(WSAGetLastError));
      DisconnectConnection(SourceSocket);
      DisconnectConnection(TargetSocket);
    end
    else
    begin
      AddLog(Format('Relayed %d bytes to target', [BytesSent]));
    end;
  end;
end;

procedure TRelayServerForm.DisconnectConnection(Socket: TSocket);
var
  Conn: PConnectionInfo;
  Peer: PPeerConnection;
begin
  Conn := FindConnectionBySocket(Socket);
  if Conn = nil then Exit;

  AddLog('Disconnecting: ' + StrPas(Conn^.PeerID) +
         ' (' + Conn^.RemoteIP + ':' + IntToStr(Conn^.RemotePort) + ')');

  if Conn^.ConnectionType = ctVncServer then
  begin
    Peer := FindPeerByID(StrPas(Conn^.PeerID));
    if Peer <> nil then
    begin
      if Peer^.ClientConnection <> INVALID_SOCKET then
        SendResponse(Peer^.ClientConnection, 'SERVER_DISCONNECTED');
      RemovePeer(Peer);
    end;
  end
  else if Conn^.ConnectionType = ctVncClient then
  begin
    Peer := FindPeerByID(StrPas(Conn^.ConnectedTo));
    if (Peer <> nil) and (Peer^.State = psConnected) then
    begin
      if Peer^.ServerConnection <> INVALID_SOCKET then
        SendResponse(Peer^.ServerConnection, 'CLIENT_DISCONNECTED');
      Peer^.ClientConnection := INVALID_SOCKET;
      Peer^.State := psWaiting;
      Peer^.Created := Now;
    end;
  end;

  WSAAsyncSelect(Socket, Handle, 0, 0);
  closesocket(Socket);

  Conn^.Socket := INVALID_SOCKET;
  Conn^.ConnectionType := ctUnknown;
  FillChar(Conn^.PeerID, ID_LENGTH, 0);
  FillChar(Conn^.ConnectedTo, ID_LENGTH, 0);
  Conn^.RemoteIP := '';
  Conn^.RemotePort := 0;
  Conn^.PeerState := psDisconnected;
  Conn^.DataBuffer.Clear;
  Conn^.ExpectingHeader := True;
  Conn^.ImageDataReceived := 0;

  UpdateConnectionsCount;
end;

procedure TRelayServerForm.UpdateConnectionsCount;
var
  i, Count: Integer;
begin
  Count := 0;
  for i := 0 to MAX_CONNECTIONS - 1 do
  begin
    if FConnections[i].Socket <> INVALID_SOCKET then
      Inc(Count);
  end;
  Label2.Caption := 'Connections: ' + IntToStr(Count);
end;

procedure TRelayServerForm.SendResponse(Socket: TSocket; const Response: string);
var
  FullResponse: AnsiString;
  BytesSent: Integer;
begin
  FullResponse := AnsiString(Response + #13#10);
  BytesSent := send(Socket, FullResponse[1], Length(FullResponse), 0);
  if BytesSent = SOCKET_ERROR then
  begin
    AddLog('Send error: ' + IntToStr(WSAGetLastError));
  end;
end;

procedure TRelayServerForm.AddLog(const Msg: string);
begin
  if Memo1.Lines.Count > 1000 then
    Memo1.Lines.Clear;

  Memo1.Lines.Add('[' + TimeToStr(Now) + '] ' + Msg);
  Memo1.SelStart := Length(Memo1.Text);
end;

procedure TRelayServerForm.WMSocket(var Message: TLMessage);
var
  Event: Word;
  Error: Integer;
  Socket: TSocket;
begin
  Event := LOWORD(Message.LParam);
  Error := HIWORD(Message.LParam);
  Socket := Message.WParam;

  try
    case Event of
      FD_ACCEPT:
        AcceptConnection;

      FD_READ:
        begin
          if Error = 0 then
          begin
            if Socket = FServerSocket then
            begin
              // Server socket - ignore
            end
            else
            begin
              ProcessConnection(Socket);
            end;
          end
          else
          begin
            AddLog('FD_READ error: ' + IntToStr(Error));
            DisconnectConnection(Socket);
          end;
        end;

      FD_CLOSE:
        begin
          AddLog('FD_CLOSE event for socket ' + IntToStr(Socket));
          DisconnectConnection(Socket);
        end;

      else
        AddLog('Unknown socket event: ' + IntToStr(Event));
    end;

  except
    on E: Exception do
    begin
      AddLog('Critical error in WMSocket: ' + E.Message);
      if Socket <> FServerSocket then
        DisconnectConnection(Socket);
    end;
  end;
end;

end.