vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Erstellen von dynamischen Kontextmen?s - wann immer Sie sie brauchen!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: Dateisystem · Laufwerke   |   VB-Versionen: VB602.05.05
IDE/SCSI Laufwerke ansprechen

Dieser Tipp zeigt, wie man mit IDE/SCSI-Laufwerke ansprechen kann. Dadurch ist eine Kommunikation mit CD/DVD-ROM Laufwerken, Festplatten etc. auf niedriger Ebene möglich.

Autor:   [rm_code]Bewertung:     [ Jetzt bewerten ]Views:  14.362 
ohne HomepageSystem:  Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

Dieser Tipp sendet an IDE/SCSI Laufwerke, dadurch ist eine Kommunikation mit CD/DVD-ROM Laufwerken, Festplatten etc. auf niedriger Ebene möglich. Dabei wird auf das SPTI (SCSI Pass-Through Interface) zurückgegriffen, genauer gesagt auf den Control Code SPTD (SCSI Pass-Through Direct), der allerdings Administrator Rechte benötigt. Dafür erlaubt dieser im Gegensatz zum Control Code SPT (SCSI Pass-Through) das verwenden eigener Puffer (bis zu 64 KB) und schnellere Kommunikation, da die Befehle nicht erst in einer Queue gelagert werden.

Einfach folgendes in ein Modul schreiben:

Option Explicit
 
' API-Deklarationen
 
' mit Treibern/Peripehrie/Dateien arbeiten
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, _
  ByRef lpOverlapped As t_OVERLAPPED) As Long
 
' Datei erstellen oder öffnen (letzteres auch für Treiber/Peripherie)
Private Declare Function CreateFile Lib "kernel32" _
  Alias "CreateFileA" ( _
  ByVal lpFileName As String, _
  ByVal dwDesiredAccess As Long, _
  ByVal dwShareMode As Long, _
  lpSecurityAttributes As Any, _
  ByVal dwCreationDisposition As Long, _
  ByVal dwFlagsAndAttributes As Long, _
  hTemplateFile As Long) As Long
 
' Windows Version abfragen
Private Declare Function GetVersionEx Lib "kernel32" _
  Alias "GetVersionExA" ( _
  lpVersionInformation As t_OSVERSIONINFOEX) As Long
 
' Ein beliebiges Handle schließen,
' in unserem Fall ein von CreateFile Zurückgegebenes
Private Declare Function CloseHandle Lib "kernel32" ( _
  ByVal hObject As Long) As Long
 
 
' Strukturen
Private Type t_InqDat
  PDT                 As Byte         ' Laufwerkstyp
  PDQ                 As Byte         ' Entfernbares Laufwerk
  VER                 As Byte         ' MMC Version (für ATAPI 0)
  RDF                 As Byte         ' Interfaceabhängiges Feld
  DLEN                As Byte         ' Zusatzlänge
  rsv1(1)             As Byte         ' reserviert
  Feat                As Byte         ' ?
  VID(7)              As Byte         ' Hersteller
  PID(15)             As Byte         ' Produkt
  PVER(3)             As Byte         ' Revision (= Firmware Version)
  FWVER(20)           As Byte         ' ?
End Type
 
Private Type t_OSVERSIONINFOEX
  dwOSVersionInfoSize As Long         ' Datenlänge
  dwMajorVersion      As Long         ' Windows Major Version
  dwMinorVersion      As Long         ' Windows Minor Version
  dwBuildNumber       As Long         ' Windows Build Nummer
  dwPlatformId        As Long         ' Windows Platform Identifier
  szCSDVersion        As String * 128 ' Windows Version als Zeichenfolge
End Type
 
 
Private Type t_SPTD
  Length              As Integer      ' Länge der Struktur
  ScsiStatus          As Byte         ' SCSI Status
  PathId              As Byte         ' Bus Nummer
  TargetId            As Byte         ' Target am Bus
  Lun                 As Byte         ' Logical Unit Number, nicht mehr benötigt
  CdbLength           As Byte         ' CDB (Command Descriptor Block) Länge
  SenseInfoLength     As Byte         ' Sense Info Länge
  DataIn              As Byte         ' Datenrichtung
  DataTransferLength  As Long         ' Datentransferlänge (Puffergröße)
  TimeOutValue        As Long         ' Timeout, nachdem der Befehl abgebrochen wird
  DataBuffer          As Long         ' Pointer zum Datenpuffer
  SenseInfoOffset     As Long         ' Sense Info Offset
  Cdb(15)             As Byte         ' Command Descriptor Block
  Fill(2)             As Byte         ' Platzhalter
