应用程序加入右键菜单和删除右键菜单 - SKY外语计算机学习

   在用vb制作系统右键菜单时，会出现在在字体下方有下划线的问题，超级解霸也有此毛病，我经过分析，终于让我发现了消除这一讨厌的下划线的方法，内幕全在注册表的设置上。只要用英文名做项，右键要显示的汉语名做默认值，这样就如你所愿了。请看以下程序。

'**************************************************************************
'**模块名：注册dll和ocx和tlb - Module1
'**说明：魔灵圣域版权所有2008 - 2009(C) by icecept(魔灵）
'**创建人：icecept(魔灵)
'**日期：2008-10-06 01:26:10
'**修改人：icecept(魔灵)
'**日期：
'**描述：icecept(魔灵)制作
'**版本：V1.0.0 http://icecept.blog.sohu.com
'*************************************************************************
Option Explicit
'注册表常数声明
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const REG_SZ = 1
'-注册表 API 声明...
'---------------------------------------------------------------
Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
'---------------------------------------------------------------
'获取系统路径的API函数
Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Sub Main()
'句柄和返回值，返回值为0代表写入成功
Dim hKey As Long, retu As Long
'应用程序绝对路径
Dim RegXy As String, winsys As String
winsys = Space(250)
winsys = Left(winsys, GetSystemDirectory(winsys, Len(winsys)))
If Dir(CheckFilePath(App.Path) & "开闭光驱.exe") <> vbNullString Then
   FileCopy CheckFilePath(App.Path) & "开闭光驱.exe", winsys & "\开闭光驱.exe"
   ' 建立注册表项,设置开光驱右键菜单
   RegCreateKey HKEY_CLASSES_ROOT, "*\shell\opendoor", hKey
   retu = RegSetValueEx(hKey, vbNullString, 0, REG_SZ, ByVal "打开光驱", LenB(StrConv("打开光驱", vbFromUnicode)) + 1)
   RegCreateKey HKEY_CLASSES_ROOT, "*\shell\opendoor\command", hKey
   retu = RegSetValueEx(hKey, vbNullString, 0, REG_SZ, ByVal winsys & "\开闭光驱.exe /opendoor", LenB(StrConv(winsys & "\开闭光驱.exe /opendoor", vbFromUnicode)) + 1)
   '设置闭光驱右键菜单
   RegCreateKey HKEY_CLASSES_ROOT, "*\shell\closedoor", hKey
   retu = RegSetValueEx(hKey, vbNullString, 0, REG_SZ, ByVal "关闭光驱", LenB(StrConv("关闭光驱", vbFromUnicode)) + 1)
   RegCreateKey HKEY_CLASSES_ROOT, "*\shell\closedoor\command", hKey
   retu = RegSetValueEx(hKey, vbNullString, 0, REG_SZ, ByVal winsys & "\开闭光驱.exe /closedoor", LenB(StrConv(winsys & "\开闭光驱.exe /closedoor", vbFromUnicode)) + 1)
