Attribute VB_Name = "DiskSystem"
Option Explicit

'*******************************磁盤系統(tǒng)相關(guān)函數(shù)*******************************
'*作者：謝建軍                                                                *
'*創(chuàng)建日期：2003年09月24日  13：43                                            *
'******************************************************************************
'*  返回指定磁盤的相關(guān)信息                                                    *
'*  1.GetDiskInformation(ByVal cPath As String) As DiskInformation            *
'*  返回系統(tǒng)當(dāng)前的所有驅(qū)動(dòng)器的盤符                                            *
'*  2.GetAllDisk() As String                                                  *
'*  設(shè)置指定磁盤的卷標(biāo)                                                        *
'*  3.SetDiskVol(ByVal cPath As String, ByVal cVolString As String) As Boolean*
'******************************************************************************

'返回磁盤信息(卷標(biāo)、序列號、文件系統(tǒng)名稱、最大文件名長度)
Private Declare Function GetVolumeInformation Lib "kernel32" _
    Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, _
    ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
    lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
    lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
    ByVal nFileSystemNameSize As Long) As Long

'設(shè)置指定磁盤的卷標(biāo)
Private Declare Function SetVolumeLabel Lib "kernel32" Alias "SetVolumeLabelA" (ByVal lpRootPathName As String, ByVal lpVolumeName As String) As Long

'返回磁盤大小包括剩余空間大小
Private 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

'返回所有驅(qū)動(dòng)器盤符
Private Declare Function GetLogicalDrives Lib "kernel32" () As Long

'返回磁盤類型
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
''磁盤類型枚舉
'Public Enum DiskType
'    DRIVE_CDROM = 5
'    DRIVE_FIXED = 3
'    DRIVE_RAMDISK = 6
'    DRIVE_REMOTE = 4
'    DRIVE_REMOVABLE = 2
'    DRIVE_UNKNOW = 0
'    NOTHISDRIVE = 1
'End Enum

''磁盤信息結(jié)構(gòu)
'Public Type DiskInformation
'    DiskType As DiskType '磁盤類型
'    DiskVol As String '磁盤卷標(biāo)
'    DiskSerNum As Long '磁盤序列號
'    DiskFSName As String '文件系統(tǒng)名稱
'    MaxFNLen As Long '最大文件名長度
'    TotalSpace(2) As Long '總的磁盤空間(Byte/Sector,Sector/Cluster,TotalCluster)
'    FreeSpace(2) As Long '剩余磁盤空間
'End Type


'返回指定磁盤的相關(guān)信息
Public Function GetDiskInformation(ByVal cPath As String) As DiskInformation
    cPath = Left(Trim$(cPath), 1) + ":\"
    Dim tType As Long, tVol As String, tSer As Long
    Dim tFSN As String, tMaxLen As Long, tSysFlag As Long
    Dim tVal As Long
    'Get Disk Type
    tType = GetDriveType(cPath)
    GetDiskInformation.DiskType = tType
    If tType = 1 Then Exit Function
    
    'Get Vol,Ser,Fsn,Maxlen
    tVol = String(256, Chr(0)): tFSN = String(256, Chr(0))
    tVal = GetVolumeInformation(cPath, tVol, 256, tSer, tMaxLen, _
        tSysFlag, tFSN, 256)
    tVol = Left(tVol, InStr(1, tVol, Chr(0)) - 1)
    tFSN = Left(tFSN, InStr(1, tFSN, Chr(0)) - 1)
    If tVal <> 0 Then
        GetDiskInformation.DiskVol = tVol
        GetDiskInformation.DiskSerNum = tSer
        GetDiskInformation.MaxFNLen = tMaxLen
        GetDiskInformation.DiskFSName = tFSN
    End If
    
    'GetDiskSpace include Free Space
    Dim SectorsPerCluster As Long, BytesPerSector As Long
    Dim NumberOfFreeClusters As Long, TotalClusters As Long
    tVal = GetDiskFreeSpace(cPath, SectorsPerCluster, BytesPerSector, NumberOfFreeClusters, TotalClusters)
    If tVal <> 0 Then
        GetDiskInformation.TotalSpace(0) = BytesPerSector
        GetDiskInformation.TotalSpace(1) = SectorsPerCluster
        GetDiskInformation.TotalSpace(2) = TotalClusters
        GetDiskInformation.FreeSpace(0) = BytesPerSector
        GetDiskInformation.FreeSpace(1) = SectorsPerCluster
        GetDiskInformation.FreeSpace(2) = NumberOfFreeClusters
    End If
End Function

'返回系統(tǒng)當(dāng)前的所有驅(qū)動(dòng)器的盤符
Public Function GetAllDisk() As String
    Dim tVal As Long, tStr As String, tI As Integer
    tVal = GetLogicalDrives
    tStr = ""
    For tI = 1 To 26
        If (tVal And 2 ^ (tI - 1)) > 0 Then
            If tStr = "" Then
                tStr = Chr(64 + tI) + ":\"
            Else
                tStr = tStr + "," + Chr(64 + tI) + ":\"
            End If
        End If
    Next
    GetAllDisk = tStr
End Function

'設(shè)置指定磁盤的卷標(biāo)
Public Function SetDiskVol(ByVal cPath As String, ByVal cVolString As String) As Boolean
    cPath = Left(Trim$(cPath), 1) + ":\"
    SetDiskVol = SetVolumeLabel(cPath, cVolString) <> 0
End Function

'格式化磁盤
Public Function FormatDisk(ByVal cPath As String) As Boolean
    cPath = Left(Trim$(cPath), 1) + ":\"
End Function