disksystem.bas

此文档为VB公共模块

Attribute VB_Name = "DiskSystem"
Option Explicit

'*******************************磁盘系统相关函数*******************************
'*作者：谢建军                                                                *
'*创建日期：2003年09月24日  13：43                                            *
'******************************************************************************
'*  返回指定磁盘的相关信息                                                    *
'*  1.GetDiskInformation(ByVal cPath As String) As DiskInformation            *
'*  返回系统当前的所有驱动器的盘符                                            *
'*  2.GetAllDisk() As String                                                  *
'*  设置指定磁盘的卷标                                                        *
'*  3.SetDiskVol(ByVal cPath As String, ByVal cVolString As String) As Boolean*
'******************************************************************************

'返回磁盘信息(卷标、序列号、文件系统名称、最大文件名长度)
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

'设置指定磁盘的卷标
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

'返回所有驱动器盘符
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

''磁盘信息结构
'Public Type DiskInformation
'    DiskType As DiskType '磁盘类型
'    DiskVol As String '磁盘卷标
'    DiskSerNum As Long '磁盘序列号
'    DiskFSName As String '文件系统名称
'    MaxFNLen As Long '最大文件名长度
'    TotalSpace(2) As Long '总的磁盘空间(Byte/Sector,Sector/Cluster,TotalCluster)
'    FreeSpace(2) As Long '剩余磁盘空间
'End Type


'返回指定磁盘的相关信息
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

'返回系统当前的所有驱动器的盘符
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

'设置指定磁盘的卷标
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