реструктуризация файлов, добавление вебчатов
This commit is contained in:
@@ -17,3 +17,4 @@ __history/
|
|||||||
backup/
|
backup/
|
||||||
bin/
|
bin/
|
||||||
lib/
|
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.
|
||||||
+265
-316
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;
|
program TTW_Bot_app;
|
||||||
|
|
||||||
uses
|
uses
|
||||||
System.StartUpCopy, SysUtils,
|
System.StartUpCopy,
|
||||||
|
SysUtils,
|
||||||
FMX.Forms,
|
FMX.Forms,
|
||||||
uGeneral in 'uGeneral.pas' {TTW_Bot} ,
|
Web.WebReq,
|
||||||
fSettings in 'fSettings.pas' {frSettings: TFrame} ,
|
IdHTTPWebBrokerBridge,
|
||||||
fAI in 'fAI.pas' {frAI: TFrame} ,
|
fAI in 'frames\fAI.pas' {frAI: TFrame},
|
||||||
fNotify in 'fNotify.pas' {frNotify: TFrame} ,
|
fAutoActions in 'frames\fAutoActions.pas' {frAutoActions: TFrame},
|
||||||
fAutoActions in 'fAutoActions.pas' {frAutoActions: TFrame} ,
|
fColorSettings in 'frames\fColorSettings.pas' {frColorSettings: TFrame},
|
||||||
fOBS in 'fOBS.pas' {frOBS: TFrame} ,
|
fCommands in 'frames\fCommands.pas' {frCommands: TFrame},
|
||||||
fLog in 'fLog.pas' {frLog: TFrame} ,
|
fContruct in 'frames\fContruct.pas' {frContruct: TFrame},
|
||||||
uRecords in 'uRecords.pas',
|
fFontSettings in 'frames\fFontSettings.pas' {frFontSettings: TFrame},
|
||||||
fCommands in 'fCommands.pas' {frCommands: TFrame} ,
|
fGroupsRequest in 'frames\fGroupsRequest.pas' {frGroupsRequest: TFrame},
|
||||||
uDataBase in 'uDataBase.pas',
|
fLog in 'frames\fLog.pas' {frLog: TFrame},
|
||||||
fColorSettings in 'fColorSettings.pas' {frColorSettings: TFrame} ,
|
fNotify in 'frames\fNotify.pas' {frNotify: TFrame},
|
||||||
uCreateChat in 'uCreateChat.pas' {fCreateChat} ,
|
fOBS in 'frames\fOBS.pas' {frOBS: TFrame},
|
||||||
fFontSettings in 'fFontSettings.pas' {frFontSettings: TFrame} ,
|
fSettings in 'frames\fSettings.pas' {frSettings: TFrame},
|
||||||
uCreateNotify in 'uCreateNotify.pas' {fCreateNotify} ,
|
fSimpleGrid in 'frames\fSimpleGrid.pas' {frSimpleGrid: TFrame},
|
||||||
uTWAuth in 'uTWAuth.pas',
|
fTTS in 'frames\fTTS.pas' {frTTS: TFrame},
|
||||||
uTTWAPI in 'uTTWAPI.pas',
|
uCreateChat in 'forms\uCreateChat.pas' {fCreateChat},
|
||||||
uAPIDA in 'uAPIDA.pas',
|
uCreateNotify in 'forms\uCreateNotify.pas' {fCreateNotify},
|
||||||
uShowText in 'uShowText.pas' {fShowText} ,
|
uGeneral in 'forms\uGeneral.pas' {TTW_Bot},
|
||||||
uWSDA in 'uWSDA.pas',
|
uQ in 'forms\uQ.pas' {frmQ},
|
||||||
uQ in 'uQ.pas' {frmQ} ,
|
uShowText in 'forms\uShowText.pas' {fShowText},
|
||||||
fSimpleGrid in 'fSimpleGrid.pas' {frSimpleGrid: TFrame} ,
|
uAPIDA in 'Services\uAPIDA.pas',
|
||||||
fContruct in 'fContruct.pas' {frContruct: TFrame} ,
|
uChatAPI in 'Services\uChatAPI.pas',
|
||||||
fGroupsRequest in 'fGroupsRequest.pas' {frGroupsRequest: TFrame} ,
|
uCustomEmoties in 'Services\uCustomEmoties.pas',
|
||||||
uMyTimer in 'uMyTimer.pas',
|
uGigaChat in 'Services\uGigaChat.pas',
|
||||||
uRegExpr in 'uRegExpr.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}
|
{$R *.res}
|
||||||
|
|
||||||
@@ -36,9 +53,16 @@ begin
|
|||||||
{$IFDEF DEBUG}
|
{$IFDEF DEBUG}
|
||||||
ReportMemoryLeaksOnShutdown := True;
|
ReportMemoryLeaksOnShutdown := True;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
Application.Initialize;
|
if WebRequestHandler <> nil then
|
||||||
|
WebRequestHandler.WebModuleClass := OBS_Doc_Player;
|
||||||
|
|
||||||
|
Application.Initialize;
|
||||||
Application.CreateForm(TTTW_Bot, TTW_Bot);
|
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.OnException := TTW_Bot.GlobalExceptionHandler;
|
||||||
Application.CreateForm(TfCreateChat, fCreateChat);
|
Application.CreateForm(TfCreateChat, fCreateChat);
|
||||||
Application.CreateForm(TfCreateNotify, fCreateNotify);
|
Application.CreateForm(TfCreateNotify, fCreateNotify);
|
||||||
|
|||||||
+97
-54
@@ -317,77 +317,120 @@
|
|||||||
<DelphiCompile Include="$(MainSource)">
|
<DelphiCompile Include="$(MainSource)">
|
||||||
<MainSource>MainSource</MainSource>
|
<MainSource>MainSource</MainSource>
|
||||||
</DelphiCompile>
|
</DelphiCompile>
|
||||||
<DCCReference Include="uGeneral.pas">
|
<DCCReference Include="frames\fAI.pas">
|
||||||
<Form>TTW_Bot</Form>
|
|
||||||
</DCCReference>
|
|
||||||
<DCCReference Include="fSettings.pas">
|
|
||||||
<Form>frSettings</Form>
|
|
||||||
<DesignClass>TFrame</DesignClass>
|
|
||||||
</DCCReference>
|
|
||||||
<DCCReference Include="fAI.pas">
|
|
||||||
<Form>frAI</Form>
|
<Form>frAI</Form>
|
||||||
|
<FormType>fmx</FormType>
|
||||||
<DesignClass>TFrame</DesignClass>
|
<DesignClass>TFrame</DesignClass>
|
||||||
</DCCReference>
|
</DCCReference>
|
||||||
<DCCReference Include="fNotify.pas">
|
<DCCReference Include="frames\fAutoActions.pas">
|
||||||
<Form>frNotify</Form>
|
|
||||||
<DesignClass>TFrame</DesignClass>
|
|
||||||
</DCCReference>
|
|
||||||
<DCCReference Include="fAutoActions.pas">
|
|
||||||
<Form>frAutoActions</Form>
|
<Form>frAutoActions</Form>
|
||||||
|
<FormType>fmx</FormType>
|
||||||
<DesignClass>TFrame</DesignClass>
|
<DesignClass>TFrame</DesignClass>
|
||||||
</DCCReference>
|
</DCCReference>
|
||||||
<DCCReference Include="fOBS.pas">
|
<DCCReference Include="frames\fColorSettings.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">
|
|
||||||
<Form>frColorSettings</Form>
|
<Form>frColorSettings</Form>
|
||||||
|
<FormType>fmx</FormType>
|
||||||
<DesignClass>TFrame</DesignClass>
|
<DesignClass>TFrame</DesignClass>
|
||||||
</DCCReference>
|
</DCCReference>
|
||||||
<DCCReference Include="uCreateChat.pas">
|
<DCCReference Include="frames\fCommands.pas">
|
||||||
<Form>fCreateChat</Form>
|
<Form>frCommands</Form>
|
||||||
</DCCReference>
|
<FormType>fmx</FormType>
|
||||||
<DCCReference Include="fFontSettings.pas">
|
|
||||||
<Form>frFontSettings</Form>
|
|
||||||
<DesignClass>TFrame</DesignClass>
|
<DesignClass>TFrame</DesignClass>
|
||||||
</DCCReference>
|
</DCCReference>
|
||||||
<DCCReference Include="uCreateNotify.pas">
|
<DCCReference Include="frames\fContruct.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">
|
|
||||||
<Form>frContruct</Form>
|
<Form>frContruct</Form>
|
||||||
|
<FormType>fmx</FormType>
|
||||||
<DesignClass>TFrame</DesignClass>
|
<DesignClass>TFrame</DesignClass>
|
||||||
</DCCReference>
|
</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>
|
<Form>frGroupsRequest</Form>
|
||||||
|
<FormType>fmx</FormType>
|
||||||
<DesignClass>TFrame</DesignClass>
|
<DesignClass>TFrame</DesignClass>
|
||||||
</DCCReference>
|
</DCCReference>
|
||||||
<DCCReference Include="uMyTimer.pas"/>
|
<DCCReference Include="frames\fLog.pas">
|
||||||
<DCCReference Include="uRegExpr.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"/>
|
<None Include=".gitignore"/>
|
||||||
<BuildConfiguration Include="Base">
|
<BuildConfiguration Include="Base">
|
||||||
<Key>Base</Key>
|
<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.Width = 970.000000000000000000
|
||||||
Size.Height = 744.000000000000000000
|
Size.Height = 744.000000000000000000
|
||||||
Size.PlatformDefault = False
|
Size.PlatformDefault = False
|
||||||
TabIndex = 7
|
TabIndex = 0
|
||||||
TabOrder = 0
|
TabOrder = 0
|
||||||
TabPosition = PlatformDefault
|
TabPosition = PlatformDefault
|
||||||
Sizes = (
|
Sizes = (
|
||||||
@@ -45,7 +45,7 @@ object TTW_Bot: TTTW_Bot
|
|||||||
item
|
item
|
||||||
end>
|
end>
|
||||||
TextSettings.Trimming = None
|
TextSettings.Trimming = None
|
||||||
IsSelected = False
|
IsSelected = True
|
||||||
ImageIndex = 21
|
ImageIndex = 21
|
||||||
Size.Width = 96.000000000000000000
|
Size.Width = 96.000000000000000000
|
||||||
Size.Height = 26.000000000000000000
|
Size.Height = 26.000000000000000000
|
||||||
@@ -72,15 +72,13 @@ object TTW_Bot: TTTW_Bot
|
|||||||
inherited btnOpenStream: TButton
|
inherited btnOpenStream: TButton
|
||||||
Images = ImageList1
|
Images = ImageList1
|
||||||
ImageIndex = 17
|
ImageIndex = 17
|
||||||
TabOrder = 32
|
|
||||||
end
|
end
|
||||||
inherited btnGetTokenStreamer: TButton
|
inherited btnGetTokenStreamer: TButton
|
||||||
Images = ImageList1
|
Images = ImageList1
|
||||||
ImageIndex = 10
|
ImageIndex = 10
|
||||||
TabOrder = 33
|
|
||||||
end
|
end
|
||||||
inherited edtBotTokenStreamer: TEdit
|
inherited edtBotTokenStreamer: TEdit
|
||||||
TabOrder = 34
|
TabOrder = 33
|
||||||
end
|
end
|
||||||
inherited Label53: TLabel
|
inherited Label53: TLabel
|
||||||
TabOrder = 36
|
TabOrder = 36
|
||||||
@@ -91,39 +89,36 @@ object TTW_Bot: TTTW_Bot
|
|||||||
Images = ImageList1
|
Images = ImageList1
|
||||||
ImageIndex = 10
|
ImageIndex = 10
|
||||||
end
|
end
|
||||||
inherited Label63: TLabel
|
|
||||||
TabOrder = 34
|
|
||||||
end
|
|
||||||
inherited edtDAClientID: TEdit
|
inherited edtDAClientID: TEdit
|
||||||
TabOrder = 37
|
TabOrder = 33
|
||||||
end
|
end
|
||||||
inherited Label64: TLabel
|
inherited Label64: TLabel
|
||||||
TabOrder = 35
|
TabOrder = 31
|
||||||
end
|
end
|
||||||
inherited edtDAClientSecret: TEdit
|
inherited edtDAClientSecret: TEdit
|
||||||
TabOrder = 36
|
TabOrder = 34
|
||||||
end
|
end
|
||||||
inherited Label65: TLabel
|
inherited Label65: TLabel
|
||||||
TabOrder = 38
|
TabOrder = 35
|
||||||
end
|
end
|
||||||
inherited edtDARedirectURL: TEdit
|
inherited edtDARedirectURL: TEdit
|
||||||
TabOrder = 39
|
TabOrder = 42
|
||||||
end
|
end
|
||||||
inherited edtDACode: TEdit
|
inherited edtDACode: TEdit
|
||||||
TabOrder = 40
|
TabOrder = 36
|
||||||
end
|
end
|
||||||
inherited Label66: TLabel
|
inherited Label66: TLabel
|
||||||
TabOrder = 41
|
TabOrder = 39
|
||||||
end
|
end
|
||||||
inherited btnDAStart: TButton
|
inherited btnDAStart: TButton
|
||||||
Images = ImageList1
|
Images = ImageList1
|
||||||
ImageIndex = 18
|
ImageIndex = 18
|
||||||
TabOrder = 42
|
TabOrder = 41
|
||||||
OnClick = frSettings1btnDAStartClick
|
OnClick = frSettings1btnDAStartClick
|
||||||
end
|
end
|
||||||
inherited btnGetDADef: TButton
|
inherited btnGetDADef: TButton
|
||||||
Images = ImageList1
|
Images = ImageList1
|
||||||
TabOrder = 44
|
TabOrder = 43
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
inherited btnOpenRomaning: TButton
|
inherited btnOpenRomaning: TButton
|
||||||
@@ -257,6 +252,7 @@ object TTW_Bot: TTTW_Bot
|
|||||||
inherited btnAIPic: TButton
|
inherited btnAIPic: TButton
|
||||||
Images = ImageList1
|
Images = ImageList1
|
||||||
ImageIndex = 5
|
ImageIndex = 5
|
||||||
|
TabOrder = 46
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
inherited btnAddCommand: TButton
|
inherited btnAddCommand: TButton
|
||||||
@@ -283,8 +279,8 @@ object TTW_Bot: TTTW_Bot
|
|||||||
Viewport.Width = 207.000000000000000000
|
Viewport.Width = 207.000000000000000000
|
||||||
Viewport.Height = 116.000000000000000000
|
Viewport.Height = 116.000000000000000000
|
||||||
end
|
end
|
||||||
inherited btnRandomAdd: TButton
|
inherited btnRandomDel: TButton
|
||||||
TabOrder = 32
|
TabOrder = 31
|
||||||
end
|
end
|
||||||
inherited btnRmGroup: TButton
|
inherited btnRmGroup: TButton
|
||||||
TabOrder = 33
|
TabOrder = 33
|
||||||
@@ -427,6 +423,28 @@ object TTW_Bot: TTTW_Bot
|
|||||||
Text = #1053#1072#1074#1099#1082#1080
|
Text = #1053#1072#1074#1099#1082#1080
|
||||||
ExplicitSize.cx = 79.000000000000000000
|
ExplicitSize.cx = 79.000000000000000000
|
||||||
ExplicitSize.cy = 26.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
|
end
|
||||||
object TabItem4: TTabItem
|
object TabItem4: TTabItem
|
||||||
CustomIcon = <
|
CustomIcon = <
|
||||||
@@ -449,41 +467,84 @@ object TTW_Bot: TTTW_Bot
|
|||||||
Size.Height = 345.000000000000000000
|
Size.Height = 345.000000000000000000
|
||||||
Size.PlatformDefault = False
|
Size.PlatformDefault = False
|
||||||
inherited sgWebChats: TStringGrid
|
inherited sgWebChats: TStringGrid
|
||||||
|
Align = Bottom
|
||||||
|
CanFocus = True
|
||||||
|
ClipChildren = True
|
||||||
|
Position.Y = 63.000000000000000000
|
||||||
Size.Width = 970.000000000000000000
|
Size.Width = 970.000000000000000000
|
||||||
Size.Height = 282.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.Width = 970.000000000000000000
|
||||||
Viewport.Height = 282.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
|
inherited StringColumn2: TStringColumn
|
||||||
|
Header = #1057#1089#1099#1083#1082#1072' '#1076#1083#1103' OBS'
|
||||||
|
HeaderSettings.TextSettings.WordWrap = False
|
||||||
Size.Width = 200.000000000000000000
|
Size.Width = 200.000000000000000000
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
inherited btnCreateOBSChat: TButton
|
inherited btnCreateOBSChat: TButton
|
||||||
Images = ImageList1
|
Images = ImageList1
|
||||||
ImageIndex = 13
|
ImageIndex = 13
|
||||||
|
Position.X = 8.000000000000000000
|
||||||
|
Position.Y = 8.000000000000000000
|
||||||
Size.Width = 94.000000000000000000
|
Size.Width = 94.000000000000000000
|
||||||
|
Size.Height = 22.000000000000000000
|
||||||
Size.PlatformDefault = False
|
Size.PlatformDefault = False
|
||||||
TabOrder = 2
|
TabOrder = 2
|
||||||
|
Text = #1057#1086#1079#1076#1072#1090#1100' '#1095#1072#1090
|
||||||
|
TextSettings.Trimming = None
|
||||||
end
|
end
|
||||||
inherited btnDeleteeChat: TButton
|
inherited btnDeleteeChat: TButton
|
||||||
Anchors = [akTop, akRight]
|
Anchors = [akTop, akRight]
|
||||||
Images = ImageList1
|
Images = ImageList1
|
||||||
ImageIndex = 4
|
ImageIndex = 4
|
||||||
Position.X = 882.000000000000000000
|
Position.X = 882.000000000000000000
|
||||||
|
Position.Y = 8.000000000000000000
|
||||||
TabOrder = 3
|
TabOrder = 3
|
||||||
|
Text = #1059#1076#1072#1083#1080#1090#1100
|
||||||
|
TextSettings.Trimming = None
|
||||||
OnClick = frOBS1btnDeleteeChatClick
|
OnClick = frOBS1btnDeleteeChatClick
|
||||||
end
|
end
|
||||||
inherited Label1: TLabel
|
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
|
end
|
||||||
inherited btnCreateOBSNotify: TButton
|
inherited btnCreateOBSNotify: TButton
|
||||||
Images = ImageList1
|
Images = ImageList1
|
||||||
ImageIndex = 24
|
ImageIndex = 24
|
||||||
Position.X = 110.000000000000000000
|
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
|
end
|
||||||
inherited btnCreateOBSKandinsky: TButton
|
inherited btnCreateOBSKandinsky: TButton
|
||||||
Images = ImageList1
|
Images = ImageList1
|
||||||
ImageIndex = 5
|
ImageIndex = 5
|
||||||
Position.X = 264.000000000000000000
|
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
|
end
|
||||||
object btnCreateChat: TButton
|
object btnCreateChat: TButton
|
||||||
Images = ImageList1
|
Images = ImageList1
|
||||||
@@ -498,6 +559,22 @@ object TTW_Bot: TTTW_Bot
|
|||||||
TextSettings.Trimming = None
|
TextSettings.Trimming = None
|
||||||
end
|
end
|
||||||
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
|
end
|
||||||
object TabItem6: TTabItem
|
object TabItem6: TTabItem
|
||||||
CustomIcon = <
|
CustomIcon = <
|
||||||
@@ -586,7 +663,7 @@ object TTW_Bot: TTTW_Bot
|
|||||||
item
|
item
|
||||||
end>
|
end>
|
||||||
TextSettings.Trimming = None
|
TextSettings.Trimming = None
|
||||||
IsSelected = True
|
IsSelected = False
|
||||||
ImageIndex = 23
|
ImageIndex = 23
|
||||||
Size.Width = 101.000000000000000000
|
Size.Width = 101.000000000000000000
|
||||||
Size.Height = 26.000000000000000000
|
Size.Height = 26.000000000000000000
|
||||||
@@ -602,23 +679,34 @@ object TTW_Bot: TTTW_Bot
|
|||||||
Size.Height = 718.000000000000000000
|
Size.Height = 718.000000000000000000
|
||||||
Size.PlatformDefault = False
|
Size.PlatformDefault = False
|
||||||
inherited GroupBox20: TGroupBox
|
inherited GroupBox20: TGroupBox
|
||||||
|
inherited edtMessage: TEdit
|
||||||
|
TabOrder = 37
|
||||||
|
end
|
||||||
|
inherited edtInterval: TEdit
|
||||||
|
TabOrder = 38
|
||||||
|
end
|
||||||
inherited btnAddMessage: TButton
|
inherited btnAddMessage: TButton
|
||||||
Images = ImageList1
|
Images = ImageList1
|
||||||
ImageIndex = 0
|
ImageIndex = 0
|
||||||
|
TabOrder = 39
|
||||||
end
|
end
|
||||||
inherited btnRmMessage: TButton
|
inherited btnRmMessage: TButton
|
||||||
Images = ImageList1
|
Images = ImageList1
|
||||||
ImageIndex = 4
|
ImageIndex = 4
|
||||||
|
TabOrder = 40
|
||||||
end
|
end
|
||||||
inherited btnEditMessage: TButton
|
inherited btnEditMessage: TButton
|
||||||
Images = ImageList1
|
Images = ImageList1
|
||||||
ImageIndex = 3
|
ImageIndex = 3
|
||||||
|
TabOrder = 41
|
||||||
end
|
end
|
||||||
inherited btnNotifyTest: TButton
|
inherited btnNotifyTest: TButton
|
||||||
Images = ImageList1
|
Images = ImageList1
|
||||||
ImageIndex = 25
|
ImageIndex = 25
|
||||||
|
TabOrder = 42
|
||||||
end
|
end
|
||||||
inherited sgTimers: TStringGrid
|
inherited sgTimers: TStringGrid
|
||||||
|
TabOrder = 43
|
||||||
Viewport.Width = 463.000000000000000000
|
Viewport.Width = 463.000000000000000000
|
||||||
Viewport.Height = 225.000000000000000000
|
Viewport.Height = 225.000000000000000000
|
||||||
inherited scTimerMessage: TStringColumn
|
inherited scTimerMessage: TStringColumn
|
||||||
@@ -630,19 +718,26 @@ object TTW_Bot: TTTW_Bot
|
|||||||
end
|
end
|
||||||
end
|
end
|
||||||
inherited GroupBox23: TGroupBox
|
inherited GroupBox23: TGroupBox
|
||||||
|
inherited edtBanWords: TEdit
|
||||||
|
TabOrder = 37
|
||||||
|
end
|
||||||
inherited btnBanWordsAdd: TButton
|
inherited btnBanWordsAdd: TButton
|
||||||
Images = ImageList1
|
Images = ImageList1
|
||||||
ImageIndex = 0
|
ImageIndex = 0
|
||||||
|
TabOrder = 38
|
||||||
end
|
end
|
||||||
inherited btnBanWordsEdt: TButton
|
inherited btnBanWordsEdt: TButton
|
||||||
Images = ImageList1
|
Images = ImageList1
|
||||||
ImageIndex = 3
|
ImageIndex = 3
|
||||||
|
TabOrder = 39
|
||||||
end
|
end
|
||||||
inherited btnBanWordsDel: TButton
|
inherited btnBanWordsDel: TButton
|
||||||
Images = ImageList1
|
Images = ImageList1
|
||||||
ImageIndex = 4
|
ImageIndex = 4
|
||||||
|
TabOrder = 40
|
||||||
end
|
end
|
||||||
inherited sgBanWords: TStringGrid
|
inherited sgBanWords: TStringGrid
|
||||||
|
TabOrder = 41
|
||||||
Viewport.Width = 297.000000000000000000
|
Viewport.Width = 297.000000000000000000
|
||||||
Viewport.Height = 225.000000000000000000
|
Viewport.Height = 225.000000000000000000
|
||||||
inherited scRegEx: TStringColumn
|
inherited scRegEx: TStringColumn
|
||||||
@@ -655,25 +750,26 @@ object TTW_Bot: TTTW_Bot
|
|||||||
Position.X = 217.000000000000000000
|
Position.X = 217.000000000000000000
|
||||||
Size.Width = 88.000000000000000000
|
Size.Width = 88.000000000000000000
|
||||||
Size.PlatformDefault = False
|
Size.PlatformDefault = False
|
||||||
|
TabOrder = 42
|
||||||
|
end
|
||||||
|
inherited Label6: TLabel
|
||||||
|
TabOrder = 43
|
||||||
end
|
end
|
||||||
inherited edtBanWordsCheck: TEdit
|
inherited edtBanWordsCheck: TEdit
|
||||||
|
TabOrder = 44
|
||||||
Size.Width = 201.000000000000000000
|
Size.Width = 201.000000000000000000
|
||||||
end
|
end
|
||||||
|
inherited Label7: TLabel
|
||||||
|
TabOrder = 45
|
||||||
|
end
|
||||||
|
inherited lBanWordsCheck: TLabel
|
||||||
|
TabOrder = 46
|
||||||
|
end
|
||||||
end
|
end
|
||||||
inherited GroupBox17: TGroupBox
|
inherited GroupBox17: TGroupBox
|
||||||
inherited edtCounterName: TEdit
|
|
||||||
TabOrder = 41
|
|
||||||
end
|
|
||||||
inherited edtCounterTrigger: TEdit
|
|
||||||
TabOrder = 39
|
|
||||||
end
|
|
||||||
inherited edtCounterCount: TEdit
|
|
||||||
TabOrder = 38
|
|
||||||
end
|
|
||||||
inherited btnCounterAdd: TButton
|
inherited btnCounterAdd: TButton
|
||||||
Images = ImageList1
|
Images = ImageList1
|
||||||
ImageIndex = 0
|
ImageIndex = 0
|
||||||
TabOrder = 40
|
|
||||||
end
|
end
|
||||||
inherited btnCounterDelete: TButton
|
inherited btnCounterDelete: TButton
|
||||||
Images = ImageList1
|
Images = ImageList1
|
||||||
@@ -685,7 +781,7 @@ object TTW_Bot: TTTW_Bot
|
|||||||
ImageIndex = 0
|
ImageIndex = 0
|
||||||
Position.X = 416.000000000000000000
|
Position.X = 416.000000000000000000
|
||||||
Size.Width = 22.000000000000000000
|
Size.Width = 22.000000000000000000
|
||||||
TabOrder = 43
|
TabOrder = 42
|
||||||
Text = ''
|
Text = ''
|
||||||
end
|
end
|
||||||
inherited btnCounterM: TButton
|
inherited btnCounterM: TButton
|
||||||
@@ -693,16 +789,16 @@ object TTW_Bot: TTTW_Bot
|
|||||||
ImageIndex = 12
|
ImageIndex = 12
|
||||||
Position.X = 449.000000000000000000
|
Position.X = 449.000000000000000000
|
||||||
Size.Width = 22.000000000000000000
|
Size.Width = 22.000000000000000000
|
||||||
TabOrder = 44
|
TabOrder = 43
|
||||||
Text = ''
|
Text = ''
|
||||||
end
|
end
|
||||||
inherited btnCounterEdit: TButton
|
inherited btnCounterEdit: TButton
|
||||||
Images = ImageList1
|
Images = ImageList1
|
||||||
ImageIndex = 3
|
ImageIndex = 3
|
||||||
TabOrder = 45
|
TabOrder = 44
|
||||||
end
|
end
|
||||||
inherited sgCounter: TStringGrid
|
inherited sgCounter: TStringGrid
|
||||||
TabOrder = 46
|
TabOrder = 45
|
||||||
Viewport.Width = 463.000000000000000000
|
Viewport.Width = 463.000000000000000000
|
||||||
Viewport.Height = 121.000000000000000000
|
Viewport.Height = 121.000000000000000000
|
||||||
inherited scCounterTrigger: TStringColumn
|
inherited scCounterTrigger: TStringColumn
|
||||||
@@ -778,6 +874,7 @@ object TTW_Bot: TTTW_Bot
|
|||||||
TabOrder = 1
|
TabOrder = 1
|
||||||
Text = #1055#1086#1076#1082#1083#1102#1095#1080#1090#1100#1089#1103
|
Text = #1055#1086#1076#1082#1083#1102#1095#1080#1090#1100#1089#1103
|
||||||
TextSettings.Trimming = None
|
TextSettings.Trimming = None
|
||||||
|
OnClick = btnConnectingClick
|
||||||
end
|
end
|
||||||
object Label2: TLabel
|
object Label2: TLabel
|
||||||
Position.X = 8.000000000000000000
|
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
|
inherited btnRmCommand: TButton
|
||||||
OnClick = frContruct1btnRmCommandClick
|
OnClick = frContruct1btnRmCommandClick
|
||||||
end
|
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
|
||||||
end
|
end
|
||||||
object GroupBox9: TGroupBox
|
object GroupBox9: TGroupBox
|
||||||
@@ -115,16 +121,16 @@ object frCommands: TfrCommands
|
|||||||
Viewport.Height = 116.000000000000000000
|
Viewport.Height = 116.000000000000000000
|
||||||
end
|
end
|
||||||
inherited btnRandomAdd: TButton
|
inherited btnRandomAdd: TButton
|
||||||
TabOrder = 34
|
TabOrder = 33
|
||||||
end
|
end
|
||||||
inherited btnRandomDel: TButton
|
inherited btnRandomDel: TButton
|
||||||
TabOrder = 35
|
TabOrder = 34
|
||||||
end
|
end
|
||||||
inherited btnRmGroup: TButton
|
inherited btnRmGroup: TButton
|
||||||
TabOrder = 37
|
TabOrder = 36
|
||||||
end
|
end
|
||||||
inherited Label4: TLabel
|
inherited Label4: TLabel
|
||||||
TabOrder = 39
|
TabOrder = 38
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
@@ -36,6 +36,7 @@ type
|
|||||||
frsgNeiro: TfrSimpleGrid;
|
frsgNeiro: TfrSimpleGrid;
|
||||||
frContruct1: TfrContruct;
|
frContruct1: TfrContruct;
|
||||||
frGroupsRequest1: TfrGroupsRequest;
|
frGroupsRequest1: TfrGroupsRequest;
|
||||||
|
cbTextToSpeach: TCheckBox;
|
||||||
procedure btnRandAddClick(Sender: TObject);
|
procedure btnRandAddClick(Sender: TObject);
|
||||||
procedure btnRandDelClick(Sender: TObject);
|
procedure btnRandDelClick(Sender: TObject);
|
||||||
procedure frsgSoundsbtnSoundDelClick(Sender: TObject);
|
procedure frsgSoundsbtnSoundDelClick(Sender: TObject);
|
||||||
@@ -10,7 +10,7 @@ object frFontSettings: TfrFontSettings
|
|||||||
Size.PlatformDefault = False
|
Size.PlatformDefault = False
|
||||||
TextSettings.Trimming = None
|
TextSettings.Trimming = None
|
||||||
Text = #1056#1072#1079#1084#1077#1088' '#1096#1088#1080#1092#1090#1072
|
Text = #1056#1072#1079#1084#1077#1088' '#1096#1088#1080#1092#1090#1072
|
||||||
TabOrder = 8
|
TabOrder = 7
|
||||||
end
|
end
|
||||||
object sbFontSize: TSpinBox
|
object sbFontSize: TSpinBox
|
||||||
Touch.InteractiveGestures = [LongTap, DoubleTap]
|
Touch.InteractiveGestures = [LongTap, DoubleTap]
|
||||||
@@ -30,14 +30,14 @@ object frFontSettings: TfrFontSettings
|
|||||||
Size.Width = 120.000000000000000000
|
Size.Width = 120.000000000000000000
|
||||||
Size.Height = 22.000000000000000000
|
Size.Height = 22.000000000000000000
|
||||||
Size.PlatformDefault = False
|
Size.PlatformDefault = False
|
||||||
TabOrder = 38
|
TabOrder = 37
|
||||||
end
|
end
|
||||||
object Label49: TLabel
|
object Label49: TLabel
|
||||||
Position.X = 116.000000000000000000
|
Position.X = 116.000000000000000000
|
||||||
Position.Y = 63.000000000000000000
|
Position.Y = 63.000000000000000000
|
||||||
TextSettings.Trimming = None
|
TextSettings.Trimming = None
|
||||||
Text = #1062#1074#1077#1090' '#1096#1088#1080#1092#1090#1072
|
Text = #1062#1074#1077#1090' '#1096#1088#1080#1092#1090#1072
|
||||||
TabOrder = 37
|
TabOrder = 36
|
||||||
end
|
end
|
||||||
object cbFontStyleDefault: TComboBox
|
object cbFontStyleDefault: TComboBox
|
||||||
Items.Strings = (
|
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.Width = 177.000000000000000000
|
||||||
Size.Height = 21.000000000000000000
|
Size.Height = 21.000000000000000000
|
||||||
Size.PlatformDefault = False
|
Size.PlatformDefault = False
|
||||||
|
OnExit = edtChannelExit
|
||||||
Left = 11
|
Left = 11
|
||||||
Top = 43
|
Top = 43
|
||||||
end
|
end
|
||||||
@@ -75,6 +76,7 @@ object frSettings: TfrSettings
|
|||||||
Size.Width = 177.000000000000000000
|
Size.Width = 177.000000000000000000
|
||||||
Size.Height = 21.000000000000000000
|
Size.Height = 21.000000000000000000
|
||||||
Size.PlatformDefault = False
|
Size.PlatformDefault = False
|
||||||
|
OnExit = edtChannelExit
|
||||||
Left = 11
|
Left = 11
|
||||||
Top = 89
|
Top = 89
|
||||||
end
|
end
|
||||||
@@ -86,6 +88,7 @@ object frSettings: TfrSettings
|
|||||||
Size.Width = 177.000000000000000000
|
Size.Width = 177.000000000000000000
|
||||||
Size.Height = 21.000000000000000000
|
Size.Height = 21.000000000000000000
|
||||||
Size.PlatformDefault = False
|
Size.PlatformDefault = False
|
||||||
|
OnExit = edtChannelExit
|
||||||
Left = 11
|
Left = 11
|
||||||
Top = 181
|
Top = 181
|
||||||
end
|
end
|
||||||
@@ -112,6 +115,7 @@ object frSettings: TfrSettings
|
|||||||
Size.Width = 177.000000000000000000
|
Size.Width = 177.000000000000000000
|
||||||
Size.Height = 21.000000000000000000
|
Size.Height = 21.000000000000000000
|
||||||
Size.PlatformDefault = False
|
Size.PlatformDefault = False
|
||||||
|
OnExit = edtChannelExit
|
||||||
Left = 11
|
Left = 11
|
||||||
Top = 135
|
Top = 135
|
||||||
end
|
end
|
||||||
@@ -134,7 +138,7 @@ object frSettings: TfrSettings
|
|||||||
Size.Width = 128.000000000000000000
|
Size.Width = 128.000000000000000000
|
||||||
Size.Height = 22.000000000000000000
|
Size.Height = 22.000000000000000000
|
||||||
Size.PlatformDefault = False
|
Size.PlatformDefault = False
|
||||||
TabOrder = 33
|
TabOrder = 31
|
||||||
Text = #1054#1090#1082#1088#1099#1090#1100' '#1089#1090#1088#1080#1084
|
Text = #1054#1090#1082#1088#1099#1090#1100' '#1089#1090#1088#1080#1084
|
||||||
TextSettings.Trimming = None
|
TextSettings.Trimming = None
|
||||||
OnClick = btnOpenStreamClick
|
OnClick = btnOpenStreamClick
|
||||||
@@ -145,20 +149,21 @@ object frSettings: TfrSettings
|
|||||||
Size.Width = 128.000000000000000000
|
Size.Width = 128.000000000000000000
|
||||||
Size.Height = 22.000000000000000000
|
Size.Height = 22.000000000000000000
|
||||||
Size.PlatformDefault = False
|
Size.PlatformDefault = False
|
||||||
TabOrder = 34
|
TabOrder = 32
|
||||||
Text = #1055#1086#1083#1091#1095#1080#1090#1100' Token'
|
Text = #1055#1086#1083#1091#1095#1080#1090#1100' Token'
|
||||||
TextSettings.Trimming = None
|
TextSettings.Trimming = None
|
||||||
OnClick = btnGetTokenStreamerClick
|
OnClick = btnGetTokenStreamerClick
|
||||||
end
|
end
|
||||||
object edtBotTokenStreamer: TEdit
|
object edtBotTokenStreamer: TEdit
|
||||||
Touch.InteractiveGestures = [LongTap, DoubleTap]
|
Touch.InteractiveGestures = [LongTap, DoubleTap]
|
||||||
TabOrder = 35
|
TabOrder = 34
|
||||||
Password = True
|
Password = True
|
||||||
Position.X = 8.000000000000000000
|
Position.X = 8.000000000000000000
|
||||||
Position.Y = 146.000000000000000000
|
Position.Y = 146.000000000000000000
|
||||||
Size.Width = 177.000000000000000000
|
Size.Width = 177.000000000000000000
|
||||||
Size.Height = 22.000000000000000000
|
Size.Height = 22.000000000000000000
|
||||||
Size.PlatformDefault = False
|
Size.PlatformDefault = False
|
||||||
|
OnExit = edtChannelExit
|
||||||
end
|
end
|
||||||
object Label53: TLabel
|
object Label53: TLabel
|
||||||
Position.X = 8.000000000000000000
|
Position.X = 8.000000000000000000
|
||||||
@@ -178,6 +183,7 @@ object frSettings: TfrSettings
|
|||||||
Size.PlatformDefault = False
|
Size.PlatformDefault = False
|
||||||
TabOrder = 4
|
TabOrder = 4
|
||||||
Text = #1040#1074#1090#1086#1087#1086#1076#1082#1083#1102#1095#1077#1085#1080#1077
|
Text = #1040#1074#1090#1086#1087#1086#1076#1082#1083#1102#1095#1077#1085#1080#1077
|
||||||
|
OnExit = edtChannelExit
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
object GroupBox22: TGroupBox
|
object GroupBox22: TGroupBox
|
||||||
@@ -191,7 +197,7 @@ object frSettings: TfrSettings
|
|||||||
object btnDAGetCode: TButton
|
object btnDAGetCode: TButton
|
||||||
Position.X = 200.000000000000000000
|
Position.X = 200.000000000000000000
|
||||||
Position.Y = 216.000000000000000000
|
Position.Y = 216.000000000000000000
|
||||||
TabOrder = 43
|
TabOrder = 40
|
||||||
Text = #1055#1086#1083#1091#1095#1080#1090#1100
|
Text = #1055#1086#1083#1091#1095#1080#1090#1100
|
||||||
TextSettings.Trimming = None
|
TextSettings.Trimming = None
|
||||||
OnClick = btnDAGetCodeClick
|
OnClick = btnDAGetCodeClick
|
||||||
@@ -201,55 +207,58 @@ object frSettings: TfrSettings
|
|||||||
Position.Y = 24.000000000000000000
|
Position.Y = 24.000000000000000000
|
||||||
TextSettings.Trimming = None
|
TextSettings.Trimming = None
|
||||||
Text = 'Client ID'
|
Text = 'Client ID'
|
||||||
TabOrder = 35
|
TabOrder = 33
|
||||||
end
|
end
|
||||||
object edtDAClientID: TEdit
|
object edtDAClientID: TEdit
|
||||||
Touch.InteractiveGestures = [LongTap, DoubleTap]
|
Touch.InteractiveGestures = [LongTap, DoubleTap]
|
||||||
TabOrder = 39
|
TabOrder = 35
|
||||||
Password = True
|
Password = True
|
||||||
Position.X = 8.000000000000000000
|
Position.X = 8.000000000000000000
|
||||||
Position.Y = 49.000000000000000000
|
Position.Y = 49.000000000000000000
|
||||||
Size.Width = 272.000000000000000000
|
Size.Width = 272.000000000000000000
|
||||||
Size.Height = 22.000000000000000000
|
Size.Height = 22.000000000000000000
|
||||||
Size.PlatformDefault = False
|
Size.PlatformDefault = False
|
||||||
|
OnExit = edtChannelExit
|
||||||
end
|
end
|
||||||
object Label64: TLabel
|
object Label64: TLabel
|
||||||
Position.X = 8.000000000000000000
|
Position.X = 8.000000000000000000
|
||||||
Position.Y = 79.000000000000000000
|
Position.Y = 79.000000000000000000
|
||||||
TextSettings.Trimming = None
|
TextSettings.Trimming = None
|
||||||
Text = 'Client Secret'
|
Text = 'Client Secret'
|
||||||
TabOrder = 36
|
TabOrder = 34
|
||||||
end
|
end
|
||||||
object edtDAClientSecret: TEdit
|
object edtDAClientSecret: TEdit
|
||||||
Touch.InteractiveGestures = [LongTap, DoubleTap]
|
Touch.InteractiveGestures = [LongTap, DoubleTap]
|
||||||
TabOrder = 38
|
TabOrder = 36
|
||||||
Password = True
|
Password = True
|
||||||
Position.X = 8.000000000000000000
|
Position.X = 8.000000000000000000
|
||||||
Position.Y = 104.000000000000000000
|
Position.Y = 104.000000000000000000
|
||||||
Size.Width = 272.000000000000000000
|
Size.Width = 272.000000000000000000
|
||||||
Size.Height = 22.000000000000000000
|
Size.Height = 22.000000000000000000
|
||||||
Size.PlatformDefault = False
|
Size.PlatformDefault = False
|
||||||
|
OnExit = edtChannelExit
|
||||||
end
|
end
|
||||||
object Label65: TLabel
|
object Label65: TLabel
|
||||||
Position.X = 8.000000000000000000
|
Position.X = 8.000000000000000000
|
||||||
Position.Y = 134.000000000000000000
|
Position.Y = 134.000000000000000000
|
||||||
TextSettings.Trimming = None
|
TextSettings.Trimming = None
|
||||||
Text = 'Redirect URL'
|
Text = 'Redirect URL'
|
||||||
TabOrder = 40
|
TabOrder = 38
|
||||||
end
|
end
|
||||||
object edtDARedirectURL: TEdit
|
object edtDARedirectURL: TEdit
|
||||||
Touch.InteractiveGestures = [LongTap, DoubleTap]
|
Touch.InteractiveGestures = [LongTap, DoubleTap]
|
||||||
TabOrder = 41
|
TabOrder = 39
|
||||||
Password = True
|
Password = True
|
||||||
Position.X = 8.000000000000000000
|
Position.X = 8.000000000000000000
|
||||||
Position.Y = 159.000000000000000000
|
Position.Y = 159.000000000000000000
|
||||||
Size.Width = 272.000000000000000000
|
Size.Width = 272.000000000000000000
|
||||||
Size.Height = 22.000000000000000000
|
Size.Height = 22.000000000000000000
|
||||||
Size.PlatformDefault = False
|
Size.PlatformDefault = False
|
||||||
|
OnExit = edtChannelExit
|
||||||
end
|
end
|
||||||
object edtDACode: TEdit
|
object edtDACode: TEdit
|
||||||
Touch.InteractiveGestures = [LongTap, DoubleTap]
|
Touch.InteractiveGestures = [LongTap, DoubleTap]
|
||||||
TabOrder = 42
|
TabOrder = 41
|
||||||
Password = True
|
Password = True
|
||||||
Position.X = 8.000000000000000000
|
Position.X = 8.000000000000000000
|
||||||
Position.Y = 214.000000000000000000
|
Position.Y = 214.000000000000000000
|
||||||
@@ -262,7 +271,7 @@ object frSettings: TfrSettings
|
|||||||
Position.Y = 189.000000000000000000
|
Position.Y = 189.000000000000000000
|
||||||
TextSettings.Trimming = None
|
TextSettings.Trimming = None
|
||||||
Text = 'Code'
|
Text = 'Code'
|
||||||
TabOrder = 44
|
TabOrder = 42
|
||||||
end
|
end
|
||||||
object btnDAStart: TButton
|
object btnDAStart: TButton
|
||||||
Position.X = 8.000000000000000000
|
Position.X = 8.000000000000000000
|
||||||
@@ -270,7 +279,7 @@ object frSettings: TfrSettings
|
|||||||
Size.Width = 121.000000000000000000
|
Size.Width = 121.000000000000000000
|
||||||
Size.Height = 22.000000000000000000
|
Size.Height = 22.000000000000000000
|
||||||
Size.PlatformDefault = False
|
Size.PlatformDefault = False
|
||||||
TabOrder = 45
|
TabOrder = 43
|
||||||
Text = #1055#1086#1076#1082#1083#1102#1095#1080#1090#1100#1089#1103
|
Text = #1055#1086#1076#1082#1083#1102#1095#1080#1090#1100#1089#1103
|
||||||
TextSettings.Trimming = None
|
TextSettings.Trimming = None
|
||||||
OnClick = btnDAStartClick
|
OnClick = btnDAStartClick
|
||||||
@@ -282,7 +291,7 @@ object frSettings: TfrSettings
|
|||||||
Size.Width = 209.000000000000000000
|
Size.Width = 209.000000000000000000
|
||||||
Size.Height = 22.000000000000000000
|
Size.Height = 22.000000000000000000
|
||||||
Size.PlatformDefault = False
|
Size.PlatformDefault = False
|
||||||
TabOrder = 47
|
TabOrder = 46
|
||||||
Text = #1055#1086#1083#1091#1095#1080#1090#1100' '#1076#1072#1085#1085#1099#1077' Donation Alerts'
|
Text = #1055#1086#1083#1091#1095#1080#1090#1100' '#1076#1072#1085#1085#1099#1077' Donation Alerts'
|
||||||
TextSettings.Trimming = None
|
TextSettings.Trimming = None
|
||||||
Visible = False
|
Visible = False
|
||||||
@@ -56,6 +56,7 @@ type
|
|||||||
procedure btnImportSettingsClick(Sender: TObject);
|
procedure btnImportSettingsClick(Sender: TObject);
|
||||||
procedure btnExportSettingsClick(Sender: TObject);
|
procedure btnExportSettingsClick(Sender: TObject);
|
||||||
procedure btnMasterClick(Sender: TObject);
|
procedure btnMasterClick(Sender: TObject);
|
||||||
|
procedure edtChannelExit(Sender: TObject);
|
||||||
private
|
private
|
||||||
{ Private declarations }
|
{ Private declarations }
|
||||||
FAPIClient: TAPIClient;
|
FAPIClient: TAPIClient;
|
||||||
@@ -325,6 +326,17 @@ if Assigned(FWSClient) then
|
|||||||
inherited;
|
inherited;
|
||||||
end;
|
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;
|
procedure TfrSettings.init;
|
||||||
begin
|
begin
|
||||||
if not Assigned(FAPIClient) then
|
if not Assigned(FAPIClient) then
|
||||||
@@ -361,7 +373,7 @@ end;
|
|||||||
|
|
||||||
procedure TfrSettings.HandleWSStatus(AStatusText: string; AStatusCode: integer);
|
procedure TfrSettings.HandleWSStatus(AStatusText: string; AStatusCode: integer);
|
||||||
begin
|
begin
|
||||||
// fLog.tolog(3,'uLogin','HandleWSStatus',AStatusText);
|
TTW_Bot.tolog('fSettings','HandleWSStatus',AStatusText,3);
|
||||||
TTW_Bot.Label8.text := AStatusText;
|
TTW_Bot.Label8.text := AStatusText;
|
||||||
case AStatusCode of
|
case AStatusCode of
|
||||||
0:
|
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
|
interface
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
type
|
type
|
||||||
TRLog = record
|
TRLog = record
|
||||||
rTime: ttime;
|
rTime: ttime;
|
||||||
@@ -77,6 +80,7 @@ type
|
|||||||
MaxCountMess: integer;
|
MaxCountMess: integer;
|
||||||
TimeMess: integer;
|
TimeMess: integer;
|
||||||
port: integer;
|
port: integer;
|
||||||
|
freez:integer;
|
||||||
StyleFont: integer;
|
StyleFont: integer;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@@ -103,7 +107,6 @@ type
|
|||||||
soundsPath: string;
|
soundsPath: string;
|
||||||
stlPath: string;
|
stlPath: string;
|
||||||
ytSongsPath: string;
|
ytSongsPath: string;
|
||||||
PublicPlay: string;
|
|
||||||
SilentPlay: string;
|
SilentPlay: string;
|
||||||
ytPlay: string;
|
ytPlay: string;
|
||||||
cfg1: 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