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

[rand]

Написал: rand

Всем привет. Предыдущий VNC работал только в Direct режиме по прямому соединению. Так как очень много узлов работает за NAT мне захотелось реализовать протокол по схеме: Client<--->Relay Server<--->Server

Запускаем Relay Server на белом IP и можем работать с VNC за натом.

В моей реализации еще куча багов. Буду её дорабатывать по возможности, но основная идея работает, также реализовано JPEG сжатие через GDI+. Если кто-то захочет собрать проект обязательно в инспекторе Lazarus 4.0 подключаем либу "lazgdi".

Скриншот клиентской части:

Скриншот релейного сервера:

Скриншот серверной части:

Исходник клиента:

unit Unit1;

{$mode objfpc}{$H+}

interface

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

// Объявление внешней функции ioctlsocket
function ioctlsocket(s: TSocket; cmd: Longint; argp: Pointer): Integer; stdcall; external 'ws2_32.dll';

const
  VNC_PORT = 5900;
  RELAY_PORT = 5500;
  WM_SOCKET = WM_USER + 1;
  FIONREAD = $4004667F;
  ID_LENGTH = 9;

  // Добавьте эти типы GDI+ здесь:
  type
    TGPStatus = (
      Ok,
      GenericError,
      InvalidParameter,
      OutOfMemory,
      ObjectBusy,
      InsufficientBuffer,
      NotImplemented,
      Win32Error,
      WrongState,
      Aborted,
      FileNotFound,
      ValueOverflow,
      AccessDenied,
      UnknownImageFormat,
      FontFamilyNotFound,
      FontStyleNotFound,
      NotTrueTypeFont,
      UnsupportedGdiplusVersion,
      GdiplusNotInitialized,
      PropertyNotFound,
      PropertyNotSupported
    );

    TStatus = TGPStatus;

    GPBITMAP = Pointer;
    GPGRAPHICS = Pointer;

    TGPRectF = record
      X: Single;
      Y: Single;
      Width: Single;
      Height: Single;
    end;

  // Объявления функций GDI+
  function GdiplusStartup(out token: ULONG; input: Pointer; output: Pointer): TGPStatus; stdcall; external 'gdiplus.dll';
  procedure GdiplusShutdown(token: ULONG); stdcall; external 'gdiplus.dll';
  function GdipCreateBitmapFromStream(stream: IStream; out bitmap: GPBITMAP): TGPStatus; stdcall; external 'gdiplus.dll';
  function GdipGetImageWidth(image: GPBITMAP; out width: UINT): TGPStatus; stdcall; external 'gdiplus.dll';
  function GdipGetImageHeight(image: GPBITMAP; out height: UINT): TGPStatus; stdcall; external 'gdiplus.dll';
  function GdipCreateFromHDC(hdc: HDC; out graphics: GPGRAPHICS): TGPStatus; stdcall; external 'gdiplus.dll';
  function GdipGraphicsClear(graphics: GPGRAPHICS; color: DWORD): TGPStatus; stdcall; external 'gdiplus.dll';
  function GdipDrawImageRect(graphics: GPGRAPHICS; image: GPBITMAP; x, y, width, height: Single): TGPStatus; stdcall; external 'gdiplus.dll';
  procedure GdipDeleteGraphics(graphics: GPGRAPHICS); stdcall; external 'gdiplus.dll';
  procedure GdipDisposeImage(image: GPBITMAP); stdcall; external 'gdiplus.dll';

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

type
  TConnectionMode = (cmDirect, cmRelay);

  TImageFormat = (ifRAW, ifJPEG, ifPNG);

  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;

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Memo1: TMemo;
    Panel1: TPanel;
    ScrollBox1: TScrollBox;
    PaintBox1: TPaintBox;
    Timer1: TTimer;
    RadioGroup1: TRadioGroup;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;

    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure Timer1Timer(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);


  private
    FSocket: TSocket;
    FRelaySocket: TSocket;
    FConnected: Boolean;
    FWSAData: TWSADATA;
    FScreenBitmap: Graphics.TBitmap;
    FScreenWidth: Integer;
    FScreenHeight: Integer;
    FLogFile: TextFile;
    FLogOpened: Boolean;
    FFullScreenForm: TForm;
    FConnectionMode: TConnectionMode;
    FJPEGAccumulator: TMemoryStream;
    FRemoteWidth: Integer;
    FRemoteHeight: Integer;
    FLastUpdateTime: DWORD;

    // Buffering
    FReceiveBuffer: PByte;
    FReceiveBufferSize: Integer;
    FReceiveBufferUsed: Integer;
    FExpectingHeader: Boolean;
    FCurrentHeader: TScreenHeader;
    FImageDataReceived: Integer;

    FFullScreenMode: Boolean;
    FOriginalBorderStyle: TBorderStyle;
    FOriginalWindowState: TWindowState;

    // Relay variables
    FTargetID: string;
    FRelayIP: string;
    FRelayPort: Integer;
    FRelayBuffer: TMemoryStream;
    FRelayState: (rsDisconnected, rsConnected, rsWaiting, rsReady);
    FThroughRelay: Boolean;

    // GDI+ variables
    FGDIPlusToken: ULONG;
    FIsMouseDown: Boolean; // Предполагается, что эта переменная уже есть для отслеживания нажатия
    // Переменные для Mouse Throttling:
    FMouseTimer: TTimer;
    FNewMouseX: Integer;
    FNewMouseY: Integer;
    FMouseCoordsReady: Boolean;

    // Private procedures
    procedure SafeLog(const Msg: string);
    procedure ConnectToServer;
    procedure ConnectViaRelay;
    procedure DisconnectFromServer;
    procedure ProcessServerData;
    procedure ProcessRelayData;
    procedure RequestUpdate;
    procedure MouseTimerTick(Sender: TObject);
    procedure SendMouseCoords(X, Y: Integer; ButtonMask: Byte = 0);
    procedure SendMouseEvent(X, Y: Integer; Buttons: Byte);
    procedure SendKeyEvent(KeyCode: DWORD; IsDown: Boolean);
    procedure UpdateDisplay;
    procedure SetStatus(const Msg: string);
    procedure UpdateBitmapRegion(DataOffset: Integer; DataSize: Integer);
    procedure UpdateConnectionUI;
    procedure UpdateBitmapFromRelay(const Data: TBytes; StartIndex, DataSize: Integer);


    // JPEG decoding procedures
    procedure DecodeJPEGData(const JPEGData: PByte; DataSize: Integer);
    procedure ProcessJPEGFrame(const JPEGData: PByte; DataSize: Integer);

    // Relay procedures
    procedure ConnectToRelayServer;
    procedure DisconnectFromRelay;
    procedure SendToRelay(const Data: string);
    procedure SendBinaryToRelay(const Data: TBytes);
    procedure HandleRelayResponse(const Response: string);
    procedure ProcessRelayBinaryData;
    procedure ParseRelayAddress;

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

  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

function MinDouble(a, b: Double): Double;
begin
  if a < b then Result := a else Result := b;
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
var
  LogFileName: string;
  Input: TGdiplusStartupInput;
  Status: TStatus;
