unit uWebServerKandinsky; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, System.NetEncoding,IdContext, IdCustomHTTPServer, IdHTTPServer, IdGlobal, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Edit, FMX.Controls.Presentation, FMX.StdCtrls, uKandinskyAPI, FMX.Memo.Types, System.json, FMX.ScrollBox, FMX.Memo, System.IOUtils, System.SyncObjs,System.DateUtils; type TKandinsky_Web = class(TObject) IdHTTPServer1: TIdHTTPServer; procedure IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); private FCriticalSection: TCriticalSection; FCurrentImage: string; FImageTime: TDateTime; FCurrentText: string; ka:TFusionBrainAPI; function GenerateHTML: string; function GenerateJSON: string; procedure CleanupOldMessages; procedure GenerationDone(Sender: TObject; const FileName: string); procedure GenerationError(Sender: TObject; const ErrorMessage: string); procedure GenerationUpdate(Sender: TObject; const Message: string); public constructor Create(aKey:string; aSecret:string; aPort:integer); destructor Destroy; procedure generate(prompt:string; aNick:string); procedure ActiveServer(aEn: boolean); end; implementation { TKandinsky_Web } procedure TKandinsky_Web.ActiveServer(aEn: boolean); begin IdHTTPServer1.Active :=aEn; end; procedure TKandinsky_Web.CleanupOldMessages; begin if FileExists(FCurrentImage) then begin DeleteFile(FCurrentImage); end; end; constructor TKandinsky_Web.Create(aKey:string; aSecret:string; aPort:integer); begin IdHTTPServer1 := TIdHTTPServer.Create; IdHTTPServer1.DefaultPort := aPort; IdHTTPServer1.OnCommandGet := IdHTTPServer1CommandGet; ka:=TFusionBrainAPI.Create(nil,aKey, aSecret); ka.OnGenerationDone := GenerationDone; ka.OnStatusUpdate:=GenerationUpdate; ka.OnError:=GenerationError; FCriticalSection:=TCriticalSection.Create; //flog.toLog(0,'uWebServerKandinsky','Create','Веб сервер запущен'); end; destructor TKandinsky_Web.Destroy; begin IdHTTPServer1.Active := False; FreeAndNil(FCriticalSection); CleanupOldMessages; end; procedure TKandinsky_Web.generate(prompt: string; aNick:string); begin //flog.toLog(0,'uWebServerKandinsky','generate','Новый запрос на генерацию'); FCriticalSection.Enter; try FCurrentText := aNick; finally FCriticalSection.Leave; end; ka.StartGeneration(prompt); //flog.toLog(0,'uWebServerKandinsky','generate','Запрос на генерацию отправлен'); end; function TKandinsky_Web.GenerateHTML: string; begin Result := '' + '' + '' + '' + '' + '' + '' + '

' + ' ' + // Начальное состояние hidden ' ' + // Начальное состояние hidden '

' + '' + ''; end; function TKandinsky_Web.GenerateJSON: string; var JSONObject: TJSONObject; begin JSONObject := TJSONObject.Create; try FCriticalSection.Enter; try // Изменили условие проверки времени if FileExists(FCurrentImage) and (SecondsBetween(Now, FImageTime) <= 5) then begin JSONObject.AddPair('imageUrl', '/image?' + IntToStr(DateTimeToUnix(FImageTime))); // Используем время генерации JSONObject.AddPair('text', FCurrentText) end else begin JSONObject.AddPair('imageUrl', ''); JSONObject.AddPair('text', ''); end; finally FCriticalSection.Leave; end; Result := JSONObject.ToString; finally JSONObject.Free; end; end; procedure TKandinsky_Web.GenerationDone(Sender: TObject; const FileName: string); begin TThread.Queue(nil, procedure begin FCriticalSection.Enter; try CleanupOldMessages; FCurrentImage := FileName; FImageTime := Now; //flog.toLog(0,'uWebServerKandinsky','GenerationDone','Файл картинки создан'); finally FCriticalSection.Leave; end; end); end; procedure TKandinsky_Web.GenerationError(Sender: TObject; const ErrorMessage: string); begin //flog.toLog(2,'uWebServerKandinsky','GenerationError',ErrorMessage); end; procedure TKandinsky_Web.GenerationUpdate(Sender: TObject; const Message: string); begin // flog.toLog(0,'uWebServerKandinsky','GenerationUpdate',Message); end; procedure TKandinsky_Web.IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); var FilePath: string; begin FCriticalSection.Enter; try if ARequestInfo.Document = '/' then begin AResponseInfo.ContentType := 'text/html'; AResponseInfo.ContentText := GenerateHTML; end else if ARequestInfo.Document = '/image' then begin if FileExists(FCurrentImage) and (SecondsBetween(Now, FImageTime) <= 5) then begin AResponseInfo.ContentType := 'image/jpeg'; AResponseInfo.ContentStream := TFileStream.Create(FCurrentImage, fmOpenRead); end else AResponseInfo.ResponseNo := 404; end else if ARequestInfo.Document = '/image-data' then begin AResponseInfo.ContentType := 'application/json'; AResponseInfo.ContentText := GenerateJSON; end else AResponseInfo.ResponseNo := 404; finally FCriticalSection.Leave; end; end; end.