hook.bas

OpenPlayer代码

Attribute VB_Name = "Hook"
'========================================================
'这个模块配合播放窗口中有关操作,实现swflash.ocx的右键菜单

'=========================================================
'=          Shockwaveflash右键菜单实现的原理:            =
'=========================================================
'这是很多写过Flash播放器的朋友遇到过最为辣手的问题!
'实现的方法可以用回调CallBack(有人说过可以用Hook,我实现不了)拦截系统发给Swflash控件的消息,拦截到的信息我们可以将它
'继续发给Swflash.ocx控件处理,也可以我用自己处理,我们要实现右键菜单,就是要拦截到右键的消息,不让它发给Swflash.ocx处理,
'而是我们自己处理.
'回调要用到如下函数:
'Public 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
'Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
                        (ByVal hwnd As Long, _
                        ByVal nIndex As Long, _
                        ByVal dwNewLong As Long) As Long
'参数:                  hwnd -----------  Long，欲为其取得信息的窗口的句柄
'                       nIndex ---------  Long，请参考GetWindowLong函数的nIndex参数的说明
'                       dwNewLong ------  Long，由nIndex指定的窗口信息的新值
'dwNewLong我们可以用AddressOf WindowProc实现,WindowProc是自己定义的函数,与它的名字无关,但它一定要用以下的格式!
'Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'参数uMsg,wParam,lParam就是我们要的
'具体的实例请结合本模块,
'从函数的原形可以看到,回调要用到一个hwnd的参数,这个参数本来也没什么好讲的,一般的控件都有,遗憾的是我们的Swflash.ocx
'没有为我们提供!那么我们现在就必须把它的hwnd找出来,相信这不是一个难题吧?对API熟悉的朋友可能已经把戏FindWindowEx 的
'声明从雪冰灵的Swinapi里拷出来的:
'Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
                        (ByVal hWnd1 As Long, _
                        ByVal hWnd2 As Long, _
                        ByVal lpsz1 As String, _
                        ByVal lpsz2 As String) As Long
'hWnd1 ----------  Long，在其中查找子的父窗口。如设为零，表示使用桌面窗口
'   （通常说的顶级窗口都被认为是桌面的子窗口，所以也会对它们进行查找）
'hWnd2 ----------  Long，从这个窗口后开始查找。这样便可利用对FindWindowEx的
'   多次调用找到符合条件的所有子窗口。如设为零，表示从第一个子窗口开始搜索
'lpsz1 ----------  String，欲搜索的类名。零表示忽略
'lpsz2 ----------  String，欲搜索的窗口标题。零表示忽略
'返回值就是找到的窗口的hwnd
'那么要我们只要知道Shockwaveflash的类名或窗口标题材就可以了就可以实现实回调了.窗口标题好像没有,类名我们可以......
'(什么?Spy++?别猴精!我可受不了,你应该到http://www.vbeden.com去下一个Hwnd查看器的源代码!不过,如果没有也只能用Spy++,
'谁叫你不"先利其器" ~_~ ),得到的类名可能是:ATL:02F6E668,类名找到了,我们就可以用FindWindowEx找回的我的Shockwaveflash
'Hwnd了.
'       hFlashhwnd = FindWindowEx(Play.hwnd, 0, "ATL:02F6E668", vbNullString)
'钩子的函数已经被"封装"好了,调用
'       MyHook(lFlashhwnd)
'就可以了.注意,退出时一定要要要要要要要UnHook()!否则盖次兄的老毛病又会犯了.
'先保存,一定!先Shift+Ctrl+F9(一定!),按F5试试吧(不要F8不要F8不要F8不要F8...不要...),试试你的右键,是不是看到了我们可爱的中文菜单?
'(什么?你在开香槟庆祝?那你等一就得去跳楼!--没这么严重吧~0~).关掉VB看看,啊,中文菜单不见了,拿到98/Me/2000/XP看看,中文菜单
'到哪里去了?这就是我不懂的也没有办法的难题.你试试打开VB/关闭VB几次,并把Shockwaveflash类名记录下来(当然,你的程序也应该
'打开/关闭),是不是很多次类名都不一样?!@#$%^&*()&^%$%^
'看来FindWindowEx()真是 黔驴技穷了,我们只得另找办法了.
'=======================================================
'        以下两个函数由：
'        制作：王鑫
'        MSN：[e-mail]
'        制作，非常感谢王鑫
'    由于我学VB不久，基础不好，用的方法太笨了
'    我以后一定要学好基础
'=======================================================
'Public Function EnumChildProc(ByVal hwnd As Long, _
                                        ByVal lParam As Long) As Long
