DeltaLima
/
Xpacket
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Xpacket/XPCOMP.PAS

299 lines
11 KiB
Plaintext
Executable File
Raw Permalink Blame History

HTable : Array [0..257] of Table_Typ =
((Tab : $AB2C; Len : 15), (Tab : $AA84; Len : 15), (Tab : $9FC4; Len : 15),
(Tab : $AB3C; Len : 15), (Tab : $AB1C; Len : 15), (Tab : $AAFC; Len : 15),
(Tab : $AAEC; Len : 15), (Tab : $AAD4; Len : 15), (Tab : $AAB4; Len : 15),
(Tab : $F340; Len : 10), (Tab : $AAA4; Len : 15), (Tab : $7D64; Len : 15),
(Tab : $AADC; Len : 15), (Tab : $F400; Len : 7), (Tab : $AA94; Len : 15),
(Tab : $9FF4; Len : 15), (Tab : $9FD4; Len : 15), (Tab : $7D74; Len : 15),
(Tab : $AB44; Len : 15), (Tab : $AB34; Len : 15), (Tab : $AB24; Len : 15),
(Tab : $AB14; Len : 15), (Tab : $AB04; Len : 15), (Tab : $AAF4; Len : 15),
(Tab : $AAE4; Len : 15), (Tab : $AB60; Len : 14), (Tab : $AB0C; Len : 15),
(Tab : $AACC; Len : 15), (Tab : $AABC; Len : 15), (Tab : $AAAC; Len : 15),
(Tab : $AA9C; Len : 15), (Tab : $AA8C; Len : 15), (Tab : $C000; Len : 3),
(Tab : $3A80; Len : 9), (Tab : $ABC0; Len : 10), (Tab : $0060; Len : 11),
(Tab : $7D40; Len : 12), (Tab : $AB5C; Len : 14), (Tab : $0000; Len : 12),
(Tab : $AB58; Len : 14), (Tab : $7C00; Len : 9), (Tab : $3C80; Len : 9),
(Tab : $7D00; Len : 11), (Tab : $0010; Len : 12), (Tab : $1200; Len : 7),
(Tab : $7A00; Len : 7), (Tab : $B800; Len : 6), (Tab : $3200; Len : 7),
(Tab : $2200; Len : 7), (Tab : $F600; Len : 8), (Tab : $3D00; Len : 8),
(Tab : $9E00; Len : 9), (Tab : $BD80; Len : 9), (Tab : $7C80; Len : 9),
(Tab : $0080; Len : 9), (Tab : $AA00; Len : 9), (Tab : $BD00; Len : 9),
(Tab : $9F00; Len : 9), (Tab : $0300; Len : 8), (Tab : $AB78; Len : 13),
(Tab : $AB68; Len : 13), (Tab : $3C00; Len : 9), (Tab : $3000; Len : 9),
(Tab : $0020; Len : 11), (Tab : $7D50; Len : 12), (Tab : $3800; Len : 7),
(Tab : $7800; Len : 7), (Tab : $9C00; Len : 7), (Tab : $FE00; Len : 7),
(Tab : $2400; Len : 6), (Tab : $BC00; Len : 8), (Tab : $0200; Len : 8),
(Tab : $0100; Len : 8), (Tab : $F100; Len : 8), (Tab : $0040; Len : 11),
(Tab : $3100; Len : 8), (Tab : $F200; Len : 8), (Tab : $3400; Len : 7),
(Tab : $1C00; Len : 7), (Tab : $1E00; Len : 7), (Tab : $BE00; Len : 7),
(Tab : $ABA0; Len : 11), (Tab : $3E00; Len : 7), (Tab : $1400; Len : 6),
(Tab : $3600; Len : 7), (Tab : $F380; Len : 9), (Tab : $F080; Len : 9),
(Tab : $2000; Len : 8), (Tab : $FC00; Len : 8), (Tab : $9F80; Len : 10),
(Tab : $9E80; Len : 9), (Tab : $AB90; Len : 12), (Tab : $3B80; Len : 9),
(Tab : $AB80; Len : 12), (Tab : $AB54; Len : 14), (Tab : $3A50; Len : 13),
(Tab : $AB50; Len : 14), (Tab : $A000; Len : 5), (Tab : $1800; Len : 6),
(Tab : $9800; Len : 6), (Tab : $7000; Len : 5), (Tab : $4000; Len : 3),
(Tab : $0400; Len : 6), (Tab : $AC00; Len : 6), (Tab : $F800; Len : 6),
(Tab : $6000; Len : 4), (Tab : $3A00; Len : 10), (Tab : $FD00; Len : 8),
(Tab : $2800; Len : 5), (Tab : $B000; Len : 6), (Tab : $8000; Len : 4),
(Tab : $B400; Len : 6), (Tab : $1000; Len : 7), (Tab : $7D20; Len : 12),
(Tab : $E000; Len : 5), (Tab : $9000; Len : 5), (Tab : $E800; Len : 5),
(Tab : $0800; Len : 5), (Tab : $F700; Len : 8), (Tab : $A800; Len : 7),
(Tab : $7D80; Len : 9), (Tab : $F300; Len : 10), (Tab : $7E00; Len : 7),
(Tab : $AB48; Len : 14), (Tab : $3A48; Len : 13), (Tab : $AB4C; Len : 14),
(Tab : $3A60; Len : 12), (Tab : $9FFC; Len : 15), (Tab : $9FEC; Len : 15),
(Tab : $2100; Len : 8), (Tab : $9FDC; Len : 15), (Tab : $9FCC; Len : 15),
(Tab : $F000; Len : 9), (Tab : $7D7C; Len : 15), (Tab : $7D6C; Len : 15),
(Tab : $3A40; Len : 14), (Tab : $AB40; Len : 15), (Tab : $AB38; Len : 15),
(Tab : $AB30; Len : 15), (Tab : $AB28; Len : 15), (Tab : $AB20; Len : 15),
(Tab : $AB18; Len : 15), (Tab : $AB70; Len : 13), (Tab : $AB10; Len : 15),
(Tab : $AB08; Len : 15), (Tab : $AB00; Len : 15), (Tab : $AAF8; Len : 15),
(Tab : $AAF0; Len : 15), (Tab : $3B00; Len : 9), (Tab : $AAE8; Len : 15),
(Tab : $AAE0; Len : 15), (Tab : $AAD8; Len : 15), (Tab : $AAD0; Len : 15),
(Tab : $AB64; Len : 14), (Tab : $7D30; Len : 12), (Tab : $AAC8; Len : 15),
(Tab : $AAC0; Len : 15), (Tab : $AAB8; Len : 15), (Tab : $AAB0; Len : 15),
(Tab : $AAA8; Len : 15), (Tab : $AAA0; Len : 15), (Tab : $AA98; Len : 15),
(Tab : $AA90; Len : 15), (Tab : $AA88; Len : 15), (Tab : $AA80; Len : 15),
(Tab : $9FF8; Len : 15), (Tab : $9FF0; Len : 15), (Tab : $9FE8; Len : 15),
(Tab : $9FE0; Len : 15), (Tab : $9FD8; Len : 15), (Tab : $9FD0; Len : 15),
(Tab : $9FC8; Len : 15), (Tab : $9FC0; Len : 15), (Tab : $7D78; Len : 15),
(Tab : $7D70; Len : 15), (Tab : $3A58; Len : 13), (Tab : $7D68; Len : 15),
(Tab : $7D60; Len : 15), (Tab : $AB46; Len : 15), (Tab : $AB42; Len : 15),
(Tab : $AB3E; Len : 15), (Tab : $AB3A; Len : 15), (Tab : $AB36; Len : 15),
(Tab : $AB32; Len : 15), (Tab : $AB2E; Len : 15), (Tab : $AB2A; Len : 15),
(Tab : $AB26; Len : 15), (Tab : $AB22; Len : 15), (Tab : $AB1E; Len : 15),
(Tab : $AB1A; Len : 15), (Tab : $AB16; Len : 15), (Tab : $AB12; Len : 15),
(Tab : $AB0E; Len : 15), (Tab : $AB0A; Len : 15), (Tab : $AB06; Len : 15),
(Tab : $AB02; Len : 15), (Tab : $AAFE; Len : 15), (Tab : $AAFA; Len : 15),
(Tab : $AAF6; Len : 15), (Tab : $AAF2; Len : 15), (Tab : $AAEE; Len : 15),
(Tab : $AAEA; Len : 15), (Tab : $AAE6; Len : 15), (Tab : $AAE2; Len : 15),
(Tab : $AADE; Len : 15), (Tab : $AADA; Len : 15), (Tab : $AAD6; Len : 15),
(Tab : $AAD2; Len : 15), (Tab : $AACE; Len : 15), (Tab : $AACA; Len : 15),
(Tab : $AAC6; Len : 15), (Tab : $AAC2; Len : 15), (Tab : $AABE; Len : 15),
(Tab : $AABA; Len : 15), (Tab : $AAB6; Len : 15), (Tab : $AAB2; Len : 15),
(Tab : $AAAE; Len : 15), (Tab : $AAAA; Len : 15), (Tab : $AAA6; Len : 15),
(Tab : $AAA2; Len : 15), (Tab : $AA9E; Len : 15), (Tab : $3A44; Len : 15),
(Tab : $AA9A; Len : 15), (Tab : $AA96; Len : 15), (Tab : $AA92; Len : 15),
(Tab : $3080; Len : 9), (Tab : $AA8E; Len : 15), (Tab : $AA8A; Len : 15),
(Tab : $AA86; Len : 15), (Tab : $AA82; Len : 15), (Tab : $9FFE; Len : 15),
(Tab : $9FFA; Len : 15), (Tab : $9FF6; Len : 15), (Tab : $9FF2; Len : 15),
(Tab : $9FEE; Len : 15), (Tab : $9FEA; Len : 15), (Tab : $9FE6; Len : 15),
(Tab : $9FE2; Len : 15), (Tab : $9FDE; Len : 15), (Tab : $9FDA; Len : 15),
(Tab : $9FD6; Len : 15), (Tab : $9FD2; Len : 15), (Tab : $9FCE; Len : 15),
(Tab : $9FCA; Len : 15), (Tab : $9FC6; Len : 15), (Tab : $9FC2; Len : 15),
(Tab : $7D7E; Len : 15), (Tab : $7D7A; Len : 15), (Tab : $7D76; Len : 15),
(Tab : $7D72; Len : 15), (Tab : $7D6E; Len : 15), (Tab : $7D6A; Len : 15),
(Tab : $7D66; Len : 15), (Tab : $7D62; Len : 15), (Tab : $3A46; Len : 15),
(Tab : $3A70; Len : 12), (Tab : $AAC4; Len : 15), (Tab : $9FE4; Len : 15));
{Kompressionsroutine}
Function Compress (* Zeile : String, Kanal : Byte) : String *);
Var Hs2, Hstr : String;
t : Word;
s : Word;
i : Byte;
a : Integer;
b,c : Byte;
ch,ch2 : Char;
long : Boolean;
lang1,
lang2,
rate,
diff : byte;
s1:string;
Begin
lang2:=length(zeile);
hstr:='';
FillChar(Hstr,SizeOf(Hstr),0);
a := 7;
b := 1;
long := false;
diff:=1;
if K[Kanal]^.KompressUpd then
begin
Zeile:='';
for i:=1 to 127 do
Zeile:=Zeile+chr(K[Kanal]^.Kompression[i]);
end;
i := 0;
While (i < length(Zeile)) and not long do
begin
inc(i);
t := HTable[ord(Zeile[i])].Tab;
s := $8000;
C := 0;
While (C < HTable[ord(Zeile[i])].Len) and not long do
begin
inc(C);
if t and s = s then Hstr[b] := Chr(ord(Hstr[b]) + 1 shl a);
s := s shr 1;
dec(a);
if a < 0 then
begin
a := 7;
inc(b);
if b > 254 then long := true;
end;
end;
Hstr[0] := chr(b);
end;
if (length(Hstr) > length(Zeile)) or long then
begin
Hstr := Zeile[0] + ccoding(kanal, Zeile);
ch := #255;
diff:=2;
end else ch := Chr(length(Hstr));
Hstr := ch + Hstr;
ch2:=ch;
if (K[Kanal]^.CompC) and (not K[kanal]^.KompressUpd) then
begin
Hs2:='';
for i := 3 to length(Hstr) do
begin
Hstr[i] := Chr(Ord(Hstr[i]) xor K[Kanal]^.Kompression[i]);
end;
end;
if K[Kanal]^.KompressUpd then
begin
Hs2:='';
for i := 3 to length(Hstr) do
begin
Hstr[i] := Chr(Ord(Hstr[i]) xor Comp_Key_Tab [I]);
end;
K[Kanal]^.KompressUpd:=false;
k[kanal]^.FileSendWait:=k[kanal]^.fileSendWaitS;
end;
TestCom:=hstr;
Compress:=Hstr;
lang1:=length(hstr)-diff;
rate:=CompRate(Lang1, Lang2);
if rate>=100 then rate:=k[kanal]^.tXKompRate;
k[kanal]^.tXKompRate:=rate;
SetzeFlags(kanal);
End;
{Dekompressions-Routine}
Function DeCompress (* Zeile : String, Kanal : Byte) : String *);
Var Hstr, Hstr2 : String;
b,i,i1,l : Byte;
a : Integer;
t,t2 : Word;
Bit : LongInt;
ch : Char;
lang1,
rate,
lang2 : Byte;
s2:string;
Begin
lang1:=length(zeile)-1;
Hstr:='';
Hstr2:='';
if kanal=0 then delete(Zeile, Length(Zeile),1);
if K[Kanal]^.KompressUpd then
begin
for i := 3 to length(Zeile) do
begin
Zeile[i] := Chr(Ord(Zeile[i]) xor Comp_Key_Tab[I]);
end;
end else Hstr2:=Zeile;
if (K[Kanal]^.CompC) and (not K[kanal]^.KompressUpd) then
begin
for i := 3 to length(Zeile) do
begin
Zeile[i] := Chr(Ord(Zeile[i]) xor K[Kanal]^.Kompression[I]);
end;
end else Hstr2:=Zeile;
HStr:=''; i:=0;
ch := Zeile[1];
delete(Zeile,1,1);
if ch = #255 then
begin
delete(Zeile,1,1);
if lang1>0 then dec(lang1);
end;
if (ch < #255) and (Zeile[0] > #0) then
begin
Hstr := '';
l := 0;
Bit := 0;
for i := 1 to length(Zeile) do
begin
Bit := (Bit shl 8) or ord(Zeile[i]);
l := Byte(l + 8);
a := 0;
Repeat
b := HTable[a].Len;
if l >= b then
begin
t := HTable[a].Tab;
t2 := Word(Bit shr (l-b)) shl (16-b);
if t = t2 then
begin
Hstr := Hstr + chr(a);
l := l - b;
a := -1;
end;
end;
inc(a);
Until (a > 257) or (l < 3);
end;
end else Hstr := Zeile;
if K[Kanal]^.KompressUpd then
begin
for i:=1 to length(Zeile) do
begin
inc(K[Kanal]^.CompCUpdZahl);
K[Kanal]^.Kompression[K[Kanal]^.CompCUpdZahl]:=ord(Zeile[i]);
if K[Kanal]^.CompCUpdZahl=127 then
begin
k[kanal]^.KompressUpd:=false;
k[kanal]^.FileSendWait:=k[kanal]^.fileSendWaitS;
For i1:=1 to 127 do
k[kanal]^.Kompression[i1+127]:=k[kanal]^.Kompression[i1] xor Comp_Key_Tab[I1];
k[kanal]^.Kompression[255]:=k[kanal]^.Kompression[1];
end;
end;
zeile:='';
Hstr:='';
end;
DeCompress := Hstr;
lang2:=length(hstr);
rate:=CompRate(Lang1, Lang2);
if rate>=100 then rate:=k[kanal]^.RXKompRate;
k[kanal]^.RXKompRate:=rate;
setzeflags(kanal);
End;
Reference in New Issue View Git Blame Copy Permalink