vb6 如何生成ZIP文件

Question

vb6 如何生成ZIP文件

Answer 1

源码，我没试，呵呵
http://down.cnzz.cn/info/23562.aspx

Answer 2

'一个vbzip函数Option Explicit
'****************************************************
'欢迎访问小聪明的主页VB版: http://coolzm.533.net
'****************************************************
'---------------------------------------------------
' Sample VB 5 code to drive zip32.dll
' Contributed to the Info-Zip project by Mike Le Voi
'
' Contact me at: [email protected]
'
' 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 :-)
'---------------------------------------------------'argv
Public Type ZIPnames
    s(0 To 99) As String
End Type'ZPOPT is used to set options in the zip32.dll
Private Type ZPOPT
    fSuffix As Long
    fEncrypt As Long
    fSystem As Long
    fVolume As Long
    fExtra As Long
    fNoDirEntries As Long
    fExcludeDate As Long
    fIncludeDate As Long
    fVerbose As Long
    fQuiet As Long
    fCRLF_LF As Long
    fLF_CRLF As Long
    fJunkDir As Long
    fRecurse As Long
    fGrow As Long
    fForce As Long
    fMove As Long
    fDeleteEntries As Long
    fUpdate As Long
    fFreshen As Long
    fJunkSFX As Long
    fLatestTime As Long
    fComment As Long
    fOffsets As Long
    fPrivilege As Long
    fEncryption As Long
    fRepair As Long
    flevel As Byte
    date As String ' 8 bytes long
    szRootDir As String ' up to 256 bytes long
End TypePrivate Type ZIPUSERFUNCTIONS
    DLLPrnt As Long
    DLLPASSWORD As Long
    DLLCOMMENT As Long
    DLLSERVICE As Long
End Type'Structure ZCL - not used by VB
'Private Type ZCL
'    argc As Long            'number of files
'    filename As String      'Name of the Zip file
'    fileArray As ZIPnames   'The array of filenames
'End Type' Call back "string" (sic)
Private Type CBChar
    ch(4096) As Byte
End Type'Local declares
Dim MYOPT As ZPOPT
' Dim MYZCL As ZCL
Dim MYUSER As ZIPUSERFUNCTIONS'This assumes zip32.dll is in your \windows\system directory!
Private Declare Function ZpInit Lib "zip32.dll" _
(ByRef Zipfun As ZIPUSERFUNCTIONS) As Long ' Set Zip CallbacksPrivate Declare Function ZpSetOptions Lib "zip32.dll" _
(ByRef Opts As ZPOPT) As Long ' Set Zip optionsPrivate Declare Function ZpGetOptions Lib "zip32.dll" _
() As ZPOPT ' used to check encryption flag onlyPrivate Declare Function ZpArchive Lib "zip32.dll" _
(ByVal argc As Long, ByVal funame As String, ByRef argv As ZIPnames) As Long ' Real zipping actionGlobal vbzipinf As String, crlf$' Puts a function pointer in a structure
Function FnPtr(ByVal lp As Long) As Long
    FnPtr = lp
End Function' Callback for zip32.dll
Function DLLPrnt(ByRef fname As CBChar, ByVal x As Long) As Long
    Dim s0$, xx As Long    ' always put this in callback routines!
    On Error Resume Next
    s0 = ""
    For xx = 0 To x
        If fname.ch(xx) = 0 Then xx = 99999 Else s0 = s0 + Chr(fname.ch(xx))
    Next xx
    ' vbzipinf = vbzipinf + s0
    Form1.Print s0;
    DoEvents
    DLLPrnt = 0
End Function' Callback for zip32.dll
Function DllPass(ByRef s1 As Byte, x As Long, _
    ByRef s2 As Byte, _
    ByRef s3 As Byte) As Long    ' always put this in callback routines!
    On Error Resume Next
    ' not supported - always return 1
    DllPass = 1
End Function' Callback for zip32.dll
Function DllComm(ByRef s1 As CBChar) As CBChar
    
    ' always put this in callback routines!
    On Error Resume Next
    ' not supported always return \0
    s1.ch(0) = vbNullString
    DllComm = s1
