unit uWSDA; interface uses system.Classes, system.SysUtils, System.JSON, ipwwsclient, system.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('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('result').GetValue('data').GetValue('data'); if Assigned(DataObj) and Assigned(FOnDonate) then FOnDonate(DataObj.GetValue('username'), DataObj.GetValue('message'), DataObj.GetValue('amount')); end; finally JSON.Free; end; end; end; end.