Chip 2002 September/Chip_2002-09_cd1.bin/zkuste/vbasic/Data/Utils/XZipComp.exe/XceedCompression.Cab/F112854_MemoryCompress.frm

Visual Basic Form | 2001-05-10 | 16.4 KB | 397 lines

VERSION 5.00
Begin VB.Form frmMemoryCompress
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Memory compression"
   ClientHeight    =   5070
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5685
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5070
   ScaleWidth      =   5685
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdQuit
      Cancel          =   -1  'True
      Caption         =   "Quit"
      Height          =   315
      Left            =   4275
      TabIndex        =   5
      Top             =   4650
      Width           =   1365
   End
   Begin VB.ComboBox cboCompressionFormat
      Height          =   315
      Left            =   1875
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   2025
      Width           =   3690
   End
   Begin VB.TextBox txtDecompressedText
      Height          =   1215
      Left            =   225
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   4
      Top             =   3300
      Width           =   5415
   End
   Begin VB.CommandButton cmdDecompress
      Caption         =   "Decompress"
      Height          =   315
      Left            =   4275
      TabIndex        =   3
      Top             =   2550
      Width           =   1365
   End
   Begin VB.CommandButton cmdCompress
      Caption         =   "Compress"
      Height          =   315
      Left            =   225
      TabIndex        =   2
      Top             =   2550
      Width           =   1365
   End
   Begin VB.TextBox txtTextToCompress
      Height          =   1215
      Left            =   150
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Text            =   "MemoryCompress.frx":0000
      Top             =   300
      Width           =   5415
   End
   Begin VB.Label lbl
      Caption         =   "Compression format"
      Height          =   240
      Index           =   5
      Left            =   150
      TabIndex        =   12
      Top             =   2025
      Width           =   1590
   End
   Begin VB.Label lblOriginalSize
      Caption         =   "0"
      ForeColor       =   &H00C00000&
      Height          =   240
      Left            =   4875
      TabIndex        =   11
      Top             =   1575
      Width           =   690
   End
   Begin VB.Label lbl
      Caption         =   "Original size"
      Height          =   240
      Index           =   3
      Left            =   3675
      TabIndex        =   10
      Top             =   1575
      Width           =   1065
   End
   Begin VB.Label lbl
      Caption         =   "Decompressed text:"
      Height          =   240
      Index           =   2
      Left            =   225
      TabIndex        =   9
      Top             =   3075
      Width           =   2865
   End
   Begin VB.Label lblCompressedSize
      Caption         =   "0"
      ForeColor       =   &H00C00000&
      Height          =   240
      Left            =   3150
      TabIndex        =   8
      Top             =   2625
      Width           =   915
   End
   Begin VB.Label lbl
      Caption         =   "Compressed size"
      Height          =   240
      Index           =   1
      Left            =   1725
      TabIndex        =   7
      Top             =   2625
      Width           =   1290
   End
   Begin VB.Label lbl
      Caption         =   "Text to compress"
      Height          =   240
      Index           =   0
      Left            =   150
      TabIndex        =   6
      Top             =   75
      Width           =   2865
   End
Attribute VB_Name = "frmMemoryCompress"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' Xceed Streaming Compression Library - Memory Compress sample
' Copyright (c) 2001 Xceed Software Inc.
' [MemoryCompress.frm]
' This form module contains the main form's code. It demonstrates how to
' compress a chunk of memory data using different kinds of compression formats,
' and decompress a compressed memory data. It specifically uses:
'  - The Compress and Decompress method.
'  - The CompressionFormat property.
' This file is part of the Xceed Streaming Compression Library sample applications.
' The source code in this file is only intended as a supplement to Xceed
' Streaming Compression Library's documentation, and is provided "as is", without
' warranty of any kind, either expressed or implied.
Option Explicit
'The different encoding formats that will serve to populate the combo box
Private Enum enuCompressionFormat
    cfBZip2 = 0
    cfGZip = 1
    cfStandard = 2
    cfZip3 = 3
    cfZLib = 4
    'The next three items are not compression formats. They are compression methods.
    'See the comments in the PrepareCompressionFormat function
    cfBWT = 5   'BurrowsWheeler
    cfDeflate = 6
    cfStore = 7
