| 订阅 | 在线投稿
分享
 
 
 

一个优化后的压缩算法(上)

来源:互联网  宽屏版  评论
2006-01-09 20:54:59

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

 
这是一个在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
󰈣󰈤
 
 
 
>>返回首页<<
 
 热帖排行
 
 
 
静静地坐在废墟上,四周的荒凉一望无际,忽然觉得,凄凉也很美
©2005- 王朝网络 版权所有