testaim.frm

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

VERSION 2.00
Begin Form frmTest 
   BackColor       =   &H00800000&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Test AIM"
   ClientHeight    =   5580
   ClientLeft      =   1065
   ClientTop       =   1485
   ClientWidth     =   6615
   Height          =   5985
   Left            =   1005
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   5580
   ScaleWidth      =   6615
   Top             =   1140
   Width           =   6735
   Begin TextBox txtDecompressed 
      Enabled         =   0   'False
      Height          =   1095
      Left            =   240
      MultiLine       =   -1  'True
      TabIndex        =   2
      Text            =   "Text1"
      Top             =   4200
      Width           =   6135
   End
   Begin TextBox txtCompressed 
      Enabled         =   0   'False
      Height          =   1095
      Left            =   240
      MultiLine       =   -1  'True
      TabIndex        =   6
      Text            =   "Text1"
      Top             =   2280
      Width           =   6135
   End
   Begin CommandButton cmdDecompress 
      Enabled         =   0   'False
      Height          =   375
      Left            =   240
      TabIndex        =   5
      Top             =   3480
      Width           =   6135
   End
   Begin CommandButton cmdCompress 
      Height          =   375
      Left            =   240
      TabIndex        =   1
      Top             =   1560
      Width           =   6135
   End
   Begin TextBox txtOriginal 
      Height          =   1095
      Left            =   240
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Top             =   360
      Width           =   6135
   End
   Begin Label Label4 
      BackStyle       =   0  'Transparent
      Caption         =   "Decompressed buffer:"
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Left            =   240
      TabIndex        =   7
      Top             =   3960
      Width           =   6135
   End
   Begin Label Label2 
      BackStyle       =   0  'Transparent
      Caption         =   "Compressed buffer:"
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Left            =   240
      TabIndex        =   4
      Top             =   2040
      Width           =   6135
   End
   Begin Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "Original buffer:"
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Left            =   240
      TabIndex        =   3
      Top             =   120
      Width           =   4215
   End
End
' testaim.frm
'
' Visual Basic v3 testbed for aim16.dll

Option Explicit

' save the size of the original string (so we can
' allocate the correct sized buffer)
Dim g_lOriginalSize As Long
' save the compressed string
Dim g_cCompressed As String
' save the compressed size
Dim g_cCompressedSize As Long

Sub cmdCompress_Click ()
    Dim cOriginal As String ' original string
    Dim cBuffer As String ' buffer for compressed string
    Dim lOriginal As Long ' length of the original string
    Dim lBuffer As Long ' length of the compression buffer
    Dim lCompressedSize ' length of the compressed string (or an error)

    ' set length of original string
    lOriginal = Len(txtOriginal.Text)
    ' get the original string
    cOriginal = txtOriginal.Text
    label1.Caption = "Original buffer: " & Format$(lOriginal) & " characters"
    'set length of compressed buffer (which should be larger
    ' than the original buffer by 1% + 12 bytes)
    lBuffer = 12 + (lOriginal * 101) / 100
    ' allocate empty compression buffer
    cBuffer = Space(lBuffer)
    ' call compression function
    lCompressedSize = addZIP_InMemory(cOriginal, lOriginal, cBuffer, lBuffer)
    If (lCompressedSize < 0) Then ' an error has occured
        txtCompressed.Text = "COMPRESSION FAILED!! Error code " & Format$(lCompressedSize)
        Exit Sub
    End If
    ' if we get to here then no error has occurred
    '
    ' save the original size for later decompression
    g_lOriginalSize = lOriginal
    g_cCompressed = Left$(cBuffer, lCompressedSize)
    g_cCompressedSize = lCompressedSize
    ' enable the decompression button
    cmdDecompress.Enabled = True
    ' display the compressed string
    txtCompressed.Text = Left$(cBuffer, lCompressedSize)
    ' display the size of the compressed string
    label2.Caption = "Compressed buffer: " & Format$(lCompressedSize) & " characters"
End Sub

Sub cmdDecompress_Click ()
    Dim cOriginal As String ' original string
    Dim cBuffer As String ' buffer for compressed string
    Dim lOriginal As Long ' length of the original string
    Dim lBuffer As Long ' length of the compression buffer
    Dim lCompressedSize ' length of the compressed string (or an error)
    
    ' set length of original string (with extra space
    ' which shouldnt be required)
    lOriginal = g_lOriginalSize + 10
    ' allocate the empty string for the original
    cOriginal = Space$(lOriginal)
    ' set length of the compressed string from global
    lBuffer = g_cCompressedSize
    ' set compressed string from global
    cBuffer = g_cCompressed
    ' call decompression function
    lOriginal = addUNZIP_InMemory(cOriginal, lOriginal, cBuffer, lBuffer)
    ' check for errors
    If (lOriginal < 0) Then ' an error has occured
        txtDecompressed.Text = "DECOMPRESSION FAILED!! Error code " & Format$(lCompressedSize)
        Exit Sub
    End If
    ' if we get to here, no error occurred
    '
    ' display decompressed string
    txtDecompressed.Text = Left$(cOriginal, lOriginal)
    label4.Caption = "Decompressed buffer: " & Format$(lOriginal) & " characters"
End Sub

Sub Form_Load ()
    txtOriginal.Text = "Type some text here and press the button below to compress it. "
    txtOriginal.Text = txtOriginal.Text & Chr$(13) & Chr$(10) & txtOriginal.Text
    txtOriginal.Text = txtOriginal.Text & Chr$(13) & Chr$(10) & txtOriginal.Text
    cmdCompress.Caption = "Press me to compress"
    txtCompressed.Text = "The compressed string will be placed here"
    cmdDecompress.Caption = "Press me to decompress"
    ' centre me on the screen
    Move screen.Width / 2 - Me.Width / 2, screen.Height / 2 - Me.Height / 2
End Sub