End Enum
'Will contain the compressed byte array.
Dim m_vaCompressed As Variant
'====================================================================================
' EVENTS - triggered by the form and its controls
'====================================================================================
'------------------------------------------------------------------------------------
'Do the compression of the text
'------------------------------------------------------------------------------------
Private Sub cmdCompress_Click()
    Dim xCompressor As XceedStreamingCompression
    Dim I As Long
    Dim lTextLen As Long
    Dim cBytes() As Byte
    Dim sTextToCompress As String
    Dim lErrorNumber As Long
    'Create an instance of the Xceed Streaming Compression
    Set xCompressor = New XceedStreamingCompression
    With xCompressor
        'Create and prepare the compression format (GZip, ZLib, ...)
        If PrepareCompressionFormat(xCompressor) Then
            'Convert unicode text to an ascii string
            'Useful to reduce the output compressed string, but it could
            'be skipped
            sTextToCompress = txtTextToCompress.Text
            lTextLen = Len(sTextToCompress)
            ReDim cBytes(lTextLen - 1)
            For I = 1 To lTextLen
                cBytes(I - 1) = Asc(Mid(sTextToCompress, I, 1))
            Next

            On Error Resume Next
                'Compress the ascii string, specifying that (True parameter)
                'this is the end of data (there will be no more calls to Compress).
                m_vaCompressed = .Compress(cBytes, True)

                lErrorNumber = Err.Number
                If lErrorNumber <> 0 Then
                    MsgBox "Error during compress." & vbCrLf & Err.Description & " (" & Hex(Err.Number) & ")"
                End If
            On Error GoTo 0
        Else
            'An error occured, we don't know which one, we don't care as it was
            'already shown to the user. We set the error code to an arbitrary
            'value of 1.
            lErrorNumber = 1
        End If

        If lErrorNumber = 0 Then
            If IsEmpty(m_vaCompressed) Then
                'No output was produced
                lblCompressedSize.Caption = "0"
            Else
                'Display the compressed byte array size.
                lblCompressedSize.Caption = CStr(UBound(m_vaCompressed) + 1)
            End If
        End If
    End With
    'Deallocate the Compression object. The Compression object will free
    'the CompressionFormat object.
    Set xCompressor = Nothing
End Sub
'------------------------------------------------------------------------------------
'Do the decompression of the compressed byte array
'------------------------------------------------------------------------------------
Private Sub cmdDecompress_Click()
    Dim xCompressor As XceedStreamingCompression
    Dim I As Long
    Dim sDecompressedText As String
    Dim lErrorNumber As Long
    Dim vaDecompressed As Variant
    If IsEmpty(m_vaCompressed) Then
        'The user did not performed a compression first. Refuse to Decompress
        Exit Sub
    End If
    'Create an instance of the Xceed Streaming Compression
    Set xCompressor = New XceedStreamingCompression
    With xCompressor
        'Create and prepare the decompression format
        If PrepareCompressionFormat(xCompressor) Then
            On Error Resume Next
                'Decompress the compressed byte array, specifying that (True parameter)
                'this is the end of data (there will be no more calls to Decompress).
                vaDecompressed = .Decompress(m_vaCompressed, True)

                lErrorNumber = Err.Number
                If lErrorNumber <> 0 Then
                    MsgBox "Error during compress." & vbCrLf & Err.Description & " (" & Hex(Err.Number) & ")"
                End If
            On Error GoTo 0
        Else
            'An error occured, we don't know which one and we don't care for it was
            'already shown to the user. We set the error code to an arbitrary
            'value of 1.
            lErrorNumber = 1
        End If

        If lErrorNumber = 0 Then
            If Not IsEmpty(vaDecompressed) Then
                ' Convert byte array to text
                'Display the decompressed result in the text box.
                'We convert the ascii string returned by the Decompress
                'method to Unicode so that the decompressed text box
                'will contained something readable.
                'If we had not convert the text to compress string in the Compress
                'process (to reduce the output compressed string), we
                'would simply assign the vaDecompressed to the txtDecompressedText.
                sDecompressedText = Space(UBound(vaDecompressed) + 1)
                For I = 0 To UBound(vaDecompressed)
                    Mid(sDecompressedText, I + 1, 1) = Chr(vaDecompressed(I))
                Next
                txtDecompressedText.Text = sDecompressedText
            End If
        End If
    End With
    'Deallocate the Compression object. The compression object will free
    'the CompressionFormat object.
    Set xCompressor = Nothing
End Sub
'------------------------------------------------------------------------------------
'Quit the sample application
'------------------------------------------------------------------------------------
Private Sub cmdQuit_Click()
    End
