1186 lines
31 KiB
Plaintext
Executable File
1186 lines
31 KiB
Plaintext
Executable File
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
|
||
³ ³
|
||
³ 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;
|