谁是VB+Delphi的高手（难题一个）

Question

'VB Form_Code:
Option ExplicitPrivate Declare Function RegHook Lib "SetMouseHook.dll" (ByVal hwnd As Long) As Boolean
Private Declare Function RemoveHook Lib "SetMouseHook.dll" () As BooleanPrivate Sub Command1_Click()
    Text1.Text = CStr(RegHook(AddressOf MyFun))
End SubPrivate Sub Command2_Click()
    Text1.Text = CStr(RemoveHook)
End Sub
------------------------------------------------------------------------
'VB Module_Code:
Option Explicit
Dim SY As LongPublic Function MyFun() As Long
        SY = SY + 1
        Main.Text2.Text = CStr(SY)
        MyFun = True
End Function
------------------------------------------------------------------------
//Delphi_Code:
library MouseHook;uses
  SysUtils,
  WinTypes,
  WinProcs,
  Messages;{$R *.res}
type
  FuncType = Function():longint;//Short;
var
  IsHooked:boolean;
  HookHandle:hhook;
  DesktopWin:hwnd;
  FunCall:FuncType;
function HookProc(Code:integer;wParam:wparam;lParam:lparam):LRESULT;stdcall;begin
  if(wParam=WM_LBUTTONDOWN)then
    begin
      MessageBeep(MB_ICONASTERISK);
      FunCall();
    end;
    Result:=CallNextHookEx(HookHandle,Code,wParam,lParam);end;function RegHook(FunCallEx:longint):boolean;stdcall;
begin
  Result:=false;
  if ishooked then
    exit;
    FunCall:=FuncType(FunCallEx);
    Desktopwin:=GetDesktopWindow;
    HookHandle:=SetWindowsHookEx(WH_MOUSE,HookProc,HInstance,0);
    Result:=HookHandle<>0;
end;function RemoveHook:boolean;stdcall;
begin
  Result:=false;
  if(not IsHooked)and(HookHandle<>0)then
    Result:=UnhookWindowsHookEx(HookHandle);
    IsHooked:=false;
end;exports
  RegHook,RemoveHook,HookProc;
begin
  IsHooked:=false
end.
===========================================================================
问题是：当VB调用DELPHI的DLL时，单击自己进程的窗体时，VB模块中的‘MyFun’可以执行，但执行两次！
当单击其它进程的窗体时‘MyFun’的代码就没有执行。求：如何点击任何进程中的窗体时‘MyFun’都运行一次？
--------------------------------------------------------------
如问题圆满解决，本贴以两百分结贴+再开一个两百分的贴给主要回复人！！！

Answer 1

连续调用2次的问题，把HOOKPROC改为function HookProc(Code:integer;wParam:wparam;lParam:lparam):LRESULT;stdcall;
begin
　if(Code=HC_Action)then
　　if(wParam=WM_LBUTTONUP)then
　　begin
　　　MessageBeep(MB_ICONASTERISK);
　　　Sleep(500);
　　　FunCall();
　　end;
　Result:=CallNextHookEx(HookHandle,Code,wParam,lParam);
end;

Answer 2

刚才出去了一下，第二个问题。其他进程内不是不能挂钩，而是你VB的回调函数在低2G内，不是全局有效的。你把VB的回调函数想办法弄到高2G中，例如做成DLL，就可以全局有效了。

Answer 3

嘿嘿～如果你要再发帖子给分，那就发在Delphi板内把

Answer 4

这个问题，我推荐个人，他定能帮你：http://www.aidelphi.com/找aizb站长

Answer 5

Eastunfail(龙子龙孙)==(恶鱼杀手)
第二个贴可以是D版的（两个一百分的贴）。
有没有什么方法可以让DLL调用VB中的函数啊？
就像EnumWindows一样，你给它函数的地址它来调用。

Answer 6

可以。但是不能跨进程调用使用CallWindowProc函数，第一个参数是你函数地址，后面四个当作附加参数。
不过你的函数也要有4个参数。

Answer 7

VB的调用窗口和DLL算是一个进程吧，就像我的程序调用EnumWindows函数一样，我的程序和这个API都在一个进程吧？高2G和低2G是什么啊？MessageBeep(MB_ICONASTERISK);
Sleep(500);//这个挂起函数做什么啊？
FunCall();

Answer 8

CallWindowProc函数是发给窗体的，我写的函数是和窗体无关。

Answer 9

Sleep去掉，不管他，我是调试的时候加上去的CallWindowProc也可以当调用函数来用

Answer 10

如果A程序和B程序同时用了DLL C。C只是在代码上是全局共享的，但是使用的栈和堆都是当前进程的。如果你想在B中利用C调用A中的函数，这样也算是跨进程，是不能靠C来调用A中的函数的。
高2G我指的是2-4G的共享空间和系统空间，低2G指的是0-2G的私有进程空间

Answer 11

