#### Howdy, Stranger!

It looks like you're new here. Sign in or register to get started.

# Some my thoughts about compress algorithm in NAV

Member Posts: 158
edited 2008-10-21
Hi All

This my simple single-pass compress algorithm. Of course it not very effective, but it working...
```OBJECT Codeunit 40000 Compress/Expand Mgt.
{
OBJECT-PROPERTIES
{
Date=21-10-08;
Time=[11:41:34 ];
Modified=Yes;
Version List=;
}
PROPERTIES
{
OnRun=BEGIN
MESSAGE('Compress ration %1',compress('c:\\test.txt',STRSUBSTNO('c:\\test.arc'),TRUE));
expand('c:\\test.arc','c:\\test2.txt',TRUE);
END;

}
CODE
{
VAR
[email protected] : ARRAY [256] OF Text[1024];
[email protected] : Integer;
[email protected] : Integer;
[email protected] : BigInteger;
[email protected] : Integer;
[email protected] : Integer;

LOCAL PROCEDURE [email protected]([email protected] : BigInteger;[email protected] : Integer) result : Text[64];
VAR
[email protected] : Integer;
BEGIN
FOR i := 1 TO size DO BEGIN
result := FORMAT(value MOD 2) + result;
value  := value DIV 2;
END;
END;

LOCAL PROCEDURE [email protected]([email protected] : Text[64];[email protected] : Integer) result : BigInteger;
VAR
[email protected] : Integer;
BEGIN
FOR i := 1 TO size DO
result := result * 2 + str2int(FORMAT(value[i]));
END;

LOCAL PROCEDURE [email protected]([email protected] : Text[250]) result : BigInteger;
BEGIN
EVALUATE(result,value);
END;

LOCAL PROCEDURE [email protected]();
VAR
[email protected] : Integer;
BEGIN

// some parameters which depended from file...
_max_len    := 11;
_range_bits := 5;
_max_limits := 1;
_max_bits   := 6;

FOR i := 0 TO 255 DO
abc[i + 1] := bit2str(i,8);

_power2 := POWER(2,_range_bits-1);
END;

PROCEDURE [email protected]([email protected] : Text[250];[email protected] : Text[250];[email protected] : Boolean) Result : Decimal;
VAR
[email protected] : File;
[email protected] : File;
[email protected] : Char;
[email protected] : Integer;
[email protected] : Text[1024];
[email protected] : Char;
[email protected] : BigInteger;
[email protected] : Boolean;
[email protected] : Dialog;
[email protected] : Integer;
BEGIN

fin.TEXTMODE(FALSE);
fin.OPEN(input);

fout.TEXTMODE(FALSE);
fout.CREATE(output);

initialize();

IF progress THEN
w.OPEN('[email protected]@@@@@@@@@@@@@@@@@@@@@@@@@@@\' +
'Ratio   #2#########%');

WHILE fin.POS < fin.LEN DO BEGIN

IF fin.POS > 0 THEN
Result := ROUND(_result_len * 100 / fin.POS,0.01);

IF progress THEN BEGIN
w.UPDATE(1,ROUND(10000 * fin.POS / fin.LEN,1));
w.UPDATE(2,Result);
END;

strbuf := strbuf + abc[ch + 1];

WHILE STRLEN(strbuf) >= 8 DO BEGIN
chrbuf := str2bit(COPYSTR(strbuf,1,8),8);
strbuf := DELSTR(strbuf,1,8);
fout.WRITE(chrbuf); _result_len := _result_len + 1;
END;

IF STRLEN(abc[ch + 1]) > _max_bits THEN
_limits := _limits + 1;

chop := FALSE;
FOR i := 0 TO 255 DO
IF STRLEN(abc[i + 1]) > _max_len THEN
chop := TRUE;
IF chop THEN initialize()
ELSE

IF _limits > _max_limits THEN BEGIN
_limits := 0;

FOR i := 0 TO 255 DO
IF (i >= (ch - _power2 + 1)) AND (i <= (ch + _power2)) THEN
abc[i + 1] := '0' + bit2str(i - ch + _power2 - 1,_range_bits)
ELSE
abc[i + 1] := '1' + abc[i + 1];

END;

END;

IF STRLEN(strbuf) > 0 THEN BEGIN
WHILE STRLEN(strbuf) < 8 DO
strbuf := strbuf + '0';
chrbuf := str2bit(strbuf,8);
fout.WRITE(chrbuf); _result_len := _result_len + 1;
END;

fin.CLOSE;
fout.CLOSE;

IF progress THEN
w.CLOSE;
END;

PROCEDURE [email protected]([email protected] : Text[250];[email protected] : Text[250];[email protected] : Boolean);
VAR
[email protected] : File;
[email protected] : File;
[email protected] : Char;
[email protected] : Integer;
[email protected] : Text[1024];
[email protected] : Char;
[email protected] : Integer;
[email protected] : Boolean;
[email protected] : Integer;
[email protected] : Boolean;
[email protected] : Dialog;
[email protected] : Integer;
BEGIN
fin.TEXTMODE(FALSE);
fin.OPEN(input);

fout.TEXTMODE(FALSE);
fout.CREATE(output);

initialize();

IF progress THEN
w.OPEN('[email protected]@@@@@@@@@@@@@@@@@@@@@@@@@@@');

WHILE fin.POS < fin.LEN DO BEGIN

IF progress THEN
w.UPDATE(1,ROUND(10000 * fin.POS / fin.LEN,1));

strbuf := strbuf + bit2str(ch,8);

REPEAT
found := FALSE;
FOR j := 1 TO STRLEN(strbuf) DO
FOR i := 0 TO 255 DO
IF abc[i + 1] = COPYSTR(strbuf,1,j) THEN
BEGIN
chrbuf := i;
fout.WRITE(chrbuf);
strbuf := DELSTR(strbuf,1,j);

IF STRLEN(abc[chrbuf + 1]) > _max_bits THEN
_limits := _limits + 1;

chop := FALSE;
FOR k := 0 TO 255 DO
IF STRLEN(abc[k + 1]) > _max_len THEN
chop := TRUE;
IF chop THEN initialize()
ELSE

IF _limits > _max_limits THEN BEGIN
_limits := 0;

FOR k := 0 TO 255 DO
IF (k >= (chrbuf - _power2 + 1)) AND (k <= (chrbuf + _power2)) THEN
abc[k + 1] := '0' + bit2str(k - chrbuf + _power2 - 1,_range_bits)
ELSE
abc[k + 1] := '1' + abc[k + 1];
END;

found := TRUE;
END;

END;

fin.CLOSE;
fout.CLOSE;

IF progress THEN
w.CLOSE;
END;

BEGIN
{
Compress/Extend Mgt. Codeunit  - Yaroslav Gaponov ([email protected])
Single-pass compress algorithm.
}
END.
}
}
```