就類似於3721的插件壹樣,當用戶瀏覽我的網站的時候,提示下載運行插件?
A:
實現方法如下：
首先需要獲得IObjectWithSite接口的定義，妳下載個olelib.tlb,包含了接口定義。然後創建壹個ActiveX DLL工程，
在工程中引用這個tlb文件，並且引用Microsoft HTML Object Library（MSHTML.DLL）和mcrosoft Internet Controls（Shdocvw.dll）。
然後在工程的class1中寫入如下代碼：
‘Class1.bas
Option Explicit
' 實現IObjectWithSite接口來獲得IE對象
Implements olelib.IObjectWithSite
Private WithEvents m_objIE As InternetExplorer
Private Sub IObjectWithSite_GetSite(riid As UUID, ppvSite As IUnknown)
Dim objUnk As olelib.IUnknown
'獲得m_objIE IUnkown接口
Set objUnk = m_objIE
'返回所需要的接口
objUnk.QueryInterface riid, ppvSite
End Sub
Private Sub IObjectWithSite_SetSite(ByVal pUnkSite As IUnknown)
'獲得IE接口
Set m_objIE = pUnkSite
End Sub
'編寫m_objIE事件處理程式
' .
' .
' .
' .
將這個工程編譯為：prjBHO.dll。編譯工程後，可以通過調用regsvr32 prjBHO.dll註冊這個組件，組件註冊了以後，就會在註冊表HKEY_CLASSES_ROOT\CLSID中註冊組件的GUID。在註冊表中用prjBHO.dll做關鍵字就可以查找到prjBHO.dll註冊的GUID，然後將這個GUID拷貝下來，然後在註冊表HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects下創建壹個新項，項的名稱就是這個GUID。
搜索關鍵字並突出顯示：
Private Sub m_objIE_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
Dim webdoc As HTMLDocument
Dim texbody As HTMLBody
Dim Rng As IHTMLTxtRange
Dim I As Byte
On Error Resume Next
Set webdoc = m_objIE.document
Set texbody = webdoc.body
Set Rng = texbody.createTextRange()
Do
If Rng.findText("言情") = False Then Exit Do
Rng.Select
'用IHTMLTxtRange的execCommand方法可以實現加粗等功能，如：
Rng.execCommand "bold"
Rng.execCommand "BackColor", True, "#FFbbDD"
Rng.collapse False
Loop
Rng.collapse True
End Sub
能搜索到並加背景色。但搜索總是無休止，到尾又從頭再搜索。。。
如果判斷是否搜索到頁尾了嗎？
Option Explicit
Public StartingAddress As String
Dim mbDontNavigateNow As Boolean
Private Sub Form_Load()
On Error Resume Next
Me.Show
tbToolBar.Refresh
Form_Resize
cboAddress.Move 50, lblAddress.Top + lblAddress.Height + 15
If Len(StartingAddress) > 0 Then
cboAddress.Text = StartingAddress
cboAddress.AddItem cboAddress.Text
'試圖對啟動地址進行瀏覽
timTimer.Enabled = True
brwWebBrowser.Navigate StartingAddress
End If
End Sub
Private Sub brwWebBrowser_DownloadComplete()
On Error Resume Next
Me.Caption = brwWebBrowser.LocationName
End Sub
Private Sub brwWebBrowser_NavigateComplete(ByVal URL As String)
Dim i As Integer
Dim bFound As Boolean
Me.Caption = brwWebBrowser.LocationName
For i = 0 To cboAddress.ListCount - 1
If cboAddress.List(i) = brwWebBrowser.LocationURL Then
bFound = True
Exit For
End If
Next i
mbDontNavigateNow = True
If bFound Then
cboAddress.RemoveItem i
End If
cboAddress.AddItem brwWebBrowser.LocationURL, 0
cboAddress.ListIndex = 0
mbDontNavigateNow = False
End Sub
Private Sub cboAddress_Click()
If mbDontNavigateNow Then Exit Sub
timTimer.Enabled = True
brwWebBrowser.Navigate cboAddress.Text
End Sub
Private Sub cboAddress_KeyPress(KeyAscii As Integer)
On Error Resume Next
If KeyAscii = vbKeyReturn Then
cboAddress_Click
End If
End Sub
Private Sub Form_Resize()
cboAddress.Width = Me.ScaleWidth - 100
brwWebBrowser.Width = Me.ScaleWidth - 100
brwWebBrowser.Height = Me.ScaleHeight - (picAddress.Top + picAddress.Height) - 100
End Sub
Private Sub timTimer_Timer()
If brwWebBrowser.Busy = False Then
timTimer.Enabled = False
Me.Caption = brwWebBrowser.LocationName
Else
Me.Caption = "正在工作..."
End If
End Sub
Private Sub tbToolBar_ButtonClick(ByVal Button As Button)
On Error Resume Next
timTimer.Enabled = True
Select Case Button.Key
Case "Back"
brwWebBrowser.GoBack
Case "Forward"
brwWebBrowser.GoForward
Case "Refresh"
brwWebBrowser.Refresh
Case "Home"
brwWebBrowser.GoHome
Case "Search"
brwWebBrowser.GoSearch
Case "Stop"
timTimer.Enabled = False
brwWebBrowser.Stop
Me.Caption = brwWebBrowser.LocationName
End Select
End Sub