7 de abril de 2008

Programa para comprimir en zip utilizando el Shell de Windows

Después de estar buscando varias opciones para comprimir archivos en zip, encontré la que, a mi punto de vista es mas práctica y no necesita dll adicionales, anexo os pongo el prg a ver si os sirve.

Nota del Editor: Código similar al ejemplo enviado por Moby (Guatemala) y publicado en: Crear un Zip usando los recursos estandard de Windows
***************************************************************
* COMPRIMIRENZIP.PRG 
* Se encarga de comprimir en un archivo zip varias extensiones de Archivos 
* utilizando el Shell de Windows - probado en XP 
* FECHA : 19 MARZO 2008 
* HECHO POR : ROTEROL (Rubén V. Otero L.) 
* La Coruña, España
****************************************************************

LOCAL lcExtension, lcZip && Variables locales tipo Caracter
LOCAL lnArchivos, lnContArray, lnContArrayDef && Variables locales tipo Numérico
LOCAL loZip, loShell, loFolder && Variables locales tipo Objeto
LOCAL ARRAY laArchivos[1,1], laArcDef[1], laExtensiones[6] && Variables locales tipo Array

*!* Verifico todos los ficheros a comprimir y los guardo en un array único laArcDef
*!* No puedo hacer una sola instrucción adir con todas las extensiones de archivos, con lo cual,
*!* ejecuto tantos adir como sea necesario para almacenar los 
*!* *.dbc, *.dct, *.dcx, *.dbf, *.fpt y *.cdx
laExtensiones[1] = "*.dbc"
laExtensiones[2] = "*.dcx"
laExtensiones[3] = "*.dct"
laExtensiones[4] = "*.dbf"
laExtensiones[5] = "*.fpt"
laExtensiones[6] = "*.cdx"
FOR EACH lcExtension IN laExtensiones
  lnArchivos = ADIR(laArchivos,lcExtension)
  *!* Dependiendo si es la primera vez que paso por el For Each, declaro el array laArcDef con el
  *!* número de Archivos resultantes del Adir, Si no es la primera vez que paso por el For Each,
  *!* incremento el número de elementos de laArcDef en la longitud que tiene actualmente 
  *!* mas el número de archivos resultantes del adir
  IF lcExtension=laExtensiones[1]
    lnContArrayDef = 0
    DECLARE laArcDef[lnArchivos]
  ELSE
    lnContArrayDef = ALEN(laArcDef)
    DECLARE laArcDef[ALEN(laArcDef)+lnArchivos]
  ENDIF
  FOR lnContArray = 1 TO lnArchivos
    lnContArrayDef = lnContArrayDef + 1
    laArcDef[lnContArrayDef] = ADDBS(FULLPATH(CURDIR()))+laArchivos[lnContArray,1]
  NEXT
NEXT

lcZip = ADDBS(FULLPATH(CURDIR()))+'ArchivoComprimido.zip'
IF FILE(lcZip) && Borro Zip si existe
  ERASE lcZip
ENDIF

*!* Creo Fichero Encabezado de zip
STRTOFILE(CHR(0x50)+CHR(0x4B)+CHR(0x05)+CHR(0x06)+REPLICATE(CHR(0),18),lcZip)

oShell = CREATEOBJECT("Shell.Application")

IF TYPE('oShell')='O'
  *!* Según Investigué, Microsoft recomienda crear el Objeto oFolder y trabajar con ese objeto 
  *!* para hacer la instrucción copyHere intenté hacerlo directamente
  *!* -oShell.NameSpace("&lcZip").copyHere(laArcDef[lnContArray])-, pero recibía contínuos errores de
  *!* fallo de aplicación VFP. asimismo, tuve que crear el objeto oFolder con la macrosubstitución
  *!* -oShell.NameSpace("&lcZip")- por que tambien, depurando el programa, detecté que no se 
  *!* creaba el objeto oFolder colocando la instrucción -oShell.NameSpace("&lcZip")- directamente
  oFolder = oShell.NameSpace("&lcZip")
  IF TYPE('oFolder')='O'
    FOR lnContArray = 1 TO lnContArrayDef && ALEN(laArcDef)
      WAIT 'Procesando Archivo '+LOWER(laArcDef[lnContArray])+', '+;
        ALLTRIM(STR(lnContArray*100/lncontArrayDef))+'%' WINDOW NOWAIT
      oFolder.CopyHere(laArcDef[lnContArray])
      *!* Me veo obligado tambien a colocarle un inkey por que si no se pone y por ejemplo
      *!* tenemos 48 archivos para comprimir (como es mi caso), el proceso lo efectúa muy rapido,
      *!* y aún cuando sale del for...next, se crean tantos shell de Fox
      *!* como archivos haya, con el dialogbox de "Comprimiendo..."
      INKEY(0.5)
    NEXT
    WAIT CLEAR
    oFolder = .F.
  ELSE
    MESSAGEBOX('No pudo crearse el Objeto oFolder',16)
  ENDIF
  oShell = .F.
ELSE
  MESSAGEBOX('No pudo crearse el Objeto Shell',16)
ENDIF
Rubén V. Otero L.

1 comentario :

  1. Copié el código y lo ejecuté
    Funcionó de maravilla
    Gracias por contribución tan valiosa

    ResponderBorrar

Los comentarios son moderados, por lo que pueden demorar varias horas para su publicación.