Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0701: CD-ROM Laufwerk Name, TOC und Sektoren lesen

VB 5/6-Tipp 0701: CD-ROM Laufwerk Name, TOC und Sektoren lesen

 von Arne Elster

Schwierigkeitsgrad:

Verwendete API-Aufrufe: CloseHandle, RtlMoveMemory (CopyMemory), CreateFileA (CreateFile), DeviceIoControl, GetVersionExA (GetVersionEx)

Download: Download des Beispielprojektes [6,83 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei prjCDROM.vbp -------------
'------- Anfang Formular "frmMain" alias frmMain.frm  -------

Option Explicit

Private Sub Form_Load()
    Dim lstInfo     As ListBox
    Dim toc         As formated_toc
    Dim i           As Long
    Dim j           As Long
    Dim LBA         As Long
    Dim msf         As msf
    Dim strDrive    As String
    Dim btSector()  As Byte

    strDrive = InputBox("Bitte CD/DVD-ROM Laufwerksbuchstaben eingeben", , "E:")

    Me.Width = 4500
    Me.Height = 6000

    Set lstInfo = Controls.Add("VB.ListBox", "lstInfo")
    With lstInfo
        .Width = Me.ScaleWidth
        .Height = Me.ScaleHeight
        .Top = 0
        .Left = 0
        .Visible = True
    End With

    ' Test Unit Ready - auch von Festplatten unterstützt
    lstInfo.AddItem strDrive & " bereit: " & IsDriveReady(strDrive)

    ' Inquiry - auch von Festplatten unterstützt
    ' gibt Produktinfos zurück, u.a. Gerätenamen
    lstInfo.AddItem strDrive & " Name: " & GetDriveName(strDrive)

    ' Unformatierte TOC (Table Of Contents) lesen.
    ' Vielleicht nicht von uralten Laufwerken
    ' (Baujahr < Ende 1999) unterstützt.
    toc = GetDriveTOC(strDrive)

    ' Prüfen, ob TOC gelesen werden konnte
    If toc.toc_valid Then
        ' Anzahl an Sessions auf der CD
        lstInfo.AddItem "CD Sessions: " & toc.num_sessions
        ' Anzahl an Tracks auf der CD
        lstInfo.AddItem "CD Tracks: " & toc.num_tracks

        ' Größe der CD über Adresse des
        ' Lead-Outs der letzten Session ermitteln
        With toc.sessions(toc.num_sessions - 1)
            With .tracks(.num_tracks)
                lstInfo.AddItem "CD Größe: " & (.start_lba * 2352) \ (1024 ^ 2) & " MB"
            End With
        End With

        lstInfo.AddItem ""

        For i = 1 To toc.num_sessions
            With toc.sessions(i - 1)
                ' Session Info
                lstInfo.AddItem ">> Session " & Format(.session, "00")
                lstInfo.AddItem ">>>> Tracks: " & .num_tracks

                lstInfo.AddItem ""

                ' Info zu jedem Track in der Session
                For j = 0 To .num_tracks - 1
                    With .tracks(j)
                        lstInfo.AddItem ">>>> Track " & Format(.track, "00")
                        lstInfo.AddItem ">>>> Audio: " & .audio
                        lstInfo.AddItem ">>>> Start: " & .start_lba & _
                            " LBA (" & msf_to_str(.start_msf) & " MSF)"
                        LBA = .start_lba
                    End With

                    ' Der letzte Eintrag in tracks() steht für das Lead-Out.
                    ' Track Größe = LBA(Track + 1) - LBA(Track)
                    LBA = .tracks(j + 1).start_lba - LBA
                    lstInfo.AddItem ">>>> Länge: " & LBA & _
                        " LBA (" & msf_to_str(lba_to_msf(LBA)) & " MSF)"
                    lstInfo.AddItem ">>>> Größe: " & (LBA * 2352) \ (1024 ^ 2) & " MB"
                    lstInfo.AddItem ""
                Next
            End With
        Next
    Else
        lstInfo.AddItem "Konnte TOC nicht lesen"
    End If

    lstInfo.AddItem ""

    ' 1 Sektor im Raw Modus lesen, heißt, den Sektor komplett
    ' (ohne Sub Channels) auslesen. 1 Sektor ist 2352 Bytes groß.
    '
    ' Würde man nur die Userdaten eines Mode-1 (Daten) Sektors
    ' auslesen wollen, müsste man den Buffer 2048 Bytes groß machen
    ' (und die Flags natürlich auf Userdata stellen).
    ReDim btSector(2352 - 1) As Byte

    ' Sektor 16 auslesen, bei ISO9660 Daten CDs ist das der erste
    ' Sektor es Dateisystems. Das Maximum sind knapp 26 Sektoren für RAW,
    ' da der jeweilige Treiber meistens nicht mehr als 65536 Bytes pro
    ' Befehl aufnehmen kann.
    '
    ' Einen kompletten Track könnte man in
    ' Verbindung mit den LBA Zahlen der TOC auslesen.
    '
    ' Viele alte Laufwerke produzieren beim Auslesen von Audio Tracks
    ' Fehler, da diesen im Gegensatz zu Datentracks ein Synchronisationsmuster fehlt.
    ' Im Internet finden sich verschiedene Verfahren (Jitter Korrektur),
    ' um solche Fehler auszubügeln. Einige ältere Laufwerke unterstützen den
    ' READ CD OpCode auch nicht, da müsste man auf READ10 oder READ12
    ' ausweichen, die aber AFAIK nur Daten Tracks auslesen können.
    '
    ' Für mehr Infos zu READ CD die MMCs durchblättern!
    If GetDriveSectors(strDrive, 16, 1, RD_RAW, VarPtr(btSector(0)), 2352) Then
        lstInfo.AddItem "Erfolgreich Sektor 16 Raw gelesen!"
        Debug.Print StrConv(btSector, vbUnicode)
    Else
        lstInfo.AddItem "Konnte Sektor 16 nicht auslesen!"
    End If
End Sub
'-------- Ende Formular "frmMain" alias frmMain.frm  --------
'-------- Anfang Modul "modCDROM" alias modCDROM.bas --------

Option Explicit

' Low Level CD/DVD-ROM Programmierung
'
' Standards:
' MMC und SPC Reihe
' http://t10.org/drafts.htm
'
' nur für Windows >= NT, Win 9x/Me nicht unterstützt
' zusätzlich Administrator Rechte benötigt

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" ( _
    lpVersionInformation As OSVERSIONINFOEX _
) As Long

