Private Declare Function SHGetSpecialFolderLocation Lib "Shell32" (ByVal hwndOwner As Long, ByVal nFolder As Integer, ppidl As Long) As Long
Private Declare Function SHGetPathFromIDList Lib "Shell32" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal szPath As String) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Const MAX_LEN = 200 '字符串最大長度
Const DESKTOP = &H0& '桌面
Const PROGRAMS = &H2& '程序集
Const MYDOCUMENTS = &H5& '我的文檔
Const MYFAVORITES = &H6& '收藏夾
Const STARTUP = &H7& '啟動
Const RECENT = &H8& '最近打開的文件
Const SENDTO = &H9& '發(fā)送
Const STARTMENU = &HB& '開始菜單
Const NETHOOD = &H13& '網(wǎng)上鄰居
Const FONTS = &H14& '字體
Const SHELLNEW = &H15& 'ShellNew
Const APPDATA = &H1A& 'Application Data
Const PRINTHOOD = &H1B& 'PrintHood
Const PAGETMP = &H20& '網(wǎng)頁臨時(shí)文件
Const COOKIES = &H21& 'Cookies目錄
Const HISTORY = &H22& '歷史
Private Sub Form_Load()
Dim sTmp As String * MAX_LEN '存放結(jié)果的固定長度的字符串
Dim nLength As Long '字符串的實(shí)際長度
Dim pidl As Long '某特殊目錄在特殊目錄列表中的位置
'*************************獲得Windows目錄**********************************
Length = GetWindowsDirectory(sTmp, MAX_LEN)
txtWin.Text = Left(sTmp, Length)
'*************************獲得System目錄***********************************
Length = GetSystemDirectory(sTmp, MAX_LEN)
txtSystem.Text = Left(sTmp, Length)
'*************************獲得Temp目錄***********************************
Length = GetTempPath(MAX_LEN, sTmp)
txtTemp.Text = Left(sTmp, Length)
'*************************獲得DeskTop目錄**********************************
SHGetSpecialFolderLocation 0, DESKTOP, pidl
SHGetPathFromIDList pidl, sTmp
txtDesktop.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
'*************************獲得發(fā)送到目錄**********************************
SHGetSpecialFolderLocation 0, SENDTO, pidl
SHGetPathFromIDList pidl, sTmp
txtSendTo.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
'*************************獲得我的文檔目錄*********************************
SHGetSpecialFolderLocation 0, MYDOCUMENTS, pidl
SHGetPathFromIDList pidl, sTmp
txtDocument.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
'*************************獲得程序集目錄***********************************
SHGetSpecialFolderLocation 0, PROGRAMS, pidl
SHGetPathFromIDList pidl, sTmp
txtProgram.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
'*************************獲得啟動目錄*************************************
SHGetSpecialFolderLocation 0, STARTUP, pidl
SHGetPathFromIDList pidl, sTmp
txtStart.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
'*************************獲得開始菜單目錄*********************************
SHGetSpecialFolderLocation 0, STARTMENU, pidl
SHGetPathFromIDList pidl, sTmp
txtStartMenu.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
'*************************獲得收藏夾目錄***********************************
SHGetSpecialFolderLocation 0, MYFAVORITES, pidl
SHGetPathFromIDList pidl, sTmp
txtFavorites.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
'**********************獲得最后打開的文件目錄*******************************
SHGetSpecialFolderLocation 0, RECENT, pidl
SHGetPathFromIDList pidl, sTmp
txtRecent.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
'*************************獲得網(wǎng)上鄰居目錄*********************************
SHGetSpecialFolderLocation 0, NETHOOD, pidl
SHGetPathFromIDList pidl, sTmp
txtNetHood.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
'*************************獲得字體目錄**********************************
SHGetSpecialFolderLocation 0, FONTS, pidl
SHGetPathFromIDList pidl, sTmp
txtFonts.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
'*************************獲得Cookies目錄**********************************
SHGetSpecialFolderLocation 0, COOKIES, pidl
SHGetPathFromIDList pidl, sTmp
txtCookies.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
'*************************獲得歷史目錄**********************************
SHGetSpecialFolderLocation 0, HISTORY, pidl
SHGetPathFromIDList pidl, sTmp
txtHistory.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
'***********************獲得網(wǎng)頁臨時(shí)文件目錄*******************************
SHGetSpecialFolderLocation 0, PAGETMP, pidl
SHGetPathFromIDList pidl, sTmp
txtPageTmp.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
'*************************獲得ShellNew目錄*********************************
SHGetSpecialFolderLocation 0, SHELLNEW, pidl
SHGetPathFromIDList pidl, sTmp
txtShellNew.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
'***********************獲得Application Data目錄*****************************
SHGetSpecialFolderLocation 0, APPDATA, pidl
SHGetPathFromIDList pidl, sTmp
txtAppData.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
'*************************獲得PrintHood目錄*********************************
SHGetSpecialFolderLocation 0, PRINTHOOD, pidl
SHGetPathFromIDList pidl, sTmp
txtPrintHood.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Sub