Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0739: Arbeiten mit sehr großen Dateien

VB 5/6-Tipp 0739: Arbeiten mit sehr großen Dateien

 von Klaus Langbein

Schwierigkeitsgrad:

Verwendete API-Aufrufe: CloseHandle, RtlMoveMemory (CopyMemory), CreateFileA (CreateFile), GetFileSize, SetEndOfFile, SetFilePointer, WriteFile

Download: Download des Beispielprojektes [2,96 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 Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command1"
' Umgang mit großen Dateien

' Dateien, z.B. Filme, Datenbanken oder Logdateien können heutzutage
' Längen von einigen GB haben. VB kann jedoch nur Dateizeiger bis
' 2147483647 verarbeiten. API-Befehle nehmen jedoch einen
' vorzeichenlosen 32-Bit-Wert zusammen mit einem 2. höherwertigen
' 32-Bit-Integer umd Dateigröße und Position zu verarbeiten. Hier wird
' gezeigt, wie man große Werte mit dem Umweg über einen Variant an die
' Api-Funktionen übergeben kann.

' Autor/Copyright: K. Langbein, ActiveVB.de, 2007

'--------1---------2---------3---------4---------5---------6---------7-----|

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 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 GetFileSize Lib "kernel32.dll" ( _
                         ByVal hFile As Long, _
                         lpFileSizeHigh As Long) As Long
                         
Private Declare Function SetFilePointer Lib "kernel32" ( _
                         ByVal hFile As Long, _
                         ByVal lDistanceToMove As Long, _
                         ByRef lpDistanceToMoveHigh As Long, _
                         ByVal dwMoveMethod As Long) As Long
                         
Private Declare Function SetEndOfFile Lib "kernel32.dll" ( _
                         ByVal hFile As Long) As Long
                         
Private Declare Function CloseHandle Lib "kernel32" ( _
                         ByVal hObject As Long) As Long
                         
Private Declare Sub CopyMemory Lib "kernel32.dll" _
                    Alias "RtlMoveMemory" ( _
                    Destination As Any, _
                    Source As Any, _
                    ByVal Length As Long)

Private Function GetFileLength(ByVal hFile As Long) As Variant

    Dim Lng() As Long
    ReDim Lng(3)
    
    Lng(0) = 14
    Lng(1) = 0
    Lng(2) = GetFileSize(hFile, Lng(3))
    
    CopyMemory GetFileLength, Lng(0), 16
    'MsgBox Lng(3)
    
End Function

Private Function GetFilePointer(ByVal hFile As Long) As Variant

    GetFilePointer = SetFilePointerRelative(hFile, 0)

End Function


Private Function SetFilePointerAbsolute(ByVal hFile As Long, _
                                        ByVal NewPos As Variant _
                                        ) As Variant

    Dim Lng() As Long
    Dim Pos As Long
    ReDim Lng(3)
    Const FILE_BEGIN As Long = 0
    
    NewPos = CDec(NewPos) ' dies ist nötig, wenn der Variant einen Single
                          ' oder Double enthält
    
    CopyMemory Lng(0), NewPos, 16

    Pos = SetFilePointer(hFile, Lng(2), Lng(3), FILE_BEGIN)

    Lng(2) = Pos     ' Pos enthält die neue Position. Pos kann sich vom
                     ' vorgegebenen Wert unterscheiden.
    'Lng(3) = Lng(3) ' Lng(3) wurde Byref übergeben und enthält evtl.
                     ' auch einen neuen Wert.
    
    ' Rückgabe der neuen Position als Variant
    CopyMemory SetFilePointerAbsolute, Lng(0), 16
    

End Function

Private Function SetFilePointerRelative(ByVal hFile As Long, _
                                        ByVal NewPos As Variant _
                                        ) As Variant

    Dim Lng() As Long
    Dim Pos As Long
    ReDim Lng(3)
    Const FILE_CURRENT As Long = 1
    
    NewPos = CDec(NewPos) ' dies ist nötig, wenn der Variant ein Single
                          ' oder Double enthält.
    
    CopyMemory Lng(0), NewPos, 16

    Pos = SetFilePointer(hFile, Lng(2), Lng(3), FILE_CURRENT)

    Lng(2) = Pos     ' Pos enthält die neue Position. Pos kann sich vom
                     ' vorgegebenen Wert unterscheiden.
    'Lng(3) = Lng(3) ' lng(3) wurde Byref übergeben und enthält evtl.
                     ' auch einen neuen Wert.
    
    ' Rückgabe der neuen Position als Variant
    CopyMemory SetFilePointerRelative, Lng(0), 16
    
End Function

Public Function OpenFile(ByVal FileName As String) As Long

    Const GENERIC_WRITE = &H40000000
    Const GENERIC_READ = &H80000000
    Const FILE_FLAG_SEQUENTIAL_SCAN = &H8000000
    Const FILE_ATTRIBUTE_NORMAL = &H80
    Const CREATE_ALWAYS = 2
    Const OPEN_ALWAYS = 4

    Dim ret As Long
    Dim hFile As Long

    hFile = CreateFile(FileName, _
                       GENERIC_WRITE Or GENERIC_READ, _
                       0, _
                       0, _
                       OPEN_ALWAYS, _
                       FILE_ATTRIBUTE_NORMAL Or FILE_FLAG_SEQUENTIAL_SCAN, _
                       0)

    OpenFile = hFile

End Function


Private Sub Command1_Click()

    ' Beispiel - noch nicht ausgereift

    Dim f$
    Dim H As Long
    Dim ret As Long
    Dim Pos As Variant
    Dim Size As Variant
    Dim fno As Long
    Dim n As Long
    Dim s$
    
    f$ = "c:\muell.txt"
    fno = FreeFile
    Open f$ For Binary As #fno
    x$ = Space$(1023)
    Put #fno, , x$
    Close #fno
    
    H = OpenFile(f$)
    If H > 0 Then
    
        Size = GetFileLength(H)
        MsgBox Size
        
        Pos = SetFilePointerAbsolute(H, 12345) ' auch größeren Wert,
                                               ' z.B. 2^32 + 10 versuchen.
        MsgBox Pos
        
    End If
    
    Pos = GetFilePointer(H)
    MsgBox Pos
    
    'ret = SetEndOfFile(H)
    s$ = StrConv("Hallo", vbFromUnicode)
    ret = WriteFile(H, ByVal StrPtr(s$), LenB(s$), n, 0&)
    
    MsgBox n & " Bytes geschrieben an Pos " & Pos
    
    Size = GetFileLength(H)
    MsgBox Size
    
    ret = CloseHandle(H)
    
    Kill f$

End Sub

'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------