Question

100分求能通过编译的代码：VB如何实现23：30后锁定鼠标无法移动？

或者实现23：30后禁用W键，游戏防沉迷用的

Answer 1

VB用timer控件，获取系统时间再用hook钩子，满足23：30，则锁定鼠标位置
首先，新建工程，添加一个时间控件，一个模块
在模块中输入
Public hHook As Long
Public h_Hook As Long
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
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
Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Long) As Long
Public 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
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_MOUSEMOVE = &H200
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP As Long = &H205
Public Const WH_KEYBOARD_LL = 13
Public Const WH_MOUSE = 7
Public Const WH_MOUSE_LL As Long = 14
Public Function MyKBHook(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If ncode = 0 Then
MyKBHook = 1
End If
End Function
Public Function My_KBHook(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If ncode = 0 Then
If wParam = WM_MOUSEMOVE Then
My_KBHook = CallNextHookEx(h_Hook, ncode, wParam, lParam)
Else
My_KBHook = 1
End If
End If
End Function
Public Sub PutMeOnTop(Form As Form)
SetWindowPos Form.hwnd, -1, 0, 0, 0, 0, 1 Or 2
End Sub
在页面的通用代码中，定义
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
然后在页面中的timer控件中输入
if format(time,"nn")=23 and format(time,"ss")=30 then
Dim r As RECT
r.Left = Me.Left / 15 + 58: r.Top = Me.Top / 15 + 40
r.Right = Me.Left / 15 + 98: r.Bottom = Me.Top / 15 + 68 '这里就是移动范围的大小
ClipCursor r
endif

Answer 2

模块里

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private 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
Private Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fskey_Modifiers As Long, ByVal vk As Long) As Long
Private Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long) As Long
Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal Scan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const WM_HOTKEY = &H312
Const MOD_ALT = &H1
Const MOD_CONTROL = &H2
Const MOD_SHIFT = &H4
Const GWL_WNDPROC = (-4) '窗口函数的地址

Dim key_preWinProc As Long '用来保存窗口信息
Dim key_Modifiers As Long, key_uVirtKey As Long, key_idHotKey As Long
Dim key_IsWinAddress As Boolean '是否取得窗口信息的判断

Function keyWndproc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

If Msg = WM_HOTKEY Then
Select Case wParam 'wParam 值就是 key_idHotKey
Case 1 '激活 3 个热键后,3 个热键所对应的操作,大家在其他的程序中，只要修改此处就可以了
If Minute(Now) >= "30" And Hour(Now) >= "23" Then
End If
Case 2

Case 3

Case 4

Case 5

End Select
End If

' 将消息传送给指定的窗口
keyWndproc = CallWindowProc(key_preWinProc, hwnd, Msg, wParam, lParam)

End Function

Function SetHotkey(ByVal KeyId As Long, ByVal KeyAss0 As String, ByVal Action As String)
Dim KeyAss1 As Long
Dim KeyAss2 As String
Dim i As Long

i = InStr(1, KeyAss0, ",")
If i = 0 Then
KeyAss1 = Val(KeyAss0)
KeyAss2 = ""
Else
KeyAss1 = Right(KeyAss0, Len(KeyAss0) - i)
KeyAss2 = Left(KeyAss0, i - 1)
End If

key_idHotKey = 0
key_Modifiers = 0
key_uVirtKey = 0

If key_IsWinAddress = False Then '判断是否需要取得窗口信息，如果重复取得,再最后恢复窗口时，将会造成程序死掉
' 记录原来的window程序地址
key_preWinProc = GetWindowLong(Form1.hwnd, GWL_WNDPROC)
' 用自定义程序代替原来的window程序
SetWindowLong Form1.hwnd, GWL_WNDPROC, AddressOf keyWndproc
End If

key_idHotKey = KeyId
Select Case Action
Case "Add"
If KeyAss2 = "Ctrl" Then key_Modifiers = MOD_CONTROL
If KeyAss2 = "Alt" Then key_Modifiers = MOD_ALT
If KeyAss2 = "Shift" Then key_Modifiers = MOD_SHIFT
If KeyAss2 = "Ctrl+Alt" Then key_Modifiers = MOD_CONTROL + MOD_ALT
If KeyAss2 = "Ctrl+Shift" Then key_Modifiers = MOD_CONTROL + MOD_SHIFT
If KeyAss2 = "Ctrl+Alt+Shift" Then key_Modifiers = MOD_CONTROL + MOD_ALT + MOD_SHIFT
If KeyAss2 = "Shift+Alt" Then key_Modifiers = MOD_SHIFT + MOD_ALT
key_uVirtKey = Val(KeyAss1)
RegisterHotKey Form1.hwnd, key_idHotKey, key_Modifiers, key_uVirtKey '向窗口注册系统热键
key_IsWinAddress = True '不需要再取得窗口信息

Case "Del"
SetWindowLong Form1.hwnd, GWL_WNDPROC, key_preWinProc '恢复窗口信息
UnregisterHotKey Form1.hwnd, key_uVirtKey '取消系统热键
key_IsWinAddress = False '可以再次取得窗口信息
End Select
End Function

工程中

Private Sub Form_Load()
SetHotkey 1, "87", "Add"
End Sub

Private Sub Form_Unload(Cancel As Integer)
SetHotkey 1, "", "Del"
End Sub

Answer 3

用timer控件，获取系统时间到23:30时锁w键。

Answer 4

我写好了，等晚上上网再把代码给你贴出来，先别急，呵呵…