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/name conversion.dos | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) create mode 100644 app/baisy/2.2.1-schulis/src/name conversion.dos (limited to 'app/baisy/2.2.1-schulis/src/name conversion.dos') 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; + -- cgit v1.2.3