Twitch Messages

unit uWebServerEvents; interface uses Classes, StrUtils, DateUtils, System.JSON, System.Generics.Collections, IdBaseComponent, IdComponent, IdCustomTCPServer, IdContext, IdCustomHTTPServer, uRecords, System.IOUtils, IdGlobalProtocols, IdHTTPServer, System.SysUtils, SyncObjs; type TTTW_Events = class(TObject) private msgStyle: TStyleEvent; fFontsList: TStringList; FMessages: TList; FCriticalSection: TCriticalSection; procedure IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); procedure ProcessFileRequest(ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo; const Folder: string); function GenerateHTML: string; function GenerateJSON: string; procedure CleanupOldMessages; public IdHTTPServer1: TIdHTTPServer; constructor Create(FontList: TStrings; aPort:integer); destructor Destroy; override; procedure addMessage(newMsg: TStyleEvent); procedure ActiveServer(aEn: boolean); end; implementation uses ugeneral; { TTTW_Events } constructor TTTW_Events.Create(FontList: TStrings; aPort:integer); var I: Integer; begin FCriticalSection := TCriticalSection.Create; FMessages := TList.Create; fFontsList := TStringList.Create; fFontsList.Assign(FontList); IdHTTPServer1 := TIdHTTPServer.Create(nil); IdHTTPServer1.DefaultPort := aPort; IdHTTPServer1.OnCommandGet := IdHTTPServer1CommandGet; end; destructor TTTW_Events.Destroy; begin FCriticalSection.Free; FMessages.Free; fFontsList.Free; IdHTTPServer1.Free; inherited; end; procedure TTTW_Events.addMessage(newMsg: TStyleEvent); begin FCriticalSection.Enter; try FMessages.Add(newMsg); CleanupOldMessages; finally FCriticalSection.Leave; end; end; procedure TTTW_Events.CleanupOldMessages; var I: Integer; TimeNow: TDateTime; begin TimeNow := Now; FCriticalSection.Enter; try for I := FMessages.Count - 1 downto 0 do begin if SecondsBetween(TimeNow, FMessages[I].Timestamp) >= FMessages[I].TimeMsg then FMessages.Delete(I); end; finally FCriticalSection.Leave; end; end; function TTTW_Events.GenerateHTML: string; var I: Integer; s, s1: string; begin // Генерация CSS для шрифтов s := 'body { background: #00FF00; }' + #13#10; for I := 41 to fFontsList.Count - 1 do begin s1 := StringReplace(fFontsList[I], '.ttf', '', [rfReplaceAll]); s := s + Format('@font-face { font-family: ''%s''; src: url(fonts/%s); }', [s1, fFontsList[I]]) + #13#10; end; Result := '' + '' + '' + '' + 'Twitch Messages' + '' + '' + '' + '' + '

' + ''; end; function TTTW_Events.GenerateJSON: string; var JSONArray: TJSONArray; I: Integer; S,S1:STRING; Msg: TStyleEvent; begin JSONArray := TJSONArray.Create; try FCriticalSection.Enter; try CleanupOldMessages; for I := 0 to FMessages.Count - 1 do begin Msg := FMessages[I]; s:=StringReplace(Msg.FontTitle.Font,'.ttf','',[rfReplaceAll]); s1:=StringReplace(Msg.FontContext.Font,'.ttf','',[rfReplaceAll]); JSONArray.AddElement(TJSONObject.Create .AddPair('nickname', Msg.Title) .AddPair('url', Msg.Url) .AddPair('content', Msg.Context) .AddPair('timestamp', TJSONNumber.Create(DateTimeToUnix(Msg.Timestamp))) .AddPair('sound', Msg.SoundURL) .AddPair('duration', Msg.TimeMsg) .AddPair('color', Msg.BlockColor) .AddPair('colorBorder', Msg.BorderColor) .AddPair('sizeBorder', TJSONNumber.Create(Msg.BorderSize)) .AddPair('fontSize', TJSONNumber.Create(Msg.FontTitle.size)) .AddPair('titlecolor', Msg.FontTitle.Color) .AddPair('titlefamily', s) .AddPair('titleSize', TJSONNumber.Create(Msg.FontTitle.Size)) .AddPair('contentcolor', Msg.FontContext.Color) .AddPair('contentfamily', s1) .AddPair('contentSize', TJSONNumber.Create(Msg.FontContext.Size)) ); // Фиксированный размер текста end; finally FCriticalSection.Leave; end; Result := JSONArray.ToString; finally JSONArray.Free; end; end; procedure TTTW_Events.ProcessFileRequest(ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo; const Folder: string); var FileName: string; FilePath: string; FS: TFileStream; begin FileName := TPath.GetFileName(ARequestInfo.Document); FilePath := myConst.AppDataPath + Folder + '\' + FileName; if FileExists(FilePath) then begin try FS := TFileStream.Create(FilePath, fmOpenRead + fmShareDenyWrite); AResponseInfo.ContentStream := FS; AResponseInfo.ContentType := GetMIMETypeFromFile(FilePath);; AResponseInfo.ResponseNo := 200; except FS.Free; AResponseInfo.ResponseNo := 500; end; end else begin AResponseInfo.ResponseNo := 404; end; end; procedure TTTW_Events.IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); begin if ARequestInfo.Document = '/' then begin AResponseInfo.CacheControl := 'no-cache, no-store, must-revalidate'; AResponseInfo.Pragma := 'no-cache'; AResponseInfo.Expires := 0; AResponseInfo.ContentType := 'text/html'; AResponseInfo.ContentText := GenerateHTML; end else if ARequestInfo.Document = '/messages' then begin AResponseInfo.ContentType := 'application/json; charset=utf-8'; AResponseInfo.ContentText := GenerateJSON; end else if ARequestInfo.Document.StartsWith('/sounds/') then begin ProcessFileRequest(ARequestInfo, AResponseInfo, 'sounds'); end else if ARequestInfo.Document.StartsWith('/fonts/') then begin ProcessFileRequest(ARequestInfo, AResponseInfo, 'fonts'); end else if ARequestInfo.Document.StartsWith('/imgs/') then begin ProcessFileRequest(ARequestInfo, AResponseInfo, 'imgs'); end else AResponseInfo.ResponseNo := 404; end; procedure TTTW_Events.ActiveServer(aEn: boolean); begin IdHTTPServer1.Active := aEn; end; end.