module1.bas

baidu_IM源程序,解压后就可以看到。自己还没有试过,不过貌似很不错的

Attribute VB_Name = "Module1"
Option Explicit

Declare Function timeGetTime Lib "winmm.dll" () As Long

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
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
Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long) As Long

Public Const WM_HOTKEY = &H312
Public Const MOD_ALT = &H1
Public Const MOD_CONTROL = &H2
Public Const MOD_SHIFT = &H4
Public Const GWL_WNDPROC = (-4)


Public Logout As Long
Public OnLine As Boolean '用户是否成功登录
Public tmpCookie As String '保存用户COOKIE
Public NextInet As Long 'INET控件索引指针
Public InetErrTime As Long 'INET请求错误数

Public MsgList0() As String '信息列表,用户名
Public MsgList1() As Long '信息列表,信息数

Public MsgListTime() As String '每条信息的时间
Public MsgListUser() As String '每条信息的发信人
Public MsgListId() As Long '每条信息的记录号
Public MsgListTxt() As String '每条信息的内容
Public MsgListRead() As Boolean
Public MsgListDel() As Boolean
Public MsgListRid() As Long '信息分组

Public GroupMsg() As String
Public GroupRoom() As String

Public InetListTxt() As String 'Inet返回的信息
Public InetListUrl() As String 'INET请求的URL
Public InetListPost() As String 'INET请求的POST
Public InetListHead() As String 'INET请求的COOKIE
Public InetListCmd() As String 'INET请求的命令
Public InetListTmp() As Long  'Inet TMPdata

Public menuKey As Long
Public soundKey As Long
Public musicKey As Long


Public preWinProc As Long
Public Modifiers As Long, uVirtKey1 As Long, idHotKey As Long

Private Type taLong
ll As Long
End Type

Private Type t2Int
lWord As Integer
hword As Integer
End Type

Public Function wndproc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim lp As taLong, i2 As t2Int

If Msg = WM_HOTKEY Then
If wParam = idHotKey Then
lp.ll = lParam
LSet i2 = lp
If (i2.lWord = Modifiers) And i2.hword = uVirtKey1 Then
'Form1.Visible = Not Form1.Visible
    frmMain.WindowState = 0
    frmMain.Show
End If
End If
End If
'如果不是热键信息则调用原来的程序
wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
End Function