模块:
Option ExplicitPublic Const HKEY_USERS = &H80000003Public Const REG_SZ = 1
Public Const REG_EXPAND_SZ = 2
Public Const REG_DWORD = 4
Public Const REG_DWORD_BIG_ENDIAN = 5
Public Const REG_MULTI_SZ = 7Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue 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 ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long) As LongSub MultiStringToStringArray(S As String, S2() As String)
Dim count As Integer, pos As Integer, pos2 As Integer, idx As Integer
pos = InStr(S, Chr(0))
While pos > 0
count = count + 1
pos = InStr(pos + 1, S, Chr(0))
Wend
count = count - 1
ReDim S2(0 To count - 1)
pos = 1
For idx = 0 To count - 1
pos2 = InStr(pos, S, Chr(0))
S2(idx) = Mid(S, pos, pos2 - pos)
pos = pos2 + 1
Next
End Sub
窗体:
Option ExplicitPrivate Sub Command1_Click()
Shell "RegEdit " & App.Path & "\kjAPI.reg", vbNormalFocus
End SubPrivate Sub Command2_Click()
Dim hKey As Long, ret As Long, lenData As Long, typeData As Long
Dim Name As String, NameList(0 To 1) As String
Dim i As Integer, j As Integer
ret = RegOpenKey(HKEY_CURRENT_USER, "Software\kjAPI", hKey)
If ret <> 0 Then Exit Sub
NameList(0) = ""
NameList(1) = "Personal"
For i = 0 To UBound(NameList)
Name = NameList(i)
ret = RegQueryValueEx(hKey, Name, 0, typeData, ByVal vbNullString, lenData)
If ret <> 0 Then
RegCloseKey hKey
Exit Sub
End If
Select Case typeData
Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ
Dim S As String
S = String(lenData, Chr(0))
RegQueryValueEx hKey, Name, 0, typeData, ByVal S, lenData
If typeData = REG_SZ Then
S = Left(S, InStr(S, Chr(0)) - 1)
Text1.SelText = IIf(Name = "", "(预设值)", Name) & " = " & S & vbCrLf
ElseIf typeData = REG_EXPAND_SZ Then
Dim S2 As String
S2 = String(Len(S) + 256, Chr(0))
ExpandEnvironmentStrings S, S2, Len(S2)
S = Left(S2, InStr(S2, Chr(0)) - 1)
Text1.SelText = Name & " = " & S & vbCrLf
ElseIf typeData = REG_MULTI_SZ Then
Dim SArr() As String
MultiStringToStringArray S, SArr
For j = 0 To UBound(SArr)
Text1.SelText = Name & "(" & j & ") = " & SArr(j) & vbCrLf
Next
End If
Case REG_DWORD, REG_DWORD_BIG_ENDIAN
Dim L As Long
RegQueryValueEx hKey, Name, 0, typeData, L, lenData
Text1.SelText = Name & " = " & L & vbCrLf
End Select
Next
RegCloseKey hKey
End Sub
Option ExplicitPublic Const HKEY_USERS = &H80000003Public Const REG_SZ = 1
Public Const REG_EXPAND_SZ = 2
Public Const REG_DWORD = 4
Public Const REG_DWORD_BIG_ENDIAN = 5
Public Const REG_MULTI_SZ = 7Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue 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 ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long) As LongSub MultiStringToStringArray(S As String, S2() As String)
Dim count As Integer, pos As Integer, pos2 As Integer, idx As Integer
pos = InStr(S, Chr(0))
While pos > 0
count = count + 1
pos = InStr(pos + 1, S, Chr(0))
Wend
count = count - 1
ReDim S2(0 To count - 1)
pos = 1
For idx = 0 To count - 1
pos2 = InStr(pos, S, Chr(0))
S2(idx) = Mid(S, pos, pos2 - pos)
pos = pos2 + 1
Next
End Sub
窗体:
Option ExplicitPrivate Sub Command1_Click()
Shell "RegEdit " & App.Path & "\kjAPI.reg", vbNormalFocus
End SubPrivate Sub Command2_Click()
Dim hKey As Long, ret As Long, lenData As Long, typeData As Long
Dim Name As String, NameList(0 To 1) As String
Dim i As Integer, j As Integer
ret = RegOpenKey(HKEY_CURRENT_USER, "Software\kjAPI", hKey)
If ret <> 0 Then Exit Sub
NameList(0) = ""
NameList(1) = "Personal"
For i = 0 To UBound(NameList)
Name = NameList(i)
ret = RegQueryValueEx(hKey, Name, 0, typeData, ByVal vbNullString, lenData)
If ret <> 0 Then
RegCloseKey hKey
Exit Sub
End If
Select Case typeData
Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ
Dim S As String
S = String(lenData, Chr(0))
RegQueryValueEx hKey, Name, 0, typeData, ByVal S, lenData
If typeData = REG_SZ Then
S = Left(S, InStr(S, Chr(0)) - 1)
Text1.SelText = IIf(Name = "", "(预设值)", Name) & " = " & S & vbCrLf
ElseIf typeData = REG_EXPAND_SZ Then
Dim S2 As String
S2 = String(Len(S) + 256, Chr(0))
ExpandEnvironmentStrings S, S2, Len(S2)
S = Left(S2, InStr(S2, Chr(0)) - 1)
Text1.SelText = Name & " = " & S & vbCrLf
ElseIf typeData = REG_MULTI_SZ Then
Dim SArr() As String
MultiStringToStringArray S, SArr
For j = 0 To UBound(SArr)
Text1.SelText = Name & "(" & j & ") = " & SArr(j) & vbCrLf
Next
End If
Case REG_DWORD, REG_DWORD_BIG_ENDIAN
Dim L As Long
RegQueryValueEx hKey, Name, 0, typeData, L, lenData
Text1.SelText = Name & " = " & L & vbCrLf
End Select
Next
RegCloseKey hKey
End Sub
Dim x As New IWshRuntimeLibrary.IWshShell_Class
MsgBox x.SpecialFolders.Item("MyDocuments")AllUsersDesktop
AllUsersStartMenu
AllUsersPrograms
AllUsersStartup
AppData
Desktop
Favorites
Fonts
MyDocuments
NetHood
PrintHood
Programs
Recent
SendTo
StartMenu
Startup
Templates
参阅:
关于"快捷方式"的几个问题 (引用 Windows Script Host Model) ....
http://www.csdn.net/expert/topic/214/214456.shtm
ITEMIDLIST *pidl=NULL;
SHGetSpecialFolderLocation(m_hWnd,CSIDL_PERSONAL,&pidl);
SHGetPathFromIDList(pidl,path); cout<<"My Document path is:"<<pat<<endl;
我用 vb ,大哥!
SHGetSpecialFolderPath(m_hWnd,dpath,CSIDL_PERSONAL,false);