реструктуризация файлов, добавление вебчатов
This commit is contained in:
PC1\PTyTb
@@ -0,0 +1,651 @@
|
||||
unit uDataBase;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils, System.Classes, FireDAC.Comp.Client, FireDAC.Stan.Param,
|
||||
FMX.Grid, FireDAC.Stan.Def, FireDAC.Stan.Intf, FireDAC.Stan.Option,
|
||||
FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Pool,
|
||||
FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Phys.SQLite, FireDAC.Phys.SQLiteDef,
|
||||
FireDAC.Stan.ExprFuncs, FireDAC.Phys.SQLiteWrapper.Stat, FireDAC.FMXUI.Wait,
|
||||
FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.DApt, Data.DB, FireDAC.Comp.DataSet,
|
||||
FireDAC.Comp.UI, uRecords, System.Generics.Collections, System.Rtti, System.TypInfo;
|
||||
|
||||
type
|
||||
TSettingsDatabase = class
|
||||
private
|
||||
FConnection: TFDConnection;
|
||||
procedure InitializeDatabase;
|
||||
function GetSetting(const Name: string): string;
|
||||
procedure SetSetting(const Name, Value: string);
|
||||
function GetColumnsDefinition(Grid: TStringGrid): string;
|
||||
function GetColumnsList(Grid: TStringGrid): string;
|
||||
function GetValuesPlaceholders(Grid: TStringGrid): string;
|
||||
function CheckTableExists(const TableName: string): Boolean;
|
||||
procedure EnsureTableForRecord(const TableName: string; RecordTypeInfo: PTypeInfo);
|
||||
// function GetFieldDefinition(Field: TRttiField): string;
|
||||
function GetSQLType(Field: TRttiField): string;
|
||||
function TableHasColumn(const TableName, ColumnName: string): Boolean;
|
||||
public
|
||||
FChannel: string;
|
||||
constructor Create(const DatabasePath: string);
|
||||
destructor Destroy; override;
|
||||
function ReadSetting(const Name: string; Default: string = ''): string;
|
||||
procedure WriteSetting(const Name, Value: string);
|
||||
function getLoginData: TLogin;
|
||||
procedure SaveGridToTable(const TableName: string; Grid: TStringGrid);
|
||||
procedure LoadGridFromTable(const TableName: string; Grid: TStringGrid);
|
||||
procedure LoadUsers(var users: TList<TUser>);
|
||||
procedure addGroupResponse(Name, Respons: string);
|
||||
procedure getGroupResponse(aName: string; const lbResponse: TStrings);
|
||||
procedure getGroupName(const lbName: TStrings);
|
||||
procedure delGroupName(aName: string);
|
||||
procedure delGroupResponse(aName, aResponse: string);
|
||||
procedure SaveRecordArray<T>(const TableName: string; const Items: array of T);
|
||||
procedure LoadRecordArray<T>(const TableName: string; var Items: TArray<T>);
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses uGeneral;
|
||||
|
||||
constructor TSettingsDatabase.Create(const DatabasePath: string);
|
||||
begin
|
||||
FConnection := TFDConnection.Create(nil);
|
||||
try
|
||||
FConnection.DriverName := 'SQLite';
|
||||
FConnection.Params.Database := DatabasePath;
|
||||
FConnection.Connected := True;
|
||||
InitializeDatabase;
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
FreeAndNil(FConnection);
|
||||
raise Exception.Create('Îøèáêà ïðè ïîäêëþ÷åíèè ê áàçå äàííûõ: ' + E.Message);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSettingsDatabase.delGroupName(aName: string);
|
||||
var
|
||||
Query: TFDQuery;
|
||||
begin
|
||||
Query := TFDQuery.Create(nil);
|
||||
try
|
||||
Query.Connection := FConnection;
|
||||
Query.SQL.Text := 'DELETE FROM GroupResponse WHERE Name = :name';
|
||||
Query.ParamByName('name').AsString := aName;
|
||||
Query.ExecSQL;
|
||||
finally
|
||||
Query.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSettingsDatabase.delGroupResponse(aName, aResponse: string);
|
||||
var
|
||||
Query: TFDQuery;
|
||||
begin
|
||||
Query := TFDQuery.Create(nil);
|
||||
try
|
||||
Query.Connection := FConnection;
|
||||
Query.SQL.Text := 'DELETE FROM GroupResponse WHERE Name = :name AND Response = :response';
|
||||
Query.ParamByName('name').AsString := aName;
|
||||
Query.ParamByName('response').AsString := aResponse;
|
||||
Query.ExecSQL;
|
||||
finally
|
||||
Query.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TSettingsDatabase.Destroy;
|
||||
begin
|
||||
if Assigned(FConnection) then
|
||||
FConnection.Connected := False;
|
||||
FreeAndNil(FConnection);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TSettingsDatabase.InitializeDatabase;
|
||||
var
|
||||
FDQuery: TFDQuery;
|
||||
FieldExists: Boolean;
|
||||
begin
|
||||
FConnection.ExecSQL('CREATE TABLE IF NOT EXISTS params (' +
|
||||
' name TEXT PRIMARY KEY,' + ' value TEXT' + ');');
|
||||
|
||||
FConnection.ExecSQL('CREATE TABLE IF NOT EXISTS users (' +
|
||||
' id TEXT PRIMARY KEY,' + ' login TEXT,' + ' DisplayName TEXT,' +
|
||||
' created_at DATETIME,' + ' follow_at DATETIME,' + ' isVip TEXT,' +
|
||||
' isModer TEXT,' + ' isO TEXT,' + ' streamer TEXT' + ');');
|
||||
|
||||
FDQuery := TFDQuery.Create(nil);
|
||||
try
|
||||
FDQuery.Connection := FConnection;
|
||||
FieldExists := False;
|
||||
FDQuery.SQL.Text := 'PRAGMA table_info(users)';
|
||||
FDQuery.Open;
|
||||
while not FDQuery.EOF do
|
||||
begin
|
||||
if FDQuery.FieldByName('name').AsString = 'streamer' then
|
||||
begin
|
||||
FieldExists := True;
|
||||
Break;
|
||||
end;
|
||||
FDQuery.Next;
|
||||
end;
|
||||
FDQuery.Close;
|
||||
if not FieldExists then
|
||||
FConnection.ExecSQL('ALTER TABLE users ADD COLUMN streamer TEXT');
|
||||
finally
|
||||
FDQuery.Free;
|
||||
end;
|
||||
|
||||
FConnection.ExecSQL('CREATE TABLE IF NOT EXISTS GroupResponse (ID INTEGER PRIMARY KEY, Name TEXT, Response TEXT);');
|
||||
end;
|
||||
|
||||
procedure TSettingsDatabase.LoadUsers(var users: TList<TUser>);
|
||||
var
|
||||
Query: TFDQuery;
|
||||
UserItem: TUser;
|
||||
begin
|
||||
Query := TFDQuery.Create(nil);
|
||||
try
|
||||
Query.Connection := FConnection;
|
||||
Query.SQL.Text := 'SELECT * FROM users WHERE streamer = :streamer';
|
||||
Query.ParamByName('streamer').AsString := FChannel;
|
||||
Query.Open;
|
||||
|
||||
while not Query.EOF do
|
||||
begin
|
||||
UserItem.id := Query.FieldByName('id').AsString;
|
||||
UserItem.login := Query.FieldByName('login').AsString;
|
||||
UserItem.DisplayName := Query.FieldByName('DisplayName').AsString;
|
||||
UserItem.created_at := Query.FieldByName('created_at').AsDateTime;
|
||||
UserItem.follow_at := Query.FieldByName('follow_at').AsDateTime;
|
||||
UserItem.isVip := Query.FieldByName('isVip').AsString = 'True';
|
||||
UserItem.isModer := Query.FieldByName('isModer').AsString = 'True';
|
||||
UserItem.isO := Query.FieldByName('isO').AsString = 'True';
|
||||
UserItem.isO_today := False;
|
||||
users.Add(UserItem);
|
||||
Query.Next;
|
||||
end;
|
||||
finally
|
||||
Query.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TSettingsDatabase.GetColumnsDefinition(Grid: TStringGrid): string;
|
||||
var
|
||||
Col: Integer;
|
||||
begin
|
||||
Result := '';
|
||||
for Col := 0 to Grid.ColumnCount - 1 do
|
||||
begin
|
||||
if Result <> '' then
|
||||
Result := Result + ', ';
|
||||
Result := Result + 'col' + IntToStr(Col) + ' TEXT';
|
||||
end;
|
||||
end;
|
||||
|
||||
function TSettingsDatabase.GetColumnsList(Grid: TStringGrid): string;
|
||||
var
|
||||
Col: Integer;
|
||||
begin
|
||||
Result := '';
|
||||
for Col := 0 to Grid.ColumnCount - 1 do
|
||||
begin
|
||||
if Result <> '' then
|
||||
Result := Result + ', ';
|
||||
Result := Result + 'col' + IntToStr(Col);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSettingsDatabase.getGroupName(const lbName: TStrings);
|
||||
var
|
||||
Query: TFDQuery;
|
||||
begin
|
||||
Query := TFDQuery.Create(nil);
|
||||
try
|
||||
Query.Connection := FConnection;
|
||||
lbName.Clear;
|
||||
Query.SQL.Text := 'SELECT DISTINCT Name FROM GroupResponse';
|
||||
Query.Open;
|
||||
while not Query.EOF do
|
||||
begin
|
||||
lbName.Add(Query.FieldByName('Name').AsString);
|
||||
Query.Next;
|
||||
end;
|
||||
finally
|
||||
Query.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSettingsDatabase.getGroupResponse(aName: string; const lbResponse: TStrings);
|
||||
var
|
||||
Query: TFDQuery;
|
||||
begin
|
||||
Query := TFDQuery.Create(nil);
|
||||
try
|
||||
Query.Connection := FConnection;
|
||||
lbResponse.Clear;
|
||||
Query.SQL.Text := 'SELECT Response FROM GroupResponse WHERE Name = :name';
|
||||
Query.ParamByName('name').AsString := aName;
|
||||
Query.Open;
|
||||
while not Query.EOF do
|
||||
begin
|
||||
lbResponse.Add(Query.FieldByName('Response').AsString);
|
||||
Query.Next;
|
||||
end;
|
||||
finally
|
||||
Query.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TSettingsDatabase.getLoginData: TLogin;
|
||||
begin
|
||||
Result.TTV_Token_Bot := ReadSetting('edtBotToken');
|
||||
Result.TTV_Token_Strimer := ReadSetting('edtBotTokenStreamer');
|
||||
Result.TTV_Name_Bot := ReadSetting('edtBotName');
|
||||
Result.TTV_Name_Strimer := ReadSetting('edtChannel');
|
||||
Result.TTV_ClientID := ReadSetting('edtBotClientID');
|
||||
|
||||
Result.DA_ClientID := ReadSetting('edtDAClientID');
|
||||
Result.DA_Client_Sictert := ReadSetting('edtDAClientSecret');
|
||||
Result.DA_RedirectURL := ReadSetting('edtDARedirectURL');
|
||||
Result.DA_Code := ReadSetting('edtDACode');
|
||||
|
||||
Result.AI_Gigachat_ClientID := ReadSetting('edtGPTClientID');
|
||||
Result.AI_Gigachat_AutorizationCode := ReadSetting('edtGPTAC');
|
||||
Result.AI_ChatGPT_Token := ReadSetting('edtGPTATChatGPT');
|
||||
Result.AI_DeepSeek_Token := ReadSetting('edtGPTATDeepSeek');
|
||||
end;
|
||||
|
||||
function TSettingsDatabase.GetValuesPlaceholders(Grid: TStringGrid): string;
|
||||
var
|
||||
Col: Integer;
|
||||
begin
|
||||
Result := '';
|
||||
for Col := 0 to Grid.ColumnCount - 1 do
|
||||
begin
|
||||
if Result <> '' then
|
||||
Result := Result + ', ';
|
||||
Result := Result + ':col' + IntToStr(Col);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSettingsDatabase.addGroupResponse(Name, Respons: string);
|
||||
var
|
||||
Query: TFDQuery;
|
||||
begin
|
||||
Query := TFDQuery.Create(nil);
|
||||
try
|
||||
Query.Connection := FConnection;
|
||||
Query.SQL.Text := 'INSERT INTO GroupResponse (Name, Response) VALUES (:name, :response)';
|
||||
Query.ParamByName('name').AsString := Name;
|
||||
Query.ParamByName('response').AsString := Respons;
|
||||
Query.ExecSQL;
|
||||
finally
|
||||
Query.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TSettingsDatabase.CheckTableExists(const TableName: string): Boolean;
|
||||
var
|
||||
Query: TFDQuery;
|
||||
begin
|
||||
Result := False;
|
||||
Query := TFDQuery.Create(nil);
|
||||
try
|
||||
Query.Connection := FConnection;
|
||||
Query.SQL.Text := 'SELECT COUNT(*) FROM sqlite_master WHERE type=''table'' AND name=:TableName';
|
||||
Query.ParamByName('TableName').AsString := TableName;
|
||||
Query.Open;
|
||||
Result := (Query.Fields[0].AsInteger > 0);
|
||||
finally
|
||||
Query.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSettingsDatabase.LoadGridFromTable(const TableName: string; Grid: TStringGrid);
|
||||
var
|
||||
Query: TFDQuery;
|
||||
Col, Row: Integer;
|
||||
begin
|
||||
if not CheckTableExists(TableName) then Exit;
|
||||
|
||||
Query := TFDQuery.Create(nil);
|
||||
try
|
||||
Query.Connection := FConnection;
|
||||
Query.SQL.Text := 'SELECT * FROM ' + TableName;
|
||||
Query.Open;
|
||||
|
||||
Grid.RowCount := 0;
|
||||
while not Query.EOF do
|
||||
begin
|
||||
Row := Grid.RowCount;
|
||||
Grid.RowCount := Grid.RowCount + 1;
|
||||
|
||||
for Col := 0 to Grid.ColumnCount - 1 do
|
||||
Grid.Cells[Col, Row] := Query.FieldByName('col' + IntToStr(Col)).AsString;
|
||||
|
||||
Query.Next;
|
||||
end;
|
||||
finally
|
||||
Query.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSettingsDatabase.SaveGridToTable(const TableName: string; Grid: TStringGrid);
|
||||
var
|
||||
Query: TFDQuery;
|
||||
Col, Row: Integer;
|
||||
begin
|
||||
FConnection.ExecSQL('DROP TABLE IF EXISTS ' + TableName);
|
||||
FConnection.ExecSQL('CREATE TABLE ' + TableName + ' (id INTEGER PRIMARY KEY AUTOINCREMENT, ' + GetColumnsDefinition(Grid) + ');');
|
||||
|
||||
Query := TFDQuery.Create(nil);
|
||||
try
|
||||
Query.Connection := FConnection;
|
||||
for Row := 0 to Grid.RowCount - 1 do
|
||||
begin
|
||||
Query.SQL.Text := 'INSERT INTO ' + TableName + ' (' + GetColumnsList(Grid) + ') VALUES (' + GetValuesPlaceholders(Grid) + ')';
|
||||
for Col := 0 to Grid.ColumnCount - 1 do
|
||||
Query.ParamByName('col' + IntToStr(Col)).AsString := Grid.Cells[Col, Row];
|
||||
Query.ExecSQL;
|
||||
end;
|
||||
finally
|
||||
Query.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TSettingsDatabase.GetSetting(const Name: string): string;
|
||||
var
|
||||
Query: TFDQuery;
|
||||
begin
|
||||
Query := TFDQuery.Create(nil);
|
||||
try
|
||||
Query.Connection := FConnection;
|
||||
Query.SQL.Text := 'SELECT value FROM params WHERE name = :name';
|
||||
Query.ParamByName('name').AsString := Name;
|
||||
Query.Open;
|
||||
if not Query.IsEmpty then
|
||||
Result := Query.FieldByName('value').AsString
|
||||
else
|
||||
Result := '';
|
||||
finally
|
||||
Query.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSettingsDatabase.SetSetting(const Name, Value: string);
|
||||
begin
|
||||
FConnection.ExecSQL('INSERT OR REPLACE INTO params (name, value) VALUES (:name, :value)', [Name, Value]);
|
||||
end;
|
||||
|
||||
function TSettingsDatabase.ReadSetting(const Name: string; Default: string = ''): string;
|
||||
begin
|
||||
Result := GetSetting(Name);
|
||||
if Result = '' then
|
||||
Result := Default;
|
||||
end;
|
||||
|
||||
procedure TSettingsDatabase.WriteSetting(const Name, Value: string);
|
||||
begin
|
||||
SetSetting(Name, Value);
|
||||
end;
|
||||
|
||||
function TSettingsDatabase.TableHasColumn(const TableName, ColumnName: string): Boolean;
|
||||
var
|
||||
Query: TFDQuery;
|
||||
begin
|
||||
Query := TFDQuery.Create(nil);
|
||||
try
|
||||
Query.Connection := FConnection;
|
||||
Query.SQL.Text := Format('PRAGMA table_info(%s)', [TableName]);
|
||||
Query.Open;
|
||||
Result := False;
|
||||
while not Query.EOF do
|
||||
begin
|
||||
if SameText(Query.FieldByName('name').AsString, ColumnName) then
|
||||
Exit(True);
|
||||
Query.Next;
|
||||
end;
|
||||
finally
|
||||
Query.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TSettingsDatabase.GetSQLType(Field: TRttiField): string;
|
||||
begin
|
||||
case Field.FieldType.TypeKind of
|
||||
tkInteger, tkInt64:
|
||||
Result := 'INTEGER';
|
||||
tkFloat:
|
||||
Result := 'REAL';
|
||||
tkUString, tkString, tkWString, tkLString:
|
||||
Result := 'TEXT';
|
||||
tkEnumeration:
|
||||
if Field.FieldType = TypeInfo(Boolean) then
|
||||
Result := 'BOOLEAN'
|
||||
else
|
||||
Result := 'INTEGER';
|
||||
else
|
||||
raise Exception.CreateFmt('Unsupported type for field %s', [Field.Name]);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSettingsDatabase.EnsureTableForRecord(const TableName: string; RecordTypeInfo: PTypeInfo);
|
||||
var
|
||||
Context: TRttiContext;
|
||||
RttiType: TRttiType;
|
||||
Field: TRttiField;
|
||||
FieldDefs: string;
|
||||
Query: TFDQuery;
|
||||
begin
|
||||
if not CheckTableExists(TableName) then
|
||||
begin
|
||||
Context := TRttiContext.Create;
|
||||
RttiType := Context.GetType(RecordTypeInfo);
|
||||
FieldDefs := '';
|
||||
for Field in RttiType.GetFields do
|
||||
begin
|
||||
if FieldDefs <> '' then
|
||||
FieldDefs := FieldDefs + ', ';
|
||||
FieldDefs := FieldDefs + Field.Name + ' ' + GetSQLType(Field);
|
||||
end;
|
||||
FConnection.ExecSQL(Format('CREATE TABLE %s (%s)', [TableName, FieldDefs]));
|
||||
end
|
||||
else
|
||||
begin
|
||||
Context := TRttiContext.Create;
|
||||
|
||||
RttiType := Context.GetType(RecordTypeInfo);
|
||||
Query := TFDQuery.Create(nil);
|
||||
try
|
||||
Query.Connection := FConnection;
|
||||
for Field in RttiType.GetFields do
|
||||
begin
|
||||
if not TableHasColumn(TableName, Field.Name) then
|
||||
begin
|
||||
Query.SQL.Text := Format('ALTER TABLE %s ADD COLUMN %s %s', [TableName, Field.Name, GetSQLType(Field)]);
|
||||
Query.ExecSQL;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
Query.Free;
|
||||
end;
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TSettingsDatabase.SaveRecordArray<T>(const TableName: string; const Items: array of T);
|
||||
var
|
||||
Context: TRttiContext;
|
||||
RttiType: TRttiType;
|
||||
Fields: TArray<TRttiField>;
|
||||
Query: TFDQuery;
|
||||
Rec: T;
|
||||
Field: TRttiField;
|
||||
FieldNames, Placeholders: string;
|
||||
i, j: Integer;
|
||||
Value: TValue;
|
||||
Param: TFDParam;
|
||||
begin
|
||||
if Length(Items) = 0 then
|
||||
begin
|
||||
FConnection.ExecSQL('DELETE FROM ' + TableName);
|
||||
exit;
|
||||
end;
|
||||
|
||||
EnsureTableForRecord(TableName, TypeInfo(T));
|
||||
|
||||
Context := TRttiContext.Create;
|
||||
|
||||
RttiType := Context.GetType(TypeInfo(T));
|
||||
Fields := RttiType.GetFields;
|
||||
|
||||
Query := TFDQuery.Create(nil);
|
||||
try
|
||||
Query.Connection := FConnection;
|
||||
|
||||
// Ïîñòðîåíèå ñïèñêà ïîëåé è ïëåéñõîëäåðîâ
|
||||
FieldNames := '';
|
||||
Placeholders := '';
|
||||
for j := 0 to High(Fields) do
|
||||
begin
|
||||
if j > 0 then
|
||||
begin
|
||||
FieldNames := FieldNames + ', ';
|
||||
Placeholders := Placeholders + ', ';
|
||||
end;
|
||||
FieldNames := FieldNames + Fields[j].Name;
|
||||
Placeholders := Placeholders + ':' + Fields[j].Name;
|
||||
end;
|
||||
|
||||
Query.SQL.Text := 'INSERT INTO ' + TableName + ' (' + FieldNames + ') VALUES (' + Placeholders + ')';
|
||||
|
||||
// Ïîäãîòàâëèâàåì çàïðîñ (ñîçäàåò ïàðàìåòðû)
|
||||
//Query.Prepare;
|
||||
|
||||
// Óñòàíàâëèâàåì ðàçìåð ìàññèâà ïàðàìåòðîâ
|
||||
Query.Params.ArraySize := Length(Items);
|
||||
|
||||
// Íà÷àëî òðàíçàêöèè
|
||||
FConnection.StartTransaction;
|
||||
try
|
||||
// Î÷èñòêà òàáëèöû ïåðåä âñòàâêîé íîâûõ äàííûõ
|
||||
FConnection.ExecSQL('DELETE FROM ' + TableName);
|
||||
|
||||
i := 0;
|
||||
for Rec in Items do
|
||||
begin
|
||||
for Field in Fields do
|
||||
begin
|
||||
Value := Field.GetValue(@Rec);
|
||||
|
||||
// Íàõîäèì ïàðàìåòð
|
||||
Param := Query.FindParam(Field.Name);
|
||||
if not Assigned(Param) then
|
||||
raise Exception.CreateFmt('Parameter "%s" not found in query', [Field.Name]);
|
||||
|
||||
// Îáðàáîòêà NULL-çíà÷åíèé
|
||||
if Value.IsEmpty then
|
||||
begin
|
||||
Param.Clear(i);
|
||||
end
|
||||
else
|
||||
begin
|
||||
// Îáðàáîòêà ïî òèïó
|
||||
case Field.FieldType.TypeKind of
|
||||
tkInteger, tkInt64:
|
||||
Param.AsIntegers[i] := Value.AsInteger;
|
||||
tkFloat:
|
||||
if (Field.FieldType = TypeInfo(TDateTime)) or
|
||||
(Field.FieldType = TypeInfo(TDate)) or
|
||||
(Field.FieldType = TypeInfo(TTime)) then
|
||||
Param.AsDateTimes[i] := Value.AsExtended
|
||||
else
|
||||
Param.AsFloats[i] := Value.AsExtended;
|
||||
tkEnumeration:
|
||||
if Field.FieldType = TypeInfo(Boolean) then
|
||||
Param.AsBooleans[i] := Value.AsBoolean
|
||||
else
|
||||
Param.AsIntegers[i] := Value.AsOrdinal;
|
||||
tkUString, tkString, tkWString, tkLString:
|
||||
Param.AsStrings[i] := Value.AsString;
|
||||
else
|
||||
Param.AsStrings[i] := Value.ToString;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
Inc(i);
|
||||
end;
|
||||
|
||||
// Ïàêåòíîå âûïîëíåíèå
|
||||
Query.Execute(Length(Items), 0);
|
||||
FConnection.Commit;
|
||||
except
|
||||
FConnection.Rollback;
|
||||
raise;
|
||||
end;
|
||||
finally
|
||||
Query.Free;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
|
||||
procedure TSettingsDatabase.LoadRecordArray<T>(const TableName: string; var Items: TArray<T>);
|
||||
var
|
||||
Context: TRttiContext;
|
||||
RttiType: TRttiType;
|
||||
Fields: TArray<TRttiField>;
|
||||
Query: TFDQuery;
|
||||
Rec: T;
|
||||
RecList: TList<T>;
|
||||
Field: TRttiField;
|
||||
begin
|
||||
if not CheckTableExists(TableName) then
|
||||
begin
|
||||
SetLength(Items, 0);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
EnsureTableForRecord(TableName, TypeInfo(T));
|
||||
|
||||
Context := TRttiContext.Create;
|
||||
try
|
||||
RttiType := Context.GetType(TypeInfo(T));
|
||||
Fields := RttiType.GetFields;
|
||||
|
||||
Query := TFDQuery.Create(nil);
|
||||
RecList := TList<T>.Create;
|
||||
try
|
||||
Query.Connection := FConnection;
|
||||
Query.SQL.Text := Format('SELECT * FROM %s', [TableName]);
|
||||
Query.Open;
|
||||
|
||||
while not Query.EOF do
|
||||
begin
|
||||
Rec := Default(T);
|
||||
for Field in Fields do
|
||||
begin
|
||||
if Query.FindField(Field.Name) <> nil then
|
||||
Field.SetValue(@Rec, TValue.FromVariant(Query.FieldByName(Field.Name).Value));
|
||||
end;
|
||||
RecList.Add(Rec);
|
||||
Query.Next;
|
||||
end;
|
||||
|
||||
Items := RecList.ToArray;
|
||||
finally
|
||||
Query.Free;
|
||||
RecList.Free;
|
||||
end;
|
||||
finally
|
||||
Context.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,158 @@
|
||||
unit uMyTimer;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.Classes, System.SyncObjs, System.SysUtils;
|
||||
|
||||
type
|
||||
TTimerExec = procedure(Sender: TObject; const txt: string; o: Boolean) of object;
|
||||
|
||||
TMyTimerThread = class(TThread)
|
||||
private
|
||||
FEvent: TEvent;
|
||||
FCriticalSection: TCriticalSection;
|
||||
FInterval: Integer;
|
||||
FText: string;
|
||||
FFlagO: Boolean;
|
||||
FEnabled: Boolean;
|
||||
FOnTimerExec: TTimerExec;
|
||||
procedure SyncTimerEvent;
|
||||
protected
|
||||
procedure Execute; override;
|
||||
public
|
||||
constructor Create(AIntervalMinutes: Integer; const AText: string; AFlagO: Boolean);
|
||||
destructor Destroy; override;
|
||||
procedure StartT;
|
||||
procedure StopT;
|
||||
procedure TerminateAndDestroy;
|
||||
procedure Update(AIntervalMinutes: Integer; const AText: string; AFlagO: Boolean);
|
||||
property OnTimerExec: TTimerExec read FOnTimerExec write FOnTimerExec;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TMyTimerThread }
|
||||
|
||||
constructor TMyTimerThread.Create(AIntervalMinutes: Integer; const AText: string; AFlagO: Boolean);
|
||||
begin
|
||||
inherited Create(True);
|
||||
FreeOnTerminate := False;
|
||||
FEvent := TEvent.Create(nil, True, False, '');
|
||||
FCriticalSection := TCriticalSection.Create;
|
||||
FInterval := AIntervalMinutes * 60 * 1000;
|
||||
FText := AText;
|
||||
FFlagO := AFlagO;
|
||||
FEnabled := False;
|
||||
end;
|
||||
|
||||
destructor TMyTimerThread.Destroy;
|
||||
begin
|
||||
StopT;
|
||||
Terminate;
|
||||
FEvent.SetEvent;
|
||||
if not Suspended then
|
||||
WaitFor;
|
||||
FreeAndNil(FEvent);
|
||||
FreeAndNil(FCriticalSection);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TMyTimerThread.Execute;
|
||||
var
|
||||
WaitResult: TWaitResult;
|
||||
LocalInterval: Integer;
|
||||
begin
|
||||
while not Terminated do
|
||||
begin
|
||||
FCriticalSection.Enter;
|
||||
try
|
||||
if FEnabled then
|
||||
LocalInterval := FInterval
|
||||
else
|
||||
LocalInterval := INFINITE;
|
||||
finally
|
||||
FCriticalSection.Leave;
|
||||
end;
|
||||
|
||||
WaitResult := FEvent.WaitFor(LocalInterval);
|
||||
|
||||
FCriticalSection.Enter;
|
||||
try
|
||||
if FEnabled and (WaitResult = wrTimeout) then
|
||||
begin
|
||||
if Assigned(FOnTimerExec) then
|
||||
SyncTimerEvent;
|
||||
end;
|
||||
finally
|
||||
FCriticalSection.Leave;
|
||||
end;
|
||||
|
||||
FEvent.ResetEvent;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMyTimerThread.StartT;
|
||||
begin
|
||||
FCriticalSection.Enter;
|
||||
try
|
||||
FEnabled := True;
|
||||
Suspended:=false;
|
||||
finally
|
||||
FCriticalSection.Leave;
|
||||
end;
|
||||
if Suspended then
|
||||
Start;
|
||||
FEvent.SetEvent;
|
||||
end;
|
||||
|
||||
procedure TMyTimerThread.StopT;
|
||||
begin
|
||||
FCriticalSection.Enter;
|
||||
|
||||
try
|
||||
FEnabled := False;
|
||||
Suspended:=true;
|
||||
finally
|
||||
FCriticalSection.Leave;
|
||||
end;
|
||||
FEvent.SetEvent;
|
||||
end;
|
||||
|
||||
procedure TMyTimerThread.SyncTimerEvent;
|
||||
var
|
||||
LText: string;
|
||||
LFlag: Boolean;
|
||||
begin
|
||||
FCriticalSection.Enter;
|
||||
try
|
||||
LText := FText;
|
||||
LFlag := FFlagO;
|
||||
finally
|
||||
FCriticalSection.Leave;
|
||||
end;
|
||||
if Assigned(FOnTimerExec) then
|
||||
FOnTimerExec(Self, LText, LFlag);
|
||||
end;
|
||||
|
||||
procedure TMyTimerThread.TerminateAndDestroy;
|
||||
begin
|
||||
StopT;
|
||||
Terminate;
|
||||
Free;
|
||||
end;
|
||||
|
||||
procedure TMyTimerThread.Update(AIntervalMinutes: Integer; const AText: string; AFlagO: Boolean);
|
||||
begin
|
||||
FCriticalSection.Enter;
|
||||
try
|
||||
FInterval := AIntervalMinutes * 60 * 1000;
|
||||
FText := AText;
|
||||
FFlagO := AFlagO;
|
||||
finally
|
||||
FCriticalSection.Leave;
|
||||
end;
|
||||
FEvent.SetEvent;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,13 @@
|
||||
object OBS_Doc_Player: TOBS_Doc_Player
|
||||
OnCreate = WebModuleCreate
|
||||
OnDestroy = WebModuleDestroy
|
||||
Actions = <
|
||||
item
|
||||
Default = True
|
||||
Name = 'DefaultHandler'
|
||||
PathInfo = '/'
|
||||
OnAction = WebModule1DefaultHandlerAction
|
||||
end>
|
||||
Height = 230
|
||||
Width = 415
|
||||
end
|
||||
@@ -0,0 +1,273 @@
|
||||
unit uOBS_Doc_Player;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils, System.Classes, Web.HTTPApp, FMX.Types,
|
||||
FMX.Controls3D, FMX.Objects3D, FMX.Controls, FMX.Forms, FMX.StdCtrls,
|
||||
FMX.Edit, FMX.ListBox, uPlayerThread, bass_simple;
|
||||
|
||||
type
|
||||
TOBS_Doc_Player = class(TWebModule)
|
||||
procedure WebModule1DefaultHandlerAction(Sender: TObject;
|
||||
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
|
||||
procedure Button1Click(Sender: TObject);
|
||||
procedure Button2Click(Sender: TObject);
|
||||
procedure TrackBar1Change(Sender: TObject);
|
||||
procedure WebModuleCreate(Sender: TObject);
|
||||
procedure WebModuleDestroy(Sender: TObject);
|
||||
private
|
||||
{ Private declarations }
|
||||
function gethtml(): string;
|
||||
procedure AddToListBox(Text: String);
|
||||
procedure DelFromListBox(Text: String);
|
||||
procedure add(const aTitle: string);
|
||||
procedure del(const aTitle: string);
|
||||
{ Private declarations }
|
||||
public
|
||||
{ Public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
OBS_Doc_Player: TComponentClass = TOBS_Doc_Player;
|
||||
Button1: TButton;
|
||||
Button2: TButton;
|
||||
ProgressBar1: TProgressBar;
|
||||
TrackBar1: TTrackBar;
|
||||
ListBox1: TListBox;
|
||||
b: TBassSimple;
|
||||
player: TPlayerThread;
|
||||
mVolume: Integer;
|
||||
isplay: string;
|
||||
mySoundPath: string;
|
||||
|
||||
implementation
|
||||
|
||||
{%CLASSGROUP 'FMX.Controls.TControl'}
|
||||
{$R *.dfm}
|
||||
{ TOBS_Doc_Player }
|
||||
|
||||
function GetPathToTestExe: string; // âåðíåò ïàïêó romaming
|
||||
begin
|
||||
Result := GetEnvironmentVariable('APPDATA');
|
||||
if Result <> '' then
|
||||
Result := IncludeTrailingPathDelimiter(Result);
|
||||
end;
|
||||
|
||||
procedure TOBS_Doc_Player.add(const aTitle: string);
|
||||
begin
|
||||
AddToListBox(aTitle);
|
||||
end;
|
||||
|
||||
procedure TOBS_Doc_Player.AddToListBox(Text: String);
|
||||
begin
|
||||
if ListBox1.Items.IndexOf(Text) = -1 then
|
||||
ListBox1.Items.add(Text);
|
||||
end;
|
||||
|
||||
procedure TOBS_Doc_Player.Button1Click(Sender: TObject);
|
||||
begin
|
||||
b.Pause;
|
||||
if isplay = '0' then
|
||||
isplay := '1'
|
||||
else
|
||||
isplay := '0'
|
||||
end;
|
||||
|
||||
procedure TOBS_Doc_Player.Button2Click(Sender: TObject);
|
||||
begin
|
||||
player.Skip;
|
||||
end;
|
||||
|
||||
procedure TOBS_Doc_Player.del(const aTitle: string);
|
||||
begin
|
||||
DelFromListBox(aTitle);
|
||||
end;
|
||||
|
||||
procedure TOBS_Doc_Player.DelFromListBox(Text: String);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Application.ProcessMessages;
|
||||
i := ListBox1.Items.IndexOf(Text);
|
||||
if i <> -1 then
|
||||
if i <= ListBox1.Items.Count - 1 then
|
||||
ListBox1.Items.Delete(i);
|
||||
Application.ProcessMessages;
|
||||
end;
|
||||
|
||||
function TOBS_Doc_Player.gethtml: string;
|
||||
var
|
||||
s: string;
|
||||
i: Integer;
|
||||
playIcon: string;
|
||||
begin
|
||||
// Îïðåäåëÿåì èêîíêó â çàâèñèìîñòè îò ñîñòîÿíèÿ
|
||||
if isplay = '1' then
|
||||
playIcon := 'fa-pause'
|
||||
else
|
||||
playIcon := 'fa-play';
|
||||
|
||||
// Ñîáèðàåì ýëåìåíòû ListBox â ñòðîêó
|
||||
s := '';
|
||||
for i := 0 to ListBox1.Items.Count - 1 do
|
||||
s := s + '<li>' + ListBox1.Items[i] + '</li>';
|
||||
|
||||
// Ãåíåðàöèÿ HTML-ñòðàíèöû ñ îáíîâëåííûìè çíà÷åíèÿìè
|
||||
Result := '<html>' + '<head><title>Web Radio</title>' +
|
||||
'<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/6.0.0/css/all.min.css">'
|
||||
+ '<style>' + 'body {' + 'background-color: #1d1f21;' + 'color: #ffffff;' +
|
||||
'font-family: "Arial", sans-serif;' + 'text-align: center;' + 'margin: 0;' +
|
||||
'padding: 20px;' + 'display: flex;' + 'flex-direction: column;' +
|
||||
'align-items: center;' + '}' +
|
||||
|
||||
'.controls {' + 'display: flex;' + 'gap: 20px;' + 'align-items: center;' +
|
||||
'margin: 20px 0;' + '}' +
|
||||
|
||||
'.icon-btn {' + 'cursor: pointer;' + 'font-size: 24px;' + 'color: #4e8b31;'
|
||||
+ 'transition: transform 0.2s, color 0.2s;' + 'background: none;' +
|
||||
'border: none;' + 'padding: 10px;' + '}' +
|
||||
|
||||
'.icon-btn:hover {' + 'color: #5f9c42;' + 'transform: scale(1.1);' + '}' +
|
||||
|
||||
'.volume-container {' + 'margin: 20px 0;' + '}' +
|
||||
|
||||
'ul {' + 'list-style-type: none;' + 'padding: 0;' + 'color: #ccc;' +
|
||||
'max-width: 500px;' + 'width: 100%;' + '}' +
|
||||
|
||||
'li {' + 'background-color: #333;' + 'margin: 5px;' + 'padding: 15px;' +
|
||||
'border-radius: 5px;' + 'text-align: left;' + '}' +
|
||||
|
||||
'#currentVolume {' + 'font-size: 16px;' + 'color: #ddd;' +
|
||||
'margin-bottom: 10px;' + '}' + '</style>' +
|
||||
|
||||
'<script>' + 'function setVolume(val) {' +
|
||||
' fetch("/setVolume?value=" + val); ' +
|
||||
' document.getElementById("currentVolume").innerText = "Ãðîìêîñòü: " + val + "%";'
|
||||
+ '} ' +
|
||||
|
||||
'function btn(val) {' + ' if (val == 1) {' +
|
||||
' const icon = document.getElementById("playIcon");' +
|
||||
' icon.classList.toggle("fa-play");' +
|
||||
' icon.classList.toggle("fa-pause");' + ' fetch("/button1");' + ' }'
|
||||
+ ' if (val == 2) fetch("/button2");' + '}' + '</script>' + '</head>' +
|
||||
'<body>' + '<div class="controls">' +
|
||||
|
||||
'<i id="playIcon" class="icon-btn fas ' + playIcon +
|
||||
'" onclick="btn(1)"></i>' +
|
||||
'<i class="icon-btn fas fa-forward" onclick="btn(2)"></i>' + '</div>' +
|
||||
|
||||
'<div class="volume-container">' + '<label id="currentVolume">Ãðîìêîñòü: ' +
|
||||
IntToStr(mVolume) + '%</label>' +
|
||||
'<input type="range" min="0" max="100" value="' + IntToStr(mVolume) +
|
||||
'" onchange="setVolume(this.value)" />' + '</div>' +
|
||||
|
||||
'<ul id="songList">' + s + '</ul>' +
|
||||
|
||||
'<script>' + 'function updateSongList() {' + ' fetch("/getSongs")' +
|
||||
' .then(response => response.json())' + ' .then(data => {' +
|
||||
' const listElement = document.getElementById("songList");' +
|
||||
' listElement.innerHTML = "";' + ' data.forEach(song => {' +
|
||||
' const li = document.createElement("li");' +
|
||||
' li.textContent = song;' + ' listElement.appendChild(li);' +
|
||||
' });' + ' })' +
|
||||
' .catch(error => console.error("Error fetching songs:", error));' + '}'
|
||||
+ 'setInterval(updateSongList, 3000);' + '</script>' + '</body>' +
|
||||
'</html>';
|
||||
end;
|
||||
|
||||
procedure TOBS_Doc_Player.TrackBar1Change(Sender: TObject);
|
||||
begin
|
||||
mVolume := Round(TrackBar1.Value);
|
||||
b.Volume := mVolume;
|
||||
end;
|
||||
|
||||
procedure TOBS_Doc_Player.WebModule1DefaultHandlerAction(Sender: TObject;
|
||||
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
|
||||
var
|
||||
VolumeStr: string;
|
||||
VolumeValue, i: Integer;
|
||||
begin
|
||||
if Request.PathInfo = '/getSongs' then
|
||||
begin
|
||||
// Âîçâðàùàåì ñïèñîê ïåñåí â ôîðìàòå JSON
|
||||
var
|
||||
songList: string := '[';
|
||||
for i := 0 to ListBox1.Items.Count - 1 do
|
||||
begin
|
||||
songList := songList + '"' + ListBox1.Items[i] + '"';
|
||||
if i < ListBox1.Items.Count - 1 then
|
||||
songList := songList + ',';
|
||||
end;
|
||||
songList := songList + ']';
|
||||
|
||||
Response.Content := songList; // Îòïðàâëÿåì JSON
|
||||
Response.ContentType := 'application/json;charset=utf8';
|
||||
Handled := True;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if Request.PathInfo = '/setVolume' then
|
||||
begin
|
||||
// Ïîëó÷àåì çíà÷åíèå èç ïàðàìåòðà 'value'
|
||||
VolumeStr := Request.QueryFields.Values['value'];
|
||||
// Ïðîáóåì ïðåîáðàçîâàòü â öåëîå ÷èñëî
|
||||
if TryStrToInt(VolumeStr, VolumeValue) then
|
||||
begin
|
||||
// Åñëè óäàëîñü ïðåîáðàçîâàòü, îáíîâëÿåì ïåðåìåííóþ mVolume
|
||||
mVolume := VolumeValue;
|
||||
// Îáíîâëÿåì çâóê íà ñåðâåðå (åñëè íóæíî, íàïðèìåð, ÷åðåç áèáëèîòåêó bass)
|
||||
b.Volume := mVolume;
|
||||
// Âîçâðàùàåì îáíîâëåííîå ñîñòîÿíèå íà ñòðàíèöó
|
||||
Response.Content := gethtml;
|
||||
end
|
||||
else
|
||||
begin
|
||||
// Åñëè íå óäàëîñü ïðåîáðàçîâàòü, âîçâðàùàåì îøèáêó
|
||||
Response.Content := 'Invalid volume value';
|
||||
end;
|
||||
Handled := True; // Çàïðîñ îáðàáîòàí
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if Request.PathInfo = '/button1' then
|
||||
begin
|
||||
Button1Click(Sender); // Âûçîâ ïðîöåäóðû äëÿ êíîïêè 1
|
||||
Response.Content := gethtml;
|
||||
Handled := True; // Óêàçûâàåì, ÷òî çàïðîñ áûë îáðàáîòàí
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if Request.PathInfo = '/button2' then
|
||||
begin
|
||||
Button2Click(Sender); // Âûçîâ ïðîöåäóðû äëÿ êíîïêè 2
|
||||
Response.Content := gethtml;
|
||||
Handled := True; // Óêàçûâàåì, ÷òî çàïðîñ áûë îáðàáîòàí
|
||||
Exit;
|
||||
end;
|
||||
|
||||
Response.Content := gethtml;
|
||||
Handled := True;
|
||||
end;
|
||||
|
||||
procedure TOBS_Doc_Player.WebModuleCreate(Sender: TObject);
|
||||
begin
|
||||
mySoundPath := GetPathToTestExe + 'TTW_Bot\ytSongs';
|
||||
b := TBassSimple.Create(0);
|
||||
player := TPlayerThread.Create(b, mySoundPath);
|
||||
player.OnAddAd := add;
|
||||
player.OnSkip := del;
|
||||
mVolume := 0;
|
||||
ListBox1 := TListBox.Create(self);
|
||||
player.Start;
|
||||
isplay := '1';
|
||||
end;
|
||||
|
||||
procedure TOBS_Doc_Player.WebModuleDestroy(Sender: TObject);
|
||||
begin
|
||||
player.Free;
|
||||
b.Free;
|
||||
ListBox1.Free;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,183 @@
|
||||
unit uPlayerThread;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, SyncObjs, Generics.Collections, bass_simple,
|
||||
System.IOUtils, Types;
|
||||
|
||||
type
|
||||
TOnError = procedure(const Msg, FileName: string) of object;
|
||||
TOnSkip = procedure(const FileName: string) of object;
|
||||
|
||||
TPlayerThread = class(TThread)
|
||||
private
|
||||
b: tbasssimple;
|
||||
FFilesQueue: TList<string>;
|
||||
FQueueCS: TCriticalSection;
|
||||
FCurrentFile: string;
|
||||
FOnError: TOnError;
|
||||
FOnSkip: TOnSkip;
|
||||
FOnAddAd: TOnSkip;
|
||||
FMusicFolder: string;
|
||||
FIsPlaying: Boolean;
|
||||
procedure PlayCurrentFile;
|
||||
procedure ScanFolder;
|
||||
procedure OnPlayHandler(Sender: TObject);
|
||||
procedure OnStopHandler(Sender: TObject);
|
||||
procedure OnEndPlayHandler(Sender: TObject);
|
||||
protected
|
||||
procedure Execute; override;
|
||||
public
|
||||
constructor Create(var ab: tbasssimple; const aFolder: string);
|
||||
destructor Destroy; override;
|
||||
procedure Skip;
|
||||
property OnError: TOnError read FOnError write FOnError;
|
||||
property OnSkip: TOnSkip read FOnSkip write FOnSkip;
|
||||
property OnAddAd: TOnSkip read FOnAddAd write FOnAddAd;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
constructor TPlayerThread.Create(var ab: tbasssimple; const aFolder: string);
|
||||
begin
|
||||
inherited Create(True);
|
||||
b := ab;
|
||||
FMusicFolder := aFolder;
|
||||
FIsPlaying := False;
|
||||
b.OnPlay := OnPlayHandler;
|
||||
b.OnStop := OnStopHandler;
|
||||
b.OnEndPlay := OnEndPlayHandler;
|
||||
FFilesQueue := TList<string>.Create;
|
||||
FQueueCS := TCriticalSection.Create;
|
||||
end;
|
||||
|
||||
destructor TPlayerThread.Destroy;
|
||||
begin
|
||||
FQueueCS.Enter;
|
||||
try
|
||||
FFilesQueue.Free;
|
||||
finally
|
||||
FQueueCS.Leave;
|
||||
end;
|
||||
FQueueCS.Free;
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TPlayerThread.Execute;
|
||||
begin
|
||||
while not Terminated do
|
||||
begin
|
||||
|
||||
ScanFolder;
|
||||
if (not FIsPlaying) then
|
||||
begin
|
||||
FQueueCS.Enter;
|
||||
try
|
||||
if (FFilesQueue.Count > 0) then
|
||||
begin
|
||||
FCurrentFile := FFilesQueue[0];
|
||||
FFilesQueue.Delete(0);
|
||||
end;
|
||||
finally
|
||||
FQueueCS.Leave;
|
||||
end;
|
||||
PlayCurrentFile;
|
||||
end;
|
||||
|
||||
Sleep(1000);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPlayerThread.PlayCurrentFile;
|
||||
begin
|
||||
if (FCurrentFile = '') or (not FileExists(FCurrentFile)) then
|
||||
begin
|
||||
if Assigned(FOnError) then
|
||||
FOnError('Ôàéë íå íàéäåí', FCurrentFile);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
// Ñîçäàåì íîâûé ïîòîê è íà÷èíàåì âîñïðîèçâåäåíèå
|
||||
TThread.Synchronize(nil,
|
||||
procedure
|
||||
begin
|
||||
b.Play(FCurrentFile);
|
||||
end);
|
||||
|
||||
FIsPlaying := True;
|
||||
|
||||
end;
|
||||
|
||||
procedure TPlayerThread.ScanFolder;
|
||||
var
|
||||
Files: TStringDynArray;
|
||||
FileName: string;
|
||||
begin
|
||||
Files := TDirectory.GetFiles(FMusicFolder, '*.mp3');
|
||||
FQueueCS.Enter;
|
||||
try
|
||||
for FileName in Files do
|
||||
if FFilesQueue.IndexOf(FileName) = -1 then
|
||||
begin
|
||||
Sleep(5000);
|
||||
FFilesQueue.Add(FileName);
|
||||
if Assigned(FOnAddAd) then
|
||||
TThread.Synchronize(nil,
|
||||
procedure
|
||||
begin
|
||||
FOnAddAd(ExtractFileName(FileName));
|
||||
end);
|
||||
end;
|
||||
finally
|
||||
FQueueCS.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPlayerThread.OnPlayHandler(Sender: TObject);
|
||||
begin
|
||||
FIsPlaying := True;
|
||||
end;
|
||||
|
||||
procedure TPlayerThread.OnStopHandler(Sender: TObject);
|
||||
begin
|
||||
FIsPlaying := False;
|
||||
end;
|
||||
|
||||
procedure TPlayerThread.OnEndPlayHandler(Sender: TObject);
|
||||
begin
|
||||
try
|
||||
b.Stop;
|
||||
b.FreeStream;
|
||||
if FileExists(FCurrentFile) then
|
||||
begin
|
||||
DeleteFile(FCurrentFile);
|
||||
if Assigned(FOnSkip) then
|
||||
FOnSkip(ExtractFileName(FCurrentFile));
|
||||
end;
|
||||
FCurrentFile := '';
|
||||
FIsPlaying := False;
|
||||
except
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPlayerThread.Skip;
|
||||
begin
|
||||
if FIsPlaying then
|
||||
begin
|
||||
b.Stop;
|
||||
b.FreeStream;
|
||||
if FileExists(FCurrentFile) then
|
||||
begin
|
||||
DeleteFile(FCurrentFile);
|
||||
if Assigned(FOnSkip) then
|
||||
FOnSkip(ExtractFileName(FCurrentFile));
|
||||
end;
|
||||
FCurrentFile := '';
|
||||
FIsPlaying := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,482 @@
|
||||
unit uRecords;
|
||||
|
||||
interface
|
||||
|
||||
|
||||
|
||||
|
||||
type
|
||||
TRLog = record
|
||||
rTime: ttime;
|
||||
rType: string;
|
||||
rModule: string;
|
||||
rMethod: string;
|
||||
rMessage: string;
|
||||
end;
|
||||
|
||||
type
|
||||
TCounter = record
|
||||
counterName: string;
|
||||
trigger: string;
|
||||
count: integer;
|
||||
auto: integer;
|
||||
end;
|
||||
|
||||
type
|
||||
TBanWord = record
|
||||
regexp: string;
|
||||
end;
|
||||
|
||||
type
|
||||
TListTimer = record
|
||||
Enable: integer;
|
||||
interval: integer;
|
||||
o: integer;
|
||||
mess: string;
|
||||
end;
|
||||
|
||||
type
|
||||
TOBSKandinsky = record
|
||||
port: integer;
|
||||
end;
|
||||
|
||||
type
|
||||
TOBSNotify = record
|
||||
Picture: string;
|
||||
Sound: string;
|
||||
|
||||
ColorBlock: string;
|
||||
SolidBorder: integer;
|
||||
Paddings: integer;
|
||||
ColorBorder: integer;
|
||||
ColorBackground: integer;
|
||||
|
||||
HeaderText: string;
|
||||
HeaderColorFont: integer;
|
||||
HeaderSizeFont: integer;
|
||||
HeaderStyleFont: integer;
|
||||
|
||||
MessText: string;
|
||||
MessColorFont: integer;
|
||||
MessSizeFont: integer;
|
||||
MessStyleFont: integer;
|
||||
|
||||
TimeMess: integer;
|
||||
TypeEvent: integer;
|
||||
TypeEdit: string;
|
||||
port: integer;
|
||||
|
||||
end;
|
||||
|
||||
type
|
||||
TOBSChat = record
|
||||
ColorBlock: string;
|
||||
ColorBorder: integer;
|
||||
ColorBackground: integer;
|
||||
ColorFont: integer;
|
||||
SolidBorder: integer;
|
||||
Paddings: integer;
|
||||
SizeFont: integer;
|
||||
MaxCountMess: integer;
|
||||
TimeMess: integer;
|
||||
port: integer;
|
||||
freez:integer;
|
||||
StyleFont: integer;
|
||||
end;
|
||||
|
||||
type
|
||||
TRandomCounters = record
|
||||
rndName: string;
|
||||
Ot: integer;
|
||||
ToValue: integer;
|
||||
end;
|
||||
|
||||
type
|
||||
TListCommands = record
|
||||
R1: string;
|
||||
R2: string;
|
||||
end;
|
||||
|
||||
type
|
||||
TConst = record
|
||||
GeneralPath: string;
|
||||
AppDataPath: string;
|
||||
DBPath: string;
|
||||
fontsPath: string;
|
||||
imgsPath: string;
|
||||
soundsPath: string;
|
||||
stlPath: string;
|
||||
ytSongsPath: string;
|
||||
SilentPlay: string;
|
||||
ytPlay: string;
|
||||
cfg1: string;
|
||||
end;
|
||||
|
||||
type
|
||||
TLogin = record
|
||||
TTV_Token_Bot: string;
|
||||
TTV_Token_Strimer: string;
|
||||
TTV_Name_Bot: string;
|
||||
TTV_Name_Strimer: string;
|
||||
TTV_ClientID: string;
|
||||
|
||||
DA_ClientID: string;
|
||||
DA_Client_Sictert: string;
|
||||
DA_RedirectURL: string;
|
||||
DA_Code: string;
|
||||
|
||||
AI_Gigachat_ClientID: string;
|
||||
AI_Gigachat_AutorizationCode: string;
|
||||
AI_ChatGPT_Token: string;
|
||||
AI_DeepSeek_Token: string;
|
||||
end;
|
||||
|
||||
var
|
||||
RLogin: TLogin;
|
||||
|
||||
type
|
||||
TUser = record
|
||||
id: string;
|
||||
login: string;
|
||||
DisplayName: string;
|
||||
created_at: TDateTime;
|
||||
follow_at: TDateTime;
|
||||
isVip: boolean;
|
||||
isModer: boolean;
|
||||
isO: boolean;
|
||||
isO_today: boolean;
|
||||
end;
|
||||
|
||||
TImage = record
|
||||
Url1x: string;
|
||||
Url2x: string;
|
||||
Url4x: string;
|
||||
end;
|
||||
|
||||
{ TReward = record
|
||||
Id: string;
|
||||
ChannelId: string;
|
||||
Title: string;
|
||||
Prompt: string;
|
||||
Cost: Integer;
|
||||
IsUserInputRequired: Boolean;
|
||||
IsSubOnly: Boolean;
|
||||
Image: TImage;
|
||||
DefaultImage: TImage;
|
||||
BackgroundColor: string;
|
||||
IsEnabled: Boolean;
|
||||
IsPaused: Boolean;
|
||||
IsInStock: Boolean;
|
||||
MaxPerStream: record
|
||||
IsEnabled: Boolean;
|
||||
MaxPerStream: Integer;
|
||||
end;
|
||||
ShouldRedemptionsSkipRequestQueue: Boolean;
|
||||
end; }
|
||||
|
||||
{ TRedemption = record
|
||||
Id: string;
|
||||
User: TUser;
|
||||
ChannelId: string;
|
||||
RedeemedAt: string;
|
||||
Reward: TReward;
|
||||
UserInput: string;
|
||||
Status: string;
|
||||
end; }
|
||||
|
||||
{ TData = record
|
||||
Timestamp: string;
|
||||
Topic: string; // Äîáàâëåíî ïîëå Topic
|
||||
MessageType: string; // Äîáàâëåíî ïîëå MessageType
|
||||
Redemption: TRedemption;
|
||||
end; }
|
||||
|
||||
{ TRewardRedeemed = record
|
||||
&Type: string;
|
||||
Data: TData;
|
||||
end; }
|
||||
|
||||
type
|
||||
TCustomRevards = record
|
||||
id: string;
|
||||
title: string;
|
||||
promt: string;
|
||||
cost: integer;
|
||||
is_user_input_required: boolean;
|
||||
end;
|
||||
|
||||
{ type
|
||||
THistRevards = record
|
||||
revard: TRewardRedeemed;
|
||||
user: user;
|
||||
is_ok: boolean;
|
||||
end; }
|
||||
|
||||
type
|
||||
TTwitchChatMessage = record
|
||||
BadgeInfo: string;
|
||||
Badges: string;
|
||||
ClientNonce: string;
|
||||
Color: string;
|
||||
DisplayName: string;
|
||||
Emotes: string;
|
||||
FirstMsg: integer;
|
||||
Flags: string;
|
||||
id: string;
|
||||
Moder: integer;
|
||||
ReturningChatter: integer;
|
||||
RoomId: string;
|
||||
Subscriber: integer;
|
||||
TmiSentTs: Int64;
|
||||
Turbo: integer;
|
||||
UserId: string;
|
||||
UserType: string;
|
||||
Vip: integer;
|
||||
Username: string;
|
||||
Channel: string;
|
||||
Message: string;
|
||||
end;
|
||||
|
||||
type
|
||||
TBadgeVersion = record
|
||||
id: string;
|
||||
ImageUrl1x: string;
|
||||
ImageUrl2x: string;
|
||||
ImageUrl4x: string;
|
||||
title: string;
|
||||
Description: string;
|
||||
ClickAction: string;
|
||||
ClickUrl: string;
|
||||
end;
|
||||
|
||||
TChatBadge = record
|
||||
SetId: string;
|
||||
Versions: TArray<TBadgeVersion>;
|
||||
end;
|
||||
|
||||
TEmotes = record
|
||||
id: string;
|
||||
name: string;
|
||||
images: TImage;
|
||||
tier: string;
|
||||
emote_type: string;
|
||||
emote_set_id: string;
|
||||
format: TArray<string>;
|
||||
scale: TArray<string>;
|
||||
theme_mode: TArray<string>;
|
||||
end;
|
||||
|
||||
TStyleChat = record
|
||||
Nick: string;
|
||||
Context: string;
|
||||
MaxMsgCount: integer;
|
||||
TimeMsg: integer;
|
||||
FontSize: integer;
|
||||
FontFamily: string;
|
||||
FontColor: string;
|
||||
BorderColor: string;
|
||||
BColor: string;
|
||||
BorderSize: integer;
|
||||
BlockColor: string;
|
||||
BlockPadding: integer;
|
||||
end;
|
||||
|
||||
TFont = record
|
||||
Font: string;
|
||||
Size: integer;
|
||||
Color: string;
|
||||
end;
|
||||
|
||||
TStyleEvent = record
|
||||
title: string;
|
||||
Context: string;
|
||||
Url: string;
|
||||
SoundURL: string;
|
||||
RequireInteraction: boolean;
|
||||
|
||||
Timestamp: TDateTime;
|
||||
TimeMsg: integer;
|
||||
|
||||
FontTitle: TFont;
|
||||
FontContext: TFont;
|
||||
|
||||
BorderColor: string;
|
||||
BorderSize: integer;
|
||||
BlockColor: string;
|
||||
|
||||
end;
|
||||
|
||||
type
|
||||
TBTTVr = record
|
||||
id: string;
|
||||
code: string;
|
||||
end;
|
||||
|
||||
type
|
||||
T7TVr = record
|
||||
id: string;
|
||||
code: string;
|
||||
Url: string;
|
||||
end;
|
||||
|
||||
TCondition = record
|
||||
broadcaster_user_id: string;
|
||||
reward_id: string;
|
||||
end;
|
||||
|
||||
TTransport = record
|
||||
method: string;
|
||||
end;
|
||||
|
||||
TSubscriptionPoints = record
|
||||
id: string;
|
||||
subscription_type: string;
|
||||
// "type" çàðåçåðâèðîâàíî â Delphi, ïîýòîìó èñïîëüçóåì äðóãîå èìÿ
|
||||
version: string;
|
||||
status: string;
|
||||
cost: integer;
|
||||
condition: TCondition;
|
||||
transport: TTransport;
|
||||
created_at: string;
|
||||
end;
|
||||
|
||||
TMaxPerStream = record
|
||||
is_enabled: boolean;
|
||||
value: integer;
|
||||
end;
|
||||
|
||||
TMaxPerUserPerStream = record
|
||||
is_enabled: boolean;
|
||||
value: integer;
|
||||
end;
|
||||
|
||||
TGlobalCooldown = record
|
||||
is_enabled: boolean;
|
||||
seconds: integer;
|
||||
end;
|
||||
|
||||
TReward = record
|
||||
id: string;
|
||||
title: string;
|
||||
cost: integer;
|
||||
prompt: string;
|
||||
end;
|
||||
|
||||
TEventReward = record
|
||||
id: string;
|
||||
broadcaster_user_id: string;
|
||||
broadcaster_user_login: string;
|
||||
broadcaster_user_name: string;
|
||||
user_id: string;
|
||||
user_login: string;
|
||||
user_name: string;
|
||||
user_input: string;
|
||||
revard: TReward;
|
||||
end;
|
||||
|
||||
TCustomRewardEvent = record
|
||||
subscription: TSubscriptionPoints;
|
||||
event: TEventReward;
|
||||
end;
|
||||
|
||||
TMetadata = record
|
||||
message_id: string;
|
||||
message_type: string;
|
||||
message_timestamp: string;
|
||||
subscription_type: string;
|
||||
end;
|
||||
|
||||
TSession = record
|
||||
id: string;
|
||||
status: string;
|
||||
connected_at: string;
|
||||
keepalive_timeout_seconds: integer;
|
||||
reconnect_url: string;
|
||||
end;
|
||||
|
||||
TPayload = record
|
||||
session: TSession;
|
||||
end;
|
||||
|
||||
TWelcomMessage = record
|
||||
payload: TPayload;
|
||||
end;
|
||||
|
||||
TEventFollow = record
|
||||
user_id: string;
|
||||
user_login: string;
|
||||
user_name: string;
|
||||
broadcaster_user_id: string;
|
||||
broadcaster_user_login: string;
|
||||
broadcaster_user_name: string;
|
||||
followed_at: string;
|
||||
end;
|
||||
|
||||
TEventSub = record
|
||||
user_id: string;
|
||||
user_login: string;
|
||||
user_name: string;
|
||||
broadcaster_user_id: string;
|
||||
broadcaster_user_login: string;
|
||||
broadcaster_user_name: string;
|
||||
tier: string;
|
||||
is_gift: boolean;
|
||||
end;
|
||||
|
||||
TEventGift = record
|
||||
user_id: string;
|
||||
user_login: string;
|
||||
user_name: string;
|
||||
broadcaster_user_id: string;
|
||||
broadcaster_user_login: string;
|
||||
broadcaster_user_name: string;
|
||||
total: integer;
|
||||
tier: string;
|
||||
cumulative_total: integer; // null if anonymous or not shared by the user
|
||||
is_anonymous: boolean;
|
||||
end;
|
||||
|
||||
TEventRaid = record
|
||||
from_broadcaster_user_id: string;
|
||||
from_broadcaster_user_login: string;
|
||||
from_broadcaster_user_name: string;
|
||||
to_broadcaster_user_id: string;
|
||||
to_broadcaster_user_login: string;
|
||||
to_broadcaster_user_name: string;
|
||||
viewers: integer;
|
||||
end;
|
||||
|
||||
TFollowEvent = record
|
||||
subscription: TSubscriptionPoints;
|
||||
event: TEventFollow;
|
||||
end;
|
||||
|
||||
TSubEvent = record
|
||||
subscription: TSubscriptionPoints;
|
||||
event: TEventSub;
|
||||
end;
|
||||
|
||||
TGiftEvent = record
|
||||
subscription: TSubscriptionPoints;
|
||||
event: TEventGift;
|
||||
end;
|
||||
|
||||
TRaidEvent = record
|
||||
subscription: TSubscriptionPoints;
|
||||
event: TEventRaid;
|
||||
end;
|
||||
|
||||
TBotAppCfg = record
|
||||
TTV_ClientID: string;
|
||||
AI_GigaChat_AC: string;
|
||||
AI_Gigachat_ClientID: string;
|
||||
AI_ChatGPT_Token: string;
|
||||
AI_DeepSeec_Token: string;
|
||||
DA_ClientID: string;
|
||||
DA_Sicret: string;
|
||||
DA_URL: string;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
+4049
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,98 @@
|
||||
unit uSoundManager;
|
||||
|
||||
interface
|
||||
|
||||
uses classes, ShellAPI, bass_simple, windows, System.SysUtils;
|
||||
|
||||
type
|
||||
TSongMachine = class(TObject)
|
||||
|
||||
private
|
||||
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy;
|
||||
procedure PlayPublic(AFileName: string; aVolume: string);
|
||||
procedure PlaySilent(AFileName: string; aVolume: string);
|
||||
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses uGeneral;
|
||||
|
||||
var
|
||||
mp: TBassSimple;
|
||||
|
||||
{ SongMachine }
|
||||
|
||||
constructor TSongMachine.Create;
|
||||
begin
|
||||
mp := TBassSimple.Create(0);
|
||||
end;
|
||||
|
||||
destructor TSongMachine.Destroy;
|
||||
begin
|
||||
mp.FreeStream;
|
||||
mp.Free;
|
||||
end;
|
||||
|
||||
function TimeToSeconds(const timeStr: string): Integer;
|
||||
var
|
||||
minutes, seconds: Integer;
|
||||
begin
|
||||
if TryStrToInt(Copy(timeStr, 1, 2), minutes) and
|
||||
TryStrToInt(Copy(timeStr, 4, 5), seconds) then
|
||||
begin
|
||||
result := minutes * 60 + seconds;
|
||||
end
|
||||
else
|
||||
begin
|
||||
result := -1;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSongMachine.PlaySilent(AFileName: string; aVolume: string);
|
||||
var
|
||||
sec: string;
|
||||
mm: TBassSimple;
|
||||
begin
|
||||
try
|
||||
if not FileExists(AFileName) then
|
||||
begin
|
||||
TTW_Bot.toLog( 'TSongMachine', 'PlayPublic', 'Íåò ôàéëà ' + AFileName,2);
|
||||
exit;
|
||||
end;
|
||||
mm := TBassSimple.Create(0);
|
||||
try
|
||||
mm.OpenFile(AFileName);
|
||||
sec := inttostr(TimeToSeconds(mm.TimeLength) + 1);
|
||||
finally
|
||||
mm.FreeStream;
|
||||
mm.Free;
|
||||
end;
|
||||
ShellExecute(0, 'open', PChar(myConst.SilentPlay),
|
||||
PChar(Format('%s %s "%s"', [sec, aVolume, AFileName])), nil, SW_HIDE);
|
||||
except
|
||||
on e: Exception do
|
||||
TTW_Bot.toLog( 'TSongMachine', 'PlaySilent', e.message,2)
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSongMachine.PlayPublic(AFileName: string; aVolume: string);
|
||||
begin
|
||||
try
|
||||
if not FileExists(AFileName) then
|
||||
begin
|
||||
TTW_Bot.toLog( 'TSongMachine', 'PlayPublic', 'Íåò ôàéëà ' + AFileName,2);
|
||||
exit;
|
||||
end;
|
||||
mp.Volume := strtoint(aVolume);
|
||||
mp.Play(AFileName)
|
||||
except
|
||||
on e: Exception do
|
||||
TTW_Bot.toLog( 'TSongMachine', 'PlaySilent', e.message,2)
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
+212
@@ -0,0 +1,212 @@
|
||||
unit uTTS;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, SysUtils, Classes, MMSystem;
|
||||
|
||||
type
|
||||
TPlayFinishedEvent = procedure(Sender: TObject) of object;
|
||||
|
||||
type
|
||||
TTTS = class
|
||||
private
|
||||
FPiperExePath: string;
|
||||
FVoicesFolder: string;
|
||||
FCurrentModel: string;
|
||||
FOnPlayFinished: TPlayFinishedEvent;
|
||||
procedure DoPlayFinished;
|
||||
function RunProcessCaptureOutput(const Exe, Args, InputText: string; out OutputText: string): Boolean;
|
||||
public
|
||||
constructor Create(const APiperExePath, AVoicesFolder: string);
|
||||
/// <summary>Ñïèñîê ìîäåëåé (ôàéëû .onnx) â ïàïêå voices</summary>
|
||||
function GetModelsList: TStringList;
|
||||
|
||||
/// <summary>Âûáðàòü ìîäåëü îçâó÷èâàíèÿ (èìÿ ôàéëà .onnx)</summary>
|
||||
procedure SetModel(const ModelFileName: string);
|
||||
|
||||
/// <summary>Îçâó÷èòü òåêñò âûáðàííîé ìîäåëüþ</summary>
|
||||
procedure TextToSpeech(const aText: string; isDeleteFile: Boolean = False);
|
||||
|
||||
property OnPlayFinished: TPlayFinishedEvent read FOnPlayFinished write FOnPlayFinished;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
procedure TTTS.DoPlayFinished;
|
||||
begin
|
||||
if Assigned(FOnPlayFinished) then
|
||||
FOnPlayFinished(Self);
|
||||
end;
|
||||
|
||||
constructor TTTS.Create(const APiperExePath, AVoicesFolder: string);
|
||||
begin
|
||||
inherited Create;
|
||||
FPiperExePath := APiperExePath;
|
||||
FVoicesFolder := AVoicesFolder;
|
||||
FCurrentModel := ''; // Ïîêà íå âûáðàíà ìîäåëü
|
||||
end;
|
||||
|
||||
function TTTS.GetModelsList: TStringList;
|
||||
var
|
||||
SR: TSearchRec;
|
||||
begin
|
||||
Result := TStringList.Create;
|
||||
if not DirectoryExists(FVoicesFolder) then Exit;
|
||||
if FindFirst(FVoicesFolder + PathDelim + '*.onnx', faAnyFile, SR) = 0 then
|
||||
begin
|
||||
repeat
|
||||
Result.Add(SR.Name);
|
||||
until FindNext(SR) <> 0;
|
||||
FindClose(SR);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTTS.SetModel(const ModelFileName: string);
|
||||
var
|
||||
FullPath: string;
|
||||
begin
|
||||
FullPath := IncludeTrailingPathDelimiter(FVoicesFolder) + ModelFileName;
|
||||
if not FileExists(FullPath) then
|
||||
raise Exception.CreateFmt('Ìîäåëü íå íàéäåíà: %s', [FullPath]);
|
||||
FCurrentModel := FullPath;
|
||||
end;
|
||||
|
||||
function TTTS.RunProcessCaptureOutput(const Exe, Args, InputText: string; out OutputText: string): Boolean;
|
||||
var
|
||||
SecAttr: TSecurityAttributes;
|
||||
StdOutRead, StdOutWrite: THandle;
|
||||
StdInRead, StdInWrite: THandle;
|
||||
StartupInfo: TStartupInfo;
|
||||
ProcInfo: TProcessInformation;
|
||||
Buffer: array [0..4095] of AnsiChar;
|
||||
BytesRead: Cardinal;
|
||||
ReadOK: BOOL;
|
||||
Stream: TStringStream;
|
||||
InheritHandles: Boolean;
|
||||
BytesWritten: Cardinal;
|
||||
Utf8Bytes: TBytes;
|
||||
begin
|
||||
Result := False;
|
||||
OutputText := '';
|
||||
Stream := TStringStream.Create('', TEncoding.UTF8);
|
||||
try
|
||||
SecAttr.nLength := SizeOf(SecAttr);
|
||||
SecAttr.bInheritHandle := True;
|
||||
SecAttr.lpSecurityDescriptor := nil;
|
||||
|
||||
if not CreatePipe(StdOutRead, StdOutWrite, @SecAttr, 0) then Exit;
|
||||
try
|
||||
if not SetHandleInformation(StdOutRead, HANDLE_FLAG_INHERIT, 0) then Exit;
|
||||
|
||||
if not CreatePipe(StdInRead, StdInWrite, @SecAttr, 0) then Exit;
|
||||
try
|
||||
if not SetHandleInformation(StdInWrite, HANDLE_FLAG_INHERIT, 0) then Exit;
|
||||
|
||||
ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
|
||||
StartupInfo.cb := SizeOf(StartupInfo);
|
||||
StartupInfo.hStdOutput := StdOutWrite;
|
||||
StartupInfo.hStdError := StdOutWrite;
|
||||
StartupInfo.hStdInput := StdInRead;
|
||||
StartupInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
|
||||
StartupInfo.wShowWindow := SW_HIDE;
|
||||
|
||||
InheritHandles := True;
|
||||
|
||||
if not CreateProcess(PChar(Exe), PChar('"' + Exe + '" ' + Args), nil, nil,
|
||||
InheritHandles, CREATE_NO_WINDOW, nil, nil, StartupInfo, ProcInfo) then Exit;
|
||||
|
||||
CloseHandle(StdOutWrite);
|
||||
CloseHandle(StdInRead);
|
||||
|
||||
if InputText <> '' then
|
||||
begin
|
||||
Utf8Bytes := TEncoding.UTF8.GetBytes(InputText + #10);
|
||||
WriteFile(StdInWrite, Utf8Bytes[0], Length(Utf8Bytes), BytesWritten, nil);
|
||||
end;
|
||||
CloseHandle(StdInWrite);
|
||||
|
||||
repeat
|
||||
ReadOK := ReadFile(StdOutRead, Buffer, SizeOf(Buffer), BytesRead, nil);
|
||||
if ReadOK and (BytesRead > 0) then
|
||||
Stream.Write(Buffer, BytesRead);
|
||||
until not ReadOK or (BytesRead = 0);
|
||||
|
||||
WaitForSingleObject(ProcInfo.hProcess, INFINITE);
|
||||
|
||||
CloseHandle(ProcInfo.hThread);
|
||||
CloseHandle(ProcInfo.hProcess);
|
||||
|
||||
OutputText := Stream.DataString;
|
||||
Result := True;
|
||||
finally
|
||||
CloseHandle(StdInWrite);
|
||||
CloseHandle(StdInRead);
|
||||
end;
|
||||
finally
|
||||
CloseHandle(StdOutRead);
|
||||
CloseHandle(StdOutWrite);
|
||||
end;
|
||||
finally
|
||||
Stream.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTTS.TextToSpeech(const aText: string; isDeleteFile: Boolean);
|
||||
var
|
||||
Args, Text, Output, WavFile: string;
|
||||
Lines: TStringList;
|
||||
i: Integer;
|
||||
begin
|
||||
if (FPiperExePath = '') or (FCurrentModel = '') then
|
||||
raise Exception.Create('Piper.exe èëè ìîäåëü íå óêàçàíû.');
|
||||
|
||||
Text := Trim(aText);
|
||||
if Text = '' then Exit;
|
||||
|
||||
// Ôîðìèðóåì àðãóìåíòû - ïóñòü Piper ñîõðàíÿåò wav â òåêóùóþ ïàïêó ñ óíèêàëüíûì èìåíåì
|
||||
Args := '--model "' + FCurrentModel + '" -f o.wav';
|
||||
|
||||
if not RunProcessCaptureOutput(FPiperExePath, Args, Text, Output) then
|
||||
begin
|
||||
|
||||
Exit;
|
||||
end;
|
||||
|
||||
Lines := TStringList.Create;
|
||||
try
|
||||
Lines.Text := Output;
|
||||
WavFile := '';
|
||||
for i := Lines.Count - 1 downto 0 do
|
||||
if (Pos('.wav', LowerCase(Lines[i])) > 0) and FileExists(Trim(Lines[i])) then
|
||||
begin
|
||||
WavFile := Trim(Lines[i]);
|
||||
Break;
|
||||
end;
|
||||
|
||||
if WavFile <> '' then
|
||||
begin
|
||||
// Çàïóñêàåì â îòäåëüíîì ïîòîêå, ÷òîáû îòñëåäèòü îêîí÷àíèå
|
||||
TThread.CreateAnonymousThread(
|
||||
procedure
|
||||
begin
|
||||
PlaySound(PChar(WavFile), 0, SND_FILENAME); // áåç SND_ASYNC — æä¸ì îêîí÷àíèÿ
|
||||
if isDeleteFile then
|
||||
DeleteFile(WavFile);
|
||||
TThread.Synchronize(nil,
|
||||
procedure
|
||||
begin
|
||||
DoPlayFinished;
|
||||
end
|
||||
);
|
||||
end
|
||||
).Start;
|
||||
end;
|
||||
|
||||
finally
|
||||
Lines.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@@ -0,0 +1,293 @@
|
||||
unit uWebServerChat;
|
||||
|
||||
interface
|
||||
|
||||
uses classes, StrUtils, DateUtils, System.JSON, System.Generics.Collections,
|
||||
IdBaseComponent, IdComponent, IdCustomTCPServer, IdContext,
|
||||
IdCustomHTTPServer, uRecords, System.IOUtils, IdGlobalProtocols,
|
||||
IdHTTPServer, System.SysUtils;
|
||||
|
||||
type
|
||||
TTwitchMessage = record
|
||||
Nickname: string;
|
||||
Content: string;
|
||||
Timestamp: TDateTime;
|
||||
TimeMsg: Integer;
|
||||
end;
|
||||
|
||||
type
|
||||
TTTW_Chat = class(TObject)
|
||||
msgStyle: TStyleChat;
|
||||
fFontsList: tstringlist;
|
||||
IdHTTPServer1: TIdHTTPServer;
|
||||
procedure IdHTTPServer1CommandGet(AContext: TIdContext;
|
||||
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
|
||||
private
|
||||
FBColor: string;
|
||||
Messages: TThreadList<TTwitchMessage>;
|
||||
FDeleteByTime: Boolean; // Ðåæèì óäàëåíèÿ: ïî âðåìåíè (true) èëè êîëè÷åñòâó (false)
|
||||
FMaxMsgCount: Integer; // Ìàêñèìàëüíîå êîëè÷åñòâî ñîîáùåíèé
|
||||
function GenerateHTML: string;
|
||||
function GenerateJSON: string;
|
||||
procedure CleanupOldMessages;
|
||||
public
|
||||
constructor Create(FontList: tstrings; aPort:integer; aColor:string);
|
||||
destructor Destroy;
|
||||
procedure addMessage(newMsg: TStyleChat);
|
||||
procedure ActiveServer(aEn: boolean);
|
||||
procedure SetDeleteMode(DeleteByTime: Boolean; MaxMsgCount: Integer); // Óñòàíîâêà ðåæèìà óäàëåíèÿ
|
||||
procedure changeBackground(aColor:string);
|
||||
end;
|
||||
|
||||
var
|
||||
Timestamp2: string;
|
||||
|
||||
implementation
|
||||
|
||||
uses uGeneral;
|
||||
|
||||
{ TTTW_Chat }
|
||||
|
||||
procedure TTTW_Chat.SetDeleteMode(DeleteByTime: Boolean; MaxMsgCount: Integer);
|
||||
begin
|
||||
FDeleteByTime := DeleteByTime;
|
||||
FMaxMsgCount := MaxMsgCount;
|
||||
end;
|
||||
|
||||
procedure TTTW_Chat.ActiveServer(aEn: boolean);
|
||||
begin
|
||||
IdHTTPServer1.Active := aEn;
|
||||
end;
|
||||
|
||||
procedure TTTW_Chat.addMessage(newMsg: TStyleChat);
|
||||
var
|
||||
Msg: TTwitchMessage;
|
||||
begin
|
||||
Msg.Nickname := newMsg.Nick;
|
||||
Msg.Content := newMsg.Context;
|
||||
Msg.Timestamp := now;
|
||||
Msg.TimeMsg := newMsg.TimeMsg;
|
||||
msgStyle := newMsg;
|
||||
with Messages.LockList do
|
||||
try
|
||||
if not FDeleteByTime then
|
||||
begin
|
||||
// Óäàëåíèå ñòàðûõ ñîîáùåíèé ïðè ïðåâûøåíèè ëèìèòà
|
||||
while Count >= FMaxMsgCount do
|
||||
Delete(0);
|
||||
end;
|
||||
Add(Msg);
|
||||
finally
|
||||
Messages.UnlockList;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTTW_Chat.changeBackground(aColor: string);
|
||||
begin
|
||||
FBColor:=aColor;
|
||||
end;
|
||||
|
||||
procedure TTTW_Chat.CleanupOldMessages;
|
||||
var
|
||||
MsgList: TList<TTwitchMessage>;
|
||||
I: integer;
|
||||
ExpiryTime: TDateTime;
|
||||
begin
|
||||
if not FDeleteByTime then
|
||||
Exit; // Âûõîäèì, åñëè óäàëåíèå ïî âðåìåíè îòêëþ÷åíî
|
||||
MsgList := Messages.LockList;
|
||||
try
|
||||
for I := MsgList.Count - 1 downto 0 do
|
||||
begin
|
||||
ExpiryTime := Now - (MsgList[I].TimeMsg / 86400); // Èñïîëüçóåì çíà÷åíèå èç ñîîáùåíèÿ
|
||||
if MsgList[I].Timestamp < ExpiryTime then
|
||||
MsgList.Delete(I);
|
||||
end;
|
||||
finally
|
||||
Messages.UnlockList;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TTTW_Chat.Create(FontList: tstrings; aPort:integer;AColor:string);
|
||||
var
|
||||
I: integer;
|
||||
begin
|
||||
FBColor := AColor;
|
||||
Messages := TThreadList<TTwitchMessage>.Create;
|
||||
IdHTTPServer1 := TIdHTTPServer.Create;
|
||||
IdHTTPServer1.DefaultPort := aPort;
|
||||
IdHTTPServer1.OnCommandGet := IdHTTPServer1CommandGet;
|
||||
fFontsList := tstringlist.Create;
|
||||
for I := 0 to FontList.Count - 1 do
|
||||
fFontsList.Add(FontList[I]);
|
||||
FDeleteByTime := True; // Ïî óìîë÷àíèþ óäàëåíèå ïî âðåìåíè
|
||||
FMaxMsgCount := 100; // Çíà÷åíèå ïî óìîë÷àíèþ
|
||||
|
||||
end;
|
||||
|
||||
destructor TTTW_Chat.Destroy;
|
||||
begin
|
||||
Messages.Free;
|
||||
IdHTTPServer1.Active := false;
|
||||
IdHTTPServer1.Free;
|
||||
fFontsList.Free;
|
||||
end;
|
||||
|
||||
|
||||
function TTTW_Chat.GenerateHTML: string;
|
||||
var
|
||||
I: integer;
|
||||
s, s1: string;
|
||||
DeleteByTimeJS: string;
|
||||
begin
|
||||
DeleteByTimeJS := LowerCase(BoolToStr(FDeleteByTime)); // Ïðåîáðàçóåì áóëåâî çíà÷åíèå â ñòðîêó 'true' èëè 'false'
|
||||
s := 'body { background: ' + FBColor + '; }' + #13#10;
|
||||
for I := 41 to fFontsList.Count - 1 do
|
||||
begin
|
||||
s1 := StringReplace(fFontsList[I], '.ttf', '', [rfReplaceAll]);
|
||||
s := s + '@font-face { font-family: ''' + s1 + '''; src: url(fonts/' + fFontsList[I] + '); }' + #13#10;
|
||||
end;
|
||||
|
||||
Result := '<!DOCTYPE html><html><head>' +
|
||||
'<meta http-equiv="Cache-Control" content="no-cache, no-store, must-revalidate">' +
|
||||
'<meta http-equiv="Pragma" content="no-cache"><meta http-equiv="Expires" content="0">' +
|
||||
'<title>Messages</title><style>' + s +
|
||||
'.message { margin:5px; border-radius:5px; transition: opacity 1s linear; display: flex; align-items: center; }' +
|
||||
'.message-icon { width: 1.5em; height: 1.5em; margin-right: 0.5em; }' + // Ñòèëü äëÿ èêîíêè
|
||||
'</style><script>' +
|
||||
'let existingMessages = new Map(); let fetching = false;' +
|
||||
'function fetchMessages() {' +
|
||||
' if (fetching) return; fetching = true;' +
|
||||
' fetch("/messages").then(response => response.json()).then(data => {' +
|
||||
' const container = document.getElementById("messages");' +
|
||||
' const newIds = new Set();' +
|
||||
' data.forEach(msg => {' +
|
||||
' const msgId = "msg-" + msg.timestamp;' +
|
||||
' newIds.add(msgId);' +
|
||||
' if (!existingMessages.has(msgId)) {' +
|
||||
' const div = document.createElement("div");' +
|
||||
' div.className = "message";' +
|
||||
' div.id = msgId;' +
|
||||
' div.style = `background-color:${msg.color}; font-family:${msg.family}; ' +
|
||||
' padding:${msg.padding}px; border: ${msg.sizeBorder}px solid ${msg.colorBorder}; ' +
|
||||
' color:${msg.colorText}; font-size:${msg.fontSize}px;`;' +
|
||||
' div.innerHTML = `' +
|
||||
// ' <img src="${msg.iconUrl}" class="message-icon">' + // Äîáàâëåíà èêîíêà
|
||||
' <div><b>${msg.nickname}:</b> ${msg.content}</div>`;' +
|
||||
' div.style.opacity = "1";' +
|
||||
' container.appendChild(div);' +
|
||||
' existingMessages.set(msgId, div);' +
|
||||
' if (deleteByTime) {' + // Óñòàíàâëèâàåì òàéìåð òîëüêî åñëè âêëþ÷åíî óäàëåíèå ïî âðåìåíè
|
||||
' setTimeout(() => {' +
|
||||
' div.style.opacity = "0";' +
|
||||
' setTimeout(() => { div.remove(); existingMessages.delete(msgId); }, 1000);' +
|
||||
' }, msg.timeMsg * 1000);' +
|
||||
' }' +
|
||||
' }' +
|
||||
' });' +
|
||||
' existingMessages.forEach((div, msgId) => {' +
|
||||
' if (!newIds.has(msgId)) { div.remove(); existingMessages.delete(msgId); }' +
|
||||
' });' +
|
||||
' }).finally(() => { fetching = false; });' +
|
||||
'}' +
|
||||
'setInterval(fetchMessages, 500); fetchMessages();' +
|
||||
'</script></head><body><div id="messages"></div></body></html>';
|
||||
end;
|
||||
|
||||
function TTTW_Chat.GenerateJSON: string;
|
||||
var
|
||||
MsgList: TList<TTwitchMessage>;
|
||||
Msg: TTwitchMessage;
|
||||
JSONArray: TJSONArray;
|
||||
JSONObject: TJSONObject;
|
||||
begin
|
||||
JSONArray := TJSONArray.Create;
|
||||
try
|
||||
MsgList := Messages.LockList;
|
||||
try
|
||||
for Msg in MsgList do
|
||||
begin
|
||||
JSONObject := TJSONObject.Create;
|
||||
JSONObject.AddPair('nickname', Msg.Nickname);
|
||||
JSONObject.AddPair('content', Msg.Content);
|
||||
JSONObject.AddPair('timestamp',
|
||||
TJSONNumber.Create(DateTimeToUnix(Msg.Timestamp)));
|
||||
JSONObject.AddPair('color', msgStyle.BlockColor); // Îñòàâëÿåì HEX-öâåò
|
||||
JSONObject.AddPair('bcolor', msgStyle.BColor); // Îñòàâëÿåì HEX-öâåò
|
||||
JSONObject.AddPair('fontSize', TJSONNumber.Create(msgStyle.FontSize));
|
||||
JSONObject.AddPair('colorText', msgStyle.FontColor);
|
||||
|
||||
JSONObject.AddPair('colorBorder', msgStyle.BorderColor);
|
||||
JSONObject.AddPair('sizeBorder',
|
||||
TJSONNumber.Create(msgStyle.BorderSize));
|
||||
JSONObject.AddPair('padding', TJSONNumber.Create(msgStyle.BorderSize));
|
||||
JSONObject.AddPair('family', msgStyle.FontFamily);
|
||||
JSONObject.AddPair('timeMsg', TJSONNumber.Create(Msg.TimeMsg)); // Äîáàâëÿåì âðåìÿ
|
||||
// Óïðàâëÿåò òîëüêî áëîêîì, íå òåêñòîì
|
||||
JSONArray.Add(JSONObject);
|
||||
end;
|
||||
finally
|
||||
Messages.UnlockList;
|
||||
end;
|
||||
Result := JSONArray.ToString;
|
||||
finally
|
||||
JSONArray.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTTW_Chat.IdHTTPServer1CommandGet(AContext: TIdContext;
|
||||
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
|
||||
var
|
||||
HtmlContent: string;
|
||||
FontFileName: string;
|
||||
FontFilePath: string;
|
||||
MIMEType: string;
|
||||
FS: TFileStream;
|
||||
begin
|
||||
CleanupOldMessages;
|
||||
|
||||
if ARequestInfo.Document = '/messages' then
|
||||
begin
|
||||
AResponseInfo.ContentType := 'application/json; charset=utf-8';
|
||||
AResponseInfo.ContentText := GenerateJSON;
|
||||
end
|
||||
else if Pos('/fonts/', ARequestInfo.Document) = 1 then
|
||||
// Ïðîâåðÿåì çàïðîñ ê øðèôòàì
|
||||
begin
|
||||
// Èçâëåêàåì èìÿ ôàéëà èç URL
|
||||
FontFileName := TPath.GetFileName(ARequestInfo.Document);
|
||||
|
||||
// Ôîðìèðóåì ïîëíûé ïóòü ê ôàéëó (ïàïêà fonts äîëæíà áûòü ðÿäîì ñ èñïîëíÿåìûì ôàéëîì)
|
||||
FontFilePath := myConst.fontsPath + FontFileName;
|
||||
|
||||
// Ïðîâåðÿåì ñóùåñòâîâàíèå ôàéëà
|
||||
if FileExists(FontFilePath) then
|
||||
begin
|
||||
|
||||
MIMEType := 'font/ttf';
|
||||
|
||||
// Íàñòðàèâàåì îòâåò
|
||||
AResponseInfo.ContentType := MIMEType;
|
||||
try
|
||||
FS := TFileStream.Create(FontFilePath, fmOpenRead + fmShareDenyWrite);
|
||||
AResponseInfo.ContentStream := FS;
|
||||
AResponseInfo.ResponseNo := 200;
|
||||
except
|
||||
FS.Free;
|
||||
AResponseInfo.ResponseNo := 500;
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
AResponseInfo.CacheControl := 'no-cache, no-store, must-revalidate';
|
||||
AResponseInfo.Pragma := 'no-cache';
|
||||
AResponseInfo.Expires := 0;
|
||||
Timestamp2 := IntToStr(DateTimeToUnix(now));
|
||||
AResponseInfo.ContentType := 'text/html; charset=utf-8';
|
||||
AResponseInfo.ContentText := GenerateHTML;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user