реструктуризация файлов, добавление вебчатов
This commit is contained in:
PC1\PTyTb
@@ -0,0 +1,135 @@
|
||||
unit uAPIDA;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, System.JSON, IdHTTP, IdSSLOpenSSL, flog;
|
||||
|
||||
type
|
||||
TAPIClient = class(TObject)
|
||||
private
|
||||
FHttpClient: TIdHTTP;
|
||||
FSSLHandler: TIdSSLIOHandlerSocketOpenSSL;
|
||||
FToken: string;
|
||||
procedure SetToken(const Value: string);
|
||||
procedure CheckHTTPError(AResponseCode: Integer; const AResponse: string);
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
function GetAccessToken(const client_id, client_secret, redirect_uri, code: string): string;
|
||||
function GetUserInfo: TJSONObject;
|
||||
function SubscribeToChannel(const uid, clientUID: string): TJSONObject;
|
||||
property Token: string read FToken write SetToken;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
ContentType = 'application/x-www-form-urlencoded';
|
||||
UserAgent = 'Mozilla/5.0 (Windows NT 10.0) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/120.0.0.0 Safari/537.36';
|
||||
AuthorizationHeader = 'Authorization: Bearer ';
|
||||
|
||||
constructor TAPIClient.Create;
|
||||
begin
|
||||
inherited;
|
||||
FHttpClient := TIdHTTP.Create(nil);
|
||||
// ñîçäà¸ì SSL handler áåç âëàäåëüöà — ÿâíîå óïðàâëåíèå
|
||||
FSSLHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
|
||||
FSSLHandler.SSLOptions.Method := sslvSSLv23;
|
||||
FHttpClient.IOHandler := FSSLHandler;
|
||||
FHttpClient.Request.UserAgent := UserAgent;
|
||||
FHttpClient.Request.ContentType := ContentType;
|
||||
FHttpClient.HandleRedirects := True;
|
||||
end;
|
||||
|
||||
destructor TAPIClient.Destroy;
|
||||
begin
|
||||
// Îòêëþ÷àåì è îñâîáîæäàåì â áåçîïàñíîì ïîðÿäêå
|
||||
try
|
||||
if Assigned(FHttpClient) then
|
||||
begin
|
||||
try
|
||||
// åñëè íóæíî — ïðåðâàòü àêòèâíûå ñîåäèíåíèÿ
|
||||
except
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
// Ñíà÷àëà îñâîáîæäàåì IOHandler (åñëè îí íå ïðèíàäëåæèò FHttpClient)
|
||||
FreeAndNil(FSSLHandler);
|
||||
FreeAndNil(FHttpClient);
|
||||
inherited;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAPIClient.CheckHTTPError(AResponseCode: Integer; const AResponse: string);
|
||||
begin
|
||||
if AResponseCode <> 200 then
|
||||
raise Exception.CreateFmt('HTTP Error %d: %s', [AResponseCode, AResponse]);
|
||||
end;
|
||||
|
||||
function TAPIClient.GetAccessToken(const client_id, client_secret, redirect_uri, code: string): string;
|
||||
var
|
||||
Response: string;
|
||||
Stream: TStringStream;
|
||||
Json: TJSONObject;
|
||||
begin
|
||||
Stream := TStringStream.Create(
|
||||
Format('grant_type=authorization_code&client_id=%s&client_secret=%s&redirect_uri=%s&code=%s',
|
||||
[client_id, client_secret, redirect_uri, code]), TEncoding.UTF8);
|
||||
try
|
||||
Response := FHttpClient.Post('https://www.donationalerts.com/oauth/token', Stream);
|
||||
CheckHTTPError(FHttpClient.ResponseCode, Response);
|
||||
|
||||
Json := TJSONObject.ParseJSONValue(Response) as TJSONObject;
|
||||
try
|
||||
Result := Json.GetValue<string>('access_token');
|
||||
FToken := Result;
|
||||
finally
|
||||
Json.Free;
|
||||
end;
|
||||
finally
|
||||
Stream.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TAPIClient.GetUserInfo: TJSONObject;
|
||||
var
|
||||
Response: string;
|
||||
begin
|
||||
FHttpClient.Request.CustomHeaders.Add(AuthorizationHeader + FToken);
|
||||
try
|
||||
Response := FHttpClient.Get('https://www.donationalerts.com/api/v1/user/oauth');
|
||||
CheckHTTPError(FHttpClient.ResponseCode, Response);
|
||||
Result := TJSONObject.ParseJSONValue(Response) as TJSONObject;
|
||||
finally
|
||||
FHttpClient.Request.CustomHeaders.Clear;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TAPIClient.SubscribeToChannel(const uid, clientUID: string): TJSONObject;
|
||||
var
|
||||
Response: string;
|
||||
Stream: TStringStream;
|
||||
RequestJSON: string;
|
||||
begin
|
||||
RequestJSON := Format('{"channels":["$alerts:donation_%s"], "client":"%s"}', [uid, clientUID]);
|
||||
Stream := TStringStream.Create(RequestJSON, TEncoding.UTF8);
|
||||
try
|
||||
FHttpClient.Request.CustomHeaders.Add(AuthorizationHeader + FToken);
|
||||
FHttpClient.Request.ContentType := 'application/json';
|
||||
Response := FHttpClient.Post('https://www.donationalerts.com/api/v1/centrifuge/subscribe', Stream);
|
||||
CheckHTTPError(FHttpClient.ResponseCode, Response);
|
||||
Result := TJSONObject.ParseJSONValue(Response) as TJSONObject;
|
||||
finally
|
||||
Stream.Free;
|
||||
FHttpClient.Request.CustomHeaders.Clear;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAPIClient.SetToken(const Value: string);
|
||||
begin
|
||||
FToken := Value;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@@ -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.
|
||||
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,289 @@
|
||||
unit uTWAuth;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils, System.Classes, IdContext, IdCustomHTTPServer, IdHTTPServer,
|
||||
IdComponent, ShellAPI, System.Threading, Windows;
|
||||
|
||||
type
|
||||
TmyEvent = procedure(txt: string) of object;
|
||||
|
||||
type
|
||||
TTTWAuth = class
|
||||
FmyEvent: TmyEvent;
|
||||
FURL: string;
|
||||
private
|
||||
FHTTPServer: TIdHTTPServer;
|
||||
procedure HandleRequest(ASender: TIdContext;
|
||||
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
|
||||
procedure HandleRootRequest(ARequestInfo: TIdHTTPRequestInfo;
|
||||
AResponseInfo: TIdHTTPResponseInfo);
|
||||
procedure HandleRedirectRequest(ARequestInfo: TIdHTTPRequestInfo;
|
||||
AResponseInfo: TIdHTTPResponseInfo);
|
||||
procedure HandleDARequest(ARequestInfo: TIdHTTPRequestInfo;
|
||||
AResponseInfo: TIdHTTPResponseInfo);
|
||||
procedure OnStatus(ASender: TObject; const AStatus: TIdStatus;
|
||||
const AStatusText: string);
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure StartServer(aURL: string);
|
||||
procedure StopServer;
|
||||
property OnToken: TmyEvent read FmyEvent write FmyEvent;
|
||||
property OnError: TmyEvent read FmyEvent write FmyEvent;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TTTWAuth }
|
||||
|
||||
constructor TTTWAuth.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FHTTPServer := TIdHTTPServer.Create(nil);
|
||||
FHTTPServer.OnCommandGet := HandleRequest;
|
||||
FHTTPServer.OnStatus := OnStatus;
|
||||
// Íå âêëþ÷àåì Active çäåñü
|
||||
end;
|
||||
|
||||
destructor TTTWAuth.Destroy;
|
||||
begin
|
||||
try
|
||||
if Assigned(FHTTPServer) then
|
||||
begin
|
||||
try
|
||||
if FHTTPServer.Active then
|
||||
FHTTPServer.Active := False;
|
||||
except
|
||||
end;
|
||||
FreeAndNil(FHTTPServer);
|
||||
end;
|
||||
except
|
||||
end;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TTTWAuth.StartServer(aURL: string);
|
||||
begin
|
||||
// Çàùèòà îò ïîâòîðíîãî çàïóñêà
|
||||
if Assigned(FHTTPServer) and FHTTPServer.Active then
|
||||
Exit;
|
||||
|
||||
// Î÷èñòèì ñòàðûå áèíäèíãè, ÷òîáû íå íàêàïëèâàòü èõ
|
||||
FHTTPServer.Bindings.Clear;
|
||||
|
||||
FHTTPServer.DefaultPort := 80;
|
||||
// Äîáàâëÿåì áèíäèíã ÿâíî
|
||||
FHTTPServer.Bindings.Add.SetBinding('127.0.0.1', 80);
|
||||
FURL := aURL;
|
||||
FHTTPServer.Active := True;
|
||||
if FURL <> '' then
|
||||
ShellExecute(0, 'open', PWideChar(FURL), nil, nil, SW_SHOWNORMAL);
|
||||
end;
|
||||
|
||||
procedure TTTWAuth.StopServer;
|
||||
begin
|
||||
if Assigned(FHTTPServer) then
|
||||
begin
|
||||
try
|
||||
FHTTPServer.Active := False;
|
||||
except
|
||||
end;
|
||||
try
|
||||
FHTTPServer.Bindings.Clear;
|
||||
except
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTTWAuth.HandleRequest(ASender: TIdContext;
|
||||
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
|
||||
begin
|
||||
if ARequestInfo.Document = '/' then
|
||||
HandleRootRequest(ARequestInfo, AResponseInfo)
|
||||
else if ARequestInfo.Document = '/redirect' then
|
||||
HandleRedirectRequest(ARequestInfo, AResponseInfo)
|
||||
else if ARequestInfo.Document = '/da' then
|
||||
HandleDARequest(ARequestInfo, AResponseInfo)
|
||||
else
|
||||
begin
|
||||
AResponseInfo.ResponseNo := 404;
|
||||
AResponseInfo.ContentText := 'Not Found';
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTTWAuth.HandleRootRequest(ARequestInfo: TIdHTTPRequestInfo;
|
||||
AResponseInfo: TIdHTTPResponseInfo);
|
||||
begin
|
||||
AResponseInfo.ContentText := '<!DOCTYPE html>' + sLineBreak + '<html>' +
|
||||
sLineBreak + '<head>' + sLineBreak +
|
||||
' <title>Redirecting...</title>' + sLineBreak + '</head>' + sLineBreak +
|
||||
'<body>' + sLineBreak + ' <p>ïîëó÷àþ òîêåí:</p>' + sLineBreak + '<script>' +
|
||||
sLineBreak + 'var paragraph = window.location.href;' + sLineBreak +
|
||||
'var urrl = paragraph.replace(''localhost/'',''localhost/redirect'');' +
|
||||
sLineBreak + 'urrl = urrl.replace(''#'',''?'');' + sLineBreak +
|
||||
'console.log(urrl);' + sLineBreak + 'window.location.href =urrl;' +
|
||||
sLineBreak + ' </script>' + sLineBreak + '</body>' + sLineBreak + '</html>';
|
||||
end;
|
||||
|
||||
procedure TTTWAuth.OnStatus(ASender: TObject; const AStatus: TIdStatus;
|
||||
const AStatusText: string);
|
||||
begin
|
||||
// Ìîæíî ëîãèðîâàòü ñòàòóñ, íî íå îáÿçàòåëüíî
|
||||
end;
|
||||
|
||||
procedure TTTWAuth.HandleDARequest(ARequestInfo: TIdHTTPRequestInfo;
|
||||
AResponseInfo: TIdHTTPResponseInfo);
|
||||
begin
|
||||
AResponseInfo.ContentText := '<!DOCTYPE html>' + sLineBreak + '<html>' +
|
||||
sLineBreak + '<head>' + sLineBreak +
|
||||
' <title>Redirecting...</title>' + sLineBreak + '</head>' + sLineBreak +
|
||||
'<body>' + sLineBreak + ' <p>ïîëó÷àþ êîä</p>' + sLineBreak + '<script>' +
|
||||
sLineBreak + 'var paragraph = window.location.href;' + sLineBreak +
|
||||
'var urrl = paragraph.replace(''localhost/da'',''localhost/redirect'');' +
|
||||
sLineBreak + 'urrl = urrl.replace(''#'',''?'');' + sLineBreak +
|
||||
'console.log(urrl);' + sLineBreak + 'window.location.href =urrl;' +
|
||||
sLineBreak + ' </script>' + sLineBreak + '</body>' + sLineBreak + '</html>';
|
||||
end;
|
||||
|
||||
procedure TTTWAuth.HandleRedirectRequest(ARequestInfo: TIdHTTPRequestInfo;
|
||||
AResponseInfo: TIdHTTPResponseInfo);
|
||||
var
|
||||
i: Integer;
|
||||
AccessToken: string;
|
||||
LTokenCopy: string;
|
||||
begin
|
||||
// Åñëè ïîëó÷åí access_token
|
||||
if Pos('access_token=', ARequestInfo.Params.Text) > 0 then
|
||||
begin
|
||||
for i := 0 to ARequestInfo.Params.Count - 1 do
|
||||
if Pos('access_token', ARequestInfo.Params[i]) > 0 then
|
||||
AccessToken := ARequestInfo.Params[i];
|
||||
AccessToken := StringReplace(AccessToken, 'access_token=', '', [rfReplaceAll]);
|
||||
|
||||
AResponseInfo.ContentText := '<!DOCTYPE html>' + sLineBreak + '<html>' +
|
||||
sLineBreak + '<head>' + sLineBreak +
|
||||
' <title>Done...</title>' + sLineBreak + '</head>' + sLineBreak +
|
||||
'<body>' + sLineBreak + 'Ýòó ñòðàíèöó ìîæíî çàêðûòü' + sLineBreak +
|
||||
'</body>' + sLineBreak + '</html>';
|
||||
AResponseInfo.WriteContent;
|
||||
|
||||
// Êîïèðóåì òîêåí, ÷òîáû êîððåêòíî ïåðåäàòü â main thread
|
||||
LTokenCopy := AccessToken;
|
||||
// Âûçûâàåì OnToken â main thread
|
||||
if Assigned(FmyEvent) then
|
||||
TThread.Queue(nil,
|
||||
procedure
|
||||
begin
|
||||
try
|
||||
FmyEvent(LTokenCopy);
|
||||
except
|
||||
end;
|
||||
end);
|
||||
|
||||
// Îñòàíîâèì ñåðâåð è çàïëàíèðóåì î÷èñòêó îáúåêòà â main thread
|
||||
try
|
||||
StopServer;
|
||||
except
|
||||
end;
|
||||
TThread.Queue(nil,
|
||||
procedure
|
||||
begin
|
||||
try
|
||||
Free;
|
||||
except
|
||||
end;
|
||||
end);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
// Åñëè åñòü error_description
|
||||
if Pos('error_description=', ARequestInfo.Params.Text) > 0 then
|
||||
begin
|
||||
for i := 0 to ARequestInfo.Params.Count - 1 do
|
||||
if Pos('error_description', ARequestInfo.Params[i]) > 0 then
|
||||
AccessToken := ARequestInfo.Params[i];
|
||||
AccessToken := StringReplace(AccessToken, 'error_description=', '', [rfReplaceAll]);
|
||||
|
||||
AResponseInfo.ContentText := '<!DOCTYPE html>' + sLineBreak + '<html>' +
|
||||
sLineBreak + '<head>' + sLineBreak +
|
||||
' <title>ERROR...</title>' + sLineBreak + '</head>' + sLineBreak +
|
||||
'<body>' + sLineBreak + AccessToken + sLineBreak + '</body>' + sLineBreak + '</html>';
|
||||
AResponseInfo.WriteContent;
|
||||
|
||||
LTokenCopy := AccessToken;
|
||||
if Assigned(FmyEvent) then
|
||||
TThread.Queue(nil,
|
||||
procedure
|
||||
begin
|
||||
try
|
||||
FmyEvent(LTokenCopy);
|
||||
except
|
||||
end;
|
||||
end);
|
||||
|
||||
try
|
||||
StopServer;
|
||||
except
|
||||
end;
|
||||
TThread.Queue(nil,
|
||||
procedure
|
||||
begin
|
||||
try
|
||||
Free;
|
||||
except
|
||||
end;
|
||||
end);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
// Åñëè ïîëó÷åí code=
|
||||
if Pos('code=', ARequestInfo.Params.Text) > 0 then
|
||||
begin
|
||||
for i := 0 to ARequestInfo.Params.Count - 1 do
|
||||
if Pos('code', ARequestInfo.Params[i]) > 0 then
|
||||
AccessToken := ARequestInfo.Params[i];
|
||||
AccessToken := StringReplace(AccessToken, 'code=', '', [rfReplaceAll]);
|
||||
|
||||
AResponseInfo.ContentText := '<!DOCTYPE html>' + sLineBreak + '<html>' +
|
||||
sLineBreak + '<head>' + sLineBreak +
|
||||
' <title>Done...</title>' + sLineBreak + '</head>' + sLineBreak +
|
||||
'<body>' + sLineBreak + 'Ýòó ñòðàíèöó ìîæíî çàêðûòü' + sLineBreak +
|
||||
'</body>' + sLineBreak + '</html>';
|
||||
AResponseInfo.WriteContent;
|
||||
|
||||
LTokenCopy := AccessToken;
|
||||
if Assigned(FmyEvent) then
|
||||
TThread.Queue(nil,
|
||||
procedure
|
||||
begin
|
||||
try
|
||||
FmyEvent(LTokenCopy);
|
||||
except
|
||||
end;
|
||||
end);
|
||||
|
||||
try
|
||||
StopServer;
|
||||
except
|
||||
end;
|
||||
TThread.Queue(nil,
|
||||
procedure
|
||||
begin
|
||||
try
|
||||
Free;
|
||||
except
|
||||
end;
|
||||
end);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
// Ïî óìîë÷àíèþ — 404
|
||||
AResponseInfo.ResponseNo := 404;
|
||||
AResponseInfo.ContentText := 'Not Found';
|
||||
AResponseInfo.WriteContent;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@@ -0,0 +1,228 @@
|
||||
unit uWSDA;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, System.JSON, ipwwsclient, StrUtils, uAPIDA;
|
||||
|
||||
type
|
||||
TOnDonateEvent = procedure(aNick, aMessage, aSum: string) of object;
|
||||
TOnStatusEvent = procedure(AStatusText: string; AStatusCode: integer) of object;
|
||||
TOnLog = procedure(aModul: string; aMethod: string; aMessage: string; aLevel: integer) of object;
|
||||
|
||||
TWSClient = class(TObject)
|
||||
private
|
||||
FWS: TipwWSClient;
|
||||
FAPIClient: TAPIClient;
|
||||
FOnDonate: TOnDonateEvent;
|
||||
FOnStatus: TOnStatusEvent;
|
||||
FOnLog: TOnLog;
|
||||
FWsstoken: string;
|
||||
FWSID: string;
|
||||
procedure DataIn(Sender: TObject; DataFormat: integer; const Text: string;
|
||||
const TextB: TBytes; EOM, EOL: Boolean);
|
||||
procedure ConnectionStatus(Sender: TObject; const ConnectionEvent: string;
|
||||
StatusCode: integer; const Description: string);
|
||||
procedure Error(Sender: TObject; ErrorCode: integer; const Description: string);
|
||||
function ExtractValue(const T_, Text, _T: string): string;
|
||||
procedure HandleIncomingData(const Data: string);
|
||||
procedure toLog(aLevel: integer; aMethod: string; aMessage: string);
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure Connect(const WSSURL: string);
|
||||
procedure Disconnect;
|
||||
procedure Send(const Data: string);
|
||||
property OnDonate: TOnDonateEvent read FOnDonate write FOnDonate;
|
||||
property OnStatus: TOnStatusEvent read FOnStatus write FOnStatus;
|
||||
property OnLog: TOnLog read FOnLog write FOnLog;
|
||||
property Wsstoken: string read FWsstoken write FWsstoken;
|
||||
property WSID: string read FWSID write FWSID;
|
||||
property APIClient: TAPIClient read FAPIClient write FAPIClient;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
constructor TWSClient.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FWS := TipwWSClient.Create(nil);
|
||||
FWS.OnDataIn := DataIn;
|
||||
FWS.OnConnectionStatus := ConnectionStatus;
|
||||
FWS.OnError := Error;
|
||||
FAPIClient := nil;
|
||||
FOnDonate := nil;
|
||||
FOnStatus := nil;
|
||||
FOnLog := nil;
|
||||
end;
|
||||
|
||||
destructor TWSClient.Destroy;
|
||||
begin
|
||||
try
|
||||
if Assigned(FWS) then
|
||||
begin
|
||||
try
|
||||
// î÷èñòèì îáðàáîò÷èêè ÷òîáû íå áûëî îáðàòíûõ âûçîâîâ â ìîìåíò îñâîáîæäåíèÿ
|
||||
FWS.OnDataIn := nil;
|
||||
FWS.OnConnectionStatus := nil;
|
||||
FWS.OnError := nil;
|
||||
try
|
||||
FWS.Disconnect;
|
||||
except
|
||||
// èãíîðèðóåì îøèáêè ïðè îòêëþ÷åíèè
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(FWS);
|
||||
end;
|
||||
end;
|
||||
except
|
||||
// íè÷åãî íå äåëàåì — çàùèòà îò èñêëþ÷åíèé â äåñòðóêòîðå
|
||||
end;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TWSClient.Disconnect;
|
||||
begin
|
||||
if Assigned(FWS) then
|
||||
begin
|
||||
try
|
||||
FWS.Disconnect;
|
||||
except
|
||||
// èãíîðèðóåì
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TWSClient.Connect(const WSSURL: string);
|
||||
begin
|
||||
if Assigned(FWS) then
|
||||
begin
|
||||
try
|
||||
FWS.ConnectTo(WSSURL);
|
||||
except
|
||||
// ëîãèðîâàòü ïðè íåîáõîäèìîñòè
|
||||
toLog(2, 'Connect', 'Exception on Connect');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TWSClient.Send(const Data: string);
|
||||
begin
|
||||
if Assigned(FWS) then
|
||||
begin
|
||||
try
|
||||
FWS.SendText(Data);
|
||||
except
|
||||
toLog(2, 'Send', 'Exception on Send');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TWSClient.toLog(aLevel: integer; aMethod: string; aMessage: string);
|
||||
begin
|
||||
if Assigned(FOnLog) then
|
||||
FOnLog('uWSDA', aMethod, aMessage, aLevel);
|
||||
end;
|
||||
|
||||
procedure TWSClient.DataIn(Sender: TObject; DataFormat: integer;
|
||||
const Text: string; const TextB: TBytes; EOM, EOL: Boolean);
|
||||
begin
|
||||
try
|
||||
HandleIncomingData(Text);
|
||||
except
|
||||
on E: Exception do
|
||||
toLog(2, 'DataIn', E.Message);
|
||||
end;
|
||||
//FWS.Ping; // åñëè íóæíî
|
||||
end;
|
||||
|
||||
procedure TWSClient.ConnectionStatus(Sender: TObject; const ConnectionEvent: string;
|
||||
StatusCode: integer; const Description: string);
|
||||
begin
|
||||
if Assigned(FOnStatus) then
|
||||
FOnStatus(ConnectionEvent, StatusCode);
|
||||
end;
|
||||
|
||||
procedure TWSClient.Error(Sender: TObject; ErrorCode: integer; const Description: string);
|
||||
begin
|
||||
toLog(2, 'Error', '[' + IntToStr(ErrorCode) + '] ' + Description);
|
||||
end;
|
||||
|
||||
function TWSClient.ExtractValue(const T_, Text, _T: string): string;
|
||||
var
|
||||
StartPos, EndPos: integer;
|
||||
begin
|
||||
StartPos := Pos(T_, Text);
|
||||
if StartPos = 0 then
|
||||
Exit('');
|
||||
StartPos := StartPos + Length(T_);
|
||||
EndPos := PosEx(_T, Text, StartPos);
|
||||
if EndPos = 0 then
|
||||
Exit('');
|
||||
Result := Copy(Text, StartPos, EndPos - StartPos);
|
||||
end;
|
||||
|
||||
procedure TWSClient.HandleIncomingData(const Data: string);
|
||||
var
|
||||
JSON: TJSONObject;
|
||||
DataObj: TJSONObject;
|
||||
ChannelArray: TJSONArray;
|
||||
jo: TJSONObject;
|
||||
wsstoken2: string;
|
||||
begin
|
||||
toLog(3, 'HandleIncomingData', Data);
|
||||
// Îáðàáîòêà ðåãèñòðàöèè êëèåíòà
|
||||
if Pos('"result":{"client":"', Data) > 0 then
|
||||
begin
|
||||
FWsstoken := ExtractValue('"result":{"client":"', Data, '",');
|
||||
toLog(3, 'HandleIncomingData', 'Êëèåíò çàðåãèñòðèðîâàí');
|
||||
if Assigned(FAPIClient) then
|
||||
begin
|
||||
try
|
||||
jo := FAPIClient.SubscribeToChannel(FWSID, FWsstoken);
|
||||
except
|
||||
jo := nil;
|
||||
end;
|
||||
if Assigned(jo) then
|
||||
try
|
||||
toLog(3, 'HandleIncomingData', 'Êëèåíò ïîäïèñàí');
|
||||
ChannelArray := jo.Values['channels'] as TJSONArray;
|
||||
if Assigned(ChannelArray) and (ChannelArray.Count > 0) then
|
||||
begin
|
||||
wsstoken2 := ChannelArray.Items[0].GetValue<string>('token');
|
||||
toLog(3, 'HandleIncomingData', 'Ïîäïèñêà íà êàíàë ñ òîêåíîì: ' + wsstoken2);
|
||||
try
|
||||
FWS.SendText('{"params": {"channel": "$alerts:donation_' + FWSID + '","token": "' + wsstoken2 + '"},"method": 1,"id": 2 }');
|
||||
except
|
||||
toLog(2, 'HandleIncomingData', 'SendText failed');
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
jo.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
// Îáðàáîòêà äîíàòîâ
|
||||
if Pos('"name":"Donations"', Data) > 0 then
|
||||
begin
|
||||
toLog(3, 'HandleIncomingData', 'Íîâûé Äîíàò');
|
||||
JSON := nil;
|
||||
try
|
||||
JSON := TJSONObject.ParseJSONValue(Data) as TJSONObject;
|
||||
if Assigned(JSON) then
|
||||
begin
|
||||
DataObj := JSON.GetValue<TJSONObject>('result').GetValue<TJSONObject>('data').GetValue<TJSONObject>('data');
|
||||
if Assigned(DataObj) and Assigned(FOnDonate) then
|
||||
FOnDonate(DataObj.GetValue<string>('username'),
|
||||
DataObj.GetValue<string>('message'),
|
||||
DataObj.GetValue<string>('amount'));
|
||||
end;
|
||||
finally
|
||||
JSON.Free;
|
||||
end;
|
||||
end;
|
||||
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.
|
||||
Reference in New Issue
Block a user