Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Simple Drive Display
#11
(12-10-2022, 09:06 AM)eoredson Wrote: Actually I was thinking more upon this:

Code: (Select All)
Declare Library
  Function GetDriveType& (d$)
End Declare

' declare library variables.
Dim Shared DriveType As String

' call drive type
For z = 1 To 26
   x = DRIVEEXISTS(z)
   If x = 0 Then
      Print Chr$(z + 64) + ": "; DriveType
   End If
Next
End

' 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

That's pretty neat!

Rho had something at .rip similar using Win32 API...

Rhosigma: https://qb64forum.alephc.xyz/index.php?t...#msg128764
Code: (Select All)
Declare Library
    Function GetLogicalDriveStringsA& (ByVal bufSize&, buffer$)
End Declare

'--- get available drives once during your program init procedure ---
Dim Shared allDrives$
buffer$ = Space$(112)
length% = GetLogicalDriveStringsA&(Len(buffer$), buffer$)
allDrives$ = ""
For position% = 1 To length% Step 4
    allDrives$ = allDrives$ + Mid$(buffer$, position%, 1)
Next position%

'--- in your program flow test drives whenever needed (returns false(0) or true(-1)) ---
Print DRIVEEXISTS%("A")
Print DRIVEEXISTS%("B")
Print DRIVEEXISTS%("C")
Print DRIVEEXISTS%("D")
End

'--- a quick test function ---
Function DRIVEEXISTS% (drv$)
    DRIVEEXISTS% = (InStr(allDrives$, UCase$(drv$)) > 0)
End Function

So far, I haven't come across anything that is strictly in QB64 that will go into a description like the program you posted, but, you could combine my code with yours and get...

Code: (Select All)
Declare Library
    Function GetDriveType& (d$)
End Declare

On Error GoTo er1
' declare library variables.
Dim Shared As String DriveType, DriveStatus

' call drive type
For z = 1 To 26

    x = DRIVEEXISTS(z)
    If x = 0 Then
        DriveStatus = "Active"
        Open Chr$(z + 64) + ":\" + Chr$(0) For Input As #1: Close #1
        Print Chr$(z + 64) + ": "; DriveType; " "; DriveStatus
    End If
Next
End

er1:
er% = Err
Select Case er%
    Case 76
        ' Not found so do nothing.
    Case 53
        DriveStatus = "Active"
    Case 68
        DriveStatus = "Not Ready"
End Select
Resume Next

' 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

Now we get the drive, some details, and its ready status.

Pete
Reply
#12
@mhrvovrfc:
Yes, the code could be easily edited to your liking.

I just posted it as an example and have no need to change it.

Erik.

btw: what does mhrvovrfc stand for??
Reply
#13
@pete:

The
Code: (Select All)
GetLogicalDriveStringsA&(Len(buffer$), buffer$)

Might be of some use.

Erik.

btw: your combination of error trap with getdrivetype is cute.
Reply
#14
(12-11-2022, 03:00 AM)eoredson Wrote: @pete:

The
Code: (Select All)
GetLogicalDriveStringsA&(Len(buffer$), buffer$)

Might be of some use.

Erik.

btw: your combination of error trap with getdrivetype is cute.

If you are interested, there are some extensive examples, here: https://qb64forum.alephc.xyz/index.php?t...#msg119203
Reply
#15
(12-11-2022, 03:45 AM)Pete Wrote:
(12-11-2022, 03:00 AM)eoredson Wrote: @pete:

The
Code: (Select All)
GetLogicalDriveStringsA&(Len(buffer$), buffer$)

Might be of some use.

Erik.

btw: your combination of error trap with getdrivetype is cute.

If you are interested, there are some extensive examples, here: https://qb64forum.alephc.xyz/index.php?t...#msg119203

I looked at this link and found some interesting dialog box stuff.

Not anything I need to use right now.

Erik.
Reply
#16
(12-11-2022, 02:43 AM)eoredson Wrote: Yes, the code could be easily edited to your liking.

I just posted it as an example and have no need to change it.

Erik.
Thank you.


(12-11-2022, 02:43 AM)eoredson Wrote: btw: what does mhrvovrfc stand for??
I don't know. Change "h" to "n", but you have to look at my forum signature for part of it. I cannot reveal a personal thing otherwise.
Reply
#17
(12-11-2022, 05:30 AM)eoredson Wrote:
(12-11-2022, 03:45 AM)Pete Wrote:
(12-11-2022, 03:00 AM)eoredson Wrote: @pete:

The
Code: (Select All)
GetLogicalDriveStringsA&(Len(buffer$), buffer$)

Might be of some use.

Erik.

btw: your combination of error trap with getdrivetype is cute.

If you are interested, there are some extensive examples, here: https://qb64forum.alephc.xyz/index.php?t...#msg119203

I looked at this link and found some interesting dialog box stuff.

Actually this dialog.bas stuff is so amazing I am going to include it my QB64shell program solving a problem I have been getting with file menu box.

Erik.
Reply
#18
Nice. I'm glad you found some useful stuff. It's a shame .rip happened, but I thank luke for keeping his mirror site up for us.

Pete
Reply
#19
From the wiki, there's this simple routine:

Code: (Select All)
Const REMOVABLE = 2
Const FIXED = 3
Const REMOTE = 4
Const CDROM = 5
Const RAMDISK = 6

Declare Library
    Function GetDriveTypeA& (nDrive As String)
    Function GetLogicalDriveStringsA (ByVal nBuff As Long, lpbuff As String)
End Declare

Dim DList As String, DL As String
Dim i As Long, typ As Long

i = GetLogicalDriveStringsA(0, DList) 'zero returns the drive string byte size
DList = Space$(i) 'set drive string length. Each drive is followed by CHR$(0)
i = GetLogicalDriveStringsA(i, DList) 'the byte size returns a string that long
Print DList

For n = 65 To 90
    If InStr(DList, Chr$(n)) Then
        DL = Chr$(n) + ":\" + Chr$(0)
        typ = GetDriveTypeA(DL)
        Select Case typ
            Case REMOVABLE: Print DL + "Removable"
            Case FIXED: Print DL + "Fixed"
            Case REMOTE: Print DL + "Remote"
            Case CDROM: Print DL + "CDROM"
            Case RAMDISK: Print DL + "RAM"
        End Select
    End If
Next
Reply
#20
That's some excellent code we were just working on combining 2 subroutines for the exact same purpose!

btw: dialog.bas needs some serious tweaking on the Title$

Erik.
Reply




Users browsing this thread: 3 Guest(s)