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) ENDIFRubén V. Otero L.
Copié el código y lo ejecuté
ResponderBorrarFuncionó de maravilla
Gracias por contribución tan valiosa