End If
'注： RegSetValueEx第二项为空时把值填入第一行的默认项
' 建立注册表项,设置注册dll
RegCreateKey HKEY_CLASSES_ROOT, ".dll", hKey
retu = RegSetValueEx(hKey, vbNullString, 0, REG_SZ, ByVal "dllfile", LenB(StrConv("dllfile", vbFromUnicode)) + 1)
RegCreateKey HKEY_CLASSES_ROOT, "dllfile\shell\regdll", hKey
retu = RegSetValueEx(hKey, vbNullString, 0, REG_SZ, ByVal "注册 dll 文件", LenB(StrConv("注册 dll 文件", vbFromUnicode)) + 1)
RegCreateKey HKEY_CLASSES_ROOT, "dllfile\shell\regdll\command", hKey
retu = RegSetValueEx(hKey, vbNullString, 0, REG_SZ, ByVal "regsvr32.exe " & Chr(34) & "%L" & Chr(34), LenB(StrConv("regsvr32.exe " & Chr(34) & "%L" & Chr(34), vbFromUnicode)) + 1)
' 建立注册表项,设置反注册dll
RegCreateKey HKEY_CLASSES_ROOT, "dllfile\shell\unregdll", hKey
retu = RegSetValueEx(hKey, vbNullString, 0, REG_SZ, ByVal "注销 dll 文件", LenB(StrConv("注销 dll 文件", vbFromUnicode)) + 1)
RegCreateKey HKEY_CLASSES_ROOT, "dllfile\shell\unregdll\command", hKey
retu = RegSetValueEx(hKey, vbNullString, 0, REG_SZ, ByVal "regsvr32.exe /u " & Chr(34) & "%L" & Chr(34), LenB(StrConv("regsvr32.exe /u " & Chr(34) & "%L" & Chr(34), vbFromUnicode)) + 1)
' 建立注册表项,设置注册ocx
RegCreateKey HKEY_CLASSES_ROOT, ".ocx", hKey
retu = RegSetValueEx(hKey, vbNullString, 0, REG_SZ, ByVal "ocxfile", LenB(StrConv("ocxfile", vbFromUnicode)) + 1)
RegCreateKey HKEY_CLASSES_ROOT, "ocxfile\shell\regocx", hKey
retu = RegSetValueEx(hKey, vbNullString, 0, REG_SZ, ByVal "注册 ocx 文件", LenB(StrConv("注册 ocx 文件", vbFromUnicode)) + 1)
RegCreateKey HKEY_CLASSES_ROOT, "ocxfile\shell\regocx\command", hKey
retu = RegSetValueEx(hKey, vbNullString, 0, REG_SZ, ByVal "regsvr32.exe " & Chr(34) & "%L" & Chr(34), LenB(StrConv("regsvr32.exe " & Chr(34) & "%L" & Chr(34), vbFromUnicode)) + 1)
' 建立注册表项,设置反注册ocx
RegCreateKey HKEY_CLASSES_ROOT, "ocxfile\shell\unregocx", hKey
retu = RegSetValueEx(hKey, vbNullString, 0, REG_SZ, ByVal "注销 ocx 文件", LenB(StrConv("注销 ocx 文件", vbFromUnicode)) + 1)
RegCreateKey HKEY_CLASSES_ROOT, "ocxfile\shell\unregocx\command", hKey
retu = RegSetValueEx(hKey, vbNullString, 0, REG_SZ, ByVal "regsvr32.exe /u " & Chr(34) & "%L" & Chr(34), LenB(StrConv("regsvr32.exe /u " & Chr(34) & "%L" & Chr(34), vbFromUnicode)) + 1)
' 建立注册表项,设置注册tlb
RegCreateKey HKEY_CLASSES_ROOT, ".tlb", hKey
retu = RegSetValueEx(hKey, vbNullString, 0, REG_SZ, ByVal "tlbfile", LenB(StrConv("tlbfile", vbFromUnicode)) + 1)
RegCreateKey HKEY_CLASSES_ROOT, "tlbfile\shell\regtlb", hKey
retu = RegSetValueEx(hKey, vbNullString, 0, REG_SZ, ByVal "注册类型库", LenB(StrConv("注册类型库", vbFromUnicode)) + 1)
RegCreateKey HKEY_CLASSES_ROOT, "tlbfile\shell\regtlb\command", hKey
retu = RegSetValueEx(hKey, vbNullString, 0, REG_SZ, ByVal "REGTLIB.EXE.exe " & Chr(34) & "%L" & Chr(34), LenB(StrConv("regsvr32.exe " & Chr(34) & "%L" & Chr(34), vbFromUnicode)) + 1)
' 建立注册表项,设置反注册tlb
RegCreateKey HKEY_CLASSES_ROOT, "tlbfile\shell\unregtlb", hKey
retu = RegSetValueEx(hKey, vbNullString, 0, REG_SZ, ByVal "注销类型库", LenB(StrConv("注销类型库", vbFromUnicode)) + 1)
RegCreateKey HKEY_CLASSES_ROOT, "tlbfile\shell\unregtlb\command", hKey
retu = RegSetValueEx(hKey, vbNullString, 0, REG_SZ, ByVal "REGTLIB.EXE /u " & Chr(34) & "%L" & Chr(34), LenB(StrConv("regsvr32.exe /u " & Chr(34) & "%L" & Chr(34), vbFromUnicode)) + 1)
RegCloseKey hKey
End
End Sub
Public Function CheckFilePath(FilePath As String) As String
'存、读档时对文件路径的检查
If Right(FilePath, 1) = "\" Then
   CheckFilePath = FilePath
Else
   CheckFilePath = FilePath & "\"
End If
End Function

'**************************************************************************
'**模块名：删除右键菜单 - Module1
'**说明：魔灵圣域版权所有2008 - 2009(C) by icecept(魔灵）
'**创建人：icecept(魔灵)
'**日期：2008-10-10 00:14:59
'**修改人：icecept(魔灵)
'**日期：
'**描述：icecept(魔灵)制作
'**版本：V1.0.0 http://icecept.blog.sohu.com
'*************************************************************************

'=====================================
' 注册表的读写声明
'=====================================
'删除项目
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const REG_SZ = 1
Sub Main()
'以下删除右键的步骤是：先删除主项，在删除子项
'这里必须分步执行，如同删除文件夹一样，不能删除非空的文件夹，此处重要。
'也就是说在删除的项中可以有值，但不能有项
RegDeleteKey HKEY_CLASSES_ROOT, "dllfile\shell\regdll\command"
RegDeleteKey HKEY_CLASSES_ROOT, "dllfile\shell\regdll"
RegDeleteKey HKEY_CLASSES_ROOT, "dllfile\shell\unregdll\command"
RegDeleteKey HKEY_CLASSES_ROOT, "dllfile\shell\unregdll"
RegDeleteKey HKEY_CLASSES_ROOT, "ocxfile\shell\regocx\command"
RegDeleteKey HKEY_CLASSES_ROOT, "ocxfile\shell\regocx"
RegDeleteKey HKEY_CLASSES_ROOT, "ocxfile\shell\unregocx\command"
RegDeleteKey HKEY_CLASSES_ROOT, "ocxfile\shell\unregocx"
RegDeleteKey HKEY_CLASSES_ROOT, "tlbfile\shell\regtlb\command"
RegDeleteKey HKEY_CLASSES_ROOT, "tlbfile\shell\regtlb"
RegDeleteKey HKEY_CLASSES_ROOT, "tlbfile\shell\unregtlb\command"
RegDeleteKey HKEY_CLASSES_ROOT, "tlbfile\shell\unregtlb"
RegDeleteKey HKEY_CLASSES_ROOT, "*\shell\opendoor\command"
RegDeleteKey HKEY_CLASSES_ROOT, "*\shell\opendoor"
RegDeleteKey HKEY_CLASSES_ROOT, "*\shell\closedoor\command"
RegDeleteKey HKEY_CLASSES_ROOT, "*\shell\closedoor"
MsgBox "右键删除成功", vbOKOnly Or vbInformation
End Sub