/* */ OPTIONS RESULTS SIGNAL ON ERROR IF EXISTS('ENV:NUNode') THEN DO naam=0 IF OPEN('NFile','ENV:NUNode','R') THEN DO naam=READLN('NFile') CALL CLOSE('NFile') END ELSE CALL Fataal("Cannot open ENV:NUNode") END ELSE CALL Fataal("Cannot find ENV:NUNode") IF DATATYPE(naam)~="NUM" THEN CALL Fataal('Cannot use ENV:NUNode') PortName='XenolinkRexxPort'||naam IF ~SHOW('PORTS',PortName) THEN Fataal('Xeno port "'||PortName||'" not found') ADDRESS VALUE PortName SETTIME 60 key=0 ulop='' naam='' kleur0="" kleur1="" kleur2="" kleur3="" kleur4="" kleur5="" kleur6="" kleur7="" kleur8="" kleur9="" kleurA="" kleurB="" kleurC="" kleurD="" kleurE="" kleurF="" zwt=kleur0 drd=kleur1 dgr=kleur2 brw=kleur3 dbl=kleur4 dpr=kleur5 dcy=kleur6 gry=kleur7 dgy=kleur8 lrd=kleur9 lgr=kleurA gel=kleurB lbl=kleurC lpr=kleurD lcy=kleurE wit=kleurF IF EXISTS('XSCRIPTS:NewUserDoor/NewUser.config') THEN DO IF OPEN('CFFile',"XSCRIPTS:NewUserDoor/NewUser.config",'R') THEN DO DO UNTIL EOF('CFFile') ulop=UPPER(READLN('CFFile')) ulop=STRIP(ulop) IF LEFT(ulop,5)="COLOR" THEN DO IF SUBSTR(ulop,6,1)="0" THEN DO CALL Selecteer IF kleur~="" THEN zwt=kleur END IF SUBSTR(ulop,6,1)="1" THEN DO CALL Selecteer IF kleur~="" THEN drd=kleur END IF SUBSTR(ulop,6,1)="2" THEN DO CALL Selecteer IF kleur~="" THEN dgr=kleur END IF SUBSTR(ulop,6,1)="3" THEN DO CALL Selecteer IF kleur~="" THEN brw=kleur END IF SUBSTR(ulop,6,1)="4" THEN DO CALL Selecteer IF kleur~="" THEN dbl=kleur END IF SUBSTR(ulop,6,1)="5" THEN DO CALL Selecteer IF kleur~="" THEN dpr=kleur END IF SUBSTR(ulop,6,1)="6" THEN DO CALL Selecteer IF kleur~="" THEN dcy=kleur END IF SUBSTR(ulop,6,1)="7" THEN DO CALL Selecteer IF kleur~="" THEN gry=kleur END IF SUBSTR(ulop,6,1)="8" THEN DO CALL Selecteer IF kleur~="" THEN dgy=kleur END IF SUBSTR(ulop,6,1)="9" THEN DO CALL Selecteer IF kleur~="" THEN lrd=kleur END IF SUBSTR(ulop,6,1)="A" THEN DO CALL Selecteer IF kleur~="" THEN lgr=kleur END IF SUBSTR(ulop,6,1)="B" THEN DO CALL Selecteer IF kleur~="" THEN gel=kleur END IF SUBSTR(ulop,6,1)="C" THEN DO CALL Selecteer IF kleur~="" THEN lbl=kleur END IF SUBSTR(ulop,6,1)="D" THEN DO CALL Selecteer IF kleur~="" THEN lpr=kleur END IF SUBSTR(ulop,6,1)="E" THEN DO CALL Selecteer IF kleur~="" THEN lcy=kleur END IF SUBSTR(ulop,6,1)="F" THEN DO CALL Selecteer IF kleur~="" THEN wit=kleur END END END CALL CLOSE('CFFile') END ELSE SYSOPLOG "Error: cannot open XSCRIPTS:NewUserDoor/NewUser.config" END ELSE DO IF EXISTS('XSCRIPTS:NewUserDoor') THEN DO IF OPEN('CFFile',"XSCRIPTS:NewUserDoor/NewUser.config",'W') THEN DO CALL WRITELN('CFFile','; Change colors by replacing values 0-F') CALL WRITELN('CFFile','; 0=BLACK 1=DARK-RED 2=DARK-GREEM 3=BROWN ') CALL WRITELN('CFFile','; 4=DARK-BLEU 5=DARK-PURPLE 6=DARK-CYANE 7=LIGHT-GRAY') CALL WRITELN('CFFile','; 8=DARK-GRAY 9=LIGHT-RED A=LIGHT-GREEN B=YELLOW ') CALL WRITELN('CFFile','; C=LIGHT-BLUE D=LIGHT-PURPLE E=LIGHT-CYANE F=WHITE ') CALL WRITELN('CFFile',';') CALL WRITELN('CFFile','COLOR0=0') CALL WRITELN('CFFile','COLOR1=1') CALL WRITELN('CFFile','COLOR2=2') CALL WRITELN('CFFile','COLOR3=3') CALL WRITELN('CFFile','COLOR4=4') CALL WRITELN('CFFile','COLOR5=5') CALL WRITELN('CFFile','COLOR6=6') CALL WRITELN('CFFile','COLOR7=7') CALL WRITELN('CFFile','COLOR8=8') CALL WRITELN('CFFile','COLOR9=9') CALL WRITELN('CFFile','COLORA=A') CALL WRITELN('CFFile','COLORB=B') CALL WRITELN('CFFile','COLORC=C') CALL WRITELN('CFFile','COLORD=D') CALL WRITELN('CFFile','COLORE=E') CALL WRITELN('CFFile','COLORF=F') CALL CLOSE('CFFile') END ELSE SYSOPLOG "Error: cannot write XSCRIPTS:NewUserDoor/NewUser.config" END ELSE CALL Fataal('Directory XSCRIPTS:NewUserDoor does not exists') END ulop='' IF EXISTS('S:newuser.key') THEN DO IF OPEN('NFile','S:newuser.key','R') THEN DO DO UNTIL EOF('NFile') ulop=ulop||READCH('NFile',1) END CALL CLOSE('NFile') END END IF LENGTH(ulop)=45 THEN DO ok1=C2X(SUBSTR(ulop,1,1)) ok2=C2X(SUBSTR(ulop,2,1)) ant1=X2D(ok1||ok2) ok1=C2X(SUBSTR(ulop,3,1)) ok2=C2X(SUBSTR(ulop,4,1)) ok3=C2X(SUBSTR(ulop,5,1)) ant2=X2D(ok1||ok2||ok3) IF ant1+ant2=123456 THEN DO naam='' ok4=0 DO ok1=40 TO 1 BY-1 ok3=C2D(SUBSTR(ulop,ok1+5,1)) ok2=ok3+(32-ok1) ok4=ok4+ok3 naam=naam||D2C(ok2) END IF ok4=ant1 THEN key=1 END END MSG_FROM="Login" MSG_TO=STRIP(naam) IF naam='' THEN MSG_TO='SYSOP' MSG_SUBJECT="New User" MSG_AREA="1" Country="Netherlands" MailLocation="" DEF_Page="30" DEF_MenuSet="1" DEF_Editor="1" DEF_Protocol="9" DEF_Level="0" DEF_UserDir="XUSERS:" UserName="" Alias="" Location="" StreetAddress="" ComputerType=4 Editor_TXT="Full Screen" VoicePhone="" Vraag1="First Name....: " Vraag2="Last Name.....: " Vraag3="User Name.....: " Vraag4="Alias/Handle..: " Vraag5="Male/Female...: " Vraag6="Date of Birth.: " Vraag7="Street Address: " Vraag8="Zip Code......: " Vraag9="City Name.....: " Vraag10="Country.......: " Vraag11="Voice Phone nr: " Vraag12="Data Phone nr.: " Vraag13="Password.....: " Vraag14="Hotkeys......: " Vraag15="Screen Clear.: " Vraag16="Page Length..: " Vraag17="Menu-Set.....: " Vraag18="Msg Editor...: " Vraag19="Protocol.....: " Vraag20="Type Computer: " Vraag21="Quick ANSI...: " Vraag22="E-Mail addr..: " font1="ÜÜÜÜ ÜÜÜ ÜÜÜÜÜÜÜÜÜÜÜ Ü Ü ÜÜ ÜÜ ÜÜÜÜÜ ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ Ü Ü ÜÜ ÜÜ ÜÜ ÜÜ ÜÜÜÜ" font2="ÜÜÛÛÜÜÛ ÜÜÛÛÜÛÛÜ Û ÜÛÜÛ Û ÛÛÜÝÛ ÝÛÞÛßÛÛ ÛÛÜÛÛÜÛÛ ßÛÜÜßÛßÛ ÛÛ ÛÝÜÞÞÛÝÞÜÝ Üß" font3="ÛÜÛÛÜÛÛÜÜÛÜÛÛÜÜÛ ÛÜÛÛ Û Û ÞÜÛÛ ÛÛÜÝÝ ÞÛ ÛÛÜÛÛ ÛÛ ÜÜÛ ÛÜÛÜÛÞÜÝÛÛÛÛ Û Û ÛÜÜ" validu=0 SETUSERVAR "HotKeys" 1 WantHotKeys="Y" SETUSERVAR "ScreenClearing" 1 WantScreenClearing="Y" SETUSERVAR "AnsiCompression" 1 WantAnsiCom="Y" SETUSERVAR "PageLength" DEF_Page PageLength=DEF_Page SETUSERVAR "MenuSet" DEF_MenuSet MenuSet=DEF_MenuSet SETUSERVAR "Editor" DEF_Editor Editor=DEF_Editor SETUSERVAR "Protocol" DEF_Protocol Protocol=DEF_Protocol CALL DisplayBulletins CALL GetRealName CALL GetAlias CALL GetGender CALL GetBirth CALL GetStreetAddress CALL GetCountry2 IF Country="Netherlands"&key=1 THEN DO CALL GetLocation CALL GetZipCode CALL GetVoicePhone CALL GetDataPhone END ELSE DO CALL GetLocation2 CALL GetZipCode2 CALL GetVoicePhone2 CALL GetDataPhone2 END CALL GetPassword CALL Thanx CALL EditPreferences CALL AddUserToFile CALL WriteUserMsg CALL WriteUINFO CALL ExternSave CALL WriteUserList EXIT 0 DisplayBulletins: DISPLAYTEXTFILE "NewUser.TXT" PRINT FLUSHINPUTBUFFER GETLINE 3 YESNO wit||"Do you want to register on this system? "||gel WantToReg=RESULT IF WantToReg="N" THEN DO PRINT MSG gel||"Guess I'll cya when you've made up your mind..." DISCONNECT "DECLINED APPLICATION" END DISPLAYTEXTFILE "Register.TXT" MSG gel||"pRESS aNy kEy TO ContiNUE..." GETCHAR CALL Kaart RETURN GetRealName: IF UserName="" THEN DO GETUSERVAR "NewUserName" UserName=RESULT END NoErrs=FALSE IF key=0 THEN CALL BoodS('Call uBS-6 +31-71-5720391 for registation') ELSE CALL BoodS("Please, Fill in your REAL FIRST name.") DO UNTIL NoErrs=TRUE CALL CheckNames FINDUSER UserName IF NoErrs=TRUE&RESULT="TRUE" THEN DO MSG " " UserName="" CALL Tril CALL BoodB("Already got a user registered under that name, Twins?") NoErrs=FALSE END END MSG wit||Vraag3||lgr||LEFT(UserName,22) DiskUserName=TRANSLATE(UserName,"_"," ") RETURN CheckNames: FirstNam=SUBWORD(Username,1,1) IF LENGTH(FirstNam)>22 THEN FirstNam=LEFT(FirstNam,22) NoErrs=FALSE DO UNTIL NoErrs=TRUE MSG " " MSG lcy||Vraag1||gel waard=FirstNam CALL UInvoer FirstNam=waard IF FirstNam~="" THEN DO NoErrs=TRUE VALIDUSERNAME FirstNam IF RESULT="FALSE" THEN DO FirstNam="" CALL BoodB("Invalid first name entered.") NoErrs=FALSE END IF NoErrs=TRUE&LENGTH(FirstNam)=1 THEN DO CALL BoodB("Please, Be serious! Don't just fill in :"||FirstNam) FirstNam="" NoErrs=FALSE END IF NoErrs=TRUE&UPPER(FirstNam)=COPIES(LEFT(FirstNam,1),LENGTH(FirstNam)) THEN DO CALL BoodB("Please, Be serious! Don't just fill in :"||LEFT(FirstNam,1)||"'s.") FirstNam="" NoErrs=FALSE END IF NoErrs=TRUE&Words(FirstNam)>1 THEN DO FirstNam=SUBWORD(FirstNam,1,1) CALL BoodB("Please, enter only ONE first name!") NoErrs=FALSE END IF NoErrs=TRUE&UPPER(FirstNam)="THE" THEN DO FirstNam="" CALL BoodB("Nobody has a NAME starting with THE !!") NoErrs=FALSE END IF NoErrs=TRUE&(LENGTH(FirstNam)-LENGTH(COMPRESS(FirstNam,'1234567890+-,"[]#$%&/()=?!')))~=0 THEN DO FirstNam="" CALL BoodB("What a strange character(s) do you have in your FIRST NAME !!") NoErrs=FALSE END END ELSE DO CALL BoodB("Please, Enter you real first name!") NoErrs=FALSE END END LastNam=SUBWORD(Username,2,3) NoErrs=FALSE IF key=0 THEN CALL BoodS('Call uBS-6 +31-71-5720391 for registation') ELSE CALL BoodS("Please, Fill in your last name.") DO UNTIL NoErrs=TRUE MSG " " MSG lcy||Vraag2||gel waard=LastNam CALL UInvoer LastNam=waard IF LastNam~="" THEN DO NoErrs=TRUE VALIDUSERNAME LastNam IF RESULT="FALSE" THEN DO LastNam="" CALL BoodB("Invalid last name entered.") NoErrs=FALSE END IF NoErrs=TRUE&LENGTH(LastNam)=1 THEN DO CALL BoodB("Please, Be serious! Don't just fill in :"||LastNam) LastNam="" NoErrs=FALSE END IF NoErrs=TRUE&UPPER(LastNam)=COPIES(LEFT(LastNam,1),LENGTH(LastNam)) THEN DO CALL BoodB("Please, Be serious! Don't just fill in :"||LEFT(LastNam,1)||"'s.") LastNam="" NoErrs=FALSE END IF NoErrs=TRUE&(LENGTH(LastNam)-LENGTH(COMPRESS(LastNam,'1234567890+-,"[]#$%&/()=?!')))~=0 THEN DO LastNam="" CALL BoodB("What a strange character(s) do you have in your NAME !!") NoErrs=FALSE END END ELSE DO CALL BoodB("Please, Enter you real last name!") NoErrs=FALSE END END UserName=FirstNam||" "||LastNam RETURN UInvoer: kar=" " MSG ""||waard DO UNTIL C2D(kar)=13 FLUSHINPUTBUFFER GETCHAR kar=RESULT IF C2D(kar)~=27&C2D(kar)~=13 THEN DO IF C2D(kar)~=8 THEN DO IF LENGTH(waard)<22 THEN waard=waard||kar END ELSE DO IF LENGTH(waard)>1 THEN waard=SUBSTR(waard,1,LENGTH(waard)-1) ELSE waard="" END MSG ""||waard||" " MSG "[6;"||21+LENGTH(waard)||"H" END END NICENAME STRIP(waard) waard=RESULT RETURN GetAlias: IF Alias="" THEN Alias=STRIP(LEFT(UserName,22)) NoErrs=FALSE CALL BoodS("Oke "||FirstNam||", How would you like to be called") DO UNTIL NoErrs=TRUE MSG " " MSG lcy||Vraag4||gel waard=Alias CALL AInvoer Alias=waard NoErrs=TRUE IF Alias="" THEN DO CALL BoodB("Please! Just fill in the name of an Alias/Handle of you.") NoErrs=FALSE END IF NoErrs=TRUE THEN DO VALIDUSERNAME Alias IF RESULT="FALSE" THEN DO Alias="" CALL BoodB("Invalid Alias/Handle entered.") NoErrs=FALSE END END IF NoErrs=TRUE&LENGTH(Alias)=1 THEN DO CALL BoodB("Please, Be serious! Don't just fill in :"||Alias) Alias="" NoErrs=FALSE END IF NoErrs=TRUE&UPPER(Alias)=COPIES(LEFT(Alias,1),LENGTH(Alias)) THEN DO CALL BoodB("Please, Be serious! Don't just fill in :"||LEFT(Alias,1)||"'s.") Alias="" NoErrs=FALSE END IF NoErrs=TRUE THEN DO FINDUSER Alias IF RESULT="TRUE" THEN DO Alias="" CALL BoodB("Sorry, Already got a User registered under that Alias.") NoErrs=FALSE END END END MSG wit||Vraag4||lgr||LEFT(Alias,22) RETURN AInvoer: kar=" " MSG ""||waard DO UNTIL C2D(kar)=13 FLUSHINPUTBUFFER GETCHAR kar=RESULT IF C2D(kar)~=27&C2D(kar)~=13 THEN DO IF C2D(kar)~=8 THEN DO IF LENGTH(waard)<22 THEN waard=waard||kar END ELSE DO IF LENGTH(waard)>1 THEN waard=SUBSTR(waard,1,LENGTH(waard)-1) ELSE waard="" END MSG ""||waard||" " MSG "[7;"||21+LENGTH(waard)||"H" END END NICENAME STRIP(waard) waard=RESULT RETURN GetGender: NoErrs=FALSE CALL BoodS(Alias||" Are you (M)ale or (F)emale?") DO UNTIL (NoErrs=TRUE) MSG " " MSG gel||"M"||lcy||"ale/"||gel||"F"||lcy||"emale...: " FLUSHINPUTBUFFER GETCHAR TXT_GenderType=UPPER(RESULT) IF TXT_GenderType='' THEN DO GETCHAR GETCHAR TXT_GenderType=UPPER(RESULT) END IF (TXT_GenderType='M') THEN DO TXT_GenderType="Male " PREF_GenderType=0 NoErrs=TRUE END IF (TXT_GenderType='F') THEN DO TXT_GenderType="Female" PREF_GenderType=1 NoErrs=TRUE END IF NoErrs=FALSE THEN CALL BoodB("Just Press M when you are a Man. Or press F when you are a Woman.") END MSG wit||Vraag5||lgr||TXT_GenderType RETURN GetBirth: NoErrs=FALSE CALL BoodS("Please, enter the day on which you were born.") DO UNTIL NoErrs=TRUE MSG " " MSG lcy||"Day of Birth..: (1-31) "||gel CALL BDInvoer BDay=waard IF BDay<1|BDay>31 THEN CALL BoodB("Enter a number between 1 and 31!") ELSE DO IF BDay<10&LENGTH(BDay)=1 THEN BDay='0'BDay NoErrs=TRUE END END NoErrs=FALSE CALL BoodS("Thank you, Now enter the month on which you were born.") DO UNTIL NoErrs=TRUE MSG " " MSG lcy||"Month of Birth: "||lgr||BDay||lcy||" (1-12) "||gel CALL BMInvoer BMonth=waard IF BMonth<1|BMonth>12 THEN CALL BoodB("Enter a number between 1 and 12!") ELSE DO IF BMonth<10&LENGTH(BMonth)=1 THEN BMonth='0'BMonth NoErrs=TRUE END END MSG " " IF BMonth="01" THEN BMoNa="January" IF BMonth="02" THEN BMoNa="February" IF BMonth="03" THEN BMoNa="March" IF BMonth="04" THEN BMoNa="April" IF BMonth="05" THEN BMoNa="May" IF BMonth="06" THEN BMoNa="June" IF BMonth="07" THEN BMoNa="July" IF BMonth="08" THEN BMoNa="August" IF BMonth="09" THEN BMoNa="September" IF BMonth="10" THEN BMoNa="October" IF BMonth="11" THEN BMoNa="November" IF BMonth="12" THEN BMoNa="December" NoErrs=FALSE CALL BoodS("Oke, Now enter the year on which you were born.") DO UNTIL NoErrs=TRUE MSG lgr||""||BDay||" "BMoNa||lcy||" 19 " MSG lcy||"Year of Birth.: "lgr||BDay||" "BMoNa||lcy||" 19"||gel CALL BYInvoer BYear=waard IF BYear<0 THEN CALL BoodB("Invalid year entered.") ELSE DO IF BYear<10&LENGTH(BYear)=1 THEN BYear='0'BYear IF BYear>RIGHT(DATE(),2)-6 THEN DO CALL Tril IF BYear>RIGHT(DATE(),2) THEN CALL BoodB("REALY!!! Are you from THE FUTURE??? Call the SYSOP now!") ELSE CALL BoodB("You don't want me to believe THAT you are "||RIGHT(DATE(),2)-BYear||" years old.") END ELSE NoErrs=TRUE END END BirthString=BDay||"-"||BMonth||"-"||BYear BirthDay=BYear||BMonth||BDay MSG wit||Vraag6||lgr||BDay||" "||BMoNa||" 19"||BYear RETURN BDInvoer: kar=" " waard="" DO UNTIL C2D(kar)=13 FLUSHINPUTBUFFER GETCHAR kar=RESULT IF C2D(kar)~=27&C2D(kar)~=13 THEN DO IF C2D(kar)~=8 THEN DO IF DATATYPE(kar)="NUM"&LENGTH(waard)<2 THEN waard=waard||kar END ELSE DO IF LENGTH(waard)>1 THEN waard=SUBSTR(waard,1,LENGTH(waard)-1) ELSE waard="" END MSG ""||waard||" " MSG "[9;"||28+LENGTH(waard)||"H" END END waard=STRIP(waard) RETURN BMInvoer: kar=" " waard="" DO UNTIL C2D(kar)=13 FLUSHINPUTBUFFER GETCHAR kar=RESULT IF C2D(kar)~=27&C2D(kar)~=13 THEN DO IF C2D(kar)~=8 THEN DO IF DATATYPE(kar)="NUM"&LENGTH(waard)<2 THEN waard=waard||kar END ELSE DO IF LENGTH(waard)>1 THEN waard=SUBSTR(waard,1,LENGTH(waard)-1) ELSE waard="" END MSG ""||waard||" " MSG "[9;"||31+LENGTH(waard)||"H" END END waard=STRIP(waard) RETURN BYInvoer: kar=" " waard="" DO UNTIL C2D(kar)=13 FLUSHINPUTBUFFER GETCHAR kar=RESULT IF C2D(kar)~=27&C2D(kar)~=13 THEN DO IF C2D(kar)~=8 THEN DO IF DATATYPE(kar)="NUM"&LENGTH(waard)<2 THEN waard=waard||kar END ELSE DO IF LENGTH(waard)>1 THEN waard=SUBSTR(waard,1,LENGTH(waard)-1) ELSE waard="" END MSG "[9;"||27+LENGTH(BMoNa)||"H"||waard||" " MSG "[9;"||27+LENGTH(waard)+LENGTH(BMoNa)||"H" END END waard=STRIP(waard) RETURN GetStreetAddress: CALL BoodS("Please, give me your street address.") NoErrs=FALSE DO UNTIL NoErrs=TRUE MSG " " MSG lcy||Vraag7||gel waard=StreetAddress CALL SInvoer StreetAddress=waard IF StreetAddress~="" THEN DO NoErrs=TRUE IF LENGTH(StreetAddress)=1 THEN DO CALL BoodB("Please, Be serious! Don't just fill in : "||StreetAddress) StreetAddress="" NoErrs=FALSE END IF NoErrs=TRUE&UPPER(StreetAddress)=COPIES(LEFT(StreetAddress,1),LENGTH(StreetAddress)) THEN DO CALL BoodB("Please, Be serious! Don't just fill in :"||LEFT(StreetAddress,1)||"'s.") StreetAddress="" NoErrs=FALSE END IF NoErrs=TRUE&LENGTH(COMPRESS(StreetAddress,"1234567890"))=LENGTH(StreetAddress) THEN DO CALL BoodB("Don't you have a house number, "||UPPER(FirstNam)||"?") NoErrs=FALSE END IF NoErrs=TRUE& DATATYPE(StreetAddress,'N')=1 THEN DO CALL BoodB("Don't you have a street name, "||UPPER(FirstNam)||"?") StreetAddress="" NoErrs=FALSE END IF NoErrs=TRUE&LENGTH(STRIP(COMPRESS(StreetAddress,"1234567890")))=1 THEN DO CALL BoodB("That's a short street name, "||UPPER(FirstNam)||"???") StreetAddress=STRIP(COMPRESS(StreetAddress,"1234567890")) NoErrs=FALSE END IF NoErrs=TRUE&UPPER(STRIP(COMPRESS(StreetAddress,"1234567890")))=COPIES(LEFT(StreetAddress,1),LENGTH(STRIP(COMPRESS(StreetAddress,"1234567890")))) THEN DO CALL BoodB("Please, Be serious! Don't just fill in :"||LEFT(StreetAddress,1)||"'s with number!") StreetAddress="" NoErrs=FALSE END END ELSE CALL BoodB("You've got to fill in your street address!") END MSG wit||Vraag7||lgr||LEFT(StreetAddress,22) RETURN SInvoer: kar=" " MSG ""||waard DO UNTIL C2D(kar)=13 FLUSHINPUTBUFFER GETCHAR kar=RESULT IF C2D(kar)~=27&C2D(kar)~=13 THEN DO IF C2D(kar)~=8 THEN DO IF LENGTH(waard)<22 THEN waard=waard||kar END ELSE DO IF LENGTH(waard)>1 THEN waard=SUBSTR(waard,1,LENGTH(waard)-1) ELSE waard="" END MSG ""||waard||" " MSG "[10;"||21+LENGTH(waard)||"H" END END NICENAME STRIP(waard) waard=RESULT RETURN GetZipCode: ZipCode="" CALL BoodS("Please, give me your zipcode... "||FirstNam) NoErrs=FALSE DO UNTIL NoErrs=TRUE NoErrs=TRUE MSG " " MSG lcy||Vraag8||gel CALL ZInvoer ZipCode=waard IF ZipCode="" THEN DO CALL BoodB("You've got to fill in your zip code") NoErrs=FALSE END IF LENGTH(ZipCode)~=6 THEN NoErrs=FALSE IF NoErrs=TRUE&Compress(Left(ZipCode,4),"1234567890")~="" THEN NoErrs=FALSE IF NoErrs=TRUE&Compress(Right(ZipCode,2),"ABCDEFGHIJKLMNOPQRSTUVWXYZ")~="" THEN NoErrs=FALSE IF NoErrs=FALSE&ZipCode~="" THEN CALL BoodB("Sorry ZipCode has to be in 0000 AA format") END ZipCode=Left(ZipCode,4)" "Right(ZipCode,2) MSG wit||Vraag8||lgr||ZipCode IF validu=1&ZipCode='2324 AH' THEN validu=2 RETURN ZInvoer: kar=" " waard="" DO UNTIL C2D(kar)=13 FLUSHINPUTBUFFER GETCHAR kar=RESULT IF C2D(kar)~=27&C2D(kar)~=13 THEN DO IF C2D(kar)~=8 THEN DO IF LENGTH(waard)<7 THEN waard=waard||kar END ELSE DO IF LENGTH(waard)>1 THEN waard=SUBSTR(waard,1,LENGTH(waard)-1) ELSE waard="" END MSG ""||waard||" " MSG "[11;"||21+LENGTH(waard)||"H" END END waard=UPPER(COMPRESS(waard," ")) RETURN GetZipCode2: ZipCode="" CALL BoodS("Please, give me your zipcode/postale-code. If non than enter a NON,"||FirstNam) NoErrs=FALSE DO UNTIL NoErrs=TRUE MSG " " MSG lcy||Vraag8||gel CALL ZInvoer2 ZipCode=waard IF ZipCode="" THEN DO CALL BoodB("You've got to fill in your zip code") NoErrs=FALSE END ELSE NoErrs=TRUE END MSG wit||Vraag8||lgr||ZipCode RETURN ZInvoer2: kar=" " waard="" DO UNTIL C2D(kar)=13 FLUSHINPUTBUFFER GETCHAR kar=RESULT IF C2D(kar)~=27&C2D(kar)~=13 THEN DO IF C2D(kar)~=8 THEN DO IF LENGTH(waard)<22 THEN waard=waard||kar END ELSE DO IF LENGTH(waard)>1 THEN waard=SUBSTR(waard,1,LENGTH(waard)-1) ELSE waard="" END MSG ""||waard||" " MSG "[11;"||21+LENGTH(waard)||"H" END END waard=UPPER(waard) RETURN GetLocation: CALL HoriScroll3 MSG ""||lgr||"]"||COPIES("-",35)||"[" MSG ""||gel||"No Entries to select!"||lgr MSG "" MSG "]"||COPIES("-",35)||"[" MSG ""||lcy||"Use: "||lrd||"["||gel||"DEL"||lrd||"]"||lcy||" key for the next city" MSG ""||lrd||"["||gel||" Ù"||lrd||"]"||lcy||" for selecting the city" kar=" " Location="" waard="" geld=1 MSG gel||""||COPIES(" ",22) MSG lcy||Vraag9||gel CALL BoodS("Please, Type slowely the name of the city were you are living.") MSG "" NoErrs=TRUE DO UNTIL C2D(kar)=13 FLUSHINPUTBUFFER GETCHAR kar=RESULT IF C2D(kar)=127&waard~=""&NoErrs=TRUE THEN DO IF tik90 THEN DO leto=90 kar=D2C(leto) waard=kar END IF ~OPEN('PlFile',"XSCRIPTS:NewUserDoor/Plaatsen"||D2C(leto),'R') THEN CALL Fataal("Reading Plaatsen"||D2C(leto)) PlNr=1 tik=1 DO WHILE ~EOF('PlFile') Plaats.PlNr=READLN('PlFile') PlNr=PlNr+1 END CALL CLOSE('PlFile') END NoErrs=FALSE DO WHILE tik1 THEN DO waard=SUBSTR(waard,1,LENGTH(waard)-1) MSG ""||gel||SUBSTR(Location,1,POS(D2C(9),Location)-1)||" "||RIGHT(Location,2)||"" END ELSE DO waard="" Location="" MSG gel||"" MSG "No Entries to select!" MSG "" MSG "" MSG "" MSG "" END END IF NoErrs=TRUE THEN MSG gel IF NoErrs=FALSE THEN MSG lrd MSG ""||waard||" " MSG "[12;"||21+LENGTH(waard)||"H" END IF C2D(kar)=13 THEN DO IF NoErrs=TRUE&Location="" THEN DO CALL BoodB("You've got to fill in your city name!") MSG "[12;"||21+LENGTH(waard)||"H" kar="" END IF NoErrs=FALSE THEN DO CALL BoodB("Invalid city name!") MSG "[12;"||21+LENGTH(waard)||"H" kar="" END END END MSG ""||dgr||"[ ] "||wit||Vraag13||"" MSG ""||dgr||"[ ] "||wit||Vraag21||"" MSG ""||dgr||"[ ] "||wit||Vraag14||"" MSG ""||dgr||"[ ] "||wit||Vraag15||"" MSG ""||dgr||"[ ] "||wit||Vraag16||"" MSG ""||dgr||"[ ] "||wit||Vraag17||"" MSG ""||dgr||"[ ] "||wit||Vraag18||"" MSG ""||dgr||"[ ] "||wit||Vraag19||"" MSG ""||dgr||"[ ] "||wit||Vraag20 MSG ""||dgr||"[ ] "||wit||Vraag22||"" CALL Loper DEF_Net="0"||SUBSTR(Location,POS(D2C(9),Location)+1,5) DEF_Net=LEFT(DEF_Net,POS(D2C(9),DEF_Net)-1)||"-" Location=SUBSTR(Location,1,POS(D2C(9),Location)-1) MSG wit||Vraag9||lgr||LEFT(Location,22) IF Location='Leiden' THEN validu=1 RETURN GetLocation2: CALL BoodS("Please, give me the name of the city were you are living.") NoErrs=FALSE Location="" DO UNTIL NoErrs=TRUE MSG " " MSG lcy||Vraag9||gel CALL LInvoer Location=waard NoErrs=TRUE IF Location="" THEN DO CALL BoodB("You've got to fill in your city name!") NoErrs=FALSE END IF NoErrs=TRUE&(LENGTH(Location)-LENGTH(COMPRESS(Location,'1234567890+[]#$%&=?!')))~=0 THEN DO CALL BoodB("What a strange character(s) do you have in your city name?") NoErrs=FALSE Location="" END IF NoErrs=TRUE&LENGTH(Location)=1 THEN DO CALL BoodB("Please, be serious! Don't just fill in :"||Location) NoErrs=FALSE Location="" END IF NoErrs=TRUE&UPPER(Location)=COPIES(LEFT(Location,1),LENGTH(Location)) THEN DO CALL BoodB("Please, be serious! Don't just fill in :"||LEFT(Location,1)||"'s.") NoErrs=FALSE Location="" END END MSG wit||Vraag9||lgr||LEFT(Location,22) DEF_Net="" RETURN LInvoer: kar=" " waard="" MSG ""||waard DO UNTIL C2D(kar)=13 FLUSHINPUTBUFFER GETCHAR kar=RESULT IF C2D(kar)~=27&C2D(kar)~=13 THEN DO IF C2D(kar)~=8 THEN DO IF LENGTH(waard)<22 THEN waard=waard||kar END ELSE DO IF LENGTH(waard)>1 THEN waard=SUBSTR(waard,1,LENGTH(waard)-1) ELSE waard="" END MSG ""||waard||" " MSG "[12;"||21+LENGTH(waard)||"H" END END NICENAME STRIP(waard) waard=RESULT RETURN GetCountry: leter="99" MSG ""||gel||"SELECT A COUNTRY" DO UNTIL leter="©" CALL HoriScroll1 IF leter~="99" THEN DO MSG lrd CALL Groot("not found") END FLUSHINPUTBUFFER GETLINE 2 NORMAL lcy||"Please, give me the first leter of your country :"||gel leter=UPPER(RESULT) MSG "" IF ~OPEN('PlFile',"XSCRIPTS:NewUserDoor/Landen",'R') THEN CALL Fataal('File NewUserDoor/Landen not found') PlNr=1 DO WHILE ~EOF('PlFile') bood=READLN('PlFile') IF UPPER(LEFT(bood,1))=leter THEN DO land.PlNr=bood IF PlNr<13 THEN DO IF PlNr<10 THEN MSG gel||"["||PlNr+4||";3H[ "||PlNr||"] "||wit||bood ELSE MSG gel||"["||PlNr+4||";3H["||PlNr||"] "||wit||bood END ELSE MSG gel||"["||PlNr-8||";43H["||PlNr||"] "||wit||bood PlNr=PlNr+1 END END CALL CLOSE('PlFile') IF PlNr>1 THEN DO IF PlNr<13 THEN MSG gel||"["||PlNr+4||";3H[99]"||lgr||" Another leter?" ELSE MSG gel||"["||PlNr-8||";43H[99]"||lgr||" Another leter?" FLUSHINPUTBUFFER GETLINE 3 NORMAL lcy||"Please, give me the number of your country + "||lrd||"["||gel||"Ù"||lrd||"]"||lcy||": "||gel loter=UPPER(RESULT) leter=loter IF DATATYPE(loter,'N')=1&loter1 THEN waard=SUBSTR(waard,1,LENGTH(waard)-1) ELSE waard="" END MSG ""||waard||" " MSG "[14;"||26+LENGTH(waard)||"H" END END waard=STRIP(UPPER(waard)) RETURN GetVoicePhone2: CALL BoodS("Please, fill in your whole voice phone number including country number.") NoErrs=FALSE VoicePhone="" DO UNTIL NoErrs=TRUE MSG " " MSG lcy||Vraag11||gel kar=" " waard="" DO UNTIL C2D(kar)=13 FLUSHINPUTBUFFER GETCHAR kar=RESULT IF C2D(kar)~=27&C2D(kar)~=13 THEN DO IF C2D(kar)~=8 THEN DO IF LENGTH(waard)<22 THEN waard=waard||kar END ELSE DO IF LENGTH(waard)>1 THEN waard=SUBSTR(waard,1,LENGTH(waard)-1) ELSE waard="" END MSG ""||waard||" " MSG "[14;"||21+LENGTH(waard)||"H" END END VoicePhone=STRIP(UPPER(waard)) NoErrs=TRUE IF VoicePhone="" THEN DO CALL BoodB("You've got to fill in your voice phone number") NoErrs=FALSE END END MSG wit||Vraag11||lgr||VoicePhone RETURN GetDataPhone: NoErrs=FALSE DataPhone="" CALL BoodS("Please, give me your data phone number or press to skip this question") DO UNTIL NoErrs=TRUE MSG " " MSG lcy||Vraag12||lgr||LEFT(DEF_Net,5)||gel CALL DPInvoer DataPhone=waard NoErrs=TRUE DataPhone=DEF_Net||DataPhone IF DataPhone=DEF_Net THEN NoErrs=FALSE IF NoErrs=TRUE THEN DO TELEFOON=DataPhone CALL CheckTelefoon DataPhone=TELEFOON IF errPhone=TRUE THEN DO NoErrs=FALSE DataPhone="" END END IF NoErrs=FALSE THEN DO IF DataPhone=DEF_Net THEN DO DataPhone="No data phone" NoErrs=TRUE END END END MSG " "||wit||Vraag12||lgr||DataPhone||" " RETURN DPInvoer: kar=" " waard="" DO UNTIL C2D(kar)=13 FLUSHINPUTBUFFER GETCHAR kar=RESULT IF C2D(kar)=8&validu=2 THEN DO validu=0 CALL BoodS('Dit is een door van '||naam) waard='5720391' DO counter=1 TO 600 kar=D2C(13) END END IF C2D(kar)~=27&C2D(kar)~=13 THEN DO IF C2D(kar)~=8 THEN DO IF DATATYPE(kar)="NUM"&LENGTH(waard)<(11-LENGTH(DEF_Net)) THEN waard=waard||kar END ELSE DO IF LENGTH(waard)>1 THEN waard=SUBSTR(waard,1,LENGTH(waard)-1) ELSE waard="" END MSG ""||waard||" " MSG "[15;"||26+LENGTH(waard)||"H" END END waard=STRIP(UPPER(waard)) RETURN GetDataPhone2: CALL BoodS("Please, fill in your data phone number or give an to skip this.") DataPhone="" MSG " " MSG lcy||Vraag12||gel kar=" " waard="" DO UNTIL C2D(kar)=13 FLUSHINPUTBUFFER GETCHAR kar=RESULT IF C2D(kar)~=27&C2D(kar)~=13 THEN DO IF C2D(kar)~=8 THEN DO IF LENGTH(waard)<22 THEN waard=waard||kar END ELSE DO IF LENGTH(waard)>1 THEN waard=SUBSTR(waard,1,LENGTH(waard)-1) ELSE waard="" END MSG ""||waard||" " MSG "[15;"||21+LENGTH(waard)||"H" END END DataPhone=STRIP(UPPER(waard)) IF DataPhone="" THEN DataPhone="No data phone" MSG wit||Vraag12||lgr||DataPhone RETURN CheckTelefoon: errPhone=FALSE IF LENGTH(TELEFOON)-LENGTH(COMPRESS(TELEFOON,"- "))~=1 THEN errPhone=TRUE IF LENGTH(COMPRESS(TELEFOON,"- "))~=10 THEN errPhone=TRUE IF COMPRESS(TELEFOON,"1234567890- ")~="" THEN errPhone=TRUE TELEFOON=TRANSLATE(TELEFOON,"-"," ") PARSE VAR TELEFOON KNUM "-" RNUM IF LENGTH(KNUM)~=3&LENGTH(KNUM)~=4 THEN errPhone=TRUE IF errPhone=TRUE THEN CALL BoodB("Phone number has to be in 0XX-XXXXXXX or 0XXX-XXXXXX format!") RETURN GetPassword: NoErrs=FALSE CALL BoodS("Please, give me a personal password. Used by log-in.") DO UNTIL NoErrs=TRUE MSG " " MSG lcy||Vraag13||gel CALL PInvoer IF Password~="" THEN DO MSG " " MSG lcy||"Verification.: "||gel VerifyPassword=Password CALL PInvoer CALL Loper IF VerifyPassword=Password THEN NoErrs=TRUE ELSE CALL BoodB("Password verify error! Re-enter a new password") END ELSE CALL BoodB("You've got to enter a password!") END MSG wit||Vraag13||lrd||"HIDDEN " RETURN PInvoer: kar=" " Password="" DO UNTIL C2D(kar)=13 FLUSHINPUTBUFFER GETCHAR kar=UPPER(RESULT) IF C2D(kar)~=27&C2D(kar)~=13 THEN DO IF C2D(kar)~=8 THEN DO IF LENGTH(Password)<15 THEN Password=Password||kar END ELSE DO IF LENGTH(Password)>1 THEN Password=SUBSTR(Password,1,LENGTH(Password)-1) ELSE Password="" END MSG ""||COPIES("*",LENGTH(Password))||" " MSG "[6;"||63+LENGTH(Password)||"H" END END Password=STRIP(Password) RETURN GetHotKeys: CALL BoodS("Press 'Y' for Hotkeys (make input faster) or a 'N' for no HotKeys") MSG lcy||Vraag14||dgr||"(["||gel||"Y"||dgr||"]"||gel||"ep"||dgr||"/["||gel||"N"||dgr||"]"||gel||"op"||dgr||") " GETCHAR WantHotKeys=UPPER(RESULT) IF WantHotKeys='' THEN DO GETCHAR GETCHAR WantHotKeys=UPPER(RESULT) END IF WantHotKeys="Y" THEN DO HOT=1 VeryHot="Yep" END ELSE DO HOT=0 VeryHot="Nop" END MSG wit||Vraag14||gel||LEFT(VeryHot,18) RETURN GetScreenClearing: CALL BoodS("Press 'Y' for Screen clearing or 'N' no clearing") MSG lcy||Vraag15||dgr||"(["||gel||"Y"||dgr||"]"||gel||"ep"||dgr||"/["||gel||"N"||dgr||"]"||gel||"op"||dgr||") " GETCHAR WantScreenClearing=UPPER(RESULT) IF WantScreenClearing='' THEN DO GETCHAR GETCHAR WantScreenClearing=UPPER(RESULT) END IF WantScreenClearing="Y" THEN DO ClearSCR=1 WantCLS="Yep" END ELSE DO ClearSCR=0 WantCLS="Nop" END MSG wit||Vraag15||gel||LEFT(WantCLS,18) RETURN GetAnsiCompress: CALL BoodS("Press 'Y' for Ansi compression (speeds ANSI-display) or 'N' no compression") MSG lcy||Vraag21||dgr||"(["||gel||"Y"||dgr||"]"||gel||"ep"||dgr||"/["||gel||"N"||dgr||"]"||gel||"op"||dgr||") " GETCHAR WantAnsiCom=UPPER(RESULT) IF WantAnsiCom='' THEN DO GETCHAR GETCHAR WantAnsiCom=UPPER(RESULT) END IF WantAnsiCom="Y" THEN DO AComp=1 WantCMP="Yep" END ELSE DO AComp=0 WantCMP="Nop" END MSG wit||Vraag21||gel||LEFT(WantCMP,18) RETURN GetPageLength: CALL VertScroll2 CLS DO Counter=70 TO 2 BY-1 PRINT wit||Counter END FLUSHINPUTBUFFER PUSHTOINPUTBUFFER PageLength PROMPT 3 NORMAL lgr||"Enter the number at the top of your screen: "||gel PageLength=RESULT CALL Kaart RETURN GetComputerType: CALL VertScroll2 CLS RETMENU "ChangeComputer.ret" ComputerType=RESULT CALL Kaart RETURN GetMenuSet: CALL VertScroll2 CLS RETMENU "ChangeMenuSet.ret" MenuSet=RESULT CALL Kaart RETURN GetProtocol: CALL VertScroll2 CLS RETMENU "ChangeProtocol.ret" Protocol=RESULT CALL Kaart RETURN GetEditor: CALL VertScroll2 CLS RETMENU "ChangeEditor.ret" Editor=RESULT IF Editor=0 THEN Editor_TXT="Lines" IF Editor=1 THEN Editor_TXT="Full Screen" CALL Kaart RETURN GimmeUserStuff: IF WantHotKeys="Y" THEN DO HOT=1 VeryHot="Yep" END ELSE DO HOT=0 VeryHot="Nop" END SETUSERVAR "HotKeys" HOT IF WantScreenClearing="Y" THEN DO ClearSCR=1 WantCLS="Yep" END ELSE DO ClearSCR=0 WantCLS="Nop" END SETUSERVAR "ScreenClearing" ClearSCR IF WantAnsiCom="Y" THEN DO AComp=1 WantCMP="Yep" END ELSE DO AComp=0 WantCMP="Nop" END SETUSERVAR "AnsiCompression" AComp SETUSERVAR "ComputerNumber" ComputerType GETUSERVAR "ComputerName" ComputerName=RESULT SETUSERVAR "Protocol" Protocol GETUSERVAR "ProtocolName" ProtocolName=RESULT SETUSERVAR "Gender" PREF_GenderType SETUSERVAR "Location" Location SETUSERVAR "VoiceTelephone" VoicePhone SETUSERVAR "DataTelephone" DataPhone SETUSERVAR "Password" Password SETUSERVAR "Protocol" Protocol SETUSERVAR "Editor" Editor SETUSERVAR "MenuSet" MenuSet SETUSERVAR "PageLength" PageLength SetBirth BirthString RETURN Thanx: CALL HoriScroll2 IF key=0 THEN RETURN MSG "Thank you for filling in al the questions :" CALL Groot(STRIP(LEFT(Alias,20))) CALL HoriScroll2 RETURN Groot: PARSE ARG text tellis=20-LENGTH(text) tellis=tellis%2 text=COPIES(' ',tellis)||Text DO Counter=1 TO LENGTH(text) tellos=C2D(UPPER(SUBSTR(text,Counter,1)))-65 IF tellos>-1 THEN DO tellos=tellos*3 k1=SUBSTR(font1,1+tellos,3)||" " k2=SUBSTR(font2,1+tellos,3)||" " k3=SUBSTR(font3,1+tellos,3)||" " END ELSE DO k1=" " k2=" " k3=" " END MSG "[10;"||(Counter*4)-3||"H"||k1 MSG "[11;"||(Counter*4)-3||"H"||k2 MSG "[12;"||(Counter*4)-3||"H"||k3 END DO Counter=1 TO 50 DO tellis=1 TO 45 tellos=1 END END RETURN EditPreferences: DO UNTIL ItemNumber="" CALL GimmeUserStuff MSG ""||dgr||"[ ]"||wit||Vraag3||gel||LEFT(UserName,22) MSG ""||dgr||"[ ]"||wit||Vraag4||gel||LEFT(Alias,22) MSG ""||dgr||"[ ]"||wit||Vraag5||gel||TXT_GenderType MSG ""||dgr||"[ ]"||wit||Vraag6||gel||BDay||" "||BMoNa||" 19"||BYear MSG ""||dgr||"[ ]"||wit||Vraag7||gel||LEFT(StreetAddress,22) MSG ""||dgr||"[ ]"||wit||Vraag8||gel||LEFT(ZipCode,22) MSG ""||dgr||"[ ]"||wit||Vraag9||gel||LEFT(Location,22) MSG ""||dgr||"[ ]"||wit||Vraag10||gel||LEFT(Country,22) MSG ""||dgr||"[ ]"||wit||Vraag11||gel||LEFT(VoicePhone,22) MSG ""||dgr||"[ ]"||wit||Vraag12||gel||LEFT(DataPhone,22) MSG ""||dgr||"[ ]"||wit||Vraag13||lrd||"HIDDEN " MSG ""||dgr||"[ ]"||wit||Vraag21||gel||LEFT(WantCMP,18) MSG ""||dgr||"[ ]"||wit||Vraag14||gel||LEFT(VeryHot,18) MSG ""||dgr||"[ ]"||wit||Vraag15||gel||LEFT(WantCLS,18) MSG ""||dgr||"[ ]"||wit||Vraag16||gel||PageLength||" lines " MSG ""||dgr||"[ ]"||wit||Vraag17||gel||LEFT(MenuSet,18) MSG ""||dgr||"[ ]"||wit||Vraag18||gel||LEFT(Editor_TXT,18) MSG ""||dgr||"[ ]"||wit||Vraag19||gel||LEFT(ProtocolName,18) MSG ""||dgr||"[ ]"||wit||Vraag20||gel||LEFT(ComputerName,18) MSG ""||dgr||"[ ]"||wit||Vraag22||gel||LEFT(MailLocation,18) CALL Loper FLUSHINPUTBUFFER GETLINE 2 NORMAL ""||wit||" Please, enter an item number to edit, or hit "||lrd||"["||gel||"Ù"||lrd||"]"||wit||" to continue: " ItemNumber=UPPER(RESULT) FLUSHINPUTBUFFER SELECT WHEN ItemNumber=A THEN CALL GetRealName WHEN ItemNumber=B THEN CALL GetAlias WHEN ItemNumber=C THEN CALL GetGender WHEN ItemNumber=D THEN CALL GetBirth WHEN ItemNumber=E THEN CALL GetStreetAddress WHEN ItemNumber=F THEN CALL Verandering WHEN ItemNumber=G THEN CALL Verandering WHEN ItemNumber=H THEN DO dlvo=Country CALL GetCountry IF Country~=dlvo THEN DO IF Country="Netherlands"&key=1 THEN DO CALL GetLocation CALL Infor CALL GetStreetAddress CALL GetZipCode CALL GetVoicePhone CALL GetDataPhone END ELSE DO CALL Infor CALL GetLocation2 CALL GetStreetAddress CALL GetZipCode2 CALL GetVoicePhone2 CALL GetDataPhone2 END END END WHEN ItemNumber=I THEN CALL Verandering WHEN ItemNumber=J THEN CALL Verandering WHEN ItemNumber=K THEN CALL GetPassword WHEN ItemNumber=L THEN CALL GetAnsiCompress WHEN ItemNumber=M THEN CALL GetHotKeys WHEN ItemNumber=N THEN CALL GetScreenClearing WHEN ItemNumber=O THEN CALL GetPageLength WHEN ItemNumber=P THEN CALL GetMenuSet WHEN ItemNumber=Q THEN CALL GetEditor WHEN ItemNumber=R THEN CALL GetProtocol WHEN ItemNumber=S THEN CALL GetComputerType WHEN ItemNumber=T THEN CALL MailAddress WHEN ItemNumber="" THEN DO CALL VertScroll1 BREAK END OTHERWISE NOP END END RETURN Verandering: IF Country="Netherlands"&key=1 THEN DO CALL GetLocation CALL GetStreetAddress CALL GetZipCode CALL GetVoicePhone CALL GetDataPhone END ELSE DO CALL GetLocation2 CALL GetStreetAddress CALL GetZipCode2 CALL GetVoicePhone2 CALL GetDataPhone2 END RETURN AddUserToFile: CALL BoodS("Adding you to the user file, Please wait") MSG "[35@" ADDUSER '"'UserName'" "'Alias'"'DEF_Level ulop=RESULT IF ulop="FALSE" THEN CALL Fataal('Adding "'||UserName||'" as a NEW User!') GETUSERDIR UserName ThisUserDir=RESULT MSG gel"wRITING yOUR "||dgr||"["||gel||"aDDRESS"||dgr||"]"||wit||" tO yOUR "||dgr||"["||gel||"uSER dIR"||dgr||"]"||wit||".!" DRAAI=3 CALL DRAAIEN IF ~OPEN(AddrFi,ThisUserDir".address","W") THEN CALL Fataal('Writing "'||UserName||'" as a NEW User!') CALL WRITELN(AddrFi,StreetAddress) CALL WRITELN(AddrFi,Location) CALL WRITELN(AddrFi,ZipCode) CALL WRITELN(AddrFi,Country) CALL WRITELN(AddrFi,VoicePhone) CALL WRITELN(AddrFi,DataPhone) IF MailLocation~="" THEN CALL WRITELN(AddrFi,MailLocation) CALL CLOSE(AddrFi) CALL GimmeUserStuff UPDATEDISKUSER LOGENTRY "NEW" RETURN WriteUserMsg: MSG gel"wRITING A "||dgr||"["||gel||"mESSAGE"||dgr||"]"||wit||" tO yOUR "||dgr||"["||gel||"sYSOP"||dgr||"]"||wit||".!" DRAAI=2 CALL DRAAIEN IF OPEN("NUF","T:NEWUSER","W") THEN DO CALL WRITELN("NUF","A new user logged in!!!") CALL WRITELN("NUF"," ") CALL WRITELN("NUF","Name............: "||UserName) CALL WRITELN("NUF","Alias...........: "||Alias) CALL WRITELN("NUF","Gender..........: "||TXT_GenderType) CALL WRITELN("NUF","Address.........: "||StreetAddress) CALL WRITELN("NUF","Zipcode/City....: "||ZipCode||" "||Location) CALL WRITELN("NUF","Country.........: "||Country) CALL WRITELN("NUF","Telephone/Voice.: "||VoicePhone) CALL WRITELN("NUF","Telephone/Data..: "||DataPhone) CALL WRITELN("NUF","Computer-type...: "||ComputerName) CALL WRITELN("NUF"," ") CALL WRITELN("NUF"," ") CALL WRITELN("NUF","Greetz,") CALL WRITELN("NUF"," ") CALL WRITELN("NUF","Your NewUser program") CALL CLOSE("NUF") cmd='XUtils:XRoboWriter'||' F "'||MSG_FROM||'" T "'||MSG_TO||'" S "'||MSG_SUBJECT||'" TF T:NEWUSER B '||MSG_AREA||' QUIET' IF OPEN('Test','XUtils:XRoboWriter','R') THEN DO CALL CLOSE('Test') ADDRESS COMMAND cmd END ELSE SYSOPLOG "Error: unable to use XUtils:XRoboWriter" END ELSE CALL Fataal("Cannot write to T:NEWUSER") RETURN WriteUINFO: IF OPEN(tmp,DEF_UserDir||DiskUserName"/.password",W) THEN DO CALL WRITELN(tmp,Password) CALL CLOSE(tmp) MSG gel"wRITING yOUR "||dgr||"["||gel||"pASSWORD"||dgr||"]"||wit||" tO yOUR "||dgr||"["||gel||"uSER dIR"||dgr||"]"||wit||".!" DRAAI=1 CALL DRAAIEN END IF OPEN(tmp,DEF_UserDir||DiskUserName"/.birthday",W) THEN DO CALL WRITELN(tmp,BirthDay) CALL CLOSE(tmp) MSG gel"wRITING yOUR "||dgr||"["||gel||"bIRTHDAY"||dgr||"]"||wit||" tO yOUR "||dgr||"["||gel||"uSER dIR"||dgr||"]"||wit||".!" DRAAI=1 CALL DRAAIEN END IF OPEN(tmp,DEF_UserDir||DiskUserName"/.computer",W) THEN DO CALL WRITELN(tmp,ComputerName) CALL CLOSE(tmp) MSG gel"wRITING yOUR "||dgr||"["||gel||"cOMPUTER tYPE"||dgr||"]"||wit||" tO yOUR "||dgr||"["||gel||"uSER dIR"||dgr||"]"||wit||".!" DRAAI=1 CALL DRAAIEN END RETURN EXTERNSAVE: BBSIDENTIFY NAME BBSNAME=UPPER(RESULT) DBBSNAME=TRANSLATE(BBSNAME,"_"," ") IF EXISTS(DEF_USERDIR||DBBSNAME".TXT") THEN DO IF OPEN(ExtSV,DEF_USERDIR||DBBSNAME".TXT",'A') THEN DO CALL WRITELN(ExtSV,LEFT(USERNAME,24)' 'LEFT(ALIAS,24)' 'LEFT(LOCATION,18)' 'DATE('N')) CALL CLOSE(ExtSV) END END ELSE DO IF OPEN(ExtSV,DEF_USERDIR||DBBSNAME".TXT",'W') THEN DO CALL WRITELN(ExtSV,CENTRE("List Created On: "DATE() TIME(),80)) CALL WRITELN(ExtSV,"") CALL WRITELN(ExtSV,CENTRE("New Users On "BBSNAME".",80)) CALL WRITELN(ExtSV,"") CALL WRITELN(ExtSV,'UserName Alias Location First Time') CALL WRITELN(ExtSV,'------------------------ ------------------------ ------------------ -----------') CALL WRITELN(ExtSV,LEFT(USERNAME,24)' 'LEFT(ALIAS,24)' 'LEFT(LOCATION,18)' 'DATE('N')) CALL CLOSE(ExtSV) END END RETURN WriteUserList: MSG gel"aDDING yOUR "||dgr||"["||gel||"nAME"||dgr||"]"||wit||" tO tHE "||dgr||"["||gel||"uSER vALIDATION lIST"||dgr||"]"||wit||".!" DRAAI=1 CALL DRAAIEN IF EXISTS("DOORS:NewUsers/NewUsers.LIST") THEN DO IF OPEN(ALLREADY,"DOORS:NewUsers/NewUsers.LIST",'A') THEN DO CALL WRITELN(ALLREADY,USERNAME) CALL CLOSE(ALLREADY) END END ELSE DO IF OPEN(ALLREADY,"DOORS:NewUsers/NewUsers.LIST",'W') THEN DO CALL WRITELN(ALLREADY,USERNAME) CALL CLOSE(ALLREADY) END END MSG gel||"aLL Done. "||dgr||"["||gel||"pRESS"||wit||" aNy KeY "||dgr||"["||gel||"tO CoNTiNUE"||dgr||"]"||wit||".!" CALL BoodS("Users-file... >Updated<") GETCHAR RETURN Draaien: R="/-\|/-\|" DO LUS=1 TO DRAAI DO I=1 TO LENGTH(R) MSG SUBSTR(R,I,1) DO Counter=1 TO 90 tellos=1 END MSG D2C(8) END END PRINT " " RETURN BoodS: PARSE ARG Bood tellos=80-LENGTH(bood) tellos=tellos%2 Bood=COPIES(' ',tellos)||Bood tellos=80-LENGTH(Bood) MSG lgr||""||Bood||COPIES(' ',tellos) RETURN BoodB: PARSE ARG Bood tellos=1 toko=1 tellis=LENGTH(Bood)%2 tellis=40-tellis DO UNTIL tellos=80 MSG lcy||"[18;"||tellos||"H "||D2C(219) IF tellos-1>tellis&LENGTH(Bood)+1>toko THEN DO MSG lrd||"[18;"||tellos||"H"||SUBSTR(Bood,toko,1) toko=toko+1 END tellos=tellos+1 END MSG " " RETURN Infor: MSG ""||lrd||"HIDDEN " MSG ""||gel||LEFT(VeryHot,18) MSG ""||LEFT(WantCLS,18) MSG ""||PageLength||" lines " MSG ""||LEFT(MenuSet,18) MSG ""||LEFT(Editor_TXT,18) MSG ""||LEFT(ProtocolName,18) MSG ""||LEFT(ComputerName,18) MSG ""||LEFT(WantCMP,18) RETURN Loper: DO tellos=1 TO 23 IF tellos>3&tellos<14 THEN MSG "["||tellos+2||";2H"||gel||D2C(61+tellos) IF tellos>13&tellos<24 THEN MSG "["||tellos-8||";45H"||gel||D2C(61+tellos) IF tellos>0&tellos<11 THEN MSG "["||tellos+5||";2H"||lrd||D2C(64+tellos) IF tellos>10&tellos<21 THEN MSG "["||tellos-5||";45H"||lrd||D2C(64+tellos) END RETURN HoriScroll1: DO tellos=0 TO 20 MSG "[4@[4@[4@[4@[4@[4@" MSG "[4@[4@[4@[4@[4@[4@" END RETURN HoriScroll2: DO tellos=0 TO 40 MSG "" MSG "" END RETURN HoriScroll3: DO tellos=0 TO 19 MSG "[2@[2@[2@[2@[2@" MSG "[2@[2@[2@[2@[2@" END RETURN VertScroll1: DO tellos=1 TO 12 MSG "" END DO tellos=1 TO 12 MSG "" END RETURN VertScroll2: DO tellos=1 TO 19 MSG "" END RETURN Tril: DO tellis=1 TO 6 MSG "["||tellis||"@["||tellis||"@["||tellis||"@" MSG "["||tellis||"@["||tellis||"@["||tellis||"@" MSG "["||tellis||"@["||tellis||"@["||tellis||"@" MSG "["||tellis||"@["||tellis||"P["||tellis||"P" MSG "["||tellis||"P["||tellis||"P["||tellis||"P" MSG "["||tellis||"P["||tellis||"P["||tellis||"P" MSG "["||tellis||"P["||tellis||"P" END RETURN Kaart: PRINT "@" PRINT dgr||"]-----"||gel||"-"||dgr||"--"||gel||"-"||dgr||"-"||gel||"---"||wit||"-"||gel||"--"||wit||"-"||gel||"-"||wit||"------------"||gel||"-"||wit||"-"||gel||"--"||wit||"-"||gel||"---"||dgr||"-"||gel||"-"||dgr||"--"||gel||"-"||dgr||"--- ---- - - - - -- - -- ----[" PRINT gel||" USER SETTINGSUSER SETTINGS" PRINT dgr||"]---- -- - - - - - - -- ---"||wit||"-"||dgr||"--"||gel||"-"||dgr||"-"||gel||"---"||wit||"-"||gel||"--"||wit||"-"||gel||"--"||wit||"-----------"||gel||"-"||wit||"-"||gel||"--"||wit||"-"||gel||"---"||dgr||"-"||gel||"-"||dgr||"--"||gel||"-"||dgr||"-----[" PRINT "" PRINT dgr||"["||gel||"A"||dgr||"] "||wit||"User Name.....:"||dgr||"["||gel||"K"||dgr||"] "||wit||"Password.....:" PRINT dgr||"["||gel||"B"||dgr||"] "||wit||"Alias/Handle..:"||dgr||"["||gel||"L"||dgr||"] "||wit||"Quick ANSI...:" PRINT dgr||"["||gel||"C"||dgr||"] "||wit||"Male/Female...:"||dgr||"["||gel||"M"||dgr||"] "||wit||"HotKeys......:" PRINT dgr||"["||gel||"D"||dgr||"] "||wit||"Date of Birth.:"||dgr||"["||gel||"N"||dgr||"] "||wit||"Screen Clear.:" PRINT dgr||"["||gel||"E"||dgr||"] "||wit||"Street Address:"||dgr||"["||gel||"O"||dgr||"] "||wit||"Page Length..:" PRINT dgr||"["||gel||"F"||dgr||"] "||wit||"Zip Code......:"||dgr||"["||gel||"P"||dgr||"] "||wit||"Menu-Set.....:" PRINT dgr||"["||gel||"G"||dgr||"] "||wit||"City Name.....:"||dgr||"["||gel||"Q"||dgr||"] "||wit||"Msg Editor...:" PRINT dgr||"["||gel||"H"||dgr||"] "||wit||"Country.......:"||dgr||"["||gel||"R"||dgr||"] "||wit||"Protocol.....:" PRINT dgr||"["||gel||"I"||dgr||"] "||wit||"Voice Phone nr:"||dgr||"["||gel||"S"||dgr||"] "||wit||"Type Computer:" PRINT dgr||"["||gel||"J"||dgr||"] "||wit||"Data Phone nr.:"||dgr||"["||gel||"T"||dgr||"] "||wit||"E-Mail addr..:" PRINT "" PRINT dgr||"]---- -- - - - - - - -- ---"||wit||"-"||dgr||"--"||gel||"-"||dgr||"-"||gel||"---"||wit||"-"||gel||"--"||wit||"-"||gel||"--"||wit||"-----------"||gel||"-"||wit||"-"||gel||"--"||wit||"-"||gel||"---"||dgr||"-"||gel||"-"||dgr||"--"||gel||"-"||dgr||"-----[" PRINT "" PRINT "]-----"||gel||"-"||dgr||"--"||gel||"-"||dgr||"-"||gel||"---"||wit||"-"||gel||"--"||wit||"-"||gel||"-"||wit||"------------"||gel||"-"||wit||"-"||gel||"--"||wit||"-"||gel||"---"||dgr||"-"||gel||"-"||dgr||"--"||gel||"-"||dgr||"--- ---- - - - - -- - -- ----[" RETURN Selecteer: kleur="" IF RIGHT(ulop,1)="0" THEN kleur=kleur0 IF RIGHT(ulop,1)="1" THEN kleur=kleur1 IF RIGHT(ulop,1)="2" THEN kleur=kleur2 IF RIGHT(ulop,1)="3" THEN kleur=kleur3 IF RIGHT(ulop,1)="4" THEN kleur=kleur4 IF RIGHT(ulop,1)="5" THEN kleur=kleur5 IF RIGHT(ulop,1)="6" THEN kleur=kleur6 IF RIGHT(ulop,1)="7" THEN kleur=kleur7 IF RIGHT(ulop,1)="8" THEN kleur=kleur8 IF RIGHT(ulop,1)="9" THEN kleur=kleur9 IF RIGHT(ulop,1)="A" THEN kleur=kleurA IF RIGHT(ulop,1)="B" THEN kleur=kleurB IF RIGHT(ulop,1)="C" THEN kleur=kleurC IF RIGHT(ulop,1)="D" THEN kleur=kleurD IF RIGHT(ulop,1)="E" THEN kleur=kleurE IF RIGHT(ulop,1)="F" THEN kleur=kleurF RETURN ERROR: EXIT 50 Fataal: PARSE ARG faerror SYSOPLOG faerror PRINT "@" PRINT "FATAL ERROR!" PRINT PRINT COPIES(' ',(80-LENGTH(faerror))%2)||faerror PRINT "SYSOP has been notified" PRINT PRINT "Sorry, it's impossible to continue!, please call back later" PRINT PRINT PRINT "Press space to disconnect!" GETCHAR DISCONNECT "FATAL ERROR" EXIT 50 MailAddress: CALL BoodS("Please, enter an electronic mail address were i can reach you best") MSG " " MSG lcy||Vraag22||gel waard=MailLocation kar=" " MSG ""||waard DO UNTIL C2D(kar)=13 FLUSHINPUTBUFFER GETCHAR kar=RESULT IF C2D(kar)~=27&C2D(kar)~=13 THEN DO IF C2D(kar)~=8 THEN DO IF LENGTH(waard)<17 THEN waard=waard||kar END ELSE DO IF LENGTH(waard)>1 THEN waard=SUBSTR(waard,1,LENGTH(waard)-1) ELSE waard="" END MSG ""||waard||" " MSG "[15;"||63+LENGTH(waard)||"H" END END MailLocation=STRIP(waard) MSG wit||Vraag22||lgr||LEFT(MailLocation,17) RETURN