' $linesize:132 ' $title: 'RBBSSUB5.BAS 17.3B, Copyright 1986 - 90 by D. Thomas Mack' ' DA081003 ' Copyright 1990 by D. Thomas Mack, all rights reserved. ' Name ...............: RBBSSUB5.BAS ' First Released .....: February 11, 1990 ' Subsequent Releases.: August 26, 1990; October 28, 1990 ' 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 ' BinSearch 63520 Binary searches sorted file for a key value ' BreakFileName 63300 Break file name into component parts ' BufAsUnit 63500 Buffer out a string with CR's ' SetPrompt 63470 Set prompts based on the user's security ' DoorReturn 63100 Process door requests ' FdMacExe 63462 Executes a found macro ' FileSystem 20117 File System for RBBS-PC ' FindIt 63490 Check whether file exists and if so open as #2 ' FormRead 63420 Read from file into a form ' LockAppend 63400 Prepare for a file append ' MacroExe 63460 Execute internal macro rather than user ' MsgNameMatch 63540 Match name to one in msg header ' NoPath 63480 Detects whether string has a path in it ' RestoreCom 63310 Restore comm port after external program ' ReadMacro 63330 Read and process macro ' ShellExit 63320 Exit RBBS via shell ' TakeOffHook 63530 Take modem off hook ' UnLockAppend 63410 Clean up after file append ' VerifyAns 63510 Verify that string passes edits ' WildCard 63200 Match string to a pattern ' ' $INCLUDE: 'RBBS-VAR.BAS' ' 20117 ' $SUBTITLE: 'FileSystem -- subroutine for RBBS-PC's file system' ' $PAGE ' ' NAME -- FileSystem ' ' INPUTS -- PARAMETER MEANING ' ZFileSysParm = 1 LIST THE SYSOP'S COMMENTS FILE ' 2 L)IST DIRECTORY COMMAND ' 3 D)OWNLOAD COMMAND ' 4 RETURN FROM EXTERNAL PROTOCOLS ' 5 U)PLOAD COMMAND ' 6 S)CAN DIRECTORY COMMAND ' 7 P)ERSONAL FILES COMMAND ' 8 N)EW FILES COMMAND ' 9 RETURN FROM EXTENDED DESCRIPTION ' ' OUTPUTS -- ZFileSysParm = 1 COMMAND PROCESSED SUCCESSFULLY ' 2 RECYCLE TO TOP OF RBBS-PC (202) ' 3 PROCESS NEXT COMMAND (1200) ' 4 DENY USER ACCESS (1380) ' 5 HANDLE EXTENDED DESCRIP. (2008) ' 6 USER'S TIME EXCEEDED (10553) ' 7 Carrier DROPPED (10595) ' ' PURPOSE -- To handle the RBBS-PC file system commands ' SUB FileSystem STATIC ZFF = ZFileSysParm ZFileSysParm = 1 ON ZFF GOSUB 20119, _ ' HANDLER TO LIST COMMENTS TO SYSOP 20150, _ ' L)IST DIRECTORY COMMAND HANDLER 20180, _ ' D)OWNLOAD COMMAND HANDLER 20263, _ ' RETURN FROM EXTERNAL Protocol'S 20400, _ ' U)PLOAD COMMAND HANDLER 21800, _ ' S)CAN DIRECTORY COMMAND HANDLER 21850, _ ' P)ERSONAL FILES COMMAND HANDLER 21860, _ ' N)EW FILES COMMAND HANDLER 20705 ' RETURN FROM EXTENDED DESCRIPTIONS GOTO 21920 20119 ZErrCode = 0 GOTO 20122 ' ' ***** SCAN DIRECTORIES (PRINT TEXT) **** ' ' (formerly lines 7000 to 7260 in RBBS-PC.BAS CPC16-1A 20120 ZOutTxt$ = "Scanning Directory " + _ ZFileNameHold$ IF WasRS$ <> "" THEN _ ZOutTxt$ = ZOutTxt$ + " for " + WasRS$ GOSUB 21650 IF ZFileSysParm > 1 THEN _ RETURN CALL AskMore ("",ZTrue,ZTrue,ZAnsIndex,ZFalse) ' KG040901 IF ZNo THEN _ ' KG040901 ZErrCode = 0 : _ ' KG040901 RETURN ' KG040901 WasPG = ZTrue 20122 CALL OpenWork (2,ZFileName$) IF ZErrCode = 53 THEN _ ZOutTxt$ = "Missing File " + ZFileName$ : _ CALL UpdtCalr (ZOutTxt$,2) : _ ZOutTxt$ = ZOutTxt$ + _ ". Please tell SYSOP" : _ GOSUB 21650 : _ RETURN ZJumpSupported = ZTrue ZJumpLast$ = "" LastOK = ZFalse ZJumpSearching = ZFalse ' ML071502 20124 CALL Carrier IF EOF(2) OR _ (ZSubParm = -1 AND NOT ZLocalUser) THEN _ GOTO 20142 20126 CALL ReadDir (2,1) IF ZErrCode <> 0 THEN _ ZWasEL = 20126 : _ GOTO 21900 IF WasCK = 0 THEN _ GOTO 20140 IF LEFT$(ZOutTxt$,1) = " " THEN _ IF LastOK AND NOT ZExtendedOff THEN _ GOTO 20140 _ ELSE GOTO 20124 LastOK = ZFalse 20128 IF ZJumpSearching THEN _ GOTO 20129 IF WasCK < 2 THEN _ GOTO 20130 IF WildSearch THEN _ ZWasA = INSTR(ZOutTxt$," ") : _ IF ZWasA = 0 THEN _ GOTO 20124 _ ELSE ZWasZ$ = LEFT$(ZOutTxt$,ZWasA - 1) : _ CALL WildFile (WasRS$,ZWasZ$,WasXXX) : _ WasXXX = NOT WasXXX : _ GOTO 20136 20129 ZWasZ$ = ZOutTxt$ CALL AllCaps (ZWasZ$) WasXXX = (INSTR(ZWasZ$,WasRS$) = 0) GOTO 20136 20130 ZWasA = INSTR(9,MID$(ZOutTxt$,1,32),"/") IF ZWasA = 0 THEN _ ZWasA = INSTR(9,MID$(ZOutTxt$,1,32),"-") 20132 IF ZWasA < 3 THEN _ GOTO 20124 IF INSTR("0123456789",MID$(ZOutTxt$,ZWasA - 1,1)) = 0 THEN _ GOTO 20124 ZWasA = ZWasA - 2 WasWK$ = RIGHT$(MID$(ZOutTxt$,ZWasA,8),2) + _ LEFT$(MID$(ZOutTxt$,ZWasA,8),2) + _ MID$(MID$(ZOutTxt$,ZWasA,8),4,2) IF MID$(WasWK$,3,1) = " " THEN _ MID$(WasWK$,3,1) = "0" IF MID$(WasWK$,5,1) = " " THEN _ MID$(WasWK$,5,1) = "0" 20134 WasXXX = (WasWK$ < WasRS$) 20136 IF WasXXX THEN _ GOTO 20124 IF ZJumpSearching THEN _ WasRS$ = PrevSearch$ : _ WasCK = PrevCK : _ ZJumpSearching = ZFalse : _ GOTO 20140 IF WasPG THEN _ WasPG = ZFalse : _ CALL OpenWork (2,ZFileName$) : _ ZWasQ = 0 : _ GOTO 20124 20138 IF WasPG THEN _ GOTO 20124 20140 LastOK = ZTrue GOSUB 21650 IF ZFileSysParm > 1 THEN _ RETURN CALL AskMore ("",ZTrue,ZTrue,ZAnsIndex,ZFalse) IF ZNo THEN _ ZErrCode = 0 : _ RETURN IF ZJumpSearching THEN _ IF LEFT$(ZOutTxt$,1) <> " " THEN _ PrevSearch$ = WasRS$ : _ PrevCK = WasCK : _ WasCK = 2 : _ WasRS$ = ZJumpTo$ IF NOT ZRet THEN _ GOTO 20124 20142 ZWasQ = 0 ZJumpSupported = ZFalse CLOSE 2 CALL Carrier IF ZSubParm = -1 THEN _ ZFileSysParm = 7 RETURN ' ' * L - COMMAND FROM FILES MENU (LIST DIRECTORY) ' 20150 ZListDir = ZTrue ListNew = ZFalse SearchDate$ = "" SearchString$ = "" WasRS$ = "" ShowDirOfDir = (ZLastIndex <= ZAnsIndex) AND NOT ZExpertUser WasCK = 0 ZSearchingAll = ZFalse 20155 IF ListNew OR ZAnsIndex > 255 THEN _ RETURN CALL GetDirs (ShowDirOfDir) IF ZWasQ = 0 THEN _ RETURN ShowDirOfDir = ZFalse CALL ConvertDir (ZAnsIndex) WasQX = ZLastIndex 20157 CALL Carrier IF ZSubParm = -1 THEN _ ZFileSysParm = 7 : _ RETURN GOTO 20161 20159 IF ZAnsIndex < ZLastIndex THEN _ GOTO 20155 ZSearchingAll = ZFalse CALL CmdStackPushPop (1) ZLastIndex = 0 IF ZNo OR (ZFileNameHold$ = ZDirPrefix$) THEN _ GOTO 20155 CALL QuickTPut (ZEmphasizeOff$,0) ZOutTxt$ = "End list. R)elist, [Q]uit, or file(s) to dwnld" ' KG082004 ZStackC = ZTrue GOSUB 21668 CALL AllCaps (ZUserIn$(1)) IF ZUserIn$(1) = "R" THEN _ ZUserIn$(ZAnsIndex) = WasA1$ : _ GOTO 20161 IF LEN(ZUserIn$(1)) > 1 AND _ ZUserSecLevel >= ZOptSec(19 - 20 * (ZMenuIndex = 6)) THEN _ ZAnsIndex = 1 : _ GOSUB 20202 CALL CmdStackPushPop (2) RETURN 20161 IF INSTR(ZUserIn$(ZAnsIndex),".") THEN _ GOTO 20172 ZViolation$ = "List Dir. " ZWasZ$ = ZUserIn$(ZAnsIndex) ZWasA = INSTR("E+E-E",ZWasZ$) IF ZWasA > 0 THEN _ IF ZWasA = 5 THEN _ ZExtendedOff = NOT ZExtendedOff : _ GOTO 20155 _ ELSE ZExtendedOff = (ZWasA > 2) : _ GOTO 20155 CALL AllCaps(ZWasZ$) ZFileNameHold$ = ZWasZ$ WasA1$ = ZWasZ$ IF ZWasZ$ = ZDirPrefix$ THEN _ GOTO 20164 InFMS = ZFalse 20162 CALL CmdStackPushPop (1) ' save dir list list processing CALL FMS (ZWasZ$,SearchString$,SearchDate$,InFMS, _ ZCategoryName$(),ZCategoryCode$(),ZCategoryDesc$(),_ DnldFlag,CatFound,ZAnsIndex) WHILE DnldFlag > 0 AND ZSubParm > -1 GOSUB 20202 IF ZFileSysParm > 1 THEN _ RETURN WasX$ = ZCategoryCode$(CatFound) CALL DispUpDir (WasX$,SearchString$,SearchDate$,DnldFlag,ZAnsIndex) CALL CheckTimeRemain (MinsRemaining) IF ZSubParm = -1 THEN _ ZFileSysParm = 6 : _ RETURN CALL Carrier WEND IF ZSubParm = -1 THEN _ ZFileSysParm = 7 : _ RETURN IF ZAnsIndex > 255 THEN _ ZLastIndex = 0 : _ RETURN CALL CmdStackPushPop (2) ' restore dir list list processing ZActiveFMSDir$ = "" IF InFMS THEN _ GOTO 20159 IF ZUserSecLevel < ZMinSecToView THEN _ IF ZFileNameHold$ = ZUpldDirCheck$ THEN _ ZFileNameHold$ = "of uploads" : _ GOTO 20172 ZFileNameHold$ = ZUserIn$(ZAnsIndex) IF ZLimitSearchToFMS THEN _ GOTO 20166 IF NOT ZSearchingAll THEN _ IF ZFileNameHold$ = "ALL" OR ZFileNameHold$ = "A" THEN _ ZSearchingAll = ZTrue : _ GOSUB 21890 : _ GOTO 20157 CALL BadFile (ZFileNameHold$,BadFileNameIndex) ON BadFileNameIndex GOTO 20163,20172,20176 20163 ZFileName$ = ZFileNameHold$ CALL BadName (BadFileNameIndex,ZTrue) ' KG101201 ON BadFileNameIndex GOTO 20164,20176 20164 IF ZFileName$ = ZUpldDirCheck$ AND _ ZUserSecLevel >= ZMinSecToView THEN _ ZFileName$ = ZUpldPath$ _ ELSE ZFileName$ = ZCurDirPath$ ZFileName$ = ZFileName$ + _ ZFileNameHold$ + _ "." + _ ZDirExtension$ CALL Graphic (ZUserGraphicDefault$,ZFileName$) 20165 IF ZOK THEN _ CALL ReadDir (2,1) : _ IF ZErrCode = 0 THEN _ IF LEFT$(ZOutTxt$,4) = "\FMS" THEN _ InFMS = ZTrue : _ ZActiveFMSDir$ = ZFileName$ : _ GOTO 20162 _ ELSE GOTO 20167 20166 ZFileName$ = ZCurDirPath$ + _ ZFileNameHold$ + ".MNU" CALL FindIt (ZFileName$) IF ZOK THEN _ CALL BufFile (ZFileName$,ZAnsIndex) : _ GOTO 20155 IF ZAltdirExtension$ = "" THEN _ GOTO 20172 ZFileName$ = ZCurDirPath$ + _ ZFileNameHold$ + _ "." + _ ZAltdirExtension$ CALL Graphic (ZUserGraphicDefault$,ZFileName$) IF NOT ZOK THEN _ GOTO 20172 20167 ZUserIn$(0) = ZUserIn$(ZAnsIndex) GOSUB 20120 IF ZFileSysParm > 1 THEN _ RETURN GOTO 20170 20168 CALL BufFile(ZFileName$,ZAnsIndex) CALL Carrier IF ZSubParm = -1 THEN _ ZFileSysParm = 7 : _ RETURN 20170 IF ZAnsIndex > 255 THEN _ ZLastIndex = 0 : _ RETURN ZUserIn$(ZAnsIndex) = ZUserIn$(0) GOTO 20159 20172 IF NOT ZSearchingAll THEN _ ZOutTxt$ = "Directory " + _ ZFileNameHold$ + _ " not found!" : _ GOSUB 21640 : _ ZNo = ZTrue : _ IF ZFileSysParm > 1 THEN _ RETURN GOTO 20155 20176 CALL SecViolation IF ZDenyAccess THEN _ ZFileSysParm = 4 : _ RETURN GOTO 20172 ' ' * D - COMMAND FROM FILES MENU (SEARCH FOR FILE TO DOWNLOAD) ' 20180 ZOutTxt$ = "Download what file(s)" ZStackC = ZTrue GOSUB 21668 IF ZFileSysParm > 1 THEN _ RETURN IF ZWasQ = 0 THEN _ RETURN 20202 IF (ZTimeLock AND 2) AND (NOT TimeLockExempt) AND NOT ZHasPrivDoor THEN _ CALL TimeLock : _ IF NOT ZOK THEN _ RETURN LastDnld = ZLastIndex FirstDnld = ZAnsIndex ZCmdTransfer$ = "" IF ZAutoDownYes THEN _ ZCmdTransfer$ = "X" ZAutoDownInProgress = ZAutoDownYes ZAnsIndex = ZLastIndex GOSUB 20470 LastDnld = LastDnld + (WasX > 0) BatchBytes# = 0 BatchBlocks# = 0 ZDownFiles = 0 CALL KillWork (ZNodeWorkFile$) ZErrCode = 0 FOR ZAnsIndex = FirstDnld TO LastDnld GOSUB 20470 GOSUB 20205 ZCmdTransfer$ = ZWasFT$ CALL Line25 IF ZFileSysParm > 1 OR ZInternalProt$ = "N" THEN _ ZAnsIndex = LastDnld + 1 20203 NEXT ZLastIndex = 0 IF ZFileSysParm > 1 THEN _ RETURN ZBatchTransfer = ZFalse ZCmdTransfer$ = "" RETURN 20205 MarkingTime = (ZAnsIndex = FirstDnld OR NOT ZConcatFIles) ZFileName$ = ZUserIn$(ZAnsIndex) CALL Remove (ZFileName$,", ") ZViolation$ = "Download " IF PersonalDnld THEN _ CALL BreakFileName (ZFileName$,DR$,ZWasY$,WasX$,ZTrue) : _ ZFileNameHold$ = ZWasY$ + _ WasX$ : _ GOTO 20235 ZFileNameHold$ = ZFileName$ CALL BadFile (ZFileName$,BadFileNameIndex) ON BadFileNameIndex GOTO 20220,20231,20233 20220 IF INSTR (ZFileName$,".") = 0 THEN _ FileNameAlt$ = ZFileName$ : _ ZFileName$ = ZFileName$ + "." + ZDefaultExtension$ : _ ZFileNameHold$ = ZFileNameHold$ + "." + ZDefaultExtension$ _ ELSE FileNameAlt$ = "" 20222 CALL RotorsDir (ZFileName$,ZSubDir$(),ZSubDirCount + _ ((ZUserSecLevel < ZMinSecToView) OR _ NOT ZCanDnldFromUp),MarkingTime,"D") ' KG022204 20225 IF ZOK THEN _ GOTO 20235 IF ZDotFlag THEN _ RETURN IF FileNameAlt$ <> "" THEN _ ZFileName$ = FileNameAlt$ : _ FileNameAlt$ = "" : _ ZFileNameHold$ = ZFileName$ : _ GOTO 20222 20231 ZOutTxt$ = ZFileNameHold$ + _ " not found!" CALL UpdtCalr (ZOutTxt$,2) IF ZAutoDownInProgress THEN _ ZOutTxt$ = ZOutTxt$ + _ " during AUTODOWNLOAD" : _ GOSUB 21640 : _ RETURN ZOutTxt$ = ZOutTxt$ + _ " Correct name"+ZPressEnterExpert$ ZSuspendAutoLogoff = ZTrue GOSUB 21660 ZSuspendAutoLogoff = ZFalse IF ZFileSysParm > 1 THEN _ RETURN IF ZWasQ=0 THEN _ IF ZBatchTransfer AND ZAnsIndex >= LastDnld THEN _ GOTO 20262 _ ELSE ZAutoLogOffReq = ZFalse : _ RETURN ZUserIn$(ZAnsIndex) = ZUserIn$(1) GOTO 20205 20233 CALL SecViolation IF ZDenyAccess THEN _ ZFileSysParm = 4 : _ RETURN GOTO 20231 20235 CALL BadName (BadFileNameIndex,ZTrue) ' KG101201 ON BadFileNameIndex GOTO 20236,20245 20236 ZLine25$ = "(D) " + _ ZWasZ$ IF ZAutoDownInProgress THEN _ MID$(ZLine25$,2,1) = "A" ' ' * TEST FOR DOWNLOAD SECURITY ' CALL OpenWork (2,ZFileSecFile$) IF ZErrCode = 53 THEN _ CALL UpdtCalr ("Missing file " + ZFileSecFile$,2) : _ GOTO 20247 20242 IF EOF(2) THEN _ GOTO 20247 CALL ReadParms (ZWorkAra$(),3,1) IF ZErrCode <> 0 THEN _ ZWasEL = 20242 : _ GOTO 21900 20243 CALL WildFile (ZWorkAra$(1),ZWasZ$,ZOK) IF NOT ZOK THEN _ GOTO 20242 20244 IF ZUserSecLevel < VAL(ZWorkAra$(2)) THEN _ GOTO 20245 FilePswd$ = ZWorkAra$(3) IF FilePswd$ = "" THEN _ GOTO 20247 CALL AllCaps (FilePswd$) IF FilePswd$ = ZPswd$ THEN _ GOTO 20247 ZOutTxt$ = "Enter PASSWORD to download " + _ ZFileName$ GOSUB 21660 IF ZFileSysParm > 1 THEN _ RETURN IF ZWasQ = 0 THEN _ RETURN CALL AllCaps (ZUserIn$(1)) IF ZUserIn$(1) = FilePswd$ THEN _ GOTO 20247 20245 ZViolation$ = "DownLoad " + _ ZFileName$ 20246 CALL SecViolation IF ZDenyAccess THEN _ ZFileSysParm = 4 RETURN 20247 ZWasDF = 0 CALL BreakFileName (ZFileName$,DR$,WasX$,Extension$,ZFalse) IF ZAutoDownInProgress THEN _ ZUserIn$(ZAnsIndex) = WasX$ + "." + Extension$ : _ ' RH022501 ZOutTxt$ = "Transferring -- " + _ ZUserIn$(ZAnsIndex) : _ ' RH022501 GOSUB 21640 : _ IF ZFileSysParm > 1 THEN _ RETURN IF INSTR("...WRK.FW .ARC.EXE.COM.OBJ.WKS.LBR.ZIP.PAK.ZOO.LZH.","."+Extension$+".") > 2 OR _ MID$(Extension$,2,1) = "Q" OR _ (ZRequireNonASCII AND Extension$ = "BAS") THEN _ ZWasDF = ZTrue 20248 ZOutTxt$ = "" IF ZBatchTransfer THEN _ IF ZAnsIndex < LastDnld THEN _ GOTO 20260 CALL XferType (2,ZTrue) IF ZFF THEN _ GOTO 20260 CALL XferType (1,ZTrue) IF ZSubParm = -1 THEN _ ZFileSysParm = 7 : _ RETURN 20260 ZTransferFunction = 1 GOSUB 21790 IF ZFileSysParm > 1 THEN _ RETURN ZBatchTransfer = (ZBatchProto AND (LastDnld > FirstDnld)) IF ZBatchTransfer AND ZCmdTransfer$ = "" THEN _ ZCmdTransfer$ = ZWasFT$ ON INSTR("AXCYN",ZInternalProt$) GOTO _ 20340, _ ' ASCII DOWNLOAD 20290, _ ' Xmodem 20290, _ ' Xmodem CRC 20270, _ ' YMODEM 21700 ' NONE - CANCEL ' ' * EXTERNAL Protocol Downloads/Uploads ' 20261 IF ZReq8Bit THEN _ IF NOT ZEightBit THEN _ GOSUB 20318 : _ IF ZFileSysParm > 1 THEN _ RETURN _ ELSE GOSUB 20992 : _ IF ZFileSysParm > 1 THEN _ RETURN IF ZTransferFunction = 1 THEN _ GOSUB 20750 : _ CLOSE 2 : _ IF ZFileSysParm > 1 OR NOT ZOK THEN _ RETURN 20262 IF ZBatchTransfer THEN _ IF ZAnsIndex < LastDnld THEN _ RETURN _ ELSE ZBlocksInFile# = BatchBlocks# : _ ZBytesInFile# = BatchBytes# : _ ZNumDnldBytes! = BatchBytes# : _ IF ZBytesInFile# < 1 THEN _ RETURN _ ELSE GOSUB 20780 : _ IF ZFileSysParm > 1 OR NOT ZOK THEN _ RETURN IF ZAutoDownInProgress THEN _ CALL SendName : _ IF ZAbort THEN _ DnldCompleted = ZFalse : _ GOSUB 21760 : _ RETURN GOSUB 20337 ' XX081401 CALL Transfer 20263 IF ZPrivateDoor THEN _ ZCmdTransfer$ = ZWasFT$ : _ CALL XferType (2,ZTrue) : _ ZCmdTransfer$ = "" CALL OpenWork (2,"XFER-" + ZNodeID$ + ".DEF") IF ZErrCode <> 0 THEN _ GOTO 20267 CALL ReadParms (ZWorkAra$(), ZFailureParm, 1) IF ZErrCode <> 0 THEN _ GOTO 20267 CLOSE 2 ' KG040902 CALL KillWork ("XFER-" + ZNodeID$ + ".DEF") 20264 IF ZPrivateDoor THEN _ ZFileName$ = ZWorkAra$(1) : _ CALL BreakFileName (ZFileName$,WasX$,ZFileNameHold$,ZWasY$,ZTrue) : _ ZFileNameHold$ = ZFileNameHold$ + _ ZWasY$ IF LEFT$(ZWorkAra$(ZFailureParm),1) = "L" THEN _ MID$(ZWorkAra$(ZFailureParm),1,1) = ZFailureString$ 20265 IF ZTransferFunction = 2 THEN _ IF INSTR(ZWorkAra$(ZFailureParm),ZFailureString$) <> 1 THEN _ GOTO 20700 _ ELSE GOTO 20730 IF ZTransferFunction = 1 THEN _ DnldCompleted = (INSTR(ZWorkAra$(ZFailureParm),ZFailureString$) <> 1) GOSUB 21760 CALL Carrier IF ZSubParm = -1 THEN _ ZFileSysParm = 7 RETURN ' ' * XFER FILE NOT Found ' 20267 ZWasEL = 20263 GOTO 21900 ' ' * YMODEM DOWNLOAD DRIVER ' 20270 GOTO 20292 ' ' * Xmodem DOWNLOAD DRIVER ' 20290 ' 20292 GOSUB 20750 IF ZFileSysParm > 1 OR NOT ZOK THEN _ RETURN WasA1$ = "SEND" GOSUB 20320 IF ZFileSysParm > 1 THEN _ RETURN IF ZLocalUser THEN _ CALL QuickTPut1 ("Protocol not available in local mode") : _ RETURN IF ZAutoDownInProgress THEN _ GOSUB 20294 : _ IF ZAbort THEN _ RETURN GOSUB 21300 IF ZFileSysParm > 1 THEN _ RETURN ZOutTxt$ = "" GOTO 20390 20294 CALL SendName RETURN 20318 ZOutTxt$ = "Please Switch to N,8,1 for binary transfer" GOSUB 21630 IF ZFileSysParm > 1 THEN _ RETURN CALL DelayTime (3) RETURN 20320 IF NOT ZEightBit THEN _ GOSUB 20318 : _ IF ZFileSysParm > 1 THEN _ RETURN 20325 IF ZCheckSum THEN _ ZNAK$ = CHR$(21) : _ SOL = 132 _ ELSE ZNAK$ = "C" : _ SOL = 133 20330 IF ZAutoDownInProgress THEN _ RETURN GOSUB 20337 ' KG032801 ZOutTxt$ = ZProtoPrompt$ + _ " " + WasA1$ + _ " of " + _ ZFileNameHold$ + _ " ready. aborts" GOSUB 21650 20335 IF ZTransferFunction = 1 THEN _ CALL Talk (8,ZOutTxt$) _ ELSE CALL Talk (9,ZOutTxt$) RETURN 20337 IF ZProtoMacro$ <> "" THEN _ ' KG032801 ZGSRAra$(1) = MID$("DU ",ZTransferFunction,1) : _ ' KG032801 CALL MacroExe (ZProtoMacro$) ' KG032801 RETURN ' KG032801 ' ' * ASCII DOWNLOAD DRIVER ' 20340 IF ZWasDF THEN _ ZOutTxt$ = "Switch to a non-ascii protocol" : _ GOSUB 21650 : _ GOTO 21700 GOSUB 20750 IF ZFileSysParm > 1 OR NOT ZOK THEN _ RETURN CALL OpenWork (2,ZFileName$) IF (ZAnsIndex = FirstDnld OR NOT ZConcatFIles) THEN _ GOSUB 20337 : _ ' KG032801 ZOutTxt$ = "^X aborts. ^S suspends ^Q resumes" : _ GOSUB 21640 : _ IF ZFileSysParm > 1 THEN _ RETURN _ ELSE ZOutTxt$ = ZProtoPrompt$ + " SEND of " + _ ZFileNameHold$ + _ " ready. Press Any Key to start" : _ ZTurboKey = 2 : _ ZForceKeyboard = ZTrue : _ ZSuspendAutologoff = ZTrue : _ GOSUB 21660 : _ ZSuspendAutologoff = ZFalse : _ GOSUB 20335 : _ IF ZFileSysParm > 1 THEN _ RETURN 20380 ZStopInterrupts = ZFalse WasTU = 0 SWAP WasTU,ZPageLength CALL BufFile (ZFileName$,WasX) SWAP WasTU,ZPageLength ZNonStop = (ZPageLength < 1) IF StopFile THEN _ DnldCompleted = ZFalse : _ GOTO 20390 20381 IF (ZAnsIndex = LastDnld OR NOT ZConcatFIles) THEN _ CALL QuickTPut (CHR$(26),0) : _ IF NOT ZLocalUser AND ZSubParm = 0 THEN _ FOR WasX = 1 TO 5 : _ CALL PutCom (CHR$(7)) : _ CALL DelayTime (3) : _ NEXT 20385 DnldCompleted = ZTrue 20390 GOTO 21760 ' ' * U - COMMAND FROM FILES MENU (UPLOAD) ' 20395 GOSUB 21640 IF ZFileSysParm > 1 THEN _ RETURN ZOutTxt$ = "Correct name of file to upload" + _ ZPressEnterExpert$ GOSUB 21660 IF ZFileSysParm > 1 THEN _ RETURN IF ZWasQ = 0 THEN _ RETURN ZUserIn$(ZAnsIndex) = ZUserIn$(1) GOTO 20435 20400 CALL TimeBack (1) GOSUB 20420 ZAutoLogOffReq = 0 FirstUpld = ZAnsIndex GOTO 20430 20420 ZOutTxt$ = "Upload what file(s)" ZStackC = ZTrue GOSUB 21668 RETURN ' ' * SEARCH FOR DUPLICATE FILENAME ' 20430 ZAnsIndex = ZLastIndex GOSUB 20470 ZLastIndex = ZLastIndex + (WasX > 0) LastUpld = ZLastIndex ' KG072702 20432 FOR ZAnsIndex = FirstUpld TO LastUpld ' KG072702 GOSUB 20470 GOSUB 20435 FirstUpld = FirstUpld + 1 ' KG072702 IF ZFileSysParm > 1 THEN _ ZAnsIndex = LastUpld + 1 ' KG072702 NEXT ZCmdTransfer$ = "" RETURN 20435 ZFileNameHold$ = ZUserIn$(ZAnsIndex) ExtSrch = ZFalse ' ML080601 IF INSTR(ZFileNameHold$,".") = 0 THEN _ ZFileNameHold$ = ZFileNameHold$ + "." + ZDefaultExtension$ CALL AllCaps(ZFileNameHold$) ZFileName$ = ZFileNameHold$ ZViolation$ = "Upload " CALL NoPath (ZFileName$,BadFileNameIndex) IF BadFileNameIndex THEN _ GOTO 20451 CALL BadFile (ZFileName$,BadFileNameIndex) ON BadFileNameIndex GOTO 20440,20451,20515 20440 CALL RotorsDir (ZFileName$,ZSubDir$(),ZSubDirCount,ZTrue,"U") ' KG022204 20445 IF ZOK THEN _ GOTO 20452 IF INSTR(ZFileName$,".") = 0 THEN _ GOTO 20475 CALL BreakFileName (ZFileName$,DR$,WasX$,Extension$,ZFalse) WasI = 1 20447 WasJ = INSTR(MID$(ZCompressedExt$+". ",WasI),".") IF WasJ = 0 THEN _ GOTO 20475 Check$ = MID$(ZCompressedExt$,WasI,WasJ-1) WasI = WasI + WasJ 20450 IF Extension$ <> Check$ THEN _ CALL RotorsDir (WasX$ + "." + Check$,ZSubDir$(),ZSubDirCount,ZTrue,"U") : _ ' KG021802 IF ZOK THEN _ ExtSrch = ZTrue : _ ' ML080601 GOTO 20452 GOTO 20447 20451 ZOutTxt$ = "Invalid file name <" + ZFileName$ + ">" GOTO 20395 20452 IF ZUserSecLevel < ZOverWriteSecLevel THEN _ GOTO 20453 IF ExtSrch AND (WasX$ + "." + Check$) <> ZFileName$ THEN _ ' ML080601 ZOutTxt$ = WasX$ + "." + Check$ + " already here, " + _ ' ML080601 "upload anyway (Y,[N])" _ ' ML080601 ELSE ZOutTxt$ = "Overwrite file (Y,[N])" ' ML080601 GOSUB 21660 IF ZFileSysParm > 1 THEN _ RETURN IF NOT ZYes THEN _ GOTO 20453 ZWasZ$ = ZFileName$ CALL KillWork (ZFileName$) IF ZErrCode <> 0 AND ZErrCode <> 53 THEN _ ' ML080601 ZOutTxt$ = "Unable to overwrite" : _ ' ML080601 GOSUB 21660 : _ ' ML080601 RETURN ' ML080601 GOTO 20475 20453 CLOSE 2 IF ZUserSecLevel >= ZAddDirSecurity THEN _ GOTO 20455 20454 CALL QuickTPut1 ("Thanks, but we already have " + ZFileNameHold$) CALL UpdtCalr ("Upload duplicate " + ZFileNameHold$,1) RETURN 20455 ZOutTxt$ = "Add new directory entry (Y,[N])" ZTurboKey = - ZTurboKeyUser GOSUB 21660 IF ZFileSysParm > 1 THEN _ RETURN IF NOT ZYes THEN _ RETURN AddingDescOnly = ZTrue ZWasFT$ = "l" GOSUB 20702 RETURN 20470 ' *** CHECK FOR Protocol IN FILE LIST *** ZWasZ$ = ZUserIn$(ZAnsIndex) CALL AllCaps(ZWasZ$) WasX = 0 IF LEN (ZWasZ$) = 1 THEN _ WasX = INSTR(ZDefaultXfer$,ZWasZ$) : _ IF WasX > 0 THEN _ ZAnsIndex = ZAnsIndex + 1 : _ ZCmdTransfer$ = ZWasZ$ : _ ZAutoDownInProgress = ZFalse : _ IF MID$(ZInternalEquiv$,WasX,1) = "N" THEN _ ZCmdTransfer$ = "" RETURN 20475 ZWasZ$ = ZUpldDriveFile$ CALL FindFree IF VAL(ZFreeSpace$) < 4096 THEN _ CALL QuickTPut1 ("No room for uploads. Try tomorrow.") : _ ZAnsIndex = ZLastIndex + 1 : _ RETURN ZOutTxt$ = "Upload disk has" + _ ZFreeSpace$ GOSUB 21640 IF ZFileSysParm > 1 THEN _ RETURN ZLine25$ = "(U) " + _ ZFileNameHold$ ZSubParm = 2 CALL Line25 ZOutTxt$ = "" ZOK = ZTrue 20477 CALL XferType (2,ZTrue) IF ZFF THEN _ GOTO 20500 CALL XferType (1,ZTrue) IF ZSubParm = -1 THEN _ ZFileSysParm = 7 : _ RETURN 20500 ZTransferFunction = 2 ZAutoDownInProgress = ZFalse GOSUB 21790 IF ZFileSysParm > 1 THEN _ RETURN ON INSTR("AXCYN",ZInternalProt$) GOTO _ 20560, _ ' ASCII UPLOAD 20542, _ ' Xmodem 20542, _ ' Xmodem CRC 20542, _ ' YMODEM 20735 ' NONE - CANCEL GOTO 20261 20510 WasD$ = " by SYSOP aborts" GOSUB 21710 RETURN 20515 CALL SecViolation IF ZDenyAccess THEN _ ZFileSysParm = 4 : _ RETURN GOTO 20420 ' ' * Xmodem/YMODEM UPLOAD DRIVER ' 20542 WasA1$ = "RECEIVE" GOSUB 20320 IF ZFileSysParm > 1 THEN _ RETURN ZOK = ZTrue GOSUB 20860 IF ZFileSysParm > 1 THEN _ RETURN IF ZOK THEN _ GOTO 20700 GOTO 20730 ' ' * ASCII UPLOAD ' 20560 LineACK = (ZDefaultLineACK$ <> "") IF LineACK THEN _ ZOutTxt$ = "Acknowledge each line ([Y],N)" : _ ZTurboKey = - ZTurboKeyUser : _ LineACK = NOT ZNo : _ GOSUB 21660 : _ IF ZFileSysParm > 1 THEN _ RETURN GOSUB 20337 ' KG032801 CALL QuickTPut1 ("Transfer MUST end with a ") CALL QuickTPut1 (ZProtoPrompt$+" RECEIVE of " + ZFileNameHold$ + " ready") ZOK = ZFalse XOff = ZFalse CALL OpenOutW(ZFileName$) IF ZErrCode <> 0 AND ZErrCode <> 53 THEN _ ZWasEL = 20560 : _ GOTO 21900 GOSUB 20510 IF ZFileSysParm > 1 THEN _ RETURN 20600 CALL EofComm (Char) WHILE Char <> -1 CALL Carrier IF ZSubParm = -1 THEN _ ZFileSysParm = 7 : _ RETURN IF NOT ZFossil THEN _ IF LOF(3) < 512 THEN _ CALL PutCom(ZXOff$) : _ XOff = ZTrue 20610 CALL FlushCom (WasX$) IF ZSubParm = -1 THEN _ ZFileSysParm = 7 : _ RETURN IF INSTR(WasX$,CHR$(11)) THEN _ GOTO 20650 ZOK = ZTrue 20620 CALL PrintWork (WasX$) IF LineACK THEN _ IF INSTR(WasX$,CHR$(10)) > 0 THEN _ CALL PutCom (ZDefaultLineACK$) IF ZErrCode <> 0 THEN _ ZWasEL = 20620 : _ GOTO 21900 WasD$ = WasX$ NumReturns = 0 GOSUB 21720 IF ZFileSysParm > 1 THEN _ RETURN 20621 CALL FindFKey IF ZSubParm < 0 THEN _ ZFileSysParm = 2 : _ RETURN IF ZKeyPressed$ = ZEscape$ THEN _ GOTO 20745 IF NOT ZOK THEN _ GOTO 20670 CALL EofComm (Char) 20630 WEND CALL Carrier IF ZSubParm = -1 THEN _ ZFileSysParm = 7 : _ RETURN IF XOff THEN _ XOff = ZFalse : _ CALL PutCom (ZXOn$) : _ IF ZErrCode <> 0 THEN _ ZWasEL = 20630 : _ GOTO 21900 GOTO 20600 20650 WasX = INSTR(WasX$,CHR$(11)) IF WasX = 1 THEN _ IF NOT ZOK THEN _ GOTO 20730 _ ELSE GOTO 20700 CALL PrintWorkA (LEFT$(WasX$,WasX-1)) IF ZErrCode <> 0 THEN _ ZWasEL = 20650 : _ GOTO 21900 GOTO 20700 20670 ZOutTxt$ = ZXOff$ + _ "System error! Upload aborted continues" 20675 GOSUB 21650 IF ZFileSysParm > 1 THEN _ RETURN CALL DelayTime (3) CALL PutCom(ZXOn$) 20680 CALL EofComm (Char) WHILE Char <> -1 CALL FlushCom(WasX$) IF INSTR(WasX$,CHR$(11)) THEN _ GOTO 20730 20685 CALL Carrier IF ZSubParm = -1 THEN _ ZFileSysParm = 7 : _ RETURN CALL EofComm (Char) WEND GOTO 20680 ' ' * UPDATE UPLOAD DIRECTORY ' 20700 GOSUB 21780 IF ZFileSysParm > 1 THEN _ RETURN 20702 CALL UpdtUpload (ZCategoryName$(),ZCategoryCode$(), ZLinesInMsg) ZPrivateDoor = ZFalse IF NOT ZGetExtDesc THEN _ GOTO 20710 ZMsgHeader$ = "Extended Description for " + ZFileNameHold$ ZSysopComment = ZTrue ZMaxMsgLines = ZMaxExtendedLines WasLL = ZRightMargin ZRightMargin = 30 + ZMaxDescLen ZFileSysParm = 5 RETURN 20705 ZMaxMsgLines = ZMaxMsgLinesDef ZRightMargin = WasLL GOSUB 20702 ' KG072702 GOTO 20432 ' KG072702 20710 AddingDescOnly = ZFalse IF ZBytesInFile# > 0.0 THEN _ GOTO 21770 20730 GOSUB 21780 CALL QuickTPut1 ("Upload aborted") ZPrivateDoor = ZFalse 20735 CALL KillWork (ZFileName$) IF ZErrCode <>0 THEN _ ZWasEL = 20736 : _ GOTO 21900 ZAnsIndex = ZLastIndex + 1 ' KG031501 ZLastIndex = 0 RETURN ' ' * Sysop ABORTED UPLOAD ' 20745 ZOutTxt$ = ZXOff$ + _ "SYSOP aborted upload. Stop transfer. continues" ' KG081701 GOTO 20675 ' ' * CALCULATE DOWNLOAD TIME ESTIMATE ' 20750 ZStartOfHeader$ = CHR$(1 - (ZInternalProt$ = "Y")) CALL OpenRSeq (ZFileName$,MaxBlock,ZWasDF,ZFLen) 20760 IF ZErrCode <> 0 THEN _ CALL QuickTPut1 ("Unable to access "+ZFileNameHold$) : _ CALL UpdtCalr ("Unable to access "+ZFileName$,2) : _ ZOK = ZFalse : _ ZErrCode = 0 : _ ZBytesInFile# = 0 : _ RETURN ZBytesInFile# = LOF(2) ZNumDnldBytes! = LOF(2) ZOK = ZTrue IF SizeOnly THEN _ SizeOnly = ZFalse : _ RETURN ZBlocksInFile# = MaxBlock IF ZBatchTransfer THEN _ Temp# = BatchBlocks# + ZBlocksInFile# : _ CALL CheckTimeRemain (MinsRemaining) : _ IF (NOT PersonalDnld) AND _ (INT(Temp# / 60) + 1 > MinsRemaining) THEN _ CALL QuickTPut1 ("Omitting " + ZFileNameHold$ + ". Insufficient time") : _ ZAutoLogoffReq = ZFalse : _ ' KG073001 RETURN _ ELSE BatchBlocks# = Temp# : _ BatchBytes# = BatchBytes# + ZBytesInFile# : _ CALL OpenWorkA (ZNodeWorkFile$) : _ CALL PrintWorkA (ZFileName$) : _ ZDownFiles = ZDownFiles + 1 : _ RETURN ZDownFiles = 1 20780 ZOutTxt$ = "File Size :" ZOK = ZTrue IF ZBlockSize > 0 THEN _ ZOutTxt$ = ZOutTxt$ + _ STR$(FIX(ZBlocksInFile#)) + _ " blocks " 20785 ZBlocksInFile# = ZBlocksInFile# / _ VAL(MID$("00000300045012002400480096019203840", -4 * ZBPS, 4)) ZBlocksInFile# = ZBlocksInFile# * ZFLen / ZSpeedFactor! IF (ZAnsIndex > 1 AND ZConcatFIles) THEN _ RETURN ZOutTxt$ = ZOutTxt$ + _ STR$(ZBytesInFile#) + _ " bytes" GOSUB 21650 IF ZFileSysParm > 1 THEN _ RETURN IF ZBytesInFile# < 1 THEN _ RETURN 20790 ZSubParm = 2 CALL Line25 ZOutTxt$ = "Transfer Time:" + _ STR$(INT(ZBlocksInFile# / 60)) + _ " min," + _ STR$(INT(ZBlocksInFile# - (INT(ZBlocksInFile# / 60) * 60))) + _ " sec (approx)" GOSUB 21650 IF ZFileSysParm > 1 THEN _ RETURN 20791 IF PersonalDnld THEN _ RETURN CALL CheckTimeRemain (MinsRemaining) IF ZSubParm = -1 THEN _ ZFileSysParm = 6 : _ RETURN ZOK = ZTrue IF (INT(ZBlocksInFile# / 60) + 1) > MinsRemaining THEN _ ZOutTxt$ = "Not enough time left!" : _ CALL UpdtCalr (ZFileName$ + " " + ZOutTxt$,2) : _ CALL QuickTPut1 (ZOutTxt$): _ ZOutTxt$ = "" : _ ZOK = ZFalse : _ ZAutoLogoffReq = ZFalse : _ RETURN IF ZRatioRestrict# > 0 THEN _ CALL QuickTPut1 ("New statistics will be") : _ CALL CheckRatio (ZTrue) RETURN 20810 ZDelay! = TIMER + 6 20840 CALL EofComm (Char) IF Char = -1 THEN _ GOTO 20850 CALL FlushCom(ZWasY$) RETURN 20850 CALL CheckTime (ZDelay!, TempElapsed!, 1) IF TempElapsed! > 0 THEN GOTO 20840 20851 ZWasY$ = "" CALL CheckCarrier IF ZSubParm = -1 THEN _ ZFileSysParm = 7 : _ RETURN RETURN ' ' * Xmodem/YMODEM UPLOAD ' 20860 GOSUB 20992 IF ZFileSysParm > 1 THEN _ RETURN IF NOT ZEightBit THEN _ GOSUB 21280 : _ IF ZFileSysParm > 1 THEN _ RETURN 20900 WasX$ = "" Sec = 1 'CALL OpenOutW (ZFileName$) IF ZFLen > ZWriteBufDef THEN _ WriteBuf = ZFLen _ ELSE WriteBuf = ZWriteBufDef CALL OpenRSeq (ZFileName$,WasY,ZWasDF,WriteBuf) IF ZErrCode <> 0 AND ZErrCode <> 53 THEN _ ZWasEL = 20900 : _ GOTO 21900 FIELD #2, WriteBuf AS ZUpldRec$ RecsWrit = 0 NumInBuff = 0 TransferAbort! = TIMER + ZWaitBeforeDisconnect Year$ = " " + _ CHR$(1) + _ CHR$(2) + _ ZEndTransmission$ + _ ZCancel$ 20903 CALL PutCom (ZNAK$) 20920 WasX = 1 20922 CALL CheckCarrier IF ZSubParm = -1 THEN _ ZFileSysParm = 7 : _ RETURN CALL FindFKey IF ZKeyPressed$ = ZEscape$ THEN _ GOSUB 20510 :_ IF ZFileSysParm > 1 THEN _ RETURN _ ELSE GOTO 21240 GOSUB 20810 IF ZFileSysParm > 1 THEN _ RETURN 20930 WasJ = INSTR(Year$,LEFT$(ZWasY$,1)) ON WasJ GOTO 20960,20999,20999,21220,21230 20960 IF ZWasY$ <> "" THEN _ GOSUB 21280 : _ IF ZFileSysParm > 1 THEN _ RETURN _ ELSE CALL CheckTime (TransferAbort!,TempElapsed!,1) : _ ON ZSubParm GOTO 20920,21230 20970 WasX = WasX + 1 CALL DelayTime (1) CALL PutCom (ZNAK$) IF WasX < 6 THEN _ GOTO 20922 WasD$ = "Upload Timeout" GOSUB 21710 IF ZFileSysParm > 1 THEN _ RETURN CALL CheckTime (TransferAbort!,TempElapsed!,1) ON ZSubParm GOTO 20990,21230 20990 GOTO 20920 ' ' * CHANGE TO 8 BIT FOR Xmodem ' 20992 GOSUB 20510 IF ZFileSysParm > 1 THEN _ ZFileSysParm = 2 : _ RETURN IF NOT ZEightBit THEN _ PrevLineCntl = INP (ZLineCntlReg) : _ CALL DelayTime (3) : _ SwitchToEight = ZTrue : _ OUT ZLineCntlReg,3 20996 WasSO = 0 RETURN ' ' * EXPECTED BLOCK LENGTH. 132 FOR CheckSum, 133 FOR CRC, 1029 FOR YMODEM ' 20999 SOL = 896 * WasJ - 1659 + ZCheckSum DataSol = 128 - (SOL > 1024)*896 GOTO 21020 ' ' * Xmodem/YMODEM UPLOAD ' 21000 GOSUB 20810 IF ZFileSysParm > 1 THEN _ RETURN IF ZWasY$ = "" THEN _ WasD$ = "Upload Timeout" : _ GOSUB 21710 : _ IF ZFileSysParm > 1 THEN _ RETURN _ ELSE GOTO 21040 21020 WasX$ = WasX$ + _ ZWasY$ IF LEN(WasX$) < SOL THEN _ GOTO 21000 21040 IF LEN(WasX$) = SOL THEN _ GOTO 21090 21050 IF LEN(WasX$) > SOL THEN _ GOTO 21180 21060 IF WasX$ = ZEndTransmission$ THEN _ GOTO 21220 21070 IF WasX$ = ZCancel$ THEN _ GOTO 21230 21080 GOTO 21170 21090 WasJX = ASC(MID$(WasX$,2,1)) IF Sec = WasJX THEN _ GOTO 21100 GOTO 21200 21100 IF (Sec XOR 255) <> ASC(MID$(WasX$,3,1)) THEN _ GOTO 21210 21110 IF ZCheckSum THEN _ WasWK$ = MID$(WasX$,4,128) : _ GOSUB 21750 : _ IF ZFileSysParm > 1 THEN _ RETURN _ ELSE IF XmodemChecksum <> ASC(MID$(WasX$,132,1)) THEN _ GOTO 21190 _ ELSE GOTO 21120 WasWK$ = MID$(WasX$,4) GOSUB 21750 IF ZFileSysParm > 1 THEN _ RETURN 21113 IF CRCValue <> 0 THEN _ GOTO 21191 21120 WasSO = WasSO + 1 CALL PutCom (ZAcknowledge$) 21131 IF NumInBuff >= WriteBuf THEN _ NumInBuff = 0 : _ CALL PutWork (ZUpldRec$,RecsWrit,WriteBuf) : _ IF ZErrCode <> 0 THEN _ ZWasEL = 21131 : _ GOTO 21900 MID$(ZUpldRec$,NumInBuff+1,DataSol) = WasWK$ NumInBuff = NumInBuff + DataSol 21145 Sec = 255 AND (Sec + 1) CALL QuickLPrnt ("OK Rec Blk #",WasSO) 21150 WasX$ = "" XmodemChecksum = 0 TransferAbort! = TIMER + 45 GOTO 20920 21170 ZOutTxt$ = "Short Blk #" GOTO 21212 21180 ZOutTxt$ = "Long Blk #" GOTO 21212 21190 ZOutTxt$ = "Chksum Error #" GOTO 21212 21191 ZOutTxt$ = "CRC Error" GOTO 21212 21200 IF Sec < WasJX THEN _ ZOutTxt$ = "Blk # Error in #" : _ GOTO 21212 CALL PutCom (RIGHT$(ZAckChar$,1 - (WasJX = 0))) GOTO 21150 21210 ZOutTxt$ = "Complement Error in #" 21212 CALL PutCom (ZNAK$) CALL LPrnt(ZLineFeed$ + ZOutTxt$ + STR$(WasSO + 1),0) GOTO 21150 21220 IF NumInBuff < 1 THEN _ GOTO 21225 WasWK$ = LEFT$(ZUpldRec$,NumInBuff) CALL OpenRSeq (ZFileName$,MaxBlock,ZWasDF,128) FIELD #2, 128 AS ZUpldRec$ MaxBlock = CDBL(RecsWrit) * WriteBuf / 128 FOR WasI = 1 TO NumInBuff/128 CALL PutWork (MID$(WasWK$,128*WasI-127,128),MaxBlock,128) IF ZErrCode > 0 THEN _ ZWasEL = 21220 : _ GOTO 21900 NEXT CLOSE 2 21225 CALL PutCom (ZAcknowledge$) GOTO 21250 21230 WasD$ = ZLineFeed$ + _ "Transfer Aborted" GOSUB 21710 IF ZFileSysParm > 1 THEN _ RETURN 21240 CALL EofComm (Char) IF Char <> -1 THEN _ GOSUB 21280 : _ IF ZFileSysParm > 1 THEN _ RETURN _ ELSE CALL DelayTime (1) : _ GOTO 21240 CALL PutCom (ZCancel$ + ZCancel$) CALL DelayTime (1) CALL EofComm (Char) IF Char <> -1 THEN _ GOTO 21240 ZOK = ZFalse 21250 ZEightBit = ZTrue RETURN ' ' * CLEAR GARBAGE OUT OF COMMUNICATIONS BUFFER ' 21280 CALL CheckCarrier IF ZSubParm = -1 THEN _ ZFileSysParm = 7 : _ RETURN CALL EofComm (Char) IF Char = -1 THEN _ RETURN 21281 CALL FlushCom(ZWasDF$) 'IF ZSubParm = -1 THEN _ ' ZFileSysParm = 7 : _ ' RETURN GOTO 21280 ' ' * Xmodem/YMODEM DOWNLOAD ' 21300 GOSUB 20992 IF ZFileSysParm > 1 THEN _ RETURN Sec = 0 GOSUB 21280 IF ZFileSysParm > 1 THEN _ RETURN ZNAK$ = CHR$(21) TransferAbort! = TIMER + ZWaitBeforeDisconnect 21303 FIELD 2,ZFLen AS ZDnldRecord$ ' ' * ROUTINE TO START AN "Xmodem" OR "YMODEM" DOWNLOAD. CHECK'S INITIAL ' * "HANDSHAKE" TO SEE IF CHARACTER IS SENT IS A: ' * "X" = Xmodem WITH CheckSum AND 128 CHARACTER RECORDS ' * "C" = Xmodem WITH CRC CHECK AND 128 CHARACTER RECORDS ' * "Y" = YMODEM WITH CRC CHECK AND 1024 CHARACTER RECORDS ' 21350 CALL EofComm (Char) WHILE Char <> -1 21360 CALL GetCom(ZWasY$) IF ZWasY$ = ZCancel$ THEN _ GOTO 21560 21380 ZCheckSum = (ZWasY$ = ZNAK$) IF ZCheckSum THEN _ ZFF = INSTR(ZInternalEquiv$,"X") : _ IF ZFF > 0 THEN _ ZWasFT$ = MID$(ZDefaultXfer$,ZFF,1) : _ GOTO 21480 _ ELSE ZWasFT$ = "X" : _ GOTO 21480 _ ELSE IF ZWasY$ = "C" THEN _ GOTO 21480 CALL EofComm (Char) 21390 WEND GOSUB 21460 IF ZFileSysParm > 1 THEN _ RETURN IF ZKeyPressed$ = ZEscape$ THEN _ RETURN CALL CheckTime (TransferAbort!, TempElapsed!, 1) ON ZSubParm GOTO 21350,21455 21410 TransferAbort! = TIMER + ZWaitBeforeDisconnect ' ' * ROUTINE TO WAIT FOR AN ACKNOWLEDGEMENT ON AN "Xmodem" OR "YMODEM" ' * DOWNLOAD ' 21415 CALL EofComm (Char) IF Char <> -1 THEN _ GOTO 21420 GOSUB 21460 IF ZFileSysParm > 1 THEN _ RETURN IF ZKeyPressed$ = ZEscape$ THEN _ RETURN CALL CheckTime (TransferAbort!, TempElapsed!, 1) ON ZSubParm GOTO 21415,21455 21420 CALL GetCom(ZWasY$) IF ZWasY$ = ZAcknowledge$ THEN _ GOTO 21470 21440 IF ZWasY$ <> ZNAK$ THEN _ GOTO 21450 21443 WasD$ = ZLineFeed$ + _ "Error -> retrans #" + _ STR$(WasSO) GOSUB 21710 IF ZFileSysParm > 1 THEN _ RETURN 21445 WasSO = WasSO - 1 GOTO 21490 21450 IF ZWasY$ = ZCancel$ THEN _ IF HaveACancel THEN _ GOTO 21560 _ ELSE HaveACancel = ZTrue CALL CheckTime (TransferAbort!, TempElapsed!, 1) ON ZSubParm GOTO 21415,21455 21455 WasD$ = "Download timeout" GOSUB 21710 IF ZFileSysParm > 1 THEN _ RETURN GOTO 21560 21460 CALL CheckCarrier CALL FindFKey IF ZSubParm < 0 THEN _ ZFileSysParm = 7 : _ RETURN IF ZKeyPressed$ = ZEscape$ THEN _ GOTO 21540 RETURN ' ' * DISPLAY BLOCK SENT OK AND THEN READ IN NEXT RECORD FROM DISK TO DOWNLOAD ' 21470 CALL QuickLPrnt ("OK Sent Blk #",WasSO) 21480 IF LOC(2) => MaxBlock THEN _ GOTO 21530 CALL GetWork (ZFLen) IF ZErrCode <> 0 THEN _ ZWasEL = 21480 : _ GOTO 21900 Sec = 255 AND (Sec + 1) GOTO 21490 ' ' * ROUTINE TO WRITE OUT AN "Xmodem" OR "YMODEM" RECORD TO THE COMM. PORT ' 21490 WasSO = WasSO + 1 CALL PutCom (ZStartOfHeader$ + CHR$(Sec) + CHR$(Sec XOR 255)) CALL PutCom (ZDnldRecord$) HaveACancel = ZFalse 21503 WasWK$ = ZDnldRecord$ 21504 GOSUB 21750 IF ZFileSysParm > 1 THEN _ RETURN 21510 IF ZCheckSum THEN _ CALL PutCom(CHR$(XmodemChecksum)) _ ELSE CALL PutCom(CHR$(CRCHigh) + CHR$(CRCLow)) GOSUB 21280 IF ZFileSysParm > 1 THEN _ RETURN GOTO 21410 ' ' * END-OF-FILE FOR Xmodem Dnlds -- SEND THE "EOT" CHARACTER AND WAIT UP ' * TO 2 SECONDS FOR A POSITIVE RESPONSE (I.E. AN "ACK"). IF NONE IS ' * RE-TRY UP TO 10 TIMES. IF No POSITIVE RESPONSE IS RECEIVED AFTER TEN ' * Attempts, ASSUME THE DOWNLOAD WAS UNSUCCESSFULL. ' 21530 CALL PutCom (ZEndTransmission$) WasX = 1 21531 GOSUB 20810 IF ZFileSysParm > 1 THEN _ RETURN IF INSTR(ZWasY$,ZAcknowledge$) THEN _ GOTO 21550 CALL FindFKey IF ZSubParm < 0 THEN _ ZFileSysParm = 2 : _ RETURN IF ZKeyPressed$ = ZEscape$ THEN _ GOSUB 21540 : _ GOTO 21545 IF WasX < 10 THEN _ WasX = WasX + 1 : _ GOTO 21531 DnldCompleted = ZFalse GOTO 21230 21540 GOSUB 20510 IF ZFileSysParm > 1 THEN _ RETURN RETURN 21545 ZWasY$ = ZCancel$ CALL PutCom (ZCancel$ + ZCancel$ + ZCancel$) DnldCompleted = ZFalse GOTO 21250 21550 DnldCompleted = ZTrue GOTO 21250 21560 DnldCompleted = ZFalse WasD$ = ZLineFeed$ + _ "Caller aborted trans" GOSUB 21710 IF ZFileSysParm > 1 THEN _ RETURN GOTO 21545 ' ' STANDARD ENTRY FOR RBBS-PC'S COMMON TERMINAL OUTPUT ROUTINE ' ' Modeled on lines 12975 to 12983 in RBBS-PC.BAS 21630 ZSubParm = 1 GOTO 21655 21640 ZSubParm = 3 GOTO 21655 21650 ZSubParm = 5 21655 CALL TPut IF ZSubParm < 0 THEN _ ZFileSysParm = 2 : _ RETURN IF ZSubParm = 8 THEN _ GOSUB 21660 RETURN ' ' STANDARD ENTRY FOR RBBS-PC'S COMMON TERMINAL INPUT ROUTINE ' ' Modeled on lines 12995 to 12997 in RBBS-PC.BAS 21660 ZSubParm = 1 CALL TGet 21665 IF ZSubParm < 0 THEN _ ZFileSysParm = 2 RETURN 21668 CALL PopCmdStack GOTO 21665 21700 ZErrCode = 0 ZLastIndex = 0 RETURN ' ' **** COMMON LOCAL DISPLAY PRINT *** ' ' (formerly lines 1315 to 1320 in RBBS-PC.BAS 21710 NumReturns = 1 21720 CALL LPrnt (WasD$,NumReturns) RETURN ' ' * Xmodem / CRC INTERFACE ' ' (formerly line 46000 in RBBS-PC.BAS 21750 XmodemChecksum = 0 CRCValue = 0 CALL Xmodem(WasWK$,XmodemChecksum,CRCValue,CRCHigh,CRCLow) RETURN ' ' * UPDATE DOWNLOAD STATISTICS ' ' (formerly lines 50600 to 50614 in RBBS-PC.BAS 21760 GOSUB 21780 IF ZFileSysParm > 1 THEN _ RETURN IF ZBatchTransfer THEN _ CALL LinesInFile (ZNodeWorkFile$,ZDownFiles) _ ELSE ZDownFiles = 1 IF NOT DnldCompleted THEN _ ZAutoLogoffReq = ZFalse : _ ZWasDF$ = " Aborted" : _ GOTO 21768 CALL LogPDown (PersonalDnld,1+ZAnsIndex-FirstDnld) WasX = ((ZRatioRestrict# = 0) AND ZEnforceRatios) IF NOT WasX THEN _ ZDnlds = ZDnlds + ZDownFiles : _ ZGlobalDLToday! = ZGlobalDLToday! + ZDownFiles : _ ZGlobalDnlds = ZGlobalDnlds + ZDownFiles : _ ZDLBytes! = ZDLBytes! + ZNumDnldBytes! : _ ZGlobalDLBytes! = ZGlobalDLBytes! + ZNumDnldBytes! : _ ZDLToday! = ZDLToday! + ZDownFiles : _ ZBytesToday! = ZBytesToday! + ZNumDnldBytes! : _ ZGlobalBytesToday! = ZGlobalBytesToday! + ZNumDnldBytes! ZNumDnldBytes! = 0 CALL Muzak (6) ZWasDF$ = " Downloaded" IF (ZAnsIndex = LastDnld OR NOT ZConcatFIles) THEN _ CALL SkipLine (1) : _ CALL QuickTPut1 ("Download successful") : _ IF WasX THEN _ CALL QuickTPut1 ("but not counted against ratios") 21768 IF ZAutoDownInProgress THEN _ ZWasDF$ = " AUTO" + _ MID$(ZWasN$,2) IF INSTR(ZWasN$,"Aborted") THEN _ ZAutoDownInProgress = 0 ZOutTxt$ = "" 21770 CALL AMorPM IF NOT ZBatchTransfer THEN _ GOTO 21773 CALL OpenWork (2,ZNodeWorkFile$) IF ZErrCode > 0 THEN _ RETURN ZWasQ = 0 WHILE NOT EOF(2) CALL ReadAny ZWasQ = ZWasQ + 1 ZUserIn$(ZWasQ) = ZOutTxt$ WEND 21772 IF ZWasQ < 1 THEN _ ZBatchTransfer = ZFalse : _ RETURN CALL OpenWork (2,ZUserIn$(ZWasQ)) IF ZErrCode > 0 THEN _ ZErrCode = 0 : _ ZWasQ = ZWasQ - 1 : _ GOTO 21772 ZBytesInFile# = LOF(2) ZFileName$ = ZUserIn$(ZWasQ) 21773 CALL BreakFileName (ZFileName$,DR$,WasX$,Extension$,ZTrue) ZWasZ$ = WasX$ + _ Extension$ + _ ZWasDF$ + _ " at " + _ ZTime$ + _ " using " + _ ZWasFT$ + _ STR$(ZBytesInFile#) CALL UpdtCalr (ZWasZ$,2) IF ZBatchTransfer THEN _ ZWasQ = ZWasQ - 1 : _ GOTO 21772 'CALL CheckRatio (ZFalse) 21774 IF ZMenuIndex = 6 THEN _ IF DnldCompleted THEN _ ZOutTxt$ = WasX$ : _ ZSubParm = 5 : _ CALL Library RETURN ' ' ***** TURN ON INTERMEDIATE ECHO **** ' ' (formerly line 50620 in RBBS-PC.BAS 21780 IF ZEchoer$ = "I" THEN _ CALL SetEcho ("I") ' ' * RESTORE COMMUNICATIONS AFTER Switch TO 8 BIT ' ' (formerly between lines 50620 and 50630 in RBBS-PC.BAS IF SwitchToEight THEN _ IF ZSwitchBack THEN _ OUT ZLineCntlReg, PrevLineCntl : _ CALL DelayTime (3) : _ ZEightBit = ZFalse : _ SwitchToEight = ZFalse RETURN ' ' ***** TURN OFF INTERMEDIATE ECHO **** ' ' (formerly line 50630 in RBBS-PC.BAS 21790 IF ZEchoer$ = "I" THEN _ CALL SetEcho ("R") RETURN ' ' ***** DIRECTORY SEARCH **** ' ' (formerly lines 52900 to 52920 in RBBS-PC.BAS 21800 WasCK = 2 21810 ZOutTxt$ = "Search string or filename (wildcards OK), [ENTER] quits)" ' DA071701 ZMacroMin = 99 GOSUB 21668 IF ZWasQ = 0 THEN _ RETURN 21820 WasRS$ = ZUserIn$(ZAnsIndex) WildSearch = (INSTR(WasRS$,"*") > 0 OR INSTR(WasRS$,"?") > 0) CALL AllCaps (WasRS$) IF RIGHT$(WasRS$,1) = "*" THEN _ ' KG081201 IF RIGHT$(WasRS$,2) <> ".*" THEN _ ' KG081201 WasRS$ = WasRS$ + ".*" ' KG081201 SearchString$ = WasRS$ SearchDate$ = "" ZJumpSearching = ZFalse WasA1$ = WasRS$ GOTO 21867 ' ' ***** P - personal download **** ' ' (formerly lines 52950 to 52952 in RBBS-PC.BAS 21850 IF ZPersonalBegin < 1 OR ZPersonalLen < 1 THEN _ RETURN DnldFlag = 0 PersonalDnld = ZTrue 21852 CALL PersFile (MID$(ZUserRecord$,ZPersonalBegin,ZPersonalLen),_ DnldFlag) IF ZSubParm = -1 THEN _ ZFileSysParm = 7: _ RETURN IF ZLastIndex <= 0 THEN _ GOTO 21854 ZConcatFIles = ZPersonalConcat ZStopInterrupts = ZTrue TimeLockExempt = ZTrue GOSUB 20202 IF ZFileSysParm > 1 THEN _ GOTO 21854 TimeLockExempt = ZFalse ZConcatFIles = ZFalse GOTO 21852 21854 PersonalDnld = ZFalse RETURN ' ' * WasN - COMMAND FROM FILES MENU (DISPLAY NEW FILES SINCE Last DIR DISPLAY) ' ' (formerly lines 53000 to 53070 in RBBS-PC.BAS 21860 WasCK = 1 21862 WasA1$ = RIGHT$(ZWasLM$,4) +_ LEFT$(ZWasLM$,2) ZOutTxt$ = "Files on/after MMDDYY, [ENTER] = " + WasA1$ GOSUB 21668 CALL AllCaps (ZUserIn$(ZAnsIndex)) IF ZWasQ = 0 OR ZUserIn$(ZAnsIndex) = "S" THEN _ WasRS$ = ZWasLM$ : _ GOTO 21866 21865 IF LEN(ZUserIn$(ZAnsIndex)) <> 6 THEN _ GOTO 21862 WasA1$ = ZUserIn$(ZAnsIndex) WasRS$ = RIGHT$(WasA1$,2) + _ LEFT$(WasA1$,4) ListNew = ZTrue 21866 SearchDate$ = WasRS$ SearchString$ = "" ZJumpSearching = ZFalse 21867 CALL GetDirs (NOT ZExpertUser) IF ZWasQ = 0 THEN _ RETURN 21871 CALL ConvertDir (ZAnsIndex) ZListDir = ZTrue ListNew = ZTrue ZSearchingAll = ZFalse 21875 ZWasZ$ = ZUserIn$(ZAnsIndex) IF NOT ZSearchingAll THEN _ IF ZWasZ$ = "ALL" THEN _ IF NOT ZLimitSearchToFMS THEN _ GOSUB 21890 21880 WasQX = ZAnsIndex GOSUB 20157 IF ZFileSysParm > 1 THEN _ RETURN ZAnsIndex = ZAnsIndex + 1 IF ZAnsIndex <= ZLastIndex THEN _ GOTO 21875 ListNew = ZFalse SearchString$ = "" SearchDate$ = "" RETURN 21890 WasG = ZAnsIndex CALL GetAll (ZUserIn$(),WasG) ZSearchingAll = ZTrue ZLastIndex = WasG ZAnsIndex = ZAnsIndex + 1 RETURN ' ' * MAIN FILE SYSTEM ERROR TRAP - ALL ERRORS PASS THROUGH THIS ROUTINE ' ' (formerly lines 13000 to 13500 in RBBS-PC.BAS 21900 IF ZDebug THEN _ ZOutTxt$ = "RBBSSUB5 DEBUG Error Trap Entry ERL=" + _ STR$(ZWasEL) + _ " ERR=" + _ STR$(ZErrCode) : _ IF ZPrinter THEN _ CALL Printit(ZOutTxt$) _ ELSE CALL LPrnt(ZOutTxt$,1) IF ZWasEL = 20126 AND ZErrCode = 53 THEN _ GOTO 20142 IF ZWasEL = 20242 AND ZErrCode = 62 THEN _ CALL UpdtCalr (ZFileSecFile$ + " bad format!",2) : _ GOTO 20247 IF ZWasEL = 20263 THEN _ ZOutTxt$ = "" : _ DnldCompleted = ZFalse : _ GOTO 20390 ' ML080601 IF ZWasEL = 20560 AND ZErrCode = 67 THEN _ GOTO 20451 IF ZWasEL = 20560 AND ZErrCode = 70 THEN _ IF VAL(ZFreeSpace$) > 1999 THEN _ GOTO 20610 _ ELSE CALL QuickTPut1 ("No room for uploads. Try tomorrow.") : _ GOTO 21700 IF ZWasEL = 20620 THEN _ GOTO 20670 IF ZWasEL = 20650 THEN _ GOTO 20670 IF ZWasEL = 20736 AND ZErrCode = 53 THEN _ GOTO 21700 IF ZWasEL = 20900 AND ZErrCode = 75 THEN _ GOTO 21230 IF ZWasEL = 20900 AND ZErrCode = 70 THEN _ CALL QuickTPut1 ("No room for uploads. Try tomorrow.") : _ GOTO 21230 IF ZWasEL = 21131 OR ZWasEL = 21220 THEN _ ZErrCode = 0 : _ GOTO 21230 IF ZWasEL = 21480 THEN _ CALL LogError : _ IF ZErrCode = 57 THEN _ CALL QuickTPut1 ("Error reading file. Aborting download") : _ DnldCompleted = ZFalse : _ GOTO 21230 21910 CALL LogError CALL QuickTPut1 (ZCallersRecord$) ZFileSysParm = 3 RETURN 21920 ' EXIT RBBS-PC FILE SUBSYSTEM END SUB 63100 ' $SUBTITLE: 'DoorReturn - Subroutine to process requests from a door' ' $PAGE ' ' NAME -- DoorReturn ' ' INPUTS -- PARAMETER MEANING ' DOUTx.DEF File of requests ' ' OUTPUTS -- ZUserSecLevel Revised Security Level ' ' PURPOSE -- To give Doors a stable way to make requests ' to the host. ' SUB DoorReturn STATIC IF ZPrivateDoor OR NOT ZExitToDoors THEN _ EXIT SUB ZFileName$ = "DOUT" + ZNodeID$ + ".DEF" CALL FindIt (ZFileName$) IF NOT ZOK THEN _ EXIT SUB 63105 IF EOF(2) THEN _ GOTO 63195 CALL ReadParms (ZOutTxt$(),2,1) IF ZErrCode > 0 THEN _ GOTO 63115 IF LEN(ZOutTxt$(1)) < 2 THEN _ EXIT SUB ZUserIn$ = LEFT$(ZOutTxt$(1),2) + "," WasX = INSTR("SL,UR,",ZUserIn$) IF WasX = 0 THEN _ GOTO 63105 WasX = WasX\3 + 1 ON WasX GOTO 63110,63115 GOTO 63105 63110 WasX$ = LEFT$(ZOutTxt$(2),1) ' ZWasSL = Security Level CALL CheckInt (ZOutTxt$(2)) IF ZErrCode > 0 THEN _ GOTO 63105 IF WasX$ = "+" OR WasX$ = "-" THEN _ ZWasA = ZUserSecLevel + ZTestedIntValue _ ELSE ZWasA = ZTestedIntValue IF ZWasA < ZSysopSecLevel THEN _ ZAdjustedSecurity = (ZWasA <> ZUserSecLevel) : _ IF ZAdjustedSecurity THEN _ ZUserSecLevel = ZWasA : _ MID$(ZUserRecord$,47,2) = MKI$(ZWasA) : _ CALL QuickTPut1 ("Security changed to" + STR$(ZWasA)) : _ CALL UpdtCalr ("Door reset security to "+STR$(ZWasA),2) GOTO 63105 63115 IF LEN(ZOutTxt$(1)) < 7 THEN _ GOTO 63105 IF MID$(ZOutTxt$(1),3,1) <> "(" THEN _ GOTO 63105 WasX = INSTR(4,ZOutTxt$(1),":") IF WasX < 1 THEN _ GOTO 63105 CALL CheckInt (MID$(ZOutTxt$(1),4,WasX-4)) IF ZErrCode > 0 THEN _ GOTO 63105 IF ZTestedIntValue > 128 OR ZTestedIntValue < 1 THEN _ GOTO 63105 ZWasA = ZTestedIntValue CALL CheckInt (MID$(ZOutTxt$(1),WasX+1)) IF ZErrCode > 0 OR ZTestedIntValue < 1 OR ZTestedIntValue > 128 THEN _ GOTO 63105 MID$(ZUserRecord$,ZWasA,ZTestedIntValue) = LEFT$(ZOutTxt$(2) + _ SPACE$(ZTestedIntValue),ZTestedIntValue) CALL UpdtCalr ("Door set UR"+STR$(ZWasA)+":"+STR$(ZTestedIntValue)+" to <"+ZOutTxt$(2)+">",2) GOTO 63105 63195 CALL KillWork (ZFileName$) ZErrCode = 0 END SUB 63200 ' $SUBTITLE: 'WildCard -- Matches string to a pattern' ' $PAGE ' NAME -- WildCard ' ' INPUTS -- PARAMETER MEANING ' Pattern$ PATTERN TO CHECK ' Strng$ STRING TO FIE ' ' OUTPUTS -- ZOK True IF MATCH Found ' False IF No MATCH WAS Found ' ' PURPOSE Determine whether a string is an instance in a pattern ' supported patterns are only "?" which requires a ' character but can be any, and "*" which matches any- ' thing, including a null string. Anything else in a ' sting must be an exact match. Supports reverse ' wildcards. ' ' SUB WildCard (Pattern$,Strng$) STATIC 63285 ZOK = ZTrue PatPos = 0 StrPos = 0 Inc = 1 WasKT = 0 WasP = LEN(Pattern$) WasL = LEN(Strng$) 63286 PatPos = PatPos + Inc StrPos = StrPos + Inc WasKT = WasKT + 1 IF WasKT > WasL THEN _ GOTO 63288 ZUserIn$ = MID$(Pattern$,PatPos,1) IF ZUserIn$ = "*" THEN _ GOTO 63289 63287 IF ZUserIn$ <> "?" AND MID$(Strng$,StrPos,1) <> ZUserIn$ THEN _ ZOK = ZFalse : _ EXIT SUB GOTO 63286 63288 IF PatPos >= LEN(Pattern$) OR PatPos < 1 THEN _ EXIT SUB IF MID$(Pattern$,PatPos,1) <> "*" THEN _ ZOK = ZFalse : _ EXIT SUB 63289 IF PatPos <> WasP THEN _ ' Reverse search Inc = -1 : _ WasP = PatPos : _ PatPos = LEN(Pattern$) + 1 : _ StrPos = LEN(Strng$) + 1 : _ WasKT = 0 : _ GOTO 63286 END SUB 63300 ' $SUBTITLE: 'BreakFileName - sub to split file name into components' ' $PAGE ' ' NAME -- BreakFileName ' ' INPUTS -- PARAMETER MEANING ' FileSpec$ FULL NAME OF FILE ' ForJoining True IF WANT PARTS FORMATTED FOR ' FORMING FILE NAMES ' OUTPUTS -- DrvPath$ DRIVE AND PATH ' Prefix$ PREFIX OF FILE NAME ' Extension$ EXTENSION OF FILE NAME ' ' (E.G. "C:\RBBS\ARCE.COM" HAS "C:\RBBS" AS DRIVE AND PATH, ' "ARCE" AS PREFIX OF THE FILE NAME, AND ' "COM" AS THE EXTENSION OF THE FILE NAME. ' ' JOINED FORMAT IS C:\RBBS\,ARCE,.COM ' ' PURPOSE -- To break a file name into its component parts ' of drive/path, prefix, and extension ' ' SUB BreakFileName (PassedFileSpec$,DrvPath$,Prefix$,Extension$,ForJoining) STATIC ' KG081705 FileSpec$ = PassedFileSpec$ ' KG081705 CALL AllCaps (FileSpec$) DrvPath$ = "" Prefix$ = "" Extension$ = "" ' KG082301 WasL = LEN(FileSpec$) IF WasL < 1 THEN _ EXIT SUB CALL FindLast (FileSpec$,"\",WasX,WasY) IF WasX < 1 THEN _ IF MID$(FileSpec$,2,1) = ":" THEN _ DrvPath$ = LEFT$(FileSpec$,2) : _ ' DA082101 ZWasS = 3 _ ELSE ZWasS = 1 _ ELSE DrvPath$ = LEFT$(FileSpec$,WasX) : _ ' DA082101 ZWasS = WasX + 1 ' DA082101 WasX = INSTR(ZWasS,FileSpec$ + ".",".") ' EC061301 IF WasX < WasL THEN _ Extension$ = MID$(FileSpec$,WasX) ' DA082101 IF ZWasS <= WasL THEN _ IF WasX >= ZWasS THEN _ Prefix$ = MID$(FileSpec$,ZWasS,WasX - ZWasS) IF ForJoining THEN _ ' DA082101 EXIT SUB IF WasY > 1 THEN _ ' KG082301 DrvPath$ = LEFT$(DrvPath$, LEN(DrvPath$) - 1) ' DA082101 IF LEN(Extension$) > 0 THEN _ Extension$ = MID$(Extension$, 2) ' DA082101 END SUB 63310 ' $SUBTITLE: 'RestoreCom - sub to restore comm port' ' $PAGE ' ' NAME -- RestoreCom ' ' INPUTS -- none ' ' OUTPUTS -- none ' ' PURPOSE -- To restore communications port after an external ' program may have left it in altered state ' SUB RestoreCom STATIC Parity$ = MID$(",N,8,1,E,7,1",7 + 6 * ZEightBit,6) IF ZLocalUser THEN _ EXIT SUB CALL SetBaud IF NOT ZFossil THEN _ CALL OpenCom(ZTalkToModemAt$,Parity$) END SUB 63320 ' $SUBTITLE: 'ShellExit - sub to shell out from RBBS' ' $PAGE ' ' NAME -- ShellExit ' ' INPUTS -- ShellTem$ String to invoke shell with ' ' OUTPUTS -- none ' ' PURPOSE -- Delay so that strings can finish printing. Restore comm ' port on return ' SUB ShellExit (ShellTem$) STATIC CALL DelayTime (8 + ZBPS) IF NOT ZLocalUser THEN _ IF ZFossil THEN _ CALL FOSExit(ZComPort) _ ELSE CLOSE 3 : _ OUT ZModemCntlReg,INP(ZModemCntlReg) OR 1 CLOSE 2 CALL MetaGSR (ShellTem$,ZFalse) SHELL ShellTem$ IF ZFossil THEN _ IF NOT ZLocalUser THEN _ CALL FOSinit(ZComPort,Result) : _ IF Result = -1 THEN _ CALL PScrn("ERROR INIT FOSSIL AFT EXTERNAL") : _ ' KG072701 SYSTEM CALL DelayTime (2) CALL RestoreCom END SUB 63330 ' $SUBTITLE: 'ReadMacro - sub to read macro' ' $PAGE ' ' NAME -- ReadMacro ' ' INPUTS -- PARAMETER MEANING ' ' OUTPUTS -- ZOutTxt$ LINE TO PROCESS IN MACRO ' ZMacroActive FLAG WHETHER IN A MACRO ' ' PURPOSE -- Reads in a line from macro file (#6) and processes ' macro commands, which are: ' *0 - display what follows, no carriage return ' *1 - display what follows with carriage return ' *B - display block that follows ' *F - display File ' WT - wait specified # of seconds ' >> - append following block to specified file ' ST - stack following (with carriage return) ' ON - define case ' == - case value that applies to following block ' M! - execute following macro ' M@ - abort macro processing ' EY - Echo on (yes) ' EN - Echo off (no) ' /* - comment line skipped in processing ' TK - Turbo key on (if user preference) ' << - Read from file into a form ' := - Assign value to work variable ' LO - Set the location of a file ' KG022301 ' SUB ReadMacro STATIC IF ZMacroTemplate$ <> "" THEN _ GOTO 63392 IF ZDistantTGet = 2 THEN _ GOTO 63349 63336 GOSUB 63395 IF NOT ZMacroActive THEN _ ZMacroEcho = ZTrue : _ EXIT SUB ' KG042501 IF CompareVar > 0 THEN _ IF NOT CaseExecute THEN _ IF LEFT$(ZOutTxt$,3) = ZSmartTextCode$+"==" THEN _ WasX$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-3) : _ ' KG042501 GOTO 63370 _ ELSE IF LEFT$(ZOutTxt$,7) = ZSmartTextCode$ + "END ON" THEN _ CompareVar = 0 : _ GOTO 63336 _ ELSE GOTO 63336 IF LEN(ZOutTxt$) < 3 THEN _ ' KG042501 GOTO 63398 ' KG042501 WasX$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-3) ' KG042501 IF LEFT$(ZOutTxt$,1) <> ZSmartTextCode$ THEN _ GOTO 63398 CALL CheckInt (MID$(ZOutTxt$,2)) IF ZErrCode > 0 THEN _ GOTO 63398 IF ZTestedIntValue > 0 AND ZTestedIntValue <= ZMaxWorkVar THEN _ ZOutTxt$ = WasX$ : _ ' Macro command ask ZForceKeyboard = ZTrue : _ ZMacroSave = ZTestedIntValue : _ ZLinesPrinted = 1 : _ ZNonStop = (ZPageLength < 1) : _ EXIT SUB ON (1+INSTR("*0*1*B*FWT>>STON==M!M@EYEN/*TK<<:=LVNVCVLO",MID$(ZOutTxt$,2,2)))\2 GOTO _ ' KG022301 63345, _ ' Display with no Carriage Return 63347, _ ' Display with Carriage Return 63340, _ ' Display Block 63348, _ ' Display File 63343, _ ' Wait # of seconds 63350, _ ' Append to file 63355, _ ' Stack 63360, _ ' Case 63370, _ ' Case Comparison 63375, _ ' Macro execute 63380, _ ' Macro Abort 63383, _ ' Macro Echo on 63385, _ ' Macro Echo off 63336, _ ' Macro Comment 63387, _ ' Turbo Key allowed 63390, _ ' Form read 63362, _ ' Assign value to work var 63363, _ ' LV list verify 63364, _ ' NV number verify 63364, _ ' CV character verify ' KG022301 63367 ' LO assign file location ' KG022301 GOTO 63398 63338 ZOutTxt$ = WasX$ 63339 ZSubParm = 4 CALL TPut RETURN 63340 WasX$ = ZSmartTextCode$ + "END" ' Print Block GOSUB 63395 WHILE ZMacroActive AND LEFT$(ZOutTxt$,4) <> WasX$ GOSUB 63339 CALL SkipLine (1) GOSUB 63395 WEND GOTO 63336 63343 CALL CheckInt (WasX$) ' Delay IF ZErrCode = 0 THEN _ CALL DelayTime (ZTestedIntValue) GOTO 63336 63345 GOSUB 63338 ' Print Line GOTO 63336 63347 GOSUB 63338 CALL SkipLine (1) GOTO 63336 63348 CALL Trim (WasX$) ' Print File CALL FINDITX (WasX$,7) IF NOT ZOK THEN _ GOTO 63336 ZLinesPrinted = 1 ZNo = ZFalse ZNonStop = (ZNonStop OR ZPageLength < 1) 63349 WHILE (NOT EOF(7) AND (NOT ZNo) AND (ZNonStop OR (ZLinesPrinted < ZPageLength)) AND (ZSubParm > -1)) CALL ReadDir (7,1) GOSUB 63396 ZSubParm = 5 CALL TPut WEND ZDistantTGet = 0 IF ZSubParm < 0 THEN _ EXIT SUB IF EOF(7) OR ZNo THEN _ CLOSE 7 : _ ZNo = ZFalse : _ GOTO 63336 ZDistantTGet = 2 CALL PauseExit EXIT SUB 63350 ZWasEN$ = WasX$ ' Append to file WasX = INSTR(ZWasEN$," /FL") OverStrike = (WasX > 0) IF OverStrike THEN _ ZWasEN$ = LEFT$(ZWasEN$,WasX-1) + RIGHT$(ZWasEN$,LEN(ZWasEN$)-WasX-3) CALL Trim (ZWasEN$) CALL LockAppend IF ZErrCode > 0 THEN _ GOTO 63352 GOSUB 63395 WasX$ = ZSmartTextCode$ + "END" WHILE ZMacroActive AND LEFT$(ZOutTxt$,4) <> WasX$ CALL PrintWorkA (ZOutTxt$) GOSUB 63395 WEND 63352 CALL UnLockAppend OverStrike = ZFalse GOTO 63336 63355 ZCommPortStack$ = ZCommPortStack$ + WasX$ + ZCarriageReturn$ ' STack GOTO 63336 63360 CompareVar = VAL(WasX$) CALL AllCaps (WasX$) IF CompareVar < 1 OR CompareVar > ZMaxWorkVar THEN _ CompareVar = 0 GOTO 63336 63362 CALL Trim (WasX$) ' KG021803 CALL CheckInt (WasX$) WasX = INSTR(WasX$," ") IF WasX > 0 AND ZTestedIntValue > 0 AND ZTestedIntValue <= ZMaxWorkVar THEN _ ZGSRAra$(ZTestedIntValue) = RIGHT$(WasX$,LEN(WasX$)-WasX) ' KG021803 GOTO 63336 63363 ZVerifyList$ = WasX$ CALL Trim (ZVerifyList$) GOTO 63365 63364 CALL Trim (WasX$) WasX = INSTR(WasX$," ") IF WasX = 0 THEN _ GOTO 63336 ZVerifyLow$ = LEFT$(WasX$,WasX-1) ZVerifyHigh$ = RIGHT$(WasX$,LEN(WasX$)-WasX) CALL Trim (ZVerifyLow$) CALL Trim (ZVerifyHigh$) ZVerifyNumeric = (MID$(ZOutTxt$,2,1) = "N") 63365 ZVerifying = ZTrue GOTO 63336 63367 CALL TRIM (WasX$) ' KG022301 ZFileLocation$ = WasX$ ' KG022301 GOTO 63336 ' KG022301 63370 IF CompareVar = 0 THEN _ ' Compare Case GOTO 63336 ZWasDF$ = ZGSRAra$(CompareVar) CALL AllCaps (ZWasDF$) CaseExecute = (WasX$ = ZWasDF$) GOTO 63336 63375 CALL Trim (WasX$) ' Execute Macro CALL Macro (WasX$,WasX) GOTO 63336 63380 ZMacroActive = ZFalse ' Abort Macro GOTO 63398 63383 ZMacroEcho = ZTrue GOTO 63336 63385 ZMacroEcho = ZFalse GOTO 63336 63387 ZTurboKey = -ZTurboKeyUser 'TK Turbo Key GOTO 63336 63390 ZUserIn$ = ZOutTxt$ ZUserIn$(5) = "" ZUserIn$(6) = "" ZWasQ = 1 ZStoreParseAt = 1 CALL ParseIt IF ZWasQ < 4 THEN _ GOTO 63336 WasX$ = ZSmartTextCode$ + "END" GOSUB 63397 ZMacroTemplate$ = "" WHILE ZMacroActive AND LEFT$(ZOutTxt$,4) <> WasX$ ZMacroTemplate$ = ZMacroTemplate$ + ZOutTxt$ + ZCrLf$ GOSUB 63397 WEND WasX = VAL(ZUserIn$(4)) VarLen = (ZUserIn$(3) <> "/F") CALL FindIt (ZUserIn$(2)) IF (WasX < 1) OR (NOT ZOK) OR (VarLen AND WasX > ZMaxWorkVar) THEN _ ZMacroTemplate$ = "" : _ GOTO 63336 PauseEachRec = (ZUserIn$(6) = "/1") 63392 CALL FormRead (ZMacroTemplate$,ZUserIn$(2),NOT VarLen,WasX,(ZUserIn$(5) = "/FL"),PauseEachRec) IF ZMacroTemplate$ <> "" THEN _ EXIT SUB _ ELSE GOTO 63336 63395 GOSUB 63397 GOSUB 63396 RETURN 63396 CALL SmartText (ZOutTxt$,ZFalse, OverStrike) CALL MetaGSR (ZOutTxt$,OverStrike) RETURN 63397 IF EOF(6) THEN _ ' Read next line in macro ZMacroActive = ZFalse _ ELSE CALL ReadDir (6,1) : _ ZMacroActive = (ZErrCode = 0) RETURN 63398 END SUB ' Not Macro command - pass to normal processing 63400 ' $SUBTITLE: 'LockAppend - prepares for file append' ' $PAGE ' ' NAME -- LockAppend ' ' INPUTS -- ZWasEN$ Name of file to append to ' ' OUTPUTS -- none ' ' PURPOSE -- Locks and opens file to append to ' SUB LockAppend STATIC WasBX = &H4 ZSubParm = 9 CALL FileLock ZErrCode = 0 CALL OpenWorkA (ZWasEN$) END SUB 63410 ' $SUBTITLE: 'UnLockAppend - cleans up after file append' ' $PAGE ' ' NAME -- UnLockAppend ' ' INPUTS -- none ' ' OUTPUTS -- none ' ' PURPOSE -- Unlocks and close file appending to ' SUB UnLockAppend STATIC WasBX = &H4 ZSubParm = 10 CALL FileLock CLOSE 2 END SUB 63420 ' $SUBTITLE: 'FormRead - Reads from a file into a form' ' $PAGE ' ' NAME -- FormRead ' ' INPUTS -- Template$ Display formvoke shell with ' FilName$ Data file to get values from ' FixedLength Whether file is fixed length ' DataVar # bytes data if fixed length; # fields ' if variable length ' OverStrike Whether typeover into form or insert ' RecPause Whether pause after every record displayed ' otherwise when screen fills ' OUTPUTS -- (displays data base records) ' ' PURPOSE -- Allows field oriented data base data to be displayed ' in a human readable format by substituting field ' data into template or form ' SUB FormRead (Template$,FilName$,FixedLength,DataVar,OverStrike,RecPause) STATIC 63422 IF EOF(2) OR ZNo OR (ZErrCode > 0) OR (ZSubParm < 0) THEN _ Template$ = "" : _ EXIT SUB IF FixedLength THEN _ CALL ReadDir (2,1) : _ ZGSRAra$(1) = ZOutTxt$ _ ELSE CALL ReadParms (ZGSRAra$(),DataVar,1) WasX$ = Template$ CALL SmartText (WasX$,ZTrue,OverStrike) CALL MetaGSR (WasX$,OverStrike) CALL BufAsUnit (WasX$) IF RecPause OR (ZPageLength > 0 AND (ZLinesPrinted >= ZPageLength-1)) THEN _ CALL PauseExit : _ EXIT SUB GOTO 63422 END SUB 63440 ' $SUBTITLE: 'BufAsUnit - prints string with no pauses' ' $PAGE ' ' NAME -- BufAsUnit ' ' INPUTS -- Strng$ String to print ' ' OUTPUTS -- none ' ' PURPOSE -- Prints string with embedded carriage returns. ' Will never pause. Used to print when can't call TGet ' SUB BufAsUnit (Strng$) STATIC WasL = LEN(Strng$) IF WasL < 1 THEN _ EXIT SUB StartByte = 1 63450 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 ZOutTxt$ = MID$(Strng$,StartByte,NumBytes) ZSubParm = 4 CALL TPut CALL SkipLine (-(CRFound)) IF ZRet THEN _ EXIT SUB StartByte = EOD + EOLlen IF StartByte <= WasL THEN _ GOTO 63450 END SUB 63460 ' Check if macro exists and execute if does SUB MacroExe (Strng$) STATIC CALL Trim (Strng$) CALL Macro (Strng$,Found) IF NOT Found THEN _ EXIT SUB CALL FdMacExe END SUB 63462 ' Unconditionally executes a macro SUB FdMaCExe STATIC ZOutTxt$ = "" ZMacroEcho = ZFalse ZSubParm = 1 CALL TGet END SUB 63465 ' Forces a keyboard pause inside a macro SUB PauseExit STATIC ZSubParm = 4 ZTurboKey = -ZTurboKeyUser ZOutTxt$ = ZMorePrompt$ + ">" + MID$("? ! ",2*ZTurboKey+1,2) ZForceKeyboard = ZTrue ZNoAdvance = ZTrue CALL TPut ZLinesPrinted = 0 ZUserIn$ = "" END SUB 63470 ' $SUBTITLE: 'SetPrompt - sub to set prompts based on user security' ' $PAGE ' ' NAME -- SetPrompt ' ' INPUTS -- PARAMETER MEANING ' ZBegMain POSITION START OF MAIN CMDS ' ZBegFile POSITION START OF FILE CMDS ' ZBegUtil POSITION START OF UTIL CMDS ' ZBegLibrary POSITION START OF Library CMDS ' ' OUTPUTS -- PRESENT.OPTS$ DISPLAY WHAT USER CAN DO (1st) ' CALLERS.OPTS$ DISPLAY WHAT USER CAN DO (2nd) ' ZMainOpts$ MAIN OPTS USER CAN DO ' ZFileOpts$ FILE OPTS USER CAN DO ' ZUtilOpts$ UTIL OPTS USER CAN DO ' ZLibOpts$ Library OPTS USER CAN DO ' ' PURPOSE -- Sets command line display of what user can do by ' section and display of what all user can do ' SUB SetPrompt STATIC First = ZBegMain Last = ZBegFile - 1 CALL SetOpts (ZMainOpts$,ZInvalidMainOpts$,First,Last) First = ZBegFile Last = ZBegUtil - 1 CALL SetOpts (ZFileOpts$,ZInvalidFileOpts$,First,Last) First = ZBegUtil Last = ZBegLibrary - 1 CALL SetOpts (ZUtilOpts$,ZInvalidUtilOpts$,First,Last) First = ZBegLibrary Last = ZBegLibrary + 6 CALL SetOpts (ZLibOpts$,ZInvalidLibraryOpts$,First,Last) First = 50 Last = 56 CALL SetOpts (SysOpt$,ZInvalidSysOpts$,First,Last) First = 46 Last = 49 CALL SetOpts (GlobalOpts$,InvalidGlobalOpts$,First,Last) IF LEN(SysOpt$) > 0 THEN _ ZSystemOpts$ = "Sysop: " + _ SysOpt$ ZMainOpts$ = GlobalOpts$ + _ ZMainOpts$ ZFileOpts$ = GlobalOpts$ + _ ZFileOpts$ ZUtilOpts$ = GlobalOpts$ + _ ZUtilOpts$ ZLibOpts$ = GlobalOpts$ + _ ZLibOpts$ CALL SortString (SysOpt$) CALL SortString (ZMainOpts$) ZMainOpts$ = ZMainOpts$ + _ SysOpt$ CALL SortString (ZFileOpts$) CALL SortString (ZUtilOpts$) CALL SortString (ZLibOpts$) CALL AddCommas (ZMainOpts$) CALL AddCommas (ZFileOpts$) CALL AddCommas (ZUtilOpts$) CALL AddCommas (ZLibOpts$) ZDirPrompt$ = "What directory(s) (" + _ MID$("U)pload,A)ll,L)ist,E)xtended +/-, [Q]uit)",8 * (ZUserSecLevel => ZMinSecToView) + 9) ZQuitPromptExpert$ = "QUIT C,S, or to F,[M],U,@" ZQuitPromptNovice$ = "QUIT C)onference, S)ession or to section " + _ "F)ile, [M]ain, U)til or @)Library" ZQuitList$ = "FMUS@C" IF ZUserSecLevel < ZOptSec(18) THEN _ ZQuitPromptExpert$ = LEFT$(ZQuitPromptExpert$,23) : _ ZQuitPromptNovice$ = LEFT$(ZQuitPromptNovice$,61) : _ MID$(ZQuitList$,5) = " " IF ZUserSecLevel < ZOptSec(15) THEN _ ZQuitPromptExpert$ = LEFT$(ZQuitPromptExpert$,22) + _ MID$(ZQuitPromptExpert$,25) : _ ZQuitPromptNovice$ = LEFT$(ZQuitPromptNovice$,56) + _ MID$(ZQuitPromptNovice$,63) : _ MID$(ZQuitList$,3,1) = " " IF ZUserSecLevel < ZOptSec(6) THEN _ ZQuitPromptExpert$ = LEFT$(ZQuitPromptExpert$,16) + _ MID$(ZQuitPromptExpert$,19) : _ ZQuitPromptNovice$ = LEFT$(ZQuitPromptNovice$,41) + _ MID$(ZQuitPromptNovice$,49) : _ MID$(ZQuitList$,1,1) = " " CALL SetSection END SUB 63480 ' $SUBTITLE: 'NoPath - detects whether string has path' ' $PAGE ' ' NAME -- NoPath ' ' INPUTS -- Strng$ String to check ' ' OUTPUTS -- HAS.NONE True if has no path ' ' PURPOSE -- Detects whether have path. Used when shouldn't ' be any ' SUB NoPath (Strng$,HasPath) STATIC CALL BreakFileName (Strng$,DrvPath$,Prefix$,Ext$,ZFalse) HasPath = (DrvPath$ <> "") END SUB 63490 ' $SUBTITLE: 'FindIt - Determine whether file exists' ' $PAGE ' ' NAME -- FindIt ' ' INPUTS -- FilName$ File name to check ' ' OUTPUTS -- ZOK True if file exists. Opened as #2 if does ' ' PURPOSE -- Determine whether file exists and open as standard work ' file if it does (#2) ' SUB FindIt (FilName$) STATIC CALL FindItX (FilName$,2) END SUB 63495 ' $SUBTITLE: 'TimeBack - Give time back to the user' ' $PAGE ' ' NAME -- TimeBack ' ' INPUTS -- Index = 1 Set start of time (begin give back) ' = 2 Give back time from defined start ' ' OUTPUTS -- ZTimeCredits! Number of seconds to credit with ' ZSecsPerSession! Number of seconds in current session ' ' PURPOSE -- Give time back to the user (e.g. sysop initiated chat) ' SUB TimeBack (Index) STATIC IF Index = 1 THEN _ CALL TimeRemain (MinsRemaining) : _ ZWasQ! = ZSecsUsedSession! : _ EXIT SUB CALL TimeRemain (MinsRemaining) WasX! = (ZSecsUsedSession! - ZWasQ!) ZTimeCredits! = ZTimeCredits! + WasX! END SUB 63500 ' $SUBTITLE: 'CmdStackPushPop - Save/restore command stack' ' $PAGE ' ' NAME -- CmdStackPushPop ' ' INPUTS -- Index = 1 Save command stack ' = 2 Restore command stack ' ZAnsIndex ' ZLastIndex ' ZUserIn$() ' ' OUTPUTS -- ZUserIn$() Stacked commands ' ZAnsIndex ' ZLastIndex ' ' PURPOSE -- Save restore a command stack list when need to input ' another list in middle of previous list processing ' SUB CmdStackPushPop (Index) STATIC IF Index = 1 THEN _ OrigLastIndex = ZLastIndex : _ ' save OrigIndex = ZAnsIndex : _ FOR WasI = 1 TO OrigLastIndex : _ ZOutTxt$(WasI) = ZUserIn$(WasI) : _ NEXT : _ EXIT SUB ZLastIndex = OrigLastIndex ' restore ZAnsIndex = OrigIndex FOR WasI = 1 TO OrigLastIndex ZUserIn$(WasI) = ZOutTxt$(WasI) NEXT END SUB 63510 ' $SUBTITLE: 'VerifyAns - edits an answer' ' $PAGE ' ' NAME -- VerifyAns ' MEANING ' INPUTS -- ZVerifying Whether verifying ' ZUserIn$(1) Response verifying ' ZVerifyList$ List of appropriate answers. 1st ' char is what separates answers ' ZVerifyNumeric Verify that is a valid integer ' if false, then verifying that ' a string is between 2 values ' ZVerifyLow$ Lowest ok value of string ' ZVerifyHigh$ Highest ok value of string ' ' OUTPUTS -- ZOK Whether passes verification ' ZVerifyList$ Empties if ok ' ZVerifying Sets false if ok ' ZVerifyNumeric Sets false if ok ' ' PURPOSE -- Processes edits on a user input ' SUB VerifyAns STATIC ZOK = ZTrue IF NOT ZVerifying THEN _ EXIT SUB Temp$ = ZUserIn$(1) CALL AllCaps (Temp$) IF ZVerifyList$ <> "" THEN _ WasX$ = LEFT$(ZVerifyList$,1) : _ ZOK = (INSTR (ZVerifyList$, WasX$+Temp$+WasX$) > 0) _ ELSE IF ZVerifyNumeric THEN _ CALL CheckInt (ZUserIn$) : _ ZOK = (ZErrCode = 0 AND _ ZTestedIntValue >= VAL(ZVerifyLow$) AND _ ZTestedIntValue <= VAL(ZVerifyHigh$)) _ ELSE ZOK = (Temp$ >= ZVerifyLow$ AND Temp$ <= ZVerifyHigh$) IF ZOK THEN _ ZVerifyList$ = "" : _ ZVerifying = ZFalse : _ ZVerifyNumeric = ZFalse END SUB 63520 ' $SUBTITLE: 'BinSearch - binary search a file' ' $PAGE ' ' NAME -- BinSearch ' MEANING ' INPUTS -- PassedSearchFor$ Value you are looking for ' StartPos Starting position of sort key ' NumChars # of characters in sort key ' LenRec Length of record of data file searching ' High Record # of last record ' ZFastTabs$ In a binary integer subfield (2 bytes) ' holds 1st record when might find ' a key beginning with a particular ' character (0-9,A-Z). Empty if ' no Fast Tab exists for the file. ' ' OUTPUTS -- RecFoundAt Record # value found at (0 if none) ' RecFound$ Full data record when found ' ' PURPOSE -- Binary searches work file #2 for a key value in a ' data file that is sorted on a key field ' SUB BinSearch (PassedSearchFor$,StartPos, NumChars, LenRec, High, RecFoundAt, RecFound$) STATIC SearchFor$ = LEFT$(PassedSearchFor$,NumChars) SearchFor$ = SearchFor$ + SPACE$(NumChars-LEN(SearchFor$)) FIELD #2, LenRec AS SearchRec$ Low = 0 IF LEN(ZFastTabs$) < 72 THEN _ GOTO 63522 WasX$ = LEFT$(SearchFor$,1) WasX = INSTR("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",WasX$) IF WasX > 0 THEN _ Low = CVI(MID$(ZFastTabs$,1+2*(WasX-1),2)) - 1 : _ ' KG102701 IF WasX < 36 THEN _ ' KG102701 High = CVI(MID$(ZFastTabs$,1+2*WasX,2)) ' KG102701 63522 RecFoundAt = 0 IF High < 1 THEN _ ' KG072102 EXIT SUB ' KG072102 WasX$ = SPACE$ (NumChars) Done = ZFalse WHILE NOT Done WasI = INT(((High + Low) / 2) + .5) GET 2, WasI LSET WasX$ = MID$(SearchRec$, StartPos, NumChars) IF WasX$ = SearchFor$ THEN _ RecFound$ = SearchRec$: _ RecFoundAt = WasI : _ Done = ZTrue _ ELSE IF (High - Low) < 2 THEN _ Done = ZTrue _ ELSE IF WasX$ < SearchFor$ THEN _ Low = WasI _ ELSE IF WasX$ > SearchFor$ THEN _ High = WasI WEND END SUB 63530 ' Take modem offhook SUB TakeOffHook STATIC CALL ModemPut (ZModemGoOffHookCmd$) CALL DelayTime (3) END SUB 63540 ' Match Name to one in message file SUB ChkMsgName (MsgFromCaller,MsgToCaller) STATIC ' KG090402 IF NOT ZRemoteSysop THEN _ ' KG090402 WasX$ = LEFT$("SYSOP",-5*ZSysop) : _ ' KG090402 CALL MsgNameMatch (ZOrigUserName$,WasX$,6,MsgFromCaller) : _ ' KG090402 CALL MsgNameMatch (ZOrigUserName$,WasX$,37,MsgToCaller) : _ ' KG090402 EXIT SUB ' KG090402 CALL MsgNameMatch ("SYSOP",ZSysopFullName$,6,MsgFromCaller) ' KG090402 IF NOT MsgFromCaller THEN _ ' KG090402 CALL MsgNameMatch (ZOrigUserName$,"",6,MsgFromCaller) ' KG090402 CALL MsgNameMatch ("SYSOP",ZSysopFullName$,37,MsgToCaller) ' KG090402 IF NOT MsgToCaller THEN _ ' KG090402 CALL MsgNameMatch (ZOrigUserName$,"",37,MsgToCaller) ' KG090402 END SUB ' KG090402 SUB MsgNameMatch (PrimeName$,AltName$,SearchPos,Found) STATIC WasX$ = LEFT$(PrimeName$+" ",22-8*(SearchPos < 7)) GOSUB 63542 ' KG052201 IF Found OR AltName$ = "" THEN _ ' KG052201 EXIT SUB ' KG052201 WasX$ = LEFT$(AltName$ + " ",22-8*(SearchPos < 7)) GOSUB 63542 ' KG052201 EXIT SUB ' KG052201 63542 WasY$ = MID$(ZMsgRec$,SearchPos,LEN(WasX$)) ' KG052201 ZWasDF = INSTR(WasY$,"@") ' KG052201 IF ZWasDF > 0 THEN _ ' KG052201 MID$(WasY$,ZWasDF) = " " ' KG052201 Found = (WasY$ = WasX$) ' KG052201 RETURN ' KG052201 END SUB