begin
  // Инициализирую GDI+
  Input.DebugEventCallback := nil;
  Input.SuppressBackgroundThread := False;
  Input.SuppressExternalCodecs := False;
  Input.GdiplusVersion := 1;
  if GdiplusStartup(FGDIPlusToken, @Input, nil) <> Ok then
    SafeLog('Warning: GDI+ initialization failed');

  FNewMouseX := -1;
  FNewMouseY := -1;
  FMouseCoordsReady := False;
  //FMouseTimer := TTimer.Create(Self);
  //FMouseTimer.Interval := 50;
  //FMouseTimer.OnTimer := @MouseTimerTick;
  //FMouseTimer.Enabled := True;
  FRemoteWidth := 640;
  FRemoteHeight := 480;
  FLastUpdateTime := 0;

  // Инициализирую лог файл
  FLogOpened := False;
  try
    LogFileName := ExtractFilePath(Application.ExeName) + 'vnc_client_relay.log';
    AssignFile(FLogFile, LogFileName);
    Rewrite(FLogFile);
    FLogOpened := True;
    SafeLog('=== VNC Client with JPEG Support Started ===');
  except
    FLogOpened := False;
    SafeLog('Ошибка открытия лог-файла.');
  end;
  FJPEGAccumulator := TMemoryStream.Create;

  try
    SafeLog('Начинаем инициализацию FormCreate');

    Caption := 'VNC Client (JPEG Support)';
    Button1.Caption := 'Connect';
    Button2.Caption := 'Disconnect';
    Button3.Caption := 'Fullscreen';
    Button2.Enabled := False;
    Button3.Enabled := False;
    Timer1.Enabled := False;

    Label1.Caption := 'Server IP:';
    Label2.Caption := 'Port:';
    Label4.Caption := 'Server ID:';
    Label5.Caption := 'Mode:';
    Label6.Caption := 'Relay Status:';
    Label7.Caption := 'Disconnected';
    Label7.Font.Color := clRed;
    Label8.Caption := 'Connection: Direct';

    Edit1.Text := '127.0.0.1';
    Edit2.Text := IntToStr(VNC_PORT);
    Edit3.Text := '';

    RadioGroup1.ItemIndex := 0;
    RadioGroup1.OnClick := @RadioGroup1Click;

    FSocket := INVALID_SOCKET;
    FRelaySocket := INVALID_SOCKET;
    FConnected := False;
    FScreenWidth := 640;
    FScreenHeight := 480;

    FFullScreenMode := False;
    FOriginalBorderStyle := Self.BorderStyle;
    FOriginalWindowState := Self.WindowState;

    // Инициализация буферизации
    FReceiveBufferSize := 65536;
    GetMem(FReceiveBuffer, FReceiveBufferSize);
    FReceiveBufferUsed := 0;
    FExpectingHeader := True;
    FImageDataReceived := 0;
    FRelayBuffer := TMemoryStream.Create;


    // Relay initialization
    FConnectionMode := cmDirect;
    FTargetID := '';
    FRelayIP := '127.0.0.1';
    FRelayPort := RELAY_PORT;
    FRelayBuffer := TMemoryStream.Create;
    FRelayState := rsDisconnected;
    FThroughRelay := False;

    SafeLog('Создаем bitmap');

    // Инициализация Bitmap
    FScreenBitmap := nil;
    try
      FScreenBitmap := Graphics.TBitmap.Create;
      FScreenBitmap.PixelFormat := pf24bit;
      FScreenBitmap.Width := FScreenWidth;
      FScreenBitmap.Height := FScreenHeight;

      FScreenBitmap.Canvas.Brush.Color := clBlack;
      FScreenBitmap.Canvas.FillRect(Classes.Rect(0, 0, FScreenWidth, FScreenHeight));

      SafeLog('Bitmap создан успешно');
    except
      on E: Exception do
      begin
        SafeLog('Ошибка создания bitmap: ' + E.Message);
        if Assigned(FScreenBitmap) then
        begin
          FScreenBitmap.Free;
          FScreenBitmap := nil;
        end;
      end;
    end;

    PaintBox1.Width := FScreenWidth;
    PaintBox1.Height := FScreenHeight;

    KeyPreview := True;

    SafeLog('Инициализируем Winsock');

    // Инициализация Winsock
    if WSAStartup(MAKEWORD(2, 2), FWSAData) <> 0 then
    begin
      SafeLog('Ошибка инициализации Winsock: ' + IntToStr(WSAGetLastError));
      ShowMessage('Winsock init failed');
      Exit;
    end;

    SafeLog('Winsock инициализирован успешно');

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

    SetStatus('Ready to connect');
    UpdateConnectionUI;
    SafeLog('FormCreate завершен успешно');

  except
    on E: Exception do
    begin
      SafeLog('КРИТИЧЕСКАЯ ОШИБКА в FormCreate: ' + E.Message);
      ShowMessage('Critical error in FormCreate: ' + E.Message);
    end;
  end;
end;

procedure TForm1.DecodeJPEGData(const JPEGData: PByte; DataSize: Integer);
var
  Stream: IStream;
  Bitmap: GPBITMAP;
  Graphics: GPGRAPHICS;
  Rect: TGPRectF;
  Status: TStatus;
  hMem: HGLOBAL;
  pMem: Pointer;
  ImgWidth, ImgHeight: UINT;
  HexStr: string;
  i: Integer;
begin
  if not Assigned(FScreenBitmap) or (DataSize = 0) then Exit;

  try
    HexStr := '';
    for i := 0 to Min(15, DataSize - 1) do
      HexStr := HexStr + IntToHex(PByte(JPEGData + i)^, 2) + ' ';
    SafeLog(Format('DecodeJPEGData: DataSize=%d, First bytes: %s', [DataSize, HexStr]));

    hMem := GlobalAlloc(GMEM_MOVEABLE, DataSize);
    if hMem = 0 then Exit;

    try
      pMem := GlobalLock(hMem);
      if pMem = nil then Exit;

      Move(JPEGData^, pMem^, DataSize);
      GlobalUnlock(hMem);

      if CreateStreamOnHGlobal(hMem, False, Stream) <> S_OK then
      begin
        SafeLog('CreateStreamOnHGlobal failed');
        Exit;
      end;

      Status := GdipCreateBitmapFromStream(Stream, Bitmap);
      if Status <> Ok then
      begin
        SafeLog('GdipCreateBitmapFromStream failed with status: ' + IntToStr(Ord(Status)));

        if DataSize < 100 then
          SafeLog('JPEG data is too small: ' + IntToStr(DataSize) + ' bytes');

        if (DataSize >= 2) and (PByte(JPEGData)^ = $FF) and (PByte(JPEGData + 1)^ = $D8) then
          SafeLog('JPEG starts with correct marker FF D8')
        else
          SafeLog('JPEG does not start with FF D8');

        if (DataSize >= 4) then
        begin
          SafeLog(Format('First 4 bytes: %2.2x %2.2x %2.2x %2.2x',
            [PByte(JPEGData)^, PByte(JPEGData + 1)^,
             PByte(JPEGData + 2)^, PByte(JPEGData + 3)^]));
        end;

        Exit;
      end;

      try
        GdipGetImageWidth(Bitmap, ImgWidth);
        GdipGetImageHeight(Bitmap, ImgHeight);


        FRemoteWidth := ImgWidth;
        FRemoteHeight := ImgHeight;

        SafeLog(Format('JPEG dimensions: %dx%d', [ImgWidth, ImgHeight]));

        if (FScreenWidth <> Integer(ImgWidth)) or (FScreenHeight <> Integer(ImgHeight)) then
        begin
          FScreenWidth := ImgWidth;
          FScreenHeight := ImgHeight;
          FScreenBitmap.Width := ImgWidth;
          FScreenBitmap.Height := ImgHeight;
          PaintBox1.Width := ImgWidth;
          PaintBox1.Height := ImgHeight;
        end;

        Status := GdipCreateFromHDC(FScreenBitmap.Canvas.Handle, Graphics);
        if Status <> Ok then
        begin
          SafeLog('Failed to create graphics: ' + IntToStr(Ord(Status)));
          Exit;
        end;

        try
          GdipGraphicsClear(Graphics, $FF000000);

          Rect.X := 0;
          Rect.Y := 0;
          Rect.Width := ImgWidth;
          Rect.Height := ImgHeight;

          Status := GdipDrawImageRect(Graphics, Bitmap,
            Rect.X, Rect.Y, Rect.Width, Rect.Height);

          if Status <> Ok then
            SafeLog('Failed to draw image: ' + IntToStr(Ord(Status)))
          else
            SafeLog('Image drawn successfully');

        finally
          GdipDeleteGraphics(Graphics);
        end;

        PaintBox1.Invalidate;

      finally
        GdipDisposeImage(Bitmap);
      end;

    finally
      GlobalFree(hMem);
    end;

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

