unit UnitClipDatabase;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils,  System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.FMTBcd, Data.DB, Data.SqlExpr, UnitClipQueue,
  {DISQLite3Database, }System.Generics.Collections, UnitFolderMonitor, Vcl.ExtCtrls, UnitMisc,  SQLite3Classes
  ,  UnitFrmDatabaseUpdate, System.IniFiles;


type TClipList = class(TObjectList<TClipItem>);
type TCaptionFormat = TPair<string, integer>;
type TCaptionFormatList = class(TList<TCaptionFormat>);

type
  TClipDatabase = class(TObject)
  private
    { Private declarations }
    class var
        FOLDER_NAME : string ;
        DB_NAME : string;

        DB : TSQLiteDatabase;

        newDatabase : boolean;
        user : string;
        computer : string;
        updateMode : boolean;
        conditionalBatchMode : boolean;
        existsOverride : boolean;
        version : integer;
        DateFormat : TFormatSettings;

        stPaged : TSQLiteStatement;
        stText : TSQLiteStatement;
        ciPaged : TClipItem;
        needImportInteraction : boolean;
        savedDB_NAME : string;
        alreadyCleared : boolean;

        speedMode : boolean;
        lastRawSQL : string;
        dirtyShared : boolean;
        dirtyGroups : THashedStringList;


    class function getFullPath : string;  overload;
    class function getUser: string;
    class function getComputer: string;
    class function clean(s : string) : string;
    class procedure ReadBlob(st : TSQLiteStatement; str : TStream; index : integer);
    class function getCount(whereClause : string; optionalLocation : string = '') : integer;
    class procedure OpenDatabase;
    class procedure Save(ci : TClipItem; pinned : integer; index : integer = 0 );
    class procedure Load(ci : TClipItem; index : integer; pinned : integer);
    class procedure ConditionalOpen;
    class procedure ConditionalClose;
    class procedure ConditionalStartBatch;
    class procedure ConditionalEndBatch;

    class function getVersion : integer;
    class procedure Extract(const st : TSQLiteStatement; ci : TClipItem);
    class function getFullPath(dbName : string) : string; overload;
    class function getComputerFrom(fullpath : string) : string;
    class procedure bindClip(const st : TSQLiteStatement; ci : TClipItem; pinned : integer; index : integer);
    class procedure rawExecute(const sql : string);
    class function rawQuery(const sql : string) : TSQLiteStatement;
    class procedure statementExecute(const st : TSQLiteStatement);
    class procedure sharedCheck(s : string);
    class procedure exportShared(groupname : string);
    class procedure importShared(groupname : string; includeHotkeys : boolean = true);
    class procedure transferShared(groupname : string; isImport : boolean; includeHotkeys : boolean = true);
    class procedure dirtyCheck;
  public
    { Public declarations }
    class procedure init;
    class procedure preLoad;


    class procedure vacuum;
    class procedure StartBatch; overload;
    class procedure StartBatch(dbName : string); overload;
    class procedure EndBatch;

    class function IsBusy : boolean;

    class procedure SaveQueue(q : TClipQueue);

    class procedure disableCollisionCodeOnce;

    class procedure SavePinned(ci : TClipItem);
    class procedure SaveNormal(ci : TClipItem; index : integer);
    class procedure SaveRemoved(ci : TClipITem);
    class procedure SavePermanent(ci : TClipITem; index : integer; location : string);

    class procedure LoadPinned( ci : TClipItem; index : integer);
    class procedure LoadNormal( ci : TClipItem; index : integer);
    class procedure LoadRemoved( ci : TClipItem; index : integer);
    class procedure LoadPermanent( ci : TClipItem; index : integer; location : string);
    class procedure LoadPermanentClips(cl : TClipList; location : string);
    class procedure LoadPermanentCaptionsAndTypes(sl : TCaptionFormatList; location : string);
    class procedure LoadPermanentNames(sl : TStringList; location : string);
    class procedure LoadPermanentHotkeys(sl : TStringList; location : string);

    class procedure MovePermanentClip(index : integer; location, newLocation : string);
    class procedure DeletePermanentClip(index : integer; location : string);

    class function LoadPermanentHotkey(index : integer; location : string) : string;
    class procedure SavePermanentHotkey(key : string; index : integer; location : string);

    class procedure DeleteRemoved(index : integer);

    class procedure StartAllPermanent;
    class function LoadNextPermanent(var location : string; ci : TClipItem) : boolean;
    class procedure EndAllPermanent;

    class procedure LoadPermanentGroups(sl : TStringList);
    class procedure SavePermanentGroup(location : string; index : integer);

    class procedure StartTextOnlyData(idx1, idx2 : integer; reversed : boolean); overload;
    class procedure StartTextOnlyData(reversed : boolean = false); overload;
    class function SkipNextText(count : integer) : integer;
    class function LoadNextText(var caption : string) : boolean;  overload;
    class function LoadNextText(var caption : string; var format : word) : boolean;  overload;
    class procedure EndTextOnlyData;


    class procedure StartPagedData;
    class function LoadNext(pd : TPagedData) : boolean;
    class procedure EndPagedData;

    class procedure LoadRemovedData( pd : TPagedData; index : integer);

    class procedure ClearNormal;
    class procedure ClearPinned;
    class procedure ClearPermanentGroup(location : string; removeGroup : boolean = false);
    class procedure ClearRemoved;

    class procedure DeleteOldestRemoved(count : integer = 1);


    class procedure SaveNormalTop(ci : TClipItem);

    class function getCountPinned : integer;
    class function getCountNormal : integer;
    class function getCountRemoved: integer;
    class function getCountPermanent(location : string) : integer;

    class function getSizeBytes : integer;

    class function exists: boolean;
    class function hasPermanentClips: boolean;
    class function hasPermanentGroups: boolean;
    class procedure ImportData(LoadingMessageForm : TfrmDatabaseUpdate = nil);
    class procedure remoteStorage;
    class procedure getDBNames(sl : TStringList);
    class procedure getPopupCaptions(dbName : string; sl : TStringList);
    class procedure getRemovedCaptions(dbName : string; sl : TStringList);
    class procedure getPermanentCaptions(dbName : string; sl : TStringList);
    class procedure getPopupClip(dbName : string; index : integer; ci : TClipItem);
    class procedure getRemovedClip(dbName : string; index : integer; ci : TClipItem);
    class procedure getPermanentClip(dbName : string; group : string; index : integer; ci : TClipItem);
  end;

type InstanceRecord = class(TObject)
    commandChar : char;
    commandNumb : int64;
    lastReadDB : int64;
    lastEdit : int64;
end;
type InstanceState = (IS_NONE, IS_READWAIT,IS_WRITING, IS_FOLDERCHANGE, IS_PINGWAIT);
type
    TInstanceData = class (TObject)
    private
        const
            COMMAND_NONE = ' ';
            COMMAND_PING = 'P';
            COMMAND_NEW_DB = 'N';
            COMMAND_PING_RESPONSE = 'U';
        var
            ir : InstanceRecord;
            state : InstanceState;
            readyPingCount : integer;
            timer : TTimer;
            instanceFile : string;
            readyList : TList<int64>;

        procedure ReadInstance;
        procedure TimerEvent(Sender : TObject);
    public
        constructor Create(path : string);
        procedure Ping;
        procedure deleteInstanceData;
        procedure saveInstanceData;
        procedure PingResponse;
        procedure ShareClips(dbNumber : integer);

        procedure HandleInstanceUpdate(id : TInstanceData);
        function getInstanceFileFullPath : string;
        function getState : InstanceState;
        function getLastEdit : Int64;
        function getNewDB : int64;

        function readyForDB(dbNumber : int64) : boolean;
        procedure reportDBHandled(dbNumber : int64);
    end;
type
    TGlobalClipboard = class(TObject)
    private


        class var
            id : TInstanceData;

            FOLDER_NAME : string;
            DB_NAME : string;
            dbNumber : int64;
//            instanceData : InstanceRecord;
            instanceFile : string;
            folderMonitor : TFolderMonitor;
            readyToReadDB : double;
            instances : TDictionary<string, TInstanceData>;
            DB : TSQLiteDatabase;
            newDatabase : boolean;
            user : string;
            computer : string;
            updateMode : boolean;
            existsOverride : boolean;
            version : integer;
            readyDBCount : integer;

            DateFormat : TFormatSettings;

            ignoreClipboard : boolean;
            ignoreFolderChange : boolean;
            instancePool : boolean;
            clips : TClipList;
            lastRawSQL : string;
            isCheckingInstance : boolean;
            fHasOtherListeners : boolean;
            lastSequence : Cardinal;

        class function getFullPath : string;
        class procedure OpenDatabase;
        class procedure ConditionalOpen;
        class procedure ConditionalClose;
        class procedure FolderChange(Sender : TObject);
        class procedure Save(ci : TClipItem; pinned : integer; index : integer = 0 );
        class procedure Load(ci : TClipItem; index : integer; pinned : integer);

        class procedure ImportFromCurrentDB;
        class procedure Extract(const st : TSQLiteStatement; ci : TClipItem);
        class function getCountNormal : integer;
        class function getCount(whereClause : string) : integer;
        class procedure ReadBlob(st : TSQLiteStatement; str : TStream; index : integer);
        class procedure saveClips;
        class procedure newClipboardCallback(Sender : Tobject);

        class function getTimeFrom(fullpath : string) : int64;

        class procedure setNumber(i : int64);


        class procedure handleDB(number : int64);
        class function hasOtherListeners : boolean;
        class procedure rawExecute(const sql : string);
        class function rawQuery(const sql : string) : TSQLiteStatement;
    public
        class procedure init;
        class procedure deleteInstanceData;
        class procedure JoinInstancePool;
        class procedure LeaveInstancePool;
    end;


type TSharedMetadata = class(TObject)
    private
        class var Shared : THashedStringList;
        class function getIniName : string;
    public
        class procedure init;
        class function isShared(groupname : string) : boolean;
        class procedure reportUpdated(groupname : string);
        class procedure update;
        class function isSharedDatabase(databasename : string) : boolean;
end;



implementation





uses  System.Character,

  SQLite3Constants, SQLite3Lib,
  Math, UnitFrmDebug, UnitFrmPermanentNew, System.DateUtils, System.IOUtils,
  UnitPaste, UnitFrmClipboardManager, System.Types, UnitFrmImport, StrUtils;

{$Region 'constants'}
const CURRENT_VERSION = 5;



const DB_PREFIX = 'clips';
const DB_SUFFIX = '.dat';
const DB_SHARED = 'shared';

const INSTANCE_FILTER = '*.instance';
const DB_filter = '*' + DB_SUFFIX;

const TIME_FORMAT = 'HH:mm:ss';
const DATE_FORMAT = 'yyyy-MM-dd ' + TIME_FORMAT;
const ID_PINNED = 2;
const ID_NORMAL = 1;
const ID_REMOVED = 3;
const ID_PERM = 4;

const INFO_TABLENAME = 'INFO';
const INFO_VERSION = 'INFO_VERSION';
const CREATE_TABLE_INFO =
'CREATE TABLE IF NOT EXISTS ' + INFO_TABLENAME + ' (_id INTEGER PRIMARY KEY,' +
INFO_VERSION + ' INTEGER DEFAULT 0) ';

const HOTKEY_TABLENAME = 'HOTKEY';
const HOTKEY_LOCATION = 'HOTKEY_LOCATION';
const HOTKEY_KEY = 'HOTKEY_KEY';
const HOTKEY_INDEX = 'HOTKEY_INDEX';
const CREATE_TABLE_HOTKEY =
'CREATE TABLE IF NOT EXISTS ' + HOTKEY_TABLENAME + ' (_id INTEGER PRIMARY KEY,' +
HOTKEY_LOCATION + ' STRING DEFAULT '''' ,'+
HOTKEY_KEY + ' STRING DEFAULT '''',  '+
HOTKEY_INDEX + ' INTEGER   '+
') ';


const HOTKEY2_TABLENAME = 'HOTKEY2';
const HOTKEY_CLIP_ID = 'HOTKEY_CLIP_ID';

