unit uWebServerGames; interface uses System.SysUtils, System.Classes, System.JSON, System.Generics.Collections, IdHTTPServer, IdCustomHTTPServer, IdContext, IdComponent, System.NetEncoding, System.IOUtils; type TGameWebServer = class private FHTTP: TIdHTTPServer; FRootDir: string; FCurrentGame: string; FClients: TList; procedure HTTPCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); procedure BroadcastJSON(const AJSON: TJSONObject); procedure HTTPDisconnect(AContext: TIdContext); function ParseControlCommands(const AGameName: string): TArray; public constructor Create(const ARootDir: string; APort: Integer = 8080); destructor Destroy; override; procedure Start; procedure Stop; procedure SetGame(const AFileName: string); procedure Input(AParams: TJSONObject); function GetControlCommands: TArray; end; implementation { TGameWebServer } function TGameWebServer.ParseControlCommands(const AGameName: string): TArray; var configPath, content, controlSection: string; startPos, endPos: Integer; lines: TArray; line: string; commands: TList; begin SetLength(Result, 0); configPath := TPath.Combine(FRootDir, 'games\' + AGameName + '\config.cfg'); if not FileExists(configPath) then Exit; content := TFile.ReadAllText(configPath, TEncoding.UTF8).ToLower; startPos := content.IndexOf(''); endPos := content.IndexOf(''); if (startPos = -1) or (endPos = -1) or (endPos <= startPos) then Exit; startPos := startPos + Length(''); controlSection := content.Substring(startPos, endPos - startPos).Trim; commands := TList.Create; try lines := controlSection.Split([#10, #13], TStringSplitOptions.ExcludeEmpty); for line in lines do begin // Исправление: используем временную переменную вместо изменения loop variable var trimmedLine := line.Trim; if not trimmedLine.IsEmpty then commands.Add(trimmedLine); end; Result := commands.ToArray; finally commands.Free; end; end; function TGameWebServer.GetControlCommands: TArray; begin if FCurrentGame.IsEmpty then SetLength(Result, 0) else Result := ParseControlCommands(FCurrentGame); end; constructor TGameWebServer.Create(const ARootDir: string; APort: Integer); begin FRootDir := ARootDir; FCurrentGame := ''; FClients := TList.Create; FHTTP := TIdHTTPServer.Create(nil); FHTTP.DefaultPort := APort; FHTTP.OnDisconnect := HTTPDisconnect; FHTTP.OnCommandGet := HTTPCommandGet; FHTTP.Bindings.Add.Port := APort; end; destructor TGameWebServer.Destroy; begin Stop; FHTTP.Free; FClients.Free; inherited; end; procedure TGameWebServer.Start; begin FHTTP.Active := True; end; procedure TGameWebServer.Stop; begin FHTTP.Active := False; end; procedure TGameWebServer.HTTPDisconnect(AContext: TIdContext); begin FClients.Remove(AContext); AContext.Connection.Disconnect; end; procedure TGameWebServer.SetGame(const AFileName: string); begin if not TDirectory.Exists(TPath.Combine(FRootDir, 'games\' + AFileName)) then raise Exception.CreateFmt('Game "%s" not found', [AFileName]); FCurrentGame := AFileName; var obj := TJSONObject.Create; try obj.AddPair('type','setGame'); obj.AddPair('payload', TJSONObject.Create.AddPair('currentGame', FCurrentGame)); BroadcastJSON(obj); finally obj.Free; end; end; procedure TGameWebServer.Input(AParams: TJSONObject); var evt: TJSONObject; begin evt := TJSONObject.Create; try evt.AddPair('type', 'input'); evt.AddPair('payload', AParams.Clone as TJSONValue); BroadcastJSON(evt); finally evt.Free; end; end; procedure TGameWebServer.BroadcastJSON(const AJSON: TJSONObject); var s: string; ctx: TIdContext; toRemove: TList; begin s := 'data: ' + AJSON.ToJSON + #13#10#13#10; // CRLF x2 в конце toRemove := TList.Create; try for ctx in FClients do begin try if ctx.Connection.Connected then begin ctx.Connection.IOHandler.Write(s); end else begin toRemove.Add(ctx); end; except toRemove.Add(ctx); end; end; // Удаляем отключенных клиентов for ctx in toRemove do begin FClients.Remove(ctx); end; finally toRemove.Free; end; end; procedure TGameWebServer.HTTPCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); var gamePath, doc, filePath: string; HeartbeatThread: TThread; begin // Добавляем CORS заголовки для всех ответов AResponseInfo.CustomHeaders.Add('Access-Control-Allow-Origin: *'); AResponseInfo.CustomHeaders.Add('Access-Control-Allow-Methods: GET, OPTIONS'); AResponseInfo.CustomHeaders.Add('Access-Control-Allow-Headers: *'); // Обработка CORS preflight запросов if ARequestInfo.Command = 'OPTIONS' then begin AResponseInfo.ResponseNo := 204; // No Content AResponseInfo.ContentText := ''; Exit; end; // КРИТИЧЕСКИ ВАЖНО: предотвращаем закрытие соединения AResponseInfo.CloseConnection := False; // Обработка SSE if SameText(ARequestInfo.URI, '/events') then begin AContext.Connection.IOHandler.WriteLn('HTTP/1.1 200 OK'); AContext.Connection.IOHandler.WriteLn('Content-Type: text/event-stream'); AContext.Connection.IOHandler.WriteLn('Cache-Control: no-cache'); AContext.Connection.IOHandler.WriteLn('Connection: keep-alive'); AContext.Connection.IOHandler.WriteLn('Access-Control-Allow-Origin: *'); AContext.Connection.IOHandler.WriteLn; // Пустая строка - конец заголовков // Добавляем клиента в список FClients.Add(AContext); // Запускаем heartbeat в отдельном потоке HeartbeatThread := TThread.CreateAnonymousThread( procedure begin try while not TThread.CheckTerminated and AContext.Connection.Connected do begin TThread.Sleep(15000); // Каждые 15 секунд // Проверяем соединение перед отправкой if AContext.Connection.Connected then begin AContext.Connection.IOHandler.Write(': heartbeat' + #13#10#13#10); end; end; finally FClients.Remove(AContext); end; end ); HeartbeatThread.FreeOnTerminate := True; HeartbeatThread.Start; // Отправляем начальное сообщение try AContext.Connection.IOHandler.Write('data: {"type":"ready","message":"Connection established"}'#13#10#13#10); except FClients.Remove(AContext); end; Exit; end; // 3. Обработка корневого пути if SameText(ARequestInfo.Document, '/') then begin doc := 'index.html'; end else begin doc := ARequestInfo.Document.Trim(['/']); end; // 4. Обработка файлов игры if FCurrentGame = '' then begin AResponseInfo.ResponseNo := 404; AResponseInfo.ContentText := 'Game not selected'; Exit; end; gamePath := IncludeTrailingPathDelimiter(FRootDir) + 'games' + PathDelim + FCurrentGame; filePath := TPath.Combine(gamePath, doc); if FileExists(filePath) then begin AResponseInfo.ContentStream := TFileStream.Create(filePath, fmOpenRead or fmShareDenyWrite); try if filePath.EndsWith('.html') then AResponseInfo.ContentType := 'text/html; charset=utf-8' else if filePath.EndsWith('.js') then AResponseInfo.ContentType := 'application/javascript; charset=utf-8' else if filePath.EndsWith('.css') then AResponseInfo.ContentType := 'text/css; charset=utf-8' else if filePath.EndsWith('.png') then AResponseInfo.ContentType := 'image/png' else if filePath.EndsWith('.jpg') or filePath.EndsWith('.jpeg') then AResponseInfo.ContentType := 'image/jpeg' else if filePath.EndsWith('.gif') or filePath.EndsWith('.gif') then AResponseInfo.ContentType := 'image/gif' else AResponseInfo.ContentType := 'application/octet-stream'; except AResponseInfo.ContentStream.Free; raise; end; end else begin AResponseInfo.ResponseNo := 404; AResponseInfo.ContentText := 'Not Found: ' + doc; AResponseInfo.ContentType := 'text/plain; charset=utf-8'; end; end; end.