procedure TForm1.MouseTimerTick(Sender: TObject);
var
  ButtonMask: Byte;
begin
  if FMouseCoordsReady and (FRelayState = rsReady) then
  begin
    ButtonMask := 0;
    if FIsMouseDown then
      ButtonMask := 1;

    SendMouseCoords(FNewMouseX, FNewMouseY, ButtonMask);

    FMouseCoordsReady := False; // Сброс флага до следующего движения мыши
  end;
end;

procedure TForm1.UpdateBitmapFromRelay(const Data: TBytes; StartIndex, DataSize: Integer);
var
  BytesPerPixel, BytesPerLine: Integer;
  CurrentOffset, Row, ColOffset, ChunkSize: Integer;
  DestPtr: PByte;
  SrcIndex: Integer;
begin
  if (FScreenBitmap = nil) then Exit;

  BytesPerPixel := 3;
  BytesPerLine := FScreenBitmap.Width * BytesPerPixel;

  SrcIndex := StartIndex;
  CurrentOffset := 0;

  FScreenBitmap.BeginUpdate;
  try
    while (DataSize > 0) and (CurrentOffset < FScreenBitmap.Height * BytesPerLine) do
    begin
      Row := CurrentOffset div BytesPerLine;
      ColOffset := CurrentOffset mod BytesPerLine;

      if Row >= FScreenBitmap.Height then Break;

      DestPtr := FScreenBitmap.ScanLine[Row];
      Inc(DestPtr, ColOffset);

      ChunkSize := Min(DataSize, BytesPerLine - ColOffset);

      Move(Data[SrcIndex], DestPtr^, ChunkSize);

      Inc(SrcIndex, ChunkSize);
      Inc(CurrentOffset, ChunkSize);
      Dec(DataSize, ChunkSize);
    end;
  finally
    FScreenBitmap.EndUpdate;
  end;
end;

procedure TForm1.ProcessJPEGFrame(const JPEGData: PByte; DataSize: Integer);
var
  i: Integer;
begin
  if DataSize < 100 then
  begin
    SafeLog('JPEG data too small: ' + IntToStr(DataSize) + ' bytes');
    Exit;
  end;

  // Проверяем JPEG маркеры
  if (JPEGData^ = $FF) and ((JPEGData + 1)^ = $D8) then
  begin
    SafeLog('Valid JPEG start marker found');
    DecodeJPEGData(JPEGData, DataSize);
  end
  else
  begin
    SafeLog('Invalid JPEG data - no start marker');

    // Ищем JPEG маркер в данных
    for i := 0 to DataSize - 2 do
    begin
      if (PByte(JPEGData + i)^ = $FF) and (PByte(JPEGData + i + 1)^ = $D8) then
      begin
        SafeLog(Format('Found JPEG marker at offset %d, attempting decode', [i]));
        DecodeJPEGData(JPEGData + i, DataSize - i);
        Exit;
      end;
    end;

    SafeLog('No JPEG markers found in data');
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  try
    SafeLog('Начинаем FormDestroy');

    if Assigned(FRelayBuffer) then
    FreeAndNil(FRelayBuffer);

    // Закрываю полноэкранную форму если она открыта
    if Assigned(FFullScreenForm) then
    begin
      FFullScreenForm.Close;
      FFullScreenForm := nil;
    end;

    FreeAndNil(FJPEGAccumulator);

    DisconnectFromServer;

    if Assigned(FScreenBitmap) then
    begin
      FScreenBitmap.Free;
      FScreenBitmap := nil;
      SafeLog('Bitmap освобожден');
    end;

    if FReceiveBuffer <> nil then
    begin
      FreeMem(FReceiveBuffer);
      FReceiveBuffer := nil;
      FReceiveBufferSize := 0;
      FReceiveBufferUsed := 0;
      SafeLog('Буфер приема освобожден');
    end;

    if Assigned(FRelayBuffer) then
      FRelayBuffer.Free;

    // Shutdown GDI+
    GdiplusShutdown(FGDIPlusToken);

    WSACleanup;
    SafeLog('Winsock очищен');

    if FLogOpened then
    begin
      SafeLog('=== VNC Client Stopped ===');
      CloseFile(FLogFile);
      FLogOpened := False;
    end;
  except
    on E: Exception do
    begin
      SafeLog('Ошибка в FormDestroy: ' + E.Message);
    end;
  end;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  try
    // Обработка горячих клавиш
    if (ssCtrl in Shift) and (Key = VK_F) then
    begin
      SafeLog('Нажата горячая клавиша Ctrl+F');
      if FFullScreenMode then
      begin
        Button3Click(nil);
        Key := 0;
        Exit;
      end;
    end;

    // Обработка клавиши Escape для выхода из полноэкранного режима
    if (Key = VK_ESCAPE) and FFullScreenMode then
    begin
      SafeLog('Нажата клавиша Escape в полноэкранном режиме');
      Button3Click(nil);
      Key := 0;
      Exit;
    end;

    // Отправляем событие клавиши
    if FConnected and (Key <> 0) then
    begin
      SafeLog(Format('Отправляем KeyDown: Code=%d', [Key]));
      SendKeyEvent(Key, True);
    end;
  except
    on E: Exception do
      SafeLog('Ошибка в FormKeyDown: ' + E.Message);
  end;
end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  try
    if FConnected and (Key <> 0) then
    begin
      SafeLog(Format('Отправляем KeyUp: Code=%d', [Key]));
      SendKeyEvent(Key, False);
    end;
  except
    on E: Exception do
      SafeLog('Ошибка в FormKeyUp: ' + E.Message);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  try
    SafeLog('Нажата кнопка Connect');

    if FConnectionMode = cmDirect then
      ConnectToServer
    else
      ConnectViaRelay;
  except
    on E: Exception do
    begin
      SafeLog('Ошибка в Button1Click: ' + E.Message);
    end;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  try
    SafeLog('Нажата кнопка Disconnect');
    DisconnectFromServer;
  except
    on E: Exception do
      SafeLog('Ошибка в Button2Click: ' + E.Message);
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  try
    SafeLog('Нажата кнопка Fullscreen');

    if not FFullScreenMode then
    begin
      // Создаем полноэкранную форму
      FFullScreenForm := TForm.Create(Self);
      FFullScreenForm.BorderStyle := bsNone;
      FFullScreenForm.WindowState := wsFullScreen;
      FFullScreenForm.KeyPreview := True;
      FFullScreenForm.Color := clBlack;

      // Создаю PaintBox для полноэкранной формы
      with TPaintBox.Create(FFullScreenForm) do
      begin
        Parent := FFullScreenForm;
        Align := alClient;
        OnPaint := @PaintBox1Paint;
        OnMouseDown := @PaintBox1MouseDown;
        OnMouseUp := @PaintBox1MouseUp;
        OnMouseMove := @PaintBox1MouseMove;
      end;

      // Обработчики клавиатуры для полноэкранной формы
      FFullScreenForm.OnKeyDown := @FormKeyDown;
      FFullScreenForm.OnKeyUp := @FormKeyUp;

      FFullScreenForm.Show;
      FFullScreenMode := True;
      Button3.Caption := 'Exit Fullscreen';

      SafeLog('Полноэкранный режим включен. Используйте Ctrl+F или Escape для выхода.');
    end
    else
    begin
      // Закрываю полноэкранную форму
      if Assigned(FFullScreenForm) then
      begin
        FFullScreenForm.Close;
        FFullScreenForm := nil;
      end;

      FFullScreenMode := False;
      Button3.Caption := 'Fullscreen';

      SafeLog('Полноэкранный режим выключен');
    end;

  except
    on E: Exception do
      SafeLog('Ошибка в Button3Click: ' + E.Message);
  end;
