我试过屏幕分块传输，感觉速度上不是很理想，变化很小的时候确时很快，但变化大的时候就会感觉到慢了，由其在INTENET上，第1块与最后1块有明显的时差，VNC的方法还行，但应该还有优化的余地，希望用DELPHI改时过VNC的能把源码贴出来大家讨论,我发份VNC勾子的delphi源码吧（转来的）
unit UCallBacks;
interface
uses Windows, Messages, SysUtils,
Graphics,Classes;
///////////////////////////////////////////////////////////////////////////-/
// Storage for the global data in the DLL
var
hVeneto: HWND = 0;
UpdateRectMessage: UINT = 0;
CopyRectMessage: UINT = 0;
MouseMoveMessage: UINT = 0;
hCallWndHook: HHOOK = 0; // Handle to the CallWnd hook
hGetMsgHook: HHOOK = 0; // Handle to the GetMsg hook
hDialogMsgHook: HHOOK = 0; // Handle to the DialogMsg hook
hLLKeyboardHook: HHOOK = 0; // Handle to LowLevel kbd hook
hLLMouseHook: HHOOK = 0; // Handle to LowLevel mouse hook
///////////////////////////////////////////////////////////////////////////-/
// Per-instance DLL variables
// const
// char sPrefSegment[] = "Application_Prefs//";
var
sModulePrefs: PChar = nil; // Name of the module that created us
prf_use_GetUpdateRect: Boolean = False; // Use the GetUpdateRect paint mode
prf_use_Timer: Boolean = False; // Use Timer events to trigger updates
prf_use_KeyPress: Boolean = False; // Use keyboard events
prf_use_LButtonUp: Boolean = True; // Use left mouse button up events
prf_use_MButtonUp: Boolean = False; // Use middle mouse button up events
prf_use_RButtonUp: Boolean = False; // Use right mouse button up events
prf_use_Deferral: Boolean = False; // Use deferred updates
hModuleKey: HKEY = 0; // Key used to save settings
// hInstance: HINSTANCE = NULL; // This instance of the DLL
HookMaster: Boolean = False; // Is this instance veneto itself?
appHookedOK: Boolean = False; // Did InitInstance succeed?
///////////////////////////////////////////////////////////////////////////-/
// Registered messages & atoms to be used by VNCHooks.DLL
// Messages
var
VNC_DEFERRED_UPDATE: UINT = 0;
// Atoms
VNC_WINDOWPOS_ATOMNAME: TAtom = 0;
VNC_POPUPSELN_ATOMNAME: TAtom = 0;
VNC_WINDOWPOS_ATOM: TAtom = 0;
VNC_POPUPSELN_ATOM: TAtom = 0;
// Forward definition of hook procedures
function HookHandle(Msg: LongWord; Wnd: HWND; wParam: Longint; lParam:
Longint): BOOL; stdcall;
function CallWndProc(nCode: Integer; wParam: Longint; lParam: Longint):
LRESULT; stdcall;
function GetMessageProc(nCode: Integer; wParam: Longint; lParam: Longint):
LRESULT; stdcall;
function DialogMessageProc(nCode: Integer; wParam: Longint; lParam:
Longint): LRESULT; stdcall;
function LowLevelKeyboardFilterProc(nCode: Integer; wParam: Longint; lParam:
Longint): LRESULT; stdcall;
function LowLevelMouseFilterProc(nCode: Integer; wParam: Longint; lParam:
Longint): LRESULT; stdcall;
function SetHook(Wnd: HWND; UpdateMsg: LongWord; CopyMsg: LongWord;
MouseMsg: LongWord): BOOL; stdcall; export;
function UnSetHook(Wnd: HWND): BOOL; stdcall; export;
function SetKeyboardFilterHook(Activate: BOOL): BOOL; stdcall; export;
function SetMouseFilterHook(Activate: BOOL): BOOL; stdcall; export;
// Forward definition of setup and shutdown procedures
function InitInstance(): BOOL;
function ExitInstance(): BOOL;
implementation
var
rr:trect;
na:integer;
procedure ToBmp(R: TRect);
var
Mybmp:Tbitmap;
dc: hdc;
Mycan: Tcanvas;
begin
Mybmp := Tbitmap.Create; {建立BMPMAP }
Mycan := TCanvas.Create; {屏幕截取}
dc := GetWindowDC(0);
try
Mycan.Handle := dc;
Mybmp.Width :=r.Right-r.Left;
Mybmp.Height :=r.Bottom-r.Top;
Mybmp.Canvas.CopyRect(R, Mycan, R);
finally
releaseDC(0, DC);
end;
Mycan.Handle := 0;
Mycan.Free;
Mybmp.SaveToFile('d:/w/'+inttostr(na)+'.bmp');
inc(na);
Mybmp.Free;
end;
function DllMain(hInst: HWND; ul_reason_for_call: ULONG; lpReserved:
Integer): BOOL; stdcall;
begin
// Find out why we're being called
case (ul_reason_for_call) of
DLL_PROCESS_ATTACH:
begin
// Call the initialisation function
appHookedOK := InitInstance();
// ALWAYS return TRUE to avoid breaking unhookable applications!!!
Result := True;
end;
DLL_PROCESS_DETACH:
begin
// Call the exit function
// If the app failed to hook OK, ExitInstance will still operate OK (hopefully...)
ExitInstance();
Result := TRUE;
end;
else
Result := TRUE;
end;
end;
// Routine to start and stop local keyboard message filtering
function SetKeyboardFilterHook(Activate: BOOL): BOOL; stdcall;
begin
if (Activate) then
begin
if (hLLKeyboardHook = 0) then
begin
// Start up the hook...
hLLKeyboardHook := SetWindowsHookEx(
WH_KEYBOARD, // Hook in before msg reaches app
LowLevelKeyboardFilterProc, // Hook procedure
hInstance, // This DLL instance
0 // Hook in to all apps
);
if (hLLKeyboardHook = 0) then
Result := False
else
Result := TRUE;
end
else
Result := true;
end
else
begin
if (hLLKeyboardHook <> 0) then
begin
// Stop the hook...
Result := (UnhookWindowsHookEx(hLLKeyboardHook));
hLLKeyboardHook := 0;
end
else
Result := True;
end;
end;
// Routine to start and stop local mouse message filtering
function SetMouseFilterHook(Activate: BOOL): BOOL; stdcall;
begin
if (Activate) then
begin
Result := (hLLMouseHook = 0);
if Result then
begin
// Start up the hook...
hLLMouseHook := SetWindowsHookEx(
WH_MOUSE, // Hook in before msg reaches app
LowLevelMouseFilterProc, // Hook procedure
hInstance, // This DLL instance
0 // Hook in to all apps
);
if (hLLMouseHook = 0) then Result := False;
end;
end
else
begin
if (hLLMouseHook <> 0) then
Result := (UnhookWindowsHookEx(hLLMouseHook)) // Stop the hook...
else
Result := True;
hLLMouseHook := 0;
end;
end;
// Add the new hook
function SetHook(Wnd: HWND; UpdateMsg: LongWord; CopyMsg: LongWord;
MouseMsg: LongWord): BOOL stdcall;
begin
// InitInstance;
// Don't add the hook if the window ID is NULL
if (Wnd = 0) then
begin
Result := False;
exit;
end;
// Don't add a hook if there is already one added
if (hVeneto <> 0) then
begin
Result := False;
exit;
end;
// Add the CallWnd hook
hCallWndHook := SetWindowsHookEx(
WH_CALLWNDPROC, // Hook in before msg reaches app
CallWndProc, // Hook procedure
hInstance, // This DLL instance
0 // Hook in to all apps
// GetWindowThreadProcessId(Wnd, nil) // DEBUG : HOOK ONLY WinVNC
);
// Add the GetMessage hook
hGetMsgHook := SetWindowsHookEx(
WH_GETMESSAGE, // Hook in before msg reaches app
GetMessageProc, // Hook procedure
hInstance, // This DLL instance
0 // Hook in to all apps
// GetWindowThreadProcessId(Wnd, nil) // DEBUG : HOOK ONLY WinVNC
);
// Add the GetMessage hook
hDialogMsgHook := SetWindowsHookEx(
WH_SYSMSGFILTER, // Hook in dialogs, menus and scrollbars
DialogMessageProc, // Hook procedure
hInstance, // This DLL instance
0 // Hook in to all apps
);
// Check that it worked
if ((hCallWndHook <> 0) and (hGetMsgHook <> 0) and (hDialogMsgHook <> 0))
then
begin
hVeneto := Wnd; // Save the WinRFB window handle
UpdateRectMessage := UpdateMsg; // Save the message ID to use for rectangle updates
CopyRectMessage := CopyMsg; // Save the message ID to use for copyrect
MouseMoveMessage := MouseMsg; // Save the message ID to send when mouse moves
HookMaster := TRUE; // Set the HookMaster flag for this instance
Result := True;
end
else
begin
// Stop the keyboard hook
SetKeyboardFilterHook(FALSE);
SetMouseFilterHook(FALSE);
// Kill the main hooks
if (hCallWndHook <> 0) then
UnhookWindowsHookEx(hCallWndHook);
if (hGetMsgHook <> 0) then
UnhookWindowsHookEx(hGetMsgHook);
if (hDialogMsgHook <> 0) then
UnhookWindowsHookEx(hDialogMsgHook);
hCallWndHook := 0;
hGetMsgHook := 0;
hDialogMsgHook := 0;
// The hook failed, so return an error code
Result := True;
end;
end;
// Remove the hook from the system
function UnSetHook(Wnd: HWND): BOOL; stdcall;
// EnumWindows procedure to remove the extra property we added
function KillPropsProc(Wnd: HWND; lParam: Longint): BOOL; stdcall;
begin
// Remove our custom property...
RemoveProp(Wnd, PChar(MAKEWORD(VNC_WINDOWPOS_ATOM, 0)));
RemoveProp(Wnd, PChar(MAKEWORD(VNC_POPUPSELN_ATOM, 0)));
Result := True;
end;
var
unHooked: BOOL;
begin
unHooked := True;
// Remove the extra property value from all local windows
EnumWindows(@KillPropsProc, 0);
// Stop the keyboard & mouse hooks
unHooked := unHooked and SetKeyboardFilterHook(FALSE);
unHooked := unHooked and SetMouseFilterHook(FALSE);
// Is the window handle valid?
if (Wnd = 0) then
MessageBox(GetDesktopWindow, 'Window pointer is null', nil, MB_OK);
// Is the correct application calling UnSetHook?
if (Wnd <> hVeneto) then
Result := False;
// Unhook the procs
if (hCallWndHook <> 0) then
begin
unHooked := unHooked and UnhookWindowsHookEx(hCallWndHook);
hCallWndHook := 0;
end;
if (hGetMsgHook <> 0) then
begin
unHooked := unHooked and UnhookWindowsHookEx(hGetMsgHook);
hGetMsgHook := 0;
end;
if (hDialogMsgHook <> 0) then
begin
unHooked := unHooked and UnhookWindowsHookEx(hDialogMsgHook);
hDialogMsgHook := 0;
end;
// If we managed to unhook then reset
if (unHooked) then
begin
hVeneto := 0;
HookMaster := False;
end;
Result := unHooked;
end;
// Routine to get the window's client rectangle, in screen coordinates
function GetAbsoluteClientRect(Wnd: HWnd; var Rect: TRect): BOOL;
var
topleft: TPoint;
begin
topleft.x := 0;
topleft.y := 0;
Result := (GetClientRect(Wnd, Rect)); // Get the client rectangle size
if Result then
Result := (ClientToScreen(Wnd, topleft)); // Get the client rectangle position
if Result then
begin
// Now adjust the window rectangle
rect.Left := rect.Left + topleft.x;
rect.Top := rect.Top + topleft.y;
rect.Right := rect.Right + topleft.x;
rect.Bottom := rect.Bottom + topleft.y;
end;
end;
(******************************************************************
// Routine to send a CopyRect message to WinVNC
inline void SendCopyWindowRect(HWND hWnd)
{
WPARAM vwParam;
// All we send back is the handle of the window to be moved
vwParam = (LPARAM) hWnd;
// Send the update to Veneto
PostMessage(
hVeneto,
CopyRectMessage,
vwParam,
0
);
}
**********************************************)
// Routine to send an UpdateRect message to Veneto
//procedure SendUpdateRect(x, y, x2, y2: ShortInt);
procedure SendUpdateRect(x, y, x2, y2: Smallint);
var
vwParam: Longint;
vlParam: Longint;
begin
OutputDebugString(PChar(IntToStr(x) + ',' + IntToStr
+ ',' + IntToStr(x2) + ',' + IntToStr(y2)));
vwParam := MAKELONG(x, y);
vlParam := MAKELONG(x2, y2);
// Send the update to Veneto
PostMessage(
hVeneto,
UpdateRectMessage,
vwParam,
vlParam
);
end;
// Send a window's position to Veneto
procedure SendWindowRect(Wnd: HWND);
var
wrect: TRect;
begin
// Get the rectangle position
if (GetWindowRect(Wnd, wrect) and IsWindowVisible(Wnd)) then
// Send the position
{SendUpdateRect(
wrect.Left,
wrect.Top,
wrect.Right,
wrect.Bottom
); {}
// tobmp(wrect);
end;
// Send a deferred message into this Window's message queue, so that
// we'll intercept it again only after the message that triggered it hasbeen
// handled
//procedure SendDeferredUpdateRect(Wnd: HWND; x, y, x2, y2: ShortInt);
procedure SendDeferredUpdateRect(Wnd: HWND; x, y, x2, y2: Smallint);
var
vwParam: Longint;
vlParam: Longint;
begin
OutputDebugString(PChar(IntToStr(x) + ',' + IntToStr
+ ',' + IntToStr(x2) + ',' + IntToStr(y2)));
rr:=rect(x,y,x2,y2);
vwParam := MAKELONG(x, y);
vlParam := MAKELONG(x2, y2);
if (prf_use_Deferral) then
// Send the update back to the window
PostMessage(
Wnd,
VNC_DEFERRED_UPDATE,
vwParam,
vlParam
)
else
// Send the update to WinRFB
PostMessage(
hVeneto,
UpdateRectMessage,
vwParam,
vlParam
);
end;
procedure SendDeferredWindowRect(Wnd: HWND);
var
wrect: TRect;
begin
// Get the rectangle position
if (GetWindowRect(Wnd, wrect) and IsWindowVisible(Wnd)) then
// Send the position
SendDeferredUpdateRect(
Wnd,
wrect.left,
wrect.top,
wrect.right,
wrect.bottom
);
end;
procedure SendDeferredBorderRect(Wnd: HWND);
var
wrect: TRect;
crect: TRect;
begin
// Get the rectangle position
if (GetWindowRect(Wnd, wrect) and IsWindowVisible(Wnd)) then
// Get the client rectangle position
if (GetAbsoluteClientRect(Wnd, crect)) then
begin
// Send the four border rectangles
SendDeferredUpdateRect(Wnd, wrect.left, wrect.top, wrect.right,
crect.top);
SendDeferredUpdateRect(Wnd, wrect.left, wrect.top, crect.left,
wrect.bottom);
SendDeferredUpdateRect(Wnd, wrect.left, crect.bottom, wrect.right,
wrect.bottom);
SendDeferredUpdateRect(Wnd, crect.right, wrect.top, wrect.right,
wrect.bottom);
end;
end;
// Generic hook-handler
function HookHandle(Msg: LongWord; Wnd: HWND; wParam: Longint; lParam:
Longint): BOOL; stdcall;
var
Prop: HWnd;
region: HRGN;
buffsize: Integer;
x: Longint;
buff: PRgnData;
TopLeft: Tpoint;
uRect: PRect;
begin
Result := True;
////////////////////////////////////////////////////////////////
// *** HANDLE DEFERRED UPDATES ***
// Is this a deferred-update message?
if (Msg = VNC_DEFERRED_UPDATE) then
begin
// NOTE : NEVER use the SendDeferred- routines to send updates
// from here, or you'll get an infinite loop....!
// NB : The format of DEFERRED_UPDATE matches that of UpdateRectMessage,
// so just send the exact same message data to WinRFB:
PostMessage(
hVeneto,
UpdateRectMessage,
wParam,
lParam
);
Result := False;
end;
// *** Could use WM_COPYDATA to send data to WinVNC
(**********************************************
if (GetClassLong(hWnd, GCW_ATOM) = = 32768)
{
_RPT4(_CRT_WARN, "DBG : popup menu message (hwnd=%d, msg=%d, l=%d,
w=%d)/n",
hWnd, MessageId, lParam, wParam);
}
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * )
**********************************************)
////////////////////////////////////////////////////////////////
// *** UPDATE-TRIGGERING MESSAGES ***
// Do something dependent upon message type
case Msg of
////////////////////////////////////////////////////////////////
// Messages indicating only a border repaint.
WM_NCPAINT: Result := True;
WM_NCACTIVATE:
begin
SendDeferredBorderRect(Wnd);
Exit;
end;
////////////////////////////////////////////////////////////////
// Messages indicating a client area repaint
WM_CHAR: Result := True;
WM_KEYUP: // Handle key-presses
begin
if (prf_use_KeyPress) then
SendDeferredWindowRect(Wnd);
Exit;
end;
WM_LBUTTONUP: // Handle LMB clicks
begin
if (prf_use_LButtonUp) then
SendDeferredWindowRect(Wnd);
Exit;
end;
WM_MBUTTONUP: // Handle MMB clicks
begin
if (prf_use_MButtonUp) then
SendDeferredWindowRect(Wnd);
Exit;
end;
WM_RBUTTONUP: // Handle RMB clicks
begin
if (prf_use_RButtonUp) then
SendDeferredWindowRect(Wnd);
Exit;
end;
WM_TIMER:
begin
if (prf_use_Timer) then
SendDeferredWindowRect(Wnd);
Exit;
end;
WM_HSCROLL: Result := True;
WM_VSCROLL:
begin
if ((LOWORD(wParam) = SB_THUMBTRACK) and not (LOWORD(wParam) =
SB_ENDSCROLL)) then
SendDeferredWindowRect(Wnd);
Exit;
end;
485: // HACK to handle popup menus
begin
// Get the old popup menu selection value
Prop := GetProp(Wnd, PChar(MAKELONG(VNC_POPUPSELN_ATOM, 0)));
if (prop <> Cardinal(wParam)) then
begin
// It did, so update the menu & the selection value
SendDeferredWindowRect(Wnd);
SetProp(Wnd,
PChar(MAKELONG(VNC_POPUPSELN_ATOM, 0)),
wParam);
end;
Exit;
end;
////////////////////////////////////////////////////////////////
// Messages indicating a full window update
WM_SYSCOLORCHANGE: Result := True;
WM_PALETTECHANGED: Result := True;
WM_SETTEXT: Result := True;
WM_ENABLE: Result := True;
BM_SETCHECK: Result := True;
BM_SETSTATE: Result := True;
EM_SETSEL:
begin
//case WM_MENUSELECT:
SendDeferredWindowRect(Wnd);
Exit;
end;
////////////////////////////////////////////////////////////////
// Messages indicating that an area of the window needs updating
// Uses GetUpdateRect to find out which
WM_PAINT:
begin
if (prf_use_GetUpdateRect) then
begin
region := CreateRectRgn(0, 0, 0, 0);
// Get the affected region
if (GetUpdateRgn(Wnd, region, FALSE) <> ERROR) then
begin
// Get the top-left point of the client area
TopLeft.x := 0;
TopLeft.y := 0;
if (ClientToScreen(Wnd, TopLeft)) then
begin
// Get the size of buffer required
buffsize := GetRegionData(region, 0, nil);
if (buffsize <> 0) then
begin
// Now get the region data
GetMem(buff, buffsize);
if (GetRegionData(region, buffsize, buff) <> ERROR) then
begin
for x := 0 to buff.rdh.nCount do
begin
// Obtain the rectangles from the list
uRect := PRect(Integer(buff) + SizeOf(TRgnDataHeader) +
(x * SizeOf(TRect)));
SendDeferredUpdateRect(
Wnd,
(TopLeft.x + urect.Left),
(TopLeft.y + urect.Top),
(TopLeft.x + urect.Right),
(TopLeft.y + urect.Bottom)
);
end;
end;
FreeMem(buff);
end;
end;
end;
// Now free the region
if (region <> 0) then DeleteObject(region);
end
else
SendDeferredWindowRect(Wnd);
Exit;
end;
////////////////////////////////////////////////////////////////
// Messages indicating full repaint of this and a different window
// Send the new position of the window
WM_WINDOWPOSCHANGING:
begin
if IsWindowVisible(Wnd) then
SendWindowRect(Wnd);
Exit;
end;
WM_WINDOWPOSCHANGED:
begin
if IsWindowVisible(Wnd) then
SendDeferredWindowRect(Wnd);
Exit;
end;
////////////////////////////////////////////////////////////////
// WinRFB also wants to know about mouse movement
WM_NCMOUSEMOVE: Result := True;
WM_MOUSEMOVE:
begin
// Inform WinRFB that the mouse has moved and pass it the current cursor handle
PostMessage(
hVeneto,
MouseMoveMessage,
GetCursor(),
0
);
Exit;
end;
////////////////////////////////////////////////////////////////
// VNCHOOKS PROPERTIES HANDLING WINDOWS
WM_DESTROY:
begin
RemoveProp(Wnd, PChar(MAKEWORD(VNC_WINDOWPOS_ATOM, 0)));
RemoveProp(Wnd, PChar(MAKEWORD(VNC_POPUPSELN_ATOM, 0)));
Exit;
end;
end;
end;
//钩子回调函数
// Hook procedure for CallWindow hook
function CallWndProc(nCode: Integer; wParam: Longint; lParam: Longint):
LRESULT ;stdcall;
var
cwpStruct: PCwpStruct;
begin
// Do we have to handle this message?
if (nCode = HC_ACTION) then
if (hVeneto <> 0) then // Process the hook if the Veneto window handle is valid
begin
cwpStruct := PCwpStruct(lParam);
HookHandle(cwpStruct.message, cwpStruct.hwnd, cwpStruct.wParam,
cwpStruct.lParam);
end;
// Call the next handler in the chain
Result := CallNextHookEx(hCallWndHook, nCode, wParam, lParam);
end;
// Hook procedure for GetMessageProc hook
function GetMessageProc(nCode: Integer; wParam: Longint; lParam: Longint):
LRESULT ;stdcall;
var
Msg: PMsg;
begin
// Do we have to handle this message?
if (nCode = HC_ACTION) then
if (hVeneto <> 0) then // Process the hook only if the Veneto window is valid
begin
Msg := PMsg(lParam);
if (wParam = PM_REMOVE) then // Only handle application messages if they're being removed:
HookHandle(Msg.message, Msg.hwnd, Msg.wParam, Msg.lParam); // Handle the message
end;
// Call the next handler in the chain
Result := CallNextHookEx(hGetMsgHook, nCode, wParam, lParam);
end;
// Hook procedure for DialogMessageProc hook
function DialogMessageProc(nCode: Integer; wParam: Longint; lParam:
Longint): LRESULT ;stdcall;
var
Msg: PMsg;
begin
// Do we have to handle this message?
if (nCode >= 0) then
if (hVeneto <> 0) then // Process the hook only if the Veneto window is valid
begin
Msg := PMsg(lParam);
HookHandle(Msg.message, Msg.hwnd, Msg.wParam, Msg.lParam); // Handle the message
end;
// Call the next handler in the chain
Result := CallNextHookEx(hGetMsgHook, nCode, wParam, lParam);
end;
// Hook procedure for LowLevel Keyboard filtering
function LowLevelKeyboardFilterProc(nCode: Integer; wParam: Longint; lParam:
Longint): LRESULT ;stdcall;
var
Msg: PMsg;
begin
// Are we expected to handle this callback?
if (nCode = HC_ACTION) then
begin
Msg := PMsg(lParam);
HookHandle(Msg.message, Msg.hwnd, Msg.wParam, Msg.lParam); // Handle the message
end;
// Otherwise, pass on the message
Result := CallNextHookEx(hLLKeyboardHook, nCode, wParam, lParam);
end;
// Hook procedure for LowLevel Mouse filtering
function LowLevelMouseFilterProc(nCode: Integer; wParam: Longint; lParam:
Longint): LRESULT ;stdcall;
var
Msg: PMsg;
begin
// Are we expected to handle this callback?
if (nCode = HC_ACTION) then
begin
Msg := PMsg(lParam);
HookHandle(Msg.message, Msg.hwnd, Msg.wParam, Msg.lParam); // Handle the message
end;
// Otherwise, pass on the message
Result := CallNextHookEx(hLLMouseHook, nCode, wParam, lParam);
end;
function StrLen(const Str: PChar): Cardinal; assembler;
asm
MOV EDX,EDI
MOV EDI,EAX
MOV ECX,0FFFFFFFFH
XOR AL,AL
REPNE SCASB
MOV EAX,0FFFFFFFEH
SUB EAX,ECX
MOV EDI,EDX
end;
function NameFromPath(const path: PChar): PChar;
var
x: Integer;
l: Integer;
begin
l := strlen(path);
Result := nil;
// Find the file part of a filename
for x := (l - 1) downto 0 do
if (path[x] = '/') then
begin
Result := PChar(Copy(string(path), x + 1, l));
Break;
end;
// If we didn't fine a / then just return a copy of the original
if (Result = nil) then
Result := path;
end;
const
szSoftware = 'Software';
szCompany = 'Levin';
szProfile = 'HTHooks';
function GetRegistryKey(): HKEY;
var
hAppKey: HKEY;
hSoftKey: HKEY;
hCompanyKey: HKEY;
dw: PDWORD;
begin
hAppKey := 0;
hSoftKey := 0;
hCompanyKey := 0;
GetMem(dw, SizeOf(DWORD));
if (RegOpenKeyEx(HKEY_CURRENT_USER, szSoftware, 0, KEY_WRITE or KEY_READ,
hSoftKey) = ERROR_SUCCESS) then
begin
if (RegCreateKeyEx(hSoftKey, szCompany, 0, nil,
REG_OPTION_NON_VOLATILE, KEY_WRITE or KEY_READ, nil,
hCompanyKey, dw) = ERROR_SUCCESS) then
RegCreateKeyEx(hCompanyKey, szProfile, 0, nil,
REG_OPTION_NON_VOLATILE, KEY_WRITE or KEY_READ, nil,
hAppKey, dw);
end;
if (hSoftKey <> 0) then
RegCloseKey(hSoftKey);
if (hCompanyKey <> 0) then
RegCloseKey(hCompanyKey);
FreeMem(dw);
Result := hAppKey;
end;
function GetModuleKey(const proc_name: PChar): HKEY;
var
hModule: HKEY;
hAppKey: HKEY;
FileName: PChar;
dw: PDWORD;
begin
hModule := 0;
// Work out the registry key to save this under
// sModulePrefs := malloc(strlen(sPrefSegment) + strlen(proc_name) + 1);
sModulePrefs := PChar('Software/HowTo/HookUsage/' + proc_name);
// if (sModulePrefs = nil) then Result := 0;
// sprintf(sModulePrefs, "%s%s", sPrefSegment, proc_name);
// Check whether the library's entry exists!
hAppKey := GetRegistryKey();
// if (hAppKey = 0) then Result := 0;
// Attempt to open the section for this application
if (RegOpenKeyEx(hAppKey,
sModulePrefs,
0, KEY_WRITE or KEY_READ,
hModule
) <> ERROR_SUCCESS) then
begin
// Cut off the app directory and just use the name
FileName := NameFromPath(proc_name);
if (FileName = nil) then
RegCloseKey(hAppKey);
// Adjust the moduleprefs name
// sprintf(sModulePrefs, "%s%s", sPrefSegment, file_name);
sModulePrefs := PChar('Software/HowTo/HookUsage/' + FileName);
{ if FileName <> nil then
begin
Dec(FileName, SizeOf(Cardinal));
FreeMem(FileName, Cardinal(Pointer(FileName)^));
end;
}
GetMem(dw, SizeOf(DWORD));
// Now get the module key again
if (RegCreateKeyEx(hAppKey,
sModulePrefs,
0, nil, REG_OPTION_NON_VOLATILE,
KEY_WRITE or KEY_READ,
nil,
hModule,
dw) <> ERROR_SUCCESS) then
RegCloseKey(hAppKey); // Couldn't find/create the key - fail!
FreeMem(dw);
end;
// Close the application registry key
RegCloseKey(hAppKey);
Result := hModule;
end;
procedure WriteProfileInt(key: PChar; Value: Integer);
begin
RegSetValueEx(
hModuleKey,
key,
0,
REG_DWORD,
@Value,
sizeof(Value));
end;
function InitInstance(): BOOL;
var
proc_name: array[0..MAX_PATH] of Char;
Size: DWORD;
begin
// Create the global atoms
VNC_WINDOWPOS_ATOM := GlobalAddAtom(PChar(VNC_WINDOWPOS_ATOMNAME));
if (VNC_WINDOWPOS_ATOM = 0) then Result := False;
VNC_POPUPSELN_ATOM := GlobalAddAtom(PChar(VNC_POPUPSELN_ATOMNAME));
if (VNC_POPUPSELN_ATOM = 0) then Result := False;
// Attempt to get the program/module name
size := GetModuleFileName(
HInstance,
@proc_name,
MAX_PATH);
if Size = 0 then Result := False;
// Get the key for the module
hModuleKey := GetModuleKey(proc_name);
// if (hModuleKey = 0) then Result := False;
// Read in the prefs
prf_use_GetUpdateRect := BOOL(GetProfileInt(proc_name,
'use_GetUpdateRect',
Integer(True)));
prf_use_Timer := BOOL(GetProfileInt(proc_name,
'use_Timer',
Integer(FALSE)));
prf_use_KeyPress := BOOL(GetProfileInt(proc_name,
'use_KeyPress',
Integer(TRUE)));
prf_use_LButtonUp := BOOL(GetProfileInt(proc_name,
'use_LButtonUp',
Integer(TRUE)));
prf_use_MButtonUp := BOOL(GetProfileInt(proc_name,
'use_MButtonUp',
Integer(TRUE)));
prf_use_RButtonUp := BOOL(GetProfileInt(proc_name,
'use_RButtonUp',
Integer(TRUE)));
prf_use_Deferral := BOOL(GetProfileInt(proc_name,
'use_Deferral',
Integer(TRUE)));
Result := True;
end;
function ExitInstance(): BOOL;
begin
// Free the created atoms
if (VNC_WINDOWPOS_ATOM <> 0) then
begin
GlobalDeleteAtom(VNC_WINDOWPOS_ATOM);
VNC_WINDOWPOS_ATOM := 0;
end;
if (VNC_POPUPSELN_ATOM <> 0) then
begin
GlobalDeleteAtom(VNC_POPUPSELN_ATOM);
VNC_POPUPSELN_ATOM := 0;
end;
// Write the module settings to disk
if (sModulePrefs <> nil) then
begin
WriteProfileInt(
'use_GetUpdateRect',
Integer(prf_use_GetUpdateRect)
);
WriteProfileInt(
'use_Timer',
Integer(prf_use_Timer)
);
WriteProfileInt(
'use_KeyPress',
Integer(prf_use_KeyPress)
);
WriteProfileInt(
'use_LButtonUp',
Integer(prf_use_LButtonUp)
);
WriteProfileInt(
'use_MButtonUp',
Integer(prf_use_MButtonUp)
);
WriteProfileInt(
'use_RButtonUp',
Integer(prf_use_RButtonUp)
);
WriteProfileInt(
'use_Deferral',
Integer(prf_use_Deferral)
);
{
if sModulePrefs <> nil then
begin
Dec(sModulePrefs, SizeOf(Cardinal));
FreeMem(sModulePrefs, Cardinal(Pointer(sModulePrefs)^));
end;
}
sModulePrefs := nil;
end;
// Close the registry key for this module
if (hModuleKey <> 0) then
RegCloseKey(hModuleKey);
Result := True;
end;
initialization
DisableThreadLibraryCalls(HInstance);
VNC_DEFERRED_UPDATE :=
RegisterWindowMessage('HTHooks.Deferred.UpdateMessage');
VNC_WINDOWPOS_ATOMNAME :=
GlobalAddAtom(PChar('HTHooks.CopyRect.WindowPos'));
VNC_POPUPSELN_ATOMNAME :=
GlobalAddAtom(PChar('HTHooks.PopUpMenu.Selected'));
finalization
// Just saw this now, upsssss...
// GlobalDeleteAtom(VNC_DEFERRED_UPDATE);
end.
这个代码还有些问题希望能人，能候正一下，比如不能勾住所有程序
);