http://www.xsal.net/index.php zh-cn http://www.xsal.net/read.php/483.htm 鬼谷军师 <cntale@gmail.com> Sun, 16 Dec 2007 10:43:33 +0000 http://www.xsal.net/read.php/483.htm 程序要实现的功能就是点击“喜欢”弹出对话框：“嘿嘿，你说喜欢俺咯，啦啦啦~~”；如果要点“不喜欢”的话，那个按钮会跑一边儿去，让你点不到。同样，程序屏蔽了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来了发给她~~ ]]> http://www.xsal.net/read.php/483.htm#blogcomment53353 婉婉 <user@domain.com> Tue, 18 Dec 2007 03:34:50 +0000 http://www.xsal.net/read.php/483.htm#blogcomment53353
这个小东东还算好玩，不过够损滴，看在你忙了一天的份上，我还是要奖励你一朵大红花 ]]>