'***********************************************************
'**模 块 名         GetFolderS
'**作    用         获取WINDOWS特殊目录
'**作    者         石陆
'**制作日期         2007 / 12 / 4
'**修    改
'**修改日期
'**石陆软件屋       http://www.cnng.net
'***********************************************************
Option Explicit

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 '字符串最大长度

Public Enum SpecialFolder
    WIN_WINDOWS = &H24& '自己定的
    WIN_SYSTEM = &H25& '自己定的
    WIN_PROGRAMFILES = &H26& 'c:\programfils
    WIN_TEMP = &H33& '自己定的
    USER_DESKTOP = &H0& '桌面
    USER_PROGRAMS = &H2& '程序集
    USER_MYDOCUMENTS = &H5& '我的文档
    USER_MYFAVORITES = &H6& '收藏夹
    USER_STARTUP = &H7& '启动
    USER_RECENT = &H8& '最近打开的文件
    SENDTO = &H9& '发送
    USER_STARTMENU = &HB& '开始菜单
    NETHOOD = &H13& '网上邻居
    WIN_Fonts = &H14& '字体
    SHELLNEW = &H15& 'ShellNew
    ALL_STARTMENU = &H16& '所有用户的开始菜单
    ALL_PROGRAMS = &H17& '所有用户的开始程序菜单
    ALL_STARTUP = &H18& '所有用户的启动菜单
    ALL_DESKTOP = &H19& '所有用户的桌面
    APPDATA = &H1A& 'Application Data
    PRINTHOOD = &H1B& 'PrintHood
    PAGETMP = &H20& '网页临时文件
    COOKIES = &H21& 'Cookies目录
    HISTORY = &H22& '历史
    
End Enum


'***********************************************************
'**函 数 名         GetSpecialFolder
'**作    用         获取WINDOWS特殊目录
'**作    者         石陆
'**制作日期         2007 / 12 / 4
'**修    改
'**修改日期
'**石陆软件屋       http://www.cnng.net
'***********************************************************
Public Function GetSpecialFolder(sName As SpecialFolder) As String
    Dim sTmp As String * MAX_LEN  '存放结果的固定长度的字符串
    Dim nLength As Long  '字符串的实际长度
    Dim pidl As Long  '某特殊目录在特殊目录列表中的位置
    Select Case sName
        Case &H24&
            nLength = GetWindowsDirectory(sTmp, MAX_LEN)
            GetSpecialFolder = Left(sTmp, nLength)
        Case &H25&
            nLength = GetSystemDirectory(sTmp, MAX_LEN)
            GetSpecialFolder = Left(sTmp, nLength)
        Case &H33&
            nLength = GetTempPath(MAX_LEN, sTmp)
            GetSpecialFolder = Left(sTmp, nLength)
        Case &H26& 'c:\programfils
            SHGetSpecialFolderLocation 0, sName, pidl
            SHGetPathFromIDList pidl, sTmp
            GetSpecialFolder = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
        Case &H0&
            SHGetSpecialFolderLocation 0, sName, pidl
            SHGetPathFromIDList pidl, sTmp
            GetSpecialFolder = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
        Case &H2&
            SHGetSpecialFolderLocation 0, sName, pidl
            SHGetPathFromIDList pidl, sTmp
            GetSpecialFolder = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
        Case &H5&
            SHGetSpecialFolderLocation 0, sName, pidl
            SHGetPathFromIDList pidl, sTmp
            GetSpecialFolder = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
        Case &H6&
            SHGetSpecialFolderLocation 0, sName, pidl
            SHGetPathFromIDList pidl, sTmp
            GetSpecialFolder = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
        Case &H7&
            SHGetSpecialFolderLocation 0, sName, pidl
            SHGetPathFromIDList pidl, sTmp
            GetSpecialFolder = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
        Case &H8&
            SHGetSpecialFolderLocation 0, sName, pidl
            SHGetPathFromIDList pidl, sTmp
            GetSpecialFolder = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
        Case &H9&
            SHGetSpecialFolderLocation 0, sName, pidl
            SHGetPathFromIDList pidl, sTmp
            GetSpecialFolder = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
        Case &HB&
            SHGetSpecialFolderLocation 0, sName, pidl
            SHGetPathFromIDList pidl, sTmp
            GetSpecialFolder = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
        Case &H13& '网上邻居
            SHGetSpecialFolderLocation 0, sName, pidl
            SHGetPathFromIDList pidl, sTmp
            GetSpecialFolder = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
        Case &H14& '字体
            SHGetSpecialFolderLocation 0, sName, pidl
            SHGetPathFromIDList pidl, sTmp
            GetSpecialFolder = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
        Case &H15&
            SHGetSpecialFolderLocation 0, sName, pidl
            SHGetPathFromIDList pidl, sTmp
            GetSpecialFolder = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
        Case &H16&
            SHGetSpecialFolderLocation 0, sName, pidl
            SHGetPathFromIDList pidl, sTmp
            GetSpecialFolder = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
        Case &H17&
            SHGetSpecialFolderLocation 0, sName, pidl
            SHGetPathFromIDList pidl, sTmp
            GetSpecialFolder = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
        Case &H18&
            SHGetSpecialFolderLocation 0, sName, pidl
            SHGetPathFromIDList pidl, sTmp
            GetSpecialFolder = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
        Case &H19&
            SHGetSpecialFolderLocation 0, sName, pidl
            SHGetPathFromIDList pidl, sTmp
            GetSpecialFolder = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
        Case &H1A&
            SHGetSpecialFolderLocation 0, sName, pidl
            SHGetPathFromIDList pidl, sTmp
            GetSpecialFolder = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
        Case &H1B& 'PrintHood
            SHGetSpecialFolderLocation 0, sName, pidl
            SHGetPathFromIDList pidl, sTmp
            GetSpecialFolder = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
        Case &H20& '网页临时文件
            SHGetSpecialFolderLocation 0, sName, pidl
            SHGetPathFromIDList pidl, sTmp
            GetSpecialFolder = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
        Case &H21&  'Cookies目录
            SHGetSpecialFolderLocation 0, sName, pidl
            SHGetPathFromIDList pidl, sTmp
            GetSpecialFolder = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
        Case &H22& '历史
            SHGetSpecialFolderLocation 0, sName, pidl
            SHGetPathFromIDList pidl, sTmp
            GetSpecialFolder = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
    End Select
'35,36,37,38
    GetSpecialFolder = IIf(Right$(GetSpecialFolder, 1) = "\", GetSpecialFolder, GetSpecialFolder & "\")
    sTmp = ""
End Function