'    '这个回调函数通过过滤所有的子窗口的类名，来判断是不是 Flash 控件，
'    '如果 Form 里的控件（子窗口）太多的话一定会影响启动速度的。我发现
'    '这个函数是从 TabIndex 最大的控件开始过滤的，也就是说，如果在设计
'    '窗体界面的时候最后才放置 Flash 控件的话，你就会第一个找到它的句柄
'    '了。而且 Flash 控件的类名会随着它的版本的不同而不同，所以我就用了
'    '一个 Like 语句。
'
'    'If GetClsName(hwnd) = "ATL:100536D0" Then
'    'If GetClsName(hwnd) = "ATL:582236D0" Then
'    If GetClsName(hwnd) Like "ATL:????????" Then
'        hFlashhwnd = hwnd
'        MyHook hFlashhwnd
'        EnumChildProc = 0
'    Else
'        EnumChildProc = 1
'    End If
'End Function
'Public Function GetClsName(ByVal hwnd As Long) As String
'    Dim xLen As Long
'    Dim sBuffer As String
'    sBuffer = String(255, 0)
'    xLen = GetClassName(hwnd, sBuffer, 255)
'    If xLen = 0 Then
'        GetClsName = ""
'    Else
'        GetClsName = Left(sBuffer, xLen)
'    End If
'End Function
'
'我学习VB不久,很多都有不懂,如果您知道更好的实现方法,请指教.
'如果有什么不清楚的地方,欢迎来信:
'[e-mail]
'[e-mail]
'QQ:59219588
'http://OpenPlayer.51.net
'=========================================================

Option Explicit
'==============================
'HOOK 钩！
'回调函数
'==============================
Public 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
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long


Public Const WM_USER = &H400
Public Const WM_LBUTTONUP = &H202

Public Const WM_MBUTTONUP = &H208
Public Const WM_RBUTTONUP = &H205
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_RBUTTONDOWN = &H204
Public Const TRAY_CALLBACK = (WM_USER + 1001&)
Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)

Public lpPrevWndProc As Long
Public lngHWnd As Long


