Option Explicit Private Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Private Const REG_SZ = 1 ' Unicode nul terminated string Private Const MAX_PATH = 260 Private Const HKEY_CLASSES_ROOT = &H80000000 Private Sub SetRMREG() Dim PathName As String PathName = App.Path If Right(PathName, 1) <> "\" Then PathName = PathName + "\" PathName = PathName + "myrealplayer.exe %1" '要确认已经存在myrealplayer.exe这个文件 Dim hKey As Long hKey = HKEY_CLASSES_ROOT RegSetValue hKey, ".rm", REG_SZ, "我的realplayer", 7 RegSetValue hKey, "我的realplayer", REG_SZ, "我的realplayer文件", 9 RegSetValue hKey, "我的realplayer\shell", REG_SZ, "open", 5 RegSetValue hKey, "我的realplayer" + "\shell\open\command", REG_SZ, PathName, LenB(StrConv(PathName, vbFromUnicode)) + 1 RegCloseKey hKey End Sub
'打开文件关联的例子Const ERROR_SUCCESS = 0& Const REG_SZ = 1 Const HKEY_CLASSES_ROOT = &H80000000 Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpszValueName As String, ByVal dwReserved As Long, lpdwType As Long, lpbData As Any, cbData As Long) As Long Declare Function RegOpenKey Lib "advapi32" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpszSubKey As String, phkResult 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 ' Note that if you declare the lpData parameter as String, you must pass it By Value. Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As LongPublic Function RegSetStringValue(ByVal hKey As Long, ByVal strValueName As String, _ ByVal strData As String, Optional ByVal fLog) As Boolean Dim lResult As Long On Error GoTo 0 lResult = RegSetValueEx(hKey, strValueName, 0&, REG_SZ, ByVal strData, _ LenB(StrConv(strData, vbFromUnicode)) + 1) If lResult = 0 Then RegSetStringValue = True Else RegSetStringValue = False End If End FunctionPublic Function StripTerminator(ByVal strString As String) As String Dim intZeroPos As Integer intZeroPos = InStr(strString, Chr$(0)) If intZeroPos > 0 Then StripTerminator = Left$(strString, intZeroPos - 1) Else StripTerminator = strString End If End FunctionPublic Sub SetFileType(ByVal strFileType As String, ExePathFile As String) Dim Length As Integer
Dim KeyId As Long Call RegCreateKey(HKEY_CLASSES_ROOT, "." & strFileType, KeyId) Call RegSetValueEx(KeyId, "", 0&, REG_SZ, ByVal strFileType & "file", Len(strFileType & "file") + 1) Dim KeyId1 As Long Call RegCreateKey(HKEY_CLASSES_ROOT, strFileType & "file", KeyId1) Call RegSetValueEx(KeyId1, "", 0&, REG_SZ, ByVal strFileType & "类型", LenB(strFileType & "类型") + 1) Dim KeyId2 As Long Call RegCreateKey(KeyId1, "DefaultIcon", KeyId2) Call RegSetValueEx(KeyId2, "", 0&, REG_SZ, ByVal ExePathFile & ",0", Len(ExePathFile & ",0") + 1) Dim KeyId3 As Long Call RegCreateKey(KeyId1, "Shell", KeyId3) Dim KeyId4 As Long Call RegCreateKey(KeyId3, "Open", KeyId4) Dim KeyId5 As Long Call RegCreateKey(KeyId4, "command", KeyId5) Call RegSetValueEx(KeyId5, "", 0&, REG_SZ, ByVal ExePathFile & " %1", Len(ExePathFile & " %1") + 1) 'MsgBox "创建自定义类型后缀名成功。", vbInformation, "系统提示" End Sub用法: Call SetFileType("csp", strEXEPathFile) “csp”是文件后缀名。 strEXEPathFile 是打开这个后缀名的 Exe 文件完整路径。双击文件时,就会调用你自己定义的程序打开。 在Form_load 过程中用command参数可以传入被打开文件的完整路径名和文件名。
下面有个.rm键
(默认)="RealPlayer.RM.6"--------可以改成MyMediaFile
Current Type="application/vnd.rn-realmedia"参考"RealPlayer.RM.6"键,加一个MyMediaFile
关键就在Shell的open中,建议在安装文件中处理,卸载文件中要还原,否则太霸道了。
Private Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Const REG_SZ = 1 ' Unicode nul terminated string
Private Const MAX_PATH = 260
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Sub SetRMREG()
Dim PathName As String
PathName = App.Path
If Right(PathName, 1) <> "\" Then PathName = PathName + "\"
PathName = PathName + "myrealplayer.exe %1" '要确认已经存在myrealplayer.exe这个文件
Dim hKey As Long
hKey = HKEY_CLASSES_ROOT
RegSetValue hKey, ".rm", REG_SZ, "我的realplayer", 7
RegSetValue hKey, "我的realplayer", REG_SZ, "我的realplayer文件", 9
RegSetValue hKey, "我的realplayer\shell", REG_SZ, "open", 5
RegSetValue hKey, "我的realplayer" + "\shell\open\command", REG_SZ, PathName, LenB(StrConv(PathName, vbFromUnicode)) + 1
RegCloseKey hKey
End Sub
Const REG_SZ = 1
Const HKEY_CLASSES_ROOT = &H80000000
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpszValueName As String, ByVal dwReserved As Long, lpdwType As Long, lpbData As Any, cbData As Long) As Long
Declare Function RegOpenKey Lib "advapi32" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpszSubKey As String, phkResult 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 ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As LongPublic Function RegSetStringValue(ByVal hKey As Long, ByVal strValueName As String, _
ByVal strData As String, Optional ByVal fLog) As Boolean
Dim lResult As Long
On Error GoTo 0
lResult = RegSetValueEx(hKey, strValueName, 0&, REG_SZ, ByVal strData, _
LenB(StrConv(strData, vbFromUnicode)) + 1)
If lResult = 0 Then
RegSetStringValue = True
Else
RegSetStringValue = False
End If
End FunctionPublic Function StripTerminator(ByVal strString As String) As String
Dim intZeroPos As Integer
intZeroPos = InStr(strString, Chr$(0))
If intZeroPos > 0 Then
StripTerminator = Left$(strString, intZeroPos - 1)
Else
StripTerminator = strString
End If
End FunctionPublic Sub SetFileType(ByVal strFileType As String, ExePathFile As String)
Dim Length As Integer
Dim KeyId As Long
Call RegCreateKey(HKEY_CLASSES_ROOT, "." & strFileType, KeyId)
Call RegSetValueEx(KeyId, "", 0&, REG_SZ, ByVal strFileType & "file", Len(strFileType & "file") + 1)
Dim KeyId1 As Long
Call RegCreateKey(HKEY_CLASSES_ROOT, strFileType & "file", KeyId1)
Call RegSetValueEx(KeyId1, "", 0&, REG_SZ, ByVal strFileType & "类型", LenB(strFileType & "类型") + 1)
Dim KeyId2 As Long
Call RegCreateKey(KeyId1, "DefaultIcon", KeyId2)
Call RegSetValueEx(KeyId2, "", 0&, REG_SZ, ByVal ExePathFile & ",0", Len(ExePathFile & ",0") + 1)
Dim KeyId3 As Long
Call RegCreateKey(KeyId1, "Shell", KeyId3)
Dim KeyId4 As Long
Call RegCreateKey(KeyId3, "Open", KeyId4)
Dim KeyId5 As Long
Call RegCreateKey(KeyId4, "command", KeyId5)
Call RegSetValueEx(KeyId5, "", 0&, REG_SZ, ByVal ExePathFile & " %1", Len(ExePathFile & " %1") + 1)
'MsgBox "创建自定义类型后缀名成功。", vbInformation, "系统提示"
End Sub用法:
Call SetFileType("csp", strEXEPathFile)
“csp”是文件后缀名。
strEXEPathFile 是打开这个后缀名的 Exe 文件完整路径。双击文件时,就会调用你自己定义的程序打开。
在Form_load 过程中用command参数可以传入被打开文件的完整路径名和文件名。
fishzone 没有你的方法 但是我还是给你分
见刚才...ft...
如果没有错的话,应该是rm文件的路经合文件名。
然后就是你自己的处理方法啦。