unit UnitFrmClipboardManager;
{
    Purpose:
    This unit monitors new items on the clipboard.
    Raw data is retrieved and send to the ClipQueue
    (the text, filenames, and icons).

    Also, this unit is the interface for the user
    to manipulating the queue.

    NOTE:
    Items entering the clipboard too soon after an ArsClip
    paste are ignored, since our clipboard items must be
    ignored.

}
interface

uses
  Windows, Messages, SysUtils, Variants,  Graphics, Controls, Forms,
  Dialogs, StdCtrls, Clipbrd, ShellAPI, Buttons, ExtCtrls, ComCtrls,
  ImgList {for DragQueryFile}, UnitClipQueue, Menus, Vcl.Imaging.pngimage,
  System.Classes, System.Generics.Collections;


//---------------------------------
// VISTA only clipboard functions
//---------------------------------

var AddClipboardFormatListener:function (h : HWND): BOOL; stdcall;
var RemoveClipboardFormatListener:function (h : HWND): BOOL; stdcall;

const WM_CLIPBOARDUPDATE = $031D;
// ---------------------------------


type
  TfrmClipboardManager = class(TForm)
        Panel2: TPanel;
        lblClipSize: TLabel;
        iPic: TImage;
        iText: TImage;
        iFormat: TImage;
        iFiles: TImage;
        iPin: TImage;
        iPin2: TImage;
        procedure FormCreate(Sender: TObject);
        procedure FormDestroy(Sender: TObject);
        procedure FormClose(Sender: TObject; var Action: TCloseAction);
        procedure FormShow(Sender: TObject);
    private
        { Public declarations }
        CF_RICHTEXT : UINT;
        CF_HTML : UINT;


        HistoryLoaded : boolean;
        { Private declarations }
        NextHandle: THandle;                {clipboard chain pointer}
        DisableMonitoring: boolean;         {altered by public interface}
        IgnoreClipboard: boolean;
        MonitorFilenames: boolean;
        CopyIcon : boolean;
        //LastPaste : TDateTime;
        DisableWhenScrollLock : boolean;

        IsJoinedToChain : boolean;
        BypassPasteProtectionOnce : boolean;
        lastSequence : integer;
        lastHash : cardinal;
        activated : Boolean;
        lastTopClipHash : cardinal;

        CurrentClip : TClipItem;

        Listeners : TList<TNotifyEvent>;

        function IsSafeToMove : boolean;
        procedure ClipboardChainJoin;
        procedure ClipboardChainLeave;
        procedure SaveTextItemsOrder;
        procedure SaveOtherItemsOrder;

        procedure SetIgnoreClipboard(ignore : boolean);
        //procedure InformOfPaste;
        procedure HealBrokenChain;

        {windows messages}
        //procedure WMDRAWCLIPBOARD(var Message: TMessage); message WM_DRAWCLIPBOARD;
        procedure WMDRAWCLIPBOARD_NEW(var Message: TMessage); message WM_DRAWCLIPBOARD;
        procedure WMCHANGECBCHAIN(var Message: TMessage); message WM_CHANGECBCHAIN;
        procedure WMCLIPBOARDUPATE(var Message: TMessage); message WM_CLIPBOARDUPDATE;

    protected
        procedure CreateParams(var Params: TCreateParams); override;

    public
        function GetCF_HTML : UINT;
        function GetCF_RICHTEXT : UINT;
        function IsNewClipboardAPI : boolean;
        {configuration}
        procedure SetDisableMonitoring(disable: boolean);
        function GetMonitoring : boolean;
        procedure SetFilenameMonitoring(enable: boolean);
        procedure SetCopyIcon(enable: boolean);
        procedure SetDisableWhenScrollLock(value : boolean);
        procedure IgnoreClipboardOnce;
        procedure ClearIgnoreClipboardOnce;
        procedure DisablePasteProtectionOnce;
        {temporarily ignore the clipboard items}

        function GetClipboardOwnerIcon(hoverride : THandle = 0) : HICON;

        {history load/save}
        //function GetDoSave
        procedure LoadHistory(saveAfterLoad : boolean = True);
        procedure SaveHistory(forceSave : boolean = True);

        procedure ReloadHistory;


        procedure RefreshClipboardMonitor;

        function GetIsOnChain : boolean;

        // API for getting the current clip
        /// and conditionally placing it on a queue
        ///    -- this includes things like altering formating and fixing URLs
        function GetCurrentClipboardClipWithRules(var URL : string; overrideFormat : TClipFormat=0) : TClipItem;
        function AddClipToQueueWithRules(clipitem : TClipITem; URL : string = '') : boolean;

        procedure ActivateAfterLoad;

        function GetLastNewClip : TClipItem;
        function GetLastClipID : cardinal;

        procedure ClearClipboard(simple:boolean=false);

        function GetSequenceCode : integer;

        procedure addNewClipListener(Listener : TNotifyEvent);
        procedure removedNewClipListener(Listener : TNotifyEvent);
  end;

var
  frmClipboardManager: TfrmClipboardManager;



