Option Explicit


'-------------------------------------------------------
'CONSTANTES
'-------------------------------------------------------
Private Const GENERIC_READ                  As Long = &H80000000
Private Const FILE_SHARE_READ              As Long = &H1
Private Const FILE_SHARE_WRITE              As Long = &H2
Private Const OPEN_EXISTING                As Long = 3

   

'-------------------------------------------------------
'TYPES & ENUMS
'-------------------------------------------------------
Public Enum SPECIAL_FOLDER_TYPE
    CSIDL_DESKTOP = &H0                '{desktop}
    CSIDL_INTERNET = &H1                'Internet Explorer (icon on desktop)
    CSIDL_PROGRAMS = &H2                'Start Menu\Programs
    CSIDL_CONTROLS = &H3                'My Computer\Control Panel
    CSIDL_PRINTERS = &H4                'My Computer\Printers
    CSIDL_PERSONAL = &H5                'My Documents
    CSIDL_FAVORITES = &H6              '{user}\Favourites
    CSIDL_STARTUP = &H7                'Start Menu\Programs\Startup
    CSIDL_RECENT = &H8                  '{user}\Recent
    CSIDL_SENDTO = &H9                  '{user}\SendTo
    CSIDL_BITBUCKET = &HA              '{desktop}\Recycle Bin
    CSIDL_STARTMENU = &HB              '{user}\Start Menu
    CSIDL_DESKTOPDIRECTORY = &H10      '{user}\Desktop
    CSIDL_DRIVES = &H11                'My Computer
    CSIDL_NETWORK = &H12                'Network Neighbourhood
    CSIDL_NETHOOD = &H13                '{user}\nethood
    CSIDL_FONTS = &H14                  'windows\fonts
    CSIDL_TEMPLATES = &H15
    CSIDL_COMMON_STARTMENU = &H16      'All Users\Start Menu
    CSIDL_COMMON_PROGRAMS = &H17        'All Users\Programs
    CSIDL_COMMON_STARTUP = &H18        'All Users\Startup
    CSIDL_COMMON_DESKTOPDIRECTORY = &H19 'All Users\Desktop
    CSIDL_APPDATA = &H1A                '{user}\Application Data
    CSIDL_PRINTHOOD = &H1B              '{user}\PrintHood
    CSIDL_LOCAL_APPDATA = &H1C          '{user}\Local Settings\Application Data (non roaming)
    CSIDL_ALTSTARTUP = &H1D            'non localized startup
    CSIDL_COMMON_ALTSTARTUP = &H1E      'non localized common startup
    CSIDL_COMMON_FAVORITES = &H1F
    CSIDL_INTERNET_CACHE = &H20
    CSIDL_COOKIES = &H21
    CSIDL_HISTORY = &H22
    CSIDL_COMMON_APPDATA = &H23          'All Users\Application Data
    CSIDL_WINDOWS = &H24                'GetWindowsDirectory()
    CSIDL_SYSTEM = &H25                  'GetSystemDirectory()
    CSIDL_PROGRAM_FILES = &H26          'C:\Program Files
    CSIDL_MYPICTURES = &H27              'C:\Program Files\My Pictures
    CSIDL_PROFILE = &H28                'USERPROFILE
    CSIDL_SYSTEMX86 = &H29              'x86 system directory on RISC
    CSIDL_PROGRAM_FILESX86 = &H2A        'x86 C:\Program Files on RISC
    CSIDL_PROGRAM_FILES_COMMON = &H2B    'C:\Program Files\Common
    CSIDL_PROGRAM_FILES_COMMONX86 = &H2C 'x86 Program Files\Common on RISC
    CSIDL_COMMON_TEMPLATES = &H2D        'All Users\Templates
    CSIDL_COMMON_DOCUMENTS = &H2E        'All Users\Documents
    CSIDL_COMMON_ADMINTOOLS = &H2F      'All Users\Start Menu\Programs\Administrative Tools
    CSIDL_ADMINTOOLS = &H30              '{user}\Start Menu\Programs\Administrative Tools
End Enum
Private Type SHITEMID
    cb As Long
    abID As Byte
End Type
Private Type ITEMIDLIST
    mkid As SHITEMID
End Type



'-------------------------------------------------------
'APIS
'-------------------------------------------------------
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function GetFileSizeEx Lib "kernel32" (ByVal hFile As Long, lpFileSize As Currency) As Boolean
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long


'-------------------------------------------------------
'obtient le programme associé à un fichier
'-------------------------------------------------------
Public Function GetAssociatedExecutableProgram(ByVal sFile As String) As String
Dim sBuf As String

    sBuf = String$(255, 0)  'création d'un buffer
   
    'trouve l'éxécutable associé
    FindExecutable sFile, vbNullString, sBuf
   
    'formate la string
    GetAssociatedExecutableProgram = Left$(sBuf, InStr(sBuf, vbNullChar) - 1)

End Function

'-------------------------------------------------------
'obtient la taille d'un fichier, même si celle ci est supérieure à 4Go (long)
'-------------------------------------------------------
Public Function GetFileSize(ByVal sFile As String) As Currency
Dim lngFile As Long
Dim curSize As Currency

    'obtient le handle du fichier
    lngFile = CreateFile(sFile, GENERIC_READ, FILE_SHARE_WRITE Or FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, ByVal 0&, ByVal 0&)
   
    'obtient la taille par API
    GetFileSizeEx lngFile, curSize
   
    'ferme le handle ouvert
    CloseHandle lngFile
   
    GetFileSize = curSize * 10000 'multiplie par 10^4 pour obtenir un nombre entier
End Function

'-------------------------------------------------------
'obtient un path spécial
'-------------------------------------------------------
Public Function GetSpecialFolder(Folder As SPECIAL_FOLDER_TYPE, Optional ByVal hwnd As Long) As String
Dim ret As Long
Dim sPath As String
Dim IDL As ITEMIDLIST

    'obtient le path
    ret = SHGetSpecialFolderLocation(hwnd, Folder, IDL)
   
    If ret = 0 Then
        'création d'un buffer
        sPath = Space$(512) '512 > MAX_PATH
        'obtient le path depuis l'itemidlist
        ret = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath)
        'formate le texte
        GetSpecialFolder = Left$(sPath, InStr(sPath, vbNullChar) - 1)
        Exit Function
    End If
   
    GetSpecialFolder = vbNullString
End Function