|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 16512 (0x4080)
Types: TextFile
Names: »B1.PAS«
└─⟦09ad82a35⟧ Bits:30002863 PolyPascal-80 V3.10 for JET80 CP/M
└─⟦this⟧ »B1.PAS«
PROGRAM AY4_DATAOPSAMLINGSSYSTEM_MAINPROGRAM;
CONST
DELIMLANG = 1;RAPHOVLANG = 1;
HNDTYPLANG = 2; SEKNRLANG = 2; FYLDNLANG = 2;
SALDOLANG = 6; DEBETLANG = 6; BSVARLANG = 6;
TIDSPLANG = 11; IDLANG = 12; FTALLLANG = 20;
AKTFEJLANG = 24;
SKILLETEGN = ',';CODEORD='KSJ';
MAXFEJL = 17; (*ANTAL DEFINEREDE FEJLKODER*)
TYPE
AYSTRDATA = RECORD
TIDSP:STRING(.TIDSPLANG.);
RAPHOV:STRING(.RAPHOVLANG.);
ID:STRING(.IDLANG.);
HNDTYP:STRING(.HNDTYPLANG.);
SEKNR:STRING(.SEKNRLANG.);
FYLDN:STRING(.FYLDNLANG.);
SALDO:STRING(.SALDOLANG.);
DEBET:STRING(.DEBETLANG.);
BSVAR:STRING(.BSVARLANG.);
AKTFEJ:STRING(.AKTFEJLANG.);
FTALL:STRING(.FTALLLANG.);
END;
KALENDER = RECORD
SEKUND:STRING(.2.);
MINUT:STRING(.2.);
TIMER:STRING(.2.);
DAGNR:STRING(.1.);
DATO:STRING(.2.);
MANED:STRING(.2.);
ARSTAL:STRING(.2.);
NAVN:STRING(.7.);
END;
IDSTATUS = RECORD
DELMARK:STRING(.1.);
IDNUMMER:STRING(.12.);
STATUS:STRING(.1.);
END;
JOBSTAT = RECORD
JOB1:INTEGER; JOBTIME1:STRING(.4.);
JOB2:INTEGER; JOBTIME2:STRING(.4.);
JOB3:INTEGER; JOBTIME3:STRING(.4.);
DAYFILENAME:STRING(.12.);
END;
STR1 = STRING(.1.);
STR2 = STRING(.2.);
STR6 = STRING(.6.);
STR7 = STRING(.7.);
STR12 = STRING(.12.);
STR14 = STRING(.14.);
VAR
TBUF:STR14;
TAST,FUNKA,FUNKB: STR1;
CODEOK: INTEGER;
JOBDEF:JOBSTAT;
DAG: KALENDER;
JOBFIL:FILE OF JOBSTAT;
DATAFIL: FILE OF AYSTRDATA;
IDFIL:FILE OF IDSTATUS;
MODTAGEFIL,TIMESETFIL: FILE;
PROCEDURE LAS_REALTIME_CLOCK;
BEGIN
TBUF:='';
BEGIN CODE
$3E,$0F,$D3,$7B,$3E,$03,$D3,$7B,$21,TBUF,$3E,$0D,$77,$23,$0E,$0D,$3E,$01,
$77,$23,$0D,$20,$FB,$3E,$CF,$D3,$7B,$3E,$0F,$D3,$7B,$21,TBUF,$3E,$0D,$77,
$23,$0E,$0D,$7D,$E6,$0F,$57,$3E,$CF,$D3,$7B,$3E,$00,$D3,$7B,$7A,$F6,$90,
$D3,$79,$E6,$7F,$D3,$79,$3E,$36,$3D,$20,$FD,$3E,$CF,$D3,$7B,$3E,$0F,$D3,
$7B,$3E,$30,$D3,$79,$3E,$03,$3D,$20,$FD,$DB,$79,$E6,$0F,$57,$3E,$00,$D3,
$79,$7A,$77,$23,$0D,$20,$C6,$DD,$21,TBUF,$21,TBUF, $AF,$77 ,$16,$02,$1E,
$07,$23,
$06,$03,$4E,$23,$7E,$2B,$A3,$C6,$30,$77,$23,$DD,$34,$00,$79,$E6,$0F,$C6,
$30,$77,$23,$DD,$34,$00,$05,$20,$E7,$15,$28,$0E,$7E,$E6,$07,$C6,$30,$77,
$23,$DD,$34,$00,$1E,$0F,$18,$D4;
END;
DAG.SEKUND:=COPY(TBUF,1,2);
DAG.MINUT:=COPY(TBUF,3,2);
DAG.TIMER:=COPY(TBUF,5,2);
DAG.DAGNR:=COPY(TBUF,7,1);
DAG.DATO:=COPY(TBUF,8,2);
DAG.MANED:=COPY(TBUF,10,2);
DAG.ARSTAL:=COPY(TBUF,12,2);
IF DAG.DAGNR='0' THEN DAG.NAVN:='SØNDAG' ELSE
IF DAG.DAGNR='1' THEN DAG.NAVN:='MANDAG' ELSE
IF DAG.DAGNR='2' THEN DAG.NAVN:='TIRSDAG' ELSE
IF DAG.DAGNR='3' THEN DAG.NAVN:='ONSDAG' ELSE
IF DAG.DAGNR='4' THEN DAG.NAVN:='TORSDAG' ELSE
IF DAG.DAGNR='5' THEN DAG.NAVN:='FREDAG' ELSE
IF DAG.DAGNR='6' THEN DAG.NAVN:='LØRDAG' ELSE
DAG.DAGNR:='ERRORDG';
END;
PROCEDURE RESET_IDSTATUS;
VAR
IDRESET:IDSTATUS;
BEGIN
ASSIGN(IDFIL,'IDSTAT.DAT');
RESET(IDFIL);
WHILE NOT EOF(IDFIL) DO
BEGIN
READ(IDFIL,IDRESET);
IF IDRESET.STATUS<>'*'
THEN
WRITELN('DØGNRAPPORT IKKE MODTAGET FRA AY4 IDNUMMER: '
,IDRESET.IDNUMMER)
ELSE BEGIN
SEEK(IDFIL,POSITION(IDFIL)-1);
IDRESET.STATUS:=' ';
WRITE(IDFIL,IDRESET);
END;
END;
CLOSE(IDFIL);
END;
PROCEDURE FJERN_ID_FRA_TABEL;
VAR
FUNKB:STR1;
SLETNR:STR12;
FUND,I,N:INTEGER;
IDRECORD:IDSTATUS;
NYFIL:FILE OF IDSTATUS;
BEGIN
FUNKB:=' ';
WHILE FUNKB<>'' DO BEGIN
WRITELN(CLRHOM);
WRITELN(' ',RVSON,'LIST ELLER SLET NUMRE I IDENTIFIKATIONSNUMMERTABEL',
RVSOFF);
WRITELN;
WRITELN(' (L) LIST NUMRE I ID-TABEL');
WRITELN;
WRITELN(' (D) SLET NUMMER I ID-TABEL');
WRITELN;
WRITELN(' <RETURN> RETUR TIL HOVEDMENU');
WRITELN;
WRITE(' ( ) INDTAST SYMBOL FOR FUNKTION',^Æ,'=),');
READLN(FUNKB);
IF FUNKB='L' THEN
BEGIN
WRITELN(CLRHOM);
ASSIGN(IDFIL,'IDSTAT.DAT');
RESET(IDFIL);
N:=0;
WRITELN('RECORDNR: ID-NR: MARK:');
WHILE NOT EOF(IDFIL) DO
BEGIN
READ(IDFIL,IDRECORD);
WRITELN(POSITION(IDFIL),' ',
IDRECORD.IDNUMMER,' ',IDRECORD.STATUS);
N:=N+1;
IF N=20 THEN
BEGIN
WRITELN;
WRITELN;
WRITELN;
TAST:='';
WHILE TAST<>' ' DO
BEGIN
WRITE(^Æ,'=7 ','TRYK <SPACE> FOR AT FORTSÆTTE');
TAST:=CHR(BDOSB(1));
END;
END;
N:=0
END;
CLOSE(IDFIL);
TAST:='';
WHILE TAST<>' ' DO
BEGIN
WRITE(^Æ,'=7 ','TRYK <SPACE> FOR AT FORTSÆTTE');
TAST:=CHR(BDOSB(1));
END;
END ELSE
IF FUNKB='D' THEN
BEGIN
ASSIGN(IDFIL,'IDSTAT.DAT'); RESET(IDFIL);
WRITELN(CLRHOM);
WRITELN;
WRITE('HVILKET IDNUMMER ØNSKES SLETTET? ');READLN(SLETNR);
IF SLETNR<>'' THEN
BEGIN
I:=0;
WHILE NOT EOF(IDFIL) DO
BEGIN
READ(IDFIL,IDRECORD);
FUND:=POS(SLETNR,IDRECORD.IDNUMMER);
IF FUND<>0 THEN
BEGIN
I:=I+1;
IDRECORD.DELMARK:='*';
SEEK(IDFIL,POSITION(IDFIL)-1);
WRITE(IDFIL,IDRECORD);
END;
END;
CLOSE(IDFIL);
IF I<>0 THEN
BEGIN
ASSIGN(NYFIL,'IDSTAT.TMP'); REWRITE(NYFIL);
ASSIGN(IDFIL,'IDSTAT.DAT'); RESET(IDFIL);
WHILE NOT EOF(IDFIL) DO
BEGIN
READ(IDFIL,IDRECORD);
IF IDRECORD.DELMARK<>'*' THEN WRITE(NYFIL,IDRECORD);
END;
CLOSE(IDFIL); CLOSE(NYFIL);
ERASE(IDFIL); RENAME(NYFIL,'IDSTAT.DAT');
WRITELN('ID-NUMMER ',RVSON,SLETNR,RVSOFF,
' ER HERMED SLETTET I TABEL');
END ELSE
BEGIN
WRITELN('IDNUMMER IKKE FUNDET I TABEL!');
END;
TAST:='';
WHILE TAST<>' ' DO
BEGIN
WRITE(^Æ,'=7 ','TRYK <SPACE> FOR AT FORTSÆTTE');
TAST:=CHR(BDOSB(1));
END;
END;
END;
END;
END;
PROCEDURE INIT_DATAFIL;
BEGIN
ASSIGN(JOBFIL,'JOBSTAT.DAT');
RESET(JOBFIL);
READ(JOBFIL,JOBDEF);
CLOSE(JOBFIL);
ASSIGN(DATAFIL,'B:'+JOBDEF.DAYFILENAME+'.DAT');
REWRITE(DATAFIL);
CLOSE(DATAFIL);
END;
PROCEDURE SKRIV_NY_IDFIL;
BEGIN
ASSIGN(IDFIL,'IDSTAT.DAT');
REWRITE(IDFIL);
CLOSE(IDFIL);
END;
PROCEDURE SET_JOBTIDER;
VAR
VALID,I,TIMEVALID:INTEGER;
TIME3,TIME1,TIME2:STRING(.4.);
BEGIN
ASSIGN(JOBFIL,'JOBSTAT.DAT');
RESET(JOBFIL);
READ(JOBFIL,JOBDEF);
CLOSE(JOBFIL);
WRITELN(CLRHOM);
VALID:=0;
WRITELN(CLRHOM);
WHILE VALID=0 DO
BEGIN
WRITELN;
WRITELN('TIDSPUNKT FOR UDSKRIFT AF MANGLENDE DØGNRAPPORTER');
WRITELN;
WRITELN('TIDSPUNKT ER NU: ',JOBDEF.JOBTIME1);
WRITELN;
WRITE('INDTAST NY TID (TTMM) ELLER <RETURN> FOR INGEN ÆNDRING: ');
READLN(TIME1);
VAL(TIME1,TIMEVALID,I);
IF I=0 THEN
IF TIMEVALID>=0 THEN IF TIMEVALID<=2359 THEN VALID:=1 ELSE
IF TIME1='' THEN VALID:=1 ELSE VALID:=0;
WRITELN;
WRITELN;
END;
IF TIME1<>'' THEN
BEGIN
JOBDEF.JOBTIME1:=COPY(TIME1,3,2);
JOBDEF.JOBTIME1:=JOBDEF.JOBTIME1+COPY(TIME1,1,2);
WRITELN(RVSON,'NY TID FOR UDSKRIFT AF MANGLENDE DØGNRAPPORTET ',
'(AKTIONSTID 1): ',JOBDEF.JOBTIME1,RVSOFF);
END ELSE
WRITELN(RVSON,'UÆNDRET TID FOR UDSKRIFT AF MANGLENDE DØGNRAPPORTER',
' (AKTIONSTID 1): ', JOBDEF.JOBTIME1,RVSOFF);
VALID:=0;
TAST:='';
WHILE TAST<>' ' DO
BEGIN
WRITE(^Æ,'=7 ','TRYK <SPACE> FOR AT FORTSÆTTE');
TAST:=CHR(BDOSB(1));
END;
WRITELN(CLRHOM);
WHILE VALID=0 DO
BEGIN
WRITELN;
WRITELN('TIDSPUNKT FOR SKIFT AF DATAFILNAVN (DAYFILENAME)');
WRITELN;
WRITELN('TIDSPUNKT ER NU: ',JOBDEF.JOBTIME2);
WRITELN;
WRITE('INDTAST NY TID (TTMM) ELLER <RETURN> FOR INGEN ÆNDRING: ');
READLN(TIME2);
VAL(TIME2,TIMEVALID,I);
IF I=0 THEN
IF TIMEVALID>=0000 THEN IF TIMEVALID<=2359 THEN VALID:=1 ELSE
IF TIME2='' THEN VALID:=1 ELSE VALID:=0;
WRITELN;
WRITELN;
END;
IF TIME2<>'' THEN
BEGIN
JOBDEF.JOBTIME2:=COPY(TIME2,3,2);
JOBDEF.JOBTIME2:=JOBDEF.JOBTIME2+COPY(TIME2,1,2);
WRITELN(RVSON,'NY TID FOR SKIFT AF DAYFILENAVN (AKTIONSTID 2): ',
JOBDEF.JOBTIME2,RVSOFF);
END ELSE
WRITELN(RVSON,'UÆNDRET TID FOR SKIFT AF DAYFILENAVN',
' (AKTIONSTID 2): ',JOBDEF.JOBTIME2,RVSOFF);
VALID:=0;
BEGIN
WRITE(^Æ,'=7 ','TRYK <SPACE> FOR AT FORTSÆTTE');
TAST:=CHR(BDOSB(1));
END;
WRITELN(CLRHOM);
WHILE VALID=0 DO
BEGIN
WRITELN;
WRITELN('TIDSPUNKT FOR RESET AF JOBSTATUS');
WRITELN;
WRITELN('TIDSPUNKT ER NU: ',JOBDEF.JOBTIME3);
WRITELN;
WRITE('INDTAST NY TID (TTMM) ELLER <RETURN> FOR INGEN ÆNDRING: ');
READLN(TIME3);
VAL(TIME3,TIMEVALID,I);
IF I=0 THEN
IF TIMEVALID>=0000 THEN IF TIMEVALID<=2359 THEN VALID:=1 ELSE
IF TIME3='' THEN VALID:=1 ELSE VALID:=0;
WRITELN;
WRITELN;
END;
IF TIME3<>'' THEN
BEGIN
JOBDEF.JOBTIME3:='';
JOBDEF.JOBTIME3:=COPY(TIME3,3,2);
JOBDEF.JOBTIME3:=JOBDEF.JOBTIME3+COPY(TIME3,1,2);
WRITELN(RVSON,'NY TID FOR RESET AF JOBSTATUS (AKTIONSTID 3): ',
JOBDEF.JOBTIME3,RVSOFF);
END ELSE
WRITELN(RVSON,'UÆNDRET TID FOR RESET AF JOBSTATUS',
' (AKTIONSTID 3): ',JOBDEF.JOBTIME3,RVSOFF);
BEGIN
WRITE(^Æ,'=7 ','TRYK <SPACE> FOR AT FORTSÆTTE');
TAST:=CHR(BDOSB(1));
END;
ASSIGN(JOBFIL,'JOBSTAT.DAT');
RESET(JOBFIL);
WRITE(JOBFIL,JOBDEF);
CLOSE(JOBFIL);
END;
PROCEDURE SYSTEMMENU;
BEGIN
WRITELN(CLRHOM);
WRITELN;
WRITELN(' ',RVSON,'DATAOPSAMLINGSSYSTEM FOR AY4',
' MØNTTELEFONER',RVSOFF);
WRITELN;WRITELN;
WRITELN(' <RETURN> EXIT SYSTEM DEFINITIONER');
WRITELN;
WRITELN(' * (1) INDSTIL SYSTEMETS REALTIMECLOCK');
WRITELN(' (2) LIST/SLET IDENTIFIKATION I TABEL');
WRITELN(' (3) DEFINERE TIDSPARAMETRE');
WRITELN(' (4) OPRET IDENTIFIKATIONSNUMMER TABEL');
WRITELN(' (5) OPRET DATAFIL');
WRITELN(' (6) OPRET JOBSTATFIL');
WRITELN;
WRITELN;
WRITELN;
WRITE(' ( ) VÆLG FUNKTION');WRITE(^Æ,'=0/');
READLN(FUNKB);
END;
PROCEDURE MAINMENU;
BEGIN
WRITELN(CLRHOM);
WRITELN;
WRITELN(' ',RVSON,'DATAOPSAMLINGSSYSTEM FOR AY4 MØNTTELEFONER'
,RVSOFF);
WRITELN;
WRITELN;
WRITELN(' <RETURN> START SYSTEM');
WRITELN;
WRITELN(' (0) EXIT SYSTEM');
WRITELN;
WRITELN(' (1) SKIFT DATA DISKETTE');
WRITELN;
WRITELN(' (2) LIST/SLET NUMRE I ID-TABEL');
WRITELN;
WRITELN(' (9) SYSTEM PARAMETRE');
WRITELN;
WRITELN;
WRITE(' ( ) INDTAST FUNKTION');
WRITE(^Æ,'=01'); READLN(FUNKA);
END;
PROCEDURE CODE_CHECK;
VAR
KAR:INTEGER;
CODE1,CODE2,CODE3,LEVEL1:STRING(.1.);
CODETOT:STRING(.3.);
BEGIN
WRITELN(CLRHOM);
CODE1:=''; CODE2:=''; CODE3:=''; CODETOT:='';
WRITE(^Æ,'=.(');
WRITE(RVSON,' HAR DU FORSTAND PÅ DET ',BLKON,'?',
BLKOFF,RVSOFF,' (J/N) ');
READLN(LEVEL1);
IF LEVEL1='J' THEN BEGIN
CODETOT:='';
WRITELN(CLRHOM);
WRITE(^Æ,'=.(');
WRITE('INDTAST KODE:');
KAR:=BDOSB(1); CODE1:=CHR(KAR); WRITE(^H,' ');
KAR:=BDOSB(1); CODE2:=CHR(KAR); WRITE(^H,' ');
KAR:=BDOSB(1); CODE3:=CHR(KAR); WRITE(^H,' ');
CODETOT:=CODE1+CODE2+CODE3;
IF CODETOT=CODEORD THEN CODEOK:=1 ELSE CODEOK:=0;
END ELSE CODEOK:=0;
END;
PROCEDURE INIT_JOBSTATFIL;
BEGIN
JOBDEF.JOB1:=0;
JOBDEF.JOBTIME1:='0007';
JOBDEF.JOB2:=0;
JOBDEF.JOBTIME2:='0000';
JOBDEF.JOB3:=0;
JOBDEF.JOBTIME3:='3017';
JOBDEF.DAYFILENAME:='';
JOBDEF.DAYFILENAME:=DAG.ARSTAL+DAG.MANED+DAG.DATO;
ASSIGN(JOBFIL,'JOBSTAT.DAT');
REWRITE(JOBFIL);
WRITE(JOBFIL,JOBDEF);
CLOSE(JOBFIL);
END;
PROCEDURE SYSTEM;
BEGIN
FUNKB:=' ';
WHILE FUNKB<>'' DO
BEGIN
LAS_REALTIME_CLOCK;
WRITELN(^Æ,'= Q',RVSON,DAG.DATO,'/',DAG.MANED,'-',
DAG.ARSTAL,' KL. ',DAG.TIMER,':',
DAG.MINUT,':',DAG.SEKUND,RVSOFF);
SYSTEMMENU;
IF FUNKB='1' THEN BEGIN
ASSIGN(TIMESETFIL,'TIME10.COM S');
EXECUTE(TIMESETFIL)
END ELSE
IF FUNKB='2' THEN FJERN_ID_FRA_TABEL ELSE
IF FUNKB='3' THEN SET_JOBTIDER ELSE
IF FUNKB='4' THEN SKRIV_NY_IDFIL ELSE
IF FUNKB='5' THEN INIT_DATAFIL ELSE
IF FUNKB='6' THEN INIT_JOBSTATFIL;
END;
END;
PROCEDURE SKIFT_DATADISK;
VAR
FUNKC:STRING(.2.);
BEGIN
WRITELN(CLRHOM);
WRITELN(' ',RVSON,'SKIFT AF DATADISKETTE',RVSOFF);
WRITELN;
WRITELN;
WRITELN(' INDSÆT TOM FORMATERET DISKETTE I DRIVE B:');
WRITELN;
WRITELN;
WRITELN(' TRYK: ',RVSON,'OK <RETURN>',RVSOFF,' NÅR DISK KLAR');
WRITELN;
WRITELN( 'ELLER');
WRITELN;
WRITELN(' TRYK: ',RVSON,'<RETURN>',RVSOFF,' FOR RETUR TIL MENU');
WRITELN;
WRITE(' INDTAST FUNKTION: '); READLN(FUNKC);
IF FUNKC='OK' THEN INIT_DATAFIL;
END;
BEGIN
WHILE FUNKA<>'0' DO
BEGIN
LAS_REALTIME_CLOCK;
WRITELN(^Æ,'=!!',RVSON,DAG.DATO,'/',DAG.MANED,'-',
DAG.ARSTAL,' KL. ',DAG.TIMER,':',
DAG.MINUT,':',DAG.SEKUND,RVSOFF);
MAINMENU;
IF FUNKA='1' THEN SKIFT_DATADISK ELSE
IF FUNKA='2' THEN FJERN_ID_FRA_TABEL ELSE
IF FUNKA='9' THEN BEGIN
CODE_CHECK;
IF CODEOK=1 THEN SYSTEM ELSE WRITELN(^G);
END ELSE
IF FUNKA='' THEN BEGIN
ASSIGN(MODTAGEFIL,'A2-300-2.COM');
EXECUTE(MODTAGEFIL);
END
END;
END.
«eof»