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
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
|
PACKET ispidagrundfunktionenDEFINES selektionenindateieintragen,
zugriffsregelnindateieintragen,druckausgabenlistezeigen,regellistezeigen,
variablenlistezeigen,behandlungderausgesuchten,inlisteblaettern,
maskenwertesichern,nummerderdruckausgabesetzen,nureinedruckausgabeangekreuzt,
rueckschrittevorproc,rueckschrittenachproc,sichernundhilfsfilesloeschen,
hilfsfilesloeschen,erfassungdruckausgabe,init,put,
setzedruckausgabelistenauswahl,druckausgabelistenauswahl,
setzelistederdruckausgabengezeigt,listederdruckausgabengezeigt,
setzeaktuellemaske,aktuellemaske:LET filenamezug="Hilfsdatei.Zugriff",
filenamesel="Hilfsdatei.Selektion",filenamedruck="Hilfsdatei.Druck",
filenamedliste="Druckausgaben",filenamezliste="Zugriffe",filenamevliste=
"Variablen";LET meldunglistenerstellung=7,meldungletzterwert=67,
meldungkeineliste=68,meldungkeinblaettern=72,meldungkeinezugriffe=200,
meldungkeinevariablen=201;LET maxselektionen=17,maxzugriffe=16,zeileninliste=
18,ausgabelaenge=71,maxvariablen=100;LET zugriffsregeln=4,druckvariablen=7;
LET serstervergleich=3,zobjkl=2,zregnr=3,zerstervergleich=7,lt=3,dnummer=2,
vnummer=2;LET vergleichtrenner="</>",trenner=" = ",oblitrenner="$",blank=" ",
kleinr="r",kleink="k",niltext="";LET andenanfang=1,andasende=2,vorwaerts=3,
rueckwaerts=4;BOOL VAR listenauswahl,listegezeigt;BOOL VAR dvrrechts,
dvrdruckvar,listeeinmalgezeigt:=FALSE ;INT VAR lvi,lvf,posi,zeilennr,
dvrlaenge,zobjekt,zregel,zindex,zanzahl,startzeile,zeilenindatei,schritte;
FILE VAR f,g;TAG VAR aktmaske;TEXT VAR zeile,dvrname,wert1,wert2,datname;
PROC selektionenindateieintragen(INT CONST leseanfangindatei,ROW 100TEXT
CONST erfassungsfeld):f:=sequentialfile(modify,filenamesel);zeilennr:=
leseanfangindatei;lvi:=serstervergleich;FOR lvfFROM leseanfangindateiUPTO
leseanfangindatei+maxselektionen-1REP IF zeilennr<=lines(f)THEN
vergleichswerteanhaengenFI PER ;.vergleichswerteanhaengen:toline(f,lvf);
readrecord(f,zeile);posi:=pos(zeile,vergleichtrenner);IF posi>0THEN zeile:=
subtext(zeile,1,posi-1)FI ;zeileCAT vergleichtrenner;zeileCAT erfassungsfeld[
lvi];writerecord(f,zeile);lviINCR 2;zeilennrINCR 1;.END PROC
selektionenindateieintragen;PROC zugriffsregelnindateieintragen(INT CONST
leseanfangindatei,ROW 100TEXT CONST erfassungsfeld):f:=sequentialfile(modify,
filenamezug);zeilennr:=leseanfangindatei;lvi:=zerstervergleich;FOR lvfFROM
leseanfangindateiUPTO leseanfangindatei+maxzugriffe-1REP IF zeilennr<=lines(f
)THEN vergleichswerteanhaengenFI PER ;.vergleichswerteanhaengen:toline(f,lvf)
;readrecord(f,zeile);posi:=pos(zeile,vergleichtrenner);IF posi>0THEN zeile:=
subtext(zeile,1,posi-1);FI ;IF erfassungsfeld[lvi]<>niltextTHEN zeileCAT
vergleichtrenner;zeileCAT erfassungsfeld[lvi];FI ;writerecord(f,zeile);lvi
INCR 3;zeilennrINCR 1;.END PROC zugriffsregelnindateieintragen;PROC
druckausgabenlistezeigen:forget(filenamedliste,quiet);datname:=filenamedliste
;f:=sequentialfile(output,datname);first(dnrida);WHILE dbstatus=okREP
zeilezusammensetzen;putline(f,text(zeile,ausgabelaenge));succ(dnrida)PER ;
startzeiledruckausgabenlistebestimmen(datname);IF startzeile=0THEN
meldeauffaellig(aktuellemaske,meldungkeineliste);return(1)ELSE
setzelistederdruckausgabengezeigt(TRUE );listeeinmalgezeigt:=TRUE ;
listezeigen(datname)FI .zeilezusammensetzen:zeile:=wert(fnridanummer)+trenner
+wert(fnridaname);.END PROC druckausgabenlistezeigen;PROC
startzeiledruckausgabenlistebestimmen(TEXT VAR fname):INT VAR lv;f:=
sequentialfile(modify,fname);FOR lvFROM 1UPTO lines(f)REP toline(f,lv);
readrecord(f,zeile);IF int(subtext(zeile,1,pos(zeile,trenner)-1))>=int(
standardmaskenfeld(dnummer))THEN startzeile:=lv;LEAVE
startzeiledruckausgabenlistebestimmenFI PER ;startzeile:=0END PROC
startzeiledruckausgabenlistebestimmen;PROC regellistezeigen:forget(
filenamezliste,quiet);datname:=filenamezliste;f:=sequentialfile(output,
datname);IF getanzahlregeln=0THEN meldeauffaellig(aktuellemaske,
meldungkeinezugriffe);return(1)ELSE meldeauffaellig(aktuellemaske,
meldunglistenerstellung);listeeinmalgezeigt:=FALSE ;
listederregelnzusammenstellen;startzeileregellistebestimmen(datname);IF
startzeile=0THEN meldeauffaellig(aktuellemaske,meldungkeineliste);return(1)
ELSE setzedruckausgabelistenauswahl(TRUE );listezeigen(datname)FI FI ;END
PROC regellistezeigen;PROC listederregelnzusammenstellen:FOR lvfFROM 1UPTO
getanzahlregelnREP getzugriffsregel(lvf,zobjekt,zregel,zindex,zanzahl);zeile
:=kleink+text(zobjekt)+kleinr+text(zregel);putline(f,text(zeile,ausgabelaenge
))PER END PROC listederregelnzusammenstellen;PROC
startzeileregellistebestimmen(TEXT VAR fname):INT VAR lv,lvi,anzahl;f:=
sequentialfile(modify,fname);regelnsortieren;anzahl:=lines(f);FOR lvFROM 1
UPTO anzahlREP toline(f,lv);readrecord(f,zeile);IF objektindatei=
objektinmaskeTHEN lvi:=lv;WHILE regelindatei<regelinmaskeREP
pruefenobdateiendesonstnaechstenlesenUNTIL objektindatei>objektinmaskePER ;
startzeile:=lvi;LEAVE startzeileregellistebestimmenFI ;IF objektindatei>
objektinmaskeTHEN startzeile:=lv;LEAVE startzeileregellistebestimmenFI PER ;
startzeile:=0.objektindatei:int(subtext(zeile,2,pos(zeile,kleinr)-1)).
objektinmaske:int(standardmaskenfeld(zobjkl)).regelindatei:int(subtext(zeile,
pos(zeile,kleinr)+1)).regelinmaske:int(standardmaskenfeld(zregnr)).
pruefenobdateiendesonstnaechstenlesen:IF lvi=anzahlTHEN startzeile:=0;LEAVE
startzeileregellistebestimmenELSE lviINCR 1;toline(f,lvi);readrecord(f,zeile)
;FI .END PROC startzeileregellistebestimmen;PROC variablenlistezeigen:forget(
filenamevliste,quiet);datname:=filenamevliste;f:=sequentialfile(output,
datname);FOR lvfFROM 1UPTO maxvariablenREP getsteuercode(lvf,dvrname,
dvrlaenge,dvrrechts,dvrdruckvar);IF dvrname<>niltextTHEN
listedervariablenzusammenstellen;FI PER ;IF lines(f)=0THEN meldeauffaellig(
aktuellemaske,meldungkeinevariablen);return(1)ELSE meldeauffaellig(
aktuellemaske,meldunglistenerstellung);listeeinmalgezeigt:=FALSE ;
startzeilevariablenlistebestimmen(datname);IF startzeile=0THEN
meldeauffaellig(aktuellemaske,meldungkeineliste);return(1)ELSE
setzedruckausgabelistenauswahl(TRUE );listezeigen(datname)FI FI END PROC
variablenlistezeigen;PROC listedervariablenzusammenstellen:zeile:=text(lvf);
zeileCAT trenner;zeileCAT dvrname;putline(f,text(zeile,ausgabelaenge))END
PROC listedervariablenzusammenstellen;PROC startzeilevariablenlistebestimmen(
TEXT VAR fname):INT VAR lv;f:=sequentialfile(modify,fname);FOR lvFROM 1UPTO
lines(f)REP toline(f,lv);readrecord(f,zeile);IF int(subtext(zeile,1,pos(zeile
,trenner)-1))>=int(standardmaskenfeld(vnummer))THEN startzeile:=lv;LEAVE
startzeilevariablenlistebestimmenFI PER ;startzeile:=0END PROC
startzeilevariablenlistebestimmen;PROC listezeigen(TEXT CONST dateiname):LET
listenmaskenname="mu objektliste";initobli;initmaske(aktmaske,
listenmaskenname);standardstartproc(listenmaskenname);f:=sequentialfile(
modify,dateiname);zeilenindatei:=lines(f);seitezeigenEND PROC listezeigen;
PROC inlisteblaettern(INT CONST wohin):SELECT wohinOF CASE andenanfang:
andendateianfangCASE andasende:andasdateiendeCASE vorwaerts:
vorwaertsblaetternindateiCASE rueckwaerts:rueckwaertsblaetternindateiEND
SELECT ;.andendateianfang:IF startzeile<>1THEN startzeile:=1;seitezeigenELSE
zurueck;FI .andasdateiende:IF startzeile<zeilenindatei-zeileninliste+1THEN
startzeile:=zeilenindatei-zeileninliste+1;seitezeigenELSE zurueck;FI .
vorwaertsblaetternindatei:IF startzeile<zeilenindatei-zeileninliste+1THEN
startzeileINCR zeileninliste;seitezeigenELSE zurueck;FI .
rueckwaertsblaetternindatei:IF startzeile>zeileninlisteTHEN startzeileDECR
zeileninliste;seitezeigenELSE andendateianfangFI .END PROC inlisteblaettern;
PROC seitezeigen:FOR lvfFROM 1UPTO zeileninlisteREP IF startzeile+lvf-1<=
zeilenindateiTHEN toline(f,startzeile+lvf-1);readrecord(f,zeile);posi:=pos(
zeile,vergleichtrenner);IF posi>0THEN standardmaskenfeld(subtext(zeile,1,posi
-1),lvf*2+1);standardmaskenfeld(subtext(zeile,posi+lt),lvf*2);ELSE
standardmaskenfeld(zeile,lvf*2+1);standardmaskenfeld(niltext,lvf*2);FI ;
feldfrei(lvf*2)ELSE standardmaskenfeld(text(niltext,ausgabelaenge),lvf*2+1);
standardmaskenfeld(niltext,lvf*2);feldschutz(lvf*2)FI PER ;END PROC
seitezeigen;PROC maskenwertesichern:FOR lvfFROM 1UPTO zeileninlisteREP IF
standardmaskenfeld(lvf*2+1)<>ausgabelaenge*blankTHEN zeile:=
standardmaskenfeld(lvf*2+1);zeileCAT vergleichtrenner;zeileCAT
standardmaskenfeld(lvf*2);toline(f,startzeile+lvf-1);writerecord(f,zeile)FI
PER END PROC maskenwertesichern;PROC behandlungderausgesuchten(PROC (INT
CONST )wastun,ROW 100TEXT VAR feld,INT CONST womit):BOOL VAR ok:=FALSE ;init(
feld);wertholen(womit,ok);IF okTHEN feldervorbelegen;wastun(womit);ELSE
meldeauffaellig(aktuellemaske,meldungletzterwert);zurueck;
setzedruckausgabelistenauswahl(FALSE );forget(datname,quiet);
listeeinmalgezeigt:=FALSE ;enter(2)#rueckschrittevorproc(2)dr01.08.88#FI .
feldervorbelegen:SELECT womitOF CASE zugriffsregeln:feld[zobjkl]:=wert1;feld[
zregnr]:=wert2;CASE druckvariablen:feld[vnummer]:=wert1END SELECT .END PROC
behandlungderausgesuchten;PROC wertholen(INT CONST wozu,BOOL VAR nochda):g:=
sequentialfile(modify,datname);#dr01.08.88#nochda:=lines(g)>0;IF NOT nochda
THEN LEAVE wertholenELSE toline(g,1);WHILE lines(g)>0REP readrecord(g,zeile);
posi:=pos(zeile,vergleichtrenner);deleterecord(g);UNTIL posi>0CAND subtext(
zeile,posi+lt)<>niltextPER ;IF lines(g)>0THEN werteermittelnELIF posi>0CAND
subtext(zeile,posi+lt)<>niltextTHEN werteermittelnELSE nochda:=FALSE FI FI .
werteermitteln:SELECT wozuOF CASE zugriffsregeln:objektundregelermittelnCASE
druckvariablen:variablennummerermittelnEND SELECT .objektundregelermitteln:
wert1:=subtext(zeile,pos(zeile,kleink)+1,pos(zeile,kleinr)-1);wert2:=subtext(
zeile,pos(zeile,kleinr)+1,pos(zeile,blank)-1).variablennummerermitteln:wert1
:=subtext(zeile,1,pos(zeile,trenner)-1);wert2:=niltext.END PROC wertholen;
PROC rueckschrittevorproc(INT CONST wieviele):BOOL VAR b:=TRUE ;schritte:=
wieviele;WHILE bREP IF listeeinmalgezeigtTHEN schritteINCR 1;b:=FALSE ELSE #
dr01.08.88#b:=listederdruckausgabengezeigt;listeeinmalgezeigt:=TRUE FI PER ;
listeeinmalgezeigt:=listederdruckausgabengezeigt;enter(schritte)END PROC
rueckschrittevorproc;PROC rueckschrittenachproc(INT CONST wieviele):return(
wieviele);END PROC rueckschrittenachproc;PROC nummerderdruckausgabesetzen(
TEXT VAR nr):FOR lvfFROM 1UPTO lines(f)REP toline(f,lvf);readrecord(f,zeile);
posi:=pos(zeile,vergleichtrenner);IF posi>0CAND subtext(zeile,posi+lt)<>
niltextTHEN nr:=subtext(zeile,1,pos(zeile," = ")-1);LEAVE
nummerderdruckausgabesetzenFI ;PER END PROC nummerderdruckausgabesetzen;BOOL
PROC nureinedruckausgabeangekreuzt:BOOL VAR angekreuzt:=FALSE ;f:=
sequentialfile(modify,filenamedliste);FOR lvfFROM 1UPTO lines(f)REP toline(f,
lvf);readrecord(f,zeile);posi:=pos(zeile,vergleichtrenner);IF posi>0CAND
subtext(zeile,posi+lt)<>niltextTHEN IF angekreuztTHEN LEAVE
nureinedruckausgabeangekreuztWITH FALSE ELSE angekreuzt:=TRUE FI FI PER ;
angekreuztEND PROC nureinedruckausgabeangekreuzt;PROC
sichernundhilfsfilesloeschen:putform;hilfsfilesloeschenEND PROC
sichernundhilfsfilesloeschen;PROC hilfsfilesloeschen:forget(filenamezug,quiet
);forget(filenamesel,quiet);forget(filenamedruck,quiet);forget(filenamedliste
,quiet)END PROC hilfsfilesloeschen;PROC erfassungdruckausgabe(INT CONST n):
LET trenner=" = ";LET laengezeile=71;TEXT VAR identizeile;identizeile:=wert(
fnridanummer)+trenner+wert(fnridaname);identizeile:=text(identizeile,
laengezeile);setzeidentiwert(identizeilemitschluesselanhang).
identizeilemitschluesselanhang:identizeile+oblitrenner+wert(fnridanummer).
END PROC erfassungdruckausgabe;PROC init(ROW 100TEXT VAR feld):INT VAR i;FOR
iFROM 1UPTO 100REP feld(i):=""PER END PROC init;PROC put(TAG CONST maske,ROW
100TEXT CONST feld,INT CONST letztesfeld):INT VAR lv;FOR lvFROM 2UPTO
letztesfeldREP IF fieldexists(maske,lv)THEN put(maske,feld[lv],lv)FI PER END
PROC put;PROC setzeaktuellemaske(TAG CONST welchemaske):aktmaske:=welchemaske
END PROC setzeaktuellemaske;TAG PROC aktuellemaske:aktmaskeEND PROC
aktuellemaske;PROC setzedruckausgabelistenauswahl(BOOL CONST b):listenauswahl
:=bEND PROC setzedruckausgabelistenauswahl;BOOL PROC
listederdruckausgabengezeigt:listegezeigtEND PROC
listederdruckausgabengezeigt;PROC setzelistederdruckausgabengezeigt(BOOL
CONST b):listegezeigt:=bEND PROC setzelistederdruckausgabengezeigt;BOOL PROC
druckausgabelistenauswahl:listenauswahlEND PROC druckausgabelistenauswahl;
PROC regelnsortieren:INT VAR lv,anzahl;anzahl:=lines(f);blanksentfernen;sort(
filenamezliste);moeglicherweisenachsortieren.blanksentfernen:FOR lvFROM 1
UPTO anzahlREP toline(f,lv);readrecord(f,zeile);changeall(zeile," ","");
writerecord(f,text(zeile,ausgabelaenge))PER .moeglicherweisenachsortieren:
FOR lvFROM 1UPTO anzahlREP toline(f,1);readrecord(f,zeile);IF subtext(zeile,2
,2)="1"THEN deleterecord(f);toline(f,anzahl);insertrecord(f);writerecord(f,
text(zeile,ausgabelaenge))ELSE LEAVE regelnsortierenFI PER .END PROC
regelnsortieren;END PACKET ispidagrundfunktionen;
|
