获取windwos中的所有可见目录

icecept

'**************************************************************************
'**模 块 名：工程1 - Form1
'**说    明：魔灵圣域 版权所有2007 - 2008(C)
'**创 建 人：郭卫(魔灵)
'**日    期：2007-12-27 01:08:17
'**修 改 人：郭卫
'**日    期：
'**描    述：郭卫制作
'**版    本：V1.0.0    http://icecept.blog.sohu.com
'*************************************************************************
Option Explicit
'获取系统路径的API函数
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
'获取TEMP临时文件路径的API函数
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
'获取WINDOWS路径
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
'获取文件夹路径S路径
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
Const DESKTOP = &H0& '桌面
Const PROGRAMS = &H2& '程序集
Const MYDOCUMENTS = &H5& '我的文档
Const MYFAVORITES = &H6& '收藏夹
Const STARTUP = &H7& '启动
Const RECENT = &H8& '最近打开的文件
Const SENDTO = &H9& '发送
Const STARTMENU = &HB& '开始菜单
Const NETHOOD = &H13& '网上邻居
Const FONTS = &H14& '字体
Const SHELLNEW = &H15& 'ShellNew
Const APPDATA = &H1A& 'Application Data
Const PrnHood = &H1B& 'PrintHood
Const PAGETMP = &H20& '网页临时文件
Const COOKIES = &H21& 'Cookies目录|
Const HISTORY = &H22& '历史
Private Sub command1_Click()
    Me.Caption = "获取系统路径"
    Me.Cls
    '也可以用 MsgBox Environ("windir")  & "\system32" 来实现
    Label1.Caption = GetWinSys()
End Sub
Private Sub Command10_Click()
    Me.Caption = "获取收藏夹路径"
    Me.Cls
    Label1.Caption = GetMyFavorites
End Sub
Private Sub Command11_Click()
    Me.Caption = "获取最后打开的文件路径"
    Me.Cls
    Label1.Caption = GetRecent
End Sub
Private Sub Command12_Click()
    Me.Caption = "获取网上邻居路径"
    Me.Cls
    Label1.Caption = GetNetHood
End Sub
Private Sub Command13_Click()
End Sub
Private Sub Command14_Click()
    Me.Caption = "获取字体路径"
    Me.Cls
    Label1.Caption = GetFonts
End Sub
Private Sub Command15_Click()
    Me.Caption = "获取cook路径"
    Me.Cls
    Label1.Caption = GetCookies
End Sub
Private Sub Command16_Click()
    Me.Caption = "获得历史路径"
    Me.Cls
    Label1.Caption = GetHistory
End Sub
Private Sub Command17_Click()
    Me.Caption = "获取网络临时文件路径"
    Me.Cls
    Label1.Caption = GetPageTemp
End Sub
Private Sub Command18_Click()
    Me.Caption = "获取ShellNew路径"
    Me.Cls
    Label1.Caption = GetShellNew
End Sub
Private Sub Command19_Click()
    Me.Caption = "获取Application Data路径"
    Me.Cls
    Label1.Caption = GetAppData
End Sub
Private Sub command2_click()
    Me.Caption = "获取TEMP路径"
    Me.Cls
    '也可以用 MsgBox Environ("temp") 来实现
    Label1.Caption = GetTemp()
End Sub
Private Sub Command20_Click()
    Me.Caption = "获取PrintHood路径"
    Me.Cls
    Label1.Caption = PrintHood
End Sub
Private Sub Command3_Click()
    Me.Caption = "获取桌面路径"
    Me.Cls
    Label1.Caption = GetDeskTop
End Sub
Private Sub Command4_Click()
    Me.Caption = "获取发送到路径"
    Me.Cls
    Label1.Caption = GetSendTo
End Sub
Private Sub Command5_Click()
    Me.Caption = "获取Windows路径"
    Me.Cls
    Label1.Caption = GetWinPath
End Sub
Private Sub Command6_Click()
    Me.Caption = "获取我的文档路径"
    Me.Cls
    Label1.Caption = GetMyDocuments
End Sub
Private Sub Command7_Click()
    Me.Caption = "获取程序路径"
    Me.Cls
    Label1.Caption = GetProGrams
End Sub
Private Sub Command8_Click()
    Me.Caption = "获取启动路径"
    Me.Cls
    Label1.Caption = GetStartUp
End Sub
Private Sub Command9_Click()
    Me.Caption = "获取开始菜单路径"
    Me.Cls
    Label1.Caption = GetStartMenu
End Sub
Private Sub form_load()
    Me.Icon = LoadPicture("")
