VB添加IE右键菜单等

/--------------------------------------------------
'***************************************
'IE工具栏按钮和IE右键菜单(VB6)
'Autor:wgscd
'mail: wgscd@126.com
'Date:2007/09
'***************************************
Option Explicit

'HKEY_CURRENT_USER/Software/Microsoft/Internet Explorer/Extensions/'IE工具栏按钮
'HKEY_CURRENT_USER/Software/Microsoft/Internet Explorer/MenuExt/IE右键菜单标题

 'Default Property Values
'Property Variables
'定义常量
Const HKEY_LOCAL_MACHINE = &H80000002

Const HKEY_CURRENT_USER = &H80000001

Const REG_SZ = 1
Const REG_DWORD = 4

Const Guid = "{6E8C5846-BCFD-4DB7-A130-94E84A92B30B}" '找个唯一的GUID

'声明存取注册表的 API 函数
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegCreateKey_DWORD Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
'定义注册表中的主键、子键
'Const hKey = HKEY_LOCAL_MACHINE '或者HKEY_CURRENT_USER
Const hKey = HKEY_CURRENT_USER

Const subKey0 = "Software/Microsoft/Internet Explorer/Extensions/"
Const subkey1 = "Software/Microsoft/Internet Explorer/MenuExt/"

'把字符串值存入注册表
Private Sub SaveString(hKey As Long, strPath As String, strValue As String, strdata As String)
Dim keyhand As Long
Dim r As Long
r = RegCreateKey(hKey, strPath, keyhand)
r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))
r = RegCloseKey(keyhand)
End Sub
'从注册表中删除字符串值
Private Function DeleteValue(ByVal hKey As Long, ByVal strPath As String, ByVal strValue As String)
Dim r, keyhand As Long
r = RegOpenKey(hKey, strPath, keyhand)
r = RegDeleteValue(keyhand, strValue)
r = RegCloseKey(keyhand)
End Function
'把设置写入注册表,定义按钮
Public Sub AddBtn2IEtoolbar()
Dim subKey As String
subKey = subKey0 & Trim(Guid) & "/"
Call SaveString(hKey, subKey, "ButtonText", "ButtonText")
Call SaveString(hKey, subKey, "CLSID", "{1FBA04EE-3024-11D2-8F1F-0000F87ABD16}")
Call SaveString(hKey, subKey, "Default Visible", "Yes")
Call SaveString(hKey, subKey, "Exec", "Exec")
Call SaveString(hKey, subKey, "HotIcon", "C:/GetFLV.ico")
Call SaveString(hKey, subKey, "Icon", "C:/GetFLV.ico")
Call SaveString(hKey, subKey, "MenuStatusBar", "MenuStatusBar")
Call SaveString(hKey, subKey, "MenuText", "MenuText")
End Sub
'添加IE右键菜单：HKEY_CURRENT_USER/Software/Microsoft/Internet Explorer/MenuExt/IE右键菜单标题
Public Sub AddIEContentMenu()
Dim subKey As String
subKey = subkey1
'Call SaveString(hKey, subKey & "/wgscdUE右键菜单", "Contexts", "67867867")

Dim lReturn As Long '储存返回值以判断是否成功
Dim hhKey As Long '储存该键句柄

'打开键(此处用RegCreateKey而不用RegOpenKey是因为若键存在,则两者效果相同;若不存在,则前者创建该键,后者报错)
lReturn = RegCreateKey(hKey, subKey & "/wgscdIE右键菜单", hhKey)
Dim strPath As String
strPath = "C:/wgscd.html"
lReturn = RegSetValueEx(hhKey, "", 0, REG_SZ, ByVal strPath, Len(strPath))  '设置默认值
If lReturn = 0 Then
'检测是否为成功(0)

'此处设置键值.设置DWORD时第五个参数为欲修改成的值(Long),最后一个参数总设为4

'------------------------------
lReturn = RegSetValueEx(hhKey, "Contexts", 0, REG_DWORD, CLng("&H" + "22"), 4) '创建DWORD键值,注意DWORD是用16进制表示的，故这里的22要转换

'lReturn = RegSetValueEx(hhKey, "wgscd", 0, REG_DWORD, CLng("&H" + "10"), 4)

 

'检测是否失败
If lReturn <> 0 Then MsgBox "失败"
Else
MsgBox "失败"
End If

 

