Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
How to zip files in VFP?
Message
From
21/01/2003 05:36:09
 
 
To
21/01/2003 03:04:32
General information
Forum:
Visual FoxPro
Category:
Other
Miscellaneous
Thread ID:
00743669
Message ID:
00743690
Views:
206
Luong Let try this code I post below


* First, Get zLib from http://www.gzip.org/zlib/ (more specifically, the
*(Win32 zLib.DLL at http://www.winimage.com/zLibDll/zlib114dll.zip ) and
* place it into your app's directory.

* Now, create zLib.prg:

*******************************************************
* zLib.prg
* Purpose: Easy to use Compress/Uncompress utilities
* for VFP
*******************************************************
PROCEDURE zLib
PARAMETER cFunc, cStr
DO CASE
CASE upper(cFunc)='COMPRESS'
RETURN CompressIt(cStr)
CASE upper(cFunc)='UNCOMPRESS'
RETURN UnCompressIt(cStr)
ENDCASE
RETURN ''
* Functions:
*!* int compress (Bytef *dest, uLongf *destLen, const Bytef *source, uLong sourceLen);
*!* int uncompress (Bytef *dest, uLongf *destLen, const Bytef *source, uLong sourceLen);

Function CompressIt( 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
lcBuff = space( len(InFile)*1.2 )
lnFinalSize = len(lcBuff)
Res = zlibCompress( @lcBuff, @lnFinalSize, InFile, lnSize )
If Res=0 && Success
RETURN PadL( alltrim(str(lnSize)), 15, '0' ) + Left( lcBuff, lnFinalSize )
endif
RETURN ''

****************************************************************************
* Proc UnCompressIt
* The first 15 chars MUST be the (decimal) size of the uncompressed file
FUNCTION UnCompressIt( zLibFile )
DECLARE INTEGER uncompress IN zlib.dll AS zlibUnCompress ;
STRING @ dest, INTEGER @ destLen, ;
STRING src, INTEGER srcLen
* Decompresses 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 large enough to hold the entire uncompressed data.
* (The size of the uncompressed data must have been saved previously
* by the compressor and transmitted to the decompressor by some mechanism
* outside the scope of this compression library.)
* Upon exit, destLen is the actual size of the compressed buffer.
* This function can be used to decompress a whole file at once if the input file is mmap'ed.
*
LOCAL lnSize, lcBuff, lnFinalSize
lnSize = len(zLibFile)
*123,456,789,012,345 15 chars is enough for 100 Terabytes.
*100,000,000,000,000
lnFinalSize = Val( Left( zLibFile, 15 ) )
lcBuff = space( lnFinalSize )
zLibFile = SubStr( zLibFile, 16 )
Res = zlibUnCompress( @lcBuff, @lnFinalSize, zLibFile, lnSize )
If Res=0 && Success
RETURN lcBuff
endif
RETURN ''
********************************************************


Now, you can use it in either of these manners:


SET PROCEDURE TO zLib ADDITIVE
x = CompressIt( FileToStr("testfile.txt") )
y = UnCompressIt( x )
StrToFile( y, "testfile.txt.out" )
RELEASE PROCEDURE zLib

** OR **

x = zLib("CompressIt", FileToStr("testfile.txt") )
y = zLib("UnCompressIt", x )
StrToFile( y, "testfile.txt.out" )


There's room for even more improvement...

Want to do multiple files?
Just create a table with two fields: "FileName" and "FileData" to keep track of a bunch of compressed files.
For example:

SET PROC TO (srcDrv+"\source\las\zLib") ADDITIVE

CREATE TABLE plg_Inst.dbf ;
( FileName C(30), ;
FileData M, ;
Register L, ;
Compressed L, ;
OrigSize N(15) )
Select Plg_Inst
fCnt = aDir( fArr, "*.HTM" )
if fCnt > 0
for fNum = 1 to fCnt
append blank
REPLACE FileName with fArr[fNum,1], ;
FileData with CompressIt( FileToStr(fArr[fNum,1]) ), ;
Compressed with .T.
endfor
endif


Then when you want to extract them:


if file('PLG_INST.DBF') and file('PLG_INST.FPT')
* Copy DBF/FPT out because VFP has "issues" with
* accessing "included" FPT files.
aa=FileToStr('PLG_INST.DBF')
bb=FileToStr('PLG_INST.FPT')
StrToFile(aa,'tmp_Inst.dbf')
StrToFile(bb,'tmp_Inst.fpt')
SELECT 0
USE TMP_INST.DBF ALIAS plg_Inst
* Dump out all internal files!
SCAN
If not empty(Plg_inst.FileName) ;
and not empty(Plg_inst.FileData)
if Plg_Inst.Compressed
lcCompFile = Plg_Inst.FileData
lcUnCompFile = zLib("UnCompressIt", lcCompFile )
if not empty(lcUnCompFile)
=StrToFile( lcUnCompFile, alltrim(Plg_Inst.FileName) )
else
=MessageBox( 'Could not uncompress file "'+Plg_Inst.FileName+'".', mbxOk)
endif
else
=StrToFile( Plg_Inst.FileData, alltrim(Plg_Inst.FileName) )
endif
endif
ENDSCAN
USE
IF FILE('TMP_INST.DBF')
DELETE FILE TMP_INST.DBF
ENDIF
IF FILE('TMP_INST.FPT')
DELETE FILE TMP_INST.FPT
ENDIF
else
=MessageBox('Error Installing additional files!',mbxOk,'')
endif
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform