PTyTb/ttw_fmx_v10
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

добавил Игры, нужно разобраться с передачей команд в игру

Browse Source
This commit is contained in:
PC1\PTyTb
2025-08-18 23:33:38 +03:00
parent fc5a835b1f
commit 318365f63b
16 changed files with 890 additions and 129 deletions
Download Patch File Download Diff File Expand all files Collapse all files
.gitignore
+7 -1
View File
@@ -6,7 +6,7 @@
*.so
*.bpl
*.res
*.rtf
# файлы IDE и сборки
*.dsk
@@ -18,3 +18,9 @@ backup/
bin/
lib/
piper/
fonts/
imgs/
sounds/
ytSongs/
stl/
games/
SilentPlayer.dpr
+2 -1
View File
@@ -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}
SilentPlayer.dproj
+31 -3
View File
@@ -4,7 +4,7 @@
<ProjectVersion>20.3</ProjectVersion>
<FrameworkType>FMX</FrameworkType>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<Config Condition="'$(Config)'==''">Release</Config>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<ProjectName Condition="'$(ProjectName)'==''">SilentPlayer</ProjectName>
<TargetedPlatforms>693395</TargetedPlatforms>
@@ -298,6 +298,11 @@
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Locale>1033</VerInfo_Locale>
<Icon_MainIcon>SilentPlayer_Icon.ico</Icon_MainIcon>
<UWP_DelphiLogo44>..\ttw_fmx_v9\pp44.png</UWP_DelphiLogo44>
<UWP_DelphiLogo150>..\ttw_fmx_v9\pp150.png</UWP_DelphiLogo150>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win64)'!=''">
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
@@ -310,6 +315,7 @@
<Form>fPublicPlayer</Form>
<FormType>fmx</FormType>
</DCCReference>
<DCCReference Include="utils\uTTS.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
@@ -330,6 +336,10 @@
<Source>
<Source Name="MainSource">SilentPlayer.dpr</Source>
</Source>
<Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k290.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp290.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages>
</Delphi.Personality>
<Deployment Version="5">
<DeployFile LocalName="$(BDS)\Redist\iossimulator\libcgunwind.1.0.dylib" Class="DependencyModule">
@@ -347,12 +357,32 @@
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="..\ttw_fmx_v9\pp150.png" Configuration="Release" Class="UWP_DelphiLogo150">
<Platform Name="Win32">
<RemoteDir>Assets\</RemoteDir>
<RemoteName>Logo150x150.png</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="..\ttw_fmx_v9\pp44.png" Configuration="Release" Class="UWP_DelphiLogo44">
<Platform Name="Win32">
<RemoteDir>Assets\</RemoteDir>
<RemoteName>Logo44x44.png</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="Win32\Debug\SilentPlayer.exe" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>SilentPlayer.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="Win32\Release\SilentPlayer.exe" Configuration="Release" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>SilentPlayer.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployClass Name="AdditionalDebugSymbols">
<Platform Name="iOSSimulator">
<Operation>1</Operation>
@@ -1307,11 +1337,9 @@
<Platforms>
<Platform value="Android">True</Platform>
<Platform value="Android64">True</Platform>
<Platform value="iOSDevice32">False</Platform>
<Platform value="iOSDevice64">True</Platform>
<Platform value="iOSSimARM64">True</Platform>
<Platform value="Linux64">True</Platform>
<Platform value="OSX32">False</Platform>
<Platform value="OSX64">True</Platform>
<Platform value="OSXARM64">True</Platform>
<Platform value="Win32">True</Platform>
SilentPlayer_Icon.ico
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 4.2 KiB

