Softwarová Záchrana 3/Softwarova-zachrana-3.bin/ArsClip/source.zip/UnitFrmChainWatcher.pas

Pascal/Delphi Source File | 2003-09-29 | 12KB | 411 lines

unit UnitFrmChainWatcher;
{
    Purpose:
        Monitor the clipboard problems caused by other peoples
        f*cked up programs. *sigh*

    Updates:
        option to disable watcher (used by Clipboard Manager)

        Disabled Clipboard chain monitor no longer running
        error reporting by default.

        --------------------
        Re-wrote "get parent" routine
        Always clear previous errors

        ---------------
        Handle EXE Name retreive errors
        --------------
        Keep track of last known program name for reporting if
        current owner is no longer running

        -----------------
        New option to report problem program
        Watcher re-written
        ---------------
        I was refreshing the chain wether it needed it or not
}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, UnitClipQueue;

type
  TFrmChainWatcher = class(TForm)
    Timer1: TTimer;
    procedure Timer1TimerNew(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }

    LastClipItem : TClipItem;
    LastClipboardOwner : string;
    DialogShownOnce : boolean;
  public
    { Public declarations }
    procedure NotifyOfClipboardActivity;
    procedure Disable;
    procedure Enable;
  end;

var
  FrmChainWatcher: TFrmChainWatcher;

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

uses Clipbrd, UnitFrmClipboardManager, UnitFrmMainPopup,
  UnitReportError, UnitMisc, UnitFrmConfig;
{$R *.dfm}

type ByteArray = array of byte;

procedure TFrmChainWatcher.Disable;
begin
    timer1.Enabled := false;
end;

procedure TFrmChainWatcher.Enable;
begin
    timer1.Enabled := true;
end;

procedure TFrmChainWatcher.FormCreate(Sender: TObject);
begin
    self.LastClipItem := nil;
    DialogShownOnce := false;

    //
    // get me started
    //
    self.Timer1TimerNew(self);
end;


procedure TFrmChainWatcher.NotifyOfClipboardActivity;
begin
    // Reset the timer to not trigger until later
    // update: make sure timer does not trigger here
    timer1.Enabled := false;

    MyFree(self.LastClipItem);

    timer1.Enabled := true;
end;


//
// I should be shot for this.
//
procedure TFrmChainWatcher.Timer1TimerNew(Sender: TObject);
var
    ba1, ba2 : pointer;
    sz : cardinal;
    ChainBroken : boolean;
    ci : TClipItem;
    problem : THandle;
    ownerTitle : string;

    procedure HandleBrokenChain;
    begin
        if not (DialogShownOnce or
            FrmConfig.cbDisableChainNotification.checked)  then begin

            UnitMisc.AppendLog('Watcher: chain broken');

            Timer1.Enabled := false;

            Windows.SetForegroundWindow(self.handle);

            if (ownerTitle <> '') then begin
                FrmReportError.ShowForm( ownerTitle );
                DialogShownOnce :=  true;
            end else if (LastClipboardOwner <> '') then begin

                FrmReportError.ShowForm( LastClipboardOwner );
                DialogShownOnce :=  true;

            end else begin
                Dialogs.ShowMessage(
                'ERROR: The Clipboard chain has been broken.' + #13#10 +
                'Please note which programs are running that may have caused this problem.' + #13#10 +
                #13#10 +
                'The Clipboard Monitor will automatically be refreshed and this message'+#13#10+
                'will not be shown again this session.');
                DialogShownOnce :=  true;
            end;
        end;

        FrmClipboardManager.RefreshClipboardMonitor;

        // If this is successful, the timer will be enabled by
        // NotifyClipboardActivity
    end;
var h : THandle;
begin
    Windows.SetLastError(ERROR_SUCCESS);

    if not frmClipboardManager.GetIsOnChain then begin
        UnitMisc.AppendLog('Watcher: ClipMonitor not attached - refreshing');
        frmClipboardManager.RefreshClipboardMonitor;
        EXIT;
    end;
    //ChainBroken := false;

    UnitMisc.AppendLog('Watcher: getting current clipboard item');
    ci := TClipItem.Create;
    if ci.GetClipboardItem(0) = 0 then begin
        UnitMisc.AppendLog('Watcher: current item failed');
        MyFree(ci);
        MyFree(LastClipItem);

        EXIT;
    end;
    UnitMisc.AppendLog('Watcher probe: ' + SysErrorMessage(GetLastError));
    SetLastError(ERROR_SUCCESS);

    // First time here?
    if (LastClipItem = nil) then begin
        LastClipItem := ci;
        UnitMisc.AppendLog('Watcher: initing');
    end else begin
        if (LastClipITem.GetDataSize <> ci.GetDataSize) then begin
            // size must be equal or we know a break has happened
            ChainBroken := true;
        end else begin
            sz := ci.GetDataSize;
            ba1 := Windows.GlobalLock(LastClipItem.GetHandle);
            if (ba1 = nil) then begin
                UnitMisc.AppendLog('Lock failed ' + SysErrorMessage(GetLastError));
                EXIT;
            end;
            ba2 := Windows.GlobalLock(ci.GetHandle);
            if (ba1 = nil) then begin
                Windows.GlobalUnlock(LastClipItem.GetHandle);
                UnitMisc.AppendLog('Lock2 failed ' + SysErrorMessage(GetLastError));
            end;
            chainbroken := not CompareMem(ba1, ba2, sz);

            Windows.GlobalUnlock(ci.GetHandle);
            Windows.GlobalUnlock(LastClipItem.GetHandle);
        end;


        //
        // Gather info about the current owner of the clipboard
        //
        {if not Windows.OpenClipboard(Application.Handle) then begin
            UnitMisc.AppendLog('GetClipboardViewer Open failed: ' + SysErrorMessage(GetLastError));
            EXIT;
        end;}
        // requires Win98 or above for GetAncestor
        {problem := Windows.GetAncestor(Windows.GetClipboardViewer,
            GA_ROOTOWNER  );}
        problem := Windows.GetClipboardViewer;
        if (problem <> 0) then begin
            h := problem;
            while (h <> 0) do begin
                problem := h;
                h := GetWindowLong(h, GWL_HWNDPARENT);
            end;
            if (GetLastError <> ERROR_SUCCESS) then begin
                UnitMisc.AppendLog('Get parent failed: ' + SysErrorMessage(GetLastError));
                EXIT;
            end;
        end else begin
            UnitMisc.AppendLog('No viewer found: ' + SysErrorMessage(GetLastError));
        end;

        {Windows.CloseClipboard;}

        ownerTitle := lowercase(ExtractFileName(WindowHandleToEXEName(problem)));
        if (GetLastError <> ERROR_SUCCESS) then begin
            UnitMisc.AppendLog('EXEName error: ' + SysErrorMessage(GetLastError));
        end;

        UnitMisc.AppendLog('Clipboard Owner = ' + ownerTitle);
        if (ownerTitle <> '') then begin
            if (ownerTitle <> 'arsclip.exe') and (ownerTitle <> EXENAME_ERROR) then begin
                LastClipboardOwner := ownerTitle;
            end;
        end;

        // If the clipboard owner is AWOL and configured to check this,
        // or the clip has changed and we don't know about it, then
        // the chain has been broken

        if (ChainBroken or
            ((ownerTitle = '') and frmConfig.cbEnableExtendedChainChecking.Checked) and
            (ownerTitle <> EXENAME_ERROR)) then begin
            if (ownerTitle = 'arsclip.exe') then begin
                ownerTitle := '';
            end;
            if (LastClipboardOwner = 'arsclip.exe') then begin
                LastClipboardOwner := '';
            end;

            HandleBrokenChain;
        end;

        // clean up the previous copy
        // store for next time this event fires
        MyFree(LastClipItem);
        LastClipItem := ci;
    end;
end;

