一个优化后的压缩算法(上)
2005-04-12 20:07
411 查看
这是一个在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
与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
相关文章推荐
- 一个优化后的压缩算法(下)
- 关于数据库的一个统计算法的优化,欢迎大家来讨论(一定要赖心看的)
- 实现了一个压缩算法,在数据高度压缩的前提下,还可以快速查找 key
- 一个demo告诉你优化算法的强大
- 一个开源的页面传输压缩算法
- 一个开源的页面传输压缩算法
- 算法代码实现之Union-Find,C++实现,quick-find、quick-union、加权quick-union(附带路径压缩优化)
- 算法8:一个整数数组里怎么同时找最大和最小的数,尽量优化比较次数
- long和DWORD的一个压缩算法
- 一个开源的页面传输压缩算法
- SSE图像算法优化系列十:简单的一个肤色检测算法的SSE优化。
- 优化了的过关键点的光滑曲线拟合算法的修正(一个链表的定义)
- 一个没有经过优化的过滤指定目录下的指定扩展名文件的算法
- 发现一个学习算法优化的好网站
- 实现简易字符串压缩算法:一个长度最大为128的字符串, 由字母a-z或者A-Z组成,将其中连续出现2次以上(含2次)的字母转换为字母和出现次数,以达到压缩目的
- 整型数组处理算法(十一)请实现一个函数:线段重叠(性能优化)。[风林火山]
- 一个压缩算法 可以适当的用来编码
- 一个连通图,采用邻接表作为存储结构,设计一个算法从顶点v出发的深度优化遍历的非递归过程
- 一个小小的算法优化
- 一个连通图,采用邻接表作为存储结构,设计一个算法从顶点v出发的深度优化遍历的非递归过程