PACKET ispobjektlisteDEFINES objektlistestarten,objektlistenausgabe, listenobjektezeigen,datensatzlistenausgabe,datensatzlistezeigen, objektlistenmaskeeinlesen,objektlistebeenden,maxidentizeilenlaenge, setzeidentiwert,#savetupel,17.10.88##restoretupel,17.10.88#pruefungdummy, pruefungbenutzerbestand,satzlesen,einendatensatzlesen,bestandende, setzebestandende,plus,minus,eineseiteeinlesen,blaettern,initobli, inlisteblaettern,setzescanendewert,setzescanstartwert:TAG VAR aktuellemaske; TEXT VAR identiobjekt,sicherungstupel:="";TEXT VAR scanstartwert:="", scanendewert:="�";INT VAR posi,aktletztesfeld,dateinummer,aktindex;INT VAR anzahltupel;LET erstesfeld=2,maxletztesfeld=36,markierung="x",keinemarkierung ="",eingabefeldnr=2,felderprozeile=2,erfwerteinobli=5,schluesseltrenner="$"; LET delimiter="�";LET andenanfang=1,ansende=2,vorwaerts=3,rueckwaerts=4;LET meldungnichtblaettern=72;LET satzzahl=18;TEXT VAR scanwertsicherung, scantupelsicherung;INT VAR scanfeldsicherung,feldnummerstartwert;INT VAR fenster,gelesen;INT VAR anzschluesselfelder:=1;LET zeilenlaenge=70;INT VAR identizeilegesamtlaenge:=70;BOOL VAR ersterbildschirm,bestandsende;BOOL VAR letzterbildschirm;BOOL VAR ersterdatensatz;BOOL VAR nureinedatenseiteROW satzzahlBOOL VAR angekreuzt;ROW satzzahlTEXT VAR identitabelle;PROC setzescanendewert(TEXT CONST endewert):scanendewert:=endewertENDPROC setzescanendewert;PROC setzescanstartwert(TEXT CONST startwert):scanstartwert :=startwertENDPROC setzescanstartwert;PROC objektlistestarten(INT CONST aktdateinummer,TEXT CONST startwert,BOOL CONST anwendung,BOOL VAR listenendeerreicht):objektlistestarten(aktdateinummer,startwert, aktdateinummer+2,anwendung,listenendeerreicht)END PROC objektlistestarten; PROC objektlistestarten(INT CONST aktdateinummer,TEXT CONST startwert,INT CONST fnrstartwert,BOOL CONST anwendung,BOOL VAR listenendeerreicht):LET indextrenner=";";INT VAR erstertrenner:=0;TEXT VAR indextext:="";IF anwendung THEN systemdboffELSE systemdbonFI ;aktindex:=aktdateinummer;dateinummer:= dateinr(primdatid(aktindex));anzschluesselfelder:=anzkey(dateinummer); feldnummerstartwert:=fnrstartwert;IF scanueberdiedateinummerTHEN scanfeldsicherung:=1;ELSE indextext:=zugriff(aktindex);erstertrenner:=pos( indextext,indextrenner);scanfeldsicherung:=int(subtext(indextext,1, erstertrenner-1));FI ;#IF scanueberdiedateinummerTHEN #IF dateinummerzugelassenTHEN putwert(dateinummer+1,startwert)ELSE putwert( dateinummer+2,startwert);IF dateinummer=dnrbenutzTHEN putwert( fnrbenutzbestand,benutzerbestandSUB 1)FI ;FI ;#ELSE IF uebereinenganzensekindexTHEN putwert(scanfeldsicherung,startwert)ELSE putwert (feldnummerstartwert,startwert)FI FI ;#scanwertsicherung:=wert(dateinummer+ scanfeldsicherung);savescanwert;search(aktindex,FALSE );IF ( scanueberdiedateinummerCOR uebereinenganzensekindex)CAND dateinummerzugelassen#dr11.05.88#THEN listenendeerreicht:=dbstatus<>okELSE listenendeerreicht:=dbstatus<>okCOR (dbstatus=okAND wert(dateinummer+ scanfeldsicherung)<>scanwertsicherung)FI ;listenendenochnichterreicht( startwert,listenendeerreicht).dateinummerzugelassen:dateinummer<> dnrschluesselAND dateinummer<>dnrbenutz.END PROC objektlistestarten;PROC listenendenochnichterreicht(TEXT CONST wert,BOOL CONST ende):IF NOT endeTHEN ersterbildschirm:=(wert="");ersterdatensatz:=(wert="");letzterbildschirm:= FALSE ;bestandsende:=FALSE ;FI .END PROC listenendenochnichterreicht;PROC objektlistenausgabe(PROC (INT CONST )erfassungspeziell,BOOL CONST scanja, BOOL PROC pruefungspeziell):initobli;listenmaskeholenundausgeben; identizeilegesamtlaenge:=zeilenlaenge;inlisteblaettern(PROC erfassungspeziell ,vorwaerts,FALSE ,scanja,BOOL PROC pruefungspeziell); objektlistenmaskeeinlesen.END PROC objektlistenausgabe;PROC datensatzlistenausgabe(PROC (INT CONST )erfassungspeziell,BOOL CONST scanja, BOOL PROC pruefungspeziell):initobli;listenmaskeholenundausgeben; identizeilegesamtlaenge:=zeilenlaenge;inlisteblaettern(PROC erfassungspeziell ,vorwaerts,TRUE ,scanja,BOOL PROC pruefungspeziell);objektlistenmaskeeinlesen .ENDPROC datensatzlistenausgabe;PROC initobli:initobli(18)END PROC initobli; PROC initobli(INT CONST szahl):leererthesaurus;bestandsende:=FALSE ;fenster:= szahlEND PROC initobli;PROC listenmaskeholenundausgeben:LET listenmaskenname= "mu objektliste";initmaske(aktuellemaske,listenmaskenname);standardstartproc( listenmaskenname).END PROC listenmaskeholenundausgeben;PROC listenobjektezeigen(PROC (INT CONST )erfassungspeziell,INT CONST start): listenobjektezeigen(PROC (INT CONST )erfassungspeziell,start,FALSE ,BOOL PROC pruefungdummy)END PROC listenobjektezeigen;PROC listenobjektezeigen( PROC (INT CONST )erfassungspeziell,INT CONST start,BOOL CONST scanja,BOOL PROC pruefungspeziell):IF aktindex=dnrschluesselTHEN inlisteblaettern(PROC erfassungspeziell,start,TRUE ,scanja,BOOL PROC pruefungspeziell);ELSE inlisteblaettern(PROC erfassungspeziell,start,FALSE ,scanja,BOOL PROC pruefungspeziell);FI ;return(1).END PROC listenobjektezeigen;PROC datensatzlistezeigen(PROC (INT CONST )erfassungspeziell,INT CONST start): datensatzlistezeigen(PROC (INT CONST )erfassungspeziell,start,FALSE ,BOOL PROC pruefungdummy)END PROC datensatzlistezeigen;PROC datensatzlistezeigen( PROC (INT CONST )erfassungspeziell,INT CONST start,BOOL CONST scanja,BOOL PROC pruefungspeziell):inlisteblaettern(PROC erfassungspeziell,start,TRUE , scanja,BOOL PROC pruefungspeziell);return(1).END PROC datensatzlistezeigen; PROC inlisteblaettern(PROC (INT CONST )erfassungspeziell,INT CONST start, BOOL CONST anwendung,BOOL CONST scanja,BOOL PROC pruefungspeziell):IF anwendungTHEN systemdboffELSE systemdbonFI ;IF blaetternerforderlichTHEN posi :=eingabefeldnr;aktletztesfeld:=maxletztesfeld;blaettern(PROC erfassungspeziell,start,scanja,BOOL PROC pruefungspeziell);IF (gelesen-1)<# satzzahl#fensterAND gelesen>0THEN leerzeilenFI ;ELSE meldungdasnichtgeblaettertwirdFI ;IF NOT anwendungTHEN systemdboffFI ;posi:= eingabefeldnr.blaetternerforderlich:SELECT startOF CASE andenanfang:NOT ersterbildschirmCASE ansende:NOT letzterbildschirmCASE vorwaerts:NOT letzterbildschirmCASE rueckwaerts:NOT ersterbildschirmOTHERWISE FALSE END SELECT .END PROC inlisteblaettern;PROC blaettern(PROC (INT CONST ) erfassungspeziell,INT CONST start,BOOL CONST anwendung,BOOL CONST scanja, BOOL PROC pruefungspeziell):IF anwendungTHEN systemdboffELSE systemdbonFI ; IF blaetternerforderlichTHEN blaettern(PROC erfassungspeziell,start,scanja, BOOL PROC pruefungspeziell);ELSE standardmeldung(meldungnichtblaettern,""); FI ;IF NOT anwendungTHEN systemdboffFI ;.blaetternerforderlich:SELECT start OF CASE andenanfang:NOT ersterbildschirmCASE ansende:NOT letzterbildschirm CASE vorwaerts:NOT letzterbildschirmCASE rueckwaerts:NOT ersterbildschirm OTHERWISE FALSE END SELECT .END PROC blaettern;PROC zeigenschluessel:IF identiobjekt=""THEN LEAVE zeigenschluesselFI ;INT VAR schluesselbeginn:=pos( identiobjekt,schluesseltrenner);identitabelle(posiDIV felderprozeile):= subtext(identiobjekt,schluesselbeginn);identiobjekt:=subtext(identiobjekt,1, schluesselbeginn-1);IF objektmarkiert(identitabelle(posiDIV felderprozeile)) THEN markierungIN posi;angekreuzt(posiDIV felderprozeile):=TRUE ELSE keinemarkierungIN posi;angekreuzt(posiDIV felderprozeile):=FALSE FI ;feldfrei (posi);identiobjektIN (posi+1);posiINCR felderprozeile.END PROC zeigenschluessel;INT PROC maxidentizeilenlaenge:identizeilegesamtlaengeEND PROC maxidentizeilenlaenge;PROC setzeidentiwert(TEXT CONST identizeile): identiobjekt:=identizeileEND PROC setzeidentiwert;PROC leerzeilen: aktletztesfeld:=posi-felderprozeile;WHILE posi<=maxletztesfeldREP leerzeileausgeben;posiINCR felderprozeilePER .leerzeileausgeben:""IN posi;"" IN (posi+1);feldschutz(posi).END PROC leerzeilen;BOOL PROC objektmarkiert( TEXT CONST suchtext):inthesaurus(suchtext).END PROC objektmarkiert;PROC objektlistenmaskeeinlesen:infeld(eingabefeldnr);standardnproc;BOOL VAR markneu,markalt;posi:=erstesfeld;WHILE posi<=aktletztesfeldREP markneu:= standardmaskenfeld(posi)<>"";markalt:=angekreuzt(posiDIV felderprozeile);IF markierungsaenderungTHEN identiobjekt:=identitabelle(posiDIV felderprozeile); IF neuemarkierungTHEN trageinthesaurusein(identiobjekt)ELIF markierungweggenommenTHEN loescheausthesaurus(identiobjekt)FI ;FI ;posiINCR felderprozeile;PER .markierungsaenderung:(markaltAND NOT markneu)OR (NOT markaltAND markneu).neuemarkierung:markneu.markierungweggenommen:markalt.END PROC objektlistenmaskeeinlesen;PROC objektlistebeenden(TEXT CONST dateiname, BOOL CONST uebernahme):IF uebernahmeTHEN uebertragethesaurusindatei(dateiname );#sort(dateiname)sf18.2.87#FI ;END PROC objektlistebeenden;PROC setzebestandende(BOOL CONST b):bestandsende:=bENDPROC setzebestandende;BOOL PROC bestandende:bestandsendeENDPROC bestandende;PROC einendatensatzlesen( PROC (INT CONST ,BOOL PROC )mitscanner,PROC ohnescanner,BOOL CONST scanja, BOOL PROC pruefungspeziell):IF scanjaAND scanerlaubtTHEN mitscanner(aktindex, BOOL PROC pruefungspeziell)ELSE ohnescannerFI ENDPROC einendatensatzlesen; PROC satzlesen(INT CONST was,n,BOOL CONST scanja,BOOL PROC pruefungspeziell): TEXT VAR sicherung:="";anzahltupel:=n;SELECT wasOF CASE andenanfang: ersteseitelesenCASE ansende:letzteseitelesenCASE vorwaerts:naechsteseitelesen CASE rueckwaerts:vorherigeseitelesenENDSELECT ;savetupel(dateinummer, sicherung);bestandsende:=anzahltupel dateinummerOR (scanueberdiedateinummerAND anzschluesselfelder>1)END PROC scanerlaubt;BOOL PROC scanueberdiedateinummer:aktindex=dateinummerEND PROC scanueberdiedateinummer;BOOL PROC uebereinenganzensekindex:was(aktindex)= indexeintragCAND feldnummerstartwert=0END PROC uebereinenganzensekindex;PROC vorherigeseitezeigen(PROC (INT CONST )erfassungspeziell,INT CONST anzahl, BOOL CONST scanja,BOOL PROC pruefung):INT VAR lv,ende:=2;gelesen:=0; stackentry(anzahl-1);savetupel(dateinummer,sicherungstupel);IF letzterbildschirmTHEN ende:=1FI ;FOR lvFROM anzahl-1DOWNTO endeREP stackentry (lv);erfassungspeziell(erfwerteinobli);zeigenschluessel;gelesenINCR 1PER ;IF ende=2THEN stackentry(ende-1)FI .END PROC vorherigeseitezeigen;PROC naechsteseitezeigen(PROC (INT CONST )erfassungspeziell,INT CONST anzahl,BOOL CONST scanja,BOOL PROC pruefung):INT VAR lv;gelesen:=0; sicherungfuerzurueckblaettern;IF bestandsendeTHEN letzterbildschirm:=TRUE ; ausgabeschleifemitscanueberpruefungELSE ausgabeschleifeohnescanueberpruefung FI .sicherungfuerzurueckblaettern:IF NOT ersterbildschirmTHEN savetupel( dateinummer,sicherungstupel);zeigenzeile;FI . ausgabeschleifemitscanueberpruefung:FOR lvFROM 1UPTO anzahlREP stackentry(lv) ;IF (scanjaCAND pruefung)OR NOT scanjaTHEN zeigenzeile;ELSE LEAVE naechsteseitezeigenFI PER .ausgabeschleifeohnescanueberpruefung:FOR lvFROM 1 UPTO (anzahl-1)REP stackentry(lv);zeigenzeilePER ;stackentry(anzahl);. zeigenzeile:erfassungspeziell(erfwerteinobli);zeigenschluessel;gelesenINCR 1. END PROC naechsteseitezeigen;PROC blaettern(PROC (INT CONST ) erfassungspeziell,INT CONST aktion,BOOL CONST scanja,BOOL PROC pruefungspeziell):SELECT aktionOF CASE andenanfang:blaettereandenanfangCASE ansende:blaettereansendeCASE vorwaerts:blaetterevorwaertsCASE rueckwaerts: blaettererueckwaertsEND SELECT .blaettereandenanfang:anfang(PROC erfassungspeziell,scanja,BOOL PROC pruefungspeziell).blaettereansende: ersterbildschirm:=FALSE ;ersterdatensatz:=FALSE ;aufbestandendepositionieren; IF bestandsendeTHEN anfang(PROC erfassungspeziell,scanja,BOOL PROC pruefungspeziell)ELSE vorherigeseitezeigen(PROC erfassungspeziell,anzahltupel ,scanja,BOOL PROC pruefungspeziell)FI .aufbestandendepositionieren:satzlesen( ansende,fenster+1,scanja,BOOL PROC pruefungspeziell);.blaetterevorwaerts:plus (fenster,PROC erfassungspeziell,scanja,BOOL PROC pruefungspeziell). blaettererueckwaerts:restoretupel(dateinummer,sicherungstupel);changeindex; minus(fenster+2,PROC erfassungspeziell,scanja,BOOL PROC pruefungspeziell). END PROC blaettern;PROC meldungdasnichtgeblaettertwird:TEXT VAR zwischensicherung:="";savetupel(dateinummer,zwischensicherung); meldeauffaellig(aktuellemaske,meldungnichtblaettern);gelesen:=0;restoretupel( dateinummer,zwischensicherung);changeindex.END PROC meldungdasnichtgeblaettertwird;PROC anfang(PROC (INT CONST )erfassungspeziell ,BOOL CONST scanja,BOOL PROC pruefungspeziell):IF scanjaTHEN restorescanwert; changeindexFI ;IF NOT ersterbildschirmTHEN ersterbildschirm:=TRUE ; aufanfangpositionieren;naechsteseitezeigen(PROC erfassungspeziell,anzahltupel ,scanja,BOOL PROC pruefungspeziell);FI .aufanfangpositionieren: letzterbildschirm:=FALSE ;satzlesen(andenanfang,fenster+1,scanja,BOOL PROC pruefungspeziell).END PROC anfang;PROC plus(INT CONST saetzevor,PROC (INT CONST )erfassungspeziell,BOOL CONST scanja,BOOL PROC pruefungspeziell): letzterbildschirm:=FALSE ;IF NOT ersterdatensatzTHEN ersterbildschirm:=FALSE ;satzlesen(vorwaerts,saetzevor,scanja,BOOL PROC pruefungspeziell);ELSE satzlesen(vorwaerts,saetzevor+1,scanja,BOOL PROC pruefungspeziell);FI ; naechsteseitezeigen(PROC erfassungspeziell,anzahltupel,scanja,BOOL PROC pruefungspeziell);IF nureinedatenseiteTHEN putwert(dateinummer+ scanfeldsicherung,scanwertsicherung)FI ;END PROC plus;PROC minus(INT CONST saetzezurueck,PROC (INT CONST )erfassungspeziell,BOOL CONST scanja,BOOL PROC pruefungspeziell):#neudr30.01.87#satzlesen(rueckwaerts,saetzezurueck,scanja, BOOL PROC pruefungspeziell);IF bestandsendeTHEN anfang(PROC erfassungspeziell ,scanja,BOOL PROC pruefungspeziell)ELSE ersterbildschirm:=FALSE ; letzterbildschirm:=FALSE ;vorherigeseitezeigen(PROC erfassungspeziell, saetzezurueck,scanja,BOOL PROC pruefungspeziell)FI .END PROC minus;PROC initankreuzliste:INT VAR i;FOR iFROM 1UPTO satzzahlREP angekreuzt(i):=FALSE PER ;END PROC initankreuzliste;#dr17.10.88PROC savetupel(INT CONST dnr,TEXT VAR tupel):INT VAR fnr,primdat;IF was(dnr)=dateieintragTHEN primdat:=dnrELSE primdat:=dateinr(primdatid(dnr))FI ;tupel:="";FOR fnrFROM 1UPTO anzattr( primdat)REP tupelCAT (wert(primdat+fnr)+delimiter)PER ENDPROC savetupel;PROC restoretupel(INT CONST dnr,TEXT VAR tupel):INT VAR fnr,primdat,p;TEXT VAR feldwert,data:=tupel;IF was(dnr)=dateieintragTHEN primdat:=dnrELSE primdat:= dateinr(primdatid(dnr))FI ;FOR fnrFROM primdat+1UPTO primdat+anzattr(primdat) REP p:=pos(data,delimiter);feldwert:=subtext(data,1,(p-1));putwert(fnr, feldwert);change(data,1,p,"")PER ENDPROC restoretupel;#BOOL PROC pruefungdummy:TRUE END PROC pruefungdummy;BOOL PROC pruefungbenutzerbestand:( wert(fnrbenutzbestand))=(benutzerbestandSUB 1)END PROC pruefungbenutzerbestand;TEXT VAR savedscan:="";LET savedscansep="�",dateityp= 1;PROC savescanwert:savedscan:="";transversale(feldnummerstartwert,PROC (INT CONST ,INT VAR )save,FALSE )ENDPROC savescanwert;PROC restorescanwert: transversale(feldnummerstartwert,PROC (INT CONST ,INT VAR )restore,TRUE ) ENDPROC restorescanwert;PROC transversale(INT CONST fnrsetzfeld,PROC (INT CONST ,INT VAR )pproc,BOOL CONST rsetzen):TEXT VAR z:=zugriffaufbauen;INT VAR p:=1,psem:=pos(z,";"),i,fnrsf:=fnrsetzfeld-dateinummer;INT VAR fnr:=int( subtext(z,p,psem-1)),p1:=1;BOOL VAR pausf:=TRUE ;WHILE #fnr<>fnrsfCAND #fnr>0 REP IF fnr=fnrsfTHEN pausf:=FALSE ELSE IF pausfTHEN pproc(fnr+dateinummer,p1) ;ELSE IF rsetzenTHEN putwert(fnr+dateinummer,"")FI FI FI ;p:=psem+1;psem:=pos (z,";",p);fnr:=int(subtext(z,p,psem-1))PER .zugriffaufbauen:IF was(aktindex)= dateitypTHEN TEXT VAR x:="";FOR iFROM 1UPTO anzkey(aktindex)REP xCAT (text(i) +";")PER ;xELSE zugriff(aktindex)FI .ENDPROC transversale;PROC save(INT CONST fnr,INT VAR p):savedscanCAT (wert(fnr)+savedscansep)ENDPROC save;PROC restore(INT CONST fnr,INT VAR p):INT VAR p2:=p;p:=pos(savedscan,savedscansep, p2)+1;putwert(fnr,subtext(savedscan,p2,p-2))ENDPROC restore;END PACKET ispobjektliste;