добавил часть модулей, нужно переделать БД на records

This commit is contained in:
PC1\PTyTb
2025-08-06 14:54:32 +03:00
parent d68064187d
commit dacd2e6050
23 changed files with 2610 additions and 201 deletions
+11 -3
View File
@@ -3,7 +3,7 @@ program TTW_Bot_app;
uses
System.StartUpCopy,
FMX.Forms,
uGeneral in 'uGeneral.pas' {Form1},
uGeneral in 'uGeneral.pas' {TTW_Bot},
fSettings in 'fSettings.pas' {frSettings: TFrame},
fAI in 'fAI.pas' {frAI: TFrame},
fNotify in 'fNotify.pas' {frNotify: TFrame},
@@ -16,14 +16,22 @@ uses
fColorSettings in 'fColorSettings.pas' {frColorSettings: TFrame},
uCreateChat in 'uCreateChat.pas' {fCreateChat},
fFontSettings in 'fFontSettings.pas' {frFontSettings: TFrame},
uCreateNotify in 'uCreateNotify.pas' {fCreateNotify};
uCreateNotify in 'uCreateNotify.pas' {fCreateNotify},
uTWAuth in 'uTWAuth.pas',
uTTWAPI in 'uTTWAPI.pas',
uAPIDA in 'uAPIDA.pas',
uShowText in 'uShowText.pas' {fShowText},
uWSDA in 'uWSDA.pas',
uQ in 'uQ.pas' {frmQ};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.CreateForm(TTTW_Bot, TTW_Bot);
Application.CreateForm(TfCreateChat, fCreateChat);
Application.CreateForm(TfCreateNotify, fCreateNotify);
Application.CreateForm(TfShowText, fShowText);
Application.CreateForm(TfrmQ, frmQ);
Application.Run;
end.
+13 -1
View File
@@ -307,7 +307,7 @@
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="uGeneral.pas">
<Form>Form1</Form>
<Form>TTW_Bot</Form>
<FormType>fmx</FormType>
</DCCReference>
<DCCReference Include="fSettings.pas">
@@ -365,6 +365,18 @@
<Form>fCreateNotify</Form>
<FormType>fmx</FormType>
</DCCReference>
<DCCReference Include="uTWAuth.pas"/>
<DCCReference Include="uTTWAPI.pas"/>
<DCCReference Include="uAPIDA.pas"/>
<DCCReference Include="uShowText.pas">
<Form>fShowText</Form>
<FormType>fmx</FormType>
</DCCReference>
<DCCReference Include="uWSDA.pas"/>
<DCCReference Include="uQ.pas">
<Form>frmQ</Form>
<FormType>fmx</FormType>
</DCCReference>
<None Include=".gitignore"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
+5
View File
@@ -0,0 +1,5 @@
QKPG@VrKK3q|#/<6# #?2r?3t&)_< +6s 
q ,*< m.~|0256{|I *55w" KK8WZFD
-!2->1-7)WDB2,/7p-t+$kmSN?
w t (!8+uv5(
+6
View File
@@ -11,6 +11,8 @@ object frAI: TfrAI
TabOrder = 43
Text = #1055#1086#1083#1091#1095#1080#1090#1100' GigaChat'
TextSettings.Trimming = None
Visible = False
OnClick = btnGetAIDefClick
end
object edtAIP2: TEdit
Touch.InteractiveGestures = [LongTap, DoubleTap]
@@ -81,6 +83,7 @@ object frAI: TfrAI
Size.PlatformDefault = False
TabOrder = 40
Text = 'GigaChat'
OnChange = RBCustomChange
end
object RBCustom: TRadioButton
Align = Top
@@ -96,6 +99,7 @@ object frAI: TfrAI
Size.PlatformDefault = False
TabOrder = 39
Text = 'Custom'
OnChange = RBCustomChange
end
object rbDS: TRadioButton
Align = Top
@@ -111,6 +115,7 @@ object frAI: TfrAI
Size.PlatformDefault = False
TabOrder = 38
Text = 'DeepSeek'
OnChange = RBCustomChange
end
object rbCG: TRadioButton
Align = Top
@@ -126,6 +131,7 @@ object frAI: TfrAI
Size.PlatformDefault = False
TabOrder = 37
Text = 'ChatGPT'
OnChange = RBCustomChange
end
end
object edtAIP3: TEdit
+77
View File
@@ -29,8 +29,11 @@ type
Label4: TLabel;
edtKandiKey: TEdit;
edtKandiSecret: TEdit;
procedure RBCustomChange(Sender: TObject);
procedure btnGetAIDefClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
@@ -39,4 +42,78 @@ implementation
{$R *.fmx}
uses uGeneral;
procedure TfrAI.btnGetAIDefClick(Sender: TObject);
begin
rbGC.IsChecked := true;
if appconst.AI_GigaChat_ClientID <> '' then
edtAIP1.text := appconst.AI_GigaChat_ClientID;
if appconst.AI_GigaChat_AC <> '' then
edtAIP2.text := appconst.AI_GigaChat_AC;
DB.WriteSetting('edtAIP1', edtAIP1.text);
DB.WriteSetting('edtAIP2', edtAIP2.text);
end;
procedure TfrAI.RBCustomChange(Sender: TObject);
var
aiIndex: Integer;
begin
aiIndex := -1;
if TRadioButton(Sender).IsChecked then
aiIndex := strtoint(TRadioButton(Sender).Hint);
if aiIndex = -1 then
exit;
case aiIndex of
0:
begin
Label45.text := 'ClientID';
Label47.text := 'Autorization Code';
Label1.Visible := false;
edtAIP2.Visible := true;
edtAIP2.Password := true;
edtAIP3.Visible := false;
cbOllama.IsChecked:=false;
cbOllama.Visible:=false;
end;
1:
begin
Label45.text := 'API Token';
Label47.text := '';
Label1.Visible := false;
edtAIP2.Visible := false;
edtAIP2.Password := false;
edtAIP3.Visible := false;
cbOllama.IsChecked:=false;
cbOllama.Visible:=false;
end;
2:
begin
Label45.text := 'API Token';
Label47.text := '';
Label1.Visible := false;
edtAIP2.Visible := false;
edtAIP2.Password := false;
edtAIP3.Visible := false;
cbOllama.IsChecked:=false;
cbOllama.Visible:=false;
end;
3:
begin
Label45.text := 'API Token';
Label47.text := 'URL';
Label1.Visible := true;
edtAIP2.Visible := true;
edtAIP2.Password := false;
edtAIP3.Visible := true;
cbOllama.IsChecked:=false;
cbOllama.Visible:=true;
end;
end;
DB.WriteSetting('aiIndex', inttostr(aiIndex));
end;
end.
+6 -4
View File
@@ -10,7 +10,7 @@ object frCommands: TfrCommands
Size.Width = 606.000000000000000000
Size.Height = 193.000000000000000000
Size.PlatformDefault = False
TabOrder = 6
TabOrder = 5
RowCount = 0
Options = [ColumnResize, ColumnMove, ColLines, RowLines, Tabs, Header, HeaderClick, AutoDisplacement]
Viewport.Width = 602.000000000000000000
@@ -306,7 +306,7 @@ object frCommands: TfrCommands
Position.Y = 24.000000000000000000
TextSettings.Trimming = None
Text = #1042#1072#1088#1080#1072#1085#1090#1099' '#1086#1090#1074#1077#1090#1072
TabOrder = 42
TabOrder = 43
end
end
object GroupBox8: TGroupBox
@@ -360,9 +360,10 @@ object frCommands: TfrCommands
object btnRandAdd: TButton
Position.X = 9.000000000000000000
Position.Y = 205.000000000000000000
TabOrder = 34
TabOrder = 33
Text = #1044#1086#1073#1072#1074#1080#1090#1100
TextSettings.Trimming = None
OnClick = btnRandAddClick
end
object btnRandDel: TButton
Position.X = 97.000000000000000000
@@ -370,9 +371,10 @@ object frCommands: TfrCommands
Size.Width = 70.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 35
TabOrder = 34
Text = #1059#1076#1072#1083#1080#1090#1100
TextSettings.Trimming = None
OnClick = btnRandDelClick
end
object sgRandomInt: TStringGrid
CanFocus = True
+63 -1
View File
@@ -5,7 +5,7 @@ interface
uses
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.Memo.Types, FMX.Grid, FMX.Layouts,
System.Rtti, FMX.Grid.Style, FMX.Memo.Types, FMX.Grid, FMX.Layouts, uRecords,
FMX.ListBox, FMX.Memo, FMX.Edit, FMX.Controls.Presentation, FMX.ScrollBox;
type
@@ -82,14 +82,76 @@ type
btnAIGenAdd: TButton;
btnAIGenDel: TButton;
btnAIGetTextUser: TButton;
procedure btnRandAddClick(Sender: TObject);
procedure btnRandDelClick(Sender: TObject);
private
{ Private declarations }
procedure UpdateGridFromArray;
public
{ Public declarations }
RandomCounters: TArray<TRandomCounters>;
end;
implementation
{$R *.fmx}
uses uGeneral;
procedure TfrCommands.btnRandDelClick(Sender: TObject);
var
i, RowIndex: Integer;
begin
RowIndex := sgRandomInt.Row;
if (RowIndex < 0) or (RowIndex > High(RandomCounters)) then Exit;
// Ñäâèãàåì ýëåìåíòû ìàññèâà
for i := RowIndex to High(RandomCounters)-1 do
RandomCounters[i] := RandomCounters[i+1];
SetLength(RandomCounters, Length(RandomCounters) - 1);
UpdateGridFromArray;
DB.SaveGridToTable('sgRandomInt', sgRandomInt);
end;
procedure TfrCommands.UpdateGridFromArray;
var
i: Integer;
begin
sgRandomInt.BeginUpdate;
try
sgRandomInt.RowCount := 1; // Ñáðàñûâàåì ñòðîêè (îñòàâëÿåì òîëüêî çàãîëîâêè)
for i := 0 to High(RandomCounters) do
begin
sgRandomInt.RowCount := i + 1;
sgRandomInt.Cells[0, i] := RandomCounters[i].Name;
sgRandomInt.Cells[1, i] := IntToStr(RandomCounters[i].Ot);
sgRandomInt.Cells[2, i] := IntToStr(RandomCounters[i].ToValue);
end;
finally
sgRandomInt.EndUpdate;
end;
end;
procedure TfrCommands.btnRandAddClick(Sender: TObject);
var
NewRec: TRandomCounters;
begin
NewRec.Name := edtRandomName.Text;
NewRec.Ot := StrToIntDef(edtOt.Text, 0);
NewRec.ToValue := StrToIntDef(edtTo.Text, 100);
SetLength(RandomCounters, Length(RandomCounters) + 1);
RandomCounters[High(RandomCounters)] := NewRec;
UpdateGridFromArray;
// DB.SaveGridToTable('sgRandomInt', sgRandomInt);
DB.SaveRecordArray<TRandomCounters>('RandomCounters', RandomCounters);
edtRandomName.Text := '';
edtOt.Text := '0';
edtTo.Text := '100';
end;
end.
+10
View File
@@ -60,4 +60,14 @@ object frOBS: TfrOBS
Text = #1057#1086#1079#1076#1072#1090#1100' '#1086#1087#1086#1074#1077#1097#1077#1085#1080#1077
TextSettings.Trimming = None
end
object btnCreateOBSKandinsky: TButton
Position.X = 257.000000000000000000
Position.Y = 8.000000000000000000
Size.Width = 147.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 5
Text = #1057#1086#1079#1076#1072#1090#1100' '#1050#1072#1085#1076#1080#1085#1089#1082#1080#1081
TextSettings.Trimming = None
end
end
+1
View File
@@ -18,6 +18,7 @@ type
StringColumn1: TStringColumn;
StringColumn2: TStringColumn;
btnCreateOBSNotify: TButton;
btnCreateOBSKandinsky: TButton;
private
{ Private declarations }
public
+25 -7
View File
@@ -98,6 +98,7 @@ object frSettings: TfrSettings
TabOrder = 3
Text = #1055#1086#1083#1091#1095#1080#1090#1100' Token'
TextSettings.Trimming = None
OnClick = btnGetTokenClick
Left = 207
Top = 87
end
@@ -133,9 +134,10 @@ object frSettings: TfrSettings
Size.Width = 128.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 35
TabOrder = 34
Text = #1054#1090#1082#1088#1099#1090#1100' '#1089#1090#1088#1080#1084
TextSettings.Trimming = None
OnClick = btnOpenStreamClick
end
object btnGetTokenStreamer: TButton
Position.X = 193.000000000000000000
@@ -143,13 +145,14 @@ object frSettings: TfrSettings
Size.Width = 128.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 36
TabOrder = 35
Text = #1055#1086#1083#1091#1095#1080#1090#1100' Token'
TextSettings.Trimming = None
OnClick = btnGetTokenStreamerClick
end
object edtBotTokenStreamer: TEdit
Touch.InteractiveGestures = [LongTap, DoubleTap]
TabOrder = 37
TabOrder = 36
Password = True
Position.X = 8.000000000000000000
Position.Y = 146.000000000000000000
@@ -191,13 +194,14 @@ object frSettings: TfrSettings
TabOrder = 45
Text = #1055#1086#1083#1091#1095#1080#1090#1100
TextSettings.Trimming = None
OnClick = btnDAGetCodeClick
end
object Label63: TLabel
Position.X = 8.000000000000000000
Position.Y = 24.000000000000000000
TextSettings.Trimming = None
Text = 'Client ID'
TabOrder = 37
TabOrder = 36
end
object edtDAClientID: TEdit
Touch.InteractiveGestures = [LongTap, DoubleTap]
@@ -269,8 +273,10 @@ object frSettings: TfrSettings
TabOrder = 46
Text = #1055#1086#1076#1082#1083#1102#1095#1080#1090#1100#1089#1103
TextSettings.Trimming = None
OnClick = btnDAStartClick
end
object btnGetDADef: TButton
ImageIndex = 10
Position.X = 8.000000000000000000
Position.Y = 274.000000000000000000
Size.Width = 209.000000000000000000
@@ -282,8 +288,8 @@ object frSettings: TfrSettings
Visible = False
end
object cbDAAutoLogin: TCheckBox
Position.X = 8.000000000000000000
Position.Y = 274.000000000000000000
Position.X = 137.000000000000000000
Position.Y = 246.000000000000000000
Size.Width = 88.000000000000000000
Size.Height = 19.000000000000000000
Size.PlatformDefault = False
@@ -300,6 +306,7 @@ object frSettings: TfrSettings
TabOrder = 2
Text = #1054#1090#1082#1088#1099#1090#1100' '#1087#1072#1087#1082#1091' '#1089' '#1085#1072#1089#1090#1088#1086#1081#1082#1072#1084#1080
TextSettings.Trimming = None
OnClick = btnOpenRomaningClick
end
object btnImportSettings: TButton
Position.X = 201.000000000000000000
@@ -310,6 +317,7 @@ object frSettings: TfrSettings
TabOrder = 3
Text = #1047#1072#1075#1088#1091#1079#1080#1090#1100' '#1089#1074#1086#1080' '#1085#1072#1089#1090#1088#1086#1081#1082#1080
TextSettings.Trimming = None
OnClick = btnImportSettingsClick
end
object btnExportSettings: TButton
Position.X = 201.000000000000000000
@@ -320,9 +328,10 @@ object frSettings: TfrSettings
TabOrder = 4
Text = #1042#1099#1075#1088#1091#1079#1080#1090#1100' '#1085#1072#1089#1090#1088#1086#1081#1082#1080
TextSettings.Trimming = None
OnClick = btnExportSettingsClick
end
object btnMaster: TButton
Position.X = 440.000000000000000000
Position.X = 369.000000000000000000
Position.Y = 321.000000000000000000
Size.Width = 193.000000000000000000
Size.Height = 22.000000000000000000
@@ -330,5 +339,14 @@ object frSettings: TfrSettings
TabOrder = 7
Text = #1047#1072#1087#1091#1089#1090#1080#1090#1100' '#1084#1072#1089#1090#1077#1088' '#1085#1072#1089#1090#1088#1086#1081#1082#1080
TextSettings.Trimming = None
OnClick = btnMasterClick
end
object SaveDialog1: TSaveDialog
Left = 513
Top = 272
end
object OpenDialog1: TOpenDialog
Left = 312
Top = 184
end
end
+254 -2
View File
@@ -3,9 +3,12 @@ unit fSettings;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
System.SysUtils, System.Types, System.UITypes, System.Classes,
System.Variants, uQ,
FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
FMX.Controls.Presentation, FMX.Edit;
ShellAPI, system.IOUtils, uDataBase,
FMX.Controls.Presentation, FMX.Edit, uTWAuth, uRecords, uAPIDA, uShowText,
json, uWSDA;
type
TfrSettings = class(TFrame)
@@ -42,14 +45,263 @@ type
btnImportSettings: TButton;
btnExportSettings: TButton;
btnMaster: TButton;
SaveDialog1: TSaveDialog;
OpenDialog1: TOpenDialog;
procedure btnGetTokenClick(Sender: TObject);
procedure btnGetTokenStreamerClick(Sender: TObject);
procedure btnOpenStreamClick(Sender: TObject);
procedure btnDAGetCodeClick(Sender: TObject);
procedure btnDAStartClick(Sender: TObject);
procedure btnOpenRomaningClick(Sender: TObject);
procedure btnImportSettingsClick(Sender: TObject);
procedure btnExportSettingsClick(Sender: TObject);
procedure btnMasterClick(Sender: TObject);
private
{ Private declarations }
FAPIClient: TAPIClient;
forbot: boolean;
procedure OnTTWToken(txt: string);
procedure OnTokenDA(txt: string);
procedure HandleWSStatus(AStatusText: string; AStatusCode: integer);
procedure HandleWSDonate(aNick, aMessage, aSum: string);
public
{ Public declarations }
FWSClient: TWSClient;
procedure init();
end;
implementation
{$R *.fmx}
uses uGeneral;
procedure TfrSettings.btnDAGetCodeClick(Sender: TObject);
var
twa: TTTWAuth;
Url: string;
begin
if (edtDAClientSecret.text = '') or (edtDAClientID.text = '') or
(edtDARedirectURL.text = '') then
exit;
Url := 'https://www.donationalerts.com/oauth/authorize?client_id=' +
edtDAClientID.text +
'&redirect_uri=http://localhost/da&response_type=code&scope=oauth-user-show+oauth-donation-subscribe';
twa := TTTWAuth.Create;
twa.OnToken := OnTokenDA;
twa.StartServer(Url);
end;
procedure TfrSettings.OnTokenDA(txt: string);
begin
edtDACode.text := txt;
if cbDAAutoLogin.IsChecked then
begin
btnDAStartClick(self);
end;
end;
procedure TfrSettings.btnDAStartClick(Sender: TObject);
var
UserInfo: TJSONObject;
Data: TJSONObject;
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<TJSONObject>('data');
FWSClient.Wsstoken := Data.GetValue<string>('socket_connection_token');
FWSClient.WSID := Data.GetValue<string>('id');
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 := 'Ïîäêëþ÷èòüñÿ';
end;
end;
procedure TfrSettings.btnExportSettingsClick(Sender: TObject);
var
DestinationFile: string;
begin
SaveDialog1.FileName := TPath.GetFileName(myConst.DBPath);
if SaveDialog1.Execute then
begin
DestinationFile := SaveDialog1.FileName;
TFile.Copy(myConst.DBPath, DestinationFile, True);
end;
end;
procedure TfrSettings.btnGetTokenClick(Sender: TObject);
var
s: string;
sope: string;
ttw_Auth: TTTWAuth;
begin
ttw_Auth := TTTWAuth.Create;
ttw_Auth.OnToken := OnTTWToken;
sope := 'moderator:manage:shoutouts' + '+moderator:manage:announcements' +
'+moderator:manage:banned_users' + '+moderator:manage:warnings' +
'+moderator:read:followers' + '+channel:manage:raids' +
'+channel:manage:moderators' + '+channel:read:redemptions' + '+chat:read' +
'+chat:edit+user:read:emotes';
sope := StringReplace(sope, ':', '%3A', [rfReplaceAll]);
s := 'https://id.twitch.tv/oauth2/authorize?client_id=' + edtBotClientID.text
+ '&redirect_uri=http://localhost&response_type=token&' + 'scope=' + sope;
ttw_Auth.StartServer('');
forbot := True;
fShowText.Memo1.Lines.text := s;
fShowText.Show;
fShowText.Memo1.WordWrap := True;
end;
procedure TfrSettings.btnGetTokenStreamerClick(Sender: TObject);
var
sope: string;
ttw_Auth: TTTWAuth;
begin
ttw_Auth := TTTWAuth.Create;
ttw_Auth.OnToken := OnTTWToken;
sope := 'channel:read:redemptions' + '+channel:manage:vips' +
'+moderator:read:followers' + '+channel:read:subscriptions' +
'+channel:manage:moderators' + '+channel:manage:redemptions';
sope := StringReplace(sope, ':', '%3A', [rfReplaceAll]);
ttw_Auth.StartServer('https://id.twitch.tv/oauth2/authorize?client_id=' +
edtBotClientID.text + '&redirect_uri=http://localhost&response_type=token&'
+ 'scope=' + sope);
forbot := false;
end;
procedure TfrSettings.btnImportSettingsClick(Sender: TObject);
var
SourceFile, DestinationDir, DestinationFile: string;
begin
if OpenDialog1.Execute then
begin
DB.Free;
SourceFile := OpenDialog1.FileName;
DestinationDir := myConst.DBPath;
DestinationFile := myConst.DBPath;
TFile.Copy(SourceFile, DestinationFile, True);
DB := TSettingsDatabase.Create(myConst.DBPath);
end;
end;
procedure TfrSettings.btnMasterClick(Sender: TObject);
var
qf: tfrmq;
begin
qf := tfrmq.Create(nil);
try
qf.SetLabelText('Ââåäèòå íèê àêêàóíòà îò êîòîðîãî áóäåò ïèñàòü áîò:');
if qf.ShowModal = mrOk then
edtBotName.text := qf.GetEditText;
qf.SetLabelText('Ââåäèòå íèê ñòðèìåðà ãäå áóäåò ðàáîòàòü áîò:');
if qf.ShowModal = mrOk then
edtChannel.text := qf.GetEditText;
if btnGetClientID.Visible then
begin
edtBotClientID.text := appconst.TTV_ClientID;
showmessage('Ïîÿâèòñÿ îêíî, òàì áóäåò ññûëêà. ' + #13 +
'Ñêîïèðóé åå è îòêðîé â áðàóçåðå ãäå àâòîðèçîâàí áîò. ' + #13 +
'Åñëè ïîíÿë - æìè ÎÊ');
btnGetTokenClick(self);
showmessage
('Êîãäà ññûëêà ïðîïàäåò æìè "Ïîëó÷èòü Token" îêîëî ïîëÿ "API Token Ñòðèìåðà". '
+ #13 + 'Åñëè ïîíÿë - æìè ÎÊ');
end
else
begin
showmessage('Íåò ôàéëà êëþ÷åé! ' + #13 +
'Ââåäèòå ClientID âðó÷íóþ è ïðîäîëæèòå íàñòðîéêó áåç ìàñòåðà!');
end;
finally
qf.Free;
end;
end;
procedure TfrSettings.btnOpenRomaningClick(Sender: TObject);
begin
ShellExecute(0, 'open', pwidechar(ExtractFilePath(myConst.DBPath)),
nil, nil, 1);
end;
procedure TfrSettings.btnOpenStreamClick(Sender: TObject);
begin
ShellExecute(0, 'open', pwidechar('https://www.twitch.tv/' + edtChannel.text),
nil, nil, 1);
end;
procedure TfrSettings.init;
begin
FAPIClient := TAPIClient.Create;
FWSClient := TWSClient.Create;
FWSClient.OnStatus := HandleWSStatus;
FWSClient.OnDonate := HandleWSDonate;
end;
procedure TfrSettings.OnTTWToken(txt: string);
begin
fShowText.Close;
if forbot then
begin
edtBotToken.text := txt;
DB.WriteSetting('edtBotToken', txt);
end
else
begin
edtBotTokenStreamer.text := txt;
DB.WriteSetting('edtBotTokenStreamer', txt);
end;
end;
procedure TfrSettings.HandleWSDonate(aNick, aMessage, aSum: string);
begin
// fDonats.OnDADonate(aNick, aMessage, aSum);
end;
procedure TfrSettings.HandleWSStatus(AStatusText: string; AStatusCode: integer);
begin
// fLog.tolog(3,'uLogin','HandleWSStatus',AStatusText);
TTW_Bot.Label8.text := AStatusText;
case AStatusCode of
0:
begin
btnDAStart.ImageIndex := 1;
btnDAStart.text := 'Îòêëþ÷èòüñÿ';
end;
else
begin
btnDAStart.ImageIndex := 18;
btnDAStart.text := 'Ïîäêëþ÷èòüñÿ';
end;
end;
end;
end.
+123
View File
@@ -0,0 +1,123 @@
unit uAPIDA;
interface
uses
Classes, SysUtils, System.JSON, IdHTTP, IdSSLOpenSSL, flog;
type
TAPIClient = class(TObject)
private
FHttpClient: TIdHTTP;
FSSLHandler: TIdSSLIOHandlerSocketOpenSSL;
FToken: string;
procedure SetToken(const Value: string);
procedure CheckHTTPError(AResponseCode: Integer; const AResponse: string);
public
constructor Create;
destructor Destroy; override;
function GetAccessToken(const client_id, client_secret, redirect_uri, code: string): string;
function GetUserInfo: TJSONObject;
function SubscribeToChannel(const uid, clientUID: string): TJSONObject;
property Token: string read FToken write SetToken;
end;
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';
AuthorizationHeader = 'Authorization: Bearer ';
constructor TAPIClient.Create;
begin
inherited;
FHttpClient := TIdHTTP.Create(nil);
FSSLHandler := TIdSSLIOHandlerSocketOpenSSL.Create(FHttpClient);
FSSLHandler.SSLOptions.Method := sslvSSLv23;
FHttpClient.IOHandler := FSSLHandler;
FHttpClient.Request.UserAgent := UserAgent;
FHttpClient.Request.ContentType := ContentType;
FHttpClient.HandleRedirects := True;
end;
destructor TAPIClient.Destroy;
begin
FHttpClient.Free;
inherited;
end;
procedure TAPIClient.CheckHTTPError(AResponseCode: Integer; const AResponse: string);
begin
if AResponseCode <> 200 then
raise Exception.CreateFmt('HTTP Error %d: %s', [AResponseCode, AResponse]);
end;
function TAPIClient.GetAccessToken(const client_id, client_secret, redirect_uri, code: string): string;
var
Response: string;
Stream: TStringStream;
Json: TJSONObject;
begin
Stream := TStringStream.Create(
Format('grant_type=authorization_code&client_id=%s&client_secret=%s&redirect_uri=%s&code=%s',
[client_id, client_secret, redirect_uri, code]), TEncoding.UTF8);
try
Response := FHttpClient.Post('https://www.donationalerts.com/oauth/token', Stream);
CheckHTTPError(FHttpClient.ResponseCode, Response);
Json := TJSONObject.ParseJSONValue(Response) as TJSONObject;
try
Result := Json.GetValue<string>('access_token');
FToken := Result;
finally
Json.Free;
end;
finally
Stream.Free;
end;
end;
function TAPIClient.GetUserInfo: TJSONObject;
var
Response: string;
begin
FHttpClient.Request.CustomHeaders.Add(AuthorizationHeader + FToken);
try
Response := FHttpClient.Get('https://www.donationalerts.com/api/v1/user/oauth');
CheckHTTPError(FHttpClient.ResponseCode, Response);
Result := TJSONObject.ParseJSONValue(Response) as TJSONObject;
finally
FHttpClient.Request.CustomHeaders.Clear;
end;
end;
function TAPIClient.SubscribeToChannel(const uid, clientUID: string): TJSONObject;
var
Response: string;
Stream: TStringStream;
RequestJSON: string;
begin
RequestJSON := Format('{"channels":["$alerts:donation_%s"], "client":"%s"}', [uid, clientUID]);
Stream := TStringStream.Create(RequestJSON, TEncoding.UTF8);
try
FHttpClient.Request.CustomHeaders.Add(AuthorizationHeader + FToken);
FHttpClient.Request.ContentType := 'application/json';
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;
end;
end;
procedure TAPIClient.SetToken(const Value: string);
begin
FToken := Value;
end;
end.
+239 -135
View File
@@ -7,13 +7,12 @@ uses
FMX.Grid, FireDAC.Stan.Def, FireDAC.Stan.Intf, FireDAC.Stan.Option,
FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Pool,
FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Phys.SQLite, FireDAC.Phys.SQLiteDef,
FireDAC.Stan.ExprFuncs, FireDAC.Phys.SQLiteWrapper.Stat, FireDAC.VCLUI.Wait,
FireDAC.Stan.ExprFuncs, FireDAC.Phys.SQLiteWrapper.Stat, FireDAC.FMXUI.Wait,
FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.DApt, Data.DB, FireDAC.Comp.DataSet,
FireDAC.FMXUI.Wait, FireDAC.Comp.UI, uRecords, System.Generics.Collections;
FireDAC.Comp.UI, uRecords, System.Generics.Collections, System.Rtti, System.TypInfo;
type
TSettingsDatabase = class
private
FConnection: TFDConnection;
procedure InitializeDatabase;
@@ -23,32 +22,27 @@ type
function GetColumnsList(Grid: TStringGrid): string;
function GetValuesPlaceholders(Grid: TStringGrid): string;
function CheckTableExists(const TableName: string): Boolean;
procedure EnsureTableForRecord(const TableName: string; RecordTypeInfo: PTypeInfo);
// function GetFieldDefinition(Field: TRttiField): string;
function GetSQLType(Field: TRttiField): string;
function TableHasColumn(const TableName, ColumnName: string): Boolean;
public
FChannel: string;
constructor Create(const DatabasePath: string);
destructor Destroy; override;
// Ìåòîäû äëÿ ðàáîòû ñ íàñòðîéêàìè
function ReadSetting(const Name: string; Default: string = ''): string;
procedure WriteSetting(const Name, Value: string);
function getLoginData(): TLogin;
// Ìåòîäû äëÿ ðàáîòû ñ TStringGrid
function getLoginData: TLogin;
procedure SaveGridToTable(const TableName: string; Grid: TStringGrid);
procedure LoadGridFromTable(const TableName: string; Grid: TStringGrid);
// Ìåòîäû äëÿ ðàáîòû ñ Users
// procedure SaveUsers(const Users: array of User);
procedure LoadUsers(var users: tlist<tuser>);
// Ìåòîäû äëÿ ðàáîòû ñ Ãðóïïîâûìè îòâåòàìè
procedure LoadUsers(var users: TList<TUser>);
procedure addGroupResponse(Name, Respons: string);
procedure getGroupResponse(aName: string; const lbResponse: Tstrings);
procedure getGroupName(const lbName: Tstrings);
procedure getGroupResponse(aName: string; const lbResponse: TStrings);
procedure getGroupName(const lbName: TStrings);
procedure delGroupName(aName: string);
procedure delGroupResponse(aName, aResponse: string);
procedure SaveRecordArray<T>(const TableName: string; const Items: array of T);
procedure LoadRecordArray<T>(const TableName: string; var Items: TArray<T>);
end;
implementation
@@ -67,8 +61,7 @@ begin
on E: Exception do
begin
FreeAndNil(FConnection);
raise Exception.Create('Îøèáêà ïðè ïîäêëþ÷åíèè ê áàçå äàííûõ: ' +
E.Message);
raise Exception.Create('Îøèáêà ïðè ïîäêëþ÷åíèè ê áàçå äàííûõ: ' + E.Message);
end;
end;
end;
@@ -80,7 +73,8 @@ begin
Query := TFDQuery.Create(nil);
try
Query.Connection := FConnection;
Query.SQL.Text := 'delete FROM GroupResponse where Name = "' + aName + '"';
Query.SQL.Text := 'DELETE FROM GroupResponse WHERE Name = :name';
Query.ParamByName('name').AsString := aName;
Query.ExecSQL;
finally
Query.Free;
@@ -94,10 +88,9 @@ begin
Query := TFDQuery.Create(nil);
try
Query.Connection := FConnection;
Query.SQL.Text := 'delete FROM GroupResponse where Name = :name' +
' and Response = :response';
Query.Params.ParamByName('name').AsString := aName;
Query.Params.ParamByName('response').AsString := aResponse;
Query.SQL.Text := 'DELETE FROM GroupResponse WHERE Name = :name AND Response = :response';
Query.ParamByName('name').AsString := aName;
Query.ParamByName('response').AsString := aResponse;
Query.ExecSQL;
finally
Query.Free;
@@ -117,16 +110,14 @@ var
FDQuery: TFDQuery;
FieldExists: Boolean;
begin
// Ñîçäàåì òàáëèöó, åñëè îíà íå ñóùåñòâóåò
FConnection.ExecSQL('CREATE TABLE IF NOT EXISTS params (' +
' name TEXT PRIMARY KEY,' + ' value TEXT' + ');');
// Ñîçäàåì òàáëèöó äëÿ ïîëüçîâàòåëåé, åñëè îíà íå ñóùåñòâóåò
FConnection.ExecSQL('CREATE TABLE IF NOT EXISTS users (' +
' id TEXT PRIMARY KEY,' + ' login TEXT,' + ' DisplayName TEXT,' +
' created_at DATETIME,' + ' follow_at DATETIME,' + ' isVip TEXT,' +
' isModer TEXT,' + ' isO TEXT,' + ' streamer TEXT' +
' isModer TEXT,' + ' isO TEXT,' + ' streamer TEXT' + ');');
');');
FDQuery := TFDQuery.Create(nil);
try
FDQuery.Connection := FConnection;
@@ -144,71 +135,19 @@ begin
end;
FDQuery.Close;
if not FieldExists then
begin
FConnection.ExecSQL('ALTER TABLE users ADD COLUMN streamer TEXT');
end;
finally
FDQuery.Free;
end;
FConnection.ExecSQL
('CREATE TABLE IF NOT EXISTS GroupResponse (ID INTEGER PRIMARY KEY, Name TEXT, Response TEXT);');
FConnection.ExecSQL('CREATE TABLE IF NOT EXISTS GroupResponse (ID INTEGER PRIMARY KEY, Name TEXT, Response TEXT);');
end;
{ procedure TSettingsDatabase.SaveUsers(const Users: array of User);
procedure TSettingsDatabase.LoadUsers(var users: TList<TUser>);
var
Query: TFDQuery;
UserItem: User;
s: string;
UserItem: TUser;
begin
if Length(Users) < 1 then
exit;
// Âñòàâëÿåì äàííûå èç ìàññèâà ïîëüçîâàòåëåé â òàáëèöó
Query := TFDQuery.Create(nil);
try
Query.Connection := FConnection;
for UserItem in Users do
begin
Query.SQL.Text :=
'INSERT OR REPLACE INTO users (id, login, DisplayName, created_at, follow_at, isVip, isModer, isO, streamer) '
+ 'VALUES (:id, :login, :DisplayName, :created_at, :follow_at, :isVip, :isModer, :isO, :streamer);';
Query.ParamByName('id').AsString := UserItem.id;
Query.ParamByName('login').AsString := UserItem.login;
Query.ParamByName('DisplayName').AsString := UserItem.DisplayName;
Query.ParamByName('created_at').AsDateTime := UserItem.created_at;
Query.ParamByName('follow_at').AsDateTime := UserItem.follow_at;
Query.ParamByName('streamer').AsString := FChannel;
if UserItem.isVip then
s := 'True'
else
s := 'False';
Query.ParamByName('isVip').AsString := s;
if UserItem.isModer then
s := 'True'
else
s := 'False';
Query.ParamByName('isModer').AsString := s;
if UserItem.isO then
s := 'True'
else
s := 'False';
Query.ParamByName('isO').AsString := s;
Query.ExecSQL;
end;
finally
Query.Free;
end;
end; }
procedure TSettingsDatabase.LoadUsers(var users: tlist<tuser>);
var
Query: TFDQuery;
UserItem: tuser;
begin
Query := TFDQuery.Create(nil);
try
Query.Connection := FConnection;
@@ -230,7 +169,6 @@ begin
users.Add(UserItem);
Query.Next;
end;
finally
Query.Free;
end;
@@ -262,14 +200,13 @@ begin
end;
end;
procedure TSettingsDatabase.getGroupName(const lbName: Tstrings);
procedure TSettingsDatabase.getGroupName(const lbName: TStrings);
var
Query: TFDQuery;
begin
Query := TFDQuery.Create(nil);
try
Query.Connection := FConnection;
lbName.Clear;
Query.SQL.Text := 'SELECT DISTINCT Name FROM GroupResponse';
Query.Open;
@@ -283,18 +220,16 @@ begin
end;
end;
procedure TSettingsDatabase.getGroupResponse(aName: string;
const lbResponse: Tstrings);
procedure TSettingsDatabase.getGroupResponse(aName: string; const lbResponse: TStrings);
var
Query: TFDQuery;
begin
Query := TFDQuery.Create(nil);
try
Query.Connection := FConnection;
lbResponse.Clear;
Query.SQL.Text := 'SELECT * FROM GroupResponse WHERE name=:TableName';
Query.ParamByName('TableName').AsString := aName;
Query.SQL.Text := 'SELECT Response FROM GroupResponse WHERE Name = :name';
Query.ParamByName('name').AsString := aName;
Query.Open;
while not Query.EOF do
begin
@@ -304,7 +239,6 @@ begin
finally
Query.Free;
end;
end;
function TSettingsDatabase.getLoginData: TLogin;
@@ -346,9 +280,9 @@ begin
Query := TFDQuery.Create(nil);
try
Query.Connection := FConnection;
Query.SQL.Text :=
Format('INSERT INTO GroupResponse (Name, Response) VALUES (''%s'', ''%s'')',
[Name, Respons]);
Query.SQL.Text := 'INSERT INTO GroupResponse (Name, Response) VALUES (:name, :response)';
Query.ParamByName('name').AsString := Name;
Query.ParamByName('response').AsString := Respons;
Query.ExecSQL;
finally
Query.Free;
@@ -363,8 +297,7 @@ begin
Query := TFDQuery.Create(nil);
try
Query.Connection := FConnection;
Query.SQL.Text :=
'SELECT COUNT(*) FROM sqlite_master WHERE type=''table'' AND name=:TableName';
Query.SQL.Text := 'SELECT COUNT(*) FROM sqlite_master WHERE type=''table'' AND name=:TableName';
Query.ParamByName('TableName').AsString := TableName;
Query.Open;
Result := (Query.Fields[0].AsInteger > 0);
@@ -373,40 +306,27 @@ begin
end;
end;
procedure TSettingsDatabase.LoadGridFromTable(const TableName: string;
Grid: TStringGrid);
procedure TSettingsDatabase.LoadGridFromTable(const TableName: string; Grid: TStringGrid);
var
Query: TFDQuery;
Col, Row: Integer;
begin
if not CheckTableExists(TableName) then Exit;
Query := TFDQuery.Create(nil);
try
Query.Connection := FConnection;
// Ïðîâåðèòü íàëè÷èå òàáëèöû
if not CheckTableExists(TableName) then
begin
// Òàáëèöà íå ñóùåñòâóåò, âûõîäèì èç ïðîöåäóðû
exit;
end;
Query.SQL.Text := 'SELECT * FROM ' + TableName;
Query.Open;
// Î÷èùàåì Grid
Grid.RowCount := 0;
// Çàïîëíÿåì Grid äàííûìè èç òàáëèöû
while not Query.EOF do
begin
Row := Grid.RowCount;
Grid.RowCount := Grid.RowCount + 1;
for Col := 0 to Grid.ColumnCount - 1 do
begin
Grid.Cells[Col, Row] := Query.FieldByName('col' + IntToStr(Col)
).AsString;
end;
Grid.Cells[Col, Row] := Query.FieldByName('col' + IntToStr(Col)).AsString;
Query.Next;
end;
@@ -415,33 +335,22 @@ begin
end;
end;
procedure TSettingsDatabase.SaveGridToTable(const TableName: string;
Grid: TStringGrid);
procedure TSettingsDatabase.SaveGridToTable(const TableName: string; Grid: TStringGrid);
var
Query: TFDQuery;
Col, Row: Integer;
begin
// Óäàëÿåì ñòàðóþ òàáëèöó, åñëè îíà ñóùåñòâóåò
FConnection.ExecSQL('DROP TABLE IF EXISTS ' + TableName);
FConnection.ExecSQL('CREATE TABLE ' + TableName + ' (id INTEGER PRIMARY KEY AUTOINCREMENT, ' + GetColumnsDefinition(Grid) + ');');
// Ñîçäàåì íîâóþ òàáëèöó
FConnection.ExecSQL('CREATE TABLE ' + TableName + ' (' +
' id INTEGER PRIMARY KEY AUTOINCREMENT,' + ' ' +
GetColumnsDefinition(Grid) + ');');
// Âñòàâëÿåì äàííûå èç Grid â òàáëèöó
Query := TFDQuery.Create(nil);
try
Query.Connection := FConnection;
for Row := 0 to Grid.RowCount - 1 do
begin
Query.SQL.Text := 'INSERT INTO ' + TableName + ' (' + GetColumnsList(Grid)
+ ') VALUES (' + GetValuesPlaceholders(Grid) + ')';
Query.SQL.Text := 'INSERT INTO ' + TableName + ' (' + GetColumnsList(Grid) + ') VALUES (' + GetValuesPlaceholders(Grid) + ')';
for Col := 0 to Grid.ColumnCount - 1 do
begin
Query.ParamByName('col' + IntToStr(Col)).AsString :=
Grid.Cells[Col, Row];
end;
Query.ParamByName('col' + IntToStr(Col)).AsString := Grid.Cells[Col, Row];
Query.ExecSQL;
end;
finally
@@ -470,13 +379,10 @@ end;
procedure TSettingsDatabase.SetSetting(const Name, Value: string);
begin
FConnection.ExecSQL
('INSERT OR REPLACE INTO params (name, value) VALUES (:name, :value)',
[Name, Value]);
FConnection.ExecSQL('INSERT OR REPLACE INTO params (name, value) VALUES (:name, :value)', [Name, Value]);
end;
function TSettingsDatabase.ReadSetting(const Name: string;
Default: string = ''): string;
function TSettingsDatabase.ReadSetting(const Name: string; Default: string = ''): string;
begin
Result := GetSetting(Name);
if Result = '' then
@@ -488,4 +394,202 @@ begin
SetSetting(Name, Value);
end;
function TSettingsDatabase.TableHasColumn(const TableName, ColumnName: string): Boolean;
var
Query: TFDQuery;
begin
Query := TFDQuery.Create(nil);
try
Query.Connection := FConnection;
Query.SQL.Text := Format('PRAGMA table_info(%s)', [TableName]);
Query.Open;
Result := False;
while not Query.EOF do
begin
if SameText(Query.FieldByName('name').AsString, ColumnName) then
Exit(True);
Query.Next;
end;
finally
Query.Free;
end;
end;
function TSettingsDatabase.GetSQLType(Field: TRttiField): string;
begin
case Field.FieldType.TypeKind of
tkInteger, tkInt64:
Result := 'INTEGER';
tkFloat:
Result := 'REAL';
tkUString, tkString, tkWString, tkLString:
Result := 'TEXT';
tkEnumeration:
if Field.FieldType = TypeInfo(Boolean) then
Result := 'BOOLEAN'
else
Result := 'INTEGER';
else
raise Exception.CreateFmt('Unsupported type for field %s', [Field.Name]);
end;
end;
procedure TSettingsDatabase.EnsureTableForRecord(const TableName: string; RecordTypeInfo: PTypeInfo);
var
Context: TRttiContext;
RttiType: TRttiType;
Field: TRttiField;
FieldDefs: string;
Query: TFDQuery;
begin
if not CheckTableExists(TableName) then
begin
Context := TRttiContext.Create;
try
RttiType := Context.GetType(RecordTypeInfo);
FieldDefs := '';
for Field in RttiType.GetFields do
begin
if FieldDefs <> '' then
FieldDefs := FieldDefs + ', ';
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
Query.Connection := FConnection;
for Field in RttiType.GetFields do
begin
if not TableHasColumn(TableName, Field.Name) then
begin
Query.SQL.Text := Format('ALTER TABLE %s ADD COLUMN %s %s', [TableName, Field.Name, GetSQLType(Field)]);
Query.ExecSQL;
end;
end;
finally
Query.Free;
end;
finally
Context.Free;
end;
end;
end;
procedure TSettingsDatabase.SaveRecordArray<T>(const TableName: string; const Items: array of T);
var
Context: TRttiContext;
RttiType: TRttiType;
Fields: TArray<TRttiField>;
Query: TFDQuery;
Rec: T;
Field: TRttiField;
FieldNames, Placeholders: string;
i: Integer;
begin
if Length(Items) = 0 then Exit;
EnsureTableForRecord(TableName, TypeInfo(T));
FConnection.ExecSQL(Format('DELETE FROM %s', [TableName]));
Context := TRttiContext.Create;
try
RttiType := Context.GetType(TypeInfo(T));
Fields := RttiType.GetFields;
Query := TFDQuery.Create(nil);
try
Query.Connection := FConnection;
FieldNames := '';
Placeholders := '';
for i := 0 to High(Fields) do
begin
if i > 0 then
begin
FieldNames := FieldNames + ', ';
Placeholders := Placeholders + ', ';
end;
FieldNames := FieldNames + Fields[i].Name;
Placeholders := Placeholders + ':p_' + Fields[i].Name;
end;
Query.SQL.Text := 'INSERT INTO '+TableName+' ('+FieldNames+') VALUES ('+Placeholders+')';
for Rec in Items do
begin
Query.Params.Clear;
for Field in Fields do
Query.ParamByName('p_'+Field.Name).Value := Field.GetValue(@Rec).AsVariant;
Query.ExecSQL;
end;
finally
Query.Free;
end;
finally
Context.Free;
end;
end;
procedure TSettingsDatabase.LoadRecordArray<T>(const TableName: string; var Items: TArray<T>);
var
Context: TRttiContext;
RttiType: TRttiType;
Fields: TArray<TRttiField>;
Query: TFDQuery;
Rec: T;
RecList: TList<T>;
Field: TRttiField;
begin
if not CheckTableExists(TableName) then
begin
SetLength(Items, 0);
Exit;
end;
EnsureTableForRecord(TableName, TypeInfo(T));
Context := TRttiContext.Create;
try
RttiType := Context.GetType(TypeInfo(T));
Fields := RttiType.GetFields;
Query := TFDQuery.Create(nil);
RecList := TList<T>.Create;
try
Query.Connection := FConnection;
Query.SQL.Text := Format('SELECT * FROM %s', [TableName]);
Query.Open;
while not Query.EOF do
begin
Rec := Default(T);
for Field in Fields do
begin
if Query.FindField(Field.Name) <> nil then
Field.SetValue(@Rec, TValue.FromVariant(Query.FieldByName(Field.Name).Value));
end;
RecList.Add(Rec);
Query.Next;
end;
Items := RecList.ToArray;
finally
Query.Free;
RecList.Free;
end;
finally
Context.Free;
end;
end;
end.
+106 -23
View File
@@ -1,4 +1,4 @@
object Form1: TForm1
object TTW_Bot: TTTW_Bot
Left = 480
Top = 0
Caption = 'Form1'
@@ -54,7 +54,7 @@ object Form1: TForm1
Text = #1053#1072#1089#1090#1088#1086#1081#1082#1080
ExplicitSize.cx = 96.000000000000000000
ExplicitSize.cy = 26.000000000000000000
inline fSettings: TfrSettings
inline frSettings1: TfrSettings
Align = Client
Size.Width = 1042.000000000000000000
Size.Height = 718.000000000000000000
@@ -64,6 +64,10 @@ object Form1: TForm1
Images = ImageList1
ImageIndex = 10
end
inherited btnGetClientID: TButton
Images = ImageList1
ImageIndex = 10
end
inherited btnOpenStream: TButton
Images = ImageList1
ImageIndex = 17
@@ -77,9 +81,6 @@ object Form1: TForm1
inherited edtBotTokenStreamer: TEdit
TabOrder = 35
end
inherited Label53: TLabel
TabOrder = 37
end
end
inherited GroupBox22: TGroupBox
inherited btnDAGetCode: TButton
@@ -115,8 +116,10 @@ object Form1: TForm1
Images = ImageList1
ImageIndex = 18
TabOrder = 44
OnClick = frSettings1btnDAStartClick
end
inherited btnGetDADef: TButton
Images = ImageList1
TabOrder = 45
end
end
@@ -202,8 +205,8 @@ object Form1: TForm1
Size.Height = 718.000000000000000000
Size.PlatformDefault = False
inherited sgCommands: TStringGrid
Viewport.Width = 602.000000000000000000
Viewport.Height = 168.000000000000000000
Viewport.Width = 606.000000000000000000
Viewport.Height = 193.000000000000000000
inherited scCommand: TStringColumn
Size.Width = 134.000000000000000000
end
@@ -212,56 +215,84 @@ object Form1: TForm1
end
end
inherited GroupBox1: TGroupBox
inherited Label12: TLabel
TabOrder = 37
end
inherited edtCommand: TEdit
TabOrder = 38
end
inherited mResponse: TMemo
Viewport.Width = 372.000000000000000000
Viewport.Height = 173.000000000000000000
TabOrder = 39
Viewport.Width = 376.000000000000000000
Viewport.Height = 177.000000000000000000
end
inherited Label14: TLabel
TabOrder = 40
end
inherited GroupBox7: TGroupBox
TabOrder = 41
inherited btnAddUserName: TButton
Images = ImageList1
ImageIndex = 11
TabOrder = 37
end
inherited btnGetDateFollow: TButton
Images = ImageList1
ImageIndex = 15
TabOrder = 38
end
inherited btnGetAgeAccaunt: TButton
Images = ImageList1
ImageIndex = 15
TabOrder = 39
end
inherited btnCounterAddtoText: TButton
Images = ImageList1
ImageIndex = 0
TabOrder = 40
end
inherited cbCounterName: TComboBox
TabOrder = 41
end
inherited btnGPT: TButton
Images = ImageList1
ImageIndex = 19
TabOrder = 42
end
inherited btnRandomUserName: TButton
Images = ImageList1
ImageIndex = 11
TabOrder = 43
end
inherited btnGetChannelStat: TButton
Images = ImageList1
ImageIndex = 20
Size.Width = 128.000000000000000000
TabOrder = 44
end
inherited btnAIPic: TButton
Images = ImageList1
ImageIndex = 5
TabOrder = 45
end
end
inherited btnAddCommand: TButton
Images = ImageList1
ImageIndex = 0
TabOrder = 42
end
inherited btnEditCommand: TButton
Images = ImageList1
ImageIndex = 3
TabOrder = 43
end
inherited btnRmCommand: TButton
Images = ImageList1
ImageIndex = 4
TabOrder = 44
end
inherited cbTextToSpeech: TCheckBox
TabOrder = 45
end
end
inherited GroupBox9: TGroupBox
@@ -281,10 +312,18 @@ object Form1: TForm1
inherited btnRandomDel: TButton
Images = ImageList1
ImageIndex = 12
TabOrder = 37
end
inherited btnRmGroup: TButton
Images = ImageList1
ImageIndex = 4
TabOrder = 38
end
inherited Label4: TLabel
TabOrder = 39
end
inherited Label5: TLabel
TabOrder = 41
end
end
inherited GroupBox8: TGroupBox
@@ -292,6 +331,7 @@ object Form1: TForm1
Images = ImageList1
ImageIndex = 0
TabOrder = 32
OnClick = frCommands1btnRandAddClick
end
inherited btnRandDel: TButton
Images = ImageList1
@@ -299,8 +339,8 @@ object Form1: TForm1
end
inherited sgRandomInt: TStringGrid
TabOrder = 35
Viewport.Width = 153.000000000000000000
Viewport.Height = 119.000000000000000000
Viewport.Width = 157.000000000000000000
Viewport.Height = 144.000000000000000000
inherited scRIntName: TStringColumn
Size.Width = 70.000000000000000000
end
@@ -316,23 +356,37 @@ object Form1: TForm1
inherited btnSoundAdd: TButton
Images = ImageList1
ImageIndex = 0
TabOrder = 37
end
inherited btnSoundDel: TButton
Images = ImageList1
ImageIndex = 12
TabOrder = 38
end
inherited edtSoundName: TEdit
TabOrder = 39
end
inherited edtSoundFileName: TEdit
TabOrder = 40
end
inherited btnSoundOpen: TButton
Images = ImageList1
ImageIndex = 14
TabOrder = 41
Text = ''
end
inherited tbSoundVolume: TTrackBar
TabOrder = 42
end
inherited btnSoundTest: TButton
Images = ImageList1
ImageIndex = 25
TabOrder = 43
end
inherited sgSAFiles: TStringGrid
Viewport.Width = 341.000000000000000000
Viewport.Height = 124.000000000000000000
TabOrder = 44
Viewport.Width = 345.000000000000000000
Viewport.Height = 149.000000000000000000
inherited sgSAFile: TStringColumn
Size.Width = 220.000000000000000000
end
@@ -342,19 +396,29 @@ object Form1: TForm1
inherited btnTextAdd: TButton
Images = ImageList1
ImageIndex = 0
TabOrder = 37
end
inherited btnTextDel: TButton
Images = ImageList1
ImageIndex = 12
TabOrder = 38
end
inherited edtTextName: TEdit
TabOrder = 39
end
inherited edtTextFileName: TEdit
TabOrder = 40
end
inherited btnTextOpen: TButton
Images = ImageList1
ImageIndex = 14
TabOrder = 41
Text = ''
end
inherited sgTFiles: TStringGrid
Viewport.Width = 293.000000000000000000
Viewport.Height = 124.000000000000000000
TabOrder = 44
Viewport.Width = 297.000000000000000000
Viewport.Height = 149.000000000000000000
inherited scTFileFile: TStringColumn
Size.Width = 170.000000000000000000
end
@@ -367,23 +431,33 @@ object Form1: TForm1
inherited GroupBox2: TGroupBox
TabOrder = 7
inherited sgAIGen: TStringGrid
Viewport.Width = 301.000000000000000000
Viewport.Height = 124.000000000000000000
TabOrder = 37
Viewport.Width = 305.000000000000000000
Viewport.Height = 149.000000000000000000
inherited StringColumn2: TStringColumn
Size.Width = 180.000000000000000000
end
end
inherited edtAIGenName: TEdit
TabOrder = 38
end
inherited edtAIGenRequest: TEdit
TabOrder = 39
end
inherited btnAIGenAdd: TButton
Images = ImageList1
ImageIndex = 0
TabOrder = 40
end
inherited btnAIGenDel: TButton
Images = ImageList1
ImageIndex = 12
TabOrder = 41
end
inherited btnAIGetTextUser: TButton
Images = ImageList1
ImageIndex = 11
TabOrder = 42
end
end
end
@@ -427,8 +501,8 @@ object Form1: TForm1
inherited sgWebChats: TStringGrid
Size.Width = 1042.000000000000000000
Size.Height = 282.000000000000000000
Viewport.Width = 1038.000000000000000000
Viewport.Height = 257.000000000000000000
Viewport.Width = 1042.000000000000000000
Viewport.Height = 282.000000000000000000
inherited StringColumn2: TStringColumn
Size.Width = 200.000000000000000000
end
@@ -448,7 +522,7 @@ object Form1: TForm1
TabOrder = 3
end
inherited Label1: TLabel
TabOrder = 5
TabOrder = 6
end
object btnCreateChat: TButton [4]
Images = ImageList1
@@ -465,10 +539,16 @@ object Form1: TForm1
end
inherited btnCreateOBSNotify: TButton
Images = ImageList1
ImageIndex = 5
ImageIndex = 24
Position.X = 110.000000000000000000
OnClick = frOBS1btnCreateOBSNotifyClick
end
inherited btnCreateOBSKandinsky: TButton
Images = ImageList1
ImageIndex = 5
Position.X = 264.000000000000000000
OnClick = frOBS1btnCreateOBSKandinskyClick
end
end
end
object TabItem6: TTabItem
@@ -531,6 +611,9 @@ object Form1: TForm1
ImageIndex = 14
Text = ''
end
inherited OpenDialog1: TOpenDialog
Top = 32
end
end
end
object TabItem7: TTabItem
@@ -22198,7 +22281,7 @@ object Form1: TForm1
SourceRect.Bottom = 512.000000000000000000
end>
end>
Left = 344
Top = 194
Left = 520
Top = 42
end
end
+53 -25
View File
@@ -13,13 +13,13 @@ uses
windows, System.Skia, FMX.Skia, uCreateChat, uCreateNotify, fOBS;
type
TForm1 = class(TForm)
TTTW_Bot = class(TForm)
V: TTabControl;
TabItem1: TTabItem;
TabItem2: TTabItem;
TabItem3: TTabItem;
TabItem4: TTabItem;
fSettings: TfrSettings;
frSettings1: TfrSettings;
ImageList1: TImageList;
TabItem5: TTabItem;
Panel1: TPanel;
@@ -59,6 +59,9 @@ type
procedure SpeedButton2Click(Sender: TObject);
procedure frChatOBS1btnCreateChatClick(Sender: TObject);
procedure frOBS1btnCreateOBSNotifyClick(Sender: TObject);
procedure frOBS1btnCreateOBSKandinskyClick(Sender: TObject);
procedure frSettings1btnDAStartClick(Sender: TObject);
procedure frCommands1btnRandAddClick(Sender: TObject);
private
{ Private declarations }
procedure ReadDB();
@@ -67,7 +70,7 @@ type
end;
var
Form1: TForm1;
TTW_Bot: TTTW_Bot;
myConst: TConst;
db: TSettingsDatabase;
appconst: TBotAppCfg;
@@ -76,7 +79,7 @@ implementation
{$R *.fmx}
procedure TForm1.cbThemeChange(Sender: TObject);
procedure TTTW_Bot.cbThemeChange(Sender: TObject);
begin
cbTheme.ItemIndex := cbTheme.Items.IndexOf(cbTheme.text);
if cbTheme.ItemIndex <> -1 then
@@ -84,7 +87,7 @@ begin
// db.WriteSetting('cbTheme', inttostr(cbTheme.ItemIndex));
end;
procedure TForm1.FormCreate(Sender: TObject);
procedure TTTW_Bot.FormCreate(Sender: TObject);
var
Path: string;
SearchRec: TSearchRec;
@@ -141,17 +144,46 @@ begin
end;
procedure TForm1.frChatOBS1btnCreateChatClick(Sender: TObject);
procedure TTTW_Bot.frChatOBS1btnCreateChatClick(Sender: TObject);
begin
fCreateChat.Show;
end;
procedure TForm1.frOBS1btnCreateOBSNotifyClick(Sender: TObject);
procedure TTTW_Bot.frCommands1btnRandAddClick(Sender: TObject);
begin
frCommands1.btnRandAddClick(Sender);
end;
procedure TTTW_Bot.frOBS1btnCreateOBSKandinskyClick(Sender: TObject);
var dport:integer;
I: Integer;
begin
dport:=8080;
for I := 0 to frOBS1.sgWebChats.RowCount-1 do
begin
if strtoint(frOBS1.sgWebChats.Cells[0,i]) >= dport then
dport:=strtoint(frOBS1.sgWebChats.Cells[0,i])+1;
end;
frOBS1.sgWebChats.RowCount:=frOBS1.sgWebChats.RowCount+1;
frOBS1.sgWebChats.Cells[0,frOBS1.sgWebChats.RowCount-1]:=inttostr(dport);
frOBS1.sgWebChats.Cells[1,frOBS1.sgWebChats.RowCount-1]:='Kandinsky';
frOBS1.sgWebChats.Cells[2,frOBS1.sgWebChats.RowCount-1]:='http://127.0.0.1:'+inttostr(dport);
end;
procedure TTTW_Bot.frOBS1btnCreateOBSNotifyClick(Sender: TObject);
begin
fCreateNotify.Show;
end;
procedure TForm1.ReadDB;
procedure TTTW_Bot.frSettings1btnDAStartClick(Sender: TObject);
begin
frSettings1.btnDAStartClick(Sender);
end;
procedure TTTW_Bot.ReadDB;
var
I: Integer;
c: TComponent;
@@ -213,25 +245,26 @@ var
I: Integer;
c: TComponent;
begin
for I := 0 to fSettings.ComponentCount - 1 do
for I := 0 to frSettings1.ComponentCount - 1 do
begin
c := fSettings.Components[I];
c := frSettings1.Components[I];
if c is TEdit then
TEdit(c).text := db.ReadSetting(TEdit(c).Name)
else if c is TCheckBox then
TCheckBox(c).IsChecked := (db.ReadSetting(TCheckBox(c).Name) = 'True');
end;
db.FChannel := fSettings.edtChannel.text;
db.FChannel := frSettings1.edtChannel.text;
end;
// Çàãðóçêà äàííûõ â ãðèäû êîìàíä
procedure LoadGridsData;
begin
db.LoadGridFromTable('sgRandomInt', frCommands1.sgRandomInt);
DB.LoadRecordArray<TRandomCounters>('RandomCounters', frCommands1.RandomCounters);
{ db.LoadGridFromTable('sgRandomInt', frCommands1.sgRandomInt);
db.LoadGridFromTable('sgCommands', frCommands1.sgCommands);
db.LoadGridFromTable('sgSAFiles', frCommands1.sgSAFiles);
db.LoadGridFromTable('sgTFiles', frCommands1.sgTFiles);
db.LoadGridFromTable('sgAIGen', frCommands1.sgAIGen);
db.LoadGridFromTable('sgAIGen', frCommands1.sgAIGen); }
end;
// Çàãðóçêà ñïèñêà ãðóïï
@@ -282,21 +315,17 @@ var
end;
end;
fSettings.btnGetClientID.Visible := (appconst.TTV_ClientID <> '');
frSettings1.btnGetClientID.Visible := (appconst.TTV_ClientID <> '');
frAI1.btnGetAIDef.Visible := ((appconst.AI_GigaChat_AC <> '') and
(appconst.AI_GigaChat_ClientID <> '')) or
(appconst.AI_ChatGPT_Token <> '') or (appconst.AI_DeepSeec_Token <> '');
fSettings.btnGetDADef.Visible := (appconst.DA_ClientID <> '') and
frSettings1.btnGetDADef.Visible := (appconst.DA_ClientID <> '') and
(appconst.DA_Sicret <> '') and (appconst.DA_URL <> '');
finally
sl.Free;
end;
end;
// Çàãðóçêà íàñòðîåê óâåäîìëåíèé
procedure LoadNotifySettings;
var
@@ -318,9 +347,6 @@ var
end;
end;
// Çàãðóçêà íàñòðîåê ÈÈ
procedure LoadAISettings;
var
@@ -399,6 +425,8 @@ var
3:
SetupCustomAISettings;
end;
frSettings1.init;
end;
@@ -423,20 +451,20 @@ begin
LoadAutoActionsGrids;
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
procedure TTTW_Bot.SpeedButton1Click(Sender: TObject);
begin
ShellExecute(0, 'open', pwidechar('https://www.twitch.tv/incadence'),
nil, nil, 1);
end;
procedure TForm1.SpeedButton2Click(Sender: TObject);
procedure TTTW_Bot.SpeedButton2Click(Sender: TObject);
begin
// https://www.twitch.tv/kuznecogr
ShellExecute(0, 'open', pwidechar('https://www.twitch.tv/kuznecogr'),
nil, nil, 1);
end;
procedure TForm1.SpeedButton3Click(Sender: TObject);
procedure TTTW_Bot.SpeedButton3Click(Sender: TObject);
begin
// https://www.flaticon.com/ru/authors/karacis
ShellExecute(0, 'open',
+38
View File
@@ -0,0 +1,38 @@
object frmQ: TfrmQ
Left = 0
Top = 0
BorderStyle = ToolWindow
Caption = #1042#1074#1077#1076#1080#1090#1077' '#1079#1085#1072#1095#1077#1085#1080#1077
ClientHeight = 96
ClientWidth = 466
FormFactor.Width = 320
FormFactor.Height = 480
FormFactor.Devices = [Desktop]
DesignerMasterStyle = 0
object Button1: TButton
Position.X = 378.000000000000000000
Position.Y = 66.000000000000000000
TabOrder = 0
Text = #1054#1082
TextSettings.Trimming = None
OnClick = Button1Click
end
object Label1: TLabel
Position.X = 8.000000000000000000
Position.Y = 8.000000000000000000
Size.Width = 450.000000000000000000
Size.Height = 17.000000000000000000
Size.PlatformDefault = False
Text = #1048#1084#1103' '#1073#1086#1090#1072
TabOrder = 1
end
object Edit1: TEdit
Touch.InteractiveGestures = [LongTap, DoubleTap]
TabOrder = 2
Position.X = 8.000000000000000000
Position.Y = 33.000000000000000000
Size.Width = 450.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
end
end
+46
View File
@@ -0,0 +1,46 @@
unit uQ;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Edit,
FMX.StdCtrls, FMX.Controls.Presentation;
type
TfrmQ = class(TForm)
Button1: TButton;
Label1: TLabel;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
function GetEditText: string;
procedure SetLabelText(const Text: string);
end;
var
frmQ: TfrmQ;
implementation
{$R *.fmx}
procedure TfrmQ.Button1Click(Sender: TObject);
begin
ModalResult := mrOk;
end;
function TfrmQ.GetEditText: string;
begin
Result := Edit1.Text;
Edit1.Text:='';
end;
procedure TfrmQ.SetLabelText(const Text: string);
begin
Label1.Text := Text;
end;
end.
+7
View File
@@ -3,6 +3,13 @@ unit uRecords;
interface
type
TRandomCounters = record
Name: string;
Ot: Integer;
ToValue: Integer;
end;
type
TConst = record
GeneralPath: string;
+39
View File
@@ -0,0 +1,39 @@
object fShowText: TfShowText
Left = 0
Top = 0
Caption = 'fShowText'
ClientHeight = 295
ClientWidth = 498
FormFactor.Width = 320
FormFactor.Height = 480
FormFactor.Devices = [Desktop]
DesignerMasterStyle = 0
object Memo1: TMemo
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
DataDetectorTypes = []
Align = Client
Size.Width = 498.000000000000000000
Size.Height = 262.000000000000000000
Size.PlatformDefault = False
TabOrder = 0
Viewport.Width = 494.000000000000000000
Viewport.Height = 258.000000000000000000
end
object Panel1: TPanel
Align = Bottom
Position.Y = 262.000000000000000000
Size.Width = 498.000000000000000000
Size.Height = 33.000000000000000000
Size.PlatformDefault = False
TabOrder = 1
object Label1: TLabel
Position.X = 8.000000000000000000
Position.Y = 8.000000000000000000
Size.Width = 345.000000000000000000
Size.Height = 17.000000000000000000
Size.PlatformDefault = False
Text = #1057#1082#1086#1087#1080#1088#1091#1081' '#1101#1090#1091' '#1089#1089#1099#1083#1082#1091' '#1080' '#1086#1090#1082#1088#1086#1081' '#1074' '#1073#1088#1072#1091#1079#1077#1088#1077' '#1089' '#1072#1082#1082#1072#1091#1085#1090#1086#1084' '#1073#1086#1090#1072
TabOrder = 1
end
end
end
+28
View File
@@ -0,0 +1,28 @@
unit uShowText;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Memo.Types,
FMX.StdCtrls, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo;
type
TfShowText = class(TForm)
Memo1: TMemo;
Panel1: TPanel;
Label1: TLabel;
private
{ Private declarations }
public
{ Public declarations }
end;
var
fShowText: TfShowText;
implementation
{$R *.fmx}
end.
+1134
View File
File diff suppressed because it is too large Load Diff
+171
View File
@@ -0,0 +1,171 @@
unit uTWAuth;
interface
uses
System.SysUtils, System.Classes, IdContext, IdCustomHTTPServer, IdHTTPServer,
IdComponent, ShellAPI;
type
TmyEvent = procedure(txt: string) of object;
type
TTTWAuth = class
FmyEvent: TmyEvent;
FURL: string;
private
FHTTPServer: TIdHTTPServer;
procedure HandleRequest(ASender: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
procedure HandleRootRequest(ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
procedure HandleRedirectRequest(ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
procedure HandleDARequest(ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
procedure OnStatus(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: string);
public
constructor Create;
destructor Destroy; override;
procedure StartServer(aURL: string);
procedure StopServer;
property OnToken: TmyEvent read FmyEvent write FmyEvent;
property OnError: TmyEvent read FmyEvent write FmyEvent;
end;
implementation
constructor TTTWAuth.Create;
begin
FHTTPServer := TIdHTTPServer.Create(nil);
FHTTPServer.OnCommandGet := HandleRequest;
FHTTPServer.OnStatus := OnStatus;
end;
destructor TTTWAuth.Destroy;
begin
FHTTPServer.Free;
inherited;
end;
procedure TTTWAuth.StartServer(aURL: string);
begin
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);
end;
procedure TTTWAuth.StopServer;
begin
FHTTPServer.Active := False;
end;
procedure TTTWAuth.HandleRequest(ASender: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
if ARequestInfo.Document = '/' then
HandleRootRequest(ARequestInfo, AResponseInfo)
else if ARequestInfo.Document = '/redirect' then
HandleRedirectRequest(ARequestInfo, AResponseInfo)
else if ARequestInfo.Document = '/da' then
HandleDARequest(ARequestInfo, AResponseInfo)
else
begin
AResponseInfo.ResponseNo := 404;
AResponseInfo.ContentText := 'Not Found';
end;
end;
procedure TTTWAuth.HandleRootRequest(ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
begin
AResponseInfo.ContentText := '<!DOCTYPE html>' + #13 + '<html>' + #13 +
'<head>' + #13 + ' <title>Redirecting...</title>' + #13 + '</head>' + #13 +
'<body>' + #13 + ' <p>ïîëó÷àþ òîêåí:</p>' + #13 + '<script>' + #13 +
'var paragraph = window.location.href;' + #13 +
'var urrl = paragraph.replace(''localhost/'',''localhost/redirect'');' + #13
+ 'urrl = urrl.replace(''#'',''?'');' + #13 + 'console.log(urrl);' + #13 +
'window.location.href =urrl;' + #13 + ' </script>' + #13 + '</body>' + #13 +
'</html>';
end;
procedure TTTWAuth.OnStatus(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: string);
begin
end;
procedure TTTWAuth.HandleDARequest(ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
begin
AResponseInfo.ContentText := '<!DOCTYPE html>' + #13 + '<html>' + #13 +
'<head>' + #13 + ' <title>Redirecting...</title>' + #13 + '</head>' + #13 +
'<body>' + #13 + ' <p>ïîëó÷àþ êîä</p>' + #13 + '<script>' + #13 +
'var paragraph = window.location.href;' + #13 +
'var urrl = paragraph.replace(''localhost/da'',''localhost/redirect'');' +
#13 + 'urrl = urrl.replace(''#'',''?'');' + #13 + 'console.log(urrl);' + #13
+ 'window.location.href =urrl;' + #13 + ' </script>' + #13 + '</body>' + #13
+ '</html>';
end;
procedure TTTWAuth.HandleRedirectRequest(ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
var
i: integer;
AccessToken: string;
begin
if Pos('access_token=', ARequestInfo.Params.Text) > 0 then
begin
for i := 0 to ARequestInfo.Params.Count - 1 do
if Pos('access_token', ARequestInfo.Params[i]) > 0 then
AccessToken := ARequestInfo.Params[i];
AccessToken := StringReplace(AccessToken, 'access_token=', '',
[rfReplaceAll]);
AResponseInfo.ContentText := '<!DOCTYPE html>' + #13 + '<html>' + #13 +
'<head>' + #13 + ' <title>Done...</title>' + #13 + '</head>' + #13 +
'<body>' + #13 + 'Ýòó ñòðàíèöó ìîæíî çàêðûòü' + #13 + '</body>' + #13 +
'</html>';
AResponseInfo.WriteContent;
OnToken(AccessToken);
Destroy;
end;
if Pos('error_description=', ARequestInfo.Params.Text) > 0 then
begin
for i := 0 to ARequestInfo.Params.Count - 1 do
if Pos('error_description', ARequestInfo.Params[i]) > 0 then
AccessToken := ARequestInfo.Params[i];
AccessToken := StringReplace(AccessToken, 'error_description=', '',
[rfReplaceAll]);
AResponseInfo.ContentText := '<!DOCTYPE html>' + #13 + '<html>' + #13 +
'<head>' + #13 + ' <title>ERROR...</title>' + #13 + '</head>' + #13 +
'<body>' + #13 + AccessToken + #13 + '</body>' + #13 +
'</html>';
AResponseInfo.WriteContent;
OnError(AccessToken);
Destroy;
end;
if Pos('code=', ARequestInfo.Params.Text) > 0 then
begin
for i := 0 to ARequestInfo.Params.Count - 1 do
if Pos('code', ARequestInfo.Params[i]) > 0 then
AccessToken := ARequestInfo.Params[i];
AccessToken := StringReplace(AccessToken, 'code=', '', [rfReplaceAll]);
AResponseInfo.ContentText := '<!DOCTYPE html>' + #13 + '<html>' + #13 +
'<head>' + #13 + ' <title>Done...</title>' + #13 + '</head>' + #13 +
'<body>' + #13 + 'Ýòó ñòðàíèöó ìîæíî çàêðûòü' + #13 + '</body>' + #13 +
'</html>';
AResponseInfo.WriteContent;
OnToken(AccessToken);
Destroy;
end;
end;
end.
+155
View File
@@ -0,0 +1,155 @@
unit uWSDA;
interface
uses
Classes, SysUtils, System.JSON, ipwwsclient, StrUtils, uAPIDA;
type
TOnDonateEvent = procedure(aNick, aMessage, aSum: string) of object;
TOnStatusEvent = procedure(AStatusText: string; AStatusCode:integer) of object;
TWSClient = class(TObject)
private
FWS: TipwWSClient;
FAPIClient: TAPIClient;
FOnDonate: TOnDonateEvent;
FOnStatus: TOnStatusEvent;
FWsstoken: string;
FWSID: string;
procedure DataIn(Sender: TObject; DataFormat: Integer; const Text: string;
const TextB: TBytes; EOM, EOL: Boolean);
procedure ConnectionStatus(Sender: TObject; const ConnectionEvent: string;
StatusCode: Integer; const Description: string);
procedure Error(Sender: TObject; ErrorCode: Integer;
const Description: string);
function ExtractValue(const T_, Text, _T: string): string;
procedure HandleIncomingData(const Data: string);
public
constructor Create;
destructor Destroy; override;
procedure Connect(const WSSURL: string);
procedure Disconnect;
procedure Send(const Data: string);
property OnDonate: TOnDonateEvent read FOnDonate write FOnDonate;
property OnStatus: TOnStatusEvent read FOnStatus write FOnStatus;
property Wsstoken: string read FWsstoken write FWsstoken;
property WSID: string read FWSID write FWSID;
property APIClient: TAPIClient read FAPIClient write FAPIClient;
end;
implementation
constructor TWSClient.Create;
begin
FWS := TipwWSClient.Create(nil);
FWS.OnDataIn := DataIn;
FWS.OnConnectionStatus := ConnectionStatus;
FWS.OnError := Error;
end;
destructor TWSClient.Destroy;
begin
FWS.Disconnect;
FWS.Free;
inherited;
end;
procedure TWSClient.Disconnect;
begin
FWS.Disconnect;
end;
procedure TWSClient.Connect(const WSSURL: string);
begin
FWS.ConnectTo(WSSURL);
end;
procedure TWSClient.Send(const Data: string);
begin
FWS.SendText(Data);
end;
procedure TWSClient.DataIn(Sender: TObject; DataFormat: Integer;
const Text: string; const TextB: TBytes; EOM, EOL: Boolean);
begin
HandleIncomingData(Text);
// FWS.Ping;
end;
procedure TWSClient.ConnectionStatus(Sender: TObject;
const ConnectionEvent: string; StatusCode: Integer;
const Description: string);
begin
if Assigned(FOnStatus) then
FOnStatus(ConnectionEvent,StatusCode);
end;
procedure TWSClient.Error(Sender: TObject; ErrorCode: Integer;
const Description: string);
begin
// fLog.toLog(2, 'uWSDA', 'Error', 'Code: ' + IntToStr(ErrorCode) + ' - ' +
// Description);
end;
function TWSClient.ExtractValue(const T_, Text, _T: string): string;
var
StartPos, EndPos: Integer;
begin
StartPos := Pos(T_, Text);
if StartPos = 0 then
Exit('');
StartPos := StartPos + Length(T_);
EndPos := PosEx(_T, Text, StartPos);
if EndPos = 0 then
Exit('');
Result := Copy(Text, StartPos, EndPos - StartPos);
end;
procedure TWSClient.HandleIncomingData(const Data: string);
var
JSON: TJSONObject;
jo: TJSONObject;
DataObj: TJSONObject;
DonationData: TJSONObject;
ChannelArray: TJSONArray;
wsstoken2: string;
begin
// fLog.toLog(3, 'uWSDA', 'HandleIncomingData', Data);
// Îáðàáîòêà ðåãèñòðàöèè êëèåíòà
if Pos('"result":{"client":"', Data) > 0 then
begin
FWsstoken := ExtractValue('"result":{"client":"', Data, '",');
// fLog.toLog(3, 'uWSDA', 'HandleIncomingData', 'Êëèåíò çàðåãèñòðèðîâàí');
jo := FAPIClient.SubscribeToChannel(FWSID, FWsstoken);
// fLog.toLog(3, 'uWSDA', 'HandleIncomingData', 'Êëèåíò ïîäïèñàí');
ChannelArray := jo.Values['channels'] as TJSONArray;
if Assigned(ChannelArray) and (ChannelArray.Count > 0) then
begin
wsstoken2 := ChannelArray.Items[0].GetValue<string>('token');
// fLog.toLog(3, 'da', 'EventWS', 'Ïîäïèñêà íà êàíàë ñ òîêåíîì: ' +
// wsstoken2);
FWS.SendText('{"params": {"channel": "$alerts:donation_' + FWSID +
'","token": "' + wsstoken2 + '"},"method": 1,"id": 2 }');
end;
end;
// Îáðàáîòêà äîíàòîâ
if Pos('"name":"Donations"', Data) > 0 then
begin
// fLog.toLog(3, 'uWSDA', 'HandleIncomingData', 'Íîâûé Äîíàò');
JSON := TJSONObject.ParseJSONValue(Data) as TJSONObject;
try
DataObj := JSON.GetValue<TJSONObject>('result').GetValue<TJSONObject>
('data').GetValue<TJSONObject>('data');
if Assigned(DataObj) and Assigned(FOnDonate) then
FOnDonate(DataObj.GetValue<string>('username'),
DataObj.GetValue<string>('message'),
DataObj.GetValue<string>('amount'));
finally
JSON.Free;
end;
end;
end;
end.