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

[Admin]

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

Исходник серверной части:

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
  Windows, WinSock2, LMessages, StrUtils, ActiveX, gdiplus;

const
  EncoderQuality: TGUID = '{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}';
  EncoderParameterValueTypeLong = 4;

type
  TEncoderParameter = packed record
    Guid: TGUID;
    NumberOfValues: ULONG;
    Type_: ULONG;
    Value: Pointer;
  end;

  TEncoderParameters = packed record
    Count: UINT;
    Parameter: array[0..0] of TEncoderParameter;
  end;
  PEncoderParameters = ^TEncoderParameters;

const
  VNC_PORT = 5900;
  RELAY_PORT = 5500;
  MAX_CLIENTS = 5;
  WM_SOCKET = WM_USER + 1;
  ID_LENGTH = 9;

  // GDI+ статусы
  Ok = 0;
  GenericError = 1;
  InvalidParameter = 2;

// GDI+ типы и функции
type
  TGPStatus = Integer;

  GPBITMAP = Pointer;
  GPGRAPHICS = Pointer;
  GPENCODERPARAMETERS = Pointer;

  TGdiplusStartupInput = record
    GdiplusVersion: UINT32;
    DebugEventCallback: Pointer;
    SuppressBackgroundThread: BOOL;
    SuppressExternalCodecs: BOOL;
  end;

// Windows API
function GetSystemMetrics(nIndex: Integer): Integer; stdcall; external 'user32.dll';
function GetDC(hWnd: HWND): HDC; stdcall; external 'user32.dll';
function ReleaseDC(hWnd: HWND; hDC: HDC): Integer; stdcall; external 'user32.dll';
function CreateCompatibleDC(hdc: HDC): HDC; stdcall; external 'gdi32.dll';
function DeleteDC(hdc: HDC): BOOL; stdcall; external 'gdi32.dll';
function CreateDIBSection(hdc: HDC; const pbmi: BITMAPINFO; iUsage: UINT;
  var ppvBits: Pointer; hSection: THandle; dwOffset: DWORD): HBITMAP; stdcall; external 'gdi32.dll';
function SelectObject(hdc: HDC; hgdiobj: HGDIOBJ): HGDIOBJ; stdcall; external 'gdi32.dll';
function BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC;
  XSrc, YSrc: Integer; Rop: DWORD): BOOL; stdcall; external 'gdi32.dll';
function DeleteObject(hObject: HGDIOBJ): BOOL; stdcall; external 'gdi32.dll';
function SendInput(cInputs: UINT; pInputs: Pointer; cbSize: Integer): UINT; stdcall; external 'user32.dll';
function SetCursorPos(X, Y: Integer): BOOL; stdcall; external 'user32.dll';

// GDI+ функции
function GdiplusStartup(out token: ULONG; input: Pointer; output: Pointer): TGPStatus; stdcall; external 'gdiplus.dll';
procedure GdiplusShutdown(token: ULONG); stdcall; external 'gdiplus.dll';
function GdipCreateBitmapFromHBITMAP(hbm: HBITMAP; hpal: HPALETTE; out bitmap: GPBITMAP): TGPStatus; stdcall; external 'gdiplus.dll';
function GdipSaveImageToStream(image: GPBITMAP; stream: IStream; const clsidEncoder: TGUID;
  encoderParams: GPENCODERPARAMETERS): TGPStatus; stdcall; external 'gdiplus.dll';
