How To Get Drive Label And Drive Serial Number In QB64

Question

I have recently found how to Get/Set Filename Attributes in QB64:

DECLARE LIBRARY
    FUNCTION GetFileAttributes& (f$)
    FUNCTION SetFileAttributes& (f$, BYVAL a&)
END DECLARE

file$ = "c:\qb64\tempfile.000" + CHR$(0)

a = GetFileAttributes(file$)
a = a AND NOT 1 ' reset read-only flag
x = SetFileAttributes(file$, a)

I would like to know if there is a simple method to get the volume label and serial number of a drive.

Answer 1

Gets drive volume label, serial number and file system type. Also counts drives which exist, and gets the drive type. Source is in QB64.

' declare external libraries.
CONST MAX_PATH = 260
DECLARE DYNAMIC LIBRARY "kernel32"
FUNCTION GetVolumeInformationA& (lpRootPathName$, _
    lpVolumeNameBuffer$, _
    BYVAL nVolumeNameSize~&, _
    lpVolumeSerialNumber~&, _
    lpMaximumComponentLength~&, _
    lpFileSystemFlags~&, _
    lpFileSystemNameBuffer$, _
    BYVAL nFileSystemNameSize&)
END DECLARE
DECLARE LIBRARY
    FUNCTION GetDriveType& (d$)
END DECLARE
DIM SHARED DriveType AS STRING
_TITLE "DRIVE LIST"
FOR Q = 1 TO 26
    X = GetFileInfo(Q)
    IF X THEN C = C + 1
NEXT
PRINT "Drives detected:"; C
END

' function gets and displays existing drive info.
FUNCTION GetFileInfo (D)
IF DRIVEEXISTS(D) THEN
    GetFileInfo = 0
    EXIT FUNCTION
END IF
COLOR 14, 0
Dname$ = CHR$(D + 64) + ":\"
PRINT "Drive: "; Dname$
Vname$ = SPACE$(MAX_PATH)
Sname$ = SPACE$(MAX_PATH)
R = GetVolumeInformationA(Dname$ + CHR$(0), Vname$, MAX_PATH, serial~&, empty1~&, empty2~&, Sname$, MAX_PATH)
' check volume mounted
IF R = 0 THEN
    PRINT "Volume: "; DriveType
    PRINT "Serial: (????-????)"
    PRINT "System: [????]"
ELSE
    ' volume label
    tmp1$ = RTRIM$(Vname$)
    v = INSTR(tmp1$, CHR$(0))
    IF v THEN tmp1$ = LEFT$(tmp1$, v - 1)
    Vname$ = tmp1$
    IF Vname$ = "" THEN Vname$ = "<none>"

    ' file system type
    tmp1$ = RTRIM$(Sname$)
    v = INSTR(tmp1$, CHR$(0))
    IF v THEN tmp1$ = LEFT$(tmp1$, v - 1)
    Fname$ = tmp1$

    ' serial number
    Sname$ = LEFT$(HEX$(serial~&), 4) + "-" + RIGHT$(HEX$(serial~&), 4)

    PRINT "Volume: "; CHR$(34) + RTRIM$(Vname$) + CHR$(34)
    PRINT "Serial: ("; Sname$; ")"
    PRINT "System: ["; RTRIM$(Fname$); "]"
END IF
GetFileInfo = -1
COLOR 15, 0
PRINT "-more-";
WHILE INKEY$ = ""
    _LIMIT 50
WEND
CLS
END FUNCTION

' check drive exists.
'  returns -1 if drive not detected.
FUNCTION DRIVEEXISTS (V)
VarX$ = CHR$(V + 64) + ":\" + CHR$(0)
VarX = GetDriveType(VarX$)
DriveType = ""
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 = 0
ELSE
    DRIVEEXISTS = -1
END IF
END FUNCTION