INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

Compression

Create .ZIP files in VFP with NO ActiveX, and No $ by wgcs
Posted: 19 Aug 04 (Edited 20 Aug 04)

#IF .f.
I have long tried to create real .ZIP files from within VFP without using any ActiveX ocx, and had finally given up, when I stumbled upon a method written in PHP, which I have now converted to VFP.

This uses the same "compress" function from the standard zlib.dll that is used in FAQ184-2070, but creates proper .ZIP header/individual file headers so that pkunzip (and any other zip program) can decompress the file.

You will need the standard zlib.dll that can be downloaded here: http://www.zlib.net/zlib121-dll.zip
See this page for more about ZLIB: http://www.gzip.org/zlib/

I haven't yet converted this code to uncompress .zip files... I expect that will be more difficult.

#ENDIF
*!*

CODE

*!*    Zip file creation class
*!*    makes zip files on the fly...
*!*
*!*    use the functions add_dir() and add_file() to build the zip file
*!* Requirements:
*!*    zlib.dll be available in the current directory or on the search path
*!*    NO ActiveX needed!!
*!*
*!*    see example code below
*!*
*!*    v1.0 2-5-01   initial version with:
*!*        - class appearance
*!*        - add_file() and file() methods
*!*        - gzcompress() output hacking
*!*        by Denis O.Philippov, webmaster@atlant.ru, http://www.atlant.ru
*!*
*!*    v1.1 9-20-01
*!*        - added comments to example
*!*     - by Eric Mueller http://www.themepark.com
*!*
*!* v2.0 9-19-04
*!*     - Converted to VFP from PHP code found at http://www.webestilo.com/php/cod.phtml?id=6
*!*     - by William GC Steinford
*!*
*!*
** // official ZIP file format: http://www.pkware.com/appnote.txt
*!*  (No longer seems active)
DO UnitTest

PROCEDURE UnitTest
* Test ZipFile class:
*!*    $zipfile = new zipfile()
xx= CREATEOBJECT('zipFile')
*!*    // add the subdirectory ... important!
xx.Add_Dir('dir1/')
IF NOT xx.Add_File('This is a test file', 'dir1/file1.txt')
  ?"Error Adding File"
  RETURN .f.
ENDIF
IF NOT xx.Add_File('This is a test file', 'dir1/file2.txt')
  ?"Error Adding File"
  RETURN .f.
ENDIF

*!*    // add the binary data stored in the string 'filedata'
xx.Add_Dir('dir2/')
IF NOT xx.Add_File('This is a test file', 'dir2/file1.txt')
  ?"Error Adding File"
  RETURN .f.
ENDIF
IF NOT xx.Add_File('This is a test file', 'dir2/file2.txt')
  ?"Error Adding File"
  RETURN .f.
ENDIF

STRTOFILE(xx.file(),'c:\temp\test.zip')




DEFINE CLASS zipFile AS Session
  datasec  = '' && array to store compressed data
  ctrl_dir = '' && central directory
  ctrl_dir_cnt = 0 && central directory item count
  * This "constant" doesn't belong here
