VB添加IE右鍵菜單等

/--------------------------------------------------

'***************************************

'IE工具欄按鈕和IE右鍵菜單(VB6)

'Autor:wgscd

'mail: [email protected]

'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:[email protected]

'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色調色闆。

//==============================================================================