Option ExplicitConst HKEY_CLASSES_ROOT = &H80000000Private Declare Function OSRegCreateKey Lib "Advapi32" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpszSubKey As String, phkResult As Long) As LongConst ERROR_SUCCESS = 0&Const REG_SZ = 1Private Declare Function OSRegSetValueEx Lib "Advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpszValueName As String, ByVal dwReserved As Long, ByVal fdwType As Long, lpbData As Any, ByVal cbData As Long) As LongConst SW_SHOW = 5Private Declare Function ShellExecute Lib "Shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Private Sub Command1_Click() Dim retu As Long, hKey As Long, hkey1 As Long, strdata As String strdata = "WinLSTFile" retu = OSRegCreateKey(HKEY_CLASSES_ROOT, ".lst", hKey) retu = OSRegSetValueEx(hKey, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1) retu = OSRegCreateKey(HKEY_CLASSES_ROOT, "WinLSTFile", hKey) strdata = "WinLST 文件" retu = OSRegSetValueEx(hKey, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1) retu = OSRegCreateKey(hKey, "DefaultIcon", hkey1) strdata = "Notepad.exe, 0" '应根据系统安装情况更改相对路径 retu = OSRegSetValueEx(hkey1, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1) retu = OSRegCreateKey(hKey, "shell", hKey) retu = OSRegCreateKey(hKey, "open", hKey) retu = OSRegCreateKey(hKey, "command", hkey1) strdata = "Notepad.exe " & Chr(34) & "%1" & Chr(34) retu = OSRegSetValueEx(hkey1, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1) Debug.Print hKeyEnd Sub