Die Community zu .NET und Classic VB.
Menü

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

 von 

Beschreibung 

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 um 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.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

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 --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.