Hi all,
I have write this program which is used to detect CD ROM.
You just need to add a command button.
- 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
-
-
Const DRIVE_CDROM& = 5
-
-
Public Function GetDriveStrings() As String
-
' Wrapper for calling the GetLogicalDriveStrings api
-
-
Dim result As Long ' Result of our API calls
-
Dim strDrives As String ' String to pass to API call
-
Dim lenStrDrives As Long ' Length of the above string
-
-
' Call GetLogicalDriveStrings with a buffer size of zero to
-
' find out how large our stringbuffer needs to be
-
result = GetLogicalDriveStrings(0, strDrives)
-
-
strDrives = String(result, 0)
-
lenStrDrives = result
-
-
' Call again with our new buffer
-
result = GetLogicalDriveStrings(lenStrDrives, strDrives)
-
-
If result = 0 Then
-
' There was some error calling the API
-
' Pass back an empty string
-
' NOTE - TODO: Implement proper error handling here
-
GetDriveStrings = ""
-
Else
-
GetDriveStrings = strDrives
-
End If
-
End Function
-
-
Private Sub Command1_Click()
-
Dim strDrives As String
-
-
' Find out what drives we have on this machine
-
strDrives = GetDriveStrings()
-
-
If strDrives = "" Then
-
' No drives were found
-
MsgBox "No Drives were found!", vbCritical
-
Else
-
' Walk through the string and check the type of each drive
-
' displaying any cd-rom drives we find
-
Dim pos As Long
-
Dim drive As String
-
Dim drivetype As Long
-
-
pos = 1
-
-
Do While Not Mid$(strDrives, pos, 1) = Chr(0)
-
drive = Mid$(strDrives, pos, 3)
-
pos = pos + 4
-
drivetype = GetDriveType(drive)
-
If drivetype = DRIVE_CDROM Then
-
MsgBox "CD-ROM found at drive " & UCase(drive)
-
End If
-
Loop
-
End If
-
End Sub
Regards
>> ALI <<
