czdemofrm.frm

vb利用zlib 压缩源码,高人写了一个类

VERSION 5.00
Begin VB.Form frmZLibCompress 
   Caption         =   "Compress-Z-It Demo Form"
   ClientHeight    =   4200
   ClientLeft      =   4695
   ClientTop       =   2625
   ClientWidth     =   6780
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "czdemofrm.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   4200
   ScaleWidth      =   6780
   Begin VB.CommandButton cmdCompressString 
      Caption         =   "Compress String (CompressString example)"
      Height          =   435
      Left            =   2760
      TabIndex        =   6
      Top             =   2280
      Width           =   3915
   End
   Begin VB.CommandButton cmdCompressData 
      Caption         =   "Compress Byte array (CompressData example)"
      Height          =   435
      Left            =   2760
      TabIndex        =   5
      Top             =   1740
      Width           =   3915
   End
   Begin VB.CommandButton cmdCompressFile 
      Caption         =   "Compress File IO (CompressData example)"
      Height          =   435
      Left            =   2760
      TabIndex        =   4
      Top             =   1200
      Width           =   3915
   End
   Begin VB.FileListBox lstFiles 
      Height          =   1650
      Left            =   60
      TabIndex        =   1
      Top             =   2460
      Width           =   2535
   End
   Begin VB.DirListBox lstDirectory 
      Height          =   1665
      Left            =   60
      TabIndex        =   0
      Top             =   720
      Width           =   2535
   End
   Begin VB.Label Label2 
      Caption         =   $"czdemofrm.frx":030A
      Height          =   1035
      Left            =   2820
      TabIndex        =   3
      Top             =   60
      Width           =   3915
   End
   Begin VB.Label Label1 
      Caption         =   "Choose a file from the path and file lists. Press 'compress' to compress the file."
      Height          =   555
      Left            =   120
      TabIndex        =   2
      Top             =   60
      Width           =   2535
   End
End
Attribute VB_Name = "frmZLibCompress"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private m_cZLib As CompressZIt

Private Sub KillFileIfExists(ByVal sFile As String)
   On Error Resume Next
   Kill sFile
End Sub
Private Function NormalizePath(ByVal sPath As String) As String
   If Len(sPath) > 2 Then
      If Right$(sPath, 1) <> "\" Then
         sPath = sPath & "\"
      End If
   End If
   NormalizePath = sPath
End Function

Private Sub cmdCompressFile_Click()
Dim sFile As String
Dim sPath As String
Dim iFile As Integer
Dim lR As Long

   sFile = lstDirectory.Path
   ' Normalize
   If Right$(sFile, 1) <> "\" Then sFile = sFile & "\"

   sPath = sFile 'get path

   sFile = sFile & lstFiles.Filename 'add file name to path

'allocate byte array
Dim TheBytes() As Byte

   ReDim TheBytes(FileLen(sFile) - 1)

'read byte array from file
   iFile = FreeFile
   Open sFile For Binary Access Read As #iFile
   Get #iFile, , TheBytes()
   Close #iFile

   'compress byte array
   lR = m_cZLib.CompressData(TheBytes())

   Dim sAppPath As String ' file path

   sAppPath = NormalizePath(App.Path)
   KillFileIfExists sAppPath & "czdemo.co"
   KillFileIfExists sAppPath & "czdemo.dec"

   'Write it out to the .co file
   iFile = FreeFile
   Open sAppPath & "czdemo.co" For Binary Access Write As #iFile
   Put #iFile, , TheBytes()
   Close #iFile

   'decompress byte array
   lR = m_cZLib.DecompressData(TheBytes(), m_cZLib.OriginalSize)

   'Write it out to the .dec file
   iFile = FreeFile
   Open sAppPath & "czdemo.dec" For Binary Access Write As #iFile
   Put #iFile, , TheBytes()
   Close #iFile


Erase TheBytes

End Sub

Private Sub cmdCompressData_Click()

Dim TheBytes() As Byte
Dim lDataSize As Long
Dim lR As Long
Dim lCnt As Long
Dim l As Long
Dim TheChar As Byte

   lDataSize = 100
   lDataSize = lDataSize * 1024

   ReDim TheBytes(0 To lDataSize - 1) 'allocate precisely 100K

'Fill our bytes from random junk.
'we use 10 bytes of one char, 10 bytes of another,
'and so on.
   lCnt = 10
   For l = 0 To UBound(TheBytes)
      If lCnt = 10 Then
         TheChar = Int((255 - 0 + 1) * Rnd + 0)
         lCnt = 0
      End If
      TheBytes(l) = TheChar
   Next l

   MsgBox "Original size: " & CStr(UBound(TheBytes) + 1) & " bytes", vbInformation

   lR = m_cZLib.CompressData(TheBytes())

   MsgBox "Compressed size: " & CStr(UBound(TheBytes) + 1) & " bytes", vbInformation

   lR = m_cZLib.DecompressData(TheBytes(), m_cZLib.OriginalSize)

   MsgBox "Decompressed (or should I say original) size: " & CStr(UBound(TheBytes) + 1) & " bytes", vbInformation

   'cleanup

   Erase TheBytes

End Sub

Private Sub cmdCompressString_Click()
Dim sOurString As String
Dim lR As Long

   sOurString = "This is a string. It is just a normal ordinary string."

   MsgBox "Length = " & Len(sOurString) & vbCrLf & vbCrLf & sOurString, vbInformation

   lR = m_cZLib.CompressString(sOurString)

   MsgBox "Length = " & Len(sOurString) & vbCrLf & vbCrLf & "Compressed string (may not display all characters due to Nulls): " & vbCrLf & vbCrLf & sOurString, vbInformation

   lR = m_cZLib.DecompressString(sOurString, m_cZLib.OriginalSize)

   MsgBox "Here it is, again, decompressed: " & vbCrLf & vbCrLf & sOurString, vbInformation

   'Note, if res is not 0 then it would mean an error.

End Sub

Private Sub Form_Load()
   Set m_cZLib = New CompressZIt
End Sub

Private Sub lstDirectory_Change()
   lstFiles.Path = lstDirectory.Path
End Sub