Private Declare Function DeviceIoControl Lib "kernel32" ( _
    ByVal hDevice As Long, _
    ByVal dwIoControlCode As Long, _
    ByRef lpInBuffer As Any, _
    ByVal nInBufferSize As Long, _
    ByRef lpOutBuffer As Any, _
    ByVal nOutBufferSize As Long, _
    ByRef lpBytesReturned As Long, _
    lpOverlapped As Any _
) As Long

Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" ( _
    ByVal lpFileName As String, _
    ByVal dwDesiredAccess As Long, _
    ByVal dwShareMode As Long, _
    ByVal lpSecurityAttributes As Long, _
    ByVal dwCreationDisposition As Long, _
    ByVal dwFlagsAndAttributes As Long, _
    ByVal hTemplateFile As Long _
) As Long

Private Declare Function CloseHandle Lib "kernel32" ( _
    ByVal hObject As Long _
) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    Destination As Any, _
    source As Any, _
    ByVal length As Long _
)

Private Type OSVERSIONINFOEX
    dwOSVersionInfoSize As Long
    dwMajorVersion      As Long
    dwMinorVersion      As Long
    dwBuildNumber       As Long
    dwPlatformId        As Long
    szCSDVersion        As String * 128
End Type

Private Type SPTD
    length              As Integer
    ScsiStatus          As Byte
    PathId              As Byte
    TargetID            As Byte
    LUN                 As Byte
    CdbLength           As Byte
    SenseInfoLength     As Byte
    DataIn              As Byte
    DataTransferLength  As Long
    TimeOutValue        As Long
    DataBuffer          As Long
    SenseInfoOffset     As Long
    cdb(15)             As Byte
    Fill(2)             As Byte
End Type

Private Type SPTD_W_BUF
    SPT                 As SPTD
    SenseBuffer(35)     As Byte
End Type

