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

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
+8 -1
View File
@@ -1,7 +1,7 @@
program TTW_Bot_app; program TTW_Bot_app;
uses uses
System.StartUpCopy, System.StartUpCopy, SysUtils,
FMX.Forms, FMX.Forms,
uGeneral in 'uGeneral.pas' {TTW_Bot} , uGeneral in 'uGeneral.pas' {TTW_Bot} ,
fSettings in 'fSettings.pas' {frSettings: TFrame} , fSettings in 'fSettings.pas' {frSettings: TFrame} ,
@@ -32,11 +32,18 @@ uses
{$R *.res} {$R *.res}
begin begin
{$IFDEF DEBUG}
ReportMemoryLeaksOnShutdown := True;
{$ENDIF}
Application.Initialize; Application.Initialize;
Application.CreateForm(TTTW_Bot, TTW_Bot); Application.CreateForm(TTTW_Bot, TTW_Bot);
Application.OnException := TTW_Bot.GlobalExceptionHandler;
Application.CreateForm(TfCreateChat, fCreateChat); Application.CreateForm(TfCreateChat, fCreateChat);
Application.CreateForm(TfCreateNotify, fCreateNotify); Application.CreateForm(TfCreateNotify, fCreateNotify);
Application.CreateForm(TfShowText, fShowText); Application.CreateForm(TfShowText, fShowText);
Application.CreateForm(TfrmQ, frmQ); Application.CreateForm(TfrmQ, frmQ);
Application.Run; Application.Run;
end. end.
+29 -17
View File
@@ -286,6 +286,11 @@
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''"> <PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<DCC_RemoteDebug>false</DCC_RemoteDebug> <DCC_RemoteDebug>false</DCC_RemoteDebug>
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode> <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>
<PropertyGroup Condition="'$(Cfg_1_Win64)'!=''"> <PropertyGroup Condition="'$(Cfg_1_Win64)'!=''">
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode> <AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
@@ -298,6 +303,12 @@
</PropertyGroup> </PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''"> <PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode> <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>
<PropertyGroup Condition="'$(Cfg_2_Win64)'!=''"> <PropertyGroup Condition="'$(Cfg_2_Win64)'!=''">
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode> <AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
@@ -308,88 +319,71 @@
</DelphiCompile> </DelphiCompile>
<DCCReference Include="uGeneral.pas"> <DCCReference Include="uGeneral.pas">
<Form>TTW_Bot</Form> <Form>TTW_Bot</Form>
<FormType>fmx</FormType>
</DCCReference> </DCCReference>
<DCCReference Include="fSettings.pas"> <DCCReference Include="fSettings.pas">
<Form>frSettings</Form> <Form>frSettings</Form>
<FormType>fmx</FormType>
<DesignClass>TFrame</DesignClass> <DesignClass>TFrame</DesignClass>
</DCCReference> </DCCReference>
<DCCReference Include="fAI.pas"> <DCCReference Include="fAI.pas">
<Form>frAI</Form> <Form>frAI</Form>
<FormType>fmx</FormType>
<DesignClass>TFrame</DesignClass> <DesignClass>TFrame</DesignClass>
</DCCReference> </DCCReference>
<DCCReference Include="fNotify.pas"> <DCCReference Include="fNotify.pas">
<Form>frNotify</Form> <Form>frNotify</Form>
<FormType>fmx</FormType>
<DesignClass>TFrame</DesignClass> <DesignClass>TFrame</DesignClass>
</DCCReference> </DCCReference>
<DCCReference Include="fAutoActions.pas"> <DCCReference Include="fAutoActions.pas">
<Form>frAutoActions</Form> <Form>frAutoActions</Form>
<FormType>fmx</FormType>
<DesignClass>TFrame</DesignClass> <DesignClass>TFrame</DesignClass>
</DCCReference> </DCCReference>
<DCCReference Include="fOBS.pas"> <DCCReference Include="fOBS.pas">
<Form>frOBS</Form> <Form>frOBS</Form>
<FormType>fmx</FormType>
<DesignClass>TFrame</DesignClass> <DesignClass>TFrame</DesignClass>
</DCCReference> </DCCReference>
<DCCReference Include="fLog.pas"> <DCCReference Include="fLog.pas">
<Form>frLog</Form> <Form>frLog</Form>
<FormType>fmx</FormType>
<DesignClass>TFrame</DesignClass> <DesignClass>TFrame</DesignClass>
</DCCReference> </DCCReference>
<DCCReference Include="uRecords.pas"/> <DCCReference Include="uRecords.pas"/>
<DCCReference Include="fCommands.pas"> <DCCReference Include="fCommands.pas">
<Form>frCommands</Form> <Form>frCommands</Form>
<FormType>fmx</FormType>
<DesignClass>TFrame</DesignClass> <DesignClass>TFrame</DesignClass>
</DCCReference> </DCCReference>
<DCCReference Include="uDataBase.pas"/> <DCCReference Include="uDataBase.pas"/>
<DCCReference Include="fColorSettings.pas"> <DCCReference Include="fColorSettings.pas">
<Form>frColorSettings</Form> <Form>frColorSettings</Form>
<FormType>fmx</FormType>
<DesignClass>TFrame</DesignClass> <DesignClass>TFrame</DesignClass>
</DCCReference> </DCCReference>
<DCCReference Include="uCreateChat.pas"> <DCCReference Include="uCreateChat.pas">
<Form>fCreateChat</Form> <Form>fCreateChat</Form>
<FormType>fmx</FormType>
</DCCReference> </DCCReference>
<DCCReference Include="fFontSettings.pas"> <DCCReference Include="fFontSettings.pas">
<Form>frFontSettings</Form> <Form>frFontSettings</Form>
<FormType>fmx</FormType>
<DesignClass>TFrame</DesignClass> <DesignClass>TFrame</DesignClass>
</DCCReference> </DCCReference>
<DCCReference Include="uCreateNotify.pas"> <DCCReference Include="uCreateNotify.pas">
<Form>fCreateNotify</Form> <Form>fCreateNotify</Form>
<FormType>fmx</FormType>
</DCCReference> </DCCReference>
<DCCReference Include="uTWAuth.pas"/> <DCCReference Include="uTWAuth.pas"/>
<DCCReference Include="uTTWAPI.pas"/> <DCCReference Include="uTTWAPI.pas"/>
<DCCReference Include="uAPIDA.pas"/> <DCCReference Include="uAPIDA.pas"/>
<DCCReference Include="uShowText.pas"> <DCCReference Include="uShowText.pas">
<Form>fShowText</Form> <Form>fShowText</Form>
<FormType>fmx</FormType>
</DCCReference> </DCCReference>
<DCCReference Include="uWSDA.pas"/> <DCCReference Include="uWSDA.pas"/>
<DCCReference Include="uQ.pas"> <DCCReference Include="uQ.pas">
<Form>frmQ</Form> <Form>frmQ</Form>
<FormType>fmx</FormType>
</DCCReference> </DCCReference>
<DCCReference Include="fSimpleGrid.pas"> <DCCReference Include="fSimpleGrid.pas">
<Form>frSimpleGrid</Form> <Form>frSimpleGrid</Form>
<FormType>fmx</FormType>
<DesignClass>TFrame</DesignClass> <DesignClass>TFrame</DesignClass>
</DCCReference> </DCCReference>
<DCCReference Include="fContruct.pas"> <DCCReference Include="fContruct.pas">
<Form>frContruct</Form> <Form>frContruct</Form>
<FormType>fmx</FormType>
<DesignClass>TFrame</DesignClass> <DesignClass>TFrame</DesignClass>
</DCCReference> </DCCReference>
<DCCReference Include="fGroupsRequest.pas"> <DCCReference Include="fGroupsRequest.pas">
<Form>frGroupsRequest</Form> <Form>frGroupsRequest</Form>
<FormType>fmx</FormType>
<DesignClass>TFrame</DesignClass> <DesignClass>TFrame</DesignClass>
</DCCReference> </DCCReference>
<DCCReference Include="uMyTimer.pas"/> <DCCReference Include="uMyTimer.pas"/>
@@ -415,6 +409,10 @@
<Source> <Source>
<Source Name="MainSource">TTW_Bot_app.dpr</Source> <Source Name="MainSource">TTW_Bot_app.dpr</Source>
</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> </Delphi.Personality>
<Deployment Version="5"> <Deployment Version="5">
<DeployFile LocalName="$(BDS)\Redist\iossimulator\libcgunwind.1.0.dylib" Class="DependencyModule"> <DeployFile LocalName="$(BDS)\Redist\iossimulator\libcgunwind.1.0.dylib" Class="DependencyModule">
@@ -432,6 +430,20 @@
<Overwrite>true</Overwrite> <Overwrite>true</Overwrite>
</Platform> </Platform>
</DeployFile> </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"> <DeployFile LocalName=".gitignore" Configuration="Debug" Class="ProjectFile">
<Platform Name="Win32"> <Platform Name="Win32">
<RemoteDir>.\</RemoteDir> <RemoteDir>.\</RemoteDir>
Binary file not shown.

After

Width:  |  Height:  |  Size: 66 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 91 KiB

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