const CREATE_TABLE_HOTKEY2 =
'CREATE TABLE IF NOT EXISTS '+HOTKEY2_TABLENAME+' (_id INTEGER PRIMARY KEY,' +
HOTKEY_KEY + ' STRING DEFAULT '''',  '+
HOTKEY_CLIP_ID  + ' INTEGER DEFAULT 0 '+
') ';

const PERMGROUPS_TABLENAME = 'PERMGROUPS';
const PERMGROUPS_INDEX = 'PERMGROUPS_INDEX';
const PERMGROUPS_LOCATION = 'PERMGROUPS_LOCATION';
const CREATE_TABLE_PERMGROUPS =
'CREATE TABLE IF NOT EXISTS '+PERMGROUPS_TABLENAME+ ' (_id INTEGER PRIMARY KEY,' +
PERMGROUPS_INDEX + ' INTEGER DEFAULT 0, ' +
PERMGROUPS_LOCATION + ' STRING ' +
') ';


const CLIP_TABLENAME= 'CLIPS';

const CLIP_PINNED = 'CLIP_PINNED';
const CLIP_LOCATION = 'CLIP_LOCATION';
const CLIP_FORMAT = 'CLIP_FORMAT';
const CLIP_HASH = 'CLIP_HASH';
const CLIP_TIMESTAMP = 'CLIP_TIMESTAMP';
const CLIP_ICONCRC = 'CLIP_ICONCRC';

const CLIP_PLAINTEXTSIZE = 'CLIP_PLAINTEXTSIZE';
const CLIP_THUMBSIZE = 'CLIP_THUMBSIZE';
const CLIP_RICHSHADOWSIZE = 'CLIP_RICHSHADOWSIZE';
const CLIP_MENUCAPTIONSIZE = 'CLIP_MENUCAPTIONSIZE';
const CLIP_ICONSIZE = 'CLIP_ICONSIZE';
const CLIP_CLIPSIZE = 'CLIP_CLIPSIZE';

const CLIP_PLAINTEXT = 'CLIP_PLAINTEXT';
const CLIP_THUMB = 'CLIP_THUMB';
const CLIP_RICHSHADOW = 'CLIP_RICHSHADOW';
const CLIP_MENUCAPTION = 'CLIP_MENUCAPTION';
const CLIP_ICON = 'CLIP_ICON';
const CLIP_CLIP = 'CLIP_CLIP';
const CLIP_INDEX = 'CLIP_INDEX';
const CREATE_TABLE_CLIPS =
'CREATE TABLE IF NOT EXISTS ' + CLIP_TABLENAME + ' (_id INTEGER PRIMARY KEY,' +
CLIP_PINNED + ' INTEGER DEFAULT 0, ' +
CLIP_LOCATION + ' STRING NOT NULL, ' +
CLIP_FORMAT + ' INTEGER NOT NULL, ' +
CLIP_HASH + ' INTEGER NOT NULL, ' +
CLIP_TIMESTAMP + ' STRING NOT NULL, ' +
CLIP_ICONCRC + ' INTEGER NOT NULL, ' +

CLIP_PLAINTEXTSIZE + ' INTEGER NOT NULL, ' +
CLIP_THUMBSIZE + ' INTEGER NOT NULL, ' +
CLIP_RICHSHADOWSIZE + ' INTEGER NOT NULL, ' +
CLIP_MENUCAPTIONSIZE + ' INTEGER NOT NULL, ' +
CLIP_ICONSIZE + ' INTEGER NOT NULL, ' +
CLIP_CLIPSIZE + ' INTEGER NOT NULL, ' +

CLIP_PLAINTEXT + ' STRING, ' +
CLIP_THUMB + ' BLOB, ' +
CLIP_RICHSHADOW + ' BLOB, ' +
CLIP_MENUCAPTION + ' STRING, ' +
CLIP_ICON + ' BLOB, ' +
CLIP_CLIP + ' BLOB, ' +
CLIP_INDEX + ' INTEGER DEFAULT 0 ' +
' )';


const CREATE_TABLE_CLIPS_FIX =
'CREATE TABLE IF NOT EXISTS ' + CLIP_TABLENAME + ' (_id INTEGER PRIMARY KEY,' +
CLIP_PINNED + ' INTEGER DEFAULT 0, ' +
CLIP_LOCATION + ' TEXT NOT NULL, ' +
CLIP_FORMAT + ' INTEGER NOT NULL, ' +
CLIP_HASH + ' INTEGER NOT NULL, ' +
CLIP_TIMESTAMP + ' STRING NOT NULL, ' +
CLIP_ICONCRC + ' INTEGER NOT NULL, ' +

CLIP_PLAINTEXTSIZE + ' INTEGER NOT NULL, ' +
CLIP_THUMBSIZE + ' INTEGER NOT NULL, ' +
CLIP_RICHSHADOWSIZE + ' INTEGER NOT NULL, ' +
CLIP_MENUCAPTIONSIZE + ' INTEGER NOT NULL, ' +
CLIP_ICONSIZE + ' INTEGER NOT NULL, ' +
CLIP_CLIPSIZE + ' INTEGER NOT NULL, ' +

CLIP_PLAINTEXT + ' TEXT, ' +
CLIP_THUMB + ' BLOB, ' +
CLIP_RICHSHADOW + ' BLOB, ' +
CLIP_MENUCAPTION + ' TEXT, ' +
CLIP_ICON + ' BLOB, ' +
CLIP_CLIP + ' BLOB, ' +
CLIP_INDEX + ' INTEGER DEFAULT 0 ' +
' )';

const CLIP_COLUMNS =
CLIP_PINNED + ' , ' +
CLIP_LOCATION + ', ' +
CLIP_FORMAT + ', ' +
CLIP_HASH + ', ' +
CLIP_TIMESTAMP + ', ' +
CLIP_ICONCRC + ', ' +

CLIP_PLAINTEXTSIZE + ', ' +
CLIP_THUMBSIZE + ', ' +
CLIP_RICHSHADOWSIZE + ', ' +
CLIP_MENUCAPTIONSIZE + ', ' +
CLIP_ICONSIZE + ', ' +
CLIP_CLIPSIZE + ', ' +

CLIP_PLAINTEXT + ', ' +
CLIP_THUMB + ', ' +
CLIP_RICHSHADOW + ', ' +
CLIP_MENUCAPTION + ', ' +
CLIP_ICON + ', ' +
CLIP_CLIP + ', ' +
CLIP_INDEX + ' ';



const ICON_TABLENAME = 'ICON';
const ICON_BLOB = 'ICON_BLOB';
const CREATE_TABLE_ICONS =
'CREATE TABLE IF NOT EXISTS ' + ICON_TABLENAME + ' (_id INTEGER PRIMARY KEY,' +
ICON_BLOB + ' BLOB )';

const CLIPBIN_TABLENAME = 'CLIPBIN';
const CLIPBIN_BLOB = 'CLIPBIN_BLOB';
const CLIPBIN_CLIP_ID = 'CLIPBIN_CLIP_ID';
const CREATE_TABLE_CLIPBIN =
'CREATE TABLE IF NOT EXISTS ' + CLIPBIN_TABLENAME + ' (_id INTEGER PRIMARY KEY,' +
CLIPBIN_CLIP_ID + ' INTEGER, '+
CLIPBIN_BLOB + ' BLOB )';

const INSERT_CLIPBIN =
'INSERT '+CLIPBIN_TABLENAME+' ('+CLIPBIN_CLIP_ID+','+CLIPBIN_BLOB+') VALUES (?,?)';




const CREATE_TABLE_CLIPS_BARE =
'CREATE TABLE IF NOT EXISTS ' + CLIP_TABLENAME + ' (_id INTEGER PRIMARY KEY,' +
CLIP_FORMAT + ' INTEGER NOT NULL, ' +
CLIP_CLIP + ' BLOB, ' +
CLIP_PLAINTEXT + ' STRING DEFAULT '''', '+
CLIP_INDEX + ' INTEGER DEFAULT 0 ' +
' )';


const CREATE_INDEX =
'CREATE INDEX IF NOT EXISTS ?1_IDX ON ?2(?3)';

const INSERT_CLIP =
'INSERT INTO CLIPS (' +
CLIP_PINNED + ', ' +
CLIP_LOCATION + ', ' +
CLIP_FORMAT + ', ' +
CLIP_HASH + ', ' +
CLIP_TIMESTAMP + ', ' +
CLIP_ICONCRC + ', ' +

CLIP_PLAINTEXTSIZE + ', ' +
CLIP_THUMBSIZE + ', ' +
CLIP_RICHSHADOWSIZE + ', ' +
CLIP_MENUCAPTIONSIZE + ', ' +
CLIP_ICONSIZE + ', ' +
CLIP_CLIPSIZE + ', ' +

CLIP_PLAINTEXT + ', ' +
CLIP_THUMB + ', ' +
CLIP_RICHSHADOW + ', ' +
CLIP_MENUCAPTION + ', ' +
CLIP_ICON + ', ' +
CLIP_CLIP + ', ' +
CLIP_INDEX + ' ' +
' ) values (?,?,?,?,?,?, ?,?,?,?,?,?, ?,?,?,cast(? as TEXT),?,?,?) ';

const INSERT_CLIP_BARE =
'INSERT INTO CLIPS (' +
CLIP_FORMAT + ', ' +
CLIP_CLIP + ', ' +
CLIP_INDEX + ', ' +
CLIP_PLAINTEXT + ' ' +
' ) values (?,?,?,?) ';


const CLIP_GET_COLUMNS =
CLIP_LOCATION + ', ' +
CLIP_FORMAT + ', ' +
CLIP_HASH + ', ' +
CLIP_TIMESTAMP + ', ' +
CLIP_ICONCRC + ', ' +

CLIP_PLAINTEXTSIZE + ', ' +
CLIP_THUMBSIZE + ', ' +
CLIP_RICHSHADOWSIZE + ', ' +
CLIP_MENUCAPTIONSIZE + ', ' +
CLIP_ICONSIZE + ', ' +
CLIP_CLIPSIZE + ', ' +

CLIP_PLAINTEXT + ', ' +
CLIP_THUMB + ', ' +
CLIP_RICHSHADOW + ', ' +
CLIP_MENUCAPTION + ', ' +
CLIP_ICON;

const GET_CLIP   =
'SELECT ' +
CLIP_GET_COLUMNS + ', ' +
CLIP_CLIP + ' ' +
'FROM ' + CLIP_TABLENAME + ' ';
{$EndRegion}

type
    cliphelper = class helper for TClipItem
public
    procedure setFormat(format : word);
    procedure createRichShadow;
end;
procedure cliphelper.setFormat(format : word);
begin
    self.cformat := self.FileFormatToFormat(format);
end;
procedure cliphelper.createRichShadow;
begin
    self.RichShadowMemory := TMemoryStream.create;
end;



class function TClipDatabase.IsBusy : boolean;
begin
    result := DB <> nil;
end;

class function TClipDatabase.getSizeBytes : integer;
var fs : TFileStream;
begin
    fs := TFileStream.Create(self.getfullPath,fmShareDenyNone);
    result := fs.size;
    myfree(fs);
end;

class procedure TClipDatabase.vacuum;
var
    p : PSQLite3;
    astr : PUTF8Char;
    i : integer;
begin
    astr := nil;
    sqlite3lib.sqlite3_open16(getFullPath, p);
    i := sqlite3lib.sqlite3_exec(p,'VACUUM;',nil,nil,astr);
    sqlite3_close(p);

    if (astr<>nil) then begin
        showmessage(astr);
    end;
end;
class function TClipDatabase.rawQuery(const sql : string) : TSQLiteStatement;
begin
    lastRawSQL := sql;
    result := DB.Query(sql);
end;
class procedure TClipDatabase.rawExecute(const sql : string);
begin
    lastRawSQL := sql;
    DB.Execute(sql);
end;
class procedure TClipDatabase.statementExecute(const st : TSQLiteStatement);
var
    ok : boolean;
    i : integer;
    ex : Exception;
    msg : string;
const MAX_ATTEMPTS = 10;
begin
    ok := false;
    i := 0;
    while not ok and (i<MAX_ATTEMPTS) do begin
        try
            st.Execute;
            ok := true;
        except on e : Exception do begin
            msg := e.Message;
            mysleep(50);
            FrmDebug.AppendLog('SQL st ERR: ' + e.message);
        end;
        end;
        inc(i);
    end;

    if not ok then begin
        ex := Exception.Create(msg);
        raise  ex;
    end;
end;


class procedure TClipDatabase.OpenDatabase;
    function replace(s : string; index : integer; param : string) : string;
    begin
        result := StringReplace(s,'?'+IntToStr(index),param,[rfIgnoreCase, rfReplaceAll]);
    end;
    procedure version0;
    var s : string;
    begin
        DB.StartTransaction;
        rawExecute(CREATE_TABLE_CLIPS);
        s := replace(s, 1, CLIP_TIMESTAMP);
        s := replace(s, 2, CLIP_TABLENAME);
        s := replace(s, 3, CLIP_TIMESTAMP);
        rawExecute(s);


        s := CREATE_INDEX;
        s := replace(s, 1, CLIP_LOCATION);
        s := replace(s, 2, CLIP_TABLENAME);
        s := replace(s, 3, CLIP_LOCATION);
        rawExecute(s);

        s := CREATE_INDEX;
        s := replace(s, 1, CLIP_HASH);
        s := replace(s, 2, CLIP_TABLENAME);
        s := replace(s, 3, CLIP_HASH);
        rawExecute(s);

        s := CREATE_INDEX;
        s := replace(s, 1, CLIP_INDEX);
        s := replace(s, 2, CLIP_TABLENAME);
        s := replace(s, 3, CLIP_INDEX);
        rawExecute(s);
        DB.EndTransaction;
    end;
    procedure version1_2;
    var s : string;
    begin
        DB.StartTransaction;
        rawExecute(CREATE_TABLE_HOTKEY);
        rawExecute(CREATE_TABLE_PERMGROUPS);
        rawExecute(CREATE_TABLE_HOTKEY2);

        s := CREATE_INDEX;
        s := replace(s, 1, HOTKEY_CLIP_ID);
        s := replace(s, 2, HOTKEY2_TABLENAME);
        s := replace(s, 3, HOTKEY_CLIP_ID);
        rawExecute(s);
        DB.EndTransaction;
    end;


var st : TSQLiteStatement;
    s : string;
    newDB : boolean;
    openOK : boolean;
    i : integer;

