ProfitPress Mega CDROM2 Shareware Freeware (MSDOS)(1992)(Eng)

home *** CD-ROM | disk | FTP | other *** search

/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / BBS / RBBS_PC / 173_BAS.ZIP / CNFG-SUB.BAS < prev next >

Wrap

BASIC Source File | 1990-02-10 | 95.1 KB | 2,247 lines

' $linesize:132 ' $title: 'CNFG-SUB.BAS CPC17.3, Copyright 1987-90 by D. Thomas Mack' ' Copyright 1990 by D. Thomas Mack, all rights reserved. ' Name ...............: CNFG-SUB.BAS ' First Released .....: February 11, 1990 ' Subsequent Releases.: ' Copyright ..........: 1987-90 ' Purpose.............: The Remote Bulletin Board System for the IBM PC, ' RBBS-PC, configuration program -- CONFIG.BAS ' utilizes a lot of menus and string space. ' These are incorporated within CNFG-SUB.BAS as a ' seperately callable subroutines in order to free ' up as much code as possible within the 64K code ' segment used by CONFIG.BAS. ' Parameters..........: Most parameters are passed via a COMMON statement. ' ' Subroutine Line Function of Subroutine ' Name Number ' ALLCAPS 61212+ Captialize a string ' ANSIDECODE 62040+ Convert ANSI strings into english text expressions ' ANYINTEGER 61450 Prompt for any integer ' ANYNUMBER 61400 Prompt for any number ' ASKRO 61100 Ask a question on a specific row ' ASKUPOS 61300 Ask for identifying field in USERS record ' BRKFNAME 61830 Break file name in drive/path, prefix, extension ' CHKFMSDIR 61700 Check FMS directory for valid structure ' CHKPERSDIR 61755 Check Personal directory format ' CNFGINIT 60385 Initialize CONFIG's constants ' COLORCODE 62040+ Convert response into ANSI-meaningful strings ' DISPLAY 12190 Display the CONFIG menu pages ' FINDFILE 61600 Determine whether a file exists ' FINDLAST 61850 Find last occurence of a character in a string ' GETANSI 62000 Prompt for ANSI colors to be used ' GETASCII 61810 Get any character by character or ascii value ' GETCOLOR 61950 Process request for setting color ' GETINIT 61110 Get answers that are integers ' GETNUMYN 61150 Get TRUE/FALSE answer to a YES/NO question ' GETYESNO 61200 Ask a question with a "yes" or "no" response ' HANDERR 61775+ Handle error checking for FMS directories ' MMINTEGER 61500 Prompt for integer with min and a max ' NETTYPE 60382 Prompt for supported network types ' REMOVE 61800 Remove characters from a string ' SECURE 61860 Allow commands and their security level to be changed ' SELMODEM 62100 Select modem to set modem strings ' TRIMTRAIL 61840 Remove trailing characters from a string ' ' $INCLUDE: 'CNFG-VAR.BAS' ' ' $SUBTITLE: 'DISPLAY - subroutine to display CONFIG's menus' ' $PAGE ' ' SUBROUTINE NAME -- DISPLAY ' ' INPUT PARAMETERS -- PARAMETER DESCRIPTION ' IX = 0 DISPLAY THE CHOICE OF MENUS ' IX = -1 RE-READ THE INPUT (INVALID REQUEST) ' IX > 0 DISPLAY THE APPROPRIATE PAGE ' ' OUTPUT PARAMETERS -- HJ$ OPTION SELECTED ' IPAGE MENU PAGE CONTAINING OPTION ' ILOOKUP INDEX (1 TO 20) OF OPTION SELECTED ' ' SUBROUTINE PURPOSE -- TO DISPLAY CONFIG'S MENUS AND REQUEST OPTION ' SUB DISPLAY STATIC ' ' * DISPLAY CONFIG'S MAIN FUNCTION KEY MENU ' IF IX > 0 THEN _ GOTO 12320 IF IX = -1 THEN _ GOTO 12590 12190 COLOR FG,BG,BORDER CLS DISPLAYED.PAGE.NUMBER = 0 I! = FRE(C$) COLOR 0,7,0 LOCATE 4,10 PRINT "RBBS-PC "+ CONFIG.VERSION$ + " CONFIGURATION PROGRAM " COLOR FG,BG,BORDER LOCATE 1,1,0 PRINT "Copyright (c) 1983-1990 Tom Mack" LOCATE 2,1,0 PRINT "39 Cranbury Dr, Trumbull, CT. 06611"; IF CONFERENCE.MODE THEN _ GOSUB 24970 LOCATE 5,1 PRINT " F1 Global RBBS-PC Parameters (part 1) PRINT " F2 Global RBBS-PC Parameters (part 2) PRINT " F3 Global RBBS-PC Parameters (part 3) PRINT " F4 RBBS-PC System Files (part 1) PRINT " F5 RBBS-PC System Files (part 2) PRINT " F6 Parameters for RBBS-PC's 'Doors' PRINT " F7 Parameters for RBBS-PC's Security (part 1) PRINT " F8 Parameters for RBBS-PC's Security (part 2) PRINT " F9 Parameters for multiple RBBS-PC's PRINT " F10 RBBS-PC utilities PRINT " Shift-F1 RBBS-PC File Management Faciliites" PRINT " Shift-F2 RBBS-PC Communications Parameters (part 1) PRINT " Shift-F3 RBBS-PC Communications Parameters (part 2) PRINT " Shift-F4 Parameters for RBBS-PC NET-MAIL PRINT " Shift-F5 New users parameters" PRINT " Shift-F6 Library Sub-System" PRINT " Shift-F7 RBBS-PC Color parameters" PRINT " Shift-F8 Reserved for future use" XX$ = "Press END to terminate or Function Key to select page " GOSUB 50345 LOCATE ,,1 12310 GOSUB 22160 12320 IF IX THEN _ 'IX Key Where to branch to ON IX GOTO 12360, _ ' 1 F1 - Global Parameters (Part 1) 12370, _ ' 2 F2 - Global Parameters (Part 2) 12380, _ ' 3 F3 - Global Parameters (Part 3) 12390, _ ' 4 F4 - RBBS-PC System Files (Part 1) 12400, _ ' 5 F5 - RBBS-PC System Files (Part 2) 12410, _ ' 6 F6 - RBBS-PC "doors" 12420, _ ' 7 F7 - RBBS-PC security parms. (Part 1) 12466, _ ' 8 F8 - RBBS-PC security parms. (Part 2) 12470, _ ' 9 F9 - Multiple RBBS-PC parameters 12480, _ '10 F10 - RBBS-PC's utilities 12490, _ '11 Shift-F1 - RBBS-PC File Manager 12500, _ '12 Shift-F2 - RBBS-PC comm. parameters (Part 1) 12505, _ '13 Shift-F3 - RBBS-PC comm. parameters (Part 2) 12510, _ '14 Shift-F4 - RBBS-PC Net Mail 12520, _ '15 Shift-F5 - New user parameters 12530, _ '16 Shift-F6 - Library parameters 12540, _ '17 Shift-F7 - RBBS-PC Color parameters 12310, _ '18 Shift-F8 - Reserved for future use 12340, _ '19 PgUp - Go to previous page 12330, _ '20 PgDn - Go to next page 12630, _ '21 End - Terminate CONFIG 12350 '22 Enter - Re-display current page GOTO 12310 ' ' * COMMON ROUTINE TO HANDLE UNDEFINED OPTIONS ' 12325 IX = IPAGE GOTO 12320 ' ' * COMMON ROUTINE TO HANDLE PAGE UP OF DISPLAYS ' 12330 IF (DISPLAYED.PAGE.NUMBER + 1 ) > 17 THEN _ GOTO 12190 IX = DISPLAYED.PAGE.NUMBER + 1 GOTO 12320 ' ' * COMMON ROUTINE TO HANDLE PAGE DOWN OF DISPLAYS ' 12340 IF (DISPLAYED.PAGE.NUMBER - 1) < 1 THEN _ GOTO 12190 IX = DISPLAYED.PAGE.NUMBER - 1 GOTO 12320 ' ' * RETURN TO PRIMARY MENU SELECTION DISPLAY ' 12350 GOSUB 60380 GOTO 12310 ' ' * COMMON CONFIGURATION PROGRAM MENU AND PAGE DISPLAY ' 12360 DISPLAYED.PAGE.NUMBER = 1 GOSUB 24800 LOCATE 3,1 PRINT " 1. SYSOP's Public First Name -------------------- " + SYSOP.FIRST.NAME$ PRINT " 2. SYSOP's Public Last Name --------------------- " + SYSOP.LAST.NAME$ PRINT " 3. SYSOP's default expert mode at signon -------- " + EXPERT.USER$ PRINT " 4. SYSOP's office hours -------------------------"STR$(START.OFFICE.HOURS);" to"STR$(END.OFFICE.HOURS) PRINT " 5. Page SYSOP using printer's bell -------------- " + M11$ PRINT " 6. Go off-line whenever a DISK FULL occurs ------ " ; FNYESNO$(DISKFULL.GO.OFFLINE) PRINT " 7. Prompt bell default is ----------------------- " + PROMPT.BELL$ PRINT " 8. Maximum time per session (in minutes) --------"STR$(MINUTES.PER.SESSION!) PRINT " 9. Maximum minutes per day ----------------------";STR$(MAX.PER.DAY) PRINT "10. Factor to extend session time for uploads ----" + STR$(UPLOAD.TIME.FACTOR!) PRINT "11. # Months of inactivity before user deleted ---"STR$(ACT.MNTHS.B4.DELETING) PRINT "12. Name of RBBS-PC shown initially is ----------- " + RBBS.NAME$ PRINT "13. Foreground color (for color monitors) is -----"STR$(FG) PRINT "14. Background color (for color monitors) is -----"STR$(BG) PRINT "15. The border color (for color monitors) is -----"STR$(BORDER) PRINT "16. Your CONFIG.SYS contains 'DEVICE=ANSI.SYS'---- " + FNYESNO$(DOSANSI) IF SMART.TEXT THEN _ SMART.TEXT$ = STR$(SMART.TEXT) _ ELSE SMART.TEXT$ = "<none>" PRINT "17. Control character for SMART TEXT -------------" + SMART.TEXT$ PRINT "18. File with automatic operator page parameters - " ; AUTOPAGE.DEF$ X = INSTR("ANS",LOGON.MAIL.LEVEL$) IF X < 1 THEN _ X = 1 X$ = MID$("OLD & NEWNEW ONLY NONE",9*X-8,9) IF X$ = "NONE" THEN _ X$ = NONE.PICKED$ PRINT "19. Personal mail notification level at logon is - " + X$ GOTO 12580 12370 DISPLAYED.PAGE.NUMBER = 2 GOSUB 24800 LOCATE 3,1 PRINT "21. Remind users of messages that they left ------ " + FNYESNO$(MESSAGE.REMINDER) PRINT "22. Remind users of # uploads and downloads? ----- " + FNYESNO$(REMIND.FILE.TRANSFERS) PRINT "23. Remind users of their terminal profile? ------ " + FNYESNO$(REMIND.PROFILE) PRINT "24. Enable download of new files at logon -------- " + FNYESNO$(NEW.FILES.CHECK) PRINT "25. Default user page length is ------------------" + STR$(PAGE.LENGTH) PRINT "26. Maximum number of lines allowed per message --" + STR$(MAX.MESSAGE.LINES) PRINT "27. Is system 'welcome' interruptable? ----------- " + FNYESNO$(WELCOME.INTERRUPTABLE) PRINT "28. Are system bulletins to be 'optional'? ------- " + FNYESNO$(BULLETINS.OPTIONAL) PRINT "29. Type of PC RBBS-PC will be running on? ------- " + COMPUTER.TYPE$ PRINT "30. Symbols to use for SYSOP commands ------------ " + SYSOP.COMMANDS$ PRINT "31. Symbols to use for MAIN menu commands -------- " + MAIN.COMMANDS$ PRINT "32. Symbols to use for FILE menu commands -------- " + FILE.COMMANDS$ PRINT "33. Symbols to use for UTILITIES menu commands --- " + UTIL.COMMANDS$ PRINT "34. Symbols to use for global commands ----------- " + GLOBAL.COMMANDS$ PRINT "35. Show section in command prompt --------------- " + FNYESNO$(SHOW.SECTION) PRINT "36. Show commands in command prompt -------------- " + FNYESNO$(COMMANDS.IN.PROMPT) PRINT "37. Restrict valid commands to current section --- " + FNYESNO$(RESTRICT.VALID.CMDS) PRINT "38. Use machine language routines for speed ------ " + FNYESNO$(TURBO.RBBS) PRINT "39. Use BASIC PRINT for screen writes ------------ " + FNYESNO$(USE.BASIC.WRITES) PRINT "40. # of lines for extended file descriptions ----" + STR$(MAX.EXTENDED.LINES) GOTO 12580 12380 DISPLAYED.PAGE.NUMBER = 3 GOSUB 24800 LOCATE 3,1 PRINT "41. Field used to identify users ----------------- " + HASH.ID$ PRINT "42. Field used to distinguish users with same ID-- " + INDIV.ID$ PRINT "43. Start position identifying personal downloads-" + STR$(PERSONAL.BEGIN) PRINT "44. Field length to identify personal downloads --" + STR$(PERSONAL.LEN) PRINT "45. Prompt for first part of personal identifier - " + FIRST.NAME.PROMPT$ PRINT "46. Prompt for last part of personal identifier -- " + LAST.NAME.PROMPT$ PRINT "47. Enforce upload/download ratios --------------- " + FNYESNO$(ENFORCE.UPLOAD.DOWNLOAD.RATIOS) PRINT "48. RESTRICT users by SUBSCRIPTION date ---------- " + FNYESNO$(RESTRICT.BY.DATE) PRINT "49. Security level when SUBSCRIPTION expires -----" + STR$(EXPIRED.SECURITY) PRINT "50. Days before expiration to warn callers -------" + STR$(DAYS.TO.WARN) PRINT "51. Default # days in SUBSCRIPTION PERIOD --------" + STR$(DAYS.IN.SUBSCRIPTION.PERIOD) PRINT "52. Turn printer off after each recycle ---------- " + FNYESNO$(TURN.PRINTER.OFF) PRINT "53. Play musical themes for RBBS-PC functions----- " + FNYESNO$(MUSIC) PRINT "54. BUFFER SIZE used when displaying text files --" + STR$(BUFFER.SIZE) PRINT "55. Stack space to be made available -------------" + STR$(SIZE.OF.STACK) PRINT "56. File shown users when SYSOP wants system next " + NOT.YET.IN$ ' F7.MESSAGE$ PRINT "57. Ask users their (What is your ...) ----------- " + USER.LOCATION$ PRINT "58. Show ALL DIRECTORIES in order in dir of dir -- " + FNYESNO$(USE.DIR.ORDER) PRINT "59. BUFFER SIZE for writes on internal protocols -" + STR$(WRITE.BUF.DEF) PRINT "60. Voice Synthesizer support -------------------- " + VOICE.TYPE$ GOTO 12580 12390 DISPLAYED.PAGE.NUMBER = 4 GOSUB 24800 IF INSTR(DRIVE.FOR.BULLETINS$,":") < 1 THEN _ DRIVE.FOR.BULLETINS$ = DRIVE.FOR.BULLETINS$ + ":" LOCATE 3,1 PRINT "61. Drive and file describing 'bulletins' is ----- " + DRIVE.FOR.BULLETINS$ + BULLETIN.MENU$ PRINT "62. Number of active 'bulletins' -----------------" + STR$(ACTIVE.BULLETINS) PRINT "63. Prefix used to name bulletin files is -------- " + BULLETIN.PREFIX$ PRINT "64. Drive and path (optional) for 'help' files --- " + HELP.PATH$ PRINT "65. Prefix used to name three major 'help' files - " + HELP.FILE.PREFIX$ PRINT "66. Extension for help files of individual cmds -- " + HELP.EXTENSION$ PRINT "67. HELP file when callers CATEGORIZE uploads ---- " + UPCAT.HELP$ PRINT "68. Name of 'newuser' file shown to new users ---- " + NEWUSER.FILE$ PRINT "69. Name of 'welcome' file shown at logon -------- " + WELCOME.FILE$ PRINT "70. The SYSOP's command menu is named ------------ " + MENU$(1) PRINT "71. The MAIN system menu is named ---------------- " + MENU$(2) PRINT "72. The file subsystem menu is named ------------- " + MENU$(3) PRINT "73. The utilities subsystem menu is named -------- " + MENU$(4) PRINT "74. Menu that lists available conferences is ----- " + CONFERENCE.MENU$ PRINT "75. Menu that lists questionnaires available is -- " + ANS.MENU$ PRINT "76. Drive/path for optional questionnaires ------- " + QUES.PATH$ PRINT "77. File with main SYSOP-supplied user interface - " + MAIN.PUI$ PRINT "78. Allow menus to pause in the middle ----------- " + FNYESNO$(MENUS.CAN.PAUSE) PRINT "79. Drive/path where macro files are stored ------ " + MACRO.DRVPATH$ IF MACRO.EXTENSION$ = "" THEN _ X$ = NONE.PICKED$ _ ELSE X$ = MACRO.EXTENSION$ PRINT "80. Extension of macro files --------------------- " ; X$ GOTO 12580 12400 DISPLAYED.PAGE.NUMBER = 5 GOSUB 24800 LOCATE 3,1 PRINT " 81. File containing invalid user names ----------- " + TRASHCAN.FILE$ PRINT " 82. Name questionnaire required of ALL callers --- " + REQUIRED.QUESTIONNAIRE$ PRINT " 83. Name of 'pre-log' file ----------------------- " + PRELOG$ PRINT " 84. Name of questionnaire required of new users -- " + NEW.USER.QUESTIONNAIRE$ PRINT " 85. Name of 'epi-log' questionnaire -------------- " + EPILOG$ PRINT " 86. System file containing messages is named ----- " + MAIN.MESSAGE.FILE$ PRINT " 87. System file for recording users is named ----- " + MAIN.USER.FILE$ PRINT " 88. System file for comments to SYSOP is named --- " + COMMENTS.FILE$ PRINT " 89. Record comments as private messages ---------- " ; FNYESNO$(COMMENTS.AS.MESSAGES) PRINT " 90. System file for 'callers' is named ----------- " + CALLERS.FILE$ PRINT " 91. Extended logging to 'callers' file ----------- " ; FNYESNO$(EXTENDED.LOGGING) PRINT " 92. Wrap-around the 'callers' file --------------- " + NOT.YET.IN$ ' WRAP.CALLERS.FILE$ PRINT " 93. File controlling scan for mail waiting ------- " + CONFMAIL.LIST$ PRINT " 94. Max # of work variables in ques/macros -------" ; STR$(MAX.WORK.VAR) GOTO 12580 12410 DISPLAYED.PAGE.NUMBER = 6 GOSUB 24800 LOCATE 3,1 PRINT "101. Is the 'door' subystem available? ------------ " ; FNYESNO$(DOORS.AVAILABLE) PRINT "102. The 'door' subsystem menu is named ----------- " + MENU$(5) PRINT "103. File built dynamically to open a 'door' ------ " + RCTTY.BAT$ PRINT "104. When a 'door' closes, re-invoke RBBS-PC via -- " + RBBS.BAT$ PRINT "105. Drive/path to look for COMMAND.COM on -------- " + DISK.FOR.DOS$ PRINT "106. Use the Dos 'CTTY' command to redirect I/O --- " ; FNYESNO$(REDIRECT.IO.METHOD) PRINT "107. Door Program to check users at logon --------- " ; REGISTRATION.PROGRAM$ PRINT "108. Logon door required of new users & security <=" ; STR$(MAX.REG.SEC) PRINT "109. Name of control file for doors --------------- " ; DOORS.DEF$ GOTO 12580 12420 DISPLAYED.PAGE.NUMBER = 7 GOSUB 24800 LOCATE 3,1 PRINT "121. Pseudonym to sign on remotely as the SYSOP ---- " + MN1$+ " " +MN2$ PRINT "122. ESC key logs SYSOP on locally without password- " + FNYESNO$(ESCAPE.INSECURE) PRINT "123. Minimum security level to log on RBBS-PC ------" + STR$(MINIMUM.LOGON.SECURITY) PRINT "124. Default security level for new callers --------" + STR$(DEFAULT.SECURITY.LEVEL) PRINT "125. Security level for SYSOP ----------------------" + STR$(SYSOP.SECURITY.LEVEL) PRINT "126. Minimum security level to see SYSOP's menu ----" + STR$(SYSOP.MENU.SECURITY.LEVEL) PRINT "127. Minimum security to leave extended description-" + STR$(ASK.EXTENDED.DESC) PRINT "128. Max # security violations before disconnect ---" + STR$(MAXIMUM.VIOLATIONS) M22$ = STR$(SYSOP.FUNCTION(1)) IX = SYSOP.FUNCTION(1) FOR I = 2 TO NUM.SYSOP IF IX <> SYSOP.FUNCTION(I) THEN _ M22$ = "(Variable)" : _ GOTO 12430 NEXT 12430 PRINT "129. Security level for SYSOP functions ------------" + M22$ M23$ = STR$(MAIN.FUNCTION(1)) IX = MAIN.FUNCTION(1) FOR I = 2 TO NUM.MAIN IF IX<>MAIN.FUNCTION(I) THEN _ M23$ = "(Variable)" : _ GOTO 12440 NEXT 12440 PRINT "130. Security level for main menu functions --------" + M23$ M24$ = STR$(FILES.FUNCTION(1)) IX = FILES.FUNCTION(1) FOR I = 2 TO NUM.FILES IF IX<>FILES.FUNCTION(I) THEN _ M24$ = "(Variable)" : _ GOTO 12450 NEXT 12450 PRINT "131. Security level for file menu functions --------" + M24$ M25$ = STR$(UTILITY.FUNCTION(1)) IX = UTILITY.FUNCTION(1) FOR I = 2 TO NUM.UTILITY IF IX<>UTILITY.FUNCTION(I) THEN _ M25$ = "(Variable)" : _ GOTO 12460 NEXT 12460 PRINT "132. Security level for utilities menu functions ---" + M25$ M26$ = STR$(GLOBAL.FUNCTION(1)) IX = GLOBAL.FUNCTION(1) FOR I = 1 TO NUM.GLOBAL IF IX<>GLOBAL.FUNCTION(I) THEN _ M26$ = "(Variable)" : _ GOTO 12465 NEXT 12465 PRINT "133. Security level for GLOBAL commands ------------" + M26$ PRINT "134. Max # of password changes in a session --------" + STR$(MAXIMUM.PASSWORD.CHANGES) PRINT "135. Minimum security for temp. password changes ---" + STR$(MINIMUM.SECURITY.FOR.TEMP.PASSWORD) PRINT "136. Minimum security to overwrite on uploads ------" + STR$(OVERWRITE.SECURITY.LEVEL) PRINT "137. User's security exempted from 'packing' -------" + STR$(SEC.LVL.EXEMPT.FRM.PURGING) PRINT "138. Default security to read new PRIVATE messages -" + STR$(PRIVATE.READ.SEC) PRINT "139. Default security to read new PUBLIC messages --" + STR$(PUBLIC.READ.SEC) PRINT "140. Minimum security to change msg.'s security ----" + STR$(SEC.CHANGE.MSG) GOTO 12580 12466 DISPLAYED.PAGE.NUMBER = 8 GOSUB 24800 LOCATE 3,1 PRINT "141. Call-back verification ----------------------- " + NOT.YET.IN$ ' CALLBACK.VERIFICATION$ PRINT "142. Drive/path where personal files & dir stored - " + PERSONAL.DRVPATH$ PRINT "143. Name of Personal Directory ------------------- " + PERSONAL.DIR$ PRINT "144. Protocol required for personal downloads ----- " + MID$("<none> Ascii XMODEM Xm/CRC Kermit Ymodem Imodem YmodemGWxmodem", 7 * INSTR("NAXCKYIGW",PERSONAL.PROTOCOL$) - 6,7) PRINT "145. Files with download security are listed in --- " + FILESEC.FILE$ PRINT "146. File name with privileged group passwords is - " + PASSWORD.FILE$ PRINT "147. Concatenate multi-file ASCII downloads ------- " + FNYESNO$(PERSONAL.CONCAT) PRINT "148. Min SECURITY to CATEGORIZE uploads -----------" + STR$(SL.CATEGORIZE.UPLOADS) PRINT "149. Min security level to view new uploads -------" + STR$(MIN.SEC.TO.VIEW) PRINT "150. Security level exempt from 'epi-log' file ----" + STR$(SECURITY.EXEMPT.FROM.EPILOG) PRINT "151. Min. security to 'AUTO ADD' conference user --" + AUTO.ADD.SECURITY$ PRINT "152. Min. security for old caller to turbo logon --" + STR$(ALLOW.CALLER.TURBO) PRINT "153. Min. security to describe an existing file ---" + STR$(ADD.DIR.SECURITY) PRINT "154. Help file to display for a security violation- " + SECVIO.HLP$ TIME.LOCK$ = MID$("<none> DOORS DOWNLDSBOTH ",TIME.LOCK*7+1,7) PRINT "155. Time lock on DOORS and DOWNLOADS ------------- "; TIME.LOCK$ PRINT "156. Min. sec level exempt from auto-update of sec-" ; AUTO.UPGRADE.SEC PRINT "157. Min security to READ & KILL all messages -----" ; SEC.KILL.ANY PRINT "158. Do not display messages beginning with ------- "; SCREEN.OUT.MSG$ GOTO 12580 12470 DISPLAYED.PAGE.NUMBER = 9 GOSUB 30040 ' MAX.USR.FILE.SIZE.FRM.DEF = HIGHEST.USER.RECORD MAX.MSG.FILE.SIZE.FRM.DEF! = HIGHEST.MESSAGE.RECORD MAX.ALLOWED.MSGS.FRM.DEF = MAXIMUM.NUMBER.OF.MSGS GOSUB 24800 LOCATE 3,1 PRINT "161. Maximum number of concurrent RBBS-PC's -------" + STR$(MAXIMUM.NUMBER.OF.NODES) MT$ = "single RBBS-PC copy " IF MAXIMUM.NUMBER.OF.NODES <> 1 THEN _ MT$ = "concurrent RBBS-PC's" : _ SUBROUTINE.PARAMETER = 2 : _ IF NETWORK.TYPE < 0 OR NETWORK.TYPE > 7 THEN _ SUBROUTINE.PARAMETER = 1 : _ CALL NETTYPE : _ ELSE CALL NETTYPE IF NETWORK.TYPE = 6 THEN _ MT$ = "NETBIOS " IF NETWORK.TYPE = 7 THEN _ MT$ = "DoubleDOS " PRINT "162. Environment running " + MT$ + " ------ " + NETWORK.TYPE$ PRINT "163. RBBS-PC 'recycle' method when users log off --- " + RECYCLE.TO.DOS$ FILE$ = MAIN.MESSAGE.FILE$ GOSUB 30180 MAX.MSG.FILE.SIZE.FRM.DEF! = UG PRINT "164. Number of records in the User File ------------";STR$(MAX.USR.FILE.SIZE.FRM.DEF) PRINT "165. Number of records in the Message File ---------";STR$(MAX.MSG.FILE.SIZE.FRM.DEF!) PRINT "166. Maximum number of messages allowed ------------" + STR$(MAX.ALLOWED.MSGS.FRM.DEF) PRINT "167. Conference File Maintenance." PRINT "168. Default extension for compressed files -------- " ; DEFAULT.EXTENSION$ PRINT "169. Additional extensions for compressed files ---- " ; COMPRESSED.EXT$ PRINT "170. Message file GROWS in size as messages added -- " ; FNYESNO$(MESSAGES.CAN.GROW) GOTO 12580 12480 DISPLAYED.PAGE.NUMBER = 10 GOSUB 24800 RB = 0 LOCATE 3,1 PRINT "181. Pack " + MAIN.MESSAGE.FILE$ + " file. PRINT "182. Rebuild " + MAIN.USER.FILE$ + " file. PRINT "183. Print " + MAIN.MESSAGE.FILE$ + " 'header' records. PRINT "184. Renumber messages in " + MAIN.MESSAGE.FILE$ + " file. PRINT "185. Repair messages in " + MAIN.MESSAGE.FILE$ + " file. PRINT "186. Make all users answer required questionnaire." PRINT "187. Check FMS directory structure." PRINT "188. Check Personal Download directory structure." PRINT "189. Set most critical parameters." PRINT "190. Set parameters new to RBBS-PC " + CONFIG.VERSION$ PRINT "191. Reset active printers for all nodes." PRINT "192. Make user pref. on hilighting match color graphics." GOTO 12580 12490 DISPLAYED.PAGE.NUMBER = 11 GOSUB 24800 LOCATE 3,1 PRINT "201. Drive available for uploading files to ------- " + DRIVE.FOR.UPLOADS$ + ":" PRINT "202. File name of Upload Directory --------------- " + UPLOAD.DIRECTORY$ PRINT "203. Drive/path where Upload Directory stored ----- " + UPLOAD.PATH$ PRINT "204. Drive(s) available for Downloading ----------- " + DRIVES.FOR.DOWNLOADS$ PRINT "205. Will you be using DOS sub-directories? ------- " ; FNYESNO$(WILL.SUBDIRS.B.USED) PRINT "206. Write Uploads to a DOS sub-directory? -------- " + FNYESNO$(UPLOAD.TO.SUBDIR) PRINT "207. Are downloads from DOS sub-directories? ------ " + FNYESNO$(DOWNLOAD.TO.SUBDIR) PRINT "208. List, change, add, delete sub-directories." PRINT "209. Extension for file directories --------------- " + DIRECTORY.EXTENTION$ X$ = ALTDIR.EXTENSION$ IF ALTDIR.EXTENSION$ = "" OR _ ALTDIR.EXTENSION$ = "<none>" THEN _ X$ = NONE.PICKED$ PRINT "210. Alternate extension for directory files ------ " + X$ PRINT "211. Name (prefix) of directory of directories ---- " + DIRECTORY.PREFIX$ PRINT "212. Omit directory of directories in N)ew cmnd. -- " + OMIT.MAIN.DIRECTORY$ X$ = ALWAYS.STREW.TO$ IF ALWAYS.STREW.TO$ = "" OR _ ALWAYS.STREW.TO$ = "<none>" THEN _ X$ = "NO" PRINT "213. Copy all upload descriptions to -------------- " + X$ A$ = FMS.DIRECTORY$ IF FMS.DIRECTORY$ = "" THEN _ A$ = NONE.PICKED$ PRINT "214. Name of master File Management System dir is - " + A$ PRINT "215. Limit file searches to master FMS dir only --- " ; FNYESNO$(LIMIT.SEARCH.TO.FMS) PRINT "216. Default category code for uploads ------------ " + DEFAULT.CATEGORY.CODE$ PRINT "217. File containing valid directory categories --- " + DIR.CATEGORY.FILE$ X$ = MASTER.DIRECTORY.NAME$ IF MASTER.DIRECTORY.NAME$ = "" THEN _ X$ = "NO" PRINT "218. Limit search for 'ALL' dirs to directory ----- " + X$ PRINT "219. Max length of description of uploaded file ---" + STR$(MAX.DESC.LEN) PRINT "220. Drive/path(optional) for directory files ----- " + DIRECTORY.PATH$ GOTO 12580 12500 DISPLAYED.PAGE.NUMBER = 12 GOSUB 24800 LOCATE 3,1 PRINT "221. Communications port to be used by RBBS-PC ---- " + COM.PORT$ PRINT "222. # of seconds to wait for modem to initialize -" + STR$(MODEM.INIT.WAIT.TIME) PRINT "223. Seconds to wait before issuing modem commands-" + STR$(MODEM.COMMAND.DELAY.TIME) PRINT "224. Number of rings to wait before answering -----" + STR$(REQUIRED.RINGS); IF INSTR(USER.INIT.COMMAND$, "S0=255 ") > 0 THEN _ PRINT " RING BACK"; PRINT PRINT "225. Set the modem commands" PRINT "226. ---------------------------------------------- " PRINT "227. Issue modem commands between rings ----------- " ; FNYESNO$(COMMANDS.BETWEEN.RINGS) PRINT "228. Baud rate to initially open modem at --------- " + MODEM.INIT.BAUD$ X$ = STR$(WAIT.BEFORE.DISCONNECT) + " seconds" IF WAIT.BEFORE.DISCONNECT = 0 THEN _ X$ = "NO" PRINT "229. Log off user who are idle for ----------------" + X$ PRINT "230. Are you using a 'DUMB' auto-answer modem? ---- " ; FNYESNO$(DUMB.MODEM) PRINT "231. Initialize modem firmware for RBBS-PC." PRINT "232. # seconds to wait after dropping DTR ---------" + STR$(DTR.DROP.DELAY) PRINT "233. File with PROTOCOL definitions --------------- " + PROTO.DEF$ PRINT "234. Always check caller for AUTODOWNLOAD support - " ; FNYESNO$(ASK.IDENTITY) PRINT "235. Require non-ascii protocol for BASIC files --- " ; FNYESNO$(REQUIRE.NON.ASCII) X$ = STR$(RECYCLE.WAIT) + " minutes" IF RECYCLE.WAIT = 0 THEN _ X$ = "<Don't recycle>" PRINT "236. Recycle if no calls are received within ------" + X$ PRINT "237. Leave modem at initial baud ------------------ " + FNYESNO$(KEEP.INIT.BAUD) GOTO 12580 12505 DISPLAYED.PAGE.NUMBER = 13 GOSUB 24800 LOCATE 3,1 PRINT "241. Restore initial parms. after change to N/8/1 - " + FNYESNO$(SWITCH.BACK) PRINT "242. Minimum baud required of new callers ---------" + STR$(MIN.NEWCALLER.BAUD) PRINT "243. Minimum baud required of old callers ---------" + STR$(MIN.OLDCALLER.BAUD) PRINT "244. Modem flow control uses Clear-to-Send (CTS)--- " + RTS$ PRINT "245. Modem flow control uses XON/XOFF ------------- " + FNYESNO$(XON.XOFF) PRINT "246. Seconds to wait for carrier after answering --" + STR$(MAX.CARRIER.WAIT) GOTO 12580 12510 DISPLAYED.PAGE.NUMBER = 14 GOSUB 24800 LOCATE 3,1 TIME.TO.DROP.TO.DOS$ = "<none>" IF TIME.TO.DROP.TO.DOS > 0 THEN _ TIME.TO.DROP.TO.DOS$ = STRING$(4 - (LEN(STR$(TIME.TO.DROP.TO.DOS)) - 1),"0") + MID$(STR$(TIME.TO.DROP.TO.DOS),2) 12512 PRINT "261. Time of day to exit to DOS ------------------- " + TIME.TO.DROP.TO.DOS$ PRINT "262. Net mail to invoke is ------------------------ " + NET.MAIL$ X$ = HOST.ECHO.ON$ IF HOST.ECHO.ON$ = "" THEN _ X$ = NONE.PICKED$ PRINT "263. Command for intermediate host to ECHO -------- " + X$ X$ = HOST.ECHO.OFF$ IF HOST.ECHO.OFF$ = "" THEN _ X$ = NONE.PICKED$ PRINT "264. Command for intermediate host NOT to ECHO ---- " + X$ X = INSTR("ICR",DEFAULT.ECHOER$) X$ = MID$("Intermediate hostCaller's softwareRBBS-PC",1 + 17 * (X - 1),17) PRINT "265. Who echos what a remote caller types? -------- " + X$ X$ = DEFAULT.LINE.ACK$ IF DEFAULT.LINE.ACK$ = "" THEN _ X$ = NONE.PICKED$ PRINT "266. String to acknowlege line in ASCII upload ---- "+ X$ PRINT "267. Name of sorted file list used in up/download = "; FAST.FILE.LIST$ ' 102201 PRINT "268. Name of locator file used in up/download ----- "; FAST.FILE.LOCATOR$ ' 102201 GOTO 12580 12520 DISPLAYED.PAGE.NUMBER = 15 GOSUB 24800 LOCATE 3,1 PRINT "281. Let new users set their preferences --------- " ; FNYESNO$(NEWUSER.SETS.DEFAULTS) PRINT "282. New users default sign-on mode -------------- " + NOT.YET.IN$ ' NEW.USER.DEFAULT.MODE$ PRINT "283. New users default file-transfer protocol ---- " + NOT.YET.IN$ ' NEW.USER.DEFAULT.PROTOCOL$ PRINT "284. Line feeds for new users default to --------- " + NOT.YET.IN$ ' NEW.USER.LINE.FEEDS$ PRINT "285. Nulls for new users default to -------------- " + NOT.YET.IN$ ' NEW.USER.NULLS$ PRINT "286. Prompt bell for new users defaults to ------- " + NOT.YET.IN$ ' NEW.USER.BELL$ PRINT "287. New users 'graphics' capability is assumed -- " + NOT.YET.IN$ ' NEW.USER.GRAPHICS$ PRINT "288. New users are assumed UPPERCASE only -------- " + NOT.YET.IN$ ' NEW.USER.CASE$ PRINT "289. New users message margins defaults to ------- " + NOT.YET.IN$ ' STR$(NEW.USER.MARGINS) PRINT "290. Add new users to USERS file ----------------- " ; FNYESNO$(REMEMBER.NEW.USERS) PRINT "291. Let new users on even when USERS file full -- " ; FNYESNO$(SURVIVE.NOUSER.ROOM) GOTO 12580 12530 DISPLAYED.PAGE.NUMBER = 16 GOSUB 24800 LOCATE 3,1 X$ = LIBRARY.DRIVE$ IF LIBRARY.DRIVE$ = "" THEN _ X$ = NONE.PICKED$ PRINT "301. Library drive ------------------------------- " + X$ PRINT "302. Drive/Path for Library directory ------------ " + LIBRARY.DIRECTORY.PATH$ PRINT "303. Extension for Library directory ------------- " + LIBRARY.DIRECTORY.EXTENTION$ PRINT "304. Drive/Path for Library work/RAM disk -------- " + LIBRARY.WORK.DISK.PATH$ PRINT "305. # of disks in Library -----------------------" + STR$(LIBRARY.MAX.DISK) PRINT "306. # of master Library subdirectories ----------" + STR$(LIBRARY.MAX.DIRECTORY) PRINT "307. # of subdirectories in each master ----------" + STR$(LIBRARY.MAX.SUBDIR) PRINT "308. Prefix of Library subdirectories ------------ " + LIBRARY.SUBDIR.PREFIX$ PRINT "309. Name of Library subsystem command menu ------ " + MENU$(6) PRINT "310. Symbols to use for Library menu commands ---- " + LIBRARY.COMMANDS$ M27$ = STR$(PS) IX = LIBRARY.FUNCTION(1) FOR I = 1 TO NUM.LIBRARY IF IX<>LIBRARY.FUNCTION(I) THEN _ M27$ = "(Variable)" : _ GOTO 12531 NEXT 12531 PRINT "311. Security level for Library menu functions --- " + M27$ PRINT "312. Drive/Path of archive utility --------------- " + LIBRARY.ARCHIVE.PATH$ PRINT "313. Name of executable archive utility ---------- " + LIBRARY.ARCHIVE.PROGRAM$ GOTO 12580 12540 DISPLAYED.PAGE.NUMBER = 17 GOSUB 24800 LOCATE 3,1 X$ = EMPHASIZE.ON.DEF$ IF EMPHASIZE.ON.DEF$ = "" THEN _ X$ = NONE.PICKED$ PRINT "321. String to turn ON Graphic Emphasis ----------- " + X$ X$ = EMPHASIZE.OFF.DEF$ IF EMPHASIZE.OFF.DEF$ = "" THEN _ X$ = NONE.PICKED$ PRINT "322. String to restore normal text (Emphasis OFF) - " + X$ PRINT "323. Caller's Foreground color 1 ------------------ " + FG.1.DEF$ PRINT "324. Caller's Foreground color 2 ------------------ " + FG.2.DEF$ PRINT "325. Caller's Foreground color 3 ------------------ " + FG.3.DEF$ PRINT "326. Caller's Foreground color 4 ------------------ " + FG.4.DEF$ X$ = MID$("<none>Blue Green Cyan Red PurpleYellowWhite",CALLER.BKGRD*6+1,6) PRINT "327. Caller's Background color -------------------- " ; X$ GOTO 12580 12550 DISPLAYED.PAGE.NUMBER = 18 GOSUB 24800 GOTO 12580 12580 IF PRE.DISPLAY THEN _ PRE.DISPLAY = FALSE : _ GOTO 12622 GOSUB 24890 12590 GOSUB 22160 12592 IF IX THEN _ 'IX Key Where to branch to ON IX GOTO 12360, _ ' 1 F1 - Global Parameters (Part 1) 12370, _ ' 2 F2 - Global Parameters (Part 2) 12380, _ ' 3 F3 - Global Parameters (Part 3) 12390, _ ' 4 F4 - RBBS-PC System Files (Part 1) 12400, _ ' 5 F5 - RBBS-PC System Files (Part 2) 12410, _ ' 6 F6 - RBBS-PC "doors" 12420, _ ' 7 F7 - RBBS-PC security parms. (Part 1) 12466, _ ' 8 F8 - RBBS-PC security parms. (Part 2) 12470, _ ' 9 F9 - Multiple RBBS-PC parameters 12480, _ '10 F10 - RBBS-PC's utilities 12490, _ '11 Shift-F1 - RBBS-PC File Manager 12500, _ '12 Shift-F2 - RBBS-PC comm. parameters (Part 1) 12505, _ '13 Shift-F3 - RBBS-PC comm. parameters (Part 2) 12510, _ '14 Shift-F4 - RBBS-PC Net Mail 12520, _ '15 Shift-F5 - New user parameters 12530, _ '16 Shift-F6 - Library parameters 12540, _ '17 Shift-F7 - RBBS-PC Color parameters 12310, _ '18 Shift-F8 - Reserved for future use 12340, _ '19 PgUp - Go to previous page 12330, _ '20 PgDn - Go to next page 12630, _ '21 End - Terminate CONFIG 12620 '22 Enter - Option selected followed by "enter" GOTO 12590 12620 GOSUB 50340 IF VAL(HJ$) < 1 OR VAL(HJ$) > 331 THEN _ GOTO 12580 IPAGE = INT((VAL(HJ$) - 1) / 20) IF DISPLAYED.PAGE.NUMBER <> IPAGE+1 THEN _ PRE.DISPLAY = TRUE : _ IX = IPAGE+1 : _ GOTO 12592 12622 ILOOKUP = VAL(HJ$) - (20 * IPAGE) IPAGE = IPAGE + 1 IF ILOOKUP < 1 THEN _ ILOOKUP = 20 : _ IPAGE = IPAGE - 1 12630 EXIT SUB ' ' * COMMON SUBROUTINE TO HANDLE THE FUNCTION KEYS, SCROLL BETWEEN CONFIG'S ' * PAGES OF OPTIONS, AND USER'S SELECTING A NUMERIC 4-CHARACTER OPTION. ' 22160 I! = FRE(C$) IX = 0 IF KSTACKED$ = "" THEN _ GOTO 22161 X = INSTR(KSTACKED$,CHR$(13)) IF X > 0 THEN _ IX = 22 : _ HJ$ = LEFT$(KSTACKED$,X-1) : _ KSTACKED$ = RIGHT$(KSTACKED$,LEN(KSTACKED$)-X) : _ OPTION$ = HJ$ : _ RETURN Y$ = CHR$(0) + CHR$(68) IF KSTACKED$ = "END" THEN _ Y$ = CHR$(0) + CHR$(79) KSTACKED$ = "" GOTO 22240 22161 Y$ = INKEY$ IF LEN(Y$) < 1 THEN _ GOTO 22161 IF LEN(Y$) = 2 THEN _ ' IF A FUNCTION KEY, BRANCH GOTO 22240 IF ASC(Y$) = 13 THEN _ ' IF A CARRIAGE RETURN, RETURN IX = 22 : _ RETURN IF ASC(Y$) = 8 AND LEN(HJ$) > 0 THEN _ HJ$ = LEFT$(HJ$,LEN(HJ$) - 1) : _ PRINT CHR$(29) + " " + CHR$(29); : _ GOTO 22161 IF ASC(Y$) < 48 OR ASC(Y$) > 57 THEN _ GOTO 22161 PRINT Y$; HJ$ = HJ$ + _ Y$ OPTION$ = HJ$ IF LEN(HJ$) > 4 THEN _ ' IF MORE THAN FOUR CHARACTERS, IX = 22 ' RETURN RETURN ' ' * COMMON SUBROUTINE TO HANDLE SET UP RETURN CODES FOR FUNCTION KEYS THAT ' * WERE PRESSED ON THE LOCAL PC RUNNING CONFIG ' 22240 IX = ASC(RIGHT$(Y$,1)) IF IX < 59 OR IX > 91 THEN _ ' IGNORE IF NOT F1 THROUGH F10 OR IX = 0: _ ' SHIFT-F1 THROUGH SHIFT-F8 RETURN IF IX = 73 THEN _ ' IF PGUP THEN SET IX = 19 IX = 19 : _ RETURN IF IX = 79 THEN _ ' IF END THEN SET IX = 21 IX = 21 : _ RETURN IF IX = 81 THEN _ ' IF PGDN THEN SET IX = 20 IX = 20 : _ RETURN IF (IX-58) < 11 THEN _ ' IF F1 THROUGH F10 SET IX = 1 IX = IX - 58 : _ ' THROUGH 10 ACCORDINGLY. RETURN IF (IX-73) > 10 AND _ ' IF SHIFT-F1 THROUGH SHIFT-F8 THEN (IX-73) < 19 THEN _ ' SET IX = 11 THROUGH 18 IX = IX - 73 : _ ' ACCORDINGLY. RETURN IX = 0 RETURN ' ' * ROUTINE TO DISPLAY THE PAGE HEADER FOR CONFIG'S DISPLAYS ' 24800 CLS I! = FRE(C$) COLOR 0,7,0 LOCATE 1,10 PRINT "RBBS-PC " + CONFIG.VERSION$ + " Configuration "; IF CONFERENCE.MODE THEN _ GOSUB 24970 COLOR FG,BG,BORDER PRINT " Page" + STR$(DISPLAYED.PAGE.NUMBER) + " of" + STR$(MAXIMUM.DISPLAYABLE.PAGES) RETURN 24890 A$ = "Enter parameter # to change, END to update, PgUp/PgDn to scroll:" 24900 LOCATE 24,5 PRINT A$; X = POS(0) + 2 PRINT STRING$((75 - LEN(A$)),32); LOCATE 24,X COLOR FG,BG,BORDER HJ$ = " I! = FRE(C$) RETURN ' ' * ROUTINE TO DISPLAY CONFERENCE MAINTENANCE MODE IN CONFIG'S DISPLAYS ' 24970 LOCATE 2,1 PRINT SPACE$(10) LOCATE 2,10 A$ = "Private" IF CONFERENCE.MODE = 2 THEN _ A$ = "Public" PRINT "(" + A$ + " Conference Maintenance Mode for " + _ MID$(MAIN.MESSAGE.FILE$,1,INSTR(MAIN.MESSAGE.FILE$,"M.DEF")-1) + _ ")"; RETURN ' ' * COMMON SUBROUTINE TO READ THE MESSAGES FILE'S CHECKPOINT RECORD ' 30040 IF NETWORK.TYPE = 6 THEN _ OPEN MAIN.MESSAGE.FILE$ FOR RANDOM SHARED AS #2 LEN=128 _ ELSE OPEN "R",2,MAIN.MESSAGE.FILE$,128 FIELD 2,128 AS RR$ GET 2,1 CALLS.TODATE! = VAL(MID$(RR$,1,8)) ' 1- 8 = number of last message on system FIRST.USER.RECORD = VAL(MID$(RR$,52,5)) ' 52- 56 = first rec. of user file CURRENT.USER.COUNT = VAL(MID$(RR$,57,5)) ' 57- 61 = next avail. user record HIGHEST.USER.RECORD = VAL(MID$(RR$,62,5)) ' 62- 66 = last rec. of user file FIRST.MESSAGE.RECORD = VAL(MID$(RR$,68,7)) ' 68- 74 = first rec. of msgs file NEXT.MESSAGE.RECORD = VAL(MID$(RR$,75,7)) ' 75- 81 = next avail. msgs record HIGHEST.MESSAGE.RECORD = VAL(MID$(RR$,82,7)) ' 82- 88 = last rec. of msgs file MAXIMUM.NUMBER.OF.MSGS = VAL(MID$(RR$,89,7)) ' 89- 95 = maximum number of messages MAXIMUM.NUMBER.OF.NODES = VAL(MID$(RR$,127,2)) '127-128 = maximum number of "nodes" CLOSE 2 RETURN ' ' * COMMON ROUTINE TO GET THE LENGTH OF A FILE ' 30180 IF NETWORK.TYPE = 6 THEN _ OPEN FILE$ FOR RANDOM SHARED AS #2 LEN=128 _ ELSE OPEN "R",2,FILE$,128 FIELD 2,128 AS RR$ UG = LOF(2) / 128 CLOSE 2 RETURN ' ' * COMMON SUBROUTINE TO KEEP STRING SPACE CLEAN AND CLEAR LINE 24 ' 50340 I! = FRE(C$) LOCATE 24,1 PRINT STRING$(79,32); RETURN ' ' * COMMON SUBROUTINE TO DISPLAY A MESSAGE ON LINE 24 ' 50345 GOSUB 50340 LOCATE 24,5 PRINT XX$; RETURN ' ' * COMMON SUBROUTINE TO BEEP AT THE SYSOP ' 60380 FOR I = 1 TO 3 BEEP NEXT RETURN END SUB ' $SUBTITLE: 'NETTYPE - subroutine to select supported networks' ' $PAGE ' ' SUBROUTINE NAME -- NETTYPE ' ' INPUT PARAMETERS -- MLCOM ' NETWORK.TYPE ' NETWORK.TYPE$ ' SUBROUTINE.PARAMETER ' ' OUTPUT PARAMETERS -- MLCOM ' NETWORK.TYPE ' NETWORK.TYPE$ ' ' SUBROUTINE PURPOSE -- TO SELECT THE RBBS-PC SUPPORTED NETWORKS ' SUB NETTYPE STATIC ON SUBROUTINE.PARAMETER GOTO 60382,60384 60382 CLS LOCATE 3,1 PRINT " RBBS-PC is supported in the following:" PRINT " Environment" PRINT " 0. Single RBBS-PC in an IBM DOS environment" PRINT " 1. MultiLink (multi-tasking under single DOS)" PRINT " 2. Omninet (CORVUS)" PRINT " 3. PC-NET (Orchid)" PRINT " 4. DESQview (Quarterdeck)" PRINT " 5. 10 NET (Fox Research)" PRINT " 6. NETBIOS (DOS SHARE)" PRINT " 7. DoubleDOS, but file sharing not supported." 60383 XX$ = "Select environment (0 to 7, [ENTER] quits)" I! = FRE(C$) LOCATE 24,1 PRINT STRING$(79,32); LOCATE 24,5 PRINT XX$; LINE INPUT;X$ IF X$ = "" THEN _ EXIT SUB NETWORK.TYPE = VAL(X$) IF NETWORK.TYPE < 0 OR NETWORK.TYPE > 7 THEN _ GOTO 60383 60384 IF NETWORK.TYPE = 0 THEN _ NETWORK.TYPE$ = "IBM's DOS" IF NETWORK.TYPE = 1 THEN _ MLCOM = TRUE : _ NETWORK.TYPE$ = "MultiLink" IF NETWORK.TYPE = 2 THEN _ NETWORK.TYPE$ = "Omninet" IF NETWORK.TYPE = 3 THEN _ NETWORK.TYPE$ = "PC-NET" IF NETWORK.TYPE = 4 THEN _ NETWORK.TYPE$ = "DESQview" IF NETWORK.TYPE = 5 THEN _ NETWORK.TYPE$ = "10 NET" IF NETWORK.TYPE = 6 THEN _ NETWORK.TYPE$ = "NETBIOS" IF NETWORK.TYPE = 7 THEN _ NETWORK.TYPE$ = "No file sharing!" IF SUBROUTINE.PARAMETER = 2 THEN _ EXIT SUB IF NETWORK.TYPE = 2 OR NETWORK.TYPE = 3 OR NETWORK.TYPE = 5 OR NETWORK.TYPE = 6 THEN _ CALL GETNUMYN ("Are you running Multi-Link with " + NETWORK.TYPE$,MLCOM) END SUB ' $SUBTITLE: 'CNFGINIT - subroutine to initialize CONFIG's constants' ' $PAGE ' ' SUBROUTINE NAME -- CNFGINIT ' ' INPUT PARAMETERS -- NONE ' ' OUTPUT PARAMETERS -- CONFIG'S CONSTANTS INITIALIZED ' ' SUBROUTINE PURPOSE -- TO INITIALIZE THE CONSTANTS USED BY CONFIG ' 60385 SUB CNFGINIT STATIC ' ' * INITALIZE ALL VARIABLES IF A .DEF FILE DOESN'T AREADY EXIST ' D$ = DD$ DRV$ = LEFT$(D$,1) FALSE = 0 TRUE = NOT FALSE SYSOP.SECURITY.LEVEL = 10 ACT.MNTHS.B4.DELETING = 1 ACTIVE.BULLETINS = 6 ADD.DIR.SECURITY = SYSOP.SECURITY.LEVEL ALLOW.CALLER.TURBO = 6 ALTDIR.EXTENSION$ = "" ALWAYS.STREW.TO$ = "" ANS.MENU$ = D$ + "MENUA" ASK.EXTENDED.DESC = SYSOP.SECURITY.LEVEL ASK.IDENTITY = FALSE AUTO.ADD.SECURITY = 5 AUTO.UPGRADE.SEC = SYSOP.SECURITY.LEVEL AUTOPAGE.DEF$ = D$ + "AUTOPAGE.DEF" BG = 0 BORDER = 0 BUFFER.SIZE = 128 BULLETIN.MENU$ = "BULLET" BULLETIN.PREFIX$ = "BULLET" BULLETINS.OPTIONAL = TRUE C$ = "" CALLER.BKGRD = 0 CALLERS.FILE$ = D$ + "CALLERS" SEC.KILL.ANY = SYSOP.SECURITY.LEVEL COM.PORT$ = "COM1" COMMANDS.BETWEEN.RINGS = FALSE COMMANDS.IN.PROMPT = TRUE COMMENTS.AS.MESSAGES = FALSE COMMENTS.FILE$ = D$ + "COMMENTS" COMPRESSED.EXT$ = ".ARC.PAK" COMPUTER.TYPE = 0 CONFERENCE.MENU$ = D$ + "CONFENCE" CONFERENCE.VIEWER.SEC.LVL = 0 CONFMAIL.LIST$ = D$ + "CONFMAIL.DEF" CONFIG.VERSION$ = "Version CPC17.3" DEFAULT.CATEGORY.CODE$ = "UNC" DAYS.IN.SUBSCRIPTION.PERIOD = 365 DAYS.TO.WARN = 60 DIR.CATEGORY.FILE$ = D$ + "DIR.CAT" DIRECTORY.PREFIX$ = "DIR" DEFAULT.ECHOER$ = "R" DEFAULT.LINE.ACK$ = "" DEFAULT.SECURITY.LEVEL = 5 DIRECTORY.EXTENTION$ = "DIR" DIRECTORY.PATH$ = D$ DISK.FOR.DOS$ = D$ DISKFULL.GO.OFFLINE = TRUE DNLD.SUB = 0 DOORS.AVAILABLE = FALSE DOORS.DEF$ = D$ + "DOORS.DEF" DOORS.TERMINAL.TYPE = 8 DOSANSI = FALSE DOS.VERSION = 2 DOWNLOAD.DRIVES$ = DRV$ + DRV$ DOWNLOAD.TO.SUBDIR = FALSE DRIVE.FOR.BULLETINS$ = D$ DRIVE.FOR.HELP.FILES$ = D$ DTR.DROP.DELAY = 3 DUMB.MODEM = FALSE ECHOER$ = "R" EMPHASIZE.OFF.DEF$ = "[27]" + "[0;40;33m" EMPHASIZE.ON.DEF$ = "[27]" + "[1;41;37m" END.OFFICE.HOURS = 2200 ENFORCE.UPLOAD.DOWNLOAD.RATIOS = FALSE EPILOG$ = D$ + "EPILOG.DEF" ESCAPE.INSECURE = FALSE EXPERT.USER = 0 EXPIRED.SECURITY = DEFAULT.SECURITY.LEVEL EXTENDED.LOGGING = FALSE EXTENSION.LIST$ = "ZIP" FAST.FILE.LIST$ = D$ + "FIDX.DEF" FAST.FILE.LOCATOR$ = D$ + "LIDX.DEF" FC = 5 FG = 7 FG.1.DEF$ = "Bright Green" FG.2.DEF$ = "Bright Yellow" FG.3.DEF$ = "Bright Purple" FG.4.DEF$ = "Bright Cyan" FILE.COMMANDS.DEFAULTS$ = "DGLNPSUV" FILE.COMMANDS$ = FILE.COMMANDS.DEFAULTS$ FILE.NOTIFY = FALSE FILES.FUNCTION$(1,1) = "D)ownload a file " FILES.FUNCTION$(2,1) = "G)oodbye " FILES.FUNCTION$(3,1) = "L)ist file directory " FILES.FUNCTION$(4,1) = "N)ew file search " FILES.FUNCTION$(5,1) = "P)ersonal files " FILES.FUNCTION$(6,1) = "S)earch files " FILES.FUNCTION$(7,1) = "U)pload a file " FILES.FUNCTION$(8,1) = "V)erbose archive list " FILES.FUNCTION$(1,2) = "D" FILES.FUNCTION$(2,2) = "G" FILES.FUNCTION$(3,2) = "L" FILES.FUNCTION$(4,2) = "N" FILES.FUNCTION$(5,2) = "P" FILES.FUNCTION$(6,2) = "S" FILES.FUNCTION$(7,2) = "U" FILES.FUNCTION$(8,2) = "V" FILESEC.FILE$ = D$ + "FILESEC" FIRST.NAME.PROMPT$ = "FIRST name" FOSSIL = 0 GB = FC GLOBAL.COMMANDS.DEFAULTS$ = "H?QX" GLOBAL.COMMANDS$ = GLOBAL.COMMANDS.DEFAULTS$ GLOBAL.FUNCTION$(1,1) = "H)elp on-line " GLOBAL.FUNCTION$(2,1) = "?)help on-line (=H) " GLOBAL.FUNCTION$(3,1) = "Q)uit this part " GLOBAL.FUNCTION$(4,1) = "X)Expert toggle on/off " GLOBAL.FUNCTION$(1,2) = "H" GLOBAL.FUNCTION$(2,2) = "?" GLOBAL.FUNCTION$(3,2) = "Q" GLOBAL.FUNCTION$(4,2) = "X" GO.TO.SHELL = TRUE HELP$(3) = "HELP03" HELP$(4) = "HELP04" HELP$(7) = "HELP07" HELP$(9) = "HELP09" HELP.EXTENSION$ = "HLP" HELP.FILE.PREFIX$ = "HELP0" HELP.PATH$ = D$ HOST.ECHO.OFF$ = "" HOST.ECHO.ON$ = "" IB = 0 KEEP.INIT.BAUD = FALSE KEEP.TIME.CREDITS = FALSE LAST.NAME.PROMPT$ = "LAST name" LEN.HASH = 31 LEN.INDIV = 0 LIBRARY.ARCHIVE.PATH$ = D$ LIBRARY.ARCHIVE.PROGRAM$ = "ARCA " LIBRARY.COMMANDS.DEFAULTS$ = "ACDGLSV" LIBRARY.COMMANDS$ = LIBRARY.COMMANDS.DEFAULTS$ LIBRARY.DRIVE$ = "" LIBRARY.MAX.DISK = 705 LIBRARY.MAX.DIRECTORY = 7 LIBRARY.MAX.SUBDIR = 100 LIBRARY.SUBDIR.PREFIX$ = "DISK" LIBRARY.DIRECTORY.PATH$ = D$ LIBRARY.DIRECTORY.EXTENTION$ = "CDR" LIBRARY.FUNCTION$(1,1) = "A)rchive a Library disk " LIBRARY.FUNCTION$(2,1) = "C)hange Library disk " LIBRARY.FUNCTION$(3,1) = "D)ownload a file " LIBRARY.FUNCTION$(4,1) = "G)oodbye " LIBRARY.FUNCTION$(5,1) = "L)ist a file directory " LIBRARY.FUNCTION$(6,1) = "S)earch files " LIBRARY.FUNCTION$(7,1) = "V)erbose archive list " LIBRARY.FUNCTION$(1,2) = "A" LIBRARY.FUNCTION$(2,2) = "C" LIBRARY.FUNCTION$(3,2) = "D" LIBRARY.FUNCTION$(4,2) = "G" LIBRARY.FUNCTION$(5,2) = "L" LIBRARY.FUNCTION$(6,2) = "S" LIBRARY.FUNCTION$(7,2) = "V" LIBRARY.WORK.DISK.PATH$ = D$ LIMIT.SEARCH.TO.FMS = FALSE LOGON.MAIL.LEVEL$ = "A" LSB = 1016 60390 MACRO.DRVPATH$ = D$ MACRO.EXTENSION$ = "" MAIN.COMMANDS.DEFAULTS$ = "ABCDEFIJKOPRSTUVW@" MAIN.COMMANDS$ = MAIN.COMMANDS.DEFAULTS$ MAIN.FUNCTION$(1,1) = "A)nswer questionnaire " MAIN.FUNCTION$(2,1) = "B)ulletins " MAIN.FUNCTION$(3,1) = "C)omments " MAIN.FUNCTION$(4,1) = "D)oor subsystem " MAIN.FUNCTION$(5,1) = "E)nter message " MAIN.FUNCTION$(6,1) = "F)iles subsystem " MAIN.FUNCTION$(7,1) = "I)nitial welcome " MAIN.FUNCTION$(8,1) = "J)oin a conference " MAIN.FUNCTION$(9,1) = "K)ill messages " MAIN.FUNCTION$(10,1) = "O)perator page " MAIN.FUNCTION$(11,1) = "P)ersonal mail " MAIN.FUNCTION$(12,1) = "R)ead messages " MAIN.FUNCTION$(13,1) = "S)can messages header " MAIN.FUNCTION$(14,1) = "T)opic msg scan " MAIN.FUNCTION$(15,1) = "U)tilities subsystem " MAIN.FUNCTION$(16,1) = "V)iew conference mail " MAIN.FUNCTION$(17,1) = "W)ho's on other nodes " MAIN.FUNCTION$(18,1) = "@)Library subsystem " MAIN.FUNCTION$(1,2) = "A" MAIN.FUNCTION$(2,2) = "B" MAIN.FUNCTION$(3,2) = "C" MAIN.FUNCTION$(4,2) = "D" MAIN.FUNCTION$(5,2) = "E" MAIN.FUNCTION$(6,2) = "F" MAIN.FUNCTION$(7,2) = "I" MAIN.FUNCTION$(8,2) = "J" MAIN.FUNCTION$(9,2) = "K" MAIN.FUNCTION$(10,2) = "O" MAIN.FUNCTION$(11,2) = "P" MAIN.FUNCTION$(12,2) = "R" MAIN.FUNCTION$(13,2) = "S" MAIN.FUNCTION$(14,2) = "T" MAIN.FUNCTION$(15,2) = "U" MAIN.FUNCTION$(16,2) = "V" MAIN.FUNCTION$(17,2) = "W" MAIN.MESSAGE.BACKUP$ = D$ + "MESSAGES.BAK" MAIN.MESSAGE.FILE$ = D$ + "MESSAGES" MAIN.PUI$ = D$ + "MAIN.PUI" MAIN.USER.FILE$ = D$ + "USERS" MASTER.DIRECTORY.NAME$ = "" MAX.ALLOWED.MSGS.FRM.DEF = 5 MAX.CARRIER.WAIT = 30 MAX.DESC.LEN = 40 MAX.EXTENDED.LINES = 2 MAX.MESSAGE.LINES = 19 MAX.PER.DAY = 0 MAX.REG.SEC = 0 MAX.USR.FILE.SIZE.FRM.DEF = 16 MAX.WORK.VAR = 30 MAXD = 15 MAXIMUM.DISPLAYABLE.PAGES = 17 MAXIMUM.PASSWORD.CHANGES = 3 MAXIMUM.VIOLATIONS = 5 MAXIMUM.NUMBER.OF.NODES = 1 MENU$(1) = D$ + "MENU1" MENU$(2) = D$ + "MENU2" MENU$(3) = D$ + "MENU3" MENU$(4) = D$ + "MENU4" MENU$(5) = D$ + "MENU5" MENU$(6) = D$ + "MENU6" MENUS.CAN.PAUSE = TRUE MESSAGE.REMINDER = TRUE MESSAGES.CAN.GROW = FALSE MIN.NEWCALLER.BAUD = 0 MIN.OLDCALLER.BAUD = 0 MIN.SEC.TO.VIEW = DEFAULT.SECURITY.LEVEL MINIMUM.LOGON.SECURITY = 0 MINIMUM.SECURITY.FOR.TEMP.PASSWORD = 5 MINUTES.PER.SESSION! = 72 MLCOM = FALSE MM = 5 MO$ = DD$ MODEM.ANSWER.COMMAND$ = "ATQ0X1V1A" MODEM.COMMAND.DELAY.TIME = 1 MODEM.COUNT.RINGS.COMMAND$ = "ATS1?" MODEM.GO.OFFHOOK.COMMAND$ = "ATQ1E1H1M0" MODEM.INIT.BAUD$ = "300" MODEM.INIT.COMMAND$ = "ATM0Q1S2=255S10=30E0Q0X1S0=254 " MODEM.INIT.WAIT.TIME = 2 MODEM.RESET.COMMAND$ = "ATZ" MUSIC = FALSE NET.MAIL$ = "<none>" NETWORK.TYPE = 0 NETWORK.TYPE$ = "IBM's DOS" NEW.FILES.CHECK = FALSE NEW.USER.QUESTIONNAIRE$ = D$ + "RBBS-REG.DEF" NEWUSER.FILE$ = D$ + "NEWUSER" NEWUSER.SETS.DEFAULTS = TRUE OMIT.MAIN.DIRECTORY$ = "NO" OMIT.UPLOAD.DIRECTORY$ = "NO" OVERWRITE.SECURITY.LEVEL = SYSOP.SECURITY.LEVEL PAGE.LENGTH = 23 PAGING.PRINTER.SUPPORT$ = ". " PASSWORD.FILE$ = D$ + "PASSWRDS" PCJR = FALSE PERSONAL.BEGIN = 1 PERSONAL.DIR$ = D$+"PRIV.DEF" PERSONAL.DRVPATH$ = D$ PERSONAL.LEN = 31 PERSONAL.CONCAT = FALSE PRELOG$ = D$ + "PRELOG" PRIVATE.READ.SEC = DEFAULT.SECURITY.LEVEL PROTO.DEF$ = D$ + "PROTO.DEF" PROMPT.BELL = 0 PROMPT.HASH$ = "Name" PROMPT.INDIV$ = "" PS = 5 PUBLIC.READ.SEC = DEFAULT.SECURITY.LEVEL QUES.PATH$ = D$ RBBS.BAT$ = D$ + "RBBS" + NODE.ID$ + ".BAT" RBBS.NAME$ = "RBBS-PC" RCTTY.BAT$ = D$ + "RCTTY" + NODE.ID$ + ".BAT" RECYCLE.TO.DOS = 0 RECYCLE.TO.DOS$ = "INTERNAL" RECYCLE.WAIT = 0 REDIRECT.IO.METHOD = TRUE REGISTRATION.PROGRAM$ = "<none>" REMEMBER.NEW.USERS = TRUE REMIND.FILE.TRANSFERS = FALSE REMIND.PROFILE = FALSE REQUIRE.NON.ASCII = TRUE REQUIRED.QUESTIONNAIRE$ = "<none>" REQUIRED.RINGS = 1 RESTRICT.BAUD = FALSE RESTRICT.BY.DATE = FALSE RESTRICT.VALID.CMDS = FALSE RTS$ = "NO" SCREEN.OUT.MSG$ = "SEEN-BY: " SEC.CHANGE.MSG = SYSOP.SECURITY.LEVEL SEC.LVL.EXEMPT.FRM.PURGING = SYSOP.SECURITY.LEVEL SECVIO.HLP$ = D$ + "SECVIO." + HELP.EXTENSION$ SECURITY.EXEMPT.FROM.EPILOG= DEFAULT.SECURITY.LEVEL + 1 SF = SYSOP.SECURITY.LEVEL SHOOT.YOURSELF = FALSE SHOW.SECTION = TRUE SIZE.OF.STACK = 1024 SL.CATEGORIZE.UPLOADS = SYSOP.SECURITY.LEVEL SMART.TEXT = 123 START.HASH = 1 START.INDIV = 0 START.OFFICE.HOURS = 800 SURVIVE.NOUSER.ROOM = FALSE SWITCH.BACK = FALSE SYSOP.COMMANDS.DEFAULTS$ = "1234567" SYSOP.COMMANDS$ = SYSOP.COMMANDS.DEFAULTS$ SYSOP.FUNCTION$(1,1) = " 1 List comments " SYSOP.FUNCTION$(2,1) = " 2 List CALLERS log " SYSOP.FUNCTION$(3,1) = " 3 Recover a message " SYSOP.FUNCTION$(4,1) = " 4 Erase comments " SYSOP.FUNCTION$(5,1) = " 5 User maintenance " SYSOP.FUNCTION$(6,1) = " 6 Toggle Page bell " SYSOP.FUNCTION$(7,1) = " 7 Exit to DOS " SYSOP.FUNCTION$(1,2) = " 1" SYSOP.FUNCTION$(2,2) = " 2" SYSOP.FUNCTION$(3,2) = " 3" SYSOP.FUNCTION$(4,2) = " 4" SYSOP.FUNCTION$(5,2) = " 5" SYSOP.FUNCTION$(6,2) = " 6" SYSOP.FUNCTION$(7,2) = " 7" SYSOP.FIRST.NAME$ = "TOM" SYSOP.LAST.NAME$ = "MACK" SYSOP.MENU.SECURITY.LEVEL = SYSOP.SECURITY.LEVEL SYSOP.PASSWORD.1$ = "RBBS-PC" SYSOP.PASSWORD.2$ = "CPC173" TIME.TO.DROP.TO.DOS = 0 TRASHCAN.FILE$ = D$ + "TRASHCAN" TURN.PRINTER.OFF = FALSE TURBO.RBBS = TRUE UE = 5 FMS.DIRECTORY$ = "" UPCAT.HELP$ = "UPCAT" UPLOAD.DIRECTORY$ = "99" UPLOAD.PATH$ = D$ UPLOAD.SUBDIR$ = "" UPLOAD.TIME.FACTOR! = 0 UPLOAD.TO.SUBDIR = FALSE USE.BASIC.WRITES = FALSE USE.DEVICE.DRIVER$ = "" USER.INITIALIZE.COMMAND$ = "AT&C1&D3B1E0V1M0S0=0&T5" USER.FIRMWARE.CLEAR.CMND$ = "AT&F" USER.FIRMWARE.WRITE.CMND$ = "&W" USER.LOCATION$ = "CITY and STATE" UTIL.COMMANDS.DEFAULTS$ = "BCEFGLMPRSTU" UTIL.COMMANDS$ = UTIL.COMMANDS.DEFAULTS$ UTILITY.FUNCTION$(1,1) = "B)aud rate " UTILITY.FUNCTION$(2,1) = "C)lock (time) " UTILITY.FUNCTION$(3,1) = "E)cho " UTILITY.FUNCTION$(4,1) = "F)ile x-fer protocol " UTILITY.FUNCTION$(5,1) = "G)raphics " UTILITY.FUNCTION$(6,1) = "L)ines per page " UTILITY.FUNCTION$(7,1) = "M)sg margin setting " UTILITY.FUNCTION$(8,1) = "P)assword change " UTILITY.FUNCTION$(9,1) = "R)eview defaults " UTILITY.FUNCTION$(10,1) = "S)tatistics " UTILITY.FUNCTION$(11,1) = "T)oggle " UTILITY.FUNCTION$(12,1) = "U)ser log scan " VOICE.TYPE = 0 VOICE.TYPE$ = NONE.PICKED$ XON.XOFF = FALSE FOR I = 1 TO LEN(UTIL.COMMANDS.DEFAULTS$) UTILITY.FUNCTION$(I,2) = MID$(UTIL.COMMANDS.DEFAULTS$,I,1) NEXT WAIT.BEFORE.DISCONNECT = 180 WELCOME.FILE$ = D$ + "WELCOME" WELCOME.INTERRUPTABLE = TRUE WILL.SUBDIRS.B.USED = FALSE WRITE.BUF.DEF = 1024 FOR I = 1 TO NUM.SYSOP SYSOP.FUNCTION(I) = SF NEXT FOR I = 1 TO NUM.MAIN MAIN.FUNCTION(I) = MM NEXT FOR I = 1 TO NUM.FILES FILES.FUNCTION(I) = FC NEXT FOR I = 1 TO NUM.LIBRARY LIBRARY.FUNCTION(I) = PS NEXT FOR I = 1 TO NUM.UTILITY UTILITY.FUNCTION(I) = UE NEXT FOR I = 1 TO NUM.GLOBAL GLOBAL.FUNCTION(I) = GB NEXT END SUB ' $SUBTITLE: 'VOICETYPE - subroutine to select voice' ' $PAGE ' ' SUBROUTINE NAME -- VOICETYPE ' ' INPUT PARAMETERS -- VOICE.TYPE ' VOICE.TYPE$ ' SUBROUTINE.PARAMETER ' ' OUTPUT PARAMETERS -- VOICE.TYPE ' VOICE.TYPE$ ' ' SUBROUTINE PURPOSE -- TO SELECT THE RBBS-PC SUPPORTED VOICE ' SYNTHESIZERS ' SUB VOICETYPE STATIC ON SUBROUTINE.PARAMETER GOTO 60482,60484 60482 CLS LOCATE 3,1 PRINT " RBBS-PC is supported in the following:" PRINT " Voice Synthesizers" PRINT " 0. None" PRINT " 1. CompuTalker" PRINT " B.G. MICRO" PRINT " P.O. Box 280298" PRINT " Dallas, Texas 75228" PRINT " 2. HearSay 1000" PRINT " HEARSAY INC." PRINT " 1825 74th Street" PRINT " Brooklyn, New York 11204" 60483 CALL ASKRO("Select environment (0 to 2, [ENTER] quits)",24,X$) IF X$ = "" THEN _ EXIT SUB VOICE.TYPE = VAL(X$) IF VOICE.TYPE < 0 OR VOICE.TYPE > 2 THEN _ GOTO 60483 60484 IF VOICE.TYPE = 0 THEN _ VOICE.TYPE$ = NONE.PICKED$ IF VOICE.TYPE = 1 THEN _ VOICE.TYPE$ = "CompuTalker" IF VOICE.TYPE = 2 THEN _ VOICE.TYPE$ = "HearSay 1000" END SUB ' $SUBTITLE: 'ASKRO - ask a question at a specific row' ' $PAGE ' ' SUBROUTINE NAME -- ASKRO ' ' INPUT PARAMETERS -- PARAMETER MENANING ' ANS$ STRING TO PUT THE ANSWER IN ' STRNG$ STRING CONTAINING THE QUESTION ' RO ROW TO ASK THE QUESTION ON ' ' OUTPUT PARAMETERS -- ANS$ RESPONSE FROM THE KEYBOARD ' ' SUBROUTINE PURPOSE -- TO ASK A QUESTION ON THE PC'S DISPLAY AT A ' SPECIFIC ROW ' SUB ASKRO (STRNG$,RO,ANS$) STATIC 61100 LOCATE RO,1 PRINT SPACE$(79); LOCATE RO,5 PRINT STRNG$;" "; LINE INPUT;ANS$ END SUB ' $SUBTITLE: 'GETINIT - get an integer' ' $PAGE ' ' SUBROUTINE NAME -- GETINIT ' ' INPUT PARAMETERS -- PARAMETER MENANING ' ANS WHERE TO PUT THE ANSWER IN ' STRNG$ STRING CONTAINING THE QUESTION ' RO ROW TO ASK THE QUESTION ON ' MIN MINIMUM ACCEPTABLE NUMBER ' MAX MAXIMUM ACCEPTABLE NUMBER ' ' OUTPUT PARAMETERS -- ANS RESPONSE FROM THE KEYBOARD ' ' SUBROUTINE PURPOSE -- TO ASK A QUESTION ON THE PC'S DISPLAY AT A ' SPECIFIC ROW AND GET AN INTEGER BACK ' SUB GETINIT (STRNG$,RO,MIN,MAX,ANS,CR) STATIC 61110 LOCATE RO,1 CR = FALSE ANS = MIN PRINT SPACE$(79); LOCATE RO,5 PRINT STRNG$;" "; LINE INPUT;ANS$ IF ANS$ = "" THEN _ CR = TRUE : _ EXIT SUB IF VAL(ANS$) < MIN OR _ VAL(ANS$) > MAX THEN _ GOTO 61110 ANS = VAL(ANS$) IF ANS = 0 AND LEFT$(ANS$,1) <> "0" THEN _ GOTO 61110 END SUB ' $SUBTITLE: 'GETNUMYN - get a TRUE-FALSE answer to a YES OR NO question' ' $PAGE ' ' SUBROUTINE NAME -- GETNUMYN ' ' INPUT PARAMETERS -- PARAMETER MENANING ' STRNG$ STRING CONTAINING THE QUESTION ' ' OUTPUT PARAMETERS -- ANS Returned value - -1 IF yes, 0 IF no ' ' SUBROUTINE PURPOSE -- TO ASK A QUESTION ON THE PC'S DISPLAY AND GET A ' YES OR NO ANSWER CONVERTED TO TRUE/FALSE ' SUB GETNUMYN (STRNG$,ANS) STATIC CALL GETYESNO (STRNG$,ANS$) ANS = FNYESNO (ANS$) END SUB ' $SUBTITLE: 'GETYESNO - Ask a YES OR NO question' ' $PAGE ' ' SUBROUTINE NAME -- GETYESNO ' ' INPUT PARAMETERS -- PARAMETER MENANING ' ANS$ STRING TO PUT THE ANSWER IN ' STRNG$ STRING CONTAINING THE QUESTION ' ' OUTPUT PARAMETERS -- ANS$ RESPONSE FROM THE KEYBOARD ' ' SUBROUTINE PURPOSE -- TO ASK A QUESTION ON THE PC'S DISPLAY AND GET A ' YES OR NO ANSWER ' SUB GETYESNO (STRNG$,ANS$) STATIC 61200 CALL ASKRO (STRNG$+" Y)es or N)o",24,HJ$) L = LEN(HJ$) IF L < 1 OR L > 3 THEN _ GOTO 61207 CALL ALLCAPS(HJ$) X = INSTR("NY",LEFT$(HJ$,1)) ON X GOTO 61210,61212 61207 BEEP GOTO 61200 61210 ANS$ = "NO" EXIT SUB 61212 ANS$ = "YES" EXIT SUB END SUB ' $SUBTITLE: 'ALLCAPS - convert a sting into all capital letters' ' $PAGE ' ' SUBROUTINE NAME -- ALLCAPS ' ' INPUT PARAMETERS -- PARAMETER MENANING ' STRNG$ STRING CONTAINING THE QUESTION ' ' OUTPUT PARAMETERS -- STRNG$ CAPITALIZED STRING ' ' SUBROUTINE PURPOSE -- TO CAPITALIZE A STRING ' SUB ALLCAPS (STRNG$) STATIC FOR Z = 1 TO LEN(STRNG$) MID$(STRNG$,Z,1) = CHR$(ASC(MID$(STRNG$,Z,1)) + _ 32 * (ASC(MID$(STRNG$,Z,1)) > 96)) NEXT END SUB ' $SUBTITLE: 'ASKUPOS - find the unique user field for USERS' ' $PAGE ' ' SUBROUTINE NAME -- ASKUPOS ' ' INPUT PARAMETERS -- PARAMETER MENANING ' HDR$ HEADER ' BEGIN.COL BEGINNING COLUMN OF FIELD ' FIELD.LEN LENGTH OF FIELD IN USER'S RECORD ' PRMPT$ PROMPT TO GIVE FOR FIELD ' ' OUTPUT PARAMETERS -- ABOVE INPUTS UPDATED WITH USER'S RESPONSES ' ' SUBROUTINE PURPOSE -- TO ASK THE SYSOP WHAT UNIQUE FIELD IN THE USERS ' RECORD IS TO BE ASKED FOR AT LOGON ' SUB ASKUPOS (HDR$,BEGIN.COL,FIELD.LEN,PRMPT$) STATIC CLS LOCATE 3,20 PRINT HDR$; 61300 LOCATE 6,5 PRINT "1. BEGINNING COLUMN in USERS file";TAB(44);STR$(BEGIN.COL);" "; LOCATE 8,5 PRINT "2. Number of CHARACTERS to use";TAB(44);STR$(FIELD.LEN);" "; LOCATE 10,5 PRINT "3. PROMPT to display to callers";TAB(45);PRMPT$;SPACE$(34-LEN(PRMPT$)); 61310 CALL ASKRO ("Select option to change (1-3, ENTER to end)",24,X$) IF X$ = "" THEN _ EXIT SUB X = VAL(X$) IF X < 1 OR X > 3 THEN _ GOTO 61310 ON X GOTO 61320,61330,61340 61320 CALL ASKRO ("New BEGINNING COLUMN",24,HJ$) IF HJ$ = "" THEN _ GOTO 61320 X = VAL(HJ$) IF X < 0 OR X > 128 THEN _ GOTO 61320 BEGIN.COL = X GOTO 61300 61330 CALL ASKRO ("New # CHARACTERS to use",24,HJ$) IF HJ$ = "" THEN _ GOTO 61330 X = VAL(HJ$) IF X < 0 OR X > 31 THEN _ GOTO 61330 FIELD.LEN = X GOTO 61300 61340 CALL ASKRO ("New PROMPT",24,HJ$) IF LEN(HJ$) > 34 THEN _ GOTO 61340 PRMPT$ = HJ$ GOTO 61300 END SUB ' $SUBTITLE: 'ANYNUMBER - input any numeric value' ' $PAGE ' ' SUBROUTINE NAME -- ANYNUMBER ' ' INPUT PARAMETERS -- PARAMETER MENANING ' PRMPT$ PROMPT ' ' OUTPUT PARAMETERS -- RETURNED.VALUE! VALUE RETURNED ' ' SUBROUTINE PURPOSE -- TO GET A NUMERIC VALUE ' SUB ANYNUMBER (PRMPT$,RETURNED.VALUE!) STATIC 61400 CALL ASKRO (PRMPT$,24,HJ$) RETURNED.VALUE! = VAL(HJ$) END SUB ' $SUBTITLE: 'ANYINTEGER - input any integer value' ' $PAGE ' ' SUBROUTINE NAME -- ANYINTEGER ' ' INPUT PARAMETERS -- PARAMETER MENANING ' PRMPT$ PROMPT TO DISPLAY ' ' OUTPUT PARAMETERS -- RETURNED.VALUE VALUE RETURNED ' ' SUBROUTINE PURPOSE -- TO GET AN INTEGER VALUE ' SUB ANYINTEGER (PRMPT$,RETURNED.VALUE) STATIC 61450 CALL ANYNUMBER (PRMPT$,RETURNED.VALUE!) IF RETURNED.VALUE! > 32767.0 OR _ RETURNED.VALUE! < -32767.0 THEN_ BEEP : _ GOTO 61450 RETURNED.VALUE = RETURNED.VALUE! END SUB ' $SUBTITLE: 'MMINTEGER - input any integer value with range check' ' $PAGE ' ' SUBROUTINE NAME -- MMINTEGER ' ' INPUT PARAMETERS -- PARAMETER MENANING ' PRMPT$ PROMPT ' MIN MINIMUM VALUE (INCLUSIVE) ' MAX MAXIMUM VALUE (INCLUSIVE) ' ' OUTPUT PARAMETERS -- RETURNED.VALUE VALUE RETURNED ' ' SUBROUTINE PURPOSE -- TO GET AN INTEGER VALUE WITHIN A RANGE ' SUB MMINTEGER (PRMPT$,MIN,MAX,RETURNED.VALUE) STATIC 61500 CALL ANYINTEGER (PRMPT$,RETURNED.VALUE) IF RETURNED.VALUE < MIN OR RETURNED.VALUE > MAX THEN _ BEEP : _ GOTO 61500 END SUB ' $SUBTITLE: 'MMREAL - input any single precision real # with range check' ' $PAGE ' ' SUBROUTINE NAME -- MMREAL ' ' INPUT PARAMETERS -- PARAMETER MENANING ' PRMPT$ PROMPT ' MIN! MINIMUM VALUE (INCLUSIVE) ' MAX! MAXIMUM VALUE (INCLUSIVE) ' ' OUTPUT PARAMETERS -- RETURNED.VALUE! VALUE RETURNED ' ' SUBROUTINE PURPOSE -- TO GET AN REAL # VALUE WITHIN A RANGE ' SUB MMREAL (PRMPT$,MIN!,MAX!,RETURNED.VALUE!) STATIC 61550 CALL ANYNUMBER (PRMPT$,RETURNED.VALUE!) IF RETURNED.VALUE! < MIN! OR RETURNED.VALUE! > MAX! THEN _ BEEP : _ GOTO 61550 END SUB ' $SUBTITLE: 'FINDFILE - Determine whether a file exists' ' $PAGE ' ' SUBROUTINE NAME -- FINDFILE ' ' INPUT PARAMETERS -- PARAMETER MENANING ' FILNAME$ FILE TO LOOK FOR ' FEXISTS WHETHER FILE EXISTS ' ' OUTPUT PARAMETERS -- RETURNED.VALUE VALUE RETURNED ' ' SUBROUTINE PURPOSE -- DETERMINE WHETHER PASSED FILE NAME EXISTS ' RETURN TRUE OR FALSE IN "FEXISTS" ' SUB FINDFILE (FILNAME$,FEXISTS) STATIC 61600 CALL RBBSFIND (FILNAME$,Z,Y,M,D) FEXISTS = (Z = 0) END SUB ' $SUBTITLE: 'CHKFMSDIR - Validate structure of FMS directory' ' $PAGE ' ' SUBROUTINE NAME -- CHKFMSDIR ' ' INPUT PARAMETERS -- PARAMETER MENANING ' FMSDIR$ NAME OF FMS DIRECTORY ' LINELEN PROPER LENGTH OF LINES ' (EXCLUDING CR/LF AT END) ' FMS.DIRCAT$ CATEGORY FILE FOR FMS ' ' OUTPUT PARAMETERS -- RETURNED.VALUE VALUE RETURNED ' ' SUBROUTINE PURPOSE -- VERIFIES THAT FMS IS IN VALID FORMAT ' AND DIAGNOSES PROBLEMS ' 61700 SUB CHKFMSDIR (FMSDIR$,LINELEN,FMS.DIRCAT$) STATIC DIM CAT.CODE$(99) CLS LOCATE 5,20 PRINT "Checking FMS file ";FMSDIR$; NLINES = 0 LOCATE 7,27 PRINT "Line #"; LOCATE 9,20 COLOR 0,7 PRINT " Last Line with an ERROR "; LOCATE 12,28 PRINT " Last ERROR "; COLOR 7,0 NCATS = 0 CALL FINDFILE (FMS.DIRCAT$,FEXISTS) IF FEXISTS THEN _ NCATS = 1:_ CAT.CODE$(1) = "***":_ OPEN FMS.DIRCAT$ FOR INPUT AS #2 : _ WHILE NOT EOF(2) AND NCATS < UBOUND(CAT.CODE$) :_ NCATS = NCATS + 1:_ INPUT #2,X$,Y$,X$:_ CAT.CODE$(NCATS) = Y$:_ WEND:_ CLOSE 2 GO.ON = -1 CALL FINDFILE (FMSDIR$,FEXISTS) IF NOT FEXISTS THEN _ LOCATE 6,25 : _ PRINT "File not found"; : _ GOTO 61750 OPEN FMSDIR$ FOR INPUT AS #2 WHILE NOT EOF(2) AND GO.ON NLINES = NLINES + 1 LINE INPUT #2, A$ L = LEN(A$) LOCATE 7,36 PRINT NLINES; IF L > LINELEN THEN _ CALL HANDERR (A$,NLINES,"Too LONG: has" + STR$(L) + " chars but should have" + STR$(LINELEN),GO.ON):_ IF NOT GO.ON THEN _ GOTO 61740 IF L < LINELEN THEN _ X$ = "Too SHORT: has" + STR$(L) + " chars but should have" + STR$(LINELEN) : _ CALL HANDERR (A$,NLINES,X$,GO.ON):_ IF NOT GO.ON THEN _ GOTO 61740 IF L > 0 THEN _ IF INSTR ("\* ",LEFT$(A$,1)) THEN _ GOTO 61740 IF L > 30 THEN _ X$ = MID$(A$,24,2) + _ MID$(A$,27,2) + _ MID$(A$,30,2) : _ I = 1 : _ WHILE I < 7 AND INSTR("0123456789",MID$(X$,I,1)) > 0 : _ I = I + 1: _ WEND: _ IF I < 7 THEN _ CALL HANDERR (A$,NLINES,"INVALID CHARACTER <" + MID$(X$,I,1) + "> in date field",GO.ON) : _ IF NOT GO.ON THEN _ GOTO 61740 I = 1 Y$ = MID$(A$,L - 2) CALL REMOVE (Y$," ") WHILE I <= NCATS AND Y$ <> CAT.CODE$(I) I = I + 1 WEND IF I > NCATS THEN _ CALL HANDERR (A$,NLINES,"Category code <" + Y$ + "> NOT IN " + FMS.DIRCAT$,GO.ON) 61740 WEND 61750 CLOSE 2 IF GO.ON THEN _ LOCATE 15,15:_ BEEP:_ CALL ASKRO (" Done checking. Press [ENTER] to continue",20,ANS$) END SUB ' $SUBTITLE: 'CHKPERSDIR - Validate personal directories' ' $PAGE ' ' SUBROUTINE NAME -- CHKPERSDIR ' ' INPUT PARAMETERS -- PARAMETER MENANING ' PDIR$ NAME OF PERSONAL DIRECTORY ' NAMELEN PROPER LENGTH OF NAME FIELD ' ' OUTPUT PARAMETERS -- NONE ' ' SUBROUTINE PURPOSE -- CHECKS PERSONAL DIRECTORY FOR PROPER FORMAT ' 61755 SUB CHKPERSDIR (PDIR$, DESC.LEN, NAMELEN) STATIC CLS LOCATE 5, 21 PRINT "Checking Personal Directory "; PDIR$; NLINES = 0 LOCATE 7, 27 PRINT "Line #"; LOCATE 9, 20 COLOR 0, 7 PRINT " Last Line with an ERROR "; LOCATE 12, 28 PRINT " Last ERROR "; COLOR 7, 0 GO.ON = -1 CALL FINDFILE(PDIR$, FEXISTS) IF NOT FEXISTS THEN _ LOCATE 6, 25: _ PRINT "File not found"; : _ GOTO 61775 LINELEN = 34 + DESC.LEN + NAMELEN OPEN PDIR$ FOR INPUT AS #2 WHILE NOT EOF(2) AND GO.ON NLINES = NLINES + 1 LINE INPUT #2, A$ L = LEN(A$) LOCATE 7, 36 PRINT NLINES; IF L > LINELEN THEN _ CALL HANDERR(A$, NLINES, "Too LONG: has" + STR$(L) + " chars but should have" + STR$(LINELEN), GO.ON) : _ IF NOT GO.ON THEN _ GOTO 61770 IF L < LINELEN THEN _ CALL HANDERR(A$, NLINES, "Too SHORT: has" + STR$(L) + " chars but should have" + STR$(LINELEN), GO.ON) : _ IF NOT GO.ON THEN _ GOTO 61770 IF L > 30 THEN _ X$ = MID$(A$, 24, 2) + MID$(A$, 27, 2) + MID$(A$, 30, 2) : _ I = 1 : _ WHILE I < 7 AND INSTR("0123456789", MID$(X$, I, 1)) > 0 : _ I = I + 1 : _ WEND : _ IF I < 7 THEN _ CALL HANDERR(A$, NLINES, "INVALID CHARACTER <" + MID$(X$, I, 1) + "> in date field", GO.ON) : _ IF NOT GO.ON THEN _ GOTO 61770 IF L = LINELEN THEN _ X$ = RIGHT$(A$, 1) : _ IF INSTR("*!", X$) = 0 THEN _ CALL HANDERR(A$, NLINES, "Last char on line should be * or ! but found <" + X$ + ">", GO.ON) : _ IF NOT GO.ON THEN _ GOTO 61770 IF L = LINELEN THEN _ X$ = MID$(A$, L - NAMELEN, LINELEN) : _ IF LEFT$(X$, 1) = " " THEN _ IF INSTR("0123456789-", MID$(X$, 2, 1)) = 0 THEN _ CALL HANDERR(A$, NLINES, "Name field at col" + STR$(L - NAMELEN) + " has <" + LEFT$(X$, 1) + ">, needs non-blank or blank+number", GO.ON) : _ IF NOT GO.ON THEN _ GOTO 61770 61770 WEND 61775 CLOSE 2 IF GO.ON THEN _ LOCATE 15, 15 : _ BEEP : _ CALL ASKRO(" Done checking. Press [ENTER] to continue", 20, ANS$) END SUB ' $SUBTITLE: 'HANDERR - subroutine to handle FMS errors' ' $PAGE ' ' SUBROUTINE NAME -- HANDERR ' ' INPUT PARAMETERS -- PARAMETER MEANING ' ERRLINE$ LINE THAT HAS THE ERROR ' ERRL LINE NUMBER WITH ERROR ' ERRMES$ ERROR MESSAGE TO ISSUE ' ' OUTPUT PARAMETERS -- GO.ON INIDCATE TO PROCEDURE OR NOT ' ' SUBROUTINE PURPOSE -- TO HANDLE ERROR CHECKING OF THE FMS DIRECTORY ' SUB HANDERR (ERRLINE$,ERRL,ERRMES$,GO.ON) STATIC LOCATE 10,1 PRINT SPACE$(80); LOCATE 10,1 PRINT ERRLINE$; LOCATE 9,45 PRINT STR$(ERRL); LOCATE 13,1 PRINT SPACE$(79); L = LEN(ERRMES$) IF L > 68 THEN _ STRT = 1 _ ELSE STRT = (70 - L) / 2 LOCATE 13,STRT PRINT ERRMES$; CALL ASKRO (" CONTINUE checking (Y/N,[ENTER]=Y) ",20,ANS$) IF ANS$ = "" THEN _ ANS$ = "Y" CALL ALLCAPS (ANS$) GO.ON = FNYESNO (ANS$) END SUB ' $SUBTITLE: 'REMOVE - subroutine to delete a string from within a string' ' $PAGE ' ' SUBROUTINE NAME -- REMOVE ' ' INPUT PARAMETERS -- PARAMETER MEANING ' BADSTRING$ STRING CONTAINING CHARACTERS ' TO BE DELETED FROM "L$" ' L$ STRING TO BE ALTERED ' ' OUTPUT PARAMETERS -- L$ WITH THE CHARACTERS IN ' "BADSTRING#" DELETED FROM IT ' ' SUBROUTINE PURPOSE -- TO REMOVE ALL INSTANCES OF THE CHARACTERS IN ' "BADSTRING$" FROM "L$" ' SUB REMOVE (L$,BADSTRNG$) STATIC 61800 J = 0 FOR I = 1 TO LEN(L$) IF INSTR(BADSTRNG$,MID$(L$,I,1)) = 0 THEN_ J = J + 1:_ MID$(L$,J,1) = MID$(L$,I,1) NEXT I L$ = LEFT$(L$,J) END SUB ' $SUBTITLE: 'GETASCII - subroutine to prompt for any ASCII values' ' $PAGE ' ' SUBROUTINE NAME -- GETASCII ' ' INPUT PARAMETERS -- PARAMETER MEANING ' TITLE$ HEADER EXPANATION FOR PARAM ' ' OUTPUT PARAMETERS -- STRNG$ RESULTANT CONFIG PARAMETER ' ' SUBROUTINE PURPOSE -- ALLOWS ANY ASCII CHARACTER TO BE STORED IN A PARAMETER ' BY ENCLOSING IT IN SQUARE BRACKETS. CHARACTERS NOT IN ' SQUARE BRACKETS ARE INTERPRETED EXACTLY AS ENTERED. ' CHARACTER'S ASCII VALUE EQUAL THE NUMERIC VALUE IN THE ' SQUARE BRACKETS. ' SUB GETASCII (TITLE$,STRNG$) STATIC 61810 CLS LOCATE 8,30 PRINT TITLE$; LOCATE 13,5 PRINT "Current value is" PRINT STRNG$ PRINT PRINT "Please enter the new values by entering the character" PRINT "or enclosing its ASCII value in square brackets:" PRINT "(Press ENTER to make empty) LINE INPUT "";HJ$ STRNG$ = HJ$ END SUB ' $SUBTITLE: 'BRKFNAME - subroutine to decompose a file name' ' $PAGE ' ' SUBROUTINE NAME -- BRKFNAME ' ' INPUT PARAMETERS -- PARAMETER MEANING ' FILENAME$ NAME OF THE FILE TO BE DECOMPOSED ' FOR.JOINING INDICATOR IF OUTPUT IS TO BE COMPBINED ' ' OUTPUT PARAMETERS -- DRVPATH$ DRIVE AND PATH ' PREFIX$ 8-CHARACTER FILE NAME PREFIX ' EXTENSION$ 3-CHARACTER EXTENSION ' ' SUBROUTINE PURPOSE -- BREAKS DOWN A FILE NAME INTO A DRIVE AND PATH, ' FILE PREFIX (8 CHARACTERS), AND FILE EXTENSION ' (3 CHARACTERS). IF "FOR.JOINING" IS TRUE, THE ' DRIVE AND PATH HAVE A ":" AND A "\" IN IT AND ' THE EXTENSION BEGINS WITH A ".". ' SUB BRKFNAME (FILENAME$,DRVPATH$,PREFIX$,EXTENSION$,FOR.JOINING) STATIC 61830 CALL ALLCAPS (FILENAME$) DRVPATH$ = "" PREFIX$ = "" EXTENSION$ = "" CALL TRIMTRAIL (FILENAME$,"\") IF LEN(FILENAME$) < 1 THEN _ EXIT SUB CALL FINDLAST (FILENAME$,"\",X,Y) IF X < 1 THEN _ IF MID$(FILENAME$,2,1) = ":" THEN _ DRVPATH$ = LEFT$(FILENAME$,1): _ S = 3 _ ELSE S = 1 _ ELSE DRVPATH$ = LEFT$(FILENAME$,X - 1) : _ S = X + 1 X = INSTR(FILENAME$+".",".") EXTENSION$ = MID$(FILENAME$,X + 1,3) PREFIX$ = MID$(FILENAME$,S,X - S) IF NOT FOR.JOINING THEN _ EXIT SUB IF LEN(DRVPATH$) = 1 THEN _ DRVPATH$ = DRVPATH$ + ":" IF INSTR(DRVPATH$,"\") > 0 THEN _ DRVPATH$ = DRVPATH$ + "\" IF LEN(EXTENSION$) > 0 THEN _ EXTENSION$ = "." + EXTENSION$ END SUB ' ' $SUBTITLE: 'TRIMTRAIL - subroutine to trim off trailing characters' ' $PAGE ' ' SUBROUTINE NAME -- TRIMTRAIL ' ' INPUT PARAMETERS -- PARAMETER MEANING ' TRIM.PARM$ TIME IN SECONDS AFTER MIDNIGHT TO WAIT ' BEFORE DISPLAYING ' TRIM.THIS$ WHAT CHARACTER TO TRIM OFF END ' ' OUTPUT PARAMETERS -- NONE ' ' SUBROUTINE PURPOSE -- TO DISPLAY RBBS-PC's SYSOP MENU ON THE LOCAL SCREEN ' 61840 SUB TRIMTRAIL (TRIM.PARM$,TRIM.THIS$) STATIC WHILE RIGHT$(TRIM.PARM$,1) = TRIM.THIS$ TRIM.PARM$ = LEFT$(TRIM.PARM$,LEN(TRIM.PARM$) - 1) WEND END SUB ' $SUBTITLE: 'FINDLAST - subroutine to find last occurence of a string' ' $PAGE ' ' SUBROUTINE NAME -- FINDLAST ' ' INPUT PARAMETERS -- PARAMETER MEANING ' LOOK.IN$ STRING TO LOOK INTO ' LOOK.FOR$ STRING TO SEARCH FOR ' ' OUTPUT PARAMETERS -- WHERE.FOUND POSITION IN LOOK.IN$ THAT ' LOOK.FOR$ FOUND ' NUM.FINDS HOW MANY OCCURENCES IN LOOK.IN$ ' ' SUBROUTINE PURPOSE -- FINDS THE LAST OCCURANCE OF "LOOK.FOR$" IN "LOOK.IN$" ' AND RETURNS COUNT OF NUMBER OF OCCURENCES. IF NONE ' ARE FOUND, BOTH RETURNED PARAMETERS ARE ZERO. ' SUB FINDLAST (LOOK.IN$,LOOK.FOR$,WHERE.FOUND,NUM.FINDS) STATIC 61850 WHERE.FOUND = INSTR(LOOK.IN$,LOOK.FOR$) NUM.FINDS = -(WHERE.FOUND > 0) NEXT.FOUND = INSTR(WHERE.FOUND + 1,LOOK.IN$,LOOK.FOR$) WHILE NEXT.FOUND > 0 NUM.FINDS = NUM.FINDS + 1 WHERE.FOUND = NEXT.FOUND NEXT.FOUND = INSTR(WHERE.FOUND + 1,LOOK.IN$,LOOK.FOR$) WEND END SUB ' $SUBTITLE: 'SECURE - subroutine to assign security to commands' ' $PAGE ' ' SUBROUTINE NAME -- SECURE ' ' INPUT PARAMETERS -- PARAMETER MEANING ' SECTION$ NAME OF THE SECTION ' DEFAULTS$ DEFAULT COMMANDS FOR THE SECTION ' NUMBER.OF.COMMANDS NUMBER OF COMMANDS IN THE SECTION ' COMMANDS$() CHARACTERS REPRESENTING THE ONE- ' CHARACTER COMMANDS ' COMMANDS() SECURITY LEVEL ASSOCIATED WITH ' THE COMMAND ' SECTION.COMMANDS$ PROMPT STRING OF ALL COMMANDS IN ' THE SECTION ' ' OUTPUT PARAMETERS -- COMMANDS$() CHARACTERS REPRESENTING THE ONE- ' CHARACTER COMMANDS ' COMMANDS() SECURITY LEVEL ASSOCIATED WITH ' THE COMMAND ' SECTION.COMMANDS$ PROMPT STRING OF ALL COMMANDS IN ' THE SECTION ' ' SUBROUTINE PURPOSE -- ALLOWS USERS TO MODIFY COMMANDS AND SECURITY FOR ' EACH COMMAND. ' SUB SECURE (SECTION$,DEFAULTS$,NUMBER.OF.COMMANDS,COMMANDS$(2),COMMANDS(1),SECTION.COMMANDS$) STATIC 61860 IF IPAGE = 2 OR _ VAL(OPTION$) = 310 THEN _ XX$ = "ALL " + _ SECTION$ + _ " commands use default letters?" _ ELSE XX$ = "ALL " + _ SECTION$ + _ " commands = SAME security level?" LOCATE 24,1 PRINT SPACE$(79); LOCATE 24,1 CALL GETNUMYN (XX$,AB) IF NOT AB THEN _ GOTO 61880 61870 IF IPAGE = 2 OR _ VAL(OPTION$) = 310 THEN _ SECTION.COMMANDS$ = DEFAULTS$ : _ FOR I = 1 TO NUMBER.OF.COMMANDS : _ COMMANDS$(I,2) = MID$(SECTION.COMMANDS$,I,1) : _ NEXT : _ EXIT SUB CALL MMINTEGER("Security level for all " + _ SECTION$ + _ " commands is?",-32767,32767,B1) FOR I = 1 TO NUMBER.OF.COMMANDS COMMANDS(I) = B1 NEXT GB = B1 EXIT SUB 61880 GOSUB 61900 IROW = 4 ICOL = 10 FOR I = 1 TO NUMBER.OF.COMMANDS LOCATE IROW + I,ICOL IF IPAGE = 2 OR _ VAL(OPTION$) = 310 THEN _ PRINT COMMANDS$(I,1);" ";COMMANDS$(I,2) _ ELSE PRINT COMMANDS$(I,1);STR$(COMMANDS(I)) NEXT 61890 CALL ASKRO("Enter first character of command ([ENTER] quits)",24,X$) IF X$ = "" THEN _ EXIT SUB IF LEN(X$) <> 1 THEN _ GOTO 61890 CALL ALLCAPS(X$) FF = INSTR(DEFAULTS$,X$) IF FF = 0 THEN _ GOTO 61890 IF IPAGE = 2 OR _ VAL(OPTION$) = 310 THEN _ GOTO 61892 CALL MMINTEGER("Security level for all " + _ SECTION$ + _ " '" + _ X$ + _ "' commands is?",-32767,32767,B1) GOTO 61893 61892 CALL ASKRO("New command for " + _ MID$(COMMANDS$(FF,1),1,INSTR(COMMANDS$(FF,1)," ")) + _ "is?",24,HK$) X$ = MID$(HK$,1,1) CALL ALLCAPS (X$) IF LEN(HK$) > 1 THEN _ HK$ = X$ + MID$(HK$,2) IF LEN (HK$) = 1 THEN _ HK$ = X$ COMMANDS$(FF,2) = HK$ MID$(SECTION.COMMANDS$,FF,1) = HK$ GOTO 61880 61893 COMMANDS(FF) = B1 GOTO 61880 ' ' * COMMON ROUTINE TO DISPLAY SUBSYSTEM COMMANDS AND THEIR SECURITY LEVELS ' 61900 CLS I! = FRE(C$) COLOR 0,7,0 LOCATE 1,23 PRINT "RBBS-PC "+ CONFIG.VERSION$ + " Default Configuration"; COLOR FG,BG,BORDER LOCATE 2,5 PRINT "The RBBS-PC " + _ SECTION$ + _ " Commands are as follows:" LOCATE 3,10 XX$ = "Command Security" IF IPAGE = 2 OR _ VAL(OPTION$) = 310 THEN _ XX$ = "Description Command" PRINT XX$ RETURN END SUB ' $SUBTITLE: 'GETCOLOR - get colors using natural language' ' $PAGE ' ' SUBROUTINE NAME -- GETCOLOR ' ' INPUT PARAMETERS -- PARAMETER MEANING ' STRNG$ TITLE OF WHAT COLOR IS FOR ' NUM.COLOR CURRENT COLOR SETTING ' ' OUTPUT PARAMETERS -- NUM.COLOR NEW COLOR SETTING ' ' SUBROUTINE PURPOSE -- SET THE COLOR USING NATURAL LANGUAGE PHRASES ' SUB GETCOLOR (STRNG$,NUM.COLOR) STATIC CLS 61950 IF NUM.COLOR > 7 THEN _ X = NUM.COLOR - 8 _ ELSE X = NUM.COLOR X$ = MID$("<none>Blue Green Cyan Red PurpleYellowWhite",X*6+1,6) LOCATE 9,15 PRINT STRNG$;" now ";X$;" "; 61955 CALL ASKRO ("Make N)one,R)ed,G)reen,Y)ellow,B)lue,P)urple,C)yan,W)hite,[ENTER] quits",20,ANS$) IF ANS$ = "" THEN _ EXIT SUB CALL ALLCAPS (ANS$) Y = INSTR("NBGCRPYW",ANS$) - 1 IF Y < 0 THEN _ GOTO 61955 NUM.COLOR = Y GOTO 61950 END SUB ' $SUBTITLE: 'GETANSI - SUBROUTINE TO GET CALLERS COLOR VALUES' ' $PAGE ' ' SUBROUTINE NAME -- GETANSI ' ' INPUT PARAMETERS -- PARAMETER MEANING ' SELECTION$ NAME OF SELECTION TO HAVE COLOR ' PRMPT$ WHAT TO PROMPT ON THE SCREEN ' ' OUTPUT PARAMETERS -- FG.1.DEF$ FIRST COLOR SELECTION ' FG.2.DEF$ SECOND COLOR SELECTION ' FG.3.DEF$ THIRD COLOR SELECTION ' FG.4.DEF$ FOURTH COLOR SELECTION ' ' SUBROUTINE PURPOSE -- ASK THE SYSOP TO SELECT THE FOUR COLORS TO BE ' USED FOR CALLERS THAT SELECT COLOR DISPLAYS. ' SUB GETANSI (SELECTION$,PRMPT$) STATIC CLS 62000 LOCATE 8,10 PRINT PRMPT$;" Foreground for caller now ";SELECTION$;" " LOCATE 10,1 PRINT "Current foreground selections: "; CALL COLORCODE (FG.1.DEF$,X$,X) COLOR X,CALLER.BKGRD PRINT "First "; CALL COLORCODE (FG.2.DEF$,X$,X) COLOR X PRINT "Second "; CALL COLORCODE (FG.3.DEF$,X$,X) COLOR X PRINT "Third "; CALL COLORCODE (FG.4.DEF$,X$,X) COLOR X PRINT "Fourth" COLOR FG,BG 62040 CALL ASKRO ("Make N)one,R)ed,G)reen,Y)ellow,B)lue,P)urple,C)yan,W)hite,[ENTER] quits",14,ANS$) IF ANS$ = "" THEN _ EXIT SUB CALL ALLCAPS (ANS$) X = INSTR("NRGYBPCW",ANS$) IF X < 2 THEN _ SELECTION$ = NONE.PICKED$ : _ GOTO 62000 X$ = MID$("Red Green YellowBlue PurpleCyan White",X*6-11,6) CALL ASKRO ("Make "+X$+" [B]right, or N)ormal",17,ANS$) CALL ALLCAPS (ANS$) IF ANS$ <> "N" THEN _ SELECTION$ = "Bright " + X$ _ ELSE SELECTION$ = "Normal " + X$ GOTO 62000 END SUB ' $SUBTITLE: 'COLORCODE - SUBROUTINE TO GET COLOR CODES' ' $PAGE ' ' SUBROUTINE NAME -- COLORCODE ' ' INPUT PARAMETERS -- PARAMETER MEANING ' NAT.LANG.COLOR$ NATURAL LANGUAGE LETTER OF COLOR ' N = NONE ' B = BLUE ' G = GREEN ' C = CYAN ' R = RED ' P = PURPLE ' Y = YELLOW ' W = WHITE ' ' OUTPUT PARAMETERS -- ANSI.COLOR$ CORRECT CHARACTER SEQUENCE OF COLOR ' BASIC.FG NUMBER FOR BASIC FORGROUND ' ' SUBROUTINE PURPOSE -- TO CONVERT THE NATURAL LANGUAGE COLOR SELECTION INTO ' COLOR CODES THAT ARE MEANINGFUL. ' SUB COLORCODE (NAT.LANG.COLOR$,ANSI.COLOR$,BASIC.FG) STATIC BASIC.FG = 7 IF NAT.LANG.COLOR$ = NONE.PICKED$ THEN _ ANSI.COLOR$ = "" : _ EXIT SUB X = INSTR(" BN",LEFT$(NAT.LANG.COLOR$,1)) IF X < 2 THEN _ EXIT SUB X$ = MID$("10",X-1,1) X = INSTR(NAT.LANG.COLOR$," ") IF X < 1 OR X >= LEN(NAT.LANG.COLOR$) THEN _ EXIT SUB Z$ = MID$(NAT.LANG.COLOR$,X+1,1) X = INSTR("RGYBPCW",Z$) IF X < 1 THEN _ EXIT SUB BASIC.FG = INSTR("BGCRPYW",Z$) - 8 * (X$="1") Y$ = MID$(STR$(30+X),2) Z = INSTR("NRGYBPCW",MID$("NBGCRPYW",CALLER.BKGRD+1,1)) Z$ = MID$(STR$(39+Z),2) ANSI.COLOR$ = CHR$(27) + "[" + X$ + ";" + Z$ + ";" + Y$ + "m" END SUB ' $SUBTITLE: 'ANSIDECODE - SUBROUTINE TO DECODE ANSI VALUES' ' $PAGE ' ' SUBROUTINE NAME -- ANSIDECODE ' ' INPUT PARAMETERS -- PARAMETER MEANING ' ANSI.EXPRESSION$ EXPRESSION WITH ANSI COLOR CODES IN ' ' OUTPUT PARAMETERS -- ANSI.EXPRESSION$ ENGLISH LANGUAGE DESCRIPTION OF COLOR ' ' SUBROUTINE PURPOSE -- DECODES THE ANSI EXPRESSION INTO A MEANINGFUL ' ENGLISH TEXT DESCRIPTION. ' SUB ANSIDECODE (ANSI.EXPRESSION$) STATIC IF LEN (ANSI.EXPRESSION$) < 3 THEN _ EXIT SUB IF ASC(ANSI.EXPRESSION$) <> 27 THEN _ EXIT SUB X = INSTR(ANSI.EXPRESSION$,";") IF X < 1 THEN _ EXIT SUB IF MID$(ANSI.EXPRESSION$,X-1,1) = "1" THEN _ X$ = "Bright " _ ELSE X$ = "Normal " X = INSTR(X,ANSI.EXPRESSION$,"m") IF X < 1 THEN _ EXIT SUB X = VAL(MID$(ANSI.EXPRESSION$,X-2,2)) - 30 IF X < 1 OR X > 7 THEN _ EXIT SUB ANSI.EXPRESSION$ = X$ + MID$("Red Green YellowBlue PurpleCyan White",X*6-5,6) END SUB 62100 ' set modem strings by selecting a modem SUB SELMODEM STATIC CALL FINDFILE ("MODEMS.SET",OK) IF NOT OK THEN _ EXIT SUB 62105 CLS LOCATE 5,15 PRINT "Select the MODEM MODEL YOU ARE USING"; LOCATE 7,10 PRINT "Use Parameter 231 to initialize modem's firmware" IF NETWORK.TYPE = 6 THEN _ OPEN "MODEMS.SET" FOR INPUT SHARED AS #2 _ ELSE OPEN "I",2,"MODEMS.SET" ANS$ = "" WHILE NOT EOF(2) AND ANS$ <> "S" INPUT #2, MODEM.MODEL$, SWITCHES$ FOR I = 1 TO 12 INPUT #2,A$(I) NEXT LOCATE 10,10 PRINT SPACE$(60); LOCATE 10,14 PRINT "Model Modem: ";MODEM.MODEL$; LOCATE 12,10 PRINT SPACE$(60); LOCATE 12,10 PRINT "Switch Settings: ";SWITCHES$ CALL ASKRO("S)elect this model (Enter for next choice)?",24,ANS$) CALL ALLCAPS (ANS$) WEND CLOSE 2 IF ANS$ = "S" THEN _ EXIT SUB GOTO 62105 END SUB