' $linesize:132 ' $title: 'RBBSSUB4.BAS CPC17.3, Copyright 1986 - 90 by D. Thomas Mack' ' Copyright 1990 by D. Thomas Mack, all rights reserved. ' Name ...............: RBBSSUB4.BAS ' First Released .....: February 4, 1990 ' Subsequent Releases.: ' Copyright ..........: 1986 - 1990 ' Purpose.............: The Remote Bulletin Board System for the IBM PC, ' RBBS-PC.BAS utilizes a lot of common subroutines. Those that do not ' require error trapping are incorporated within RBBSSUB 2-5 as ' separately callable subroutines in order to free up as much ' code as possible within the 64K code segment used by RBBS-PC.BAS. ' Parameters..........: Most parameters are passed via a COMMON statement. ' ' Subroutine Line Function of Subroutine ' Name Number ' AnyBut 59760 Determine where a "word" begins ' AskUsers 64003 Ask users questions based on a script and save answers ' AskMore 59858 Check whether screen full ' AutoPage 60300 Check whether to notify sysop caller is on ' BadFileChar 59800 Check file name for bad character ' Bracket 59960 Puts strings around a substring ' BufFile 58400 Write a file to the user quickly ' BufString 58300 Write a string with imbedded CR/LF to the user quickly ' CheckColor 59930 Highlighting based on search string ' SearchArray 58190 Check for the occurance of a string in an array ' ColorDir 59920 Adds colorization to FMS directory entry ' ColorPrompt 59940 Colorizes prompts ' CompDate 59880+ Produces a computational data from YY, MM, DD ' ConfMail 59854 Check conference mail waiting ' ConvertDir 58950 Checks for U & A (shorthand) and converts appropriately ' PackDate 59201 Compress date in string format to 2 characters ' EofComm 60000 Determine whether any chars in comm port buffer ' ExpireDate 59890 Calculate registration expiration date ' FakeXRpt 62650 Write out file transfer report for protocols that don't ' FindEnd 58770 Find where a "word" ends ' FindFile 58790 Determine whether a file exists without opening it ' FindLast 58600 Find last occurence of a string ' FMS 58200 Search the upload management system for entries ' GetAll 59780 Get list of all directories to display ' GetDirs 58895 Prompts for directories for file list/new/search cmds ' GetMsgAttr 62530 Restore attributes of original message ' GetYMD 59204 Pulls YY, MM, or DD from a 2 byte stored date ' GlobalSrchRepl 60100 Global search and replace ' LogPDown 59400 Records download in private directory ' MarkTime 60200 Give visual feedback during lengthy process ' MetaGSR 60130 Meta statement global search and replace ' MsgImport 59698 Allow local user to import a text file to a message ' Muzak 59100 Play musical themes for different RBBS functions ' NewPassword 60668 Get a new password ' PersFile 59300 View and select personal files for downloading ' Protocol 62600 Determine if external protocols are available ' PutMsgAttr 62520 Save attributes of original message ' Remove 58210 Remove characters from within strings ' RotorsDir 58700 Searches for a file using list of subdirs ' RptTime 62540 Report date/time and time on ' SetEcho 59600 Set RBBS properly for who is to echo ' SetHiLite 59934 Set user preference on highlighting ' SetGraphic 59980 Sets graphic preference for text file display ' SmartText 58250 Process SMART TEXT control strings ' SubMenu 59500 Processes options that have sub-menus ' TimedOut 63000 Write timed exit semaphore file ' TimeLock 60150 Check for TIME LOCK on certain features ' Transfer 62624 RBBS-PC support for external protocols for file transfer ' Toggle 57000 Toggles or views user options ' TwoByteDate 59200 Reduces a data to 2 byte string for space compression ' UnPackDate 59902 Uncompresses a 2 byte date ' UserColor 59965 Lets user set color for text and whether bold ' UserFace 59450 Processes programmable user interface ' ViewArc 64600 Display .ARC file contents to user ' PrivDoorRtn 62629 Private door exit routine ' WipeLine 58800 Wipes away a line so next prints in its place ' WordWrap 59710 Adjust a msg -- wrap lines and perserve paragraphs ' ' $INCLUDE: 'RBBS-VAR.BAS' ' 57000 ' $SUBTITLE: 'Toggle - Toggle User Preferences' ' $PAGE ' ' NAME -- Toggle ' ' INPUTS -- ToggleOption Option to toggle or view ' according to the following: ' ToggleOption PREFERENCE ' Toggle VIEW ' 1 -1 Autodownload ' 2 -2 Bulletin review on logon ' 3 -3 Case change ' 4 -4 File review on logon ' 5 -5 Highlight ' 6 -6 Line feeds ' 7 -7 Nulls ' 8 -8 TurboKey ' 9 -9 Expert ' 10 -10 Bell ' ' OUTPUTS -- ZSubParm passed from TPut ' ' PURPOSE -- Sets or views any single user preference value ' SUB Toggle (ToggleOption) STATIC ZSubParm = 0 IF ToggleOption < 0 THEN _ GOTO 57005 ON ToggleOption GOSUB _ 57010, _ 'Autodownload 57120, _ 'Bulletin review on logon 57260, _ 'Case change 57150, _ 'File review on logon 57040, _ 'Highlight 57100, _ 'Line feeds 57210, _ 'Nulls 57230, _ 'TurboKey 57190, _ 'Expert 57170 'Bell EXIT SUB 57005 CALL AskMore ("",ZTrue,ZTrue,WasX,ZTrue) ON -ToggleOption GOSUB _ 57030, _ 'Autodownload 57130, _ 'Bulletin review on logon 57270, _ 'Case change 57160, _ 'File review on logon 57050, _ 'Highlight 57110, _ 'Line feeds 57220, _ 'Nulls 57240, _ 'TurboKey 57200, _ 'Expert 57180 'Bell EXIT SUB 57010 'IF ZAutoDownDesired THEN _ ' GOTO 57020 'IF NOT ZAutoDownVerified THEN _ ' CALL TestUser 'IF NOT ZAutoDownYes THEN CALL QuickTPut1 ("AUTODOWNLOAD Not Supported--- Use a BATCH Protocol") : _ ZAutoDownDesired = ZTrue 57020 ZAutoDownDesired = NOT ZAutoDownDesired 57030 ZOutTxt$ = "Autodownload " + FNOffOn$(ZAutoDownDesired) CALL QuickTPut1 (ZOutTxt$) RETURN 57040 IF ZEmphasizeOnDef$ = "" THEN _ CALL QuickTPut1 ("Highlighting unavailable") : _ RETURN IF NOT ZHiLiteOff THEN _ CALL QuickTPut (ZColorReset$,0) CALL SetHiLite (NOT ZHiLiteOff) GOSUB 57050 CALL UserColor RETURN 57050 IF ZEmphasizeOn$ <> "" THEN _ ZEmphasizeOff$ = ZEscape$ + "[" + ZBoldText$ + _ ";40;" + MID$(STR$(ZUserTextColor),2) + "m" CALL QuickTPut1 (ZEmphasizeOn$ + "Highlighting" + ZEmphasizeOff$ + _ " " + FNOffOn$(NOT ZHiLiteOff)) RETURN 57100 ZLineFeeds = NOT ZLineFeeds IF ZLocalUser THEN _ ZLineFeeds = ZTrue 57110 CALL QuickTPut1 ("Line Feeds " + FNOffOn$(ZLineFeeds)) CALL SetCrLf RETURN 57120 ZCheckBulletLogon = NOT ZCheckBulletLogon 57130 ZOutTxt$ = MID$("SKIP CHECK",1 -5 * ZCheckBulletLogon,5) + _ " old BULLETINS in logon" CALL QuickTPut1 (ZOutTxt$) RETURN 57150 ZSkipFilesLogon = NOT ZSkipFilesLogon 57160 ZOutTxt$ = MID$("CHECKSKIP",1 -5 * ZSkipFilesLogon,5) + _ " new files in logon" CALL QuickTPut1 (ZOutTxt$) RETURN 57170 ZPromptBell = NOT ZPromptBell 57180 ZOutTxt$ = "Prompt Bell " + FNOffOn$(ZPromptBell) CALL QuickTPut1 (ZOutTxt$) RETURN 57190 ZExpertUser = NOT ZExpertUser CALL SetExpert 57200 ZOutTxt$ = MID$("NoviceExpert",1 -6 * ZExpertUser,6) CALL QuickTPut1 (ZOutTxt$) RETURN 57210 ZNulls = NOT ZNulls ZNul$ = MID$(STRING$(5,0),1, - 5 * ZNulls) CALL SetCrLf 57220 ZOutTxt$ = "Nulls " + FNOffOn$(ZNulls) CALL QuickTPut1 (ZOutTxt$) RETURN 57230 ZTurboKeyUser = NOT ZTurboKeyUser 57240 CALL QuickTPut1 ("TurboKey " + FNOffOn$(ZTurboKeyUser)) RETURN 57260 ZUpperCase = NOT ZUpperCase 57270 ZOutTxt$ = "UPPER CASE " + _ MID$("and lowerONLY",1 - 9 * ZUpperCase,9) CALL QuickTPut1 (ZOutTxt$) 57280 ZUseTPut = (ZUpperCase OR ZXOnXOff) RETURN END SUB ' 58190 ' $SUBTITLE: 'SearchArray - subroutine to check for a string in an array' ' $PAGE ' ' NAME -- SearchArray ' ' INPUTS -- PARAMETER MEANING ' Element$ THE STRING TO CHECK FOR ' Array$() THE ARRAY TO BE SEARCHED ' NumEntriesToSearch NUMBER OF ENTRIES WITHIN IN ' THE ARRAY TO BE SEARCHED ' ' OUTPUTS -- IsInAra 0 = STRING NOT Found IN THE ' ARRAY SPECIFIED ' OTHERWISE IT IS THE NUMBER sOF ' ELEMENT WITHIN THE ARRAY THAT ' WAS Found TO MATCH ' ' PURPOSE -- Search an array for a specified string and, if found, ' return the number of the element that matched. ' SUB SearchArray (Element$,Array$(1),NumEntriesToSearch,IsInAra) STATIC IsInAra = 1 CALL AllCaps (Element$) MaxTries = NumEntriesToSearch + 1 Array$(MaxTries) = Element$ WHILE Array$(IsInAra) <> Element$ IsInAra = IsInAra + 1 WEND IF IsInAra = MaxTries THEN _ IsInAra = 0 END SUB 58200 ' $SUBTITLE: 'FMS - subroutine to search the upload management system' ' $PAGE ' ' NAME -- FMS ' ' INPUTS -- PARAMETER MEANING ' DirToSearch$ RBBS-PC "DIR" CATEGORY TO LOOK ' FOR ' SearchString$ STRING TO SEARCH FOR ' SearchDate$ DATE TO SEARCH FOR ' ZCategoryName$() ' ZCategoryCode$() ' ZCategoryDesc$() ' CatFound ' ZNumCategories ' ' OUTPUTS -- ProcessedInFMS ' DnldFlag ' ' PURPOSE -- To search the file management system and display the ' files being searched for as well as the catetory descriptions ' SUB FMS (DirToSearch$,SearchString$,SearchDate$, _ ProcessedInFMS,ZCategoryName$(1),ZCategoryCode$(1), _ ZCategoryDesc$(1),DnldFlag,CatFound,AbortIndex) STATIC DnldFlag = 0 CALL SearchArray (DirToSearch$,ZCategoryName$(),ZNumCategories,CatFound) ProcessedInFMS = ProcessedInFMS OR (CatFound > 0) '****************************** TELL THEM mod ***************************** ' Bh ' ZNotify$ = ZWelcomeFileDrvPath$ + _ "HAPPY.DEF" 'Pe 06/12/89 ZStopInterrupts = ZTrue 'Pe 06/12/89 CALL BUFFILE (ZNotify$,WasX) 'Pe 06/12/89 ' '********************** END OF MOD ************************************** ' Bh IF ZFG4$ <> "" THEN _ FG5$ = ZEscape$ + "[1;34;40m" : _ FG6$ = ZEscape$ + "[1;37;41m" : _ FG7$ = ZEscape$ + "[1;37;44m" 'Pe 02/05/90 IF ProcessedInFMS THEN _ ZSubParm = 5 : _ GOSUB 58202 : _ ' CALL QuickTPut(FG5$+"ÉÍ"+FG6$+" "+DirToSearch$+" "+FG5$+"ÍÍÍ",0) : _ ' Bh 090690 CALL QuickTPut("",1) : _ CALL QuickTPut("ÉÍ " + DirToSearch$+" ÍÍÍ",0) : _ ' Bh 090890 CALL QuickTPut(" "+ ZCategoryDesc$(CatFound) +" " + FG5$ + "ÍÍÍÍ" + _ +" " + SrchDir$,1) : _ CALL QuickTPut("º",1) : _ ' CALL QuickTPut("ÈÍ"+FG7$+"File Name"+FG5$+"ÍÍÍÍÍ" + FG7$ + "Size" + _ ' Bh 082990 ' FG5$+"ÍÍÍÍÍ",0) : _ ' CALL QuickTPut(FG7$+"Date"+FG5$+"ÍÍÍÍ"+FG7$ + "Description"+ _ ' FG5$+"ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"+ZFG3$+" "+ZEmphasizeOff$,1) : _ ' CALL QuickTPut("ÈÍ"+FG7$+"File Name"+FG5$+"ÍÍÍ" + FG7$ + "Size" + _ ' Bh 082990 ' FG5$+"ÍÍ",0) : _ ' CALL QuickTPut(FG7$+"Date"+FG5$+"Í "+FG7$ + "+ means that"+ _ ' FG5$+" there is extra information "+ZFG3$+" "+ZCrLf$+ZEmphasizeOff$,1) : _ CALL QuickTPut("ÈÍFile NameÍÍÍSize" + _ ' Bh 082990 "ÍÍ",0) : _ CALL QuickTPut("Date (+ here means"+ _ " extra info is available) ÍÍÍ "+ZCrLf$+ZEmphasizeOff$,1) : _ Cat$ = ZCategoryCode$(CatFound) : _ CALL DispUpDir (CAT$,SearchString$,SearchDate$,DnldFlag,AbortIndex) EXIT SUB 58202 ZOutTxt$ = SearchDate$ IF LEN(ZOutTxt$) > 0 THEN _ ZOutTxt$ = MID$(ZOutTxt$,3) + LEFT$(ZOutTxt$,2) SrchDir$ = SearchString$ + _ ZOutTxt$ IF SrchDir$ <> "" THEN _ SrchDir$ = ZFG4$ + "Scanning for " + ZFG2$ + SrchDir$ RETURN END SUB 58210 ' $SUBTITLE: 'Remove - subroutine to delete a string from within a string' ' $PAGE ' ' NAME -- Remove ' ' INPUTS -- PARAMETER MEANING ' BADSTRING$ STRING CONTAINING CHARACTERS ' TO BE DELETED FROM "WasL$" ' WasL$ STRING TO BE ALTERED ' ' OUTPUTS -- WasL$ WITH THE CHARACTERS IN ' "BADSTRING#" DELETED FROM IT ' ' PURPOSE -- To remove all instances of the characters in ' "BADSTRING$" from "WasL$" ' SUB Remove (WasL$,BadString$) STATIC WasJ = 0 FOR WasI=1 TO LEN(WasL$) IF INSTR(BadString$,MID$(WasL$,WasI,1)) = 0 THEN _ WasJ = WasJ + 1 : _ MID$(WasL$,WasJ,1) = MID$(WasL$,WasI,1) NEXT WasI WasL$ = LEFT$(WasL$,WasJ) END SUB ' Removes full strings from other strings ' SUB UnString(WasL$,BadString$) STATIC WasI = INSTR(WasL$,BadString$) WHILE WasI <> 0 WasL$ = LEFT$(WasL$,WasI-1) + MID$(WasL$,WasI+LEN(BadString$)) WasI = INSTR(WasL$,BadString$) WEND END SUB ' 58250 ' $SUBTITLE: 'SmartText - smart text substitution' ' $PAGE ' ' NAME -- SmartText (WRITTEN BY DOUG AZZARITO) ' ' INPUTS -- StringWork$ string to scan for Smart Text ' CRFound Does this line contain a CR? ' ZSmartTextCode Smart Text control code ' ' OUTPUTS -- StringWork$ Input string with Smart replaced ' ' PURPOSE -- Smart Text allows control strings in text files ' to be replaced at runtime with user info or other ' data. The Smart Text control code is a 1-byte ' code (configurable) with a 2-byte action code. ' SUB SmartText (StringWork$, CRFound, OverStrike) STATIC IF SmartCarry$<>"" THEN _ StringWork$ = SmartCarry$+StringWork$ Index = INSTR(StringWork$, ZSmartTextCode$) WHILE Index > 0 AND Index < LEN(StringWork$)-1 IF INSTR(MID$(StringWork$, Index+1,2)," ") THEN _ SmartAct = 0 _ ELSE _ SmartAct = INSTR(ZSmartTable$, MID$(StringWork$, Index+1, 2)) IF SmartAct = 0 THEN _ WasI = 1 : _ GOTO 58254 SmartAct = (SmartAct+2)/3 ON SmartAct GOSUB 58260, 58261, 58262, 58263, 58264, 58265, _ 58266, 58267, 58268, 58269, 58270, _ 58271, 58272, 58273, 58274, 58275, _ 58276, 58277, 58278, 58279, 58280, _ 58281, 58282, 58283, 58284, 58285, _ 58286, 58287, 58289, 58290, 58291, _ 58292, 58293, 58294, 58295 'DGS-STAMod GOSUB 58256 WasI = LEN(SmartHold$) ReplaceLen = 3 IF OverStrike OR Overlay THEN _ IF WasI > 2 THEN _ ReplaceLen = WasI _ ELSE _ SmartHold$ = SmartHold$ + SPACE$(3 - WasI) StringWork$ = LEFT$(StringWork$, Index-1) + SmartHold$ + _ MID$(StringWork$,Index+ReplaceLen) 58254 Index = INSTR(Index+WasI, StringWork$, ZSmartTextCode$) WEND IF Index AND (Index > LEN(StringWork$)-2) AND NOT CRFound THEN _ SmartCarry$ = MID$(StringWork$,Index) : _ StringWork$ = LEFT$(StringWork$,Index-1) : _ ELSE _ SmartCarry$ = "" EXIT SUB 58256 IF TrimSmart THEN _ CALL Trim (SmartHold$) RETURN 58258 ZLastSmartColor$ = SmartHold$ RETURN 58260 ZLinesPrinted = 0 ' CS (Clear screen line count reset) SmartHold$ = "" RETURN 58261 ZLinesPrinted = ZPageLength ' PB Page Break IF ZNonStop THEN _ ' force a 1-time pause ZOneStop = ZTrue : _ ' if NON STOP is on ZNonStop = ZFalse SmartHold$ = "" ZForceKeyboard = ZTrue RETURN 58262 ZNonStop = ZTrue ' NS Non-stop SmartHold$ = "" RETURN 58263 IF ZGlobalSysop THEN _ ' FN First Name SmartHold$ = ZOrigSysopFN$ _ ELSE SmartHold$ = ZFirstName$ CALL NameCaps(SmartHold$) RETURN 58264 IF ZGlobalSysop THEN _ SmartHold$ = ZOrigSysopLN$ _ ELSE SmartHold$ = ZLastName$ CALL NameCaps(SmartHold$) RETURN 58265 SmartHold$ = MID$(STR$(ZUserSecLevel),2) ' SL Security level RETURN 58266 SmartHold$ = DATE$ ' DT Date RETURN 58267 CALL AMorPM SmartHold$ = ZTime$ ' TM Time RETURN 58268 CALL TimeRemain(MinsRemaining) SmartHold$ = MID$(STR$(INT(MinsRemaining)),2) RETURN 58269 CALL TimeRemain(MinsRemaining) ' TE Time elapsed (mm:ss) SmartHold$ = MID$(STR$(INT(ZSecsUsedSession!/60)),2)+":"+ _ MID$(STR$((ZSecsUsedSession! MOD 60)+100),3) RETURN 58270 SmartHold$ = MID$(STR$(INT((ZTimeLockSet+0.5)/60)),2) ' TL - Time Lock period SmartHold$ = SmartHold$ + ":"+ MID$(STR$((ZTimeLockSet MOD 60)+100),3) RETURN 58271 SmartHold$ = MID$(STR$(ZDaysInRegPeriod),2) RETURN ' RP Registration Length 58272 SmartHold$ = MID$(STR$(ZRegDaysRemaining),2) RETURN ' RR Registration Remaining 58273 SmartHold$ = ZCityState$ ' CT Users CITY & STATE RETURN 58274 SmartHold$ = ZFG1$ ' C1 Color 1 GOTO 58258 58275 SmartHold$ = ZFG2$ ' C2 Color 2 GOTO 58258 58276 SmartHold$ = ZFG3$ ' C3 Color 3 GOTO 58258 58277 SmartHold$ = ZFG4$ ' C4 Color 4 GOTO 58258 58278 SmartHold$ = ZEmphasizeOff$ ' C0 Reset color ZLastSmartColor$ = "" RETURN 58279 SmartHold$ = MID$(STR$(INT(ZDLToday!)),2) RETURN ' DD files Dnlded TODAY 58280 SmartHold$ = MID$(STR$(INT(ZBytesToday!)),2) RETURN ' BD Bytes Dnlded TODAY 58281 SmartHold$ = MID$(STR$(INT(ZDLBytes!)),2) RETURN ' DB Download Bytes 58282 SmartHold$ = MID$(STR$(INT(ZULBytes!)),2) RETURN ' UB Upload Bytes 58283 SmartHold$ = MID$(STR$(ZDnlds),2) ' DL Number of Dnlds RETURN 58284 SmartHold$ = MID$(STR$(ZUplds),2) ' UL Number of Uplds RETURN 58285 SmartHold$ = ZFileName$ ' FI File Name RETURN 58286 Overlay = ZTrue ' VY Overlay ON GOTO 58288 58287 Overlay = ZFalse ' VN Overlay OFF 58288 SmartHold$ = "" RETURN 58289 TrimSmart = ZTrue ' TY Trim Yes GOTO 58288 58290 TrimSmart = ZFalse ' TN Trim No GOTO 58288 58291 SmartHold$ = ZRBBSName$ ' BN Board Name RETURN 58292 SmartHold$ = ZNodeID$ ' ND Node Number IF SmartHold$ >= "A" THEN _ SmartHold$ = MID$(STR$(ASC(SmartHold$) - 54),2) RETURN '58293 SmartHold$ = ZSysopFirstName$ ' FS Sysops First Name ' Bh 110690 ' CALL NameCaps(SmartHold$) ' RETURN 58293 SmartHold$ = ZConfName$ ' FS File Collection ' Bh 122790 RETURN 58294 SmartHold$ = ZSysopLastName$ ' LS Sysops First Name CALL NameCaps(SmartHold$) RETURN 58295 SmartHold$ = STR$(ZBaudTest!) ' BA Baud Rate RETURN END SUB ' 58300 ' $SUBTITLE: 'BufString - write a string with imbedded ZCR/LF' ' $PAGE ' ' NAME -- BufString ' ' INPUTS -- PARAMETER MEANING ' Strng$ STRING TO BE WRITTEN OUT ' DataSize LENGTH OF STRING - # LEFT ' CHARS TO OUTPUT ' ' OUTPUTS -- Strng$ IS WRITTEN TO THE USER ' ' PURPOSE -- To search the string, Strng$, for embedded carriage ' returns and line feeds and write out each line with ' the appropriate substitution (cr/lf if to the local ' screen or cr/nulls/lf if to the communications port). ' SUB BufString (Strng$,PassedDataSize,AbortIndex) STATIC WasL = LEN(Strng$) IF PassedDataSize < WasL THEN _ WasL = PassedDataSize IF WasL < 1 THEN _ EXIT SUB ZFF = ZPageLength - 1 StartByte = 1 IF CarryOver THEN _ IF ASC(Strng$) = 10 THEN _ StartByte = 2 : _ CALL SkipLine (1+ZJumpSearching) CarryOver = (MID$(Strng$,WasL,1) = ZCarriageReturn$) WasL = WasL + CarryOver 58301 CRat = INSTR(StartByte,Strng$,ZCarriageReturn$) IF CRat > 0 AND CRat < WasL THEN _ CRFound = (MID$(Strng$,CRat + 1,1) = ZLineFeed$) _ ELSE CRFound = ZFalse EOLlen = -2 * CRFound IF CRFound THEN _ EOD = CRat _ ELSE EOD = WasL + 1 NumBytes = EOD - StartByte StringWork$ = MID$(Strng$,StartByte,NumBytes) IF NOT ZDeleteInvalid THEN _ GOTO 58304 Index = INSTR(StringWork$,"<") WasJ = LEN(StringWork$) - 1 WHILE Index > 0 AND Index < WasJ IF MID$(StringWork$,Index + 2,1) = ">" THEN _ IF INSTR (ZInvalidOpts$,MID$(StringWork$,Index + 1,1)) THEN _ MID$(StringWork$,Index + 1,1) = "*" Index = INSTR(Index + 1,StringWork$,"<") WEND 58304 IF ZJumpSearching THEN _ Temp$ = StringWork$ : _ CALL AllCaps (Temp$) : _ HiLitePos = INSTR (Temp$,ZJumpTo$) : _ IF HiLitePos = 0 THEN _ GOTO 58307 _ ELSE CALL Bracket (StringWork$,HiLitePos,HiLitePos+LEN(ZJumpTo$)-1,ZEmphasizeOn$,ZEmphasizeOff$) : _ ZJumpSearching = ZFalse IF ZSmartTextCode THEN _ CALL SmartText (StringWork$, CRFound, ZFalse) CALL QuickTPut (StringWork$, - (CRFound)) IF ZRet THEN _ EXIT SUB IF ZLinesPrinted < ZFF THEN _ GOTO 58307 58305 CALL CheckTimeRemain (MinsRemaining) CALL CheckCarrier IF ZSubParm = -1 THEN _ EXIT SUB IF ZNonStop THEN _ GOTO 58307 IF NOT CRFound THEN _ GOTO 58307 ZForceKeyboard = ZTrue CALL AskMore ("",ZTrue,ZFalse,AbortIndex,ZStopInterrupts) IF ZNo THEN _ ZRet = ZTrue : _ EXIT SUB 58307 StartByte = EOD + EOLlen IF StartByte <= WasL THEN _ GOTO 58301 END SUB 58400 ' $SUBTITLE: 'BufFile - subroutine to write a sequential file to the user' ' $PAGE ' ' NAME -- BufFile ' ' INPUTS -- PARAMETER MEANING ' FileSpec$ NAME OF THE FILE TO WRITE TO ' OUT TO THE USER ' ' OUTPUTS -- NONE FILE IS WRITTEN TO THE USER ' ' PURPOSE -- To display a sequential file to the user ' SUB BufFile (FilName$,AbortIndex) STATIC CALL FindIt (FilName$) IF NOT ZOK THEN _ GOTO 58419 ZNo = ZFalse CALL OpenRSeq (FilName$,NumRecs,LenLastRec,ZBufferSize) DataSize = ZBufferSize FIELD 2, DataSize AS SeqRec$ ZNonStop = ZNonStop OR (ZPageLength < 1) ZJumpLast$ = "" ZJumpSearching = ZFalse ZJumpSupported = ZTrue ' IF NOT ZStopInterrupts THEN _ ' Bh 112390 ' IF NOT ZConcatFIles THEN _ ' IF NOT ZNonStop THEN _ ' ZOutTxt$ = "* Ctrl-K(^K) / ^X aborts. ^S suspends ^Q resumes *" : _ ' ZSubParm = 2 : _ ' CALL TPut IF ZSubParm = -1 THEN _ EXIT SUB 'Pe 02/09/90 WasTU = 0 58405 WasTU = WasTU + 1 IF WasTU < NumRecs THEN _ GET 2,WasTU _ ELSE IF WasTU = NumRecs THEN _ GET 2,WasTU : _ WasX = INSTR(SeqRec$,CHR$(26)) : _ IF WasX = 0 OR WasX > LenLastRec THEN _ DataSize = LenLastRec _ ELSE DataSize = WasX - 1 _ ELSE GOTO 58419 IF ZLocalUser THEN _ GOTO 58406 CALL EofComm (Char) IF Char <> -1 THEN _ GOTO 58407 ' comm port input 58406 ZKeyboardStack$ = INKEY$ IF ZKeyboardStack$ = "" THEN _ ' no keyboard input CALL BufString (SeqRec$,DataSize,AbortIndex) : _ GOTO 58408 58407 ZOutTxt$ = LEFT$(SeqRec$,DataSize) ' process comm/keyboard ZSubParm = 4 CALL TPut 58408 IF ZSubParm <> -1 AND NOT ZRet THEN _ GOTO 58405 58419 CLOSE 2 ZBypassTimeCheck = ZFalse ZStopInterrupts = ZFalse CALL QuickTPut (ZEmphasizeOff$,0) ZJumpSupported = ZFalse END SUB 58600 ' $SUBTITLE: 'FindLast - find last occurence of a string' ' $PAGE ' ' NAME -- FindLast ' ' INPUTS -- PARAMETER MEANING ' LookIn$ STRING TO LOOK INTO ' LookFor$ STRING TO SEARCH FOR ' ' OUTPUTS -- WhereFound POSITION IN LookIn$ THAT ' LookFor$ Found ' NumFinds HOW MANY OCCURENCES IN LookIn$ ' ' PURPOSE -- Finds last occurence of LookFor$ in LookIn$ and ' returns count of # of occurences. If none found, ' both returned parameters are set to 0. ' SUB FindLast (LookIn$,LookFor$,WhereFound,NumFinds) STATIC WhereFound = INSTR(LookIn$,LookFor$) NumFinds = -(WhereFound > 0) NextFound = INSTR(WhereFound + 1,LookIn$,LookFor$) WHILE NextFound > 0 NumFinds = NumFinds + 1 WhereFound = NextFound NextFound = INSTR(WhereFound + 1,LookIn$,LookFor$) WEND END SUB 58700 ' $SUBTITLE: 'RotorsDir - search thru a list of subdirs for a file' ' $PAGE ' ' NAME -- RotorsDir ' ' INPUTS -- PARAMETER MEANING ' FilName$ FILE NAME TO LOOK FOR ' SDIR.ARA ARRAY OF SUBDIRECTORIES ' MaxSearch MAX # OF SUBDIRECTORIES ' MarkingTime WHETHER TO MARK TIME ' ' OUTPUTS -- FNAME$ ADD SUBDIRECTORY TO THE ' FILE NAME IF FOUND. OTHER- ' WISE DON'T. ' ZOK TRUE IF FILE WAS Found ' ' PURPOSE -- Hunt through a list of subdirectories to determine ' if a file is in any of them. If file is found, open ' the file as file #2, add the drive/path to the file ' name, and sets ZOK to true. If file isn't found, set ' file name to the last subdirectory searched -- which ' should be the upload subdirectory. ' ' If the library menu is selected (ZMenuIndex = 6), then ' only 2 subdirectories are searched. The first being ' the work disk and the second being the selected ' library disk. ' SUB RotorsDir (FilName$,SDirAra$(1),MaxSearch,MarkingTime,PassToMacro$) STATIC CALL Carrier IF ZSubParm = -1 THEN _ 'Pe 01/04/89 EXIT SUB 'Pe 01/04/89 ZOK = ZFalse ZDotFlag = ZFalse IF MarkingTime THEN _ CALL QuickTPut ("Searching for "+FilName$,0) IF ZMenuIndex = 6 THEN _ GOTO 58705 NumSearch = 1 WasX = 0 WHILE (NOT ZOK) AND NumSearch <= MaxSearch AND _ SDirAra$(NumSearch) <> "" IF MarkingTime THEN _ CALL MarkTime (WasX) WasX$ = SDirAra$(NumSearch) + _ FilName$ CALL FindFile (WasX$,ZOK) NumSearch = NumSearch + 1 WEND IF ZOK OR NOT ZFastFileSearch THEN _ GOTO 58710 CALL OpenRSeq (ZFastFileList$,HighRec,WasX,18) IF ZErrCode <> 0 THEN _ GOTO 58710 CALL TrimTrail (FilName$,".") CALL BinSearch (FilName$,1,12,18,HighRec,RecFoundAt, RecFound$) ZOK = (RecFoundAt > 0) IF NOT ZOK THEN _ GOTO 58710 ZOK = ZFalse CALL CheckInt (MID$(RecFound$,13,4)) IF ZTestedIntValue < 1 THEN _ GOTO 58710 CALL OpenRSeq (ZFastFileLocator$,HighRec,WasX,66) IF ZErrCode <> 0 OR ZTestedIntValue > HighRec THEN _ GOTO 58710 FIELD 2, 66 AS LocatorRec$ GET 2, ZTestedIntValue WasX$ = LEFT$(LocatorRec$,63) CALL Trim (WasX$) IF LEFT$(WasX$,2) = "M!" THEN _ ZOK = ZFalse : _ ZGSRAra$(1) = PassToMacro$ : _ WasX$ = RIGHT$(WasX$,LEN(WasX$)-2) : _ CALL Trim (WasX$) : _ ZFileLocation$ = "" : _ CALL MacroExe (WasX$) : _ IF ZFileLocation$ = "" THEN _ ZOK = ZFalse : _ GOTO 58711 _ ELSE WasX$ = ZFileLocation$ WasX$ = WasX$ + FilName$ CALL FindFile (WasX$,ZOK) GOTO 58710 58705 WasX$ = ZLibWorkDiskPath$ + _ FilName$ CALL FindIt (WasX$) IF ZOK THEN _ GOTO 58710 WasX$ = ZLibDrive$ + _ FilName$ CALL FindIt (WasX$) 58710 FilName$ = WasX$ 58711 CALL SkipLine (-MarkingTime) END SUB 58800 ' $SUBTITLE: 'WipeLine - Wipe away a line so next overprints' ' $PAGE ' ' NAME -- WipeLine ' ' INPUTS -- PARAMETER MEANING ' ZCarriageReturn$ ' CharsToWipe # OF CHARACTERS TO BLANK ' ZNulls ' ' OUTPUTS -- NONE ' ' PURPOSE -- Wipe away a line and leave cursor at beginning of the ' same line so that the next line will print in its place ' SUB WipeLine (CharsToWipe) STATIC IF ZNulls OR CharsToWipe > 79 THEN _ CALL SkipLine (1) : _ EXIT SUB IF NOT ZLocalUser THEN _ Strng$ = ZCarriageReturn$ + SPACE$(CharsToWipe) + ZCarriageReturn$ : _ PRINT #3,Strng$ IF ZSnoop THEN _ LOCATE ,1 : _ CALL LPrnt(SPACE$(CharsToWipe),0) : _ LOCATE ,1 IF ZF7Msg$ = "" OR _ ZF7Msg$ = "NONE" OR _ NOT ZSysopNext THEN _ EXIT SUB ZBypassTimeCheck = ZTrue CALL BufFile (ZF7Msg$,WasX) END SUB 58895 ' $SUBTITLE: 'GetDirs -- Prompt for directories to search' ' $PAGE ' ' NAME -- GetDirs ' ' INPUTS -- PARAMETER MEANING ' ZDirPrompt$ BASE OF DIRECTORY PROMPT ' ShowHelp Whether to display help ' on entry ' OUTPUTS -- ZUserIn$ ' ZWasQ ' ' PURPOSE -- Prompt for directories to search ' SUB GetDirs (ShowHelp) STATIC IF ShowHelp AND (ZAnsIndex >= ZLastIndex ) THEN _ GOTO 58902 58900 ZOutTxt$ = ZDirPrompt$ ZMacroMin = 2 CALL PopCmdStack IF ZWasQ = 0 OR ZSubParm = -1 THEN _ EXIT SUB CALL AllCaps (ZUserIn$(ZAnsIndex)) IF ZUserIn$(ZAnsIndex) = "Q" THEN _ ZWasQ = 0 : _ EXIT SUB ZWasA = INSTR("E+.E-.E.L.H.?.",ZUserIn$(ZAnsIndex)+".") IF ZWasA = 0 THEN _ EXIT SUB IF ZWasA > 8 THEN _ IF ZAnsIndex < ZLastIndex THEN _ GOTO 58900 _ ELSE GOTO 58902 IF ZWasA = 7 THEN _ ZExtendedOff = NOT ZExtendedOff _ ELSE ZExtendedOff = (ZWasA > 3) CALL QuickTPut1 ("Extended directory display "+MID$("ON OFF",1-3*ZExtendedOff,3)) GOTO 58900 58902 ZFileName$ = ZCurDirPath$ + ZDirPrefix$ + _ "." + ZDirExtension$ GDefault$ = MID$(" GC",ZWasGR + 1, 1) CALL Graphic (GDefault$,ZFileName$) CALL BufFile (ZFileName$,ZAnsIndex) GOTO 58900 END SUB ' 58950 ' $SUBTITLE: 'ConvertDir -- Converts coded response to right directory' ' $PAGE ' ' NAME -- ConvertDir ' ' INPUTS -- PARAMETER MEANING ' Start ELEMENT TO BEGIN WITH ' ZUserIn$ ARRAY TO CONVERT ' ZWasQ Last ELEMENT TO CONVERT ' ' OUTPUTS -- ZUserIn$ CONVERTED DIRECTORY LIST ' ' PURPOSE -- Let the user put in a short standard string for a directory ' ' SUB ConvertDir (Start) STATIC FOR WasI=Start TO ZLastIndex CALL AllCaps (ZUserIn$(WasI)) IF ZUserIn$(WasI)="U" THEN _ ZUserIn$(WasI) = ZUpldDirCheck$ IF ZUserIn$(WasI) = "A" THEN _ ZUserIn$(WasI) = "ALL" NEXT END SUB 59200 ' $SUBTITLE: 'TwoByteDate -- subroutine to put date in 2 bytes' ' $PAGE ' ' NAME -- TwoByteDate ' ' INPUTS -- PARAMETER MEANING ' Year FOUR DIGIT YEAR (I.E. 1987) ' WasMM MONTH ' WasDD DAY ' Result$ LOCATION TO PLACE THE Result ' ' OUTPUTS -- Result$ TWO BYTE COMPRESSED DATE FOR USE IN ' A RANDOM RECORD ' ' PURPOSE -- Compress a WasY,ZMsgPtr,WasD date into two characters ' SUB TwoByteDate (Year,WasMM,WasDD,Result$) STATIC Result$ = CHR$(((Year - 1980) * 2) OR - ((WasMM AND 8) <> 0)) + _ CHR$((WasMM AND NOT 8) * 32 + WasDD) END SUB 59201 ' $SUBTITLE: 'PackDate -- subroutine to Compress STRING DATE' ' $PAGE ' ' NAME -- PackDate ' ' INPUTS -- PARAMETER MEANING ' Strng$ String Date (mm-dd-yyyy) ' ' OUTPUTS -- Result$ TWO BYTE COMPRESSED DATE FOR USE IN ' A RANDOM RECORD ' ' PURPOSE -- Compress an 8-character date into two characters ' SUB PackDate (Strng$,Result$) STATIC IF LEN(Strng$) < 8 THEN _ EXIT SUB Year = VAL(MID$(Strng$,7)) WasMM = VAL(Strng$) WasDD = VAL(MID$(Strng$,4)) CALL TwoByteDate (Year,WasMM,WasDD,Result$) END SUB 59202 ' $SUBTITLE: 'UnPackDate -- subroutine to UNCompress DATE' ' $PAGE ' ' NAME -- UnPackDate ' ' INPUTS -- PARAMETER MEANING ' CompressedDate$ Date in 2 byte compressed form ' ' OUTPUTS -- Year Year of compressed date ' WasMM Month of compressed date ' WasDD Day of compressed date ' DisplayDate$ 8 char display date (mm-dd-yyyy) ' ' PURPOSE -- Uncompress a 2 char date to get Y,M,D & display ' SUB UnPackDate (CompressedDate$,Year,WasMM,WasDD,DisplayDate$) STATIC CALL GetYMD (CompressedDate$,1,Year) CALL GetYMD (CompressedDate$,2,WasMM) CALL GetYMD (CompressedDate$,3,WasDD) DisplayDate$ = RIGHT$("00" + MID$(STR$(WasMM),2),2) + _ "-" + _ RIGHT$("00" + MID$(STR$(WasDD),2),2) + _ "-" + _ RIGHT$(STR$(Year),2) END SUB 59204 ' $SUBTITLE: 'GetYMD -- subroutine to unpack a two-byte date' ' $PAGE ' ' NAME -- GetYMD ' ' INPUTS -- PARAMETER MEANING ' TwoByte$ PACKED TWO-BYTE DATE FIELD ' YMD 1 = YEAR ' 2 = MONTH ' 3 = DAY ' Result LOCATION TO PLACE THE Result ' ' OUTPUTS -- Result FOUR DIGIT Result OF UNPAKING THE DATE ' ' PURPOSE -- Unpack a compressed two-byte date field ' SUB GetYMD (TwoByte$,YMD,Result) STATIC ON YMD GOTO 59206,59210,59215 EXIT SUB 59206 Result = (ASC(TwoByte$)AND NOT 1) / 2 + 1980 EXIT SUB 59210 Result = FIX((ASC(MID$(TwoByte$,2)) / 32)) OR ((ASC(TwoByte$) AND 1) * 8) EXIT SUB 59215 Result = ASC(MID$(TwoByte$,2)) AND NOT 224 END SUB 59300 ' $SUBTITLE: 'PersFile - processes requests for personal files' ' $PAGE ' ' NAME -- PersFile ' ' INPUTS -- PARAMETER MEANING ' PersonalCat$ CATEGORY IN DIR FOR CALLER ' ZPersonalLen # CHARS IN PERSONAL CATEGORY ' OUTPUTS -- NONE UP ZDnlds ' ' PURPOSE -- Show caller what personal files have for downloading, ' verify and process requests for downloads ' SUB PersFile (PersonalCat$,DnldFlag) STATIC CALL QuickTput1 ("No personal files available") ZAnsIndex = 0 ZLastIndex = 0 END SUB 59302 59303 59304 59305 59306 59308 59320 59322 59323 59324 59325 59327 59329 59330 59332 59335 59336 59338 59400 SUB LogPDown (PrivateDnld,ZDwnIndex) STATIC END SUB 59450 ' $SUBTITLE: 'UserFace - handles programmable user interface' ' $PAGE ' ' NAME -- UserFace ' ' INPUTS -- PARAMETER MEANING ' GDefault$ GRAPHICS DEFAULT TO USE ' ZCurPUI$ PUI TO USE ' ZExpertUser WHETHER CALL IN EXPERT MODE ' ' OUTPUTS -- ZWasQ ' ZUserIn$() ' ZWasZ$ ' ' PURPOSE -- When sysop overrides RBBS-PC's default user ' interface (provides a MAIN.PUT), this routine ' reads in the table of specifications, presents ' the sysop menu, presents the prompt, verifies ' that a valid option has been picked, determines ' whether the option is another PUI, and passes ' back choices to be processed. ' SUB UserFace (GDefault$) STATIC END SUB 59500 ' $SUBTITLE: 'SubMenu -- subroutine to process menus' ' $PAGE ' ' NAME -- SubMenu ' ' INPUTS -- PARAMETER MEANING ' PassedPrompt$ PROMPT TO DISPLAY ' CurMenu$ NOVICE MENU TO DISPLAY ' FrontOpt$ DRIVE/PATH/PREFIX OF FILE ' NEEDED FOR TYPED OPTION ' BackOpt$ SUFFIX/EXTENSION OF FILE ' NEEDED WITH TYPED OPTION ' ReturnOn$ LETTERS CALLING PROGRAM WANTS ' CONTROL ON ' GRDefault$ GRAPHICS DEFAULT TO USE ' VerifyInMenu WHETHER VERIFY OPTION IS IN MENU ' AllMenuOK WHETHER CONTROL SHOULD RETURN ' WHEN IN MENU ' ZAnsIndex # OF COMMANDS IN TYPE AHEAD ' RequireInMenu WHETHER OPTION MUST BE IN MENU ' ' OUTPUTS -- ZWasZ$ OPTION PICKED ' ZFileName$ NAME OF FILE SUPPORTING OPTION ' ' ' PURPOSE -- Handles menus - including conference, bulletins, ' doors, questionnaires. Supports sub-menus (i.e. ' an option on the menu that invokes another menu) ' SUB SubMenu (PassedPrompt$,CurMenu$,FrontOpt$, _ BackOpt$,ReturnOn$,GRDefault$,VerifyInMenu, _ AllMenuOK,RequireInMenu,BackOpt2$) STATIC 59510 ZFileName$ = CurMenu$ CALL BreakFileName (CurMenu$,MenuDrv$,WasX$,ZWasDF$,ZTrue) MenuFront$ = MenuDrv$ + WasX$ CALL Graphic (GRDefault$,ZFileName$) CurMenuVer$ = ZFileName$ ZStopInterrupts = ZFalse IF ZAnsIndex < ZLastIndex OR ZExpertUser THEN _ GOTO 59520 59515 CALL BufFile (CurMenuVer$,ZAnsIndex) 'show menu 59520 ZOutTxt$ = PassedPrompt$ 'get response CALL PopCmdStack IF ZWasQ = 0 OR ZSubParm = -1 THEN _ EXIT SUB 59530 ZWasZ$ = ZUserIn$(ZAnsIndex) CALL AllCaps (ZWasZ$) IF INSTR(ReturnOn$,ZWasZ$) THEN _ 'check whether calling pgm wants EXIT SUB IF INSTR("LH?",ZWasZ$) THEN _ 'check whether caller wants help GOTO 59515 IF INSTR(ZWasZ$,".") > 0 THEN _ GOTO 59532 FPre$ = FrontOpt$ GOSUB 59538 IF (WasBF < 2) AND (NOT ZOK) THEN _ FPre$ = MenuDrv$ : _ GOSUB 59538 : _ IF NOT ZOK THEN _ ' support shared options FPre$ = MenuFront$ : _ GOSUB 59538 IF NewMenu THEN _ NewMenu = ZFalse : _ GOTO 59515 IF ZOK THEN _ EXIT SUB 59532 IF INSTR(ReturnOn$,LEFT$(ZWasZ$,1)) > 0 THEN _ EXIT SUB GOSUB 59547 GOTO 59515 59538 FilName$ = FPre$ + ZWasZ$ CALL BadFile (FilName$,WasBF) IF WasBF > 1 THEN _ ZOK = ZFalse : _ RETURN ZFileName$ = FilName$ + _ BackOpt$ CALL Graphic (GRDefault$,ZFileName$) IF NOT ZOK THEN _ IF BackOpt2$ <> "" THEN _ ZFileName$ = FilName$ + _ BackOpt2$ : _ CALL Graphic (GRDefault$,ZFileName$) IF ZOK THEN _ IF ZSysop OR (NOT RequireInMenu) THEN _ RETURN _ ELSE CALL WordInFile (CurMenu$,ZWasZ$,Found) : _ IF Found THEN _ RETURN _ ELSE GOTO 59540 IF (NOT VerifyInMenu) THEN _ GOTO 59540 CALL WordInFile (CurMenu$,ZWasZ$,Found) 'verify against menu itself IF Found THEN _ IF AllMenuOK THEN _ RETURN 59540 WasX$ = FPre$ + _ ZWasZ$ + _ ".MNU" 'check whether option is a menu ZFileName$ = WasX$ CALL Graphic (GRDefault$,ZFileName$) IF ZOK THEN _ NewMenu = ZTrue : _ CurMenuVer$ = ZFileName$ : _ CurMenu$ = WasX$ : _ CALL BreakFileName (CurMenu$,MenuDrv$,WasX$,ZWasDF$,ZTrue) : _ MenuFront$ = MenuDrv$ + WasX$ : _ RETURN IF VerifyInMenu AND Found AND NOT RequireInMenu THEN _ CALL UpdtCalr("Option " + ZWasZ$ + " on menu " + _ CurMenu$ + " but not found",1) RETURN 59547 CALL QuickTPut1 ("No such option " + ZWasZ$) ZLastIndex = 0 RETURN 59548 END SUB 59600 ' $SUBTITLE: 'SetEcho -- subroutine to reset who echoes' ' $PAGE ' ' NAME -- SetEcho ' ' INPUTS -- PARAMETER MEANING ' NewEcho$ The new echo option ' ZLocalUser ' ' OUTPUTS -- ZRemoteEcho Whether RBBS is to echo what a ' remote caller types ' ' PURPOSE -- Resets who echos. "R" is for RBBS to echo. ' "I" is for intermediate host to echo. ' "C" is for caller's communication pgm to echo. ' SUB SetEcho (NewEcho$) STATIC IF NewEcho$ = PrevEcho$ THEN _ EXIT SUB IF NewEcho$ = "R" THEN _ ZRemoteEcho = (NOT ZLocalUser) _ ELSE ZRemoteEcho = ZFalse IF ZLocalUser THEN _ GOTO 59602 IF NewEcho$ = "I" THEN _ PRINT #3,ZHostEchoOn$; : _ GOTO 59602 IF PrevEcho$ = "I" THEN _ PRINT #3,ZHostEchoOff$; 59602 PrevEcho$ = NewEcho$ END SUB 59698 ' $SUBTITLE: 'MsgImport -- subroutine to import a message' ' $PAGE ' ' NAME -- MsgImport ' ' INPUTS -- PARAMETER MEANING ' MaxLines MAXIMUM # OF LINES ' MaxLen MAXIMUM LENGTH OF A LINE ' NumLines NUMBER OF LINES ALREADY IN MESSAGE ' LineAra$ ARRAY OF LINES IN MESSAGE ' ' OUTPUTS -- NumLines ' LineAra$ ' ' PURPOSE -- Allows local user to append a text file to ' a message. Will word wrap if needed. ' SUB MsgImport (MaxLines,MaxLen,NumLines,LineAra$(1)) STATIC IF NOT (ZLocalUser OR ZSysop) THEN _ CALL QuickTPut1 ("Only for SYSOPS/local users") : _ EXIT SUB 59700 ZOutTxt$ = "Import what file" + ZPressEnter$ CALL PopCmdStack IF ZSubParm = -1 OR ZWasQ = 0 THEN _ EXIT SUB CALL FindIt (ZUserIn$(ZAnsIndex)) IF NOT ZOK THEN _ CALL QuickTPut1 (ZUserIn$(ZAnsIndex) + " not found") : _ GOTO 59700 WHILE NOT EOF(2) AND NumLines < MaxLines NumLines = NumLines + 1 LINE INPUT #2,LineAra$(NumLines) WEND CLOSE 2 CALL WordWrap (MaxLen,NumLines,LineAra$()) END SUB 59703 ' $SUBTITLE: 'WordWrap -- subroutine to wrap lines in a message' ' $PAGE ' ' NAME -- WordWrap ' ' INPUTS -- PARAMETER MEANING ' MaxLen MAXIMUM LENGTH OF A SINGLE LINE ' NumLines NUMBER OF LINES IN A MESSAGE ' LineAra$ ALL THE LINES IN THE MESSAGE ' ' OUTPUTS -- NumLines ' LineAra$ ' ' PURPOSE -- Batch adjusts a message, wrapping lines if ' needed. Preserves paragraph structure. ' SUB WordWrap (MaxLen,NumLines,LineAra$(1)) STATIC WasJ = 1 WHILE WasJ <= NumLines ReFormatted = ZFalse 59704 CALL TrimTrail (LineAra$(WasJ)," ") WasK = LEN(LineAra$(WasJ)) IF WasK <= MaxLen THEN _ GOTO 59705 CALL FindLast (LineAra$(WasJ)," ",LastPos,HowMany) CALL AnyBut (LineAra$(WasJ),1,">",WasX) CALL AnyBut (LineAra$(WasJ+1),1,">",Temp) IF LEFT$(LineAra$(WasJ + 1),2) = " " OR ((Temp > 0) AND WasX <> Temp) THEN _ FOR WasK = NumLines TO WasJ + 1 STEP -1 : _ LineAra$(WasK + 1) = LineAra$(WasK) : _ NEXT : _ NumLines = NumLines + 1 : _ LineAra$(WasJ + 1) = "" IF WasX > 1 THEN _ IF MID$(LineAra$(WasJ),WasX,1) = " " THEN _ WasX = WasX + 1 WasX$ = LEFT$(LineAra$(WasJ),WasX-1) IF LastPos < 1 THEN _ LineAra$(WasJ + 1) = WasX$ + MID$(LineAra$(WasJ),MaxLen) + MID$(LineAra$(WasJ + 1),WasX) : _ LineAra$(WasJ) = LEFT$(LineAra$(WasJ),MaxLen - 1) + "-" _ ELSE ZUserIn$ = LEFT$(" ", - (LEN(LineAra$(WasJ + 1)) > 0)) : _ LineAra$(WasJ + 1) = WasX$ + MID$(LineAra$(WasJ),LastPos + 1) + ZUserIn$ + MID$(LineAra$(WasJ + 1),WasX) : _ LineAra$(WasJ) = LEFT$(LineAra$(WasJ),LastPos - 1) ReFormatted = ZTrue GOTO 59704 59705 IF ReFormatted THEN _ IF WasJ = NumLines THEN _ NumLines = NumLines + 1 WasJ = WasJ + 1 WEND END SUB 59760 ' $SUBTITLE: 'AnyBut -- subroutine to find where a word begins' ' $PAGE ' ' NAME -- AnyBut ' ' INPUTS -- PARAMETER MEANING ' Strng$ STRING TO SEARCH FOR WORDS ' Beg BYTE POSITION IN Strng$ TO ' BEGIN SEARCHING ' SkipChars$ CHARACTERS TO SKIP OVER WHEN ' SEARCHING ' ' OUTPUTS -- WhereIs BYTES POSITION IN Strng$ WHERE ' WORD BEGINS ' ' PURPOSE -- Parser. Finds where a "word" begins, where ' any character will be accepted as the beginning of a ' word except those listed in SKIP.CHAR$ ' SUB AnyBut (Strng$, Beg, SkipChars$, WhereIs) STATIC WasX$ = Strng$ + _ CHR$(0) WhereIs = Beg IF WhereIs < 1 THEN _ WhereIs = 1 WHILE INSTR(SkipChars$, MID$(WasX$, WhereIs, 1)) > 0 WhereIs = WhereIs + 1 WEND IF WhereIs > LEN(Strng$) THEN _ WhereIs = 0 END SUB 59770 ' $SUBTITLE: 'FindEnd -- subroutine to find where a word ends' ' $PAGE ' ' NAME -- FindEnd ' ' INPUTS -- PARAMETER MEANING ' Strng$ STRING TO SEARCH FOR WORDS ' Beg POSITION IN Strng$ TO BEGIN SEARCH ' StopWith$ CHARACTERS THAT TERMINATE A WORD ' ' OUTPUTS WhereIs POSITION IN Strng$ WHERE WORD ENDS ' (I.E. THE Last CHARACTER OF THE WORD) ' ' PURPOSE -- Parser. Finds where a "word" ends, where ' any character will be counted as in a word ' except for those in StopWith$ or when the end of ' the string is found. ' SUB FindEnd (Strng$, Beg, StopWith$, WhereIs) STATIC ZWasB = Beg IF ZWasB < 1 THEN _ ZWasB = 1 IF ZWasB > LEN(Strng$) THEN _ WasX$ = StopWith$ _ ELSE WasX$ = MID$(Strng$, ZWasB) + _ StopWith$ WasI = 1 WasX = INSTR(StopWith$, MID$(WasX$, WasI, 1)) WHILE WasX = 0 WasI = WasI + 1 WasX = INSTR(StopWith$, MID$(WasX$, WasI, 1)) WEND WhereIs = WasI - 1 + ZWasB - 1 END SUB 59780 ' $SUBTITLE: 'GetAll -- subroutine to create directory list' ' $PAGE ' ' NAME -- GetAll ' ' INPUTS -- PARAMETER MEANING ' LookIn$ NAME OF FILE TO SEARCH ' DIR.EXT$ MAIN DIRECTORY EXTENSION TO USE ' StartPos Last POSITION USED IN ARRAY ' ' OUTPUTS StartPos Last ELEMENT USED IN ARRAY ' LoadInto$ ARRAY TO LOAD ELEMENTS Found ' ' PURPOSE -- Creates a list (LoadInto$) of all directories ' to be listed when ZWasA)ll is selected for a directory. ' All uses config parm, which can be either a single ' directory or list of directories (begin with "@"). ' SUB GetAll (LoadInto$(1), StartPos) STATIC IF ZMasterDirName$ <> "" AND LEFT$(ZMasterDirName$,1) <> "@" THEN _ StartPos = StartPos + 1 : _ LoadInto$(StartPos) = ZMasterDirName$ : _ EXIT SUB ZOK = ZFalse IF LEN (ZMasterDirName$) > 1 AND LEFT$(ZMasterDirName$,1) = "@" THEN _ CALL FindIt(MID$(ZMasterDirName$,2)) IF NOT ZOK THEN _ CALL QuickTPut1 ("No dirs defined for A)ll") : _ EXIT SUB MaxLoad = UBOUND(LoadInto$, 1) StartSort = StartPos + 1 WHILE NOT EOF(2) AND StartPos < MaxLoad LINE INPUT #2, ZOutTxt$ StartPos = StartPos + 1 LoadInto$(StartPos) = ZOutTxt$ WEND CLOSE 2 END SUB 59800 ' $SUBTITLE: 'BadFileChar -- checks file for illegal char' ' $PAGE ' ' NAME -- BadFileChar ' ' INPUTS -- PARAMETER MEANING ' FilName$ NAME OF FILE TO CHECK ' ' OUTPUTS -- IsOK WHETHER NAME OK ' ' PURPOSE -- Part of test for file's existence. If bad ' character in name, can't exist. ' SUB BadFileChar (FilName$,IsOK) STATIC WasL = LEN(FilName$) IF WasL > 2 THEN _ IF INSTR(3,FilName$,":") > 0 THEN _ IsOK = ZFalse : _ EXIT SUB WasX$ = FilName$ + "=" WasI = 1 WHILE INSTR("/[]|<>+=;, ?*",MID$(WasX$,WasI,1)) = 0 AND ASC(MID$(WasX$,WasI)) < 128 WasI = WasI + 1 WEND IsOK = WasI > WasL END SUB ' 59850 ' $SUBTITLE: 'ConfMail -- quickly checks mail waiting' ' $PAGE ' ' NAME -- ConfMail ' ' INPUTS -- PARAMETER MEANING ' SKIP.CONFIRM Whether to skip confirm of option ' ZConfMailList$ File of user/message pairs to check ' ZActiveUserFile$ Active user file (restored on exit) ' ZActiveMessageFile$ Active msg file (restored) ' OUTPUTS -- None ' ' PURPOSE -- Quicking scans message header record to get ' last msg # and user record to get whether any ' new mail and last msg read, reports both, using ' highlighting if new mail to caller. ' SUB ConfMail (MailCheckConfirm) STATIC SkipJoinUnjoin = ZNonStop IF ZStartHash = 1 AND ZUserFileIndex > 0 THEN _ CALL FindIt (ZConfMailList$) _ ELSE ZOK = ZFalse IF NOT ZOK THEN _ EXIT SUB IF MailCheckConfirm THEN _ ZOutTxt$ = "Check conferences for mail ([Y],N)" : _ ZTurboKey = -ZTurboKeyUser : _ CALL PopCmdStack : _ IF ZNo OR ZSubParm < 0 THEN _ ' Bh 123190 EXIT SUB CALL BreakFileName (ZActiveUserFile$,WasX$,NowInPre$,NowInExt$,ZFalse) CALL BreakFileName (ZOrigUserFile$,WasX$,OrigPre$,OrigExt$,ZFalse) CALL SkipLine (1) CALL QuickTPut1 ("Checking Conferences since you were last on...") ' Bh AnyMail = ZFalse ZStopInterrupts = ZFalse WasA1$ = ZActiveUserFile$ MsgFileSave$ = ZActiveMessageFile$ TempIndivValue$ = "" UserFileIndexSave = ZUserFileIndex UserRecordHold$ = ZUserRecord$ ZOK = ZTrue 59852 IF EOF(2) OR NOT ZOK THEN _ GOTO 59854 CALL ReadAny ZActiveUserFile$ = ZOutTxt$ CALL ReadAny IF ZErrCode > 0 THEN _ GOTO 59854 ZActiveMessageFile$ = ZOutTxt$ CALL FindFile (ZActiveUserFile$,ZOK) IF NOT ZOK THEN _ GOTO 59854 CALL OpenUser (HighestUserRecord) FIELD 5, 128 AS ZUserRecord$ CALL FindFile (ZActiveMessageFile$,ZOK) IF NOT ZOK THEN _ GOTO 59854 CALL FindUser (ZOrigUserName$,"",ZStartHash,ZLenHash,_ 0,0,HighestUserRecord,_ Found,HoldUserFileIndex,ZWasSL) IF NOT Found THEN _ GOTO 59852 CALL OpenMsg FIELD 1, 128 AS ZMsgRec$ GET 1,1 AnyMail = ZTrue WasX = CVI(MID$(ZUserRecord$,57,2)) WasX = (WasX AND 512) > 0 CALL BreakFileName (ZActiveUserFile$,WasX$,CurPre$,CurExt$,ZFalse) InCur = (CurPre$ = NowInPre$ AND CurExt$ = NowInExt$) IF InCur THEN _ WasX = ZMailWaiting : _ ' KG030101 ZWasA = ZLastMsgRead _ ELSE ZWasA = CVI(MID$(ZUserRecord$,51,2)) ZWasB = VAL(LEFT$(ZMsgRec$,8)) WasZ = (ZWasB - ZWasA) IF WasZ < 0 THEN _ ZWasA = 0 : _ WasZ = ZWasB _ ELSE IF WasZ = 0 THEN _ WasX = ZFalse ZOutTxt$ = MID$(STR$((ZWasB > ZWasA) * WasZ),2) ZWasSL = LEN(ZOutTxt$) ZOutTxt$ = SPACE$(-(ZWasSL<4) * (4-ZWasSL)) + ZOutTxt$ ZWasSL = LEN(CurPre$) IF CurPre$ = "USERS" AND CurExt$ = "" THEN _ Conf$ = "MAIN" _ ELSE Conf$ = LEFT$(CurPre$,ZWasSL-1) ZWasY$ = Conf$ + SPACE$(-(ZWasSL<8) * (8-ZWasSL)) IF WasX THEN _ WasX$ = ZEmphasizeOn$ : _ ZWasZ$ = ZEmphasizeOff$ _ ELSE WasX$ = "" : _ ZWasZ$ = "" ZOutTxt$ = ZWasY$ + ": " + ZOutTxt$ + " new message(s): " + _ WasX$ + MID$("-None-*Some*",-6 * WasX + 1,6) + " to you" + ZWasZ$ ZSubParm = 5 CALL TPut IF SkipJoinUnjoin THEN _ CALL AskMore ("",ZTrue,ZTrue,WasX,ZTrue) : _ GOTO 59853 ZTurboKey = -ZTurboKeyUser CALL AskMore (",J)oin,U)njoin",ZTrue,ZFalse,WasX,ZFalse) IF ZNo THEN _ GOTO 59854 WasX$ = LEFT$(ZUserIn$(1),1) CALL AllCaps (WasX$) IF WasX$ = "J" THEN _ ZHomeConf$ = Conf$ : _ GOTO 59854 IF WasX$ = "U" THEN _ IF InCur OR (OrigPre$ = CurPre$ AND OrigExt$ = CurExt$) THEN _ CALL QuickTPut1 ("Can't omit yourself from the board or conference you're in") _ ELSE LSET ZUserRecord$ = CHR$(0) + "deleted user" : _ ZUserFileIndex = HoldUserFileIndex : _ ZSubParm = 6 : _ CALL FileLock : _ PUT 5, HoldUserFileIndex : _ ZSubParm = 8 : _ CALL FileLock : _ CALL QuickTPut1 ("Omitted you from " + Conf$) 59853 IF NOT ZRet THEN _ GOTO 59852 59854 ZActiveUserFile$ = WasA1$ CALL OpenUser (HighestUserRecord) FIELD 5, 128 AS ZUserRecord$ IF (NOT ZRet) AND NOT AnyMail THEN _ CALL QuickTPut1 ("You have not joined any conferences") ZUserFileIndex = UserFileIndexSave LSET ZUserRecord$ = UserRecordHold$ ZActiveMessageFile$ = MsgFileSave$ CALL OpenMsg FIELD 1, 128 AS ZMsgRec$ GET 1,1 ZNonStop = (ZPageLength > 0) END SUB 59858 ' $SUBTITLE: 'AskMore -- pauses when possible screen full' ' $PAGE ' ' NAME -- AskMore ' ' INPUTS -- PARAMETER MEANING ' ExtraPrompt$ STRING TO ADD TO MORE PROMPT AT END ' OverWrite WHETHER TO WIPE AWAY PROMPT ' ' OUTPUTS -- ZUserIn$() ' ZNo ' ' PURPOSE -- Determines whether need to pause if screen full. ' And, if so, asks the appropriate question. If non- ' stop, at least check for carrier present. ' SUB AskMore (ExtraPrompt$, OverWrite, CheckLines,AbortIndex,CantInterrupt) STATIC ZNo = ZFalse IF CheckLines THEN _ WasX = -ZDisplayAsUnit*ZUnitCount -(NOT ZDisplayAsUnit)*ZLinesPrinted : _ IF WasX < ZPageLength OR (ZPageLength = 0) THEN _ ZWasQ = 0 : _ EXIT SUB IF ZOneStop THEN _ ZOneStop = ZFalse : _ ZNonStop = ZTrue : _ GOTO 59860 IF ZNonStop THEN _ ZLinesPrinted = 0 : _ CALL CheckCarrier : _ IF ZKeyboardStack$ = "" AND ZCommPortStack$ = "" THEN _ EXIT SUB _ ELSE ZNonStop = ZFalse 59860 CALL QuickTPut (ZEmphasizeOff$,0) IF CantInterrupt THEN _ ZTurboKey = 2 : _ ZForceKeyboard = ZTrue : _ ZOutTxt$ = "Press Any Key to continue" _ ELSE GOSUB 59870 : _ ZOutTxt$ = ZMorePrompt$ + Temp$ + ExtraPrompt$ + LEFT$(">",-ZExpertUser) WasX = LEN(ZOutTxt$) + 2 ZNoAdvance = OverWrite ZSubParm = 1 IF ExtraPrompt$ = "" AND ZTurboKey = 0 THEN _ ZTurboKey = -ZTurboKeyUser ZMacroMin = 2 CALL TGet IF ZSubParm = -1 THEN _ EXIT SUB ZTurboKey = ZFalse ZWasDF$ = ZUserIn$ (1) CALL AllCaps (ZWasDF$) WasI = INSTR(";C;A;",";"+ZWasDF$+";") IF WasI = 1 THEN _ ZOutTxt$ = "* Ctrl-K(^K) / ^X aborts. ^S suspends ^Q resumes *" : _ ' Bh 112390 ZNonStop = ZTrue : _ ZWasQ = 0 CALL WipeLine (WasX + LEN(ZUserIn$)) IF NOT ZHiLiteOff THEN _ CALL QuickTPut (ZLastSmartColor$,0) IF CantInterrupt THEN _ ZNo = ZFalse : _ EXIT SUB IF WasI = 3 THEN _ AbortIndex = 32000 IF ZNo THEN _ ZKeyboardStack$ = "" : _ ZCommPortStack$ = "" : _ ZLastSmartColor$ = "" IF NOT ZJumpSupported THEN _ EXIT SUB IF ZWasDF$ = "J" THEN _ IF ZWasQ > 1 THEN _ ZUserIn$ = ZUserIn$(2) : _ GOTO 59866 _ ELSE ZOutTxt$ = "Jump forward to what text string (one word only)" + ZPressEnterExpert$ : _ ' KG092302 ' Bh CALL PopCmdStack : _ IF ZWasQ = 0 THEN _ EXIT SUB _ ELSE GOTO 59866 IF ZWasDF$ <> "R" THEN _ EXIT SUB ZUserIn$ = ZJumpLast$ 59866 ZJumpTo$ = ZUserIn$ CALL AllCaps (ZJumpTo$) ZJumpSearching = ZTrue ZJumpLast$ = ZJumpTo$ EXIT SUB 59870 Temp$ = "" IF NOT ZJumpSupported THEN _ RETURN IF ZJumpLast$ = "" THEN _ Temp$ = LEFT$(",J)ump",2+4*(ZExpertUser+1)) _ ELSE IF ZExpertUser THEN _ Temp$ = ",J,R=" + ZJumpLast$ _ ELSE Temp$ = ",J)ump,R)ejump=" + ZJumpLast$ RETURN END SUB 59880 ' $SUBTITLE: 'CompDate -- subroutine to compute elased days' ' $PAGE ' ' NAME -- CompDate ' ' INPUTS -- PARAMETER MEANING ' Year YEAR ' WasMM MONTH ' WasDD DAY ' Result! LOCATION TO PLACE THE Result ' ' OUTPUTS -- Result! COMPUTE COMPUTATIONAL DATE ' ' PURPOSE -- Computes a computational date from YEAR, MONTH, DAY. ' Results may be used to compute the number of elapsed ' days between two dates. You may pass a 2 or 4 digit ' year, but for meaningful results, be consistent ' SUB CompDate (Year,WasMM,WasDD,Result!) STATIC IF WasMM < 1 OR WasMM > 12 THEN _ WasMM = 1 Result! = Year * 365.0 + _ INT((Year - 1) / 4) + _ (WasMM - 1) * 28 + _ VAL(MID$("000303060811131619212426",(WasMM - 1) * 2 + 1,2)) - _ ((WasMM > 2) AND ((Year MOD 4) = 0)) + _ WasDD END SUB 59890 ' $SUBTITLE: 'ExpireDate -- subroutine to display expiration date' ' $PAGE ' ' NAME -- ExpireDate ' ' INPUTS -- PARAMETER MEANING ' RegDate! COMPUTATIONAL REGISTRATION DATE ' RegPeriod DAYS IN REGISTRATION PERIOD ' ' OUTPUTS -- ExpDate$ DISPLAYABLE EXPIRATION DATE ' ' PURPOSE -- Computes/creates a displayable registration ' expiration date using registration date and days in ' registration period. ' SUB ExpireDate (RegDate!,RegPeriod,ExpDate$) STATIC ExpDate! = RegDate! + RegPeriod ExpireYear = INT((ExpDate! - ExpDate! / 1461) / 365) ExpireDay = ExpDate! - (ExpireYear * 365.0 + INT((ExpireYear -1)/4)) ExpireMonth = -((ExpireYear MOD 4)<>0) * _ (1 - (ExpireDay > 31) - (ExpireDay > 59) - _ (ExpireDay > 90) - (ExpireDay >120) - _ (ExpireDay > 151) - (ExpireDay > 181) - _ (ExpireDay > 212) - (ExpireDay > 243) - _ (ExpireDay > 273) - (ExpireDay > 304) - _ (ExpireDay > 334)) - ((ExpireYear MOD 4) = 0) * _ (1 - (ExpireDay > 31) - (ExpireDay > 60) - _ (ExpireDay > 91) - (ExpireDay >121) - _ (ExpireDay > 152) - (ExpireDay > 182) - _ (ExpireDay > 213) - (ExpireDay > 243) - _ (ExpireDay > 274) - (ExpireDay > 305) - _ (ExpireDay > 335)) ExpireDay = (ExpireDay - ((ExpireMonth - 1) * 28 + _ VAL(MID$("000303060811131619212426",(ExpireMonth -1) * 2 + 1,2)))) + _ ((ExpireMonth > 2) AND ((ExpireYear MOD 4) = 0)) ExpDate$ = RIGHT$("0" + MID$(STR$(ExpireMonth),2),2) + _ "/" + _ RIGHT$("0" + MID$(STR$(ExpireDay),2),2) + _ "/" + _ RIGHT$(STR$(ExpireYear),2) END SUB 59920 ' $SUBTITLE: 'ColorDir - builds a color FMS directory string' ' $PAGE ' ' NAME -- ColorDir ' ' INPUTS -- PARAMETER MEANING ' Strng$ String to alter ' FMSDir$ "Y" FOR FMS DIR ' "N" FOR PERSONAL Download ' SUB ColorDir (Strng$,FMSDir$) STATIC IF ZWasGR < 2 THEN _ EXIT SUB IF FMSDir$ = "N" THEN _ GOTO 59921 ' ' INSERT COLOR FOR FILENAME ' ON INSTR("\ *",LEFT$(Strng$,1)) GOTO 59924,59922,59923 '59921 Strng$ = ZDR1$ + LEFT$(Strng$,13) + ZDR2$ + MID$(Strng$,14,10) + _ ' ZDR3$ + MID$(Strng$,24,10) + ZDR4$ + MID$(Strng$,34,ZMaxDescLen) ' EXIT SUB 59921 Strng$ = ZDR1$ + LEFT$(Strng$,13) + ZDR2$ + MID$(Strng$,14,7) + _ ' Bh 082790 ZDR3$ + MID$(Strng$,21,7) + ZDR4$ + MID$(Strng$,28,ZMaxDescLen) EXIT SUB 59922 Strng$ = ZDR4$ + Strng$ EXIT SUB 59923 Strng$ = ZEmphasizeOff$ + Strng$ 59924 END SUB 59930 ' $SUBTITLE: 'CheckColor - highlights based on search string' ' $PAGE ' ' NAME -- CheckColor ' ' INPUTS -- PARAMETER MEANING ' LookFor$ String that triggers highlight ' LookIn$ String being searched ' EndColor$ Terminating color ' ' OUTPUTS -- Strng$ Revised string ' ' PURPOSE -- Adds highlighting to a string within a string. ' Respects previous colorization. SUB CheckColor (LookIn$,LookFor$,PassedEndColor$) STATIC IF LookFor$ = "" THEN _ EXIT SUB WasX$ = LookIn$ CALL AllCaps (WasX$) StartColor = INSTR(WasX$,LookFor$) IF StartColor < 1 THEN _ EXIT SUB EndColor$ = PassedEndColor$ IF EndColor$ = "" THEN _ EndColor$ = ZEmphasizeOff$ : _ CALL FindLast (LEFT$(LookIn$,StartColor-1),ZEscape$,WhereFound,WasJ) : _ IF WhereFound > 0 THEN _ WasJ = INSTR(WhereFound,LookIn$,"m") : _ IF WasJ > 0 THEN _ EndColor$ = MID$(LookIn$,WhereFound,WasJ-WhereFound+1) CALL Bracket (LookIn$,StartColor,StartColor + LEN(LookFor$)-1,ZEmphasizeOn$,EndColor$) END SUB 59934 ' $SUBTITLE: 'SetHiLite - subroutine to reset highlight preference' ' $PAGE ' ' NAME -- SetHiLite ' ' INPUTS -- PARAMETER MEANING ' SetTo New value (True or False) ' ZEmphasizeOnDef$ String turns emphasize on ' ZEmphasizeOffDef$ String turns emphasize off ' ' OUTPUTS -- ZHiLiteOff Callers preference on Hilite ' ZEmphasizeOn$ String to use for emphasis ' ZEmphasizeOff$ String to use after emphasis ' SUB SetHiLite (SetTo) STATIC ZHiLiteOff = (ZEmphasizeOnDef$ <> "" AND SetTo) IF ZHiLiteOff THEN _ ZEmphasizeOn$ = "" : _ ZEmphasizeOff$ = "" : _ ZFG1$ = "" : _ ZFG2$ = "" : _ ZFG3$ = "" : _ ZFG4$ = "" _ ELSE ZEmphasizeOn$ = ZEmphasizeOnDef$ : _ ZFG1$ = ZFG1Def$ : _ ZFG2$ = ZFG2Def$ : _ ZFG3$ = ZFG3Def$ : _ ZFG4$ = ZFG4Def$ END SUB 59940 ' $SUBTITLE: 'ColorPrompt - subroutine to colorize prompts' ' $PAGE ' ' NAME -- ColorPrompt ' ' INPUTS -- PARAMETER MEANING ' Strng$ String to colorize ' ZHiLiteOff Whether highlighting is off ' ZEmphasizeOn$ String to use for emphasis ' ZEmphasizeOff$ String to use after emphasis ' ' OUTPUTS -- Strng$ Colorized string ' ' PURPOSE -- colorizes a string based on sysop settings ' and the string. ' [...] is the default - put in emphasis ' <...> options to type - put in ZFG4$ ' and first two preceeding words use ZFG1$ and ZFG2$ ' options identified on right by ) and on ' left by space or comma - put in ZFG4$ ' SUB ColorPrompt (Strng$) STATIC IF ZHiLiteOff THEN _ EXIT SUB AlreadyColorized = (INSTR(Strng$,ZEscape$) > 0) WasX = INSTR(Strng$,"<") IF WasX > 0 THEN _ GOTO 59943 WasX = INSTR(Strng$,"[") ' highlight default IF WasX > 0 THEN _ WasY = INSTR(WasX,Strng$,"]") : _ IF WasY > 0 THEN _ CALL Bracket (Strng$,WasX,WasY,ZEmphasizeOn$,ZEmphasizeOff$) IF AlreadyColorized THEN _ EXIT SUB WasX = INSTR(Strng$,"<") IF WasX < 1 THEN _ GOTO 59945 59943 WasY = INSTR(WasX,Strng$,">") IF WasY < 1 THEN _ GOTO 59945 CALL Bracket (Strng$,WasX,WasY,ZFG4$,ZEmphasizeOff$) WasY = INSTR(Strng$," ") IF WasY > 1 AND WasY < WasX THEN _ Strng$ = ZFG1$ + Strng$ : _ WasZ = INSTR(WasY+1,Strng$," ") : _ IF WasZ > 1 AND WasZ < WasX+LEN(ZFG1$) THEN _ Strng$ = LEFT$(Strng$,WasZ) + ZFG2Def$ + MID$(Strng$,WasZ+1) EXIT SUB 59945 WasX = 1 DidInsert = ZFalse WasL = LEN(ZFG4$) 59950 WasY = INSTR (WasX,Strng$,")") ' x: where command begins, y: terminating pos WasZ = INSTR (WasX,Strng$,",") IF WasY = 0 OR (WasZ > 0 AND WasZ < WasY) THEN _ WasY = WasZ WasK = LEN(Strng$) IF WasX > WasK THEN _ EXIT SUB IF WasY < 1 THEN _ IF NOT DidInsert THEN _ EXIT SUB _ ELSE WasY = WasK+1 WasZ = WasY - 1 WHILE WasZ > 0 ' got terminating pos: find beginning IF INSTR(ZOptionEnd$,MID$(Strng$,WasZ,1)) > 0 THEN _ WasX = WasZ + 1 : _ WasZ = 0 WasZ = WasZ - 1 WEND IF WasY-WasX < 3 THEN _ ' exclude commands too long CmndString$ = MID$(Strng$,WasX,WasY-WasX) : _ WasX$ = CmndString$ : _ CALL AllCaps (CmndString$) : _ IF WasX$ = CmndString$ THEN _ ' exclude lower case DidInsert = ZTrue : _ CALL Bracket (Strng$,WasX,WasY-1,ZFG4$,ZEmphasizeOff$) : _ ' colorize WasY = WasY + WasL WasX = WasY + 1 GOTO 59950 END SUB 59960 ' $SUBTITLE: 'Bracket - Inserts strings around a string' ' $PAGE ' ' NAME -- Bracket ' ' INPUTS -- PARAMETER MEANING ' Strng$ Insert in this string ' B4Here Insert 1st before this pos ' AfterHere Insert 2nd after this pos ' B4String$ String to insert before ' AfterString$ String to insert after ' ' OUTPUTS -- Strng$ ' ' PURPOSE -- Primarily for colorization ' SUB Bracket (Strng$,B4Here,AfterHere,B4String$,AfterString$) STATIC Strng$ = LEFT$(Strng$,B4Here-1) + _ B4String$ + _ MID$(Strng$,B4Here,AfterHere-B4Here+1) + _ AfterString$ + _ RIGHT$(Strng$,LEN(Strng$) - AfterHere) END SUB 59965 ' $SUBTITLE: 'UserColor - lets user set color for normal text' ' $PAGE ' ' NAME -- UserColor ' ' INPUTS -- PARAMETER MEANING ' ZEmphasizeOff$ Normal text color ' ' OUTPUTS -- ZEmphasizeOff$ New text color ' ZBoldText$ Whether bold (0 not, 1 bold) ' ZUserTextColor ANSI Color selected ' ' PURPOSE -- Lets caller select desired color and whether bold. ' SUB UserColor STATIC IF ZHiLiteOff THEN _ EXIT SUB 59970 CALL QuickTPut (ZEmphasizeOff$,0) ZOutTxt$ = "Make text R)ed,G)reen,Y)ellow,B)lue,P)urple,C)yan,W)hite" + ZPressEnterExpert$ GOSUB 59973 IF ZWasQ = 0 THEN _ ZEmphasizeOff$ = ZEscape$ + "[" + ZBoldText$ + _ ";40;" + MID$(STR$(ZUserTextColor),2) + "m" : _ EXIT SUB CALL AllCaps (ZUserIn$) WasX = INSTR("RGYBPCW",ZUserIn$) IF WasX = 0 THEN _ GOTO 59970 ZUserTextColor = 30 + WasX ZOutTxt$ = "Make text Bright (Y,[N])" GOSUB 59973 ZBoldText$ = CHR$(48 - ZYes) ZEmphasizeOff$ = ZEscape$ + "[" + ZBoldText$ + ";40;" + MID$(STR$(ZUserTextColor),2) + "m" GOTO 59970 59973 ZSubParm = 1 ZTurboKey = -ZTurboKeyUser CALL TGet IF ZSubParm = -1 THEN _ EXIT SUB RETURN END SUB 59980 ' $SUBTITLE: 'SetGraphic - Sets user graphic preference' ' $PAGE ' ' NAME -- SetGraphic ' ' INPUTS -- PARAMETER MEANING ' GraphicsNumber 0=None, 1=Ascii, 2=color ' ' OUTPUTS -- ZWasGR Shared var - set to ' graphics.number ' GraphicsLetter$ What add to file name to ' see if got graphics file ver ' ' PURPOSE -- Sets file graphics preference ' SUB SetGraphic (GraphicsNumber,GraphicsLetter$) STATIC ZWasGR = GraphicsNumber IF ZWasGR = 2 THEN _ ZDR1$ = ZFG1Def$ : _ ZDR2$ = ZFG2Def$ : _ ZDR3$ = ZFG3Def$ : _ ZDR4$ = ZFG4Def$ _ ELSE ZDR1$ = "" : _ ZDR2$ = "" : _ ZDR3$ = "" : _ ZDR4$ = "" GraphicsLetter$ = MID$(" GC",ZWasGR+1, - (ZWasGR > 0)) END SUB 60000 ' $SUBTITLE: 'EofComm - Determines whether input in comm port buffer' ' $PAGE ' ' NAME -- EofComm ' ' INPUTS -- PARAMETER MEANING ' ZFossil Whether fossil driver used ' ZComPort Comm port # in use ' ' OUTPUTS -- NoChars -1 (True) if no chars in buffer. ' Anything else means has char. ' ' PURPOSE -- Query comm port to see if input waiting ' SUB EofComm (NoChars) STATIC NoChars = EOF(3) END SUB 60100 ' $SUBTITLE: 'GlobalSrchRepl - Global search and replace' ' $PAGE ' ' NAME -- GlobalSrchRepl ' ' INPUTS -- PARAMETER MEANING ' Strng$ String to edit ' LookFor$ String to look for ' ReplaceBy$ String to replace by ' ' OUTPUTS -- Strng$ Edited string ' ' PURPOSE -- Replaces every occurence of LookFor$ that ' is in Strng$ by ReplaceBy$ ' SUB GlobalSrchRepl (Strng$,LookFor$,ReplaceBy$,OverStrike) STATIC IF LookFor$ = "" THEN _ EXIT SUB WasX = 1 WasL = LEN(ReplaceBy$) ZMsgPtr = LEN(LookFor$) 60102 WasY = INSTR(WasX,Strng$,LookFor$) IF WasY < 1 THEN _ EXIT SUB IF OverStrike THEN _ MID$(Strng$,WasY) = ReplaceBy$ + SPACE$((WasL-ZMsgPtr)*(WasL < ZMsgPtr)) _ ELSE Strng$ = LEFT$(Strng$,WasY-1) + _ ReplaceBy$ + _ RIGHT$(Strng$,LEN(Strng$)-WasY+1-ZMsgPtr) WasX = WasY + WasL IF WasX > LEN(Strng$) THEN _ EXIT SUB GOTO 60102 END SUB 60130 ' $SUBTITLE: 'MetaGSR -- Meta Global search and replace' ' $PAGE ' ' NAME -- MetaGSR ' ' INPUTS -- PARAMETER MEANING ' Strng$ String to edit ' ' OUTPUTS -- Strng$ Edited string ' ' PURPOSE -- Global search and replace for meta variables ' SUB MetaGSR (Strng$,OverStrike) STATIC WasY = 1 60131 IF WasY > LEN(Strng$) THEN _ EXIT SUB WasX = INSTR(WasY,Strng$,"[") IF WasX = 0 THEN _ EXIT SUB WasY = INSTR(WasX,Strng$,"]") IF WasY = 0 THEN _ EXIT SUB ZMsgPtr = WasY-WasX+1 Temp = WasY-WasX-1 CALL CheckInt(MID$(Strng$,WasX+1,Temp)) IF (ZErrCode > 0) OR (ZTestedIntValue < 1) OR (ZTestedIntValue > ZMaxWorkVar) THEN _ GOTO 60135 IF ((ZTestedIntValue < 10) AND (Temp = 1)) OR ((ZTestedIntValue > 9) AND (Temp = 2)) THEN _ GOTO 60132 WasY = WasX + 1 GOTO 60131 60132 WorkHold$ = ZGSRAra$(ZTestedIntValue) IF WasY = LEN(Strng$) THEN _ GOTO 60151 IF MID$(Strng$,WasY+1,1) <> "(" THEN _ GOTO 60151 WasI = INSTR(WasY+1,Strng$,")") IF WasI = 0 THEN _ GOTO 60151 WasJ = INSTR(WasY+1,Strng$,":") IF WasJ > WasI THEN _ GOTO 60151 CALL CheckInt (MID$(Strng$,WasY+2)) IF (ZErrCode > 0) OR (ZTestedIntValue < 1) OR _ (ZTestedIntValue > LEN(WorkHold$)) THEN _ GOTO 60151 WasY = WasI ZMsgPtr = WasI-WasX+1 StartSub = ZTestedIntValue CALL CheckInt (MID$(Strng$,WasJ+1)) IF ZErrCode > 0 OR ZTestedIntValue < 1 OR _ (ZTestedIntValue > LEN(WorkHold$)) THEN _ GOTO 60151 LenSub = ZTestedIntValue WorkHold$ = MID$(WorkHold$,StartSub,LenSub) GOTO 60151 60135 MetaVal$ = MID$(Strng$,WasX+1,WasY-WasX-1) WasI = INSTR(" BAUD PORT PORT# PARITYPROTO NODE FILE ",MetaVal$) IF WasI = 0 OR LEN(MetaVal$) < 4 THEN _ WasY = WasX + 1 : _ GOTO 60131 WasJ = (WasI-1)\6 + 1 WasK = (WasI+4)\6 + 1 IF WasK > WasJ THEN _ EXIT SUB ON WasJ GOTO 60155, _ 60137, _ 60139, _ 60141, _ 60143, _ 60145, _ 60147, _ 60149, _ 60151 60137 WorkHold$ = ZTalkToModemAt$ GOTO 60151 60139 WorkHold$ = ZComPort$ GOTO 60151 60141 WorkHold$ = MID$(ZComPort$,4) GOTO 60151 60143 WorkHold$ = MID$(ZBaudParity$,INSTR(ZBaudParity$,",")+1,1) GOTO 60151 60145 WorkHold$ = ZWasFT$ GOTO 60151 60147 WorkHold$ = ZNodeID$ GOTO 60151 60149 IF ZBatchTransfer THEN _ WorkHold$ = "@" + ZNodeWorkFile$ _ ELSE WorkHold$ = ZFileName$ GOTO 60151 60151 WasL = LEN(WorkHold$) IF OverStrike THEN _ MID$(Strng$,WasX) = WorkHold$ + SPACE$((WasL-ZMsgPtr)*(WasL < ZMsgPtr)) _ ELSE Strng$ = LEFT$(Strng$,WasX-1) + WorkHold$ + RIGHT$(Strng$,LEN(Strng$)-WasY) WasY = 1 ' WasY = WasX + WasL GOTO 60131 60155 WasY = WasY + 1 GOTO 60131 END SUB 60180 ' $SUBTITLE: 'TimeLock - Test TIME LOCK for premium features' ' $PAGE ' ' NAME -- TimeLock (written by Doug Azzarito) ' ' INPUTS -- PARAMETER MEANING ' ZTimeLockSet SECONDS/SESSION TO LOCK ' ' OUTPUTS -- ZSubParm -1 if feature is LOCKED ' ' PURPOSE -- Check elapsed time for lock duration ' SUB TimeLock STATIC CALL TimeRemain(MinsRemaining) IF ZSecsUsedSession! >= ZTimeLockSet THEN _ ZOK = ZTrue : _ EXIT SUB ZOutTxt$ = ZFirstName$ CALL NameCaps(ZOutTxt$) CALL QuickTPut1 ("Sorry, " + ZOutTxt$ + ", function locked" + _ STR$(INT((ZTimeLockSet-ZSecsUsedSession!)/60)) + _ " more minutes" + _ STR$(INT(ZTimeLockSet-ZSecsUsedSession!) MOD 60) + " seconds") CALL BufFile(ZHelpPath$+"TIMELOCK"+ZHelpExtension$,WasX) ZOK = ZFalse END SUB 60200 ' $SUBTITLE: 'MarkTime - Give feedback for lengthy processes' ' $PAGE ' ' NAME -- MarkTime ' ' INPUTS -- PARAMETER MEANING ' DotNumber How many dots printed ' ' OUTPUTS -- DotNumber ' ' PURPOSE -- Marks time by putting colorized dots out ' to 4, then erasing ' SUB MarkTime (DotNumber) STATIC TimeNow! = TIMER IF TimeNow! - PrevTI! < 1.0 THEN _ EXIT SUB PrevTI! = TimeNow! IF RemoveDot AND DotNumber > 0 THEN _ CALL QuickTPut (ZBackSpace$,0) : _ DotNumber = DotNumber - 1 : _ EXIT SUB DotNumber = DotNumber + 1 ON DotNumber GOTO 60201,60202,60203,60204 60201 WasX$ = ZFG1$ RemoveDot = ZFalse GOTO 60205 60202 WasX$ = ZFG2$ GOTO 60205 60203 WasX$ = ZFG3$ GOTO 60205 60204 WasX$ = ZFG4$ RemoveDot = ZTrue 60205 CALL QuickTPut (WasX$ + "." + ZEmphasizeOff$,0) END SUB 60300 ' $SUBTITLE: 'AutoPage - NOTIFIES ZSysop WHEN SPECIFIC USER CALLS' ' $PAGE ' ' NAME -- AutoPage 'Contributed by Gregg and Bob Snyder ' 'and RoseMarie Siddiqui ' ' INPUTS -- ZAutoPageDef$ List of conditions that trigger ' notification and how ' ' OUTPUTS -- NONE ' ' PURPOSE -- Search ZAutoPageDef$ for match on whether ' on name, security level, whether new user. ' Also controls whether caller notified and ' number of times sysop has bell rung. ' And what tune to play (if any). ' SUB AutoPage STATIC CALL FindIt (ZAutoPageDef$) IF NOT ZOK THEN _ EXIT SUB ZErrCode = 0 ZOK = ZFalse WHILE NOT EOF(2) AND ZOK = ZFalse AND ZErrCode = 0 CALL ReadParms (ZWorkAra$(),4,1) IF ZErrCode = 0 THEN _ ZOK = (ZWorkAra$(1) = ZActiveUserName$) : _ IF NOT ZOK THEN _ IF ZNewUser AND ZWorkAra$(1) = "NEWUSER" THEN _ ZOK = ZTrue _ ELSE IF LEFT$(ZWorkAra$(1),1) = "/" AND LEN(ZWorkAra$(1)) > 2 THEN _ ZWasB = INSTR (2,ZWorkAra$(1),"/") : _ IF ZWasB > 0 AND LEN(ZWorkAra$(1)) > ZWasB THEN _ IF ZUserSecLevel <= VAL(MID$(ZWorkAra$(1),ZWasB+1)) AND _ ZUserSecLevel >= VAL(MID$(ZWorkAra$(1),2)) THEN _ ZOK = ZTrue WEND CLOSE 2 IF ZErrCode > 0 OR NOT ZOK THEN _ ZErrCode = 0 : _ EXIT SUB ZPageStatus$ = "AutoPaged!" IF LEFT$(ZWorkAra$(2),1) = "N" THEN _ ZOutTxt$ = "Telling sysop you're on..." : _ CALL RingCaller ZWasB = (ZWorkAra$(4) = "") ZWorkAra$(5) = "" FOR WasI = 1 TO VAL(ZWorkAra$(3)) IF ZWasB THEN _ CALL LPrnt (ZBellRinger$,0) : _ ELSE ZWorkAra$(5) = ZWorkAra$(5) + "O4 X" + VARPTR$(ZWorkAra$(4)) NEXT ' IF NOT ZWasB THEN _ ' CALL RBBSPlay (ZWorkAra$(5)) END SUB 62520 ' $SUBTITLE: 'PutMsgAttr - subroutine to save msg. attributes' ' $PAGE ' ' NAME -- PutMsgAttr ' ' INPUTS -- PARAMETER MEANING ' ZWasQ ' ZUserIn$ ' ZLinesInMsg ' ZWasS ' ZNonStop ' ZMsgDimIndex ' ' OUTPUTS -- ZWasSQ ' ZWasLG$(10) ' ZLinesInMsgSave ' ZWasSL ' ZNonStopSave ' ZMsgDimIndexSave ' ' PURPOSE -- WHEN REPLYING TO A MESSAGE THIS ROUTINE SAVES ' THE ATTRIBUTES OF THE ORGINAL MESSAGE ' SUB PutMsgAttr STATIC ZWasSQ = ZWasQ ZWasLG$(10) = ZUserIn$ ZLinesInMsgSave = ZLinesInMsg ZWasSL = ZWasS ZNonStopSave = ZNonStop ZMsgDimIndexSave = ZMsgDimIndex END SUB 62530 ' $SUBTITLE: 'GetMsgAttr - subroutine to get msg. attributes' ' $PAGE ' ' NAME -- GetMsgAttr ' ' INPUTS -- PARAMETER MEANING ' ZWasSQ ' ZWasLG$(10) ' ZLinesInMsgSave ' ZWasSL ' ZNonStopSave ' ZMsgDimIndexSave ' ' OUTPUTS -- ZWasQ ' ZUserIn$ ' LINES.IN.MESSAGESAVE ' ZWasS ' ZNonStop ' ZMsgDimIndex ' ZKillMessage ' ' PURPOSE -- After replying to a message this routine restores ' the attributes of the orginal message ' SUB GetMsgAttr STATIC ZWasQ = ZWasSQ ZUserIn$ = ZWasLG$(10) ZLinesInMsg = ZLinesInMsgSave ZWasS = ZWasSL ZNonStop = ZNonStopSave ZMsgDimIndex = ZMsgDimIndexSave ZKillMessage = ZFalse END SUB 62540 ' $SUBTITLE: 'RptTime -- Reports time on system' ' $PAGE ' ' NAME -- RptTime ' ' INPUTS -- PARAMETER MEANING ' ' OUTPUTS -- ' ' PURPOSE -- Tells user time used on system ' SUB RptTime STATIC CALL SkipLine (1) CALL GetTime CALL AMorPM Mins = (ZSessionHour * 60) + ZSessionMin CALL Carrier IF ZSubParm = -1 THEN _ EXIT SUB CALL QuickTPut1 ("Now: " + DATE$ + " at " + TIME$) CALL QuickTPut1 ("On for" + STR$(Mins) + " mins," + _ STR$(ZSessionSec) + " secs") ' CALL Talk (7,ZOutTxt$) END SUB 62600 ' $SUBTITLE: 'Protocol - Determine protocols available' ' $PAGE ' ' NAME -- Protocol ' ' INPUTS -- PARAMETER MEANING ' ZProtoDef$ File of installed protocols ' ' OUTPUTS -- ZTransferOption$ Prompt for protocol choice ' ZDefaultXfer$ Letters of protocols ' ZInternalEquiv$ Internal protocol to use ' ' PURPOSE -- TO determine what protocols are available to user ' SUB Protocol STATIC CALL FindIt (ZProtoDef$) IF NOT ZOK THEN _ ZTransferOption$ = "A)scii,X)modem,C)rcXmodem,Y)modem" : _ ZInternalEquiv$ = "AXCY" : _ ZDefaultXfer$ = "AXCY" : _ GOTO 62604 ZDefaultXfer$ = "" ZInternalEquiv$ = "" ZTransferOption$ = "" WasL = 0 62602 IF EOF(2) THEN _ GOTO 62604 CALL ReadParms (ZWorkAra$(),13,1) IF ZErrCode > 0 THEN _ EXIT SUB ZDefaultXfer$ = ZDefaultXfer$ + " " ZInternalEquiv$ = ZInternalEquiv$ + " " IF ZUserSecLevel < VAL(ZWorkAra$(2)) THEN _ GOTO 62602 IF LEFT$(ZWorkAra$(5),1) = "R" THEN _ IF NOT ZReliableMode THEN _ GOTO 62602 IF LEFT$(ZWorkAra$(3),1) = "I" THEN _ GOTO 62603 WasX = INSTR(ZWorkAra$(12)+" "," ") WasX$ = LEFT$(ZWorkAra$(12),WasX-1) CALL FindFile (WasX$,Found) IF Found THEN _ WasX = INSTR(ZWorkAra$(13)+" "," ") : _ WasX$ = LEFT$(ZWorkAra$(13),WasX-1) : _ CALL FindFile (WasX$,Found) IF NOT Found THEN _ GOTO 62602 62603 MID$(ZDefaultXfer$,LEN(ZDefaultXfer$),1) = LEFT$(ZWorkAra$(1),1) CALL FindLast (ZWorkAra$(1),ZCrLf$,WasX,WasI) IF WasX > 0 AND WasX >= LEN(ZWorkAra$(1)) - 2 THEN _ ZWorkAra$(1) = LEFT$(ZWorkAra$(1),WasX-1) IF (WasL + LEN(ZWorkAra$(1)) < 62) AND WasX = 0 THEN _ ZTransferOption$ = ZTransferOption$ + "," + ZWorkAra$(1) : _ WasL = WasL + LEN(ZWorkAra$(1)) + 1 _ ELSE WasL = LEN(ZWorkAra$(1)) : _ ZTransferOption$ = ZTransferOption$ + _ ZCrLf$ + _ ZWorkAra$(1) IF LEFT$(ZWorkAra$(3),1) = "I" AND RIGHT$(ZWorkAra$(3),1) <> "I" THEN _ MID$(ZInternalEquiv$,LEN(ZInternalEquiv$),1) = RIGHT$(ZWorkAra$(3),1) GOTO 62602 62604 IF INSTR(ZInternalEquiv$,"N") > 0 THEN _ GOTO 62605 IF WasX = 0 THEN _ ZTransferOption$ = ZTransferOption$ + ",N)one" _ ELSE ZTransferOption$ = ZTransferOption$ + ZCrLf$ + "N)one" ZDefaultXfer$ = ZDefaultXfer$ + "N" ZInternalEquiv$ = ZInternalEquiv$ + "N" 62605 IF LEFT$(ZTransferOption$,1) = "," THEN _ ZTransferOption$ = MID$(ZTransferOption$,2) IF INSTR(ZDefaultXfer$,ZUserXferDefault$) = 0 THEN _ CALL QuickTPut1 ("Protocol "+ZUserXferDefault$+" unavailable. Default reset to None") : _ ZUserXferDefault$ = MID$(ZDefaultXfer$,INSTR(ZInternalEquiv$,"N"),1) END SUB 62620 ' $SUBTITLE: 'Transfer - Subroutine for external protocols' ' $PAGE ' ' NAME -- Transfer ' ' INPUTS -- PARAMETER MEANING ' ZTransferFunction = 1 DOWNLOAD FILE TO USER ' = 2 UPLOAD FILE TO RBBS-PC ' ZFileName$ NAME OF FILE FOR Transfer ' ZComPort$ NAME OF COMMUNICATIONS PORT ' TO BE USED BY KERMIT (COM1 ' OR COM2) ' ZBPS = -1 FOR 300 BAUD ' = -2 FOR 450 BAUD ' = -3 FOR 1200 BAUD ' = -4 FOR 2400 BAUD ' = -5 FOR 4800 BAUD ' = -6 FOR 9600 BAUD ' = -7 FOR 19200 BAUD ' ' OUTPUTS -- NONE ' ' PURPOSE -- To transfer files using external protocols ' SUB Transfer STATIC IF ZPrivateDoor THEN _ CALL PrivDoorRtn : _ EXIT SUB IF ZTransferFunction = 1 THEN _ ZUserIn$ = ZDownTemplate$ : _ ZWasZ$ = "send " _ ELSE IF ZTransferFunction = 2 THEN _ ZUserIn$ = ZUpTemplate$ : _ ZWasZ$ = "receive " CALL MetaGSR (ZUserIn$,ZFalse) CALL QuickTPut1 ("Protocol : "+ZProtoPrompt$) CALL QuickTPut ("Ready to " + ZWasZ$ + " ",0) IF ZBatchTransfer THEN _ CALL QuickTPut1 ("(BATCH)") : _ CALL OpenWork (2,ZNodeWorkFile$) : _ WHILE NOT EOF(2) : _ CALL ReadAny : _ CALL BreakFileName (ZOutTxt$,ZWasZ$,ZWasY$,WasX$,ZTrue) : _ CALL QuickTPut1 (" "+ZWasY$+WasX$) : _ WEND _ ELSE CALL QuickTPut1 (ZFileNameHold$) IF ZAutoLogoffReq or ZAutoEnd = 1 THEN _ CALL QuickTPut1 ("Automatic logoff will occur if the transfer is successful") ' Bh 06/26/90 CALL PrivDoorRtn END SUB 62624 ' $SUBTITLE: 'PrivDoorRtn - subroutine to exit as a private door.' ' $PAGE ' ' NAME -- PrivDoorRtn ' ' INPUTS -- PARAMETER MEANING ' ZTransferFunction = 1 DOWNLOAD FILE TO USER ' = 2 UPLOAD FILE TO RBBS-PC ' = 3 USER REGISTRATION PGM ' ZUserIn$ NAME OF FILE TO EXIT TO ' ZComPort$ NAME OF COMMUNICATIONS PORT ' TO BE USED BY KERMIT (COM1 ' OR COM2) ' ZBPS = -1 FOR 300 BAUD ' = -2 FOR 450 BAUD ' = -3 FOR 1200 BAUD ' = -4 FOR 2400 BAUD ' = -5 FOR 4800 BAUD ' = -6 FOR 9600 BAUD ' = -7 FOR 19200 BAUD ' ' OUTPUTS -- NONE ' ' PURPOSE -- To transfer control to another program ' SUB PrivDoorRtn STATIC IF ZPrivateDoor THEN _ GOTO 62630 IF ZFakeXRpt THEN _ CALL FakeXRpt (ZWasFT$) IF ZAdvanceProtoWrite THEN _ CALL OpenOutW ("XFER-"+ZNodeID$+".DEF") : _ IF ZErrCode < 1 THEN _ CALL PrintWorkA (ZFileName$+",,"+ZWasFT$) : _ CLOSE 2 IF ZProtoMethod$ = "S" THEN _ GOTO 62629 62628 WasX$ = LEFT$(ZUserIn$,INSTR(ZUserIn$+" "," ")-1) IF WasX$ = "" THEN _ EXIT SUB CALL FindIt (WasX$) IF NOT ZOK THEN _ ZOutTxt$ = "Missing door program" : _ CALL UpdtCalr (ZOutTxt$ + " " + WasX$,1) : _ ZSnoop = ZTrue : _ CALL LPrnt (ZOutTxt$,1) : _ EXIT SUB ZOutTxt$(1) = "CLS" GOSUB 62633 ZOutTxt$(2) = "ECHO" + ZOutTxt$ ZOutTxt$(3) = ZDiskForDos$ + _ "COMMAND /C " + _ ZUserIn$ ZOutTxt$(4) = ZRBBSBat$ ZPrivateDoor = ZTrue CALL QuickTPut1 ("I have to run an External Program for this function and I'm a little sluggish.") CALL QuickTPut1 ("Please be patient and stand by...I'm not quite ready yet!") LOCATE 25,1 CALL LPrnt(ZLineFeed$,0) CALL RBBSExit (ZOutTxt$(),4) 62629 GOSUB 62633 ' CLS 'PE 02/16/90 ZOutTxt$ = ZOutTxt$ + ZCrLf$ ' Pe 02/17/90 CALL PScrn (ZOutTxt$) CALL ShellExit (ZUserIn$) 62630 IF ZPrivateDoor THEN _ CALL RestoreCom : _ CALL DelayTime (7 + ZBPS) : _ CALL SetBaud : _ CALL QuickTPut1 ("Reloading HIS BOARD software. Please be patient.") 62631 CALL SkipLine (2) LOCATE 24,1 62632 EXIT SUB 62633 ZOutTxt$ = STR$(ZUserSecLevel) + _ " " + _ ZActiveUserName$ + _ " " + _ ZWasCI$ RETURN END SUB 62650 ' $SUBTITLE: 'FakeXRpt - subroutine to create fake xfer report' ' $PAGE ' ' NAME -- FakeXRpt ' ' INPUTS -- PARAMETER MEANING ' ZFileNameHold$ FILE TO BE TRANSFERRED ' ProtoUsed$ Protocol USED ' ' OUTPUTS -- WRITES OUT Transfer FILE REPORT ' ' PURPOSE -- External protocol drivers that do not write ' out a standard transfer report must have one ' provided in order for "dooring" to external ' protocols to work properly, since this file ' is read upon returning from an external protocol. ' SUB FakeXRpt (ProtoUsed$) STATIC CLOSE 2 OPEN "O",2,"XFER-" + _ ZNodeFileID$ + _ ".DEF" PRINT #2,ZFileName$ PRINT #2, PRINT #2,ProtoUsed$ PRINT #2,"S" CLOSE 2 END SUB 62660 ' $SUBTITLE: 'SetExpert - subroutine to adjust for expert change' ' $PAGE ' ' NAME -- SetExpert ' ' INPUTS -- PARAMETER MEANING ' ZExpertUser WHETHER IS AN EXPERT ' ' OUTPUTS -- ZMorePrompt$ Pause prompt ' ZPressEnter$ Prompt to press enter ' ' PURPOSE -- Make more helpful prompt for novices and shorter ' one for experts ' SUB SetExpert STATIC IF ZExpertUser THEN _ ZMorePrompt$ = "More <[Y],N,C" : _ ' Bh ZPressEnter$ = ZPressEnterExpert$ : _ EXIT SUB ZMorePrompt$ = "More [Y]es,N)o,C)ontinuous" ' Bh ZPressEnter$ = ZPressEnterNovice$ END SUB 62668 ' $SUBTITLE: 'NewPassword - subroutine to get new password' ' $PAGE ' ' NAME -- NewPassword ' ' INPUTS -- PARAMETER MEANING ' Prompt$ Prompt to display ' DisallowSpaces Whether answer can have all spaces ' ' OUTPUTS -- ZWasZ$ Password ' ' PURPOSE -- To get a new password. ' SUB NewPassword (Prompt$,DisallowSpaces) STATIC 62670 ZOutTxt$ = Prompt$ ZHidden = ZTrue CALL PopCmdStack ZHidden = ZFalse IF ZSubParm < 0 OR ZWasQ = 0 THEN _ EXIT SUB IF LEN(ZUserIn$) > 15 THEN _ CALL QuickTPut1 ("15 chars max") : _ GOTO 62670 IF INSTR(ZUserIn$,";") > 0 THEN _ CALL QuickTPut1 ("Cannot use ';'") : _ GOTO 62670 IF DisallowSpaces THEN _ IF ZUserIn$ = SPACE$(LEN(ZUserIn$)) THEN _ CALL QuickTPut1 ("Not all blanks") : _ GOTO 62670 CALL AllCaps (ZUserIn$) ZWasZ$ = ZUserIn$ END SUB 63000 ' $SUBTITLE: 'TimedOut - exits based on time of day' ' $PAGE ' ' NAME -- TimedOut ' ' INPUTS -- PARAMETER MEANING ' ZRCTTYBat$ ' ZNodeRecIndex ' ZMsgRec$ ' ZModemInitBaud$ ' ZModemGoOffHookCmnd$ ' ' OUTPUTS -- NONE ' ' PURPOSE -- When RBBS-PC is to exit to DOS at a specific time of ' day, this routine writes out to the file specified ' in "ZRCTTYBat$" the one-line entry: ' RBBSxTM.BAT ' WHERE "x" is the node id. ' SUB TimedOut STATIC FIELD #1,128 AS ZMsgRec$ ZSubParm = 3 CALL FileLock GET 1,ZNodeRecIndex WasX$ = DATE$ CALL PackDate (WasX$,ZWasY$) MID$(ZMsgRec$,77,2) = ZWasY$ 'MID$(ZMsgRec$,86,5) = LEFT$(TIME$,5) PUT 1,ZNodeRecIndex ZSubParm = 2 CALL FileLock CLOSE 2 ZFileName$ = ZNodeWorkDrvPath$ + "RBBS" + ZNodeFileID$ + "TM.DEF" OPEN "O",2,ZFileName$ PRINT #2,MID$(ZFileName$,3,7) CLOSE 2 IF ZLocalUserMode THEN _ EXIT SUB IF ZSubParm <> 7 THEN _ ZSubParm = 4 : _ CALL FileLock : _ CALL OpenCom(ZModemInitBaud$,",N,8,1") CALL TakeOffHook END SUB 64003 ' $SUBTITLE: 'AskUsers - subroutine to get registration information' ' $PAGE ' ' NAME -- AskUsers (WRITTEN BY JON MARTIN) ' ' INPUTS -- PARAMETER MEANING ' ZFileName$ NAME OF THE FILE CONTAINING THE ' SCRIPT TO BE USED WHEN ASKING ' THE USER QUESTIONS. ' ZActiveUserName$ NAME OF THE CURRENT USER ' ZUserSecLevel USER'S SECURITY ' ZUpperCase SET IF USER NEEDS UPPERCASE ' ' OUTPUTS -- WRITE THE USER'S RESPONSES TO THE QUESTIONS TO THE ' FILE NAME SPECIFIED AS THE First PARAMETER IN THE ' First RECORD OF THE FILE CONTAINING THE SCRIPT TO ' BE USED. ' ZUserSecLevel CAN BE RAISED OR LOWERED ' ' PURPOSE -- Provides a sophisticated, script driven mechanism by ' which a sysop can control the interaction with the ' user. Special function questionnaires include the ' registration questionnaire and the epilog. ' SUB AskUsers STATIC ZQuestAborted = ZFalse ZQuestChainStarted = ZFalse REDIM ZOutTxt$(256) REDIM ZWorkAra$(ZMaxWorkVar),ZGSRAra$(ZMaxWorkVar) PrevAppend$ = "" ' ' ' * LOAD SCRIPT CONTAINING THE QUESTIONS INTO THE ZOutTxt$ DIMENSION * ' ' 64005 ZChatAvail = ZFalse QestChain = ZFalse LastQues = 0 CALL Graphic (ZUserGraphicDefault$,ZFileName$) IF NOT ZOK THEN _ EXIT SUB CALL ReadParms (ZOutTxt$(),2,1) IF ZErrCode > 0 THEN _ EXIT SUB PrevAppend$ = AppendFileName$ AppendFileName$ = ZOutTxt$(1) MaxSecLevel = VAL(ZOutTxt$(2)) WasX = INSTR(ZOutTxt$(2)," ") IF WasX > 0 THEN _ IF ZUserSecLevel < VAL(MID$(ZOutTxt$(2),WasX)) THEN _ CALL QuickTPut1 ("Higher security needed for questionnaire") : _ EXIT SUB ' ' ' * THE First RECORD OF THE SCRIPT FILE CONTAINS THREE PARAMETERS: ' * 1. THE NAME OF THE FILE TO APPEND THE ANSWERS TO. ' * 2. THE MAXIMUM SECURITY LEVEL THE + COMMAND CAN RAISE A USER SECURITY ' * 3. THE MINIMUM SECURITY TO USE THIS QUESTIONNAIRE ' * e.g. 'C:XXX.DAT,6 5' writes answers to C:XXX.DAT, can raise to 6, ' * and requires security 5 or more to access ScriptIndex = 1 ZOutTxt$(ScriptIndex) = ZActiveUserName$ + _ " " + _ DATE$ + _ " " + _ TIME$ 64010 IF EOF(2) OR ScriptIndex > 255 THEN _ GOTO 64100 ScriptIndex = ScriptIndex + 1 LINE INPUT #2,ZOutTxt$(ScriptIndex) IF LEFT$(ZOutTxt$(ScriptIndex),1) = ":" THEN _ CALL AllCaps (ZOutTxt$(ScriptIndex)) : _ CALL Trim (ZOutTxt$(ScriptIndex)) IF ZUpperCase THEN _ CALL AllCaps (ZOutTxt$(ScriptIndex)) IF LEFT$(ZOutTxt$(ScriptIndex),1) = "?" THEN _ ScriptIndex = ScriptIndex + 1 : _ ZOutTxt$(ScriptIndex) = "!" GOTO 64010 ' ' ' * PROCESS QUESTIONS IN THE SCRIPT AS FOLLOWS: ' * ' * First COLUMN MEANING ' * : THIS LINE IS A LABEL THAT MAY BE BRANCHED TO ' * ! THIS MEANS THIS IS AN ANSWER ' * > THIS IS A "GOTO" COMMAND TO ONE OF THE LABELS ' * * THIS MEANS THE LINE IS A MESSAGE TO BE WRITTEN TO THE USER ' * ? THIS MEANS THIS IS A QUESTION FOR THE USER ' * = THIS MEANS THAT THIS LINE CONTAINS DECISION CRITERIA ' * - THIS MEANS TO LOWER THE USER'S SECURITY LEVEL ' * + THIS MEANS TO RAISE THE USER'S SECURITY LEVEL ' * @ THIS MEANS TO ABORT THE QUESTIONNAIRE DO NOT WRITE OUT ' * & THIS MEANS TO CHAIN TO ANOTHER QUESTIONNAIRE ' * M Execute specified macro ' * T Turbo Key ' * < Assign value to work variable ' 64100 ScriptMax = ScriptIndex ScriptIndex = 1 64110 CALL Carrier IF ZSubParm = -1 THEN _ GOTO 64510 ScriptIndex = ScriptIndex + 1 IF ScriptIndex > ScriptMax THEN _ GOTO 64400 ZOutTxt$ = MID$(ZOutTxt$(ScriptIndex),2) WasX = ZFalse IF LEFT$(ZOutTxt$,3) = "/FL" THEN _ ZOutTxt$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-3) : _ WasX = ZTrue CALL MetaGSR (ZOutTxt$,WasX) CALL SmartText (ZOutTxt$,ZFalse,WasX) WasX$ = ZOutTxt$ ON INSTR(" :!@MT><*?=-+&",LEFT$(ZOutTxt$(ScriptIndex),1)) GOTO _ 64111, _ ' catch invalid lines 64110, _ ' : label 64110, _ ' ! stored answer 64420, _ ' @ abort 64120, _ ' M macro execute 64430, _ ' T turbo key 64440, _ ' > goto label 64190, _ ' < assign value 64450, _ ' * display line 64113, _ ' ? prompt for answer 64114, _ ' = conditional branch 64460, _ ' - decrease security level 64465, _ ' + increase security level 64470 ' & chain 64111 ZOutTxt$ = "Invalid line. Column 1 is <" + LEFT$(ZOutTxt$(ScriptIndex),1)+">. Must be: * ? = + - > @ & M T <" ZSubParm = 5 CALL TPut GOTO 64510 64113 LastQues = ScriptIndex ' process ? GOSUB 64180 ZSubParm = 1 CALL TGet IF ZSubParm = -1 THEN _ GOTO 64510 _ ELSE IF ZWasQ = 0 THEN _ ZOutTxt$ = WasX$ : _ GOTO 64113 _ ELSE ZOutTxt$(ScriptIndex + 1) = "!" + _ ZUserIn$ : _ ZGSRAra$(ZTestedIntValue) = ZUserIn$ GOTO 64110 64114 IF LEFT$(ZOutTxt$(ScriptIndex),2) = "=#" THEN _ ' Numeric GOSUB 64350 : _ GOTO 64110 GOSUB 64300 ' process = GOTO 64445 64120 ZWasZ$ = MID$(ZOutTxt$(ScriptIndex),2) ' Execute macro CALL Trim (ZWasZ$) CALL Macro (ZWasZ$,Found) IF Found THEN _ CALL FDMACEXE GOTO 64110 64180 CALL CheckInt (ZOutTxt$) IF (ZErrCode > 0) OR (ZTestedIntValue < 1) OR _ (ZTestedIntValue > ZMaxWorkVar) OR _ (INSTR("123456789",LEFT$(ZOutTxt$,1)) = 0) THEN _ ZTestedIntValue = 0 _ ELSE ZOutTxt$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-1+(ZTestedIntValue > 9)) RETURN 64190 GOSUB 64180 IF ZTestedIntValue > 0 THEN _ ZGSRAra$(ZTestedIntValue) = MID$(ZOutTxt$,2) GOTO 64110 ' ' ' * SEARCH FOR GOTO LABEL ' ' 64200 ScriptIndex = 1 CALL MetaGSR (BranchLabel$,ZFalse) CALL SmartText (BranchLabel$,ZFalse,ZFalse) CALL AllCaps (BranchLabel$) CALL Trim (BranchLabel$) 64210 ScriptIndex = ScriptIndex + 1 IF ScriptIndex > ScriptMax THEN _ ZOutTxt$ = BranchLabel$ + _ " not found!" : _ ZSubParm = 5 : _ CALL TPut : _ IF ZSubParm = -1 THEN _ RETURN _ ELSE IF LastQues > 0 THEN _ ScriptIndex = LastQues - 1 : _ RETURN _ ELSE GOTO 64510 IF LEFT$(ZOutTxt$(ScriptIndex),1) <> ":" THEN _ GOTO 64210 IF MID$(ZOutTxt$(ScriptIndex),2) <> BranchLabel$ THEN _ GOTO 64210 RETURN ' ' ' * DETERMINE BRANCH LOGIC ' ' 64300 CurEquals = 1 ZWasZ$ = RIGHT$(ZOutTxt$(LastQues + 1),1) CALL AllCaps (ZWasZ$) 64310 NextEquals = INSTR(CurEquals + 1, ZOutTxt$(ScriptIndex),"=") IF NextEquals = 0 THEN _ BranchLabel$ = MID$(ZOutTxt$(ScriptIndex),CurEquals + 2) : _ GOTO 64320 IF ZWasZ$ <> _ MID$(ZOutTxt$(ScriptIndex),CurEquals + 1,1) THEN _ CurEquals = NextEquals : _ GOTO 64310 BranchLabel$ = MID$(ZOutTxt$(ScriptIndex),CurEquals + 2,NextEquals-(CurEquals + 2)) 64320 GOSUB 64200 RETURN ' ' ' * DETERMINE Numeric BRANCH LOGIC ' ' 64350 CurEquals = 1 64360 NextEquals = INSTR(CurEquals + 1, ZOutTxt$(ScriptIndex),"=") IF NextEquals = 0 THEN _ BranchLabel$ = MID$(ZOutTxt$(ScriptIndex),CurEquals + 2) : _ GOTO 64380 Numeric = ZTrue LoopIndex = 2 WHILE LoopIndex < LEN(ZOutTxt$(ScriptIndex - 1)) +1 IF INSTR("()1234567890- ",MID$(ZOutTxt$(ScriptIndex - 1),LoopIndex,1)) THEN _ GOTO 64370 Numeric = ZFalse 64370 LoopIndex = LoopIndex + 1 WEND IF NOT Numeric THEN _ CurEquals = NextEquals : _ GOTO 64360 BranchLabel$ = MID$(ZOutTxt$(ScriptIndex),CurEquals + 2,NextEquals-(CurEquals + 2)) 64380 GOSUB 64200 RETURN ' ' ' * WRITE RESPONSES TO DESIGNATED FILE ' ' 64400 ScriptIndex = 0 ZWasEN$ = AppendFileName$ CALL LockAppend IF ZErrCode <> 0 THEN _ ZOutTxt$ = "Fatal Error in script!" : _ ZSubParm = 5 : _ CALL TPut : _ GOTO 64500 64410 ScriptIndex = ScriptIndex + 1 IF ScriptIndex > ScriptMax THEN _ GOTO 64500 IF LEFT$(ZOutTxt$(ScriptIndex),1) = ":" THEN _ QuestionSave$ = MID$(ZOutTxt$(ScriptIndex),2) : _ GOTO 64410 IF LEFT$(ZOutTxt$(ScriptIndex),1) = "!" AND _ LEN(ZOutTxt$(ScriptIndex)) < 2 THEN _ GOTO 64410 IF LEFT$(ZOutTxt$(ScriptIndex),1) = "!" THEN _ CALL PrintWorkA (QuestionSave$) : _ CALL PrintWorkA (MID$(ZOutTxt$(ScriptIndex),2)) IF ScriptIndex = 1 AND _ AppendFileName$ <> PrevAppend$ THEN _ CALL PrintWorkA (ZOutTxt$(ScriptIndex)) IF ZErrCode <> 0 THEN _ ZOutTxt$ = "Unrecoverable failure in script!" : _ ZSubParm = 5 : _ CALL TPut : _ GOTO 64500 GOTO 64410 64420 ZQuestAborted = ZTrue ' @ abort GOTO 64510 64430 ZTurboKey = -ZTurboKeyUser ' T turbo key GOTO 64110 64440 BranchLabel$ = ZOutTxt$ ' = branch GOSUB 64200 64445 IF ZSubParm = -1 THEN _ GOTO 64510 _ ELSE GOTO 64110 64450 ZSubParm = 5 ' * display CALL TPut GOTO 64445 64460 WasX = -1 ' - lower security 64462 CALL CheckInt (ZOutTxt$) IF ZErrCode = 0 THEN _ Temp = ZUserSecLevel + _ WasX * ZTestedIntValue : _ IF Temp <= MaxSecLevel THEN _ ZUserSecLevel = Temp : _ ZUserSecSave = ZUserSecLevel : _ ZAdjustedSecurity = ZTrue GOTO 64110 64465 WasX = 1 ' + raise security GOTO 64462 64470 QestChain = ZTrue ' & chain questionnaires ZFileNameHold$ = ZOutTxt$ GOTO 64110 64500 CALL UnLockAppend CALL Carrier IF QestChain THEN _ ZQuestChainStarted = ZTrue : _ ZFileName$ = ZFileNameHold$ : _ GOTO 64005 64510 ZChatAvail = (INSTR("MUF",ZActiveMenu$) > 0) ZOK = ZTrue ZLastIndex = 0 END SUB 64600 ' $SUBTITLE: 'ViewArc - subroutine to display .ARC contents' ' $PAGE ' ' NAME -- ViewArc (Written by Jon Martin) ' ' INPUTS -- PARAMETER MEANING ' ZFileName$ NAME OF THE ARC FILE TO BE ' VIEWED. ' ' OUTPUTS -- NONE ' ' PURPOSE -- Provides a mechanism to provide users with the ' contents of a libraried file prior to downloading. ' SUB ViewArc STATIC CLOSE 2 RetCode = 0 'Maple Street Zip View Mods *********** IF ZLastExt$ = "ZIP" THEN _ FilName$ = ZLibArcPath$+"PKUNZIP.EXE" _ 'PE/03/28/89 ELSE IF ZLastExt$ = "LZH" THEN _ FilName$ = ZLibArcPath$+"LHARC.EXE"_ ELSE IF ZLastExt$ = "ARC" THEN _ ' Bh 110690 FilName$ = ZLibArcPath$+"ARCVIEW.COM"_ ' Bh 110690 ELSE _ FilName$ = ZLibArcPath$+"TYPE" ' Bh 110690 CALL FindIt (FilName$) IF NOT ZOK THEN _ CALL QuickTPut(" Missing "+ FilName$ + " ...Please tell Sysop " ,1) : _ EXIT SUB CALL QuickTPut ("Preparing " + ZFileNameHold$ + " for view...one moment please.... ",1) ' Bh 110690 ' 'CALL QuickTPut ("Creating View file, One Moment Please.... ",1) ' Bh 110690 'ZStopInterrupts = ZTrue IF ZLastExt$ = "ZIP" THEN _ SHOWARC$ = ZLibArcPath$+ "PKUNZIP.EXE -v "_ ELSE IF ZLastExt$ = "LZH" THEN _ 'PM 07/26/89 SHOWARC$ = ZLibArcPath$+ "LHARC.EXE l "_ 'PE 09/20/89 ELSE IF ZLastExt$ = "ARC" THEN _ ' Bh 110690 SHOWARC$ = ZLibArcPath$+ "ARCVIEW.COM "_ ' Bh 110690 ELSE _ SHOWARC$ = "TYPE " ' Bh 110690 ' SHOWARC$ = SHOWARC$ +ZFileName$ + ">" + ZArcWork$ SHELL SHOWARC$ CALL BufFile (ZArcWork$,WasX) EXIT SUB END SUB