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-08 14:57:56 +03:00
parent 1936c9c9c0
commit 71cdcc9909
23 changed files with 721 additions and 249 deletions
Download Patch File Download Diff File Expand all files Collapse all files
TTW_Bot_app.dpr
+25 -18
View File
@@ -1,42 +1,49 @@
program TTW_Bot_app;
uses
System.StartUpCopy,
System.StartUpCopy, SysUtils,
FMX.Forms,
uGeneral in 'uGeneral.pas' {TTW_Bot},
fSettings in 'fSettings.pas' {frSettings: TFrame},
fAI in 'fAI.pas' {frAI: TFrame},
fNotify in 'fNotify.pas' {frNotify: TFrame},
fAutoActions in 'fAutoActions.pas' {frAutoActions: TFrame},
fOBS in 'fOBS.pas' {frOBS: TFrame},
fLog in 'fLog.pas' {frLog: TFrame},
uGeneral in 'uGeneral.pas' {TTW_Bot} ,
fSettings in 'fSettings.pas' {frSettings: TFrame} ,
fAI in 'fAI.pas' {frAI: TFrame} ,
fNotify in 'fNotify.pas' {frNotify: TFrame} ,
fAutoActions in 'fAutoActions.pas' {frAutoActions: TFrame} ,
fOBS in 'fOBS.pas' {frOBS: TFrame} ,
fLog in 'fLog.pas' {frLog: TFrame} ,
uRecords in 'uRecords.pas',
fCommands in 'fCommands.pas' {frCommands: TFrame},
fCommands in 'fCommands.pas' {frCommands: TFrame} ,
uDataBase in 'uDataBase.pas',
fColorSettings in 'fColorSettings.pas' {frColorSettings: TFrame},
uCreateChat in 'uCreateChat.pas' {fCreateChat},
fFontSettings in 'fFontSettings.pas' {frFontSettings: TFrame},
uCreateNotify in 'uCreateNotify.pas' {fCreateNotify},
fColorSettings in 'fColorSettings.pas' {frColorSettings: TFrame} ,
uCreateChat in 'uCreateChat.pas' {fCreateChat} ,
fFontSettings in 'fFontSettings.pas' {frFontSettings: TFrame} ,
uCreateNotify in 'uCreateNotify.pas' {fCreateNotify} ,
uTWAuth in 'uTWAuth.pas',
uTTWAPI in 'uTTWAPI.pas',
uAPIDA in 'uAPIDA.pas',
uShowText in 'uShowText.pas' {fShowText},
uShowText in 'uShowText.pas' {fShowText} ,
uWSDA in 'uWSDA.pas',
uQ in 'uQ.pas' {frmQ},
fSimpleGrid in 'fSimpleGrid.pas' {frSimpleGrid: TFrame},
fContruct in 'fContruct.pas' {frContruct: TFrame},
fGroupsRequest in 'fGroupsRequest.pas' {frGroupsRequest: TFrame},
uQ in 'uQ.pas' {frmQ} ,
fSimpleGrid in 'fSimpleGrid.pas' {frSimpleGrid: TFrame} ,
fContruct in 'fContruct.pas' {frContruct: TFrame} ,
fGroupsRequest in 'fGroupsRequest.pas' {frGroupsRequest: TFrame} ,
uMyTimer in 'uMyTimer.pas',
uRegExpr in 'uRegExpr.pas';
{$R *.res}
begin
{$IFDEF DEBUG}
ReportMemoryLeaksOnShutdown := True;
{$ENDIF}
Application.Initialize;
Application.CreateForm(TTTW_Bot, TTW_Bot);
Application.OnException := TTW_Bot.GlobalExceptionHandler;
Application.CreateForm(TfCreateChat, fCreateChat);
Application.CreateForm(TfCreateNotify, fCreateNotify);
Application.CreateForm(TfShowText, fShowText);
Application.CreateForm(TfrmQ, frmQ);
Application.Run;
end.
TTW_Bot_app.dproj
+29 -17
View File
@@ -286,6 +286,11 @@
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<DCC_RemoteDebug>false</DCC_RemoteDebug>
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Locale>1033</VerInfo_Locale>
<Icon_MainIcon>TTW_Bot_app_Icon1.ico</Icon_MainIcon>
<UWP_DelphiLogo44>..\ttw_fmx_v9\fawico_44_2.png</UWP_DelphiLogo44>
<UWP_DelphiLogo150>..\ttw_fmx_v9\fawico_150_2.png</UWP_DelphiLogo150>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win64)'!=''">
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
@@ -298,6 +303,12 @@
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_MajorVer>10</VerInfo_MajorVer>
<VerInfo_MinorVer>1</VerInfo_MinorVer>
<VerInfo_Release>1</VerInfo_Release>
<VerInfo_Locale>1049</VerInfo_Locale>
<VerInfo_Keys>CompanyName=PTyTb;FileDescription=$(MSBuildProjectName);FileVersion=10.1.1.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=ru.ptytb.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win64)'!=''">
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
@@ -308,88 +319,71 @@
</DelphiCompile>
<DCCReference Include="uGeneral.pas">
<Form>TTW_Bot</Form>
<FormType>fmx</FormType>
</DCCReference>
<DCCReference Include="fSettings.pas">
<Form>frSettings</Form>
<FormType>fmx</FormType>
<DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="fAI.pas">
<Form>frAI</Form>
<FormType>fmx</FormType>
<DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="fNotify.pas">
<Form>frNotify</Form>
<FormType>fmx</FormType>
<DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="fAutoActions.pas">
<Form>frAutoActions</Form>
<FormType>fmx</FormType>
<DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="fOBS.pas">
<Form>frOBS</Form>
<FormType>fmx</FormType>
<DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="fLog.pas">
<Form>frLog</Form>
<FormType>fmx</FormType>
<DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="uRecords.pas"/>
<DCCReference Include="fCommands.pas">
<Form>frCommands</Form>
<FormType>fmx</FormType>
<DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="uDataBase.pas"/>
<DCCReference Include="fColorSettings.pas">
<Form>frColorSettings</Form>
<FormType>fmx</FormType>
<DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="uCreateChat.pas">
<Form>fCreateChat</Form>
<FormType>fmx</FormType>
</DCCReference>
<DCCReference Include="fFontSettings.pas">
<Form>frFontSettings</Form>
<FormType>fmx</FormType>
<DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="uCreateNotify.pas">
<Form>fCreateNotify</Form>
<FormType>fmx</FormType>
</DCCReference>
<DCCReference Include="uTWAuth.pas"/>
<DCCReference Include="uTTWAPI.pas"/>
<DCCReference Include="uAPIDA.pas"/>
<DCCReference Include="uShowText.pas">
<Form>fShowText</Form>
<FormType>fmx</FormType>
</DCCReference>
<DCCReference Include="uWSDA.pas"/>
<DCCReference Include="uQ.pas">
<Form>frmQ</Form>
<FormType>fmx</FormType>
</DCCReference>
<DCCReference Include="fSimpleGrid.pas">
<Form>frSimpleGrid</Form>
<FormType>fmx</FormType>
<DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="fContruct.pas">
<Form>frContruct</Form>
<FormType>fmx</FormType>
<DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="fGroupsRequest.pas">
<Form>frGroupsRequest</Form>
<FormType>fmx</FormType>
<DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="uMyTimer.pas"/>
@@ -415,6 +409,10 @@
<Source>
<Source Name="MainSource">TTW_Bot_app.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">
@@ -432,6 +430,20 @@
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="..\ttw_fmx_v9\fawico_150_2.png" Configuration="Debug" Class="UWP_DelphiLogo150">
<Platform Name="Win32">
<RemoteDir>Assets\</RemoteDir>
<RemoteName>Logo150x150.png</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="..\ttw_fmx_v9\fawico_44_2.png" Configuration="Debug" Class="UWP_DelphiLogo44">
<Platform Name="Win32">
<RemoteDir>Assets\</RemoteDir>
<RemoteName>Logo44x44.png</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName=".gitignore" Configuration="Debug" Class="ProjectFile">
<Platform Name="Win32">
<RemoteDir>.\</RemoteDir>
TTW_Bot_app_Icon.ico
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 66 KiB

TTW_Bot_app_Icon1.ico
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 91 KiB