const MAX_ATTEMPTS = 5;
begin
    try
        db := TSQLiteDatabase.Create(getFullPath, SQLite3Classes.TSQLiteOpenMode.readWrite);
        i := 0;
        while (db.ReadOnly) and (i<MAX_ATTEMPTS) do begin
            db.Free;
            db := TSQLiteDatabase.Create(getFullPath, SQLite3Classes.TSQLiteOpenMode.readWrite);
            frmDebug.AppendLog('DB = ReadOnly error');
            inc(i);
        end;
        newDB := false;
        if (db.ReadOnly) then begin
            ShowMessage('Database file is locked by another program.');
            ExitProcess(1);
        end;
    except on e : ESQLiteError do
        begin
            case e.getCode of
            SQLITE_CANTOPEN: begin
                try
                    DB := TSQLiteDatabase.Create(getFullPath, SQLite3Classes.TSQLiteOpenMode.createAsNeeded);
                    rawExecute('PRAGMA page_size = 8192');
                    newDB := true;
                except
                    begin
                        ShowMessage('Error: Unable to create database.'#13#10'ArsClip requires write permission to the local folder');
                        ExitProcess(1);
                    end;
                end;
            end;
            SQLITE_READONLY:
                begin
                    i := 0;
                    while (i < 10) do begin

                        openOK := false;
                        try
                            db := TSQLiteDatabase.Create(getFullPath, SQLite3Classes.TSQLiteOpenMode.readWrite);
                            openOK := true;
                        except on e : ESQLiteError
                            do begin
                                // TODO
                            end;
                        end;
                        if openOK then BREAK;

                        sleep(100);
                        inc(i);
                    end;

                    if (i>=10) then begin
                        ShowMessage('Cannot open database for writing. Quiting.');
                        Application.Terminate;
                    end;
                end;

            else begin
                FrmDebug.AppendLog('Cannot open DB code='+IntToSTr(e.getCode));
            end;
            end;
        end;
     on E: Exception do begin
            ShowMessage(e.ToString);
        end;
    end;



{causes an error (but not in debug mode), so can't use}
//    if (speedMode) then begin
//        rawExecute('PRAGMA journal_mode=MEMORY');
//    end else begin
//        rawExecute('PRAGMA journal_mode=DELETE');
//    end;


    if (newDB) then begin
        version0;
        version1_2;
    end else begin
    end;

//    rawExecute('PRAGMA synchronous=NORMAL');
end;

class procedure TClipDatabase.ReadBlob(st : TSQLiteStatement; str : TStream; index : integer);
var
    size : integer;
    p : pointer;
begin

    size := st.cursor.ColumnSize[index];
    if (size=0) then EXIT;

    st.Cursor.ColumnToStream(index, str);
//    GetMem(p, size);
//    CopyMemory(p, st.cursor.ColumnAsBlob[index], size );
//    str.write(p^, size);
//    FreeMem(p);
    str.Position := 0;
end;
class procedure TClipDatabase.bindClip(const st : TSQLiteStatement; ci : TClipItem; pinned : integer; index : integer);
var
    p : pointer;
    procedure BindBlob(str : TStream; index : integer);
    var
        p : Pointer;
        size : integer;
    begin
        size := str.Size;
        str.Seek(0, soFromBeginning);

        p := TMemoryStream(str).Memory;
        st.SetParamBlob(index, p,size, true);
    end;
    procedure UnbindBlob;
    begin
        FreeMem(p);
    end;
var
    fm : integer;
    sdate : string;
    pin: integer;
    plainTextSize : integer;
    thumbSize : integer;
    richShadowSize : integer;
    menuCaptionSize : integer;
    iconSize : integer;
    clipSize : integer;
    thumb : TMemoryStream;
    clipStr : TStream;
    iconStr : TStream;
    richStr : TStream;
    hash : integer;

    function SQLiteStringTypeIssue(s : string) : string;
    const
        nobreak_space = char($00A0);
    begin
        result := s;
//        if s <> '' then begin
//            if s[length(s)] <> nobreak_space then begin
//                result := s + nobreak_space;
//            end;
//        end;
    end;
begin
    fm := ci.GetFormat;
    if (fm = UnitMisc.GetCF_RICHTEXT) then begin
        fm := CF_FILE_RICHTEXT;
    end else if (fm = UnitMisc.GetCF_HTML ) then begin
        fm := CF_FILE_HTML;
    end;
    sdate :=  FormatDateTime('yyyy-MM-dd HH:mm:ss', ci.CData.GetCreationDate);

    st.param[1] := pinned;
    st.param[2] := computer;
    st.param[3] := fm;
    hash := ci.CData.Hash; // Cardinal triggers range check error
    st.param[4] := hash;
    st.param[5] := sdate;
    hash := UnitMisc.IconCRC(ci.CData.GetHICONAbsolute);
    st.param[6] := hash;


    plainTextSize := 0;
    thumbSize := 0;
    richShadowSize := 0;
    menuCaptionSize := length(ci.cdata.displaytext) * SizeOf(char);
    iconSize := 0;
    clipSize := 0;
    if ci.GetFormat <> CF_UNICODETEXT then
            plaintextSize := length(ci.GetAsPlaintext) * SizeOf(char);
    thumb := nil;
    if ci.CData.thumb <> nil then begin
        thumb := TMemoryStream.create;
        ci.CData.thumb.SaveToStream(thumb);
    end;
    if thumb <> nil then
            thumbSize := thumb.Size;

    clipStr := ci.GetStream;
    clipSize := clipStr.Size;

    if (ci.HasRichShadow) then begin
        richStr := ci.GetRichStream;
        richShadowSize := richStr.Size;
    end;
    if ci.CData.GetHICONAbsolute <> 0 then begin
        iconStr := TMemoryStream.Create;
        ci.SaveIconToStream(iconStr);
        iconStr.Position := 0;
        iconSize := iconStr.size;
        if iconStr.Size = SizeOf(cardinal) * 2 then begin
            myfree(iconStr);
            iconSize := 0;
        end;
    end;

    st.param[7] := plainTextSize;
    st.param[8] := thumbSize;
    st.param[9] := richShadowSize;
    st.param[10] := menuCaptionSize;
    st.param[11] := iconSize;
    st.param[12] := clipSize;


    if (plainTextSize<>0) then begin
        st.param[13] := ci.GetAsPlaintext;
    end else begin
        st.param[13] := '';
    end;
    if (thumbSize<>0) then begin
        BindBlob(thumb, 14);
        MyFree(thumb);
    end else begin
        st.param[14] := null;
    end;
    if (richShadowSize<>0) then begin
        BindBlob(richStr, 15);
    end else begin
        st.param[15] := null;
    end;
    st.param[16] := SQLiteStringTypeIssue(ci.CData.displaytext);
    if (iconSize<>0) then begin
        BindBlob(iconStr, 17);
        MyFree(iconStr);
    end else begin
        st.param[17] := null;
    end;
    BindBlob(clipstr, 18);

    st.param[19] := index;
end;
class procedure TClipDatabase.StartBatch;
begin
    if (db <> nil) then begin
        FrmDebug.EmergencyDump;
        ShowMessage('Error: StartBatch detected a database issue.'#13#10+
        'Terminating program to protect data');
        Application.Terminate;
        EXIT
    end;

    updateMode := true;
    dirtyShared := false;
    dirtyGroups.Clear;
    savedDB_NAME := '';
    TClipDatabase.OpenDatabase;
    Db.StartTransaction;
end;

class procedure TClipDatabase.StartBatch(dbName : string);
var s : string;
begin
    s := DB_NAME;
    DB_NAME := DB_PREFIX+dbName+DB_SUFFIX;
    StartBatch;
    savedDB_NAME := s;
end;
class procedure TClipDatabase.disableCollisionCodeOnce;
begin
    alreadyCleared := true;
end;

class procedure TClipDatabase.EndBatch;
var i : integer;
begin
    updateMode := false;
    DB.EndTransaction;
    myfree(DB);

    if (savedDB_NAME <> '') then begin
        DB_NAME := savedDB_NAME;
    end;

    DirtyCheck;
end;

class procedure TClipDatabase.SaveQueue(q : TClipQueue);
var
    i : integer;
//    st : TDISQLite3Statement;
    st : TSQLiteStatement;
    ci : TClipItem;
    pinned : integer;
    b : boolean;
    s : string;
    procedure ClearExisting;
    begin
        if (q is TPinnedClipQueue) then begin
            pinned := ID_PINNED;
            TClipDatabase.ClearPinned;
        end else begin
            pinned := ID_NORMAL;
            TClipDatabase.ClearNormal;
        end;
    end;
begin
    if (q=nil) then begin
        FrmDebug.AppendLog('Wow, SaveQueue called with nil');
        ShowMessage('Missing Clip list - Terminating.');
        Application.Terminate;
        EXIT;
    end;
    if (q.GetQueueCount=0) then begin
        ClearExisting;
        EXIT;
    end;


    speedMode := true;
    ConditionalStartBatch;

    ClearExisting;

    for i := 0 to q.GetQueueCount-1 do begin
        st := rawQuery(INSERT_CLIP);
        ci := q.GetClipItem(i);
        bindClip(st, ci, pinned, i);
        try
            statementExecute(st);
        finally
            st.Free;
        end;

    end;

    ConditionalEndBatch;
    speedMode := false;
end;


class procedure TClipDatabase.ConditionalOpen;
begin
    if (updateMode) then EXIT;
    TClipDatabase.OpenDatabase;
    dirtyShared := false;
    dirtyGroups.Clear;
end;
class procedure TClipDatabase.ConditionalClose;
begin
    if (updateMode) then begin
        EXIT;
    end;
    myfree(DB);
    DirtyCheck;
end;
class procedure TClipDatabase.ConditionalStartBatch;
begin
    conditionalBatchMode := false;
    if not UpdateMode then begin
        TClipDatabase.StartBatch;
        conditionalBatchMode := true;
    end;
end;
class procedure TClipDatabase.ConditionalEndBatch;
begin
    if conditionalBatchMode then begin
        TClipDatabase.EndBatch;
        conditionalBatchMode := false;
    end;
end;


class function TClipDatabase.getFullPath : string;
begin
    result := getFullPath(DB_NAME);
end;
class function TClipDatabase.getFullPath(dbName : string) : string;
begin
    result := IncludeTrailingPathDelimiter(UnitMisc.GetAppPath) +
        IncludeTrailingPathDelimiter(FOLDER_NAME) + dbName;
end;
class function TClipDatabase.exists: boolean;
var fullpath : string;
begin
    result := FileExists(getFullPath) and (not existsOverride);
end;

class procedure TClipDatabase.SavePinned(ci : TClipItem);
begin
    TClipDatabase.save(ci, ID_PINNED);
end;
class procedure TClipDatabase.SaveNormal(ci : TClipItem; index :integer);
begin
    TClipDatabase.save(ci, ID_NORMAL, index);
end;
class procedure TClipDatabase.SaveRemoved(ci : TClipITem);
begin
    TClipDatabase.save(ci, ID_REMOVED);
end;
class procedure TClipDatabase.SaveNormalTop(ci : TClipItem);
var
    s : string;
begin
    TClipDatabase.StartBatch;

    s := 'update '+CLIP_TABLENAME+' set '+CLIP_INDEX+' = '+CLIP_INDEX+' + 1 ' +
    ' where CLIP_PINNED = ID_NORMAL ';
    rawExecute(s);
    TClipDatabase.SaveNormal(ci, 0);

    TClipDatabase.EndBatch;
end;
class procedure TClipDatabase.SavePermanent(ci : TClipITem; index : integer; location : string);
var s : string;
begin
    s := computer;
    computer := location;
    TClipDatabase.sharedCheck(location);
    TClipDatabase.save(ci, ID_PERM, index);
    computer := s;
end;


class procedure TClipDatabase.LoadPinned(ci : TClipItem; index : integer);
begin
    TClipDatabase.Load(ci,index,ID_PINNED);
end;
class procedure TClipDatabase.LoadNormal( ci : TClipItem; index : integer);
begin
    TClipDatabase.Load(ci,index,ID_NORMAL);
end;
class procedure TClipDatabase.LoadRemoved( ci : TClipItem; index : integer);
begin
    TClipDatabase.Load(ci,index,ID_REMOVED);
end;
class procedure TClipDatabase.LoadPermanent( ci : TClipItem; index : integer; location : string);
var s : string;
begin
    s := computer;
    computer := location;
    TClipDatabase.Load(ci,index,ID_PERM);

    if ci is TPermanentClipItem then begin
        TPermanentClipItem(ci).DetectClipType;
    end;

    computer := s;
end;

class procedure TClipDatabase.SavePermanentHotkey(key : string; index : integer; location : string);
var
    s, id : string;
//    st : TDISQLite3Statement;
    st : TSQLiteStatement;
begin
    TClipDatabase.ConditionalOpen;

    s := 'select _id from '+CLIP_TABLENAME+'  '+
    '     where '+CLIP_LOCATION+' = ? ' +
    ' and '+CLIP_INDEX+' = ' + IntToSTr(index) + ' '  +
    ' and '+CLIP_PINNED+' = '+IntToStr(ID_PERM);

    st := rawQuery(s);
    st.Param[1] := location;

    st.Cursor.Next;
    id := IntToSTr(st.cursor.ColumnAsInteger[0]);
    st.free;



    s := 'delete from '+HOTKEY2_TABLENAME+' ' +
    ' where '+HOTKEY_CLIP_ID+' = '+id;
    rawExecute(s);

    s := 'insert into '+HOTKEY2_TABLENAME+' ('+HOTKEY_KEY+', ' +HOTKEY_CLIP_ID+') ' +
    ' values (?, ' +id+')';

    st := rawQuery(s);
    st.Param[1] := key;

    st.Cursor.Next;
    st.free;


    TClipDatabase.sharedCheck(location);

    TClipDatabase.ConditionalClose;
end;
class function  TClipDatabase.LoadPermanentHotkey(index : integer; location : string) : string;
var
    st : TSQLiteStatement;
    s : string;
begin
    TClipDatabase.ConditionalOpen;

     s := 'select '+HOTKEY_KEY+' from '+HOTKEY2_TABLENAME+', '+CLIP_TABLENAME + ' '+
    ' where '+CLIP_LOCATION+' = ? ' +
    ' and '+CLIP_INDEX+' = ' + IntToSTr(index) + ' '+
    ' and '+HOTKEY_CLIP_ID+' = '+CLIP_TABLENAME+'._id';

    st := rawQuery(s);
    st.Param[1] := location;
    result := '';
    if (st.cursor.Next) then begin
        result := st.Cursor.ColumnAsString[0];
    end;
    st.free;

    TClipDatabase.COnditionalClose
end;
//class procedure TClipDatabase.LoadPermanentHotkeys(sl : TStringList; location : string);
//var
//    s : string;
//    st : TSQLiteStatement;
//begin
//    TClipDatabase.ConditionalOpen;
//
//    s := 'select '+HOTKEY_KEY+' from '+HOTKEY2_TABLENAME +', '+CLIP_TABLENAME+
//    ' where '+CLIP_LOCATION +' = '''+location+''' AND '+CLIP_TABLENAME+'._id = '+HOTKEY_CLIP_ID+' '+
//    ' order by '+CLIP_INDEX;
//
//
//    st := rawQuery(s);
//    while (st.cursor.Next) do begin
//        sl.Add( st.Cursor.ColumnAsString[0] );
//    end;
//    st.Free;
//    TClipDatabase.COnditionalClose;
//end;
class procedure TClipDatabase.LoadPermanentNames(sl : TStringList; location : string);
var
    s : string;
    st : TSQLiteStatement;
begin
    TClipDatabase.ConditionalOpen;
    s := 'select '+CLIP_MENUCAPTION+' from '+CLIP_TABLENAME+' where '+CLIP_LOCATION+' = ?  and '+CLIP_PINNED+'='+IntToStr(ID_PERM)+' ' +
    ' order by '+CLIP_INDEX+' ';

    st := rawQuery(s);
    st.Param[1] := location;
    while (st.cursor.Next) do begin
        sl.Add( st.cursor.ColumnAsString[0] );
    end;
    st.free;
    TClipDatabase.COnditionalClose;
end;
class procedure TClipDatabase.LoadPermanentClips(cl : TClipList; location : string);
var
    s : string;
    st : TSQLiteStatement;
    ci : TPermanentClipItem;
begin
    TClipDatabase.ConditionalOpen;

    s := GET_CLIP +
    ' WHERE '+CLIP_LOCATION+' = ? '+
    ' AND '+CLIP_PINNED+' = ' + IntToStr(ID_PERM) + ' ORDER BY '+CLIP_INDEX;


    st := rawQuery(s);
    st.Param[1] := location;

    cl.Clear;
    cl.OwnsObjects := true;
    while (st.cursor.Next) do begin
        ci := TPermanentClipItem.Create;
        TClipDatabase.Extract(st, ci);
        cl.Add(ci);
    end;

    st.free;
    TClipDatabase.COnditionalClose;
end;
class procedure TClipDatabase.LoadPermanentCaptionsAndTypes(sl : TCaptionFormatList; location : string);
var
    s : string;
    st : TSQLiteStatement;
    ci : TClipItem;
begin
    TClipDatabase.ConditionalOpen;
    s := 'select ' + CLIP_MENUCAPTION+','+CLIP_FORMAT+' from '+CLIP_TABLENAME+' where '+CLIP_LOCATION+' = ? order by '+CLIP_INDEX;
    st := rawQuery(s);
    st.Param[1] := location;

    ci := TClipITem.Create;
    while (st.Cursor.Next) do begin
        ci.setFormat(st.Cursor.ColumnAsInteger[1]);
        sl.Add(TCaptionFormat.Create(st.Cursor.ColumnAsString[0], Integer(ci.GetFormatType)));
    end;

    st.free;
    ci.Free;
    LogTimeStart;
    TClipDatabase.ConditionalClose;
end;

class procedure TClipDatabase.LoadPermanentHotkeys(sl : TStringList; location : string);
var
    s : string;
    val : string;
    st : TSQLiteStatement;
begin
     TClipDatabase.ConditionalOpen;

    s := 'select '+HOTKEY_KEY+','+CLIP_MENUCAPTION+' from '+CLIP_TABLENAME+' LEFT OUTER JOIN  '+HOTKEY2_TABLENAME +
    ' ON '+CLIP_TABLENAME+'._id = '+HOTKEY_CLIP_ID+' '+ ' where '+CLIP_LOCATION +' = ? and CLIP_PINNED= '+IntToStr(ID_PERM)+' '+
    ' order by '+CLIP_INDEX;

    st := rawQuery(s);
    st.Param[1] := location;
    while (st.cursor.Next) do begin
        val :=  st.Cursor.ColumnAsString[0];
        sl.Add( val );
    end;
    st.Free;
    TClipDatabase.COnditionalClose;
end;


class procedure TClipDatabase.MovePermanentClip(index : integer; location, newLocation : string);
var s, hotkey : string;
    cnt, idx : integer;
    st : TSQLiteStatement;
begin
    cnt := getCountPermanent(newLocation);

    ConditionalOpen;
    s := 'select _id from '+CLIP_TABLENAME+
    ' where '+CLIP_LOCATION+' = ? AND '+CLIP_PINNED+' = ' + IntToStr(ID_PERM) + ' '+
    ' order by '+CLIP_INDEX+' limit 1 offset ' + IntToStr(index);
    st := rawQuery(s);
    st.Param[1] := location;
    st.cursor.Next;
    idx := st.cursor.ColumnAsInteger[0];
    st.Free;


    s := 'update '+CLIP_TABLENAME+' set '+CLIP_LOCATION+' = ? , '+
    ' '+CLIP_INDEX+' = '+IntToStr(cnt)+' ' +
    ' where _id ='+IntToStr(idx);
    st := rawQuery(s);
    st.Param[1] := newLocation;
    st.Cursor.Next;
    st.Free;


    s := 'update '+CLIP_TABLENAME+' set '+CLIP_INDEX+' = '+CLIP_INDEX+' - 1 ' +
    ' where '+CLIP_PINNED+' = '+IntToStr(ID_PERM)+' '+
    ' AND '+CLIP_LOCATION+' = ? AND '+CLIP_INDEX+' > '+IntToStr(index);
    st := rawQuery(s);
    st.Param[1] := location;
    st.Cursor.Next;
    st.Free;

    TClipDatabase.sharedCheck(location);
    TClipDatabase.sharedCheck(newLocation);

    ConditionalClose;

    // TODO - handle case of moving shared to shared!
end;
class procedure TClipDatabase.DeletePermanentClip(index : integer; location : string);
var
    s : string;
    b : boolean;
    st : TSQLiteStatement;
begin
    ConditionalStartBatch;

    s := 'delete from '+CLIP_TABLENAME+' where '+CLIP_PINNED+' = '+IntToStr(ID_PERM)+' '+
    ' AND '+CLIP_LOCATION+' = ? AND '+CLIP_INDEX+' = '+IntToSTr(index);
    st := rawQuery(s);
    st.Param[1] := location;
    st.Cursor.Next;
    st.Free;

    s := 'update '+CLIP_TABLENAME+' set '+CLIP_INDEX+' = '+CLIP_INDEX+' - 1 ' +
    ' where '+CLIP_PINNED+' = '+IntToStr(ID_PERM)+' '+
    ' AND '+CLIP_LOCATION+' = ? AND '+CLIP_INDEX+' > '+IntToStr(index);
    st := rawQuery(s);
    st.Param[1] := location;
    st.Cursor.Next;
    st.Free;

    TClipDatabase.sharedCheck(location);
    ConditionalEndBatch;
end;


class procedure TClipDatabase.ClearPermanentGroup(location : string; removeGroup : boolean = false);
var
    s, idlist : string;
    b : boolean;
    ids : TStringList;
    st : TSQLiteStatement;
label EXIT_CODE;
begin
    ConditionalStartBatch;


    s := 'select _id from '+CLIP_TABLENAME+' where '+CLIP_PINNED+' = '+IntToStr(ID_PERM)+' '+
    ' and '+CLIP_LOCATION+' = ? ';

    st := rawQuery(s);
    st.Param[1] := location;
    while (st.cursor.Next) do begin
        if (idlist ='') then begin
            idList := IntToStr(st.cursor.ColumnAsInteger[0]);
        end else begin
            idlist := idlist + ','+IntToStr(st.cursor.ColumnAsInteger[0])
        end;
    end;
    myfree(st);
    if idlist='' then goto EXIT_CODE;

    idlist := '('+idlist+')';
    s := 'delete from '+CLIP_TABLENAME+' where _id in '+idlist;
    rawExecute(s);
    s := 'delete from '+HOTKEY2_TABLENAME+' where '+HOTKEY_CLIP_ID+' in '+idlist;
    rawExecute(s);

EXIT_CODE:
    if removeGroup then begin
        s := 'delete from '+PERMGROUPS_TABLENAME+' where '+PERMGROUPS_LOCATION+' = ? ';
        st := rawQuery(s);
        st.Param[1] := location;
        statementExecute(st);
        myfree(st);
    end;
    ConditionalEndBatch;
end;

class procedure TClipDatabase.DeleteRemoved(index : integer);
var
    s : string;
    st : TSQLiteStatement;
begin
    TClipDatabase.ConditionalOpen;

    s := ' select _id from '+CLIP_TABLENAME+' ';
    s := s+ ' WHERE '+CLIP_PINNED+' = ' + IntToStr(ID_REMOVED);
    s := s + ' ORDER BY datetime('+ CLIP_TIMESTAMP + ') DESC ';
    s := s + ' LIMIT 1 OFFSET ' + IntToStr(index);

    st := rawQuery(s);
    st.cursor.Next;

    s := ' DELETE FROM '+CLIP_TABLENAME+' '+
    ' WHERE _ID = ' + IntToStr(st.Cursor.ColumnAsInteger[0]);
    st.Free;
    rawExecute(s);

    TClipDatabase.COnditionalClose;
end;

class procedure TClipDatabase.LoadRemovedData( pd : TPagedData; index : integer);
var
    s : string;
    st : TSQLiteStatement;
    ci : TClipITem;
    stream : TMemoryStream;
begin
    TClipDatabase.ConditionalOpen;

    s := 'SELECT '+CLIP_MENUCAPTION+', '+CLIP_PLAINTEXT+', '+CLIP_ICON+', '+
    CLIP_TIMESTAMP+', '+CLIP_FORMAT+ ', ' + CLIP_ICONCRC + ' ' +
    'FROM '+CLIP_TABLENAME+' ' +
    'WHERE '+CLIP_LOCATION+' = ? ' +
    ' AND '+CLIP_PINNED+' = '+IntToStr(ID_REMOVED)+' ' +
    ' ORDER BY datetime('+CLIP_TIMESTAMP+') DESC ' +
    ' LIMIT 1 OFFSET ' + IntToStr(index+1);

    st := rawQuery(s);
    st.Param[1] := computer;
    st.cursor.Next;
    ci := TClipItem.Create;
    pd.AsText := st.cursor.ColumnAsString[0];
    if (pd.AsText = '') then begin
        pd.AsText := st.cursor.ColumnAsString[1];
    end;

    ci.setFormat(st.cursor.ColumnAsInteger[4]);
    pd.FormatType :=  ci.GetFormatType;
    try
       pd.FileDate := StrToDateTime(st.cursor.ColumnAsString[3],DateFormat);
    except

    end;

    stream := TMemoryStream.Create;
    ReadBlob(st, stream, 2);
    if (stream.Size<>0) then  begin
        try
            ci.LoadIcons(stream, st.cursor.ColumnAsInteger[5]);
        except

        end;
    end;
    pd.icon := ci.CData.GetHICON;
    myfree(ci);

    st.free;
    TClipDatabase.ConditionalClose;
end;


class procedure TClipDatabase.LoadPermanentGroups(sl : TStringList);
var
    s : string;
    st : TSQLiteStatement;
begin
    TClipDatabase.ConditionalOpen;

    s := 'SELECT '+PERMGROUPS_LOCATION+' FROM '+PERMGROUPS_TABLENAME+' ' +
    ' ORDER BY ' +PERMGROUPS_LOCATION + ' COLLATE NOCASE ';
    st := rawQuery(s);

    while (st.cursor.Next) do begin
        sl.Add( st.cursor.ColumnAsString[0] );
    end;

    st.free;
    TClipDatabase.COnditionalClose;
end;
class procedure TClipDatabase.SavePermanentGroup(location : string; index : integer);
var
    s : string;
    st : TSQLiteStatement;
begin
    TClipDatabase.ConditionalOpen;

    s := 'INSERT INTO '+PERMGROUPS_TABLENAME+' ('+PERMGROUPS_INDEX+', '+PERMGROUPS_LOCATION+') VALUES ' +
    ' ('+IntToStr(index)+', ?)';

    st := rawQuery(s);
    st.Param[1] := location;
    statementExecute(st);
    myfree(st);
    TClipDatabase.COnditionalClose;
end;

class procedure TClipDatabase.StartAllPermanent;
begin

end;
class function  TClipDatabase.LoadNextPermanent(var location : string; ci : TClipItem) : boolean;
begin

end;
class procedure TClipDatabase.EndAllPermanent;
begin

end;

class procedure TClipDatabase.Extract(const st : TSQLiteStatement; ci : TClipItem);
var
    i : integer;
    iconcrc : cardinal;
    plainTextSize : integer;
    thumbSize : integer;
    richShadowSize : integer;
    menuCaptionSize : integer;
    iconSize : integer;
    clipSize : integer;

    ms : TMemoryStream;
    s : string;

    procedure readHeader;
    begin
        ci.setFormat( st.cursor.ColumnAsInteger[1] );
        ci.CData.Hash := st.cursor.ColumnAsInteger[2];
        ci.CData.settimestamp( StrToDateTime(st.cursor.ColumnAsString[3], DateFormat) );
        iconcrc := st.cursor.ColumnAsInteger[4];
    end;
    procedure readSizes;
    begin
        plainTextSize := st.cursor.ColumnAsInteger[5];
        thumbSize := st.cursor.ColumnAsInteger[6];
        richShadowSize := st.cursor.ColumnAsInteger[7];
        menuCaptionSize := st.cursor.ColumnAsInteger[8];
        iconSize := st.cursor.ColumnAsInteger[9];
        clipSize := st.cursor.ColumnAsInteger[10];
        ci.CData.setSize(clipSize);
    end;

begin
    readHeader;
    readSizes;

    if (plainTextSize<>0) then begin
        ci.CData.SetString(st.cursor.ColumnAsString[11]);
    end;
    if (thumbSize<>0) then begin
        ms := TMemoryStream.Create;
        ReadBlob(st, ms,12);
        ci.CData.thumb := TBitmap.Create;
        ci.CData.thumb.LoadFromStream(ms);
        myfree(ms);
    end;
    if (st.cursor.ColumnSize[13]<>0) then begin
        ci.createRichShadow;
        ms := TMemoryStream(ci.GetRichStream);
        ReadBlob(st, ms, 13);
    end;
    ci.CData.displaytext := st.cursor.ColumnAsString[14];
    if (iconSize <> 0) then begin
        if not ci.TryGetIcon(iconCRC) then begin
            ms := TMemoryStream.Create;
            ReadBlob(st, ms, 15);
            try
                ci.LoadIcons(ms, iconCRC);
            except
                iconSize := 0;
                iconCRC := 0;
                ci.cdata.SetHICON(0);
            end;
            MyFree(ms);
        end
    end;
    if (clipSize<>0) then begin
        LogTimeStart;
        ms := TMemoryStream(ci.GetStream);
        readBlob(st, ms,16);
    end;
end;


class procedure TClipDatabase.StartTextOnlyData(reversed : boolean = false);
var s : string;
begin
    StartBatch;

    s := 'SELECT '+CLIP_MENUCAPTION+','+CLIP_FORMAT+
    ' FROM '+CLIP_TABLENAME+' ' +
    'WHERE '+CLIP_PINNED+' = '+IntToStr(ID_REMOVED)+' '+
    ' ORDER BY datetime('+CLIP_TIMESTAMP+') ';
    if (reversed) then begin
        s := s + ' ASC ';
    end else begin
        s := s + ' DESC ';
    end;

    stText := rawQuery(s);
end;
class procedure TClipDatabase.StartTextOnlyData(idx1, idx2 : integer; reversed : boolean);
var
    s : string;
begin
    StartBatch;

    s := 'SELECT '+CLIP_MENUCAPTION+','+CLIP_FORMAT+
    ' FROM '+CLIP_TABLENAME+' ' +
    'WHERE '+CLIP_PINNED+' = '+IntToStr(ID_REMOVED)+' '+
    ' ORDER BY datetime('+CLIP_TIMESTAMP+') ';

    if (reversed) then begin
        s := s + ' ASC ';
    end else begin
        s := s + ' DESC ';
    end;
    s := s + ' limit '+IntToStr((idx2-idx1)+1)+' offset ' +IntToStr(idx1);
    stText := rawQuery(s);
end;
class function  TClipDatabase.SkipNextText(count : integer) : integer;
begin
    while (count>0) and (stText.cursor.Next) do begin
        dec(count);
    end;

    result := count;
end;
class function  TClipDatabase.LoadNextText(var caption : string) : boolean;
var f : word;
begin
    result := self.LoadNextText(caption, f)
end;
class function TClipDatabase.LoadNextText(var caption : string; var format : word) : boolean;
var
    st : TMemoryStream;
    i : integer;
    ci : TClipItem;
begin
    result := false;
    if (not stText.cursor.next) then EXIT;

    caption := stText.cursor.ColumnAsString[0];
    ci := TClipItem.Create;
    ci.setFormat(stText.Cursor.ColumnAsInteger[1]);
    format := ci.GetFormat;
    myfree(ci);
    result := true;
end;
class procedure TClipDatabase.EndTextOnlyData;
begin
    stText.Free;
    EndBatch;
end;

class procedure TClipDatabase.StartPagedData;
var
    s : string;
begin
    TClipDatabase.StartBatch;

    s := 'SELECT '+CLIP_MENUCAPTION+', '+CLIP_PLAINTEXT+', '+CLIP_ICON+', '+
    CLIP_TIMESTAMP+', '+CLIP_FORMAT+ ', ' + CLIP_ICONCRC + ' ' +
    'FROM '+CLIP_TABLENAME+' ' +
//    'WHERE '+CLIP_LOCATION+' = '''+computer+ ''' ' +
    ' WHERE '+CLIP_PINNED+' = '+IntToStr(ID_REMOVED)+' ' +
    ' ORDER BY datetime('+CLIP_TIMESTAMP+') DESC ';

    stPaged := rawQuery(s);
    ciPaged := TClipItem.Create;
end;
class function  TClipDatabase.LoadNext(pd : TPagedData) : boolean;
var
    stream : TMemoryStream;
begin
    result := stPaged.cursor.next;
    if (not result) then EXIT;


    pd.AsText := stPaged.cursor.ColumnAsString[0];
    if (pd.AsText = '') then begin
        pd.AsText := stPaged.cursor.ColumnAsString[1]
    end;

    ciPaged.setFormat(stPaged.cursor.ColumnAsInteger[4]);
    pd.FormatType :=  ciPaged.GetFormatType;
    try
       pd.FileDate := StrToDateTime(stPaged.cursor.ColumnAsString[3], dateformat);
    except
    end;

    stream := TMemoryStream.Create;
    ReadBlob(stPaged, stream, 2);
    if (stream.Size<>0) then  begin
        try
            ciPaged.LoadIcons(stream, stPaged.cursor.ColumnAsInteger[5]);
        except
        end;
    end;
    pd.icon := ciPaged.CData.GetHICON;
end;
class procedure TClipDatabase.EndPagedData;
begin
    myfree(ciPaged);
    stPaged.free;
    TClipDatabase.EndBatch;
end;

class procedure TClipDatabase.Save(ci : TClipItem; pinned : integer;  index : integer = 0  );
var
    st : TSQLiteStatement;
    s : string;

    procedure reportError(errMessage : string);
    begin
        ShowMessage(
            'Unable to save to database. Debug info added debug log'#13#10+
            #13#10 +
            errMessage
        );
    end;
    procedure cleanup;
    begin
        st.Free;
        TClipDatabase.ConditionalClose;
    end;
begin
    TClipDatabase.ConditionalOpen;


    try
    if not (alreadyCleared) then begin
        alreadyCleared := false;
        case pinned of
            ID_NORMAL, ID_PINNED: begin
                s := 'DELETE FROM ' + CLIP_TABLENAME +
                ' where '+CLIP_PINNED+' = ' + IntToStr(pinned) +
                ' and '+CLIP_INDEX+' = ' + IntToStr(index);
                rawExecute(s);
            end;
            ID_PERM: begin
                s := 'DELETE FROM ' + CLIP_TABLENAME +
                ' where '+CLIP_INDEX+' = ' + IntToStr(index) +
                ' and '+CLIP_LOCATION+' = ? ' +
                ' and '+CLIP_PINNED+' = ' + IntToStr(pinned);
                st := rawQuery(s);
                st.Param[1] := computer;
                st.Cursor.Next;
                st.Free;
            end;
        end;
    end;
    except on e:  Exception do begin
        TClipDatabase.ConditionalClose;
        FrmDebug.AppendLog('TClipDatabase.Save : ' + e.Message);
        FrmDebug.AppendLog('TClipDatabase.lastRawSQL : ' + lastRawSQL);
        reportError(e.Message);
        EXIT;
    end;
    end;

    st := rawQuery(INSERT_CLIP);
    bindClip(st,ci,pinned,index);
    try
        statementExecute(st);
    except on e:  Exception do begin
        FrmDebug.AppendLog('TClipDatabase.Save : ' + e.Message);
        FrmDebug.AppendLog('TClipDatabase.lastRawSQL : ' + lastRawSQL);
        reportError(e.Message);
    end;
    end;
    cleanup;
end;
class procedure TClipDatabase.Load( ci : TClipItem; index : integer; pinned : integer );
var
    s : string;
    st : TSQLiteStatement;
    e : Exception;
begin
    try
        e := nil;
        TClipDatabase.ConditionalOpen;

        s := GET_CLIP;
        s := s + ' WHERE '+CLIP_PINNED+' = ' + IntToStr(pinned);
        case pinned of
            ID_PINNED,
            ID_NORMAL
            : begin
                s := s + ' AND '+CLIP_INDEX+' = ' + IntToStr(index);
            end;
            ID_PERM: begin
                s := s + ' AND '+CLIP_LOCATION+' = ? ';
                s := s + ' AND '+CLIP_INDEX+' = ' + IntToStr(index);
            end;
            ID_REMOVED: begin
                s := 'select _id from '+CLIP_TABLENAME+' WHERE '+CLIP_PINNED+' = ' + IntToStr(pinned);
                s := s + ' ORDER BY datetime('+ CLIP_TIMESTAMP + ') DESC ';
                s := s + ' LIMIT 1 OFFSET ' + IntToStr(index);
                st := rawQuery(s);
                st.Cursor.Next;

                s := GET_CLIP;
                s := s + ' WHERE _id = '+IntToStr(st.cursor.ColumnAsInteger[0]);
                st.Free;
            end;
        end;


        st := rawQuery(s);
        case pinned of
        ID_PERM: begin
            st.Param[1] := computer;
        end;
        end;
        if (not st.cursor.Next) then begin
            //  TODO: do some real error reporting
            e := Exception.Create('Cannot load clip from database');
            EXIT;
        end;

        TClipDatabase.Extract(st, ci);

    finally

        st.free;

        TClipDatabase.ConditionalClose;

        if assigned(e) then begin
            raise e;
        end;
    end;
end;


class procedure TClipDatabase.ClearPinned;
var s : string;
begin
    try
        TClipDatabase.ConditionalOpen;

        s := 'DELETE FROM '+CLIP_TABLENAME+' where '+CLIP_PINNED+' = ' + IntToStr(ID_PINNED);
        rawExecute(s);

    finally
        TClipDatabase.ConditionalClose;
    end;
end;
class procedure TClipDatabase.ClearNormal;
var s : string;
begin
    try
        TClipDatabase.ConditionalOpen;

        s := 'DELETE FROM '+CLIP_TABLENAME+' where '+CLIP_PINNED+' = ' + IntToStr(ID_NORMAL);
        rawExecute(s);
    finally
        TClipDatabase.ConditionalClose;
    end;
end;
class procedure TClipDatabase.ClearRemoved;
var s : string;
begin
    try
        TClipDatabase.ConditionalOpen;

        s := 'DELETE FROM '+CLIP_TABLENAME+' where '+CLIP_PINNED+' = ' + IntToStr(ID_REMOVED);
        rawExecute(s);
    finally
        TClipDatabase.ConditionalClose;
    end;
end;
class procedure TClipDatabase.DeleteOldestRemoved(count : integer = 1);
var s : string;
    st : TSQLiteStatement;
    b : boolean;
begin
    try
        ConditionalStartBatch;

        s := 'SELECT _ID FROM '+CLIP_TABLENAME+
        ' where '+CLIP_PINNED+' = ' + IntToStr(ID_REMOVED) +
        ' order by _ID LIMIT ' + IntToStr(count);
        st := rawQuery(s);
        while (st.Cursor.Next) do begin
            s := 'delete from '+CLIP_TABLENAME+' where _ID = ' + IntToStr(st.cursor.ColumnAsInteger[0]);
            rawExecute(s);
        end;
        st.free;
    finally
        ConditionalEndBatch;
    end;
end;

class function TClipDatabase.getCount(whereClause : string; optionalLocation : string = '') : integer;
var
    st : TSQLiteStatement;
begin
    try
        TClipDatabase.ConditionalOpen;
        st := rawQuery(
            'select count(_id) from '+CLIP_TABLENAME+' ' +
            whereClause
            );
        if optionalLocation <> '' then begin
            st.Param[1] := optionalLocation;
        end;

        result := 0;
        if (st.cursor.Next) then begin
            result := st.cursor.ColumnAsInteger[0];
        end;
    finally
        st.free;
        TClipDatabase.ConditionalClose;
    end;
end;
class function TClipDatabase.getCountPinned : integer;
begin
    result := TClipDatabase.getCount(' WHERE '+CLIP_PINNED+' = ' + IntToSTr(ID_PINNED) );
end;
class function TClipDatabase.getCountNormal : integer;
begin
    result := TClipDatabase.getCount(' WHERE '+CLIP_PINNED+' = ' + IntToSTr(ID_NORMAL) );
end;
class function TClipDatabase.getCountRemoved: integer;
begin
    result := TClipDatabase.getCount(' WHERE '+CLIP_PINNED+' = ' + IntToSTr(ID_REMOVED) );
end;
class function TClipDatabase.getCountPermanent(location : string) : integer;
begin
    result := TClipDatabase.getCount(
        ' WHERE '+CLIP_PINNED+' = ' + IntToSTr(ID_PERM) + ' ' +
        ' and '+CLIP_LOCATION+' = ? ', location
        );
end;



class function TClipDatabase.getVersion : integer;
var
    st : TSQLiteStatement;
    s : string;
begin

    ConditionalOpen;
    result := 0;
    try
        rawExecute(CREATE_TABLE_INFO);
    except
        ShowMessage('Database may be corrupted. Terminating.');
        Application.Terminate;
        EXIT;
    end;
    s := 'SELECT '+INFO_VERSION+' from '+INFO_TABLENAME;
    st := rawQuery(s);

    if (st.Cursor.Next) then begin
        result := st.cursor.ColumnAsInteger[0];
        st.free;
    end else begin
        st.free;
        s := 'INSERT INTO '+INFO_TABLENAME+' ('+INFO_VERSION+') VALUES (0)';
        rawExecute(s);
    end;
    COnditionalClose;
end;


class function TClipDatabase.hasPermanentClips: boolean;
begin
    result := version > 0;
end;
class function TClipDatabase.hasPermanentGroups: boolean;
begin
    result := version > 1;
end;

class function TClipDatabase.getComputer: string;
var
    buffer: array[0..MAX_PATH-1] of char;
    size : cardinal;
begin
    result := 'error_computer';
    size := MAX_PATH;
    if GetComputerName(buffer, size) then begin
        result := TClipDatabase.clean( string(buffer) );
    end;
end;
class function TClipDatabase.getUser: string;
var
    buffer : array[0..MAX_PATH-1] of char;
    size : cardinal;
begin
    result := 'error_user';
    size := MAX_PATH;
    if GetUserName(buffer, size) then begin
        result := TClipDatabase.clean( string(buffer) );
    end;
end;
class function TClipDatabase.clean(s : string) : string;
var i : integer;
begin
     result := '';
     for i := 1 to length(s) do begin
         if TCharacter.IsLetterOrDigit(s[i])  then
            result := result + s[i];
     end;
end;


class procedure TClipDatabase.init;
var
    defaultName,
    path, dbpath : string;
    dbs : TStringDynArray;
    st : TSQLiteStatement;



begin
    version := 0;
    needImportInteraction := false;

    FOLDER_NAME := 'clipdatabase';
    DB_NAME := DB_PREFIX + DB_SUFFIX;
    defaultName := getFullPath(DB_NAME);

    dirtyGroups := THashedStringList.Create;

    DB := nil;


    dateformat := TFormatSettings.Create();
    dateformat.LongDateFormat :=  DATE_FORMAT;
    dateformat.ShortDateFormat := DATE_FORMAT;
    dateformat.ShortTimeFormat := TIME_FORMAT;
    dateformat.LongTimeFormat := TIME_FORMAT;
    DateFormat.TimeSeparator := ':';
    DateFormat.DateSeparator := '-';

    user := TClipDatabase.getUser;
    computer := TClipDatabase.getComputer;
    DB_NAME := DB_PREFIX+ computer +DB_SUFFIX;
    newDatabase :=  not TClipDatabase.exists;
    path := ExtractFilePath(TClipDatabase.getFullPath);
    if (newDatabase) then begin
        if (not DirectoryExists(path)) then
            ForceDirectories(path);
    end;
    if (UnitMisc.IsUSB) then begin
        //  single instance database for USB drives
        DB_NAME := DB_PREFIX + DB_SUFFIX;

        // detect when a local install was copied to a USB drive
        // use that DB instaed of the default
        dbs := TDirectory.GetFiles(path, DB_filter);
        case length(dbs) of
        1: DB_NAME := ExtractFileName(dbs[0]);
        end;
    end else if (UnitMisc.IsRemote) then begin
        // remote instance - start with copy of original
        if FileExists(defaultName) and not FileExists(getFullPath) then begin
            CopyFile(PChar(defaultName), PChar(getFullPath), true);
        end;
    end else begin
        // may be cloud synced, use separate DBs

        dbs := TDirectory.GetFiles(path, DB_filter);
        if (not FileExists(getFullPath)) then begin
            if Length(dbs) = 1 then begin
                // detect when a default DB is needed
                if not FileExists(getFullPath(DB_PREFIX+DB_SUFFIX)) then begin
                    CopyFile(PChar(dbs[0]),PChar(getFullPath(DB_PREFIX+DB_SUFFIX)), false);
                end;
            end;

            // TODO: Rethink this case
            // new individual DB - copy the default, if exists
            if FileExists(getFullPath(DB_PREFIX+DB_SUFFIX)) then begin
//                CopyFile(PChar(getFullPath(DB_PREFIX+DB_SUFFIX)), PChar(getFullPath), false);
            end;

            needImportInteraction := length(dbs) > 0;
        end;
    end;

    // can't create the DB until the initial import is done
    if (TClipDatabase.exists) then  begin
        version := TClipDatabase.getVersion;
    end;
end;

class procedure TClipDatabase.preLoad;
    procedure FixPermIndexes;
    var
        idxs : array of integer;
        ids : array of integer;
        sl : TStringList;
        i,j, cnt : integer;
        s : string;
        st : TSQLiteStatement;
    begin
        sl := TStringList.Create;
        TClipDatabase.LoadPermanentGroups(sl);
        for i := 0 to sl.Count-1 do begin
            cnt := TClipDatabase.getCountPermanent(sl[i]);
            if cnt > 0 then begin
                SetLength(idxs, cnt);
                SetLength(ids, cnt);

                s := 'select ' + CLIP_INDEX + ',_id'  +' from ' + CLIP_TABLENAME +
                ' where ' + CLIP_LOCATION + '= ?  and ' + CLIP_PINNED + ' = ' + IntToStr(ID_PERM) +
                ' order by ' + CLIP_INDEX;
                TClipDatabase.ConditionalOpen;
                st := rawQuery(s);
                st.Param[1] := sl[i];
                j := 0;
                while (st.cursor.Next) do begin
                    idxs[j] := st.cursor.ColumnAsInteger[0];
                    ids[j] := st.Cursor.ColumnAsInteger[1];
                    inc(j);
                end;
                st.free;
                TClipDatabase.ConditionalClose;


                s := '';
                for j := 0 to cnt-1 do begin
                    if idxs[j] <> j then begin
                        s := s + 'update '+CLIP_TABLENAME + ' set ' + CLIP_INDEX +'='+IntToStr(j)+
                        ' where _id = ' + IntToStr(ids[j]) + ';';
                    end;
                end;
                if s <> '' then begin
                    TClipDatabase.ConditionalOpen;
                    rawExecute(s);
                    TClipDatabase.ConditionalClose;
                end;

                SetLength(idxs, 0);
                SetLength(ids, 0);


            end;
        end;
        myfree(sl);
    end;
begin
    case version of
    4 : FixPermIndexes;
    end;
end;

class procedure TClipDatabase.remoteStorage;
var
    path : string;
    i : integer;
begin
    for path in  TDirectory.GetFiles(ExtractFilePath(getFullPath), DB_filter) do begin
    end;
end;
class procedure TClipDatabase.ImportData;
var i : integer;
    ci : TClipItem;
    s, dbPath : string;
    sl : TStringList;
    timeStart : Cardinal;

    procedure ShowLoadingForm;
    begin
       LoadingMessageForm.MyShow;
    end;
    procedure StartTime;
    begin
        timeStart := Winapi.Windows.GetTickCount;
    end;
    function isTimeTrigger : boolean;
    begin
        result := Winapi.Windows.GetTickCount - timestart > 800;
    end;
    procedure TimeCheck;
    begin
        if isTimeTrigger then begin
            ShowLoadingForm;
        end;
    end;
    procedure setVersion(version : integer);
    var
        s : string;
    begin
        s := 'UPDATE '+INFO_TABLENAME+' set '+INFO_VERSION+' = ' + IntToStr(version);
        rawExecute(s);
    end;
    procedure ImportDataPermanent;
    var
        i, j : integer;
        itemtext, hotkey : string;
        location : string;
        ci : TClipItem;
    begin
        existsOverride := true;
        FrmPermanent.PermFolderPush;
        for i:= 0 to FrmPermanent.PermFoldersGetCount-1 do begin
            FrmPermanent.SetPermanentGroup(i);
            location := FrmPermanent.GetPermanentPath;

            for j := 0 to FrmPermanent.GetCount-1 do begin
                itemtext := FrmPermanent.GetItemText(j);
                ci := FrmPermanent.GetItemClip(j);
                ci.CData.displaytext := FrmPermanent.GetItemName(j);
                hotkey := FrmPermanent.GetHotkey(j);

                TClipDatabase.SavePermanent(ci, j, location);
                TClipDatabase.SavePermanentHotkey(hotkey,j, location);

                myFree(ci);

                TimeCheck;
            end;
        end;
        FrmPermanent.PermFolderPop;
        existsOverride := false;
    end;
    procedure ImportPermanentGroups;
    var i : integer;
    begin
        for i:=0 to FrmPermanent.PermFoldersGetCount-1 do begin
            TClipDatabase.SavePermanentGroup( FrmPermanent.PermFoldersGetItem(i) ,i);
            TimeCheck;
        end;
    end;
    procedure FixHotkeys;
    var
        groups, clipids, keyids : TStringList;
        s, group, id : string;
        st, st2 : TSQLiteStatement;
        i : integer;
    begin
        groups := TStringList.Create;
        clipids := TStringList.Create;
        keyids := TStringList.Create;



        s := 'select '+HOTKEY_LOCATION+' from '+HOTKEY_TABLENAME+' group by '+HOTKEY_LOCATION;
        st := rawQuery(s);
        while (st.cursor.Next) do begin
            groups.Add(st.cursor.ColumnAsString[0] );
        end;
        st.free;

        for group in groups do begin
            s := 'select _id from '+CLIP_TABLENAME+' '+
            ' where '+CLIP_LOCATION+' = '''+group+''' '+
            ' order by '+CLIP_INDEX;
            st := rawQuery(s);

            clipids.Clear;
            while (st.cursor.Next) do begin
                clipids.Add(IntToStr(st.cursor.ColumnAsInteger[0]))
            end;
            st.free;

            s := 'select '+HOTKEY_KEY+' from '+HOTKEY_TABLENAME+' '+
            ' where '+HOTKEY_LOCATION+' = '''+group+''' '+
            ' order by '+HOTKEY_INDEX;
            st := rawQuery(s);
            keyids.Clear;
            while (st.cursor.Next) do begin
                s := st.cursor.ColumnAsString[0];
                if (s='0') then begin
                    s := '';
                end;
                keyids.Add(s);
            end;
            st.free;

            for i:=0 to keyids.Count-1 do begin
                if (i < clipids.Count) then begin
                    s := 'insert into '+HOTKEY2_TABLENAME+' '+
                    '('+HOTKEY_CLIP_ID+','+HOTKEY_KEY+') values ('+clipids[i]+','''+keyids[i]+''')';
                    rawExecute(s);
                end;
            end;
        end;
    end;
    procedure FixClipsTable;
    var
        s : string;
        const COLUMN_LIST =   '_id, '+
            CLIP_PINNED + ' , ' +
            CLIP_LOCATION + ', ' +
            CLIP_FORMAT + ' , ' +
            CLIP_HASH + ' , ' +
            CLIP_TIMESTAMP + ' , ' +
            CLIP_ICONCRC + ' , ' +

            CLIP_PLAINTEXTSIZE + ' , ' +
            CLIP_THUMBSIZE + ' , ' +
            CLIP_RICHSHADOWSIZE + ' , ' +
            CLIP_MENUCAPTIONSIZE + ' , ' +
            CLIP_ICONSIZE + ' , ' +
            CLIP_CLIPSIZE + ' , ' +

            CLIP_PLAINTEXT + ' , ' +
            CLIP_THUMB + ' , ' +
            CLIP_RICHSHADOW + ' , ' +
            CLIP_MENUCAPTION + ' , ' +
            CLIP_ICON + ' , ' +
            CLIP_CLIP + ' , ' +
            CLIP_INDEX + '  ';

    begin
        s := 'ALTER TABLE ' + CLIP_TABLENAME + ' RENAME to ' + 'TEMP_CLIPS';
        rawExecute(s);

        rawExecute(CREATE_TABLE_CLIPS_FIX);
        timeCheck;

        s := 'insert into ' + CLIP_TABLENAME + '('+COLUMN_LIST+' )' +
            ' select '+COLUMN_LIST + ' from TEMP_CLIPS ';
        rawExecute(s);
        timeCheck;

        s := 'drop table TEMP_CLIPS';
        rawExecute(s);
        timeCheck;
    end;
    procedure FixClipsIndexes;
        function replace(s : string; index : integer; param : string) : string;
        begin
            result := StringReplace(s,'?'+IntToStr(index),param,[rfIgnoreCase, rfReplaceAll]);
        end;
    var s : string;
    begin
        // the "FixClipsTable" didn't recreate the indexes
        s := CREATE_INDEX;
        s := replace(s, 1, CLIP_LOCATION);
        s := replace(s, 2, CLIP_TABLENAME);
        s := replace(s, 3, CLIP_LOCATION);
        rawExecute(s);

        s := CREATE_INDEX;
        s := replace(s, 1, CLIP_HASH);
        s := replace(s, 2, CLIP_TABLENAME);
        s := replace(s, 3, CLIP_HASH);
        rawExecute(s);

        s := CREATE_INDEX;
        s := replace(s, 1, CLIP_INDEX);
        s := replace(s, 2, CLIP_TABLENAME);
        s := replace(s, 3, CLIP_INDEX);
        rawExecute(s);
    end;


var
    compName : string;
    needsVacuum : boolean;
begin
    if (needImportInteraction) then begin
        sl := TStringList.create;
        TClipDatabase.getDBNames(sl);

        FrmImport.showFrom(sl);
        dbPath := FrmImport.getResult;
        if (dbPath<>'') then begin
            dbPath := getFullPath(DB_PREFIX + dbPath + DB_SUFFIX);
            CopyFile(PChar(dbPath),PChar(getFullPath),false);
            version := TClipDatabase.getVersion;
            frmClipboardManager.ReloadHistory;
        end;
    end else begin
        if (not TClipDatabase.exists) then begin
            try
                TClipDatabase.StartBatch;
                existsOverride := true;

                for i := 0 to PinnedClipQueue.GetQueueCount-1 do begin
                    TClipDatabase.SavePinned(PinnedClipQueue.GetClipItem(i));
                end;

                for i := 0 to ClipQueue.GetQueueCount-1 do begin
                    TClipDatabase.SaveNormal(ClipQueue.GetClipItem(i), i);
                end;


                for i := 0 to RemovedQueue.GetQueueCount-1 do begin
                    ci := RemovedQueue.GetItemClip(i);
                    if ci.GetStream.Size <> 0 then begin
                        TClipDatabase.SaveRemoved(ci);
                    end;
                    myfree(ci);
                end;

                existsOverride := false;
                TClipDatabase.EndBatch;
            except
                begin
                    ShowMessage('Error: Unable to create database.'#13#10' ArsClip requires write permission to the local folder');
                    Application.Terminate;
                end;
            end;
        end;
    end;

    try
        TClipDatabase.StartBatch;
        needsVacuum := false;
        StartTime;

        version := TClipDatabase.getVersion;
        while (version < CURRENT_VERSION) do begin
            timeCheck;

            case (version) of
                0: begin
                    ImportDataPermanent;
                    setVersion(1);
                end;
                1: begin
                    ImportPermanentGroups;
                    setVersion(2);
                end;
                2: begin
                    FixHotkeys;
                    setVersion(3);
                end;
                3: begin
                    FixClipsTable;
                    setVersion(4);
                    needsVacuum := true;
                end;
                4: begin
                    FixClipsIndexes;
                    setVersion(5);
                end;
            end;
            inc(version);
        end;
        TClipDatabase.EndBatch;




    except on e : Exception do
    begin
        FrmDebug.AppendLog('TClipDataBase.Import : '+e.ToString);
        FrmDebug.AppendLog('TClipDatabase.lastRawSQL : ' + lastRawSQL);
        DB.CancelTransaction;
    end;
    end;

    if needsVacuum then begin
        ShowLoadingForm;
        vacuum;
    end;
    if (LoadingMessageForm.Visible) then
            LoadingMessageForm.Hide;
end;

class function  TClipDatabase.getComputerFrom(fullpath : string) : string;
begin
    fullpath := ExtractFileName(fullpath);
    fullpath := StringReplace(fullpath,DB_PREFIX,'',[]);
    fullpath := StringReplace(fullpath,DB_SUFFIX,'',[]);
    result := fullpath;
end;
class procedure TClipDatabase.getDBNames(sl : TStringList);
var
    s : string;
    compName : string;
begin
    for s in TDirectory.GetFiles(ExtractFilePath(getFullPath),DB_filter) do begin
        compName := getComputerFrom(s);
        if (
            (compName <> '')
            and (compName <> Self.getComputer)
            and (compName <> DB_SHARED)
        ) then
            sl.Add(compName);
    end;
end;
class procedure TClipDatabase.getPopupCaptions(dbName : string; sl : TStringList);
var
    computerBak : string;
    s : string;
    st : TSQLiteStatement;
begin
    computerBak := DB_NAME;
    DB_NAME := DB_PREFIX+dbName+DB_SUFFIX;

    ConditionalOpen;
    s := ' select '+CLIP_MENUCAPTION+' from '+CLIP_TABLENAME+' '+
    ' where '+CLIP_PINNED+' = '+IntToSTr(ID_NORMAL)+ ' ' +
    ' order by '+CLIP_INDEX;
    st := rawQuery(s);

    while (st.cursor.Next) do begin
        sl.Add( st.cursor.ColumnAsString[0] );
    end;
    st.Free;
    ConditionalClose;

    DB_NAME := computerBak;
end;
class procedure TClipDatabase.getRemovedCaptions(dbName : string; sl : TStringList);
var
    computerBak : string;
    s : string;
    st : TSQLiteStatement;
begin
    computerBak := DB_NAME;
    DB_NAME := DB_PREFIX+dbName+DB_SUFFIX;

    ConditionalOpen;
    s := ' select '+CLIP_MENUCAPTION+' from '+CLIP_TABLENAME+' '+
    ' where '+CLIP_PINNED+' = '+IntToSTr(ID_REMOVED)+ ' ' +
    ' ORDER BY datetime('+ CLIP_TIMESTAMP + ') DESC ';
    st := rawQuery(s);

    while (st.cursor.Next) do begin
        sl.Add( st.cursor.ColumnAsString[0] );
    end;
    st.Free;
    ConditionalClose;

    DB_NAME := computerBak;
end;
class procedure TClipDatabase.getPermanentCaptions(dbName : string; sl : TStringList);
var
    computerBak : string;
    s : string;
    st : TSQLiteStatement;
begin
    computerBak := DB_NAME;
    DB_NAME := DB_PREFIX+dbName+DB_SUFFIX;

    ConditionalOpen;
    s := ' select '+CLIP_MENUCAPTION+','+CLIP_LOCATION+' from '+CLIP_TABLENAME+' '+
    ' where '+CLIP_PINNED+' = '+IntToSTr(ID_PERM)+ ' ' +
    ' ORDER BY '+CLIP_LOCATION+' COLLATE NOCASE, '+CLIP_INDEX + '  ';
    st := rawQuery(s);

    while (st.cursor.Next) do begin
        sl.Add( st.cursor.ColumnAsString[1]+': '+st.cursor.ColumnAsString[0] );
    end;
    st.Free;
    ConditionalClose;

    DB_NAME := computerBak;
end;
class procedure TClipDatabase.getPopupClip(dbName : string; index : integer; ci : TClipItem);
var
    computerBak : string;
    s : string;
begin
    computerBak := DB_NAME;
    DB_NAME := DB_PREFIX+dbName+DB_SUFFIX;

    LoadNormal(ci, index);

    DB_NAME := computerBak;
end;
class procedure TClipDatabase.getRemovedClip(dbName : string; index : integer; ci : TClipItem);
var
    computerBak : string;
    s : string;
begin
    computerBak := DB_NAME;
    DB_NAME := DB_PREFIX+dbName+DB_SUFFIX;

    LoadRemoved(ci, index);

    DB_NAME := computerBak;
end;
class procedure TClipDatabase.getPermanentClip(dbName : string; group : string; index : integer; ci : TClipItem);
var
    computerBak : string;
    s : string;
begin
    computerBak := DB_NAME;
    DB_NAME := DB_PREFIX+dbName+DB_SUFFIX;

    LoadPermanent(ci,index,group);

    DB_NAME := computerBak;
end;

class procedure TClipDatabase.sharedCheck(s : string);
begin
    if DB_NAME = DB_PREFIX+DB_SHARED+DB_SUFFIX then EXIT;

    if TSharedMetadata.isShared(s) and (dirtyGroups.IndexOf(s) = -1) then begin
        dirtyShared := true;
        dirtyGroups.Add(s);
    end;
end;
class procedure TClipDatabase.exportShared(groupname : string);
begin
    if TClipDatabase.DB_NAME = DB_SHARED then EXIT;

    transferShared(groupname, false);
end;
class procedure TClipDatabase.importShared(groupname : string;includeHotkeys : boolean = true);
begin
    transferShared(groupname, true);
end;
class procedure TClipDatabase.transferShared(groupname : string; isImport : boolean; includeHotkeys : boolean = true);
var
    ItemClip : TClipList;
    ItemHotKeyList, groups : TStringList;
    cnt, i : integer;
    ci : TClipItem;
begin
    ItemClip := TClipList.Create;
    ItemHotKeyList := TStringList.Create;

    if isImport then begin
        TClipDatabase.StartBatch(DB_SHARED);
    end else begin
        TClipDatabase.StartBatch;
    end;
    TClipDatabase.LoadPermanentHotkeys(ItemHotKeyList, groupname);
    cnt := TClipDatabase.getCountPermanent(groupname);
    for i := 0 to cnt-1 do begin
        ci := TClipITem.Create;
        TClipDatabase.LoadPermanent(ci, i, groupname);
        ItemClip.Add(ci);

        // legacy stuff, not enought keyslots
        if (i>=ItemHotKeyList.Count) then begin
            ItemHotKeyList.Add('');
        end;
    end;
    dirtyShared := false;
    TClipDatabase.EndBatch;


    if isImport then begin
        TClipDatabase.StartBatch;
    end else begin
        TClipDatabase.StartBatch(DB_SHARED);
    end;

    groups := TStringList.Create;
    TClipDatabase.LoadPermanentGroups(groups);
    if (groups.IndexOf(groupname)=-1) then begin
        TClipDatabase.SavePermanentGroup(groupname, groups.count);
    end;
    groups.Free;

    TClipDatabase.ClearPermanentGroup(groupname);
    for i := 0 to ItemClip.Count-1 do begin
        TClipDatabase.SavePermanent(ItemClip[i],i,groupname);
        if isImport then begin
            if includeHotkeys then begin
                TClipDatabase.SavePermanentHotkey(ItemHotKeyList[i],i,groupname);
            end;
        end else begin
            TClipDatabase.SavePermanentHotkey(ItemHotKeyList[i],i,groupname);
        end;
    end;
    dirtyShared := false;
    TClipDatabase.EndBatch;

    ItemClip.Free;
    ItemHotKeyList.Free;
end;
class procedure TClipDatabase.dirtyCheck;
var
    i : integer;
begin
    if (dirtyShared) then begin
        dirtyShared := false;
        for i := 0 to dirtyGroups.Count-1 do begin
            TSharedMetadata.reportUpdated(dirtyGroups[i]);
        end;
        dirtyGroups.clear;
    end;
end;


//
// Instance Data
//
constructor TInstanceData.Create(path : string);
begin
    instanceFile := path;
    self.ir := InstanceRecord.Create;
    readyList := TList<int64>.create;
    state := IS_NONE;

    ir.commandChar := COMMAND_NONE;
    ir.commandNumb := 0;
    ir.lastReadDB := 0;
    ir.lastEdit := DateTimeToUnix(Now);

    timer := TTimer.Create(nil);
    timer.Enabled := false;
    timer.Interval := 10 * 1000;
    timer.OnTimer := TimerEvent;

    if FileExists(instanceFile)  then
        ReadInstance;
end;
procedure TInstanceData.Ping;
begin
    ir.commandChar := COMMAND_PING;
    ir.commandNumb := DateTimeToUnix(Now);

    state := IS_PINGWAIT;
    readyPingCount := 0;
    saveInstanceData;
    timer.Enabled := true;
end;
procedure TInstanceData.PingResponse;
begin
    ir.commandChar := COMMAND_PING_RESPONSE;
    ir.commandNumb := ir.lastEdit;
    saveInstanceData;
end;
procedure TInstanceData.ShareClips(dbNumber : integer);
begin
    if ((ir.commandChar = COMMAND_NEW_DB) and (ir.commandNumb = dbNumber)) then begin
    end else begin
        state := IS_WRITING;
        ir.commandChar := COMMAND_NEW_DB;
        ir.commandNumb := dbNumber;
        ir.lastReadDB := dbNumber;
        saveInstanceData;
    end;
    state := IS_NONE;
end;
procedure TInstanceData.saveInstanceData;
var
    s, stamp : string;
    fs : TStreamWriter;
    files : TFileStream;
    b : boolean;
    i : integer;
begin
    s := getInstanceFileFullPath;
    try

        i := 0;
        repeat
            try
                if Fileexists(s) then begin
                    files := TFileStream.Create(s, fmOpenWrite or fmShareDenyRead);
                end else begin
                    files := TFileStream.Create(s, fmCreate or fmShareDenyRead);
                end;
                b := true;
            except
                b := false;
                inc(i);
                sleep(50);
                if (i>10) then EXIT;
            end;
        until b;

        fs := TStreamWriter.Create( files );
        fs.OwnStream;
        stamp := IntToStr(DateTimeToUnix(Now));

        s := ir.commandChar;
        fs.WriteLine(s);
        s := IntToStr(ir.commandNumb);
        fs.WriteLine(s);
        s := IntToStr(ir.lastReadDB);
        fs.Writeline(s);

        s := stamp;
        fs.Writeline(s);
    finally
        fs.Close;
        fs.Free;
    end;
end;
procedure TInstanceData.deleteInstanceData;
begin
    if not DeleteFile(getInstanceFileFullPath) then begin
        FrmDebug.AppendLog('can''t delete instace file ',true);
    end;
end;

function  TInstanceData.getInstanceFileFullPath : string;
begin
    result := instanceFile;
end;
function  TInstanceData.getState : InstanceState;
begin
    result := state;
end;
function  TInstanceData.getLastEdit : Int64;
begin
    result := ir.lastEdit;
end;
procedure TInstanceData.HandleInstanceUpdate(id : TInstanceData);
begin
    case (id.ir.commandChar) of
    COMMAND_PING: begin
        PingResponse;
    end;
    COMMAND_NONE: begin
        // nothing
    end;
    COMMAND_NEW_DB: begin
        readyList.Add(id.ir.commandNumb);
    end;
    COMMAND_PING_RESPONSE: begin
        if (state = IS_PINGWAIT) then begin
            if (not timer.Enabled) then begin
                timer.Enabled := true;
            end;

            inc(readyPingCount);
        end;
    end;
    end;
end;
function  TInstanceData.getNewDB : int64;
begin
    result := 0;
    if (ir.commandChar = COMMAND_NEW_DB) then
        result := ir.commandNumb;
end;
procedure TInstanceData.ReadInstance;
var tf : TextFile;
    fs : TStreamreader;
    s : string;
    i : integer;
    b : boolean;
begin

    i := 0;
    b := false;
    mysleep(50);
    repeat
        try
            fs := TStreamReader.Create(TFileStream.Create(instanceFile, fmOpenRead or fmShareDenyWrite));
            fs.OwnStream;
            b := true;

            s := fs.ReadLine;
            if (s='') then begin
                b := false;
                fs.Close;
                fs.Free;
            end;
        except
            inc(i);
            if (i=10) then begin
                FrmDebug.appendLog('TGlobalClipboard - can''t open file: '+ instanceFile);
                EXIT;
            end;
            mysleep(50);
        end;
    until b;

    try
//        s := fs.ReadLine;
        ir.commandChar := s[1];
        s := fs.ReadLine;
        ir.commandNumb := StrToInt64(s);
        s := fs.ReadLine;
        ir.lastReadDB := StrToInt64(s);
        s := fs.ReadLine;
        ir.lastEdit := StrToInt64(s);
    finally
        fs.Close;
        fs.Free;
    end;
end;
procedure TInstanceData.TimerEvent(Sender : TObject);
begin

end;
function  TInstanceData.readyForDB(dbNumber : int64) : boolean;
begin
    result := readyList.indexof(dbNumber)<>-1;
end;
procedure TInstanceData.reportDBHandled(dbNumber : int64);
begin
    readyList.Remove(dbNumber);
end;



//
/// Global CLipboard
///
class function TGlobalClipboard.rawQuery(const sql : string) : TSQLiteStatement;
begin
    lastRawSQL := sql;
    result := DB.Query(sql);
end;
class procedure TGlobalClipboard.rawExecute(const sql : string);
begin
    lastRawSQL := sql;
    DB.Execute(sql);
end;
class function TGlobalClipboard.hasOtherListeners : boolean;
var
    path : string;
    d : string;
    id : TInstanceData;
    files : TStringDynArray;
    i : integer;
    procedure clearInstances;
    var
        i : integer;
        id2 : TInstanceData;
        s : string;
    begin
        for s in instances.Keys do begin
            id2 := instances.Items[s];
            myfree(id2);
        end;
        instances.Clear;
    end;
begin
    result := fHasOtherListeners;
    if (result) then EXIT;

    clearInstances;
    d := ExtractFilePath(getFullPath);
    files := TDirectory.GetFiles(d, INSTANCE_FILTER) ;
    for i := 0 to length(files)-1 do begin
        path := files[i];
        if path = Self.id.getInstanceFileFullPath then CONTINUE;

        id := TInstanceData.Create(path);

        if not instances.ContainsKey(path) then
            instances.Add(path, id);
    end;

    result := instances.Count > 0;
    fHasOtherListeners := result;
end;
// Public Interface
class procedure TGlobalClipboard.JoinInstancePool;
var
    d : string;
    i : integer;
const
    MUTEX_NAME = 'AC_GLOBAL_CLIPBOARD';
begin
    if (instancePool) then EXIT;

    d := ExtractFilePath(getFullPath);
    folderMonitor := TFolderMonitor.Create;
    folderMonitor.OnChange := FolderChange;
    folderMonitor.SetFolder( d );

    hasOtherListeners;

    self.id.saveInstanceData;
    frmClipboardManager.addNewClipListener(newClipboardCallback);

    instancePool := true;
end;
class procedure TGlobalClipboard.LeaveInstancePool;
begin
    if not instancePool then EXIT;

    folderMonitor.Cancel;
    id.deleteInstanceData;
    frmClipboardManager.removedNewClipListener(newClipboardCallback);
end;

// EVENTS
class procedure TGlobalClipboard.newClipboardCallback(Sender : Tobject);
var ci : TClipItem;
    cformat : integer;
    c : cardinal;
begin
    if ignoreClipboard then EXIT;
    if not self.hasOtherListeners then EXIT;

    c := WinAPI.Windows.GetClipboardSequenceNumber;
    if (c=lastSequence) then begin
        EXIT;
    end;
    lastSequence := c;

    ci := TClipItem.Create;
    cformat := ci.GetClipboardItem(0);
    if (cformat = 0) then begin
        myfree(ci);
        EXIT;
    end;


    clips.Insert(0, ci);

    ignoreFolderChange := true;
    setNumber(DateTimeToUnix(Now));
    saveClips;
    id.ShareClips(dbNumber);
    ignoreFolderChange := false;

end;
class procedure TGlobalClipboard.handleDB(number : int64);
begin
    self.id.reportDBHandled(number);
    setNumber(number);
    ImportFromCurrentDB;
end;
class procedure TGlobalClipboard.FolderChange;
var
    sr : TSearchRec;
    i, x : integer;
    sl : TStringList;
    path,s : string;
    id1, id2 : TInstanceData;
    oldInstanceExists, instanceUpdated, newDB : boolean;
    oldest : int64;
    le1, le2 : int64;
    i64 : int64;
    dbs : TStringDynArray;
    dbName : string;
const UNIX_HOUR = 60 * 60;
begin
    if Application.Terminated then EXIT;
    if ignoreFolderChange then begin
        FrmDebug.AppendLog('TGlobalClipboard: Ignoring Folder Change');
        EXIT;
    end;

    FrmDebug.AppendLog('FolderChange - start');
    while (self.id.getState = IS_WRITING) do begin
        MySleep(50);
    end;

    try
        oldest := DateTimeToUnix(Now);
        for path in  TDirectory.GetFiles(ExtractFilePath(getFullPath), INSTANCE_FILTER) do begin
            if (path = self.id.getInstanceFileFullPath) then CONTINUE;

            id1 := TInstanceData.Create(path);
            id2 := nil;
            oldInstanceExists := instances.TryGetValue(path, id2);
            if (oldInstanceExists) then begin
                le1 := id1.getLastEdit;
                le2 := id2.getLastEdit;
                oldInstanceExists := le1<>le2;
                id2.Free;
            end;

            newDB := (oldInstanceExists);
            if (newDB) then begin
                self.id.HandleInstanceUpdate(id1);
            end;
            instances.AddOrSetValue(path, id1);
            oldest := min(id1.getLastEdit, oldest);
        end;

        ignoreClipboard := true;
        for path in TDirectory.GetFiles(ExtractFilePath(getFullPath), DB_FILTER) do begin
            i := getTimeFrom(path);
            if (self.id.readyForDB(i)) then begin
                handleDB(i);
            end else begin
                FrmDebug.AppendLog('DB with no message:' + path, false);

                if (oldest-i> UNIX_HOUR * 3 ) then begin
                    FrmDebug.AppendLog('DB is too old:' + IntToStr(i));
                    DeleteFile(path);
                end;
            end;
        end;
        ignoreClipboard := false;

        myfree(foldermonitor);
        folderMonitor := TFolderMonitor.Create;
        folderMonitor.OnChange := FolderChange;
        folderMonitor.SetFolder( ExtractFilePath(getFullPath)  );
    finally
        FrmDebug.AppendLog('FolderChange - end');
    end;
end;
class procedure TGlobalClipboard.init;
var s : string;
begin
    FOLDER_NAME := 'clipdatabase\global';
    DB_NAME := DB_PREFIX+'?'+DB_SUFFIX;
//    state := IS_NONE;

//    myDB := TDISQLite3Database.Create(nil);

    dateformat := TFormatSettings.Create();
    dateformat.LongDateFormat :=  DATE_FORMAT;
    dateformat.ShortDateFormat := DATE_FORMAT;
    dateformat.ShortTimeFormat := TIME_FORMAT;
    dateformat.LongTimeFormat := TIME_FORMAT;
    DateFormat.TimeSeparator := ':';
    DateFormat.DateSeparator := '-';

    user := '';
    computer := '';

    s := ExtractFilePath(getFullPath) ;
    if (not DirectoryExists(s) ) then begin
        ForceDirectories( s );
    end;




    instanceFile := TClipDatabase.getComputer + '.instance';
    self.id := TInstanceData.create(
        IncludeTrailingPathDelimiter(
        ExtractFilePath(getFullPath)
        ) + instanceFile
    );


    readyToReadDB := 0;
    instances := TDictionary<String,TInstanceData>.create;
    clips := TClipList.Create(true);


    instancePool := false;
end;


class procedure TGlobalClipboard.setNumber(i : int64);
begin
    DB_NAME := DB_PREFIX+IntToStr(i)+DB_SUFFIX;
    dbNumber := i;
end;
class procedure TGlobalClipboard.OpenDatabase;
var st : TSQLiteStatement;
    s : string;
    function replace(s : string; index : integer; param : string) : string;
    begin
        result := StringReplace(s,'?'+IntToStr(index),param,[rfIgnoreCase, rfReplaceAll]);
    end;
begin
    try
       db := TSQLiteDatabase.Create(getFullPath, SQLite3Classes.TSQLiteOpenMode.readWrite);
    except
        on e : ESQLiteError do begin
            case (e.getCode) of
            SQLITE_CANTOPEN: begin

                DB := TSQLiteDatabase.Create(getFullPath);
                rawExecute('PRAGMA page_size = 8192');
                rawExecute(CREATE_TABLE_CLIPS_BARE);
            end;
            end;
        end;
        on E: Exception do begin
            ShowMessage(e.ToString);
        end;
    end;
end;
class function  TGlobalClipboard.getCount(whereClause : string) : integer;
var
    st : TSQLiteStatement;
begin
    try
        ConditionalOpen;
        st := rawQuery(
            'select count(_id) from '+CLIP_TABLENAME+' ' +
            whereClause
            );

        result := 0;
        if (st.cursor.Next) then begin
            result := st.cursor.ColumnAsInteger[0];
        end;
    finally
        st.free;
        ConditionalClose;
    end;
end;

class function  TGlobalClipboard.getCountNormal : integer;
begin
    result := getCount('');
end;
class procedure TGlobalClipboard.Save(ci : TClipItem; pinned : integer;  index : integer = 0  );
var
    st : TSQLiteStatement;
    fm : integer;
    sdate : string;
    pin: integer;
    plainTextSize : integer;
    thumbSize : integer;
    richShadowSize : integer;
    menuCaptionSize : integer;
    iconSize : integer;
    clipSize : integer;
    thumb : TMemoryStream;
    clipStr : TStream;
    iconStr : TStream;
    richStr : TStream;

    s : string;
    procedure BindBlob(str : TStream; index : integer);
    var
        p : Pointer;
        size : integer;
    begin
        size := str.Size;
        GetMem(p, size);
        str.Seek(0, soFromBeginning);
        str.Read(p^, size);
        st.SetParamBlob( index, p,size);
    end;
begin

    s := 'DELETE FROM ' + CLIP_TABLENAME +
    ' where '+CLIP_INDEX+' = ' + IntToStr(index);
    rawExecute(s);

    fm := ci.GetFormat;
    if (fm = UnitMisc.GetCF_RICHTEXT) then begin
        fm := CF_FILE_RICHTEXT;
    end else if (fm = UnitMisc.GetCF_HTML ) then begin
        fm := CF_FILE_HTML;
    end;

    st := rawQuery(INSERT_CLIP_BARE);
    clipStr := ci.GetStream;
    st.param[1] := fm;
    BindBlob(clipstr, 2);
    st.param[3] := index;
    st.Param[4] := ci.GetAsPlaintext;

    st.Cursor.Next;
    st.free;
end;
class procedure TGlobalClipboard.Load( ci : TClipItem; index : integer; pinned : integer );
var
    s : string;
    st : TSQLiteStatement;
    i : integer;
begin
    try
        s := ' select '+CLIP_CLIP+', '+CLIP_FORMAT+' from '+CLIP_TABLENAME+
        ' where '+CLIP_INDEX+' = '+ IntToStr(index);
        st := rawQuery(s);


        if (not st.Cursor.Next) then begin
            //  TODO: do some real error reporting
            EXIT;
        end;

        Extract(st, ci);
    finally
        st.free;
    end;
end;
class procedure TGlobalClipboard.ConditionalOpen;
begin
    if (updateMode) then EXIT;
    OpenDatabase;
end;
class procedure TGlobalClipboard.ConditionalClose;
begin
    if (updateMode) then EXIT;
    myfree(db);
end;
class procedure TGlobalClipboard.Extract(const st : TSQLiteStatement; ci : TClipItem);
var
    ms : TMemoryStream;
begin
    ms := TMemoryStream(ci.GetStream);
    readBlob(st, ms, 0);
    ci.CData.setSize(ms.size);
    ci.setFormat( st.cursor.ColumnAsInteger[1] );
end;
class function  TGlobalClipboard.getFullPath : string;
begin
    result := IncludeTrailingPathDelimiter(UnitMisc.GetAppPath) +
        IncludeTrailingPathDelimiter(FOLDER_NAME) + DB_NAME;
end;
class procedure TGlobalClipboard.ReadBlob(st : TSQLiteStatement; str : TStream; index : integer);
var
    size : integer;
    p : pointer;
begin
    size := st.Cursor.ColumnSize[index];
    if (size=0) then EXIT;

    GetMem(p, size);
    CopyMemory(p, st.cursor.ColumnAsBlob[index], size );
    str.write(p^, size);
    FreeMem(p);
    str.Position := 0;
end;


class procedure TGlobalClipboard.deleteInstanceData;
begin
    if (assigned(id)) then
        id.deleteInstanceData;
end;
class procedure TGlobalClipboard.saveClips;
var i, x : integer;
    c : integer;
begin
    ConditionalOpen;
    i := 0;
    while (clips.Count>0) do begin
        c := clips.Count - 1;
        save(clips[c], ID_NORMAL, i);
        clips.Delete(c);

        inc(i);
    end;
    ConditionalClose;
end;


class procedure TGlobalClipboard.ImportFromCurrentDB;
var ci : TClipItem;
    cnt, i : integer;
begin
    try
        cnt := getCountNormal;
        ConditionalOpen;
        for i := 0 to cnt-1 do begin
            ci := TClipItem.Create;
            Load(ci, i, ID_NORMAL);

            FrmDebug.AppendLog('size='+IntToSTr(ci.GetStream.Size));
            FrmDebug.AppendLog('format='+IntToStr(ci.GetFormat));

            Paste.SetClipboardOnlyOnce;
            Paste.SendClip(ci);
            myfree(ci);
        end;
        ConditionalClose;
    finally
    end;

end;
class function TGlobalClipboard.getTimeFrom(fullpath : string) : int64;
begin
    fullpath := ExtractFileName(fullpath);
    fullpath := StringReplace(fullpath,DB_PREFIX,'',[]);
    fullpath := StringReplace(fullpath,DB_SUFFIX,'',[]);
    result := 0;
    try
        result := StrToInt(fullpath);
    except
    end;
end;



//
//  TSharedMetadata
//

class procedure TSharedMetadata.init;
begin
    shared := THashedStringList.Create;
    TSharedMetadata.update;
end;
class function TSharedMetadata.isShared(groupname : string) : boolean;
begin
    result := shared.Values[groupname] <> '';
end;


class function TSharedMetadata.isSharedDatabase(databasename : string) : boolean;
begin
    result := AnsiEndsText(databasename, TSharedMetadata.getIniName);
end;

class function TSharedMetadata.getIniName : string;
const
    ini_name = 'shared.ini';
    FOLDER_NAME = 'clipdatabase';
begin
    result := IncludeTrailingPathDelimiter(UnitMisc.GetAppPath) +
        IncludeTrailingPathDelimiter(FOLDER_NAME) + ini_name;
end;
class procedure TSharedMetadata.update;
var
    ini : TIniFile;
    i : integer;
    val : integer;
    gname, compname : string;
    sl : THashedStringList;
    includeHotkeys : boolean;
const
    ini_section = 'main';
    ini_options = 'options';
    INCLUDE_HOTKEYS = 'INCLUDE_HOTKEYS';
begin
    ini := Tinifile.Create( TSharedMetadata.getIniName );
    compname := TClipDatabase.getComputer;

    includeHotkeys := ini.ReadBool(ini_options + '_'+compname, INCLUDE_HOTKEYS, true);
    ini.WriteBool(ini_options + '_'+compname, INCLUDE_HOTKEYS, includeHotkeys);



    if (shared.count = 0) then begin
        ini.ReadSectionValues(compname, shared);
    end;

    sl := THashedStringList.Create;
    ini.ReadSectionValues(ini_section, sl);
    for i := 0 to sl.Count-1 do begin
        gname := sl.Names[i];

        if sl.Values[gname] <> shared.Values[gname] then begin
            TClipDatabase.importShared(gname, includeHotkeys);
            shared.Values[gname] := sl.Values[gname];
            ini.WriteString(compname, gname, shared.Values[gname]);
        end;
    end;
    sl.Free;


    ini.Free;
end;
class procedure TSharedMetadata.reportUpdated(groupname : string);
var
    val : integer;
    s, gname : string;
    ini : TIniFile;
    groupidx, curridx : integer;
const
    ini_section = 'main';

begin
    gname := groupname;
    s := shared.Values[gname];
    if (s='') then begin
        shared.Values[gname] := IntToStr(1);
    end else begin
        shared.Values[gname] := IntToStr( StrToInt(s) + 1);
    end;
    curridx := StrToInt(shared.Values[gname]);

    ini := Tinifile.Create( TSharedMetadata.getIniName );
    s := ini.ReadString(ini_section, gname, '');
    if (s='') then begin
        s := '0';
    end;
    groupidx := StrToInt(s);
    if (groupidx < curridx) or (groupidx = 0) then begin
        TClipDatabase.exportShared(gname);
    end else begin
        // something is not right - trigger an import on the next run and terminate
        ShowMessage('Database error. Terminating program to protect data.');
        ini.WriteString(TClipDatabase.getComputer, gname, '');
        ini.Free;
        application.Terminate;
        EXIT;
    end;


    ini.WriteString(TClipDatabase.getComputer, gname,  shared.Values[gname] );
    ini.WriteString(ini_section, gname,  shared.Values[gname] );
    ini.Free;
end;


var d : TDateTIme;
initialization
begin
    TClipDatabase.init;
    TGlobalClipboard.init;
    TSharedMetadata.init;
end;

finalization
begin
    TGlobalClipboard.deleteInstanceData;
end;
end.
