这个程序功能很简单,就是打开之后窗口最大化,上面有一句话,可以自己写咯。我写的是:你喜欢我么?这句话下面有两个按钮,一个是“喜欢”,一个是“不喜欢”。
程序要实现的功能就是点击“喜欢”弹出对话框:“嘿嘿,你说喜欢俺咯,啦啦啦~~”;如果要点“不喜欢”的话,那个按钮会跑一边儿去,让你点不到。同样,程序屏蔽了tab、win、alt+F4等热键,只能点“喜欢”的,除非按下“ctrl+alt+del”组合键调出任务管理器结束进程。本来可以屏蔽所有按键的,不过有些小题大做了,实现起来也很麻烦,就暂且如此吧。
打开vb6.0,新建一个工程,添加一个标签,标签的caption属性自己写上想说的话。添加两个按钮:command1和command2,command2的tabstop设置为false。设置好form1的属性,borderstyle为0-none,windowstat为2-maximized。
大体上就是这么简单,废话少说,代码如下:
添加一个模块module1.bas(屏蔽系统热键的):
Option Explicit
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Public 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
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Const HC_ACTION = 0
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_SYSKEYDOWN = &H104
Public Const WM_SYSKEYUP = &H105
Public Const VK_TAB = &H9
Public Const VK_CONTROL = &H11
Public Const VK_ESCAPE = &H1B
Public Const WH_KEYBOARD_LL = 13
Public Const LLKHF_ALTDOWN = &H20
Public Type KBDLLHOOKSTRUCT
vkCode As Long
scanCode As Long
flags As Long
time As Long
dwExtraInfo As Long
End Type
Dim p As KBDLLHOOKSTRUCT
Public Function LowLevelKeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim fEatKeystroke As Boolean
If (nCode = HC_ACTION) Then
If wParam = WM_KEYDOWN Or wParam = WM_SYSKEYDOWN Or wParam = WM_KEYUP Or wParam = WM_SYSKEYUP Then
CopyMemory p, ByVal lParam, Len(p)
fEatKeystroke = _
((p.vkCode = VK_TAB) And ((p.flags And LLKHF_ALTDOWN) <> 0)) Or _
((p.vkCode = VK_ESCAPE) And ((p.flags And LLKHF_ALTDOWN) <> 0)) Or _
((p.vkCode = VK_ESCAPE) And ((GetKeyState(VK_CONTROL) And &H8000) <> 0)) Or _
((p.vkCode = 91) Or (p.vkCode = 92) Or (p.vkCode = 93)) '左右Win 和徽标键
End If
End If
If fEatKeystroke Then
LowLevelKeyboardProc = -1
Else
LowLevelKeyboardProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
End If
End Function
添加工程代码如下:
Option Explicit
Dim hhkLowLevelKybd As Long
Private Sub Form_Unload(Cancel As Integer)
If hhkLowLevelKybd <> 0 Then UnhookWindowsHookEx hhkLowLevelKybd
End Sub
Private Sub Command1_Click()
Dim ddmm As String
ddmm = MsgBox("嘿嘿,你说喜欢俺咯,啦啦啦~~", vbInformation, "好高兴哦")
UnhookWindowsHookEx hhkLowLevelKybd
hhkLowLevelKybd = 0
Unload Me
End
End Sub
Private Sub Command2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim a As Integer
Dim b As Integer
a = Int(Rnd() * 20000)
b = Int(Rnd() * 16000)
Command2.Top = a + 3 * Rnd() '#随机数
Command2.Left = b + Rnd() '#随机数
If Command2.Left < 0 Then Command2.Left = Rnd() + Command2.Width
If Command2.Top < 0 Then Command2.Top = Rnd() + Command2.Height
If Command2.Left > Me.Width - Command2.Width Then Command2.Left = 10 * Rnd()
If Command2.Top > Me.Height - Command2.Height Then Command2.Top = 10 * Rnd()
End Sub
Private Sub Form_Load()
hhkLowLevelKybd = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, App.hInstance, 0)
Form1.Width = Screen.Width
Form1.Height = Screen.Height
Command1.Left = Screen.Width / 2 - Command1.Width - 450
Command2.Left = Screen.Width / 2 + 450
Label1.Left = (Screen.Width - Label1.Width) / 2
Image1.Left = (Screen.Width - Image1.Width) / 2
End Sub
好了,大体上就是这个样子,具体的美化和功能添加可以再补充咯,写完收工。生成可执行文件,等mm来了发给她~~
程序要实现的功能就是点击“喜欢”弹出对话框:“嘿嘿,你说喜欢俺咯,啦啦啦~~”;如果要点“不喜欢”的话,那个按钮会跑一边儿去,让你点不到。同样,程序屏蔽了tab、win、alt+F4等热键,只能点“喜欢”的,除非按下“ctrl+alt+del”组合键调出任务管理器结束进程。本来可以屏蔽所有按键的,不过有些小题大做了,实现起来也很麻烦,就暂且如此吧。
打开vb6.0,新建一个工程,添加一个标签,标签的caption属性自己写上想说的话。添加两个按钮:command1和command2,command2的tabstop设置为false。设置好form1的属性,borderstyle为0-none,windowstat为2-maximized。
大体上就是这么简单,废话少说,代码如下:
添加一个模块module1.bas(屏蔽系统热键的):
Option Explicit
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Public 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
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Const HC_ACTION = 0
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_SYSKEYDOWN = &H104
Public Const WM_SYSKEYUP = &H105
Public Const VK_TAB = &H9
Public Const VK_CONTROL = &H11
Public Const VK_ESCAPE = &H1B
Public Const WH_KEYBOARD_LL = 13
Public Const LLKHF_ALTDOWN = &H20
Public Type KBDLLHOOKSTRUCT
vkCode As Long
scanCode As Long
flags As Long
time As Long
dwExtraInfo As Long
End Type
Dim p As KBDLLHOOKSTRUCT
Public Function LowLevelKeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim fEatKeystroke As Boolean
If (nCode = HC_ACTION) Then
If wParam = WM_KEYDOWN Or wParam = WM_SYSKEYDOWN Or wParam = WM_KEYUP Or wParam = WM_SYSKEYUP Then
CopyMemory p, ByVal lParam, Len(p)
fEatKeystroke = _
((p.vkCode = VK_TAB) And ((p.flags And LLKHF_ALTDOWN) <> 0)) Or _
((p.vkCode = VK_ESCAPE) And ((p.flags And LLKHF_ALTDOWN) <> 0)) Or _
((p.vkCode = VK_ESCAPE) And ((GetKeyState(VK_CONTROL) And &H8000) <> 0)) Or _
((p.vkCode = 91) Or (p.vkCode = 92) Or (p.vkCode = 93)) '左右Win 和徽标键
End If
End If
If fEatKeystroke Then
LowLevelKeyboardProc = -1
Else
LowLevelKeyboardProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
End If
End Function
添加工程代码如下:
Option Explicit
Dim hhkLowLevelKybd As Long
Private Sub Form_Unload(Cancel As Integer)
If hhkLowLevelKybd <> 0 Then UnhookWindowsHookEx hhkLowLevelKybd
End Sub
Private Sub Command1_Click()
Dim ddmm As String
ddmm = MsgBox("嘿嘿,你说喜欢俺咯,啦啦啦~~", vbInformation, "好高兴哦")
UnhookWindowsHookEx hhkLowLevelKybd
hhkLowLevelKybd = 0
Unload Me
End
End Sub
Private Sub Command2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim a As Integer
Dim b As Integer
a = Int(Rnd() * 20000)
b = Int(Rnd() * 16000)
Command2.Top = a + 3 * Rnd() '#随机数
Command2.Left = b + Rnd() '#随机数
If Command2.Left < 0 Then Command2.Left = Rnd() + Command2.Width
If Command2.Top < 0 Then Command2.Top = Rnd() + Command2.Height
If Command2.Left > Me.Width - Command2.Width Then Command2.Left = 10 * Rnd()
If Command2.Top > Me.Height - Command2.Height Then Command2.Top = 10 * Rnd()
End Sub
Private Sub Form_Load()
hhkLowLevelKybd = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, App.hInstance, 0)
Form1.Width = Screen.Width
Form1.Height = Screen.Height
Command1.Left = Screen.Width / 2 - Command1.Width - 450
Command2.Left = Screen.Width / 2 + 450
Label1.Left = (Screen.Width - Label1.Width) / 2
Image1.Left = (Screen.Width - Image1.Width) / 2
End Sub
好了,大体上就是这个样子,具体的美化和功能添加可以再补充咯,写完收工。生成可执行文件,等mm来了发给她~~
专家们推断阿房宫为“烂尾楼”
一个故事的思考
2007-12-16 18:43 | by


