12-26-2024, 03:35 PM
(This post was last modified: 12-26-2024, 03:54 PM by aadityap0901.)
Check this out:
1B - A pre-compression algorithm to increase the compression-ratio of deflate:
Basic Usage: 1b -c [FILENAME]
1B - A pre-compression algorithm to increase the compression-ratio of deflate:
Basic Usage: 1b -c [FILENAME]
Code: (Select All)
$Console:Only
If _CommandCount = 0 Then System
Dim As _Unsigned Long BS
Dim ST!, LT!, I$, O$, Y%, INFILE$, OUTFILE$, PATHPREFIX$, MODE%%, L&
If Command$(1) = "-c" Or Command$(1) = "--compress" Then MODE%% = 1
If Command$(1) = "-d" Or Command$(1) = "--decompress" Then MODE%% = 2
INFILE$ = Command$(2)
If _FileExists(INFILE$) = 0 Then PATHPREFIX$ = _StartDir$ + "\"
INFILE$ = PATHPREFIX$ + INFILE$
If _FileExists(INFILE$) = 0 Then Print "File "; Command$(2); " does not exists!": System
Y% = CsrLin + 1
Select Case MODE%%
Case 1: Print "Compressing": Open INFILE$ For Binary As #1
OUTFILE$ = INFILE$ + ".1b"
Open OUTFILE$ For Output As #2
Close #2
Open OUTFILE$ For Binary As #2
ST! = Timer(0.001)
BS = 2 ^ Val(Command$(3))
If BS = 1 Then BS = 2 ^ 20
Do
LT! = Timer(0.001)
If LOF(1) - Seek(1) + 1 >= BS Then I$ = Space$(BS) Else I$ = Space$(LOF(1) - Seek(1) + 1)
Get #1, , I$
O$ = OneByteEncode$(I$)
I$ = MKL$(Len(O$)) + O$
Put #2, , I$
If LOF(1) <= Seek(1) - 1 Then Exit Do
Locate Y%, 1: Print Round(100 * (Seek(1) - 1) / LOF(1)); "%", Round(100 * LOF(2) / (Seek(1) - 1)); "%", Round(Timer(0.001) - LT!); "s", Round((Timer(0.001) - LT!) / BS * (LOF(1) - Seek(1) + 1)); "s", Round(Timer(0.001) - ST!); "s"
Loop
Print "Ratio:"; Round(100 * LOF(2) / LOF(1)); "%"
Print "Time: "; Timer(0.001) - ST!; "s"
Close
Case 2: Print "Decompressing": Open INFILE$ For Binary As #1
OUTFILE$ = INFILE$ + ".out"
Open OUTFILE$ For Output As #2
Close #2
Open OUTFILE$ For Binary As #2
ST! = Timer(0.001)
Do
LT! = Timer(0.001)
Get #1, , L&
If EOF(1) = -1 Then Exit Do
I$ = Space$(L&)
Get #1, , I$
O$ = OneByteDecode$(I$)
Put #2, , O$
Locate Y%, 1: Print Round(100 * (Seek(1) - 1) / LOF(1)); "%", Round(Timer(0.001) - LT!); "s", Round(Timer(0.001) - ST!); "s"
Loop
Print "Time: "; Timer(0.001) - ST!; "s"
Close
End Select
System
Function Round (__N As Double)
Round = Int(100 * __N) / 100
End Function
Function Remain~& (A~&, B~&)
Remain~& = A~& \ B~& + Sgn(A~& Mod B~&)
End Function
Function OneByteEncode$ (__I$)
Dim As _Unsigned _Byte __ONEBYTE, __C
Dim As _Unsigned Long __BYTE_BUFFER_OFFSET, __POSITION_BUFFER_OFFSET, __I, __LENA, __Frequency_Table(0 To 255)
Dim __J As _Unsigned _Bit * 3
Dim As String __BYTE_BUFFER, __POSITION_BUFFER
__LENA = Len(__I$)
For __I = 1 To __LENA
__BYTE~%% = Asc(__I$, __I)
__Frequency_Table(__BYTE~%%) = __Frequency_Table(__BYTE~%%) + 1
Next __I
For __BI~%% = 0 To 255
If __Frequency_Table(__BI~%%) > __Frequency_Table(__ONEBYTE) Then __ONEBYTE = __BI~%%
Next __BI~%%
__BYTE_BUFFER = String$(Len(__I$), 0): __POSITION_BUFFER = String$(Remain(Len(__I$), 8) + 1, 0)
For __I = 1 To Len(__I$)
__C = Asc(__I$, __I): If __J = 0 Then __POSITION_BUFFER_OFFSET = __POSITION_BUFFER_OFFSET + 1
If __C <> __ONEBYTE Then
Asc(__POSITION_BUFFER, __POSITION_BUFFER_OFFSET) = _SetBit(Asc(__POSITION_BUFFER, __POSITION_BUFFER_OFFSET), __J)
__BYTE_BUFFER_OFFSET = __BYTE_BUFFER_OFFSET + 1: Asc(__BYTE_BUFFER, __BYTE_BUFFER_OFFSET) = __C
End If
__J = __J + 1
Next __I
__POSITION_BUFFER = _Deflate$(Left$(__POSITION_BUFFER, __POSITION_BUFFER_OFFSET))
__BYTE_BUFFER = _Deflate$(Left$(__BYTE_BUFFER, __BYTE_BUFFER_OFFSET))
OneByteEncode$ = MKL$(Len(__I$)) + MKL$(Len(__POSITION_BUFFER)) + MKL$(Len(__BYTE_BUFFER)) + Chr$(__ONEBYTE) + __POSITION_BUFFER + __BYTE_BUFFER
__POSITION_BUFFER = ""
__BYTE_BUFFER = ""
Exit Function
End Function
Function OneByteDecode$ (__I$)
Dim As _Unsigned Long __I, __BYTE_BUFFER_OFFSET, __POSITION_BUFFER_OFFSET
Dim As _Unsigned _Bit * 3 __J
Dim As String __BYTE_BUFFER, __POSITION_BUFFER, __OUT_BUFFER
__OUT_LENGTH~& = CVL(Left$(__I$, 4))
__POSITION_BUFFER_DEFLATE_LENGTH~& = CVL(Mid$(__I$, 5, 4))
__BYTE_BUFFER_DEFLATE_LENGTH~& = CVL(Mid$(__I$, 9, 4))
__ONEBYTE~%% = Asc(__I$, 13)
__POSITION_BUFFER = _Inflate$(Mid$(__I$, 14, __POSITION_BUFFER_DEFLATE_LENGTH~&))
__BYTE_BUFFER = _Inflate$(Mid$(__I$, 14 + __POSITION_BUFFER_DEFLATE_LENGTH~&, __BYTE_BUFFER_DEFLATE_LENGTH~&))
__OUT_BUFFER = String$(__OUT_LENGTH~&, 0)
__POSITION_BUFFER_OFFSET = 0
__BYTE_BUFFER_OFFSET = 0
For __I = 1 To __OUT_LENGTH~&
If __J = 0 Then __POSITION_BUFFER_OFFSET = __POSITION_BUFFER_OFFSET + 1
If _ReadBit(Asc(__POSITION_BUFFER, __POSITION_BUFFER_OFFSET), __J) Then
__BYTE_BUFFER_OFFSET = __BYTE_BUFFER_OFFSET + 1
Asc(__OUT_BUFFER, __I) = Asc(__BYTE_BUFFER, __BYTE_BUFFER_OFFSET)
Else
Asc(__OUT_BUFFER, __I) = __ONEBYTE~%%
End If
__J = __J + 1
Next __I
__POSITION_BUFFER = ""
__BYTE_BUFFER = ""
OneByteDecode = __OUT_BUFFER
End Function
Function RLEEncode$ (__I$)
Dim As _Unsigned _Byte __CB, __LB, __C
Dim As Long __I
Dim As String __OUT_BUFFER
__OUT_BUFFER = String$(Len(__I$) * 2, 0)
__LB = Asc(__I$, 1)
__C = 1
For __I = 2 To Len(__I$)
__CB = Asc(__I$, __I)
If __CB = __LB And __C < 255 Then
__C = __C + 1
Else
__OUT_BUFFER_OFFSET = __OUT_BUFFER_OFFSET + 1
Asc(__OUT_BUFFER, __OUT_BUFFER_OFFSET) = __LB
__OUT_BUFFER_OFFSET = __OUT_BUFFER_OFFSET + 1
Asc(__OUT_BUFFER, __OUT_BUFFER_OFFSET) = __C
__C = 1
__LB = __CB
End If
Next __I
__OUT_BUFFER_OFFSET = __OUT_BUFFER_OFFSET + 1
Asc(__OUT_BUFFER, __OUT_BUFFER_OFFSET) = __LB
__OUT_BUFFER_OFFSET = __OUT_BUFFER_OFFSET + 1
Asc(__OUT_BUFFER, __OUT_BUFFER_OFFSET) = __C
If 5 + __OUT_BUFFER_OFFSET > Len(__I$) Then
RLEEncode$ = Chr$(0) + __I$
Else
RLEEncode$ = Chr$(1) + MKL$(Len(__I$)) + Left$(__OUT_BUFFER, __OUT_BUFFER_OFFSET + 1)
End If
__OUT_BUFFER = ""
End Function
Function RLEDecode$ (__I$)
Dim As _Unsigned _Byte __B, __C
Dim As Long __I, __OUT_BUFFER_OFFSET
Dim As String __OUT_BUFFER
If Asc(__I$, 1) = 0 Then
RLEDecode$ = Mid$(__I$, 2)
Exit Function
End If
__OUT_LENGTH~& = CVL(Mid$(__I$, 2, 4))
__OUT_BUFFER = String$(__OUT_LENGTH~&, 0)
__OUT_BUFFER_OFFSET = 1
For __I = 6 To Len(__I$) - 1
__B = Asc(__I$, __I): __I = __I + 1: __C = Asc(__I$, __I)
Mid$(__OUT_BUFFER, __OUT_BUFFER_OFFSET, __C) = String$(__C, __B)
__OUT_BUFFER_OFFSET = __OUT_BUFFER_OFFSET + __C
Next __I
RLEDecode$ = __OUT_BUFFER
__OUT_BUFFER = ""
End Function