Crear un Zip usando los recursos estándar de Windows

Estuve buscando por mucho tiempo la manera de usar la funcionalidad estándar de Windows "carpetas comprimidas" pero fue hasta ahora que encontré la manera.

Como se que muchos de ustedes posiblemente han estado buscando rutinas para empacar y desempacar archivos .zip de manera automática y sin instalar librerías de terceros (winzip, .dlls, etc) aquí les envío una copia del .prg que cree para hacer esto sin necesidad de instalar nada mas que VFP.

********************************************
*
* CREADO: Moby
*         Guatemala
*         Enero 2008
*
* Crear un zip con las funciones del sistema operativo Windows
* Este programa deberia funcionar en windows 95/98/Me/XP/2000/2003/Vista
* Lo he probado en Windows Me/XP/y demas y funciona bien.
*
* Para usarlo en Windows Pre-XP instale primero la funcionalidad 
* "carpetas comprimidas"
* en Inicio > Panel de control > Agregar y quitar programas > Componentes Windows
*
* Lo que hay que entender en este programa
* es que para Windows, un archivo .zip no es mas
* que un objeto Folder (es decir una carpeta cualquiera)
*
* Si quieren saber mas sobre Shell.Application
* pueden buscar la documentacion completa en:
*
* +MSDN - Library 2001 o posterior
* ++Platform SDK Documentation
* +++User interface services
* ++++Windows shell
* 
* La informacion especifica de como tratar un objeto folter
* la pueden encontrar en:
*
* +MSDN - Library 2001 o posterior
* ++Platform SDK Documentation
* +++User interface services
* ++++Windows shell
* +++++Shell Reference
* 
* y denle una ojeada a:
* 
*      +++Shell Objects for scripting an Visual Basic
*      ++++Shell Object
*      +++++Methods
*      ++++++NameSpace
*
* Y Tambien a:
*
*      ++Shell Objects for scripting an Visual Basic
*      +++Folder Object
*      ++++Methods
*      +++++CopyHere
*      ++++++Items
*
* El argumento de CopyHere 
* PUEDE ser:
*
* Una cadena conteniendo la ruta completa y el nombre del archivo a copiar
* o Una referencia al Objeto FolderItems
* o Una referencia al objeto FolderItem
*
* FolderItems referencia el contenido completo del folder
* folderItem  referencia solo un archivo en el folder
*
********************************************

&& Secuencia para empacar un archivo:

&& obtener el nombre del zip
cArchivoZip = GetFile("zip:zip","archivo:","Crear",0)

&& obtener un nombre de directorio para empacar
cDirectorioFuente = GetDir("","FUENTE","¿Que empacar?",80)

&& Si se tiene un nombre de archivo
If .not. (Empty(cArchivoZip) .or. Empty(cDirectorioFuente))
  && Borra el archivo si ya existe y lo envia a la papelera
  If File(cArchivoZip)
    Delete File (cArchivoZip) RECYCLE
  EndIf
  && Crear el nuevo zip
  If CreaZip(cArchivoZip)
    && empacalo
    Empaca(cArchivoZip,cDirectorioFuente)
  EndIf
EndIf

&& Secuencia para desempacar un archivo

&& obtener el nombre del zip
cArchivoZip = GetFile("zip:zip","Archivo:","Desempacalo",0)

&& obtener un nombre de directorio destino
cDirectorioDestino = GetDir("","DESTINO","¿A donde desempacar?",80)

&& Desempacalo
If File(cArchivoZip) .and. !Empty(cDirectorioDestino)
  Desempaca(cArchivoZip,cDirectorioDestino) 
EndIf