Private Type full_toc_packet
    session             As Byte
    adr_ctl             As Byte
    tno                 As Byte
    point               As Byte
    min                 As Byte
    sec                 As Byte
    frame               As Byte
    zero                As Byte
    pmin                As Byte
    psec                As Byte
    pframe              As Byte
End Type

Private Type full_toc
    length(1)           As Byte
    first_session       As Byte
    last_session        As Byte
    packet(255)         As full_toc_packet
End Type

Public Type msf
    min                 As Byte
    sec                 As Byte
    frame               As Byte
End Type

Public Type formated_toc_track
    track               As Byte
    session             As Byte
    audio               As Boolean
    start_lba           As Long
    start_msf           As msf
End Type

Public Type formated_toc_session
    session             As Byte
    num_tracks          As Byte
    tracks()            As formated_toc_track
End Type

Public Type formated_toc
    toc_valid           As Boolean
    num_tracks          As Byte
    num_sessions        As Byte
    sessions()          As formated_toc_session
End Type

Public Type inquiry
    qualifier           As Byte
    rsvd1               As Byte
    version             As Byte
    respfmt             As Byte
    addlen              As Byte
    rsvd2               As Byte
    stuff(1)            As Byte
    vendor(7)           As Byte
    product(15)         As Byte
    revision(3)         As Byte
    rsvd3(1)            As Byte
    stuff2(37)          As Byte
End Type

Private Type HFILE
    path                As String
    handle              As Long
End Type

Public Enum disc_type
    DISC_TYPE_DATA_DA = &H0
    DISC_TYPE_CDI = &H10
    DISC_TYPE_CDXA = &H20
End Enum

Public Enum cd_read_flags
    RD_SYNC = &H80          ' Sync Muster (nur für Daten)
    RD_HEADER_CODES = &H60  '
    RD_USER_DATA = &H10     ' z.B. 2048 Bytes/Sektor für Mode-1
    RD_EDCECC = &H8         ' EDC/ECC
    RD_ERROR_FIELD = &H6    ' C2
    RD_RAW = &HF8           ' 2352 Bytes/Sektor
End Enum

Private Enum spti_direction
    SCSI_IOCTL_DATA_OUT = 0
    SCSI_IOCTL_DATA_IN = 1
    SCSI_IOCTL_DATA_UNSPECIFIED = 2
End Enum

Private Const INVALID_HANDLE_VALUE  As Long = -1
Private Const OPEN_EXISTING         As Long = &H3
Private Const GENERIC_READ          As Long = &H80000000
Private Const GENERIC_WRITE         As Long = &H40000000
Private Const FILE_SHARE_READ       As Long = &H1
Private Const FILE_SHARE_WRITE      As Long = &H2

Private Const IOCTL_SPTD            As Long = &H4D014

Private Const VER_PLATFORM_WIN32_NT As Long = &H2

Private Function IsW2K() As Boolean
    Dim sys As OSVERSIONINFOEX

    sys.dwOSVersionInfoSize = Len(sys)
    GetVersionEx sys

    If sys.dwPlatformId = VER_PLATFORM_WIN32_NT Then
        IsW2K = sys.dwMajorVersion >= 5
    End If
End Function

Public Function GetDriveSectors( _
    ByVal strDrive As String, _
    ByVal LBA As Long, _
    ByVal sectors As Long, _
    ByVal flags As cd_read_flags, _
    ByVal buffer_ptr As Long, _
    ByVal buffer_len As Long _
) As Boolean

    Dim cdb(9)  As Byte
    Dim hDrive  As HFILE

    hDrive = GetDriveHandle(strDrive)
    If hDrive.handle = INVALID_HANDLE_VALUE Then
        Exit Function
    End If

    cdb(0) = &HBE                       ' READ CD OpCode
    cdb(2) = (LBA \ &H1000000) And &HFF
    cdb(3) = (LBA \ &H10000) And &HFF
    cdb(4) = (LBA \ &H100) And &HFF
    cdb(5) = (LBA) And &HFF
    cdb(6) = (sectors \ &H10000) And &HFF
    cdb(7) = (sectors \ &H100) And &HFF
    cdb(8) = (sectors) And &HFF
    cdb(9) = flags

    GetDriveSectors = ExecCMD(hDrive.handle, cdb, 10, _
                              SCSI_IOCTL_DATA_IN, _
                              buffer_ptr, buffer_len)

    CloseDriveHandle hDrive
