Posts: 2,177
Threads: 222
Joined: Apr 2022
Reputation:
104
12-10-2022, 05:39 PM
(This post was last modified: 12-10-2022, 05:53 PM by Pete.)
(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
Posts: 369
Threads: 71
Joined: Jul 2022
Reputation:
14
12-11-2022, 02:43 AM
(This post was last modified: 12-11-2022, 03:04 AM by eoredson.)
@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??
Posts: 369
Threads: 71
Joined: Jul 2022
Reputation:
14
12-11-2022, 03:00 AM
(This post was last modified: 12-11-2022, 03:28 AM by eoredson.)
@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.
Posts: 2,177
Threads: 222
Joined: Apr 2022
Reputation:
104
(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
Posts: 369
Threads: 71
Joined: Jul 2022
Reputation:
14
(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.
Posts: 1,586
Threads: 59
Joined: Jul 2022
Reputation:
52
(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.
Posts: 369
Threads: 71
Joined: Jul 2022
Reputation:
14
(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.
Posts: 2,177
Threads: 222
Joined: Apr 2022
Reputation:
104
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
Posts: 2,697
Threads: 327
Joined: Apr 2022
Reputation:
217
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
Posts: 369
Threads: 71
Joined: Jul 2022
Reputation:
14
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.
|