end;


procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  ButtonMask: Byte;
  ActualX, ActualY: Integer;
begin
  try
    ButtonMask := 0;
    if Button = mbLeft then ButtonMask := 1
    else if Button = mbRight then ButtonMask := 2
    else if Button = mbMiddle then ButtonMask := 4;

    // Преобразую координаты с учетом масштабирования в полноэкранном режиме
    if FFullScreenMode then
    begin
      ActualX := Round(X * FScreenWidth / PaintBox1.Width);
      ActualY := Round(Y * FScreenHeight / PaintBox1.Height);
    end
    else
    begin
      ActualX := X;
      ActualY := Y;
    end;

    SendMouseEvent(ActualX, ActualY, ButtonMask);
  except
    on E: Exception do
      SafeLog('Ошибка в PaintBox1MouseDown: ' + E.Message);
  end;
end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  ActualX, ActualY: Integer;
begin
  try
    // Преобразую координаты с учетом маштабирования в полноэкранном режиме
    if FFullScreenMode then
    begin
      ActualX := Round(X * FScreenWidth / PaintBox1.Width);
      ActualY := Round(Y * FScreenHeight / PaintBox1.Height);
    end
    else
    begin
      ActualX := X;
      ActualY := Y;
    end;

    SendMouseEvent(ActualX, ActualY, 0);
  except
    on E: Exception do
      SafeLog('Ошибка в PaintBox1MouseUp: ' + E.Message);
  end;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  // ОТПРАВЛЯЕМ СРАЗУ, но с проверкой частоты внутри SendMouseCoords
  if FConnected then
    SendMouseCoords(X, Y, 0);
end;

procedure TForm1.SendMouseCoords(X, Y: Integer; ButtonMask: Byte);
var
  Buffer: array[0..5] of Byte;
  CurrentTime: DWORD;
  TimeDiff: DWORD;
const
  MIN_MOUSE_DELAY = 100;
begin
  CurrentTime := GetTickCount;
  if CurrentTime >= FLastUpdateTime then
    TimeDiff := CurrentTime - FLastUpdateTime
  else
    TimeDiff := MAXDWORD - FLastUpdateTime + CurrentTime;

  if TimeDiff < MIN_MOUSE_DELAY then
    Exit;

  FLastUpdateTime := CurrentTime;

  if (X < 0) or (Y < 0) or (X >= FRemoteWidth) or (Y >= FRemoteHeight) then
    Exit;

  Buffer[0] := $02;
  Buffer[1] := ButtonMask;
  PWord(@Buffer[2])^ := Word(X);
  PWord(@Buffer[4])^ := Word(Y);

  send(FRelaySocket, Buffer, SizeOf(Buffer), 0);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  try
    if FConnected then
    begin
      SafeLog('Timer: запрашиваем обновление');
      RequestUpdate;
    end;
  except
    on E: Exception do
    begin
      SafeLog('Ошибка в Timer1Timer: ' + E.Message);
      Timer1.Enabled := False;
    end;
  end;
end;

procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
  FConnectionMode := TConnectionMode(RadioGroup1.ItemIndex);

  if FConnectionMode = cmDirect then
  begin
    Edit1.Enabled := True;
    Edit2.Enabled := True;
    Edit3.Enabled := False;
    Label8.Caption := 'Connection: Direct';
  end
  else
  begin
    Edit1.Enabled := False;
    Edit2.Enabled := False;
    Edit3.Enabled := True;
    Label8.Caption := 'Connection: Via Relay';
  end;

  SafeLog('Changed connection mode to: ' + IntToStr(Ord(FConnectionMode)));
end;

procedure TForm1.SafeLog(const Msg: string);
var
  TimeStr: string;
  FullMsg: string;
begin
  try
    TimeStr := FormatDateTime('hh:nn:ss', Now);
    FullMsg := '[' + TimeStr + '] ' + Msg;

    if Assigned(Memo1) then
    begin
      Memo1.Lines.Add(FullMsg);
      while Memo1.Lines.Count > 50 do
        Memo1.Lines.Delete(0);
      Application.ProcessMessages;
    end;

    if FLogOpened then
    begin
      WriteLn(FLogFile, FullMsg);
      Flush(FLogFile);
    end;
  except
  end;
end;

procedure TForm1.ConnectToServer;
var
  ServerAddr: TSockAddrIn;
  ServerIP: string;
  ServerPort: Integer;
  SocketBufferSize: Integer;
  OptLen: Integer;
begin
  if FConnected then Exit;

  try
    ServerIP := Edit1.Text;
    ServerPort := StrToIntDef(Edit2.Text, VNC_PORT);

    SafeLog('Подключаемся напрямую к ' + ServerIP + ':' + IntToStr(ServerPort));

    if ServerIP = '' then
    begin
      ShowMessage('Enter server IP address');
      Exit;
    end;

    SetStatus('Connecting to server...');

    FSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
    if FSocket = INVALID_SOCKET then
    begin
      SafeLog('Ошибка создания сокета: ' + IntToStr(WSAGetLastError));
      raise Exception.Create('Failed to create socket');
    end;

    SocketBufferSize := 1024 * 1024;
    OptLen := SizeOf(SocketBufferSize);
    if setsockopt(FSocket, SOL_SOCKET, SO_RCVBUF, @SocketBufferSize, OptLen) = SOCKET_ERROR then
    begin
      SafeLog('Предупреждение: не удалось установить размер буфера приема: ' + IntToStr(WSAGetLastError));
    end
    else
    begin
      SafeLog('Буфер приема сокета установлен в ' + IntToStr(SocketBufferSize) + ' байт');
    end;

    SafeLog('Сокет создан: ' + IntToStr(FSocket));

    ZeroMemory(@ServerAddr, SizeOf(ServerAddr));
    ServerAddr.sin_family := AF_INET;
    ServerAddr.sin_addr.s_addr := inet_addr(PAnsiChar(AnsiString(ServerIP)));
    ServerAddr.sin_port := htons(ServerPort);

    SafeLog('Вызываем connect()');

    if connect(FSocket, @ServerAddr, SizeOf(ServerAddr)) = SOCKET_ERROR then
    begin
      SafeLog('Ошибка connect: ' + IntToStr(WSAGetLastError));
      closesocket(FSocket);
      FSocket := INVALID_SOCKET;
      raise Exception.Create('Failed to connect to server');
    end;

    SafeLog('TCP соединение установлено');
    SetStatus('Connection established');

    SafeLog('Настраиваем асинхронные уведомления');
    if WSAAsyncSelect(FSocket, Handle, WM_SOCKET, FD_READ or FD_CLOSE) = SOCKET_ERROR then
    begin
      SafeLog('Ошибка WSAAsyncSelect: ' + IntToStr(WSAGetLastError));
      closesocket(FSocket);
      FSocket := INVALID_SOCKET;
      raise Exception.Create('Failed to set up async notifications');
    end
    else
    begin
      SafeLog('Асинхронные уведомления настроены успешно');
    end;

    FConnected := True;
    FThroughRelay := False;
    UpdateConnectionUI;

    // Сбрасываю состояние буфера
    FReceiveBufferUsed := 0;
    FExpectingHeader := True;
    FImageDataReceived := 0;

    Timer1.Interval := 200;
    Timer1.Enabled := True;

    SetStatus('Connected to ' + ServerIP + ':' + IntToStr(ServerPort));
    SafeLog('Прямое подключение завершено, ждем данных от сервера');

  except
    on E: Exception do
    begin
      SafeLog('ОШИБКА подключения: ' + E.Message);
      SetStatus('Connection error: ' + E.Message);
      ShowMessage('Connection error: ' + E.Message);

      if FSocket <> INVALID_SOCKET then
      begin
        closesocket(FSocket);
        FSocket := INVALID_SOCKET;
        SafeLog('Сокет закрыт после ошибки');
      end;
      UpdateConnectionUI;
    end;
  end;
