JLRodgers
Level: Moderator
Registered: 04-04-2002
Posts: 1616
|
Re: Need help getting disk size & ram size
This class was used at a company I was at:
Private Type FreeSpaceType
TotalMB As Long
TotalFreeMB As Long
FreeBytesAvailMB As Long
TotalSpaceUsedMB As Long
End Type
Private FreeSpace As FreeSpaceType
Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA" (ByVal lpRootPathName As String, lpFreeBytesAvailableToCaller As Currency, lpTotalNumberOfBytes As Currency, lpTotalNumberOfFreeBytes As Currency) As Long
Private Declare Function SHGetDiskFreeSpace Lib "shell32" Alias "SHGetDiskFreeSpaceA" (ByVal pszVolume As String, pqwFreeCaller As Currency, pqwTot As Currency, pqwFree As Currency) As Long
Private Declare Function GetLogicalDrives Lib "kernel32" () As Long
Private Declare Function MessageBoxEx Lib "user32" Alias "MessageBoxExA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal uType As Long, ByVal wLanguageId As Long) As Long
Private Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long)
Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
Private Type SYSTEM_INFO
dwOemID As Long
dwPageSize As Long
lpMinimumApplicationAddress As Long
lpMaximumApplicationAddress As Long
dwActiveProcessorMask As Long
dwNumberOfProcessors As Long
dwProcessorType As Long
dwAllocationGranularity As Long
dwReserved As Long
End Type
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Public Event DriveInfo(ByVal Drive As String, ByVal TotalMB As Long, ByVal TotalGB As Long, ByVal TotalFreeMB As Long, ByVal TotalFreeGB As Long, ByVal TotalUsedMB As Long, ByVal TotalUsedGB As Long, ByVal PercentFree As Integer, ByVal PercentUsed As Integer)
Option Explicit
Public Sub SysInfo(ByRef OEMId As Long, ByRef PageSize As Long, ByRef LowMemoryAddress As Long, ByRef HighMemoryAddress As Long, ByRef ActiveProcessorMask As Long, ByRef NumberOfProcessors As Long, ByRef ProcessorType As Long, ByRef AllocationGranularity As Long)
Dim SInfo As SYSTEM_INFO
'Get the system information
GetSystemInfo SInfo
' Store it in the variables
ActiveProcessorMask = SInfo.dwActiveProcessorMask
AllocationGranularity = SInfo.dwAllocationGranularity
NumberOfProcessors = SInfo.dwNumberOfProcessors
OEMId = SInfo.dwOemID
PageSize = SInfo.dwPageSize
ProcessorType = SInfo.dwProcessorType
LowMemoryAddress = SInfo.lpMinimumApplicationAddress
HighMemoryAddress = SInfo.lpMaximumApplicationAddress
End Sub
Public Function FreeSpaceEXArray(ByRef Drives() As String, ByRef TotalMB() As Long, ByRef TotalGB() As Long, ByRef TotalUsedMB() As Long, ByRef TotalUsedGB() As Long, ByRef TotalFreeMB() As Long, ByRef TotalFreeGB() As Long, ByRef PercentUsed() As Integer, ByRef PercentFree() As Integer) As Boolean
On Error GoTo FreeSpaceEXArray_Err
Dim DriveList As String
Dim sDrive As String
Dim FreeBytesAvailableToCaller As Currency
Dim TotalNumberOfBytes As Currency
Dim TotalNumberOfFreeBytes As Currency
Dim i As Integer
' Get available hard drives
DriveList = Replace(AvailableDrivesString, " ", "")
' OK... now redim the arrays, since each letter is a drive, it's the top number
i = Len(DriveList) - 1 ' starts at 0, so offset
ReDim Drives(i)
ReDim TotalMB(i)
ReDim TotalGB(i)
ReDim TotalUsedMB(i)
ReDim TotalUsedGB(i)
ReDim TotalFreeMB(i)
ReDim TotalFreeGB(i)
ReDim PercentUsed(i)
ReDim PercentFree(i)
i = 0
' All right... now we loop through each letter, getting the information
Do
' Get the information
sDrive = Left(DriveList, 1) & ":\"
GetDiskFreeSpaceEx sDrive, FreeBytesAvailableToCaller, TotalNumberOfBytes, TotalNumberOfFreeBytes
' Reset to just the drive letter
sDrive = Left(sDrive, 1)
' Move the drive letter from the list
DriveList = Right(DriveList, Len(DriveList) - 1)
' Since currency returns 4 decimals... multiply by 10000 to adjust
Drives(i) = sDrive
TotalMB(i) = CLng(TotalNumberOfBytes * 10000 / 1024 / 1024)
TotalGB(i) = TotalMB(i) / 1024
TotalFreeMB(i) = CLng(TotalNumberOfFreeBytes * 10000 / 1024 / 1024)
TotalFreeGB(i) = TotalFreeMB(i) / 1024
TotalUsedMB(i) = CLng((TotalNumberOfBytes - TotalNumberOfFreeBytes) * 10000 / 1024 / 1024)
TotalUsedGB(i) = TotalUsedMB(i) / 1024
If TotalMB(i) > 0 Then
' Just in case... don't want a divide by 0
PercentUsed(i) = TotalUsedMB(i) / TotalMB(i)
PercentFree(i) = TotalFreeMB(i) / TotalMB(i)
End If
i = i + 1
Loop Until DriveList = ""
FreeSpaceEXArray = True
Exit Function
FreeSpaceEXArray_Err:
FreeSpaceEXArray = False
End Function
Public Function FreeSpaceEXEvents() As Boolean
On Error GoTo FreeSpaceEXEvents_Err
Dim DriveList As String
Dim sDrive As String
Dim FreeBytesAvailableToCaller As Currency
Dim TotalNumberOfBytes As Currency
Dim TotalNumberOfFreeBytes As Currency
Dim TotalMB As Long
Dim TotalGB As Long
Dim TotalFreeMB As Long
Dim TotalFreeGB As Long
Dim TotalUsedMB As Long
Dim TotalUsedGB As Long
Dim PercentUsed As Integer
Dim PercentFree As Integer
' Get available hard drives
DriveList = Replace(AvailableDrivesString, " ", "")
' All right... now we loop through each letter, getting the information
Do
' Get the information
sDrive = Left(DriveList, 1) & ":\"
GetDiskFreeSpaceEx sDrive, FreeBytesAvailableToCaller, TotalNumberOfBytes, TotalNumberOfFreeBytes
' Reset to just the drive letter
sDrive = Left(sDrive, 1)
' Move the drive letter from the list
DriveList = Right(DriveList, Len(DriveList) - 1)
' Since currency returns 4 decimals... multiply by 10000 to adjust
TotalMB = CLng(TotalNumberOfBytes * 10000 / 1024 / 1024)
TotalGB = TotalMB / 1024
TotalFreeMB = CLng(TotalNumberOfFreeBytes * 10000 / 1024 / 1024)
TotalFreeGB = TotalFreeMB / 1024
TotalUsedMB = CLng((TotalNumberOfBytes - TotalNumberOfFreeBytes) * 10000 / 1024 / 1024)
TotalUsedGB = TotalUsedMB / 1024
If TotalMB > 0 Then
' Just in case... don't want a divide by 0
PercentUsed = (TotalUsedMB / TotalMB) * 100
PercentFree = (TotalFreeMB / TotalMB) * 100
End If
' Got it all
RaiseEvent DriveInfo(sDrive, TotalMB, TotalGB, TotalFreeMB, TotalFreeGB, TotalUsedMB, TotalUsedGB, PercentFree, PercentUsed)
Loop Until DriveList = ""
FreeSpaceEXEvents = True
Exit Function
FreeSpaceEXEvents_Err:
FreeSpaceEXEvents = False
End Function
Public Function AvailableDrivesArray(ByRef DriveList() As String) As Boolean
On Error GoTo AvailableDrives_Err
Dim lng As Long
Dim i As Integer
Dim iDrive As Integer
Dim sDrive As String
' Get the drives
lng = GetLogicalDrives
' Redim the array
iDrive = 0
ReDim DriveList(iDrive)
For i = 0 To 25
If (lng And 2 ^ i) <> 0 Then
sDrive = Chr(65 + i)
Select Case GetDriveType(sDrive & ":\")
Case 1, 2, 4, 5
Case Else ' includes 3
If DriveList(iDrive) <> "" Then
iDrive = iDrive + 1
ReDim Preserve DriveList(iDrive)
End If
DriveList(iDrive) = sDrive
End Select
End If
Next
Exit Function
AvailableDrives_Err:
End Function
Public Function AvailableDrivesString() As String
On Error GoTo AvailableDrivesString_Err
Dim lng As Long
Dim i As Integer
Dim sDrive As String
lng = GetLogicalDrives
For i = 0 To 25
If (lng And 2 ^ i) <> 0 Then
sDrive = Chr(65 + i)
Select Case GetDriveType(sDrive & ":\")
Case 1, 2, 4, 5
Case Else ' Includes 3
AvailableDrivesString = AvailableDrivesString & " " & sDrive
End Select
End If
Next
Exit Function
AvailableDrivesString_Err:
End Function
Public Function DriveInfoEvents(ByVal Drive As String) As Boolean
On Error GoTo DriveInfoEvents_Err
Dim FreeBytesAvailableToCaller As Currency
Dim TotalNumberOfBytes As Currency
Dim TotalNumberOfFreeBytes As Currency
Dim TotalMB As Long
Dim TotalGB As Long
Dim TotalFreeMB As Long
Dim TotalFreeGB As Long
Dim TotalUsedMB As Long
Dim TotalUsedGB As Long
Dim PercentUsed As Integer
Dim PercentFree As Integer
' Get the information
If Len(Drive) = 1 Then
Drive = Drive & ":\"
ElseIf Len(Drive) = 3 Then
If Right(Drive, 2) <> ":\" Then
Drive = Left(Drive, 1) & ":\"
End If
Else
Drive = Left(Drive, 1) & ":\"
End If
GetDiskFreeSpaceEx Drive, FreeBytesAvailableToCaller, TotalNumberOfBytes, TotalNumberOfFreeBytes
' Reset to just the drive letter
Drive = Left(Drive, 1)
' Since currency returns 4 decimals... multiply by 10000 to adjust
TotalMB = CLng(TotalNumberOfBytes * 10000 / 1024 / 1024)
TotalGB = TotalMB / 1024
TotalFreeMB = CLng(TotalNumberOfFreeBytes * 10000 / 1024 / 1024)
TotalFreeGB = TotalFreeMB / 1024
TotalUsedMB = CLng((TotalNumberOfBytes - TotalNumberOfFreeBytes) * 10000 / 1024 / 1024)
TotalUsedGB = TotalUsedMB / 1024
If TotalMB > 0 Then
' Just in case... don't want a divide by 0
PercentUsed = (TotalUsedMB / TotalMB) * 100
PercentFree = (TotalFreeMB / TotalMB) * 100
End If
' Got it all
RaiseEvent DriveInfo(Drive, TotalMB, TotalGB, TotalFreeMB, TotalFreeGB, TotalUsedMB, TotalUsedGB, PercentFree, PercentUsed)
DriveInfoEvents = True
Exit Function
DriveInfoEvents_Err:
DriveInfoEvents = False
End Function
Public Function DriveInfo(ByVal Drive As String, ByRef TotalMB As Long, ByRef TotalGB As Long, ByRef TotalFreeMB As Long, ByRef TotalFreeGB As Long, ByRef TotalUsedMB As Long, ByRef TotalUsedGB As Long, ByRef PercentUsed As Integer, ByRef PercentFree As Integer) As Boolean
On Error GoTo DriveInfo_Err
Dim FreeBytesAvailableToCaller As Currency
Dim TotalNumberOfBytes As Currency
Dim TotalNumberOfFreeBytes As Currency
' Get the information
If Len(Drive) = 1 Then
Drive = Drive & ":\"
ElseIf Len(Drive) = 3 Then
If Right(Drive, 2) <> ":\" Then
Drive = Left(Drive, 1) & ":\"
End If
Else
Drive = Left(Drive, 1) & ":\"
End If
GetDiskFreeSpaceEx Drive, FreeBytesAvailableToCaller, TotalNumberOfBytes, TotalNumberOfFreeBytes
' Reset to just the drive letter
Drive = Left(Drive, 1)
' Since currency returns 4 decimals... multiply by 10000 to adjust
TotalMB = CLng(TotalNumberOfBytes * 10000 / 1024 / 1024)
TotalGB = TotalMB / 1024
TotalFreeMB = CLng(TotalNumberOfFreeBytes * 10000 / 1024 / 1024)
TotalFreeGB = TotalFreeMB / 1024
TotalUsedMB = CLng((TotalNumberOfBytes - TotalNumberOfFreeBytes) * 10000 / 1024 / 1024)
TotalUsedGB = TotalUsedMB / 1024
If TotalMB > 0 Then
' Just in case... don't want a divide by 0
PercentUsed = (TotalUsedMB / TotalMB) * 100
PercentFree = (TotalFreeMB / TotalMB) * 100
End If
DriveInfo = True
Exit Function
DriveInfo_Err:
DriveInfo = False
End Function
|
____________________________
Everywhere's Local (classifieds, job postings, & more for everycity in the world - user entered)
|
