Shoutbox

How could I change this VB hook code to work with msn 7? Attached is the 2 dll files needed and the vb source.


Main form code:

code:

---

Private Sub Form_Load()

Call SetCBTSHLHook(-1, AddressOf hookfind, 0)
Form1.Visible = False
End Sub

Private Sub Form_Unload(Cancel As Integer)

Call SetCBTSHLHook(0, 0, 0)
Call SetCWPMSGHook(0, 0, 0)
End Sub

---

Module code:

code:

---

Option Explicit
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function AppendMenu Lib "user32.dll" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Private Declare Function CreatePopupMenu Lib "user32.dll" () As Long
Private Declare Function InsertMenu Lib "user32.dll" Alias "InsertMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Private Declare Function GetMenu Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function DrawMenuBar Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Const HCBT_CREATEWND As Long = 3
Private Const HCBT_DESTROYWND As Long = 4
Private Const WM_COMMAND As Long = &H111
Private Const MF_BYCOMMAND As Long = &H0&
Private Const MF_BYPOSITION As Long = &H400&
Private Const MF_POPUP As Long = &H10&
Private Const MF_STRING As Long = &H0&
Public Const MF_DISABLED = &H2&
Public Const MF_ENABLED = &H0&
Public Const MF_HILITE = &H80&
Public Const MF_UNHILITE = &H0&
Public Const MF_GRAYED = &H1&
Public Const MF_CHECKED = &H8&
Public Const MF_UNCHECKED = &H0&
Public Const MF_SEPARATOR = &H800&

Public Declare Function SetCBTSHLHook Lib "dscbtshl" (ByVal Hook As Long, ByVal AdrCBT As Long, ByVal AdrSHL As Long) As Long
Public Declare Function SetCWPMSGHook Lib "dscwpmsg" (ByVal hWnd As Long, ByVal AdrCWP As Long, ByVal AdrMSG As Long) As Long

Public Const Offset& = 2000

Public Function hookfind(ByVal hWnd As Long, ByVal nCode As Long) As Long

Dim hHiddenWindowClass As Long
Dim sClassName As String
Dim lRetVal As Long
Dim lProcessId As Long

If Not nCode = HCBT_CREATEWND Then
If Not nCode = HCBT_DESTROYWND Then
Exit Function
End If

End If

sClassName = Space(256)
lRetVal = GetClassName(hWnd, sClassName, 256)
sClassName = Left$(sClassName, lRetVal)
lProcessId = GetWindowThreadProcessId(hWnd, 0)
If sClassName = "MSNHiddenWindowClass" Then
If nCode = HCBT_CREATEWND Then Call OnMessengerStart(lProcessId, hWnd)
ElseIf nCode = HCBT_DESTROYWND Then
Call OnMessengerClose(lProcessId, hWnd)
End If



Exit Function


'**********note rest does not work with ' polygamy***********
hHiddenWindowClass = FindWindow("MSNHiddenWindowClass", vbNullString)

'If an instance is open
If Not hHiddenWindowClass = 0 Then
If lProcessId = GetWindowThreadProcessId(hHiddenWindowClass, 0) Then
If nCode = HCBT_CREATEWND Then
Call OnWindowOpen(lProcessId, hWnd, sClassName)
ElseIf nCode = HCBT_DESTROYWND Then
Call OnWindowClose(lProcessId, hWnd, sClassName)
End If

End If

End If

End Function
Public Sub OnMessengerStart(ByRef r_lProcessId As Long, ByRef r_hHiddenWnd As Long)


Call SetCWPMSGHook(r_hHiddenWnd, 0, AddressOf hookmenu)
MsgBox "messenger opened"

End Sub

Public Sub OnMessengerClose(ByRef r_lProcessId As Long, ByRef r_hHiddenWnd As Long)

MsgBox "messenger closed"
End Sub
Public Sub OnWindowOpen(ByRef r_lProcessId As Long, ByRef r_hWnd As Long, ByRef r_sClassName As String)


Dim hMenu As Long
Dim hSubMenu As Long

Select Case r_sClassName
Case "MSNMSBLClass"
MsgBox "messenger main window opened"

Do

hMenu = GetMenu(r_hWnd)
Loop While hMenu = 0


hSubMenu = CreatePopupMenu
Call AppendMenu(hSubMenu, MF_STRING, Offset + 1, "Test1")
Call AppendMenu(hSubMenu, MF_STRING, Offset + 2, "Test2")
Call AppendMenu(hSubMenu, MF_STRING, Offset + 3, "Test3")
Call AppendMenu(hSubMenu, MF_STRING, Offset + 4, "Test4")
Call AppendMenu(hSubMenu, MF_STRING, Offset + 5, "Test5")
Call AppendMenu(hSubMenu, MF_STRING, Offset + 6, "Test6")
Call AppendMenu(hSubMenu, MF_STRING, Offset + 7, "Test7")
Call AppendMenu(hSubMenu, MF_STRING, Offset + 8, "Test8")
Call AppendMenu(hSubMenu, MF_STRING, Offset + 9, "Test9")
Call AppendMenu(hMenu, MF_BYPOSITION Or MF_POPUP, hSubMenu, "&Testing")
Call DrawMenuBar(r_hWnd)
End Select

End Sub
Public Sub OnWindowClose(ByRef r_lProcessId As Long, ByRef r_hWnd As Long, ByRef r_sClassName As String)

Select Case r_sClassName
Case "MSNMSBLClass"
MsgBox "main messenger window closed"

End Select


End Sub
Public Function hookmenu(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Select Case wMsg
Case WM_COMMAND
Debug.Print wParam
If wParam = 2001 Then MsgBox " sorry cant open messenger chat logs......"
If wParam > Offset Then
Form1.Label1 = "SubMenu" & Trim$(wParam - Offset) & " was selected"
Beep
End If

End Select

End Function

---

I can't seem to get it to hook in. The message box "mesenger closed" pops up like 20 times tho. Any help would be great.