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.
1642 lines
46 KiB
Plaintext
1642 lines
46 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, Generics.Collections, System.Threading,
|
|
Variants, Data.DB, FireDAC.Comp.Client, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Phys.SQLite, FireDAC.Phys.SQLiteDef,
|
|
FireDAC.Phys.SQLiteWrapper, FireDAC.DApt, FireDAC.Stan.Option, FireDAC.Stan.Def, FireDAC.Stan.Async, FireDAC.Stan.Intf,
|
|
FireDAC.ConsoleUI.Wait{, FireDAC.Moni.FlatFile},
|
|
Events, ICQCommon, Stickers;
|
|
|
|
type
|
|
TMsgID = UInt64;
|
|
TSecurityAction = (SA_CHECK, SA_ENCRYPT, SA_DECRYPT, SA_CHANGEPASS);
|
|
|
|
TSrvHist = record
|
|
LastMsgId, LastRead: TMsgID;
|
|
PatchVersion: String;
|
|
end;
|
|
|
|
TPatch = record
|
|
PatchType, PatchedText: String;
|
|
end;
|
|
|
|
TSQLDatabase = class
|
|
private
|
|
sql: TFDConnection;
|
|
sqlcontains: TFDSQLiteFunction;
|
|
sqlsec: TFDSQLiteSecurity;
|
|
sqlvalid: TFDSQLiteValidate;
|
|
procedure ContainsFunc(AFunc: TSQLiteFunctionInstance; AInputs: TSQLiteInputs; AOutput: TSQLiteOutput; var AUserData: TObject);
|
|
function OpenTable(const Table: String): Boolean;
|
|
|
|
// Conversations
|
|
procedure CreateConvTable;
|
|
procedure MigrateConvTable;
|
|
procedure OpenConvTable;
|
|
function RecordToEvent(var qry: TFDQuery): Thevent;
|
|
function QueryToEventArray(var qry: TFDQuery; var events: Thevents; inverse: Boolean = False): Boolean;
|
|
|
|
// Stickers
|
|
procedure CreateStickersTable;
|
|
procedure OpenStickersTable;
|
|
function RecordToSticker(var qry: TFDQuery): TStickerPack;
|
|
function QueryToStickersArray(var qry: TFDQuery; var stickers: TStickerPacks): Boolean;
|
|
public
|
|
function Connect: Boolean;
|
|
procedure Disconnect;
|
|
function CheckIntegrity: Boolean;
|
|
function ManageSecurity(action: TSecurityAction; const passwd: 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);
|
|
procedure WritePatch(const Chat: TUID; MsgID: TMsgID; PatchType: String);
|
|
procedure PatchEvent(const chat: TUID; ev: Thevent);
|
|
procedure WriteMsgIDs(const chat: TUID; ReqID: Integer; 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 GetAll(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 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 GetStickerPacksCount: Integer;
|
|
function GetStickerPacks(ActiveOnly: Boolean = False): TStickerPacks;
|
|
|
|
// Server history
|
|
procedure OpenSrvHistTable;
|
|
procedure CreateSrvHistTable;
|
|
procedure MigrateSrvHistTable;
|
|
procedure OpenPatchesTable;
|
|
procedure CreatePatchesTable;
|
|
procedure UpdateLastMsg(const UID: TUID; LastMsgId: TMsgID; PatchVersion: String);
|
|
procedure UpdateLastRead(const UID: TUID; LastRead: TMsgID);
|
|
function GetHistDlg(const UID: TUID): TSrvHist;
|
|
end;
|
|
|
|
TCUID = record
|
|
UID: TUID;
|
|
Pos: Integer;
|
|
end;
|
|
|
|
const
|
|
dbConv: String = 'Conversations';
|
|
dbPatches: String = 'Patches';
|
|
dbSrvHist: String = 'ServerHistory';
|
|
dbStickers: String = 'Stickers';
|
|
|
|
var
|
|
SQLDB: TSQLDatabase;
|
|
userts: TDateTime;
|
|
sqldrv: TFDPhysSQLiteDriverLink;
|
|
// trace: TFDMoniFlatFileClientLink;
|
|
taskFakeFrm: TForm;
|
|
taskDlg: TTaskDialog;
|
|
cUID: TCUID;
|
|
|
|
implementation
|
|
|
|
uses
|
|
globalLib, history, utilLib, IOUtils,
|
|
RDGlobal, RDFileUtil, RDUtils, RnQGlobal, RnQDialogs, RnQLangs, RQLog, ICQContacts;
|
|
|
|
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: Boolean;
|
|
var
|
|
params: TFDPhysSQLiteConnectionDefParams;
|
|
begin
|
|
Result := False;
|
|
if not CheckHistPass then
|
|
Exit;
|
|
|
|
userts := Now;
|
|
|
|
// 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 histcrypt.enabled then
|
|
params.Password := histcrypt.pwd;
|
|
// 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));
|
|
|
|
OpenConvTable;
|
|
OpenPatchesTable;
|
|
OpenSrvHistTable;
|
|
OpenStickersTable;
|
|
|
|
Result := True;
|
|
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 := histcrypt.pwd;
|
|
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 := histcrypt.pwd;
|
|
sqlvalid.Options := []; // Quick check, do not validate indexes
|
|
Result := sqlvalid.CheckOnly;
|
|
sqlvalid.Free;
|
|
|
|
if not Result then
|
|
messageDlg(GetTranslation('History 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; const passwd: String = ''): Boolean;
|
|
|
|
function IsEncrypted: Boolean;
|
|
begin
|
|
try
|
|
Result := not (sqlsec.CheckEncryption = ' |
|
except
|
|
Result := True;
|
|
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 := histcrypt.pwd;
|
|
Result := IsEncrypted;
|
|
sqlsec.Free;
|
|
Exit;
|
|
end;
|
|
|
|
if not CheckIntegrity then
|
|
Exit;
|
|
Disconnect;
|
|
|
|
try case action of
|
|
SA_ENCRYPT:
|
|
begin
|
|
sqlsec.Password := passwd;
|
|
sqlsec.SetPassword;
|
|
Result := True;
|
|
end;
|
|
SA_DECRYPT:
|
|
begin
|
|
sqlsec.Password := passwd;
|
|
sqlsec.RemovePassword;
|
|
Result := True;
|
|
end;
|
|
SA_CHANGEPASS:
|
|
begin
|
|
sqlsec.Password := histcrypt.pwd;
|
|
sqlsec.ToPassword := passwd;
|
|
sqlsec.ChangePassword;
|
|
Result := True;
|
|
end;
|
|
end except end;
|
|
|
|
histcrypt.enabled := IsEncrypted;
|
|
if histcrypt.enabled then
|
|
histcrypt.pwd := passwd
|
|
else
|
|
histcrypt.pwd := '';
|
|
Connect;
|
|
|
|
sqlsec.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;
|
|
|
|
procedure TSQLDatabase.OpenConvTable;
|
|
begin
|
|
if not OpenTable(dbConv) then
|
|
CreateConvTable
|
|
else
|
|
MigrateConvTable;
|
|
end;
|
|
|
|
function GetConvSchema: String;
|
|
begin
|
|
Result := 'CREATE TABLE IF NOT EXISTS "' + dbConv + '" ('
|
|
+ '"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;
|
|
|
|
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;
|
|
|
|
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.CreateConvTable;
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
sql.StartTransaction;
|
|
try
|
|
qry.ExecSQL(GetConvSchema);
|
|
qry.ExecSQL(GetConvIndex);
|
|
sql.Commit;
|
|
except
|
|
sql.Rollback;
|
|
end;
|
|
qry.Free;
|
|
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);
|
|
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);
|
|
var
|
|
qry: TFDQuery;
|
|
txt: String;
|
|
bin: TBytes;
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'SELECT * FROM "' + dbConv + '" 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 "' + dbConv + '" VALUES (:when, :kind, :chat, :who, :text, :binary, :flags, :out, :wid, :msgid)');
|
|
|
|
qry.Params[0].DataType := ftDateTime;
|
|
qry.Params[1].DataType := ftInteger;
|
|
qry.Params[2].DataType := ftString;
|
|
qry.Params[3].DataType := ftString;
|
|
qry.Params[4].DataType := ftWideString;
|
|
qry.Params[5].DataType := ftBlob;
|
|
qry.Params[6].DataType := ftInteger;
|
|
qry.Params[7].DataType := ftInteger;
|
|
qry.Params[8].DataType := ftGuid;
|
|
qry.Params[9].DataType := 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 := ftLargeint;
|
|
qry.Params[1].DataType := ftString;
|
|
qry.Params[2].DataType := ftWideString;
|
|
|
|
qry.ParamByName('msgid').AsLargeInt := MsgID;
|
|
qry.ParamByName('type').AsString := PatchType;
|
|
|
|
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;
|
|
cur: Thevent;
|
|
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 := ftWideString;
|
|
qry.Params[1].DataType := ftBlob;
|
|
qry.Params[2].DataType := ftInteger;
|
|
qry.Params[3].DataType := ftGuid;
|
|
qry.Params[4].DataType := ftString;
|
|
qry.Params[5].DataType := ftString;
|
|
qry.Params[6].DataType := 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.WriteMsgIDs(const Chat: TUID; ReqID: Integer; MsgID: TMsgID; const WID: RawByteString);
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
if wid = '' then
|
|
Exit;
|
|
|
|
qry := TFDQuery.Create(sql);
|
|
try
|
|
qry.Connection := sql;
|
|
qry.SQL.Text := 'UPDATE OR IGNORE "' + dbConv + '" SET "WID" = :wid, "MsgID" = :msgid WHERE "Chat" = :chat AND "When" >= :userts AND "MsgID" = :reqid';
|
|
qry.ParamByName('wid').AsGUID := StringToGUID('{' + wid + '}');
|
|
qry.ParamByName('msgid').AsLargeInt := MsgID;
|
|
qry.ParamByName('chat').AsString := Chat;
|
|
qry.ParamByName('userts').AsDateTime := userts;
|
|
qry.ParamByName('reqid').AsInteger := ReqID;
|
|
qry.ExecSQL;
|
|
finally
|
|
if Assigned(qry) then
|
|
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 := userts;
|
|
qry.ExecSQL;
|
|
finally
|
|
if Assigned(qry) then
|
|
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.QueryToEventArray(var qry: TFDQuery; var events: Thevents; inverse: Boolean = False): Boolean;
|
|
var
|
|
c: Integer;
|
|
begin
|
|
Result := False;
|
|
if not qry.OpenOrExecute or (qry.RecordCount = 0) then
|
|
Exit;
|
|
Result := True;
|
|
|
|
SetLength(events, qry.RecordCount);
|
|
c := 0;
|
|
|
|
if inverse then
|
|
begin
|
|
qry.Last;
|
|
while (not qry.Bof) do
|
|
begin
|
|
events[c] := RecordToEvent(qry);
|
|
Inc(c);
|
|
qry.Prior;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
qry.First;
|
|
while not qry.Eof do
|
|
begin
|
|
events[c] := RecordToEvent(qry);
|
|
Inc(c);
|
|
qry.Next;
|
|
end;
|
|
end;
|
|
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;
|
|
end;
|
|
|
|
function TSQLDatabase.QueryToStickersArray(var qry: TFDQuery; var stickers: TStickerPacks): Boolean;
|
|
var
|
|
c: Integer;
|
|
begin
|
|
Result := False;
|
|
if not qry.OpenOrExecute or (qry.RecordCount = 0) then
|
|
Exit;
|
|
Result := True;
|
|
|
|
SetLength(stickers, qry.RecordCount);
|
|
c := 0;
|
|
|
|
qry.First;
|
|
while not qry.Eof do
|
|
begin
|
|
stickers[c] := RecordToSticker(qry);
|
|
Inc(c);
|
|
qry.Next;
|
|
end;
|
|
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
|
|
if Assigned(qry) then
|
|
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
|
|
if Assigned(qry) then
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
function TSQLDatabase.GetAll(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;
|
|
QueryToEventArray(qry, Result);
|
|
finally
|
|
if Assigned(qry) then
|
|
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;
|
|
QueryToEventArray(qry, Result, True);
|
|
end;
|
|
finally
|
|
if Assigned(qry) then
|
|
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
|
|
if Assigned(qry) then
|
|
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
|
|
if Assigned(qry) then
|
|
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
|
|
if Assigned(qry) then
|
|
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 := userts
|
|
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
|
|
if Assigned(qry) then
|
|
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
|
|
if Assigned(qry) then
|
|
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;
|
|
QueryToEventArray(qry, Result, True);
|
|
finally
|
|
if Assigned(qry) then
|
|
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 QueryToEventArray(qry, Result) then
|
|
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
|
|
if Assigned(qry) then
|
|
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
|
|
if Assigned(qry) then
|
|
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
|
|
if Assigned(qry) then
|
|
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
|
|
if Assigned(qry) then
|
|
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;
|
|
QueryToEventArray(qry, Result);
|
|
finally
|
|
if Assigned(qry) then
|
|
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
|
|
if Assigned(qry) then
|
|
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
|
|
if Assigned(qry) then
|
|
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('History 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;
|
|
task: ITask;
|
|
begin
|
|
LogEvent('History: converting to SQLite');
|
|
|
|
if TDirectory.Exists(AccPath + historyPath) then
|
|
uins := TDirectory.GetFiles(AccPath + historyPath);
|
|
|
|
if Length(uins) = 0 then
|
|
Exit;
|
|
|
|
task := TTask.Create(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 := ftDateTime;
|
|
qry.Params[1].DataType := ftInteger;
|
|
qry.Params[2].DataType := ftWideString;
|
|
qry.Params[3].DataType := ftWideString;
|
|
qry.Params[4].DataType := ftWideString;
|
|
qry.Params[5].DataType := ftBlob;
|
|
qry.Params[6].DataType := ftInteger;
|
|
qry.Params[7].DataType := ftInteger;
|
|
qry.Params[8].DataType := ftGuid;
|
|
qry.Params[9].DataType := 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;
|
|
end);
|
|
task.Start;
|
|
|
|
if (Win32MajorVersion >= 6) and ThemeServices.ThemesEnabled 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 not task.Wait(100) do
|
|
Application.ProcessMessages;
|
|
end;
|
|
|
|
// Stickers
|
|
|
|
procedure TSQLDatabase.OpenStickersTable;
|
|
begin
|
|
if not OpenTable(dbStickers) then
|
|
CreateStickersTable;
|
|
end;
|
|
|
|
procedure TSQLDatabase.CreateStickersTable;
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
sql.StartTransaction;
|
|
try
|
|
qry.ExecSQL('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);');
|
|
qry.ExecSQL('CREATE UNIQUE INDEX IF NOT EXISTS "stickerid" ON "' + dbStickers + '" ("Id");');
|
|
sql.Commit;
|
|
except
|
|
sql.Rollback;
|
|
end;
|
|
qry.Free;
|
|
end;
|
|
|
|
//procedure TSQLDatabase.MigrateStickersTable;
|
|
//var
|
|
// qry: TFDQuery;
|
|
// MIQ: TFDMetaInfoQuery;
|
|
//begin
|
|
// 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 = 'StoreId' then
|
|
// begin
|
|
// MIQ.Free;
|
|
// Exit;
|
|
// end;
|
|
// MIQ.Next;
|
|
// end;
|
|
// end;
|
|
// MIQ.Free;
|
|
//
|
|
// qry := TFDQuery.Create(sql);
|
|
// qry.Connection := sql;
|
|
// sql.StartTransaction;
|
|
// try
|
|
// qry.ExecSQL('DROP TABLE "' + dbStickers + '";');
|
|
// sql.Commit;
|
|
// except
|
|
// sql.Rollback;
|
|
// end;
|
|
// qry.Free;
|
|
//
|
|
// CreateStickersTable;
|
|
//end;
|
|
|
|
procedure TSQLDatabase.ClearStickerPacks;
|
|
var
|
|
qry: TFDQuery;
|
|
txt: String;
|
|
bin: TBytes;
|
|
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;
|
|
txt: String;
|
|
bin: TBytes;
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
|
|
qry.SQL.Add('REPLACE INTO "' + dbStickers + '" VALUES (:id, :name, :purchased, :user, :priority, :count)');
|
|
|
|
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;
|
|
qry.ExecSQL;
|
|
qry.Free;
|
|
end;
|
|
|
|
procedure TSQLDatabase.ChangeStickerPackStatus(const PackId: String; Status: Boolean);
|
|
var
|
|
qry: TFDQuery;
|
|
txt: String;
|
|
bin: TBytes;
|
|
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.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
|
|
if Assigned(qry) then
|
|
FreeAndNil(qry);
|
|
end;
|
|
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 QueryToStickersArray(qry, Result) then
|
|
SetLength(Result, 0);
|
|
finally
|
|
if Assigned(qry) then
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
// Server history
|
|
|
|
procedure TSQLDatabase.OpenSrvHistTable;
|
|
begin
|
|
if not OpenTable(dbSrvHist) then
|
|
CreateSrvHistTable
|
|
else
|
|
MigrateSrvHistTable;
|
|
end;
|
|
|
|
procedure TSQLDatabase.CreateSrvHistTable;
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
sql.StartTransaction;
|
|
try
|
|
qry.ExecSQL(GetSrvHistSchema);
|
|
qry.ExecSQL(GetSrvHistIndex);
|
|
sql.Commit;
|
|
except
|
|
sql.Rollback;
|
|
end;
|
|
qry.Free;
|
|
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.CreatePatchesTable;
|
|
var
|
|
qry: TFDQuery;
|
|
begin
|
|
qry := TFDQuery.Create(sql);
|
|
qry.Connection := sql;
|
|
sql.StartTransaction;
|
|
try
|
|
qry.ExecSQL(GetPatchesSchema);
|
|
qry.ExecSQL(GetPatchesIndex);
|
|
sql.Commit;
|
|
except
|
|
sql.Rollback;
|
|
end;
|
|
qry.Free;
|
|
end;
|
|
|
|
procedure TSQLDatabase.OpenPatchesTable;
|
|
begin
|
|
if not OpenTable(dbPatches) then
|
|
CreatePatchesTable;
|
|
end;
|
|
|
|
procedure TSQLDatabase.UpdateLastMsg(const UID: TUID; LastMsgId: TMsgID; PatchVersion: String);
|
|
var
|
|
qry: TFDQuery;
|
|
txt: String;
|
|
bin: TBytes;
|
|
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;
|
|
txt: String;
|
|
bin: TBytes;
|
|
tmp: TMsgId;
|
|
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
|
|
if Assigned(qry) then
|
|
FreeAndNil(qry);
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
FFDGUIxSilentMode := True;
|
|
FFDGUIxProvider := 'Console';
|
|
|
|
sqldrv := TFDPhysSQLiteDriverLink.Create(nil);
|
|
sqldrv.VendorHome := ModulesPath;
|
|
sqldrv.VendorLib := '..\sqlite3.dll';
|
|
|
|
finalization
|
|
if Assigned(sqldrv) then
|
|
FreeAndNil(sqldrv);
|
|
|
|
end.
|