en esta liga explica como se usa la libreria zip.dll con una aplicacion vb
http://www.powerbasic.com/support/pbforums/showthread.php?t=24366
integro aqui el contenido por si en algun momento lo quitan
+ a main simple proc to test under PBWin (tested with ver 7.04)
+ an include file to get text description of ZIP errors
(using ASM routine inspired from examples. Special thanks to
Daniel Modler and Steve Hutchesson. Worth to visit Steve at www.movsd.com)
+ an include file for ZIP procs and Global variables
=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= Now, main application for testing:
=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= "EnZipErr.inc" 'function to return ZIP error description
=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= "PBw-Zip.inc" 'all procs and global variables
------------------
Marc Chauviere - France :-)
http://www.powerbasic.com/support/pbforums/showthread.php?t=24366
integro aqui el contenido por si en algun momento lo quitan
I hope you have some interest in this !
Some PBWin codes to use zip32.dll © Info-zip (www.info-zip.com)
TESTED WITH ZIP32.DLL version 2.30 (www.info-zip.com)
Some PBWin codes to use zip32.dll © Info-zip (www.info-zip.com)
TESTED WITH ZIP32.DLL version 2.30 (www.info-zip.com)
+ an include file to get text description of ZIP errors
(using ASM routine inspired from examples. Special thanks to
Daniel Modler and Steve Hutchesson. Worth to visit Steve at www.movsd.com)
+ an include file for ZIP procs and Global variables
=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= Now, main application for testing:
Code:
'.executable Win 2000/XP
'---------------------------------------------------------------------------------
#Option Version5
#Compile Exe
#Debug Error Off
#Tools Off
#Register None
#Dim All
'xxx #Resource "PBw-Zip.pbr" 'resource giving at least version info, so useful !
%NOGDI = 1 : %NOMETAFILE = 1 : %NOTEXTMETRIC = 1 : %NOMMIDS = 1 : %WSABASEERR = 1
%TVOUT_INC = 1 : %NOSCROLL = 1 : %NOVIRTUALKEYCODES = 1 : %NOWINOFFSETS = 1
#Include "WIN32API.INC"
#Include "EnZipErr.inc" 'function to return ZIP error description
#Include "PBw-Zip.inc" 'all procs and global variables
'=================================================================================
Function WinMain (ByVal hCurInst As Dword, ByVal hPrevInst As Dword, _
ByVal lpCmdLine As Asciiz Ptr, ByVal nCmdShow As Long) As Long
Local jRetn As Long
Local hLib As Dword, kdx As Long
hLib = LoadLibrary("ZIP32.DLL")
If hLib = 0 Then GoTo TraitApiError
'full path of destination zip file (current directory)
gzZipDestName = "TestZip.zip"
'test with 2 sources (in current directory)
gnbSrces = 2: ReDim tbFiles2Zip(gnbSrces - 1)
'fill asciiz array with two filenames
tbFiles2Zip(0) = "TestFile1.txt"
tbFiles2Zip(1) = "TestFile2.txt"
'pass these filenames as address in ZIPnames structure
For kdx = 0 To gnbSrces - 1
guSrceNames.zFiles(kdx) = VarPtr(tbFiles2Zip(kdx))
Next kdx
'you may need gzDate, gzRootDir, gzTempDir
gzRootDir = ""
gzTempDir = ""
gzDate = ""
gZOPTN.fJunkDir = 0
gZOPTN.fUpdate = 0
gZOPTN.fEncrypt = 0
gZOPTN.fComment = 0
gZOPTN.fLevel = 48 + 9 'compression max as ascii char value
gZOPTN.fLatestTime = 1
' gZOPTN.fQuiet = 0
' gZOPTN.fVerbose = 0
jRetn = PBwZip32() 'should be 0 if no error
Call FreeLibrary(hLib)
FinProcMain:
Function = 0
Exit Function
TraitApiError:
MsgApiErr GetLastError()
Function = 0
Exit Function
End Function
'=================================================================================
=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= "EnZipErr.inc" 'function to return ZIP error description
Code:
'-- this code is much inspired from the very nice examples and works ' given by PowerBasic users, especially Daniel Modler and Steve Hutchesson ' Thanks to them. Worth to visit Steve at www.movsd.com '-- ASM routine about 4 times faster than Select Case but more work to update ' (but would you change error descriptions often ?) '------------------------------------------------------------------------------- Declare Function GetZipErrTxt(ByVal bCode As Byte) As String '-- bCode must be Byte > 0 ' (it's not common to show to the user an alert msgbox with red color ' and app-fault horrible sound to say <operation successful> !) ' table with one byte for error code, one byte for length of description ' then description ($nul not needed as separator) - dim Asciiz * 40 '-- here is the original text file used to build this table ' 2, Unexpected End Of Zip File ' 3, Zip File Structure ' 4, Out of Memory ' 5, Internal Logic ' 6, Entry Too Large to Split ' 7, Invalid Comment Format ' 8, Zip Test Failed Or Out of Memory ' 9, User Interrupted Or Termination failed ' 10, Using a Temp File failed ' 11, Reading Or Seeking a File ' 12, Nothing To Do ' 13, Missing Or Empty Zip File ' 14, Writing to a File ' 15, Couldn't Open a File to Write ' 16, Bad Command Line Argument ' 18, Couldn't Open a File to Read ' 0, Unknown Zip error (#000) ' ' ASM code below needs the last description to have code = 0 and ' its description must end by 000) to write unknown error code '------------------------------------------------------------------------------- Function GetZipErrTxt(ByVal bCode As Byte) As String Register None ! jmp lsEndReferTable lsStartReferTable: ! db 2,26,85,110,101,120,112,101,99,116,101,100,32,69,110,100 ! db 32,79,102,32,90,105,112,32,70,105,108,101,3,18,90,105 ! db 112,32,70,105,108,101,32,83,116,114,117,99,116,117,114,101 ! db 4,13,79,117,116,32,111,102,32,77,101,109,111,114,121,5 ! db 14,73,110,116,101,114,110,97,108,32,76,111,103,105,99,6 ! db 24,69,110,116,114,121,32,84,111,111,32,76,97,114,103,101 ! db 32,116,111,32,83,112,108,105,116,7,22,73,110,118,97,108 ! db 105,100,32,67,111,109,109,101,110,116,32,70,111,114,109,97 ! db 116,8,32,90,105,112,32,84,101,115,116,32,70,97,105,108 ! db 101,100,32,79,114,32,79,117,116,32,111,102,32,77,101,109 ! db 111,114,121,9,38,85,115,101,114,32,73,110,116,101,114,114 ! db 117,112,116,101,100,32,79,114,32,84,101,114,109,105,110,97 ! db 116,105,111,110,32,102,97,105,108,101,100,10,24,85,115,105 ! db 110,103,32,97,32,84,101,109,112,32,70,105,108,101,32,102 ! db 97,105,108,101,100,11,25,82,101,97,100,105,110,103,32,79 ! db 114,32,83,101,101,107,105,110,103,32,97,32,70,105,108,101 ! db 12,13,78,111,116,104,105,110,103,32,84,111,32,68,111,13 ! db 25,77,105,115,115,105,110,103,32,79,114,32,69,109,112,116 ! db 121,32,90,105,112,32,70,105,108,101,14,17,87,114,105,116 ! db 105,110,103,32,116,111,32,97,32,70,105,108,101,15,29,67 ! db 111,117,108,100,110,39,116,32,79,112,101,110,32,97,32,70 ! db 105,108,101,32,116,111,32,87,114,105,116,101,16,25,66,97 ! db 100,32,67,111,109,109,97,110,100,32,76,105,110,101,32,65 ! db 114,103,117,109,101,110,116,18,28,67,111,117,108,100,110,39 ! db 116,32,79,112,101,110,32,97,32,70,105,108,101,32,116,111 ! db 32,82,101,97,100,0,24,85,110,107,110,111,119,110,32,90 ! db 105,112,32,101,114,114,111,114,32,40,35,48,48,48,41 lsEndReferTable: Local lpTble As Dword, txtPtr As Dword Local zErrText As Asciiz * 40 If bCode = 0 Then Exit Function '-- error 0 generally means no error txtPtr = VarPtr(zErrText) lpTble = CodePtr(lsStartReferTable) ! cld ; esi and edi go forward after lods, stos, movs... ! xor eax, eax ! xor ebx, ebx ! xor ecx, ecx ; receive length of description ! mov esi, lpTble ; esi pointeur to description table ! mov edi, txtPtr ; edi pointeur to asciiz receiving description ! mov bl, bCode ; error code in bl lsTestCode: ! lodsb ; table code in al ! mov cl, [esi] ; length of description in ecx ! inc esi ; esi pointing to first char of description ! cmp al, 0 ; zero = special table code for unknown error ! jz lsUnknown ! cmp al, bl ! je lsCopyText ; error code found ! add esi, ecx ; add length to esi, now esi pointing to next code ! jmp lsTestCode lsUnknown: ! rep movsb ; repeat write [esi] to [edi] for ecx = length ! mov [edi], cl ; $nul at end of text, edi still pointing to $nul ! dec edi ! dec edi ; edi pointeur to space or zero before char ) ! mov al, bl ; error code in al ! mov cx, 10 ; divisor will be 10 lsDividing: ! xor dx, dx ; clean remainder ! div cx ; divide DX:AX by CX, quotient in AX, remainder in DX ! add dl, 48 ; remainder digit 0 to 9 transformed in char ! mov [edi], dl ; write char then edi go backward ! dec edi ! cmp ax, 0 ! jnz lsDividing ; quotient <> 0, continue ! jmp lsEndOper ; finished >>>>> lsCopyText: ! rep movsb ; repeat write [esi] to [edi] for ecx = length ! mov [edi], cl ; after rep, ecx = 0, write $nul at end of text lsEndOper: Function = zErrText End Function '-------------------------------------------------------------------------------
=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+= "PBw-Zip.inc" 'all procs and global variables
Code:
' TESTED WITH ZIP32.DLL version 2.30 (www.info-zip.com) '----------------------------------------------------------------- '-- Please Do Not Remove These Comments!!! '----------------------------------------------------------------- '-- Sample VB 5 code to drive zip32.dll '-- Contributed to the Info-ZIP project by Mike Le Voi '-- Contact me at: mlevoi@modemss.brisnet.org.au '-- Visit my home page at: http://modemss.brisnet.org.au/~mlevoi '-- Use this code at your own risk. Nothing implied or warranted '-- to work on your machine :-) '----------------------------------------------------------------- '-- The Source Code Is Freely Available From Info-ZIP At: '-- http://www.cdrom.com/pub/infozip/infozip.html '-- A Very Special Thanks To Mr. Mike Le Voi '-- And Mr. Mike White Of The Info-ZIP '-- For Letting Me Use And Modify His Orginal '-- Visual Basic 5.0 Code! Thank You Mike Le Voi. '----------------------------------------------------------------- '-- Contributed To The Info-ZIP Project By Raymond L. King '-- Modified June 21, 1998 '-- By Raymond L. King '-- Custom Software Designers '-- Contact Me At: king@ntplx.net '-- ICQ 434355 '-- Or Visit Our Home Page At: http://www.ntplx.net/~king '----------------------------------------------------------------- '-- Modified Oct 13, 2004 by Marc Chauviere to use with '-- compilator PBWin © PowerBasic (www.powerbasic.com) '-- taking benefit of Asciiz string, the original format '-- used in Zip32.dll, written in C '----------------------------------------------------------------- '--------------------------------------------------------------------------------- Type ZIPnames zFiles(0 To 99) As Dword '(Asciiz Ptr) (up To 255 Bytes Long) End Type '-- ZPOPT Is Used To Set The Options In The ZIP32.DLL Type ZPOPT szDate As Dword '(Asciiz Ptr) US Date (8 Bytes Long) "mmddyyyy" or "yyyy-mm-dd" szRootDir As Dword '(Asciiz Ptr) Root Directory Pathname (Up To 255 Bytes Long) szTempDir As Dword '(Asciiz Ptr) Temp Directory Pathname (Up To 255 Bytes Long) fTemp As Long ' 1 If Temp dir Wanted, Else 0 fSuffix As Long ' Include Suffixes (Not Yet Implemented!) fEncrypt As Long ' 1 If Encryption Wanted, Else 0 fSystem As Long ' 1 To Include System/Hidden Files, Else 0 fVolume As Long ' 1 If Storing Volume Label, Else 0 fExtra As Long ' 1 If Excluding Extra Attributes, Else 0 fNoDirEntries As Long ' 1 If Ignoring Directory Entries, Else 0 fExcludeDate As Long ' 1 If Excluding Files Earlier Than Specified Date, Else 0 fIncludeDate As Long ' 1 If Including Files Earlier Than Specified Date, Else 0 fVerbose As Long ' 1 If Full Messages Wanted, Else 0 fQuiet As Long ' 1 If Minimum Messages Wanted, Else 0 fCRLF_LF As Long ' 1 If Translate CR/LF To LF, Else 0 fLF_CRLF As Long ' 1 If Translate LF To CR/LF, Else 0 fJunkDir As Long ' 1 If Junking Directory Names, Else 0 fGrow As Long ' 1 If Allow Appending To Zip File, Else 0 fForce As Long ' 1 If Making Entries Using DOS File Names, Else 0 fMove As Long ' 1 If Deleting Files Added Or Updated, Else 0 fDeleteEntries As Long ' 1 If Files Passed Have To Be Deleted, Else 0 fUpdate As Long ' 1 If Updating Zip File-Overwrite Only If Newer, Else 0 fFreshen As Long ' 1 If Freshing Zip File-Overwrite Only, Else 0 fJunkSFX As Long ' 1 If Junking SFX Prefix, Else 0 fLatestTime As Long ' 1 If Setting Zip File Time To Time Of Latest File In Archive, Else 0 fComment As Long ' 1 If Putting Comment In Zip File, Else 0 fOffsets As Long ' 1 If Updating Archive Offsets For SFX Files, Else 0 fPrivilege As Long ' 1 If Not Saving Privileges, Else 0 fEncryption As Long ' Read Only Property!!! fRecurse As Long ' 1 (-r), 2 (-R) If Recursing Into Sub-Directories, Else 0 fRepair As Long ' 1 = Fix Archive, 2 = Try Harder To Fix, Else 0 fLevel As Byte ' Compression Level - 0 = Stored 6 = Default 9 = Max (ascii char value) End Type '-- This Structure Is Used For The ZIP32.DLL Function Callbacks Type ZIPUSERFUNCTIONS ZDLLPRINT As Dword ' Callback ZIP32.DLL Print Function ZDLLCOMMENT As Dword ' Callback ZIP32.DLL Comment Function ZDLLPASSWORD As Dword ' Callback ZIP32.DLL Password Function ZDLLSERVICE As Dword ' Callback ZIP32.DLL Service Function End Type '--------------------------------------------------------------------------------- '-- This Assumes ZIP32.DLL Is In Your \Windows\System Directory! '-- (alternatively, a copy of ZIP32.DLL needs to be located in the program '-- directory or in some other directory listed in the PATH.) '-- Set Zip Callbacks Declare Function ZpInit Lib "zip32.dll" Alias "ZpInit" (ByRef Zipfun As ZIPUSERFUNCTIONS) As Long '-- Set Zip Options Declare Function ZpSetOptions Lib "zip32.dll" Alias "ZpSetOptions" (ByRef Opts As ZPOPT) As Long '-- Used To Check Encryption Flag Only Declare Function ZpGetOptions Lib "zip32.dll" Alias "ZpGetOptions" () As Dword 'Ptr to gZOPTN '-- Real Zipping Action Declare Function ZpArchive Lib "zip32.dll" Alias "ZpArchive" (ByVal argc As Long, _ ByVal fuName As String, ByRef argv As ZIPnames) As Long '-- Local procs Declare Function PBwZip32() As Long Declare Sub MakeWinStr(sTexte As String) Declare Sub MsgApiErr(ByVal lastErr As Long) '--------------------------------------------------------------------------------- '-- Global Variables For Setting The ZPOPT Structure... '-- You Must Set The Options That You Want ZIP32.DLL To Do Before Calling PBwZip32 '-- As gZOPTN is global, you just fix them by gZOPTN.option = ? in a main proc '--------------------------------------------------------------------------------- Global gzDate As Asciiz * 16 Global gzRootDir As Asciiz * 256 Global gzTempDir As Asciiz * 256 Global tbFiles2Zip() As Asciiz * 256 Global gsReport As String '-- Global Program Variables Global gZOPTN As ZPOPT Global gZUSER As ZIPUSERFUNCTIONS Global gnbSrces As Long ' Number Of Files To Zip Up Global gzZipDestName As Asciiz * 256 ' The Zip File Name ie: Myzip.zip Global guSrceNames As ZIPnames ' File Names To Zip Up '-- Global Constants -- For Zip Error Codes! '-- uncomment these lines to make some decision after the Zip operation failed '-- error description is obtained by function GetZipErrTxt (see EnZipErr.inc) ' %ZE_OK = 0 ' Success (No Error) ' %ZE_EOF = 2 ' Unexpected End Of Zip File Error ' %ZE_FORM = 3 ' Zip File Structure Error ' %ZE_MEM = 4 ' Out Of Memory Error ' %ZE_LOGIC = 5 ' Internal Logic Error ' %ZE_BIG = 6 ' Entry Too Large To Split Error ' %ZE_NOTE = 7 ' Invalid Comment Format Error ' %ZE_TEST = 8 ' Zip Test (-T) Failed Or Out Of Memory Error ' %ZE_ABORT = 9 ' User Interrupted Or Termination Error ' %ZE_TEMP = 10 ' Error Using A Temp File ' %ZE_READ = 11 ' Read Or Seek Error ' %ZE_NONE = 12 ' Nothing To Do Error ' %ZE_NAME = 13 ' Missing Or Empty Zip File Error ' %ZE_WRITE = 14 ' Error Writing To A File ' %ZE_CREAT = 15 ' Could't Open To Write Error ' %ZE_PARMS = 16 ' Bad Command Line Argument Error ' %ZE_OPEN = 18 ' Could Not Open A Specified File To Read Error '-- litteral text as constant (easy for changing to other language) $ApiErrPrefx = "WinAPI error: " $ApiErrTitle = "Sorry - Programm may abort !" $ApiErrUnkwn = $CrLf & "unknown description" $ZipRetPrefx = "ZIP failed: " $ZipRetTitle = "End zipping (free code by M.Chauviere)" $ZipRetFinOp = "(zip32 ©Info-Zip <A HREF="http://www.info-zip.org)"" TARGET=_blank>www.info-zip.org)"</A> & $CrLf & "Done:" & $CrLf '================================================================================= 'to make string from programm written for Unix to look like Windows style 'sorry about zip I\O error ! Sub MakeWinStr(sTexte As String) Replace Any "/" & $Tab With "\ " In sTexte Replace $Lf With $CrLf In sTexte End Sub 'to show API Error description in default language Sub MsgApiErr(ByVal lastErr As Long) Local zApiErr As Asciiz * 380 Call FormatMessage (%FORMAT_MESSAGE_FROM_SYSTEM, ByVal %Null, lastErr, %Null,_ zApiErr, 380&, ByVal %Null) If Len(zApiErr) = 0 Then zApiErr = Format$(lastErr, "(\#0)") & $ApiErrUnkwn MsgBox $ApiErrPrefx & zApiErr, %MB_ICONEXCLAMATION, $ApiErrTitle End Sub '--------------------------------------------------------------------------------- '-- These Functions Are For The ZIP32.DLL >>>>> '-- Callback For ZIP32.DLL - DLL Print Function Function ZBCKPrint(ByRef fname As Asciiz, ByVal nbx As Long) As Long Local sPrint As String '-- Always Put This In Callback Routines! On Error Resume Next '-- Get Zip32.DLL Message For processing '-- some Error and 'deflated' info come here '-- you can change to process each message, send to a progress info in unmodal dialog '-- or check for words 'zip error:' to decide If nbx > 0 Then sPrint = Left$(fname, nbx) MakeWinStr sPrint 'don't know why adding starts with two spaces when updating or freshening don't have ! If Left$(sPrint, 9) = " adding:" Then sPrint = Mid$(sPrint,3) '-- here, messages are just added to a global report string ' ' deflated' added to the same line as its filename in report If Not Left$(sPrint, 1) = " " Then If Right$(gsReport, 1) = $Lf Then 'report already starting new line If Left$(sPrint, 1) = $Cr Then 'avoid blank line in report sPrint = Mid$(sPrint, 3) End If End If End If End If gsReport = gsReport & sPrint Function = 0 End Function '--------------------------------------------------------------------------------- '-- Callback For ZIP32.DLL - DLL Service Function Function ZBCKSercice(ByRef mname As Asciiz, ByVal nbx As Long) As Long '! Local sServi As String '-- Always Put This In Callback Routines! On Error Resume Next '-- Get Zip32.DLL Message For processing '-- End Of compression comes here for each files (no need if 'deflated' is reported '-- by Print CallBack when fQuiet option is 0. With fQuit=1, you should report this ' If nbx > 0 Then ' sServi = Left$(mname, nbx) ' MakeWinStr sServi ' gsReport = gsReport & sServi ' End If Function = 0 ' Setting this to 1 will abort the zip! End Function '--------------------------------------------------------------------------------- '-- Callback For ZIP32.DLL - DLL Password Function Function ZBCKPassW(ByRef apassw As Asciiz, ByVal nbx As Long, _ ByRef mssg As Asciiz, ByRef aname As Asciiz) As Integer Local sPrompt As String Local sTitle As String Local sPasswrd As String '-- Always Put This In Callback Routines! On Error Resume Next Function = 1 '-- If There Is A Password Have The User Enter It! This Can Be Changed If Len(mssg) > 0 Then sPrompt = Left$(mssg, InStr(1, mssg, $Nul) -1) Else sPrompt = "Enter Password:" End If If Len(aname) > 0 Then sTitle = Left$(aname, InStr(1, aname, $Nul) -1) Else sTitle = "ZIP Password" End If sPasswrd = InputBox$(sPrompt, sTitle, "") '-- The User Did Not Enter A Password So Exit The Function If Len(sPasswrd) = 0 Then Exit Function '-- User Entered A Password So Proccess It apassw = Left$(sPasswrd, 80) & $Nul Function = 0 End Function '--------------------------------------------------------------------------------- '-- Callback For ZIP32.DLL - DLL Comment Function Function ZBCKComment(ByRef zComnt As Asciiz) As Integer Local sComment As String '-- Always Put This In Callback Routines! On Error Resume Next Function = 1 sComment = InputBox$("Enter comment:", "ZIP Comment", "") If Len(sComment) = 0 Then Exit Function zComnt = Left$(sComment, 4094) & $Nul Function = 0 End Function '--------------------------------------------------------------------------------- '-- Main ZIP32.DLL Subroutine Where It All Happens!!! Function PBwZip32() As Long Local retcode As Long On Error Resume Next '-- Nothing Will Go Wrong :-) '-- Set Address Of ZIP32.DLL Callback Functions - Do Not Change!!! gZUSER.ZDLLPRINT = CodePtr(ZBCKPrint) gZUSER.ZDLLPASSWORD = CodePtr(ZBCKPassW) gZUSER.ZDLLCOMMENT = CodePtr(ZBCKComment) gZUSER.ZDLLSERVICE = CodePtr(ZBCKSercice) '-- Set ZIP32.DLL Callbacks !!! retcode = ZpInit(gZUSER) '-- Setup ZIP32 Options (WARNING!) Do Not Change! gZOPTN.szDate = VarPtr(gzDate) ' US Date gZOPTN.szRootDir = VarPtr(gzRootDir) ' Root Directory Pathname gZOPTN.szTempDir = VarPtr(gzTempDir) ' Temp Directory Pathname '... all other options should be fixed in main proc as gZOPTN is global '-- Set ZIP32.DLL Options !!! seems to return 1, errors come by ZipPrint retcode = ZpSetOptions(gZOPTN) '-- Go Zip It Them Up! and return it to function retcode = ZpArchive(gnbSrces, gzZipDestName, guSrceNames) If retcode > 0 Then MsgBox $ZipRetFinOp & gsReport & $CrLf & $ZipRetPrefx & GetZipErrTxt(retcode), _ %MB_ICONEXCLAMATION, $ZipRetTitle Else MsgBox $ZipRetFinOp & gsReport, %MB_ICONASTERISK, $ZipRetTitle End If PBwZip32 = retcode End Function '---------------------------------------------------------------------------------
------------------
Marc Chauviere - France :-)
Comentarios
Publicar un comentario