From 04e68443040c7abad84d66477e98f93bed701760 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 4 Feb 2019 13:09:03 +0100 Subject: Initial import --- app/baisy/2.2.1-schulis/src/isp.objektliste | 252 ++++++++++++++++++++++++++++ 1 file changed, 252 insertions(+) create mode 100644 app/baisy/2.2.1-schulis/src/isp.objektliste (limited to 'app/baisy/2.2.1-schulis/src/isp.objektliste') diff --git a/app/baisy/2.2.1-schulis/src/isp.objektliste b/app/baisy/2.2.1-schulis/src/isp.objektliste new file mode 100644 index 0000000..46262e1 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/isp.objektliste @@ -0,0 +1,252 @@ +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; + -- cgit v1.2.3