From 318365f63b73e181410e71069133110cdccb1915 Mon Sep 17 00:00:00 2001 From: "PC1\\PTyTb" Date: Mon, 18 Aug 2025 23:33:38 +0300 Subject: [PATCH] =?UTF-8?q?=D0=B4=D0=BE=D0=B1=D0=B0=D0=B2=D0=B8=D0=BB=20?= =?UTF-8?q?=D0=98=D0=B3=D1=80=D1=8B,=20=D0=BD=D1=83=D0=B6=D0=BD=D0=BE=20?= =?UTF-8?q?=D1=80=D0=B0=D0=B7=D0=BE=D0=B1=D1=80=D0=B0=D1=82=D1=8C=D1=81?= =?UTF-8?q?=D1=8F=20=D1=81=20=D0=BF=D0=B5=D1=80=D0=B5=D0=B4=D0=B0=D1=87?= =?UTF-8?q?=D0=B5=D0=B9=20=D0=BA=D0=BE=D0=BC=D0=B0=D0=BD=D0=B4=20=D0=B2=20?= =?UTF-8?q?=D0=B8=D0=B3=D1=80=D1=83?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .gitignore | 8 +- SilentPlayer.dpr | 3 +- SilentPlayer.dproj | 34 ++++- SilentPlayer_Icon.ico | Bin 0 -> 4326 bytes TTW_Bot_app.dpr | 5 +- TTW_Bot_app.dproj | 14 +- forms/uCreateGame.fmx | 53 +++++++ forms/uCreateGame.pas | 93 ++++++++++++ forms/uGeneral.fmx | 150 +++++++++--------- forms/uGeneral.pas | 98 ++++++++---- frames/fOBS.fmx | 11 ++ frames/fOBS.pas | 145 +++++++++++++++--- install.ico | Bin 0 -> 4326 bytes install_Script.iss | 88 +++++++++++ utils/uRecords.pas | 8 +- utils/uWebServerGames.pas | 309 ++++++++++++++++++++++++++++++++++++++ 16 files changed, 890 insertions(+), 129 deletions(-) create mode 100644 SilentPlayer_Icon.ico create mode 100644 forms/uCreateGame.fmx create mode 100644 forms/uCreateGame.pas create mode 100644 install.ico create mode 100644 install_Script.iss create mode 100644 utils/uWebServerGames.pas diff --git a/.gitignore b/.gitignore index 7586c35..2e52410 100644 --- a/.gitignore +++ b/.gitignore @@ -6,7 +6,7 @@ *.so *.bpl *.res - +*.rtf # файлы IDE и сборки *.dsk @@ -18,3 +18,9 @@ backup/ bin/ lib/ piper/ +fonts/ +imgs/ +sounds/ +ytSongs/ +stl/ +games/ \ No newline at end of file diff --git a/SilentPlayer.dpr b/SilentPlayer.dpr index 1ff8de5..77fda2f 100644 --- a/SilentPlayer.dpr +++ b/SilentPlayer.dpr @@ -3,7 +3,8 @@ program SilentPlayer; uses System.StartUpCopy, FMX.Forms, - uSilentPlayer in 'uSilentPlayer.pas' {fPublicPlayer}; + uSilentPlayer in 'uSilentPlayer.pas' {fPublicPlayer}, + uTTS in 'utils\uTTS.pas'; {$R *.res} diff --git a/SilentPlayer.dproj b/SilentPlayer.dproj index 1c15e79..98b283b 100644 --- a/SilentPlayer.dproj +++ b/SilentPlayer.dproj @@ -4,7 +4,7 @@ 20.3 FMX True - Debug + Release Win32 SilentPlayer 693395 @@ -298,6 +298,11 @@ PerMonitorV2 + true + 1033 + SilentPlayer_Icon.ico + ..\ttw_fmx_v9\pp44.png + ..\ttw_fmx_v9\pp150.png PerMonitorV2 @@ -310,6 +315,7 @@
fPublicPlayer
fmx + Base @@ -330,6 +336,10 @@ SilentPlayer.dpr + + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + @@ -347,12 +357,32 @@ true + + + Assets\ + Logo150x150.png + true + + + + + Assets\ + Logo44x44.png + true + + SilentPlayer.exe true + + + SilentPlayer.exe + true + + 1 @@ -1307,11 +1337,9 @@ True True - False True True True - False True True True diff --git a/SilentPlayer_Icon.ico b/SilentPlayer_Icon.ico new file mode 100644 index 0000000000000000000000000000000000000000..17715093f93a4b37fe398ee7993f774da3e36dd2 GIT binary patch literal 4326 zcmeHJOHWfl6uw&exR16Ziclc5T$EyIOA9n0N=qn3pgf{H+z<^xVq6%Lf-8f;#6*7r zKR^?A>c+JrqgN{*Wm}uFfQ`q6#9X6*8Fx@r_)`K zZML~XH8o5W#03CK*WurZIdVOTHU)09*lL|SSX0ZOJK<>VkDDL}cY=WcYj195g_iuN zMx#0U6Miku_&D2ao<%CE6!>uKmLy6OxQh~qm)Gl`kZt4H4gOx) zRy;%eUY85}#)n(UZ_w+X)>iwXj#4{pS$K{2myPxQWly=2f#+?y`B&`*c1eD#y!ZC4 z`f-Loz284`|M9#Lw?DGMmd4;;vp<37KaihOtl19#qw|Ik%M#2=jTl>_;K1o7t$IFlOqy9)9wQPM9>@wWsq{k{YN@!llz*h?<*=huC5 z3ClK_m*6kQ)yChV!ovBsQ1hnpPh20$zZY>AVR~1?kNn$|vupPf-J6nsCFv$`8_B20.3 FMX True - Debug + Release Win32 TTW_Bot_app 693395 @@ -446,7 +446,13 @@ fmx TFrame + + +
fCreateGame
+ fmx + + Base @@ -540,6 +546,12 @@ true + + + .\ + true + + 1 diff --git a/forms/uCreateGame.fmx b/forms/uCreateGame.fmx new file mode 100644 index 0000000..68e633c --- /dev/null +++ b/forms/uCreateGame.fmx @@ -0,0 +1,53 @@ +object fCreateGame: TfCreateGame + Left = 0 + Top = 0 + Caption = #1057#1086#1079#1076#1072#1085#1080#1077' '#1080#1075#1088#1099 + ClientHeight = 99 + ClientWidth = 294 + FormFactor.Width = 320 + FormFactor.Height = 480 + FormFactor.Devices = [Desktop] + OnCreate = FormCreate + DesignerMasterStyle = 0 + object Button1: TButton + Position.X = 177.000000000000000000 + Position.Y = 63.000000000000000000 + Size.Width = 100.000000000000000000 + Size.Height = 22.000000000000000000 + Size.PlatformDefault = False + TabOrder = 0 + Text = #1057#1086#1079#1076#1072#1090#1100' '#1080#1075#1088#1091 + TextSettings.Trimming = None + OnClick = Button1Click + end + object Label1: TLabel + Position.X = 8.000000000000000000 + Position.Y = 8.000000000000000000 + Text = #1048#1075#1088#1072 + TabOrder = 1 + end + object cbGames: TComboBox + Position.X = 8.000000000000000000 + Position.Y = 33.000000000000000000 + Size.Width = 161.000000000000000000 + Size.Height = 22.000000000000000000 + Size.PlatformDefault = False + TabOrder = 2 + end + object Label2: TLabel + Position.X = 177.000000000000000000 + Position.Y = 8.000000000000000000 + Text = #1055#1086#1088#1090 + TabOrder = 3 + end + object sbWebServerPort: TSpinBox + Touch.InteractiveGestures = [LongTap, DoubleTap] + TabOrder = 4 + Cursor = crIBeam + Min = 100.000000000000000000 + Max = 60000.000000000000000000 + Value = 8080.000000000000000000 + Position.X = 177.000000000000000000 + Position.Y = 33.000000000000000000 + end +end diff --git a/forms/uCreateGame.pas b/forms/uCreateGame.pas new file mode 100644 index 0000000..ef4fa48 --- /dev/null +++ b/forms/uCreateGame.pas @@ -0,0 +1,93 @@ +unit uCreateGame; + +interface + +uses + System.SysUtils, System.Types, System.UITypes, System.Classes, + System.Variants, + FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Edit, + FMX.EditBox, FMX.SpinBox, FMX.ListBox, FMX.StdCtrls, + FMX.Controls.Presentation, + System.Generics.Collections, IOUtils; + +type + TfCreateGame = class(TForm) + Button1: TButton; + Label1: TLabel; + cbGames: TComboBox; + Label2: TLabel; + sbWebServerPort: TSpinBox; + procedure FormCreate(Sender: TObject); + procedure Button1Click(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + +var + fCreateGame: TfCreateGame; + +implementation + +{$R *.fmx} + +uses uGeneral; + +function GetGameFolders(const ARootDir: string): TArray; +var + gamesPath: string; + folders: TStringDynArray; + i: Integer; +begin + // + gamesPath := IncludeTrailingPathDelimiter(ARootDir) + 'games'; + + // + if not TDirectory.Exists(gamesPath) then + begin + SetLength(Result, 0); + Exit; + end; + + // + folders := TDirectory.GetDirectories(gamesPath); + SetLength(Result, Length(folders)); + + // ( ) + for i := 0 to High(folders) do + Result[i] := ExtractFileName(ExcludeTrailingPathDelimiter(folders[i])); +end; + +procedure TfCreateGame.Button1Click(Sender: TObject); +begin + if cbGames.Text = '' then + Exit; + TTW_Bot.frOBS1.addGame(cbGames.Text, round(sbWebServerPort.Value)); + close; +end; + +procedure TfCreateGame.FormCreate(Sender: TObject); +var + gameFolders: TArray; + folder: string; +begin + // + gameFolders := GetGameFolders(ExtractFilePath(ParamStr(0))); + // + + // (, TComboBox) + cbGames.Items.BeginUpdate; + try + cbGames.Items.Clear; + for folder in gameFolders do + cbGames.Items.Add(folder); + finally + cbGames.Items.EndUpdate; + end; + + if cbGames.Items.Count > 0 then + cbGames.ItemIndex := 0; +end; + +end. diff --git a/forms/uGeneral.fmx b/forms/uGeneral.fmx index 0bd30de..7a43955 100644 --- a/forms/uGeneral.fmx +++ b/forms/uGeneral.fmx @@ -3,7 +3,7 @@ object TTW_Bot: TTTW_Bot Top = 0 Caption = 'TTW_Bot' ClientHeight = 886 - ClientWidth = 1003 + ClientWidth = 968 Position = Designed FormFactor.Width = 320 FormFactor.Height = 480 @@ -15,30 +15,30 @@ object TTW_Bot: TTTW_Bot object V: TTabControl Align = Client Images = ImageList1 - Size.Width = 1003.000000000000000000 + Size.Width = 968.000000000000000000 Size.Height = 744.000000000000000000 Size.PlatformDefault = False - TabIndex = 3 + TabIndex = 4 TabOrder = 0 TabPosition = PlatformDefault Sizes = ( - 1003s + 968s 718s - 1003s + 968s 718s - 1003s + 968s 718s - 1003s + 968s 718s - 1003s + 968s 718s - 1003s + 968s 718s - 1003s + 968s 718s - 1003s + 968s 718s - 1003s + 968s 718s) object TabItem1: TTabItem CustomIcon = < @@ -57,7 +57,7 @@ object TTW_Bot: TTTW_Bot ExplicitSize.cy = 26.000000000000000000 inline frSettings1: TfrSettings Align = Client - Size.Width = 1003.000000000000000000 + Size.Width = 968.000000000000000000 Size.Height = 718.000000000000000000 Size.PlatformDefault = False inherited GroupBox3: TGroupBox @@ -115,12 +115,12 @@ object TTW_Bot: TTTW_Bot inherited btnDAStart: TButton Images = ImageList1 ImageIndex = 18 - TabOrder = 38 + TabOrder = 39 OnClick = frSettings1btnDAStartClick end inherited btnGetDADef: TButton Images = ImageList1 - TabOrder = 40 + TabOrder = 41 end end inherited btnOpenRomaning: TButton @@ -168,7 +168,7 @@ object TTW_Bot: TTTW_Bot ExplicitSize.cy = 26.000000000000000000 inline frAI1: TfrAI Align = Client - Size.Width = 1003.000000000000000000 + Size.Width = 968.000000000000000000 Size.Height = 718.000000000000000000 Size.PlatformDefault = False inherited btnGetAIDef: TButton @@ -201,12 +201,12 @@ object TTW_Bot: TTTW_Bot ExplicitSize.cy = 26.000000000000000000 inline frCommands1: TfrCommands Align = Client - Size.Width = 1003.000000000000000000 + Size.Width = 968.000000000000000000 Size.Height = 718.000000000000000000 Size.PlatformDefault = False inherited sgCommands: TStringGrid - Viewport.Width = 536.000000000000000000 - Viewport.Height = 168.000000000000000000 + Viewport.Width = 540.000000000000000000 + Viewport.Height = 193.000000000000000000 inherited scCommand: TStringColumn Size.Width = 134.000000000000000000 end @@ -218,53 +218,53 @@ object TTW_Bot: TTTW_Bot inherited frContruct1: TfrContruct inherited mResponse: TMemo Size.Width = 384.000000000000000000 - Viewport.Width = 380.000000000000000000 - Viewport.Height = 157.000000000000000000 + Viewport.Width = 384.000000000000000000 + Viewport.Height = 161.000000000000000000 end inherited GroupBox7: TGroupBox inherited btnAddUserName: TButton Images = ImageList1 ImageIndex = 11 - TabOrder = 38 + TabOrder = 37 end inherited btnGetDateFollow: TButton Images = ImageList1 ImageIndex = 15 - TabOrder = 39 + TabOrder = 38 end inherited btnGetAgeAccaunt: TButton Images = ImageList1 ImageIndex = 15 - TabOrder = 40 + TabOrder = 39 end inherited btnCounterAddtoText: TButton Images = ImageList1 ImageIndex = 23 - TabOrder = 41 + TabOrder = 40 end inherited cbCounterName: TComboBox - TabOrder = 42 + TabOrder = 41 end inherited btnGPT: TButton Images = ImageList1 ImageIndex = 19 - TabOrder = 43 + TabOrder = 42 end inherited btnRandomUserName: TButton Images = ImageList1 ImageIndex = 11 - TabOrder = 44 + TabOrder = 43 end inherited btnGetChannelStat: TButton Images = ImageList1 ImageIndex = 22 Size.Width = 136.000000000000000000 - TabOrder = 45 + TabOrder = 44 end inherited btnAIPic: TButton Images = ImageList1 ImageIndex = 5 - TabOrder = 48 + TabOrder = 45 end end inherited btnAddCommand: TButton @@ -294,20 +294,20 @@ object TTW_Bot: TTTW_Bot inherited btnRandomAdd: TButton Images = ImageList1 ImageIndex = 0 - TabOrder = 30 + TabOrder = 29 end inherited btnRandomDel: TButton Images = ImageList1 ImageIndex = 12 - TabOrder = 31 + TabOrder = 30 end inherited btnRmGroup: TButton Images = ImageList1 ImageIndex = 4 - TabOrder = 33 + TabOrder = 32 end inherited Label4: TLabel - TabOrder = 35 + TabOrder = 33 end inherited Label5: TLabel TabOrder = 43 @@ -326,8 +326,8 @@ object TTW_Bot: TTTW_Bot end inherited sgRandomInt: TStringGrid TabOrder = 35 - Viewport.Width = 153.000000000000000000 - Viewport.Height = 119.000000000000000000 + Viewport.Width = 157.000000000000000000 + Viewport.Height = 144.000000000000000000 inherited scRIntName: TStringColumn Size.Width = 70.000000000000000000 end @@ -343,8 +343,8 @@ object TTW_Bot: TTTW_Bot Margins.Top = 200.000000000000000000 inherited frsgSounds: TfrSimpleGrid inherited sg: TStringGrid - Viewport.Width = 289.000000000000000000 - Viewport.Height = 124.000000000000000000 + Viewport.Width = 293.000000000000000000 + Viewport.Height = 149.000000000000000000 inherited sgR2: TStringColumn Size.Width = 170.000000000000000000 end @@ -372,8 +372,8 @@ object TTW_Bot: TTTW_Bot inherited GroupBox24: TGroupBox inherited frsgFiles: TfrSimpleGrid inherited sg: TStringGrid - Viewport.Width = 289.000000000000000000 - Viewport.Height = 124.000000000000000000 + Viewport.Width = 293.000000000000000000 + Viewport.Height = 149.000000000000000000 inherited sgR2: TStringColumn Size.Width = 170.000000000000000000 end @@ -406,8 +406,8 @@ object TTW_Bot: TTTW_Bot TabOrder = 7 inherited frsgNeiro: TfrSimpleGrid inherited sg: TStringGrid - Viewport.Width = 289.000000000000000000 - Viewport.Height = 124.000000000000000000 + Viewport.Width = 293.000000000000000000 + Viewport.Height = 149.000000000000000000 inherited sgR2: TStringColumn Size.Width = 170.000000000000000000 end @@ -434,7 +434,7 @@ object TTW_Bot: TTTW_Bot item end> TextSettings.Trimming = None - IsSelected = True + IsSelected = False ImageIndex = 20 Size.Width = 79.000000000000000000 Size.Height = 26.000000000000000000 @@ -491,8 +491,8 @@ object TTW_Bot: TTTW_Bot Size.PlatformDefault = False inherited sgEvents: TStringGrid Size.Width = 721.000000000000000000 - Viewport.Width = 717.000000000000000000 - Viewport.Height = 186.000000000000000000 + Viewport.Width = 721.000000000000000000 + Viewport.Height = 211.000000000000000000 inherited StringColumn1: TStringColumn Size.Width = 150.000000000000000000 end @@ -541,8 +541,8 @@ object TTW_Bot: TTTW_Bot inherited StringGrid1: TStringGrid Size.Width = 605.000000000000000000 Size.Height = 153.000000000000000000 - Viewport.Width = 585.000000000000000000 - Viewport.Height = 128.000000000000000000 + Viewport.Width = 605.000000000000000000 + Viewport.Height = 153.000000000000000000 inherited StringColumn1: TStringColumn Size.Width = 241.000000000000000000 end @@ -550,14 +550,14 @@ object TTW_Bot: TTTW_Bot Size.Width = 140.000000000000000000 end end - inherited Label34: TLabel - TabOrder = 2 + inherited ceCustomRevardTitle: TComboEdit + TabOrder = 4 end inherited edtCustomRevardPrompt: TEdit - TabOrder = 7 + TabOrder = 6 end inherited nbCustomRevardCost: TNumberBox - TabOrder = 6 + TabOrder = 5 end inherited Label35: TLabel TabOrder = 3 @@ -568,12 +568,15 @@ object TTW_Bot: TTTW_Bot inherited btnAddCustomRewards: TButton Images = ImageList1 ImageIndex = 0 - TabOrder = 13 + TabOrder = 12 end inherited btnDelCustomRewards: TButton Images = ImageList1 ImageIndex = 12 - TabOrder = 16 + TabOrder = 13 + end + inherited cbUserInput: TCheckBox + TabOrder = 14 end end end @@ -583,7 +586,7 @@ object TTW_Bot: TTTW_Bot item end> TextSettings.Trimming = None - IsSelected = False + IsSelected = True ImageIndex = 10 Size.Width = 136.000000000000000000 Size.Height = 26.000000000000000000 @@ -595,13 +598,13 @@ object TTW_Bot: TTTW_Bot ExplicitSize.cy = 26.000000000000000000 inline frOBS1: TfrOBS Align = Top - Size.Width = 1003.000000000000000000 + Size.Width = 968.000000000000000000 Size.Height = 345.000000000000000000 Size.PlatformDefault = False inherited sgWebChats: TStringGrid - Size.Width = 1003.000000000000000000 + Size.Width = 968.000000000000000000 Size.Height = 282.000000000000000000 - Viewport.Width = 999.000000000000000000 + Viewport.Width = 964.000000000000000000 Viewport.Height = 257.000000000000000000 inherited StringColumn2: TStringColumn Size.Width = 200.000000000000000000 @@ -618,12 +621,12 @@ object TTW_Bot: TTTW_Bot Anchors = [akTop, akRight] Images = ImageList1 ImageIndex = 4 - Position.X = 915.000000000000000000 + Position.X = 880.000000000000000000 TabOrder = 3 OnClick = frOBS1btnDeleteeChatClick end inherited Label1: TLabel - TabOrder = 14 + TabOrder = 18 end inherited btnCreateOBSNotify: TButton Images = ImageList1 @@ -634,7 +637,12 @@ object TTW_Bot: TTTW_Bot Images = ImageList1 ImageIndex = 5 Position.X = 264.000000000000000000 - TabOrder = 13 + TabOrder = 17 + end + inherited btnCreateOBSGame: TButton + Images = ImageList1 + ImageIndex = 20 + TabOrder = 5 end object btnCreateChat: TButton Images = ImageList1 @@ -683,7 +691,7 @@ object TTW_Bot: TTTW_Bot ExplicitSize.cy = 26.000000000000000000 inline frNotify1: TfrNotify Align = Client - Size.Width = 1003.000000000000000000 + Size.Width = 968.000000000000000000 Size.Height = 718.000000000000000000 Size.PlatformDefault = False inherited btnNotifyOpen: TButton @@ -765,7 +773,7 @@ object TTW_Bot: TTTW_Bot ExplicitSize.cy = 26.000000000000000000 inline frAutoActions1: TfrAutoActions Align = Client - Size.Width = 1003.000000000000000000 + Size.Width = 968.000000000000000000 Size.Height = 718.000000000000000000 Size.PlatformDefault = False inherited GroupBox20: TGroupBox @@ -921,20 +929,20 @@ object TTW_Bot: TTTW_Bot ExplicitSize.cy = 26.000000000000000000 inline frLog1: TfrLog Align = Client - Size.Width = 1003.000000000000000000 + Size.Width = 968.000000000000000000 Size.Height = 718.000000000000000000 Size.PlatformDefault = False inherited Panel1: TPanel - Size.Width = 1003.000000000000000000 + Size.Width = 968.000000000000000000 inherited btnClear: TButton Images = ImageList1 ImageIndex = 4 end end inherited sgLog: TStringGrid - Size.Width = 1003.000000000000000000 + Size.Width = 968.000000000000000000 Size.Height = 685.000000000000000000 - Viewport.Width = 1003.000000000000000000 + Viewport.Width = 968.000000000000000000 Viewport.Height = 685.000000000000000000 inherited StringColumn2: TStringColumn Size.Width = 170.000000000000000000 @@ -952,7 +960,7 @@ object TTW_Bot: TTTW_Bot object Panel1: TPanel Align = Bottom Position.Y = 744.000000000000000000 - Size.Width = 1003.000000000000000000 + Size.Width = 968.000000000000000000 Size.Height = 142.000000000000000000 Size.PlatformDefault = False TabOrder = 10 @@ -1075,7 +1083,7 @@ object TTW_Bot: TTTW_Bot end object Label1: TLabel Anchors = [akTop, akRight] - Position.X = 854.000000000000000000 + Position.X = 819.000000000000000000 Position.Y = 8.000000000000000000 Text = #1054#1090#1076#1077#1083#1100#1085#1086#1077' '#1089#1087#1072#1089#1080#1073#1086':' TabOrder = 12 @@ -1112,7 +1120,7 @@ object TTW_Bot: TTTW_Bot Anchors = [akTop, akRight] Images = ImageList1 ImageIndex = 11 - Position.X = 854.000000000000000000 + Position.X = 819.000000000000000000 Position.Y = 33.000000000000000000 Size.Width = 141.000000000000000000 Size.Height = 22.000000000000000000 @@ -1125,7 +1133,7 @@ object TTW_Bot: TTTW_Bot Anchors = [akTop, akRight] Images = ImageList1 ImageIndex = 11 - Position.X = 854.000000000000000000 + Position.X = 819.000000000000000000 Position.Y = 63.000000000000000000 Size.Width = 141.000000000000000000 Size.Height = 22.000000000000000000 @@ -1138,7 +1146,7 @@ object TTW_Bot: TTTW_Bot Anchors = [akTop, akRight] Images = ImageList1 ImageIndex = 11 - Position.X = 854.000000000000000000 + Position.X = 819.000000000000000000 Position.Y = 93.000000000000000000 Size.Width = 141.000000000000000000 Size.Height = 22.000000000000000000 diff --git a/forms/uGeneral.pas b/forms/uGeneral.pas index 9b665e3..97a24d0 100644 --- a/forms/uGeneral.pas +++ b/forms/uGeneral.pas @@ -27,7 +27,7 @@ uses System.IOUtils, fCommands, uDataBase, FMX.Edit, FMX.Colors, FMX.SpinBox, windows, System.Skia, FMX.Skia, uCreateChat, uCreateNotify, fOBS, fTTS, fPlayerWeb, uWebServerKandinsky, FMX.Memo.Types, FMX.ScrollBox, FMX.Memo, - fRevards; + fRevards, json; type TTTW_Bot = class(TForm) @@ -124,6 +124,7 @@ type procedure ESStatus(Sender: TObject; const ConnectionEvent: String; StatusCode: Integer; const Description: String); procedure ESOnSubOk(s: string); + procedure checkAndSendToGames(aNick: string; aCommand: string); public { Public declarations } procedure toLog(aModule, aMethod, aMessage: string; aCode: Integer); @@ -432,6 +433,27 @@ begin db.WriteSetting('cbTheme', inttostr(cbTheme.ItemIndex)); end; +procedure TTTW_Bot.checkAndSendToGames(aNick: string; aCommand: string); +var + I: Integer; + j: Integer; +begin + for I := 0 to frOBS1.GameWebServers.Count - 1 do + begin + for j := 0 to frOBS1.GameWebServers[I].commands.Count - 1 do + begin + if frOBS1.GameWebServers[I].commands[j] = aCommand then + begin + var + obj := TJSONObject.Create; + obj.AddPair('user', aNick); + obj.AddPair('cmd', aCommand); + frOBS1.GameWebServers[I].WebServerGame.Input(obj); + end; + end; + end; +end; + procedure TTTW_Bot.FormCreate(Sender: TObject); var Path: string; @@ -515,12 +537,13 @@ end; procedure TTTW_Bot.FormDestroy(Sender: TObject); begin - FreeAndNil(frOBS1.ChatBadges); + FreeAndNil(frOBS1.ChatBadges); FreeAndNil(frOBS1.ChatEmotes); FreeAndNil(frOBS1.ChatWebServers); -FreeAndNil(frOBS1.EventWebServers); -FreeAndNil(frOBS1.KandinskyWebServers); -FreeAndNil(frRevards1.CustomRewards); + FreeAndNil(frOBS1.EventWebServers); + FreeAndNil(frOBS1.KandinskyWebServers); + FreeAndNil(frOBS1.GameWebServers); + FreeAndNil(frRevards1.CustomRewards); frOBS1.BTTV.Free; frOBS1.m7tv.Free; @@ -533,7 +556,7 @@ FreeAndNil(frRevards1.CustomRewards); FreeAndNil(ttw_API); if Assigned(Kandinsky) then Kandinsky.Free; - //frSettings1.Destroy; + // frSettings1.Destroy; FreeAndNil(db); FreeAndNil(frAutoActions1.FTimerList); FreeAndNil(frLog1.FLogList); @@ -577,14 +600,14 @@ var frAutoActions1.UpdateGridFromArray; end; - function StringToArray(const input: string): TArray; + function StringToArray(const Input: string): TArray; var Delimiter: char; Words: TArray; I: Integer; begin Delimiter := ','; - Words := input.Split([Delimiter]); + Words := Input.Split([Delimiter]); SetLength(Result, Length(Words)); for I := 0 to High(Words) do Result[I] := Words[I].Trim; @@ -725,8 +748,9 @@ begin UpdateWordCounters(processedText); CheckBannedWords(processedText, aRecord.DisplayName, aRecord.UserId); - if (frCommands1.frContruct1.cbTextToSpeach.IsChecked) and (processedText[1] = '!') and - (processedText[2] = '!') and (processedText[3] = '!') then + if (frCommands1.frContruct1.cbTextToSpeach.IsChecked) and + (processedText[1] = '!') and (processedText[2] = '!') and + (processedText[3] = '!') then begin s := StringReplace(processedText, '!!!', '', [rfReplaceAll]); s := Trim(s); @@ -734,7 +758,8 @@ begin exit; end; - if (frCommands1.frContruct1.cbHelloTTS.IsChecked) and (aRecord.FirstMsg = 1) then + if (frCommands1.frContruct1.cbHelloTTS.IsChecked) and (aRecord.FirstMsg = 1) + then toSpeech('приветствую, ' + IfThen(aRecord.DisplayName <> '', aRecord.DisplayName, aRecord.Username)); @@ -752,6 +777,8 @@ begin end); PlayNotifySound((aRecord.Moder = 1), (aRecord.Vip = 1), (aRecord.Subscriber = 1)); + processedText := StringReplace(processedText, '!', '', [rfReplaceAll]); + checkAndSendToGames(aRecord.DisplayName, processedText); end; procedure TTTW_Bot.PlayNotifySound(aMod, aVip, aSub: Boolean); @@ -806,30 +833,36 @@ begin end; procedure TTTW_Bot.frAutoActions1btnCounterAddClick(Sender: TObject); -var i:integer; +var + I: Integer; begin frAutoActions1.btnCounterAddClick(Sender); frCommands1.frContruct1.cbCounterName.Items.Clear; - for i:=0 to high(frAutoActions1.listCounters) do - frCommands1.frContruct1.cbCounterName.Items.Add(frAutoActions1.listCounters[i].counterName); + for I := 0 to high(frAutoActions1.listCounters) do + frCommands1.frContruct1.cbCounterName.Items.Add + (frAutoActions1.listCounters[I].counterName); end; procedure TTTW_Bot.frAutoActions1btnCounterDeleteClick(Sender: TObject); -var i:integer; +var + I: Integer; begin frAutoActions1.btnCounterDeleteClick(Sender); - frCommands1.frContruct1.cbCounterName.Items.Clear; - for i:=0 to high(frAutoActions1.listCounters) do - frCommands1.frContruct1.cbCounterName.Items.Add(frAutoActions1.listCounters[i].counterName); + frCommands1.frContruct1.cbCounterName.Items.Clear; + for I := 0 to high(frAutoActions1.listCounters) do + frCommands1.frContruct1.cbCounterName.Items.Add + (frAutoActions1.listCounters[I].counterName); end; procedure TTTW_Bot.frAutoActions1btnCounterEditClick(Sender: TObject); -var i:integer; +var + I: Integer; begin frAutoActions1.btnCounterEditClick(Sender); - frCommands1.frContruct1.cbCounterName.Items.Clear; - for i:=0 to high(frAutoActions1.listCounters) do - frCommands1.frContruct1.cbCounterName.Items.Add(frAutoActions1.listCounters[i].counterName); + frCommands1.frContruct1.cbCounterName.Items.Clear; + for I := 0 to high(frAutoActions1.listCounters) do + frCommands1.frContruct1.cbCounterName.Items.Add + (frAutoActions1.listCounters[I].counterName); end; procedure TTTW_Bot.frCommands1btnRandAddClick(Sender: TObject); @@ -1094,15 +1127,19 @@ procedure TTTW_Bot.ReadDB; // Загрузка гридов автоматических действий procedure LoadAutoActionsGrids; -var i:integer; + var + I: Integer; begin db.LoadRecordArray('listTimer', frAutoActions1.listTimer); db.LoadRecordArray('listBanWords', frAutoActions1.listBanWords); db.LoadRecordArray('listCounters', frAutoActions1.listCounters); - for I := 0 to High(frAutoActions1.listCounters) do - frCommands1.frContruct1.cbCounterName.items.Add(frAutoActions1.listCounters[i].counterName); - frCommands1.frContruct1.cbTextToSpeach.IsChecked:=db.ReadSetting('cbTextToSpeach', 'False') = 'True'; - frCommands1.frContruct1.cbHelloTTS.IsChecked:= db.ReadSetting('cbHelloTTS', 'False') = 'True'; + for I := 0 to High(frAutoActions1.listCounters) do + frCommands1.frContruct1.cbCounterName.Items.Add + (frAutoActions1.listCounters[I].counterName); + frCommands1.frContruct1.cbTextToSpeach.IsChecked := + db.ReadSetting('cbTextToSpeach', 'False') = 'True'; + frCommands1.frContruct1.cbHelloTTS.IsChecked := + db.ReadSetting('cbHelloTTS', 'False') = 'True'; frAutoActions1.initTimers; frAutoActions1.UpdateGridFromArray; end; @@ -1143,6 +1180,13 @@ var i:integer; end; + db.LoadRecordArray('listGames', frOBS1.listGames); + frOBS1.GameWebServers := TList.Create; + for I := 0 to High(frOBS1.listGames) do + begin + frOBS1.CreateWebGame(frOBS1.listGames[I].game, frOBS1.listGames[I].port); + end; + frOBS1.UpdateGridFromArray; end; diff --git a/frames/fOBS.fmx b/frames/fOBS.fmx index f934fdc..d7f7f08 100644 --- a/frames/fOBS.fmx +++ b/frames/fOBS.fmx @@ -74,4 +74,15 @@ object frOBS: TfrOBS TextSettings.Trimming = None OnClick = btnCreateOBSKandinskyClick end + object btnCreateOBSGame: TButton + Position.X = 412.000000000000000000 + Position.Y = 8.000000000000000000 + Size.Width = 147.000000000000000000 + Size.Height = 22.000000000000000000 + Size.PlatformDefault = False + TabOrder = 6 + Text = #1057#1086#1079#1076#1072#1090#1100' '#1080#1075#1088#1091 + TextSettings.Trimming = None + OnClick = btnCreateOBSGameClick + end end diff --git a/frames/fOBS.pas b/frames/fOBS.pas index f858d2c..9cacbe2 100644 --- a/frames/fOBS.pas +++ b/frames/fOBS.pas @@ -5,8 +5,8 @@ interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, uCustomEmoties, System.Variants, uWebServerChat, uWebServerEvents, fColorSettings, - fFontSettings, - System.Generics.Collections, uWebServerKandinsky, + fFontSettings, uCreateGame, + System.Generics.Collections, uWebServerKandinsky, uWebServerGames, 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, @@ -37,6 +37,14 @@ type WebServerChat: TTTW_Events; end; +type + TGameWebServers = record + port: integer; + game: string; + WebServerGame: TGameWebServer; + commands: tstringlist; + end; + type TKandinskyWebServers = record port: integer; @@ -54,11 +62,13 @@ type StringColumn2: TStringColumn; btnCreateOBSNotify: TButton; btnCreateOBSKandinsky: TButton; + btnCreateOBSGame: TButton; procedure btnDeleteeChatClick(Sender: TObject); procedure btnCreateOBSKandinskyClick(Sender: TObject); procedure btnCreateOBSChatClick(Sender: TObject); procedure btnCreateOBSNotifyClick(Sender: TObject); procedure sgWebChatsCellDblClick(const Column: TColumn; const Row: integer); + procedure btnCreateOBSGameClick(Sender: TObject); private { Private declarations } @@ -72,6 +82,7 @@ type listChats: TArray; listNotify: TArray; listKandinsky: TArray; + listGames: TArray; BTTV: TBTTV; m7tv: t7tv; @@ -80,6 +91,8 @@ type ChatWebServers: Tlist; EventWebServers: Tlist; KandinskyWebServers: Tlist; + GameWebServers: Tlist; + procedure MsgToWebServer(const aRecord: TTwitchChatMessage); procedure toEventWebServer(aEvent: TFollowEvent); overload; // follow procedure toEventWebServer(aEvent: TSubEvent); overload; // sub @@ -101,6 +114,10 @@ type procedure AddKandinsky(newRecord: TOBSKandinsky); procedure DelKandinsky(aPort: integer); procedure CreateWebKandinsky(aRecord: TOBSKandinsky); + + procedure addGame(aGame: string; aPort: integer); + procedure delGame(aPort: integer); + procedure CreateWebGame(aGame: string; aPort: integer); end; implementation @@ -304,6 +321,18 @@ begin CreateWebChat(newRecord); end; +procedure TfrOBS.addGame(aGame: string; aPort: integer); +begin + SetLength(listGames, Length(listGames) + 1); + listGames[High(listGames)].port := aPort; + listGames[High(listGames)].game := aGame; + + UpdateGridFromArray; + + db.SaveRecordArray('listGames', listGames); + CreateWebGame(aGame, aPort); +end; + procedure TfrOBS.AddKandinsky(newRecord: TOBSKandinsky); begin SetLength(listKandinsky, Length(listKandinsky) + 1); @@ -337,6 +366,20 @@ begin fCreateChat.Show; end; +procedure TfrOBS.btnCreateOBSGameClick(Sender: TObject); +var + dport, i: integer; +begin + dport := 8080; + for i := 0 to sgWebChats.RowCount - 1 do + begin + if strtoint(sgWebChats.Cells[0, i]) >= dport then + dport := strtoint(sgWebChats.Cells[0, i]) + 1; + end; + fCreateGame.sbWebServerPort.Value := dport; + fCreateGame.Show; +end; + procedure TfrOBS.btnCreateOBSKandinskyClick(Sender: TObject); var dport: integer; @@ -383,6 +426,10 @@ begin begin DelNotify(strtoint(sgWebChats.Cells[0, sgWebChats.Row])); end; + if sgWebChats.Cells[1, sgWebChats.Row] = '' then + begin + delGame(strtoint(sgWebChats.Cells[0, sgWebChats.Row])); + end; end; procedure TfrOBS.CreateWebChat(chatSettings: TOBSChat); @@ -527,7 +574,7 @@ begin EventWebServer.se.FontTitle.Color := eventsSettings.HeaderColorFont; EventWebServer.se.FontContext.Font := eventsSettings.MessStyleFont; EventWebServer.se.FontContext.Size := eventsSettings.MessSizeFont; - EventWebServer.se.FontContext.Color :=eventsSettings.MessColorFont; + EventWebServer.se.FontContext.Color := eventsSettings.MessColorFont; EventWebServer.se.BorderColor := eventsSettings.ColorBorder; EventWebServer.se.BorderSize := eventsSettings.SolidBorder; EventWebServer.se.BlockColor := eventsSettings.ColorBlock; @@ -540,6 +587,24 @@ begin end; end; +procedure TfrOBS.CreateWebGame(aGame: string; aPort: integer); +var + GameWebServer: TGameWebServers; + commands: TArray; + Cmd: string; +begin + GameWebServer.port := aPort; + GameWebServer.WebServerGame := TGameWebServer.Create + (myConst.GeneralPath, aPort); + GameWebServers.Add(GameWebServer); + GameWebServers[GameWebServers.Count - 1].WebServerGame.Start; + GameWebServers[GameWebServers.Count - 1].WebServerGame.SetGame(aGame); + commands := GameWebServers[GameWebServers.Count - 1] + .WebServerGame.GetControlCommands; + for Cmd in commands do + GameWebServers[GameWebServers.Count - 1].commands.Add(Cmd); +end; + procedure TfrOBS.CreateWebKandinsky(aRecord: TOBSKandinsky); var KandinskyWebServer: TKandinskyWebServers; @@ -579,6 +644,31 @@ begin UpdateGridFromArray; end; +procedure TfrOBS.delGame(aPort: integer); +var + i, j: integer; +begin + // + for i := High(listGames) downto 0 do + begin + if listGames[i].port = aPort then + begin + // + for j := i to High(listGames) - 1 do + listGames[j] := listGames[j + 1]; + // + SetLength(listGames, Length(listGames) - 1); + // ( ) + Break; + end; + end; + GameWebServers[i].WebServerGame.Stop; + GameWebServers[i].WebServerGame.Destroy; + GameWebServers.Delete(i); + UpdateGridFromArray; + db.SaveRecordArray('listGames', listGames); +end; + procedure TfrOBS.DelKandinsky(aPort: integer); var i, j: integer; @@ -690,37 +780,38 @@ end; procedure TfrOBS.EdtNotify(newRecord: TOBSNotify; oldPort: integer); var - i,mi: integer; ws:TEventWebServers; + i, mi: integer; + ws: TEventWebServers; begin -for I := 0 to EventWebServers.Count - 1 do - if EventWebServers[i].port = oldPort then - begin - ws:=EventWebServers[i]; - mi:=i; - end; + for i := 0 to EventWebServers.Count - 1 do + if EventWebServers[i].port = oldPort then + begin + ws := EventWebServers[i]; + mi := i; + end; for i := 0 to High(listNotify) do if listNotify[i].port = oldPort then begin listNotify[i] := newRecord; - ws.port:=listNotify[i].port; - ws.typeEvent:=listNotify[i].TypeEvent; - ws.se.title:=listNotify[i].HeaderText; - ws.se.Context:=listNotify[i].MessText; - ws.se.Url:=listNotify[i].Picture; - ws.se.SoundURL:=listNotify[i].Sound; - ws.se.TimeMsg:=listNotify[i].TimeMess; - ws.se.FontTitle.Font:=listNotify[i].HeaderStyleFont; + ws.port := listNotify[i].port; + ws.typeEvent := listNotify[i].typeEvent; + ws.se.Title := listNotify[i].HeaderText; + ws.se.Context := listNotify[i].MessText; + ws.se.Url := listNotify[i].Picture; + ws.se.SoundURL := listNotify[i].Sound; + ws.se.TimeMsg := listNotify[i].TimeMess; + ws.se.FontTitle.Font := listNotify[i].HeaderStyleFont; ws.se.FontTitle.Font := listNotify[i].HeaderStyleFont; ws.se.FontTitle.Size := listNotify[i].HeaderSizeFont; ws.se.FontTitle.Color := listNotify[i].HeaderColorFont; ws.se.FontContext.Font := listNotify[i].MessStyleFont; ws.se.FontContext.Size := listNotify[i].MessSizeFont; ws.se.FontContext.Color := listNotify[i].MessColorFont; - ws.se.BorderColor :=listNotify[i].ColorBorder; + ws.se.BorderColor := listNotify[i].ColorBorder; ws.se.BorderSize := listNotify[i].SolidBorder; ws.se.BlockColor := listNotify[i].ColorBlock; - EventWebServers[mi]:=ws; + EventWebServers[mi] := ws; UpdateGridFromArray; db.SaveRecordArray('listNotify', listNotify); Break; @@ -800,7 +891,7 @@ begin ws := EventWebServers[i]; ws.se.Title := StringReplace(ws.se.Title, '[NICK]', aEvent.event.user_name, [rfReplaceAll]); - ws.se.Timestamp:=now; + ws.se.Timestamp := now; ws.se.RequireInteraction := True; TTW_Bot.toLog('fOBS', 'toEventWebServer.BlockColor', ws.se.BlockColor, 3); EventWebServers[i].WebServerChat.AddMessage(ws.se); @@ -824,7 +915,7 @@ begin EventWebServers[i] := ws; EventWebServers[i].WebServerChat.AddMessage(EventWebServers[i].se); end; - TTW_Bot.frEvents1.OnTTVEvent(aEvent.event.user_name); + TTW_Bot.frEvents1.OnTTVEvent(aEvent.event.user_name); end; procedure TfrOBS.toEventWebServer(aEvent: TRaidEvent); @@ -926,6 +1017,16 @@ begin inttostr(listKandinsky[i].port); Inc(rowIndex); // end; + + for i := 0 to High(listGames) do + begin + sgWebChats.RowCount := rowIndex + 1; + sgWebChats.Cells[0, rowIndex] := inttostr(listGames[i].port); + sgWebChats.Cells[1, rowIndex] := ''; + sgWebChats.Cells[2, rowIndex] := 'http://127.0.0.1:' + + inttostr(listGames[i].port); + Inc(rowIndex); // + end; finally sgWebChats.EndUpdate; end; diff --git a/install.ico b/install.ico new file mode 100644 index 0000000000000000000000000000000000000000..d95725bc0476fda0446b86c2e48cb76d6b305a7d GIT binary patch literal 4326 zcmeHJNoy2A6t3>7PU04W!Q~(%G`Jv9F}4vwxA{$Bi>u`{Ujtg9<^b+recu*W}Gg%!PSp_L*{O%G?54 z;qw>P{J;K;=3g+e8}oQJFtJ0P-(tQz|BlV?ka5QM7t53Tv3`Bh8s3%riut4!=@!E# z^*a`SSI`$DNx0d>D^NzE@f35tMd7JNJYUe~ztF!x#vrGea*0EZoBEZEtwH`+sFA~& zy@=d}4zrIUHWbDS=f~n1hw(OG<^y{H{kae`R>~N#M|xv4e#XS)F_8a5!!Y}t>2pgs z0iL+$RP~Crhr#JcyvA-7V=l%J)aTOPPm@^3RmOrk&=QvYQk&0UEE%lxCEqOmED57i znn$pQTVr^qaDES{EQlQhc1p$L9lKe@8nkPny&YWlbw0ZzDL*_L>VCLKT*#?S%8TOk zO#;35s;1N)2UbM*m^LVJm&bWp9j8mNux842ndXkZXZvwZt`j$DB;~7d z;7=e|o`3Qm1BcR}{pO)>P{pGrAJ&lOfu-P^R5?)-Uf{g#1uz0z^~6ZMY5Ew0u)i8khKRF9+e@x)$G?beL!#i^ww6%Ix!g#Vc^XsRP8#FNP zQ;OC{ypz-1;%}9>H1}czm>%?hkTJw%AgMucW-f<3edt^f0&MKJJu<)VGqDT((ONG@ z?13K#hekYu0BX`si8somefiDj561d!9d*92W~|QhvePWrlC6VzxfU; + 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.