You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
2935 lines
90 KiB
Plaintext
2935 lines
90 KiB
Plaintext
{
|
|
This file is part of R&Q.
|
|
Under same license
|
|
}
|
|
unit SQLiteDB;
|
|
{$I RnQConfig.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Classes, Forms, Dialogs, Themes, Types, SysUtils, StrUtils, DateUtils, JSON, Generics.Collections, System.SyncObjs, System.IniFiles,
|
|
Variants, Data.DB, FireDAC.Comp.Client, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Phys.SQLite, FireDAC.Phys.SQLiteDef,
|
|
FireDAC.Phys.SQLiteWrapper, FireDAC.Phys.SQLiteWrapper.Stat, FireDAC.DApt, FireDAC.Stan.Option, FireDAC.Stan.Def, FireDAC.Stan.Async,
|
|
FireDAC.Stan.Intf, FireDAC.ConsoleUI.Wait{, FireDAC.Moni.FlatFile},
|
|
GlobalLib, GroupsLib, OutboxLib, UINListLib, RnQNet, RnQMacros, Events, ICQCommon, ICQContacts, Stickers, RnQPrefsLib;
|
|
|
|
type
|
|
TSecurityAction = (SA_CHECK, SA_ENCRYPT, SA_DECRYPT, SA_CHANGEPASS);
|
|
|
|
TSQLDatabase = class
|
|
private
|
|
sql: TFDConnection;
|
|
sqlcontains: TFDSQLiteFunction;
|
|
sqlsec: TFDSQLiteSecurity;
|
|
sqlvalid: TFDSQLiteValidate;
|
|
procedure ContainsFunc(AFunc: TSQLiteFunctionInstance; AInputs: TSQLiteInputs; AOutput: TSQLiteOutput; var AUserData: TObject);
|
|
procedure CreateTable(const Schema: String; const Index: String = '');
|
|
function OpenTable(const Table: String): Boolean;
|
|
function RecordToObject |
|
function QueryToArray |
|
|
|
// Conversations
|
|
procedure MigrateConvTable;
|
|
procedure OpenConvTable;
|
|
function RecordToEvent(var qry: TFDQuery): Thevent;
|
|
|
|
// Stickers
|
|
procedure OpenStickersTable;
|
|
procedure MigrateStickersTable;
|
|
function RecordToSticker(var qry: TFDQuery): TStickerPack;
|
|
|
|
// Server history
|
|
procedure OpenSrvHistTable;
|
|
procedure MigrateSrvHistTable;
|
|
|
|
// Patches
|
|
procedure OpenPatchesTable;
|
|
|
|
// Reactions
|
|
procedure OpenReactionsTable;
|
|
function RecordToReactions(var qry: TFDQuery): TReactions;
|
|
|
|
// Contacts
|
|
procedure OpenContactsTable;
|
|
function RecordToContact(var qry: TFDQuery): TICQContact;
|
|
|
|
// Groups
|
|
procedure OpenGroupsTable;
|
|
function RecordToGroup(var qry: TFDQuery): TGroup;
|
|
|
|
// Proxies
|
|
procedure OpenProxiesTable;
|
|
function RecordToProxy(var qry: TFDQuery): TProxy;
|
|
|
|
// Macros
|
|
procedure OpenMacrosTable;
|
|
function RecordToMacro(var qry: TFDQuery): TMacro;
|
|
|
|
// XStatuses
|
|
procedure OpenXStatusesTable;
|
|
function RecordToXStatus(var qry: TFDQuery): TXStatStr;
|
|
|
|
// SpamQuests
|
|
procedure OpenSpamQuestsTable;
|
|
function RecordToSpamQuest(var qry: TFDQuery): TQuestAns;
|
|
|
|
// UINLists
|
|
procedure OpenUINListsTable;
|
|
function RecordToUINList(var qry: TFDQuery): TUINList;
|
|
|
|
// Inbox
|
|
procedure OpenInboxTable;
|
|
|
|
//Outbox
|
|
procedure OpenOutboxTable;
|
|
function RecordToOEvent(var qry: TFDQuery): TOEvent;
|
|
|
|
// Configuration
|
|
procedure OpenConfigTable;
|
|
function RecordToPrefElement(var qry: TFDQuery): TPrefElementRec;
|
|
public
|
|
NeedToConvertHistory: Boolean;
|
|
NeedToConvertDB: Boolean;
|
|
|
|
function Connect(Password: String): Boolean;
|
|
function Connected: Boolean;
|
|
procedure Disconnect;
|
|
function CheckIntegrity: Boolean;
|
|
function ManageSecurity(Action: TSecurityAction; Password: String = ''): Boolean;
|
|
|
|
// Conversations
|
|
procedure ConvertHistory;
|
|
procedure UpdateProgress(Sender: TObject; TickCount: Cardinal; var Reset: Boolean);
|
|
procedure DeleteChat(const chat: TUID);
|
|
procedure WriteEvent(const chat: TUID; ev: Thevent; table: String = '');
|
|
procedure WritePatch(const Chat: TUID; MsgID: TMsgID; PatchType: String);
|
|
procedure PatchEvent(const chat: TUID; ev: Thevent);
|
|
procedure WriteMsgIDs(const chat: TUID; ReqID, MsgID: TMsgID; const WID: RawByteString);
|
|
procedure WriteMsgFlags(const chat: TUID; MsgID: TMsgID; Flags: Integer);
|
|
procedure DeleteByTimeRange(const chat: TUID; fromTime, toTime: TDateTime);
|
|
procedure DeleteByMsgID(const Chat: TUID; MsgID: TMsgID);
|
|
procedure DeleteBySender(const chat, sender: TUID);
|
|
function GetExistingChats: TUIDS;
|
|
function ChatExists(const chat: TUID): Boolean;
|
|
function GetAllEvents(const chat: TUID): Thevents;
|
|
function GetLastMulti(const chat: TUID; offset, cnt: Integer; var noMoreMessages: Boolean): Thevents;
|
|
function GetLastSingle(const chat: TUID; cnt: Integer): Thevent;
|
|
function GetByTimeRange(const chat: TUID; fromTime, toTime: TDateTime; var noMoreMessages: Boolean; toInclusive: Boolean = True): Thevents;
|
|
function GetByTime(const chat: TUID; thetime: TDateTime): Thevent;
|
|
function GetByRowID(const chat: TUID; RowID: Integer): Thevent;
|
|
function GetByMsgID(const chat: TUID; MsgID: TMsgID; Recent: Boolean = True): Thevent;
|
|
function GetByWID(const chat: TUID; const wid: String): Thevent;
|
|
function GetBySender(const chat, sender: TUID): Thevents;
|
|
function GetEventCount(const chat: TUID): Integer;
|
|
function GetEventCounts: TDictionary |
|
function GetPatches(MsgID: TMsgID): TArray |
|
function DataSearch(const chat: TUID; const txt: String; caseSensitive: Boolean = False): Thevents;
|
|
|
|
// Stickers
|
|
procedure ClearStickerPacks;
|
|
procedure AddStickerPack(const StickerPack: TStickerPack);
|
|
procedure ChangeStickerPackStatus(const PackId: String; Status: Boolean);
|
|
function GetStickerPackContent(const PackId: String): TArray |
|
function GetStickerPackKeywords(const PackId: String): TArray |
|
//procedure SaveStickerPackContent(const PackId: String; Content: TArray |
|
function GetStickerPacksCount: Integer;
|
|
function GetStickerPacks(ActiveOnly: Boolean = False): TStickerPacks;
|
|
|
|
// Patches
|
|
procedure UpdateLastMsg(const UID: TUID; LastMsgId: TMsgID; PatchVersion: String);
|
|
procedure UpdateLastRead(const UID: TUID; LastRead: TMsgID);
|
|
function GetHistDlg(const UID: TUID): TSrvHist;
|
|
|
|
// Contacts
|
|
procedure LoadContactsDB;
|
|
procedure SaveContactsDB;
|
|
|
|
// Groups
|
|
procedure LoadGroups;
|
|
procedure SaveGroups;
|
|
|
|
// Proxies
|
|
procedure LoadProxies;
|
|
procedure SaveProxies;
|
|
|
|
// Macros
|
|
procedure LoadMacros;
|
|
procedure SaveMacros;
|
|
|
|
// XStatuses
|
|
procedure LoadXStatuses;
|
|
procedure SaveXStatuses;
|
|
|
|
// SpamQuests
|
|
procedure LoadSpamQuests;
|
|
procedure SaveSpamQuests;
|
|
|
|
// UINLists
|
|
procedure LoadUINLists;
|
|
procedure SaveUINLists;
|
|
|
|
// Inbox
|
|
procedure LoadInbox;
|
|
procedure SaveInbox;
|
|
|
|
// Outbox
|
|
procedure LoadOutbox;
|
|
procedure SaveOutbox;
|
|
|
|
// Configuration
|
|
procedure LoadConfig;
|
|
procedure SaveConfig;
|
|
|
|
// Reactions
|
|
procedure LoadReactions;
|
|
procedure SaveReactions;
|
|
end;
|
|
|
|
TCUID = record
|
|
UID: TUID;
|
|
Pos: Integer;
|
|
end;
|
|
|
|
const
|
|
dbConv: String = 'Conversations';
|
|
dbStickers: String = 'Stickers';
|
|
dbPatches: String = 'Patches';
|
|
dbSrvHist: String = 'ServerHistory';
|
|
dbReactions: String = 'Reactions';
|
|
dbContacts: String = 'Contacts';
|
|
dbGroups: String = 'Groups';
|
|
dbProxies: String = 'Proxies';
|
|
dbMacros: String = 'Macros';
|
|
dbXStatuses: String = 'XStatuses';
|
|
dbSpamQuests: String = 'SpamQuests';
|
|
dbUINLists: String = 'UINLists';
|
|
dbInbox: String = 'Inbox';
|
|
dbOutbox: String = 'Outbox';
|
|
dbConfig: String = 'Configuration';
|
|
|
|
var
|
|
SQLDB: TSQLDatabase;
|
|
sqldrv: TFDPhysSQLiteDriverLink;
|
|
// trace: TFDMoniFlatFileClientLink;
|
|
taskDlg: TTaskDialog;
|
|
cUID: TCUID;
|
|
|
|
implementation
|
|
|
|
uses
|
|
SciterLib, UtilLib, IOUtils, history, Base64,
|
|
RDGlobal, RDFileUtil, RDUtils, RnQGlobal, RnQDialogs, RnQLangs, RnQCrypt, RQLog, ICQSession, ICQConsts, Nodes;
|
|
|
|
var
|
|
FloatFormat: TFormatSettings;
|
|
|
|
procedure TSQLDatabase.ContainsFunc(AFunc: TSQLiteFunctionInstance; AInputs: TSQLiteInputs; AOutput: TSQLiteOutput; var AUserData: TObject);
|
|
var
|
|
CaseSensitive: Boolean;
|
|
Str1, Str2: String;
|
|
begin
|
|
if AInputs.Count < 2 then
|
|
AOutput.AsBoolean := False;
|
|
|
|
if AInputs.Count < 3 then
|
|
CaseSensitive := False
|
|
else
|
|
CaseSensitive := AInputs[2].AsBoolean;
|
|
|
|
Str1 := AInputs[0].AsString;
|
|
Str2 := AInputs[1].AsString;
|
|
|
|
if CaseSensitive then
|
|
AOutput.AsBoolean := ContainsStr(Str1, Str2)
|
|
else
|
|
AOutput.AsBoolean := ContainsText(Str1, Str2);
|
|
end;
|
|
|
|
function TSQLDatabase.Connect(Password: String): Boolean;
|
|
var
|
|
params: TFDPhysSQLiteConnectionDefParams;
|
|
begin
|
|
Result := False;
|
|
|
|
// FDManager.Active := True;
|
|
|
|
sqlcontains := TFDSQLiteFunction.Create(nil);
|
|
sqlcontains.DriverLink := sqldrv;
|
|
sqlcontains.FunctionName := 'contains';
|
|
sqlcontains.ArgumentsCount := 3;
|
|
sqlcontains.OnCalculate := ContainsFunc;
|
|
sqlcontains.Active := True;
|
|
|
|
// trace := TFDMoniFlatFileClientLink.Create(nil);
|
|
// trace.FileName := 'D:\Site\trace';
|
|
// trace.FileEncoding := ecUTF8;
|
|
// trace.Tracing := True;
|
|
|
|
try
|
|
sql := TFDConnection.Create(nil);
|
|
sql.DriverName := 'SQLite';
|
|
params := TFDPhysSQLiteConnectionDefParams(sql.Params);
|
|
params.Clear;
|
|
params.LockingMode := lmExclusive;
|
|
params.DriverID := 'SQLite';
|
|
params.Database := AccPath + accountFilename;
|
|
params.OpenMode := omCreateUTF8;
|
|
params.JournalMode := jmWAL;
|
|
params.LockingMode := lmNormal;
|
|
params.Synchronous := snFull;
|
|
params.GUIDFormat := guiBinary;
|
|
params.DateTimeFormat := dtfBinary;
|
|
if not (Password = '') then
|
|
params.Password := Password;
|
|
// params.MonitorBy := mbFlatFile;
|
|
// params.SQLiteAdvanced := 'page_size = 4096';
|
|
sql.FormatOptions.QuoteIdentifiers := True;
|
|
sql.FormatOptions.StrsTrim := False;
|
|
sql.FetchOptions.Mode := fmAll;
|
|
sql.FetchOptions.Items := [fiBlobs, fiDetails, fiMeta];
|
|
sql.UpdateOptions.LockWait := True;
|
|
sql.TxOptions.AutoCommit := True;
|
|
sql.TxOptions.Isolation := xiReadCommitted;
|
|
sql.ResourceOptions.CmdExecMode := amNonBlocking;
|
|
sql.ResourceOptions.SilentMode := True;
|
|
sql.Connected := True;
|
|
except
|
|
Exit;
|
|
end;
|
|
|
|
// WAL checkpoint at 512KB (128 * 4096 bytes page)
|
|
if Assigned(sql.ConnectionIntf.CliObj) then
|
|
TSQLiteDatabase(sql.ConnectionIntf.CliObj).AutoCheckpoint := 128;
|
|
// OutputDebugString(PChar(TSQLiteDatabase(sql.ConnectionIntf.CliObj).CharacterSet));
|
|
|
|
OpenConfigTable;
|
|
OpenContactsTable;
|
|
OpenGroupsTable;
|
|
OpenProxiesTable;
|
|
OpenMacrosTable;
|
|
OpenXStatusesTable;
|
|
OpenSpamQuestsTable;
|
|
OpenUINListsTable;
|
|
OpenInboxTable;
|
|
OpenOutboxTable;
|
|
OpenConvTable;
|
|
OpenStickersTable;
|
|
OpenPatchesTable;
|
|
OpenSrvHistTable;
|
|
OpenReactionsTable;
|
|
|
|
Result := True;
|
|
end;
|
|
|
|
function TSQLDatabase.Connected: Boolean;
|
|
begin
|
|
Result := Assigned(sql) and sql.Connected;
|
|
end;
|
|
|
|
procedure TSQLDatabase.Disconnect;
|
|
begin
|
|
if Assigned(sql) then
|
|
begin
|
|
if sql.Connected then
|
|
try
|
|
sql.Connected := False;
|
|
if optimizeDB then
|
|
begin
|
|
sqlvalid := TFDSQLiteValidate.Create(nil);
|
|
sqlvalid.DriverLink := sqldrv;
|
|
sqlvalid.Password := AccPass;
|
|
sqlvalid.Sweep; // VACUUM
|
|
sqlvalid.Free;
|
|
end;
|
|
except end;
|
|
FreeAndNil(sql);
|
|
end;
|
|
|
|
if Assigned(sqlcontains) then
|
|
FreeAndNil(sqlcontains);
|
|
end;
|
|
|
|
function TSQLDatabase.CheckIntegrity: Boolean;
|
|
begin
|
|
try
|
|
sqlvalid := TFDSQLiteValidate.Create(nil);
|
|
sqlvalid.DriverLink := sqldrv;
|
|
sqlvalid.Database := AccPath + accountFilename;
|
|
sqlvalid.Password := AccPass;
|
|
sqlvalid.Options := []; // Quick check, do not validate indexes
|
|
Result := sqlvalid.CheckOnly;
|
|
sqlvalid.Free;
|
|
|
|
if not Result then
|
|
messageDlg(GetTranslation('Account database integrity validation failed, so it connot be encrypted or decrypted right now'), mtError, [mbOK])
|
|
except
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
function TSQLDatabase.ManageSecurity(Action: TSecurityAction; Password: String = ''): Boolean;
|
|
|
|
function IsEncrypted: Boolean;
|
|
begin
|
|
try
|
|
Result := not (sqlsec.CheckEncryption = ' |
|
except
|
|
on E: Exception do
|
|
Result := not E.Message.Contains('not encrypted');
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Result := False;
|
|
sqlsec := TFDSQLiteSecurity.Create(nil);
|
|
sqlsec.DriverLink := sqldrv;
|
|
sqlsec.Options := [soSetLargeCache];
|
|
sqlsec.Database := AccPath + accountFilename;
|
|
|
|
if Action = SA_CHECK then
|
|
begin
|
|
sqlsec.Password := AccPass;
|
|
Result := IsEncrypted;
|
|
sqlsec.Free;
|
|
Exit;
|
|
end;
|
|
|
|
if not CheckIntegrity then
|
|
Exit;
|
|
Disconnect;
|
|
|
|
try case Action of
|
|
SA_ENCRYPT:
|
|
begin
|
|
sqlsec.Password := Password;
|
|
sqlsec.SetPassword;
|
|
Result := True;
|
|
end;
|
|
SA_DECRYPT:
|
|
begin
|
|
sqlsec.Password := Password;
|
|
sqlsec.RemovePassword;
|
|
Password := '';
|
|
Result := True;
|
|
end;
|
|
SA_CHANGEPASS:
|
|
begin
|
|
sqlsec.Password := AccPass;
|
|
sqlsec.ToPassword := Password;
|
|
sqlsec.ChangePassword;
|
|
Result := True;
|
|
end;
|
|
end except end;
|
|
|
|
Connect(Password);
|
|
|
|
sqlsec.Free;
|
|
end;
|
|
|
|
procedure TSQLDatabase.CreateTable(const Schema: String; const Index: String = '');
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
sql.StartTransaction;
|
|
try
|
|
qry.ExecSQL(Schema);
|
|
if not (Index = '') then
|
|
qry.ExecSQL(Index);
|
|
sql.Commit;
|
|
except
|
|
sql.Rollback;
|
|
end;
|
|
qry.Free;
|
|
end;
|
|
|
|
function TSQLDatabase.OpenTable(const Table: String): Boolean;
|
|
var
|
|
MIQ: TFDMetaInfoQuery;
|
|
begin
|
|
Result := False;
|
|
MIQ := TFDMetaInfoQuery.Create(sql);
|
|
MIQ.Connection := sql;
|
|
MIQ.MetaInfoKind := mkTables;
|
|
if MIQ.OpenOrExecute and (MIQ.RecordCount > 0) then
|
|
begin
|
|
MIQ.First;
|
|
while not MIQ.Eof do
|
|
begin
|
|
if MIQ.FieldByName('TABLE_NAME').AsString = Table then
|
|
begin
|
|
Result := True;
|
|
Break;
|
|
end;
|
|
MIQ.Next;
|
|
end;
|
|
end;
|
|
MIQ.Free;
|
|
end;
|
|
|
|
function TSQLDatabase.RecordToObject |
|
begin
|
|
if TypeInfo(T) = TypeInfo(Thevent) then
|
|
Phevent(@Result)^ := RecordToEvent(qry)
|
|
else if TypeInfo(T) = TypeInfo(TStickerPack) then
|
|
PStickerPack(@Result)^ := RecordToSticker(qry)
|
|
else if TypeInfo(T) = TypeInfo(TICQContact) then
|
|
PICQContact(@Result)^ := RecordToContact(qry)
|
|
else if TypeInfo(T) = TypeInfo(TGroup) then
|
|
PGroup(@Result)^ := RecordToGroup(qry)
|
|
else if TypeInfo(T) = TypeInfo(TProxy) then
|
|
PProxy(@Result)^ := RecordToProxy(qry)
|
|
else if TypeInfo(T) = TypeInfo(TMacro) then
|
|
PMacro(@Result)^ := RecordToMacro(qry)
|
|
else if TypeInfo(T) = TypeInfo(TXStatStr) then
|
|
PXStatStr(@Result)^ := RecordToXStatus(qry)
|
|
else if TypeInfo(T) = TypeInfo(TQuestAns) then
|
|
PQuestAns(@Result)^ := RecordToSpamQuest(qry)
|
|
else if TypeInfo(T) = TypeInfo(TUINList) then
|
|
PUINList(@Result)^ := RecordToUINList(qry)
|
|
else if TypeInfo(T) = TypeInfo(TOEvent) then
|
|
POEvent(@Result)^ := RecordToOEvent(qry)
|
|
else if TypeInfo(T) = TypeInfo(TPrefElementRec) then
|
|
PPrefElementRec(@Result)^ := RecordToPrefElement(qry)
|
|
else if TypeInfo(T) = TypeInfo(TReactions) then
|
|
PReactions(@Result)^ := RecordToReactions(qry)
|
|
else
|
|
OutputDebugString(PChar('Cannot convert query result to object!'));
|
|
end;
|
|
|
|
function TSQLDatabase.QueryToArray |
|
var
|
|
c: Integer;
|
|
begin
|
|
Result := False;
|
|
if not qry.OpenOrExecute or (qry.RecordCount = 0) then
|
|
Exit;
|
|
Result := True;
|
|
|
|
SetLength(arr, qry.RecordCount);
|
|
c := 0;
|
|
|
|
if inverse then
|
|
begin
|
|
qry.Last;
|
|
while (not qry.Bof) do
|
|
begin
|
|
arr[c] := RecordToObject |
|
Inc(c);
|
|
qry.Prior;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
qry.First;
|
|
while not qry.Eof do
|
|
begin
|
|
arr[c] := RecordToObject |
|
Inc(c);
|
|
qry.Next;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function GetConvSchema(const Table: String): String;
|
|
begin
|
|
Result := 'CREATE TABLE IF NOT EXISTS "' + Table + '" ('
|
|
+ '"When" DATETIME NOT NULL,'
|
|
+ '"Kind" INTEGER NOT NULL,'
|
|
+ '"Chat" TEXT NOT NULL,'
|
|
+ '"Who" TEXT NOT NULL,'
|
|
+ '"Text" TEXT,'
|
|
+ '"Binary" BLOB,'
|
|
+ '"Flags" INTEGER DEFAULT 0,'
|
|
+ '"Out" INTEGER DEFAULT 0,'
|
|
+ '"WID" GUID,'
|
|
+ '"MsgID" UINT64);';
|
|
end;
|
|
|
|
function GetConvIndex: String;
|
|
begin
|
|
Result := 'CREATE INDEX IF NOT EXISTS "mainindex" ON "' + dbConv + '" ("Chat", "When");';
|
|
end;
|
|
|
|
procedure TSQLDatabase.OpenConvTable;
|
|
begin
|
|
NeedToConvertHistory := False;
|
|
if not OpenTable(dbConv) then
|
|
begin
|
|
CreateTable(GetConvSchema(dbConv), GetConvIndex);
|
|
NeedToConvertHistory := True;
|
|
end else
|
|
MigrateConvTable;
|
|
end;
|
|
|
|
procedure TSQLDatabase.MigrateConvTable;
|
|
var
|
|
qry: TFDQuery;
|
|
MIQ: TFDMetaInfoQuery;
|
|
MigrateMsgID: Boolean;
|
|
begin
|
|
MigrateMsgID := false;
|
|
MIQ := TFDMetaInfoQuery.Create(sql);
|
|
MIQ.Connection := sql;
|
|
MIQ.MetaInfoKind := mkTableFields;
|
|
MIQ.ObjectName := dbConv;
|
|
if MIQ.OpenOrExecute and (MIQ.RecordCount > 0) then
|
|
begin
|
|
MIQ.First;
|
|
while not MIQ.Eof do
|
|
begin
|
|
if MIQ.Fields.FieldByName('COLUMN_NAME').AsWideString = 'MsgID' then
|
|
if MIQ.Fields.FieldByName('COLUMN_DATATYPE').AsInteger = Integer(dtInt32) then
|
|
MigrateMsgID := True;
|
|
MIQ.Next;
|
|
end;
|
|
end;
|
|
MIQ.Free;
|
|
|
|
if MigrateMsgID then
|
|
begin
|
|
OutputDebugString(PChar('Changing MsgID type from INTEGER to UINT64'));
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
sql.StartTransaction;
|
|
try
|
|
qry.ExecSQL('ALTER TABLE "' + dbConv + '" RENAME TO "Temp";');
|
|
qry.ExecSQL('DROP INDEX IF EXISTS "mainindex";');
|
|
qry.ExecSQL(GetConvSchema(dbConv));
|
|
qry.ExecSQL(GetConvIndex);
|
|
qry.ExecSQL('INSERT INTO "' + dbConv + '" SELECT * FROM "Temp";');
|
|
qry.ExecSQL('DROP TABLE "Temp";');
|
|
sql.Commit;
|
|
except
|
|
sql.Rollback;
|
|
end;
|
|
qry.ExecSQL('VACUUM;');
|
|
qry.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TSQLDatabase.DeleteChat(const chat: TUID);
|
|
begin
|
|
sql.ExecSQL('DELETE FROM "' + dbConv + '" WHERE "Chat" = ' + AnsiQuotedStr(chat, ''''), True);
|
|
end;
|
|
|
|
procedure TSQLDatabase.WriteEvent(const chat: TUID; ev: Thevent; Table: String = '');
|
|
var
|
|
qry: TFDQuery;
|
|
txt: String;
|
|
bin: TBytes;
|
|
begin
|
|
if Table = '' then
|
|
Table := dbConv;
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT * FROM "' + Table + '" WHERE "Chat" = :chat AND "When" = :when; LIMIT 1';
|
|
qry.ParamByName('chat').AsString := chat;
|
|
qry.ParamByName('when').AsDateTime := ev.when;
|
|
if qry.OpenOrExecute and (qry.RecordCount > 0) then
|
|
ev.when := IncMillisecond(ev.when);
|
|
qry.Free;
|
|
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
|
|
qry.SQL.Add('INSERT INTO "' + Table + '" VALUES (:when, :kind, :chat, :who, :text, :binary, :flags, :out, :wid, :msgid)');
|
|
|
|
qry.Params[0].DataType := TFieldType.ftDateTime;
|
|
qry.Params[1].DataType := TFieldType.ftInteger;
|
|
qry.Params[2].DataType := TFieldType.ftString;
|
|
qry.Params[3].DataType := TFieldType.ftString;
|
|
qry.Params[4].DataType := TFieldType.ftWideString;
|
|
qry.Params[5].DataType := TFieldType.ftBlob;
|
|
qry.Params[6].DataType := TFieldType.ftInteger;
|
|
qry.Params[7].DataType := TFieldType.ftInteger;
|
|
qry.Params[8].DataType := TFieldType.ftGuid;
|
|
qry.Params[9].DataType := TFieldType.ftLargeint;
|
|
|
|
qry.ParamByName('when').AsDateTime := ev.when;
|
|
qry.ParamByName('kind').AsInteger := ev.kind;
|
|
qry.ParamByName('chat').AsString := chat;
|
|
qry.ParamByName('who').AsString := ev.who.UID;
|
|
txt := ev.textData;
|
|
if txt = '' then
|
|
qry.ParamByName('text').Value := Null
|
|
else
|
|
qry.ParamByName('text').AsWideString := txt;
|
|
bin := ev.binaryData;
|
|
if not (bin = nil) and (Length(bin) > 0) then
|
|
qry.ParamByName('binary').Value := bin
|
|
else
|
|
qry.ParamByName('binary').Value := Null;
|
|
qry.ParamByName('flags').AsInteger := ev.flags;
|
|
qry.ParamByName('out').AsInteger := IfThen(ev.outgoing, 1, 0);
|
|
if ev.WID = '' then
|
|
qry.ParamByName('wid').Value := Null
|
|
else
|
|
qry.ParamByName('wid').AsGUID := StringToGUID('{' + ev.wid + '}');
|
|
if ev.ID > 0 then
|
|
qry.ParamByName('msgid').AsLargeInt := ev.ID
|
|
else
|
|
qry.ParamByName('msgid').Value := Null;
|
|
qry.ExecSQL;
|
|
qry.Free;
|
|
end;
|
|
|
|
procedure TSQLDatabase.WritePatch(const Chat: TUID; MsgID: TMsgID; PatchType: String);
|
|
var
|
|
qry: TFDQuery;
|
|
ev: Thevent;
|
|
del: Boolean;
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
|
|
qry.SQL.Text := 'INSERT INTO "' + dbPatches + '" VALUES (:msgid, :type, :text)';
|
|
|
|
qry.Params[0].DataType := TFieldType.ftLargeint;
|
|
qry.Params[1].DataType := TFieldType.ftString;
|
|
qry.Params[2].DataType := TFieldType.ftWideString;
|
|
|
|
qry.ParamByName('msgid').AsLargeInt := MsgID;
|
|
qry.ParamByName('type').AsString := PatchType;
|
|
|
|
ev := nil;
|
|
del := (PatchType = 'delete') or (PatchType = 'modify');
|
|
if not del then
|
|
ev := GetByMsgID(Chat, MsgID, False);
|
|
|
|
if Assigned(ev) then
|
|
begin
|
|
qry.ParamByName('text').AsWideString := ev.textData;
|
|
ev.Free;
|
|
end else
|
|
qry.ParamByName('text').AsWideString := '';
|
|
|
|
qry.ExecSQL;
|
|
|
|
if del then
|
|
begin
|
|
qry.SQL.Text := 'UPDATE OR IGNORE "' + dbConv + '" SET "Flags" = "Flags" | ' + IntToStr(IF_Patched) + ' WHERE "Chat" = :chat AND "MsgID" = :msgid';
|
|
qry.ParamByName('chat').AsString := Chat;
|
|
qry.ParamByName('msgid').AsLargeInt := MsgID;
|
|
qry.ExecSQL;
|
|
end;
|
|
|
|
qry.Free;
|
|
end;
|
|
|
|
procedure TSQLDatabase.PatchEvent(const chat: TUID; ev: Thevent);
|
|
var
|
|
qry: TFDQuery;
|
|
txt: String;
|
|
bin: TBytes;
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
|
|
qry.SQL.Text := 'UPDATE OR IGNORE "' + dbConv + '" SET "Text" = :text, "Binary" = :binary, "Flags" = :flags, "WID" = :wid WHERE "Chat" = :chat AND "Who" = :who AND "MsgID" = :msgid';
|
|
|
|
qry.Params[0].DataType := TFieldType.ftWideString;
|
|
qry.Params[1].DataType := TFieldType.ftBlob;
|
|
qry.Params[2].DataType := TFieldType.ftInteger;
|
|
qry.Params[3].DataType := TFieldType.ftGuid;
|
|
qry.Params[4].DataType := TFieldType.ftString;
|
|
qry.Params[5].DataType := TFieldType.ftString;
|
|
qry.Params[6].DataType := TFieldType.ftLargeint;
|
|
|
|
qry.ParamByName('chat').AsString := chat;
|
|
qry.ParamByName('who').AsString := ev.who.UID;
|
|
txt := ev.textData;
|
|
|
|
if txt = '' then
|
|
qry.ParamByName('text').Value := Null
|
|
else
|
|
qry.ParamByName('text').AsWideString := txt;
|
|
bin := ev.binaryData;
|
|
if not (bin = nil) and (Length(bin) > 0) then
|
|
qry.ParamByName('binary').Value := bin
|
|
else
|
|
qry.ParamByName('binary').Value := Null;
|
|
qry.ParamByName('flags').AsInteger := ev.flags;
|
|
if ev.WID = '' then
|
|
qry.ParamByName('wid').Value := Null
|
|
else
|
|
qry.ParamByName('wid').AsGUID := StringToGUID('{' + ev.wid + '}');
|
|
if ev.ID > 0 then
|
|
qry.ParamByName('msgid').AsLargeInt := ev.ID
|
|
else
|
|
qry.ParamByName('msgid').Value := Null;
|
|
qry.ExecSQL;
|
|
|
|
qry.Free;
|
|
end;
|
|
|
|
procedure TSQLDatabase.LoadReactions;
|
|
var
|
|
qry: TFDQuery;
|
|
Reactions: TArray |
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT * FROM "' + dbReactions + '"';
|
|
QueryToArray |
|
MsgsReactions.Clear;
|
|
for var Reaction in Reactions do
|
|
MsgsReactions.AddOrSetValue(Reaction.MsgID, Reaction);
|
|
SetLength(Reactions, 0);
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
procedure TSQLDatabase.SaveReactions;
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
sql.StartTransaction;
|
|
try
|
|
qry.ExecSQL('DELETE FROM "' + dbReactions + '"');
|
|
for var Reaction in MsgsReactions.Values do
|
|
begin
|
|
qry.SQL.Text := 'INSERT INTO "' + dbReactions + '" VALUES (:msgid, :chatid, :notifymsgid, :data, :my);';
|
|
qry.ParamByName('msgid').AsLargeInt := Reaction.MsgID;
|
|
qry.ParamByName('chatid').AsString := Reaction.ChatID;
|
|
qry.ParamByName('notifymsgid').AsLargeInt := Reaction.NotifyMsgID;
|
|
qry.ParamByName('data').AsWideString := Reaction.Data.ToString;
|
|
qry.ParamByName('my').AsWideString := Reaction.My;
|
|
qry.ExecSQL;
|
|
end;
|
|
sql.Commit;
|
|
except
|
|
sql.Rollback;
|
|
end;
|
|
qry.Free;
|
|
end;
|
|
|
|
procedure TSQLDatabase.WriteMsgIDs(const Chat: TUID; ReqID, MsgID: TMsgID; const WID: RawByteString);
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
if ReqID = 0 then
|
|
Exit;
|
|
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'UPDATE OR IGNORE "' + dbConv + '" SET "WID" = COALESCE(:wid, "WID"), "MsgID" = COALESCE(:msgid, "MsgID") WHERE "Chat" = :chat AND "When" >= :userts AND "MsgID" = :reqid';
|
|
qry.Params[0].DataType := TFieldType.ftGuid;
|
|
qry.Params[1].DataType := TFieldType.ftLargeInt;
|
|
if WID = '' then
|
|
qry.ParamByName('wid').Value := Null
|
|
else
|
|
qry.ParamByName('wid').AsGUID := StringToGUID('{' + wid + '}');
|
|
if MsgID = 0 then
|
|
qry.ParamByName('msgid').Value := Null
|
|
else
|
|
qry.ParamByName('msgid').AsLargeInt := MsgID;
|
|
qry.ParamByName('chat').AsString := Chat;
|
|
qry.ParamByName('userts').AsDateTime := UserStartTime;
|
|
qry.ParamByName('reqid').AsLargeInt := ReqID;
|
|
qry.ExecSQL;
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
procedure TSQLDatabase.WriteMsgFlags(const Chat: TUID; MsgID: TMsgID; Flags: Integer);
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
if MsgID = 0 then
|
|
Exit;
|
|
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'UPDATE OR IGNORE "' + dbConv + '" SET "Flags" = :flags WHERE "Chat" = :chat AND "When" >= :userts AND "MsgID" = :msgid';
|
|
qry.ParamByName('flags').AsInteger := Flags;
|
|
qry.ParamByName('msgid').AsLargeInt := MsgID;
|
|
qry.ParamByName('chat').AsString := Chat;
|
|
qry.ParamByName('userts').AsDateTime := UserStartTime;
|
|
qry.ExecSQL;
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
function TSQLDatabase.RecordToEvent(var qry: TFDQuery): Thevent;
|
|
var
|
|
schat, swho: String;
|
|
chat, who: TICQContact;
|
|
begin
|
|
schat := qry.FieldByName('Chat').AsString;
|
|
if Account.AccProto.getMyInfo.equals(schat) then
|
|
chat := Account.AccProto.getMyInfo
|
|
else
|
|
chat := Account.AccProto.getContact(schat);
|
|
|
|
swho := qry.FieldByName('Who').AsString;
|
|
if Account.AccProto.getMyInfo.equals(swho) then
|
|
who := Account.AccProto.getMyInfo
|
|
else
|
|
who := Account.AccProto.getContact(swho);
|
|
|
|
Result := Thevent.new(
|
|
qry.FieldByName('Kind').AsInteger,
|
|
chat,
|
|
who,
|
|
qry.FieldByName('When').AsDateTime,
|
|
qry.FieldByName('Text').AsWideString,
|
|
[],
|
|
qry.FieldByName('Flags').AsInteger,
|
|
0,
|
|
Copy(qry.FieldByName('WID').AsString, 2, 36)
|
|
);
|
|
Result.outgoing := qry.FieldByName('Out').AsInteger = 1;
|
|
Result.ID := qry.FieldByName('MsgID').AsLargeInt;
|
|
Result.rawBin := qry.FieldByName('Binary').AsBytes;
|
|
if Assigned(qry.FieldList.Find('rowid')) then
|
|
Result.rowID := qry.FieldByName('rowid').AsInteger;
|
|
end;
|
|
|
|
function TSQLDatabase.GetExistingChats: TUIDS;
|
|
var
|
|
qry: TFDQuery;
|
|
i: Integer;
|
|
begin
|
|
SetLength(Result, 0);
|
|
try
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT DISTINCT "Chat" FROM "' + dbConv + '" ORDER BY "Chat" ASC';
|
|
if qry.OpenOrExecute and (qry.RecordCount > 0) then
|
|
begin
|
|
SetLength(Result, qry.RecordCount);
|
|
i := 0;
|
|
qry.First;
|
|
while not qry.Eof do
|
|
begin
|
|
Result[i] := qry.FieldByName('Chat').AsString;
|
|
qry.Next;
|
|
Inc(i);
|
|
end;
|
|
end;
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
function TSQLDatabase.ChatExists(const chat: TUID): Boolean;
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
Result := False;
|
|
try
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT "Chat" FROM "' + dbConv + '" WHERE "Chat" = :chat LIMIT 1';
|
|
qry.ParamByName('chat').AsString := chat;
|
|
Result := qry.OpenOrExecute and (qry.RecordCount > 0);
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
function TSQLDatabase.GetAllEvents(const chat: TUID): Thevents;
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
SetLength(Result, 0);
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT *, "rowid" FROM "' + dbConv + '" WHERE "Chat" = :chat ORDER BY "When" ASC';
|
|
qry.ParamByName('chat').AsString := chat;
|
|
QueryToArray |
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
function TSQLDatabase.GetLastMulti(const chat: TUID; offset, cnt: Integer; var noMoreMessages: Boolean): Thevents;
|
|
var
|
|
qry: TFDQuery;
|
|
c: Integer;
|
|
begin
|
|
SetLength(Result, 0);
|
|
noMoreMessages := False;
|
|
qry := nil;
|
|
try
|
|
c := GetEventCount(chat);
|
|
noMoreMessages := (offset + cnt) >= c;
|
|
if c > 0 then
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT * FROM "' + dbConv + '" WHERE "Chat" = :chat ORDER BY "When" DESC LIMIT ' + IntToStr(cnt) + ' OFFSET ' + IntToStr(offset) + ';';
|
|
qry.ParamByName('chat').AsString := chat;
|
|
QueryToArray |
|
end;
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
function TSQLDatabase.GetLastSingle(const chat: TUID; cnt: Integer): Thevent;
|
|
var
|
|
qry: TFDQuery;
|
|
c: Integer;
|
|
begin
|
|
Result := nil;
|
|
qry := nil;
|
|
try
|
|
c := GetEventCount(chat);
|
|
if (c > 0) and (cnt <= c) then
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT * FROM "' + dbConv + '" WHERE "Chat" = :chat ORDER BY "When" DESC LIMIT 1 OFFSET ' + IntToStr(cnt-1) + ';';
|
|
qry.ParamByName('chat').AsString := chat;
|
|
if qry.OpenOrExecute and (qry.RecordCount > 0) then
|
|
begin
|
|
qry.First;
|
|
Result := RecordToEvent(qry);
|
|
end;
|
|
end;
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
function TSQLDatabase.GetByTime(const chat: TUID; thetime: TDateTime): Thevent;
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
Result := nil;
|
|
|
|
if thetime <= 0 then
|
|
Exit;
|
|
|
|
try
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT * FROM "' + dbConv + '" WHERE "Chat" = :chat AND "When" = :time;';
|
|
qry.ParamByName('chat').AsString := chat;
|
|
qry.ParamByName('time').AsDateTime := thetime;
|
|
if qry.OpenOrExecute and (qry.RecordCount > 0) then
|
|
begin
|
|
qry.First;
|
|
Result := RecordToEvent(qry);
|
|
end;
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
function TSQLDatabase.GetByRowID(const chat: TUID; rowID: Integer): Thevent;
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
Result := nil;
|
|
|
|
if rowID <= 0 then
|
|
Exit;
|
|
|
|
try
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT * FROM "' + dbConv + '" WHERE "Chat" = :chat AND "rowid" = :rowid LIMIT 1;';
|
|
qry.ParamByName('chat').AsString := chat;
|
|
qry.ParamByName('rowid').AsInteger := rowID;
|
|
if qry.OpenOrExecute and (qry.RecordCount > 0) then
|
|
begin
|
|
qry.First;
|
|
Result := RecordToEvent(qry);
|
|
end;
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
function TSQLDatabase.GetByMsgID(const Chat: TUID; MsgID: TMsgID; Recent: Boolean = True): Thevent;
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
Result := nil;
|
|
|
|
if MsgID < 0 then
|
|
Exit;
|
|
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT * FROM "' + dbConv + '" WHERE "Chat" = :chat AND "When" >= :userts AND "MsgID" = :msgid LIMIT 1;';
|
|
qry.ParamByName('chat').AsString := Chat;
|
|
if Recent then
|
|
qry.ParamByName('userts').AsDateTime := UserStartTime
|
|
else
|
|
qry.ParamByName('userts').AsFloat := 0;
|
|
qry.ParamByName('msgid').AsLargeInt := MsgID;
|
|
if qry.OpenOrExecute and (qry.RecordCount > 0) then
|
|
begin
|
|
qry.First;
|
|
Result := RecordToEvent(qry);
|
|
end;
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
function TSQLDatabase.GetByWID(const chat: TUID; const wid: String): Thevent;
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
Result := nil;
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT * FROM "' + dbConv + '" WHERE "Chat" = :chat AND "WID" = :wid;';
|
|
qry.ParamByName('chat').AsString := chat;
|
|
qry.ParamByName('wid').AsGUID := StringToGUID('{' + wid + '}');
|
|
if qry.OpenOrExecute and (qry.RecordCount > 0) then
|
|
begin
|
|
qry.First;
|
|
Result := RecordToEvent(qry);
|
|
end;
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
function TSQLDatabase.GetBySender(const chat, sender: TUID): Thevents;
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
SetLength(Result, 0);
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT * FROM "' + dbConv + '" WHERE "Chat" = :chat AND "Who" = :sender ORDER BY "When" ASC;';
|
|
qry.ParamByName('chat').AsString := chat;
|
|
qry.ParamByName('sender').AsString := sender;
|
|
QueryToArray |
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
function TSQLDatabase.GetByTimeRange(const chat: TUID; fromTime, toTime: TDateTime; var noMoreMessages: Boolean; toInclusive: Boolean = True): Thevents;
|
|
var
|
|
qry, qry2: TFDQuery;
|
|
begin
|
|
SetLength(Result, 0);
|
|
noMoreMessages := False;
|
|
qry := nil;
|
|
qry2 := nil;
|
|
|
|
if fromTime < 0 then
|
|
fromTime := 0;
|
|
if toTime <= 0 then
|
|
Exit;
|
|
|
|
try
|
|
if GetEventCount(chat) > 0 then
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
if toInclusive then
|
|
qry.SQL.Text := 'SELECT *, "rowid" FROM "' + dbConv + '" WHERE "Chat" = :chat AND "When" BETWEEN :fromTime AND :toTime ORDER BY "When" ASC;'
|
|
else
|
|
qry.SQL.Text := 'SELECT *, "rowid" FROM "' + dbConv + '" WHERE "Chat" = :chat AND "When" >= :fromTime AND "When" < :toTime ORDER BY "When" ASC;';
|
|
qry.ParamByName('chat').AsString := chat;
|
|
qry.ParamByName('fromTime').AsDateTime := fromTime;
|
|
qry.ParamByName('toTime').AsDateTime := toTime;
|
|
if QueryToArray |
|
try
|
|
qry2 := TFDQuery.Create(sql);
|
|
qry2.Connection := sql;
|
|
qry2.SQL.Text := 'SELECT "rowid" FROM "' + dbConv + '" WHERE "Chat" = :chat ORDER BY "When" ASC LIMIT 1;';
|
|
qry2.ParamByName('chat').AsString := chat;
|
|
if qry2.OpenOrExecute then
|
|
begin
|
|
qry.First; qry2.First;
|
|
noMoreMessages := qry.FieldByName('rowid').AsInteger = qry2.FieldByName('rowid').AsInteger;
|
|
end;
|
|
finally
|
|
if Assigned(qry2) then
|
|
FreeAndNil(qry2);
|
|
end else
|
|
noMoreMessages := (fromTime = 0);
|
|
end else
|
|
noMoreMessages := True;
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
procedure TSQLDatabase.DeleteByTimeRange(const chat: TUID; fromTime, toTime: TDateTime);
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
if toTime <= 0 then
|
|
Exit;
|
|
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'DELETE FROM "' + dbConv + '" WHERE "Chat" = :chat AND "When" BETWEEN :fromTime AND :toTime;';
|
|
qry.ParamByName('chat').AsString := chat;
|
|
qry.ParamByName('fromTime').AsDateTime := fromTime;
|
|
qry.ParamByName('toTime').AsDateTime := toTime;
|
|
qry.ExecSQL;
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
procedure TSQLDatabase.DeleteByMsgID(const Chat: TUID; MsgID: TMsgID);
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'DELETE FROM "' + dbConv + '" WHERE "Chat" = :chat AND "MsgID" = :msgid';
|
|
qry.ParamByName('chat').AsString := Chat;
|
|
qry.ParamByName('msgid').AsLargeInt := MsgID;
|
|
qry.ExecSQL;
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
procedure TSQLDatabase.DeleteBySender(const chat, sender: TUID);
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
if sender = '' then
|
|
Exit;
|
|
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'DELETE FROM "' + dbConv + '" WHERE "Chat" = :chat AND "Who" = :sender';
|
|
qry.ParamByName('chat').AsString := chat;
|
|
qry.ParamByName('sender').AsString := sender;
|
|
qry.ExecSQL;
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
function TSQLDatabase.DataSearch(const chat: TUID; const txt: String; caseSensitive: Boolean = False): Thevents;
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
SetLength(Result, 0);
|
|
Result := nil;
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT *, "rowid" FROM "' + dbConv + '" WHERE "Chat" = :chat AND CONTAINS("Text", :txt, :case) ORDER BY "When" ASC;';
|
|
qry.ParamByName('chat').AsString := chat;
|
|
qry.ParamByName('txt').AsWideString := txt;
|
|
qry.ParamByName('case').AsBoolean := caseSensitive;
|
|
QueryToArray |
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
function TSQLDatabase.GetEventCount(const chat: TUID): Integer;
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
Result := 0;
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT COUNT(*) FROM "' + dbConv + '" WHERE "Chat" = :chat;';
|
|
qry.ParamByName('chat').AsString := chat;
|
|
if qry.OpenOrExecute and (qry.RecordCount > 0) then
|
|
begin
|
|
qry.First;
|
|
Result := qry.Fields[0].AsInteger;
|
|
end;
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
function TSQLDatabase.GetEventCounts: TDictionary |
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
Result := TDictionary |
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT "Chat", COUNT(*) FROM "' + dbConv + '" GROUP BY "Chat"';
|
|
if qry.OpenOrExecute and (qry.RecordCount > 0) then
|
|
begin
|
|
qry.First;
|
|
while not qry.Eof do
|
|
begin
|
|
Result.Add(qry.Fields[0].AsString, qry.Fields[1].AsInteger);
|
|
qry.Next;
|
|
end;
|
|
end;
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
function TSQLDatabase.GetPatches(MsgID: TMsgID): TArray |
|
var
|
|
qry: TFDQuery;
|
|
c: Integer;
|
|
begin
|
|
SetLength(Result, 0);
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT * FROM "' + dbPatches + '" WHERE "MsgID" = :msgid ORDER BY "rowid" ASC;';
|
|
qry.ParamByName('msgid').AsLargeInt := MsgID;
|
|
if qry.OpenOrExecute and (qry.RecordCount > 0) then
|
|
begin
|
|
SetLength(Result, qry.RecordCount);
|
|
qry.First;
|
|
c := 0;
|
|
while not qry.Eof do
|
|
begin
|
|
Result[c].PatchType := qry.FieldByName('Type').AsString;
|
|
Result[c].PatchedText := qry.FieldByName('Text').AsString;
|
|
Inc(c);
|
|
qry.Next;
|
|
end;
|
|
end;
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
procedure TSQLDatabase.UpdateProgress(Sender: TObject; TickCount: Cardinal; var Reset: Boolean);
|
|
begin
|
|
if Assigned(taskDlg) then
|
|
if cUID.Pos >= taskDlg.ProgressBar.Max then
|
|
begin
|
|
taskDlg.Text := GetTranslation('Account was successfully converted to SQLite format.\nYou can now proceed by pressing Continue.');
|
|
taskDlg.FooterText := GetTranslation('Contacts processed') + ': ' + IntToStr(taskDlg.ProgressBar.Max);
|
|
taskDlg.ProgressBar.Position := taskDlg.ProgressBar.Max;
|
|
taskDlg.Buttons[0].Enabled := True;
|
|
end
|
|
else
|
|
begin
|
|
taskDlg.FooterText := GetTranslation('Processing contact') + ' ' + cUID.UID;
|
|
taskDlg.ProgressBar.Position := cUID.Pos;
|
|
end;
|
|
end;
|
|
|
|
procedure TSQLDatabase.ConvertHistory;
|
|
var
|
|
uins: TStringDynArray;
|
|
FinishedEvent: TEvent;
|
|
begin
|
|
LogEvent('History: converting to SQLite');
|
|
|
|
if TDirectory.Exists(AccPath + historyPath) then
|
|
uins := TDirectory.GetFiles(AccPath + historyPath);
|
|
|
|
if Length(uins) = 0 then
|
|
Exit;
|
|
|
|
FinishedEvent := TEvent.Create(nil, True, False, '');
|
|
TThread.CreateAnonymousThread(procedure()
|
|
var
|
|
hist: THistory;
|
|
qry: TFDQuery;
|
|
ev: Pointer;
|
|
i, k: Integer;
|
|
uin, txt: String;
|
|
bin: TBytes;
|
|
begin
|
|
sql.StartTransaction;
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
qry.FetchOptions.AutoClose := False;
|
|
qry.SQL.Add('INSERT INTO "' + dbConv + '" VALUES (:when, :kind, :chat, :who, :text, :binary, :flags, :out, :wid, :msgid);');
|
|
try
|
|
for i := 0 to Length(uins) - 1 do
|
|
try
|
|
uin := ExtractFileName(uins[i]);
|
|
cUID.UID := uin;
|
|
cUID.Pos := i;
|
|
|
|
hist := Thistory.Create('');
|
|
OutputDebugString(PChar('Start ' + uin));
|
|
hist.old_Load(Account.AccProto.GetICQContact(uin));
|
|
|
|
k := 0;
|
|
qry.Params.ArraySize := hist.old_eventList.Count;
|
|
qry.Params[0].DataType := TFieldType.ftDateTime;
|
|
qry.Params[1].DataType := TFieldType.ftInteger;
|
|
qry.Params[2].DataType := TFieldType.ftWideString;
|
|
qry.Params[3].DataType := TFieldType.ftWideString;
|
|
qry.Params[4].DataType := TFieldType.ftWideString;
|
|
qry.Params[5].DataType := TFieldType.ftBlob;
|
|
qry.Params[6].DataType := TFieldType.ftInteger;
|
|
qry.Params[7].DataType := TFieldType.ftInteger;
|
|
qry.Params[8].DataType := TFieldType.ftGuid;
|
|
qry.Params[9].DataType := TFieldType.ftLargeint;
|
|
|
|
for ev in hist.old_eventList do
|
|
with Thevent(ev) do
|
|
begin
|
|
qry.Params[0].Values[k] := when;
|
|
qry.Params[1].Values[k] := kind;
|
|
qry.Params[2].Values[k] := uin;
|
|
qry.Params[3].Values[k] := who.UID;
|
|
txt := old_getTextPart;
|
|
if txt = '' then
|
|
qry.Params[4].Values[k] := Null
|
|
else
|
|
qry.Params[4].Values[k] := txt;
|
|
bin := old_getBinPart;
|
|
if not (bin = nil) and (Length(bin) > 0) then
|
|
qry.Params[5].Values[k] := bin
|
|
else
|
|
qry.Params[5].Values[k] := Null;
|
|
qry.Params[6].Values[k] := flags;
|
|
qry.Params[7].Values[k] := IfThen(old_isMyEvent, 1, 0);
|
|
if WID = '' then
|
|
qry.Params[8].Values[k] := Null
|
|
else
|
|
qry.Params[8].AsGUIDs[k] := StringToGUID('{' + WID + '}');
|
|
if ID > 0 then
|
|
qry.Params[9].Values[k] := ID
|
|
else
|
|
qry.Params[9].Values[k] := Null;
|
|
Inc(k);
|
|
end;
|
|
qry.Execute(hist.old_eventList.Count);
|
|
hist.Free;
|
|
except
|
|
OutputDebugString(PChar('Failed ' + uin));
|
|
end;
|
|
|
|
qry.Free;
|
|
sql.Commit;
|
|
LogEvent('History: conversion completed');
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
OutputDebugString(PChar(E.Message));
|
|
sql.Rollback;
|
|
end;
|
|
end;
|
|
FinishedEvent.SetEvent;
|
|
end).Start;
|
|
|
|
if (Win32MajorVersion >= 6) and StyleServices.Enabled then
|
|
begin
|
|
taskDlg := TTaskDialog.Create(nil);
|
|
taskDlg.Caption := GetTranslation('History management');
|
|
taskDlg.Text := GetTranslation('Converting history to SQLite format.\nThis could take a while...');
|
|
taskDlg.CustomMainIcon.LoadFromResourceName(hInstance, 'SQLITE');
|
|
taskDlg.CustomFooterIcon.LoadFromResourceName(hInstance, 'USER');
|
|
taskDlg.ProgressBar.Min := 0;
|
|
taskDlg.ProgressBar.Max := Length(uins) - 1;
|
|
taskDlg.ProgressBar.Position := 0;
|
|
taskDlg.OnTimer := UpdateProgress;
|
|
taskDlg.FooterText := GetTranslation('Processing contact') + '...';
|
|
taskDlg.Flags := [tfUseHiconMain, tfUseHiconFooter, tfShowProgressBar, tfCallbackTimer, tfExpandFooterArea];
|
|
taskDlg.CommonButtons := [];
|
|
taskDlg.Buttons.Clear;
|
|
with taskDlg.Buttons.Add do
|
|
begin
|
|
Caption := GetTranslation('Continue');
|
|
Enabled := False;
|
|
end;
|
|
taskDlg.ExpandButtonCaption := '';
|
|
taskDlg.Execute;
|
|
FreeAndNil(taskDlg);
|
|
end;
|
|
|
|
while FinishedEvent.WaitFor(0) = wrTimeout do
|
|
if MsgWaitForMultipleObjects(0, Pointer(nil)^, False, 1000, QS_ALLINPUT) = WAIT_OBJECT_0 then
|
|
Application.ProcessMessages;
|
|
end;
|
|
|
|
// Stickers
|
|
|
|
function GetStickersSchema: String;
|
|
begin
|
|
Result := 'CREATE TABLE IF NOT EXISTS "' + dbStickers + '" ('
|
|
+ '"Id" INTEGER NOT NULL,'
|
|
+ '"Name" TEXT NOT NULL,'
|
|
+ '"Purchased" INTEGER DEFAULT 0,'
|
|
+ '"Usersticker" INTEGER DEFAULT 0,'
|
|
+ '"Priority" INTEGER DEFAULT 0,'
|
|
+ '"Count" INTEGER DEFAULT 0,'
|
|
+ '"Content" TEXT,'
|
|
+ '"ContentType" TEXT DEFAULT "image",'
|
|
+ '"Keywords" TEXT);';
|
|
end;
|
|
|
|
function GetStickersIndex: String;
|
|
begin
|
|
Result := 'CREATE UNIQUE INDEX IF NOT EXISTS "stickerid" ON "' + dbStickers + '" ("Id");';
|
|
end;
|
|
|
|
procedure TSQLDatabase.OpenStickersTable;
|
|
begin
|
|
if not OpenTable(dbStickers) then
|
|
CreateTable(GetStickersSchema, GetStickersIndex)
|
|
else
|
|
MigrateStickersTable;
|
|
end;
|
|
|
|
procedure TSQLDatabase.MigrateStickersTable;
|
|
var
|
|
qry: TFDQuery;
|
|
MIQ: TFDMetaInfoQuery;
|
|
MigrateContent, MigrateContentType, MigrateKeywords: Boolean;
|
|
begin
|
|
MigrateContent := True;
|
|
MigrateContentType := True;
|
|
MigrateKeywords := True;
|
|
MIQ := TFDMetaInfoQuery.Create(sql);
|
|
MIQ.Connection := sql;
|
|
MIQ.MetaInfoKind := mkTableFields;
|
|
MIQ.ObjectName := dbStickers;
|
|
if MIQ.OpenOrExecute and (MIQ.RecordCount > 0) then
|
|
begin
|
|
MIQ.First;
|
|
while not MIQ.Eof do
|
|
begin
|
|
if MIQ.Fields.FieldByName('COLUMN_NAME').AsWideString = 'Content' then MigrateContent := False;
|
|
if MIQ.Fields.FieldByName('COLUMN_NAME').AsWideString = 'ContentType' then MigrateContentType := False;
|
|
if MIQ.Fields.FieldByName('COLUMN_NAME').AsWideString = 'Keywords' then MigrateKeywords := False;
|
|
MIQ.Next;
|
|
end;
|
|
end;
|
|
MIQ.Free;
|
|
|
|
if MigrateContent then
|
|
begin
|
|
OutputDebugString(PChar('Adding Content column to Stickers table'));
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
sql.StartTransaction;
|
|
try
|
|
qry.ExecSQL('ALTER TABLE "' + dbStickers + '" ADD "Content" TEXT;');
|
|
sql.Commit;
|
|
except
|
|
sql.Rollback;
|
|
end;
|
|
qry.ExecSQL('VACUUM;');
|
|
qry.Free;
|
|
end;
|
|
|
|
if MigrateContentType then
|
|
begin
|
|
OutputDebugString(PChar('Adding ContentType column to Stickers table'));
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
sql.StartTransaction;
|
|
try
|
|
qry.ExecSQL('ALTER TABLE "' + dbStickers + '" ADD "ContentType" TEXT DEFAULT "image";');
|
|
sql.Commit;
|
|
except
|
|
sql.Rollback;
|
|
end;
|
|
qry.ExecSQL('VACUUM;');
|
|
qry.Free;
|
|
end;
|
|
|
|
if MigrateKeywords then
|
|
begin
|
|
OutputDebugString(PChar('Adding Keywords column to Stickers table'));
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
sql.StartTransaction;
|
|
try
|
|
qry.ExecSQL('ALTER TABLE "' + dbStickers + '" ADD "Keywords" TEXT;');
|
|
sql.Commit;
|
|
except
|
|
sql.Rollback;
|
|
end;
|
|
qry.ExecSQL('VACUUM;');
|
|
qry.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TSQLDatabase.ClearStickerPacks;
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
qry.ExecSQL('DELETE FROM "' + dbStickers + '"');
|
|
qry.Free;
|
|
end;
|
|
|
|
procedure TSQLDatabase.AddStickerPack(const StickerPack: TStickerPack);
|
|
var
|
|
qry: TFDQuery;
|
|
Content, Keywords: TArray |
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
|
|
qry.SQL.Add('REPLACE INTO "' + dbStickers + '" VALUES (:id, :name, :purchased, :user, :priority, :count, :content, :contenttype, :keywords)');
|
|
|
|
qry.ParamByName('id').AsInteger := StickerPack.Id;
|
|
qry.ParamByName('name').AsWideString := StickerPack.Name;
|
|
qry.ParamByName('purchased').AsInteger := IfThen(StickerPack.Purchased, 1, 0);
|
|
qry.ParamByName('user').AsInteger := IfThen(StickerPack.UserSticker, 1, 0);
|
|
qry.ParamByName('priority').AsInteger := StickerPack.Priority;
|
|
qry.ParamByName('count').AsInteger := StickerPack.Count;
|
|
if Length(StickerPack.Content) > 0 then
|
|
Content := StickerPack.Content
|
|
else
|
|
Content := GetStickerPackContent(IntToStr(StickerPack.Id));
|
|
qry.ParamByName('content').AsString := IfThen(Length(Content) > 0, String.Join(#10, StickerPack.Content), '');
|
|
qry.ParamByName('contenttype').AsString := StickerPack.ContentType;
|
|
if Length(StickerPack.Keywords) > 0 then
|
|
Keywords := StickerPack.Keywords
|
|
else
|
|
Keywords := GetStickerPackKeywords(IntToStr(StickerPack.Id));
|
|
qry.ParamByName('keywords').AsWideString := IfThen(Length(StickerPack.Keywords) > 0, String.Join(#10, StickerPack.Keywords), '');
|
|
qry.ExecSQL;
|
|
qry.Free;
|
|
end;
|
|
|
|
procedure TSQLDatabase.ChangeStickerPackStatus(const PackId: String; Status: Boolean);
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
qry.SQL.Add('UPDATE "' + dbStickers + '" SET "Purchased" = :purchased WHERE "Id" = :packid');
|
|
qry.ParamByName('purchased').AsInteger := IfThen(Status, 1, 0);
|
|
qry.ParamByName('packid').AsInteger := StrToInt(PackId);
|
|
qry.ExecSQL;
|
|
qry.Free;
|
|
end;
|
|
|
|
function TSQLDatabase.GetStickerPackContent(const PackId: String): TArray |
|
var
|
|
qry: TFDQuery;
|
|
tmp: String;
|
|
begin
|
|
SetLength(Result, 0);
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT "Content" FROM "' + dbStickers + '" WHERE "Id" = ' + PackId;
|
|
if qry.OpenOrExecute then
|
|
begin
|
|
qry.First;
|
|
tmp := Trim(qry.FieldByName('Content').AsString);
|
|
if not (tmp = '') then
|
|
Result := tmp.Split([#10]);
|
|
end;
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
function TSQLDatabase.GetStickerPackKeywords(const PackId: String): TArray |
|
var
|
|
qry: TFDQuery;
|
|
tmp: String;
|
|
begin
|
|
SetLength(Result, 0);
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT "Keywords" FROM "' + dbStickers + '" WHERE "Id" = ' + PackId;
|
|
if qry.OpenOrExecute then
|
|
begin
|
|
qry.First;
|
|
tmp := TrimRight(qry.FieldByName('Keywords').AsWideString);
|
|
if not (tmp = '') then
|
|
Result := tmp.Split([#10]);
|
|
end;
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
//procedure TSQLDatabase.SaveStickerPackContent(const PackId: String; Content: TArray |
|
//var
|
|
// qry: TFDQuery;
|
|
//begin
|
|
// qry := TFDQuery.Create(sql);
|
|
// qry.Connection := sql;
|
|
// qry.SQL.Add('UPDATE "' + dbStickers + '" SET "Content" = :content WHERE "Id" = :packid');
|
|
// qry.ParamByName('content').AsString := String.Join(#10, Content);
|
|
// qry.ParamByName('packid').AsInteger := StrToInt(PackId);
|
|
// qry.ExecSQL;
|
|
// qry.Free;
|
|
//end;
|
|
|
|
function TSQLDatabase.RecordToSticker(var qry: TFDQuery): TStickerPack;
|
|
begin
|
|
Result := Default(TStickerPack);
|
|
Result.Id := qry.FieldByName('Id').AsInteger;
|
|
Result.Name := qry.FieldByName('Name').AsWideString;
|
|
Result.Purchased := qry.FieldByName('Purchased').AsInteger = 1;
|
|
Result.UserSticker := qry.FieldByName('Usersticker').AsInteger = 1;
|
|
Result.Priority := qry.FieldByName('Priority').AsInteger;
|
|
Result.Count := qry.FieldByName('Count').AsInteger;
|
|
Result.Content := qry.FieldByName('Content').AsString.Split([#10]);
|
|
Result.ContentType := qry.FieldByName('ContentType').AsString;
|
|
Result.Keywords := qry.FieldByName('Keywords').AsWideString.Split([#10]);
|
|
end;
|
|
|
|
function TSQLDatabase.GetStickerPacks(ActiveOnly: Boolean = False): TStickerPacks;
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT * FROM "' + dbStickers + '"' + IfThen(ActiveOnly, ' WHERE "Purchased" = 1', '') + ' ORDER BY "Id"';
|
|
if not QueryToArray |
|
SetLength(Result, 0);
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
function TSQLDatabase.GetStickerPacksCount: Integer;
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
Result := 0;
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT COUNT(*) FROM "' + dbStickers + '"';
|
|
if qry.OpenOrExecute and (qry.RecordCount > 0) then
|
|
begin
|
|
qry.First;
|
|
Result := qry.Fields[0].AsInteger;
|
|
end;
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
// Server history
|
|
|
|
function GetSrvHistSchema: String;
|
|
begin
|
|
Result := 'CREATE TABLE IF NOT EXISTS "' + dbSrvHist + '" ('
|
|
+ '"UID" TEXT NOT NULL,'
|
|
+ '"LastMsgId" UINT64 DEFAULT 0,'
|
|
+ '"LastRead" UINT64 DEFAULT 0,'
|
|
+ '"PatchVersion" TEXT);';
|
|
end;
|
|
|
|
function GetSrvHistIndex: String;
|
|
begin
|
|
Result := 'CREATE UNIQUE INDEX IF NOT EXISTS "userid" ON "' + dbSrvHist + '" ("UID");';
|
|
end;
|
|
|
|
procedure TSQLDatabase.OpenSrvHistTable;
|
|
begin
|
|
if not OpenTable(dbSrvHist) then
|
|
CreateTable(GetSrvHistSchema, GetSrvHistIndex)
|
|
else
|
|
MigrateSrvHistTable;
|
|
end;
|
|
|
|
procedure TSQLDatabase.MigrateSrvHistTable;
|
|
var
|
|
qry: TFDQuery;
|
|
MIQ: TFDMetaInfoQuery;
|
|
begin
|
|
MIQ := TFDMetaInfoQuery.Create(sql);
|
|
MIQ.Connection := sql;
|
|
MIQ.MetaInfoKind := mkTableFields;
|
|
MIQ.ObjectName := dbSrvHist;
|
|
if MIQ.OpenOrExecute and (MIQ.RecordCount > 0) then
|
|
begin
|
|
MIQ.First;
|
|
while not MIQ.Eof do
|
|
begin
|
|
if MIQ.Fields.FieldByName('COLUMN_NAME').AsWideString = 'LastRead' then
|
|
begin
|
|
MIQ.Free;
|
|
Exit;
|
|
end;
|
|
MIQ.Next;
|
|
end;
|
|
end;
|
|
MIQ.Free;
|
|
|
|
OutputDebugString(PChar('Adding LastRead column to ServerHistory table'));
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
sql.StartTransaction;
|
|
try
|
|
qry.ExecSQL('ALTER TABLE "' + dbSrvHist + '" RENAME TO "Temp";');
|
|
qry.ExecSQL('DROP INDEX IF EXISTS "userid";');
|
|
qry.ExecSQL(GetSrvHistSchema);
|
|
qry.ExecSQL(GetSrvHistIndex);
|
|
qry.ExecSQL('INSERT INTO "' + dbSrvHist + '" ("UID", "LastMsgId", "PatchVersion") SELECT * FROM "Temp";');
|
|
qry.ExecSQL('DROP TABLE "Temp";');
|
|
sql.Commit;
|
|
except
|
|
sql.Rollback;
|
|
end;
|
|
qry.ExecSQL('VACUUM;');
|
|
qry.Free;
|
|
end;
|
|
|
|
procedure TSQLDatabase.UpdateLastMsg(const UID: TUID; LastMsgId: TMsgID; PatchVersion: String);
|
|
var
|
|
qry: TFDQuery;
|
|
tmp: TMsgId;
|
|
begin
|
|
if not TryStrToUInt64(PatchVersion, tmp) then
|
|
PatchVersion := '1';
|
|
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
|
|
qry.SQL.Add('INSERT INTO "' + dbSrvHist + '" VALUES (:uid, :last, 0, :patch) ON CONFLICT("UID") DO UPDATE SET "LastMsgId" = :last, "PatchVersion" = :patch;');
|
|
qry.ParamByName('uid').AsString := UID;
|
|
qry.ParamByName('last').AsLargeInt := LastMsgId;
|
|
qry.ParamByName('patch').AsString := PatchVersion;
|
|
qry.ExecSQL;
|
|
qry.Free;
|
|
end;
|
|
|
|
procedure TSQLDatabase.UpdateLastRead(const UID: TUID; LastRead: TMsgID);
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
qry.SQL.Add('INSERT INTO "' + dbSrvHist + '" VALUES (:uid, 0, :lastread, "1") ON CONFLICT("UID") DO UPDATE SET "LastRead" = :lastread;');
|
|
qry.ParamByName('uid').AsString := UID;
|
|
qry.ParamByName('lastread').AsLargeInt := LastRead;
|
|
qry.ExecSQL;
|
|
qry.Free;
|
|
end;
|
|
|
|
function TSQLDatabase.GetHistDlg(const UID: TUID): TSrvHist;
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
Result := Default(TSrvHist);
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT * FROM "' + dbSrvHist + '" WHERE "UID" = :uid;';
|
|
qry.ParamByName('uid').AsString := UID;
|
|
if qry.OpenOrExecute and (qry.RecordCount > 0) then
|
|
begin
|
|
qry.First;
|
|
Result.LastMsgId := qry.FieldByName('LastMsgId').AsLargeInt;
|
|
Result.LastRead := qry.FieldByName('LastRead').AsLargeInt;
|
|
Result.PatchVersion := qry.FieldByName('PatchVersion').AsString;
|
|
end;
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
// Patches
|
|
|
|
function GetPatchesSchema: String;
|
|
begin
|
|
Result := 'CREATE TABLE IF NOT EXISTS "' + dbPatches + '" ('
|
|
+ '"MsgID" UINT64,'
|
|
+ '"Type" TEXT,'
|
|
+ '"Text" TEXT);';
|
|
end;
|
|
|
|
function GetPatchesIndex: String;
|
|
begin
|
|
Result := 'CREATE INDEX IF NOT EXISTS "messageid" ON "' + dbPatches + '" ("MsgID");';
|
|
end;
|
|
|
|
procedure TSQLDatabase.OpenPatchesTable;
|
|
begin
|
|
if not OpenTable(dbPatches) then
|
|
CreateTable(GetPatchesSchema, GetPatchesIndex);
|
|
end;
|
|
|
|
// Reactions
|
|
|
|
function GetReactionsSchema: String;
|
|
begin
|
|
Result := 'CREATE TABLE IF NOT EXISTS "' + dbReactions + '" ('
|
|
+ '"MsgID" UINT64,'
|
|
+ '"ChatID" TEXT,'
|
|
+ '"NotifyMsgID" UINT64,'
|
|
+ '"Data" TEXT,'
|
|
+ '"MyReaction" TEXT);';
|
|
end;
|
|
|
|
function GetReactionsIndex: String;
|
|
begin
|
|
Result := 'CREATE UNIQUE INDEX IF NOT EXISTS "rmessageid" ON "' + dbReactions + '" ("MsgID");';
|
|
end;
|
|
|
|
procedure TSQLDatabase.OpenReactionsTable;
|
|
begin
|
|
if not OpenTable(dbReactions) then
|
|
CreateTable(GetReactionsSchema, GetReactionsIndex);
|
|
end;
|
|
|
|
// Contacts
|
|
|
|
function GetContactsSchema: String;
|
|
begin
|
|
Result := 'CREATE TABLE IF NOT EXISTS "' + dbContacts + '" ('
|
|
+ '"UID" TEXT NOT NULL,'
|
|
+ '"UserType" INTEGER,'
|
|
+ '"Local" BOOLEAN DEFAULT 1,'
|
|
+ '"Authorized" BOOLEAN DEFAULT 1,'
|
|
+ '"Display" TEXT,'
|
|
+ '"Nick" TEXT,'
|
|
+ '"First" TEXT,'
|
|
+ '"Last" TEXT,'
|
|
+ '"Email" TEXT,'
|
|
+ '"City" TEXT,'
|
|
+ '"State" TEXT,'
|
|
+ '"Country" TEXT,'
|
|
+ '"About" TEXT,'
|
|
+ '"Lang1" TEXT,'
|
|
+ '"Lang2" TEXT,'
|
|
+ '"Lang3" TEXT,'
|
|
+ '"Regular" TEXT,'
|
|
+ '"Cellular" TEXT,'
|
|
+ '"Workphone" TEXT,'
|
|
+ '"SMSMobile" TEXT,'
|
|
+ '"Age" INTEGER,'
|
|
+ '"Gender" INTEGER,'
|
|
+ '"Group" INTEGER DEFAULT 0,'
|
|
+ '"LastUpdate" DATETIME,'
|
|
+ '"LastInfoUpdate" DATETIME,'
|
|
+ '"LastOnline" DATETIME,'
|
|
+ '"LastMsg" DATETIME,'
|
|
+ '"LastBDInform" DATETIME,'
|
|
+ '"OnlineSince" DATETIME,'
|
|
+ '"MemberSince" DATETIME,'
|
|
+ '"Birth" DATETIME,'
|
|
+ '"BirthLocal" DATETIME,'
|
|
+ '"NoDB" BOOLEAN DEFAULT 0,'
|
|
+ '"DontDelete" BOOLEAN DEFAULT 0,'
|
|
+ '"SMSable" BOOLEAN DEFAULT 0,'
|
|
+ '"Official" BOOLEAN DEFAULT 0,'
|
|
+ '"Bot" BOOLEAN DEFAULT 0,'
|
|
+ '"Deleted" BOOLEAN DEFAULT 0,'
|
|
+ '"SendTranslit" BOOLEAN DEFAULT 0,'
|
|
+ '"Notes" TEXT,'
|
|
+ '"Important" TEXT,'
|
|
+ '"ImportantLocal" TEXT,'
|
|
+ '"Nickname" TEXT,'
|
|
+ '"Cell1" TEXT,'
|
|
+ '"Cell2" TEXT,'
|
|
+ '"Cell3" TEXT,'
|
|
+ '"Cell4" TEXT,'
|
|
+ '"IconToShow" INTEGER,'
|
|
+ '"IconID" TEXT,'
|
|
+ '"AvatarBackColor" TEXT,'
|
|
+ '"AvatarTextColor" TEXT,'
|
|
+ '"PhotoBackColor" TEXT,'
|
|
+ '"PhotoTextColor" TEXT,'
|
|
+ '"MaritalStatus" INTEGER);';
|
|
end;
|
|
|
|
function GetContactsIndex: String;
|
|
begin
|
|
Result := 'CREATE UNIQUE INDEX IF NOT EXISTS "contactuid" ON "' + dbContacts + '" ("UID");';
|
|
end;
|
|
|
|
procedure TSQLDatabase.OpenContactsTable;
|
|
begin
|
|
if not OpenTable(dbContacts) then
|
|
CreateTable(GetContactsSchema, GetContactsIndex);
|
|
end;
|
|
|
|
function TSQLDatabase.RecordToContact(var qry: TFDQuery): TICQContact;
|
|
begin
|
|
Result := TICQContact.Create(qry.FieldByName('UID').AsString);
|
|
Result.UserType := TICQContactType(qry.FieldByName('UserType').AsInteger);
|
|
Result.CntIsLocal := qry.FieldByName('Local').AsBoolean;
|
|
Result.Authorized := qry.FieldByName('Authorized').AsBoolean;
|
|
Result.Display := qry.FieldByName('Display').AsWideString;
|
|
Result.Nick := qry.FieldByName('Nick').AsWideString;
|
|
Result.First := qry.FieldByName('First').AsWideString;
|
|
Result.Last := qry.FieldByName('Last').AsWideString;
|
|
Result.Email := qry.FieldByName('Email').AsString;
|
|
Result.City := qry.FieldByName('City').AsWideString;
|
|
Result.State := qry.FieldByName('State').AsWideString;
|
|
Result.Country := qry.FieldByName('Country').AsWideString;
|
|
Result.About := qry.FieldByName('About').AsWideString;
|
|
Result.Lang[1] := qry.FieldByName('Lang1').AsString;
|
|
Result.Lang[2] := qry.FieldByName('Lang2').AsString;
|
|
Result.Lang[3] := qry.FieldByName('Lang3').AsString;
|
|
Result.Regular := qry.FieldByName('Regular').AsString;
|
|
Result.Cellular := qry.FieldByName('Cellular').AsString;
|
|
Result.WorkPhone := qry.FieldByName('Workphone').AsString;
|
|
Result.SMSMobile := qry.FieldByName('SMSMobile').AsString;
|
|
Result.Age := qry.FieldByName('Age').AsInteger;
|
|
Result.Gender := qry.FieldByName('Gender').AsInteger;
|
|
Result.Group := qry.FieldByName('Group').AsInteger;
|
|
if not Groups.Exists(Result.Group) then
|
|
Result.Group := 0;
|
|
Result.InfoUpdatedTo := qry.FieldByName('LastUpdate').AsDateTime;
|
|
Result.LastInfoUpdate := qry.FieldByName('LastInfoUpdate').AsDateTime;
|
|
Result.LastTimeSeenOnline := qry.FieldByName('LastOnline').AsDateTime;
|
|
Result.LastBDInform := qry.FieldByName('LastBDInform').AsDateTime;
|
|
Result.OnlineSince := qry.FieldByName('OnlineSince').AsDateTime;
|
|
Result.MemberSince := qry.FieldByName('MemberSince').AsDateTime;
|
|
Result.Birth := qry.FieldByName('Birth').AsDateTime;
|
|
Result.BirthL := qry.FieldByName('BirthLocal').AsDateTime;
|
|
Result.NoDB := qry.FieldByName('NoDB').AsBoolean;
|
|
Result.SMSable := qry.FieldByName('SMSable').AsBoolean;
|
|
Result.Official := qry.FieldByName('Official').AsBoolean;
|
|
Result.Bot := qry.FieldByName('Bot').AsBoolean;
|
|
Result.Deleted := qry.FieldByName('Deleted').AsBoolean;
|
|
Result.SendTransl := qry.FieldByName('SendTranslit').AsBoolean;
|
|
Result.ssImportant := qry.FieldByName('Important').AsWideString;
|
|
Result.lclImportant := qry.FieldByName('ImportantLocal').AsWideString;
|
|
Result.ssNickname := qry.FieldByName('Nickname').AsWideString;
|
|
Result.ssCell1 := qry.FieldByName('Cell1').AsString;
|
|
Result.ssCell2 := qry.FieldByName('Cell2').AsString;
|
|
Result.ssCell3 := qry.FieldByName('Cell3').AsString;
|
|
Result.ssCell4 := qry.FieldByName('Cell4').AsString;
|
|
Result.Icon.ToShow := qry.FieldByName('IconToShow').AsInteger;
|
|
Result.IconID := qry.FieldByName('IconID').AsString;
|
|
Result.IconColors.AvatarBack := qry.FieldByName('AvatarBackColor').AsString;
|
|
Result.IconColors.AvatarText := qry.FieldByName('AvatarTextColor').AsString;
|
|
Result.IconColors.PhotoBack := qry.FieldByName('PhotoBackColor').AsString;
|
|
Result.IconColors.PhotoText := qry.FieldByName('PhotoTextColor').AsString;
|
|
Result.MarStatus := qry.FieldByName('MaritalStatus').AsInteger;
|
|
TCE(Result.Data^).LastMsgTime := qry.FieldByName('LastMsg').AsDateTime;
|
|
TCE(Result.Data^).DontDelete := qry.FieldByName('DontDelete').AsBoolean;
|
|
TCE(Result.Data^).Notes := qry.FieldByName('Notes').AsWideString;
|
|
end;
|
|
|
|
procedure TSQLDatabase.LoadContactsDB;
|
|
var
|
|
qry: TFDQuery;
|
|
Contacts: TArray |
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT * FROM "' + dbContacts + '"';
|
|
QueryToArray |
|
if Assigned(TICQSession.ContactsDB) then
|
|
TICQSession.ContactsDB.Clear
|
|
else
|
|
TICQSession.ContactsDB := TRnQCList.Create;
|
|
for var Contact in Contacts do
|
|
TICQSession.ContactsDB.Add(Contact);
|
|
TICQSession.ContactsDB.Add(Account.AccProto.MyAccNum);
|
|
TICQSession.ContactsDB.ResetEnumeration;
|
|
SetLength(Contacts, 0);
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
procedure TSQLDatabase.SaveContactsDB;
|
|
var
|
|
qry: TFDQuery;
|
|
I: Integer;
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
sql.StartTransaction;
|
|
try
|
|
qry.ExecSQL('DELETE FROM "' + dbContacts + '"');
|
|
qry.SQL.Text := 'INSERT INTO "' + dbContacts + '" VALUES (:uid, :usertype, :local, :authorized, :display, :nick, :first,' +
|
|
':last, :email, :city, :state, :country, :about, :lang1, :lang2, :lang3, :regular, :cellular, :workphone, :smsmobile,' +
|
|
':age, :gender, :group, :lupdate, :linfoupdate, :lonline, :lmsg, :lbdinform, :onlinesince, :membersince,' +
|
|
':birth, :birthlocal, :nodb, :nodel, :smsable, :official, :bot, :deleted, :translit, :notes, :ssimp, :lclimp, :nickname,' +
|
|
':cell1, :cell2, :cell3, :cell4, :icontoshow, :iconid, :avback, :avtext, :phback, :phtext, :marital);';
|
|
|
|
I := 0;
|
|
qry.Params.ArraySize := TICQSession.ContactsDB.Count;
|
|
for var Contact in TICQSession.ContactsDB do
|
|
begin
|
|
qry.ParamByName('uid').AsStrings[I] := Contact.UID;
|
|
qry.ParamByName('usertype').AsIntegers[I] := Integer(Contact.UserType);
|
|
qry.ParamByName('local').AsBooleans[I] := Contact.CntIsLocal;
|
|
qry.ParamByName('authorized').AsBooleans[I] := Contact.Authorized;
|
|
qry.ParamByName('display').AsWideStrings[I] := Contact.Display;
|
|
qry.ParamByName('nick').AsWideStrings[I] := Contact.Nick;
|
|
qry.ParamByName('first').AsWideStrings[I] := Contact.First;
|
|
qry.ParamByName('last').AsWideStrings[I] := Contact.Last;
|
|
qry.ParamByName('email').AsStrings[I] := Contact.Email;
|
|
qry.ParamByName('city').AsWideStrings[I] := Contact.City;
|
|
qry.ParamByName('state').AsWideStrings[I] := Contact.State;
|
|
qry.ParamByName('country').AsWideStrings[I] := Contact.Country;
|
|
qry.ParamByName('about').AsWideStrings[I] := Contact.About;
|
|
qry.ParamByName('lang1').AsStrings[I] := Contact.Lang[1];
|
|
qry.ParamByName('lang2').AsStrings[I] := Contact.Lang[2];
|
|
qry.ParamByName('lang3').AsStrings[I] := Contact.Lang[3];
|
|
qry.ParamByName('regular').AsStrings[I] := Contact.Regular;
|
|
qry.ParamByName('cellular').AsStrings[I] := Contact.Cellular;
|
|
qry.ParamByName('workphone').AsStrings[I] := Contact.WorkPhone;
|
|
qry.ParamByName('smsmobile').AsStrings[I] := Contact.SMSMobile;
|
|
qry.ParamByName('age').AsIntegers[I] := Contact.Age;
|
|
qry.ParamByName('gender').AsIntegers[I] := Contact.Gender;
|
|
qry.ParamByName('group').AsIntegers[I] := Contact.Group;
|
|
qry.ParamByName('lupdate').AsDateTimes[I] := Contact.InfoUpdatedTo;
|
|
qry.ParamByName('linfoupdate').AsDateTimes[I] := Contact.LastInfoUpdate;
|
|
qry.ParamByName('lonline').AsDateTimes[I] := Contact.LastTimeSeenOnline;
|
|
qry.ParamByName('lmsg').AsDateTimes[I] := TCE(Contact.Data^).LastMsgTime;
|
|
qry.ParamByName('lbdinform').AsDateTimes[I] := Contact.LastBDInform;
|
|
qry.ParamByName('onlinesince').AsDateTimes[I] := Contact.OnlineSince;
|
|
qry.ParamByName('membersince').AsDateTimes[I] := Contact.MemberSince;
|
|
qry.ParamByName('birth').AsDateTimes[I] := Contact.Birth;
|
|
qry.ParamByName('birthlocal').AsDateTimes[I] := Contact.BirthL;
|
|
qry.ParamByName('nodb').AsBooleans[I] := Contact.NoDB;
|
|
qry.ParamByName('nodel').AsBooleans[I] := TCE(Contact.Data^).DontDelete;
|
|
qry.ParamByName('smsable').AsBooleans[I] := Contact.SMSable;
|
|
qry.ParamByName('official').AsBooleans[I] := Contact.Official;
|
|
qry.ParamByName('bot').AsBooleans[I] := Contact.Bot;
|
|
qry.ParamByName('deleted').AsBooleans[I] := Contact.Deleted;
|
|
qry.ParamByName('translit').AsBooleans[I] := Contact.SendTransl;
|
|
qry.ParamByName('notes').AsWideStrings[I] := TCE(Contact.Data^).Notes;
|
|
qry.ParamByName('ssimp').AsWideStrings[I] := Contact.ssImportant;
|
|
qry.ParamByName('lclimp').AsWideStrings[I] := Contact.lclImportant;
|
|
qry.ParamByName('nickname').AsWideStrings[I] := Contact.ssNickname;
|
|
qry.ParamByName('cell1').AsStrings[I] := Contact.ssCell1;
|
|
qry.ParamByName('cell2').AsStrings[I] := Contact.ssCell2;
|
|
qry.ParamByName('cell3').AsStrings[I] := Contact.ssCell3;
|
|
qry.ParamByName('cell4').AsStrings[I] := Contact.ssCell4;
|
|
qry.ParamByName('icontoshow').AsIntegers[I] := Contact.Icon.ToShow;
|
|
qry.ParamByName('iconid').AsStrings[I] := Contact.IconID;
|
|
qry.ParamByName('avback').AsStrings[I] := Contact.IconColors.AvatarBack;
|
|
qry.ParamByName('avtext').AsStrings[I] := Contact.IconColors.AvatarText;
|
|
qry.ParamByName('phback').AsStrings[I] := Contact.IconColors.PhotoBack;
|
|
qry.ParamByName('phtext').AsStrings[I] := Contact.IconColors.PhotoText;
|
|
qry.ParamByName('marital').AsIntegers[I] := Contact.MarStatus;
|
|
Inc(I);
|
|
end;
|
|
if qry.Params.ArraySize > 0 then
|
|
qry.Execute(qry.Params.ArraySize);
|
|
sql.Commit;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
OutputDebugString(PChar(E.Message));
|
|
sql.Rollback;
|
|
end;
|
|
end;
|
|
qry.Free;
|
|
end;
|
|
|
|
// Groups
|
|
|
|
function GetGroupsSchema: String;
|
|
begin
|
|
Result := 'CREATE TABLE IF NOT EXISTS "' + dbGroups + '" ('
|
|
+ '"ID" INTEGER,'
|
|
+ '"Name" TEXT,'
|
|
+ '"Order" INTEGER DEFAULT 0,'
|
|
+ '"Local" BOOLEAN DEFAULT 1,'
|
|
+ '"Collapsed" TEXT);';
|
|
end;
|
|
|
|
function GetGroupsIndex: String;
|
|
begin
|
|
Result := 'CREATE UNIQUE INDEX IF NOT EXISTS "groupid" ON "' + dbGroups + '" ("ID");';
|
|
end;
|
|
|
|
procedure TSQLDatabase.OpenGroupsTable;
|
|
begin
|
|
if not OpenTable(dbGroups) then
|
|
CreateTable(GetGroupsSchema, GetGroupsIndex);
|
|
end;
|
|
|
|
function TSQLDatabase.RecordToGroup(var qry: TFDQuery): TGroup;
|
|
var
|
|
d: TDivisor;
|
|
i: Integer;
|
|
Collapsed: TArray |
|
begin
|
|
with Result do
|
|
begin
|
|
ID := qry.FieldByName('ID').AsInteger;
|
|
Name := qry.FieldByName('Name').AsWideString;
|
|
Order := qry.FieldByName('Order').AsInteger;
|
|
IsLocal := qry.FieldByName('Local').AsBoolean;
|
|
|
|
for d := Low(d) to High(d) do
|
|
begin
|
|
Node[d] := nil;
|
|
Expanded[d] := True;
|
|
end;
|
|
|
|
Collapsed := qry.FieldByName('Collapsed').AsString.Split([';']);
|
|
for i := Low(Collapsed) to High(Collapsed) do
|
|
Expanded[Str2Divisor(Collapsed[i])] := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TSQLDatabase.LoadGroups;
|
|
var
|
|
qry: TFDQuery;
|
|
QGroups: TArray |
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT * FROM "' + dbGroups + '"';
|
|
QueryToArray |
|
Groups.Clear;
|
|
for var Group in QGroups do
|
|
Groups.SaveGroup(Group);
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
procedure TSQLDatabase.SaveGroups;
|
|
var
|
|
qry: TFDQuery;
|
|
d: TDivisor;
|
|
I: Integer;
|
|
Collapsed: TArray |
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
sql.StartTransaction;
|
|
try
|
|
qry.ExecSQL('DELETE FROM "' + dbGroups + '"');
|
|
qry.SQL.Text := 'INSERT INTO "' + dbGroups + '" VALUES (:id, :name, :order, :local, :collapsed);';
|
|
qry.Params.ArraySize := Groups.GList.Count;
|
|
I := 0;
|
|
for var g in Groups.GList do
|
|
begin
|
|
qry.ParamByName('id').AsIntegers[I] := g.Value.ID;
|
|
qry.ParamByName('name').AsWideStrings[I] := g.Value.name;
|
|
qry.ParamByName('order').AsIntegers[I] := g.Value.order;
|
|
qry.ParamByName('local').AsBooleans[I] := g.Value.IsLocal;
|
|
|
|
SetLength(Collapsed, 0);
|
|
for d := Low(d) to High(d) do
|
|
if not g.Value.Expanded[d] then
|
|
Collapsed := Collapsed + [Divisor2Str[d]];
|
|
qry.ParamByName('collapsed').AsStrings[I] := String.Join(';', Collapsed);
|
|
|
|
Inc(I);
|
|
end;
|
|
if qry.Params.ArraySize > 0 then
|
|
qry.Execute(qry.Params.ArraySize);
|
|
sql.Commit;
|
|
except
|
|
sql.Rollback;
|
|
end;
|
|
qry.Free;
|
|
end;
|
|
|
|
// Proxies
|
|
|
|
function GetProxiesSchema: String;
|
|
begin
|
|
Result := 'CREATE TABLE IF NOT EXISTS "' + dbProxies + '" ('
|
|
+ '"Name" TEXT,'
|
|
+ '"User" TEXT,'
|
|
+ '"Password" RAW,'
|
|
+ '"Host" TEXT,'
|
|
+ '"Port" INTEGER,'
|
|
+ '"Protocol" INTEGER DEFAULT 0,'
|
|
+ '"Auth" BOOLEAN DEFAULT 0,'
|
|
+ '"NTLM" BOOLEAN DEFAULT 0);';
|
|
end;
|
|
|
|
procedure TSQLDatabase.OpenProxiesTable;
|
|
begin
|
|
if not OpenTable(dbProxies) then
|
|
CreateTable(GetProxiesSchema);
|
|
end;
|
|
|
|
function TSQLDatabase.RecordToProxy(var qry: TFDQuery): TProxy;
|
|
begin
|
|
Result.name := qry.FieldByName('Name').AsWideString;
|
|
Result.user := qry.FieldByName('User').AsWideString;
|
|
Result.pwd := UnUTF(PassDecrypt(qry.FieldByName('Password').AsAnsiString));
|
|
Result.addr.host := qry.FieldByName('Host').AsWideString;
|
|
Result.addr.port := qry.FieldByName('Port').AsInteger;
|
|
Result.proto := TProxyProto(qry.FieldByName('Protocol').AsInteger);
|
|
Result.auth := qry.FieldByName('Auth').AsBoolean;
|
|
Result.NTLM := qry.FieldByName('NTLM').AsBoolean;
|
|
end;
|
|
|
|
procedure TSQLDatabase.LoadProxies;
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT * FROM "' + dbProxies + '"';
|
|
SetLength(AllProxies, 0);
|
|
QueryToArray |
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
procedure TSQLDatabase.SaveProxies;
|
|
var
|
|
qry: TFDQuery;
|
|
I: Integer;
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
sql.StartTransaction;
|
|
try
|
|
qry.ExecSQL('DELETE FROM "' + dbProxies + '"');
|
|
|
|
if Length(AllProxies) > 0 then
|
|
for I := 0 to Length(AllProxies) - 1 do
|
|
begin
|
|
if AllProxies[I].name = '' then
|
|
AllProxies[I].name := 'Proxy' + IntToStr(I + 1);
|
|
|
|
qry.SQL.Text := 'INSERT INTO "' + dbProxies + '" VALUES (:name, :user, :pwd, :host, :port, :proto, :auth, :ntlm);';
|
|
qry.ParamByName('name').AsWideString := AllProxies[I].name;
|
|
qry.ParamByName('user').AsWideString := AllProxies[I].user;
|
|
qry.ParamByName('pwd').AsByteStr := PassCrypt(UTF(AllProxies[I].pwd));
|
|
qry.ParamByName('host').AsWideString := AllProxies[I].addr.host;
|
|
qry.ParamByName('port').AsInteger := AllProxies[I].addr.port;
|
|
qry.ParamByName('proto').AsInteger := Integer(AllProxies[I].proto);
|
|
qry.ParamByName('auth').AsBoolean := AllProxies[I].auth;
|
|
qry.ParamByName('ntlm').AsBoolean := AllProxies[I].NTLM;
|
|
|
|
qry.ExecSQL;
|
|
end;
|
|
sql.Commit;
|
|
except
|
|
sql.Rollback;
|
|
end;
|
|
qry.Free;
|
|
end;
|
|
|
|
// Macros
|
|
|
|
function GetMacrosSchema: String;
|
|
begin
|
|
Result := 'CREATE TABLE IF NOT EXISTS "' + dbMacros + '" ('
|
|
+ '"Hotkey" WORD,'
|
|
+ '"Opcode" INTEGER,'
|
|
+ '"SystemWide" BOOLEAN DEFAULT 0);';
|
|
end;
|
|
|
|
procedure TSQLDatabase.OpenMacrosTable;
|
|
begin
|
|
if not OpenTable(dbMacros) then
|
|
CreateTable(GetMacrosSchema);
|
|
end;
|
|
|
|
function TSQLDatabase.RecordToMacro(var qry: TFDQuery): TMacro;
|
|
begin
|
|
Result.hk := qry.FieldByName('Hotkey').AsLongWord;
|
|
Result.opcode := qry.FieldByName('Opcode').AsInteger;
|
|
Result.sw := qry.FieldByName('SystemWide').AsBoolean;
|
|
end;
|
|
|
|
procedure TSQLDatabase.LoadMacros;
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT * FROM "' + dbMacros + '"';
|
|
SetLength(Macros, 0);
|
|
QueryToArray |
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
procedure TSQLDatabase.SaveMacros;
|
|
var
|
|
qry: TFDQuery;
|
|
I: Integer;
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
sql.StartTransaction;
|
|
try
|
|
qry.ExecSQL('DELETE FROM "' + dbMacros + '"');
|
|
|
|
if Length(Macros) > 0 then
|
|
for I := 0 to Length(Macros) - 1 do
|
|
begin
|
|
qry.SQL.Text := 'INSERT INTO "' + dbMacros + '" VALUES (:hk, :opcode, :sw);';
|
|
qry.ParamByName('hk').AsWord := Macros[I].hk;
|
|
qry.ParamByName('opcode').AsInteger := Macros[I].opcode;
|
|
qry.ParamByName('sw').AsBoolean := Macros[I].sw;
|
|
qry.ExecSQL;
|
|
end;
|
|
sql.Commit;
|
|
except
|
|
sql.Rollback;
|
|
end;
|
|
qry.Free;
|
|
end;
|
|
|
|
// XStatuses
|
|
|
|
function GetXStatusesSchema: String;
|
|
begin
|
|
Result := 'CREATE TABLE IF NOT EXISTS "' + dbXStatuses + '" ('
|
|
+ '"ID" INTEGER,'
|
|
+ '"Caption" TEXT,'
|
|
+ '"Description" TEXT);';
|
|
end;
|
|
|
|
function GetXStatusesIndex: String;
|
|
begin
|
|
Result := 'CREATE UNIQUE INDEX IF NOT EXISTS "xstatusid" ON "' + dbXStatuses + '" ("ID");';
|
|
end;
|
|
|
|
procedure TSQLDatabase.OpenXStatusesTable;
|
|
begin
|
|
if not OpenTable(dbXStatuses) then
|
|
CreateTable(GetXStatusesSchema);
|
|
end;
|
|
|
|
function TSQLDatabase.RecordToXStatus(var qry: TFDQuery): TXStatStr;
|
|
begin
|
|
Result.Cap := qry.FieldByName('Caption').AsWideString;
|
|
Result.Desc := qry.FieldByName('Description').AsWideString;
|
|
end;
|
|
|
|
procedure TSQLDatabase.LoadXStatuses;
|
|
var
|
|
qry: TFDQuery;
|
|
I, ID: Integer;
|
|
XStatuses: TArray |
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT * FROM "' + dbXStatuses + '" ORDER BY "ID" ASC';
|
|
for I := Low(XStatusArray) to High(XStatusArray) do
|
|
ExtStsStrings[I].Desc := '';
|
|
QueryToArray |
|
ID := 0;
|
|
for var XStatus in XStatuses do
|
|
begin
|
|
ExtStsStrings[ID] := XStatus;
|
|
Inc(ID);
|
|
if ID > High(XStatusArray) then
|
|
Break;
|
|
end;
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
procedure TSQLDatabase.SaveXStatuses;
|
|
var
|
|
qry: TFDQuery;
|
|
I: Integer;
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
sql.StartTransaction;
|
|
try
|
|
qry.ExecSQL('DELETE FROM "' + dbXStatuses + '"');
|
|
qry.SQL.Text := 'INSERT INTO "' + dbXStatuses + '" VALUES (:id, :caption, :desc);';
|
|
qry.Params[0].DataType := TFieldType.ftInteger;
|
|
qry.Params[1].DataType := TFieldType.ftWideString;
|
|
qry.Params[2].DataType := TFieldType.ftWideString;
|
|
qry.Params.ArraySize := Length(ExtStsStrings);
|
|
for I := 0 to Length(ExtStsStrings) - 1 do
|
|
begin
|
|
qry.ParamByName('id').AsIntegers[I] := I;
|
|
qry.ParamByName('caption').AsWideStrings[I] := GetTranslation(XStatusArray[I].Text); // MaxXStatusLen
|
|
qry.ParamByName('desc').AsWideStrings[I] := Copy(ExtStsStrings[I].Desc, 1, MaxXStatusDescLen);
|
|
end;
|
|
if qry.Params.ArraySize > 0 then
|
|
qry.Execute(qry.Params.ArraySize);
|
|
sql.Commit;
|
|
except
|
|
sql.Rollback;
|
|
end;
|
|
qry.Free;
|
|
end;
|
|
|
|
// SpamQuests
|
|
|
|
function GetSpamQuestsSchema: String;
|
|
begin
|
|
Result := 'CREATE TABLE IF NOT EXISTS "' + dbSpamQuests + '" ('
|
|
+ '"Question" TEXT,'
|
|
+ '"Answers" TEXT);';
|
|
end;
|
|
|
|
procedure TSQLDatabase.OpenSpamQuestsTable;
|
|
begin
|
|
if not OpenTable(dbSpamQuests) then
|
|
CreateTable(GetSpamQuestsSchema);
|
|
end;
|
|
|
|
function TSQLDatabase.RecordToSpamQuest(var qry: TFDQuery): TQuestAns;
|
|
begin
|
|
Result.q := qry.FieldByName('Question').AsWideString;
|
|
Result.a := qry.FieldByName('Answers').AsWideString.Split([#10]);
|
|
end;
|
|
|
|
procedure TSQLDatabase.LoadSpamQuests;
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT * FROM "' + dbSpamQuests + '"';
|
|
SetLength(SpamFilter.Quests, 0);
|
|
QueryToArray |
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
procedure TSQLDatabase.SaveSpamQuests;
|
|
var
|
|
qry: TFDQuery;
|
|
I: Integer;
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
sql.StartTransaction;
|
|
try
|
|
qry.ExecSQL('DELETE FROM "' + dbSpamQuests + '"');
|
|
for I := 0 to Length(SpamFilter.Quests) - 1 do
|
|
begin
|
|
qry.SQL.Text := 'INSERT INTO "' + dbSpamQuests + '" VALUES (:quest, :answers);';
|
|
qry.ParamByName('quest').AsWideString := SpamFilter.Quests[I].q;
|
|
qry.ParamByName('answers').AsWideString := String.Join(#10, SpamFilter.Quests[I].a);
|
|
qry.ExecSQL;
|
|
end;
|
|
sql.Commit;
|
|
except
|
|
sql.Rollback;
|
|
end;
|
|
qry.Free;
|
|
end;
|
|
|
|
// UINLists
|
|
|
|
function GetUINListsSchema: String;
|
|
begin
|
|
Result := 'CREATE TABLE IF NOT EXISTS "' + dbUINLists + '" ('
|
|
+ '"Name" TEXT,'
|
|
+ '"Description" TEXT,'
|
|
+ '"List" TEXT);';
|
|
end;
|
|
|
|
function GetUINListsIndex: String;
|
|
begin
|
|
Result := 'CREATE UNIQUE INDEX IF NOT EXISTS "uinlistname" ON "' + dbUINLists + '" ("Name");';
|
|
end;
|
|
|
|
procedure TSQLDatabase.OpenUINListsTable;
|
|
begin
|
|
if not OpenTable(dbUINLists) then
|
|
CreateTable(GetUINListsSchema, GetUINListsIndex);
|
|
end;
|
|
|
|
function TSQLDatabase.RecordToUINList(var qry: TFDQuery): TUINList;
|
|
begin
|
|
Result.name := qry.FieldByName('Name').AsWideString;
|
|
Result.desc := qry.FieldByName('Description').AsWideString;
|
|
Result.cl := TRnQCList.FromArray(qry.FieldByName('List').AsWideString.Split([#10]));
|
|
end;
|
|
|
|
procedure TSQLDatabase.LoadUINLists;
|
|
var
|
|
qry: TFDQuery;
|
|
Lists: TArray |
|
PList: PUINList;
|
|
I: Integer;
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT * FROM "' + dbUINLists + '"';
|
|
QueryToArray |
|
UINLists.Clear;
|
|
for var List in Lists do
|
|
begin
|
|
PList := UINLists.put(List.name);
|
|
PList.desc := List.desc;
|
|
PList.cl.Assign(List.cl);
|
|
end;
|
|
for I := Low(Lists) to High(Lists) do
|
|
begin
|
|
Lists[I].name := '';
|
|
Lists[I].desc := '';
|
|
Lists[I].cl.Free;
|
|
Lists[I] := Default(TUINList);
|
|
end;
|
|
SetLength(Lists, 0);
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
procedure TSQLDatabase.SaveUINLists;
|
|
var
|
|
qry: TFDQuery;
|
|
I: Integer;
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
sql.StartTransaction;
|
|
try
|
|
qry.ExecSQL('DELETE FROM "' + dbUINLists + '"');
|
|
for I := 0 to UINLists.Count - 1 do
|
|
begin
|
|
qry.SQL.Text := 'INSERT INTO "' + dbUINLists + '" VALUES (:name, :desc, :list);';
|
|
qry.ParamByName('name').AsWideString := PUINList(UINLists.Items[I]).name;
|
|
qry.ParamByName('desc').AsWideString := PUINList(UINLists.Items[I]).desc;
|
|
if Assigned(PUINList(UINLists.Items[I]).cl) then
|
|
qry.ParamByName('list').AsWideString := PUINList(UINLists.Items[I]).cl.Text
|
|
else
|
|
qry.ParamByName('list').AsWideString := '';
|
|
qry.ExecSQL;
|
|
end;
|
|
sql.Commit;
|
|
except
|
|
sql.Rollback;
|
|
end;
|
|
qry.Free;
|
|
end;
|
|
|
|
// Inbox
|
|
|
|
procedure TSQLDatabase.OpenInboxTable;
|
|
begin
|
|
if not OpenTable(dbInbox) then
|
|
CreateTable(GetConvSchema(dbInbox));
|
|
end;
|
|
|
|
procedure TSQLDatabase.LoadInbox;
|
|
var
|
|
qry: TFDQuery;
|
|
InEvents: TArray |
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT * FROM "' + dbInbox + '"';
|
|
QueryToArray |
|
EventQ.Clear;
|
|
for var InEvent in InEvents do
|
|
EventQ.Add(InEvent);
|
|
EventQ.RemoveExpiredEvents;
|
|
SetLength(InEvents, 0);
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
procedure TSQLDatabase.SaveInbox;
|
|
var
|
|
qry: TFDQuery;
|
|
I: Integer;
|
|
Ev: Thevent;
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
qry.ExecSQL('DELETE FROM "' + dbInbox + '"');
|
|
qry.Free;
|
|
|
|
for I := 0 to EventQ.Count - 1 do
|
|
begin
|
|
Ev := EventQ.Get(I);
|
|
if Assigned(Ev.who) then
|
|
WriteEvent(Ev.who.UID, Ev, dbInbox);
|
|
end;
|
|
end;
|
|
|
|
// Outbox
|
|
|
|
function GetOutboxSchema: String;
|
|
begin
|
|
Result := 'CREATE TABLE IF NOT EXISTS "' + dbOutbox + '" ('
|
|
+ '"Kind" INTEGER,'
|
|
+ '"Flags" INTEGER,'
|
|
+ '"UID" TEXT,'
|
|
+ '"Info" TEXT,'
|
|
+ '"Created" DATETIME,'
|
|
+ '"Modified" DATETIME,'
|
|
+ '"List" TEXT);';
|
|
end;
|
|
|
|
procedure TSQLDatabase.OpenOutboxTable;
|
|
begin
|
|
if not OpenTable(dbOutbox) then
|
|
CreateTable(GetOutboxSchema);
|
|
end;
|
|
|
|
function TSQLDatabase.RecordToOEvent(var qry: TFDQuery): TOEvent;
|
|
var
|
|
UID: TUID;
|
|
begin
|
|
Result := TOEvent.Create(qry.FieldByName('Kind').AsInteger);
|
|
Result.flags := qry.FieldByName('Flags').AsInteger;
|
|
UID := qry.FieldByName('UID').AsString;
|
|
if not (UID = '') then
|
|
Result.whom := Account.AccProto.GetContact(UID);
|
|
Result.info := qry.FieldByName('Info').AsWideString;
|
|
Result.wrote := qry.FieldByName('Created').AsDateTime;
|
|
Result.lastmodify := qry.FieldByName('Modified').AsDateTime;
|
|
Result.cl := TRnQCList.FromArray(qry.FieldByName('List').AsWideString.Split([#10]));
|
|
end;
|
|
|
|
procedure TSQLDatabase.LoadOutbox;
|
|
var
|
|
qry: TFDQuery;
|
|
OEvents: TArray |
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT * FROM "' + dbOutbox + '"';
|
|
QueryToArray |
|
Account.outbox.Clear;
|
|
for var OEvent in OEvents do
|
|
with Account.outbox do
|
|
begin
|
|
Add(OEvent);
|
|
UpdateScreenFor(OEvent.whom);
|
|
end;
|
|
UI.UpdateOutbox;
|
|
SetLength(OEvents, 0);
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
procedure TSQLDatabase.SaveOutbox;
|
|
var
|
|
qry: TFDQuery;
|
|
I: Integer;
|
|
OEvent: TOEvent;
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
sql.StartTransaction;
|
|
try
|
|
qry.ExecSQL('DELETE FROM "' + dbOutbox + '"');
|
|
for I := 0 to Account.outbox.Count - 1 do
|
|
begin
|
|
OEvent := Account.outbox.GetAt(I);
|
|
qry.SQL.Text := 'INSERT INTO "' + dbOutbox + '" VALUES (:kind, :flags, :uid, :info, :create, :mod, :list);';
|
|
qry.ParamByName('kind').AsInteger := OEvent.kind;
|
|
qry.ParamByName('flags').AsInteger := OEvent.flags;
|
|
if Assigned(OEvent.whom) then
|
|
qry.ParamByName('uid').AsString := OEvent.whom.UID
|
|
else
|
|
qry.ParamByName('uid').AsString := '';
|
|
qry.ParamByName('info').AsWideString := OEvent.info;
|
|
qry.ParamByName('create').AsDateTime := OEvent.wrote;
|
|
qry.ParamByName('mod').AsDateTime := OEvent.lastmodify;
|
|
if Assigned(OEvent.cl) then
|
|
qry.ParamByName('list').AsWideString := OEvent.cl.Text
|
|
else
|
|
qry.ParamByName('list').AsWideString := '';
|
|
qry.ExecSQL;
|
|
end;
|
|
sql.Commit;
|
|
except
|
|
sql.Rollback;
|
|
end;
|
|
qry.Free;
|
|
end;
|
|
|
|
// Configuration
|
|
|
|
function GetConfigSchema: String;
|
|
begin
|
|
Result := 'CREATE TABLE IF NOT EXISTS "' + dbConfig + '" ('
|
|
+ '"Key" TEXT,'
|
|
+ '"Type" INTEGER,'
|
|
+ '"Value" CUSTOMBLOB);';
|
|
end;
|
|
|
|
function GetConfigIndex: String;
|
|
begin
|
|
Result := 'CREATE UNIQUE INDEX IF NOT EXISTS "configkey" ON "' + dbConfig + '" ("Key");';
|
|
end;
|
|
|
|
procedure TSQLDatabase.OpenConfigTable;
|
|
begin
|
|
NeedToConvertDB := False;
|
|
if not OpenTable(dbConfig) then
|
|
begin
|
|
CreateTable(GetConfigSchema, GetConfigIndex);
|
|
NeedToConvertDB := True;
|
|
end;
|
|
end;
|
|
|
|
function TSQLDatabase.RecordToPrefElement(var qry: TFDQuery): TPrefElementRec;
|
|
var
|
|
StrVal: String;
|
|
FloatVal: Double;
|
|
DateTimeVal: TDateTime;
|
|
begin
|
|
Result.Key := qry.FieldByName('Key').AsString;
|
|
Result.Element := TPrefElement.Create;
|
|
Result.Element.ElType := TElemType(qry.FieldByName('Type').AsInteger);
|
|
if Result.Element.ElType = ET_String then
|
|
Result.Element.elem.sVal := qry.FieldByName('Value').AsString
|
|
else if Result.Element.ElType = ET_Integer then
|
|
Result.Element.elem.iVal := qry.FieldByName('Value').AsInteger
|
|
else if Result.Element.ElType = ET_Blob then
|
|
Result.Element.elem.bVal := qry.FieldByName('Value').AsAnsiString
|
|
else if Result.Element.ElType = ET_Blob64 then
|
|
Result.Element.elem.rVal := Base64DecodeString(qry.FieldByName('Value').AsAnsiString)
|
|
else if Result.Element.ElType = ET_Double then
|
|
begin
|
|
StrVal := qry.FieldByName('Value').AsString;
|
|
if TryStrToFloat(StrVal, FloatVal, FloatFormat) then
|
|
Result.Element.elem.dVal := FloatVal;
|
|
end else if Result.Element.ElType = ET_Date then
|
|
begin
|
|
StrVal := qry.FieldByName('Value').AsString;
|
|
if TryStrToFloat(StrVal, FloatVal, FloatFormat) then
|
|
Result.Element.elem.tVal := FloatVal
|
|
else if TryStrToDateTime(StrVal, DateTimeVal) then
|
|
Result.Element.elem.tVal := DateTimeVal
|
|
end else if Result.Element.ElType = ET_Time then
|
|
begin
|
|
StrVal := qry.FieldByName('Value').AsString;
|
|
if TryStrToFloat(StrVal, FloatVal, FloatFormat) then
|
|
Result.Element.elem.dtVal := FloatVal
|
|
else if TryStrToDateTime(StrVal, DateTimeVal) then
|
|
Result.Element.elem.dtVal := DateTimeVal
|
|
end else if Result.Element.ElType = ET_Bool then
|
|
Result.Element.elem.yVal := qry.FieldByName('Value').AsBoolean
|
|
else
|
|
OutputDebugString(PChar(Result.Key + ': ' + IntToStr(Integer(Result.Element.ElType))));
|
|
end;
|
|
|
|
function TSQLDatabase.RecordToReactions(var qry: TFDQuery): TReactions;
|
|
begin
|
|
Result := TReactions.Create(
|
|
qry.FieldByName('MsgID').AsLargeInt,
|
|
qry.FieldByName('ChatID').AsString,
|
|
qry.FieldByName('NotifyMsgID').AsLargeInt,
|
|
TJSONArray(TJSONObject.ParseJSONValue(qry.FieldByName('Data').AsWideString)),
|
|
qry.FieldByName('MyReaction').AsWideString
|
|
);
|
|
end;
|
|
|
|
procedure TSQLDatabase.LoadConfig;
|
|
var
|
|
qry: TFDQuery;
|
|
PrefRecs: TArray |
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT * FROM "' + dbConfig + '"';
|
|
QueryToArray |
|
for var PrefRec in PrefRecs do
|
|
MainPrefs.addPrefVal(PrefRec.Key, PrefRec.Element);
|
|
finally
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
procedure TSQLDatabase.SaveConfig;
|
|
var
|
|
qry: TFDQuery;
|
|
I: Integer;
|
|
el: TPrefElement;
|
|
DBPrefs: THashedStringList;
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
sql.StartTransaction;
|
|
DBPrefs := MainPrefs.GetDBPrefs;
|
|
try
|
|
//qry.ExecSQL('DELETE FROM "' + dbConfig + '"');
|
|
qry.SQL.Text := 'REPLACE INTO "' + dbConfig + '" VALUES (:key, :type, :val);';
|
|
qry.Params[0].DataType := TFieldType.ftString;
|
|
qry.Params[1].DataType := TFieldType.ftInteger;
|
|
qry.Params[2].DataType := TFieldType.ftBlob;
|
|
qry.Params.ArraySize := DBPrefs.Count;
|
|
for I := 0 to DBPrefs.Count - 1 do
|
|
begin
|
|
qry.ParamByName('key').AsStrings[I] := DBPrefs.KeyNames[I];
|
|
el := TPrefElement(DBPrefs.Objects[I]);
|
|
qry.ParamByName('type').AsIntegers[I] := Integer(el.ElType);
|
|
if el.ElType = ET_String then
|
|
qry.ParamByName('val').AsStrings[I] := el.elem.sVal
|
|
else if el.ElType = ET_Integer then
|
|
qry.ParamByName('val').AsIntegers[I] := el.elem.iVal
|
|
else if el.ElType = ET_Blob then
|
|
qry.ParamByName('val').AsAnsiStrings[I] := el.elem.bVal
|
|
else if el.ElType = ET_Blob64 then
|
|
qry.ParamByName('val').AsAnsiStrings[I] := Base64EncodeString(el.elem.rVal)
|
|
else if el.ElType = ET_Double then
|
|
qry.ParamByName('val').AsStrings[I] := FloatToStr(el.elem.dVal, FloatFormat)
|
|
else if el.ElType = ET_Date then
|
|
qry.ParamByName('val').AsStrings[I] := FloatToStr(el.elem.tVal, FloatFormat)
|
|
else if el.ElType = ET_Time then
|
|
qry.ParamByName('val').AsStrings[I] := FloatToStr(el.elem.dtVal, FloatFormat)
|
|
else if el.ElType = ET_Bool then
|
|
qry.ParamByName('val').AsBooleans[I] := el.elem.yVal
|
|
else
|
|
begin
|
|
OutputDebugString(PChar(DBPrefs.KeyNames[I] + ': ' + IntToStr(Integer(el.ElType))));
|
|
qry.ParamByName('val').AsStrings[I] := '';
|
|
end;
|
|
end;
|
|
if qry.Params.ArraySize > 0 then
|
|
qry.Execute(qry.Params.ArraySize);
|
|
sql.Commit;
|
|
except
|
|
sql.Rollback;
|
|
end;
|
|
qry.Free;
|
|
DBPrefs.Free;
|
|
end;
|
|
|
|
initialization
|
|
FFDGUIxSilentMode := True;
|
|
FFDGUIxProvider := 'Console';
|
|
|
|
FloatFormat := TFormatSettings.Create(LOCALE_USER_DEFAULT);
|
|
FloatFormat.DecimalSeparator := '.';
|
|
|
|
sqldrv := TFDPhysSQLiteDriverLink.Create(nil);
|
|
sqldrv.EngineLinkage := slStatic;
|
|
// sqldrv.VendorHome := ModulesPath;
|
|
// sqldrv.VendorLib := '..\sqlite3.dll';
|
|
|
|
finalization
|
|
if Assigned(sqldrv) then
|
|
FreeAndNil(sqldrv);
|
|
|
|
end.
|