End Function'Main Subroutine
Function VBZip(argc As Integer, zipname As String, _
        mynames As ZIPnames, junk As Integer, _
        recurse As Integer, updat As Integer, _
        freshen As Integer, basename As String) As Long
    
    Dim hmem As Long, xx As Integer
    Dim retcode As Long
    
    On Error Resume Next ' nothing will go wrong :-)
    
    ' Set address of callback functions
    MYUSER.DLLPrnt = FnPtr(AddressOf DLLPrnt)
    MYUSER.DLLPASSWORD = FnPtr(AddressOf DllPass)
    MYUSER.DLLCOMMENT = FnPtr(AddressOf DllComm)
    MYUSER.DLLSERVICE = 0& ' not coded yet :-)
    retcode = ZpInit(MYUSER)
    
    ' Set zip options
    MYOPT.fSuffix = 0        ' include suffixes (not yet implemented)
    MYOPT.fEncrypt = 0       ' 1 if encryption wanted
    MYOPT.fSystem = 0        ' 1 to include system/hidden files
    MYOPT.fVolume = 0        ' 1 if storing volume label
    MYOPT.fExtra = 0         ' 1 if including extra attributes
    MYOPT.fNoDirEntries = 0  ' 1 if ignoring directory entries
    MYOPT.fExcludeDate = 0   ' 1 if excluding files earlier than a specified date
    MYOPT.fIncludeDate = 0   ' 1 if including files earlier than a specified date
    MYOPT.fVerbose = 0       ' 1 if full messages wanted
    MYOPT.fQuiet = 0         ' 1 if minimum messages wanted
    MYOPT.fCRLF_LF = 0       ' 1 if translate CR/LF to LF
    MYOPT.fLF_CRLF = 0       ' 1 if translate LF to CR/LF
    MYOPT.fJunkDir = junk    ' 1 if junking directory names
    MYOPT.fRecurse = recurse ' 1 if recursing into subdirectories
    MYOPT.fGrow = 0          ' 1 if allow appending to zip file
    MYOPT.fForce = 0         ' 1 if making entries using DOS names
    MYOPT.fMove = 0          ' 1 if deleting files added or updated
    MYOPT.fDeleteEntries = 0 ' 1 if files passed have to be deleted
    MYOPT.fUpdate = updat    ' 1 if updating zip file--overwrite only if newer
    MYOPT.fFreshen = freshen ' 1 if freshening zip file--overwrite only
    MYOPT.fJunkSFX = 0       ' 1 if junking sfx prefix
    MYOPT.fLatestTime = 0    ' 1 if setting zip file time to time of latest file in archive
    MYOPT.fComment = 0       ' 1 if putting comment in zip file
    MYOPT.fOffsets = 0       ' 1 if updating archive offsets for sfx Files
    MYOPT.fPrivilege = 0     ' 1 if not saving privelages
    MYOPT.fEncryption = 0    'Read only property!
    MYOPT.fRepair = 0        ' 1=> fix archive, 2=> try harder to fix
    MYOPT.flevel = 0         ' compression level - should be 0!!!
    MYOPT.date = vbNullString ' "12/31/79"? US Date?
    MYOPT.szRootDir = basename
    
    ' Set options
    retcode = ZpSetOptions(MYOPT)
    
    ' ZCL not needed in VB
    ' MYZCL.argc = 2
    ' MYZCL.filename = "c:\wiz\new.zip"
    ' MYZCL.fileArray = MYNAMES
    
    ' Go for it!
    retcode = ZpArchive(argc, zipname, mynames)
    
    VBZip = retcode
End Function

Answer 3

'Windows操作系统自带ZIP压缩器,就那么几行搞定:
'出处(原VB工程下载文件出自):  http://www.21code.com/codebase/code_278.htmlOption ExplicitPrivate Sub Command1_Click()
        Zip1.OutputFile = Text1.Text
        Zip1.InputFile = Text2.Text
        Zip1.Level = CInt(Text3.Text)
        Zip1.Mode = CInt(Text4.Text)
        If Check1.Value = vbChecked Then Zip1.Recurse = True
        If Check1.Value = vbUnchecked Then Zip1.Recurse = False
        If Check2.Value = vbChecked Then Zip1.Paths = True
        If Check2.Value = vbUnchecked Then Zip1.Paths = False
        If Check3.Value = vbChecked Then Zip1.SysAndHid = True
        If Check3.Value = vbUnchecked Then Zip1.SysAndHid = False
        Zip1.Filter = Text5.Text
        Zip1.Go
End SubPrivate Sub Command2_Click()
        Zip1.ShowAboutBox
End SubPrivate Sub Command3_Click()
        Unload Me
End Sub

Answer 4

能具体一点吗，分都给你
 Zip1.OutputFile = Text1.Text
        Zip1.InputFile = Text2.Text
        Zip1.Level = CInt(Text3.Text)
        Zip1.Mode = CInt(Text4.Text)

Answer 5

去下载,那是一个VB工程打包,下载下来之后直接用VB打开(源代码,你可以修改的).

Answer 6

  我用shell 已经可行，现在的问题是 压缩后 ZIP 文件中还有一个文件夹，我想压缩后ZIP 文件中直接就是文件，怎么加参数
Private   Sub   Command1_Click()   
  Dim   wzipexe   As   String   '   winzip   执行文件的位置   
  Dim   wsource   As   String   '   原始文件   (压缩前)   
  Dim   wtarget   As   String   '   目地文件   (压缩后)   
  Dim   wcmd   As   String   '   Shell   指令   
  Dim   retval   As   Double   '   Shell   指令传回值   
    
  '   Shell   指令   
  wzipexe   =   "C:\program   files\winzip\WINzip32"   '   winzip   执行文件的位置   
  wtarget   =   "d:\1.zip"   '   原始文件   (压缩前)   
  wsource   =   "d:\1.mbd"   '   目地文件   (压缩后)   
  wcmd   =   wzipexe   &   "   -a   "   &   wtarget   &   "   "   &   wsource   '   Shell   指令   
  retval   =   Shell(wcmd,   6)   '   Shell   指令传回值   
    
    
  '上面的一大串可写成   
  'retval   =   Shell("C:\program   files\winzip\WINzip32   -a   _   
  'd:\1.zip   d:\1.mdb",   6)   
  End   Sub