Twitch Messages

unit uWebServerEvents; interface uses System.Classes, System.StrUtils, System.DateUtils, System.JSON, System.Generics.Collections, IdBaseComponent, IdComponent, IdCustomTCPServer, IdContext, IdCustomHTTPServer, uRecords, System.IOUtils, IdGlobalProtocols, IdHTTPServer, System.SysUtils, System.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 FreeAndNil(FCriticalSection); 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; for I := FMessages.Count - 1 downto 0 do if SecondsBetween(TimeNow, FMessages[I].Timestamp) >= FMessages[I].TimeMsg then FMessages.Delete(I); 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; Msg: TStyleEvent; begin JSONArray := TJSONArray.Create; try CleanupOldMessages; FCriticalSection.Enter; try for I := 0 to FMessages.Count - 1 do begin Msg := FMessages[I]; 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', TPath.GetFileNameWithoutExtension(Msg.FontTitle.Font)) .AddPair('titleSize', TJSONNumber.Create(Msg.FontTitle.Size)) .AddPair('contentcolor', Msg.FontContext.Color) .AddPair('contentfamily', TPath.GetFileNameWithoutExtension(Msg.FontContext.Font)) .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; AResponseInfo.FreeContentStream := True; 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.