0 DO DEC(p); IF i>0 THEN DEC(i); s[p]:=s[i]; ELSE s[p]:=" " END; END; END rightbound; PROCEDURE TimeToStr(t:TIME; VAR s:ARRAY OF CHAR); VAR h:ARRAY[0..20] OF CHAR; d:TIME; BEGIN d:=t DIV (60*60*24); s[0]:=0C; IF d>0 THEN IntToStr(d, 1 , s); Append(s,"d"); END; IntToStr(t DIV (60*60) MOD 24, 2 , h); IF h[0]=" " THEN h[0]:="0" END; Append(s, h); Append(s, ":"); IntToStr(t DIV 60 MOD 60, 2, h); IF h[0]=" " THEN h[0]:="0" END; Append(s, h); Append(s,":"); IntToStr(t MOD 60, 2, h); IF h[0]=" " THEN h[0]:="0" END; Append(s, h); END TimeToStr; PROCEDURE DateToStr(time:CARDINAL; VAR tstr:ARRAY OF CHAR); VAR mon, year, day, monthlen:CARDINAL; k:ARRAY[0..12] OF CHAR; PROCEDURE tostr(n:CARDINAL; s-:ARRAY OF CHAR); VAR h:ARRAY[0..1] OF CHAR; BEGIN h[1]:=0C; h[0]:=CHR(ORD('0')+n DIV 10); Append(tstr,h); h[0]:=CHR(ORD('0')+n MOD 10); Append(tstr,h); Append(tstr,s); END tostr; BEGIN tstr[0]:=0C; day:=25568+time DIV (60*60*24); (*IF day>=36584 THEN INC(day) END;*) year:=day*4 DIV 1461; day:=1 + day*4 MOD 1461 DIV 4; mon:=0; k[0]:=0C; Append(k,'3303232332323'); IF year MOD 4 = 0 THEN k[2]:='1' END; LOOP INC(mon); monthlen:=ORD(k[mon])-20; IF day<=monthlen THEN EXIT END; DEC(day, monthlen); END; tostr(19+year DIV 100,''); tostr(year MOD 100,'.'); tostr(mon,'.'); tostr(day,' '); tostr(time DIV (60*60) MOD 24,':'); tostr(time DIV 60 MOD 60,':'); tostr(time MOD 60,''); END DateToStr; PROCEDURE StrToTime(s:ARRAY OF CHAR; VAR time:CARDINAL):BOOLEAN; (* to s since 1970*) VAR y, m, d, k, h, mi:CARDINAL; err:BOOLEAN; PROCEDURE dig(c:CHAR):CARDINAL; BEGIN IF (c<"0") OR (c>"9") THEN err:=TRUE; RETURN 0 ELSE RETURN ORD(c)-ORD("0") END; END dig; BEGIN err:=FALSE; y:=dig(s[0])*1000 + dig(s[1])*100 + dig(s[2])*10 + dig(s[3]); IF (y<1970) OR (y>2100) THEN RETURN FALSE END; time:=(y-1970)*365 + (y-1969) DIV 4; m:=dig(s[5])*10 + dig(s[6]); d:=dig(s[8])*10 + dig(s[9]); IF (d<1) OR (d>31) THEN RETURN FALSE END; k:=ORD(y MOD 4=0); INC(time, d-1); IF m>2 THEN INC(time, k) END; CASE m OF 1: |2: IF d>28+k THEN err:=TRUE END; INC(time, 31); |3: INC(time, 31+28); |4: IF d>30 THEN err:=TRUE END; INC(time, 31+28+31); |5: INC(time, 31+28+31+30); |6: IF d>30 THEN err:=TRUE END; INC(time, 31+28+31+30+31); |7: INC(time, 31+28+31+30+31+30); |8: INC(time, 31+28+31+30+31+30+31); |9: IF d>30 THEN err:=TRUE END; INC(time, 31+28+31+30+31+30+31+31); |10:INC(time, 31+28+31+30+31+30+31+31+30); |11:IF d>30 THEN err:=TRUE END; INC(time, 31+28+31+30+31+30+31+31+30+31); |12:INC(time, 31+28+31+30+31+30+31+31+30+31+30); ELSE err:=TRUE; END; IF err THEN RETURN FALSE END; h:=dig(s[11])*10 + dig(s[12]); IF h>24 THEN RETURN FALSE END; mi:=dig(s[14])*10 + dig(s[15]); IF mi>=60 THEN RETURN FALSE END; time:=(time*24 + h)*3600 + mi*60; RETURN TRUE END StrToTime; PROCEDURE CtrlHex(VAR s:ARRAY OF CHAR); (* replace ctrl char by *) PROCEDURE Hex(d:CARDINAL):CHAR; BEGIN d:=d MOD 16; IF d>9 THEN INC(d, ORD("A")-10-ORD("0")) END; RETURN CHR(d+ORD("0")) END Hex; VAR i,j,len:CARDINAL; BEGIN len:=Length(s); i:=0; WHILE (i=3) OR (h[0]<>PORTSEP) THEN n:=0; ok:=FALSE; WHILE (h[p]>="0") & (h[p]<="9") DO ok:=TRUE; n:=n*10+ORD(h[p])-ORD("0"); INC(p); END; IF NOT ok THEN RETURN -1 END; END; IF i<3 THEN IF h[0]<>PORTSEP THEN IF (h[p]<>".") OR (n>255) THEN RETURN -1 END; ip:=ip*256+n; END; ELSIF i=3 THEN IF h[0]<>PORTSEP THEN ip:=ip*256+n; IF (h[p]<>PORTSEP) OR (n>255) THEN RETURN -1 END; ELSE p:=0; ip:=DEFAULTIP END; ELSIF i=4 THEN check:=h[p]=CHECKSEP; IF (h[p]<>PORTSEP) & (h[p]<>CHECKSEP) OR (n>65535) THEN RETURN -1 END; dp:=n; ELSIF n>65535 THEN RETURN -1 END; lp:=n; INC(p); END; RETURN 0 END GetIp2; PROCEDURE ipv4tostr(ip:CARDINAL; VAR s:ARRAY OF CHAR); VAR h:ARRAY[0..20] OF CHAR; BEGIN IntToStr(ip DIV 1000000H, 0, s); Append (s, "."); IntToStr(ip DIV 10000H MOD 100H, 0, h); Append (s, h); Append (s, "."); IntToStr(ip DIV 100H MOD 100H, 0, h); Append (s, h); Append (s, "."); IntToStr(ip MOD 100H, 0, h); Append (s, h); END ipv4tostr; PROCEDURE HashCh(c:CHAR; VAR hashl, hashh:SET8); VAR b:CARD8; BEGIN IF c<>" " THEN b:=CAST(CARD8, CAST(SET8, c) / hashl); hashl:=CRCL[b] / hashh; hashh:=CRCH[b]; END; END HashCh; PROCEDURE AppCRC(VAR frame:ARRAY OF CHAR; size:INTEGER); VAR l,h:SET8; b:CARD8; i:INTEGER; BEGIN l:=SET8{}; h:=SET8{}; FOR i:=0 TO size-1 DO b:=CAST(CARD8, CAST(SET8, frame[i]) / l); l:=CRCL[b] / h; h:=CRCH[b]; END; frame[size ]:=CAST(CHAR, l); frame[size+1]:=CAST(CHAR, h); END AppCRC; PROCEDURE Hash(frame-:ARRAY OF CHAR; start, end:INTEGER):CARDINAL; VAR l,h:SET8; b:CARD8; i:INTEGER; c:CHAR; BEGIN l:=SET8{}; h:=SET8{}; FOR i:=start TO end-1 DO c:=frame[i]; IF c<>" " THEN b:=CAST(CARD8, CAST(SET8, c) / l); l:=CRCL[b] / h; h:=CRCH[b]; END; END; RETURN (ORD(CAST(CHAR, l)) + ORD(CAST(CHAR, h))*256); END Hash; PROCEDURE mon2raw(mon-:ARRAY OF CHAR; VAR raw:ARRAY OF CHAR; VAR p:INTEGER); CONST CTRL=CHR(3); PID=CHR(0F0H); cTO=">"; cVIA=","; cLASTCALL=":"; cSSID="-"; cREPEATED="*"; MAXVIAS=8; MAXSSID=15; SSIDBASE=16*3; CALLFILL=" "; MAXINFOLEN=256; VAR i,n,r:CARDINAL; PROCEDURE call(sep1, sep2, sep3:CHAR; sbase:CARDINAL):BOOLEAN; VAR l,s:CARDINAL; BEGIN l:=0; WHILE (mon[i]<>0C) & (mon[i]<>sep1) & (mon[i]<>sep2) & (mon[i]<>sep3) & (mon[i]<>cSSID) DO s:=ORD(mon[i])*2 MOD 256; IF s<=ORD(" ")*2 THEN RETURN FALSE END; raw[p]:=CHR(s); INC(p); INC(i); INC(l); IF l>=CALLLEN THEN RETURN FALSE END; END; WHILE l="0") & (mon[i]<="9") DO s:=s*10 + ORD(mon[i])-ORD("0"); INC(i) END; IF s>MAXSSID THEN RETURN FALSE END; END; raw[p]:=CHR((s+sbase)*2); INC(p); RETURN TRUE END call; BEGIN p:=CALLLEN; i:=0; IF NOT call(cTO, 0C, 0C, SSIDBASE) THEN p:=0; RETURN END; (* from call *) p:=0; IF mon[i]<>cTO THEN RETURN END; (* ">" *) INC(i); IF NOT call(cLASTCALL, cVIA, 0C, SSIDBASE+64) THEN p:=0; RETURN END; (* dest call bit 7 for UI v2 command *) -- IF NOT call(cLASTCALL, cVIA, 0C, SSIDBASE) THEN p:=0; RETURN END; (* dest call bit 7 for UI v2 command *) p:=CALLLEN*2; n:=0; WHILE mon[i]=cVIA DO INC(i); IF NOT call(cLASTCALL, cVIA, cREPEATED, SSIDBASE) THEN p:=0; RETURN END; INC(n); IF n>MAXVIAS THEN p:=0; RETURN END; IF mon[i]=cREPEATED THEN (* "*" has repeatet sign *) INC(i); FOR r:=p TO CALLLEN*3 BY -CALLLEN DO raw[r-1]:=CHR(ORD(raw[r-1])+HBIT) END; (* set "has repeated" flags *) END; END; IF (p=0) OR (mon[i]<>cLASTCALL) THEN p:=0; RETURN END; (* ":" start of info sign *) raw[p-1]:=CHR(ORD(raw[p-1]) + 1); (* end address field mark *) raw[p]:=CTRL; INC(p); raw[p]:=PID; INC(p); INC(i); n:=MAXINFOLEN; WHILE (mon[i]<>0C) & (i<=HIGH(mon)) DO (* copy info part *) IF (p>=VAL(INTEGER, HIGH(raw))-2) OR (n=0) THEN p:=0; RETURN END; (* spare 2 bytes for crc *) raw[p]:=mon[i]; INC(p); INC(i); DEC(n); END; AppCRC(raw,p); INC(p, 2); END mon2raw; PROCEDURE Call2Str(r-:ARRAY OF CHAR; VAR t:ARRAY OF CHAR; pos:CARDINAL; VAR len:CARDINAL):BOOLEAN; VAR i,e,ssid:CARDINAL; c:CHAR; BEGIN e:=pos; FOR i:=pos TO pos+5 DO IF r[i]<>100C THEN e:=i END; END; FOR i:=pos TO e DO c:=CHR(ASH(ORD(r[i]), -1)); IF c<=" " THEN (* ctrl char in call *) IF showctrl THEN c:="^" ELSE t[len]:=0C; len:=0; RETURN FALSE END; END; t[len]:=c; INC(len); END; ssid:=ASH(ORD(r[pos+6]), -1) MOD 16; IF ssid>0 THEN t[len]:="-"; INC(len); IF ssid>9 THEN t[len]:="1"; INC(len); END; t[len]:=CHR(ssid MOD 10 + ORD("0")); INC(len); END; RETURN TRUE END Call2Str; PROCEDURE brandghost(VAR b:ARRAY OF CHAR; brand:CARDINAL); VAR i, j, l:CARDINAL; s,s1:ARRAY[0..20] OF CHAR; BEGIN i:=0; LOOP IF (i>=HIGH(b)) OR (b[i]=0C) THEN RETURN END; IF (b[i]=",") OR (b[i]=":") THEN EXIT END; INC(i); END; (* IF NOT v1 & (b[i]=",") THEN IF ((b[i+1]<>"W") OR (b[i+2]<>"I") OR (b[i+3]<>"D") OR (b[i+4]<>"E") OR (b[i+5]<>"1") OR (b[i+6]<>"-") OR (b[i+7]<>"1") OR (b[i+8]<>",") OR (b[i+9]<>"W") OR (b[i+10]<>"I") OR (b[i+11]<>"D") OR (b[i+12]<>"E") OR (b[i+13]<>"2") OR (b[i+14]<>"-") OR (b[i+15]<>"1") & (b[i+15]<>"2") OR (b[i+16]<>":")) & ((b[i+1]<>"R") OR (b[i+2]<>"E") OR (b[i+3]<>"L") OR (b[i+4]<>"A") OR (b[i+5]<>"Y") OR (b[i+6]<>":")) THEN v1:=TRUE END; END; *) IF (b[i]=",") THEN j:=i+1; LOOP (* goto end of first via *) IF (j>=HIGH(b)) OR (b[j]=0C) THEN RETURN END; IF (b[j]=":") OR (b[j]=",") THEN EXIT END; INC(j); END; IF (brand<256) & ((j<=3) OR (b[j-1]<"0") OR (b[j-1]>"9") OR (b[j-2]<>"-") OR (b[j-1]<>b[j-3])) THEN RETURN END; (* frame has n<>N so known as not direct *) j:=i+1; LOOP (* look for h-bit *) IF (j>=HIGH(b)) OR (b[j]=0C) THEN RETURN END; IF b[j]=":" THEN EXIT END; IF b[j]="*" THEN RETURN END; (* frame has h bit so known as not direct *) INC(j); END; END; s:=",GHOST"; IntToStr(brand, 0, s1); Append(s, s1); Append(s, "*"); l:=Length(s); i:=0; WHILE (i<=HIGH(b)) & (b[i]<>0C) & (b[i]<>":") DO INC(i) END; IF b[i]=":" THEN j:=i; WHILE (j<=HIGH(b)) & (b[j]<>0C) DO INC(j) END; IF (b[j]=0C) & (j+l=i DO b[j+l]:=b[j]; DEC(j) END; FOR i:=0 TO l-1 DO INC(j); b[j]:=s[i] END; END; END; END brandghost; PROCEDURE raw2mon(VAR raw, mon:ARRAY OF CHAR; len:CARDINAL; VAR p:CARDINAL; ghostset-:GHOSTSET); VAR i, brand:CARDINAL; hcheck:BOOLEAN; BEGIN IF (len>21) & NOT ODD(ORD(raw[13])) & (raw[14]=CHR(ORD("A")*2)) & (raw[15]=CHR(ORD("P")*2)) & (raw[16]=CHR(ORD("R")*2)) & (raw[17]=CHR(ORD("S")*2)) & (raw[18]=CHR(ORD(" ")*2)) THEN brand:=256 ELSE brand:=ORD(raw[6]) DIV 32 + (ORD(raw[13]) DIV 32)*8 END; p:=0; mon[0]:=0C; i:=0; WHILE NOT ODD(ORD(raw[i])) DO INC(i); IF i>len THEN mon[0]:=0C; RETURN END; (* no address end mark found *) END; IF i MOD 7 <> 6 THEN mon[0]:=0C; RETURN END; (* address end not modulo 7 error *) IF NOT Call2Str(raw,mon,7,p) THEN mon[0]:=0C; RETURN END; mon[p]:=">"; INC(p); IF NOT Call2Str(raw,mon,0,p) THEN mon[0]:=0C; RETURN END; i:=14; hcheck:=TRUE; WHILE (i+6=128 THEN IF NOT hcheck THEN mon[0]:=0C; RETURN END; (* wrong H bit *) IF (ODD(ORD(raw[i+6])) OR (ORD(raw[i+13])<128)) THEN mon[p]:="*"; INC(p); END; ELSE hcheck:=FALSE END; INC(i,7); END; IF (raw[i]<>3C) & (raw[i]<>23C) THEN mon[0]:=0C; RETURN END; (* not UI frame *) IF raw[i]=23C THEN INC(brand, 64) END; (* UI.poll *) IF raw[i+1]<>CHR(0F0H) THEN INC(brand, 128) END; (* not pid 0F0H *) INC(i,2); (* ctrl, pid *) mon[p]:=":"; INC(p); WHILE (i0C THEN mon[p]:=raw[i]; INC(p); END; INC(i); END; (* mon[p]:=15C; INC(p); mon[p]:=12C; INC(p); *) mon[p]:=0C; INC(p); mon[p]:=0C; --FOR i:=0 TO 256 DO IF i IN ghostset THEN WrInt(i, 4) END; END; WrStrLn("=ghs"); IF (256 IN ghostset) & (brand>255) OR (brand IN ghostset) THEN brandghost(mon, brand) END; --WrInt(ORD(raw[6]) DIV 32,1); WrInt(ORD(raw[13]) DIV 32,1);WrStrLn(mon); END raw2mon; PROCEDURE extrudp2(VAR ib:ARRAY OF CHAR; VAR ud:ARRAY OF CHAR; VAR len:INTEGER); (* extract axudp2 header *) VAR i, j:INTEGER; BEGIN i:=0; j:=0; REPEAT ud[i]:=ib[i]; INC(i); UNTIL (i>=VAL(INTEGER, HIGH(ud))) OR (i>=len) OR (ib[i]=0C); ud[i]:=0C; INC(i); IF i>=len THEN len:=0; ELSE DEC(len, i); WHILE j0C) DO (* remove leftside junk *) IF (j>0) OR (s[i]>" ") THEN s[j]:=s[i]; INC(j) END; INC(i); END; WHILE (j>0) & (s[j-1]<=" ") DO DEC(j) END; (* remove trailing junk *) IF j<=HIGH(s) THEN s[j]:=0C END; END cleanfilename; PROCEDURE Gencrctab; CONST POLINOM=08408H; VAR i,crc,c:CARDINAL; BEGIN FOR c:=0 TO 255 DO crc:=255-c; FOR i:=0 TO 7 DO IF ODD(crc) THEN crc:=CAST(CARDINAL, CAST(BITSET, ASH(crc, -1))/CAST(BITSET,POLINOM)) ELSE crc:=ASH(crc, -1) END; END; CRCL[c]:=CAST(SET8, crc); CRCH[c]:=CAST(SET8, 255 - ASH(crc, -8)); END; END Gencrctab; PROCEDURE loctopos(VAR pos:POSITION; loc:ARRAY OF CHAR); VAR i, l:CARDINAL; ok:BOOLEAN; BEGIN ok:=FALSE; l:=Length(loc); i:=0; WHILE i=6) & (loc[0]>='A') & (loc[0]<='R') & (loc[1]>='A') & (loc[1]<='R') & (loc[2]>='0') & (loc[2]<='9') & (loc[3]>='0') & (loc[3]<='9') & (loc[4]>='A') & (loc[4]<='X') & (loc[5]>='A') & (loc[5]<='X') THEN pos.long:=FLOAT(ORD(loc[0])-ORD('A'))*20.0 +FLOAT(ORD(loc[2])-ORD('0'))*2.0 +(FLOAT(ORD(loc[4])-ORD('A'))+0.5)/12.0; pos.lat :=FLOAT(ORD(loc[1])-ORD('A'))*10.0 +FLOAT(ORD(loc[3])-ORD('0')) +(FLOAT(ORD(loc[5])-ORD('A'))+0.5)/24.0; IF l=6 THEN ok:=TRUE END; IF (l>=8) & (loc[6]>='0') & (loc[6]<='9') & (loc[7]>='0') & (loc[7]<='9') THEN pos.long:=pos.long + FLOAT(ORD(loc[6])-ORD('0'))/120.0 - 4.5/120.0; pos.lat :=pos.lat + FLOAT(ORD(loc[7])-ORD('0'))/240.0 - 4.5/240.0; IF l=8 THEN ok:=TRUE END; END; IF (l>=10) & (loc[8]>='A') & (loc[8]<='X') & (loc[9]>='A') & (loc[9]<='X') THEN pos.long:=pos.long + FLOAT(ORD(loc[8])-ORD('A'))/2880.0 - 11.5/2880.0; pos.lat :=pos.lat + FLOAT(ORD(loc[9])-ORD('A'))/5760.0 - 11.5/5760.0; IF l=10 THEN ok:=TRUE END; END; END; IF ok THEN pos.long:=(pos.long - 180.0)*(pi/180.0); pos.lat :=(pos.lat - 90.0 )*(pi/180.0); ELSE posinval(pos) END; END loctopos; PROCEDURE postoloc(VAR loc:ARRAY OF CHAR; pos:POSITION); VAR lc,bc:CARDINAL; lr, br:REAL; BEGIN lr:=(pos.long*(180.0/pi)+180.0)*(120.0*24.0); IF lr<0.0 THEN lr:=0.0 END; lc:=TRUNC(lr); br:=(pos.lat *(180.0/pi)+90.0 )*(240.0*24.0); IF br<0.0 THEN br:=0.0 END; bc:=TRUNC(br); loc[0]:=CHR(ORD("A")+lc DIV 57600); loc[1]:=CHR(ORD("A")+bc DIV 57600); loc[2]:=CHR(ORD("0")+lc DIV 5760 MOD 10); loc[3]:=CHR(ORD("0")+bc DIV 5760 MOD 10); loc[4]:=CHR(ORD("A")+lc DIV 240 MOD 24); loc[5]:=CHR(ORD("A")+bc DIV 240 MOD 24); loc[6]:=CHR(ORD("0")+lc DIV 24 MOD 10); loc[7]:=CHR(ORD("0")+bc DIV 24 MOD 10); loc[8]:=CHR(ORD("A")+lc MOD 24); loc[9]:=CHR(ORD("A")+bc MOD 24); loc[10]:=0C; END postoloc; PROCEDURE posinval(VAR pos:POSITION); BEGIN pos.long:=0.0; pos.lat:=0.0 END posinval; BEGIN showctrl:=FALSE; Gencrctab; END aprsstr.