*  eof_ctrl_dir = chr(0x50)+chr(0x4b)+chr(0x05)+chr(0x06)+chr(0x00)+chr(0x00)+chr(0x00)+chr(0x00)     && end of Central directory record
  old_offset = 0

  function add_dir( tcDir )
    && adds "directory" to archive - do this before putting any files in directory!
    && tcDir - name of directory... like this: "path/"
    && ...then you can add files using add_file with names like "path/file.txt"
    LOCAL lcDir, fr, crc, c_len, unc_len, new_offset
    
    * tcDir = str_replace("", "/", tcDir)
    lcDir = STRTRAN(tcDir,"\", "/")
    
    fr = chr(0x50)+chr(0x4b)+chr(0x03)+chr(0x04)
    fr = fr +  chr(0x0a)+chr(0x00) && ver needed to extract
    fr = fr +  chr(0x00)+chr(0x00) && gen purpose bit flag
    fr = fr +  chr(0x00)+chr(0x00) && compression method
    fr = fr +  chr(0x00)+chr(0x00)+chr(0x00)+chr(0x00) && last mod time and date
    
    fr = fr +  THIS.phpPACK("V",0) && crc32
    fr = fr +  THIS.phpPACK("V",0) &&compressed filesize
    fr = fr +  THIS.phpPACK("V",0) &&uncompressed filesize
    fr = fr +  THIS.phpPACK("v", len(lcDir) ) &&length of pathname
    fr = fr +  THIS.phpPACK("v", 0 ) &&extra field length
    fr = fr +  lcDir
    && end of "local file header" segment
    
    && no "file data" segment for path
    
    && "data descriptor" segment (optional but necessary if archive is not served as file)
    * wgcs: I assume that the undefined variables crc,c_len,unc_len will be 0 in these statements!!
    fr = fr +  THIS.phpPACK("V", 0 ) && crc    ) &&crc32
    fr = fr +  THIS.phpPACK("V", 0 ) && c_len  ) &&compressed filesize
    fr = fr +  THIS.phpPACK("V", 0 ) && unc_len) &&uncompressed filesize
    
    && add this entry to array
    this.datasec = this.datasec + fr
    
    new_offset = len(this.datasec)
    
    && ext. file attributes mirrors MS-DOS directory attr byte, detailed
    && at http:&&support.microsoft.com/support/kb/articles/Q125/0/19.asp
    
    && now add to central record
    cdrec = chr(0x50)+chr(0x4b)+chr(0x01)+chr(0x02)
    cdrec = cdrec + chr(0x00)+chr(0x00) && version made by
    cdrec = cdrec + chr(0x0a)+chr(0x00) && version needed to extract
    cdrec = cdrec + chr(0x00)+chr(0x00) && gen purpose bit flag
    cdrec = cdrec + chr(0x00)+chr(0x00) && compression method
    cdrec = cdrec + chr(0x00)+chr(0x00)+chr(0x00)+chr(0x00) && last mod time & date
    cdrec = cdrec +  THIS.phpPACK("V",0) && crc32
    cdrec = cdrec +  THIS.phpPACK("V",0) &&compressed filesize
    cdrec = cdrec +  THIS.phpPACK("V",0) &&uncompressed filesize
    cdrec = cdrec +  THIS.phpPACK("v", len(lcDir) ) &&length of filename
    cdrec = cdrec +  THIS.phpPACK("v", 0 ) &&extra field length
    cdrec = cdrec +  THIS.phpPACK("v", 0 ) &&file comment length
    cdrec = cdrec +  THIS.phpPACK("v", 0 ) &&disk number start
    cdrec = cdrec +  THIS.phpPACK("v", 0 ) &&internal file attributes
    ext = chr(0x00)+chr(0x00)+chr(0x10)+chr(0x00) && wgcs:This seems redundant!
    ext = chr(0xff)+chr(0xff)+chr(0xff)+chr(0xff)
    cdrec = cdrec +  THIS.phpPACK("V", 16 ) &&external file attributes - 'directory' bit set
    
    cdrec = cdrec +  THIS.phpPACK("V", this.old_offset ) &&relative offset of local header
    this.old_offset = new_offset
    
    cdrec = cdrec +  lcDir
    && optional extra field, file comment goes here
    
    && save to array
    this.ctrl_dir = this.ctrl_dir + cdrec
    THIS.ctrl_dir_cnt = THIS.ctrl_dir_cnt + 1
    
  ENDFUNC
    
    
  function add_file(tcData, tcFile)

    && adds "file" to archive
    && tcData - file contents
    && tcFile - name of file in archive. Add path if you want
    LOCAL lcFile, fr, unc_len, crc, zData, c_len
    
    lcFile = STRTRAN(tcFile,"\", "/")
    &&tcFile = str_replace("", "", tcFile)
    
    fr = chr(0x50)+chr(0x4b)+chr(0x03)+chr(0x04)
    fr = fr +  chr(0x14)+chr(0x00) && ver needed to extract
    fr = fr +  chr(0x00)+chr(0x00) && gen purpose bit flag
    fr = fr +  chr(0x08)+chr(0x00) && compression method
    fr = fr +  chr(0x00)+chr(0x00)+chr(0x00)+chr(0x00) && last mod time and date
    
    unc_len = len(tcData)
    crc     = VAL(SYS(2007,tcData,0,1)) && crc32(tcData) .. wgcs:returns crc32 as a string
    zdata   = THIS.gzCompress(tcData)
    IF EMPTY(zData)
      RETURN .F.
    ENDIF
    
    * wgcs: do we have to compensate for the bug, too?
    *zdata   = substr( substr(zdata, 0, len(zdata) - 4), 2) && fix crc bug     
    zdata   = substr( substr(zdata, 1, len(zdata) - 4), 3) && fix crc bug     
    c_len   = len(zdata)
    
    fr = fr +  THIS.phpPACK("V",crc)           && crc32
    fr = fr +  THIS.phpPACK("V", c_len)        && compressed filesize
    fr = fr +  THIS.phpPACK("V", unc_len)      && uncompressed filesize
    fr = fr +  THIS.phpPACK("v", len(lcFile) ) && length of filename
    fr = fr +  THIS.phpPACK("v", 0 )           && extra field length
    fr = fr +  lcFile
    && end of "local file header" segment
    
    && "file data" segment
    fr = fr +  zdata
    
    && "data descriptor" segment (optional but necessary if archive is not served as file)
    fr = fr +  THIS.phpPACK("V",crc)     && crc32
    fr = fr +  THIS.phpPACK("V",c_len)   && compressed filesize
    fr = fr +  THIS.phpPACK("V",unc_len) && uncompressed filesize
    
    && add this entry to array
    this.datasec = this.datasec + fr
    
    new_offset = len(this.datasec)
    
    && now add to central directory record
    cdrec = chr(0x50)+chr(0x4b)+chr(0x01)+chr(0x02)
    cdrec = cdrec + chr(0x00)+chr(0x00) && version made by
    cdrec = cdrec + chr(0x14)+chr(0x00) && version needed to extract
    cdrec = cdrec + chr(0x00)+chr(0x00) && gen purpose bit flag
    cdrec = cdrec + CHR(0x08)+chr(0x00) && compression method
    cdrec = cdrec + chr(0x00)+chr(0x00)+chr(0x00)+chr(0x00) && last mod time & date
    cdrec = cdrec +  THIS.phpPACK("V",crc)           && crc32
    cdrec = cdrec +  THIS.phpPACK("V", c_len)        && compressed filesize
    cdrec = cdrec +  THIS.phpPACK("V", unc_len)      && uncompressed filesize
    cdrec = cdrec +  THIS.phpPACK("v", len(lcFile) ) && length of filename
    cdrec = cdrec +  THIS.phpPACK("v", 0 )           && extra field length
    cdrec = cdrec +  THIS.phpPACK("v", 0 )           && file comment length
    cdrec = cdrec +  THIS.phpPACK("v", 0 )           && disk number start
    cdrec = cdrec +  THIS.phpPACK("v", 0 )           && internal file attributes
    cdrec = cdrec +  THIS.phpPACK("V", 32 )          && external file attributes - 'archive' bit set
    
    cdrec = cdrec +  THIS.phpPACK("V", this.old_offset ) &&relative offset of local header
    && echo "old offset is ".this->old_offset.", new offset is new_offset<br>"
    this.old_offset = new_offset
    
    cdrec = cdrec + lcFile
    && optional extra field, file comment goes here
    
    && save to central directory
    this.ctrl_dir     = this.ctrl_dir + cdrec
    THIS.ctrl_dir_cnt = THIS.ctrl_dir_cnt + 1
  ENDFUNC
    
  FUNCTION file
    && dump out file
*!*        LOCAL lcData, lcCtrlDir
*!*        lcData    = implode("", this.datasec  )  && condenses/implodes the array into a string
*!*        lcCtrldir = implode("", this.ctrl_dir )
    
    return THIS.DataSec + THIS.Ctrl_Dir + ; && this.eof_ctrl_dir
      chr(0x50)+chr(0x4b)+chr(0x05)+chr(0x06)+chr(0x00)+chr(0x00)+chr(0x00)+chr(0x00) ;    && end of Central directory record
         + THIS.phpPACK("v", this.ctrl_dir_cnt)  ; && total # of entries "on this disk"
         + THIS.phpPACK("v", this.ctrl_dir_cnt)  ; && total # of entries overall
         + THIS.phpPACK("V", len(this.ctrl_dir)) ; && size of central dir
         + THIS.phpPACK("V", len(THIS.dataSec))  ; && offset to start of central dir
         + chr(0x00)+chr(0x00)                && .zip file comment length
  ENDFUNC

  * * *
  * dword is compatible with LONG
  FUNCTION phpPACK( tcFmt, tnVal )
    #DEFINE m0       256
    #DEFINE m1     65536
    #DEFINE m2  16777216
    DO CASE
      CASE tcFmt='V' && unsigned long (32 bit) little-endian
        LOCAL b0, b1, b2, b3
        b3 = Int(tnVal/m2)
        b2 = Int((tnVal - b3*m2)/m1)
        b1 = Int((tnVal - b3*m2 - b2*m1)/m0)
        b0 = Mod(tnVal, m0)
        RETURN Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)
        
      CASE tcFmt='v' && unsigned short (16 bit) little-endian
        RETURN Chr(MOD(m.tnVal,256)) + CHR(INT(m.tnVal/256))
    ENDCASE
    RETURN ''
  ENDFUNC  

  FUNCTION gzCompress( InFile )
    DECLARE INTEGER compress IN zlib.dll AS zlibCompress ;
      STRING @ dest, INTEGER @ destLen, ;
      STRING src, INTEGER srcLen
    * Compresses the source buffer into the destination buffer.
    *   sourceLen is the byte length of the source buffer. Upon entry,
    *   destLen is the total size of the destination buffer, which must
    *   be at least 0.1% larger than sourceLen plus 12 bytes. Upon exit,
    *   destLen is the actual size of the compressed buffer.
    LOCAL lnSize, lcBuff, lnFinalSize
    lnSize = len(InFile)
    *123,456,789,012,345  15 chars is enough for 100 Terabytes.
    *100,000,000,000,000
    lnFinalSize = MAX( 100, len(InFile)*1.2 )
    lcBuff      = space(lnFinalSize)
    Res = zlibCompress( @lcBuff, @lnFinalSize, InFile, lnSize )
    If Res=0 && Success
      ** RETURN PadL( alltrim(str(lnSize)), 15, '0' ) + Left( lcBuff, lnFinalSize )
      RETURN Left( lcBuff, lnFinalSize )
    endif
    RETURN '' && error!!
  ENDFUNC

ENDDEFINE
*!*

Back to Microsoft: Visual FoxPro FAQ Index
Back to Microsoft: Visual FoxPro Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close