VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)

VB爱好者乐园(VBGood)

 找回密码
 立即注册
搜索
查看: 850|回复: 4

源码:读写大文件

[复制链接]
发表于 2018-12-6 19:39:05 | 显示全部楼层 |阅读模式
在做一个大文件的读写是碰到一个问题,提示记录错误。
在VB6中读写二进制文件使用 GET 语句,文件指针是LONG类型,最大可以2G,实际上由于LONG有符号,只能使用1G,超过1G的文件就不好读写了。
经过查找APIF发现使用
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
这个可以设置文件指针,lDistanceToMove 为指针的低位,lpDistanceToMoveHigh,为指针的高位,这样就可以读大文件了。
原理就是这样,我找了一个现成的类模块,经过测试可以直接使用,发给大家共享

'***********************************
'Written by D.L.
'
'2011/04/04
'***********************************
Option Explicit

'Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
'Private Type SECURITY_ATTRIBUTES
'    nLength As Long
'    lpSecurityDescriptor As Long
'    bInheritHandle As Long
'End Type
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 ReadFile Lib "kernel32.dll" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, ByRef lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function WriteFile Lib "kernel32.dll" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, ByRef lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
'Private Declare Function GetFileSize Lib "kernel32.dll" (ByVal hFile As Long, ByRef lpFileSizeHigh As Long) As Long
Private Declare Function GetFileSizeEx Lib "kernel32.dll" (ByVal hFile As Long, ByRef lpFileSize As Currency) As Long

Enum DesiredAccess
    GENERIC_READ = &H80000000
    GENERIC_WRITE = &H40000000
    GENERIC_EXECUTE = &H20000000
    GENERIC_ALL = &H10000000
End Enum

Enum ShareMode
    FILE_SHARE_READ = &H1
    FILE_SHARE_WRITE = &H2
    FILE_SHARE_DELETE = &H4
End Enum

'This parameter must be one of the following values, which cannot be combined:
Enum CreationDisposition
    TRUNCATE_EXISTING = 5
    OPEN_ALWAYS = 4
    OPEN_EXISTING = 3
    CREATE_ALWAYS = 2
    CREATE_NEW = 1
End Enum

Enum FlagsAndAttributes
    'attributes
    FILE_ATTRIBUTE_ARCHIVE = &H20
    FILE_ATTRIBUTE_COMPRESSED = &H800
    FILE_ATTRIBUTE_DIRECTORY = &H10
    FILE_ATTRIBUTE_HIDDEN = &H2
    FILE_ATTRIBUTE_NORMAL = &H80 'The file does not have other attributes set. This attribute is valid only if used alone.
    FILE_ATTRIBUTE_READONLY = &H1
    FILE_ATTRIBUTE_SYSTEM = &H4
    FILE_ATTRIBUTE_TEMPORARY = &H100
    'flags
    FILE_FLAG_BACKUP_SEMANTICS = &H2000000
    FILE_FLAG_DELETE_ON_CLOSE = &H4000000
    FILE_FLAG_NO_BUFFERING = &H20000000
    FILE_FLAG_OVERLAPPED = &H40000000
    FILE_FLAG_POSIX_SEMANTICS = &H1000000
    FILE_FLAG_RANDOM_ACCESS = &H10000000
    FILE_FLAG_SEQUENTIAL_SCAN = &H8000000
    FILE_FLAG_WRITE_THROUGH = &H80000000
End Enum

Private Const INVALID_HANDLE_VALUE = -1

'Private Declare Function SetFilePointer Lib "kernel32.dll" (ByVal hFile As Long, ByVal lDistanceToMove As Long, ByRef lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
'Private Const INVALID_SET_FILE_POINTER = -1
'Private Declare Function SetFilePointerEx Lib "kernel32" (ByVal hFile As Long, liDistanceToMove As LARGE_INTEGER, lpNewFilePointer As LARGE_INTEGER, ByVal dwMoveMethod As Long) As Long
'Private Type LARGE_INTEGER
'    Lowpart As Long
'    Highpart As Long
'End Type
Private Declare Function SetFilePointerEx Lib "kernel32" (ByVal hFile As Long, ByVal liDistanceToMove As Currency, lpNewFilePointer As Currency, ByVal dwMoveMethod As Long) As Long
Enum MoveMethod
    FILE_BEGIN = 0
    FILE_CURRENT = 1
    FILE_END = 2
