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

Visual Basic Form | 2001-05-11 | 23.5 KB | 537 lines

VERSION 5.00
Begin VB.Form frmMemoryEncode
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Memory Encoding"
   ClientHeight    =   4530
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   10080
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4530
   ScaleWidth      =   10080
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox txtMaxLineLength
      Height          =   315
      Left            =   1725
      TabIndex        =   2
      Text            =   "78"
      Top             =   900
      Width           =   990
   End
   Begin VB.ComboBox cboEndOfLineType
      Height          =   315
      Left            =   1725
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   525
      Width           =   3240
   End
   Begin VB.CommandButton cmdQuit
      Cancel          =   -1  'True
      Caption         =   "Quit"
      Height          =   390
      Left            =   8850
      TabIndex        =   7
      Top             =   4050
      Width           =   1140
   End
   Begin VB.ComboBox cboEncodingMethod
      Height          =   315
      Left            =   1725
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   150
      Width           =   3240
   End
   Begin VB.TextBox txtEncodedText
      BeginProperty Font
         Name            =   "Courier New"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1815
      Left            =   5625
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   5
      Top             =   1725
      Width           =   4365
   End
   Begin VB.CommandButton cmdDecode
      Caption         =   "<< Decode"
      Height          =   540
      Left            =   4500
      TabIndex        =   6
      Top             =   2850
      Width           =   990
   End
   Begin VB.CommandButton cmdEncode
      Caption         =   "Encode >>"
      Height          =   540
      Left            =   4500
      TabIndex        =   4
      Top             =   1875
      Width           =   990
   End
   Begin VB.TextBox txtDecodedText
      Height          =   1815
      Left            =   150
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   3
      Text            =   "MemoryEncode.frx":0000
      Top             =   1725
      Width           =   4215
   End
   Begin VB.Label lbl
      Caption         =   "Max line length"
      Height          =   240
      Index           =   6
      Left            =   150
      TabIndex        =   16
      Top             =   900
      Width           =   1440
   End
   Begin VB.Label lbl
      Caption         =   "End of line type"
      Height          =   240
      Index           =   5
      Left            =   150
      TabIndex        =   15
      Top             =   525
      Width           =   1440
   End
   Begin VB.Label lbl
      Caption         =   "Encoding method"
      Height          =   240
      Index           =   4
      Left            =   150
      TabIndex        =   14
      Top             =   150
      Width           =   1440
   End
   Begin VB.Label lblDecodedSize
      Caption         =   "0"
      ForeColor       =   &H00C00000&
      Height          =   240
      Left            =   1350
      TabIndex        =   13
      Top             =   3675
      Width           =   690
   End
   Begin VB.Label lbl
      Caption         =   "Decoded size"
      Height          =   240
      Index           =   3
      Left            =   150
      TabIndex        =   12
      Top             =   3675
      Width           =   1065
   End
   Begin VB.Label lbl
      Caption         =   "Encoded text"
      Height          =   240
      Index           =   2
      Left            =   5625
      TabIndex        =   11
      Top             =   1500
      Width           =   2865
   End
   Begin VB.Label lblEncodedSize
      Caption         =   "0"
      ForeColor       =   &H00C00000&
      Height          =   240
      Left            =   7050
      TabIndex        =   10
      Top             =   3675
      Width           =   915
   End
   Begin VB.Label lbl
      Caption         =   "Encoded size"
      Height          =   240
      Index           =   1
      Left            =   5625
      TabIndex        =   9
      Top             =   3675
      Width           =   1290
   End
   Begin VB.Label lbl
      Caption         =   "Decoded text"
      Height          =   240
      Index           =   0
      Left            =   150
      TabIndex        =   8
      Top             =   1500
      Width           =   2865
   End
Attribute VB_Name = "frmMemoryEncode"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' Xceed Binary Encoding Library - Memory Encode sample
' Copyright (c) 2001 Xceed Software Inc.
' [MemoryEncode.frm]
' This form module contains the main form's code. It demonstrates how to
' encode a chunk of memory data using different kinds of encoding methods,
' and decode an encoded memory data. It specifically uses:
'  - The Encode and Decode method.
'  - The ContinueOnInvalidData, IncludeHeaderFooter, EndOfLineType, MaxLineLength,
'    HeaderDataForkLength, HeaderResourceForkLength and EncodingFormat propeties.
' This file is part of the Xceed Binary Encoding Library sample applications.
' The source code in this file is only intended as a supplement to Xceed
' Binary Encoding Library's documentation, and is provided "as is", without
' warranty of any kind, either expressed or implied.
Option Explicit
'The different encoding methods that will serve to populate the combo box
Private Enum enuEncodingMethod
    emUUEncode = 0
    emXXEncode = 1
    emHexadecimal = 2
    emBase64 = 3
    emQuotedPrintable = 4
    emBinHex = 5