end;

procedure TForm1.ConnectViaRelay;
begin
  if FConnected then Exit;

  FTargetID := Edit3.Text;

  if FTargetID = '' then
  begin
    ShowMessage('Enter server ID');
    Exit;
  end;

  SetStatus('Connecting via relay to ID: ' + FTargetID);

  // Сначала подключаемся к relay серверу
  ConnectToRelayServer;
end;

procedure TForm1.ConnectToRelayServer;
var
  RelayAddr: TSockAddrIn;
begin
  if FRelayState <> rsDisconnected then Exit;

  try
    ParseRelayAddress;

    SafeLog('Connecting to relay server: ' + FRelayIP + ':' + IntToStr(FRelayPort));

    FRelaySocket := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
    if FRelaySocket = INVALID_SOCKET then
    begin
      SafeLog('Ошибка создания relay сокета: ' + IntToStr(WSAGetLastError));
      raise Exception.Create('Failed to create relay socket');
    end;

    ZeroMemory(@RelayAddr, SizeOf(RelayAddr));
    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
      SafeLog('Ошибка подключения к relay: ' + IntToStr(WSAGetLastError));
      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);

    FRelayState := rsConnected;
    Label7.Caption := 'Connected to relay';
    Label7.Font.Color := clGreen;

    SafeLog('Connected to relay server');

    // Отправляем запрос на подключение к целевому серверу
    SendToRelay('CONNECT_CLIENT ' + FTargetID);
    FRelayState := rsWaiting;
    Label7.Caption := 'Waiting for server...';
    Label7.Font.Color := clBlue;

    SetStatus('Waiting for server connection via relay...');

  except
    on E: Exception do
    begin
      SafeLog('Relay connection error: ' + E.Message);
      SetStatus('Relay connection error: ' + E.Message);
      FRelayState := rsDisconnected;
      Label7.Caption := 'Connection failed';
      Label7.Font.Color := clRed;
    end;
  end;
end;

procedure TForm1.DisconnectFromServer;
begin
  try
    if not FConnected and (FRelayState = rsDisconnected) then Exit;

    SafeLog('Начинаем отключение');

    FConnected := False;
    Timer1.Enabled := False;

    if FSocket <> INVALID_SOCKET then
    begin
      WSAAsyncSelect(FSocket, Handle, 0, 0);
      closesocket(FSocket);
      FSocket := INVALID_SOCKET;
      SafeLog('Основной сокет закрыт');
    end;

    DisconnectFromRelay;

    // Сбрасываю состояние буфера
    FReceiveBufferUsed := 0;
    FExpectingHeader := True;
    FImageDataReceived := 0;

    if Assigned(FScreenBitmap) then
    begin
      FScreenBitmap.Canvas.Brush.Color := clBlack;
      FScreenBitmap.Canvas.FillRect(Classes.Rect(0, 0, FScreenBitmap.Width, FScreenBitmap.Height));
      PaintBox1.Invalidate;
    end;

    SetStatus('Disconnected');
    UpdateConnectionUI;
    SafeLog('Отключение завершено');

  except
    on E: Exception do
      SafeLog('Ошибка в DisconnectFromServer: ' + E.Message);
  end;
end;

procedure TForm1.DisconnectFromRelay;
begin
  if FRelaySocket <> INVALID_SOCKET then
  begin
    WSAAsyncSelect(FRelaySocket, Handle, 0, 0);
    closesocket(FRelaySocket);
    FRelaySocket := INVALID_SOCKET;
    SafeLog('Relay сокет закрыт');
  end;

  FRelayState := rsDisconnected;
  Label7.Caption := 'Disconnected';
  Label7.Font.Color := clRed;
  FRelayBuffer.Clear;
end;

procedure TForm1.ProcessServerData;
var
  BytesReceived: Integer;
  BytesProcessed: Integer;
  RemainingDataInSocket: LongWord;
  ExpectedTotalData: Cardinal;
  MaxBufferSize: Cardinal;
  FramesProcessed: Integer;
  RemainingImageData: Integer;
  AvailableData: Integer;
  RemainingBytes: Integer;
