7487
社区成员
- 全部
windows右键菜单问题[300-500分]
怎么将自己的程序加入到右键菜单中，就像winzip 一样
并且知道你点击的是哪个文件或文件夹
我看过注册表，是添加到：
HKEY_CLASSES_ROOT/*/SHELLEX/contextmenuHandlers
下，然后指向的是一个dll,好象每个有此功能的软件都用了dll,我看过这些dll,应该是activeX的dll,请问谁有这些dll的源代码？提供思路的也可以
还有就是这些dll都是在系统启动后就添加到explorer的模块里，启动后就加载乐，请问如何加载？
在线等待，1天后回复的400分，2天以后回复的300分
并且知道你点击的是哪个文件或文件夹
我看过注册表，是添加到：
HKEY_CLASSES_ROOT/*/SHELLEX/contextmenuHandlers
下，然后指向的是一个dll,好象每个有此功能的软件都用了dll,我看过这些dll,应该是activeX的dll,请问谁有这些dll的源代码？提供思路的也可以
还有就是这些dll都是在系统启动后就添加到explorer的模块里，启动后就加载乐，请问如何加载？
在线等待，1天后回复的400分，2天以后回复的300分
...全文
当前发帖距今超过3年，不再开放新的回复
发表回复
Rozre 2003-06-05
up
yefm 2003-06-05
up
rainstormmaster 2003-06-05
blacklevin(黑闪电)的就可以了，至于 zhou_huanxi(阿周) 说的：不能象WINZIP可处理相应文件，很容易解决。先在注册表中写入文件的打开方式。然后在程序中处理command传回的字串就可以了。
fontz 2003-06-05
感谢，收藏，有用
gilbe 2003-02-27
有没有不用控件的例子呢?
不用控件可不可以呢?
不用控件可不可以呢?
Girl1983 2003-02-26
http://www.freevbgood.com有个例子，http://www.sijiqing.com/vbgood/taishan/index.html
有个控件
有个控件
xiaole18 2003-02-26
又学了不少东西呀！
stove 2003-02-26
up
chanet 2003-02-26
挺复杂的...
来学习的...
来学习的...
SamHuang1 2003-02-26
up
来学习东西的!
来学习东西的!
我是杨威利 2003-02-26
gz
gilbe 2003-02-26
我已经成功做出，不过是用delphi做出的windows外壳，谁有vb的例子牙？
minajo21 2003-01-30
up
situation 2003-01-30
gz
along 2003-01-14
楼上这种方法只是执行相应的命令而不能象WINZIP可处理相应文件；其实WINZIP等软件是通过WINDOWS外壳扩展中的Context menu handles（向特定类型的文件对象增添上下文菜单）类实现的，WINDOWS外壳扩展都是基于COM组件型；外壳扩展都通过接口来访问对象。它一般都被设计成32位的进程服务器中，且都以动态链接库的形式为操作系统服务。因此要有一定的COM功底。
编写Context menu handles必须实现IShellExtInit(实现初始化）、IContextMenu(实现上下文相关菜单）与TComObjectFactory(实现对象的创建）三个接口。真正要做至象WINZIP等一样用VB实现有相当的困难；我有DELPHI的原代码，若要请留下EMAIL；但声明一点我也是参考了一些资料及代码后做出来的不过封装为DLL后在VB做的软件中应该也可以用。
另若嫌麻烦，也可用楼上的方法只不过稍作要改造即可处理相应文件。我以前用这种方法做过一个收集资料的小软件，若在文本类文件上单击右键即出添加菜单条目，单击此菜单条目即可把此文件导入我的资料库中，具体实现代码如下：
此处只给出TXT类文件添加右键菜单并通过单击右键菜把文件内容读入窗体的文本框中的代码（以下代码在VB6WINDOWSME下调试通过）：
其余类同。代码没有优化见笑了各位大侠。
以下在BAS中
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function RegSetValueExString Lib "advapi32.dll" 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 '
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Type SECURITY_ATTRIBUTES
NLONGTH As Long
bInheritHandle As Boolean
End Type
Private NotiFy1 As SECURITY_ATTRIBUTES
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const REG_SZ = 1
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const SYNCHRONIZE = &H100000
Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Private Const ERROR_SUCCESS = 0&
Private Const REG_OPTION_NON_VOLATILE = 0
Private Const STANDARD_RIGHTS_READ = &H20000
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
KEY_QUERY_VALUE Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY) And _
(Not SYNCHRONIZE))
Dim Rc As Long
Dim hKey As Long
Dim lpData As String
Dim lpDataW As Long
Dim lpcbData As Long
Public Declare Function SHFileExists Lib "shell32.dll" Alias "#45" (ByVal szPath As String) As Long
Public Fapath As String '存放本程序所在路径名
Public MyTxtFile$ '菜单关联的文件的路径与文件名
Dim MyExeName$
'读取一个键值
Public Function GetRegValue(ByVal hKeyRoot As Long, ByVal SubKey As String, ByVal KeyValueName As String, ByVal ValueType As Long) As Variant
Rc = RegOpenKeyEx(hKeyRoot, SubKey, 0, KEY_READ, hKey)
If Rc <> ERROR_SUCCESS Then
Exit Function
End If
Rc = RegQueryValueEx(hKey, KeyValueName, 0, ValueType, ByVal 0, lpcbData)
If Rc <> ERROR_SUCCESS Then Exit Function
lpcbData = 260
lpData = String(lpcbData, Chr(0))
Rc = RegQueryValueEx(hKey, KeyValueName, 0, REG_SZ, ByVal lpData, lpcbData)
If Rc = ERROR_SUCCESS Then
Dim Regs As String, Lop As Integer
Regs = Left(lpData, lpcbData - 1)
Lop = InStr(Regs, Chr(0))
If Lop <> 0 Then Regs = Mid$(Regs, 1, Lop - 1)
GetRegValue = Regs
Else
GetRegValue = ""
End If
RegCloseKey hKey
End Function
'在注册表中创建一个键值
Public Function CreaSub(ByVal LngKey As Long, ByVal SubKey1 As String, ByVal KeyName As String, KeyValue As Variant, ByVal KeyValueType As Long)
Dim KeyHandle As Long
Dim ReturnValue As Long
Dim R1, R2, R3, R4 As Long
Dim Tt1 As String
R1 = RegCreateKeyEx(LngKey, SubKey1, 0&, Tt1, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, NotiFy1, KeyHandle, ReturnValue) ' RegOpenKeyEx(LngKey, SubKey1, 0, KEY_SET_VALUE, KeyHandle)
If R1 = ERROR_SUCCESS Then
R1 = SetValueEx(KeyHandle, KeyName, KeyValueType, KeyValue)
R4 = RegCloseKey(KeyHandle)
Else
Beep
MsgBox "访问注册表出错！！", 16, "注意"
Exit Function
End If
End Function
'设置REG_SZ值
Private Function SetValueEx(ByVal hKey As Long, sValueName As String, _
lType As Long, vValue As Variant) As Long
Dim sValue As String
sValue = vValue & Chr$(0)
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
End Function
'在注册表中删除一个键
Public Function DeleKeyN(ByVal LngKey As Long, ByVal SubKey1 As String) As Long
Dim KeyHandle As Long
Dim R1 As Long
R1 = RegOpenKeyEx(LngKey, SubKey1, 0&, KEY_ALL_ACCESS, KeyHandle)
If R1 = 0 Then
R1 = RegDeleteKey(LngKey, SubKey1)
If R1 = ERROR_SUCCESS Then
DeleKeyN = 1
RegCloseKey KeyHandle
Exit Function
Else
DeleKeyN = 0
End If
RegCloseKey KeyHandle
End If
End Function
'启动加载过程
Sub Main()
Dim CmdStr As String
Dim Regv$
CmdStr = Command '取命令行参数
Fapath = App.Path '程序所在路径
MyExeName = App.EXEName 'EXE文件名
'此处处理磁盘根目录与子目录
If Right(Fapath, 1) <> "\" Then Fapath = Fapath & "\"
'此处取得TXT文件类型名
Regv = GetRegValue(HKEY_LOCAL_MACHINE, "Software\classes\.txt", "", REG_SZ)
'此处在TXT文件下的Shell子键下建立与此类文件关联的右键菜注意键值中的%1
'此即为返加点击右键菜时所对应的文件名与路径
'此处添加的菜单名为——"发送到" & MyExeName
If Regv <> "" Then _
CreaSub HKEY_LOCAL_MACHINE, "Software\classes\" & Regv & "\shell\" & _
"发送到" & MyExeName & "\command", "", Fapath & MyExeName & ".exe %1", REG_SZ
'此处利用命令行形式获取此文件的路径与名字
If CmdStr <> "" Then
MyTxtFile = Mid$(CmdStr, 3, Len(CmdStr) - 2)
End If
Load MainFrm
End Sub
以下在FORM中
'在窗体中添加一文本框
'在窗体的调用事件中输入如代码
'文件内是否已在文本框中了呢？
'调试完后请自行调用删除一个键值代码删除刚建立的键值
'另请注意正常情况下文本框只能处理32KB内容，超过可能……haha!!
'在读某些文件可能出错请自行完整。
Private Sub Form_Load()
Dim FileHa&
If SHFileExists(MyTxtFile) Then
FileHa = FreeFile
Open MyTxtFile For Input As #FileHa
Text1.Text = StrConv(InputB$(LOF(FileHa), #FileHa), vbUnicode)
Close #FileHa
Else
Text1.Text = "程序出错," & MyTxtFile & "不存在！！"
End If
Me.Show
DoEvents
End Sub
编写Context menu handles必须实现IShellExtInit(实现初始化）、IContextMenu(实现上下文相关菜单）与TComObjectFactory(实现对象的创建）三个接口。真正要做至象WINZIP等一样用VB实现有相当的困难；我有DELPHI的原代码，若要请留下EMAIL；但声明一点我也是参考了一些资料及代码后做出来的不过封装为DLL后在VB做的软件中应该也可以用。
另若嫌麻烦，也可用楼上的方法只不过稍作要改造即可处理相应文件。我以前用这种方法做过一个收集资料的小软件，若在文本类文件上单击右键即出添加菜单条目，单击此菜单条目即可把此文件导入我的资料库中，具体实现代码如下：
此处只给出TXT类文件添加右键菜单并通过单击右键菜把文件内容读入窗体的文本框中的代码（以下代码在VB6WINDOWSME下调试通过）：
其余类同。代码没有优化见笑了各位大侠。
以下在BAS中
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function RegSetValueExString Lib "advapi32.dll" 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 '
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Type SECURITY_ATTRIBUTES
NLONGTH As Long
bInheritHandle As Boolean
End Type
Private NotiFy1 As SECURITY_ATTRIBUTES
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const REG_SZ = 1
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const SYNCHRONIZE = &H100000
Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Private Const ERROR_SUCCESS = 0&
Private Const REG_OPTION_NON_VOLATILE = 0
Private Const STANDARD_RIGHTS_READ = &H20000
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
KEY_QUERY_VALUE Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY) And _
(Not SYNCHRONIZE))
Dim Rc As Long
Dim hKey As Long
Dim lpData As String
Dim lpDataW As Long
Dim lpcbData As Long
Public Declare Function SHFileExists Lib "shell32.dll" Alias "#45" (ByVal szPath As String) As Long
Public Fapath As String '存放本程序所在路径名
Public MyTxtFile$ '菜单关联的文件的路径与文件名
Dim MyExeName$
'读取一个键值
Public Function GetRegValue(ByVal hKeyRoot As Long, ByVal SubKey As String, ByVal KeyValueName As String, ByVal ValueType As Long) As Variant
Rc = RegOpenKeyEx(hKeyRoot, SubKey, 0, KEY_READ, hKey)
If Rc <> ERROR_SUCCESS Then
Exit Function
End If
Rc = RegQueryValueEx(hKey, KeyValueName, 0, ValueType, ByVal 0, lpcbData)
If Rc <> ERROR_SUCCESS Then Exit Function
lpcbData = 260
lpData = String(lpcbData, Chr(0))
Rc = RegQueryValueEx(hKey, KeyValueName, 0, REG_SZ, ByVal lpData, lpcbData)
If Rc = ERROR_SUCCESS Then
Dim Regs As String, Lop As Integer
Regs = Left(lpData, lpcbData - 1)
Lop = InStr(Regs, Chr(0))
If Lop <> 0 Then Regs = Mid$(Regs, 1, Lop - 1)
GetRegValue = Regs
Else
GetRegValue = ""
End If
RegCloseKey hKey
End Function
'在注册表中创建一个键值
Public Function CreaSub(ByVal LngKey As Long, ByVal SubKey1 As String, ByVal KeyName As String, KeyValue As Variant, ByVal KeyValueType As Long)
Dim KeyHandle As Long
Dim ReturnValue As Long
Dim R1, R2, R3, R4 As Long
Dim Tt1 As String
R1 = RegCreateKeyEx(LngKey, SubKey1, 0&, Tt1, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, NotiFy1, KeyHandle, ReturnValue) ' RegOpenKeyEx(LngKey, SubKey1, 0, KEY_SET_VALUE, KeyHandle)
If R1 = ERROR_SUCCESS Then
R1 = SetValueEx(KeyHandle, KeyName, KeyValueType, KeyValue)
R4 = RegCloseKey(KeyHandle)
Else
Beep
MsgBox "访问注册表出错！！", 16, "注意"
Exit Function
End If
End Function
'设置REG_SZ值
Private Function SetValueEx(ByVal hKey As Long, sValueName As String, _
lType As Long, vValue As Variant) As Long
Dim sValue As String
sValue = vValue & Chr$(0)
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
End Function
'在注册表中删除一个键
Public Function DeleKeyN(ByVal LngKey As Long, ByVal SubKey1 As String) As Long
Dim KeyHandle As Long
Dim R1 As Long
R1 = RegOpenKeyEx(LngKey, SubKey1, 0&, KEY_ALL_ACCESS, KeyHandle)
If R1 = 0 Then
R1 = RegDeleteKey(LngKey, SubKey1)
If R1 = ERROR_SUCCESS Then
DeleKeyN = 1
RegCloseKey KeyHandle
Exit Function
Else
DeleKeyN = 0
End If
RegCloseKey KeyHandle
End If
End Function
'启动加载过程
Sub Main()
Dim CmdStr As String
Dim Regv$
CmdStr = Command '取命令行参数
Fapath = App.Path '程序所在路径
MyExeName = App.EXEName 'EXE文件名
'此处处理磁盘根目录与子目录
If Right(Fapath, 1) <> "\" Then Fapath = Fapath & "\"
'此处取得TXT文件类型名
Regv = GetRegValue(HKEY_LOCAL_MACHINE, "Software\classes\.txt", "", REG_SZ)
'此处在TXT文件下的Shell子键下建立与此类文件关联的右键菜注意键值中的%1
'此即为返加点击右键菜时所对应的文件名与路径
'此处添加的菜单名为——"发送到" & MyExeName
If Regv <> "" Then _
CreaSub HKEY_LOCAL_MACHINE, "Software\classes\" & Regv & "\shell\" & _
"发送到" & MyExeName & "\command", "", Fapath & MyExeName & ".exe %1", REG_SZ
'此处利用命令行形式获取此文件的路径与名字
If CmdStr <> "" Then
MyTxtFile = Mid$(CmdStr, 3, Len(CmdStr) - 2)
End If
Load MainFrm
End Sub
以下在FORM中
'在窗体中添加一文本框
'在窗体的调用事件中输入如代码
'文件内是否已在文本框中了呢？
'调试完后请自行调用删除一个键值代码删除刚建立的键值
'另请注意正常情况下文本框只能处理32KB内容，超过可能……haha!!
'在读某些文件可能出错请自行完整。
Private Sub Form_Load()
Dim FileHa&
If SHFileExists(MyTxtFile) Then
FileHa = FreeFile
Open MyTxtFile For Input As #FileHa
Text1.Text = StrConv(InputB$(LOF(FileHa), #FileHa), vbUnicode)
Close #FileHa
Else
Text1.Text = "程序出错," & MyTxtFile & "不存在！！"
End If
Me.Show
DoEvents
End Sub
blacklevin 2003-01-13
我把上面的的代码重新写了一下
这样可以很直观的看到
现在无论反键点任何地方都可以在右键菜单执行ms-dos
Const HKEY_CLASSES_ROOT = &H80000000
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 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 REG_SZ = 1
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 Sub asscociateFileInPopup(sFileType As String)
Dim sReg As String
savestring HKEY_CLASSES_ROOT, sFileType & "\shell\ms-dos\", "", "执行ms-dos"
sReg = "c:\windows\system32\cmd.exe"
savestring HKEY_CLASSES_ROOT, sFileType & "\shell\ms-dos\command\", "", sReg
End Sub
Private Sub Form_Load()
asscociateFileInPopup "*"
asscociateFileInPopup "Directory"
asscociateFileInPopup "Drive"
asscociateFileInPopup "Folder"
End Sub
这样可以很直观的看到
现在无论反键点任何地方都可以在右键菜单执行ms-dos
Const HKEY_CLASSES_ROOT = &H80000000
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 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 REG_SZ = 1
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 Sub asscociateFileInPopup(sFileType As String)
Dim sReg As String
savestring HKEY_CLASSES_ROOT, sFileType & "\shell\ms-dos\", "", "执行ms-dos"
sReg = "c:\windows\system32\cmd.exe"
savestring HKEY_CLASSES_ROOT, sFileType & "\shell\ms-dos\command\", "", sReg
End Sub
Private Sub Form_Load()
asscociateFileInPopup "*"
asscociateFileInPopup "Directory"
asscociateFileInPopup "Drive"
asscociateFileInPopup "Folder"
End Sub
pdy11 2003-01-13
up
blacklevin 2003-01-13
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const ERROR_SUCCESS = 0&
Declare Function RegCloseKey Lib "advapi32.dll" (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 RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String) As Long
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal Hkey As Long, ByVal lpValueName As String) 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 RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
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
Public Const REG_SZ = 1 ' Unicode nul terminated string
Public Const REG_DWORD = 4 ' 32-bit number
Public Sub savekey(Hkey As Long, strPath As String)
Dim keyhand&
r = RegCreateKey(Hkey, strPath, keyhand&)
r = RegCloseKey(keyhand&)
End Sub
Public Function getstring(Hkey As Long, strPath As String, strValue As String)
Dim keyhand As Long
Dim datatype As Long
Dim lResult As Long
Dim strBuf As String
Dim lDataBufSize As Long
Dim intZeroPos As Integer
r = RegOpenKey(Hkey, strPath, keyhand)
lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&, lDataBufSize)
If lValueType = REG_SZ Then
strBuf = String(lDataBufSize, " ")
lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, ByVal strBuf, lDataBufSize)
If lResult = ERROR_SUCCESS Then
intZeroPos = InStr(strBuf, Chr$(0))
If intZeroPos > 0 Then
getstring = Left$(strBuf, intZeroPos - 1)
Else
getstring = strBuf
End If
End If
End If
End Function
Public 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
Function getdword(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String) As Long
Dim lResult As Long
Dim lValueType As Long
Dim lBuf As Long
Dim lDataBufSize As Long
Dim r As Long
Dim keyhand As Long
r = RegOpenKey(Hkey, strPath, keyhand)
' Get length/data type
lDataBufSize = 4
lResult = RegQueryValueEx(keyhand, strValueName, 0&, lValueType, lBuf, lDataBufSize)
If lResult = ERROR_SUCCESS Then
If lValueType = REG_DWORD Then
getdword = lBuf
End If
'Else
' Call errlog("GetDWORD-" & strPath, False)
End If
r = RegCloseKey(keyhand)
End Function
Function SaveDword(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String, ByVal lData As Long)
Dim lResult As Long
Dim keyhand As Long
Dim r As Long
r = RegCreateKey(Hkey, strPath, keyhand)
lResult = RegSetValueEx(keyhand, strValueName, 0&, REG_DWORD, lData, 4)
'If lResult <> error_success Then Call errlog("SetDWORD", False)
r = RegCloseKey(keyhand)
End Function
Public Function DeleteKey(ByVal Hkey As Long, ByVal strKey As String)
Dim r As Long
r = RegDeleteKey(Hkey, strKey)
End Function
Public Function DeleteValue(ByVal Hkey As Long, ByVal strPath As String, ByVal strValue As String)
Dim keyhand As Long
r = RegOpenKey(Hkey, strPath, keyhand)
r = RegDeleteValue(keyhand, strValue)
r = RegCloseKey(keyhand)
End Function
Public Sub asscociateFileInPopup(sFileType As String)
Dim sReg As String
sReg = Chr(34) & App.Path & "\" & App.EXEName & ".exe" & Chr(34) & " " & Chr(34) & "%1" & Chr(34)
savestring HKEY_CLASSES_ROOT, sFileType & "\shell\Edit With &Ultra HTML Designer\command", "", sReg
End Sub
asscociateFileInPopup "htmlfile"
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const ERROR_SUCCESS = 0&
Declare Function RegCloseKey Lib "advapi32.dll" (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 RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String) As Long
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal Hkey As Long, ByVal lpValueName As String) 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 RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
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
Public Const REG_SZ = 1 ' Unicode nul terminated string
Public Const REG_DWORD = 4 ' 32-bit number
Public Sub savekey(Hkey As Long, strPath As String)
Dim keyhand&
r = RegCreateKey(Hkey, strPath, keyhand&)
r = RegCloseKey(keyhand&)
End Sub
Public Function getstring(Hkey As Long, strPath As String, strValue As String)
Dim keyhand As Long
Dim datatype As Long
Dim lResult As Long
Dim strBuf As String
Dim lDataBufSize As Long
Dim intZeroPos As Integer
r = RegOpenKey(Hkey, strPath, keyhand)
lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&, lDataBufSize)
If lValueType = REG_SZ Then
strBuf = String(lDataBufSize, " ")
lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, ByVal strBuf, lDataBufSize)
If lResult = ERROR_SUCCESS Then
intZeroPos = InStr(strBuf, Chr$(0))
If intZeroPos > 0 Then
getstring = Left$(strBuf, intZeroPos - 1)
Else
getstring = strBuf
End If
End If
End If
End Function
Public 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
Function getdword(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String) As Long
Dim lResult As Long
Dim lValueType As Long
Dim lBuf As Long
Dim lDataBufSize As Long
Dim r As Long
Dim keyhand As Long
r = RegOpenKey(Hkey, strPath, keyhand)
' Get length/data type
lDataBufSize = 4
lResult = RegQueryValueEx(keyhand, strValueName, 0&, lValueType, lBuf, lDataBufSize)
If lResult = ERROR_SUCCESS Then
If lValueType = REG_DWORD Then
getdword = lBuf
End If
'Else
' Call errlog("GetDWORD-" & strPath, False)
End If
r = RegCloseKey(keyhand)
End Function
Function SaveDword(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String, ByVal lData As Long)
Dim lResult As Long
Dim keyhand As Long
Dim r As Long
r = RegCreateKey(Hkey, strPath, keyhand)
lResult = RegSetValueEx(keyhand, strValueName, 0&, REG_DWORD, lData, 4)
'If lResult <> error_success Then Call errlog("SetDWORD", False)
r = RegCloseKey(keyhand)
End Function
Public Function DeleteKey(ByVal Hkey As Long, ByVal strKey As String)
Dim r As Long
r = RegDeleteKey(Hkey, strKey)
End Function
Public Function DeleteValue(ByVal Hkey As Long, ByVal strPath As String, ByVal strValue As String)
Dim keyhand As Long
r = RegOpenKey(Hkey, strPath, keyhand)
r = RegDeleteValue(keyhand, strValue)
r = RegCloseKey(keyhand)
End Function
Public Sub asscociateFileInPopup(sFileType As String)
Dim sReg As String
sReg = Chr(34) & App.Path & "\" & App.EXEName & ".exe" & Chr(34) & " " & Chr(34) & "%1" & Chr(34)
savestring HKEY_CLASSES_ROOT, sFileType & "\shell\Edit With &Ultra HTML Designer\command", "", sReg
End Sub
asscociateFileInPopup "htmlfile"
Windows 右键菜单打开MSYS-MinGW 安装MSYS-MinGW后，通常是通过启动菜单去打开，要进入某个目录就去寻找目录，cd了。 如果可以在右键菜单直接打开，并定位到当前目录，岂不是爽歪歪。Windows与Unix特性兼得~
Windows 右键菜单管理工具 ContextMenuManager 3.1.2.0.zip 一款开源免费纯粹的 Windows 右键菜单管理工具，该工具由网友蓝点lilac开发并发布到开源社区共享。对于习惯了使用 Windows 系统的用户肯定会经常碰到自己的 Windows 右键菜单随着安装的软件添加的项目越来越多，而想...
【易首发】极精简易代码实现完美弹出explorer右键菜单，windows shell外壳编程。-易语言 上次我发了个：【首发】纯易代码实现弹出Windowszy管理器的右键菜单。 ，说实话，做得没有那么好。 这次我进行了修改（大概看了下Shell外壳的资料）。 图片一览： 效果图： 部分代码： 原理解析： ...
windows资源管理器文件-文件夹右键菜单自定义二级 在Windows系统下的资源管理器（explorer.exe）中的文件、文件夹右键菜单中自定义一个菜单项，并展开第二级。使用VC++ 6.0开发，Windows XP 32位下测试通过。wzsy的...
Windows 右键菜单扩展 右键菜单，指用户在对Windows Shell Object右键单击时，弹出的上下文菜单（Context Menu）。...本文将介绍利用COM接口对Windows右键菜单进行扩展，笔者将分四个步骤对整个项目建立过程进行引...
windows右键菜单添加“在CMD打开” 在Ubuntu中我们可以很方便的在目录空白处或文件夹上进入终端，但是Windows上没有这...为了能够方便的操作命令提示符，本文将介绍批处理方式将cmd加入右键菜单，可以在目录空白处或文件夹上进入CMD，并直接到达该路径。
Windows自定义右键菜单 给文件添加右键菜单的方法主要有修改注册表，编写COM组件两种方式，当然这个只是我知道的，或许还有其他我所不知道的方法。今天我要分享的是如何通过添加注册表来达到创建自定义菜单的目的。 在XP系统上通过...
windows10右键菜单怎样添加卸载USB设备选项 我们在使用完u盘之后，如果想要拔出它一般都需要先弹出usb设备才可以，也就是说用户每次都得到...接下来，就为大家分享一个在windows10右键菜单中添加安全弹出usb设备的方法。有了这个方法我们就能快速弹出usb设备。
右键菜单管理.zip 这是一个可以自定义右键新建菜单栏的工具，在Windows系统上可以自行添加和删除要新建的菜单选项，包括.md、.txt、.zip、.ppt、.docx、.xls等各种软件的后缀菜单
windows右键菜单注册表 windows右键菜单注册表 sublime_text Windows Registry Editor Version 5.00 [HKEY_CLASSES_ROOT\*\shell\SublimeText3] @="用 SublimeText3 打开" "Icon"="F:\\...
VC++ 外壳扩展编程之windows右键菜单 VC++ 外壳扩展编程之windows右键菜单VC++ 外壳扩展编程之windows右键菜单VC++ 外壳扩展编程之windows右键菜单VC++ 外壳扩展编程之windows右键菜单VC++ 外壳扩展编程之windows右键菜单VC++ 外壳扩展编程之windows右键...
