CD Sürücüsünü Bulma

Option Explicit

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6



Function StripNulls(startStrg$) As String

'Take a string separated by Chr$(0)'s, and split off 1 item, and
'shorten the string so that the next item is ready for removal.

Dim c%, item$
c% = 1

Do

If Mid$(startStrg$, c%, 1) = Chr$(0) Then

item$ = Mid$(startStrg$, 1, c% - 1)
startStrg$ = Mid$(startStrg$, c% + 1, Len(startStrg$))
StripNulls$ = item$
Exit Function

End If

c% = c% + 1

Loop

End Function
Private Sub Form_Load()

Dim r&, allDrives$, JustOneDrive$, pos%, DriveType&
Dim CDfound As Integer

'pad the string with spaces
allDrives$ = Space$(64)

'call the API to get the string containing all drives
r& = GetLogicalDriveStrings(Len(allDrives$), allDrives$)

'trim off trailing chr$(0)'s. AllDrives$
'now contains all the drive letters.
allDrives$ = Left$(allDrives$, r&)

'begin a loop
Do

'find the first separating chr$(0)
pos% = InStr(allDrives$, Chr$(0))

'if there's one, then...
If pos% Then

'extract the drive up to the chr$(0)
JustOneDrive$ = Left$(allDrives$, pos%)

'and remove that from the Alldrives string,
'so it won't be checked again
allDrives$ = Mid$(allDrives$, pos% + 1, Len(allDrives$))

'with the one drive, call the API to
'determine the drive type
DriveType& = GetDriveType(JustOneDrive$)

'check if it's what we want
If DriveType& = DRIVE_CDROM Then

'got it (or at least the first one,
'anyway, if more than one), so set
'the found flag...
CDfound% = True

'we're done, so get out
Exit Do

End If
End If

Loop Until allDrives$ = "" Or DriveType& = DRIVE_CDROM

'display the appropriate message
If CDfound% Then
Label1 = "The CD-ROM drive on your system is drive " & UCase$(JustOneDrive$)
Else: Label1 = "No CD-ROM drives were detected on your system."
End If

End Sub

Yorum Yapabilmek İçin Üye Girişi Yapmanız Gerekmektedir.

cd sürücüsünü bulma