Looking for a reliable way to determine if a drive letter is in use

[Steffan-68]

I found something else in my hodgepodge, maybe that can help. 

Code: (Select All)

'LETTER_OF_USB_DEVICE  'program by Euklides
'Working with files on USB devices

'When you write a program using files located on USB drives, you don't be
'sure that the letter of this drive is always the same.
'You cannot write for instance:

'         OPEN "F:\MYFILE\info.txt" FOR INPUT AS #1
'         ...

'If your drive has a new letter, for instance "E", you must go into your program
' and change the letter
'So what you can do is this:

'1) '  find the serial of your drive
'  Use below:

'         GOSUB SERIALSSHOW

'  and you will see all the serials of then actuel connected drives
'  For instance, the good drive has the serial "<9911-447E>

'2) Now write your program so:

'        fic$ = "<9911-447E>:\MYFILE\info.txt"
'        GOSUB DRIVELETTERFIND: IF _CLIPBOARD$ = "" THEN PRINT "USB unit is not connected for using " + fic$: END
'        fic$ = _CLIPBOARD$:OPEN fic$ FOR INPUT AS #1
'       ...


'End


'=====================================================================
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, SERIALFOUND As String
'---
SERIALSSHOW:
For q = 1 To 26: X = GetFileInfo(q): If SERIALFOUND <> "<!!!-!!!>" Then Print " "; Chr$(64 + q) + ":    "; SERIALFOUND
Next q
End
'---
DRIVELETTERFIND: 'in-->fic$ like' "<SER-IAL>ficname"  out--> like "D:\ficname"
_Clipboard$ = "": K$ = UCase$(Left$(fic$, 2))
If Right$(K$, 1) = ":" And Left$(K$, 1) >= "A" And Left$(K$, 1) <= "Z" And DRIVEEXISTS(Asc(K$) - 64) = 1 Then _Clipboard$ = fic$: Return
J1 = InStr(fic$, "<"): J2 = InStr(J1, fic$, ">")
If J1 = 0 Or J2 = 0 Then Print fic$; " must be written like: <serial>\ficmame...": End
Serialsearch$ = Mid$(fic$, J1, J2 - J1 + 1): q = 0
For q = 1 To 26: X = GetFileInfo(q)
    If SERIALFOUND = Serialsearch$ Then
        fic$ = Right$(fic$, Len(fic$) - J2): If Left$(fic$, 1) <> ":" Then fic$ = ":" + fic$
        fic$ = Chr$(64 + q) + fic$: _Clipboard$ = fic$
    End If
Next q
Return
'---
Function GetFileInfo (D)
    SERIALFOUND = "<!!!-!!!>":
    If DRIVEEXISTS(D) <> 1 Then GetFileInfo = 0: Exit Function
    Dname$ = Chr$(D + 64) + ":\": Sname$ = Space$(260)
    R = GetVolumeInformationA(Dname$ + Chr$(0), Vname$, 260, serial~&, empty1~&, empty2~&, Sname$, 260)
    If R = 0 Then Exit Function
    Sname$ = Left$(Hex$(serial~&), 4) + "-" + Right$(Hex$(serial~&), 4)
    SERIALFOUND = "<" + Sname$ + ">"
    GetFileInfo = -1
End Function
'---
Function DRIVEEXISTS (V)
    DRIVEEXISTS = 0: varX$ = Chr$(V + 64) + ":\" + Chr$(0): VarX = GetDriveType(varX$): If VarX > 1 Then DRIVEEXISTS = 1
End Function
'=====================================================================

   

My Pc Drives

C: is a Drive
D: Partition on C:
E: Partition on F:
F: is a Drive
G: is a USB Stick