|
程式
Option Explicit
Private Declare Function CoCreateGuid Lib "ole32.dll" (lpGUID As Any) As Long
Private Declare Function StringFromGUID2 Lib "ole32" (lpGUID As Any, ByVal lpStr As String, ByVal lSize 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 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
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Const REG_SZ = 1
Private Const ERROR_SUCCESS = 0&
Private Const HKEY_LOCAL_MACHINE = &H80000002
'------------------------------------------------------------------------
'sButtonText : 按鈕文字
'EXEC : 所要執行程式的路徑
'sHotIcon : 滑鼠移到按鈕上所要顯示的圖示
'sIcon : 按鈕圖示
'------------------------------------------------------------------------
Public Sub ADDNewButton(sButtonText As String, EXEC As String, _
sHotIcon As String, sIcon As String)
Dim hKey As Long
Dim sGUID As String, B_CLSID As String, sVisable As String
B_CLSID = "{1FBA04EE-3024-11D2-8F1F-0000F87ABD16}" 'CLSID
sGUID = CreateGUID() '取得新的GUID
sVisable = "Yes" '按鈕為Visable
If RegCreateKey(HKEY_LOCAL_MACHINE, "Software\Microsoft\Internet Explorer\Extensions\" & sGUID, hKey) = ERROR_SUCCESS Then
RegSetValueEx hKey, "ButtonText", 0, REG_SZ, ByVal sButtonText, LenB(StrConv(sButtonText, vbFromUnicode)) + 1
RegSetValueEx hKey, "CLSID", 0, REG_SZ, ByVal B_CLSID, LenB(StrConv(B_CLSID, vbFromUnicode)) + 1
RegSetValueEx hKey, "Default Visible", 0, REG_SZ, ByVal sVisable, LenB(StrConv(sVisable, vbFromUnicode)) + 1
RegSetValueEx hKey, "Exec", 0, REG_SZ, ByVal EXEC, LenB(StrConv(EXEC, vbFromUnicode)) + 1
RegSetValueEx hKey, "HotIcon", 0, REG_SZ, ByVal sHotIcon, LenB(StrConv(sHotIcon, vbFromUnicode)) + 1
RegSetValueEx hKey, "Icon", 0, REG_SZ, ByVal sIcon, LenB(StrConv(sIcon, vbFromUnicode)) + 1
RegCloseKey hKey
End If
End Sub
Public Function CreateGUID() As String
Dim pGuid(16) As Byte
Dim s As String
s = String(255, " ")
CoCreateGuid pGuid(0)
StringFromGUID2 pGuid(0), s, 255
s = Trim(s)
CreateGUID = StrConv(s, vbFromUnicode)
End Function
如果要放個記事本在上面 顯示圖示C:\i1.ico以及C:\I2.ICO只要呼叫
ADDNewButton "記事本", "C:\windows\notedpad.exe", "C:\I1.ICO", "C:\I2.ICO"
就行了
執行結果
閃電後面又多了條魚對吧
|
