diff --git a/TTW_Bot_app.dpr b/TTW_Bot_app.dpr
index f5acd68..1ca6deb 100644
--- a/TTW_Bot_app.dpr
+++ b/TTW_Bot_app.dpr
@@ -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.
diff --git a/TTW_Bot_app.dproj b/TTW_Bot_app.dproj
index 184bd12..f7271e7 100644
--- a/TTW_Bot_app.dproj
+++ b/TTW_Bot_app.dproj
@@ -286,6 +286,11 @@
false
PerMonitorV2
+ true
+ 1033
+ TTW_Bot_app_Icon1.ico
+ ..\ttw_fmx_v9\fawico_44_2.png
+ ..\ttw_fmx_v9\fawico_150_2.png
PerMonitorV2
@@ -298,6 +303,12 @@
PerMonitorV2
+ true
+ 10
+ 1
+ 1
+ 1049
+ 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=
PerMonitorV2
@@ -308,88 +319,71 @@
- fmx
- fmx
TFrame
- fmx
TFrame
- fmx
TFrame
- fmx
TFrame
- fmx
TFrame
- fmx
TFrame
- fmx
TFrame
- fmx
TFrame
- fmx
- fmx
TFrame
- fmx
- fmx
- fmx
- fmx
TFrame
- fmx
TFrame
- fmx
TFrame
@@ -415,6 +409,10 @@
TTW_Bot_app.dpr
+
+ Microsoft Office 2000 Sample Automation Server Wrapper Components
+ Microsoft Office XP Sample Automation Server Wrapper Components
+
@@ -432,6 +430,20 @@
true
+
+
+ Assets\
+ Logo150x150.png
+ true
+
+
+
+
+ Assets\
+ Logo44x44.png
+ true
+
+
.\
diff --git a/TTW_Bot_app_Icon.ico b/TTW_Bot_app_Icon.ico
new file mode 100644
index 0000000..da28655
Binary files /dev/null and b/TTW_Bot_app_Icon.ico differ
diff --git a/TTW_Bot_app_Icon1.ico b/TTW_Bot_app_Icon1.ico
new file mode 100644
index 0000000..dca514b
Binary files /dev/null and b/TTW_Bot_app_Icon1.ico differ
diff --git a/fAutoActions.pas b/fAutoActions.pas
index e33e6ee..7aa3658 100644
--- a/fAutoActions.pas
+++ b/fAutoActions.pas
@@ -76,6 +76,7 @@ type
listTimer: TArray;
listBanWords: TArray;
listCounters: TArray;
+ 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('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;
diff --git a/fFontSettings.pas b/fFontSettings.pas
index fa2f0ca..b44d70d 100644
--- a/fFontSettings.pas
+++ b/fFontSettings.pas
@@ -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;
diff --git a/fLog.fmx b/fLog.fmx
index a80085b..53ba1b8 100644
--- a/fLog.fmx
+++ b/fLog.fmx
@@ -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
diff --git a/fLog.pas b/fLog.pas
index d22df5d..f5f6cdb 100644
--- a/fLog.pas
+++ b/fLog.pas
@@ -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;
+ 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.
diff --git a/fOBS.pas b/fOBS.pas
index 502232b..ffa60f3 100644
--- a/fOBS.pas
+++ b/fOBS.pas
@@ -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);
diff --git a/fSettings.fmx b/fSettings.fmx
index 9584a3c..d8bd93b 100644
--- a/fSettings.fmx
+++ b/fSettings.fmx
@@ -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
diff --git a/fSettings.pas b/fSettings.pas
index 87f3d34..f2bfcec 100644
--- a/fSettings.pas
+++ b/fSettings.pas
@@ -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,33 +114,84 @@ var
begin
if btnDAStart.text = 'Подключиться' then
begin
- try // Получение токена
- if FAPIClient.Token = '' then
- begin
- FAPIClient.Token := FAPIClient.GetAccessToken(edtDAClientID.text,
- edtDAClientSecret.text, edtDARedirectURL.text, edtDACode.text);
- FWSClient.APIClient := FAPIClient;
- UserInfo := FAPIClient.GetUserInfo;
- Data := UserInfo.GetValue('data');
- FWSClient.Wsstoken := Data.GetValue('socket_connection_token');
- FWSClient.WSID := Data.GetValue('id');
+ UserInfo := nil;
+ try
+ try
+ if not Assigned(FAPIClient) then
+ init;
+
+ if FAPIClient.Token = '' then
+ begin
+ 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('data');
+ FWSClient.Wsstoken := Data.GetValue('socket_connection_token');
+ FWSClient.WSID := Data.GetValue('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;
+
+ except
+ on E: Exception do
+ TTW_Bot.toLog('fSettings', 'btnDAStartClick', 'Неизвестная ошибка: ' + E.Message,2);
end;
- // Получение информации о пользователе
-
-
- FWSClient.Connect
- ('wss://centrifugo.donationalerts.com/connection/websocket');
- FWSClient.Send(Format('{"params":{"token":"%s"},"id":1}',
- [FWSClient.Wsstoken]));
finally
UserInfo.Free;
end;
end
else
begin
- FWSClient.Disconnect;
- btnDAStart.ImageIndex := 18;
- btnDAStart.text := 'Подключиться';
+ 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;
@@ -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' +
@@ -246,7 +302,7 @@ end;
procedure TfrSettings.btnOpenRomaningClick(Sender: TObject);
begin
- ShellExecute(0, 'open', pwidechar(ExtractFilePath(myConst.DBPath)),
+ ShellExecute(0, 'open', pwidechar(ExtractFilePath(myConst.DBPath)),
nil, nil, 1);
end;
@@ -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
- FAPIClient := TAPIClient.Create;
- FWSClient := TWSClient.Create;
- FWSClient.OnStatus := HandleWSStatus;
- FWSClient.OnDonate := HandleWSDonate;
+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);
diff --git a/uAPIDA.pas b/uAPIDA.pas
index 0b401bd..16f476e 100644
--- a/uAPIDA.pas
+++ b/uAPIDA.pas
@@ -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;
- inherited;
+ // Отключаем и освобождаем в безопасном порядке
+ 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.
+
diff --git a/uCreateChat.fmx b/uCreateChat.fmx
index f01cd9d..10e2f44 100644
--- a/uCreateChat.fmx
+++ b/uCreateChat.fmx
@@ -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
diff --git a/uCreateNotify.fmx b/uCreateNotify.fmx
index 4f18629..36b84bd 100644
--- a/uCreateNotify.fmx
+++ b/uCreateNotify.fmx
@@ -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
diff --git a/uCreateNotify.pas b/uCreateNotify.pas
index dc48e6f..ac877ae 100644
--- a/uCreateNotify.pas
+++ b/uCreateNotify.pas
@@ -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('..');
diff --git a/uDataBase.pas b/uDataBase.pas
index 24517aa..656f0d8 100644
--- a/uDataBase.pas
+++ b/uDataBase.pas
@@ -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;
diff --git a/uGeneral.fmx b/uGeneral.fmx
index 5a2daea..c4990ab 100644
--- a/uGeneral.fmx
+++ b/uGeneral.fmx
@@ -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
diff --git a/uGeneral.pas b/uGeneral.pas
index 1c30069..13257f3 100644
--- a/uGeneral.pas
+++ b/uGeneral.pas
@@ -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.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.
diff --git a/uRecords.pas b/uRecords.pas
index 6288713..d91562e 100644
--- a/uRecords.pas
+++ b/uRecords.pas
@@ -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;
diff --git a/uShowText.fmx b/uShowText.fmx
index bdb0978..d9b9bde 100644
--- a/uShowText.fmx
+++ b/uShowText.fmx
@@ -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
diff --git a/uTTWAPI.pas b/uTTWAPI.pas
index 2f033fe..65dcdae 100644
--- a/uTTWAPI.pas
+++ b/uTTWAPI.pas
@@ -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;
+ 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);
procedure GetGlobalEmotes(var ge: Tlist);
function ValidateTwitchToken(const TokenName, TokenValue: string; var DayOfLive:integer): Boolean;
+ property OnLog: TOnLog read FOnLog write FOnLog;
end;
TChatBadges = TList;
TEmotesList = TList;
@@ -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;
diff --git a/uTWAuth.pas b/uTWAuth.pas
index 62b929b..9163a86 100644
--- a/uTWAuth.pas
+++ b/uTWAuth.pas
@@ -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
- FHTTPServer.Active := False;
-
+ 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 := '' + #13 + '' + #13 +
- '' + #13 + ' Redirecting...' + #13 + '' + #13 +
- '' + #13 + ' получаю токен:
' + #13 + '' + #13 + '' + #13 +
- '';
+ AResponseInfo.ContentText := '' + sLineBreak + '' +
+ sLineBreak + '' + sLineBreak +
+ ' Redirecting...' + sLineBreak + '' + sLineBreak +
+ '' + sLineBreak + ' получаю токен:
' + sLineBreak + '' + sLineBreak + '' + sLineBreak + '';
end;
procedure TTTWAuth.OnStatus(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: string);
begin
-
+ // Можно логировать статус, но не обязательно
end;
procedure TTTWAuth.HandleDARequest(ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
begin
- AResponseInfo.ContentText := '' + #13 + '' + #13 +
- '' + #13 + ' Redirecting...' + #13 + '' + #13 +
- '' + #13 + ' получаю код
' + #13 + '' + #13 + '' + #13
- + '';
+ sLineBreak + 'urrl = urrl.replace(''#'',''?'');' + sLineBreak +
+ 'console.log(urrl);' + sLineBreak + 'window.location.href =urrl;' +
+ sLineBreak + ' ' + sLineBreak + ' ' + sLineBreak + '