我是用VB的程序调用DLL的，DLL中的全局钩子收到点击系统中任意窗体的消息时，调用一次我的VB程序中的函数。应该可以啊，我试了一下，只有本进程的所有窗体可以，其它进程的就不行。A.exe(调用者)---->B.dll(Hook)----->C.exe(点击事件)---->B.dll(Hook)---->A.exe(调用者)

Answer 12

例如你在A程序中挂钩（假设回调函数的地址是0xYYYYYYYY） B是HOOK的DLL，你在C中点击，这个时候你当前的进程是C，系统会在挂钩链表中依次调用，对于在2-4G内的DLL，可以正常的调用，因为所有进程内那里的内容是一样的，但是回调函数在A中，而当前程序是C，系统在挂钩的链表中找到这么一个0xBBBBBBBB（B中的鼠标钩子处理程序），而0xBBBBBBBB的函数又调用了回调函数0xYYYYYYYY，但在C程序中0xYYYYYYYY不是一个正确的钩子，这样导致执行了非法指令或者读取了不能读的内存引发异常。记住，我们一般电脑的操作系统里多任务是模拟出来的，当前是C程序主线程执行的时候当前的环境是C的环境而不是A的环境，你试图在C中直接访问A的东西肯定有问题

Answer 13

楼上的是高手！
to 楼主：可以Send/Post一个消息给vb的窗口，在vb里处理。好像只有9x的2G-3G内存空间是所有进程公用的。在NT里按照MSDN的说法2G-4G内存空间是系统保留空间。

Answer 14

HookProc函数改为：
function HookProc(Code:integer;wParam:wparam;lParam:lparam):LRESULT;stdcall;
begin  
 if icode < 0 then
    begin
    Result := CallNextHookEX(0,icode,wparam,lparam);
    exit;
    end;
  result:=0;
  if (wparam=WM_LBUTTONDOWN) then
    begin
      MessageBeep(MB_ICONASTERISK);
      FunCall();
      result:=1;
    end;
end;

Answer 15

{$R *.res}
const
  LBDOWN=WM_USER+WM_LBUTTONDOWN;
  LBUP=WM_USER+WM_LBUTTONUP;
var
  IsHooked:boolean;
  HookHandle:hhook;
  DesktopWin:hwnd;
  hWndLong:longint;
function HookProc(Code:integer;wParam:wparam;lParam:lparam):LRESULT;stdcall;
var
  cur:TPoint;
begin
  if(Code=HC_Action)then
  if(wParam=WM_LBUTTONUP)then
    begin
      MessageBeep(MB_ICONASTERISK);
      GetCursorPos(Cur);
      SendMessage(hWndLong,wParam,WindowFromPoint(Cur),lParam);
    end;
  if(Code=HC_Action)then
  if(wParam=WM_LBUTTONDOWN)then
    begin
      MessageBeep(MB_ICONASTERISK);
      GetCursorPos(Cur);
      SendMessage(hWndLong,wParam,WindowFromPoint(Cur),lParam);
    end;    Result:=CallNextHookEx(HookHandle,Code,wParam,lParam);
end;
---------------------------------------------------------
Option Explicit
Public Declare Function GetClassLong Lib "user32" Alias "GetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Const GWL_WNDPROC = (-4)
Public Const WM_USER = &H400
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202Public Const LBDOWN = WM_USER + WM_LBUTTONDOWN
Public Const LBUP = WM_USER + WM_LBUTTONUPDim Str As String
Public WinProc As LongPublic Function MyFun(ByVal con As String, ByVal hwnd As Long) As Long
    Str = con & "==" & hwnd
    Main.Text2.Text = Str & vbCrLf & vbCrLf & Main.Text2.Text
    MyFun = True
End FunctionPublic Sub SetSubClass(ByVal Wnd As Long)
    On Error Resume Next
    WinProc = GetWindowLong(Wnd, GWL_WNDPROC)
    SetWindowLong Wnd, GWL_WNDPROC, AddressOf WndProc
End SubPublic Sub UnSubClass(ByVal Wnd As Long)
    On Error Resume Next
    SetWindowLong Wnd, GWL_WNDPROC, WinProc
    WinProc = 0
End SubPublic Function WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    On Error Resume Next
    Select Case Msg
        Case LBDOWN: Call MyFun("WM_LBUTTONDOWN", wParam)
        Case LBUP: Call MyFun("WM_LBUTTONUP", wParam)
        Else: WndProc = CallWindowProc(WinProc, hwnd, Msg, wParam, lParam)
    End Select
End Function
========================================================
我现在用这个方法，就是VB的操作太多了，还要SUBCLASS。
不知为什么总非法退出了。
D版的贴子是：
http://community.csdn.net/Expert/topic/3296/3296224.xml?temp=.4829523
下一个贴子明天贴出！
本贴晚几日结，再说说这个问题。

Answer 16

//不知为什么总非法退出了。原来是CallWindowProc没定义！
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Answer 17

//原来是CallWindowProc没定义！呵呵：）