主页

将程序至于最前和鼠标编程的问题

yongtang 平安银行 2003-01-10 06:08:04

请问：
我在学习VB中，遇到这样一个问题，我要将我的程序至于最前，即尽管我的程序失去了焦点，但还是显示在其他窗口之前，有点像QQ的那种感觉。我用了如下的API和过程：

Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wflags As Long) As Long
Const HWND_TOPMOST = -1
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1

Public Sub PutWindowOnTop(pFrm As Form)

Dim lngWindowPosition As Long
lngWindowPosition = SetWindowPos(pFrm.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)

End Sub

而且我在Form_Load事件中也加入了Call PutWindowOnTop(frmMain)了，可是frmMain还是没有置前，依然和普通窗口一样。请问这个问题应如何解决？

另外有一个问题，我使用VB如何获得鼠标在我的程序之外的按键情况，比如我的程序运行在桌面上，我对桌面点击了一下左键，程序能捕获这个动作，请问这个如何实现？

非常感谢各位能够帮助我！谢谢！

...全文

12 条回复

切换为时间正序

请发表友善的回复…

发表回复

boywang 2003-01-11

要dll才能hook mouse哦。

回复赞

yongtang 2003-01-11

谢谢各位高手的回复和帮助？
可是我不太懂VC，钩子的应用也不太明白，能不能再讲明白些呢？
谢谢！

回复赞

zyl910 2003-01-11

全局Hook才能需要dll

回复赞

oswica 2003-01-10

有点像黑客程序

回复赞

绝缘 2003-01-10

支持,技术本来就是一柄双刃刀!
其它你的问题可用只用一个API实现的
它是...
还是你自己去查查吧,点到为止!

回复赞

topikachu 2003-01-10

呵呵。
潘多拉魔盒已打开
有多少苦难降临就看自己的造化了：）

回复赞

智能卡_Snooper 2003-01-10

2. The VB part.

A standard module:
==================

Attribute VB_Name = "Module1"
Option Explicit

Public Declare Function HookMouse Lib "MouseHook.dll" () As Long
Public Declare Function UnhookMouse Lib "MouseHook.dll" () As Long

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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

Global Const GWL_WNDPROC = -4
Global g_oldWindowProc As Long

