zip.frm

一个兼容pkzip的文件/内存压缩算法

VERSION 4.00
Begin VB.Form frmZIP 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Form1"
   ClientHeight    =   1710
   ClientLeft      =   2040
   ClientTop       =   2910
   ClientWidth     =   4830
   Height          =   2115
   Left            =   1980
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1710
   ScaleWidth      =   4830
   ShowInTaskbar   =   0   'False
   Top             =   2565
   Width           =   4950
   Begin VB.TextBox txtHidden 
      Height          =   375
      Left            =   1920
      TabIndex        =   3
      Text            =   "Text1"
      Top             =   1080
      Visible         =   0   'False
      Width           =   1095
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   375
      Left            =   240
      TabIndex        =   2
      Top             =   960
      Width           =   1455
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "OK"
      Default         =   -1  'True
      Height          =   375
      Left            =   3120
      TabIndex        =   1
      Top             =   960
      Width           =   1455
   End
   Begin VB.Label lblInfo 
      Caption         =   "Label1"
      Height          =   495
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Width           =   4215
   End
End
Attribute VB_Name = "frmZIP"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Dim iDoZIP As Integer


Sub DoZIP()
    Dim sFiles As String
    Dim I As Long
    
' Set the name of the archive
    I = addZIP_ArchiveName(frmWizard!txtArchive.Text)
    
' Create pipe-delimited list of files and call the appropriate function
    sFiles = ""
    For I = 0 To frmWizard!lstSelected.ListCount - 1
        sFiles = sFiles & frmWizard!lstSelected.List(I) & "|"
    Next I
    I = addZIP_Include(sFiles)
    
    If (frmWizard!optFull(0).Value) Then
        I = addZIP_SaveStructure(azSTRUCTURE_ABSOLUTE)
    Else
        I = addZIP_SaveStructure(azSTRUCTURE_NONE)
    End If
    
    If (frmWizard!optEncrypt(0).Value) Then
        I = addZIP_Encrypt(txtPassword.Text)
    Else
    End If
    
    If (frmWizard!optLevel(0).Value) Then
        I = addZIP_SetCompressionLevel(azCOMPRESSION_NONE)
    ElseIf (frmWizard!optLevel(1).Value) Then
        I = addZIP_SetCompressionLevel(azCOMPRESSION_MINIMUM)
    ElseIf (frmWizard!optLevel(2).Value) Then
        I = addZIP_SetCompressionLevel(azCOMPRESSION_NORMAL)
    Else
        I = addZIP_SetCompressionLevel(azCOMPRESSION_MAXIMUM)
    End If
    
    If (frmWizard!optSpan(0).Value) Then
        I = addZIP_Span(True)
    Else
        I = addZIP_Span(False)
    End If
    
    If (frmWizard!optLFN(0).Value) Then
        I = addZIP_UseLFN(1)
    Else
        I = addZIP_UseLFN(0)
    End If
    
    If (frmWizard!optComment(0).Value) Then
        I = addZIP_Comment(frmWizard!txtComment.Text)
    End If
    I = addZIP()
End Sub


Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdOK_Click()
    Me.Caption = "Compressing..."
    cmdOK.Visible = False
    cmdCancel.Move (Me.Width - cmdCancel.Width) / 2
    cmdCancel.Enabled = False
    DoZIP
    Me.Caption = "Finished"
    lblInfo.Caption = "Finished"
    cmdCancel.Caption = "OK"
    cmdCancel.Enabled = True
End Sub


Private Sub Form_Load()
    Dim I As Integer
    
    addZIP_Initialise
    I = addZIP_SetWindowHandle(CLng(txtHidden.Hwnd))
    Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
    Me.Caption = "Confirm"
    lblInfo.Caption = "You are about to start creating the archive. Press OK to proceed, Cancel to quit."
    iDoZIP = 1
End Sub


Private Sub txtHidden_Change()
    Dim sFile As String
        
    Select Case GetAction(txtHidden.Text)
        Case AM_SEARCHING
        Case AM_ZIPCOMMENT
        Case AM_ZIPPING
            sFile = "Compressing " & GetFileName(txtHidden.Text)
            sFile = sFile & " - " & Format$(GetPercentComplete(txtHidden.Text)) & "%"
            lblInfo.Caption = sFile
        Case AM_ZIPPED
        Case AM_UNZIPPING
        Case AM_UNZIPPED
        Case AM_TESTING
        Case AM_TESTED
        Case AM_DELETING
        Case AM_DELETED
        Case AM_DISKCHANGE
        Case AM_VIEW
        Case AM_ERROR
        Case AM_WARNING
        Case AM_QUERYOVERWRITE
        Case AM_COPYING
        Case AM_COPIED
        Case Else
            Debug.Print txtHidden.Text
    End Select
    DoEvents
End Sub