* New User Account Filter and Display Setup Utility * Checks new user accounts for valid (first & last) name. * Erases accounts with bad words and wrong looking info. * Allows new user to define settings of ANSI color and IBM graphics. SET ESCAPE OFF && prevent user from aborting program SET EXACT ON && compare variable length and content * A - Check for bad words and both FIRST and LAST name. Allow three * names as in the case with JOHN SMITH JR., but no more. * B - Check for bad words but don't check for number of words in name. * This will allow one word names as well as many word names, but * will NOT allow more than one space between any of the words in the * name. * C - This will not check the name. * The following line is a method of reading the menu line that called the * program. It allows the sysop to pass some information to the program from * the menu. In this case the menu Opt Data format should look something like: * Opt Data= testset /q && A%CanAnsi%%Bad7Bit% * Notice that the double ampersand is used to separate the normal menu command * from the information being passed to the program. The letter option followed * by two insertion parameters makes up the three pieces of information needed. parm = LTRIM(RTRIM(SUBS(OPTDATA(),AT("&" + "&",OPTDATA()) + 2))) + " " * NOTE: The double ampersand is used in TDBS source code to mark the end * of a program line and the start of a comment. For this reason the * above line must separate the two ampersands and use the string add * technique to logically put them together. IF LEFT(parm,1) $ "X." && missing something? parm = "A" + parm && add default to front ENDIF IF .NOT. EMPTY(parm) && is there something there? check = UPPER(LEFT(parm,1)) && level of name checking check = IIF(check $ "ABC",check,"A") && default to level A if not B or C can_ansi = (SUBSTR(parm,2,1) $ "X") && logical - can user see ANSI? bad7bit = (SUBSTR(parm,3,1) $ "X") && logical - is user 7 bit? speed = ":" + LTRIM(SUBSTR(parm,4)) && baud rate for this call ELSE check = "A" && force level "A" checking can_ansi = .T. && force ansi ability on bad7bit = .F. && can't tell about 7bit speed = ":0" && can't tell speed IF UPRIV() = 255 && are they a sysop? ? ? "SYSOP ERROR: Be sure to add the following to the menu command line:" ? * NOTE: The OPTDATA() function shows the full calling menu command line. ? OPTDATA() + " &" + "& A%CanAnsi%%Bad7Bit%" ? ? "This will allow this program to do more for you and your users!" ? WAIT && pause for user key press ENDIF ENDIF IF bad7bit && user only has 7 bit link ? ? "ERROR: YOU NEED TO CHANGE YOUR SOFTWARE OR HARDWARE TO USE" ? ? " 8 DATA BITS, 1 STOP BIT AND NO PARITY BEFORE YOU CAN" ? ? " USE THIS SERVICE." ? ? ? "PRESS ANY KEY WHEN READY TO HANG UP..." CLEAR TYPEAHEAD && blank out any pending keys dummy = INKEY(120) && wait 120 seconds or until key press DOTBBS TYPE 10 OPTDATA "/Q" && call "hang up" from TBBS ENDIF un = TRIM(UNAME()) && get user name from BBS IF RIGHT(UAUTH(1),1) = "." && check if not verified (A1=-------.) bad = .F. && default flag to false junk = "" && temporary variable junkn = 127 && start at ASCII CHR(127) DO WHILE junkn < 255 && look for high ASCII CHRs in name IF CHR(junkn) $ un && is it inside user's name? bad = .T. && make flag for part below junkn = 999 && force end of loop ENDIF junkn = junkn + 1 && incr by one ENDDO IF bad && did loop find bad user name? dummy = ULREPLACE(UPRIV,0) && set priv level to ZERO! no access! CLEAR && clear screen ? CHR(7) && ring bell ? "ERROR: YOU HAVE INVALID CHARACTERS IN YOUR NAME. PLEASE CHECK TO MAKE SURE" ? " THAT YOUR TERMINAL IS SET TO EIGHT (8) DATA BITS, ONE (1) STOP BIT" ? " AND NO PARITY!" ? ? " *** IT IS VERY IMPORTANT TO USE THESE SETTINGS. ***" ? ? "THIS ACCOUNT WILL BE ERASED SO YOU CAN CALL BACK AND NOT HAVE A PROBLEM" ? "CREATING A CORRECT ACCOUNT." ? ? "THE BBS WILL HANG UP WHEN YOU PRESS A KEY." ? dummy = ULPOKE(151,1,255) && Per Call Time Limit 'use' it all up junk = ULPEEK(72,5) && this holds the "deleted" flag dummy = ULPOKE(72,5,LEFT(junk,1)+"X"+RIGHT(junk,6)) && delete user ? "PRESS ANY KEY WHEN READY..." CLEAR TYPEAHEAD && make sure no pending characters dummy = INKEY(120) && wait for 120 seconds or key press DOTBBS TYPE 10 OPTDATA "/Q" && call "hang up" from TBBS ENDIF bad = .F. DO CASE && start selection case CASE .NOT. " " $ un && no space in name (one word) bad = .T. && make flag say it is bad CASE SUBSTR(un,LEN(un)-2,1) = " " && only last initial bad = .T. && make flag say it is bad CASE SUBSTR(un,2,1) = " " && only first initial bad = .T. && make flag say it is bad ENDCASE && end selection case IF bad .AND. check = "A" && bad flag and sysop has name checked dummy = ULREPLACE(UPRIV,0) && make no access = priv level zero CLEAR && blank user's screen ? ? "ERROR: YOU DID NOT PROVIDE BOTH YOUR FIRST AND LAST NAME!" ? ? "We are glad that you are calling, but this BBS is limited to people who" ? "can read and answer questions correctly. If you don't want to answer the" ? "prompts with the required information then you are free to call any of" ? "the other boards in this area." ? ? "Please don't take this personally. It's just that if you can't understand" ? "what you read then you need help that is not available here." ? ? "The BBS will hang up when you press the next key." ? dummy = ULPOKE(151,1,255) && Per Call Time Limit 'use' it all up junk = ULPEEK(72,5) && this holds the "deleted" flag dummy = ULPOKE(72,5,LEFT(junk,1)+"X"+RIGHT(junk,6)) && delete user ? "Press any key when ready..." CLEAR TYPEAHEAD && blank user's keyboard buffer dummy = INKEY(120) && wait 120 seconds or for key press DOTBBS TYPE 10 OPTDATA "/Q" && call "hang up" from TBBS ENDIF bad = .F. && reset flag junk = un + ULOCATION() && check in name or location DO CASE && start selection case for bad words CASE CHR(70) + "U" + CHR(67) + "K" $ junk bad = .T. && make flag say it is bad CASE "P" + CHR(69) + "N" + CHR(73) + "S" $ junk bad = .T. && make flag say it is bad CASE CHR(65) + "SS" + CHR(72) + "O" + CHR(76) + "E" $ junk bad = .T. && make flag say it is bad CASE "DI" + CHR(67) + "K" + CHR(72) + "E" + CHR(65) + "D" $ junk bad = .T. && make flag say it is bad ENDCASE && end selection case IF bad .AND. check # "C" && bad and sysop option is not C ? ? "An invalid word has been used. Your account has been purged." dummy = ULREPLACE(UPRIV,0) && zero access dummy = ULPOKE(151,1,255) && Per Call Time Limit 'use' it all up junk = ULPEEK(72,5) && this holds the "deleted" flag dummy = ULPOKE(72,5,LEFT(junk,1)+"X"+RIGHT(junk,6)) && delete user ? ? "Press any key when ready..." CLEAR TYPEAHEAD && make sure no keys are still pending dummy = INKEY(120) && wait for key press or 120 seconds DOTBBS TYPE 10 OPTDATA "/Q" && call "hang up" from TBBS ENDIF IF " " $ un .AND. check # "C" && two (or more) spaces in name CLEAR && blank user's screen ? ? "ERROR: YOU HAVE MORE THAN ONE BLANK SPACE BETWEEN YOUR FIRST AND LAST NAME!" ? ? "We are glad that you are calling, but most people don't notice things like" ? "hitting the spacebar too many times and would not be able to log in again." ? "This creates accounts on our drive that are never used and some people" ? "even complain about having to log in as a new user again." ? ? "Please don't take this personally. This is just a way of making sure you" ? "will be able to log into this BBS next time without any problems." ? ? "This account (with too many blank spaces) will be erased so you can call back" ? "and not have a problem logging in." ? ? "The BBS will hang up when you press the next key." ? dummy = ULREPLACE(UPRIV,0) && lower user's privilege level to 0 dummy = ULPOKE(151,1,255) && Per Call Time Limit 'use' it all up junk = ULPEEK(72,5) && this holds the "deleted" flag dummy = ULPOKE(72,5,LEFT(junk,1)+"X"+RIGHT(junk,6)) && delete user ? "Press any key when ready..." CLEAR TYPEAHEAD && make sure no keys are still pending dummy = INKEY(120) && wait for key press or 120 seconds DOTBBS TYPE 10 OPTDATA "/Q" && call "hang up" from TBBS ENDIF junkn = 0 && reset counter variable to 0 junk = TRIM(un) && remember user's name DO WHILE LEN(junk) > 0 && loop until "junk" is empty IF LEFT(junk,1) = " " && is this a space? junkn = junkn + 1 && count number of spaces ENDIF IF LEN(junk) > 1 && are there more letters? junk = SUBSTR(junk,2) && trim off a letter ELSE junk = "" && blank out to end loop ENDIF ENDDO IF junkn > 2 .AND. check = "A" && more than three names? CLEAR && blank user's screen ? ? "ERROR: YOU HAVE TYPED MORE THAN JUST YOUR FIRST AND LAST NAME!" ? ? "We are glad that you are calling, but most people don't notice things" ? "like this and too many times would not be able to log in again. This" ? "creates accounts on our drive that are never used and some people even" ? "complain about having to log in as a new user again." ? ? "Please don't take this personally. This is just a way of making sure you" ? "will be able to log into this BBS next time without any problems." ? ? "This account will be erased so you can call back and not have a" ? "problem logging in." ? ? "The BBS will hang up when you press the next key." ? dummy = ULREPLACE(UPRIV,0) && lower privilege level to 0 dummy = ULPOKE(151,1,255) && Per Call Time Limit 'use' it all up junk = ULPEEK(72,5) && this holds the "deleted" flag dummy = ULPOKE(72,5,LEFT(junk,1)+"X"+RIGHT(junk,6)) && delete user ? "Press any key when ready..." CLEAR TYPEAHEAD && make sure no keys are still pending dummy = INKEY(120) && wait only 120 seconds DOTBBS TYPE 10 OPTDATA "/Q" && call "hang up" from TBBS ENDIF ? && they passed the tests! ? "NOTE: The following questions are very important to set up your account here" ? " on the BBS. If you give the wrong answer you may not be able to see the" ? " prompts for the rest of the system." ? ? "New users: The '(Y/n)' prompt choices show you that pressing ENTER or RETURN" ? " will select the UPPERCASE letter as your answer." ? ? "Please read and answer the following questions carefully." ok = .F. && flag to exit loop DO WHILE .NOT. ok && start loop to check term settings ? ? ? "===TERMINAL SETTINGS===" && tell user what is happening try_ansi = can_ansi && store flag in temp variable IF .NOT. can_ansi && they didn't pass TBBS ANSI poll? ? "NOTE: Your terminal software has failed the ANSI poll." ? " If this is incorrect please check your software" ? " configuration and call back." ? ? && show some ANSI codes ? " [" + CHR(27) + "[1;37m" + CHR(27) + "[1;37m" ?? CHR(27) + "[1;37m"+CHR(27)+"[0m]" ? key = "" && blank variable for input ? "Do you see ANYTHING between the brackets above? (Y/n) " dummy = UPPER(CHR(INKEY(120))) && get key press or 120 seconds ?? IIF(dummy = "N","No","Yes") && show response dummy = ULREPLACE(UANSI,IIF(key = "N",.F.,.T.)) && turn ANSI on/off ? ELSE ? && show some ANSI codes ? " [" + CHR(27) + "[1;37m" + CHR(27) + "[1;37m" ?? CHR(27) + "[1;37m"+CHR(27)+"[0m]" ? key = "" && blank variable for input ? "Do you see ANYTHING between the brackets above? (y/N) " key = UPPER(CHR(INKEY(120))) && wait 120 seconds or key press ?? IIF(key = "Y","Yes","No") && show response dummy = ULREPLACE(UANSI,IIF(key = "Y",.T.,.F.)) && turn ANSI on/off ? ? ENDIF ? ? " [ÄÄÄÄÄÄÄÄÄÄÄÄÄÄ]" && show some line graphics ? key = "" && blank variable for input ? "Is there thin straight line between the brackets above? (Y/n) " key = UPPER(CHR(INKEY(120))) && wait 120 seconds or key press ?? IIF(key = "M","No","Yes") && show selection dummy = ULREPLACE(UIBM,IIF(key = "N",.F.,.T.)) && turn graphics on/off i = 60 && start counter at 60 lines DO WHILE i > 2 && loop until line 2 i = i - 1 && decr variable by one ? LTRIM(STR(i)) && show number on screen ENDDO && end of loop key = "" && blank variable for input ACCEPT "What is the number at the TOP of your screen? " TO key key = VAL(key) && get number value of input IF key < 24 && is selection less than 24? key = 24 && force min screen length ENDIF IF key > 60 && it selection more than 60? key = 60 && force max ENDIF dummy = ULREPLACE(UMORE,key) && set length of screen CLEAR && blank user's screen ? ? ? "Your answers:" ? ? "ANSI Color commands : " + IIF(UANSI(),"Yes","No") && ANSI settings ? "Extended characters : " + IIF(UIBM(),"Yes [ÄÄÄÄÄÄ]","No [------]") && IBM graphic settings ? "Length of screen is : " + IIF(UMORE() > 0,LTRIM(STR(UMORE())) + " lines.","-none-") ? key = "" && blank for input ? "Is this correct? (Y/n) " && prompt user key = UPPER(CHR(INKEY(120))) && wait 120 seconds or key press ?? IIF(key = "N","No","Yes") && show selection IF key # "N" && if it is not "N" ok = .T. && flag to exit loop ENDIF ENDDO * The following is a display utility to show up to 5 text files in order. * The text files must be in the same directory as this program. IF FILE(HOMEPATH() + "newuser1.inf") && is 1st file here? DOTBBS TYPE 1 OPTDATA HOMEPATH() + "newuser1.inf" ENDIF IF FILE(HOMEPATH() + "newuser2.inf") && is 2nd file here? DOTBBS TYPE 1 OPTDATA HOMEPATH() + "newuser2.inf" ENDIF IF FILE(HOMEPATH() + "newuser3.inf") && is 3rd file here? DOTBBS TYPE 1 OPTDATA HOMEPATH() + "newuser3.inf" ENDIF IF FILE(HOMEPATH() + "newuser4.inf") && is 4th file here? DOTBBS TYPE 1 OPTDATA HOMEPATH() + "newuser4.inf" ENDIF IF FILE(HOMEPATH() + "newuser5.inf") && is 5th file here? DOTBBS TYPE 1 OPTDATA HOMEPATH() + "newuser5.inf" ENDIF * This following line is a authorization flag change. This should be used * with a menu authorization flag to prevent the user from running this * program more than once. dummy = ULREPLACE(UAUTH,1,LEFT(UAUTH(1),7)+"X") && change flag ENDIF QUIT && this ends the program