End Type
 
' Obere Struktur + mehr oder weniger wichtige andere Buffer
Private Type t_SCSI_PASS_THROUGH_DIRECT_WITH_BUFFER
  spt                 As t_SPTD       ' SPTD Struktur
  Fill                As Long         ' Platzhalter
  SenseBuffer(31)     As Byte         ' Debugging-Info vom LW
End Type
 
Private Type t_OVERLAPPED
  Internal            As Long
  InternalHigh        As Long
  offset              As Long
  OffsetHigh          As Long
  hEvent              As Long
End Type
 
' Enumerationen
Public Enum e_Errors
  ERR_OK                              ' fertig
  ERR_WIN                             ' inkompatible Windows Version
  ERR_HANDLE                          ' invalides Laufwerkshandle
  ERR_SPTD_FAILED                     ' SPTD fehlgeschlagen
  ERR_SCSI_FAILED                     ' Befehl fehlgeschlagen
End Enum
 
Public Enum e_DataDir
  SCSI_IOCTL_DATA_OUT                 ' Daten an Laufwerk senden
  SCSI_IOCTL_DATA_IN                  ' Daten von Laufwerk emfpangen
  SCSI_IOCTL_DATA_UNSPECIFIED         ' Kein Datenverkehr
End Enum
 
 
' Konstanten
Private Const IOCTL_SCSI_BASE       As Long = &H4        
 
Private Const METHOD_BUFFERED       As Long = &H0        
Private Const METHOD_IN_DIRECT      As Long = &H1        
Private Const METHOD_OUT_DIRECT     As Long = &H2        
Private Const METHOD_NEITHER        As Long = &H3        
 
Private Const FILE_ANY_ACCESS       As Long = &H0        ' Voller Zugriff
Private Const FILE_READ_ACCESS      As Long = &H1        ' Lesezugriff
Private Const FILE_WRITE_ACCESS     As Long = &H2        ' Schreibzugriff
 
Private Const INVALID_HANDLE_VALUE  As Long = -1         ' Falsches Handle
Private Const OPEN_EXISTING         As Long = &H3        ' Existierende Datei öffnen
Private Const GENERIC_READ          As Long = &H80000000 ' Allgemeine Lese-Rechte
Private Const GENERIC_WRITE         As Long = &H40000000 ' Allgemeine Schreib-Rechte
Private Const FILE_SHARE_READ       As Long = &H1        ' Geteilte Lese-Rechte
Private Const FILE_SHARE_WRITE      As Long = &H2        ' Geteilte Schreib-Rechte
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80       ' ?
 
Private Const VER_PLATFORM_WIN32_NT As Long = &H2        ' Windows NT 3/4/2000/XP/Longhorn
 
' Variablen
Private IOCTL_SCSI_PASS_THROUGH_DIRECT As Long           ' DevIoCtl Code
Private blnW2K                      As Boolean           ' >= Windows 2000?
Private lngPower2(31)               As Long              ' 2er Potenzen
' Laufwerkshandle von Windows "erbetteln"
' Admin-Rechte benötigt
Private Function GetDriveHandle(ByVal drv As String, ByRef fh As Long) As Integer
  Static intWin   As Integer
 
  Dim osver   As t_OSVERSIONINFOEX
  Dim I       As Integer
  Dim flags   As Long
 
  ' Windows Version überprüfen
  If intWin < 1 Then
    ' kompatible Windows Version?
    If intWin = -1 Then
      GetDriveHandle = -1
      Exit Function
    End If
 
    osver.dwOSVersionInfoSize = Len(osver)  ' Strukturgröße
    GetVersionEx osver                      ' Windows Version lesen
 
    ' Windowsversion überprüfen, bei Windows 2000
    ' oder höher blnW2K auf TRUE setzen.
    If osver.dwPlatformId = VER_PLATFORM_WIN32_NT Then
      blnW2K = osver.dwMajorVersion >= 5
      intWin = 1
    Else
      ' inkompatible Windows Version
      intWin = -1
      Exit Function
    End If
  End If
 
 
  ' Ab Windows 2000 wird zusätzlich noch GENERIC_WRITE benötigt
  flags = GENERIC_READ
  If blnW2K Then flags = flags Or GENERIC_WRITE
 
  ' Das Handle durch CreateFile erhalten.
  ' Definition des Laufwerks durch \\.\X:", wobei X für
  ' einen Laufwerksbuchstaben steht.
  fh = CreateFile("\\.\" & drv & ":", flags, _
    FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0, _
    OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, ByVal 0)
 
  ' Korrektes Handle erhalten?
  GetDriveHandle = Abs(Not (fh = INVALID_HANDLE_VALUE))
