Resumen del hilo iniciado en las News de Accecss sobre como hacer copia de erspaldo con verificacion ANTONIO ======= Querría saber cómo puedo copiar un fichero mediante visual basic, pero de modo que se verifique que se puede leer el archivo copiado, igual que cuando se usa la opción /v en el comando copy de la línea de comandos. La orden Copy de la línea de comandos, o, concretamente, la línea de comandos del Dos, tiene la orden copy para copiar ficheros. Dicha orden admite el parámetro /v, que sirve para que, cada vez que se escribe un sector del fichero destino, se lea dicho sector para comprobar que es legible. Esto te evita la desagradable sorpresa de ir a restaurar una copia de seguridad y ver que hay errores de superficie en el disquete, porque, si los hay, el sector recién escrito no podrá ser leído y te da un aviso, por lo que puedes resolver el problema cuando aún puedes hacerlo, cambiendo el disquete por otro. Por tanto, quisiera poder usar una orden de vb o api que permita la verificación del fichero copiado. No se si me he explicado esta vez o he liado más. Buho ==== Te has explicado correctamente Cotersía de Rubén Vigon: http://vbnet.mvps.org/index.html?code/shell/shfileopadv.htm Parece ser que la API «SHFileOperation», según me comenta Ruben, cumple este requisito de verificacion. ....es cuestion de mirar bien los componentes de la estructura SHFILEOPSTRUCT que recibe. Siempre te queda el recurso de lanzar Copy del Dos con /v con la orden Shell de VB. Otro recurso que podría quedar, para ver si la copia en disquete se ha hecho correcta, es efectivamente copiar con FileCopy y luego, a modo de comprobacion, leer el fichero a bajo nivel y comprobar que la lectura (La apertura+lectura en este caso) no da error. Por ejemplo: Dim Manejador As Integer, Contenido As Variant Manejador = FreeFile Open "A:\Ruta\tuficherocopia.xxx" For Input As #Manejador Contenido = Input(LOF(Manejador), #Manejador) Close #Manejador Si por cualquier circunstancia, el disquete estuviera mal, ese codigo daría error. ANTONIO ======= Pues bien. He mirado la dirección web que me proporcionas y no encuentro ahí ninguna opción para hacer que shfileoperation copie con verificación del destino. Tamíén he mirado en la web de microsoft, concretamente en http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wceui40/html/_cerefshfileopstruct.asp y tampoco he encontrado nada. Respecto al método que me propones para verificar el archivo copiado, ¿hace uso de la caché de disco del disquete?. Es decir, cuando leemos mediante input, ¿estaremos leyendo de la caché de disco del disquete en vez de hacerlo directamente desde el disquete?.Porque, si es así, no estaremos haciendo nada. BUHO ==== No tengo ni idea. Supongo que *NO* leera del caché. Pero solo es eso, una suposición. Todo sería probarlo. He visto esta API que aunque es para copiar ficheros bajo otras espectativas diferentes, lo mismo podría servir: PEGO: Option Explicit Private Type OFSTRUCT cBytes As Byte fFixedDisk As Byte nErrCode As Integer Reserved1 As Integer Reserved2 As Integer szPathName As String * 128 End Type Private Declare Function LZOpenFile Lib "lz32.dll" Alias "LZOpenFileA" (ByVal lpszFile As String, lpOf As OFSTRUCT, ByVal style As Long) As Long Private Declare Function LZCopy Lib "lz32.dll" (ByVal hfSource As Long, ByVal hfDest As Long) As Long Private Declare Sub LZClose Lib "lz32.dll" (ByVal hfFile As Long) Const OF_READ = &H0 Const OF_CREATE = &H1000 Const LZERROR_BADINHANDLE = (-1) Const LZERROR_BADOUTHANDLE = (-2) Const LZERROR_BADVALUE = (-7) Const LZERROR_GLOBLOCK = (-6) Const LZERROR_PUBLICLOC = (-5) Const LZERROR_READ = (-3) Const LZERROR_UNKNOWNALG = (-8) Const LZERROR_WRITE = (-4) Private Sub Form_Load() 'KPD-Team 1999 'URL: http://www.allapi.net/ 'E-Mail: KPDTeam@Allapi.net Dim SourceStruct As OFSTRUCT, DestStruct As OFSTRUCT Dim hSource As Long, hDest As Long, lResults As Long 'Open the source- and the destination-files hSource = LZOpenFile("c:\prueba.txt", SourceStruct, OF_READ) hDest = LZOpenFile("A:\pruebax.txt", DestStruct, OF_CREATE) 'Copy the files lResults = LZCopy(hSource, hDest) 'Close the files LZClose hSource LZClose hDest 'Check for errors Select Case lResults Case LZERROR_BADINHANDLE MsgBox "LZERROR_BADINHANDLE" Case LZERROR_BADOUTHANDLE MsgBox "LZERROR_BADOUTHANDLE" Case LZERROR_BADVALUE MsgBox "LZERROR_BADVALUE" Case LZERROR_GLOBLOCK MsgBox "LZERROR_GLOBLOCK" Case LZERROR_PUBLICLOC MsgBox "LZERROR_PUBLICLOC" Case LZERROR_READ MsgBox "LZERROR_READ" Case LZERROR_UNKNOWNALG MsgBox "LZERROR_UNKNOWNALG" Case LZERROR_WRITE MsgBox "LZERROR_WRITE" End Select End Sub ANTONIO ======= Option Compare Database Option Explicit 'Aquí está el código (la función definitiva es cualquiera 'de las dos últimas): 'Declaración del API de 32 bits para obtener el espacio 'libre de un disco y otras caractyerísticas. Declare Function GetDiskFreeSpace Lib "kernel32" Alias _ "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, _ lpSectorsPerCluster As Long, lpBytesPerSector As Long, _ lpNumberOfFreeClusters As Long, _ lpTotalNumberOfClusters As Long) As Long Public Function BytesPorClúster( _ ByVal lpRootPathName As String) As Long 'lpRootPathName= Directorio raiz de la unidad a examinar 'Valores devueltos por la función: 'lpSectorsPerCluster = sectores por cluster 'lpBytesPerSector = bytes por sector 'lpNumberOfFreeClusters = número de clusters libres 'lpTotalNumberOfClusters = número de clusters en el disco Dim lpSectorsPerCluster As Long Dim lpBytesPerSector As Long Dim lpNumberOfFreeClusters As Long Dim lpTotalNumberOfClusters As Long Dim Ret& 'Dim TotalBytes As Long Ret = GetDiskFreeSpace(lpRootPathName, lpSectorsPerCluster, _ lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters) ' TotalBytes = lpTotalNumberOfClusters * lpSectorsPerCluster * lpBytesPerSector BytesPorClúster = lpBytesPerSector * lpSectorsPerCluster End Function Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _ (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _ ByVal dwShareMode As Long, lpSecurityAttributes As Long, _ ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _ ByVal hTemplateFile As Long) As Long Private Const GENERIC_READ = &H80000000 Private Const GENERIC_WRITE = &H40000000 Private Const CREATE_ALWAYS = 2 Private Const OPEN_EXISTING = 3 Private Const FILE_SHARE_READ = &H1 Private Const FILE_SHARE_WRITE = &H2 Private Const FILE_FLAG_NO_BUFFERING = &H20000000 Private Const FILE_FLAG_WRITE_THROUGH = &H80000000 'Ejemplo: hFile = CreateFile(strRutaYNombreFichero, GENERIC_READ, 0, ByVal 0&,_ 'OPEN_EXISTING,FILE_FLAG_NO_BUFFERING,0) 'La clave está en FILE_FLAG_NO_BUFFERING, que hace que no se lea a 'través de la caché (bueno, eso me ha parecido entender). Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, _ ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, _ lpOverlapped As Any) As Long 'Ejemplo: Dim sTemp as string ' Buffer ' Dim Ret as long ' Puntero a entero largo donde están los bytes leídos. ' ' sTemp = String(FileLen(strRutaYNombreFichero,0)+4) ' rc = ReadFile(hFile, sTemp, FileLen (strRutaYNombreFichero,0), _ ' Ret, ByVal 0&) Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As _ Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As _ Long, lpOverlapped As Any) As Long 'La siguiente función, no se si entra en algún conflicto con el objero Err, pero 'con el uso que le doy aquí, no me ha dado problemas. Declare Function GetLastError Lib "kernel32" () As Long Private Const ERROR_SUCCESS = 0 Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" _ (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, _ ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, _ Arguments As Long) As Long Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100 Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000 Const LANG_NEUTRAL = &H0 Const SUBLANG_DEFAULT = &H1 'Ejemplo: Dim Buffer as String ' ' Buffer = Space(400) ' FormatMessage FORMAT_MESSAGE_FROM_SYSTEM,ByVal 0&, GetLastError, _ ' LANG_NEUTRAL, Buffer, 400, ByVal '0 Sub Prueba_LecturaBajoNivel() 'Si antes de usar esta función, se ha leído o escrito 'el fichero a disco, es probable que ya estén los datos en 'la caché, por lo que esta función no sirve. Dim byBuffer() As Byte Dim lenBuffer As Long Dim hFile As Long Dim strRutaYNombreFichero As String Dim rc As Long Dim Ret As Long Dim strBufferMensaje As String Dim strContenido As String Dim c As Long 'Contador strRutaYNombreFichero = "A:\2004-06-07 a las 11h 40m 35s.zip.01" lenBuffer = ((FileLen(strRutaYNombreFichero) \ BytesPorClúster( _ left(strRutaYNombreFichero, _ 3))) + 1) * BytesPorClúster(left(strRutaYNombreFichero, 3)) hFile = CreateFile(strRutaYNombreFichero, GENERIC_READ, 0, _ ByVal 0&, OPEN_EXISTING, FILE_FLAG_NO_BUFFERING, 0) ReDim byBuffer(1 To lenBuffer) As Byte rc = ReadFile(hFile, byBuffer(1), UBound(byBuffer), Ret, ByVal 0&) CloseHandle hFile If Ret <> FileLen(strRutaYNombreFichero) Then MsgBox "Error leyendo el fichero." & vbCrLf & "Se esperaban " _ & FileLen( _ strRutaYNombreFichero) & " bytes, pero se han leído " & rc & _ " bytes." strBufferMensaje = Space(400) FormatMessage FORMAT_MESSAGE_FROM_SYSTEM, ByVal0&, _ GetLastError, LANG_NEUTRAL, strBufferMensaje, 400, ByVal 0& Else strContenido = "" For c = 1 To 1000 strContenido = strContenido & Chr$(byBuffer(c)) Next c MsgBox "Inicio del fichero: " & vbCrLf & strContenido End If End Sub Sub Prueba_LecturaBajoNivel2() 'Si antes de usar esta función, se ha leído o escrito 'el fichero a disco, es probable que ya estén los datos en 'la caché, por lo que esta función no sirve. Dim byBuffer() As Byte Dim lenBuffer As Long Dim hFile As Long Dim strRutaYNombreFichero As String Dim rc As Long Dim Ret As Long Dim strBufferMensaje As String Dim strContenido As String Dim c As Long 'Contador Dim lngLastError As Long strRutaYNombreFichero = "A:\2004-06-07 a las 11h 40m 35s.zip.01" lenBuffer = ((5000 \ BytesPorClúster(left(strRutaYNombreFichero, _ 3))) + 1) * BytesPorClúster(left(strRutaYNombreFichero, 3)) hFile = CreateFile(strRutaYNombreFichero, GENERIC_READ, 0, _ ByVal 0&, OPEN_EXISTING, FILE_FLAG_NO_BUFFERING, 0) ReDim byBuffer(1 To lenBuffer) As Byte Do rc = ReadFile(hFile, byBuffer(1), UBound(byBuffer), Ret, _ ByVal 0&) Loop Until Ret < lenBuffer CloseHandle hFile 'Se sale del bucle cuando el número de bytes leídos es menor que el tamaño 'del búffer, que es igual al número de bytes que se ha requerido leer.Esto 'puede ocurrir porque se haya llegado al final del fichero, o porque haya 'ocurrido algún error. por ello, comprobamos si se ha producido algún error, 'usando la función GetLastError. lngLastError = GetLastError If lngLastError <> ERROR_SUCCESS Then strBufferMensaje = Space(400) FormatMessage FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, _ lngLastError, LANG_NEUTRAL, strBufferMensaje, 400, ByVal 0& GoTo Exit_Prueba_LecturaBajoNivel2 Else strContenido = "" For c = 1 To UBound(byBuffer) strContenido = strContenido & Chr$(byBuffer(c)) Next c MsgBox "Fin del fichero: " & vbCrLf & strContenido End If Exit_Prueba_LecturaBajoNivel2: End Sub Function Comprobar_LecturaFichero( _ strRutaYNombreFichero As String) As Boolean 'Si antes de usar esta función, se ha leído o escrito 'el fichero a disco, es probable que ya estén los datos en 'la caché, por lo que esta función no sirve. Dim byBuffer() As Byte Dim lenBuffer As Long Dim hFile As Long Dim rc As Long Dim Ret As Long Dim strBufferMensaje As String Dim strContenido As String Dim c As Long 'Contador Dim lngLastError As Long lenBuffer = ((5000 \ BytesPorClúster(left(strRutaYNombreFichero, _ 3))) + 1) * BytesPorClúster(left(strRutaYNombreFichero, 3)) hFile = CreateFile(strRutaYNombreFichero, GENERIC_READ, 0, _ ByVal 0&, OPEN_EXISTING, FILE_FLAG_NO_BUFFERING, 0) ReDim byBuffer(1 To lenBuffer) As Byte Do rc = ReadFile(hFile, byBuffer(1), UBound(byBuffer), Ret, _ ByVal 0&) Loop Until Ret < lenBuffer CloseHandle hFile 'Se sale del bucle cuando el número de bytes leídos es menor que el tamaño 'del búffer, que es igual al número de bytes que se ha requerido leer.Esto 'puede ocurrir porque se haya llegado al final del fichero, o porque haya 'ocurrido algún error. por ello, comprobamos si se ha producido algún error, 'usando la función GetLastError. lngLastError = GetLastError If lngLastError <> ERROR_SUCCESS Then strBufferMensaje = Space(400) FormatMessage FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, _ lngLastError, LANG_NEUTRAL, strBufferMensaje, 400, ByVal 0& Comprobar_LecturaFichero = False GoTo Exit_Comprobar_LecturaFichero Else strContenido = "" For c = 1 To UBound(byBuffer) strContenido = strContenido & Chr$(byBuffer(c)) Next c MsgBox "Fin del fichero: " & vbCrLf & strContenido Comprobar_LecturaFichero = True End If Exit_Comprobar_LecturaFichero: End Function Function Copiar_FicheroConVerificación(strOrigen As String, _ strDestino As String) As Boolean 'Esta función realiza la copia y la lectura de verificación, y, al realizar 'la copia no usa la cache (en la verificación tampoco), y el fichero destino se 'borra (si existe) antes de comenzar la copia, por lo que no hay peligro de 'que sus datos ya estén en la caché. Dim byBuffer() As Byte 'Búfer usado para lectura y escritura de los ficheros. Dim lenBuffer As Long 'Tamaño del búfer declarado arriba. Dim hFile1 As Long 'Para leer el fichero origen. Dim hFile2 As Long 'Para escribir en el ficherodestino. Dim hFile3 As Long 'Para leer el fichero destino por si tiene algún error. Dim rc As Long 'Para recoger los valores devueltos por las Apis. Dim Ret1 As Long 'Contendrá el nº de bytes realmente leídos o escritos Dim Ret2 As Long 'en las respectivas lecturas o escritura. Dim Ret3 As Long Dim strBufferMensaje As String 'Para escribir los posibles mensajes de error. Dim strComienzoMensaje As String 'Para completar el posible mensaje de error. Dim lngLastError As Long Dim intTamañoClúster As Long strBufferMensaje = Space(400) lenBuffer = 5000 intTamañoClúster = BytesPorClúster(left(strDestino, 3)) 'Cuando leemos un fichero sin usar la caché, debemos posicionar el puntero 'de lectura en una posición que sea un múltiplo exacto del tamaño del 'sector del disco. En nuestro caso, como siempre empezaremos desde la 'posición cero del fichero, no debemos preocuparnos por esto. 'Sin embargo, también se debe leer los datos en una cantidad que sea un 'múltiplo exacto del tamaño del sector físico del disco. Para conseguir esto, 'aplicamos a la variable lenBuffer la siguiente operación (en lugar del 'sector físico, he usado el clúster, para estar más seguro). lenBuffer = (( _ lenBuffer \ intTamañoClúster) + 1) * intTamañoClúster hFile1 = CreateFile(strOrigen, GENERIC_READ, _ FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, _ 0) lngLastError = GetLastError If lngLastError <> ERROR_SUCCESS Then strComienzoMensaje = "Error al intentar abrir " & strOrigen & _ " para lectura:" & vbCrLf GoTo Error End If hFile2 = CreateFile(strDestino, GENERIC_WRITE, _ FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, CREATE_ALWAYS, _ FILE_FLAG_NO_BUFFERING Or FILE_FLAG_WRITE_THROUGH, 0) lngLastError = GetLastError If lngLastError <> ERROR_SUCCESS Then strComienzoMensaje = "Error al intentar abrir " & strDestino _ & " para escritura:" & vbCrLf GoTo Error End If hFile3 = CreateFile(strDestino, GENERIC_READ, _ FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, _ FILE_FLAG_NO_BUFFERING Or FILE_FLAG_WRITE_THROUGH, 0) lngLastError = GetLastError If lngLastError <> ERROR_SUCCESS Then strComienzoMensaje = "Error al intentar abrir " & strDestino _ & _ " para lectura (para comprobar que se puede leer correctamaente):" & vbCrLf GoTo Error End If ReDim byBuffer(1 To lenBuffer) As Byte Do rc = ReadFile(hFile1, byBuffer(1), UBound(byBuffer), Ret1, _ ByVal 0&) lngLastError = GetLastError If lngLastError <> ERROR_SUCCESS Then strComienzoMensaje = "Error al intentar leer " & _ strDestino & ":" & vbCrLf Exit Do End If rc = WriteFile(hFile2, byBuffer(1), Ret1, Ret2, ByVal 0&) lngLastError = GetLastError If lngLastError <> ERROR_SUCCESS Then strComienzoMensaje = "Error al intentar escribir " & _ strDestino & ":" & vbCrLf Exit Do End If rc = ReadFile(hFile3, byBuffer(1), Ret1, Ret3, ByVal 0&) lngLastError = GetLastError If lngLastError <> ERROR_SUCCESS Then strComienzoMensaje = "Error al intentar leer " & _ strDestino & _ " para comprobar que se puede leer correctamaente:" & _ vbCrLf Exit Do End If Loop Until (Ret1 < lenBuffer) Or (Ret2 < lenBuffer) Or ( _ Ret3 < lenBuffer) 'Se sale del bucle cuando el número de bytes leídos es menor que el tamaño 'del búffer, que es igual al número de bytes que se harequerido leer.Esto 'puede ocurrir porque se haya llegado al final del fichero, o porque haya 'ocurrido algún error. por ello, comprobamos si se ha producido algún error, 'usando la función GetLastError. If lngLastError <> ERROR_SUCCESS Then GoTo Error 'Ahora cerramos las asas (handles) de los ficheros. CloseHandle hFile1 lngLastError = GetLastError If lngLastError <> ERROR_SUCCESS Then strComienzoMensaje = "Error al intentar cerrar " & strOrigen _ & ":" & vbCrLf GoTo Error End If CloseHandle hFile2 lngLastError = GetLastError If lngLastError <> ERROR_SUCCESS Then strComienzoMensaje = "Error al intentar cerrar " & strDestino _ & " en su apertura para escritura:" & vbCrLf GoTo Error End If CloseHandle hFile3 lngLastError = GetLastError If lngLastError <> ERROR_SUCCESS Then strComienzoMensaje = "Error al intentar cerrar " & strDestino _ & _ " en su apertura para lectura (para comprobar que se puede leer correctamaente):" & vbCrLf GoTo Error End If Copiar_FicheroConVerificación = True Exit_Comprobar_LecturaFichero: Exit Function Error: If lngLastError <> ERROR_SUCCESS Then strBufferMensaje = Space(400) FormatMessage FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, _ lngLastError, LANG_NEUTRAL, strBufferMensaje, 400, ByVal 0& MsgBox strComienzoMensaje & strBufferMensaje Copiar_FicheroConVerificación = False GoTo Exit_Comprobar_LecturaFichero End If GoTo Exit_Comprobar_LecturaFichero End Function Function Copiar_FicheroConVerificaciónYBarraProgreso( _ strOrigen As String, strDestino As String) As Boolean Dim byBuffer() As Byte 'Búfer usado para lectura y escritura de los ficheros. Dim lenBuffer As Long 'Tamaño del búfer declarado arriba. Dim hFile1 As Long 'Para leer el fichero origen. Dim hFile2 As Long 'Para escribir en el fichero destino. Dim hFile3 As Long 'Para leer el fichero destino por si tiene algún error. Dim rc As Long 'Para recoger los valores devueltos por las Apis. Dim Ret1 As Long 'Contendrá el nº de bytesrealmente leídos o escritos Dim Ret2 As Long 'en las respectivas lecturas o escritura. Dim Ret3 As Long Dim strBufferMensaje As String 'Para escribir los posibles mensajes de error. Dim strComienzoMensaje As String 'Para completar el posible mensaje de error. Dim lngLastError As Long Dim intTamañoClúster As Long Dim c As Long 'Contador strBufferMensaje = Space(400) lenBuffer = 5000 intTamañoClúster = BytesPorClúster(left(strDestino, 3)) 'Cuando leemos un fichero sin usar la caché, debemos posicionar el puntero 'de lectura en una posición que sea un múltiplo exactodel tamaño del 'sector del disco. En nuestro caso, como siempre empezaremos desde la 'posición cero del fichero, no debemos preocuparnos por esto. 'Sin embargo, también se debe leer los datos en una cantidad que sea un 'múltiplo exacto del tamaño del sector físico del disco. Para conseguir esto, 'aplicamos a la variable lenBuffer la siguiente operación (en lugar del 'sector físico, he usado el clúster, para estar más seguro). lenBuffer = (( _ lenBuffer \ intTamañoClúster) + 1) * intTamañoClúster 'Inicializamos la barra de progreso. Call SysCmd(acSysCmdInitMeter, "Copiado:", _ FileLen(strOrigen) \ lenBuffer + 1) hFile1 = CreateFile(strOrigen, GENERIC_READ, _ FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, _ 0) lngLastError = GetLastError If lngLastError <> ERROR_SUCCESS Then strComienzoMensaje = "Error al intentar abrir " & strOrigen & _ " para lectura:" & vbCrLf GoTo Error End If hFile2 = CreateFile(strDestino, GENERIC_WRITE, _ FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, CREATE_ALWAYS, _ FILE_FLAG_NO_BUFFERING Or FILE_FLAG_WRITE_THROUGH, 0) lngLastError = GetLastError If lngLastError <> ERROR_SUCCESS Then strComienzoMensaje = "Error al intentar abrir " & strDestino _ & " para escritura:" & vbCrLf GoTo Error End If hFile3 = CreateFile(strDestino, GENERIC_READ, _ FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, _ FILE_FLAG_NO_BUFFERING Or FILE_FLAG_WRITE_THROUGH, 0) lngLastError = GetLastError If lngLastError <> ERROR_SUCCESS Then strComienzoMensaje = "Error al intentar abrir " & strDestino _ & _ " para lectura (para comprobar que se puede leer correctamaente):" & vbCrLf GoTo Error End If ReDim byBuffer(1 To lenBuffer) As Byte c = 1 Do 'He probado a poner DoEvents entre cada dos órdenes de lectura o escritura, pero entonces da error. rc = ReadFile(hFile1, byBuffer(1), UBound(byBuffer), Ret1, _ ByVal 0&) lngLastError = GetLastError If lngLastError <> ERROR_SUCCESS Then strComienzoMensaje = "Error al intentar leer " & _ strDestino & ":" & vbCrLf Exit Do End If rc = WriteFile(hFile2, byBuffer(1), Ret1, Ret2, ByVal 0&) lngLastError = GetLastError If lngLastError <> ERROR_SUCCESS Then strComienzoMensaje = "Error al intentar escribir " & _ strDestino & ":" & vbCrLf Exit Do End If rc = ReadFile(hFile3, byBuffer(1), Ret1, Ret3, ByVal 0&) lngLastError = GetLastError If lngLastError <> ERROR_SUCCESS Then strComienzoMensaje = "Error al intentar leer " & _ strDestino & _ " para comprobar que se puede leer correctamaente:" & _ vbCrLf Exit Do End If Call SysCmd(acSysCmdUpdateMeter, c) c = c + 1 Loop Until (Ret1 < lenBuffer) Or (Ret2 < lenBuffer) Or ( _ Ret3 < lenBuffer) 'Se sale del bucle cuando el número de bytes leídos es menor que el tamaño 'del búffer, que es igual al número de bytes que se ha requerido leer.Esto 'puede ocurrir porque se haya llegado al final del fichero, o porque haya 'ocurrido algún error. por ello, comprobamos si se ha producido algún error, 'usando la función GetLastError. If lngLastError <> ERROR_SUCCESS Then GoTo Error 'Ahora cerramos las asas (handles) de los ficheros. CloseHandle hFile1 lngLastError = GetLastError If lngLastError <> ERROR_SUCCESS Then strComienzoMensaje = "Error al intentar cerrar " & strOrigen _ & ":" & vbCrLf GoTo Error End If CloseHandle hFile2 lngLastError = GetLastError If lngLastError <> ERROR_SUCCESS Then strComienzoMensaje = "Error al intentar cerrar " & strDestino _ & " en su apertura para escritura:" & vbCrLf GoTo Error End If CloseHandle hFile3 lngLastError = GetLastError If lngLastError <> ERROR_SUCCESS Then strComienzoMensaje = "Error al intentar cerrar " & strDestino _ & _ " en su apertura para lectura (para comprobar que se puede leer correctamaente):" & vbCrLf GoTo Error End If Copiar_FicheroConVerificaciónYBarraProgreso = True Exit_Comprobar_LecturaFichero: Call SysCmd(acSysCmdRemoveMeter) Exit Function Error: If lngLastError <> ERROR_SUCCESS Then strBufferMensaje = Space(400) FormatMessage FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, _ lngLastError, LANG_NEUTRAL, strBufferMensaje, 400, ByVal 0& MsgBox strComienzoMensaje & strBufferMensaje Copiar_FicheroConVerificaciónYBarraProgreso = False GoTo Exit_Comprobar_LecturaFichero End If GoTo Exit_Comprobar_LecturaFichero End Function