summaryrefslogtreecommitdiff
path: root/app/baisy/2.2.1-schulis
diff options
context:
space:
mode:
authorLars-Dominik Braun <lars@6xq.net>2019-02-04 13:09:03 +0100
committerLars-Dominik Braun <lars@6xq.net>2019-02-04 13:09:03 +0100
commit04e68443040c7abad84d66477e98f93bed701760 (patch)
tree2b6202afae659e773bf6916157d23e83edfa44e3 /app/baisy/2.2.1-schulis
downloadeumel-src-04e68443040c7abad84d66477e98f93bed701760.tar.gz
eumel-src-04e68443040c7abad84d66477e98f93bed701760.tar.bz2
eumel-src-04e68443040c7abad84d66477e98f93bed701760.zip
Initial import
Diffstat (limited to 'app/baisy/2.2.1-schulis')
-rw-r--r--app/baisy/2.2.1-schulis/source-disk1
-rw-r--r--app/baisy/2.2.1-schulis/src/ANWENDUNG.files3
-rw-r--r--app/baisy/2.2.1-schulis/src/BAISY SERVER.files6
-rw-r--r--app/baisy/2.2.1-schulis/src/BASIS.files7
-rw-r--r--app/baisy/2.2.1-schulis/src/DB REORG.files5
-rw-r--r--app/baisy/2.2.1-schulis/src/DB.files16
-rw-r--r--app/baisy/2.2.1-schulis/src/DOS.files22
-rw-r--r--app/baisy/2.2.1-schulis/src/SICHERUNG.files8
-rw-r--r--app/baisy/2.2.1-schulis/src/STANDARD.files16
-rw-r--r--app/baisy/2.2.1-schulis/src/WERKZEUGE.files8
-rw-r--r--app/baisy/2.2.1-schulis/src/allgemeine grundfunktionen35
-rw-r--r--app/baisy/2.2.1-schulis/src/aufruf manager39
-rw-r--r--app/baisy/2.2.1-schulis/src/auskunftsfenster126
-rw-r--r--app/baisy/2.2.1-schulis/src/baisyio51
-rw-r--r--app/baisy/2.2.1-schulis/src/block i-o52
-rw-r--r--app/baisy/2.2.1-schulis/src/bpb dsbin0 -> 2048 bytes
-rw-r--r--app/baisy/2.2.1-schulis/src/db archive.sc7
-rw-r--r--app/baisy/2.2.1-schulis/src/db dd.sc60
-rw-r--r--app/baisy/2.2.1-schulis/src/db ddinfo.sc24
-rw-r--r--app/baisy/2.2.1-schulis/src/db fetch.baisy28
-rw-r--r--app/baisy/2.2.1-schulis/src/db kernel.sc60
-rw-r--r--app/baisy/2.2.1-schulis/src/db parse.sc38
-rw-r--r--app/baisy/2.2.1-schulis/src/db phon.sc17
-rw-r--r--app/baisy/2.2.1-schulis/src/db reorg.sc48
-rw-r--r--app/baisy/2.2.1-schulis/src/db reorganisation auftrag12
-rw-r--r--app/baisy/2.2.1-schulis/src/db reorganisation manager15
-rw-r--r--app/baisy/2.2.1-schulis/src/db scan245
-rw-r--r--app/baisy/2.2.1-schulis/src/db utils.sc60
-rw-r--r--app/baisy/2.2.1-schulis/src/dir.dos187
-rw-r--r--app/baisy/2.2.1-schulis/src/disk descriptor.dos73
-rw-r--r--app/baisy/2.2.1-schulis/src/dos hd inserter12
-rw-r--r--app/baisy/2.2.1-schulis/src/dos inserter15
-rw-r--r--app/baisy/2.2.1-schulis/src/dump12
-rw-r--r--app/baisy/2.2.1-schulis/src/editorfunktionen56
-rw-r--r--app/baisy/2.2.1-schulis/src/erf.auskuenfte66
-rw-r--r--app/baisy/2.2.1-schulis/src/eu disk descriptor26
-rw-r--r--app/baisy/2.2.1-schulis/src/f packet.sc9
-rw-r--r--app/baisy/2.2.1-schulis/src/fat.dos82
-rw-r--r--app/baisy/2.2.1-schulis/src/fetch108
-rw-r--r--app/baisy/2.2.1-schulis/src/fetch save interface16
-rw-r--r--app/baisy/2.2.1-schulis/src/get put interface.dos103
-rw-r--r--app/baisy/2.2.1-schulis/src/insert.dos15
-rw-r--r--app/baisy/2.2.1-schulis/src/isp archive.sc35
-rw-r--r--app/baisy/2.2.1-schulis/src/isp.auskunftseditor27
-rw-r--r--app/baisy/2.2.1-schulis/src/isp.auskunftsfunktionen69
-rw-r--r--app/baisy/2.2.1-schulis/src/isp.baisy server80
-rw-r--r--app/baisy/2.2.1-schulis/src/isp.benutzerberechtigungen87
-rw-r--r--app/baisy/2.2.1-schulis/src/isp.erf.abkuerzungen67
-rw-r--r--app/baisy/2.2.1-schulis/src/isp.erf.benutzerberechtigungen54
-rw-r--r--app/baisy/2.2.1-schulis/src/isp.erf.meldungen40
-rw-r--r--app/baisy/2.2.1-schulis/src/isp.erf.steueroperationen258
-rw-r--r--app/baisy/2.2.1-schulis/src/isp.init baisy server4
-rw-r--r--app/baisy/2.2.1-schulis/src/isp.knoten137
-rw-r--r--app/baisy/2.2.1-schulis/src/isp.manager schnittstelle82
-rw-r--r--app/baisy/2.2.1-schulis/src/isp.masken495
-rw-r--r--app/baisy/2.2.1-schulis/src/isp.maskendesign302
-rw-r--r--app/baisy/2.2.1-schulis/src/isp.meldungsfunktionen64
-rw-r--r--app/baisy/2.2.1-schulis/src/isp.monitor sicherungstask126
-rw-r--r--app/baisy/2.2.1-schulis/src/isp.objektliste252
-rw-r--r--app/baisy/2.2.1-schulis/src/isp.schulis db nummern225
-rw-r--r--app/baisy/2.2.1-schulis/src/isp.sicherungsmonitor141
-rw-r--r--app/baisy/2.2.1-schulis/src/isp.standardmaskenbehandlung35
-rw-r--r--app/baisy/2.2.1-schulis/src/isp.systembaumbearbeitung236
-rw-r--r--app/baisy/2.2.1-schulis/src/isp.systembaumeditor72
-rw-r--r--app/baisy/2.2.1-schulis/src/isp.zusatz archive packet13
-rw-r--r--app/baisy/2.2.1-schulis/src/konvert18
-rw-r--r--app/baisy/2.2.1-schulis/src/log.eintrag14
-rw-r--r--app/baisy/2.2.1-schulis/src/log.manager126
-rw-r--r--app/baisy/2.2.1-schulis/src/logbuch verwaltung81
-rw-r--r--app/baisy/2.2.1-schulis/src/longrow38
-rw-r--r--app/baisy/2.2.1-schulis/src/manager-M.dos55
-rw-r--r--app/baisy/2.2.1-schulis/src/manager-S.dos67
-rw-r--r--app/baisy/2.2.1-schulis/src/maskenerweiterung11
-rw-r--r--app/baisy/2.2.1-schulis/src/maskenverarbeitung125
-rw-r--r--app/baisy/2.2.1-schulis/src/name conversion.dos22
-rw-r--r--app/baisy/2.2.1-schulis/src/new monitor baisy4
-rw-r--r--app/baisy/2.2.1-schulis/src/open11
-rw-r--r--app/baisy/2.2.1-schulis/src/plausipruefung88
-rw-r--r--app/baisy/2.2.1-schulis/src/save61
-rw-r--r--app/baisy/2.2.1-schulis/src/schulis kommandobehandlung19
-rw-r--r--app/baisy/2.2.1-schulis/src/shard interface20
-rw-r--r--app/baisy/2.2.1-schulis/src/standarddialog34
-rw-r--r--app/baisy/2.2.1-schulis/src/sybifunktionen71
-rw-r--r--app/baisy/2.2.1-schulis/src/systembaum299
-rw-r--r--app/baisy/2.2.1-schulis/src/systembauminterpreter390
-rw-r--r--app/baisy/2.2.1-schulis/src/thesaurusfunktionen16
-rw-r--r--app/baisy/2.2.1-schulis/src/umgebungswechsel manager19
87 files changed, 6279 insertions, 0 deletions
diff --git a/app/baisy/2.2.1-schulis/source-disk b/app/baisy/2.2.1-schulis/source-disk
new file mode 100644
index 0000000..17b0588
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/source-disk
@@ -0,0 +1 @@
+schulis-grundpaket-schulverwaltung-2.2.1/02_baisy-quellen.img
diff --git a/app/baisy/2.2.1-schulis/src/ANWENDUNG.files b/app/baisy/2.2.1-schulis/src/ANWENDUNG.files
new file mode 100644
index 0000000..40d187b
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/ANWENDUNG.files
@@ -0,0 +1,3 @@
+db reorganisation auftrag
+logbuch verwaltung
+
diff --git a/app/baisy/2.2.1-schulis/src/BAISY SERVER.files b/app/baisy/2.2.1-schulis/src/BAISY SERVER.files
new file mode 100644
index 0000000..d1cc99f
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/BAISY SERVER.files
@@ -0,0 +1,6 @@
+longrow
+systembaum
+isp.systembaumbearbeitung
+maskenverarbeitung
+isp.baisy server
+
diff --git a/app/baisy/2.2.1-schulis/src/BASIS.files b/app/baisy/2.2.1-schulis/src/BASIS.files
new file mode 100644
index 0000000..f04fa3c
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/BASIS.files
@@ -0,0 +1,7 @@
+db dd.sc
+db phon.sc
+db parse.sc
+f packet.sc
+isp.masken
+
+
diff --git a/app/baisy/2.2.1-schulis/src/DB REORG.files b/app/baisy/2.2.1-schulis/src/DB REORG.files
new file mode 100644
index 0000000..04f7bd7
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/DB REORG.files
@@ -0,0 +1,5 @@
+db utils.sc
+db reorg.sc
+db reorganisation manager
+
+
diff --git a/app/baisy/2.2.1-schulis/src/DB.files b/app/baisy/2.2.1-schulis/src/DB.files
new file mode 100644
index 0000000..5ea703b
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/DB.files
@@ -0,0 +1,16 @@
+db fetch.baisy
+db kernel.sc
+isp.init baisy server
+isp.manager schnittstelle
+isp.schulis db nummern
+log.eintrag
+maskenerweiterung
+baisyio
+isp.meldungsfunktionen
+isp.knoten
+sybifunktionen
+editorfunktionen
+auskunftsfenster
+isp.auskunftsfunktionen
+
+
diff --git a/app/baisy/2.2.1-schulis/src/DOS.files b/app/baisy/2.2.1-schulis/src/DOS.files
new file mode 100644
index 0000000..ff4d45c
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/DOS.files
@@ -0,0 +1,22 @@
+dump
+konvert
+open
+eu disk descriptor
+disk descriptor.dos
+block i/o
+name conversion.dos
+fat.dos
+dir.dos
+get put interface.dos
+fetch save interface
+fetch
+save
+manager/M.dos
+manager/S.dos
+bpb ds
+shard interface
+insert.dos
+dos hd inserter
+dos inserter
+
+
diff --git a/app/baisy/2.2.1-schulis/src/SICHERUNG.files b/app/baisy/2.2.1-schulis/src/SICHERUNG.files
new file mode 100644
index 0000000..d082e14
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/SICHERUNG.files
@@ -0,0 +1,8 @@
+db ddinfo.sc
+isp.zusatz archive packet
+db utils.sc
+isp archive.sc
+db archive.sc
+isp.monitor sicherungstask
+
+
diff --git a/app/baisy/2.2.1-schulis/src/STANDARD.files b/app/baisy/2.2.1-schulis/src/STANDARD.files
new file mode 100644
index 0000000..0a0c982
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/STANDARD.files
@@ -0,0 +1,16 @@
+plausipruefung
+thesaurusfunktionen
+isp.standardmaskenbehandlung
+isp.benutzerberechtigungen
+umgebungswechsel manager
+systembauminterpreter
+aufruf manager
+standarddialog
+isp.sicherungsmonitor
+db scan
+allgemeine grundfunktionen
+isp.objektliste
+isp.erf.steueroperationen
+isp.erf.abkuerzungen
+isp.erf.benutzerberechtigungen
+
diff --git a/app/baisy/2.2.1-schulis/src/WERKZEUGE.files b/app/baisy/2.2.1-schulis/src/WERKZEUGE.files
new file mode 100644
index 0000000..cf1f4f2
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/WERKZEUGE.files
@@ -0,0 +1,8 @@
+isp.systembaumeditor
+schulis kommandobehandlung
+isp.maskendesign
+isp.erf.meldungen
+erf.auskuenfte
+isp.auskunftseditor
+new monitor baisy
+
diff --git a/app/baisy/2.2.1-schulis/src/allgemeine grundfunktionen b/app/baisy/2.2.1-schulis/src/allgemeine grundfunktionen
new file mode 100644
index 0000000..7d3b4c5
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/allgemeine grundfunktionen
@@ -0,0 +1,35 @@
+PACKET allgemeinegrundfunktionenDEFINES statleseschleife,rechtstext,
+aenderungsvermerksetzen,geplanteshjundsjberechnen,textnichtnull,jgstaufber,
+eingabenummerisch:LET sgaenderung="c02 aenderungsvermerk",schlakt="aktuell",
+schlgepl="geplant",blank=" ";PROC statleseschleife(INT CONST indexnummer,
+TEXT CONST startschluessel1,startschluessel2,INT CONST feldnr1,feldnr2,PROC (
+BOOL VAR )stataktion):vorbereitungen;leseschleife.vorbereitungen:LET
+maxleseanzahl=10;BOOL VAR vorzeitigesende:=FALSE ;INT VAR anzahltupel;.
+leseschleife:putwert(feldnr1,startschluessel1);putwert(feldnr2,
+startschluessel2);search(indexnummer);IF dbstatus=0THEN einleseschleifeFI .
+einleseschleife:zaehlen;WHILE NOT schlussREP anzahltupel:=maxleseanzahl;
+multisucc(indexnummer,anzahltupel);stackdurchlaufPER ;.stackdurchlauf:IF
+anzahltupel=0THEN dbstatus(1)ELSE WHILE anzahltupel<>0REP lesen;zaehlen;IF
+vorzeitigesendeTHEN dbstatus(1);anzahltupel:=0FI ;PER FI .schluss:dbstatus<>0
+.zaehlen:stataktion(vorzeitigesende).lesen:multisucc;anzahltupelDECR 1;.END
+PROC statleseschleife;TEXT PROC rechtstext(TEXT CONST t,INT CONST laenge):((
+laenge-length(t))*" ")+tEND PROC rechtstext;PROC aenderungsvermerksetzen(
+TEXT CONST schlwert):IF schlwert<>schlaktCAND schlwert<>schlgeplTHEN LEAVE
+aenderungsvermerksetzenFI ;inittupel(dnrschluessel);putwert(fnrschlsachgebiet
+,sgaenderung);putwert(fnrschlschluessel,schlwert);search(dnrschluessel,TRUE )
+;IF dbstatus=okTHEN putwert(fnrschllangtext,date+blank+timeofday);update(
+dnrschluessel)ELSE putwert(fnrschlsachgebiet,sgaenderung);putwert(
+fnrschlschluessel,schlwert);putwert(fnrschllangtext,date+blank+timeofday);
+insert(dnrschluessel)FI END PROC aenderungsvermerksetzen;PROC
+geplanteshjundsjberechnen(TEXT VAR halbjahr,schuljahr):TEXT VAR hilfe;IF
+halbjahr="1"THEN halbjahr:="2";ELSE halbjahr:="1";schuljahr:=subtext(
+schuljahr,3);hilfe:=text(int(schuljahr)+1);schuljahrCAT subtext("0"+hilfe,
+LENGTH (hilfe))FI END PROC geplanteshjundsjberechnen;TEXT PROC textnichtnull(
+TEXT CONST txt):TEXT VAR t:=txt;IF t=length(t)*"0"THEN t:=""FI ;tEND PROC
+textnichtnull;TEXT PROC jgstaufber(TEXT CONST jgst):LET erstestellejgst="0",
+maxsek1=10;INT VAR ijgst:=int(jgst);IF ijgst>=maxsek1THEN jgstELIF ijgst=0
+THEN ""ELSE erstestellejgst+text(ijgst)FI END PROC jgstaufber;BOOL PROC
+eingabenummerisch(TEXT CONST t):INT VAR lv;FOR lvFROM 1UPTO length(t)REP IF
+pos("0123456789",tSUB lv)=0THEN LEAVE eingabenummerischWITH FALSE FI PER ;
+TRUE END PROC eingabenummerisch;END PACKET allgemeinegrundfunktionen
+
diff --git a/app/baisy/2.2.1-schulis/src/aufruf manager b/app/baisy/2.2.1-schulis/src/aufruf manager
new file mode 100644
index 0000000..9577a95
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/aufruf manager
@@ -0,0 +1,39 @@
+PACKET aufrufmanagerDEFINES starteaufrufmanager:LET ack=0,nak=1,naksingletask
+=2;LET modussingleuser=1;PROC starteaufrufmanager:starteaufrufmanager(0)END
+PROC starteaufrufmanager;PROC starteaufrufmanager(INT CONST modus):TASK VAR
+sohn;initialisiere;REP warteaufdatenbankkennungundkanal;IF korrektTHEN
+gruendesohntaskmitkanalnrunddatenbankkennungFI PER .initialisiere:break;
+disablestop;setautonom;initsybifunktionen;.warteaufdatenbankkennungundkanal:
+TASK VAR sender;INT VAR kanalnr;DATASPACE VAR datenbankkennung;clearerror;
+wait(datenbankkennung,kanalnr,sender).korrekt:NOT iserror.
+gruendesohntaskmitkanalnrunddatenbankkennung:IF modus=modussingleuserCAND
+sohntaskschoneingerichtetTHEN quittung:=naksingletask;send(sender,quittung,
+niltask)ELSE gruendesohntask;meldesohnnameansenderFI .gruendesohntask:
+gruenden;IF korrektTHEN mitkanalnrunddatenbankkennungversorgenFI .gruenden:
+begin(PROC stellvertreter,sohn).mitkanalnrunddatenbankkennungversorgen:BOOL
+VAR erfolg;call(sohn,kanalnr,datenbankkennung,erfolg).meldesohnnameansender:
+INT VAR quittung;IF erfolgTHEN quittung:=ackELSE quittung:=nakFI ;send(sender
+,quittung,sohn).END PROC starteaufrufmanager;BOOL PROC
+sohntaskschoneingerichtet:accesscatalogue;exists(son(myself))END PROC
+sohntaskschoneingerichtet;PROC stellvertreter:
+warteaufkanalnrunddatenbankkennung;geheaufkanalundsetzewerte;IF erfolgTHEN
+warteaufauftrag;fuehreauftragausFI ;selbstmord.erfolg:NOT iserror.selbstmord:
+end(myself).warteaufkanalnrunddatenbankkennung:disablestop;DATASPACE VAR ds;
+TASK VAR vater;INT VAR kanalnr;wait(ds,kanalnr,vater).
+geheaufkanalundsetzewerte:INT VAR quittung;IF erfolgTHEN #quittung:=ack;
+oeffnedatenbank(ds)#datenbankeneroeffnenELSE quittung:=nakFI ;continue(
+kanalnr);send(vater,quittung,ds);forget(ds);initmeldungsfunktionen.
+datenbankeneroeffnen:oeffnedatenbank;fetchdd(schulisdbname);IF dbopen(
+schulisdbname)THEN systemdboff;quittung:=ackELSE quittung:=nakFI .
+warteaufauftrag:INT VAR knotenname;TASK VAR auftraggeber;REP wait(ds,
+knotenname,auftraggeber)UNTIL korrekterauftragPER .korrekterauftrag:
+knotenname>0.fuehreauftragaus:setzesystembaumundaktuellenknoten(ds,knotenname
+);starteanwendung;IF erfolgTHEN quittung:=ackELSE quittung:=nakFI ;break(
+quiet);send(auftraggeber,quittung,ds);forget(ds).END PROC stellvertreter;
+PROC call(TASK CONST zielmanager,INT CONST kanal,DATASPACE VAR ds,BOOL VAR
+erfolg):INT VAR replycode;call(zielmanager,kanal,ds,replycode);erfolg:=
+replycode=ack;forget(ds)END PROC call;PROC send(TASK CONST sender,INT CONST
+quittung,TASK CONST sohn):DATASPACE VAR ds:=nilspace;IF quittung=ackTHEN
+BOUND TASK VAR t:=ds;t:=sohnFI ;send(sender,quittung,ds);forget(ds)END PROC
+send;END PACKET aufrufmanager;
+
diff --git a/app/baisy/2.2.1-schulis/src/auskunftsfenster b/app/baisy/2.2.1-schulis/src/auskunftsfenster
new file mode 100644
index 0000000..855f1a3
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/auskunftsfenster
@@ -0,0 +1,126 @@
+PACKET auskunftsfensterDEFINES WINDOW ,:=,=,shrink,grow,open,startwindow,
+auskunfterteilung,encode,subtext,textschonmalzeigen:LET zeilenlimit=200,#
+maxauskfeld=6,##editorfenster=78,#eol="�",stop="�",hop="�",#cr=" ",#up="�",
+down="
+",esc="�",right="�",left="�";#escape=27,frage="?",halt="h",vor="+",
+zurueck="-",cleol="�";#LET cshrink=45,cgrow=43;TYPE WINDOW =STRUCT (INT lux,
+luy,rox,roy);BOOL VAR fuereditor:=FALSE ;BOOL OP =(WINDOW CONST v,w):((v.lux=
+w.lux)AND (v.luy=w.luy))AND ((v.rox=w.rox)AND (v.roy=w.roy))END OP =;OP :=(
+WINDOW VAR v,WINDOW CONST w):CONCR (v):=CONCR (w)END OP :=;WINDOW PROC
+startwindow(INT CONST u,v,w,x):WINDOW :(u,v,w,x)END PROC startwindow;PROC
+grow(WINDOW VAR w):INT VAR nx1,ny1,nx2,ny2;IF (w.lux)<=2THEN nx1:=w.lux;ELSE
+nx1:=w.lux-2FI ;IF (w.rox)>=77THEN nx2:=w.rox;ELSE nx2:=w.rox+2FI ;IF (w.luy)
+=24THEN ny1:=w.luy;ELSE ny1:=w.luy+1FI ;IF (w.roy)=1THEN ny2:=w.roy;ELSE ny2
+:=w.roy-1FI ;WINDOW VAR v:=WINDOW :(nx1,ny1,nx2,ny2);w:=vEND PROC grow;PROC
+shrink(WINDOW VAR w):INT VAR nx1,ny1,nx2,ny2;IF (w.roy+3)>=w.luyTHEN ny1:=w.
+luy;ny2:=w.roy;ELSE ny1:=w.luy-1;ny2:=w.roy+1;FI ;IF (w.lux+7)>=w.roxTHEN nx1
+:=w.lux;nx2:=w.roxELSE nx1:=w.lux+2;nx2:=w.rox-2FI ;WINDOW VAR v:=WINDOW :(
+nx1,ny1,nx2,ny2);erase(w);loeschespalte(w.rox-1,w);loeschespalte(w.lux+1,w);
+loeschespalte(w.rox+1,w);w:=vEND PROC shrink;PROC erase(WINDOW CONST w):
+loeschespalte(w.lux,w);loeschespalte(w.rox+2,w);loeschezeile(w.roy,w);
+loeschezeile(w.luy,w);END PROC erase;PROC open(WINDOW CONST w):INT VAR x1:=w.
+lux,y1:=w.luy,x2:=w.rox,y2:=w.roy;oeffnefenster(x1,y1,x2,y2)END PROC open;
+PROC unterlegung(INT CONST i,j):TEXT VAR grund;IF fuereditorTHEN cursor(j,i);
+grund:=(editorunterlegung(i)SUB j);IF grund=""THEN grund:=" "FI ;out(grund)
+ELSE reorganizescreen(i,j,j)FI END PROC unterlegung;PROC loeschespalte(INT
+CONST col,WINDOW CONST w):INT VAR from,to;from:=w.roy;to:=w.luy;INT VAR i;
+FOR iFROM fromUPTO toREP unterlegung(i,col)PER END PROC loeschespalte;PROC
+loeschezeile(INT CONST row,WINDOW CONST w):INT VAR from,to,lg,geslg;from:=w.
+lux;to:=w.rox;IF fuereditorTHEN cursor(from,row);TEXT CONST grund:=subtext(
+editorunterlegung(row),from,to+1);lg:=to-from+2;geslg:=length(grund);IF geslg
+<lgTHEN out(text(grund,lg))ELSE out(grund)FI ELSE reorganizescreen(row,from,
+to+1)FI END PROC loeschezeile;BOOL VAR nurschau:=FALSE ;PROC
+textschonmalzeigen(TEXT CONST t,WINDOW VAR w,BOOL CONST editorwunsch):TEXT
+VAR ausk:=t;nurschau:=TRUE ;auskunfterteilung(ausk,w,editorwunsch);nurschau:=
+FALSE END PROC textschonmalzeigen;PROC auskunfterteilung(TEXT VAR auskunft,
+WINDOW CONST v,BOOL CONST editorwunsch):initialisiere;
+auskunfterteilunganbenutzer;liefereevtlgewaehltenzeilenausschnitt.
+auskunfterteilunganbenutzer:REP warteaufreaktion;IF NOT nochinteresseTHEN
+LEAVE auskunfterteilunganbenutzerFI ;zeigefensterPER .zeigefenster:
+bestimmeneuecursorposition;IF ausbereichgeratenTHEN bauefensterneuaufFI .
+bauefensterneuauf:IF seitenwechselCAND (interesse=down)THEN IF bottom>=lTHEN
+LEAVE zeigefensterFI ;ELIF (interesse=down)THEN IF (bottom>=l)THEN LEAVE
+zeigefensterFI ;seitenanfang:=aktuellezeile-zeilenzahl+2;zeigersetzen;ELSE
+initialisiereseiteneu;IF seitenwechselCAND (interesse=up)THEN IF seitenanfang
+=1THEN LEAVE zeigefensterFI ;seitenanfang:=max(1,seitenanfang-zeilenzahl);
+zeigersetzenELIF (interesse=up)THEN IF seitenanfang=1THEN LEAVE zeigefenster
+FI ;seitenanfang:=seitenanfang-1;zeigersetzenELIF (interesse=hop)THEN
+seitenanfang:=1;zeigersetzenELSE bereitefenstervor;zeigersetzenFI ;FI ;
+trageinfensterein;.initialisiereseiteneu:seitenanfang:=aktuellezeile-
+zeilenzahl+1.trageinfensterein:FOR iFROM 1UPTO zeilenzahlREP formatierezeile;
+schreibzeileinfensterPER ;cursor(posx,posy).zeigersetzen:bottom:=
+zeilenanfaenge(seitenanfang);aktuellezeile:=seitenanfang-1.initialisiere:
+WINDOW VAR w:=v;BOOL VAR ausbereichgeraten;INT VAR bottom:=1,top:=1,
+seitenanfang:=1;INT VAR aktuellezeile:=0;ROW zeilenlimitINT VAR
+zeilenanfaenge;INT VAR i;BOOL VAR seitenwechsel:=TRUE ;TEXT VAR interesse:=
+down;INT VAR posy:=w.roy+1;INT VAR posx:=w.lux+3;fuereditor:=editorwunsch;
+bereitefenstervor;trageinfensterein;IF nurschauTHEN LEAVE auskunfterteilung
+FI .bestimmeneuecursorposition:cursor(w,interesse,seitenwechsel,posx,posy,
+ausbereichgeraten).bereitefenstervor:INT VAR x1:=w.lux,y1:=w.luy,x2:=w.rox,y2
+:=w.roy;INT CONST zeilenzahl:=y1-y2-1,spaltenzahl:=x2-x1-5;INT CONST l:=
+length(auskunft);TEXT CONST blankzeile:=spaltenzahl*" ";limito:=w.roy+1;
+limitu:=w.luy-1;limitr:=w.rox-2;limitl:=w.lux+3;.nochinteresse:(interesse<>
+esc).warteaufreaktion:seitenwechsel:=FALSE ;inchar(interesse);evtlschieben;
+IF geschobenTHEN open(w)FI ;IF hopbeginnTHEN seitenwechsel:=TRUE ;REP inchar(
+interesse)UNTIL erlaubtCOR hopbeginnPER ;FI .evtlschieben:BOOL VAR geschoben
+:=FALSE ;REP SELECT code(interesse)OF CASE cshrink:shrink(w)CASE cgrow:grow(w
+)OTHERWISE LEAVE evtlschiebenEND SELECT ;interesse:=incharety(2);geschoben:=
+TRUE PER .erlaubt:(interesse=up)COR (interesse=down)COR (interesse=left)COR (
+interesse=right).hopbeginn:interesse=hop.
+liefereevtlgewaehltenzeilenausschnitt:berechnezeilenincrement;IF NOT amanfang
+THEN berechnerelativzeile;TEXT VAR einkopiertext:=subtext(zeile,1,
+zeilenincrement);IF editorwunschTHEN type(einkopiertext)ELSE
+inaktuellesmaskenfeld(einkopiertext)FI ELSE inaktuellesmaskenfeld("")FI .
+berechnezeilenincrement:INT VAR zeilenincrement:=posx-limitl;.amanfang:
+zeilenincrement=0.berechnerelativzeile:INT VAR relativzeile:=posy-limito+1;
+initialisiereseiteneu;zeigersetzen;FOR iFROM 1UPTO relativzeileREP
+formatierezeilePER ;zeile:=text(zeile,spaltenzahl).formatierezeile:TEXT VAR
+zeile:="";IF NOT blankbeabsichtigtTHEN bottomsuchenFI ;IF bottom>=lTHEN zeile
+:=blankzeileELSE top:=min(bottom+spaltenzahl-1,l);zeile:=subtext(auskunft,
+bottom,top,eol,stop,TRUE );topINCR 1FI ;aktuellezeileINCR 1;zeilenanfaenge(
+aktuellezeile):=bottom;bottom:=top.blankbeabsichtigt:subtext(auskunft,bottom-
+1,bottom-1)=stop.bottomsuchen:TEXT VAR bottomvergleich;WHILE (bottom<=l)REP
+bottomvergleich:=subtext(auskunft,bottom,bottom);IF (bottomvergleich=" ")COR
+(bottomvergleich=eol)THEN bottomINCR 1ELSE LEAVE bottomsuchenFI PER .
+schreibzeileinfenster:zeile:=text(zeile,spaltenzahl);cursor(x1+3,y2+i);out(
+zeile).END PROC auskunfterteilung;INT VAR limito,limitu,limitr,limitl;PROC
+cursor(WINDOW CONST w,TEXT CONST interesse,BOOL CONST seitenwechsel,INT VAR
+posx,posy,BOOL VAR ausbereichgeraten):limitssetzen;neueposition.limitssetzen:
+limito:=w.roy+1;limitu:=w.luy-1;limitr:=w.rox-2;limitl:=w.lux+3;
+ausbereichgeraten:=FALSE .neueposition:IF seitenwechselTHEN IF (interesse=
+left)THEN anzeilenanfangELSE IF (interesse=right)THEN anzeilenendeELSE IF (
+interesse=down)THEN eineseitevorELSE IF (interesse=up)THEN eineseitezurueck
+FI FI FI FI ELSE IF interesse=leftTHEN nachlinksELSE IF interesse=rightTHEN
+nachrechtsELSE IF (interesse=down)THEN einezeilenachuntenELSE IF (interesse=
+up)THEN einezeilenachobenELSE cursornachlo;ausbereichgeraten:=TRUE FI FI FI
+FI FI ;cursor(posx,posy).nachlinks:IF posx>limitlTHEN posxDECR 1FI .
+nachrechts:IF posx<limitrTHEN posxINCR 1FI .anzeilenanfang:posx:=limitl.
+anzeilenende:posx:=limitr.einezeilenachunten:IF posy<limituTHEN posyINCR 1
+ELSE cursornachlu;ausbereichgeraten:=TRUE FI .einezeilenachoben:IF posy>
+limitoTHEN posyDECR 1ELSE cursornachlo;ausbereichgeraten:=TRUE FI .
+eineseitevor:IF posy<limituTHEN posy:=limituELSE cursornachlu;
+ausbereichgeraten:=TRUE FI .eineseitezurueck:IF posy>limitoTHEN posy:=limito
+ELSE cursornachlo;ausbereichgeraten:=TRUE FI .cursornachlo:posx:=limitl;posy
+:=limito.cursornachlu:posx:=limitl;posy:=limitu.END PROC cursor;TEXT PROC
+encode(TEXT CONST t):INT CONST max:=length(t);TEXT CONST vergleich:=subtext(t
+,max,max);IF vergleich=" "THEN subtext(t,1,max-1)+stopELSE t+eolFI END PROC
+encode;TEXT PROC subtext(TEXT VAR auskunft,INT CONST bottom,INT VAR top,TEXT
+CONST loe,TEXT CONST stp,BOOL CONST infenster):LET b=" ";TEXT VAR oberster;
+INT VAR lastblank;INT VAR i;TEXT VAR t,vergleich;konstruieret;t.konstruieret:
+FOR iFROM bottomUPTO topREP vergleich:=subtext(auskunft,i,i);IF vergleich=loe
+THEN IF NOT infensterTHEN t:=subtext(auskunft,bottom,i-1);top:=i;LEAVE
+konstruieretFI ;replace(auskunft,i,b);lastblank:=iELIF vergleich=stpTHEN t:=
+subtext(auskunft,bottom,i-1);IF NOT infensterTHEN t:=t+bFI ;top:=i;LEAVE
+konstruieretELIF vergleich=bTHEN lastblank:=iFI ;PER ;oberster:=subtext(
+auskunft,top+1,top+1);IF (lastblank<>top)CAND ((oberster<>b)CAND (oberster<>
+loe)CAND (oberster<>stp))THEN top:=lastblankFI ;t:=subtext(auskunft,bottom,
+top).END PROC subtext;PROC oeffnefenster(INT VAR x1,y1,x2,y2):
+zeichnegrundseite;zeichnezwischenlinien;zeichneunterseite.zeichnegrundseite:
+ermittlegrundkoordinaten;malepunkte.ermittlegrundkoordinaten:INT VAR x,y;x:=
+x1;y:=y2.malepunkte:INT VAR fensterbreite;fensterbreite:=x2-x1-1;cursor(x,y);
+out("");fensterbreite+2TIMESOUT " ";out("�").zeichnezwischenlinien:INT VAR
+j,fensterlaenge;fensterbreiteDECR 2;fensterlaenge:=y1-y2;FOR jFROM 1UPTO
+fensterlaenge-1REP yINCR 1;cursor(x,y);out(sp);fensterbreiteTIMESOUT " ";out(
+ep);PER .sp:" ".ep:" �".zeichneunterseite:yINCR 1;cursor(x,y);malepunkte.
+END PROC oeffnefenster;END PACKET auskunftsfenster
+
diff --git a/app/baisy/2.2.1-schulis/src/baisyio b/app/baisy/2.2.1-schulis/src/baisyio
new file mode 100644
index 0000000..d0dd294
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/baisyio
@@ -0,0 +1,51 @@
+PACKET baisyioDEFINES hardcopy,protected,protect,setzeschulisversion,
+schulisversion,get,putget,inaktuellesmaskenfeld,getcursorposfuerauskunft,
+bildschirmausdrucken:LET #variablenzahlklein=10,#variablenzahlgross=100,
+variablenzahlganzgross=200,cesc=27,cseiterueck=15,cseitevor=14,
+bildschirmausdruck="Bildschirm-Ausdruck",versilaenge=5,meldungsfeldnummer=1;
+INT VAR x,y;INT VAR xauskunft,yauskunft;LET xruhepos=1,yruhepos=24;BOOL VAR
+cl,pr,se,sp,le;INT VAR dummy;TEXT VAR versionsnummer:="01";TEXT VAR
+untergeschobenerfeldinhalt:="";PROC getcursorposfuerauskunft(INT VAR xpos,
+ypos):xpos:=xauskunft;ypos:=yauskunftEND PROC getcursorposfuerauskunft;PROC
+hardcopy:FILE VAR f:=sequentialfile(output,bildschirmausdruck);screencopy(f);
+print(bildschirmausdruck);forget(bildschirmausdruck,quiet)END PROC hardcopy;
+PROC inaktuellesmaskenfeld(TEXT CONST auskunftsteiltext):
+untergeschobenerfeldinhalt:=auskunftsteiltextEND PROC inaktuellesmaskenfeld;
+BOOL PROC protected(TAG CONST t,INT CONST feld):fieldinfos(t,feld,dummy,cl,pr
+,se,sp,le);clOR prEND PROC protected;PROC protect(TAG VAR t,INT CONST feld,
+BOOL CONST prneu):fieldinfos(t,feld,dummy,cl,pr,se,sp,le);setfieldinfos(t,
+feld,cl,prneu,se);END PROC protect;PROC setzeschulisversion(TEXT CONST versi)
+:versionsnummer:=text(versi,versilaenge)END PROC setzeschulisversion;TEXT
+PROC schulisversion:versionsnummerEND PROC schulisversion;PROC putget(TAG
+CONST t,ROW variablenzahlgrossTEXT VAR feld,INT VAR pos):INT VAR i;FOR iFROM
+posUPTO variablenzahlgrossREP IF fieldexists(t,i)THEN put(t,feld(i),i)FI PER
+;get(t,feld,pos);END PROC putget;PROC get(TAG CONST t,ROW variablenzahlgross
+TEXT VAR feld,INT VAR pos):einkopieren(t,feld(pos),pos);
+bestimmexykoordinatendesmeldungsfelds(t);REP get(t,feld(pos),pos);
+executeextendedcommandcode(t,pos);UNTIL leavingcode=cescPER ;getcursor(
+xauskunft,yauskunft);cursor(xruhepos,yruhepos).END PROC get;PROC putget(TAG
+CONST t,ROW variablenzahlganzgrossTEXT VAR feld,INT VAR pos):INT VAR i;FOR i
+FROM posUPTO variablenzahlganzgrossREP IF fieldexists(t,i)THEN put(t,feld(i),
+i)FI PER ;get(t,feld,pos);END PROC putget;PROC get(TAG CONST t,ROW
+variablenzahlganzgrossTEXT VAR feld,INT VAR pos):einkopieren(t,feld(pos),pos)
+;bestimmexykoordinatendesmeldungsfelds(t);REP get(t,feld(pos),pos);
+executeextendedcommandcode(t,pos);UNTIL leavingcode=cescPER ;getcursor(
+xauskunft,yauskunft);cursor(xruhepos,yruhepos).END PROC get;PROC einkopieren(
+TAG CONST t,TEXT VAR feld,INT CONST pos):IF etwasuntergeschobenTHEN zeigees
+FI .etwasuntergeschoben:untergeschobenerfeldinhalt<>"".zeigees:feld:=
+untergeschobenerfeldinhalt;put(t,feld,pos);untergeschobenerfeldinhalt:="".
+END PROC einkopieren;PROC bestimmexykoordinatendesmeldungsfelds(TAG CONST t):
+cursor(t,meldungsfeldnummer);getcursor(x,y);END PROC
+bestimmexykoordinatendesmeldungsfelds;PROC executeextendedcommandcode(TAG
+CONST t,INT VAR pos):INT VAR charcode:=leavingcode;SELECT charcodeOF CASE
+cseiterueck:tofirstfieldCASE cseitevor:tolastfieldOTHERWISE
+executecommandcode(t,pos)END SELECT .tofirstfield:pos:=firstfield(t);WHILE
+gesperrtREP pos:=nextfield(t,pos)PER .tolastfield:INT VAR oldpos;REP oldpos:=
+pos;pos:=nextfield(t,pos)UNTIL warletztesPER ;pos:=oldpos;WHILE gesperrtREP
+pos:=priorfield(t,pos)PER .warletztes:pos<1.gesperrt:protected(t,pos).END
+PROC executeextendedcommandcode;PROC bildschirmausdrucken(PROC (INT CONST )
+return):cursor(x,y);out(" Der Bildschirminhalt wird ausgedruckt. ");
+hardcopy;pause(10);cursor(x,y);out(
+"===================================================");return(1)END PROC
+bildschirmausdrucken;END PACKET baisyio;
+
diff --git a/app/baisy/2.2.1-schulis/src/block i-o b/app/baisy/2.2.1-schulis/src/block i-o
new file mode 100644
index 0000000..6ac925d
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/block i-o
@@ -0,0 +1,52 @@
+PACKET diskblockioDEFINES readdiskblock,readdiskblockandcloseworkiferror,
+readdiskcluster,writediskblock,writediskblockandcloseworkiferror,
+writediskcluster,firstnondummydspage,blocknodumpmodus:BOOL VAR
+blocknodumpflag:=FALSE ;LET writenormal=0;INT CONST firstnondummydspage:=2;
+INT VAR error;PROC readdiskblock(DATASPACE VAR ds,INT CONST dspageno,INT
+CONST blockno):IF blocknodumpflagTHEN dump("READ ",blockno)FI ;checkrerun;
+readblock(ds,dspageno,eublock(blockno),error);IF error>0THEN lesefehler(error
+)FI .END PROC readdiskblock;PROC readdiskblock(DATASPACE VAR ds,INT CONST
+dspageno,REAL CONST blockno):IF blocknodumpflagTHEN dump("READ ",blockno)FI ;
+checkrerun;readblock(ds,dspageno,eublock(blockno),error);IF error>0THEN
+lesefehler(error)FI .END PROC readdiskblock;PROC
+readdiskblockandcloseworkiferror(DATASPACE VAR ds,INT CONST dspageno,INT
+CONST blockno):IF blocknodumpflagTHEN dump("READ ",blockno)FI ;checkrerun;
+readblock(ds,dspageno,eublock(blockno),error);IF error>0THEN closework;
+lesefehler(error)FI .END PROC readdiskblockandcloseworkiferror;PROC
+readdiskblockandcloseworkiferror(DATASPACE VAR ds,INT CONST dspageno,REAL
+CONST blockno):IF blocknodumpflagTHEN dump("READ ",blockno)FI ;checkrerun;
+readblock(ds,dspageno,eublock(blockno),error);IF error>0THEN closework;
+lesefehler(error)FI .END PROC readdiskblockandcloseworkiferror;PROC
+readdiskcluster(DATASPACE VAR ds,INT CONST firstdspageno,REAL CONST clusterno
+):IF blocknodumpflagTHEN dump("CLUSTER ",clusterno)FI ;INT VAR i;FOR iFROM 0
+UPTO sectorspercluster-1REP readdiskblock(ds,firstdspageno+i,blockno+real(i))
+PER .blockno:beginofcluster(clusterno).END PROC readdiskcluster;PROC
+lesefehler(INT CONST fehlercode):errorstop(fehlertext).fehlertext:SELECT
+fehlercodeOF CASE 1:"Diskettenlaufwerk nicht betriebsbereit"CASE 2:
+"Lesefehler"OTHERWISE "Lesefehler "+text(fehlercode)END SELECT .END PROC
+lesefehler;PROC writediskblock(DATASPACE CONST ds,INT CONST dspageno,INT
+CONST blockno):IF blocknodumpflagTHEN dump("WRITE",blockno)FI ;checkrerun;
+writeblock(ds,dspageno,writenormal,eublock(blockno),error);IF error>0THEN
+schreibfehler(error)FI .END PROC writediskblock;PROC writediskblock(
+DATASPACE CONST ds,INT CONST dspageno,REAL CONST blockno):IF blocknodumpflag
+THEN dump("WRITE",blockno)FI ;checkrerun;writeblock(ds,dspageno,writenormal,
+eublock(blockno),error);IF error>0THEN schreibfehler(error)FI .END PROC
+writediskblock;PROC writediskblockandcloseworkiferror(DATASPACE CONST ds,INT
+CONST dspageno,INT CONST blockno):IF blocknodumpflagTHEN dump("WRITE",blockno
+)FI ;checkrerun;writeblock(ds,dspageno,writenormal,eublock(blockno),error);
+IF error>0THEN closework;schreibfehler(error)FI .END PROC
+writediskblockandcloseworkiferror;PROC writediskblockandcloseworkiferror(
+DATASPACE CONST ds,INT CONST dspageno,REAL CONST blockno):IF blocknodumpflag
+THEN dump("WRITE",blockno)FI ;checkrerun;writeblock(ds,dspageno,writenormal,
+eublock(blockno),error);IF error>0THEN closework;schreibfehler(error)FI .END
+PROC writediskblockandcloseworkiferror;PROC writediskcluster(DATASPACE CONST
+ds,INT CONST firstdspageno,REAL CONST clusterno):IF blocknodumpflagTHEN dump(
+"CLUSTER ",clusterno)FI ;INT VAR i;FOR iFROM 0UPTO sectorspercluster-1REP
+writediskblock(ds,firstdspageno+i,blockno+real(i))PER .blockno:beginofcluster
+(clusterno).END PROC writediskcluster;PROC schreibfehler(INT CONST fehlercode
+):errorstop(fehlertext).fehlertext:SELECT fehlercodeOF CASE 1:
+"Diskettenlaufwerk nicht betriebsbereit"CASE 2:"Schreibfehler"OTHERWISE
+"Schreibfehler "+text(fehlercode)END SELECT .END PROC schreibfehler;PROC
+blocknodumpmodus(BOOL CONST status):blocknodumpflag:=statusEND PROC
+blocknodumpmodus;END PACKET diskblockio;
+
diff --git a/app/baisy/2.2.1-schulis/src/bpb ds b/app/baisy/2.2.1-schulis/src/bpb ds
new file mode 100644
index 0000000..dabf721
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/bpb ds
Binary files differ
diff --git a/app/baisy/2.2.1-schulis/src/db archive.sc b/app/baisy/2.2.1-schulis/src/db archive.sc
new file mode 100644
index 0000000..e68c5ce
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/db archive.sc
@@ -0,0 +1,7 @@
+ PACKETdbarchive DEFINESdbtoarchive,dbfromarchive: TEXT VARuuuuuv:=""; PROCdbtoarchive( TEXT CONSTuuuuux):enablestop;logonarchive;fetchdb(uuuuux);uuuuuz;savetoarchive
+(db);uuuuvu;logoffarchive. ENDPROCdbtoarchive; PROCdbfromarchive( TEXT CONSTuuuuux):dbfromarchive(uuuuux,"") ENDPROCdbfromarchive; PROCdbfromarchive( TEXT CONSTuuuuux
+, TEXT CONSTuuuuwx):enablestop;logonarchive;uuuuuv:=postfix;postfix(uuuuwx);fetchfromarchive;uuuuuz; IF NOTtaskda(uuuuux) THEN IFyes("Server anlegen") CANDuuuuxw THEN
+restoredb(uuuuux);uuuuvu FI ELSErestoredb(uuuuux);uuuuvu FI;uuuuyv.uuuuyv:postfix("");fetchdd(uuuuux); BOOL VARuuuuyy:=dbopen(uuuuux);postfix(uuuuuv);logoffarchive
+.uuuuxw: IF NOTexists(uuuuux) THENcopy(uuuuux+uuuuwx,uuuuux) FI;createdb(uuuuux). ENDPROCdbfromarchive; PROCuuuuuz: IFonline THENline; FI ENDPROCuuuuuz; PROCuuuuvu
+:commanddialogue( FALSE);forget(db);commanddialogue( TRUE) ENDPROCuuuuvu; ENDPACKETdbarchive;
+
diff --git a/app/baisy/2.2.1-schulis/src/db dd.sc b/app/baisy/2.2.1-schulis/src/db dd.sc
new file mode 100644
index 0000000..7d6d1cd
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/db dd.sc
@@ -0,0 +1,60 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+����
+����
+����
+����
+����
+����
+
+
+
+����
+����
+����
+
+
+
+
+����
+����
+����
+����
+����
+����
+
+
+
+����
+����
+����
+
+
+�
+#����#
diff --git a/app/baisy/2.2.1-schulis/src/db ddinfo.sc b/app/baisy/2.2.1-schulis/src/db ddinfo.sc
new file mode 100644
index 0000000..3993705
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/db ddinfo.sc
@@ -0,0 +1,24 @@
+ PACKETddinfopacket DEFINESddinfo: REAL PROCuuuuuv( INT CONSTuuuuuw):records(uuuuuw) ENDPROCuuuuuv; PROCddinfo( TEXT CONSTuuuuvu):ddinfo(uuuuvu,"") ENDPROCddinfo;
+ PROCddinfo( TEXT CONSTuuuuvu,uuuuwu): INT VARuuuuwv,uuuuww:=1,uuuuwx; TEXT VARuuuuwy; IFuuuuvu="" ORuuuuvu="screen" THENpage ELSEforget(uuuuvu+".dd",quiet);sysout
+(uuuuvu+".dd"); IFuuuuvu="printer" THENputline("#type("""+uuuuwu+""")#") FI FI;uuuuxz;putline(" Datenbank: <"+name(1)+">");putline(" Anzahl Dateien erster Index Max DatID 1. Freier Eintrag"
+);putline(" "+text(anzdateien)+" "+text(firstindex)+" "+text(maxdatid)+" "+text(firstfree));uuuuyu;uuuuwv:=2; WHILE
+uuuuwv<firstfree REP IFwas(uuuuwv)=dateieintrag THENuuuuyy ELIFwas(uuuuwv)=indexeintrag THENuuuuzu ELSEuuuuwv INCR1 FI END REP;uuuuzw;uuuuzx;uuuuzy;uuuuzz; IFuuuuvu
+="" ORuuuuvu="screen" THENout("<RETURN>");pause;page ELSEsysout(""); IFuuuuvu="printer" THENprint(uuuuvu+".dd");forget(uuuuvu+".dd",quiet); FI FI.uuuuyy:uuuuxz;putline
+(" Datei: "+name(uuuuwv)+" (DatID: "+text(datid(uuuuwv))+")");uuuuwy:=compress(text(uuuuuv(uuuuwv),15,0));uuuuwy:=subtext(uuuuwy,1,length(uuuuwy)-1);putline(" Anzahl Schlüsselfelder: "
++text(anzkey(uuuuwv))+" Befugnis: "+text(befugnis(uuuuwv))+" Datensätze: "+uuuuwy);putline(" Feld Typ Länge XN YN XF YF Befug 1234567890123456"
+);uuuuwv INCR1;uuuuwx:=1; WHILEuuuuwv<firstfree CANDistfeld(was(uuuuwv)) REPuuuuxz;uuuvxz; IFlength(name(uuuuwv))>23 THENwrite(text(name(uuuuwv),23)+"<") ELSEwrite
+(text(name(uuuuwv),23)+" ") FI;write(code(feldtyp(uuuuwv))+" "); IFfeldtyp(uuuuwv)=realfeld THENuuuuwy:=text(einglaenge(uuuuwv))+"."+text(nachkomma(uuuuwv));write
+(text("",5-length(uuuuwy)));write(uuuuwy+" ") ELSEwrite(text(einglaenge(uuuuwv),5)+" ") FI;write(text(posxname(uuuuwv),2)+" ");write(text(posyname(uuuuwv),2)+" ")
+;write(text(posxfeld(uuuuwv),2)+" ");write(text(posyfeld(uuuuwv),2)+" ");write(text(befugnis(uuuuwv),5)+" ");uuuwuy;line;uuuuwv INCR1; END REP;uuuuyu.uuuwvv:3*" "
+.uuuuzw:uuuuyu;line;write("INITIALISIERUNGEN");line;line;uuuuwv:=3; WHILEuuuuwv<firstfree REP IFinitialisierung(uuuuwv)<>"" CANDuuuwwv(uuuuwv) THENputline(text(uuuwvv
++"zu Feld "+text(text(uuuuwv),4)+": "+initialisierung(uuuuwv),76)) FI;uuuuwv INCR1 PER;line.uuuuzx:uuuuyu;line;write("PLAUSIBILITÄTEN");line;line;uuuuwv:=3; WHILE
+uuuuwv<firstfree REP IFplausi(uuuuwv)<>"" CANDuuuwwv(uuuuwv) THENputline(text(uuuwvv+"zu Feld "+text(text(uuuuwv),4)+": "+plausi(uuuuwv),76)) FI;uuuuwv INCR1 PER;
+line.uuuuzy:uuuuyu;line;write("HILFSTEXTNUMMERN");line;line;uuuuwv:=3; WHILEuuuuwv<firstfree REP IFhilfstextnr(uuuuwv)>0 THENputline(uuuwvv+"zu Feld "+text(text(uuuuwv
+),4)+": "+text(hilfstextnr(uuuuwv))) FI;uuuuwv INCR1 PER;line.uuuuzz:uuuuyu;line;write("STANDARD-AKTIONEN");line;line;uuuuwv:=3; WHILEuuuuwv<firstfree REP IFstandardaktion
+(uuuuwv) CANDuuuwwv(uuuuwv) THENputline(text(uuuwvv+"zu Feld "+text(text(uuuuwv),4)+": "+zugriff(uuuuwv),76)) FI;uuuuwv INCR1 PER;line.uuuwuy: INT VARuuuxwx; FORuuuxwx
+ FROM1 UPTO16 REP IFswitch(uuuuwv,uuuxwx) THENwrite("*") ELSEwrite("-") FI PER.uuuuzu: TEXT VARuuuxxw:=""; WHILEuuuuwv<firstfree REPuuuuxz; IFphonetic(uuuuwv) THEN
+uuuxxw:=" Phon-Index: " ELSEuuuxxw:=" Index : " FI;putline(uuuxxw+name(uuuuwv)+" (DatID: "+text(datid(uuuuwv))+")");putline(" zu Datei : "+name(dateinr(
+primdatid(uuuuwv))));putline(" über Felder: "+text(zugriff(uuuuwv),25));uuuuwv INCR1; PER.uuuuxz: TEXT VARindex:=text(uuuuww);write((3-length(index))*" ");write
+(index+")");uuuuww INCR1.uuuvxz:index:=text(uuuuwx);write((3-length(index))*" ");write(index+". ");uuuuwx INCR1.uuuuyu:write(6*"-------------");line. END PROCddinfo
+; BOOL PROCuuuwwv( INT CONSTuuuyuz):uuuyuz<>1 CANDwas(uuuyuz)<>dateieintrag CANDwas(uuuyuz)<>indexeintrag ENDPROCuuuwwv; ENDPACKETddinfopacket;
+
diff --git a/app/baisy/2.2.1-schulis/src/db fetch.baisy b/app/baisy/2.2.1-schulis/src/db fetch.baisy
new file mode 100644
index 0000000..5f40dd1
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/db fetch.baisy
@@ -0,0 +1,28 @@
+PACKET fetch dd packet
+DEFINES fetch dd,
+ server station
+:
+
+LET save dd code = 36;
+
+DATASPACE VAR ds;
+
+INT VAR reply code, stat no:: station(myself);
+
+PROC server station (INT CONST server stat):
+ stat no:= server stat
+ENDPROC server station;
+
+PROC fetch dd (TEXT CONST db name): (* sf 4.12.86 *)
+ forget(ds); ds:= nilspace;
+ call (stat no/db name,save dd code,ds,reply code);
+ IF reply code = save dd code
+ THEN
+ forget (db name,quiet);
+ copy (ds,db name)
+ FI;
+ forget(ds)
+ENDPROC fetch dd;
+
+ENDPACKET fetch dd packet;
+
diff --git a/app/baisy/2.2.1-schulis/src/db kernel.sc b/app/baisy/2.2.1-schulis/src/db kernel.sc
new file mode 100644
index 0000000..7d6d1cd
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/db kernel.sc
@@ -0,0 +1,60 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+����
+����
+����
+����
+����
+����
+
+
+
+����
+����
+����
+
+
+
+
+����
+����
+����
+����
+����
+����
+
+
+
+����
+����
+����
+
+
+�
+#����#
diff --git a/app/baisy/2.2.1-schulis/src/db parse.sc b/app/baisy/2.2.1-schulis/src/db parse.sc
new file mode 100644
index 0000000..38f0503
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/db parse.sc
@@ -0,0 +1,38 @@
+ PACKETdbparse DEFINESparsetupel,buildtupel,buildkey,parsenooffields,reinitparsing,savetupel,restoretupel,istzahl: LETtextfeld=84,intfeld=73,realfeld=82,aktionsfeld
+=65,datumfeld=68,editorfeld=69,pointerfeld=80,#dateieintrag=1,#indexeintrag=2;#schluessel=1,daten=2,alles=3;# TEXT VARuuuuuv:=""; INT VARuuuuuw,uuuuux,uuuuuy; INT
+ VARuuuuuz,uuuuvu,uuuuvv; TEXT VARuuuuvw:="00",uuuuvx:="",uuuuvy:="",uuuuvz:="",uuuuwu:=""; BOOL VARuuuuwv; BOOL PROCuuuuww( TEXT CONSTuuuuwx):(uuuuwx>"/") AND(uuuuwx
+<":") END PROCuuuuww; PROCuuuuxv( INT CONSTuuuuxw):uuuuxv(uuuuxw,uuuuxz) ENDPROCuuuuxv; PROCuuuuxv( INT CONSTuuuuxw,uuuuyx): INT VARuuuuyy:=uuuuxw,uuuuzu:=4,uuuuzv
+:=0,uuuuuy:=anzattr(uuuuxw)+uuuuxw; WHILE(uuuuuy>uuuuyy) CANDuuuuzv<=uuuuyx REPuuuuyy INCR1; IF NOTstandardaktion(uuuuyy) THENputzugriff(uuuuyy,uuuvvu(uuuuyy,uuuuzu
+)) ELSEuuuuwv:= TRUE FI;uuuuzv INCR1 PER ENDPROCuuuuxv; INT VARuuuuxz:=maxint; PROCparsenooffields( INT CONSTuuuvww):uuuuxz:=uuuvww ENDPROCparsenooffields; INT PROC
+parsenooffields:uuuuxz ENDPROCparsenooffields; PROCreinitparsing:uuuuxz:=maxint ENDPROCreinitparsing; TEXT PROCuuuvvu( INT CONSTuuuuyy, INT VARuuuuzu):uuuuuz:=0;uuuuvu
+:=2;uuuuvv:=feldtyp(uuuuyy); SELECTuuuuvv OF CASEaktionsfeld,textfeld,pointerfeld,realfeld,editorfeld,datumfeld:#uuuvzw;uuuvzx;#uuuvzy;uuuuwv:=uuuuwv OR(uuuuvv=aktionsfeld
+)#change(uuuwuw,1,2+uuuuuz,"")# CASEintfeld:uuuuuz:=2;uuuuvu:=0;uuuvzx;#change(uuuwuw,1,2,"")# ENDSELECT;uuuuzu:=uuuuzu+uuuuuz+uuuuvu;uuuuvx.uuuvzy:uuuuvx:=subtext
+(uuuuwu,uuuuzu,uuuuzu+1);#uuuuuz:=wortnachint(uuuuvx);# IFuuuuvx<>"" THENuuuuuz:=uuuuvx ISUB1;uuuuvx:=subtext(uuuuwu,uuuuzu+uuuuvu,uuuuzu+uuuuvu+uuuuuz-1) ELSEuuuuuz
+:=0;uuuuvx:="" FI.uuuvzx: IFuuuuuz<>0 THENuuuuvx:=subtext(uuuuwu,uuuuzu+uuuuvu,uuuuzu+uuuuvu+uuuuuz-1) ELSEuuuuvx:="" FI. ENDPROCuuuvvu; PROCuuuxvv( INT CONSTuuuxvw
+): INT VARuuuxvx;disablestop; FORuuuxvx FROMuuuxvw+1 UPTOuuuxvw+anzattr(uuuxvw) REP IFfeldtyp(uuuxvx)=aktionsfeld CANDzugriff(uuuxvx)<>"" THEN IFactionlocked(uuuxvx
+) THEN#unlockaction(uuuxvx)# ELSEdo(zugriff(uuuxvx)); IFiserror THENactionfailure(uuuxvx, TRUE);clearerror ELSEactionfailure(uuuxvx, FALSE) FI FI FI PER;enablestop
+ ENDPROCuuuxvv; PROCparsetupel( INT CONSTuuuxxz, TEXT CONSTuuuxyu):parsetupel(uuuxxz,uuuxyu, FALSE, TRUE) ENDPROCparsetupel; PROCparsetupel( INT CONSTuuuxxz, TEXT
+ CONSTuuuxyu, BOOL CONSTuuuxzw,uuuxzx): INT VARuuuxzy:=uuuxxz; IF NOTuuuxzw THENuuuuwu:=uuuxyu;uuuyux FI.uuuyux: IFwas(uuuxxz)=indexeintrag THENuuuxzy:=dateinr(primdatid
+(uuuxxz)) FI;uuuuwv:= FALSE;uuuuxv(uuuxzy); IFuuuuwv CANDuuuxzx THENuuuxvv(uuuxzy) FI. ENDPROCparsetupel; PROCbuildtupel( INT CONSTuuuuxw, TEXT VARuuuxyu): INT VAR
+uuuuyy:=uuuuxw,uuuuuy:=anzattr(uuuuxw)+uuuuxw;replace(uuuuvw,1,uuuuxw);uuuuwu:="";uuuuwu CAT"D";uuuuwu CATuuuuvw; WHILEuuuuuy>uuuuyy REPuuuuyy INCR1; IFfeldtyp(uuuuyy
+)<>intfeld THEN IF NOTstandardaktion(uuuuyy) THENuuuyzz(zugriff(uuuuyy)) FI; ELSEuuuuwu CATzugriff(uuuuyy) FI PER;uuuxyu:=uuuuwu ENDPROCbuildtupel; PROCuuuyzz( TEXT
+ CONSTwert):replace(uuuuvw,1,length(wert));uuuuwu CATuuuuvw;uuuuwu CATwert ENDPROCuuuyzz; BOOL PROCistzahl( TEXT CONSTuuuzwv): INT VARuuuzww; FORuuuzww FROM1 UPTO
+length(uuuzwv) REP IF NOTuuuuww(uuuzwv SUBuuuzww) THEN LEAVEistzahl WITH FALSE FI PER; TRUE ENDPROCistzahl; PROCbuildkey( INT CONSTuuuuxw, TEXT VARuuuzyu,uuuzyv, BOOL
+ CONSTuuuzyw,uuuzyx): INT VARuuuzyy:=1,uuuzyz,uuuuyy:=uuuuxw,uuuzzw; BOOL VARuuuzzx:=phonetic(uuuuxw),uuuzzz:=(was(uuuuxw)=indexeintrag);uuuuvy:="";uuuzyu:=""; IF
+uuuzyx THENuuuzyv:="";buildkey(dateinr(primdatid(uuuuxw)),uuuzyu,uuuzyv, FALSE, FALSE);uuuzyu:="";uuuuvy:="" FI; IFuuuzzz THENuuvuwu ELSEuuvuwv FI; IFuuuzzx THENuuuzyu
+ CATcode(0) FI; IFuuuzzz THEN IF#uuvuwz ORuuvuxu ORuuvuxv???#uuuzyw THENuuuzyu CATuuuzyv FI ELSEuuuzyv:=uuuzyu; FI.uuvuwv:uuuuuy:=anzkey(uuuuxw)+uuuuxw; WHILEuuuuyy
+<uuuuuy REPuuuuyy INCR1;uuvuzw PER;.uuvuwu:uuuuuv:=zugriff(uuuuxw);uuuuuw:=dateinr(primdatid(uuuuxw));uuuuux:=length(uuuuuv);uuuzyz:=pos(uuuuuv,";");uuuuyy:=int(subtext
+(uuuuuv,1,uuuzyz-1))+uuuuuw;uuuzyy:=uuuzyz+1; WHILEuuuzyz>0 REPuuvuzw;uuuzyz:=pos(uuuuuv,";",uuuzyy);uuuuyy:=int(subtext(uuuuuv,uuuzyy,uuuzyz-1))+uuuuuw;uuuzyy:=uuuzyz
++1 PER;.uuvuzw:uuuzzw:=feldtyp(uuuuyy); IFuuuzzw=realfeld CORuuuzzw=datumfeld THENuuuzyu CATzugriff(uuuuyy) ELSE# IFuuuzzw=textfeld ORuuuzzw=intfeld ORuuuzzw=aktionsfeld
+ ORuuuzzw=editorfeld ORuuuzzw=pointerfeld THEN#uuvwuu FI; IF NOTuuuzzx THENuuuzyu CATcode(0) FI.uuvwuu: IF NOTstandardaktion(uuuuyy) THEN IFuuuzzx THENuuuzyu CATphoneticcode
+(zugriff(uuuuyy)) ELSEuuuuvy:=zugriff(uuuuyy); IFuuuzzw=textfeld CORuuuzzw=editorfeld THEN IFalpharechts(uuuuyy) CANDistzahl(uuuuvy) THENuuvwwx ELSEuuvwwy FI; FI;
+uuuzyu CATuuuuvy FI FI.uuvwwy:changeall(uuuuvy,"ß","ss");changeall(uuuuvy,"Ä","Ae");changeall(uuuuvy,"Ü","Ue");changeall(uuuuvy,"Ö","Oe");changeall(uuuuvy,"ä","ae"
+);changeall(uuuuvy,"ü","ue");changeall(uuuuvy,"ö","oe").uuvwwx:uuuuvy:=((einglaenge(uuuuyy)-length(uuuuvy))*"0")+uuuuvy. ENDPROCbuildkey; PROCsavetupel( INT CONST
+uuuxzy, TEXT VARuuvwzz): INT VARuuuuyy,uuvxuv; BOOL VARuuvxuw:= FALSE; IFwas(uuuxzy)=dateieintrag THENuuvxuv:=uuuxzy ELSEuuvxuv:=dateinr(primdatid(uuuxzy)) FI;uuvwzz
+:=""; FORuuuuyy FROM1 UPTOmin(anzattr(uuvxuv),uuuuxz) REPuuvxuw:=feldtyp(uuuuyy+uuvxuv)=pointerfeld; IFuuvxuw CANDlength(wert(uuuuyy+uuvxuv))<>uuvxxu THENuuvwzz CAT
+(uuvxxw+uuvxxx) ELSEuuvwzz CAT(wert(uuvxuv+uuuuyy)+uuvxxx) FI PER ENDPROCsavetupel; PROCrestoretupel( INT CONSTuuuxzy, TEXT CONSTuuvwzz): INT VARuuuuyy,uuvxuv,uuvxzw
+,uuuzyy:=1; BOOL VARuuvxuw:= FALSE;uuuuvz:=uuvwzz; IFwas(uuuxzy)=dateieintrag THENuuvxuv:=uuuxzy ELSEuuvxuv:=dateinr(primdatid(uuuxzy)) FI; FORuuuuyy FROMuuvxuv+1
+ UPTOuuvxuv+min(anzattr(uuvxuv),uuuuxz) REPuuvxuw:=feldtyp(uuuuyy)=pointerfeld; IFuuvxuw THENuuvxzw:=uuuzyy+4 ELSEuuvxzw:=pos(uuuuvz,uuvxxx,uuuzyy) FI;uuuuvy:=subtext
+(uuuuvz,uuuzyy,(uuvxzw-1));uuuzyy:=uuvxzw+1; IFuuvxuw CANDuuuuvy=uuvxxw THENuuuuvy:="" FI;putwert(uuuuyy,uuuuvy) PER ENDPROCrestoretupel; LETuuvxxx="�",uuvxxw="0000"
+,uuvxxu=4; ENDPACKETdbparse;
+
diff --git a/app/baisy/2.2.1-schulis/src/db phon.sc b/app/baisy/2.2.1-schulis/src/db phon.sc
new file mode 100644
index 0000000..b4d887a
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/db phon.sc
@@ -0,0 +1,17 @@
+ PACKETphonpacket DEFINESphoneticcode,gross,allesgross:#$ IFmitphonetic THEN# LETa=65,uuuuuv=66,uuuuuw=67,uuuuux=68,e=69,uuuuuy=70,uuuuuz=71,uuuuvu=72,uuuuvv=73,uuuuvw
+=74,uuuuvx=75,uuuuvy=76,uuuuvz=77,uuuuwu=78,uuuuwv=79,uuuuww=80,uuuuwx=81,uuuuwy=82,uuuuwz=83,uuuuxu=84,uuuuxv=85,uuuuxw=86,uuuuxx=87,uuuuxy=88,uuuuxz=89,uuuuyu=90
+,uuuuyv=214,uuuuyw=215,uuuuyx=216,uuuuyy=251; TEXT VARuuuuyz:="",uuuuzu:="";#$ FI# TEXT PROCgross( TEXT CONSTuuuuzw): IFcode(uuuuzw)>96 CANDcode(uuuuzw)<123 THENcode
+(code(uuuuzw)-32) ELIFcode(uuuuzw)>216 CANDcode(uuuuzw)<220 THENcode(code(uuuuzw)-3) ELSEuuuuzw FI END PROCgross; TEXT PROCallesgross( TEXT CONSTword): TEXT VARuuuvvu
+:=""; INT VARuuuuvv; FORuuuuvv FROM1 UPTOlength(word) REPuuuvvu CATgross(word SUBuuuuvv); PER;uuuvvu END PROCallesgross; PROCchange( TEXT VARuuuvww, TEXT CONSTuuuvwx
+, INT CONSTpos):change(uuuvww,pos,pos,uuuvwx) ENDPROCchange; TEXT PROCphoneticcode( TEXT CONSTuuuvxv): TEXT VARuuuvxw:="";#$ IFmitphonetic THEN# INT VARuuuvxx:=1;
+ WHILEuuuvxx<=length(uuuvxv) REP SELECTcode(gross(uuuvxv SUBuuuvxx)) OF CASEuuuuvu:uuuvyy CASEa:uuuvxw CAT"6";uuuvzu CASEuuuuvv:uuuvxw CAT"8";uuuvzx CASEuuuuwv:uuuvxw
+ CAT"9";uuuwuu CASEuuuuxv:uuuvxw CAT"0";uuuwux CASEuuuuwz:uuuvxw CAT"2";uuuwvu CASEuuuuyv,uuuuyw,e:uuuvxw CAT"7" CASEuuuuvw,uuuuyx,uuuuxz:uuuvxw CAT"8" CASEuuuuuv
+,uuuuuy,uuuuww,uuuuxw,uuuuxx:uuuvxw CAT"1" CASEuuuuuw,uuuuuz,uuuuvx,uuuuwx,uuuuxy,uuuuyu,uuuuyy:uuuvxw CAT"2" CASEuuuuux,uuuuxu:uuuvxw CAT"3" CASEuuuuvy,uuuuwy:uuuvxw
+ CAT"4" CASEuuuuvz,uuuuwu:uuuvxw CAT"5" ENDSELECT;uuuvxx INCR1; IFlength(uuuvxw)>1 CAND(uuuvxw SUBlength(uuuvxw))=(uuuvxw SUB(length(uuuvxw)-1)) THENchange(uuuvxw
+,"",length(uuuvxw)) FI PER;#$ FI#uuuvxw.#$ IFmitphonetic THEN#uuuvyy:.uuuvzu: IFuuuvxx<length(uuuvxv) THENuuuuzu:=gross(uuuvxv SUB(uuuvxx+1)); IFuuuuzu="E" THENchange
+(uuuvxw,"7",length(uuuvxw));uuuvxx INCR1; ELSE IFuuuuzu="I" ORuuuuzu="Y" THENchange(uuuvxw,"7",length(uuuvxw));uuuvxw CAT"8";uuuvxx INCR1; FI FI FI.uuuwuu:uuuvzu;
+ IF(uuuvxw SUBlength(uuuvxw))="8" THENchange(uuuvxw,"0",length(uuuvxw)); FI.uuuvzx: IFuuuvxx<length(uuuvxv) THENuuuuzu:=gross(uuuvxv SUB(uuuvxx+1)); IFuuuuzu="H" THEN
+change(uuuvxw,"7",length(uuuvxw));uuuvxx INCR1; FI FI.uuuwux: IFuuuvxx<length(uuuvxv) THENuuuuzu:=gross(uuuvxv SUB(uuuvxx+1)); IFuuuuzu="E" THENchange(uuuvxw,"8",
+length(uuuvxw));uuuvxx INCR1; FI FI.uuuwvu: IFuuuvxx<length(uuuvxv)-1 THENuuuuzu:=gross(uuuvxv SUB(uuuvxx+1));uuuuyz:=gross(uuuvxv SUB(uuuvxx+2)); IFuuuuzu="C" AND
+uuuuyz="H" THENuuuvxx INCR2; FI FI.#$ FI# ENDPROCphoneticcode; ENDPACKETphonpacket;
+
diff --git a/app/baisy/2.2.1-schulis/src/db reorg.sc b/app/baisy/2.2.1-schulis/src/db reorg.sc
new file mode 100644
index 0000000..5903721
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/db reorg.sc
@@ -0,0 +1,48 @@
+PACKET dbreorgDEFINES reorgdb:LET uuuuuv=".temporary";TEXT VAR uuuuuw:="";
+INT VAR uuuuux,uuuuuy;PROC reorgdb:enablestop;uuuuuw:=name(1);uuuuvv;uuuuvw;
+uuuuvx;BOOL VAR uuuuvy:=dbopen(uuuuuw)ENDPROC reorgdb;TYPE DD =STRUCT (TEXT
+name,wert,initialisierung,plausi,INT was,uuuuwv,nachkomma,uuuuww,uuuuwx,
+uuuuwy,uuuuwz,uuuuxu,hilfstextnr,descript);LET uuuuxv=2978;TYPE DDROW =ROW
+uuuuxvDD ;BOUND DDROW VAR newdd;PROC uuuuxx(INT CONST uuuuux):newdd[uuuuux].
+name:=name(uuuuux);newdd[uuuuux].wert:=zugriff(uuuuux);newdd[uuuuux].was:=was
+(uuuuux);newdd[uuuuux].uuuuwv:=anzattr(uuuuux);newdd[uuuuux].nachkomma:=
+nachkomma(uuuuux);newdd[uuuuux].uuuuww:=anzkey(uuuuux);newdd[uuuuux].uuuuwx:=
+datid(uuuuux);newdd[uuuuux].uuuuwy:=posxfeld(uuuuux);newdd[uuuuux].uuuuwz:=
+posyfeld(uuuuux);newdd[uuuuux].uuuuxu:=befugnis(uuuuux);newdd[uuuuux].
+descript:=descript(uuuuux);newdd[uuuuux].initialisierung:=initialisierung(
+uuuuux);newdd[uuuuux].plausi:=plausi(uuuuux);newdd[uuuuux].hilfstextnr:=
+hilfstextnr(uuuuux)ENDPROC uuuuxx;PROC uuuuvv:forget(uuuuuw+uuuuuv,quiet);
+rename(uuuuuw,uuuuuw+uuuuuv);newdd:=new(uuuuuw);FOR uuuuuxFROM 1UPTO
+firstfree-1REP uuuuxx(uuuuux)PER ;forget(uuuuuw+uuuuuv,quiet)ENDPROC uuuuvv;
+LET uuuvzz=8192,uuuwuu=150;LET DATATABLE =ROW uuuvzzTEXT ;LET DINFOENTRIES =
+STRUCT (BOOL uuuwuw,uuuwux,INT firstfree,uuuwuy,uuuwuz,REAL uuuwvu);LET
+DINFOTABLE =ROW uuuwuuDINFOENTRIES ;BOUND DINFOTABLE VAR uuuwvw;BOUND
+DATATABLE VAR uuuwvx,uuuwvy;TEXT PROC uuuwvz(INT CONST uuuwwu):uuuuuw+".data"
++text(uuuwwu)END PROC uuuwvz;PROC uuuuvw:uuuwvw:=old(uuuwvz(0));FOR uuuuux
+FROM 1UPTO uuuwuuREP IF uuuwvw[uuuuux].uuuwuwTHEN uuuwyu;forget(uuuwvz(uuuuux
+)+uuuuuv,quiet)FI PER .uuuwyu:forget(uuuwvz(uuuuux)+uuuuuv,quiet);rename(
+uuuwvz(uuuuux),uuuwvz(uuuuux)+uuuuuv);uuuwvx:=new(uuuwvz(uuuuux));uuuwvy:=old
+(uuuwvz(uuuuux)+uuuuuv);FOR uuuuuyFROM 1UPTO uuuwvw[uuuuux].firstfree-1REP
+uuuwvx[uuuuuy]:=uuuwvy[uuuuuy]PER .ENDPROC uuuuvw;LET uuuxwy=#21,#48,uuuxwz=#
+250;96;#160;LET BINFOENTRIES =STRUCT (BOOL uuuwuw,INT firstfree,uuuwuy,uuuwuz
+);LET BINFOTABLE =ROW uuuwuuBINFOENTRIES ;BOUND BINFOTABLE VAR uuuxxy;TYPE
+ENTRY =STRUCT (TEXT uuuxxz,INT uuuxyu,uuuxyv);TYPE BLOCK =STRUCT (INT uuuxyw,
+uuuxyx,uuuxyy,uuuxyz,ROW uuuxwyBOOL map,ROW uuuxwyINT pointer,ROW uuuxwy
+ENTRY entry);LET BLOCKTABLE =ROW uuuxwzBLOCK ;BOUND BLOCKTABLE VAR uuuxzy,
+uuuxzz;TEXT PROC uuuyuu(INT CONST uuuwwu):uuuuuw+".tree"+text(uuuwwu)END
+PROC uuuyuu;PROC uuuuvx:uuuxxy:=old(uuuyuu(0));FOR uuuuuxFROM 1UPTO uuuwuu
+REP IF uuuxxy[uuuuux].uuuwuwTHEN uuuywv;forget(uuuyuu(uuuuux)+uuuuuv,quiet)
+FI PER .uuuywv:forget(uuuyuu(uuuuux)+uuuuuv,quiet);rename(uuuyuu(uuuuux),
+uuuyuu(uuuuux)+uuuuuv);uuuxzz:=new(uuuyuu(uuuuux));uuuxzy:=old(uuuyuu(uuuuux)
++uuuuuv);#note("TREE "+text(uuuuux));noteline;note("first free:"+text(uuuxxy[
+uuuuux].firstfree));noteline;note("unused :"+text(uuuxxy[uuuuux].uuuwuy));
+noteline;note("free :"+text(uuuxxy[uuuuux].uuuwuz));noteline;#FOR uuuuuy
+FROM 1UPTO uuuxxy[uuuuux].firstfree-1REP uuuxzz[uuuuuy]:=uuuxzy[uuuuuy]PER .
+ENDPROC uuuuvx;OP :=(ENTRY VAR uuuzww,ENTRY CONST uuuzwx):CONCR (uuuzww):=
+CONCR (uuuzwx)ENDOP :=;OP :=(BLOCK VAR uuuzww,BLOCK CONST uuuzwx):INT VAR
+uuuzxw;uuuzww.uuuxyw:=uuuzwx.uuuxyw;uuuzww.uuuxyx:=uuuzwx.uuuxyx;uuuzww.
+uuuxyy:=uuuzwx.uuuxyy;uuuzww.uuuxyz:=uuuzwx.uuuxyz;FOR uuuzxwFROM 1UPTO min(
+uuuzwx.uuuxyy-1,uuuxwy)REP uuuzww.entry[uuuzwx.pointer[uuuzxw]]:=uuuzwx.entry
+[uuuzwx.pointer[uuuzxw]]PER ;uuuzww.map:=uuuzwx.map;uuuzww.pointer:=uuuzwx.
+pointerENDOP :=;ENDPACKET dbreorg;
+
diff --git a/app/baisy/2.2.1-schulis/src/db reorganisation auftrag b/app/baisy/2.2.1-schulis/src/db reorganisation auftrag
new file mode 100644
index 0000000..8731c5d
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/db reorganisation auftrag
@@ -0,0 +1,12 @@
+PACKET dbreorganisationauftragDEFINES reorganisierenderanwendungsdaten:PROC
+reorganisierenderanwendungsdaten:LET namederzieltask="DB REORG";TASK VAR
+zieltask;LET order=1;INT VAR ok;DATASPACE VAR ds;BOOL VAR fehler:=FALSE ;LET
+meldnrbittewarten=69,meldnrkeinereorgtask=90,meldnrreorgerfolgreich=91,
+meldnrreorgnichtok=92;disablestop;zieltask:=/namederzieltask;IF iserrorTHEN
+fehler:=TRUE ;clearerrorFI ;enablestop;IF fehlerTHEN standardmeldung(
+meldnrkeinereorgtask,"");return(1)ELSE standardmeldung(meldnrbittewarten,"");
+ds:=nilspace;call(zieltask,order,ds,ok);forget(ds);fehler:=ok>0;IF fehler
+THEN standardmeldung(meldnrreorgnichtok,"");return(1)ELSE standardmeldung(
+meldnrreorgerfolgreich,"");return(1)FI FI END PROC
+reorganisierenderanwendungsdaten;END PACKET dbreorganisationauftrag
+
diff --git a/app/baisy/2.2.1-schulis/src/db reorganisation manager b/app/baisy/2.2.1-schulis/src/db reorganisation manager
new file mode 100644
index 0000000..c26715d
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/db reorganisation manager
@@ -0,0 +1,15 @@
+PACKET dbreorganisationmanagerDEFINES dbreorganisationmanager:INT VAR order;
+DATASPACE VAR ds;TASK VAR ordertask;BOOL VAR reorgok;INT VAR returncode;LET
+ack=0,nak=1;LET reorganisieren=1;LET dbname="EUMELbase.schulis";PROC
+dbreorganisationmanager:setautonom;disablestop;break;REP warteaufauftrag;
+fuehreaus;meldezurueckPER .warteaufauftrag:wait(ds,order,ordertask).fuehreaus
+:reorgok:=TRUE ;IF order=reorganisierenTHEN datenbankreorganisieren(reorgok);
+IF reorgokTHEN returncode:=ackELSE returncode:=nakFI ;FI .meldezurueck:forget
+(ds);ds:=nilspace;send(ordertask,returncode,ds).END PROC
+dbreorganisationmanager;PROC datenbankreorganisieren(BOOL VAR ok):
+commanddialogue(FALSE );forget(all);commanddialogue(TRUE );ok:=TRUE ;postfix(
+"");fetchdb(dbname);BOOL VAR b:=dbopen(dbname);reorgdb;IF iserrorTHEN ok:=
+FALSE ;clearerrorFI ;IF okTHEN restoredb(dbname)FI ;commanddialogue(FALSE );
+forget(all);commanddialogue(TRUE );END PROC datenbankreorganisierenEND
+PACKET dbreorganisationmanager
+
diff --git a/app/baisy/2.2.1-schulis/src/db scan b/app/baisy/2.2.1-schulis/src/db scan
new file mode 100644
index 0000000..e7cf320
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/db scan
@@ -0,0 +1,245 @@
+PACKET db scan
+
+(********************************************************************)
+(* *)
+(* AUTOR : Siegfried Fronzek (ISP GmbH) *)
+(* ZWECK : Navigation über eine Tupelmenge *)
+(* *)
+(* Vor Aufruf der Prozeduren scan first/scan forward *)
+(* müssen die ersten n Schlüsselwerte gesetzt werden. *)
+(* Diese Schlüsselwerte bestimmen die zu durchlaufende *)
+(* Tupel-Menge. *)
+(* Die Prozeduren scan last/scan pred bestimmen zum *)
+(* vorgegebenen Schlüssel den vorherigen Datensatz! *)
+(* *)
+(* Die Prozedur scan backward liefert einen Stack incl. *)
+(* (eventuell nächstem !!!!) Datensatz zum vorgegebenen *)
+(* Schlüssel, eignet sich also nicht zur Simulation *)
+(* der Proczedur scan last im Stack-Betrieb. *)
+(* *)
+(* DATUM : 06.04.87 *)
+(* GEÄNDERT: 20.05.87 PROCs scan backward, scan stack entry *)
+(* *)
+(********************************************************************)
+
+DEFINES scan first, scan last, scan succ, scan pred,
+ scan status, scan stack entry,
+ scan forward, scan backward, scan stack succ, scan stack pred
+ :
+
+INT VAR scan db status:: db status;
+
+PROC scan first (INT CONST index nr, BOOL PROC pruefung):
+ BOOL VAR exact sve:: exact match;
+ exact match (FALSE);
+ scan rumpf (index nr, BOOL PROC pruefung, PROC (INT CONST) search);
+ IF scan status <> ok
+ THEN
+ scan status (file empty)
+ FI ;
+ exact match (exact sve)
+ENDPROC scan first;
+
+PROC scan last (INT CONST index nr, BOOL PROC pruefung):
+ change index;
+ scan rumpf (index nr, BOOL PROC pruefung, PROC (INT CONST) pred);
+ IF scan status <> ok
+ THEN
+ scan status (file empty)
+ FI
+ENDPROC scan last;
+
+PROC scan succ (INT CONST index nr, BOOL PROC pruefung):
+ scan rumpf (index nr, BOOL PROC pruefung, PROC (INT CONST) succ);
+ENDPROC scan succ;
+
+PROC scan pred (INT CONST index nr, BOOL PROC pruefung):
+ scan rumpf (index nr, BOOL PROC pruefung, PROC (INT CONST) pred);
+ENDPROC scan pred;
+
+INT PROC scan status:
+ scan db status
+ENDPROC scan status;
+
+PROC scan status (INT CONST stat):
+ scan db status:= stat
+ENDPROC scan status;
+
+PROC scan rumpf (INT CONST index nr, BOOL PROC pruefung,
+ PROC (INT CONST) aktion ):
+ TEXT VAR sve t:: "";
+ save tupel (index nr, sve t);
+ aktion (index nr);
+ IF db status <> ok
+ THEN
+ restore tupel (index nr, sve t);
+ change index;
+ scan status (db status)
+ ELSE
+ IF NOT pruefung
+ THEN
+ restore tupel (index nr, sve t);
+ change index;
+ scan status (end of file)
+ ELSE
+ scan status (ok)
+ FI
+ FI
+ENDPROC scan rumpf;
+
+(******************************************************************)
+(* *)
+(* STACK ohne Datenraum *)
+(* *)
+(******************************************************************)
+#
+PROC scan forward (INT CONST index nr, BOOL PROC pruefung,
+ INT VAR anz tupels):
+ scan stack rumpf (index nr, BOOL PROC pruefung,
+ PROC (INT CONST,INT VAR) multisearch forward, anz tupels)
+ENDPROC scan forward;
+
+PROC scan backward (INT CONST index nr, BOOL PROC pruefung,
+ INT VAR anz tupels):
+ scan stack rumpf (index nr, BOOL PROC pruefung,
+ PROC (INT CONST,INT VAR) multisearch backward, anz tupels)
+ (* !!! Vorsicht: multisearch backward liefert den naechsten zu einem
+ ungültigen Startwert !!!!! *)
+ENDPROC scan backward;
+
+PROC scan succ (INT CONST index nr, BOOL PROC pruefung, INT VAR anz tupels):
+ scan stack rumpf (index nr, BOOL PROC pruefung,
+ PROC (INT CONST,INT VAR) multisucc, anz tupels);
+ENDPROC scan succ;
+
+PROC scan pred (INT CONST index nr, BOOL PROC pruefung, INT VAR anz tupels):
+ scan stack rumpf (index nr, BOOL PROC pruefung,
+ PROC (INT CONST,INT VAR) multipred, anz tupels)
+ENDPROC scan pred;
+
+PROC scan stack succ (INT CONST index nr, BOOL PROC pruefung):
+ scan stack rumpf (index nr, BOOL PROC pruefung, PROC multisucc);
+ENDPROC scan stack succ;
+
+PROC scan stack pred (INT CONST index nr, BOOL PROC pruefung):
+ scan stack rumpf (index nr, BOOL PROC pruefung, PROC multipred);
+ENDPROC scan stack pred;
+
+BOOL PROC scan stack entry (INT CONST entry nr, BOOL PROC pruefung):
+ stack entry (entry nr);
+ pruefung
+ENDPROC scan stack entry;
+
+PROC scan stack rumpf (INT CONST index nr, BOOL PROC pruefung,
+ PROC (INT CONST,INT VAR) aktion, INT VAR anz tupels ):
+ change index;
+ aktion (index nr, anz tupels);
+ scan status (end of file);
+ change index;
+ IF anz tupels = 0 COR db status <> ok
+ THEN
+ IF anz tupels <> 0
+ THEN
+ scan status (db status)
+ FI
+ ELSE
+ scan status (ok)
+ FI
+ENDPROC scan stack rumpf;
+
+PROC scan stack rumpf (INT CONST index nr, BOOL PROC pruefung,
+ PROC aktion):
+ aktion;
+ change index;
+ IF NOT pruefung
+ THEN
+ scan status (end of file)
+ ELSE
+ scan status (ok)
+ FI
+ENDPROC scan stack rumpf;
+
+ #
+(******************************************************************)
+(* *)
+(* STACK mit Datenraum *)
+(* *)
+(******************************************************************)
+
+
+PROC scan forward (INT CONST index nr, BOOL PROC pruefung,
+ INT VAR anz tupels):
+ scan stack rumpf (index nr, BOOL PROC pruefung,
+ PROC (INT CONST,INT VAR) multisearch forward,
+ anz tupels)
+ENDPROC scan forward;
+
+PROC scan backward (INT CONST index nr, BOOL PROC pruefung,
+ INT VAR anz tupels):
+ scan stack rumpf (index nr, BOOL PROC pruefung,
+ PROC (INT CONST,INT VAR) multisearch backward,
+ anz tupels)
+ (* !!! Vorsicht: multisearch backward liefert den naechsten zu einem
+ ungültigen Startwert !!!!! *)
+ENDPROC scan backward;
+
+PROC scan succ (INT CONST index nr, BOOL PROC pruefung, INT VAR anz tupels):
+ scan stack rumpf (index nr, BOOL PROC pruefung,
+ PROC (INT CONST,INT VAR) multisucc,
+ anz tupels)
+ENDPROC scan succ;
+
+PROC scan pred (INT CONST index nr, BOOL PROC pruefung, INT VAR anz tupels):
+ scan stack rumpf (index nr, BOOL PROC pruefung,
+ PROC (INT CONST,INT VAR) multipred,
+ anz tupels)
+ENDPROC scan pred;
+
+PROC scan stack succ (INT CONST index nr, BOOL PROC pruefung):
+ scan stack rumpf (index nr, BOOL PROC pruefung, PROC multisucc)
+ENDPROC scan stack succ;
+
+PROC scan stack pred (INT CONST index nr, BOOL PROC pruefung):
+ scan stack rumpf (index nr, BOOL PROC pruefung,
+ PROC multipred)
+ENDPROC scan stack pred;
+
+BOOL PROC scan stack entry (INT CONST entry nr, BOOL PROC pruefung ):
+ stack entry (entry nr);
+ pruefung
+ENDPROC scan stack entry;
+
+PROC scan stack rumpf (INT CONST index nr, BOOL PROC pruefung,
+ PROC (INT CONST,INT VAR) aktion,
+ INT VAR anz tupels):
+ change index;
+ aktion (index nr, anz tupels);
+ scan status (end of file);
+ IF anz tupels = 0 COR db status <> ok
+ THEN
+ change index;
+ IF anz tupels <> 0
+ THEN
+ scan status (db status)
+ FI
+ ELSE
+ scan status (ok)
+ FI
+ENDPROC scan stack rumpf;
+
+PROC scan stack rumpf (INT CONST index nr, BOOL PROC pruefung,
+ PROC aktion):
+ aktion;
+ IF NOT pruefung
+ THEN
+ change index;
+ scan status (end of file)
+ ELSE
+ scan status (ok)
+ FI
+ENDPROC scan stack rumpf;
+
+
+ENDPACKET db scan;
+
+
diff --git a/app/baisy/2.2.1-schulis/src/db utils.sc b/app/baisy/2.2.1-schulis/src/db utils.sc
new file mode 100644
index 0000000..7d6d1cd
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/db utils.sc
@@ -0,0 +1,60 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+����
+����
+����
+����
+����
+����
+
+
+
+����
+����
+����
+
+
+
+
+����
+����
+����
+����
+����
+����
+
+
+
+����
+����
+����
+
+
+�
+#����#
diff --git a/app/baisy/2.2.1-schulis/src/dir.dos b/app/baisy/2.2.1-schulis/src/dir.dos
new file mode 100644
index 0000000..fd348a1
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/dir.dos
@@ -0,0 +1,187 @@
+PACKET dirDEFINES opendir,insertdirentry,deletedirentry,initdirds,fileinfo,
+formatdir,dirlist,fileexists,subdirexists,allfiles,allsubdirs:LET
+maxdirentrys=1000;INITFLAG VAR dirblockdsused:=FALSE ;DATASPACE VAR
+dirblockds;BOUND STRUCT (ALIGN dummy,ROW 64REAL daten)VAR dirblock;REAL VAR
+lastreaddirblockno;PROC initdirblockio:lastreaddirblockno:=-1.0;IF NOT
+initialized(dirblockdsused)THEN dirblockds:=nilspace;dirblock:=dirblockdsFI .
+END PROC initdirblockio;PROC readdirblock(REAL CONST blocknr):IF
+lastreaddirblockno<>blocknrTHEN lastreaddirblockno:=-1.0;
+readdiskblockandcloseworkiferror(dirblockds,2,blocknr);lastreaddirblockno:=
+blocknrFI .END PROC readdirblock;PROC writedirblock(REAL CONST blocknr):
+writediskblockandcloseworkiferror(dirblockds,2,blocknr);lastreaddirblockno:=
+blocknr.END PROC writedirblock;PROC writedirblock:IF lastreaddirblockno<0.0
+THEN errorstop("Lesefehler")FI ;writedirblock(lastreaddirblockno)END PROC
+writedirblock;PROC getdirentry(TEXT VAR entrybuffer,INT CONST blockentryno):
+entrybuffer:=32*".";INT CONST replaceoffset:=4*blockentryno;replace(
+entrybuffer,1,dirblock.daten[replaceoffset+1]);replace(entrybuffer,2,dirblock
+.daten[replaceoffset+2]);replace(entrybuffer,3,dirblock.daten[replaceoffset+3
+]);replace(entrybuffer,4,dirblock.daten[replaceoffset+4]).END PROC
+getdirentry;PROC putdirentry(TEXT CONST entrybuffer,INT CONST blockentryno):
+INT CONST offset:=4*blockentryno;dirblock.daten[offset+1]:=entrybufferRSUB 1;
+dirblock.daten[offset+2]:=entrybufferRSUB 2;dirblock.daten[offset+3]:=
+entrybufferRSUB 3;dirblock.daten[offset+4]:=entrybufferRSUB 4.END PROC
+putdirentry;LET DIRPOS =REAL ;DIRPOS PROC dirpos(REAL CONST blocknr,INT
+CONST entrynr):blocknr*16.0+real(entrynr).END PROC dirpos;REAL PROC blockno(
+DIRPOS CONST p):floor(p/16.0)END PROC blockno;INT PROC entryno(DIRPOS CONST p
+):int(pMOD 16.0)END PROC entryno;PROC incr(DIRPOS VAR p):pINCR 1.0.END PROC
+incr;LET FREELIST =STRUCT (ROW maxdirentrysDIRPOS stack,INT stacktop,DIRPOS
+beginoffreearea,endofdir,REAL dirroot);PROC initfreelist(FREELIST VAR flist,
+REAL CONST root):flist.stacktop:=0;flist.beginoffreearea:=dirpos(9.0e99,0);
+flist.endofdir:=dirpos(-1.0,0);flist.dirroot:=root.END PROC initfreelist;
+PROC store(FREELIST VAR flist,DIRPOS CONST freepos):flist.stacktopINCR 1;
+flist.stack[flist.stacktop]:=freepos.END PROC store;PROC storebeginoffreearea
+(FREELIST VAR flist,DIRPOS CONST begin):flist.beginoffreearea:=beginEND PROC
+storebeginoffreearea;PROC storeendofdir(FREELIST VAR flist,DIRPOS CONST end):
+flist.endofdir:=endEND PROC storeendofdir;DIRPOS PROC freedirpos(FREELIST
+VAR flist):enablestop;DIRPOS VAR result;IF flist.stacktop>0THEN popELIF NOT
+freeareaemptyTHEN firstoffreeareaELIF expansionallowededTHEN
+allocatenewdircluster;result:=freedirpos(flist)ELSE errorstop(
+"Directory voll")FI ;result.pop:result:=flist.stack[flist.stacktop];flist.
+stacktopDECR 1.freeareaempty:flist.beginoffreearea>flist.endofdir.
+firstoffreearea:result:=flist.beginoffreearea;incr(flist.beginoffreearea).
+expansionalloweded:flist.dirroot>=2.0.allocatenewdircluster:REAL CONST
+newdircluster:=availablefatentry;REAL VAR lastentryno;
+searchlastentrynooffatchain;fatentry(newdircluster,lastfatchainentry);
+fatentry(lastentryno,newdircluster);writefat;storebeginoffreearea(flist,
+dirpos(firstnewblock,0));storeendofdir(flist,dirpos(lastnewblock,15));
+initnewdircluster.searchlastentrynooffatchain:lastentryno:=flist.dirroot;
+WHILE NOT islastfatchainentry(fatentry(lastentryno))REP lastentryno:=fatentry
+(lastentryno)PER .firstnewblock:beginofcluster(newdircluster).lastnewblock:
+beginofcluster(newdircluster)+real(sectorspercluster-1).initnewdircluster:
+TEXT CONST emptydirentry:=32*"�";INT VAR i;FOR iFROM 0UPTO 15REP putdirentry(
+emptydirentry,i)PER ;disablestop;REAL VAR blockno:=firstnewblock;WHILE
+blockno<=lastnewblockREP writedirblock(blockno)PER .END PROC freedirpos;LET
+FILEENTRY =STRUCT (TEXT dateandtime,REAL size,firstcluster,DIRPOS dirpos),
+FILELIST =STRUCT (THESAURUS thes,ROW maxdirentrysFILEENTRY entry);PROC
+initfilelist(FILELIST VAR flist):flist.thes:=emptythesaurus.END PROC
+initfilelist;PROC storefileentry(FILELIST VAR flist,TEXT CONST entrytext,
+DIRPOS CONST position):INT VAR entryindex;insert(flist.thes,filename,
+entryindex);storefileentry(flist.entry[entryindex],entrytext,position).
+filename:TEXT CONST namepre:=compress(subtext(entrytext,1,8)),namepost:=
+compress(subtext(entrytext,9,11));IF namepost<>""THEN namepre+"."+namepost
+ELSE namepreFI .END PROC storefileentry;PROC storefileentry(FILEENTRY VAR
+fentry,TEXT CONST entrytext,DIRPOS CONST position):fentry.firstcluster:=real(
+entrytextISUB 14);fentry.dateandtime:=dosdate+" "+dostime;fentry.size:=dint(
+entrytextISUB 15,entrytextISUB 16);fentry.dirpos:=position.dosdate:day+"."+
+month+"."+year.day:text2(code(entrytextSUB 25)MOD 32).month:text2(code(
+entrytextSUB 25)DIV 32+8*(code(entrytextSUB 26)MOD 2)).year:text(80+code(
+entrytextSUB 26)DIV 2,2).dostime:hour+":"+minute.hour:text2(code(entrytext
+SUB 24)DIV 8).minute:text2(code(entrytextSUB 23)DIV 32+8*(code(entrytextSUB
+24)MOD 8)).END PROC storefileentry;TEXT PROC text2(INT CONST intvalue):IF
+intvalue<10THEN "0"+text(intvalue)ELSE text(intvalue)FI .END PROC text2;
+DIRPOS PROC fileentrypos(FILELIST CONST flist,TEXT CONST filename):INT CONST
+linkindex:=link(flist.thes,filename);IF linkindex=0THEN errorstop(
+"Die Datei """+filename+""" gibt es nicht")FI ;flist.entry[linkindex].dirpos.
+END PROC fileentrypos;PROC delete(FILELIST VAR flist,TEXT CONST filename):
+INT VAR dummy;delete(flist.thes,filename,dummy).END PROC delete;PROC fileinfo
+(FILELIST CONST flist,TEXT CONST filename,REAL VAR firstclusterno,storage):
+INT CONST linkindex:=link(flist.thes,filename);IF linkindex=0THEN errorstop(
+"Die Datei """+filename+""" gibt es nicht")FI ;firstclusterno:=flist.entry[
+linkindex].firstcluster;storage:=flist.entry[linkindex].sizeEND PROC fileinfo
+;BOOL PROC contains(FILELIST VAR flist,TEXT CONST filename):flist.thes
+CONTAINS filenameEND PROC contains;PROC list(FILE VAR f,FILELIST CONST flist)
+:INT VAR index:=0;TEXT VAR name;get(flist.thes,name,index);WHILE index>0REP
+listfile;get(flist.thes,name,index)PER .listfile:write(f,centeredname);write(
+f," ");write(f,text(flist.entry[index].size,11,0));write(f,
+" Bytes belegt ");write(f,flist.entry[index].dateandtime);write(f,
+" +++ ");write(f,text(flist.entry[index].firstcluster));line(f).
+centeredname:INT VAR pointpos:=pos(name,".");IF pointpos>0THEN namepre+"."+
+namepostELSE text(name,12)FI .namepre:text(subtext(name,1,pointpos-1),8).
+namepost:text(subtext(name,pointpos+1,pointpos+4),3).END PROC list;LET
+DIRENTRY =REAL ,DIRLIST =STRUCT (THESAURUS thes,ROW maxdirentrysDIRENTRY
+entry);PROC initdirlist(DIRLIST VAR dlist):dlist.thes:=emptythesaurus.END
+PROC initdirlist;PROC storesubdirentry(DIRLIST VAR dlist,TEXT CONST entrytext
+):INT VAR entryindex;insert(dlist.thes,subdirname,entryindex);dlist.entry[
+entryindex]:=real(entrytextISUB 14).subdirname:TEXT CONST namepre:=compress(
+subtext(entrytext,1,8)),namepost:=compress(subtext(entrytext,9,11));IF
+namepost<>""THEN namepre+"."+namepostELSE namepreFI .END PROC
+storesubdirentry;REAL PROC firstclusterofsubdir(DIRLIST CONST dlist,TEXT
+CONST name):INT CONST linkindex:=link(dlist.thes,name);IF linkindex=0THEN
+errorstop("Das Unterverzeichnis """+name+""" gibt es nicht")FI ;dlist.entry[
+linkindex].END PROC firstclusterofsubdir;BOOL PROC contains(DIRLIST CONST
+dlist,TEXT CONST subdirname):dlist.thesCONTAINS subdirnameEND PROC contains;
+PROC list(FILE VAR f,DIRLIST CONST dlist):INT VAR index:=0;TEXT VAR name;get(
+dlist.thes,name,index);WHILE index>0REP listdir;get(dlist.thes,name,index)
+PER .listdir:write(f,centeredname);write(f," <DIR>");write(f," +++ ");
+write(f,text(dlist.entry[index]));line(f).centeredname:INT VAR pointpos:=pos(
+name,".");IF pointpos>0THEN namepre+"."+namepostELSE text(name,12)FI .namepre
+:text(subtext(name,1,pointpos-1),8).namepost:text(subtext(name,pointpos+1,
+pointpos+4),3).END PROC list;LET DIR =BOUND STRUCT (FILELIST filelist,
+DIRLIST dirlist,FREELIST freelist,TEXT path);DIR VAR dir;DATASPACE VAR dirds;
+INITFLAG VAR dirdsused:=FALSE ;PROC opendir(TEXT CONST pathstring):
+initdirblockio;initdirds;dir.path:=pathstring;loadmaindir;TEXT VAR restpath:=
+pathstring;WHILE restpath<>""REP TEXT CONST subdirname:=nextsubdirname(
+restpath);loadsubdirPER .loadmaindir:initfilelist(dir.filelist);initdirlist(
+dir.dirlist);initfreelist(dir.freelist,0.0);storeendofdir(dir.freelist,dirpos
+(lastmaindirsector,15));BOOL VAR waslastdirsector:=FALSE ;REAL VAR blockno:=
+firstmaindirsector;INT VAR i;FOR iFROM 1UPTO dirsectorsREP loaddirblock(
+blockno,waslastdirsector);blocknoINCR 1.0UNTIL waslastdirsectorPER .
+firstmaindirsector:real(beginofdir).lastmaindirsector:real(beginofdir+
+dirsectors-1).loadsubdir:REAL VAR clusterno:=firstclusterofsubdir(dir.dirlist
+,subdirname);waslastdirsector:=FALSE ;initfilelist(dir.filelist);initdirlist(
+dir.dirlist);initfreelist(dir.freelist,clusterno);WHILE NOT
+islastfatchainentry(clusterno)REP loadsubdirentrysofcluster;clusterno:=
+fatentry(clusterno)UNTIL waslastdirsectorPER .loadsubdirentrysofcluster:
+storeendofdir(dir.freelist,dirpos(lastblocknoofcluster,15));blockno:=
+beginofcluster(clusterno);FOR iFROM 1UPTO sectorsperclusterREP loaddirblock(
+blockno,waslastdirsector);blocknoINCR 1.0UNTIL waslastdirsectorPER .
+lastblocknoofcluster:beginofcluster(clusterno)+real(sectorspercluster-1).END
+PROC opendir;PROC loaddirblock(REAL CONST blockno,BOOL VAR waslastblock):
+waslastblock:=FALSE ;readdirblock(blockno);INT VAR entryno;TEXT VAR entry;
+FOR entrynoFROM 0UPTO 15REP getdirentry(entry,entryno);processentryUNTIL
+waslastblockPER .processentry:SELECT pos("�.�",entrySUB 1)OF CASE 1:
+endofdirsearchCASE 2:CASE 3:freeentryOTHERWISE
+volumelabelorfileentryorsubdirentryEND SELECT .endofdirsearch:waslastblock:=
+TRUE ;storebeginoffreearea(dir.freelist,dirpos(blockno,entryno)).freeentry:
+store(dir.freelist,dirpos(blockno,entryno)).
+volumelabelorfileentryorsubdirentry:INT CONST byte11:=code(entrySUB 12);IF (
+byte11AND 8)>0THEN ELIF (byte11AND 16)>0THEN subdirentryELSE fileentryFI .
+subdirentry:storesubdirentry(dir.dirlist,entry).fileentry:storefileentry(dir.
+filelist,entry,dirpos(blockno,entryno)).END PROC loaddirblock;TEXT PROC
+nextsubdirname(TEXT VAR pathstring):TEXT VAR subdirname;IF (pathstringSUB 1)
+<>"\"THEN errorstop("ungültige Pfadbezeichnung")FI ;INT CONST backslashpos:=
+pos(pathstring,"\",2);IF backslashpos=0THEN subdirname:=subtext(pathstring,2)
+;pathstring:=""ELSE subdirname:=subtext(pathstring,2,backslashpos-1);
+pathstring:=subtext(pathstring,backslashpos)FI ;dosname(subdirname,readmodus)
+.END PROC nextsubdirname;PROC initdirds:IF initialized(dirdsused)THEN forget(
+dirds)FI ;dirds:=nilspace;dir:=dirds.END PROC initdirds;PROC insertdirentry(
+TEXT CONST name,REAL CONST startcluster,storage):DIRPOS CONST inspos:=
+freedirpos(dir.freelist);TEXT CONST entrystring:=entryname+" "+(10*"�")+
+dostime+dosdate+entrystartcluster+entrystorage;writeentryondisk;
+writeentryindirds.entryname:INT CONST pointpos:=pos(name,".");IF pointpos>0
+THEN subtext(name,1,pointpos-1)+(9-pointpos)*" "+subtext(name,pointpos+1)+(3-
+LENGTH name+pointpos)*" "ELSE name+(11-LENGTH name)*" "FI .dostime:TEXT
+CONST akttime:=timeofday(clock(1));code((minuteMOD 8)*32)+code(8*hour+minute
+DIV 8).hour:int(subtext(akttime,1,2)).minute:int(subtext(akttime,4,5)).
+dosdate:TEXT CONST aktdate:=date(clock(1));code(32*(monthMOD 8)+day)+code((
+year-80)*2+monthDIV 8).day:int(subtext(aktdate,1,2)).month:int(subtext(
+aktdate,4,5)).year:int(subtext(aktdate,7,8)).entrystartcluster:TEXT VAR
+buffer2:="12";replace(buffer2,1,lowword(startcluster));buffer2.entrystorage:
+TEXT VAR buffer4:="1234";replace(buffer4,1,lowword(storage));replace(buffer4,
+2,highword(storage));buffer4.writeentryondisk:readdirblock(blockno(inspos));
+putdirentry(entrystring,entryno(inspos));writedirblock.writeentryindirds:
+storefileentry(dir.filelist,entrystring,inspos).END PROC insertdirentry;PROC
+deletedirentry(TEXT CONST name):TEXT VAR entry;DIRPOS CONST delpos:=
+fileentrypos(dir.filelist,name);readdirblock(blockno(delpos));getdirentry(
+entry,entryno(delpos));putdirentry("�"+subtext(entry,2,32),entryno(delpos));
+writedirblock;delete(dir.filelist,name);store(dir.freelist,delpos).END PROC
+deletedirentry;PROC formatdir:initdirblockio;initdirds;buildemptydirblock;
+REAL VAR blockno:=real(beginofdir);disablestop;FOR iFROM 1UPTO dirsectorsREP
+writedirblock(blockno);blocknoINCR 1.0PER ;enablestop;dir.path:="";
+initfilelist(dir.filelist);initdirlist(dir.dirlist);initfreelist(dir.freelist
+,0.0);storebeginoffreearea(dir.freelist,dirpos(real(beginofdir),0));
+storeendofdir(dir.freelist,dirpos(lastmaindirsector,15)).buildemptydirblock:
+INT VAR i;FOR iFROM 0UPTO 15REP putdirentry(32*"�",i)PER .lastmaindirsector:
+real(beginofdir+dirsectors-1).END PROC formatdir;PROC fileinfo(TEXT CONST
+filename,REAL VAR startcluster,size):fileinfo(dir.filelist,filename,
+startcluster,size)END PROC fileinfo;THESAURUS PROC allfiles:THESAURUS VAR t:=
+dir.filelist.thes;tEND PROC allfiles;THESAURUS PROC allsubdirs:dir.dirlist.
+thesEND PROC allsubdirs;BOOL PROC fileexists(TEXT CONST filename):contains(
+dir.filelist,filename)END PROC fileexists;BOOL PROC subdirexists(TEXT CONST
+subdirname):contains(dir.dirlist,subdirname)END PROC subdirexists;PROC
+dirlist(DATASPACE VAR ds):openlistfile;headline(listfile,listfilehead);list(
+listfile,dir.filelist);list(listfile,dir.dirlist).openlistfile:forget(ds);ds
+:=nilspace;FILE VAR listfile:=sequentialfile(output,ds);putline(listfile,"").
+listfilehead:"DOS"+pathstring.pathstring:IF dir.path<>""THEN " PATH: "+
+dir.pathELSE ""FI .END PROC dirlist;END PACKET dir;
+
diff --git a/app/baisy/2.2.1-schulis/src/disk descriptor.dos b/app/baisy/2.2.1-schulis/src/disk descriptor.dos
new file mode 100644
index 0000000..5fa1ce0
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/disk descriptor.dos
@@ -0,0 +1,73 @@
+PACKET dosdiskDEFINES opendosdisk,sectorspercluster,fatcopies,dirsectors,
+mediadescriptor,fatsectors,beginoffat,fatentrys,beginofdir,beginofcluster,
+clustersize,bpbexists,writebpb,eublock,bpbdumpmodus:INITFLAG VAR
+bpbdsinitialisiert:=FALSE ;DATASPACE VAR bpbds;BOUND STRUCT (ALIGN dummy,ROW
+512INT daten)VAR bpb;BOOL VAR bpbdumpflag:=FALSE ;REAL VAR beginofdataarea;
+INT VAR sectorspertrack,heads;IF exists("shard interface")THEN
+loadshardinterfacetableFI ;TEXT CONST bpbtype254:="���"+"EUMELBPB"+"��"+"�"+
+"��"+"�"+"§�"+"§�"+"�"+"��"+"��"+"��"+"��",bpbtype255:="���"+"EUMELBPB"+"��"+
+"�"+"��"+"�"+"p�"+"��"+"�"+"��"+"��"+"��"+"��";PROC opendosdisk:enablestop;
+bpbdsanboundkoppeln;bpblesen;IF bpbungueltigTHEN versuchepseudobpbzuverwenden
+FI ;ueberpruefebpbaufgueltigkeit;globalevariableninitialisieren;IF
+bpbdumpflagTHEN dumpschreibenFI .bpbdsanboundkoppeln:IF NOT initialized(
+bpbdsinitialisiert)THEN bpbds:=nilspace;bpb:=bpbdsFI .bpblesen:INT VAR return
+;checkrerun;readblock(bpbds,2,0,return);IF return<>0THEN lesefehler(return)
+FI .bpbungueltig:INT VAR wordno;FOR wordnoFROM 6UPTO 10REP IF bpb.daten[
+wordno+1]<>bpb.daten[wordno+2]THEN LEAVE bpbungueltigWITH FALSE FI PER ;TRUE
+.versuchepseudobpbzuverwenden:lieserstenfatsektor;IF
+fatsektorgueltigundpseudobpbvorhandenTHEN pseudobpbladenELSE errorstop(
+"Format unbekannt")FI .lieserstenfatsektor:checkrerun;readblock(bpbds,2,1,
+return);IF return<>0THEN lesefehler(return)FI .
+fatsektorgueltigundpseudobpbvorhanden:TEXT VAR fatstart:="1234";replace(
+fatstart,1,bpb.daten[1]);replace(fatstart,2,bpb.daten[2]);(fatstartSUB 2)="�"
+CAND (fatstartSUB 3)="�"CAND pseudobpbvorhanden.pseudobpbvorhanden:pos("��",
+fatstartSUB 1)>0.pseudobpbladen:INT VAR i;FOR iFROM 1UPTO 15REP bpb.daten[i]
+:=bpbpufferISUB iPER .bpbpuffer:IF pseudobpbname="�"THEN bpbtype255ELSE
+bpbtype254FI .pseudobpbname:fatstartSUB 1.ueberpruefebpbaufgueltigkeit:IF
+bytespersector<>512THEN errorstop(
+"DOS Format nicht implementiert (unzulässige Sektorgröße)")FI ;IF (fatsectors
+>64)THEN errorstop("ungültige DOS Disk (BPB)")FI .
+globalevariableninitialisieren:sectorspertrack:=bpbbyte(25)*256+bpbbyte(24);
+heads:=bpbbyte(27)*256+bpbbyte(26);beginofdataarea:=real(reservedsectors+
+fatcopies*fatsectors+dirsectors).dumpschreiben:dump("Sektoren pro Cluster",
+sectorspercluster);dump("Fat Kopien ",fatcopies);dump(
+"Dir Sektoren ",dirsectors);dump("Media Descriptor ",
+mediadescriptor);dump("Sektoren pro Fat ",fatsectors);dump(
+"Fat Anfang (0) ",beginoffat(0));dump("Fat Einträge ",fatentrys);
+dump("Dir Anfang ",beginofdir).END PROC opendosdisk;PROC lesefehler(
+INT CONST fehlercode):errorstop(fehlertext).fehlertext:SELECT fehlercodeOF
+CASE 1:"Diskettenlaufwerk nicht betriebsbereit"CASE 2:"Lesefehler"OTHERWISE
+"Lesefehler "+text(fehlercode)END SELECT .END PROC lesefehler;TEXT VAR
+konvertierpuffer:="12";INT PROC bpbbyte(INT CONST byteno):replace(
+konvertierpuffer,1,bpb.daten[bytenoDIV 2+1]);code(konvertierpufferSUB
+pufferpos).pufferpos:IF evenbytenoTHEN 1ELSE 2FI .evenbyteno:(bytenoMOD 2)=0.
+END PROC bpbbyte;INT PROC bytespersector:bpbbyte(12)*256+bpbbyte(11)END PROC
+bytespersector;INT PROC sectorspercluster:bpbbyte(13)END PROC
+sectorspercluster;INT PROC reservedsectors:bpbbyte(15)*256+bpbbyte(14)END
+PROC reservedsectors;INT PROC fatcopies:bpbbyte(16)END PROC fatcopies;INT
+PROC dirsectors:direntrysDIV direntryspersector.direntrys:bpbbyte(18)*256+
+bpbbyte(17).direntryspersector:16.END PROC dirsectors;REAL PROC dossectors:
+real(bpbbyte(20))*256.0+real(bpbbyte(19))END PROC dossectors;INT PROC
+mediadescriptor:bpbbyte(21)END PROC mediadescriptor;INT PROC fatsectors:
+bpbbyte(23)*256+bpbbyte(22)END PROC fatsectors;INT PROC beginoffat(INT CONST
+fatcopyno):reservedsectors+fatcopyno*fatsectorsEND PROC beginoffat;INT PROC
+fatentrys:anzahldatencluster+2.anzahldatencluster:int((dossectors-
+tabellensektoren)/real(sectorspercluster)).tabellensektoren:real(
+reservedsectors+fatcopies*fatsectors+dirsectors).END PROC fatentrys;INT PROC
+beginofdir:reservedsectors+fatcopies*fatsectors.END PROC beginofdir;REAL
+PROC beginofcluster(REAL CONST clusterno):beginofdataarea+(clusterno-2.0)*
+real(sectorspercluster)END PROC beginofcluster;INT PROC clustersize:512*
+sectorsperclusterEND PROC clustersize;BOOL PROC bpbexists(INT CONST no):
+exists("bpb ds")AND no>0AND no<4.END PROC bpbexists;PROC writebpb(INT CONST
+no):INT VAR return;writeblock(old("bpb ds"),no+1,0,0,return);IF return<>0
+THEN errorstop("Schreibfehler")FI .END PROC writebpb;INT PROC eublock(INT
+CONST dosblockno):IF hdversionTHEN dosblocknoELSE dosblocknofloppyformatFI .
+dosblocknofloppyformat:IF pageformatTHEN head*eusectorsperhead+trac*eusectors
++sectorELSE head*eusectors+trac*abs(euheads)*eusectors+sectorFI .pageformat:
+euheads<0.sector:dosblocknoMOD sectorspertrack.trac:(dosblocknoDIV
+sectorspertrack)DIV heads.head:(dosblocknoDIV sectorspertrack)MOD heads.
+eusectorsperhead:eusectors*eutracks.eusectors:eulastsector-eufirstsector+1.
+END PROC eublock;INT PROC eublock(REAL CONST dosblockno):eublock(lowword(
+dosblockno)).END PROC eublock;PROC bpbdumpmodus(BOOL CONST status):
+bpbdumpflag:=statusEND PROC bpbdumpmodus;END PACKET dosdisk;
+
diff --git a/app/baisy/2.2.1-schulis/src/dos hd inserter b/app/baisy/2.2.1-schulis/src/dos hd inserter
new file mode 100644
index 0000000..ed8da22
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/dos hd inserter
@@ -0,0 +1,12 @@
+IF NOT singleuserTHEN do(
+"IF name (myself) <> ""DOS HD"" THEN error stop (""Bitte der Task den Namen 'DOS HD' geben und neu starten"") FI"
+);FI ;archive("dos");checkoff;commanddialogue(FALSE );fetch("insert.dos",
+archive);fetch("bpb ds",archive);IF singleuserTHEN do(PROC (TEXT CONST )gens,
+ALL "insert.dos");gens("manager/S.dos")ELSE fetch(ALL "insert.dos",archive);
+fetch("manager/M.dos",archive);release(archive);do(PROC (TEXT CONST )genm,
+ALL "insert.dos");genm("manager/M.dos");FI ;do("hd version (TRUE)");forget(
+"insert.dos",quiet);forget("dos hd inserter",quiet);IF NOT singleuserTHEN do(
+"dos manager (29)")FI .singleuser:(pcb(9)AND 255)=1.PROC genm(TEXT CONST name
+):insert(name);forget(name,quiet)END PROC genm;PROC gens(TEXT CONST t):fetch(
+t,archive);insert(t);forget(t,quiet)END PROC gens;
+
diff --git a/app/baisy/2.2.1-schulis/src/dos inserter b/app/baisy/2.2.1-schulis/src/dos inserter
new file mode 100644
index 0000000..fcf3d05
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/dos inserter
@@ -0,0 +1,15 @@
+IF NOT singleuserTHEN do(
+"IF name (myself) <> ""DOS"" THEN error stop (""Bitte der Task den Namen 'DOS' geben und neu starten"") FI"
+);FI ;archive("dos");checkoff;commanddialogue(FALSE );hol("shard interface");
+hol("bpb ds");hol("insert.dos");IF singleuserTHEN do(PROC (TEXT CONST )gens,
+ALL "insert.dos");gens("manager/S.dos")ELSE do(PROC (TEXT CONST )hol,ALL
+"insert.dos");hol("manager/M.dos");release(archive);do(PROC (TEXT CONST )genm
+,ALL "insert.dos");genm("manager/M.dos");putline(
+"jetzt mit 'dos manager' bzw. 'dos manager (channnel)' starten");FI ;do(
+"hd version (FALSE)");do("load shard interface table");forget(
+"shard interface",quiet);forget("insert.dos",quiet);forget("dos inserter",
+quiet).singleuser:(pcb(9)AND 255)=1.PROC genm(TEXT CONST name):insert(name);
+forget(name,quiet)END PROC genm;PROC gens(TEXT CONST t):hol(t);insert(t);
+forget(t,quiet)END PROC gens;PROC hol(TEXT CONST t):IF NOT exists(t)THEN
+fetch(t,archive)FI END PROC hol;
+
diff --git a/app/baisy/2.2.1-schulis/src/dump b/app/baisy/2.2.1-schulis/src/dump
new file mode 100644
index 0000000..4eb0737
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/dump
@@ -0,0 +1,12 @@
+PACKET dumpDEFINES dump:TEXT VAR ergebnis:="";PROC dump(TEXT CONST kommentar,
+dumptext):ergebnis:=kommentar;ergebnisCAT ": ";INT VAR i;FOR iFROM 1UPTO
+LENGTH dumptextREP zeichenschreibenPER ;ergebnisschreiben.zeichenschreiben:
+INT CONST charcode:=code(dumptextSUB i);IF charcode<32THEN ergebnisCAT ("$"+
+text(charcode)+"$")ELSE ergebnisCAT code(charcode)FI .END PROC dump;PROC dump
+(TEXT CONST kommentar,INT CONST dumpint):ergebnis:=kommentar;ergebnisCAT ": "
+;ergebnisCAT text(dumpint);ergebnisschreiben.END PROC dump;PROC dump(TEXT
+CONST kommentar,REAL CONST dumpreal):ergebnis:=kommentar;ergebnisCAT ": ";
+ergebnisCAT text(dumpreal);ergebnisschreiben.END PROC dump;PROC
+ergebnisschreiben:FILE VAR f:=sequentialfile(output,"logbuch");putline(f,
+ergebnis);ergebnis:="".END PROC ergebnisschreiben;END PACKET dump;
+
diff --git a/app/baisy/2.2.1-schulis/src/editorfunktionen b/app/baisy/2.2.1-schulis/src/editorfunktionen
new file mode 100644
index 0000000..495f320
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/editorfunktionen
@@ -0,0 +1,56 @@
+PACKET editorfunktionenDEFINES editiere,editierewieeingestellt,zeigedatei,
+zeigedateiwieeingestellt,indateivorblaettern,killundenter,andateianfang,
+andateiende,aufeditstack,aufeditstackundloeschen,voneditstack,
+druckendereditorhilfsdatei,editorunterlegung,loeschendereditorhilfsdatei:LET
+standardtasten="�bcqhst!19h?o",maxzeilenlaenge=78,maxzeilennr=23,
+erweiterungstasten="gpd";FILE VAR f;TEXT VAR editorhilfsdatei,editortasten;
+LET temp="temporäre Druckdatei";INT VAR basiszeile;ROW maxzeilennrTEXT VAR
+untergrundzeile;PROC zeigedateiwieeingestellt:zeigedatei(editorhilfsdatei,
+editortasten)END PROC zeigedateiwieeingestellt;PROC zeigedatei(TEXT CONST
+name,tasten):store(FALSE );f:=sequentialfile(modify,name);editorhilfsdatei:=
+name;editortasten:=tasten;openeditor(f,FALSE );edit(groesstereditor,
+standardtasten+tasten,PROC leaveeditor);INT VAR xkoord,ykoord;INT CONST
+aktlineno:=lineno(f);geteditcursor(xkoord,ykoord);basiszeile:=aktlineno-
+ykoord;store(TRUE )END PROC zeigedatei;PROC indateivorblaettern(BOOL CONST
+vorwaerts):IF vorwaertsTHEN toline(f,min(lines(f),lineno(f)+maxzeilennr))
+ELSE toline(f,max(1,lineno(f)-maxzeilennr))FI ;return(1)END PROC
+indateivorblaettern;PROC editiere(TEXT CONST name):inituntergrundzeilen;
+editieren(name,standardtasten)END PROC editiere;PROC editiere(TEXT CONST name
+,TEXT CONST tasten):inituntergrundzeilen;editieren(name,standardtasten+tasten
+)END PROC editiere;PROC editiere(TEXT CONST name,BOOL CONST standard):
+inituntergrundzeilen;IF standardTHEN editiere(name)ELSE editiere(name,
+erweiterungstasten)FI END PROC editiere;PROC editiere(TEXT CONST name,TEXT
+CONST tasten,BOOL CONST standard):inituntergrundzeilen;IF standardTHEN
+editiere(name,tasten)ELSE editiere(name,erweiterungstasten+tasten)FI END
+PROC editiere;PROC editierewieeingestellt:editieren(editorhilfsdatei,
+editortasten)END PROC editierewieeingestellt;PROC editieren(TEXT CONST name,
+TEXT CONST tasten):store(FALSE );f:=sequentialfile(modify,name);
+editorhilfsdatei:=name;editortasten:=tasten;edit(f,tasten,PROC leaveeditor);
+INT VAR xkoord,ykoord;INT CONST aktlineno:=lineno(f);geteditcursor(xkoord,
+ykoord);basiszeile:=aktlineno-ykoord;store(TRUE )END PROC editieren;PROC
+leaveeditor(TEXT CONST t):IF pos("19"+erweiterungstasten,t)>0THEN
+stdkommandointerpreter(t)ELSE seteingabe(t);quitFI END PROC leaveeditor;PROC
+killundenter(INT CONST steps):forget(editorhilfsdatei,quiet);enter(steps)END
+PROC killundenter;PROC andateianfang:toline(f,1);return(1)END PROC
+andateianfang;PROC andateiende:toline(f,lines(f));return(1)END PROC
+andateiende;PROC aufeditstackundloeschen:type("�p"+"�q");edit(f);return(1)
+END PROC aufeditstackundloeschen;PROC aufeditstack:type("�d"+"�q");edit(f);
+return(1)END PROC aufeditstack;PROC voneditstack:type("�g"+"�q");edit(f);
+return(1)END PROC voneditstack;PROC loeschendereditorhilfsdatei:forget(
+editorhilfsdatei,quiet);enter(2)END PROC loeschendereditorhilfsdatei;PROC
+druckendereditorhilfsdatei:FILE VAR datei;forget(temp,quiet);copy(
+editorhilfsdatei,temp);datei:=sequentialfile(modify,temp);tofirstrecord(datei
+);INT VAR i;FOR iFROM 1UPTO 5REP insertrecord(datei)PER ;tofirstrecord(datei)
+;TEXT VAR satz:="Stand: "+date+" "+timeofday;writerecord(datei,satz);
+satz:="Dateiname: "+editorhilfsdatei;toline(datei,2);writerecord(datei,
+satz);print(temp);forget(temp,quiet);return(1)END PROC
+druckendereditorhilfsdatei;PROC inituntergrundzeilen:INT VAR zeilennr;FOR
+zeilennrFROM 1UPTO maxzeilennrREP untergrundzeile(zeilennr):=""PER END PROC
+inituntergrundzeilen;TEXT PROC editorunterlegung(INT CONST i):IF i=1THEN
+blankzeileELSE IF schondaTHEN diesezeileELSE neuezeileFI FI .blankzeile:
+maxzeilenlaenge*" ".schonda:TEXT VAR diesezeile:=untergrundzeile(i-1);
+diesezeile<>"".neuezeile:TEXT VAR nzeile:="";toline(f,basiszeile+i);
+readrecord(f,nzeile);IF nzeile=""THEN nzeile:=blankzeileFI ;untergrundzeile(i
+-1):=nzeile;toline(f,basiszeile);nzeile.END PROC editorunterlegung;END
+PACKET editorfunktionen;
+
diff --git a/app/baisy/2.2.1-schulis/src/erf.auskuenfte b/app/baisy/2.2.1-schulis/src/erf.auskuenfte
new file mode 100644
index 0000000..f838768
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/erf.auskuenfte
@@ -0,0 +1,66 @@
+PACKET erfauskuenfteDEFINES erfassungauskuenfte,sicherungauskunftsname,
+sicherungauskunftstext,zwischenspeicherungdestextes:LET maskenname=
+"mb erf auskuenfte",fnrletztesfeld=5,fnrschluessel=2,fnrmaskenname=3,
+fnrmaskenfeldnr=4,fnrschluesselverzeichnis=5,trenner=" = ",leer="";TEXT VAR
+auskmaskenname,auskunftsname:="",auskunftstext:="",sicherungdestextes:="";
+INT VAR dateinummer:=0;TAG VAR auskmaske;PROC erfassungauskuenfte(INT CONST
+proznr):systemdbon;SELECT proznrOF CASE 1:setzeerfassungsparameterCASE 2:
+zeigeschluesselzurbearbeitungCASE 3:pruefeplausibilitaetCASE 4:
+setzewertefuerdbspeicherungCASE 5:setzeidentiobjektfuerobjektlisteCASE 6:
+auskunftlesenCASE 7:auskunftaendernCASE 8:auskunfteinfuegenCASE 9:
+auskunftloeschenENDSELECT ;END PROC erfassungauskuenfte;PROC
+setzeerfassungsparameter:dateinummer:=dnrausk;setzeerfassungsparameter(
+dateinummer,maskenname,fnrletztesfeld)END PROC setzeerfassungsparameter;PROC
+zeigeschluesselzurbearbeitung:setzeerfassungsfeld("",fnrmaskenname);
+setzeerfassungsfeld("",fnrmaskenfeldnr);setzeerfassungsfeld(wert(fnrschlverz)
+,fnrschluesselverzeichnis)END PROC zeigeschluesselzurbearbeitung;PROC
+pruefeplausibilitaet:LET leer="",meldungmaskegibtsnicht=8;INT VAR
+fehlerstatus;pruefe(2,erfassungsmaske,TEXT PROC (INT CONST )erfassungswert,
+fnrschluessel,1,32000,leer,fehlerstatus);IF fehlerstatus<>0THEN
+setzefehlerstatus(fehlerstatus);LEAVE pruefeplausibilitaetFI ;auskmaskenname
+:=erfassungswert(fnrmaskenname);IF auskunftsmaskennameangegebenTHEN IF
+maskegibtes(auskmaskenname)THEN holemaske;ELSE setzefehlerstatus(
+fnrmaskenname);melde(erfassungsmaske,meldungmaskegibtsnicht);LEAVE
+pruefeplausibilitaetFI ;FI .auskunftsmaskennameangegeben:auskmaskenname<>"".
+holemaske:initmaske(auskmaske,auskmaskenname).END PROC pruefeplausibilitaet;
+PROC setzewertefuerdbspeicherung:IF sicherungdestextes=""THEN putwert(
+fnrauskunftstext,auskunftstext)ELSE restoretupel(dnrausk,sicherungdestextes);
+FI ;putwert(fnrauskunftsname,erfassungswert(fnrschluessel));putwert(
+fnrschlverz,erfassungswert(fnrschluesselverzeichnis));END PROC
+setzewertefuerdbspeicherung;PROC setzeidentiobjektfuerobjektliste:LET
+trennsymbolfuerobli="$";TEXT VAR identizeile:="";identizeile:=wert(
+fnrauskunftsname)+trenner;identizeileCAT wert(fnrauskunftstext);INT VAR
+feldlaenge:=maxidentizeilenlaenge;setzeidentiwert(
+identizeilemitschluesselanhang).identizeilemaxlang:subtext(identizeile,1,
+feldlaenge,"�","�",TRUE ).identizeilemitschluesselanhang:identizeilemaxlang+
+trennsymbolfuerobli+wert(fnrauskunftsname).END PROC
+setzeidentiobjektfuerobjektliste;PROC auskunftlesen:INT VAR fehlerstatus;
+pruefe(2,erfassungsmaske,TEXT PROC (INT CONST )erfassungswert,fnrschluessel,1
+,32000,leer,fehlerstatus);IF fehlerstatus=0THEN inittupel(dnrausk);putwert(
+fnrauskunftsname,erfassungswert(fnrschluessel));search(dnrausk,TRUE );IF
+dbstatus=okTHEN saveupdateposition(dnrausk)FI ;auskunftstext:=wert(
+fnrauskunftstext);auskunftsname:=erfassungswert(fnrschluessel);ELSE dbstatus(
+notfound)FI ENDPROC auskunftlesen;TEXT PROC sicherungauskunftsname:
+auskunftsnameENDPROC sicherungauskunftsname;TEXT PROC sicherungauskunftstext:
+auskunftstextENDPROC sicherungauskunftstext;PROC zwischenspeicherungdestextes
+(TEXT CONST text):putwert(fnrauskunftstext,text);savetupel(dnrausk,
+sicherungdestextes)ENDPROC zwischenspeicherungdestextes;PROC auskunftaendern:
+restoreupdateposition(dnrausk);update(dnrausk);logbucheintrag("geändert");
+sicherungdestextes:="";IF dbstatus=okAND auskmaskenname<>""THEN
+auskunftanmaskeanknuepfenFI END PROC auskunftaendern;PROC auskunfteinfuegen:
+insert(dnrausk);logbucheintrag("eingefügt");IF dbstatus=okAND auskmaskenname
+<>""THEN auskunftanmaskeanknuepfenFI ;sicherungdestextes:="";END PROC
+auskunfteinfuegen;PROC auskunftloeschen:delete(dnrausk);logbucheintrag(
+"gelöscht");sicherungdestextes:="";END PROC auskunftloeschen;PROC
+logbucheintrag(TEXT CONST logergaenzung):TEXT VAR eintrag:="Auskunft ";
+eintragCAT schluessel;eintragCAT " ";eintragCAT logergaenzung;logeintrag(
+eintrag)END PROC logbucheintrag;TEXT PROC schluessel:erfassungswert(
+fnrschluessel)END PROC schluessel;PROC auskunftanmaskeanknuepfen:INT VAR ug:=
+int(subtext(erfassungswert(fnrmaskenfeldnr),1,3)),og:=int(subtext(
+erfassungswert(fnrmaskenfeldnr),4,6)),ab:=int(subtext(erfassungswert(
+fnrmaskenfeldnr),7,8));INT VAR ifnr;IF og=0THEN og:=ug;ab:=1ELSE IF ab=0THEN
+ab:=1FI ;FI ;ifnr:=ug;WHILE ifnr<=ogREP IF fieldexists(auskmaske,ifnr)THEN
+auskunftsnr(auskmaske,ifnr,int(schluessel))FI ;ifnrINCR abPER ;setzemaske(
+auskmaske);maskespeichern(auskmaskenname);END PROC auskunftanmaskeanknuepfen;
+END PACKET erfauskuenfte
+
diff --git a/app/baisy/2.2.1-schulis/src/eu disk descriptor b/app/baisy/2.2.1-schulis/src/eu disk descriptor
new file mode 100644
index 0000000..50f2b7d
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/eu disk descriptor
@@ -0,0 +1,26 @@
+PACKET eudiskDEFINES loadshardinterfacetable,openeudisk,eusize,euheads,
+eutracks,eufirstsector,eulastsector:LET tablelength=15,sizefield=1,headfield=
+2,trackfield=3,firstsectorfield=4,lastsectorfield=5;ROW tablelengthROW 5INT
+VAR formattable;INT VAR tabletop:=0,tablepointer;PROC openeudisk:enablestop;
+initcheckrerun;IF hdversionTHEN LEAVE openeudiskFI ;INT CONST blocks:=
+archiveblocks;IF blocks<=0THEN errorstop("keine Diskette eingelegt")FI ;
+searchformattableentry.searchformattableentry:IF tabletop<1THEN errorstop(
+"SHard-Interfacetabelle nicht geladen")FI ;tablepointer:=1;WHILE formattable[
+tablepointer][sizefield]<>blocksREP tablepointerINCR 1;IF tablepointer>
+tabletopTHEN errorstop("Diskettenformat nicht implementiert")FI PER .END
+PROC openeudisk;PROC loadshardinterfacetable:FILE VAR f:=sequentialfile(input
+,"shard interface");TEXT VAR line;tabletop:=0;WHILE NOT eof(f)REP getline(f,
+line);IF (lineSUB 1)<>";"THEN loadlineFI PER .loadline:tabletopINCR 1;IF
+tabletop>tablelengthTHEN errorstop("Shard Interface Tabelle zu groß")FI ;INT
+VAR blankpos:=1;formattable[tabletop][sizefield]:=nextint;formattable[
+tabletop][headfield]:=nextint;formattable[tabletop][trackfield]:=nextint;
+formattable[tabletop][firstsectorfield]:=nextint;formattable[tabletop][
+lastsectorfield]:=nextint.nextint:line:=compress(subtext(line,blankpos))+" ";
+blankpos:=pos(line," ");int(subtext(line,1,blankpos-1)).END PROC
+loadshardinterfacetable;INT PROC eusize:formattable[tablepointer][sizefield]
+END PROC eusize;INT PROC euheads:formattable[tablepointer][headfield]END
+PROC euheads;INT PROC eutracks:formattable[tablepointer][trackfield]END PROC
+eutracks;INT PROC eufirstsector:formattable[tablepointer][firstsectorfield]
+END PROC eufirstsector;INT PROC eulastsector:formattable[tablepointer][
+lastsectorfield]END PROC eulastsector;END PACKET eudisk;
+
diff --git a/app/baisy/2.2.1-schulis/src/f packet.sc b/app/baisy/2.2.1-schulis/src/f packet.sc
new file mode 100644
index 0000000..b9c3e15
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/f packet.sc
@@ -0,0 +1,9 @@
+ PACKETfpacket DEFINESfetchfast,savefast: LETuuuuuv=50,uuuuuw=51,uuuuux=47,uuuuuy=66,uuuuuz=0,uuuuvu=1; INT VARuuuuvv; DATASPACE VARuuuuvw; BOUND TEXT VARuuuuvx; TASK
+ VARuuuuvy; TEXT VARuuuuvz:=""; PROCfetchfast( TEXT CONSTuuuuwv): TASK VARuuuuww;uuuuvy:=/uuuuwv;forget(uuuuvw);uuuuvw:=nilspace;call(/uuuuwv,uuuuux,uuuuvw,uuuuvv
+); IFuuuuvv=uuuuuz THENuuuuyv FI.uuuuyv: REPforget(uuuuvw);wait(uuuuvw,uuuuvv,uuuuww); SELECTuuuuvv OF CASEuuuuuv:uuuuvx:=uuuuvw;uuuuvz:=uuuuvx;uuuvuv CASEuuuuuw:
+forget(uuuuvz,quiet);copy(uuuuvw,uuuuvz);uuuvuv OTHERWISE:uuuvvv ENDSELECT PER.uuuvvv: IFuuuuww=uuuuvy CANDuuuuvv=uuuuuy THEN LEAVEuuuuyv ELSEuuuvww FI.uuuvww:send
+(uuuuww,uuuuvu,uuuuvw).uuuvuv:send(uuuuww,uuuuuz,uuuuvw). ENDPROCfetchfast; PROCsavefast( TASK CONSTuuuvyv): THESAURUS VARuuuvyw:= ALLmyself; INT VARuuuvyx;uuuvyy
+;uuuvyz;uuuvzu.uuuvyy:forget(uuuuvw);uuuuvw:=nilspace;send(uuuvyv,uuuuuz,uuuuvw).uuuvyz:uuuvyx:=0;get(uuuvyw,uuuuvz,uuuvyx); WHILEuuuvyx>0 REPuuuwvv;get(uuuvyw,uuuuvz
+,uuuvyx) PER;.uuuwvv:uuuwwu;uuuwwv.uuuwwu:forget(uuuuvw);uuuuvw:=nilspace;uuuuvx:=uuuuvw;uuuuvx:=uuuuvz;call(uuuvyv,uuuuuv,uuuuvw,uuuuvv).uuuwwv:forget(uuuuvw);uuuuvw
+:=old(uuuuvz);call(uuuvyv,uuuuuw,uuuuvw,uuuuvv).uuuvzu:forget(uuuuvw);uuuuvw:=nilspace;send(uuuvyv,uuuuuy,uuuuvw). ENDPROCsavefast; ENDPACKETfpacket;
+
diff --git a/app/baisy/2.2.1-schulis/src/fat.dos b/app/baisy/2.2.1-schulis/src/fat.dos
new file mode 100644
index 0000000..79129b9
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/fat.dos
@@ -0,0 +1,82 @@
+PACKET dosfatDEFINES readfat,writefat,firstfatblockok,clearfatds,formatfat,
+fatentry,lastfatchainentry,islastfatchainentry,erasefatchain,
+availablefatentry:LET fatsize=16384,maxanzahlfatsektoren=64;LET FAT =BOUND
+STRUCT (ALIGN dummy,ROW 256INT blockrow,ROW fatsizeINT fatrow);DATASPACE VAR
+fatds;INITFLAG VAR fatdsused:=FALSE ;FAT VAR fatstruktur;.fat:fatstruktur.
+fatrow.REAL VAR erstermoeglicherfreiereintrag;BOOL VAR kleinesfatformat;PROC
+readfat:fatdsinitialisieren;fatbloeckelesen;fatformatbestimmen;
+erstermoeglicherfreiereintrag:=2.0.fatdsinitialisieren:clearfatds;fatstruktur
+:=fatds.fatbloeckelesen:LET keintestblock=FALSE ;INT VAR blockno;FOR blockno
+FROM 0UPTO fatsectors-1REP fatblocklesen(blockno,keintestblock)PER .
+fatformatbestimmen:IF fatentrys<=4086THEN kleinesfatformat:=TRUE ELSE
+kleinesfatformat:=FALSE FI .END PROC readfat;PROC writefat:disablestop;INT
+VAR blocknr;FOR blocknrFROM 0UPTO fatsectors-1REP fatblockschreiben(blocknr)
+PER .END PROC writefat;BOOL PROC firstfatblockok:enablestop;LET testblock=
+TRUE ;fatblocklesen(0,testblock);INT VAR i;FOR iFROM 1UPTO 256REP
+vergleichewoerterPER ;TRUE .vergleichewoerter:IF fat[i]<>fatstruktur.blockrow
+[i]THEN LEAVE firstfatblockokWITH FALSE FI .END PROC firstfatblockok;PROC
+clearfatds:IF initialized(fatdsused)THEN forget(fatds)FI ;fatds:=nilspace.
+END PROC clearfatds;PROC formatfat:fatdsinitialisieren;fatformatbestimmen;
+erstermoeglicherfreiereintrag:=2.0;writefirstfourfatbytes;writeotherfatbytes;
+vermerkeschreibzugriffe;writefat.fatdsinitialisieren:clearfatds;fatstruktur:=
+fatds.fatformatbestimmen:IF fatentrys<=4086THEN kleinesfatformat:=TRUE ELSE
+kleinesfatformat:=FALSE FI .writefirstfourfatbytes:fat[1]:=word(
+mediadescriptor,255);IF kleinesfatformatTHEN fat[2]:=word(255,0)ELSE fat[2]:=
+word(255,255)FI .writeotherfatbytes:INT VAR i;FOR iFROM 3UPTO 256*fatsectors
+REP fat[i]:=0PER .vermerkeschreibzugriffe:FOR iFROM 0UPTO fatsectors-1REP
+schreibzugriff(i)PER .END PROC formatfat;REAL PROC fatentry(REAL CONST
+realentryno):INT CONST entryno:=int(realentryno);IF kleinesfatformatTHEN
+construct12bitvalueELSE dint(fat[entryno+1],0)FI .construct12bitvalue:INT
+CONST firstbyteno:=entryno+entrynoDIV 2;IF entrynoMOD 2=0THEN real((rightbyte
+MOD 16)*256+leftbyte)ELSE real(rightbyte*16+leftbyteDIV 16)FI .leftbyte:
+fatbyte(firstbyteno).rightbyte:fatbyte(firstbyteno+1).END PROC fatentry;TEXT
+VAR convertbuffer:="12";INT PROC fatbyte(INT CONST no):replace(convertbuffer,
+1,word);IF evenbytenoTHEN code(convertbufferSUB 1)ELSE code(convertbufferSUB
+2)FI .evenbyteno:noMOD 2=0.word:fat[noDIV 2+1].END PROC fatbyte;PROC fatentry
+(REAL CONST realentryno,realvalue):INT CONST entryno:=int(realentryno),value
+:=lowword(realvalue);IF kleinesfatformatTHEN write12bitvalueELSE fat[entryno+
+1]:=value;schreibzugriff(entrynoDIV 256)FI ;updatefirstpossibleavailableentry
+.write12bitvalue:INT CONST firstbyteno:=entryno+entrynoDIV 2;schreibzugriff(
+fatblockoffirstbyte);schreibzugriff(fatblockofsecondbyte);writevalue.
+fatblockoffirstbyte:firstbytenoDIV 512.fatblockofsecondbyte:secondbytenoDIV
+512.writevalue:IF evenentrynoTHEN writefatbyte(firstbyteno,valueMOD 256);
+writefatbyte(secondbyteno,(rightbyteDIV 16)*16+valueDIV 256)ELSE writefatbyte
+(firstbyteno,(leftbyteMOD 16)+16*(valueMOD 16));writefatbyte(secondbyteno,
+valueDIV 16)FI .evenentryno:entrynoMOD 2=0.secondbyteno:firstbyteno+1.
+leftbyte:fatbyte(firstbyteno).rightbyte:fatbyte(secondbyteno).
+updatefirstpossibleavailableentry:IF value=0THEN
+erstermoeglicherfreiereintrag:=min(erstermoeglicherfreiereintrag,realentryno)
+FI .END PROC fatentry;PROC writefatbyte(INT CONST byteno,newvalue):
+readoldword;changebyte;writenewword.readoldword:replace(convertbuffer,1,word)
+.writenewword:word:=convertbufferISUB 1.word:fat[bytenoDIV 2+1].changebyte:
+replace(convertbuffer,bytepos,code(newvalue)).bytepos:bytenoMOD 2+1.END PROC
+writefatbyte;REAL PROC lastfatchainentry:IF kleinesfatformatTHEN 4088.0ELSE
+65528.0FI .END PROC lastfatchainentry;BOOL PROC islastfatchainentry(REAL
+CONST value):value>=lastfatchainentryEND PROC islastfatchainentry;PROC
+erasefatchain(REAL CONST firstentryno):REAL VAR nextentryno:=firstentryno,
+actentryno:=0.0;WHILE nextentryexistsREP actentryno:=nextentryno;nextentryno
+:=fatentry(actentryno);fatentry(actentryno,0.0)PER .nextentryexists:NOT
+islastfatchainentry(nextentryno).END PROC erasefatchain;REAL PROC
+availablefatentry:INT VAR i;REAL VAR reali:=erstermoeglicherfreiereintrag;
+FOR iFROM int(erstermoeglicherfreiereintrag)UPTO fatentrys-1REP IF fatentry(
+reali)=0.0THEN erstermoeglicherfreiereintrag:=reali;LEAVE availablefatentry
+WITH erstermoeglicherfreiereintragFI ;realiINCR 1.0PER ;closework;errorstop(
+"MS-DOS Datentraeger voll");1.0e99.END PROC availablefatentry;PROC
+fatblocklesen(INT CONST blocknr,BOOL CONST testblock):disablestop;IF NOT
+testblockTHEN keinschreibzugriff(blocknr)FI ;INT VAR kopienr;FOR kopienrFROM
+0UPTO fatcopies-1REP clearerror;readdiskblock(fatds,dsseitennr,diskblocknr)
+UNTIL NOT iserrorPER ;IF iserrorTHEN closeworkFI .dsseitennr:IF testblock
+THEN 2ELSE blocknr+2+1FI .diskblocknr:beginoffat(kopienr)+blocknr.END PROC
+fatblocklesen;PROC fatblockschreiben(INT CONST blocknr):IF warschreibzugriff(
+blocknr)THEN wirklichschreibenFI .wirklichschreiben:disablestop;INT VAR
+kopienr;FOR kopienrFROM 0UPTO fatcopies-1REP
+writediskblockandcloseworkiferror(fatds,dsseitennr,diskblocknr)PER ;
+keinschreibzugriff(blocknr).dsseitennr:blocknr+2+1.diskblocknr:beginoffat(
+kopienr)+blocknr.END PROC fatblockschreiben;ROW maxanzahlfatsektorenBOOL VAR
+schreibzugrifftabelle;PROC schreibzugriff(INT CONST fatsektor):
+schreibzugrifftabelle[fatsektor+1]:=TRUE END PROC schreibzugriff;PROC
+keinschreibzugriff(INT CONST fatsektor):schreibzugrifftabelle[fatsektor+1]:=
+FALSE END PROC keinschreibzugriff;BOOL PROC warschreibzugriff(INT CONST
+fatsektor):schreibzugrifftabelle[fatsektor+1]END PROC warschreibzugriff;END
+PACKET dosfat;
+
diff --git a/app/baisy/2.2.1-schulis/src/fetch b/app/baisy/2.2.1-schulis/src/fetch
new file mode 100644
index 0000000..3b91788
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/fetch
@@ -0,0 +1,108 @@
+PACKET fetchDEFINES fetch,checkfile:LET ascii=1,asciigerman=2,transparent=3,
+rowtext=5,ds=6,dump=7,atarist=10,ibm=11,minlineendchar="
+",maxlineendchar=" "
+,lf="
+",cr=" ",tabcode=9,lfcode=10,ffcode=12,crcode=13,ctrlz="�",pagecmd=
+"#page#",rowtextlength=4000,rowtexttype=1000;BOUND STRUCT (INT size,ROW
+rowtextlengthTEXT clusterrow)VAR clusterstruct;FILE VAR file;TEXT VAR buffer;
+INT VAR bufferlength;PROC fetch(TEXT CONST name,DATASPACE VAR fileds,INT
+CONST mode):SELECT modeOF CASE ascii,asciigerman,atarist,ibm,transparent:
+fetchfilemode(fileds,name,mode)CASE rowtext:fetchrowtextmode(fileds,name)
+CASE ds:fetchdsmode(fileds,name)CASE dump:fetchdumpmode(fileds,name)
+OTHERWISE errorstop("Unzulässige Betriebsart")END SELECT .END PROC fetch;
+PROC fetchfilemode(DATASPACE VAR filespace,TEXT CONST name,INT CONST codetype
+):enablestop;initializefetchfilemode;openfetchdosfile(name);WHILE NOT
+waslastfetchclusterREP gettextofcluster;writelines;IF lines(file)>3900THEN
+putline(file,">>> FREMDDATEI FUER EUMEL ZU LANG. ES KÖNNEN DATEN FEHLEN <<<")
+;LEAVE fetchfilemodeFI ;UNTIL fileendviactrlzPER ;writelastlineifnecessary;
+closefetchdosfile.initializefetchfilemode:buffer:="";bufferlength:=0;forget(
+filespace);filespace:=nilspace;file:=sequentialfile(output,filespace);BOOL
+VAR fileendviactrlz:=FALSE .gettextofcluster:catnextfetchdoscluster(buffer);
+IF asciicodeTHEN ctrlzisbufferendFI ;adaptcode(buffer,bufferlength+1,codetype
+);bufferlength:=length(buffer).asciicode:(codetype=ascii)OR (codetype=
+asciigerman).ctrlzisbufferend:INT CONST ctrlzpos:=pos(buffer,ctrlz,
+bufferlength+1);fileendviactrlz:=ctrlzpos>0;IF fileendviactrlzTHEN buffer:=
+subtext(buffer,1,ctrlzpos-1);bufferlength:=length(buffer)FI .writelines:INT
+VAR linebeginpos:=1,lineendpos;computelineendpos;WHILE lineendpos>0REP
+putline(file,subtext(buffer,linebeginpos,lineendpos));exec(PROC (TEXT CONST ,
+INT CONST )controlcharconversion,file,codetype);linebeginpos:=lineendpos+1;
+computelineendposPER ;buffer:=subtext(buffer,linebeginpos);bufferlength:=
+length(buffer);IF bufferlength>5000THEN putline(file,buffer);exec(PROC (TEXT
+CONST ,INT CONST )controlcharconversion,file,codetype);buffer:="";
+bufferlength:=0FI .computelineendpos:lineendpos:=linebeginpos;REP lineendpos
+:=pos(buffer,minlineendchar,maxlineendchar,lineendpos);INT CONST lineendcode
+:=code(bufferSUB lineendpos);SELECT lineendcodeOF CASE lfcode:lookforcrCASE
+11:lineendposINCR 1CASE crcode:lookforlfEND SELECT UNTIL lineendcode<>11PER .
+lookforcr:IF lineendpos=bufferlengthTHEN lineendpos:=0ELIF (bufferSUB
+lineendpos+1)=crTHEN lineendposINCR 1FI .lookforlf:IF lineendpos=bufferlength
+THEN lineendpos:=0ELIF (bufferSUB lineendpos+1)=lfTHEN lineendposINCR 1FI .
+writelastlineifnecessary:IF bufferlength>0THEN putline(file,buffer);exec(
+PROC (TEXT CONST ,INT CONST )controlcharconversion,file,codetype);FI .END
+PROC fetchfilemode;PROC adaptcode(TEXT VAR textbuffer,INT CONST startpos,
+codetype):SELECT codetypeOF CASE ascii:cancelbit8CASE asciigerman:cancelbit8;
+asciigermanadaptionCASE atarist:ataristadaptionCASE ibm:ibmadaptionEND
+SELECT .cancelbit8:INT VAR setpos:=pos(textbuffer,"�","�",startpos);WHILE
+setpos>0REP replace(textbuffer,setpos,sevenbitchar);setpos:=pos(textbuffer,
+"�","�",setpos+1)PER .sevenbitchar:code(code(textbufferSUB setpos)AND 127).
+asciigermanadaption:changeallbyreplace(textbuffer,startpos,"[","Ä");
+changeallbyreplace(textbuffer,startpos,"\","Ö");changeallbyreplace(textbuffer
+,startpos,"]","Ü");changeallbyreplace(textbuffer,startpos,"{","ä");
+changeallbyreplace(textbuffer,startpos,"|","ö");changeallbyreplace(textbuffer
+,startpos,"}","ü");changeallbyreplace(textbuffer,startpos,"~","ß").
+ataristadaption:changeallbyreplace(textbuffer,startpos,"Ξ","Ä");
+changeallbyreplace(textbuffer,startpos,"�","Ö");changeallbyreplace(textbuffer
+,startpos,"�","Ü");changeallbyreplace(textbuffer,startpos,"Δ","ä");
+changeallbyreplace(textbuffer,startpos,"Υ","ö");changeallbyreplace(textbuffer
+,startpos,"Α","ü");changeallbyreplace(textbuffer,startpos,"�","ß").
+ibmadaption:changeallbyreplace(textbuffer,startpos,"Ξ","Ä");
+changeallbyreplace(textbuffer,startpos,"�","Ö");changeallbyreplace(textbuffer
+,startpos,"�","Ü");changeallbyreplace(textbuffer,startpos,"Δ","ä");
+changeallbyreplace(textbuffer,startpos,"Υ","ö");changeallbyreplace(textbuffer
+,startpos,"Α","ü");changeallbyreplace(textbuffer,startpos,"�","ß").END PROC
+adaptcode;PROC changeallbyreplace(TEXT VAR string,INT CONST beginpos,TEXT
+CONST old,new):INT VAR p:=pos(string,old,beginpos);WHILE p>0REP replace(
+string,p,new);p:=pos(string,old,p+1)PER .END PROC changeallbyreplace;PROC
+controlcharconversion(TEXT VAR string,INT CONST codetype):IF codetype<>
+transparentTHEN codeconversionFI .codeconversion:INT VAR p:=pos(string,"�",
+"�",1);WHILE p>0REP convertchar;p:=pos(string,"�","�",p)PER .convertchar:INT
+CONST charcode:=code(stringSUB p);SELECT charcodeOF CASE tabcode:expandtab
+CASE lfcode:change(string,p,p,"")CASE ffcode:change(string,p,p,pagecmd)CASE
+crcode:change(string,p,p,"")OTHERWISE ersatzdarstellungEND SELECT .expandtab:
+change(string,p,p,(8-(p-1)MOD 8)*" ").ersatzdarstellung:TEXT CONST t:=text(
+charcode);change(string,p,p,"#"+(3-length(t))*"0"+t+"#").END PROC
+controlcharconversion;PROC fetchrowtextmode(DATASPACE VAR filespace,TEXT
+CONST name):enablestop;openfetchdosfile(name);initializefetchrowtextmode;
+WHILE NOT waslastfetchclusterREP clusterstruct.sizeINCR 1;clusterstruct.
+clusterrow[clusterstruct.size]:="";catnextfetchdoscluster(clusterstruct.
+clusterrow[clusterstruct.size])PER ;closefetchdosfile.
+initializefetchrowtextmode:forget(filespace);filespace:=nilspace;
+clusterstruct:=filespace;type(filespace,rowtexttype);clusterstruct.size:=0.
+END PROC fetchrowtextmode;PROC fetchdsmode(DATASPACE VAR inds,TEXT CONST name
+):enablestop;openfetchdosfile(name);initfetchdsmode;WHILE NOT
+waslastfetchclusterREP readnextfetchdoscluster(inds,dsblockno);PER ;
+closefetchdosfile.initfetchdsmode:forget(inds);inds:=nilspace;INT VAR
+dsblockno:=2.END PROC fetchdsmode;PROC fetchdumpmode(DATASPACE VAR filespace,
+TEXT CONST name):enablestop;openfetchdosfile(name);initializefetchdumpmode;
+WHILE NOT waslastfetchclusterREP TEXT VAR clusterbuffer:="";
+catnextfetchdoscluster(clusterbuffer);dumpclusterUNTIL offset>50000.0PER ;
+closefetchdosfile.initializefetchdumpmode:BOOL VAR fertig:=FALSE ;REAL VAR
+offset:=0.0;forget(filespace);filespace:=nilspace;file:=sequentialfile(output
+,filespace).dumpcluster:TEXT VAR dumpline;INT VAR line,column;FOR lineFROM 0
+UPTO (clustersizeDIV 16)-1REP builddumpline;putline(file,dumpline);offset
+INCR 16.0UNTIL fertigPER .builddumpline:TEXT VAR charline:="";dumpline:=text(
+offset,6,0);dumpline:=subtext(dumpline,1,5);dumplineCAT " ";FOR columnFROM
+0UPTO 7REP convertchar;dumplineCAT " "PER ;dumplineCAT " ";FOR columnFROM 8
+UPTO 15REP convertchar;dumplineCAT " "PER ;dumplineCAT " ";dumplineCAT
+charline.convertchar:TEXT CONST char:=clusterbufferSUB (line*16+column+1);IF
+char=""THEN fertig:=TRUE ;dumplineCAT " ";LEAVE convertcharFI ;INT CONST
+charcode:=code(char);LET hexchars="0123456789ABCDEF";dumplineCAT (hexchars
+SUB (charcodeDIV 16+1));dumplineCAT (hexcharsSUB (charcodeMOD 16+1));charline
+CAT showchar.showchar:IF (charcode>31AND charcode<127)THEN charELSE "."FI .
+END PROC fetchdumpmode;PROC checkfile(TEXT CONST name):disablestop;DATASPACE
+VAR testds:=nilspace;enablecheckfile(name,testds);forget(testds);IF iserror
+THEN clearerror;errorstop("Fehler beim Prüflesen der Datei """+name+"""")FI .
+END PROC checkfile;PROC enablecheckfile(TEXT CONST name,DATASPACE VAR testds)
+:enablestop;openfetchdosfile(name);WHILE NOT waslastfetchclusterREP INT VAR
+dummy:=2;readnextfetchdoscluster(testds,dummy)PER ;closefetchdosfile.END
+PROC enablecheckfile;END PACKET fetch;
+
diff --git a/app/baisy/2.2.1-schulis/src/fetch save interface b/app/baisy/2.2.1-schulis/src/fetch save interface
new file mode 100644
index 0000000..24abb49
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/fetch save interface
@@ -0,0 +1,16 @@
+PACKET fetchsaveDEFINES savefetchmode,path:LET ascii=1,asciigerman=2,
+transparent=3,rowtext=5,ds=6,dump=7,atarist=10,ibm=11;INT PROC savefetchmode(
+TEXT CONST reservestring):TEXT VAR modus;INT CONST p:=pos(reservestring,":");
+IF p=0THEN modus:=reservestringELSE modus:=subtext(reservestring,1,p-1)FI ;
+modusnormieren;IF modus="FILEASCII"THEN asciiELIF modus="FILEASCIIGERMAN"
+THEN asciigermanELIF modus="FILEATARIST"THEN ataristELIF modus="FILEIBM"THEN
+ibmELIF modus="FILETRANSPARENT"THEN transparentELIF modus="ROWTEXT"THEN
+rowtextELIF modus="DS"THEN dsELIF modus="DUMP"THEN dumpELSE errorstop(
+"Unzulässige Betriebsart");-1FI .modusnormieren:changeall(modus," ","");INT
+VAR i;FOR iFROM 1UPTO LENGTH modusREP INT CONST charcode:=code(modusSUB i);
+IF islowercaseTHEN replace(modus,i,uppercasechar)FI PER .islowercase:charcode
+>96AND charcode<123.uppercasechar:code(charcode-32).END PROC savefetchmode;
+TEXT PROC path(TEXT CONST reservestring):INT CONST p:=pos(reservestring,":");
+IF p=0THEN ""ELSE subtext(reservestring,p+1)FI .END PROC path;END PACKET
+fetchsave;
+
diff --git a/app/baisy/2.2.1-schulis/src/get put interface.dos b/app/baisy/2.2.1-schulis/src/get put interface.dos
new file mode 100644
index 0000000..1e80856
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/get put interface.dos
@@ -0,0 +1,103 @@
+PACKET dosgetputDEFINES logmodus,opendosdisk,closedosdisk,accessdosdisk,
+openfetchdosfile,closefetchdosfile,catnextfetchdoscluster,
+readnextfetchdoscluster,waslastfetchcluster,opensavedosfile,
+writenextsavedoscluster,closesavedosfile,erasedosfile,alldosfiles,
+alldossubdirs,dosfileexists,doslist,cleardosdisk,formatdosdisk:BOOL VAR
+logflag:=FALSE ;PROC logmodus(BOOL CONST status):logflag:=statusEND PROC
+logmodus;LET maxclustersize=8192,realspersector=64;LET CLUSTER =BOUND STRUCT
+(ALIGN dummy,ROW maxclustersizeREAL clusterrow);CLUSTER VAR cluster;
+DATASPACE VAR clusterds;INITFLAG VAR clusterdsused:=FALSE ;TEXT VAR
+convertbuffer;INT VAR convertbufferlength;PROC initclusterhandle:IF
+initialized(clusterdsused)THEN forget(clusterds)FI ;clusterds:=nilspace;
+cluster:=clusterds;convertbuffer:="";convertbufferlength:=0.END PROC
+initclusterhandle;PROC catclustertext(REAL CONST clusterno,TEXT VAR
+destination,INT CONST to):readdiskcluster(clusterds,2,clusterno);
+initconvertbuffer;INT VAR i;FOR iFROM 1UPTO sectorspercluster*realspersector
+REP replace(convertbuffer,i,cluster.clusterrow[i])PER ;destinationCAT subtext
+(convertbuffer,1,to).initconvertbuffer:IF convertbufferlength<clustersize
+THEN convertbufferCAT (clustersize-convertbufferlength)*"*";
+convertbufferlength:=clustersizeFI .END PROC catclustertext;PROC
+writetexttocluster(REAL CONST clusterno,TEXT CONST string):IF LENGTH string<
+clustersizeTHEN executewritetext(text(string,clustersize))ELSE
+executewritetext(string)FI ;writediskcluster(clusterds,2,clusterno).END PROC
+writetexttocluster;PROC executewritetext(TEXT CONST string):INT VAR i;FOR i
+FROM 1UPTO sectorspercluster*realspersectorREP cluster.clusterrow[i]:=string
+RSUB iPER .END PROC executewritetext;BOOL VAR diskopen:=FALSE ;TEXT VAR
+actpath;REAL VAR lastaccesstime;PROC opendosdisk(TEXT CONST path):IF logflag
+THEN dump("open dos disk",path)FI ;enablestop;closework;initclusterhandle;
+actpath:=path;diskopen:=TRUE END PROC opendosdisk;PROC closedosdisk:IF
+logflagTHEN dump("close dos disk","")FI ;enablestop;diskopen:=FALSE ;
+closework;initclusterhandle;clearfatds;initdirds.END PROC closedosdisk;PROC
+accessdosdisk:enablestop;IF NOT diskopenTHEN errorstop(
+"DOS-Arbeit nicht eröffnet")FI ;IF workclosedCOR (
+lastaccessmorethan5secondsagoCAND diskchanged)THEN openeudisk;opendosdisk;
+readfat;opendir(actpath);lastaccesstime:=clock(1);openworkFI .
+lastaccessmorethan5secondsago:abs(clock(1)-lastaccesstime)>5.0.diskchanged:
+IF hdversionTHEN FALSE ELSE lastaccesstime:=clock(1);NOT firstfatblockokFI .
+END PROC accessdosdisk;REAL VAR nextfetchcluster,fetchrest;PROC
+openfetchdosfile(TEXT CONST filename):IF logflagTHEN dump(
+"open fetch dos file",filename)FI ;enablestop;accessdosdisk;fileinfo(filename
+,nextfetchcluster,fetchrest).END PROC openfetchdosfile;BOOL PROC
+waslastfetchcluster:IF logflagTHEN dump("was last fetch cluster","")FI ;
+islastfatchainentry(nextfetchcluster)OR fetchrest<=0.0.END PROC
+waslastfetchcluster;PROC catnextfetchdoscluster(TEXT VAR buffer):IF logflag
+THEN dump("cat next fetch dos cluster","")FI ;enablestop;IF
+waslastfetchclusterTHEN errorstop("fetch nach Dateiende")FI ;IF fetchrest<
+real(clustersize)THEN catclustertext(nextfetchcluster,buffer,int(fetchrest));
+fetchrest:=0.0ELSE catclustertext(nextfetchcluster,buffer,clustersize);
+fetchrestDECR real(clustersize)FI ;lastaccesstime:=clock(1);nextfetchcluster
+:=fatentry(nextfetchcluster).END PROC catnextfetchdoscluster;PROC
+readnextfetchdoscluster(DATASPACE VAR readds,INT VAR startpage):IF logflag
+THEN dump("read next fetch dos cluster",startpage)FI ;enablestop;IF
+waslastfetchclusterTHEN errorstop("fetch nach Dateiende")FI ;readdiskcluster(
+readds,startpage,nextfetchcluster);lastaccesstime:=clock(1);startpageINCR
+sectorspercluster;nextfetchcluster:=fatentry(nextfetchcluster);IF fetchrest<
+real(clustersize)THEN fetchrest:=0.0ELSE fetchrestDECR real(clustersize)FI .
+END PROC readnextfetchdoscluster;PROC closefetchdosfile:IF logflagTHEN dump(
+"close fetch dos file","")FI ;END PROC closefetchdosfile;TEXT VAR savename;
+REAL VAR firstsavecluster,lastsavecluster,savesize;PROC opensavedosfile(TEXT
+CONST filename):IF logflagTHEN dump("open save dos file",filename)FI ;
+enablestop;accessdosdisk;IF fileexists(filename)OR subdirexists(filename)
+THEN errorstop("die Datei """+filename+""" gibt es schon")FI ;savename:=
+filename;firstsavecluster:=-1.0;savesize:=0.0.END PROC opensavedosfile;PROC
+writenextsavedoscluster(TEXT CONST buffer):IF logflagTHEN dump(
+"write next save dos cluster","")FI ;enablestop;REAL CONST savecluster:=
+availablefatentry;writetexttocluster(savecluster,buffer);lastaccesstime:=
+clock(1);savesizeINCR real(LENGTH buffer);IF firstsavecluster<2.0THEN
+firstsavecluster:=saveclusterELSE fatentry(lastsavecluster,savecluster)FI ;
+fatentry(savecluster,lastfatchainentry);lastsavecluster:=savecluster.END
+PROC writenextsavedoscluster;PROC writenextsavedoscluster(DATASPACE CONST
+saveds,INT VAR startpage):IF logflagTHEN dump("write next save dos cluster",
+startpage)FI ;enablestop;REAL CONST savecluster:=availablefatentry;
+writediskcluster(saveds,startpage,savecluster);lastaccesstime:=clock(1);
+startpageINCR sectorspercluster;savesizeINCR real(clustersize);IF
+firstsavecluster<2.0THEN firstsavecluster:=saveclusterELSE fatentry(
+lastsavecluster,savecluster)FI ;fatentry(savecluster,lastfatchainentry);
+lastsavecluster:=savecluster.END PROC writenextsavedoscluster;PROC
+closesavedosfile:IF logflagTHEN dump("close save dos file","")FI ;enablestop;
+IF firstsavecluster<2.0THEN LEAVE closesavedosfileFI ;fatentry(
+lastsavecluster,lastfatchainentry);writefat;insertdirentry(savename,
+firstsavecluster,savesize);lastaccesstime:=clock(1).END PROC closesavedosfile
+;PROC erasedosfile(TEXT CONST filename):IF logflagTHEN dump("erase dos file",
+filename)FI ;enablestop;accessdosdisk;REAL VAR firstcluster,size;fileinfo(
+filename,firstcluster,size);deletedirentry(filename);erasefatchain(
+firstcluster);writefat;lastaccesstime:=clock(1).END PROC erasedosfile;
+THESAURUS PROC alldosfiles:IF logflagTHEN dump("all dosfile","")FI ;
+enablestop;accessdosdisk;allfiles.END PROC alldosfiles;THESAURUS PROC
+alldossubdirs:IF logflagTHEN dump("all subdirs","")FI ;enablestop;
+accessdosdisk;allsubdirs.END PROC alldossubdirs;BOOL PROC dosfileexists(TEXT
+CONST filename):IF logflagTHEN dump("dos file exists",filename)FI ;enablestop
+;accessdosdisk;fileexists(filename).END PROC dosfileexists;PROC doslist(
+DATASPACE VAR listds):IF logflagTHEN dump("dos list","")FI ;enablestop;
+accessdosdisk;dirlist(listds).END PROC doslist;PROC cleardosdisk:IF logflag
+THEN dump("clear dos disk","")FI ;enablestop;IF hdversionTHEN errorstop(
+"nicht implementiert")ELSE accessdosdisk;formatdir;formatfat;lastaccesstime:=
+clock(1)FI .END PROC cleardosdisk;PROC formatdosdisk(INT CONST formatcode):
+IF logflagTHEN dump("format dos disk ("+text(formatcode)+")","")FI ;
+enablestop;IF NOT diskopenTHEN errorstop("DOS-Arbeit nicht eröffnet")FI ;IF
+hdversionTHEN errorstop("nicht implementiert")ELSE doformatFI .doformat:IF
+bpbexists(formatcode)THEN closework;formatarchive(formatcode);openeudisk;
+writebpb(formatcode);opendosdisk;formatdir;formatfat;openworkELSE errorstop(
+"Format unzulässig")FI ;lastaccesstime:=clock(1).END PROC formatdosdisk;END
+PACKET dosgetput;
+
diff --git a/app/baisy/2.2.1-schulis/src/insert.dos b/app/baisy/2.2.1-schulis/src/insert.dos
new file mode 100644
index 0000000..6788f3f
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/insert.dos
@@ -0,0 +1,15 @@
+dump
+konvert
+open
+eu disk descriptor
+disk descriptor.dos
+block i/o
+name conversion.dos
+fat.dos
+dir.dos
+get put interface.dos
+fetch save interface
+fetch
+save
+
+
diff --git a/app/baisy/2.2.1-schulis/src/isp archive.sc b/app/baisy/2.2.1-schulis/src/isp archive.sc
new file mode 100644
index 0000000..f608a95
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp archive.sc
@@ -0,0 +1,35 @@
+ PACKETisparchive DEFINESarchivefiles,archivesize,savetoarchive,fetchfromarchive,initarchive,cleararchive,cleararchivetask,checkarchive,listarchive,formatarchive,
+channelfree,logonarchive,logoffarchive,cleareacharchive,writefactor,readafterwrite,kf: LETuuuuuv=1,uuuuuw=2,uuuuux=34,uuuuuy=35,uuuuuz=25,uuuuvu=26,uuuuvv=36,uuuuvw
+=37,uuuuvx=39,uuuuvy=40,uuuuvz=41,uuuuwu=42,uuuuwv=43,uuuuww=44,uuuuwx=45,uuuuwy=46,uuuuwz=47,uuuuxu=48,uuuuxv=200,uuuuxw="�",fehlertext="ARCHIVE-Fehler: "; LET ARCHIVECONTROL
+= STRUCT( INTuuuuxx, BOOLuuuuxy); BOUND ARCHIVECONTROL VARuuuuxz; INT VARuuuuyu,uuuuyv,uuuuyw,uuuuyx:=1; THESAURUS VARuuuuyy; TEXT VARuuuuyz:=""; BOOL VARuuuuzu:=
+ FALSE,uuuuzv:= FALSE,uuuuzw:= FALSE; BOUND STRUCT( INTuuuuzx, ROWuuuuxv TEXTuuuuzz) VARuuuvuu; DATASPACE VARuuuvuv; PROCkf( BOOL CONSTuuuvux):uuuuzw:=uuuvux ENDPROC
+kf; PROCreadafterwrite( BOOL CONSTuuuuxy):uuuuzv:=uuuuxy ENDPROCreadafterwrite; BOOL PROCreadafterwrite:uuuuzv ENDPROCreadafterwrite; PROCwritefactor( INT CONSTuuuuxy
+):uuuuyx:=uuuuxy ENDPROCwritefactor; INT PROCwritefactor:uuuuyx ENDPROCwritefactor; BOOL PROCcleareacharchive:uuuuzu ENDPROCcleareacharchive; PROCcleareacharchive
+( BOOL CONSTuuuvyx):uuuuzu:=uuuvyx ENDPROCcleareacharchive; PROCcleararchivetask:logoffarchive;logonarchive ENDPROCcleararchivetask; THESAURUS PROCarchivefiles:uuuuyy
+ ENDPROCarchivefiles; INT PROCarchivesize:archivesize( SOMEmyself) ENDPROCarchivesize; INT PROCarchivesize( THESAURUS CONSTuuuwvu):uuuuyy:=uuuwvu;uuuuyu:=0;uuuuyv
+:=1;uuuuyw:=0;get(uuuuyy,uuuuyz,uuuuyu); WHILEuuuuyu>0 REPuuuuyw INCRstorage(old(uuuuyz));uuuuyv INCR1;get(uuuuyy,uuuuyz,uuuuyu) PER;uuuuyw ENDPROCarchivesize; TASK
+ PROCuuuwyu:/"isp.archive" ENDPROCuuuwyu; BOUND TEXT VARuuuwyw; BOUND INT VARuuuwyx; DATASPACE VARuuuwyy; INT VARuuuwyz; TASK VARuuuwzu:=niltask; PROCformatarchive
+( TEXT CONSTuuuwzw):formatarchive(0,uuuwzw) ENDPROCformatarchive; PROCformatarchive( INT CONSTuuuxuv, TEXT CONSTuuuwzw): IFpos("0123",text(uuuxuv))>0 THENuuuxuy(uuuuvy
+,code(uuuxuv)+uuuwzw, TRUE) FI ENDPROCformatarchive; PROCsavetoarchive( THESAURUS CONSTuuuwvu): IFuuuuzu THENcleararchive; FI;do( PROC( TEXT CONST)uuuxwv,uuuwvu);
+ ENDPROCsavetoarchive; PROCfetchfromarchive:uuuxwz;uuuxxu;uuuxxv.uuuxwz:uuuxxx;call(uuuwyu,uuuuvz,uuuwyy,uuuwyz).uuuxxu: INT VARuuuxyx:=uuuuvz; WHILEuuuwyz<>uuuuvx
+ REPuuuxzv; IFuuuwyz=uuuuvw THENuuuxzy ELSEuuuxxx;call(uuuwyu,uuuxyx,uuuwyy,uuuwyz) FI PER.uuuxzv: SELECTuuuwyz OF CASEuuuuuw:uuuwyw:=uuuwyy;enablestop;errorstop(
+fehlertext+uuuwyw) CASEuuuuvw: IFcommanddialogue THENuuuyvz;uuuwyw:=uuuwyy;out(uuuwyw) FI CASEuuuuvv:uuuyvz; IFuuuywz THENerrorstop("Archivieren inkonsistent abgebrochen"
+) FI;uuuxyx:=uuuuwu ENDSELECT.uuuxxv: INT VARuuuyxx;forget(uuuvuv);uuuvuv:=uuuwyy;uuuvuu:=uuuvuv; FORuuuyxx FROM1 UPTOuuuvuu.uuuuzx REP#out("<"+uuuvuu.uuuuzz[uuuyxx
+]+">");uuuyvz;#uuuyzy PER;forget(uuuvuv).uuuyzy:uuuxxx;uuuwyx:=uuuwyy;uuuwyx:=uuuyxx;call(uuuwyu,uuuuwv,uuuwyy,uuuwyz);forget(uuuvuu.uuuuzz[uuuyxx],quiet);copy(uuuwyy
+,uuuvuu.uuuuzz[uuuyxx]). ENDPROCfetchfromarchive; BOOL PROCuuuywz: REPuuuyvz; IFonline THENout(2*uuuuxw) FI; IFyes("Nachfolgende Archive-Diskette eingelegt") THEN
+ LEAVEuuuywz WITH FALSE FI UNTILuuuuzw COR( NOTuuuuzw CANDyes("Sicherung wirklich abbrechen")) PER; TRUE ENDPROCuuuywz; PROCuuuxwv( TEXT CONSTuuuzyw#, BOOL PROCuuuzyx
+#):save(uuuzyw,uuuwyu); IFcommanddialogue THENuuuyvz;out(""""+uuuzyw+""" wird gesichert!");#uuuyvz# FI;uuuzzx;uuuzzy.uuuzzx:uuuxxx;uuuuxz:=uuuwyy;uuuuxz.uuuuxx:=uuuuyx
+;uuuuxz.uuuuxy:=uuuuzv;call(uuuwyu,uuuuux,uuuwyy,uuuwyz);uuvuwv.uuvuwv: WHILEuuuwyz<>uuuuvv REPuuuxzv;uuuxzy PER.uuuzzy: REP IFuuuwyz=uuuuvv THENuuuyvz; IFuuuywz THEN
+errorstop("Sichern eventuell inkonsistent abgebrochen!"); LEAVEuuuxwv ELSE IFuuuuzu THENcleararchive; FI;out(""""+uuuzyw+""" wird gesichert!"); FI ELSEuuuxzv FI;uuuxxx
+; IF NOTuuvuzu THENcall(uuuwyu,uuuuuy,uuuwyy,uuuwyz) ELSEuuuxzy FI; PER.uuvuzu:uuuwyz=uuuuvw.uuuxzv: SELECTuuuwyz OF CASEuuuuuw:uuuwyw:=uuuwyy;enablestop;errorstop
+(fehlertext+uuuwyw) CASEuuuuvx: LEAVEuuuxwv CASEuuuuvw: IFcommanddialogue THENuuuwyw:=uuuwyy;uuuyvz;out(uuuwyw); FI ENDSELECT. ENDPROCuuuxwv; PROCinitarchive( TEXT
+ CONSTuuvvxu):uuuxuy(uuuuwz,uuvvxu, TRUE) ENDPROCinitarchive; PROCcheckarchive:uuuxuy(uuuuxu) ENDPROCcheckarchive; PROCcleararchive:uuuxuy(uuuuuz) ENDPROCcleararchive
+; PROClistarchive:uuuxuy(uuuuvu);forget("ISP-Archive",quiet);type(uuuwyy,1003);copy(uuuwyy,"ISP-Archive");show("ISP-Archive");forget("ISP-Archive",quiet) ENDPROClistarchive
+; PROClogonarchive:uuuxuy(uuuuwx,"", FALSE) ENDPROClogonarchive; PROClogoffarchive:uuuxuy(uuuuwy,"", FALSE) ENDPROClogoffarchive; PROCuuuxuy( INT CONSTuuvwvy):uuuxuy
+(uuvwvy,"", FALSE) ENDPROCuuuxuy; PROCuuuxuy( INT CONSTuuvwvy, TEXT CONSTuuvwwy, BOOL CONSTuuvwwz):uuvwxu; WHILEuuvwxv REPuuvwxw;uuuxzy PER.uuvwxv:uuuwyz<>uuuuvx.
+uuvwxu:uuuxxx; IFuuvwwz THENuuuwyw:=uuuwyy;uuuwyw:=uuvwwy FI;call(uuuwyu,uuvwvy,uuuwyy,uuuwyz).uuvwxw: IFuuuwyz=uuuuvw THEN IFcommanddialogue THENuuuwyw:=uuuwyy;uuuyvz
+;out(uuuwyw) FI ELIFuuuwyz=uuuuuw THENuuuwyw:=uuuwyy;enablestop;errorstop(fehlertext+uuuwyw) FI. ENDPROCuuuxuy; PROCuuuxzy: REPforget(uuuwyy);wait(uuuwyy,uuuwyz,uuuwzu
+); IF NOT(uuuwzu=uuuwyu) THEN#note("IN WARTE: "+text(uuuwyz)+"/"+name(uuuwzu));noteline;#uuvxxy FI UNTILuuuwzu=uuuwyu PER ENDPROCuuuxzy; PROCuuvxxy:send(uuuwzu,uuuuuv
+,uuuwyy) ENDPROCuuvxxy; PROCchannelfree: DATASPACE VARuuvxzw:=nilspace;send(uuuwyu,uuuuww,uuvxzw);forget(uuvxzw) ENDPROCchannelfree; PROCuuuxxx:forget(uuuwyy);uuuwyy
+:=nilspace ENDPROCuuuxxx; PROCuuuyvz: IFonline THENline; FI ENDPROCuuuyvz; ENDPACKETisparchive;
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.auskunftseditor b/app/baisy/2.2.1-schulis/src/isp.auskunftseditor
new file mode 100644
index 0000000..abf50d4
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.auskunftseditor
@@ -0,0 +1,27 @@
+PACKET ispauskunftseditorDEFINES auskunftstextaendernvp,
+auskunftstextaendernnp,auskunftstextspeichern:LET dateiname=
+"Auskunftstext zur Auskunft ";LET editorfenster=77,eol="�",stop="�";TEXT VAR
+datnam;PROC auskunftstextaendernvp:datnam:=dateiname+sicherungauskunftsname;#
+FILE VAR dat:=sequentialfile(output,datnam);#store(FALSE );IF
+sicherungauskunftstext<>""THEN auskunftindatei(datnam,sicherungauskunftstext)
+FI ;wordwrap(TRUE );page;editiere(datnam,"s",FALSE ).END PROC
+auskunftstextaendernvp;PROC auskunftstextaendernnp:store(FALSE );
+editierewieeingestelltEND PROC auskunftstextaendernnp;PROC
+auskunftstextspeichern(PROC (INT CONST )spezerfassungauskuenfte,BOOL CONST
+speichern):originalsituation;IF speichernTHEN TEXT VAR t;auskunftintext(
+datnam,t);#putwert(fnrauskunftstext,t);#zwischenspeicherungdestextes(t);FI ;
+forget(datnam,quiet);return(1);angegebenedatenpruefenundevtlspeichern(
+speichern,PROC spezerfassungauskuenfte);END PROC auskunftstextspeichern;PROC
+auskunftintext(TEXT CONST datnam,TEXT VAR auskunft):FILE VAR dat:=
+sequentialfile(input,datnam);TEXT VAR zeile;IF eof(dat)THEN close(dat);
+auskunft:=""ELSE auskunft:="";REP getline(dat,zeile);auskunft:=auskunft+
+encode(zeile);UNTIL eof(dat)PER ;FI END PROC auskunftintext;PROC
+auskunftindatei(TEXT CONST datnam,TEXT CONST te):FILE VAR dat:=sequentialfile
+(output,datnam);TEXT VAR zeile,auskunft:=te;INT VAR bottom:=1,top:=1;INT VAR
+l:=length(auskunft);formatierezeile;REP schreibe;formatierezeile;UNTIL (top>=
+l)CAND (zeile="")PER .formatierezeile:zeile:="";IF bottom>=lTHEN zeile:=""
+ELSE top:=min(bottom+editorfenster-1,l);zeile:=subtext(auskunft,bottom,top,
+eol,stop,FALSE );topINCR 1;bottom:=topFI .schreibe:putline(dat,zeile).END
+PROC auskunftindatei;PROC originalsituation:reorganizescreen;store(TRUE )END
+PROC originalsituation;END PACKET ispauskunftseditor;
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.auskunftsfunktionen b/app/baisy/2.2.1-schulis/src/isp.auskunftsfunktionen
new file mode 100644
index 0000000..0f002ba
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.auskunftsfunktionen
@@ -0,0 +1,69 @@
+PACKET auskunftsfunktionenDEFINES erteileauskunft,ergaenzeauskunft,
+auskunftszeilenende,auskunftstextende,editauskunft,quadrant:LET eol="�",stop=
+"�",fuereditor=TRUE ,fuermaske=FALSE ;TEXT CONST standardtext:=
+"Die gewünschte Auskunft ist leider noch nicht verfügbar!"+stop;TEXT CONST
+auskunftszeilenende:=eol;TEXT CONST auskunftstextende:=stop;TEXT VAR
+auskunftergaenzung:="";INT VAR auskunftergaenzungsnr:=0;PROC ergaenzeauskunft
+(TEXT CONST durch,INT CONST fuer):auskunftergaenzung:=durch;
+auskunftergaenzungsnr:=fuerEND PROC ergaenzeauskunft;TEXT PROC atext(INT
+CONST nr):TEXT VAR grundauskunft;IF wert(fnrauskunftstext)=""THEN
+grundauskunft:=standardtextELSE grundauskunft:=wert(fnrauskunftstext)FI ;IF (
+auskunftergaenzung<>"")CAND (nr=auskunftergaenzungsnr)THEN grundauskunftCAT
+auskunftergaenzungFI ;grundauskunftEND PROC atext;TEXT PROC astichwort:
+systemdbon;wert(fnrschlverz)END PROC astichwort;WINDOW PROC altesfenster:INT
+VAR i,j,k,l;quadrant(i,j,k,l);startwindow(i,j,k,l)END PROC altesfenster;PROC
+quadrant(INT VAR i,j,k,l):merkeposition;fenster.merkeposition:INT VAR x,y;
+getcursorposfuerauskunft(x,y).fenster:INT VAR x1,y1,x2,y2;IF vierterquadrant
+THEN x1:=1;y1:=12;x2:=39;y2:=1ELIF dritterquadrantTHEN x1:=40;y1:=12;x2:=77;
+y2:=1ELIF zweiterquadrantTHEN x1:=1;y1:=24;x2:=39;y2:=13ELIF ersterquadrant
+THEN x1:=40;y1:=24;x2:=77;y2:=13FI ;i:=x1;j:=y1;k:=x2;l:=y2.ersterquadrant:(x
+<40)CAND (y<13).zweiterquadrant:(x>39)CAND (y<13).dritterquadrant:(x<40)CAND
+(y>12).vierterquadrant:(x>39)CAND (y>12).END PROC quadrant;PROC holeauskunft(
+INT CONST name):putintwert(fnrauskunftsname,name);search(dnrausk,TRUE );END
+PROC holeauskunft;PROC erteileauskunft(INT CONST nr):WINDOW VAR w:=
+altesfenster;TEXT VAR auskunft:="";TEXT CONST st:=" = ";INT CONST suchname:=
+nr;INT VAR anzahl:=5;systemdbon;erteileauskunftbody;systemdboff;
+wiederaufsetzen.erteileauskunftbody:IF menuedraussenTHEN reorganizescreenFI ;
+open(w);auskunftholen;zeige.auskunftholen:holeauskunft(suchname);.zeige:IF
+dbstatus=okTHEN auskunft:=atext(suchname)ELSE auskunft:=standardtext;putwert(
+fnrschlverz,"")FI ;stwpruefen;auskunfterteilung(auskunft,w,fuermaske);.
+stwpruefen:IF astichwort<>""THEN textschonmalzeigen(auskunft,w,fuermaske);IF
+pos(astichwort,"c")=1THEN schluesselverzeichnisausschluesseldateiELSE
+schluesselverzeichnisnichtausschluesseldateiFI FI ;schlussstern.
+schluesselverzeichnisausschluesseldatei:#INT VAR i:=1;##02.02.88dr#TEXT VAR
+bestname:=astichwort;systemdboff;bestandsuchen;IF bestandvorhandenTHEN
+auskunftCAT stop;ankoppelnderabkuerzung;naechstelesen;WHILE erfolgreichREP
+anhaengen;naechstelesenPER ELSE meldunganhaengen(auskunft,"Bestand "+bestname
++" ist nicht vorhanden")FI .bestandsuchen:inittupel(dnrschluessel);putwert(
+fnrschlsachgebiet,bestname);search(dnrschluessel,FALSE );.bestandvorhanden:
+dbstatus=okCAND wert(fnrschlsachgebiet)=bestname.naechstelesen:anzahl:=18;
+multisucc(dnrschluessel,anzahl);#iINCR 1##02.02.88dr#.erfolgreich:anzahl>0
+CAND wert(fnrschlsachgebiet)=bestname.anhaengen:WHILE anzahl>0REP multisucc;
+IF erfolgreichTHEN ankoppelnderabkuerzung;FI ;anzahlDECR 1UNTIL NOT
+erfolgreichPER .ankoppelnderabkuerzung:auskunftCAT wert(fnrschlschluessel);
+auskunftCAT st;auskunftCAT wert(fnrschllangtext);auskunftCAT stop;.
+schluesselverzeichnisnichtausschluesseldatei:TEXT VAR dateiname:=astichwort;
+INT VAR dnr:=0;systemdboff;stopbeifalschemnamen(FALSE );dnr:=dateinr(
+dateiname);IF dnr>0THEN first(dnr);IF dbstatus=okTHEN auskunftCAT stop;
+anwendungsdatenkoppeln;dienaechstenanwendungsdatenlesenELSE meldunganhaengen(
+auskunft,"Keine Daten zu "+dateiname+" vorhanden")FI ELSE meldunganhaengen(
+auskunft,"Bestand "+dateiname+" ist nicht vorhanden")FI ;stopbeifalschemnamen
+(TRUE ).dienaechstenanwendungsdatenlesen:INT VAR a:=0;anzahl:=18;multisucc(
+dnr,anzahl);REP IF anzahl>0THEN WHILE a<anzahlREP multisucc;
+anwendungsdatenkoppeln;aINCR 1;PER ;a:=0;anzahl:=18;multisucc(dnr,anzahl)
+ELSE LEAVE dienaechstenanwendungsdatenlesenFI ;PER .anwendungsdatenkoppeln:
+auskunftCAT wert(dnr+1);auskunftCAT st;auskunftCAT wert(dnr+2);auskunftCAT
+stop.schlussstern:auskunftCAT "*";auskunftCAT stop.wiederaufsetzen:
+reorganizescreen;setlasteditvalues;return(1).END PROC erteileauskunft;PROC
+erteileauskunft:erteileauskunft(auskunftsnr)END PROC erteileauskunft;PROC
+meldunganhaengen(TEXT VAR auskunft,TEXT CONST meldtext):auskunftCAT stop;
+auskunftCAT meldtext;auskunftCAT stop;.END PROC meldunganhaengen;PROC
+editauskunft(INT CONST editnummer):systemdbon;erteileauskunftbody;systemdboff
+;wiederaufsetzen.erteileauskunftbody:auskunftholen;zeige.auskunftholen:
+WINDOW VAR w:=altesfenster;open(w);TEXT VAR auskunft:="";#INT VAR lu,ro;#
+cursor(1,2);holeauskunft(editnummer);IF dbstatus=okTHEN auskunft:=atext(
+editnummer)ELSE auskunft:=standardtextFI ;schlussstern.schlussstern:auskunft
+CAT "*";auskunftCAT stop.zeige:auskunfterteilung(auskunft,w,fuereditor).
+wiederaufsetzen:return(1).END PROC editauskunft;END PACKET
+auskunftsfunktionen;
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.baisy server b/app/baisy/2.2.1-schulis/src/isp.baisy server
new file mode 100644
index 0000000..dfb77a9
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.baisy server
@@ -0,0 +1,80 @@
+PACKET ispbaisyserverDEFINES baisyserver:LET PARAM =STRUCT (TEXT textkey1,
+textkey2,TAG maske);LET endcode=37,savedbcode=38,restoredbcode=39,
+maxthesaurusentry=252,nak=1,aktionsavebase=38,aktionloadbase=39,sendall=47,
+pruefen=40,init=41,loeschen=42,speichern=43,umbenennen=44,kopieren=45,liste=
+46,newtree=52,reorg=53,refinementlist=54,translate=55,retranslate=56,
+eraserefinement=57;LET ack=0,nack=1,ende=3;LET fehldat="Übersetzungsfehler:";
+BOUND PARAM VAR p;INT VAR status;PROC baisyserver:boot;globalmanager(PROC (
+DATASPACE VAR ,INT CONST ,INT CONST ,TASK CONST )baisyserver)END PROC
+baisyserver;PROC baisyserver(DATASPACE VAR ds,INT CONST auftragsnr,INT CONST
+dummy,TASK CONST auftraggeber):BOUND THESAURUS VAR boundthesau;THESAURUS VAR
+thesau;enablestop;status:=ack;fuehreauftragaus;meldezurueck.fuehreauftragaus:
+IF auftragsnr>=newtreeTHEN baumbearbeitungELSE andererdienstFI .
+baumbearbeitung:IF auftragsnr=newtreeTHEN schicktabelleELSE bearbeitetabelle
+FI .bearbeitetabelle:TEXT VAR dateiname:=headline(sequentialfile(input,ds));
+forget(dateiname,quiet);copy(ds,dateiname);forget(ds);SELECT auftragsnrOF
+CASE refinementlist:listeallerrefinementsCASE translate,reorg:
+bearbeitendesbaumesCASE retranslate:ausdembaumCASE eraserefinement:
+refinementloeschenOTHERWISE falscherauftragEND SELECT ;forget(dateiname,quiet
+).schicktabelle:p:=ds;TEXT VAR startknotenname:=p.textkey1;forget(ds);
+gibbaumtabelle(startknotenname,ds).listeallerrefinements:listederteilbaeume(
+dateiname);ds:=old(dateiname).ausdembaum:BOOL VAR ok;teilbaeumeaussystembaum(
+dateiname,ok);IF NOT okTHEN status:=nackFI ;ds:=old(dateiname).
+refinementloeschen:loescheteilbaeume(dateiname,ok);IF NOT okTHEN status:=nack
+FI ;ds:=old(dateiname).bearbeitendesbaumes:INT CONST dl:=length(dateiname);
+disablestop;continue(int(subtext(dateiname,dl-1,dl)));IF auftragsnr=reorg
+THEN reorganisierenELSE BOOL VAR falsch;uebersetze(dateiname,falsch)FI ;
+startesystembaum;break(quiet);clearerror;enablestop;IF falschTHEN status:=
+nack;ds:=old(fehldat);forget(fehldat,quiet)ELSE ds:=old(dateiname)FI .
+falscherauftrag:errorstop("Ungültiger Auftrag an "+name(myself)).
+andererdienst:p:=ds;SELECT auftragsnrOF CASE pruefen:maskepruefenCASE init:
+maskeinitialisierenCASE loeschen:maskeloeschenCASE speichern:maskespeichern
+CASE umbenennen:maskeumbenennenCASE kopieren:maskekopierenCASE liste:
+maskenlisteCASE sendall:savefast(auftraggeber)CASE aktionsavebase:#savebase#
+senddb(auftraggeber)CASE aktionloadbase:#fetchbase#boundthesau:=ds;thesau:=
+boundthesau;restoredb(auftraggeber,thesau);startesystembaum;
+startemaskenverarbeitungOTHERWISE systemaufrufEND SELECT .maskepruefen:IF
+NOT tagexists(p.textkey1)THEN status:=endeFI .maskeinitialisieren:p.maske
+INITBY p.textkey1.maskeloeschen:forgettag(p.textkey1).maskespeichern:storetag
+(p.maske,p.textkey1).maskekopieren:copytag(p.textkey1,p.textkey2);.
+maskeumbenennen:renametag(p.textkey1,p.textkey2).maskenliste:TEXT VAR
+listdatei:=p.textkey1;listedermasken(listdatei);forget(ds);ds:=old(listdatei)
+;forget(listdatei,quiet).meldezurueck:send(auftraggeber,status,ds).
+systemaufruf:IF auftragsnr>=100THEN forget(ds);LEAVE baisyserverELSE
+freemanager(ds,auftragsnr,dummy,auftraggeber)FI .#savebase:sbase(auftraggeber
+).fetchbase:fbase(auftraggeber,katalog);boot.katalog:BOUND THESAURUS VAR kat
+:=ds;kat.#END PROC baisyserver;PROC boot:startesystembaum;
+startemaskenverarbeitungEND PROC boot;PROC sbase(TASK CONST auftraggeber):
+meldezurueck;saveall(auftraggeber).meldezurueck:DATASPACE VAR ds:=nilspace;
+send(auftraggeber,0,ds).END PROC sbase;PROC fbase(TASK CONST auftraggeber,
+THESAURUS VAR katalog):meldezurueck;interessierendeeintraege(katalog);fetch(
+katalog,auftraggeber).meldezurueck:DATASPACE VAR ds:=nilspace;send(
+auftraggeber,0,ds).END PROC fbase;PROC interessierendeeintraege(THESAURUS
+VAR t):LET datenraumpraefix="BAISY-";beginneliste;naechster;WHILE
+nochwelchedaREP pruefen;naechsterPER .beginneliste:TEXT VAR name;INT VAR
+index:=0.naechster:get(t,name,index).nochwelcheda:index>0.pruefen:IF pos(name
+,datenraumpraefix)<>1THEN delete(t,index)FI .END PROC
+interessierendeeintraege;ROW maxthesaurusentryDATASPACE VAR receiveddb;PROC
+senddb(TASK CONST ordertask):THESAURUS VAR dbthesaurus:=ALL myself;DATASPACE
+VAR ds;INT VAR tindex;forget(ds);ds:=nilspace;interessierendeeintraege(
+dbthesaurus);sendthesaurus;sendfilesinthesaurus.sendthesaurus:BOUND
+THESAURUS VAR thesau:=ds;thesau:=dbthesaurus;send(ordertask,savedbcode,ds);.
+sendfilesinthesaurus:TEXT VAR fname;tindex:=0;get(dbthesaurus,fname,tindex);
+WHILE tindex>0REP sendfile;get(dbthesaurus,fname,tindex)PER ;sendend.sendfile
+:pause(10);forget(ds);ds:=old(fname);send(ordertask,savedbcode,ds);.sendend:
+pause(10);ds:=nilspace;send(ordertask,endcode,ds).ENDPROC senddb;PROC
+restoredb(TASK CONST ordertask,THESAURUS CONST dbthesaurus):INT VAR replycode
+;#THESAURUS VAR olddb:=ALL myself;#DATASPACE VAR ds;TASK VAR sourcetask:=
+niltask;INT VAR tindex;TEXT VAR fname:="";#deleteallfiles;#sendack;rcvdb;
+builddb.#deleteallfiles:TEXT VAR fname;INT VAR tindex;tindex:=0;get(olddb,
+fname,tindex);WHILE tindex>0REP forget(fname,quiet);get(olddb,fname,tindex)
+PER .#sendack:forget(ds);ds:=nilspace;send(ordertask,restoredbcode,ds).rcvdb:
+INT VAR l:=1;REP forget(receiveddb[l]);wait(receiveddb[l],replycode,
+sourcetask);IF NOT (sourcetask=ordertask)THEN forget(receiveddb[l]);sendnack
+ELSE IF replycode=restoredbcodeTHEN lINCR 1ELSE forget(receiveddb[l])FI FI
+UNTIL replycode=endcodePER .builddb:tindex:=0;l:=1;get(dbthesaurus,fname,
+tindex);WHILE tindex>0REP forget(fname,quiet);copy(receiveddb[l],fname);
+forget(receiveddb[l]);lINCR 1;get(dbthesaurus,fname,tindex)PER .sendnack:
+forget(ds);ds:=nilspace;send(sourcetask,nak,ds).ENDPROC restoredb;ENDPACKET
+ispbaisyserver;
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.benutzerberechtigungen b/app/baisy/2.2.1-schulis/src/isp.benutzerberechtigungen
new file mode 100644
index 0000000..ba9f102
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.benutzerberechtigungen
@@ -0,0 +1,87 @@
+PACKET ispbenutzerberechtigungenDEFINES erstellebenutzungsberechtigung,
+identistart,aktuellebenutzerkenndatenlesen,pruefeberechtigung,
+setzeanfangsknotennamefuerbenutzerbestand,benutzerbestand:LET standardanfang=
+2,maskenname="mu identifikation",#benbest="cb benutzer",23.07.87#wer=47,
+falsch=39,#benmeth=2,#punkt=".";BOOL VAR pruefungnoetig,gefunden,berechtigt;
+INT VAR anzahlversuche;LET maxversuche=3;;TAG VAR aktuellemaske;INT VAR
+aktuelleposition;TEXT VAR benutzername,geheimwort,benutzerberechtigung,
+startknotenname:="schulis";PROC hinweisauflizenzfreiesoftwaregeben:TEXT VAR
+testname;holeberechtigungswert(testname);IF testname=""THEN
+kopierhinweiszeigenFI .kopierhinweiszeigen:page;cursor(23,3);put(
+"schulis - Schulverwaltungssystem");cursor(27,8);put(
+"Lizenzfreie Software der");cursor(13,10);put(
+"Gesellschaft für Mathematik und Datenverarbeitung mbH");cursor(8,14);put(
+"Die Nutzung der Software ist nur im Schul- und Hochschulbereich ");cursor(20
+,15);put("für nichtkommerzielle Zwecke gestattet.");cursor(16,17);put(
+"Gewährleistung und Haftung werden ausgeschlossen.");cursor(26,23);put(
+"Weiter mit beliebiger Taste");pause(100).END PROC
+hinweisauflizenzfreiesoftwaregeben;PROC identistart:
+frageentwicklernachseinemnamen;aktuellebenutzerkenndatenlesen;.
+frageentwicklernachseinemnamen:hinweisauflizenzfreiesoftwaregeben;page;
+benutzername:="";geheimwort:="";gefunden:=FALSE ;pruefungnoetig:=TRUE ;
+anzahlversuche:=0;standardkopfmaskeinitialisieren(startknotenname);
+standardkopfmaskeausgeben(text(vergleichsknoten));initmaske(aktuellemaske,
+maskenname);show(aktuellemaske);aktuelleposition:=standardanfang;.END PROC
+identistart;PROC aktuellebenutzerkenndatenlesen:ROW 100TEXT VAR feld;
+berechtigt:=FALSE ;init(feld);feld(2):=benutzername;feld(3):=geheimwort;
+putget(aktuellemaske,feld,aktuelleposition);benutzername:=feld(2);geheimwort
+:=feld(3);END PROC aktuellebenutzerkenndatenlesen;PROC berechtigungholen:
+systemdbon;IF gefundenTHEN gefunden:=((startknotennameSUB 1)=wert(
+fnrbenutzbestand)CAND benutzername=wert(fnrbenutzname))FI ;
+benutzerberechtigung:="";IF NOT gefundenTHEN putwert(fnrbenutzname,
+benutzername);putwert(fnrbenutzbestand,(startknotennameSUB 1));search(
+dnrbenutz,TRUE );gefunden:=(dbstatus=ok);FI ;IF gefundenTHEN IF (geheimwort=
+wert(fnrbenutzgeheimwort))THEN benutzerberechtigung:=wert(fnrbenutzberecht);
+berechtigt:=TRUE ELSE berechtigt:=FALSE ;aktuelleposition:=standardanfang+1
+FI ELSE aktuelleposition:=standardanfangFI ;systemdboff;END PROC
+berechtigungholen;PROC pruefeberechtigung:IF pruefungnoetigTHEN
+berechtigungholen;IF NOT (gefundenAND berechtigt)THEN IF anzahlversuche<
+maxversucheTHEN anzahlversucheINCR 1ELSE anzahlversuche:=0;
+logbucheintraganmeldversuchFI ;meldedies;return(1)ELSE
+logbucheintraganmeldung;setzebenutzerberechtigung(benutzerberechtigung);
+pruefungnoetig:=FALSE ;pageFI ELSE pageFI ;.meldedies:IF NOT gefundenTHEN
+meldeauffaellig(aktuellemaske,wer)ELSE meldeauffaellig(aktuellemaske,falsch)
+FI .END PROC pruefeberechtigung;PROC logbucheintraganmeldung:LET
+loggrenzeerreicht=9,keinreplyvonlog=2,meldungloggrenzeerreicht=93;INT VAR
+logreply:=0;TEXT VAR eintrag:="Identifikation ";eintragCAT """";eintragCAT
+name(myself);eintragCAT """ durch """;eintragCAT benutzername;eintragCAT """"
+;logeintrag(eintrag,logreply);IF logreply=loggrenzeerreichtTHEN
+meldeauffaellig(aktuellemaske,meldungloggrenzeerreicht);pause(20)ELIF
+logreply=keinreplyvonlogTHEN errorstop(
+"Zur Benutzung des schulis-Systems bitte erst LOG-Task einrichten")FI END
+PROC logbucheintraganmeldung;PROC logbucheintraganmeldversuch:TEXT VAR
+eintrag:="mehrfach Identifikation durch """;eintragCAT benutzername;eintrag
+CAT """ versucht";logeintrag(eintrag)END PROC logbucheintraganmeldversuch;
+PROC setzeanfangsknotennamefuerbenutzerbestand(TEXT CONST knotenname):
+startknotenname:=knotenname.END PROC
+setzeanfangsknotennamefuerbenutzerbestand;TEXT PROC benutzerbestand:
+startknotennameEND PROC benutzerbestand;PROC erstellebenutzungsberechtigung(
+INT CONST felder,INT VAR fehlerin,TEXT VAR einausgabe):pruefeaufkorrektheit;
+pruefeaufpraefixeigenschaft;gebeergebnisaus.pruefeaufkorrektheit:INT VAR i,j,
+bottom;LET maxstring=100;ROW maxstringTEXT VAR strings;TEXT VAR string:="";
+FOR iFROM 1UPTO felderREP bottom:=(i-1)*11;string:=subtext(einausgabe,bottom+
+1,bottom+11);pruefeauffeldkorrektheit;IF korrektTHEN strings(i):=
+bereinigterstringELSE fehlerin:=i;LEAVE erstellebenutzungsberechtigungFI PER
+.pruefeauffeldkorrektheit:BOOL VAR korrekt:=TRUE ;TEXT VAR bereinigterstring
+:="";TEXT VAR cstr:=compress(string);IF cstr=""THEN bereinigterstring:=""
+ELSE korrekt:=istmenuebaumkennung(cstr,bereinigterstring)FI .
+pruefeaufpraefixeigenschaft:FOR iFROM 1UPTO felderREP FOR jFROM 1UPTO felder
+REP IF i<>jTHEN IF istpraefix(strings(i),strings(j))THEN strings(j):=""FI FI
+PER PER .gebeergebnisaus:TEXT VAR s,t:="";FOR iFROM 1UPTO felderREP s:=
+strings(i);IF s<>""THEN tCAT "/";tCAT sFI PER ;einausgabe:=t.END PROC
+erstellebenutzungsberechtigung;BOOL PROC istmenuebaumkennung(TEXT CONST st,
+TEXT VAR bereinigterstring):INT VAR anfang:=1;INT VAR ende:=pos(st,punkt);
+INT VAR l:=length(st);IF ende=lTHEN istzahl(subtext(st,anfang,l-1),
+bereinigterstring)ELIF NOT (ende>0)THEN istzahl(subtext(st,anfang,l),
+bereinigterstring)ELIF istzahl(subtext(st,anfang,ende-1),bereinigterstring)
+THEN bereinigterstringCAT punkt;istmenuebaumkennung(subtext(st,ende+1,l),
+bereinigterstring)ELSE FALSE FI END PROC istmenuebaumkennung;BOOL PROC
+istzahl(TEXT CONST t,TEXT VAR bereinigterstring):IF ((t<>"")CAND ((t<>"+")
+CAND (t<>"-")))CAND (length(t)<=2)THEN INT VAR i:=int(t);IF lastconversionok
+THEN bereinigterstringCAT text(i);TRUE ELSE FALSE FI ELSE FALSE FI END PROC
+istzahl;BOOL PROC istpraefix(TEXT CONST s,t):IF (s="")OR (t="")THEN FALSE
+ELSE pos(aufber(t),aufber(s))=1FI END PROC istpraefix;TEXT PROC aufber(TEXT
+CONST t):INT CONST l:=length(t);IF (tSUB l)<>punktTHEN t+punktELSE tFI END
+PROC aufber;PROC init(ROW 100TEXT VAR feld):INT VAR i;FOR iFROM 1UPTO 100REP
+feld(i):=""PER END PROC initEND PACKET ispbenutzerberechtigungen
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.erf.abkuerzungen b/app/baisy/2.2.1-schulis/src/isp.erf.abkuerzungen
new file mode 100644
index 0000000..2283aa1
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.erf.abkuerzungen
@@ -0,0 +1,67 @@
+PACKET isperfabkuerzungenDEFINES starterfassungallgemabkuerzungen,
+erfassungallgemabkuerzungen,pruefungabkuerzungen:LET standardmaskenname=
+"mu erf abkuerzungen",bestandallerbestaende="c02 bestand aller bestaende",
+fnrletztesfeld=4,fnrschluessel=2,fnrlangtext=4,trenner=" = ";TEXT VAR
+bestandname:="",aktmaskenname:="";TEXT VAR schluesselsicherung:="";INT VAR
+maxschluessellaenge:=0,statistiknummer:=0;BOOL VAR gesamtbestand:=FALSE ,
+erstesmalgelesen:=TRUE ;PROC starterfassungallgemabkuerzungen(TEXT CONST
+bestand):starterfassungallgemabkuerzungen(bestand,standardmaskenname)ENDPROC
+starterfassungallgemabkuerzungen;PROC starterfassungallgemabkuerzungen(TEXT
+CONST bestand,maskenname):reinitparsing;bestandname:=bestand;gesamtbestand:=
+bestandname=bestandallerbestaende;aktmaskenname:=maskenname;
+holeschluessellaengediesesbestands;
+erfassungsbildschirmaufbauenundvonerfassungsbildschirmeinlesen(PROC (INT
+CONST )erfassungallgemabkuerzungen).holeschluessellaengediesesbestands:
+systemdboff;inittupel(dnrschluessel);putwert(fnrschlsachgebiet,
+bestandallerbestaende);putwert(fnrschlschluessel,bestandname);search(
+dnrschluessel,TRUE );IF lesenfehlerfreiTHEN maxschluessellaenge:=int(wert(
+fnrschllangtext));ELSE maxschluessellaenge:=0;FI ;putwert(fnrschlsachgebiet,
+bestandname);.lesenfehlerfrei:dbstatus=0.ENDPROC
+starterfassungallgemabkuerzungen;PROC erfassungallgemabkuerzungen(INT CONST
+proznr):systemdboff;SELECT proznrOF CASE 1:setzeerfassungsparameterCASE 2:
+zeigeschluesselzurbearbeitungCASE 3:pruefeplausibilitaetCASE 4:
+setzewertefuerdbspeicherungCASE 5:setzeidentiobjektfuerobjektlisteCASE 6:
+abkuerzunglesenCASE 7:abkuerzungaendernCASE 8:abkuerzungeinfuegenCASE 9:
+abkuerzungloeschenENDSELECT ENDPROC erfassungallgemabkuerzungen;PROC
+setzeerfassungsparameter:erstesmalgelesen:=TRUE ;setzeerfassungsparameter(
+dnrschluessel,maxschluessellaenge,aktmaskenname,fnrletztesfeld)END PROC
+setzeerfassungsparameter;PROC zeigeschluesselzurbearbeitung:
+setzeerfassungsfeld(wert(fnrschlschluessel),fnrschluessel);
+setzeerfassungsfeld(wert(fnrschllangtext),fnrlangtext)END PROC
+zeigeschluesselzurbearbeitung;PROC pruefeplausibilitaet:INT VAR fehlerstatus
+:=0;setzefehlerstatus(fehlerstatus)ENDPROC pruefeplausibilitaet;PROC
+setzewertefuerdbspeicherung:putwert(fnrschlsachgebiet,bestandname);putwert(
+fnrschlschluessel,compress(erfassungswert(fnrschluessel)));putwert(
+fnrschllangtext,erfassungswert(fnrlangtext))ENDPROC
+setzewertefuerdbspeicherung;PROC setzeidentiobjektfuerobjektliste:LET
+trennsymbolfuerobli="$";TEXT VAR identizeile;identizeile:=wert(
+fnrschlschluessel)+trenner+wert(fnrschllangtext);identizeile:=subtext(
+identizeile,1,maxidentizeilenlaenge);setzeidentiwert(
+identizeilemitschluesselanhang).identizeilemitschluesselanhang:identizeile+
+trennsymbolfuerobli+wert(fnrschlschluessel).ENDPROC
+setzeidentiobjektfuerobjektliste;PROC abkuerzunglesen:putwert(
+fnrschlsachgebiet,bestandname);putwert(fnrschlschluessel,compress(
+erfassungswert(fnrschluessel)));search(dnrschluessel,TRUE );IF dbstatus=ok
+THEN saveupdateposition(dnrschluessel);IF erstesmalgelesenTHEN
+schluesselsicherung:=wert(fnrschlschluessel);erstesmalgelesen:=FALSE ;FI FI
+ENDPROC abkuerzunglesen;PROC abkuerzungaendern:restoreupdateposition(
+dnrschluessel);update(dnrschluessel);#IF dbstatus=okCAND statistikbestand
+CAND kuerzelgeaendertTHEN kuerzelnameinstatraumaendern(statistiknummer,
+schluesselsicherung,schluessel)FI ;dr11.05.88#erstesmalgelesen:=dbstatus=ok.#
+kuerzelgeaendert:schluesselsicherung<>schluessel.dr11.05.88#ENDPROC
+abkuerzungaendern;PROC abkuerzungeinfuegen:insert(dnrschluessel);#IF dbstatus
+=okCAND statistikbestandTHEN kuerzelnameinstatraumeinfuegen(statistiknummer,
+wert(fnrschlschluessel))FI ;dr11.05.88#erstesmalgelesen:=dbstatus=okENDPROC
+abkuerzungeinfuegen;PROC abkuerzungloeschen:delete(dnrschluessel);#IF
+dbstatus=okCAND statistikbestandTHEN kuerzelnameausstatraumentfernen(
+statistiknummer,wert(fnrschlschluessel))FI ;dr11.05.88#erstesmalgelesen:=
+dbstatus=okEND PROC abkuerzungloeschen;TEXT PROC schluessel:erfassungswert(
+fnrschluessel)END PROC schluessel;BOOL PROC pruefungabkuerzungen:wert(
+fnrschlsachgebiet)=bestandnameEND PROC pruefungabkuerzungen;#dr11.05.88BOOL
+PROC statistikbestand:LET anzstatistiken=8;ROW anzstatistikenTEXT CONST
+statistikname:=ROW anzstatistikenTEXT :("","c02 schulart","c02 zugang",
+"c02 versetzung","c02 relizugehoerigkeit","","c02 abgang","c02 abschluss");
+FOR statistiknummerFROM 1UPTO anzstatistikenREP IF statistikname[
+statistiknummer]=bestandnameTHEN LEAVE statistikbestandWITH TRUE FI PER ;
+FALSE END PROC statistikbestand;#END PACKET isperfabkuerzungen;
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.erf.benutzerberechtigungen b/app/baisy/2.2.1-schulis/src/isp.erf.benutzerberechtigungen
new file mode 100644
index 0000000..cab166c
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.erf.benutzerberechtigungen
@@ -0,0 +1,54 @@
+PACKET erfbenutzerberechtigungenDEFINES erfassungbenutzerberechtigungen:LET
+maskenname="mu erf benutzerdaten",fnrschluessel=2,maxschluessellaenge=0,
+fnrgeheimwort=3,fnrberechtigunganfang=4,fnrberechtigungende=43,
+meldungkeineberechtigung=75,trenner=" = ";TEXT VAR felderinstring:="",bestand
+:="s";INT VAR dateinummer:=0;#25.03.87#PROC erfassungbenutzerberechtigungen(
+INT CONST proznr):systemdbon;SELECT proznrOF CASE 1:setzeerfassungsparameter
+CASE 2:zeigeschluesselfuerbearbeitungCASE 3:pruefeplausibilitaetCASE 4:
+setzewertefuerdbspeicherungCASE 5:setzeidentiobjektfuerobjektlisteCASE 6:
+benutzerlesenCASE 7:benutzeraendernCASE 8:benutzereinfuegenCASE 9:
+benutzerloeschenENDSELECT ;#systemdboff;##26.03.87#END PROC
+erfassungbenutzerberechtigungen;PROC setzeerfassungsparameter:dateinummer:=
+dnrbenutz;bestand:=benutzerbestandSUB 1;setzeerfassungsparameter(dateinummer,
+maxschluessellaenge,maskenname,fnrberechtigungende)END PROC
+setzeerfassungsparameter;PROC zeigeschluesselfuerbearbeitung:
+setzeerfassungsfeld(wert(fnrbenutzgeheimwort),fnrgeheimwort);
+berechtigungeninfeldersetzen(wert(fnrbenutzberecht),fnrberechtigunganfang)
+END PROC zeigeschluesselfuerbearbeitung;PROC berechtigungeninfeldersetzen(
+TEXT CONST berechtstring,INT CONST i):TEXT VAR t:=subtext(berechtstring,2);
+INT VAR p:=pos(t,"/");INT VAR l:=length(t);INT VAR j;IF p>0THEN
+setzeerfassungsfeld(subtext(t,1,p-1),i);berechtigungeninfeldersetzen(subtext(
+t,p),i+1)ELSE setzeerfassungsfeld(subtext(t,1,l),i);FOR jFROM i+1UPTO
+fnrberechtigungendeREP setzeerfassungsfeld("",j)PER FI END PROC
+berechtigungeninfeldersetzen;PROC pruefeplausibilitaet:INT VAR fehlerstatus:=
+0;concatenation(felderinstring);erstellebenutzungsberechtigung(anzahl,
+fehlerstatus,felderinstring);IF fehlerstatus<>0THEN melde(erfassungsmaske,
+meldungkeineberechtigung);setzefehlerstatus(fnrberechtigunganfang+
+fehlerstatus-1);LEAVE pruefeplausibilitaetFI .anzahl:fnrberechtigungende-
+fnrberechtigunganfang+1.END PROC pruefeplausibilitaet;PROC concatenation(
+TEXT VAR t):INT VAR i;INT VAR l:=length(erfassungsmaske,fnrberechtigunganfang
+);t:="";FOR iFROM fnrberechtigunganfangUPTO fnrberechtigungendeREP IF
+erfassungswert(i)<>""THEN tCAT text(erfassungswert(i),l)FI PER END PROC
+concatenation;PROC setzewertefuerdbspeicherung:putwert(fnrbenutzbestand,
+bestand);putwert(fnrbenutzname,erfassungswert(fnrschluessel));putwert(
+fnrbenutzgeheimwort,erfassungswert(fnrgeheimwort));putwert(fnrbenutzberecht,
+felderinstring)END PROC setzewertefuerdbspeicherung;PROC
+setzeidentiobjektfuerobjektliste:LET trennsymbolfuerobli="$";TEXT VAR
+identizeile;identizeile:=wert(fnrbenutzname)+trenner+wert(fnrbenutzberecht);
+identizeile:=subtext(identizeile,1,maxidentizeilenlaenge);setzeidentiwert(
+identizeilemitschluesselanhang).identizeilemitschluesselanhang:identizeile+
+trennsymbolfuerobli+wert(fnrbenutzname).END PROC
+setzeidentiobjektfuerobjektliste;PROC benutzerlesen:inittupel(dnrbenutz);
+putwert(fnrbenutzbestand,bestand);putwert(fnrbenutzname,erfassungswert(
+fnrschluessel));search(dnrbenutz,TRUE );IF dbstatus=okTHEN saveupdateposition
+(dnrbenutz)FI END PROC benutzerlesen;PROC benutzeraendern:
+restoreupdateposition(dnrbenutz);update(dnrbenutz);logbucheintrag("Änderung")
+END PROC benutzeraendern;PROC benutzereinfuegen:insert(dnrbenutz);
+logbucheintrag("Neueinfügen")END PROC benutzereinfuegen;PROC benutzerloeschen
+:delete(dnrbenutz);logbucheintrag("Entfernen")END PROC benutzerloeschen;PROC
+logbucheintrag(TEXT CONST logergaenzung):TEXT VAR eintrag:="Anw. 10.5.1 ";
+eintragCAT logergaenzung;eintragCAT " """;eintragCAT schluessel;eintragCAT
+"""";logeintrag(eintrag)END PROC logbucheintrag;TEXT PROC schluessel:
+erfassungswert(fnrschluessel)END PROC schluessel;END PACKET
+erfbenutzerberechtigungen
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.erf.meldungen b/app/baisy/2.2.1-schulis/src/isp.erf.meldungen
new file mode 100644
index 0000000..b431202
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.erf.meldungen
@@ -0,0 +1,40 @@
+PACKET isperfmeldungenDEFINES erfassungmeldungen:LET maskenname=
+"mu erf abkuerzungen",maxschluessellaenge=4,fnrschluessel=2,fnrletztesfeld=4,
+fnrlangtext=4,trenner=" = ",leer="";INT VAR dateinummer:=0;PROC
+erfassungmeldungen(INT CONST proznr):systemdbon;SELECT proznrOF CASE 1:
+setzeerfassungsparameterCASE 2:zeigeschluesselzurbearbeitungCASE 3:
+pruefeplausibilitaetCASE 4:setzewertefuerdbspeicherungCASE 5:
+setzeidentiobjektfuerobjektlisteCASE 6:meldunglesenCASE 7:meldungaendernCASE
+8:meldungeinfuegenCASE 9:meldungloeschenENDSELECT ;END PROC
+erfassungmeldungen;PROC setzeerfassungsparameter:dateinummer:=dnrmeld;
+setzeerfassungsparameter(dateinummer,maxschluessellaenge,maskenname,
+fnrletztesfeld)END PROC setzeerfassungsparameter;PROC
+zeigeschluesselzurbearbeitung:setzeerfassungsfeld(wert(fnrmeldungstext),
+fnrlangtext)END PROC zeigeschluesselzurbearbeitung;PROC pruefeplausibilitaet:
+INT VAR fehlerstatus;pruefe(2,erfassungsmaske,TEXT PROC (INT CONST )
+erfassungswert,fnrschluessel,1,9999,leer,fehlerstatus);IF fehlerstatus<>0
+THEN setzefehlerstatus(fehlerstatus);FI END PROC pruefeplausibilitaet;PROC
+setzewertefuerdbspeicherung:putintwert(fnrmeldungsname,int(erfassungswert(
+fnrschluessel)));search(dnrmeld,TRUE );putwert(fnrmeldungstext,erfassungswert
+(fnrlangtext))END PROC setzewertefuerdbspeicherung;PROC
+setzeidentiobjektfuerobjektliste:LET trennsymbolfuerobli="$";TEXT VAR
+identizeile;identizeile:=text(intwert(fnrmeldungsname))+trenner+wert(
+fnrmeldungstext);identizeile:=subtext(identizeile,1,maxidentizeilenlaenge);
+setzeidentiwert(identizeilemitschluesselanhang).
+identizeilemitschluesselanhang:identizeile+trennsymbolfuerobli+text(intwert(
+fnrmeldungsname)).END PROC setzeidentiobjektfuerobjektliste;PROC meldunglesen
+:INT VAR fehlerstatus;pruefe(2,erfassungsmaske,TEXT PROC (INT CONST )
+erfassungswert,fnrschluessel,1,9999,leer,fehlerstatus);IF fehlerstatus=0THEN
+inittupel(dnrmeld);putintwert(fnrmeldungsname,int(schluessel));search(dnrmeld
+,TRUE );IF dbstatus=okTHEN saveupdateposition(dnrmeld)FI ELSE dbstatus(
+notfound)FI END PROC meldunglesen;PROC meldungaendern:restoreupdateposition(
+dnrmeld);update(dnrmeld);logbucheintrag("geändert")END PROC meldungaendern;
+PROC meldungeinfuegen:insert(dnrmeld);logbucheintrag("eingefügt")END PROC
+meldungeinfuegen;PROC meldungloeschen:putintwert(fnrmeldungsname,int(
+schluessel));search(dnrmeld,TRUE );IF dbstatus=okTHEN delete(dnrmeld);
+logbucheintrag("gelöscht")FI END PROC meldungloeschen;PROC logbucheintrag(
+TEXT CONST logergaenzung):TEXT VAR eintrag:="Meldung ";eintragCAT schluessel;
+eintragCAT " ";eintragCAT logergaenzung;logeintrag(eintrag)END PROC
+logbucheintrag;TEXT PROC schluessel:erfassungswert(fnrschluessel)END PROC
+schluessel;END PACKET isperfmeldungen
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.erf.steueroperationen b/app/baisy/2.2.1-schulis/src/isp.erf.steueroperationen
new file mode 100644
index 0000000..87654f0
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.erf.steueroperationen
@@ -0,0 +1,258 @@
+PACKET isperfsteueroperationenDEFINES
+erfassungsbildschirmaufbauenundvonerfassungsbildschirmeinlesen,
+vonerfassungsbildschirmeinlesen,maskezeigenundallefeldereinlesen,
+allesvonerfassungsbildschirmeinlesen,schluesselbearbeiten,
+bearbeitetenschluesseleinlesen,angegebenedatenpruefenundevtlspeichern,
+schluesselloeschvorbereitung,schluesselloeschfrage,schluesselloeschen,
+neuenschluesseleinfuegen,schluesselzeigen,datensatzzeigen,
+ausgesuchtezurbearbeitung,ausgesuchtezumloeschen,zurueckzureinzelbearbeitung,
+erfassungswert,setzeerfassungsfeld,erfassungsmaske,setzefehlerstatus,
+setzeerfassungsparameter,erfassungsfelder,datumskonversion,datumrekonversion:
+LET fnrschluessel=2,fnrschluessellaenge=3,fnrerstesfeld=4;LET erfparamsetzen=
+1,erfwertezeigen=2,erfwertepruefen=3,erfwerteindbwerte=4,erfwertelesen=6,
+erfwerteaendern=7,erfwerteeinfuegen=8,erfwerteloeschen=9;LET
+meldungloeschfrage=65,meldungspeicherung=50,meldungloeschung=61,
+meldungkeineloeschung=62,meldungkeineaenderung=63,meldunggibtsschon=64,
+meldunggibtsnicht=66,meldungletzter=67,meldungkeineliste=68,
+meldunglistenerstellung=7,pruefemeldung=57,meldungschluesselzulang=60,
+meldungnichteingefuegt=70;LET dateiname="Liste zu den allgemeinen Diensten",
+leer="",null=0,oblitrenner="$";LET dateinummerschluessel=137;BOOL VAR
+neuerschluessel:=FALSE ;LET maxfelderzahl=100;ROW maxfelderzahlTEXT VAR
+erfassungsfeld;TAG VAR maske;INT VAR startpos;FILE VAR f;TEXT VAR
+programmname,aktschluessel;TEXT VAR aktmaskenname;INT VAR
+aktmaxschluessellaenge,aktindex,aktdateinummer;INT VAR anzschlfelder:=1;INT
+VAR fnraktletztesfeld,fnrakterstesfeld;INT VAR fnrfehlerhaftesfeld;PROC
+erfassungsbildschirmaufbauenundvonerfassungsbildschirmeinlesen(PROC (INT
+CONST )erfassungspeziell):erfassungspeziell(erfparamsetzen);startprozedur;
+erfassungsbildschirmaufbauen;startpos:=fnrschluessel;
+vonerfassungsbildschirmeinlesen.END PROC
+erfassungsbildschirmaufbauenundvonerfassungsbildschirmeinlesen;PROC
+maskezeigenundallefeldereinlesen(PROC (INT CONST )erfassungspeziell):
+erfassungspeziell(erfparamsetzen);startprozedur;
+erfassungsbildschirmganzaufbauen;allesvonerfassungsbildschirmeinlesen.END
+PROC maskezeigenundallefeldereinlesen;PROC startprozedur:
+programminitialisieren;bildschirminitialisieren.END PROC startprozedur;PROC
+programminitialisieren:page;programmnameholen;standardkopfmaskeausgeben(
+programmname).programmnameholen:programmname:=text(vergleichsknoten).END
+PROC programminitialisieren;PROC bildschirminitialisieren:initmaske(maske,
+aktmaskenname);erfassungsfelderzumanfanginitialisieren.
+erfassungsfelderzumanfanginitialisieren:INT VAR i;FOR iFROM 1UPTO min(
+maxfelderzahl,(fnraktletztesfeld+5))REP erfassungsfeld(i):=""PER .END PROC
+bildschirminitialisieren;PROC erfassungsbildschirmaufbauen:
+standardkopfmaskeaktualisieren(programmname);erfassungsmaskeausgeben;
+felderzurausgabevorbereiten;felderausgeben.erfassungsmaskeausgeben:show(maske
+).felderzurausgabevorbereiten:IF schluessellaengenichtzuberuecksichtigenTHEN
+fnrakterstesfeld:=fnrschluessellaengeELSE fnrakterstesfeld:=fnrerstesfeld;
+erfassungsfeld(fnrschluessellaenge):=text(aktmaxschluessellaenge)FI ;protect(
+maske,fnrakterstesfeld,fnraktletztesfeld+1,TRUE );loeschfeldverdecken.
+schluessellaengenichtzuberuecksichtigen:aktmaxschluessellaenge=0.
+loeschfeldverdecken:LET rahmenzeichen="=";erfassungsfeld(fnraktletztesfeld+1)
+:=rahmenzeichen.felderausgeben:put(maske,erfassungsfeld,1);startpos:=
+fnrschluessel.END PROC erfassungsbildschirmaufbauen;PROC
+erfassungsbildschirmganzaufbauen:standardkopfmaskeaktualisieren(programmname)
+;erfassungsmaskeausgeben;felderzurausgabevorbereiten;loeschfeldverdecken.
+erfassungsmaskeausgeben:show(maske).felderzurausgabevorbereiten:
+fnrakterstesfeld:=fnrschluessel+anzschlfelder;.loeschfeldverdecken:LET
+rahmenzeichen="=";erfassungsfeld(fnraktletztesfeld+1):=rahmenzeichen;protect(
+maske,fnraktletztesfeld+1,TRUE ).END PROC erfassungsbildschirmganzaufbauen;
+PROC vonerfassungsbildschirmeinlesen:schluesseleinlesen.schluesseleinlesen:
+get(maske,erfassungsfeld,startpos).END PROC vonerfassungsbildschirmeinlesen;
+PROC allesvonerfassungsbildschirmeinlesen:put(maske,erfassungsfeld,1);
+startpos:=fnrschluessel;get(maske,erfassungsfeld,startpos)END PROC
+allesvonerfassungsbildschirmeinlesen;PROC schluesselbearbeiten(PROC (INT
+CONST )erfassungspeziell):BOOL VAR schluesselexistiert:=FALSE ;loeschemeldung
+(maske);aktschluessel:=erfassungsfeld(fnrschluessel);datendirektlesen(PROC (
+INT CONST )erfassungspeziell,schluesselexistiert);IF schluesselexistiertTHEN
+zeigeschluesselzurbearbeitung(PROC (INT CONST )erfassungspeziell);
+bearbeitetenschluesseleinlesenELSE melde(maske,meldunggibtsnicht);return(1)
+FI .END PROC schluesselbearbeiten;PROC zeigeschluesselzurbearbeitung(PROC (
+INT CONST )erfassungspeziell):neuerschluessel:=FALSE ;protect(maske,
+fnrakterstesfeld,fnraktletztesfeld,FALSE );erfassungspeziell(erfwertezeigen);
+aktschluessel:=erfassungsfeld(fnrschluessel);startpos:=fnrschluessel;put(
+maske,erfassungsfeld,startpos);END PROC zeigeschluesselzurbearbeitung;PROC
+bearbeitetenschluesseleinlesen:get(maske,erfassungsfeld,startpos);END PROC
+bearbeitetenschluesseleinlesen;PROC angegebenedatenpruefenundevtlspeichern(
+BOOL CONST zuspeichern,PROC (INT CONST )erfassungspeziell):INT VAR schritte;
+IF zuspeichernTHEN speichernteil;ELSE nichtspeichernteil;FI .
+nichtspeichernteil:meldeauffaellig(maske,meldungkeineaenderung);
+vorbereitendernaechstenschluesselbehandlung(schritte,PROC erfassungspeziell);
+return(schritte).speichernteil:fnrfehlerhaftesfeld:=0;
+pruefeplausibilitaetallgemein(PROC (INT CONST )erfassungspeziell);IF
+datenfehlerfreiTHEN erfassungspeziell(erfwertepruefen)FI ;IF datenfehlerfrei
+THEN BOOL VAR satzgeschrieben;datenwegschreiben;IF NOT satzgeschriebenAND
+neuerschluesselTHEN melde(maske,meldungnichteingefuegt);return(1)ELSE
+vorbereitendernaechstenschluesselbehandlung(schritte,PROC erfassungspeziell);
+return(schritte)FI ELSE fehlerbehandeln;return(1)FI .datenwegschreiben:
+meldespeicherung;datenindatenbankspeichern.datenindatenbankspeichern:
+erfassungspeziell(erfwerteindbwerte);IF neuerschluesselTHEN
+neuenschluesseleinfuegenELSE bearbeitetenschluesselzurueckschreibenFI .
+bearbeitetenschluesselzurueckschreiben:erfassungspeziell(erfwerteaendern);.
+neuenschluesseleinfuegen:erfassungspeziell(erfwerteeinfuegen);satzgeschrieben
+:=dbstatus=0.meldespeicherung:melde(maske,meldungspeicherung).datenfehlerfrei
+:fnrfehlerhaftesfeld=0.fehlerbehandeln:startpos:=fnrfehlerhaftesfeld.END
+PROC angegebenedatenpruefenundevtlspeichern;PROC schluesselloeschvorbereitung
+(PROC (INT CONST )erfassungspeziell):BOOL VAR schluesselexistiert:=FALSE ;
+loeschemeldung(maske);aktschluessel:=erfassungsfeld(fnrschluessel);
+datendirektlesen(PROC (INT CONST )erfassungspeziell,schluesselexistiert);IF
+schluesselexistiertTHEN loeschennachfrage(PROC (INT CONST )erfassungspeziell)
+;schluesselloeschfrageELSE melde(maske,meldunggibtsnicht);return(1)FI .END
+PROC schluesselloeschvorbereitung;PROC loeschennachfrage(PROC (INT CONST )
+erfassungspeziell):zeigeschluesselzurbearbeitung(PROC (INT CONST )
+erfassungspeziell);melde(maske,meldungloeschfrage);protect(maske,
+fnrschluessel,TRUE );END PROC loeschennachfrage;PROC schluesselloeschfrage:
+TEXT VAR xy;startpos:=fnraktletztesfeld+1;get(maske,xy,startpos).END PROC
+schluesselloeschfrage;PROC schluesselloeschen(BOOL CONST zuloeschen,PROC (
+INT CONST )erfassungspeziell):INT VAR schritte;IF zuloeschenTHEN melde(maske,
+meldungloeschung);erfassungspeziell(erfwerteloeschen);IF dbstatus<>0THEN put(
+maske,("Löschen - Fehlerstatus: "+text(dbstatus)),1);pauseFI ELSE melde(maske
+,meldungkeineloeschung)FI ;vorbereitendernaechstenschluesselbehandlung(
+schritte,PROC erfassungspeziell);return(schritte).END PROC schluesselloeschen
+;PROC neuenschluesseleinfuegen(PROC (INT CONST )erfassungspeziell):BOOL VAR
+schluesselexistiert;loeschemeldung(maske);aktschluessel:=erfassungsfeld(
+fnrschluessel);pruefeneuenschluessel(PROC (INT CONST )erfassungspeziell,
+schluesselexistiert);IF schluesselexistiertTHEN melde(maske,meldunggibtsschon
+);return(1)ELSE neuerschluesselvorbereitung;bearbeitetenschluesseleinlesenFI
+.neuerschluesselvorbereitung:neuerschluessel:=TRUE ;protect(maske,
+fnrakterstesfeld,fnraktletztesfeld,FALSE );startpos:=fnrschluessel;put(maske,
+erfassungsfeld,startpos).END PROC neuenschluesseleinfuegen;PROC
+pruefeneuenschluessel(PROC (INT CONST )erfassungspeziell,BOOL VAR existiert):
+TEXT VAR schluessel:=compress(erfassungsfeld(fnrschluessel));existiert:=
+FALSE ;IF schluessel<>leerTHEN datendirektlesen(PROC (INT CONST )
+erfassungspeziell,existiert);existiert:=dbstatus=0;FI .END PROC
+pruefeneuenschluessel;PROC vorbereitendernaechstenschluesselbehandlung(INT
+VAR schritte,PROC (INT CONST )erfassungspeziell):IF exists(dateiname)THEN
+holenaechstenschluesselauslisteELSE bereitenaechstebenutzereingabevor;
+schritte:=2FI .holenaechstenschluesselausliste:BOOL VAR ok,
+kannbearbeitetwerden:=FALSE ;TEXT VAR oblischl2:="";
+holenaechstenschluesselausdatei(aktschluessel,oblischl2,ok);WHILE okREP
+erfassungsfeld(fnrschluessel):=aktschluessel;datendirektlesen(PROC (INT
+CONST )erfassungspeziell,ok);IF okTHEN kannbearbeitetwerden:=TRUE ;ok:=FALSE
+ELSE holenaechstenschluesselausdatei(aktschluessel,oblischl2,ok)FI PER ;IF
+kannbearbeitetwerdenTHEN zeigeschluesselzurbearbeitung(PROC (INT CONST )
+erfassungspeziell);startpos:=fnrschluessel;put(maske,erfassungsfeld,startpos)
+;schritte:=1ELSE behandleendederlistenabarbeitung;schritte:=3FI .
+behandleendederlistenabarbeitung:melde(maske,meldungletzter);pause(20);
+bereitenaechstebenutzereingabevor.bereitenaechstebenutzereingabevor:protect(
+maske,fnrschluessel,FALSE );protect(maske,fnrakterstesfeld,fnraktletztesfeld,
+TRUE );erfassungsfelderinitialisieren;startpos:=fnrschluessel;put(maske,
+erfassungsfeld,startpos).END PROC vorbereitendernaechstenschluesselbehandlung
+;PROC schluesselzeigen(PROC (INT CONST )erfassungspeziell):schluesselzeigen(
+PROC (INT CONST )erfassungspeziell,FALSE ,BOOL PROC pruefungdummy)END PROC
+schluesselzeigen;PROC schluesselzeigen(PROC (INT CONST )erfassungspeziell,
+BOOL CONST scanja,BOOL PROC pruefungspeziell):IF aktindex=
+dateinummerschluesselTHEN systemdboff;datensatzzeigen(PROC (INT CONST )
+erfassungspeziell,scanja,BOOL PROC pruefungspeziell);LEAVE schluesselzeigen
+FI ;BOOL VAR listeexistiertnicht:=FALSE ;TEXT VAR sicherungstupel;systemdbon;
+savetupel(aktdateinummer,sicherungstupel);melde(maske,meldunglistenerstellung
+);systemdbon;restoretupel(aktdateinummer,sicherungstupel);systemdboff;
+aktschluessel:=erfassungsfeld(fnrschluessel);objektlistestarten(aktindex,
+aktschluessel,FALSE ,listeexistiertnicht);IF listeexistiertnichtTHEN melde(
+maske,meldungkeineliste);return(1)ELSE objektlistenausgabe(PROC (INT CONST )
+erfassungspeziell,scanja,BOOL PROC pruefungspeziell)FI END PROC
+schluesselzeigen;PROC datensatzzeigen(PROC (INT CONST )erfassungspeziell):
+datensatzzeigen(PROC (INT CONST )erfassungspeziell,FALSE ,BOOL PROC
+pruefungdummy)END PROC datensatzzeigen;PROC datensatzzeigen(PROC (INT CONST )
+erfassungspeziell,BOOL CONST scanja,BOOL PROC pruefungspeziell):BOOL VAR
+listeexistiertnicht:=FALSE ;melde(maske,meldunglistenerstellung);
+aktschluessel:=erfassungsfeld(fnrschluessel);objektlistestarten(aktindex,
+aktschluessel,TRUE ,#26.03.87#listeexistiertnicht);IF listeexistiertnicht
+THEN melde(maske,meldungkeineliste);return(1)ELSE datensatzlistenausgabe(
+PROC (INT CONST )erfassungspeziell,scanja,BOOL PROC pruefungspeziell)FI .END
+PROC datensatzzeigen;PROC ausgesuchtezurbearbeitung(PROC (INT CONST )
+erfassungspeziell):BOOL VAR ok,kannbearbeitetwerden:=FALSE ;
+objektlistebeenden(dateiname,TRUE );TEXT VAR oblischl2;
+holeerstenschluesselausdatei(aktschluessel,oblischl2,ok);WHILE okREP
+erfassungsfeld(fnrschluessel):=aktschluessel;datendirektlesen(PROC (INT
+CONST )erfassungspeziell,ok);IF okTHEN kannbearbeitetwerden:=TRUE ;ok:=FALSE
+ELSE holenaechstenschluesselausdatei(aktschluessel,oblischl2,ok)FI PER ;IF
+kannbearbeitetwerdenTHEN erfassungsbildschirmaufbauen;
+zeigeschluesselzurbearbeitung(PROC (INT CONST )erfassungspeziell);
+bearbeitetenschluesseleinlesenELSE erfassungsfelderinitialisieren;
+erfassungsbildschirmaufbauen;return(2)FI .END PROC ausgesuchtezurbearbeitung;
+PROC ausgesuchtezumloeschen(PROC (INT CONST )erfassungspeziell):BOOL VAR ok,
+kannbearbeitetwerden:=FALSE ;objektlistebeenden(dateiname,TRUE );TEXT VAR
+oblischl2;holeerstenschluesselausdatei(aktschluessel,oblischl2,ok);WHILE ok
+REP erfassungsfeld(fnrschluessel):=aktschluessel;datendirektlesen(PROC (INT
+CONST )erfassungspeziell,ok);IF okTHEN kannbearbeitetwerden:=TRUE ;ok:=FALSE
+ELSE holenaechstenschluesselausdatei(aktschluessel,oblischl2,ok)FI PER ;IF
+kannbearbeitetwerdenTHEN erfassungsbildschirmaufbauen;loeschennachfrage(PROC
+(INT CONST )erfassungspeziell);schluesselloeschfrageELSE
+erfassungsfelderinitialisieren;erfassungsbildschirmaufbauen;return(2)FI .END
+PROC ausgesuchtezumloeschen;PROC datendirektlesen(PROC (INT CONST )
+erfassungspeziell,BOOL VAR dirok):erfassungspeziell(erfwertelesen);dirok:=
+dbstatus=0;END PROC datendirektlesen;PROC erfassungsfelderinitialisieren:
+erfassungsfeld(fnrschluessel):="";INT VAR feldnr;FOR feldnrFROM
+fnrakterstesfeldUPTO fnraktletztesfeldREP erfassungsfeld(feldnr):="";PER .
+END PROC erfassungsfelderinitialisieren;PROC holeerstenschluesselausdatei(
+TEXT VAR feld1,feld2,BOOL VAR ok):IF NOT exists(dateiname)THEN ok:=FALSE ;
+LEAVE holeerstenschluesselausdateiFI ;f:=sequentialfile(input,dateiname);
+holenaechstenschluesselausdatei(feld1,feld2,ok);END PROC
+holeerstenschluesselausdatei;PROC holenaechstenschluesselausdatei(TEXT VAR
+feld1,feld2,BOOL VAR ok):TEXT VAR thesaurustext:="";IF eof(f)THEN ok:=FALSE ;
+loeschedieerstellteobjektlisteELSE getline(f,thesaurustext);
+bestimmeschluesselausthesaurustext;ok:=TRUE FI .
+bestimmeschluesselausthesaurustext:INT VAR schluesselbeginn:=pos(
+thesaurustext,oblitrenner);INT VAR schluesseltrennung:=pos(thesaurustext,
+oblitrenner,schluesselbeginn+1);IF schluesseltrennung>0THEN feld1:=subtext(
+thesaurustext,schluesselbeginn+1,schluesseltrennung-1);feld2:=subtext(
+thesaurustext,schluesseltrennung+1)ELSE feld1:=subtext(thesaurustext,
+schluesselbeginn+1);feld2:=leerFI .END PROC holenaechstenschluesselausdatei;
+PROC loeschedieerstellteobjektliste:forget(dateiname,quiet);END PROC
+loeschedieerstellteobjektliste;PROC put(TAG CONST t,ROW maxfelderzahlTEXT
+VAR pfeld,INT CONST pos):INT VAR i;FOR iFROM posUPTO maxfelderzahlREP IF
+fieldexists(t,i)THEN put(t,pfeld(i),i)FI ;PER ;END PROC put;PROC protect(TAG
+VAR maske,INT CONST anfangfeld,endefeld,BOOL CONST schreibschutz):IF endefeld
+>=anfangfeldTHEN setzefeldschutzfuerdiebenanntenfelderFI .
+setzefeldschutzfuerdiebenanntenfelder:INT VAR feldnr;FOR feldnrFROM
+anfangfeldUPTO endefeldREP protect(maske,feldnr,schreibschutz)PER .END PROC
+protect;PROC pruefeplausibilitaetallgemein(PROC (INT CONST )erfassungspeziell
+):melde(maske,pruefemeldung);INT VAR fehlstatus;pruefe(1,maske,TEXT PROC (
+INT CONST )erfassungswert,fnrschluessel,null,null,leer,fehlstatus);IF
+fehlstatus<>0THEN setzefehlerstatus(fehlstatus);LEAVE
+pruefeplausibilitaetallgemeinFI ;IF schluessellaengemussueberprueftwerden
+THEN IF eingabelaenge>aktmaxschluessellaengeTHEN melde(maske,
+meldungschluesselzulang);setzefehlerstatus(fnrschluessel);LEAVE
+pruefeplausibilitaetallgemeinFI FI ;BOOL VAR schluesselexistiert;IF
+neuerschluesselTHEN pruefeneuenschluessel(PROC (INT CONST )erfassungspeziell,
+schluesselexistiert);IF schluesselexistiertTHEN melde(maske,meldunggibtsschon
+);setzefehlerstatus(fnrschluessel)FI ELSE IF erfassungsfeld(fnrschluessel)<>
+aktschluesselTHEN pruefeneuenschluessel(PROC (INT CONST )erfassungspeziell,
+schluesselexistiert);IF schluesselexistiertTHEN setzeaufaltensatzzurueck;
+melde(maske,meldunggibtsschon);setzefehlerstatus(fnrschluessel);ELSE
+setzefehlerstatus(0);FI ELSE setzefehlerstatus(0);FI FI .
+setzeaufaltensatzzurueck:TEXT VAR falscherschluessel:=erfassungsfeld(
+fnrschluessel);erfassungsfeld(fnrschluessel):=aktschluessel;datendirektlesen(
+PROC (INT CONST )erfassungspeziell,schluesselexistiert);erfassungsfeld(
+fnrschluessel):=falscherschluessel.eingabelaenge:length(erfassungsfeld(
+fnrschluessel)).schluessellaengemussueberprueftwerden:aktmaxschluessellaenge>
+0.END PROC pruefeplausibilitaetallgemein;PROC zurueckzureinzelbearbeitung:
+loeschedieerstellteobjektliste;standardkopfmaskeaktualisieren(programmname);
+protect(maske,fnrschluessel,FALSE );protect(maske,fnrakterstesfeld,TRUE );
+erfassungsfelderinitialisieren;startpos:=fnrschluessel;put(maske,
+erfassungsfeld,startpos);return(3);END PROC zurueckzureinzelbearbeitung;PROC
+setzeerfassungsfeld(TEXT CONST feldinhalt,INT CONST feldnr):erfassungsfeld(
+feldnr):=feldinhaltEND PROC setzeerfassungsfeld;TEXT PROC erfassungswert(INT
+CONST feldnr):IF (feldnr>maxfelderzahl)OR (feldnr<1)THEN ""ELSE
+erfassungsfeld(feldnr)FI .END PROC erfassungswert;ROW 100TEXT PROC
+erfassungsfelder:erfassungsfeldEND PROC erfassungsfelder;TAG PROC
+erfassungsmaske:maskeEND PROC erfassungsmaske;PROC setzefehlerstatus(INT
+CONST feldnr):fnrfehlerhaftesfeld:=feldnr.END PROC setzefehlerstatus;PROC
+setzeerfassungsparameter(INT CONST dateinummer,INT CONST schluessellaenge,
+TEXT CONST maskenname,INT CONST letzteserfassungsfeld):aktindex:=dateinummer;
+aktdateinummer:=dateinr(primdatid(dateinummer));aktmaxschluessellaenge:=
+schluessellaenge;aktmaskenname:=maskenname;fnraktletztesfeld:=
+letzteserfassungsfeld;anzschlfelder:=anzkey(dateinr(primdatid(aktdateinummer)
+));END PROC setzeerfassungsparameter;PROC setzeerfassungsparameter(INT CONST
+dateinummer,TEXT CONST maskenname,INT CONST letzteserfassungsfeld):LET
+keineschluessellaenge=0;setzeerfassungsparameter(dateinummer,
+keineschluessellaenge,maskenname,letzteserfassungsfeld).END PROC
+setzeerfassungsparameter;TEXT PROC datumskonversion(TEXT CONST datum):TEXT
+VAR d:=datum;IF nurblanksoderleer(datum)OR d=" . . "THEN "01.01.00"ELSE
+changeall(d," ","0");IF nochnichtkonvertiertTHEN insertchar(d,".",3);
+insertchar(d,".",6);FI ;dFI .nochnichtkonvertiert:pos(d,".")=0.ENDPROC
+datumskonversion;BOOL PROC nurblanksoderleer(TEXT CONST t):INT VAR i;FOR i
+FROM 1UPTO length(t)REP IF (tSUB i)<>" "THEN LEAVE nurblanksoderleerWITH
+FALSE FI PER ;TRUE ENDPROC nurblanksoderleer;TEXT PROC datumrekonversion(
+TEXT CONST datum):TEXT VAR d:=datum;changeall(d,".","");IF d="010100"THEN d:=
+""FI ;dENDPROC datumrekonversion;END PACKET isperfsteueroperationen
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.init baisy server b/app/baisy/2.2.1-schulis/src/isp.init baisy server
new file mode 100644
index 0000000..98044ba
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.init baisy server
@@ -0,0 +1,4 @@
+PACKET ispinitbaisyserverDEFINES initbs,baisyserver:TASK VAR bs;PROC initbs:
+bs:=/"baisy server"END PROC initbs;TASK PROC baisyserver:bsEND PROC
+baisyserver;initbsEND PACKET ispinitbaisyserver;
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.knoten b/app/baisy/2.2.1-schulis/src/isp.knoten
new file mode 100644
index 0000000..6af3e22
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.knoten
@@ -0,0 +1,137 @@
+PACKET knotenDEFINES systembaum,setzesystembaumundaktuellenknoten,
+generierebaisymonitor,KNOTEN ,STACK ,KNOTENMENGE ,leeremenge,nilknoten,
+leererstack,anfangsknotenholen,einzelknotenholen,erster,weitere,naechster,
+attribute,maske,task,text,nummer,vorprozedur,nachprozedur,taste,isrefinement,
+isopen,knotenaufrufindex,HAT ,zahlderelemente,mengedernachfolger,:=,=,push,
+pop,hoehe,voll,leer:LET maxhoehe=20,bottom=1;LET maxkn=2190;TYPE LONGROW =
+TEXT ;TYPE KNOTENMENGE =INT ;TYPE KNOTEN =STRUCT (INT zeile,index);TYPE
+INTKNOTEN =INT ;TYPE EINTRAG =STRUCT (TEXT attribute,INTKNOTEN vater,LONGROW
+knotenmengenLONGROW knoten);TYPE SYSTAB =STRUCT (INT maxeintrag,ersterfreier,
+ROW maxknEINTRAG zeile);KNOTEN CONST nilknoten:=KNOTEN :(0,0);BOUND SYSTAB
+VAR sysbaum;TYPE STACK =STRUCT (ROW maxhoeheKNOTEN st,INT top);LET maxat=6,
+tepos=1,mpos=2,vpos=3,npos=4,tpos=5,ppos=6;LET scanid=1;DATASPACE VAR ds;
+BOOL VAR verteilteraufruf;INT VAR newkind;TEXT VAR newsymbol;TEXT VAR
+pruefstack;BOOL PROC isid:(newkind=scanid)END PROC isid;PROC next:nextsymbol(
+newsymbol,newkind);END PROC next;PROC next(TEXT CONST proz):scan(proz);next
+END PROC next;BOOL PROC prozedurexistiert(TEXT CONST prozname):BOOL VAR da:=
+false;scanstring(da,prozname);da.END PROC prozedurexistiert;PROC scanstring(
+BOOL VAR da,TEXT CONST str):procpos:=1;next(str);analyse(da);WHILE NOT
+schlussREP next(subtext(str,procpos+4));IF isidTHEN analyse(da)ELSE da:=false
+FI ;procposINCR 1PER .schluss:INT VAR procpos:=pos(str,"PROC",procpos);
+procpos=0.END PROC scanstring;PROC analyse(BOOL VAR da):IF schongeprueftTHEN
+da:=trueELSE da:=analyseergebnis(newsymbol);IF daTHEN alsgeprueftvermerkenFI
+FI .schongeprueft:pos(pruefstack,pruefname(newsymbol))>0.alsgeprueftvermerken
+:pruefstackCAT pruefname(newsymbol).END PROC analyse;BOOL PROC
+analyseergebnis(TEXT CONST prozname):pruefungvorbereiten;IF iserrorTHEN
+breakabfangen;falseELSE trueFI .pruefungvorbereiten:disablestop;type("�q");
+help(prozname).breakabfangen:TEXT VAR br:="";editget(br);clearerror.END PROC
+analyseergebnis;TEXT PROC pruefname(TEXT CONST name):"/"+name+"/"END PROC
+pruefname;TEXT PROC prozedur(TEXT CONST pname):IF pname<>""THEN IF
+prozedurexistiert(pname)THEN pnameELSE "return(1)"FI ELSE pnameFI END PROC
+prozedur;PROC generierebaisymonitor(TEXT CONST teilbaumname):LET maxcase=510;
+startemonitordatei;naechstezeile;WHILE NOT tabellenendeREP neuescase;
+naechstezeilePER ;schlusszeilen.startemonitordatei:richtedateiein;
+anfangszeile.richtedateiein:TEXT CONST monitorname:=teilbaumname+" monitor";
+forget(monitorname,quiet);FILE VAR f:=sequentialfile(output,monitorname).
+anfangszeile:putline(f,
+"PACKET baisymonitor DEFINES call,starten ueber monitor:");TEXT VAR anfaenge
+:="";INT VAR tabind:=0;INT VAR caseproczahl:=0;INT VAR aktcasezahl:=0;INT
+VAR maxtabeintrag:=sysbaum.ersterfreier-1;pruefstack:="".naechstezeile:
+aktcasezahlINCR 1;tabindINCR 1;cout(tabind).tabellenende:tabind>maxtabeintrag
+.neuescase:IF aktcasezahl=1THEN neuecaseprocFI ;casewennnoetig;IF aktcasezahl
+=maxcaseTHEN schlusscaseprocFI .neuecaseproc:caseproczahlINCR 1;putline(f,
+"PROC case"+text(caseproczahl)+"(INT CONST i,BOOL CONST vor):");putline(f,
+"SELECT i OF").casewennnoetig:IF gueltigezeileTHEN KNOTEN VAR k;k.zeile:=
+tabind;TEXT VAR vproc:=prozedur(vorprozedur(k));IF vproc<>""THEN vprocteil;
+TEXT VAR nproc:=prozedur(nachprozedur(k));IF nproc<>""THEN nprocteilELSE put(
+f,"FI");line(f)FI FI FI .gueltigezeile:CONCR (sysbaum.zeile(tabind).vater)>=0
+.vprocteil:put(f,"CASE "+text(aktcasezahl)+": ");put(f,"IF vor THEN "+vproc).
+nprocteil:put(f," ELSE "+nproc+" FI");line(f).schlusszeilen:schlusscaseproc;
+procanfang;ifabfragen;procundpacketende.schlusscaseproc:putline(f,
+"END SELECT");putline(f,"END PROC case"+text(caseproczahl)+";");aktcasezahl:=
+0;anfaengeCAT text(tabind,4).procanfang:putline(f,"PROC call"+
+"(INT CONST i,BOOL CONST vor,TEXT CONST t):").ifabfragen:INT VAR ifzahl:=
+caseproczahl-1;IF ifzahl=0THEN einfacherfallELIF ifzahl=1THEN erstesif;
+elseteilELSE erstesif;alleelifs;elseteilFI .caseaufruf:TEXT VAR zusatz:="";
+TEXT VAR decr:=subtext(anfaenge,basis-3,basis);IF decr<>""THEN zusatz:=" - "+
+decrFI ;put(f,"case"+text(aktcaseindex)+"(i"+zusatz+",vor)");.einfacherfall:
+put(f,"case1(i,vor)");line(f).erstesif:INT VAR aktcaseindex;basis:=0;put(f,
+"IF i<="+subtext(anfaenge,1,4)+" THEN");einfacherfall.alleelifs:INT VAR elif;
+FOR elifFROM 1UPTO ifzahl-1REP neueselifPER .neueselif:put(f,"ELIF ");
+aktcaseindex:=elif+1;INT VAR basis:=elif*4;put(f,"i <="+subtext(anfaenge,
+basis+1,basis+4)+" THEN");caseaufruf;line(f).elseteil:put(f,"ELSE ");basis
+INCR 4;aktcaseindex:=ifzahl+1;caseaufruf;putline(f," FI").procundpacketende:
+putline(f,"END PROC call;");putline(f,"PROC starten ueber monitor:");putline(
+f,"start baisy("""+teilbaumname+
+""",PROC (INT CONST,BOOL CONST,TEXT CONST) call)");putline(f,
+"END PROC starten ueber monitor");putline(f,"END PACKET baisymonitor");
+pruefstack:="".END PROC generierebaisymonitor;DATASPACE PROC systembaum:ds
+END PROC systembaum;KNOTEN VAR aktuellerknoten;PROC
+setzesystembaumundaktuellenknoten(DATASPACE CONST d,INT CONST s):ds:=d;
+aktuellerknoten.zeile:=sEND PROC setzesystembaumundaktuellenknoten;PROC
+kopplesystembauman(TEXT CONST name):forget(ds);ladesystembaum(ds,name);
+sysbaum:=dsEND PROC kopplesystembauman;PROC anfangsknotenholen(TEXT CONST
+name,KNOTEN VAR k,BOOL VAR ok):schaltersetzen;vglkn:=nilknoten;IF NOT
+verteilteraufrufTHEN kopplesystembauman(name);suche(k,ok)ELSE ok:=TRUE ;
+sysbaum:=ds;k:=aktuellerknotenFI .schaltersetzen:verteilteraufruf:=name="".
+END PROC anfangsknotenholen;PROC einzelknotenholen(TEXT CONST name,KNOTEN
+VAR einzelknoten,BOOL VAR ok):IF NOT verteilteraufrufTHEN
+holeindexvoneinzelknoten;IF okTHEN vermerkeihnanletzterstelleFI ELSE
+sucheunterdenangehaengtenindizesFI .holeindexvoneinzelknoten:DATASPACE VAR
+savespace:=ds;kopplesystembauman(name);INT VAR index;suche(index,ok);forget(
+ds);ds:=savespace;forget(savespace);sysbaum:=ds.vermerkeihnanletzterstelle:
+einzelknoten.zeile:=index;sysbaum.maxeintragINCR 1;CONCR (sysbaum.zeile(
+sysbaum.maxeintrag).vater):=einzelknoten.zeile;sysbaum.zeile(sysbaum.
+maxeintrag).attribute:=taste(einzelknoten).sucheunterdenangehaengtenindizes:
+INT VAR i;FOR iFROM sysbaum.ersterfreierUPTO sysbaum.maxeintragREP IF sysbaum
+.zeile(i).attribute=nameTHEN einzelknoten.zeile:=CONCR (sysbaum.zeile(i).
+vater)FI PER .END PROC einzelknotenholen;PROC suche(KNOTEN VAR k,BOOL VAR ok)
+:suche(k.zeile,ok);sysbaum.maxeintragINCR 1;sysbaum.ersterfreier:=sysbaum.
+maxeintrag;CONCR (sysbaum.zeile(sysbaum.maxeintrag).vater):=k.zeileEND PROC
+suche;PROC suche(INT VAR k,BOOL VAR ok):k:=CONCR (sysbaum.zeile(sysbaum.
+ersterfreier).vater);ok:=(k>0)END PROC suche;KNOTENMENGE PROC leeremenge:
+KNOTENMENGE :(0)END PROC leeremenge;STACK PROC leererstack:STACK VAR s;s.top
+:=bottom;sEND PROC leererstack;TEXT PROC knotentexte(KNOTEN CONST k):sysbaum.
+zeile(k.zeile).attributeEND PROC knotentexte;PROC knotentexte(KNOTEN VAR k,
+TEXT CONST t):sysbaum.zeile(k.zeile).attribute:=tEND PROC knotentexte;TEXT
+PROC maske(KNOTEN CONST k):attribut(k,mpos)END PROC maske;TEXT PROC task(
+KNOTEN CONST k):attribut(k,ppos)END PROC task;INT PROC nummer(KNOTEN CONST k)
+:knotenaufrufindex(k)END PROC nummer;TEXT PROC text(KNOTEN CONST k):attribut(
+k,tepos)END PROC text;TEXT PROC vorprozedur(KNOTEN CONST k):attribut(k,vpos)
+END PROC vorprozedur;TEXT PROC nachprozedur(KNOTEN CONST k):attribut(k,npos)
+END PROC nachprozedur;TEXT PROC taste(KNOTEN CONST k):attribut(k,tpos)END
+PROC taste;TEXT VAR attext;TEXT PROC attribut(KNOTEN CONST k,INT CONST i):
+attribute(k);TEXT VAR amuster:="��",emuster:="��";replace(amuster,1,i);
+replace(emuster,1,i+1);INT VAR ende,anfang;anfang:=pos(attext,amuster)+2;IF i
+<maxatTHEN ende:=pos(attext,emuster,anfang)-1;subtext(attext,anfang,ende)
+ELSE subtext(attext,anfang)FI END PROC attribut;KNOTEN VAR vglkn;PROC
+attribute(KNOTEN CONST k):IF NOT (k=vglkn)THEN attext:=knotentexte(k);vglkn:=
+kFI END PROC attribute;BOOL PROC isrefinement(KNOTEN CONST k):attribute(k);(
+attextSUB 1)="1"END PROC isrefinement;BOOL PROC isnormal(KNOTEN CONST k):
+attribute(k);(attextSUB 1)="0"END PROC isnormal;BOOL PROC isopen(KNOTEN
+CONST k):NOT (isrefinement(k)COR isnormal(k))END PROC isopen;OP HAT (KNOTEN
+VAR k,TEXT CONST t):knotentexte(k,t)END OP HAT ;INT PROC zahlderelemente(
+KNOTENMENGE CONST m):length(sysbaum.zeile(CONCR (m)).knoten)END PROC
+zahlderelemente;INT PROC length(LONGROW CONST l):length(CONCR (l))DIV 2END
+PROC length;PROC mengedernachfolger(KNOTEN CONST k,KNOTENMENGE VAR m):CONCR (
+m):=k.zeileEND PROC mengedernachfolger;KNOTEN PROC erster(KNOTENMENGE CONST m
+):KNOTEN VAR k;aktuellemenge:=sysbaum.zeile(CONCR (m)).knoten;aktuellelaenge
+:=length(aktuellemenge);mengenindex:=CONCR (m);k.zeile:=0;k.index:=0;
+naechster(k);kEND PROC erster;LONGROW VAR aktuellemenge;INT VAR
+aktuellelaenge;INT VAR mengenindex;PROC naechster(KNOTEN VAR k):IF (
+aktuellelaenge>0)CAND (k.index<aktuellelaenge)THEN k.indexINCR 1;k.zeile:=
+CONCR (aktuellemenge)ISUB k.indexELSE k:=nilknotenFI END PROC naechster;INT
+PROC knotenaufrufindex(KNOTEN CONST k):k.zeileEND PROC knotenaufrufindex;
+BOOL PROC weitere(KNOTEN CONST k,KNOTENMENGE CONST m):(CONCR (m)=mengenindex)
+CAND (k.index<>0)END PROC weitere;BOOL OP =(KNOTEN CONST k,l):k.zeile=l.zeile
+END OP =;OP :=(KNOTEN VAR ziel,KNOTEN CONST quelle):CONCR (ziel):=CONCR (
+quelle)END OP :=;OP :=(KNOTENMENGE VAR ziel,KNOTENMENGE CONST quelle):CONCR (
+ziel):=CONCR (quelle)END OP :=;OP :=(LONGROW VAR ziel,LONGROW CONST quelle):
+CONCR (ziel):=CONCR (quelle)END OP :=;OP :=(STACK VAR ziel,STACK CONST quelle
+):CONCR (ziel):=CONCR (quelle)END OP :=;PROC push(STACK VAR s,KNOTEN CONST k)
+:IF NOT (s.top=maxhoehe)THEN s.st(s.top):=k;s.topINCR 1FI END PROC push;PROC
+pop(STACK VAR s,KNOTEN VAR k):IF NOT (s.top=bottom)THEN s.topDECR 1;k:=s.st(s
+.top);FI END PROC pop;INT PROC hoehe(STACK CONST s):s.top-1END PROC hoehe;
+BOOL PROC voll(STACK CONST s):s.top=maxhoeheEND PROC voll;BOOL PROC leer(
+STACK CONST s):s.top=bottomEND PROC leer;END PACKET knoten;
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.manager schnittstelle b/app/baisy/2.2.1-schulis/src/isp.manager schnittstelle
new file mode 100644
index 0000000..12ba492
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.manager schnittstelle
@@ -0,0 +1,82 @@
+PACKET ispmanagerschnittstelleDEFINES gibdatenbankkennung,oeffnedatenbank,
+initmaske,maskegibtes,maskeloeschen,maskespeichern,maskeumbenennen,
+maskekopieren,maskenliste,setzemaske,baumverarbeitung,ladesystembaum,
+schulisdbname,#08.02.88dr#baisydbname,#08.02.88dr#setzeschulisdbname,#08.02.
+88dr#setzebaisydbname,#08.02.88dr##dnrausk,dnrbenutz,dnrmeld,fnrauskunftsname
+,fnrschlverz,fnrauskunftstext,fnrbenutzbestand,fnrbenutzname,
+fnrbenutzgeheimwort,fnrbenutzberecht,fnrmeldungsname,fnrmeldungstext#:LET
+PARAM =STRUCT (TEXT textkey1,textkey2,TAG maske);LET pruefen=40,init=41,
+loeschen=42,speichern=43,umbenennen=44,kopieren=45,liste=46,newtree=52;#dr06.
+07.88indasPACKET "isp schulis db nummern"übernommenLET dnrauskuenfte=2,
+fnrauskname=3,fnrauskverz=4,fnrausktext=5,dnrbenutzer=7,fnrbenbestand=8,
+fnrbenname=9,fnrbengwort=10,fnrbenrecht=11,dnrmeldungen=12,fnrmeldname=13,
+fnrmeldtext=14;#LET ack=0,error=2,ende=3,baumverarbeitungbasis=53;DATASPACE
+VAR ds;BOUND PARAM VAR p;LET manager="baisy server";TASK VAR newmanager;INT
+VAR replycode;TEXT VAR schulisdatenbank:="EUMELbase.schulis",baisydatenbank:=
+"EUMELbase.baisy";PROC initdbsneu:neuanmelden;neuinitialisieren.neuanmelden:
+newmanager:=baisyserver;.END PROC initdbsneu;PROC neuinitialisieren:forget(ds
+);ds:=nilspace;p:=dsEND PROC neuinitialisieren;LET KENNUNGALT =STRUCT (TASK
+managerbaisy,managerschulis,INT baisy,schulis);LET DATENBANKKENNUNG =STRUCT (
+TASK newmanager,KENNUNGALT oldmanager);PROC gibdatenbankkennung(DATASPACE
+VAR ds):BOUND DATENBANKKENNUNG VAR dbkennung:=ds;dbkennung.newmanager:=
+newmanager;DATASPACE VAR d:=nilspace;BOUND KENNUNGALT VAR kennung:=d;
+dbkennung.oldmanager:=kennung;forget(d)END PROC gibdatenbankkennung;PROC
+oeffnedatenbank(DATASPACE CONST ds):BOUND DATENBANKKENNUNG VAR dbkennung:=ds;
+newmanager:=dbkennung.newmanager;DATASPACE VAR d:=nilspace;BOUND KENNUNGALT
+VAR kennung:=d;kennung:=dbkennung.oldmanager;oeffneeumelbasebaisydatenbank;#
+oeffnedatenbankalt(d);ersetztdurch#kennung.managerbaisy:=/"ei";kennung.
+managerschulis:=/"ei";kennung.baisy:=999;kennung.schulis:=999;
+neuinitialisierenEND PROC oeffnedatenbank;PROC oeffnedatenbank:
+oeffneeumelbasebaisydatenbank;#oeffnedatenbankalt;#initdbsneuEND PROC
+oeffnedatenbank;PROC oeffnedatenbank(TEXT CONST db):fetchdd(db);IF dbopen(db)
+THEN setzeschulisdbname(db);oeffnedatenbank;systemdboffELSE errorstop(
+"Datenbank der Anwendung konnte nicht geöffnet werden")FI ENDPROC
+oeffnedatenbank;PROC setzebaisydbname(TEXT CONST bdbname):baisydatenbank:=
+bdbnameEND PROC setzebaisydbname;PROC setzeschulisdbname(TEXT CONST sdbname):
+schulisdatenbank:=sdbnameEND PROC setzeschulisdbname;TEXT PROC baisydbname:
+baisydatenbankEND PROC baisydbname;TEXT PROC schulisdbname:schulisdatenbank
+END PROC schulisdbname;PROC oeffneeumelbasebaisydatenbank:fetchdd(baisydbname
+);IF NOT systemdbopen(baisydbname)THEN errorstop("Datenbank "+baisydbname+
+" konnte nicht geöffnet werden")FI ;ENDPROC oeffneeumelbasebaisydatenbank;#
+dr06.07.88indasPACKET "isp.schulis db nummern"übernommenINT PROC dnrausk:
+dnrauskuenfteENDPROC dnrausk;INT PROC fnrauskunftsname:fnrausknameENDPROC
+fnrauskunftsname;INT PROC fnrschlverz:fnrauskverzENDPROC fnrschlverz;INT
+PROC fnrauskunftstext:fnrausktextENDPROC fnrauskunftstext;INT PROC dnrbenutz:
+dnrbenutzerENDPROC dnrbenutz;INT PROC fnrbenutzbestand:fnrbenbestandENDPROC
+fnrbenutzbestand;INT PROC fnrbenutzname:fnrbennameENDPROC fnrbenutzname;INT
+PROC fnrbenutzgeheimwort:fnrbengwortENDPROC fnrbenutzgeheimwort;INT PROC
+fnrbenutzberecht:fnrbenrechtENDPROC fnrbenutzberecht;INT PROC dnrmeld:
+dnrmeldungenENDPROC dnrmeld;INT PROC fnrmeldungsname:fnrmeldnameENDPROC
+fnrmeldungsname;INT PROC fnrmeldungstext:fnrmeldtextENDPROC fnrmeldungstext;#
+PROC initmaske(TAG VAR t,TEXT CONST name):p.textkey1:=name;sendeauftrag(init)
+;t:=p.maskeEND PROC initmaske;BOOL PROC maskegibtes(TEXT CONST name):p.
+textkey1:=name;sendeauftrag(pruefen);replycode=ackEND PROC maskegibtes;PROC
+maskeloeschen(TEXT CONST name):p.textkey1:=name;sendeauftrag(loeschen)END
+PROC maskeloeschen;PROC maskespeichern(TEXT CONST name):p.textkey1:=name;
+sendeauftrag(speichern)END PROC maskespeichern;PROC maskeumbenennen(TEXT
+CONST alt,neu):p.textkey1:=alt;p.textkey2:=neu;sendeauftrag(umbenennen)END
+PROC maskeumbenennen;PROC maskekopieren(TEXT CONST alt,neu):p.textkey1:=alt;p
+.textkey2:=neu;sendeauftrag(kopieren)END PROC maskekopieren;PROC maskenliste(
+TEXT CONST dateiname):p.textkey1:=dateiname;sendeauftrag(liste);copy(ds,
+dateiname);neuinitialisierenEND PROC maskenliste;PROC setzemaske(TAG CONST t)
+:p.maske:=tEND PROC setzemaske;PROC ladesystembaum(DATASPACE VAR d,TEXT
+CONST name):p.textkey1:=name;sendeauftrag(newtree);d:=ds;neuinitialisieren
+END PROC ladesystembaum;PROC baumverarbeitung(TEXT VAR dateiname,INT CONST
+aktion):INT VAR wastun:=baumverarbeitungbasis+aktion;IF aktion>4THEN wastun
+DECR 2ELIF (aktion=2)COR (aktion=0)THEN FILE VAR f:=sequentialfile(input,
+dateiname);INT CONST ch:=channel(myself);TEXT CONST cht:=dateiname+text(ch,2)
+;headline(f,cht);break(quiet)FI ;DATASPACE VAR datei:=old(dateiname);INT VAR
+re:=0;call(newmanager,wastun,datei,re);IF (aktion=2)COR (aktion=0)THEN
+continue(ch)FI ;IF re<>ackTHEN IF re<0THEN errorstop("Keine Managertask")
+ELSE IF re=errorTHEN BOUND TEXT VAR t:=datei;errorstop(t)ELSE SELECT aktion
+OF CASE 2:dateiname:=headline(sequentialfile(input,datei));copy(datei,
+dateiname);forget(datei)CASE 3,4:forget(dateiname,quiet);forget(datei);
+dateiname:=""OTHERWISE standard;dateiname:=""END SELECT FI FI ELSE standard
+FI .standard:forget(dateiname,quiet);copy(datei,dateiname);forget(datei).END
+PROC baumverarbeitung;PROC sendeauftrag(INT CONST auftragsnr):call(newmanager
+,auftragsnr,ds,replycode);IF (replycode<>ack)CAND (replycode<>ende)THEN IF
+nomanagerTHEN errorstop(no)ELSE BOUND TEXT VAR t:=ds;TEXT VAR fehlermeldung:=
+t;neuinitialisieren;errorstop(fehlermeldung)FI ELSE p:=dsFI .nomanager:
+replycode<0.no:"Keine Managertask".END PROC sendeauftrag;END PACKET
+ispmanagerschnittstelle;
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.masken b/app/baisy/2.2.1-schulis/src/isp.masken
new file mode 100644
index 0000000..12d5ef2
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.masken
@@ -0,0 +1,495 @@
+PACKET textalsrowDEFINES ins,del,CAT ,ipos,dump,replaceiac,VSUB ,VISUB :LET
+nil13byte="�������������",nil4byte="����",nilbyte="�";TEXT VAR g1,code2:="��"
+;PROC ins(TEXT VAR row,INT CONST wo,was):replace(code2,1,was);g1:=subtext(row
+,2*wo-1);row:=subtext(row,1,2*wo-2);rowCAT code2;rowCAT g1END PROC ins;PROC
+del(TEXT VAR row,INT CONST wo):g1:=subtext(row,2*wo+1);row:=subtext(row,1,2*
+wo-2);rowCAT g1END PROC del;OP CAT (TEXT VAR row,INT CONST was):replace(code2
+,1,was);rowCAT code2END OP CAT ;INT PROC ipos(TEXT CONST row,INT CONST was):
+INT VAR start:=0;replace(code2,1,was);REP start:=pos(row,code2,start+1)UNTIL
+startMOD 2=1OR start=0PER ;(start+1)DIV 2END PROC ipos;PROC dump(TEXT VAR row
+):INT VAR i;FOR iFROM 1UPTO length(row)DIV 2REP put(rowISUB i)PER END PROC
+dump;PROC replaceiac(TEXT VAR string,INT CONST wo,TEXT CONST was):IF LENGTH
+string<=LENGTH was+wo-1THEN stretch(string,LENGTH was+wo-1)FI ;replace(string
+,wo,was)END PROC replaceiac;PROC stretch(TEXT VAR t,INT CONST wo):WHILE
+LENGTH t<=wo-13REP tCAT nil13bytePER ;WHILE LENGTH t<=wo-4REP tCAT nil4byte
+PER ;WHILE LENGTH t<woREP tCAT nilbytePER END PROC stretch;PROC replaceiac(
+TEXT VAR string,INT CONST wo,INT CONST was):IF LENGTH string<=2*(wo+1)THEN
+stretch(string,2*(wo+1))FI ;replace(string,wo,was)END PROC replaceiac;INT OP
+VSUB (TEXT CONST string,INT CONST pos):code(stringSUB pos)END OP VSUB ;INT
+OP VISUB (TEXT CONST string,INT CONST pos):IF pos*2<=LENGTH stringTHEN string
+ISUB posELSE 0FI END OP VISUB ;END PACKET textalsrow;#-S tand: 09.10.8617:45'
+10398-7873997831794-186313620-87233256154684296-17369#PACKET screenservice
+DEFINES screencursor,screenput,screenpage,screenline,screenout,screenbs,
+screencopy,checkscreen,screenreorganized,screendirty,screenok,
+reorganizescreen:#L screenlets#LET zeilen=24,spalten=80,ganzrichtig=0,
+ganzfalsch=1,teilweisefalsch=3;LET emptyline="�
+";TEXT CONST blankline:=
+spalten*" ";ROW zeilenTEXT VAR screen;TEXT VAR buffer;INT VAR screenstatus:=
+ganzfalsch;ROW zeilenBOOL VAR lineok;INT VAR zeile;INT VAR curx,cury,pbegin,
+pend;.allesrichtig:ROW zeilenBOOL :(TRUE ,TRUE ,TRUE ,TRUE ,TRUE ,TRUE ,TRUE
+,TRUE ,TRUE ,TRUE ,TRUE ,TRUE ,TRUE ,TRUE ,TRUE ,TRUE ,TRUE ,TRUE ,TRUE ,
+TRUE ,TRUE ,TRUE ,TRUE ,TRUE ).allesfalsch:ROW zeilenBOOL :(FALSE ,FALSE ,
+FALSE ,FALSE ,FALSE ,FALSE ,FALSE ,FALSE ,FALSE ,FALSE ,FALSE ,FALSE ,FALSE ,
+FALSE ,FALSE ,FALSE ,FALSE ,FALSE ,FALSE ,FALSE ,FALSE ,FALSE ,FALSE ,FALSE )
+.;BOOL PROC screenreorganized:screenstatus=ganzrichtigEND PROC
+screenreorganized;PROC screendirty:screenstatus:=ganzfalsch;END PROC
+screendirty;PROC screenok:screenstatus:=ganzrichtig;END PROC screenok;PROC
+screenok(BOOL CONST wie,INT CONST von,bis):IF screenstatus=ganzfalschCAND wie
+THEN lineok:=allesfalsch;screenstatus:=teilweisefalschELIF screenstatus=
+ganzrichtigCAND NOT wieTHEN lineok:=allesrichtig;screenstatus:=
+teilweisefalschFI ;IF screenstatus=teilweisefalschTHEN FOR zeileFROM vonUPTO
+bisREPEAT lineok(zeile):=wiePER FI END PROC screenok;PROC checkscreen:IF
+screenstatus<>ganzrichtigTHEN reorganizescreenFI END PROC checkscreen;
+screenpage;PROC screencursor(INT CONST x,y):curx:=x;cury:=yEND PROC
+screencursor;PROC screenpage:FOR curyFROM 1UPTO zeilen-1REPEAT screen(cury):=
+emptylinePER ;screen(zeilen):=blankline;cury:=1;curx:=1END PROC screenpage;
+PROC screenbs:curxDECR 1END PROC screenbs;PROC screenline:curyINCR 1;curx:=1;
+END PROC screenline;PROC screenput(TEXT CONST was):IF was>""THEN
+checkworkline;getfirstparttoput;WHILE theremaybearestREP replacepart;
+getnextparttoputPER ;replacerestFI .getfirstparttoput:pbegin:=pos(was," ","�"
+,1);pend:=pos(was,"�","�",pbegin)-1.theremaybearest:pend>0.replacepart:buffer
+:=subtext(was,pbegin,pend);replace(workline,pbegin+curx-1,buffer).
+getnextparttoput:pbegin:=pos(was," ","�",pend+2);IF pbegin>0THEN pend:=pos(
+was,"�","�",pbegin)-1;ELSE pend:=0FI .replacerest:IF pbegin>0THEN IF pbegin=1
+THEN replace(workline,curx,was)ELSE buffer:=subtext(was,pbegin,LENGTH was);
+replace(workline,pbegin+curx-1,buffer)FI ;curxINCR LENGTH was;IF curx>spalten
+THEN curyINCR 1;curxDECR spaltenFI ;FI .END PROC screenput;PROC screenout(
+TEXT CONST was,INT CONST von,bis):buffer:=subtext(was,von,bis);checkscreen;
+IF buffer>""THEN checkworkline;replace(workline,curx,buffer);curxINCR ((bis-
+von)+1);IF curx>spaltenTHEN curyINCR 1;curxDECR spaltenFI FI .workline:screen
+(cury).END PROC screenout;PROC screenout(TEXT CONST was):checkscreen;IF was>
+""THEN checkworkline;replace(workline,curx,was);curxINCR LENGTH was;IF curx>
+spaltenTHEN curyINCR 1;curxDECR spaltenFI FI .END PROC screenout;PROC
+reorganizescreen:out("�");IF screenstatus=teilweisefalschTHEN FOR zeileFROM 1
+UPTO zeilen-1REPEAT IF lineok(zeile)THEN out("
+")ELSE out(screen(zeile))FI
+PER ;IF NOT lineok(zeilen)THEN outsubtext(screen(zeilen),1,spalten-1);FI
+ELSE FOR zeileFROM 1UPTO zeilen-1REPEAT out(screen(zeile))PER ;outsubtext(
+screen(zeilen),1,spalten-1);FI ;cursor(curx,cury);screenok;END PROC
+reorganizescreen;PROC screencopy(FILE VAR f):putline(f,"#page#");INT VAR
+zeile;FOR zeileFROM 1UPTO zeilenREPEAT TEXT VAR t:=screen(zeile);changeall(t,
+"�"," ");changeall(t,"�"," ");putline(f,t)PER ;END PROC screencopy;PROC
+reorganizescreen(INT CONST zeile,von,bis):cursor(von,zeile);IF LENGTH screen(
+zeile)<vonTHEN outsubtext(blankline,von,bis)ELSE outsubtext(screen(zeile),von
+,bis)FI END PROC reorganizescreen;.checkworkline:IF LENGTH (workline)<3THEN
+workline:=blankline;FI .workline:screen(cury).END PACKET screenservice;
+PACKET maskDEFINES TAG ,:=,nil,show,put,get,putget,leavingcode,xsize,ysize,
+fields,fieldexists,formline,setautoesc,executecommandcode,length,cursor,
+clearfield,definefield,setlasteditvalues,setneweditvalues,searchfield,
+firstfield,nextfield,priorfield,fieldinfos,setfieldinfos,symbolicname,
+auskunftsnr,fieldwithname,store,storefalse,page,SCROLL ,design,designfields,
+designfield,designform,trans,TO ,transform,#V alt#fill,CLEARBY :#V std##L
+eumelcodes##L codeintlets#LET invers="",endinvers="",left="�",right="�",
+home="�";LET chop=1,chome=1,cvor=2,cfeldende=18,crueck=8,cfeldanf=20,choch=3,
+cfeldrueck=19,crunter=10,causkunft=0,ctab=9,csettab=21,ceinf=11,caufbrech=22,
+causf=12,clearn=26,cfeldvor=13,cloeschende=24,cmark=16,cneu=17,cesc=27,
+cseiterueck=15,centry=6,cseitevor=14;LET hoptasten="?aouAOUBb§</>(!)-k'= #",
+hopcodes="�äöüÄÖÜßßß[\]{|}­k^~ \#";LET niltext="";#L maskenlets#LET tagtypenr=
+999,filetypenr=1003,taglines=24,maxfields=100;#boardlines=2000,##boardtype=
+777;#TEXT VAR cat;BOOL VAR beimletztenrausfallen:=FALSE ,prot:=FALSE ,
+outputallowed:=TRUE ;BOOL VAR closedbit,protectbit,darstbit,tabbit,leftbit,
+exitbit,rollbit,normal:=TRUE ;INT VAR workint,ausnr;PROC store(BOOL CONST ein
+):prot:=ein;IF NOT einTHEN screendirty;outputallowed:=TRUE FI END PROC store;
+PROC storefalse(INT CONST von,bis):prot:=FALSE ;screenok(FALSE ,von,bis);
+outputallowed:=TRUE END PROC storefalse;BOOL PROC store:protEND PROC store;
+PROC page:IF protTHEN screenpage;screenokFI ;IF outputallowedTHEN out("��")
+FI END PROC page;PROC xoutsubtext(TEXT CONST was,INT CONST von,bis):IF prot
+THEN screenout(was,von,bis)FI ;IF outputallowedTHEN outsubtext(was,von,bis)
+FI END PROC xoutsubtext;TYPE TAG =STRUCT (TEXT erstel,darst,diainfo,dbnam,
+ausknam,feld,x,y,len,tab,ROW taglinesTEXT formblatt,INT xmax,ymax,xs,ys,dbp,
+ver,durchs,art);OP :=(TAG VAR a,TAG CONST b):CONCR (a):=CONCR (b)END OP :=;
+PROC nil(TAG VAR t):t.formblatt:=ROW taglinesTEXT :("","","","","","","","",
+"","","","","","","","","","","","","","","","");t.xmax:=0;t.ymax:=0;t.xs:=1;
+t.ys:=1;t.dbp:=0;t.ver:=1;t.durchs:=0;t.art:=0;t.darst:="";t.erstel:="";t.
+diainfo:="";t.dbnam:="";t.ausknam:="";t.feld:="";t.x:="";t.y:="";t.tab:="";t.
+len:="";END PROC nil;INT PROC fields(TAG CONST a):LENGTH a.erstelEND PROC
+fields;BOOL PROC fieldexists(TAG CONST a,INT CONST feldnr):(a.erstelVSUB
+feldnr)>0END PROC fieldexists;INT PROC xsize(TAG CONST a):a.xmaxEND PROC
+xsize;INT PROC ysize(TAG CONST a):a.ymaxEND PROC ysize;TEXT PROC formline(
+TAG CONST a,INT CONST l):a.formblatt(l)END PROC formline;PROC setinfo(TEXT
+CONST string,INT CONST pos):workint:=stringVSUB pos;IF workint>0THEN
+setallvaluesELSE normal:=TRUE FI .setallvalues:closedbit:=hbit;protectbit:=
+hbit;darstbit:=hbit;tabbit:=hbit;leftbit:=hbit;exitbit:=hbit;rollbit:=hbit;
+normal:=FALSE .hbit:workint:=workint*2;IF workint>255THEN workintDECR 256;
+TRUE ELSE FALSE FI .END PROC setinfo;PROC clearfield(TAG VAR a,INT CONST feld
+):sucheanfangdesfeldelementstring;sucheendedesfeldelementstring;
+loeschefeldelementeintraege;korrigiereerstelverweise;loeschefeldeintraege.
+sucheanfangdesfeldelementstring:INT VAR anf:=pos(a.feld,code(feld)).
+sucheendedesfeldelementstring:INT VAR ende:=anf;WHILE (a.feldVSUB ende)=feld
+REP endeINCR 1PER ;endeDECR 1.loeschefeldelementeintraege:change(a.feld,anf,
+ende,"");change(a.x,anf,ende,"");change(a.y,anf,ende,"");change(a.len,anf,
+ende,"");change(a.tab,anf,ende,"").korrigiereerstelverweise:INT VAR feldnr;
+FOR feldnrFROM 1UPTO LENGTH a.erstelREP IF code(a.erstelSUB feldnr)>endeTHEN
+replace(a.erstel,feldnr,code(decrementierterwert))FI ;PER .
+decrementierterwert:code(a.erstelSUB feldnr)-(ende-anf+1).
+loeschefeldeintraege:replace(a.erstel,feld,"�");replace(a.darst,feld,"�");
+replace(a.diainfo,feld,"�");IF LENGTH a.dbnam>=2*feldTHEN replace(a.dbnam,
+feld,0)FI ;IF LENGTH a.ausknam>=2*feldTHEN replace(a.ausknam,feld,0)FI .END
+PROC clearfield;PROC definefield(TAG VAR t,TEXT CONST xb,yb,lenb,tabb,INT
+CONST dbnam,auskinfo,feldnr,TEXT CONST darst,diainfo):IF fieldexists(t,feldnr
+)THEN clearfield(t,feldnr)FI ;elementarfeldpossuchen;elementarfeldereinfuegen
+;erstelverweisekorrigieren;feldeintragen.elementarfeldpossuchen:
+zumerstenelfeld;WHILE elfelddaCAND (liegtvorneuemCOR NOT isterstel)REP
+oldnumber:=feld;elementarfeldposINCR 1PER .elementarfeldereinfuegen:
+insertchar(t.y,yb,elementarfeldpos);insertchar(t.x,xb,elementarfeldpos);
+insertchar(t.tab,tabb,elementarfeldpos);insertchar(t.len,lenb,
+elementarfeldpos);insertchar(t.feld,LENGTH xb*code(feldnr),elementarfeldpos).
+erstelverweisekorrigieren:INT VAR fnr;FOR fnrFROM 1UPTO LENGTH t.erstelREP
+IF code(t.erstelSUB fnr)>=elementarfeldposTHEN replace(t.erstel,fnr,code(
+incrementierterwert))FI ;PER .incrementierterwert:code(t.erstelSUB fnr)+
+LENGTH xb.feldeintragen:replaceiac(t.erstel,feldnr,code(elementarfeldpos));
+replaceiac(t.diainfo,feldnr,diainfo);replaceiac(t.darst,feldnr,darst);IF
+dbnam<>0THEN replaceiac(t.dbnam,feldnr,dbnam)FI ;IF auskinfo<>0THEN
+replaceiac(t.ausknam,feldnr,auskinfo)FI .zumerstenelfeld:INT VAR oldnumber:=0
+;INT VAR elementarfeldpos:=1.liegtvorneuem:y<(ybSUB 1)OR (y=(ybSUB 1)AND x<(
+xbSUB 1)).isterstel:oldnumber<>feld.elfeldda:elementarfeldpos<=LENGTH t.x.y:t
+.ySUB elementarfeldpos.x:t.xSUB elementarfeldpos.feld:code(t.feldSUB
+elementarfeldpos).END PROC definefield;OP SCROLL (TAG VAR t,INT CONST lines):
+cat:="";INT VAR i;FOR iFROM 1UPTO LENGTH (t.y)REP INT VAR v:=code(t.ySUB i)+
+lines;IF v<1OR v>taglinesTHEN errorstop(
+"Feld ausserhalb Bildschirm durch SCROLL")FI ;catCAT code(v)PER ;t.y:=cat;IF
+lines>0THEN FOR iFROM min(taglines-lines,t.ymax)DOWNTO 1REP t.formblatt(i+
+lines):=t.formblatt(i)PER ;FOR iFROM linesDOWNTO 1REP t.formblatt(i):=""PER ;
+t.ymaxINCR lines;t.ymax:=min(taglines,t.ymax)ELSE FOR iFROM 1-linesUPTO min(t
+.ymax-lines,taglines)REP t.formblatt(i+lines):=t.formblatt(i)PER ;FOR iFROM t
+.ymax+lines+1UPTO t.ymaxREP t.formblatt(i):=""PER ;t.ymaxINCR lines;t.ymax:=
+max(t.ymax,1);FI .END OP SCROLL ;INT PROC fieldwithname(TAG CONST t,INT
+CONST name):ipos(t.dbnam,name)END PROC fieldwithname;INT PROC symbolicname(
+TAG CONST t,INT CONST feld):t.dbnamVISUB feldEND PROC symbolicname;PROC
+symbolicname(TAG VAR t,INT CONST feld,symbol):replaceiac(t.dbnam,feld,symbol)
+END PROC symbolicname;INT PROC auskunftsnr(TAG CONST t,INT CONST feld):t.
+ausknamVISUB feldEND PROC auskunftsnr;INT PROC auskunftsnr:ausnrEND PROC
+auskunftsnr;PROC auskunftsnr(TAG VAR t,INT CONST feld,ausknr):replaceiac(t.
+ausknam,feld,ausknr)END PROC auskunftsnr;PROC fieldinfos(TAG CONST t,INT
+CONST feld,INT VAR geheimcode,BOOL VAR closed,protected,secret,special,left):
+geheimcode:=code(t.darstSUB feld);setinfo(t.diainfo,feld);IF normalTHEN
+closed:=FALSE ;protected:=FALSE ;secret:=FALSE ;special:=FALSE ;left:=FALSE ;
+ELSE closed:=closedbit;protected:=protectbit;secret:=darstbit;special:=tabbit
+;left:=leftbit;FI END PROC fieldinfos;PROC setfieldinfos(TAG VAR t,INT CONST
+feld,BOOL CONST closed,protected,secret):INT VAR cd:=(t.diainfoVSUB feld)MOD
+32;IF secretTHEN cdINCR 32FI ;IF protectedTHEN cdINCR 64FI ;IF closedTHEN cd
+INCR 128FI ;replaceiac(t.diainfo,feld,code(cd))END PROC setfieldinfos;PROC
+transform(TAG CONST t,FILE VAR o):enablestop;buffer:="";bufferCAT t.xmax;
+bufferCAT t.ymax;bufferCAT t.xs;bufferCAT t.ys;bufferCAT t.dbp;bufferCAT t.
+ver;bufferCAT t.durchs;bufferCAT t.art;putline(o,buffer);putline(o,t.darst);
+putline(o,t.erstel);putline(o,t.diainfo);putline(o,t.dbnam);putline(o,t.
+ausknam);putline(o,t.feld);putline(o,t.x);putline(o,t.y);putline(o,t.tab);
+putline(o,t.len);putline(o,trtab);tTO o.END PROC transform;PROC transform(
+FILE VAR i,TAG VAR t):enablestop;TEXT VAR oldtrtab:=trtab;getline(i,buffer);t
+.xmax:=bufferISUB 1;IF t.xmax<>12336THEN t.ymax:=bufferISUB 2;t.xs:=buffer
+ISUB 3;t.ys:=bufferISUB 4;t.dbp:=bufferISUB 5;t.ver:=bufferISUB 6;t.durchs:=
+bufferISUB 7;t.art:=bufferISUB 8;getline(i,t.darst);getline(i,t.erstel);
+getline(i,t.diainfo);getline(i,t.dbnam);getline(i,t.ausknam);getline(i,t.feld
+);getline(i,t.x);getline(i,t.y);getline(i,t.tab);getline(i,t.len);getline(i,
+trtab);ELSE nil(t);FI ;iTO t;trtab:=oldtrtab;IF t.ver<>1THEN errorstop(
+"Datei enth�lt kein TAG")FI .END PROC transform;PROC filetotag(DATASPACE
+CONST ei):type(ei,tagtypenr)END PROC filetotag;PROC tagtofile(DATASPACE
+CONST ei):IF type(ei)=tagtypenrTHEN type(ei,filetypenr)ELSE errorstop(
+"TYPE nicht TAG")FI END PROC tagtofile;PROC efill(TAG VAR ff,TEXT CONST t,
+INT CONST elfeld):INT CONST abwo:=1;zumerstenelementarfeld;WHILE
+nochgenugtextdaREP fuelleelementarfeld;elementarfeldweiterzaehlen;IF
+gehoertzumnaechstenfeldTHEN markiereueberlauf;LEAVE efillFI ;zumelementarfeld
+;PER ;gibrestaus.zumerstenelementarfeld:tlen:=LENGTH t;tout:=abwo-1;afeld:=ff
+.feldVSUB elfeld;ael:=elfeld;zumelementarfeld.fuelleelementarfeld:cat:=
+subtext(t,tout+1,tout+al);replace(ff.formblatt(ay),ax,cat);toutINCR al.
+nochgenugtextda:tout+al<tlen.elementarfeldweiterzaehlen:aelINCR 1.
+zumelementarfeld:al:=ff.lenVSUB ael;ax:=ff.xVSUB ael;ay:=ff.yVSUB ael.
+gehoertzumnaechstenfeld:(ff.feldVSUB ael)<>afeld.gibrestaus:cat:=subtext(t,
+tout+1,tlen);replace(ff.formblatt(ay),ax,cat).markiereueberlauf:replace(ff.
+formblatt(ay),ax+al-1,"<").END PROC efill;PROC fill(TAG VAR t,TEXT CONST
+inhalt,INT CONST feld):setinfo(t.diainfo,feld);INT VAR erstelem:=t.erstel
+VSUB feld;IF erstelem>0THEN IF normalCOR NOT closedbitTHEN efill(t,inhalt,
+erstelem)FI FI END PROC fill;OP CLEARBY (TAG VAR u,TAG CONST u1):INT VAR i;
+FOR iFROM 1UPTO u.ymaxREP u.formblatt(i):=u1.formblatt(i)PER ;END OP CLEARBY
+;INT VAR afeld,ax,ay,al,ael,tlen,tout;PROC eput(TAG CONST ff,TEXT CONST t,
+INT CONST elfeld):eput(ff,t,elfeld,1)END PROC eput;PROC eput(TAG CONST ff,
+TEXT CONST t,INT CONST elfeld,INT CONST abwo):zumerstenelementarfeld;WHILE
+nochgenugtextdaREP fuelleelementarfeld;elementarfeldweiterzaehlen;IF
+gehoertzumnaechstenfeldTHEN markiereueberlauf;LEAVE eputFI ;zumelementarfeld;
+PER ;gibrestaus;REP elementarfeldweiterzaehlen;IF gehoertzumnaechstenfeld
+THEN LEAVE eputFI ;zumelementarfeld;gibhintergrundausPER .
+zumerstenelementarfeld:tlen:=LENGTH t;tout:=abwo-1;afeld:=ff.feldVSUB elfeld;
+ael:=elfeld;positionieren(ff).fuelleelementarfeld:xoutsubtext(t,tout+1,tout+
+al);toutINCR al.nochgenugtextda:tout+al<tlen.elementarfeldweiterzaehlen:ael
+INCR 1.zumelementarfeld:positionieren(ff).gehoertzumnaechstenfeld:(ff.feld
+VSUB ael)<>afeld.gibrestaus:xoutsubtext(t,tout+1,tlen);IF tout+al>tlenTHEN
+xoutsubtext(grund,ax+tlen-tout,ax+al-1)FI .gibhintergrundaus:xoutsubtext(
+grund,ax,ax+al-1).grund:ff.formblatt(ay).markiereueberlauf:IF outputallowed
+THEN out("�<")FI ;IF protTHEN screenbs;screenout("<")FI .END PROC eput;PROC
+positionieren(TAG CONST ff):al:=ff.lenVSUB ael;ax:=ff.xVSUB ael;ay:=ff.yVSUB
+ael;IF protTHEN screencursor(ax,ay)FI ;IF outputallowedTHEN cursor(ax,ay)FI .
+END PROC positionieren;PROC cursor(TAG CONST ff,INT CONST feld):ael:=ff.
+erstelVSUB feld;positionieren(ff)END PROC cursor;INT PROC length(TAG CONST ff
+,INT CONST feld):zumerstenelementarfeld;IF ael<1THEN LEAVE lengthWITH 0FI ;
+INT VAR len:=0;REP lenINCR feldlaenge;zumnaechstenelementarfeld;UNTIL
+gehoertzumnaechstenfeldPER ;len.zumerstenelementarfeld:ael:=ff.erstelVSUB
+feld.zumnaechstenelementarfeld:aelINCR 1.gehoertzumnaechstenfeld:(ff.feld
+VSUB ael)<>feld.feldlaenge:ff.lenVSUB ael.END PROC length;PROC show(TAG
+CONST ff):INT VAR i;IF protTHEN IF screenreorganizedTHEN FOR iFROM 1UPTO ff.
+ymaxREP screencursor(1,i);screenput(ff.formblatt(i))PER ;ELSE FOR iFROM 1
+UPTO ff.ymaxREP IF ff.formblatt(i)>""THEN screencursor(1,i);screenok(FALSE ,i
+,i);screenput(ff.formblatt(i))FI PER ;IF outputallowedTHEN reorganizescreen
+FI ;LEAVE showFI FI ;IF outputallowedTHEN out(home);out(ff.formblatt(1));FOR
+iFROM 2UPTO ff.ymaxREP line;out(ff.formblatt(i))PER FI .END PROC show;INT
+VAR charcode:=0,lastx,lasty;PROC translatecode:charcode:=code(char);SELECT
+charcodeOF CASE chop:charcode:=chomeCASE cvor:charcode:=cfeldendeCASE crueck:
+charcode:=cfeldanfCASE choch:charcode:=cseiterueckCASE crunter:charcode:=
+cseitevorCASE ctab:charcode:=csettabCASE ceinf:charcode:=caufbrechCASE causf:
+charcode:=cloeschendeCASE cfeldvor:charcode:=cfeldrueckCASE cmark:charcode:=
+cneuCASE cesc:charcode:=clearnOTHERWISE charcode:=pos(hoptasten,char);IF
+charcode=0THEN IF ischarTHEN FI ELSE char:=hopcodesSUB charcode;charcode:=
+code(char)FI END SELECT END PROC translatecode;TEXT VAR char,pseudochar;BOOL
+PROC ischar:inchar(char);charcode:=code(char);IF charcode>31THEN TRUE ELIF
+charcode=chopTHEN inchar(char);translatecode;charcode>31ELSE FALSE FI END
+PROC ischar;INT VAR aktlimit,aktbegin,aktfeld,aktline,aktlen,aktanf,aktel,wo;
+PROC setfieldvalues(TAG CONST ta):aktlen:=ta.lenVSUB aktel;aktanf:=ta.xVSUB
+aktel;aktline:=ta.yVSUB aktelEND PROC setfieldvalues;INT VAR nextfeld,nextel,
+nextwo,nextbegin;PROC setlasteditvalues:preset:=TRUE END PROC
+setlasteditvalues;PROC setneweditvalues:aktfeld:=nextfeld;aktbegin:=nextbegin
+;aktel:=nextel;wo:=nextwo;preset:=TRUE END PROC setneweditvalues;BOOL VAR
+preset:=FALSE ,feldda;PROC searchfield(TAG CONST t,INT CONST x,y,BOOL VAR
+erfolg):erfolg:=FALSE ;nextel:=0;REP sucheelementinrichtigerzeileUNTIL
+keinsmehrdaCOR xposstimmtPER ;IF erfolgTHEN nextfeld:=t.feldVSUB nextel;
+nextbegin:=1;INT VAR i:=t.erstelVSUB nextfeld;WHILE i<nextelREP nextbegin
+INCR (t.lenVSUB i);iINCR 1PER ;nextwo:=nextbegin+x-anfangFI .
+sucheelementinrichtigerzeile:nextel:=pos(t.y,code(y),nextel+1).keinsmehrda:
+nextel=0.xposstimmt:erfolg:=anfang<=xAND ende>x;erfolg.anfang:t.xVSUB nextel.
+ende:(t.xVSUB nextel)+(t.lenVSUB nextel).END PROC searchfield;PROC editieren(
+TAG CONST ff,TEXT VAR eing,INT CONST feld):IF fieldexists(ff,feld)THEN
+bestimmeeinstieg;REPEAT REPEAT wertesteuerzeichenausUNTIL ischarPER ;REPEAT
+schreibezeichen;UNTIL wo>aktlimitCOR NOT ischarPER PER FI .bestimmeeinstieg:
+IF presetAND (feld=0COR feld=aktfeld)THEN ELSE aktfeld:=feld;aktel:=ff.erstel
+VSUB aktfeld;aktbegin:=1;wo:=1FI ;charcode:=centry;preset:=FALSE ;IF NOT
+normalTHEN preparespecialeditingFI .preparespecialediting:IF darstbitTHEN
+pseudochar:=ff.darstSUB feldFI .schreibezeichen:IF wo<=LENGTH eingTHEN
+replace(eing,wo,char)ELSE eingCAT char;IF wo>LENGTH eing+1THEN
+normalizepositionFI FI ;IF normalCOR NOT darstbitTHEN out(char)ELSE out(
+pseudochar)FI ;woINCR 1.wertesteuerzeichenaus:SELECT charcodeOF CASE cneu:
+neuschreibenCASE centry:setfieldvalues(ff);positionieren;aktlimit:=aktbegin+
+aktlen-1CASE cvor:IF wo<=LENGTH eingTHEN woINCR 1;out(right);forwardFI CASE
+cfeldende:zumfeldendeCASE crueck:woDECR 1;out(left);backwardCASE cfeldanf:wo
+:=1;backwardtoendCASE ceinf:insertchar(eing," ",wo);restneuschreibenCASE
+causf:IF LENGTH eing>0THEN IF wo>LENGTH eingTHEN woDECR 1;out(left);backward
+FI ;deletechar(eing,wo);restneuschreibenFI ;CASE cloeschende:eing:=subtext(
+eing,1,wo-1);restneuschreibenCASE choch:gouporleaveCASE crunter:godownorleave
+OTHERWISE :IF charcode>31THEN forwardELSE leaveFI END SELECT .zumfeldende:wo
+:=LENGTH eing+1;forward;positionieren.positionieren:cursor(aktanf+(wo-
+aktbegin),aktline).forward:WHILE wo>aktlimitREPEAT aktelINCR 1;IF
+gehoertzumfeldTHEN aktbegin:=aktlimit+1;decodefieldlen;aktlimitINCR aktlen
+ELSE aktelDECR 1;wo:=aktlimitFI ;positionierenPER .leave:getcursor(lastx,
+lasty);LEAVE editieren.godownorleave:getcursor(lastx,lasty);searchfield(ff,
+lastx,lasty+1,feldda);IF felddaCAND nextfeld=aktfeldTHEN wo:=nextwo;aktel:=
+nextel;setfieldvalues(ff);aktbegin:=nextbegin;aktlimit:=aktbegin-1+aktlen;
+positionierenELSE LEAVE editierenFI .gouporleave:getcursor(lastx,lasty);
+searchfield(ff,lastx,lasty-1,feldda);IF felddaCAND nextfeld=aktfeldTHEN wo:=
+nextwo;aktel:=nextel;setfieldvalues(ff);aktbegin:=nextbegin;aktlimit:=
+aktbegin-1+aktlen;positionierenELSE LEAVE editierenFI .backward:IF wo<
+aktbeginTHEN IF wo<1THEN wo:=1ELSE aktelDECR 1;decodefieldlen;aktlimit:=
+aktbegin-1;aktbeginDECR aktlen;FI ;positionierenFI .backwardtoend:aktel:=ff.
+erstelVSUB aktfeld;decodefieldlen;aktbegin:=1;aktlimit:=aktlen;positionieren.
+normalizeposition:wo:=LENGTH eing;WHILE wo<aktbeginREP aktelDECR 1;
+decodefieldlen;aktlimit:=aktbegin-1;aktbeginDECR aktlenPER ;positionieren.
+decodefieldlen:setfieldvalues(ff).restneuschreiben:neuschreiben.neuschreiben:
+eput(ff,darstellstring,ff.erstelVSUB aktfeld);positionieren.darstellstring:
+IF normalCOR NOT darstbitTHEN eingELSE LENGTH (eing)*pseudocharFI .
+gehoertzumfeld:(ff.feldVSUB aktel)=aktfeld.END PROC editieren;TEXT PROC get(
+TAG CONST ff,INT CONST feld):TEXT VAR a:=niltext;get(ff,a,feld);aEND PROC get
+;PROC get(TAG CONST ff,TEXT VAR eingabe,INT CONST feld):IF protTHEN
+checkscreenFI ;BOOL VAR p:=prot;prot:=FALSE ;setinfo(ff.diainfo,feld);
+editieren(ff,eingabe,feld);IF pTHEN prot:=TRUE ;outputallowed:=FALSE ;put(ff,
+eingabe,feld);outputallowed:=TRUE FI END PROC get;PROC putget(TAG CONST ff,
+TEXT VAR value,INT CONST feld):BOOL VAR p:=prot;prot:=FALSE ;outputallowed:=
+TRUE ;put(ff,value,feld);editieren(ff,value,feld);IF pTHEN prot:=TRUE ;
+outputallowed:=FALSE ;put(ff,value,feld);outputallowed:=TRUE FI END PROC
+putget;PROC put(TAG CONST ff,TEXT CONST v,INT CONST feld):setinfo(ff.diainfo,
+feld);INT VAR erstelem:=ff.erstelVSUB feld;IF erstelem>0THEN IF normalCOR
+NOT darstbitTHEN eput(ff,v,erstelem)ELSE eput(ff,LENGTH v*(ff.darstSUB feld),
+erstelem)FI FI END PROC put;INT PROC leavingcode:charcodeEND PROC leavingcode
+;PROC putget(TAG CONST ff,ROW maxfieldsTEXT VAR v,INT VAR einstieg):put(ff,v)
+;get(ff,v,einstieg)END PROC putget;PROC put(TAG CONST ff,ROW maxfieldsTEXT
+VAR fieldvalues):INT VAR iFOR iFROM 1UPTO LENGTH ff.erstelREP IF fieldexists(
+ff,i)THEN put(ff,fieldvalues(i),i)FI PER END PROC put;PROC get(TAG CONST ff,
+ROW maxfieldsTEXT VAR fieldvalues,INT VAR feld):INT VAR felder:=LENGTH ff.
+erstel;IF NOT fieldexists(ff,feld)THEN errorstop("startfeld nicht im tag")
+ELSE WHILE feld<=felderREPEAT get(ff,fieldvalues(feld),feld);
+executecommandcode(ff,feld)UNTIL charcode=cescPER FI END PROC get;PROC
+executecommandcode(TAG CONST ff,INT VAR feld):SELECT charcodeOF CASE
+cfeldrueck:topriorfieldCASE cfeldvor:tonextfieldCASE choch:goupifpossible
+CASE crunter:godownifpossibleCASE chome:tohomefieldCASE ctab:IF protTHEN
+reorganizescreenFI ;setlasteditvaluesCASE cesc:ausnr:=auskunftsnr(ff,feld)
+END SELECT .topriorfield:REPEAT feld:=priorfield(ff,feld)UNTIL warerstesCOR
+nichtgesperrtPER ;IF warerstesTHEN tohomefieldFI .tonextfield:INT VAR oldfeld
+:=feld;REP feld:=nextfield(ff,feld)UNTIL warletztesCOR nichtgesperrtPER ;IF
+warletztesTHEN feld:=oldfeld;IF beimletztenrausfallenTHEN charcode:=cesc;
+beimletztenrausfallen:=FALSE FI FI .tohomefield:feld:=firstfield(ff);WHILE
+gesperrtREP feld:=nextfield(ff,feld)PER .goupifpossible:BOOL VAR erfolg;
+searchfield(ff,lastx,lasty-1,erfolg);IF erfolgAND nextnichtgesperrtTHEN
+setneweditvalues;feld:=nextfeldELSE setlasteditvaluesFI .godownifpossible:
+searchfield(ff,lastx,lasty+1,erfolg);IF erfolgAND nextnichtgesperrtTHEN
+setneweditvalues;feld:=nextfeldELSE setlasteditvaluesFI .nichtgesperrt:(ff.
+diainfoVSUB feld)<64.nextnichtgesperrt:(ff.diainfoVSUB nextfeld)<64.gesperrt:
+NOT nichtgesperrt.warletztes:feld<1.warerstes:feld<1.END PROC
+executecommandcode;PROC setautoesc:beimletztenrausfallen:=TRUE END PROC
+setautoesc;INT PROC firstfield(TAG CONST t):t.feldVSUB 1END PROC firstfield;
+INT PROC nextfield(TAG CONST t,INT CONST feld):INT VAR el:=(t.erstelVSUB feld
+)+1;WHILE (t.feldVSUB el)=feldREP elINCR 1PER ;t.feldVSUB elEND PROC
+nextfield;INT PROC priorfield(TAG CONST t,INT CONST feld):t.feldVSUB ((t.
+erstelVSUB feld)-1)END PROC priorfield;TEXT VAR buffer,blinkan,blinkaus;TEXT
+VAR trtab:="!<> ",tr;TAG VAR hilfstag;nil(hilfstag);hilfstag.formblatt(
+taglines):=" Feldnummer : __ ";
+definefield(hilfstag,code(pos(hilfstag.formblatt(taglines),"_")),code(
+taglines),"�",".",0,0,1,"�","�");OP TO (FILE VAR a,TAG VAR t):INT VAR i,j;
+TEXT VAR char;t.xmax:=0;FOR jFROM 1UPTO taglinesREP IF NOT eof(a)THEN getline
+(a,buffer);transform;IF length(buffer)>t.xmaxTHEN t.xmax:=length(buffer)FI ;t
+.ymax:=jELSE tr:=niltext;FI ;t.formblatt(j):=tr;PER .transform:tr:=niltext;
+FOR iFROM 1UPTO LENGTH bufferREP char:=bufferSUB i;SELECT pos(trtab,char)OF
+CASE 2:trCAT inversCASE 3:trCAT endinversCASE 1:trCAT " "CASE 4:trCAT right
+OTHERWISE :trCAT charEND SELECT PER .END OP TO ;OP TO (TAG CONST t,FILE VAR f
+):INT VAR i,j;TEXT VAR pseudoblank:=trtabSUB 1,char;FOR jFROM 1UPTO t.ymax
+REP buffer:=t.formblatt(j);retransform;putline(f,tr)PER .retransform:tr:=
+niltext;FOR iFROM 1UPTO LENGTH bufferREP char:=bufferSUB i;SELECT code(char)
+OF CASE 32:trCAT pseudoblankCASE 15:trCAT (trtabSUB 2)CASE 14:trCAT (trtab
+SUB 3)CASE cvor:trCAT " "OTHERWISE :trCAT charEND SELECT PER ;buffer:=tr.END
+OP TO ;PROC trans(TEXT CONST x):IF LENGTH x=3THEN trtab:=x;trtabCAT " "ELSE
+errorstop("falsche Umsetztabelle")FI END PROC trans;TEXT PROC blink(TAG
+CONST t,INT VAR feld):blinkan:=length(t,feld)*"#";blinkaus:=LENGTH blinkan*
+"!";INT VAR i;FOR iFROM 1UPTO 20REP IF (iMOD 2)=0THEN put(t,blinkan,feld);
+ELSE put(t,blinkaus,feld);FI ;buffer:=incharety(3)UNTIL buffer<>""PER ;buffer
+END PROC blink;PROC findchar(TAG CONST f,TEXT CONST eingabe,INT VAR posx,posy
+):INT VAR posxn:=posx,posyn:=posy;WHILE (f.formblatt(posy)SUB posxn)=eingabe
+REP posxnINCR 1PER ;posxn:=pos(f.formblatt(posy),eingabe,posxn+1);WHILE posxn
+=0REP posynINCR 1;IF posyn>f.ymaxTHEN LEAVE findcharFI ;posxn:=pos(f.
+formblatt(posyn),eingabe)PER ;posx:=posxn;posy:=posyn.END PROC findchar;PROC
+designelfield(TAG CONST t,INT CONST xm,ym,INT VAR x,y,l):cursortostartpos;
+cursortoendpos.cursortostartpos:TEXT VAR storage:="_";REP cursor(x,y);IF
+ischarTHEN findchar(t,char,x,y);storage:=charELSE SELECT charcodeOF CASE
+chome:x:=1;y:=1CASE cvor:x:=xMOD xm;xINCR 1CASE crueck:IF x=1THEN x:=xmELSE x
+DECR 1FI CASE cfeldanf:x:=1CASE cfeldende:x:=xmCASE choch:IF y=1THEN y:=ym
+ELSE yDECR 1FI CASE crunter:y:=yMOD ym;yINCR 1CASE causkunft:cursor(1,24);out
+("X=");put(text(x,2));out(" Y=");put(text(y,2))CASE cesc:LEAVE designelfield
+CASE ctab:findchar(t,storage,x,y)CASE cfeldvor:LEAVE cursortostartpos
+OTHERWISE :out("�")END SELECT FI PER .cursortoendpos:TEXT VAR aktchar:=t.
+formblatt(y)SUB x;IF aktchar>" "AND (t.formblatt(y)SUB x-1)<>aktcharTHEN l:=1
+;WHILE (t.formblatt(y)SUB (x+l))=aktcharREP lINCR 1PER ;FI ;markiere;REP
+WHILE ischarREP out("�")PER ;IF charcode=cvorAND x+l<xm+1THEN lINCR 1;out(
+right);out(">");out(left);ELIF charcode=crueckAND l>1THEN
+originalzeichenausgeben;lDECR 1ELIF charcode=cescTHEN LEAVE designelfield
+ELIF charcode=cfeldvorTHEN LEAVE cursortoendposFI PER .
+originalzeichenausgeben:out(" �");out(t.formblatt(y)SUB (x+l-1));out("��").
+markiere:cursor(x,y);lTIMESOUT ">";out(left).END PROC designelfield;INT VAR
+el;PROC designfield(TAG CONST t,INT CONST feld,TEXT VAR x,y,l,ta):IF NOT
+varsinitializedTHEN initializeFI ;REP designelement;elINCR 1PER .
+varsinitialized:LENGTH x=LENGTH yAND LENGTH y=LENGTH lAND LENGTH l=LENGTH ta
+AND LENGTH x>0.initialize:IF NOT fieldexists(t,feld)THEN x:="";y:="";l:="";ta
+:=""ELSE INT VAR begin:=t.erstelVSUB feld,end:=begin;WHILE (t.feldVSUB end)=
+feldREP endINCR 1PER ;endDECR 1;x:=subtext(t.x,begin,end);y:=subtext(t.y,
+begin,end);l:=subtext(t.len,begin,end);ta:=subtext(t.tab,begin,end);FI ;el:=1
+.designelement:INT VAR xb,yb,lb;cursor(1,24);out(text(el));out(
+". Teilfeld ");IF LENGTH x<elTHEN xb:=1;yb:=1;lb:=1ELSE xb:=x
+VSUB el;yb:=yVSUB el;lb:=lVSUB elFI ;designelfield(t,t.xmax,t.ymax,xb,yb,lb);
+IF charcode=cescTHEN LEAVE designfieldFI ;IF LENGTH x<elTHEN xCAT code(xb);y
+CAT code(yb);lCAT code(lb);taCAT "�"ELSE replace(x,el,code(xb));replace(y,el,
+code(yb));replace(l,el,code(lb));FI .END PROC designfield;PROC design(TAG
+VAR todesign):REP designform(todesign);designfields(todesign);UNTIL
+leavingcode<>cescCOR no(" �Formulardarstellung veraendern")PER END PROC
+design;PROC designform(TAG VAR f):taginitialisieren;formulareditieren.
+formulareditieren:DATASPACE VAR wds:=nilspace;FILE VAR in:=sequentialfile(
+output,wds);fTO in;modify(in);headline(in,"Formular eingeben !");edit(in);
+page;input(in);reset(in);inTO f;forget(wds).taginitialisieren:IF f.ver<>1
+THEN nil(f)FI .END PROC designform;PROC dummie(INT VAR a,b,TEXT VAR c,BOOL
+VAR d,e):LEAVE dummie;a:=b;d:=e;c:="";END PROC dummie;PROC designfields(TAG
+VAR f):designfields(f,PROC dummie)END PROC designfields;PROC designfields(
+TAG VAR f,PROC (INT VAR ,INT VAR ,TEXT VAR ,BOOL VAR ,BOOL VAR )setparam):
+show(f);INT VAR feld:=2;TEXT VAR xrow,yrow,lrow,trow;REPEAT
+feldnummereinlesen;benutzerwunscherfragen;benutzerwunschauswertenEND REP .
+benutzerwunscherfragen:IF fieldexists(f,feld)THEN REP cursor(1,24);out(
+"a(endern) ,l(oeschen), i(rrtum) ?");TEXT VAR ein:=blink(f,feld);IF ein="�"
+THEN charcode:=cesc;LEAVE designfieldsFI UNTIL pos("aAäÄlLiI",ein)>0PER ;
+ELSE REP cursor(1,24);out(" n(eu einrichten), (i)rrtum ?");inchar(ein);
+IF ein="�"THEN charcode:=cesc;LEAVE designfieldsFI UNTIL pos("nNiI",ein)>0
+PER ;FI ;cursor(1,24);out(" ").
+benutzerwunschauswerten:IF pos("lL",ein)>0THEN put(f,"",feld);clearfield(f,
+feld)ELSE IF fieldexists(f,feld)THEN put(f,"",feld);FI ;IF pos("iI",ein)=0
+THEN xrow:="";yrow:=" ";lrow:="";trow:="";designfield(f,feld,xrow,yrow,lrow,
+trow);parametersetzen;definefield(f,xrow,yrow,lrow,trow,sym,aus,feld,dar,dia)
+;feldINCR 1;FI FI .feldnummereinlesen:TEXT VAR itext:=text(feld);REPEAT
+cursor(1,24);out("�");out(hilfstag.formblatt(taglines));putget(hilfstag,itext
+,1);IF leavingcode=cescTHEN LEAVE designfieldsFI ;feld:=int(itext);IF feld<1
+OR leavingcode=causkunftOR NOT lastconversionokTHEN dialogueELSE LEAVE
+feldnummereinlesen;FI ;PER .dialogue:REP cursor(1,24);out(
+"q(uit), i(rrtum), m(aske neu zeigen), f(eldnummern) �");inchar(ein);IF ein=
+"�"THEN charcode:=cesc;LEAVE designfieldsFI UNTIL pos("qQiImMfF",ein)>0PER ;
+SELECT (pos("qQiImMfF",ein)-1)DIV 2OF CASE 0:LEAVE designfieldsCASE 1:LEAVE
+dialogueCASE 2:show(f)CASE 3:INT VAR i;FOR iFROM 1UPTO fields(f)REP TEXT VAR
+buf:=text(i);bufCAT "*";put(f,((length(f,i)-1)DIV LENGTH (buf)+1)*buf,i)PER
+END SELECT .parametersetzen:INT VAR aus:=auskunftsnr(f,feld),sym:=
+symbolicname(f,feld);TEXT VAR dar:=f.darstSUB feld,dia;setinfo(f.diainfo,feld
+);BOOL VAR a:=closedbit,b:=protectbit,c:=darstbit;setparam(sym,aus,dar,b,c);
+setfieldinfos(f,feld,a,b,c);dia:=f.diainfoSUB feld;dar:=text(dar,1).END PROC
+designfields;END PACKET mask;PACKET dateDEFINES monat,jahr,tag,datum,tmj,
+datumjh,nildatum,jahrestag,wochentag:LET seperatorzeichen=":./ ",
+seperatorzeichen1=".";INT CONST beforefirstday:=-(22*vierjahre)-1;TEXT VAR b;
+BOOL VAR conversionerror:=FALSE ;INT PROC nildatum:beforefirstdayEND PROC
+nildatum;#L datumslets#LET letzterjanuar=31,letzterfebruar=59,letztermaerz=90
+,letzterapril=120,letztermai=151,letzterjuni=181,letzterjuli=212,
+letzteraugust=243,letzterseptember=273,letzteroktober=304,letzternovember=334
+,#letzterdezember=365,#vierjahre=1461;PROC tmj(INT CONST d,INT VAR t,m,j):
+INT VAR a;IF d<=beforefirstdayTHEN t:=-1;m:=-1;j:=-1;LEAVE tmjFI ;a:=d;IF a>0
+THEN j:=88ELSE j:=0;aINCR (-(beforefirstday+1))FI ;jINCR 4*(aDIV vierjahre);a
+:=aMOD vierjahre;IF a=letzterfebruarTHEN t:=29;m:=2;LEAVE tmjELIF a>
+letzterfebruarTHEN aDECR 1FI ;jINCR aDIV 365;a:=(aMOD 365)+1;IF a<=
+letzterjuniTHEN januarbisjuniELSE julibisdezemberFI .januarbisjuni:IF a<=
+letztermaerzTHEN januarbismaerzELSE aprilbisjuniFI .julibisdezember:IF a<=
+letzterseptemberTHEN julibisseptemberELSE oktoberbisdezemberFI .
+januarbismaerz:IF a<=letzterjanuarTHEN m:=1;t:=aELIF a<=letzterfebruarTHEN m
+:=2;t:=a-letzterjanuarELSE m:=3;t:=a-letzterfebruarFI .aprilbisjuni:IF a<=
+letzteraprilTHEN m:=4;t:=a-letztermaerzELIF a<=letztermaiTHEN m:=5;t:=a-
+letzteraprilELSE m:=6;t:=a-letztermaiFI .julibisseptember:IF a<=letzterjuli
+THEN m:=7;t:=a-letzterjuniELIF a<=letzteraugustTHEN m:=8;t:=a-letzterjuli
+ELSE m:=9;t:=a-letzteraugustFI .oktoberbisdezember:IF a<=letzteroktoberTHEN m
+:=10;t:=a-letzterseptemberELIF a<=letzternovemberTHEN m:=11;t:=a-
+letzteroktoberELSE m:=12;t:=a-letzternovemberFI .END PROC tmj;INT PROC datum(
+TEXT CONST a):b:=a;conversionerror:=FALSE ;INT VAR seperator:=seppos,t,m,j;
+IF seperator=0THEN IF length(b)=6THEN t:=z(1)*10+z(2);m:=z(3)*10+z(4);j:=z(5)
+*10+z(6);INT VAR dummy:=datum(t,m,j);IF conversionerrorTHEN dummy:=nildatum
+FI ;LEAVE datumWITH dummyELSE leaveFI ELIF seperator=2THEN t:=z(1);ELIF
+seperator=3THEN t:=10*z(1)+z(2);ELSE leaveFI ;b:=subtext(b,seperator+1);
+seperator:=seppos;IF seperator=3THEN m:=z(1)*10+z(2);ELIF seperator=2THEN m:=
+z(1)ELSE leaveFI ;b:=subtext(b,seperator+1);IF length(b)=2THEN j:=z(1)*10+z(2
+)ELIF length(b)=4THEN j:=z(1)*1000+z(2)*100+z(3)*10+z(4)-1900;ELSE leaveFI ;
+IF conversionerrorTHEN nildatumELSE datum(t,m,j)FI .leave:LEAVE datumWITH
+nildatum.seppos:INT VAR q;FOR qFROM 2UPTO 3REP IF pos(seperatorzeichen,bSUB q
+)>0THEN LEAVE sepposWITH q;FI PER ;0.END PROC datum;INT PROC z(INT CONST wo):
+INT VAR e:=code(bSUB wo)-48;IF e<0OR e>9THEN conversionerror:=TRUE ;0ELSE e
+FI END PROC z;INT PROC datum(INT CONST t,m,jc):INT VAR j:=jc-1900IF j<0THEN j
+INCR 1900FI ;IF (j+160)DIV 160<>1THEN nildatumELIF t<0THEN nildatumELSE
+SELECT mOF CASE 1,3,5,7,8,10,12:IF t>31THEN nildatumELSE erg(t,m,j)FI CASE 4,
+6,9,11:IF t>30THEN nildatumELSE erg(t,m,j)FI CASE 2:IF t<29THEN erg(t,m,j)
+ELIF t=29AND jMOD 4=0THEN erg(t,m,j)ELSE nildatumFI OTHERWISE nildatumEND
+SELECT FI END PROC datum;INT PROC wochentag(INT CONST d):INT CONST x:=d-1;IF
+x<0THEN 6-(-xMOD 7)ELSE xMOD 7FI END PROC wochentag;INT PROC jahrestag(INT
+CONST d):INT VAR a;IF d<=beforefirstdayTHEN LEAVE jahrestagWITH -1FI ;a:=d;
+IF a<=0THEN aINCR (-(beforefirstday+1))FI ;a:=aMOD vierjahre;IF a>365THEN a
+DECR 366;a:=aMOD 365FI ;a+1END PROC jahrestag;INT PROC erg(INT CONST t,m,jc):
+INT VAR j:=jc;INT VAR result:=beforefirstday,tagimzyklus;IF j>=88THEN jDECR
+88;result:=-1FI ;resultINCR ((jDIV 4)*vierjahre);j:=jMOD 4;tagimzyklus:=
+tagundmonat+365*j;IF tagimzyklus>erstermaerzimschaltjahrTHEN tagimzyklusINCR
+1ELIF tagimzyklus=erstermaerzimschaltjahrAND m=3THEN tagimzyklusINCR 1FI ;
+result+tagimzyklus.erstermaerzimschaltjahr:60.tagundmonat:SELECT mOF CASE 1:t
+CASE 2:t+letzterjanuarCASE 3:t+letzterfebruarCASE 4:t+letztermaerzCASE 5:t+
+letzteraprilCASE 6:t+letztermaiCASE 7:t+letzterjuniCASE 8:t+letzterjuliCASE 9
+:t+letzteraugustCASE 10:t+letzterseptemberCASE 11:t+letzteroktoberCASE 12:t+
+letzternovemberOTHERWISE errorstop("monat > 12 oder < 0");0END SELECT .END
+PROC erg;INT PROC tag(INT CONST d):INT VAR t,m,j;tmj(d,t,m,j);tEND PROC tag;
+INT PROC jahr(INT CONST d):INT VAR t,m,j;tmj(d,t,m,j);j+1900END PROC jahr;
+INT PROC monat(INT CONST d):INT VAR t,m,j;tmj(d,t,m,j);mEND PROC monat;TEXT
+PROC datumjh(INT CONST d):INT VAR t,m,j;TEXT VAR e;tmj(d,t,m,j);IF t<0THEN
+LEAVE datumjhWITH ""FI ;e:=code(tDIV 10+48);eCAT code(tMOD 10+48);eCAT
+seperatorzeichen1;eCAT code(mDIV 10+48);eCAT code(mMOD 10+48);eCAT
+seperatorzeichen1;IF j<100THEN eCAT "19"ELSE eCAT "20";jDECR 100FI ;eCAT code
+(jDIV 10+48);eCAT code(jMOD 10+48);eEND PROC datumjh;TEXT PROC datum(INT
+CONST d):INT VAR t,m,j;TEXT VAR e;tmj(d,t,m,j);IF t<0THEN LEAVE datumWITH ""
+FI ;e:=code(tDIV 10+48);eCAT code(tMOD 10+48);eCAT seperatorzeichen1;eCAT
+code(mDIV 10+48);eCAT code(mMOD 10+48);eCAT seperatorzeichen1;eCAT code((j
+MOD 100)DIV 10+48);eCAT code(jMOD 10+48);eEND PROC datum;END PACKET date;
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.maskendesign b/app/baisy/2.2.1-schulis/src/isp.maskendesign
new file mode 100644
index 0000000..a90acca
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.maskendesign
@@ -0,0 +1,302 @@
+PACKET maskendesignDEFINES maskstart,aktuellendesignnamenlesen,maskgenstart,
+holestandardvorgaben,maskenattributespeichern,einlesenderattribute,
+generieremaske,zeigegeneriertemaske,formularentwerfen,formularspeichern,
+felderentwerfen,felddefinitionenspeichern,maskenformularzeigen,
+definitionsnamenlesen,gesuchtesfeldanzeigen,feldloeschen,feldspeichern,
+feldnichtspeichern,feldmalen,feldaufneuenschirmmalen,feldattributesetzen,
+holeattribute,listeallermasken,loescheneinermaske,kopierenaendern,
+zweitennamenlesen,kopiereneinermaske,druckeneinermaske,neuernamefuereinemaske
+:LET standardanfang=2;LET z="Liste aller Masken";LET nummernmaske=
+"mb maskenfeldnummern",id="mb maskenbearbeitung1",zusatz=
+"mb maskenbearbeitung2",mgmatrix="mb maskgenmatrix",mg="mb maskengenerator",
+b1="mb maskenfeldattribute";LET dru=49;LET maxfeldnr=200;LET praefixs=
+"Formular für: ",praefixf="form.";TEXT VAR symbalphag:="#",symbalphau:="&",
+symbankreuz:="^",symbgeheim:="'",symbmeldung:="%",symbfortsetzunga:="<",
+symbfortsetzunge:=">",symbpseudoblank:="!",unterlegungalpha:="_",
+unterlegungankreuz:="_",unterlegunggeheim:="_",unterlegungmeldung:="=",
+anzeigeankreuz:="x",anzeigegeheim:="-";TEXT VAR symbolischemaske:="";TEXT
+VAR formulardatei:="";TEXT VAR maskenname:="",zweitername:="";INT VAR
+feldname:=standardanfang,loeschfeld;BOOL VAR da;#DBMASKE VAR dbm;nil(dbm);#
+TEXT VAR eingangsname;TAG VAR maske;;TAG VAR aktuellemaske;INT VAR
+aktuelleposition;TEXT VAR logtextergaenzung;PROC maskstart:
+frageentwicklernachmaskennamen(id);aktuellendesignnamenlesenEND PROC
+maskstart;PROC frageentwicklernachmaskennamen(TEXT CONST start):eingangsname
+:=start;standardstartproc(start)END PROC frageentwicklernachmaskennamen;PROC
+aktuellendesignnamenlesen:standardmaskenfeld(maskenname,2);standardnproc;
+maskenname:=standardmaskenfeld(2);init(feld)END PROC
+aktuellendesignnamenlesen;PROC maskgenstart:zeigemaske;holestandardvorgaben;.
+zeigemaske:frageentwicklernachmaskennamen(mg).END PROC maskgenstart;PROC
+holestandardvorgaben:standardmaskenfeld("",1);standardmaskenfeld(maskenname,2
+);standardmaskenfeld(unterlegungalpha,3);standardmaskenfeld(symbalphag,4);
+standardmaskenfeld(symbalphau,5);standardmaskenfeld(symbankreuz,6);
+standardmaskenfeld(unterlegungankreuz,7);standardmaskenfeld(anzeigeankreuz,8)
+;standardmaskenfeld(symbgeheim,9);standardmaskenfeld(unterlegunggeheim,10);
+standardmaskenfeld(anzeigegeheim,11);standardmaskenfeld(symbmeldung,12);
+standardmaskenfeld(unterlegungmeldung,13);standardmaskenfeld(symbfortsetzunga
+,14);standardmaskenfeld(symbfortsetzunge,15);standardmaskenfeld(
+symbpseudoblank,16);standardnproc;maskenname:=standardmaskenfeld(2);
+unterlegungalpha:=standardmaskenfeld(3);symbalphag:=standardmaskenfeld(4);
+symbalphau:=standardmaskenfeld(5);symbankreuz:=standardmaskenfeld(6);
+unterlegungankreuz:=standardmaskenfeld(7);anzeigeankreuz:=standardmaskenfeld(
+8);symbgeheim:=standardmaskenfeld(9);unterlegunggeheim:=standardmaskenfeld(10
+);anzeigegeheim:=standardmaskenfeld(11);symbmeldung:=standardmaskenfeld(12);
+unterlegungmeldung:=standardmaskenfeld(13);symbfortsetzunga:=
+standardmaskenfeld(14);symbfortsetzunge:=standardmaskenfeld(15);
+symbpseudoblank:=standardmaskenfeld(16);trans(symbpseudoblank+
+symbfortsetzunga+symbfortsetzunge);.END PROC holestandardvorgaben;PROC
+formularentwerfen(INT CONST nummerderauskunft):IF maskenname=""THEN
+keineeingabe;return(1)ELSE setzedateinamen;IF NOT exists(symbolischemaske)
+THEN IF NOT maskedaTHEN logtextergaenzung:="eingefügt";neuELSE
+logtextergaenzung:="geändert";aendernFI ;FI ;formularzeigen(nummerderauskunft
+)FI .keineeingabe:aktuelleposition:=standardanfang;standardmeldung(26,"").
+setzedateinamen:symbolischemaske:=praefixs+maskenname;formulardatei:=praefixf
++maskenname.maskeda:maskegibtes(maskenname).neu:init(feld);
+erzeugeleeresymbolischemaske(maskenname).aendern:erzeugesymbolischemaske(
+maskenname).END PROC formularentwerfen;PROC formularzeigen(INT CONST
+nummerderauskunft):page;sagderauskunftwasaufdemeingangsschirmstand;editiere(
+symbolischemaske,"a",FALSE ).sagderauskunftwasaufdemeingangsschirmstand:TEXT
+VAR eingangsinfo:="";eingangsinfoCAT infozeile("geschützt",symbalphag);
+eingangsinfoCAT infozeile("ungeschützt",symbalphau);eingangsinfoCAT infozeile
+("Ankreuzfeld",symbankreuz);eingangsinfoCAT infozeile("sonst. Geheimfeld",
+symbgeheim);eingangsinfoCAT infozeile("Meldungsfeld",symbmeldung);
+eingangsinfoCAT infozeile("Beginn Fortsetzung",symbfortsetzunga);eingangsinfo
+CAT infozeile("Ende Fortsetzung",symbfortsetzunge);eingangsinfoCAT infozeile(
+"Überdeckungszeichen",symbpseudoblank);eingangsinfoCAT auskunftstextende;
+ergaenzeauskunft(eingangsinfo,nummerderauskunft).END PROC formularzeigen;
+PROC generieremaske:erzeugemaske(maskenname);page;show(maske);
+zeigegeneriertemaskeEND PROC generieremaske;PROC zeigegeneriertemaske:INT
+VAR feldind,maxfeld:=min(fields(maske),maxfeldnr);ROW maxfeldnrTEXT VAR
+maskenfeld;INT VAR einstieg:=maxfeldnr;FOR feldindFROM 1UPTO maxfeldREP IF
+fieldexists(maske,feldind)THEN maskenfeld(feldind):="";put(maske,"",feldind);
+cursor(maske,feldind);out(text(feldind));IF (NOT protected(maske,feldind))
+CAND (feldind<einstieg)THEN einstieg:=feldindFI ;FI PER ;IF einstieg>maxfeld
+THEN einstieg:=standardanfangFI ;get(maske,maskenfeld,einstieg)END PROC
+zeigegeneriertemaske;ROW maxfeldnrTEXT VAR feld;INT VAR maxfeld;PROC
+maskenattributesetzen:maskenholen;formularzeigen;attributezeigen;
+einlesenderattribute.maskenholen:initmaske(aktuellemaske,mgmatrix).
+formularzeigen:page;standardkopfmaskeausgeben(text(vergleichsknoten));show(
+aktuellemaske).attributezeigen:INT VAR i;INT VAR maxfields:=fields(
+aktuellemaske);feld(1):="";TEXT VAR hellername:=""+maskenname+" ";feld(2):=
+hellername+(length(aktuellemaske,2)-length(hellername))*" ";INT VAR zaehler:=
+3;FOR iFROM 2UPTO min(fields(maske),maxfeldnr-1)REP IF (fieldexists(maske,i))
+THEN IF feld(zaehler)=""THEN feld(zaehler):=text(i,3)+text(auskunftsnr(maske,
+i),5)+text(symbolicname(maske,i),3)FI ;zaehlerINCR 1FI PER ;FOR iFROM 1UPTO
+zaehler-1REP IF fieldexists(aktuellemaske,i)THEN put(aktuellemaske,feld(i),i)
+FI PER ;FOR iFROM zaehlerUPTO maxfieldsREP protect(aktuellemaske,i,TRUE )PER
+;maxfeld:=zaehler-1;aktuelleposition:=3.END PROC maskenattributesetzen;PROC
+einlesenderattribute:get(aktuellemaske,feld,aktuelleposition)END PROC
+einlesenderattribute;PROC maskenattributespeichern:INT VAR i;IF NOT
+maskengeneratorTHEN gibtestag;IF NOT daTHEN meldezuerstformular;LEAVE
+maskenattributespeichernFI ;FOR iFROM 1UPTO maxfeldnrREP feld(i):=""PER ;FI ;
+maskenattributesetzen;FOR iFROM 3UPTO maxfeldREP INT VAR feldnr:=int(subtext(
+feld(i),1,3));auskunftsnr(maske,feldnr,int(subtext(feld(i),4,8)));
+symbolicname(maske,feldnr,int(subtext(feld(i),9,11)))PER .maskengenerator:
+eingangsname=mg.meldezuerstformular:standardmeldung(32,"");return(1).END
+PROC maskenattributespeichern;PROC formularspeichern(INT CONST zurueck):
+schreibemaske(maske,maskenname);logbucheintrag(logtextergaenzung);IF exists(
+formulardatei)THEN forget(formulardatei,quiet)FI ;return(zurueck);
+frageentwicklernachmaskennamen(eingangsname);meldespeicherung.
+meldespeicherung:standardmeldung(27,"").END PROC formularspeichern;PROC
+felderentwerfen:gibtestag;IF daTHEN initialisiereELSE meldezuerstformularFI .
+initialisiere:feldname:=standardanfang;maskenformularzeigen;
+definitionsnamenlesen.meldezuerstformular:standardmeldung(32,"");return(1).
+END PROC felderentwerfen;PROC gibtestag:initmaske(maske,maskenname);da:=
+maskegibtes(maskenname)END PROC gibtestag;PROC felddefinitionenspeichern:
+schreibemaske(maske,maskenname);return(2);frageentwicklernachmaskennamen(id);
+meldespeicherung;.meldespeicherung:standardmeldung(28,"").END PROC
+felddefinitionenspeichern;PROC maskenformularzeigen:
+maskezuderfelderstelltwerdensollzeigen;entwicklernachfeldnamenfragen.
+maskezuderfelderstelltwerdensollzeigen:page;show(maske).END PROC
+maskenformularzeigen;PROC entwicklernachfeldnamenfragen:aktuelleposition:=
+standardanfang;initmaske(aktuellemaske,nummernmaske);show(aktuellemaske).END
+PROC entwicklernachfeldnamenfragen;PROC definitionsnamenlesen:TEXT VAR f:=
+text(feldname);ROW maxfeldnrTEXT VAR feld;init(feld);feld(2):=f;loeschfeld:=
+feldname;putget(aktuellemaske,feld,aktuelleposition);feldname:=int(feld(
+aktuelleposition));loeschemeldung(aktuellemaske);END PROC
+definitionsnamenlesen;PROC gesuchtesfeldanzeigen:IF NOT fieldexists(maske,
+feldname)THEN meldefalschenummer;loeschenELSE TEXT CONST pointer:=(length(
+maske,feldname))*"?";loeschen;put(maske,pointer,feldname);meldegesuchtesfeld
+FI ;return(1).meldegesuchtesfeld:melde(aktuellemaske,10).loeschen:put(maske,
+"",loeschfeld).END PROC gesuchtesfeldanzeigen;PROC meldefalschenummer:melde(
+aktuellemaske,9).END PROC meldefalschenummer;LET null="�";TEXT VAR xrow,yrow,
+lrow,trow;BOOL VAR a,b,c,d,e;INT VAR sym,aus;TEXT VAR geheimzeichen;PROC
+feldloeschen:INT VAR x,y;IF fieldexists(maske,feldname)THEN clearfield(maske,
+feldname);put(maske,"",loeschfeld);getcursor(x,y);cursor(1,y);out(formline(
+maske,y));melde(aktuellemaske,42)ELSE meldefalschenummerFI ;return(1)END
+PROC feldloeschen;PROC feldmalen:xrow:="";yrow:=" ";lrow:="";trow:="";IF
+menuedraussenTHEN reorganizescreenFI ;designfield(maske,feldname,xrow,yrow,
+lrow,trow)END PROC feldmalen;PROC feldaufneuenschirmmalen:reorganizescreen;
+designfield(maske,feldname,xrow,yrow,lrow,trow)END PROC
+feldaufneuenschirmmalen;PROC feldattributesetzen:INT VAR gz;fieldinfos(maske,
+feldname,gz,a,b,c,d,e);geheimzeichen:=code(gz);baisymaskeholen;sym:=
+symbolicname(maske,feldname);aus:=auskunftsnr(maske,feldname);show(
+aktuellemaske);holeattribute;END PROC feldattributesetzen;PROC
+baisymaskeholen:initmaske(aktuellemaske,b1)END PROC baisymaskeholen;PROC
+holeattribute:ROW maxfeldnrTEXT VAR feld;init(feld);IF bTHEN feld(2):="X"FI ;
+IF cTHEN feld(3):=geheimzeichenFI ;feld(4):=text(sym);putget(aktuellemaske,
+feld,aktuelleposition);b:=feld(2)<>"";c:=feld(3)<>"";geheimzeichen:=feld(3);
+sym:=int(feld(4))END PROC holeattribute;PROC feldspeichern:definefield(maske,
+xrow,yrow,lrow,trow,sym,aus,feldname,geheimzeichen,null);setfieldinfos(maske,
+feldname,a,b,c);maskenformularzeigen;meldevorlaeufiguebernommen;return(3).
+meldevorlaeufiguebernommen:melde(aktuellemaske,41).END PROC feldspeichern;
+PROC feldnichtspeichern(INT CONST schritte):maskenformularzeigen;return(
+schritte)END PROC feldnichtspeichern;PROC listeallermasken:
+meldezusammenstellung;listen.listen:listezusammenstellen;zeigendermaskenliste
+.meldezusammenstellung:store(FALSE );standardmeldung(7,"");store(TRUE ).
+listezusammenstellen:maskenliste(z).END PROC listeallermasken;PROC
+zeigendermaskenliste:page;editiere(z)END PROC zeigendermaskenliste;PROC
+loescheneinermaske:IF maskenname=""THEN keineeingabe;return(1)ELSE IF
+maskegibtes(maskenname)THEN loeschemaske(maskenname);logbucheintrag(
+"gelöscht");meldeloeschungELSE maskegibtesnichtFI ;return(1)FI .
+maskegibtesnicht:standardmeldung(8,"").meldeloeschung:standardmeldung(33,"").
+keineeingabe:standardmeldung(26,"").END PROC loescheneinermaske;PROC
+kopierenaendern:maskekopierenoderaendern;IF NOT daTHEN maskegibtesnichtFI .
+maskegibtesnicht:standardmeldung(8,"");return(1).END PROC kopierenaendern;
+PROC maskekopierenoderaendern:IF NOT maskegibtes(maskenname)THEN da:=FALSE
+ELSE da:=TRUE ;frageentwicklernachmaske;zweitennamenlesenFI .
+frageentwicklernachmaske:aktuelleposition:=standardanfang;initmaske(
+aktuellemaske,zusatz);zweitername:="";show(aktuellemaske).END PROC
+maskekopierenoderaendern;PROC zweitennamenlesen:ROW maxfeldnrTEXT VAR feld;
+init(feld);feld(2):=zweitername;putget(aktuellemaske,feld,aktuelleposition);
+zweitername:=feld(2);loeschemeldung(aktuellemaske).END PROC zweitennamenlesen
+;PROC kopiereneinermaske:IF maskegibtes(zweitername)THEN da:=TRUE ;return(1)
+ELSE maskekopieren(maskenname,zweitername);da:=FALSE FI ;IF daTHEN gibtsschon
+ELSE return(2);frageentwicklernachmaskennamen(id);meldekopierungFI .
+gibtsschon:melde(aktuellemaske,31).meldekopierung:melde(aktuellemaske,29).
+END PROC kopiereneinermaske;PROC neuernamefuereinemaske:IF maskegibtes(
+zweitername)THEN da:=TRUE ;return(1)ELSE maskeumbenennen(maskenname,
+zweitername);da:=FALSE ;FI ;IF daTHEN gibtsschonELSE return(2);
+frageentwicklernachmaskennamen(id);meldeumbenennungFI .gibtsschon:melde(
+aktuellemaske,31).meldeumbenennung:melde(aktuellemaske,30).END PROC
+neuernamefuereinemaske;PROC druckeneinermaske:BOOL VAR maskeda;TAG VAR t;IF
+maskenname=""THEN keineeingabe;return(1)ELSE maskeda:=maskegibtes(t,
+maskenname);IF maskedaTHEN meldedrucken;fuehredurchELSE maskegibtesnichtFI ;
+return(1)FI .maskegibtesnicht:standardmeldung(8,"").keineeingabe:
+standardmeldung(26,"").meldedrucken:standardmeldung(dru,"").fuehredurch:
+kopfindatei;formularindatei;feldinformationenindatei;drucken.kopfindatei:LET
+temp="temporäre Druckdatei";FILE VAR f:=sequentialfile(output,temp);putline(f
+,"Name der Maske: "+maskenname);putline(f,"Stand: "+date+" "+
+timeofday);line(f,2).drucken:print(temp);forget(temp,quiet).formularindatei:
+INT VAR fz:=min(fields(t),maxfeldnr);IF fz>0THEN INT VAR i;FOR iFROM 1UPTO fz
+REP IF fieldexists(t,i)THEN fill(t,text(i),i)FI PER FI ;tTO f.
+feldinformationenindatei:line(f,2);IF fz>0THEN ueberschrift;FOR iFROM 1UPTO
+fzREP IF fieldexists(t,i)THEN tabellenzeileFI PER FI .ueberschrift:putline(f,
+"Nr...Länge...geschützt....geheim.....Symbol.....Auskunftsnr....").
+tabellenzeile:INT VAR gz;BOOL VAR a,b,c,d,e;fieldinfos(t,i,gz,a,b,c,d,e);
+TEXT VAR geheim:=code(gz);INT VAR sym:=0,aus:=0;sym:=symbolicname(t,i);aus:=
+auskunftsnr(t,i);put(f,text(text(i),4));put(f,text(text(length(t,i)),7));IF b
+THEN put(f,text("X",13))ELSE put(f,13*" ")FI ;IF cTHEN put(f,text(geheim,11))
+ELSE put(f,11*" ")FI ;IF sym<>0THEN put(f,text(text(sym),10))ELSE put(f,10*
+" ")FI ;IF aus<>0THEN put(f,text(aus))FI ;line(f,1).END PROC
+druckeneinermaske;PROC schreibemaske(TAG VAR ta,TEXT CONST t):setzemaske(ta);
+maskespeichern(t)END PROC schreibemaske;PROC loeschemaske(TEXT CONST t):
+maskeloeschen(t)END PROC loeschemaske;BOOL PROC maskegibtes(TAG VAR t,TEXT
+CONST name):initmaske(t,name);maskegibtes(name)END PROC maskegibtes;PROC
+erzeugeleeresymbolischemaske(TEXT CONST maskenname):oeffneausgabedatei;
+schreibemarkierungenindatei.oeffneausgabedatei:TEXT CONST dateiname:=praefixs
++maskenname;forget(dateiname,quiet);FILE VAR f:=sequentialfile(output,
+dateiname).schreibemarkierungenindatei:dreileerzeilen;grundlinie;
+vieleleerzeilen;endlinie.dreileerzeilen:INT VAR i;FOR iFROM 1UPTO 3REP
+putline(f,"")PER .grundlinie:putline(f,78*unterlegungmeldung).vieleleerzeilen
+:FOR iFROM 1UPTO 18REP putline(f,"")PER .endlinie:putline(f,3*
+unterlegungmeldung+72*symbmeldung+3*unterlegungmeldung).END PROC
+erzeugeleeresymbolischemaske;PROC erzeugesymbolischemaske(TEXT CONST
+maskenname):holeformular;oeffneausgabedatei;setzesymbole;
+zeigesymbolischemaske.holeformular:INT VAR i;INT CONST maxmaskenfeld:=
+maxfeldnr-1;initmaske(maske,maskenname);FOR iFROM 2UPTO maxmaskenfeldREP IF
+fieldexists(maske,i)THEN feld(i+1):=text(i,3)+text(auskunftsnr(maske,i),5)+
+text(symbolicname(maske,i),3)ELSE feld(i+1):=""FI PER .oeffneausgabedatei:
+TEXT CONST dateiname:=praefixs+maskenname;forget(dateiname,quiet);FILE VAR f
+:=sequentialfile(output,dateiname).zeigesymbolischemaske:maskeTO f.
+setzesymbole:erstesfeld;REP symbolisierefeld;naechstesfeldUNTIL letztesfeld
+PER ;abschluss.erstesfeld:INT VAR aktfeld:=firstfield(maske),zeilennr:=1;INT
+VAR altesfeld:=aktfeld;INT VAR zeilenpointer:=1.naechstesfeld:altesfeld:=
+aktfeld;aktfeld:=nextfield(maske,aktfeld).letztesfeld:aktfeld<0.
+symbolisierefeld:setzezeile;pruefeobfortsetzung;uebernehmenbiszudiesemfeld;
+holeinformationenueberdasfeld;fuelledasfeldmitdensymbolen.
+fuelledasfeldmitdensymbolen:TEXT VAR alteszeichen;IF aktfeld=1THEN fill(maske
+,length(maske,1)*symbmeldung,aktfeld);alteszeichen:=symbmeldungELSE IF
+geschuetztTHEN fill(maske,laenge*symbalphag,aktfeld);alteszeichen:=symbalphag
+ELSE IF geheimTHEN IF laenge=1THEN IF code(gz)=anzeigeankreuzTHEN fill(maske,
+symbankreuz,aktfeld);alteszeichen:=symbankreuzELSE fill(maske,symbgeheim,
+aktfeld);alteszeichen:=symbgeheimFI ELSE fill(maske,laenge*symbgeheim,aktfeld
+);alteszeichen:=symbgeheimFI ELSE fill(maske,laenge*symbalphau,aktfeld);
+alteszeichen:=symbalphauFI FI FI .holeinformationenueberdasfeld:INT VAR gz,x,
+y,laenge:=length(maske,aktfeld);BOOL VAR a,geschuetzt,geheim,d,e;fieldinfos(
+maske,aktfeld,gz,a,geschuetzt,geheim,d,e);.setzezeile:woliegtdasfeld;
+allevorhergehendenzeilen.woliegtdasfeld:cursor(maske,aktfeld);getcursor(x,y).
+allevorhergehendenzeilen:IF y>zeilennrTHEN INT VAR xalt:=x;x:=length(formline
+(maske,zeilennr))+1;pruefeobfortsetzung;uebernehmenbiszudiesemfeld;x:=xalt;
+zeilenpointer:=1;zeileaktualisierenFI .zeileaktualisieren:zeilennr:=y;.
+abschluss:y:=ysize(maske)+1;allevorhergehendenzeilen.schoneinfeldinderzeile:
+zeilenpointer<>1.pruefeobfortsetzung:BOOL VAR fortsetzung:=
+schoneinfeldinderzeileCAND (pos(subtext(formline(maske,zeilennr),
+zeilenpointer,x-1),alteszeichen,laenge+1)>0).uebernehmenbiszudiesemfeld:IF
+fortsetzungTHEN fill(maske,symbfortsetzunga+((length(maske,altesfeld)-2)*
+alteszeichen)+symbfortsetzunge,altesfeld)FI ;zeilenpointer:=x.END PROC
+erzeugesymbolischemaske;PROC feldanfang(INT VAR fa,TEXT CONST zeile):INT
+CONST zeilenlaenge:=length(zeile);WHILE NOT issymbol(subtext(zeile,fa,fa))
+REP faINCR 1UNTIL NOT inzeilePER .inzeile:NOT (fa>zeilenlaenge).END PROC
+feldanfang;BOOL PROC issymbol(TEXT CONST s):TEXT VAR symb:=s;symbol(symb);
+symb<>""END PROC issymbol;PROC symbol(TEXT VAR s):IF NOT ((s=symbalphag)OR (s
+=symbalphau)OR (s=symbankreuz)OR (s=symbgeheim)OR (s=symbmeldung)OR (s=
+symbfortsetzunga)OR (s=symbfortsetzunge))THEN s:=""FI END PROC symbol;PROC
+felddefinition(INT VAR fa,TEXT VAR zeile,INT VAR feldnr,INT CONST znr):IF
+feldmitteilfeldernTHEN teilfelderELSE einfachesfeldFI ;setzefeld.
+feldmitteilfeldern:subtext(zeile,fa,fa)=symbfortsetzunga.teilfelder:
+geschuetzt:=FALSE ;geheim:=FALSE ;xkoord:="";ykoord:="";laengen:="";
+geheimzeichen:=code(0);TEXT VAR gesamtunterlegung:=unterlegungalpha;BOOL VAR
+gesamtgeschuetzt:=TRUE ,gesamtgeheim:=FALSE ;teilfeldbearbeitung;unterlegung
+:=gesamtunterlegung;geschuetzt:=gesamtgeschuetzt;geheim:=gesamtgeheim.
+teilfeldbearbeitung:REP efeld(zeile,fa,unterlegung,xkoord,ykoord,laengen,
+geschuetzt,geheim,geheimzeichen,znr);IF (unterlegung=symbfortsetzunge)COR (
+unterlegung="")THEN LEAVE teilfeldbearbeitungELIF unterlegung<>""THEN
+gesamtunterlegung:=unterlegung;gesamtgeschuetzt:=geschuetzt;gesamtgeheim:=
+geheimFI ;faINCR 1;feldanfang(fa,zeile);PER .einfachesfeld:TEXT VAR
+unterlegung;BOOL VAR geschuetzt:=FALSE ,geheim:=FALSE ;TEXT VAR xkoord:="",
+ykoord:="",laengen:="",geheimzeichen:=code(0);efeld(zeile,fa,unterlegung,
+xkoord,ykoord,laengen,geschuetzt,geheim,geheimzeichen,znr);.setzefeld:INT
+VAR fnr;IF meldungsfeldTHEN fnr:=1;geschuetzt:=TRUE ELSE fnr:=feldnr;feldnr
+INCR 1FI ;definefield(maske,xkoord,ykoord,laengen,code(0),0,0,fnr,
+geheimzeichen,code(0));setfieldinfos(maske,fnr,FALSE ,geschuetzt,geheim);
+ersetzedurchunterlegung(zeile,xkoord,laengen,unterlegung).meldungsfeld:
+subtext(zeile,fa,fa)=symbmeldung.END PROC felddefinition;PROC
+ersetzedurchunterlegung(TEXT VAR zeile,TEXT CONST xkoord,laengen,unterlegung)
+:INT VAR eintragszahl:=length(xkoord),ind;FOR indFROM 1UPTO eintragszahlREP
+ersetzungPER .ersetzung:INT VAR fstart,flaenge;fstart:=code(subtext(xkoord,
+ind,ind));flaenge:=code(subtext(laengen,ind,ind));replace(zeile,fstart,
+flaenge*unterlegung);.END PROC ersetzedurchunterlegung;PROC efeld(TEXT CONST
+zeile,INT VAR fa,TEXT VAR unterlegung,xkoord,ykoord,laengen,BOOL VAR
+geschuetzt,geheim,TEXT VAR geheimzeichen,INT CONST znr):INT VAR poszeile:=fa;
+IF issymbol(subtext(zeile,poszeile,poszeile))THEN WHILE issymbol(subtext(
+zeile,poszeile+1,poszeile+1))REP poszeileINCR 1PER ;xkoordCAT code(fa);ykoord
+CAT code(znr);laengenCAT code(poszeile-fa+1);fa:=poszeile;FI ;TEXT CONST s:=
+subtext(zeile,fa,fa);IF s=symbalphagTHEN geschuetzt:=TRUE ;unterlegung:=
+unterlegungalphaELIF s=symbalphauTHEN geschuetzt:=FALSE ;unterlegung:=
+unterlegungalphaELIF s=symbankreuzTHEN geheim:=TRUE ;unterlegung:=
+unterlegungankreuz;geheimzeichen:=anzeigeankreuzELIF s=symbgeheimTHEN geheim
+:=TRUE ;unterlegung:=unterlegunggeheim;geheimzeichen:=anzeigegeheimELIF s=
+symbmeldungTHEN unterlegung:=unterlegungmeldungELIF s=symbfortsetzungeTHEN
+unterlegung:=symbfortsetzungeELSE unterlegung:=""FI END PROC efeld;PROC
+erzeugemaske(TEXT CONST maskenname):oeffnedatei;
+generieremaskeausformulardatei;uebertrageformular;.oeffnedatei:forget(
+formulardatei,quiet);copy(symbolischemaske,formulardatei);FILE VAR datei:=
+sequentialfile(modify,formulardatei).uebertrageformular:input(datei);dateiTO
+maske;forget(formulardatei,quiet).generieremaskeausformulardatei:
+holeerstezeile;REP generierefelderdieserzeile;schreibeformularzeile;
+holenaechstezeileUNTIL dateiendePER .holeerstezeile:ananfang;lesezeile.
+holenaechstezeile:einsweiter;lesezeile.dateiende:eof(datei).einsweiter:down(
+datei,1).ananfang:nil(maske);TEXT VAR zeile:="";toline(datei,1);INT VAR
+feldnr:=2.lesezeile:readrecord(datei,zeile).schreibeformularzeile:writerecord
+(datei,zeile).generierefelderdieserzeile:startezeile;REP
+findefeldspezifikation;definierenaechstesfeldPER .startezeile:INT VAR fa:=1.
+findefeldspezifikation:feldanfang(fa,zeile);IF fa>length(zeile)THEN LEAVE
+generierefelderdieserzeileFI ;.definierenaechstesfeld:felddefinition(fa,zeile
+,feldnr,lineno(datei));faINCR 1.END PROC erzeugemaske;TEXT PROC infozeile(
+TEXT CONST t,s):auskunftstextende+t+" = "+sEND PROC infozeile;PROC init(ROW
+maxfeldnrTEXT VAR feld):INT VAR i;FOR iFROM 1UPTO maxfeldnrREP feld(i):=""
+PER END PROC init;PROC logbucheintrag(TEXT CONST logergaenzung):TEXT VAR
+eintrag:="Maske ";eintragCAT maskenname;eintragCAT " ";eintragCAT
+logergaenzung;logeintrag(eintrag)END PROC logbucheintrag;END PACKET
+maskendesign
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.meldungsfunktionen b/app/baisy/2.2.1-schulis/src/isp.meldungsfunktionen
new file mode 100644
index 0000000..1e65ec3
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.meldungsfunktionen
@@ -0,0 +1,64 @@
+PACKET ispmeldungsfunktionenDEFINES melde,meldeauffaellig,loeschemeldung,
+meldungstext,initmeldungsfunktionen:LET maxmeldungen=500,
+namedesmeldungsdatenraums="Meldungsdatenraum";BOUND ROW maxmeldungenTEXT VAR
+dsmeldung;INT VAR geliefert;LET anzahl=25;LET zeinfuegen="#",znormeinfuegen=
+"+",zhelleinfuegen="#",normausgabe=1,hellausgabe=2;BOOL VAR meldungdraussen:=
+FALSE ;PROC initmeldungsfunktionen:TASK VAR savetask;LET savetaskname=
+"anwendung";savetask:=task(savetaskname);IF NOT meldungsdatenraumdaTHEN IF
+exists(namedesmeldungsdatenraums,savetask)THEN fetch(
+namedesmeldungsdatenraums,savetask)ELSE meldungenindatenraumschreiben;save(
+namedesmeldungsdatenraums,savetask)FI ;FI ;dsmeldung:=old(
+namedesmeldungsdatenraums).meldungsdatenraumda:exists(
+namedesmeldungsdatenraums).END PROC initmeldungsfunktionen;PROC melde(TAG
+CONST t,INT CONST i):meldung(t,i,"",TRUE ,"",TRUE ,FALSE )END PROC melde;
+PROC melde(TAG CONST t,INT CONST i,TEXT CONST meldvar):meldung(t,i,"",TRUE ,
+meldvar,TRUE ,FALSE )END PROC melde;PROC meldeauffaellig(TAG CONST t,INT
+CONST i):meldung(t,i,"",TRUE ,"",TRUE ,TRUE )END PROC meldeauffaellig;PROC
+melde(TAG CONST t,TEXT CONST mtext):meldung(t,0,mtext,FALSE ,"",TRUE ,FALSE )
+END PROC melde;PROC melde(TAG CONST t,TEXT CONST mtext,TEXT CONST meldvar):
+meldung(t,0,mtext,FALSE ,meldvar,TRUE ,FALSE )END PROC melde;PROC
+meldeauffaellig(TAG CONST t,TEXT CONST mtext):meldung(t,0,mtext,FALSE ,"",
+TRUE ,TRUE )END PROC meldeauffaellig;PROC meldung(TAG CONST t,INT CONST mnr,
+TEXT CONST mt,BOOL CONST was,TEXT CONST mvartext,BOOL CONST zentriert,BOOL
+CONST hell):IF fieldexists(t,1)THEN TEXT VAR me;IF wasTHEN me:=meldungstext(
+mnr)ELSE me:=mtFI ;IF variablemeldungTHEN vartexteinfuegenFI ;IF hellTHEN
+erhellen(t,me)FI ;IF zentriertTHEN centerFI ;put(t,me,1);meldungdraussen:=
+TRUE FI .center:INT CONST lmax:=length(t,1);INT CONST lmeld:=length(me);INT
+CONST dif:=lmax-lmeld;IF lmeld>=lmaxTHEN LEAVE centerFI ;INT CONST bz:=dif
+DIV 2;me:=bz*" "+me+(dif-bz)*" ".variablemeldung:INT VAR einfuegepos:=pos(me,
+zeinfuegen);einfuegepos<>0.vartexteinfuegen:TEXT VAR ersatztext;INT VAR
+textattr,aktpos:=1,posnorm,poshell;WHILE einfuegepos<>0REP
+holeersatztextundattributausersatzzeile;ersetzeeinfuegezeichendurchersatztext
+;einfuegepos:=pos(me,zeinfuegen)PER .holeersatztextundattributausersatzzeile:
+posnorm:=pos(mvartext,znormeinfuegen,aktpos);poshell:=pos(mvartext,
+zhelleinfuegen,aktpos);IF posnorm=0THEN helloderendeELSE normoderhellFI .
+helloderende:IF poshell=0THEN ersatztext:="";textattr:=normausgabeELSE
+holeteiltext(ersatztext,mvartext,aktpos,poshell);textattr:=hellausgabeFI .
+normoderhell:IF poshell=0THEN holeteiltext(ersatztext,mvartext,aktpos,posnorm
+);textattr:=normausgabeELIF normzuerstTHEN holeteiltext(ersatztext,mvartext,
+aktpos,posnorm);textattr:=normausgabeELSE holeteiltext(ersatztext,mvartext,
+aktpos,poshell);textattr:=hellausgabeFI .normzuerst:posnorm<poshell.
+ersetzeeinfuegezeichendurchersatztext:SELECT textattrOF CASE 1:change(me,
+zeinfuegen,ersatztext)CASE 2:erhellen(t,ersatztext);change(me,zeinfuegen,
+ersatztext)ENDSELECT .END PROC meldung;PROC holeteiltext(TEXT VAR akttext,
+TEXT CONST ersatzzeile,INT VAR abarbeitpos,INT CONST textendepos):akttext:=
+subtext(ersatzzeile,abarbeitpos,textendepos-1);abarbeitpos:=textendepos+1;
+END PROC holeteiltext;PROC loeschemeldung(TAG CONST t):IF meldungdraussen
+THEN put(t,"",1);meldungdraussen:=FALSE FI ;END PROC loeschemeldung;PROC
+erhellen(TAG CONST t,TEXT VAR helltext):TEXT VAR ht:=helltext;helltext:=""+
+subtext(ht,1,meldfeldlaenge-4)+" ".meldfeldlaenge:length(t,1).END PROC
+erhellen;TEXT PROC meldungstext(INT CONST meldnummer):IF meldnummer<0OR
+meldnummer>maxmeldungenTHEN ""ELSE dsmeldung(meldnummer)FI END PROC
+meldungstext;PROC meldungstext(INT CONST meldnr,TEXT VAR meldetext):meldetext
+:=meldungstext(meldnr)END PROC meldungstext;PROC
+meldungenindatenraumschreiben:INT VAR iinit;forget(namedesmeldungsdatenraums,
+quiet);dsmeldung:=new(namedesmeldungsdatenraums);FOR iinitFROM 1UPTO
+maxmeldungenREP dsmeldung(iinit):=""PER ;systemdbon;lieserstemeldung;
+dsmeldung(meldungsnr):=mtext;geliefert:=anzahl;WHILE
+meldungindatenraumaufzunehmenAND geliefert=anzahlREP geliefert:=anzahl;
+multisucc(dnrmeld,geliefert);FOR iinitFROM 1UPTO geliefertREP stackentry(
+iinit);dsmeldung(meldungsnr):=mtext;PER ;PER ;systemdboff.meldungsnr:intwert(
+fnrmeldungsname).mtext:wert(fnrmeldungstext).lieserstemeldung:first(dnrmeld).
+meldungindatenraumaufzunehmen:dbstatus=ok.END PROC
+meldungenindatenraumschreiben;END PACKET ispmeldungsfunktionen;
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.monitor sicherungstask b/app/baisy/2.2.1-schulis/src/isp.monitor sicherungstask
new file mode 100644
index 0000000..2d4a7be
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.monitor sicherungstask
@@ -0,0 +1,126 @@
+PACKET ispmonitorsicherungstaskDEFINES ispmonitorsicherungstask,sndbaisyfiles
+,rcvbaisyfiles,sndidafiles,rcvidafiles,ida,statistik,:LET initcode=25,
+listcode=26,checkcode=27,formatcode=40,logonarchivecode=45,logoffarchivecode=
+46,dbvomserver=47,dbzumserver=48,dbaufdisk=49,dbvondisk=50,dddrucken=51,ack=0
+,errornak=2,nak=1,continuecode=100,endcode=37,savedbcode=38,restoredbcode=39,
+maxthesaurusentry=252;LET showcode=12,mlddbnichtda=
+"Keine vollständige DB bei Sicherungstask!",formfilename=
+"Namen der Formulare",statistikserver="statistik server",#25.09.90#
+statistikbasis="STATISTIK.basis";BOOL VAR idasicherung:=FALSE ,
+statistiksicherung:=FALSE ;#25.09.90#FILE VAR formfile;TEXT VAR nameoftask:=
+"",formname:="";LET stundenplanserver="stundenplan server";LET
+stundenplanpraefix="Stundenplan-*";TASK VAR stundenplanservertask;LET
+kurswahlserver="kurswahl server";LET kurswahlpraefix="Kurswahl-*";TASK VAR
+kurswahlservertask;BOUND TEXT VAR message;DATASPACE VAR ds;INT VAR replycode;
+PROC ispmonitorsicherungstask(TEXT CONST sicherungstask):nameoftask:=
+sicherungstask;globalmanager(PROC (DATASPACE VAR ,INT CONST ,INT CONST ,TASK
+CONST )ispmonitor)ENDPROC ispmonitorsicherungstask;PROC ispmonitor(DATASPACE
+VAR dsp,INT CONST orderp,phasep,TASK CONST ordertaskp):INT VAR replycode;
+TASK VAR begintask;IF orderp>=continuecodeAND ordertaskp=supervisorTHEN
+forget(dsp);spoolcommand(orderp)ELSE enablestop;ordertask(ordertaskp);SELECT
+orderpOF CASE initcode:cleararchive;CASE listcode:listarchive;CASE
+dbvomserver:forget(ALL myself-schulisdbname#17.10.88#-baisydbname);IF ida
+THEN rcvidafiles#25.09.90#ELIF statistikTHEN rcvstatfilesELSE fetchdb(
+nameoftask);IF baisyTHEN rcvbaisyfilesELSE receivestundenplan;
+receivekurswahldatenFI ;FI CASE dbzumserver:IF idaTHEN sndidafiles#25.09.90#
+ELIF statistikTHEN sndstatfilesELSE restoredb(nameoftask);IF baisyTHEN
+sndbaisyfilesELSE sendstundenplan;sendkurswahldatenFI FI CASE dbaufdisk:IF
+ida#25.09.90#THEN savetoarchive(all-schulisdbname)ELIF NOT statistikCAND
+dbnichtkomplettTHEN errorstop(mlddbnichtda)ELSE savetoarchive(all)FI CASE
+dbvondisk:forget(ALL myself-schulisdbname#17.10.88#-baisydbname);
+fetchfromarchive;IF idaTHEN sndidafiles#25.09.90#ELIF statistikTHEN
+sndstatfilesELSE restoredb(nameoftask);IF baisyTHEN sndbaisyfilesELSE
+sendstundenplan;sendkurswahldatenFI ;FI CASE formatcode:formatarchive(
+nameoftask)CASE checkcode:checkarchiveCASE logonarchivecode:logonarchiveCASE
+logoffarchivecode:logoffarchiveCASE dddrucken:datadirdruckenOTHERWISE :
+errorstop("Falscher Auftrag!")ENDSELECT ;endemeldungFI .dbnichtkomplett:IF
+NOT exists(nameoftask)COR (nameoftask="EUMELbase.baisy"CAND (NOT exists(
+"BAISY-0")COR NOT exists("BAISY-1")COR NOT exists("BAISY-2")COR NOT exists(
+"BAISY-3")))THEN TRUE ELSE FALSE FI .endemeldung:send(ordertaskp,ack,dsp).
+datadirdrucken:servereinrichten;out("Datenbankverzeichnis wird erstellt!");
+serverwecken.servereinrichten:begin("-",PROC servermonitor,begintask).
+serverwecken:call(begintask,dddrucken,dsp,replycode);IF replycode=errornak
+THEN message:=dsp;errorstop(message)ELSE send(ordertaskp,showcode,dsp)FI .
+ENDPROC ispmonitor;PROC servermonitor:TASK VAR fathertask;INT VAR ordercode;
+DATASPACE VAR ds;disablestop;wait(ds,ordercode,fathertask);postfix("");
+fetchdd(nameoftask);IF dbopen(nameoftask)THEN ddinfo("X")ELSE errorstop(
+"Drucken nicht möglich!")FI ;IF iserrorTHEN forget(ds);ds:=nilspace;message:=
+ds;message:=errormessage;ordercode:=errornakELSE forget(ds);ds:=old("X.dd")
+FI ;send(fathertask,ordercode,ds);end(myself)ENDPROC servermonitor;PROC
+spoolcommand(INT CONST order):TEXT VAR commandline:="";enablestop;break(quiet
+);continue(order-continuecode);disablestop;REP #commanddialogue(TRUE );#
+getcommand(name(myself)+"-Monitor:",commandline);do(commandline)UNTIL NOT
+onlinePER ;#commanddialogue(FALSE );#break(quiet);setautonomEND PROC
+spoolcommand;ROW maxthesaurusentryDATASPACE VAR receiveddb;BOUND THESAURUS
+VAR thesau;THESAURUS VAR dbthesaurus:=emptythesaurus;TASK VAR sourcetask:=
+niltask#,baisyserver:=/"baisy server"#;PROC rcvbaisyfiles:out(
+"BAISY-Files werden übertragen!");fetchfast(name(baisyserver));ENDPROC
+rcvbaisyfiles;PROC sndbaisyfiles:THESAURUS VAR theo:=ALL myself,theodb:=
+emptythesaurus;LET baisyconst="BAISY-";TEXT VAR fname;INT VAR tindex:=0,l:=1;
+forget(ds);ds:=nilspace;thesau:=ds;thesau:=emptythesaurus;modifytheo;
+sendthesaurusandrcvok;senddb.modifytheo:get(theo,fname,tindex);WHILE tindex>0
+REP IF pos(fname,baisyconst)=1THEN insert(theodb,fname)FI ;get(theo,fname,
+tindex)PER ;thesau:=theodb.sendthesaurusandrcvok:REP call(baisyserver,
+restoredbcode,ds,replycode)UNTIL replycode=restoredbcodePER ;.senddb:tindex:=
+0;l:=1;get(theodb,fname,tindex);WHILE tindex>0REP sendfile;get(theodb,fname,
+tindex)PER ;sendend.sendfile:pause(10);forget(ds);ds:=old(fname);out(fname+
+" wird übertragen!");lINCR 1;send(baisyserver,restoredbcode,ds);.sendend:
+pause(10);ds:=nilspace;send(baisyserver,endcode,ds).ENDPROC sndbaisyfiles;
+PROC rcvidafiles:initformfile;first(dnrida);WHILE dbstatus=okREP IF
+formexists(intwert(fnridanummer))THEN out("Formular "+wert(fnridanummer)+
+" gesichert!");getform(intwert(fnridanummer));formname:="";savetupel(dnrida,
+formname);putline(formfile,formname)FI ;succ(dnrida)PER .initformfile:forget(
+ALL myself-schulisdbname);formfile:=sequentialfile(output,formfilename).
+ENDPROC rcvidafiles;PROC sndidafiles:IF NOT exists(formfilename)THEN
+errorstop("Druckausgaben nicht vollständig!")ELSE rueckspeichernFI .
+formdateienda:exists("FORMDATA."+wert(fnridanummer))CAND exists("FORMTEXT."+
+wert(fnridanummer)).rueckspeichern:formfile:=sequentialfile(input,
+formfilename);IF lines(formfile)>0THEN eigentlichesrueckspeichernFI .
+eigentlichesrueckspeichern:clearfile(dnrida);WHILE NOT eof(formfile)REP
+getline(formfile,formname);restoretupel(dnrida,formname);IF formdateienda
+THEN openformular(intwert(fnridanummer));putform;out("Formular "+wert(
+fnridanummer)+" rückgesichert!");insert(dnrida)FI PER .ENDPROC sndidafiles;
+PROC rcvstatfiles:TASK CONST statserver:=task(statistikserver);THESAURUS VAR
+stats:=ALL statserver;TEXT VAR name;INT VAR index:=0;sicheredatenbasis;get(
+stats,name,index);WHILE index>0REP out(name+" gesichert!");fetch(name,
+statserver);get(stats,name,index);PER ;pause(20).sicheredatenbasis:IF stats
+CONTAINS statistikbasisTHEN out("Statistik Datenbasis gesichert!");fetch(
+statistikbasis,statserver);stats:=stats-statistikbasis;FI .END PROC
+rcvstatfiles;PROC sndstatfiles:THESAURUS CONST alle:=ALL myself;TASK CONST
+statserver:=task(statistikserver);TEXT VAR name;INT VAR index:=0;IF
+highestentry(alle)=0THEN errorstop("Keine Statistiken vorhanden!");ELSE
+allesloeschen;rueckspeichern;pause(20);FI .allesloeschen:BOOL VAR
+dialogschalter:=commanddialogue;commanddialogue(FALSE );erase(ALL statserver,
+statserver);commanddialogue(dialogschalter).rueckspeichern:get(alle,name,
+index);WHILE index>0REP IF name=statistikbasisTHEN out(
+"Statistik Datenbasis rückgesichert!");ELSE out(name+" rückgesichert!");FI ;
+save(name,statserver);get(alle,name,index);PER .END PROC sndstatfiles;PROC
+receivestundenplan:disablestop;stundenplanservertask:=task(stundenplanserver)
+;IF iserrorTHEN clearerror;ELSE loeschestundenplandsintask;fetchall(
+stundenplanservertask);FI ;enablestop.loeschestundenplandsintask:BOOL VAR
+dialogschalter:=commanddialogue;commanddialogue(FALSE );forget(allLIKE
+stundenplanpraefix);commanddialogue(dialogschalter).END PROC
+receivestundenplan;PROC sendstundenplan:disablestop;stundenplanservertask:=
+task(stundenplanserver);IF iserrorTHEN clearerror;ELSE
+loeschestundenplandsinservertask;save(allLIKE stundenplanpraefix,
+stundenplanservertask);FI ;enablestop.loeschestundenplandsinservertask:BOOL
+VAR dialogschalter:=commanddialogue;commanddialogue(FALSE );erase(ALL
+stundenplanservertask,stundenplanservertask);commanddialogue(dialogschalter).
+END PROC sendstundenplan;PROC receivekurswahldaten:disablestop;
+kurswahlservertask:=task(kurswahlserver);IF iserrorTHEN clearerror;ELSE
+loeschekurswahldsintask;fetch((ALL kurswahlservertask)LIKE kurswahlpraefix,
+kurswahlservertask);FI ;enablestop.loeschekurswahldsintask:BOOL VAR
+dialogschalter:=commanddialogue;commanddialogue(FALSE );forget(allLIKE
+kurswahlpraefix);commanddialogue(dialogschalter).END PROC
+receivekurswahldaten;PROC sendkurswahldaten:disablestop;kurswahlservertask:=
+task(kurswahlserver);IF iserrorTHEN clearerror;ELSE
+loeschekurswahldsinservertask;save(allLIKE kurswahlpraefix,kurswahlservertask
+);FI ;enablestop.loeschekurswahldsinservertask:BOOL VAR dialogschalter:=
+commanddialogue;commanddialogue(FALSE );erase(ALL kurswahlservertask,
+kurswahlservertask);commanddialogue(dialogschalter).END PROC
+sendkurswahldaten;BOOL PROC baisy:nameoftask="EUMELbase.baisy"ENDPROC baisy;
+BOOL PROC ida:idasicherungENDPROC ida;PROC ida(BOOL CONST idas):idasicherung
+:=idasENDPROC ida;BOOL PROC statistik:statistiksicherungEND PROC statistik;
+PROC statistik(BOOL CONST stats):statistiksicherung:=statsEND PROC statistik;
+ENDPACKET ispmonitorsicherungstask
+
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<nCOR (scanjaCAND (NOT scanstackentry(
+anzahltupel,BOOL PROC pruefungspeziell)));restoretupel(dateinummer,sicherung)
+;changeindex;nureinedatenseite:=(ersterdatensatzCAND was=vorwaertsCAND
+bestandsende);IF ersterdatensatzCAND was=vorwaertsTHEN ersterdatensatz:=
+FALSE ;FI ;.ersteseitelesen:ersteletzteseite(scanstartwert,PROC (INT CONST ,
+BOOL PROC ,INT VAR )scanforward,PROC (INT CONST )first,scanja,BOOL PROC
+pruefungspeziell,anzahltupel,feldnummerstartwert);IF NOT scanjaTHEN
+multisearchforward(aktindex,anzahltupel)FI ;.letzteseitelesen:
+ersteletzteseite(scanendewert,PROC (INT CONST ,BOOL PROC ,INT VAR )scanpred,
+PROC (INT CONST )last,scanja,BOOL PROC pruefungspeziell,anzahltupel,
+feldnummerstartwert);IF NOT scanjaTHEN multisearchbackward(aktindex,
+anzahltupel)FI ;letzterbildschirm:=TRUE ;.naechsteseitelesen:IF
+ersterdatensatzTHEN multisearchforward(aktindex,anzahltupel);ELSE changeindex
+;multisucc(aktindex,anzahltupel);ersterbildschirm:=FALSE FI .
+vorherigeseitelesen:multisearchbackward(aktindex,anzahltupel);.END PROC
+satzlesen;PROC ersteletzteseite(TEXT CONST startwert,PROC (INT CONST ,BOOL
+PROC ,INT VAR )mitscanner,PROC (INT CONST )ohnescanner,BOOL CONST scanja,
+BOOL PROC pruefungspeziell,INT VAR anzahl,INT CONST fnrstartwert):IF scanja
+CAND scanerlaubtTHEN setzestartwert;mitscanner(aktindex,BOOL PROC
+pruefungspeziell,anzahl)ELSE ohnescanner(aktindex)FI .setzestartwert:INT VAR
+k,ersteskeyfeld:=dateinummer+1;INT VAR letzteskeyfeld:=dateinummer+
+anzschluesselfelder;FOR kFROM ersteskeyfeldUPTO letzteskeyfeldREP putwert(k,
+"")PER ;restorescanwert;putwert(fnrstartwert,startwert);changeindex.END PROC
+ersteletzteseite;PROC eineseiteeinlesen(TEXT CONST startwert,PROC (INT CONST
+,BOOL PROC ,INT VAR )mitscanner,PROC (INT CONST )ohnescanner,BOOL CONST
+scanja,BOOL PROC pruefungspeziell,INT VAR anzahl):IF scanjaAND scanerlaubt
+THEN IF scanueberdiedateinummerTHEN putwert(aktindex+2,startwert)ELSE putwert
+(dateinummer+1,startwert)FI ;mitscanner(aktindex,BOOL PROC pruefungspeziell,
+anzahl)ELSE ohnescanner(aktindex)FI ;.END PROC eineseiteeinlesen;PROC
+eineseiteeinlesen(PROC (INT CONST ,BOOL PROC ,INT VAR )mitscanner,PROC (INT
+CONST ,INT VAR )ohnescanner,BOOL CONST scanja,BOOL PROC pruefungspeziell,INT
+VAR anzahl):IF scanjaAND scanerlaubtTHEN dbstatus(ok);mitscanner(aktindex,
+BOOL PROC pruefungspeziell,anzahl)ELSE scanstatus(ok);ohnescanner(aktindex,
+anzahl)FI .END PROC eineseiteeinlesen;BOOL PROC scanerlaubt:aktindex<>
+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;
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.schulis db nummern b/app/baisy/2.2.1-schulis/src/isp.schulis db nummern
new file mode 100644
index 0000000..f030559
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.schulis db nummern
@@ -0,0 +1,225 @@
+PACKET ispschulisdbnummernDEFINES dnrschueler,fnrsufamnames,fnrsurufnames,
+fnrsugebdatums,fnrsustatuss,fnrsusgrpjgst,fnrsusgrpzugtut,fnrsutidakthjd,
+fnrsuartzugang,fnrsuneuerzugtut,fnrsugeschlechts,fnrsujgsteintr,
+fnrsuskennlschule,fnrsuklasselschule,fnrsuabgdats,fnrsuabggrund,
+fnrsuabschluss,fnrsuskennnschule,fnrsuvornames,fnrsunamenszusatzs,
+fnrsugebnames,fnrsuwohntbei,fnrsustrnrs,fnrsuplzorts,fnrsutelnrs,
+fnrsuortsteils,fnrsufamnamee,fnrsuvornamee,fnrsunamenszusatze,fnrsustrnre,
+fnrsuplzorte,fnrsutelnre,fnrsuverhes,fnrsustaatsangs,fnrsureligionsz,
+fnrsureligionsvz,fnrsuspaetaus,fnrsumuttersprache,fnrsugeborts,fnrsugebkreiss
+,fnrsujahreinschul,fnrsueintrittsdats,fnrsueintrittinsek,fnrsuvermerk1,
+fnrsuvermerk2,fnrsuvermerk3,fnrsuvermerk4,fnrsuvermerk5,fnrsuvermerk6,
+fnrsudiffdatennrs,fnrsutiddiffdaten,dnrdiffdaten,fnrdddiffdatennr,
+fnrdd1fremdfach,fnrdd1fremdb,fnrdd1fremde,fnrdd2fremdfach,fnrdd2fremdb,
+fnrdd2fremde,fnrdd3fremdfach,fnrdd3fremdb,fnrdd3fremde,fnrdd4fremdfach,
+fnrdd4fremdb,fnrdd4fremde,fnrddreliunter,fnrddabmeldedatreli,
+fnrddanmeldedatreli,fnrddkunstmusik,fnrddfach091a,fnrddfach091b,fnrddfach092a
+,fnrddfach092b,fnrddfach101a,fnrddfach101b,fnrddfach102a,fnrddfach102b,
+fnrddagthema1,fnrddagthema1b,fnrddagthema1e,fnrddagthema2,fnrddagthema2b,
+fnrddagthema2e,fnrddagthema3,fnrddagthema3b,fnrddagthema3e,dnrhalbjahresdaten
+,fnrhjdfamnames,fnrhjdrufnames,fnrhjdgebdats,fnrhjdsj,fnrhjdhj,fnrhjdjgst,
+fnrhjdkennung,fnrhjdversetzung,fnrhjdnachfach1,fnrhjdnachfach2,
+fnrhjdnachfach3,fnrhjdnachfach,fnrhjdnacherg,fnrhjdversstdm,fnrhjdversstdo,
+fnrhjdverspaet,fnrhjdbemzeug1,fnrhjdbemzeug2,fnrhjdbemzeug3,fnrhjdbemnach,
+fnrhjdvermblau,fnrhjdvermnachwarn,fnrhjdbemblau,fnrhjdbemnachwarn,fnrhjdfach,
+fnrhjdkursart,fnrhjdlerngrpkenn,fnrhjdklausurteiln,fnrhjdnotepunkte,
+fnrhjdbemerk,fnrhjdvermwarnung,dnrschulen,fnrschkennung,fnrschname,fnrschart,
+fnrschstrnr,fnrschplzort,fnrschtelnr,fnrschamtlnr,fnrschbundesland,
+dnraktschuelergruppen,fnrsgrpsj,fnrsgrphj,fnrsgrpjgst,fnrsgrpkennung,
+fnrsgrplehrer,fnrsgrpstellvlehrer,fnrsgrpintegabez,dnrschluessel,
+fnrschlsachgebiet,fnrschlschluessel,fnrschllangtext,dnrfaecher,fnrffach,
+fnrffachbez,fnrffachgrp,fnrffachbereich,dnrlehrer,fnrlparaphe,fnrlfamname,
+fnrlrufname,fnrlzusatz,fnrlamtsbeztitel,fnrlgeschlecht,fnrlsollstd,
+fnrlpflichtstd,fnrlerm1,fnrlermgrund1,fnrlerm2,fnrlermgrund2,fnrlerm3,
+fnrlermgrund3,fnrlerm4,fnrlermgrund4,fnrlsprechzeit,fnrlstrnr,fnrlplzort,
+fnrltelnr,dnrlehrbefaehigungen,fnrlbfach,fnrlbparaphe,fnrlbart,
+dnrfaecherangebot,fnrfangsj,fnrfanghj,fnrfangjgst,fnrfanglfdnr,fnrfangfach,
+fnrfangart,fnrfangwochenstd,fnrfanganzlv,dnrlehrveranstaltungen,fnrlvsj,
+fnrlvhj,fnrlvjgst,fnrlvfachkennung,fnrlvkopplung,fnrlvparaphe,fnrlvwochenstd,
+fnrlvklgrp1,fnrlvklgrp2,fnrlvklgrp3,fnrlvklgrp4,fnrlvraumgrp1,fnrlvraumgrp2,
+fnrlvart,dnrzeitraster,fnrzrsj,fnrzrhj,fnrzrtagstunde,fnrzrkennungteil,
+fnrzrbeginnuhr,fnrzrendeuhr,dnraufsichtszeiten,fnrazsj,fnrazhj,
+fnrazaufsichtszeit,fnraztagstdvor,fnraztagstdnach,fnrazbeginnuhr,fnrazendeuhr
+,fnrazbezeichnung,dnrzeitwuensche,fnrzwsj,fnrzwhj,fnrzwbezug,
+fnrzwbezugsobjekt,fnrzwbestimmtewuensche,fnrzwunbestimmtewuensche,
+dnrraumgruppen,fnrrgraumgrp,fnrrgraeume,dnrklassengruppen,fnrkgklassengrp,
+fnrkgschuelergrp,dnraufsichtsplan,fnrapsj,fnraphj,fnrapaufsichtszeit,
+fnrapaufsichtsort,fnrapparaphe,dnrvertretungen,fnrvdatum,fnrvtagstd,
+fnrvparaphe,fnrvanrechnung,fnrvveranstaltung,dnrida,fnridanummer,fnridaname,
+fnridastatus,fnridatyp,#ixsustat,dr05.04.88jetztüberflüssig#ixsustatschulkenn
+,ixsustatfamrufgeb,ixsustatjgstzug,ixsustatabgdat,ixsustatjgst,ixsustatgeb,
+ixsustatgeschlgeb,ixhjdfamrufgebjgsthj,ixhjdsjhjjgstkenn,ixhjdsjhjverjgstkenn
+,ixhjdversjhjjgstkenn,ixhjdverfamsjhjrufgeb,ixhjdsjhjverjgst,ixsgrpjgstkenn,
+ixlfamruf,ixlbpar,ixlbart,ixfangsjhjfach,ixlvsjhjkopp,ixlvsjhjkenn,
+ixlvsjhjpar,ixappar,ixvpar,dnrausk,dnrbenutz,dnrmeld,fnrauskunftsname,
+fnrschlverz,fnrauskunftstext,fnrbenutzbestand,fnrbenutzname,
+fnrbenutzgeheimwort,fnrbenutzberecht,fnrmeldungsname,fnrmeldungstext:LET
+dnrauskuenfte=2,fnrauskname=3,fnrauskverz=4,fnrausktext=5,dnrbenutzer=7,
+fnrbenbestand=8,fnrbenname=9,fnrbengwort=10,fnrbenrecht=11,dnrmeldungen=12,
+fnrmeldname=13,fnrmeldtext=14;INT PROC dnrausk:dnrauskuenfteENDPROC dnrausk;
+INT PROC fnrauskunftsname:fnrausknameENDPROC fnrauskunftsname;INT PROC
+fnrschlverz:fnrauskverzENDPROC fnrschlverz;INT PROC fnrauskunftstext:
+fnrausktextENDPROC fnrauskunftstext;INT PROC dnrbenutz:dnrbenutzerENDPROC
+dnrbenutz;INT PROC fnrbenutzbestand:fnrbenbestandENDPROC fnrbenutzbestand;
+INT PROC fnrbenutzname:fnrbennameENDPROC fnrbenutzname;INT PROC
+fnrbenutzgeheimwort:fnrbengwortENDPROC fnrbenutzgeheimwort;INT PROC
+fnrbenutzberecht:fnrbenrechtENDPROC fnrbenutzberecht;INT PROC dnrmeld:
+dnrmeldungenENDPROC dnrmeld;INT PROC fnrmeldungsname:fnrmeldnameENDPROC
+fnrmeldungsname;INT PROC fnrmeldungstext:fnrmeldtextENDPROC fnrmeldungstext;#
+oeffnedatenbank(schulisdbname);systemdboff;#BOOL VAR b:=dbopen(schulisdbname)
+;INT CONST dnrschueler:=dateinr("Schüler"),fnrsufamnames:=feldnr(
+"Familienname.S"),fnrsurufnames:=feldnr("Rufname.S"),fnrsugebdatums:=feldnr(
+"Geburtsdatum.S"),fnrsustatuss:=feldnr("Status"),fnrsusgrpjgst:=feldnr(
+"SchülergruppeJgst"),fnrsusgrpzugtut:=feldnr("SchülergruppeZug/Tutor"),
+fnrsutidakthjd:=feldnr("Tid akt Hjd"),fnrsuartzugang:=feldnr(
+"Art des Zugangs"),fnrsuneuerzugtut:=feldnr("neuer Zug/Tutor"),
+fnrsugeschlechts:=feldnr("Geschlecht.S"),fnrsujgsteintr:=feldnr(
+"Jahrgangsstufe Eintr"),fnrsuskennlschule:=feldnr("Schulkenn. letzt Sch"),
+fnrsuklasselschule:=feldnr("Klasse letzte Schule"),fnrsuabgdats:=feldnr(
+"Abgangsdatum.S"),fnrsuabggrund:=feldnr("Abgangsgrund"),fnrsuabschluss:=
+feldnr("Abschluß"),fnrsuskennnschule:=feldnr("Schulkennung neue Sch"),
+fnrsuvornames:=feldnr("Vorname.S"),fnrsunamenszusatzs:=feldnr(
+"Namenszusatz.S"),fnrsugebnames:=feldnr("Geburtsname.S"),fnrsuwohntbei:=
+feldnr("Zusatz wohnt bei"),fnrsustrnrs:=feldnr("Straße, Nr.S"),fnrsuplzorts:=
+feldnr("PLZ, Ort.S"),fnrsutelnrs:=feldnr("Tel.Nr.S"),fnrsuortsteils:=feldnr(
+"Ortsteil.S"),fnrsufamnamee:=feldnr("Familienname.E"),fnrsuvornamee:=feldnr(
+"Vorname.E"),fnrsunamenszusatze:=feldnr("Namenszusatz.E"),fnrsustrnre:=feldnr
+("Straße, Nr.E"),fnrsuplzorte:=feldnr("PLZ, Ort.E"),fnrsutelnre:=feldnr(
+"Tel.Nr.E"),fnrsuverhes:=feldnr("Verhältnis.E-S"),fnrsustaatsangs:=feldnr(
+"Staatsangehörigkeit.S"),fnrsureligionsz:=feldnr("Religionszugehörigkeit"),
+fnrsureligionsvz:=feldnr("ReligionsvermerkZeugn"),fnrsuspaetaus:=feldnr(
+"Spätaussiedler"),fnrsumuttersprache:=feldnr("Muttersprache"),fnrsugeborts:=
+feldnr("Geburtsort.S"),fnrsugebkreiss:=feldnr("Geburtskreis/-land.S"),
+fnrsujahreinschul:=feldnr("Jahr der Einschulung"),fnrsueintrittsdats:=feldnr(
+"Eintrittsdatum.S"),fnrsueintrittinsek:=feldnr("Eintritt in Sek. II"),
+fnrsuvermerk1:=feldnr("Vermerk 1"),fnrsuvermerk2:=feldnr("Vermerk 2"),
+fnrsuvermerk3:=feldnr("Vermerk 3"),fnrsuvermerk4:=feldnr("Vermerk 4"),
+fnrsuvermerk5:=feldnr("Vermerk 5"),fnrsuvermerk6:=feldnr("Vermerk 6"),
+fnrsudiffdatennrs:=feldnr("Diffdaten Nr.S"),fnrsutiddiffdaten:=feldnr(
+"Tid Diffdaten");INT CONST dnrdiffdaten:=dateinr("Differenzierungsdaten"),
+fnrdddiffdatennr:=feldnr("Diffdaten Nr."),fnrdd1fremdfach:=feldnr(
+"Fach.1.Fremdsprache"),fnrdd1fremdb:=feldnr("Beginn.1.Fremdsprache"),
+fnrdd1fremde:=feldnr("Ende.1.Fremdsprache"),fnrdd2fremdfach:=feldnr(
+"Fach.2.Fremdsprache"),fnrdd2fremdb:=feldnr("Beginn.2.Fremdsprache"),
+fnrdd2fremde:=feldnr("Ende.2.Fremdsprache"),fnrdd3fremdfach:=feldnr(
+"Fach.3.Fremdsprache"),fnrdd3fremdb:=feldnr("Beginn.3.Fremdsprache"),
+fnrdd3fremde:=feldnr("Ende.3.Fremdsprache"),fnrdd4fremdfach:=feldnr(
+"Fach.4.Fremdsprache"),fnrdd4fremdb:=feldnr("Beginn.4.Fremdsprache"),
+fnrdd4fremde:=feldnr("Ende.4.Fremdsprache"),fnrddreliunter:=feldnr(
+"Religionsunterricht"),fnrddabmeldedatreli:=feldnr("Abmeldedatum.Religion"),
+fnrddanmeldedatreli:=feldnr("Wiederanmeld.Religion"),fnrddkunstmusik:=feldnr(
+"Kunst/Musik"),fnrddfach091a:=feldnr("FächerWP09.1.a"),fnrddfach091b:=feldnr(
+"FächerWP09.1.b"),fnrddfach092a:=feldnr("FächerWP09.2.a"),fnrddfach092b:=
+feldnr("FächerWP09.2.b"),fnrddfach101a:=feldnr("FächerWP10.1.a"),
+fnrddfach101b:=feldnr("FächerWP10.1.b"),fnrddfach102a:=feldnr(
+"FächerWP10.2.a"),fnrddfach102b:=feldnr("FächerWP10.2.b"),fnrddagthema1:=
+feldnr("AG.Thema1"),fnrddagthema1b:=feldnr("AG.Thema1.Beginn"),fnrddagthema1e
+:=feldnr("AG.Thema1.Ende"),fnrddagthema2:=feldnr("AG.Thema2"),fnrddagthema2b
+:=feldnr("AG.Thema2.Beginn"),fnrddagthema2e:=feldnr("AG.Thema2.Ende"),
+fnrddagthema3:=feldnr("AG.Thema3"),fnrddagthema3b:=feldnr("AG.Thema3.Beginn")
+,fnrddagthema3e:=feldnr("AG.Thema3.Ende");INT CONST dnrhalbjahresdaten:=
+dateinr("Halbjahresdaten"),fnrhjdfamnames:=feldnr("Hjd.Famname.S"),
+fnrhjdrufnames:=feldnr("Hjd.Rufname.S"),fnrhjdgebdats:=feldnr(
+"Hjd.Gebdatum.S"),fnrhjdsj:=feldnr("Hjd.Schuljahr"),fnrhjdhj:=feldnr(
+"Hjd.Halbjahr"),fnrhjdjgst:=feldnr("Hjd.Jahrgangsstufe"),fnrhjdkennung:=
+feldnr("Hjd.Kennung"),fnrhjdversetzung:=feldnr("Hjd.Versetzung"),
+fnrhjdnachfach1:=feldnr("Hjd.Nachprüfungsfach 1"),fnrhjdnachfach2:=feldnr(
+"Hjd.Nachprüfungsfach 2"),fnrhjdnachfach3:=feldnr("Hjd.Nachprüfungsfach 3"),
+fnrhjdnachfach:=feldnr("Hjd.Nachprüfungsfach"),fnrhjdnacherg:=feldnr(
+"Hjd.Nachprüfungsergebnis"),fnrhjdversstdm:=feldnr(
+"Hjd.versäumte Stunden mit"),fnrhjdversstdo:=feldnr(
+"Hjd.versäumte Stunden ohn"),fnrhjdverspaet:=feldnr("Hjd.Verspätungen"),
+fnrhjdbemzeug1:=feldnr("Hjd.Bemerk.Zeugnis 1"),fnrhjdbemzeug2:=feldnr(
+"Hjd.Bemerk.Zeugnis 2"),fnrhjdbemzeug3:=feldnr("Hjd.Bemerk.Zeugnis 3"),
+fnrhjdbemnach:=feldnr("Hjd.Bemerk.Nachprüfung"),fnrhjdvermblau:=feldnr(
+"Hjd.Vermerk.Blauer Brief"),fnrhjdvermnachwarn:=feldnr(
+"Hjd.Vermerk.Nachwarnung"),fnrhjdbemblau:=feldnr("Hjd.Bemerk.Blauer Brief"),
+fnrhjdbemnachwarn:=feldnr("Hjd.Bemerk.Nachwarnung"),fnrhjdfach:=feldnr(
+"Hjd.Fach"),fnrhjdkursart:=feldnr("Hjd.Kursart"),fnrhjdlerngrpkenn:=feldnr(
+"Hjd.Lerngrp.Kennung"),fnrhjdklausurteiln:=feldnr("Hjd.Klausurteilnahme"),
+fnrhjdnotepunkte:=feldnr("Hjd.Zeugnisnote/Punkte"),fnrhjdbemerk:=feldnr(
+"Hjd.Bemerkung"),fnrhjdvermwarnung:=feldnr("Hjd.Vermerk Warnung");INT CONST
+dnrschulen:=dateinr("Schulen"),fnrschkennung:=feldnr("Schulkennung"),
+fnrschname:=feldnr("Schulname"),fnrschart:=feldnr("Schulart"),fnrschstrnr:=
+feldnr("Straße Nr.Schule"),fnrschplzort:=feldnr("PLZ, Ort.Schule"),
+fnrschtelnr:=feldnr("Tel. Nr.Schule"),fnrschamtlnr:=feldnr(
+"amtl. Schulnummer"),fnrschbundesland:=feldnr("Bundesland");INT CONST
+dnraktschuelergruppen:=dateinr("aktuelle Schülergruppen"),fnrsgrpsj:=feldnr(
+"Schuljahr"),fnrsgrphj:=feldnr("Halbjahr"),fnrsgrpjgst:=feldnr(
+"Jahrgangsstufe"),fnrsgrpkennung:=feldnr("Kennung"),fnrsgrplehrer:=feldnr(
+"Klassenlehrer/Tutor"),fnrsgrpstellvlehrer:=feldnr("stellvertr. Klassenl."),
+fnrsgrpintegabez:=feldnr("intega Bezeichnung");INT CONST dnrschluessel:=
+dateinr("Schlüssel"),fnrschlsachgebiet:=feldnr("Sachgebiet"),
+fnrschlschluessel:=feldnr("Schlüssel"),fnrschllangtext:=feldnr("Langtext");
+INT CONST dnrfaecher:=dateinr("Fächer"),fnrffach:=feldnr("Fach"),fnrffachbez
+:=feldnr("Fachbezeichnung"),fnrffachgrp:=feldnr("Fachgruppe"),fnrffachbereich
+:=feldnr("Fachbereich");INT CONST dnrlehrer:=dateinr("Lehrer"),fnrlparaphe:=
+feldnr("Paraphe"),fnrlfamname:=feldnr("Familienname.L"),fnrlrufname:=feldnr(
+"Rufname.L"),fnrlzusatz:=feldnr("Namenszusatz.L"),fnrlamtsbeztitel:=feldnr(
+"Amtsbezeichnung Titel"),fnrlgeschlecht:=feldnr("Geschlecht.L"),fnrlsollstd:=
+feldnr("Sollstunden"),fnrlpflichtstd:=feldnr("Pflichtstunden"),fnrlerm1:=
+feldnr("Ermäßigung 1"),fnrlermgrund1:=feldnr("Ermäßigungsgrund 1"),fnrlerm2:=
+feldnr("Ermäßigung 2"),fnrlermgrund2:=feldnr("Ermäßigungsgrund 2"),fnrlerm3:=
+feldnr("Ermäßigung 3"),fnrlermgrund3:=feldnr("Ermäßigungsgrund 3"),fnrlerm4:=
+feldnr("Ermäßigung 4"),fnrlermgrund4:=feldnr("Ermäßigungsgrund 4"),
+fnrlsprechzeit:=feldnr("Sprechzeiten"),fnrlstrnr:=feldnr("Straße, Nr.L"),
+fnrlplzort:=feldnr("PLZ, Ort.L"),fnrltelnr:=feldnr("Tel. Nr.L");INT CONST
+dnrlehrbefaehigungen:=dateinr("Lehrbefähigungen"),fnrlbfach:=feldnr("Lb.Fach"
+),fnrlbparaphe:=feldnr("Lb.Paraphe"),fnrlbart:=feldnr("Lb.Art");INT CONST
+dnrfaecherangebot:=dateinr("Fächerangebot"),fnrfangsj:=feldnr("Fa.Schuljahr")
+,fnrfanghj:=feldnr("Fa.Halbjahr"),fnrfangjgst:=feldnr("Fa.Jgst"),fnrfanglfdnr
+:=feldnr("Fa.laufende Nr."),fnrfangfach:=feldnr("Fa.Fach"),fnrfangart:=feldnr
+("Fa.Art"),fnrfangwochenstd:=feldnr("Fa.Wochenstundenzahl"),fnrfanganzlv:=
+feldnr("Fa.Anzahl Lehrveranst.");INT CONST dnrlehrveranstaltungen:=dateinr(
+"Lehrveranstaltungen"),fnrlvsj:=feldnr("Lv.Schuljahr"),fnrlvhj:=feldnr(
+"Lv.Halbjahr"),fnrlvjgst:=feldnr("Lv.Jgst"),fnrlvfachkennung:=feldnr(
+"Lv.Fach Kennung"),fnrlvkopplung:=feldnr("Lv.Kopplung"),fnrlvparaphe:=feldnr(
+"Lv.Paraphe"),fnrlvwochenstd:=feldnr("Lv.Wochenstunden"),fnrlvklgrp1:=feldnr(
+"Lv.Klassengruppe 1"),fnrlvklgrp2:=feldnr("Lv.Klassengruppe 2"),fnrlvklgrp3:=
+feldnr("Lv.Klassengruppe 3"),fnrlvklgrp4:=feldnr("Lv.Klassengruppe 4"),
+fnrlvraumgrp1:=feldnr("Lv.Raumgruppe 1"),fnrlvraumgrp2:=feldnr(
+"Lv.Raumgruppe 2"),fnrlvart:=feldnr("Lv.Art");INT CONST dnrzeitraster:=
+dateinr("Zeitraster"),fnrzrsj:=feldnr("Zr.Schuljahr"),fnrzrhj:=feldnr(
+"Zr.Halbjahr"),fnrzrtagstunde:=feldnr("Zr.Tag Stunde"),fnrzrkennungteil:=
+feldnr("Zr.Kennung Tagesteil"),fnrzrbeginnuhr:=feldnr("Zr.Beginn Uhrzeit"),
+fnrzrendeuhr:=feldnr("Zr.Ende Uhrzeit");INT CONST dnraufsichtszeiten:=dateinr
+("Aufsichtszeiten"),fnrazsj:=feldnr("Az.Schuljahr"),fnrazhj:=feldnr(
+"Az.Halbjahr"),fnrazaufsichtszeit:=feldnr("Az.Aufsichtszeit"),fnraztagstdvor
+:=feldnr("Az.Tag Stunde vorher"),fnraztagstdnach:=feldnr(
+"Az.Tag Stunde nachher"),fnrazbeginnuhr:=feldnr("Az.Beginn Uhrzeit"),
+fnrazendeuhr:=feldnr("Az.Ende Uhrzeit"),fnrazbezeichnung:=feldnr(
+"Az.Bezeichnung");INT CONST dnrzeitwuensche:=dateinr("Zeitwünsche"),fnrzwsj:=
+feldnr("Zw.Schuljahr"),fnrzwhj:=feldnr("Zw.Halbjahr"),fnrzwbezug:=feldnr(
+"Zw.Bezug"),fnrzwbezugsobjekt:=feldnr("Zw.Bezugsobjekt"),
+fnrzwbestimmtewuensche:=feldnr("Zw.bestimmte Wünsche"),
+fnrzwunbestimmtewuensche:=feldnr("Zw.unbestimmte Wünsche");INT CONST
+dnrraumgruppen:=dateinr("Raumgruppen"),fnrrgraumgrp:=feldnr("Raumgruppe"),
+fnrrgraeume:=feldnr("Räume");INT CONST dnrklassengruppen:=dateinr(
+"Klassengruppen"),fnrkgklassengrp:=feldnr("Klassengruppe"),fnrkgschuelergrp:=
+feldnr("Schülergruppen");INT CONST dnraufsichtsplan:=dateinr("Aufsichtsplan")
+,fnrapsj:=feldnr("Ap.Schuljahr"),fnraphj:=feldnr("Ap.Halbjahr"),
+fnrapaufsichtszeit:=feldnr("Ap.Aufsichtszeit"),fnrapaufsichtsort:=feldnr(
+"Ap.Aufsichtsort"),fnrapparaphe:=feldnr("Ap.Paraphe");INT CONST
+dnrvertretungen:=dateinr("Vertretungen"),fnrvdatum:=feldnr("V.Datum"),
+fnrvtagstd:=feldnr("V.Tag Stunde"),fnrvparaphe:=feldnr("V.Paraphe"),
+fnrvanrechnung:=feldnr("V.Anrechnung"),fnrvveranstaltung:=feldnr(
+"V.Veranstaltung");INT CONST dnrida:=dateinr("Druckausgaben"),fnridanummer:=
+feldnr("Ida.Nr"),fnridaname:=feldnr("Ida.Name"),fnridastatus:=feldnr(
+"Ida.Status"),fnridatyp:=feldnr("Ida.Typ");INT CONST #ixsustat:=indexnr(
+"Status"),#ixsustatschulkenn:=indexnr("letzte Schule"),ixsustatfamrufgeb:=
+indexnr("Schuelerbestand"),ixsustatjgstzug:=indexnr("Status Jgst Zug"),
+ixsustatabgdat:=indexnr("Status Abgangsdatum"),ixsustatjgst:=indexnr(
+"SchülergruppeJgst"),ixsustatgeb:=indexnr("Geburtsdatum.S"),ixsustatgeschlgeb
+:=indexnr("Geschlecht, Gebdat"),ixhjdfamrufgebjgsthj:=indexnr(
+"ix hjd fam ruf geb jgst hj"),ixhjdsjhjjgstkenn:=indexnr(
+"hjd sj hj jgst kenn"),ixhjdsjhjverjgstkenn:=indexnr(
+"hjd sj hj vers jgst kenn"),ixhjdversjhjjgstkenn:=indexnr("Hjd.Versetzung"),
+ixhjdverfamsjhjrufgeb:=indexnr("Hjd.Famname der Wiederh"),ixhjdsjhjverjgst:=
+indexnr("hjd sj hj vers jgst"),ixsgrpjgstkenn:=indexnr("Gruppe"),ixlfamruf:=
+indexnr("Index.Lehrername"),ixlbpar:=indexnr("Index.Lb.Paraphe"),ixlbart:=
+indexnr("Index.Lb.Art"),ixfangsjhjfach:=indexnr("Index.Fa.Fach"),ixlvsjhjkopp
+:=indexnr("Index.Lv.Kopplung"),ixlvsjhjkenn:=indexnr("Index.Lv.Fach"),
+ixlvsjhjpar:=indexnr("Index.Lv.Paraphe"),ixappar:=indexnr("Index.Ap.Paraphe")
+,ixvpar:=indexnr("Index.V.Paraphe");#systemdbon#END PACKET
+ispschulisdbnummern
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.sicherungsmonitor b/app/baisy/2.2.1-schulis/src/isp.sicherungsmonitor
new file mode 100644
index 0000000..67ebbfb
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.sicherungsmonitor
@@ -0,0 +1,141 @@
+PACKET sicherungsmonitorDEFINES ladenstarten,sichernstarten,formatieren,
+endeformatieren,initialisieren,disketteueberpruefen,floppylisten,
+floppylistingzeigen,endefloppylisting,meldungquittieren,
+dbverzeichniserstellen,dbverzeichniszeigen,endedbverzeichnis,archiveanmelden,
+archiveabmelden,bestimmendersicherungstask,sicherungsloop,beendenarchivieren:
+LET initcode=25,listcode=26,checkcode=27,formatcode=40,logonarchivecode=45,
+logoffarchivecode=46,dbvomserver=47,dbzumserver=48,dbaufdisk=49,dbvondisk=50,
+dddrucken=51,endemeldung=0,errornak=2,nak=1,keinedaten=59,floppyzuranzeige=
+180,formatkorrekt=181,initkorrekt=182,sichernkorrekt=183,ladenkorrekt=184,
+opkorrekt=185,unbekanntercode=186,inkonsicherung=187,floppyzurpruefung=199;
+LET yescode=10,outcode=11,showcode=12;LET meldungsfeld=1;LET
+ankreuzauffloppyladen=6,ankreuzauffloppysichern=7,floppynamefeld=8,
+ankreuzschulis=2,ankreuzbaisy=3,ankreuzida=4,ankreuzstatistik=5,
+fragekennzeichnung=" ?";LET manager2="baisy",manager1="schulis",manager3=
+"ida",manager4="statistik";LET meldpattern1="Archiv",meldpattern2="e",
+meldpattern3="Diskette",patternlaenge=6;LET sicherung=" sicherung";INT VAR
+quittung,stufe:=1,letzterauftragscode;TEXT VAR dbinhalt:="";TASK VAR
+dbsicherungstask;DATASPACE VAR ds;BOUND TEXT VAR message;INT VAR
+meldungsfeldlaenge,eingabestatus;TEXT VAR dbsicherung:="",anmeldetask:="";
+BOOL VAR endequittungda:=FALSE ,error:=FALSE ;LET logbucheintragsichern=
+"Anw. 10.1.1 Sicherung von ",logbucheintragladen="Anw. 10.1.2 Laden von ";
+PROC eingabepruefen:standardpruefe(5,ankreuzschulis,ankreuzstatistik,0,"",
+eingabestatus);IF eingabestatus=0THEN standardpruefe(5,ankreuzauffloppyladen,
+ankreuzauffloppysichern,0,"",eingabestatus);IF eingabestatus=0THEN
+parametersetzenFI ;FI .END PROC eingabepruefen;PROC eingabepruefeneinfach:
+standardpruefe(5,ankreuzschulis,ankreuzstatistik,0,"",eingabestatus);IF
+eingabestatus=0THEN parametersetzenFI .END PROC eingabepruefeneinfach;PROC
+parametersetzen:IF standardmaskenfeld(ankreuzschulis)<>""THEN dbsicherung:=
+manager1;dbinhalt:="EUMELbase.schulis-DB-Verzeichnis"ELIF standardmaskenfeld(
+ankreuzbaisy)<>""THEN dbsicherung:=manager2;dbinhalt:=
+"EUMELbase.baisy-DB-Verzeichnis"ELIF standardmaskenfeld(ankreuzida)<>""THEN
+dbsicherung:=manager3;dbinhalt:="EUMELbase.schulis-DB-Verzeichnis"ELSE #25.09
+.90#dbsicherung:=manager4;dbinhalt:="EUMELbase.schulis-DB-Verzeichnis"FI ;
+dbsicherungCAT sicherung;infeld(floppynamefeld);meldungsfeldlaenge:=
+standardfeldlaenge(meldungsfeld).END PROC parametersetzen;PROC
+beendenarchivieren:archiveabmelden;enter(2)ENDPROC beendenarchivieren;PROC
+ladenstarten:IF stufe=2THEN sicherungsloopELSE stufe1behandlungFI .
+stufe1behandlung:eingabepruefen;IF eingabestatus<>0THEN infeld(eingabestatus)
+;return(1)ELSE IF auffloppyTHEN archiveanmelden;IF anmeldetask=""THEN return(
+1);LEAVE ladenstartenELSE stufe:=2;logeintrag(logbucheintragladen+
+logbuchbehandeltedaten);archiveoperation(dbvondisk,dbsicherung);IF
+endequittungdaOR errorTHEN return(1)FI FI ELSE logeintrag(logbucheintragladen
++logbuchbehandeltedaten);archiveoperation(dbzumserver,dbsicherung);return(1)
+FI FI .auffloppy:standardmaskenfeld(ankreuzauffloppyladen)<>"".END PROC
+ladenstarten;PROC sichernstarten:IF stufe=2THEN sicherungsloopELSE
+stufe1behandlungFI ;.stufe1behandlung:eingabepruefen;IF eingabestatus<>0THEN
+infeld(eingabestatus);return(1)ELSE IF auffloppyTHEN archiveanmelden;IF
+anmeldetask=""THEN return(1);LEAVE sichernstartenELSE stufe:=2;
+archiveoperation(dbaufdisk,dbsicherung);IF endequittungdaOR errorTHEN return(
+1)FI FI ELSE logeintrag(logbucheintragsichern+logbuchbehandeltedaten);
+archiveoperation(dbvomserver,dbsicherung);return(1)FI FI .END PROC
+sichernstarten;TEXT PROC logbuchbehandeltedaten:IF standardmaskenfeld(
+ankreuzschulis)<>""THEN "Anwendungsdaten"ELIF standardmaskenfeld(ankreuzbaisy
+)<>""THEN "Systemdaten"ELIF standardmaskenfeld(ankreuzida)<>""THEN
+"Anwenderspezifischen Druckausgaben"ELSE "Amtliche Statistik"FI END PROC
+logbuchbehandeltedaten;BOOL PROC auffloppy:standardmaskenfeld(
+ankreuzauffloppysichern)<>""ENDPROC auffloppy;PROC formatieren:
+archiveanmelden;IF anmeldetask<>""THEN archiveoperation(formatcode,
+dbsicherung)FI ;infeld(2);return(2)END PROC formatieren;PROC endeformatieren:
+archiveabmelden;enter(2)ENDPROC endeformatieren;PROC initialisieren:
+archiveanmelden;IF anmeldetask<>""THEN archiveoperation(initcode,dbsicherung)
+FI ;infeld(2);return(2)END PROC initialisieren;PROC disketteueberpruefen:
+eingabepruefeneinfach;IF eingabestatus<>0THEN infeld(eingabestatus);return(1)
+ELSE standardmeldung(floppyzurpruefung,"");archiveanmelden;IF anmeldetask<>""
+THEN archiveoperation(checkcode,dbsicherung)FI ;infeld(2);return(1)FI END
+PROC disketteueberpruefen;PROC floppylisten:eingabepruefeneinfach;IF
+eingabestatus<>0THEN infeld(eingabestatus);return(1)ELSE standardmeldung(
+floppyzuranzeige,"");archiveanmelden;IF anmeldetask<>""THEN archiveoperation(
+listcode,dbsicherung);IF errorTHEN return(1)FI ELSE return(1)FI FI END PROC
+floppylisten;PROC dbverzeichniserstellen:eingabepruefeneinfach;IF
+eingabestatus<>0THEN infeld(eingabestatus);return(1)ELIF standardmaskenfeld(
+ankreuzstatistik)<>""THEN standardmeldung(keinedaten,"");return(1)ELSE
+archiveoperation(dddrucken,dbsicherung);FI END PROC dbverzeichniserstellen;
+PROC melde(TEXT CONST mt):TEXT CONST mtext:=""+subtext(mt,1,
+meldungsfeldlaenge-5)+" ";INT VAR textl:=length(mtext);INT VAR seitenlaenge
+:=meldungsfeldlaenge-textl;seitenlaenge:=seitenlaengeDIV 2;TEXT CONST fueller
+:=seitenlaenge*" ";TEXT VAR meldung:=fueller+mtext+fueller;
+evtlteiltextersetzen;meldungIN meldungsfeld.evtlteiltextersetzen:INT VAR
+archpos:=pos(meldung,meldpattern1);IF archpos>0THEN IF NOT (pos(meldung,
+meldpattern3)>0)THEN TEXT VAR ergaenztemeldung:=subtext(meldung,1,archpos-1)+
+meldpattern3;INT VAR patternpos2:=archpos+patternlaenge;IF (meldungSUB
+patternpos2)=meldpattern2THEN ergaenztemeldungCAT subtext(meldung,patternpos2
++1)ELSE ergaenztemeldungCAT subtext(meldung,patternpos2)FI ;meldung:=
+ergaenztemeldungFI FI .END PROC melde;TEXT PROC frage(TEXT CONST mess):#
+subtext(#mess#,textbeginn)#+fragekennzeichnungEND PROC frage;PROC
+archiveoperation(INT CONST auftragscode,TEXT CONST sicherungstask):TASK VAR
+sendingtask;letzterauftragscode:=auftragscode;dbsicherungstask:=/
+sicherungstask;forget(ds);ds:=nilspace;endequittungda:=FALSE ;error:=FALSE ;
+call(dbsicherungstask,auftragscode,ds,quittung);loop.loop:REP SELECT quittung
+OF CASE yescode:questionCASE showcode:showenCASE outcode:meldenCASE
+endemeldung:beendenCASE errornak:fehlermeldenOTHERWISE :unknowncodeENDSELECT
+;UNTIL endequittungdaPER .question:message:=ds;melde(frage(message));LEAVE
+archiveoperation.showen:IF auftragscode=listcodeTHEN floppyELSE dbFI .floppy:
+forget(dbsicherung,quiet);copy(ds,dbsicherung);floppylistingzeigen;LEAVE
+archiveoperation.db:forget(dbinhalt,quiet);copy(ds,dbinhalt);
+dbverzeichniszeigen;LEAVE archiveoperation.melden:message:=ds;standardmeldung
+(message,"");wartenaufnaechstesendung.wartenaufnaechstesendung:REP forget(ds)
+;wait(ds,quittung,sendingtask);IF NOT (sendingtask=dbsicherungstask)THEN
+sendnakELSE LEAVE wartenaufnaechstesendungFI PER .beenden:IF
+ungleichanmeldenundabmeldenTHEN standardmeldung(meldnr,"");archiveabmelden;
+FI ;stufe:=1;endequittungda:=TRUE .meldnr:SELECT auftragscodeOF CASE
+formatcode:formatkorrektCASE initcode:initkorrektCASE dbvomserver,dbaufdisk:
+sichernkorrektCASE dbzumserver,dbvondisk:ladenkorrektOTHERWISE :opkorrekt
+ENDSELECT .ungleichanmeldenundabmelden:auftragscode<>logonarchivecodeCAND
+auftragscode<>logoffarchivecode.fehlermelden:message:=ds;standardmeldung(
+message,"");IF ungleichanmeldenundabmeldenTHEN archiveabmeldenFI ;stufe:=1;
+error:=TRUE ;#return(1);#LEAVE archiveoperation.unknowncode:standardmeldung(
+unbekanntercode,": "+text(quittung)+"#");stufe:=1;#return(1);#LEAVE loop.
+sendnak:send(sendingtask,nak,ds).ENDPROC archiveoperation;PROC
+floppylistingzeigen:editiere(dbsicherung)ENDPROC floppylistingzeigen;PROC
+dbverzeichniszeigen:editiere(dbinhalt,FALSE )ENDPROC dbverzeichniszeigen;
+PROC endedbverzeichnis:killundenter(2)ENDPROC endedbverzeichnis;PROC
+endefloppylisting:archiveabmelden;killundenter(2)ENDPROC endefloppylisting;
+PROC archiveanmelden:eingabepruefeneinfach;IF eingabestatus<>0THEN infeld(
+eingabestatus);return(1)ELSE archiveoperation(logonarchivecode,dbsicherung);
+IF #quittung=endemeldung#endequittungdaCAND NOT errorTHEN anmeldetask:=
+dbsicherungELSE anmeldetask:=""FI FI ENDPROC archiveanmelden;PROC
+archiveabmelden:IF anmeldetask<>""THEN archiveoperation(logoffarchivecode,
+anmeldetask);anmeldetask:=""FI ENDPROC archiveabmelden;PROC meldungquittieren
+(BOOL CONST b):BOUND BOOL VAR boolds;forget(ds);ds:=nilspace;boolds:=ds;
+boolds:=b;send(/dbsicherung,yescode,ds);forget(ds);IF bTHEN enter(1)ELSE
+standardmeldung(inkonsicherung,"");archiveabmelden;#enter(2)#return(2)FI
+ENDPROC meldungquittieren;PROC bestimmendersicherungstask:
+eingabepruefeneinfach;IF eingabestatus<>0THEN infeld(eingabestatus);return(1)
+FI ENDPROC bestimmendersicherungstask;PROC sicherungsloop:TASK VAR
+sendingtask;endequittungda:=FALSE ;REP wartenaufnaechstesendung;SELECT
+quittungOF CASE yescode:questionCASE outcode:meldenCASE endemeldung:beenden
+CASE errornak:fehlermeldenOTHERWISE :unknowncodeENDSELECT ;PER .question:
+message:=ds;melde(frage(message));LEAVE sicherungsloop.melden:message:=ds;
+standardmeldung(message,"");#wartenaufnaechstesendung#.
+wartenaufnaechstesendung:REP forget(ds);wait(ds,quittung,sendingtask);IF NOT
+(sendingtask=dbsicherungstask)THEN sendnakELSE LEAVE wartenaufnaechstesendung
+FI PER .beenden:standardmeldung(meldnr,"");archiveabmelden;stufe:=1;return(1)
+;endequittungda:=TRUE ;LEAVE sicherungsloop.meldnr:SELECT letzterauftragscode
+OF CASE dbvomserver,dbaufdisk:sichernkorrektCASE dbzumserver,dbvondisk:
+ladenkorrektOTHERWISE :opkorrektENDSELECT .fehlermelden:message:=ds;
+standardmeldung(message,"");archiveabmelden;error:=TRUE ;stufe:=1;return(1);
+LEAVE sicherungsloop.unknowncode:standardmeldung(unbekanntercode,"");stufe:=1
+;return(1);LEAVE sicherungsloop.sendnak:send(sendingtask,nak,ds).ENDPROC
+sicherungsloop;END PACKET sicherungsmonitor
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.standardmaskenbehandlung b/app/baisy/2.2.1-schulis/src/isp.standardmaskenbehandlung
new file mode 100644
index 0000000..1ebb1eb
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.standardmaskenbehandlung
@@ -0,0 +1,35 @@
+PACKET ispstandardmaskenbehandlungDEFINES schulkenndatum,
+standardkopfmaskeinitialisieren,standardkopfmaskeausgeben,
+standardkopfmaskeaktualisieren,setzeschulnamen,leseschulnamen:LET maskenname=
+"mu standardkopf",fnrsystem=2,fnrschule=3,fnrdatum=4,fnrversion=5,fnrtitel=6,
+fnrzeit=7;TAG VAR maske;#LET s2="Schulname";#TEXT VAR schuldaten:="";TEXT
+VAR zeileschulname:="";TEXT VAR systemname:="";PROC
+standardkopfmaskeinitialisieren(TEXT CONST system):setzeschulnamen(
+zeileschulname);systemname:=system;initmaske(maske,maskenname)END PROC
+standardkopfmaskeinitialisieren;PROC standardkopfmaskeausgeben(TEXT CONST
+programmname):TEXT VAR hilfe;hilfe:=systemname;zentrieretext(maske,hilfe,
+fnrsystem);fill(maske,hilfe,fnrsystem);fill(maske,schulisversion,fnrversion);
+fill(maske,date,fnrdatum);fill(maske,timeofday,fnrzeit);hilfe:=programmname;
+zentrieretext(maske,hilfe,fnrtitel);fill(maske,hilfe,fnrtitel);hilfe:=
+zeileschulname;zentrieretext(maske,hilfe,fnrschule);fill(maske,hilfe,
+fnrschule);show(maske).END PROC standardkopfmaskeausgeben;PROC
+standardkopfmaskeaktualisieren(TEXT CONST programmname):TEXT VAR hilfe;put(
+maske,timeofday,fnrzeit);hilfe:=programmname;zentrieretext(maske,hilfe,
+fnrtitel);put(maske,hilfe,fnrtitel);END PROC standardkopfmaskeaktualisieren;
+PROC standardkopfmaskeaktualisieren:put(maske,timeofday,fnrzeit);END PROC
+standardkopfmaskeaktualisieren;TEXT PROC leseschulnamen:zeileschulname
+ENDPROC leseschulnamen;PROC setzeschulnamen(TEXT CONST schulname):
+zeileschulname:=schulnameENDPROC setzeschulnamen;TEXT PROC schulkenndatum(
+TEXT CONST schluessel):LET schulkenndaten="c02 schulkenndaten";systemdboff;
+inittupel(dnrschluessel);putwert(fnrschlsachgebiet,schulkenndaten);putwert(
+fnrschlschluessel,schluessel);search(dnrschluessel,TRUE );IF dbstatus=okTHEN
+schuldaten:=wert(fnrschllangtext)ELSE schuldaten:=""FI ;schuldatenENDPROC
+schulkenndatum;PROC zentrieretext(TAG CONST maske,TEXT VAR text,INT CONST
+feld):INT VAR leerlaenge;TEXT VAR leertext;LET leerzeichen=" ";leerlaenge:=(
+length(maske,feld)-length(text));IF (leerlaenge>0)THEN leertext:=(leerlaenge
+DIV 2)*leerzeichen;text:=leertext+text+leertext;IF (leerlaengeMOD 2<>0)THEN
+text:=text+leerzeichenFI ;FI ;END PROC zentrieretext;END PACKET
+ispstandardmaskenbehandlung;oeffnedatenbank(schulisdbname);setzeschulnamen(
+schulkenndatum("Schulname"));setzeschulisversion("2.2.1");
+standardkopfmaskeinitialisieren("schulis")
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.systembaumbearbeitung b/app/baisy/2.2.1-schulis/src/isp.systembaumbearbeitung
new file mode 100644
index 0000000..8b2f189
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.systembaumbearbeitung
@@ -0,0 +1,236 @@
+PACKET systembaumbearbeitungneuDEFINES loescheteilbaeume,
+teilbaeumeaussystembaum,uebersetze:LET dp=":",refinementende=".";LET grenze=6
+;LET fehldat="Übersetzungsfehler:";FILE VAR quelle;KNOTENMENGE VAR ang,nach;
+TEXT VAR newsymbol:="";INT VAR newkind;TEXT VAR aktzeile:="";INT VAR
+zeilenindex;ROW grenzeTEXT VAR at;FILE VAR f;INT CONST maxat:=6,tepos:=1,mpos
+:=2,vpos:=3,npos:=4,tpos:=5,ppos:=6;LET normkz="0",refkz="1";LET scanende=7,
+scanbold=2,scantext=4,scandel=6,scannumber=3,scanid=1;TEXT PROC attribute(
+KNOTEN CONST k):TEXT VAR attr;read(k,attr);attrEND PROC attribute;BOOL PROC
+isrefinement(KNOTEN CONST k):(subtext(attribute(k),1,1)=refkz)END PROC
+isrefinement;BOOL PROC isnormal(KNOTEN CONST k):(subtext(attribute(k),1,1)=
+normkz)END PROC isnormal;BOOL PROC isopen(KNOTEN CONST k):NOT (isrefinement(k
+)COR isnormal(k))END PROC isopen;PROC mengedernachfolger(KNOTEN CONST k,
+KNOTENMENGE VAR m):read(k,m)END PROC mengedernachfolger;PROC
+neuenachfolgermenge(KNOTEN CONST k,KNOTENMENGE CONST m):write(k,m)END PROC
+neuenachfolgermenge;PROC loescheteilbaeume(TEXT CONST datnam,BOOL VAR
+gefunden):bearbeiteteilbaeume(datnam,PROC (TEXT CONST ,BOOL VAR )loesche,
+gefunden)END PROC loescheteilbaeume;PROC teilbaeumeaussystembaum(TEXT CONST
+datnam,BOOL VAR gefunden):bearbeiteteilbaeume(datnam,PROC (TEXT CONST ,BOOL
+VAR )retranslate,gefunden)END PROC teilbaeumeaussystembaum;PROC
+bearbeiteteilbaeume(TEXT CONST datnam,PROC (TEXT CONST ,BOOL VAR )behandle,
+BOOL VAR gefunden):ersterteilbaum;WHILE weitereteilbaeumeREP behandleteilbaum
+;naechsterteilbaumPER .behandleteilbaum:behandle(teilbaumname,gefunden);IF
+NOT gefundenTHEN line(f,2);putline(f,"(* Teilbaum "+teilbaumname+
+" existiert nicht *)");FI ;nextsymbol(newsymbol,typ).ersterteilbaum:f:=
+sequentialfile(input,datnam);TEXT VAR liste;getline(f,liste);forget(datnam,
+quiet);f:=sequentialfile(output,datnam);scan(liste);naechsterteilbaum.
+naechsterteilbaum:TEXT VAR teilbaumname;INT VAR typ;nextsymbol(teilbaumname,
+typ).weitereteilbaeume:typ<>scanende.END PROC bearbeiteteilbaeume;PROC
+loesche(TEXT CONST teilbaumname,BOOL VAR gefunden):sucheteilbaum;IF gefunden
+THEN loeschediesenFI .sucheteilbaum:KNOTEN VAR teilbaumref;gefunden:=
+existiert(exporte,teilbaumref,teilbaumname).loeschediesen:#loescheunterbaum(
+teilbaumref);KNOTENMENGE VAR g;mengedernachfolger(teilbaumref,g);KNOTEN VAR r
+:=erster(g);IF gueltig(r)THEN knotenloeschen(g,r)FI ;knotenloeschen(exporte,
+teilbaumref)#KNOTENMENGE VAR g;mengedernachfolger(teilbaumref,g);KNOTEN VAR r
+:=erster(g);loescheunterbaum(teilbaumref);IF gueltig(r)THEN knotenloeschen(g,
+r)FI ;knotenloeschen(exporte,teilbaumref).END PROC loesche;PROC retranslate(
+TEXT CONST teilbaumname,BOOL VAR gefunden):sucheteilbaum;IF gefundenTHEN
+schreibeteilbaumname;durchlaufeteilbaum;schreibeteilbaumendeFI .sucheteilbaum
+:KNOTEN VAR teilbaumref;gefunden:=existiert(exporte,teilbaumref,teilbaumname)
+.schreibeteilbaumname:putline(f,attribute(teilbaumref)+dp).
+schreibeteilbaumende:putline(f,refinementende).durchlaufeteilbaum:
+KNOTENMENGE VAR g;mengedernachfolger(teilbaumref,g);ausbaum(erster(g),1).END
+PROC retranslate;PROC ausbaum(KNOTEN CONST k,INT CONST stufe):stufennummer;
+IF istnochnichtdefiniertTHEN refinementnameschreiben;
+nochnichtdefiniertschreibenELIF istrefinementTHEN
+refinementsuchenundschreibenELSE notierediesen;durchlaufeallesoehneFI .
+istrefinement:(isrefinement(k))CAND (stufe>1).istnochnichtdefiniert:isopen(k)
+.notierediesen:elemente(k,vorschub,zeile).stufennummer:TEXT VAR vorschub:=
+stufe*" ";TEXT VAR zeile:=vorschub+text(stufe);vorschub:=vorschub+" ".
+refinementnameschreiben:KNOTEN VAR knoten:=k;refinementname.refinementname:
+put(f,zeile+" "+attribute(knoten));line(f).nochnichtdefiniertschreiben:put(f,
+vorschub+" (* ist noch nicht definiert *)");line(f).
+refinementsuchenundschreiben:read(k,knoten);refinementname.
+durchlaufeallesoehne:KNOTENMENGE VAR soehne;mengedernachfolger(k,soehne);
+KNOTEN VAR sohn:=erster(soehne);WHILE gueltig(sohn)REP ausbaum(sohn,stufe+1);
+naechster(sohn,soehne)PER .END PROC ausbaum;PROC elemente(KNOTEN CONST k,
+TEXT CONST vorschub,TEXT CONST zeil):TEXT VAR at,zeile:=zeil;tex;mask;vorproz
+;nachproz;tast;prozess;absatz.tex:zeile:=zeile+" TEXT """+text(k)+"""";put(f,
+zeile).mask:at:=maske(k);IF at<>""THEN put(f,";");line(f);zeile:=vorschub+
+"MASKE """+at+"""";put(f,zeile)FI .prozess:at:=task(k);IF at<>""THEN put(f,
+";");line(f);zeile:=vorschub+"TASK """+at+"""";put(f,zeile)FI .vorproz:at:=
+vorprozedur(k);IF at<>""THEN put(f,";");line(f);zeile:=vorschub+"> "+at;put(f
+,zeile)FI .nachproz:at:=nachprozedur(k);IF at<>""THEN put(f,";");line(f);
+zeile:=vorschub+"< "+at;put(f,zeile)FI .tast:at:=taste(k);IF at<>""THEN put(f
+,";");line(f);zeile:=vorschub+"TASTE """+at+"""";put(f,zeile)FI .absatz:line(
+f).END PROC elemente;TEXT PROC maske(KNOTEN CONST k):attribut(k,mpos)END
+PROC maske;TEXT PROC task(KNOTEN CONST k):attribut(k,ppos)END PROC task;TEXT
+PROC vorprozedur(KNOTEN CONST k):attribut(k,vpos)END PROC vorprozedur;TEXT
+PROC nachprozedur(KNOTEN CONST k):attribut(k,npos)END PROC nachprozedur;TEXT
+PROC taste(KNOTEN CONST k):attribut(k,tpos)END PROC taste;TEXT PROC attribut(
+KNOTEN CONST k,INT CONST i):TEXT VAR attext;attext:=attribute(k);TEXT VAR
+amuster:="��",emuster:="��";replace(amuster,1,i);replace(emuster,1,i+1);INT
+VAR ende,anfang;anfang:=pos(attext,amuster)+2;IF i<maxatTHEN ende:=pos(attext
+,emuster,anfang)-1;subtext(attext,anfang,ende)ELSE subtext(attext,anfang)FI
+END PROC attribut;TEXT PROC text(KNOTEN CONST k):attribut(k,tepos)END PROC
+text;OP HAT (KNOTEN CONST k,TEXT CONST t):write(k,t)END OP HAT ;OP NACH (
+KNOTEN CONST sohn,vater):KNOTENMENGE VAR m;mengedernachfolger(vater,m);
+inknotenmenge(m,sohn);write(vater,m);END OP NACH ;OP BEZUG (KNOTEN CONST sohn
+,KNOTEN CONST vater):write(sohn,vater);END OP BEZUG ;BOOL PROC schluss:
+dateiendeCOR is(refinementende)END PROC schluss;BOOL PROC dateiende:(newkind=
+scanende)CAND eof(quelle)END PROC dateiende;BOOL PROC isrand:(schlussCOR
+isnumber)END PROC isrand;BOOL PROC is(TEXT CONST t):(t=newsymbol)END PROC is;
+BOOL PROC isbold:(newkind=scanbold)END PROC isbold;BOOL PROC iskeybold:(is(
+"TEXT")OR is(">")OR is("<")OR is("MASKE")OR is("TASTE")OR is("TASK"))END
+PROC iskeybold;BOOL PROC istext:(newkind=scantext)END PROC istext;BOOL PROC
+isdelimiter:(newkind=scandel)END PROC isdelimiter;BOOL PROC isprocedure(TEXT
+VAR t):IF NOT isidTHEN FALSE ELSE t:=newsymbol;next;IF is("(")THEN INT VAR
+klammernzaehler:=0;REP IF is("(")THEN klammernzaehlerINCR 1ELIF is(")")THEN
+klammernzaehlerDECR 1FI ;IF istextTHEN t:=t+""""+newsymbol+""""ELSE t:=t+
+newsymbolFI ;nextUNTIL (klammernzaehler=0)PER FI ;is(";")COR israndFI END
+PROC isprocedure;BOOL PROC isnumber:(newkind=scannumber)END PROC isnumber;
+BOOL PROC isid:(newkind=scanid)END PROC isid;PROC next:nextsymbol(newsymbol,
+newkind);WHILE (newkind=scanende)CAND (NOT eof(quelle))REP getline(quelle,
+aktzeile);continuescan(aktzeile);aktuellezeile;nextsymbol(newsymbol,newkind);
+PER ;END PROC next;PROC lies(TEXT CONST t):IF NOT (t=newsymbol)THEN fehler(t)
+ELSE nextFI END PROC lies;PROC fehler(TEXT CONST f):FILE VAR fd:=
+sequentialfile(output,fehldat);TEXT VAR t:="Fehler bei : """;t:=t+newsymbol+
+""" in Zeile "+text(zeilenindex)+" , ";line(fd,5);putline(fd,t);t:=
+"denn erwartet wurde: """;t:=t+f;t:=t+""" ";putline(fd,t);close(fd);stop
+END PROC fehler;PROC initparser:initscanner;END PROC initparser;PROC
+initscanner:getline(quelle,aktzeile);scan(aktzeile);page;cursor(1,3);put(
+"Bearbeitet wird zur Zeit Zeile: ");zeilenindex:=1;aktuellezeile;END PROC
+initscanner;PROC aktuellezeile:cursor(33,3);put(zeilenindex);zeilenindexINCR
+1;END PROC aktuellezeile;PROC systembaum:enablestop;initparser;
+initialisieretemporaeregruppen;next;REP benannterteilbaum;nextUNTIL dateiende
+PER ;meldesyntaxkorrekt;uebernehmeindenbestand.initialisieretemporaeregruppen
+:ang:=leereknotenmenge;nach:=leereknotenmenge.meldesyntaxkorrekt:line(5);put(
+" * * * E i n g a b e i s t k o r r e k t * * * ");line(5);put(
+" * * * Ü b e r n a h m e i n M e n ü b a u m * * * ").END PROC
+systembaum;PROC benannterteilbaum:IF NOT isidTHEN fehler("Teilbaumname")FI ;
+erzeugeangebotsundsystemknotenaunds;next;baum(s);sistnachfolgervona;
+aistbezugsknotenvons.erzeugeangebotsundsystemknotenaunds:KNOTEN VAR a:=
+neuerknoten(ang);aHAT newsymbol;KNOTEN VAR s:=neuerknoten(system).
+sistnachfolgervona:sNACH a.aistbezugsknotenvons:sBEZUG a.END PROC
+benannterteilbaum;PROC baum(KNOTEN VAR node):INT VAR i0;lies(":");IF NOT
+isnumberTHEN fehler("Stufennummer")FI ;i0:=int(newsymbol);next;
+knotenattribute(node);zeigerefinementan;unterbaum(i0,node).zeigerefinementan:
+TEXT VAR t:=attribute(node);replace(t,1,"1");nodeHAT t.END PROC baum;PROC
+unterbaum(INT CONST j,KNOTEN VAR node):INT CONST k:=int(newsymbol);IF NOT
+isnumberTHEN IF NOT schlussTHEN fehler("Stufennummer oder Ende")ELSE LEAVE
+unterbaumFI FI ;IF j>=kTHEN LEAVE unterbaumFI ;next;erzeugeneuensohns;
+dieseristinsystemnachfolgervonnode;sohn(k,s,node);soehne(k,node).
+erzeugeneuensohns:KNOTEN VAR s:=neuerknoten(system).
+dieseristinsystemnachfolgervonnode:sNACH node.END PROC unterbaum;PROC soehne(
+INT CONST j,KNOTEN VAR node):INT CONST k:=int(newsymbol);IF NOT isnumberTHEN
+IF NOT schlussTHEN fehler("Stufennummer oder Ende")ELSE LEAVE soehneFI FI ;
+IF j>kTHEN LEAVE soehneFI ;IF NOT (j=k)THEN fehler("gleiche Stufennummer")FI
+;next;erzeugeneuensohns;dieseristinsystemnachfolgervonnode;sohn(j,s,node);
+soehne(j,node).erzeugeneuensohns:KNOTEN VAR s:=neuerknoten(system).
+dieseristinsystemnachfolgervonnode:sNACH node.END PROC soehne;PROC sohn(INT
+CONST k,KNOTEN VAR node,vater):IF iskeyboldTHEN knotenattribute(node);
+unterbaum(k,node)ELSE IF NOT isidTHEN fehler(
+"ein Teilbaumname oder Schlüsselwort")ELSE erzeugeneuenachfrageninnach;
+setzevateralsnachfolgervonn;next;FI FI .erzeugeneuenachfrageninnach:KNOTEN
+VAR n:=neuerknoten(nach,newsymbol).setzevateralsnachfolgervonn:IF sohnvon(n,
+vater)THEN fehler(newsymbol+" nur einmal als Sohn auf Level "+text(k))FI ;
+vaterNACH n;nodeHAT newsymbol.END PROC sohn;PROC knotenattribute(KNOTEN VAR
+node):initialisierehilfsvariablen;TEXT VAR t;attribut;WHILE iskeyboldREP
+attributPER ;IF ((NOT isnumber)CAND (NOT schluss))THEN fehler(
+"Attribut oder Stufennummer")ELSE abschliessendebehandlungFI .
+initialisierehilfsvariablen:INT VAR i:=0;t:="0";FOR iFROM 1UPTO maxatREP at(i
+):=""PER .abschliessendebehandlung:merke(t);nodeHAT t.END PROC
+knotenattribute;PROC attribut:TEXT VAR procname;IF is("TEXT")THEN next;IF
+NOT istextTHEN fehler("ein Menuetext")FI ;setze(newsymbol,tepos);next;IF NOT
+israndTHEN lies(";")FI ELSE IF is(">")THEN next;IF NOT isprocedure(procname)
+THEN fehler("ein Vor-Prozedur-Aufruf")FI ;setze(procname,vpos);IF NOT isrand
+THEN nextFI ELSE IF is("<")THEN next;IF NOT isprocedure(procname)THEN fehler(
+"ein Nach-Prozedur-Aufruf")FI ;setze(procname,npos);IF NOT israndTHEN nextFI
+ELSE IF is("MASKE")THEN next;IF NOT istextTHEN fehler("ein Maskenname")FI ;
+setze(newsymbol,mpos);next;IF NOT israndTHEN lies(";")FI ELSE IF is("TASTE")
+THEN next;IF NOT istextTHEN fehler("ein Funktionstastenname")FI ;setze(
+newsymbol,tpos);next;IF NOT israndTHEN lies(";")FI ELSE IF is("TASK")THEN
+next;IF NOT istextTHEN fehler("ein Taskname")FI ;setze(newsymbol,ppos);next;
+IF NOT israndTHEN lies(";")FI ELSE fehler("ein Schlüsselwort")FI FI FI FI FI
+FI END PROC attribut;PROC setze(TEXT CONST t,INT CONST i):at(i):=tEND PROC
+setze;PROC merke(TEXT VAR t):INT VAR i;TEXT VAR muster:="��";FOR iFROM 1UPTO
+maxatREP replace(muster,1,i);tCAT muster;tCAT at(i)PER END PROC merke;PROC
+uebersetze(TEXT CONST t,BOOL VAR fehler):quelle:=sequentialfile(input,t);INT
+CONST azahl:=zahlderelemente(exporte),szahl:=zahlderelemente(system),nzahl:=
+zahlderelemente(importe);clearerror;disablestop;kopieresystembaum;systembaum;
+IF iserrorTHEN fehler:=TRUE ;setzesystembaumzurueck;LEAVE uebersetzeFI ;
+fehler:=FALSE ;line(3);put(
+" * * * Ü b e r n a h m e i s t b e e n d e t * * * ");line(2);
+statistik(azahl,szahl,nzahl);line(2);put(
+" * * * D a t e n b a n k b e r e i n i g u n g * * * ");loesche;
+ueberschreibesystembaumEND PROC uebersetze;PROC statistik(INT CONST az,sz,nz)
+:INT CONST agesz:=zahlderelemente(exporte),sgesz:=zahlderelemente(system),
+ngesz:=zahlderelemente(importe);put("Zahl der Systembaumknoten insgesamt: ");
+put(sgesz);INT CONST sdif:=sgesz-sz,ndif:=ngesz-nz;line;IF sdif<0THEN put(
+"Entfernte Systemknoten: "+text(-sdif));ELSE put(
+"Neu erzeugte Systemknoten: "+text(sdif));FI ;line;put(
+"Neu definierte Teilbäume: "+text(agesz-az));line;IF ndif<0THEN put(
+"Abgedeckte Teilbaumreferenzen: "+text(-ndif))ELSE put(
+"Zusätzliche offene Teilbaumreferenzen: "+text(ndif))FI END PROC statistik;
+PROC loesche:knotenmengeloeschen(ang);knotenmengeloeschen(nach)END PROC
+loesche;OP VEREINIGT (KNOTENMENGE VAR a,KNOTENMENGE CONST b):KNOTEN VAR k:=
+erster(b);WHILE gueltig(k)REP a+k;naechster(k,b)PER ;END OP VEREINIGT ;OP +(
+KNOTENMENGE VAR a,KNOTEN CONST b):inknotenmenge(a,b);END OP +;PROC
+uebernehmeindenbestand:startepruefungmitneu;WHILE gueltig(neu)REP
+pruefenderexporte;IF schondaTHEN aenderungELSE neuanlegenFI PER ;
+abgleichenvonexportenundimporten.startepruefungmitneu:KNOTEN VAR neu:=erster(
+ang);KNOTEN VAR alt;BOOL VAR gleich.pruefenderexporte:gleich:=existiert(
+exporte,alt,attribute(neu)).schonda:gleich.aenderung:
+loeschealleknotendesaltenrefinements;neuanlegenbisaufdenursprung.
+loeschealleknotendesaltenrefinements:rettebisherigenursprung;
+gehevomursprungausundloescheallesausserrefinements.rettebisherigenursprung:
+KNOTENMENGE VAR u;mengedernachfolger(alt,u);KNOTEN VAR ursprung:=erster(u).
+gehevomursprungausundloescheallesausserrefinements:loescheunterbaum(ursprung)
+.neuanlegenbisaufdenursprung:raufnachfolgervonneusetzen;
+derursprungwirdueberschrieben.raufnachfolgervonneusetzen:KNOTENMENGE VAR root
+;KNOTEN VAR r;mengedernachfolger(neu,root);r:=erster(root).
+derursprungwirdueberschrieben:move(r,ursprung);knotenloeschen(root,r);
+knotenloeschen(ang,neu).neuanlegen:inknotenmenge(exporte,neu,alt);
+ausknotenmenge(ang,neu).abgleichenvonexportenundimporten:KNOTENMENGE VAR
+abzudeckendenachfragen;KNOTENMENGE VAR nachfragesoehne;BOOL VAR gibtes;TEXT
+VAR importname;KNOTEN VAR importeinordner,importbezug;festimport:=erster(
+importe);WHILE gueltig(festimport)REP importname:=attribute(festimport);
+abgleichmitimporten;abgleichabschlussPER ;KNOTEN VAR aktimport:=erster(nach);
+WHILE gueltig(aktimport)REP importname:=attribute(aktimport);
+versucheabgleichmitexporten;IF gelungenTHEN importbezug:=aktimport;
+fuehreabgleichmitexportendurch;knotenloeschen(nach,aktimport)ELSE gibtes:=
+existiert(importe,importeinordner,importname);inknotenmenge(importe,aktimport
+,importeinordner);ausknotenmenge(nach,aktimport)FI ;PER .abgleichabschluss:
+versucheabgleichmitexporten;IF gelungenTHEN importbezug:=festimport;
+fuehreabgleichmitexportendurch;knotenloeschen(importe,festimport)ELSE
+naechster(festimport,importe)FI .versucheabgleichmitexporten:KNOTEN VAR
+aktexport;BOOL VAR gelungen;gelungen:=existiert(exporte,aktexport,importname)
+.abgleichmitimporten:KNOTEN VAR festimport;gelungen:=existiert(nach,aktimport
+,importname);IF gelungenTHEN verschmelzung;knotenloeschen(nach,aktimport)FI .
+verschmelzung:KNOTENMENGE VAR nfa;mengedernachfolger(aktimport,nfa);
+KNOTENMENGE VAR nfn;mengedernachfolger(festimport,nfn);nfnVEREINIGT nfa.
+fuehreabgleichmitexportendurch:finderefinementwurzel;
+markiererefinementalsbenutzt;sammlenachfragen;WHILE nochimbereichREP
+deckenachfrageabPER .finderefinementwurzel:KNOTEN VAR refinementwurzel;
+KNOTENMENGE VAR exportiertesrefinement;mengedernachfolger(aktexport,
+exportiertesrefinement);refinementwurzel:=erster(exportiertesrefinement).
+markiererefinementalsbenutzt:write(aktexport,markierungsknoten).
+sammlenachfragen:mengedernachfolger(importbezug,abzudeckendenachfragen);
+KNOTEN VAR behandelterimport:=erster(abzudeckendenachfragen).nochimbereich:
+gueltig(behandelterimport).naechsterimport:naechster(behandelterimport,
+abzudeckendenachfragen).deckenachfrageab:findeungesaettigtensohn;IF gueltig(
+zuersetzendersohn)THEN ersetzediesendurchrefinement;naechsterimportELSE
+ausknotenmenge(abzudeckendenachfragen,behandelterimport)FI .
+findeungesaettigtensohn:KNOTEN VAR zuersetzendersohn;mengedernachfolger(
+behandelterimport,nachfragesoehne);zuersetzendersohn:=erster(nachfragesoehne)
+;WHILE gueltig(zuersetzendersohn)CAND nochnichtgefundenREP naechster(
+zuersetzendersohn,nachfragesoehne)PER .nochnichtgefunden:(NOT isopen(
+zuersetzendersohn))COR (NOT (attribute(zuersetzendersohn)=attribute(
+importbezug))).ersetzediesendurchrefinement:knotenloeschen(nachfragesoehne,
+zuersetzendersohn);inknotenmenge(nachfragesoehne,refinementwurzel,
+zuersetzendersohn).END PROC uebernehmeindenbestand;PROC loescheunterbaum(
+KNOTEN CONST node):KNOTENMENGE VAR m;mengedernachfolger(node,m);KNOTEN VAR k
+:=erster(m);WHILE gueltig(k)REP IF NOT isrefinement(k)THEN loescheunterbaum(k
+);knotenloeschen(m,k)ELSE ausknotenmenge(m,k);FI PER END PROC
+loescheunterbaum;END PACKET systembaumbearbeitungneu;
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.systembaumeditor b/app/baisy/2.2.1-schulis/src/isp.systembaumeditor
new file mode 100644
index 0000000..ffd3b6c
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.systembaumeditor
@@ -0,0 +1,72 @@
+PACKET systembaumeditorDEFINES startsystembaumeditor,aktuellensenamenlesen,
+baumausdatei,baumausdateizeigen,baumausdateiuebersetzen,
+systembaumreorganisieren,listederteilbaumdateien,listederteilbaeume,
+erwartereaktion,baumaendern,baumloeschen,eingangsbildschirmherstellen,
+internenbaumzeigen,internenbaumuebersetzen:LET z="Teilbaumliste",trenner=",",
+praefix="b.",standardanfang=2,maxfelder=10,reorg=0,dummy="dummy",baumdatei=1,
+teilbaeume=2,maskese1="mb baumdateibearbeitung",maskese2=
+"mb teilbaumbearbeitung",maxnamenlaenge=32,fehldat="Übersetzungsfehler:";;
+BOOL VAR fehler:=FALSE ;FILE VAR f;TEXT VAR namen:="";TEXT VAR dnam:="";;TAG
+VAR aktuellemaske;INT VAR aktuelleposition;ROW 100TEXT VAR feld;INT VAR prog,
+teilbaumzahl;init(feld);PROC startsystembaumeditor(INT CONST kennung):
+werbinich;frageentwicklernachdemnamen;aktuellensenamenlesen.werbinich:TEXT
+VAR maskenname;SELECT kennungOF CASE baumdatei:maskenname:=maskese1CASE
+teilbaeume:maskenname:=maskese2END SELECT ;prog:=kennung.
+frageentwicklernachdemnamen:page;IF exists(dnam)THEN forget(dnam,quiet)FI ;
+IF exists(namen)THEN rename(namen,praefix+namen)FI ;aktuelleposition:=
+standardanfang;standardkopfmaskeausgeben(text(vergleichsknoten));initmaske(
+aktuellemaske,maskenname);show(aktuellemaske).END PROC startsystembaumeditor;
+PROC aktuellensenamenlesen:putget(aktuellemaske,feld,aktuelleposition);namen
+:=eingegebenenamen;loeschemeldung(aktuellemaske).END PROC
+aktuellensenamenlesen;PROC baumausdatei:IF namen=""THEN melde(aktuellemaske,
+43);return(1)ELSE IF istree(namen)THEN meldeohneb;return(1)ELSE f:=
+sequentialfile(output,praefix+namen);close(f);baumausdateizeigenFI FI .
+meldeohneb:melde(aktuellemaske,44).END PROC baumausdatei;PROC
+baumausdateizeigen:store(FALSE );page;TEXT VAR t:=praefix+namen;IF exists(t)
+THEN rename(t,namen)FI ;IF exists(fehldat)THEN forget(fehldat,quiet)FI ;
+editiere(namen,"ae",FALSE );store(TRUE )END PROC baumausdateizeigen;PROC
+systembaumreorganisieren:FILE VAR f:=sequentialfile(output,dummy);close(f);
+dnam:=dummy;baumverarbeitung(dnam,reorg);eingangsbildschirmherstellen(1)END
+PROC systembaumreorganisieren;PROC baumausdateiuebersetzen:translate(namen,
+fehler);rename(namen,praefix+namen);IF fehlerTHEN erwartereaktionELSE
+eingangsbildschirmherstellen(2)FI END PROC baumausdateiuebersetzen;PROC
+baumaendern:baumbearbeiten(1)END PROC baumaendern;PROC baumloeschen:
+baumbearbeiten(2)END PROC baumloeschen;PROC baumbearbeiten(INT CONST wie):
+TEXT VAR t:="";meldesuche;dnam:=subtext(namen,1,maxnamenlaenge);t:=
+bearbeitung(namen,wie);IF (t="")CAND teilbaumzahl=1THEN meldemisserfolg;
+return(1)ELSE loeschemeldung(aktuellemaske);IF loeschenundkeinfehlerTHEN
+eingangsbildschirmherstellen(1);meldeloeschungELSE internenbaumzeigenFI FI .
+meldesuche:melde(aktuellemaske,24).meldemisserfolg:melde(aktuellemaske,25).
+meldeloeschung:melde(aktuellemaske,51).loeschenundkeinfehler:(wie=2)AND (t<>
+"").END PROC baumbearbeiten;PROC internenbaumzeigen:IF exists(fehldat)THEN
+forget(fehldat,quiet)FI ;store(FALSE );page;editiere(dnam,"a",FALSE );store(
+TRUE )END PROC internenbaumzeigen;PROC internenbaumuebersetzen:store(FALSE );
+translate(dnam,fehler);store(TRUE );IF fehlerTHEN erwartereaktionELSE
+eingangsbildschirmherstellen(2)FI END PROC internenbaumuebersetzen;PROC
+listederteilbaeume:meldezusammenstellung;transactionlistederteilbaeume;
+zeigenderteilbaumliste.meldezusammenstellung:melde(aktuellemaske,7).END PROC
+listederteilbaeume;PROC listederteilbaumdateien:melde(aktuellemaske,7);FILE
+VAR f;f:=sequentialfile(output,z);line(f);beginlist;TEXT VAR s:="",t:=" ";
+REP getlistentry(s,t);IF istree(s)THEN put(f,t);put(f,s);line(f)FI UNTIL t=""
+PER ;close(f);sort(z);zeigenderteilbaumliste.END PROC listederteilbaumdateien
+;BOOL PROC istree(TEXT VAR t):INT VAR i;i:=pos(t,praefix);IF i>0THEN t:=3*" "
++subtext(t,i+2,length(t))FI ;i>0END PROC istree;PROC zeigenderteilbaumliste:
+page;editiere(z)END PROC zeigenderteilbaumliste;PROC erwartereaktion:store(
+FALSE );page;store(TRUE );IF fehlerTHEN editiere(fehldat,"a")FI ;END PROC
+erwartereaktion;PROC transactionlistederteilbaeume:f:=sequentialfile(output,z
+);TEXT VAR dateiname:=z;baumverarbeitung(dateiname,1)END PROC
+transactionlistederteilbaeume;PROC translate(TEXT CONST t,BOOL VAR b):TEXT
+VAR dateiname:=t;baumverarbeitung(dateiname,2);b:=(dateiname<>t)END PROC
+translate;TEXT PROC bearbeitung(TEXT CONST t,INT CONST wie):f:=sequentialfile
+(output,dnam);putline(f,t);TEXT VAR dateiname:=dnam;INT VAR methode:=2+wie;
+IF teilbaumzahl>1THEN methodeINCR 2FI ;baumverarbeitung(dateiname,methode);
+dateinameEND PROC bearbeitung;PROC eingangsbildschirmherstellen(INT CONST i):
+reorganizescreen;return(i);IF exists(dnam)THEN forget(dnam,quiet)FI ;
+standardkopfmaskeaktualisierenEND PROC eingangsbildschirmherstellen;TEXT
+PROC eingegebenenamen:IF prog=baumdateiTHEN teilbaumzahl:=1;feld(
+standardanfang)ELSE teilbaumzahl:=0;INT VAR i;TEXT VAR t:="";FOR iFROM
+standardanfangUPTO maxfelderREP IF feld(i)<>""THEN teilbaumzahlINCR 1;IF t<>
+""THEN tCAT trennerFI ;tCAT feld(i)FI PER ;tFI END PROC eingegebenenamen;
+PROC init(ROW 100TEXT VAR feld):INT VAR i;FOR iFROM 1UPTO 100REP feld(i):=""
+PER END PROC init;END PACKET systembaumeditor;
+
diff --git a/app/baisy/2.2.1-schulis/src/isp.zusatz archive packet b/app/baisy/2.2.1-schulis/src/isp.zusatz archive packet
new file mode 100644
index 0000000..0e8b352
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.zusatz archive packet
@@ -0,0 +1,13 @@
+PACKET zusatzarchivepacketDEFINES yes,out,show,ordertask:LET yescode=10,
+outcode=11,showcode=12;TASK VAR ordert:=niltask;BOUND BOOL VAR boolds;BOUND
+TEXT VAR textds;#BOUND FILE VAR fileds;#DATASPACE VAR ds;INT VAR replycode;
+PROC ordertask(TASK CONST ot):ordert:=otENDPROC ordertask;TASK PROC ordertask
+:ordertENDPROC ordertask;BOOL PROC yes(TEXT CONST quest):BOOL VAR b;initds;
+textds:=ds;textds:=quest;call(ordertask,yescode,ds,replycode);IF replycode=
+yescodeTHEN ordentlichesendungELSE FALSE FI .ordentlichesendung:boolds:=ds;b
+:=CONCR (boolds);forget(ds);b.ENDPROC yes;PROC out(TEXT CONST txt):initds;
+textds:=ds;textds:=txt;send(ordertask,outcode,ds,replycode)ENDPROC out;PROC
+show(TEXT CONST t):forget(ds);ds:=old(t);send(ordertask,showcode,ds,replycode
+)ENDPROC show;PROC initds:forget(ds);ds:=nilspaceENDPROC initds;ENDPACKET
+zusatzarchivepacket;
+
diff --git a/app/baisy/2.2.1-schulis/src/konvert b/app/baisy/2.2.1-schulis/src/konvert
new file mode 100644
index 0000000..098e253
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/konvert
@@ -0,0 +1,18 @@
+PACKET konvertDEFINES highbyte,lowbyte,word,changelowbyte,changehighbyte,dint
+,highword,lowword:INT PROC highbyte(INT CONST value):TEXT VAR x:=" ";replace
+(x,1,value);code(xSUB 2)END PROC highbyte;INT PROC lowbyte(INT CONST value):
+TEXT VAR x:=" ";replace(x,1,value);code(xSUB 1)END PROC lowbyte;INT PROC
+word(INT CONST lowbyte,highbyte):TEXT CONST x:=code(lowbyte)+code(highbyte);x
+ISUB 1END PROC word;PROC changelowbyte(INT VAR word,INT CONST lowbyte):TEXT
+VAR x:=" ";replace(x,1,word);replace(x,1,code(lowbyte));word:=xISUB 1END
+PROC changelowbyte;PROC changehighbyte(INT VAR word,INT CONST highbyte):TEXT
+VAR x:=" ";replace(x,1,word);replace(x,2,code(highbyte));word:=xISUB 1END
+PROC changehighbyte;REAL PROC dint(INT CONST lowword,highword):reallowword+
+65536.0*realhighword.reallowword:real(lowbyte(lowword))+256.0*real(highbyte(
+lowword)).realhighword:real(lowbyte(highword))+256.0*real(highbyte(highword))
+.END PROC dint;INT PROC highword(REAL CONST doubleprecissionint):int(
+doubleprecissionint/65536.0)END PROC highword;INT PROC lowword(REAL CONST
+doubleprecissionint):stringoflowbytesISUB 1.stringoflowbytes:code(int(
+doubleprecissionintMOD 256.0))+code(int((doubleprecissionintMOD 65536.0)/
+256.0)).END PROC lowword;END PACKET konvert;
+
diff --git a/app/baisy/2.2.1-schulis/src/log.eintrag b/app/baisy/2.2.1-schulis/src/log.eintrag
new file mode 100644
index 0000000..27dfea2
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/log.eintrag
@@ -0,0 +1,14 @@
+PACKET logeintragDEFINES logeintrag:LET eintragtextorder=201,nak=1,
+logmanagername="LOG";INT VAR reply;BOUND TEXT VAR msg;PROC logeintrag(TEXT
+CONST messagetext):INT VAR dummy;logeintrag(messagetext,dummy)END PROC
+logeintrag;PROC logeintrag(TEXT CONST messagetext,INT VAR returncode):
+DATASPACE VAR ds:=nilspace;msg:=ds;CONCR (msg):=messagetext;logauftrag(
+eintragtextorder,ds,returncode);forget(ds).END PROC logeintrag;PROC
+logauftrag(INT CONST opcode,DATASPACE VAR ds,INT VAR returncode):
+verschickeauftrag;bearbeiteggfantwort.verschickeauftrag:
+verschickeauftrageinmal;verschickeauftragggfnochmal.verschickeauftrageinmal:
+call(/logmanagername,opcode,ds,reply).verschickeauftragggfnochmal:WHILE
+auftragnichtangenommenREPEAT pause(10);verschickeauftrageinmalEND REPEAT .
+auftragnichtangenommen:reply=nak.bearbeiteggfantwort:returncode:=reply.END
+PROC logauftrag;END PACKET logeintrag
+
diff --git a/app/baisy/2.2.1-schulis/src/log.manager b/app/baisy/2.2.1-schulis/src/log.manager
new file mode 100644
index 0000000..d49e048
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/log.manager
@@ -0,0 +1,126 @@
+PACKET logmanagerDEFINES logmanager:LET zeilenwahl=10000,spaltenwahl=70;LET
+maxzeilenprologdatei=4000;INT CONST logdateien:=max(2,zeilenwahlDIV
+maxzeilenprologdatei+sign(zeilenwahlMOD maxzeilenprologdatei)),
+zeilenprologdatei:=zeilenwahlDIV logdateien,logzeilen:=zeilenprologdatei*
+logdateien,logspalten:=spaltenwahl,kritischelogzeilenanzahl:=(logzeilenDIV 5)
+*4;LET eintragfileorder=200,eintragtextorder=201,readloglimitsorder=202,
+logholenorder=301,gesichertvermerk=306,loeschenorder=307,ack=0,logack=7,
+letzteslogack=8,kritischegrenzeerreichtack=9,dateiexistiertnichtack=10,
+dateinichtgesichertack=11,meldungloggeloescht=" gelöscht",
+seitenwechselanweisung="",niltext="",zeilenproseite=60,nureinzeiligereintrag=
+1,maxlogdateien=8,vaterallerprivtasks="anwendung",logmanagername="LOG",
+lognamepre="logbuch.",lognamedatumzeittrenner="/",vonbistrenner="-",taskpre=
+", Task: ",terminalname=" Term.";BOUND TEXT VAR msg;FILE VAR logfile;
+DATASPACE VAR ds;INT CONST laengeseitenwechselanweisung:=LENGTH
+seitenwechselanweisung;INT VAR seitenzeile,zeiger,ersteslog,letzteslog,
+benutztelogzeilen;TEXT VAR eintragssatz;INT VAR terminalnr;BOOL VAR
+datumneuinlogschreiben:=TRUE ;LET LLIMITS =STRUCT (INT zeilen,zeilenbenutzt,
+zeilenkritisch),LDATEN =STRUCT (REAL von,bis,BOOL gesichert,INT zeilen),
+LOGBUCH =STRUCT (LDATEN daten,DATASPACE inhalt);ROW maxlogdateienLOGBUCH VAR
+log;BOUND LLIMITS VAR loggrenzenmsg;PROC logmanager:enablestop;IF name(myself
+)<>logmanagernameTHEN renamemyself(logmanagername)END IF ;taskpassword("-");
+benutztelogzeilen:=0;initpacket;globalmanager(PROC (DATASPACE VAR ,INT CONST
+,INT CONST ,TASK CONST )logmanagerfaenger).END PROC logmanager;PROC
+logmanagerfaenger(DATASPACE VAR ds,INT CONST order,phase,TASK CONST ordertask
+):disablestop;logmanager(ds,order,phase,ordertask);trageggffehlermeldungein;
+enablestop.trageggffehlermeldungein:IF iserrorTHEN logeintrag(fehlermeldung)
+END IF .fehlermeldung:"Fehler: "+errormessage+" in Zeile "+text(errorline).
+END PROC logmanagerfaenger;PROC logmanager(DATASPACE VAR ds,INT CONST order,
+phase,TASK CONST ordertask):enablestop;IF order=eintragfileorderTHEN
+nimmdateieintragvorELIF order=eintragtextorderTHEN nimmtexteintragvorELSE IF
+istberechtigt(ordertask)THEN SELECT orderOF CASE readloglimitsorder:
+leseloggrenzenCASE logholenorder:logverschicken(ordertask)CASE
+gesichertvermerk:vermerkesicherungCASE loeschenorder:loeschelogOTHERWISE
+logeintrag(ordertask,"Falscher Auftrag für Task ""LOG"" von Task: "+name(
+ordertask))END SELECT ELSE logeintrag(ordertask,
+"Unberechtigter Logbuchzugriff von Task: "+name(ordertask))FI FI .
+nimmdateieintragvor:FILE VAR eintrag:=sequentialfile(input,ds);logeintrag(
+eintrag,ordertask);meldeeintrag.meldeeintrag:IF logbuchgroessekritischTHEN
+send(ordertask,kritischegrenzeerreichtack,ds)ELSE send(ordertask,ack,ds)END
+IF .logbuchgroessekritisch:benutztelogzeilen>=kritischelogzeilenanzahl.
+nimmtexteintragvor:msg:=ds;logeintrag(ordertask,CONCR (msg));meldeeintrag.
+vermerkesicherung:msg:=ds;zeiger:=ersteslog;WHILE logname(log[zeiger])<>
+CONCR (msg)AND zeiger<>letzteslogREP zeiger:=next(zeiger)PER ;IF logname(log[
+zeiger])<>CONCR (msg)THEN send(ordertask,dateiexistiertnichtack,ds)ELSE log[
+zeiger].daten.gesichert:=TRUE ;send(ordertask,ack,ds)FI .loeschelog:msg:=ds;
+zeiger:=ersteslog;WHILE logname(log[zeiger])<>CONCR (msg)AND zeiger<>
+letzteslogREP zeiger:=next(zeiger)PER ;IF logname(log[zeiger])<>CONCR (msg)
+THEN send(ordertask,dateiexistiertnichtack,ds)ELIF NOT log[zeiger].daten.
+gesichertTHEN send(ordertask,dateinichtgesichertack,ds)ELSE TEXT CONST
+eintragstext:=logname(log[zeiger])+meldungloggeloescht;logbuchdateiloeschen(
+zeiger);logeintrag(ordertask,eintragstext);send(ordertask,ack,ds)FI .
+leseloggrenzen:forget(ds);ds:=nilspace;loggrenzenmsg:=ds;loggrenzenmsg.zeilen
+:=logzeilen;loggrenzenmsg.zeilenbenutzt:=benutztelogzeilen;loggrenzenmsg.
+zeilenkritisch:=kritischelogzeilenanzahl;send(ordertask,ack,ds).END PROC
+logmanager;PROC logeintrag(FILE VAR eintrag,TASK CONST ordertask):
+bereiteeintragvor;schreibeeintrag.bereiteeintragvor:logeintragvorbereiten(
+ordertask,lines(eintrag));logeintragsimple(taskpre+name(ordertask),TRUE ).
+schreibeeintrag:WHILE nocheintragssaetzeREPEAT schreibeeintragssatzEND
+REPEAT .nocheintragssaetze:NOT eof(eintrag).schreibeeintragssatz:getline(
+eintrag,eintragssatz);logeintragsimple(eintragssatz,FALSE ).END PROC
+logeintrag;PROC seitenwechsel:seitenzeile:=0;putline(logfile,
+seitenwechselanweisung).END PROC seitenwechsel;PROC zeilenwechsel:seitenzeile
+INCR 1;line(logfile).END PROC zeilenwechsel;PROC logeintragvorbereiten(TASK
+CONST task,INT CONST eintrzeilen):terminalnr:=channel(task);
+wechseledateiseiteoderzeile;IF date(logb.daten.bis)<>dateOR
+datumneuinlogschreibenTHEN datumneuinlogschreiben:=FALSE ;zeilenwechsel;
+logeintragsimple(kennungen,FALSE )FI .wechseledateiseiteoderzeile:INT CONST
+zeilen:=eintrzeilen+evtldatumszeile;IF dateiwechselerforderlichTHEN
+wechseledateiELIF seitenwechselerforderlichTHEN bereiteseitenwechselvorEND
+IF .dateiwechselerforderlich:zeilen+lines(logfile)>zeilenprologdatei.
+evtldatumszeile:IF date(logb.daten.bis)<>dateOR datumneuinlogschreibenTHEN 1
+ELSE 0FI .wechseledatei:logdateiwechsel.seitenwechselerforderlich:INT CONST
+restzeilen:=zeilenproseite-seitenzeile;(zeilen>restzeilenCAND restzeilen<=5).
+bereiteseitenwechselvor:seitenwechsel.kennungen:date.END PROC
+logeintragvorbereiten;PROC logeintragsimple(TEXT CONST eintragssatz,BOOL
+CONST mitkennung):wechseleggfseiteoderzeile;nimmeintragvor;
+bringelogdatenaufneuestenstand.wechseleggfseiteoderzeile:IF seitenzeile=
+zeilenproseiteTHEN seitenwechselELIF seitenzeile>0THEN zeilenwechselELSE
+seitenzeile:=1END IF .nimmeintragvor:put(logfile,subtext(ggfkennung+
+eintragssatz,1,logspalten)).ggfkennung:IF mitkennungTHEN timeofday+
+terminalname+text(terminalnr)+" "ELSE niltextEND IF .
+bringelogdatenaufneuestenstand:logb.daten.gesichert:=FALSE ;logb.daten.bis:=
+clock(1);logb.daten.zeilenINCR 1;benutztelogzeilenINCR 1.END PROC
+logeintragsimple;PROC logeintrag(TEXT CONST zeile):logeintrag(myself,zeile).
+END PROC logeintrag;PROC logeintrag(TASK CONST task,TEXT CONST zeile):
+logeintragvorbereiten(task,nureinzeiligereintrag);logeintragsimple(zeile,
+TRUE ).END PROC logeintrag;PROC initpacket:initlogs;initlogdaten.initlogs:
+FOR zeigerFROM 1UPTO maxlogdateienREPEAT loesche(log[zeiger])END REPEAT .
+initlogdaten:ersteslog:=1;letzteslog:=1;logfileoeffnen;logeintrag(
+"Logbuch gestartet").END PROC initpacket;BOOL PROC istberechtigt(TASK CONST
+ordertask):ordertask</vaterallerprivtasksEND PROC istberechtigt;PROC
+logverschicken(TASK CONST ordertask):FILE VAR f;INT VAR reply:=0;
+verschickeersteslog;verschickealleweiterenlogs.verschickeersteslog:zeiger:=
+ersteslog;forget(ds);ds:=log[zeiger].inhalt;f:=sequentialfile(modify,ds);
+headline(f,logname(log[zeiger]));send(ordertask,letztesds,ds).
+verschickealleweiterenlogs:IF zeiger<>letzteslogTHEN REP zeiger:=next(zeiger)
+;forget(ds);ds:=log[zeiger].inhalt;f:=sequentialfile(modify,ds);headline(f,
+logname(log[zeiger]));call(ordertask,letztesds,ds,reply)UNTIL zeiger=
+letzteslogPER FI .letztesds:IF zeiger=letzteslogTHEN letzteslogackELSE logack
+END IF .END PROC logverschicken;PROC logbuchdateiloeschen(INT CONST zeiger):
+INT VAR vorgänger,nachfolger;benutztelogzeilenDECR log[zeiger].daten.zeilen;
+IF zeiger=letzteslogTHEN loesche(log[zeiger]);datumneuinlogschreiben:=TRUE ;
+logfileoeffnenELIF zeiger=ersteslogTHEN loesche(log[zeiger]);ersteslog:=next(
+ersteslog)ELSE vorgänger:=zeiger;REP nachfolger:=vorgänger;vorgänger:=prev(
+nachfolger);forget(log[nachfolger].inhalt);log[nachfolger]:=log[vorgänger];
+UNTIL vorgänger=ersteslogPER ;ersteslog:=nachfolger;forget(log[vorgänger].
+inhalt);log[vorgänger].inhalt:=nilspace;log[vorgänger].daten.von:=clock(1);
+log[vorgänger].daten.bis:=clock(1);log[vorgänger].daten.gesichert:=FALSE ;log
+[vorgänger].daten.zeilen:=0FI END PROC logbuchdateiloeschen;PROC loesche(
+LOGBUCH VAR log):forget(log.inhalt);log.inhalt:=nilspace;log.daten.von:=clock
+(1);log.daten.bis:=clock(1);log.daten.gesichert:=FALSE ;log.daten.zeilen:=0.
+END PROC loesche;PROC logdateiwechsel:vervollstaendigealteslog;starteneueslog
+;datumneuinlogschreiben:=TRUE .vervollstaendigealteslog:logb.daten.zeilen:=
+lines(logfile).starteneueslog:letzteslog:=next(letzteslog);IF letzteslog=
+ersteslogTHEN ersteslog:=next(ersteslog);benutztelogzeilenDECR logb.daten.
+zeilenEND IF ;loesche(logb);logfileoeffnen.END PROC logdateiwechsel;PROC
+logfileoeffnen:logfile:=sequentialfile(output,logb.inhalt);maxlinelength(
+logfile,logspalten+laengeseitenwechselanweisung+1);seitenzeile:=lines(logfile
+)MOD zeilenproseite.END PROC logfileoeffnen;INT PROC next(INT CONST zeiger):
+zeigerMOD logdateien+1.END PROC next;INT PROC prev(INT CONST zeiger):IF
+zeiger=1THEN logdateienELSE zeiger-1FI END PROC prev;TEXT PROC logname(
+LOGBUCH CONST aktuelleslog):lognamepre+date(aktuelleslog.daten.von)+
+lognamedatumzeittrenner+timeofday(aktuelleslog.daten.von)+vonbistrenner+date(
+aktuelleslog.daten.bis)+lognamedatumzeittrenner+timeofday(aktuelleslog.daten.
+bis).END PROC logname;.logb:log[letzteslog].END PACKET logmanager
+
diff --git a/app/baisy/2.2.1-schulis/src/logbuch verwaltung b/app/baisy/2.2.1-schulis/src/logbuch verwaltung
new file mode 100644
index 0000000..7d6577b
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/logbuch verwaltung
@@ -0,0 +1,81 @@
+PACKET logbuchverwaltungDEFINES logbuchverwaltungstart,logbuchzeigen,
+logbuchdrucken,logbucheditordateidrucken,logbuchloeschen,
+logbuchzurueckzummenue:LET maskeeingang="ms logbuch verwaltung";LET
+fnrzeilenaktuell=2,fnrzeilenmaximal=3,fnrzeilenkritisch=4,fnrauswahl1=5,
+fnrlogname1=6,fnrauswahl2=7,fnrlogname2=8,fnrauswahl3=9,fnrlogname3=10,
+fnrauskunftsfeld=11;LET meldnrfalscheauswahl=56,meldnrfehlerbeimloeschen=74,
+meldnrlogbuchwurdegelöscht=94,meldnrnochnichtgesichert=95,
+meldnrlogbuchwirdgedruckt=96;LET logbuchpraefix="logbuch.*";LET
+zusätzlicherlaubtetasten="vr";LET laengelogname=45;INT VAR zeilenaktuell,
+zeilenmaximal,zeilenkritisch;THESAURUS VAR thes;INT VAR thesindex;LET
+maxlogdateien=3;ROW maxlogdateienTEXT VAR logname;INT VAR ilogname,
+aktletzteslog;TEXT VAR dateinamezumzeigen;INT VAR ifnr,auswahl;INT VAR
+replycode;LET ack=0,nak=1,dateinichtgesichertack=11,readloglimitsorder=202,
+logholenorder=301,gesichertvermerk=306,loeschenorder=307,logmanagername="LOG"
+;DATASPACE VAR ds;INT VAR reply;TASK VAR ordertask;BOUND TEXT VAR msgtext;
+LET letzteslogack=8;PROC logfetch:FILE VAR f;forget(ds);ds:=nilspace;auftrag(
+logholenorder,reply);f:=sequentialfile(input,ds);copy(ds,headline(f));forget(
+ds);WHILE reply<>letzteslogackREP warteauflogmanager;f:=sequentialfile(input,
+ds);copy(ds,headline(f));forget(ds);ds:=nilspace;send(ordertask,ack,ds);PER .
+warteauflogmanager:wait(ds,reply,ordertask);WHILE name(ordertask)<>
+logmanagernameREP forget(ds);wait(ds,reply,ordertask);PER .END PROC logfetch;
+PROC loggetloglimits(INT VAR anzzeilen,anzzeilenbenutzt,anzzeilenkritisch):
+LET LLIMITS =STRUCT (INT zeilen,zeilenbenutzt,zeilenkritisch);BOUND LLIMITS
+VAR loggrenzenmsg;forget(ds);ds:=nilspace;loggrenzenmsg:=ds;auftrag(
+readloglimitsorder,reply);anzzeilen:=CONCR (loggrenzenmsg).zeilen;
+anzzeilenbenutzt:=CONCR (loggrenzenmsg).zeilenbenutzt;anzzeilenkritisch:=
+CONCR (loggrenzenmsg).zeilenkritisch;forget(ds)END PROC loggetloglimits;PROC
+logsetsavedmark(TEXT CONST logbuchdateiname,INT VAR reply):forget(ds);ds:=
+nilspace;msgtext:=ds;msgtext:=logbuchdateiname;auftrag(gesichertvermerk,reply
+);forget(ds)END PROC logsetsavedmark;PROC logerasesavedlogs(TEXT CONST
+logbuchdateiname,INT VAR reply):forget(ds);ds:=nilspace;msgtext:=ds;msgtext:=
+logbuchdateiname;auftrag(loeschenorder,reply);forget(ds)END PROC
+logerasesavedlogs;PROC auftrag(INT CONST opcode,INT VAR reply):schickeauftrag
+;WHILE auftragnichtangenommenREPEAT pause(10);schickeauftragEND REPEAT .
+auftragnichtangenommen:reply=nak.schickeauftrag:call(/logmanagername,opcode,
+ds,reply).END PROC auftrag;PROC logbuchverwaltungstart:loggetloglimits(
+zeilenmaximal,zeilenaktuell,zeilenkritisch);vorhandenelogbuchdateienloeschen;
+FOR ilognameFROM 1UPTO maxlogdateienREP logname(ilogname):=""PER ;logfetch;
+thes:=allLIKE logbuchpraefix;thesindex:=0;ilogname:=0;get(thes,
+dateinamezumzeigen,thesindex);WHILE thesindex>0REP IF ilogname<maxlogdateien
+THEN ilognameINCR 1;logname(ilogname):=dateinamezumzeigen;aktletzteslog:=
+ilogname;FI ;get(thes,dateinamezumzeigen,thesindex);PER ;standardstartproc(
+maskeeingang);standardmaskenfeld(text(zeilenaktuell),fnrzeilenaktuell);
+standardmaskenfeld(text(zeilenmaximal),fnrzeilenmaximal);standardmaskenfeld(
+text(zeilenkritisch),fnrzeilenkritisch);logdateinamenaufbereitenundausgeben;
+infeld(fnrzeilenaktuell);standardfelderausgeben;infeld(fnrauskunftsfeld);
+standardnproc.logdateinamenaufbereitenundausgeben:ifnr:=fnrauswahl1;FOR
+ilognameFROM 1UPTO maxlogdateienREP IF logname(ilogname)=""THEN feldschutz(
+ifnr);standardmaskenfeld("",ifnr);standardmaskenfeld(laengelogname*" ",ifnr+1
+);ELSE feldfrei(ifnr);standardmaskenfeld("",ifnr);standardmaskenfeld(
+nameaufber(ilogname),ifnr+1)FI ;ifnrINCR 2PER .END PROC
+logbuchverwaltungstart;TEXT PROC nameaufber(INT CONST iname):TEXT VAR
+ausgabename:="Logbuch vom ";ausgabenameCAT subtext(datname,9,22);ausgabename
+CAT " bis ";ausgabenameCAT subtext(datname,24,37);ausgabename.datname:logname
+(iname)END PROC nameaufber;PROC logbuchzeigen:auswahlbestimmen;IF auswahl=0
+THEN return(1)ELSE dateinamezumzeigen:=logname(auswahl);zeigedatei(
+dateinamezumzeigen,zusätzlicherlaubtetasten)FI END PROC logbuchzeigen;PROC
+logbucheditordateidrucken:standardmeldung(meldnrlogbuchwirdgedruckt,"");print
+(dateinamezumzeigen);logsetsavedmark(dateinamezumzeigen,reply);return(1)END
+PROC logbucheditordateidrucken;PROC logbuchdrucken:auswahlbestimmen;IF
+auswahl=0THEN return(1)ELSE dateinamezumzeigen:=logname(auswahl);
+standardmeldung(meldnrlogbuchwirdgedruckt,"");print(dateinamezumzeigen);
+logsetsavedmark(dateinamezumzeigen,reply);return(1)FI END PROC logbuchdrucken
+;PROC logbuchloeschen:auswahlbestimmen;IF auswahl=0THEN return(1)ELSE
+dateinamezumzeigen:=logname(auswahl);logerasesavedlogs(dateinamezumzeigen,
+reply);IF reply=ackTHEN standardmeldung(meldnrlogbuchwurdegelöscht,"");pause(
+10);enter(1)ELIF reply=dateinichtgesichertackTHEN standardmeldung(
+meldnrnochnichtgesichert,"");return(1)ELSE standardmeldung(
+meldnrfehlerbeimloeschen,"");return(1)FI FI END PROC logbuchloeschen;PROC
+auswahlbestimmen:auswahl:=0;IF auswahl1THEN IF auswahl2OR auswahl3THEN
+fehlermeldungELSE auswahl:=1FI ELIF auswahl2THEN IF auswahl3THEN
+fehlermeldungELSE auswahl:=2FI ELIF auswahl3THEN auswahl:=3ELSE fehlermeldung
+FI .auswahl1:standardmaskenfeld(fnrauswahl1)<>"".auswahl2:standardmaskenfeld(
+fnrauswahl2)<>"".auswahl3:standardmaskenfeld(fnrauswahl3)<>"".fehlermeldung:
+standardmeldung(meldnrfalscheauswahl,"").END PROC auswahlbestimmen;PROC
+logbuchzurueckzummenue:vorhandenelogbuchdateienloeschen;enter(2)END PROC
+logbuchzurueckzummenue;PROC vorhandenelogbuchdateienloeschen:INT VAR kanal:=
+channel;commanddialogue(FALSE );break(quiet);forget(allLIKE logbuchpraefix);
+continue(kanal);commanddialogue(TRUE )END PROC
+vorhandenelogbuchdateienloeschen;END PACKET logbuchverwaltung
+
diff --git a/app/baisy/2.2.1-schulis/src/longrow b/app/baisy/2.2.1-schulis/src/longrow
new file mode 100644
index 0000000..482cb8a
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/longrow
@@ -0,0 +1,38 @@
+PACKET longrowDEFINES LONGROW ,:=,newrow,insert,replace,delete,CAT ,length,
+pos,binsearch,_:TYPE LONGROW =TEXT ;LET nil13bytes="�������������",nil4bytes=
+"����",nilbyte="�",niltext="";TEXT VAR teil2,platzhalter:="��";OP :=(LONGROW
+VAR r,LONGROW CONST s):CONCR (r):=CONCR (s)END OP :=;LONGROW PROC newrow:
+LONGROW VAR r;CONCR (r):=niltext;rEND PROC newrow;PROC insert(LONGROW VAR row
+,INT CONST wo,was):IF wo>0THEN replace(platzhalter,1,was);INT VAR trennpos:=2
+*wo-1;teil2:=subtext(CONCR (row),trennpos);CONCR (row):=subtext(CONCR (row),1
+,trennpos-1);CONCR (row)CAT platzhalter;CONCR (row)CAT teil2FI END PROC
+insert;PROC replace(LONGROW VAR row,INT CONST wo,INT CONST was):IF length(row
+)<woTHEN stretch(row,2*wo)FI ;replace(CONCR (row),wo,was)END PROC replace;
+PROC replace(LONGROW VAR row,INT CONST wo,LONGROW CONST was):INT CONST rowl:=
+length(row);INT CONST wasl:=length(was);INT CONST elementpos:=2*wo-1;INT
+CONST benoetigtelaenge:=wo+wasl-1;IF rowl<benoetigtelaengeTHEN stretch(row,
+benoetigtelaenge+benoetigtelaenge)FI ;replace(CONCR (row),elementpos,CONCR (
+was))END PROC replace;PROC delete(LONGROW VAR row,INT CONST wo):IF wo>0THEN
+INT VAR trennpos:=2*wo+1;teil2:=subtext(CONCR (row),trennpos);CONCR (row):=
+subtext(CONCR (row),1,trennpos-3);CONCR (row)CAT teil2FI END PROC delete;OP
+CAT (LONGROW VAR row,INT CONST was):replace(platzhalter,1,was);CONCR (row)
+CAT platzhalterEND OP CAT ;INT OP _(LONGROW CONST row,INT CONST i):CONCR (row
+)ISUB iEND OP _;INT PROC pos(LONGROW CONST row,INT CONST wert):INT VAR start
+:=0;replace(platzhalter,1,wert);REP start:=pos(CONCR (row),platzhalter,start+
+1)UNTIL gefundenCOR stringendePER ;(start+1)DIV 2.gefunden:((startMOD 2)=1).
+stringende:start=0.END PROC pos;INT PROC length(LONGROW CONST row):length(
+CONCR (row))DIV 2END PROC length;PROC binsearch(LONGROW CONST ordnung,TEXT
+CONST muster,BOOL PROC (TEXT CONST ,INT CONST )kleiner,INT VAR indord):
+starteindenvorgegebenengrenzen;setzeaufdiemitte;WHILE nichtgefundenREP IF
+NOT kleineralsvergleichselementTHEN untererhinterdiemitteELSE
+obereristdiemitteFI ;IF nichtgefundenTHEN setzeaufdiemitteELSE
+setzeaufunterenFI PER ;gibordnungsindex.starteindenvorgegebenengrenzen:INT
+VAR m,u:=1,o:=length(ordnung)+1.setzeaufdiemitte:m:=(u+o)DIV 2.nichtgefunden:
+o>u.untererhinterdiemitte:u:=m+1.obereristdiemitte:o:=m.setzeaufunteren:m:=u.
+kleineralsvergleichselement:kleiner(muster,vergleichselement).
+vergleichselement:(ordnung_m).gibordnungsindex:indord:=m.END PROC binsearch;
+PROC stretch(LONGROW VAR row,INT CONST laenge):WHILE LENGTH CONCR (row)<=
+laenge-13REP CONCR (row)CAT nil13bytesPER ;WHILE LENGTH CONCR (row)<=laenge-4
+REP CONCR (row)CAT nil4bytesPER ;WHILE LENGTH CONCR (row)<laengeREP CONCR (
+row)CAT nilbytePER END PROC stretch;END PACKET longrow;
+
diff --git a/app/baisy/2.2.1-schulis/src/manager-M.dos b/app/baisy/2.2.1-schulis/src/manager-M.dos
new file mode 100644
index 0000000..a47bf6c
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/manager-M.dos
@@ -0,0 +1,55 @@
+PACKET dosmanagermultiDEFINES providechannel,dosmanager:LET stdarchivechannel
+=31,ack=0,secondphaseack=5,falsecode=6,fetchcode=11,savecode=12,existscode=13
+,erasecode=14,listcode=15,allcode=17,clearcode=18,reservecode=19,freecode=20,
+checkreadcode=22,formatcode=23,logcode=78,quote="""";BOUND STRUCT (TEXT name,
+pass)VAR msg;TASK VAR ordertask;INT VAR doschannel;INT VAR fetchsavemodus;
+REAL VAR lastaccesstime:=0.0;TASK VAR diskowner:=niltask;TEXT VAR
+savefilename;PROC providechannel(INT CONST channel):doschannel:=channelEND
+PROC providechannel;IF hdversionTHEN providechannel(29)ELSE providechannel(
+stdarchivechannel)FI ;PROC dosmanager:dosmanager(doschannel)END PROC
+dosmanager;PROC dosmanager(INT CONST channel):doschannel:=channel;
+taskpassword("-");globalmanager(PROC (DATASPACE VAR ,INT CONST ,INT CONST ,
+TASK CONST )dosmanager)END PROC dosmanager;PROC dosmanager(DATASPACE VAR ds,
+INT CONST ordercode,phase,TASK CONST fromtask):enablestop;ordertask:=fromtask
+;msg:=ds;IF NOT (ordertask=diskowner)AND ordercode<>freecodeAND ordercode<>
+reservecodeTHEN errorstop("DOS nicht angemeldet")FI ;IF ordertask=diskowner
+THEN lastaccesstime:=clock(1)FI ;SELECT ordercodeOF CASE fetchcode:fetchfile
+CASE savecode:savefileCASE erasecode:erasefileCASE clearcode:cleardiskCASE
+existscode:existsfileCASE listcode:listdiskCASE allcode:deliverdirectoryCASE
+reservecode:reserveCASE freecode:freeCASE checkreadcode:checkCASE formatcode:
+formatCASE logcode:sendlogOTHERWISE errorstop(
+"unbekannter Auftrag für Task: "+name(myself))END SELECT .fetchfile:fetch(
+dosname(msg.name,readmodus),ds,fetchsavemodus);managerok(ds).check:checkfile(
+dosname(msg.name,readmodus));managermessage(expandedname(msg.name,readmodus)+
+" ohne Fehler gelesen").format:IF phase=1THEN managerquestion(
+"Diskette formatieren")ELSE formatdosdisk(int(msg.name));managerok(ds)FI .
+savefile:IF phase=1THEN savefirstphaseELSE savesecondphaseFI .savefirstphase:
+savefilename:=dosname(msg.name,writemodus);IF dosfileexists(savefilename)
+THEN managerquestion(expandedname(msg.name,writemodus)+
+" auf der MS-DOS Disk ueberschreiben")ELSE send(ordertask,secondphaseack,ds)
+FI .savesecondphase:IF dosfileexists(savefilename)THEN erasedosfile(
+savefilename)FI ;save(savefilename,ds,fetchsavemodus);forget(ds);ds:=nilspace
+;managerok(ds).cleardisk:IF phase=1THEN managerquestion("Diskette loeschen")
+ELSE cleardosdisk;managerok(ds)FI .erasefile:IF dosfileexists(dosname(msg.
+name,readmodus))THEN IF phase=1THEN managerquestion(expandedname(msg.name,
+TRUE )+" auf der MS-DOS Disk loeschen")ELSE erasedosfile(dosname(msg.name,
+readmodus));managerok(ds)FI ELSE managermessage("die Datei "+expandedname(msg
+.name,TRUE )+" gibt es nicht auf der MS-DOS Disk")FI .existsfile:IF
+dosfileexists(dosname(msg.name,readmodus))THEN managerok(ds)ELSE send(
+ordertask,falsecode,ds)FI .listdisk:doslist(ds);managerok(ds).sendlog:forget(
+ds);ds:=old("logbuch");managerok(ds).deliverdirectory:forget(ds);ds:=nilspace
+;BOUND THESAURUS VAR allnames:=ds;allnames:=alldosfiles;managerok(ds).reserve
+:IF reserveorfreepermittedTHEN continuechannel(doschannel);diskowner:=
+fromtask;fetchsavemodus:=savefetchmode(msg.name);opendosdisk(path(msg.name));
+forget("logbuch",quiet);managerok(ds)ELSE errorstop(
+"Archivlaufwerk wird von Task """+name(diskowner)+""" benutzt")FI .
+reserveorfreepermitted:fromtask=diskownerOR lastaccessmorethanfiveminutesago
+OR diskowner=niltaskOR NOT (exists(diskowner)OR station(diskowner)<>station(
+myself)).lastaccessmorethanfiveminutesago:abs(lastaccesstime-clock(1))>300.0.
+free:IF reserveorfreepermittedTHEN closedosdisk;diskowner:=niltask;break(
+quiet);managerok(ds)ELSE managermessage("DOS nicht angemeldet")FI .END PROC
+dosmanager;PROC managerok(DATASPACE VAR ds):send(ordertask,ack,ds);
+lastaccesstime:=clock(1).END PROC managerok;TEXT PROC expandedname(TEXT
+CONST name,BOOL CONST status):text(quote+dosname(name,status)+quote,14)END
+PROC expandedname;END PACKET dosmanagermulti;
+
diff --git a/app/baisy/2.2.1-schulis/src/manager-S.dos b/app/baisy/2.2.1-schulis/src/manager-S.dos
new file mode 100644
index 0000000..2bbfc16
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/manager-S.dos
@@ -0,0 +1,67 @@
+PACKET dossingleDEFINES /,dos,providedoschannel,archive,reserve,release,save,
+fetch,erase,check,exists,ALL ,SOME ,clear,list,format:LET stdarchivechannel=
+31,mainchannel=1;INT VAR doschannel:=stdarchivechannel;INT VAR fetchsavemodus
+;TYPE DOSTASK =TEXT ;DOSTASK CONST dos:="DOS";OP :=(DOSTASK VAR d,TEXT CONST
+t):CONCR (d):=tEND OP :=;DOSTASK OP /(TEXT CONST text):DOSTASK VAR d;CONCR (d
+):=text;dEND OP /;BOOL PROC isdostask(DOSTASK CONST d):CONCR (d)="DOS"END
+PROC isdostask;PROC providedoschannel(INT CONST channelno):doschannel:=
+channelnoEND PROC providedoschannel;DATASPACE VAR space:=nilspace;forget(
+space);PROC reserve(TEXT CONST string,DOSTASK CONST task):IF isdostask(task)
+THEN fetchsavemodus:=savefetchmode(string);opendosdisk(path(string))ELSE
+errorstop("die angesprochene Task existiert nicht")FI .END PROC reserve;PROC
+archive(TEXT CONST string,DOSTASK CONST task):reserve(string,task)END PROC
+archive;PROC release(DOSTASK CONST task):IF isdostask(task)THEN closedosdisk
+ELSE errorstop("die angesprochene Task existiert nicht")FI .END PROC release;
+PROC fetch(TEXT CONST name,DOSTASK CONST from):IF isdostask(from)THEN
+fetchfromdosdiskELSE errorstop("die angesprochene Task existiert nicht")FI .
+fetchfromdosdisk:IF NOT exists(name)COR overwritepermittedTHEN dofetchFI .
+overwritepermitted:say("eigene Datei """);say(name);yes(
+""" auf der Diskette ueberschreiben").dofetch:lastparam(name);disablestop;
+continue(doschannel);fetch(dosname(name,readmodus),space,fetchsavemodus);
+continue(mainchannel);IF NOT iserrorTHEN forget(name,quiet);copy(space,name)
+FI ;forget(space).END PROC fetch;PROC erase(TEXT CONST name,DOSTASK CONST
+task):IF isdostask(task)THEN doerasedosfileELSE errorstop(
+"die angesprochene Task existiert nicht")FI .doerasedosfile:IF NOT exists(
+name,/"DOS")THEN errorstop("die Datei """+name+""" gibt es nicht")ELIF yes(
+""""+dosname(name,readmodus)+""" auf Der Diskette loeschen")THEN disablestop;
+continue(doschannel);erasedosfile(dosname(name,readmodus));continue(
+mainchannel)FI .END PROC erase;PROC save(TEXT CONST name,DOSTASK CONST task):
+IF isdostask(task)THEN savetodosdiskELSE errorstop(
+"die angesprochene Task existiert nicht")FI .savetodosdisk:TEXT CONST
+savefilename:=dosname(name,writemodus);disablestop;continue(doschannel);IF
+NOT dosfileexists(savefilename)COR overwritepermittedTHEN IF dosfileexists(
+savefilename)THEN erasedosfile(savefilename)FI ;save(savefilename,old(name),
+fetchsavemodus);FI ;continue(mainchannel).overwritepermitted:continue(
+mainchannel);BOOL CONST result:=yes(""""+savefilename+
+""" auf der Diskette ueberschreiben");continue(doschannel);result.END PROC
+save;PROC check(TEXT CONST name,DOSTASK CONST from):IF isdostask(from)THEN
+disablestop;continue(doschannel);checkfile(dosname(name,readmodus));continue(
+mainchannel)ELSE errorstop("die angesprochene Task existiert nicht")FI .END
+PROC check;BOOL PROC exists(TEXT CONST name,DOSTASK CONST task):IF isdostask(
+task)THEN disablestop;continue(doschannel);BOOL VAR dummy:=dosfileexists(
+dosname(name,readmodus));continue(mainchannel);enablestop;dummyELSE errorstop
+("die angesprochene Task existiert nicht");FALSE FI .END PROC exists;PROC
+list(DOSTASK CONST from):forget(space);space:=nilspace;FILE VAR listfile:=
+sequentialfile(output,space);list(listfile,from);modify(listfile);show(
+listfile);forget(space).ENDPROC list;PROC list(FILE VAR listfile,DOSTASK
+CONST from):IF isdostask(from)THEN listdosdiskELSE errorstop(
+"die angesprochene Task existiert nicht")FI .listdosdisk:disablestop;continue
+(doschannel);doslist(space);continue(mainchannel);enablestop;output(listfile)
+;FILE VAR listsource:=sequentialfile(output,space);TEXT VAR line;WHILE NOT
+eof(listsource)REP getline(listsource,line);putline(listfile,line)PER .END
+PROC list;THESAURUS OP ALL (DOSTASK CONST task):IF isdostask(task)THEN
+disablestop;continue(doschannel);THESAURUS VAR dummy:=alldosfiles;continue(
+mainchannel);enablestop;dummyELSE errorstop(
+"die angesprochene Task existiert nicht");emptythesaurusFI .END OP ALL ;
+THESAURUS OP SOME (DOSTASK CONST task):IF isdostask(task)THEN disablestop;
+continue(doschannel);THESAURUS VAR dummy:=alldosfiles;continue(mainchannel);
+enablestop;SOME dummyELSE errorstop("die angesprochene Task existiert nicht")
+;emptythesaurusFI .END OP SOME ;PROC clear(DOSTASK CONST task):IF isdostask(
+task)THEN cleardiskELSE errorstop("die angesprochene Task existiert nicht")
+FI .cleardisk:disablestop;IF yes("Diskette loeschen")THEN continue(doschannel
+);cleardosdisk;continue(mainchannel)FI .END PROC clear;PROC format(INT CONST
+formatcode,DOSTASK CONST task):IF isdostask(task)THEN formatdiskELSE
+errorstop("die angesprochene Task existiert nicht")FI .formatdisk:disablestop
+;IF yes("Diskette formatieren")THEN continue(doschannel);formatdosdisk(
+formatcode);continue(mainchannel)FI .END PROC format;END PACKET dossingle;
+
diff --git a/app/baisy/2.2.1-schulis/src/maskenerweiterung b/app/baisy/2.2.1-schulis/src/maskenerweiterung
new file mode 100644
index 0000000..a61d7f0
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/maskenerweiterung
@@ -0,0 +1,11 @@
+#-S tand: 04.11.8714:46'1238216893388-2761274802888164125853-15453-2245822115
+#PACKET maskenerweiterungDEFINES put,get,putget:LET maxfields=200;PROC putget
+(TAG CONST ff,ROW maxfieldsTEXT VAR v,INT VAR einstieg):put(ff,v);get(ff,v,
+einstieg)END PROC putget;PROC put(TAG CONST ff,ROW maxfieldsTEXT VAR
+fieldvalues):INT VAR iFOR iFROM 1UPTO fields(ff)REP IF fieldexists(ff,i)THEN
+put(ff,fieldvalues(i),i)FI PER END PROC put;PROC get(TAG CONST ff,ROW
+maxfieldsTEXT VAR fieldvalues,INT VAR feld):INT VAR felder:=fields(ff);IF
+NOT fieldexists(ff,feld)THEN errorstop("startfeld nicht im tag")ELSE WHILE
+feld<=felderREPEAT get(ff,fieldvalues(feld),feld);executecommandcode(ff,feld)
+UNTIL leavingcode=27PER FI END PROC get;END PACKET maskenerweiterung;
+
diff --git a/app/baisy/2.2.1-schulis/src/maskenverarbeitung b/app/baisy/2.2.1-schulis/src/maskenverarbeitung
new file mode 100644
index 0000000..a640f2c
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/maskenverarbeitung
@@ -0,0 +1,125 @@
+PACKET maskenverarbeitungDEFINES INITBY ,tagexists,storetag,renametag,copytag
+,forgettag,listedermasken,startemaskenverarbeitung:LET datenraumpraefix=
+"BAISY-",datenraumbasis=2;LET maxtag=100,maxtab=20,maxinhalt=2000;LET niltext
+="",null=0;TYPE EINTRAG =STRUCT (TEXT name,INT dr,tagnr);TYPE INHALT =STRUCT
+(LONGROW ordnung,INT maxeintrag,ersterfreier,ROW maxinhaltEINTRAG eintrag);
+TYPE ZEILE =STRUCT (BOOL gueltig,TAG maske);TYPE TAGTAB =STRUCT (INT
+maxeintrag,zahldereintraege,ersterfreier,ROW maxtagZEILE zeile);BOUND INHALT
+VAR inhaltsverzeichnis;ROW maxtabBOUND TAGTAB VAR tagtable;INT VAR maxeintrag
+,ersterfreier;OP INITBY (TAG VAR maske,TEXT CONST name):BOOL VAR gefunden;
+INT VAR eintragsnr,dr,tagnr;suchen(name,eintragsnr,dr,tagnr,gefunden);IF
+gefundenTHEN maske:=tagtable(dr).zeile(tagnr).maskeELSE nil(maske)FI END OP
+INITBY ;BOOL PROC tagexists(TEXT CONST name):tagindex(name)>nullEND PROC
+tagexists;PROC storetag(TAG CONST maske,TEXT CONST name):BOOL VAR gefunden;
+INT VAR katalognr,inhaltnr,dr,tagnr;suchen(name,katalognr,dr,tagnr,gefunden);
+IF NOT gefundenTHEN neueinrichtenELSE ueberschreibenFI .neueinrichten:
+freieplaetzesuchen;einfuegen.freieplaetzesuchen:naechstenfreiensuchen(
+inhaltnr,dr,tagnr).einfuegen:intagtable;inkatalog.intagtable:tagtable(dr).
+zeile(tagnr).maske:=maske;tagtable(dr).zeile(tagnr).gueltig:=true.inkatalog:
+eintragmachen;inordnungaufnehmen.eintragmachen:EINTRAG VAR e;e.name:=name;e.
+dr:=dr;e.tagnr:=tagnr;inhaltsverzeichnis.eintrag(inhaltnr):=e.
+inordnungaufnehmen:IF katalognr=nullTHEN anhaengenELSE einkettenFI .anhaengen
+:inhaltsverzeichnis.ordnungCAT inhaltnr.einketten:insert(inhaltsverzeichnis.
+ordnung,pos(inhaltsverzeichnis.ordnung,katalognr),inhaltnr).ueberschreiben:
+tagtable(dr).zeile(tagnr).maske:=maske.END PROC storetag;PROC renametag(TEXT
+CONST alt,neu):BOOL VAR gefunden;INT VAR alterindex,neuerindex,dr,tagnr;
+alterindex:=tagindex(alt);IF alterindex<>nullTHEN umbenennenFI .umbenennen:
+suchen(neu,neuerindex,dr,tagnr,gefunden);IF NOT gefundenTHEN
+alterindexausordnung;neuerindexinordnung;nameueberschreibenFI .
+alterindexausordnung:delete(inhaltsverzeichnis.ordnung,pos(inhaltsverzeichnis
+.ordnung,alterindex)).neuerindexinordnung:suchen(neu,neuerindex,dr,tagnr,
+gefunden);insert(inhaltsverzeichnis.ordnung,pos(inhaltsverzeichnis.ordnung,
+neuerindex),alterindex).nameueberschreiben:inhaltsverzeichnis.eintrag(
+alterindex).name:=neu.END PROC renametag;PROC copytag(TEXT CONST alt,neu):
+TAG VAR maske;maskeINITBY alt;storetag(maske,neu)END PROC copytag;PROC
+forgettag(TEXT CONST name):ungueltigmachen(tagindex(name))END PROC forgettag;
+PROC begintaglist:taglistindex:=0;taglistlaenge:=length(inhaltsverzeichnis.
+ordnung)END PROC begintaglist;INT VAR taglistindex,taglistlaenge;PROC
+nexttaglistentry(TEXT VAR name):taglistindexINCR 1;name:=naechstereintrag.
+naechstereintrag:IF taglistindex>taglistlaengeTHEN niltextELSE
+inhaltsverzeichnis.eintrag(eintragindex).nameFI .eintragindex:
+inhaltsverzeichnis.ordnung_taglistindex.END PROC nexttaglistentry;PROC
+listedermasken:LET listname="Masken";listedermasken(listname);show(listname);
+forget(listname,quiet)END PROC listedermasken;PROC listedermasken(TEXT CONST
+dateiname):LONGROW VAR refinements;FILE VAR f:=sequentialfile(output,
+dateiname);refinements:=inhaltsverzeichnis.ordnung;INT VAR i;FOR iFROM 1UPTO
+length(refinements)REP put(f,inhaltsverzeichnis.eintrag(refinements_i).name);
+line(f)PER ;close(f)END PROC listedermasken;INT PROC tagindex(TEXT CONST name
+):BOOL VAR gefunden;INT VAR eintragsnr,dr,tagnr;suchen(name,eintragsnr,dr,
+tagnr,gefunden);IF gefundenTHEN eintragsnrELSE nullFI END PROC tagindex;PROC
+suchen(TEXT CONST muster,INT VAR eintragsnr,dr,tagnr,BOOL VAR gefunden):
+LONGROW CONST ordnung:=inhaltsverzeichnis.ordnung;INT CONST l:=length(ordnung
+);eintragsnr:=null;IF l=nullTHEN gefunden:=falseELSE INT VAR ordnungsindex;
+binsearch(ordnung,muster,BOOL PROC (TEXT CONST ,INT CONST )kleiner,
+ordnungsindex);IF ordnungsindex>lTHEN gefunden:=falseELSE eintragsnr:=ordnung
+_ordnungsindex;EINTRAG VAR e;e:=inhaltsverzeichnis.eintrag(eintragsnr);dr:=e.
+dr;tagnr:=e.tagnr;gefunden:=(muster=e.name)FI FI .END PROC suchen;BOOL PROC
+kleiner(TEXT CONST muster,INT CONST verzeichnispos):muster<=
+inhaltsverzeichnis.eintrag(verzeichnispos).nameEND PROC kleiner;OP :=(
+EINTRAG VAR e,EINTRAG CONST f):CONCR (e):=CONCR (f)END OP :=;PROC
+naechstenfreiensuchen(INT VAR index,dr,tagnr):
+naechstenfreienininhaltsverzeichnis(index);dr:=ersterfreier;
+naechstefreiezeile(dr,tagnr)END PROC naechstenfreiensuchen;PROC
+naechstenfreienininhaltsverzeichnis(INT VAR index):index:=inhaltsverzeichnis.
+ersterfreier;IF index>inhaltsverzeichnis.maxeintragTHEN inhaltsverzeichnis.
+maxeintrag:=inhaltsverzeichnis.ersterfreier;inhaltsverzeichnis.ersterfreier
+INCR 1ELSE INT VAR i;FOR iFROM index+1UPTO inhaltsverzeichnis.maxeintragREP
+IF NOT istgueltigTHEN inhaltsverzeichnis.ersterfreier:=i;LEAVE
+naechstenfreienininhaltsverzeichnisFI PER ;inhaltsverzeichnis.ersterfreier:=
+inhaltsverzeichnis.maxeintrag+1FI .istgueltig:inhaltsverzeichnis.eintrag(i).
+name<>niltext.END PROC naechstenfreienininhaltsverzeichnis;PROC
+naechstenfreiendatenraum:IF ersterfreier>maxeintragTHEN neuerdatenraumansende
+ELSE INT VAR i;FOR iFROM ersterfreier+1UPTO maxeintragREP IF NOT
+datenraumvollTHEN ersterfreier:=i;LEAVE naechstenfreiendatenraumFI PER ;
+ersterfreier:=maxeintrag+1;neuerdatenraumansendeFI .neuerdatenraumansende:
+datenraumneuankoppeln(ersterfreier);maxeintrag:=ersterfreier.datenraumvoll:
+tagtable(i).zahldereintraege>=maxtag.END PROC naechstenfreiendatenraum;PROC
+naechstefreiezeile(INT VAR dr,INT VAR tagnr):IF tagtable(dr).zahldereintraege
+=maxtagTHEN naechstenfreiendatenraum;dr:=ersterfreierFI ;tagnr:=tagtable(dr).
+ersterfreier;tagtable(dr).zahldereintraegeINCR 1;IF tagtable(dr).ersterfreier
+>tagtable(dr).maxeintragTHEN tagtable(dr).maxeintrag:=tagtable(dr).
+ersterfreier;tagtable(dr).ersterfreierINCR 1ELSE INT VAR i;FOR iFROM tagtable
+(dr).ersterfreier+1UPTO tagtable(dr).maxeintragREP IF NOT istgueltigTHEN
+tagtable(dr).ersterfreier:=i;LEAVE naechstefreiezeileFI PER ;tagtable(dr).
+ersterfreier:=tagtable(dr).maxeintrag+1FI .istgueltig:tagtable(dr).zeile(i).
+gueltig.END PROC naechstefreiezeile;PROC ungueltigmachen(INT CONST index):IF
+gueltigerindexTHEN tagungueltigmachen;eintragungueltigmachen;
+inordnungungueltigmachenFI .gueltigerindex:index>0.tagungueltigmachen:
+EINTRAG VAR e:=inhaltsverzeichnis.eintrag(index);ungueltigmachen(e.dr,e.tagnr
+).eintragungueltigmachen:e.name:=niltext;inhaltsverzeichnis.eintrag(index):=e
+;IF inhaltsverzeichnis.ersterfreier>indexTHEN inhaltsverzeichnis.ersterfreier
+:=indexFI .inordnungungueltigmachen:delete(inhaltsverzeichnis.ordnung,pos(
+inhaltsverzeichnis.ordnung,index)).END PROC ungueltigmachen;PROC
+ungueltigmachen(INT CONST dr,tagnr):eintragungueltigmachen;IF letztereintrag
+THEN datenraumungueltigmachenFI .eintragungueltigmachen:INT VAR eintragszahl
+:=tagtable(dr).zahldereintraege;eintragszahlDECR 1;IF NOT letztereintragTHEN
+tagtable(dr).zahldereintraege:=eintragszahl;INT VAR ef:=tagtable(dr).
+ersterfreier;IF tagnr<efTHEN tagtable(dr).ersterfreier:=tagnrFI ;tagtable(dr)
+.zeile(tagnr).gueltig:=false;nil(tagtable(dr).zeile(tagnr).maske);FI .
+letztereintrag:eintragszahl=null.datenraumungueltigmachen:TEXT CONST drname:=
+datenraumname(dr);forget(drname,quiet);IF letzterdatenraumTHEN weglassenELSE
+neuanlegenFI .letzterdatenraum:(dr=maxeintrag)CAND (dr<>1).weglassen:
+maxeintragDECR 1;ersterfreier:=min(ersterfreier,maxeintrag).neuanlegen:
+datenraumneuankoppeln(dr);ersterfreier:=min(ersterfreier,dr).END PROC
+ungueltigmachen;PROC datenraumneuankoppeln(INT CONST dr):tagtable(dr):=new(
+datenraumname(dr));tagtable(dr).zahldereintraege:=null;tagtable(dr).
+maxeintrag:=null;tagtable(dr).ersterfreier:=1END PROC datenraumneuankoppeln;
+PROC startemaskenverarbeitung:IF daTHEN nurankoppelnELSE neuerzeugenFI .da:
+TEXT CONST verwaltungsname:=datenraumpraefix+text(datenraumbasis);exists(
+verwaltungsname).neuerzeugen:inhaltsverzeichnis:=new(verwaltungsname);
+inhaltsverzeichnis.maxeintrag:=0;inhaltsverzeichnis.ersterfreier:=1;
+inhaltsverzeichnis.ordnung:=newrow;maxeintrag:=0;ersterfreier:=1;
+naechstenfreiendatenraum.nurankoppeln:verwaltungankoppeln;restankoppeln.
+verwaltungankoppeln:inhaltsverzeichnis:=old(verwaltungsname).restankoppeln:
+beginneliste;naechster;WHILE nochwelchedaREP anbinden;naechsterPER ;abschluss
+.beginneliste:beginlist;maxeintrag:=null.abschluss:ersterfreier:=null;
+naechstenfreiendatenraum.naechster:TEXT VAR name,datum;getlistentry(name,
+datum).nochwelcheda:name<>niltext.anbinden:INT VAR index:=datenraumnummer(
+name)-datenraumbasis;IF index>nullTHEN tagtable(index):=old(name);maxeintrag
+:=max(maxeintrag,index)FI .END PROC startemaskenverarbeitung;INT PROC
+datenraumnummer(TEXT CONST name):IF pos(name,datenraumpraefix)<>1THEN null
+ELSE int(name-datenraumpraefix)FI END PROC datenraumnummer;TEXT PROC
+datenraumname(INT CONST nr):datenraumpraefix+text(nr+datenraumbasis)END PROC
+datenraumname;TEXT OP -(TEXT CONST s,t):TEXT VAR kurz:=s;change(kurz,t,
+niltext);kurzEND OP -;END PACKET maskenverarbeitung;
+
diff --git a/app/baisy/2.2.1-schulis/src/name conversion.dos b/app/baisy/2.2.1-schulis/src/name conversion.dos
new file mode 100644
index 0000000..01113b9
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/name conversion.dos
@@ -0,0 +1,22 @@
+PACKET nameconversionDEFINES dosname,readmodus,writemodus:BOOL CONST
+readmodus:=TRUE ,writemodus:=NOT readmodus;LET uppercasechars=
+"ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789$#&§!()-{}`_",lowercasechars=
+"abcdefghijklmnopqrstuvwxyz";TEXT PROC dosname(TEXT CONST euname,BOOL CONST
+readwritemodus):enablestop;INT CONST pointpos:=pos(euname,".");IF
+nameextensionexistsTHEN changednamewithextensionELSE
+changednamewithoutextensionFI .nameextensionexists:pointpos>0.
+changednamewithextension:TEXT CONST namepre:=compress(subtext(euname,1,
+pointpos-1)),namepost:=compress(subtext(euname,pointpos+1));IF LENGTH namepre
+=0OR LENGTH namepre>8OR LENGTH namepost>3THEN errorFI ;IF LENGTH namepost=0
+THEN newname(namepre,readwritemodus)ELSE newname(namepre,readwritemodus)+"."+
+newname(namepost,readwritemodus)FI .changednamewithoutextension:IF LENGTH
+euname>8OR LENGTH euname<1THEN errorFI ;newname(euname,readwritemodus).error:
+errorstop("Unzulässiger Name").END PROC dosname;TEXT PROC newname(TEXT CONST
+oldname,BOOL CONST readwritemodus):TEXT VAR new:="";INT VAR count;FOR count
+FROM 1UPTO LENGTH oldnameREP convertcharPER ;new.convertchar:TEXT CONST char
+:=oldnameSUB count;IF islowercasecharTHEN newCAT (uppercasecharsSUB stringpos
+)ELIF isuppercasecharOR readwritemodusTHEN newCAT charELSE errorstop(
+"Unzulässiger Name")FI .islowercasechar:pos(lowercasechars,char)>0.
+isuppercasechar:pos(uppercasechars,char)>0.stringpos:pos(lowercasechars,char)
+.END PROC newname;END PACKET nameconversion;
+
diff --git a/app/baisy/2.2.1-schulis/src/new monitor baisy b/app/baisy/2.2.1-schulis/src/new monitor baisy
new file mode 100644
index 0000000..f446230
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/new monitor baisy
@@ -0,0 +1,4 @@
+PACKET newmonitorbaisyDEFINES monitor:PROC monitor:commanddialogue(TRUE );
+disablestop;REP oeffnedatenbank(schulisdbname);startebaisy;clearerrorEND REP
+.END PROC monitor;END PACKET newmonitorbaisy;
+
diff --git a/app/baisy/2.2.1-schulis/src/open b/app/baisy/2.2.1-schulis/src/open
new file mode 100644
index 0000000..28836c4
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/open
@@ -0,0 +1,11 @@
+PACKET openDEFINES openwork,closework,workopened,workclosed,initcheckrerun,
+checkrerun,hdversion:BOOL VAR open;INT VAR oldsession;BOOL VAR hdflag:=FALSE
+;INITFLAG VAR packet:=FALSE ;PROC openwork:open:=TRUE END PROC openwork;PROC
+closework:open:=FALSE END PROC closework;BOOL PROC workopened:IF NOT
+initialized(packet)THEN closeworkFI ;openEND PROC workopened;BOOL PROC
+workclosed:NOT workopenedEND PROC workclosed;PROC initcheckrerun:oldsession:=
+sessionEND PROC initcheckrerun;PROC checkrerun:IF session<>oldsessionTHEN
+closework;errorstop("Diskettenzugriff im RERUN")FI .END PROC checkrerun;PROC
+hdversion(BOOL CONST status):hdflag:=statusEND PROC hdversion;BOOL PROC
+hdversion:hdflagEND PROC hdversion;END PACKET open;
+
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 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;
+
diff --git a/app/baisy/2.2.1-schulis/src/save b/app/baisy/2.2.1-schulis/src/save
new file mode 100644
index 0000000..e634acd
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/save
@@ -0,0 +1,61 @@
+PACKET saveDEFINES save:LET ascii=1,asciigerman=2,transparent=3,rowtext=5,ds=
+6,atarist=10,ibm=11,ff="�",ctrlz="�",crlf="
+",rowtextmodelength=4000;TEXT
+VAR buffer;BOUND STRUCT (INT size,ROW rowtextmodelengthTEXT clusterrow)VAR
+clusterstruct;PROC save(TEXT CONST filename,DATASPACE CONST fileds,INT CONST
+mode):SELECT modeOF CASE ascii,asciigerman,atarist,ibm,transparent:
+savefilemode(fileds,filename,mode)CASE rowtext:saverowtextmode(fileds,
+filename)CASE ds:savedsmode(fileds,filename)OTHERWISE errorstop(
+"Unzulässige Betriebsart")END SELECT .END PROC save;PROC savefilemode(
+DATASPACE CONST filespace,TEXT CONST name,INT CONST codetype):enablestop;
+opensavedosfile(name);FILE VAR file:=sequentialfile(modify,filespace);buffer
+:="";INT VAR lineno;FOR linenoFROM 1UPTO lines(file)REP toline(file,lineno);
+buffercatfileline;WHILE length(buffer)>=clustersizeREP
+writenextsavedoscluster(subtext(buffer,1,clustersize));buffer:=subtext(buffer
+,clustersize+1)PER PER ;IF asciicodeTHEN bufferCAT ctrlzFI ;writerest;
+closesavedosfile;buffer:="".buffercatfileline:exec(PROC (TEXT CONST ,INT
+CONST )catadaptedline,file,codetype).asciicode:(codetype=ascii)OR (codetype=
+asciigerman).writerest:WHILE buffer<>""REP writenextsavedoscluster(subtext(
+buffer,1,clustersize));buffer:=subtext(buffer,clustersize+1)PER .END PROC
+savefilemode;PROC catadaptedline(TEXT VAR line,INT CONST codetype):IF
+codetype=transparentTHEN bufferCAT lineELSE changeescsequences;
+changeeumelprintchars;SELECT codetypeOF CASE ascii:asciichangeCASE
+asciigerman:asciigermanchangeCASE atarist:ataristchangeCASE ibm:ibmchangeEND
+SELECT ;bufferCAT line;IF (lineSUB length(line))<>ffTHEN bufferCAT crlfFI FI
+.changeescsequences:changeall(line,"#page#",ff);INT VAR p:=pos(line,"#");
+WHILE p>0REP IF isescsequenceTHEN change(line,p,p+4,codedchar)FI ;p:=pos(line
+,"#",p+1)PER .isescsequence:LET digits="0123456789";(lineSUB (p+4))="#"CAND
+pos(digits,lineSUB p+1)>0CAND pos(digits,lineSUB p+2)>0CAND pos(digits,line
+SUB p+3)>0.codedchar:code(int(subtext(line,p+1,p+3))).changeeumelprintchars:p
+:=pos(line,"k"," ",1);WHILE p>0REP replace(line,p,stdchar);p:=pos(line,"k",
+" ",p+1)PER .stdchar:"k-# "SUB (code(lineSUB p)-219).asciichange:changeall(
+line,"ß","#251#");p:=pos(line,"Ä","ü",1);WHILE p>0REP change(line,p,p,
+ersatzdarstellung(lineSUB p));p:=pos(line,"Ä","ü",p+1)PER .asciigermanchange:
+changeall(line,"[","#091#");changeall(line,"\","#092#");changeall(line,"]",
+"#093#");changeall(line,"{","#123#");changeall(line,"|","#124#");changeall(
+line,"}","#125#");changeall(line,"~","#126#");changeall(line,"ß","~");p:=pos(
+line,"Ä","ü",1);WHILE p>0REP replace(line,p,umlautinasciigerman);p:=pos(line,
+"Ä","ü",p+1)PER .umlautinasciigerman:"[\]{|}"SUB (code(lineSUB p)-213).
+ibmchange:changeall(line,"ß","�");p:=pos(line,"Ä","ü",1);WHILE p>0REP replace
+(line,p,umlautinibm);p:=pos(line,"Ä","ü",p+1)PER .ataristchange:changeall(
+line,"ß","�");p:=pos(line,"Ä","ü",1);WHILE p>0REP replace(line,p,umlautinibm)
+;p:=pos(line,"Ä","ü",p+1)PER .umlautinibm:"Ξ��ΔΥΑ"SUB (code(lineSUB p)-213).
+END PROC catadaptedline;TEXT PROC ersatzdarstellung(TEXT CONST char):TEXT
+CONST t:=text(code(charSUB 1));"#"+(3-length(t))*"0"+t+"#"END PROC
+ersatzdarstellung;PROC saverowtextmode(DATASPACE CONST space,TEXT CONST name)
+:enablestop;opensavedosfile(name);initsaverowtextmode;WHILE lineno<
+clusterstruct.sizeREP fillbuffer;writenextsavedoscluster(subtext(buffer,1,
+clustersize));rememberrestPER ;writerest;closesavedosfile;buffer:="".
+initsaverowtextmode:clusterstruct:=space;buffer:="";INT VAR lineno:=0.
+fillbuffer:WHILE lineno<clusterstruct.sizeAND NOT bufferfullREP linenoINCR 1;
+bufferCAT clusterstruct.clusterrow[lineno]PER .bufferfull:LENGTH buffer>=
+clustersize.rememberrest:buffer:=subtext(buffer,clustersize+1).writerest:
+WHILE buffer<>""REP writenextsavedoscluster(subtext(buffer,1,clustersize));
+rememberrestPER .END PROC saverowtextmode;PROC savedsmode(DATASPACE CONST
+outds,TEXT CONST name):enablestop;opensavedosfile(name);INT VAR pageno:=
+firstnondummydspage;getlastallocateddspage;WHILE pageno<=lastallocateddspage
+REP writenextsavedoscluster(outds,pageno);PER ;closesavedosfile.
+getlastallocateddspage:INT VAR lastallocateddspage:=-1,i;FOR iFROM 1UPTO
+dspages(outds)REP lastallocateddspage:=nextdspage(outds,lastallocateddspage)
+PER .END PROC savedsmode;END PACKET save;
+
diff --git a/app/baisy/2.2.1-schulis/src/schulis kommandobehandlung b/app/baisy/2.2.1-schulis/src/schulis kommandobehandlung
new file mode 100644
index 0000000..51fbcac
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/schulis kommandobehandlung
@@ -0,0 +1,19 @@
+PACKET schuliskommandobehandlungDEFINES bsstart,aktuelleskommandolesen,
+kommandoausfuehren:LET standardanfang=2,id="mb kommandobearbeitung";TEXT VAR
+name:="",fehl:="";#TEXT VAR titel:="";#BOOL VAR fehler:=FALSE ;;TAG VAR
+aktuellemaske;INT VAR aktuelleposition;PROC bsstart:
+frageentwicklernachkommando;aktuelleskommandolesen.END PROC bsstart;PROC
+frageentwicklernachkommando:page;fehl:="";standardkopfmaskeausgeben(text(
+vergleichsknoten));aktuelleposition:=standardanfang;initmaske(aktuellemaske,
+id);show(aktuellemaske).END PROC frageentwicklernachkommando;PROC
+aktuelleskommandolesen:ROW 100TEXT VAR feld;init(feld);feld(2):=name;feld(4)
+:=fehl;putget(aktuellemaske,feld,aktuelleposition);name:=feld(2);IF fehler
+THEN loeschemeldung(aktuellemaske);put(aktuellemaske,"",4)FI .END PROC
+aktuelleskommandolesen;PROC kommandoausfuehren:disablestop;melde(
+aktuellemaske,46);store(FALSE );do(name);store(TRUE );IF iserrorTHEN
+clearerror;meldefehler;ELSE fehler:=FALSE ;fehl:="";reorganizescreenFI ;
+return(1);enablestop.meldefehler:meldeauffaellig(aktuellemaske,45);fehl:=
+errormessage.END PROC kommandoausfuehren;PROC init(ROW 100TEXT VAR feld):INT
+VAR i;FOR iFROM 1UPTO 100REP feld(i):=""PER END PROC init;END PACKET
+schuliskommandobehandlung;
+
diff --git a/app/baisy/2.2.1-schulis/src/shard interface b/app/baisy/2.2.1-schulis/src/shard interface
new file mode 100644
index 0000000..20d9b76
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/shard interface
@@ -0,0 +1,20 @@
+; ';' in Spalte 1 kennzeichnet eine Kommentarzeile
+; alle Werte müssen durch Blanks getrennt werden
+;
+;heads: Anzahl der Köpfe, positiv für cylinderorientiertes Lesen
+; negativ für seitenorientiertes Lesen
+;
+;size heads tracks first sectors last sector
+;=====================================================
+320 1 40 1 8
+360 1 40 1 9
+640 -2 40 1 8
+720 -2 40 1 9
+800 2 40 1 10
+1440 -2 80 1 9
+1600 2 80 1 10
+2400 -2 80 1 15
+1232 1 77 0 15
+2464 -2 77 0 15
+; END OF FILE
+
diff --git a/app/baisy/2.2.1-schulis/src/standarddialog b/app/baisy/2.2.1-schulis/src/standarddialog
new file mode 100644
index 0000000..7e498cb
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/standarddialog
@@ -0,0 +1,34 @@
+PACKET standarddialogDEFINES standardstartproc,standardvproc,standardnproc,
+standardfelderausgeben,standardmaskenfeld,standardfeldlaenge,standardfeldname
+,standardmeldung,standardpruefe,infeld,IN ,feldschutz,feldfrei:LET maxfelder=
+200;TAG VAR maske;INT VAR einstieg;ROW maxfelderTEXT VAR feld;BOOL VAR
+feldausgeben;LET xruhepos=1,yruhepos=24;INT PROC infeld:einstiegEND PROC
+infeld;PROC standardstartproc(TEXT CONST maskenname):initmaske(maske,
+maskenname);page;initfeld;einstieg:=2;standardkopfmaskeausgeben(text(
+vergleichsknoten));feldausgeben:=FALSE ;show(maske)END PROC standardstartproc
+;PROC standardvproc(TEXT CONST maskenname):standardstartproc(maskenname);
+standardnprocEND PROC standardvproc;PROC standardnproc:IF feldausgebenTHEN
+standardfelderausgebenFI ;get(maske,feld,einstieg);loeschemeldung(maske);
+cursor(xruhepos,yruhepos)END PROC standardnproc;PROC standardfelderausgeben:
+INT VAR fnr;INT VAR maxnr:=fields(maske);FOR fnrFROM einstiegUPTO maxnrREP
+IF fieldexists(maske,fnr)THEN put(maske,feld(fnr),fnr)FI PER ;feldausgeben:=
+falseEND PROC standardfelderausgeben;PROC standardpruefe(INT CONST pruefart,
+INT CONST feldnummer,ug,og,TEXT CONST bestand,INT VAR status):pruefe(pruefart
+,maske,TEXT PROC (INT CONST )standardmaskenfeld,feldnummer,ug,og,bestand,
+status)END PROC standardpruefe;PROC feldschutz(INT CONST feldnr):protect(
+maske,feldnr,TRUE )END PROC feldschutz;PROC feldfrei(INT CONST feldnr):
+protect(maske,feldnr,FALSE )END PROC feldfrei;INT PROC standardfeldlaenge(
+INT CONST i):length(maske,i)END PROC standardfeldlaenge;INT PROC
+standardfeldname(INT CONST i):symbolicname(maske,i)END PROC standardfeldname;
+TEXT PROC standardmaskenfeld(INT CONST i):feld(i)END PROC standardmaskenfeld;
+PROC standardmaskenfeld(TEXT CONST t,INT CONST i):feld(i):=t;feldausgeben:=
+TRUE END PROC standardmaskenfeld;PROC infeld(INT CONST i):einstieg:=i;cursor(
+maske,i)END PROC infeld;OP IN (TEXT CONST t,INT CONST feldnr):put(maske,t,
+feldnr);feld(feldnr):=tEND OP IN ;PROC standardmeldung(INT CONST mnr,TEXT
+CONST ergaenzung):IF ergaenzung=""THEN meldeauffaellig(maske,mnr)ELSE melde(
+maske,mnr,ergaenzung)FI END PROC standardmeldung;PROC standardmeldung(TEXT
+CONST meldungstext,TEXT CONST ergaenzung):IF ergaenzung=""THEN
+meldeauffaellig(maske,meldungstext)ELSE melde(maske,meldungstext,ergaenzung)
+FI END PROC standardmeldung;PROC initfeld:INT VAR i;FOR iFROM 1UPTO maxfelder
+REP feld(i):=""PER END PROC initfeld;END PACKET standarddialog;
+
diff --git a/app/baisy/2.2.1-schulis/src/sybifunktionen b/app/baisy/2.2.1-schulis/src/sybifunktionen
new file mode 100644
index 0000000..ebe62ea
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/sybifunktionen
@@ -0,0 +1,71 @@
+PACKET sybifunktionenDEFINES initsybifunktionen,setzebenutzerberechtigung,
+holeberechtigungswert,setzeprogrammende,programmende,
+setzeeditorschalterzurueck,gesetztdurcheditor,setzeschalterfuermenueausgabe,
+loeschetastendruck,tastendruck,setzetastendruck,bittedasmenuezeigen,
+menuedraussen,seteingabe,vpwunsch,npwunsch,vpgewaehlt,npgewaehlt,enter,return
+,reenter,leave,setzevergleichsknoten,vergleichsknoten,knotenaufstackablegen,
+legehistorieknotenab,holehistorietext,stopbaisy,setzeverteilteanwendung,
+beendendessystembauminterpreters:TEXT VAR gedruecktetaste;BOOL VAR
+programmendeschalter:=FALSE ,editorschalter:=FALSE ,schalterfuermenueausgabe
+:=FALSE ,vornachschalter,verteilteanwendung:=FALSE ;KNOTEN VAR k;STACK VAR s;
+INT VAR zurueckknotenanz;LET schaltervorprozedur=TRUE ,schalternachprozedur=
+FALSE ;TEXT VAR benutzerberechtigung:="";LET maxmenueebenen=4;LET
+HISTORIEKNOTEN =STRUCT (TEXT knotentext,INT anwahlpos);ROW maxmenueebenen
+HISTORIEKNOTEN VAR hk;INT VAR aktebene;PROC setzeverteilteanwendung:
+verteilteanwendung:=TRUE END PROC setzeverteilteanwendung;PROC seteingabe(
+TEXT CONST t):gedruecktetaste:=t;editorschalter:=TRUE END PROC seteingabe;
+PROC setzeeditorschalterzurueck:editorschalter:=FALSE END PROC
+setzeeditorschalterzurueck;BOOL PROC gesetztdurcheditor:editorschalterEND
+PROC gesetztdurcheditor;PROC setzebenutzerberechtigung(TEXT CONST t):
+benutzerberechtigung:=tEND PROC setzebenutzerberechtigung;PROC
+holeberechtigungswert(TEXT VAR t):t:=benutzerberechtigungEND PROC
+holeberechtigungswert;PROC setzeprogrammende(BOOL CONST wahrwert):
+programmendeschalter:=wahrwertEND PROC setzeprogrammende;BOOL PROC
+programmende:programmendeschalterEND PROC programmende;PROC
+setzeschalterfuermenueausgabe(BOOL CONST sfma):schalterfuermenueausgabe:=sfma
+END PROC setzeschalterfuermenueausgabe;BOOL PROC menuedraussen:
+schalterfuermenueausgabeEND PROC menuedraussen;BOOL PROC bittedasmenuezeigen:
+schalterfuermenueausgabeEND PROC bittedasmenuezeigen;PROC loeschetastendruck:
+gedruecktetaste:=""END PROC loeschetastendruck;TEXT PROC tastendruck:
+gedruecktetasteEND PROC tastendruck;PROC setzetastendruck(TEXT CONST taste):
+gedruecktetaste:=tasteEND PROC setzetastendruck;PROC vpwunsch:vornachschalter
+:=schaltervorprozedurEND PROC vpwunsch;PROC npwunsch:vornachschalter:=
+schalternachprozedurEND PROC npwunsch;BOOL PROC vpgewaehlt:vornachschalter
+END PROC vpgewaehlt;BOOL PROC npgewaehlt:NOT vornachschalterEND PROC
+npgewaehlt;PROC return(INT CONST zurueckknotenanzahl):zurueckknotenanz:=
+zurueckknotenanzahl;INT VAR knotenstackhoehe;knotenstackhoehe:=hoehe(s);
+npwunsch;IF knotenstackhoehe<zurueckknotenanzahlTHEN holeerstenstackknoten
+ELSE holenaechstenstackknotenFI END PROC return;PROC enter(INT CONST
+zurueckknotenanzahl):zurueckknotenanz:=zurueckknotenanzahl;INT VAR
+knotenstackhoehe;knotenstackhoehe:=hoehe(s);vpwunsch;IF knotenstackhoehe<
+zurueckknotenanzahlTHEN holeerstenstackknotenELSE holenaechstenstackknotenFI
+END PROC enter;PROC reenter(INT CONST zurueckknotenanzahl):enter(
+zurueckknotenanzahl)END PROC reenter;PROC leave(INT CONST zurueckknotenanzahl
+):return(zurueckknotenanzahl)END PROC leave;PROC holeerstenstackknoten:IF
+verteilteanwendungTHEN zurueckverzweigenvorbereitenELSE
+lokalerstenstackknotenholenFI .zurueckverzweigenvorbereiten:
+programmendeschalter:=TRUE .lokalerstenstackknotenholen:REP pop(s,k)UNTIL
+leer(s)PER ;aktebene:=0.END PROC holeerstenstackknoten;PROC
+holenaechstenstackknoten:INT VAR zurueckknotenzaehler:=0;WHILE (
+zurueckknotenzaehler<zurueckknotenanz)REP pop(s,k);IF aktebene>0THEN IF text(
+k)=hk(aktebene).knotentextTHEN aktebeneDECR 1FI ;FI ;zurueckknotenzaehler
+INCR 1PER ;END PROC holenaechstenstackknoten;PROC knotenaufstackablegen(
+KNOTEN VAR stackknoten):push(s,k)END PROC knotenaufstackablegen;PROC
+setzevergleichsknoten(KNOTEN CONST vglknoten):k:=vglknotenEND PROC
+setzevergleichsknoten;KNOTEN PROC vergleichsknoten:kEND PROC vergleichsknoten
+;PROC beendendessystembauminterpreters:setzeprogrammende(TRUE );return(1)END
+PROC beendendessystembauminterpreters;PROC initsybifunktionen:
+programmendeschalter:=FALSE ;verteilteanwendung:=FALSE ;s:=leererstack;
+aktebene:=0;store(TRUE );INT VAR ind;FOR indFROM 1UPTO maxmenueebenenREP hk(
+ind).knotentext:="";hk(ind).anwahlpos:=0;PER END PROC initsybifunktionen;
+PROC legehistorieknotenab(TEXT CONST ktext,INT CONST mpkt):IF aktebene<
+maxmenueebenenTHEN aktebeneINCR 1;hk(aktebene).knotentext:=ktext;hk(aktebene)
+.anwahlpos:=mpktFI END PROC legehistorieknotenab;PROC holehistorietext(TEXT
+VAR ktext,INT VAR kpos,INT CONST nletzter):INT VAR hkzeiger;hkzeiger:=
+aktebene-nletzter+1;IF hkzeiger<1THEN ktext:=""ELSE ktext:=hk(hkzeiger).
+knotentext;kpos:=hk(hkzeiger).anwahlposFI END PROC holehistorietext;PROC
+stopbaisy:logbucheintragabmeldung;benutzerberechtigung:="";enter(1);breakEND
+PROC stopbaisy;PROC logbucheintragabmeldung:TEXT VAR eintrag:="Abmeldung """;
+eintragCAT name(myself);eintragCAT """";logeintrag(eintrag)END PROC
+logbucheintragabmeldung;END PACKET sybifunktionen
+
diff --git a/app/baisy/2.2.1-schulis/src/systembaum b/app/baisy/2.2.1-schulis/src/systembaum
new file mode 100644
index 0000000..2497398
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/systembaum
@@ -0,0 +1,299 @@
+PACKET systembaumDEFINES sohnvon,reorganisieren,gibbaumtabelle,KNOTEN ,=,
+neuerknoten,nilknoten,markierungsknoten,erster,naechster,gueltig,suche,
+existiert,read,write,inknotenmenge,ausknotenmenge,knotenloeschen,move,
+KNOTENMENGE ,:=,zahlderelemente,leereknotenmenge,knotenmengeloeschen,exporte,
+importe,system,listederteilbaeume,startesystembaum,kopieresystembaum,
+ueberschreibesystembaum,setzesystembaumzurueck:BOOL PROC sohnvon(KNOTEN
+CONST vater,sohn):pos(kmknoten,CONCR (sohn))>0.kmknoten:IF CONCR (vater)<=
+maxknTHEN systembaum.tabzeile(CONCR (vater)).knotenELSE verwaltung.tabzeile(
+CONCR (vater)-maxkn).knotenFI .ENDPROC sohnvon;LET maxkn=2190,niltext="",null
+=0,knindex=1;LET kn1=2191,kn2=2192,kn3=2193;LET systembaumname="BAISY-0",
+systembaumkopie="SBKOP",verwaltungsname="BAISY-1",verwaltungskopie="VWKOP";
+LET maxhoehe=100,bottom=1,refkz="1",erreichtkz="2";LET reorgincr=7000;TYPE
+TUPEL =STRUCT (KNOTEN kn,INT index,BOOL markiert);TYPE STACK =STRUCT (ROW
+maxhoeheTUPEL st,INT top);TYPE KNOTENMENGE =INT ;TYPE KNOTEN =INT ;TYPE
+EINTRAG =STRUCT (TEXT attribute,KNOTEN vater,LONGROW knotenmengenLONGROW
+knoten);TYPE SYSTAB =STRUCT (INT maxeintrag,ersterfreier,ROW maxknEINTRAG
+tabzeile);KNOTEN CONST nilknoten:=KNOTEN :(null);KNOTEN CONST
+markierungsknoten:=KNOTEN :(4711);BOUND SYSTAB VAR systembaum;BOUND SYSTAB
+VAR verwaltung;BOUND SYSTAB VAR reorg;KNOTENMENGE VAR exp,imp,sys;PROC
+gibbaumtabelle(TEXT CONST startknotenname,DATASPACE VAR ds):CONCR (systembaum
+.tabzeile(systembaum.ersterfreier).vater):=zeilennr(startknotenname);ds:=old(
+systembaumname)END PROC gibbaumtabelle;INT PROC zeilennr(TEXT CONST
+startknotenname):KNOTEN VAR k;IF existiert(exporte,k,startknotenname)THEN
+KNOTENMENGE VAR soehne;read(k,soehne);CONCR (erster(soehne))ELSE nullFI END
+PROC zeilennr;OP :=(KNOTEN VAR k,KNOTEN CONST l):CONCR (k):=CONCR (l)END OP
+:=;BOOL OP =(KNOTEN CONST k,KNOTEN CONST l):CONCR (k)=CONCR (l)END OP =;
+KNOTEN PROC neuerknoten(KNOTENMENGE CONST m):KNOTEN VAR k;CONCR (k):=
+neuereintrag(CONCR (m)<>CONCR (sys),true);inknotenmenge(m,k);kEND PROC
+neuerknoten;KNOTEN PROC neuerknoten(KNOTENMENGE CONST m,TEXT CONST schluessel
+):KNOTEN VAR k;IF existiert(m,k,schluessel)THEN LEAVE neuerknotenWITH kFI ;
+KNOTEN VAR l;CONCR (l):=neuereintrag(CONCR (m)<>CONCR (sys),true);write(l,
+schluessel);inknotenmenge(m,l,k);lEND PROC neuerknoten;BOOL PROC existiert(
+KNOTENMENGE CONST a,KNOTEN VAR r,TEXT CONST muster):BOOL VAR gefunden;suche(a
+,muster,r,gefunden);gefundenEND PROC existiert;PROC read(KNOTEN CONST k,
+KNOTEN VAR vater):vater:=kvater.kvater:IF CONCR (k)<=maxknTHEN systembaum.
+tabzeile(CONCR (k)).vaterELSE verwaltung.tabzeile(CONCR (k)-maxkn).vaterFI .
+END PROC read;PROC read(KNOTEN CONST k,KNOTENMENGE VAR soehne):CONCR (soehne)
+:=CONCR (k)END PROC read;PROC read(KNOTEN CONST k,TEXT VAR attribute):
+attribute:=kattribute.kattribute:IF CONCR (k)<=maxknTHEN systembaum.tabzeile(
+CONCR (k)).attributeELSE verwaltung.tabzeile(CONCR (k)-maxkn).attributeFI .
+END PROC read;PROC read(KNOTEN CONST k,EINTRAG VAR attribute):attribute:=
+keintrag.keintrag:IF CONCR (k)<=maxknTHEN systembaum.tabzeile(CONCR (k))ELSE
+verwaltung.tabzeile(CONCR (k)-maxkn)FI .END PROC read;PROC write(KNOTEN
+CONST k,KNOTEN CONST vater):kvater:=vater.kvater:IF CONCR (k)<=maxknTHEN
+systembaum.tabzeile(CONCR (k)).vaterELSE verwaltung.tabzeile(CONCR (k)-maxkn)
+.vaterFI .END PROC write;PROC write(KNOTEN CONST k,KNOTENMENGE CONST soehne):
+kknoten:=sohnknoten.kknoten:IF CONCR (k)<=maxknTHEN systembaum.tabzeile(
+CONCR (k)).knotenELSE verwaltung.tabzeile(CONCR (k)-maxkn).knotenFI .
+sohnknoten:IF CONCR (soehne)<=maxknTHEN systembaum.tabzeile(CONCR (soehne)).
+knotenELSE verwaltung.tabzeile(CONCR (soehne)-maxkn).knotenFI .END PROC write
+;PROC write(KNOTEN CONST k,TEXT CONST attribute):kattribute:=attribute.
+kattribute:IF CONCR (k)<=maxknTHEN systembaum.tabzeile(CONCR (k)).attribute
+ELSE verwaltung.tabzeile(CONCR (k)-maxkn).attributeFI .END PROC write;PROC
+write(KNOTEN CONST k,EINTRAG CONST attribute):keintrag:=attribute.keintrag:
+IF CONCR (k)<=maxknTHEN systembaum.tabzeile(CONCR (k))ELSE verwaltung.
+tabzeile(CONCR (k)-maxkn)FI .END PROC write;PROC inknotenmenge(KNOTENMENGE
+CONST km,KNOTEN CONST k):kmknotenCAT kindex;kknotenmengenCAT kmindex.kmknoten
+:IF CONCR (km)<=maxknTHEN systembaum.tabzeile(CONCR (km)).knotenELSE
+verwaltung.tabzeile(CONCR (km)-maxkn).knotenFI .kknotenmengen:IF CONCR (k)<=
+maxknTHEN systembaum.tabzeile(CONCR (k)).knotenmengenELSE verwaltung.tabzeile
+(CONCR (k)-maxkn).knotenmengenFI .kindex:CONCR (k).kmindex:CONCR (km).END
+PROC inknotenmenge;PROC inknotenmenge(KNOTENMENGE CONST km,KNOTEN CONST k,l):
+IF l=nilknotenTHEN inknotenmenge(km,k)ELSE insert(kmknoten,posl,kindex);
+kknotenmengenCAT kmindexFI .posl:pos(kmknoten,lindex).kmknoten:IF CONCR (km)
+<=maxknTHEN systembaum.tabzeile(CONCR (km)).knotenELSE verwaltung.tabzeile(
+CONCR (km)-maxkn).knotenFI .kknotenmengen:IF CONCR (k)<=maxknTHEN systembaum.
+tabzeile(CONCR (k)).knotenmengenELSE verwaltung.tabzeile(CONCR (k)-maxkn).
+knotenmengenFI .kindex:CONCR (k).lindex:CONCR (l).kmindex:CONCR (km).END
+PROC inknotenmenge;PROC ausknotenmenge(KNOTENMENGE CONST km,KNOTEN VAR k):
+KNOTEN VAR l:=k;naechster(l,km);delete(kmknoten,kindex);delete(kknotenmengen,
+kmindex);k:=l.kmknoten:IF CONCR (km)<=maxknTHEN systembaum.tabzeile(CONCR (km
+)).knotenELSE verwaltung.tabzeile(CONCR (km)-maxkn).knotenFI .kknotenmengen:
+IF CONCR (k)<=maxknTHEN systembaum.tabzeile(CONCR (k)).knotenmengenELSE
+verwaltung.tabzeile(CONCR (k)-maxkn).knotenmengenFI .kindex:pos(kmknoten,
+CONCR (k)).kmindex:pos(kknotenmengen,CONCR (km)).END PROC ausknotenmenge;
+PROC knotenloeschen(KNOTENMENGE CONST km,KNOTEN VAR k):IF
+knotenundknotenmengeexistierenTHEN ausallenmengen;sohnknotenmengeloeschen;
+ungueltigmachen(CONCR (l))FI .knotenundknotenmengeexistieren:(CONCR (km)<>0)
+CAND (CONCR (k)<>0).ausallenmengen:KNOTEN VAR nachf:=k;KNOTEN CONST l:=k;
+LONGROW VAR mengen:=kknotenmengen;INT VAR i,mindex;KNOTENMENGE VAR m;FOR i
+FROM 1UPTO length(mengen)REP mindex:=mengen_i;CONCR (m):=mindex;
+ausknotenmenge(m,k);IF mindex=CONCR (km)THEN nachf:=kFI ;k:=lPER ;k:=nachf.
+sohnknotenmengeloeschen:KNOTENMENGE VAR soehne;CONCR (soehne):=CONCR (l);
+knotenmengeloeschen(soehne).kknotenmengen:IF CONCR (k)<=maxknTHEN systembaum.
+tabzeile(CONCR (k)).knotenmengenELSE verwaltung.tabzeile(CONCR (k)-maxkn).
+knotenmengenFI .END PROC knotenloeschen;PROC move(KNOTEN CONST k,KNOTEN
+CONST l):eigenschaftenuebertragen;pointerpflegen.eigenschaftenuebertragen:
+systembaum.tabzeile(CONCR (l)).knoten:=systembaum.tabzeile(CONCR (k)).knoten;
+systembaum.tabzeile(CONCR (l)).attribute:=systembaum.tabzeile(CONCR (k)).
+attribute.pointerpflegen:soehnevonkumsetzen;vaetervonkumsetzen.
+soehnevonkumsetzen:soehneumsetzen(systembaum.tabzeile(CONCR (k)).knoten,k,l).
+vaetervonkumsetzen:vaeterumsetzen(systembaum.tabzeile(CONCR (k)).knotenmengen
+,k,l).END PROC move;PROC soehneumsetzen(LONGROW CONST soehne,KNOTEN CONST von
+,nach):INT VAR i;FOR iFROM 1UPTO length(soehne)REP INT VAR sohni:=soehne_i;
+replace(beisohni,posvon,CONCR (nach))PER .beisohni:systembaum.tabzeile(sohni)
+.knotenmengen.posvon:pos(beisohni,CONCR (von)).END PROC soehneumsetzen;PROC
+vaeterumsetzen(LONGROW CONST vaeter,KNOTEN CONST von,nach):INT VAR i,refindex
+;refindex:=CONCR (systembaum.tabzeile(CONCR (von)).vater);FOR iFROM 1UPTO
+length(vaeter)REP INT VAR vateri:=vaeter_i;vaterumsetzen(vateri,refindex,nach
+)PER END PROC vaeterumsetzen;PROC vaterumsetzen(INT CONST vaterindex,refindex
+,KNOTEN CONST nach):IF (vaterindex<>CONCR (system))CAND (vaterindex<>refindex
+)THEN KNOTENMENGE VAR vater;CONCR (vater):=vaterindex;inknotenmenge(vater,
+nach)FI END PROC vaterumsetzen;KNOTEN PROC erster(KNOTENMENGE CONST m):
+LONGROW CONST ordnung:=mknoten;ersternach(null,ordnung).mknoten:IF CONCR (m)
+<=maxknTHEN systembaum.tabzeile(CONCR (m)).knotenELSE verwaltung.tabzeile(
+CONCR (m)-maxkn).knotenFI .END PROC erster;PROC naechster(KNOTEN VAR k,
+KNOTENMENGE CONST m):LONGROW CONST ordnung:=mknoten;k:=ersternach(indexvonk,
+ordnung).indexvonk:pos(ordnung,CONCR (k)).mknoten:IF CONCR (m)<=maxknTHEN
+systembaum.tabzeile(CONCR (m)).knotenELSE verwaltung.tabzeile(CONCR (m)-maxkn
+).knotenFI .END PROC naechster;BOOL PROC gueltig(KNOTEN CONST k):CONCR (k)<>
+nullEND PROC gueltig;PROC suche(KNOTENMENGE CONST m,TEXT CONST muster,KNOTEN
+VAR k,BOOL VAR gefunden):LONGROW CONST ordnung:=mknoten;INT CONST l:=length(
+ordnung);IF l=nullTHEN gefunden:=false;k:=nilknotenELSE INT VAR ordnungsindex
+;binsearch(ordnung,muster,BOOL PROC (TEXT CONST ,INT CONST )kleiner,
+ordnungsindex);IF ordnungsindex>lTHEN gefunden:=false;k:=nilknotenELSE CONCR
+(k):=ordnung_ordnungsindex;TEXT VAR gefundenesmuster;read(k,gefundenesmuster)
+;gefunden:=(muster=gefundenesmuster)FI FI .mknoten:IF CONCR (m)<=maxknTHEN
+systembaum.tabzeile(CONCR (m)).knotenELSE verwaltung.tabzeile(CONCR (m)-maxkn
+).knotenFI .END PROC suche;OP :=(KNOTENMENGE VAR k,KNOTENMENGE CONST l):
+CONCR (k):=CONCR (l)END OP :=;INT PROC zahlderelemente(KNOTENMENGE CONST km):
+length(kmknoten).kmknoten:IF CONCR (km)<=maxknTHEN systembaum.tabzeile(CONCR
+(km)).knotenELSE verwaltung.tabzeile(CONCR (km)-maxkn).knotenFI .END PROC
+zahlderelemente;KNOTENMENGE PROC leereknotenmenge:KNOTENMENGE VAR k;CONCR (k)
+:=neuereintrag(true,false);kEND PROC leereknotenmenge;PROC
+knotenmengeloeschen(KNOTENMENGE VAR km):IF knotenmengeexistiertTHEN
+allezeigerloeschen;alsungueltigkennzeichnenFI .knotenmengeexistiert:CONCR (km
+)<>0.allezeigerloeschen:INT CONST kmind:=CONCR (km);LONGROW VAR knoten:=
+kmindknoten;INT VAR i,kindex;LONGROW VAR row;FOR iFROM 1UPTO length(knoten)
+REP kindex:=knoten_i;row:=kindexknotenmengen;delete(kindexknotenmengen,pos(
+row,kmind))PER ;.kmindknoten:IF kmind<=maxknTHEN systembaum.tabzeile(kmind).
+knotenELSE verwaltung.tabzeile(kmind-maxkn).knotenFI .kindexknotenmengen:IF
+kindex<=maxknTHEN systembaum.tabzeile(kindex).knotenmengenELSE verwaltung.
+tabzeile(kindex-maxkn).knotenmengenFI .alsungueltigkennzeichnen:IF
+nichtinknotenTHEN ungueltigmachen(kmind);ELSE kmindknoten:=newrowFI ;CONCR (
+km):=null.nichtinknoten:KNOTEN VAR vglknoten,kmknoten;CONCR (kmknoten):=kmind
+;read(kmknoten,vglknoten);CONCR (vglknoten)=knindex.END PROC
+knotenmengeloeschen;KNOTENMENGE PROC exporte:expEND PROC exporte;KNOTENMENGE
+PROC importe:impEND PROC importe;KNOTENMENGE PROC system:sysEND PROC system;
+PROC startesystembaum:IF verwaltungdaTHEN nurankoppelnELSE
+ankoppelnundpermanenteknotenmengenerzeugenFI ;systembaumbehandeln.
+verwaltungda:exists(verwaltungsname).nurankoppeln:verwaltung:=old(
+verwaltungsname);CONCR (exp):=kn1;CONCR (imp):=kn2;CONCR (sys):=kn3.
+ankoppelnundpermanenteknotenmengenerzeugen:verwaltung:=new(verwaltungsname);
+verwaltung.maxeintrag:=0;verwaltung.ersterfreier:=1;exp:=leereknotenmenge;imp
+:=leereknotenmenge;sys:=leereknotenmenge.systembaumbehandeln:IF exists(
+systembaumname)THEN systembaum:=old(systembaumname)ELSE systembaum:=new(
+systembaumname);systembaum.maxeintrag:=0;systembaum.ersterfreier:=1;FI .END
+PROC startesystembaum;PROC listederteilbaeume(TEXT CONST dateiname):LONGROW
+VAR refinements;FILE VAR f:=sequentialfile(output,dateiname);refinements:=
+verwaltung.tabzeile(CONCR (exporte)-maxkn).knoten;INT VAR i;FOR iFROM 1UPTO
+length(refinements)REP put(f,verwaltung.tabzeile((refinements_i)-maxkn).
+attribute);line(f)PER ;close(f)END PROC listederteilbaeume;PROC
+kopieresystembaum:copy(systembaumname,systembaumkopie);systembaum:=old(
+systembaumkopie);copy(verwaltungsname,verwaltungskopie);verwaltung:=old(
+verwaltungskopie)END PROC kopieresystembaum;PROC ueberschreibesystembaum:
+forget(systembaumname,quiet);rename(systembaumkopie,systembaumname);forget(
+verwaltungsname,quiet);rename(verwaltungskopie,verwaltungsname)END PROC
+ueberschreibesystembaum;PROC setzesystembaumzurueck:systembaum:=old(
+systembaumname);forget(systembaumkopie,quiet);verwaltung:=old(verwaltungsname
+);forget(verwaltungskopie,quiet)END PROC setzesystembaumzurueck;INT PROC
+neuereintrag(BOOL CONST istverwaltung,istknoten):EINTRAG VAR e;e.attribute:=
+niltext;IF istknotenTHEN CONCR (e.vater):=null;ELSE CONCR (e.vater):=knindex
+FI ;e.knotenmengen:=newrow;e.knoten:=newrow;INT VAR eintragsnr;
+naechstenfreiensuchen(istverwaltung,eintragsnr);KNOTEN VAR k;CONCR (k):=
+eintragsnr;write(k,e);eintragsnrEND PROC neuereintrag;OP :=(EINTRAG VAR e,
+EINTRAG CONST f):CONCR (e):=CONCR (f)END OP :=;PROC naechstenfreiensuchen(
+BOOL CONST istverwaltung,INT VAR eintragsnr):IF istverwaltungTHEN
+naechstenfreieninverwaltungsuchen(eintragsnr)ELSE
+naechstenfreieninsystembaumsuchen(eintragsnr)FI END PROC
+naechstenfreiensuchen;PROC naechstenfreieninsystembaumsuchen(INT VAR
+eintragsnr):eintragsnr:=systembaum.ersterfreier;IF systembaum.ersterfreier>
+systembaum.maxeintragTHEN systembaum.maxeintrag:=systembaum.ersterfreier;
+systembaum.ersterfreierINCR 1ELSE INT VAR i;FOR iFROM systembaum.ersterfreier
++1UPTO systembaum.maxeintragREP IF NOT istgueltigTHEN systembaum.ersterfreier
+:=i;LEAVE naechstenfreieninsystembaumsuchenFI PER ;systembaum.ersterfreier:=
+systembaum.maxeintrag+1FI .istgueltig:CONCR (systembaum.tabzeile(i).vater)>=
+null.END PROC naechstenfreieninsystembaumsuchen;PROC
+naechstenfreieninverwaltungsuchen(INT VAR eintragsnr):eintragsnr:=verwaltung.
+ersterfreier+maxkn;IF verwaltung.ersterfreier>verwaltung.maxeintragTHEN
+verwaltung.maxeintrag:=verwaltung.ersterfreier;verwaltung.ersterfreierINCR 1
+ELSE INT VAR i;FOR iFROM verwaltung.ersterfreier+1UPTO verwaltung.maxeintrag
+REP IF NOT istgueltigTHEN verwaltung.ersterfreier:=i;LEAVE
+naechstenfreieninverwaltungsuchenFI PER ;verwaltung.ersterfreier:=verwaltung.
+maxeintrag+1FI .istgueltig:CONCR (verwaltung.tabzeile(i).vater)>=null.END
+PROC naechstenfreieninverwaltungsuchen;KNOTEN PROC ersternach(INT CONST
+knindex,LONGROW CONST ordnung):KNOTEN VAR k:=nilknoten;INT CONST l:=length(
+ordnung);IF (l>0)CAND (knindex<l)THEN CONCR (k):=ordnung_(knindex+1)FI ;kEND
+PROC ersternach;BOOL PROC kleiner(TEXT CONST muster,INT CONST i):KNOTEN VAR k
+;TEXT VAR vglmuster;CONCR (k):=i;read(k,vglmuster);muster<=vglmusterEND PROC
+kleiner;PROC ungueltigmachen(INT CONST nr):EINTRAG VAR e;e.attribute:=niltext
+;CONCR (e.vater):=-1;e.knotenmengen:=newrow;e.knoten:=newrow;KNOTEN VAR k;
+CONCR (k):=nr;write(k,e);ersterfreier(nr)END PROC ungueltigmachen;PROC
+ersterfreier(INT CONST nr):IF nr<=maxknTHEN ersterfreier(systembaum.
+ersterfreier,nr)ELSE ersterfreier(verwaltung.ersterfreier,nr-maxkn)FI END
+PROC ersterfreier;PROC ersterfreier(INT VAR ef,INT CONST nr):IF nr<efTHEN ef
+:=nrFI END PROC ersterfreier;PROC reorganisieren:meldestartderreorganisation;
+reorganisieresystem;reorganisiereverwaltung.meldestartderreorganisation:out(
+"��");put("Der Systembaum wird reorganisiert").END PROC reorganisieren;PROC
+reorganisieresystem:vorbereitung;ausfuehrung;abschluss.ausfuehrung:
+sammlealleunbenutztenrefinements;reorganisierediese.
+sammlealleunbenutztenrefinements:LONGROW VAR refinements;refinements:=
+verwaltung.tabzeile(CONCR (exporte)-maxkn).knoten;LONGROW VAR unbenutzte:=
+newrow,startknoten:=newrow;INT VAR i;EINTRAG VAR e;FOR iFROM 1UPTO length(
+refinements)REP INT VAR knnummer:=refinements_i;INT VAR relnummer:=knnummer-
+maxkn;e:=verwaltung.tabzeile(relnummer);IF NOT ((e.vater)=markierungsknoten)
+THEN unbenutzteCAT knnummer;startknotenCAT (e.knoten_1)FI PER .
+reorganisierediese:reorganisiere(unbenutzte,startknoten).vorbereitung:
+DATASPACE VAR ds:=nilspace;reorg:=ds;reorg.maxeintrag:=0;reorg.ersterfreier:=
+1.abschluss:forget(systembaumname,quiet);copy(ds,systembaumname);forget(ds).
+END PROC reorganisieresystem;PROC reorganisiereverwaltung:vorbereitung;
+ausfuehrung;abschluss.ausfuehrung:line;put(
+"Die Verwaltungsstruktur wird reorganisiert");INT VAR i;FOR iFROM 1UPTO reorg
+.maxeintragREP IF gueltigTHEN uebertrageELSE markiereFI PER .gueltig:cout(i);
+CONCR (verwaltung.tabzeile(i).vater)>=0.uebertrage:EINTRAG VAR e;e.attribute
+:=verwaltung.tabzeile(i).attribute;e.knotenmengen:=verwaltung.tabzeile(i).
+knotenmengen;e.vater:=verwaltung.tabzeile(i).vater;e.knoten:=decr(verwaltung.
+tabzeile(i).knoten);reorg.tabzeile(i):=e.markiere:CONCR (reorg.tabzeile(i).
+vater):=-1.vorbereitung:DATASPACE VAR ds:=nilspace;reorg:=ds;reorg.maxeintrag
+:=verwaltung.maxeintrag;reorg.ersterfreier:=verwaltung.ersterfreier.abschluss
+:forget(verwaltungsname,quiet);copy(ds,verwaltungsname);forget(ds);
+startesystembaum.END PROC reorganisiereverwaltung;PROC reorganisiere(LONGROW
+CONST unbenutzte,startknoten):INT VAR i;FOR iFROM 1UPTO length(unbenutzte)
+REP reorganisiere(knoten,name)PER .knoten:KNOTEN :(startknoten_i).name:TEXT
+VAR na;read(KNOTEN :(unbenutzte_i),na);na.END PROC reorganisiere;PROC
+reorganisiere(KNOTEN CONST k,TEXT CONST teilbaumname):line;put("Teilbaum "+
+teilbaumname+" wird reorganisiert");reorganisiere(k)END PROC reorganisiere;
+PROC reorganisiere(KNOTEN CONST k):vorbereitung;erstenaufstack;REP
+stackbearbeitungUNTIL stackleerPER .stackbearbeitung:nimmoberstenvomstack;IF
+(NOT oberstermarkiert)CAND hatsoehneTHEN markiertzurueck;
+allesoehneaufdenstackELSE oberstenuebertragenFI .vorbereitung:STACK VAR s:=
+leererstack.erstenaufstack:TUPEL VAR tup;IF schonmalerreicht(k)THEN LEAVE
+reorganisiereELSE tup.kn:=k;tup.index:=naechsterindex;tup.markiert:=false;
+alserreichtkennzeichnen(k);vater.kn:=systembaum.tabzeile(CONCR (k)).vater;
+vater.index:=CONCR (vater.kn);hauptindexaendern(tup,vater);push(s,tup)FI .
+stackleer:leer(s).nimmoberstenvomstack:TUPEL VAR vater;pop(s,vater).
+oberstermarkiert:vater.markiert.markiertzurueck:vater.markiert:=true;push(s,
+vater).hatsoehne:KNOTENMENGE VAR soehne;read(vater.kn,soehne);INT VAR
+sohnzahl:=zahlderelemente(soehne);sohnzahl>0.oberstenuebertragen:uebertrage(
+vater).allesoehneaufdenstack:INT VAR i;LONGROW VAR sohnverzeichnis:=
+systembaum.tabzeile(CONCR (soehne)).knoten;tup.markiert:=false;FOR iFROM 1
+UPTO sohnzahlREP holesohn;IF NOT (schonmalerreicht(sohn))THEN
+itersohnaufstackELSE indexaendern(s,vater,sohn)FI PER .holesohn:KNOTEN VAR
+sohn;CONCR (sohn):=sohnverzeichnis_i.itersohnaufstack:tup.kn:=sohn;tup.index
+:=naechsterindex;IF isrefinement(sohn)THEN alserreichtkennzeichnen(sohn)FI ;
+hauptindexaendern(tup,vater);push(s,tup).END PROC reorganisiere;BOOL PROC
+schonmalerreicht(KNOTEN CONST k):is(k,erreichtkz)END PROC schonmalerreicht;
+BOOL PROC isrefinement(KNOTEN CONST k):is(k,refkz)END PROC isrefinement;BOOL
+PROC is(KNOTEN CONST k,TEXT CONST muster):is(attribute(k),muster)END PROC is;
+BOOL PROC is(TEXT CONST k,TEXT CONST muster):(subtext(k,1,1)=muster)END PROC
+is;PROC alserreichtkennzeichnen(KNOTEN CONST k):replace(systembaum.tabzeile(
+CONCR (k)).attribute,1,erreichtkz)END PROC alserreichtkennzeichnen;TEXT PROC
+attribute(KNOTEN CONST k):systembaum.tabzeile(CONCR (k)).attributeEND PROC
+attribute;INT PROC naechsterindex:reorg.maxeintragINCR 1;reorg.ersterfreier
+INCR 1;cout(reorg.maxeintrag);reorg.maxeintragEND PROC naechsterindex;PROC
+uebertrage(TUPEL CONST tup):EINTRAG VAR e;INT VAR knummer:=CONCR (tup.kn);e.
+attribute:=systembaum.tabzeile(knummer).attribute;e.vater:=systembaum.
+tabzeile(knummer).vater;e.knotenmengen:=decr(systembaum.tabzeile(knummer).
+knotenmengen);e.knoten:=decr(systembaum.tabzeile(knummer).knoten);IF
+schonmalerreichtTHEN replace(e.attribute,1,refkz)FI ;reorg.tabzeile(tup.index
+):=e;CONCR (systembaum.tabzeile(knummer).vater):=tup.index.schonmalerreicht:
+is(e.attribute,erreichtkz).END PROC uebertrage;PROC hauptindexaendern(TUPEL
+CONST tup,TUPEL CONST vater):INT VAR knummer:=CONCR (tup.kn);LONGROW VAR
+knotenmengen:=systembaum.tabzeile(knummer).knotenmengen;INT VAR i;FOR iFROM 1
+UPTO length(knotenmengen)REP IF verwaltungodervaterTHEN indexaendern(knummer,
+tup.index,iteknotenmenge,vater.index)FI PER .verwaltungodervater:INT VAR
+iteknotenmenge:=knotenmengen_i;(iteknotenmenge>maxkn)COR (iteknotenmenge=
+CONCR (vater.kn)).END PROC hauptindexaendern;PROC indexaendern(STACK CONST s,
+TUPEL CONST vater,KNOTEN CONST sohn):INT VAR neuersohnindex:=CONCR (
+systembaum.tabzeile(CONCR (sohn)).vater);IF nochaufstackTHEN
+sucheneuensohnindexFI ;indexaendern(CONCR (sohn),neuersohnindex,CONCR (vater.
+kn),vater.index);reorg.tabzeile(neuersohnindex).knotenmengen:=decr(systembaum
+.tabzeile(CONCR (sohn)).knotenmengen).nochaufstack:(neuersohnindex>maxkn).
+sucheneuensohnindex:search(s,CONCR (sohn),neuersohnindex);.END PROC
+indexaendern;PROC indexaendern(INT CONST alterindex,nind,knalt,kneu):INT VAR
+neuerindex:=nind+reorgincr,knneu:=kneu+reorgincr;IF knalt<=maxknTHEN
+possystemELSE errechneposition;posverwaltung;FI .possystem:INT VAR ps:=pos(
+systemknoten,alterindex);replace(systemknoten,ps,neuerindex);replace(
+systemknotenmengen,knpos,knneu).systemknoten:systembaum.tabzeile(knalt).
+knoten.systemknotenmengen:systembaum.tabzeile(alterindex).knotenmengen.knpos:
+pos(systemknotenmengen,knalt).errechneposition:INT CONST position:=knalt-
+maxkn.posverwaltung:INT VAR pv:=pos(verwaltungsknoten,alterindex);replace(
+verwaltungsknoten,pv,neuerindex).verwaltungsknoten:verwaltung.tabzeile(
+position).knoten.END PROC indexaendern;LONGROW PROC decr(LONGROW CONST l):
+LONGROW VAR row:=newrow;INT VAR i;FOR iFROM 1UPTO length(l)REP rowCAT ((l_i)
+MOD reorgincr)PER ;rowEND PROC decr;STACK PROC leererstack:STACK VAR s;s.top
+:=bottom;sEND PROC leererstack;OP :=(TUPEL VAR ziel,TUPEL CONST quelle):
+CONCR (ziel):=CONCR (quelle)END OP :=;OP :=(STACK VAR ziel,STACK CONST quelle
+):CONCR (ziel):=CONCR (quelle)END OP :=;PROC push(STACK VAR s,TUPEL CONST k):
+IF NOT (s.top=maxhoehe)THEN s.st(s.top):=k;s.topINCR 1ELSE errorstop(
+"Stacküberlauf")FI END PROC push;PROC pop(STACK VAR s,TUPEL VAR k):IF NOT (s.
+top=bottom)THEN s.topDECR 1;k:=s.st(s.top)ELSE errorstop("Stackunterlauf")FI
+END PROC pop;PROC search(STACK CONST s,INT CONST index,INT VAR neuersohnindex
+):INT VAR i:=0;REP iINCR 1;IF i>s.topTHEN errorstop("Rekursionsauflösung: "+
+text(index)+" nicht auf stack")FI UNTIL CONCR (s.st(i).kn)=indexPER ;
+neuersohnindex:=s.st(i).indexEND PROC search;INT PROC hoehe(STACK CONST s):s.
+top-1END PROC hoehe;BOOL PROC voll(STACK CONST s):s.top=maxhoeheEND PROC voll
+;BOOL PROC leer(STACK CONST s):s.top=bottomEND PROC leer;END PACKET
+systembaum;
+
diff --git a/app/baisy/2.2.1-schulis/src/systembauminterpreter b/app/baisy/2.2.1-schulis/src/systembauminterpreter
new file mode 100644
index 0000000..222cdfe
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/systembauminterpreter
@@ -0,0 +1,390 @@
+PACKET systembauminterpreterDEFINES startebaisy,starteschulis,starteanwendung
+,startbaisy:LET esctaste="�",#crtaste=" ",#obentaste="�",untentaste="
+",
+rechtstaste="�",hoptaste="�",ausrufezeichen="!",#leertaste=" ",#stufentrenner
+=".",berechttrenner="/",codefuerziffernull=48,codefuerzifferneun=57,
+titelfeldnr=2,felderanzahlbishistoriebeginn=2,historiebeginn=3,maxhknoten=4,
+felderanzahlbismenuebeginn=6,historieende=6,menuebeginn=7,maxmenuepunkte=20,
+felderpromenuepunkt=1,felderimanwahlmenue=18,fcursor=">",fcursorweg=" ",
+laengedescursors=2,offenermenuepunkt="noch nicht realisiert",menuemaskenname=
+"mb anwahlmenue",wartezeit=30,wegtext=" Ihr Weg durch das Menü:",stern="*",
+strich="-",if="Systemfehler ",zeile=" Zeile: ",fortsetzung=
+"Weiterarbeiten ist möglich. Fehlermeldung wird gedruckt!",POINTER =STRUCT (
+INT xpointer,ypointer);KNOTEN VAR k;ROW maxmenuepunkteKNOTEN VAR ktab;ROW
+maxmenuepunkteBOOL VAR menuepunktanwaehlbar;ROW maxmenuepunktePOINTER VAR
+pointer;TEXT VAR benutzerberechtigung:="";INT VAR aktfeldnr:=menuebeginn;
+TEXT VAR vpname,npname;BOOL VAR menuemaske:=FALSE ,cursorbewegungmithop:=
+FALSE ;LET zeilenzahlbildschirm=24,spaltenzahlbildschirm=79,
+rahmenzusatzzeilen=4,spaltendesmenuerands=10,maxmenuetextlaenge=60,
+tastenlaenge=4,zeichenblankstern=" *";TEXT VAR ueberschrift:="";INT VAR x1:=1
+,y1:=1,aktuellezeile,spaltendesmenuerahmens,zeilenzahldesfktmenues,
+anzblankstern,textlaenge,cursorx,cursory;KNOTEN VAR
+knotenfuerbildschirmausdruck,knotenfuerauskunftserteilung;LET
+knotennamefuerbildschirmausdruck="hardcopy",knotennamefuerauskunftserteilung=
+"auskunft",tastefuerbildschirmausdruck="o",tastefuerauskunftserteilung="?";
+PROC vpausfuehren(PROC (INT CONST ,BOOL CONST ,TEXT CONST )call):INT VAR
+prozedurindex;prozedurindex:=knotenaufrufindex(k);enablestop;call(
+prozedurindex,TRUE ,vpname)END PROC vpausfuehren;PROC npausfuehren(PROC (INT
+CONST ,BOOL CONST ,TEXT CONST )call):INT VAR prozedurindex;prozedurindex:=
+knotenaufrufindex(k);enablestop;call(prozedurindex,FALSE ,npname)END PROC
+npausfuehren;BOOL PROC vpvorhanden:NOT ((vpname)="")END PROC vpvorhanden;
+BOOL PROC npvorhanden:NOT ((npname)="")END PROC npvorhanden;PROC
+bereitemenuemaskenausgabevor:page;loeschetastendruckEND PROC
+bereitemenuemaskenausgabevor;PROC tasteholen:TEXT VAR zwischentaste;inchar(
+zwischentaste);setzetastendruck(zwischentaste)END PROC tasteholen;PROC
+gedaechtnisloeschen:TEXT VAR t:=" ";WHILE t<>""REP t:=incharetyPER END PROC
+gedaechtnisloeschen;PROC setzeschalterfuermenueausgabenachfunktionstaste:IF (
+tastendruck=ausrufezeichen)OR (tastendruck="")THEN
+setzeschalterfuermenueausgabe(TRUE )ELSE setzeschalterfuermenueausgabe(FALSE
+)FI .END PROC setzeschalterfuermenueausgabenachfunktionstaste;BOOL PROC
+anderermenuepunkt:IF nachobenoderuntenTHEN cursorbewegungmithop:=FALSE ;TRUE
+ELIF tastendruck=hoptasteTHEN tasteholen;IF nachobenoderuntenTHEN
+cursorbewegungmithop:=TRUE ;TRUE ELIF tastendruck=hoptasteTHEN
+cursorbewegungmithop:=TRUE ;setzetastendruck(obentaste);TRUE ELSE FALSE FI
+ELSE FALSE FI .nachobenoderunten:(tastendruck=obentaste)OR (tastendruck=
+untentaste).END PROC anderermenuepunkt;BOOL PROC
+knotenwechselbeiprozedurausfuehrung:NOT (k=vergleichsknoten)END PROC
+knotenwechselbeiprozedurausfuehrung;PROC menuetextzusammensetzen(INT CONST
+mpkt,TEXT CONST stufennum,TEXT VAR menuetext):TEXT VAR kts,ktx;BOOL VAR
+berechtigt:=FALSE ;IF ktab(mpkt)=nilknotenTHEN ktx:=offenermenuepunkt;
+behandlemenuepunkt(menuetext,mpkt,kts,ktx,FALSE )ELSE ktx:=text(ktab(mpkt));
+berechtigungspruefung(stufennum,mpkt,berechtigt);behandlemenuepunkt(menuetext
+,mpkt,kts,ktx,berechtigt)FI .END PROC menuetextzusammensetzen;PROC
+behandlemenuepunkt(TEXT VAR menuetextaufber,INT CONST menuepunkt,TEXT CONST
+ktaste,ktext,BOOL CONST berechtigt):IF berechtigtTHEN menuetextaufber:=""+
+text(menuepunktMOD 10,1)+" "+ktextELSE menuetextaufber:=" "+ktextFI ;
+setzemenuepunktzugang(menuepunkt+maxhknoten,berechtigt).END PROC
+behandlemenuepunkt;PROC setzemenuepunktzugang(INT CONST feldnr,BOOL CONST
+wahrwert):menuepunktanwaehlbar(feldnr):=wahrwertEND PROC
+setzemenuepunktzugang;BOOL PROC zugangerlaubt(INT CONST feldnr):
+menuepunktanwaehlbar(feldnr)END PROC zugangerlaubt;PROC fehlerbehandeln:
+cursor(1,23);TEXT VAR fehlerzeile:=if+errormessage+zeile+text(errorline);put(
+""+fehlerzeile+"�");line;put(fortsetzung+"�");clearerror;#FILE VAR f:=
+sequentialfile(output,if);line(f);putline(f,date+" "+timeofday);line(f);
+putline(f,text(vergleichsknoten));line(f);putline(f,fehlerzeile);print(if);
+forget(if,quiet)#END PROC fehlerbehandeln;PROC zeige(TEXT VAR te,INT CONST
+start1,start2,schluss):INT VAR zeile2:=start1+1;cursor(1,start1);out(te);INT
+CONST ende:=length(te),anfang:=pos(te,stern);INT CONST stellen:=ende-anfang+2
+;historiemalen;trennungslinie;restmalen.historiemalen:cursor(anfang,zeile2);
+out(stern);out(wegtext);cursor(ende,zeile2);out(stern);INT VAR i;FOR iFROM
+zeile2+1UPTO start2-2REP zeilerausPER .trennungslinie:cursor(anfang,start2-1)
+;out(stern);(stellen-3)TIMESOUT strich;out(stern).restmalen:FOR iFROM start2
+UPTO schluss-1REP zeilerausPER ;cursor(1,schluss);out(te).zeileraus:cursor(
+anfang,i);out(stern);cursor(ende,i);out(stern).END PROC zeige;PROC
+getposition(INT VAR x,y,INT CONST feldnr):POINTER CONST p:=pointer(feldnr);x
+:=p.xpointer;y:=p.ypointer;END PROC getposition;PROC putposition(TAG VAR t,
+INT CONST feldnr):POINTER VAR p;INT VAR x,y;getcursor(x,y);p.xpointer:=x-
+length(t,feldnr)-laengedescursors;p.ypointer:=y;pointer(feldnr):=pEND PROC
+putposition;PROC ermittlegrenzwertedesmenuerahmens(INT CONST sohnanz,BOOL
+CONST nichtvorhandenetaste):INT CONST mindestlaengewegenfehlermeldung:=31;
+ueberschrift:=text(k);spaltendesmenuerahmens:=maxtextlaenge+
+spaltendesmenuerands;IF geradespaltenanzahlTHEN spaltendesmenuerahmensINCR 1;
+textlaengeINCR 1FI ;bestimmezeilenzahldesfktmenues;legeeckpunktefest.
+geradespaltenanzahl:(spaltendesmenuerahmensMOD 2)=0.maxtextlaenge:INT VAR
+menuepkt;IF nichtvorhandenetasteTHEN textlaenge:=
+mindestlaengewegenfehlermeldungELSE textlaenge:=0FI ;textlaenge:=max(
+textlaenge,length(ueberschrift));FOR menuepktFROM 1UPTO sohnanzREP textlaenge
+:=max(textlaenge,length(text(ktab(menuepkt))))PER ;textlaenge:=min(textlaenge
+,maxmenuetextlaenge);textlaenge.bestimmezeilenzahldesfktmenues:IF
+nichtvorhandenetasteTHEN zeilenzahldesfktmenues:=sohnanz+rahmenzusatzzeilen+1
+ELSE zeilenzahldesfktmenues:=sohnanz+rahmenzusatzzeilenFI .legeeckpunktefest:
+bestimmepositionfuerfktmenueauscursorpos(x1,y1);
+veraenderex1fallshaelftedesbsnichtausreicht;
+veraenderey1fallshaelftedesbsnichtausreicht;aktuellezeile:=y1;anzblankstern:=
+spaltendesmenuerahmensDIV 2.veraenderex1fallshaelftedesbsnichtausreicht:IF (
+x1+spaltendesmenuerahmens)>spaltenzahlbildschirmTHEN x1:=
+spaltenzahlbildschirm-spaltendesmenuerahmensFI .
+veraenderey1fallshaelftedesbsnichtausreicht:IF (y1+zeilenzahldesfktmenues)>
+zeilenzahlbildschirmTHEN y1:=zeilenzahlbildschirm-zeilenzahldesfktmenuesFI .
+END PROC ermittlegrenzwertedesmenuerahmens;PROC
+bestimmepositionfuerfktmenueauscursorpos(INT VAR xwert,ywert):
+bestimmecursorposition;bestimmeeckpunktlinksoben.bestimmecursorposition:
+getcursor(cursorx,cursory).bestimmeeckpunktlinksoben:IF vierterquadrantTHEN
+xwert:=1;ywert:=1;ELIF dritterquadrantTHEN xwert:=40;ywert:=1;ELIF
+zweiterquadrantTHEN xwert:=1;ywert:=13;ELIF ersterquadrantTHEN xwert:=40;
+ywert:=13;FI .ersterquadrant:(cursorx<40)CAND (cursory<13).zweiterquadrant:(
+cursorx>39)CAND (cursory<13).dritterquadrant:(cursorx<40)CAND (cursory>12).
+vierterquadrant:(cursorx>39)CAND (cursory>12).END PROC
+bestimmepositionfuerfktmenueauscursorpos;PROC
+zeigefunktionenmenueaufdembildschirm(INT CONST sohnanz,BOOL VAR
+nichtvorhandenetaste):TEXT CONST meldungungueltigefkttaste:=
+"Diese Funktion gibt es nicht. ";zeigemenuekopfzeile;zeigeueberschriftzeile
+;zeigemenueteil;zeigemenueabschlusszeile.zeigemenuekopfzeile:
+setzecursoraufausgabeanfangsposition;zeichnesternzeile.
+setzecursoraufausgabeanfangsposition:cursor(x1,aktuellezeile).
+zeichnesternzeile:put("*"+(anzblankstern*zeichenblankstern)).
+zeigeueberschriftzeile:setzecursoraufnaechstenzeilenanfang;put("* "+
+zentrierteueberschrift+" *").zentrierteueberschrift:TEXT VAR zwtext:=
+zentriert(ueberschrift,textlaenge+tastenlaenge);IF length(zwtext)<(textlaenge
++tastenlaenge)THEN zwtextCAT " "FI ;zwtext.zeigemenueabschlusszeile:
+setzecursoraufnaechstenzeilenanfang;IF nichtvorhandenetasteTHEN
+gebehinweisaufungueltigefkttaste;setzeschalterzurueck;
+setzecursoraufnaechstenzeilenanfangFI ;zeichnesternzeile.
+gebehinweisaufungueltigefkttaste:put("* "+eingepasstemeldung+" *").
+eingepasstemeldung:zwtext:=zentriert(meldungungueltigefkttaste,textlaenge+
+tastenlaenge);IF length(zwtext)<(textlaenge+tastenlaenge)THEN zwtextCAT " "
+FI ;zwtext.setzeschalterzurueck:nichtvorhandenetaste:=FALSE .
+setzecursoraufnaechstenzeilenanfang:aktuellezeileINCR 1;cursor(x1,
+aktuellezeile).zeigemenueteil:zeigeleerzeile;zeigemenuezeilen;zeigeleerzeile.
+zeigeleerzeile:setzecursoraufnaechstenzeilenanfang;leerzeile.leerzeile:put(
+"*"+((spaltendesmenuerahmens-2)*" ")+"*").zeigemenuezeilen:INT VAR menuepkt:=
+0;FOR menuepktFROM 1UPTO sohnanzREP zeigemenuezeilePER .zeigemenuezeile:
+setzecursoraufnaechstenzeilenanfang;put(anfangundfkttaste+aufbereitetertext+
+zeichenblankstern).anfangundfkttaste:"* "+fkttaste+" ".fkttaste:TEXT VAR
+aufbertaste:=taste(ktab(menuepkt));IF aufbertaste<>""THEN aufbertasteELSE " "
+FI .aufbereitetertext:IF menuetextzulangTHEN subtext(text(ktab(menuepkt)),1,
+textlaenge)ELSE text(ktab(menuepkt))+restblanksFI .menuetextzulang:length(
+text(ktab(menuepkt)))>textlaenge.restblanks:(textlaenge-length(text(ktab(
+menuepkt))))*" ".END PROC zeigefunktionenmenueaufdembildschirm;TEXT PROC
+zentriert(TEXT CONST text,INT CONST breite):TEXT CONST blank:=" ";TEXT CONST
+blanks:=blankausgleich;blanks+text+blanks.blankausgleich:((breite-length(text
+))DIV 2)*blank.END PROC zentriert;PROC einzelknotenfuerfunktionenmenueholen(
+BOOL CONST verteilteanwendung):BOOL VAR ok;IF verteilteanwendungTHEN
+einzelknotenholen(tastefuerbildschirmausdruck,knotenfuerbildschirmausdruck,ok
+);einzelknotenholen(tastefuerauskunftserteilung,knotenfuerauskunftserteilung,
+ok)ELSE einzelknotenholen(knotennamefuerbildschirmausdruck,
+knotenfuerbildschirmausdruck,ok);einzelknotenholen(
+knotennamefuerauskunftserteilung,knotenfuerauskunftserteilung,ok)FI .END
+PROC einzelknotenfuerfunktionenmenueholen;PROC startbaisy(TEXT CONST kn,PROC
+(INT CONST ,BOOL CONST ,TEXT CONST )call):BOOL VAR menuepunktgefunden,
+anwahleineshistoriepunktes:=FALSE ,gueltigetasteimmenue:=FALSE ,
+anderemenueebene:=FALSE ,zurueckuebercursortaste:=FALSE ,nichtvorhandenetaste
+:=FALSE ,ebenenwechsel:=FALSE ,programmeinstiegnachmenueanwahl,#
+benutzerberechtigt:=FALSE ,#druckenkommtimfktmenuevor:=FALSE ,
+auskunftkommtimfktmenuevor:=FALSE ;TAG VAR t,men;TEXT VAR te,stufennummer:=""
+;INT VAR start1,start2,schluss,koordx;TEXT VAR anfangsknotenname;ROW
+maxhknotenTEXT VAR histtexttab;ROW maxhknotenINT VAR histanwahlpos;INT VAR
+sohnanzahl,mpkt,letztemenueanwahlpos:=menuebeginn,aktmaxmenuepunkte,x,y;
+KNOTEN VAR sk;KNOTENMENGE VAR ksoehne;initialisierenzumanfang;
+holenamedesanfangsknotens;fortlaufendeknotenbehandlung.
+fortlaufendeknotenbehandlung:REP behandleknotenPER .initialisierenzumanfang:
+IF kn<>""THEN initmaske(men,menuemaskenname);schluss:=ysize(men)FI ;ksoehne:=
+leeremenge;bildschirmwiederholspeichereinschalten.holenamedesanfangsknotens:
+anfangsknotenname:=text(k);.behandleknoten:setzevergleichsknoten(k);
+programmeinstiegnachmenueanwahl:=menuemaske;schaueobmaskediemenuemaskeist;IF
+vpgewaehltTHEN vpname:=vorprozedur(k);IF vpvorhandenTHEN clearerror;
+disablestop;vpausfuehren(PROC (INT CONST ,BOOL CONST ,TEXT CONST )call);IF
+programmendeTHEN LEAVE fortlaufendeknotenbehandlungFI ;IF iserrorTHEN
+fehlerbehandeln;clearerrorFI ;enablestop;IF
+knotenwechselbeiprozedurausfuehrungTHEN vaterknotenalsneuenknotennehmen;
+ebenenwechsel:=TRUE ;LEAVE behandleknotenFI ;holefunktionstaste;ELSE
+bereitemenuemaskenausgabevorFI ;ELSE IF npgewaehltTHEN npname:=nachprozedur(k
+);IF npvorhandenTHEN clearerror;disablestop;npausfuehren(PROC (INT CONST ,
+BOOL CONST ,TEXT CONST )call);IF programmendeTHEN LEAVE
+fortlaufendeknotenbehandlungFI ;IF iserrorTHEN fehlerbehandeln;clearerrorFI ;
+enablestop;IF knotenwechselbeiprozedurausfuehrungTHEN
+vaterknotenalsneuenknotennehmen;ebenenwechsel:=TRUE ;LEAVE behandleknotenFI ;
+holefunktionstaste;ELSE bereitemenuemaskenausgabevorFI ;ELSE
+bereitemenuemaskenausgabevorFI FI ;holeberechtigungswert(benutzerberechtigung
+);holeallesohnknoten;setzeschalterfuermenueausgabenachfunktionstaste;IF
+bittedasmenuezeigenTHEN anwahluebermenueELSE direktefunktionstaste;IF
+nichtvorhandenetasteTHEN setzeschalterfuermenueausgabe(TRUE );
+anwahluebermenueFI ;FI ;holenaechstenknoten.schaueobmaskediemenuemaskeist:
+menuemaske:=nachprozedur(k)="".direktefunktionstaste:menuepunktgefunden:=
+FALSE ;IF sohnanzahl>0THEN
+pruefetasteundliefereknotenodermenuepunktnichtgefundenFI ;IF NOT
+menuepunktgefundenTHEN IF tastendruck=tastefuerbildschirmausdruckTHEN sk:=
+knotenfuerbildschirmausdruck;merkeknotenalsgefundenenmenuepunktELIF
+tastendruck=tastefuerauskunftserteilungTHEN sk:=knotenfuerauskunftserteilung;
+merkeknotenalsgefundenenmenuepunktELSE nichtvorhandenetaste:=TRUE FI FI .
+pruefetasteundliefereknotenodermenuepunktnichtgefunden:menuepunkt:=0;sk:=
+erster(ksoehne);WHILE weitere(sk,ksoehne)AND NOT menuepunktgefundenREP IF (
+NOT isopen(sk))CAND gesuchtetastegefundenTHEN
+merkeknotenalsgefundenenmenuepunktFI ;naechster(sk)PER .
+merkeknotenalsgefundenenmenuepunkt:menuepunktgefunden:=TRUE ;menuepunktINCR 1
+;ktab(menuepunkt):=sk.gesuchtetastegefunden:taste(sk)=tastendruck.
+holeallesohnknoten:mengedernachfolger(k,ksoehne);sohnanzahl:=zahlderelemente(
+ksoehne).holefunktionstaste:IF NOT gesetztdurcheditorTHEN IF menuemaskeTHEN
+loeschetastendruckELSE setzetastendruck(incharety(wartezeit))FI FI .
+anwahluebermenue:bildschirmwiederholspeicherausschalten;IF menuemaskeTHEN
+maskeaufbauen;maskekomplettausgeben;menueanwahlbestimmen;
+setzeschalterfuermenueausgabe(FALSE )ELSE fktmenueaufbauenundausgeben;
+fktmenueanwahlbestimmenFI .fktmenueaufbauenundausgeben:
+holeallesohnknotenfuerfktmenue;ermittlegrenzwertedesmenuerahmens(sohnanzahl,
+nichtvorhandenetaste);zeigefunktionenmenueaufdembildschirm(sohnanzahl,
+nichtvorhandenetaste).holeallesohnknotenfuerfktmenue:menuepunkt:=0;
+druckenkommtimfktmenuevor:=FALSE ;auskunftkommtimfktmenuevor:=FALSE ;sk:=
+erster(ksoehne);REP knotentabfuellenUNTIL (menuepunkt>=sohnanzahl)OR (
+menuepunkt>=maxmenuepunkte)PER ;IF (NOT druckenkommtimfktmenuevor)CAND
+sohnanzahl<maxmenuepunkteTHEN sohnanzahlINCR 1;ktab(sohnanzahl):=
+knotenfuerbildschirmausdruckFI ;IF (NOT auskunftkommtimfktmenuevor)CAND
+sohnanzahl<maxmenuepunkteTHEN sohnanzahlINCR 1;ktab(sohnanzahl):=
+knotenfuerauskunftserteilungFI ;aktmaxmenuepunkte:=sohnanzahl.
+knotentabfuellen:menuepunktINCR 1;IF isopen(sk)THEN ktab(menuepunkt):=
+nilknotenELSE ktab(menuepunkt):=sk;IF taste(sk)=tastefuerbildschirmausdruck
+THEN druckenkommtimfktmenuevor:=TRUE ELIF taste(sk)=
+tastefuerauskunftserteilungTHEN auskunftkommtimfktmenuevor:=TRUE FI ;FI ;
+naechster(sk).fktmenueanwahlbestimmen:
+eventuellefehlermeldungimfktmenueausgeben;
+setzecursoraufeinleseanfangsposition;tasteholen;anderemenueebene:=FALSE ;REP
+tastendruckimfktmenueUNTIL anderemenueebenePER ;
+bildschirmwiederholspeichereinschalten.
+eventuellefehlermeldungimfktmenueausgeben:.
+setzecursoraufeinleseanfangsposition:x:=x1+2;INT VAR yanfang:=y1+3;INT VAR
+yende:=yanfang+sohnanzahl-1;y:=yanfang;fktcursorzeigen.tastendruckimfktmenue:
+IF anderermenuepunktTHEN fktcursorloeschen;neuenfktmenuepunktbestimmen;
+fktcursorzeigen;tasteholen;ELSE pruefefkttastezudiesemmenue;IF NOT
+anderemenueebeneTHEN tasteholenFI FI .fktcursorloeschen:cursor(x,y);out(" ").
+fktcursorzeigen:cursor(x,y);out(">");cursor(x,y).pruefefkttastezudiesemmenue:
+IF tastendruck=rechtstasteTHEN anderemenueebene:=TRUE ;
+wandleypositioninmenuepunktnummerum;fktcursorloeschenELIF tastendruck=
+esctasteTHEN anderemenueebene:=TRUE ;funktionenmenueloeschenELSE
+vergleichetastemitgueltigenfkttasten;IF gueltigetasteimmenueTHEN
+anderemenueebene:=TRUE ;fktcursorloeschen;wandlemenuepunktnummerinypositionum
+;fktcursorzeigen;fktcursorloeschenFI FI .wandleypositioninmenuepunktnummerum:
+getcursor(x,y);menuepunkt:=y-yanfang+1.wandlemenuepunktnummerinypositionum:y
+:=yanfang+menuepunkt-1.funktionenmenueloeschen:
+schalterzurueckuebercursortasteein;IF vpvorhandenTHEN IF NOT
+gesetztdurcheditorTHEN reorganizescreen;cursor(cursorx,cursory);
+setlasteditvalues;setzeschalterfuermenueausgabe(FALSE )FI ;return(0)ELSE
+enter(1)FI .vergleichetastemitgueltigenfkttasten:gueltigetasteimmenue:=FALSE
+;menuepunkt:=0;WHILE (NOT gueltigetasteimmenue)AND menuepunkt<
+aktmaxmenuepunkteREP menuepunktINCR 1;IF tastendruck=taste(ktab(menuepunkt))
+THEN gueltigetasteimmenue:=TRUE FI PER .neuenfktmenuepunktbestimmen:IF
+cursorbewegungmithopTHEN aktuellerstenoderletztenfktmenuepunktbestimmenELSE
+naechstenfktmenuepunktbestimmenFI .
+aktuellerstenoderletztenfktmenuepunktbestimmen:cursorbewegungmithop:=FALSE ;
+IF tastendruck=obentasteTHEN y:=yanfangELSE y:=yendeFI .
+naechstenfktmenuepunktbestimmen:IF tastendruck=obentasteTHEN IF y>yanfang
+THEN yDECR 1ELIF y=yanfangTHEN y:=yendeFI ELIF tastendruck=untentasteTHEN IF
+y<yendeTHEN yINCR 1ELIF y=yendeTHEN y:=yanfangFI FI .maskeaufbauen:
+holemaskedesknotens;fuellemaske.holemaskedesknotens:t:=men.fuellemaske:
+fuelletitel;fuelletextederhistorie;fuelletextedersoehne.fuelletitel:put(t,
+text(k),titelfeldnr);getcursor(koordx,start2).fuelletextederhistorie:INT VAR
+hknr,tabzeiger,histmpkt;menuefeldnr:=historieende;FOR hknrFROM 1UPTO
+maxhknotenREP holehistorietext(menuetext,histmpkt,hknr);tabzeiger:=
+menuefeldnr-felderanzahlbishistoriebeginn;IF menuetext=""THEN
+setzemenuepunktzugang(tabzeiger,FALSE );menuetext:=" "ELSE
+setzemenuepunktzugang(tabzeiger,TRUE );histtexttab(hknr):=menuetext;
+histanwahlpos(hknr):=histmpkt;menuetext:=tabzeiger*" "+menuetext;put(t,
+menuetext,menuefeldnr);putposition(t,menuefeldnr);FI ;menuefeldnrDECR 1PER ;
+getposition(koordx,start1,historieende);start1:=start1-maxhknoten-1;te:=
+formline(men,start1);zeige(te,start1,start2,schluss).fuelletextedersoehne:
+TEXT VAR menuetext;INT VAR menuepunkt:=0,menuefeldnr;menuefeldnr:=menuebeginn
+;sk:=erster(ksoehne);WHILE (menuefeldnr<=felderimanwahlmenue)REP menuepunkt
+INCR 1;IF menuepunkt>sohnanzahlTHEN keinenmenuetext;ELSE IF isopen(sk)THEN
+ktab(menuepunkt):=nilknotenELSE ktab(menuepunkt):=skFI ;
+menuetextzusammensetzen(menuepunkt,stufennummer,menuetext);naechster(sk);put(
+t,menuetext,menuefeldnr);putposition(t,menuefeldnr)FI ;menuefeldnrINCR 1PER ;
+aktmaxmenuepunkte:=menuepunkt.keinenmenuetext:menuetext:=" ";mpkt:=menuepunkt
++maxhknoten;setzemenuepunktzugang(mpkt,FALSE ).maskekomplettausgeben:
+eventuellefehlermeldungausgeben;erstenmenuepunktbestimmen;
+cursorpositionerrechnen;cursorzeigen;tasteholen;anderemenueebene:=FALSE ;REP
+tastendruckindiesemmenueUNTIL anderemenueebenePER ;cursorloeschen;
+bildschirmwiederholspeichereinschalten.eventuellefehlermeldungausgeben:.
+erstenmenuepunktbestimmen:IF ebenenwechselTHEN ebenenwechsel:=FALSE ;
+aktfeldnr:=letztemenueanwahlposFI ;mpkt:=aktfeldnr-
+felderanzahlbishistoriebeginn;IF NOT zugangerlaubt(mpkt)THEN setzetastendruck
+(untentaste);neuenmenuepunktbestimmenFI ;mpkt:=aktfeldnr-
+felderanzahlbishistoriebeginn;IF (NOT zugangerlaubt(mpkt))AND menuemaskeTHEN
+aktfeldnr:=historieendeFI .cursorpositionerrechnen:getposition(x,y,aktfeldnr)
+.cursorzeigen:cursor(x,y);out(fcursor);xDECR 1;cursor(x,y);out(" ").
+cursorloeschen:cursorvormenuepunktloeschen.cursorvormenuepunktloeschen:
+getcursor(x,y);cursor(x,y);out(fcursorweg).tastendruckindiesemmenue:IF
+anderermenuepunktTHEN cursorloeschen;neuenmenuepunktbestimmen;
+cursorpositionerrechnen;cursorzeigen;tasteholenELSE
+pruefetastendruckzudiesemmenue;IF NOT anderemenueebeneTHEN tasteholenFI FI .
+pruefetastendruckzudiesemmenue:IF tastendruck=rechtstasteTHEN
+anderemenueebene:=TRUE ELIF code(tastendruck)>=codefuerziffernullAND code(
+tastendruck)<=codefuerzifferneunTHEN IF code(tastendruck)=codefuerziffernull
+THEN mpkt:=10ELSE mpkt:=code(tastendruck)-codefuerziffernullFI ;IF sohnanzahl
+<mpktTHEN gedaechtnisloeschen;out("�");cursor(x+1,y)ELIF NOT zugangerlaubt(
+mpkt+maxhknoten)THEN gedaechtnisloeschen;out("�");cursor(x+1,y)ELSE
+anderemenueebene:=TRUE ;cursorloeschen;aktfeldnr:=menuebeginn+(mpkt-1)*
+felderpromenuepunkt;setzetastendruck(rechtstaste);cursorpositionerrechnen;
+cursorzeigenFI FI .neuenmenuepunktbestimmen:IF cursorbewegungmithopTHEN
+aktuellerstenoderletztenmenuepunktbestimmenELSE naechstenmenuepunktbestimmen
+FI .aktuellerstenoderletztenmenuepunktbestimmen:BOOL VAR
+erstenoderletztenmenuepunktgefunden:=FALSE ;WHILE NOT
+erstenoderletztenmenuepunktgefundenREP naechstenmenuepunktbestimmen;IF
+savefeldnr=aktfeldnrTHEN erstenoderletztenmenuepunktgefunden:=TRUE FI ;PER ;
+cursorbewegungmithop:=FALSE .naechstenmenuepunktbestimmen:BOOL VAR
+neuenmenuepunktgefunden:=FALSE ;INT VAR savefeldnr:=aktfeldnr;REP
+sucheneuenmenuepunktUNTIL neuenmenuepunktgefundenPER .sucheneuenmenuepunkt:
+IF tastendruck=obentasteTHEN aktfeldnrDECR felderpromenuepunktELIF
+tastendruck=untentasteTHEN aktfeldnrINCR felderpromenuepunktFI ;IF
+cursorbewegungmithopTHEN IF aktfeldnr<historiebeginnOR aktfeldnr>
+felderimanwahlmenueTHEN aktfeldnr:=savefeldnr;neuenmenuepunktgefunden:=TRUE ;
+LEAVE sucheneuenmenuepunktFI ELSE IF aktfeldnr<historiebeginnTHEN aktfeldnr:=
+fields(t)-felderpromenuepunkt+1ELIF aktfeldnr>fields(t)THEN aktfeldnr:=
+historiebeginnFI FI ;IF feldvorhandenTHEN mpkt:=aktfeldnr-
+felderanzahlbishistoriebeginn;IF zugangerlaubt(mpkt)THEN
+neuenmenuepunktgefunden:=TRUE FI ;FI .feldvorhanden:fieldexists(t,aktfeldnr).
+bildschirmwiederholspeicherausschalten:store(FALSE ).
+bildschirmwiederholspeichereinschalten:store(TRUE ).menueanwahlbestimmen:IF
+menuemaskeTHEN IF aktfeldnr<menuebeginnTHEN letztemenueanwahlpos:=menuebeginn
+ELSE letztemenueanwahlpos:=aktfeldnrFI ;FI ;IF tastendruck=rechtstasteTHEN
+bestimmemenuepunktfuernaechstesmenueELSE schalterzurueckuebercursortasteein;
+IF vpvorhandenTHEN IF NOT gesetztdurcheditorTHEN reorganizescreenFI ;return(0
+)ELSE enter(1)FI ;FI .bestimmemenuepunktfuernaechstesmenue:IF aktfeldnr>=
+menuebeginnTHEN aktfeldnrDECR felderanzahlbismenuebeginnELSE aktfeldnrDECR
+felderanzahlbishistoriebeginn;anwahleineshistoriepunktes:=TRUE FI ;menuepunkt
+:=aktfeldnr.holenaechstenknoten:setzeeditorschalterzurueck;IF
+zurueckuebercursortasteTHEN schalterzurueckuebercursortasteaus;
+vaterknotenalsneuenknotennehmenELIF historiepunktangewaehltTHEN
+anwahleineshistoriepunktes:=FALSE ;textdeshistoriepunktesbestimmen;
+historieknotenalsneuenknotennehmenELSE knotenaufstackablegen(k);IF
+aktuellerhistorieknotenTHEN legehistorieknotenab(text(k),menuepunkt)FI ;
+sohnknotenalsneuenknotennehmenFI .historiepunktangewaehlt:
+anwahleineshistoriepunktes.textdeshistoriepunktesbestimmen:TEXT VAR histtext;
+hknr:=maxhknoten+1-menuepunkt;histtext:=histtexttab(hknr);aktfeldnr:=
+historieende+histanwahlpos(hknr).historieknotenalsneuenknotennehmen:REP enter
+(1);vaterknotenalsneuenknotennehmenUNTIL text(k)=histtextPER .
+reduzierestufennummer:INT VAR lstufnr:=length(stufennummer);IF lstufnr<=3
+THEN stufennummer:=""ELSE IF subtext(stufennummer,lstufnr-1,lstufnr-1)=
+stufentrennerTHEN stufennummer:=subtext(stufennummer,1,lstufnr-2)ELSE
+stufennummer:=subtext(stufennummer,1,lstufnr-3)FI ;FI .
+aktuellerhistorieknoten:menuemaskeOR (text(k)=anfangsknotenname).
+vaterknotenalsneuenknotennehmen:k:=vergleichsknoten;IF nachprozedur(k)=""
+THEN reduzierestufennummerFI .sohnknotenalsneuenknotennehmen:KNOTEN VAR
+tabknoten:=ktab(menuepunkt);IF reinlokaleoperationTHEN k:=tabknoten;IF
+menuemaskeTHEN erweiterestufennummerFI ;aktfeldnr:=menuebeginnELSE
+fuehreknotenwechselmittaskwechseldurch;ebenenwechsel:=TRUE FI ;vpwunsch.
+reinlokaleoperation:TEXT CONST knotentask:=task(tabknoten);knotentask="".
+fuehreknotenwechselmittaskwechseldurch:INT VAR statustaskwechsel:=0;
+umgebungswechsel(tabknoten,knotentask,statustaskwechsel);k:=
+altermenueknotenaufstack;IF statustaskwechsel=1THEN cursor(1,23);put(
+"Verzweigung ist nicht möglich");pauseELIF statustaskwechsel=2THEN cursor(1,
+23);put("es wird bereits innerhalb dieser Anwendungen gearbeitet");pauseFI .
+altermenueknotenaufstack:enter(1);vergleichsknoten.erweiterestufennummer:IF
+stufennummer=""THEN stufennummer:=berechttrenner+text(menuepunkt)ELSE
+stufennummer:=stufennummer+stufentrenner+text(menuepunkt)FI .
+schalterzurueckuebercursortasteein:zurueckuebercursortaste:=TRUE .
+schalterzurueckuebercursortasteaus:zurueckuebercursortaste:=FALSE .END PROC
+startbaisy;PROC berechtigungspruefung(TEXT CONST altnr,INT CONST neunr,BOOL
+VAR berechtigt):IF NOT menuemaskeTHEN berechtigt:=TRUE ;LEAVE
+berechtigungspruefungFI ;TEXT VAR berechtstring:=benutzerberechtigung;IF
+keineberechtigungzugeteiltTHEN berechtigt:=FALSE ;LEAVE berechtigungspruefung
+FI ;berechtigt:=FALSE ;zupruefendestufennummeraufbauen;berechtigungholen;
+WHILE NOT berechtigtAND nocheineberechtigungdaREP IF
+berechtistpraefixvonpruefnrOR pruefnristpraefixvonberechtTHEN berechtigt:=
+TRUE FI ;berechtigungholenPER .keineberechtigungzugeteilt:berechtstring="".
+nocheineberechtigungda:berecht<>"".zupruefendestufennummeraufbauen:TEXT VAR
+pruefnr;IF altnr=""THEN pruefnr:=berechttrenner+text(neunr)ELSE pruefnr:=
+altnr+stufentrenner+text(neunr)FI ;pruefnrCAT stufentrenner.berechtigungholen
+:TEXT VAR berecht;IF berechtstringabgearbeitetTHEN berecht:=""ELSE
+imberechtstringweitereberechtsuchen;IF nurnocheineberechtigungTHEN berecht:=
+berechtstring;berechtstring:=""ELSE berecht:=subtext(berechtstring,1,
+postrennz-1);berechtstring:=subtext(berechtstring,postrennz)FI ;berechtCAT
+stufentrenner;FI .imberechtstringweitereberechtsuchen:INT VAR postrennz:=pos(
+berechtstring,berechttrenner,2).nurnocheineberechtigung:postrennz=0.
+berechtstringabgearbeitet:berechtstring="".berechtistpraefixvonpruefnr:pos(
+pruefnr,berecht)<>0.pruefnristpraefixvonberecht:pos(berecht,pruefnr)<>0.END
+PROC berechtigungspruefung;PROC dummycall(INT CONST i,BOOL CONST b,TEXT
+CONST knotenproc):do(knotenproc)END PROC dummycall;PROC startebaisy(TEXT
+CONST kn):initsybifunktionen;BOOL VAR knotenda;anfangsknotenholen(kn,k,
+knotenda);holenamedesanfangsknotens;vpwunsch;IF NOT knotendaTHEN put(
+"kein knoten da");pause(50);setzeprogrammende(TRUE )ELIF isopen(k)THEN put(
+"knoten da, aber offen");pause(50);setzeprogrammende(TRUE )FI ;
+setzeanfangsknotennamefuerbenutzerbestand(kn);
+einzelknotenfuerfunktionenmenueholen(verteilt);monitorbehandlungundstart.
+holenamedesanfangsknotens:TEXT VAR anfangsknotenname;anfangsknotenname:=text(
+k);page.verteilt:anfangsknotenname="".monitorbehandlungundstart:putline(
+"Das System "+kn+" wird gestartet.");initmeldungsfunktionen;startbaisy(kn,
+PROC dummycall)END PROC startebaisy;PROC starteanwendung:BOOL VAR knotenda;
+anfangsknotenholen("",k,knotenda);vpwunsch;
+einzelknotenfuerfunktionenmenueholen(TRUE );setzeverteilteanwendung;
+startbaisy("",PROC dummycall)END PROC starteanwendung;PROC startebaisy:
+startebaisy("baisy")END PROC startebaisy;PROC starteschulis:startebaisy(
+"schulis")END PROC starteschulis;END PACKET systembauminterpreter;
+
diff --git a/app/baisy/2.2.1-schulis/src/thesaurusfunktionen b/app/baisy/2.2.1-schulis/src/thesaurusfunktionen
new file mode 100644
index 0000000..d003dc9
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/thesaurusfunktionen
@@ -0,0 +1,16 @@
+PACKET thesaurusfunktionenDEFINES leererthesaurus,trageinthesaurusein,
+loescheausthesaurus,inthesaurus,zeigethesaurus,uebertragethesaurusindatei:
+THESAURUS VAR saurus;PROC leererthesaurus:saurus:=emptythesaurus;END PROC
+leererthesaurus;PROC trageinthesaurusein(TEXT CONST objekt):INT VAR index;IF
+NOT inthesaurus(objekt)THEN insert(saurus,objekt,index)FI ;END PROC
+trageinthesaurusein;PROC loescheausthesaurus(TEXT CONST loeschtext):INT VAR
+index;delete(saurus,loeschtext,index);END PROC loescheausthesaurus;BOOL PROC
+inthesaurus(TEXT CONST objekt):saurusCONTAINS objektEND PROC inthesaurus;
+PROC uebertragethesaurusindatei(TEXT CONST dateiname):IF exists(dateiname)
+THEN forget(dateiname,quiet)FI ;FILE VAR f:=sequentialfile(output,dateiname);
+TEXT VAR zeile;INT VAR index:=0;get(saurus,zeile,index);WHILE index>0REP
+putline(f,zeile);get(saurus,zeile,index)PER ;END PROC
+uebertragethesaurusindatei;PROC zeigethesaurus:TEXT VAR zeile;INT VAR index:=
+0;get(saurus,zeile,index);WHILE index>0REP putline(zeile);get(saurus,zeile,
+index)PER ;END PROC zeigethesaurus;END PACKET thesaurusfunktionen;
+
diff --git a/app/baisy/2.2.1-schulis/src/umgebungswechsel manager b/app/baisy/2.2.1-schulis/src/umgebungswechsel manager
new file mode 100644
index 0000000..3b4debb
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/umgebungswechsel manager
@@ -0,0 +1,19 @@
+PACKET umgebungswechselmanagerDEFINES umgebungswechsel:LET ack=0,nak=1,
+manager=" manager";PROC umgebungswechsel(KNOTEN CONST k,TEXT CONST zieltask,
+INT VAR fstatus):INT VAR kanal;pruefezieltask;IF fstatus=ackTHEN gibkanalfrei
+;sendedatenbankkennungundkanalanmanager;IF fstatus=ackTHEN
+sendesystembaumundaktuellenknotenansohntaskFI ;belegekanalwiederFI .
+pruefezieltask:disablestop;TASK VAR zielmanager:=/(zieltask+manager),
+stellvertreter;IF iserrorTHEN fstatus:=nakELSE fstatus:=ackFI ;clearerror.
+sendedatenbankkennungundkanalanmanager:DATASPACE VAR dsvar:=nilspace;call(
+zielmanager,kanal,dsvar,stellvertreter,fstatus);forget(dsvar).
+sendesystembaumundaktuellenknotenansohntask:holesystembaumundanfangsknoten;
+call(stellvertreter,anfangsknoten,systembaumds,fstatus);forget(systembaumds).
+gibkanalfrei:kanal:=channel(myself);break(quiet).belegekanalwieder:continue(
+kanal).holesystembaumundanfangsknoten:DATASPACE VAR systembaumds:=systembaum;
+INT CONST anfangsknoten:=nummer(k).END PROC umgebungswechsel;PROC call(TASK
+CONST zielmanager,INT CONST kanal,DATASPACE VAR ds,TASK VAR stellvertreter,
+INT VAR fstatus):call(zielmanager,kanal,ds,fstatus);IF fstatus=ackTHEN BOUND
+TASK VAR t:=ds;stellvertreter:=tFI ;forget(ds);break(quiet);END PROC call;
+END PACKET umgebungswechselmanager
+