這是一個在csdn論壇中討論過的壓縮算法代碼。

與winrar以最快方式壓縮zip比較，
255m的文件
level=0時 用時24.98秒 大小95.1m
level=255時 用時30.24秒 大小91.6m

winrar最快壓縮zip 用時 25.2秒 大小58.6m
標準rar壓縮，我看了一下，實在太慢，也就沒試了，估計要幾分鐘才會有結果。

從速度看，基本持平了，這個算法雖然最大壓縮能力有限，但感覺設計得很巧妙，每次都基于動態表，使軟件可以做得很小巧，資源占用也很少。非常值得收藏！

'測試窗體中的代碼
option explicit
private withevents objzip as classzip
private bgtime as single
private sub command1_click()
    bgtime = timer
    command1.enabled = false
    command2.enabled = false
    with objzip
    .inputfilename = text1.text
    .outputfilename = text2.text
    .iscompress = true
    .compresslevel = val(text4.text)
    .beginprocss
    end with
    label1.caption = round(timer - bgtime, 2) & "秒"
    command1.enabled = true
    command2.enabled = true
end sub
private sub command2_click()
    bgtime = timer
    command1.enabled = false
    command2.enabled = false
    with objzip
    .inputfilename = text2.text
    .outputfilename = text3.text
    .iscompress = false
    .beginprocss
    end with
    label1 = round(timer - bgtime, 2) & "秒"
    command1.enabled = true
    command2.enabled = true
end sub
private sub command3_click()
    objzip.cancelprocss = true
end sub

private sub form_load()
    set objzip = new classzip
    command1.caption = "壓縮"
    command2.caption = "解壓"
    command3.caption = "中斷"
end sub

private sub form_unload(cancel as integer)
    set objzip = nothing
end sub

private sub objzip_fileprogress(sngpercentage as single)
    label1 = int(sngpercentage * 100) & "%"
end sub

private sub objzip_procsserror(errordescription as string)
    msgbox errordescription
end sub

'classzip類中的聲明與屬性、方法、事件

option explicit
public event fileprogress(sngpercentage as single)
public event procsserror(errordescription as string)
private type fileheader
    headertag as string * 3
    headersize as integer
    flag as byte
    filelength as long
    version as integer
end type
private mintcompresslevel as long
private m_benableprocss as boolean
private m_bcompress as boolean
private m_strinputfilename as string
private m_stroutputfilename as string
private const mcintwindowsize as integer = &h1000
private const mcintmaxmatchlen as integer = 18
private const mcintminmatchlen as integer = 3
private const mcintnull as long = &h1000
private const mcstrsignature as string = "fmz"
private declare sub copymemory lib "kernel32" alias "rtlmovememory" (pdest as any, psource as any, byval dwlength as long)
public sub beginprocss()
    if m_bcompress then
        compress
    else
        decompress
    end if
end sub
private function lasterror(errno as integer) as string
    select case errno
        case 1
            lasterror = "待壓縮文件未設置或不存在"
        case 2
            lasterror = "待壓縮文件長度太小"
        case 3
            lasterror = "待壓縮文件已經過壓縮"
        case 4
            lasterror = "待解壓文件未設置或不存在"
        case 5
            lasterror = "待解壓文件格式不對或為本軟件不能認別的高版本軟件所壓縮"
        case 254
            lasterror = "用戶取消了操作"
        case 255
            lasterror = "未知錯誤"
    end select
end function
public property get compresslevel() as integer
    compresslevel = mintcompresslevel / 16
end property
public property let compresslevel(byval intvalue as integer)
    mintcompresslevel = intvalue * 16
    if mintcompresslevel < 0 then mintcompresslevel = 0
end property

public property get iscompress() as boolean
    iscompress = m_bcompress
end property
public property let iscompress(byval bvalue as boolean)
    m_bcompress = bvalue
end property

public property let cancelprocss(byval bvalue as boolean)
    m_benableprocss = not bvalue
end property

public property get inputfilename() as string
    inputfilename = m_strinputfilename
end property

public property get outputfilename() as string
    outputfilename = m_stroutputfilename
end property
public property let outputfilename(byval strvalue as string)
    m_stroutputfilename = strvalue
end property
public property let inputfilename(byval strvalue as string)
    m_strinputfilename = strvalue
end property
private sub class_terminate()
    m_benableprocss = false
end sub