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: 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.383 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
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. |
sevISDN 1.0 Überwachung aller eingehender Anrufe! Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 Neu! sevCommand 4.0 Professionelle Schaltflächen im modernen Design! Mit nur wenigen Mausklicks statten auch Sie Ihre Anwendungen ab sofort mit grafischen Schaltflächen im modernen Look & Feel aus (WinXP, Office, Vista oder auch Windows 8), inkl. große Symbolbibliothek. |
||||||||||||||||
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. |