|
|
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: 7296 (0x1c80)
Types: TextFile
Names: »MENUFIL.PAS«
└─⟦08ea08c61⟧ Bits:30003924 PolyPascal programmer
└─⟦this⟧ »MENUFIL.PAS«
└─⟦09235ab48⟧ Bits:30003065 Demoprogrammer K-Z til Pascal bog
└─⟦this⟧ »MENUFIL.PAS«
└─⟦092727b26⟧ Bits:30005927 Demoprogrammer til Pascal bog (Jet-80)
└─⟦this⟧ »MENUFIL.PAS«
PROGRAM menufil;
TYPE
str30 = STRING(.30.);
medlemspost = RECORD
navn, adresse, by, info : str30;
END;
VAR
fil : FILE OF medlemspost;
medlem : medlemspost;
ch : CHAR;
PROCEDURE retur;
VAR
ch : CHAR;
BEGIN (* retur *)
WRITE('Tast <RETURN>: ');
REPEAT
READ(KBD, ch);
UNTIL ch = CHR(13);
END; (* retur *)
PROCEDURE opret;
VAR
filnavn : STRING(.14.);
BEGIN (* opret *)
WRITE(CLRHOM);
GOTOXY(10, 5);
WRITE('Hvad skal kartoteket hedde: ');
READLN(filnavn);
ASSIGN(fil, filnavn);
REWRITE(fil);
GOTOXY(10, 7);
WRITE(filnavn, ' er nu oprettet');
GOTOXY(10, 9);
retur;
END; (* opret *)
PROCEDURE hvilkenfil;
VAR
filnavn : STRING(.14.);
BEGIN (* hvilkenfil *)
WRITE(CLRHOM);
GOTOXY(10, 5);
WRITE('Hvad hedder den eksisterende fil: ');
READLN(filnavn);
ASSIGN(fil, filnavn);
RESET(fil);
GOTOXY(10, 7);
retur;
END; (* hvilkenfil *)
PROCEDURE udskriv;
VAR
i : INTEGER;
ch : CHAR;
udfil : TEXT;
udnavn : STRING(.4.);
BEGIN (* udskriv *)
WRITE(CLRHOM);
WRITE('Ønskes udskrift på skærm eller printer (s/p): ');
REPEAT
READ(KBD, ch);
UNTIL ch IN (. 'S', 's', 'P', 'p'.);
WRITELN(ch);
IF ch IN (. 'S', 's'.)
THEN udnavn := 'CON:'
ELSE udnavn := 'LST:';
ASSIGN(udfil, udnavn);
RESET(fil);
REWRITE(udfil);
i := 0;
WHILE NOT EOF(fil) DO
BEGIN
i := i + 1;
READ(fil, medlem);
WITH medlem DO
BEGIN
IF navn <> ''
THEN
BEGIN
WRITELN('Medlem nr. ', i, ': ');
WRITELN(navn);
WRITELN(adresse);
WRITELN(by);
WRITELN(info);
WRITELN;
END;
END;
END;
WRITELN;
retur;
END; (* udskriv *)
PROCEDURE slet;
VAR
medlemsnr : INTEGER;
ch : CHAR;
BEGIN (* slet *)
WRITE(CLRHOM);
GOTOXY(10, 5);
WRITE('Hvem skal slettes? Tast medlemsnummer: ');
READLN(medlemsnr);
GOTOXY(10, 7);
IF medlemsnr > LENGTH(fil)
THEN WRITE('Medlemsnummeret er for stort')
ELSE
BEGIN
SEEK(fil, medlemsnr - 1);
READ(fil, medlem);
WITH medlem DO
BEGIN
IF navn = ''
THEN WRITELN('Der er intet medlem med dette nummer')
ELSE
BEGIN
WRITE('Skal ', navn, ' slettes (j/n): ');
REPEAT
READ(KBD, ch);
UNTIL ch IN (. 'J', 'j', 'N', 'n'.);
WRITELN(ch);
IF ch IN (. 'J', 'j'.)
THEN navn := '';
SEEK(fil, medlemsnr - 1);
WRITE(fil, medlem);
END;
END;
END;
GOTOXY(10, 9);
retur;
END; (* slet *)
PROCEDURE ret;
VAR
medlemsnr : INTEGER;
ch : CHAR;
BEGIN (* ret *)
WRITE(CLRHOM);
GOTOXY(10, 0); WRITE('Tast medlemsnummer: '); READLN(medlemsnr);
SEEK(fil, medlemsnr - 1);
READ(fil, medlem);
SEEK(fil, medlemsnr - 1);
WITH medlem DO
BEGIN
GOTOXY(10, 2); WRITE('Navn: ', navn);
GOTOXY(10, 3); WRITE('Adresse: ', adresse);
GOTOXY(10, 4); WRITE('By: ', by);
GOTOXY(10, 5); WRITE('Info: ', info);
GOTOXY(10, 7); WRITE('Hvad skal rettes:');
GOTOXY(10, 8); WRITE('N Navn');
GOTOXY(10, 9); WRITE('A Adresse');
GOTOXY(10, 10); WRITE('B By');
GOTOXY(10, 11); WRITE('I Info');
GOTOXY(10, 12); WRITE('F FÆRDIG');
REPEAT
GOTOXY(0, 14); WRITE(CLREOS);
GOTOXY(10, 14); WRITE('Tast kommando (N/A/B/I/F): ');
REPEAT
READ(KBD, ch);
UNTIL ch IN (. 'N', 'n', 'A', 'a', 'B', 'b', 'I', 'i', 'F', 'f'.);
WRITE(ch);
GOTOXY(10, 16); WRITE('Tast ændring: ');
CASE ch OF
'N', 'n' : READ(navn);
'A', 'a' : READ(adresse);
'B', 'b' : READ(by);
'I', 'i' : READ(info);
END;
IF NOT (ch IN (.'F', 'f'.))
THEN
BEGIN
GOTOXY(10, 18);
retur;
END;
UNTIL ch IN (.'F', 'f'.);
WRITE(fil, medlem);
END;
END; (* ret *)
PROCEDURE tilfoej;
VAR
filpointer : INTEGER;
nytmedlem : medlemspost;
BEGIN (* tilfoej *)
WRITE(CLRHOM);
RESET(fil);
filpointer := 0;
IF LENGTH(fil) > 0
THEN
BEGIN
READ(fil, medlem);
filpointer := 1;
WHILE (medlem.navn <> '') AND NOT EOF(fil) DO
BEGIN
READ(fil, medlem);
filpointer := filpointer + 1;
END;
IF medlem.navn = ''
THEN filpointer := filpointer - 1;
END;
WITH nytmedlem DO
BEGIN
GOTOXY(10, 5); WRITE('Nyt medlem nr: ', filpointer + 1);
GOTOXY(10, 7); WRITE('Navn: '); READ(navn);
GOTOXY(10, 9); WRITE('Adresse: '); READ(adresse);
GOTOXY(10, 11); WRITE('By: '); READ(by);
GOTOXY(10, 13); WRITE('Info: '); READ(info);
END;
SEEK(fil, filpointer);
WRITE(fil, nytmedlem);
GOTOXY(10, 15);
retur;
END; (* tilfoej *)
BEGIN (* menufil *)
WRITE(CLRHOM);
GOTOXY(10, 5); WRITE('M E D L E M S K A R T O T E K');
GOTOXY(10, 7); WRITE('Skal du arbejde med et nyt eller et allerede');
GOTOXY(10, 8); WRITE('eksisterende kartotek (N/E): ');
REPEAT
READ(KBD, ch);
UNTIL ch IN (. 'N', 'n', 'E', 'e'.);
IF ch IN (. 'N', 'n'.)
THEN opret
ELSE hvilkenfil;
REPEAT
WRITE(CLRHOM);
GOTOXY(10, 7); WRITE('M E D L E M S K A R T O T E K');
GOTOXY(10, 9); WRITE('Udskrive kartoteket');
GOTOXY(10, 11); WRITE('Slette medlem');
GOTOXY(10, 13); WRITE('Rette i medlemspost');
GOTOXY(10, 15); WRITE('Indsætte nyt medlem i kartotek');
GOTOXY(10, 17); WRITE('AFSLUTTE programkørslen');
GOTOXY(10, 19); WRITE('Tast kommando: (U/S/R/I/A): ');
REPEAT
READ(KBD, ch);
UNTIL ch IN (. 'U', 'u', 'S', 's', 'R', 'r', 'I', 'i', 'A', 'a'.);
WRITELN(ch);
CASE ch OF
'U', 'u' : udskriv;
'S', 's' : slet;
'R', 'r' : ret;
'I', 'i' : tilfoej;
END;
UNTIL ch IN (. 'A', 'a'.);
WRITELN;
CLOSE(fil);
END. (* menufil *)
«eof»