Program SaveWatchList;
{$IFDEF COMPILER_8}
{$IFNDEF VER170}
{$IFNDEF VER160}
{$IFNDEF VER150}
{$IFNDEF VER140}
{$IFNDEF VER130}
{$IFNDEF VER120}
{$IFNDEF VER100}
{$IFNDEF VER90}
{$IFNDEF VER80}
{$DEFINE Delphi_2005_UP}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}
Uses
Forms,
Windows,
Messages,
Classes,
SysUtils,
shellapi,
ClipBrd;
{$R-}
Type
pHWND=^HWND;
Procedure PostKeyExHWND(hWindow:HWnd;key:Word;
Const shift:TShiftState;specialkey:Boolean=false);
Type
TBuffers=Array[0..1]
Of TKeyboardState;
Var
pKeyBuffers :^TBuffers;
lParam :LongInt;
Begin
(* check if the target window exists *)
If IsWindow(hWindow)
Then
Begin
(* set local variables to default values *)
pKeyBuffers :=
Nil;
lParam := MakeLong(0,MapVirtualKey(key,0));
(* modify lparam if special key requested *)
If specialkey
Then
lParam := lParam
Or $1000000;
(* allocate space for the key state buffers *)
New(pKeyBuffers);
Try
(* Fill buffer 1 with current state so we can later restore it.
Null out buffer 0 to get a "no key pressed" state. *)
GetKeyboardState(pKeyBuffers^[1]);
FillChar(pKeyBuffers^[0],SizeOf(TKeyboardState),0);
(* set the requested modifier keys to "down" state in the buffer*)
If ssShift
In shift
Then
pKeyBuffers^[0][VK_SHIFT] := $80;
If ssAlt
In shift
Then
Begin
(* Alt needs special treatment since a bit in lparam needs also be set *)
pKeyBuffers^[0][VK_MENU] := $80;
lParam := lParam
Or $20000000;
End;
If ssCtrl
In shift
Then
pKeyBuffers^[0][VK_CONTROL] := $80;
If ssLeft
In shift
Then
pKeyBuffers^[0][VK_LBUTTON] := $80;
If ssRight
In shift
Then
pKeyBuffers^[0][VK_RBUTTON] := $80;
If ssMiddle
In shift
Then
pKeyBuffers^[0][VK_MBUTTON] := $80;
(* make out new key state array the active key state map *)
SetKeyboardState(pKeyBuffers^[0]);
(* post the key messages *)
If ssAlt
In Shift
Then
Begin
If Not PostMessage(hWindow,WM_SYSKEYDOWN,key,lParam)
Or Not PostMessage(hWindow,WM_SYSKEYUP,key,lParam
Or $C0000000)
Then
Raise Exception.Create(SysErrorMessage(GetLastError));
End
Else
Begin
If Not PostMessage(hWindow,WM_KEYDOWN,key,lParam)
Or Not PostMessage(hWindow,WM_KEYUP,key,lParam
Or $C0000000)
Then
Raise Exception.Create(SysErrorMessage(GetLastError));
End;
(* restore the old key state map *)
SetKeyboardState(pKeyBuffers^[1]);
Finally
(* free the memory for the key state buffers *)
Dispose(pKeyBuffers);
End;
{ If }
End;
End;
{ PostKeyEx }
Procedure SelectAll_CopyClipboard_SaveToFile(wndParent,wndChild:HWND;Filename:
String;bAppendFile:Boolean);
Var
List :TStringlist;
Var
hOtherWin,hFocusWin :THandle;
OtherThreadID,ProcessID :DWORD;
Text :
String;
Begin
List :=
Nil;
hOtherWin := wndChild;
If IsWindow(hOtherWin)
Then
Begin
OtherThreadID := GetWindowThreadProcessID(hOtherWin,@ProcessID);
If AttachThreadInput(GetCurrentThreadID,OtherThreadID,True)
Then
Begin
hFocusWin := GetFocus;
If hFocusWin<>0
Then
Try
Clipboard.Clear;
List := TStringlist.Create;
If bAppendFile
And Fileexists(FileName)
Then
List.LoadFromFile(FileName);
List.Add('
**** '+DateTimeToStr(Now)+'
****');
{$IFDEF Delphi_2005_UP}
PostKeyExHWND(wndChild,VK_HOME, []);
{$ELSE}
PostKeyExHWND(wndChild,VK_HOME, [ssCtrl]);
{$ENDIF}
Repeat
Sleep(30);
PostKeyExHWND(wndChild,Ord('
C'), [ssCtrl]);
Sleep(30);
PostKeyExHWND(wndChild,VK_DOWN, []);
Sleep(30);
Text := Clipboard.AsText;
List.Add(Text);
Until Text='
';
List.SaveToFile(FileName); *)
Finally
AttachThreadInput(GetCurrentThreadID,OtherThreadID,False);
list.Free;
End;
End;
End;
End;
Procedure HandleParamstr(
Out FileName:
String;
Out bAppendFile,bOpen:Boolean);
Function IsInParam(
Const s:
String):Boolean;
Var
i :Byte;
Begin
Result := false;
For i := 1
To ParamCount
Do
Begin
If pos(s,uppercase(paramstr(i)))=1
Then
Result := true;
End;
End;
Begin
FileName := '
SaveWatchlist.txt';
bAppendFile := true;
If ParamCount>0
Then
Begin
If (UpperCase(Paramstr(1))='
/HELP')
Or(Paramstr(1)='
/?')
Then
Begin
MessageBox(0,'
Saves the Delphi Watch List to a file specified by the filename parameter.'
+#13#10#13#10+'
Usage: SaveWatchlist [<path>] <parameter>'
+#13#10#13#10+'
Parameter:'
+#13#10+'
/append'+#9+'
Appends the output to the outputfile'
,'
Save Watch List',MB_OK);
End
Else
Begin
bAppendFile := IsInParam('
/APPEND');
bopen := IsInParam('
/OPEN');
If copy(paramstr(1),0,1)<>'
/'
Then
FileName := Paramstr(1);
End;
End;
End;
Function EnumProcTWatchWindow(wnd:HWND;pwnd:pHWND):BOOL;
Stdcall;
Var
buf :
Array[0..255]
Of char;
Begin
Result := True;
GetClassName(wnd,buf,SizeOf(buf)-1);
If (buf='
TWatchWindow')
Then
Begin
pwnd^ := wnd;
Result := false;
End;
End;
Function FindWatchWindow(
Out wndWatchWindow,wndChild:HWND):Boolean;
Var
wndEditWindow :HWND;
Begin
Result := False;
wndWatchWindow := 0;
//Fenster TWatchWindow suchen
EnumWindows(@EnumProcTWatchWindow,integer(@wndWatchWindow));
//Wenn es angedockt ist, befindet es sich in einen TEditWindow
If wndWatchWindow=0
Then
Begin
wndEditWindow := FindWindow('
TEditWindow',
Nil);
EnumChildWindows(wndEditWindow,@EnumProcTWatchWindow,integer(@wndWatchWindow));
End;
If wndWatchWindow<>0
Then
Begin
{$IFDEF Delphi_2005_up}
wndChild := FindWindowEx(wndWatchWindow,0,'
TVirtualStringTree',
Nil);
{$ELSE}
wndChild := FindWindowEx(wndWatchWindow,0,'
TDrawGrid',
Nil);
{$ENDIF}
Result := wndChild<>0;
End;
End;
Var
wndWatchWindow,wndChild :HWND;
OutPutFilename :
String;
bAppendFile,bOpen :Boolean;
Begin
HandleParamstr(OutPutFilename,bAppendFile,bOpen);
If FindWatchWindow(wndWatchWindow,wndChild)
Then
Begin
SetForeGroundWindow(wndWatchWindow);
SetFocus(wndWatchWindow);
Sleep(200);
SelectAll_CopyClipboard_SaveToFile(wndWatchWindow,wndChild,OutPutFilename,bAppendFile);
If bopen
Then
ShellExecute(0,'
open',pchar(OutPutFilename),Pchar('
'),
Nil,SW_SHOWDEFAULT)
End
Else
MessageBox(0,'
The Watch Window could not be found.','
Information',MB_OK);
End.