End Function

Public Function GetDriveTOC(ByVal strDrive As String) As formated_toc
    Dim toc         As full_toc
    Dim fmt_toc     As formated_toc
    Dim hDrive      As HFILE
    Dim cdb(9)      As Byte
    Dim i           As Long
    Dim packets     As Long
    Dim btLast      As Byte
    Dim lngLOLBA    As Long
    Dim bln         As Boolean

    hDrive = GetDriveHandle(strDrive)
    If hDrive.handle = INVALID_HANDLE_VALUE Then
        Exit Function
    End If

    cdb(0) = &H43               ' READ TOC OpCode
    cdb(1) = 0                  ' LBA Format
    cdb(2) = 2                  ' volle TOC
    cdb(6) = 1                  ' Start bei Session 1
    cdb(7) = Len(toc) \ &H100
    cdb(8) = Len(toc) And &HFF

    bln = ExecCMD(hDrive.handle, cdb, 10, _
                  SCSI_IOCTL_DATA_IN, _
                  VarPtr(toc), Len(toc))

    CloseDriveHandle hDrive

    If Not bln Then Exit Function

    fmt_toc.toc_valid = True

    With toc
        packets = .length(0) * &H100 Or .length(1)
        packets = packets / Len(toc.packet(0))
    End With

    For i = 0 To packets - 1
        ' Packete mit ADR > 1 ingorieren
        If (toc.packet(i).adr_ctl \ &H10) > 1 Then
            Goto SkipPacket
        End If

        With fmt_toc

            ' neue Session angefangen?
            If toc.packet(i).session > fmt_toc.num_sessions Then
                .num_sessions = toc.packet(i).session
                ReDim Preserve .sessions(.num_sessions - 1)
                .sessions(.num_sessions - 1).session = toc.packet(i).session
            End If

            ' Track
            If toc.packet(i).point > 0 And toc.packet(i).point < 100 Then

                .num_tracks = toc.packet(i).point

                With .sessions(.num_sessions - 1)
                    .num_tracks = .num_tracks + 1
                    ReDim Preserve .tracks(.num_tracks - 1)
                    .tracks(.num_tracks - 1).session = .session
                    .tracks(.num_tracks - 1).track = toc.packet(i).point

                    With .tracks(.num_tracks - 1)
                        .start_msf = to_msf(toc.packet(i).pmin, _
                            toc.packet(i).psec, toc.packet(i).pframe)
                        .start_lba = msf_to_lba(.start_msf)
                        .audio = Not CBool(toc.packet(i).adr_ctl And &H4)
                    End With

                    If toc.packet(i).point = btLast Then
                        ReDim Preserve .tracks(.num_tracks)
                        .tracks(.num_tracks).session = .session
                        .tracks(.num_tracks).track = &HFF
                        .tracks(.num_tracks).start_lba = lngLOLBA
                        .tracks(.num_tracks).start_msf = lba_to_msf(lngLOLBA)
                    End If
                End With

            ' Letzter Track in Session
            ElseIf toc.packet(i).point = &HA1 Then
                btLast = toc.packet(i).pmin

            ' Session Lead-Out
            ElseIf toc.packet(i).point = &HA2 Then
                lngLOLBA = msf_to_lba(to_msf(toc.packet(i).pmin, _
                    toc.packet(i).psec, toc.packet(i).pframe))

            End If

        End With

SkipPacket:
    Next

    GetDriveTOC = fmt_toc
End Function

Public Function GetDriveName(ByVal strDrive As String) As String
    Dim udtInq  As inquiry
    Dim strName As String
    Dim hDrive  As HFILE
    Dim cdb(5)  As Byte

    hDrive = GetDriveHandle(strDrive)
    If hDrive.handle = INVALID_HANDLE_VALUE Then
        Exit Function
    End If

    cdb(0) = &H12           ' Inquiry OpCode
    cdb(4) = Len(udtInq)

    ExecCMD hDrive.handle, cdb, 6, SCSI_IOCTL_DATA_IN, _
            VarPtr(udtInq), Len(udtInq)

    CloseDriveHandle hDrive

    strName = Trim$(StrConv(udtInq.vendor, vbUnicode)) & " " & _
              Trim$(StrConv(udtInq.product, vbUnicode)) & " " & _
              Trim$(StrConv(udtInq.revision, vbUnicode))

    GetDriveName = Replace(strName, Chr$(0), "")
