Problemas con array muy grande y el Windows7

[OfTheVara]

Hola,

Al iniciar mi programa necesito cargar unos 850.000 bytes contenidos en el archivo "prueba.dat".

Me creo un array adecuado y leo los datos del archivo:

Código [Seleccionar] Expandir



  Dim VectorBytes(0 To 900000) As Byte
 
  Open App.Path & "\" & "prueba.dat" For Binary Lock Read As 1
    Get #1, , VectorBytes
  Close




Pues en WindowsXP todo correcto. Pero al ejecutarlo en Windows7 se cierra el programa sin decir ni pio, porque no acepta la creacion de un vector de 900.000. Maximo unos 60.000 o menos.

¿Alguien sabe como solucionar esto o que está pasando?

[Lekim]

No tengo Window7, ni siquiera en Virtualbox pero puedo sugerirte varias cosas

Primera:
Si la línea ReDim byte... está desactivada se cargan todos los bytes. Si solo quieres una porción por ejemplo de 500 bytes, activa la línea quitando ' y estableces el ReDim bytes(500).

Código (vb) [Seleccionar] Expandir

Dim VectorBytes() As Byte
 
 Open App.Path & "\" & "prueba.dat" For Binary Lock Read As 1
VectorBytes= Space(LOF(1))
' ReDim bytes(?) '<<--- Forma selectiva de bytes Ej. (500)
   Get #1, , VectorBytes
 Close #1

Segunda
Crear el Array del archivo mediante API

Código (vb) [Seleccionar] Expandir


Const FILE_ATTRIBUTE_TEMPORARY = &H100
Const OPEN_EXISTING = 3
Const GENERIC_READ = &H80000000
Const GENERIC_WRITE = &H40000000
Const FILE_ATTRIBUTE_NORMAL = &H80
Const OPEN_ALWAYS = 4
Const INVALID_HANDLE_VALUE = -1

Private Declare Function FlushFileBuffers Lib "kernel32" ( _
       ByVal hFile As Long) As Long
       

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function SetVolumeLabel Lib "kernel32" Alias "SetVolumeLabelA" _
(ByVal lpRootPathName As String, ByVal lpVolumeName As String) 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 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 WriteFile Lib "kernel32" _
(ByVal hFile As Long, lpBuffer As Any, _
ByVal nNumberOfBytesToWrite As Long, _
lpNumberOfBytesWritten As Long, _
ByVal lpOverlapped As Any) As Long

Private Sub Command1_Click()
   Dim hFile As Long
   Dim fBytes() As Byte <==Array del archivo
   Dim fSize As Long, lBytesRead As Long
   Dim fSuccess As Long
   Dim BytesToRead As Long
   Dim FileToRead As String
   
  FileToRead = App.Path & "\" & "Prueba.dat"


   '///LEE EL ARCHIVO EN BYTES ///////////////////
   hFile = CreateFile(FileToRead, _
   GENERIC_WRITE Or GENERIC_READ, 0&, 0&, _
   OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0&)
   If hFile <> INVALID_HANDLE_VALUE Then
   fSize = GetFileSize(hFile, 0)
   ReDim fBytes(fSize)
   BytesToRead = (UBound(fBytes) + 1) * LenB(fBytes(0))
   fSuccess = ReadFile(hFile, fBytes(LBound(fBytes)), BytesToRead, lBytesRead, 0&)
   CloseHandle hFile
    End If
   '/////////////////////////////////////////////
 
 
 
' Guardar el archivo en otro directorio (Con API)
 Call CrearAchivoBinario("C:\PruebaCopia.dat", fBytes)



'///guardar el archivo en otro directorio (Sin API)
   'Open "C:\PruebaCopia.dat" For Binary Access Write As 1
   'Put #1, , fBytes
   'Close
End Sub


  Private Sub CrearAchivoBinario(ByVal FileName As String, fBytes() As Byte)
   Dim fSuccess As Long
   Dim hFile As Long
   Dim BytesToRead As Long
   Dim lBytesWritten As Long
   
      BytesToWrite = (UBound(fBytes) + 1) * LenB(fBytes(1))
         hFile = CreateFile(FileName, _
         GENERIC_WRITE Or GENERIC_READ, _
         ByVal 0&, ByVal 0&, _
         OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0&)
         
           If hFile <> INVALID_HANDLE_VALUE Then
         fSuccess = WriteFile(hFile, fBytes(LBound(fBytes)), BytesToWrite, lBytesWritten, 0&)
         
           If fSuccess <> 0 Then
              fSuccess = FlushFileBuffers(hFile)
              fSuccess = CloseHandle(hFile)
           End If
           End If
           
     End Sub



He añadido CrearAchivoBinario por si quieres crearlo a partir del array y tuvieras también problemas con eso.

+Info:
https://support.microsoft.com/es-es/kb/165942