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/plausipruefung | 88 ++++++++++++++++++++++++++++++ 1 file changed, 88 insertions(+) create mode 100644 app/baisy/2.2.1-schulis/src/plausipruefung (limited to 'app/baisy/2.2.1-schulis/src/plausipruefung') diff --git a/app/baisy/2.2.1-schulis/src/plausipruefung b/app/baisy/2.2.1-schulis/src/plausipruefung new file mode 100644 index 0000000..4b08653 --- /dev/null +++ b/app/baisy/2.2.1-schulis/src/plausipruefung @@ -0,0 +1,88 @@ +PACKET plausipruefungDEFINES pruefe,imschlbestand,imbestand:LET +trennerfuerfeldwerte="�",dateinameschluessel="Schlüssel";PROC pruefe(INT +CONST pruefart,TAG CONST maske,TEXT PROC (INT CONST )prueftext,INT CONST +feldnummer,ug,og,TEXT CONST bestand,INT VAR fstatus):fstatus:=0;SELECT +pruefartOF CASE 1:pruefefeldgefuellt(maske,PROC prueftext,feldnummer,fstatus) +CASE 2:pruefenumerisch(maske,PROC prueftext,feldnummer,fstatus)CASE 3: +pruefenumgrenzen(maske,PROC prueftext,feldnummer,ug,og,fstatus)CASE 4: +pruefeimbestand(maske,PROC prueftext,feldnummer,bestand,fstatus)CASE 5: +pruefealternativen(maske,PROC prueftext,feldnummer,ug,fstatus)CASE 6: +pruefedatum(maske,PROC prueftext,feldnummer,fstatus)END SELECT .END PROC +pruefe;PROC pruefefeldgefuellt(TAG CONST maske,TEXT PROC (INT CONST )eingabe, +INT CONST fnr,INT VAR fstatus):LET fehlermeldungsnr=52;IF eingabe(fnr)="" +THEN meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnrFI ;END PROC +pruefefeldgefuellt;PROC pruefenumerisch(TAG CONST maske,TEXT PROC (INT CONST +)eingabe,INT CONST fnr,INT VAR fstatus):LET fehlermeldungsnr=53;INT VAR type; +TEXT VAR teiltext;scan(eingabe(fnr));nextsymbol(teiltext,type);IF type<>3 +THEN meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnrELSE nextsymbol( +teiltext,type);IF type<>7THEN meldeauffaellig(maske,fehlermeldungsnr);fstatus +:=fnrFI ;FI ;END PROC pruefenumerisch;PROC pruefenumgrenzen(TAG CONST maske, +TEXT PROC (INT CONST )eingabe,INT CONST fnr,ug,og,INT VAR fstatus):LET +fehlermeldungsnr=54;INT VAR inteingabe:=int(eingabe(fnr));IF inteingabeogTHEN meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnrFI ; +END PROC pruefenumgrenzen;PROC pruefeimbestand(TAG CONST maske,TEXT PROC ( +INT CONST )eingabe,INT CONST fnr,TEXT CONST bestand,INT VAR fstatus):LET +fehlermeldungsnr=55;BOOL VAR nichtimbestandgefunden;IF (bestandSUB 1)="c" +THEN nichtimbestandgefunden:=NOT (imbestand(bestand+trennerfuerfeldwerte+ +eingabe(fnr),dateinameschluessel))ELSE nichtimbestandgefunden:=NOT (imbestand +(eingabe(fnr),bestand))FI ;IF nichtimbestandgefundenTHEN meldeauffaellig( +maske,fehlermeldungsnr);fstatus:=fnrFI .END PROC pruefeimbestand;PROC +pruefealternativen(TAG CONST maske,TEXT PROC (INT CONST )eingabe,INT CONST +fnr1,fnr2,INT VAR fstatus):LET fehlermeldungsnr=56;IF fnr2<=fnr1THEN LEAVE +pruefealternativenFI ;INT VAR nr:=fnr1,treffer:=0;REP IF eingabe(nr)<>""THEN +trefferINCR 1FI ;nrINCR 1UNTIL (nr>fnr2)OR (treffer>1)PER ;IF treffer<>1THEN +meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnr1FI .END PROC +pruefealternativen;PROC pruefedatum(TAG CONST maske,TEXT PROC (INT CONST ) +eingabe,INT CONST fnr,INT VAR fstatus):LET fehlermeldungsnr=157,falschertag= +"00";TEXT VAR pruefdatum:=eingabe(fnr);IF datum(pruefdatum)=nildatumCOR +subtext(pruefdatum,1,2)=falschertagTHEN meldeauffaellig(maske, +fehlermeldungsnr);fstatus:=fnrFI ;END PROC pruefedatum;PROC pruefe(INT CONST +pruefart,TAG CONST maske,ROW 100TEXT CONST prueftext,INT CONST feldnummer,ug, +og,TEXT CONST bestand,INT VAR fstatus):fstatus:=0;SELECT pruefartOF CASE 1: +pruefefeldgefuellt(maske,prueftext,feldnummer,fstatus)CASE 2:pruefenumerisch( +maske,prueftext,feldnummer,fstatus)CASE 3:pruefenumgrenzen(maske,prueftext, +feldnummer,ug,og,fstatus)CASE 4:pruefeimbestand(maske,prueftext,feldnummer, +bestand,fstatus)CASE 5:pruefealternativen(maske,prueftext,feldnummer,ug, +fstatus)CASE 6:pruefedatum(maske,prueftext,feldnummer,fstatus)END SELECT . +END PROC pruefe;PROC pruefefeldgefuellt(TAG CONST maske,ROW 100TEXT CONST +eingabe,INT CONST fnr,INT VAR fstatus):LET fehlermeldungsnr=52;IF eingabe(fnr +)=""THEN meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnrFI ;END PROC +pruefefeldgefuellt;PROC pruefenumerisch(TAG CONST maske,ROW 100TEXT CONST +eingabe,INT CONST fnr,INT VAR fstatus):LET fehlermeldungsnr=53;INT VAR type; +TEXT VAR teiltext;scan(eingabe(fnr));nextsymbol(teiltext,type);IF type<>3 +THEN meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnrELSE nextsymbol( +teiltext,type);IF type<>7THEN meldeauffaellig(maske,fehlermeldungsnr);fstatus +:=fnrFI ;FI ;END PROC pruefenumerisch;PROC pruefenumgrenzen(TAG CONST maske, +ROW 100TEXT CONST eingabe,INT CONST fnr,ug,og,INT VAR fstatus):LET +fehlermeldungsnr=54;INT VAR inteingabe:=int(eingabe(fnr));IF inteingabeogTHEN meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnrFI ; +END PROC pruefenumgrenzen;PROC pruefeimbestand(TAG CONST maske,ROW 100TEXT +CONST eingabe,INT CONST fnr,TEXT CONST bestand,INT VAR fstatus):LET +fehlermeldungsnr=55;BOOL VAR nichtimbestandgefunden;IF (bestandSUB 1)="c" +THEN nichtimbestandgefunden:=NOT (imbestand(bestand+trennerfuerfeldwerte+ +eingabe(fnr),dateinameschluessel))ELSE nichtimbestandgefunden:=NOT (imbestand +(eingabe(fnr),bestand))FI ;IF nichtimbestandgefundenTHEN meldeauffaellig( +maske,fehlermeldungsnr);fstatus:=fnrFI .END PROC pruefeimbestand;PROC +pruefealternativen(TAG CONST maske,ROW 100TEXT CONST eingabe,INT CONST fnr1, +fnr2,INT VAR fstatus):LET fehlermeldungsnr=56;IF fnr2<=fnr1THEN LEAVE +pruefealternativenFI ;INT VAR nr:=fnr1,treffer:=0;REP IF eingabe(nr)<>""THEN +trefferINCR 1FI ;nrINCR 1UNTIL (nr>fnr2)OR (treffer>1)PER ;IF treffer<>1THEN +meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnr1FI .END PROC +pruefealternativen;PROC pruefedatum(TAG CONST maske,ROW 100TEXT CONST eingabe +,INT CONST fnr,INT VAR fstatus):LET fehlermeldungsnr=157,falschertag="00"; +TEXT VAR pruefdatum:=eingabe(fnr);IF datum(pruefdatum)=nildatumCOR subtext( +pruefdatum,1,2)=falschertagTHEN meldeauffaellig(maske,fehlermeldungsnr); +fstatus:=fnrFI ;END PROC pruefedatum;BOOL PROC imschlbestand(TEXT CONST +schlwert,bestand):imbestand(bestand+trennerfuerfeldwerte+schlwert, +dateinameschluessel)END PROC imschlbestand;BOOL PROC imbestand(TEXT CONST +schlwerte,bestandname):INT VAR dateinummer,status,position,i;TEXT VAR suchkey +:=schlwerte;systemdboff;stopbeifalschemnamen(FALSE );dateinummer:=dateinr( +bestandname);IF dateinummer>0THEN parsenooffields(0);suchwertesetzen;search( +dateinummer,TRUE );status:=dbstatus;reinitparsingELSE status:=1FI ; +stopbeifalschemnamen(TRUE );status=0.suchwertesetzen:FOR iFROM 1UPTO anzkey( +dateinummer)REP ermittleposition;putwert(dateinummer+i,suchwert);suchkey:= +subtext(suchkey,position+2)UNTIL suchkey=""PER .ermittleposition:position:= +pos(suchkey,trennerfuerfeldwerte);IF position=0THEN position:=length(suchkey) +ELSE positionDECR 1FI .suchwert:subtext(suchkey,1,position).END PROC +imbestand;END PACKET plausipruefung; + -- cgit v1.2.3