'IN frmMain
'Beispiel : Ermittlung aller sich im System befindenden CD-Laufwerke und 
' Ausgabe in einem Menue.2.
'Hallo laf...
'Hier ein kleines Lösungsbeispiel wie Du vorhandene CD Laufwerke in ein Menue 
' einfuegen kannst.
'Da das Beispiel in VB 5 geschrieben wurde, wird hier die Funktion <Split> 
' verwendet. Solltest
'Du VB 6 verwenden kannst Du diese Funktion auskommentieren.
'Testumgebung : W98
'NG.:03.04.03.do.
 
Private Sub Form_Load()
    Dim Result  As String
    Dim n       As Long
 
    Result = GetCDRomDrive
    Debug.Print Result & " Result"
    If drvCount > 0 Then
        For n = 1 To drvCount - 1
            Load mnuCDLetter(n)
        Next
 
        Dim arrCaption As Variant
        arrCaption = Split(Result, (Chr(0)))
        For n = LBound(arrCaption) To UBound(arrCaption)
            mnuCDLetter(n).Caption = arrCaption(n)
            Debug.Print n
        Next
    Else
        Call MsgBox("Keine CD Laufwerke gefunden...", , "Info...")
        Exit Sub
    End If
End Sub
 
Private Sub mnuCDLetter_Click(Index As Integer)
    Call MsgBox(mnuCDLetter(Index).Caption, vbInformation, "Info...")
End Sub
 
Public Function Split(Source As String, Optional mChar As Variant) As Variant
    Dim n             As Long
    Dim lPos          As Long
    Dim sTmp          As String
    ReDim arrSplit(0) As String
 
    If IsMissing(mChar) Then mChar = " "
 
    sTmp = Source
    lPos = InStr(sTmp, mChar)
    '
    Do While lPos
        If n > UBound(arrSplit) Then
            ReDim Preserve arrSplit(0 To n) As String
        End If
        '
        arrSplit(n) = Left$(sTmp, lPos - 1)
        sTmp = Mid$(sTmp, lPos + Len(mChar))
        lPos = InStr(sTmp, mChar)
        n = n + 1
    Loop
    '
    If Len(sTmp) Then
        If n > UBound(arrSplit) Then
            ReDim Preserve arrSplit(0 To n) As String
        End If
        arrSplit(n) = sTmp
    End If
 
    Split = arrSplit
    sTmp = vbNullString
    ReDim arrSplit(n)
End Function
 
'IN modDriveString
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 Type DriveReturn
    lRetInStr   As Long
    lRet        As Long
    sDrv        As String
End Type
 
Public drvCount As Integer
 
Public Function GetCDRomDrive() As String
    Dim dr              As DriveReturn
    Dim sRet            As String
    Dim lDrvType        As Long
 
    drvCount = 0
    With dr
        .sDrv = Space$(64)
        .lRet = GetLogicalDriveStrings(Len(.sDrv), .sDrv)
        .sDrv = Left$(.sDrv, .lRet)
    End With
    Do
        dr.lRetInStr = InStr(dr.sDrv, Chr$(0))
            If dr.lRetInStr Then
                sRet = Left$(dr.sDrv, dr.lRetInStr - 1)
                dr.sDrv = Mid$(dr.sDrv, dr.lRetInStr + 1, Len(dr.sDrv))
                lDrvType = GetDriveType(sRet)
                If lDrvType = 5 Then
                    drvCount = drvCount + 1
                    GetCDRomDrive = GetCDRomDrive & UCase$(sRet) & Chr(0)
                    Debug.Print drvCount
                End If
            End If
    Loop Until dr.sDrv = ""
End Function
'MfG 
'Frank