begin
  try
    if FSocket = INVALID_SOCKET then
    begin
      SafeLog('ProcessServerData: FSocket недействителен, выход.');
      Exit;
    end;

    MaxBufferSize := 10 * 1024 * 1024;

    if ioctlsocket(FSocket, FIONREAD, @RemainingDataInSocket) = SOCKET_ERROR then
    begin
      SafeLog('Ошибка ioctlsocket (FIONREAD): ' + IntToStr(WSAGetLastError));
      DisconnectFromServer;
      Exit;
    end;

    if RemainingDataInSocket = 0 then
    begin
      SafeLog('ProcessServerData: Нет данных для чтения из сокета.');
      Exit;
    end;

    if FReceiveBufferUsed + RemainingDataInSocket > MaxBufferSize then
    begin
      SafeLog(Format('ПРЕДУПРЕЖДЕНИЕ: Буфер переполнен (%d + %d > %d), сбрасываем старые данные',
        [FReceiveBufferUsed, RemainingDataInSocket, MaxBufferSize]));

      FReceiveBufferUsed := 0;
      FExpectingHeader := True;
      FImageDataReceived := 0;

      RemainingDataInSocket := Min(RemainingDataInSocket, MaxBufferSize div 2);
    end;

    SafeLog(Format('ProcessServerData: в сокете доступно %d байт, в буфере %d байт',
      [RemainingDataInSocket, FReceiveBufferUsed]));

    ExpectedTotalData := FReceiveBufferUsed + RemainingDataInSocket;
    if FReceiveBufferSize < ExpectedTotalData then
    begin
      FReceiveBufferSize := ExpectedTotalData + (64 * 1024);
      ReallocMem(FReceiveBuffer, FReceiveBufferSize);
      SafeLog(Format('Буфер приема увеличен до %d байт', [FReceiveBufferSize]));
    end;

    BytesReceived := recv(FSocket, (FReceiveBuffer + FReceiveBufferUsed)^, RemainingDataInSocket, 0);

    if BytesReceived = SOCKET_ERROR then
    begin
      SafeLog('Ошибка recv: ' + IntToStr(WSAGetLastError));
      DisconnectFromServer;
      Exit;
    end;

    if BytesReceived = 0 then
    begin
      SafeLog('Соединение закрыто сервером (recv вернул 0)');
      DisconnectFromServer;
      Exit;
    end;

    Inc(FReceiveBufferUsed, BytesReceived);
    SafeLog(Format('Получено %d байт, в буфере теперь %d байт', [BytesReceived, FReceiveBufferUsed]));

    BytesProcessed := 0;
    FramesProcessed := 0;

    while (FReceiveBufferUsed - BytesProcessed >= SizeOf(TScreenHeader)) and (FramesProcessed < 3) do
    begin
      if FExpectingHeader then
      begin
        Move((FReceiveBuffer + BytesProcessed)^, FCurrentHeader, SizeOf(TScreenHeader));
        Inc(BytesProcessed, SizeOf(TScreenHeader));

        SafeLog(Format('Заголовок: %dx%d, данных: %d байт, формат: %d',
          [FCurrentHeader.Width, FCurrentHeader.Height, FCurrentHeader.DataSize, FCurrentHeader.ImageFormat]));

        if (FCurrentHeader.Width < 1) or (FCurrentHeader.Width > 4096) or
           (FCurrentHeader.Height < 1) or (FCurrentHeader.Height > 4096) or
           (FCurrentHeader.DataSize < 1) or (FCurrentHeader.DataSize > 50 * 1024 * 1024) then
        begin
          SafeLog(Format('Некорректный заголовок (%dx%d, DataSize=%d), поиск следующего',
            [FCurrentHeader.Width, FCurrentHeader.Height, FCurrentHeader.DataSize]));

          while (BytesProcessed < FReceiveBufferUsed - SizeOf(TScreenHeader)) do
          begin
            Inc(BytesProcessed);
            Move((FReceiveBuffer + BytesProcessed)^, FCurrentHeader, SizeOf(TScreenHeader));
            if (FCurrentHeader.Width >= 1) and (FCurrentHeader.Width <= 4096) and
               (FCurrentHeader.Height >= 1) and (FCurrentHeader.Height <= 4096) and
               (FCurrentHeader.DataSize >= 1) and (FCurrentHeader.DataSize <= 50 * 1024 * 1024) then
            begin
              SafeLog(Format('Найден корректный заголовок на позиции %d', [BytesProcessed]));
              Inc(BytesProcessed, SizeOf(TScreenHeader));
              Break;
            end;
          end;

          if BytesProcessed >= FReceiveBufferUsed - SizeOf(TScreenHeader) then
          begin
            SafeLog('Корректный заголовок не найден, очищаем буфер');
            FReceiveBufferUsed := 0;
            FExpectingHeader := True;
            Exit;
          end;
        end;

        if (FScreenWidth <> FCurrentHeader.Width) or (FScreenHeight <> FCurrentHeader.Height) then
        begin
          SafeLog(Format('Изменяем размер bitmap: %dx%d -> %dx%d',
            [FScreenWidth, FScreenHeight, FCurrentHeader.Width, FCurrentHeader.Height]));

          FScreenWidth := FCurrentHeader.Width;
          FScreenHeight := FCurrentHeader.Height;

          if not Assigned(FScreenBitmap) then
          begin
            FScreenBitmap := Graphics.TBitmap.Create;
            FScreenBitmap.PixelFormat := pf24bit;
          end;

          FScreenBitmap.Width := FScreenWidth;
          FScreenBitmap.Height := FScreenHeight;
          FScreenBitmap.Canvas.Brush.Color := clBlack;
          FScreenBitmap.Canvas.FillRect(Classes.Rect(0, 0, FScreenWidth, FScreenHeight));

          PaintBox1.Width := FScreenWidth;
          PaintBox1.Height := FScreenHeight;
        end;

        FExpectingHeader := False;
        FImageDataReceived := 0;
      end;

      if not FExpectingHeader then
      begin
        RemainingImageData := Integer(FCurrentHeader.DataSize) - FImageDataReceived;
        AvailableData := FReceiveBufferUsed - BytesProcessed;

        if AvailableData >= RemainingImageData then
        begin
          if FCurrentHeader.ImageFormat = 1 then // JPEG
          begin
            // Обработка JPEG через GDI+
            ProcessJPEGFrame(FReceiveBuffer + BytesProcessed, RemainingImageData);
          end
          else // RAW
          begin
            UpdateBitmapRegion(BytesProcessed, RemainingImageData);
          end;

          Inc(BytesProcessed, RemainingImageData);
          Inc(FImageDataReceived, RemainingImageData);

          SafeLog(Format('Кадр %d завершен (%d байт, Формат: %s)',
            [FramesProcessed + 1, FCurrentHeader.DataSize,
             IfThen(FCurrentHeader.ImageFormat = 1, 'JPEG', 'RAW')]));

          FExpectingHeader := True;
          FImageDataReceived := 0;
          Inc(FramesProcessed);

          if FramesProcessed = 1 then
            UpdateDisplay;
        end
        else
        begin
          if AvailableData > 0 then
          begin
            UpdateBitmapRegion(BytesProcessed, AvailableData);
            Inc(FImageDataReceived, AvailableData);
            Inc(BytesProcessed, AvailableData);

            SafeLog(Format('Частичные данные: %d/%d байт получено',
              [FImageDataReceived, FCurrentHeader.DataSize]));
          end;
          Break;
        end;
      end;
    end;

    if FramesProcessed > 1 then
    begin
      SafeLog(Format('Обработано %d кадров за один вызов', [FramesProcessed]));
      UpdateDisplay;
    end;

    if BytesProcessed > 0 then
    begin
      RemainingBytes := FReceiveBufferUsed - BytesProcessed;
      if RemainingBytes > 0 then
      begin
        Move((FReceiveBuffer + BytesProcessed)^, FReceiveBuffer^, RemainingBytes);
        FReceiveBufferUsed := RemainingBytes;
        SafeLog(Format('Буфер сдвинут, осталось %d байт', [FReceiveBufferUsed]));
      end
      else
      begin
        FReceiveBufferUsed := 0;
        SafeLog('Буфер полностью обработан');
      end;
    end;

    if not Timer1.Enabled and FConnected then
    begin
      Timer1.Enabled := True;
      SafeLog('Таймер обновлений запущен');
    end;

  except
    on E: Exception do
    begin
      SafeLog('ОШИБКА в ProcessServerData: ' + E.Message);
      FReceiveBufferUsed := 0;
      FExpectingHeader := True;
      FImageDataReceived := 0;
      DisconnectFromServer;
    end;
  end;
end;

procedure TForm1.ProcessRelayData;
var
  Buffer: array[0..65535] of Byte;
  BytesReceived: Integer;
  StrData: string;
  NewlinePos: Integer;
  RemainingData: string;
