From 04e68443040c7abad84d66477e98f93bed701760 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 4 Feb 2019 13:09:03 +0100 Subject: Initial import --- app/baisy/2.2.1-schulis/src/ANWENDUNG.files | 3 + app/baisy/2.2.1-schulis/src/BAISY SERVER.files | 6 + app/baisy/2.2.1-schulis/src/BASIS.files | 7 + app/baisy/2.2.1-schulis/src/DB REORG.files | 5 + app/baisy/2.2.1-schulis/src/DB.files | 16 + app/baisy/2.2.1-schulis/src/DOS.files | 22 + app/baisy/2.2.1-schulis/src/SICHERUNG.files | 8 + app/baisy/2.2.1-schulis/src/STANDARD.files | 16 + app/baisy/2.2.1-schulis/src/WERKZEUGE.files | 8 + .../2.2.1-schulis/src/allgemeine grundfunktionen | 35 ++ app/baisy/2.2.1-schulis/src/aufruf manager | 39 ++ app/baisy/2.2.1-schulis/src/auskunftsfenster | 126 ++++++ app/baisy/2.2.1-schulis/src/baisyio | 51 +++ app/baisy/2.2.1-schulis/src/block i-o | 52 +++ app/baisy/2.2.1-schulis/src/bpb ds | Bin 0 -> 2048 bytes app/baisy/2.2.1-schulis/src/db archive.sc | 7 + app/baisy/2.2.1-schulis/src/db dd.sc | 60 +++ app/baisy/2.2.1-schulis/src/db ddinfo.sc | 24 + app/baisy/2.2.1-schulis/src/db fetch.baisy | 28 ++ app/baisy/2.2.1-schulis/src/db kernel.sc | 60 +++ app/baisy/2.2.1-schulis/src/db parse.sc | 38 ++ app/baisy/2.2.1-schulis/src/db phon.sc | 17 + app/baisy/2.2.1-schulis/src/db reorg.sc | 48 ++ .../2.2.1-schulis/src/db reorganisation auftrag | 12 + .../2.2.1-schulis/src/db reorganisation manager | 15 + app/baisy/2.2.1-schulis/src/db scan | 245 ++++++++++ app/baisy/2.2.1-schulis/src/db utils.sc | 60 +++ app/baisy/2.2.1-schulis/src/dir.dos | 187 ++++++++ app/baisy/2.2.1-schulis/src/disk descriptor.dos | 73 +++ app/baisy/2.2.1-schulis/src/dos hd inserter | 12 + app/baisy/2.2.1-schulis/src/dos inserter | 15 + app/baisy/2.2.1-schulis/src/dump | 12 + app/baisy/2.2.1-schulis/src/editorfunktionen | 56 +++ app/baisy/2.2.1-schulis/src/erf.auskuenfte | 66 +++ app/baisy/2.2.1-schulis/src/eu disk descriptor | 26 ++ app/baisy/2.2.1-schulis/src/f packet.sc | 9 + app/baisy/2.2.1-schulis/src/fat.dos | 82 ++++ app/baisy/2.2.1-schulis/src/fetch | 108 +++++ app/baisy/2.2.1-schulis/src/fetch save interface | 16 + app/baisy/2.2.1-schulis/src/get put interface.dos | 103 +++++ app/baisy/2.2.1-schulis/src/insert.dos | 15 + app/baisy/2.2.1-schulis/src/isp archive.sc | 35 ++ app/baisy/2.2.1-schulis/src/isp.auskunftseditor | 27 ++ .../2.2.1-schulis/src/isp.auskunftsfunktionen | 69 +++ app/baisy/2.2.1-schulis/src/isp.baisy server | 80 ++++ .../2.2.1-schulis/src/isp.benutzerberechtigungen | 87 ++++ app/baisy/2.2.1-schulis/src/isp.erf.abkuerzungen | 67 +++ .../src/isp.erf.benutzerberechtigungen | 54 +++ app/baisy/2.2.1-schulis/src/isp.erf.meldungen | 40 ++ .../2.2.1-schulis/src/isp.erf.steueroperationen | 258 +++++++++++ app/baisy/2.2.1-schulis/src/isp.init baisy server | 4 + app/baisy/2.2.1-schulis/src/isp.knoten | 137 ++++++ .../2.2.1-schulis/src/isp.manager schnittstelle | 82 ++++ app/baisy/2.2.1-schulis/src/isp.masken | 495 +++++++++++++++++++++ app/baisy/2.2.1-schulis/src/isp.maskendesign | 302 +++++++++++++ app/baisy/2.2.1-schulis/src/isp.meldungsfunktionen | 64 +++ .../2.2.1-schulis/src/isp.monitor sicherungstask | 126 ++++++ app/baisy/2.2.1-schulis/src/isp.objektliste | 252 +++++++++++ app/baisy/2.2.1-schulis/src/isp.schulis db nummern | 225 ++++++++++ app/baisy/2.2.1-schulis/src/isp.sicherungsmonitor | 141 ++++++ .../2.2.1-schulis/src/isp.standardmaskenbehandlung | 35 ++ .../2.2.1-schulis/src/isp.systembaumbearbeitung | 236 ++++++++++ app/baisy/2.2.1-schulis/src/isp.systembaumeditor | 72 +++ .../2.2.1-schulis/src/isp.zusatz archive packet | 13 + app/baisy/2.2.1-schulis/src/konvert | 18 + app/baisy/2.2.1-schulis/src/log.eintrag | 14 + app/baisy/2.2.1-schulis/src/log.manager | 126 ++++++ app/baisy/2.2.1-schulis/src/logbuch verwaltung | 81 ++++ app/baisy/2.2.1-schulis/src/longrow | 38 ++ app/baisy/2.2.1-schulis/src/manager-M.dos | 55 +++ app/baisy/2.2.1-schulis/src/manager-S.dos | 67 +++ app/baisy/2.2.1-schulis/src/maskenerweiterung | 11 + app/baisy/2.2.1-schulis/src/maskenverarbeitung | 125 ++++++ app/baisy/2.2.1-schulis/src/name conversion.dos | 22 + app/baisy/2.2.1-schulis/src/new monitor baisy | 4 + app/baisy/2.2.1-schulis/src/open | 11 + app/baisy/2.2.1-schulis/src/plausipruefung | 88 ++++ app/baisy/2.2.1-schulis/src/save | 61 +++ .../2.2.1-schulis/src/schulis kommandobehandlung | 19 + app/baisy/2.2.1-schulis/src/shard interface | 20 + app/baisy/2.2.1-schulis/src/standarddialog | 34 ++ app/baisy/2.2.1-schulis/src/sybifunktionen | 71 +++ app/baisy/2.2.1-schulis/src/systembaum | 299 +++++++++++++ app/baisy/2.2.1-schulis/src/systembauminterpreter | 390 ++++++++++++++++ app/baisy/2.2.1-schulis/src/thesaurusfunktionen | 16 + .../2.2.1-schulis/src/umgebungswechsel manager | 19 + 86 files changed, 6278 insertions(+) create mode 100644 app/baisy/2.2.1-schulis/src/ANWENDUNG.files create mode 100644 app/baisy/2.2.1-schulis/src/BAISY SERVER.files create mode 100644 app/baisy/2.2.1-schulis/src/BASIS.files create mode 100644 app/baisy/2.2.1-schulis/src/DB REORG.files create mode 100644 app/baisy/2.2.1-schulis/src/DB.files create mode 100644 app/baisy/2.2.1-schulis/src/DOS.files create mode 100644 app/baisy/2.2.1-schulis/src/SICHERUNG.files create mode 100644 app/baisy/2.2.1-schulis/src/STANDARD.files create mode 100644 app/baisy/2.2.1-schulis/src/WERKZEUGE.files create mode 100644 app/baisy/2.2.1-schulis/src/allgemeine grundfunktionen create mode 100644 app/baisy/2.2.1-schulis/src/aufruf manager create mode 100644 app/baisy/2.2.1-schulis/src/auskunftsfenster create mode 100644 app/baisy/2.2.1-schulis/src/baisyio create mode 100644 app/baisy/2.2.1-schulis/src/block i-o create mode 100644 app/baisy/2.2.1-schulis/src/bpb ds create mode 100644 app/baisy/2.2.1-schulis/src/db archive.sc create mode 100644 app/baisy/2.2.1-schulis/src/db dd.sc create mode 100644 app/baisy/2.2.1-schulis/src/db ddinfo.sc create mode 100644 app/baisy/2.2.1-schulis/src/db fetch.baisy create mode 100644 app/baisy/2.2.1-schulis/src/db kernel.sc create mode 100644 app/baisy/2.2.1-schulis/src/db parse.sc create mode 100644 app/baisy/2.2.1-schulis/src/db phon.sc create mode 100644 app/baisy/2.2.1-schulis/src/db reorg.sc create mode 100644 app/baisy/2.2.1-schulis/src/db reorganisation auftrag create mode 100644 app/baisy/2.2.1-schulis/src/db reorganisation manager create mode 100644 app/baisy/2.2.1-schulis/src/db scan create mode 100644 app/baisy/2.2.1-schulis/src/db utils.sc create mode 100644 app/baisy/2.2.1-schulis/src/dir.dos create mode 100644 app/baisy/2.2.1-schulis/src/disk descriptor.dos create mode 100644 app/baisy/2.2.1-schulis/src/dos hd inserter create mode 100644 app/baisy/2.2.1-schulis/src/dos inserter create mode 100644 app/baisy/2.2.1-schulis/src/dump create mode 100644 app/baisy/2.2.1-schulis/src/editorfunktionen create mode 100644 app/baisy/2.2.1-schulis/src/erf.auskuenfte create mode 100644 app/baisy/2.2.1-schulis/src/eu disk descriptor create mode 100644 app/baisy/2.2.1-schulis/src/f packet.sc create mode 100644 app/baisy/2.2.1-schulis/src/fat.dos create mode 100644 app/baisy/2.2.1-schulis/src/fetch create mode 100644 app/baisy/2.2.1-schulis/src/fetch save interface create mode 100644 app/baisy/2.2.1-schulis/src/get put interface.dos create mode 100644 app/baisy/2.2.1-schulis/src/insert.dos create mode 100644 app/baisy/2.2.1-schulis/src/isp archive.sc create mode 100644 app/baisy/2.2.1-schulis/src/isp.auskunftseditor create mode 100644 app/baisy/2.2.1-schulis/src/isp.auskunftsfunktionen create mode 100644 app/baisy/2.2.1-schulis/src/isp.baisy server create mode 100644 app/baisy/2.2.1-schulis/src/isp.benutzerberechtigungen create mode 100644 app/baisy/2.2.1-schulis/src/isp.erf.abkuerzungen create mode 100644 app/baisy/2.2.1-schulis/src/isp.erf.benutzerberechtigungen create mode 100644 app/baisy/2.2.1-schulis/src/isp.erf.meldungen create mode 100644 app/baisy/2.2.1-schulis/src/isp.erf.steueroperationen create mode 100644 app/baisy/2.2.1-schulis/src/isp.init baisy server create mode 100644 app/baisy/2.2.1-schulis/src/isp.knoten create mode 100644 app/baisy/2.2.1-schulis/src/isp.manager schnittstelle create mode 100644 app/baisy/2.2.1-schulis/src/isp.masken create mode 100644 app/baisy/2.2.1-schulis/src/isp.maskendesign create mode 100644 app/baisy/2.2.1-schulis/src/isp.meldungsfunktionen create mode 100644 app/baisy/2.2.1-schulis/src/isp.monitor sicherungstask create mode 100644 app/baisy/2.2.1-schulis/src/isp.objektliste create mode 100644 app/baisy/2.2.1-schulis/src/isp.schulis db nummern create mode 100644 app/baisy/2.2.1-schulis/src/isp.sicherungsmonitor create mode 100644 app/baisy/2.2.1-schulis/src/isp.standardmaskenbehandlung create mode 100644 app/baisy/2.2.1-schulis/src/isp.systembaumbearbeitung create mode 100644 app/baisy/2.2.1-schulis/src/isp.systembaumeditor create mode 100644 app/baisy/2.2.1-schulis/src/isp.zusatz archive packet create mode 100644 app/baisy/2.2.1-schulis/src/konvert create mode 100644 app/baisy/2.2.1-schulis/src/log.eintrag create mode 100644 app/baisy/2.2.1-schulis/src/log.manager create mode 100644 app/baisy/2.2.1-schulis/src/logbuch verwaltung create mode 100644 app/baisy/2.2.1-schulis/src/longrow create mode 100644 app/baisy/2.2.1-schulis/src/manager-M.dos create mode 100644 app/baisy/2.2.1-schulis/src/manager-S.dos create mode 100644 app/baisy/2.2.1-schulis/src/maskenerweiterung create mode 100644 app/baisy/2.2.1-schulis/src/maskenverarbeitung create mode 100644 app/baisy/2.2.1-schulis/src/name conversion.dos create mode 100644 app/baisy/2.2.1-schulis/src/new monitor baisy create mode 100644 app/baisy/2.2.1-schulis/src/open create mode 100644 app/baisy/2.2.1-schulis/src/plausipruefung create mode 100644 app/baisy/2.2.1-schulis/src/save create mode 100644 app/baisy/2.2.1-schulis/src/schulis kommandobehandlung create mode 100644 app/baisy/2.2.1-schulis/src/shard interface create mode 100644 app/baisy/2.2.1-schulis/src/standarddialog create mode 100644 app/baisy/2.2.1-schulis/src/sybifunktionen create mode 100644 app/baisy/2.2.1-schulis/src/systembaum create mode 100644 app/baisy/2.2.1-schulis/src/systembauminterpreter create mode 100644 app/baisy/2.2.1-schulis/src/thesaurusfunktionen create mode 100644 app/baisy/2.2.1-schulis/src/umgebungswechsel manager (limited to 'app/baisy/2.2.1-schulis/src') 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 +=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 +limitoTHEN posyDECR 1ELSE cursornachlo;ausbereichgeraten:=TRUE FI . +eineseitevor:IF posylimitoTHEN 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 Binary files /dev/null and b/app/baisy/2.2.1-schulis/src/bpb ds 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");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; WHILEuuuuwv23 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"" 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"" 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; WHILEuuuuwv0 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; WHILEuuuuwv1 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 +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: IFuuuvxx0;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," ");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 convertbufferlength5.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=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 +0)CAND (k.index0)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 tganzrichtigTHEN 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)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+alafeld.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+alafeld.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 ix;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 wo0THEN 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");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 xcescCOR 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 (feldindmaxfeld +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:posnormmaxmeldungenTHEN ""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 +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")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):ordertaskletzteslogTHEN 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"".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 +)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)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 tagnr1).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 inteingabeogTHEN meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnrFI ; +END PROC pruefenumgrenzen;PROC pruefeimbestand(TAG CONST maske,TEXT PROC ( +INT CONST )eingabe,INT CONST fnr,TEXT CONST bestand,INT VAR fstatus):LET +fehlermeldungsnr=55;BOOL VAR nichtimbestandgefunden;IF (bestandSUB 1)="c" +THEN nichtimbestandgefunden:=NOT (imbestand(bestand+trennerfuerfeldwerte+ +eingabe(fnr),dateinameschluessel))ELSE nichtimbestandgefunden:=NOT (imbestand +(eingabe(fnr),bestand))FI ;IF nichtimbestandgefundenTHEN meldeauffaellig( +maske,fehlermeldungsnr);fstatus:=fnrFI .END PROC pruefeimbestand;PROC +pruefealternativen(TAG CONST maske,TEXT PROC (INT CONST )eingabe,INT CONST +fnr1,fnr2,INT VAR fstatus):LET fehlermeldungsnr=56;IF fnr2<=fnr1THEN LEAVE +pruefealternativenFI ;INT VAR nr:=fnr1,treffer:=0;REP IF eingabe(nr)<>""THEN +trefferINCR 1FI ;nrINCR 1UNTIL (nr>fnr2)OR (treffer>1)PER ;IF treffer<>1THEN +meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnr1FI .END PROC +pruefealternativen;PROC pruefedatum(TAG CONST maske,TEXT PROC (INT CONST ) +eingabe,INT CONST fnr,INT VAR fstatus):LET fehlermeldungsnr=157,falschertag= +"00";TEXT VAR pruefdatum:=eingabe(fnr);IF datum(pruefdatum)=nildatumCOR +subtext(pruefdatum,1,2)=falschertagTHEN meldeauffaellig(maske, +fehlermeldungsnr);fstatus:=fnrFI ;END PROC pruefedatum;PROC pruefe(INT CONST +pruefart,TAG CONST maske,ROW 100TEXT CONST prueftext,INT CONST feldnummer,ug, +og,TEXT CONST bestand,INT VAR fstatus):fstatus:=0;SELECT pruefartOF CASE 1: +pruefefeldgefuellt(maske,prueftext,feldnummer,fstatus)CASE 2:pruefenumerisch( +maske,prueftext,feldnummer,fstatus)CASE 3:pruefenumgrenzen(maske,prueftext, +feldnummer,ug,og,fstatus)CASE 4:pruefeimbestand(maske,prueftext,feldnummer, +bestand,fstatus)CASE 5:pruefealternativen(maske,prueftext,feldnummer,ug, +fstatus)CASE 6:pruefedatum(maske,prueftext,feldnummer,fstatus)END SELECT . +END PROC pruefe;PROC pruefefeldgefuellt(TAG CONST maske,ROW 100TEXT CONST +eingabe,INT CONST fnr,INT VAR fstatus):LET fehlermeldungsnr=52;IF eingabe(fnr +)=""THEN meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnrFI ;END PROC +pruefefeldgefuellt;PROC pruefenumerisch(TAG CONST maske,ROW 100TEXT CONST +eingabe,INT CONST fnr,INT VAR fstatus):LET fehlermeldungsnr=53;INT VAR type; +TEXT VAR teiltext;scan(eingabe(fnr));nextsymbol(teiltext,type);IF type<>3 +THEN meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnrELSE nextsymbol( +teiltext,type);IF type<>7THEN meldeauffaellig(maske,fehlermeldungsnr);fstatus +:=fnrFI ;FI ;END PROC pruefenumerisch;PROC pruefenumgrenzen(TAG CONST maske, +ROW 100TEXT CONST eingabe,INT CONST fnr,ug,og,INT VAR fstatus):LET +fehlermeldungsnr=54;INT VAR inteingabe:=int(eingabe(fnr));IF inteingabeogTHEN meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnrFI ; +END PROC pruefenumgrenzen;PROC pruefeimbestand(TAG CONST maske,ROW 100TEXT +CONST eingabe,INT CONST fnr,TEXT CONST bestand,INT VAR fstatus):LET +fehlermeldungsnr=55;BOOL VAR nichtimbestandgefunden;IF (bestandSUB 1)="c" +THEN nichtimbestandgefunden:=NOT (imbestand(bestand+trennerfuerfeldwerte+ +eingabe(fnr),dateinameschluessel))ELSE nichtimbestandgefunden:=NOT (imbestand +(eingabe(fnr),bestand))FI ;IF nichtimbestandgefundenTHEN meldeauffaellig( +maske,fehlermeldungsnr);fstatus:=fnrFI .END PROC pruefeimbestand;PROC +pruefealternativen(TAG CONST maske,ROW 100TEXT CONST eingabe,INT CONST fnr1, +fnr2,INT VAR fstatus):LET fehlermeldungsnr=56;IF fnr2<=fnr1THEN LEAVE +pruefealternativenFI ;INT VAR nr:=fnr1,treffer:=0;REP IF eingabe(nr)<>""THEN +trefferINCR 1FI ;nrINCR 1UNTIL (nr>fnr2)OR (treffer>1)PER ;IF treffer<>1THEN +meldeauffaellig(maske,fehlermeldungsnr);fstatus:=fnr1FI .END PROC +pruefealternativen;PROC pruefedatum(TAG CONST maske,ROW 100TEXT CONST eingabe +,INT CONST fnr,INT VAR fstatus):LET fehlermeldungsnr=157,falschertag="00"; +TEXT VAR pruefdatum:=eingabe(fnr);IF datum(pruefdatum)=nildatumCOR subtext( +pruefdatum,1,2)=falschertagTHEN meldeauffaellig(maske,fehlermeldungsnr); +fstatus:=fnrFI ;END PROC pruefedatum;BOOL PROC imschlbestand(TEXT CONST +schlwert,bestand):imbestand(bestand+trennerfuerfeldwerte+schlwert, +dateinameschluessel)END PROC imschlbestand;BOOL PROC imbestand(TEXT CONST +schlwerte,bestandname):INT VAR dateinummer,status,position,i;TEXT VAR suchkey +:=schlwerte;systemdboff;stopbeifalschemnamen(FALSE );dateinummer:=dateinr( +bestandname);IF dateinummer>0THEN parsenooffields(0);suchwertesetzen;search( +dateinummer,TRUE );status:=dbstatus;reinitparsingELSE status:=1FI ; +stopbeifalschemnamen(TRUE );status=0.suchwertesetzen:FOR iFROM 1UPTO anzkey( +dateinummer)REP ermittleposition;putwert(dateinummer+i,suchwert);suchkey:= +subtext(suchkey,position+2)UNTIL suchkey=""PER .ermittleposition:position:= +pos(suchkey,trennerfuerfeldwerte);IF position=0THEN position:=length(suchkey) +ELSE positionDECR 1FI .suchwert:subtext(suchkey,1,position).END PROC +imbestand;END PACKET plausipruefung; + 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= +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 knotenstackhoehe0THEN 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=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");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 +ysohnanzahlTHEN 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 + +felderimanwahlmenueTHEN aktfeldnr:=savefeldnr;neuenmenuepunktgefunden:=TRUE ; +LEAVE sucheneuenmenuepunktFI ELSE IF aktfeldnrfields(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 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 + -- cgit v1.2.3