End Enum
Private Declare Function SetEndOfFile Lib "kernel32" (ByVal hFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

''''''''''''''''''''''''''''''''''''''''''''''''''''
Private m_Handle As Long
Private m_FileName As String

Private Sub Class_Initialize()
    Handle = INVALID_HANDLE_VALUE
    FileName = ""
End Sub
Private Sub Class_Terminate()
    Call FileClose
End Sub

'*******properties*******
Public Property Get Handle() As Long
    Handle = m_Handle
End Property
Private Property Let Handle(ByVal Value As Long)
    m_Handle = Value
End Property
Public Property Get FileName() As String
    FileName = m_FileName
End Property
Private Property Let FileName(ByVal Value As String)
    m_FileName = Value
End Property
'*******public functions*******
'FileOpen
'打开文件
Public Function FileOpen(ByVal FileName As String, ByVal CreateIfNotExists As Boolean) As Boolean
    Dim dwCreation As Long
   
    If (CreateIfNotExists) Then
        dwCreation = OPEN_ALWAYS
    Else
        dwCreation = OPEN_EXISTING
    End If
   
    If (CreateFile2(FileName, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, dwCreation, 0, 0)) Then
        FileOpen = True
    Else
        FileOpen = False
    End If
End Function
'FileSeek
'移动文件指针
Public Function FileSeek(ByVal DistanceToMove As Double, ByVal MoveMethod As MoveMethod) As Boolean
    Dim lRet As Long
    Dim curIn As Currency, curOut As Currency
   
    If (Handle = INVALID_HANDLE_VALUE) Then Exit Function
   
    curIn = dbl2cur(DistanceToMove)
    lRet = SetFilePointerEx(Handle, curIn, curOut, MoveMethod)
    If (lRet) Then
        FileSeek = True
    Else
        FileSeek = False
    End If
End Function
'FileWrite
'写文件
Public Function FileWrite(Buffer() As Byte) As Boolean
    Dim lRet As Long
    Dim lBufferLength As Long
    Dim lBytesWritten As Long
   
    If (Handle = INVALID_HANDLE_VALUE) Then Exit Function
   
    If (IsArrayInit(Buffer()) = False) Then Exit Function
   
    lBufferLength = UBound(Buffer) - LBound(Buffer) + 1
    lRet = WriteFile(Handle, Buffer(0), lBufferLength, lBytesWritten, 0)
    If (lRet And lBytesWritten = lBufferLength) Then
        'lRet = FlushFileBuffers(Handle)
        FileWrite = True
    Else
        FileWrite = False
    End If
End Function
'FileRead
'读文件
Public Function FileRead(Buffer() As Byte) As Boolean
    Dim lRet As Long
    Dim lBufferLength
    Dim lBytesRead As Long
   
    If (Handle = INVALID_HANDLE_VALUE) Then Exit Function
   
    If (IsArrayInit(Buffer()) = False) Then Exit Function
   
    lBufferLength = UBound(Buffer) - LBound(Buffer) + 1
    lRet = ReadFile(Handle, Buffer(0), lBufferLength, lBytesRead, 0)
    If (lRet) Then
        FileRead = True
    Else
        FileRead = False
    End If
End Function
'FileClose
'关闭文件
Public Function FileClose() As Boolean
    Dim lRet As Long
   
    If (Handle = INVALID_HANDLE_VALUE) Then Exit Function
   
    lRet = CloseHandle(Handle)
    If (lRet) Then
        Handle = INVALID_HANDLE_VALUE
        FileName = ""
        FileClose = True
    End If
End Function
'CreateFile2
'创建文件,同 CreateFile API 函数,这个函数可以不暴露
Public Function CreateFile2(ByVal lpFileName As String, ByVal dwDesiredAccess As DesiredAccess, ByVal dwShareMode As ShareMode, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As CreationDisposition, ByVal dwFlagsAndAttributes As FlagsAndAttributes, ByVal hTemplateFile As Long) As Boolean
    'The lpFileName string should be //./x: to open a floppy drive x or a partition x on a hard disk.For example:
    '
    'String Meaning
    '//./A: Obtains a handle to drive A on the user's computer.
    '//./C: Obtains a handle to drive C on the user's computer.
    m_FileName = lpFileName
    Handle = CreateFile(lpFileName, dwDesiredAccess, dwShareMode, lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile)
    CreateFile2 = IIf(Handle <> INVALID_HANDLE_VALUE, True, False)
End Function
'FileGetSize
'取得文件大小(字节)
Public Function FileGetSize(Size As Double) As Boolean
    Dim lRet As Long
    Dim curOut As Currency
   
    If (Handle = INVALID_HANDLE_VALUE) Then Exit Function
   
    lRet = GetFileSizeEx(Handle, curOut)
    If (lRet) Then
        Size = cur2dbl(curOut)
        FileGetSize = True
    End If
End Function
'FileSetSize
'指定文件大小(字节)
Public Function FileSetSize(ByVal Size As Double) As Boolean
    Dim lRet As Long
    Dim curOut As Currency
   
    If (Size < 0) Then Exit Function
   
    If (Handle = INVALID_HANDLE_VALUE) Then Exit Function
   
    lRet = SetFilePointerEx(Handle, dbl2cur(Size), curOut, FILE_BEGIN)
    If (lRet) Then
        lRet = SetEndOfFile(Handle)
        If (lRet) Then
            FileSetSize = True
        End If
    End If
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function cur2dbl(cur As Currency) As Double
    cur2dbl = cur * 10000
End Function
Private Function dbl2cur(dbl As Double) As Currency
    dbl2cur = dbl / 10000
End Function

Private Function IsArrayInit(ByRef lpsa() As Byte) As Boolean
    Dim lRet As Long
   
    IsArrayInit = True
   
    Err.Clear
    On Error Resume Next
    lRet = LBound(lpsa())
    If (Err.Number) Then
        Err.Clear
        IsArrayInit = False
    End If
End Function

点评

海!外直播 t.cn/RxmJTRS 禁闻视频 t.cn/RJvO78S 医院成了屠宰场;学校成了洗脑班;酒店成了办公处;道德成了奢侈品;人民成了提款机;新闻成了编故事;官员成了奴隶主;国家成了大监狱…中国真实现状  发表于 2018-12-16 20:41
发表于 2018-12-21 17:17:35 | 显示全部楼层
GET也可以分块读的
回复 支持 反对

使用道具 举报

 楼主| 发表于 2018-12-21 18:27:24 | 显示全部楼层
amandv 发表于 2018-12-21 17:17
GET也可以分块读的

GET可以分块读,但是文件大小超过1.1GB以后就无法读入,你试试就知道了。
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

文字版|手机版|小黑屋|VBGood  

GMT+8, 2019-5-19 18:58

VB爱好者乐园(VBGood)
快速回复 返回顶部 返回列表