begin
  if FRelaySocket = INVALID_SOCKET then Exit;

  // 1. Читаем из сокета
  BytesReceived := recv(FRelaySocket, Buffer, SizeOf(Buffer), 0);

  if BytesReceived <= 0 then
  begin
    SafeLog('Relay server disconnected (recv 0)');
    DisconnectFromServer;
    Exit;
  end;

  // 2. ВАЖНО: Ставим позицию в конец для ЗАПИСИ
  FRelayBuffer.Position := FRelayBuffer.Size;
  FRelayBuffer.Write(Buffer, BytesReceived);

  // 3. Обработка
  if FRelayState = rsWaiting then
  begin
    // --- ТЕКСТОВЫЙ РЕЖИМ ---
    FRelayBuffer.Position := 0; // Читаем с начала
    SetLength(StrData, FRelayBuffer.Size);
    if Length(StrData) > 0 then
      FRelayBuffer.Read(StrData[1], Length(StrData));

    NewlinePos := Pos(#13#10, StrData);
    if NewlinePos > 0 then
    begin
      HandleRelayResponse(Copy(StrData, 1, NewlinePos - 1));

      // Сохраняем "хвост" если он есть (начало JPEG)
      if NewlinePos + 1 < Length(StrData) then
      begin
        RemainingData := Copy(StrData, NewlinePos + 2, Length(StrData));
        FRelayBuffer.Clear;
        if Length(RemainingData) > 0 then
          FRelayBuffer.Write(RemainingData[1], Length(RemainingData));
      end
      else
        FRelayBuffer.Clear;
    end;
  end
  else if FRelayState = rsReady then
  begin
    // --- БИНАРНЫЙ РЕЖИМ ---
    // ВАЖНО: Сбрасываем позицию в 0, чтобы функция обработки видела данные
    FRelayBuffer.Position := 0;
    ProcessRelayBinaryData;
  end;
end;

procedure TForm1.HandleRelayResponse(const Response: string);
var
  Lines: TStringList;
  i: Integer;
  Line: string;
begin
  Lines := TStringList.Create;
  try
    Lines.Text := Response;

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

      if Line = '' then Continue;

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

      if Pos('CONNECTED', Line) = 1 then
      begin
        FConnected := True;
        FThroughRelay := True;

        FRelayState := rsReady;
        Label7.Caption := 'Connected to server';
        Label7.Font.Color := clGreen;

        SetStatus('Connected via relay to server: ' + FTargetID);

        UpdateConnectionUI;

        FExpectingHeader := True;
        FImageDataReceived := 0;

        // Сбрасываем буфер релея
        FRelayBuffer.Clear;

        Timer1.Enabled := True;

        SafeLog('Successfully connected via relay to server');

        // Запросить первый кадр
        RequestUpdate();

      end
      else if Pos('ERROR', Line) = 1 then
      begin
        SetStatus('Relay error: ' + Copy(Line, 7, MaxInt));
        SafeLog('Relay error: ' + Line);
        DisconnectFromServer;
      end
      else if Pos('SERVER_DISCONNECTED', Line) = 1 then
      begin
        SetStatus('Server disconnected via relay');
        SafeLog('Server disconnected');
        DisconnectFromServer;
      end;
    end;
  finally
    Lines.Free;
  end;
end;

procedure TForm1.ProcessRelayBinaryData;
var
  Header: TScreenHeader;
  TotalFrameSize: Integer;
  TempData: TBytes;
  BytesRemained: Integer;
  FrameProcessed: Boolean;
  begin
    while True do
    begin
      FrameProcessed := False;

      if FRelayBuffer.Size < SizeOf(TScreenHeader) then
        Break;

      FRelayBuffer.Position := 0;
      FRelayBuffer.Read(Header, SizeOf(TScreenHeader));

      if (Header.DataSize = 0) or (Header.DataSize > 50 * 1024 * 1024) then
      begin
        SafeLog('Critical: Bad header size (' + IntToStr(Header.DataSize) + '). Resetting buffer.');
        FRelayBuffer.Clear;
        Break;
      end;

      TotalFrameSize := SizeOf(TScreenHeader) + Header.DataSize;

      if FRelayBuffer.Size < TotalFrameSize then
        Break;

      try
        if Header.DataSize > 0 then
        begin
          SetLength(TempData, Header.DataSize);
          FRelayBuffer.Position := SizeOf(TScreenHeader);
          FRelayBuffer.Read(TempData[0], Header.DataSize);

          if Header.ImageFormat = 1 then
            ProcessJPEGFrame(@TempData[0], Header.DataSize);

          FrameProcessed := True;
        end;
      except
        on E: Exception do
          SafeLog('Error processing frame: ' + E.Message);
      end;

      BytesRemained := FRelayBuffer.Size - TotalFrameSize;

      if BytesRemained > 0 then
      begin
        Move(PByte(FRelayBuffer.Memory)[TotalFrameSize],
             PByte(FRelayBuffer.Memory)[0],
             BytesRemained);
        FRelayBuffer.SetSize(BytesRemained);
      end
      else
      begin
        FRelayBuffer.Clear;
      end;

      FRelayBuffer.Position := 0;

    end;

    FRelayBuffer.Position := FRelayBuffer.Size;
  end;

procedure TForm1.UpdateBitmapRegion(DataOffset: Integer; DataSize: Integer);
var
  i: Integer;
  CurrentLineBytes: PByte;
  SrcPtr: PByte;
  BytesPerPixel: Integer;
  PixelsToCopy: Integer;
begin
  if not Assigned(FScreenBitmap) then Exit;

  BytesPerPixel := 3;
  if FCurrentHeader.DataSize > 0 then
    BytesPerPixel := FCurrentHeader.DataSize div (FCurrentHeader.Width * FCurrentHeader.Height);

  FScreenBitmap.BeginUpdate;
  try
    SrcPtr := FReceiveBuffer + DataOffset;

    for i := 0 to FScreenHeight - 1 do
    begin
      CurrentLineBytes := FScreenBitmap.ScanLine[i];
      PixelsToCopy := FScreenWidth * BytesPerPixel;

      if DataSize >= PixelsToCopy then
      begin
        Move(SrcPtr^, CurrentLineBytes^, PixelsToCopy);
        Inc(SrcPtr, PixelsToCopy);
        Dec(DataSize, PixelsToCopy);
      end
      else if DataSize > 0 then
      begin
        Move(SrcPtr^, CurrentLineBytes^, DataSize);
        FillChar((CurrentLineBytes + DataSize)^, PixelsToCopy - DataSize, 0);
        SrcPtr := SrcPtr + DataSize;
        DataSize := 0;
      end
      else
      begin
        Break;
      end;
    end;

  finally
    FScreenBitmap.EndUpdate;
  end;
end;

procedure TForm1.RequestUpdate;
var
  Msg: Byte;
  CurrentTime: DWORD;
  TimeDiff: DWORD;
const
  MIN_FRAME_DELAY = 50; // Если к примеру изменить с 30 до 100 мс (клиент будет отображать 10 FPS вместо 33)
begin
  try
    if not FConnected then Exit;

    CurrentTime := GetTickCount;
    if CurrentTime >= FLastUpdateTime then
      TimeDiff := CurrentTime - FLastUpdateTime
    else
      TimeDiff := MAXDWORD - FLastUpdateTime + CurrentTime;

    if TimeDiff < MIN_FRAME_DELAY then
    begin
      // SafeLog('Frame request throttled'); // для отладки
      Exit;
    end;

    FLastUpdateTime := CurrentTime;

    Msg := 1;
    if FThroughRelay then
    begin
      SendBinaryToRelay([Msg]);
    end
    else
    begin
      if send(FSocket, Msg, SizeOf(Msg), 0) = SOCKET_ERROR then
        DisconnectFromServer;
    end;
  except
    on E: Exception do
      SafeLog('Error in RequestUpdate: ' + E.Message);
  end;
end;

procedure TForm1.SendMouseEvent(X, Y: Integer; Buttons: Byte);
var
  Msg: TMouseMsg;
  Data: TBytes;
begin
  try
    if not FConnected then Exit;

    if (X < 0) or (X >= FScreenWidth) or (Y < 0) or (Y >= FScreenHeight) then
    begin
      SafeLog(Format('Попытка отправить недействительные координаты мыши: X=%d, Y=%d', [X, Y]));
      Exit;
    end;

    Msg.MsgType := 2;
    Msg.X := X;
    Msg.Y := Y;
    Msg.Buttons := Buttons;

    SetLength(Data, SizeOf(Msg));
    Move(Msg, Data[0], SizeOf(Msg));

    if FThroughRelay then
    begin
      SendBinaryToRelay(Data);
    end
    else
    begin
      if send(FSocket, Msg, SizeOf(Msg), 0) = SOCKET_ERROR then
      begin
        SafeLog('Ошибка отправки mouse event: ' + IntToStr(WSAGetLastError));
      end
      else
      begin
        SafeLog(Format('Mouse: X=%d, Y=%d, Buttons=%d', [X, Y, Buttons]));
      end;
    end;
  except
    on E: Exception do
      SafeLog('Ошибка в SendMouseEvent: ' + E.Message);
  end;
end;

procedure TForm1.SendKeyEvent(KeyCode: DWORD; IsDown: Boolean);
var
  Msg: TKeyMsg;
  Data: TBytes;
begin
  try
    if not FConnected then Exit;

    Msg.MsgType := 3;
    if IsDown then
      Msg.IsDown := 1
    else
      Msg.IsDown := 0;
    Msg.KeyCode := KeyCode;

    SetLength(Data, SizeOf(Msg));
    Move(Msg, Data[0], SizeOf(Msg));

    if FThroughRelay then
    begin
      SendBinaryToRelay(Data);
    end
    else
    begin
      if send(FSocket, Msg, SizeOf(Msg), 0) = SOCKET_ERROR then
      begin
        SafeLog('Ошибка отправки key event: ' + IntToStr(WSAGetLastError));
      end
      else
      begin
        SafeLog(Format('Key: Code=%d, Down=%s', [KeyCode, BoolToStr(IsDown, True)]));
      end;
    end;
  except
    on E: Exception do
      SafeLog('Ошибка в SendKeyEvent: ' + E.Message);
  end;
end;

procedure TForm1.UpdateDisplay;
var
  LastUpdateTime: Cardinal;
  CurrentTime: Cardinal;
const
  MIN_UPDATE_INTERVAL = 33;
begin
  try
    CurrentTime := GetTickCount;
    LastUpdateTime := 0;

    if CurrentTime - LastUpdateTime >= MIN_UPDATE_INTERVAL then
    begin
      PaintBox1.Invalidate;
      LastUpdateTime := CurrentTime;

      if FFullScreenMode and Assigned(FFullScreenForm) then
      begin
        FFullScreenForm.Invalidate;
      end;
    end;
  except
    on E: Exception do
      SafeLog('Ошибка в UpdateDisplay: ' + E.Message);
  end;
end;

procedure TForm1.SetStatus(const Msg: string);
begin
  try
    if Assigned(Label3) then
      Label3.Caption := Msg;
    Application.ProcessMessages;
  except
    on E: Exception do
      SafeLog('Ошибка в SetStatus: ' + E.Message);
  end;
end;

procedure TForm1.UpdateConnectionUI;
begin
  Button1.Enabled := not FConnected;
  Button2.Enabled := FConnected;
  Button3.Enabled := FConnected;

  if FConnectionMode = cmDirect then
  begin
    Edit1.Enabled := not FConnected;
    Edit2.Enabled := not FConnected;
    Edit3.Enabled := False;
  end
  else
  begin
    Edit1.Enabled := False;
    Edit2.Enabled := False;
    Edit3.Enabled := not FConnected;
  end;

  RadioGroup1.Enabled := not FConnected;

  case FRelayState of
    rsDisconnected:
    begin
      Label7.Caption := 'Disconnected';
      Label7.Font.Color := clRed;
    end;
    rsConnected:
    begin
      Label7.Caption := 'Connected to relay';
      Label7.Font.Color := clGreen;
    end;
    rsWaiting:
    begin
      Label7.Caption := 'Waiting for server...';
      Label7.Font.Color := clBlue;
    end;
    rsReady:
    begin
      Label7.Caption := 'Connected to server';
      Label7.Font.Color := clGreen;
    end;
  end;
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);
    SafeLog('>> Relay: ' + Data);
  end;
