652 lines
18 KiB
Plaintext
652 lines
18 KiB
Plaintext
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('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>: ' + 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;
|
||
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
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 + ')';
|
||
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> (<28><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>)
|
||
//Query.Prepare;
|
||
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
Query.Params.ArraySize := Length(Items);
|
||
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
FConnection.StartTransaction;
|
||
try
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
FConnection.ExecSQL('DELETE FROM ' + TableName);
|
||
|
||
i := 0;
|
||
for Rec in Items do
|
||
begin
|
||
for Field in Fields do
|
||
begin
|
||
Value := Field.GetValue(@Rec);
|
||
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
Param := Query.FindParam(Field.Name);
|
||
if not Assigned(Param) then
|
||
raise Exception.CreateFmt('Parameter "%s" not found in query', [Field.Name]);
|
||
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> NULL-<2D><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
if Value.IsEmpty then
|
||
begin
|
||
Param.Clear(i);
|
||
end
|
||
else
|
||
begin
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD>
|
||
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;
|
||
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
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.
|