function GdipDisposeImage(image: GPBITMAP): TGPStatus; stdcall; external 'gdiplus.dll';
function GdipGetImageEncodersSize(out numEncoders: UINT; out size: UINT): TGPStatus; stdcall; external 'gdiplus.dll';
function GdipGetImageEncoders(numEncoders: UINT; size: UINT; encoders: Pointer): TGPStatus; stdcall; external 'gdiplus.dll';

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

  TMouseMsg = packed record
    MsgType: Byte;
    Buttons: Byte;
    X: WORD;
    Y: WORD;
  end;

  TKeyMsg = packed record
    MsgType: Byte;
    IsDown: Byte;
    KeyCode: DWORD;
  end;

  TInputRec = record
    InputType: DWORD;
    case Integer of
      0: (mi: MOUSEINPUT);
      1: (ki: KEYBDINPUT);
  end;

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Memo1: TMemo;
    Timer1: TTimer;
    CheckBox1: TCheckBox;
    Edit2: TEdit;
    Button3: TButton;
    Label3: TLabel;
    Edit3: TEdit;
    Label4: TLabel;
    Label5: TLabel;
    Button4: TButton;
    Label7: TLabel;
    ComboBox1: TComboBox;
    Label8: TLabel;

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

  private
    FServerSocket: TSocket;
    FClients: array[0..MAX_CLIENTS-1] of TSocket;
    FClientCount: Integer;
    FRunning: Boolean;
    FWSAData: TWSADATA;
    FLastFrameSentTime: DWORD;


    // Screen capture
    FScreenDC: HDC;
    FMemoryDC: HDC;
    FBitmap: HBITMAP;
    FBitmapInfo: BITMAPINFO;
    FPixelData: Pointer;
    FScreenWidth: Integer;
    FScreenHeight: Integer;
    FScreenInitialized: Boolean;

    // JPEG encoding
    FGDIPlusToken: ULONG;
    FJPEGQuality: Integer;
    FJPEGEncoderClsid: TGUID;
    FGDIPlusInitialized: Boolean;

    // Relay support
    FRelaySocket: TSocket;
    FUseRelay: Boolean;
    FMyID: string;
    FRelayBuffer: TMemoryStream;
    FRelayIP: string;
    FRelayPort: Integer;
    FIsRegistered: Boolean;
    FRelayClientConnected: Boolean;

    // Private procedures
    procedure StartServer;
    procedure StopServer;
    procedure AcceptClient;
    procedure ProcessClient(Index: Integer);
    procedure DisconnectClient(Index: Integer);
    procedure InitScreen;
    procedure CleanupScreen;
    procedure CaptureScreen;
    procedure SendScreenToAll;
    procedure SendJPEGToClient(ClientSocket: TSocket);
    procedure HandleMouse(const Msg: TMouseMsg);
    procedure HandleKey(const Msg: TKeyMsg);
    procedure AddLog(const Msg: string);
    procedure FormShow(Sender: TObject);

    // JPEG encoding
    function GetEncoderClsid(const mimeType: WideString; out clsid: TGUID): Boolean;
    function EncodeScreenToJPEG(var JPEGData: TBytes): Boolean;
    procedure InitGDIplus;

    // Relay procedures
    procedure StartRelayRegistration;
    procedure StopRelayRegistration;
    procedure ConnectToRelay;
    procedure DisconnectFromRelay;
    procedure SendToRelay(const Data: string);
    procedure SendBinaryToRelay(const Data: TBytes);
    procedure ProcessRelayData;
    procedure RegisterWithRelay;
    function GenerateID: string;

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

  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

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