End Sub
'获取系统路径
Function GetWinSys() As String
    Dim Sysdir As String * 80, Length As Long
    Length = GetSystemDirectory(Sysdir, Len(Sysdir))
    GetWinSys = Left(Sysdir, Length)
End Function
'获取Windows路径
Function GetWinPath() As String
    '也可以用 MsgBox Environ("windir")  来实现
    Dim Windir As String * 80, Length As Long
    Length = GetWindowsDirectory(Windir, Len(Windir))
    GetWinPath = Left(Windir, Length)
End Function
'获取Temp路径
Function GetTemp() As String
    Dim Temp As String * 80, Length As Long
    Length = GetTempPath(Len(Temp), Temp)
    GetTemp = Left(Temp, Length)     '返回：盘符:\temp\
    If Right(GetTemp, 1) = "\" Then '
        GetTemp = Left(GetTemp, Length - 1)
    End If
End Function
'获得桌面目录
Function GetDeskTop() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, DESKTOP, pidl
    SHGetPathFromIDList pidl, sTmp
    GetDeskTop = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得发送到目录
Function GetSendTo() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, SENDTO, pidl
    SHGetPathFromIDList pidl, sTmp
    GetSendTo = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得我的文档目录
Function GetMyDocuments() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, MYDOCUMENTS, pidl
    SHGetPathFromIDList pidl, sTmp
    GetMyDocuments = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得程序目录
Function GetProGrams() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, PROGRAMS, pidl
    SHGetPathFromIDList pidl, sTmp
    GetProGrams = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得启动目录
Function GetStartUp() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, STARTUP, pidl
    SHGetPathFromIDList pidl, sTmp
    GetStartUp = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得开始菜单目录
Function GetStartMenu() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, STARTMENU, pidl
    SHGetPathFromIDList pidl, sTmp
    GetStartMenu = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得收藏夹目录
Function GetMyFavorites() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, MYFAVORITES, pidl
    SHGetPathFromIDList pidl, sTmp
    GetMyFavorites = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得最后打开的文件目录
Function GetRecent() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, RECENT, pidl
    SHGetPathFromIDList pidl, sTmp
    GetRecent = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得网上邻居目录
Function GetNetHood() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, NETHOOD, pidl
    SHGetPathFromIDList pidl, sTmp
    GetNetHood = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得字体目录
Function GetFonts() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, FONTS, pidl
    SHGetPathFromIDList pidl, sTmp
    GetFonts = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得Cookies目录
Function GetCookies() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, COOKIES, pidl
    SHGetPathFromIDList pidl, sTmp
    GetCookies = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得历史目录
Function GetHistory() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, HISTORY, pidl
    SHGetPathFromIDList pidl, sTmp
    GetHistory = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得网页临时文件目录
Function GetPageTemp() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, PAGETMP, pidl
    SHGetPathFromIDList pidl, sTmp
    GetPageTemp = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得ShellNew目录
Function GetShellNew() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, SHELLNEW, pidl
    SHGetPathFromIDList pidl, sTmp
    GetShellNew = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得Application Data目录
Function GetAppData() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, APPDATA, pidl
    SHGetPathFromIDList pidl, sTmp
    GetAppData = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得PrintHood目录
Function PrintHood() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, PrnHood, pidl
    SHGetPathFromIDList pidl, sTmp
    PrintHood = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function

icecept

这个帖子里的附件没有人下吗？

jupiter

