RE: Get Disk Drive Capacity - Ultraman - 07-05-2023
If you like making temp files, sure. Plus, you'd still need to write a function that parses out what you returned from that file. If you're going to use wmic, why not use pipecom to eliminate the temp file?
Code: (Select All)
Option _Explicit
$Console:Only
Print pipecom_lite("wmic logicaldisk get Name,Description,Size")
'$Include:'pipecomqb64.bm'
RE: Get Disk Drive Capacity - Steffan-68 - 07-05-2023
(07-05-2023, 03:56 PM)Ultraman Wrote: I think the code Steffan shared is code I wrote a long time ago. Glad to see it was able to do its job.
The code is not mine. Found it in my collection of programs.
RE: Get Disk Drive Capacity - Ultraman - 07-05-2023
(07-05-2023, 05:24 PM)Steffan-68 Wrote: (07-05-2023, 03:56 PM)Ultraman Wrote: I think the code Steffan shared is code I wrote a long time ago. Glad to see it was able to do its job.
The code is not mine. Found it in my collection of programs.
Right, I'm just saying that I wrote it a long time ago. I just didn't realize anyone would get any use out of it. I don't even remember when I did it. I just recognize it as mine. I used to have a GitHub repo with all my code on it. It probably came from that or from whichever forum post I originally made with it.
Ah! I found the post https://qb64forum.alephc.xyz/index.php?topic=2276.msg126693#msg126693
RE: Get Disk Drive Capacity - eoredson - 07-07-2023
Attached is a program which displays the drives and their free space and total space and used space.
In this attachment find DriveX.bas for 32-bit..
Also look at this link for more QB64 utilities:
https://staging.qb64phoenix.com/attachment.php?aid=1878
Erik.
Here is the actual program:
Code: (Select All) Rem List drives and info v1.4a PD 12/10/2022 -ejo.
Rem $DYNAMIC
' high intensity foreground
Const Black = 0
Const Gray = 8
Const Blue = 9
Const Green = 10
Const Cyan = 11
Const Red = 12
Const Magenta = 13
Const Yellow = 14
Const White = 15
' declare library constants.
Const MAX_PATH = 260
' declare external libraries.
Declare Dynamic Library "kernel32"
Function GetVolumeInformationA& (lpRootPathName$, lpVolumeNameBuffer$, Byval nVolumeNameSize~&, lpVolumeSerialNumber~&, lpMaximumComponentLength~&, lpFileSystemFlags~&, lpFileSystemNameBuffer$, Byval nFileSystemNameSize&)
Function GetDiskFreeSpaceExA& (filename$, free As _Unsigned _Integer64, total As _Unsigned _Integer64, free2 As _Unsigned _Integer64)
End Declare
Declare Library
Function GetDriveType& (d$)
End Declare
' declare library variables.
Dim Shared Out3 As String
Dim Shared DriveType As String
' declare byte divisor variable.
Dim Shared ByteDivisor As Double
' declare standard error trap
On Error GoTo Error.Routine
' declare some constants.
Const Nul = ""
Const True = -1
_Title "DRIVE INFO"
Rem Start program loop.
Do
If InStr(_OS$, "[WINDOWS]") Then
ByteDivisor = 1024
Else
If InStr(_OS$, "[MACOSX]") Then
ByteDivisor = 1000
Else
ByteDivisor = 1024
End If
End If
Cls
Color 15
Print "Drive info v1.4a"
Color 14
Print "Byte divisor:"; ByteDivisor
Print "Override(Y/N)? ";
Locate , , 1
Do
_Limit 50
x$ = UCase$(InKey$)
If x$ = "N" Then
Print x$
Exit Do
End If
If x$ = "Y" Then
Print x$
Do
Print "Enter display byte divisor (1000, 1024)";
Input Var
If Var = 0 Then
Exit Do
End If
If Var = 1000 Or Var = 1024 Then
ByteDivisor = Var
Exit Do
End If
Loop
Exit Do
End If
Loop
Var$ = Nul
Print "Use drive list(Y/N)? ";
Do
_Limit 50
x$ = UCase$(InKey$)
If x$ = "N" Then
Print x$
Exit Do
End If
If x$ = "Y" Then
Print x$
Print "Enter drive list: ";
Line Input Var$
If Var$ <> Nul Then
Call ListDrives(Var$, 0)
End If
Exit Do
End If
Loop
If Var$ = Nul Then
Print "Skip A: and B: drives(Y/N)? ";
Do
_Limit 50
x$ = UCase$(InKey$)
If x$ = "Y" Then
Print x$
Call ListDrives(Nul, -1)
Exit Do
End If
If x$ = "N" Then
Print x$
Call ListDrives(Nul, 0)
Exit Do
End If
Loop
End If
Locate 24, 30, 1
Color 15, 1
Print "Press (A)gain, (Q)uit:";
Color 15, 0
Do
_Limit 50
i$ = UCase$(InKey$)
If i$ = "Q" Then
System
End If
If i$ = "A" Then
Exit Do
End If
Loop
Loop
End
' critical error trap
Error.Routine:
DataError = Err
If Display.Errors Then
Resume Next
End If
Color Green, Black
Print "Critical error:"; Str$(DataError); " IDE line:"; _ErrorLine
Prompt$ = "Press R to retry, Q to quit, C to continue:"
Call MorePrompt(Prompt$, "rqc", Outpt$)
Select Case Outpt$
Case "r"
Resume
Case "q"
Color 7, 0
System
Case "c"
Resume Next
End Select
Color Plain, Black
End 0
' prompt for keypress
Sub MorePrompt (Input.String$, Input.Mask$, Output.String$)
Color White, Black
Print Input.String$ + " ";
Input.Char$ = Nul
Do
Locate , , 1
_Limit 100
Input.Char$ = InKey$
If Len(Input.Char$) Then
Input.Char$ = LCase$(Input.Char$)
If InStr(Input.Mask$, Input.Char$) Then
Print Input.Char$
Output.String$ = Input.Char$
Exit Do
End If
End If
Loop
End Sub
' lists specified drives.
Sub ListDrives (Var$, VarQ)
' Var$ = "x..." only list drives in string,
' otherwise,
' VarQ = 0 list all drives.
' VarQ = -1 except A: and B:
Cls
l = 0
GoSub DriveHeader
For c = 1 To 26
If Var$ <> Nul Then ' display specific drives.
x$ = UCase$(Var$)
If InStr(x$, Chr$(c + 64)) Then
x = InStr(x$, Chr$(c + 64))
x = Asc(Mid$(x$, x, 1))
If x >= 65 And x <= 90 Then
x = x - 64
If c = x Then
GoSub DisplayDrive
End If
End If
End If
Else
If VarQ = 0 Then ' list all drives
GoSub DisplayDrive
Else
' except A: or B:
If c >= 3 Then
GoSub DisplayDrive
End If
End If
End If
If h = 20 Then
h = 0
Print "-more-";
Do
_Limit 50
I$ = InKey$
If Len(I$) Then
Exit Do
End If
Loop
GoSub DriveHeader
End If
Next
Print
If q = 0 Then
Print "<none>"
Else
Color 15, 0
Print "Total drives"; l
End If
Exit Sub
DisplayDrive:
c$ = Chr$(c + 64)
Out3 = c$
If DRIVEEXISTS(c) = 0 Then
h = h + 1
l = l + 1
q = -1
' display drive letter
Color 15, 0
Print c$; ": ";
' display volume label
Color 14, 0
Out3 = c$
Call Vlabel(Out3)
If RTrim$(Out3) = Nul Then
z$ = DriveType
Else
z$ = Left$(Out3, 12)
End If
z$ = z$ + Space$(13 - Len(z$))
Print z$;
' display volume serial number
Color 10, 0
Out3 = c$
Call Vserial(Out3)
z$ = Left$(Out3, 12)
z$ = z$ + Space$(13 - Len(z$))
Print z$;
' display volume file system type
Color 12, 0
Out3 = c$
Call Vtype(Out3)
z$ = Left$(Out3, 8)
z$ = z$ + Space$(9 - Len(z$))
Print z$;
' display volume total disk space
Color 11, 0
Out3 = c$
Call TotalSpace(Out3)
x# = Int(Val(Out3))
x1# = x#
If x# > 0# Then
Call Suffix(x#, S$) ' 1,024.0 KB
Print Space$(11 - Len(S$)) + S$;
Else
Print " <n/a>";
End If
' display volume free disk space
Out3 = c$
Call FreeSpace(Out3)
y# = Int(Val(Out3))
y1# = y#
If y# > 0# Then
Call Suffix(y#, S$) ' 1,024.0 KB
Print Space$(11 - Len(S$)) + S$;
Else
Print " <n/a>";
End If
' display volume used disk space
If x1# > 0# Or y1# > 0# Then
z# = x1# - y1#
Call Suffix(z#, S$) ' 1,024.0 KB
Print Space$(11 - Len(S$)) + S$
Else
Print " <n/a>"
End If
End If
Return
DriveHeader:
h = 2
Color 15, 0
Print "Drive Label Serial Type Total Free Used"
Print "--------------------------------------------------------------------------"
Return
End Sub
' calculate byte suffix
Sub Suffix (Var#, Var3$)
Rem B (Byte) = 00x - 0FFx (hexidecimal zero-based)
Rem KB (Kilobyte) = 1024 B
Rem MB (Megabyte) = 1024 KB (1 MB B)
Rem GB (Gigabyte) = 1024 MB
Rem TB (Terabyte) = 1024 GB (1 MB MB)
Rem PB (Petabyte) = 1024 TB
Rem EB (Exabyte) = 1024 PB (1 MB TB)
Rem Note: next two suffixes are beyond 64-bit:
Rem ZB (Zettabyte) = 1024 EB
Rem YB (Yottabyte) = 1024 ZB (1 MB EB)
' check double
VarX# = Var#
s$ = Str$(VarX#)
If InStr(s$, "D") Then
Var3$ = s$
Exit Sub
End If
' get sign
If VarX# < 0# Then
Sign = True
VarX# = Abs(VarX#)
End If
' calculate bytes
TempA = False
Do
If VarX# >= ByteDivisor Then
VarX# = VarX# / ByteDivisor
TempA = TempA + 1
If TempA = 8 Then
Exit Do
End If
Else
Exit Do
End If
Loop
' calculate byte string
Var3$ = FormatString$(VarX#)
If InStr(Var3$, ".") Then
Var3$ = Left$(Var3$, InStr(Var3$, ".") + 1)
Else
Var3$ = Var3$ + ".0"
End If
' calculate byte suffix
Var$ = Nul
If TempA > 0 Then
Var$ = Mid$("KMGTPEZY", TempA, 1)
End If
Var3$ = Var3$ + " " + Var$ + "B"
' calculate byte sign
If Sign Then
Var3$ = "-" + Var3$
End If
End Sub
' formats a double numeric string
Function FormatString$ (s#)
x$ = Nul
s$ = Str$(s#)
If InStr(s$, "D") Then ' return string
FormatString$ = s$
Exit Function
End If
If Left$(s$, 1) = "-" Then ' store sign
e$ = "-"
s$ = Mid$(s$, 2)
End If
s$ = LTrim$(s$) ' format string
If InStr(s$, ".") Then
q$ = Mid$(s$, InStr(s$, "."))
s$ = Left$(s$, InStr(s$, ".") - 1)
End If
For l = Len(s$) To 3 Step -3
x$ = Mid$(s$, l - 2, 3) + "," + x$
Next
If l > 0 Then
x$ = Mid$(s$, 1, l) + "," + x$
End If
If Len(s$) < 3 Then
x$ = s$
End If
If Right$(x$, 1) = "," Then
x$ = Left$(x$, Len(x$) - 1)
End If
x$ = e$ + x$ + q$ ' construct string
FormatString$ = x$
End Function
' check drive exists.
' returns -1 if drive not detected.
Function DRIVEEXISTS (V)
VarX$ = Chr$(V + 64) + ":\" + Chr$(0)
VarX = GetDriveType(VarX$)
DriveType = Nul
Select Case VarX
Case 0
DriveType = "[UNKNOWN]"
Case 1
DriveType = "[BADROOT]"
Case 2
DriveType = "[REMOVABLE]"
Case 3
DriveType = "[FIXED]"
Case 4
DriveType = "[REMOTE]"
Case 5
DriveType = "[CDROM]"
Case 6
DriveType = "[RAMDISK]"
End Select
If VarX > 1 Then
DRIVEEXISTS = False
Else
DRIVEEXISTS = True
End If
End Function
' get drive freespace
Sub FreeSpace (Var$)
VarX$ = Var$ + ":\" + Chr$(0)
Var$ = Nul
r = GetDiskFreeSpaceExA(VarX$, free~&&, total~&&, free2~&&)
If r Then
Var$ = LTrim$(Str$(free~&&))
End If
End Sub
' get drive totalspace
Sub TotalSpace (Var$)
VarX$ = Var$ + ":\" + Chr$(0)
Var$ = Nul
r = GetDiskFreeSpaceExA(VarX$, free~&&, total~&&, free2~&&)
If r Then
Var$ = LTrim$(Str$(total~&&))
End If
End Sub
' get volume label
Sub Vlabel (Var$)
' Note: in DOS the volume label was 8.3 format,
' however, in windows XP+ it is 32 char.
' get drive info.
VarX$ = Var$ + ":\" + Chr$(0)
Var$ = Nul
Vname$ = Space$(MAX_PATH)
Fname$ = Space$(MAX_PATH)
R = GetVolumeInformationA(VarX$, Vname$, MAX_PATH, serial~&, empty1~&, empty2~&, Fname$, MAX_PATH)
If R Then
' get volume label.
Var$ = RTrim$(Vname$)
v = InStr(Var$, Chr$(0))
If v Then Var$ = Left$(Var$, v - 1)
End If
End Sub
' get volume serial number
Sub Vserial (Var$)
' get drive info.
VarX$ = Var$ + ":\" + Chr$(0)
Var$ = Nul
Vname$ = Space$(MAX_PATH)
Fname$ = Space$(MAX_PATH)
R = GetVolumeInformationA(VarX$, Vname$, MAX_PATH, serial~&, empty1~&, empty2~&, Fname$, MAX_PATH)
If R Then
' serial number.
Var$ = Left$(Hex$(serial~&), 4) + "-" + Right$(Hex$(serial~&), 4)
End If
End Sub
' get volume system type
Sub Vtype (Var$)
' get drive info.
VarX$ = Var$ + ":\" + Chr$(0)
Var$ = Nul
Vname$ = Space$(MAX_PATH)
Fname$ = Space$(MAX_PATH)
R = GetVolumeInformationA(VarX$, Vname$, MAX_PATH, serial~&, empty1~&, empty2~&, Fname$, MAX_PATH)
If R Then
' get volume system type.
Var$ = RTrim$(Fname$)
v = InStr(Var$, Chr$(0))
If v Then Var$ = Left$(Var$, v - 1)
End If
End Sub
RE: Get Disk Drive Capacity - Ultraman - 07-07-2023
The code output looks great. The code itself is a bit hard to read with all the single character variable names and suffixes.
|