***********************************************************************************
PROCEDURE CreaZip
PARAMETERS cNombre     && recibe como parametro el nombre del zip
PRIVATE lRetorno
  lRetorno = .f.

  && Crea un archivo zip y le adiciona el primer encabezado

  && Crear el archivo en blanco
  nHandle = fCreate(cNombre)
  
  && si se pudo crear
  If nHandle > 0
     && Escribirle el encabezado .zip
    nEscritos = fWrite(nHandle,"PK"+Chr(5)+Chr(6)+Replicate(Chr(0),18),22)
    && cerrar el archivo
    =fClose(nHandle)
    
    && reportar OK.
    lRetorno = .t.
  EndIf

  && para determinar el encabezado se creo un archivo .zip
  && vacio (click derecho > nuevo > carpeta comprimida en zip). 
  && Y despues se leyo con la funcion leezip que aparece al final
  && de este prg 

RETURN lRetorno
***********************************************************************************
PROCEDURE Empaca
PARAMETERS cFileName,cDirectorio
PRIVATE oShell,oFolder

  && Crear un shell
  oShell = CREATEOBJECT("Shell.Application")
   
  && obtener el objeto Folder del archivo zip
  oFolder = oShell.NameSpace(cFileName)
  
  If IsNull(oFolder)
    =MessageBox("No se puede abrir el zip.",48,"Advertencia:")
  Else
    && si se pudo obtener el objeto folder

    && copiar el directorio al zip
    oFolder.CopyHere(cDirectorio)

    && la sintaxis: oShell.NameSpace(cFileName).CopyHere(cDirectorio)
    && es valida.
    && pero Microsoft sugiere primero hacer oFolder = NameSpace
    && y despues usar oFolder. 
    
    && se puede verificar si el zip empaco todo 
    && usando la propiedad Count del objeto Items 
    && pero les queda de tarea 
  EndIf
  
  && se liberan los recursos 
  Release oShell,oFolder
  
ENDPROC
***********************************************************************************
PROCEDURE Desempaca 
PARAMETERS cFileName,cDirectorio
PRIVATE oShell,;
        oFS,;             && oFolderSource
        oFD,;             && oFolderDest
        oFSI              && oFolderItems 

  && Se crea un shell
  oShell = CREATEOBJECT("Shell.Application")
  
  && Se obtiene el objeto folder del zip
  oFS = oShell.NameSpace(cFilename)
  
  && Se obtien el objeto folder del directorio destino
  oFD = oShell.NameSpace(cDirectorio)

  && Se obtiene el objeto items del zip
  oFSI = oFS.Items 

  If IsNull(oFS) .or. IsNull(oFD)
    =MessageBox("No se puede abrir el zip.",48,"Advertencia:")
  Else
    && Si se pudieron obtener todos los objetos

    && Verifica si el zip contiene archivos dentro
    If oFSI.Count > 0
      && Metodo para desempacar de uno en uno
      && si necesita usarlo comente el otro metodo y des-comente este
      && note que J empieza en 0 y no en 1
*      For J = 0 To (oFSI.Count-1)
*        oFD.CopyHere(oFSI.Item(J))
*      Next

      && Metodo para desempacar todo de una sola vez
      oFD.CopyHere(oFSI)
    Else
      =MessageBox("El zip de origen esta vacio.",48,"Advertencia")
    EndIf
  EndIf
  
  && libera los recursos
  Release oShell,oFS,oFD,oFSI
  
ENDPROC
***********************************************************************************
PROCEDURE LeeZip
PARAMETERS cArchivo
PRIVATE I,J,k
  && abre un archivo (cualquiera) y lo lee byte por byte
  
  && limpia la pantalla
  clear
  
  && abre el archivo a bajo nivel (read-write unbuffered = 12)
  nHandle = fOpen(cArchivo,12)
  
  && si lo pudo abrir
  If nHandle > 0
    && obtiene el tamaño del archivo
    j=fseek(nHandle,0,2)
    
    && ubica el puntero en el inicio
    =fSeek(nHandle,0,0)

    && lee el archivo byte por byte
    && y despliega los resultados en pantalla
    For i=1 to j
      k=fRead(nHandle,1) 
      ? k 
      ?? " = " 
      ?? Asc(k) 
    EndFor
    
    && cierra el archivo    
    =fClose(nHandle)
  EndIf

ENDPROC
***********************************************************************************

Gabriel [Moby]