程式转换(200分)

Luben · 1999-02-27

请教各位高手： 在本网站中有人提到： ’如何象许多字典一样动态截取Window95 和NT 屏幕上的字符？‘而且也有答案，但 弟现在针对这个程式要如何转换成Delphi的程式？ 弟现愿意出200分请各位帮忙解决一下. 谢谢

坏蟑螂 · 1999-03-02

源程序是何种语言，在哪儿？ E-Mail 一份给我，就可以了。

CJ · 1999-03-02

pegasus · 1999-03-02

原来的答案是我提供的，至于使用Delphi,并不需要转换， 因为原先的程序是编译生成的DLL, 您只要在Delphi里 面使用这个DLL就行了， DLL会把鼠标下面的字符串通知 给你的程序的，

Luben · 1999-03-02

抱歉！小弟比较不懂C所以不知道要如何从Delphi中呼叫这个DLL中的函式！ 可否请您用程式说明之。                          Luben

WebBar · 1999-03-06

啊？这个DLL在哪儿？我要了！

mayday · 1999-03-06

luben象是个台湾哥们！大富翁人气很旺呀！

Luben · 1999-03-07

叫拜??瞷?硂?拜肈Τ秆?盾?и璶非称倒だ??

pegasus · 1999-03-09

要什么版本的? 让我试试吧!

茶叶蛋 · 1999-06-26

pega（随曹晓刚称呼）：您还有时间吗？ Luben，其实调用Dll还是比较容易的，您学会了吗？如果学会的话，请结束问题吧

Jams · 1999-06-26

刚看了报纸，1998年10月份“中国计算机报”有屏幕截字的介绍，可作参考。

gxg8816 · 2000-02-18

beta · 2000-02-19

这里有Delphi源程序+Dll源程序,不过不是我写的,贴出来吧. smth的delphi版有源代码.发信人: raphaelzl (小飞熊), 信区: Delphi 标  题: 数据定义文件 u_def.pas 发信站: BBS 水木清华站 (Sat Jan  1 11:25:21 2000)   unit U_Def; interface uses   Messages, Windows; const   WM_MOUSEPT = WM_USER + 1000 + Ord('M') + Ord('P') + Ord('T');   MappingFileName = 'Mapping File By Raphael';   MaxStringLen = 50;   CodeJump = $E9909090; type   PInt = ^integer;   _ExtTextOutA = function (theDC :HDC; nXStart, nYStart :integer; toOptions : Longint; rect : PRect;                            lpStr

AnsiChar; nCount :integer; Dx : PInteger) :BOOL; stdcall;   _PExtTextOutA = ^_ExtTextOutA;   TLongJump = packed record     JmpOp : Cardinal;     Addr : Pointer;   end;   TShareMem = packed record     hProcWnd : HWND;           //The main window of the program     hHookWnd : HWND;           //The window currently being hooked     hWndPseudo : HWND;         //The pseudo window used to repaint the other  window     hProc : THandle;           //The process ID of the main program     pMouse : TPoint;           //the mouse position     fStrMouseQueue : array [0..MaxStringLen] of Char; //mouse info     nTimePassed : integer;     //the time passed since last time's mousemove       bCanSpyNow : Boolean;     bHookExtTextOutA : Boolean;     pOldExtTextOutA : TLongJump;     fStrExtTextOutA : array [0..MaxStringLen] of Char;   end;   PShareMem = ^TShareMem; implementation end. --        真的好想拍拍小翅膀，            就飞上那晴朗的天空。   发信人: raphaelzl (小飞熊), 信区: Delphi 标  题: hook的dll源文件 发信站: BBS 水木清华站 (Sat Jan  1 11:26:17 2000)   library dll_HookMouse; uses   SysUtils,   Windows,   Classes,   Messages,   Math,   Dialogs,   U_Def in 'U_Def.pas'; {$R *.RES} var   hMouseHook : HHOOK;   SpyInstalled : Boolean;   fTimerID : Cardinal;   pShMem : PShareMem;   hMappingFile : THandle; function InstallSpy:Boolean; forward; function UnWiseSpy:Boolean; forward; function fExtTextOutA(theDC :HDC; nXStart, nYStart :integer; toOptions : Lon gint; rect : PRect;                       lpStr