End Function
' Befehl über das SPTI (SCSI Pass-Through Interface) ausführen
Public Function SCSICmd(ByVal drv As String, _
  ByRef cmd() As Byte, _
  ByVal CmdLen As Integer, _
  ByVal eDir As e_DataDir, _
  ByVal Pointer As Long, _
  ByVal PointerLen As Long, _
  Optional ByVal WFE As Boolean = False, _
  Optional ByVal TimeOut As Long = 5) As e_Errors
 
  Static blnCTLCode   As Boolean
 
  Dim pswb        As t_SCSI_PASS_THROUGH_DIRECT_WITH_BUFFER
  Dim OL          As t_OVERLAPPED
  Dim Length      As Long
  Dim returned    As Long
  Dim I           As Long
  Dim status      As Long
  Dim fh          As Long
 
  If Not blnCTLCode Then
    ' SPTD Control Code berrechnen
    IOCTL_SCSI_PASS_THROUGH_DIRECT = CTL_CODE(IOCTL_SCSI_BASE, &H405, _
      METHOD_BUFFERED, FILE_READ_ACCESS Or FILE_WRITE_ACCESS)
      blnCTLCode = True
  End If
 
 
  ' Erstmal das Laufwerkshandle ermitteln
  Select Case GetDriveHandle(Left$(drv, 1), fh)
    Case 0:  SCSICmd = ERR_HANDLE: Exit Function
    Case -1: SCSICmd = ERR_WIN:    Exit Function
  End Select
 
  ' Timeout überprüfen und ggf. neu setzen
  If WFE Then
    TimeOut = 9999
  Else
    If TimeOut = 0 Then TimeOut = 10
  End If
 
  With pswb.spt
    .Length = 44                                       ' Größe der Substruktur
 
    .DataIn = eDir                                     ' Datenrichtung
    .TimeOutValue = TimeOut                            ' Timeout
 
    .SenseInfoOffset = Len(pswb.spt) + Len(pswb.Fill)  ' Sense Info Offset
    .SenseInfoLength = UBound(pswb.SenseBuffer)        ' Sense Info Größe
 
    .DataTransferLength = PointerLen                   ' Datenlänge
    .DataBuffer = Pointer                              ' Datenbufferpointer
 
    For I = 0 To CmdLen - 1
      .Cdb(I) = cmd(I)                                 ' CDB aus Array
    Next I
    .CdbLength = CmdLen                                ' CDB Länge
  End With
 
  Length = Len(pswb)                                   ' Größe der Struktur
 
 
  ' SPTD (SCSI Pass-Through Direct, benötigt Administrator-Privilegien)
  ' Request über DeviceIoControl ausführen
  status = DeviceIoControl(fh, IOCTL_SCSI_PASS_THROUGH_DIRECT, _
    pswb, Length, pswb, Length, returned, OL)
 
  ' Laufwerkshandle wieder schließen
  CloseHandle fh
 
  ' Requeststatus auswerten, auf Erfolg überprüfen
  If Not (status = 1) Then
    SCSICmd = ERR_SPTD_FAILED
    Exit Function
  End If
 
  If Not (pswb.spt.ScsiStatus = 0) Then
    SCSICmd = ERR_SCSI_FAILED
    Exit Function
  End If
 
  SCSICmd = ERR_OK