TTW_Bot_app.dpr
+4 -1
View File
@@ -48,7 +48,9 @@ uses
uWebServerEvents in 'utils\uWebServerEvents.pas',
fEvents in 'frames\fEvents.pas' {frEvents: TFrame},
uKeyEvent in 'utils\uKeyEvent.pas',
fRevards in 'frames\fRevards.pas' {frRevards: TFrame};
fRevards in 'frames\fRevards.pas' {frRevards: TFrame},
uWebServerGames in 'utils\uWebServerGames.pas',
uCreateGame in 'forms\uCreateGame.pas' {fCreateGame};
{$R *.res}
@@ -62,6 +64,7 @@ begin
Application.Initialize;
Application.CreateForm(TTTW_Bot, TTW_Bot);
Application.CreateForm(TfCreateGame, fCreateGame);
Application.OnException := TTW_Bot.GlobalExceptionHandler;
Application.CreateForm(TfCreateChat, fCreateChat);
Application.CreateForm(TfCreateNotify, fCreateNotify);
TTW_Bot_app.dproj
+13 -1
View File
@@ -4,7 +4,7 @@
<ProjectVersion>20.3</ProjectVersion>
<FrameworkType>FMX</FrameworkType>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<Config Condition="'$(Config)'==''">Release</Config>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<ProjectName Condition="'$(ProjectName)'==''">TTW_Bot_app</ProjectName>
<TargetedPlatforms>693395</TargetedPlatforms>
@@ -446,7 +446,13 @@
<FormType>fmx</FormType>
<DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="utils\uWebServerGames.pas"/>
<DCCReference Include="forms\uCreateGame.pas">
<Form>fCreateGame</Form>
<FormType>fmx</FormType>
</DCCReference>
<None Include=".gitignore"/>
<None Include="install_Script.iss"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
@@ -540,6 +546,12 @@
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="install_Script.iss" Configuration="Release" Class="ProjectFile">
<Platform Name="Win32">
<RemoteDir>.\</RemoteDir>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployClass Name="AdditionalDebugSymbols">
<Platform Name="iOSSimulator">
<Operation>1</Operation>
forms/uCreateGame.fmx
+53
View File
@@ -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
forms/uCreateGame.pas
+93
View File
@@ -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<string>;
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<string>;
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.
forms/uGeneral.fmx
+79 -71
View File
@@ -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
forms/uGeneral.pas
+63 -19
View File
@@ -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;
@@ -520,6 +542,7 @@ begin
FreeAndNil(frOBS1.ChatWebServers);
FreeAndNil(frOBS1.EventWebServers);
FreeAndNil(frOBS1.KandinskyWebServers);
FreeAndNil(frOBS1.GameWebServers);
FreeAndNil(frRevards1.CustomRewards);
frOBS1.BTTV.Free;
@@ -577,14 +600,14 @@ var
frAutoActions1.UpdateGridFromArray;
end;
function StringToArray(const input: string): TArray<string>;
function StringToArray(const Input: string): TArray<string>;
var
Delimiter: char;
Words: TArray<string>;
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);
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);
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<TListTimer>('listTimer', frAutoActions1.listTimer);
db.LoadRecordArray<TBanWord>('listBanWords', frAutoActions1.listBanWords);
db.LoadRecordArray<TCounter>('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';
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<TOBSGames>('listGames', frOBS1.listGames);
frOBS1.GameWebServers := TList<TGameWebServers>.Create;
for I := 0 to High(frOBS1.listGames) do
begin
frOBS1.CreateWebGame(frOBS1.listGames[I].game, frOBS1.listGames[I].port);
end;
frOBS1.UpdateGridFromArray;
end;
frames/fOBS.fmx
+11
View File
@@ -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
frames/fOBS.pas
+107 -6
View File
@@ -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<TOBSChat>;
listNotify: TArray<TOBSNotify>;
listKandinsky: TArray<TOBSKandinsky>;
listGames: TArray<TOBSGames>;
BTTV: TBTTV;
m7tv: t7tv;
@@ -80,6 +91,8 @@ type
ChatWebServers: Tlist<TChatWebServers>;
EventWebServers: Tlist<TEventWebServers>;
KandinskyWebServers: Tlist<TKandinskyWebServers>;
GameWebServers: Tlist<TGameWebServers>;
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<TOBSGames>('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);
@@ -540,6 +587,24 @@ begin
end;
end;
procedure TfrOBS.CreateWebGame(aGame: string; aPort: integer);
var
GameWebServer: TGameWebServers;
commands: TArray<string>;
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<TOBSGames>('listGames', listGames);
end;
procedure TfrOBS.DelKandinsky(aPort: integer);
var
i, j: integer;
@@ -690,9 +780,10 @@ 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
for i := 0 to EventWebServers.Count - 1 do
if EventWebServers[i].port = oldPort then
begin
ws := EventWebServers[i];
@@ -704,8 +795,8 @@ for I := 0 to EventWebServers.Count - 1 do
begin
listNotify[i] := newRecord;
ws.port := listNotify[i].port;
ws.typeEvent:=listNotify[i].TypeEvent;
ws.se.title:=listNotify[i].HeaderText;
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;
@@ -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;
install.ico
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 4.2 KiB

install_Script.iss
+88
View File
@@ -0,0 +1,88 @@
; Script generated by the Inno Setup Script Wizard.
; SEE THE DOCUMENTATION FOR DETAILS ON CREATING INNO SETUP SCRIPT FILES!
#define MyAppName "TTW_Bot"
#define MyAppVersion "10.1.2"
#define MyAppPublisher "PTyTb, Inc."
#define MyAppURL "https://ptytb.ru/ttw_bot"
#define MyAppExeName "TTW_Bot_app.exe"
#define MyAppAssocName MyAppName + "_Files"
#define MyAppAssocExt ".myp"
#define MyAppAssocKey StringChange(MyAppAssocName, " ", "") + MyAppAssocExt
[Setup]
; NOTE: The value of AppId uniquely identifies this application. Do not use the same AppId value in installers for other applications.
; (To generate a new GUID, click Tools | Generate GUID inside the IDE.)
LicenseFile=license.rtf
DisableWelcomePage=no
AppId={{81A4FB77-4AE5-4FAC-A889-CA3CA7B8C687}
AppName={#MyAppName}
AppVersion={#MyAppVersion}
;AppVerName={#MyAppName} {#MyAppVersion}
AppPublisher={#MyAppPublisher}
AppPublisherURL={#MyAppURL}
AppSupportURL={#MyAppURL}
AppUpdatesURL={#MyAppURL}
DefaultDirName={autopf}\{#MyAppName}
ChangesAssociations=yes
DisableDirPage=auto
DisableProgramGroupPage=auto
; Uncomment the following line to run in non administrative install mode (install for current user only.)
;PrivilegesRequired=lowest
OutputDir=C:\Users\ptytb\Documents\Embarcadero\Studio\Projects\ttw_fmx_v10\Win32\installer
OutputBaseFilename=TTW_Bot_setup
SetupIconFile=C:\Users\ptytb\Documents\Embarcadero\Studio\Projects\ttw_fmx_v10\install.ico
Compression=lzma
SolidCompression=yes
WizardStyle=modern
[Languages]
Name: "russian"; MessagesFile: "compiler:Languages\Russian.isl"; LicenseFile: license.rtf
[Tasks]
Name: "desktopicon"; Description: "{cm:CreateDesktopIcon}"; GroupDescription: "{cm:AdditionalIcons}"; Flags: unchecked
[Files]
Source: "C:\Users\ptytb\Documents\Embarcadero\Studio\Projects\ttw_fmx_v10\Win32\Release\{#MyAppExeName}"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\Users\ptytb\Documents\Embarcadero\Studio\Projects\ttw_fmx_v10\Win32\Release\bass.dll"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\Users\ptytb\Documents\Embarcadero\Studio\Projects\ttw_fmx_v10\Win32\Release\botapp.cfg"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\Users\ptytb\Documents\Embarcadero\Studio\Projects\ttw_fmx_v10\Win32\Release\ffmpeg.exe"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\Users\ptytb\Documents\Embarcadero\Studio\Projects\ttw_fmx_v10\Win32\Release\libcrypto-1_1.dll"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\Users\ptytb\Documents\Embarcadero\Studio\Projects\ttw_fmx_v10\Win32\Release\libeay32.dll"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\Users\ptytb\Documents\Embarcadero\Studio\Projects\ttw_fmx_v10\Win32\Release\libssl-1_1.dll"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\Users\ptytb\Documents\Embarcadero\Studio\Projects\ttw_fmx_v10\Win32\Release\libssl32.dll"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\Users\ptytb\Documents\Embarcadero\Studio\Projects\ttw_fmx_v10\Win32\Release\SilentPlayer.exe"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\Users\ptytb\Documents\Embarcadero\Studio\Projects\ttw_fmx_v10\Win32\Release\ssleay32.dll"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\Users\ptytb\Documents\Embarcadero\Studio\Projects\ttw_fmx_v10\Win32\Release\yt-dlp.exe"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\Users\ptytb\Documents\Embarcadero\Studio\Projects\ttw_fmx_v10\Win32\Release\zlib1.dll"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\Users\ptytb\Documents\Embarcadero\Studio\Projects\ttw_fmx_v10\Win32\Release\stl\*"; DestDir: "{userappdata}\TTW_Bot\stl"; Flags: ignoreversion recursesubdirs createallsubdirs
Source: "C:\Users\PTyTb\Documents\Embarcadero\Studio\Projects\ttw_fmx_v10\Win32\Release\piper\*"; DestDir: "{app}\piper"; Flags: ignoreversion recursesubdirs createallsubdirs
Source: "C:\Users\ptytb\Documents\Embarcadero\Studio\Projects\ttw_fmx_v10\license.rtf"; DestDir: "{app}"; Flags: ignoreversion
; NOTE: Don't use "Flags: ignoreversion" on any shared system files
[Registry]
Root: HKA; Subkey: "Software\Classes\{#MyAppAssocExt}\OpenWithProgids"; ValueType: string; ValueName: "{#MyAppAssocKey}"; ValueData: ""; Flags: uninsdeletevalue
Root: HKA; Subkey: "Software\Classes\{#MyAppAssocKey}"; ValueType: string; ValueName: ""; ValueData: "{#MyAppAssocName}"; Flags: uninsdeletekey
Root: HKA; Subkey: "Software\Classes\{#MyAppAssocKey}\DefaultIcon"; ValueType: string; ValueName: ""; ValueData: "{app}\{#MyAppExeName},0"
Root: HKA; Subkey: "Software\Classes\{#MyAppAssocKey}\shell\open\command"; ValueType: string; ValueName: ""; ValueData: """{app}\{#MyAppExeName}"" ""%1"""
Root: HKA; Subkey: "Software\Classes\Applications\{#MyAppExeName}\SupportedTypes"; ValueType: string; ValueName: ".myp"; ValueData: ""
[Icons]
Name: "{autoprograms}\{#MyAppName}"; Filename: "{app}\{#MyAppExeName}"
Name: "{autodesktop}\{#MyAppName}"; Filename: "{app}\{#MyAppExeName}"; Tasks: desktopicon
[Run]
Filename: "{app}\{#MyAppExeName}"; Description: "{cm:LaunchProgram,{#StringChange(MyAppName, '&', '&&')}}"; Flags: nowait postinstall skipifsilent
[Code]
function NextButtonClick(CurPageID: Integer): Boolean;
begin
if CurPageID = wpLicense then
begin
Result := WizardForm.LicenseAcceptedRadio.Checked;
if not Result then
MsgBox('Âû äîëæíû ïðèíÿòü óñëîâèÿ ëèöåíçèîííîãî ñîãëàøåíèÿ!', mbError, MB_OK);
end
else
Result := True;
end;
utils/uRecords.pas
+6 -2
View File
@@ -2,8 +2,6 @@ unit uRecords;
interface
type
TEventGlobal = record
Event: integer;
@@ -88,6 +86,12 @@ type
port: integer;
end;
type
TOBSGames = record
port: integer;
game: string;
end;
type
TRandomCounters = record
rndName: string;
utils/uWebServerGames.pas
+309
View File
@@ -0,0 +1,309 @@
unit uWebServerGames;
interface
uses
System.SysUtils, System.Classes, System.JSON, System.Generics.Collections,
IdHTTPServer, IdCustomHTTPServer, IdContext, IdComponent, NetEncoding, IOUtils;
type
TGameWebServer = class
private
FHTTP: TIdHTTPServer;
FRootDir: string;
FCurrentGame: string;
FClients: TList<TIdContext>;
procedure HTTPCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
procedure BroadcastJSON(const AJSON: TJSONObject);
procedure HTTPDisconnect(AContext: TIdContext);
function ParseControlCommands(const AGameName: string): TArray<string>;
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<string>;
end;
implementation
{ TGameWebServer }
function TGameWebServer.ParseControlCommands(const AGameName: string): TArray<string>;
var
configPath, content, controlSection: string;
startPos, endPos: Integer;
lines: TArray<string>;
line: string;
commands: TList<string>;
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('<control>');
endPos := content.IndexOf('</control>');
if (startPos = -1) or (endPos = -1) or (endPos <= startPos) then
Exit;
startPos := startPos + Length('<control>');
controlSection := content.Substring(startPos, endPos - startPos).Trim;
commands := TList<string>.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<string>;
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<TIdContext>.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<TIdContext>;
begin
s := 'data: ' + AJSON.ToJSON + #13#10#13#10; // CRLF x2 â êîíöå
toRemove := TList<TIdContext>.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.