End Sub
'------------------------------------------------------------------------------------
'Initialize the original size label and fill the combo box
'------------------------------------------------------------------------------------
Private Sub Form_Load()
    lblOriginalSize.Caption = CStr(Len(txtTextToCompress.Text))
    With cboCompressionFormat
        Call .AddItem("BZip2", cfBZip2)
        Call .AddItem("GZip", cfGZip)
        Call .AddItem("Standard", cfStandard)
        Call .AddItem("Zip3", cfZip3)
        Call .AddItem("ZLib", cfZLib)
        Call .AddItem("BurrowsWheeler", cfBWT)
        Call .AddItem("Deflate", cfDeflate)
        Call .AddItem("Store", cfStore)
        .ListIndex = cfBZip2
    End With
End Sub
'------------------------------------------------------------------------------------
'Update the original size label when the user modify the text to compress text box
'------------------------------------------------------------------------------------
Private Sub txtTextToCompress_Change()
    lblOriginalSize.Caption = CStr(Len(txtTextToCompress.Text))
End Sub
'====================================================================================
' FUNCTIONS
'====================================================================================
'------------------------------------------------------------------------------------
'Prepare the compression format according to the user selection
'Return True if all succeeded
'------------------------------------------------------------------------------------
Private Function PrepareCompressionFormat(ByRef xCompressor As XceedStreamingCompression) As Boolean
    'We use one variable for each encoding format to simplify the programming
    '(code completion). Only one of these will be used at a time (according to
    'the chosen encoding method in the combo box).
    'To see an example of how it could be done without all these declarations,
    'consult the Manager sample application.
    Dim xBZip2Format As XceedBZip2CompressionFormat
    Dim xGZipFormat As XceedGZipCompressionFormat
    Dim xStdFormat As XceedStandardCompressionFormat
    Dim xZip3Format As XceedZip3CompressionFormat
    Dim xZLibFormat As XceedZLibCompressionFormat
    Dim xBWTMethod As XceedBWTCompressionMethod
    Dim xDeflateMethod As XceedDeflateCompressionMethod
    Dim xStoreMethod As XceedStoreCompressionMethod
    Dim bPrepareOK As Boolean
    bPrepareOK = True
    On Error Resume Next
        Select Case cboCompressionFormat.ListIndex
            Case cfBZip2
                Set xBZip2Format = New XceedBZip2CompressionFormat
                'Here, we would set the properties if needed

                'Set the compression format of the compressor object
                'received as a parameter of this function.
                Set xCompressor.CompressionFormat = xBZip2Format

                'Free the temporary compression format. The previous assignation adding
                'a reference to the compression format object, this object will effectively
                'be freed by the xCompressor object when it will be freed.
                Set xBZip2Format = Nothing

            Case cfGZip
                Set xGZipFormat = New XceedGZipCompressionFormat
                Set xCompressor.CompressionFormat = xGZipFormat
                Set xGZipFormat = Nothing

            Case cfStandard
                Set xStdFormat = New XceedStandardCompressionFormat
                Set xCompressor.CompressionFormat = xStdFormat
                Set xStdFormat = Nothing

            Case cfZip3
                Set xZip3Format = New XceedZip3CompressionFormat
                Set xCompressor.CompressionFormat = xZip3Format
                Set xZip3Format = Nothing

            Case cfZLib
                Set xZLibFormat = New XceedZLibCompressionFormat
                Set xCompressor.CompressionFormat = xZLibFormat
                Set xZLibFormat = Nothing


            'The next three items are not compression formats. They are compression
            'methods that can be assigned to the CompressionFormat property of the
            'Xceed Streaming Compression object. In these cases, the resulting
            'compressed streams will have no formating (no header, footer, checksum, ...)
            Case cfBWT
                Set xBWTMethod = New XceedBWTCompressionMethod
                Set xCompressor.CompressionFormat = xBWTMethod
                Set xBWTMethod = Nothing

            Case cfDeflate
                Set xDeflateMethod = New XceedDeflateCompressionMethod
                Set xCompressor.CompressionFormat = xDeflateMethod
                Set xDeflateMethod = Nothing

            Case cfStore
                'Using Store as the Compression format will produce an output
                'compressed stream identical to the text to compress!
                Set xStoreMethod = New XceedStoreCompressionMethod
                Set xCompressor.CompressionFormat = xStoreMethod
                Set xStoreMethod = Nothing

        End Select

        If Err.Number <> 0 Then
            bPrepareOK = False
            Call MsgBox("Error during compression format initialization." & vbCrLf & Err.Description & " (" & Hex(Err.Number) & ")")
        End If
    On Error GoTo 0
    PrepareCompressionFormat = bPrepareOK
End Function