End Sub

'从注册表中删除自定义按钮
Public Sub DelBtnFromIEtoolbar()
Dim subKey As String
subKey = subKey0 & Trim(Guid) & "/"
Call DeleteValue(hKey, subKey, "ButtonText")
Call DeleteValue(hKey, subKey, "CLSID")
Call DeleteValue(hKey, subKey, "Default Visible")
Call DeleteValue(hKey, subKey, "Exec")
Call DeleteValue(hKey, subKey, "HotIcon")
Call DeleteValue(hKey, subKey, "Icon")
Call DeleteValue(hKey, subKey, "MenuStatusBar")
Call DeleteValue(hKey, subKey, "MenuText")

'从注册表中删除自定义IE右键菜单

subKey = subkey1 & "/wgscdIE右键菜单/"
Call DeleteValue(hKey, subKey, "")
Call DeleteValue(hKey, subKey, "Contexts")

 

End Sub
'初始化控件属性

Private Sub Command1_Click()
AddBtn2IEtoolbar '

AddIEContentMenu

End Sub

Private Sub Command2_Click()

DelBtnFromIEtoolbar

End Sub
/------------------------------------------------

/--------------------------------------------------
'***************************************
'获取当前IE地址栏URL(VB.NET)
'Autor:wgscd
'mail:wgscd@126.com
'Date:2007/09
'***************************************
Friend Class Form1
 Inherits System.Windows.Forms.Form
 
 Private Declare Function FindWindow Lib "user32"  Alias "FindWindowA"(ByVal lpClassName As String, ByVal lpWindowName As String) As Integer 'Findwindow函数的功能是找到当前运行的IE窗口的url地址的句柄
 
 
 Private Declare Function FindWindowEx Lib "user32"  Alias "FindWindowExA"(ByVal hWnd1 As Integer, ByVal hWnd2 As Integer, ByVal lpsz1 As String, ByVal lpsz2 As String) As Integer 'FindwindowEx函数的功能是找到子窗体的句柄
 
 
 Private Declare Function SendMessageByString Lib "user32"  Alias "SendMessageA"(ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As String) As Integer
 
 
 Private Const WM_GETTEXT As Short = &HDs
 
 
 Private Sub Command1_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command1.Click
  
        getcurrenturl()

  
 End Sub
 
    Sub getcurrenturl(Optional ByRef URL As String = "")

        Dim hwnd As Integer '设定一个长整形变量用来接收函数返回值

        hwnd = 0 '初始化

        hwnd = FindWindowEx(hwnd, 0, "IEFrame", vbNullString) 'IE窗口句柄

        hwnd = FindWindowEx(hwnd, 0, "Workerw", vbNullString) 'IE窗口的工作区句柄

        hwnd = FindWindowEx(hwnd, 0, "ReBarWindow32", vbNullString) 'IE窗口的菜单栏句柄

        hwnd = FindWindowEx(hwnd, 0, "ComboBoxEx32", vbNullString) 'IE窗口下拉菜单句柄

        hwnd = FindWindowEx(hwnd, 0, "ComboBox", vbNullString) 'IE窗口下拉菜单当前项句柄

        hwnd = FindWindowEx(hwnd, 0, "Edit", vbNullString) ''IE窗口下拉菜单编辑框句柄

        URL = New String(Chr(0), 1024) '初始化字符串

        Dim s As Integer

        'UPGRADE_WARNING: 未能解析对象 s 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"”
        s = SendMessageByString(hwnd, WM_GETTEXT, 1025, URL) '向系统发送获得IE窗体地址栏中的字符串命令

        URL = Split(URL, Chr(0))(0) '根据 URL 长度得到 URL 值

        MsgBox(URL) '显示IE当前网址

    End Sub
End Class
/-------------------------------------------------

 

==================================================================================

/------------------------------------------------------
关于添加IE工具栏按扭和IE右键菜单，以下是转贴网上的一些资料！

如何添加IE右键菜单2007-09-19 04:00Windows Registry Editor Version 5.00

[HKEY_CURRENT_USER/Software/Microsoft/Internet Explorer/MenuExt]
@="C://Program Files//Tencent//qq//SendMMS.htm"
"contexts"=dword:00000002

