Partir un archivo en piezas más pequeñas

Partir un archivo en n bytes con fox. Esto es parte de utilidades de backups. (Les envio el programa para volver a unir las piezas en la proxima noticia)

*- JARSoft Argentina
*- Prog. Alberto Rodiriguez - jarargentina@hotmail.com
*- Ultima modificacion: Abr. 2003
*-
*- Partir el archivo en piezas de n bytes
*- ADVERTENCIA.!! todos los archivos de extencion nnn de tcDestino se eliminan.!!
*- Parámetros:
Lparameters tcArchivo, tnBytes, tcDestino
*- Devuelve el nro de pedazos en que se partio el archivo o cero
*- si no se pudo completar la operacion o -1 si hubo algun error.

*- Ej. de uso:
*- nPedazos = partirarchivo_01('c:tmpRespaldos.zip', 1457664, 'c:tmp')
*- Este ejemplo divide respaldos.zip en 1.40 Mg para que las partes quepan en
*- disquetes y las pone en c:tmp

If PCOUNT() # 3 Or Vartype(tcArchivo) # 'C' Or Vartype(tnBytes) # 'N' Or ;
  tnBytes < 1 Or Vartype(tcDestino) # 'C' Or !Directory(tcDestino)
 Messagebox('Error de llamada.',16,'')
 Return -1
Endif

If Val(Left(Version(4),2)) < 7
 Messagebox('Debe modificar (y verificar) este programa para que corra en esta '+;
  'version',16,'Version no soportada')
 Return -1
Endif

tcDestino = Lower(Addbs(tcDestino))

Local x, nDevolver, nTamanio, nBytesEscritos, nMan, nManParte, nNroDisco As Integer
Local cAux, cCadenaleida, cAntesSafe, cFlog As String
Local lOk As Boolean

*--------------------------------------------------------------------------
*- como el programa parte en extenciones de 00n no se permiten partir
*- archivos con estas extenciones.
cAux = Justext(tcArchivo)
If Len(cAux) = 3  && si es # 3 no hay problema, pueden convivir.
 For x = 1 To Len(cAux)
  If !Isdigit(Substr(cAux, x, 1))
   lOk = .T.
   Exit
  Endif
 NEXT
ELSE
 lOk = .T.
Endif
*- continuar si la extencion no tiene solo numeros.
If !lOk
 Messagebox('No se permiten partir archivos con extenciones iguales a las '+;
  'que se usará en las partes.',16,'Excepción')
 Return -1
Endif
*--------------------------------------------------------------------------

cFlog = Sys(3)+'.log'

cAntesSafe = Set("Safety")
nDevolver = 0
If !File(tcArchivo)
 Messagebox(tcArchivo+' no existe.',16,'No existe el archivo')
 Return -1
Endif
tcArchivo = Lower(Locfile(tcArchivo))
*- verificar que el tamaño sea mayor que tnBytes
If Adir(aInfoFilePartir1, tcArchivo)#1
 Return -1
Endif
nTamanio = aInfoFilePartir1[1,2]  && tamaño total del archivo a partir
If nTamanio <= tnBytes
 Messagebox('No se puede partir en menos de 2 partes',16,'Parámetros incorrectos')
 Return -1
Endif

Set Safety Off
If !Empty(Sys(2000, tcDestino + Juststem(tcArchivo)+'.*'))
 *- hay que consultar asi y no erase dir*.*, porque el archivo original
 *- (de igual nombre y con otra extencion podria encontrarse en el mismo
 *- directorio destino)
 For x=0 To 999
  cAux = tcDestino + Juststem(tcArchivo)+'.'+Transform(x,@L 999')
  If File(cAux)
   Erase (cAux) recycle
  Endif
 Next
Endif

*- partir el archivo original:
nNroDisco = 1
nMan = Fopen(tcArchivo)
If nMan < 0
 Messagebox('No se puede abrir '+tcArchivo,16,'Operación cancelada')
 Return -1
Endif

Do While nTamanio > 0
 If nNroDisco > 999
  nDevolver = -1
  Messagebox('Demasiados archivos',16,'')
  Exit
 Endif

 cFileDestino = tcDestino + ;
  Forceext(Justfname(tcArchivo), Transform(nNroDisco, @L 999'))
 nManParte = Fcreate(cFileDestino)
 If nManParte < 0
  nDevolver = -1
  Messagebox('No se puede crear '+cFileDestino,16,'Operación cancelada')
  Exit
 Endif

 nEspacio = tnBytes
 Do While nEspacio > 0 And nTamanio > 0
  cCadenaleida = Fread(nMan, Min(10240, nEspacio))
  nBytesEscritos = Fwrite(nManParte, cCadenaleida) && escribir lo real leido
  If nBytesEscritos = 0
   nDevolver = -1
   Messagebox('No se puede escribir',16,'Operación cancelada')
   Exit
  Endif

  nEspacio = nEspacio - nBytesEscritos
  nTamanio = nTamanio - nBytesEscritos
 Enddo

 Fclose(nManParte)
 nDevolver = nNroDisco
 If nTamanio <= 0
  Exit
 Endif
 nNroDisco = nNroDisco + 1
Enddo
Fclose(nMan)
*- fin partir

Release aInfoFilePartir1
Set Safety &cAntesSafe

Return nDevolver
*- Par volver a unir las partes en el archivo original,
*- usar: unirarchivo_01.prg
*- JARSoft Argentina

Alberto Rodriguez