{////////////////////}
{//}implementation{//}
{////////////////////}

uses UnitMisc, UnitFrmMainPopup, UnitListBoxMover, UnitFrmDummyIcon,
     UnitOtherQueue, UnitKeyboardQuery, StrUtils, DateUtils,
  UnitFrmSysTrayMenu, UnitFrmChainWatcher, UnitFrmConfig,  Math,
  UnitPaste, UnitSound, UnitFrmEditItem, UnitPopupGenerate,
  UnitFrmDummyClipboardBar, UnitFrmEditTextExternal, UnitFrmPermanentNew,
  UnitToken, UnitFrmJumpList, UnitFrmDebug, UnitClipDatabase, UnitFrmTooltipNew;
const REMEMBER_FILE = 'remember.txt';
const OTHER_FILE = 'other.txt';

{$R *.dfm}



{
--======================
-- // Public Inteface //
--======================
}
procedure TfrmClipboardManager.RefreshClipboardMonitor;
begin
    FrmDebug.AppendLog('Refreshing Monitor');

    Windows.SetLastError(ERROR_SUCCESS);
    self.ClipboardChainLeave;
    self.ClipboardChainJoin;

end;


procedure TfrmClipboardManager.HealBrokenChain;
begin
    // this is a bad idea, if the chain is not truely broken
    //
    self.NextHandle := 0;
    self.ClipboardChainJoin; 
end;

function TfrmClipboardManager.GetLastNewClip : TClipItem;
begin
    Result := self.CurrentClip;
end;

function TfrmClipboardManager.GetLastClipID : cardinal;
begin
    result := Windows.GetClipboardSequenceNumber;
end;

procedure TfrmClipboardManager.ClearClipboard(simple:boolean=false);
begin
    if not simple then begin
        ClipQueue.DestroyItem(UnitClipQueue.CurrentClipboard);
    end;

    clipbrd.clipboard.clear;
    frmClipboardBar.NewClipFound;
end;

function TfrmClipboardManager.GetSequenceCode : integer;
begin
    result := self.lastSequence;
end;

{
procedure TFrmClipboardManager.InformOfPaste;
begin
    LastPaste := SysUtils.Time();
end;
}
//--------------------------------
// configuration stuff
//--------------------------------

procedure TfrmClipboardManager.SetCopyIcon(enable: boolean);
begin
    self.CopyIcon := enable;
end;
procedure TfrmClipboardManager.SetDisableMonitoring(disable: boolean);
begin
    self.DisableMonitoring := disable;
    if assigned(frmSysTrayMenu) then
        frmSysTrayMenu.ForceIconUpdate;
end;
procedure TfrmClipboardManager.SetIgnoreClipboard(ignore : boolean);
begin
    IgnoreClipboard := ignore;
    FrmDebug.AppendLog('ClipboardManager: ignore = ' + BoolToStr(ignore) );
end;
procedure TfrmClipboardManager.SetFilenameMonitoring(enable: boolean);
begin
    MonitorFilenames := enable;
end;
procedure TFrmClipboardManager.SetDisableWhenScrollLock(value : boolean);
begin
    DisableWhenScrollLock := value;
end;
{
--======================
-- // Create/Destroy  //
--======================
}
procedure TfrmClipboardManager.FormCreate(Sender: TObject);
var h : THandle;
begin
    FrmDebug.AppendLog('FrmClipboardManager - Creating');
    self.CurrentClip := TClipItem.Create;

    Windows.SetLastError(ERROR_SUCCESS);

    if IsNewClipboardAPI  then begin
        h := LoadLibrary('user32.dll');
        if (h <> 0) then begin
            @AddClipboardFormatListener := GetProcAddress(h, 'AddClipboardFormatListener');
            @RemoveClipboardFormatListener := GetProcAddress(h, 'RemoveClipboardFormatListener');
            FreeLibrary(h);
        end;
        if (h = 0) or
        (@AddClipboardFormatListener = nil) or
        (@RemoveClipboardFormatListener = nil) then
        begin
            ShowMessage('Failed to locate Vista Clipboard API');
            Application.Terminate;
        end;
    end;
    CF_HTML := RegisterClipboardFormat('HTML Format');
    CF_RICHTEXT := RegisterClipboardFormat('Rich Text Format');

    self.IgnoreClipboard := true;
    self.activated := false;

    Listeners := TList<TNotifyEvent>.Create;

    self.ClipboardChainJoin;
end;
procedure TfrmClipboardManager.ActivateAfterLoad;
begin
    self.IgnoreClipboard := False;
    self.activated := true;
end;
procedure TfrmClipboardManager.FormDestroy(Sender: TObject);
begin
  self.ClipboardChainLeave;
end;

procedure TfrmClipboardManager.addNewClipListener(Listener : TNotifyEvent);
begin
   Listeners.Add(Listener);
end;

procedure TfrmClipboardManager.removedNewClipListener(Listener : TNotifyEvent);
begin
   Listeners.delete( Listeners.IndexOf(Listener));
end;


{
--=========================
-- // Clipboard messages //
--=========================

Description: Monitor for new text entries entered into the clipboard. Add
new text entries into the finite sized queue (removing oldest items as needed).
Also, follow the rule for a change in the clipboard chain.

}



function TfrmClipboardManager.GetCurrentClipboardClipWithRules(var URL : String; overrideFormat : TClipFormat): TClipItem;
   function FixedURL(ci : TClipItem) : string;
        function SubstringCount(substring, s : string) : integer;
        var i : integer;
        begin
            result := 0;
            i := pos(substring, s);
            while i <> 0 do begin
                inc(result);

                Delete(s,i,length(substring));
                i := pos(substring, s);
            end;
        end;
    var s, s2: string;
        i : integer;
    begin
        result := '';

        if (FrmConfig.cbAutofixURLs.Checked) then begin
            s := ci.GetAsPlaintext;
            s2 := Trim(s);
            i := SubstringCount('://', s);
            if (i > 1) then begin
                EXIT;
            end;

            i := Pos( '://', s2);
            if (i > 2) and (i < 8) then begin
                while (Pos(#13#10, s2) <> 0) do begin
                    s2 := StringReplace(s2, #13#10, '', [rfReplaceAll]);
                end;
                s2 := StringReplace(trim(s2), ' ', '%20', [rfReplaceAll]);
                if (s2 <> s) then begin
                    result := s2;
                    // remove leading/trailing spaces and encode internal spaces
                end;



            end;
        end;
    end;
var cformat : cardinal;
    ClipItem : TClipItem;
    h, h2 : HICON;
label EXIT_CODE;

begin
    Windows.SetLastError(NO_ERROR);
    //
    // Clipboard contents have changed
    // Copy the contents
    //
    cformat := 0;
    try
        ClipItem := TClipItem.Create;
        FrmDebug.AppendLog('    Attempting to retrieve clipboard text');
        // get clipboard item
        // only act when an item is found (non-zero result) without error
        h := self.GetClipboardOwnerIcon;
        h2 := CloneIcon(h);
        DestroyIcon(h);
        cformat := ClipItem.GetClipboardItem(h2,overrideformat);
    except
        on E: Exception do
        begin
            FrmDebug.AppendLog('problems getting new clip item: ' + e.message);
        end;
    end;

    // FIX: Don't leak GDI memory when object retreval fails
    if (cformat = 0) then begin
        FrmDebug.AppendLog('Get ClipItem failed',true);
        MyFree(ClipItem);
        IgnoreClipboard := false;
        goto exit_code;
    end;

    // Detect broken URLs
    // - abort process when detected
    URL := FixedURL(ClipItem);
    if (URL <> '') then begin
        MyFree(ClipItem);
        IgnoreClipboard := false;
        goto exit_code;
    end;
EXIT_CODE:

    result := ClipItem;
end;
function TfrmClipboardManager.AddClipToQueueWithRules(clipitem : TClipITem; URL : string = ''): boolean;
var cformat : THANDLE;
    s, plaintext : string;
    function IsWhiteSpace(s : string) : boolean;
    var i : integer;
    begin
    	result := true;
    	for i := 1 to length(s) do begin
            if not (ord(s[i]) in [9,13,10,32]) then begin
                result := false;
                EXIT;
            end;
        end;
    end;
begin
    result := false;
    if clipitem <> nil then begin
        {
        if CurrentClip <> nil then begin
            CurrentClip.Free;
        end;
        CurrentClip := clipitem.CloneClip;
        }

        cformat := ClipItem.GetFormat;
        try
            if (cformat <> 0) then begin
                s := ClipItem.GetAsPlaintext;
                plaintext := s;
                // May be a text item, may be a copied filename,
                // may be an "Other" item
                // Will be deleted if nobody wants the clip
                if (s <> '') then begin
                	if IsWhiteSpace(s) then begin
                    	FrmDebug.AppendLog('     Clip is just whitespace');
                        MyFree(ClipItem);
                    end else if frmconfig.cbIgnoreSmallText.checked and (length(s)< frmConfig.getMinClipLength) then begin
                    	FrmDebug.AppendLog('     Text is too small');
                        FrmMainPopup.showCue('ArsClip','text clip too small');
                        MyFree(ClipItem);
                    end else begin
                        if (CFormat = Windows.CF_HDROP) then begin
                            if (MonitorFilenames) then begin
                                FrmDebug.AppendLog('    Accepting as file(s)');
                                result := ClipQueue.InsertAtStart(ClipItem);
                            end else begin
								FrmDebug.AppendLog('     Ignoring files(s)');
                        		MyFree(ClipItem);
                            end;
                        end else begin
                            FrmDebug.AppendLog('    Accepting as text');
                            result := ClipQueue.InsertAtStart(ClipItem, frmConfig.cbCaseSensitive.checked);
                            FrmDebug.AppendLog('    Accepting as text Done');
                        end;
                    end;
                end else begin
                    // reject the clip if
                    // -- non-text monitoring disabled
                    // -- found as duplicated and using separate queue for non-text items
                    // --

                    FrmDebug.AppendLog('    Accepting as Other clip');
                    result := false;
                    if frmconfig.cbOtherItems.Checked then begin
                        result := ClipQueue.InsertAtStartNontext(ClipItem);
                        if (not result) then begin
                            FrmMainPopup.showCue('ArsClip','clip too large');
                        end;
                    end else begin
                        FrmMainPopup.showCue('ArsClip','media clip ignored');
                    end;
                    if (not result) then begin
                        FrmDebug.AppendLog('    Nobody wants the clip');
                        MyFree(ClipItem);
                    end;
                end;
            end;
        except
            on E: Exception do
            begin
                FrmDebug.AppendLog('problems getting new clip item: ' + e.message);
            end;
        end;
    end;

    if (URL <> '') then begin
        FrmDebug.AppendLog('//// Fixing URL');
        self.BypassPasteProtectionOnce := true;
        Paste.PlaceOnClipboardDontBypassClipboardManager(URL);
        UnitMisc.TimerStart;
        UnitMisc.TimerEndAt(50); 
    end;

    if assigned(frmconfig) then
        if FrmConfig.cbRemoveFormat.checked and (not Paste.IsPasting) and (not FrmMainPopup.IsSendingText) then begin
            if (clipitem <> nil) and
                (clipItem.GetFormatType in [FT_HTML, FT_RICHTEXT]) and
                (clipItem.HasText) then begin

                FrmDebug.AppendLog('>>> Removing Formatting');
                Paste.SetClipboardOnlyOnce;
                self.IgnoreClipboard := true;
                Paste.SendPlainText(plaintext);
                self.IgnoreClipboard := false;
                UnitMisc.TimerStart;
                UnitMisc.TimerEndAt(50);
                FrmDebug.AppendLog('>>> Removing Formatting END');
            end;
        end;
end;

procedure TfrmClipboardManager.WMDRAWCLIPBOARD_NEW(var Message: TMessage);
var s : string;
    ClipItem : TList<TClipItem>;
    ci : TClipItem;
    h : THandle;
    URL : string;
    i : integer;
    ignoring : boolean;
    added : boolean;
    ClipDetected : boolean;
    seq : integer;
    textFormat : TClipFormat;
    procedure CheckExecuteClip;
    begin
    end;
    function getForegroundRect : TRect;
    var
        h : THandle;
    begin
        // wait until a new foreground window appears

        h := GetForegroundWindow;
        if (h=0) then
            h := GetTopWindow(0);

        windows.GetWindowRect(h, result);
    end;
    procedure IgnoreCue(programname : string);
    var
        tt : TFrmTooltipNew;
        r : TRect;
    begin
        if Paste.IsPasting then EXIT;

        r := getForegroundRect;
        inc(r.top, 5);
        inc(r.left, 5);

        tt := TFrmTooltipNew.Create(nil);
        tt.HideHeader;
        tt.SmallFontOnce := true;
        tt.ShowTooltip('['+programname+ ']: Clipboard Ignored.',
            point(r.left, r.top)
        );
        tt.TimClose.Interval := 2500;
        tt.TimClose.Enabled := true;
    end;
label exit_code;

begin

    ignoring := false;
    ClipItem := TList<TClipItem>.create;

    seq := Windows.GetClipboardSequenceNumber;
    if  seq = self.lastSequence then begin
        FrmDebug.AppendLog('sequence: ' +IntToStr(seq)+' duplicate detected - not sending Windows message');
        EXIT; // NOTE: purposely skipping the exit code, no need to send multiple messages
    end;
    self.lastSequence := seq;
    FrmDebug.AppendLog('sequence: ' + IntToStr(seq));

    Windows.SetLastError(ERROR_SUCCESS);
    if (FrmChainWatcher <> nil) then begin
        FrmChainWatcher.NotifyOfClipboardActivity;
        FrmChainWatcher.Disable;
    end;


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

    if (IgnoreClipboard) then begin
        FrmDebug.AppendLog('//// Ignoring ');
        ignoring := true;
        goto exit_code;
    end;

    if (not self.activated) then begin
        FrmDebug.AppendLog('/// Program not initialized yet');
        ignoring := true;
        goto exit_code;
    end;

    if (DisableMonitoring) then begin
        frmSysTrayMenu.SetIconIgnore;
        FrmDebug.AppendLog('//// Monitoring disabled');
        ignoring := true;
        goto exit_code;
    end;




    // is this our data that we just pasted?
    // disabled? Ignore the clipboard for now?
    // make sure the data isn't from us
    // configurable disable via Scroll Lock key

    h := Windows.GetClipboardOwner;
    if (h = Application.Handle) then begin
        if (self.BypassPasteProtectionOnce)   then begin
            i := 0;
            while Paste.IsPasting and (i<2000) do begin
                MySleep(50);
                inc(i,50);
            end;
        end else begin
            FrmDebug.AppendLog('    Ignore our own clipboard events');
            goto exit_code;
        end;
    end;
    self.BypassPasteProtectionOnce := false;



    s := WindowHandleToEXEName(Windows.GetForegroundWindow);
    if (frmSysTrayMenu.IsDisabledEXE(s)) then begin
        FrmDebug.AppendLog('/// ignoring EXE clipboard: ' + s);
        frmSysTrayMenu.SetIconIgnore;
        ignoring := true;
        IgnoreCue(UpperCase(s));
        goto EXIT_CODE;
    end;

    If (self.DisableWhenScrollLock) then begin
        if (KeyboardQuery.LockOn(VK_SCROLL)) then begin
            frmSysTrayMenu.SetIconIgnore;
            IgnoreCue('Scroll Lock');
            FrmDebug.AppendLog('    scroll lock on - ignoring contents');
            ignoring := true;
            goto exit_code;
        end;
    end;

    // get ready to do the thing
    IgnoreClipboard := true;
    FrmDebug.AppendLog('//// Clipboard Start ////' +
        #13+#10 +
        '    # = ' + IntToStr(message.msg) +
        ' lparam = ' + IntToStr(message.LParam) +
        ' wparam = ' + IntToStr(message.WParam)

        + ' Owner = ' + IntToStr(Windows.GetClipboardOwner)
    );
    Windows.Sleep(FrmConfig.GetPreCaptureDelayMS);



    frmSysTrayMenu.SetIconTriggered;
    //
    // Get the clip and conditionally add it to the right queue
    //

    CheckExecuteClip;
    if TClipboardGrabber.ClipboardHasPicAndText(textFormat) then begin
        ci :=  self.GetCurrentClipboardClipWithRules(URL, CF_DIB);
        if (ci <> nil) then begin
            ClipItem.Add(ci);
        end;
        // the plain text version may be empty, so ignore any text clip
        // without a visible plaintext version
        ci := self.GetCurrentClipboardClipWithRules(URL, textFormat);
        if (ci <> nil) and (ci.GetAsPlaintext <> '') then begin
            ClipItem.Add(ci);
        end;
    end else begin
        ci := self.GetCurrentClipboardClipWithRules(URL);
        if (ci <> nil) then begin
            ClipItem.Add(ci);
        end;
    end;
    ClipDetected := (ClipItem.count > 0) or (URL <> '');


exit_code:
    IgnoreClipboard := false;
    // Pass message to next in line (rules of a cliboard viewer)
    Message.Result := 0;
    If (NextHandle <> 0) then begin
        if (NextHandle = self.Handle) then begin
            NextHandle := 0;
            FrmDebug.AppendLog('Infinite loop detected in Clipboard chain!!!');
        end else begin
            Windows.SendMessage(NextHandle, WM_DRAWCLIPBOARD,  message.WParam, message.LParam )
        end;
    end;

    // Program is not fully loaded and ready to process clips
    if not self.activated then EXIT;

    FrmDebug.AppendLog('//// Clipboard End ////');
    if (FrmChainWatcher <> nil) then begin
        FrmChainWatcher.Enable;
    end;



    if assigned(frmClipboardBar) then
        frmClipboardBar.NewClipFound;
    if assigned(FrmMainPopup) then
        FrmMainPopup.NewClipboardCallback;

    // add non-duplicate clips
    if (not ignoring) then begin
        added := false;
        for i := ClipItem.Count-1 downto 0 do begin
            if (clipitem[i] <> nil) then begin
                if (lastHash <> clipitem[i].CData.Hash) then begin
                    lastHash := clipitem[i].CData.Hash;
                    added := self.AddClipToQueueWithRules(clipItem[i], URL);

                    if (frmConfig.cbEnableSound.Checked) then begin
                        UnitSound.PlaySound_NewClipboardItem();
                    end;
                end else begin
                    // TODO:   make sure this destroy was in error
                    //DestroyIcon(clipitem.CData.GetHICONAbsolute);
                    FrmDebug.AppendLog('// Duplicate Hash - destroying clip');
                    clipitem[i].Free;
                end;
            end else begin
                // fix a URL instead - this will trigger another event later
                added := self.AddClipToQueueWithRules(nil, URL);
            end;
        end;
    end;
    clipitem.Free;
    ignoring := false;
end;

procedure TfrmClipboardManager.WMCHANGECBCHAIN(var Message: TMessage);
begin
    Windows.SetLastError(ERROR_SUCCESS);

    //
    //Someone is leaving the chain, only "fires" when the program leaving
    //is the one after us
    //

    { MS Documentation...
    When a clipboard viewer window receives the WM_CHANGECBCHAIN message,
    it should call the SendMessage function to pass the message to the
    next window in the chain, unless the next window is the window being
    removed. In this case, the clipboard viewer should save the handle
    specified by the lParam parameter as the next window in the chain.
    }
    if (Cardinal(Message.WParam) = NextHandle) then begin
        FrmDebug.AppendLog('WM_Changecbchain - reassign next handle');
        NextHandle := Message.LParam;

        if (NextHandle = self.Handle) then begin
            Raise Exception.Create('ERROR: ArsClip Joined the chain twice!');
        end;
    end else if (NextHandle <> 0) then begin
        FrmDebug.AppendLog('WM_Changecbchain - send message to next handle');
        if NextHandle <> 0 then
            sendmessage(NextHandle,
                        WM_CHANGECBCHAIN,
                        Message.WParam,  // handle of window to remove
                        Message.LParam); // handle of next window
    end;

    //
    // viewers joining/leaving the chain can send erounious 'clipboard
    // changed' events, so they'll need to be ingored just like our own
    // paste events

    //self.InformOfPaste;
    Message.Result := 0;
end;
procedure TfrmClipboardManager.WMCLIPBOARDUPATE(var Message: TMessage);
begin
    message.Result := 0;
    self.WMDRAWCLIPBOARD_NEW(message);
    Windows.SetLastError(ERROR_SUCCESS);
end;

procedure TfrmClipboardManager.ClipboardChainJoin;
var i : integer;
begin
    Windows.SetLastError(ERROR_SUCCESS);



    //Join the cliboard chain
    // Disable monitoring until this form has been created
    // This prevents aditions until the Config form has a
    // chance to set the queue size

    self.SetIgnoreClipboard(true);
    FrmDebug.AppendLog('ClipManager: Joining Chain');
    Windows.SetLastError(ERROR_SUCCESS);

    if IsNewClipboardAPI then begin

        FrmDebug.AppendLog('ClipManager: Vista Detected');
        IsJoinedToChain := AddClipboardFormatListener(self.handle);
        if not IsJoinedToChain then begin
            FrmDebug.AppendLog('ClipManager: Can''t join chain ', true );
        end;
    end else begin
        if not Windows.OpenClipboard(Application.Handle) then begin
            FrmDebug.AppendLog('Can''t open clipboard', true);
            EXIT;
        end;
        Windows.SetLastError(ERROR_SUCCESS);
        NextHandle := Windows.SetClipboardViewer(self.Handle);
        i := Windows.GetLastError;
        if (NextHandle = 0) then begin
            if (i <> 0) then begin
                FrmDebug.AppendLog('ClipManager: Can''t join chain ' + SysErrorMessage(i) );
                self.IsJoinedToChain := false;
            end else begin
                self.IsJoinedToChain := true;
            end;
        end else begin
            self.IsJoinedToChain := true;
        end;

        Windows.CloseClipboard;
    end;
    FrmDebug.AppendLog('ClipManger: joining end');
    self.SetIgnoreClipboard(false);
end;
procedure TfrmClipboardManager.ClipboardChainLeave;
begin
    Windows.SetLastError(ERROR_SUCCESS);

    self.IsJoinedToChain := false;
    self.SetIgnoreClipboard(true);
    FrmDebug.AppendLog('ClipManager: leaving chain');
    //Leave the chain

    if IsNewClipboardAPI  then begin
        RemoveClipboardFormatListener(self.handle);
    end else begin
        Windows.ChangeClipboardChain(self.Handle,     // our handle to remove
                       NextHandle ); // handle of next window in the chain
    end;

    FrmDebug.AppendLog('ClipManger: leaving end');
    self.SetIgnoreClipboard(false);
end;









procedure TfrmClipboardManager.CreateParams(var Params: TCreateParams);
begin

    inherited CreateParams(Params);
    // allow context taskbar context menu and
    // show me on the taskbar - independant of main form
    with Params do begin
        ExStyle := ExStyle or WS_EX_APPWINDOW;
        WndParent := GetDesktopwindow;
    end;
end;
procedure TfrmClipboardManager.LoadHistory(saveAfterLoad : boolean = True);
    procedure LoadQueue(q : TClipQueue; clippath, iconpath : string);
    var
        i : integer;
        ci : TClipItem;
        useV1Format, useV2Format : boolean;
    begin
        i := 0;
        useV2Format := false;
        useV1Format := false;
        repeat
            if q is TPinnedClipQueue then begin

            end else begin
                if i >= q.GetQueueSize then BREAK;
            end;
            ci := TClipItem.Create;
            if (useV1Format=false) and FileExists(ci.GetFilenameV2(clippath, i)) then begin
                ci.LoadFromFile(clippath, i, CI_FILEMASK_ALL);
                inc(i);
                if ci.GetDataSize = 0 then begin
                    MyFree(ci);
                    CONTINUE;
                end;

                q.AddNoSizeCheck(ci.GetAsPlaintext, ci);
                useV2Format := true;
            end else if (useV2Format = false) and FileExists(ci.GetFilename(clippath, i)) then begin
                ci.LoadIconFromFile(iconpath, i);
                ci.LoadFromFIle(clippath, i);

                q.AddNoSizeCheck(ci.GetAsPlaintext, ci);
                inc(i);
                useV1Format := true;
            end else begin
                MyFree(ci);
                BREAK;
            end;
        until (false);
    end;
var
    base, icons, otherclips,
    textclips, name, itemText,
    pinned, pinnedicons, s : string;

    lineCount : cardinal;
    i , j, IconCount: integer;
    tf : textfile;
    ci : TClipItem;

    procedure AddNewItem(s : string);
    begin
        ci := TClipItem.Create;
        ci.CData.SetString(s);

        // load icon if exists
        ci.LoadIconFromFile(icons, iconCount);
        ci.LoadFromFIle(textClips, IconCount);

        ClipQueue.AddNoSizeCheck(s, ci);
        inc(IconCount);
    end;
    procedure LoadSimpleText;
    var i : integer;
    begin
        try
            AssignFile(tf, name);
            Reset(tf);

            ClipQueue.ClearQueue;

            // abort reading and show message on error
            // always close the file
            iconCount := 0;
            while not eof(tf) do begin
                try
                    Readln(tf, s);
                    itemText := '';
                    lineCount := StrToInt(s);

                    for i := 0 to lineCount - 1 do begin
                        Readln(tf, s);
                        if (itemText = '') then begin
                            itemText := s;
                        end else begin
                            itemText := itemText + #13#10 + s;
                        end;
                    end;
                    AddNewItem(itemtext);
                except
                    on E: Exception do begin
                        ShowMessage('The "Load items from last session" file is corrupted - ' + name + #13#10#13#10 +
                                    'Error Message: ' + E.Message);
                        BREAK;
                    end;
                end;
            end;
        finally
            CloseFile(tf);
        end;
    end;
    function LoadBinary : boolean;
    var f : file;
        i : integer;
        s : string;
    begin
        assignfile(f, name);
        reset(f, 1);
        result := false;
        blockread(f, i, sizeof(i));
        if (i = -1) then begin
            while not eof(f) do begin
                blockread(f, i, sizeof(i));
                setlength(s, i);
                blockread(f, s[1], i);

                addnewitem(s);
            end;
            result := true;
        end;
        closefile(f);
    end;
    procedure LoadLegacyOtherQueue;
    begin
        name := base + OTHER_FILE;
        if (FileExists(name)) then begin
            AssignFile(tf, name);
            reset(tf);
            i := 0;
            while not eof(tf) do begin
                readln(tf,s);
                ci := TClipItem.Create;
                ci.CData.SetString(s);
                ci.LoadFromFile(otherclips, i);
                ci.LoadIconFromFile(icons, i, '-o');
                OtherQueue.AddNoSizeCheck(s, ci);
                inc(i);
            end;
            closefile(tf);
        end else begin
            i := 0;
            repeat
                if i >= OtherQueue.GetQueueSize then BREAK;
                ci := TClipItem.Create;
                if FileExists(ci.GetFilename(otherClips, i)) then begin
                    ci.LoadIconFromFile(icons, i, '-o');
                    ci.LoadFromFile(otherclips, i);
                    OtherQueue.AddNoSizeCheck(ci.GetAsPlaintext, ci);
                    inc(i);
                end else begin
                    MyFree(ci);
                    BREAK;
                end;
            until (false);
        end;
    end;
    procedure RemoveLegacyTextFiles;
    begin
         //
        // Remove the legacy formats
        s := base + REMEMBER_FILE;
        if (FileExists(s)) then begin
            renamefile(s, s + '.old');
        end;
        s := base + OTHER_FILE;
        if (FileExists(s)) then begin
            renamefile(s, s + '.old');
        end;
    end;
var c : Cardinal;
begin
    // only load once
    if (HistoryLoaded) then begin
        exit;
    end;
    HistoryLoaded := true;

    if (TClipDatabase.exists) then begin
        TClipDatabase.StartBatch;
        j := TClipDatabase.getCountPinned;
        if (j>0) then begin
            for i := 0 to j-1 do begin
                ci := TClipItem.Create;
                TClipDatabase.LoadPinned(ci, i);
                PinnedClipQueue.AddNoSizeCheck(ci.GetAsPlaintext, ci);
            end;
        end;
        j := TClipDatabase.getCountNormal;
        if (j>0) then begin
            for i := 0 to j-1 do begin
                ci := TClipItem.Create;
                TClipDatabase.LoadNormal(ci, i);
                ClipQueue.AddNoSizeCheck(ci.GetAsPlaintext, ci);
            end;
            FrmDebug.AppendLog('loaded count =' + IntToStr(ClipQUeue.GetQueueCount));
            if ClipQueue.GetQueueCount <> 0 then begin
                lastTopClipHash := ClipQueue.GetClipItem(0).GetHashCode;
            end;
        end;
        TClipDatabase.EndBatch;
        EXIT;
    end;

    c := Windows.GetTickCount;
    //
    // load permanent items - 2 legacy read attempts first
    //
    base := UnitMisc.GetAppPath;
    name := base + REMEMBER_FILE;
    icons := base + 'iconcache\';
    textclips := base + 'textcache\';
    pinned := textclips + 'pinned\';
    pinnedicons := pinned + 'iconcache\';
    otherclips := base + 'othercache\';
    IconCount := 0;

    if FileExists(name) then begin
        if not LoadBinary then begin
            LoadSimpleText;
        end;
    end else begin
        LoadQueue(ClipQueue, textclips, icons);
        if ClipQueue.GetQueueCount <> 0 then begin
            lastTopClipHash := ClipQueue.GetClipItem(0).GetHashCode;
        end;

        LoadQueue(PinnedClipQueue, pinned, pinnedicons);
    end;
    //
    // load non-text items, attempt legacy read first
    //
    LoadLegacyOtherQueue;
    RemoveLegacyTextFiles;

//    if saveAfterLoad then Self.SaveHistory;
    FrmDebug.AppendLog('LoadHistory - ms = ' + IntToStr(Windows.GetTickCount-c));
end;
procedure TfrmClipboardManager.SaveHistory(forceSave : boolean = True);
    procedure SaveQueue(q : TClipQueue; clippath, iconpath : string);
    var
        ci : TClipItem;
        i : integer;
        s : string;
        b : boolean;
    begin
        for i := 0 to (q.GetQueueCount - 1) do begin
            // save or overwrite the icon file
            // save or overwrite the clip item
            ci := q.GetClipItem(i);
            if (ci <> nil) then begin
                ci.SaveToFile(clippath, i, CI_FILEMASK_ALL);
                ci.FinishedWithStream;
            end;
        end;

        ci := TClipITem.Create;
        // make sure the next files are missing to signify
        // the end of the queue
        s := ci.GetFilenameV2(clippath, q.GetQueueCount);
        if FileExists(s) then begin
            DeleteFile(s);
        end;
        s := ci.GetFilename(clippath, q.GetQueueCount);
        if FileExists(s) then begin
            DeleteFile(s);
        end;

        ci.Free;
    end;

type barray = array of byte;
var base, name, icons,  textclips, pinned, pinnedicons : string;
    timc, c : Cardinal;
    i : integer;
    ci : TClipItem;
begin
    timc := Windows.GetTickCount;
    //
    // save items
    //
    if (TClipDatabase.exists) then begin
        TClipDatabase.SaveQueue(PinnedClipQueue);
        if (ClipQueue.GetQueueCount <> 0) then begin
            ci := ClipQueue.GetClipItem(0);
            if (ci = nil) then begin
                FrmDebug.AppendLog('failed to get a clip from the clipboard');
            end else begin
                c := ci.GetHashCode;
                if (c <> lastTopClipHash) or forceSave then begin
                    TClipDatabase.SaveQueue(ClipQueue);
                end;
                lastTopClipHash := c;
            end;
        end else begin
            TClipDatabase.SaveQueue(clipQueue);
        end;
    end else begin
        base := UnitMisc.GetAppPath;
        name :=  base + REMEMBER_FILE;
        icons := base + 'iconcache\';
    //    ForceDirectories(icons);
        textclips := base + 'textcache\';
    //    ForceDirectories(textclips);
        pinned := textclips + 'pinned\';
    //    ForceDirectories(pinned);
        pinnedicons := pinned + 'iconcache\';
    //    ForceDirectories(pinnedicons);

        if (ClipQueue.GetQueueCount <> 0) then begin
            c := ClipQueue.GetClipItem(0).GetHashCode;
            if (c <> lastTopClipHash) or forceSave then begin
                SaveQueue(ClipQueue, textclips, icons);
            end else begin
                FrmDebug.AppendLog('Save History - no changes made');
            end;
            lastTopClipHash := c;
        end else begin
            SaveQueue(ClipQueue, textclips, icons);
        end;

        SaveQueue(PinnedClipQueue, pinned, pinnedicons);
    end;

    timc := Windows.GetTickCount-timc;
    FrmDebug.AppendLog('SaveHistory - ms = ' + IntToStr(timc));
end;
procedure TfrmClipboardManager.ReloadHistory;
begin
    self.HistoryLoaded := false;
    LoadHistory(false);
end;

function TFrmClipboardManager.GetClipboardOwnerIcon(hoverride : THandle) : HICON;
var h, owner : THandle;
    dwresult : cardinal;
    cnt, maxcnt : integer;
begin
    Windows.SetLastError(ERROR_SUCCESS);


    // set defualt result
    // bail out if owner went bye-bye
    result := 0;
    if hoverride <> 0 then begin
        owner := hoverride;
    end else begin
        owner := Windows.GetForegroundWindow;
    end;
    if (owner = 0) then begin
        EXIT;
    end;

    FrmDebug.AppendLog('^Cloning Icon^');
    // find topmost parent
    cnt := 1;
    maxcnt := FrmConfig.getIconRetryCount;
    repeat
        h := GetWindowLong(owner, GWL_HWNDPARENT);
        if (h <> 0) then begin
            owner := h;
        end;

        if cnt > maxcnt then BREAK;
        inc(cnt);
    until (h = 0);
    Windows.SetLastError(ERROR_SUCCESS);

    // get the first small icon available, if any



    h := Windows.GetClassLong(owner, GCL_HICONSM);
    if (h <> 0) then begin
        result := CloneIcon(h);
        EXIT;
    end;
    Windows.SetLastError(ERROR_SUCCESS);

    h := Windows.GetClassLong(owner, GCL_HICON);
    if (h <> 0) then begin
        result := CloneIcon(h);
        EXIT;
    end;
    Windows.SetLastError(ERROR_SUCCESS);

    if (SendMessageTimeout(owner, WM_GETICON,
    ICON_SMALL,0,
    SMTO_ABORTIFHUNG,1000,dwresult) <> 0) then begin
        if (dwresult <> 0) then begin
            result := CloneIcon(dwresult);
            EXIT;
        end;
    end;
    Windows.SetLastError(ERROR_SUCCESS);


    if (SendMessageTimeout(owner, WM_GETICON, ICON_BIG,0,SMTO_ABORTIFHUNG,1000,dwresult) <> 0) then begin
        if (dwresult <> 0) then begin
            result := CloneIcon(dwresult);
            DestroyIcon(dwresult);
            EXIT;
        end;
    end;
    FrmDebug.AppendLog('Clone failed: ' + SysUtils.SysErrorMessage(Windows.GetLastError));
    Windows.SetLastError(ERROR_SUCCESS);
end;







//////////////////////////////////////////////////////////////
// User Interface
// close the window,
// move item
// delete item
//////////////////////////////////////////////////////////////

procedure TfrmClipboardManager.IgnoreClipboardOnce;
begin
    self.SetIgnoreClipboard(true);
end;
procedure TfrmClipboardManager.ClearIgnoreClipboardOnce;
begin
    self.SetIgnoreClipboard(false);
end;

function TfrmClipboardManager.IsNewClipboardAPI: boolean;
begin
    result := (SysUtils.Win32MajorVersion > 5);
end;

function TfrmClipboardManager.IsSafeToMove: boolean;
begin
end;



//------------------------------------------------------------------
// To set the changes in the queue, send back what we've altered
//
// NOTE: See the dirty trick used as a Win9X workaround
// A reference to the ClipItem of each listbox item is stored.
// This is how each item's index can be found in ClipQueue and
// OtherQueue
//------------------------------------------------------------------
procedure TfrmClipboardManager.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
    //bCopyAs.Visible := false;
end;

procedure TfrmClipboardManager.SaveOtherItemsOrder;
begin
end;
procedure TfrmClipboardManager.SaveTextItemsOrder;
begin
end;


procedure TfrmClipboardManager.FormShow(Sender: TObject);
begin

end;

//
// show the preview when an item is clicke on
//
function TfrmClipboardManager.GetIsOnChain: boolean;
begin
    result := self.IsJoinedToChain;
end;


function TfrmClipboardManager.GetMonitoring: boolean;
begin
    result := not self.DisableMonitoring;
end;

//
// custome draw routines
//
function TfrmClipboardManager.GetCF_HTML: UINT;
begin
    result := self.CF_HTML;
end;

function TfrmClipboardManager.GetCF_RICHTEXT: UINT;
begin
    result := self.CF_RICHTEXT; 
end;

procedure TfrmClipboardManager.DisablePasteProtectionOnce;
begin
    self.BypassPasteProtectionOnce := true;
end;

end.
