Drive display utility for Windows
#1
Utility in windows qb64 to display drives and their info:

Code:
REM List drives and info v1.4a PD 04/30/2016 -ejo.

REM $DYNAMIC

' declare library constants.
CONST MAX_PATH = 260
CONST INVALID_HANDLE_VALUE = -1
CONST ERROR_FILE_NOT_FOUND = 2
CONST ERROR_NO_MORE_FILES = &H12

' declare library structures.
TYPE FILETIME
    dwLowDateTime AS _UNSIGNED LONG
    dwHighDateTime AS _UNSIGNED LONG
END TYPE

TYPE SYSTEMTIME
    wYear AS INTEGER
    wMonth AS INTEGER
    wDayOfWeek AS INTEGER
    wDay AS INTEGER
    wHour AS INTEGER
    wMinute AS INTEGER
    wSecond AS INTEGER
    wMilliseconds AS INTEGER
END TYPE

TYPE WIN32_FIND_DATAA
    dwFileAttributes AS _UNSIGNED LONG
    ftCreationTime AS FILETIME
    ftLastAccessTime AS FILETIME
    ftLastWriteTime AS FILETIME
    nFileSizeHigh AS _UNSIGNED LONG
    nFileSizeLow AS _UNSIGNED LONG
    dwReserved0 AS _UNSIGNED LONG
    dwReserved1 AS _UNSIGNED LONG
    cFileName AS STRING * MAX_PATH
    cAlternateFileName AS STRING * 14
END TYPE

' declare external libraries.
DECLARE DYNAMIC LIBRARY "kernel32"
    FUNCTION FindFirstFileA~%& (BYVAL lpFileName~%&, BYVAL lpFindFileData~%&
    FUNCTION FindNextFileA& (BYVAL hFindFile~%&, BYVAL lpFindFileData~%&
    FUNCTION FindClose& (BYVAL hFindFile~%&
    FUNCTION FileTimeToSystemTime& (lpFileTime AS FILETIME, lpSystemTime AS SYSTEMTIME)
    FUNCTION GetVolumeInformationA& (lpRootPathName$, lpVolumeNameBuffer$, BYVAL nVolumeNameSize~&, lpVolumeSerialNumber~&, lpMaximumComponentLength~&, lpFileSystemFlags~&, lpFileSystemNameBuffer$, BYVAL nFileSystemNameSize&
    FUNCTION GetDiskFreeSpaceA& (f$, sectors&, bytes&, free&, total&
    FUNCTION GetDiskFreeSpaceExA& (filename$, free AS _UNSIGNED _INTEGER64, total AS _UNSIGNED _INTEGER64, free2 AS _UNSIGNED _INTEGER64)
END DECLARE

DECLARE LIBRARY
    FUNCTION GetFileAttributes& (f$)
    FUNCTION SetFileAttributes& (f$, BYVAL a&
    FUNCTION GetDriveType& (d$)
    FUNCTION GetShortPathName& (InP$, OutP$, BYVAL length&
    FUNCTION GetModuleFileNameA (BYVAL Module AS LONG, FileName AS STRING, BYVAL nSize AS LONG)
END DECLARE

' declare library variables.
DIM SHARED finddata AS WIN32_FIND_DATAA
DIM SHARED hfind AS _UNSIGNED _OFFSET
DIM SHARED SysTime AS SYSTEMTIME
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
    IF DriveType = "[CDROM]" THEN
        EXIT SUB
    END IF
    IF DriveType = "[REMOVABLE]" THEN
        EXIT SUB
    END IF
    r = GetDiskFreeSpaceExA(VarX$, free~&&, total~&&, free2~&&
    IF r THEN
        Var$ = LTRIM$(STR$(free~&&
    END IF
    EXIT SUB

    r = GetDiskFreeSpaceA(VarX$, sectors&, bytes&, free&, total&
    IF r THEN
        ' sectors per cluster * bytes per sector * free clusters
        x1# = CDBL(sectors& * CDBL(bytes& * CDBL(free&
        Var$ = LTRIM$(STR$(x1#))
    END IF
END SUB

' get drive totalspace
SUB TotalSpace (Var$)
    VarX$ = Var$ + ":\" + CHR$(0)
    Var$ = Nul
    IF DriveType = "[CDROM]" THEN
        EXIT SUB
    END IF
    IF DriveType = "[REMOVABLE]" THEN
        EXIT SUB
    END IF
    r = GetDiskFreeSpaceExA(VarX$, free~&&, total~&&, free2~&&
    IF r THEN
        Var$ = LTRIM$(STR$(total~&&
    END IF
    EXIT SUB

    r = GetDiskFreeSpaceA(VarX$, sectors&, bytes&, free&, total&
    IF r THEN
        ' sectors per cluster * bytes per sector * total clusters
        x1# = CDBL(sectors& * CDBL(bytes& * CDBL(total&
        Var$ = LTRIM$(STR$(x1#))
    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   DRIVEX.ZIP (Size: 3.81 KB / Downloads: 4)
dndbbs project:

Links to my MUD: (strictly 16-bit); AKA XP:

Dndbbs executables
http://www.filegate.net/pdn/pdnbasic/dnd50a1e.zip

Dndbbs source
http://www.filegate.net/pdn/pdnbasic/dnd50a1s.zip

Dndbbs upgrade
http://www.filegate.net/pdn/pdnbasic/dnd50a1u.zip

DNDDOOR - https://bit.ly/EriksDNDDoor DUNGEON - https://bit.ly/EriksDungeon
Interpreter - https://bit.ly/EriksSICK Hex Editor - https://bit.ly/EriksHexEditor Utilities - https://bit.ly/EriksUtils
QB45 files: - https://bit.ly/EriksQB45 QB64shell - https://bit.ly/QB64shell Some old QB64 versions: - https://bit.ly/OldQB64
Reply