End Function
' >>Operator in VB<
' von VB-Accelerator
Public Function RShift(ByVal lThis As Long, ByVal lBits As Long) As Long
  Static init As Boolean
 
  If Not init Then InitShifting: init = True
 
  If (lBits <= 0) Then
    RShift = lThis
  ElseIf (lBits > 63) Then
    Exit Function
  ElseIf (lBits > 31) Then
    RShift = 0
  Else
    If (lThis And lngPower2(31)) = lngPower2(31) Then
      RShift = (lThis And &H7FFFFFFF) \ lngPower2(lBits) _
        Or lngPower2(31 - lBits)
    Else
      RShift = lThis \ lngPower2(lBits)
    End If
  End If
End Function
' << Operator in VB
' von VB-Accelerator
Public Function LShift(ByVal lThis As Long, ByVal lBits As Long) As Long
  Static init As Boolean
 
  If Not init Then InitShifting: init = True
 
  If (lBits <= 0) Then
    LShift = lThis
  ElseIf (lBits > 63) Then
    Exit Function
  ElseIf (lBits > 31) Then
    LShift = 0
  Else
    If (lThis And lngPower2(31 - lBits)) = lngPower2(31 - lBits) Then
      LShift = (lThis And (lngPower2(31 - lBits) - 1)) _
        * lngPower2(lBits) Or lngPower2(31)
    Else
      LShift = (lThis And (lngPower2(31 - lBits) - 1)) _
        * lngPower2(lBits)
    End If
  End If
End Function
' 2er Potenzen
' von VB-Accelerator
Private Sub InitShifting()
  lngPower2(0) = &H1&: lngPower2(1) = &H2&
  lngPower2(2) = &H4&: lngPower2(3) = &H8&
  lngPower2(4) = &H10&: lngPower2(5) = &H20&
  lngPower2(6) = &H40&: lngPower2(7) = &H80&
  lngPower2(8) = &H100&: lngPower2(9) = &H200&
  lngPower2(10) = &H400&: lngPower2(11) = &H800&
  lngPower2(12) = &H1000&: lngPower2(13) = &H2000&
  lngPower2(14) = &H4000&: lngPower2(15) = &H8000&
  lngPower2(16) = &H10000: lngPower2(17) = &H20000
  lngPower2(18) = &H40000: lngPower2(19) = &H80000
  lngPower2(20) = &H100000: lngPower2(21) = &H200000
  lngPower2(22) = &H400000: lngPower2(23) = &H800000
  lngPower2(24) = &H1000000: lngPower2(25) = &H2000000
  lngPower2(26) = &H4000000: lngPower2(27) = &H8000000
  lngPower2(28) = &H10000000: lngPower2(29) = &H20000000
  lngPower2(30) = &H40000000: lngPower2(31) = &H80000000
End Sub
' Control Code berrechnen
Private Function CTL_CODE(ByVal lDevType As Long, _
  ByVal lFunction As Long, _
  ByVal lMethod As Long, _
  ByVal lAccess As Long) As Long
 
  CTL_CODE = LShift(lDevType, 16) Or _
    LShift(lAccess, 14) Or _
    LShift(lFunction, 2) Or _
    lMethod
End Function

Anwendungsbeispiel:
Das folgende Beispiel sendet einen Test Unit Ready Befehl an Laufwerk D:, welchen sowohl CD/DVD-ROM Laufwerke als auch Festplatten unterstützen müssen:

Dim cmd(5) As Byte
 
Select Case SCSICmd("D", cmd, 6, SCSI_IOCTL_DATA_IN, 0, 0)
  Case ERR_SCSI_FAILED
    MsgBox "Test Unit Ready für D: [Nicht bereit]"
 
  Case ERR_SPTD_FAILED
    MsgBox "SPTD fehlgeschlagen. Administrator?"
 
  Case ERR_HANDLE
    MsgBox "Invalides Laufwerkshandle erhalten"
 
  Case ERR_WIN
    MsgBox "Inkompatible Windows Version"
 
  Case ERR_OK
    MsgBox "Test Unit Ready für D: [Bereit]"
End Select

Dieser Tipp wurde bereits 14.362 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel