home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Softwarová Záchrana 3
/
Softwarova-zachrana-3.bin
/
ArsClip
/
source.zip
/
UnitFrmChainWatcher.pas
< prev
next >
Wrap
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.