This is a compression algorithm code discussed in the 9CBS Forum.
Compared with WinRAR compare ZIP comparison, 255m file level = 0 is used in 24.98 seconds size 95.1mlevel = 255 hours 30.24 seconds size 91.6m
WinRAR is the fastest compression zip to use the 25.2 second size 58.6M standard RAR compression, I saw it, it is too slow, I haven't tried it, it is estimated that there will be a few minutes.
From the speed of view, it is basically flat. Although this algorithm is limited, it feels very clever, every time it is dynamic table, so that the software can be very small, and the resource is also very small. Very worth collecting!
'Test code form Option ExplicitPrivate WithEvents ObjZip As ClassZipPrivate BgTime As SinglePrivate 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) & "seconds" Command1.Enabled = true Command2.Enabled = TrueEnd SubPrivate 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) & "seconds" Command1.Enabled = True Command2 .Enabled = truend subprivate sub command3_click () objzip.cancelprocss = truend subcancelprocss = true
Private Sub Form_Load () set objzip = new classzip command1.caption = "Compressed" Command2.caption = "Unzip" Command3.caption = "Interrupt" end submand
Private Sub Form_Unload (Cancel AS Integer) Set Objzip = Nothingend Sub
Private sub objzip_fileprogress (SNGPERCentage as single) Label1 = int (SNGPERCentage * 100) & "%" end sub
Private subjzip_procsserror (ErrorDescription as String) MsgBox ErrorDescriptionnd Neument and Properties, Methods, Methods, Events, Methods, Events, Methods, Events, Events
Option ExplicitPublic 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 IntegerEnd TypePrivate mintCompressLevel As LongPrivate m_bEnableProcss As BooleanPrivate m_bCompress As BooleanPrivate m_strInputFileName As StringPrivate m_strOutputFileName As StringPrivate Const mcintWindowSize As Integer = & H1000Private Const mcintMaxMatchLen As Integer = 18Private Const mcintMinMatchLen As Integer = 3Private Const mcintNull As Long = & H1000Private 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 IfEnd SubPrivate Function LastError (ErrNo As Integer) As String Select Case ErrNo Case 1 LastError = "to be pressed The retracting file is not set or does not exist "Case 2 lasterror =" to be compressed file length is too small "case 3 lasterror =" to be compressed file has been compressed "Case 4 lasterror =" to be decompressed without setting or does not exist "Case 5 lasterror = "Case 254 lasterror =" Case 255 lasterror = "Unknown Error" end compressLevel () AS Integer CompressLevel () AS Integer CompressLevel () AS Integer CompressLevel () MintCompresslevel / 16nd PropertyPublic Property Let CompressLevel (Byval INTVALUE AS INTEGER) MintCompressLevel = INTVALUE * 16 IF MintCompressLevel <0 Then MintCompressLevel =
0nd PropertyPublic Property get iScompress () as boolean iScompress = m_bcompressend propertypublic property letyspress (Byval Bvalue as boolean) m_bcompress = BValueEnd Property
Public property let can CancelProcss (Byval Bvalue as Boolean) M_BenableProcss = NOT BVALUEEND Property
Public property Get InputFileName () AS String InputFileName = M_STRINPUTFILENAMEEND PROPERTY
Public Property Get OutputFileName () As String OutputFileName = m_strOutputFileNameEnd PropertyPublic Property Let OutputFileName (ByVal strValue As String) m_strOutputFileName = strValueEnd PropertyPublic Property Let InputFileName (ByVal strValue As String) m_strInputFileName = strValueEnd PropertyPrivate Sub Class_Terminate () m_bEnableProcss = FalseEnd Sub
