Ya están disponibles los Componentes Sedna para mejorarlos y ampliarlos en VFPx.
Sedna esta compuesto de seis diferentes proyectos:
******************************************** * * 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 ***********************************************************************************