當前位置：首頁 > 编程资源 > 编程问答 >内容正文

编程问答

VB添加IE右键菜单等

發布時間：2024/1/1 编程问答 30 豆豆

生活随笔收集整理的這篇文章主要介紹了 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.

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色調色板。
?
//==============================================================================

總結

以上是生活随笔為你收集整理的VB添加IE右键菜单等的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。

上一篇： kodi android 卡顿,分享n1
下一篇：英语经典口语999句