Public Function MyWindowProc(ByVal hWnd As Long, _
ByVal lMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long

If (lMsg = 1234 + &H400) Then
Form1.Caption = "UM_MOUSE"
End If
MyWindowProc = CallWindowProc(g_oldWindowProc, hWnd, lMsg, wParam, lParam)

End Function

Public Sub SubclassMe(f As Form)
g_oldWindowProc = SetWindowLong(f.hWnd, GWL_WNDPROC, AddressOf MyWindowProc)
End Sub

Public Sub UnsubclassMe(f As Form)
SetWindowLong f.hWnd, GWL_WNDPROC, g_oldWindowProc
End Sub

A standard form:
================

VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 795
ClientLeft = 60
ClientTop = 345
ClientWidth = 4110
LinkTopic = "Form1"
ScaleHeight = 795
ScaleWidth = 4110
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdClearTitle
Caption = "&Clear Title"
Height = 495
Left = 2760
TabIndex = 2
Top = 120
Width = 1215
End
Begin VB.CommandButton cmdUnhook
Caption = "&Unhook"
Enabled = 0 'False
Height = 495
Left = 1440
TabIndex = 1
Top = 120
Width = 1215
End
Begin VB.CommandButton cmdHook
Caption = "&Hook"
Height = 495
Left = 120
TabIndex = 0
Top = 120
Width = 1215
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdHook_Click()
cmdHook.Enabled = False
HookMouse
cmdUnhook.Enabled = True
End Sub

Private Sub cmdUnhook_Click()
cmdUnhook.Enabled = False
UnhookMouse
cmdHook.Enabled = True
End Sub

Private Sub cmdClearTitle_Click()
Me.Caption = "Form2"
End Sub

Private Sub Form_Load()
SubclassMe Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
UnhookMouse
UnsubclassMe Me
End Sub

That's basically it. I run NT 4.0 SP5, VB6, VC6.

回复赞

智能卡_Snooper 2003-01-10

I will send the complete projects to your email account including a Win32 example that uses MouseHook.dll. Here I will post the critical things for the dll and a VB example.

1 - MouseHook.dll, standard Win32
2 - a VB example that uses MouseHook.dll

1. The MouseHook.dll

Header:

#ifndef MouseHook_h
#define MouseHook_h

#define UM_MOUSE WM_USER + 1234

extern "C"
{
__declspec(dllexport) BOOL HookMouse( void ) ;
__declspec(dllexport) BOOL UnhookMouse( void ) ;
}

#endif

Source:

#include <windows.h>
#include "MouseHook.h"

#pragma comment(linker, "-section:.shared,rws")
#pragma data_seg(".shared")

HHOOK g_hHook = NULL ;

#pragma data_seg()

HINSTANCE g_hInstance = NULL ;

LRESULT CALLBACK MouseHook( int nCode, WPARAM wParam, LPARAM lParam )
{
if( ( nCode == HC_ACTION ) || ( nCode == HC_NOREMOVE ) )
{
if( wParam == WM_RBUTTONUP )
{
SendMessage( HWND_BROADCAST, UM_MOUSE, wParam, lParam ) ;
}
}
return CallNextHookEx( g_hHook, nCode, wParam, lParam ) ;
}

BOOL HookMouse( void )
{
BOOL fResult ;

fResult = ( g_hHook == NULL ) ;
if( fResult )
{
g_hHook = SetWindowsHookEx( WH_MOUSE, MouseHook, g_hInstance, 0 ) ;
fResult = ( g_hHook != NULL ) ;
}
return fResult ;
}

BOOL UnhookMouse( void )
{
BOOL fResult ;

fResult = ( g_hHook != NULL ) ;
if( fResult )
{
UnhookWindowsHookEx( g_hHook ) ;
g_hHook = NULL ;
}
return fResult ;
}

BOOL APIENTRY DllMain( HINSTANCE hInstance, DWORD dwReason, LPVOID reserved )
{
if( dwReason == DLL_PROCESS_ATTACH )
{
DisableThreadLibraryCalls(hInstance) ;
g_hInstance = hInstance ;
}
return TRUE ;
}

回复赞

topikachu 2003-01-10

上面的hook是本地hook
只能判断到本程序内的键盘鼠标操作

如果不在当前程序范围就只能傻眼了：）

办法么，当然有，不过太危险，我可不想让你的机器三天两头就当了：）

回复赞

智能卡_Snooper 2003-01-10

'下面的代码可以检测任何鼠标和键盘事件，用这些代码配合GetCursorPos和GetWindowRect可以判断什么时候鼠标点下，在那里点下，Good luck.
'模块
Option Explicit

Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Private Const WH_MOUSE = 7
Private Const WH_KEYBOARD = 2
Private Const HC_ACTION = 0

Private mlMouseHook As Long
Private mlKeyboardHook As Long

Private mdtLastInputTime As Date

Public Sub InitQuiesceTimer()

mlMouseHook = SetWindowsHookEx(WH_MOUSE, AddressOf MouseHook, 0, App.ThreadID)
mlKeyboardHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf KeyboardHook, 0, App.ThreadID)

End Sub
Public Sub CloseQuiesceTimer()

UnhookWindowsHookEx mlMouseHook
UnhookWindowsHookEx mlKeyboardHook

End Sub
Public Function LastInputTime() As Date

LastInputTime = mdtLastInputTime

End Function
Private Function MouseHook(ByVal lCode As Long, ByVal lWP As Long, ByVal lLP As Long) As Long

If lCode = HC_ACTION Then
mdtLastInputTime = Now
End If
CallNextHookEx mlMouseHook, lCode, lWP, lLP

End Function
Private Function KeyboardHook(ByVal lCode As Long, ByVal lWP As Long, ByVal lLP As Long) As Long

If lCode = HC_ACTION Then
mdtLastInputTime = Now
End If
CallNextHookEx mlKeyboardHook, lCode, lWP, lLP

End Function

'窗体
Option Explicit

Private Sub Form_Load()

InitQuiesceTimer

End Sub

Private Sub Form_Unload(Cancel As Integer)

CloseQuiesceTimer
exit sub
End Sub

Private Sub Timer1_Timer()

Label1.Caption = Format$(LastInputTime, "hh:nn:ss")

End Sub
'现在运行，将提示产生键盘鼠标消息的时间，可以使用这个判断用户操作状态。

回复赞

智能卡_Snooper 2003-01-10

the first question
try this

Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wflags As Long) As Long
Const HWND_TOPMOST = -1
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1

Public Sub PutWindowOnTop(hwnd as long)

Dim lngWindowPosition As Long
lngWindowPosition = SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)

End Sub

Call PutWindowOnTop(frmMain.hwnd)

回复赞

智能卡_Snooper 2003-01-10

the second question, u may use GetCursorPos and hook the mouse message

回复赞

发动态

发帖子

VB基础类

创建于2007-09-28

加入

7451

社区成员

19.7w+