добавил обработку таймеров и сами таймеры в автоматические действия

This commit is contained in:
PC1\PTyTb
2025-08-08 01:49:45 +03:00
parent 7d9eaaac4e
commit f2c012dd28
12 changed files with 500 additions and 71 deletions
+2 -1
View File
@@ -25,7 +25,8 @@ uses
uQ in 'uQ.pas' {frmQ},
fSimpleGrid in 'fSimpleGrid.pas' {frSimpleGrid: TFrame},
fContruct in 'fContruct.pas' {frContruct: TFrame},
fGroupsRequest in 'fGroupsRequest.pas' {frGroupsRequest: TFrame};
fGroupsRequest in 'fGroupsRequest.pas' {frGroupsRequest: TFrame},
uMyTimer in 'uMyTimer.pas';
{$R *.res}
+1
View File
@@ -392,6 +392,7 @@
<FormType>fmx</FormType>
<DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="uMyTimer.pas"/>
<None Include=".gitignore"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
+5
View File
@@ -35,6 +35,7 @@ object frAutoActions: TfrAutoActions
TabOrder = 40
Text = #1044#1086#1073#1072#1074#1080#1090#1100
TextSettings.Trimming = None
OnClick = btnAddMessageClick
end
object btnRmMessage: TButton
Position.X = 184.000000000000000000
@@ -42,6 +43,7 @@ object frAutoActions: TfrAutoActions
TabOrder = 41
Text = #1059#1076#1072#1083#1080#1090#1100
TextSettings.Trimming = None
OnClick = btnRmMessageClick
end
object btnEditMessage: TButton
Position.X = 96.000000000000000000
@@ -49,6 +51,7 @@ object frAutoActions: TfrAutoActions
TabOrder = 42
Text = #1048#1079#1084#1077#1085#1080#1090#1100
TextSettings.Trimming = None
OnClick = btnEditMessageClick
end
object btnNotifyTest: TButton
Position.X = 412.000000000000000000
@@ -59,6 +62,7 @@ object frAutoActions: TfrAutoActions
TabOrder = 43
Text = #1058#1077#1089#1090
TextSettings.Trimming = None
OnClick = btnNotifyTestClick
end
object sgTimers: TStringGrid
CanFocus = True
@@ -70,6 +74,7 @@ object frAutoActions: TfrAutoActions
Size.PlatformDefault = False
TabOrder = 44
RowCount = 0
OnEditingDone = sgTimersEditingDone
Viewport.Width = 459.000000000000000000
Viewport.Height = 200.000000000000000000
object ccTimerEnable: TCheckColumn
+194 -3
View File
@@ -3,10 +3,11 @@ unit fAutoActions;
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.Edit,
FMX.Controls.Presentation;
System.Rtti, FMX.Grid.Style, FMX.Grid, FMX.ScrollBox, FMX.Edit, StrUtils,
FMX.Controls.Presentation, uMyTimer, uRecords, System.Generics.Collections;
type
TfrAutoActions = class(TFrame)
@@ -48,14 +49,204 @@ type
scCounterTrigger: TStringColumn;
icCounterCount: TIntegerColumn;
ccCounterAuto: TCheckColumn;
procedure btnAddMessageClick(Sender: TObject);
procedure btnEditMessageClick(Sender: TObject);
procedure btnRmMessageClick(Sender: TObject);
procedure btnNotifyTestClick(Sender: TObject);
procedure sgTimersEditingDone(Sender: TObject; const ACol, ARow: Integer);
private
{ Private declarations }
procedure OnMyTimerExec(Sender: TObject; const txt: string; o: Boolean);
public
{ Public declarations }
FTimerList: TObjectList<TMyTimerThread>;
listTimer: TArray<TListTimer>;
procedure UpdateGridFromArray;
procedure initTimers;
end;
implementation
{$R *.fmx}
uses uGeneral;
procedure TfrAutoActions.btnAddMessageClick(Sender: TObject);
var
TimerThread: TMyTimerThread;
NewRec: TListTimer;
begin
if (edtMessage.text = '') or (edtInterval.text = '') then
exit;
TimerThread := TMyTimerThread.Create(edtInterval.text.ToInteger,
edtMessage.text, false);
TimerThread.OnTimerExec := OnMyTimerExec;
FTimerList.Add(TimerThread);
NewRec.Enable := 1;
NewRec.interval := edtInterval.text.ToInteger;
NewRec.o := 0;
NewRec.mess := edtMessage.text;
SetLength(listTimer, Length(listTimer) + 1);
listTimer[High(listTimer)] := NewRec;
UpdateGridFromArray;
DB.SaveRecordArray<TListTimer>('listTimer', listTimer);
edtMessage.text := '';
edtInterval.text := '10';
end;
procedure TfrAutoActions.btnEditMessageClick(Sender: TObject);
var
SelectedRow: Integer;
NewText: string;
NewInterval: Integer;
RowIndex: Integer;
begin
SelectedRow := sgTimers.Row;
if (edtMessage.text = '') or (edtInterval.text = '') or (SelectedRow <= 0) or
(SelectedRow >= sgTimers.RowCount) then
exit;
NewText := edtMessage.text;
NewInterval := StrToIntDef(edtInterval.text, 0);
RowIndex := sgTimers.Row;
if (RowIndex < 0) or (RowIndex > High(listTimer)) then
exit;
if NewInterval <= 0 then
exit;
// Îáíîâëÿåì íàñòðîéêè òàéìåðà
FTimerList[SelectedRow].Update(sgTimers.Cells[2, SelectedRow].ToInteger,
sgTimers.Cells[1, SelectedRow], (sgTimers.Cells[3, SelectedRow] = 'True'));
listTimer[RowIndex].interval := NewInterval;
listTimer[RowIndex].mess := NewText;
UpdateGridFromArray;
DB.SaveRecordArray<TListTimer>('listTimer', listTimer);
edtMessage.text := '';
edtInterval.text := '';
end;
procedure TfrAutoActions.btnNotifyTestClick(Sender: TObject);
var
s: string;
B: Boolean;
begin
s := sgTimers.Cells[1, sgTimers.Row];
B := sgTimers.Cells[3, sgTimers.Row] = 'True';
{ if B then
ttw_API.sendNotify(s)
else
ttw_IRS.sendMessage(s); }
end;
procedure TfrAutoActions.btnRmMessageClick(Sender: TObject);
var
SelectedRow: Integer;
i, RowIndex: Integer;
begin
SelectedRow := sgTimers.Row;
// Ïðîâåðÿåì âàëèäíîñòü âûáðàííîé ñòðîêè
if (SelectedRow < 0) or (SelectedRow >= sgTimers.RowCount) then
exit;
// Ïðîâåðÿåì íàëè÷èå òàéìåðà â ñïèñêå
if (SelectedRow < FTimerList.Count) then
begin
// Îñòàíàâëèâàåì è óíè÷òîæàåì òàéìåð
if Assigned(FTimerList[SelectedRow]) then
begin
FTimerList[SelectedRow].StopT;
FTimerList[SelectedRow].TerminateAndDestroy; // Ìåòîä äëÿ îñòàíîâêè ïîòîêà
FTimerList.Delete(SelectedRow); // Óäàëÿåì èç ñïèñêà ñ àâòîóíè÷òîæåíèåì
end;
end;
// Óäàëÿåì ñòðîêó èç ñåòêè
RowIndex := sgTimers.Row;
if (RowIndex < 0) or (RowIndex > High(listTimer)) then
exit;
// Ñäâèãàåì ýëåìåíòû ìàññèâà
for i := RowIndex to High(listTimer) do
listTimer[i] := listTimer[i + 1];
SetLength(listTimer, Length(listTimer) - 1);
UpdateGridFromArray;
DB.SaveRecordArray<TListTimer>('listTimer', listTimer);
end;
procedure TfrAutoActions.initTimers;
var
i: Integer;
TimerThread: TMyTimerThread;
begin
for i := 0 to High(listTimer) do
begin
TimerThread := TMyTimerThread.Create(listTimer[i].interval,
listTimer[i].mess, listTimer[i].o = 1);
TimerThread.OnTimerExec := OnMyTimerExec;
FTimerList.Add(TimerThread);
end;
end;
procedure TfrAutoActions.OnMyTimerExec(Sender: TObject; const txt: string;
o: Boolean);
begin
{ if o then
ttw_API.sendNotify(txt)
else
ttw_IRS.sendMessage(txt); }
end;
procedure TfrAutoActions.sgTimersEditingDone(Sender: TObject;
const ACol, ARow: Integer);
var
NewRec: TListTimer;
begin
NewRec.Enable := strtoint(ifthen(sgTimers.Cells[0, ARow] = 'True', '1', '0'));
NewRec.o := strtoint(ifthen(sgTimers.Cells[3, ARow] = 'True', '1', '0'));
NewRec.interval := strtoint(sgTimers.Cells[2, ARow]);
NewRec.mess := sgTimers.Cells[1, ARow];
if ACol = 0 then // Êîëîíêà enabled
begin
if NewRec.Enable = 1 then
FTimerList[ARow].StartT
else
FTimerList[ARow].StopT;
end;
if ACol = 3 then // Êîëîíêà o
begin
// Îáíîâëÿåì íàñòðîéêè òàéìåðà
FTimerList[ARow].Update(NewRec.interval, NewRec.mess, (NewRec.o = 1));
end;
listTimer[ARow] := NewRec;
UpdateGridFromArray;
DB.SaveRecordArray<TListTimer>('listTimer', listTimer);
end;
procedure TfrAutoActions.UpdateGridFromArray;
var
i: Integer;
begin
sgTimers.BeginUpdate;
try
sgTimers.RowCount := 0; // Ñáðàñûâàåì ñòðîêè (îñòàâëÿåì òîëüêî çàãîëîâêè)
for i := 0 to High(listTimer) do
begin
sgTimers.RowCount := i + 1;
sgTimers.Cells[0, i] := ifthen(listTimer[i].Enable = 1, 'True', 'False');
sgTimers.Cells[1, i] := listTimer[i].mess;
sgTimers.Cells[2, i] := IntToStr(listTimer[i].interval);
sgTimers.Cells[3, i] := ifthen(listTimer[i].o = 1, 'True', 'False');
end;
finally
sgTimers.EndUpdate;
end;
end;
end.
+45 -19
View File
@@ -14,8 +14,8 @@ object frCommands: TfrCommands
RowCount = 0
Options = [ColumnResize, ColumnMove, ColLines, RowLines, Tabs, Header, HeaderClick, AutoDisplacement]
OnCellClick = sgCommandsCellClick
Viewport.Width = 536.000000000000000000
Viewport.Height = 168.000000000000000000
Viewport.Width = 540.000000000000000000
Viewport.Height = 193.000000000000000000
object scCommand: TStringColumn
Header = #1050#1086#1084#1072#1085#1076#1072
HeaderSettings.TextSettings.WordWrap = False
@@ -45,8 +45,37 @@ object frCommands: TfrCommands
Size.Height = 417.000000000000000000
Size.PlatformDefault = False
inherited mResponse: TMemo
Viewport.Width = 388.000000000000000000
Viewport.Height = 157.000000000000000000
Viewport.Width = 392.000000000000000000
Viewport.Height = 161.000000000000000000
end
inherited GroupBox7: TGroupBox
inherited btnAddUserName: TButton
TabOrder = 37
end
inherited btnGetDateFollow: TButton
TabOrder = 38
end
inherited btnGetAgeAccaunt: TButton
TabOrder = 39
end
inherited btnCounterAddtoText: TButton
TabOrder = 40
end
inherited cbCounterName: TComboBox
TabOrder = 41
end
inherited btnGPT: TButton
TabOrder = 42
end
inherited btnRandomUserName: TButton
TabOrder = 43
end
inherited btnGetChannelStat: TButton
TabOrder = 44
end
inherited btnAIPic: TButton
TabOrder = 45
end
end
inherited btnAddCommand: TButton
OnClick = frContruct1btnAddCommandClick
@@ -86,16 +115,16 @@ object frCommands: TfrCommands
Viewport.Height = 116.000000000000000000
end
inherited btnRandomAdd: TButton
TabOrder = 35
TabOrder = 34
end
inherited btnRandomDel: TButton
TabOrder = 36
TabOrder = 35
end
inherited btnRmGroup: TButton
TabOrder = 38
TabOrder = 37
end
inherited Label4: TLabel
TabOrder = 40
TabOrder = 39
end
end
end
@@ -178,8 +207,8 @@ object frCommands: TfrCommands
RowCount = 0
Options = [ColumnResize, ColumnMove, ColLines, RowLines, Tabs, Header, HeaderClick, AutoDisplacement]
OnCellDblClick = sgRandomIntCellDblClick
Viewport.Width = 153.000000000000000000
Viewport.Height = 119.000000000000000000
Viewport.Width = 157.000000000000000000
Viewport.Height = 144.000000000000000000
object scRIntName: TStringColumn
Header = #1053#1072#1079#1074#1072#1085#1080#1077
HeaderSettings.TextSettings.WordWrap = False
@@ -217,10 +246,9 @@ object frCommands: TfrCommands
Size.PlatformDefault = False
inherited sg: TStringGrid
Size.Width = 293.000000000000000000
TabOrder = 43
OnCellDblClick = frsgSoundssgCellDblClick
Viewport.Width = 289.000000000000000000
Viewport.Height = 124.000000000000000000
Viewport.Width = 293.000000000000000000
Viewport.Height = 149.000000000000000000
inherited sgR2: TStringColumn
Size.Width = 170.000000000000000000
end
@@ -253,10 +281,9 @@ object frCommands: TfrCommands
Size.PlatformDefault = False
inherited sg: TStringGrid
Size.Width = 293.000000000000000000
TabOrder = 43
OnCellDblClick = frsgFilessgCellDblClick
Viewport.Width = 289.000000000000000000
Viewport.Height = 124.000000000000000000
Viewport.Width = 293.000000000000000000
Viewport.Height = 149.000000000000000000
inherited sgR2: TStringColumn
Size.Width = 170.000000000000000000
end
@@ -293,10 +320,9 @@ object frCommands: TfrCommands
Size.PlatformDefault = False
inherited sg: TStringGrid
Size.Width = 293.000000000000000000
TabOrder = 43
OnCellDblClick = frsgNeirosgCellDblClick
Viewport.Width = 289.000000000000000000
Viewport.Height = 124.000000000000000000
Viewport.Width = 293.000000000000000000
Viewport.Height = 149.000000000000000000
inherited sgR2: TStringColumn
Header = #1047#1072#1087#1088#1086#1089
Size.Width = 170.000000000000000000
+3 -3
View File
@@ -9,12 +9,12 @@ object frSimpleGrid: TfrSimpleGrid
Size.Width = 339.000000000000000000
Size.Height = 149.000000000000000000
Size.PlatformDefault = False
TabOrder = 44
TabOrder = 43
RowCount = 0
Options = [ColumnResize, ColumnMove, ColLines, RowLines, Tabs, Header, HeaderClick, AutoDisplacement]
OnCellClick = sgCellClick
Viewport.Width = 335.000000000000000000
Viewport.Height = 124.000000000000000000
Viewport.Width = 339.000000000000000000
Viewport.Height = 149.000000000000000000
object sgR1: TStringColumn
Header = #1053#1072#1079#1074#1072#1085#1080#1077
HeaderSettings.TextSettings.WordWrap = False
+1
View File
@@ -88,6 +88,7 @@ begin
fCreateChat.sbTimeMsg.Value := aRec.TimeMess;
fCreateChat.sbMaxMsg.Value := aRec.MaxCountMess;
fCreateChat.sbWebServerPort.Value := aRec.port;
oldPort := aRec.port;
end;
procedure TfCreateChat.btnCreateWebChatClick(Sender: TObject);
+1
View File
@@ -112,6 +112,7 @@ begin
fCreateNotify.cbEventsType.ItemIndex := TypeEvent;
fCreateNotify.edtIF.Text := TypeEdit;
fCreateNotify.sbWebServerPort.Value := port;
oldPort:=port;
end;
end;
+55 -24
View File
@@ -17,7 +17,7 @@ object TTW_Bot: TTTW_Bot
Size.Width = 970.000000000000000000
Size.Height = 744.000000000000000000
Size.PlatformDefault = False
TabIndex = 4
TabIndex = 7
TabOrder = 0
TabPosition = PlatformDefault
Sizes = (
@@ -283,13 +283,13 @@ object TTW_Bot: TTTW_Bot
Viewport.Height = 116.000000000000000000
end
inherited btnRandomAdd: TButton
TabOrder = 34
TabOrder = 33
end
inherited btnRandomDel: TButton
TabOrder = 35
TabOrder = 34
end
inherited btnRmGroup: TButton
TabOrder = 37
inherited Label4: TLabel
TabOrder = 35
end
inherited Label5: TLabel
TabOrder = 43
@@ -432,7 +432,7 @@ object TTW_Bot: TTTW_Bot
item
end>
TextSettings.Trimming = None
IsSelected = True
IsSelected = False
ImageIndex = 10
Size.Width = 136.000000000000000000
Size.Height = 26.000000000000000000
@@ -450,8 +450,8 @@ object TTW_Bot: TTTW_Bot
inherited sgWebChats: TStringGrid
Size.Width = 970.000000000000000000
Size.Height = 282.000000000000000000
Viewport.Width = 970.000000000000000000
Viewport.Height = 282.000000000000000000
Viewport.Width = 966.000000000000000000
Viewport.Height = 257.000000000000000000
inherited StringColumn2: TStringColumn
Size.Width = 200.000000000000000000
end
@@ -472,7 +472,7 @@ object TTW_Bot: TTTW_Bot
OnClick = frOBS1btnDeleteeChatClick
end
inherited Label1: TLabel
TabOrder = 8
TabOrder = 9
end
inherited btnCreateOBSNotify: TButton
Images = ImageList1
@@ -585,7 +585,7 @@ object TTW_Bot: TTTW_Bot
item
end>
TextSettings.Trimming = None
IsSelected = False
IsSelected = True
ImageIndex = 23
Size.Width = 101.000000000000000000
Size.Height = 26.000000000000000000
@@ -601,25 +601,36 @@ object TTW_Bot: TTTW_Bot
Size.Height = 718.000000000000000000
Size.PlatformDefault = False
inherited GroupBox20: TGroupBox
inherited edtMessage: TEdit
TabOrder = 38
end
inherited edtInterval: TEdit
TabOrder = 39
end
inherited btnAddMessage: TButton
Images = ImageList1
ImageIndex = 0
TabOrder = 40
end
inherited btnRmMessage: TButton
Images = ImageList1
ImageIndex = 4
TabOrder = 41
end
inherited btnEditMessage: TButton
Images = ImageList1
ImageIndex = 3
TabOrder = 42
end
inherited btnNotifyTest: TButton
Images = ImageList1
ImageIndex = 25
TabOrder = 43
end
inherited sgTimers: TStringGrid
Viewport.Width = 463.000000000000000000
Viewport.Height = 225.000000000000000000
TabOrder = 44
Viewport.Width = 459.000000000000000000
Viewport.Height = 200.000000000000000000
inherited scTimerMessage: TStringColumn
Size.Width = 301.000000000000000000
end
@@ -629,21 +640,28 @@ object TTW_Bot: TTTW_Bot
end
end
inherited GroupBox23: TGroupBox
inherited edtBanWords: TEdit
TabOrder = 38
end
inherited btnBanWordsAdd: TButton
Images = ImageList1
ImageIndex = 0
TabOrder = 39
end
inherited btnBanWordsEdt: TButton
Images = ImageList1
ImageIndex = 3
TabOrder = 40
end
inherited btnBanWordsDel: TButton
Images = ImageList1
ImageIndex = 4
TabOrder = 41
end
inherited sgBanWords: TStringGrid
Viewport.Width = 297.000000000000000000
Viewport.Height = 225.000000000000000000
TabOrder = 42
Viewport.Width = 293.000000000000000000
Viewport.Height = 200.000000000000000000
inherited scRegEx: TStringColumn
Size.Width = 265.000000000000000000
end
@@ -654,34 +672,47 @@ object TTW_Bot: TTTW_Bot
Position.X = 217.000000000000000000
Size.Width = 88.000000000000000000
Size.PlatformDefault = False
TabOrder = 43
end
inherited Label6: TLabel
TabOrder = 44
end
inherited edtBanWordsCheck: TEdit
TabOrder = 45
Size.Width = 201.000000000000000000
end
inherited Label7: TLabel
TabOrder = 46
end
inherited lBanWordsCheck: TLabel
TabOrder = 47
end
end
inherited GroupBox17: TGroupBox
inherited edtCounterName: TEdit
TabOrder = 42
end
inherited edtCounterTrigger: TEdit
TabOrder = 38
TabOrder = 39
end
inherited edtCounterCount: TEdit
TabOrder = 37
TabOrder = 38
end
inherited btnCounterAdd: TButton
Images = ImageList1
ImageIndex = 0
TabOrder = 39
TabOrder = 40
end
inherited btnCounterDelete: TButton
Images = ImageList1
ImageIndex = 4
TabOrder = 40
end
inherited btnCounterP: TButton
Images = ImageList1
ImageIndex = 0
Position.X = 416.000000000000000000
Size.Width = 22.000000000000000000
TabOrder = 42
TabOrder = 43
Text = ''
end
inherited btnCounterM: TButton
@@ -689,18 +720,18 @@ object TTW_Bot: TTTW_Bot
ImageIndex = 12
Position.X = 449.000000000000000000
Size.Width = 22.000000000000000000
TabOrder = 43
TabOrder = 44
Text = ''
end
inherited btnCounterEdit: TButton
Images = ImageList1
ImageIndex = 3
TabOrder = 44
TabOrder = 45
end
inherited sgCounter: TStringGrid
TabOrder = 45
Viewport.Width = 463.000000000000000000
Viewport.Height = 121.000000000000000000
TabOrder = 46
Viewport.Width = 459.000000000000000000
Viewport.Height = 96.000000000000000000
inherited scCounterTrigger: TStringColumn
Size.Width = 236.000000000000000000
end
+28 -21
View File
@@ -8,7 +8,8 @@ uses
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.TabControl,
FMX.Controls.Presentation, FMX.StdCtrls, System.ImageList, FMX.ImgList,
FMX.Styles, ShellAPI, StrUtils,
fSettings, fAI, fNotify, fAutoActions, FMX.ListBox, fLog, uRecords,
fSettings, fAI, fNotify, fAutoActions, FMX.ListBox, fLog, uMyTimer, uRecords,
System.Generics.Collections,
System.IOUtils, fCommands, uDataBase, FMX.Edit, FMX.Colors, FMX.SpinBox,
windows, System.Skia, FMX.Skia, uCreateChat, uCreateNotify, fOBS;
@@ -133,6 +134,7 @@ begin
myConst.cfg1 := myConst.GeneralPath + 'botapp.cfg';
db := TSettingsDatabase.Create(myConst.DBPath);
frAutoActions1.FTimerList := TObjectList<TMyTimerThread>.Create(false);
ReadDB;
frCommands1.frsgSounds.ObjectRecord := frCommands1.listSounds;
frCommands1.frsgSounds.TableName := 'listSounds';
@@ -252,11 +254,6 @@ var
db.LoadRecordArray<TListCommands>('listCommands', frCommands1.listCommands);
frCommands1.UpdateGridFromArray;
db.LoadRecordArray<TOBSChat>('listChats', frOBS1.listChats);
db.LoadRecordArray<TOBSNotify>('listNotify', frOBS1.listNotify);
db.LoadRecordArray<TOBSKandinsky>('listKandinsky', frOBS1.listKandinsky);
frOBS1.UpdateGridFromArray;
end;
// Çàãðóçêà ñïèñêà ãðóïï
@@ -352,11 +349,11 @@ var
frAI1.rbGC.IsChecked := True;
frAI1.Label45.text := 'ClientID';
frAI1.Label47.text := 'Autorization Code';
frAI1.Label1.Visible := False;
frAI1.Label1.Visible := false;
frAI1.edtAIP2.Visible := True;
frAI1.edtAIP2.Password := True;
frAI1.edtAIP3.Visible := False;
frAI1.cbOllama.Visible := False;
frAI1.edtAIP3.Visible := false;
frAI1.cbOllama.Visible := false;
end;
// Íàñòðîéêè DeepSeek
@@ -365,10 +362,10 @@ var
frAI1.rbDS.IsChecked := True;
frAI1.Label45.text := 'API Token';
frAI1.Label47.text := '';
frAI1.Label1.Visible := False;
frAI1.edtAIP2.Visible := False;
frAI1.edtAIP3.Visible := False;
frAI1.cbOllama.Visible := False;
frAI1.Label1.Visible := false;
frAI1.edtAIP2.Visible := false;
frAI1.edtAIP3.Visible := false;
frAI1.cbOllama.Visible := false;
end;
// Íàñòðîéêè ChatGPT
@@ -377,10 +374,10 @@ var
frAI1.rbCG.IsChecked := True;
frAI1.Label45.text := 'API Token';
frAI1.Label47.text := '';
frAI1.Label1.Visible := False;
frAI1.edtAIP2.Visible := False;
frAI1.edtAIP3.Visible := False;
frAI1.cbOllama.Visible := False;
frAI1.Label1.Visible := false;
frAI1.edtAIP2.Visible := false;
frAI1.edtAIP3.Visible := false;
frAI1.cbOllama.Visible := false;
end;
// Íàñòðîéêè êàñòîìíîãî ÈÈ
@@ -391,7 +388,7 @@ var
frAI1.Label47.text := 'URL';
frAI1.Label1.Visible := True;
frAI1.edtAIP2.Visible := True;
frAI1.edtAIP2.Password := False;
frAI1.edtAIP2.Password := false;
frAI1.edtAIP3.Visible := True;
frAI1.cbOllama.Visible := True;
frAI1.cbOllama.IsChecked := db.ReadSetting(frAI1.cbOllama.Name) = '1';
@@ -425,9 +422,18 @@ var
// Çàãðóçêà ãðèäîâ àâòîìàòè÷åñêèõ äåéñòâèé
procedure LoadAutoActionsGrids;
begin
db.LoadGridFromTable('sgTimers', frAutoActions1.sgTimers);
db.LoadGridFromTable('sgCounter', frAutoActions1.sgCounter);
db.LoadGridFromTable('sgBanWords', frAutoActions1.sgBanWords);
db.LoadRecordArray<TListTimer>('listTimer', frAutoActions1.listTimer);
frAutoActions1.initTimers;
frAutoActions1.UpdateGridFromArray;
end;
// Çàãðóçêà èíòåãðàöèé ñ ÎÁÑ
procedure LoadOBSGrids;
begin
db.LoadRecordArray<TOBSChat>('listChats', frOBS1.listChats);
db.LoadRecordArray<TOBSNotify>('listNotify', frOBS1.listNotify);
db.LoadRecordArray<TOBSKandinsky>('listKandinsky', frOBS1.listKandinsky);
frOBS1.UpdateGridFromArray;
end;
begin
@@ -438,6 +444,7 @@ begin
LoadNotifySettings;
LoadAISettings;
LoadOBSGrids;
LoadAutoActionsGrids;
end;
+158
View File
@@ -0,0 +1,158 @@
unit uMyTimer;
interface
uses
System.Classes, System.SyncObjs, System.SysUtils;
type
TTimerExec = procedure(Sender: TObject; const txt: string; o: Boolean) of object;
TMyTimerThread = class(TThread)
private
FEvent: TEvent;
FCriticalSection: TCriticalSection;
FInterval: Integer;
FText: string;
FFlagO: Boolean;
FEnabled: Boolean;
FOnTimerExec: TTimerExec;
procedure SyncTimerEvent;
protected
procedure Execute; override;
public
constructor Create(AIntervalMinutes: Integer; const AText: string; AFlagO: Boolean);
destructor Destroy; override;
procedure StartT;
procedure StopT;
procedure TerminateAndDestroy;
procedure Update(AIntervalMinutes: Integer; const AText: string; AFlagO: Boolean);
property OnTimerExec: TTimerExec read FOnTimerExec write FOnTimerExec;
end;
implementation
{ TMyTimerThread }
constructor TMyTimerThread.Create(AIntervalMinutes: Integer; const AText: string; AFlagO: Boolean);
begin
inherited Create(True);
FreeOnTerminate := False;
FEvent := TEvent.Create(nil, True, False, '');
FCriticalSection := TCriticalSection.Create;
FInterval := AIntervalMinutes * 60 * 1000;
FText := AText;
FFlagO := AFlagO;
FEnabled := False;
end;
destructor TMyTimerThread.Destroy;
begin
StopT;
Terminate;
FEvent.SetEvent;
if not Suspended then
WaitFor;
FreeAndNil(FEvent);
FreeAndNil(FCriticalSection);
inherited;
end;
procedure TMyTimerThread.Execute;
var
WaitResult: TWaitResult;
LocalInterval: Integer;
begin
while not Terminated do
begin
FCriticalSection.Enter;
try
if FEnabled then
LocalInterval := FInterval
else
LocalInterval := INFINITE;
finally
FCriticalSection.Leave;
end;
WaitResult := FEvent.WaitFor(LocalInterval);
FCriticalSection.Enter;
try
if FEnabled and (WaitResult = wrTimeout) then
begin
if Assigned(FOnTimerExec) then
SyncTimerEvent;
end;
finally
FCriticalSection.Leave;
end;
FEvent.ResetEvent;
end;
end;
procedure TMyTimerThread.StartT;
begin
FCriticalSection.Enter;
try
FEnabled := True;
Suspended:=false;
finally
FCriticalSection.Leave;
end;
if Suspended then
Start;
FEvent.SetEvent;
end;
procedure TMyTimerThread.StopT;
begin
FCriticalSection.Enter;
try
FEnabled := False;
Suspended:=true;
finally
FCriticalSection.Leave;
end;
FEvent.SetEvent;
end;
procedure TMyTimerThread.SyncTimerEvent;
var
LText: string;
LFlag: Boolean;
begin
FCriticalSection.Enter;
try
LText := FText;
LFlag := FFlagO;
finally
FCriticalSection.Leave;
end;
if Assigned(FOnTimerExec) then
FOnTimerExec(Self, LText, LFlag);
end;
procedure TMyTimerThread.TerminateAndDestroy;
begin
StopT;
Terminate;
Free;
end;
procedure TMyTimerThread.Update(AIntervalMinutes: Integer; const AText: string; AFlagO: Boolean);
begin
FCriticalSection.Enter;
try
FInterval := AIntervalMinutes * 60 * 1000;
FText := AText;
FFlagO := AFlagO;
finally
FCriticalSection.Leave;
end;
FEvent.SetEvent;
end;
end.
+7
View File
@@ -2,6 +2,13 @@ unit uRecords;
interface
type TListTimer = record
Enable:integer;
interval:integer;
o:integer;
mess:string;
end;
type
TOBSKandinsky = record
port: integer;