不错 顶一个
但是有些目录是跟用户有关的哦
下面是部分csidl 供楼主参考
Const CSIDL_ADMINTOOLS As Long = &H30             '（用户）\开始菜单\程序\系统管理工具
Const CSIDL_ALTSTARTUP As Long = &H1D             '未本地化的启动
Const CSIDL_APPDATA As Long = &H1A                '（用户）\应用程序的数据
Const CSIDL_BITBUCKET As Long = &HA               '（桌面）\回收站
Const CSIDL_CONTROLS As Long = &H3                '我的电脑\控制面板
Const CSIDL_DESKTOP As Long = &H0                 '桌面
Const CSIDL_DESKTOPDIRECTORY As Long = &H10       '（用户）\桌面
Const CSIDL_FAVORITES As Long = &H6               '（用户）\个性化设置
Const CSIDL_FONTS As Long = &H14                  'windows\字体
Const CSIDL_INTERNET As Long = &H1                'IE（桌面上的图标
Const CSIDL_INTERNET_CACHE As Long = &H20         '因特网缓存文件夹
Const CSIDL_LOCAL_APPDATA  As Long = &H1C         '（用户）\本地设置\应用程序数据
Const CSIDL_DRIVES As Long = &H11                 '我的电脑
Const CSIDL_MYPICTURES As Long = &H27             'C:\Program Files\My Pictures
Const CSIDL_NETHOOD As Long = &H13                '（用户）\网上邻居中的元素
Const CSIDL_NETWORK As Long = &H12                '网上邻居
Const CSIDL_PRINTERS As Long = &H4                '我的电脑\打印机
Const CSIDL_PRINTHOOD As Long = &H1B              '（用户）\打印机连接
Const CSIDL_PERSONAL As Long = &H5                '我的文档
Const CSIDL_PROGRAM_FILES As Long = &H26          'C:\Program Files
Const CSIDL_PROGRAM_FILESX86 As Long = &H2A       'x86 apps (Alpha)的程序文件目录
Const CSIDL_PROGRAMS As Long = &H2                '开始菜单\程序
Const CSIDL_PROGRAM_FILES_COMMON As Long = &H2B   'Program Files\Common
Const CSIDL_PROGRAM_FILES_COMMONX86 As Long = &H2C 'RISC上的x86 \Program Files\Common
Const CSIDL_RECENT As Long = &H8                  '(用户)\最近记录目录
Const CSIDL_SENDTO As Long = &H9                  '(用户)\发送到目录
Const CSIDL_STARTMENU As Long = &HB               '(用户)\开始菜单
Const CSIDL_STARTUP As Long = &H7                 '开始菜单\程序\启动
Const CSIDL_SYSTEM As Long = &H25                 'system文件夹
Const CSIDL_SYSTEMX86 As Long = &H29              'x86 apps (Alpha)的system文件夹
Const CSIDL_PROFILE As Long = &H28                '用户概貌文件夹
Const CSIDL_WINDOWS As Long = &H24                'Windows目录或SYSROOT()
Const CSIDL_COMMON_ADMINTOOLS As Long = &H2F      '（所有用户）\开始菜单\程序\系统管理工具
Const CSIDL_COMMON_ALTSTARTUP As Long = &H1E      '未本地化的通用启动
Const CSIDL_COMMON_APPDATA As Long = &H23         '（所有用户）\应用程序数据
Const CSIDL_COMMON_DESKTOPDIRECTORY As Long = &H19 '（所有用户）\桌面
Const CSIDL_COMMON_DOCUMENTS As Long = &H2E       '（所有用户）\文档
Const CSIDL_COMMON_FAVORITES As Long = &H1F       '(所有用户)\设置
Const CSIDL_COMMON_PROGRAMS As Long = &H17        '(所有用户)\程序
Const CSIDL_COMMON_STARTMENU As Long = &H16       '(所有用户)\开始菜单
Const CSIDL_COMMON_STARTUP As Long = &H18         '(所有用户)\启动
Const CSIDL_COMMON_TEMPLATES As Long = &H2D       '(所有用户)\临时

[ 本帖最后由 jupiter 于 2008-1-24 16:00 编辑 ]

icecept

谢谢了，我的资料有全了，给你加分

kiss-win

如果是常用的一些系?相?的特殊目?位置？用WSH十分方便
?先引用 Windows Script Host Object Model (%system%\wshom.ocx)

Sub PrintSpecialFolders()
Dim wsh As New WshShell
Dim i As Integer

For i = wsh.SpecialFolders.Count - 1 To 0 Step -1
Debug.Print wsh.SpecialFolders(i)
Next

Debug.Print wsh.SpecialFolders("Desktop") 　　'?得桌面目?
　　Debug.Print wsh.SpecialFolders("Fonts") 　　'?得系?字?目?
　　Debug.Print wsh.SpecialFolders("Programs") 　　'?得程序菜?目?
　　Debug.Print wsh.SpecialFolders("StartUp") 　　'?得程序??目?
　　Debug.Print wsh.SpecialFolders("Recent") 　　'?得最近使用文件目?
　　Debug.Print wsh.SpecialFolders("FAVORITES") 　　'?得收藏?目?
　　Debug.Print wsh.SpecialFolders("SENDTO") 　　'?得?送到目?
　　Debug.Print wsh.SpecialFolders("NETHOOD") 　　'?得???居目?
　　Debug.Print wsh.SpecialFolders("AppData") 　　'?得微?程序??目?
end Sub

loveyouvb

不错 呵呵

rance1031

非常感谢

r_tian_cn

不错 收藏了

icecept

5# kiss-win

在有些系统里会禁止使用脚本和FSO，因我以前就用的Windows Script Host 这种方法，却使程序在一些电脑上不通用，所以才想到了此贴的方法。

Windows Script Host 请参考：http://www.vbgood.com/viewthread.php?tid=59332&page=1#pid258405