End Enum
'====================================================================================
' EVENTS - triggered by the form and its controls
'====================================================================================
'------------------------------------------------------------------------------------
'Do the encoding of the original text
'------------------------------------------------------------------------------------
Private Sub cmdEncode_Click()
    Dim xEncoder As XceedBinaryEncoding
    Dim zDecodedText As Variant
    Dim lErrorNumber As Long
    Dim vaEncoded As Variant
    'Create an instance of the Xceed binary encoding
    Set xEncoder = New XceedBinaryEncoding
    With xEncoder
        'Create and prepare the encoding format (XX, UU, BinHex, ...)
        If PrepareEncodingFormat(xEncoder) Then
            'Convert unicode text to an ascii string
            'Useful to reduce the output encoded string, but it could
            'be skipped
            zDecodedText = StrConv(txtDecodedText.Text, vbFromUnicode)

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

                lErrorNumber = Err.Number
                If lErrorNumber <> 0 Then
                    Call MsgBox("Error during Encode." & 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(vaEncoded) Then
                'No output was produced
                txtEncodedText.Text = ""
                lblEncodedSize.Caption = "0"
            Else
                'Display the encoded result in the text box and show
                'the encoded string size. We convert the ascii string
                'returned by the Encode method to Unicode so that the
                'encoded text box will contained something readable.
                txtEncodedText.Text = StrConv(vaEncoded, vbUnicode)
                lblEncodedSize.Caption = CStr(UBound(vaEncoded) + 1)
            End If
        End If
    End With
    'Deallocate the Encoding object. The encoding object will free
    'the EncodingFormat object.
    Set xEncoder = Nothing
End Sub
'------------------------------------------------------------------------------------
'Do the decoding of the encoded text
'------------------------------------------------------------------------------------
Private Sub cmdDecode_Click()
    Dim xEncoder As XceedBinaryEncoding
    Dim zEncodedText As Variant
    Dim lErrorNumber As Long
    Dim vaDecoded As Variant
    'Create an instance of the Xceed binary encoding
    Set xEncoder = New XceedBinaryEncoding
    With xEncoder
        'Create and prepare the encoding format (XX, UU, BinHex, ...)
        If PrepareDecodingFormat(xEncoder) Then
            'Convert unicode text to an ascii string
            'Mandatory as the Decode method will expect an ascii string
            'as input.
            zEncodedText = StrConv(txtEncodedText.Text, vbFromUnicode)

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

                lErrorNumber = Err.Number
                If lErrorNumber <> 0 Then
                    Call MsgBox("Error during Encode." & 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 IsEmpty(vaDecoded) Then
                'No output was produced
                txtDecodedText.Text = ""
                lblDecodedSize.Caption = "0"
            Else
                'Display the decoded result in the text box and show
                'the decoded string size. We convert the ascii string
                'returned by the Decode method to Unicode so that the
                'decoded text box will contained something readable.
                'If we had not convert the decoded string in the Encode
                'process (to reduce the output encoded string), we
                'would simply assign the vaDecoded to the txtDecodedText.
                txtDecodedText.Text = StrConv(vaDecoded, vbUnicode)
                lblDecodedSize.Caption = CStr(UBound(vaDecoded) + 1)
            End If
        End If
    End With
    'Deallocate the Encoding object. The encoding object will free
    'the EncodingFormat object.
    Set xEncoder = Nothing
End Sub
'------------------------------------------------------------------------------------
'Quit the sample application
'------------------------------------------------------------------------------------
Private Sub cmdQuit_Click()
    End
End Sub
'------------------------------------------------------------------------------------
'Initialize the decoded size label and fill the 2 combo boxes
'------------------------------------------------------------------------------------
Private Sub Form_Load()
    lblDecodedSize.Caption = CStr(Len(txtDecodedText.Text))
    With cboEncodingMethod
        Call .AddItem("UU encoding", emUUEncode)
        Call .AddItem("XX encoding", emXXEncode)
        Call .AddItem("Hexadecimal", emHexadecimal)
        Call .AddItem("Base 64", emBase64)
        Call .AddItem("Quoted printable", emQuotedPrintable)
        Call .AddItem("BinHex", emBinHex)
        .ListIndex = emUUEncode
    End With
    With cboEndOfLineType
        Call .AddItem("None", bltNone)
        Call .AddItem("Carriage return/line feed", bltCrLf)
        Call .AddItem("Line feed", bltLf)
        Call .AddItem("Carriage return", bltCr)
        .ListIndex = bltNone
    End With
End Sub
'------------------------------------------------------------------------------------
'Update the decoded size label when the user modify the decoded text box content
'------------------------------------------------------------------------------------
Private Sub txtDecodedText_Change()
    lblDecodedSize.Caption = CStr(Len(txtDecodedText.Text))
End Sub
'------------------------------------------------------------------------------------
'Update the encoded size label when the user modify the encoded text box content
'------------------------------------------------------------------------------------
Private Sub txtEncodedText_Change()
    lblEncodedSize.Caption = CStr(Len(txtEncodedText.Text))
End Sub
'====================================================================================
' FUNCTIONS
'====================================================================================
'------------------------------------------------------------------------------------
'Prepare the encoding format according to the user selection
'Return True if all succeeded
'------------------------------------------------------------------------------------
Private Function PrepareEncodingFormat(ByRef xEncoder As XceedBinaryEncoding) 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 xUUFormat As XceedUUEncodingFormat
    Dim xXXFormat As XceedXXEncodingFormat
    Dim xHexaFormat As XceedHexaEncodingFormat
    Dim xBase64Format As XceedBase64EncodingFormat
    Dim xQPFormat As XceedQuotedPrintableEncodingFormat
    Dim xBinHexFormat As XceedBinHexEncodingFormat
    Dim bPrepareOK As Boolean
    bPrepareOK = True
    On Error Resume Next
        Select Case cboEncodingMethod.ListIndex
            Case emUUEncode
                Set xUUFormat = New XceedUUEncodingFormat
                'We don't want any header/footer for this is only a memory encoding
                'process. The header/footer are mainly useful with files.
                xUUFormat.IncludeHeaderFooter = False
                xUUFormat.EndOfLineType = cboEndOfLineType.ListIndex
                'Set the maximum line length specified by the user. This is a mandatory
                'value as the EndOfLineType can not be None for UUEncoding.
                xUUFormat.MaxLineLength = CLng(txtMaxLineLength.Text)
                'Set the previously initialized Encoding format of the Encoder object
                'received as a parameter of this function.
                Set xEncoder.EncodingFormat = xUUFormat
                'Free the temporary encoding format. The previous assignation adding
                'a reference to the encoding format object, this object will effectively
                'be freed by the xEncoder object when the latter will be freed.
                Set xUUFormat = Nothing

            Case emXXEncode
                Set xXXFormat = New XceedXXEncodingFormat
                'We don't want any header/footer for this is only a memory encoding
                'process. The header/footer are mainly useful with files.
                xXXFormat.IncludeHeaderFooter = False
                xXXFormat.EndOfLineType = cboEndOfLineType.ListIndex
                'Set the maximum line length specified by the user. This is a mandatory
                'value as the EndOfLineType can not be None for XXEncoding.
                xXXFormat.MaxLineLength = CLng(txtMaxLineLength.Text)
                Set xEncoder.EncodingFormat = xXXFormat
                Set xXXFormat = Nothing

            Case emHexadecimal
                Set xHexaFormat = New XceedHexaEncodingFormat
                xHexaFormat.EndOfLineType = cboEndOfLineType.ListIndex
                'Set the maximum line length specified by the user. This value will
                'be ignored by the Xceed Binary Encoding Library if the End of line
                'type is set to None
                xHexaFormat.MaxLineLength = CLng(txtMaxLineLength.Text)
                Set xEncoder.EncodingFormat = xHexaFormat
                Set xHexaFormat = Nothing

            Case emBase64
                Set xBase64Format = New XceedBase64EncodingFormat
                xBase64Format.EndOfLineType = cboEndOfLineType.ListIndex
                'Set the maximum line length specified by the user. This value will
                'be ignored by the Xceed Binary Encoding Library if the End of line
                'type is set to None
                xBase64Format.MaxLineLength = CLng(txtMaxLineLength.Text)
                Set xEncoder.EncodingFormat = xBase64Format
                Set xBase64Format = Nothing

            Case emQuotedPrintable
                Set xQPFormat = New XceedQuotedPrintableEncodingFormat
                xQPFormat.EndOfLineType = cboEndOfLineType.ListIndex
                'Set the maximum line length specified by the user. This value will
                'be ignored by the Xceed Binary Encoding Library if the End of line
                'type is set to None
                xQPFormat.MaxLineLength = CLng(txtMaxLineLength.Text)
                Set xEncoder.EncodingFormat = xQPFormat
                Set xQPFormat = Nothing

            Case emBinHex
                Set xBinHexFormat = New XceedBinHexEncodingFormat
                xBinHexFormat.EndOfLineType = cboEndOfLineType.ListIndex
                'Set the maximum line length specified by the user. This value will
                'be ignored by the Xceed Binary Encoding Library if the End of line
                'type is set to None
                xBinHexFormat.MaxLineLength = CLng(txtMaxLineLength.Text)

                'For the BinHex format, we must specify the data fork length and the
                'resource fork length.
                'The DataForkLength is mandatory and must be set to the size
                'of the data that will be encoded.
                xBinHexFormat.HeaderDataForkLength = Len(txtDecodedText.Text)
                'The ResourceForkLength, used by MAC system, is not relevant
                'under a PC system. We set it to 0.
                xBinHexFormat.HeaderResourceForkLength = 0

                'We don't want any formating for this is only a memory encoding
                'process. The formating are mainly useful with files.
                xBinHexFormat.IncludeHeaderFooter = False
                Set xEncoder.EncodingFormat = xBinHexFormat
                Set xBinHexFormat = Nothing
        End Select

        If Err.Number <> 0 Then
            bPrepareOK = False
            Call MsgBox("Error during encoding format initialization." & vbCrLf & Err.Description & " (" & Hex(Err.Number) & ")")
        End If
    On Error GoTo 0
    PrepareEncodingFormat = bPrepareOK
End Function
'------------------------------------------------------------------------------------
'Prepare the decoding format according to the user selection
'Return True if all succeeded
'------------------------------------------------------------------------------------
Private Function PrepareDecodingFormat(ByRef xEncoder As XceedBinaryEncoding) As Boolean
    'We use one variable for each decoding 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 xUUFormat As XceedUUEncodingFormat
    Dim xXXFormat As XceedXXEncodingFormat
    Dim xHexaFormat As XceedHexaEncodingFormat
    Dim xBase64Format As XceedBase64EncodingFormat
    Dim xQPFormat As XceedQuotedPrintableEncodingFormat
    Dim xBinHexFormat As XceedBinHexEncodingFormat
    Dim bPrepareOK As Boolean
    bPrepareOK = True
    On Error Resume Next
        Select Case cboEncodingMethod.ListIndex
            Case emUUEncode
                Set xUUFormat = New XceedUUEncodingFormat
                'The encoded string does not contain any header/footer
                'The header/footer are usually present only in files.
                xUUFormat.IncludeHeaderFooter = False
                'We want to ignore any invalid encoded characters
                xUUFormat.ContinueOnInvalidData = True
                Set xEncoder.EncodingFormat = xUUFormat
                Set xUUFormat = Nothing
            Case emXXEncode
                Set xXXFormat = New XceedXXEncodingFormat
                'The encoded string does not contain any header/footer
                'The header/footer are usually present only in files.
                xXXFormat.IncludeHeaderFooter = False
                xXXFormat.ContinueOnInvalidData = True
                Set xEncoder.EncodingFormat = xXXFormat
                Set xXXFormat = Nothing
            Case emHexadecimal
                Set xHexaFormat = New XceedHexaEncodingFormat
                xHexaFormat.ContinueOnInvalidData = True
                Set xEncoder.EncodingFormat = xHexaFormat
                Set xHexaFormat = Nothing
            Case emBase64
                Set xBase64Format = New XceedBase64EncodingFormat
                xBase64Format.ContinueOnInvalidData = True
                Set xEncoder.EncodingFormat = xBase64Format
                Set xBase64Format = Nothing
            Case emQuotedPrintable
                Set xQPFormat = New XceedQuotedPrintableEncodingFormat
                xQPFormat.ContinueOnInvalidData = True
                Set xEncoder.EncodingFormat = xQPFormat
                Set xQPFormat = Nothing
            Case emBinHex
                Set xBinHexFormat = New XceedBinHexEncodingFormat
                'The encoded string does not contain any formating
                'The formating are usually present only in files.
                xBinHexFormat.IncludeHeaderFooter = False
                xBinHexFormat.ContinueOnInvalidData = True
                Set xEncoder.EncodingFormat = xBinHexFormat
                Set xBinHexFormat = Nothing
        End Select

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