Hi Basti,
damit Dus nicht zu schwer hast, wenigstens die Klasse, ich ich mir bei Planetsourcecode besorgt habe. Ich habe gegenüber dem Original nicht sehr viel verändert, nur übersichtlicher gemacht und ‚eingedeutscht‘. Das Original war italienisch … 
Gruß, Rainer
Option Explicit
Public Enum W32F\_Errors
W32F\_UNKNOWN\_ERROR = 45600
W32F\_FILE\_ALREADY\_OPEN
W32F\_PROBLEM\_OPENING\_FILE
W32F\_FILE\_ALREADY\_CLOSED
W32F\_PROBLEM\_SEEKING
End Enum
Private Const W32F\_SOURCE = "Clase: Win32File Object"
Private Const FILE\_SHARE\_READ As Long = &H1
Private Const FILE\_SHARE\_WRITE As Long = &H2
Private Const GENERIC\_WRITE As Long = &H40000000
Private Const GENERIC\_READ As Long = &H80000000
Private Const FILE\_ATTRIBUTE\_NORMAL As Long = &H80
Private Const CREATE\_ALWAYS As Long = 2
Private Const OPEN\_ALWAYS As Long = 4
Private Const INVALID\_HANDLE\_VALUE As Long = -1
Private Const FILE\_BEGIN As Long = 0
Private Const FILE\_CURRENT As Long = 1
Private Const FILE\_END As Long = 2
Private Const FORMAT\_MESSAGE\_FROM\_SYSTEM = &H1000
Private Declare Function FormatMessage Lib "kernel32" \_
Alias "FormatMessageA" (ByVal dwFlags As Long, \_
lpSource As Long, \_
ByVal dwMessageId As Long, \_
ByVal dwLanguageId As Long, \_
ByVal lpBuffer As String, \_
ByVal nSize As Long, \_
Arguments As Any) As Long
Private Declare Function ReadFile Lib "kernel32" \_
(ByVal hFile As Long, \_
lpBuffer As Any, \_
ByVal nNumberOfBytesToRead As Long, \_
lpNumberOfBytesRead As Long, \_
ByVal lpOverlapped As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" \_
(ByVal hObject As Long) As Long
Private Declare Function WriteFile Lib "kernel32" \_
(ByVal hFile As Long, \_
lpBuffer As Any, \_
ByVal nNumberOfBytesToWrite As Long, \_
lpNumberOfBytesWritten As Long, \_
ByVal lpOverlapped As Long) 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 SetFilePointer Lib "kernel32" \_
(ByVal hFile As Long, \_
ByVal lDistanceToMove As Long, \_
lpDistanceToMoveHigh As Long, \_
ByVal dwMoveMethod As Long) As Long
Private Declare Function FlushFileBuffers Lib "kernel32" \_
(ByVal hFile As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" \_
(pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private hFile As Long
Private sFName As String
Private fAutoFlush As Boolean
Private iPos As Long
Public Property Get FileHandle() As Long
If hFile = INVALID\_HANDLE\_VALUE Then
RaiseError W32F\_FILE\_ALREADY\_CLOSED
End If
FileHandle = hFile
End Property
Public Property Get FileName() As String
If hFile = INVALID\_HANDLE\_VALUE Then
RaiseError W32F\_FILE\_ALREADY\_CLOSED
End If
FileName = sFName
End Property
Public Property Get IsOpen() As Boolean
IsOpen = hFile INVALID\_HANDLE\_VALUE
End Property
Public Property Get AutoFlush() As Boolean
If hFile = INVALID\_HANDLE\_VALUE Then
RaiseError W32F\_FILE\_ALREADY\_CLOSED
End If
AutoFlush = fAutoFlush
End Property
Public Property Let AutoFlush(ByVal NewVal As Boolean)
If hFile = INVALID\_HANDLE\_VALUE Then
RaiseError W32F\_FILE\_ALREADY\_CLOSED
End If
fAutoFlush = NewVal
End Property
Public Sub OpenFile(ByVal sFileName As String)
If hFile INVALID\_HANDLE\_VALUE Then
RaiseError W32F\_FILE\_ALREADY\_OPEN, sFName
Exit Sub
End If
hFile = CreateFile(sFileName, GENERIC\_WRITE Or GENERIC\_READ, FILE\_SHARE\_READ \_
Or FILE\_SHARE\_WRITE, 0, OPEN\_ALWAYS, FILE\_ATTRIBUTE\_NORMAL, 0)
If hFile = INVALID\_HANDLE\_VALUE Then
RaiseError W32F\_PROBLEM\_OPENING\_FILE, sFileName
Exit Sub
End If
sFName = sFileName
End Sub
Public Sub CloseFile()
If hFile = INVALID\_HANDLE\_VALUE Then
RaiseError W32F\_FILE\_ALREADY\_CLOSED
Exit Sub
End If
CloseHandle hFile
sFName = ""
fAutoFlush = False
hFile = INVALID\_HANDLE\_VALUE
End Sub
Public Function ReadBytes(ByVal ByteCount As Long, Bytes() As Byte) As String
Dim BytesRead As Long
Dim asB As String
If hFile = INVALID\_HANDLE\_VALUE Then
RaiseError W32F\_FILE\_ALREADY\_CLOSED
Exit Function
End If
ReDim Bytes(0 To ByteCount - 1) As Byte
ReadFile hFile, Bytes(0), ByteCount, BytesRead, 0
Dim i&
For i = 0 To ByteCount - 1
If Bytes(i) INVALID\_HANDLE\_VALUE Then CloseHandle hFile
End Sub
Private Sub RaiseError(ByVal ErrorCode As W32F\_Errors, \_
Optional sExtra)
Dim Win32Err As Long, Win32Text As String
Win32Err = Err.LastDllError
If Win32Err Then
Win32Text = vbCrLf & "Error " & Win32Err & vbCrLf & \_
DecodeAPIErrors(Win32Err)
End If
Select Case ErrorCode
Case W32F\_FILE\_ALREADY\_OPEN
Err.Raise W32F\_FILE\_ALREADY\_OPEN, W32F\_SOURCE, \_
"Das Laufwerk'" & sExtra & "' ist bereits geöffnet." & Win32Text
Case W32F\_PROBLEM\_OPENING\_FILE
Err.Raise W32F\_PROBLEM\_OPENING\_FILE, W32F\_SOURCE, \_
"Fehler beim öffnen '" & sExtra & "'." & Win32Text
Case W32F\_FILE\_ALREADY\_CLOSED
Err.Raise W32F\_FILE\_ALREADY\_CLOSED, W32F\_SOURCE, \_
"Laufwerk ist geschlossen."
Case W32F\_PROBLEM\_SEEKING
Err.Raise W32F\_PROBLEM\_SEEKING, W32F\_SOURCE, \_
"Laufwerk nicht gefunden." & vbCrLf & sExtra
Case Else
Err.Raise W32F\_UNKNOWN\_ERROR, W32F\_SOURCE, \_
"Unbekannter Fehler." & Win32Text
End Select
End Sub
Private Function DecodeAPIErrors(ByVal ErrorCode As Long) As String
Dim sMessage As String, MessageLength As Long
sMessage = Space$(256)
MessageLength = FormatMessage(FORMAT\_MESSAGE\_FROM\_SYSTEM, 0&, \_
ErrorCode, 0&, sMessage, 256&, 0&:wink:
If MessageLength \> 0 Then
DecodeAPIErrors = Left(sMessage, MessageLength)
Else
DecodeAPIErrors = "Unbekannter Fehler"
End If
End Function