AnsiChar; nCount :Longint; Dx: PInteger):BOOL;  stdcall; var   dwBytes, dwCallingProc : DWORD;   pOldExtTextOut : _ExtTextOutA;   hModuleGDI : THandle;   poOri, poDC, poText, poMouse : TPoint;   Size : TSize; begin   UnWiseSpy;   GetWindowThreadProcessID(pShMem^.hHookWnd, @dwCallingProc);   try     if pShMem^.bCanSpyNow and (dwCallingProc <> pShMem^.hProc) then     begin       dwBytes := Min(nCount, MaxStringLen);       CopyMemory(@(pShMem^.fStrExtTextOutA), lpStr, dwBytes);       //Get lpStr Content       //The following codes for get the right text       GetDCOrgEx(theDC, poOri);       // 取得本窗口设备相关坐标原点的全局逻辑坐标       poDC.x := nXStart;       poDC.y := nYStart;       //       LPToDP(theDC, poDC, 1);       //全局逻辑坐标转化为设备相关坐标       GetCursorPos(poMouse);       poText.x := poDC.x + poOri.x;       poText.y := poDC.y + poOri.y;       if (GetTextAlign(theDC) and TA_UPDATECP) <> 0 then       begin         GetCurrentPositionEx(theDC, @poOri);         poText.x := poText.x + poOri.x;         poText.y := poText.y + poOri.y;       end;       GetTextExtentPoint(theDC, lpStr, nCount, Size);       // 取得要输出的字符串的实际显示大小       if (poMouse.x >= poText.x) and (poMouse.x <= poText.x + Size.cx) and          (poMouse.y >= poText.y) and (poMouse.y <= poText.y + Size.cy) then       begin         pShMem^.bCanSpyNow := False;         pShMem^.nTimePassed := -1;       end;       pShMem^.fStrExtTextOutA[dwBytes] := Chr(0);       FlushViewOfFile(pShMem, 0);       if dwCallingProc <> pShMem^.hProc then         PostMessage(pShMem^.hProcWnd, WM_MOUSEPT, 2, 2);     end;     if (dwCallingProc = pShMem^.hProc) or pShMem^.bHookExtTextOutA then     begin       hModuleGDI := GetModuleHandle(PChar('GDI32'));       @pOldExtTextOut := GetProcAddress(hModuleGDI, PChar('ExtTextOutA'));       Result := pOldExtTextOut(theDC, nXStart, nYStart, toOptions, rect, lpS tr, nCount, Dx);     end else       Result := True;   except     Result := False;   end;   SpyInstalled := True;   InstallSpy; end; function UnWiseSpy:Boolean; var   dwBytesWritten, dwOldProtect : DWORD;   pOldExtTextOut : _ExtTextOutA;   hModuleGDI : THandle; begin   hModuleGDI := GetModuleHandle(PChar('GDI32'));   @pOldExtTextOut := GetProcAddress(hModuleGDI, PChar('ExtTextOutA'));   if not VirtualProtect(@pOldExtTextOut, SizeOf(TLongJump), PAGE_EXECUTE_REA DWRITE, @dwOldProtect) then   begin     Result := False;     Exit;   end;   if not WriteProcessMemory(GetCurrentProcess, @pOldExtTextOut, @pShMem^.pOl dExtTextOutA, SizeOf(TLongJump), dwBytesWritten) then   begin     Result := False;     Exit;   end;   if not VirtualProtect(@pOldExtTextOut, SizeOf(TLongJump), dwOldProtect, @d wBytesWritten) then   begin     Result := False;     Exit;   end;   Result := True; end; function InstallSpy:Boolean; var   dwBytesWritten, dwOldProtect : DWORD;   ljHere : TLongJump;   pOldExtTextOut : _ExtTextOutA;   hModuleGDI : THandle; begin   hModuleGDI := GetModuleHandle(PChar('GDI32'));   @pOldExtTextOut := GetProcAddress(hModuleGDI, PChar('ExtTextOutA'));   if not VirtualProtect(@pOldExtTextOut, SizeOf(TLongJump), PAGE_EXECUTE_REA DWRITE, @dwOldProtect) then   begin     Result := False;     Exit;   end;   ljHere.JmpOp := CodeJump;   ljHere.Addr := Pointer( Cardinal(@fExtTextOutA) - Cardinal(@pOldExtTextOut ) - SizeOf(TLongJump) );   if not WriteProcessMemory(GetCurrentProcess, @pOldExtTextOut, @ljHere, Siz eOf(TLongJump), dwBytesWritten) then   begin     Result := False;     Exit;   end;   if not VirtualProtect(@pOldExtTextOut, SizeOf(TLongJump), dwOldProtect, @d wBytesWritten) then   begin     Result := False;     Exit;   end;   Result := True; end; function MouseHookProc(nCode : integer; wPar : WParam; lPar : LParam) : lRes ult; stdcall; var   pMouseInf : TMouseHookStruct; begin   if (not SpyInstalled) and pShMem^.bHookExtTextOutA then     InstallSpy;   if SpyInstalled and (not pShMem^.bHookExtTextOutA) then   begin     UnwiseSpy;     SpyInstalled := False;   end;   pShMem^.nTimePassed := 0 ;   if (nCode >= 0) and (wPar = WM_MOUSEMOVE) then   begin     pMouseInf := (PMouseHookStruct(lPar))^;     if (pShMem^.pMouse.x <> pMouseInf.pt.x) or        (pShMem^.pMouse.y <> pMouseInf.pt.y) then     begin       if nCode = HC_NOREMOVE then         pShMem^.fStrMouseQueue := 'Not removed from the queue'       else                                //then HC_ACTION         pShMem^.fStrMouseQueue := 'Removed from the queue';       pShMem^.pMouse := pMouseInf.pt;       pShMem^.hHookWnd := pMouseInf.hwnd;       PostMessage(pShMem^.hProcWnd, WM_MOUSEPT, 1, 1); //1 indicates mouse m essage     end;   end;   FlushViewOfFile(pShMem, 0);   Result := CallNextHookEx(hMouseHook, nCode, wPar, lPar); end; procedure fOnTimer(theWnd : HWND; msg, idTimer : Cardinal; dwTime : DWORD);f ar pascal; //CallBack Type begin   if pShMem^.nTimePassed = -1 then     Exit;   pShMem^.nTimePassed := pShMem^.nTimePassed + 1;   if pShMem^.nTimePassed > 21 then   begin     pShMem^.nTimePassed := 21;     FlushViewOfFile(pShMem, 0);     Exit;   end;   if pShMem^.nTimePassed > 20 then   begin     pShMem^.bCanSpyNow := True;     FlushViewOfFile(pShMem, 0);     SetWindowPos(pShMem^.hWndPseudo, HWND_TOPMOST, pShMem^.pMouse.x, pShMem^ .pMouse.y, 1, 8, SWP_NOACTIVATE or SWP_SHOWWINDOW);     ShowWindow(pShMem^.hWndPseudo , SW_HIDE);   end; end; function MouseWndProc(theWnd : HWND; theMess : Cardinal; wPar : wParam; lPar  : lParam): LResult;stdcall; begin   case theMess of     WM_CLOSE :             begin                DestroyWindow(theWnd);                PostQuitMessage(0);             end;     else          begin            Result := DefWindowProc(theWnd, theMess, wPar, lPar);            Exit;          end;   end;   Result := 0; end; function InstallMouseHook(hInst : LongWord):Boolean; begin   hMouseHook := SetWindowsHookEx(WH_MOUSE,                                  MouseHookProc,                                  GetModuleHandle(PChar('dll_HookMouse')),                                  0);   if hMouseHook = 0 then   begin     Result := False;     Exit;   end;   pShMem^.hWndPseudo := CreateWindowEx(WS_EX_TOPMOST or WS_EX_TOOLWINDOW,                                        'ZL_MOUSE_WND_PSEUDO',                                        'ZL_MOUSE_WND_PSEUDO',                                        WS_CLIPSIBLINGS or WS_POPUP ,                                        0, 0, 1, 8,                                        0, 0,                                        hInst,                                        nil);   ShowWindow(pShMem^.hWndPseudo, SW_HIDE);   UpdateWindow(pShMem^.hWndPseudo);   fTimerID := SetTimer(0, 0, 10, @fOnTimer);   FlushViewOfFile(pShMem, 0);   Result := True; end; function UnWiseMouseHook:Boolean; begin   KillTimer(0, fTimerID);   DestroyWindow(pShMem^.hWndPseudo);   if SpyInstalled then     UnWiseSpy;   pShMem^.bHookExtTextOutA := False;   FlushViewOfFile(pShMem, 0);   Result := UnHookWindowsHookEx(hMouseHook); end; procedure DllEntry(nReason : integer); begin   case nReason Of     DLL_PROCESS_ATTACH:       begin         hMappingFile := CreateFileMapping($FFFFFFFF,                                           nil,                                           PAGE_READWRITE,                                           0,                                           SizeOf(TShareMem),                                           PChar(MappingFileName));         if hMappingFile<>0 then //if h..=0 , the work is done by OS         begin           pShMem := PShareMem( MapViewOfFile(hMappingFile,                                              FILE_MAP_WRITE,                                              0, //hi_order offset where mapp ing begins                                              0, //lo_order offset where mapp ing begins                                              0) ); //Size of the mapping           if pShMem = nil then           begin             CloseHandle(hMappingFile);             ShowMessage('Cannot create the Share Memory Block!');           end;         end else           ShowMessage('Cannot create the Share Memory Block!');       end;     DLL_PROCESS_DETACH:       begin         UnwiseSpy;         UnMapViewOfFile(pShMem);         CloseHandle(hMappingFile);       end;     else;   end; end; exports   MouseWndProc,   InstallMouseHook,   UnWiseMouseHook; begin   DllProc := @DllEntry;   DllEntry(DLL_PROCESS_ATTACH); end. --        真的好想拍拍小翅膀，            就飞上那晴朗的天空。   发信人: raphaelzl (小飞熊), 信区: Delphi 标  题: hook的exe部分的源程序 发信站: BBS 水木清华站 (Sat Jan  1 11:26:55 2000)   unit U_MouseHook; interface uses   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,   StdCtrls, U_Def; type   TF_MouseHook = class(TForm)     Label1: TLabel;     e_MouseInfo: TEdit;     btn_HookMouse: TButton;     Label2: TLabel;     e_ExtTextOutA: TEdit;     btn_HookExtTextOutA: TButton;     procedure btn_HookMouseClick(Sender: TObject);     procedure FormCreate(Sender: TObject);     procedure FormClose(Sender: TObject; var Action: TCloseAction);     procedure btn_HookExtTextOutAClick(Sender: TObject);   private     fWndClosed, fbMouseHookInstalled : Boolean;     hMapObj : THandle;     pShMem : PShareMem;     procedure getMouseInfo(var theMess:TMessage); message WM_MOUSEPT;   public     { Public declarations }   end; function InstallMouseHook(hInst : LongWord) : Boolean; external 'dll_HookMou se.dll'; function UnWiseMouseHook : Boolean; external 'dll_HookMouse.dll'; function MouseWndProc(theWnd : HWND; theMess : Cardinal; wPar : wParam; lPar  : lParam): LResult; stdcall; external 'dll_HookMouse.dll'; var   F_MouseHook: TF_MouseHook; implementation {$R *.DFM} procedure TF_MouseHook.btn_HookMouseClick(Sender: TObject); begin   if not fbMouseHookInstalled then   begin     fbMouseHookInstalled := InstallMouseHook(hInstance);     if fbMouseHookInstalled then     begin       btn_HookMouse.Caption := 'Stop!';       btn_HookExtTextOutA.Enabled := True;     end  else       ShowMessage('Cannot hook mouse!');   end else   begin     fbMouseHookInstalled := not UnWiseMouseHook;     if not fbMouseHookInstalled then     begin       btn_HookMouse.Caption := 'Hook Mouse';       btn_HookExtTextOutA.Enabled := False;       btn_HookExtTextOutA.Caption := 'Hook ExtTextOutA';       pShMem^.bHookExtTextOutA := False;       FlushViewOfFile(pShMem, 0);     end else       ShowMessage('Cannot unhook mouse!');   end; end; procedure TF_MouseHook.getMouseInfo(var theMess : TMessage); begin   if fWndClosed then     Exit;   if theMess.LParam = 1 then //Get the Mouse info to display     e_MouseInfo.Text := 'X:' + IntToStr(pShMem^.pMouse.x) + ' ' +                         'Y:' + IntToStr(pShMem^.pMouse.y) + ' ' +                         'HWND:0x' + IntToHex(pShMem^.hHookWnd, 8) + ' ' +                         pShMem^.fStrMouseQueue   else if theMess.LParam = 2 then //Get the ExtTextOutA display     e_ExtTextOutA.Text := pShMem^.fStrExtTextOutA; end; procedure TF_MouseHook.FormCreate(Sender: TObject); var   hModuleGDI : THandle;   wc : TWndClass; begin   hMapObj := OpenFileMapping(FILE_MAP_WRITE,     //Get full access of the ma pping file                              False,              //Not inheritable                              LPCTSTR(MappingFileName));   //Name of the mapp ing file   if hMapObj = 0 then   begin     ShowMessage('Cannot locate the Share Memory Block!');     Halt;   end;   pShMem := PShareMem( MapViewOfFile(hMapObj,                                      FILE_MAP_WRITE,                                      0, //hi_order offset where mapping begi ns                                      0, //lo_order offset where mapping begi ns                                      0) ); //Size of the mapping   if pShMem = nil then   begin     ShowMessage('Map File Mapping Failed! Error '+ IntToStr(GetLastError));     CloseHandle(hMapObj);     Halt;   end;   FillChar(pShMem^, SizeOf(TShareMem), 0);   hModuleGDI := GetModuleHandle(PChar('GDI32'));   if hModuleGDI = 0 then   begin     ShowMessage('Cannot get module GDI32! Error ' + IntToStr(GetLastError));       UnmapViewOfFile(pShMem);     CloseHandle(hMapObj);     Halt;   end;   CopyMemory(@pShMem^.pOldExtTextOutA, GetProcAddress(hModuleGDI, PChar('Ext TextOutA')), SizeOf(TLongJump));   pShMem^.hProcWnd := Self.Handle;   GetWindowThreadProcessID(Self.Handle, @pShMem^.hProc);   pShMem^.bHookExtTextOutA := False;   pShMem^.bCanSpyNow := False;   fbMouseHookInstalled := False;   FlushViewOfFile(pShMem, 0);   wc.style         := 0;   wc.lpfnWndProc   := TFNWndProc(@MouseWndProc);   wc.cbClsExtra    := 0;   wc.cbWndExtra    := 0;   wc.hInstance     := HInstance;   wc.hIcon         := 0 ;   wc.hCursor       := 0 ;   wc.hbrBackground := 0 ;   wc.lpszMenuName  := nil;   wc.lpszClassName := 'ZL_MOUSE_WND_PSEUDO';   // register the class for the main window   Windows.RegisterClass(wc);   fWndClosed := False; end; procedure TF_MouseHook.FormClose(Sender: TObject;   var Action: TCloseAction); begin   if fbMouseHookInstalled then     UnWiseMouseHook;   UnMapViewOfFile(pShMem);   CloseHandle(hMapObj);   Windows.UnRegisterClass('ZL_MOUSE_WND_PSEUDO', hInstance);   fWndClosed := True; end; procedure TF_MouseHook.btn_HookExtTextOutAClick(Sender: TObject); begin   if pShMem^.bHookExtTextOutA then     btn_HookExtTextOutA.Caption := 'Hook ExtTextOutA'   else     btn_HookExtTextOutA.Caption := 'Stop!';   pShMem^.bHookExtTextOutA := not pShMem^.bHookExtTextOutA;   FlushViewOfFile(pShMem, 0); end; //RaiseLastWin32Error can be used to create a GetLastError //Message end.

wjiachun · 2000-08-13

多人接受答案了。

程式转换(200分)

Luben

Unregistered / Unconfirmed

坏蟑螂

Unregistered / Unconfirmed

CJ

Unregistered / Unconfirmed

pegasus

Unregistered / Unconfirmed

Luben

Unregistered / Unconfirmed

WebBar

Unregistered / Unconfirmed

mayday

Unregistered / Unconfirmed

Luben

Unregistered / Unconfirmed

pegasus

Unregistered / Unconfirmed

茶叶蛋

Unregistered / Unconfirmed

Jams

Unregistered / Unconfirmed

gxg8816

Unregistered / Unconfirmed

beta

Unregistered / Unconfirmed

wjiachun

Unregistered / Unconfirmed

Similar threads