реструктуризация файлов, добавление вебчатов
This commit is contained in:
PC1\PTyTb
@@ -17,3 +17,4 @@ __history/
|
||||
backup/
|
||||
bin/
|
||||
lib/
|
||||
piper/
|
||||
|
||||
+23
@@ -0,0 +1,23 @@
|
||||
program Player;
|
||||
{$APPTYPE GUI}
|
||||
|
||||
uses
|
||||
System.StartUpCopy,
|
||||
FMX.Forms,
|
||||
Web.WebReq,
|
||||
IdHTTPWebBrokerBridge,
|
||||
uPlayer in 'uPlayer.pas' {fPlayer},
|
||||
uOBS_Doc_Player in 'uOBS_Doc_Player.pas' {OBS_Doc_Player: TDataModule},
|
||||
uPlayerThread in 'uPlayerThread.pas',
|
||||
uPlayerWeb in 'uPlayerWeb.pas' {frPlayerWeb: TFrame};
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
if WebRequestHandler <> nil then
|
||||
WebRequestHandler.WebModuleClass := OBS_Doc_Player;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TfPlayer, fPlayer);
|
||||
Application.Run;
|
||||
|
||||
end.
|
||||
+1319
File diff suppressed because it is too large
Load Diff
Binary file not shown.
|
After Width: | Height: | Size: 4.2 KiB |
@@ -0,0 +1,48 @@
|
||||
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||
<PropertyGroup>
|
||||
<ProjectGuid>{4668C1BF-7804-4469-B989-F2A5607035A1}</ProjectGuid>
|
||||
</PropertyGroup>
|
||||
<ItemGroup>
|
||||
<Projects Include="TTW_Bot_app.dproj">
|
||||
<Dependencies/>
|
||||
</Projects>
|
||||
<Projects Include="SilentPlayer.dproj">
|
||||
<Dependencies/>
|
||||
</Projects>
|
||||
</ItemGroup>
|
||||
<ProjectExtensions>
|
||||
<Borland.Personality>Default.Personality.12</Borland.Personality>
|
||||
<Borland.ProjectType/>
|
||||
<BorlandProject>
|
||||
<Default.Personality/>
|
||||
</BorlandProject>
|
||||
</ProjectExtensions>
|
||||
<Target Name="TTW_Bot_app">
|
||||
<MSBuild Projects="TTW_Bot_app.dproj"/>
|
||||
</Target>
|
||||
<Target Name="TTW_Bot_app:Clean">
|
||||
<MSBuild Projects="TTW_Bot_app.dproj" Targets="Clean"/>
|
||||
</Target>
|
||||
<Target Name="TTW_Bot_app:Make">
|
||||
<MSBuild Projects="TTW_Bot_app.dproj" Targets="Make"/>
|
||||
</Target>
|
||||
<Target Name="SilentPlayer">
|
||||
<MSBuild Projects="SilentPlayer.dproj"/>
|
||||
</Target>
|
||||
<Target Name="SilentPlayer:Clean">
|
||||
<MSBuild Projects="SilentPlayer.dproj" Targets="Clean"/>
|
||||
</Target>
|
||||
<Target Name="SilentPlayer:Make">
|
||||
<MSBuild Projects="SilentPlayer.dproj" Targets="Make"/>
|
||||
</Target>
|
||||
<Target Name="Build">
|
||||
<CallTarget Targets="TTW_Bot_app;SilentPlayer"/>
|
||||
</Target>
|
||||
<Target Name="Clean">
|
||||
<CallTarget Targets="TTW_Bot_app:Clean;SilentPlayer:Clean"/>
|
||||
</Target>
|
||||
<Target Name="Make">
|
||||
<CallTarget Targets="TTW_Bot_app:Make;SilentPlayer:Make"/>
|
||||
</Target>
|
||||
<Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/>
|
||||
</Project>
|
||||
@@ -0,0 +1,9 @@
|
||||
<?xml version="1.0" encoding="utf-8"?>
|
||||
<BorlandProject>
|
||||
<Transactions>
|
||||
<Transaction>2025.08.10 08:44:51.964,C:\Users\PTyTb\Documents\Embarcadero\Studio\Projects\ttw_fmx_v10\ProjectGroup1.groupproj=C:\Users\PTyTb\Documents\Embarcadero\Studio\Projects\ProjectGroup1.groupproj</Transaction>
|
||||
</Transactions>
|
||||
<Default.Personality>
|
||||
<Projects ActiveProject="C:\Users\PTyTb\Documents\Embarcadero\Studio\Projects\ttw_fmx_v10\TTW_Bot_app.dproj"/>
|
||||
</Default.Personality>
|
||||
</BorlandProject>
|
||||
@@ -0,0 +1,195 @@
|
||||
unit uChatAPI;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, IdHTTP, System.JSON, IdSSLOpenSSL, IdGlobal;
|
||||
|
||||
type
|
||||
TMessage = procedure(s: string) of object;
|
||||
|
||||
type
|
||||
TChatAPI = class(TObject)
|
||||
protected
|
||||
FToken_api: string;
|
||||
FPrefix: string;
|
||||
FOnError: TMessage;
|
||||
function GetOtvetFromJson(jsonString: string; isOllama: boolean = false)
|
||||
: string; virtual;
|
||||
function CreateHTTPRequest(const url: string; const params: TStringStream;
|
||||
isOllama: boolean = false): string;
|
||||
|
||||
public
|
||||
constructor Create(Sender: TObject; aToken: string;
|
||||
aprefix: string = ''); virtual;
|
||||
destructor Destroy; override;
|
||||
function GetGPTRequest(url: string; model: string; q: string;
|
||||
isOllama: boolean = false): string;
|
||||
property OnError: TMessage read FOnError write FOnError;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TChatAPI }
|
||||
|
||||
constructor TChatAPI.Create(Sender: TObject; aToken: string;
|
||||
aprefix: string = '');
|
||||
begin
|
||||
FPrefix := aprefix;
|
||||
FToken_api := aToken;
|
||||
end;
|
||||
|
||||
function TChatAPI.CreateHTTPRequest(const url: string;
|
||||
const params: TStringStream; isOllama: boolean = false): string;
|
||||
var
|
||||
http: TIdHTTP;
|
||||
ssl: TIdSSLIOHandlerSocketOpenSSL;
|
||||
otv: string;
|
||||
begin
|
||||
http := TIdHTTP.Create(nil);
|
||||
ssl := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
|
||||
try
|
||||
http.IOHandler := ssl;
|
||||
ssl.SSLOptions.method := sslvSSLv23;
|
||||
http.Request.UserAgent :=
|
||||
'Mozilla/5.0 (Windows NT 10.0) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/120.0.0.0 Safari/537.36';
|
||||
http.Request.CustomHeaders.Clear;
|
||||
// http.Request.CustomHeaders.Add('Content-Type: application/json; charset=utf-8');
|
||||
http.Request.ContentType := 'application/json; charset=utf-8';
|
||||
|
||||
if FToken_api <> '' then
|
||||
http.Request.CustomHeaders.Add('Authorization: Bearer ' + FToken_api);
|
||||
http.Request.Accept := 'application/json; charset=utf-8';
|
||||
http.Request.CharSet := 'utf-8';
|
||||
http.Response.CharSet := 'utf-8';
|
||||
// http.Request.CustomHeaders.Add('Accept: application/json; charset=utf-8');
|
||||
http.Response.ContentEncoding := 'utf-8';
|
||||
http.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
|
||||
http.Request.ContentEncoding := 'utf-8';
|
||||
|
||||
try
|
||||
otv := http.Post(url, params);
|
||||
Result := GetOtvetFromJson(otv, isOllama);
|
||||
except
|
||||
on E: Exception do
|
||||
if Assigned(OnError) then
|
||||
OnError(E.Message);
|
||||
end;
|
||||
finally
|
||||
params.Free;
|
||||
http.Free;
|
||||
ssl.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TChatAPI.Destroy;
|
||||
begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function ReplaceDelphiHexCodes(const InputStr: string): string;
|
||||
var
|
||||
I, Start, HexVal: Integer;
|
||||
HexStr: string;
|
||||
begin
|
||||
Result := '';
|
||||
I := 1;
|
||||
while I <= Length(InputStr) do
|
||||
begin
|
||||
if (I <= Length(InputStr) - 5) and (InputStr[I] = '#') and
|
||||
(InputStr[I + 1] = '$') then
|
||||
begin
|
||||
HexStr := Copy(InputStr, I + 2, 4);
|
||||
if TryStrToInt('$' + HexStr, HexVal) then
|
||||
begin
|
||||
Result := Result + WideChar(HexVal);
|
||||
Inc(I, 6); // Ïðîïóñêàåì #$XXXX
|
||||
Continue;
|
||||
end;
|
||||
end;
|
||||
Result := Result + InputStr[I];
|
||||
Inc(I);
|
||||
end;
|
||||
end;
|
||||
|
||||
function ConvertAnsiToUtf8(const AStr: string): string;
|
||||
var
|
||||
AnsiBytes: TBytes;
|
||||
begin
|
||||
AnsiBytes := TEncoding.ANSI.GetBytes(AStr);
|
||||
Result := TEncoding.UTF8.GetString(AnsiBytes);
|
||||
end;
|
||||
|
||||
function TChatAPI.GetOtvetFromJson(jsonString: string;
|
||||
isOllama: boolean = false): string;
|
||||
var
|
||||
JSON: TJSONObject;
|
||||
dataArray: TJSONArray;
|
||||
JSONValue: TJSONValue;
|
||||
JsonParts: TStringList;
|
||||
I: Integer;
|
||||
CleanedJson: string;
|
||||
JsonObj: TJSONObject;
|
||||
ResponseStr, FullResponse: string;
|
||||
begin
|
||||
|
||||
Result := 'Ïðîèçîøëà êàêàÿ òî îøèáêà, ïîïðîáóéòå ñïðàøèâàòü ïî î÷åðåäè!';
|
||||
if isOllama then
|
||||
begin
|
||||
JSON := TJSONObject.ParseJSONValue(jsonString) as TJSONObject;
|
||||
try
|
||||
if Assigned(JSON) then
|
||||
begin
|
||||
JSONValue := TJSONObject(JSON);
|
||||
if JSONValue.TryGetValue('response', JSONValue) then
|
||||
Result := JSONValue.Value;
|
||||
end;
|
||||
finally
|
||||
JSON.Free;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
JSON := TJSONObject.ParseJSONValue(jsonString) as TJSONObject;
|
||||
try
|
||||
if Assigned(JSON) then
|
||||
begin
|
||||
if JSON.TryGetValue('messages', JSONValue) then
|
||||
begin
|
||||
dataArray := JSONValue as TJSONArray;
|
||||
if Assigned(dataArray) and (dataArray.Count > 0) then
|
||||
Result := dataArray.Items[0].GetValue<string>('content');
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
JSON.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TChatAPI.GetGPTRequest(url: string; model: string; q: string;
|
||||
isOllama: boolean = false): string;
|
||||
var
|
||||
params: TStringStream;
|
||||
r: string;
|
||||
begin
|
||||
|
||||
q := StringReplace(q, '"', '''', [rfReplaceAll]);
|
||||
if isOllama then
|
||||
params := TStringStream.Create('{ "model": "' + model + '", "prompt": "' +
|
||||
FPrefix + q + '", "stream": false }', TEncoding.UTF8)
|
||||
else
|
||||
params := TStringStream.Create('{ "model": "' + model +
|
||||
'", "messages": [{ "role": "user", "content": "' + FPrefix + q +
|
||||
'" }], "stream": false }', CP_UTF8);
|
||||
|
||||
try
|
||||
r := CreateHTTPRequest(url, params, isOllama);
|
||||
finally
|
||||
// params.Free;
|
||||
end;
|
||||
Result := r;
|
||||
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,410 @@
|
||||
unit uCustomEmoties;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, System.Generics.Collections, System.JSON, uRecords, IdHTTP, IdSSLOpenSSL,
|
||||
System.Net.HttpClient, System.SysUtils;
|
||||
|
||||
type
|
||||
TOnLog = procedure(aModul: string; aMethod: string; aMessage: string; aLevel: integer) of object;
|
||||
|
||||
|
||||
type
|
||||
TBTTV = class(TObject)
|
||||
private
|
||||
list: TList<TBTTVr>;
|
||||
FOnLog: TOnLog;
|
||||
procedure AddEmotesGlobalJson(const JsonStr: string);
|
||||
procedure AddEmotesUserJson(const JsonStr: string);
|
||||
function GetHTTP(aMethod: string): string;
|
||||
procedure toLog(alevel: integer; amethod: string; amessage: string);
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure GetGlobal;
|
||||
procedure GetCustom(uid: string);
|
||||
function GenerateURL(emoteName: string): string;
|
||||
property OnLog: TOnLog read FOnLog write FOnLog;
|
||||
end;
|
||||
|
||||
type
|
||||
T7TV = class(TObject)
|
||||
private
|
||||
list7: TList<T7TVr>;
|
||||
FOnLog: TOnLog;
|
||||
procedure AddEmotesGlobalJson(const JsonStr: string);
|
||||
procedure AddEmotesUserJson(const JsonStr: string);
|
||||
function GetHTTP(aMethod: string): string;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure GetGlobal;
|
||||
procedure GetCustom(uid: string);
|
||||
function GenerateURL(emoteName: string): string;
|
||||
procedure toLog(alevel: integer; amethod: string; amessage: string);
|
||||
property OnLog: TOnLog read FOnLog write FOnLog;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TBTTV }
|
||||
|
||||
constructor TBTTV.Create;
|
||||
begin
|
||||
inherited;
|
||||
list := TList<TBTTVr>.Create;
|
||||
end;
|
||||
|
||||
destructor TBTTV.Destroy;
|
||||
begin
|
||||
FreeAndNil(list);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TBTTV.AddEmotesGlobalJson(const JsonStr: string);
|
||||
var
|
||||
JSONValue: TJSONValue;
|
||||
JSONArray: TJSONArray;
|
||||
EmoteObj: TJSONObject;
|
||||
NewEmote: TBTTVr;
|
||||
i: Integer;
|
||||
begin
|
||||
JSONValue := TJSONObject.ParseJSONValue(JsonStr);
|
||||
if not Assigned(JSONValue) then Exit;
|
||||
|
||||
try
|
||||
if not (JSONValue is TJSONArray) then Exit;
|
||||
JSONArray := TJSONArray(JSONValue);
|
||||
|
||||
for i := 0 to JSONArray.Count - 1 do
|
||||
begin
|
||||
if not (JSONArray.Items[i] is TJSONObject) then Continue;
|
||||
|
||||
EmoteObj := TJSONObject(JSONArray.Items[i]);
|
||||
NewEmote := Default(TBTTVr);
|
||||
|
||||
if Assigned(EmoteObj.GetValue('id')) then
|
||||
NewEmote.id := EmoteObj.GetValue('id').Value;
|
||||
if Assigned(EmoteObj.GetValue('code')) then
|
||||
NewEmote.code := EmoteObj.GetValue('code').Value;
|
||||
|
||||
if not NewEmote.id.IsEmpty and not NewEmote.code.IsEmpty then
|
||||
list.Add(NewEmote);
|
||||
end;
|
||||
finally
|
||||
JSONValue.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TBTTV.AddEmotesUserJson(const JsonStr: string);
|
||||
var
|
||||
JSONValue, ChannelEmotes: TJSONValue;
|
||||
JSONArray: TJSONArray;
|
||||
EmoteObj: TJSONObject;
|
||||
NewEmote: TBTTVr;
|
||||
i: Integer;
|
||||
begin
|
||||
JSONValue := TJSONObject.ParseJSONValue(JsonStr);
|
||||
if not Assigned(JSONValue) then Exit;
|
||||
|
||||
try
|
||||
// Îáðàáîòêà channelEmotes
|
||||
ChannelEmotes := TJSONObject(JSONValue).GetValue('channelEmotes');
|
||||
if (ChannelEmotes is TJSONArray) then
|
||||
begin
|
||||
JSONArray := TJSONArray(ChannelEmotes);
|
||||
for i := 0 to JSONArray.Count - 1 do
|
||||
begin
|
||||
if not (JSONArray.Items[i] is TJSONObject) then Continue;
|
||||
|
||||
EmoteObj := TJSONObject(JSONArray.Items[i]);
|
||||
NewEmote := Default(TBTTVr);
|
||||
|
||||
if Assigned(EmoteObj.GetValue('id')) then
|
||||
NewEmote.id := EmoteObj.GetValue('id').Value;
|
||||
if Assigned(EmoteObj.GetValue('code')) then
|
||||
NewEmote.code := EmoteObj.GetValue('code').Value;
|
||||
|
||||
if not NewEmote.id.IsEmpty and not NewEmote.code.IsEmpty then
|
||||
list.Add(NewEmote);
|
||||
end;
|
||||
end;
|
||||
|
||||
// Îáðàáîòêà sharedEmotes
|
||||
ChannelEmotes := TJSONObject(JSONValue).GetValue('sharedEmotes');
|
||||
if (ChannelEmotes is TJSONArray) then
|
||||
begin
|
||||
JSONArray := TJSONArray(ChannelEmotes);
|
||||
for i := 0 to JSONArray.Count - 1 do
|
||||
begin
|
||||
if not (JSONArray.Items[i] is TJSONObject) then Continue;
|
||||
|
||||
EmoteObj := TJSONObject(JSONArray.Items[i]);
|
||||
NewEmote := Default(TBTTVr);
|
||||
|
||||
if Assigned(EmoteObj.GetValue('id')) then
|
||||
NewEmote.id := EmoteObj.GetValue('id').Value;
|
||||
if Assigned(EmoteObj.GetValue('code')) then
|
||||
NewEmote.code := EmoteObj.GetValue('code').Value;
|
||||
|
||||
if not NewEmote.id.IsEmpty and not NewEmote.code.IsEmpty then
|
||||
list.Add(NewEmote);
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
JSONValue.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TBTTV.GenerateURL(emoteName: string): string;
|
||||
var
|
||||
emote: TBTTVr;
|
||||
begin
|
||||
Result := '';
|
||||
for emote in list do
|
||||
begin
|
||||
if emote.code = emoteName then
|
||||
begin
|
||||
Result := 'https://cdn.betterttv.net/emote/' + emote.id + '/1x';
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TBTTV.GetCustom(uid: string);
|
||||
begin
|
||||
if not uid.IsEmpty then
|
||||
AddEmotesUserJson(GetHTTP('users/twitch/' + uid));
|
||||
end;
|
||||
|
||||
procedure TBTTV.GetGlobal;
|
||||
begin
|
||||
AddEmotesGlobalJson(GetHTTP('emotes/global'));
|
||||
end;
|
||||
|
||||
function TBTTV.GetHTTP(aMethod: string): string;
|
||||
var
|
||||
http: TIdHTTP;
|
||||
ssl: TIdSSLIOHandlerSocketOpenSSL;
|
||||
begin
|
||||
Result := '';
|
||||
http := TIdHTTP.Create(nil);
|
||||
try
|
||||
ssl := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
|
||||
try
|
||||
http.IOHandler := ssl;
|
||||
ssl.SSLOptions.SSLVersions := [sslvTLSv1_2];
|
||||
http.Request.UserAgent :=
|
||||
'Mozilla/5.0 (Windows NT 10.0) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/120.0.0.0 Safari/537.36';
|
||||
Result := http.Get('https://api.betterttv.net/3/cached/' + aMethod);
|
||||
finally
|
||||
ssl.Free;
|
||||
end;
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
toLog(2,'GetCustom',e.Message);
|
||||
Result := '';
|
||||
end;
|
||||
end;
|
||||
http.Free;
|
||||
end;
|
||||
|
||||
procedure TBTTV.toLog(alevel: integer; amethod, amessage: string);
|
||||
begin
|
||||
if Assigned(FOnLog) then
|
||||
FOnLog('uCustomEmoties.TBTTV', amethod, amessage, alevel);
|
||||
end;
|
||||
|
||||
{ T7TV }
|
||||
|
||||
constructor T7TV.Create;
|
||||
begin
|
||||
inherited;
|
||||
list7 := TList<T7TVr>.Create;
|
||||
end;
|
||||
|
||||
destructor T7TV.Destroy;
|
||||
begin
|
||||
FreeAndNil(list7);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure T7TV.AddEmotesGlobalJson(const JsonStr: string);
|
||||
var
|
||||
Root: TJSONObject;
|
||||
EmotesArray: TJSONArray;
|
||||
EmoteObj, DataObj, HostObj: TJSONObject;
|
||||
FilesArray: TJSONArray;
|
||||
i: Integer;
|
||||
Emote: T7TVr;
|
||||
BaseUrl: string;
|
||||
begin
|
||||
Root := TJSONObject.ParseJSONValue(JsonStr) as TJSONObject;
|
||||
if not Assigned(Root) then Exit;
|
||||
|
||||
try
|
||||
EmotesArray := Root.GetValue('emotes') as TJSONArray;
|
||||
if not Assigned(EmotesArray) then Exit;
|
||||
|
||||
for i := 0 to EmotesArray.Count - 1 do
|
||||
begin
|
||||
if not (EmotesArray.Items[i] is TJSONObject) then Continue;
|
||||
|
||||
EmoteObj := EmotesArray.Items[i] as TJSONObject;
|
||||
Emote := Default(T7TVr);
|
||||
|
||||
// Ïîëó÷åíèå áàçîâûõ äàííûõ
|
||||
if Assigned(EmoteObj.GetValue('id')) then
|
||||
Emote.id := EmoteObj.GetValue('id').Value;
|
||||
if Assigned(EmoteObj.GetValue('name')) then
|
||||
Emote.code := EmoteObj.GetValue('name').Value;
|
||||
|
||||
// Ïîëó÷åíèå URL
|
||||
DataObj := EmoteObj.GetValue('data') as TJSONObject;
|
||||
if Assigned(DataObj) then
|
||||
begin
|
||||
HostObj := DataObj.GetValue('host') as TJSONObject;
|
||||
if Assigned(HostObj) then
|
||||
begin
|
||||
if Assigned(HostObj.GetValue('url')) then
|
||||
begin
|
||||
BaseUrl := 'https:' + HostObj.GetValue('url').Value;
|
||||
|
||||
FilesArray := HostObj.GetValue('files') as TJSONArray;
|
||||
if Assigned(FilesArray) and (FilesArray.Count > 0) and
|
||||
(FilesArray.Items[0] is TJSONObject) then
|
||||
begin
|
||||
Emote.url := BaseUrl + '/' +
|
||||
(FilesArray.Items[0] as TJSONObject).GetValue('name').Value;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
if not Emote.id.IsEmpty and not Emote.code.IsEmpty and not Emote.url.IsEmpty then
|
||||
list7.Add(Emote);
|
||||
end;
|
||||
finally
|
||||
Root.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure T7TV.AddEmotesUserJson(const JsonStr: string);
|
||||
var
|
||||
Root, EmoteSet, EmoteObj, DataObj, HostObj: TJSONObject;
|
||||
EmotesArr, FilesArr: TJSONArray;
|
||||
i: Integer;
|
||||
Emote: T7TVr;
|
||||
BaseUrl: string;
|
||||
begin
|
||||
Root := TJSONObject.ParseJSONValue(JsonStr) as TJSONObject;
|
||||
if not Assigned(Root) then Exit;
|
||||
|
||||
try
|
||||
if not Root.TryGetValue<TJSONObject>('emote_set', EmoteSet) then Exit;
|
||||
|
||||
EmotesArr := EmoteSet.GetValue('emotes') as TJSONArray;
|
||||
if not Assigned(EmotesArr) then Exit;
|
||||
|
||||
for i := 0 to EmotesArr.Count - 1 do
|
||||
begin
|
||||
if not (EmotesArr.Items[i] is TJSONObject) then Continue;
|
||||
|
||||
EmoteObj := EmotesArr.Items[i] as TJSONObject;
|
||||
Emote := Default(T7TVr);
|
||||
|
||||
// Ïîëó÷åíèå áàçîâûõ äàííûõ
|
||||
if Assigned(EmoteObj.GetValue('id')) then
|
||||
Emote.id := EmoteObj.GetValue('id').Value;
|
||||
if Assigned(EmoteObj.GetValue('name')) then
|
||||
Emote.code := EmoteObj.GetValue('name').Value;
|
||||
|
||||
// Ïîëó÷åíèå URL
|
||||
DataObj := EmoteObj.GetValue('data') as TJSONObject;
|
||||
if Assigned(DataObj) then
|
||||
begin
|
||||
HostObj := DataObj.GetValue('host') as TJSONObject;
|
||||
if Assigned(HostObj) then
|
||||
begin
|
||||
if Assigned(HostObj.GetValue('url')) then
|
||||
begin
|
||||
BaseUrl := 'https:' + HostObj.GetValue('url').Value;
|
||||
|
||||
FilesArr := HostObj.GetValue('files') as TJSONArray;
|
||||
if Assigned(FilesArr) and (FilesArr.Count > 0) and
|
||||
(FilesArr.Items[0] is TJSONObject) then
|
||||
begin
|
||||
Emote.url := BaseUrl + '/' +
|
||||
(FilesArr.Items[0] as TJSONObject).GetValue('name').Value;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
if not Emote.id.IsEmpty and not Emote.code.IsEmpty and not Emote.url.IsEmpty then
|
||||
list7.Add(Emote);
|
||||
end;
|
||||
finally
|
||||
Root.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function T7TV.GenerateURL(emoteName: string): string;
|
||||
var
|
||||
emote: T7TVr;
|
||||
begin
|
||||
Result := '';
|
||||
for emote in list7 do
|
||||
begin
|
||||
if emote.code = emoteName then
|
||||
begin
|
||||
Result := emote.url;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure T7TV.GetCustom(uid: string);
|
||||
begin
|
||||
if not uid.IsEmpty then
|
||||
AddEmotesUserJson(GetHTTP('users/twitch/' + uid));
|
||||
end;
|
||||
|
||||
procedure T7TV.GetGlobal;
|
||||
begin
|
||||
AddEmotesGlobalJson(GetHTTP('emote-sets/global'));
|
||||
end;
|
||||
|
||||
function T7TV.GetHTTP(aMethod: string): string;
|
||||
var
|
||||
HttpClient: THTTPClient;
|
||||
Response: IHTTPResponse;
|
||||
begin
|
||||
Result := '';
|
||||
HttpClient := THTTPClient.Create;
|
||||
try
|
||||
try
|
||||
HttpClient.UserAgent := 'Mozilla/5.0';
|
||||
Response := HttpClient.Get('https://api.7tv.app/v3/' + aMethod);
|
||||
Result := Response.ContentAsString;
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
toLog(2,'GetHTTP',e.Message);
|
||||
Result := '';
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
HttpClient.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure T7TV.toLog(alevel: integer; amethod, amessage: string);
|
||||
begin
|
||||
if Assigned(FOnLog) then
|
||||
FOnLog('uCustomEmoties.T7TV', amethod, amessage, alevel);
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,132 @@
|
||||
unit uGigaChat;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
uChatAPI, SysUtils, IdHTTP, System.JSON, IdSSLOpenSSL, IdGlobal, classes;
|
||||
|
||||
type
|
||||
TGigaChat = class(TChatAPI)
|
||||
private
|
||||
ClientID: string;
|
||||
AutorizationCode: string;
|
||||
function getAPIKey: string;
|
||||
function GetTokenFromJson(jsonString: string): string;
|
||||
protected
|
||||
function GetOtvetFromJson(jsonString: string; isOllama:boolean = false): string; override;
|
||||
public
|
||||
constructor Create(Sender: TObject; aClientID: string; aAutorizationCode: string; aprefix: string = ''); reintroduce;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TGigaChat }
|
||||
|
||||
constructor TGigaChat.Create(Sender: TObject; aClientID: string; aAutorizationCode: string; aprefix: string = '');
|
||||
var AT:string;
|
||||
begin
|
||||
ClientID := aClientID;
|
||||
AutorizationCode:=aAutorizationCode;
|
||||
AT:= getAPIKey;
|
||||
|
||||
inherited Create(Sender, at, aprefix);
|
||||
|
||||
// Äîïîëíèòåëüíàÿ èíèöèàëèçàöèÿ, åñëè íåîáõîäèìî
|
||||
end;
|
||||
|
||||
function TGigaChat.getAPIKey: string;
|
||||
const
|
||||
url = 'https://ngw.devices.sberbank.ru:9443/api/v2/oauth';
|
||||
var
|
||||
params: TStringStream;
|
||||
http: TIdHTTP;
|
||||
ssl: TIdSSLIOHandlerSocketOpenSSL;
|
||||
begin
|
||||
http := TIdHTTP.Create(nil);
|
||||
ssl := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
|
||||
try
|
||||
http.IOHandler := ssl;
|
||||
ssl.SSLOptions.method := sslvSSLv23;
|
||||
http.Request.UserAgent :=
|
||||
'Mozilla/5.0 (Windows NT 10.0) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/120.0.0.0 Safari/537.36';
|
||||
http.Request.CustomHeaders.Clear;
|
||||
http.Request.CustomHeaders.Add
|
||||
('Content-Type: application/x-www-form-urlencoded');
|
||||
http.Request.CustomHeaders.Add('Accept: application/json');
|
||||
http.Request.CustomHeaders.Add('RqUID: ' + ClientID);
|
||||
http.Request.CustomHeaders.Add('Authorization: Basic ' + AutorizationCode);
|
||||
params := TStringStream.Create(' scope=GIGACHAT_API_PERS');
|
||||
result := GetTokenFromJson(http.Post(url, params));
|
||||
finally
|
||||
params.Free;
|
||||
http.Free;
|
||||
ssl.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function TGigaChat.GetOtvetFromJson(jsonString: string; isOllama:boolean = false): string;
|
||||
var
|
||||
JSON: TJSONObject;
|
||||
choicesArray: TJSONArray;
|
||||
choiceObject, messageObject: TJSONObject;
|
||||
JSONValue: TJSONValue;
|
||||
begin
|
||||
Result := 'Ïðîèçîøëà êàêàÿ-òî îøèáêà, ïîïðîáóéòå ñïðàøèâàòü ïî î÷åðåäè!';
|
||||
JSON := TJSONObject.ParseJSONValue(jsonString) as TJSONObject;
|
||||
try
|
||||
if Assigned(JSON) then
|
||||
begin
|
||||
// Ïðîâåðÿåì íàëè÷èå êëþ÷à "choices"
|
||||
if JSON.TryGetValue('choices', JSONValue) then
|
||||
begin
|
||||
choicesArray := JSONValue as TJSONArray;
|
||||
if Assigned(choicesArray) and (choicesArray.Count > 0) then
|
||||
begin
|
||||
// Ïîëó÷àåì ïåðâûé ýëåìåíò ìàññèâà "choices"
|
||||
choiceObject := choicesArray.Items[0] as TJSONObject;
|
||||
if Assigned(choiceObject) then
|
||||
begin
|
||||
// Ïðîâåðÿåì íàëè÷èå êëþ÷à "message" â ïåðâîì ýëåìåíòå "choices"
|
||||
if choiceObject.TryGetValue('message', JSONValue) then
|
||||
begin
|
||||
messageObject := JSONValue as TJSONObject;
|
||||
if Assigned(messageObject) then
|
||||
begin
|
||||
// Èçâëåêàåì çíà÷åíèå "content" èç îáúåêòà "message"
|
||||
Result := messageObject.GetValue<string>('content');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
JSON.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TGigaChat.GetTokenFromJson(jsonString: string): string;
|
||||
var
|
||||
JSON: TJSONObject;
|
||||
dataArray: TJSONString;
|
||||
begin
|
||||
JSON := TJSONObject.ParseJSONValue(jsonString) as TJSONObject;
|
||||
try
|
||||
if Assigned(JSON) then
|
||||
begin
|
||||
if pos('access_token', jsonString) <> 0 then
|
||||
begin
|
||||
dataArray := JSON.GetValue('access_token') as TJSONString;
|
||||
if Assigned(dataArray) then
|
||||
Result := dataArray.GetValue<string>();
|
||||
end
|
||||
else
|
||||
Result := '';
|
||||
end;
|
||||
finally
|
||||
JSON.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,212 @@
|
||||
unit uKandinskyAPI;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils, System.Classes, System.JSON, System.Net.HttpClient,
|
||||
System.Net.URLClient, System.NetConsts, StrUtils, System.Net.Mime,
|
||||
System.NetEncoding, System.Threading;
|
||||
|
||||
type
|
||||
TGenerationDoneEvent = procedure(Sender: TObject; const FileName: string) of object;
|
||||
TStatusUpdateEvent = procedure(Sender: TObject; const Message: string) of object;
|
||||
TErrorEvent = procedure(Sender: TObject; const ErrorMessage: string) of object;
|
||||
|
||||
TFusionBrainAPI = class(TComponent)
|
||||
private
|
||||
FBaseURL: string;
|
||||
FApiKey: string;
|
||||
FSecretKey: string;
|
||||
FClient: THTTPClient;
|
||||
FOnGenerationDone: TGenerationDoneEvent;
|
||||
FOnStatusUpdate: TStatusUpdateEvent;
|
||||
FOnError: TErrorEvent;
|
||||
|
||||
procedure DoStatusUpdate(const AMessage: string);
|
||||
procedure DoGenerationDone(const AFileName: string);
|
||||
procedure DoError(const AErrorMessage: string);
|
||||
function GetAuthHeaders: TNetHeaders;
|
||||
function GetPipeline: string;
|
||||
function Generate(const Prompt, PipelineId: string): string;
|
||||
function CheckGeneration(const RequestId: string): TArray<string>;
|
||||
procedure SaveBase64Image(const Base64Str, FileName: string);
|
||||
public
|
||||
constructor Create(AOwner: TComponent; aKey:string; aSecret:string);
|
||||
destructor Destroy; override;
|
||||
procedure StartGeneration(const APrompt: string);
|
||||
|
||||
property OnGenerationDone: TGenerationDoneEvent read FOnGenerationDone write FOnGenerationDone;
|
||||
property OnStatusUpdate: TStatusUpdateEvent read FOnStatusUpdate write FOnStatusUpdate;
|
||||
property OnError: TErrorEvent read FOnError write FOnError;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses ugeneral;
|
||||
|
||||
constructor TFusionBrainAPI.Create(AOwner: TComponent; aKey:string; aSecret:string);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FClient := THTTPClient.Create;
|
||||
FBaseURL := 'https://api-key.fusionbrain.ai/';
|
||||
FApiKey :=aKey;
|
||||
// FApiKey := '28C9C30489D635732FB04AA6B85F0671';
|
||||
FSecretKey := aSecret;
|
||||
// FSecretKey := '805CB624C052202A05E3F40C0582045A';
|
||||
end;
|
||||
|
||||
destructor TFusionBrainAPI.Destroy;
|
||||
begin
|
||||
FClient.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TFusionBrainAPI.StartGeneration(const APrompt: string);
|
||||
begin
|
||||
TTask.Run(procedure
|
||||
var
|
||||
PipelineID, UUID, FileName: string;
|
||||
Links: TArray<string>;
|
||||
begin
|
||||
try
|
||||
TThread.Queue(nil, procedure begin DoStatusUpdate('Ïîëó÷åíèå êîíâåéåðà...'); end);
|
||||
PipelineID := GetPipeline;
|
||||
|
||||
TThread.Queue(nil, procedure begin DoStatusUpdate('Ãåíåðàöèÿ èçîáðàæåíèÿ...'); end);
|
||||
UUID := Generate(APrompt, PipelineID);
|
||||
|
||||
TThread.Queue(nil, procedure begin DoStatusUpdate('Ïðîâåðêà ñòàòóñà...'); end);
|
||||
Links := CheckGeneration(UUID);
|
||||
|
||||
FileName := myConst.AppDataPath + 'imgs\kandinsky_' + FormatDateTime('yyyymmddhhnnss', Now) + '.jpg';
|
||||
SaveBase64Image(Links[0], FileName);
|
||||
|
||||
TThread.Queue(nil, procedure begin DoGenerationDone(FileName); end);
|
||||
except
|
||||
on E: Exception do
|
||||
TThread.Queue(nil, procedure begin DoError(E.Message); end);
|
||||
end;
|
||||
end);
|
||||
end;
|
||||
|
||||
function TFusionBrainAPI.GetAuthHeaders: TNetHeaders;
|
||||
begin
|
||||
SetLength(Result, 2);
|
||||
Result[0] := TNetHeader.Create('X-Key', 'Key ' + FApiKey);
|
||||
Result[1] := TNetHeader.Create('X-Secret', 'Secret ' + FSecretKey);
|
||||
end;
|
||||
|
||||
function TFusionBrainAPI.GetPipeline: string;
|
||||
var
|
||||
Response: IHTTPResponse;
|
||||
Json: TJSONArray;
|
||||
begin
|
||||
Response := FClient.Get(FBaseURL + 'key/api/v1/pipelines', nil, GetAuthHeaders);
|
||||
Json := TJSONObject.ParseJSONValue(Response.ContentAsString) as TJSONArray;
|
||||
try
|
||||
Result := Json.Items[0].GetValue<string>('id');
|
||||
finally
|
||||
Json.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFusionBrainAPI.Generate(const Prompt, PipelineId: string): string;
|
||||
var
|
||||
Params, Root: TJSONObject;
|
||||
Multipart: TMultipartFormData;
|
||||
Response: IHTTPResponse;
|
||||
Json: TJSONObject;
|
||||
begin
|
||||
Root := TJSONObject.Create;
|
||||
try
|
||||
Params := TJSONObject.Create;
|
||||
Params.AddPair('query', Prompt);
|
||||
|
||||
Root.AddPair('type', 'GENERATE');
|
||||
Root.AddPair('numImages', TJSONNumber.Create(1));
|
||||
Root.AddPair('width', TJSONNumber.Create(512));
|
||||
Root.AddPair('height', TJSONNumber.Create(512));
|
||||
Root.AddPair('generateParams', Params);
|
||||
|
||||
Multipart := TMultipartFormData.Create;
|
||||
try
|
||||
Multipart.AddField('pipeline_id', PipelineId);
|
||||
Multipart.AddField('params', Root.ToString, 'application/json');
|
||||
|
||||
Response := FClient.Post(FBaseURL + 'key/api/v1/pipeline/run', Multipart, nil, GetAuthHeaders);
|
||||
Json := TJSONObject.ParseJSONValue(Response.ContentAsString) as TJSONObject;
|
||||
try
|
||||
Result := Json.GetValue<string>('uuid');
|
||||
finally
|
||||
Json.Free;
|
||||
end;
|
||||
finally
|
||||
Multipart.Free;
|
||||
end;
|
||||
finally
|
||||
Root.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFusionBrainAPI.CheckGeneration(const RequestId: string): TArray<string>;
|
||||
var
|
||||
Response: IHTTPResponse;
|
||||
Json, ResultObj: TJSONObject;
|
||||
Files: TJSONArray;
|
||||
i: Integer;
|
||||
begin
|
||||
repeat
|
||||
Sleep(5000);
|
||||
Response := FClient.Get(FBaseURL + 'key/api/v1/pipeline/status/' + RequestId, nil, GetAuthHeaders);
|
||||
Json := TJSONObject.ParseJSONValue(Response.ContentAsString) as TJSONObject;
|
||||
try
|
||||
if Json.GetValue<string>('status') = 'DONE' then
|
||||
begin
|
||||
ResultObj := Json.GetValue<TJSONObject>('result');
|
||||
Files := ResultObj.GetValue<TJSONArray>('files');
|
||||
SetLength(Result, Files.Count);
|
||||
for i := 0 to Files.Count - 1 do
|
||||
Result[i] := Files.Items[i].Value;
|
||||
Exit;
|
||||
end;
|
||||
finally
|
||||
Json.Free;
|
||||
end;
|
||||
until False;
|
||||
end;
|
||||
|
||||
procedure TFusionBrainAPI.SaveBase64Image(const Base64Str, FileName: string);
|
||||
var
|
||||
DecodedStream: TMemoryStream;
|
||||
InputStr: TStringStream;
|
||||
begin
|
||||
DecodedStream := TMemoryStream.Create;
|
||||
InputStr := TStringStream.Create(Base64Str);
|
||||
try
|
||||
TNetEncoding.Base64.Decode(InputStr, DecodedStream);
|
||||
DecodedStream.SaveToFile(FileName);
|
||||
finally
|
||||
DecodedStream.Free;
|
||||
InputStr.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFusionBrainAPI.DoStatusUpdate(const AMessage: string);
|
||||
begin
|
||||
if Assigned(FOnStatusUpdate) then
|
||||
FOnStatusUpdate(Self, AMessage);
|
||||
end;
|
||||
|
||||
procedure TFusionBrainAPI.DoGenerationDone(const AFileName: string);
|
||||
begin
|
||||
if Assigned(FOnGenerationDone) then
|
||||
FOnGenerationDone(Self, AFileName);
|
||||
end;
|
||||
|
||||
procedure TFusionBrainAPI.DoError(const AErrorMessage: string);
|
||||
begin
|
||||
if Assigned(FOnError) then
|
||||
FOnError(Self, AErrorMessage);
|
||||
end;
|
||||
|
||||
end.
|
||||
+206
-257
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,660 @@
|
||||
unit uTTWEventSub;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils, System.JSON, System.Types, System.UITypes, System.Classes,
|
||||
WinInet, ComObj, IdException,
|
||||
ipwcore, ipwtypes, ipwwsclient, ipwping, idhttp, IdSSLOpenSSL, uRecords,
|
||||
fmx.Types, System.Net.HttpClient, System.Net.HttpClientComponent;
|
||||
|
||||
type
|
||||
TNotifyEvent = procedure(s: string) of object;
|
||||
TGetCustomRewardEvent = procedure(s: TCustomRewardEvent) of object;
|
||||
TGetFollowEvent = procedure(s: TFollowEvent) of object;
|
||||
TGetGiftEvent = procedure(s: TGiftEvent) of object;
|
||||
TGetSubEvent = procedure(s: TSubEvent) of object;
|
||||
TGetRaidEvent = procedure(s: TRaidEvent) of object;
|
||||
TOnLog = procedure(aModul: string; aMethod: string; aMessage: string; aLevel: integer) of object;
|
||||
|
||||
TOnStatus = procedure(Sender: TObject; const ConnectionEvent: String;
|
||||
StatusCode: Integer; const Description: String) of Object;
|
||||
|
||||
type
|
||||
TTTW_ES = class(TObject)
|
||||
FTimer: ttimer;
|
||||
wss: TipwWSClient;
|
||||
|
||||
private
|
||||
|
||||
BroadcasterID: string;
|
||||
FAccessToken: string;
|
||||
FClientID: string;
|
||||
FOnError: TNotifyEvent;
|
||||
FOnMessage: TNotifyEvent;
|
||||
FOnSubOk: TNotifyEvent;
|
||||
FOnRAW: TNotifyEvent;
|
||||
FOnGetCustomReward: TGetCustomRewardEvent;
|
||||
FOnFollow: TGetFollowEvent;
|
||||
FOnGift: TGetGiftEvent;
|
||||
FOnSub: TGetSubEvent;
|
||||
FOnLog: TOnLog;
|
||||
FOnRaid: TGetRaidEvent;
|
||||
FOnStatus: TOnStatus;
|
||||
SW: TWelcomMessage;
|
||||
procedure HandleTimer(Sender: TObject);
|
||||
procedure ipwWSClient1DataIn(Sender: TObject; DataFormat: Integer;
|
||||
const Text: string; const TextB: TBytes; EOM, EOL: Boolean);
|
||||
procedure ipwWSPing(Sender: TObject; const Payload: String;
|
||||
const PayloadB: TBytes; Response: Boolean);
|
||||
procedure ipwWSClient1ConnectionStatus(Sender: TObject;
|
||||
const ConnectionEvent: String; StatusCode: Integer;
|
||||
const Description: String);
|
||||
procedure ipwWSClientError(Sender: TObject; ErrorCode: Integer;
|
||||
const Description: string);
|
||||
procedure ipwWSClientDisconnected(Sender: TObject; StatusCode: Integer;
|
||||
const Description: String);
|
||||
procedure ipwWSClientHeader(Sender: TObject; const Field: String;
|
||||
const Value: String);
|
||||
procedure ipwWSClientLog(Sender: TObject; LogLevel: Integer;
|
||||
const aMessage, aLog: string);
|
||||
function subscribeTo(const EventType, Version: string; const Condition: string): Boolean;
|
||||
procedure subscribe();
|
||||
// function ParseRewardRedeemed(const AJsonString: string): TRewardRedeemed;
|
||||
procedure EventMSG(const AText: string);
|
||||
function ParseWelcomMessage(const JSONString: string): TWelcomMessage;
|
||||
function ParseCustomRewardEvent(const JSONString: string)
|
||||
: TCustomRewardEvent;
|
||||
function ParseFollowEvent(const JSONString: string): TFollowEvent;
|
||||
function ParseSubEvent(const JSONString: string): TSubEvent;
|
||||
function ParseGiftEvent(const JSONString: string): TGiftEvent;
|
||||
function ParseRaidEvent(const JSONString: string): TRaidEvent;
|
||||
procedure toLog(aLevel: integer; aMethod: string; aMessage: string);
|
||||
function ParseMetadata(const JSONString: string): TMetadata;
|
||||
public
|
||||
|
||||
constructor Create(Sender: TObject;
|
||||
aTokenWS, aClientID, aBroadcasterID: string);
|
||||
destructor Destroy; override;
|
||||
procedure Connect();
|
||||
procedure Disconnect;
|
||||
|
||||
property OnMessage: TNotifyEvent read FOnMessage write FOnMessage;
|
||||
property OnError: TNotifyEvent read FOnError write FOnError;
|
||||
property OnSubOk: TNotifyEvent read FOnSubOk write FOnSubOk;
|
||||
property OnRAW: TNotifyEvent read FOnRAW write FOnRAW;
|
||||
property OnGetCustomReward: TGetCustomRewardEvent read FOnGetCustomReward
|
||||
write FOnGetCustomReward;
|
||||
property OnStatus: TOnStatus read FOnStatus write FOnStatus;
|
||||
property OnFollow: TGetFollowEvent read FOnFollow write FOnFollow;
|
||||
property OnSub: TGetSubEvent read FOnSub write FOnSub;
|
||||
property OnGift: TGetGiftEvent read FOnGift write FOnGift;
|
||||
property OnRaid: TGetRaidEvent read FOnRaid write FOnRaid;
|
||||
property OnLog: TOnLog read FOnLog write FOnLog;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses ugeneral;
|
||||
|
||||
function SafeGetObj(Parent: TJSONObject; const Name: string): TJSONObject;
|
||||
begin
|
||||
Result := Parent.GetValue<TJSONObject>(Name);
|
||||
if not Assigned(Result) then
|
||||
raise Exception.CreateFmt('JSON object "%s" not found', [Name]);
|
||||
end;
|
||||
|
||||
function SafeGetStr(Parent: TJSONObject; const Name: string): string;
|
||||
var
|
||||
V: TJSONValue;
|
||||
begin
|
||||
V := Parent.GetValue(Name);
|
||||
if Assigned(V) then
|
||||
Result := V.Value
|
||||
else
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
function SafeGetInt(Parent: TJSONObject; const Name: string): Integer;
|
||||
var
|
||||
V: TJSONValue;
|
||||
begin
|
||||
V := Parent.GetValue(Name);
|
||||
if Assigned(V) then
|
||||
Result := StrToIntDef(V.Value, 0)
|
||||
else
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function SafeGetBool(Parent: TJSONObject; const Name: string): Boolean;
|
||||
var
|
||||
V: TJSONValue;
|
||||
begin
|
||||
V := Parent.GetValue(Name);
|
||||
if Assigned(V) then
|
||||
Result := SameText(V.Value, 'true')
|
||||
else
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
procedure TTTW_ES.toLog(aLevel: integer; aMethod: string; aMessage: string);
|
||||
begin
|
||||
if Assigned(FOnLog) then
|
||||
FOnLog('uTTWEvenSub', aMethod, aMessage, aLevel);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
procedure TTTW_ES.Connect;
|
||||
begin
|
||||
|
||||
if wss.Connected then
|
||||
wss.Disconnect;
|
||||
|
||||
try
|
||||
wss.ConnectTo('wss://eventsub.wss.twitch.tv/ws?keepalive_timeout_seconds=60');
|
||||
toLog(0, 'Connect', 'Ïîäêëþ÷åíèå ê WebSocket âûïîëíåíî');
|
||||
FTimer.Enabled := True;
|
||||
except
|
||||
on E: Exception do
|
||||
toLog(2, 'Connect', E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TTTW_ES.Create(Sender: TObject;
|
||||
aTokenWS, aClientID, aBroadcasterID: string);
|
||||
begin
|
||||
FAccessToken := aTokenWS;
|
||||
FClientID := aClientID;
|
||||
BroadcasterID := aBroadcasterID;
|
||||
|
||||
wss := TipwWSClient.Create(nil);
|
||||
wss.Timeout := 30;
|
||||
wss.OnPing := ipwWSPing;
|
||||
wss.OnDataIn := ipwWSClient1DataIn;
|
||||
wss.OnConnectionStatus := ipwWSClient1ConnectionStatus;
|
||||
wss.OnError := ipwWSClientError;
|
||||
wss.OnLog := ipwWSClientLog;
|
||||
wss.OnDisconnected := ipwWSClientDisconnected;
|
||||
wss.OnHeader := ipwWSClientHeader;
|
||||
|
||||
FTimer := TTimer.Create(nil);
|
||||
FTimer.Interval := 9000;
|
||||
FTimer.OnTimer := HandleTimer;
|
||||
FTimer.Enabled := False;
|
||||
|
||||
toLog(0, 'Create', 'Èíèöèàëèçàöèÿ EventSub');
|
||||
end;
|
||||
|
||||
destructor TTTW_ES.Destroy;
|
||||
begin
|
||||
toLog(0, 'Destroy', 'Çàâåðøåíèå ðàáîòû EventSub');
|
||||
try
|
||||
if Assigned(FTimer) then
|
||||
FreeAndNil(FTimer);
|
||||
|
||||
if Assigned(wss) then
|
||||
begin
|
||||
if wss.Connected then
|
||||
Disconnect;
|
||||
FreeAndNil(wss);
|
||||
end;
|
||||
finally
|
||||
inherited Destroy;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTTW_ES.Disconnect;
|
||||
begin
|
||||
toLog(1, 'Disconnect', 'Îòêëþ÷åíèå îò WebSocket');
|
||||
try
|
||||
if wss.Connected then
|
||||
wss.Disconnect;
|
||||
except
|
||||
on E: Exception do
|
||||
toLog(2, 'Disconnect', E.ClassName + ': ' + E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTTW_ES.EventMSG(const AText: string);
|
||||
var
|
||||
md: TMetadata;
|
||||
begin
|
||||
if Assigned(FOnRAW) then
|
||||
FOnRAW(AText);
|
||||
|
||||
md := ParseMetadata(AText);
|
||||
toLog(0, 'EventMSG', 'Òèï ñîîáùåíèÿ: ' + md.message_type + ', Òèï ïîäïèñêè: ' + md.subscription_type);
|
||||
|
||||
if md.message_type = 'session_welcome' then
|
||||
begin
|
||||
toLog(0, 'EventMSG', 'Ïîëó÷åí session_welcome');
|
||||
SW := ParseWelcomMessage(AText);
|
||||
if Assigned(FOnMessage) then
|
||||
FOnMessage('Welcome message');
|
||||
subscribe;
|
||||
end
|
||||
else if md.message_type = 'notification' then
|
||||
begin
|
||||
if md.subscription_type = 'channel.channel_points_custom_reward_redemption.add' then
|
||||
if Assigned(FOnGetCustomReward) then
|
||||
FOnGetCustomReward(ParseCustomRewardEvent(AText));
|
||||
|
||||
if md.subscription_type = 'channel.follow' then
|
||||
if Assigned(FOnFollow) then
|
||||
FOnFollow(ParseFollowEvent(AText));
|
||||
|
||||
// Òóò àíàëîãè÷íî ìîæíî âûçûâàòü ParseSubEvent, ParseGiftEvent, ParseRaidEvent
|
||||
end
|
||||
else if md.message_type = 'session_keepalive' then
|
||||
toLog(3, 'EventMSG', 'Ïîëó÷åí keepalive');
|
||||
|
||||
end;
|
||||
|
||||
procedure TTTW_ES.HandleTimer(Sender: TObject);
|
||||
begin
|
||||
if wss.Connected then
|
||||
begin
|
||||
toLog(3, 'HandleTimer', 'Îòïðàâêà ping');
|
||||
wss.Ping;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTTW_ES.ipwWSClient1ConnectionStatus(Sender: TObject;
|
||||
const ConnectionEvent: String; StatusCode: Integer;
|
||||
const Description: String);
|
||||
begin
|
||||
toLog(0, 'ConnectionStatus',
|
||||
Format('%s | %d | %s', [ConnectionEvent, StatusCode, Description]));
|
||||
if Assigned(FOnStatus) then
|
||||
FOnStatus(Sender, ConnectionEvent, StatusCode, Description);
|
||||
end;
|
||||
|
||||
procedure TTTW_ES.ipwWSClient1DataIn(Sender: TObject; DataFormat: Integer;
|
||||
const Text: string; const TextB: TBytes; EOM, EOL: Boolean);
|
||||
begin
|
||||
toLog(3, 'ipwWSClient1DataIn', Text);
|
||||
EventMSG(Text);
|
||||
end;
|
||||
|
||||
procedure TTTW_ES.ipwWSClientDisconnected(Sender: TObject; StatusCode: Integer;
|
||||
const Description: String);
|
||||
begin
|
||||
toLog(1, 'ipwWSClientDisconnected', Description);
|
||||
end;
|
||||
|
||||
procedure TTTW_ES.ipwWSClientError(Sender: TObject; ErrorCode: Integer;
|
||||
const Description: string);
|
||||
begin
|
||||
toLog(2, 'ipwWSClientError', Format('Êîä: %d | %s', [ErrorCode, Description]));
|
||||
if Assigned(FOnError) then
|
||||
FOnError(Description);
|
||||
end;
|
||||
|
||||
procedure TTTW_ES.ipwWSClientHeader(Sender: TObject;
|
||||
const Field, Value: String);
|
||||
begin
|
||||
// toLog(3, 'ipwWSClientHeader',
|
||||
// 'Field: ' + Field + ' | Value: ' + Value);
|
||||
|
||||
end;
|
||||
|
||||
procedure TTTW_ES.ipwWSClientLog(Sender: TObject; LogLevel: Integer;
|
||||
const aMessage, aLog: string);
|
||||
begin
|
||||
// toLog(3, 'ipwWSClientLog', 'Level: ' + IntToStr(LogLevel)
|
||||
// + ' | ' + aMessage + ' | ' + aLog);
|
||||
// form1.log(1, 'ipwWSClientLog', 'Level: ' + inttostr(LogLevel) + ' Message: ' +
|
||||
// aMessage + ' Log: ' + aLog);
|
||||
|
||||
end;
|
||||
|
||||
procedure TTTW_ES.ipwWSPing(Sender: TObject; const Payload: String;
|
||||
const PayloadB: TBytes; Response: Boolean);
|
||||
begin
|
||||
toLog(3, 'ipwWSPing', 'PING ' + Payload);
|
||||
end;
|
||||
|
||||
function TTTW_ES.ParseMetadata(const JSONString: string): TMetadata;
|
||||
var
|
||||
Root, Metadata: TJSONObject;
|
||||
begin
|
||||
Root := TJSONObject.ParseJSONValue(JSONString) as TJSONObject;
|
||||
if not Assigned(Root) then
|
||||
raise Exception.Create('Invalid JSON');
|
||||
try
|
||||
Metadata := SafeGetObj(Root, 'metadata');
|
||||
Result.message_id := SafeGetStr(Metadata, 'message_id');
|
||||
Result.message_type := SafeGetStr(Metadata, 'message_type');
|
||||
Result.message_timestamp := SafeGetStr(Metadata, 'message_timestamp');
|
||||
Result.subscription_type := SafeGetStr(Metadata, 'subscription_type');
|
||||
finally
|
||||
Root.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTTW_ES.ParseWelcomMessage(const JSONString: string): TWelcomMessage;
|
||||
var
|
||||
Root, Payload, Session: TJSONObject;
|
||||
begin
|
||||
Root := TJSONObject.ParseJSONValue(JSONString) as TJSONObject;
|
||||
if not Assigned(Root) then
|
||||
raise Exception.Create('Invalid JSON');
|
||||
try
|
||||
Payload := SafeGetObj(Root, 'payload');
|
||||
Session := SafeGetObj(Payload, 'session');
|
||||
Result.Payload.session.id := SafeGetStr(Session, 'id');
|
||||
Result.Payload.session.status := SafeGetStr(Session, 'status');
|
||||
Result.Payload.session.connected_at := SafeGetStr(Session, 'connected_at');
|
||||
Result.Payload.session.keepalive_timeout_seconds := SafeGetInt(Session, 'keepalive_timeout_seconds');
|
||||
Result.Payload.session.reconnect_url := SafeGetStr(Session, 'reconnect_url');
|
||||
finally
|
||||
Root.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTTW_ES.ParseCustomRewardEvent(const JSONString: string)
|
||||
: TCustomRewardEvent;
|
||||
var
|
||||
Root, Payload, Subscription, mCondition, mTransport, Event, mReward: TJSONObject;
|
||||
begin
|
||||
toLog(3, 'ParseCustomRewardEvent', 'Íà÷àëî ïàðñèíãà íàãðàäû');
|
||||
Root := TJSONObject.ParseJSONValue(JSONString) as TJSONObject;
|
||||
if not Assigned(Root) then
|
||||
raise Exception.Create('Invalid JSON');
|
||||
try
|
||||
Payload := SafeGetObj(Root, 'payload');
|
||||
Subscription := SafeGetObj(Payload, 'subscription');
|
||||
with Result.Subscription do
|
||||
begin
|
||||
id := SafeGetStr(Subscription, 'id');
|
||||
subscription_type := SafeGetStr(Subscription, 'type');
|
||||
version := SafeGetStr(Subscription, 'version');
|
||||
status := SafeGetStr(Subscription, 'status');
|
||||
cost := SafeGetInt(Subscription, 'cost');
|
||||
created_at := SafeGetStr(Subscription, 'created_at');
|
||||
mCondition := SafeGetObj(Subscription, 'condition');
|
||||
condition.broadcaster_user_id := SafeGetStr(mCondition, 'broadcaster_user_id');
|
||||
condition.reward_id := SafeGetStr(mCondition, 'reward_id');
|
||||
mTransport := SafeGetObj(Subscription, 'transport');
|
||||
transport.method := SafeGetStr(mTransport, 'method');
|
||||
end;
|
||||
|
||||
Event := SafeGetObj(Payload, 'event');
|
||||
with Result.Event do
|
||||
begin
|
||||
id := SafeGetStr(Event, 'id');
|
||||
broadcaster_user_id := SafeGetStr(Event, 'broadcaster_user_id');
|
||||
broadcaster_user_login := SafeGetStr(Event, 'broadcaster_user_login');
|
||||
broadcaster_user_name := SafeGetStr(Event, 'broadcaster_user_name');
|
||||
user_id := SafeGetStr(Event, 'user_id');
|
||||
user_login := SafeGetStr(Event, 'user_login');
|
||||
user_name := SafeGetStr(Event, 'user_name');
|
||||
user_input := SafeGetStr(Event, 'user_input');
|
||||
mReward := SafeGetObj(Event, 'reward');
|
||||
revard.id := SafeGetStr(mReward, 'id');
|
||||
revard.title := SafeGetStr(mReward, 'title');
|
||||
revard.cost := SafeGetInt(mReward, 'cost');
|
||||
revard.prompt := SafeGetStr(mReward, 'prompt');
|
||||
end;
|
||||
finally
|
||||
Root.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTTW_ES.ParseFollowEvent(const JSONString: string): TFollowEvent;
|
||||
var
|
||||
Root, Payload, Subscription, mCondition, mTransport, Event: TJSONObject;
|
||||
begin
|
||||
toLog(3, 'ParseFollowEvent', 'Ïàðñèíã ïîäïèñêè');
|
||||
Root := TJSONObject.ParseJSONValue(JSONString) as TJSONObject;
|
||||
if not Assigned(Root) then
|
||||
raise Exception.Create('Invalid JSON');
|
||||
try
|
||||
Payload := SafeGetObj(Root, 'payload');
|
||||
Subscription := SafeGetObj(Payload, 'subscription');
|
||||
with Result.Subscription do
|
||||
begin
|
||||
id := SafeGetStr(Subscription, 'id');
|
||||
subscription_type := SafeGetStr(Subscription, 'type');
|
||||
version := SafeGetStr(Subscription, 'version');
|
||||
status := SafeGetStr(Subscription, 'status');
|
||||
cost := SafeGetInt(Subscription, 'cost');
|
||||
created_at := SafeGetStr(Subscription, 'created_at');
|
||||
mCondition := SafeGetObj(Subscription, 'condition');
|
||||
condition.broadcaster_user_id := SafeGetStr(mCondition, 'broadcaster_user_id');
|
||||
mTransport := SafeGetObj(Subscription, 'transport');
|
||||
transport.method := SafeGetStr(mTransport, 'method');
|
||||
end;
|
||||
|
||||
Event := SafeGetObj(Payload, 'event');
|
||||
with Result.Event do
|
||||
begin
|
||||
broadcaster_user_id := SafeGetStr(Event, 'broadcaster_user_id');
|
||||
broadcaster_user_login := SafeGetStr(Event, 'broadcaster_user_login');
|
||||
broadcaster_user_name := SafeGetStr(Event, 'broadcaster_user_name');
|
||||
user_id := SafeGetStr(Event, 'user_id');
|
||||
user_login := SafeGetStr(Event, 'user_login');
|
||||
user_name := SafeGetStr(Event, 'user_name');
|
||||
followed_at := SafeGetStr(Event, 'followed_at');
|
||||
end;
|
||||
finally
|
||||
Root.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTTW_ES.ParseGiftEvent(const JSONString: string): TGiftEvent;
|
||||
var
|
||||
Root, Payload, Subscription, mCondition, mTransport, Event: TJSONObject;
|
||||
begin
|
||||
toLog(3, 'ParseGiftEvent', 'Ïàðñèíã ïîäàðî÷íîé ïîäïèñêè');
|
||||
Root := TJSONObject.ParseJSONValue(JSONString) as TJSONObject;
|
||||
if not Assigned(Root) then
|
||||
raise Exception.Create('Invalid JSON');
|
||||
try
|
||||
Payload := SafeGetObj(Root, 'payload');
|
||||
Subscription := SafeGetObj(Payload, 'subscription');
|
||||
with Result.Subscription do
|
||||
begin
|
||||
id := SafeGetStr(Subscription, 'id');
|
||||
subscription_type := SafeGetStr(Subscription, 'type');
|
||||
version := SafeGetStr(Subscription, 'version');
|
||||
status := SafeGetStr(Subscription, 'status');
|
||||
cost := SafeGetInt(Subscription, 'cost');
|
||||
created_at := SafeGetStr(Subscription, 'created_at');
|
||||
mCondition := SafeGetObj(Subscription, 'condition');
|
||||
condition.broadcaster_user_id := SafeGetStr(mCondition, 'broadcaster_user_id');
|
||||
mTransport := SafeGetObj(Subscription, 'transport');
|
||||
transport.method := SafeGetStr(mTransport, 'method');
|
||||
end;
|
||||
|
||||
Event := SafeGetObj(Payload, 'event');
|
||||
with Result.Event do
|
||||
begin
|
||||
broadcaster_user_id := SafeGetStr(Event, 'broadcaster_user_id');
|
||||
broadcaster_user_login := SafeGetStr(Event, 'broadcaster_user_login');
|
||||
broadcaster_user_name := SafeGetStr(Event, 'broadcaster_user_name');
|
||||
user_id := SafeGetStr(Event, 'user_id');
|
||||
user_login := SafeGetStr(Event, 'user_login');
|
||||
user_name := SafeGetStr(Event, 'user_name');
|
||||
total := SafeGetInt(Event, 'total');
|
||||
tier := SafeGetStr(Event, 'tier');
|
||||
cumulative_total := SafeGetInt(Event, 'cumulative_total');
|
||||
is_anonymous := SafeGetBool(Event, 'anonymous');
|
||||
end;
|
||||
finally
|
||||
Root.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function TTTW_ES.ParseRaidEvent(const JSONString: string): TRaidEvent;
|
||||
var
|
||||
Root, Payload, Subscription, mCondition, mTransport, Event: TJSONObject;
|
||||
begin
|
||||
toLog(3, 'ParseRaidEvent', 'Ïàðñèíã ðåéäà');
|
||||
Root := TJSONObject.ParseJSONValue(JSONString) as TJSONObject;
|
||||
if not Assigned(Root) then
|
||||
raise Exception.Create('Invalid JSON');
|
||||
try
|
||||
Payload := SafeGetObj(Root, 'payload');
|
||||
Subscription := SafeGetObj(Payload, 'subscription');
|
||||
with Result.Subscription do
|
||||
begin
|
||||
id := SafeGetStr(Subscription, 'id');
|
||||
subscription_type := SafeGetStr(Subscription, 'type');
|
||||
version := SafeGetStr(Subscription, 'version');
|
||||
status := SafeGetStr(Subscription, 'status');
|
||||
cost := SafeGetInt(Subscription, 'cost');
|
||||
created_at := SafeGetStr(Subscription, 'created_at');
|
||||
mCondition := SafeGetObj(Subscription, 'condition');
|
||||
condition.broadcaster_user_id := SafeGetStr(mCondition, 'to_broadcaster_user_id');
|
||||
mTransport := SafeGetObj(Subscription, 'transport');
|
||||
transport.method := SafeGetStr(mTransport, 'method');
|
||||
end;
|
||||
|
||||
Event := SafeGetObj(Payload, 'event');
|
||||
with Result.Event do
|
||||
begin
|
||||
from_broadcaster_user_id := SafeGetStr(Event, 'from_broadcaster_user_id');
|
||||
from_broadcaster_user_login := SafeGetStr(Event, 'from_broadcaster_user_login');
|
||||
from_broadcaster_user_name := SafeGetStr(Event, 'from_broadcaster_user_name');
|
||||
to_broadcaster_user_id := SafeGetStr(Event, 'to_broadcaster_user_id');
|
||||
to_broadcaster_user_login := SafeGetStr(Event, 'to_broadcaster_user_login');
|
||||
to_broadcaster_user_name := SafeGetStr(Event, 'to_broadcaster_user_name');
|
||||
viewers := SafeGetInt(Event, 'viewers');
|
||||
end;
|
||||
finally
|
||||
Root.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTTW_ES.ParseSubEvent(const JSONString: string): TSubEvent;
|
||||
var
|
||||
Root, Payload, Subscription, mCondition, mTransport, Event: TJSONObject;
|
||||
begin
|
||||
toLog(3, 'ParseSubEvent', 'Ïàðñèíã ïîäïèñêè');
|
||||
Root := TJSONObject.ParseJSONValue(JSONString) as TJSONObject;
|
||||
if not Assigned(Root) then
|
||||
raise Exception.Create('Invalid JSON');
|
||||
try
|
||||
Payload := SafeGetObj(Root, 'payload');
|
||||
Subscription := SafeGetObj(Payload, 'subscription');
|
||||
with Result.Subscription do
|
||||
begin
|
||||
id := SafeGetStr(Subscription, 'id');
|
||||
subscription_type := SafeGetStr(Subscription, 'type');
|
||||
version := SafeGetStr(Subscription, 'version');
|
||||
status := SafeGetStr(Subscription, 'status');
|
||||
cost := SafeGetInt(Subscription, 'cost');
|
||||
created_at := SafeGetStr(Subscription, 'created_at');
|
||||
mCondition := SafeGetObj(Subscription, 'condition');
|
||||
condition.broadcaster_user_id := SafeGetStr(mCondition, 'broadcaster_user_id');
|
||||
mTransport := SafeGetObj(Subscription, 'transport');
|
||||
transport.method := SafeGetStr(mTransport, 'method');
|
||||
end;
|
||||
|
||||
Event := SafeGetObj(Payload, 'event');
|
||||
with Result.Event do
|
||||
begin
|
||||
broadcaster_user_id := SafeGetStr(Event, 'broadcaster_user_id');
|
||||
broadcaster_user_login := SafeGetStr(Event, 'broadcaster_user_login');
|
||||
broadcaster_user_name := SafeGetStr(Event, 'broadcaster_user_name');
|
||||
user_id := SafeGetStr(Event, 'user_id');
|
||||
user_login := SafeGetStr(Event, 'user_login');
|
||||
user_name := SafeGetStr(Event, 'user_name');
|
||||
tier := SafeGetStr(Event, 'tier');
|
||||
is_gift := SafeGetBool(Event, 'is_gift');
|
||||
end;
|
||||
finally
|
||||
Root.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTTW_ES.subscribeTo(const EventType, Version: string; const Condition: string): Boolean;
|
||||
var
|
||||
Json: TStringStream;
|
||||
Resp: string;
|
||||
HTTP: TNetHTTPClient;
|
||||
begin
|
||||
Result := False;
|
||||
toLog(0, 'subscribeTo', 'Ïîäïèñêà íà ' + EventType);
|
||||
|
||||
HTTP := TNetHTTPClient.Create(nil);
|
||||
try
|
||||
HTTP.ContentType := 'application/json';
|
||||
HTTP.CustomHeaders['Authorization'] := 'Bearer ' + FAccessToken;
|
||||
HTTP.CustomHeaders['Client-Id'] := FClientID;
|
||||
|
||||
Json := TStringStream.Create(
|
||||
TJSONObject.Create
|
||||
.AddPair('type', EventType)
|
||||
.AddPair('version', Version)
|
||||
.AddPair('condition', TJSONObject.ParseJSONValue(Condition) as TJSONObject)
|
||||
.AddPair('transport',
|
||||
TJSONObject.Create
|
||||
.AddPair('method', 'websocket')
|
||||
.AddPair('session_id', SW.Payload.session.id)
|
||||
).ToJSON, TEncoding.UTF8
|
||||
);
|
||||
try
|
||||
Resp := HTTP.Post('https://api.twitch.tv/helix/eventsub/subscriptions', Json).ContentAsString();
|
||||
toLog(3, 'subscribeTo', 'Îòâåò Twitch: ' + Resp);
|
||||
|
||||
if Pos('"status":"enabled"', Resp) > 0 then
|
||||
begin
|
||||
toLog(0, 'subscribeTo', 'Ïîäïèñêà óñïåøíà');
|
||||
Result := True;
|
||||
end
|
||||
else
|
||||
toLog(1, 'subscribeTo', 'Ïîäïèñêà íå ïîäòâåðæäåíà: ' + Resp);
|
||||
finally
|
||||
Json.Free;
|
||||
end;
|
||||
except
|
||||
on E: Exception do
|
||||
toLog(2, 'subscribeTo', 'Îøèáêà ïîäïèñêè: ' + E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTTW_ES.subscribe;
|
||||
begin
|
||||
// channel.channel_points_custom_reward.add (1)
|
||||
// channel.follow (2) moderator:read:followers
|
||||
// channel.subscribe (1) channel:read:subscriptions
|
||||
// channel.subscription.gift (1) channel:read:subscriptions
|
||||
// channel.raid (1)
|
||||
if subscribeTo('channel.channel_points_custom_reward_redemption.add', '1',
|
||||
'{"broadcaster_user_id":"' + BroadcasterID + '"}') then
|
||||
toLog(0, 'subscribe',
|
||||
'channel.channel_points_custom_reward_redemption.add OK')
|
||||
else
|
||||
toLog(2, 'subscribe',
|
||||
'channel.channel_points_custom_reward_redemption.add');
|
||||
|
||||
if subscribeTo('channel.raid', '1', '{"to_broadcaster_user_id":"' +
|
||||
BroadcasterID + '"}') then
|
||||
toLog(0, 'subscribe', 'channel.raid OK')
|
||||
else
|
||||
toLog(2, 'subscribe', 'channel.raid');
|
||||
|
||||
if subscribeTo('channel.follow', '2', '{"broadcaster_user_id":"' +
|
||||
BroadcasterID + '","moderator_user_id":"' + BroadcasterID + '"}') then
|
||||
toLog(0, 'subscribe', 'channel.follow OK')
|
||||
else
|
||||
toLog(2, 'subscribe', 'channel.follow');
|
||||
|
||||
if subscribeTo('channel.subscribe', '1', '{"broadcaster_user_id":"' +
|
||||
BroadcasterID + '"}') then
|
||||
toLog(0, 'subscribe', 'channel.subscribe OK')
|
||||
else
|
||||
toLog(2, 'subscribe', 'channel.subscribe');
|
||||
|
||||
if subscribeTo('channel.subscription.gift', '1', '{"broadcaster_user_id":"' +
|
||||
BroadcasterID + '"}') then
|
||||
toLog(0, 'subscribe', 'channel.subscription.gift OK')
|
||||
else
|
||||
toLog(2, 'subscribe', 'channel.subscription.gift');
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,364 @@
|
||||
unit uTTWIRC;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.Classes, System.SysUtils, IdIRC, IdSSLOpenSSL, IdContext,
|
||||
FMX.Forms, IdGlobal, IdComponent, System.StrUtils, uRecords;
|
||||
|
||||
|
||||
|
||||
type
|
||||
TNotifyEvent = procedure(s: string) of object;
|
||||
TJoinEvent = procedure(aNick: string) of object;
|
||||
TMyStatusEvent = procedure(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string) of object;
|
||||
tOnMessageRecord = procedure(aRecord: TTwitchChatMessage) of object;
|
||||
TOnLog = procedure(aModul: string; aMethod: string; aMessage: string; aLevel: integer) of object;
|
||||
|
||||
TTTW = class
|
||||
private
|
||||
ws: TIdIRC;
|
||||
ssl: TIdSSLIOHandlerSocketOpenSSL;
|
||||
FOnLog: TOnLog;
|
||||
FOnStatus: TMyStatusEvent;
|
||||
FOnDisConnect: TNotifyEvent;
|
||||
FOnJoin: TJoinEvent;
|
||||
FOnMessage: TNotifyEvent;
|
||||
FOnMessageRecord: tOnMessageRecord;
|
||||
channel_name: string;
|
||||
room_id: string;
|
||||
channel_id: string;
|
||||
procedure wsConnected(Sender: TObject);
|
||||
procedure wsStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);
|
||||
procedure wsDisconnected(Sender: TObject);
|
||||
procedure wsDataIn(ASender: TIdContext; AIn: boolean; const AMessage: string);
|
||||
procedure Join(ASender: TIdContext; const ANickname, AHost, AChannel: string);
|
||||
procedure se(ASender: TIdContext; AErrorCode: Integer; const AErrorMessage: String);
|
||||
procedure RAW(text: string);
|
||||
procedure toLog(aLevel: integer; aMethod: string; aMessage: string);
|
||||
procedure toParse(t: string);
|
||||
public
|
||||
constructor Create(Sender: TObject);
|
||||
destructor Destroy; override;
|
||||
procedure Init(a_oauth, a_channel, a_username: string);
|
||||
procedure Connect;
|
||||
procedure Disconnect;
|
||||
procedure sendMessage(text: string);
|
||||
function ParseTwitchChatMessage(const AMessage: string): TTwitchChatMessage;
|
||||
function GetRoom_ID: string;
|
||||
function Pars(T_, text, _T: string): string;
|
||||
property OnLog: TOnLog read FOnLog write FOnLog;
|
||||
property OnStatus: TMyStatusEvent read FOnStatus write FOnStatus;
|
||||
property OnDisConnect: TNotifyEvent read FOnDisConnect write FOnDisConnect;
|
||||
property OnJoin: TJoinEvent read FOnJoin write FOnJoin;
|
||||
property OnMessage: TNotifyEvent read FOnMessage write FOnMessage;
|
||||
property OnMessageRecord: tOnMessageRecord read FOnMessageRecord write FOnMessageRecord;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses uGeneral; // ��� ������� � ��������� Log
|
||||
|
||||
const
|
||||
LOG_INFO = 0;
|
||||
LOG_WARNING = 1;
|
||||
LOG_ERROR = 2;
|
||||
LOG_DEBUG = 3;
|
||||
|
||||
procedure TTTW.toLog(aLevel: integer; aMethod: string; aMessage: string);
|
||||
begin
|
||||
if aLevel < 0 then
|
||||
aLevel := LOG_INFO
|
||||
else if aLevel > LOG_DEBUG then
|
||||
aLevel := LOG_DEBUG;
|
||||
|
||||
if Assigned(FOnLog) then
|
||||
FOnLog('uTTWIRC', aMethod, aMessage, aLevel);
|
||||
end;
|
||||
|
||||
constructor TTTW.Create(Sender: TObject);
|
||||
begin
|
||||
try
|
||||
ws := TIdIRC.Create;
|
||||
ssl := TIdSSLIOHandlerSocketOpenSSL.Create;
|
||||
ws.IOHandler := ssl;
|
||||
ws.OnConnected := wsConnected;
|
||||
ws.OnDisconnected := wsDisconnected;
|
||||
ws.OnStatus := wsStatus;
|
||||
ws.OnRaw := wsDataIn;
|
||||
ws.OnJoin := Join;
|
||||
ws.OnServerError := se;
|
||||
except
|
||||
on E: Exception do
|
||||
toLog(LOG_ERROR, 'Create', E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TTTW.Destroy;
|
||||
begin
|
||||
try
|
||||
if Assigned(ws) then
|
||||
begin
|
||||
ws.OnConnected := nil;
|
||||
ws.OnDisconnected := nil;
|
||||
ws.OnStatus := nil;
|
||||
ws.OnRaw := nil;
|
||||
ws.OnJoin := nil;
|
||||
ws.OnServerError := nil;
|
||||
ws.IOHandler := nil;
|
||||
ws.Free;
|
||||
end;
|
||||
if Assigned(ssl) then
|
||||
ssl.Free;
|
||||
except
|
||||
on E: Exception do
|
||||
;
|
||||
end;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TTTW.ParseTwitchChatMessage(const AMessage: string): TTwitchChatMessage;
|
||||
var
|
||||
s: string;
|
||||
LSpacePos: Integer;
|
||||
LParamStr, LRestStr: string;
|
||||
LParams: TArray<string>;
|
||||
I: Integer;
|
||||
LKeyValue: TArray<string>;
|
||||
LUsernamePart: string;
|
||||
LMessagePos: Integer;
|
||||
begin
|
||||
Result := Default(TTwitchChatMessage);
|
||||
s := AMessage;
|
||||
|
||||
// �������� ����������� ��������
|
||||
LSpacePos := Pos(' ', s);
|
||||
if LSpacePos = 0 then
|
||||
Exit;
|
||||
|
||||
LParamStr := Copy(s, 1, LSpacePos - 1);
|
||||
LRestStr := Copy(s, LSpacePos + 1, Length(s) - LSpacePos);
|
||||
|
||||
// ������������ ���������
|
||||
LParams := LParamStr.Split([';']);
|
||||
for I := 0 to High(LParams) do
|
||||
begin
|
||||
LKeyValue := LParams[I].Split(['=']);
|
||||
if Length(LKeyValue) = 2 then
|
||||
begin
|
||||
case AnsiIndexStr(LKeyValue[0], [
|
||||
'@badge-info', 'badges', 'client-nonce', 'color', 'display-name', 'emotes',
|
||||
'first-msg', 'id', 'mod', 'returning-chatter', 'room-id', 'subscriber',
|
||||
'tmi-sent-ts', 'turbo', 'user-id', 'user-type', 'vip'
|
||||
]) of
|
||||
0: Result.BadgeInfo := LKeyValue[1];
|
||||
1: Result.Badges := LKeyValue[1];
|
||||
2: Result.ClientNonce := LKeyValue[1];
|
||||
3: Result.Color := LKeyValue[1];
|
||||
4: Result.DisplayName := LKeyValue[1];
|
||||
5: Result.Emotes := LKeyValue[1];
|
||||
6: Result.FirstMsg := StrToIntDef(LKeyValue[1], 0);
|
||||
7: Result.Id := LKeyValue[1];
|
||||
8: Result.Moder := StrToIntDef(LKeyValue[1], 0);
|
||||
9: Result.ReturningChatter := StrToIntDef(LKeyValue[1], 0);
|
||||
10: Result.RoomId := LKeyValue[1];
|
||||
11: Result.Subscriber := StrToIntDef(LKeyValue[1], 0);
|
||||
12: Result.TmiSentTs := StrToInt64Def(LKeyValue[1], 0);
|
||||
13: Result.Turbo := StrToIntDef(LKeyValue[1], 0);
|
||||
14: Result.UserId := LKeyValue[1];
|
||||
15: Result.UserType := LKeyValue[1];
|
||||
16: Result.Vip := StrToIntDef(LKeyValue[1], 0);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
if LRestStr.StartsWith(':') then
|
||||
begin
|
||||
LUsernamePart := Copy(LRestStr, 1, Pos('!', LRestStr) - 1);
|
||||
Result.Username := LUsernamePart.Substring(1);
|
||||
end
|
||||
else
|
||||
Result.Username := '';
|
||||
|
||||
// ��������� �����
|
||||
LMessagePos := Pos('PRIVMSG #', LRestStr);
|
||||
if LMessagePos > 0 then
|
||||
begin
|
||||
Inc(LMessagePos, Length('PRIVMSG #'));
|
||||
Result.Channel := Copy(LRestStr, LMessagePos, PosEx(' ', LRestStr, LMessagePos) - LMessagePos);
|
||||
end
|
||||
else
|
||||
Result.Channel := '';
|
||||
|
||||
// �������� �����
|
||||
LMessagePos := Pos(' :', LRestStr);
|
||||
if LMessagePos > 0 then
|
||||
Result.Message := Copy(LRestStr, LMessagePos + 2, Length(LRestStr) - LMessagePos - 1)
|
||||
else
|
||||
Result.Message := '';
|
||||
end;
|
||||
|
||||
procedure TTTW.Init(a_oauth, a_channel, a_username : string);
|
||||
begin
|
||||
try
|
||||
channel_name := a_channel;
|
||||
ws.Host := 'irc.chat.twitch.tv';
|
||||
ws.Port := 6697;
|
||||
ssl.SSLOptions.SSLVersions := [sslvSSLv23];
|
||||
ws.Password := 'oauth:' + a_oauth;
|
||||
ws.Nickname := a_username;
|
||||
channel_name := a_channel;
|
||||
// Token := a_oauth;
|
||||
except
|
||||
on E: Exception do
|
||||
toLog(LOG_ERROR, 'Init', E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTTW.Connect;
|
||||
begin
|
||||
try
|
||||
if not ws.Connected then
|
||||
begin
|
||||
ws.Connect;
|
||||
ws.Raw('CAP REQ :twitch.tv/membership twitch.tv/tags twitch.tv/commands');
|
||||
ws.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
|
||||
end;
|
||||
except
|
||||
on E: Exception do
|
||||
toLog(LOG_ERROR, 'Connect', E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTTW.Disconnect;
|
||||
begin
|
||||
try
|
||||
if ws.Connected then
|
||||
begin
|
||||
ws.Disconnect;
|
||||
end;
|
||||
except
|
||||
on E: Exception do
|
||||
toLog(LOG_ERROR, 'Disconnect', E.ClassName + ': ' + E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTTW.GetRoom_ID: string;
|
||||
begin
|
||||
result:=room_id;
|
||||
end;
|
||||
|
||||
procedure TTTW.sendMessage(text: string);
|
||||
begin
|
||||
try
|
||||
ws.Say('#' + channel_name, text);
|
||||
except
|
||||
on E: Exception do
|
||||
toLog(LOG_ERROR, 'sendMessage', E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTTW.RAW(text: string);
|
||||
begin
|
||||
try
|
||||
ws.Raw(text);
|
||||
except
|
||||
on E: Exception do
|
||||
toLog(LOG_ERROR, 'RAW', E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTTW.wsConnected(Sender: TObject);
|
||||
begin
|
||||
if Assigned(FOnStatus) then
|
||||
FOnStatus(ws, TIdStatus.hsConnected, 'Connected to Twitch IRC');
|
||||
toLog(LOG_INFO, 'wsConnected', 'Connected to Twitch IRC');
|
||||
end;
|
||||
|
||||
procedure TTTW.wsStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);
|
||||
begin
|
||||
if Assigned(FOnStatus) then
|
||||
FOnStatus(ASender, AStatus, AStatusText);
|
||||
end;
|
||||
|
||||
procedure TTTW.wsDisconnected(Sender: TObject);
|
||||
begin
|
||||
if Assigned(FOnDisConnect) then
|
||||
FOnDisConnect('Disconnected');
|
||||
toLog(LOG_WARNING, 'wsDisconnected', 'Disconnected from Twitch IRC');
|
||||
end;
|
||||
|
||||
procedure TTTW.wsDataIn(ASender: TIdContext; AIn: boolean; const AMessage: string);
|
||||
begin
|
||||
|
||||
toLog(LOG_DEBUG, 'wsDataIn', AMessage);
|
||||
|
||||
if Pos('CAP * ACK', AMessage) <> 0 then
|
||||
begin
|
||||
Sleep(200);
|
||||
ws.Raw('JOIN #' + channel_name);
|
||||
end;
|
||||
|
||||
toParse(AMessage);
|
||||
end;
|
||||
|
||||
procedure TTTW.toParse(t: string);
|
||||
var
|
||||
LTwitchChatMessage:tTwitchChatMessage;
|
||||
begin
|
||||
try
|
||||
if (Pos('room-id=', t) <> 0) and (Pos('ROOMSTATE', t) <> 0) then
|
||||
room_id := Pars('room-id=', t, ';');
|
||||
|
||||
if Pos('NOTICE * :Login authentication failed', t) <> 0 then
|
||||
begin
|
||||
|
||||
toLog(2, 'toParse', 'Токен бота просрочен');
|
||||
Disconnect;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if Pos('PRIVMSG', t) <> 0 then
|
||||
begin
|
||||
LTwitchChatMessage := ParseTwitchChatMessage(t);
|
||||
if Assigned(FOnMessageRecord) then
|
||||
FOnMessageRecord(LTwitchChatMessage);
|
||||
end;
|
||||
except
|
||||
on E: Exception do
|
||||
toLog(2, 'toParse', E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTTW.Join(ASender: TIdContext; const ANickname, AHost, AChannel: string);
|
||||
begin
|
||||
if Assigned(FOnJoin) then
|
||||
FOnJoin(ANickname);
|
||||
toLog(LOG_INFO, 'Join', ANickname + ' joined ' + AChannel);
|
||||
end;
|
||||
|
||||
procedure TTTW.se(ASender: TIdContext; AErrorCode: Integer; const AErrorMessage: String);
|
||||
begin
|
||||
toLog(LOG_ERROR, 'se', AErrorMessage);
|
||||
end;
|
||||
|
||||
function TTTW.Pars(T_, text, _T: string): string;
|
||||
var
|
||||
a, b: Integer;
|
||||
begin
|
||||
Result := '';
|
||||
if (T_ = '') or (text = '') or (_T = '') then
|
||||
Exit;
|
||||
a := Pos(T_, text);
|
||||
if a = 0 then
|
||||
Exit
|
||||
else
|
||||
a := a + Length(T_);
|
||||
text := Copy(text, a, Length(text) - a + 1);
|
||||
b := Pos(_T, text);
|
||||
if b > 0 then
|
||||
Result := Copy(text, 1, b - 1);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@@ -0,0 +1,227 @@
|
||||
unit uWebServerKandinsky;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils, System.Types, System.UITypes, System.Classes,
|
||||
System.Variants, System.NetEncoding,IdContext, IdCustomHTTPServer, IdHTTPServer, IdGlobal,
|
||||
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Edit,
|
||||
FMX.Controls.Presentation, FMX.StdCtrls, uKandinskyAPI, FMX.Memo.Types, json,
|
||||
FMX.ScrollBox, FMX.Memo, System.IOUtils, System.SyncObjs,System.DateUtils;
|
||||
|
||||
type
|
||||
TKandinsky_Web = class(TObject)
|
||||
|
||||
IdHTTPServer1: TIdHTTPServer;
|
||||
procedure IdHTTPServer1CommandGet(AContext: TIdContext;
|
||||
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
|
||||
private
|
||||
FCriticalSection: TCriticalSection;
|
||||
FCurrentImage: string;
|
||||
FImageTime: TDateTime;
|
||||
FCurrentText: string;
|
||||
ka:TFusionBrainAPI;
|
||||
function GenerateHTML: string;
|
||||
function GenerateJSON: string;
|
||||
procedure CleanupOldMessages;
|
||||
procedure GenerationDone(Sender: TObject; const FileName: string);
|
||||
procedure GenerationError(Sender: TObject; const ErrorMessage: string);
|
||||
procedure GenerationUpdate(Sender: TObject; const Message: string);
|
||||
public
|
||||
constructor Create(aKey:string; aSecret:string);
|
||||
destructor Destroy;
|
||||
procedure generate(prompt:string; aNick:string);
|
||||
procedure ActiveServer(aEn: boolean);
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TKandinsky_Web }
|
||||
|
||||
procedure TKandinsky_Web.ActiveServer(aEn: boolean);
|
||||
begin
|
||||
IdHTTPServer1.Active :=aEn;
|
||||
end;
|
||||
|
||||
procedure TKandinsky_Web.CleanupOldMessages;
|
||||
begin
|
||||
if FileExists(FCurrentImage) then
|
||||
begin
|
||||
DeleteFile(FCurrentImage);
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TKandinsky_Web.Create(aKey:string; aSecret:string);
|
||||
begin
|
||||
IdHTTPServer1 := TIdHTTPServer.Create;
|
||||
IdHTTPServer1.DefaultPort := 8087;
|
||||
IdHTTPServer1.OnCommandGet := IdHTTPServer1CommandGet;
|
||||
ka:=TFusionBrainAPI.Create(nil,aKey, aSecret);
|
||||
ka.OnGenerationDone := GenerationDone;
|
||||
ka.OnStatusUpdate:=GenerationUpdate;
|
||||
ka.OnError:=GenerationError;
|
||||
FCriticalSection:=TCriticalSection.Create;
|
||||
//flog.toLog(0,'uWebServerKandinsky','Create','Âåá ñåðâåð çàïóùåí');
|
||||
end;
|
||||
|
||||
destructor TKandinsky_Web.Destroy;
|
||||
begin
|
||||
IdHTTPServer1.Active := False;
|
||||
FCriticalSection.Free;
|
||||
CleanupOldMessages;
|
||||
end;
|
||||
|
||||
procedure TKandinsky_Web.generate(prompt: string; aNick:string);
|
||||
begin
|
||||
//flog.toLog(0,'uWebServerKandinsky','generate','Íîâûé çàïðîñ íà ãåíåðàöèþ');
|
||||
FCriticalSection.Enter;
|
||||
try
|
||||
FCurrentText := aNick;
|
||||
finally
|
||||
FCriticalSection.Leave;
|
||||
end;
|
||||
ka.StartGeneration(prompt);
|
||||
//flog.toLog(0,'uWebServerKandinsky','generate','Çàïðîñ íà ãåíåðàöèþ îòïðàâëåí');
|
||||
end;
|
||||
|
||||
function TKandinsky_Web.GenerateHTML: string;
|
||||
begin
|
||||
Result := '<!DOCTYPE html>' +
|
||||
'<html><head>' +
|
||||
'<meta http-equiv="Cache-Control" content="no-cache, no-store, must-revalidate">' +
|
||||
'<meta http-equiv="Pragma" content="no-cache">' +
|
||||
'<meta http-equiv="Expires" content="0">' +
|
||||
'<style>' +
|
||||
'body { background: #00ff00; }' +
|
||||
'#current-image { max-width: 100%; max-height: 90vh; margin: 5vh auto; display: block; }' +
|
||||
'#image-text { text-align: center; font-size: 24px; margin: 10px; color: black; }' +
|
||||
'.hidden { display: none !important; }' + // Äîáàâèëè êëàññ hidden
|
||||
'</style></head>' +
|
||||
'<body>' +
|
||||
'<div id="image-container">' +
|
||||
' <img id="current-image" class="hidden" src="" />' + // Íà÷àëüíîå ñîñòîÿíèå hidden
|
||||
' <div id="image-text" class="hidden"></div>' + // Íà÷àëüíîå ñîñòîÿíèå hidden
|
||||
'</div>' +
|
||||
'<script>' +
|
||||
'function updateImage() {' +
|
||||
' fetch("/image-data")' +
|
||||
' .then(response => response.json())' +
|
||||
' .then(data => {' +
|
||||
' const img = document.getElementById("current-image");' +
|
||||
' const textDiv = document.getElementById("image-text");' +
|
||||
' ' +
|
||||
' if (data.imageUrl && data.text) {' +
|
||||
' if (img.src !== data.imageUrl) {' +
|
||||
' img.src = data.imageUrl;' +
|
||||
' textDiv.textContent = data.text;' +
|
||||
' }' +
|
||||
' img.classList.remove("hidden");' +
|
||||
' textDiv.classList.remove("hidden");' +
|
||||
' } else {' + // Îáðàáîòêà ñëó÷àÿ êîãäà íåò èçîáðàæåíèÿ
|
||||
' img.classList.add("hidden");' +
|
||||
' textDiv.classList.add("hidden");' +
|
||||
' img.src = "";' + // Î÷èùàåì src
|
||||
' textDiv.textContent = "";' +
|
||||
' }' +
|
||||
' })' +
|
||||
' .catch(error => console.error("Error:", error));' +
|
||||
'}' +
|
||||
'setInterval(updateImage, 1000);' +
|
||||
'updateImage();' +
|
||||
'</script>' +
|
||||
'</body></html>';
|
||||
end;
|
||||
|
||||
function TKandinsky_Web.GenerateJSON: string;
|
||||
var
|
||||
JSONObject: TJSONObject;
|
||||
begin
|
||||
JSONObject := TJSONObject.Create;
|
||||
try
|
||||
FCriticalSection.Enter;
|
||||
try
|
||||
// Èçìåíèëè óñëîâèå ïðîâåðêè âðåìåíè
|
||||
if FileExists(FCurrentImage) and (SecondsBetween(Now, FImageTime) <= 5) then
|
||||
begin
|
||||
JSONObject.AddPair('imageUrl', '/image?' + IntToStr(DateTimeToUnix(FImageTime))); // Èñïîëüçóåì âðåìÿ ãåíåðàöèè
|
||||
JSONObject.AddPair('text', FCurrentText)
|
||||
end
|
||||
else
|
||||
begin
|
||||
JSONObject.AddPair('imageUrl', '');
|
||||
JSONObject.AddPair('text', '');
|
||||
end;
|
||||
finally
|
||||
FCriticalSection.Leave;
|
||||
end;
|
||||
Result := JSONObject.ToString;
|
||||
finally
|
||||
JSONObject.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TKandinsky_Web.GenerationDone(Sender: TObject;
|
||||
const FileName: string);
|
||||
begin
|
||||
TThread.Queue(nil, procedure
|
||||
begin
|
||||
FCriticalSection.Enter;
|
||||
try
|
||||
CleanupOldMessages;
|
||||
FCurrentImage := FileName;
|
||||
FImageTime := Now;
|
||||
//flog.toLog(0,'uWebServerKandinsky','GenerationDone','Ôàéë êàðòèíêè ñîçäàí');
|
||||
finally
|
||||
FCriticalSection.Leave;
|
||||
end;
|
||||
end);
|
||||
end;
|
||||
|
||||
procedure TKandinsky_Web.GenerationError(Sender: TObject;
|
||||
const ErrorMessage: string);
|
||||
begin
|
||||
//flog.toLog(2,'uWebServerKandinsky','GenerationError',ErrorMessage);
|
||||
end;
|
||||
|
||||
procedure TKandinsky_Web.GenerationUpdate(Sender: TObject;
|
||||
const Message: string);
|
||||
begin
|
||||
// flog.toLog(0,'uWebServerKandinsky','GenerationUpdate',Message);
|
||||
end;
|
||||
|
||||
procedure TKandinsky_Web.IdHTTPServer1CommandGet(AContext: TIdContext;
|
||||
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
|
||||
var
|
||||
FilePath: string;
|
||||
begin
|
||||
FCriticalSection.Enter;
|
||||
try
|
||||
if ARequestInfo.Document = '/' then
|
||||
begin
|
||||
AResponseInfo.ContentType := 'text/html';
|
||||
AResponseInfo.ContentText := GenerateHTML;
|
||||
end
|
||||
else if ARequestInfo.Document = '/image' then
|
||||
begin
|
||||
if FileExists(FCurrentImage) and (SecondsBetween(Now, FImageTime) <= 5) then
|
||||
begin
|
||||
AResponseInfo.ContentType := 'image/jpeg';
|
||||
AResponseInfo.ContentStream := TFileStream.Create(FCurrentImage, fmOpenRead);
|
||||
end
|
||||
else
|
||||
AResponseInfo.ResponseNo := 404;
|
||||
end
|
||||
else if ARequestInfo.Document = '/image-data' then
|
||||
begin
|
||||
AResponseInfo.ContentType := 'application/json';
|
||||
AResponseInfo.ContentText := GenerateJSON;
|
||||
end
|
||||
else
|
||||
AResponseInfo.ResponseNo := 404;
|
||||
finally
|
||||
FCriticalSection.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,14 @@
|
||||
program SilentPlayer;
|
||||
|
||||
uses
|
||||
System.StartUpCopy,
|
||||
FMX.Forms,
|
||||
uSilentPlayer in 'uSilentPlayer.pas' {fPublicPlayer};
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TfPublicPlayer, fPublicPlayer);
|
||||
Application.Run;
|
||||
end.
|
||||
+1326
File diff suppressed because it is too large
Load Diff
+51
-27
@@ -1,33 +1,50 @@
|
||||
program TTW_Bot_app;
|
||||
|
||||
uses
|
||||
System.StartUpCopy, SysUtils,
|
||||
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} ,
|
||||
uRecords in 'uRecords.pas',
|
||||
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} ,
|
||||
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} ,
|
||||
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';
|
||||
Web.WebReq,
|
||||
IdHTTPWebBrokerBridge,
|
||||
fAI in 'frames\fAI.pas' {frAI: TFrame},
|
||||
fAutoActions in 'frames\fAutoActions.pas' {frAutoActions: TFrame},
|
||||
fColorSettings in 'frames\fColorSettings.pas' {frColorSettings: TFrame},
|
||||
fCommands in 'frames\fCommands.pas' {frCommands: TFrame},
|
||||
fContruct in 'frames\fContruct.pas' {frContruct: TFrame},
|
||||
fFontSettings in 'frames\fFontSettings.pas' {frFontSettings: TFrame},
|
||||
fGroupsRequest in 'frames\fGroupsRequest.pas' {frGroupsRequest: TFrame},
|
||||
fLog in 'frames\fLog.pas' {frLog: TFrame},
|
||||
fNotify in 'frames\fNotify.pas' {frNotify: TFrame},
|
||||
fOBS in 'frames\fOBS.pas' {frOBS: TFrame},
|
||||
fSettings in 'frames\fSettings.pas' {frSettings: TFrame},
|
||||
fSimpleGrid in 'frames\fSimpleGrid.pas' {frSimpleGrid: TFrame},
|
||||
fTTS in 'frames\fTTS.pas' {frTTS: TFrame},
|
||||
uCreateChat in 'forms\uCreateChat.pas' {fCreateChat},
|
||||
uCreateNotify in 'forms\uCreateNotify.pas' {fCreateNotify},
|
||||
uGeneral in 'forms\uGeneral.pas' {TTW_Bot},
|
||||
uQ in 'forms\uQ.pas' {frmQ},
|
||||
uShowText in 'forms\uShowText.pas' {fShowText},
|
||||
uAPIDA in 'Services\uAPIDA.pas',
|
||||
uChatAPI in 'Services\uChatAPI.pas',
|
||||
uCustomEmoties in 'Services\uCustomEmoties.pas',
|
||||
uGigaChat in 'Services\uGigaChat.pas',
|
||||
uKandinskyAPI in 'Services\uKandinskyAPI.pas',
|
||||
uTTWAPI in 'Services\uTTWAPI.pas',
|
||||
uTTWEventSub in 'Services\uTTWEventSub.pas',
|
||||
uTTWIRC in 'Services\uTTWIRC.pas',
|
||||
uTWAuth in 'Services\uTWAuth.pas',
|
||||
uWebServerKandinsky in 'Services\uWebServerKandinsky.pas',
|
||||
uWSDA in 'Services\uWSDA.pas',
|
||||
uDataBase in 'utils\uDataBase.pas',
|
||||
uMyTimer in 'utils\uMyTimer.pas',
|
||||
uOBS_Doc_Player in 'utils\uOBS_Doc_Player.pas' {OBS_Doc_Player: TWebModule},
|
||||
uRecords in 'utils\uRecords.pas',
|
||||
uRegExpr in 'utils\uRegExpr.pas',
|
||||
uSoundManager in 'utils\uSoundManager.pas',
|
||||
uTTS in 'utils\uTTS.pas',
|
||||
fPlayerWeb in 'frames\fPlayerWeb.pas' {frPlayerWeb: TFrame},
|
||||
uPlayerThread in 'utils\uPlayerThread.pas',
|
||||
uWebServerChat in 'utils\uWebServerChat.pas';
|
||||
|
||||
{$R *.res}
|
||||
|
||||
@@ -36,9 +53,16 @@ begin
|
||||
{$IFDEF DEBUG}
|
||||
ReportMemoryLeaksOnShutdown := True;
|
||||
{$ENDIF}
|
||||
Application.Initialize;
|
||||
if WebRequestHandler <> nil then
|
||||
WebRequestHandler.WebModuleClass := OBS_Doc_Player;
|
||||
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TTTW_Bot, TTW_Bot);
|
||||
Application.CreateForm(TfCreateChat, fCreateChat);
|
||||
Application.CreateForm(TfCreateNotify, fCreateNotify);
|
||||
Application.CreateForm(TfrmQ, frmQ);
|
||||
Application.CreateForm(TfShowText, fShowText);
|
||||
Application.CreateForm(TOBS_Doc_Player, OBS_Doc_Player);
|
||||
Application.OnException := TTW_Bot.GlobalExceptionHandler;
|
||||
Application.CreateForm(TfCreateChat, fCreateChat);
|
||||
Application.CreateForm(TfCreateNotify, fCreateNotify);
|
||||
|
||||
+97
-54
@@ -317,77 +317,120 @@
|
||||
<DelphiCompile Include="$(MainSource)">
|
||||
<MainSource>MainSource</MainSource>
|
||||
</DelphiCompile>
|
||||
<DCCReference Include="uGeneral.pas">
|
||||
<Form>TTW_Bot</Form>
|
||||
</DCCReference>
|
||||
<DCCReference Include="fSettings.pas">
|
||||
<Form>frSettings</Form>
|
||||
<DesignClass>TFrame</DesignClass>
|
||||
</DCCReference>
|
||||
<DCCReference Include="fAI.pas">
|
||||
<DCCReference Include="frames\fAI.pas">
|
||||
<Form>frAI</Form>
|
||||
<FormType>fmx</FormType>
|
||||
<DesignClass>TFrame</DesignClass>
|
||||
</DCCReference>
|
||||
<DCCReference Include="fNotify.pas">
|
||||
<Form>frNotify</Form>
|
||||
<DesignClass>TFrame</DesignClass>
|
||||
</DCCReference>
|
||||
<DCCReference Include="fAutoActions.pas">
|
||||
<DCCReference Include="frames\fAutoActions.pas">
|
||||
<Form>frAutoActions</Form>
|
||||
<FormType>fmx</FormType>
|
||||
<DesignClass>TFrame</DesignClass>
|
||||
</DCCReference>
|
||||
<DCCReference Include="fOBS.pas">
|
||||
<Form>frOBS</Form>
|
||||
<DesignClass>TFrame</DesignClass>
|
||||
</DCCReference>
|
||||
<DCCReference Include="fLog.pas">
|
||||
<Form>frLog</Form>
|
||||
<DesignClass>TFrame</DesignClass>
|
||||
</DCCReference>
|
||||
<DCCReference Include="uRecords.pas"/>
|
||||
<DCCReference Include="fCommands.pas">
|
||||
<Form>frCommands</Form>
|
||||
<DesignClass>TFrame</DesignClass>
|
||||
</DCCReference>
|
||||
<DCCReference Include="uDataBase.pas"/>
|
||||
<DCCReference Include="fColorSettings.pas">
|
||||
<DCCReference Include="frames\fColorSettings.pas">
|
||||
<Form>frColorSettings</Form>
|
||||
<FormType>fmx</FormType>
|
||||
<DesignClass>TFrame</DesignClass>
|
||||
</DCCReference>
|
||||
<DCCReference Include="uCreateChat.pas">
|
||||
<Form>fCreateChat</Form>
|
||||
</DCCReference>
|
||||
<DCCReference Include="fFontSettings.pas">
|
||||
<Form>frFontSettings</Form>
|
||||
<DCCReference Include="frames\fCommands.pas">
|
||||
<Form>frCommands</Form>
|
||||
<FormType>fmx</FormType>
|
||||
<DesignClass>TFrame</DesignClass>
|
||||
</DCCReference>
|
||||
<DCCReference Include="uCreateNotify.pas">
|
||||
<Form>fCreateNotify</Form>
|
||||
</DCCReference>
|
||||
<DCCReference Include="uTWAuth.pas"/>
|
||||
<DCCReference Include="uTTWAPI.pas"/>
|
||||
<DCCReference Include="uAPIDA.pas"/>
|
||||
<DCCReference Include="uShowText.pas">
|
||||
<Form>fShowText</Form>
|
||||
</DCCReference>
|
||||
<DCCReference Include="uWSDA.pas"/>
|
||||
<DCCReference Include="uQ.pas">
|
||||
<Form>frmQ</Form>
|
||||
</DCCReference>
|
||||
<DCCReference Include="fSimpleGrid.pas">
|
||||
<Form>frSimpleGrid</Form>
|
||||
<DesignClass>TFrame</DesignClass>
|
||||
</DCCReference>
|
||||
<DCCReference Include="fContruct.pas">
|
||||
<DCCReference Include="frames\fContruct.pas">
|
||||
<Form>frContruct</Form>
|
||||
<FormType>fmx</FormType>
|
||||
<DesignClass>TFrame</DesignClass>
|
||||
</DCCReference>
|
||||
<DCCReference Include="fGroupsRequest.pas">
|
||||
<DCCReference Include="frames\fFontSettings.pas">
|
||||
<Form>frFontSettings</Form>
|
||||
<FormType>fmx</FormType>
|
||||
<DesignClass>TFrame</DesignClass>
|
||||
</DCCReference>
|
||||
<DCCReference Include="frames\fGroupsRequest.pas">
|
||||
<Form>frGroupsRequest</Form>
|
||||
<FormType>fmx</FormType>
|
||||
<DesignClass>TFrame</DesignClass>
|
||||
</DCCReference>
|
||||
<DCCReference Include="uMyTimer.pas"/>
|
||||
<DCCReference Include="uRegExpr.pas"/>
|
||||
<DCCReference Include="frames\fLog.pas">
|
||||
<Form>frLog</Form>
|
||||
<FormType>fmx</FormType>
|
||||
<DesignClass>TFrame</DesignClass>
|
||||
</DCCReference>
|
||||
<DCCReference Include="frames\fNotify.pas">
|
||||
<Form>frNotify</Form>
|
||||
<FormType>fmx</FormType>
|
||||
<DesignClass>TFrame</DesignClass>
|
||||
</DCCReference>
|
||||
<DCCReference Include="frames\fOBS.pas">
|
||||
<Form>frOBS</Form>
|
||||
<FormType>fmx</FormType>
|
||||
<DesignClass>TFrame</DesignClass>
|
||||
</DCCReference>
|
||||
<DCCReference Include="frames\fSettings.pas">
|
||||
<Form>frSettings</Form>
|
||||
<FormType>fmx</FormType>
|
||||
<DesignClass>TFrame</DesignClass>
|
||||
</DCCReference>
|
||||
<DCCReference Include="frames\fSimpleGrid.pas">
|
||||
<Form>frSimpleGrid</Form>
|
||||
<FormType>fmx</FormType>
|
||||
<DesignClass>TFrame</DesignClass>
|
||||
</DCCReference>
|
||||
<DCCReference Include="frames\fTTS.pas">
|
||||
<Form>frTTS</Form>
|
||||
<FormType>fmx</FormType>
|
||||
<DesignClass>TFrame</DesignClass>
|
||||
</DCCReference>
|
||||
<DCCReference Include="forms\uCreateChat.pas">
|
||||
<Form>fCreateChat</Form>
|
||||
<FormType>fmx</FormType>
|
||||
</DCCReference>
|
||||
<DCCReference Include="forms\uCreateNotify.pas">
|
||||
<Form>fCreateNotify</Form>
|
||||
<FormType>fmx</FormType>
|
||||
</DCCReference>
|
||||
<DCCReference Include="forms\uGeneral.pas">
|
||||
<Form>TTW_Bot</Form>
|
||||
<FormType>fmx</FormType>
|
||||
</DCCReference>
|
||||
<DCCReference Include="forms\uQ.pas">
|
||||
<Form>frmQ</Form>
|
||||
<FormType>fmx</FormType>
|
||||
</DCCReference>
|
||||
<DCCReference Include="forms\uShowText.pas">
|
||||
<Form>fShowText</Form>
|
||||
<FormType>fmx</FormType>
|
||||
</DCCReference>
|
||||
<DCCReference Include="Services\uAPIDA.pas"/>
|
||||
<DCCReference Include="Services\uChatAPI.pas"/>
|
||||
<DCCReference Include="Services\uCustomEmoties.pas"/>
|
||||
<DCCReference Include="Services\uGigaChat.pas"/>
|
||||
<DCCReference Include="Services\uKandinskyAPI.pas"/>
|
||||
<DCCReference Include="Services\uTTWAPI.pas"/>
|
||||
<DCCReference Include="Services\uTTWEventSub.pas"/>
|
||||
<DCCReference Include="Services\uTTWIRC.pas"/>
|
||||
<DCCReference Include="Services\uTWAuth.pas"/>
|
||||
<DCCReference Include="Services\uWebServerKandinsky.pas"/>
|
||||
<DCCReference Include="Services\uWSDA.pas"/>
|
||||
<DCCReference Include="utils\uDataBase.pas"/>
|
||||
<DCCReference Include="utils\uMyTimer.pas"/>
|
||||
<DCCReference Include="utils\uOBS_Doc_Player.pas">
|
||||
<Form>OBS_Doc_Player</Form>
|
||||
<FormType>dfm</FormType>
|
||||
<DesignClass>TWebModule</DesignClass>
|
||||
</DCCReference>
|
||||
<DCCReference Include="utils\uRecords.pas"/>
|
||||
<DCCReference Include="utils\uRegExpr.pas"/>
|
||||
<DCCReference Include="utils\uSoundManager.pas"/>
|
||||
<DCCReference Include="utils\uTTS.pas"/>
|
||||
<DCCReference Include="frames\fPlayerWeb.pas">
|
||||
<Form>frPlayerWeb</Form>
|
||||
<FormType>fmx</FormType>
|
||||
<DesignClass>TFrame</DesignClass>
|
||||
</DCCReference>
|
||||
<DCCReference Include="utils\uPlayerThread.pas"/>
|
||||
<DCCReference Include="utils\uWebServerChat.pas"/>
|
||||
<None Include=".gitignore"/>
|
||||
<BuildConfiguration Include="Base">
|
||||
<Key>Base</Key>
|
||||
|
||||
@@ -1,322 +0,0 @@
|
||||
unit fOBS;
|
||||
|
||||
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.Grid, FMX.ScrollBox, FMX.Edit, FMX.Colors,
|
||||
FMX.ListBox, FMX.EditBox, FMX.SpinBox, FMX.Controls.Presentation, uRecords;
|
||||
|
||||
type
|
||||
TfrOBS = class(TFrame)
|
||||
sgWebChats: TStringGrid;
|
||||
btnCreateOBSChat: TButton;
|
||||
btnDeleteeChat: TButton;
|
||||
Label1: TLabel;
|
||||
IntegerColumn1: TIntegerColumn;
|
||||
StringColumn1: TStringColumn;
|
||||
StringColumn2: TStringColumn;
|
||||
btnCreateOBSNotify: TButton;
|
||||
btnCreateOBSKandinsky: TButton;
|
||||
procedure btnDeleteeChatClick(Sender: TObject);
|
||||
procedure btnCreateOBSKandinskyClick(Sender: TObject);
|
||||
procedure btnCreateOBSChatClick(Sender: TObject);
|
||||
procedure btnCreateOBSNotifyClick(Sender: TObject);
|
||||
procedure sgWebChatsCellDblClick(const Column: TColumn; const Row: Integer);
|
||||
private
|
||||
{ Private declarations }
|
||||
public
|
||||
{ Public declarations }
|
||||
listChats: TArray<TOBSChat>;
|
||||
listNotify: TArray<TOBSNotify>;
|
||||
listKandinsky: TArray<TOBSKandinsky>;
|
||||
|
||||
procedure UpdateGridFromArray;
|
||||
procedure AddChat(newRecord: TOBSChat);
|
||||
procedure EdtChat(newRecord: TOBSChat; oldPort: Integer);
|
||||
procedure DelChat(aPort: Integer);
|
||||
|
||||
procedure AddNotify(newRecord: TOBSNotify);
|
||||
procedure EdtNotify(newRecord: TOBSNotify; oldPort: Integer);
|
||||
procedure DelNotify(aPort: Integer);
|
||||
|
||||
procedure AddKandinsky(newRecord: TOBSKandinsky);
|
||||
procedure DelKandinsky(aPort: Integer);
|
||||
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.fmx}
|
||||
|
||||
uses uGeneral, uCreateChat, uCreateNotify;
|
||||
|
||||
{ TfrOBS }
|
||||
|
||||
procedure TfrOBS.AddChat(newRecord: TOBSChat);
|
||||
begin
|
||||
SetLength(listChats, Length(listChats) + 1);
|
||||
listChats[High(listChats)] := newRecord;
|
||||
UpdateGridFromArray;
|
||||
db.SaveRecordArray<TOBSChat>('listChats', listChats);
|
||||
end;
|
||||
|
||||
procedure TfrOBS.AddKandinsky(newRecord: TOBSKandinsky);
|
||||
begin
|
||||
SetLength(listKandinsky, Length(listKandinsky) + 1);
|
||||
listKandinsky[High(listKandinsky)] := newRecord;
|
||||
UpdateGridFromArray;
|
||||
db.SaveRecordArray<TOBSKandinsky>('listKandinsky', listKandinsky);
|
||||
end;
|
||||
|
||||
procedure TfrOBS.AddNotify(newRecord: TOBSNotify);
|
||||
begin
|
||||
SetLength(listNotify, Length(listNotify) + 1);
|
||||
listNotify[High(listNotify)] := newRecord;
|
||||
UpdateGridFromArray;
|
||||
db.SaveRecordArray<TOBSNotify>('listNotify', listNotify);
|
||||
end;
|
||||
|
||||
procedure TfrOBS.btnCreateOBSChatClick(Sender: TObject);
|
||||
var
|
||||
dport, i: Integer;
|
||||
begin
|
||||
dport := 8080;
|
||||
for i := 0 to sgWebChats.RowCount - 1 do
|
||||
begin
|
||||
if strtoint(sgWebChats.Cells[0, i]) >= dport then
|
||||
dport := strtoint(sgWebChats.Cells[0, i]) + 1;
|
||||
end;
|
||||
fCreateChat.sbWebServerPort.Value := dport;
|
||||
fCreateChat.isEdit := false;
|
||||
fCreateChat.Show;
|
||||
end;
|
||||
|
||||
procedure TfrOBS.btnCreateOBSKandinskyClick(Sender: TObject);
|
||||
var
|
||||
dport: Integer;
|
||||
i: Integer;
|
||||
rk: TOBSKandinsky;
|
||||
begin
|
||||
dport := 8080;
|
||||
for i := 0 to sgWebChats.RowCount - 1 do
|
||||
begin
|
||||
if strtoint(sgWebChats.Cells[0, i]) >= dport then
|
||||
dport := strtoint(sgWebChats.Cells[0, i]) + 1;
|
||||
end;
|
||||
rk.port := dport;
|
||||
AddKandinsky(rk);
|
||||
|
||||
end;
|
||||
|
||||
procedure TfrOBS.btnCreateOBSNotifyClick(Sender: TObject);
|
||||
var
|
||||
dport, i: Integer;
|
||||
begin
|
||||
dport := 8080;
|
||||
for i := 0 to sgWebChats.RowCount - 1 do
|
||||
begin
|
||||
if strtoint(sgWebChats.Cells[0, i]) >= dport then
|
||||
dport := strtoint(sgWebChats.Cells[0, i]) + 1;
|
||||
end;
|
||||
fCreateNotify.sbWebServerPort.Value := dport;
|
||||
fCreateNotify.isEdit := false;
|
||||
fCreateNotify.Show;
|
||||
end;
|
||||
|
||||
procedure TfrOBS.btnDeleteeChatClick(Sender: TObject);
|
||||
begin
|
||||
if sgWebChats.Cells[1, sgWebChats.Row] = '×àò' then
|
||||
begin
|
||||
DelChat(strtoint(sgWebChats.Cells[0, sgWebChats.Row]));
|
||||
end;
|
||||
if sgWebChats.Cells[1, sgWebChats.Row] = 'Kandinsky' then
|
||||
begin
|
||||
DelKandinsky(strtoint(sgWebChats.Cells[0, sgWebChats.Row]));
|
||||
end;
|
||||
if sgWebChats.Cells[1, sgWebChats.Row] = 'Îïîâåùåíèå' then
|
||||
begin
|
||||
DelNotify(strtoint(sgWebChats.Cells[0, sgWebChats.Row]));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrOBS.DelChat(aPort: Integer);
|
||||
var
|
||||
i, j: Integer;
|
||||
begin
|
||||
// Èùåì â îáðàòíîì ïîðÿäêå äëÿ áåçîïàñíîãî óäàëåíèÿ
|
||||
for i := High(listChats) downto 0 do
|
||||
begin
|
||||
if listChats[i].port = aPort then
|
||||
begin
|
||||
// Ñäâèãàåì ýëåìåíòû ìàññèâà
|
||||
for j := i to High(listChats) - 1 do
|
||||
listChats[j] := listChats[j + 1];
|
||||
// Óìåíüøàåì ðàçìåð ìàññèâà
|
||||
SetLength(listChats, Length(listChats) - 1);
|
||||
// Âûõîäèì ïîñëå ïåðâîãî íàéäåííîãî ñîâïàäåíèÿ (ïðåäïîëàãàåì óíèêàëüíîñòü ïîðòîâ)
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
|
||||
db.SaveRecordArray<TOBSChat>('listChats', listChats);
|
||||
UpdateGridFromArray;
|
||||
end;
|
||||
|
||||
procedure TfrOBS.DelKandinsky(aPort: Integer);
|
||||
var
|
||||
i, j: Integer;
|
||||
begin
|
||||
// Èùåì â îáðàòíîì ïîðÿäêå äëÿ áåçîïàñíîãî óäàëåíèÿ
|
||||
for i := High(listKandinsky) downto 0 do
|
||||
begin
|
||||
if listKandinsky[i].port = aPort then
|
||||
begin
|
||||
// Ñäâèãàåì ýëåìåíòû ìàññèâà
|
||||
for j := i to High(listKandinsky) - 1 do
|
||||
listKandinsky[j] := listKandinsky[j + 1];
|
||||
// Óìåíüøàåì ðàçìåð ìàññèâà
|
||||
SetLength(listKandinsky, Length(listKandinsky) - 1);
|
||||
// Âûõîäèì ïîñëå ïåðâîãî íàéäåííîãî ñîâïàäåíèÿ (ïðåäïîëàãàåì óíèêàëüíîñòü ïîðòîâ)
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
UpdateGridFromArray;
|
||||
db.SaveRecordArray<TOBSKandinsky>('listKandinsky', listKandinsky);
|
||||
end;
|
||||
|
||||
procedure TfrOBS.DelNotify(aPort: Integer);
|
||||
var
|
||||
i, j: Integer;
|
||||
begin
|
||||
// Èùåì â îáðàòíîì ïîðÿäêå äëÿ áåçîïàñíîãî óäàëåíèÿ
|
||||
for i := High(listNotify) downto 0 do
|
||||
begin
|
||||
if listNotify[i].port = aPort then
|
||||
begin
|
||||
// Ñäâèãàåì ýëåìåíòû ìàññèâà
|
||||
for j := i to High(listNotify) - 1 do
|
||||
listNotify[j] := listNotify[j + 1];
|
||||
// Óìåíüøàåì ðàçìåð ìàññèâà
|
||||
SetLength(listNotify, Length(listNotify) - 1);
|
||||
// Âûõîäèì ïîñëå ïåðâîãî íàéäåííîãî ñîâïàäåíèÿ (ïðåäïîëàãàåì óíèêàëüíîñòü ïîðòîâ)
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
|
||||
UpdateGridFromArray;
|
||||
db.SaveRecordArray<TOBSNotify>('listNotify', listNotify);
|
||||
end;
|
||||
|
||||
procedure TfrOBS.EdtChat(newRecord: TOBSChat; oldPort: Integer);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to High(listChats) do
|
||||
if listChats[i].port = oldPort then
|
||||
begin
|
||||
listChats[i] := newRecord;
|
||||
UpdateGridFromArray;
|
||||
db.SaveRecordArray<TOBSChat>('listChats', listChats);
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrOBS.EdtNotify(newRecord: TOBSNotify; oldPort: Integer);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to High(listNotify) do
|
||||
if listNotify[i].port = oldPort then
|
||||
begin
|
||||
listNotify[i] := newRecord;
|
||||
UpdateGridFromArray;
|
||||
db.SaveRecordArray<TOBSNotify>('listNotify', listNotify);
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrOBS.sgWebChatsCellDblClick(const Column: TColumn;
|
||||
const Row: Integer);
|
||||
var
|
||||
myChatRec: TOBSChat;
|
||||
myNotifyRec: TOBSNotify;
|
||||
i: Integer;
|
||||
begin
|
||||
if sgWebChats.Cells[1, Row] = 'Îïîâåùåíèå' then
|
||||
begin
|
||||
for i := 0 to High(listNotify) do
|
||||
if listNotify[i].port = (strtoint(sgWebChats.Cells[0, Row])) then
|
||||
begin
|
||||
myNotifyRec := listNotify[i];
|
||||
Break;
|
||||
end;
|
||||
|
||||
fCreateNotify.isEdit := true;
|
||||
fCreateNotify.setRecord(myNotifyRec);
|
||||
fCreateNotify.Show;
|
||||
end;
|
||||
if sgWebChats.Cells[1, Row] = '×àò' then
|
||||
begin
|
||||
for i := 0 to High(listChats) do
|
||||
if listChats[i].port = (strtoint(sgWebChats.Cells[0, Row])) then
|
||||
begin
|
||||
myChatRec := listChats[i];
|
||||
Break;
|
||||
end;
|
||||
fCreateChat.isEdit := true;
|
||||
fCreateChat.setRecord(myChatRec);
|
||||
fCreateChat.Show;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrOBS.UpdateGridFromArray;
|
||||
var
|
||||
i, rowIndex: Integer;
|
||||
begin
|
||||
sgWebChats.BeginUpdate;
|
||||
try
|
||||
sgWebChats.RowCount := 0; // Ñáðàñûâàåì ñòðîêè
|
||||
|
||||
rowIndex := 0; // Îòäåëüíûé ñ÷åò÷èê äëÿ ñòðîê ñåòêè
|
||||
|
||||
// listChats
|
||||
for i := 0 to High(listChats) do
|
||||
begin
|
||||
sgWebChats.RowCount := rowIndex + 1;
|
||||
sgWebChats.Cells[0, rowIndex] := inttostr(listChats[i].port);
|
||||
sgWebChats.Cells[1, rowIndex] := '×àò';
|
||||
sgWebChats.Cells[2, rowIndex] := 'http://127.0.0.1:' +
|
||||
inttostr(listChats[i].port);
|
||||
Inc(rowIndex); // Óâåëè÷èâàåì ñ÷åò÷èê ñòðîê
|
||||
end;
|
||||
|
||||
// listNotify
|
||||
for i := 0 to High(listNotify) do
|
||||
begin
|
||||
sgWebChats.RowCount := rowIndex + 1;
|
||||
sgWebChats.Cells[0, rowIndex] := inttostr(listNotify[i].port);
|
||||
sgWebChats.Cells[1, rowIndex] := 'Îïîâåùåíèå';
|
||||
sgWebChats.Cells[2, rowIndex] := 'http://127.0.0.1:' +
|
||||
inttostr(listNotify[i].port);
|
||||
Inc(rowIndex); // Óâåëè÷èâàåì ñ÷åò÷èê ñòðîê
|
||||
end;
|
||||
|
||||
// listKandinsky
|
||||
for i := 0 to High(listKandinsky) do
|
||||
begin
|
||||
sgWebChats.RowCount := rowIndex + 1;
|
||||
sgWebChats.Cells[0, rowIndex] := inttostr(listKandinsky[i].port);
|
||||
sgWebChats.Cells[1, rowIndex] := 'Kandinsky';
|
||||
sgWebChats.Cells[2, rowIndex] := 'http://127.0.0.1:' +
|
||||
inttostr(listKandinsky[i].port);
|
||||
Inc(rowIndex); // Óâåëè÷èâàåì ñ÷åò÷èê ñòðîê
|
||||
end;
|
||||
finally
|
||||
sgWebChats.EndUpdate;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,5 @@
|
||||
[uCreateChat.pas]
|
||||
SaveTime=14.08.2025 10:44:31
|
||||
FileCount=2
|
||||
File0=C:\Users\PTyTb\Documents\Embarcadero\Studio\Projects\ttw_fmx_v10\forms\uCreateChat.pas
|
||||
File1=C:\Users\PTyTb\Documents\Embarcadero\Studio\Projects\ttw_fmx_v10\forms\uCreateChat.fmx
|
||||
@@ -0,0 +1,189 @@
|
||||
object fCreateChat: TfCreateChat
|
||||
Left = 0
|
||||
Top = 0
|
||||
Caption = #1056#1077#1076#1072#1082#1090#1086#1088' '#1095#1072#1090#1086#1074
|
||||
ClientHeight = 287
|
||||
ClientWidth = 810
|
||||
FormFactor.Width = 320
|
||||
FormFactor.Height = 480
|
||||
FormFactor.Devices = [Desktop]
|
||||
OnCreate = FormCreate
|
||||
OnShow = FormShow
|
||||
DesignerMasterStyle = 0
|
||||
object GroupBox1: TGroupBox
|
||||
Position.X = 8.000000000000000000
|
||||
Position.Y = 8.000000000000000000
|
||||
Size.Width = 305.000000000000000000
|
||||
Size.Height = 271.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
Text = #1041#1083#1086#1082' '#1089#1086#1086#1073#1097#1077#1085#1080#1103
|
||||
TabOrder = 1
|
||||
inline frChatSettings1: TfrColorSettings
|
||||
Align = Client
|
||||
Margins.Top = 20.000000000000000000
|
||||
Size.Width = 305.000000000000000000
|
||||
Size.Height = 251.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
inherited ccbStyleBorderColor: TColorComboBox
|
||||
TabOrder = 30
|
||||
end
|
||||
inherited Label40: TLabel
|
||||
TabOrder = 8
|
||||
end
|
||||
inherited Label42: TLabel
|
||||
TabOrder = 35
|
||||
end
|
||||
inherited Label44: TLabel
|
||||
TabOrder = 38
|
||||
end
|
||||
inherited Label48: TLabel
|
||||
TabOrder = 40
|
||||
end
|
||||
inherited sbStyleBlockBorderSize: TSpinBox
|
||||
TabOrder = 37
|
||||
end
|
||||
inherited sbStyleBlockPadding: TSpinBox
|
||||
TabOrder = 41
|
||||
end
|
||||
inherited Label1: TLabel
|
||||
TabOrder = 34
|
||||
end
|
||||
inherited ccbBColor: TColorComboBox
|
||||
TabOrder = 36
|
||||
end
|
||||
inherited btnChangeBGColor: TButton
|
||||
TabOrder = 39
|
||||
end
|
||||
end
|
||||
end
|
||||
object GroupBox2: TGroupBox
|
||||
Position.X = 321.000000000000000000
|
||||
Position.Y = 8.000000000000000000
|
||||
Size.Width = 240.000000000000000000
|
||||
Size.Height = 145.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
Text = #1064#1088#1080#1092#1090
|
||||
TabOrder = 2
|
||||
inline frFontSettings1: TfrFontSettings
|
||||
Align = Client
|
||||
Margins.Top = 20.000000000000000000
|
||||
Size.Width = 240.000000000000000000
|
||||
Size.Height = 125.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
inherited ccbFontColor: TColorComboBox
|
||||
TabOrder = 36
|
||||
end
|
||||
inherited Label49: TLabel
|
||||
TabOrder = 35
|
||||
end
|
||||
inherited Label46: TLabel
|
||||
TabOrder = 39
|
||||
end
|
||||
end
|
||||
end
|
||||
object GroupBox10: TGroupBox
|
||||
Position.X = 569.000000000000000000
|
||||
Position.Y = 8.000000000000000000
|
||||
Size.Width = 232.000000000000000000
|
||||
Size.Height = 203.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
Text = #1053#1072#1089#1090#1088#1086#1081#1082#1080
|
||||
TabOrder = 0
|
||||
object Label27: TLabel
|
||||
Position.X = 8.000000000000000000
|
||||
Position.Y = 22.000000000000000000
|
||||
Size.Width = 249.000000000000000000
|
||||
Size.Height = 17.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TextSettings.Trimming = None
|
||||
Text = #1052#1072#1082#1089#1080#1084#1072#1083#1100#1085#1086#1077' '#1082#1086#1083#1080#1095#1077#1089#1090#1074#1086' '#1089#1086#1086#1073#1097#1077#1085#1080#1081
|
||||
TabOrder = 3
|
||||
end
|
||||
object Label38: TLabel
|
||||
Position.X = 8.000000000000000000
|
||||
Position.Y = 77.000000000000000000
|
||||
Size.Width = 249.000000000000000000
|
||||
Size.Height = 17.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TextSettings.Trimming = None
|
||||
Text = #1042#1088#1077#1084#1103' '#1086#1090#1086#1073#1088#1072#1078#1077#1085#1080#1103' '#1089#1086#1086#1073#1097#1077#1085#1080#1103
|
||||
TabOrder = 0
|
||||
end
|
||||
object sbMaxMsg: TSpinBox
|
||||
Touch.InteractiveGestures = [LongTap, DoubleTap]
|
||||
TabOrder = 5
|
||||
Cursor = crIBeam
|
||||
Value = 5.000000000000000000
|
||||
Position.X = 8.000000000000000000
|
||||
Position.Y = 47.000000000000000000
|
||||
end
|
||||
object sbTimeMsg: TSpinBox
|
||||
Touch.InteractiveGestures = [LongTap, DoubleTap]
|
||||
TabOrder = 2
|
||||
Cursor = crIBeam
|
||||
Value = 10.000000000000000000
|
||||
Position.X = 8.000000000000000000
|
||||
Position.Y = 102.000000000000000000
|
||||
end
|
||||
object Label39: TLabel
|
||||
Position.X = 8.000000000000000000
|
||||
Position.Y = 132.000000000000000000
|
||||
Size.Width = 193.000000000000000000
|
||||
Size.Height = 17.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TextSettings.Trimming = None
|
||||
Text = #1055#1086#1088#1090' '#1042#1077#1073' '#1057#1077#1088#1074#1077#1088#1072
|
||||
TabOrder = 6
|
||||
end
|
||||
object cbFreez: TCheckBox
|
||||
Position.X = 112.000000000000000000
|
||||
Position.Y = 105.000000000000000000
|
||||
Size.Width = 112.000000000000000000
|
||||
Size.Height = 19.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 38
|
||||
Text = #1042#1077#1095#1085#1086
|
||||
end
|
||||
object sbWebServerPort: TSpinBox
|
||||
Touch.InteractiveGestures = [LongTap, DoubleTap]
|
||||
TabOrder = 4
|
||||
Cursor = crIBeam
|
||||
Min = 8080.000000000000000000
|
||||
Max = 65000.000000000000000000
|
||||
Value = 8085.000000000000000000
|
||||
Position.X = 8.000000000000000000
|
||||
Position.Y = 157.000000000000000000
|
||||
end
|
||||
end
|
||||
object edtWebChatTest: TEdit
|
||||
Touch.InteractiveGestures = [LongTap, DoubleTap]
|
||||
TabOrder = 5
|
||||
Position.X = 321.000000000000000000
|
||||
Position.Y = 161.000000000000000000
|
||||
Size.Width = 240.000000000000000000
|
||||
Size.Height = 22.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
end
|
||||
object btnWebChatTest: TButton
|
||||
Position.X = 321.000000000000000000
|
||||
Position.Y = 191.000000000000000000
|
||||
Size.Width = 152.000000000000000000
|
||||
Size.Height = 22.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 3
|
||||
Text = #1058#1077#1089#1090#1086#1074#1086#1077' '#1089#1086#1086#1073#1097#1077#1085#1080#1077
|
||||
TextSettings.Trimming = None
|
||||
OnClick = btnWebChatTestClick
|
||||
end
|
||||
object btnCreateWebChat: TButton
|
||||
Position.X = 704.000000000000000000
|
||||
Position.Y = 257.000000000000000000
|
||||
Size.Width = 97.000000000000000000
|
||||
Size.Height = 22.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 4
|
||||
Text = #1057#1086#1079#1076#1072#1090#1100' '#1095#1072#1090
|
||||
TextSettings.Trimming = None
|
||||
OnClick = btnCreateWebChatClick
|
||||
end
|
||||
end
|
||||
@@ -0,0 +1,207 @@
|
||||
unit uCreateChat;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils, System.Types, System.UITypes, System.Classes,
|
||||
System.Variants, FMX.ListBox, FMX.Colors, FMX.SpinBox,
|
||||
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
|
||||
fColorSettings, fFontSettings, FMX.Controls.Presentation, FMX.StdCtrls,
|
||||
FMX.Edit, FMX.EditBox, StrUtils, uRecords;
|
||||
|
||||
type
|
||||
TfCreateChat = class(TForm)
|
||||
frChatSettings1: TfrColorSettings;
|
||||
GroupBox1: TGroupBox;
|
||||
GroupBox2: TGroupBox;
|
||||
frFontSettings1: TfrFontSettings;
|
||||
GroupBox10: TGroupBox;
|
||||
Label27: TLabel;
|
||||
Label38: TLabel;
|
||||
sbMaxMsg: TSpinBox;
|
||||
sbTimeMsg: TSpinBox;
|
||||
Label39: TLabel;
|
||||
cbFreez: TCheckBox;
|
||||
sbWebServerPort: TSpinBox;
|
||||
edtWebChatTest: TEdit;
|
||||
btnWebChatTest: TButton;
|
||||
btnCreateWebChat: TButton;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure btnCreateWebChatClick(Sender: TObject);
|
||||
procedure FormShow(Sender: TObject);
|
||||
procedure btnWebChatTestClick(Sender: TObject);
|
||||
private
|
||||
{ Private declarations }
|
||||
function GetColorFromColorPanel(aColor: TAlphaColor): string;
|
||||
public
|
||||
{ Public declarations }
|
||||
isEdit: boolean;
|
||||
oldPort: integer;
|
||||
procedure setRecord(aRec: TOBSChat);
|
||||
end;
|
||||
|
||||
var
|
||||
fCreateChat: TfCreateChat;
|
||||
|
||||
implementation
|
||||
|
||||
uses uGeneral;
|
||||
|
||||
{$R *.fmx}
|
||||
|
||||
function TfCreateChat.GetColorFromColorPanel(aColor: TAlphaColor): string;
|
||||
var
|
||||
Color: TAlphaColor;
|
||||
r, G, B: Byte;
|
||||
A: Real;
|
||||
FS: TFormatSettings;
|
||||
begin
|
||||
Color := aColor;
|
||||
r := TAlphaColorRec(Color).r;
|
||||
G := TAlphaColorRec(Color).G;
|
||||
B := TAlphaColorRec(Color).B;
|
||||
A := TAlphaColorRec(Color).A / 255; // Преобразуем альфа-канал в диапазон 0..1
|
||||
|
||||
// Устанавливаем точку в качестве десятичного разделителя
|
||||
FS := TFormatSettings.Create;
|
||||
FS.DecimalSeparator := '.';
|
||||
|
||||
result := Format('rgba(%d, %d, %d, %.2f)', [r, G, B, A], FS);
|
||||
end;
|
||||
|
||||
procedure TfCreateChat.setRecord(aRec: TOBSChat);
|
||||
var
|
||||
SavedColor: TAlphaColor;
|
||||
begin
|
||||
if TryStrToUInt('$' + aRec.ColorBlock, Cardinal(SavedColor)) then
|
||||
fCreateChat.frChatSettings1.cpStyleBlockColor.Color := SavedColor
|
||||
else
|
||||
fCreateChat.frChatSettings1.cpStyleBlockColor.Color := TAlphaColorRec.Black;
|
||||
fCreateChat.frChatSettings1.ccbStyleBorderColor.ItemIndex := aRec.ColorBorder;
|
||||
fCreateChat.frChatSettings1.ccbBColor.ItemIndex := aRec.ColorBackground;
|
||||
fCreateChat.frChatSettings1.sbStyleBlockBorderSize.Value := aRec.SolidBorder;
|
||||
fCreateChat.frChatSettings1.sbStyleBlockPadding.Value := aRec.Paddings;
|
||||
|
||||
fCreateChat.frFontSettings1.ccbFontColor.ItemIndex := aRec.ColorFont;
|
||||
fCreateChat.frFontSettings1.sbFontSize.Value := aRec.SizeFont;
|
||||
fCreateChat.frFontSettings1.cbFontStyleDefault.ItemIndex := aRec.StyleFont;
|
||||
|
||||
fCreateChat.sbTimeMsg.Value := aRec.TimeMess;
|
||||
fCreateChat.sbMaxMsg.Value := aRec.MaxCountMess;
|
||||
fCreateChat.sbWebServerPort.Value := aRec.port;
|
||||
oldPort := aRec.port;
|
||||
end;
|
||||
|
||||
procedure TfCreateChat.btnCreateWebChatClick(Sender: TObject);
|
||||
var
|
||||
OBSChat: TOBSChat;
|
||||
begin
|
||||
OBSChat.ColorBlock := GetColorFromColorPanel
|
||||
(frChatSettings1.cpStyleBlockColor.Color);
|
||||
OBSChat.ColorBorder := frChatSettings1.ccbStyleBorderColor.ItemIndex;
|
||||
OBSChat.ColorBackground := frChatSettings1.ccbBColor.ItemIndex;
|
||||
OBSChat.SolidBorder := round(frChatSettings1.sbStyleBlockBorderSize.Value);
|
||||
OBSChat.Paddings := round(frChatSettings1.sbStyleBlockPadding.Value);
|
||||
|
||||
OBSChat.ColorFont := frFontSettings1.ccbFontColor.ItemIndex;
|
||||
OBSChat.SizeFont := round(frFontSettings1.sbFontSize.Value);
|
||||
OBSChat.StyleFont := frFontSettings1.cbFontStyleDefault.ItemIndex;
|
||||
|
||||
OBSChat.MaxCountMess := round(sbMaxMsg.Value);
|
||||
OBSChat.TimeMess := round(sbTimeMsg.Value);
|
||||
OBSChat.port := round(sbWebServerPort.Value);
|
||||
|
||||
if isEdit then
|
||||
TTW_Bot.frOBS1.EdtChat(OBSChat, oldPort)
|
||||
else
|
||||
TTW_Bot.frOBS1.AddChat(OBSChat);
|
||||
close;
|
||||
end;
|
||||
|
||||
procedure TfCreateChat.btnWebChatTestClick(Sender: TObject);
|
||||
var j:integer; aRecord: TTwitchChatMessage;
|
||||
begin
|
||||
aRecord.Username:='Test';
|
||||
aRecord.DisplayName:='Test';
|
||||
aRecord.Message:=edtWebChatTest.Text;
|
||||
for j := 0 to TTW_Bot.frOBS1.ChatWebServers.Count - 1 do
|
||||
begin
|
||||
if TTW_Bot.frOBS1.ChatWebServers[j].port = round(sbWebServerPort.Value) then
|
||||
begin
|
||||
TTW_Bot.frOBS1.MsgToWebServer(aRecord);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfCreateChat.FormCreate(Sender: TObject);
|
||||
procedure LoadFontList;
|
||||
var
|
||||
SearchRec: TSearchRec;
|
||||
n: integer;
|
||||
begin
|
||||
if not DirectoryExists(myConst.fontsPath) then
|
||||
CreateDir(myConst.fontsPath);
|
||||
|
||||
n := 1;
|
||||
if FindFirst(IncludeTrailingPathDelimiter(myConst.fontsPath) + '*.*',
|
||||
faArchive, SearchRec) = 0 then
|
||||
try
|
||||
repeat
|
||||
if (SearchRec.Attr and faAnyFile) = SearchRec.Attr then
|
||||
begin
|
||||
fCreateChat.frFontSettings1.cbFontStyleDefault.Items.Add
|
||||
(SearchRec.Name);
|
||||
Inc(n);
|
||||
end;
|
||||
until FindNext(SearchRec) <> 0;
|
||||
finally
|
||||
System.SysUtils.FindClose(SearchRec);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure LoadChatOBSSettings;
|
||||
var
|
||||
I: integer;
|
||||
c: TComponent;
|
||||
ColorStr: string;
|
||||
SavedColor: TAlphaColor;
|
||||
begin
|
||||
for I := 0 to frChatSettings1.ComponentCount - 1 do
|
||||
begin
|
||||
c := frChatSettings1.Components[I];
|
||||
if c is TComboBox then
|
||||
TComboBox(c).ItemIndex :=
|
||||
strtoint(db.ReadSetting(TComboBox(c).Name, '0'))
|
||||
else if c is TColorComboBox then
|
||||
TColorComboBox(c).ItemIndex :=
|
||||
strtoint(db.ReadSetting(TComboBox(c).Name, '147'))
|
||||
else if c is TSpinBox then
|
||||
TSpinBox(c).text := db.ReadSetting(TSpinBox(c).Name,
|
||||
IfThen(TSpinBox(c).Name = 'sbWebServerPort', '8080', '1'))
|
||||
else if c is TCheckBox then
|
||||
TCheckBox(c).IsChecked := db.ReadSetting(TCheckBox(c).Name, '0') = '1';
|
||||
end;
|
||||
|
||||
ColorStr := db.ReadSetting('cpStyleBlockColor', 'FF000000');
|
||||
if TryStrToUInt('$' + ColorStr, Cardinal(SavedColor)) then
|
||||
frChatSettings1.cpStyleBlockColor.Color := SavedColor
|
||||
else
|
||||
frChatSettings1.cpStyleBlockColor.Color := TAlphaColorRec.Black;
|
||||
end;
|
||||
|
||||
begin
|
||||
isEdit := false;
|
||||
LoadChatOBSSettings;
|
||||
LoadFontList;
|
||||
|
||||
end;
|
||||
|
||||
procedure TfCreateChat.FormShow(Sender: TObject);
|
||||
begin
|
||||
if isEdit then
|
||||
btnCreateWebChat.text := 'Изменить чат'
|
||||
else
|
||||
btnCreateWebChat.text := 'Создать чат';
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -18,7 +18,7 @@ object TTW_Bot: TTTW_Bot
|
||||
Size.Width = 970.000000000000000000
|
||||
Size.Height = 744.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabIndex = 7
|
||||
TabIndex = 0
|
||||
TabOrder = 0
|
||||
TabPosition = PlatformDefault
|
||||
Sizes = (
|
||||
@@ -45,7 +45,7 @@ object TTW_Bot: TTTW_Bot
|
||||
item
|
||||
end>
|
||||
TextSettings.Trimming = None
|
||||
IsSelected = False
|
||||
IsSelected = True
|
||||
ImageIndex = 21
|
||||
Size.Width = 96.000000000000000000
|
||||
Size.Height = 26.000000000000000000
|
||||
@@ -72,15 +72,13 @@ object TTW_Bot: TTTW_Bot
|
||||
inherited btnOpenStream: TButton
|
||||
Images = ImageList1
|
||||
ImageIndex = 17
|
||||
TabOrder = 32
|
||||
end
|
||||
inherited btnGetTokenStreamer: TButton
|
||||
Images = ImageList1
|
||||
ImageIndex = 10
|
||||
TabOrder = 33
|
||||
end
|
||||
inherited edtBotTokenStreamer: TEdit
|
||||
TabOrder = 34
|
||||
TabOrder = 33
|
||||
end
|
||||
inherited Label53: TLabel
|
||||
TabOrder = 36
|
||||
@@ -91,39 +89,36 @@ object TTW_Bot: TTTW_Bot
|
||||
Images = ImageList1
|
||||
ImageIndex = 10
|
||||
end
|
||||
inherited Label63: TLabel
|
||||
TabOrder = 34
|
||||
end
|
||||
inherited edtDAClientID: TEdit
|
||||
TabOrder = 37
|
||||
TabOrder = 33
|
||||
end
|
||||
inherited Label64: TLabel
|
||||
TabOrder = 35
|
||||
TabOrder = 31
|
||||
end
|
||||
inherited edtDAClientSecret: TEdit
|
||||
TabOrder = 36
|
||||
TabOrder = 34
|
||||
end
|
||||
inherited Label65: TLabel
|
||||
TabOrder = 38
|
||||
TabOrder = 35
|
||||
end
|
||||
inherited edtDARedirectURL: TEdit
|
||||
TabOrder = 39
|
||||
TabOrder = 42
|
||||
end
|
||||
inherited edtDACode: TEdit
|
||||
TabOrder = 40
|
||||
TabOrder = 36
|
||||
end
|
||||
inherited Label66: TLabel
|
||||
TabOrder = 41
|
||||
TabOrder = 39
|
||||
end
|
||||
inherited btnDAStart: TButton
|
||||
Images = ImageList1
|
||||
ImageIndex = 18
|
||||
TabOrder = 42
|
||||
TabOrder = 41
|
||||
OnClick = frSettings1btnDAStartClick
|
||||
end
|
||||
inherited btnGetDADef: TButton
|
||||
Images = ImageList1
|
||||
TabOrder = 44
|
||||
TabOrder = 43
|
||||
end
|
||||
end
|
||||
inherited btnOpenRomaning: TButton
|
||||
@@ -257,6 +252,7 @@ object TTW_Bot: TTTW_Bot
|
||||
inherited btnAIPic: TButton
|
||||
Images = ImageList1
|
||||
ImageIndex = 5
|
||||
TabOrder = 46
|
||||
end
|
||||
end
|
||||
inherited btnAddCommand: TButton
|
||||
@@ -283,8 +279,8 @@ object TTW_Bot: TTTW_Bot
|
||||
Viewport.Width = 207.000000000000000000
|
||||
Viewport.Height = 116.000000000000000000
|
||||
end
|
||||
inherited btnRandomAdd: TButton
|
||||
TabOrder = 32
|
||||
inherited btnRandomDel: TButton
|
||||
TabOrder = 31
|
||||
end
|
||||
inherited btnRmGroup: TButton
|
||||
TabOrder = 33
|
||||
@@ -427,6 +423,28 @@ object TTW_Bot: TTTW_Bot
|
||||
Text = #1053#1072#1074#1099#1082#1080
|
||||
ExplicitSize.cx = 79.000000000000000000
|
||||
ExplicitSize.cy = 26.000000000000000000
|
||||
object GroupBox1: TGroupBox
|
||||
Padding.Left = 10.000000000000000000
|
||||
Padding.Top = 20.000000000000000000
|
||||
Padding.Right = 10.000000000000000000
|
||||
Padding.Bottom = 10.000000000000000000
|
||||
Position.X = 1.000000000000000000
|
||||
Position.Y = 8.000000000000000000
|
||||
Size.Width = 328.000000000000000000
|
||||
Size.Height = 233.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
Text = #1054#1079#1074#1091#1095#1082#1072' '#1090#1077#1082#1089#1090#1072
|
||||
TabOrder = 0
|
||||
inline frTTS1: TfrTTS
|
||||
Align = Client
|
||||
Size.Width = 308.000000000000000000
|
||||
Size.Height = 203.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
inherited btnSend: TButton
|
||||
OnClick = frTTS1btnSendClick
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
object TabItem4: TTabItem
|
||||
CustomIcon = <
|
||||
@@ -449,41 +467,84 @@ object TTW_Bot: TTTW_Bot
|
||||
Size.Height = 345.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
inherited sgWebChats: TStringGrid
|
||||
Align = Bottom
|
||||
CanFocus = True
|
||||
ClipChildren = True
|
||||
Position.Y = 63.000000000000000000
|
||||
Size.Width = 970.000000000000000000
|
||||
Size.Height = 282.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 0
|
||||
RowCount = 0
|
||||
Options = [ColumnResize, ColumnMove, ColLines, RowLines, Tabs, Header, HeaderClick, AutoDisplacement]
|
||||
Viewport.Width = 970.000000000000000000
|
||||
Viewport.Height = 282.000000000000000000
|
||||
inherited IntegerColumn1: TIntegerColumn
|
||||
Header = #1055#1086#1088#1090
|
||||
HeaderSettings.TextSettings.WordWrap = False
|
||||
end
|
||||
inherited StringColumn1: TStringColumn
|
||||
Header = #1058#1080#1087
|
||||
HeaderSettings.TextSettings.WordWrap = False
|
||||
end
|
||||
inherited StringColumn2: TStringColumn
|
||||
Header = #1057#1089#1099#1083#1082#1072' '#1076#1083#1103' OBS'
|
||||
HeaderSettings.TextSettings.WordWrap = False
|
||||
Size.Width = 200.000000000000000000
|
||||
end
|
||||
end
|
||||
inherited btnCreateOBSChat: TButton
|
||||
Images = ImageList1
|
||||
ImageIndex = 13
|
||||
Position.X = 8.000000000000000000
|
||||
Position.Y = 8.000000000000000000
|
||||
Size.Width = 94.000000000000000000
|
||||
Size.Height = 22.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 2
|
||||
Text = #1057#1086#1079#1076#1072#1090#1100' '#1095#1072#1090
|
||||
TextSettings.Trimming = None
|
||||
end
|
||||
inherited btnDeleteeChat: TButton
|
||||
Anchors = [akTop, akRight]
|
||||
Images = ImageList1
|
||||
ImageIndex = 4
|
||||
Position.X = 882.000000000000000000
|
||||
Position.Y = 8.000000000000000000
|
||||
TabOrder = 3
|
||||
Text = #1059#1076#1072#1083#1080#1090#1100
|
||||
TextSettings.Trimming = None
|
||||
OnClick = frOBS1btnDeleteeChatClick
|
||||
end
|
||||
inherited Label1: TLabel
|
||||
TabOrder = 10
|
||||
Position.X = 8.000000000000000000
|
||||
Position.Y = 38.000000000000000000
|
||||
Text = #1057#1086#1079#1076#1072#1085#1085#1099#1077' '#1095#1072#1090#1099':'
|
||||
TabOrder = 13
|
||||
end
|
||||
inherited btnCreateOBSNotify: TButton
|
||||
Images = ImageList1
|
||||
ImageIndex = 24
|
||||
Position.X = 110.000000000000000000
|
||||
Position.Y = 8.000000000000000000
|
||||
Size.Width = 146.000000000000000000
|
||||
Size.Height = 22.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 4
|
||||
Text = #1057#1086#1079#1076#1072#1090#1100' '#1086#1087#1086#1074#1077#1097#1077#1085#1080#1077
|
||||
TextSettings.Trimming = None
|
||||
end
|
||||
inherited btnCreateOBSKandinsky: TButton
|
||||
Images = ImageList1
|
||||
ImageIndex = 5
|
||||
Position.X = 264.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
|
||||
object btnCreateChat: TButton
|
||||
Images = ImageList1
|
||||
@@ -498,6 +559,22 @@ object TTW_Bot: TTTW_Bot
|
||||
TextSettings.Trimming = None
|
||||
end
|
||||
end
|
||||
inline frPlayerWeb1: TfrPlayerWeb
|
||||
Position.X = 2.000000000000000000
|
||||
Position.Y = 353.000000000000000000
|
||||
Size.Width = 191.000000000000000000
|
||||
Size.Height = 96.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
inherited Label1: TLabel
|
||||
Size.Width = 171.000000000000000000
|
||||
Size.Height = 39.000000000000000000
|
||||
Text = #1057#1089#1099#1083#1082#1072' '#1076#1083#1103' OBS '#1044#1086#1082'-'#1087#1072#1085#1077#1083#1080' YouTube Player'
|
||||
end
|
||||
inherited Edit1: TEdit
|
||||
Position.Y = 69.000000000000000000
|
||||
Size.Width = 171.000000000000000000
|
||||
end
|
||||
end
|
||||
end
|
||||
object TabItem6: TTabItem
|
||||
CustomIcon = <
|
||||
@@ -586,7 +663,7 @@ object TTW_Bot: TTTW_Bot
|
||||
item
|
||||
end>
|
||||
TextSettings.Trimming = None
|
||||
IsSelected = True
|
||||
IsSelected = False
|
||||
ImageIndex = 23
|
||||
Size.Width = 101.000000000000000000
|
||||
Size.Height = 26.000000000000000000
|
||||
@@ -602,23 +679,34 @@ object TTW_Bot: TTTW_Bot
|
||||
Size.Height = 718.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
inherited GroupBox20: TGroupBox
|
||||
inherited edtMessage: TEdit
|
||||
TabOrder = 37
|
||||
end
|
||||
inherited edtInterval: TEdit
|
||||
TabOrder = 38
|
||||
end
|
||||
inherited btnAddMessage: TButton
|
||||
Images = ImageList1
|
||||
ImageIndex = 0
|
||||
TabOrder = 39
|
||||
end
|
||||
inherited btnRmMessage: TButton
|
||||
Images = ImageList1
|
||||
ImageIndex = 4
|
||||
TabOrder = 40
|
||||
end
|
||||
inherited btnEditMessage: TButton
|
||||
Images = ImageList1
|
||||
ImageIndex = 3
|
||||
TabOrder = 41
|
||||
end
|
||||
inherited btnNotifyTest: TButton
|
||||
Images = ImageList1
|
||||
ImageIndex = 25
|
||||
TabOrder = 42
|
||||
end
|
||||
inherited sgTimers: TStringGrid
|
||||
TabOrder = 43
|
||||
Viewport.Width = 463.000000000000000000
|
||||
Viewport.Height = 225.000000000000000000
|
||||
inherited scTimerMessage: TStringColumn
|
||||
@@ -630,19 +718,26 @@ object TTW_Bot: TTTW_Bot
|
||||
end
|
||||
end
|
||||
inherited GroupBox23: TGroupBox
|
||||
inherited edtBanWords: TEdit
|
||||
TabOrder = 37
|
||||
end
|
||||
inherited btnBanWordsAdd: TButton
|
||||
Images = ImageList1
|
||||
ImageIndex = 0
|
||||
TabOrder = 38
|
||||
end
|
||||
inherited btnBanWordsEdt: TButton
|
||||
Images = ImageList1
|
||||
ImageIndex = 3
|
||||
TabOrder = 39
|
||||
end
|
||||
inherited btnBanWordsDel: TButton
|
||||
Images = ImageList1
|
||||
ImageIndex = 4
|
||||
TabOrder = 40
|
||||
end
|
||||
inherited sgBanWords: TStringGrid
|
||||
TabOrder = 41
|
||||
Viewport.Width = 297.000000000000000000
|
||||
Viewport.Height = 225.000000000000000000
|
||||
inherited scRegEx: TStringColumn
|
||||
@@ -655,25 +750,26 @@ object TTW_Bot: TTTW_Bot
|
||||
Position.X = 217.000000000000000000
|
||||
Size.Width = 88.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 42
|
||||
end
|
||||
inherited Label6: TLabel
|
||||
TabOrder = 43
|
||||
end
|
||||
inherited edtBanWordsCheck: TEdit
|
||||
TabOrder = 44
|
||||
Size.Width = 201.000000000000000000
|
||||
end
|
||||
inherited Label7: TLabel
|
||||
TabOrder = 45
|
||||
end
|
||||
inherited lBanWordsCheck: TLabel
|
||||
TabOrder = 46
|
||||
end
|
||||
end
|
||||
inherited GroupBox17: TGroupBox
|
||||
inherited edtCounterName: TEdit
|
||||
TabOrder = 41
|
||||
end
|
||||
inherited edtCounterTrigger: TEdit
|
||||
TabOrder = 39
|
||||
end
|
||||
inherited edtCounterCount: TEdit
|
||||
TabOrder = 38
|
||||
end
|
||||
inherited btnCounterAdd: TButton
|
||||
Images = ImageList1
|
||||
ImageIndex = 0
|
||||
TabOrder = 40
|
||||
end
|
||||
inherited btnCounterDelete: TButton
|
||||
Images = ImageList1
|
||||
@@ -685,7 +781,7 @@ object TTW_Bot: TTTW_Bot
|
||||
ImageIndex = 0
|
||||
Position.X = 416.000000000000000000
|
||||
Size.Width = 22.000000000000000000
|
||||
TabOrder = 43
|
||||
TabOrder = 42
|
||||
Text = ''
|
||||
end
|
||||
inherited btnCounterM: TButton
|
||||
@@ -693,16 +789,16 @@ object TTW_Bot: TTTW_Bot
|
||||
ImageIndex = 12
|
||||
Position.X = 449.000000000000000000
|
||||
Size.Width = 22.000000000000000000
|
||||
TabOrder = 44
|
||||
TabOrder = 43
|
||||
Text = ''
|
||||
end
|
||||
inherited btnCounterEdit: TButton
|
||||
Images = ImageList1
|
||||
ImageIndex = 3
|
||||
TabOrder = 45
|
||||
TabOrder = 44
|
||||
end
|
||||
inherited sgCounter: TStringGrid
|
||||
TabOrder = 46
|
||||
TabOrder = 45
|
||||
Viewport.Width = 463.000000000000000000
|
||||
Viewport.Height = 121.000000000000000000
|
||||
inherited scCounterTrigger: TStringColumn
|
||||
@@ -778,6 +874,7 @@ object TTW_Bot: TTTW_Bot
|
||||
TabOrder = 1
|
||||
Text = #1055#1086#1076#1082#1083#1102#1095#1080#1090#1100#1089#1103
|
||||
TextSettings.Trimming = None
|
||||
OnClick = btnConnectingClick
|
||||
end
|
||||
object Label2: TLabel
|
||||
Position.X = 8.000000000000000000
|
||||
+1724
File diff suppressed because it is too large
Load Diff
@@ -86,6 +86,12 @@ object frCommands: TfrCommands
|
||||
inherited btnRmCommand: TButton
|
||||
OnClick = frContruct1btnRmCommandClick
|
||||
end
|
||||
object cbTextToSpeach: TCheckBox
|
||||
Position.X = 272.000000000000000000
|
||||
Position.Y = 8.000000000000000000
|
||||
TabOrder = 47
|
||||
Text = #1054#1079#1074#1091#1095#1082#1072' '#1087#1086#1089#1083#1077' !!!'
|
||||
end
|
||||
end
|
||||
end
|
||||
object GroupBox9: TGroupBox
|
||||
@@ -115,16 +121,16 @@ object frCommands: TfrCommands
|
||||
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
|
||||
TabOrder = 36
|
||||
end
|
||||
inherited Label4: TLabel
|
||||
TabOrder = 39
|
||||
TabOrder = 38
|
||||
end
|
||||
end
|
||||
end
|
||||
@@ -36,6 +36,7 @@ type
|
||||
frsgNeiro: TfrSimpleGrid;
|
||||
frContruct1: TfrContruct;
|
||||
frGroupsRequest1: TfrGroupsRequest;
|
||||
cbTextToSpeach: TCheckBox;
|
||||
procedure btnRandAddClick(Sender: TObject);
|
||||
procedure btnRandDelClick(Sender: TObject);
|
||||
procedure frsgSoundsbtnSoundDelClick(Sender: TObject);
|
||||
@@ -10,7 +10,7 @@ object frFontSettings: TfrFontSettings
|
||||
Size.PlatformDefault = False
|
||||
TextSettings.Trimming = None
|
||||
Text = #1056#1072#1079#1084#1077#1088' '#1096#1088#1080#1092#1090#1072
|
||||
TabOrder = 8
|
||||
TabOrder = 7
|
||||
end
|
||||
object sbFontSize: TSpinBox
|
||||
Touch.InteractiveGestures = [LongTap, DoubleTap]
|
||||
@@ -30,14 +30,14 @@ object frFontSettings: TfrFontSettings
|
||||
Size.Width = 120.000000000000000000
|
||||
Size.Height = 22.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 38
|
||||
TabOrder = 37
|
||||
end
|
||||
object Label49: TLabel
|
||||
Position.X = 116.000000000000000000
|
||||
Position.Y = 63.000000000000000000
|
||||
TextSettings.Trimming = None
|
||||
Text = #1062#1074#1077#1090' '#1096#1088#1080#1092#1090#1072
|
||||
TabOrder = 37
|
||||
TabOrder = 36
|
||||
end
|
||||
object cbFontStyleDefault: TComboBox
|
||||
Items.Strings = (
|
||||
+697
@@ -0,0 +1,697 @@
|
||||
unit fOBS;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils, System.Types, System.UITypes, System.Classes, uCustomEmoties,
|
||||
System.Variants, uWebServerChat, fColorSettings, System.Generics.Collections,
|
||||
FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
|
||||
System.Rtti, FMX.Grid.Style, FMX.Grid, FMX.ScrollBox, FMX.Edit, FMX.Colors,
|
||||
FMX.ListBox, FMX.EditBox, FMX.SpinBox, FMX.Controls.Presentation, uRecords,
|
||||
System.Generics.Defaults, fFontSettings;
|
||||
|
||||
type
|
||||
TChatWebServers = record
|
||||
port: integer;
|
||||
MaxMsg: integer;
|
||||
TimeMsg: integer;
|
||||
Freez: boolean;
|
||||
StyleBorderColor: string;
|
||||
StyleBlockColor: string;
|
||||
StyleBlockBorderSize: integer;
|
||||
StyleBlockPadding: integer;
|
||||
FontStyleDefault: string;
|
||||
FontColor: string;
|
||||
BColor: string;
|
||||
FontSize: integer;
|
||||
WebServerChat: TTTW_Chat;
|
||||
end;
|
||||
|
||||
type
|
||||
TfrOBS = class(TFrame)
|
||||
sgWebChats: TStringGrid;
|
||||
btnCreateOBSChat: TButton;
|
||||
btnDeleteeChat: TButton;
|
||||
Label1: TLabel;
|
||||
IntegerColumn1: TIntegerColumn;
|
||||
StringColumn1: TStringColumn;
|
||||
StringColumn2: TStringColumn;
|
||||
btnCreateOBSNotify: TButton;
|
||||
btnCreateOBSKandinsky: TButton;
|
||||
procedure btnDeleteeChatClick(Sender: TObject);
|
||||
procedure btnCreateOBSKandinskyClick(Sender: TObject);
|
||||
procedure btnCreateOBSChatClick(Sender: TObject);
|
||||
procedure btnCreateOBSNotifyClick(Sender: TObject);
|
||||
procedure sgWebChatsCellDblClick(const Column: TColumn; const Row: integer);
|
||||
private
|
||||
{ Private declarations }
|
||||
|
||||
function checkBttv(aMsg: string): string;
|
||||
function ReplaceEmotesInMessage(const MessageText,
|
||||
EmotesString: string): string;
|
||||
function FindEmoteByID(const ID: string): TEmotes;
|
||||
function GetBadgesHTML(Badges: string): string;
|
||||
public
|
||||
{ Public declarations }
|
||||
listChats: TArray<TOBSChat>;
|
||||
listNotify: TArray<TOBSNotify>;
|
||||
listKandinsky: TArray<TOBSKandinsky>;
|
||||
|
||||
BTTV: TBTTV;
|
||||
m7tv: t7tv;
|
||||
ChatBadges: Tlist<TChatBadge>;
|
||||
ChatEmotes: Tlist<TEmotes>;
|
||||
ChatWebServers: Tlist<TChatWebServers>;
|
||||
procedure MsgToWebServer(const aRecord: TTwitchChatMessage);
|
||||
procedure CreateWebChat(chatSettings: TOBSChat);
|
||||
procedure UpdateGridFromArray;
|
||||
procedure AddChat(newRecord: TOBSChat);
|
||||
procedure EdtChat(newRecord: TOBSChat; oldPort: integer);
|
||||
procedure DelChat(aPort: integer);
|
||||
|
||||
procedure AddNotify(newRecord: TOBSNotify);
|
||||
procedure EdtNotify(newRecord: TOBSNotify; oldPort: integer);
|
||||
procedure DelNotify(aPort: integer);
|
||||
|
||||
procedure AddKandinsky(newRecord: TOBSKandinsky);
|
||||
procedure DelKandinsky(aPort: integer);
|
||||
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.fmx}
|
||||
|
||||
uses uGeneral, uCreateChat, uCreateNotify;
|
||||
|
||||
{ TfrOBS }
|
||||
|
||||
function TfrOBS.checkBttv(aMsg: string): string;
|
||||
var
|
||||
Words: tstringlist;
|
||||
i: integer;
|
||||
CurrentWord, Url: string;
|
||||
begin
|
||||
Words := tstringlist.Create;
|
||||
try
|
||||
// Ðàçáèâàåì ñòðîêó íà ñëîâà ïî ïðîáåëàì
|
||||
Words.Delimiter := ' ';
|
||||
Words.StrictDelimiter := True; // Èãíîðèðîâàòü ïîâòîðÿþùèåñÿ ïðîáåëû
|
||||
Words.DelimitedText := aMsg;
|
||||
|
||||
// Îáðàáîòêà ñëîâ
|
||||
for i := 0 to Words.Count - 1 do
|
||||
begin
|
||||
CurrentWord := Words[i];
|
||||
Url := BTTV.generateURL(CurrentWord);
|
||||
if Url = '' then
|
||||
Url := m7tv.generateURL(CurrentWord);
|
||||
if Url <> '' then
|
||||
Words[i] := Format('<img src="%s" width="18" height="18">', [Url]);
|
||||
end;
|
||||
|
||||
// Ñîáèðàåì ðåçóëüòàò
|
||||
result := Words.text;
|
||||
finally
|
||||
Words.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TfrOBS.FindEmoteByID(const ID: string): TEmotes;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
result.ID := '';
|
||||
if not Assigned(ChatEmotes) then
|
||||
exit;
|
||||
|
||||
for i := 0 to ChatEmotes.Count - 1 do
|
||||
if ChatEmotes[i].ID = ID then
|
||||
begin
|
||||
result := ChatEmotes[i];
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TfrOBS.ReplaceEmotesInMessage(const MessageText,
|
||||
EmotesString: string): string;
|
||||
type
|
||||
TEmotePosition = record
|
||||
StartPos: integer;
|
||||
EndPos: integer;
|
||||
ImageURL: string;
|
||||
end;
|
||||
var
|
||||
Positions: Tlist<TEmotePosition>;
|
||||
i, ColonPos: integer;
|
||||
Parts, EmoteData, Ranges: tstringlist;
|
||||
EmoteID, RangeStr: string;
|
||||
StartPos, EndPos: integer;
|
||||
Emote: TEmotes;
|
||||
begin
|
||||
result := MessageText;
|
||||
if EmotesString.IsEmpty then
|
||||
exit;
|
||||
|
||||
Parts := tstringlist.Create;
|
||||
EmoteData := tstringlist.Create;
|
||||
Ranges := tstringlist.Create;
|
||||
Positions := Tlist<TEmotePosition>.Create;
|
||||
try
|
||||
Parts.Delimiter := '/';
|
||||
Parts.StrictDelimiter := True;
|
||||
Parts.DelimitedText := EmotesString;
|
||||
|
||||
for i := 0 to Parts.Count - 1 do
|
||||
begin
|
||||
ColonPos := Pos(':', Parts[i]);
|
||||
if ColonPos = 0 then
|
||||
Continue;
|
||||
|
||||
EmoteID := Copy(Parts[i], 1, ColonPos - 1);
|
||||
RangeStr := Copy(Parts[i], ColonPos + 1, MaxInt);
|
||||
|
||||
Ranges.Clear;
|
||||
Ranges.Delimiter := ',';
|
||||
Ranges.StrictDelimiter := True;
|
||||
Ranges.DelimitedText := RangeStr;
|
||||
|
||||
Emote := FindEmoteByID(EmoteID);
|
||||
if Emote.ID = '' then
|
||||
Continue;
|
||||
|
||||
for var j := 0 to Ranges.Count - 1 do
|
||||
begin
|
||||
EmoteData.Clear;
|
||||
EmoteData.Delimiter := '-';
|
||||
EmoteData.StrictDelimiter := True;
|
||||
EmoteData.DelimitedText := Ranges[j];
|
||||
if EmoteData.Count <> 2 then
|
||||
Continue;
|
||||
|
||||
if TryStrToInt(EmoteData[0], StartPos) and
|
||||
TryStrToInt(EmoteData[1], EndPos) then
|
||||
begin
|
||||
var
|
||||
EmotePosition: TEmotePosition;
|
||||
EmotePosition.StartPos := StartPos;
|
||||
EmotePosition.EndPos := EndPos;
|
||||
EmotePosition.ImageURL := Emote.images.Url1x;
|
||||
|
||||
Positions.Add(EmotePosition);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Positions.Sort(TComparer<TEmotePosition>.Construct(
|
||||
function(const Left, Right: TEmotePosition): integer
|
||||
begin
|
||||
result := Right.StartPos - Left.StartPos;
|
||||
end));
|
||||
|
||||
var
|
||||
SB := TStringBuilder.Create(MessageText);
|
||||
try
|
||||
for var Pos in Positions do
|
||||
begin
|
||||
if (Pos.StartPos < 0) or (Pos.EndPos >= SB.Length) or
|
||||
(Pos.StartPos > Pos.EndPos) then
|
||||
Continue;
|
||||
|
||||
var
|
||||
Replacement := Format('<img src="%s" width="18" height="18">',
|
||||
[Pos.ImageURL]);
|
||||
|
||||
SB.Remove(Pos.StartPos, Pos.EndPos - Pos.StartPos + 1);
|
||||
SB.Insert(Pos.StartPos, Replacement);
|
||||
end;
|
||||
result := SB.ToString;
|
||||
finally
|
||||
SB.Free;
|
||||
end;
|
||||
finally
|
||||
Parts.Free;
|
||||
EmoteData.Free;
|
||||
Ranges.Free;
|
||||
Positions.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TfrOBS.GetBadgesHTML(Badges: string): string;
|
||||
var
|
||||
BadgeList: TArray<string>;
|
||||
CodeParts: TArray<string>;
|
||||
CurrentCode, SetId, VersionId: string;
|
||||
Badge: TChatBadge;
|
||||
Version: TBadgeVersion;
|
||||
Found: boolean;
|
||||
begin
|
||||
// Ðàçáèâàåì ñòðîêó íà îòäåëüíûå áåéäæ-êîäû
|
||||
BadgeList := Badges.Split([',']);
|
||||
|
||||
for CurrentCode in BadgeList do
|
||||
begin
|
||||
// Ðàçäåëÿåì SetId è VersionId
|
||||
CodeParts := CurrentCode.Split(['/']);
|
||||
if Length(CodeParts) <> 2 then
|
||||
Continue;
|
||||
|
||||
SetId := CodeParts[0];
|
||||
VersionId := CodeParts[1];
|
||||
Found := false;
|
||||
|
||||
// Èùåì ñîîòâåòñòâóþùèé áåéäæ
|
||||
for Badge in ChatBadges do
|
||||
begin
|
||||
if Badge.SetId = SetId then
|
||||
begin
|
||||
// Èùåì íóæíóþ âåðñèþ
|
||||
for Version in Badge.Versions do
|
||||
begin
|
||||
if Version.ID = VersionId then
|
||||
begin
|
||||
// Ôîðìèðóåì HTML-òåã
|
||||
result := result +
|
||||
Format(' <img src="%s" width=18 height=18 alt="%s" title="%s">',
|
||||
[Version.ImageUrl1x, Version.Title, Version.Description]);
|
||||
Found := True;
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
if Found then
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
|
||||
// Åñëè íå íàøëè - äîáàâëÿåì çàãëóøêó
|
||||
if not Found then
|
||||
result := result + ' <img src="placeholder.png" width=18 height=18>';
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrOBS.MsgToWebServer(const aRecord: TTwitchChatMessage);
|
||||
var
|
||||
s: string;
|
||||
ms: TStyleChat;
|
||||
i: integer;
|
||||
begin
|
||||
s := checkBttv(aRecord.Message);
|
||||
if aRecord.Emotes <> '' then
|
||||
s := ReplaceEmotesInMessage(s, aRecord.Emotes);
|
||||
|
||||
ms.Nick := GetBadgesHTML(aRecord.Badges) + '<span class="nick" style="color:'
|
||||
+ aRecord.Color + '">' + aRecord.DisplayName + '</span>';
|
||||
ms.Context := '<span class="text">' + s + '</span>';
|
||||
|
||||
for i := 0 to ChatWebServers.Count - 1 do
|
||||
begin
|
||||
ms.FontColor := ChatWebServers[i].FontColor;
|
||||
ms.FontSize := ChatWebServers[i].FontSize;
|
||||
ms.FontFamily := '''' + ChatWebServers[i].FontStyleDefault + ''';';
|
||||
ms.FontFamily := StringReplace(ms.FontFamily, '.ttf', '', [rfReplaceAll]);
|
||||
ms.BlockColor := ChatWebServers[i].StyleBlockColor;
|
||||
ms.BlockPadding := ChatWebServers[i].StyleBlockPadding;
|
||||
ms.MaxMsgCount := ChatWebServers[i].MaxMsg;
|
||||
ms.TimeMsg := ChatWebServers[i].TimeMsg;
|
||||
ms.BorderSize := ChatWebServers[i].StyleBlockBorderSize;
|
||||
ms.BorderColor := ChatWebServers[i].StyleBorderColor;
|
||||
ms.BColor := ChatWebServers[i].BColor;
|
||||
ChatWebServers[i].WebServerChat.AddMessage(ms);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrOBS.AddChat(newRecord: TOBSChat);
|
||||
begin
|
||||
SetLength(listChats, Length(listChats) + 1);
|
||||
listChats[High(listChats)] := newRecord;
|
||||
UpdateGridFromArray;
|
||||
db.SaveRecordArray<TOBSChat>('listChats', listChats);
|
||||
CreateWebChat(newRecord);
|
||||
end;
|
||||
|
||||
procedure TfrOBS.AddKandinsky(newRecord: TOBSKandinsky);
|
||||
begin
|
||||
SetLength(listKandinsky, Length(listKandinsky) + 1);
|
||||
listKandinsky[High(listKandinsky)] := newRecord;
|
||||
UpdateGridFromArray;
|
||||
db.SaveRecordArray<TOBSKandinsky>('listKandinsky', listKandinsky);
|
||||
end;
|
||||
|
||||
procedure TfrOBS.AddNotify(newRecord: TOBSNotify);
|
||||
begin
|
||||
SetLength(listNotify, Length(listNotify) + 1);
|
||||
listNotify[High(listNotify)] := newRecord;
|
||||
UpdateGridFromArray;
|
||||
db.SaveRecordArray<TOBSNotify>('listNotify', listNotify);
|
||||
end;
|
||||
|
||||
procedure TfrOBS.btnCreateOBSChatClick(Sender: TObject);
|
||||
var
|
||||
dport, i: integer;
|
||||
begin
|
||||
dport := 8080;
|
||||
for i := 0 to sgWebChats.RowCount - 1 do
|
||||
begin
|
||||
if strtoint(sgWebChats.Cells[0, i]) >= dport then
|
||||
dport := strtoint(sgWebChats.Cells[0, i]) + 1;
|
||||
end;
|
||||
fCreateChat.sbWebServerPort.Value := dport;
|
||||
fCreateChat.isEdit := false;
|
||||
fCreateChat.Show;
|
||||
end;
|
||||
|
||||
procedure TfrOBS.btnCreateOBSKandinskyClick(Sender: TObject);
|
||||
var
|
||||
dport: integer;
|
||||
i: integer;
|
||||
rk: TOBSKandinsky;
|
||||
begin
|
||||
dport := 8080;
|
||||
for i := 0 to sgWebChats.RowCount - 1 do
|
||||
begin
|
||||
if strtoint(sgWebChats.Cells[0, i]) >= dport then
|
||||
dport := strtoint(sgWebChats.Cells[0, i]) + 1;
|
||||
end;
|
||||
rk.port := dport;
|
||||
AddKandinsky(rk);
|
||||
|
||||
end;
|
||||
|
||||
procedure TfrOBS.btnCreateOBSNotifyClick(Sender: TObject);
|
||||
var
|
||||
dport, i: integer;
|
||||
begin
|
||||
dport := 8080;
|
||||
for i := 0 to sgWebChats.RowCount - 1 do
|
||||
begin
|
||||
if strtoint(sgWebChats.Cells[0, i]) >= dport then
|
||||
dport := strtoint(sgWebChats.Cells[0, i]) + 1;
|
||||
end;
|
||||
fCreateNotify.sbWebServerPort.Value := dport;
|
||||
fCreateNotify.isEdit := false;
|
||||
fCreateNotify.Show;
|
||||
end;
|
||||
|
||||
procedure TfrOBS.btnDeleteeChatClick(Sender: TObject);
|
||||
begin
|
||||
if sgWebChats.Cells[1, sgWebChats.Row] = '×àò' then
|
||||
begin
|
||||
DelChat(strtoint(sgWebChats.Cells[0, sgWebChats.Row]));
|
||||
end;
|
||||
if sgWebChats.Cells[1, sgWebChats.Row] = 'Kandinsky' then
|
||||
begin
|
||||
DelKandinsky(strtoint(sgWebChats.Cells[0, sgWebChats.Row]));
|
||||
end;
|
||||
if sgWebChats.Cells[1, sgWebChats.Row] = 'Îïîâåùåíèå' then
|
||||
begin
|
||||
DelNotify(strtoint(sgWebChats.Cells[0, sgWebChats.Row]));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrOBS.CreateWebChat(chatSettings: TOBSChat);
|
||||
var
|
||||
ChatWebServer: TChatWebServers;
|
||||
fonts: tstringlist;
|
||||
f: TfrColorSettings;
|
||||
t: TfrFontSettings;
|
||||
procedure LoadFontList(const mySL: tstringlist);
|
||||
var
|
||||
SearchRec: TSearchRec;
|
||||
n: integer;
|
||||
begin
|
||||
if not DirectoryExists(myConst.fontsPath) then
|
||||
CreateDir(myConst.fontsPath);
|
||||
|
||||
n := 1;
|
||||
if FindFirst(IncludeTrailingPathDelimiter(myConst.fontsPath) + '*.*',
|
||||
faArchive, SearchRec) = 0 then
|
||||
try
|
||||
repeat
|
||||
if (SearchRec.Attr and faAnyFile) = SearchRec.Attr then
|
||||
begin
|
||||
mySL.Add(SearchRec.Name);
|
||||
Inc(n);
|
||||
end;
|
||||
until FindNext(SearchRec) <> 0;
|
||||
finally
|
||||
System.SysUtils.FindClose(SearchRec);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
fonts := tstringlist.Create;
|
||||
f := TfrColorSettings.Create(self);
|
||||
t := TfrFontSettings.Create(self);
|
||||
try
|
||||
LoadFontList(fonts);
|
||||
ChatWebServer.WebServerChat := TTTW_Chat.Create(fonts, chatSettings.port,
|
||||
f.ccbBColor.Items[chatSettings.ColorBackground]);
|
||||
ChatWebServer.port := chatSettings.port;
|
||||
ChatWebServer.MaxMsg := chatSettings.MaxCountMess;
|
||||
ChatWebServer.TimeMsg := chatSettings.TimeMess;
|
||||
ChatWebServer.Freez := chatSettings.Freez = 1;
|
||||
ChatWebServer.StyleBorderColor := f.ccbStyleBorderColor.Items
|
||||
[chatSettings.ColorBorder];
|
||||
ChatWebServer.StyleBlockColor := chatSettings.ColorBlock;
|
||||
ChatWebServer.StyleBlockBorderSize := chatSettings.SolidBorder;
|
||||
ChatWebServer.StyleBlockPadding := chatSettings.Paddings;
|
||||
ChatWebServer.FontStyleDefault := t.cbFontStyleDefault.Items
|
||||
[chatSettings.StyleFont];
|
||||
ChatWebServer.FontColor := t.ccbFontColor.Items[chatSettings.ColorFont];
|
||||
ChatWebServer.BColor := f.ccbBColor.Items[chatSettings.ColorBorder];;
|
||||
ChatWebServer.FontSize := chatSettings.SizeFont;
|
||||
ChatWebServers.Add(ChatWebServer);
|
||||
|
||||
ChatWebServers[ChatWebServers.Count - 1].WebServerChat.ActiveServer(True);
|
||||
ChatWebServers[ChatWebServers.Count - 1].WebServerChat.SetDeleteMode
|
||||
(not ChatWebServer.Freez, ChatWebServer.MaxMsg);
|
||||
|
||||
finally
|
||||
fonts.Free;
|
||||
f.Free;
|
||||
t.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrOBS.DelChat(aPort: integer);
|
||||
var
|
||||
i, j: integer;
|
||||
begin
|
||||
// Èùåì â îáðàòíîì ïîðÿäêå äëÿ áåçîïàñíîãî óäàëåíèÿ
|
||||
for i := High(listChats) downto 0 do
|
||||
begin
|
||||
if listChats[i].port = aPort then
|
||||
begin
|
||||
// Ñäâèãàåì ýëåìåíòû ìàññèâà
|
||||
for j := i to High(listChats) - 1 do
|
||||
listChats[j] := listChats[j + 1];
|
||||
// Óìåíüøàåì ðàçìåð ìàññèâà
|
||||
SetLength(listChats, Length(listChats) - 1);
|
||||
// Âûõîäèì ïîñëå ïåðâîãî íàéäåííîãî ñîâïàäåíèÿ (ïðåäïîëàãàåì óíèêàëüíîñòü ïîðòîâ)
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
ChatWebServers[i].WebServerChat.ActiveServer(false);
|
||||
ChatWebServers[i].WebServerChat.Destroy;
|
||||
ChatWebServers.Delete(i);
|
||||
db.SaveRecordArray<TOBSChat>('listChats', listChats);
|
||||
UpdateGridFromArray;
|
||||
end;
|
||||
|
||||
procedure TfrOBS.DelKandinsky(aPort: integer);
|
||||
var
|
||||
i, j: integer;
|
||||
begin
|
||||
// Èùåì â îáðàòíîì ïîðÿäêå äëÿ áåçîïàñíîãî óäàëåíèÿ
|
||||
for i := High(listKandinsky) downto 0 do
|
||||
begin
|
||||
if listKandinsky[i].port = aPort then
|
||||
begin
|
||||
// Ñäâèãàåì ýëåìåíòû ìàññèâà
|
||||
for j := i to High(listKandinsky) - 1 do
|
||||
listKandinsky[j] := listKandinsky[j + 1];
|
||||
// Óìåíüøàåì ðàçìåð ìàññèâà
|
||||
SetLength(listKandinsky, Length(listKandinsky) - 1);
|
||||
// Âûõîäèì ïîñëå ïåðâîãî íàéäåííîãî ñîâïàäåíèÿ (ïðåäïîëàãàåì óíèêàëüíîñòü ïîðòîâ)
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
UpdateGridFromArray;
|
||||
db.SaveRecordArray<TOBSKandinsky>('listKandinsky', listKandinsky);
|
||||
end;
|
||||
|
||||
procedure TfrOBS.DelNotify(aPort: integer);
|
||||
var
|
||||
i, j: integer;
|
||||
begin
|
||||
// Èùåì â îáðàòíîì ïîðÿäêå äëÿ áåçîïàñíîãî óäàëåíèÿ
|
||||
for i := High(listNotify) downto 0 do
|
||||
begin
|
||||
if listNotify[i].port = aPort then
|
||||
begin
|
||||
// Ñäâèãàåì ýëåìåíòû ìàññèâà
|
||||
for j := i to High(listNotify) - 1 do
|
||||
listNotify[j] := listNotify[j + 1];
|
||||
// Óìåíüøàåì ðàçìåð ìàññèâà
|
||||
SetLength(listNotify, Length(listNotify) - 1);
|
||||
// Âûõîäèì ïîñëå ïåðâîãî íàéäåííîãî ñîâïàäåíèÿ (ïðåäïîëàãàåì óíèêàëüíîñòü ïîðòîâ)
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
|
||||
UpdateGridFromArray;
|
||||
db.SaveRecordArray<TOBSNotify>('listNotify', listNotify);
|
||||
end;
|
||||
|
||||
procedure TfrOBS.EdtChat(newRecord: TOBSChat; oldPort: integer);
|
||||
var
|
||||
i, j: integer;
|
||||
chatWeb: TChatWebServers; // Âðåìåííàÿ ïåðåìåííàÿ äëÿ çàïèñè
|
||||
f: TfrColorSettings;
|
||||
t: TfrFontSettings;
|
||||
begin
|
||||
f := TfrColorSettings.Create(self);
|
||||
t := TfrFontSettings.Create(self);
|
||||
try
|
||||
// Îáíîâëÿåì çàïèñü â listChats
|
||||
for i := 0 to High(listChats) do
|
||||
if listChats[i].port = oldPort then
|
||||
begin
|
||||
listChats[i] := newRecord;
|
||||
Break;
|
||||
end;
|
||||
|
||||
// Îáíîâëÿåì ñîîòâåòñòâóþùèé ñåðâåð â ChatWebServers
|
||||
for j := 0 to ChatWebServers.Count - 1 do
|
||||
begin
|
||||
// 1. Èçâëåêàåì çàïèñü âî âðåìåííóþ ïåðåìåííóþ
|
||||
chatWeb := ChatWebServers[j];
|
||||
|
||||
if chatWeb.port = oldPort then
|
||||
begin
|
||||
// 2. Ìîäèôèöèðóåì ïîëÿ çàïèñè
|
||||
chatWeb.MaxMsg := newRecord.MaxCountMess;
|
||||
chatWeb.TimeMsg := newRecord.TimeMess;
|
||||
chatWeb.Freez := newRecord.Freez = 1;
|
||||
chatWeb.StyleBorderColor := f.ccbStyleBorderColor.Items[newRecord.ColorBorder];
|
||||
chatWeb.StyleBlockColor := newRecord.ColorBlock;
|
||||
chatWeb.StyleBlockBorderSize := newRecord.SolidBorder;
|
||||
chatWeb.StyleBlockPadding := newRecord.Paddings;
|
||||
chatWeb.FontStyleDefault := t.cbFontStyleDefault.Items[newRecord.StyleFont];
|
||||
chatWeb.FontColor := t.ccbFontColor.Items[newRecord.ColorFont];
|
||||
chatWeb.FontSize := newRecord.SizeFont;
|
||||
chatWeb.BColor := f.ccbBColor.Items[newRecord.ColorBackground];
|
||||
chatWeb.WebServerChat.changeBackground(f.ccbBColor.Items[newRecord.ColorBackground]);
|
||||
chatWeb.WebServerChat.SetDeleteMode(not chatWeb.Freez, chatWeb.MaxMsg);
|
||||
|
||||
// 4. Âîçâðàùàåì ìîäèôèöèðîâàííóþ çàïèñü â ñïèñîê
|
||||
ChatWebServers[j] := chatWeb;
|
||||
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
|
||||
UpdateGridFromArray;
|
||||
db.SaveRecordArray<TOBSChat>('listChats', listChats);
|
||||
finally
|
||||
f.Free;
|
||||
t.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrOBS.EdtNotify(newRecord: TOBSNotify; oldPort: integer);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
for i := 0 to High(listNotify) do
|
||||
if listNotify[i].port = oldPort then
|
||||
begin
|
||||
listNotify[i] := newRecord;
|
||||
UpdateGridFromArray;
|
||||
db.SaveRecordArray<TOBSNotify>('listNotify', listNotify);
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrOBS.sgWebChatsCellDblClick(const Column: TColumn;
|
||||
const Row: integer);
|
||||
var
|
||||
myChatRec: TOBSChat;
|
||||
myNotifyRec: TOBSNotify;
|
||||
i: integer;
|
||||
begin
|
||||
if sgWebChats.Cells[1, Row] = 'Îïîâåùåíèå' then
|
||||
begin
|
||||
for i := 0 to High(listNotify) do
|
||||
if listNotify[i].port = (strtoint(sgWebChats.Cells[0, Row])) then
|
||||
begin
|
||||
myNotifyRec := listNotify[i];
|
||||
Break;
|
||||
end;
|
||||
|
||||
fCreateNotify.isEdit := True;
|
||||
fCreateNotify.setRecord(myNotifyRec);
|
||||
fCreateNotify.Show;
|
||||
end;
|
||||
if sgWebChats.Cells[1, Row] = '×àò' then
|
||||
begin
|
||||
for i := 0 to High(listChats) do
|
||||
if listChats[i].port = (strtoint(sgWebChats.Cells[0, Row])) then
|
||||
begin
|
||||
myChatRec := listChats[i];
|
||||
Break;
|
||||
end;
|
||||
fCreateChat.isEdit := True;
|
||||
fCreateChat.setRecord(myChatRec);
|
||||
fCreateChat.Show;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrOBS.UpdateGridFromArray;
|
||||
var
|
||||
i, rowIndex: integer;
|
||||
begin
|
||||
sgWebChats.BeginUpdate;
|
||||
try
|
||||
sgWebChats.RowCount := 0; // Ñáðàñûâàåì ñòðîêè
|
||||
|
||||
rowIndex := 0; // Îòäåëüíûé ñ÷åò÷èê äëÿ ñòðîê ñåòêè
|
||||
|
||||
// listChats
|
||||
for i := 0 to High(listChats) do
|
||||
begin
|
||||
sgWebChats.RowCount := rowIndex + 1;
|
||||
sgWebChats.Cells[0, rowIndex] := inttostr(listChats[i].port);
|
||||
sgWebChats.Cells[1, rowIndex] := '×àò';
|
||||
sgWebChats.Cells[2, rowIndex] := 'http://127.0.0.1:' +
|
||||
inttostr(listChats[i].port);
|
||||
Inc(rowIndex); // Óâåëè÷èâàåì ñ÷åò÷èê ñòðîê
|
||||
end;
|
||||
|
||||
// listNotify
|
||||
for i := 0 to High(listNotify) do
|
||||
begin
|
||||
sgWebChats.RowCount := rowIndex + 1;
|
||||
sgWebChats.Cells[0, rowIndex] := inttostr(listNotify[i].port);
|
||||
sgWebChats.Cells[1, rowIndex] := 'Îïîâåùåíèå';
|
||||
sgWebChats.Cells[2, rowIndex] := 'http://127.0.0.1:' +
|
||||
inttostr(listNotify[i].port);
|
||||
Inc(rowIndex); // Óâåëè÷èâàåì ñ÷åò÷èê ñòðîê
|
||||
end;
|
||||
|
||||
// listKandinsky
|
||||
for i := 0 to High(listKandinsky) do
|
||||
begin
|
||||
sgWebChats.RowCount := rowIndex + 1;
|
||||
sgWebChats.Cells[0, rowIndex] := inttostr(listKandinsky[i].port);
|
||||
sgWebChats.Cells[1, rowIndex] := 'Kandinsky';
|
||||
sgWebChats.Cells[2, rowIndex] := 'http://127.0.0.1:' +
|
||||
inttostr(listKandinsky[i].port);
|
||||
Inc(rowIndex); // Óâåëè÷èâàåì ñ÷åò÷èê ñòðîê
|
||||
end;
|
||||
finally
|
||||
sgWebChats.EndUpdate;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,35 @@
|
||||
object frPlayerWeb: TfrPlayerWeb
|
||||
Size.Width = 207.000000000000000000
|
||||
Size.Height = 76.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
object Label1: TLabel
|
||||
Align = Top
|
||||
Margins.Left = 10.000000000000000000
|
||||
Margins.Top = 10.000000000000000000
|
||||
Margins.Right = 10.000000000000000000
|
||||
Margins.Bottom = 10.000000000000000000
|
||||
Position.X = 10.000000000000000000
|
||||
Position.Y = 10.000000000000000000
|
||||
Size.Width = 187.000000000000000000
|
||||
Size.Height = 17.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
Text = #1057#1089#1099#1083#1082#1072' '#1076#1083#1103' OBS '#1044#1086#1082'-'#1087#1072#1085#1077#1083#1080
|
||||
TabOrder = 3
|
||||
end
|
||||
object Edit1: TEdit
|
||||
Touch.InteractiveGestures = [LongTap, DoubleTap]
|
||||
Align = Top
|
||||
TabOrder = 2
|
||||
ReadOnly = True
|
||||
Text = 'http://127.0.0.1:8088'
|
||||
Position.X = 10.000000000000000000
|
||||
Position.Y = 47.000000000000000000
|
||||
Margins.Left = 10.000000000000000000
|
||||
Margins.Top = 10.000000000000000000
|
||||
Margins.Right = 10.000000000000000000
|
||||
Margins.Bottom = 10.000000000000000000
|
||||
Size.Width = 187.000000000000000000
|
||||
Size.Height = 22.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
end
|
||||
end
|
||||
@@ -0,0 +1,58 @@
|
||||
unit fPlayerWeb;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils, System.Types, System.UITypes, System.Classes,
|
||||
System.Variants, FMX.Styles, IdHTTPWebBrokerBridge, IdGlobal, Web.HTTPApp,
|
||||
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,
|
||||
FMX.Controls.Presentation, FMX.Layouts, FMX.ListBox, uPlayerThread,
|
||||
bass_simple, FMX.Memo.Types, FMX.ScrollBox, FMX.Memo, FMX.Edit;
|
||||
|
||||
type
|
||||
TfrPlayerWeb = class(TFrame)
|
||||
Label1: TLabel;
|
||||
Edit1: TEdit;
|
||||
|
||||
private
|
||||
mp: TBassSimple;
|
||||
Player: TPlayerThread;
|
||||
FServer: TIdHTTPWebBrokerBridge;
|
||||
procedure StartServer;
|
||||
public
|
||||
procedure init;
|
||||
destructor Destoy(Sender: TObject; var Action: TCloseAction);
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.fmx}
|
||||
|
||||
destructor TfrPlayerWeb.Destoy(Sender: TObject; var Action: TCloseAction);
|
||||
begin
|
||||
FServer.Active := False;
|
||||
FServer.Bindings.Clear;
|
||||
Player.Free;
|
||||
mp.Free;
|
||||
end;
|
||||
|
||||
procedure TfrPlayerWeb.init;
|
||||
begin
|
||||
|
||||
FServer := TIdHTTPWebBrokerBridge.Create(Self);
|
||||
StartServer;
|
||||
end;
|
||||
|
||||
procedure TfrPlayerWeb.StartServer;
|
||||
begin
|
||||
if not FServer.Active then
|
||||
begin
|
||||
FServer.Bindings.Clear;
|
||||
FServer.DefaultPort := 8088;
|
||||
FServer.Active := True;
|
||||
end;
|
||||
|
||||
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -63,6 +63,7 @@ object frSettings: TfrSettings
|
||||
Size.Width = 177.000000000000000000
|
||||
Size.Height = 21.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
OnExit = edtChannelExit
|
||||
Left = 11
|
||||
Top = 43
|
||||
end
|
||||
@@ -75,6 +76,7 @@ object frSettings: TfrSettings
|
||||
Size.Width = 177.000000000000000000
|
||||
Size.Height = 21.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
OnExit = edtChannelExit
|
||||
Left = 11
|
||||
Top = 89
|
||||
end
|
||||
@@ -86,6 +88,7 @@ object frSettings: TfrSettings
|
||||
Size.Width = 177.000000000000000000
|
||||
Size.Height = 21.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
OnExit = edtChannelExit
|
||||
Left = 11
|
||||
Top = 181
|
||||
end
|
||||
@@ -112,6 +115,7 @@ object frSettings: TfrSettings
|
||||
Size.Width = 177.000000000000000000
|
||||
Size.Height = 21.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
OnExit = edtChannelExit
|
||||
Left = 11
|
||||
Top = 135
|
||||
end
|
||||
@@ -134,7 +138,7 @@ object frSettings: TfrSettings
|
||||
Size.Width = 128.000000000000000000
|
||||
Size.Height = 22.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 33
|
||||
TabOrder = 31
|
||||
Text = #1054#1090#1082#1088#1099#1090#1100' '#1089#1090#1088#1080#1084
|
||||
TextSettings.Trimming = None
|
||||
OnClick = btnOpenStreamClick
|
||||
@@ -145,20 +149,21 @@ object frSettings: TfrSettings
|
||||
Size.Width = 128.000000000000000000
|
||||
Size.Height = 22.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 34
|
||||
TabOrder = 32
|
||||
Text = #1055#1086#1083#1091#1095#1080#1090#1100' Token'
|
||||
TextSettings.Trimming = None
|
||||
OnClick = btnGetTokenStreamerClick
|
||||
end
|
||||
object edtBotTokenStreamer: TEdit
|
||||
Touch.InteractiveGestures = [LongTap, DoubleTap]
|
||||
TabOrder = 35
|
||||
TabOrder = 34
|
||||
Password = True
|
||||
Position.X = 8.000000000000000000
|
||||
Position.Y = 146.000000000000000000
|
||||
Size.Width = 177.000000000000000000
|
||||
Size.Height = 22.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
OnExit = edtChannelExit
|
||||
end
|
||||
object Label53: TLabel
|
||||
Position.X = 8.000000000000000000
|
||||
@@ -178,6 +183,7 @@ object frSettings: TfrSettings
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 4
|
||||
Text = #1040#1074#1090#1086#1087#1086#1076#1082#1083#1102#1095#1077#1085#1080#1077
|
||||
OnExit = edtChannelExit
|
||||
end
|
||||
end
|
||||
object GroupBox22: TGroupBox
|
||||
@@ -191,7 +197,7 @@ object frSettings: TfrSettings
|
||||
object btnDAGetCode: TButton
|
||||
Position.X = 200.000000000000000000
|
||||
Position.Y = 216.000000000000000000
|
||||
TabOrder = 43
|
||||
TabOrder = 40
|
||||
Text = #1055#1086#1083#1091#1095#1080#1090#1100
|
||||
TextSettings.Trimming = None
|
||||
OnClick = btnDAGetCodeClick
|
||||
@@ -201,55 +207,58 @@ object frSettings: TfrSettings
|
||||
Position.Y = 24.000000000000000000
|
||||
TextSettings.Trimming = None
|
||||
Text = 'Client ID'
|
||||
TabOrder = 35
|
||||
TabOrder = 33
|
||||
end
|
||||
object edtDAClientID: TEdit
|
||||
Touch.InteractiveGestures = [LongTap, DoubleTap]
|
||||
TabOrder = 39
|
||||
TabOrder = 35
|
||||
Password = True
|
||||
Position.X = 8.000000000000000000
|
||||
Position.Y = 49.000000000000000000
|
||||
Size.Width = 272.000000000000000000
|
||||
Size.Height = 22.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
OnExit = edtChannelExit
|
||||
end
|
||||
object Label64: TLabel
|
||||
Position.X = 8.000000000000000000
|
||||
Position.Y = 79.000000000000000000
|
||||
TextSettings.Trimming = None
|
||||
Text = 'Client Secret'
|
||||
TabOrder = 36
|
||||
TabOrder = 34
|
||||
end
|
||||
object edtDAClientSecret: TEdit
|
||||
Touch.InteractiveGestures = [LongTap, DoubleTap]
|
||||
TabOrder = 38
|
||||
TabOrder = 36
|
||||
Password = True
|
||||
Position.X = 8.000000000000000000
|
||||
Position.Y = 104.000000000000000000
|
||||
Size.Width = 272.000000000000000000
|
||||
Size.Height = 22.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
OnExit = edtChannelExit
|
||||
end
|
||||
object Label65: TLabel
|
||||
Position.X = 8.000000000000000000
|
||||
Position.Y = 134.000000000000000000
|
||||
TextSettings.Trimming = None
|
||||
Text = 'Redirect URL'
|
||||
TabOrder = 40
|
||||
TabOrder = 38
|
||||
end
|
||||
object edtDARedirectURL: TEdit
|
||||
Touch.InteractiveGestures = [LongTap, DoubleTap]
|
||||
TabOrder = 41
|
||||
TabOrder = 39
|
||||
Password = True
|
||||
Position.X = 8.000000000000000000
|
||||
Position.Y = 159.000000000000000000
|
||||
Size.Width = 272.000000000000000000
|
||||
Size.Height = 22.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
OnExit = edtChannelExit
|
||||
end
|
||||
object edtDACode: TEdit
|
||||
Touch.InteractiveGestures = [LongTap, DoubleTap]
|
||||
TabOrder = 42
|
||||
TabOrder = 41
|
||||
Password = True
|
||||
Position.X = 8.000000000000000000
|
||||
Position.Y = 214.000000000000000000
|
||||
@@ -262,7 +271,7 @@ object frSettings: TfrSettings
|
||||
Position.Y = 189.000000000000000000
|
||||
TextSettings.Trimming = None
|
||||
Text = 'Code'
|
||||
TabOrder = 44
|
||||
TabOrder = 42
|
||||
end
|
||||
object btnDAStart: TButton
|
||||
Position.X = 8.000000000000000000
|
||||
@@ -270,7 +279,7 @@ object frSettings: TfrSettings
|
||||
Size.Width = 121.000000000000000000
|
||||
Size.Height = 22.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 45
|
||||
TabOrder = 43
|
||||
Text = #1055#1086#1076#1082#1083#1102#1095#1080#1090#1100#1089#1103
|
||||
TextSettings.Trimming = None
|
||||
OnClick = btnDAStartClick
|
||||
@@ -282,7 +291,7 @@ object frSettings: TfrSettings
|
||||
Size.Width = 209.000000000000000000
|
||||
Size.Height = 22.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 47
|
||||
TabOrder = 46
|
||||
Text = #1055#1086#1083#1091#1095#1080#1090#1100' '#1076#1072#1085#1085#1099#1077' Donation Alerts'
|
||||
TextSettings.Trimming = None
|
||||
Visible = False
|
||||
@@ -56,6 +56,7 @@ type
|
||||
procedure btnImportSettingsClick(Sender: TObject);
|
||||
procedure btnExportSettingsClick(Sender: TObject);
|
||||
procedure btnMasterClick(Sender: TObject);
|
||||
procedure edtChannelExit(Sender: TObject);
|
||||
private
|
||||
{ Private declarations }
|
||||
FAPIClient: TAPIClient;
|
||||
@@ -325,6 +326,17 @@ if Assigned(FWSClient) then
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TfrSettings.edtChannelExit(Sender: TObject);
|
||||
begin
|
||||
if Sender is TEdit then
|
||||
DB.WriteSetting(TEdit(Sender).Name, TEdit(Sender).text);
|
||||
if Sender is TCheckBox then
|
||||
if TCheckBox(Sender).IsChecked then
|
||||
DB.WriteSetting(TCheckBox(Sender).Name, 'True')
|
||||
else
|
||||
DB.WriteSetting(TCheckBox(Sender).Name, 'False');
|
||||
end;
|
||||
|
||||
procedure TfrSettings.init;
|
||||
begin
|
||||
if not Assigned(FAPIClient) then
|
||||
@@ -361,7 +373,7 @@ end;
|
||||
|
||||
procedure TfrSettings.HandleWSStatus(AStatusText: string; AStatusCode: integer);
|
||||
begin
|
||||
// fLog.tolog(3,'uLogin','HandleWSStatus',AStatusText);
|
||||
TTW_Bot.tolog('fSettings','HandleWSStatus',AStatusText,3);
|
||||
TTW_Bot.Label8.text := AStatusText;
|
||||
case AStatusCode of
|
||||
0:
|
||||
@@ -0,0 +1,71 @@
|
||||
object frTTS: TfrTTS
|
||||
Size.Width = 314.000000000000000000
|
||||
Size.Height = 214.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
object Label1: TLabel
|
||||
Position.X = 8.000000000000000000
|
||||
Position.Y = 8.000000000000000000
|
||||
Text = #1043#1086#1083#1086#1089
|
||||
TabOrder = 0
|
||||
end
|
||||
object cbVoices: TComboBox
|
||||
Position.X = 8.000000000000000000
|
||||
Position.Y = 33.000000000000000000
|
||||
Size.Width = 161.000000000000000000
|
||||
Size.Height = 22.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 1
|
||||
end
|
||||
object btnUpdateVoices: TButton
|
||||
Position.X = 177.000000000000000000
|
||||
Position.Y = 33.000000000000000000
|
||||
Size.Width = 128.000000000000000000
|
||||
Size.Height = 22.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 2
|
||||
Text = #1054#1073#1085#1086#1074#1080#1090#1100' '#1075#1086#1083#1086#1089#1072
|
||||
TextSettings.Trimming = None
|
||||
OnClick = btnUpdateVoicesClick
|
||||
end
|
||||
object Label2: TLabel
|
||||
Position.X = 8.000000000000000000
|
||||
Position.Y = 63.000000000000000000
|
||||
Text = #1058#1077#1082#1089#1090' '#1076#1083#1103' '#1086#1079#1074#1091#1095#1082#1080
|
||||
TabOrder = 3
|
||||
end
|
||||
object edtText: TEdit
|
||||
Touch.InteractiveGestures = [LongTap, DoubleTap]
|
||||
TabOrder = 4
|
||||
Position.X = 8.000000000000000000
|
||||
Position.Y = 88.000000000000000000
|
||||
Size.Width = 161.000000000000000000
|
||||
Size.Height = 22.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
end
|
||||
object Label3: TLabel
|
||||
Position.X = 8.000000000000000000
|
||||
Position.Y = 118.000000000000000000
|
||||
Text = #1048#1089#1090#1086#1095#1085#1080#1082
|
||||
TabOrder = 5
|
||||
end
|
||||
object cbOutput: TComboBox
|
||||
Items.Strings = (
|
||||
#1069#1090#1086' '#1087#1088#1080#1083#1086#1078#1077#1085#1080#1077
|
||||
'SilentPlayer')
|
||||
ItemIndex = 0
|
||||
Position.X = 8.000000000000000000
|
||||
Position.Y = 143.000000000000000000
|
||||
Size.Width = 161.000000000000000000
|
||||
Size.Height = 22.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 6
|
||||
end
|
||||
object btnSend: TButton
|
||||
Position.X = 8.000000000000000000
|
||||
Position.Y = 173.000000000000000000
|
||||
TabOrder = 7
|
||||
Text = #1054#1079#1074#1091#1095#1080#1090#1100
|
||||
TextSettings.Trimming = None
|
||||
OnClick = btnSendClick
|
||||
end
|
||||
end
|
||||
@@ -0,0 +1,86 @@
|
||||
unit fTTS;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils, System.Types, System.UITypes, System.Classes,
|
||||
System.Variants, shellapi,
|
||||
FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
|
||||
FMX.Edit, FMX.ListBox, FMX.Controls.Presentation, uTTS, bass_simple;
|
||||
|
||||
type
|
||||
TfrTTS = class(TFrame)
|
||||
Label1: TLabel;
|
||||
cbVoices: TComboBox;
|
||||
btnUpdateVoices: TButton;
|
||||
Label2: TLabel;
|
||||
edtText: TEdit;
|
||||
Label3: TLabel;
|
||||
btnSend: TButton;
|
||||
cbOutput: TComboBox;
|
||||
procedure btnUpdateVoicesClick(Sender: TObject);
|
||||
procedure btnSendClick(Sender: TObject);
|
||||
private
|
||||
{ Private declarations }
|
||||
tts: TTTS;
|
||||
public
|
||||
{ Public declarations }
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.fmx}
|
||||
uses ugeneral;
|
||||
|
||||
procedure TfrTTS.btnSendClick(Sender: TObject);
|
||||
var
|
||||
s, s1: string;
|
||||
|
||||
begin
|
||||
case cbOutput.ItemIndex of
|
||||
0:
|
||||
begin // this
|
||||
s := ExtractFilePath(ParamStr(0)) + 'piper\piper.exe';
|
||||
s1 := ExtractFilePath(ParamStr(0)) + 'piper\voices';
|
||||
if cbVoices.ItemIndex = -1 then
|
||||
exit;
|
||||
tts := TTTS.Create(s, s1);
|
||||
try
|
||||
tts.SetModel(cbVoices.Text);
|
||||
tts.TextToSpeech(edtText.Text, true);
|
||||
finally
|
||||
tts.Free;
|
||||
end;
|
||||
end;
|
||||
1:
|
||||
begin // SilentPlay
|
||||
ShellExecute(0, 'open', PChar(myConst.SilentPlay),
|
||||
PChar(Format('%s %s "%s"', ['2', cbVoices.Text, edtText.Text])), nil, 0);
|
||||
end;
|
||||
|
||||
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure TfrTTS.btnUpdateVoicesClick(Sender: TObject);
|
||||
var
|
||||
s, s1: string;
|
||||
List: TStringList;
|
||||
begin
|
||||
s := ExtractFilePath(ParamStr(0)) + 'piper\piper.exe';
|
||||
s1 := ExtractFilePath(ParamStr(0)) + 'piper\voices';
|
||||
|
||||
tts := TTTS.Create(s, s1);
|
||||
List := TStringList.Create;
|
||||
try
|
||||
cbVoices.Items.Clear;
|
||||
List := tts.GetModelsList;
|
||||
cbVoices.Items.Assign(List);
|
||||
finally
|
||||
tts.Free;
|
||||
List.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
-506
@@ -1,506 +0,0 @@
|
||||
unit uGeneral;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils, System.Types, System.UITypes, System.Classes,
|
||||
System.Variants,
|
||||
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, uMyTimer, uRecords,
|
||||
System.Generics.Collections,
|
||||
System.IOUtils, fCommands, uDataBase, FMX.Edit, FMX.Colors, FMX.SpinBox,
|
||||
windows, System.Skia, FMX.Skia, uCreateChat, uCreateNotify, fOBS;
|
||||
|
||||
type
|
||||
TTTW_Bot = class(TForm)
|
||||
V: TTabControl;
|
||||
TabItem1: TTabItem;
|
||||
TabItem2: TTabItem;
|
||||
TabItem3: TTabItem;
|
||||
TabItem4: TTabItem;
|
||||
frSettings1: TfrSettings;
|
||||
ImageList1: TImageList;
|
||||
TabItem5: TTabItem;
|
||||
Panel1: TPanel;
|
||||
btnConnecting: TButton;
|
||||
Label2: TLabel;
|
||||
Label3: TLabel;
|
||||
Label5: TLabel;
|
||||
Label6: TLabel;
|
||||
Label7: TLabel;
|
||||
Label8: TLabel;
|
||||
aiConnecting: TAniIndicator;
|
||||
Label9: TLabel;
|
||||
Label10: TLabel;
|
||||
Label11: TLabel;
|
||||
Label12: TLabel;
|
||||
frAI1: TfrAI;
|
||||
TabItem6: TTabItem;
|
||||
TabItem7: TTabItem;
|
||||
TabItem8: TTabItem;
|
||||
TabItem9: TTabItem;
|
||||
frNotify1: TfrNotify;
|
||||
Label1: TLabel;
|
||||
frAutoActions1: TfrAutoActions;
|
||||
frOBS1: TfrOBS;
|
||||
frLog1: TfrLog;
|
||||
cbTheme: TComboBox;
|
||||
Label15: TLabel;
|
||||
frCommands1: TfrCommands;
|
||||
SpeedButton1: TSpeedButton;
|
||||
SpeedButton2: TSpeedButton;
|
||||
SpeedButton3: TSpeedButton;
|
||||
btnCreateChat: TButton;
|
||||
procedure cbThemeChange(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure SpeedButton1Click(Sender: TObject);
|
||||
procedure SpeedButton3Click(Sender: TObject);
|
||||
procedure SpeedButton2Click(Sender: TObject);
|
||||
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
|
||||
TTW_Bot: TTTW_Bot;
|
||||
myConst: TConst;
|
||||
db: TSettingsDatabase;
|
||||
appconst: TBotAppCfg;
|
||||
|
||||
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);
|
||||
if cbTheme.ItemIndex <> -1 then
|
||||
TStyleManager.SetStyleFromFile(myConst.stlPath + cbTheme.text);
|
||||
// db.WriteSetting('cbTheme', inttostr(cbTheme.ItemIndex));
|
||||
end;
|
||||
|
||||
procedure TTTW_Bot.FormCreate(Sender: TObject);
|
||||
var
|
||||
Path: string;
|
||||
|
||||
function GetPathToTestExe: string; // âåðíåò ïàïêó romaming
|
||||
begin
|
||||
Result := GetEnvironmentVariable('APPDATA');
|
||||
if Result <> '' then
|
||||
Result := IncludeTrailingPathDelimiter(Result);
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
myConst.GeneralPath := ExtractFilePath(ParamStr(0));
|
||||
myConst.AppDataPath := GetPathToTestExe + 'TTW_Bot\';
|
||||
|
||||
if not DirectoryExists(myConst.AppDataPath) then
|
||||
CreateDir(myConst.AppDataPath);
|
||||
|
||||
myConst.DBPath := myConst.AppDataPath + 'settings.db';
|
||||
|
||||
if not DirectoryExists(myConst.AppDataPath + 'fonts') then
|
||||
CreateDir(myConst.AppDataPath + 'fonts');
|
||||
myConst.fontsPath := myConst.AppDataPath + 'fonts\';
|
||||
|
||||
if not DirectoryExists(myConst.AppDataPath + 'imgs') then
|
||||
CreateDir(myConst.AppDataPath + 'imgs');
|
||||
myConst.imgsPath := myConst.AppDataPath + 'imgs\';
|
||||
|
||||
if not DirectoryExists(myConst.AppDataPath + 'sounds') then
|
||||
CreateDir(myConst.AppDataPath + 'sounds');
|
||||
myConst.soundsPath := myConst.AppDataPath + 'sounds\';
|
||||
|
||||
if not DirectoryExists(myConst.AppDataPath + 'stl') then
|
||||
CreateDir(myConst.AppDataPath + 'stl');
|
||||
myConst.stlPath := myConst.AppDataPath + 'stl\';
|
||||
|
||||
if not DirectoryExists(myConst.AppDataPath + 'ytSongs') then
|
||||
CreateDir(myConst.AppDataPath + 'ytSongs');
|
||||
myConst.ytSongsPath := myConst.AppDataPath + 'ytSongs\';
|
||||
|
||||
myConst.PublicPlay := myConst.GeneralPath + 'PublicPlay.exe';
|
||||
myConst.SilentPlay := myConst.GeneralPath + 'SilentPlayer.exe';
|
||||
myConst.ytPlay := myConst.GeneralPath + 'Player.exe';
|
||||
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';
|
||||
frCommands1.frsgSounds.UpdateGrid;
|
||||
frCommands1.frsgFiles.ObjectRecord := frCommands1.listFiles;
|
||||
frCommands1.frsgFiles.TableName := 'listFiles';
|
||||
frCommands1.frsgFiles.UpdateGrid;
|
||||
frCommands1.frsgNeiro.ObjectRecord := frCommands1.listNeiro;
|
||||
frCommands1.frsgNeiro.TableName := 'listNeiro';
|
||||
frCommands1.frsgNeiro.UpdateGrid;
|
||||
|
||||
for Path in TDirectory.GetFiles(myConst.stlPath) do
|
||||
cbTheme.Items.Add(ExtractFileName(Path));
|
||||
cbTheme.ItemIndex := strtoint(db.ReadSetting('cbTheme', '-1'));
|
||||
frLog1.FLogList := TList<TRLog>.Create;
|
||||
end;
|
||||
|
||||
procedure TTTW_Bot.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
FreeAndNil(db);
|
||||
FreeAndNil(frAutoActions1.FTimerList);
|
||||
FreeAndNil(frLog1.FLogList);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TTTW_Bot.frCommands1btnRandAddClick(Sender: TObject);
|
||||
begin
|
||||
frCommands1.btnRandAddClick(Sender);
|
||||
|
||||
end;
|
||||
|
||||
procedure TTTW_Bot.frOBS1btnDeleteeChatClick(Sender: TObject);
|
||||
begin
|
||||
frOBS1.btnDeleteeChatClick(Sender);
|
||||
|
||||
end;
|
||||
|
||||
procedure TTTW_Bot.frSettings1btnDAStartClick(Sender: TObject);
|
||||
begin
|
||||
frSettings1.btnDAStartClick(Sender);
|
||||
|
||||
end;
|
||||
|
||||
procedure TTTW_Bot.ReadDB;
|
||||
|
||||
function XorDecryptToStrings(const InputFile, Key: string): TStrings;
|
||||
var
|
||||
InStream: TFileStream;
|
||||
MemStream: TMemoryStream;
|
||||
KeyBytes: TBytes;
|
||||
KeyLen, KeyIndex: integer;
|
||||
B: Byte;
|
||||
begin
|
||||
KeyBytes := TEncoding.ANSI.GetBytes(Key);
|
||||
KeyLen := Length(KeyBytes);
|
||||
if KeyLen = 0 then
|
||||
raise Exception.Create('Êëþ÷ íå ìîæåò áûòü ïóñòûì');
|
||||
|
||||
InStream := TFileStream.Create(InputFile, fmOpenRead);
|
||||
try
|
||||
MemStream := TMemoryStream.Create;
|
||||
try
|
||||
KeyIndex := 0;
|
||||
while InStream.Position < InStream.Size do
|
||||
begin
|
||||
InStream.ReadBuffer(B, 1);
|
||||
B := B xor KeyBytes[KeyIndex];
|
||||
MemStream.WriteBuffer(B, 1);
|
||||
KeyIndex := (KeyIndex + 1) mod KeyLen;
|
||||
end;
|
||||
MemStream.Position := 0;
|
||||
Result := TStringList.Create;
|
||||
try
|
||||
Result.LoadFromStream(MemStream, TEncoding.ANSI);
|
||||
except
|
||||
Result.Free; // Îñâîáîæäàåì ïðè îøèáêå çàãðóçêè
|
||||
raise;
|
||||
end;
|
||||
finally
|
||||
MemStream.Free;
|
||||
end;
|
||||
finally
|
||||
InStream.Free;
|
||||
end;
|
||||
end;
|
||||
// Çàãðóçêà êîìïîíåíòîâ íàñòðîåê (TEdit, TCheckBox)
|
||||
procedure LoadSettingsComponents;
|
||||
var
|
||||
I: integer;
|
||||
c: TComponent;
|
||||
begin
|
||||
for I := 0 to frSettings1.ComponentCount - 1 do
|
||||
begin
|
||||
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 := frSettings1.edtChannel.text;
|
||||
end;
|
||||
|
||||
// Çàãðóçêà äàííûõ â ãðèäû êîìàíä
|
||||
procedure LoadGridsData;
|
||||
begin
|
||||
db.LoadRecordArray<TRandomCounters>('RandomCounters',
|
||||
frCommands1.RandomCounters);
|
||||
db.LoadRecordArray<TListCommands>('listSounds', frCommands1.listSounds);
|
||||
db.LoadRecordArray<TListCommands>('listFiles', frCommands1.listFiles);
|
||||
db.LoadRecordArray<TListCommands>('listNeiro', frCommands1.listNeiro);
|
||||
db.LoadRecordArray<TListCommands>('listCommands', frCommands1.listCommands);
|
||||
frCommands1.UpdateGridFromArray;
|
||||
|
||||
end;
|
||||
|
||||
// Çàãðóçêà ñïèñêà ãðóïï
|
||||
procedure LoadGroupNames;
|
||||
begin
|
||||
db.getGroupName(frCommands1.frGroupsRequest1.lbRandomGroup.Items);
|
||||
end;
|
||||
|
||||
// Çàãðóçêà çàøèôðîâàííîãî êîíôèãà
|
||||
procedure LoadEncryptedConfig;
|
||||
var
|
||||
tempList: TStrings; // Âðåìåííûé ñïèñîê äëÿ ðåçóëüòàòà
|
||||
I: integer;
|
||||
begin
|
||||
if not FileExists(myConst.cfg1) then
|
||||
Exit;
|
||||
|
||||
tempList := nil; // Èíèöèàëèçàöèÿ
|
||||
try
|
||||
tempList := XorDecryptToStrings(myConst.cfg1, 'fgvasrgEFAXFAFAS');
|
||||
|
||||
for I := 0 to tempList.Count - 1 do
|
||||
begin
|
||||
var eqPos := Pos('=', tempList[I]);
|
||||
if eqPos > 0 then
|
||||
begin
|
||||
var Key := Trim(Copy(tempList[I], 1, eqPos - 1));
|
||||
var Value := Trim(Copy(tempList[I], eqPos + 1, MaxInt));
|
||||
|
||||
if Key = 'k1' then
|
||||
appconst.TTV_ClientID := Value
|
||||
else if Key = 'k2' then
|
||||
appconst.AI_GigaChat_AC := Value
|
||||
else if Key = 'k3' then
|
||||
appconst.AI_GigaChat_ClientID := Value
|
||||
else if Key = 'k4' then
|
||||
appconst.AI_ChatGPT_Token := Value
|
||||
else if Key = 'k5' then
|
||||
appconst.AI_DeepSeec_Token := Value
|
||||
else if Key = 'k6' then
|
||||
appconst.DA_ClientID := Value
|
||||
else if Key = 'k7' then
|
||||
appconst.DA_Sicret := Value
|
||||
else if Key = 'k8' then
|
||||
appconst.DA_URL := Value;
|
||||
end;
|
||||
end;
|
||||
|
||||
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 <> '');
|
||||
frSettings1.btnGetDADef.Visible := (appconst.DA_ClientID <> '') and
|
||||
(appconst.DA_Sicret <> '') and (appconst.DA_URL <> '');
|
||||
finally
|
||||
tempList.Free; // Âàæíî: îñâîáîæäàåì âðåìåííûé ñïèñîê!
|
||||
end;
|
||||
end;
|
||||
// Çàãðóçêà íàñòðîåê óâåäîìëåíèé
|
||||
procedure LoadNotifySettings;
|
||||
var
|
||||
I: integer;
|
||||
c: TComponent;
|
||||
begin
|
||||
for I := 0 to frNotify1.ComponentCount - 1 do
|
||||
begin
|
||||
c := frNotify1.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')
|
||||
else if c is TSwitch then
|
||||
TSwitch(c).IsChecked := (db.ReadSetting(TSwitch(c).Name) = 'True')
|
||||
else if c is TTrackBar then
|
||||
TTrackBar(c).Value :=
|
||||
strtoint(db.ReadSetting(TTrackBar(c).Name, '100'));
|
||||
end;
|
||||
end;
|
||||
|
||||
// Çàãðóçêà íàñòðîåê ÈÈ
|
||||
procedure LoadAISettings;
|
||||
var
|
||||
I: integer;
|
||||
c: TComponent;
|
||||
ii: integer;
|
||||
|
||||
// Íàñòðîéêè GigaChat
|
||||
procedure SetupGigaChatSettings;
|
||||
begin
|
||||
frAI1.rbGC.IsChecked := True;
|
||||
frAI1.Label45.text := 'ClientID';
|
||||
frAI1.Label47.text := 'Autorization Code';
|
||||
frAI1.Label1.Visible := false;
|
||||
frAI1.edtAIP2.Visible := True;
|
||||
frAI1.edtAIP2.Password := True;
|
||||
frAI1.edtAIP3.Visible := false;
|
||||
frAI1.cbOllama.Visible := false;
|
||||
end;
|
||||
|
||||
// Íàñòðîéêè DeepSeek
|
||||
procedure SetupDeepSeekSettings;
|
||||
begin
|
||||
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;
|
||||
end;
|
||||
|
||||
// Íàñòðîéêè ChatGPT
|
||||
procedure SetupChatGPTSettings;
|
||||
begin
|
||||
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;
|
||||
end;
|
||||
|
||||
// Íàñòðîéêè êàñòîìíîãî ÈÈ
|
||||
procedure SetupCustomAISettings;
|
||||
begin
|
||||
frAI1.RBCustom.IsChecked := True;
|
||||
frAI1.Label45.text := 'API Token';
|
||||
frAI1.Label47.text := 'URL';
|
||||
frAI1.Label1.Visible := True;
|
||||
frAI1.edtAIP2.Visible := True;
|
||||
frAI1.edtAIP2.Password := false;
|
||||
frAI1.edtAIP3.Visible := True;
|
||||
frAI1.cbOllama.Visible := True;
|
||||
frAI1.cbOllama.IsChecked := db.ReadSetting(frAI1.cbOllama.Name) = '1';
|
||||
end;
|
||||
|
||||
begin
|
||||
for I := 0 to frAI1.ComponentCount - 1 do
|
||||
begin
|
||||
c := frAI1.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) = '1';
|
||||
end;
|
||||
|
||||
ii := strtoint(db.ReadSetting('aiIndex', '0'));
|
||||
case ii of
|
||||
0:
|
||||
SetupGigaChatSettings;
|
||||
1:
|
||||
SetupDeepSeekSettings;
|
||||
2:
|
||||
SetupChatGPTSettings;
|
||||
3:
|
||||
SetupCustomAISettings;
|
||||
end;
|
||||
|
||||
frSettings1.init;
|
||||
end;
|
||||
|
||||
// Çàãðóçêà ãðèäîâ àâòîìàòè÷åñêèõ äåéñòâèé
|
||||
procedure LoadAutoActionsGrids;
|
||||
begin
|
||||
db.LoadRecordArray<TListTimer>('listTimer', frAutoActions1.listTimer);
|
||||
db.LoadRecordArray<TBanWord>('listBanWords', frAutoActions1.listBanWords);
|
||||
db.LoadRecordArray<TCounter>('listCounters', frAutoActions1.listCounters);
|
||||
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
|
||||
LoadSettingsComponents;
|
||||
LoadGridsData;
|
||||
LoadGroupNames;
|
||||
LoadEncryptedConfig;
|
||||
|
||||
LoadNotifySettings;
|
||||
LoadAISettings;
|
||||
LoadOBSGrids;
|
||||
LoadAutoActionsGrids;
|
||||
end;
|
||||
|
||||
procedure TTTW_Bot.SpeedButton1Click(Sender: TObject);
|
||||
begin
|
||||
ShellExecute(0, 'open', pwidechar('https://www.twitch.tv/incadence'),
|
||||
nil, nil, 1);
|
||||
end;
|
||||
|
||||
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 TTTW_Bot.SpeedButton3Click(Sender: TObject);
|
||||
begin
|
||||
// https://www.flaticon.com/ru/authors/karacis
|
||||
ShellExecute(0, 'open',
|
||||
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.
|
||||
+43
@@ -0,0 +1,43 @@
|
||||
object fPlayer: TfPlayer
|
||||
Left = 0
|
||||
Top = 0
|
||||
Caption = #1055#1083#1077#1077#1088
|
||||
ClientHeight = 81
|
||||
ClientWidth = 227
|
||||
FormFactor.Width = 320
|
||||
FormFactor.Height = 480
|
||||
FormFactor.Devices = [Desktop]
|
||||
OnCreate = FormCreate
|
||||
OnClose = FormClose
|
||||
DesignerMasterStyle = 0
|
||||
object Edit1: TEdit
|
||||
Touch.InteractiveGestures = [LongTap, DoubleTap]
|
||||
Align = Top
|
||||
TabOrder = 2
|
||||
ReadOnly = True
|
||||
Text = 'http://127.0.0.1:8088'
|
||||
Position.X = 10.000000000000000000
|
||||
Position.Y = 47.000000000000000000
|
||||
Margins.Left = 10.000000000000000000
|
||||
Margins.Top = 10.000000000000000000
|
||||
Margins.Right = 10.000000000000000000
|
||||
Margins.Bottom = 10.000000000000000000
|
||||
Size.Width = 207.000000000000000000
|
||||
Size.Height = 22.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
end
|
||||
object Label1: TLabel
|
||||
Align = Top
|
||||
Margins.Left = 10.000000000000000000
|
||||
Margins.Top = 10.000000000000000000
|
||||
Margins.Right = 10.000000000000000000
|
||||
Margins.Bottom = 10.000000000000000000
|
||||
Position.X = 10.000000000000000000
|
||||
Position.Y = 10.000000000000000000
|
||||
Size.Width = 207.000000000000000000
|
||||
Size.Height = 17.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
Text = #1057#1089#1099#1083#1082#1072' '#1076#1083#1103' OBS '#1044#1086#1082'-'#1087#1072#1085#1077#1083#1080
|
||||
TabOrder = 3
|
||||
end
|
||||
end
|
||||
+72
@@ -0,0 +1,72 @@
|
||||
unit uPlayer;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils, System.Types, System.UITypes, System.Classes,
|
||||
System.Variants, FMX.Styles, IdHTTPWebBrokerBridge, IdGlobal, Web.HTTPApp,
|
||||
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,
|
||||
FMX.Controls.Presentation, FMX.Layouts, FMX.ListBox, uPlayerThread,
|
||||
bass_simple, FMX.Memo.Types, FMX.ScrollBox, FMX.Memo, FMX.Edit;
|
||||
|
||||
type
|
||||
TfPlayer = class(TForm)
|
||||
Edit1: TEdit;
|
||||
Label1: TLabel;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
||||
private
|
||||
{ Private declarations }
|
||||
mp: TBassSimple;
|
||||
|
||||
Player: TPlayerThread;
|
||||
FServer: TIdHTTPWebBrokerBridge;
|
||||
procedure StartServer;
|
||||
public
|
||||
{ Public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
fPlayer: TfPlayer;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.fmx}
|
||||
|
||||
function GetPathToTestExe: string; // âåðíåò ïàïêó romaming
|
||||
begin
|
||||
Result := GetEnvironmentVariable('APPDATA');
|
||||
if Result <> '' then
|
||||
Result := IncludeTrailingPathDelimiter(Result);
|
||||
end;
|
||||
|
||||
procedure TfPlayer.FormClose(Sender: TObject; var Action: TCloseAction);
|
||||
begin
|
||||
FServer.Active := False;
|
||||
FServer.Bindings.Clear;
|
||||
end;
|
||||
|
||||
procedure TfPlayer.FormCreate(Sender: TObject);
|
||||
var
|
||||
theme: string;
|
||||
begin
|
||||
theme := ParamStr(1);
|
||||
if theme <> '' then
|
||||
begin
|
||||
TStyleManager.SetStyleFromFile(GetPathToTestExe + 'TTW_Bot\stl\' + theme);
|
||||
end;
|
||||
FServer := TIdHTTPWebBrokerBridge.Create(Self);
|
||||
StartServer;
|
||||
end;
|
||||
|
||||
procedure TfPlayer.StartServer;
|
||||
begin
|
||||
if not FServer.Active then
|
||||
begin
|
||||
FServer.Bindings.Clear;
|
||||
FServer.DefaultPort := 8088;
|
||||
FServer.Active := True;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,14 @@
|
||||
object fPublicPlayer: TfPublicPlayer
|
||||
Left = 0
|
||||
Top = 0
|
||||
Caption = 'Form1'
|
||||
ClientHeight = 52
|
||||
ClientWidth = 168
|
||||
Transparency = True
|
||||
FormFactor.Width = 320
|
||||
FormFactor.Height = 480
|
||||
FormFactor.Devices = [Desktop]
|
||||
OnCreate = FormCreate
|
||||
OnClose = FormClose
|
||||
DesignerMasterStyle = 0
|
||||
end
|
||||
@@ -0,0 +1,101 @@
|
||||
unit uSilentPlayer;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils, System.Types, System.UITypes, System.Classes,
|
||||
System.Variants, utts, mmsystem,
|
||||
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, bass_simple,
|
||||
FMX.Controls.Presentation, FMX.StdCtrls;
|
||||
|
||||
type
|
||||
TfPublicPlayer = class(TForm)
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
||||
private
|
||||
procedure endPlay(Sender: TObject);
|
||||
public
|
||||
{ Public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
fPublicPlayer: TfPublicPlayer;
|
||||
b1: tbassSimple;
|
||||
i, sec: Integer;
|
||||
s: string;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.fmx}
|
||||
|
||||
procedure TfPublicPlayer.endPlay(Sender: TObject);
|
||||
begin
|
||||
try
|
||||
TThread.Queue(nil,
|
||||
procedure
|
||||
begin
|
||||
Close;
|
||||
end);
|
||||
except
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfPublicPlayer.FormClose(Sender: TObject; var Action: TCloseAction);
|
||||
begin
|
||||
try
|
||||
if Assigned(b1) then
|
||||
b1.Free;
|
||||
except
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfPublicPlayer.FormCreate(Sender: TObject); // mode(1) sec vol othet
|
||||
var
|
||||
mode: Integer; // mode(2) model texts
|
||||
tts: ttts;
|
||||
p, v, m: string;
|
||||
begin
|
||||
hide;
|
||||
try
|
||||
mode := StrToIntDef(ParamStr(1), 1);
|
||||
case mode of
|
||||
1:
|
||||
begin
|
||||
b1 := tbassSimple.Create(0);
|
||||
b1.Volume := StrToIntDef(ParamStr(2), 255);
|
||||
sec := StrToIntDef(ParamStr(1), 1);
|
||||
s := '';
|
||||
for i := 3 to ParamCount do
|
||||
begin
|
||||
s := s + ParamStr(i) + ' ';
|
||||
end;
|
||||
Delete(s, length(s), 1);
|
||||
b1.Play(s);
|
||||
b1.OnEndPlay := endPlay;
|
||||
end;
|
||||
2:
|
||||
begin
|
||||
s := '';
|
||||
m := ParamStr(2);
|
||||
for i := 3 to ParamCount do
|
||||
begin
|
||||
s := s + ParamStr(i) + ' ';
|
||||
end;
|
||||
Delete(s, length(s), 1);
|
||||
p := ExtractFilePath(ParamStr(0)) + 'piper\piper.exe';
|
||||
v := ExtractFilePath(ParamStr(0)) + 'piper\voices';
|
||||
tts := ttts.Create(p, v);
|
||||
tts.OnPlayFinished := endPlay;
|
||||
tts.SetModel(m);
|
||||
tts.TextToSpeech(s, true);
|
||||
end;
|
||||
end;
|
||||
except
|
||||
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
end.
|
||||
+342
@@ -0,0 +1,342 @@
|
||||
unit uTTWIRC;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.Classes, System.SysUtils, IdIRC, IdSSLOpenSSL, IdContext,
|
||||
FMX.Forms, IdGlobal, IdComponent, System.StrUtils, uRecords;
|
||||
|
||||
|
||||
|
||||
type
|
||||
TNotifyEvent = procedure(s: string) of object;
|
||||
TJoinEvent = procedure(aNick: string) of object;
|
||||
TMyStatusEvent = procedure(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string) of object;
|
||||
tOnMessageRecord = procedure(aRecord: TTwitchChatMessage) of object;
|
||||
TOnLog = procedure(aModul: string; aMethod: string; aMessage: string; aLevel: integer) of object;
|
||||
|
||||
type
|
||||
TTTW = class(TObject)
|
||||
private
|
||||
ws: TIdIRC;
|
||||
ssl: TIdSSLIOHandlerSocketOpenSSL;
|
||||
channel_name: string;
|
||||
Token: string;
|
||||
|
||||
FOnConnect: TNotifyEvent;
|
||||
FOnDisConnect: TNotifyEvent;
|
||||
|
||||
FOnJoin: TJoinEvent;
|
||||
FOnStatus: TMyStatusEvent;
|
||||
FOnMessageRecord:tOnMessageRecord;
|
||||
FOnLog: TOnLog;
|
||||
room_id: string;
|
||||
|
||||
procedure wsConnected(Sender: TObject);
|
||||
procedure wsDisconnected(Sender: TObject);
|
||||
procedure wsDataIn(ASender: TIdContext; AIn: boolean; const AMessage: string);
|
||||
procedure toParse(t: string);
|
||||
procedure Join(ASender: TIdContext; const ANickname, AHost, AChannel: string);
|
||||
procedure se(ASender: TIdContext; AErrorCode: Integer; const AErrorMessage: String);
|
||||
function Pars(T_, text, _T: string): string;
|
||||
function ParseTwitchChatMessage(const AMessage: string): TTwitchChatMessage;
|
||||
procedure toLog(aLevel: integer; aMethod: string; aMessage: string);
|
||||
public
|
||||
constructor Create(Sender: TObject);
|
||||
destructor Destroy; override;
|
||||
procedure Init(myToken, Channel, Bot_Name: string);
|
||||
procedure sendMessage(text: string);
|
||||
procedure RAW(text: string);
|
||||
procedure Connect;
|
||||
procedure Disconnect;
|
||||
|
||||
function GetRoom_ID:string;
|
||||
property FRoom_ID:string read GetRoom_ID;
|
||||
property OnConnect: TNotifyEvent read FOnConnect write FOnConnect;
|
||||
property OnDisConnect: TNotifyEvent read FOnDisConnect write FOnDisConnect;
|
||||
|
||||
property OnMessageRecord: tOnMessageRecord read FOnMessageRecord write FOnMessageRecord;
|
||||
property OnLog: TOnLog read FOnLog write FOnLog;
|
||||
property OnJoin: TJoinEvent read FOnJoin write FOnJoin;
|
||||
property OnStatus: TMyStatusEvent read FOnStatus write FOnStatus;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses uGeneral; // Äëÿ äîñòóïà ê ïðîöåäóðå Log
|
||||
|
||||
procedure TTTW.toLog(aLevel: integer; aMethod: string; aMessage: string);
|
||||
begin
|
||||
if Assigned(FOnLog) then
|
||||
FOnLog('uTTWIRC', aMethod, aMessage, aLevel);
|
||||
end;
|
||||
|
||||
constructor TTTW.Create(Sender: TObject);
|
||||
begin
|
||||
try
|
||||
ws := TIdIRC.Create;
|
||||
ssl := TIdSSLIOHandlerSocketOpenSSL.Create;
|
||||
ws.IOHandler := ssl;
|
||||
ws.OnConnected := wsConnected;
|
||||
ws.OnDisconnected := wsDisconnected;
|
||||
ws.OnStatus:= FOnStatus;
|
||||
ws.OnRaw := wsDataIn;
|
||||
ws.OnJoin := Join;
|
||||
ws.OnServerError := se;
|
||||
except
|
||||
on E: Exception do
|
||||
toLog(2, 'Create', E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TTTW.Destroy;
|
||||
begin
|
||||
ws.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TTTW.ParseTwitchChatMessage(const AMessage: string): TTwitchChatMessage;
|
||||
var
|
||||
s: string;
|
||||
LSpacePos: Integer;
|
||||
LParamStr, LRestStr: string;
|
||||
LParams: TArray<string>;
|
||||
LKeyValue: TArray<string>;
|
||||
I: Integer;
|
||||
LUsernamePart: string;
|
||||
LMessagePos: Integer;
|
||||
begin
|
||||
s := AMessage;
|
||||
|
||||
// Ðàçäåëÿåì ñòðîêó íà ïàðàìåòðû è îñòàëüíóþ ÷àñòü
|
||||
LSpacePos := Pos(' ', s);
|
||||
if LSpacePos > 0 then
|
||||
begin
|
||||
LParamStr := Copy(s, 1, LSpacePos - 1);
|
||||
LRestStr := Copy(s, LSpacePos + 1, Length(s) - LSpacePos);
|
||||
end
|
||||
else
|
||||
begin
|
||||
LParamStr := s;
|
||||
LRestStr := '';
|
||||
end;
|
||||
|
||||
// Îáðàáàòûâàåì ïàðàìåòðû
|
||||
LParams := LParamStr.Split([';']);
|
||||
for I := 0 to High(LParams) do
|
||||
begin
|
||||
LKeyValue := LParams[I].Split(['=']);
|
||||
if Length(LKeyValue) = 2 then
|
||||
begin
|
||||
case AnsiIndexStr(LKeyValue[0], [
|
||||
'@badge-info', 'badges', 'client-nonce', 'color', 'display-name', 'emotes',
|
||||
'first-msg', 'id', 'mod', 'returning-chatter', 'room-id', 'subscriber',
|
||||
'tmi-sent-ts', 'turbo', 'user-id', 'user-type', 'vip'
|
||||
]) of
|
||||
0: Result.BadgeInfo := LKeyValue[1];
|
||||
1: Result.Badges := LKeyValue[1];
|
||||
2: Result.ClientNonce := LKeyValue[1];
|
||||
3: Result.Color := LKeyValue[1];
|
||||
4: Result.DisplayName := LKeyValue[1];
|
||||
5: Result.Emotes := LKeyValue[1];
|
||||
6: Result.FirstMsg := StrToIntDef(LKeyValue[1], 0);
|
||||
7: Result.Id := LKeyValue[1];
|
||||
8: Result.Moder := StrToIntDef(LKeyValue[1], 0);
|
||||
9: Result.ReturningChatter := StrToIntDef(LKeyValue[1], 0);
|
||||
10: Result.RoomId := LKeyValue[1];
|
||||
11: Result.Subscriber := StrToIntDef(LKeyValue[1], 0);
|
||||
12: Result.TmiSentTs := StrToInt64Def(LKeyValue[1], 0);
|
||||
13: Result.Turbo := StrToIntDef(LKeyValue[1], 0);
|
||||
14: Result.UserId := LKeyValue[1];
|
||||
15: Result.UserType := LKeyValue[1];
|
||||
16: Result.Vip := StrToIntDef(LKeyValue[1], 0);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
// Èçâëåêàåì èìÿ ïîëüçîâàòåëÿ
|
||||
if LRestStr.StartsWith(':') then
|
||||
begin
|
||||
LUsernamePart := Copy(LRestStr, 1, Pos('!', LRestStr) - 1);
|
||||
Result.Username := LUsernamePart.Substring(1);
|
||||
end
|
||||
else
|
||||
Result.Username := '';
|
||||
|
||||
// Èçâëåêàåì êàíàë
|
||||
LMessagePos := Pos('PRIVMSG #', LRestStr);
|
||||
if LMessagePos > 0 then
|
||||
begin
|
||||
Inc(LMessagePos, Length('PRIVMSG #'));
|
||||
Result.Channel := Copy(LRestStr, LMessagePos, PosEx(' ', LRestStr, LMessagePos) - LMessagePos);
|
||||
end
|
||||
else
|
||||
Result.Channel := '';
|
||||
|
||||
// Èçâëåêàåì ñîîáùåíèå
|
||||
LMessagePos := Pos(' :', LRestStr);
|
||||
if LMessagePos > 0 then
|
||||
Result.Message := Copy(LRestStr, LMessagePos + 2, MaxInt).Trim
|
||||
else
|
||||
Result.Message := '';
|
||||
end;
|
||||
|
||||
procedure TTTW.Init(myToken, Channel, Bot_Name: string);
|
||||
begin
|
||||
try
|
||||
ws.Host := 'irc.chat.twitch.tv';
|
||||
ws.Port := 6697;
|
||||
ssl.SSLOptions.SSLVersions := [sslvSSLv23];
|
||||
ws.Password := 'oauth:' + myToken;
|
||||
ws.Nickname := Bot_Name;
|
||||
channel_name := Channel;
|
||||
Token := myToken;
|
||||
except
|
||||
on E: Exception do
|
||||
toLog(2, 'Init', E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTTW.Connect;
|
||||
begin
|
||||
try
|
||||
ws.Connect;
|
||||
ws.Raw('CAP REQ :twitch.tv/membership twitch.tv/tags twitch.tv/commands');
|
||||
ws.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
|
||||
except
|
||||
on E: Exception do
|
||||
toLog(2, 'Connect', E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTTW.Disconnect;
|
||||
begin
|
||||
try
|
||||
if ws.Connected then // Äîáàâëÿåì ïðîâåðêó ñîñòîÿíèÿ
|
||||
begin
|
||||
ws.Disconnect;
|
||||
end;
|
||||
except
|
||||
on E: Exception do
|
||||
toLog(2, 'Disconnect', E.ClassName + ': ' + E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTTW.GetRoom_ID: string;
|
||||
begin
|
||||
result:=room_id;
|
||||
end;
|
||||
|
||||
procedure TTTW.sendMessage(text: string);
|
||||
begin
|
||||
try
|
||||
ws.Say('#' + channel_name, text);
|
||||
except
|
||||
on E: Exception do
|
||||
toLog(2, 'sendMessage', E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTTW.RAW(text: string);
|
||||
begin
|
||||
try
|
||||
ws.Raw(text);
|
||||
except
|
||||
on E: Exception do
|
||||
toLog(2, 'RAW', E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTTW.wsConnected(Sender: TObject);
|
||||
begin
|
||||
if Assigned(FOnStatus) then
|
||||
FOnStatus(ws, TIdStatus.hsDisconnected, 'Connected.');
|
||||
if Assigned(FOnConnect) then
|
||||
FOnConnect('Connected');
|
||||
toLog(0, 'wsConnected', 'Connected to Twitch IRC');
|
||||
end;
|
||||
|
||||
procedure TTTW.wsDisconnected(Sender: TObject);
|
||||
begin
|
||||
if Assigned(FOnStatus) then
|
||||
FOnStatus(ws, TIdStatus.hsDisconnected, 'Disconnected.');
|
||||
if Assigned(FOnDisConnect) then
|
||||
FOnDisConnect('Disconnected');
|
||||
toLog(1, 'wsDisconnected', 'Disconnected from Twitch IRC');
|
||||
end;
|
||||
|
||||
procedure TTTW.wsDataIn(ASender: TIdContext; AIn: boolean; const AMessage: string);
|
||||
begin
|
||||
|
||||
toLog(3, 'wsDataIn', AMessage);
|
||||
|
||||
if Pos('CAP * ACK', AMessage) <> 0 then
|
||||
begin
|
||||
Sleep(200);
|
||||
ws.Raw('JOIN #' + channel_name);
|
||||
end;
|
||||
toParse(AMessage);
|
||||
end;
|
||||
|
||||
procedure TTTW.toParse(t: string);
|
||||
var
|
||||
LTwitchChatMessage:tTwitchChatMessage;
|
||||
begin
|
||||
try
|
||||
if (Pos('room-id=', t) <> 0) and (Pos('ROOMSTATE', t) <> 0) then
|
||||
room_id := Pars('room-id=', t, ';');
|
||||
|
||||
if Pos('NOTICE * :Login authentication failed', t) <> 0 then
|
||||
begin
|
||||
toLog(2, 'toParse', 'Òîêåí áîòà ïðîñðî÷åí');
|
||||
Disconnect;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if Pos('PRIVMSG', t) <> 0 then
|
||||
begin
|
||||
LTwitchChatMessage := ParseTwitchChatMessage(t);
|
||||
if Assigned(FOnMessageRecord) then
|
||||
FOnMessageRecord(LTwitchChatMessage);
|
||||
end;
|
||||
except
|
||||
on E: Exception do
|
||||
toLog(2, 'toParse', E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TTTW.Join(ASender: TIdContext; const ANickname, AHost, AChannel: string);
|
||||
begin
|
||||
if Assigned(FOnJoin) then
|
||||
FOnJoin(ANickname);
|
||||
toLog(0, 'Join', ANickname + ' joined ' + AChannel);
|
||||
end;
|
||||
|
||||
procedure TTTW.se(ASender: TIdContext; AErrorCode: Integer; const AErrorMessage: String);
|
||||
begin
|
||||
toLog(2, 'se', AErrorMessage);
|
||||
end;
|
||||
|
||||
function TTTW.Pars(T_, text, _T: string): string;
|
||||
var
|
||||
a, b: Integer;
|
||||
begin
|
||||
Result := '';
|
||||
if (T_ = '') or (text = '') or (_T = '') then
|
||||
Exit;
|
||||
a := Pos(T_, text);
|
||||
if a = 0 then
|
||||
Exit
|
||||
else
|
||||
a := a + Length(T_);
|
||||
text := Copy(text, a, Length(text) - a + 1);
|
||||
b := Pos(_T, text);
|
||||
if b > 0 then
|
||||
Result := Copy(text, 1, b - 1);
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,13 @@
|
||||
object OBS_Doc_Player: TOBS_Doc_Player
|
||||
OnCreate = WebModuleCreate
|
||||
OnDestroy = WebModuleDestroy
|
||||
Actions = <
|
||||
item
|
||||
Default = True
|
||||
Name = 'DefaultHandler'
|
||||
PathInfo = '/'
|
||||
OnAction = WebModule1DefaultHandlerAction
|
||||
end>
|
||||
Height = 230
|
||||
Width = 415
|
||||
end
|
||||
@@ -0,0 +1,273 @@
|
||||
unit uOBS_Doc_Player;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils, System.Classes, Web.HTTPApp, FMX.Types,
|
||||
FMX.Controls3D, FMX.Objects3D, FMX.Controls, FMX.Forms, FMX.StdCtrls,
|
||||
FMX.Edit, FMX.ListBox, uPlayerThread, bass_simple;
|
||||
|
||||
type
|
||||
TOBS_Doc_Player = class(TWebModule)
|
||||
procedure WebModule1DefaultHandlerAction(Sender: TObject;
|
||||
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
|
||||
procedure Button1Click(Sender: TObject);
|
||||
procedure Button2Click(Sender: TObject);
|
||||
procedure TrackBar1Change(Sender: TObject);
|
||||
procedure WebModuleCreate(Sender: TObject);
|
||||
procedure WebModuleDestroy(Sender: TObject);
|
||||
private
|
||||
{ Private declarations }
|
||||
function gethtml(): string;
|
||||
procedure AddToListBox(Text: String);
|
||||
procedure DelFromListBox(Text: String);
|
||||
procedure add(const aTitle: string);
|
||||
procedure del(const aTitle: string);
|
||||
{ Private declarations }
|
||||
public
|
||||
{ Public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
OBS_Doc_Player: TComponentClass = TOBS_Doc_Player;
|
||||
Button1: TButton;
|
||||
Button2: TButton;
|
||||
ProgressBar1: TProgressBar;
|
||||
TrackBar1: TTrackBar;
|
||||
ListBox1: TListBox;
|
||||
b: TBassSimple;
|
||||
player: TPlayerThread;
|
||||
mVolume: Integer;
|
||||
isplay: string;
|
||||
mySoundPath: string;
|
||||
|
||||
implementation
|
||||
|
||||
{%CLASSGROUP 'FMX.Controls.TControl'}
|
||||
{$R *.dfm}
|
||||
{ TOBS_Doc_Player }
|
||||
|
||||
function GetPathToTestExe: string; // âåðíåò ïàïêó romaming
|
||||
begin
|
||||
Result := GetEnvironmentVariable('APPDATA');
|
||||
if Result <> '' then
|
||||
Result := IncludeTrailingPathDelimiter(Result);
|
||||
end;
|
||||
|
||||
procedure TOBS_Doc_Player.add(const aTitle: string);
|
||||
begin
|
||||
AddToListBox(aTitle);
|
||||
end;
|
||||
|
||||
procedure TOBS_Doc_Player.AddToListBox(Text: String);
|
||||
begin
|
||||
if ListBox1.Items.IndexOf(Text) = -1 then
|
||||
ListBox1.Items.add(Text);
|
||||
end;
|
||||
|
||||
procedure TOBS_Doc_Player.Button1Click(Sender: TObject);
|
||||
begin
|
||||
b.Pause;
|
||||
if isplay = '0' then
|
||||
isplay := '1'
|
||||
else
|
||||
isplay := '0'
|
||||
end;
|
||||
|
||||
procedure TOBS_Doc_Player.Button2Click(Sender: TObject);
|
||||
begin
|
||||
player.Skip;
|
||||
end;
|
||||
|
||||
procedure TOBS_Doc_Player.del(const aTitle: string);
|
||||
begin
|
||||
DelFromListBox(aTitle);
|
||||
end;
|
||||
|
||||
procedure TOBS_Doc_Player.DelFromListBox(Text: String);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Application.ProcessMessages;
|
||||
i := ListBox1.Items.IndexOf(Text);
|
||||
if i <> -1 then
|
||||
if i <= ListBox1.Items.Count - 1 then
|
||||
ListBox1.Items.Delete(i);
|
||||
Application.ProcessMessages;
|
||||
end;
|
||||
|
||||
function TOBS_Doc_Player.gethtml: string;
|
||||
var
|
||||
s: string;
|
||||
i: Integer;
|
||||
playIcon: string;
|
||||
begin
|
||||
// Îïðåäåëÿåì èêîíêó â çàâèñèìîñòè îò ñîñòîÿíèÿ
|
||||
if isplay = '1' then
|
||||
playIcon := 'fa-pause'
|
||||
else
|
||||
playIcon := 'fa-play';
|
||||
|
||||
// Ñîáèðàåì ýëåìåíòû ListBox â ñòðîêó
|
||||
s := '';
|
||||
for i := 0 to ListBox1.Items.Count - 1 do
|
||||
s := s + '<li>' + ListBox1.Items[i] + '</li>';
|
||||
|
||||
// Ãåíåðàöèÿ HTML-ñòðàíèöû ñ îáíîâëåííûìè çíà÷åíèÿìè
|
||||
Result := '<html>' + '<head><title>Web Radio</title>' +
|
||||
'<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/6.0.0/css/all.min.css">'
|
||||
+ '<style>' + 'body {' + 'background-color: #1d1f21;' + 'color: #ffffff;' +
|
||||
'font-family: "Arial", sans-serif;' + 'text-align: center;' + 'margin: 0;' +
|
||||
'padding: 20px;' + 'display: flex;' + 'flex-direction: column;' +
|
||||
'align-items: center;' + '}' +
|
||||
|
||||
'.controls {' + 'display: flex;' + 'gap: 20px;' + 'align-items: center;' +
|
||||
'margin: 20px 0;' + '}' +
|
||||
|
||||
'.icon-btn {' + 'cursor: pointer;' + 'font-size: 24px;' + 'color: #4e8b31;'
|
||||
+ 'transition: transform 0.2s, color 0.2s;' + 'background: none;' +
|
||||
'border: none;' + 'padding: 10px;' + '}' +
|
||||
|
||||
'.icon-btn:hover {' + 'color: #5f9c42;' + 'transform: scale(1.1);' + '}' +
|
||||
|
||||
'.volume-container {' + 'margin: 20px 0;' + '}' +
|
||||
|
||||
'ul {' + 'list-style-type: none;' + 'padding: 0;' + 'color: #ccc;' +
|
||||
'max-width: 500px;' + 'width: 100%;' + '}' +
|
||||
|
||||
'li {' + 'background-color: #333;' + 'margin: 5px;' + 'padding: 15px;' +
|
||||
'border-radius: 5px;' + 'text-align: left;' + '}' +
|
||||
|
||||
'#currentVolume {' + 'font-size: 16px;' + 'color: #ddd;' +
|
||||
'margin-bottom: 10px;' + '}' + '</style>' +
|
||||
|
||||
'<script>' + 'function setVolume(val) {' +
|
||||
' fetch("/setVolume?value=" + val); ' +
|
||||
' document.getElementById("currentVolume").innerText = "Ãðîìêîñòü: " + val + "%";'
|
||||
+ '} ' +
|
||||
|
||||
'function btn(val) {' + ' if (val == 1) {' +
|
||||
' const icon = document.getElementById("playIcon");' +
|
||||
' icon.classList.toggle("fa-play");' +
|
||||
' icon.classList.toggle("fa-pause");' + ' fetch("/button1");' + ' }'
|
||||
+ ' if (val == 2) fetch("/button2");' + '}' + '</script>' + '</head>' +
|
||||
'<body>' + '<div class="controls">' +
|
||||
|
||||
'<i id="playIcon" class="icon-btn fas ' + playIcon +
|
||||
'" onclick="btn(1)"></i>' +
|
||||
'<i class="icon-btn fas fa-forward" onclick="btn(2)"></i>' + '</div>' +
|
||||
|
||||
'<div class="volume-container">' + '<label id="currentVolume">Ãðîìêîñòü: ' +
|
||||
IntToStr(mVolume) + '%</label>' +
|
||||
'<input type="range" min="0" max="100" value="' + IntToStr(mVolume) +
|
||||
'" onchange="setVolume(this.value)" />' + '</div>' +
|
||||
|
||||
'<ul id="songList">' + s + '</ul>' +
|
||||
|
||||
'<script>' + 'function updateSongList() {' + ' fetch("/getSongs")' +
|
||||
' .then(response => response.json())' + ' .then(data => {' +
|
||||
' const listElement = document.getElementById("songList");' +
|
||||
' listElement.innerHTML = "";' + ' data.forEach(song => {' +
|
||||
' const li = document.createElement("li");' +
|
||||
' li.textContent = song;' + ' listElement.appendChild(li);' +
|
||||
' });' + ' })' +
|
||||
' .catch(error => console.error("Error fetching songs:", error));' + '}'
|
||||
+ 'setInterval(updateSongList, 3000);' + '</script>' + '</body>' +
|
||||
'</html>';
|
||||
end;
|
||||
|
||||
procedure TOBS_Doc_Player.TrackBar1Change(Sender: TObject);
|
||||
begin
|
||||
mVolume := Round(TrackBar1.Value);
|
||||
b.Volume := mVolume;
|
||||
end;
|
||||
|
||||
procedure TOBS_Doc_Player.WebModule1DefaultHandlerAction(Sender: TObject;
|
||||
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
|
||||
var
|
||||
VolumeStr: string;
|
||||
VolumeValue, i: Integer;
|
||||
begin
|
||||
if Request.PathInfo = '/getSongs' then
|
||||
begin
|
||||
// Âîçâðàùàåì ñïèñîê ïåñåí â ôîðìàòå JSON
|
||||
var
|
||||
songList: string := '[';
|
||||
for i := 0 to ListBox1.Items.Count - 1 do
|
||||
begin
|
||||
songList := songList + '"' + ListBox1.Items[i] + '"';
|
||||
if i < ListBox1.Items.Count - 1 then
|
||||
songList := songList + ',';
|
||||
end;
|
||||
songList := songList + ']';
|
||||
|
||||
Response.Content := songList; // Îòïðàâëÿåì JSON
|
||||
Response.ContentType := 'application/json;charset=utf8';
|
||||
Handled := True;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if Request.PathInfo = '/setVolume' then
|
||||
begin
|
||||
// Ïîëó÷àåì çíà÷åíèå èç ïàðàìåòðà 'value'
|
||||
VolumeStr := Request.QueryFields.Values['value'];
|
||||
// Ïðîáóåì ïðåîáðàçîâàòü â öåëîå ÷èñëî
|
||||
if TryStrToInt(VolumeStr, VolumeValue) then
|
||||
begin
|
||||
// Åñëè óäàëîñü ïðåîáðàçîâàòü, îáíîâëÿåì ïåðåìåííóþ mVolume
|
||||
mVolume := VolumeValue;
|
||||
// Îáíîâëÿåì çâóê íà ñåðâåðå (åñëè íóæíî, íàïðèìåð, ÷åðåç áèáëèîòåêó bass)
|
||||
b.Volume := mVolume;
|
||||
// Âîçâðàùàåì îáíîâëåííîå ñîñòîÿíèå íà ñòðàíèöó
|
||||
Response.Content := gethtml;
|
||||
end
|
||||
else
|
||||
begin
|
||||
// Åñëè íå óäàëîñü ïðåîáðàçîâàòü, âîçâðàùàåì îøèáêó
|
||||
Response.Content := 'Invalid volume value';
|
||||
end;
|
||||
Handled := True; // Çàïðîñ îáðàáîòàí
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if Request.PathInfo = '/button1' then
|
||||
begin
|
||||
Button1Click(Sender); // Âûçîâ ïðîöåäóðû äëÿ êíîïêè 1
|
||||
Response.Content := gethtml;
|
||||
Handled := True; // Óêàçûâàåì, ÷òî çàïðîñ áûë îáðàáîòàí
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if Request.PathInfo = '/button2' then
|
||||
begin
|
||||
Button2Click(Sender); // Âûçîâ ïðîöåäóðû äëÿ êíîïêè 2
|
||||
Response.Content := gethtml;
|
||||
Handled := True; // Óêàçûâàåì, ÷òî çàïðîñ áûë îáðàáîòàí
|
||||
Exit;
|
||||
end;
|
||||
|
||||
Response.Content := gethtml;
|
||||
Handled := True;
|
||||
end;
|
||||
|
||||
procedure TOBS_Doc_Player.WebModuleCreate(Sender: TObject);
|
||||
begin
|
||||
mySoundPath := GetPathToTestExe + 'TTW_Bot\ytSongs';
|
||||
b := TBassSimple.Create(0);
|
||||
player := TPlayerThread.Create(b, mySoundPath);
|
||||
player.OnAddAd := add;
|
||||
player.OnSkip := del;
|
||||
mVolume := 0;
|
||||
ListBox1 := TListBox.Create(self);
|
||||
player.Start;
|
||||
isplay := '1';
|
||||
end;
|
||||
|
||||
procedure TOBS_Doc_Player.WebModuleDestroy(Sender: TObject);
|
||||
begin
|
||||
player.Free;
|
||||
b.Free;
|
||||
ListBox1.Free;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,183 @@
|
||||
unit uPlayerThread;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, SyncObjs, Generics.Collections, bass_simple,
|
||||
System.IOUtils, Types;
|
||||
|
||||
type
|
||||
TOnError = procedure(const Msg, FileName: string) of object;
|
||||
TOnSkip = procedure(const FileName: string) of object;
|
||||
|
||||
TPlayerThread = class(TThread)
|
||||
private
|
||||
b: tbasssimple;
|
||||
FFilesQueue: TList<string>;
|
||||
FQueueCS: TCriticalSection;
|
||||
FCurrentFile: string;
|
||||
FOnError: TOnError;
|
||||
FOnSkip: TOnSkip;
|
||||
FOnAddAd: TOnSkip;
|
||||
FMusicFolder: string;
|
||||
FIsPlaying: Boolean;
|
||||
procedure PlayCurrentFile;
|
||||
procedure ScanFolder;
|
||||
procedure OnPlayHandler(Sender: TObject);
|
||||
procedure OnStopHandler(Sender: TObject);
|
||||
procedure OnEndPlayHandler(Sender: TObject);
|
||||
protected
|
||||
procedure Execute; override;
|
||||
public
|
||||
constructor Create(var ab: tbasssimple; const aFolder: string);
|
||||
destructor Destroy; override;
|
||||
procedure Skip;
|
||||
property OnError: TOnError read FOnError write FOnError;
|
||||
property OnSkip: TOnSkip read FOnSkip write FOnSkip;
|
||||
property OnAddAd: TOnSkip read FOnAddAd write FOnAddAd;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
constructor TPlayerThread.Create(var ab: tbasssimple; const aFolder: string);
|
||||
begin
|
||||
inherited Create(True);
|
||||
b := ab;
|
||||
FMusicFolder := aFolder;
|
||||
FIsPlaying := False;
|
||||
b.OnPlay := OnPlayHandler;
|
||||
b.OnStop := OnStopHandler;
|
||||
b.OnEndPlay := OnEndPlayHandler;
|
||||
FFilesQueue := TList<string>.Create;
|
||||
FQueueCS := TCriticalSection.Create;
|
||||
end;
|
||||
|
||||
destructor TPlayerThread.Destroy;
|
||||
begin
|
||||
FQueueCS.Enter;
|
||||
try
|
||||
FFilesQueue.Free;
|
||||
finally
|
||||
FQueueCS.Leave;
|
||||
end;
|
||||
FQueueCS.Free;
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TPlayerThread.Execute;
|
||||
begin
|
||||
while not Terminated do
|
||||
begin
|
||||
|
||||
ScanFolder;
|
||||
if (not FIsPlaying) then
|
||||
begin
|
||||
FQueueCS.Enter;
|
||||
try
|
||||
if (FFilesQueue.Count > 0) then
|
||||
begin
|
||||
FCurrentFile := FFilesQueue[0];
|
||||
FFilesQueue.Delete(0);
|
||||
end;
|
||||
finally
|
||||
FQueueCS.Leave;
|
||||
end;
|
||||
PlayCurrentFile;
|
||||
end;
|
||||
|
||||
Sleep(1000);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPlayerThread.PlayCurrentFile;
|
||||
begin
|
||||
if (FCurrentFile = '') or (not FileExists(FCurrentFile)) then
|
||||
begin
|
||||
if Assigned(FOnError) then
|
||||
FOnError('Ôàéë íå íàéäåí', FCurrentFile);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
// Ñîçäàåì íîâûé ïîòîê è íà÷èíàåì âîñïðîèçâåäåíèå
|
||||
TThread.Synchronize(nil,
|
||||
procedure
|
||||
begin
|
||||
b.Play(FCurrentFile);
|
||||
end);
|
||||
|
||||
FIsPlaying := True;
|
||||
|
||||
end;
|
||||
|
||||
procedure TPlayerThread.ScanFolder;
|
||||
var
|
||||
Files: TStringDynArray;
|
||||
FileName: string;
|
||||
begin
|
||||
Files := TDirectory.GetFiles(FMusicFolder, '*.mp3');
|
||||
FQueueCS.Enter;
|
||||
try
|
||||
for FileName in Files do
|
||||
if FFilesQueue.IndexOf(FileName) = -1 then
|
||||
begin
|
||||
Sleep(5000);
|
||||
FFilesQueue.Add(FileName);
|
||||
if Assigned(FOnAddAd) then
|
||||
TThread.Synchronize(nil,
|
||||
procedure
|
||||
begin
|
||||
FOnAddAd(ExtractFileName(FileName));
|
||||
end);
|
||||
end;
|
||||
finally
|
||||
FQueueCS.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPlayerThread.OnPlayHandler(Sender: TObject);
|
||||
begin
|
||||
FIsPlaying := True;
|
||||
end;
|
||||
|
||||
procedure TPlayerThread.OnStopHandler(Sender: TObject);
|
||||
begin
|
||||
FIsPlaying := False;
|
||||
end;
|
||||
|
||||
procedure TPlayerThread.OnEndPlayHandler(Sender: TObject);
|
||||
begin
|
||||
try
|
||||
b.Stop;
|
||||
b.FreeStream;
|
||||
if FileExists(FCurrentFile) then
|
||||
begin
|
||||
DeleteFile(FCurrentFile);
|
||||
if Assigned(FOnSkip) then
|
||||
FOnSkip(ExtractFileName(FCurrentFile));
|
||||
end;
|
||||
FCurrentFile := '';
|
||||
FIsPlaying := False;
|
||||
except
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPlayerThread.Skip;
|
||||
begin
|
||||
if FIsPlaying then
|
||||
begin
|
||||
b.Stop;
|
||||
b.FreeStream;
|
||||
if FileExists(FCurrentFile) then
|
||||
begin
|
||||
DeleteFile(FCurrentFile);
|
||||
if Assigned(FOnSkip) then
|
||||
FOnSkip(ExtractFileName(FCurrentFile));
|
||||
end;
|
||||
FCurrentFile := '';
|
||||
FIsPlaying := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -2,6 +2,9 @@ unit uRecords;
|
||||
|
||||
interface
|
||||
|
||||
|
||||
|
||||
|
||||
type
|
||||
TRLog = record
|
||||
rTime: ttime;
|
||||
@@ -77,6 +80,7 @@ type
|
||||
MaxCountMess: integer;
|
||||
TimeMess: integer;
|
||||
port: integer;
|
||||
freez:integer;
|
||||
StyleFont: integer;
|
||||
end;
|
||||
|
||||
@@ -103,7 +107,6 @@ type
|
||||
soundsPath: string;
|
||||
stlPath: string;
|
||||
ytSongsPath: string;
|
||||
PublicPlay: string;
|
||||
SilentPlay: string;
|
||||
ytPlay: string;
|
||||
cfg1: string;
|
||||
@@ -0,0 +1,98 @@
|
||||
unit uSoundManager;
|
||||
|
||||
interface
|
||||
|
||||
uses classes, ShellAPI, bass_simple, windows, System.SysUtils;
|
||||
|
||||
type
|
||||
TSongMachine = class(TObject)
|
||||
|
||||
private
|
||||
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy;
|
||||
procedure PlayPublic(AFileName: string; aVolume: string);
|
||||
procedure PlaySilent(AFileName: string; aVolume: string);
|
||||
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses uGeneral;
|
||||
|
||||
var
|
||||
mp: TBassSimple;
|
||||
|
||||
{ SongMachine }
|
||||
|
||||
constructor TSongMachine.Create;
|
||||
begin
|
||||
mp := TBassSimple.Create(0);
|
||||
end;
|
||||
|
||||
destructor TSongMachine.Destroy;
|
||||
begin
|
||||
mp.FreeStream;
|
||||
mp.Free;
|
||||
end;
|
||||
|
||||
function TimeToSeconds(const timeStr: string): Integer;
|
||||
var
|
||||
minutes, seconds: Integer;
|
||||
begin
|
||||
if TryStrToInt(Copy(timeStr, 1, 2), minutes) and
|
||||
TryStrToInt(Copy(timeStr, 4, 5), seconds) then
|
||||
begin
|
||||
result := minutes * 60 + seconds;
|
||||
end
|
||||
else
|
||||
begin
|
||||
result := -1;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSongMachine.PlaySilent(AFileName: string; aVolume: string);
|
||||
var
|
||||
sec: string;
|
||||
mm: TBassSimple;
|
||||
begin
|
||||
try
|
||||
if not FileExists(AFileName) then
|
||||
begin
|
||||
TTW_Bot.toLog( 'TSongMachine', 'PlayPublic', 'Íåò ôàéëà ' + AFileName,2);
|
||||
exit;
|
||||
end;
|
||||
mm := TBassSimple.Create(0);
|
||||
try
|
||||
mm.OpenFile(AFileName);
|
||||
sec := inttostr(TimeToSeconds(mm.TimeLength) + 1);
|
||||
finally
|
||||
mm.FreeStream;
|
||||
mm.Free;
|
||||
end;
|
||||
ShellExecute(0, 'open', PChar(myConst.SilentPlay),
|
||||
PChar(Format('%s %s "%s"', [sec, aVolume, AFileName])), nil, SW_HIDE);
|
||||
except
|
||||
on e: Exception do
|
||||
TTW_Bot.toLog( 'TSongMachine', 'PlaySilent', e.message,2)
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSongMachine.PlayPublic(AFileName: string; aVolume: string);
|
||||
begin
|
||||
try
|
||||
if not FileExists(AFileName) then
|
||||
begin
|
||||
TTW_Bot.toLog( 'TSongMachine', 'PlayPublic', 'Íåò ôàéëà ' + AFileName,2);
|
||||
exit;
|
||||
end;
|
||||
mp.Volume := strtoint(aVolume);
|
||||
mp.Play(AFileName)
|
||||
except
|
||||
on e: Exception do
|
||||
TTW_Bot.toLog( 'TSongMachine', 'PlaySilent', e.message,2)
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
+212
@@ -0,0 +1,212 @@
|
||||
unit uTTS;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, SysUtils, Classes, MMSystem;
|
||||
|
||||
type
|
||||
TPlayFinishedEvent = procedure(Sender: TObject) of object;
|
||||
|
||||
type
|
||||
TTTS = class
|
||||
private
|
||||
FPiperExePath: string;
|
||||
FVoicesFolder: string;
|
||||
FCurrentModel: string;
|
||||
FOnPlayFinished: TPlayFinishedEvent;
|
||||
procedure DoPlayFinished;
|
||||
function RunProcessCaptureOutput(const Exe, Args, InputText: string; out OutputText: string): Boolean;
|
||||
public
|
||||
constructor Create(const APiperExePath, AVoicesFolder: string);
|
||||
/// <summary>Ñïèñîê ìîäåëåé (ôàéëû .onnx) â ïàïêå voices</summary>
|
||||
function GetModelsList: TStringList;
|
||||
|
||||
/// <summary>Âûáðàòü ìîäåëü îçâó÷èâàíèÿ (èìÿ ôàéëà .onnx)</summary>
|
||||
procedure SetModel(const ModelFileName: string);
|
||||
|
||||
/// <summary>Îçâó÷èòü òåêñò âûáðàííîé ìîäåëüþ</summary>
|
||||
procedure TextToSpeech(const aText: string; isDeleteFile: Boolean = False);
|
||||
|
||||
property OnPlayFinished: TPlayFinishedEvent read FOnPlayFinished write FOnPlayFinished;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
procedure TTTS.DoPlayFinished;
|
||||
begin
|
||||
if Assigned(FOnPlayFinished) then
|
||||
FOnPlayFinished(Self);
|
||||
end;
|
||||
|
||||
constructor TTTS.Create(const APiperExePath, AVoicesFolder: string);
|
||||
begin
|
||||
inherited Create;
|
||||
FPiperExePath := APiperExePath;
|
||||
FVoicesFolder := AVoicesFolder;
|
||||
FCurrentModel := ''; // Ïîêà íå âûáðàíà ìîäåëü
|
||||
end;
|
||||
|
||||
function TTTS.GetModelsList: TStringList;
|
||||
var
|
||||
SR: TSearchRec;
|
||||
begin
|
||||
Result := TStringList.Create;
|
||||
if not DirectoryExists(FVoicesFolder) then Exit;
|
||||
if FindFirst(FVoicesFolder + PathDelim + '*.onnx', faAnyFile, SR) = 0 then
|
||||
begin
|
||||
repeat
|
||||
Result.Add(SR.Name);
|
||||
until FindNext(SR) <> 0;
|
||||
FindClose(SR);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTTS.SetModel(const ModelFileName: string);
|
||||
var
|
||||
FullPath: string;
|
||||
begin
|
||||
FullPath := IncludeTrailingPathDelimiter(FVoicesFolder) + ModelFileName;
|
||||
if not FileExists(FullPath) then
|
||||
raise Exception.CreateFmt('Ìîäåëü íå íàéäåíà: %s', [FullPath]);
|
||||
FCurrentModel := FullPath;
|
||||
end;
|
||||
|
||||
function TTTS.RunProcessCaptureOutput(const Exe, Args, InputText: string; out OutputText: string): Boolean;
|
||||
var
|
||||
SecAttr: TSecurityAttributes;
|
||||
StdOutRead, StdOutWrite: THandle;
|
||||
StdInRead, StdInWrite: THandle;
|
||||
StartupInfo: TStartupInfo;
|
||||
ProcInfo: TProcessInformation;
|
||||
Buffer: array [0..4095] of AnsiChar;
|
||||
BytesRead: Cardinal;
|
||||
ReadOK: BOOL;
|
||||
Stream: TStringStream;
|
||||
InheritHandles: Boolean;
|
||||
BytesWritten: Cardinal;
|
||||
Utf8Bytes: TBytes;
|
||||
begin
|
||||
Result := False;
|
||||
OutputText := '';
|
||||
Stream := TStringStream.Create('', TEncoding.UTF8);
|
||||
try
|
||||
SecAttr.nLength := SizeOf(SecAttr);
|
||||
SecAttr.bInheritHandle := True;
|
||||
SecAttr.lpSecurityDescriptor := nil;
|
||||
|
||||
if not CreatePipe(StdOutRead, StdOutWrite, @SecAttr, 0) then Exit;
|
||||
try
|
||||
if not SetHandleInformation(StdOutRead, HANDLE_FLAG_INHERIT, 0) then Exit;
|
||||
|
||||
if not CreatePipe(StdInRead, StdInWrite, @SecAttr, 0) then Exit;
|
||||
try
|
||||
if not SetHandleInformation(StdInWrite, HANDLE_FLAG_INHERIT, 0) then Exit;
|
||||
|
||||
ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
|
||||
StartupInfo.cb := SizeOf(StartupInfo);
|
||||
StartupInfo.hStdOutput := StdOutWrite;
|
||||
StartupInfo.hStdError := StdOutWrite;
|
||||
StartupInfo.hStdInput := StdInRead;
|
||||
StartupInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
|
||||
StartupInfo.wShowWindow := SW_HIDE;
|
||||
|
||||
InheritHandles := True;
|
||||
|
||||
if not CreateProcess(PChar(Exe), PChar('"' + Exe + '" ' + Args), nil, nil,
|
||||
InheritHandles, CREATE_NO_WINDOW, nil, nil, StartupInfo, ProcInfo) then Exit;
|
||||
|
||||
CloseHandle(StdOutWrite);
|
||||
CloseHandle(StdInRead);
|
||||
|
||||
if InputText <> '' then
|
||||
begin
|
||||
Utf8Bytes := TEncoding.UTF8.GetBytes(InputText + #10);
|
||||
WriteFile(StdInWrite, Utf8Bytes[0], Length(Utf8Bytes), BytesWritten, nil);
|
||||
end;
|
||||
CloseHandle(StdInWrite);
|
||||
|
||||
repeat
|
||||
ReadOK := ReadFile(StdOutRead, Buffer, SizeOf(Buffer), BytesRead, nil);
|
||||
if ReadOK and (BytesRead > 0) then
|
||||
Stream.Write(Buffer, BytesRead);
|
||||
until not ReadOK or (BytesRead = 0);
|
||||
|
||||
WaitForSingleObject(ProcInfo.hProcess, INFINITE);
|
||||
|
||||
CloseHandle(ProcInfo.hThread);
|
||||
CloseHandle(ProcInfo.hProcess);
|
||||
|
||||
OutputText := Stream.DataString;
|
||||
Result := True;
|
||||
finally
|
||||
CloseHandle(StdInWrite);
|
||||
CloseHandle(StdInRead);
|
||||
end;
|
||||
finally
|
||||
CloseHandle(StdOutRead);
|
||||
CloseHandle(StdOutWrite);
|
||||
end;
|
||||
finally
|
||||
Stream.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTTS.TextToSpeech(const aText: string; isDeleteFile: Boolean);
|
||||
var
|
||||
Args, Text, Output, WavFile: string;
|
||||
Lines: TStringList;
|
||||
i: Integer;
|
||||
begin
|
||||
if (FPiperExePath = '') or (FCurrentModel = '') then
|
||||
raise Exception.Create('Piper.exe èëè ìîäåëü íå óêàçàíû.');
|
||||
|
||||
Text := Trim(aText);
|
||||
if Text = '' then Exit;
|
||||
|
||||
// Ôîðìèðóåì àðãóìåíòû - ïóñòü Piper ñîõðàíÿåò wav â òåêóùóþ ïàïêó ñ óíèêàëüíûì èìåíåì
|
||||
Args := '--model "' + FCurrentModel + '" -f o.wav';
|
||||
|
||||
if not RunProcessCaptureOutput(FPiperExePath, Args, Text, Output) then
|
||||
begin
|
||||
|
||||
Exit;
|
||||
end;
|
||||
|
||||
Lines := TStringList.Create;
|
||||
try
|
||||
Lines.Text := Output;
|
||||
WavFile := '';
|
||||
for i := Lines.Count - 1 downto 0 do
|
||||
if (Pos('.wav', LowerCase(Lines[i])) > 0) and FileExists(Trim(Lines[i])) then
|
||||
begin
|
||||
WavFile := Trim(Lines[i]);
|
||||
Break;
|
||||
end;
|
||||
|
||||
if WavFile <> '' then
|
||||
begin
|
||||
// Çàïóñêàåì â îòäåëüíîì ïîòîêå, ÷òîáû îòñëåäèòü îêîí÷àíèå
|
||||
TThread.CreateAnonymousThread(
|
||||
procedure
|
||||
begin
|
||||
PlaySound(PChar(WavFile), 0, SND_FILENAME); // áåç SND_ASYNC — æä¸ì îêîí÷àíèÿ
|
||||
if isDeleteFile then
|
||||
DeleteFile(WavFile);
|
||||
TThread.Synchronize(nil,
|
||||
procedure
|
||||
begin
|
||||
DoPlayFinished;
|
||||
end
|
||||
);
|
||||
end
|
||||
).Start;
|
||||
end;
|
||||
|
||||
finally
|
||||
Lines.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@@ -0,0 +1,293 @@
|
||||
unit uWebServerChat;
|
||||
|
||||
interface
|
||||
|
||||
uses classes, StrUtils, DateUtils, System.JSON, System.Generics.Collections,
|
||||
IdBaseComponent, IdComponent, IdCustomTCPServer, IdContext,
|
||||
IdCustomHTTPServer, uRecords, System.IOUtils, IdGlobalProtocols,
|
||||
IdHTTPServer, System.SysUtils;
|
||||
|
||||
type
|
||||
TTwitchMessage = record
|
||||
Nickname: string;
|
||||
Content: string;
|
||||
Timestamp: TDateTime;
|
||||
TimeMsg: Integer;
|
||||
end;
|
||||
|
||||
type
|
||||
TTTW_Chat = class(TObject)
|
||||
msgStyle: TStyleChat;
|
||||
fFontsList: tstringlist;
|
||||
IdHTTPServer1: TIdHTTPServer;
|
||||
procedure IdHTTPServer1CommandGet(AContext: TIdContext;
|
||||
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
|
||||
private
|
||||
FBColor: string;
|
||||
Messages: TThreadList<TTwitchMessage>;
|
||||
FDeleteByTime: Boolean; // Ðåæèì óäàëåíèÿ: ïî âðåìåíè (true) èëè êîëè÷åñòâó (false)
|
||||
FMaxMsgCount: Integer; // Ìàêñèìàëüíîå êîëè÷åñòâî ñîîáùåíèé
|
||||
function GenerateHTML: string;
|
||||
function GenerateJSON: string;
|
||||
procedure CleanupOldMessages;
|
||||
public
|
||||
constructor Create(FontList: tstrings; aPort:integer; aColor:string);
|
||||
destructor Destroy;
|
||||
procedure addMessage(newMsg: TStyleChat);
|
||||
procedure ActiveServer(aEn: boolean);
|
||||
procedure SetDeleteMode(DeleteByTime: Boolean; MaxMsgCount: Integer); // Óñòàíîâêà ðåæèìà óäàëåíèÿ
|
||||
procedure changeBackground(aColor:string);
|
||||
end;
|
||||
|
||||
var
|
||||
Timestamp2: string;
|
||||
|
||||
implementation
|
||||
|
||||
uses uGeneral;
|
||||
|
||||
{ TTTW_Chat }
|
||||
|
||||
procedure TTTW_Chat.SetDeleteMode(DeleteByTime: Boolean; MaxMsgCount: Integer);
|
||||
begin
|
||||
FDeleteByTime := DeleteByTime;
|
||||
FMaxMsgCount := MaxMsgCount;
|
||||
end;
|
||||
|
||||
procedure TTTW_Chat.ActiveServer(aEn: boolean);
|
||||
begin
|
||||
IdHTTPServer1.Active := aEn;
|
||||
end;
|
||||
|
||||
procedure TTTW_Chat.addMessage(newMsg: TStyleChat);
|
||||
var
|
||||
Msg: TTwitchMessage;
|
||||
begin
|
||||
Msg.Nickname := newMsg.Nick;
|
||||
Msg.Content := newMsg.Context;
|
||||
Msg.Timestamp := now;
|
||||
Msg.TimeMsg := newMsg.TimeMsg;
|
||||
msgStyle := newMsg;
|
||||
with Messages.LockList do
|
||||
try
|
||||
if not FDeleteByTime then
|
||||
begin
|
||||
// Óäàëåíèå ñòàðûõ ñîîáùåíèé ïðè ïðåâûøåíèè ëèìèòà
|
||||
while Count >= FMaxMsgCount do
|
||||
Delete(0);
|
||||
end;
|
||||
Add(Msg);
|
||||
finally
|
||||
Messages.UnlockList;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTTW_Chat.changeBackground(aColor: string);
|
||||
begin
|
||||
FBColor:=aColor;
|
||||
end;
|
||||
|
||||
procedure TTTW_Chat.CleanupOldMessages;
|
||||
var
|
||||
MsgList: TList<TTwitchMessage>;
|
||||
I: integer;
|
||||
ExpiryTime: TDateTime;
|
||||
begin
|
||||
if not FDeleteByTime then
|
||||
Exit; // Âûõîäèì, åñëè óäàëåíèå ïî âðåìåíè îòêëþ÷åíî
|
||||
MsgList := Messages.LockList;
|
||||
try
|
||||
for I := MsgList.Count - 1 downto 0 do
|
||||
begin
|
||||
ExpiryTime := Now - (MsgList[I].TimeMsg / 86400); // Èñïîëüçóåì çíà÷åíèå èç ñîîáùåíèÿ
|
||||
if MsgList[I].Timestamp < ExpiryTime then
|
||||
MsgList.Delete(I);
|
||||
end;
|
||||
finally
|
||||
Messages.UnlockList;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TTTW_Chat.Create(FontList: tstrings; aPort:integer;AColor:string);
|
||||
var
|
||||
I: integer;
|
||||
begin
|
||||
FBColor := AColor;
|
||||
Messages := TThreadList<TTwitchMessage>.Create;
|
||||
IdHTTPServer1 := TIdHTTPServer.Create;
|
||||
IdHTTPServer1.DefaultPort := aPort;
|
||||
IdHTTPServer1.OnCommandGet := IdHTTPServer1CommandGet;
|
||||
fFontsList := tstringlist.Create;
|
||||
for I := 0 to FontList.Count - 1 do
|
||||
fFontsList.Add(FontList[I]);
|
||||
FDeleteByTime := True; // Ïî óìîë÷àíèþ óäàëåíèå ïî âðåìåíè
|
||||
FMaxMsgCount := 100; // Çíà÷åíèå ïî óìîë÷àíèþ
|
||||
|
||||
end;
|
||||
|
||||
destructor TTTW_Chat.Destroy;
|
||||
begin
|
||||
Messages.Free;
|
||||
IdHTTPServer1.Active := false;
|
||||
IdHTTPServer1.Free;
|
||||
fFontsList.Free;
|
||||
end;
|
||||
|
||||
|
||||
function TTTW_Chat.GenerateHTML: string;
|
||||
var
|
||||
I: integer;
|
||||
s, s1: string;
|
||||
DeleteByTimeJS: string;
|
||||
begin
|
||||
DeleteByTimeJS := LowerCase(BoolToStr(FDeleteByTime)); // Ïðåîáðàçóåì áóëåâî çíà÷åíèå â ñòðîêó 'true' èëè 'false'
|
||||
s := 'body { background: ' + FBColor + '; }' + #13#10;
|
||||
for I := 41 to fFontsList.Count - 1 do
|
||||
begin
|
||||
s1 := StringReplace(fFontsList[I], '.ttf', '', [rfReplaceAll]);
|
||||
s := s + '@font-face { font-family: ''' + s1 + '''; src: url(fonts/' + fFontsList[I] + '); }' + #13#10;
|
||||
end;
|
||||
|
||||
Result := '<!DOCTYPE html><html><head>' +
|
||||
'<meta http-equiv="Cache-Control" content="no-cache, no-store, must-revalidate">' +
|
||||
'<meta http-equiv="Pragma" content="no-cache"><meta http-equiv="Expires" content="0">' +
|
||||
'<title>Messages</title><style>' + s +
|
||||
'.message { margin:5px; border-radius:5px; transition: opacity 1s linear; display: flex; align-items: center; }' +
|
||||
'.message-icon { width: 1.5em; height: 1.5em; margin-right: 0.5em; }' + // Ñòèëü äëÿ èêîíêè
|
||||
'</style><script>' +
|
||||
'let existingMessages = new Map(); let fetching = false;' +
|
||||
'function fetchMessages() {' +
|
||||
' if (fetching) return; fetching = true;' +
|
||||
' fetch("/messages").then(response => response.json()).then(data => {' +
|
||||
' const container = document.getElementById("messages");' +
|
||||
' const newIds = new Set();' +
|
||||
' data.forEach(msg => {' +
|
||||
' const msgId = "msg-" + msg.timestamp;' +
|
||||
' newIds.add(msgId);' +
|
||||
' if (!existingMessages.has(msgId)) {' +
|
||||
' const div = document.createElement("div");' +
|
||||
' div.className = "message";' +
|
||||
' div.id = msgId;' +
|
||||
' div.style = `background-color:${msg.color}; font-family:${msg.family}; ' +
|
||||
' padding:${msg.padding}px; border: ${msg.sizeBorder}px solid ${msg.colorBorder}; ' +
|
||||
' color:${msg.colorText}; font-size:${msg.fontSize}px;`;' +
|
||||
' div.innerHTML = `' +
|
||||
// ' <img src="${msg.iconUrl}" class="message-icon">' + // Äîáàâëåíà èêîíêà
|
||||
' <div><b>${msg.nickname}:</b> ${msg.content}</div>`;' +
|
||||
' div.style.opacity = "1";' +
|
||||
' container.appendChild(div);' +
|
||||
' existingMessages.set(msgId, div);' +
|
||||
' if (deleteByTime) {' + // Óñòàíàâëèâàåì òàéìåð òîëüêî åñëè âêëþ÷åíî óäàëåíèå ïî âðåìåíè
|
||||
' setTimeout(() => {' +
|
||||
' div.style.opacity = "0";' +
|
||||
' setTimeout(() => { div.remove(); existingMessages.delete(msgId); }, 1000);' +
|
||||
' }, msg.timeMsg * 1000);' +
|
||||
' }' +
|
||||
' }' +
|
||||
' });' +
|
||||
' existingMessages.forEach((div, msgId) => {' +
|
||||
' if (!newIds.has(msgId)) { div.remove(); existingMessages.delete(msgId); }' +
|
||||
' });' +
|
||||
' }).finally(() => { fetching = false; });' +
|
||||
'}' +
|
||||
'setInterval(fetchMessages, 500); fetchMessages();' +
|
||||
'</script></head><body><div id="messages"></div></body></html>';
|
||||
end;
|
||||
|
||||
function TTTW_Chat.GenerateJSON: string;
|
||||
var
|
||||
MsgList: TList<TTwitchMessage>;
|
||||
Msg: TTwitchMessage;
|
||||
JSONArray: TJSONArray;
|
||||
JSONObject: TJSONObject;
|
||||
begin
|
||||
JSONArray := TJSONArray.Create;
|
||||
try
|
||||
MsgList := Messages.LockList;
|
||||
try
|
||||
for Msg in MsgList do
|
||||
begin
|
||||
JSONObject := TJSONObject.Create;
|
||||
JSONObject.AddPair('nickname', Msg.Nickname);
|
||||
JSONObject.AddPair('content', Msg.Content);
|
||||
JSONObject.AddPair('timestamp',
|
||||
TJSONNumber.Create(DateTimeToUnix(Msg.Timestamp)));
|
||||
JSONObject.AddPair('color', msgStyle.BlockColor); // Îñòàâëÿåì HEX-öâåò
|
||||
JSONObject.AddPair('bcolor', msgStyle.BColor); // Îñòàâëÿåì HEX-öâåò
|
||||
JSONObject.AddPair('fontSize', TJSONNumber.Create(msgStyle.FontSize));
|
||||
JSONObject.AddPair('colorText', msgStyle.FontColor);
|
||||
|
||||
JSONObject.AddPair('colorBorder', msgStyle.BorderColor);
|
||||
JSONObject.AddPair('sizeBorder',
|
||||
TJSONNumber.Create(msgStyle.BorderSize));
|
||||
JSONObject.AddPair('padding', TJSONNumber.Create(msgStyle.BorderSize));
|
||||
JSONObject.AddPair('family', msgStyle.FontFamily);
|
||||
JSONObject.AddPair('timeMsg', TJSONNumber.Create(Msg.TimeMsg)); // Äîáàâëÿåì âðåìÿ
|
||||
// Óïðàâëÿåò òîëüêî áëîêîì, íå òåêñòîì
|
||||
JSONArray.Add(JSONObject);
|
||||
end;
|
||||
finally
|
||||
Messages.UnlockList;
|
||||
end;
|
||||
Result := JSONArray.ToString;
|
||||
finally
|
||||
JSONArray.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTTW_Chat.IdHTTPServer1CommandGet(AContext: TIdContext;
|
||||
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
|
||||
var
|
||||
HtmlContent: string;
|
||||
FontFileName: string;
|
||||
FontFilePath: string;
|
||||
MIMEType: string;
|
||||
FS: TFileStream;
|
||||
begin
|
||||
CleanupOldMessages;
|
||||
|
||||
if ARequestInfo.Document = '/messages' then
|
||||
begin
|
||||
AResponseInfo.ContentType := 'application/json; charset=utf-8';
|
||||
AResponseInfo.ContentText := GenerateJSON;
|
||||
end
|
||||
else if Pos('/fonts/', ARequestInfo.Document) = 1 then
|
||||
// Ïðîâåðÿåì çàïðîñ ê øðèôòàì
|
||||
begin
|
||||
// Èçâëåêàåì èìÿ ôàéëà èç URL
|
||||
FontFileName := TPath.GetFileName(ARequestInfo.Document);
|
||||
|
||||
// Ôîðìèðóåì ïîëíûé ïóòü ê ôàéëó (ïàïêà fonts äîëæíà áûòü ðÿäîì ñ èñïîëíÿåìûì ôàéëîì)
|
||||
FontFilePath := myConst.fontsPath + FontFileName;
|
||||
|
||||
// Ïðîâåðÿåì ñóùåñòâîâàíèå ôàéëà
|
||||
if FileExists(FontFilePath) then
|
||||
begin
|
||||
|
||||
MIMEType := 'font/ttf';
|
||||
|
||||
// Íàñòðàèâàåì îòâåò
|
||||
AResponseInfo.ContentType := MIMEType;
|
||||
try
|
||||
FS := TFileStream.Create(FontFilePath, fmOpenRead + fmShareDenyWrite);
|
||||
AResponseInfo.ContentStream := FS;
|
||||
AResponseInfo.ResponseNo := 200;
|
||||
except
|
||||
FS.Free;
|
||||
AResponseInfo.ResponseNo := 500;
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
AResponseInfo.CacheControl := 'no-cache, no-store, must-revalidate';
|
||||
AResponseInfo.Pragma := 'no-cache';
|
||||
AResponseInfo.Expires := 0;
|
||||
Timestamp2 := IntToStr(DateTimeToUnix(now));
|
||||
AResponseInfo.ContentType := 'text/html; charset=utf-8';
|
||||
AResponseInfo.ContentText := GenerateHTML;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user