End Function

Public Function IsDriveReady(ByVal strDrive As String) As Boolean
    Dim hDrive  As HFILE
    Dim cdb(5)  As Byte

    hDrive = GetDriveHandle(strDrive)
    If hDrive.handle = INVALID_HANDLE_VALUE Then
        Exit Function
    End If

    IsDriveReady = ExecCMD(hDrive.handle, cdb, 6, SCSI_IOCTL_DATA_IN, 0, 0)

    CloseDriveHandle hDrive
End Function

Public Function to_msf(ByVal min As Byte, ByVal sec As Byte, ByVal frame As Byte) As msf
    With to_msf
        .min = min
        .sec = sec
        .frame = frame
    End With
End Function

Public Function msf_to_lba(fmt As msf, Optional pos As Boolean) As Long
    With fmt
        msf_to_lba = .min * 60& * 75& + (.sec * 75&) + .frame
    End With

    If fmt.min < 90& Or pos Then
        msf_to_lba = msf_to_lba - 150&
    Else
        msf_to_lba = msf_to_lba - 450150
    End If
End Function

Public Function lba_to_msf(ByVal LBA As Long) As msf
    Dim start   As Long

    start = Choose(Abs(CBool(LBA >= -150&)) + 1&, 450150, 150&)

    With lba_to_msf
        .min = Fix((LBA + start) / (60& * 75&))
        .sec = Fix((LBA + start - .min * 60& * 75&) / 75&)
        .frame = Fix(LBA + start - .min * 60& * 75& - .sec * 75&)
    End With
End Function

Public Function msf_to_str(msf As msf) As String
    With msf
        msf_to_str = Format(.min, "00") & ":" & _
                     Format(.sec, "00") & "." & _
                     Format(.frame, "00")
    End With
End Function

Private Function GetDriveHandle(ByVal strDrive As String) As HFILE
    Dim fh  As Long
    Dim flg As Long

    strDrive = Left$(strDrive, 1)

    flg = GENERIC_READ Or IIf(IsW2K(), GENERIC_WRITE, 0)

    fh = CreateFile("\\.\" & strDrive & ":", flg, _
                    FILE_SHARE_READ Or FILE_SHARE_WRITE, _
                    ByVal 0&, OPEN_EXISTING, 0, 0)

    GetDriveHandle.handle = fh
    GetDriveHandle.path = strDrive & ":\"
End Function

Private Sub CloseDriveHandle(hf As HFILE)
    CloseHandle hf.handle
    hf.handle = INVALID_HANDLE_VALUE
    hf.path = ""
End Sub

Private Function ExecCMD( _
    ByVal handle As Long, _
    ByRef cdb() As Byte, _
    ByVal cdblen As Byte, _
    ByVal datadir As spti_direction, _
    ByVal buffer_ptr As Long, _
    ByVal buffer_len As Long, _
    Optional ByVal timeout As Long = 5 _
) As Boolean

    Dim BytesRet    As Long
    Dim lngStatus   As Long
    Dim SPT         As SPTD_W_BUF

    With SPT.SPT
        .length = Len(SPT.SPT)
        .SenseInfoLength = UBound(SPT.SenseBuffer) - 4
        .SenseInfoOffset = Len(SPT.SPT) + 4
        .TimeOutValue = IIf(timeout > 0, timeout, 10800)
        .DataIn = datadir
        .DataBuffer = buffer_ptr
        .DataTransferLength = buffer_len
        .CdbLength = cdblen

        CopyMemory .cdb(0), cdb(0), cdblen
    End With

    lngStatus = DeviceIoControl(handle, IOCTL_SPTD, _
                                SPT, Len(SPT), SPT, Len(SPT), _
                                BytesRet, ByVal 0&)

    ExecCMD = SPT.SPT.ScsiStatus = 0
End Function
'--------- Ende Modul "modCDROM" alias modCDROM.bas ---------
'-------------- Ende Projektdatei prjCDROM.vbp --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 2 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.