unit UnitClipQueue;
{
    Purpose:
        Encapsulate all the rules of of the queue
        - number of items allowed
        - deleting icons on item removal (no memory leaks)
        - etc
        Handle a separate queue of items removed from the ClipQueue
}



{///////////////}
interface
{///////////////}
uses unitmisc, classes, Windows, Graphics {TPicture}, inifiles {hash}, UnitTWideChar,
    System.Generics.Collections;

var ClipDataDefaultIcon : HICON;

type TClipFormatType = (
    FT_UNKNOWN = 0, FT_TEXT, FT_UNICODE, FT_PICTURE, FT_HTML, FT_RICHTEXT, FT_FILE, FT_AUDIO
);

{
    TClipData
        - data associated with a clipboard item ( aka TClipItem )
}
const

    CI_FILEMASK_PLAIN = 1;
    CI_FILEMASK_THUMB = 2;
    CI_FILEMASK_SHADDOW = 4;
    CI_FILEMASK_CAPTION = 8;
    CI_FILEMASK_ICON = 16;
    CI_FILEMASK_CLIP = 32;
    CI_FILEMASK_NO_CLEAR = 64;
    CI_FILEMASK_ALL = cardinal(-1) and not CI_FILEMASK_NO_CLEAR;

const CF_FILE_RICHTEXT = CF_PRIVATEFIRST;
const CF_FILE_HTML = CF_PRIVATEFIRST + 1;


type TPermanentClipType = (
    PCT_NONE=0,
    PCT_TEXT=1,
    PCT_MACRO=2,
    PCT_JAVASCRIPT=3
);


type TClipData = class(TObject)
    private
        size : cardinal;
        plaintext : string;
        hndIcon : HICON;
        timestamp : TDateTime;
        fhash : cardinal;
        fclicked : Boolean;
        picturesize : string;
        timestampused : boolean;
        function GetString : string;
    public
        thumb : TBitmap;
        displaytext : string;

        constructor Create(s : string; h : HICON);
        destructor Destroy; override;
        procedure setTimeStamp(timestamp : TDateTime);
        procedure setSize(size : integer);
        function GetHICON : HICON;
        function GetHICONAbsolute : HICON; {used so the default icon is not saved}
        procedure SetString(s : string);
        procedure SetHICON(h : HICON; filename : string = ''); overload;
        procedure SetHICON(h : HICON; crc : cardinal); overload;
        procedure DeleteHICON;
        function GetCreationDate : TDateTime;
        function CreationDateUsed : Boolean;
        property Hash : Cardinal read fhash write fhash;
        property Clicked : Boolean read fCLicked write fclicked;
end;
type
TClipFormat = word;
TClipFormatList = TList<TClipFormat>;
TClipItem = class;
TClipboardGrabber = class(TObject)
private
    class function TryOpenClipboard : boolean;
    class function ChooseAFormat : TClipFormat;
    class procedure LastDitchAttempt(ci : TClipItem);
    class function CleanRichtextURLs(s : string) : string;
    class function GetAvailableFormats : TClipFormatList;
    class function GetConfiguredTextFormat(listOrNil : TClipFormatList) : TClipFormat;
public
    class function GetClipboardItem(clip : TClipItem; hi : HICON; OverrideFormat : WORD = 0; SizeLimit : cardinal = $FFFF) : cardinal; overload;
    class function ClipboardHasPicAndText(var textformat :word) : boolean;
end;
TClipItem = class(TObject)
    private
        CFormat : WORD; {The format & Handle of the copied clipboard item}
        ClipMemory : TStream;
        RichShadowMemory : TStream;

        fCompressed : boolean;

        picwd, picht : integer;

        function GetFilenamesAsText(h : THandle) : string; overload;

        procedure CleanupMemory;
        function GetCRC : cardinal;

        function isCompressed : boolean;
        procedure Compress;
        procedure Decompress;
        function GetStreamRaw : TStream;
    public
        CData : TClipdata; {Data relating to the clipboard item}
                           {Used to store a text version of the file and
                            save the ICON of the program that this text came from}

        constructor Create;
        destructor Destroy; override;

        function FileFormatToFormat(w : word) : word;
        function CloneClip : TClipItem;
        function GetClipboardItem(hi : HICON; OverrideFormat : WORD = 0; SizeLimit : cardinal = $FFFF) : cardinal; overload;
        procedure SetFromPlainText(text : string);
        procedure SetDisplayText(text : string);
        function getDisplayText : string;
        function GetAsPlaintext : string;

        function HasText : boolean;
        procedure OverrideTextVersionOfItem(s : string);
        function GetStream : TStream;
        procedure OverwriteStream(st : TStream);
        procedure FinishedWithStream; virtual;
        procedure ClearStream;


        function GetDataSize : cardinal;
        function GetFormatType : TClipFormatType;
        function GetFormat : cardinal;
        function GetFormatName(AccessHandle : boolean = true) : string;
        procedure DibToBitmap(BM : TBitmap);
        procedure GetDIB(pic : TPicture); overload;
        procedure GetDIB(ms : TStream); overload;
        procedure GetRichText(var s : string);
        procedure GetAnsiText(var s : string);
        procedure GetUTF8Text(var s : string);
        procedure GetUnicodeText(var s : string);

        procedure SaveToFile(path : string; index : integer); overload;
        procedure LoadFromFile(path : string; index : integer); overload;
        procedure SaveToFile(path : string; index : integer; readmask : cardinal); overload;
        procedure LoadFromFile(path : string; index : integer; readmask : cardinal); overload;

        function GetFilename(path : string; index : integer) : string;
        function GetFilenameV2(path : string; index : integer) : string;

        procedure SaveIconToFile(path : string; index : integer; suffix : string = '');
        procedure LoadIconFromFile(path : string; index : integer; suffix : string = '');


        function LoadOnlyFormat(path : string; index : Integer) : word;

        function HasRichShadow : boolean;
        procedure GetRichTextShadow(var s: string);
        function GetRichStream : TStream;

        procedure BuildMenuCaption;
        function GetPicHeight : integer;

        procedure SaveIconToStream(st : TStream);
        procedure LoadIcons(st : TStream; iconcrc : cardinal);
        function TryGetIcon(crc : cardinal) : boolean;

end;
TPermanentClipItem = class(TClipItem)
    protected
        fClipType : TPermanentClipType;
        function getClipType : TPermanentClipType;
        procedure setClipType(value : TPermanentClipType);
    public
        procedure DetectClipType;
        property ClipType : TPermanentClipType read getClipType write setClipType;
end;

type TClipItemNoQueue = class(TClipItem)
    public
        procedure CleanupMemory;
end;
type TClipItemCurrentClipboard = class(TClipItemNoQueue)
    private
        fLastClipID : cardinal;
        procedure Compress;
        procedure Decompress;
    public
        procedure FinishedWithStream; override;
        function GetClipboardItem(hi : HICON; OverrideFormat : WORD = 0; SizeLimit : cardinal = $FFFF) : cardinal; overload;
end;

{
    TStringQueue
        - Basic FIFO for strings
        - Enforces a total size
        - Override for populating the list
    NOTES:
        TStringList container because I don't want to deal with overriding
        all the many ways the list can be altered. Lazy, yes I am, but it also
        saves me from myself.
}
type TStringQueue = class(TObject)
    protected
        sl : TStringList;
        qSize : cardinal;
    public
        constructor Create;
        destructor Destroy; override;
        // init the rule
        procedure SetQueueSize(size : longint);
        function GetQueueSize : longint;
        // Add - for loading history, no size check
        // InsertAtStart - for FrmClipboardManagaer
        procedure AddNoSizeCheck(s : string);
        procedure InsertAtStart(s : string); overload;

        function GetQueueCount : integer;
        function GetItemText(index : cardinal) : string;


        procedure DeleteItem(index : cardinal); virtual;
        procedure ClearQueue; virtual;
end;

type TQueueEvent = procedure of object;
type TClipQueue = class(TStringQueue)
    private
        MoveDuplicateTop : boolean;
        Listeners : TList<TQueueEvent>;
        procedure notifyListeners;
        procedure NewClipEvent(ci : TCLipItem);
    public
        constructor Create;
        destructor Destroy; override;


        procedure addListener(ChangeListener : TQueueEvent);
        procedure removeListener(ChangeListener : TQueueEvent);
        {config options}
        procedure SetMoveDuplicateTop(enable: boolean);

        procedure MoveToStart(index : cardinal);
        function Move(oldIndex : cardinal; newIndex : cardinal) : boolean;

        {add & retreive operations}
        procedure GetQueueItems(items : TStrings);
        procedure SetQueueItems(items : TStrings);


        function InsertAtStartNontext(ci : TClipItem) : boolean; virtual;
        procedure AddNoSizeCheck(s : string; ci : TClipItem = nil); virtual;
        function InsertAtStart(ci : TClipItem) : boolean; overload;
        function InsertAtStart(ci : TClipItem; casesensative : boolean ) : boolean; overload;
        function GetClipItem(index : cardinal) : TClipItem;
        function GetClipSafe(index : cardinal) : TClipItem;

        function GetItemText(index : cardinal) : string;

        {find & delete}
        function IndexOf(s : string) : integer;  overload;
        function IndexOf(ci : TClipItem) : integer; overload;
        procedure DeleteItem(index : cardinal); override;
        procedure DestroyItem(index : cardinal); overload;
        procedure DestroyItem(ci : TClipItem); overload;
        procedure ClearQueue; override;
end;
//
// buffer between the ClipQueue and the PagedStringQueue
//
type TTempClipQueue = class(TClipQueue)
      procedure DeleteItem(index : cardinal); override;
      procedure DeleteItem2(index : cardinal; NoFree : boolean = false); overload;
      procedure InsertAtStart(ci : TClipItem); overload;
      procedure AddNoSizeCheck(s : string; ci : TClipItem = nil); override;
end;
type TPinnedClipQueue = class(TClipQueue)
    constructor Create;

    procedure DeleteItem(index : cardinal); override;
    procedure DeleteItem2(index : cardinal; NoFree : boolean = false); overload;
    procedure InsertAtStart(ci : TClipItem); overload;
    procedure AddNoSizeCheck(s : string; ci : TClipItem = nil); override;
end;


//procedure ResyncTempClipQueue;
{
    TPagedStringQueue
        Poor Engineering 101 here, but oh well. (Does not inherit
        from TStringQueue)

        - Circular queue of items 0-N but the Queue "start" is the first
        item in the list
        - Item 0 is the oldest item, Item (GetQueueCount - 1) is the newest
        item
}
const PAGED_EXT = '.ac';
const PAGED_CLIP_EXT = '.acz';
const PAGED_STATEFILE = 'start' + PAGED_EXT;
const PAGED_ICON_EXT = '.bmp';

type TPagedData = class(TObject)
    icon : HICON;
    FileDate : TDateTime;
    FormatType : TClipFormatType;
    AsText : string;
    caption : string;
end;
type TPagedClipData = record
    FileDate : TDateTime;
    ci : TClipItem;
end;
type TPagedStringQueue = class(TObject)
    private
        base : string;
        filename : string;
        cache : string;

        iconcache : string;
        qSize : cardinal;
        qStart : cardinal;
        qCount : integer;
        v2Format : boolean;

        ci : TClipITem;
        ClipCache : TDictionary<Integer, TPagedClipData>;

        PagedCache : TDictionary<Integer, TPagedData>;

        NewClipListeners : TList<TNotifyEvent>;

        procedure SaveItem(index: cardinal; ci : TClipItem = nil);


        function IsEmptyItemAbsolute(absoluteIndex : cardinal) : boolean;

        procedure RemoveOldestItem;
        procedure SaveQueueState;
        procedure ReIndexQueue;

        function IndexTranslate(index : cardinal) : cardinal;

        procedure SwapClips(index, fileindex : cardinal);

        function GetItemAbsolute(absoluteIndex : cardinal) : string;
        function GetItemClipAbsolute(absoluteIndex : cardinal) : TClipItem;

        function GetFilenameAbsolute(absoluteindex : cardinal) : string;
        function GetFilenameAbsoluteOld(absoluteIndex : cardinal) : string;
        function GetFilenameClip(index : cardinal) : string;
        function GetFilenameClipAbsolute(absoluteIndex : cardinal) : string;
        function GetFilenameIcon1Absolute(absoluteIndex : cardinal) : string;
        function GetFilenameIcon2Absolute(absoluteIndex : cardinal) : string;

        function GetItemDate(index : cardinal) : TDateTime;
        function GetItemIcon(index : cardinal) : HICON;
        function GetItemIconIndex(index : cardinal) : cardinal;
    public
        constructor Create(filename : string; folder : string = '');
        destructor Destroy; override;

        procedure InsertAtStart(ci : TClipItem); overload;
        function GetQueueCount : integer;
        function getQueueSize : integer;
        procedure ClearQueue;
        procedure SetQueueSize(size : cardinal);

        function GetPagedData(index : Integer) : TPagedData;

        function GetItemText(index : cardinal) : string;
        function GetItemClip(Index: cardinal): TClipItem;
        procedure DeleteItem(index : cardinal);
        procedure ClearClipCache;
        procedure PreloadCache;

        procedure RefreshSize;

        procedure addNewClipListener(listener : TNotifyEvent);
end;



var ClipQueue : TClipQueue;
var RemovedQueue : TPagedStringQueue;
//var TempClipQueue : TTempClipQueue;
var ClickedClipQueue : TTempClipQueue;
var PinnedClipQueue : TPinnedClipQueue;

var CurrentClipboard : TClipItemCurrentClipboard;
{////////////////////}
{//}implementation{//}
{////////////////////}


uses UnitFrmMainPopup, Forms {For Application object},
    Clipbrd, StrUtils, SysUtils, ShellAPI, Dialogs, UnitPaste, Math, UnitFrmClipboardManager,
  UnitFrmConfig, UnitCRC32, UnitMiscCom, UnitToken, Generics.Collections, System.IOUtils, System.types,
  UnitFrmDebug, UnitClipDatabase, UnitJS;

const FILE_EXT_BINARY = PAGED_CLIP_EXT;
const FILE_EXT = '.acy';

var crit : RTL_CRITICAL_SECTION;


const FILE_EXT_V2 = '.acz2';
type TClipFileHeader = packed record
    format : word;
    cliphash : cardinal;
    timestamp : TDateTime;
    iconCRC : cardinal;

    plaintextSize,
    thumbSize,
    richshadowSize,
    menucaptionSize,
    iconSize,
    clipSize : cardinal;
end;


///
///  TPermanentClipItem
///
procedure TPermanentClipItem.DetectClipType;
var s : string;
begin
    s := self.GetAsPlaintext;
    if Paste.IsMacro(s) then begin
        setClipType(PCT_MACRO);
    end else if TJavaScript.isJavaScript(s) then begin
        setClipType(PCT_JAVASCRIPT)
    end else begin
        setClipType(PCT_TEXT);
    end;
end;
function TPermanentClipItem.getClipType;
begin
    if (fClipType = PCT_NONE) then begin
        self.DetectClipType;
    end;
    result := fClipType;
end;
procedure TPermanentClipItem.setClipType(value : TPermanentClipType);
begin
    fClipType := value;
end;

///
/// TClipboardGrabber
///
class function TClipboardGrabber.GetClipboardItem(
    clip : TClipItem; hi : HICON;
    OverrideFormat : WORD = 0;
    SizeLimit : cardinal = $FFFF
) : cardinal;
    procedure PreExit(log : string);
    begin
        FrmDebug.AppendLog(log, true);
        Windows.LeaveCriticalSection(crit);
    end;
    function GetFormat : TClipFormat;
    begin
        result := 0;
        try
            if OverrideFormat = 0 then begin
                result := ChooseAFormat;
            end else begin
                result := OverrideFormat;
            end;
        except
            FrmDebug.AppendLog('<ClipItem - Find Format exception' + SysErrorMessage(GetLastError) );
        end;
    end;
    function SaveClipboardTo(ci : TClipItem; SizeLimit : cardinal) : boolean;
    var
        CVolatileHandle : THandle;
        HasSizeLimit : boolean;
        pnt : Pointer;
    begin
        result := false;
        ci.CData.size := SizeLimit;
        HasSizeLimit := SizeLimit <> $FFFF;
        CVolatileHandle := Windows.GetClipboardData(ci.CFormat);
        if (CVolatileHandle = 0) then begin
            FrmDebug.AppendLog('<ClipItem - can''t get handle 2> ', true);
            Windows.CloseClipboard; // missing close case
            UnitMisc.MySleep(100);
            LastDitchAttempt(ci);
            EXIT;
        end;

        ci.ClearStream;
        pnt := unitmisc.DupHandleToPointer(CVolatileHandle, ci.CData.size, HasSizeLimit);
        if (pnt = nil) then begin
            FrmDebug.AppendLog('<ClipItem - can''t dup handle> ');
            Windows.CloseClipboard;
            LastDitchAttempt(ci);
            EXIT;
        end;

        ci.GetStreamRaw.Write(pnt^, ci.CData.size);
        FreeMemory(pnt);
        result := true;
    end;
    procedure HandledDisplayText(ci : TClipItem);
    var
        CVolatileHandle : THandle;
        sz : Cardinal;
        s : string;
        pnt : Pointer;
    begin
        ci.CData.picturesize := '';
        ci.CData.SetString('');
       // richtext shadow for HTML clips
        if (ci.cformat = unitmisc.GetCF_HTML) then begin
            if Clipboard.HasFormat(unitmisc.GetCF_RICHTEXT) then begin
                ci.RichShadowMemory := TMemoryStream.Create;
                CVolatileHandle := Clipboard.GetAsHandle(unitmisc.GetCF_RICHTEXT);
                if (CVolatileHandle <> 0) then begin
                    pnt := unitmisc.DupHandleToPointer(CVolatileHandle, sz);
                    ci.RichShadowMemory.Write(pnt^, sz);
                    ci.RichShadowMemory.Position := 0;
                    FreeMemory(pnt);
                    ci.GetRichTextShadow(s);
                    s := CleanRichtextURLs(s);
                    TMemoryStream(ci.RichShadowMemory).Clear;
                    ci.RichShadowMemory.Write(s[1], length(s) * sizeof(char));
                    ci.RichShadowMemory.Position := 0;


                    FrmDebug.AppendLog('<ClipItem - RichText Shaddow');
                end;
            end;
            ci.CData.SetString(Clipboard.AsText);
        end else if (ci.cformat = unitmisc.GetCF_RICHTEXT) then begin
            ci.RichShadowMemory := TMemoryStream.Create;
            ci.RichShadowMemory.CopyFrom(ci.GetStream, 0);

            ci.GetRichText(s);
            s := CleanRichtextURLs(s);

            TMemoryStream(ci.RichShadowMemory).Clear;
            ci.RichShadowMemory.Write(s[1], length(s) * sizeof(char));
            ci.RichShadowMemory.Position := 0;

            FrmDebug.AppendLog('<ClipItem - RichText Shadow>');
            ci.CData.SetString(Clipboard.AsText);
        end else if (ci.cformat = CF_HDROP) then begin
            CVolatileHandle := Clipboard.GetAsHandle(CF_HDROP);
            s := ci.GetFilenamesAsText(CVolatileHandle) ;
            FrmDebug.AppendLog('filenames: ' + s);
            ci.CData.SetString(s);
        end else if (ci.CFormat = CF_DIB) then begin
            ci.cdata.picturesize := ci.GetFormatName(true);
        end else  if ci.CFormat <> CF_UNICODETEXT then begin
            ci.CData.SetString(Clipboard.AsText);
        end;
    end;
    procedure HandleSizeWorkarounds(ci : TClipItem);
    var
        Estimation : cardinal;
    begin
        // vba workaround - garbage in the clip
        if (ci.CFormat = CF_UNICODETEXT) and (ci.cdata.size = 2048) then begin
            Estimation := ((length(ci.GetAsPlaintext)+1)*2);
            if Estimation <> ci.Cdata.size  then begin
                ci.cdata.size := Estimation;
            end;
        end;
        // workaround for a terminal program, might need to generalize this
        // more for other programs instead of a sentinal value
        if (ci.CFormat = CF_UNICODETEXT) and (ci.cdata.size = $4000) {16,384} then begin
            Estimation := ((length(ci.GetAsPlaintext)+1)*2);
            if Estimation <> ci.Cdata.size  then begin
                ci.cdata.size := Estimation;
            end;
        end;
    end;

begin
    FrmDebug.AppendLog('<ClipItem> ', true);
    Windows.EnterCriticalSection(crit);
    Windows.SetLastError(ERROR_SUCCESS);     // workaround for some OS's

    clip.CFormat := 0;
    clip.cdata.size := 0;
    clip.CData.hndIcon := hi;
    clip.CData.SetString('');
    clip.CData.displaytext := '';
    result := 0;
    clip.fCompressed := false;


    clip.ClearStream;
    clip.CFormat := GetFormat;
    if (clip.CFormat  = 0) then begin
        PreExit('<ClipItem - No Supported Format ');
         Windows.LeaveCriticalSection(crit);
        EXIT;
    end;
    try
        if not TryOpenClipboard then begin
            LastDitchAttempt(clip);
            if (clip.GetFormat = 0) then begin
                PreExit('<ClipItem - can''t open clipboard2 > ');
                Windows.LeaveCriticalSection(crit);
                EXIT;
            end;
        end else begin
            if not SaveClipboardTo(clip, SizeLimit) then begin
                PreExit('SaveClipboardTo failed');
                Windows.LeaveCriticalSection(crit);
                EXIT;
            end;
        end;
        HandledDisplayText(clip);
        Windows.CloseClipboard;
        HandleSizeWorkarounds(clip);
        clip.CData.Hash := clip.GetCRC;
    except
        on E: Exception do begin
            Windows.CloseClipboard;
            clip.CFormat := 0;
            result := 0;

            PreExit('<clipItem Dup Exception - ' + E.Message + ' ');
            EXIT;
        end;
    end;

    FrmDebug.AppendLog('<ClipItem ClipboardSave success!> size=' + IntToSTr(clip.CData.size) );
    clip.cdata.timestamp := now;
    clip.CData.timestampused := true;
    result := clip.CFormat;
    Windows.LeaveCriticalSection(crit);
end;
class function TClipboardGrabber.ClipboardHasPicAndText(var textformat :word) : boolean;
var cfl : TList<TClipFormat>;
    i : integer;
begin
    cfl := GetAvailableFormats;
    result := cfl.Contains(CF_DIB);
    result := result and (
        cfl.Contains(CF_UNICODETEXT) or
        cfl.Contains(UnitMisc.GetCF_HTML) or
        cfl.Contains(UnitMisc.GetCF_RICHTEXT) or
        cfl.Contains(CF_TEXT)
    );
    result := result and (Clipboard.AsText <> '');

    if (result) then begin
        textFormat := GetConfiguredTextFormat(cfl);
    end;
    myfree(cfl);
end;

class function TClipboardGrabber.GetConfiguredTextFormat(listOrNil : TClipFormatList) : TClipFormat;
var i : integer;
begin
    if listOrNil = nil then begin
        listOrNil := GetAvailableFormats;
    end;
    result := 0;
    for i := 0 to FrmConfig.FormatCount - 1 do begin
    case FrmConfig.GetFormat(i) of
    FO_RICHTEXT:
        begin
            if listOrNil.Contains(UnitMisc.GetCF_RICHTEXT) then begin
                result := UnitMisc.GetCF_RICHTEXT;
                BREAK;
            end
        end;
    FO_HTML:
        begin
            if listOrNil.Contains(UnitMisc.getCF_HTML) then begin
                result := UnitMisc.GetCF_HTML;
                BREAK;
            end
        end;
    end;
    end;

    if result = 0 then begin
        if listOrNil.Contains(CF_UNICODETEXT) then begin
            result := CF_UNICODETEXT;
        end else begin
            result := CF_TEXT;
        end;
    end;
end;
class function TClipboardGrabber.GetAvailableFormats : TClipFormatList;
var cf : TClipFormat;
begin
    result := TList<TClipFormat>.Create;
    if Clipboard.HasFormat(CF_TEXT) then result.Add(CF_TEXT);
    if clipboard.HasFormat(CF_WAVE) then result.Add(CF_WAVE);
    if clipboard.HasFormat(CF_DIB) then result.Add(CF_DIB);
    if clipboard.HasFormat(CF_HDROP) then result.Add(CF_HDROP);
    if clipboard.HasFormat(UnitMisc.GetCF_RICHTEXT) then result.Add(UnitMisc.GetCF_RICHTEXT);
    if clipboard.HasFormat(UnitMisc.getCF_HTML) then result.Add(UnitMisc.getCF_HTML);
    if clipboard.HasFormat(CF_UNICODETEXT) then result.Add(CF_UNICODETEXT);
end;

class function TClipboardGrabber.TryOpenClipboard : boolean;
var i : integer;
    openOK : boolean;
begin
    // Try a few times to open the the clipboard
    i := 0;
    while (i<4) do begin
        result := Windows.OpenClipboard(Application.Handle);
        if result then BREAK;

        FrmDebug.AppendLog('<ClipItem - can''t open clipboard> attempt = '+IntToStr(i), true);
        Windows.CloseClipboard; // just in case, I'm getting weird false with 0 error code [no error]
        MySleep(50);
        inc(i);
    end;
end;
class function TClipboardGrabber.ChooseAFormat : TClipFormat;
var i : integer;
    cfl : TList<TClipFormat>;
    HasPicture : boolean;
begin
    result := 0;
    cfl := GetAvailableFormats;
    if cfl.Count = 0 then EXIT;

//    HasText := cfl.Contains(CF_TEXT);
    HasPicture := cfl.Contains(cf_DIB);


    if cfl.Contains(CF_WAVE) then begin
        result := CF_WAVE;
    end else if cfl.Contains(CF_DIB) then begin
        result := CF_DIB;
    end else if cfl.Contains(CF_HDROP) then begin
        result := CF_HDROP;
    end;

    if result = 0 then result := GetConfiguredTextFormat(cfl);
end;
class procedure TClipboardGrabber.LastDitchAttempt;
var s : string;
begin
    ci.CFormat := 0;
    s := Clipboard.AsText;
    if s <> '' then begin
        ci.CData.SetString(s);
        ci.CFormat := CF_TEXT;
    end;
end;
class function TClipboardGrabber.CleanRichtextURLs(s : string) : string;
var str : string;
    astr : ansistring;
begin
    str := pansichar(@s[1]);
    // remove the link between the quotes
    astr := '';
    while str <> '' do begin
        astr := astr + UnitToken.TokenString(str,'fldinst HYPERLINK "',false);
        if str = '' then begin
            astr := astr + #0;
            setlength(str, length(astr) div 2);
            move(astr[1], str[1], length(astr));
            result := str;
            EXIT;
        end;

        UnitToken.TokenString(str,'"}',false);
        astr := astr + 'fldsint HYPERLINK ""}';
    end;
end;


//--------------------
// TIconCache
// - allows for multiple clips to share a single handle to an icon
// - icon is deleted when last reference is removed
// - for loading from a file, allow a filename to be associate with a handle
//--------------------
type TIconCache = class(TObject)
    private
        names : TDictionary<string, HICON>;
        refcount : TDictionary<cardinal, integer>;
        function GetShortName(filename : string) : string;
    public
        constructor Create;
        destructor Destroy; override;

        function TryGetIcon(filename : string; ci : TClipItem) : boolean; overload;
        function TryGetIcon(crc : cardinal; ci : TClipItem) : boolean; overload;
        procedure AssignIcon(var h : HICON; filename : string = ''); overload;
        procedure AssignIcon(var h : HICON; crc : cardinal); overload;
        procedure DeleteIcon(h : HICON);
end;
constructor TIconCache.Create;
begin
    refcount := TDictionary<cardinal, integer>.Create;
    names := TDictionary<string, HICON>.create;
end;
destructor TIconCache.Destroy;
begin
    names.Free;
    refcount.Free;
end;
function TIconCache.GetShortName(filename : string) : string;
begin
//    result := ExtractShortPathName(filename);
    result := filename;
end;
function TIconCache.TryGetIcon(crc : cardinal; ci : TClipItem) : boolean;
var h : HICON;
begin
    result := names.TryGetValue(IntToStr(crc), h);
    if Result then ci.CData.SetHICON(h, crc);
end;
function TIconCache.TryGetIcon(filename : string; ci : TClipItem) : boolean;
var h : HICON;
begin
    filename := GetShortName(filename);
    result := names.TryGetValue(filename, h);
    if Result then ci.CData.SetHICON(h, filename);
end;
procedure TIconCache.AssignIcon(var h : HICON; crc : cardinal);
var i : integer;
    h2 : HICON;


begin
    if h = 0 then EXIT;

    if names.TryGetValue( IntToStr(crc), h2) then begin
        if (h2 <> h) and (not refcount.ContainsKey(h)) then begin
            // unreferenced new duplicate detected, get rid of it

            // This occurs with a new clip on the clipboard and the icon
            // is already on the popup
            unitmisc.MyDestroyIcon(h);
            h := h2;
        end;
    end else begin
        names.AddOrSetValue(IntToStr(crc), h);
    end;

    if refcount.TryGetValue(h, i) then begin
        inc(i);
    end else begin
        i := 1;
    end;
    refcount.AddOrSetValue(h, i);
end;
procedure TIconCache.AssignIcon(var h : HICON; filename : string = '');
var i : integer;



begin
    if h = 0 then EXIT;
    if filename = '' then begin
        AssignIcon(h, UnitMisc.IconCRC(h));
        EXIT;
    end;

    // icon is loaded from v1format cache
    if not names.ContainsKey(filename) then begin
        names.Add(filename, h);
    end;
    // in-memory clips and v2format clips will do lookups by CRC
    // add a reference for them
    filename := IntToStr(unitmisc.IconCRC(h));
    if not names.ContainsKey(filename) then begin
        names.AddOrSetValue(filename, h);
    end;

    // increment of initilize reference count
    if refcount.TryGetValue(h, i) then begin
        inc(i);
    end else begin
        i := 1;
    end;
    refcount.AddOrSetValue(h, i);
end;
procedure TIconCache.DeleteIcon(h : HICON);
var i : Integer;
var key : string;
begin
    if not refcount.TryGetValue(h, i) then begin
        FrmDebug.AppendLog('DeleteIcon: Missing icon refcount');
        FrmDebug.AppendLog('^Deleting Icon^');
        unitmisc.MyDestroyIcon(h);
        EXIT;
    end;
    Dec(i);
    if i = 0 then begin
//        FrmDebug.AppendLog('^Deleting Icon^');
        unitmisc.MyDestroyIcon(h);

        // get rid of CRC and/or filename reference
        for key in names.Keys do begin
            if names.Items[key] = h then begin
                names.Remove(key);
            end;
        end;
    end else begin
        refcount.AddOrSetValue(h, i);
    end;
end;
var IconCache : TIconCache;


function IconCRC(bmp : TBitmap) : cardinal;
var
    ms : TMemoryStream;
    crc : TCRC32;
begin
    ms := TMemoryStream.Create;
    crc := TCRC32.Create;

    bmp.SaveToStream(ms);

    crc.ReInit;
    result := crc.Update(ms);

    MyFree(crc);
    MyFree(ms);
end;

//---------------------------------------------
// TCacheResolver
// - used to find Clips an their icons
// - may be used in the future for redirection
//---------------------------------------------
type TCacheResolver = class(TObject)
    private
        TEXTEXT,
        CLIPEXT, CLIPEXT2, CLIPSHADOWEXT,
        ICONEXT : string;
        MASKSUFFIX,
        COLORSUFFIX : string;
        bm : TBitmap;
        function GetBaseName(path:string; index : integer; suffix : string = '') : string;
        function FindIcon(path:string; index:integer; suffix:string) : string;
        function GetArchivePath(filename : string) : string;
    public
        constructor Create;
        destructor Destroy;

        function GetIconCRC(path:string; crc : string) : string;
        function GetIconColor(path:string; index : integer; suffix : string = '') : string;
        function GetIconMask(path:string; index : integer; suffix : string = '') : string;
        function SearchIconColor(path:string; index : integer; suffix : string='') : string;
        function SearchIconMask(path:string; index : integer; suffix : string='') : string;
        function GetClipData(path:string; index : integer) : string;
        function GetClipText(path:string; index : integer) : string;
        function GetClipDataShadow(path:string; index:integer) : string;
        function GetClipData2(path:string; index : integer) : string;
        function GetNewFileStream(filename : string) : TStream;
        procedure SaveStream(filename : string; s : TStream);
end;
constructor TCacheResolver.Create;
begin
    CLIPEXT := '.acz';
    TEXTEXT := '.acy';
    ICONEXT := '.bmp';
    MASKSUFFIX := '-m';
    COLORSUFFIX := '-c';
    CLIPSHADOWEXT := '.acx';
    CLIPEXT2 := FILE_EXT_V2;
    bm := TBitmap.Create;
end;
destructor TCacheResolver.Destroy;
begin
    myfree(bm);
end;
function TCacheResolver.GetBaseName(path:string; index : integer; suffix : string = '') : string;
begin
     result := path + IntToHex(index, 8) + suffix;
end;
function TCacheResolver.GetIconCRC(path:string; crc : string) : string;
begin
    result := IncludeTrailingPathDelimiter(path) + 'idx'+crc+'.bmp';
end;
function TCacheResolver.GetIconColor(path:string; index : integer; suffix : string = '') : string;
begin
    result := GetBaseName(path, index, colorsuffix) + suffix + ICONEXT;
end;
function TCacheResolver.GetIconMask(path:string; index : integer; suffix : string = '') : string;
begin
    result := GetBaseName(path, index, masksuffix) + suffix + ICONEXT;
end;
function TCacheResolver.FindIcon(path:string; index:integer; suffix : string) : string;
var search, s, crc,tempname, redirectname: string;
    rec : TSearchRec;
    tf : TextFile;
    c : cardinal;
    function ExtractReference(name : string) : string;
    begin
        UnitToken.TokenString(Name,'[');
        result := UnitToken.TokenString(Name,']');
        result := path +  result + '.bmp';
    end;
begin
    search := self.GetBaseName(path,index,suffix) + '[*].txt';
    result := self.GetBaseName(path,index,suffix) + ICONEXT;
    path := IncludeTrailingPathDelimiter(path);

    if FindFirst(search, faAnyFile,rec) = 0 then begin
        s := ExtractReference(rec.name);

        // return the indexed file instead
        // create the indexed bitmap if it's missing
        if FileExists(s) then begin
            result := s;
        end else if FileExists(result) then begin
            bm.LoadFromFile(result);
            bm.SaveToFile(s);
            bm.FreeImage;

            result := s;
        end;
    end else if FileExists(result) then begin
        // create the index file and save the index bitmap
        bm.LoadFromFile(result);

        c := IconCRC(bm);
        crc := IntToStr(c);
        tempname := GetIconCRC(path, crc);
        redirectname := self.GetBaseName(path, index, suffix + '[idx'+crc+']') + '.txt';
        if not FileExists(redirectname) then begin
            try
                Assign(tf,redirectname);
                Rewrite(tf);
                Close(tf);
            except
            end;
        end;
        if not FileExists(tempname) then begin
            bm.SaveToFile(tempname);
        end;

        bm.FreeImage;
    end;
    findclose(rec);
end;
function TCacheResolver.SearchIconColor(path:string; index : integer; suffix : string='') : string;
begin
    result := FindIcon(path, index, colorsuffix + suffix);
end;
function TCacheResolver.SearchIconMask(path:string; index : integer; suffix : string='') : string;
begin
    result := FindIcon(path, index, MASKSUFFIX + suffix);
end;
function TCacheResolver.GetClipData(path:string; index : integer) : string;
begin
    result := GetBaseName(path, index) + CLIPEXT;
end;
function TCacheResolver.GetClipText(path:string; index : integer) : string;
begin
    result := GetBaseName(path, index) + TEXTEXT;
end;
function TCacheResolver.GetClipDataShadow(path:string; index:integer) : string;
begin
    result := GetBaseName(path, index) + CLIPSHADOWEXT;
end;
function TCacheResolver.GetArchivePath(filename : string) : string;
begin
    result := '';

    result := TPath.Combine( TPath.GetDirectoryName(filename), 'data.zip');
    if FileExists(result) then begin
        EXIT;
    end;
    result := TPath.Combine(TDirectory.GetParent(TPath.GetDirectoryName(filename)), 'data.zip');
    if FileExists(result) then begin
        EXIT;
    end;

    result := ''
end;
function TCacheResolver.GetClipData2(path:string; index : integer) : string;
begin
    result := GetBaseName(path, index) + CLIPEXT2;
end;
function TCacheResolver.GetNewFileStream(filename : string) : TStream;
begin
    // reading into a TMemoryStream from file was slower, so I guestimate
    // this TFileStream is likely already buffered
    result := TFileStream.Create(filename, fmOpenRead);
end;
procedure TCacheResolver.SaveStream(filename : string; s : TStream);
begin

end;
var Resolver : TCacheResolver;



//-------------------
// (Con/De)structors
//-------------------
constructor TStringQueue.Create;
begin
    sl := TStringList.Create;
end;
destructor TStringQueue.Destroy;
begin
    MyFree(sl);
    inherited Destroy;
end;
procedure TStringQueue.SetQueueSize(size : longint);
begin
    qSize := size;
    while (sl.count > size) and (sl.count > 0) do
        self.DeleteItem(sl.count - 1);
end;
function TStringQueue.GetQueueSize: longint;
begin
    result := qSize;
end;

procedure TStringQueue.DeleteItem(index : cardinal);
begin
    sl.Delete(index);
end;
procedure TStringQueue.InsertAtStart(s : string);
begin
    sl.Insert(0,s);
    self.SetQueueSize(self.qSize);
end;
procedure TStringQueue.AddNoSizeCheck(s: string);
var i : longint;
begin
    i := sl.IndexOf(s);
    if (i = -1) then begin
        sl.Add(s);
    end;
end;

function TStringQueue.GetQueueCount : integer;
begin
    result := sl.count;
end;
function TStringQueue.GetItemText(index : cardinal) : string;
begin
    result := sl[index];
end;
procedure TStringQueue.ClearQueue;
var i : integer;
begin
    for i := (sl.count - 1) downto 0 do begin
        self.DeleteItem(i);
    end;
end;



//////////////////////////
// TClipQueue
//////////////////////////
//-------------------
// (Con/De)structors
//-------------------
constructor TClipQueue.Create;
begin
    sl := TStringList.Create;
    Listeners := TList<TQueueEvent>.create;
end;
destructor TClipQueue.Destroy;
begin
    MyFree(Listeners);
    MyFree(sl);
    inherited Destroy;
end;


procedure TClipQueue.addListener(ChangeListener : TQueueEvent);
begin
    Listeners.Add(ChangeListener);
end;
procedure TClipQueue.removeListener(ChangeListener : TQueueEvent);
begin
    Listeners.Remove(ChangeListener);
end;
procedure TClipQueue.notifyListeners;
var
    listener : TQueueEvent;
begin
    if Listeners<>nil then
        for listener in Listeners do begin
            listener();
        end;
end;

//-------------------
// Configuration
//-------------------
procedure TClipQueue.SetMoveDuplicateTop(enable: boolean);
begin
    self.MoveDuplicateTop := enable;
end;
//-------------------
// Public Interface
//-------------------
// items added to list
const
    USE_COMPRESSION = FALSE;
    COMPRESS_TRIGGER_BYTES = 500000;
procedure TClipQueue.NewClipEvent(ci : TCLipItem);
begin
    ci.BuildMenuCaption;
    ci.GetFormatName(true);
    if USE_COMPRESSION then begin
        if ci.GetStream.Size > COMPRESS_TRIGGER_BYTES then begin
            ci.Compress;
        end;
    end;


end;
function TClipQueue.InsertAtStartNontext(ci: TClipItem) : boolean;
var i : longint;
    limit : integer;
begin
    // No dups, add move to top if configured to do so
    result := false;
    self.NewClipEvent(ci);


    i := self.IndexOf(ci);
    if (i = -1) then begin
        limit := StrToInt(FrmConfig.txtOtherSizeLimitKB.text) * 1024;
        if (limit=0) or (ci.GetDataSize <= limit)  then begin {self.qClipsizeLimit not used}
            ci.OverrideTextVersionOfItem(ci.GetFormatName);

            sl.InsertObject(0, ci.GetAsPlaintext, ci);
            self.SetQueueSize(self.qSize);
            result := true;
        end;
    end else if (self.MoveDuplicateTop) then begin
        self.MoveToStart(i);
        result := true;
    end;

    notifyListeners;
end;
procedure TClipQueue.AddNoSizeCheck(s : string; ci : TClipItem = nil);
var i : longint;
begin
    // No dups, add move to top if configured to do so

    self.NewClipEvent(ci);

    i := sl.IndexOf(s);

    // picture with the same dimensions were being ignored
    if (ci<>nil) and (ci.GetFormatType = FT_PICTURE) then begin
        i := self.IndexOf(ci);
    end;


    if (i = -1) then begin
        sl.AddObject(s, ci);
    end else if (self.MoveDuplicateTop) then begin
        self.MoveToStart(i);
    end;

    notifyListeners;
end;
function TCLipQueue.InsertAtStart(ci: TClipItem) : boolean;
var
    useCase : boolean;
begin

    useCase := false;
    if (assigned(FrmConfig)) then begin
        useCase := FrmConfig.cbCaseSensitive.Checked;
    end;

    result := InsertAtStart(ci, useCase);
end;
function TClipQueue.InsertAtStart(ci : TClipItem; casesensative : boolean) : boolean;
var i : integer;
    ci2 : TClipItem;
    cmp :integer;
    limit : integer;
    procedure NewItem;
    begin
    end;
begin
    FrmDebug.AppendLog('ClipQueue: Inserting Clip');
    result := false;
    self.NewClipEvent(ci);



    sl.CaseSensitive :=  casesensative;
    i := sl.IndexOf(ci.GetAsPlaintext);
    if (i = -1) then begin
        limit := StrToInt(FrmConfig.txtTextSizeLimitKB.text) * 1024;
        if (not frmconfig.cbDontCopyLargeText.checked) or (ci.GetDataSize <= limit)  then begin
            result := true;
            sl.InsertObject(0, ci.GetAsPlaintext, ci);
            self.SetQueueSize(self.qSize);
        end;
    end else begin
        if (self.MoveDuplicateTop) then begin
            // delete an add it in its place if only differs in Case CASE case
            //ci2 := self.GetClipItem(i);

            // use the "new" item and delete the old when case has changed
            // just remove the new item when identical
            ci2 := self.GetClipItem(i);
            cmp := CompareStr(ci2.GetAsPlaintext, ci.GetAsPlaintext);
            if  cmp <> 0 then begin
                DeleteItem(i);
                sl.InsertObject(0, ci.GetAsPlaintext, ci);
                self.SetQueueSize(self.qSize);
            end else begin
                self.MoveToStart(i);
                UnitMisc.MyFree(ci);
            end;
        end;
    end;
    notifyListeners;
    FrmDebug.AppendLog('ClipQueue: Inserting Clip End Result=' +BoolToStr(result));
end;
//
procedure TClipQueue.SetQueueItems(items : TStrings);
begin
    //
    // trim queue if needed

    self.ClearQueue;
    sl.AddStrings(items);
    self.SetQueueSize(self.qSize);
end;
function TClipQueue.IndexOf(s : string) : integer;
begin
    result := sl.IndexOf(s);
end;
function TClipQueue.IndexOf(ci: TClipItem): integer;
var i : integer;
    ci2 : TClipItem;
begin
    result := -1;
    if ci = nil then EXIT;

    if ci.CData.Hash = 0 then begin
        result := sl.IndexOfObject(ci);
    end else begin

        for i := 0 to self.GetQueueCount - 1 do begin
            ci2 := self.GetClipItem(i);
            if (ci.CData.Hash = ci2.CData.Hash) and
                (ci.CData.size = ci2.CData.size) then begin
                result := i;
                EXIT;
            end;
        end;
    end;
end;
procedure TClipQueue.GetQueueItems(items : TStrings);
begin
    items.Clear;
    items.AddStrings( sl );
end;
function TClipQueue.GetClipItem(index: cardinal): TClipItem;
    var ci : TClipItem;
begin
    ci := TClipItem(sl.Objects[index]);
    result := ci;
end;

function TClipQueue.GetClipSafe(index: cardinal): TClipItem;
    var ci : TClipItem;
begin
    result := nil;
    if index >=  sl.Count then begin
        exit;
    end;
    ci := TClipItem(sl.Objects[index]);
    result := ci;
end;



function TClipQueue.GetItemText(index : cardinal) : string;
begin
    result := self.GetClipItem(index).GetAsPlaintext;
end;
// Move items in the list
procedure TClipQueue.MoveToStart(index : cardinal);
begin

    if index >= sl.count then EXIT;
    
    sl.Move(index, 0);

    notifyListeners;
end;
function TClipQueue.Move(oldIndex : cardinal; newIndex : cardinal) : boolean;
begin
    result := false;
    if (newIndex < 0) or (oldIndex < 0) then EXIT;
    if (newIndex >= sl.count) or (oldIndex >= sl.count) then EXIT;

    sl.Move(oldIndex, newindex);
    result := true;

    notifyListeners;
end;
// Remove items from queue
// NOTE: Resources must be released here
procedure TClipQueue.DeleteItem(index : cardinal);
var ci : TClipItem;
begin
    // We've got to clean up the clone icon to avoid a memory leak
    ci := TClipITem(sl.Objects[index]);

    // Add the text to the removed items
    // ClipItem also has global memory to free
    RemovedQueue.InsertAtStart(ci);
    MyFree(ci);

    // this MUST be the ONLY place an item is deleted
    sl.Delete(index);
    notifyListeners;
end;
procedure TClipQueue.DestroyItem(index: cardinal);
var ci : TClipItem;
begin
    // OK, I lied - you can delete here because cleanup will be taken care
    // of. We're not passing off the clip to another queue automatically.

    ci := TClipITem(sl.Objects[index]);

    // ClipItem also has global memory to free
    MyFree(ci);
    sl.Delete(index);

    notifyListeners;
end;
procedure TClipQueue.DestroyItem(ci : TClipItem);
var i : integer;
    c2 : TClipItem;
begin
    for i := 0 to sl.Count-1 do begin
        c2 := TClipItem(sl.Objects[i]);
        if c2.CData.Hash = ci.CData.Hash then begin
            DestroyItem(i);
            EXIT;
        end;
    end;

    notifyListeners;
end;
procedure TClipQueue.ClearQueue;
var i : longint;
begin
    // see note in DeleteQueueItem for rules of removing items
    // from queue
    // I know better, this must go in reverse order
    for i := (sl.count - 1) downto 0 do begin
        self.DeleteItem(i);
    end;
    TClipDatabase.ClearNormal;

    notifyListeners;
end;


//------------------------------
// ClipData / ClipItem
//------------------------------

constructor TClipData.Create(s: string; h: HICON);
begin
    self.plaintext := s;
    self.hndIcon := h;

    self.picturesize := '';
    self.timestampused := false;

    self.thumb := nil;
end;
destructor TClipData.Destroy;
begin
    if hndIcon <> 0 then begin
        //FrmDebug.AppendLog('^Deleting Icon^');
        IconCache.DeleteIcon(hndIcon);
        hndIcon := 0;
    end;

    inherited;
end;

function TClipData.GetCreationDate: TDateTime;
begin
    result := self.timestamp;
end;
function TClipData.CreationDateUsed : Boolean;
begin
    result := Self.timestampused;
end;
procedure TClipData.setTimestamp(timestamp : TDateTime);
begin
    self.timestamp := timestamp;
    self.timestampused := self.timestamp <> 0;
end;
procedure TClipData.setSize(size : integer);
begin
    self.size := size;
end;
function TClipData.GetHICON: HICON;
begin
    if (self.hndIcon = 0) then begin
        result := UnitClipQueue.ClipDataDefaultIcon;
    end else begin
        result := self.hndIcon;
    end;
end;
function TClipData.GetHICONAbsolute: HICON;
begin
    result := self.hndIcon;
end;
function TClipData.GetString: string;
begin
    result := self.plaintext;
end;
procedure TClipData.SetHICON(h: HICON; filename : string = '');
begin
    if h <> 0 then begin
        IconCache.AssignIcon(h, filename)
    end;
    self.hndIcon := h;
end;
procedure TClipData.SetHICON(h : HICON; crc : cardinal);
begin
    if h <> 0 then begin
        IconCache.AssignIcon(h, crc);
        self.hndIcon := h;
    end;
end;
procedure TClipData.DeleteHICON;
begin
    if self.GetHICONAbsolute <> 0 then begin
        IconCache.DeleteIcon(self.GetHICONAbsolute);
        self.SetHICON(0);
    end;
end;
procedure TClipData.SetString(s: string);
begin
    self.plaintext := s;
end;

{ TClipItem }
function TClipItem.GetPicHeight : integer;
begin
    result := self.picht;
end;
function TClipItem.FileFormatToFormat(w : word) : word;
begin
    result := w;
    case result of
    CF_FILE_RICHTEXT:   result := UnitMisc.GetCF_RICHTEXT;
    CF_FILE_HTML:       result := UnitMisc.GetCF_HTML;
    end;
end;
function TClipItem.CloneClip: TClipItem;
begin
    result := TClipITem.Create();

    result.CData.SetString( self.GetAsPlaintext );
    result.CData.SetHICON( self.CData.GetHICONAbsolute );

    result.CData.size := self.cdata.size;
    result.CFormat := self.cformat;
    result.CData.timestamp := self.cdata.timestamp;
    result.CData.timestampused := Self.CData.timestampused;
    result.CData.Hash := self.CData.Hash;
    result.cdata.Clicked := Self.CData.Clicked;
    result.CData.thumb := nil;
    result.CData.displaytext := self.CData.displaytext;

    result.OverwriteStream(self.GetStream);

    if self.RichShadowMemory <> nil then begin
        result.RichShadowMemory := TMemoryStream.Create;
        result.RichShadowMemory.CopyFrom(self.RichShadowMemory, 0);
    end;
end;
constructor TClipItem.Create;
begin
    self.CData := TClipData.Create('', 0);
    self.CFormat := 0;
    self.ClipMemory := TMemoryStream.Create;
    self.RichShadowMemory := nil;
end;
destructor TClipItem.Destroy;
begin
    self.CleanupMemory;
    MyFree(CData);
    inherited Destroy;
end;
procedure TClipItem.CleanupMemory;
begin
    ClearStream;

    if (CData<>nil) and (cdata.thumb <> nil) then begin
        myfree(cdata.thumb);
    end;
    self.CData.displaytext := '';
    self.CData.SetString('');

    if (RichShadowMemory<>nil) then
        myfree(RichShadowMemory);
end;
function TClipItem.GetCRC : Cardinal;
begin
    UnitCRC32.CRC32.ReInit;
    result := UnitCRC32.CRC32.Update(GetStreamRaw);
end;
function TClipItem.GetAsPlaintext: string;
begin
    case GetFormatType of
    FT_TEXT:
        begin
            if GetStream.Size = 0 then begin
                result := CData.GetString;
            end else begin
                self.GetAnsiText(result);
            end;
        end;
    FT_UNICODE:
        begin
            if GetStream.Size = 0 then begin
                result := CData.GetString;
            end else begin
                self.GetUnicodeText(result);
                result := pchar(result);
            end;
        end;
    else
        begin
            result := CData.GetString;
        end;
    end;

end;

function TClipItem.getDisplayText : string;
begin
    result := cdata.displaytext;
end;

function TClipItem.isCompressed : boolean;
begin
    result := fCompressed;
end;
procedure TClipItem.Compress;
var
    ms : TMemoryStream;
    ms2 : TMemoryStream;
begin
    ms := TMemorySTream.Create;
    ms2 := TMemoryStream.Create;
    ms2.CopyFrom(GetStreamRaw,0);
    unitmisc.CompressZip(TStream(ms2), TStream(ms));
    ClearStream;
    GetStreamRaw.CopyFrom(ms, 0);

    myfree(ms);
    myfree(ms2);

    self.fCompressed := true;
end;
procedure TClipItem.Decompress;
var
    ms : TStream;
    ms2 : TStream;

begin
    ms2 := TMemoryStream.Create;
    ms := TMemoryStream.Create;
    ms.CopyFrom(GetStreamRaw, 0);

    unitmisc.DecompressZip(ms, ms2);
    ClearStream;
    TMemoryStream(GetStreamRaw).LoadFromStream(ms2);

    myfree(ms2);
    myfree(ms);
    self.fCompressed := false;
end;

//
// Return the format of clipitem saved
// 0 = ERROR
// NOTES: GetAtText will return empty unless the clipboard has CF_TEXT or
// CF_HDROP
//
function TClipItem.GetClipboardItem( hi: HICON; OverrideFormat : word = 0; SizeLimit : cardinal = $FFFF): cardinal;
begin
    result := TClipboardGrabber.GetClipboardItem(self, hi, OverrideFormat, SizeLimit);
end;

// return all filenames or return empty string
function TClipItem.GetFilenamesAsText(h : THandle): string;
var i, j : longint;
    s : string;
begin
    Windows.SetLastError(ERROR_SUCCESS);
    result := '';

    if (CFormat = CF_HDROP) then begin
        FrmDebug.AppendLog('    Detecting Filenames...');

        try
            //
            // On Win9x, the handle must be on the clipboard and the clipboard
            // must be open; otherwise, bad bad stuff happens
            //
            FrmDebug.AppendLog('GetFilenamesAsText');
            s := stringofchar(#0, Windows.MAX_PATH+1);
            j := ShellApi.DragQueryFile(h, Cardinal(-1){//$FFFFFFFF}, nil, 0);
            FrmDebug.AppendLog('FileCount=' + IntToSTr(j));
            result := '';
            for i := 0 to (j - 1) do begin
                s := stringofchar(#0, Windows.MAX_PATH+1);
                ShellApi.DragQueryFile(h, i, pchar(s), Windows.MAX_PATH);
                FrmDebug.AppendLog(Trim(String(s)));
                if i = (j - 1) then begin
                    result := result + Trim(PChar(s));
                end else begin
                    result := result + Trim(PChar(s)) + #13 + #10;
                end;
            end;

        except
            on e : exception do begin
                FrmDebug.AppendLog('GetFilenamesAsText' + #13#10 +
                    e.Message + ' ', true
                );
            end;
        end;
    end;
end;
function TClipItem.GetFormat: cardinal;
begin
    result := self.CFormat;
end;

function TClipItem.GetStreamRaw : TStream;
begin
    ClipMemory.Position := 0;
    result := ClipMemory;
end;
function TClipItem.GetStream : TStream;
begin
    if USE_COMPRESSION then begin
        if isCompressed then begin
           Decompress;
        end;
    end;
    result := GetStreamRaw;
end;
procedure TClipItem.OverwriteStream(st : TStream);
begin
    self.ClearStream;
    self.GetStreamRaw.CopyFrom(st, 0);
end;
procedure TClipItem.FinishedWithStream;
begin
    if USE_COMPRESSION then begin
        if not self.isCompressed then begin
            if GetStreamRaw.Size > COMPRESS_TRIGGER_BYTES then begin
                self.Compress;
            end;
        end;
    end;
end;
procedure TClipItem.ClearStream;
begin
    if ClipMemory is TMemoryStream then begin
        TMemoryStream(GetStreamRaw).Clear;
    end;
end;
procedure TClipItem.OverrideTextVersionOfItem(s : string);
begin
    if self.CFormat = 0 then self.CFormat := CF_TEXT;
    self.CData.SetString(s);
end;

function TClipItem.GetFormatName(AccessHandle : boolean = true) : string;
var name : array[0 .. 80] of char;
    format : cardinal;
    p2 : tagBITMAPINFO;
    st : TStream;
begin
    Windows.SetLastError(ERROR_SUCCESS);

    format := self.CFormat;

    case (format) of
        CF_DIB          : begin
            if (AccessHandle) then begin
                if CData.picturesize = '' then begin
                    st := self.GetStream;
                    st.Position := 0;
                    st.Read(p2, SizeOf(p2));

                    picwd := p2.bmiHeader.biWidth;
                    picht := p2.bmiHeader.biHeight;
                    result := 'Picture (DIB) ' + IntToStr(p2.bmiHeader.biWidth) + 'x' + IntToStr(p2.bmiHeader.biHeight);
                    cdata.picturesize := result;
                end else begin
                    result := CData.picturesize;
                end;
            end else begin
                result := 'Picture (DIB)';
            end;
        end;
        CF_WAVE         : result := 'Wave Audio';
        CF_BITMAP       : result := 'Picture (Bitmap)';
        CF_HDROP        : result := 'File(s)';

        CF_DIF          : result := 'CF_DIF';
        CF_TEXT         : result := 'Plain text';
        CF_SYLK         : result := 'CF_SYLK';
        CF_TIFF         : result := 'CF_TIFF';
        CF_RIFF         : result := 'CF_RIFF';
        CF_LOCALE       : result := 'CF_LOCALE';
        CF_OEMTEXT      : result := 'CF_OEMTEXT';
        CF_PALETTE      : result := 'CF_PALETTE';
        CF_PENDATA      : result := 'CF_PENDATA';
        CF_UNICODETEXT  : result := 'Unicode';
        CF_ENHMETAFILE  : result := 'CF_ENHMETAFILE';
        CF_METAFILEPICT : result := 'CF_METAFILEPICT';
        else begin
            if format = UnitMisc.GetCF_HTML then begin
                result := 'HTML';
            end else if format = UnitMisc.GetCF_RICHTEXT then begin
                result := 'RichText';
            end else begin
                FrmDebug.AppendLog('Unknown format...');
                if Windows.GetClipboardFormatName(format,  @name,  sizeof(name)  ) <> 0 then begin
                    Result := string(name);
                    if (result  = '') then begin
                        result := 'Unknown';
                    end;
                end else begin
                    FrmDebug.AppendLog('Format Name failed', true);
                    result := 'Error: Unknown';
                end;
            end;
        end;
   end;

end;
function TClipItem.GetFormatType: TClipFormatType;
var c : Cardinal;
begin
	result := FT_UNKNOWN;
	c := GetFormat;

    if c = CF_TEXT then begin
    	result := FT_TEXT;
    end else if c = CF_UNICODETEXT then begin
    	result := FT_UNICODE;
    end else if c = CF_DIB then begin
        result := FT_PICTURE
    end else if c = CF_HDROP then begin
        result := FT_FILE
    end else if c = GetCF_HTML then begin
    	result := FT_HTML;
    end else if c = GetCF_RICHTEXT then begin
        result := FT_RICHTEXT;
    end else if c = CF_WAVE then begin
        result := FT_AUDIO;
    end;
end;
procedure TClipItem.DibToBitmap(BM : TBitmap);
var
    bmfh :  TBitmapFileHeader;
    bi :  BitmapInfo;
    ms :  TMemoryStream;
    ColorsUsed : integer;

    st : TStream;
begin
    st := self.GetStream;
    st.Read(bi, sizeof(Bi));

    try
        // Caculate the number of colors used (power of 2)
        ColorsUsed := bi.bmiHeader.biClrUsed;
        if (ColorsUsed = 0) and (bi.bmiHeader.biBitCount <= 8) then
            ColorsUsed := 1 shl bi.bmiHeader.biBitCount;

        bmfh.bfType := $4D42;  // 'BM'
        bmfh.bfReserved1 := 0;
        bmfh.bfReserved2 := 0;
        // point to location of actual data
        // header is variable because of the RGBQuads
        bmfh.bfOffBits := SizeOf(TBitmapFileHeader)       +
                   SizeOf(TBitmapInfoHeader)       +
                   ColorsUsed * SizeOf(TRGBQuad);
        // from msdn: DIBs and Their Use (GDI Technical Articles)
        //  "The crazy roundoffs and shifts account for the
        //  bitmap being DWORD-aligned at the end of every scanline.""
        // Hooray for microkernel garbage!
        if bi.bmiHeader.biSizeImage = 0 then begin
            with bi.bmiHeader do begin
                biSizeImage :=
                ((((biWidth * biBitCount) + 31) and
                    (not 31)) shr 3) * biHeight;
            end;
        end;
        bmfh.bfSize := bmfh.bfOffBits + bi.bmiHeader.biSizeImage;
        // Create a fake bitmap file and load it into a TBitmap
        ms := TMemoryStream.Create;
        try
            ms.Write(bmfh, SizeOf(TBitmapFileHeader));
            ms.CopyFrom(self.GetStream, 0);
            ms.Position := 0;
            BM.LoadFromStream(ms);
        finally
            ms.Free
        end;
    finally
    end;
end;

procedure TClipItem.GetDIB(pic : TPicture);
begin
    Windows.SetLastError(ERROR_SUCCESS);

    if (self.CFormat = CF_DIB) then begin
        DibToBitmap(pic.Bitmap);
        self.FinishedWithStream;
    end;
end;
procedure TClipItem.GetDIB(ms : TStream);
begin
    ms.CopyFrom(GetStream, 0);
    self.FinishedWithStream;
end;

procedure TClipItem.GetUTF8Text(var s : string);
var astr : AnsiString;
    st : TStream;
begin
    SetLength(astr, GetDataSize);
    st := self.GetStream;
    st.Read(astr[1], GetDataSize);

    s := UTF8Decode( PAnsiChar(astr));
end;
procedure TClipItem.GetAnsiText(var s : string);
var astr : AnsiString;
    st : TStream;
begin
    SetLength(astr, GetDataSize);
    st := self.GetStream;
    st.Read(astr[1], GetDataSize);

    s := string(astr);
end;
procedure TClipItem.GetRichText(var s: string);
var
    st : TStream;
begin
    SetLength(s, self.GetDataSize);
    st := self.GetStream;
    st.Read(s[1], GetDataSize);
    s := s + #0;
end;
procedure TClipItem.GetUnicodeText(var s : string);
var
    st : TStream;
    sz : integer;
begin

    SetLength(s, self.GetDataSize);
    st := self.GetStream;
    st.Read(s[1], GetDataSize);
end;
function TClipItem.GetRichStream : TStream;
begin
    result := self.RichShadowMemory;
end;

function TClipItem.GetDataSize: cardinal;
begin
    result := self.CData.size;
end;
function TClipItem.GetFilename(path: string; index: integer): string;
begin
    result := Resolver.GetClipData(path, index);
end;
function TClipItem.GetFilenameV2(path : string; index : integer) : string;
begin
    result := Resolver.GetClipData2(path, index);
end;

procedure TClipItem.SaveToFile(path : string; index : integer);
var
    w : word;
    clpname, str : UnicodeString;
    header : word;

    fs : TFileStream;

    st : TStream;

    procedure WriteClip(clpname : string);

    begin
        fs := TFileStream.Create(clpname, fmCreate);
        if (self.CFormat = UnitMisc.GetCF_RICHTEXT) then begin
            w := CF_FILE_RICHTEXT;
        end else if (self.CFormat = UnitMisc.GetCF_HTML ) then begin
            w := CF_FILE_HTML;
        end else begin
            w := self.CFormat;
        end;
        fs.Write(w, sizeof(self.CFormat));
        fs.Write(self.CData.size, sizeof(self.CData.size));

        st := self.GetStream;
        fs.CopyFrom(st, 0);
        fs.Write(self.CData.hash, sizeof(self.CData.hash));
        if Self.CData.timestampused then begin
            fs.Write(Self.CData.timestamp, SizeOf(Self.CData.timestamp));
        end;
        MyFree(fs);
    end;
begin
    st := self.GetStream;
    if st.Size = 0 then EXIT;
    if self.CData.size = 0 then EXIT;

    clpname := Resolver.GetClipData(path, index);
    WriteClip(clpname);
    if self.HasRichShadow then begin
        clpname := Resolver.GetClipDataShadow(path, index);
        fs := TFileStream.Create(clpname, fmCreate);
        fs.CopyFrom(RichShadowMemory, 0);
        myfree(fs);
    end;



    // simple text version
    str := self.GetAsPlaintext;
    if str = '' then begin
        EXIT;
    end;
    clpname := Resolver.GetClipText(path, index);
    try
        fs := TFileStream.Create(clpname, fmCreate);
        if length(str) > 0 then begin
            header := $FEFF;
            fs.Write(header, sizeof(header));
            fs.Write(str[1], strsize(str));
        end;
    finally
        MyFree(fs);
    end;

end;
procedure TClipItem.SetFromPlainText(text: string);
var sz : cardinal;
begin
    self.CFormat := CF_UNICODETEXT;
    self.GetStream.Size := 0;
    text := text + #0;
    sz := length(text) * SizeOf(char);
    self.GetStream.Write(text[1], sz);
    self.GetStream.Seek(0, soFromBeginning);

    self.CData.size := sz;
end;
procedure TClipItem.SetDisplayText(text : string);
begin
    self.CData.displaytext := text;
end;
function TClipItem.LoadOnlyFormat(path : string; index : Integer) : word;
var f : file;

    clpname : string;

label EXIT_CODE;

begin
    result := 0;
    clpname := Resolver.GetClipData(path, index);
    if not (FileExists(clpname)) then begin
        EXIT;
    end;

    assignfile(f, clpname);
    reset(f,1);
    if filesize(f) = 0 then begin
        close(f);
        EXIT;
    end;
    try
        blockread(f, result, sizeof(result));
    finally
        Close(f);
    end;

    result := self.FileFormatToFormat(result);
end;
procedure TClipItem.LoadFromFile(path : string; index : integer);
var
    clpname, str : string;
    fs : TStream;
    sz : Int64;
    b : boolean;
    function fsEOF : Boolean;
    begin
        result := fs.position >= sz;
    end;
    function ReadHeader : boolean;
    type theader = packed record
        format : word;
        size : cardinal;
    end;
    var header : THeader;
    begin
        result := false;
        sz := fs.Size;

        try
            fs.Read(header, sizeof(header));

            self.CFormat := self.FileFormatToFormat(header.format);
            self.CData.size := header.size;
        except
            on e: exception do begin
                FrmDebug.AppendLog('TClipItem.LoadFromFile: read1 error' + SysErrorMessage(GetLastError) + e.Message );
                self.CData.size := 0;
                result := false;
                EXIT;
            end;
        end;

        result := true;
    end;
    function ReadClipData : boolean;
    begin
        result := true;
        ClearStream;
        try
            GetStreamRaw.CopyFrom(fs, self.CData.size);
            self.CData.Hash := 0;
            if not fsEOF then begin
                fs.Read(self.CData.fhash, sizeof(self.CData.fhash));
            end;
            if not fsEOF then begin
                fs.Read(self.CData.timestamp, sizeof(self.CData.timestamp));
                self.CData.timestampused := true;
            end;
            if self.CData.Hash = 0 then begin
                CData.Hash := self.GetCRC;
            end;
        except
            on e: exception do begin
                self.CData.size := 0;

                ClearStream;
                FrmDebug.AppendLog('TClipItem.LoadFromFile: read2 error' + SysErrorMessage(GetLastError) + e.message);
                result := False;
            end;
        end;

        if result then begin
            self.GetFormatName(true);
        end;
    end;
    function ReadPlainText : Boolean;
    var
        header : word;
        oldtext : ansistring;
    begin
        result := false;
        clpname := Resolver.GetClipText(path, index);


        oldtext := '';
        str := '';
        if not fileexists(clpname) then EXIT;

        self.CData.SetString( TFile.ReadAllText(clpname) );
    end;
label EXIT_CODE;

begin
    clpname := Resolver.GetClipData(path, index);
    if not (FileExists(clpname)) then begin
        EXIT;
    end;

    fs := Resolver.GetNewFileStream(clpname);
    if not ReadHeader then begin
        fs.Free;
        EXIT;
    end;
    b := ReadClipData;
    fs.free;
    if not b then begin
        //EXIT; // TODO - figure out the propper response
    end;

    clpname := Resolver.GetClipDataShadow(path, index);
    if FileExists(clpname) then begin
        fs := TFileStream.Create(clpname, fmOpenRead);
        fs.Position := 0;
        RichShadowMemory := TMemoryStream.Create;
        RichShadowMemory.CopyFrom(fs, fs.size);
        myfree(fs);
    end;



    b := ReadPlainText;
    if b then
        fs.Free;
end;
procedure TClipItem.LoadIconFromFile(path : string; index : integer; suffix : string = '');
    function LoadNewBitmap(name : string) : TBitmap;

    begin
        result := TBitmap.Create;
        result.LoadFromFile(name);
    end;
var icn : TIcon;
    bit1, bit2 : TBitmap;
    info : _ICONINFO;
    iconNameM, iconNameC : string;
    h : HICON;
begin
    // legacy support
    // load the ICO version only if the BMP
    // version does not exist

    CData.DeleteHICON;

    iconNameM := Resolver.SearchIconMask(path, index, suffix);
    iconNameC := Resolver.SearchIconColor(path, index, suffix);
    if (FileExists(iconNameM) and FileExists(iconNameC)) then begin
        if (IconCache.TryGetIcon(IconNameM, self)) then begin
            // icon is set automatically
        end else begin
            try
                bit1 := LoadNewBitmap(iconNameM);
                bit2 := LoadNewBitmap(iconNameC);

                info.fIcon := true;
                info.xHotspot := 0;
                info.yHotspot := 0;
                info.hbmMask := bit1.Handle;
                info.hbmColor := bit2.Handle;

                h := Windows.CreateIconIndirect(info);
                self.CData.SetHICON( h, iconNameM );

                MyFree(bit1);
                MyFree(bit2);
            except
            end;
        end;
    end else begin
        iconNameM := path + IntToStr(index) + suffix + '.ico';

        if (FileExists(iconNameM)) then begin
            icn := TIcon.Create;
            try
                icn.LoadFromFile(iconnameM);
                h := unitmisc.CloneIcon(icn.Handle);
                self.CData.SetHICON(h);
            except
                // ignore empty / null icon files
            end;
            icn.free;
        end;
    end;
end;
procedure TClipItem.SaveIconToFile(path : string; index : integer; suffix : string = '');
var bit1, bit2 : TBitmap;
    info : _ICONINFO;
    ms : TMemoryStream;
    im, ic : string;
    crc : cardinal;
    procedure MakeIndexFile(name : string; crc : integer);
    var s : string;
        tf : textfile;
        rec : TSearchRec;
        i : integer;
    begin
        s := StringReplace(name,'.bmp','[*].txt',[rfIgnoreCase]);
        i := FindFirst(s,faAnyFile,rec);
        while (i=0) do begin
            DeleteFile(ExtractFilePath(s) + rec.name);
            i := FindNext(rec);
        end;
        FindClose(rec);

        s := StringReplace(name,'.bmp','[idx'+IntToStr(crc)+'].txt',[rfIgnoreCase]);
        try
            Assign(tf,s);
            Rewrite(tf);
            Close(tf);
        except
        end;
    end;
var idxname : string;
begin
    if (self.CData.GetHICONAbsolute <> 0) then begin
        bit1 := TBitmap.Create;
        bit2 := TBitmap.Create;
        ms := TMemoryStream.Create;

        im := Resolver.GetIconMask(path,index,suffix);
        ic := Resolver.GetIconColor(path,index,suffix);

        Windows.GetIconInfo(self.CData.GetHICONAbsolute, info);
        bit1.Handle := info.hbmMask;
        bit1.SaveToFile(im);
        crc := IconCRC(bit1);
        idxname := Resolver.GetIconCRC(path, IntToStr(crc));
        if not FileExists(idxname) then
            bit1.SaveToFile(idxname);
        MakeIndexFile(im, crc);

        bit2.Handle := info.hbmColor;
        bit2.SaveToFile(ic);
        crc := IconCRC(bit2);
        idxname := Resolver.GetIconCRC(path, IntToStr(crc));
        if not FileExists(idxname) then
            bit2.SaveToFile(idxname);
        MakeIndexFile(ic, crc);

        DeleteObject(info.hbmMask);
        DeleteObject(Info.hbmColor);

        MyFree(ms);
        MyFree(bit1);
        MyFree(bit2);
    end else begin
        //
        // Without this, null icons will use old cached icon from other clips
        //
        DeleteFile(Resolver.GetIconMask(path,index,suffix));
        DeleteFile(Resolver.GetIconColor(path,index,suffix));
    end;

end;
function TClipItem.HasText: boolean;
begin
    result := (self.GetAsPlaintext <> '') and (self.CFormat <> CF_HDROP) and (self.CFormat <> CF_DIB) and (self.CFormat <> CF_WAVE);
end;


procedure TClipItem.SaveToFile(path : string; index : integer; readmask : cardinal);
var
    header : TClipFileHeader;
    thumb : TMemoryStream;
    st : TStream;
    fs : TStream;
    filename : string;
    ico : TMemoryStream;

    procedure SetHeaderData;
    begin
        if (self.CFormat = UnitMisc.GetCF_RICHTEXT) then begin
            header.format := CF_FILE_RICHTEXT;
        end else if (self.CFormat = UnitMisc.GetCF_HTML ) then begin
            header.format := CF_FILE_HTML;
        end else begin
            header.format := self.CFormat;
        end;
        header.cliphash := self.CData.Hash;
        header.timestamp := 0;
        header.iconCRC := 0;

        header.plaintextSize := 0;
        header.thumbSize := 0;
        header.richshadowSize := 0;
        header.menucaptionSize := length(self.CData.displaytext) * SizeOf(char);
        header.iconSize := 0;
        header.clipSize := st.size;

        if (ico <> nil) and (ico.Size <> 0) then begin
            header.iconCRC := UnitMisc.IconCRC(CData.GetHICONAbsolute);
            ico.Position := 0;
            header.iconSize := ico.Size;
        end;
        if CFormat <> CF_UNICODETEXT then
            header.plaintextSize := length(self.GetAsPlaintext) * SizeOf(char);
        if self.CData.timestampused then
            header.timestamp := self.CData.timestamp;
        if thumb <> nil then
            header.thumbSize := thumb.Size;
        if RichShadowMemory <> nil then
            header.richshadowSize := RichShadowMemory.Size;
    end;
    function IsSet(mask : cardinal) : boolean;
    begin
        result := (readmask and mask) <> 0;
    end;
    function MustSave(size : cardinal; mask : cardinal) : boolean;
    begin
        result := (size <> 0) and IsSet(mask);
    end;

var s : string;
    cnt : integer;
    b : boolean;
begin
    if (TClipDatabase.exists) then begin
        if StrUtils.EndsText('\pinned\', path) then begin
            TClipDatabase.SavePinned(self);
        end else if StrUtils.EndsText('\removedcache\', path) then begin
            TClipDatabase.SaveRemoved(self);
        end else if StrUtils.EndsText('\textcache\', path) then begin
            TClipDatabase.SaveNormal(self, index);
        end else  begin
            TClipDatabase.SavePermanent(self, index, ExtractFileDir(path));
        end;
        EXIT;
    end;


    thumb := nil;
    if CData.thumb <> nil then begin
        thumb := TMemoryStream.create;
        CData.thumb.SaveToStream(thumb);
    end;
    st := GetStream;

    ico := nil;
    if CData.GetHICONAbsolute <> 0 then begin
        ico := TMemoryStream.Create;
        SaveIconToStream(ico);
        ico.Position := 0;
        if ico.Size = SizeOf(cardinal) * 2 then begin
            myfree(ico);
        end;
    end;

    SetHeaderData;

    filename := Resolver.GetClipData2(path, index);
    try
        fs := TFileStream.Create(filename, fmCreate or fmShareExclusive);
        cnt := fs.Write(header, sizeof(header));
        if MustSave(header.plaintextSize, CI_FILEMASK_PLAIN) then begin
            s := GetAsPlaintext;
            cnt := fs.Write(s[1], header.plaintextSize);
        end;
        if MustSave(header.thumbsize, CI_FILEMASK_THUMB) then begin
            cnt := fs.CopyFrom(thumb, 0);
        end;
        if MustSave(header.richshadowSize, CI_FILEMASK_SHADDOW) then begin
            cnt := fs.CopyFrom(RichShadowMemory, 0);
        end;
        if MustSave(header.menucaptionSize, CI_FILEMASK_CAPTION) then begin
            cnt := fs.Write(self.CData.displaytext[1], header.menucaptionSize);
        end;
        if MustSave(header.iconSize, CI_FILEMASK_ICON) then begin
            cnt := fs.CopyFrom(ico, 0);
        end;
        cnt := fs.CopyFrom(st, 0);
    finally
        myfree(fs);
        myfree(ico);
        myfree(thumb);
    end;
end;
procedure TClipItem.LoadFromFile(path : string; index : integer; readmask : cardinal);
    function IsSet(mask : cardinal) : boolean;
    begin
        result := (readmask and mask) <> 0;
    end;
var
    header : TClipFileHeader;
    fs : TFileStream;
    ms : TMemoryStream;
    clpname : string;
    s : string;
    st : TStream;

    p : pointer;
    cnt : integer;

    needPlaintext : boolean;
    b : boolean;
const
    TIMING_LOG = false;
    procedure LoadHeader;
    begin
        if fs.Read(header, sizeof(header)) <> sizeof(header) then begin
            EXIT;
        end;
        self.CFormat := self.FileFormatToFormat(header.format);
        self.CData.Hash := header.cliphash;
        self.CData.timestamp := header.timestamp;
        self.CData.timestampused := self.CData.timestamp <> 0;
        self.CData.size := header.clipSize;
    end;
    procedure SkipBytes(size : cardinal);
    begin
        fs.Seek(size, soFromCurrent);
    end;
    procedure ReadErrorCheck(size : cardinal);
    begin
        if size > (fs.Size - fs.Position) then begin
            raise Exception.Create('ClipItem.LoadFromFil(): Request greater that available data.');
        end;
    end;
    function MustRead(size : cardinal; mask : cardinal) : boolean;
    begin
        result := size <> 0;
        try
            if result then begin
                result := false;
                ReadErrorCheck(size);

                if IsSet(mask) then begin
                    result := true;
                end else begin
                    SkipBytes(size);
                end;
            end;
        except
            RAISE;
        end;
    end;

    procedure FinalCode;
    begin
        myfree(fs);
        if TIMING_LOG then UnitMisc.LogTimeEnd('LoadFromFile - ');
    end;
begin
    if (TClipDatabase.exists) then begin
        if StrUtils.EndsText('\pinned\', path) then begin
            TClipDatabase.LoadPinned(self, index);
        end else if StrUtils.EndsText('\removedcache\', path) then begin
            TClipDatabase.LoadRemoved(self, index);
        end else if StrUtils.EndsText('\textcache\', path) then begin
            TClipDatabase.LoadNormal(self, index);
        end else begin
            TClipDatabase.LoadPermanent(self, index, ExtractFileDir(path));
        end;
        EXIT;
    end;

    clpname := Resolver.GetClipData2(path, index);
    if not (FileExists(clpname)) then begin
        EXIT;
    end;

    if not IsSet(CI_FILEMASK_NO_CLEAR) then begin
        self.CleanupMemory;
    end;

    if TIMING_LOG then UnitMisc.LogTimeStart;
    fs := TFileStream.Create(clpname, fmOpenRead);
    if fs.Size = 0 then begin
        myfree(fs);
        EXIT;
    end;
    LoadHeader;

    if readmask = 0 then begin
        FinalCode;
        EXIT;
    end;

    try
        if MustRead(header.plaintextSize, CI_FILEMASK_PLAIN) then begin
            s := StringOfChar(#0, (header.plaintextSize div SizeOf(char)) + 1);
            cnt := fs.Read(s[1], header.plaintextSize);
            s := PChar(s);
            CData.SetString(s);
        end;
        if MustRead(header.thumbsize, CI_FILEMASK_THUMB) then begin
            ms := TMemoryStream.Create;
            cnt := ms.CopyFrom(fs, header.thumbSize);
            ms.Position := 0;
            CData.thumb := TBitmap.Create;
            CData.thumb.LoadFromStream(ms);
            myfree(ms);
        end;
        if MustRead(header.richshadowSize, CI_FILEMASK_SHADDOW) then begin
            RichShadowMemory := TMemoryStream.create;
            cnt := RichShadowMemory.CopyFrom(fs, header.richshadowSize);
        end;
        if MustRead(header.menucaptionSize, CI_FILEMASK_CAPTION) then begin
            s := StringOfChar(#0, (header.menucaptionSize div SizeOf(char)) + 1);
            cnt := fs.Read(s[1], header.menucaptionSize);
            s := PChar(s);
            CData.displaytext := s;
        end;
        if MustRead(header.iconSize, CI_FILEMASK_ICON) then begin
            if not IconCache.TryGetIcon(header.iconCRC, self) then begin
                ms := TMemoryStream.Create;
                cnt := ms.CopyFrom(fs, header.iconSize);
                try
                    LoadIcons(ms, header.iconCRC);
                except
                    header.iconSize := 0;
                    header.iconCRC := 0;
                    CData.hndIcon := 0;
                end;
                MyFree(ms);
            end else begin
                SkipBytes(header.iconSize);
            end;
        end;
    except
        CData.size := 0;
        FinalCode;
        EXIT;
    end;

    needPlaintext := (self.CFormat = CF_UNICODETEXT) and IsSet(CI_FILEMASK_PLAIN) and (self.CData.plaintext = '');
    if IsSet(CI_FILEMASK_CLIP) or (needPlaintext) then begin
        st := GetStreamRaw;
        p := GetMemory(header.clipSize);
        cnt := fs.Read(p^, header.clipSize);
        cnt := st.Write(p^, header.clipSize);
        freememory(p);
    end;

    FinalCode;
end;
procedure TClipItem.SaveIconToStream(st : TStream);
var
    bit1, bit2 : TBitmap;
    ms1, ms2 : TMemoryStream;
    c : cardinal;
    info : _ICONINFO;
begin
    bit1 := TBitmap.Create;
    bit2 := TBitmap.Create;
    ms1 := TMemoryStream.Create;
    ms2 := TMemoryStream.Create;

    Windows.GetIconInfo(self.CData.GetHICONAbsolute, info);
    bit1.Handle := info.hbmMask;
    bit1.SaveToStream(ms1);

    bit2.Handle := info.hbmColor;
    bit2.SaveToStream(ms2);

    // SizeOf Mask, SizeOf Color, Mask, Color
    c := ms1.Size;
    st.Write(c, sizeof(c));
    c := ms2.Size;
    st.Write(c, sizeof(c));
    st.CopyFrom(ms1, 0);
    st.CopyFrom(ms2, 0);

    DeleteObject(info.hbmMask);
    DeleteObject(Info.hbmColor);

    MyFree(ms1);
    MyFree(ms2);
    MyFree(bit1);
    MyFree(bit2);
end;
procedure TClipItem.LoadIcons(st : TStream; iconcrc : cardinal);
    var masksize, colorsize : cardinal;
        ms1, ms2 : TMemoryStream;
        bitmask, bitcolor : TBitmap;
        info : _ICONINFO;
        h : HICON;
    begin
        // read sizes
        st.seek(0, soFromBeginning);
        st.Read(masksize, sizeof(masksize));
        st.Read(colorsize, sizeof(colorsize));

        if (masksize + colorsize) > st.Size then begin
            EXIT;
        end;

        // load bitmaps
        ms1 := TMemoryStream.Create;
        ms1.CopyFrom(st, masksize);
        ms1.position := 0;
        ms2 := TMemoryStream.Create;
        ms2.CopyFrom(st, colorsize);
        ms2.position := 0;
        // convert to TBitmap
        bitmask := TBitmap.Create;
        bitmask.LoadFromStream(ms1);
        bitcolor := TBitmap.Create;
        bitcolor.LoadFromStream(ms2);
        // convert to HICON
        info.fIcon := true;
        info.xHotspot := 0;
        info.yHotspot := 0;
        info.hbmMask := bitmask.Handle;
        info.hbmColor := bitcolor.Handle;
        h := Windows.CreateIconIndirect(info);
        CData.SetHICON(h, iconcrc);
        // clean up
        myfree(bitmask); myfree(bitcolor);
        myfree(ms1); myfree(ms2);
    end;
function TClipItem.TryGetIcon(crc : cardinal) : boolean;
begin
    result := IconCache.TryGetIcon(crc, self)
end;


function TClipItem.HasRichShadow : boolean;
begin
    result := self.RichShadowMemory <> nil;
end;
procedure TClipItem.GetRichTextShadow(var s: string);
begin
    SetLength(s, (RichShadowMemory.size div 2) + 1);
    FillChar(s[1], length(s), #0);
    RichShadowMemory.Position := 0;
    RichShadowMemory.Read(s[1], RichShadowMemory.size);
end;
procedure TClipItem.BuildMenuCaption;
const
    MIDDLE_DOT = WideChar($B0);
    ELLIPSES = WideChar($2026);
    VERTICAL_ELLIPSES = WideChar($22EE);
    RETURN_SYMBOL = WideChar($23ce);
    SMALL_BOX = WideChar($25A0);     { $25A0 is a nice box }
    SMALL_CIRCLE = WideChar($2022);
    TAB_SYMBOL = WideChar($21D2);      { $27AA is nice $21E8 is ok but too small}
    THIN_SPACE = WideChar($200B);    {200B ZERO WIDTH SPACE}
    NOBREAK_SPACE = WideChar($00A0);

    LEFT_SPACE = 22;
    RIGHT_SPACE = 20;
    LEFT_EDGE = 2;
    FSPACING = 2;
var
    c : TCanvas;
    destwd, destht, scalewd, scaleht, left, right, available : integer;

    r : TRect;
    st : Tstream;

    bm : TBitmap;
begin
    //
    // Newer Clipboard files load this data already, detect this
    //
    case GetFormatType of
    FT_PICTURE:
        begin
            if CData.thumb <> nil then EXIT;

            c := frmClipboardManager.Canvas;
            c.Font := FrmConfig.GetFont;
            c.Font.Size := FrmConfig.GetFont.Size;
            c.Font.Style := FrmConfig.getfont.style;
            destht := max(
                (c.TextHeight('AZW') + FSPACING) * 2,
                frmconfig.udMinHeight.Position
            );

            GetFormatName(true);
            destwd := self.picwd;
            left := LEFT_SPACE + LEFT_EDGE  + (c.TextWidth('ZZ')+1) + FSPACING;
            right := (RIGHT_SPACE + FSPACING);
            available := FrmConfig.UDWidth.Position - (left + right);

            if (destwd > available) or (self.picht > destht) then begin
                destwd := available;
                with CData do begin
                    thumb := TBitmap.Create;
                    thumb.PixelFormat := pf24bit;
                    thumb.Canvas.Brush.Style := bsSolid;
                    thumb.Canvas.Brush.Color := clNone;
                    thumb.Width := destwd;
                    thumb.Height := destht;
//                    thumb.AlphaFormat := afIgnored;

                    r.Left := 0;
                    r.top := 0;
                    r.Width := self.picwd;
                    r.Height := self.picht;

                    scalewd := self.picwd;
                    scaleht := trunc(destht * (picwd /destwd));

                    bm := TBitmap.Create;
                    Self.DibToBitmap(bm);
                    thumb.Canvas.CopyMode := cmSrcCopy;
                    Windows.SetStretchBltMode(thumb.Canvas.Handle, STRETCH_HALFTONE);
                    windows.StretchBlt(thumb.Canvas.Handle,0,0,destwd,destht, bm.Canvas.Handle,0,0,scalewd,scaleht,SRCCOPY);

                    bm.Free;
                end;
            end;
        end;
    else
        begin
            if GetFormatType in [FT_UNICODE, FT_RICHTEXT, FT_HTML] then begin
                if CData.displaytext <> '' then EXIT;
                CData.displaytext := UnitMisc.CompactWhiteSpace(
                    StrUtils.leftstr(GetAsPlaintext, 300)
                );
            end;
         end;
    end;
end;

// A no-queue clip can be used over and over again to access the clipboard or
// perform utility tasks.
//
// The CurrentClipboard clip will only update if it detects the clipboard
// contents have changed. Otherwise, it will just hold onto the currently cached
// version
procedure TClipItemNoQueue.CleanupMemory;
begin
    inherited;

    CData.DeleteHICON;
end;
function TClipItemCurrentClipboard.GetClipboardItem(hi : HICON; OverrideFormat : WORD = 0; SizeLimit : cardinal = $FFFF) : cardinal;
var c : cardinal;
    tf : TClipFormat;
begin
    c := Windows.GetClipboardSequenceNumber;
    if (fLastClipID=0) or (fLastClipID <> c) then begin
        fLastClipID := c;
        self.CData.DeleteHICON;
        if cdata.thumb <> nil then myfree(cdata.thumb);
        inherited GetClipboardItem(hi,OverrideFormat, SizeLimit);
    end;
end;
procedure TClipItemCurrentClipboard.Compress;
begin

end;
procedure TClipItemCurrentClipboard.Decompress;
begin

end;
procedure TClipItemCurrentClipboard.FinishedWithStream;
begin

end;



{ TPagedStringQueue }
//--------------------
// Public Interface
//--------------------


procedure TPagedStringQueue.DeleteItem(index : cardinal);
begin
    TClipDatabase.DeleteRemoved(index);
    dec(self.qCount);
end;

procedure TPagedStringQueue.addNewClipListener(listener : TNotifyEvent);
begin
    NewClipListeners.Add(listener);
end;

constructor TPagedStringQueue.Create(filename: string; folder : string = '');
var tf : textfile;
    i  : integer;
    procedure HandleLegacyFiles;
    begin
        EXIT;
    end;
    procedure ConvertToCache;
    begin
        if (TClipDatabase.exists) then EXIT;
        //
        // convert the old format into the new format
        //
        i := 0;
        while
            FileExists(self.GetFilenameAbsoluteOld(i))
        do begin
            if fileexists(self.GetFilenameAbsolute(i)) then begin
                deletefile(self.GetFilenameAbsolute(i));
            end;
            renamefile(
                self.GetFilenameAbsoluteOld(i),
                self.GetFilenameAbsolute(i)
            );
            inc(i);
        end;
    end;
    procedure LoadCacheData;
    var i,j : integer;
    begin
        if (TClipDatabase.exists) then begin
            self.qStart := 0;
            self.qCount := TClipDatabase.getCountRemoved;
            self.qSize := self.qCount;
            EXIT;
        end;
        // find the queue size by counting contiguous files
        // get the real "zero" item index
        // count the contiguous files, starting at qStart for the qcount

        self.qStart := 0;
        self.qCount := 0;
        self.qSize := 0;
        v2Format := false;

        if (FileExists(self.cache + PAGED_STATEFILE)) then begin
            assignfile(tf, self.cache + PAGED_STATEFILE);
            reset(tf);
            read(tf, self.qStart);
            try
                read(tf, self.qCount);
                read(tf, self.qSize);
            except
            end;
            close(tf);
            v2Format := qsize <> 0;
        end;
        if not v2Format then begin
            i := 0;
            self.qSize := $ffffffff;
            while
                FileExists(self.GetFilenameAbsolute(i))
            do begin
                inc(i);
            end;
            self.qSize := i;
        end;


        if not v2Format then begin
            if self.qStart > qSize then begin
                // corrupt cache, what to do?
                self.qStart := 0;
            end;
            if (qsize<>0) then begin
                for j := qstart to qsize - 1 do begin
                    if (self.IsEmptyItemAbsolute(j)) then EXIT;
                    inc(self.qCount);
                end;
                // This caused an overflow problem since qstart is a cardinal.
                // Oh the evils of mixing signed and unsigned integers.
                if (qstart <> 0) then
                    for j := 0 to qstart-1 do begin
                        if (self.IsEmptyItemAbsolute(j)) then EXIT;
                        inc(self.qCount);
                    end;
            end;
        end;
    end;
    procedure ConvertCashToV2;
    var i, ti : integer;

        ci : TClipItem;
    begin
        if (TClipDatabase.exists) then EXIT;

        if not v2Format then begin
            for i := 0 to self.GetQueueCount - 1 do begin
                ci := self.GetItemClip(i);
                if (ci <> nil) then begin
                    ti := IndexTranslate(i);
                    ci.SaveToFile(self.cache, ti, CI_FILEMASK_ALL);
                    myfree(ci);
                end;

            end;
            v2Format := true;
            self.SaveQueueState;
        end;
    end;
begin
    self.ci := TClipItem.Create;

    PagedCache := TDictionary<Integer, TPagedData>.Create;
    NewClipListeners := TList<TNotifyEvent>.Create;


    self.base := UnitMisc.GetAppPath;
    if folder = '' then begin
        self.cache :=  self.base + 'removedcache\';
    end else begin
        self.cache := IncludeTrailingPathDelimiter( self.base + folder );
    end;

    self.filename := self.base + filename;
    if (not TClipDatabase.exists) then SysUtils.ForceDirectories(cache);
    self.iconcache := self.cache + 'iconcache\';
    if (not TClipDatabase.exists) then SysUtils.ForceDirectories(self.iconcache);

    v2Format := true;
    HandleLegacyFiles;
    ConvertToCache;
    LoadCacheData;
    ConvertCashToV2;
end;
destructor TPagedStringQueue.Destroy;
begin
    inherited;
end;
procedure TPagedStringQueue.InsertAtStart(ci : TClipItem);
var i : integer;
begin
    if (TClipDatabase.exists) then begin
        try
            ci.CData.setTimeStamp(Now);
            TClipDatabase.StartBatch;
            TClipDatabase.SaveRemoved(ci);
            self.qCount := TClipDatabase.getCountRemoved;

            i := self.qCount - self.qSize;
            if i>0 then
                TClipDatabase.DeleteOldestRemoved(i);

            self.qCount := TClipDatabase.getCountRemoved;
        finally
            TClipDatabase.EndBatch;
        end;

        for i := 0 to NewClipListeners.Count-1 do begin
            NewClipListeners[i](nil);
        end;
    end;
    EXIT;

    if qsize = 0 then EXIT;

    // ensure the queue has 1 free spot
    while (self.qCount >= self.qSize) and (self.qCount <> 0) do begin
        self.RemoveOldestItem;
    end;

    // save the item at the end of the queue
    self.SaveItem(self.qCount, ci);
    inc(self.qCount);
    self.SaveQueueState;
end;
function TPagedStringQueue.GetQueueCount: integer;
begin
    result := self.qCount;
end;

procedure TPagedStringQueue.ClearQueue;
var fn : string;
    tf : textfile;
    i : Integer;
begin
    self.ClearClipCache;
    TClipDatabase.ClearRemoved;
    self.qCount := 0;
    EXIT;
    // no more dirty tricks
    // - empty every placeholder items
    // - ensure no file exists after the last item
    for i := 0 to (self.qsize - 1) do begin
        if v2Format then begin
            fn := self.GetFilenameClipAbsolute(i);
        end else begin
            fn := self.GetFilenameAbsolute(i);
        end;
        Assign(tf, fn);
        Rewrite(tf);
        Close(tf);
    end;

    fn := self.GetFilenameAbsolute(self.qsize);
    if (FileExists(fn)) then begin
        DeleteFile(fn);
    end;



    self.qStart := 0;
    self.qCount := 0;
    self.SaveQueueState;
end;
procedure TPagedStringQueue.SaveQueueState;
var tf : textfile;
begin
    EXIT;

    assignfile(tf, cache + PAGED_STATEFILE);
    rewrite(tf);
        Writeln(tf, self.qStart);
        Writeln(tf, self.qCount);
        Writeln(tf, self.qSize);
    close(tf);
end;
procedure TPagedStringQueue.SetQueueSize(size: cardinal);
var fn : string;
    i : integer;
    tf : textfile;

begin
    if (TClipDatabase.exists) then begin
        self.qSize := size;
        i := self.qCount - self.qSize;
        if i>0 then begin
            TClipDatabase.DeleteOldestRemoved(i);
            self.qCount := TClipDatabase.getCountRemoved;
        end;
    end;
    EXIT;
    if self.qSize = size then EXIT;

    // Make sure all files exist within the circular queue
    // (when the queue size is enlarged)
    // Make sure new items are blank
    for i := 0 to (size - 1) do begin
        fn := self.GetFilenameAbsolute(i);
        if not FileExists(fn) or
            (cardinal(i) >= self.qSize) then begin
            Assign(tf, fn);
            Rewrite(tf);
            Close(tf);
        end;
    end;

    //
    // fill the new slots to ensure a consecutives list of clips
    //
    if (size > self.qSize) and (self.qSize > 0) then begin
        self.ReIndexQueue;
    end;

    // To Shrink the paged queue.....
    // Remove oldest items
    // Re-index items from 0-(qSize - 1)  so that virtual indexes
    // match the actuall indexes.
    // Break the contigous numbers so that only 0-(size-1) exists
    // contigously

    if (self.qSize > size) and (self.qSize > 0) then begin
        self.ReIndexQueue;
        while (self.qCount > size) do begin
            self.RemoveOldestItem;
        end;
    end;

    if not v2Format then begin
        fn := self.GetFilenameAbsolute(size);
        if (FileExists(fn)) then begin
            DeleteFile(fn);
        end;
    end;

    self.qSize := size;
    self.SaveQueueState;
end;
function TPagedStringQueue.getQueueSize : integer;
begin
    result := qSize;
end;


function TPagedStringQueue.GetItemText(index: cardinal): string;
var
    ci : TClipItem;
begin
    index := IndexTranslate(index);
    if v2Format then begin
        ci := TClipItem.Create;
        ci.LoadFromFile(self.cache, index, CI_FILEMASK_PLAIN);

        result := ci.GetAsPlaintext;
        myfree(ci);
    end else begin
        result := self.GetItemAbsolute(index);
    end;
end;
function TPagedStringQueue.GetItemClip(Index: cardinal): TClipItem;
var
    ti : integer;
begin
    ti := IndexTranslate(index);
    result := self.GetItemClipAbsolute(ti);  // V2format safe
    if (result.CData.GetHICONAbsolute = 0) then begin
        result.LoadIconFromFile(self.iconcache,  ti, '');
    end;
end;
function TPagedStringQueue.GetPagedData(index : Integer) : TPagedData;
var ti : integer;

    pcd : TPagedClipData;
    s : string;
begin
    if (TClipDatabase.exists) then begin
        if not PagedCache.TryGetValue(index, result) then begin
            result := TPagedData.Create;
            TClipDatabase.LoadRemovedData(result, index);
            PagedCache.Add(index, result);
        end;
        EXIT;
    end;

    // a quick way to gather just enough information
    // to show in a list

    ti := IndexTranslate(index);
    if v2Format then begin
        if not ClipCache.TryGetValue(ti, pcd) then begin
            pcd.ci := TClipItem.Create;
            pcd.ci.LoadFromFile(self.cache, ti, CI_FILEMASK_ICON or CI_FILEMASK_CAPTION or CI_FILEMASK_PLAIN);
            if pcd.ci.CData.GetHICONAbsolute = 0 then begin
                pcd.ci.LoadIconFromFile(self.iconcache, ti);
            end;
            if pcd.ci.CData.timestampused then begin
                pcd.FileDate := pcd.ci.CData.timestamp;
            end else begin
                pcd.FileDate := FileDateToDateTime(
                    FileAge( Resolver.GetClipData2(self.cache, ti) )
                );
            end;

            ClipCache.Add(ti, pcd);
        end;

        Result.icon := pcd.ci.CData.GetHICONAbsolute;
        result.FileDate := pcd.FileDate;
        result.FormatType := pcd.ci.GetFormatType;
        if pcd.ci.CData.displaytext = '' then begin
            result.AsText := pcd.ci.GetAsPlaintext;
        end else begin
            result.AsText := pcd.ci.CData.displaytext;
        end;
    end else begin
        {$REGION 'Old Format Stuff'}
        if not ClipCache.TryGetValue(ti, pcd) then begin
            pcd.ci := TClipItem.Create;
            pcd.ci.CFormat :=  pcd.ci.LoadOnlyFormat(self.cache, ti);
            pcd.ci.LoadIconFromFile(self.iconcache, ti);
            s := self.GetItemText(index);
            pcd.ci.CleanupMemory;
            pcd.ci.CData.SetString(LeftStr(s,200));

            pcd.FileDate := self.GetItemDate(index);

            ClipCache.Add(ti, pcd);
        end;

        Result.icon := pcd.ci.CData.GetHICONAbsolute;
        result.FileDate := pcd.FileDate;
        result.FormatType := pcd.ci.GetFormatType;
        result.AsText := pcd.ci.GetAsPlaintext;
        {$ENDREGION}
    end;
end;


procedure TPagedStringQueue.ClearClipCache;
var
    i, ti : integer;
    pcd : TPagedClipData;
    pd : TPagedData;
begin
    if (TClipDatabase.exists) then begin
        for i := 0 to self.qCount-1 do begin
            if PagedCache.TryGetValue(i, pd) then begin
                MyFree(pd);
            end;
        end;
        PagedCache.Clear;
    end;

    EXIT;
    for i := 0 to self.qCount-1 do begin
        ti := IndexTranslate(i);
        if ClipCache.TryGetValue(ti, pcd) then begin
            MyFree(pcd.ci);
            ClipCache.Remove(ti);
        end;
    end;
end;
procedure TPagedStringQueue.PreloadCache;
var
    pd : TPagedData;
    i : integer;
begin
    ClearClipCache;
    TClipDatabase.StartPagedData;
    i := 0;
    pd := TPagedData.Create;
    while TClipDatabase.LoadNext(pd)do begin
        PagedCache.Add(i, pd);
        pd := TPagedData.Create;
        inc(i);
    end;
    TClipDatabase.EndPagedData;
end;
//-----------------------
// Private Implementation
//-----------------------
function TPagedStringQueue.GetItemIconIndex(index: cardinal): cardinal;
begin
    result := index;
end;
function TPagedStringQueue.GetItemIcon(index: cardinal): HICON;
var ci : TClipItem;

begin

    ci := TClipITem.create;
    ci.LoadIconFromFile(self.iconcache, Self.IndexTranslate(index));
    result := ci.CData.GetHICONAbsolute;
    myfree(ci);
end;
function TPagedStringQueue.GetItemDate(index: cardinal): TDateTime;
var f : string;
begin
    index := IndexTranslate(index);

    f := self.GetFilenameAbsolute(index);
    result := FileDateToDateTime(FileAge(f));
end;

procedure TPagedStringQueue.SaveItem(index: cardinal; ci : TClipItem);
begin
    if self.qSize = 0 then EXIT;
    index := self.IndexTranslate(index);

    if (ci <> nil) then begin
        if v2Format then begin
            ci.SaveToFile(self.cache, index, CI_FILEMASK_ALL);
        end else begin
            ci.SaveToFile(self.cache, index);
            if (ci.CData.GetHICONAbsolute <> 0) then begin
                ci.SaveIconToFile(self.iconcache, index);
            end;
        end;
    end;
end;


// Only used for non V2 format
function TPagedStringQueue.IsEmptyItemAbsolute(absoluteIndex: cardinal): boolean;
var f : file;
    fn, newfn : string;
    fs : cardinal;
begin

    newfn := self.GetFilenameAbsolute(absoluteIndex);
    fn := self.GetFilenameAbsoluteOld(absoluteIndex);
    if fileexists(newfn) then begin
        fn := newfn;
    end;

    Assign(f, fn);
    Reset(f, 1);
    fs := 0;
    try
        fs := FileSize(f);
    finally
        result := (fs = 0);
        Close(f);
    end;
end;
function TPagedStringQueue.GetFilenameAbsoluteOld(absoluteIndex: cardinal): string;
begin
    result := self.cache + IntToHex(absoluteIndex,8) + PAGED_EXT;
end;
function TPagedStringQueue.GetFilenameAbsolute(absoluteindex: cardinal): string;
begin
    result := Resolver.GetClipText(self.cache, absoluteindex);
end;
function TPagedStringQueue.GetItemAbsolute(absoluteIndex: cardinal): string;
var f : file;
    filename, newfilename : string;
    s : string;
    oldtext : AnsiString;
    i : integer;
begin
    // default to the new format
    // convert old format to new format automatically

    filename := self.GetFilenameAbsoluteOld(absoluteIndex);
    newfilename := self.GetFilenameAbsolute(absoluteIndex);
    if fileexists(newfilename) then begin
        filename := newfilename;
    end else begin
        if fileexists(filename) then begin
            renamefile(filename, newfilename);
            filename := newfilename;
        end;
    end;

    //
    // read the item text from the cache
    //
    result := '';
    s := '';
    if (FileExists(filename)) then begin
        try
            Assign(f, filename);
            FileMode := 0;
            Reset(f, 1);
            i := filesize(f);
            if i <> 0 then begin
                setlength(s, i div 2);
                FillChar(s[1],i div 2,#0);
                blockread(f, s[1], i);
            end;
            if (i<>0) and (S[1] = char($FEFF)) then begin
                s := RightStr(s,Length(s)-1);
                s := pchar(s);
            end else begin
                CloseFile(f);
                Assign(f, filename);
                FileMode := 0;
                Reset(f, 1);
                i := filesize(f);
                s := '';
                if i <> 0 then begin
                    SetLength(oldtext, i);
                    blockread(f,oldtext[1], i);
                    s := string(oldtext);
                    s := pchar(s);
                end;
            end;
            result := s;
            closefile(f);
        except
            on e : exception do begin
                FrmDebug.AppendLog('GetItemAbsolute: ' + e.Message );
            end;
        end;
    end;
end;

// Updated to support V2 format
function TPagedStringQueue.IndexTranslate(index: cardinal): cardinal;
begin
    if (TClipDatabase.exists) then begin
        result := index;
        EXIT;
    end;
    // since this is a circular queue, item "0" can actually
    // start anywhere from 0 to qSize - 1
    result := 0;
    if self.qSize = 0 then EXIT;

    result := (self.qStart + index) mod self.qSize;
end;
procedure TPagedStringQueue.RemoveOldestItem;
var fn : string;
    tf : textfile;
    pcd : TPagedClipData;
    ti : Integer;
    procedure EmptyOldest;
    var ti : integer;
    begin
        ti := IndexTranslate(0);
        if v2Format then begin
            fn := self.GetFilenameClipAbsolute(ti);
        end else begin
            fn := self.GetFilenameAbsolute(ti);
        end;
        if (FileExists(fn)) then begin
            Assign(tf, fn);
            Rewrite(tf);
            Close(tf);
        end;
    end;
begin
    EXIT;

    // "delete" the first/oldest item in the list
    // empty files must exist to keep a contiguous run of files in v1

    if (self.qSize = 0) then begin
        EmptyOldest;
        self.qCount := 0;
    end else begin
        // Remove the cached data
        ti := IndexTranslate(0);
        if ClipCache.TryGetValue(ti, pcd) then begin
            MyFree(pcd.ci);
            ClipCache.Remove(ti);
        end;

        EmptyOldest;

        self.qStart := (self.qStart + 1) mod qSize;
        dec(self.qCount);
    end;
end;
procedure TPagedStringQueue.SwapClips(index, fileindex: cardinal);
    procedure Swap(fn1, fn2 : string);
    begin
        RenameFile(fn1, fn1+'.TEMP');
        RenameFile(fn2, fn1);
        RenameFile(fn1+'.TEMP', fn2);
    end;
var fn1, fn2 : string;
begin
    if v2Format then begin
        // currently unimplemented in an Unused Function
    end else begin
        fn1 := self.GetFilenameAbsolute(fileindex);
        fn2 := self.GetFilenameAbsolute(self.IndexTranslate(index));
        Swap(fn1, fn2);

        fn1 := self.GetFilenameClip(index);
        fn2 := self.GetFilenameClipAbsolute(fileindex);
        Swap(fn1, fn2);

        fn1 := self.GetFilenameIcon1Absolute(self.IndexTranslate(index));
        fn2 := self.GetFilenameIcon1Absolute(fileindex);
        Swap(fn1, fn2);

        fn1 := self.GetFilenameIcon2Absolute(self.IndexTranslate(index));
        fn2 := self.GetFilenameIcon2Absolute(fileindex);
        Swap(fn1, fn2);
    end;
end;
procedure TPagedStringQueue.ReIndexQueue;
    procedure ClearIndexData;
    var rec : TSearchRec;
        s : string;
        i : integer;
    begin
        s := self.cache + '*[*].txt';
        i := FindFirst(s,faAnyFile, rec);
        while (i=0) do begin
            DeleteFile(self.cache + rec.name);
            FindNext(rec);
        end;
        FindClose(rec);
    end;
var s1, s2 : string;
    i, k : integer;
const BAK_EXT = '.bak';
begin
    EXIT;

    if self.qStart = 0 then EXIT;
    if self.qSize =0 then EXIT;

    // move virtual items 0-n to absolute indexes 0-n
    // replace the extension of all items so there are no name clashed
    // when re-ordering the items

    if v2Format then begin
        for i := 0 to self.qSize-1 do begin
            s1 := self.GetFilenameClipAbsolute(i);
            RenameFile(s1, s1 + BAK_EXT);
            s1 := self.GetFilenameIcon1Absolute(i);
            RenameFile(s1, s1 + BAK_EXT);
            s1 := self.GetFilenameIcon2Absolute(i);
            RenameFile(s1, s1 + BAK_EXT);
        end;

        // move virtual index 0 to absolute index 0
        for i := 0 to self.qsize do begin
            s1 := self.GetFilenameClip(i) + BAK_EXT;
            s2 := self.GetFilenameClipAbsolute(i);
            if FileExists(s1) then
                RenameFile(s1, s2);
            s1 := self.GetFilenameIcon1Absolute(IndexTranslate(i)) + BAK_EXT;
            s2 := self.GetFilenameIcon1Absolute(i);
            if FileExists(s1) then
                RenameFile(s1, s2);
            s1 := self.GetFilenameIcon2Absolute(IndexTranslate(i)) + BAK_EXT;
            s2 := self.GetFilenameIcon2Absolute(i);
            if FileExists(s1) then
                RenameFile(s1, s2);
        end;

        self.ClearClipCache;
    end else begin
        {$REGION 'Old Format Stuff'}
        for i := 0 to self.qSize-1 do begin
            s1 := self.GetFilenameAbsolute(i);
            RenameFile(s1, s1 + BAK_EXT);
            s1 := self.GetFilenameClipAbsolute(i);
            RenameFile(s1, s1 + BAK_EXT);
            s1 := self.GetFilenameClipAbsolute(i);
            s1 := leftstr(s1,length(s1)-4) + FILE_EXT;
            RenameFile(s1, s1 + BAK_EXT);
            s1 := self.GetFilenameIcon1Absolute(i);
            RenameFile(s1, s1 + BAK_EXT);
            s1 := self.GetFilenameIcon2Absolute(i);
            RenameFile(s1, s1 + BAK_EXT);
        end;


        // move absolute item X to virtual item X
        i := self.qStart;
        k := 0;
        repeat
            s1 := self.GetFilenameAbsolute(i) + BAK_EXT;
            s2 := self.GetFilenameAbsolute(k);
            if FileExists(s1) then
                RenameFile(s1, s2);
            s1 := self.GetFilenameClipAbsolute(i) + BAK_EXT;
            s2 := self.GetFilenameClipAbsolute(k);
            if FileExists(s1) then
                RenameFile(s1, s2);
            s1 := self.GetFilenameClipAbsolute(i);
            s1 := leftstr(s1,length(s1)-4) + FILE_EXT + BAK_EXT;
            s2 := self.GetFilenameClipAbsolute(k);
            if FileExists(s1) then
                RenameFile(s1, s2);
            s1 := self.GetFilenameIcon1Absolute(i) + BAK_EXT;
            s2 := self.GetFilenameIcon1Absolute(k);
            if FileExists(s1) then
                RenameFile(s1, s2);
            s1 := self.GetFilenameIcon2Absolute(i) + BAK_EXT;
            s2 := self.GetFilenameIcon2Absolute(k);
            if FileExists(s1) then
                RenameFile(s1, s2);

            i := Cardinal(i + 1) mod self.qSize;
            inc(k);
        until (Cardinal(i) = self.qStart);
        {$ENDREGION}
    end;
    self.qStart := 0;
end;
function TPagedStringQueue.GetFilenameClipAbsolute(absoluteIndex: cardinal): string;
begin
    if v2Format then begin
        result := Resolver.GetClipData2(self.cache, absoluteIndex)
    end else begin
        result := Resolver.GetClipData(self.cache, absoluteIndex)
    end;
end;
function TPagedStringQueue.GetFilenameClip(index: cardinal): string;
begin
    result := self.GetFilenameClipAbsolute(IndexTranslate(index));
end;
function TPagedStringQueue.GetFilenameIcon1Absolute(absoluteIndex: cardinal): string;
begin
    result := Resolver.GetIconMask(self.iconcache, absoluteindex);
end;
function TPagedStringQueue.GetFilenameIcon2Absolute(absoluteIndex: cardinal): string;
begin
    result := Resolver.GetIconColor(self.iconcache, absoluteindex);
end;
function TPagedStringQueue.getItemClipAbsolute(absoluteIndex: cardinal): TClipItem;
var clip : TClipItem;
begin
    result := nil;
    if (TClipDatabase.exists) then begin
        clip := TClipItem.Create;
        clip.LoadFromFile(self.cache, absoluteIndex, CI_FILEMASK_ALL);
        result := clip;
        exit;
    end;
    if v2Format then begin
        if FileExists( Resolver.GetClipData2(self.cache, absoluteIndex) )then begin
            clip := TClipItem.Create;
            clip.LoadFromFile(self.cache, absoluteIndex, CI_FILEMASK_ALL);
            result := clip;
        end;
    end else begin
        if FileExists(self.GetFilenameClipAbsolute(absoluteIndex)) then begin
            result := TClipItem.Create;
            result.LoadFromFile(self.cache, absoluteIndex);
        end;
    end;
end;

procedure TPagedStringQueue.RefreshSize;
begin
    self.qStart := 0;
    self.qCount := TClipDatabase.getCountRemoved;
end;

{ TTempClipQueue }
procedure TTempClipQueue.AddNoSizeCheck(s: string; ci: TClipItem);
begin
    sl.AddObject(s, ci);
end;
procedure TTempClipQueue.InsertAtStart(ci: TClipItem);
var c2 : TClipItem;
begin
	if self.IndexOf(ci)<>-1 then EXIT;

    c2 := ci.CloneClip;

    sl.InsertObject(0, c2.GetAsPlaintext, c2);
    self.SetQueueSize(self.qSize);
end;
procedure TTempClipQueue.DeleteItem(index: cardinal);
begin
    self.DeleteItem2(index, false);
end;
procedure TTempClipQueue.DeleteItem2(index: cardinal; NoFree : boolean = false);
var ci : TClipItem;
begin
    ci := TClipITem(sl.Objects[index]);
    MyFree(ci);

    // this MUST be the ONLY place an item is deleted
    sl.Delete(index);
end;



{ TPinnedClipQueue }
// clips are removed from the ClipQueue and added here
// clips are not added to the RemovedClipQueue or TempClipRemoved
// clips removed from here are added back to the start of the ClipQueue

constructor TPinnedClipQueue.Create;
begin
    self.qSize := 0;
    sl := TStringList.Create;
end;
procedure TPinnedClipQueue.AddNoSizeCheck(s: string; ci: TClipItem);
begin
    sl.AddObject(s, ci);
    self.qSize := sl.Count;
end;
procedure TPinnedClipQueue.DeleteItem(index : cardinal);
begin
    self.DeleteItem2(index, false);
end;
procedure TPinnedClipQueue.DeleteItem2(index : cardinal; NoFree : boolean = false);
var ci : TClipItem;
    i : integer;
begin
    // move to top of popup clips
    // either as new or existing

    ci := TClipITem(sl.Objects[index]);
    i := ClipQueue.IndexOf(ci);
    if  i = -1 then begin
        ClipQueue.InsertAtStart(ci);
    end else begin
        ClipQueue.MoveToStart(i);
        self.DestroyItem(index);
    end;

    sl.Delete(index);
end;
procedure TPinnedClipQueue.InsertAtStart(ci : TClipItem);
var c2 : TClipItem;
    i : integer;
begin
    // clone the clip
    // destroy the clip in the clip queu
    // grow the queue size as needed

    if self.IndexOf(ci)<>-1 then EXIT;
    i := ClipQueue.IndexOf(ci);
    if i =- 1 then EXIT;

    c2 := ci.CloneClip;
    ClipQueue.DestroyItem(i);

    sl.InsertObject(0, c2.GetAsPlaintext, c2);
    self.qSize := sl.Count;

    self.SetQueueSize(self.qSize);
end;



{////////////////////}
{//}initialization{//}
{////////////////////}
begin
    FrmDebug.AppendLog('Loading Queues');

    Resolver := TCacheResolver.Create;
    IconCache := TIconCache.Create;


    CurrentClipboard := TClipItemCurrentClipboard.Create;

    RemovedQueue := TPagedStringQueue.Create('removed.txt', 'removedcache\');
    ClipQueue := TClipQueue.Create;

    clickedClipQueue := TTempClipQueue.Create;
    ClickedClipQueue.SetQueueSize(10);

    PinnedClipQueue := TPinnedClipQueue.create;

    ClipDataDefaultIcon := LoadIcon(0, IDI_APPLICATION);
    FrmDebug.AppendLog('Loaded Queues');

    Windows.InitializeCriticalSection(crit);
end;
{//////////////////}
{//}finalization{//}
{//////////////////}
begin
    RemovedQueue.Free;
    ClipQueue.Free;

    IconCache.Free;
end;
end.
