一个优化后的压缩算法（上）

这是一个在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