module1.bas

很好的教程原代码！

Attribute VB_Name = "Module1"
Option Explicit
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
    "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath _
    As String) As Long
Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
    (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As _
    ITEMIDLIST) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
    "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Type SHITEMID
     cb As Long
     abID As Byte
End Type

Type ITEMIDLIST
     mkid As SHITEMID
End Type

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

Public Const NOERROR = 0

Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000

' 获取磁盘剩余空间
Declare Function GetDiskFreeSpace Lib "kernel32" Alias _
    "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, _
    lpSectorsPerCluster As Long, lpBytesPerSector As Long, _
    lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters _
    As Long) As Long
' 执行文件结构体
Type SHELLEXECUTEINFO
    cbSize As Long
    fMask As Long
    hwnd As Long
    lpVerb As String
    lpFile As String
    lpParameters  As String
    lpDirectory   As String
    nShow As Long
    hInstApp As Long
    lpIDList      As Long
    lpClass       As String
    hkeyClass     As Long
    dwHotKey      As Long
    hIcon         As Long
    hProcess      As Long
End Type
Public Const SEE_MASK_INVOKEIDLIST = &HC
Public Const SEE_MASK_NOCLOSEPROCESS = &H40
Public Const SEE_MASK_FLAG_NO_UI = &H400
Declare Function ShellExecuteEX Lib "shell32.dll" Alias _
    "ShellExecuteEx" (SEI As SHELLEXECUTEINFO) As Long

' 获取磁盘剩余空间
Public Function DiskSpaceInBytes(drvPath As String) As Double
    Dim Drive As String
    Dim BytesPerSector As Long
    Dim SectorsPerCluster As Long
    Dim NumberOfFreeClusters As Long
    Dim TotalNumberOfClusters As Long
  
    Drive = Left(drvPath, 1) & ":\"
    
    If GetDiskFreeSpace(Drive, BytesPerSector, SectorsPerCluster, _
            NumberOfFreeClusters, TotalNumberOfClusters) <> 0 Then
        DiskSpaceInBytes = (BytesPerSector * SectorsPerCluster * NumberOfFreeClusters)
    Else
        DiskSpaceInBytes = -1
    End If
End Function