fAutoActions.pas
+27 -2
View File
@@ -76,6 +76,7 @@ type
listTimer: TArray<TListTimer>;
listBanWords: TArray<TBanWord>;
listCounters: TArray<TCounter>;
destructor Destroy; override;
procedure UpdateGridFromArray;
procedure initTimers;
end;
@@ -138,12 +139,16 @@ var
rx: TRegExpr;
begin
rx := TRegExpr.Create;
try
rx.InputString := edtBanWordsCheck.text;
rx.Expression := edtBanWords.text;
if rx.Exec then
lBanWordsCheck.text := 'åñòü áàíâîðä'
else
lBanWordsCheck.text := 'íåò áàíâîðäà';
finally
rx.Free;
end;
end;
procedure TfrAutoActions.btnBanWordsDelClick(Sender: TObject);
@@ -322,7 +327,8 @@ begin
if Assigned(FTimerList[SelectedRow]) then
begin
FTimerList[SelectedRow].StopT;
FTimerList[SelectedRow].TerminateAndDestroy; // Ìåòîä äëÿ îñòàíîâêè ïîòîêà
FTimerList[SelectedRow].Terminate; // Ìåòîä äëÿ îñòàíîâêè ïîòîêà
FTimerList[SelectedRow].Free;
FTimerList.Delete(SelectedRow); // Óäàëÿåì èç ñïèñêà ñ àâòîóíè÷òîæåíèåì
end;
end;
@@ -334,6 +340,26 @@ begin
DB.SaveRecordArray<TListTimer>('listTimer', listTimer);
end;
destructor TfrAutoActions.Destroy;
var
i: Integer;
begin
if Assigned(FTimerList) then
begin
for i := FTimerList.Count - 1 downto 0 do
begin
if Assigned(FTimerList[i]) then
begin
FTimerList[i].StopT;
FTimerList[i].Terminate;
FTimerList[i].Free;
end;
end;
FreeAndNil(FTimerList);
end;
inherited;
end;
procedure TfrAutoActions.initTimers;
var
I: Integer;
@@ -369,7 +395,6 @@ begin
edtCounterName.text := sgCounter.Cells[0, Row];
edtCounterTrigger.text := sgCounter.Cells[1, Row];
edtCounterCount.text := sgCounter.Cells[2, Row];
end;
procedure TfrAutoActions.sgTimersCellClick(const Column: TColumn;
fFontSettings.pas
+2 -1
View File
@@ -3,7 +3,8 @@ unit fFontSettings;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
System.SysUtils, System.Types, System.UITypes, System.Classes,
System.Variants,
FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
FMX.ListBox, FMX.Colors, FMX.Edit, FMX.EditBox, FMX.SpinBox,
FMX.Controls.Presentation;
fLog.fmx
+7 -2
View File
@@ -14,6 +14,7 @@ object frLog: TfrLog
TabOrder = 0
Text = #1054#1095#1080#1089#1090#1080#1090#1100
TextSettings.Trimming = None
OnClick = btnClearClick
end
object chkWARNING: TCheckBox
Position.X = 160.000000000000000000
@@ -23,6 +24,7 @@ object frLog: TfrLog
Size.PlatformDefault = False
TabOrder = 1
Text = #1055#1088#1077#1076#1091#1087#1088#1077#1078#1076#1077#1085#1080#1103
OnChange = chkWARNINGChange
end
object chkERROR: TCheckBox
Position.X = 289.000000000000000000
@@ -32,12 +34,14 @@ object frLog: TfrLog
Size.PlatformDefault = False
TabOrder = 2
Text = #1054#1096#1080#1073#1082#1080
OnChange = chkWARNINGChange
end
object chkDEBUG: TCheckBox
Position.X = 369.000000000000000000
Position.Y = 8.000000000000000000
TabOrder = 3
Text = #1054#1090#1083#1072#1076#1082#1072
OnChange = chkWARNINGChange
end
object chkINFO: TCheckBox
Position.X = 96.000000000000000000
@@ -47,6 +51,7 @@ object frLog: TfrLog
Size.PlatformDefault = False
TabOrder = 4
Text = #1048#1085#1092#1086
OnChange = chkWARNINGChange
end
end
object sgLog: TStringGrid
@@ -58,8 +63,8 @@ object frLog: TfrLog
Size.PlatformDefault = False
TabOrder = 1
RowCount = 0
Viewport.Width = 796.000000000000000000
Viewport.Height = 477.000000000000000000
Viewport.Width = 800.000000000000000000
Viewport.Height = 502.000000000000000000
object StringColumn5: TStringColumn
Header = #1044#1072#1090#1072
HeaderSettings.TextSettings.WordWrap = False
fLog.pas
+62 -3
View File
@@ -3,10 +3,12 @@ unit fLog;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
System.SysUtils, System.Types, System.UITypes, System.Classes,
System.Variants,
FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
System.Rtti, FMX.Grid.Style, FMX.Grid, FMX.ScrollBox,
FMX.Controls.Presentation;
System.Rtti, FMX.Grid.Style, System.Generics.Collections, FMX.Grid,
FMX.ScrollBox,
FMX.Controls.Presentation, uRecords;
type
TfrLog = class(TFrame)
@@ -22,14 +24,71 @@ type
StringColumn2: TStringColumn;
StringColumn3: TStringColumn;
StringColumn4: TStringColumn;
procedure btnClearClick(Sender: TObject);
procedure chkWARNINGChange(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
FLogList: TList<TRLog>;
destructor Destroy; override;
procedure UpdateGridFilters;
end;
implementation
{$R *.fmx}
{ TfrLog }
procedure TfrLog.chkWARNINGChange(Sender: TObject);
begin
UpdateGridFilters;
end;
destructor TfrLog.Destroy;
begin
FLogList.Free;
inherited;
end;
procedure TfrLog.btnClearClick(Sender: TObject);
begin
FLogList.Clear;
UpdateGridFilters;
end;
procedure TfrLog.UpdateGridFilters;
var
ml: TRLog;
NewRow: integer;
begin
sgLog.BeginUpdate;
try
sgLog.RowCount := 0;
// Ïðîâåðêà íàëè÷èÿ âñåõ êîëîíîê
if sgLog.ColumnCount < 5 then
raise Exception.Create('Ãðèä äîëæåí ñîäåðæàòü 5 êîëîíîê.');
for ml in FLogList do
begin
// Ïðîâåðêà ôèëüòðà
if ((ml.rType = 'WARNING') and chkWARNING.IsChecked) or
((ml.rType = 'ERROR') and chkERROR.IsChecked) or
((ml.rType = 'DEBUG') and chkDEBUG.IsChecked) or
((ml.rType = 'INFO') and chkINFO.IsChecked) then
begin
sgLog.RowCount := sgLog.RowCount + 1;
NewRow := sgLog.RowCount - 1;
// Çàïîëíåíèå äàííûõ ñ ïðîâåðêîé êîëîíîê
sgLog.Cells[0, NewRow] := TimeToStr(ml.rTime); // Êîëîíêà 0
sgLog.Cells[1, NewRow] := ml.rType; // Êîëîíêà 1
sgLog.Cells[2, NewRow] := ml.rModule; // Êîëîíêà 2
sgLog.Cells[3, NewRow] := ml.rMethod; // Êîëîíêà 3
sgLog.Cells[4, NewRow] := ml.rMessage; // Êîëîíêà 4
end;
end;
finally
sgLog.EndUpdate;
end;
end;
end.
fOBS.pas
+2 -2
View File
@@ -175,7 +175,7 @@ begin
if listKandinsky[i].port = aPort then
begin
// Ñäâèãàåì ýëåìåíòû ìàññèâà
for j := i to High(listKandinsky) do
for j := i to High(listKandinsky) - 1 do
listKandinsky[j] := listKandinsky[j + 1];
// Óìåíüøàåì ðàçìåð ìàññèâà
SetLength(listKandinsky, Length(listKandinsky) - 1);
@@ -197,7 +197,7 @@ begin
if listNotify[i].port = aPort then
begin
// Ñäâèãàåì ýëåìåíòû ìàññèâà
for j := i to High(listNotify) do
for j := i to High(listNotify) - 1 do
listNotify[j] := listNotify[j + 1];
// Óìåíüøàåì ðàçìåð ìàññèâà
SetLength(listNotify, Length(listNotify) - 1);
fSettings.fmx
+12 -12
View File
@@ -134,7 +134,7 @@ object frSettings: TfrSettings
Size.Width = 128.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 34
TabOrder = 33
Text = #1054#1090#1082#1088#1099#1090#1100' '#1089#1090#1088#1080#1084
TextSettings.Trimming = None
OnClick = btnOpenStreamClick
@@ -145,14 +145,14 @@ object frSettings: TfrSettings
Size.Width = 128.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 35
TabOrder = 34
Text = #1055#1086#1083#1091#1095#1080#1090#1100' Token'
TextSettings.Trimming = None
OnClick = btnGetTokenStreamerClick
end
object edtBotTokenStreamer: TEdit
Touch.InteractiveGestures = [LongTap, DoubleTap]
TabOrder = 36
TabOrder = 35
Password = True
Position.X = 8.000000000000000000
Position.Y = 146.000000000000000000
@@ -191,7 +191,7 @@ object frSettings: TfrSettings
object btnDAGetCode: TButton
Position.X = 200.000000000000000000
Position.Y = 216.000000000000000000
TabOrder = 45
TabOrder = 43
Text = #1055#1086#1083#1091#1095#1080#1090#1100
TextSettings.Trimming = None
OnClick = btnDAGetCodeClick
@@ -201,11 +201,11 @@ object frSettings: TfrSettings
Position.Y = 24.000000000000000000
TextSettings.Trimming = None
Text = 'Client ID'
TabOrder = 36
TabOrder = 35
end
object edtDAClientID: TEdit
Touch.InteractiveGestures = [LongTap, DoubleTap]
TabOrder = 40
TabOrder = 39
Password = True
Position.X = 8.000000000000000000
Position.Y = 49.000000000000000000
@@ -218,11 +218,11 @@ object frSettings: TfrSettings
Position.Y = 79.000000000000000000
TextSettings.Trimming = None
Text = 'Client Secret'
TabOrder = 38
TabOrder = 36
end
object edtDAClientSecret: TEdit
Touch.InteractiveGestures = [LongTap, DoubleTap]
TabOrder = 39
TabOrder = 38
Password = True
Position.X = 8.000000000000000000
Position.Y = 104.000000000000000000
@@ -235,11 +235,11 @@ object frSettings: TfrSettings
Position.Y = 134.000000000000000000
TextSettings.Trimming = None
Text = 'Redirect URL'
TabOrder = 41
TabOrder = 40
end
object edtDARedirectURL: TEdit
Touch.InteractiveGestures = [LongTap, DoubleTap]
TabOrder = 42
TabOrder = 41
Password = True
Position.X = 8.000000000000000000
Position.Y = 159.000000000000000000
@@ -249,7 +249,7 @@ object frSettings: TfrSettings
end
object edtDACode: TEdit
Touch.InteractiveGestures = [LongTap, DoubleTap]
TabOrder = 43
TabOrder = 42
Password = True
Position.X = 8.000000000000000000
Position.Y = 214.000000000000000000
@@ -270,7 +270,7 @@ object frSettings: TfrSettings
Size.Width = 121.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 46
TabOrder = 45
Text = #1055#1086#1076#1082#1083#1102#1095#1080#1090#1100#1089#1103
TextSettings.Trimming = None
OnClick = btnDAStartClick
fSettings.pas
+84 -10
View File
@@ -6,9 +6,9 @@ uses
System.SysUtils, System.Types, System.UITypes, System.Classes,
System.Variants, uQ,
FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
ShellAPI, system.IOUtils, uDataBase,
ShellAPI, System.IOUtils, uDataBase,
FMX.Controls.Presentation, FMX.Edit, uTWAuth, uRecords, uAPIDA, uShowText,
json, uWSDA;
json, uWSDA, fLog;
type
TfrSettings = class(TFrame)
@@ -68,7 +68,9 @@ type
public
{ Public declarations }
FWSClient: TWSClient;
destructor Destroy; override;
procedure init();
end;
implementation
@@ -92,6 +94,7 @@ begin
twa := TTTWAuth.Create;
twa.OnToken := OnTokenDA;
twa.StartServer(Url);
// ttw_Auth áóäåò îñâîáîæäåí àâòîìàòè÷åñêè ïîñëå ïîëó÷åíèÿ òîêåíà (ñì. uTWAuth)
end;
procedure TfrSettings.OnTokenDA(txt: string);
@@ -103,6 +106,7 @@ begin
end;
end;
procedure TfrSettings.btnDAStartClick(Sender: TObject);
var
UserInfo: TJSONObject;
@@ -110,34 +114,85 @@ var
begin
if btnDAStart.text = 'Ïîäêëþ÷èòüñÿ' then
begin
try // Ïîëó÷åíèå òîêåíà
UserInfo := nil;
try
try
if not Assigned(FAPIClient) then
init;
if FAPIClient.Token = '' then
begin
FAPIClient.Token := FAPIClient.GetAccessToken(edtDAClientID.text,
edtDAClientSecret.text, edtDARedirectURL.text, edtDACode.text);
try
FAPIClient.Token := FAPIClient.GetAccessToken(
edtDAClientID.text,
edtDAClientSecret.text,
edtDARedirectURL.text,
edtDACode.text
);
except
on E: Exception do
begin
TTW_Bot.toLog('fSettings', 'btnDAStartClick', 'Îøèáêà ïîëó÷åíèÿ òîêåíà: ' + E.Message,2);
Exit;
end;
end;
FWSClient.APIClient := FAPIClient;
try
UserInfo := FAPIClient.GetUserInfo;
Data := UserInfo.GetValue<TJSONObject>('data');
FWSClient.Wsstoken := Data.GetValue<string>('socket_connection_token');
FWSClient.WSID := Data.GetValue<string>('id');
except
on E: Exception do
begin
TTW_Bot.toLog( 'fSettings','btnDAStartClick', 'Îøèáêà ïîëó÷åíèÿ UserInfo: ' + E.Message,2);
Exit;
end;
end;
end;
// Ïîëó÷åíèå èíôîðìàöèè î ïîëüçîâàòåëå
try
FWSClient.Connect('wss://centrifugo.donationalerts.com/connection/websocket');
FWSClient.Send(Format(
'{"params":{"token":"%s"},"id":1}',
[FWSClient.Wsstoken]
));
except
on E: Exception do
TTW_Bot.toLog( 'fSettings','btnDAStartClick', 'Îøèáêà ïîäêëþ÷åíèÿ ê WebSocket: ' + E.Message,2);
end;
FWSClient.Connect
('wss://centrifugo.donationalerts.com/connection/websocket');
FWSClient.Send(Format('{"params":{"token":"%s"},"id":1}',
[FWSClient.Wsstoken]));
except
on E: Exception do
TTW_Bot.toLog('fSettings', 'btnDAStartClick', 'Íåèçâåñòíàÿ îøèáêà: ' + E.Message,2);
end;
finally
UserInfo.Free;
end;
end
else
begin
try
edtDACode.Text:='';
if Assigned(FWSClient) then
begin
try
FWSClient.Disconnect;
except
on E: Exception do
TTW_Bot.toLog( 'fSettings', 'btnDAStartClick', 'Îøèáêà ïðè îòêëþ÷åíèè WS: ' + E.Message,2);
end;
FreeAndNil(FWSClient);
end;
FreeAndNil(FAPIClient);
finally
btnDAStart.ImageIndex := 18;
btnDAStart.text := 'Ïîäêëþ÷èòüñÿ';
end;
end;
end;
procedure TfrSettings.btnExportSettingsClick(Sender: TObject);
@@ -160,6 +215,7 @@ var
begin
ttw_Auth := TTTWAuth.Create;
ttw_Auth.OnToken := OnTTWToken;
// ttw_Auth áóäåò îñâîáîæäåí àâòîìàòè÷åñêè ïîñëå ïîëó÷åíèÿ òîêåíà (ñì. uTWAuth)
sope := 'moderator:manage:shoutouts' + '+moderator:manage:announcements' +
'+moderator:manage:banned_users' + '+moderator:manage:warnings' +
'+moderator:read:followers' + '+channel:manage:raids' +
@@ -256,12 +312,30 @@ begin
nil, nil, 1);
end;
destructor TfrSettings.Destroy;
begin
if Assigned(FWSClient) then
begin
try
FWSClient.Disconnect; // åñëè åñòü ìåòîä îòêëþ÷åíèÿ
except end;
FreeAndNil(FWSClient);
end;
FreeAndNil(FAPIClient);
inherited;
end;
procedure TfrSettings.init;
begin
if not Assigned(FAPIClient) then
FAPIClient := TAPIClient.Create;
if not Assigned(FWSClient) then
begin
FWSClient := TWSClient.Create;
FWSClient.OnStatus := HandleWSStatus;
FWSClient.OnDonate := HandleWSDonate;
FWSClient.OnLog := TTW_Bot.toLog;
end;
end;
procedure TfrSettings.OnTTWToken(txt: string);
uAPIDA.pas
+17 -5
View File
@@ -24,8 +24,6 @@ type
implementation
const
ContentType = 'application/x-www-form-urlencoded';
UserAgent = 'Mozilla/5.0 (Windows NT 10.0) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/120.0.0.0 Safari/537.36';
@@ -35,7 +33,8 @@ constructor TAPIClient.Create;
begin
inherited;
FHttpClient := TIdHTTP.Create(nil);
FSSLHandler := TIdSSLIOHandlerSocketOpenSSL.Create(FHttpClient);
// ñîçäà¸ì SSL handler áåç âëàäåëüöà — ÿâíîå óïðàâëåíèå
FSSLHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
FSSLHandler.SSLOptions.Method := sslvSSLv23;
FHttpClient.IOHandler := FSSLHandler;
FHttpClient.Request.UserAgent := UserAgent;
@@ -45,8 +44,21 @@ end;
destructor TAPIClient.Destroy;
begin
FHttpClient.Free;
// Îòêëþ÷àåì è îñâîáîæäàåì â áåçîïàñíîì ïîðÿäêå
try
if Assigned(FHttpClient) then
begin
try
// åñëè íóæíî — ïðåðâàòü àêòèâíûå ñîåäèíåíèÿ
except
end;
end;
finally
// Ñíà÷àëà îñâîáîæäàåì IOHandler (åñëè îí íå ïðèíàäëåæèò FHttpClient)
FreeAndNil(FSSLHandler);
FreeAndNil(FHttpClient);
inherited;
end;
end;
procedure TAPIClient.CheckHTTPError(AResponseCode: Integer; const AResponse: string);
@@ -108,7 +120,6 @@ begin
Response := FHttpClient.Post('https://www.donationalerts.com/api/v1/centrifuge/subscribe', Stream);
CheckHTTPError(FHttpClient.ResponseCode, Response);
Result := TJSONObject.ParseJSONValue(Response) as TJSONObject;
// .toLog(3,'uAPIDA','SubscribeToChannel',Result.ToJSON);
finally
Stream.Free;
FHttpClient.Request.CustomHeaders.Clear;
@@ -121,3 +132,4 @@ begin
end;
end.
uCreateChat.fmx
+8 -5
View File
@@ -1,7 +1,7 @@
object fCreateChat: TfCreateChat
Left = 0
Top = 0
Caption = 'Form2'
Caption = #1056#1077#1076#1072#1082#1090#1086#1088' '#1095#1072#1090#1086#1074
ClientHeight = 287
ClientWidth = 810
FormFactor.Width = 320
@@ -25,7 +25,7 @@ object fCreateChat: TfCreateChat
Size.Height = 251.000000000000000000
Size.PlatformDefault = False
inherited ccbStyleBorderColor: TColorComboBox
TabOrder = 32
TabOrder = 31
end
inherited Label40: TLabel
TabOrder = 8
@@ -42,9 +42,6 @@ object fCreateChat: TfCreateChat
inherited sbStyleBlockBorderSize: TSpinBox
TabOrder = 37
end
inherited sbStyleBlockPadding: TSpinBox
TabOrder = 45
end
inherited Label1: TLabel
TabOrder = 34
end
@@ -73,6 +70,12 @@ object fCreateChat: TfCreateChat
inherited Label41: TLabel
TabOrder = 6
end
inherited ccbFontColor: TColorComboBox
TabOrder = 36
end
inherited Label49: TLabel
TabOrder = 35
end
inherited Label46: TLabel
TabOrder = 39
end
uCreateNotify.fmx
+18 -9
View File
@@ -1,7 +1,7 @@
object fCreateNotify: TfCreateNotify
Left = 0
Top = 0
Caption = 'Form2'
Caption = #1056#1077#1076#1072#1082#1090#1086#1088' '#1086#1087#1086#1074#1077#1097#1077#1085#1080#1103
ClientHeight = 383
ClientWidth = 813
FormFactor.Width = 320
@@ -146,7 +146,7 @@ object fCreateNotify: TfCreateNotify
Position.X = 8.000000000000000000
Position.Y = 135.000000000000000000
Text = #1057#1086#1073#1099#1090#1080#1077
TabOrder = 51
TabOrder = 42
end
object cbEventsType: TComboBox
Items.Strings = (
@@ -160,22 +160,25 @@ object fCreateNotify: TfCreateNotify
Size.Width = 192.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 52
TabOrder = 43
OnChange = cbEventsTypeChange
end
object Label3: TLabel
Position.X = 8.000000000000000000
Position.Y = 190.000000000000000000
Text = #1059#1089#1083#1086#1074#1080#1077' '#1089#1091#1084#1084#1099
TabOrder = 53
Visible = False
TabOrder = 44
end
object edtIF: TEdit
Touch.InteractiveGestures = [LongTap, DoubleTap]
TabOrder = 54
TabOrder = 45
Position.X = 8.000000000000000000
Position.Y = 215.000000000000000000
Size.Width = 192.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
Visible = False
end
end
object btnCreateEvent: TButton
@@ -224,8 +227,11 @@ object fCreateNotify: TfCreateNotify
Size.Width = 241.000000000000000000
Size.Height = 115.000000000000000000
Size.PlatformDefault = False
inherited Label41: TLabel
TabOrder = 6
inherited ccbFontColor: TColorComboBox
TabOrder = 36
end
inherited Label49: TLabel
TabOrder = 35
end
inherited Label46: TLabel
TabOrder = 39
@@ -249,8 +255,11 @@ object fCreateNotify: TfCreateNotify
Size.Width = 241.000000000000000000
Size.Height = 115.000000000000000000
Size.PlatformDefault = False
inherited Label41: TLabel
TabOrder = 6
inherited ccbFontColor: TColorComboBox
TabOrder = 36
end
inherited Label49: TLabel
TabOrder = 35
end
inherited Label46: TLabel
TabOrder = 38
uCreateNotify.pas
+9 -3
View File
@@ -38,6 +38,7 @@ type
procedure FormCreate(Sender: TObject);
procedure btnCreateEventClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure cbEventsTypeChange(Sender: TObject);
private
{ Private declarations }
function GetColorFromColorPanel(aColor: TAlphaColor): string;
@@ -154,6 +155,12 @@ begin
close;
end;
procedure TfCreateNotify.cbEventsTypeChange(Sender: TObject);
begin
Label3.Visible := cbEventsType.ItemIndex = 4;
edtIF.Visible := cbEventsType.ItemIndex = 4;
end;
procedure TfCreateNotify.FormCreate(Sender: TObject);
var
i: integer;
@@ -268,8 +275,7 @@ begin
TCheckBox(c).IsChecked := DB.ReadSetting(TCheckBox(c).Name) = '1';
end;
end;
var
n := 1;
var
cDir := myconst.fontsPath; // Èñêàòü â ïàïêå ñ ïðîãðàììîé
var
@@ -284,7 +290,7 @@ begin
frFontSettings2.cbFontStyleDefault.Items.Add(SearchRec.Name);
frFontSettings3.cbFontStyleDefault.Items.Add(SearchRec.Name);
Inc(n);
end;
until FindNext(SearchRec) <> 0;
ChDir('..');
uDataBase.pas
+4 -12
View File
@@ -445,7 +445,6 @@ begin
if not CheckTableExists(TableName) then
begin
Context := TRttiContext.Create;
try
RttiType := Context.GetType(RecordTypeInfo);
FieldDefs := '';
for Field in RttiType.GetFields do
@@ -455,14 +454,11 @@ begin
FieldDefs := FieldDefs + Field.Name + ' ' + GetSQLType(Field);
end;
FConnection.ExecSQL(Format('CREATE TABLE %s (%s)', [TableName, FieldDefs]));
finally
Context.Free;
end;
end
else
begin
Context := TRttiContext.Create;
try
RttiType := Context.GetType(RecordTypeInfo);
Query := TFDQuery.Create(nil);
try
@@ -478,9 +474,7 @@ begin
finally
Query.Free;
end;
finally
Context.Free;
end;
end;
end;
@@ -507,7 +501,7 @@ begin
EnsureTableForRecord(TableName, TypeInfo(T));
Context := TRttiContext.Create;
try
RttiType := Context.GetType(TypeInfo(T));
Fields := RttiType.GetFields;
@@ -598,9 +592,7 @@ begin
finally
Query.Free;
end;
finally
Context.Free;
end;
end;
uGeneral.fmx
+17 -5
View File
@@ -1,7 +1,7 @@
object TTW_Bot: TTTW_Bot
Left = 480
Top = 0
Caption = 'Form1'
Caption = 'TTW_Bot'
ClientHeight = 886
ClientWidth = 970
Position = Designed
@@ -9,6 +9,7 @@ object TTW_Bot: TTTW_Bot
FormFactor.Height = 480
FormFactor.Devices = [Desktop]
OnCreate = FormCreate
OnDestroy = FormDestroy
Left = 480
DesignerMasterStyle = 0
object V: TTabControl
@@ -117,12 +118,12 @@ object TTW_Bot: TTTW_Bot
inherited btnDAStart: TButton
Images = ImageList1
ImageIndex = 18
TabOrder = 43
TabOrder = 42
OnClick = frSettings1btnDAStartClick
end
inherited btnGetDADef: TButton
Images = ImageList1
TabOrder = 45
TabOrder = 44
end
end
inherited btnOpenRomaning: TButton
@@ -660,23 +661,31 @@ object TTW_Bot: TTTW_Bot
end
end
inherited GroupBox17: TGroupBox
inherited edtCounterName: TEdit
TabOrder = 41
end
inherited edtCounterTrigger: TEdit
TabOrder = 39
end
inherited edtCounterCount: TEdit
TabOrder = 37
TabOrder = 38
end
inherited btnCounterAdd: TButton
Images = ImageList1
ImageIndex = 0
TabOrder = 40
end
inherited btnCounterDelete: TButton
Images = ImageList1
ImageIndex = 4
TabOrder = 38
TabOrder = 37
end
inherited btnCounterP: TButton
Images = ImageList1
ImageIndex = 0
Position.X = 416.000000000000000000
Size.Width = 22.000000000000000000
TabOrder = 43
Text = ''
end
inherited btnCounterM: TButton
@@ -684,13 +693,16 @@ object TTW_Bot: TTTW_Bot
ImageIndex = 12
Position.X = 449.000000000000000000
Size.Width = 22.000000000000000000
TabOrder = 44
Text = ''
end
inherited btnCounterEdit: TButton
Images = ImageList1
ImageIndex = 3
TabOrder = 45
end
inherited sgCounter: TStringGrid
TabOrder = 46
Viewport.Width = 463.000000000000000000
Viewport.Height = 121.000000000000000000
inherited scCounterTrigger: TStringColumn
uGeneral.pas
+57 -15
View File
@@ -61,11 +61,14 @@ type
procedure frSettings1btnDAStartClick(Sender: TObject);
procedure frCommands1btnRandAddClick(Sender: TObject);
procedure frOBS1btnDeleteeChatClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
procedure ReadDB();
public
{ Public declarations }
procedure toLog(aModule, aMethod, aMessage: string; aCode: integer);
procedure GlobalExceptionHandler(Sender: TObject; E: Exception);
end;
var
@@ -78,6 +81,15 @@ implementation
{$R *.fmx}
procedure TTTW_Bot.GlobalExceptionHandler(Sender: TObject; E: Exception);
begin
try
TTW_Bot.toLog('GlobalException', E.ClassName, E.Message, 2);
except
// íà ñëó÷àé, åñëè ëîããåð ñàì êèíåò èñêëþ÷åíèå
end;
end;
procedure TTTW_Bot.cbThemeChange(Sender: TObject);
begin
cbTheme.ItemIndex := cbTheme.Items.IndexOf(cbTheme.text);
@@ -89,7 +101,6 @@ end;
procedure TTTW_Bot.FormCreate(Sender: TObject);
var
Path: string;
SearchRec: TSearchRec;
function GetPathToTestExe: string; // âåðíåò ïàïêó romaming
begin
@@ -149,7 +160,15 @@ begin
for Path in TDirectory.GetFiles(myConst.stlPath) do
cbTheme.Items.Add(ExtractFileName(Path));
cbTheme.ItemIndex := strtoint(db.ReadSetting('cbTheme', '-1'));
frLog1.FLogList := TList<TRLog>.Create;
end;
procedure TTTW_Bot.FormDestroy(Sender: TObject);
begin
FreeAndNil(db);
FreeAndNil(frAutoActions1.FTimerList);
FreeAndNil(frLog1.FLogList);
inherited;
end;
procedure TTTW_Bot.frCommands1btnRandAddClick(Sender: TObject);
@@ -171,21 +190,13 @@ begin
end;
procedure TTTW_Bot.ReadDB;
var
I: Integer;
c: TComponent;
sl: TStringList;
SavedColor: TAlphaColor;
ColorStr: string;
function XorDecryptToStrings(const InputFile, Key: string): TStrings;
var
InStream: TFileStream;
MemStream: TMemoryStream;
KeyBytes: TBytes;
KeyLen, KeyIndex: Integer;
KeyLen, KeyIndex: integer;
B: Byte;
begin
// Ïðåîáðàçóåì êëþ÷ â áàéòû ñ èñïîëüçîâàíèåì ANSI êîäèðîâêè
@@ -229,7 +240,7 @@ var
// Çàãðóçêà êîìïîíåíòîâ íàñòðîåê (TEdit, TCheckBox)
procedure LoadSettingsComponents;
var
I: Integer;
I: integer;
c: TComponent;
begin
for I := 0 to frSettings1.ComponentCount - 1 do
@@ -266,7 +277,7 @@ var
procedure LoadEncryptedConfig;
var
sl: TStringList;
I: Integer;
I: integer;
begin
if not FileExists(myConst.cfg1) then
Exit;
@@ -318,7 +329,7 @@ var
// Çàãðóçêà íàñòðîåê óâåäîìëåíèé
procedure LoadNotifySettings;
var
I: Integer;
I: integer;
c: TComponent;
begin
for I := 0 to frNotify1.ComponentCount - 1 do
@@ -339,9 +350,9 @@ var
// Çàãðóçêà íàñòðîåê ÈÈ
procedure LoadAISettings;
var
I: Integer;
I: integer;
c: TComponent;
ii: Integer;
ii: integer;
// Íàñòðîéêè GigaChat
procedure SetupGigaChatSettings;
@@ -470,4 +481,35 @@ begin
pwidechar('https://www.flaticon.com/ru/authors/karacis'), nil, nil, 1);
end;
procedure TTTW_Bot.toLog(aModule, aMethod, aMessage: string; aCode: integer);
begin
TThread.Synchronize(nil,
procedure
var
ml: TRLog;
begin
// Èíèöèàëèçàöèÿ âñåõ ïîëåé çàïèñè
ml.rTime := Now;
case aCode of
0:
ml.rType := 'INFO';
1:
ml.rType := 'WARNING';
2:
ml.rType := 'ERROR';
3:
ml.rType := 'DEBUG';
else
ml.rType := 'UNKNOWN';
end;
ml.rModule := aModule; // string
ml.rMethod := aMethod; // string
ml.rMessage := aMessage; // string
// Äîáàâëÿåì çàïèñü â ñïèñîê
frLog1.FLogList.Add(ml);
// Îáíîâëÿåì ãðèä
frLog1.UpdateGridFilters;
end);
end;
end.
uRecords.pas
+9
View File
@@ -2,6 +2,15 @@ unit uRecords;
interface
type
TRLog = record
rTime: ttime;
rType: string;
rModule: string;
rMethod: string;
rMessage: string;
end;
type
TCounter = record
counterName: string;
uShowText.fmx
+3 -3
View File
@@ -1,7 +1,7 @@
object fShowText: TfShowText
Left = 0
Top = 0
Caption = 'fShowText'
Caption = #1057#1089#1099#1083#1082#1072' '#1085#1072' '#1072#1074#1090#1086#1088#1080#1079#1072#1094#1080#1102
ClientHeight = 295
ClientWidth = 498
FormFactor.Width = 320
@@ -16,8 +16,8 @@ object fShowText: TfShowText
Size.Height = 262.000000000000000000
Size.PlatformDefault = False
TabOrder = 0
Viewport.Width = 494.000000000000000000
Viewport.Height = 258.000000000000000000
Viewport.Width = 498.000000000000000000
Viewport.Height = 262.000000000000000000
end
object Panel1: TPanel
Align = Bottom
uTTWAPI.pas
+28 -15
View File
@@ -7,6 +7,9 @@ uses
IdMultipartFormData, DateUtils, uDataBase, System.Generics.Collections,
uRecords;
type
TOnLog = procedure(aModul: string; aMethod: string; aMessage:string; aLevel:integer) of object;
type
TTTW_API = class(TObject)
private
@@ -16,6 +19,7 @@ type
channel_name_api: string;
BotName_api: string;
FChatBadges:tlist<TChatBadge>;
FOnLog:TOnLog;
function GetFollowedAtFromJson(jsonString: string): string;
function getTTW(method: string; ClientID: string;
@@ -30,6 +34,8 @@ type
function patchTTW(method: string; ClientID: string; params: TStringStream;
isStreamer: boolean = false): string; overload;
procedure toLog(alevel:integer; amethod:string; amessage:string);
public
constructor Create(Sender: TObject);
destructor Destroy; override;
@@ -66,6 +72,7 @@ type
procedure GetChannelEmotes(var ce: Tlist<TEmotes>);
procedure GetGlobalEmotes(var ge: Tlist<TEmotes>);
function ValidateTwitchToken(const TokenName, TokenValue: string; var DayOfLive:integer): Boolean;
property OnLog: TOnLog read FOnLog write FOnLog;
end;
TChatBadges = TList<TChatBadge>;
TEmotesList = TList<TEmotes>;
@@ -849,6 +856,12 @@ begin
end;
end;
procedure TTTW_API.toLog(alevel: integer; amethod, amessage: string);
begin
if Assigned(FOnLog) then
FOnLog('uTTWAPI', aMethod, aMessage, aLevel);
end;
procedure TTTW_API.unBanUser(id: string);
begin
try
@@ -862,7 +875,7 @@ begin
except
on E: Exception do
//Form1.Log(2, 'TTTW_API.unBanUser', E.Message);
// flog.toLog(2,'TTW_API','unBanUser',E.Message);
toLog(2,'unBanUser',E.Message);
end;
end;
@@ -876,7 +889,7 @@ begin
except
on E: Exception do
//Form1.Log(2, 'TTTW_API.unRaid', E.Message);
// flog.toLog(2,'TTW_API','unRaid',E.Message);
toLog(2,'unRaid',E.Message);
end;
end;
@@ -900,7 +913,7 @@ begin
except
on E: Exception do
//Form1.Log(2, 'TTTW_API.UpdateCustomReward', E.Message);
// flog.toLog(2,'TTW_API','UpdateCustomReward',E.Message);
toLog(2,'UpdateCustomReward',E.Message);
end;
end;
@@ -920,8 +933,8 @@ begin
//Form1.Log(1, 'TTTW_API.UpdateRedemptionStatus', 'ChannelId: ' + qbid +
// '; Reward.id: ' + qrid + '; Redemption.id: ' + qid);
// flog.toLog(1,'TTW_API','UpdateRedemptionStatus','ChannelId: ' + qbid +
// '; Reward.id: ' + qrid + '; Redemption.id: ' + qid);
toLog(1,'UpdateRedemptionStatus','ChannelId: ' + qbid +
'; Reward.id: ' + qrid + '; Redemption.id: ' + qid);
RequestData := TStringStream.Create('{"status":"CANCELED"}', CP_UTF8);
try
patchTTW('channel_points/custom_rewards/redemptions?broadcaster_id=' +
@@ -933,7 +946,7 @@ begin
except
on E: Exception do
// Form1.Log(2, 'TTTW_API.UpdateRedemptionStatus', E.Message);
// flog.toLog(2,'TTW_API','UpdateRedemptionStatus',E.Message);
toLog(2,'UpdateRedemptionStatus',E.Message);
end;
end;
@@ -986,10 +999,10 @@ begin
try
if ResponseJSON.GetValue('expires_in') <> nil then
begin
//fLog.toLog(0, 'TokenCheck', TokenName,
// Format('Òîêåí äåéñòâèòåëåí. Îñòàëîñü: %d ñåê. Êëèåíò: %s',
// [ResponseJSON.GetValue('expires_in').Value.ToInteger,
// ResponseJSON.GetValue('client_id').Value]));
toLog(0, 'ValidateTwitchToken',
Format('Òîêåí äåéñòâèòåëåí. Îñòàëîñü: %d ñåê. Êëèåíò: %s',
[ResponseJSON.GetValue('expires_in').Value.ToInteger,
ResponseJSON.GetValue('client_id').Value]));
DayOfLive:=round(ResponseJSON.GetValue('expires_in').Value.ToInteger/60/60/24);
end;
Result := True;
@@ -998,19 +1011,19 @@ begin
end;
except
on E: Exception do
//fLog.toLog(2, 'TokenCheck', 'JSON Parse', E.Message);
toLog(2, 'ValidateTwitchToken', E.Message);
end;
end
else if StatusCode = 401 then
begin
//fLog.toLog(2, 'TokenCheck', TokenName, 'Invalid token');
toLog(2, 'ValidateTwitchToken', 'Invalid token');
DayOfLive:=0;
end
else
begin
DayOfLive:=0;
// fLog.toLog(2, 'TokenCheck', TokenName,
// Format('HTTP %d: %s', [StatusCode, ResponseText]));
toLog(2, 'ValidateTwitchToken',
Format('HTTP %d: %s', [StatusCode, ResponseText]));
end;
finally
@@ -1041,7 +1054,7 @@ begin
except
on E: Exception do
//Form1.Log(2, 'TTTW_API.warnUser', E.Message);
// flog.toLog(2,'TTW_API','warnUser',E.Message);
toLog(2,'warnUser',E.Message);
end;
end;
uTWAuth.pas
+164 -46
View File
@@ -4,7 +4,7 @@ interface
uses
System.SysUtils, System.Classes, IdContext, IdCustomHTTPServer, IdHTTPServer,
IdComponent, ShellAPI;
IdComponent, ShellAPI, System.Threading, Windows;
type
TmyEvent = procedure(txt: string) of object;
@@ -25,7 +25,6 @@ type
AResponseInfo: TIdHTTPResponseInfo);
procedure OnStatus(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: string);
public
constructor Create;
destructor Destroy; override;
@@ -33,44 +32,74 @@ type
procedure StopServer;
property OnToken: TmyEvent read FmyEvent write FmyEvent;
property OnError: TmyEvent read FmyEvent write FmyEvent;
end;
implementation
{ TTTWAuth }
constructor TTTWAuth.Create;
begin
inherited Create;
FHTTPServer := TIdHTTPServer.Create(nil);
FHTTPServer.OnCommandGet := HandleRequest;
FHTTPServer.OnStatus := OnStatus;
// Íå âêëþ÷àåì Active çäåñü
end;
destructor TTTWAuth.Destroy;
begin
FHTTPServer.Free;
try
if Assigned(FHTTPServer) then
begin
try
if FHTTPServer.Active then
FHTTPServer.Active := False;
except
end;
FreeAndNil(FHTTPServer);
end;
except
end;
inherited;
end;
procedure TTTWAuth.StartServer(aURL: string);
begin
// Çàùèòà îò ïîâòîðíîãî çàïóñêà
if Assigned(FHTTPServer) and FHTTPServer.Active then
Exit;
// Î÷èñòèì ñòàðûå áèíäèíãè, ÷òîáû íå íàêàïëèâàòü èõ
FHTTPServer.Bindings.Clear;
FHTTPServer.DefaultPort := 80;
// Äîáàâëÿåì áèíäèíã ÿâíî
FHTTPServer.Bindings.Add.SetBinding('127.0.0.1', 80);
FURL := aURL;
FHTTPServer.Active := True;
if FURL <> '' then
ShellExecute(0, 'open', pwidechar(FURL), nil, nil, 1);
ShellExecute(0, 'open', PWideChar(FURL), nil, nil, SW_SHOWNORMAL);
end;
procedure TTTWAuth.StopServer;
begin
if Assigned(FHTTPServer) then
begin
try
FHTTPServer.Active := False;
except
end;
try
FHTTPServer.Bindings.Clear;
except
end;
end;
end;
procedure TTTWAuth.HandleRequest(ASender: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
if ARequestInfo.Document = '/' then
HandleRootRequest(ARequestInfo, AResponseInfo)
else if ARequestInfo.Document = '/redirect' then
@@ -87,85 +116,174 @@ end;
procedure TTTWAuth.HandleRootRequest(ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
begin
AResponseInfo.ContentText := '<!DOCTYPE html>' + #13 + '<html>' + #13 +
'<head>' + #13 + ' <title>Redirecting...</title>' + #13 + '</head>' + #13 +
'<body>' + #13 + ' <p>ïîëó÷àþ òîêåí:</p>' + #13 + '<script>' + #13 +
'var paragraph = window.location.href;' + #13 +
'var urrl = paragraph.replace(''localhost/'',''localhost/redirect'');' + #13
+ 'urrl = urrl.replace(''#'',''?'');' + #13 + 'console.log(urrl);' + #13 +
'window.location.href =urrl;' + #13 + ' </script>' + #13 + '</body>' + #13 +
'</html>';
AResponseInfo.ContentText := '<!DOCTYPE html>' + sLineBreak + '<html>' +
sLineBreak + '<head>' + sLineBreak +
' <title>Redirecting...</title>' + sLineBreak + '</head>' + sLineBreak +
'<body>' + sLineBreak + ' <p>ïîëó÷àþ òîêåí:</p>' + sLineBreak + '<script>' +
sLineBreak + 'var paragraph = window.location.href;' + sLineBreak +
'var urrl = paragraph.replace(''localhost/'',''localhost/redirect'');' +
sLineBreak + 'urrl = urrl.replace(''#'',''?'');' + sLineBreak +
'console.log(urrl);' + sLineBreak + 'window.location.href =urrl;' +
sLineBreak + ' </script>' + sLineBreak + '</body>' + sLineBreak + '</html>';
end;
procedure TTTWAuth.OnStatus(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: string);
begin
// Ìîæíî ëîãèðîâàòü ñòàòóñ, íî íå îáÿçàòåëüíî
end;
procedure TTTWAuth.HandleDARequest(ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
begin
AResponseInfo.ContentText := '<!DOCTYPE html>' + #13 + '<html>' + #13 +
'<head>' + #13 + ' <title>Redirecting...</title>' + #13 + '</head>' + #13 +
'<body>' + #13 + ' <p>ïîëó÷àþ êîä</p>' + #13 + '<script>' + #13 +
'var paragraph = window.location.href;' + #13 +
AResponseInfo.ContentText := '<!DOCTYPE html>' + sLineBreak + '<html>' +
sLineBreak + '<head>' + sLineBreak +
' <title>Redirecting...</title>' + sLineBreak + '</head>' + sLineBreak +
'<body>' + sLineBreak + ' <p>ïîëó÷àþ êîä</p>' + sLineBreak + '<script>' +
sLineBreak + 'var paragraph = window.location.href;' + sLineBreak +
'var urrl = paragraph.replace(''localhost/da'',''localhost/redirect'');' +
#13 + 'urrl = urrl.replace(''#'',''?'');' + #13 + 'console.log(urrl);' + #13
+ 'window.location.href =urrl;' + #13 + ' </script>' + #13 + '</body>' + #13
+ '</html>';
sLineBreak + 'urrl = urrl.replace(''#'',''?'');' + sLineBreak +
'console.log(urrl);' + sLineBreak + 'window.location.href =urrl;' +
sLineBreak + ' </script>' + sLineBreak + '</body>' + sLineBreak + '</html>';
end;
procedure TTTWAuth.HandleRedirectRequest(ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
var
i: integer;
i: Integer;
AccessToken: string;
LTokenCopy: string;
begin
// Åñëè ïîëó÷åí access_token
if Pos('access_token=', ARequestInfo.Params.Text) > 0 then
begin
for i := 0 to ARequestInfo.Params.Count - 1 do
if Pos('access_token', ARequestInfo.Params[i]) > 0 then
AccessToken := ARequestInfo.Params[i];
AccessToken := StringReplace(AccessToken, 'access_token=', '',
[rfReplaceAll]);
AResponseInfo.ContentText := '<!DOCTYPE html>' + #13 + '<html>' + #13 +
'<head>' + #13 + ' <title>Done...</title>' + #13 + '</head>' + #13 +
'<body>' + #13 + 'Ýòó ñòðàíèöó ìîæíî çàêðûòü' + #13 + '</body>' + #13 +
'</html>';
AccessToken := StringReplace(AccessToken, 'access_token=', '', [rfReplaceAll]);
AResponseInfo.ContentText := '<!DOCTYPE html>' + sLineBreak + '<html>' +
sLineBreak + '<head>' + sLineBreak +
' <title>Done...</title>' + sLineBreak + '</head>' + sLineBreak +
'<body>' + sLineBreak + 'Ýòó ñòðàíèöó ìîæíî çàêðûòü' + sLineBreak +
'</body>' + sLineBreak + '</html>';
AResponseInfo.WriteContent;
OnToken(AccessToken);
Destroy;
// Êîïèðóåì òîêåí, ÷òîáû êîððåêòíî ïåðåäàòü â main thread
LTokenCopy := AccessToken;
// Âûçûâàåì OnToken â main thread
if Assigned(FmyEvent) then
TThread.Queue(nil,
procedure
begin
try
FmyEvent(LTokenCopy);
except
end;
end);
// Îñòàíîâèì ñåðâåð è çàïëàíèðóåì î÷èñòêó îáúåêòà â main thread
try
StopServer;
except
end;
TThread.Queue(nil,
procedure
begin
try
Free;
except
end;
end);
Exit;
end;
// Åñëè åñòü error_description
if Pos('error_description=', ARequestInfo.Params.Text) > 0 then
begin
for i := 0 to ARequestInfo.Params.Count - 1 do
if Pos('error_description', ARequestInfo.Params[i]) > 0 then
AccessToken := ARequestInfo.Params[i];
AccessToken := StringReplace(AccessToken, 'error_description=', '',
[rfReplaceAll]);
AResponseInfo.ContentText := '<!DOCTYPE html>' + #13 + '<html>' + #13 +
'<head>' + #13 + ' <title>ERROR...</title>' + #13 + '</head>' + #13 +
'<body>' + #13 + AccessToken + #13 + '</body>' + #13 +
'</html>';
AccessToken := StringReplace(AccessToken, 'error_description=', '', [rfReplaceAll]);
AResponseInfo.ContentText := '<!DOCTYPE html>' + sLineBreak + '<html>' +
sLineBreak + '<head>' + sLineBreak +
' <title>ERROR...</title>' + sLineBreak + '</head>' + sLineBreak +
'<body>' + sLineBreak + AccessToken + sLineBreak + '</body>' + sLineBreak + '</html>';
AResponseInfo.WriteContent;
OnError(AccessToken);
Destroy;
LTokenCopy := AccessToken;
if Assigned(FmyEvent) then
TThread.Queue(nil,
procedure
begin
try
FmyEvent(LTokenCopy);
except
end;
end);
try
StopServer;
except
end;
TThread.Queue(nil,
procedure
begin
try
Free;
except
end;
end);
Exit;
end;
// Åñëè ïîëó÷åí code=
if Pos('code=', ARequestInfo.Params.Text) > 0 then
begin
for i := 0 to ARequestInfo.Params.Count - 1 do
if Pos('code', ARequestInfo.Params[i]) > 0 then
AccessToken := ARequestInfo.Params[i];
AccessToken := StringReplace(AccessToken, 'code=', '', [rfReplaceAll]);
AResponseInfo.ContentText := '<!DOCTYPE html>' + #13 + '<html>' + #13 +
'<head>' + #13 + ' <title>Done...</title>' + #13 + '</head>' + #13 +
'<body>' + #13 + 'Ýòó ñòðàíèöó ìîæíî çàêðûòü' + #13 + '</body>' + #13 +
'</html>';
AResponseInfo.ContentText := '<!DOCTYPE html>' + sLineBreak + '<html>' +
sLineBreak + '<head>' + sLineBreak +
' <title>Done...</title>' + sLineBreak + '</head>' + sLineBreak +
'<body>' + sLineBreak + 'Ýòó ñòðàíèöó ìîæíî çàêðûòü' + sLineBreak +
'</body>' + sLineBreak + '</html>';
AResponseInfo.WriteContent;
OnToken(AccessToken);
Destroy;
LTokenCopy := AccessToken;
if Assigned(FmyEvent) then
TThread.Queue(nil,
procedure
begin
try
FmyEvent(LTokenCopy);
except
end;
end);
try
StopServer;
except
end;
TThread.Queue(nil,
procedure
begin
try
Free;
except
end;
end);
Exit;
end;
// Ïî óìîë÷àíèþ — 404
AResponseInfo.ResponseNo := 404;
AResponseInfo.ContentText := 'Not Found';
AResponseInfo.WriteContent;
end;
end.
uWSDA.pas
+105 -32
View File
@@ -7,7 +7,8 @@ uses
type
TOnDonateEvent = procedure(aNick, aMessage, aSum: string) of object;
TOnStatusEvent = procedure(AStatusText: string; AStatusCode:integer) of object;
TOnStatusEvent = procedure(AStatusText: string; AStatusCode: integer) of object;
TOnLog = procedure(aModul: string; aMethod: string; aMessage: string; aLevel: integer) of object;
TWSClient = class(TObject)
private
@@ -15,16 +16,17 @@ type
FAPIClient: TAPIClient;
FOnDonate: TOnDonateEvent;
FOnStatus: TOnStatusEvent;
FOnLog: TOnLog;
FWsstoken: string;
FWSID: string;
procedure DataIn(Sender: TObject; DataFormat: Integer; const Text: string;
procedure DataIn(Sender: TObject; DataFormat: integer; const Text: string;
const TextB: TBytes; EOM, EOL: Boolean);
procedure ConnectionStatus(Sender: TObject; const ConnectionEvent: string;
StatusCode: Integer; const Description: string);
procedure Error(Sender: TObject; ErrorCode: Integer;
const Description: string);
StatusCode: integer; const Description: string);
procedure Error(Sender: TObject; ErrorCode: integer; const Description: string);
function ExtractValue(const T_, Text, _T: string): string;
procedure HandleIncomingData(const Data: string);
procedure toLog(aLevel: integer; aMethod: string; aMessage: string);
public
constructor Create;
destructor Destroy; override;
@@ -33,6 +35,7 @@ type
procedure Send(const Data: string);
property OnDonate: TOnDonateEvent read FOnDonate write FOnDonate;
property OnStatus: TOnStatusEvent read FOnStatus write FOnStatus;
property OnLog: TOnLog read FOnLog write FOnLog;
property Wsstoken: string read FWsstoken write FWsstoken;
property WSID: string read FWSID write FWSID;
property APIClient: TAPIClient read FAPIClient write FAPIClient;
@@ -42,60 +45,112 @@ implementation
constructor TWSClient.Create;
begin
inherited Create;
FWS := TipwWSClient.Create(nil);
FWS.OnDataIn := DataIn;
FWS.OnConnectionStatus := ConnectionStatus;
FWS.OnError := Error;
FAPIClient := nil;
FOnDonate := nil;
FOnStatus := nil;
FOnLog := nil;
end;
destructor TWSClient.Destroy;
begin
try
if Assigned(FWS) then
begin
try
// î÷èñòèì îáðàáîò÷èêè ÷òîáû íå áûëî îáðàòíûõ âûçîâîâ â ìîìåíò îñâîáîæäåíèÿ
FWS.OnDataIn := nil;
FWS.OnConnectionStatus := nil;
FWS.OnError := nil;
try
FWS.Disconnect;
FWS.Free;
except
// èãíîðèðóåì îøèáêè ïðè îòêëþ÷åíèè
end;
finally
FreeAndNil(FWS);
end;
end;
except
// íè÷åãî íå äåëàåì — çàùèòà îò èñêëþ÷åíèé â äåñòðóêòîðå
end;
inherited;
end;
procedure TWSClient.Disconnect;
begin
FWS.Disconnect;
if Assigned(FWS) then
begin
try
FWS.Disconnect;
except
// èãíîðèðóåì
end;
end;
end;
procedure TWSClient.Connect(const WSSURL: string);
begin
if Assigned(FWS) then
begin
try
FWS.ConnectTo(WSSURL);
except
// ëîãèðîâàòü ïðè íåîáõîäèìîñòè
toLog(2, 'Connect', 'Exception on Connect');
end;
end;
end;
procedure TWSClient.Send(const Data: string);
begin
if Assigned(FWS) then
begin
try
FWS.SendText(Data);
except
toLog(2, 'Send', 'Exception on Send');
end;
end;
end;
procedure TWSClient.DataIn(Sender: TObject; DataFormat: Integer;
procedure TWSClient.toLog(aLevel: integer; aMethod: string; aMessage: string);
begin
if Assigned(FOnLog) then
FOnLog('uWSDA', aMethod, aMessage, aLevel);
end;
procedure TWSClient.DataIn(Sender: TObject; DataFormat: integer;
const Text: string; const TextB: TBytes; EOM, EOL: Boolean);
begin
try
HandleIncomingData(Text);
// FWS.Ping;
except
on E: Exception do
toLog(2, 'DataIn', E.Message);
end;
//FWS.Ping; // åñëè íóæíî
end;
procedure TWSClient.ConnectionStatus(Sender: TObject;
const ConnectionEvent: string; StatusCode: Integer;
const Description: string);
procedure TWSClient.ConnectionStatus(Sender: TObject; const ConnectionEvent: string;
StatusCode: integer; const Description: string);
begin
if Assigned(FOnStatus) then
FOnStatus(ConnectionEvent,StatusCode);
FOnStatus(ConnectionEvent, StatusCode);
end;
procedure TWSClient.Error(Sender: TObject; ErrorCode: Integer;
const Description: string);
procedure TWSClient.Error(Sender: TObject; ErrorCode: integer; const Description: string);
begin
// fLog.toLog(2, 'uWSDA', 'Error', 'Code: ' + IntToStr(ErrorCode) + ' - ' +
// Description);
toLog(2, 'Error', '[' + IntToStr(ErrorCode) + '] ' + Description);
end;
function TWSClient.ExtractValue(const T_, Text, _T: string): string;
var
StartPos, EndPos: Integer;
StartPos, EndPos: integer;
begin
StartPos := Pos(T_, Text);
if StartPos = 0 then
@@ -110,42 +165,59 @@ end;
procedure TWSClient.HandleIncomingData(const Data: string);
var
JSON: TJSONObject;
jo: TJSONObject;
DataObj: TJSONObject;
DonationData: TJSONObject;
ChannelArray: TJSONArray;
jo: TJSONObject;
wsstoken2: string;
begin
// fLog.toLog(3, 'uWSDA', 'HandleIncomingData', Data);
toLog(3, 'HandleIncomingData', Data);
// Îáðàáîòêà ðåãèñòðàöèè êëèåíòà
if Pos('"result":{"client":"', Data) > 0 then
begin
FWsstoken := ExtractValue('"result":{"client":"', Data, '",');
// fLog.toLog(3, 'uWSDA', 'HandleIncomingData', 'Êëèåíò çàðåãèñòðèðîâàí');
toLog(3, 'HandleIncomingData', 'Êëèåíò çàðåãèñòðèðîâàí');
if Assigned(FAPIClient) then
begin
try
jo := FAPIClient.SubscribeToChannel(FWSID, FWsstoken);
// fLog.toLog(3, 'uWSDA', 'HandleIncomingData', 'Êëèåíò ïîäïèñàí');
except
jo := nil;
end;
if Assigned(jo) then
try
toLog(3, 'HandleIncomingData', 'Êëèåíò ïîäïèñàí');
ChannelArray := jo.Values['channels'] as TJSONArray;
if Assigned(ChannelArray) and (ChannelArray.Count > 0) then
begin
wsstoken2 := ChannelArray.Items[0].GetValue<string>('token');
// fLog.toLog(3, 'da', 'EventWS', 'Ïîäïèñêà íà êàíàë ñ òîêåíîì: ' +
// wsstoken2);
FWS.SendText('{"params": {"channel": "$alerts:donation_' + FWSID +
'","token": "' + wsstoken2 + '"},"method": 1,"id": 2 }');
toLog(3, 'HandleIncomingData', 'Ïîäïèñêà íà êàíàë ñ òîêåíîì: ' + wsstoken2);
try
FWS.SendText('{"params": {"channel": "$alerts:donation_' + FWSID + '","token": "' + wsstoken2 + '"},"method": 1,"id": 2 }');
except
toLog(2, 'HandleIncomingData', 'SendText failed');
end;
end;
finally
jo.Free;
end;
end;
end;
// Îáðàáîòêà äîíàòîâ
if Pos('"name":"Donations"', Data) > 0 then
begin
// fLog.toLog(3, 'uWSDA', 'HandleIncomingData', 'Íîâûé Äîíàò');
JSON := TJSONObject.ParseJSONValue(Data) as TJSONObject;
toLog(3, 'HandleIncomingData', 'Íîâûé Äîíàò');
JSON := nil;
try
DataObj := JSON.GetValue<TJSONObject>('result').GetValue<TJSONObject>
('data').GetValue<TJSONObject>('data');
JSON := TJSONObject.ParseJSONValue(Data) as TJSONObject;
if Assigned(JSON) then
begin
DataObj := JSON.GetValue<TJSONObject>('result').GetValue<TJSONObject>('data').GetValue<TJSONObject>('data');
if Assigned(DataObj) and Assigned(FOnDonate) then
FOnDonate(DataObj.GetValue<string>('username'),
DataObj.GetValue<string>('message'),
DataObj.GetValue<string>('amount'));
end;
finally
JSON.Free;
end;
@@ -153,3 +225,4 @@ begin
end;
end.