Command-line file codec sample using algorithm by original author of Zip

Category:

Miscellaneous

Type:

Applications

Difficulty:

Intermediate

Author: neophile

Version Compatibility: Visual Basic 6

More information:

This requires the completely free ZLib.dll You can find it in many different colors and flavors at: http://www.gzip.org/zlib/ ...along with some info about the authors and some interesting implementations of it. (NT/2000/XP users/developers, check out CExe) Below is a sample project that will take a file from a command line and compress it or decompress it accordingly. This is just the guts and I'm sure you'll do more with it (like adding an entry into HKEY_CLASS_ROOT/*) but here goes...

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
' 1: Create a new Standard EXE project ' 2: Add a module ' 3: Remove the form ' 4: Copy the code below ' 5: Paste into the module ' 6: Compile ' ' From there, you could add entries in the registry, or drag & drop files directly onto the executable you created ;)

Code:

Option Explicit

Private Const CZHeader As String = "CZ1"

Sub Main()
    Dim sFile As String
    Dim vAttr As VbFileAttribute
    Dim bFlag As Boolean
    Dim fn As Integer
    Dim sHdr As String
    Dim lLen As Long
    Dim lKey As Long
    Dim bData() As Byte
    Dim bTmp() As Byte
    Dim oZip As CompressZIt ' Win32 ActiveX DLL: ZLib.dll
    
    sFile = Trim(Replace(Command, """", "")) ' Strip extra characters
    
    If Dir(sFile, vbHidden) <> "" And sFile <> "" Then ' Check for the file
        vAttr = GetAttr(sFile) ' Get the file's attributes
        bFlag = True ' Set default flag
        If (vAttr And vbReadOnly) = vbReadOnly Then ' Check for 'Read Only' attribute
            ' And see if they want to continue anyway
            bFlag = (MsgBox("Are you sure you want to alter this read-only file?", vbYesNo) = vbYes)
        End If
        If bFlag Then ' Check if we're continuing
            SetAttr sFile, vbNormal ' Reset the attributes for full access
            If FileLen(sFile) > 0 Then  ' See if we need to do anything
                fn = FreeFile ' Get the first available handle
                Open sFile For Binary Access Read As fn ' Open it up as a byte-stream
                    If LOF(fn) >= 7 Then ' It might be compressed
                        sHdr = Space(Len(CZHeader))
                        Get fn, , sHdr
                        bFlag = (sHdr <> CZHeader) ' See if we need to compress
                    End If
                    If bFlag Then ' Check if we're compressing
                        lKey = LOF(fn) ' Get the size of the data
                        ReDim bData(lKey - 1) As Byte ' Allocate to current size
                        Get fn, 1, bData ' Get the file's complete contents
                        bTmp = bData ' Make a copy of the data
                        Set oZip = New CompressZIt ' Create an instance of the compression object
                        oZip.CompressData bTmp  ' Compress the copied data
                        Set oZip = Nothing ' Destroy the instance
                        If (UBound(bData) - UBound(bTmp)) > 11 Then ' See if it was worth compressing
                            bData = bTmp ' Grab the compressed data
                        Else
                            lKey = 0 ' We're not compressing, key not needed
                        End If
                        Erase bTmp ' Clear the copy
                        lLen = UBound(bData) + 1 ' Get the adjusted size
                    Else ' or decompressing
                        Get fn, , lLen ' Get the data's size
                        If lLen > 0 Then ' If there actually is data
                            Get fn, , lKey ' Get it's original size
                            ReDim bData(lLen - 1) ' Allocate to current size
                            Get fn, , bData ' Get the data
                            If lKey > 0 Then ' If it's actually compressed
                                Set oZip = New CompressZIt ' Create an instance of the compression object
                                oZip.DecompressData bData, lKey ' Decompress to it's original size
                                Set oZip = Nothing ' Destroy the instance
                            End If
                        End If
                    End If
                Close fn
            End If
            ' We have our data, if any, so let's empty the file without deleting it
            fn = FreeFile
            Open sFile For Output As fn
            Close fn
            ' Write to the file with the new data, if any
            fn = FreeFile
            Open sFile For Binary Access Write As fn
                If bFlag Then ' See if we just compressed
                    Put fn, , CZHeader ' Write the file header
                    Put fn, , lLen ' Write the data size
                    If lLen > 0 Then Put fn, , lKey ' If there is data, write it's key
                End If
                If lLen > 0 Then Put fn, , bData ' Write the data
            Close fn
            Erase bData ' Clear our data buffer
            If bFlag Then  ' See how we need to rename it
                ' It was compressed
                Name sFile As sFile & ".cz"
                MsgBox "File compressed."
            Else
                ' It was decompressed
                If LCase(Right(sFile, 3)) = ".cz" Then ' If it has our extension
                    Name sFile As Left(sFile, Len(sFile) - 3) ' Drop the extension
                End If
                MsgBox "File decompressed."
            End If
        End If
    End If
End Sub