Me envia 1 kb de mas... - VB-MUNDO

Ixreb · #1 (**permalink**) 12-01-2007, 18:38:40

Os comento, mi proposito es unir 2 archivos ya cortados (he comprobado que se han cortado correctamente), pero si por ejemplo, el 1º archivo ocupa 3 kb al copiarlo al archivo donde voy a unirlos me ocupa 4, y no entiendo porque me envia 1kb mas... El código es el siguiente:

Dim Buffer As String * 1024

Open "c:\archivo_" & i & "." & i For Binary As #1

Do While not EOF(1)
Get #1, , Buffer
Open destino.Text For Binary As #2
Seek (2), LOF(2) + 1
Put #2, , Buffer
Close #2
Loop

Close #1

i = i + 1

(Ahora mismo se van añadiendo cada vez que pulse el boton, ya que, queria saber que fallaba)

Pues lo dicho, siempre me añade 1 kb mas por archivo, por lo tanto el archivo unido no sirve al unirlo

Gracias adelantadas

acalanto · #2 (**permalink**) 12-01-2007, 20:22:42

Es que por defecto dimensionas un buffer de 1024 y deberías hacerlo de forma dinámica tal como te muestro en el siguiente código modificado.

Código:

Dim Buffer As String
Dim i as Long
'Apertura del archivo Destino
Open destino.Text For Binary As #2 
for i = 1 to 2
    'Abrimos el fichero origen 'I'
    Open "c:\archivo_" & i & "." & i For Binary As #1 
    'Asignamos un buffer stream de la longitud del fichero origen
    Buffer = string(LOF(1),32)
    Get #1, , Buffer 
    Put #2, , Buffer 
    Close #1
next i 
'Cerramos fichero destino
Close #2

Espero que te resulte útil.

Ixreb · #3 (**permalink**) 12-01-2007, 23:56:13

gracias acalanto, funciona a la perfección. Yo en realidad lo habia dimensionado a 1 kb para tener control sobre el progreso, y por cada vez que se hiciese el bucle aumentar un progressbar con tamaño max tamaño del archivo. Pero este código tambien funciona, solo me queda probar si peta pegando archivos mayores

Saludos

acalanto · #4 (**permalink**) 13-01-2007, 08:45:14

Yo te he propuesto esta variante de código con la seguridad de que se trata de ficheros pequeños que construyen uno mayor, y por esta razón no controlo el tamaño del fichero origen.

Para garantizar que funcione bien con cualquier tamaño de fichero es necesario lerr por bloques el origen hasta agotarlo, para evitar un desbordamiento de la memoria con un tamaño de buffer excesivo. Observa el siguiente ejemplo y comprobarás que funciona bien bajo cualquier situación (Ojo que windows no acepta ficheros mayores de 2 GB). Lógicamente deberás probar y adaptar a tus necesidades ya que está escrito 'al vuelo' y he podido cometer algún error.

Código:

public function union(FDestino as String, relpath as string, bloques as Long) as boolean
    Dim Buffer As String
    Dim MaxLen As Long 
    Dim Resto As Long
    Dim ptr As Long
    Dim i as Long 
    Dim hdo as integer
    Dim hdd as Integer
    On Local Error Resume Next
    'Asumimos un bloque máximo de lectura de 1 MB
    MaxLen = 1024^2
    'Apertura del archivo Destino 
    hdd = Freefile()
    Close #hdd : Open FDestino For Binary As #2 
    'Bucle de tratamiento de las diferentes particiones
    'con las que se construye el fichero completo.
    for i = 1 to bloques 
        'Abrimos el fichero origen 'I' 
        hdo = Freefile() : Close #hdo
        Open RelPath & cstr(i) & "." & cstr(i) For Binary As #hdo
        'Iniciamos el puntero de lectura
        ptr = 0
        Do
            If (LOF(hdo)-ptr) <= Len(MaxLen) then 
                'Asignamos un buffer stream de la longitud pendiente de copia 
                Buffer = string(LOF(1)-ptr, 32) 
                Get #hdo, ptr+1, Buffer 
                Put #hdd, , Buffer 
                Close #hdo
                Exit Do
            Else
                'Lectura y proceso de un Bloque MaxLen 
                Buffer = string(MaxLen, 32) 
                Get #hdo, ptr+1, Buffer 
                Put #hdd, , Buffer 
                ptr=ptr+MaxLen
            End If 
        Loop 
    Next i
    'Cerramos fichero destino 
    Close #2 
    'Controlamos si se han producido errores
    'durante el proceso de reconstrucción.
    union = iff(Err<>0, false, true)
end function

Ixreb · #5 (**permalink**) 14-01-2007, 02:31:33

muchas gracias acalanto :smt003

muy buen codigo