(**************************************************************************) (* Programm 8.5 von Rene' Scholz *) (* Erstellen einer Bibliotheks-kartei mit Funktionen *) (**************************************************************************) program bibliothek (input,output); uses crt; const Legal = [ 'E','e','S','s','W','w','L','l', 'A','a','Z','z' ,'K','k', 'I','i' ]; type wort = string[70]; karte = ^kartei; kartei = record Au : wort; (* Autor *) Bu : wort; (* Buch *) Vlg : wort; (* Verlag *) FG : wort; (* Fachgebiet *) BSN : wort; (* Bestandsnummer *) next : karte; (* naechste Karte *) davor : karte; (* vorige Karte *) end; bibo_datei = File of kartei; var erste, vorige, aktuelle, naechste : karte; wk : kartei; bd : bibo_datei; liste : boolean; laenge, akt_nummer : integer; dat : wort; eg : string[1]; { procedure cls; begin writeln( chr(27), '[2J', chr(27), '[;H' ); end; } procedure wln( z : integer); { zeilenvorschub } var i :integer; begin for i:=1 to z do writeln; end; procedure dok; begin clrscr; writeln(' Welcome to ** BIBO ** (c) By Rene'' Scholz '); wln(2); writeln('Mit BIBO koennen Sie bequem ihre Bibliotheks-Kartei verwalten .'); wln(3); writeln('Eine Kartei-Karte enthaelt die folgenden Informationen : '); writeln; writeln('** Autor, Buch, Verlag, Fachgebiet und Bestandsnummer ** '); wln(3); writeln('Sie koennen folgende Aktionen durchfuehren : '); wln(4); writeln(' Einfuegen, Streichen, '); writeln(' Korrigieren und Anzeigen von Eintraegen . '); writeln(' Wildcard-Suche in den Eintraegen . '); writeln(' Laden ihrer BiBo-Dateien . '); writeln(' Abspeichern ihrer BiBo-Dateien . '); writeln(' Informationen anzeigen . '); readln; end; function Menu : char; begin repeat clrscr; writeln(' Welcome to ** BIBO ** (c) By Rene'' Scholz '); wln(3); writeln(' E_infuegen '); writeln(' S_treichen '); writeln(' Z_eigen '); writeln(' W_ildcard-Suche '); writeln(' L_aden '); writeln(' A_bspeichern '); writeln(' K_orrigieren '); writeln(' I_nfo''s '); wln(2); writeln('Sie beenden ** BIBO ** mit Enter '); wln(3); write('Was wollen Sie durchfuehren ? : '); readln(eg); until (eg[1] in Legal) or (eg=''); if eg='' then menu:=' ' else menu:=eg[1]; clrscr; end; { of Menu } procedure Info; begin clrscr; if liste then begin wln(5); writeln('Zur Zeit existieren ',laenge,' Eintraege in ihrer Liste .'); wln(3); if dat='' then writeln('Sie haben aber noch keine Datei angelegt ! ') else writeln('Ihre aktuelle Datei ist ---> ',dat); end else begin writeln('Zur Zeit existiert noch keine Liste !!! '); wln(5); writeln('Sie koennen Eintraege einfuegen ', 'oder eine BIBO-Datei einladen . '); end; readln; end; { of Info } procedure suche_eintrag( nr:integer); begin if (nr > akt_nummer) then { Vorwaertssuchen } begin while (akt_nummer<nr) do begin aktuelle:=aktuelle^.next; akt_nummer:=akt_nummer + 1; end; end else if (nr < akt_nummer) then { Rueckwaertssuchen } begin while (akt_nummer > nr) do begin aktuelle:=aktuelle^.davor; akt_nummer:=akt_nummer - 1; end; end; end; { of suche_eintrag } procedure zeige_eintrag( nr:integer); begin suche_eintrag(nr); writeln(' --- Eintrag Nr. ' ,nr:6, ' --- '); writeln;writeln;writeln; with aktuelle^ do begin writeln('Autor : ' , au); writeln('Buch : ' , bu); writeln('Verlag : ' , vlg); writeln('Fachgebiet : ' , FG); writeln('Bestandsnummer : ' , BSN); end; writeln;writeln;writeln; end; { of zeige_eintrag } procedure L_aden; begin clrscr; writeln(' --- Einladen Ihrer BiBo-Datei --- '); wln(2); writeln(' --- Default Datei ---> Bibo.BIB '); writeln(' --- Default Extension ---> *.bib '); wln(3); write('Welche Datei wollen Sie einladen ? '); readln(dat); if dat='' then dat:='bibo'; if pos('.',dat)=0 then dat:=dat + '.bib'; wln(2); writeln(' ---> ',dat); assign(bd,dat); reset(bd); aktuelle :=erste; vorige :=erste; laenge:=0; akt_nummer:=0; while not eof(bd) do begin new(aktuelle); read(bd,aktuelle^); vorige^.next:=aktuelle; aktuelle^.davor:=vorige; vorige:=aktuelle; laenge:=laenge + 1; akt_nummer:=akt_nummer + 1; end; aktuelle^.next:=NIL; liste:=true; wln(3); writeln(' ---> Gesamt-Eintraege : ',laenge ); wln(3); readln; end; { of Laden } procedure A_bspeichern; begin clrscr; writeln(' --- Abspeichern Ihrer BiBo-Datei --- '); writeln(' --- Gesamt-Eintraege : ',laenge ,' --- ' ); wln(2); writeln(' --- Default Datei ---> Bibo.BIB '); writeln(' --- Default Extension ---> *.bib '); wln(3); write('Welche Datei wollen Sie abspeichern ? '); readln(dat); if dat='' then dat:='bibo'; if pos('.',dat)=0 then dat:=dat + '.bib'; wln(2); writeln(' ---> ',dat); assign(bd,dat); rewrite(bd); aktuelle:=erste; while (aktuelle^.next <> NIL) do begin aktuelle:=aktuelle^.next; write(bd,aktuelle^); end; close(bd); end; { of A_bspeichern } procedure lese_wildcard ( var wk :kartei); begin clrscr; wln(2); writeln('Eingaben wie bei DOS, fuer ein beliebiges Wort', ' betaetigen Sie "Enter" . '); wln(2); writeln('Beispiel : fuer Autor --> "Sch*" eingeben '); writeln('oder : fuer Buch --> "*buch*" eingeben '); wln(2); writeln('Geben Sie jetzt ihre Wildcards ein : '); wln(3); with wk do begin write(' Autor ? '); readln(au); write(' Buch ? '); readln(bu); write(' Verlag ? '); readln(vlg); write(' Fachgebiet ? '); readln(FG); write(' Nummer ? '); readln(BSN); end; clrscr; end; { of lese_wildcard } function w_wort_vgl ( ws,hs :wort) : boolean; var i,lws,lhs,lw_string : integer; erg : boolean; w_string : wort; begin erg:=true; lws:=length(ws); lhs:=length(hs); w_string:=ws; if ws[lws]='*' then w_string:=copy(ws,1,lws-1); lw_string:=length(w_string); if ws[1]='*' then w_string:=copy(w_string,2,lw_string-1); lw_string:=length(w_string); if (ws[1]='*') and (ws[lws]='*') then erg:=(pos(w_string,hs) <> 0) else if (ws[1]<>'*') and (ws[lws]<>'*') then erg:=(w_string=hs) else if (ws[1]='*') and (ws[lws]<>'*') then erg:=( copy(hs,lhs-lw_string,lw_string) = w_string ) else erg:=(pos(w_string,hs) = 1 ); w_wort_vgl:=erg; end; function w_vergleich ( wk :kartei) :boolean; var erg : boolean; begin erg:=true; with aktuelle^ do begin if (wk.au<>'') and (wk.au<>'*') then begin erg:=w_wort_vgl(wk.au , aktuelle^.au) and erg; end; if (wk.bu<>'') and (wk.bu<>'*') then begin erg:=w_wort_vgl(wk.bu , aktuelle^.bu) and erg; end; if (wk.vlg<>'') and (wk.vlg<>'*') then begin erg:=w_wort_vgl(wk.vlg , aktuelle^.vlg) and erg; end; if (wk.FG<>'') and (wk.FG<>'*') then begin erg:=w_wort_vgl(wk.FG , aktuelle^.FG) and erg; end; if (wk.BSN<>'') and (wk.BSN<>'*') then begin erg:=w_wort_vgl(wk.BSN , aktuelle^.BSN) and erg; end; end; { of with } w_vergleich:=erg; end; { of w_vergleich } procedure W_ildcard_suche; var i : integer; gef : boolean; begin repeat gef:=false; clrscr; writeln(' --- Suchen in Ihrer BiBo-Datei --- '); writeln(' --- Gesamt-Eintraege : ',laenge:6 ,' --- ' ); lese_wildcard(wk); aktuelle:=erste; akt_nummer:=0; i:=1; repeat aktuelle:=aktuelle^.next; akt_nummer:=akt_nummer + 1; if w_vergleich(wk) then { gefundenen Eintrag anzeigen } begin gef:=true; clrscr; writeln(' --- Anzeigen Ihrer BiBo-Datei --- '); writeln(' --- Gesamt-Eintraege : ',laenge:6,' --- '); wln(2); writeln(' --- Eintrag Nr. ' ,i:6, ' --- '); wln(3); with aktuelle^ do begin writeln('Autor : ' , au); writeln('Buch : ' , bu); writeln('Verlag : ' , vlg); writeln('Fachgebiet : ' , FG); writeln('Bestandsnummer : ' , BSN); end; wln(2); write(' Enter for more '); readln; end; i:=i+1; until (aktuelle^.next=NIL); { alle Karten wurden angesehen } wln(3); if not gef then writeln(' Es wurden keine passenden Eintraege gefunden !!! '); wln(2); write(' Suchen fortsetzen ? (j/N) '); readln(eg); until (eg='') or (eg[1]='N') or (eg[1]='n'); end; { of W_ildcard_suche } procedure streiche_eintrag ( nr :integer); begin suche_eintrag(nr); vorige:=aktuelle^.davor; naechste:=aktuelle^.next; vorige^.next:=naechste; naechste^.davor:=vorige; dispose(aktuelle); laenge:=laenge-1; aktuelle:=naechste; if laenge=0 then liste:=false; end; { of streiche_eintrag } procedure S_treichen; var i,n1,n2 : integer; gef : boolean; begin repeat clrscr; writeln(' --- Streichen in Ihrer BiBo-Datei --- '); writeln(' --- Gesamt-Eintraege : ',laenge ,' --- ' ); wln(2); write('Streichen mit Wild-Cards oder mit Nummern ? (W/n) '); readln(eg); if (eg[1]='N') or (eg[1]='n') then begin repeat write(' Nummer des 1. Eintrages ? '); readln(n1); until n1>0; if n1>laenge then n1:=laenge; repeat write(' Nummer des 2. Eintrages ? '); readln(n2); until n2>=n1; if n2>laenge then n2:=laenge; for i:=n2 downto n1 do begin clrscr; zeige_eintrag(i); write(' wollen Sie wirklich diesen Eintrag loeschen ? (j/N) '); readln(eg); if (eg[1]='J') or (eg[1]='j') then streiche_eintrag(i); end; end; { of if } if (eg[1]='W') or (eg[1]='w') or (eg='') then begin { Wildcard-loeschen } gef:=false; lese_wildcard(wk); { hier auch CLS } i:=1; suche_eintrag(1); while (i<=laenge) do begin suche_eintrag(i); if w_vergleich(wk) then begin gef:=true; clrscr; { gefundenen Eintrag anzeigen } zeige_eintrag(i); write('Wollen Sie wirklich diesen Eintrag loeschen ? (j/N) '); readln(eg); if (eg[1]='J') or (eg[1]='j') then begin streiche_eintrag(i); i:=i-1; end; end; i:=i+1; end; { of while } wln(3); if not gef then writeln(' Es wurden keine passenden Eintraege gefunden !!! '); wln(2); end; { of if } if liste then begin write(' Streichen fortsetzen ? (j/N) '); readln(eg); end else eg:=''; until (eg='') or (eg[1]='N') or (eg[1]='n'); end; { of S_treichen } procedure aendere_eintrag; { den jeweils aktuellen Eintrag ! } const Komponenten = [ 'A','a', 'B','b', 'V','v', 'F','f', 'N','n' ]; begin eg[1]:=' '; repeat writeln('Was wollen Sie korrigieren : A_utor '); writeln(' B_uch '); writeln(' V_erlag '); writeln(' F_achgebiet '); writeln(' N_ummer '); wln(2); write(' ? '); readln(eg); until (eg[1] in Komponenten) or (eg=''); wln(2); case eg[1] of 'A','a' : begin write('Autor ? '); readln(aktuelle^.au); end; 'B','b' : begin write('Buch ? '); readln(aktuelle^.bu); end; 'V','v' : begin write('Verlag ? '); readln(aktuelle^.vlg); end; 'F','f' : begin write('Fachgebiet ? '); readln(aktuelle^.FG); end; 'N','n' : begin write('Bestands-Nummer ? '); readln(aktuelle^.BSN); end; end; { of case } end; { of aendere_eintrag } procedure K_orrigieren; var n1,n2,i : Integer; gef : boolean; begin repeat clrscr; writeln(' --- Aendern Ihrer BiBo-Datei --- '); writeln(' --- Gesamt-Eintraege : ',laenge ,' --- ' ); wln(2); write('Korrigieren mit Wildcards oder mit Nummern ? (W/n) '); readln(eg); if (eg[1]='N') or (eg[1]='n') then begin { aendern mit Nummern } repeat write('Nummer des 1. zu korrigierenden Eintrags ? '); readln(n1); until (n1>0); if n1>laenge then n1:=laenge; repeat write('Nummer des 2. zu korrigierenden Eintrags ? '); readln(n2); until (n2>=n1); if n2>laenge then n2:=laenge; for i:=n1 to n2 do begin clrscr; zeige_eintrag(i); aendere_eintrag; end; end; { of aendern mit Nummern } if (eg[1]='W') or (eg[1]='w') or (eg='') then { aendern mit Wildcards } begin gef:=false; lese_wildcard(wk); { hier auch CLS } i:=1; repeat suche_eintrag(i); if w_vergleich(wk) then begin gef:=true; clrscr; zeige_eintrag(i); { gefundenen Eintrag zeigen } aendere_eintrag; { und aendern } end; i:=i+1; until (aktuelle^.next=NIL); { alle Karten wurden angesehen } if not gef then begin wln(5); writeln(' Es wurden keine passenden Eintraege gefunden !!! '); end; end; write(' Korrigieren fortsetzen ? (j/N) '); readln(eg); until (eg[1]<>'J') and (eg[1]<>'j'); end; { of Korrigieren } procedure E_infuegen; begin repeat clrscr; writeln(' --- Einfuegen von Eintrag Nr. ',laenge+1, ' in Ihre BiBo-Datei --- '); writeln(' --- Gesamt-Eintraege : ',laenge ,' --- ' ); wln(2); if liste then begin suche_eintrag(laenge); { am Ende der Liste einfuegen } vorige:=aktuelle; new(aktuelle); end else begin vorige:=erste; new(aktuelle); end; with aktuelle^ do begin repeat write('Autor ? '); readln(au); until au <>''; repeat write('Buch ? '); readln(bu); until bu <>''; repeat write('Verlag ? '); readln(vlg); until vlg <>''; repeat write('Fachgebiet ? '); readln(FG); until FG <>''; repeat write('Bestandsnummer ? '); readln(BSN); until BSN <>''; end; vorige^.next:=aktuelle; aktuelle^.next:=NIL; aktuelle^.davor:=vorige; laenge:=laenge+1; akt_nummer:=akt_nummer + 1; liste:=true; wln(4); write('Weiter einfuegen ? (J/n) '); readln(eg); until (eg='N') or (eg='n'); end; { of E_infuegen } procedure Z_eigen; var i,n1,n2 : integer; begin repeat clrscr; writeln(' --- Anzeigen Ihrer BiBo-Datei --- '); writeln(' --- Gesamt-Eintraege : ',laenge:6,' --- ' ); wln(3); repeat write(' 1. anzuzeigender Eintrag ? '); readln(n1); until (n1>0); if n1>laenge then n1:=laenge; repeat write(' 2. anzuzeigender Eintrag ? '); readln(n2); until (n2>=n1); if n2>laenge then n2:=laenge; for i:=n1 to n2 do { Anzeigen der Eintraege in der Liste } begin clrscr; writeln(' --- Anzeigen Ihrer BiBo-Datei --- '); writeln(' --- Gesamt-Eintraege : ',laenge:6,' --- ' ); writeln(' Eintraege ',n1,' bis ', n2 ); wln(4); zeige_eintrag(i); wln(2); write(' --> Enter <-- for more '); readln; end; { Eintraege wurden angezeigt } wln(2); write(' Anzeigen fortsetzen ? (j/N) '); readln(eg); until (eg[1]='N') or (eg[1]='n') or (eg=''); end; { of Z_eigen } (* ------------- This is the Main-Program of BIBO ------------------ *) var wahl : char; begin clrscr; write('Wollen Sie die Dokumentation lesen oder gleich starten ? (j/N) '); readln(eg); if (eg='J') or (eg='j') then dok; new(erste); with erste^ do begin au:=''; bu:=''; vlg:=''; FG:=''; BSN:=''; next:=NIL; davor:=NIL; end; liste:=false; laenge:=0; akt_nummer:=0; dat:=''; repeat wahl:=menu; case wahl of 'E','e' : E_infuegen; 'S','s' : begin if liste then S_treichen else begin writeln('Es ist noch keine Liste vorhanden !!! '); readln; end; end; 'W','w' : begin if liste then W_ildcard_suche else begin writeln('Es ist noch keine Liste vorhanden !!! '); readln; end; end; 'L','l' : L_aden; 'A','a' : begin if liste then A_bspeichern else begin writeln('Es ist noch keine Liste vorhanden !!! '); readln; end; end; 'Z','z' : begin if liste then Z_eigen else begin writeln('Es ist noch keine Liste vorhanden !!! '); readln; end; end; 'K','k' : begin if liste then K_orrigieren else begin writeln('Es ist noch keine Liste vorhanden !!! '); readln; end; end; 'I','i' : Info; end; { of case } until wahl=' '; clrscr; writeln('By.'); end. { of Main-Program }