end;

procedure TForm1.SendBinaryToRelay(const Data: TBytes);
begin
  if FRelaySocket <> INVALID_SOCKET then
  begin
    send(FRelaySocket, Data[0], Length(Data), 0);
    SafeLog('Binary data sent to relay: ' + IntToStr(Length(Data)) + ' bytes');
  end;
end;

procedure TForm1.ParseRelayAddress;
begin
  // Дефолтный адрес релей сервера для подключения
  FRelayIP := '10.30.28.28';
  FRelayPort := RELAY_PORT;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
var
  PaintBox: TPaintBox;
  DestRect: TRect;
  ScaleX, ScaleY, Scale: Double;
begin
  try
    PaintBox := Sender as TPaintBox;

    if Assigned(FScreenBitmap) and (FScreenWidth > 0) and (FScreenHeight > 0) then
    begin
      if FFullScreenMode then
      begin
        ScaleX := PaintBox.Width / FScreenWidth;
        ScaleY := PaintBox.Height / FScreenHeight;
        Scale := MinDouble(ScaleX, ScaleY);

        DestRect.Left := (PaintBox.Width - Round(FScreenWidth * Scale)) div 2;
        DestRect.Top := (PaintBox.Height - Round(FScreenHeight * Scale)) div 2;
        DestRect.Right := DestRect.Left + Round(FScreenWidth * Scale);
        DestRect.Bottom := DestRect.Top + Round(FScreenHeight * Scale);

        PaintBox.Canvas.StretchDraw(DestRect, FScreenBitmap);
      end
      else
      begin
        PaintBox.Canvas.Draw(0, 0, FScreenBitmap);
      end;
    end
    else
    begin
      // Рисуем черный фон, если битмап не готов или имеет нулевые размеры
      PaintBox.Canvas.Brush.Color := clBlack;
      PaintBox.Canvas.FillRect(PaintBox.ClientRect);
    end;
  except
    on E: Exception do
      SafeLog('Ошибка в PaintBox1Paint: ' + E.Message);
  end;
end;

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

  try
    SafeLog(Format('WMSocket вызван. Событие: %d, Ошибка: %d, Socket: %d',
                   [Event, Error, Socket]));

    if Socket = FRelaySocket then
    begin
      case Event of
        FD_READ:
          if Error = 0 then
            ProcessRelayData
          else
            DisconnectFromServer;

        FD_CLOSE:
          begin
            SafeLog('Relay connection closed');
            DisconnectFromServer;
          end;
      end;
    end
    else if Socket = FSocket then
    begin
      case Event of
        FD_READ:
          if Error = 0 then
            ProcessServerData
          else
            DisconnectFromServer;

        FD_CLOSE:
          begin
            SafeLog('Direct connection closed');
            DisconnectFromServer;
          end;
      end;
    end;

  except
    on E: Exception do
    begin
      SafeLog('КРИТИЧЕСКАЯ ОШИБКА в WMSocket: ' + E.Message);
      DisconnectFromServer;
    end;
  end;
end;

end.

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

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.

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

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.

P.S. Файлы проектов: https://send.exploit.in/download/599cd915caf447f4/#GpSVRjDIiqKRYiWlcdC-fA

 

[swwwheart]

link is expired.

 

[C2flow]

Вы что ребята наверное еще и Читы какие нибудь пишите ? Это не как не назвать тем-более VNC если ты траффик соединения которые очень шумные не шифруешь, любой антивирус спалит это и любой браузер. База для любого софта пусть это Стиллер или VNC или hvnc это подавление шума, маскировка под обычное браузерное соединение хотя бы. Я понимаю что это очень трудно и мало кто умеет но без этого нету не какого смысла. А так то красавчик автор