diff --git a/TTW_Bot_app.dpr b/TTW_Bot_app.dpr index 2ec8337..b7446f5 100644 --- a/TTW_Bot_app.dpr +++ b/TTW_Bot_app.dpr @@ -33,7 +33,6 @@ uses uTTWEventSub in 'Services\uTTWEventSub.pas', uTTWIRC in 'Services\uTTWIRC.pas', uTWAuth in 'Services\uTWAuth.pas', - uWebServerKandinsky in 'Services\uWebServerKandinsky.pas', uWSDA in 'Services\uWSDA.pas', uDataBase in 'utils\uDataBase.pas', uMyTimer in 'utils\uMyTimer.pas', @@ -44,7 +43,9 @@ uses uTTS in 'utils\uTTS.pas', fPlayerWeb in 'frames\fPlayerWeb.pas' {frPlayerWeb: TFrame}, uPlayerThread in 'utils\uPlayerThread.pas', - uWebServerChat in 'utils\uWebServerChat.pas'; + uWebServerChat in 'utils\uWebServerChat.pas', + uWebServerKandinsky in 'utils\uWebServerKandinsky.pas', + uWebServerEvents in 'utils\uWebServerEvents.pas'; {$R *.res} diff --git a/TTW_Bot_app.dproj b/TTW_Bot_app.dproj index bae77af..17f9045 100644 --- a/TTW_Bot_app.dproj +++ b/TTW_Bot_app.dproj @@ -411,7 +411,6 @@ - @@ -431,6 +430,8 @@ + + Base diff --git a/forms/uCreateNotify.fmx b/forms/uCreateNotify.fmx index 36b84bd..81b5965 100644 --- a/forms/uCreateNotify.fmx +++ b/forms/uCreateNotify.fmx @@ -146,7 +146,7 @@ object fCreateNotify: TfCreateNotify Position.X = 8.000000000000000000 Position.Y = 135.000000000000000000 Text = #1057#1086#1073#1099#1090#1080#1077 - TabOrder = 42 + TabOrder = 37 end object cbEventsType: TComboBox Items.Strings = ( @@ -160,7 +160,7 @@ object fCreateNotify: TfCreateNotify Size.Width = 192.000000000000000000 Size.Height = 22.000000000000000000 Size.PlatformDefault = False - TabOrder = 43 + TabOrder = 38 OnChange = cbEventsTypeChange end object Label3: TLabel @@ -168,11 +168,11 @@ object fCreateNotify: TfCreateNotify Position.Y = 190.000000000000000000 Text = #1059#1089#1083#1086#1074#1080#1077' '#1089#1091#1084#1084#1099 Visible = False - TabOrder = 44 + TabOrder = 39 end object edtIF: TEdit Touch.InteractiveGestures = [LongTap, DoubleTap] - TabOrder = 45 + TabOrder = 40 Position.X = 8.000000000000000000 Position.Y = 215.000000000000000000 Size.Width = 192.000000000000000000 @@ -198,6 +198,7 @@ object fCreateNotify: TfCreateNotify TabOrder = 59 Text = #1058#1077#1089#1090 TextSettings.Trimming = None + OnClick = btnESTestClick end object GroupBox1: TGroupBox Padding.Left = 10.000000000000000000 @@ -227,6 +228,9 @@ object fCreateNotify: TfCreateNotify Size.Width = 241.000000000000000000 Size.Height = 115.000000000000000000 Size.PlatformDefault = False + inherited Label41: TLabel + TabOrder = 5 + end inherited ccbFontColor: TColorComboBox TabOrder = 36 end @@ -255,6 +259,9 @@ object fCreateNotify: TfCreateNotify Size.Width = 241.000000000000000000 Size.Height = 115.000000000000000000 Size.PlatformDefault = False + inherited Label41: TLabel + TabOrder = 5 + end inherited ccbFontColor: TColorComboBox TabOrder = 36 end diff --git a/forms/uCreateNotify.pas b/forms/uCreateNotify.pas index ac877ae..43cf9b6 100644 --- a/forms/uCreateNotify.pas +++ b/forms/uCreateNotify.pas @@ -4,7 +4,7 @@ interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, - System.Variants, + System.Variants, fOBS, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, fFontSettings, fColorSettings, FMX.StdCtrls, FMX.Edit, FMX.Controls.Presentation, FMX.ListBox, FMX.EditBox, FMX.SpinBox, FMX.Colors, uRecords; @@ -39,9 +39,11 @@ type procedure btnCreateEventClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure cbEventsTypeChange(Sender: TObject); + procedure btnESTestClick(Sender: TObject); private { Private declarations } function GetColorFromColorPanel(aColor: TAlphaColor): string; + function GetColorFromCCB(aColor: TAlphaColor): string; public { Public declarations } isEdit: boolean; @@ -155,6 +157,48 @@ begin close; end; + + +function TfCreateNotify.GetColorFromCCB(aColor: TAlphaColor): string; +var + Color: TAlphaColor; + r, G, B: Byte; +begin + Color := aColor; + r := TAlphaColorRec(Color).r; + G := TAlphaColorRec(Color).G; + B := TAlphaColorRec(Color).B; + result := Format('#%.2X%.2X%.2X', [r, G, B]); +end; + +procedure TfCreateNotify.btnESTestClick(Sender: TObject); +var + se: TStyleEvent; + i: Integer; +begin + + se.Title := edtESTitle.Text; + se.Context := edtESMessage.Text; + se.Url := edtESImage.Text; + se.SoundURL := edtESSound.Text; + se.Timestamp := Now; + se.TimeMsg := round(sbTimeMsg.Value); + se.BorderColor := GetColorFromCCB(frColorSettings1.ccbStyleBorderColor.Color); + se.BorderSize := round(frColorSettings1.sbStyleBlockBorderSize.Value); + se.BlockColor := GetColorFromColorPanel(frColorSettings1.cpStyleBlockColor.Color); + se.FontTitle.Font := frFontSettings2.cbFontStyleDefault.Text; + se.FontTitle.Size := round(frFontSettings2.sbFontSize.Value); + se.FontTitle.Color := GetColorFromCCB(frFontSettings2.ccbFontColor.Color); + se.FontContext.Font := frFontSettings3.cbFontStyleDefault.Text; + se.FontContext.Size := round(frFontSettings3.sbFontSize.Value); + se.FontContext.Color := GetColorFromCCB(frFontSettings3.ccbFontColor.Color); + se.RequireInteraction := True; + for i := 0 to TTW_Bot.frOBS1.EventWebServers.Count - 1 do + begin + TTW_Bot.frOBS1.EventWebServers[i].WebServerChat.AddMessage(se); + end; +end; + procedure TfCreateNotify.cbEventsTypeChange(Sender: TObject); begin Label3.Visible := cbEventsType.ItemIndex = 4; diff --git a/forms/uGeneral.pas b/forms/uGeneral.pas index 321729f..6c7e022 100644 --- a/forms/uGeneral.pas +++ b/forms/uGeneral.pas @@ -249,10 +249,10 @@ begin ttw_ES.OnStatus := ESStatus; // ttw_ES.OnRAW := fRewards.ESOnRAW; // ttw_ES.OnSubOk := fRewards.ESOnSubOk; - // ttw_ES.OnFollow := fWebServerEvents.ESOnFollow; - // ttw_ES.OnSub := fWebServerEvents.ESOnSub; - // ttw_ES.OnGift := fWebServerEvents.ESOnGift; - // ttw_ES.OnRaid := fWebServerEvents.ESOnRaid; } + ttw_ES.OnFollow := frOBS1.toEventWebServer; + ttw_ES.OnSub := frOBS1.toEventWebServer; + ttw_ES.OnGift := frOBS1.toEventWebServer; + ttw_ES.OnRaid := frOBS1.toEventWebServer; toLog('uGeneral', 'ConnectProcedure.ttw_ES', 'Создан', 0); ttw_ES.Connect; except @@ -496,7 +496,7 @@ begin frOBS1.ChatBadges.Free; frOBS1.ChatEmotes.Free; frOBS1.ChatWebServers.Free; - +frOBS1.EventWebServers.Free; DisconnectProcedure; if Assigned(ttw_IRS) then @@ -1063,6 +1063,11 @@ procedure TTTW_Bot.ReadDB; end; db.LoadRecordArray('listNotify', frOBS1.listNotify); + frOBS1.EventWebServers := TList.Create; + for I := 0 to High(frOBS1.listNotify) do + begin + frOBS1.CreateWebEvents(frOBS1.listNotify[I]); + end; db.LoadRecordArray('listKandinsky', frOBS1.listKandinsky); frOBS1.UpdateGridFromArray; end; diff --git a/frames/fOBS.pas b/frames/fOBS.pas index 1a9f6f7..89c4d87 100644 --- a/frames/fOBS.pas +++ b/frames/fOBS.pas @@ -4,7 +4,8 @@ interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, uCustomEmoties, - System.Variants, uWebServerChat, fColorSettings, System.Generics.Collections, + System.Variants, uWebServerChat, uWebServerEvents, fColorSettings, + System.Generics.Collections, FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls, System.Rtti, FMX.Grid.Style, FMX.Grid, FMX.ScrollBox, FMX.Edit, FMX.Colors, FMX.ListBox, FMX.EditBox, FMX.SpinBox, FMX.Controls.Presentation, uRecords, @@ -27,6 +28,13 @@ type WebServerChat: TTTW_Chat; end; +type + TEventWebServers = record + port: integer; + se: TStyleEvent; + WebServerChat: TTTW_Events; + end; + type TfrOBS = class(TFrame) sgWebChats: TStringGrid; @@ -62,7 +70,15 @@ type ChatBadges: Tlist; ChatEmotes: Tlist; ChatWebServers: Tlist; + EventWebServers: Tlist; procedure MsgToWebServer(const aRecord: TTwitchChatMessage); + procedure toEventWebServer(CustomReward: TFollowEvent); overload; // follow + procedure toEventWebServer(CustomReward: TSubEvent); overload; // sub + procedure toEventWebServer(CustomReward: TRaidEvent); overload; // raid + procedure toEventWebServer(CustomReward: TGiftEvent); overload; // gift + procedure toEventWebServer(aNick, aSum, aText: string); overload; // donate + procedure CreateWebEvents(eventsSettings: TOBSNotify); + procedure CreateWebChat(chatSettings: TOBSChat); procedure UpdateGridFromArray; procedure AddChat(newRecord: TOBSChat); @@ -117,7 +133,6 @@ begin end; end; - function TfrOBS.GetBadgesHTML(Badges: string): string; var BadgeList: TArray; @@ -201,23 +216,23 @@ begin end; end; - -function TfrOBS.ReplaceEmotesInMessage(const MessageText, EmotesString: string): string; +function TfrOBS.ReplaceEmotesInMessage(const MessageText, + EmotesString: string): string; var ProcessedEmotes: TDictionary; - Parts: TStringList; - i, ColonPos: Integer; + Parts: tstringlist; + i, ColonPos: integer; EmoteID: string; Emote: TEmotes; ResultText: string; begin - Result := MessageText; + result := MessageText; if EmotesString.Trim = '' then Exit; // Èñïîëüçóåì ñëîâàðü äëÿ îòñëåæèâàíèÿ óæå îáðàáîòàííûõ ýìîäçè ProcessedEmotes := TDictionary.Create; - Parts := TStringList.Create; + Parts := tstringlist.Create; try // Ðàçäåëÿåì îáùóþ ñòðîêó ñìàéëîâ ïî '/' Parts.StrictDelimiter := True; @@ -245,7 +260,8 @@ begin if Emote.ID = '' then Continue; - var imgUrl: string; + var + imgUrl: string; if Emote.topImage <> '' then imgUrl := Emote.topImage else if Emote.images.Url4x <> '' then @@ -254,25 +270,21 @@ begin Continue; // Ïðîïóñêàåì åñëè íåò URL // Çàìåíÿåì âñå âõîæäåíèÿ èìåíè ýìîäçè - ResultText := StringReplace( - ResultText, - Emote.name, + ResultText := StringReplace(ResultText, Emote.name, Format('', [imgUrl]), - [rfReplaceAll] - ); + [rfReplaceAll]); // Ïîìå÷àåì ýìîäçè êàê îáðàáîòàííûé ProcessedEmotes.Add(EmoteID, ''); end; - Result := ResultText; + result := ResultText; finally ProcessedEmotes.Free; Parts.Free; end; end; - procedure TfrOBS.AddChat(newRecord: TOBSChat); begin SetLength(listChats, Length(listChats) + 1); @@ -296,6 +308,7 @@ begin listNotify[High(listNotify)] := newRecord; UpdateGridFromArray; db.SaveRecordArray('listNotify', listNotify); + CreateWebEvents(newRecord); end; procedure TfrOBS.btnCreateOBSChatClick(Sender: TObject); @@ -382,7 +395,7 @@ var repeat if (SearchRec.Attr and faAnyFile) = SearchRec.Attr then begin - mySL.Add(SearchRec.Name); + mySL.Add(SearchRec.name); Inc(n); end; until FindNext(SearchRec) <> 0; @@ -426,6 +439,90 @@ begin end; end; +procedure TfrOBS.CreateWebEvents(eventsSettings: TOBSNotify); +var + EventWebServer: TEventWebServers; + fonts: tstringlist; + f: TfrColorSettings; + t: TfrFontSettings; + procedure LoadFontList(const mySL: tstringlist); + var + SearchRec: TSearchRec; + n: integer; + begin + if not DirectoryExists(myConst.fontsPath) then + CreateDir(myConst.fontsPath); + + n := 1; + if FindFirst(IncludeTrailingPathDelimiter(myConst.fontsPath) + '*.*', + faArchive, SearchRec) = 0 then + try + repeat + if (SearchRec.Attr and faAnyFile) = SearchRec.Attr then + begin + mySL.Add(SearchRec.name); + Inc(n); + end; + until FindNext(SearchRec) <> 0; + finally + System.SysUtils.FindClose(SearchRec); + end; + end; + + function GetColorFromColorPanel(aColor: TAlphaColor): string; +var + Color: TAlphaColor; + r, G, B: Byte; + A: Real; + FS: TFormatSettings; +begin + Color := aColor; + r := TAlphaColorRec(Color).r; + G := TAlphaColorRec(Color).G; + B := TAlphaColorRec(Color).B; + A := TAlphaColorRec(Color).A / 255; // Ïðåîáðàçóåì àëüôà-êàíàë â äèàïàçîí 0..1 + + // Óñòàíàâëèâàåì òî÷êó â êà÷åñòâå äåñÿòè÷íîãî ðàçäåëèòåëÿ + FS := TFormatSettings.Create; + FS.DecimalSeparator := '.'; + + result := Format('rgba(%d, %d, %d, %.2f)', [r, G, B, A], FS); +end; + +begin + fonts := tstringlist.Create; + f := TfrColorSettings.Create(self); + t := TfrFontSettings.Create(self); + try + LoadFontList(fonts); + EventWebServer.WebServerChat := TTTW_Events.Create(fonts,eventsSettings.port); + EventWebServer.port := eventsSettings.port; + + EventWebServer.se.title := eventsSettings.HeaderText; + EventWebServer.se.Context:=eventsSettings.MessText; + EventWebServer.se.Url:=eventsSettings.Picture; + EventWebServer.se.SoundURL:=eventsSettings.Sound; + EventWebServer.se.Timestamp:=now; + EventWebServer.se.TimeMsg:=eventsSettings.TimeMess; + EventWebServer.se.FontTitle.Font:= t.cbFontStyleDefault.Items[eventsSettings.HeaderStyleFont]; + EventWebServer.se.FontTitle.Size:=eventsSettings.HeaderSizeFont; + EventWebServer.se.FontTitle.Color:=t.ccbFontColor.Items[eventsSettings.HeaderColorFont]; + EventWebServer.se.FontContext.Font:= t.cbFontStyleDefault.Items[eventsSettings.MessStyleFont]; + EventWebServer.se.FontContext.Size:=eventsSettings.MessSizeFont; + EventWebServer.se.FontContext.Color:=t.ccbFontColor.Items[eventsSettings.MessColorFont]; + EventWebServer.se.BorderColor:=f.ccbStyleBorderColor.Items[eventsSettings.ColorBorder]; + EventWebServer.se.BorderSize:=eventsSettings.SolidBorder; + EventWebServer.se.BlockColor:=GetColorFromColorPanel(f.cpStyleBlockColor.Color); + + EventWebServers.Add(EventWebServer); + EventWebServers[EventWebServers.Count - 1].WebServerChat.ActiveServer(True); + finally + fonts.Free; + f.Free; + t.Free; + end; +end; + procedure TfrOBS.DelChat(aPort: integer); var i, j: integer; @@ -526,15 +623,18 @@ begin chatWeb.MaxMsg := newRecord.MaxCountMess; chatWeb.TimeMsg := newRecord.TimeMess; chatWeb.Freez := newRecord.Freez = 1; - chatWeb.StyleBorderColor := f.ccbStyleBorderColor.Items[newRecord.ColorBorder]; + chatWeb.StyleBorderColor := f.ccbStyleBorderColor.Items + [newRecord.ColorBorder]; chatWeb.StyleBlockColor := newRecord.ColorBlock; chatWeb.StyleBlockBorderSize := newRecord.SolidBorder; chatWeb.StyleBlockPadding := newRecord.Paddings; - chatWeb.FontStyleDefault := t.cbFontStyleDefault.Items[newRecord.StyleFont]; + chatWeb.FontStyleDefault := t.cbFontStyleDefault.Items + [newRecord.StyleFont]; chatWeb.FontColor := t.ccbFontColor.Items[newRecord.ColorFont]; chatWeb.FontSize := newRecord.SizeFont; chatWeb.BColor := f.ccbBColor.Items[newRecord.ColorBackground]; - chatWeb.WebServerChat.changeBackground(f.ccbBColor.Items[newRecord.ColorBackground]); + chatWeb.WebServerChat.changeBackground + (f.ccbBColor.Items[newRecord.ColorBackground]); chatWeb.WebServerChat.SetDeleteMode(not chatWeb.Freez, chatWeb.MaxMsg); // 4. Âîçâðàùàåì ìîäèôèöèðîâàííóþ çàïèñü â ñïèñîê @@ -572,7 +672,7 @@ var begin result.ID := ''; if not Assigned(ChatEmotes) then - exit; + Exit; for i := 0 to ChatEmotes.Count - 1 do if ChatEmotes[i].ID = ID then @@ -583,7 +683,7 @@ begin end; procedure TfrOBS.sgWebChatsCellDblClick(const Column: TColumn; -const Row: integer); + const Row: integer); var myChatRec: TOBSChat; myNotifyRec: TOBSNotify; @@ -616,6 +716,346 @@ begin end; end; +procedure TfrOBS.toEventWebServer(CustomReward: TFollowEvent); +var + se: TStyleEvent; + i, j: integer; + f: TfrColorSettings; + t: TfrFontSettings; + notify: TOBSNotify; +begin + f := TfrColorSettings.Create(self); + t := TfrFontSettings.Create(self); + try + for i := 0 to high(listNotify) do + begin + if listNotify[i].TypeEvent = 0 then + begin + notify := listNotify[i]; + se.Title := notify.HeaderText; + se.Title := StringReplace(se.Title, '[NICK]', + CustomReward.event.user_name, [rfReplaceAll]); + se.Context := notify.MessText; + se.Url := notify.Picture; + se.SoundURL := notify.Sound; + se.Timestamp := Now; + se.TimeMsg := notify.TimeMess; + se.BorderColor := f.ccbStyleBorderColor.Items[notify.ColorBorder]; + se.BorderSize := notify.SolidBorder; + se.BlockColor := notify.ColorBlock; + se.FontTitle.Font := t.cbFontStyleDefault.Items[notify.HeaderStyleFont]; + se.FontTitle.Size := notify.HeaderSizeFont; + se.FontTitle.Color := t.ccbFontColor.Items[notify.HeaderColorFont]; + se.FontContext.Font := t.cbFontStyleDefault.Items[notify.MessSizeFont]; + se.FontContext.Size := notify.MessSizeFont; + se.FontContext.Color := t.ccbFontColor.Items[notify.MessColorFont]; + se.RequireInteraction := True; + for j := 0 to EventWebServers.Count - 1 do + begin + EventWebServers[j].WebServerChat.AddMessage(se); + end; + end; + + end; + + finally + f.Free; + t.Free; + end; +end; + +procedure TfrOBS.toEventWebServer(CustomReward: TSubEvent); +var + se: TStyleEvent; + i, j: integer; + f: TfrColorSettings; + t: TfrFontSettings; + notify: TOBSNotify; +begin + f := TfrColorSettings.Create(self); + t := TfrFontSettings.Create(self); + try + for i := 0 to high(listNotify) do + begin + if listNotify[i].TypeEvent = 1 then + begin + notify := listNotify[i]; + se.Title := notify.HeaderText; + se.Title := StringReplace(se.Title, '[NICK]', + CustomReward.event.user_name, [rfReplaceAll]); + se.Context := notify.MessText; + + se.Url := notify.Picture; + se.SoundURL := notify.Sound; + se.Timestamp := Now; + se.TimeMsg := notify.TimeMess; + se.BorderColor := f.ccbStyleBorderColor.Items[notify.ColorBorder]; + se.BorderSize := notify.SolidBorder; + se.BlockColor := notify.ColorBlock; + se.FontTitle.Font := t.cbFontStyleDefault.Items[notify.HeaderStyleFont]; + se.FontTitle.Size := notify.HeaderSizeFont; + se.FontTitle.Color := t.ccbFontColor.Items[notify.HeaderColorFont]; + se.FontContext.Font := t.cbFontStyleDefault.Items[notify.MessSizeFont]; + se.FontContext.Size := notify.MessSizeFont; + se.FontContext.Color := t.ccbFontColor.Items[notify.MessColorFont]; + se.RequireInteraction := True; + for j := 0 to EventWebServers.Count - 1 do + begin + EventWebServers[j].WebServerChat.AddMessage(se); + end; + end; + + end; + + finally + f.Free; + t.Free; + end; +end; + +procedure TfrOBS.toEventWebServer(CustomReward: TRaidEvent); +var + se: TStyleEvent; + i, j: integer; + f: TfrColorSettings; + t: TfrFontSettings; + notify: TOBSNotify; +begin + f := TfrColorSettings.Create(self); + t := TfrFontSettings.Create(self); + try + for i := 0 to high(listNotify) do + begin + if listNotify[i].TypeEvent = 3 then + begin + notify := listNotify[i]; + se.Title := notify.HeaderText; + se.Title := StringReplace(se.Title, '[NICK]', + CustomReward.event.from_broadcaster_user_name, [rfReplaceAll]); + se.Context := notify.MessText; + se.Context := StringReplace(se.Context, '[SUM]', + inttostr(CustomReward.event.viewers), [rfReplaceAll]); + se.Url := notify.Picture; + se.SoundURL := notify.Sound; + se.Timestamp := Now; + se.TimeMsg := notify.TimeMess; + se.BorderColor := f.ccbStyleBorderColor.Items[notify.ColorBorder]; + se.BorderSize := notify.SolidBorder; + se.BlockColor := notify.ColorBlock; + se.FontTitle.Font := t.cbFontStyleDefault.Items[notify.HeaderStyleFont]; + se.FontTitle.Size := notify.HeaderSizeFont; + se.FontTitle.Color := t.ccbFontColor.Items[notify.HeaderColorFont]; + se.FontContext.Font := t.cbFontStyleDefault.Items[notify.MessSizeFont]; + se.FontContext.Size := notify.MessSizeFont; + se.FontContext.Color := t.ccbFontColor.Items[notify.MessColorFont]; + se.RequireInteraction := True; + for j := 0 to EventWebServers.Count - 1 do + begin + EventWebServers[j].WebServerChat.AddMessage(se); + end; + end; + + end; + + finally + f.Free; + t.Free; + end; +end; + +procedure TfrOBS.toEventWebServer(CustomReward: TGiftEvent); +var + se: TStyleEvent; + i, j: integer; + f: TfrColorSettings; + t: TfrFontSettings; + notify: TOBSNotify; +begin + f := TfrColorSettings.Create(self); + t := TfrFontSettings.Create(self); + try + for i := 0 to high(listNotify) do + begin + if listNotify[i].TypeEvent = 2 then + begin + notify := listNotify[i]; + se.Title := notify.HeaderText; + se.Title := StringReplace(se.Title, '[NICK]', + CustomReward.event.user_name, [rfReplaceAll]); + se.Context := notify.MessText; + se.Url := notify.Picture; + se.SoundURL := notify.Sound; + se.Timestamp := Now; + se.TimeMsg := notify.TimeMess; + se.BorderColor := f.ccbStyleBorderColor.Items[notify.ColorBorder]; + se.BorderSize := notify.SolidBorder; + se.BlockColor := notify.ColorBlock; + se.FontTitle.Font := t.cbFontStyleDefault.Items[notify.HeaderStyleFont]; + se.FontTitle.Size := notify.HeaderSizeFont; + se.FontTitle.Color := t.ccbFontColor.Items[notify.HeaderColorFont]; + se.FontContext.Font := t.cbFontStyleDefault.Items[notify.MessSizeFont]; + se.FontContext.Size := notify.MessSizeFont; + se.FontContext.Color := t.ccbFontColor.Items[notify.MessColorFont]; + se.RequireInteraction := True; + for j := 0 to EventWebServers.Count - 1 do + begin + EventWebServers[j].WebServerChat.AddMessage(se); + end; + end; + + end; + + finally + f.Free; + t.Free; + end; + +end; + +procedure TfrOBS.toEventWebServer(aNick, aSum, aText: string); +var + i, j: integer; + aSumInt: integer; + BestRow: integer; + BestPriority: integer; + BestValue: integer; + Condition: string; + CurrentPriority: integer; + CurrentValue: integer; + MinVal, MaxVal: integer; + Parts: tstringlist; + se: TStyleEvent; + notify: TOBSNotify; + f: TfrColorSettings; + t: TfrFontSettings; +begin + aSumInt := StrToIntDef(aSum, 0); + BestRow := -1; + BestPriority := -1; + BestValue := 0; + + for i := 0 to high(listNotify) do + begin + if listNotify[i].TypeEvent = 4 then + begin + Condition := Trim(listNotify[i].TypeEdit); + + if Condition = '' then + Continue; + + CurrentPriority := -1; + CurrentValue := 0; + + // Ïðîâåðêà íà òî÷íîå çíà÷åíèå + if Pos('-', Condition) = 0 then + begin + if Pos('>', Condition) = 0 then + begin + if Pos('<', Condition) = 0 then + begin + // Òî÷íîå çíà÷åíèå + CurrentValue := StrToIntDef(Condition, -1); + if aSumInt = CurrentValue then + CurrentPriority := 4; + end; + end; + end; + + if CurrentPriority = -1 then + begin + if Pos('-', Condition) > 0 then + begin + // Äèàïàçîí + Parts := tstringlist.Create; + try + Parts.Delimiter := '-'; + Parts.StrictDelimiter := True; + Parts.DelimitedText := Condition; + if Parts.Count = 2 then + begin + MinVal := StrToIntDef(Trim(Parts[0]), 0); + MaxVal := StrToIntDef(Trim(Parts[1]), 0); + if (aSumInt >= MinVal) and (aSumInt <= MaxVal) then + begin + CurrentPriority := 3; + CurrentValue := MinVal; // Ïðèîðèòåò ïî MinVal + end; + end; + finally + Parts.Free; + end; + end + else if Pos('>', Condition) > 0 then + begin + // Óñëîâèå ">X" + CurrentValue := + StrToIntDef(Trim(StringReplace(Condition, '>', '', + [rfReplaceAll])), 0); + if aSumInt >= CurrentValue then + CurrentPriority := 2; + end + else if Pos('<', Condition) > 0 then + begin + // Óñëîâèå " -1 then + begin + // Îïðåäåëåíèå íàèëó÷øåãî óñëîâèÿ + if (CurrentPriority > BestPriority) or (CurrentPriority = BestPriority) + and ((CurrentPriority = 3) and (CurrentValue > BestValue) or + (CurrentPriority = 2) and (CurrentValue > BestValue) or + (CurrentPriority = 1) and (CurrentValue < BestValue)) then + begin + BestPriority := CurrentPriority; + BestValue := CurrentValue; + BestRow := i; + notify := listNotify[i]; + end; + end; + if BestRow = -1 then + Break; + + f := TfrColorSettings.Create(self); + t := TfrFontSettings.Create(self); + try + se.Title := notify.HeaderText; + se.Title := StringReplace(se.Title, '[NICK]', aNick, [rfReplaceAll]); + se.Title := StringReplace(se.Title, '[SUM]', aSum, [rfReplaceAll]); + se.Context := aText; + se.Url := notify.Picture; + se.SoundURL := notify.Sound; + se.Timestamp := Now; + se.TimeMsg := notify.TimeMess; + se.BorderColor := f.ccbStyleBorderColor.Items[notify.ColorBorder]; + se.BorderSize := notify.SolidBorder; + se.BlockColor := notify.ColorBlock; + se.FontTitle.Font := t.cbFontStyleDefault.Items[notify.HeaderStyleFont]; + se.FontTitle.Size := notify.HeaderSizeFont; + se.FontTitle.Color := t.ccbFontColor.Items[notify.HeaderColorFont]; + se.FontContext.Font := t.cbFontStyleDefault.Items[notify.MessSizeFont]; + se.FontContext.Size := notify.MessSizeFont; + se.FontContext.Color := t.ccbFontColor.Items[notify.MessColorFont]; + se.RequireInteraction := True; + finally + f.Free; + t.Free; + end; + for j := 0 to EventWebServers.Count - 1 do + begin + EventWebServers[j].WebServerChat.AddMessage(se); + end; + end; + end; + +end; + procedure TfrOBS.UpdateGridFromArray; var i, rowIndex: integer; diff --git a/utils/uWebServerEvents.pas b/utils/uWebServerEvents.pas new file mode 100644 index 0000000..3cbdbee --- /dev/null +++ b/utils/uWebServerEvents.pas @@ -0,0 +1,341 @@ +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. diff --git a/Services/uWebServerKandinsky.pas b/utils/uWebServerKandinsky.pas similarity index 100% rename from Services/uWebServerKandinsky.pas rename to utils/uWebServerKandinsky.pas