利用WebBorwser和MSHTML.tlb做广告过滤器完全源码公开

程序组成:

两个引用对象:Microsoft HTML Object Library,Microsoft Internet Object

两个窗体: frmAbout.frm frmMenu.frm

两个*.bas: APIs.bas,mSysTray.bas

两个Class: MyIE.cls, windows.cls(其中windows.cls是collection对象的扩展,放MyIE.cls)

下面公开这两个主要类的代码(如要全部代码请留email,要看演示上www.jjsoft.cn,版权归作者,要用于商业目的请和作者联系fazhu@163.net)

myIE.cls

------------------------------------------------------------------------------------------------------

Option Explicit


Private WithEvents mIE As SHDocVw.InternetExplorer
Private WithEvents IE_IFrame As MSHTML.HTMLIFrame
Private WithEvents win2 As MSHTML.HTMLWindow2
Private WithEvents doc2 As MSHTML.HTMLDocument

''///////////////////////////////////////////////////////
''判断Frame对象
Private tmpIE_IFrame As MSHTML.HTMLIFrame
Private IE_FCols As MSHTML.FramesCollection
''///////////////////////////////////////////////////////

Private body As MSHTML.HTMLBody
Private IElements As MSHTML.IHTMLElement
Private mHWnd As Long
Private mDoc As MSHTML.IHTMLDocument2
Private isLoaded As Integer
Private isClicked As Integer
Private isCleaned As Integer
Private tmpState As String

Private Const FlashClassID As String = "CLSID:D27CDB6E-AE6D-11CF-96B8-444553540000"

''determine the refresh button is clicked
''Private m_nPageCounter As Integer
''Private m_nObjCounter As Integer
Private m_bIsRefresh As Boolean
Private mSArrays As Variant
Private mPtr As POINTAPI
''//////////////////////////////////////////

Public Function Banding(item As SHDocVw.InternetExplorer) As SHDocVw.InternetExplorer
    On Error GoTo Err
    Dim tmpName As String, tmpie As SHDocVw.InternetExplorer
    ''Dim tmpdoc As MSHTML.HTMLDocument
    Set tmpie = item
    If (tmpie Is Nothing) Then Exit Function
    If Not (TypeOf item Is IWebBrowser2) Then Exit Function
            
    tmpName = tmpie.FullName
    tmpName = Mid(tmpName, InStrRev(tmpName, "\") + 1)
    If UCase(tmpName) = "IEXPLORE.EXE" Then
        Set mIE = tmpie
        mHWnd = mIE.hwnd
       '' Call BandingDoc(mIE2)
    End If
    tmpName = ""
    Set tmpie = Nothing
    Set Banding = mIE

Bye:
    
    If Not (tmpie Is Nothing) Then Set tmpie = Nothing
    Exit Function
Err:
    MsgBox "Error:" & Err.Description & " in Banding"
    Resume Bye
End Function

Public Property Get IEHandle() As Long
    IEHandle = mHWnd
End Property

Private Sub Class_Initialize()

    m_bIsRefresh = Tru