{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  try
    // Winsock - ПЕРВЫМ
    if WSAStartup(MAKEWORD(2, 2), FWSAData) <> 0 then
    begin
      Application.Terminate;
      Exit;
    end;

    // Инициализация переменных
    FServerSocket := INVALID_SOCKET;
    for i := 0 to MAX_CLIENTS-1 do
      FClients[i] := INVALID_SOCKET;
    FClientCount := 0;
    FRunning := False;
    FLastFrameSentTime := 0;

    FScreenDC := 0;
    FMemoryDC := 0;
    FBitmap := 0;
    FPixelData := nil;
    FScreenWidth := 0;
    FScreenHeight := 0;
    FScreenInitialized := False;

    FGDIPlusInitialized := False;
    FGDIPlusToken := 0;
    FJPEGQuality := 85;

    FUseRelay := False;
    FRelaySocket := INVALID_SOCKET;
    FMyID := '';
    FRelayBuffer := TMemoryStream.Create;
    FRelayIP := '10.30.28.28';    // Меняем на свой айпишник на котором висит релей
    FRelayPort := RELAY_PORT;
    FIsRegistered := False;
    FRelayClientConnected := False;

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

    InitGDIplus;

  except
    on E: Exception do
    begin
      Application.MessageBox(PChar('Initialization error: ' + E.Message), 'Error', MB_OK);
      Application.Terminate;
    end;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Timer1.Enabled := False;

  StopServer;

  CleanupScreen;

  DisconnectFromRelay;

  if Assigned(FRelayBuffer) then
    FreeAndNil(FRelayBuffer);

  if FGDIPlusInitialized and (FGDIPlusToken <> 0) then
  begin
    GdiplusShutdown(FGDIPlusToken);
    FGDIPlusInitialized := False;
    FGDIPlusToken := 0;
  end;

  // Winsock cleanup ПОСЛЕДНИМ
  WSACleanup;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  if Assigned(Memo1) then
    AddLog('Server ready (JPEG only)');
end;

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

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

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if FRunning and (FClientCount > 0) and FScreenInitialized then
    SendScreenToAll;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  FUseRelay := CheckBox1.Checked;
  Edit2.Enabled := FUseRelay;
  Button3.Enabled := FUseRelay;
  Button4.Enabled := FUseRelay;

  if FUseRelay then
    StartRelayRegistration
  else
    StopRelayRegistration;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  FMyID := GenerateID;
  Edit3.Text := FMyID;
  AddLog('Generated new ID: ' + FMyID);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  if FMyID = '' then
  begin
    ShowMessage('Please generate an ID first');
    Exit;
  end;

  if FRelaySocket = INVALID_SOCKET then
    ConnectToRelay
  else
    RegisterWithRelay;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  // Защита от вызова при инициализации
  if not Assigned(Self) then Exit;
  if not Assigned(ComboBox1) then Exit;
  if csLoading in ComponentState then Exit; // КРИТИЧНО!

  case ComboBox1.ItemIndex of
    0: FJPEGQuality := 50;
    1: FJPEGQuality := 75;
    2: FJPEGQuality := 85;
    3: FJPEGQuality := 95;
  else
    FJPEGQuality := 85;
  end;

  if Assigned(Memo1) then
    AddLog('JPEG quality set to ' + IntToStr(FJPEGQuality) + '%');
end;

function TForm1.GenerateID: string;
begin
  Result := RandomString(8);
end;

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

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

  try
    InitScreen;

    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');

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

    WSAAsyncSelect(FServerSocket, Handle, WM_SOCKET, FD_ACCEPT);

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

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

    // Если используем relay, регистрируемся
    if FUseRelay and (FMyID <> '') and (FRelaySocket <> INVALID_SOCKET) then
      RegisterWithRelay;

  except
    on E: Exception do
    begin
      AddLog('Start error: ' + E.Message);
      ShowMessage('Start error: ' + E.Message);
      CleanupScreen;
    end;
  end;
end;

procedure TForm1.StopServer;
var
  i: Integer;
begin
  if not FRunning then Exit;

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

  for i := 0 to MAX_CLIENTS-1 do
    if FClients[i] <> INVALID_SOCKET then
      DisconnectClient(i);

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

  CleanupScreen;

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

procedure TForm1.AcceptClient;
var
  ClientSocket: TSocket;
  i: Integer;
  Greeting: AnsiString;
begin
  ClientSocket := accept(FServerSocket, nil, nil);
  if ClientSocket = INVALID_SOCKET then Exit;

  for i := 0 to MAX_CLIENTS-1 do
  begin
    if FClients[i] = INVALID_SOCKET then
    begin
      FClients[i] := ClientSocket;
      WSAAsyncSelect(ClientSocket, Handle, WM_SOCKET, FD_READ or FD_CLOSE);

      Greeting := 'VNC JPEG Ready'#13#10;
      send(ClientSocket, Greeting[1], Length(Greeting), 0);

      Inc(FClientCount);
      Label2.Caption := 'Clients: ' + IntToStr(FClientCount);
      AddLog('Client connected directly');

      Exit;
    end;
  end;

  closesocket(ClientSocket);
  AddLog('Client rejected - no slots');
end;

procedure TForm1.ProcessClient(Index: Integer);
var
  Buffer: array[0..255] of Byte;
  BytesReceived: Integer;
  MouseMsg: TMouseMsg;
  KeyMsg: TKeyMsg;
begin
  if FClients[Index] = INVALID_SOCKET then Exit;

  BytesReceived := recv(FClients[Index], Buffer, SizeOf(Buffer), 0);
  if BytesReceived <= 0 then
  begin
    DisconnectClient(Index);
    Exit;
  end;

  case Buffer[0] of
    1: // Update request
      begin
        AddLog(Format('Client #%d requests update', [Index]));
        SendJPEGToClient(FClients[Index]);
      end;
    2: // Mouse event
      begin
        if BytesReceived >= SizeOf(TMouseMsg) then
        begin
          Move(Buffer, MouseMsg, SizeOf(TMouseMsg));
          HandleMouse(MouseMsg);
        end;
      end;
    3: // Key event
      begin
        if BytesReceived >= SizeOf(TKeyMsg) then
        begin
          Move(Buffer, KeyMsg, SizeOf(TKeyMsg));
          HandleKey(KeyMsg);
        end;
      end;
  end;
end;

procedure TForm1.DisconnectClient(Index: Integer);
begin
  if FClients[Index] = INVALID_SOCKET then Exit;

  closesocket(FClients[Index]);
  FClients[Index] := INVALID_SOCKET;
  Dec(FClientCount);
  Label2.Caption := 'Clients: ' + IntToStr(FClientCount);
  AddLog('Client disconnected');
end;

procedure TForm1.InitScreen;
begin
  FScreenWidth := GetSystemMetrics(0); // SM_CXSCREEN
  FScreenHeight := GetSystemMetrics(1); // SM_CYSCREEN

  if (FScreenWidth <= 0) or (FScreenHeight <= 0) then
  begin
    FScreenWidth := 1024;
    FScreenHeight := 768;
  end;

  FScreenDC := GetDC(0);
  if FScreenDC = 0 then
  begin
    AddLog('Failed to get screen DC');
    Exit;
  end;

  FMemoryDC := CreateCompatibleDC(FScreenDC);
  if FMemoryDC = 0 then
  begin
    AddLog('Failed to create compatible DC');
    ReleaseDC(0, FScreenDC);
    FScreenDC := 0;
    Exit;
  end;

  FillChar(FBitmapInfo, SizeOf(FBitmapInfo), 0);
  FBitmapInfo.bmiHeader.biSize := SizeOf(BITMAPINFOHEADER);
  FBitmapInfo.bmiHeader.biWidth := FScreenWidth;
  FBitmapInfo.bmiHeader.biHeight := -FScreenHeight;
  FBitmapInfo.bmiHeader.biPlanes := 1;
  FBitmapInfo.bmiHeader.biBitCount := 24;
  FBitmapInfo.bmiHeader.biCompression := 0; // BI_RGB

  FBitmap := CreateDIBSection(FMemoryDC, FBitmapInfo, 0, FPixelData, 0, 0);
  if (FBitmap = 0) or (FPixelData = nil) then
  begin
    AddLog('Failed to create DIB section');
    DeleteDC(FMemoryDC);
    ReleaseDC(0, FScreenDC);
    FMemoryDC := 0;
    FScreenDC := 0;
    Exit;
  end;

  SelectObject(FMemoryDC, FBitmap);
  FScreenInitialized := True;

  AddLog(Format('Screen init: %dx%d', [FScreenWidth, FScreenHeight]));
end;

procedure TForm1.CleanupScreen;
begin
  if FBitmap <> 0 then
  begin
    DeleteObject(FBitmap);
    FBitmap := 0;
  end;
  if FMemoryDC <> 0 then
  begin
    DeleteDC(FMemoryDC);
    FMemoryDC := 0;
  end;
  if FScreenDC <> 0 then
  begin
    ReleaseDC(0, FScreenDC);
    FScreenDC := 0;
  end;
  FPixelData := nil;
  FScreenInitialized := False;
end;

procedure TForm1.CaptureScreen;
begin
  if not FScreenInitialized then Exit;
  BitBlt(FMemoryDC, 0, 0, FScreenWidth, FScreenHeight, FScreenDC, 0, 0, SRCCOPY);
end;

function TForm1.GetEncoderClsid(const mimeType: WideString; out clsid: TGUID): Boolean;
type
  TImageCodecInfo = record
    Clsid: TGUID;
    FormatID: TGUID;
    CodecName: PWideChar;
    DllName: PWideChar;
    FormatDescription: PWideChar;
    FilenameExtension: PWideChar;
    MimeType: PWideChar;
    Flags: DWORD;
    Version: DWORD;
    SigCount: DWORD;
    SigSize: DWORD;
    SigPattern: PByte;
    SigMask: PByte;
  end;
  PImageCodecInfo = ^TImageCodecInfo;
var
  numEncoders, size: UINT;
  encoders: PImageCodecInfo;
  i: Integer;
begin
  Result := False;

  if not FGDIPlusInitialized then
    Exit;

  if GdipGetImageEncodersSize(numEncoders, size) <> Ok then
    Exit;

  if size = 0 then
    Exit;

  GetMem(encoders, size);
  try
    if GdipGetImageEncoders(numEncoders, size, encoders) <> Ok then
      Exit;

    for i := 0 to numEncoders - 1 do
    begin
      if WideString(encoders[i].MimeType) = mimeType then
      begin
        clsid := encoders[i].Clsid;
        Result := True;
        Exit;
      end;
    end;
  finally
    FreeMem(encoders);
  end;
end;

function TForm1.EncodeScreenToJPEG(var JPEGData: TBytes): Boolean;
var
  Bitmap: GPBITMAP;
  Stream: IStream;
  Status: TGPStatus;
  hMem: HGLOBAL;
  DataSize: SIZE_T;
  pMem: Pointer;

  EncoderParameters: TEncoderParameters;
  Quality: ULONG;
const
  EncoderQuality: TGUID = '{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}';
begin
  Result := False;
  Stream := nil;
  Bitmap := nil;

  if not (FGDIPlusInitialized and FScreenInitialized) then Exit;

  CaptureScreen;

  // HBITMAP -> GDI+ Bitmap
  Status := GdipCreateBitmapFromHBITMAP(FBitmap, 0, Bitmap);
  if Status <> Ok then Exit;

  try
    hMem := GlobalAlloc(GMEM_MOVEABLE, 0);
    if CreateStreamOnHGlobal(hMem, True, Stream) <> S_OK then
    begin
      GlobalFree(hMem);
      Exit;
    end;

    // Настройка качества
    Quality := FJPEGQuality;
    EncoderParameters.Count := 1;
    EncoderParameters.Parameter[0].Guid := EncoderQuality;
    EncoderParameters.Parameter[0].Type_ := 4; // ValueTypeLong
    EncoderParameters.Parameter[0].NumberOfValues := 1;
    EncoderParameters.Parameter[0].Value := @Quality;

    // Кодирование
    Status := GdipSaveImageToStream(Bitmap, Stream, FJPEGEncoderClsid, @EncoderParameters);

    if Status = Ok then
    begin
      DataSize := GlobalSize(hMem);
      if DataSize > 0 then
      begin
        SetLength(JPEGData, DataSize);
        pMem := GlobalLock(hMem);
        Move(pMem^, JPEGData[0], DataSize);
        GlobalUnlock(hMem);
        Result := True;
      end;
    end;

  finally
    GdipDisposeImage(Bitmap);
  end;
end;

procedure TForm1.SendScreenToAll;
var
  JPEGData: TBytes;
  Header: TScreenHeader;
  Data: TBytes;
  i: Integer;
  CurrentTime: DWORD;
  BytesSent: Integer;
const
  MIN_FRAME_INTERVAL = 50; //минимум 50мс между кадрами (20 FPS max)
begin
  if (FClientCount = 0) and (not (FUseRelay and FIsRegistered and FRelayClientConnected)) then Exit;

  CurrentTime := GetTickCount;
  if (CurrentTime - FLastFrameSentTime) < MIN_FRAME_INTERVAL then
  begin
    Exit;
  end;
  FLastFrameSentTime := CurrentTime;

  try
    if not EncodeScreenToJPEG(JPEGData) then
    begin
      AddLog('Failed to encode JPEG');
      Exit;
    end;

    if Length(JPEGData) = 0 then
    begin
      AddLog('JPEG data is empty');
      Exit;
    end;

    Header.Width := FScreenWidth;
    Header.Height := FScreenHeight;
    Header.DataSize := Length(JPEGData);
    Header.ImageFormat := 1;

    SetLength(Data, SizeOf(Header) + Length(JPEGData));
    Move(Header, Data[0], SizeOf(Header));
    Move(JPEGData[0], Data[SizeOf(Header)], Length(JPEGData));

    if FUseRelay and FIsRegistered and (FRelaySocket <> INVALID_SOCKET) and FRelayClientConnected then
    begin
      BytesSent := send(FRelaySocket, Data[0], Length(Data), 0);
      if BytesSent = SOCKET_ERROR then
      begin
        AddLog('Relay send error: ' + IntToStr(WSAGetLastError));
      end
      else if BytesSent < Length(Data) then
      begin
        AddLog('Warning: Partial send to relay: ' + IntToStr(BytesSent) + '/' + IntToStr(Length(Data)));
      end;
    end;

    for i := 0 to MAX_CLIENTS-1 do
    begin
      if FClients[i] <> INVALID_SOCKET then
      begin
        if send(FClients[i], Data[0], Length(Data), 0) = SOCKET_ERROR then
          AddLog('Error sending to client #' + IntToStr(i));
      end;
    end;

  except
    on E: Exception do
      AddLog('Error in SendScreenToAll: ' + E.Message);
  end;
end;

procedure TForm1.SendJPEGToClient(ClientSocket: TSocket);
var
  JPEGData: TBytes;
  Header: TScreenHeader;
  Data: TBytes;
begin
  if not FScreenInitialized then
  begin
    AddLog('Screen not initialized');
    Exit;
  end;

  if not EncodeScreenToJPEG(JPEGData) then
    Exit;

  if Length(JPEGData) = 0 then
    Exit;

  Header.Width := FScreenWidth;
  Header.Height := FScreenHeight;
  Header.DataSize := Length(JPEGData);
  Header.ImageFormat := 1; // JPEG

  SetLength(Data, SizeOf(Header) + Length(JPEGData));
  Move(Header, Data[0], SizeOf(Header));
  Move(JPEGData[0], Data[SizeOf(Header)], Length(JPEGData));

  if send(ClientSocket, Data[0], Length(Data), 0) <> Length(Data) then
    AddLog('Error sending JPEG to client');
end;

procedure TForm1.HandleMouse(const Msg: TMouseMsg);
var
  Input: TInputRec;
begin
  SetCursorPos(Msg.X, Msg.Y);

  FillChar(Input, SizeOf(Input), 0);
  Input.InputType := 0;

  if (Msg.Buttons and 1) <> 0 then
    Input.mi.dwFlags := MOUSEEVENTF_LEFTDOWN
  else if (Msg.Buttons and 2) <> 0 then
    Input.mi.dwFlags := MOUSEEVENTF_RIGHTDOWN
  else if (Msg.Buttons and 4) <> 0 then
    Input.mi.dwFlags := MOUSEEVENTF_MIDDLEDOWN
  else
    Input.mi.dwFlags := MOUSEEVENTF_LEFTUP;

  SendInput(1, @Input, SizeOf(Input));
end;

procedure TForm1.HandleKey(const Msg: TKeyMsg);
var
  Input: TInputRec;
begin
  FillChar(Input, SizeOf(Input), 0);
  Input.InputType := 1;
  Input.ki.wVk := Msg.KeyCode;

  if Msg.IsDown = 0 then
    Input.ki.dwFlags := KEYEVENTF_KEYUP;

  SendInput(1, @Input, SizeOf(Input));
end;

procedure TForm1.AddLog(const Msg: string);
begin
  if not Assigned(Self) then Exit;
  if not Assigned(Memo1) then Exit;

  try
    Memo1.Lines.BeginUpdate;
    try
      Memo1.Lines.Add('[' + TimeToStr(Now) + '] ' + Msg);
      while Memo1.Lines.Count > 100 do
        Memo1.Lines.Delete(0);
    finally
      Memo1.Lines.EndUpdate;
    end;
  except
  end;
end;

procedure TForm1.StartRelayRegistration;
begin
  if FUseRelay then
  begin
    FRelayIP := Copy(Edit2.Text, 1, Pos(':', Edit2.Text) - 1);
    if FRelayIP = '' then FRelayIP := '10.30.28.28';
    FRelayPort := StrToIntDef(Copy(Edit2.Text, Pos(':', Edit2.Text) + 1, Length(Edit2.Text)), RELAY_PORT);

    ConnectToRelay;
  end;
end;

procedure TForm1.StopRelayRegistration;
begin
  DisconnectFromRelay;
end;

procedure TForm1.ConnectToRelay;
var
  RelayAddr: TSockAddrIn;
begin
  if FRelaySocket <> INVALID_SOCKET then Exit;

  try
    FRelaySocket := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
    if FRelaySocket = INVALID_SOCKET then
      raise Exception.Create('Failed to create relay socket');

    FillChar(RelayAddr, SizeOf(RelayAddr), 0);
    RelayAddr.sin_family := AF_INET;
    RelayAddr.sin_addr.s_addr := inet_addr(PAnsiChar(AnsiString(FRelayIP)));
    RelayAddr.sin_port := htons(FRelayPort);

    if connect(FRelaySocket, @RelayAddr, SizeOf(RelayAddr)) = SOCKET_ERROR then
    begin
      closesocket(FRelaySocket);
      FRelaySocket := INVALID_SOCKET;
      raise Exception.Create('Failed to connect to relay server');
    end;

    WSAAsyncSelect(FRelaySocket, Handle, WM_SOCKET, FD_READ or FD_CLOSE);

    AddLog('Connected to relay server: ' + FRelayIP + ':' + IntToStr(FRelayPort));
    Label5.Caption := 'Status: Connected to relay';

  except
    on E: Exception do
    begin
      AddLog('Relay connection error: ' + E.Message);
      Label5.Caption := 'Status: Connection failed';
      FUseRelay := False;
      CheckBox1.Checked := False;
    end;
  end;
end;

procedure TForm1.DisconnectFromRelay;
begin
  if FRelaySocket <> INVALID_SOCKET then
  begin
    if FIsRegistered then
      SendToRelay('UNREGISTER ' + FMyID);

    closesocket(FRelaySocket);
    FRelaySocket := INVALID_SOCKET;
  end;

  FIsRegistered := False;
  FRelayClientConnected := False;
  FMyID := '';
  Edit3.Text := '';
  Label5.Caption := 'Status: Disconnected';
  Label7.Caption := 'Status: Not registered';
end;

procedure TForm1.SendToRelay(const Data: string);
var
  FullData: AnsiString;
begin
  if FRelaySocket <> INVALID_SOCKET then
  begin
    FullData := AnsiString(Data) + #13#10;
    send(FRelaySocket, FullData[1], Length(FullData), 0);
    AddLog('>> Relay: ' + Data);
  end;
end;

procedure TForm1.SendBinaryToRelay(const Data: TBytes);
begin
  if FRelaySocket <> INVALID_SOCKET then
  begin
    send(FRelaySocket, Data[0], Length(Data), 0);
  end;
end;

procedure TForm1.ProcessRelayData;
var
  Buffer: array[0..16383] of Byte;
  BytesReceived: Integer;
  DataStr: string;
  Lines: TStringList;
  i: Integer;
  Line: string;
  MouseMsg: TMouseMsg;
  KeyMsg: TKeyMsg;
  RequestCount: Integer;
  MouseCount: Integer;
const
  MAX_REQUESTS_IN_BUFFER = 3;
  MAX_MOUSE_IN_BUFFER = 5;
begin
  if FRelaySocket = INVALID_SOCKET then Exit;

  BytesReceived := recv(FRelaySocket, Buffer, SizeOf(Buffer), 0);
  if BytesReceived <= 0 then
  begin
    AddLog('Relay server disconnected');
    DisconnectFromRelay;
    Exit;
  end;

  if not Assigned(FRelayBuffer) then
    FRelayBuffer := TMemoryStream.Create;

  FRelayBuffer.Write(Buffer, BytesReceived);

  if FRelayClientConnected then
  begin
    FRelayBuffer.Position := 0;
    RequestCount := 0;
    MouseCount := 0;

    while FRelayBuffer.Position < FRelayBuffer.Size do
    begin
      if FRelayBuffer.Size - FRelayBuffer.Position < 1 then Break;

      FRelayBuffer.Read(Buffer[0], 1);
      FRelayBuffer.Position := FRelayBuffer.Position - 1;

      case Buffer[0] of
        1:
          begin
            FRelayBuffer.Position := FRelayBuffer.Position + 1;
            Inc(RequestCount);

            if RequestCount <= MAX_REQUESTS_IN_BUFFER then
            begin
              SendScreenToAll;
            end
            else
            begin
              AddLog('Skipping excess update request');
            end;
          end;
        2:
          begin
            if FRelayBuffer.Size - FRelayBuffer.Position >= SizeOf(TMouseMsg) then
            begin
              FRelayBuffer.Read(MouseMsg, SizeOf(TMouseMsg));
              Inc(MouseCount);

              if MouseCount <= MAX_MOUSE_IN_BUFFER then
              begin
                HandleMouse(MouseMsg);
              end
              else
              begin
              end;
            end
            else Break;
          end;
        3:
          begin
            if FRelayBuffer.Size - FRelayBuffer.Position >= SizeOf(TKeyMsg) then
            begin
              FRelayBuffer.Read(KeyMsg, SizeOf(TKeyMsg));
              HandleKey(KeyMsg);
            end
            else Break;
          end;
        else
          FRelayBuffer.Position := FRelayBuffer.Position + 1;
      end;
    end;


    if FRelayBuffer.Position >= FRelayBuffer.Size then
      FRelayBuffer.Clear
    else if FRelayBuffer.Position > 0 then
    begin
      BytesReceived := FRelayBuffer.Size - FRelayBuffer.Position;
      Move(PByte(FRelayBuffer.Memory)[FRelayBuffer.Position],
           PByte(FRelayBuffer.Memory)[0], BytesReceived);
      FRelayBuffer.SetSize(BytesReceived);
    end;
  end
  else
  begin
    FRelayBuffer.Position := 0;
    SetLength(DataStr, FRelayBuffer.Size);
    if FRelayBuffer.Size > 0 then
      Move(FRelayBuffer.Memory^, DataStr[1], FRelayBuffer.Size);

    if Pos(#13#10, DataStr) > 0 then
    begin
      Lines := TStringList.Create;
      try
        Lines.Text := DataStr;
        for i := 0 to Lines.Count - 1 do
        begin
          Line := Trim(Lines[i]);
          if Line = '' then Continue;

          AddLog('<< Relay: ' + Line);

          if Pos('REGISTERED', Line) = 1 then
          begin
            FIsRegistered := True;
            Label7.Caption := 'Status: Registered as ' + FMyID;
            AddLog('Registered with relay as: ' + FMyID);
          end
          else if Pos('CLIENT_CONNECTED', Line) = 1 then
          begin
            FRelayClientConnected := True;
            Label7.Caption := 'Status: Client connected via relay';
            AddLog('Client connected via relay');
            Timer1.Enabled := True;
          end
          else if Pos('CLIENT_DISCONNECTED', Line) = 1 then
          begin
            FRelayClientConnected := False;
            Label7.Caption := 'Status: Waiting for client';
            AddLog('Client disconnected via relay');
            Timer1.Enabled := False;
          end;
        end;
      finally
        Lines.Free;
      end;
      FRelayBuffer.Clear;
    end;
  end;
end;

procedure TForm1.RegisterWithRelay;
begin
  if FMyID = '' then
  begin
    FMyID := GenerateID;
    Edit3.Text := FMyID;
  end;

  if FRelaySocket = INVALID_SOCKET then
  begin
    ConnectToRelay;
    Exit;
  end;

  SendToRelay('REGISTER_SERVER ' + FMyID);
  Label5.Caption := 'Status: Registering...';
  AddLog('Registering with relay as: ' + FMyID);
end;

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

  if Socket = FRelaySocket then
  begin
    case Event of
      FD_READ:
        ProcessRelayData;
      FD_CLOSE:
        begin
          AddLog('Relay connection closed');
          DisconnectFromRelay;
        end;
    end;
    Exit;
  end;

  case Event of
    FD_ACCEPT:
      AcceptClient;
    FD_READ:
      begin
        for i := 0 to MAX_CLIENTS-1 do
          if FClients[i] = Socket then
          begin
            ProcessClient(i);
            Break;
          end;
      end;
    FD_CLOSE:
      begin
        for i := 0 to MAX_CLIENTS-1 do
          if FClients[i] = Socket then
          begin
            DisconnectClient(i);
            Break;
          end;
      end;
  end;
end;

procedure TForm1.InitGDIplus;
var
  Input: TGdiplusStartupInput;
  Status: TGPStatus;
begin
  if FGDIPlusInitialized then Exit;

  FillChar(Input, SizeOf(Input), 0);
  Input.GdiplusVersion := 1;
  Input.DebugEventCallback := nil;
  Input.SuppressBackgroundThread := False;
  Input.SuppressExternalCodecs := False;

  Status := GdiplusStartup(FGDIPlusToken, @Input, nil);
  if Status = Ok then
  begin
    FGDIPlusInitialized := True;
    if not GetEncoderClsid('image/jpeg', FJPEGEncoderClsid) then
    begin
      GdiplusShutdown(FGDIPlusToken);
      FGDIPlusInitialized := False;
      FGDIPlusToken := 0;
    end;
  end
  else
  begin
    FGDIPlusInitialized := False;
    FGDIPlusToken := 0;
  end;
end;

end.