Xpacket/XPLIB.PAS

2108 lines
47 KiB
Plaintext
Raw Permalink Normal View History

2019-05-15 00:31:19 +02:00
{<7B><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀ
<20> <20>
<20> X - P a c k e t <20>
<20> <20>
<20> <20>
<20> X P L I B . P A S Bestandteil der XPACT1.PAS <20>
<20> <20>
<20> Library - Unit mit oft ben<65>tigten Routinen <20>
<20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>}
Function Channel_ID (* Kanal : Byte) : Str5 *);
Var Bstr : String[5];
Begin
Bstr := TNC[K[Kanal]^.TncNummer]^.Ident;
if length(Bstr) > 0 then Bstr := Bstr + B1;
Channel_ID := Bstr;
End;
Procedure Warten;
Var KC : Sondertaste;
VC : Char;
Begin
Repeat Until _Keypressed;
_ReadKey(KC,VC);
End;
Procedure Triller;
Var i : Byte;
Begin
for i := 1 to 6 do
begin
Beep(600,50);
Beep(800,50);
end;
End;
PROCEDURE Warte (HdstlSec : WORD);
VAR wi : INTEGER;
wstd1, wmin1, wsec1, wsec1001 : Word;
wstd2, wmin2, wsec2, wsec1002 : Word;
wrsec, wrstd, wrmin, wrsec100 : word;
BEGIN
GETTIME (wstd1, wmin1, wsec1, wsec1001);
wrsec100 := 0;
wi := 0;
WHILE wrsec100 < HdstlSec DO
BEGIN
wi := wi + 1;
GETTIME (wstd2, wmin2, wsec2, wsec1002);
wrstd := wstd2 - wstd1;
wmin2 := wmin2 + (wrstd * 60);
wrmin := wmin2 - wmin1;
wsec2 := wsec2 + (wrmin * 60);
wrsec := wsec2 - wsec1;
wsec1002 := wsec1002 + (wrsec * 100);
wrsec100 := wsec1002 - wsec1001;
END;
END;
(*
Procedure Bimmel;
Const
Ton : array[1..8] of integer =
(670,530,595,400,400,595,670,530);
PauseT : array[1..8] of byte =
(40, 40, 40, 60, 40, 40, 40, 60);
PauseN : array[1..8] of byte =
(0, 0, 0, 60, 0, 0, 0, 0);
Var i : Byte;
kc: sondertaste;
vc:char;
Begin
I:=0;
while (i<8) and (not keypressed) do
begin
inc(i);
Sound_(Ton[i], PauseT[i]); Warte(PauseN[i]);
end;
if keypressed then _ReadKey(KC,VC);
End;
*)
Procedure Bimmel(kan:byte);
type
BimmelTon = Record
Ton, Lange : Word;
end;
Const BT2: array[0..8] of bimmelton =
((Ton:670; Lange:40), (Ton:530; Lange:40), (Ton:595; Lange:40),
(Ton:400; Lange:60), (Ton:0; Lange:60),
(Ton:400; Lange:40), (Ton:595; Lange:40), (Ton:670; lange:40),
(Ton:530; lange:60));
var BT: array[0..255] of bimmelton;
f: text;
s:string;
j,i:byte;
rem:boolean;
kc: sondertaste;
vc:char;
fst:file;
Begin
s:='';
s:=int_str(kan);
rem:=false;
{$IFDEF Sound}
if Konfig.WavOut then
begin
s:='RING'+s;
rem:=exists(Konfig.SpkVerz+s+'.wav');
if rem then WavStream:=WavStream+#2+EFillStr(8,B1,s)
else
begin
s:='RING';
rem:=exists(Konfig.SpkVerz+s+'.wav');
if rem then WavStream:=WavStream+#2+EFillStr(8,B1,s);
end;
end;
if Konfig.MidiOut then
begin
rem:=playmidi(konfig.spkverz+'RING'+s+'.MID');
if not rem then rem:=playmidi(konfig.spkverz+'RING.MID');
end;
{$ENDIF}
s:='';
if not rem then begin
fillchar(bt,sizeof(bt),0);
{$I-}
assign(f,Sys1Pfad+'RING.XP');
reset(f);
j:=0;
if ioresult=0 then
begin
while not eof(F) do
begin
Rem:=false;
readln(f, s);
if S[1]<>';' then
begin
BT[j].Ton := str_int(copy (s,1,pos(',',s)-1));
delete (s,1,pos(',',s));
BT[j].Lange := str_int(s);
inc(j);
end;
end;
close(F);
if ioresult=0 then i:=0;
end else for i:=0 to 8 do BT[i]:=BT2[i];
{$I+}
i:=0;
Repeat
if (BT[i].Lange>0) then
begin
if (BT[i].Ton)>0 then Sound_(BT[i].Ton,BT[i].Lange)
else warte(BT[i].Lange);
end else i:=254;
inc(i);
until (keypressed) or (i=255);
{ Folgende Zeile entfernt, damit beim Abbrechen von //ring und //bell kein
Tastendruck mehr verschluckt wird! //db1ras }
{ if keypressed then _ReadKey(KC,VC); }
end;
End;
Procedure StopWave_;
begin
{$IFDEF Sound}
if not Playing then
begin
if SoundBuffer<>NIL then StopWave;
WavFileOpen:=False;
end;
{$ENDIF}
end;
Procedure SprachWav;
var i:byte;
wavs:string;
begin
{$IFDEF Sound}
{Strip(Zeile);
for i:=1 to length(Zeile) do
begin}
wavs:='';
if playing then wavfileopen:=true;
if not playing then
begin
StopWAVE;
wavs:=Konfig.Spkverz+WavStream[1];
if WavStream[1]=#10 then Wavs:=Konfig.Spkverz+'10';
if WavStream[1]=#11 then Wavs:=Konfig.Spkverz+'11';
if WavStream[1]=#12 then Wavs:=Konfig.Spkverz+'12';
if WavStream[1]=#13 then Wavs:=Konfig.Spkverz+'13';
if WavStream[1]=#14 then Wavs:=Konfig.Spkverz+'14';
if WavStream[1]=#15 then Wavs:=Konfig.Spkverz+'15';
if wavstream[1]=#1 then {Connect-Bimmel}
begin
wavs:=Copy(WavStream,2,8);
KillEndBlanks(wavs);
delete(WavStream, 2,8);
wavs:=Konfig.SpkVerz+wavs;
end;
if wavstream[1]=#2 then {Disconnect}
begin
wavs:=Copy(WavStream,2,8);
KillEndBlanks(wavs);
delete(WavStream, 2,8);
wavs:=Konfig.SpkVerz+wavs;
end;
if wavstream[1]=#3 then {Reconnect}
begin
wavs:=Copy(WavStream,2,8);
KillEndBlanks(wavs);
delete(WavStream, 2,8);
wavs:=Konfig.SpkVerz+wavs;
end;
if wavstream[1]=#4 then {Bimmel}
begin
wavs:=Copy(WavStream,2,8);
KillEndBlanks(wavs);
delete(WavStream, 2,8);
wavs:=Konfig.SpkVerz+wavs;
end;
if wavstream[1]=#5 then {Weitercon-Bimmel}
begin
wavs:=Copy(WavStream,2,8);
KillEndBlanks(wavs);
delete(WavStream, 2,8);
wavs:=Konfig.SpkVerz+wavs;
end;
playwave(wavs +'.wav');
delete(wavstream, 1,1);
end;
{repeat until not Playing;
end;}
{$ENDIF}
end;
Procedure C_Bell;
type
BimmelTon = Record
Ton, Lange : Word;
end;
Const BT2: array[0..8] of bimmelton =
((Ton:1400; Lange:5), (Ton:1000; Lange:5), (Ton:1800; Lange:5),
(Ton:1400; Lange:5), (Ton:1000; Lange:5), (Ton:1800; Lange:5),
(Ton:1400; Lange:5), (Ton:1000; Lange:5), (Ton:1800; Lange:5));
var BT: array[0..255] of bimmelton;
f: text;
s:string;
j,i:byte;
rem:boolean;
kc: sondertaste;
vc:char;
fst:file;
Begin
s:=call;
strip(s);
rem:=false;
{$IFDEF Sound}
if Konfig.WavOut then
begin
rem:=exists(konfig.spkverz + s+'.WAV');
if rem then WavStream:=WavStream+#1+EFillStr(8,B1,s)
else
begin
s:='';
s:=int_str(kan);
s:='CBELL'+s;
rem:=exists(konfig.spkverz + s + '.WAV');
if rem then WavStream:=WavStream+#1+EFillStr(8,B1,s)
else
begin
s:='CBELL';
rem:=exists(konfig.spkverz+s+'.wav');
if rem then WavStream:=WavStream+#1+EFillStr(8,B1,s)
end;
end;
end;
If Konfig.MidiOut then
begin;
s:=call;
strip(s);
rem:=playmidi(konfig.spkverz+s+'.MID');
s:='';
s:=int_str(kan);
if not rem then rem:=playmidi(konfig.spkverz+'CBELL'+s+'.MID');
if not rem then rem:=playmidi(konfig.spkverz+'CBELL.MID');
end;
{$ENDIF}
if not rem then
begin
s:=call;
strip(s);
fillchar(bt,sizeof(bt),0);
{$I-}
assign(f,Sys1Pfad+s+'.CBL');
reset(f);
j:=0;
if ioresult=0 then
begin
while not eof(F) do
begin
Rem:=false;
readln(f, s);
if S[1]<>';' then
begin
BT[j].Ton := str_int(copy (s,1,pos(',',s)-1));
delete (s,1,pos(',',s));
BT[j].Lange := str_int(s);
inc(j);
end;
end;
close(F);
if ioresult=0 then i:=0;
end else for i:=0 to 8 do BT[i]:=BT2[i];
{$I+}
i:=0;
Repeat
if (BT[i].Lange>0) then
begin
if (BT[i].Ton)>0 then Sound_(BT[i].Ton,BT[i].Lange)
else warte(BT[i].Lange);
end else i:=254;
inc(i);
until (i=255);
{ Folgende Zeile entfernt, damit beim Connect kein Tastendruck mehr
verschluckt wird! //db1ras }
{ if keypressed then _ReadKey(KC,VC); }
end;
End;
(*
Var i : Byte;
Begin
if (Klingel) then
begin
for i := 1 to 3 do
begin
sound_(1400,5);
sound_(1000,5);
sound_(1800,5);
end;
end;
End;
*)
Procedure D_Bell; (* Klingel beim Disconnect *)
var rem:boolean;
var s:string[5];
Begin
s:='';
s:=int_str(kan);
rem:=false;
{$IFDEF Sound}
if Konfig.WavOut then
begin
s:='dbell'+s;
rem:=exists(Konfig.SpkVerz+s+'.wav');
if rem then WavStream:=WavStream+#2+EFillStr(8,B1,s)
else
begin
s:='DBELL';
rem:=exists(Konfig.SpkVerz+s+'.wav');
if rem then WavStream:=WavStream+#2+EFillStr(8,B1,s);
end;
end;
if Konfig.MidiOut then
begin
rem:=playmidi(konfig.spkverz+'DBELL'+s+'.MID');
if not rem then rem:=playmidi(konfig.spkverz+'DBELL.MID');
end;
{$ENDIF}
if not rem then
begin
sound_(1800,5); warte(5);
sound_(1400,5); warte(5);
sound_(1000,5); warte(5);
end;
End;
Procedure Daten_Bell;
Begin
sound_(1800,5);
sound_(1400,5);
sound_(1800,5);
End;
Function Datum (* : Str11 *);
Var Tag,
WoTag,
Monat,
Jahr : Word;
TagStr,
WoTagStr,
MonatStr,
JahrStr : String[2];
Dummy : String[8];
Begin
Dummy := Uhrzeit;
TagStr := SFillStr(2,'0',int_str(Tag_));
MonatStr := SFillStr(2,'0',int_str(Monat_));
JahrStr := copy(int_str(Jahr_),3,2);
WochenTag := ParmStr(WoTag_+1,B1,WeekDayStr);
WotagStr := copy(WochenTag,1,2);
Datum := WotagStr + B1 + TagStr + Pkt + MonatStr + Pkt + JahrStr;
End;
Procedure GetTime_ (* (Hr, Mn, Sk, Sk100 : Word) *) ;
var Flag:Boolean;
begin
if RTC then
begin
Repeat
Port[$70] := 10;
Until Port[$71] and $80 = 0;
Port[$70] := 11;
Flag := (Port[$71] and 4) = 0;
Port[$70] := 0; Sk := Port[$71];
Port[$70] := 2; Mn := Port[$71];
Port[$70] := 4; Hr := Port[$71];
if Flag then
begin
Sk := (Sk shr 4) * 10 + Sk and 15;
Mn := (Mn shr 4) * 10 + Mn and 15;
Hr := (Hr shr 4) * 10 + Hr and 15;
end;
end else GetTime(Hr,Mn,Sk,Sk100);
end;
Function Uhrzeit (* : Str8 *);
Var
Sek100,
UtcStd : Word;
Flag : Boolean;
Hstr : String[8];
LTCheck : Longint;
Begin
GetTime_(Stunde,Minute,Sekunde,Sek100);
{$IFNDEF no_Netrom} {//db1ras}
if (Konfig.MaxNodes>0) and (minute<>lminute) then
begin
lminute:=minute;
LTCheck := PackDT;
if ((LTCheck-LastLTCheck)>=150) and (not InNodeListe) then {alle 5 minuten pr<70>fen}
begin
LastLTCheck:=LTCheck;
NodesLifeTime;
end;
end;
{$ENDIF}
UtcStd := Stunde;
UtcStd := UtcStd + 24 + ZeitDiff;
While UtcStd > 23 do UtcStd := UtcStd - 24;
Hstr := SFillStr(2,'0',int_str(Stunde)) + DP +
SFillStr(2,'0',int_str(Minute)) + DP +
SFillStr(2,'0',int_str(Sekunde)) + DP;
UtcZeit := SFillStr(2,'0',int_str(UtcStd)) + copy(Hstr,3,6);
Uhrzeit := Hstr;
End;
Function GetCursorSize : Integer; (* Liefert Cursorgroesse (aus PCT von DD6CV) *)
Var r : Registers;
Begin
r.AH := $03;
intr($10,r);
GetCursorSize := r.CX;
End;
Procedure SetCursorSize(Size : Integer); (* Setzt Cursorgroesse (aus PCT von DD6CV) *)
Var r : Registers;
Begin
r.AH := $01;
r.CX := Size;
intr($10,r);
End;
Procedure Cursor_aus; (* Schaltet Cursor aus. (aus PCT von DD6CV) *)
Const CursorOffBit = 8192;
Begin
SetCursorSize(GetCursorSize or CursorOffBit);
Cursor_On := false;
End;
Procedure Cursor_ein; (* Schaltet Cursor ein. (aus PCT von DD6CV) *)
Const CursorOnMask = -8193;
Begin
SetCursorSize(GetCursorSize and CursorOnMask);
Cursor_On := true;
End;
Procedure Beep (* Ton,Laenge : Word*);
Begin
if Laenge > 0 then
begin
Sound_(Ton,Laenge div 14);
end;
End;
Procedure Fenster (* H:Byte *);
Var i,x,y : Byte;
Attr : Byte;
Begin
Attr := Attrib[3];
x := 1;
Teil_Bild_Loesch(7,h,Attr);
x := 40-(length(G^.Fstr[7]) DIV 2);
WriteRam(2,6,Attr,1,ConstStr('<27>',78));
WriteRam(2,h+1,Attr,1,ConstStr('<27>',78));
WriteRam(1,6,Attr,1,'<27>'); WriteRam(80,6,Attr,1,'<27>');
WriteRam(1,h+1,Attr,1,'<27>'); WriteRam(80,h+1,Attr,1,'<27>');
for i:=7 to h do
begin
if i<> 8 then
begin
WriteRam(1,i,Attr,1,'<27>');
WriteRam(80,i,Attr,1,'<27>');
end
else
begin
WriteRam(1,i,Attr,1,'<27>'); {'<27>');}
WriteRam(80,i,Attr,1,'<27>'); {'<27>');}
end;
end;
WriteRam(x,7,Attr,1,G^.Fstr[7]);
WriteRam(2,8,Attr,1,ConstStr('<27>',78)); {<7B>}
for i := 9 to 20 do WriteRam(G^.Fstx[i],i,Attr,1,G^.Fstr[i]);
End;
Procedure clrFenster;
Var i : Byte;
Begin
for i := 7 to 20 do G^.Fstr[i] := '';
for i := 7 to 20 do G^.Fstx[i] := 2;
End;
Procedure Status2;
Var AByte,
Beg,
Ende,
C,i,
Z,UT : Byte;
ch : Char;
Hstr : String[80];
Xstr : String[6];
Flag : Boolean;
Begin
if not OnlHelp then
begin
i := 0;
Repeat
Flag := not (i in [Portstufe+1..Portstufe+10]) and K[i]^.connected;
inc (i);
Until (i > maxLink) or Flag;
if Flag then ch := '*'
else ch := B1;
Hstr := ch;
Beg := PortStufe + 1;
Ende := Beg + 9;
if Ende > maxLink then Ende := maxLink;
for C := Beg to Ende do with K[C]^ do
begin
if (connected) then
begin
Xstr := Call;
Strip(Xstr);
end else
if Test then Xstr := 'T (' + int_str(TestMerk) + ')' else
begin
Xstr := ' '; {#7+#7;}
if c<10 then Xstr:=xstr+' ';
xstr:=xstr+int_str(C)+' '; {#7+#7};
end;
if Mo.MonActive then
begin
Xstr := CutStr(Mo.MonStr[1]);
strip(Xstr);
end;
if (C > 0) and (C = ConvHilfsPort) then Xstr := 'SYSOP';
Xstr := EFillStr(6,B1,Xstr);
Hstr := Hstr + KStatTr;
Hstr := Hstr + Xstr;
end;
Hstr := Hstr + KStatTr;
Hstr := EFillStr(80,B1,Hstr);
UT := K[show]^.UnStat;
WriteRam(1,UT,Attrib[15],1,Hstr);
if show = 0 then i := Unproto
else i := K[show]^.TncNummer;
WriteRam(73,UT,Attrib[30],1,SFillStr(8,B1,TNC[i]^.QRG_Akt));
Z := 0;
for C := Beg to Ende do
begin
inc(Z);
with K[C]^ do
begin
if (show = C)
then AByte := Attrib[17]
else if (NochNichtGelesen) then AByte := Attrib[8]
else if Mo.MonActive then AByte := Attrib[25]
else if connected then AByte := Attrib[16]
else AByte := Attrib[15];
WriteAttr((Z*6)+Z-4,UT,6,AByte,1);
end;
end;
if maxLink > 10 then for C := 1 to maxLink do with K[C]^ do
begin
if NochNichtGelesen and not (C in [(Portstufe+1)..(Portstufe+10)]) then
begin
Hstr := EFillStr(6,B1,'CH:' + int_str(C));
Z := C mod 10;
if Z = 0 then Z := 10;
i := show mod 10;
if i = 0 then i := 10;
if Z <> i then AByte := Attrib[8]
else AByte := Attrib[17];
WriteRam((Z*6)+Z-4,UT,AByte,1,Hstr);
end;
end;
end; {if not OnlHelp ... }
End;
Procedure Alarm;
Begin
if Klingel then Beep(G^.Alarm_Freq,G^.Alarm_Time);
End;
Procedure StatusOut (* Kanal,x,Nr,Attr : Byte ; Zeile : string ; StZ : Byte *);
Var N,Nx,i,Soz : Byte;
FlagZeil : String;
Begin
if Not OnlHelp then
begin
with K[Kanal]^ do
begin
N := (((NrStat[Nr]-1) * 40) + (2 * x) - 1);
Nx := (NrStat[Nr]-1) * 40 + 1;
if stz=1 then
begin
for i := 1 to ord(Zeile[0]) do
begin
StatZeile[N] := Zeile[i];
inc(N);
StatZeile[N] := chr(Attr);
inc(N);
end;
end;
if stz=2 then
begin
for i := 1 to ord(Zeile[0]) do
begin
FlagZeile[N] := Zeile[i];
inc(N);
FlagZeile[N] := chr(Attr);
inc(N);
end;
end;
if stz=3 then
begin
for i := 1 to ord(Zeile[0]) do
begin
FlagZeile2[N] := Zeile[i];
inc(N);
FlagZeile2[N] := chr(Attr);
inc(N);
end;
end;
if not ScreenSTBY then
begin
if (Kanal = show) and not DirScroll then
begin
if not Backscroll(show) { and (nr <>1)}
then
begin
move(StatZeile,Bild^[(ObStat-1)*160+1],160);
move(FlagZeile,Bild^[(ObStat)*160+1],160);
move(FlagZeile2,Bild^[(ObStat+1)*160+1],160);
end;
end;
end;
end;
end; {if not onlhelp ...}
End;
Procedure NodeConnect (* Kanal : Byte; Zeile : Str80 *);
Var i : Byte;
Bstr,
Hstr : String[80];
Begin
with K[Kanal]^ do
begin
Hstr := Zeile;
if length(Zeile) > 1 then NodeCmd := false;
Zeile := CutStr(Zeile);
if Zeile > '' then
begin
Bstr := InfoZeile(216);
while (Bstr > '') and not NodeCmd do
begin
if pos(Zeile,CutStr(Bstr)) = 1 then NodeCmd := true
else Bstr := RestStr(Bstr);
end;
if NodeCmd then ConnectMerk := Hstr;
end;
end;
End;
Function Exists (* name : Str80) : Boolean *);
Var Datei : Text;
ExFlagi : Boolean;
dummio : byte;
Begin
ExFlagi:=false;
if Name > '' then
begin
{$I-}
Assign(Datei,name);
Reset(Datei);
if IOResult = 0 then
begin
Exflagi:= true;
end else Exflagi:= false;
close(Datei);
dummio:=ioresult;
{$I+}
end else Exflagi:= false;
Exists:=ExFlagi;
End;
Procedure Teil_Bild_Loesch (* y,y1,Attr : Byte *); (* Zeilen von y bis y1 l<>schen *)
Begin
if not ScreenSTBY then
Asm les di, Bild
mov al, y
dec al
mov ah, 160
mul ah
add di, ax
mov al, y1
mov ah, 160
mul ah
sub ax, di
mov cx, ax
mov al, 32
mov ah, Attr { Attribut laden }
shr cx, 1
@Again:
mov [es:di], ax { Zeichen mit Attr <20>bertragen }
add di, 2
Loop @Again
end;
End;
Procedure InfoOut; (* Kanal,AL,NewPic : Byte; Zeile : Str80 *)
Var AMerk,
Tr,x,l : Byte;
Begin
if (not OnlHelp) and (not K[kanal]^.Mo.MonActive) then
begin
if length(Zeile) > 78 then Zeile[0] := Chr(78);
if (K[Kanal]^.Rx_Bin>0) or (K[kanal]^.SPlSave) or (K[kanal]^.xbin.rx) then K[Kanal]^.LstRXInfo:=Zeile
else K[Kanal]^.LstRXInfo:='';
if (K[Kanal]^.FileSend) or (K[kanal]^.xbin.tx) then K[Kanal]^.LstTXInfo:=Zeile else K[Kanal]^.LstTXInfo:='';
if (Kanal = show) and not BackScroll(Kanal) then
begin
if NewPic = 1 then Neu_Bild;
if Kanal > 0 then Tr := K[Kanal]^.QBeg
else Tr := K[Kanal]^.UnStat + 1;
if not HardCur and (length(Zeile) < 76) then Zeile := B1 + Zeile + B1;
if volle_Breite then Zeile := EFillStr(78,B1,Zeile);
l := length(Zeile);
x := (80 - l) div 2;
XL := x;
XR := x + l + 2;
WriteRam(x,Tr,15,1,'<27>' + ConstStr('<27>',l) + '<27>');
WriteRam(x,Tr+1,15,1,'<27>' + Zeile + '<27>');
WriteAttr(x+1,Tr+1,l,Attrib[3],1);
WriteRam(x,Tr+2,15,1,'<27>' + ConstStr('<27>',l) + '<27>');
if LastInfoFlag then
WriteRam(x+1,Tr,15,1,B1+int_str(LastInfoOut^.KA[LastInfoCount])+B1);
NowFenster := true;
if (not K[Kanal]^.FileSend) and (K[Kanal]^.RX_Bin<1)
and ((not K[kanal]^.xbin.rx) and (not K[kanal]^.xbin.tx)) then BoxZaehl := Box_Time
else BoxZaehl:=0;
NowCurBox := true;
if (AL = 1) and Klingel then Beep(G^.PopFreq,G^.PopFreqTime);
if not LastInfoFlag then
begin
for l := maxInfoOut-1 downto 1 do
begin
LastInfoOut^.IZ[l+1] := LastInfoOut^.IZ[l];
LastInfoOut^.KA[l+1] := LastInfoOut^.KA[l];
end;
LastInfoCount := 0;
LastInfoOut^.IZ[1] := Zeile;
LastInfoOut^.KA[1] := Kanal;
KillEndBlanks(LastInfoOut^.IZ[1]);
KillStartBlanks(LastInfoOut^.IZ[1]);
end;
set_Hardwarecursor(Kanal);
K[Kanal]^.MerkInfo := '';
end else K[Kanal]^.MerkInfo := Zeile;
end; {if not OnlHelp ... }
End;
Procedure max_path_ermitteln;
Var Hstr : String[80];
Begin
maxPath := 0;
FiResult := ResetTxt(G^.LinkFile);
Repeat
Readln(G^.LinkFile,Hstr);
if pos(DP,Hstr) > 0 then inc(maxPath);
Until Eof(G^.LinkFile);
FiResult := CloseTxt(G^.LinkFile);
End;
Procedure WriteAttr (* X_Pos,Y_Pos,Count,Attr,Aufruf : Byte *);
Begin
if not ScreenSTBY then
begin
if not ((Aufruf = 0) and BackScroll(show)) then
Asm xor ch, ch
mov cl, Count
cmp cl, 0
je @Ende
les di, Bild
mov al, Y_Pos
dec al
mov ah, 160
mul ah
add di, ax
mov al, X_Pos
shl al, 1
dec al
xor ah, ah
add di, ax
mov al, Attr { Attribut laden, }
@Again:
mov [es:di], al { und schreiben }
add di, 2
loop @Again
@Ende:
end;
end;
End;
Procedure WritePage (* Kanal,X_Pos,Y_Pos,Attr,Aufruf : Byte ; Zeile : Str80 *);
Var Attr1 : Byte;
Zeile2:string;
i,i2:byte;
itab:byte;
U_FArb_Green:Boolean;
Begin
zeile2:='';
itab:=8;
for i:=1 to length(zeile) do
begin {or (zeile[1]=^J)}
if (itab=0) or (zeile[i]=#13) then itab:=8;
dec(itab);
if kanal>0 then
begin
if zeile[i]<>#9 then Zeile2:=zeile2+zeile[i]
else
begin
zeile2:=zeile2+efillstr(itab,B1,'');
itab:=9;
end;
end else zeile2:=zeile;
end;
if not ScreenSTBY then
begin
if (Aufruf = 1) or (Kanal = show) then
begin
Attr1 := Attrib[1];
AusStr := Zeile2;
U_Farb_Green:=Not SoZeichen;
{ Asm mov si, Offset AusStr
xor ch, ch
mov cl, [ds:si]
test cl, $FF
jz @Ende
inc si
les di, Bild
mov al, Y_Pos
mov ah, 160
dec al
mul ah
mov di, ax
mov al, X_Pos
shl al, 1
dec al
dec al
xor ah, ah
add di, ax
cld
@Again:
mov ah, Attr
lodsb
cmp al, 32
jae @Weiter
test al, $FF
jz @Weiter
mov ah, Attr1
mov bl, WCTRL
test bl, $FF
jz @1
add al, 64
@1:
@Weiter:
mov [es:di], ax
add di, 2
Loop @Again
@Ende:}
Asm mov si, Offset AusStr
xor ch, ch
mov cl, [ds:si]
test cl, $FF
jz @Ende
inc si
les di, Bild
mov al, Y_Pos
mov ah, 160
dec al
mul ah
mov di, ax
mov al, X_Pos
shl al, 1
dec al
dec al
xor ah, ah
add di, ax
cld
@Again:
mov ah, Attr
lodsb
cmp al, 32
jae @Weiter
test al, $FF
jz @Weiter
mov bl, WCTRL
test bl, $FF
test U_FARB_GREEN, 1
jz @Weiter
mov ah, Attr1
add al, 64
jz @1
@1:
@Weiter:
mov [es:di], ax
add di, 2
Loop @Again
@Ende:
end;
end;
end;
End;
{
Procedure WritePage (* Kanal,X_Pos,Y_Pos,Attr : Byte ; Zeile : Str80 *);
var Attr1,i : Byte;
ch : char;
Position : Integer;
aktuell : Boolean;
Begin
if not ScreenSTBY then
begin
if (Aufruf = 1) or (Kanal = show) then
begin
Position := pred(Y_Pos) * 160 + pred(X_Pos shl 1);
for i := 1 to length(Zeile) do
Begin
ch := Zeile[i];
if ch < #32 then
begin
Attr1 := Attrib[1];
if WCTRL then ch := chr(ord(ch) + 64);
end else Attr1 := Attr;
Bild^[Position] := ch;
inc(Position);
Bild^[Position] := chr(Attr1);
inc(Position);
end;
end;
end;
End;
}
Procedure WriteRam (* X_Pos,Y_Pos,Attr,Aufruf : Byte; Zeile : Str80 *);
Begin
if not ScreenSTBY then
begin
if not ((Aufruf = 0) and BackScroll(show)) then
begin
AusStr := Zeile;
Asm mov si, Offset AusStr
xor ch, ch
mov cl, [ds:si]
test cl, $FF
jz @Ende
inc si
les di, Bild
mov al, Y_Pos
mov ah, 160
dec al
mul ah
mov di, ax
mov al, X_Pos
shl al, 1
sub al, 2
xor ah, ah
add di, ax
mov ah, Attr
cld
@Again:
lodsb
mov [es:di], ax
add di, 2
Loop @Again
@Ende:
end;
end;
end;
End;
{
Procedure WriteRam(X_Pos,Y_Pos,Attr,Aufruf : Byte ; Zeile : Str80);
var i : Byte;
ch : char;
ch1 : char;
Position : Integer;
Begin
if not ScreenSTBY then
begin
ch1 := chr(Attr);
Position := (pred(Y_Pos) * 160) + pred(X_Pos shl 1);
if not ((Aufruf = 0) and BackScroll(show)) then
begin
for i := 1 to ord(Zeile[0]) do
Begin
Bild^[Position] := Zeile[i];
Position := Succ(Position);
Bild^[Position] := ch1;
Position := Succ(Position);
end;
end;
end;
End;
}
Procedure WriteTxt (* X_Pos,Y_Pos,Attr : Byte; Zeile : Str80 *);
Begin
AusStr := Zeile;
Asm mov si, Offset AusStr
xor ch, ch
mov cl, [ds:si]
test cl, $FF
jz @Ende
inc si
les di, Bild
mov al, Y_Pos
mov ah, 160
dec al
mul ah
mov di, ax
mov al, X_Pos
shl al, 1
sub al, 2
xor ah, ah
add di, ax
mov ah, Attr
cld
@Again:
lodsb
mov [es:di], ax
add di, 2
Loop @Again
@Ende:
end;
End;
Procedure WriteBios (* Kanal,X_Pos,Y_Pos,Attr,Aufruf : Byte ; Zeile : Str80 *);
Var i : Byte;
r : Registers;
Begin
if not ScreenSTBY then
begin
if (Aufruf = 1) or (Kanal = show) then
begin
for i := 1 to length(Zeile) do if Zeile[i] in [#0..#31] then Zeile[i] := B1;
r.AH := $13;
r.AL := $00;
r.BH := $00;
r.BL := Attr;
r.CX := ord(Zeile[0]);
r.DH := Y_Pos - 1;
r.DL := X_Pos - 1;
r.ES := Seg(Zeile[1]);
r.BP := Ofs(Zeile[1]);
Intr($10,r);
end;
end;
End;
Function KanalFrei (* Kanal : Byte) : Byte *);
Var Free : Boolean;
i : Integer;
Begin
Free := false;
i := maxLink;
While not Free and (i > 0) do with K[i]^ do
begin
if not (Kanal_benutz or connected or Test or Mo.MonActive) and
(i <> ConvHilfsPort) and
((Kanal = 0) or (Kanal > 0) and (Kanal <> i)) then
begin
Free := true;
KanalFrei := i;
end else dec(i);
end;
if not Free then KanalFrei := 0;
End;
Function Line_convert (* Kanal, Art : Byte; Zeile : String) : String *);
Var i : Byte;
zh:char;
Begin
with K[Kanal]^ do
begin
if Umlaut = 2 then
begin
case Art of
1 : For i := 1 to length(Zeile) do
begin
zh:=#0;