vb二进制读取大文件时内存溢出？

Question

    Dim fileOld As String, fileNew As String    fileOld = App.Path & "\fileold"
    fileNew = App.Path & "\filenew"    Open fileOld For Binary As #1
    ReDim Preserve x(LOF(1) - 1) As Byte
    Get #1, , x
    Close #1    Open fileNew For Binary As #1
    Put #1, , x
    Close #1请问怎么解决
我的文件有500兆

Answer 1

ReDim Preserve x(LOF(1) - 1) As Byte '提示在这里内存溢出

Answer 2

分块读取
用循环来完成比如do while not eof(1)
   doevents 
   redim x(65535)
   get #1,,x
   put #2,,x
loop

Answer 3

    Open fileOld For Binary As #1
    Open fileNew For Binary As #2
    
Do While Not EOF(1)
   DoEvents
   ReDim x(65535)
   Get #1, , x
   Put #2, , x
Loop    Close #1    Close #2这样写对吗

Answer 4

怎么计算，麻烦说清楚点，或者给个例子
我这个是读取Access 的mdb数据库
数据库有500兆
刚开始我是做的文件分割技术，但文件一大就内存溢出，不知道有什么更好的解决办法数据库要加密、安全性能要好，而且读取速度要快的方法
小虾请假各位了

Answer 5

mdb文件 用winrar压缩后 500M 估计只有20~40M 然后你再去分割

Answer 6

然后怎么用程序解压rar的文件

Answer 7

Const MOVEFILE_REPLACE_EXISTING = &H1 
Const FILE_ATTRIBUTE_TEMPORARY = &H100 
Const FILE_BEGIN = 0 
Const FILE_SHARE_READ = &H1 
Const FILE_SHARE_WRITE = &H2 
Const CREATE_NEW = 1 
Const OPEN_EXISTING = 3 
Const GENERIC_READ = &H80000000 
Const GENERIC_WRITE = &H40000000 
Private Declare Function SetVolumeLabel Lib "kernel32" Alias "SetVolumeLabelA" (ByVal lpRootPathName As String, ByVal lpVolumeName As String) 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 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 Any) 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 Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long 
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject 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 SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long 
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long 
Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long 
Private Declare Function MoveFileEx Lib "kernel32" Alias "MoveFileExA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal dwFlags As Long) As Long 
Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long 
Private Sub Form_Load() 
Dim sSave As String, hOrgFile As Long, hNewFile As Long, bBytes() As Byte 
Dim sTemp As String, nSize As Long, Ret As Long 
'Ask for a new volume label 
sSave = InputBox("Please enter a new volume label for drive C:\" + vbCrLf + " (if you don't want to change it, leave the textbox blank)") 
If sSave <> "" Then 
SetVolumeLabel "C:\", sSave 
End If 'Create a buffer 
sTemp = String(260, 0) 
'Get a temporary filename 
GetTempFileName "C:\", "KPD", 0, sTemp 
'Remove all the unnecessary chr$(0)'s 
sTemp = Left$(sTemp, InStr(1, sTemp, Chr$(0)) - 1) 
'Set the file attributes 
SetFileAttributes sTemp, FILE_ATTRIBUTE_TEMPORARY 
'Open the files 
hNewFile = CreateFile(sTemp, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0) 
hOrgFile = CreateFile("c:\config.sys", GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0) 'Get the file size 
nSize = GetFileSize(hOrgFile, 0) 
'Set the file pointer 
SetFilePointer hOrgFile, Int(nSize / 2), 0, FILE_BEGIN 
'Create an array of bytes 
ReDim bBytes(1 To nSize - Int(nSize / 2)) As Byte 
'Read from the file 
ReadFile hOrgFile, bBytes(1), Ubound(bBytes), Ret, ByVal 0& 
'Check for errors 
If Ret <> Ubound(bBytes) Then MsgBox "Error reading file ..." 'Write to the file 
WriteFile hNewFile, bBytes(1), Ubound(bBytes), Ret, ByVal 0& 
'Check for errors 
If Ret <> Ubound(bBytes) Then MsgBox "Error writing file ..." 'Close the files 
CloseHandle hOrgFile 
CloseHandle hNewFile 'Move the file 
MoveFileEx sTemp, "C:\KPDTEST.TST", MOVEFILE_REPLACE_EXISTING 
'Delete the file 
DeleteFile "C:\KPDTEST.TST" 
Unload Me 
End Sub

Answer 8

FileCopy fileOld, filenew
这就是你的程序实现的功能。

Answer 9

FileCopy fileOld, filenew 
虽然可以实现
但是没有可以查询复制的状态，我要知道什么时候复制好，可以响应其它程序

Answer 10

循环等待一直到 filenew 出现
循环等待一直到 FileLen(filenew) 与 FileLen(fileold) 一致。

Answer 11

'******************************************************
Dim FileOld As String, fileNew As String
FileOld = ××
fileNew = ××
Dim x() As Byte
Open FileOld For Binary As #1
Open fileNew For Binary As #2
XX = 0
Do While Not EOF(1)
   XX = XX + 1
   'Debug.Print "loadxx=" & XX
   DoEvents
   ReDim x(65535)
   Get #1, , x
   Put #2, , x
LoopClose #1Close #2
'******************************************************
Private Sub Timer2_Timer()  Dim TotalSize As Long  If Int(XX / TotalSize) = 1 Then
    
    '正在复制提示
    
  Else
    '文件复制完毕
  End If
End Sub
'******************************************************
'最后用这样的方法实现的

Answer 12

循环改一下
lRemain = LOF(1)
Do while lRamin>0
  ...
  redim x(iif(lremain>65535,65535,lRemain-1)
  lremain = lremain - 65535
  ...
loop

Answer 13

如果 LOF(1) = 65537，你原先的分块写就是 2 * 65536 = 131072，文件大小、内容不一致。