[HKEY_CURRENT_USER/Software/Microsoft/Internet Explorer/MenuExt/&使用迅雷下载]
@="C://Program Files//Sandai Technologies Inc//Thunder//geturl.htm"
"Contexts"=dword:00000022

[HKEY_CURRENT_USER/Software/Microsoft/Internet Explorer/MenuExt/导出到 Microsoft Office Excel(&X)]
@="res://C://PROGRA~1//MICROS~1//OFFICE11//EXCEL.EXE/3000"
"Contexts"=dword:00000001

[HKEY_CURRENT_USER/Software/Microsoft/Internet Explorer/MenuExt/导出当前页到超星阅览器(&A)]
@="C://Program Files//SSREADER36//ss_all.htm"

[HKEY_CURRENT_USER/Software/Microsoft/Internet Explorer/MenuExt/导出选中部分到超星阅览器(&S)]
@="C://Program Files//SSREADER36//ss_select.htm"

[HKEY_CURRENT_USER/Software/Microsoft/Internet Explorer/MenuExt/添加到QQ自定义面板]
@="C://Program Files//Tencent//qq//AddPanel.htm"
"contexts"=dword:0000007f

[HKEY_CURRENT_USER/Software/Microsoft/Internet Explorer/MenuExt/添加到QQ表情]
@="C://Program Files//Tencent//qq//AddEmotion.htm"
"contexts"=dword:00000002

[HKEY_CURRENT_USER/Software/Microsoft/Internet Explorer/MenuExt/用QQ彩信发送该图片]
@="C://Program Files//Tencent//qq//SendMMS.htm"
"contexts"=dword:00000002

这是从注册表导出的reg文件,可以发现ie的右键菜单都是通过编辑注册表实现的,当点击菜单项时浏览器会执行相应的URL.

<script language="VBScript">

Sub AddPanel(strUrl, strName)
On Error Resume Next
set cpAdder = CreateObject("QQCPHelper.CPAdder")
if 0 = err then
call cpAdder.AddCustomPanel(strUrl, strName)
end if
end sub

Sub OnContextMenu()
set srcEvent = external.menuArguments.event
set EventElement = external.menuArguments.document.elementFromPoint(srcEvent.clientX, srcEvent.clientY)

if "MenuExtAnchor" = srcEvent.type then
set srcAnchor = EventElement
do until "HTMLAnchorElement" = TypeName(srcAnchor)
set srcAnchor = srcAnchor.parentElement
Loop
Call AddPanel(srcAnchor.href, srcAnchor.innerText)

elseif "MenuExtImage" = srcEvent.type then
if "HTMLAreaElement" = TypeName(EventElement) then
Call AddPanel(EventElement.href, EventElement.Alt)
else
set srcElement = EventElement
set srcAnchor = srcElement.parentElement
do until "HTMLAnchorElement" = TypeName(srcAnchor)
set srcAnchor = srcAnchor.parentElement
if "Nothing" = TypeName(srcAnchor) then
call AddPanel(srcElement.href, srcElement.Alt)
exit sub
end if
Loop
Call AddPanel(srcAnchor.href, srcElement.Alt)
end if

elseif "MenuExtUnknown" = srcEvent.type then
set srcAnchor = EventElement
do until "HTMLAnchorElement" = TypeName(srcAnchor)
set srcAnchor = srcAnchor.parentElement
if "Nothing" = TypeName(srcAnchor) then
'Call AddPanel(EventElement.href, EventElement.innerText)
set srcDoc = external.menuArguments.document
Call AddPanel(srcDoc.URL, srcDoc.title)
exit sub
end if
Loop

Call AddPanel(srcAnchor.href, srcAnchor.innerText)

else
set srcDoc = external.menuArguments.document
Call AddPanel(srcDoc.URL, srcDoc.title)

end if
end sub

call OnContextMenu()

</script>

这是qq自定义面板的HTML文件,这里通过VBScript脚本调用本地的二进制对象来实现本地调用.还可以通过提交表单来实现与web service的互动.
下面转载篇用VB来写OLE的文章:
要实现在IE右键菜单中添加菜单项的功能，要依次实现以下步骤：

