Private Declare Function ShellExecute Lib "shell32.dll" Alias..........
Private Declare Function GetVersionEx Lib "kernel32.dll" Alias..........
Private Declare Function GetDiskFreeSpaceEx Lib "kernel32.dll" Alias..........
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias..........
Private Type ULARGE_INTEGER
LowPart As Long
HighPart As Long
End Type
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Dim OsInfo As OSVERSIONINFO
Dim tmp As String
Dim FreeUser As ULARGE_INTEGER
Dim Total As ULARGE_INTEGER
Dim FreeSys As ULARGE_INTEGER
Dim Temp As Currency
Dim fTemp As Currency
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias.....
Private Declare Function GetDriveType Lib "kernel32" Alias.....
Private Function [b]GetDriveTypeFromLetter(strDriveLetter As String) As String[/b]
Dim strDrive As String
If Right(strDriveLetter, 1) <> "\" Then
strDrive = strDriveLetter & "\"
Else
strDrive = strDriveLetter
End If
Select Case GetDriveType(strDrive)
Case 2
GetDriveTypeFromLetter = "Removable"
Case 3
GetDriveTypeFromLetter = "Fixed Hard Drive"
Case Is = 4
GetDriveTypeFromLetter = "Remote"
Case Is = 5
GetDriveTypeFromLetter = "CD-ROM"
Case Is = 6
GetDriveTypeFromLetter = "Ram disk"
Case Else
GetDriveTypeFromLetter = "Unrecognized"
End Select
End Function
Private Sub [b]Form_Load()[/b]
Dim strSave As String, i As Long, ret&
Me.AutoRedraw = True
strSave = String(255, Chr$(0))
ret& = GetLogicalDriveStrings(255, strSave)
For i = 1 To 100
If Left$(strSave, InStr(1, strSave, Chr$(0))) = Chr$(0) Then Exit For
If GetDriveTypeFromLetter(Left$(strSave, InStr(1, strSave, Chr$(0)) - 1)) = "Fixed Hard Drive" Then
imgCboDrives.ComboItems.Add , , Left$(strSave, InStr(1, strSave, Chr$(0)) - 1), 1
End If
strSave = Right$(strSave, Len(strSave) - InStr(1, strSave, Chr$(0)))
Next i
Call GetDrive("C:\")
imgCboDrives.ComboItems(1).Selected = True
End Sub
Function [b]GetDrive(DriveName)[/b]
On Error Resume Next
Dim retVal
lblSysInfo.Height = 985
OsInfo.dwOSVersionInfoSize = Len(OsInfo)
retVal = GetVersionEx(OsInfo)
Select Case OsInfo.dwPlatformId
Case 0
tmp = "Windows 3.x"
Case 1
tmp = "Windows 95/98"
Case 2
tmp = "Windows 2000"
End Select
lblSysInfo.Caption = "Drive: " & Left(DriveName, 2) & vbNewLine
lblSysInfo.Caption = lblSysInfo.Caption & "Version: " & OsInfo.dwMajorVersion & "." & OsInfo.dwMinorVersion & vbNewLine
lblSysInfo.Caption = lblSysInfo.Caption & "Platform: " & tmp & vbNewLine
GetDiskFreeSpaceEx Left(DriveName, 2), FreeUser, Total, FreeSys
CopyMemory Temp, Total, 8
CopyMemory fTemp, FreeUser, 8
lblSysInfo.Caption = lblSysInfo.Caption & "Total Space: " & Format$(CCur(Temp) * 10000, "#######,##") & " bytes" & vbNewLine
lblSysInfo.Caption = lblSysInfo.Caption & "Free Space: " & Format$(CCur(fTemp) * 10000, "#######,##") & " bytes" & vbNewLine
lblSysInfo.Caption = lblSysInfo.Caption & "Used Space: " & Format$(CCur(Temp) - CCur(fTemp) * 10000, "#######,##") & " bytes" & vbNewLine
End Function
Private Sub [b]imgCboDrives_Click()[/b]
Call GetDrive(imgCboDrives.Text)
End Sub