|
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: 9728 (0x2600)
Types: TextFile
Names: »SISABON.PAS«
└─⟦d814f614c⟧ Bits:30008872 EDB Trænings- og Erhvervs Center / Almen Nyttig Data Service
└─⟦this⟧ »SISABON.PAS«
PROGRAM SISABON;
(* DETTE PROGRAM VEDLIGEHOLDER DEN INTERNE OG DEN EXTERNE ABONNEMENTS- *)
(* FIL TIL SIS-MANUALERNE. BRUGEREN VÆLGER VIA EN MENU DEN FIL DER *)
(* SKAL BEARBEJDES. HEREFTER KAN DER BLADRES FREM I FILEN TIL DEN ØNS- *)
(* KEDE POST, SOM HEREFTER ENTEN KAN SLETTES ELLER RETTES. *)
(* NÅR PROGRAMMET NÅR BUNDEN AF FILEN, KAN MAN OPRETTE NYE POSTER. *)
(* PROGRAMMET LÆSER DE GAMLE POSTER PÅ DE EKSISTERENDE FILER OG GENE- *)
(* RERER NYE FILER UDFRA DE INDTASTEDE OPLYSNINGER. *)
(* PROGRAMMET TERMINERER VED AT INDTASTE 0 I MENU. *)
(* PROGRAMMØR : HELLE ALLESEN-VERNØ DATO : 1984.03.13 *)
(****************** VARIABELDEKLARATION FOR HOVEDPROGRAM **************)
VAR F, W : TEXT;
S : STRINGÆ130Å;
Q, K, N, P, BP, L, SP, ANTPOST, SZ : INTEGER;
FIRSTLN, SECONDLN, ASTR : STRINGÆ70Å;
BUF : ARRAYÆ1..7Å OF STRINGÆ130Å;
DUMMY : INTEGER;
SV, V, B : CHAR;
TST : BOOLEAN;
KEYBOARD, CRT : TEXT;
CONST DELSCR = 12;
DELREST = 31;
DELLINE = 30;
(****************** PROCEDURE TIL CURSORSTYRING ************************)
PROCEDURE GOTOXY (X,Y : INTEGER);
BEGIN
WRITE (CHR(6),CHR(Y+32),CHR(X+32));
END;
(*********************** STJERNEKANT PROCEDURE ****************************)
PROCEDURE WRITEEDGE;
VAR I : INTEGER;
BEGIN
FOR I :=0 TO 79 DO BEGIN
GOTOXY(I,0); WRITE('*'); GOTOXY(I,23); WRITE('*'); END;
FOR I :=1 TO 23 DO BEGIN
GOTOXY(0,I); WRITE('*'); GOTOXY(79,I); WRITE('*'); END;
END;
(********************* PROCEDURE TIL HOVEDMENU ******************************)
PROCEDURE MENU;
BEGIN
GOTOXY(0,0); WRITE(CHR(DELSCR));
WRITEEDGE;
GOTOXY(13,4);
WRITE('*** VEDLIGEHOLDELSE AF SIS-ABONNEMENTSFILER ***');
GOTOXY(29,7); WRITE('*** MENU ***');
GOTOXY(24,9);
WRITE('1 : EXTERNE ABONNENTER');
GOTOXY(24,11);
WRITE('2 : INTERNE ABONNENTER');
GOTOXY(24,13);
WRITE('0 : STOP');
GOTOXY(24,16); WRITE('INDTAST VALG : ');
REPEAT
READ(KEYBOARD,V);
UNTIL V IN Æ'0','1','2'Å;
WRITE(V);
END;
(********************** PROCEDURE TIL UNDERMENU ****************************)
PROCEDURE UNDERMENU;
BEGIN
GOTOXY(0,0); WRITE(CHR(DELSCR));
WRITEEDGE;
GOTOXY(17,5); WRITE('DU ER NU VED STARTEN AF FILEN: ',ASTR);
GOTOXY(17,6); WRITE('FILEN ER ',ANTPOST-1,' POSTER LANG ');
GOTOXY(17,8); WRITE('DU KAN BLADRE FREM I FILEN VED AT INDTASTE');
GOTOXY(17,9); WRITE('DET ANTAL POSTER, DU ØNSKER AT SPRINGE OVER.');
GOTOXY(17,10);
WRITE('HEREFTER BLIVER DEN NÆSTE POST I FILEN VIST PÅ SKÆRMEN.');
GOTOXY(17,11); WRITE('DU KAN SÅ VÆLGE AT RETTE ELLER SLETTE POSTEN.');
GOTOXY(17,13);
WRITE('HVIS DU ER FÆRDIG - TAST ET TAL STØRRE END ANTAL POSTER');
GOTOXY(17,15); WRITE('NÅR HELE FILEN ER LÆST, ER DER MULIGHED FOR AT');
GOTOXY(17,16); WRITE('OPRETTE NYE ABONNENTER.');
GOTOXY(30,19); WRITE('TAST RETUR ');
READ (SV);
END;
(********************** VENTEPROCEDURE ********************************)
PROCEDURE WAIT;
VAR I : INTEGER;
BEGIN
GOTOXY(0,0); FOR I :=1 TO 30000 DO I:=I;
END;
(********************* PROCEDURE TIL UDSKRIVNING PÅ SKÆRM *******************)
PROCEDURE SKRIV;
VAR SP, LGD, STARTPOS, POS : INTEGER;
FOUND : BOOLEAN;
BEGIN
GOTOXY(0,0); WRITE(CHR(DELSCR));
LGD:=LENGTH(BUFÆ1Å);
FOUND:=FALSE;
STARTPOS:=LGD;
IF STARTPOS > 75 THEN
BEGIN
STARTPOS :=75;
POS:=STARTPOS;
WHILE (POS > 0) AND (NOT FOUND) DO
BEGIN
IF BUFÆ1,POSÅ = ',' THEN FOUND :=TRUE
ELSE POS:=POS-1;
END;
IF FOUND THEN BEGIN
FIRSTLN:=COPY(BUFÆ1Å,1,POS);
SECONDLN:=COPY(BUFÆ1Å,POS+1,LGD-POS);
END
ELSE BEGIN
FIRSTLN:=COPY(BUFÆ1Å,1,75);
SECONDLN:=COPY(BUFÆ1Å,76,LGD-75);
END;
END
ELSE BEGIN
FIRSTLN:=COPY(BUFÆ1Å,1,STARTPOS);
SECONDLN:='';
END;
GOTOXY(0,1); WRITE('1 ',FIRSTLN);
GOTOXY(0,2); WRITE('2 ',SECONDLN);
L:= 3;
FOR SP:= BP DOWNTO 2 DO BEGIN
GOTOXY(0,L); WRITE(L,' ',BUFÆL-1Å);(* buffer skrives ud på skærm *)
L:=L+1;
END;
END;
(**************** PROCEDURE TIL UDSKRIVNING PÅ SKÆRM OG SLET/RET *************)
PROCEDURE SKAERMBUF;
VAR Q, LNR, SP : INTEGER;
NS : STRINGÆ130Å;
SVAR : CHAR;
BEGIN
SKRIV; (* DEN LÆSTE POST UDSKRIVES PÅ SKÆRM *)
GOTOXY(0,10); WRITE('INDTAST R(ET), S(LET) ELLER V(IDERE) ');
READ (B);
IF B IN Æ'R','r','S','s'Å THEN BEGIN
IF B IN Æ'R','r'Å THEN BEGIN
REPEAT
GOTOXY(0,15); WRITE(CHR(DELLINE));
WRITE('INDTAST LINIENR/RETUR - 0 FOR STOP ');
READ (LNR); GOTOXY(35,15); WRITE(LNR);
UNTIL LNR IN Æ0,1,2,3,4,5,6,7,8Å;
WHILE LNR <> 0 DO BEGIN
GOTOXY(0,16); WRITE ('INDTAST NY LINIE ');
READ(NS);
IF (LNR < 9) AND (LNR <=(BP+2)) THEN BEGIN
IF LNR=1 THEN
FIRSTLN:=NS
ELSE
IF LNR=2 THEN
SECONDLN:=NS
ELSE BUFÆLNR-1Å:=NS;
IF LNR = (BP+2) THEN BP:= BP+1;
END
ELSE BEGIN
GOTOXY(0,20);
WRITE('MAX 8 LINIER OG INGEN TOMME LINIER I POST');
WAIT;
END;
BUFÆ1Å:=CONCAT(FIRSTLN, SECONDLN);
SKRIV; (* DEN RETTEDE POST UDSKRIVES PÅ SKÆRM *)
REPEAT
GOTOXY(0,15); WRITE(CHR(DELREST));
GOTOXY(0,15); WRITE ('INDTAST LINIENR/RETUR - 0 FOR STOP ');
READ(LNR); GOTOXY(35,15); WRITE(LNR);
UNTIL LNR IN Æ0,1,2,3,4,5,6,7,8Å;
END;
FOR SP:=1 TO BP DO
WRITELN(W,BUFÆSPÅ); (* DEN KORRIGEREDE POST SKRIVES PÅ FIL *)
WRITELN(W); (* TOM LINIE *)
END
ELSE BEGIN
GOTOXY(0,15); WRITE('ØNSKER DU AT SLETTE DENNE POST ? J/N ! ');
READ (SVAR);
IF SVAR IN Æ'J','j'Å THEN BEGIN
GOTOXY(0,17); WRITE ('POSTEN SLETTES! ');
WAIT;
END
ELSE BEGIN
GOTOXY(0,17); WRITE ('POSTEN GEMMES ');
WAIT;
FOR SP:=1 TO BP DO
WRITELN(W,BUFÆSPÅ);
WRITELN(W); (* TOM LINIE *)
END;
END;
END;
GOTOXY(0,0); WRITE(CHR(DELSCR));
END;
(****************** OPRETTELSES PROCEDURE *************************)
PROCEDURE OPRET;
VAR SZ : INTEGER;
BEGIN
IF SV IN Æ'J','j'Å THEN BEGIN
GOTOXY(0,0); WRITE(CHR(DELSCR));
GOTOXY(0,3); WRITE('INDTAST LINIER(MAX 2 NUMMERLINIER OG 6 ADRESSELINIER)');
GOTOXY(0,4); WRITE('LINIE 2 ER EN FORTSÆTTELSE AF LIN. 1 - KUN TIL NUMRE');
GOTOXY(0,5); WRITE('1 '); READ(FIRSTLN);
GOTOXY(0,6); WRITE('2 '); READ(SECONDLN);
L:=3;
REPEAT
GOTOXY(0,4+L); WRITE(L,' '); READ(S);
BUFÆL-1Å:=S; BP:=L-1; L:=L+1;
UNTIL (S = '') OR (L>8);
BP:=BP-1;
BUFÆ1Å:=CONCAT(FIRSTLN,SECONDLN);
SKAERMBUF; (* DEN INDTASTEDE POST UDSKRIVES PÅ SKÆRM TIL RET *)
IF B IN Æ'R','r','S','s'Å THEN
ELSE BEGIN
FOR SZ:=1 TO BP DO
WRITELN(W,BUFÆSZÅ);
WRITELN(W); (* TOM LINIE *)
END;
END;
END;
(******************* HER BEGYNDER HOVEDPROGRAMMET *******************)
BEGIN
ASSIGN(KEYBOARD,'KBD:'); ASSIGN(CRT,'TRM:');
RESET (KEYBOARD);
IF IORESULT = 255 THEN WRITELN('FEJL VED ÅBNING AF TASTATUR') ELSE BEGIN
REWRITE (CRT);
IF IORESULT = 255 THEN WRITELN('FEJL VED ÅBNING AF SKÆRM') ELSE BEGIN
MENU; (* PROCEDURE TIL VALG AF FIL *)
WHILE V <> '0' DO BEGIN
IF V = '1' THEN BEGIN
ASSIGN(F,'EXTFIL.TST');
ASSIGN(W,'NYEXT.TST');
ASTR:='EXTERNE ABONNENTER';
END;
IF V = '2' THEN BEGIN
ASSIGN (F,'INTFIL.TST');
ASSIGN (W,'NYINT.TST');
ASTR:='INTERNE ABONNENTER';
END;
RESET(F);
REWRITE(W);
IF IORESULT = 255 THEN WRITELN(' FEJL VED ÅBNING AF FILER ')
ELSE BEGIN
ANTPOST:=0;
REPEAT
READLN(F,S);
IF S='' THEN ANTPOST:=ANTPOST+1;
UNTIL S = 'finis';
RESET (F);
K:=0;
P:=0;
UNDERMENU;
GOTOXY(0,0); WRITE(CHR(DELSCR));
WRITELN('INDTAST ANTAL POSTER, DU ØNSKER AT SPRINGE OVER OG RETUR (200 for stop');
READ (P);
P:=ABS(P);
READLN (F,S);
WHILE S <> 'finis' DO BEGIN
BP:=0;
WHILE S<> '' DO BEGIN
BP:=BP+1;
BUFÆBPÅ:=S; (* SKRIVNING I BUFFER *)
READLN (F,S);
END; (* WHILE NOT BLANK *)
IF P=K THEN BEGIN
SKAERMBUF; (* PROC. TIL DISPLAY AF BUFFER *)
WRITELN ('INDTAST ANTAL POSTER, DU ØNSKER AT SPRINGE OVER OG RETUR');
READ (N);
N:=ABS(N);
P:=P+N;
END
ELSE BEGIN
FOR Q := 1 TO BP DO
WRITELN (W,BUFÆQÅ);
WRITELN(W);
K:=K+1;
END;
READLN(F,S);
END; (* WHILE NOT FINIS *)
REPEAT
GOTOXY(0,0); WRITE(CHR(DELSCR));
GOTOXY(0,10); WRITE('ØNSKER DU AT OPRETTE NYE ABONNENTER? ');
GOTOXY(0,11); WRITE('TAST J ELLER N : ');
READ(SV);
WRITELN;
OPRET; (* PROC. TIL OPRETTELSER AF NYE POSTER *)
UNTIL SV IN Æ'N','n'Å;
WRITELN (W,'finis');
CLOSE (W,DUMMY);
IF IORESULT = 255 THEN
WRITELN ('ERROR CLOSING');
END; (* BEGIN EFTER IORESULTTEST *)
MENU;
END; (* WHILE NOT 0 IN MENU *)
GOTOXY(0,0); WRITE(CHR(DELSCR));
END;
END;
END.
«eof»