basicqbasicqb64

How To Get Drive Label And Drive Serial Number In QB64


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.


Solution

  • 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