'=============================================
'以下为ShockWaveFlash钩子
'=============================================
Public Sub MyHook(hwnd As Long)
    lngHWnd = hwnd
    lpPrevWndProc = SetWindowLong(lngHWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

'钩 子 函 数 撤 消：
Public Sub UnHook()
    Dim lngReturnValue As Long
    lngReturnValue = SetWindowLong(lngHWnd, GWL_WNDPROC, lpPrevWndProc)
End Sub

Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    '调试
    If uMsg > 500 And uMsg <> 512 Then
        Debug.Print uMsg & "  " & wParam & "    " & lParam
    End If
    
    Select Case uMsg
        ' 检 测 鼠 标 击 键 消 息， 如 果 是 单 击 右 键
        Case WM_RBUTTONDOWN         '右键
            Popupme                 '弹出菜单
        Case 123                    '键盘菜单键
            Popupme                 '弹出菜单
        Case 522                    '滑轮调整播放窗口的大小,滑轮滚动 wParam大于0为下，小于0为向上
            If Play.ShockwaveFlash1.Movie <> "" Then
                If wParam < 0 And (Play.Width < (Screen.Width - 500) And Play.Height < (Screen.Height - 500)) Then
                    Play.Height = Play.Height + 500
                    Play.Width = Play.Width + 500
                Else
                    If Play.Width > 700 And Play.Height > 700 Then
                        Play.Height = Play.Height - 500
                        Play.Width = Play.Width - 500
                    End If
               End If
            End If
       Case WM_LBUTTONDOWN                   '左键鼠标按下
            WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
            '如果没有放大+不是全屏+当鼠标按下移动窗口（选中）
            If Zoom = 0 And (Not isFullScreen) And ControlForm.MCMouseDownMoveForm.Checked Then
                '移动窗口
                ReleaseCapture
                SendMessage Play.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
            End If
            WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
        Case Else
            WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
    End Select
End Function

'================================
'弹出自定义菜单
'================================

Function Popupme()
     '================================
     '初始化菜单
     '================================
      '初始化[放大]
     If Zoom > 6 Then
        ControlForm.ZoomIn.Enabled = False
     Else
        ControlForm.ZoomIn.Enabled = True
     End If
     '初始化[缩小]
     If Zoom = 0 Then
         ControlForm.ZoomOut.Enabled = False
     Else
         ControlForm.ZoomOut.Enabled = True
     End If
      '初始化[全屏]
     If isFullScreen = True Then
        ControlForm.FullScreen.Caption = "返回(&R)"
        ControlForm.FullScreen.Checked = True
     Else
        ControlForm.FullScreen.Caption = "全屏(&F)"
        ControlForm.FullScreen.Checked = False
     End If
     '如果总帧数小于2,隐藏控制菜单项
     If CLng(TotalFrames - 1) < 2 Then
        ControlForm.Control.Visible = False
        ControlForm.s7.Visible = False
        ControlForm.MMouseDownMoveForm.Visible = True
     Else
        ControlForm.Control.Visible = True
        ControlForm.s7.Visible = True
        ControlForm.MMouseDownMoveForm.Visible = False
     End If
           
     '初始化[循环]
     If Play.ShockwaveFlash1.Loop = True Then
        ControlForm.MLoop1.Checked = True
     Else
        ControlForm.MLoop1.Checked = False
     End If
     '初始化[播放]
     If Play.ShockwaveFlash1.Playing = True Then
         ControlForm.pMplay.Caption = "停止(&S)"
     Else
         ControlForm.pMplay.Caption = "播放(&S)"
     End If
     
     Play.PopupMenu ControlForm.PlayPopup  '弹出菜单

End Function

'=======================================================
'        以下两个由：
'        制作：王鑫
'        MSN：[e-mail]
'        制作，非常感谢王鑫
'    由于我学VB不久，基础不好，用的方法太笨了
'    我以后一定要学好基础
'=======================================================

Public Function EnumChildProc(ByVal hwnd As Long, _
                                        ByVal lParam As Long) As Long
    '这个回调函数通过过滤所有的子窗口的类名，来判断是不是 Flash 控件，
    '如果 Form 里的控件（子窗口）太多的话一定会影响启动速度的。我发现
    '这个函数是从 TabIndex 最大的控件开始过滤的，也就是说，如果在设计
    '窗体界面的时候最后才放置 Flash 控件的话，你就会第一个找到它的句柄
    '了。而且 Flash 控件的类名会随着它的版本的不同而不同，所以我就用了
    '一个 Like 语句。

    'If GetClsName(hwnd) = "ATL:100536D0" Then
    'If GetClsName(hwnd) = "ATL:582236D0" Then
    Dim hFlash As String
    hFlash = GetClsName(hwnd)
    If (hFlash Like "ATL:????????") Or (hFlash = "MacromediaFlashPlayerActiveX") Then
        hFlashhwnd = hwnd
        MyHook hFlashhwnd
        EnumChildProc = 0
    Else
        EnumChildProc = 1
    End If
End Function
Public Function GetClsName(ByVal hwnd As Long) As String
    Dim xLen As Long
    Dim sBuffer As String
    sBuffer = String(255, 0)
    xLen = GetClassName(hwnd, sBuffer, 255)
    If xLen = 0 Then
        GetClsName = ""
    Else
        GetClsName = Left(sBuffer, xLen)
    End If
End Function