VB Shell32 的外壳函数库 代码

Attribute VB_Name  =   " Shell32Function "
Option   Explicit
Private   Declare   Sub CopyMemory() Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Long, pSrc As Long, ByVal ByteLen As Long)

Private Declare Function SHBrowseForFolder()Function SHBrowseForFolder Lib "shell32" Alias "SHBrowseForFolderA" ( _
                                                lpBrowseInfo As BROWSEINFO) As Long

Private Declare Function SHGetSpecialFolderLocation()Function SHGetSpecialFolderLocation Lib "shell32" ( _
                                                ByVal hwndOwner As Long, _
                                                ByVal nFolder As Long, _
                                                pIdl As ITEMIDLIST) As Long
                                                
'Private Declare Function SHGetFileInfo Lib "shell32" Alias "SHGetFileInfoA" ( _
                                                ByVal pszPath As Any, _
                                                ByVal dwFileAttributes As Long, _
                                                psfi As SHFILEINFO, _
                                                ByVal cbFileInfo As Long, _
                                                ByVal uFlags As Long) As Long
                                                
Private Declare Function ShellAbout()Function ShellAbout Lib "shell32" Alias "ShellAboutA" ( _
                                                ByVal hwnd As Long, _
                                                ByVal szApp As String, _
                                                ByVal szOtherStuff As String, _
                                                ByVal HIcon As Long) As Long
                                                
Private Declare Function SHGetPathFromIDList()Function SHGetPathFromIDList Lib "shell32" Alias "SHGetPathFromIDListA" ( _
                                                ByVal pIdl As Long, _
                                                ByVal pszPath As String) As Long
                                                
'Private Declare Function SHAddToRecentDocs Lib "shell32" ( _
                                                ByVal uFlags As Long, _
                                                ByVal pV As String)
                                                
                                                
Private Declare Function SHFormatDrive()Function SHFormatDrive Lib "shell32" ( _
                                                hwnd As Long, _
                                                iDrive As Long, _
                                                iCapacity As Long, _
                                                iType As Long) As Long
                                                
Private Declare Sub CoTaskMemFree()Sub CoTaskMemFree Lib "ole32" (ByVal pV As Long)

Private Type SHITEMID
    cb As Long
    abID() As Byte
End Type

Private Type ITEMIDLIST
    mkid As SHITEMID
End Type

Private Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type
Private Const MAX_PATH = 260

'Private Type SHFILEINFO
'    HIcon As Long
'    iIcon As Long
'    dwAttributes As Long
'    szDisplayName As String * MAX_PATH
'    szTypeName As String * 80
'End Type
Private Const ERROR_SUCCESS = 0&


Private Const CSIDL_DESKTOP = &H0                           '// <desktop>
Private Const CSIDL_INTERNET = &H1                          '// Internet Explorer (icon on desktop)
Private Const CSIDL_PROGRAMS = &H2                          '// Start MenuPrograms