You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

1186 lines
31 KiB

{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P A U S . P A S ³
³ ³
³ Routinen f<>r diverse Ausgaben. (Bildschirm, Morsezeichen ... usw.) ³
³ Desweiteren Speicherung der Backsrolltexte. ³
³ ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Procedure Scroll (* Art : str2; Aufruf,Y1,Y2 : Byte *); (* Video-Ram scrollen *)
Var i : Byte;
Begin
if not ((Aufruf = 0) and BackScroll(show)) then
begin
if Art = Up then { Aufw„rts scrollen }
begin
if ScrollVor or not NowFenster or ((Y2 = maxZ) and (show > 0)) then
move(Bild^[Y1*160+1],Bild^[((Y1-1)*160)+1],(Y2-Y1)*160) else
begin
for i := 0 to 2 do { nur links und rechts vom Fenster wird gescrollt }
begin
move(Bild^[(Y1+i)*160+1],Bild^[((Y1-1+i)*160)+1],(XL-1)*2);
move(Bild^[(Y1+i)*160+1+2*(XR-1)],Bild^[((Y1-1+i)*160)+1+2*(XR-1)],(81-XR)*2);
end; { Unter dem Fenster werden wieder alle Zeilen komplett gescrollt }
if Y2-Y1-3 > 0 then
move(Bild^[(Y1+3)*160+1],Bild^[((Y1+2)*160)+1],(Y2-Y1-3)*160);
end; { Abw„rts scrollen }
end else move(Bild^[((Y1-1)*160)+1],Bild^[(Y1)*160+1],(Y2-Y1)*160);
ScrollVor := false;
end;
End;
Procedure _aus (* Attr,Kanal : Byte; Zeile : String *);
Var i,X2M : Byte;
ch : Char;
Aktuell : Boolean;
Hstr : String[80];
hstr2 : string;
Begin
Aktuell := (Kanal = show) and not BackScroll(Kanal);
with K[Kanal]^ do
Begin
While pos(^J,Zeile) > 0 do delete(Zeile,pos(^J,Zeile),1);
{ if kanal>0 then
while pos(chr(9), zeile) do
begin
i:=pos(chr(9), zeile);
end;} {while}
Hstr := '';
X2M := X2;
if Save and not RX_Save then Write_SFile(Kanal,Zeile);
if Drucker then Write_Drucker(Kanal,Zeile);
Zeile := Line_Convert(Kanal,2,Zeile);
if (pos(^G,Zeile) > 0) and
not(Ignore or RX_Save or EigFlag or RemFlag or FileFlag or Mo.MonActive) and
TNC_ReadOut and CtrlBeep then Beep(G^.CTRL_G_Freq,G^.CTRL_G_Time);
if Rx_Beep and Aktuell and Klingel then
begin
LockIntFlag(0);
Beep(G^.RxPiepFreq,G^.RxPiepTime);
LockIntFlag(1);
end;
for i := 1 to ord(Zeile[0]) do
begin
ch := Zeile[i];
if ch = #0 then ch := #255;
if RxLRet then
begin
if (X2 > 80) and (ch = M1) then ch := ^J;
Write_Notstr(Kanal,M1);
Write_Notstr(Kanal,chr(ChAttr(Attr)));
if Aktuell then
begin
if Hstr > '' then
if BiosOut then WriteBios(Kanal,X2M,QEnd,Attr,0,Hstr)
else WritePage(Kanal,X2M,QEnd,Attr,0,Hstr);
Scroll(Up,0,QBeg,QEnd);
WriteRam(1,QEnd,Attr,0,G^.Leer);
end;
if (NeueZeilen < N999) then inc(NeueZeilen);
Hstr := '';
X2M := 1;
X2 := 1;
end;
RxLRet := false;
if ch = M1 then RxLRet := true else
if ch <> ^J then
begin
Write_Notstr(Kanal,ch);
Hstr := Hstr + ch;
inc(X2);
if X2 > 80 then RxLRet := true;
end;
end; (* for i := ... *)
Write_Notiz(Kanal);
if (Hstr > '') and Aktuell then
if BiosOut then WriteBios(Kanal,X2M,QEnd,Attr,0,Hstr)
else WritePage(Kanal,X2M,QEnd,Attr,0,Hstr);
End;
End;
Function CallInBox(Box, Such:str9) : boolean;
var cib:boolean;
ci:byte;
begin
cib:=false;
{ for ci:=1 to maxMailFrames do
begin
if (Mail[ci].BoxCall=Box) and (UpcaseStr(Such)=Mail[ci].ZielCall) then Cib:=true;
end;}
CallInBox:=cib;
end;
Procedure M_aus (* Attr : Byte; Zeile : String ; Kanal : Byte *);
Var mfs,mfsc,i,j,ij,mc,X2M : Byte;
ch : Char;
Hstr : String[80];
MFlaggi,
Flag,
Output,
PlenOn,
Aktuell : Boolean;
MailFrErk : Boolean;
MailZeile : String;
MailFlag : Boolean;
MailFTemp : string;
OCall : str20;
MailCalls : string;
HCall,hcall2, Box:str9;
Begin
MailFrErk:=false;
MailFlag:=false;
Aktuell := show = 0;
MailZeile:='';
ij:=0;i:=0;mc:=0;
mfs:=0;
Output := ((K[show]^.UnStat < maxZ) or Aktuell) and not Backscroll(0);
with K[0]^ do
Begin
if Save then Write_SFile(0,Zeile);
if Drucker then Write_Drucker(0,Zeile);
Zeile := Line_Convert(0,2,Zeile);
Hstr := '';
X2M := X2;
Flag := false;
for i := 1 to ord(Zeile[0]) do
begin
ch := Zeile[i];
if ch = #0 then ch := #255;
if RxLRet then
begin {or (ch = ^J)}
if (X2 > 80) and ((ch = M1)) or (ch = ^J) then Flag := true;
Write_Notstr(0,M1);
Write_Notstr(0,chr(ChAttr(Attr)));
if Output then
begin
if Hstr > '' then WritePage(0,X2M,maxZ,Attr,1,Hstr);
if Aktuell then Scroll(Up,0,UnStat+1,maxZ)
else Scroll(Up,1,K[show]^.UnStat+1,maxZ);
WriteRam(1,maxZ,Attr,1,G^.Leer);
end;
if (NeueZeilen < N999) then inc(NeueZeilen);
Hstr := '';
X2 := 1;
X2M := 1;
end;
RxLRet := false;
{ ch=^J or }
if (ch = ^J) or (ch = M1) then
begin
if not Flag then RxLRet := true;
if ZeigeRet and (ch = M1) then
begin
RxLRet := true;
Write_Notstr(0,^J);
Hstr := Hstr + ^J;
inc(X2);
end;
end else if not Flag then
begin
Write_Notstr(0,ch);
Hstr := Hstr + ch;
inc(X2);
if X2 > 80 then RxLRet := true;
end;
Flag := false;
end;
Write_Notiz(0);
if (Hstr > '') and Output then WritePage(0,X2M,maxZ,Attr,1,Hstr);
end;
End;
Procedure Write_Notiz; (* Kanal : Integer *)
var l : Byte;
i : Word;
i1 : Integer;
Hstr : string;
Begin
with K[Kanal]^ do
begin
l := ord(NZeile[0]);
if use_EMS then EMS_Seite_einblenden(Kanal,Scr);
if use_Vdisk then Open_Scroll(Kanal);
if NotPos + l > (maxNotCh-1) then
begin
i1 := NotPos + l - (maxNotCh-1);
if use_Vdisk then
begin
Hstr := copy(NZeile,1,(maxNotCh-1)-NotPos);
BlockWrite(ScrollFile,Hstr[1],length(Hstr),i);
delete(NZeile,1,(maxNotCh-1)-NotPos);
Seek(ScrollFile,Pos_im_Scr);
BlockWrite(ScrollFile,NZeile[1],length(NZeile),i);
end else
if use_XMS then
begin
Data_to_XMS(@NZeile[1],XMS_Handle,Pos_im_Scr+NotPos,(maxNotCh-1)-NotPos);
Data_to_XMS(@NZeile[(maxNotCh-1)-NotPos+1],XMS_Handle,Pos_im_Scr,i1);
NotPos := i1;
end else
begin
move(NZeile[1],NotCh[Kanal]^[NotPos],(maxNotCh-1)-NotPos);
move(NZeile[(maxNotCh-1)-NotPos+1],NotCh[Kanal]^[0],i1);
NotPos := i1;
end;
end else
begin
if use_Vdisk then
begin
BlockWrite(ScrollFile,NZeile[1],l,i);
end else if use_XMS then
begin
Data_to_XMS(@NZeile[1],XMS_Handle,Pos_im_Scr+NotPos,l);
NotPos := NotPos + l;
end else
begin
move(NZeile[1],NotCh[Kanal]^[NotPos],l);
NotPos := NotPos + l;
end;
end;
if use_Vdisk then Close_Scroll(Kanal);
NZeile := '';
end; { with }
End;
Procedure Write_Notstr (* Kanal : Byte; ch : char *);
Begin
with K[Kanal]^ do
begin
if length(NZeile) >= 255 then Write_Notiz(Kanal);
NZeile := NZeile + ch;
end;
End;
Procedure Write_BoxStr (* Kanal,Art : Byte *);
var HStr, Zstr : String[40];
Ach : Char;
i,lp : Byte;
Result : Word;
Nr : LongInt;
FBBAuswert,
RubHeader,
RunHeader,
Checks,
Lists : Boolean;
Begin
Checks := false;
Lists := false;
RubHeader := false;
RunHeader := false;
lp := 1;
FillChar(G^.MlStr,SizeOf(G^.MlStr),0);
Zstr := '';
Ach := 'U';
with K[Kanal]^ do
begin
if Art = 0 then
begin
if SCon[2] then (* BBOX *)
begin
i := pos(') ',BoxStr);
if (i > 0) and (i < 8) and (pos('(',BoxStr) <> 1) then BoxStr[i] := B1;
i := pos('R ',BoxStr);
if (i > 0) and (i < 8) and (str_int(copy(BoxStr,1,i-1)) > 0) then
begin
BoxStr[i] := B1;
BoxStr[i+1] := 'r';
end;
i := pos('F ',BoxStr);
if (i > 0) and (i < 8) and (str_int(copy(BoxStr,1,i-1)) > 0) then
begin
BoxStr[i] := B1;
BoxStr[i+1] := 'f';
end;
i := pos('E ',BoxStr);
if (i > 0) and (i < 8) and (str_int(copy(BoxStr,1,i-1)) > 0) then
begin
BoxStr[i] := B1;
BoxStr[i+1] := 'e';
end;
end;
for i := 1 to maxBlBox do
begin
G^.MlStr[i] := ParmStr(i,B1,BoxStr);
if length(G^.MlStr[i]) > 0 then lp := i;
end;
Nr := LongInt(str_int(G^.MlStr[1]));
if Nr > 0 then (* Hier war die erste Sequenz eine Nummer *)
begin
{Check-Befehl auswerten}
if SCon[1] or SCon[2] or SCon[14] then (* DBOX oder BBOX oder TBOX im Connect *)
begin
if (G^.MlStr[3] = '>') and (copy(G^.MlStr[5],3,1) = Pkt ) and
(copy(G^.MlStr[5],6,1) = Pkt ) then
begin
Checks := true;
Ach := 'C';
Rubrik := copy(G^.MlStr[4],1,8);
i := pos(Pkt ,Rubrik);
if i > 0 then Rubrik := copy(Rubrik,1,i-1);
Rubrik := EFillStr(8,B1,Rubrik);
end else if (copy(G^.MlStr[3],3,1) = Pkt ) and (copy(G^.MlStr[3],6,1) = Pkt ) and
(str_int(G^.MlStr[5]) > 0) then
begin
Lists := true;
Ach := 'L';
end;
end;
if SCon[3] then (* FBOX *)
begin {(pos('@',BoxStr) in [23..26])}
FBBAuswert:=false;
if FBBStreng then
begin
if (pos('/',BoxStr) in [42..46]) and
(LongInt(str_int(copy(BoxStr,pos('/',Boxstr)+1,4))) > 0) and
(LongInt(str_int(copy(BoxStr,pos('/',Boxstr)-4,4))) > 0)
and ((LongInt(str_int(copy(BoxStr,13,5))) > 0)
or (LongInt(str_int(copy(BoxStr,11,5))) > 0)) then FBBAuswert:=true;
end else
begin
Hstr:=copy(BoxStr,1,6);
KillEndBlanks(HSTR);
nr:=str_int(hstr);
if ( nr > 0) and (pos('@',BoxStr) > 6) then FBBAuswert:=true;
end;
if FBBAuswert then
begin
Checks := true;
Ach := 'C';
if pos('@',BoxStr)>0 then
begin
Rubrik := EFillStr(8,B1,copy(BoxStr,pos('@',BoxStr)-7,6));
killStartBlanks(Rubrik);
end
else Rubrik := EFillStr(8,B1,' ')
end;
end;
if SCon[4] then (* WBOX *)
begin
if (pos('@',BoxStr) = 22) and
(LongInt(str_int(G^.MlStr[2])) > 0) then
begin
Checks := true;
Ach := 'C';
Rubrik := EFillStr(8,B1,copy(BoxStr,14,8));
end;
end;
if SCon[5] then (* EBOX *) (* Die EBOX ist nur eine lokale Box *)
begin
Zstr := UpCaseStr(G^.MlStr[8]);
if (Word(str_int(G^.MlStr[2])) > 0) and
(Word(str_int(G^.MlStr[7])) > 0) and
((Zstr = 'T') or (Zstr = 'D')) then
begin
Lists := true;
Rubrik := ConstStr(B1,8);
Ach := 'L';
end;
end;
end else
begin
if SCon[1] or SCon[2] then (* DBox + BBox *)
begin
if ((pos(G^.BinEL,BoxStr) = 1) or (pos(G^.TxtEL,BoxStr) = 1)) and
(LongInt(str_int(G^.MlStr[3])) > 0) then
begin
BoxStr := EFillStr(45,B1,RunRub + G^.MlStr[2]) +
SFillStr(8,B1,G^.MlStr[3]) + B1 + OneByte + B1 +
copy(G^.MlStr[5],1,6) +
copy(G^.MlStr[5],9,2) + B1 +
copy(G^.MlStr[6],1,5) + B1 +
G^.MlStr[1];
Ach := 'R';
Lists := true;
end else
if ((pos(G^.BinEL,BoxStr) = 1) or (pos(G^.TxtEL,BoxStr) = 1)) and
(LongInt(str_int(G^.MlStr[2])) > 0) then
begin
BoxStr := EFillStr(45,B1,G^.MlStr[5]) +
SFillStr(8,B1,G^.MlStr[2]) + B1 + OneByte + B1 +
EFillStr(15,B1,G^.MlStr[4]) +
G^.MlStr[1];
Ach := 'R';
Lists := true;
end else
if (pos(G^.DirEL,BoxStr) = 1) and
(copy(G^.MlStr[2],length(G^.MlStr[2]),1) = BS ) and
(pos(Pkt ,G^.MlStr[4]) = 3) and
(pos(DP,G^.MlStr[5]) = 3) then
begin
BoxStr := EFillStr(74,B1,RunRub + G^.MlStr[2]) + CutStr(BoxStr);
Ach := 'V';
Lists := true;
end else
if (copy(BoxStr,length(G^.MlStr[1]),1) = BS ) and
(pos('Datei',G^.MlStr[3]) = 1) and
(G^.MlStr[5] = OneByte) and
(pos('Unterverzeichnis',G^.MlStr[7]) = 1) then
begin
BoxStr := EFillStr(40,B1,RunRub + CutStr(BoxStr)) +
SFillStr(3,B1,int_str(str_int(G^.MlStr[2]))) + B1 + Files + B1 +
SFillStr(8,B1,G^.MlStr[4]) + B1 + OneByte +
SFillStr(4,B1,int_str(str_int(G^.MlStr[6]))) + B1 + DIRs;
Ach := 'V';
Lists := true;
end else
if (copy(BoxStr,3,1) = Pkt ) and
(copy(BoxStr,6,1) = Pkt ) and
(copy(BoxStr,11,2) = ' ') and
(pos(':\',G^.MlStr[2]) = 2) and
(pos(B1,G^.MlStr[2]) = 0) then
begin
BoxStr := RestStr(BoxStr);
Ach := 'V';
Lists := true;
end else
if pos(G^.RunElFile,BoxStr) = 1 then
begin
{ Dateien im Unterverzeichnis: D:\DISKTOOL\*.* }
RunRub := G^.MlStr[lp];
While (RunRub[0] > #0) and (RunRub[Ord(RunRub[0])] <> BS )
do RunRub[0] := Chr(Ord(RunRub[0])-1);
Rubrik := ConstStr(B1,8);
RubHeader := true;
RunHeader := true;
end else
if pos(G^.RunElDir,BoxStr) = 1 then
begin
{ Unterverzeichnisse von: D:\*.* }
RunRub := G^.MlStr[lp];
While (RunRub[0] > #0) and (RunRub[Ord(RunRub[0])] <> BS )
do RunRub[0] := Chr(Ord(RunRub[0])-1);
Rubrik := ConstStr(B1,8);
RubHeader := true;
RunHeader := true;
end else
if pos(G^.RunElTree,BoxStr) = 1 then
begin
{ Verzeichnisbaum fuer EL-Laufwerk/EL-Pfad: D:\EL\ }
RunRub := G^.MlStr[lp];
Rubrik := ConstStr(B1,8);
RubHeader := true;
RunHeader := true;
end;
end;
{ Check-Liste erkennen //db1ras }
{ # Call File Nr. Datum @MBX Bytes #LT Titel }
{ # Absender Rubrik Nr. Datum @BBS Bytes #LT Titel }
{ ^ ^ ^ wird geprueft }
If (SCon[1] Or SCon[2]) And { * DBOX * oder * BBOX * }
(Length(BoxStr)>54) And (BoxStr[5]='#') And
(BoxStr[38]='@') And (BoxStr[51]='#') Then Begin
RubHeader := true;
Rubrik := '';
End;
if SCon[1] then (* DBox *)
begin
if (pos(G^.InfoDieBox,BoxStr) = 1) or (pos(G^.UserDieBox,BoxStr) = 1) or
(pos(G^.RubrikStr,BoxStr) = 1) then
begin
RubHeader := true;
Rubrik := EFillStr(8,B1,RestStr(BoxStr));
end;
end;
{ Inhaltsverzeichnis fuer DF8MT @DB0GV: }
{ Inhaltsverzeichnis fuer COMPUTER/IBM: }
if SCon[2] then (* BBOX *)
begin
if pos(G^.InfoBayBox,BoxStr) = 1 then
begin
RubHeader := true;
Zstr := G^.MlStr[3];
While pos('/',Zstr) > 0 do delete(Zstr,1,pos('/',Zstr));
While pos(DP,Zstr) > 0 do delete(Zstr,pos(DP ,Zstr),1);
Rubrik := EFillStr(8,B1,Zstr);
end;
end;
if SCon[5] then (* EBOX *)
begin
if (pos(G^.EzFileStr,BoxStr) = 1) or (pos(G^.EzMsgStr,BoxStr) = 1) then
begin
RubHeader := true;
Rubrik := ConstStr(B1,8);
end;
end;
if SCon[14] then (* TBOX *)
begin
Zstr := RestStr(BoxStr);
if (pos(G^.InfoTnc3Box,BoxStr) = 1) and (Zstr[length(Zstr)] = DP) then
begin
delete(Zstr,length(Zstr),1);
RubHeader := true;
Rubrik := EFillStr(8,B1,Zstr);
end;
end;
if RubHeader then
begin
if RunHeader then
BoxStr := GPkt + B1 + Call + B1 + GPkt + B1 + copy(Datum,1,8)
+ B1 + copy(Uhrzeit,1,5) + B1 + GPkt + B1 + RunRub
else If Rubrik='' Then
{Check-Liste //db1ras}
BoxStr := GPkt + B1 + Call + B1 + GPkt + B1 + copy(Datum,1,8)
+ B1 + copy(Uhrzeit,1,5) + B1 + GPkt + B1
+ 'Check'
else
BoxStr := GPkt + B1 + Call + B1 + GPkt + B1 + copy(Datum,1,8)
+ B1 + copy(Uhrzeit,1,5) + B1 + GPkt + B1
+ G^.RubrikStr + Rubrik;
KillEndBlanks(BoxStr);
BoxStr := BoxStr + B1;
if Ord(BoxStr[0]) > 80 then BoxStr[0] := Chr(80);
BoxStr := EFillStr(79,GPkt,BoxStr) + B2;
BoxStr[81] := Chr(Attrib[20]);
Ach := 'R';
end;
end;
end;
if (Art = 1) or Checks or Lists or RubHeader then
begin
if length(BoxStr) < 80 then
BoxStr := EFillStr(80,B1,BoxStr) + Chr(Attrib[18]);
BoxStr := BoxStr + Ach + Chr(SysArt) + Rubrik;
Seek(DBox,FSize);
BlockWrite(DBox,BoxStr[1],1,Result);
FSize := FilePos(DBox);
inc(NewChkLst);
end;
FillChar(BoxStr,SizeOf(BoxStr),0);
end;
End;
Procedure Morse (* Kanal : Byte; Zeile : str80 *);
var i,i1,i2 : Byte;
VC : char;
Begin
for i := 1 to length(Zeile) do
begin
VC := UpCase(Zeile[i]);
i1 := 1;
LockIntFlag(0);
While (i1 < maxMorAnz) and (Mchs[i1].Ze <> VC) do inc(i1);
if Mchs[i1].Ze = VC then
begin
for i2 := 1 to length(Mchs[i1].Co) do
begin
case Mchs[i1].Co[i2] of
Pkt : Beep(G^.Tonhoehe,MPause);
'-' : Beep(G^.Tonhoehe,3 * MPause);
end;
Verzoegern(MPause);
end;
Verzoegern(2 * MPause);
end else
if VC = B1 then Verzoegern(7 * MPause) else
begin
Sound_((G^.Tonhoehe div 3) * 2, Mpause div 14);
Verzoegern(MPause);
end;
LockIntFlag(1);
end;
End;
Function CompRate (Compri, DeCompri : Byte) : Byte;
var cra1:real;
begin
if Compri=0 then Compri:=1;
if DeCompri=0 then DeCompri:=1;
cra1:=100 / Decompri;
cra1:=cra1 * Compri;
CompRate:=Round(Cra1);
end;
{ACHTUNG: F<>r offizielle Version nur zwischen den Marken einklammern!!!}
function CCoding (kanal : Byte; zeile:string) : string;
var i,j,l,x,y,z:byte;
hstr:string;
codcall:string;
const teiler=8;
begin
{F<>r offizielle Version hier Klammer AUF - bzw. Def-Schalter abw<62>rgen}
{$IFDEF code}
codcall:=k[kanal]^.call;
strip(codcall);
if (codcall='KA1SH') or (codcall='DAB365') or (codcall='DKA777')
or (codcall='DCW763') or (codcall='CW1MOB') then
begin
hstr:=zeile;
zeile:='';
for i:=1 to length(hstr) do Zeile:=zeile+hstr[length(hstr)-i+1];
for i:=1 to length(zeile) do zeile[i]:=chr(ord(Zeile[i]) xor codierung[i]);
x:=length(zeile);
hstr:=zeile;
if x>teiler-1 then
begin
z:=x;
y:=1;
while z>teiler do
begin
inc(y);
z:=x div y;
end;
x:=z div 2+1;
i:=2; l:=1;
while i<253 do
begin
if z=i then begin
dec(x);
l:=0;
end;
inc(i,2);
end;
zeile:='';
{z=anzahl zeichen/gruppe, y=anzahl gruppen, x=mitte}
for j:=1 to y do
begin
if length(hstr)>=z then
begin
for i:=1 to x do
begin
zeile:=zeile+hstr[z-i+1];
end;
for i:=1 to x-l do
begin
zeile:=zeile+hstr[i];
end;
delete(hstr,1,z);
end;
end;
zeile:=hstr+zeile;
end;
end;
{F<>r offizielle Version hier Klammer zu!}
{$ENDIF}
ccoding:=zeile;
end;
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);
{if hstr[length(hstr)]=#0 then hstr[0]:=chr(b-1);}
end;
{****************************** codierung *********}
{$IFDEF code}
hstr:=ccoding(kanal, hstr);
{$ENDIF}
{*************************************}
{ if not K[Kanal]^.KompressUpd then
begin}
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;
{ end;}
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;
{$IFDEF code}
function CDECoding (kanal : Byte; zeile:string) : string;
var i,j,l,x,y,z:byte;
hstr:string;
codcall:string;
const teiler=8;
begin
codcall:=k[kanal]^.call;
strip(codcall);
if (codcall='KA1SH') or (codcall='DAB365') or (codcall='DKA777')
or (codcall='DCW763') or (codcall='CW1MOB') then
begin
if not k[kanal]^.mo.monactive then
begin
hstr:=zeile;
x:=length(zeile);
if x>teiler-1 then
begin
zeile:='';
z:=x;
y:=1;
while z>teiler do
begin
inc(y);
z:=x div y;
end;
x:=x-(z*y);
codcall:='';
codcall:=copy(hstr,1,x);
delete(hstr,1,x);
hstr:=hstr+codcall;
x:=z div 2+1;
i:=2;
l:=1;
while i<253 do
begin
if z=i then
begin
dec(x);
l:=0;
end;
inc(i,2);
end;
for j:=1 to y do
begin
if length(hstr)>=z then
begin
for i:=x-l downto 1 do
begin
zeile:=zeile+hstr[z-i+1];
end;
for i:=x downto 1 do
begin
zeile:=zeile+hstr[i];
end;
delete(hstr,1,z);
end;
end;
hstr:=zeile+hstr;
end;
zeile:=hstr;
for i:=1 to length(hstr) do zeile[i]:=chr(ord(Zeile[i]) xor codierung[i]);
hstr:='';
for i:=1 to length(zeile) do hstr:=hstr+zeile[length(zeile)-i+1];
{hstr:=Zeile[1]+hstr;}
zeile:=hstr;
end;
end;
cdecoding:=zeile;
end;
{$ENDIF}
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;
{******************** DEcodierung ****************}
{$IFDEF code}
zeile:=CDEcoding(kanal, zeile);
{$ENDIF}
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;
(* if (K[Kanal]^.CompC) and (K[Kanal]^.Mo.MonActive) then
begin
{i!!!} for i1:=1 to 255 do K[Kanal]^.Kompression[i1]:=238;
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;
Function SPCompress (* 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;
Begin
lang2:=length(zeile);
FillChar(Hstr,SizeOf(Hstr),0);
a := 7;
b := 1;
long := false;
diff:=1;
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);
{ if hstr[length(hstr)]=#0 then Hstr[0] := chr(b-1);}
{mit dem fehlt das return einer zeile nach dekomp!}
end;
if (length(Hstr) > length(Zeile)) or long then
begin
Hstr := Zeile;
ch := #255;
(*diff:=2;*)
end else
begin
ch := Chr(length(Zeile));
{if zeile[length(zeile)]=#13 then }ch:=Chr(length(Zeile)-1)
end;
Hstr := ch + Hstr;
ch2:=ch;
TestCom:=hstr;
SPCompress:=Hstr;
lang1:=length(hstr)-diff;
rate:=CompRate(Lang1, Lang2);
if rate>=100 then rate:=k[kanal]^.tXKompRate;
k[kanal]^.tXKompRate:=rate;
SetzeFlags(kanal);
End;
Function SPDeCompress (* 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;
Begin
lang1:=length(zeile)-1;
Hstr:='';
Hstr2:='';
if kanal=0 then delete(Zeile, Length(Zeile),1);
Hstr2:=Zeile;
HStr:=''; i:=0;
if k[kanal]^.SPRxCount>=k[kanal]^.SPRxSoll then
begin
ch := Zeile[1];
delete(Zeile,1,1);
k[kanal]^.SPRXCount:=0;
k[kanal]^.SPRxSOLL:=ord (CH);
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;
{ hstr[0]:=ch;}
lang2:=length(hstr)-1;
k[kanal]^.SPRXCount:=k[kanal]^.SPRXCount+length(hstr);
if zeile[length(zeile)]=#13 then dec(lang2);
{if ord(ch)<>lang2 then hstr:='!!COMP FAILED!!'+hstr;}
SPDeCompress := Hstr;
rate:=CompRate(Lang1, Lang2);
if rate>=100 then rate:=k[kanal]^.RXKompRate;
k[kanal]^.RXKompRate:=rate;
setzeflags(kanal);
End;