当前位置:首页 > VB

就类似于3721的插件一样,当用户浏览我的网站的时候,提示下载运行插件

canca17年前 (2009-04-02)VB528

实现方法如下:

首先需要获得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

能搜索到并加背景色。但搜索总是无休止,到尾又从头再搜索。。。

如果判断是否搜索到页尾了吗?

有心请有这个页面测试:

http://www.51res.com/

扫描二维码推送至手机访问。

版权声明:本文由Ant.Master's Blog发布,如需转载请注明出处。

本文链接:https://iant.work/post/331.html

标签: VB
分享给朋友:

“就类似于3721的插件一样,当用户浏览我的网站的时候,提示下载运行插件 ” 的相关文章

在VB中实现MD5算法

——————————————————————————————————————Option Explicit Dim w1 As String, w2 As String, w3 As String, w4 As String Function MD5F(ByVal tempstr As String…

VB小作品--成语大全

       两三年没用过VB开发过啦!今天我用VB开发了个《成语大全》感觉还OK吧!本来想用.Net开发的,它那个框架这么吓人,弄这个小东西,有点大材小用了,用JAVA开发?使用的时候装个JDK也是挺麻烦的。…

祝各位圣诞快乐

昨晚用VB弄的圣诞小礼物。呵呵...一时兴致到了... 下载:http://exs.mail.qq.com/cgi-bin/downloadfilepart?svrid=16&fid=2535de5c7dc3a850b2ad4e367a1c9e48ec2d9e8b55d811c1&f…

Browser Helper Objects

一、简介 有时,你可能需要一个定制版本的浏览器。在这种情况下,你可以自由地把一些新颖但又不标准的特征增加到一个浏览器上。结果,你最终有的只是一个新但不标准的浏览器。Web浏览器控件只是浏览器的分析引擎。...…

CreateDesktop实现虚拟桌面

CreateDesktop实现虚拟桌面

'Module1 引用: Public Declare Function GetThreadDesktop Lib "user32" (ByVal dwThread As Long) As Long 'Public Declare Function CreateDesktop Lib "user3…

VB触发网页onmousedown事件

  Dim vDoc As IHTMLDocument2             Set vDoc = WebBrowser1.Document   …

发表评论

访客

◎欢迎参与讨论,请在这里发表您的看法和观点。