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 Long
Public 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 Function
Public 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 Function
Public 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