{
procedure TFrmChainWatcher.Timer1TimerNew(Sender: TObject);
    function DupHandle(h : Thandle; var sizeh : cardinal) : Thandle;
    var
        newh : Thandle;
        p1, p2 : pointer;
    begin
        result := 0;
        if (h = 0) then
            EXIT;
        //
        // make sure size is non-zero
        // and not bigger than size restrictions
        //
        sizeh := Windows.GlobalSize(h);
        if (sizeh = 0) then
            EXIT;

        //
        // Lock and copy
        //

        newh := Windows.GlobalAlloc(GMEM_MOVEABLE, sizeh);
        if (newh=0) then EXIT;
        p1 := Windows.GlobalLock(newh);
        p2 := Windows.GlobalLock(h);
        if ((p1=nil) or (p2=nil)) then EXIT;

        CopyMemory(p1, p2, sizeh);

        Windows.GlobalUnlock(h);
        Windows.GlobalUnlock(newh);

        result := newh;
    end;

var i : integer;
    h : THandle;

    clipSize : cardinal;
    ClipformatPop : word;
    CliphandlePop : THandle;
    ba1, ba2 : ^ByteArray;
    ChainBroken : boolean;
begin
    if not frmClipboardManager.GetIsOnChain then begin
        UnitMisc.AppendLog('Watcher: ClipMonitor not attached - refreshing');
        frmClipboardManager.RefreshClipboardMonitor;
        EXIT;
    end;
    ChainBroken := false;


    // find the current format
    // must be non-zero
    ClipformatPop := 0;
    if not Windows.OpenClipboard(Application.Handle) then begin
        UnitMisc.AppendLog('Watcher: can''t open clipboard');
        EXIT;
    end;

    for i := 0 to clipboard.FormatCount - 1 do begin
        if (clipboard.HasFormat(Clipboard.Formats[i])) then begin
            ClipFormatPop := Clipboard.Formats[i];
            //BREAK;
        end;
    end;

    if (ClipFormatPop  = 0) then begin
        UnitMisc.AppendLog('Watcher: format not found');
        Windows.CloseClipboard;
        EXIT;
    end;


    //
    // Dupe the handle, exit on error
    // (aka copy what's on the clipboard)

    h := clipboard.GetAsHandle(ClipFormatPop);
    CliphandlePop := DupHandle(h, ClipSize);
    Windows.CloseClipboard;
    if (CliphandlePop = 0) then begin
        UnitMisc.AppendLog('Watcher: dup failed');
        EXIT;
    end;

    // First time here?
    if (self.LastHandle = 0) then begin
        LastHandle := CliphandlePop;
        LastSize := ClipSize;
        UnitMisc.AppendLog('Watcher: initing');
    end else begin
        if (LastSize <> ClipSize) then begin
            // size must be equal or we know a break has happened
            ChainBroken := true;
        end else begin
            // compare the contents of each memory location
            // becuase the size is the same
            UnitMisc.AppendLog('Watcher: Testing clip');
            ba1 := Pointer(LastHandle);
            ba2 := Pointer(ClipHandlePop);

            for i := 0 to ClipSize - 1 do begin
                if (ba1^[i] <> ba2^[i]) then begin
                    ChainBroken := true;
                    BREAK;
                end;
            end;
        end;


        // Fix the chain and/or Warn about it
        // GRR - bad bad bad me
        // I was refreshing the chain wether it needed it or not

        if (ChainBroken) then begin
            if (not DialogShownOnce) then begin
                DialogShownOnce :=  true;
                UnitMisc.AppendLog('Watcher: chain broken');
                Windows.SetForegroundWindow(self.handle);
                Timer1.Enabled := false;
                Dialogs.ShowMessage(
                    'ERROR: The Clipboard chain has been broken.' + #13#10 +
                    'Please note which programs are running that may have caused this problem.' + #13#10 +
                    #13#10 +
                    'The Clipboard Monitor will automatically be refreshed and this message'+#13#10+
                    'will not be shown again this session.');
                Timer1.Enabled := true;
            end;

            FrmClipboardManager.RefreshClipboardMonitor;
        end;

        // clean up the previous copy
        // store for next time this event fires

        if (Windows.GlobalFree(LastHandle) <> 0) then begin
            UnitMisc.AppendLog('Watcher: Can''t free old clip');
        end;

        LastHandle := CliphandlePop;
        LastSize := ClipSize;

    end;
end;
}


end.