1、在注册表HKEY_CURRENT_USER/Software/Microsoft/Internet
　　Explorer/MenuExt项下建立一个新项，项的名称既出现在菜单中的标题，例如你想建立的菜单项标题为Add　URL，则新建项的名称为HKEY_CURRENT_USER/Software/Microsoft/Internet
　　Explorer/MenuExt/Add URL
　　2、将新建项的默认值设定为一个URL地址，当用户点击菜单项后，IE就会调用URL指向的页面中的脚本，在目标页面的脚本中通过访问IE提供的external对象的menuArguments属性就可以访问IE中的页面中的各种对象，例如链接、图片、表单域、被选中的文本等。详细的帮助请参考MSDN中关于InternetExplore object的帮助，熟悉了Window对象才可以比较好的了解下面的脚本。
　　对于如何实现自身的程序访问menuArguments的问题，我们可以仿效Netants的做法，首先建立一个OLE Automation对象，然后在脚本中调用该对象，并将页面信息传递对象处理。下面我们需要首先通过VB建立一个对象：
　　打开VB，点击菜单：File New，在新建工程窗口中选择ActiveX Dll后按确定键建立一个ActiveX
　　DLL工程。然后在工程列表窗口中将Class1的Name属性更改为NetAPI，然后在NetAPI的代码窗口中添加如下代码：
Public
　　Sub AddURL(URL As String, Info As String) MsgBox Info,
　　vbOKOnly, URLEnd Sub 保存文件，将工程文件保存成NetSamp.vbp。然后在菜单中选择
　　File Make NetSamp.dll建立对象动态连接库。
　　接下来是注册库，在Windows目录下找到Regsvr32.exe，然后将其拷贝到netsamp.dll所在目录下，将netsamp.dll的的图标拖到Regsvr32.exe上放开，这时Regsvr32.exe就会弹出对话框提示对象注册成功。
　　打开UltraEdit(或者其它文本编辑器)将下面的脚本代码输入编辑器中：
将文件保存到c:/program files下，文件名为geturl.htm 从上面的脚本可以看到，首先访问external.menuArguments属性，获得用户单击鼠标右键位置的对象，然后根? 象的不同获得它的URL，然后建立IEContextMenu.IEMenu1对象并调用该对象的AddURL方法。
　　接下来是为右键菜单建立注册项，打开UltraEdit(或者其它文本编辑器)将下面的注册数据输入编辑器中Windows Registry Editor Version 5.00
　　
　　[HKEY_CURRENT_USER/Software/Microsoft/Internet
　　Explorer/MenuExt/&Get URL]@="c://program
　　files//geturl.htm""Contexts"=dword:00000022
　　将文件以reg为后缀保存，然后在Windows资源管理器中双击该文件将注册项添加到注册表中，然后打开IE，右键点击一个连接或者图片，在弹出菜单中会出现一个Get URL项，点击该项，就会出现一个消息框显示点击的连接或者图片的URL地址 下面再介绍一下上面注册项中Contexts项的作用，通过该项可以制定菜单项在右键点击IE中的什么对象时出现，它可以为以下值的“或”组合：对象值　缺省 0x1 图片 0x2 控件
　　0x4 表单域 0x8 选择文本 0x10 锚点 0x20 例如上面我们希望菜单项在用户点击图片或者超链接时出现，那么我们就将值设置为dword:00000022，既在点击图片或者锚点时出现菜单。一个锚点是页面中描述一个超链接的对象。如果不设置Contexts项，则菜单项会在点击任何对象时出现在右键菜单中。
　　通过上面的程序介绍我们可以看到IE鼠标右键菜单的工作过程。前面讲了，Netants就是使用这样的方法通过在脚本中建立对象来实现调用NetAnts的，那么我们如果安装了NetAnts，就可以在程序中通过调用NetAnts对象来调用NetAnts。
　　建立一个新工程，点击菜单Projects References项，选择其中的AntAPI 1.0 Type Library 项，如果没有点击Browser按钮，在文件列表框中选择网络蚂蚁目录下的NetAPI.dll后按打开键。在Form1中添加一个CommandButton按钮，在Command1_Click事件中添加如下代码：
　　
　　Dim ant As New ANTAPILib.AntAPIObj
　　ant.AddUrl "http://www.applevb.com/z.zip", "", "http://www.applevb.com/" 点击command1，然后NetAnts就会运行并且将http://www.applevb.com/z.zip添加到任务中。
二、如何添加任务栏按钮 基本上来说，添加任务栏按钮只需要修改注册表就可以实现。通过修改注册表来实现添加按钮的步骤如下：
　　
1、建立一个GUID。
2、打开注册表编辑器，转到HKEY_LOCAL_MACHINE/Software/Microsoft/Internet Explorer/Extensions部分，在其下添加一个新的项，名称为，Your GUID为你刚建立的GUID。
3、在注册表的HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/InternetExplorer/Extensions/ GUID$#@62;下建立一个新的String类型的值，名称为HotIcon，该值定义当按钮具有热点时的图标，它的一般类型为：包含图标的文件全路径名,图标索引，例如：C:/PROGRA~1/KINGSOFT/XDICT/ieplugin.DLL,208
4、在注册表的　HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/InternetExplorer/Extensions/ GUID$#@62;下建立一个新的String类型的值，名称为Icon，该值定义当按钮的图标，它的一般类型为：
　　图标文件全路径名,图标索引
5、在注册表的HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Internet Explorer/Extensions/ GUID$#@62;下建立一个新的String类型的值，名称为ButtonText，该值定义按钮的ToolTip文本。
6、在注册表的
　　HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Internet Explorer/Extensions/ GUID$#@62;下建立一个新的String类型的值，名称为Default Visible，该值定义按钮是否可见，如果是，则该值设定为"Yes"，否则设定为"No"。
7、在注册表的
　　HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Internet Explorer/Extensions/ GUID$#@62;下建立一个新的String类型的值，名称为Clsid，将该值设定为{1FBA04EE-3024-11D2-8F1F-0000F87ABD16}
8、在注册表的HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Internet Explorer/Extensions/ GUID$#@62;下建立一个新的String类型的值，名称为Exec，该值定义点击按钮后运行的文件的全路径名称，例如:c:/program files/samples/net.exe
　　例如NetAnts的按钮注册表项的内容就是象下面这样：
　　
　　Windows Registry Editor Version 5.00
　　
　　[HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Internet
　　Explorer/Extensions/{57E91B47-F40A-11D1-B792-444553540000}]"CLSID"="{1FBA04EE-3024-11D2-8F1F-0000F87ABD16}""Default Visible"="Yes""HotIcon"="C://PROGRA~1//NETANTS//NetAnts.exe,1001""Icon"="C://PROGRA~1//NETANTS//NetAnts.exe,1000""Exec"="C://PROGRA~1//NETANTS//NetAnts.exe""ButtonText"="NetAnts""MenuText"="&NetAnts""MenuStatusBar"="Launch NetAnts"
　　当点击NetAnts按钮时就会运行Netants。上面的注册表项中下面的两项：MenuText项添加一个菜单项到菜单的“工具”栏中，MenuStatusBar项定义当光标移动到添加的菜单栏上后显示在状态栏中提示文本。此外在注册表的HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Internet Explorer/Extensions/ GUID$#@62;下还可以添加一个名称为MenuCustomize的字符串类型值，将该值设定为"Help"将使菜单项出现在“帮助”菜单栏中，否则出现在“工具”栏中。
　　当然，我们不会满足于只是添加一个按钮，执行一个程序，我们希望能够获得当用户点击按钮时能够操控当前页面，在注册表的
　　HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Internet Explorer/Extensions/ GUID$#@62;下建立一个新的String类型的值，名称设定为一个htm文件的全路径名，同前面介绍的添加鼠标右键菜单一样，在点击按钮后IE会调用该文件，在文件中通过设定VBScript访问external对象的menuArguments属性就可以获得浏览器中的页面。例如我们将HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Internet Explorer/Extensions//VBScript的值设定为c:/program
　　files/samp.htm，然后在c:/program files下建立一个名为Samp.htm的文件，在文件中输入以下脚本内容： 　　
　　打开IE浏览器，点击新建按钮，就会弹出对话框显示当前页面的URL。注意该项同前面设定的Exec项不能够同时使用。
　　最后，对于按钮图标，IE需要两种尺寸的图标：20x20和16x16的，前者用于正常状态下的显示，后者用于在全屏幕下的显示，所以上面HotIcon和Icon指向的图标资源应该是三个图标的组合，这三个图标的规格如下：
　　16x16 16-色icon (必须) 20x20 16-色icon (可选)
　　20x20 256-色icon (必须) 在设计图标时，256色图标应该使用Windows半色调调色板，而16色图标使用Windows 16色调色板。
 
//==============================================================================