ArdDiskNetInfo




'1. Place the following code into a module.

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
Declare Function GetLogicalDrives& Lib "kernel32" ()
Declare Function GetDriveType& Lib "kernel32" Alias "GetDriveTypeA" _
(ByVal nDrive As String)
Declare Function GetDiskFreeSpace& Lib "kernel32" Alias "GetDiskFreeSpaceA"_
(ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector _
As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long)
Public vararyDriveInfo(26, 11) ' a Variant Array to hold the info
'2. This is a sub that can be called from a form loading or from a command button.

Sub getDriveInfo()
' *****************************************

' SUB: This sub will get all the drive

' info for all the hard drives and

' network drives.

' 2/19/95

'

' There is a array named vararyDriveInfo that

' holds all the info for up to 26 drives (A-Z).

'

' Array Format:

' x,1 = Is there a drive for this letter

' x,2 = Drive Letter

' x,3 = Drive Type 2=Floppy, 3=Disk Fixed (local) 4=Disk Remote (Network)

' x,4 = Sectors

' x,5 = Bytes / Sector

' x,6 = Number of free sectors

' x,7 = Total Clusters

' x,8 = Total Bytes

' x,9 = Free Bytes

' x,10 = Percent of Free Bytes

' x,11 = Vol Name

Dim ournum As Long
Dim rv As Long
Dim DriveType As Long
Dim c As Long
Dim d As Long
Dim e As Long
Dim f As Long
Dim h As Long
Dim Counter As Integer
Dim CompareTo
Dim tmpDrvLet As String
Dim SectorsPerCluster&, BytesPerSector&, NumberOfFreeClustors&, _
TotalNumberOfClustors&
Dim BytesFreeas, BytesTotal, FreeBytes, TotalBytes As Variant
Dim dl&, lpVolumeSerialNumber&, lpMaximumComponentLength&, _
lpFileSystemFlags&
Dim lpVolumeNameBuffer As String
Dim rc
Dim A As String
Dim b As String
Dim g As String
Dim s$, sz&
' *** get the logical Drives

rv = 0
rv = GetLogicalDrives&()
If rv = 0 Then
MsgBoxText = "No Logical Drives Found. Program will stop."
MsgBoxButton = MB_OK + MB_ICONSTOP
MsgBoxTitle = "Error"

MsgBox MsgBoxText, MsgBoxButton, MsgBoxTitle
Stop
Exit Sub
End If
' *** clear the VarArray

Erase vararyDriveInfo
' *** set the var

b = String$(255, 0)
c = 200
g = String$(255, 0)
h = 100
For Counter = 1 To 26
CompareTo = (2 ^ (Counter - 1))
If (rv And CompareTo) 0 Then
vararyDriveInfo(Counter, 1) = True ' Found a drive
tmpDrvLet = Chr(Counter + 64) ' Build a drive letter
vararyDriveInfo(Counter, 2) = tmpDrvLet ' Save the drive letter
tmpDrvLet = tmpDrvLet & ":\" ' Add the root stuff
DriveType = GetDriveType&(tmpDrvLet) ' Get the drive type
vararyDriveInfo(Counter, 3) = DriveType ' Save the drive type
If DriveType = 3 Or DriveType = 4 Then ' local or network drives only

' *** get the vol name

A = tmpDrvLet 'DriveLtr & "\:"
rc = GetVolumeInformation(A, b, c, d, e, f, g, h)
vararyDriveInfo(Counter, 11) = b

' *** let's get the Drive info for this HardDrive

dl& = GetDiskFreeSpace(tmpDrvLet, SectorsPerCluster, BytesPerSector, _
NumberOfFreeClustors, TotalNumberOfClustors)

vararyDriveInfo(Counter, 4) = Format(SectorsPerCluster, "#,0")
vararyDriveInfo(Counter, 5) = Format(BytesPerSector, "#,0")
vararyDriveInfo(Counter, 6) = Format(NumberOfFreeClustors, "#,0")
vararyDriveInfo(Counter, 7) = Format(TotalNumberOfClustors, "#,0")
TotalBytes = (TotalNumberOfClustors / 100) * (SectorsPerCluster / 100) * (BytesPerSector / 100)
vararyDriveInfo(Counter, 8) = Format(TotalBytes, "#,0")
FreeBytes = (NumberOfFreeClustors / 100) * (SectorsPerCluster / 100) * (BytesPerSector / 100)
vararyDriveInfo(Counter, 9) = Format(FreeBytes, "#,0")
vararyDriveInfo(Counter, 10) = Format(FreeBytes / TotalBytes, "Percent")
End If
Else
' *** no drive? then set to false

vararyDriveInfo(Counter, 1) = False
End If
Next Counter
End Sub











( arddisknetinfo.html )- by Paolo Puglisi - Modifica del 17/12/2023