Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Get Disk Drive Capacity
#11
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'


Attached Files
.bm   pipecomqb64.bm (Size: 9.27 KB / Downloads: 40)
.bas   unicodetoansi.bas (Size: 1.91 KB / Downloads: 24)
Schuwatch!
Yes, it's me. Now shut up.
Reply
#12
(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.
Reply
#13
(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?t...#msg126693
Schuwatch!
Yes, it's me. Now shut up.
Reply
#14
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://qb64phoenix.com/forum/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


Attached Files
.zip   DRIVEX2.ZIP (Size: 195.62 KB / Downloads: 22)
Reply
#15
The code output looks great. The code itself is a bit hard to read with all the single character variable names and suffixes.
Schuwatch!
Yes, it's me. Now shut up.
Reply




Users browsing this thread: 1 Guest(s)