浏览器

开发平台：
Visual Basic

mFrmHook.bas：源码内容
							Attribute VB_Name = "mFrmHook"
Option Explicit
'Public mHookAllForms As New Collection
'是否call actFrm.FormActive
Public NOExeActive As Boolean
Private Const GWL_WNDPROC = (-4)
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Private 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
Private Const PROP_PREVPROC = "WinProc"
Private Const PROP_OBJECT = "Object"
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
''return 0:pass the message;other:no pass
'Public Function WindowProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'WindowProc = 0
'End Function
Private Function WindowProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim lPrevProc As Long
Dim oObj As frmBrowser
   
    ' Get the previous window procedure
    lPrevProc = GetProp(hwnd, PROP_PREVPROC)
    
    Select Case wMsg
        Case WM_NCACTIVATE
            If wParam = 1 Then
                If Not NOExeActive Then
                    'Set actFrm = mHookAllForms.Item(Str(hw))
                    Set oObj = PtrToObj(GetProp(hwnd, PROP_OBJECT))
                    Call oObj.FormActive
                End If
            End If
        Case WM_SIZE
            If wParam = SIZE_MAXIMIZED Then
                wParam = 0
            End If
        Case WM_MOUSEACTIVATE
            BringWindowToTop hwnd
    End Select
    
'    If oObj.WindowProc(hwnd, wMsg, wParam, lParam) = 0 Then
        WindowProc = CallWindowProc(lPrevProc, hwnd, wMsg, wParam, lParam)
'    End If
    
End Function
Private Function PtrToObj(ByVal lPtr As Long) As Object
Dim oUnk As Object
   MoveMemory oUnk, lPtr, 4&
   Set PtrToObj = oUnk
   MoveMemory oUnk, 0&, 4&
            
End Function
Public Sub WebformHook(ByVal hwnd As Long, ByVal Obj As frmBrowser)
   ' Set the properties
   SetProp hwnd, PROP_OBJECT, ObjPtr(Obj)
   SetProp hwnd, PROP_PREVPROC, GetWindowLong(hwnd, GWL_WNDPROC)
   
   ' Subclass the windows
   SetWindowLong hwnd, GWL_WNDPROC, AddressOf WindowProc
   
End Sub
Public Sub WebformUnhook(ByVal hwnd As Long)
Dim lProc As Long
   ' Get the window procedure
   lProc = GetProp(hwnd, PROP_PREVPROC)
   
   ' Unsubclass the window
   SetWindowLong hwnd, GWL_WNDPROC, lProc
   
   ' Remove the properties
   RemoveProp hwnd, PROP_OBJECT
   RemoveProp hwnd, PROP_PREVPROC
End Sub
'Public Sub WebformHook(nHwnd As Long, lpPrevProc As Long) '将程序勾入消息环中
'lpPrevProc = SetWindowLong(nHwnd, GWL_WNDPROC, AddressOf WindowProc)
'End Sub
'
'Public Sub WebformUnhook(nHwnd As Long, lpPrevProc As Long)
'Call SetWindowLong(nHwnd, GWL_WNDPROC, lpPrevProc)
'End Sub
'##################################################################
'##################################################################
'Option Explicit
'
'Public mHookAllForms As New Collection
'
''是否call actFrm.FormActive
'Public NOExeActive As Boolean
'
'Private Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'On Error Resume Next
'Dim actFrm As frmBrowser ', dactFrm As frmBrowser
'Dim tc As frmBrowser
'Set tc = mHookAllForms.Item(Str(hw))
'
'Select Case uMsg
'    Case WM_NCACTIVATE
'        'Debug.Print "WM_NCACTIVATE", wParam, lParam, hw
'        If wParam = 1 Then
'            If Not NOExeActive Then
'                Set actFrm = mHookAllForms.Item(Str(hw))
'                Call actFrm.FormActive
''                If actFrm.NoActive Then
''                    actFrm.NoActive = False
''                    'uMsg = 0
''                Else
''                    Call actFrm.FormActive
''                End If
'            End If
'        End If
'    Case WM_SIZE
'        If wParam = SIZE_MAXIMIZED Then
'            'uMsg = 0
'            wParam = 0 ' SIZE_MAXSHOW
'        End If
'
'    'Case WM_MDIACTIVATE
''        If Not NOExeActive Then
''            'Debug.Print "active:"; hw, wParam, lParam
''            Set actFrm = mHookAllForms.item(Str(hw))
''            'Set dactFrm = mHookAllForms.Item(Str(wParam))
''
''            If hw = lParam Then
''                If actFrm.NoActive Then
''                    actFrm.NoActive = False
''                    uMsg = 0
''                Else
''                    Call actFrm.FormActive
''                End If
''            Else
''                'Call dactFrm.OrgWeb(actFrm.webMe)
''            End If
''        End If
'    Case WM_MOUSEACTIVATE
'        'Debug.Print "br"
'        BringWindowToTop hw
'End Select
''If uMsg <> 0 Then Debug.Print hw, Hex(uMsg)
'
'WindowProc = CallWindowProc(tc.lpPrevFormProc, hw, uMsg, wParam, lParam)
'End Function
'
'Public Sub WebformHook(nHwnd As Long, lpPrevProc As Long) '将程序勾入消息环中
'lpPrevProc = SetWindowLong(nHwnd, GWL_WNDPROC, AddressOf WindowProc)
'End Sub
'
'Public Sub WebformUnhook(nHwnd As Long, lpPrevProc As Long)
'Call SetWindowLong(nHwnd, GWL_WNDPROC, lpPrevProc)
'End Sub

						