1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
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 inteingabe<ugOR
inteingabe>ogTHEN 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 inteingabe<ugOR
inteingabe>ogTHEN 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;
|
