' $linesize:132 ' $title: 'RBBSSUB3.BAS CPC17.3, Copyright 1986 - 90 by D. Thomas Mack' ' Copyright 1990 by D. Thomas Mack, all rights reserved. ' Name ...............: RBBSSUB3.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 ' AllCaps 58050 Convert a string to all upper case characters ' AMorPM 41498 Calculate the current time as AM or PM ' AskGraphics 43004 Determine users graphic default ' BadFile 20741 Check for system crash attempt with bad device name ' Carrier 42000 Test for whether to continue in RBBS ' CheckTime 58070 Test to insure that users don't exceed their time ' CheckCarrier 42005 Checks whether still have carrier ' CheckNewBul 58110 Check for new bulletins based on their file creation date ' CheckTimeRemain 41008 Set up to log off if time exceeded ' CommInfo 44020 Get users baud rate and parity in a string format ' CountLines 58160 Count categories a file can be classified into ' CountNewFiles 58150 Check for number of files uploaded after a specific date ' DelayTime 50495 Wait number of seconds specified before returning ' DispCall 57001 Display callers file ' DispTimeRemain 41032 Compute and display time remaining ' DispUpDir 58165 Display the shared directory of the FMS mng. sys. ' FileLock 21993 Moved to RBBSSUB1 for Error Traping 'Pe 02/04/90 ' FindFKey 30595 Handle local keyboard's function & ZSysop's keys ' FindLast 58600 Finds last occurence of a string in a string ' FlushKeys 35000 Completely flush all user input ' Graphic 43031 Determines if graphic ver of file exists, opens as #2 ' GraphicX 43031 Determines if graphic ver of file exists, any file # ' HashRBBS 58080 "Hash" to a user's record in the USERS file ' InitFMS 58162 Initialize the RBBS-PC's File Management System ' InitIBM 30000 Open/create NetBIOS semaphore file ' AddCommas 58130 Format commands in the command prompt ' Library 21105 Provide support for "library" drives ' LinesInFile 58161 Counts lines in a file ' LoadNew 58140 Find the latest uploads ' ModemPut 52070 Write a modem command string to the modem ' NameCaps 58060 Convert a string to Proper Case (for name output) ' OpenMsg 30500 Open the messages file as file number 1 ' PageUp 33202 Display user info. on local screen for ZSysop ' ReadProf 44000 Read user's profile on return from a "door" ' SaveProf 43068 Save the user's provile when exiting to "doors" or DOS ' SendName 20293 Send filename via EXEC-PC protocol during autodownload ' SetOpts 58100 Set correct prompt line for each subsystem ' SortString 58120 Sort characters in a string ' TestUser 20310 Check if user's software can do auto downloading ' TimeRemain 41010 Compute time remaining in minutes ' UpdtUpload 20705 Updates upload directory file ' WildFile 20290 Determines whether string matches a pattern ' XferType 21600 Identify the file transfer protocol ' ' $INCLUDE: 'RBBS-VAR.BAS' ' 20290 ' $SUBTITLE: 'WildFile -- Matches file to a filespec' ' $PAGE ' NAME -- WildFile ' ' INPUTS -- PARAMETER MEANING ' Pattern$ PATTERN TO CHECK AGAINST ' ItemToMatch$ FILE NAME TO MATCH ' ' OUTPUTS -- DoesMatch WHETHER MATCHES ' ' PURPOSE Determine whether a file name is an instance of ' a file specification. Exactly like DOS except that ? must have a ' character. ' SUB WildFile (Pattern$,ItemToMatch$,DoesMatch) STATIC IF Pattern$ <> PrevPattern$ THEN _ CALL BreakFileName (Pattern$,PDrive$,PPrefix$,PExt$,ZFalse) : _ PrevPattern$ = Pattern$ CALL BreakFileName (ItemToMatch$,IDrive$,IPrefix$,IExt$,ZFalse) DoesMatch = ZFalse IF PDrive$ <> "" AND PDrive$ <> IDrive$ THEN _ EXIT SUB CALL WildCard (PPrefix$,IPrefix$) IF NOT ZOK THEN _ EXIT SUB CALL WildCard (PExt$,IExt$) DoesMatch = ZOK END SUB ' ' Pe 02/03/90---- Removed SendName and Testuser subs ' ' ' ********* Maple UPDTU... ****** ' ' 20705 ' $SUBTITLE: 'UpdtUpload -- Updates upload directory' ' $PAGE ' SUBROUTINE NAME -- UpdtUpload ' ' INPUT PARAMETERS -- PARAMETER MEANING ' ZFileName$ ' ZUpldDir$ ' ZFileNameHold$ ' ZShareIt ' ZFMSDirectory$ ' ZWasQ! ' TCA! ' ' OUTPut PARAMETERS -- ZBytesInFile# ' ZSecsPerSession! ' ' SUBROUTINE PURPOSE -- UPON A SUCCESSFUL UPLOAD, ADD ENTRY TO THE UPLOAD ' DIRECTORY AND GIVE ANY SESSION TIME CREDIT. ' SUB UpdtUpload (ZCategoryName$(1),ZCategoryCode$(1),LinesInDesc,WasFF) STATIC '<=== ON WasFF GOTO 20710,20724,20723 'Pe 11/20/89 20710 ZAbort = ZFalse ' PE ZAbort MOD CALL QuickTPut1 ("Describe " + ZFileNameHold$ +ZCrLf$ + _ " (Begin with / if for Sysop only) or enter the word ABORT to cancel") ' Bh CALL QuickTPut1 (LEFT$(" |----+--Min<..-+---2+0---+---3+0---+---4+0---+-", _ ZMaxDescLen - 4) + "..Max>") CALL QuickTPut ("? ",0) ZOutTxt$ = "" ZSubParm = 1 ZParseOff = ZTrue CALL TGet CALL Carrier IF ZSubParm = -1 THEN _ 'Pe 11/20/89 EXIT SUB 'Pe 11/20/89 TempUserIn$ = ZUserIn$ 'Pe 02/17/90 CALL AllCaps (TempUserIn$) 'Pe 02/17/90 IF TempUserIn$ = "ABORT" THEN _ 'Pe 02/17/90 ZAbort = ZTrue : _ TempUserIn$ = "" : _ 'Pe 02/17/90 EXIT SUB TempUserIn$ = "" 'Pe 02/17/90 IF LEN(ZUserIn$) > ZMaxDescLen OR LEN(ZUserIn$) < 5 THEN _ CALL QuickTPut (" Description must be 5 chars min," + STR$(ZMaxDescLen) + " chars max",1) : _ CALL QuickTPut (" ENTER the word Abort to cancel transfer....",1) : _ GOTO 20710 20712 Desc$ = ZUserIn$ IF NOT ZLimitSearchToFMS THEN _ IF ZFMSDirectory$ <> ZUpldDir$ THEN _ IF LEFT$(ZUserIn$,1) = "/" OR LEFT$(ZUserIn$,1) = "\" THEN _ GOTO 20722_ ELSE GOTO 20717 20715 IF LEFT$(ZUserIn$,1) = "/" OR LEFT$(ZUserIn$,1) = "\" THEN _ UCat$ = "***" : _ GOTO 20722 UCat$ = ZDefaultCatCode$ 20717 IF ZSubParm = -1 OR _ ZUserSecLevel < ZSLCategorizeUplds THEN _ GOTO 20722 20719 CALL BufFile (ZUpcatHelp$,WasX) 20720 ZOutTxt$ = "Upload best fits which category (H=help)" ' Bh ZSubParm = 1 CALL TGet IF ZSubParm = -1 THEN _ EXIT SUB 'Pe 11/20/89 IF ZWasQ = 0 THEN _ GOTO 20719 CALL AllCaps (ZUserIn$(1)) IF ZUserIn$(1) = "H" OR _ ZUserIn$(1) = "*" OR _ ZUserIn$(1) = "?" THEN _ GOTO 20719 CALL SearchArray (ZUserIn$(1),ZCategoryName$(),ZNumCategories,Found) IF Found > 0 THEN _ UCat$ = ZCategoryCode$(Found) : _ IF LEN(UCat$) > 0 AND LEN(UCat$) < 4 AND INSTR(UCat$,",") = 0 THEN _ GOTO 20722 UCat$ = "" IF NOT ZLimitSearchToFMS THEN _ StrewTo$ = ZDirPath$ + _ ZUserIn$(1) + _ "." + _ ZDirExtension$ : _ CALL FindIt (StrewTo$) : _ 'Pe 11/21/89 IF ZOK THEN _ GOTO 20722 _ ELSE CALL WORDInFile (ZUpcatHelp$,ZUserIn$(1),ZOK) : _ IF ZOK THEN _ GOTO 20722 StrewTo$ = "" CALL QuickTPut1 ("No such category " + ZUserIn$(1)) GOTO 20719 'Pe 11/21/89 20722 IF ZUserSecLevel >= ZAskExtendedDesc AND _ ZMaxExtendedLines > 0 AND ZSubParm <> -1 THEN _ ZOutTxt$ = "Want to add EXTRA INFORMATION for " + _ ' Bh ZFileNameHold$ + " (Y,[N])" : _ ZTurboKey = -ZTurboKeyUser : _ ZSubParm = 1 : _ CALL TGet : _ IF ZSubParm <> -1 THEN _ IF ZYes THEN _ CALL SkipLine (2):_ CALL QuickTPut (CHR$(7)+ " You can type in extra info AFTER the UPLOAD is Completed",2) : _ ' Bh CALL DelayTime (2) :_ ZGetExtDesc = ZTrue ' '******** Pe Upload changes ******* ' ' need to add file for RBBS to read when DOORING to external protocols ' to remember Description, CatCode ect ect...should be done around this ' Point since we could use this info on batch Uploads also (future RBBS) ' following are variables we need to save and later restored ' ' ZFileName$ ' ZFileNameHold$ ' Desc$ ' UCat$ ' ZAbort ' ZGetExtDesc ' IF ZPrivateDoor THEN CALL OpenOutW ("UPDESC" +ZNodeID$ +".LST") Print #2, ZFileName$ Print #2, ZFileNameHold$ Print #2, Desc$ Print #2, UCat$ Print #2, ZActiveFMSDir$ Print #2, ZFMSDirectory$ Print #2, ZAbort Print #2, ZGetExtDesc Print #2, StrewTo$ Print #2, ZAllwaysStrewTo$ Print #2, ZUpldDir$ Close 2 END IF EXIT SUB ' ********* routine AFTER the Upload is successfull and Extended = True ***** 20723 ZUserIn$ = Desc$ WasX$ = DATE$ WasZ$ = LEFT$(WasX$,6) + _ RIGHT$(WasX$,2) ZWasEN$ = StrewTo$ GOSUB 20730 ZWasEN$ = ZAllwaysStrewTo$ GOSUB 20730 GOTO 20728 'CHANGE from 20725 to 20728 'Pe 09/12/89 ' '***** ENTRY POINT WHEN UPLOAD is Finished *********** ' 20724 IF ZPrivateDoor THEN CALL OpenWork (2,"UPDESC" +ZNodeID$ +".LST") While Not EOF(2) Input #2, ZFileName$ Input #2, ZFileNameHold$ Input #2, Desc$ Input #2, UCat$ Input #2, ZActiveFMSDir$ Input #2, ZFMSDirectory$ Input #2, ZAbort Input #2, ZGetExtDesc Input #2, StrewTo$ Input #2, ZAllwaysStrewTo$ InPut #2, ZUpldDir$ Wend Close 2 END IF GOSUB 20734 'find uploaded file ' CALL TimeRemain (MinsRemaining) IF ZPrivateDoor THEN _ WasX! = ZUpldTimeFactor! * ZWasQ! _ ELSE WasX! = ZUpldTimeFactor! * (ZSecsUsedSession! - ZWasQ!) ' '************************8 New Convert code begins here 8******************* ' Orig mods by Warren Muldrow ' ' additional mods by Pete Eibl moved code to callable Subroutines 09/25/89 ' added X2ZIP?.LST.......01/18/90 ' ' Zip Convert code. Does the following: ' IF X2ZIP? (?=Node #) is found then any file extension ' Listed in this file is NOT touched any other file will ' Be converted to ZIP format. IF the file is NOT found then ' user is asked to convert file....!! ' The First line determins weather to ask user to Convert or not ' This should either be a Yes or NO (in Upper case only) if Yes ' then user has the option of converting the file the rest of the ' file should have one EXTENSION per line including the "." ' ex: .ARC ' ' PKUNZIP, PKZIP, PKUNPAK, PAK, LHARC, ZOO.BAT, WHAT.EXE, and LOOZ.EXE ' should be in the DOS path or the RBBS directory. WHAT is used by ' ZOO.BAT ' ' The Library work path (Config parm # 304) is used for a work area !!! ' IF ZAbort = ZTrue THEN _ 'Corrects aborted uploads EXIT SUB 'corrects aborted uploads ' CALL BreakFileName (ZFileName$, WDR$, WZZ$, WX$, ZTrue) 'Pe 11/26/89 'TooZip$ = "X2ZIP" + ZNodeID$ + ".LST" 'CALL FindIt (TooZip$) 'IF NOT ZOK THEN _ 'Pe 02/06/90 'AskToConvert = ZTrue : _ ' GOTO 20725 'CALL OpenWork (2,TooZip$) ' WHILE NOT EOF(2) ' INPUT #2, Check$ ' IF Check$ = "Yes" THEN _ ' AskToConvert = ZTrue :_ ' CLOSE 2 : _ ' GOTO 20725 ' IF WX$ = Check$ THEN _ ' CLOSE 2: _ ' GOTO 20727 ' WEND ' CLOSE 2 '' '20725 IF ZAutoEnd = 1 THEN 'Pe 01/24/90 ' IF WX$ = Check$ THEN GOTO 20727 Else GOTO 20726 'Pe 01/24/90 ' END IF 'IF ZSysop OR ZUserSecLevel > = ZAddDirSecurity OR AskToConvert = ZTrue THEN 'AskToConvert = ZFalse ' ZSubParm = 1 ' ZOutTxt$ = " Convert or verify " + ZFileName$ + " ([Y],N) " ' ZTurboKey = -ZTurboKeyUser ' CALL TGet ' IF ZSubParm = -1 THEN _ ' EXIT SUB ' IF ZNO THEN _ ' GOTO 20727 ' END IF '20726 IF ZLocalUser THEN _ 'Pe 01/23/90 added line number ' CALL LOCALCONVERT (WDR$,WZZ$,WX$,Desc$) _ 'Pe 10/05/89 ' ELSE _ ' CALL CONVERT2ZIP (WDR$,WZZ$,WX$,Desc$) 'Pe 10/05/89 '' '20727 GOSUB 20734 'Pe 11/21/89 ' 'IF RIGHT$(ZFileNameHold$,3) = "ZIP" THEN ' CALL QuickTPut ("Adding Your Name and File Description to "+ZFileNameHold$ + " .......",2) ' CommentName$ =ZUpldSubDir$ +"\UPLOAD.CMT ' ADDCMT1$ =ZCrLf$ +"Uploaded to "+ ZRBBSName$ +" By: "+ZActiveUserName$ ' ADDCMT2$ = ZCrLf$ +"Description: " + Desc$ ' ADDCOMMENT$ = ADDCMT1$ + ADDCMT2$ + ZCrLf$ ' CALL OpenOutW (CommentName$) ' PRINT #2, ADDCOMMENT$ ' CLOSE 2 ' ADDCMT$ = ZLibArcPath$+"PKZIP -z<"+CommentName$+" "+ ZFileName$ ' SHELL "COMMAND.COM /C "+ADDCMT$ 'END IF ' ZOK = 0 CALL CheckNovell (ZOK) IF ZOK <> -1 THEN _ CALL SetSharedAttr (ZFileName$, ZOK) : _ IF ZOK <> 0 THEN _ CALL PScrn ("Error setting shared attribute") IF ZGetExtDesc THEN _ EXIT SUB ' ZOutTxt$ = "" 'Pe 03/04/90 WasX$ = DATE$ ' WasZ$ = LEFT$(WasX$,6) + RIGHT$(WasX$,2) WasZ$ = LEFT$(WasX$,2) + MID$(WasX$,4,2) + RIGHT$(WasX$,2) ' StrewTo$ = "" 'Pe 03/04/90 ZUserIn$ = Desc$ ZWasEN$ = ZAllwaysStrewTo$ GOSUB 20730 ZWasEN$ = StrewTo$ GOSUB 20730 ' 20728 IF LEFT$(ZUserIn$,1) = "/" OR LEFT$(ZUserIn$,1) = "\" THEN _ WZZ$ = "************" : _ WX$ = "" CALL AMorPM 'Pe 11/25/89 IF ZActiveUserName$ = ZSysopPswd1$ + " " + ZSysopPswd2$ THEN _ 'Pe 11/25/89 ULBYNAME$ = "ZSysop" _ 'Pe 11/25/89 ELSE ULBYNAME$ = ZActiveUserName$ 'Pe 11/25/89 ULXXX$ = WZZ$+WX$+SPACE$(13-(LEN(WZZ$)+LEN(WX$))) 'Pe 01/24/90 UPLOADLG$ = "{C1"+ ULXXX$ + _ 'Pe 01/24/90 "{C2"+ ULBYNAME$+SPACE$(34-LEN(ULBYNAME$)) + _ 'Pe 01/24/90 "{C3"+ DATE$ + " " + _ 'Pe 01/24/90 "{C4"+ ZTime$+" {C0" 'Pe 01/24/90 CALL OpenWorkA ("UPLOADLG.DEF") 'Pe 01/09/90 CALL PrintWorkA (UPLOADLG$) 'Pe 11/25/89 CLOSE 2 'Pe 01/18/90 IF ZFMSDirectory$ <> ZUpldDir$ THEN _ IF LEFT$(ZUserIn$,1) = "/" OR LEFT$(ZUserIn$,1) = "\" THEN _ CALL UpdtCalr (ZUserIn$,2): _ GOTO 20729 '****************** ZWasEN$ = ZUpldDir$ GOSUB 20730 20729 ZWasDF$ = " >> uploaded << " ZUplds = ZUplds + 1 ZGlobalUplds = ZGlobalUplds + 1 ZULBytes! = ZULBytes! + ZBytesInFile# ZGlobalULBytes! = ZGlobalULBytes! + ZBytesInFile# CALL TimeRemain (MinsRemaining!) ZTimeCredits! = ZTimeCredits! + WasX! ZSecsPerSession! = ZSecsPerSession! + WasX! IF ZPrivateDoor THEN _ WasX! = (WasX! - ZWasQ!) / 60.0 _ ELSE WasX! = (WasX! - ZSecsUsedSession! + ZWasQ!)/60.0 WasX$ = STR$(FIX(WasX!*10.0)) WasX$ = LEFT$(WasX$,LEN(WasX$)-1) + "." + RIGHT$(WasX$,1) IF WasX! > 1.0 THEN _ CALL QuickTPut1 ("Session time increased by"+WasX$+" minutes") CALL QuickTPut ("Upload successful. Thanks for the file, " + ZFirstName$ ,1) ' Bh CALL DelayTime (2) 'Pe 02/23/90 ZGetExtDesc = ZFalse IF ZAutoEnd = 1 THEN _ ZFileSysParm = 7 : _ ZDnldCompleted = ZTrue 'Pe 02/05/90 EXIT SUB 20730 ' ---[ lock file ]--- IF ZWasEN$ = "" THEN _ RETURN FMSFormat = ZFalse IF ZWasEN$ = ZFMSDirectory$ OR ZLimitSearchToFMS THEN _ FMSFormat = ZTrue _ ELSE CALL FindIt (ZWasEN$) : _ IF ZOK THEN _ CALL ReadDir (2,1) : _ 'Pe 11/22/89 IF ZErrCode = 0 THEN _ FMSFormat = (LEFT$(ZOutTxt$,4) = "\FMS") IF NOT FMSFormat THEN _ ReadBackwards = ZFalse : _ FixedLen = 0 : _ ZUserIn$ = Desc$ _ ELSE FixedLen = 28 + ZMaxDescLen : _ ' Bh 082790 ' ELSE FixedLen = 34 + ZMaxDescLen : _ ZUserIn$ = Desc$ + _ SPACE$(ZMaxDescLen - LEN(Desc$)) + _ UCat$ + _ SPACE$(3 - LEN(UCat$)) : _ ReadBackwards = ZTrue : _ CALL FindIt (ZWasEN$) : _ IF ZOK THEN _ CALL ReadDir (2,1) : _ IF ZErrCode = 0 THEN _ ReadBackwards = (INSTR(ZOutTxt$," TOP ") = 0) CALL LockAppend IF ZErrCode <> 0 THEN _ GOTO 20731 ' ---[ append ]--- IF ZGetExtDesc THEN _ IF ReadBackwards THEN _ FOR WasI = LinesInDesc TO 1 STEP -1 : _ GOSUB 20732 : _ NEXT ' CALL AllCaps (ZUserIn$) ' Bh 090690 PRINT #2,USING "\ \####### & &"; _ ' Bh 083090 ZFileNameHold$; _ ZBytesInFile#; _ WasZ$; _ ZUserIn$ IF ZGetExtDesc THEN _ IF NOT ReadBackwards THEN _ FOR WasI = 1 TO LinesInDesc : _ GOSUB 20732 : _ NEXT 20731 CALL UnLockAppend FixedLen = 0 RETURN 20732 WasX$ = ZOutTxt$(WasI) CALL Trim (WasX$) IF WasX$ = "" THEN _ RETURN IF NOT FMSFormat THEN _ PRINT #2," ";ZOutTxt$(WasI) : _ RETURN IF FixedLen > LEN(ZOutTxt$(WasI)) THEN _ WasX$ = SPACE$(FixedLen - 1 - LEN(ZOutTxt$(WasI))) + "." _ ELSE WasX$ = "" PRINT #2, " ";LEFT$(ZOutTxt$(WasI),FixedLen);WasX$ RETURN 20734 CALL FindIt (ZFileName$) 20736 IF NOT ZOK THEN _ ZBytesInFile# = 0.0_ ELSE ZBytesInFile# = LOF(2) IF ZBytesInFile# < 2.0 THEN _ EXIT SUB RETURN END SUB 20741 ' $SUBTITLE: 'BadFile - subroutine to find bad file names' ' $PAGE ' ' NAME -- BadFile ' ' INPUTS -- PARAMETER MEANING ' ZViolation$ ' ZViolationsThisSession ' FilName$ NAME OF FILE ' ' OUTPUTS -- Result 1 = FILE NAME IS OK ' 2 = CHARACTER NOT ALLOWED ' 3 = SYSTEM CRASH ATTEMPT ' ZViolationsThisSession NUMBER OF VIOLATIONS ' FilName$ Gets capitalized ' ' PURPOSE -- To protect RBBS-PC against the use of bad file names ' to either crash the system or to breach RBBS-PC's security. ' SUB BadFile (FilName$,Result) STATIC ' ' ' * TEST FOR INVALID CHARACTERS IN FILENAME ' ' Result = 2 IF LEN(FilName$) < 1 THEN _ EXIT SUB CALL BadFileChar (FilName$,ZOK) IF NOT ZOK THEN _ EXIT SUB CALL AllCaps (FilName$) WasXX = INSTR(FilName$,".") IF WasXX > 0 THEN _ IF WasXX < LEN(FilName$) THEN _ WasXX = INSTR(WasXX + 1,FilName$,".") : _ IF WasXX > 0 THEN _ EXIT SUB WasXX = LEN(FilName$) IF WasXX => 3 THEN _ IF INSTR("PRN:CON:AUX:NUL:",FilName$) THEN _ GOTO 20742 IF WasXX => 4 THEN _ IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:SCRN:KYBD:CONS:",FilName$) THEN _ GOTO 20742 CALL BreakFileName (FilName$,Pre$,Body$,Ext$,ZFalse) IF LEN(Pre$) > 64 OR LEN(Body$) > 8 OR LEN(Body$) < 1 OR LEN(Ext$) > 3 THEN _ EXIT SUB WasXX = LEN(Body$) IF WasXX => 3 THEN _ IF INSTR("PRN:CON:AUX:NUL:",Body$) THEN _ GOTO 20742 IF WasXX => 4 THEN _ IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:SCRN:KYBD:CONS:",Body$) THEN _ GOTO 20742 Result = 1 EXIT SUB 20742 ZViolationsThisSession = ZMaxViolations ZViolation$ = ZViolation$ + _ FilName$ Result = 3 END SUB ' '21105 ' $SUBTITLE: 'Library - sub to support Library downloads' ' $PAGE ' ' NAME -- Library ' ' INPUTS -- PARAMETER MEANING ' ZSubParm 1 = DISPLAY ACTIVE AREA ' 2 = CHANGE ACTIVE AREA ' 3 = DISPLAY PC-SIG ' DISCLAIMER ' 4 = ARCHIVE Library DISK ' 5 = DOWNLOAD COMPLETED ' ZLibType 0 = No Library ACTIVE ' 1 = Library FROM PC-SIG ' ZLibDrive$ Library DRIVE ID ' ' OUTPUTS -- NONE ' ' PURPOSE -- To provide access support for library drives ' ' SUB Library STATIC ' STATIC LibSubdirName$(1) ' STATIC DiskTitle$ ' ZErrCode = 0 ' IF ZLibType = 0 THEN _ ' EXIT SUB ' IF ZLibDiskChar$ = "" THEN _ ' ZLibDiskChar$ = "0000" ' ON ZSubParm GOTO 21110, 21115, 21130, 21140, 21159 '21110 IF ZLibDiskChar$ = "0000" THEN _ ' ZOutTxt$ = "No Library Book currently selected" _ ' Bh ' ELSE ZOutTxt$ = "Library Book " + _ ' Bh ' ZLibDiskChar$ + _ ' " selected - " + _ ' DiskTitle$ ' CALL QuickTPut1 (ZOutTxt$) ' IF LibDiskArc$ = "" THEN _ ' EXIT SUB ' IF INSTR(ZLibDiskArc$,"ARC") THEN _ ' Extension$ = "ARC" _ ' ELSE IF INSTR(ZLibDiskArc$,"ZIP") THEN _ ' Extension$ = "ZIP" _ ' ELSE IF INSTR(ZLibDiskArc$,"LHA") THEN _ ' Extension$ = "LHZ" _ ' ELSE Extension$ = ZDefaultExtension$ ' FOR LibDisplayCount = 0 TO LibLoopCount - 1 ' IF LibSubdirName$(LibDisplayCount) <> "" THEN _ ' CALL QuickTPut1 (LibSubdirName$(LibDisplayCount) + _ ' "." + Extension$ + " ready for transmission!") ' NEXT ' EXIT SUB '21115 IF ZWasQ = 1 THEN _ ' ZOutTxt$ = "Change Library Book from " + _ ' Bh ' ZLibDiskChar$ + _ ' " to (1 -" + _ ' STR$(ZLibMaxDisk) + _ ' ")" : _ ' ZSubParm = 1 : _ ' CALL TGet : _ ' IF ZSubParm = -1 THEN _ ' EXIT SUB _ ' ELSE IF ZWasQ = 0 THEN _ ' ZLibDiskChar$ = "0000" : _ ' ChdirLib$ = ZLibDrive$ + _ ' "\" : _ ' GOTO 21126 '21117 IF VAL(ZUserIn$(ZWasQ)) < 1 OR VAL(ZUserIn$(ZWasQ)) > ZLibMaxDisk THEN _ ' ZWasQ = 1 : _ ' GOTO 21115 '21120 ZLibDiskChar$ = ZUserIn$(ZWasQ) ' CLOSE 2 ' ZLibDiskChar$ = RIGHT$("0000" + ZLibDiskChar$,4) '21121 CALL FindIt("RBBS-CDR.DEF") ' IF NOT ZOK THEN _ ' EXIT SUB '21122 IF EOF(2) THEN _ ' ZLibDiskChar$ = "" : _ ' EXIT SUB ' INPUT #2,WorkSubdir$,ChdirLib$ ' LINE INPUT #2,DiskTitle$ ' IF ZLibDiskChar$ = WorkSubdir$ THEN _ ' ChdirLib$ = ZLibDrive$ + _ ' ChdirLib$ : _ ' GOTO 21126 ' GOTO 21122 '21126 ZErrCode = 0 ' CALL ChangeDir (ChdirLib$) ' IF ZErrCode <> 0 THEN _ ' ZLibDiskChar$ = "0000" : _ ' ChdirLib$ = ZLibDrive$ + _ ' "\" : _ ' GOTO 21126 ' EXIT SUB '21130 IF ZLibType <> 1 THEN _ ' EXIT SUB ' CALL SkipLine(1) ' ZOutTxt$ = "HIS BOARD's Christian Library is being accessed. The file you " ' KG011001 ' Bh ' CALL QuickTPut1 (ZOutTxt$) ' ZOutTxt$ = "are about to download can also be ordered as BOOK " + _ ' KG011001 ' Bh ' ZLibDiskChar$ ' CALL QuickTPut1 (ZOutTxt$) ' ZOutTxt$ = "from HIS BOARD, P.O. Box 22, Ventura, CA 93002" ' Bh ' CALL QuickTPut (ZOutTxt$,2) ' EXIT SUB '21140 IF ZLibDiskChar$ = "0000" THEN _ ' CALL QuickTPut1 ("You must first Select a Library Book with the C command!") : _ ' KG011903 ' Bh ' EXIT SUB ' ZOutTxt$ = "Compress the contents of Library Book - " + _ ' KG011903 ' Bh ' ZLibDiskChar$ + _ ' " for faster downloading (Y/[N])" ' KG011903 ' Bh ' ZSubParm = 1 ' CALL TGet ' IF NOT ZLocalUser THEN _ ' IF ZSubParm = -1 THEN _ ' EXIT SUB ' IF NOT ZYes THEN _ ' EXIT SUB '21145 CALL KillWork (ZLibWorkDiskPath$ + _ ' ZLibNodeID$ + _ ' "BOOK*." + Extension$) ' AC100101 ' Bh '21150 CALL QuickTPut1 ("Work/RAM disk purged") ' CALL QuickTPut1 ("I'm now doing compression with " + _ ' KG011903 ' Bh ' ZLibArcProgram$ + _ ' " May take a few moments. Patience!") ' Bh ' REDIM LibSubdirName$(10) ' LibSubdirChar$ = "" ' LibLoopCount = 0 ' GOSUB 21157 ' ZOutTxt$ = "Contents of Library Book - " + _ ' Bh ' ZLibDiskChar$ + _ ' " now compressed and ready for you to D)ownload" ' KG011903 ' Bh ' CALL QuickTPut1 (ZOutTxt$) ' ZOutTxt$ = "Searching for Sub-directories" ' CALL QuickTPut1 (ZOutTxt$) ' GOSUB 21158 ' LibDiskArc$ = ZLibDiskChar$ '' '' SEARCH AND ARCHIVE ANY SUBDIRECTORIES '' ' Treedir$ = ZLibWorkDiskPath$ + _ ' ZLibNodeID$ + _ ' "DKDIR.LST" ' DirCmd$ = "DIR " + _ ' ZLibDrive$ + _ ' " | FIND " + _ ' CHR$(34) + _ ' " " + _ ' CHR$(34) + _ ' " > " + _ ' Treedir$ '21151 SHELL DirCmd$ ' CALL SkipLine (2) ' LOCATE 24,1 ' ZErrCode = 0 '21152 CLOSE 2 '21153 CALL OpenWork (2,Treedir$) ' LibSubdirCount = 0 ' WHILE NOT EOF(2) ' LINE INPUT #2, Dirrec$ ' IF LEFT$(Dirrec$,1) <> "." THEN _ ' LibSubdirCount = LibSubdirCount + 1 : _ ' LibSubdirName$(LibSubdirCount) = _ ' LEFT$(Dirrec$,8) ' WEND ' CLOSE 2 ' LibLoopCount = 1 ' IF LibSubdirCount = 0 THEN _ ' GOTO 21156 ' ZOutTxt$ = STR$(LibSubdirCount) + _ ' " Subdirectories belonging to Library Book - " + _ ' Bh ' ZLibDiskChar$ ' CALL QuickTPut1 (ZOutTxt$) ' FOR LibLoopCount = 1 TO LibSubdirCount ' IF NOT ZLocalUser THEN _ ' CALL Carrier : _ ' IF ZSubParm THEN _ ' GOTO 21155 ' LibSubdirChar$ = MID$("ABCDEFGHI",LibLoopCount,1) ' ZOutTxt$ = "Creating " + _ ' ZLibNodeID$ + _ ' "BOOK" + _ ' ZLibDiskChar$ + _ ' LibSubdirChar$ + "." + ZDefaultExtension$ + _ ' " using " + ZLibArcProgram$ ' CALL QuickTPut1 (ZOutTxt$) ' CHDIR ChdirLib$ + _ ' "\" + _ ' LibSubdirName$(LibLoopCount) ' GOSUB 21157 ' ZOutTxt$ = "Book - " + _ ' ZLibDiskChar$ + _ ' "; Subdirectory" + _ ' " -" + _ ' STR$(LibLoopCount) + _ ' " has been compressed and is ready for you to D)ownload" ' Bh ' KG011903 ' CALL QuickTPut1 (ZOutTxt$) ' GOSUB 21158 '21155 NEXT LibLoopCount '21156 CALL Carrier ' ZOutTxt$ = "" ' EXIT SUB '21157 LibArc$ = ZLibArcPath$ + _ ' ZLibArcProgram$ + _ ' " " + _ ' ZLibWorkDiskPath$ + _ ' ZLibNodeID$ + _ ' "BOOK" + _ ' Bh ' ZLibDiskChar$ + _ ' LibSubdirChar$ + _ ' " " + _ ' ZLibDrive$ + _ ' "*.* > gate1 " ' IF ZUseDeviceDriver$ <> "" AND ZFossil AND NOT ZLocalUser THEN _ ' LibArc$ = ZDiskForDos$ + _ ' "COMMAND /C " + _ ' LibArc$ + _ ' " > gate1 " + _ ' ZUseDeviceDriver$ ' SHELL LibArc$ ' CALL SkipLine (2) ' LOCATE 24,1 ' RETURN '21158 LibSubdirName$(LibLoopCount) = ZLibNodeID$ + _ ' "BOOK" + _ ' Bh ' ZLibDiskChar$ + _ ' LibSubdirChar$ ' RETURN '21159 FOR LibDisplayCount = 0 TO LibLoopCount - 1 ' IF LibSubdirName$(LibDisplayCount) = ZOutTxt$ THEN _ ' LibSubdirName$(LibDisplayCount) = "" ' NEXT ' END SUB ' 21598 ' $SUBTITLE: 'XferType - sub to identify file xfer protocol' ' $PAGE ' ' NAME -- XferType ' ' INPUTS -- PARAMETER MEANING ' Index = 1 Manual select for up/download ' = 2 Default select ' = 3 Set transfer default ' ZOutTxt$ ' ZUserIn$(1) ' ZWasQ ' ZReliableMode ' ZTransferOption$ ' ZUserXferDefault$ ' ZXferSupport ' ' OUTPUTS -- ZCheckSum ' ZFLen ' ZWasFT$ ' ' PURPOSE -- To identify the file transfer protocol (either ' from the user's default or via explicit selection) ' SUB XferType (Index,SkipHelp) STATIC IF ZTransferOption$ = "" OR ZUserSecLevel <> PrevUSL THEN _ CALL Protocol : _ PrevUSL = ZUserSecLevel WasX$ = ZOutTxt$ + "Protocol" ON Index GOTO 21600,21620,21600 ' ' ' * MANUAL SELECT OF Transfer Protocol ' ' 21600 IF SkipHelp THEN _ GOTO 21604 21602 CALL BufFile (ZHelpPath$ + "UF" + ZHelpExtension$,WasX) IF ZSubParm = -1 THEN _ EXIT SUB 21604 ZStopInterrupts = ZTrue IF Index = 3 THEN _ IF ZAnsIndex < ZLastIndex THEN _ GOTO 21605 CALL QuickTPut1 (WasX$) CALL BufString (ZTransferOption$,4096,WasX) CALL QuickTPut (MID$("?!",1-ZTurboKeyUser,1)+" ",0) 21605 ZOutTxt$ = "" ZTurboKey = -ZTurboKeyUser ZMacroMin = 2 ZSubParm = 1 ZSuspendAutoLogoff = ZTrue ZStackC = ZTrue IF Index = 3 THEN _ CALL PopCmdStack : _ WasX = ZAnsIndex _ ELSE ZSubParm = 1 : _ CALL TGet : _ WasX = 1 ZSuspendAutoLogoff = ZFalse IF ZSubParm = -1 THEN _ EXIT SUB IF ZWasQ = 0 THEN _ GOTO 21604 21606 ZWasZ$ = ZUserIn$(WasX) ' ' ' * DEFAULT SELECT OF Transfer Protocol ' ' 21610 CALL AllCaps (ZWasZ$) IF INSTR("H",ZWasZ$) > 0 THEN _ GOTO 21602 ZFF = INSTR(ZDefaultXfer$,ZWasZ$) IF ZFF < 1 THEN _ GOTO 21600 21612 ZWasFT$ = MID$(ZDefaultXfer$,ZFF,1) ZInternalProt$ = MID$(ZInternalEquiv$,ZFF,1) GOTO 21621 21620 ZFF = -1 IF ZCmdTransfer$ <> "" THEN _ ZWasZ$ = ZCmdTransfer$ : _ GOTO 21610 WasX = INSTR(ZDefaultXfer$,ZUserXferDefault$) IF WasX > 0 THEN _ IF MID$(ZInternalEquiv$,WasX,1) <> "N" THEN _ ZWasZ$ = ZUserXferDefault$ : _ GOTO 21610 ZProtoPrompt$ = "None" ZFF = 0 EXIT SUB 21621 IF ZFF = PrevFF AND PrevProtoDef$ = ZProtoDef$ THEN _ ZProtoPrompt$ = PrevProtoPrompt$ : _ EXIT SUB PrevFF = ZFF PrevProtoDef$ = ZProtoDef$ ZInternalProt$ = MID$(ZInternalEquiv$,ZFF,1) ZCheckSum = (ZInternalProt$ = "X") CALL FindIt (ZProtoDef$) IF ZOK THEN _ GOTO 21623 WasX = INSTR("AXCYN",ZInternalProt$) IF WasX < 1 THEN _ ZInternalProt$ = "N" ZProtoPrompt$ = MID$("Ascii Xmodem Xmodem/CRCYmodem None",10*INSTR("AXCYN",ZInternalProt$)-9,10) CALL TrimTrail (ZProtoPrompt$," ") ZCheckSum = (ZInternalProt$ = "X") ZFLen = 128 - 896 * (ZInternalProt$ = "Y") ZBlockSize = ZFLen IF ZInternalProt$ = "Y" THEN _ ZSpeedFactor! = 0.87 _ ELSE IF ZInternalProt$ = "A" THEN _ ZSpeedFactor! = 0.92 _ ELSE ZSpeedFactor! = 0.78 GOTO 21625 21623 CALL ReadParms (ZWorkAra$(),13,ZFF) IF ZErrCode > 0 THEN _ ZFF = LEN(ZDefaultXfer$) : _ ZProtoPrompt$ = "None" : _ GOTO 21625 ZProtoPrompt$ = ZWorkAra$(1) IF LEN(ZProtoPrompt$) > 2 THEN _ IF MID$(ZProtoPrompt$,2,1) = ")" THEN _ ZProtoPrompt$ = LEFT$(ZProtoPrompt$,1) + MID$(ZProtoPrompt$,3) WasX = INSTR(ZProtoPrompt$+ZCrLf$,ZCrLf$) ZProtoPrompt$ = LEFT$(ZProtoPrompt$,WasX-1) CALL Trim (ZProtoPrompt$) ZProtoMethod$ = LEFT$(ZWorkAra$(3),1) CALL AllCaps (ZProtoMethod$) ZReq8Bit = (LEFT$(ZWorkAra$(4),1) = "8") ZDownTemplate$ = ZWorkAra$(12) ZUpTemplate$ = ZWorkAra$(13) WasX$ = ZWorkAra$(11) WasX = INSTR(WasX$,"=") ZAdvanceProtoWrite = ZFalse IF WasX < 2 OR WasX >= LEN(WasX$) THEN _ ZFailureParm = 4 : _ ZFailureString$ = "F" _ ELSE ZFailureParm = VAL(LEFT$(WasX$,WasX-1)) : _ ZFailureString$ = MID$(WasX$,WasX+1) : _ WasX = INSTR(ZFailureString$,"=") : _ IF WasX > 0 THEN _ ZAdvanceProtoWrite = (MID$(ZFailureString$,WasX) = "=A") : _ ZFailureString$ = LEFT$(ZFailureString$,WasX-1) ZProtoMacro$ = ZWorkAra$(10) ZFakeXRpt = (LEFT$(ZWorkAra$(8),1) = "F") ZBatchProto = (LEFT$(ZWorkAra$(6),1) = "B") ZSpeedFactor! = VAL(ZWorkAra$(9)) IF ZSpeedFactor! < 0.1 THEN _ ZSpeedFactor! = 0.87 ZBlockSize = VAL(ZWorkAra$(7)) ZFLen = ZBlockSize IF ZFLen < 1 THEN _ ZFLen = 128 21625 PrevProtoPrompt$ = ZProtoPrompt$ END SUB ' Pe 02/04/90 30000 ' $SUBTITLE: 'InitIBM - sub to create/open NetBIOS semaphore file' ' $PAGE ' ' NAME -- InitIBM (Written by Doug Azzarito) ' ' INPUTS -- NONE ' ' OUTPUTS -- ZSubParm = -1 Abort RBBS ' ' PURPOSE -- Open semaphore file "IBMFLAGS" on default drive as file #6 ' Create file if it does not exits. ' SUB InitIBM STATIC ' ' ' * SEE IF FILE EXISTS ' ' ZShareIt = ZTrue CALL BreakFileName (ZMainMsgFile$,IBMFlagFile$,Dummy$,Dummy$,ZTrue) IBMFlagFile$ = IBMFlagFile$ + _ "IBMFLAGS" CALL FindIt (IBMFlagFile$) CLOSE 2 IF ZOK THEN _ GOTO 30020 ' ' ' * CREATE A NEW FILE, EACH RECORD IS A SEMAPHORE ' ' OPEN IBMFlagFile$ ACCESS WRITE AS #6 LEN=2 FIELD 6, 2 AS LockBuf$ LSET LockBuf$ = MKI$(0) FOR WasI = 1 TO 3 PUT 6 NEXT CLOSE #6 30020 OPEN IBMFlagFile$ ACCESS READ WRITE SHARED AS #6 LEN=2 END SUB 30500 ' $SUBTITLE: 'OpenMsg - open the MESSAGES file' ' $PAGE ' ' NAME -- OpenMsg ' ' INPUTS -- PARAMETER MEANING ' ZActiveMessageFile$ ' ZShareIt ' ' OUTPUTS -- ZMsgRec$ ' SUB OpenMsg STATIC ' ' ' * OPEN AND DEFINE MESSAGE FILE ' ' CLOSE 1 IF ZShareIt THEN _ OPEN ZActiveMessageFile$ ACCESS READ WRITE SHARED AS #1 _ ELSE OPEN "R",1,ZActiveMessageFile$ FIELD 1,128 AS ZMsgRec$ END SUB 30595 ' $SUBTITLE: 'FindFKey - sub to handle local keyboard functions' ' $PAGE ' ' NAME -- FindFKey ' ' INPUTS -- PARAMETER MEANING ' ZActiveMenu$ INDICATOR OF ACTIVE MENU ' ZAdjustedSecurity Switch INDICATING TEMP. SECURITY CHANGE ' ZAutoDownDesired USER'S PREFERENCE FOR AUTODOWNLOADING ' ZCallersFile$ NAME OF CALLERS FILE ' ZChatAvail Toggle INDICATING IF Sysop WILL CHAT ' ZCheckBulletLogon USER'S PREFERENCE FOR BULLETIN CHECK ' ZConfMode INDICATOR THAT USER IS IN A CONFERENCE ' ZCursorLine LINE THAT THE CURSOR IS AT ' ZCursorRow ROW THAT THE CURSOR IS AT ' ZDiskForDos$ DISK TO LOAD COMMAND.COM FROM ' ZDiskFullGoOffline INDICATOR OF WHAT TO DO WHEN DISK FULL ' ZExitToDoors FLAG INDICATING EXITING TO DOORS ' ZExpertUser FLAG FOR EXPERT/NOVICE USER MODE ' ZFirstName$ LOGGED ON USER'S First NAME ' ZF1Key FUNCTION KEY ONE VALUE ' ZF10Key FUNCTION KEY TEN VALUE ' ZWasGR GRAPHICS PREFERENCE OF USER ' ZLineFeeds SWTICH FOR USER'S LINE FEED PREFERENCE ' ZLocalUser FLAG INDICATING USER IS LOCAL ' ZMinLogonSec MINIMUM SECURITY TO LOGON ' ZModemGoOffHookCmd$ COMMAND TO TAKE MODEM OFF-HOOK ' ZModemInitBaud$ BAUD TO INITIALIZE MODEM AT ' ZNodeID$ NODE IDENTIFIER ' ZNodeRecIndex NODE RECORD Index FOR THIS NODE ' ZNulls Switch FOR USER'S PREFERENCE FOR Nulls ' ZPrinter Toggle INDICATING Printer IS AVAILABLE ' ZPromptBell USER'S PREFERENCE FOR BELLS ON PROMPTS ' SECONDS.PER.SESSION TIME LEFT IN CURRENT USER SESSION ' ZSkipFilesLogon USER'S LOGON NOTIFICIATION PREFERENCE ' ZSnoop Toggle INDICATING Snoop STATUS ' ZSubParm -8 = Sysop'S OPTION 6 REMOTELY ' -9 = GOT TO DOS ' -10 = Sysop GET'S SYSTEM NEXT ' ZSysop INDICATOR THAT USER IS Sysop ' ZSysopAnnoy Toggle INDICATING Sysop IS AVAILABLE ' ZSysopNext Toggle SO Sysop GETS SYSTEM NEXT ' ZUpperCase USER'S PREFERENCE FOR UPPER/LOWER CASE ' ZUserFileIndex Index INTO THE USER FILE FOR CALLER ' ZUserSecLevel USER'S SECURITY LEVEL ' USERT.TRANSFER.DEFAULT USER'S FILE Transfer DEFAULT PREFERENCE ' ' OUTPUTS -- ' ZAdjustedSecurity Switch INDICATING TEMP. SECURITY CHANGE ' ZChatAvail Toggle INDICATING IF Sysop WILL CHAT ' ZFunctionKey VALUE 1 TO 10 CORRESPONDING TO ' THE FUNCTION KEY THAT WAS PRESSED ' ZKeyPressed$ CHARACTER STRING GENERATED BY KEY ' ZPrinter TOGGLE INDICATING Printer IS AVAILABLE ' ZSnoop Toggle INDICATING Snoop STATUS ' ZSysop INDICATOR THAT USER IS Sysop ' ZSysopAnnoy Toggle INDICATING Sysop IS AVAILABLE ' ZSysopNext Toggle SO Sysop GETS SYSTEM NEXT ' ZSubParm -1 Carrier LOST ' -2 CHAT MODE ACTIVATED ' -3 FORCE CALLER ON-LINE ' -4 EXIT TO SYSTEM IMMEDIATELY ' -5 EXIT TO SYSTEM AFTER MULTI-LINK CALL ' -6 TELL USER ACCESS IS DENIED ' -7 UPDATE CALLERS FILE AND DENY ACCESS ' ZUserSecLevel USER'S SECURITY LEVEL ' ' PURPOSE -- To determine if a function has been pressed on ' the PC'S keyboard that is running RBBS-PC. ' SUB FindFKey STATIC LookUp = ZSubParm IF ZSubParm < -1 THEN _ ZSubParm = 0 : _ IF LookUp = - 8 THEN _ GOTO 33070 _ ELSE IF LookUp = - 9 THEN _ GOTO 31000 _ ELSE IF LookUp = - 10 THEN _ GOTO 33090 ' ' ' * TEST FOR FUNCTION KEY PRESSED ' ' 30600 IF ZKeyboardStack$ = "" THEN _ ZKeyPressed$ = INKEY$ _ ELSE ZKeyPressed$ = ZKeyboardStack$ : _ ZKeyboardStack$ = "" ZFunctionKey = 0 IF LEN(ZKeyPressed$) <> 2 THEN _ GOTO 33970 ZKeyPressed = ASC(RIGHT$(ZKeyPressed$,1)) ' IF ZLocalUser AND NOT ZSysop THEN _ ' ZKeyPressed$ = "" : _ ' GOTO 33970 IF ZKeyPressed => ZF1Key AND _ ZKeyPressed <= ZF10Key THEN _ ZFunctionKey = ZKeyPressed - 58 : _ GOTO 30610 IF ZKeyPressed = 117 THEN _ 'Ctrl-End ZFunctionKey = 11 IF ZKeyPressed = 73 THEN _ 'PgUp ZFunctionKey = 12 IF ZKeyPressed = 72 THEN _ 'up arrow ZFunctionKey = 13 IF ZKeyPressed = 80 THEN _ 'Down arrow ZFunctionKey = 14 IF ZKeyPressed = 81 THEN _ 'PgDn ZFunctionKey = 15 IF ZKeyPressed = 75 THEN _ 'left arrow ZFunctionKey = 16 IF ZKeyPressed = 77 THEN _ 'Right arrow ZFunctionKey = 17 IF ZKeyPressed = 141 THEN _ 'CTRL-up arrow ZFunctionKey = 18 IF ZKeyPressed = 132 THEN _ 'CTRL-PgUp (same as CTRL-UP) ZFunctionKey = 18 IF ZKeyPressed = 145 THEN _ 'CTRL-down arrow ZFunctionKey = 19 IF ZKeyPressed = 118 THEN _ 'CTRL-PgDn (same as CTRL-DOWN) ZFunctionKey = 19 IF ZKeyPressed = 115 THEN _ 'CTRL-left arrow ZFunctionKey = 20 IF ZKeyPressed = 116 THEN _ 'CTRL-right arrow ZFunctionKey = 21 IF ZKeyPressed = 79 THEN _ 'End (a nice way to kick user off) ZFunctionKey = 22 30610 ZKeyPressed$ = "" IF ZFunctionKey < 1 OR ZFunctionKey > 22 THEN _ GOTO 33970 IF ZFunctionKey < 10 AND (ZFunctionKey <> 8) THEN _ GOTO 30620 IF ZToggleOnly THEN _ ZSubParm = 1 : _ GOTO 33970 30620 ON ZFunctionKey GOTO 31000, _ ' 1 = F1 32000, _ ' 2 = F2 33000, _ ' 3 = F3 33040, _ ' 4 = F4 33060, _ ' 5 = F5 33070, _ ' 6 = F6 33090, _ ' 7 = F7 33110, _ ' 8 = F8 33130, _ ' 9 = F9 33150, _ ' 10 = F10 31398, _ ' 11 = CTRL END 33200, _ ' 12 = PGUP 33170, _ ' 13 = UP ARROW 33180, _ ' 14 = DOWN ARROW 33220, _ ' 15 = PGDN 33240, _ ' 16 = LEFT ARROW 33250, _ ' 17 = RIGHT ARROW 33170, _ ' 18 = CTRL-UP ARROW 33180, _ ' 19 = CTRL-DOWN 33245, _ ' 20 = CTRL-LEFT 33255, _ ' 21 = CTRL-RIGHT 31398 ' 22 = END ' ' ' * F1 - COMMAND FROM LOCAL KEYBOARD (IMMEDIATE EXIT TO DOS) ' ' 31000 ZSubParm = -10 CALL Carrier IF ZSubParm = 0 THEN _ GOTO 33970 ZFileName$ = ZNodeWorkDrvPath$ + "RBBS" + ZNodeFileID$ + "F1.DEF" CLOSE 2 CALL OpenOutW (ZFileName$) PRINT #2,MID$(ZFileName$,3,7) IF ZExitToDoors THEN _ ZSubParm = -4 : _ GOTO 33970 CALL OpenCom(ZModemInitBaud$,",N,8,1") CALL TakeOffHook ZSubParm = -5 GOTO 33970 ' ' ' * END KEY - FORCE CURRENT USER OFF AND LOCK THEM OUT ' ' 31398 IF NOT ZLocalUser THEN _ CALL Carrier : _ IF ZSubParm = -1 THEN _ GOTO 33970 IF INSTR("MUF",ZActiveMenu$) > 0 THEN _ GOTO 31399 ZCursorLine = CSRLIN ZCursorRow = POS(0) LOCATE 25,1 WasD$ = SPACE$(79) GOSUB 33210 LOCATE 25,1 WasD$ ="Cannot FORCE OFF until user reaches MAIN menu" GOSUB 33210 CALL DelayTime (1) LOCATE ZCursorLine,ZCursorRow ZSubParm = 1 CALL Line25 GOTO 33970 31399 IF ZFunctionKey = 22 THEN _ CALL SkipLine (2) : _ CALL QuickTPut1 ("Sorry, " + ZFirstName$ + ", SYSOP needs the system.") : _ CALL DelayTime (8 + ZBPS) : _ ZSubParm = -6 : _ GOTO 33970 CALL QuickTPut1 (ZFirstName$ + ", goodbye and don't call back") CALL DelayTime (8 + ZBPS) : _ IF ZUserFileIndex < 1 THEN _ ZSubParm = -6 : _ GOTO 33970 ZUserSecLevel = ZMinLogonSec - 1 CALL DenyAccess ZSubParm = -7 GOTO 33970 ' ' ' * F2 - COMMAND FROM LOCAL KEYBOARD (SYSOP EXIT TO DOS AND RETURN) ' ' 32000 IF NOT ZLocalUser THEN _ CALL SkipLine (1) : _ CALL QuickTPut1 ("Sysop exiting to DOS. Please wait...") : _ ZFunctionKey = 0 : _ CALL DelayTime (3) CALL ShellExit (ZDiskForDos$ + "COMMAND") CLS IF NOT ZLocalUser THEN _ CALL Carrier : _ IF ZSubParm = -1 THEN _ GOTO 33970 ZSubParm = 2 CALL Line25 CALL QuickTPut1 ("Sysop back from DOS. Returning control to you.") ZCommPortStack$ = ZCarriageReturn$ GOTO 33970 ' ' ' * F3 - COMMAND FROM LOCAL KEYBOARD (Printer Toggle) ' ' 33000 ZPrinter = NOT ZPrinter ChangeValue = ZPrinter FieldPosition = 38 GOTO 33950 ' ' ' * F4 - COMMAND FROM LOCAL KEYBOARD (Sysop ANNOY) ' ' 33040 ZSysopAnnoy = NOT ZSysopAnnoy ChangeValue = ZSysopAnnoy FieldPosition = 34 GOTO 33950 ' ' ' * F5 - COMMAND FROM LOCAL KEYBOARD (FORCE CALLER ONLINE) ' ' 33060 ZFunctionKey = 0 ZSubParm = -3 GOTO 33970 ' ' ' * F6 - COMMAND FROM LOCAL KEYBOARD (Sysop AVAILABLE Toggle) ' * 6 - COMMAND FROM Sysop MENU (Sysop AVAILABLE Toggle) ' ' 33070 ZSysopAvail = NOT ZSysopAvail ChangeValue = ZSysopAvail FieldPosition = 32 GOTO 33950 ' ' ' * F7 - COMMAND FROM LOCAL KEYBOARD (Sysop GETS SYSTEM NEXT) ' ' 33090 IF ERR=61 AND NOT ZDiskFullGoOffline THEN _ GOTO 33970 ZSysopNext = NOT ZSysopNext ChangeValue = ZSysopNext FieldPosition = 36 GOTO 33950 ' ' ' * F8 - COMMAND FROM LOCAL KEYBOARD (ASSIGN USER TEMPORARY Sysop SECURITY) ' ' 33110 ZSysop = NOT ZSysop ZCursorLine = CSRLIN ZCursorRow = POS(0) LOCATE 25,1 WasD$ = SPACE$(79) NumReturns = 0 CALL LPrnt (WasD$,NumReturns) LOCATE 25,1 ZUserSecLevel = (1 + ZSysop) * _ ZUserSecSave - _ ZSysop * _ ZSysopSecLevel WasD$ = "Sysop Privileges " + FNOffOn$(ZSysop) CALL LPrnt (WasD$,NumReturns) CALL DelayTime (3) LOCATE ZCursorLine,ZCursorRow ZSubParm = 1 CALL Line25 CALL SetPrompt GOTO 33970 ' ' ' * F9 - COMMAND FROM LOCAL KEYBOARD (Snoop Toggle) ' ' 33130 IF NOT ZSnoop THEN _ ZSnoop = ZTrue : _ LOCATE 24,1,0 : _ WasD$ = "SNOOP ON" : _ NumReturns = 0 : _ CALL LPrnt (WasD$,NumReturns) : _ ZSubParm = 2 : _ CALL Line25 _ ELSE LOCATE ,,0 : _ ZSnoop = ZFalse : _ CLS 33140 ChangeValue = ZSnoop FieldPosition = 58 GOTO 33950 ' ' ' * F10 - COMMAND FROM LOCAL KEYBOARD (FORCE CHAT WITH USER) ' ' 33150 GOTO 33160 33155 ZSubParm = 1 CALL Line25 GOTO 33970 33160 CALL UpdtCalr ("Sysop began chat",1) ZPageStatus$ = "" CALL SkipLine (1) CALL QuickTPut1 ("Hello there " + _ ' Bh ZFirstName$ + _ ", this is " + _ ZSysopFirstName$ + _ " " + _ ZSysopLastName$ + _ " Mind if I interrupt a sec?") ' Bh CALL TimeBack (1) CALL SysopChat CALL TimeBack (2) ZCommPortStack$ = CHR$(13) GOTO 33155 ' ' ' * UP / CTRL-UP: INCREASE THE ON-LINE USER'S SECURITY BY ONE / FIVE ' ' 33170 ZUserSecLevel = ZUserSecLevel + _ 1 - 4 * (ZFunctionKey = 18) GOTO 33190 ' ' ' * DOWN / CTRL-DOWN: DECREASE THE ON-LINE USER'S SECURITY BY ONE / FIVE ' ' 33180 ZUserSecLevel = ZUserSecLevel - _ 1 + 4 * (ZFunctionKey = 19) 33190 ZAdjustedSecurity = ZTrue ZUserSecSave = ZUserSecLevel IF (NOT ZConfMode) AND (NOT SubBoard) THEN _ ZOrigSec = ZUserSecLevel : _ ZSubParm = 2 CALL Line25 CALL SetPrompt GOTO 33970 ' ' ' * PGUP DISPLAY USER PROFILE ' ' 33200 IF NOT ZLocalUser THEN _ CALL Carrier : _ IF ZSubParm = -1 THEN _ GOTO 33970 IF ZVoiceType <> 0 THEN _ ZTalkAll = ZTrue CALL PageUp WasD$ = MID$("NoviceExPERT",1 -6 * ZExpertUser,6) GOSUB 33210 WasD$ = "GRAPHICS: " + _ MID$("None AsciiColor",ZWasGR * 5 + 1,5) GOSUB 33210 WasD$ = "Protocol : " + _ ZUserXferDefault$ GOSUB 33210 WasD$ = "UPPER CASE " + _ MID$("and lowerONLY", 1 - 9 * ZUpperCase,9) GOSUB 33210 WasD$ = "Line Feeds " + FNOffOn$(ZLineFeeds) GOSUB 33210 WasD$ = "Nulls " + FNOffOn$(ZNulls) GOSUB 33210 WasD$ = "Prompt Bell " + FNOffOn$(ZPromptBell) GOSUB 33210 WasD$ = MID$("SKIP CHECK",1 -5 * ZCheckBulletLogon,5) + _ " old BULLETINS on logon." GOSUB 33210 WasD$ = MID$("CHECKSKIP ",1 -5 * ZSkipFilesLogon,5) + _ " new files on logon." GOSUB 33210 WasD$ = "Autodownload " + FNOffOn$(ZAutoDownDesired) GOSUB 33210 ZTalkAll = ZFalse GOTO 33970 33210 NumReturns = 1 CALL LPrnt(WasD$,NumReturns) RETURN ' ' ' * PGDN CLEAR DISPLAY OF USER'S PROFILE ' ' 33220 IF NOT ZLocalUser THEN _ CALL Carrier : _ IF ZSubParm = -1 THEN _ GOTO 33970 CLS GOTO 33155 ' ' ' * LEFT ARROW - DECREASE THE ON-LINE USER'S TIME BY ONE MINUTE ' ' 33240 IF ZSecsPerSession! > 120 THEN _ ZSecsPerSession! = ZSecsPerSession! - 60 GOTO 33970 ' ' ' * CTRL-LEFT ARROW - DECREASE THE ON-LINE USER'S TIME BY FIVE MINUTES ' ' 33245 IF ZSecsPerSession! > 360 THEN _ ZSecsPerSession! = ZSecsPerSession! - 300 GOTO 33970 ' ' ' * RIGHT ARROW - INCREASE THE ON-LINE USER'S TIME BY ONE MINUTE ' ' 33250 IF ZSecsPerSession! < 86280 THEN _ ZSecsPerSession! = ZSecsPerSession! + 60 ZTimeLockSet = 0 GOTO 33970 ' ' ' * CTRL-RIGHT ARROW - INCREASE THE ON-LINE USER'S TIME BY FIVE MINUTES ' ' 33255 IF ZSecsPerSession! < 86040 THEN _ ZSecsPerSession! = ZSecsPerSession! + 300 ZTimeLockSet = 0 GOTO 33970 ' ' ' * UPDATE NODE RECORD WITH LOCAL FUNCTION KEY ACTIVITY ' ' 33950 IF ZSnoop THEN _ ZSubParm = 1 : _ CALL Line25 33960 IF ZConfMode = ZTrue THEN _ IF ZLocalUser THEN _ GOTO 33970 _ ELSE WasD$ = "Cannot change status during Conference!" : _ GOSUB 33210 : _ GOTO 33970 ZSubParm = 3 CALL FileLock IF ZSubParm = -1 THEN _ GOTO 33970 CALL OpenMsg FIELD 1,128 AS ZMsgRec$ GET 1,ZNodeRecIndex MID$(ZMsgRec$,FieldPosition,2) = STR$(ChangeValue) CALL SaveProf (2) FIELD 1, 128 AS ZMsgRec$ 33970 IF ZFunctionKey < 22 AND ZFunctionKey > 15 THEN _ 'DGS-L25MOD MinsRemaining = (ZSecsPerSession! - ZSecsUsedSession!) / 60 : _ 'DGS-L25 CALL Line25 'DGS-L25 END SUB 'DGS-L25MOD 33990 ' $SUBTITLE: 'PageUp - Display user profile to Sysop' ' $PAGE ' ' NAME -- PageUp ' ' INPUTS -- PARAMETER MEANING ' ZActiveUserName$ CURRENT USER NAME ' ZDnlds # OF FILES DOWNLOADED ' ZExpirationDate$ REGISTRATION EXPIRATION ' ZLastDateTimeOnSave$ Last DATE & TIME ON SYSTEM ' ZLastMsgRead Last MESSAGE READ BY USER ' ZPswdSave$ USERS PASSWORD ' ZTimesLoggedOn TIMES USER HAS LOGGED ON ' ZUplds # OF FILES UPLOADED ' ZUserSecSave USERS SECURITY LEVEL ' ' OUTPUTS -- ZMsgRec$ ' SUB PageUp STATIC CALL LPrnt (" ",1) CALL LPrnt ("USER NAME : " + ZActiveUserName$,1) CALL LPrnt ("SECURITY :" + STR$(ZUserSecSave),1) CALL LPrnt ("PASSWORD :" + ZPswdSave$,1) CALL LPrnt ("READ MSG. :" + STR$(ZLastMsgRead),1) CALL LPrnt ("TIMES ON :" + STR$(ZTimesLoggedOn),1) CALL LPrnt ("LAST ON :" + ZLastDateTimeOnSave$,1) CALL LPrnt ("DOWNLOADS :" + STR$(ZDnlds),1) CALL LPrnt ("UPLOADS :" + STR$(ZUplds),1) CALL LPrnt ("DL-BYTES :" + STR$(ZDLBytes!),1) 'Pe 02/05/90 CALL LPrnt ("UL-BYTES :" + STR$(ZULBytes!),1) IF ZRestrictByDate THEN _ CALL LPrnt ("EXPIRATION: " + ZExpirationDate$,1) CALL LPrnt ("User's Profile",1) END SUB 35000 ' $SUBTITLE: 'FlushKeys - Completely flush all user input' ' $PAGE ' ' NAME -- FlushKeys ' SUB FlushKeys STATIC CALL FlushCom (ZWasY$) ZAnsIndex = 0 ZLastIndex = 0 REDIM ZUserIn$(ZMsgDim) END SUB 41008 ' $SUBTITLE: 'CheckTimeRemain - Kicks off if no time remaining' ' $PAGE ' ' NAME -- CheckTimeRemain ' ' INPUTS -- PARAMETER MEANING ' ' OUTPUTS -- PARAMETER MEANING ' MinsRemaining TIME IN MINUTES LEFT IN SESSION ' ZSecsUsedSession! TIME USED IN SECONDS ' ZSubParm -1 IF No TIME LEFT ' SUB CheckTimeRemain (MinsRemaining) STATIC CALL TimeRemain (MinsRemaining) IF ZBypassTimeCheck THEN _ EXIT SUB IF MinsRemaining <= 0 THEN _ ZSubParm = -1 IF DGSCurrHour = 1 THEN _ CALL QuickTPut ("Sorry " + ZFirstName$ + _ 'DGS-BRM " Board Access Restricted During Current Hours",1) 'DGS-BRM END SUB 41010 ' $SUBTITLE: 'TimeRemain - calculates time remaining in a session' ' $PAGE ' ' NAME -- TimeRemain ' ' INPUTS -- PARAMETER MEANING ' ZUserLogonTime! WHEN DID THE CALLER GET HERE ' ZSecsPerSession! HOW LONG MAY THE CALLER STAY ON ' ZTimeToDropToDos! WHEN ARE WE DOING OUR DAILY EVENT ' ZBypassTimeCheck DO WE CARE HOW LONG THEY CAN STAY ' ' OUTPUTS -- PARAMETER MEANING ' MinsRemaining TIME IN MINUTES LEFT IN SESSION ' ZSecsUsedSession! TIME USED IN SECONDS ' SUB TimeRemain (MinsRemaining) STATIC TOA! = FRE("A") IF ZBypassTimeCheck THEN _ MinsRemaining = ZSecsPerSession! / 60 : _ EXIT SUB CALL CheckTime (ZUserLogonTime!, ZSecsUsedSession!, 2) IF ZTimeToDropToDos! = 0 OR _ ZOldDate$ = DATE$ THEN _ GOTO 41020 CALL CheckTime (ZTimeToDropToDos!, HowMuchTimeLeft!, 1) IF (ZSecsPerSession! - ZSecsUsedSession!) _ > HowMuchTimeLeft! THEN _ ZSecsPerSession! = HowMuchTimeLeft! + _ ZSecsUsedSession! : _ IF NOT ToldShort THEN _ ToldShort = ZTrue : _ ZOutTxt$ = "Time shortened for scheduled event" : _ CALL RingCaller : _ 'DGS-014Mod CALL UpdtCalr ("Notified - Time Cut for Scheduled Event",1) 'DGS-014 41020 MinsRemaining = (ZSecsPerSession! - ZSecsUsedSession!) / 60 END SUB 41032 ' $SUBTITLE: 'DispTimeRemain - Display users time remaining' ' $PAGE ' ' NAME -- DispTimeRemain ' ' INPUTS -- PARAMETER MEANING ' MinsRemaining ' ' OUTPUTS -- PARAMETER MEANING ' MinsRemaining TIME IN MINUTES LEFT IN SESSION ' SUB DispTimeRemain (MinsRemaining) STATIC CALL TimeRemain (MinsRemaining) CALL QuickTPut1 (STR$(MinsRemaining) + " min left") CALL Line25 'DGS-008 END SUB 41498 ' $SUBTITLE: 'AMorPM - give time of day in AM/PM format' ' $PAGE ' ' NAME -- AMorPM ' ' INPUTS -- PARAMETER MEANING ' ' OUTPUTS -- ZCurDate$ CURRENT DATE (MM-DD-YY) ' ZTime$ CURRENT TIME (I.E. 1:13 PM) ' ' PURPOSE -- To set the time and date and ' describe the time as "AM" or "PM." ' SUB AMorPM STATIC ' ' ' * CALCULATE CURRENT TIME FOR AM OR PM ' ' 41500 ZCurDate$ = DATE$ ZCurDate$ = LEFT$(ZCurDate$ ,6) + _ RIGHT$(ZCurDate$ ,2) 41510 ZTime$ = TIME$ IF VAL(MID$(ZTime$,1,2)) = 12 THEN _ MID$(ZTime$,1,2) = RIGHT$(STR$(VAL(MID$(ZTime$,1,2))),2) : _ ZTime$ = LEFT$(ZTime$,5) + _ " PM" : _ EXIT SUB IF VAL(MID$(ZTime$,1,2)) > 11 THEN _ MID$(ZTime$,1,2) = RIGHT$(STR$(VAL(MID$(ZTime$,1,2))-12),2) : _ ZTime$ = LEFT$(ZTime$,5) + _ " PM" : _ EXIT SUB ZTime$ = LEFT$(ZTime$,5) + _ " AM" END SUB 42000 ' $SUBTITLE: 'Carrier - sub to monitor carrier on comm. port' ' $PAGE ' ' NAME -- Carrier ' ' INPUTS -- PARAMETER MEANING ' ZAutoLogoffReq -1 if in autologoff request ' ' OUTPUTS -- ZSubParm = 0 CONTINUE ' ZSubParm = -1 TERMINATE (No Carrier) ' ' PURPOSE -- To test whether should continue in RBBS. Reasons ' NOT to continue are: autologoff, out of time, or ' carrier dropped. ' SUB Carrier STATIC IF ZAutoLogoffReq THEN _ IF NOT ZSuspendAutologoff THEN _ ZSubParm = -1 : _ EXIT SUB CALL CheckCarrier END SUB 42005 ' $SUBTITLE: 'CheckCarrier - monitors carrier on comm. port' ' $PAGE ' ' NAME -- CheckCarrier ' ' INPUTS -- PARAMETER MEANING ' ZLocalUser = 0 REMOTE USER ' ZLocalUser = -1 LOCAL KEYBOARD USER ' ZModemStatusReg ADDRESS OF THE COMMUNI- ' CATIONS PORT'S REGISTER ' ZSubParm = -9 DON'T WRITE TO CALLERS ' ZSubParm = -10 SAME AS -9, BUT DON'T ' DELAY ' ' OUTPUTS -- ZSubParm = 0 Carrier STILL PRESENT ' ZSubParm = -1 Carrier NOT PRESENT ' ' PURPOSE -- To test if carrier is present (i.e. the user ' is still on line). Ignores whether in autologoff. ' SUB CheckCarrier STATIC IF ZSubParm = -1 THEN _ EXIT SUB Speedy = ZSubParm ZSubParm = 0 IF ZLocalUser THEN _ EXIT SUB 42010 IF INP(ZModemStatusReg) > 127 THEN _ EXIT SUB ' ' ' * IN CASE USER IS 2400 BAUD, PAUSE A SECOND AND CHECK AGAIN FOR Carrier ' * DETECT. SOME 2400 BAUD MODEMS TAKE A WHILE TO SYNCHRONIZE THE Carrier, ' * HENCE A THREE-SECOND PAUSE BEFORE CHECKING AGAIN. ' ' 42015 IF Speedy = -10 THEN _ GOTO 42020 CALL DelayTime (ZModemInitWaitTime) IF INP(ZModemStatusReg) > 127 THEN _ EXIT SUB 42020 ZSubParm = -1 IF Speedy < -8 THEN _ EXIT SUB IF AlreadyWritten = -9 THEN _ EXIT SUB CALL TakeOffHook ZModemOffHook = -1 AlreadyWritten = -9 CALL UpdtCalr ("Carrier dropped",1) END SUB 43004 ' $SUBTITLE: 'AskGraphics -- sub to ask users graphic preference' ' $PAGE ' ' NAME -- AskGraphics ' ' INPUTS -- PARAMETER MEANING ' ZUserGraphicDefault$ USER Graphic DEFAULT ' ' OUTPUTS -- ' ' PURPOSE -- To determine users graphics default ' SUB AskGraphics STATIC IF ZExpertUser THEN _ GOTO 43007 43006 ZFileName$ = ZHelp$(9) CALL BufFile (ZFileName$,WasX) IF ZSubParm = -1 THEN _ EXIT SUB 43007 CALL QuickTPut1 ("GRAPHICS for text files and menus") ZOutTxt$ = "Change from " + MID$("NAC",ZWasGR+1,1) + " to N)one, A)scii-IBM, C)olor-IBM, H)elp" + ZPressEnterExpert$ ZSubParm = 1 ZTurboKey = -ZTurboKeyUser CALL TGet IF ZSubParm = -1 THEN _ EXIT SUB IF ZWasQ = 0 THEN _ CALL QuickTPut1 ("Unchanged") : _ EXIT SUB CALL AllCaps (ZUserIn$(1)) ZWasGR = INSTR("NAC",ZUserIn$(1)) IF ZWasGR = 2 AND NOT ZEightBit THEN _ CALL QuickTPut1 ("Ascii unavailable. Requires 8 bit") : _ GOTO 43007 IF ZWasGR = 0 THEN _ GOTO 43006 ZWasGR = ZWasGR - 1 CALL SetGraphic (ZWasGR,ZUserGraphicDefault$) END SUB ' 43031 ' $SUBTITLE: 'GraphicX - sub to find graphic version of a file' ' $PAGE ' ' NAME -- GraphicX ' ' INPUTS -- PARAMETER MEANING ' Default$ USERS Graphic DEFAULT ' ZWasGR WHETHER GRAPHICS ARE AVAILABLE ' FilName$ FILE TO CHECK ' FileNum # of file to use ' ' OUTPUTS -- FilName$ SUBSTITUTES NAME OF GRAPHICS ' FILE (IF IT EXISTS). ' ' PURPOSE -- Checks whether there is a graphics version of ' a file, based on users graphics perference. ' Sets file name to graphics file if it exists, ' Otherwise leaves file name intact. Returns file ' name to use. ' SUB GraphicX (Default$,FilName$,FileNum) STATIC ZOK = ZFalse IF ZWasGR THEN _ CALL BreakFileName (FilName$,DR$,WasX$,Extension$,ZTrue) : _ IF LEN(WasX$) < 8 THEN _ ZWasDF$ = DR$ + _ WasX$ + _ Default$ + _ Extension$ : _ CALL FINDITX (ZWasDF$,FileNum) : _ IF ZOK THEN _ FilName$ = ZWasDF$ : _ IF Default$ = "C" THEN _ ZLinesPrinted = 0 IF NOT ZOK THEN _ CALL FINDITX (FilName$,FileNum) END SUB ' Sets Graphic version but uses file # 2 always SUB Graphic (Default$,FilName$) STATIC CALL GraphicX (Default$,FilName$,2) END SUB 43068 ' $SUBTITLE: 'SaveProf - subroutine to read a user profile' ' $PAGE ' ' NAME -- SaveProf ' ' INPUTS -- PARAMETER MEANING ' ZBPS ' ZEightBit ' ZExitToDoors ' ZWasGR ' ZMsgRec$ ' ZNodeRecIndex ' ZSysop ' ZUpperCase ' ZTimeLoggedOn$ ' ZPrivateDoor ' ZReliableMode ' ' OUTPUTS -- NONE ' ' PURPOSE -- Saves a user's options and communications parameters ' in the node record when a user exits to a "door" so ' that he is in the same status as when he exited. ' SUB SaveProf (IParm) STATIC ON IParm GOTO 43070,43080 43070 ZActiveMessageFile$ = ZOrigMsgFile$ ZSubParm = 3 CALL FileLock CALL OpenMsg FIELD 1, 128 AS ZMsgRec$ GET 1,ZNodeRecIndex IF ZGlobalSysop THEN _ MID$(ZMsgRec$,1,30) = "SYSOP" + SPACE$(25) MID$(ZMsgRec$,40,2) = STR$(ZExitToDoors) MID$(ZMsgRec$,42,2) = STR$(ZEightBit) MID$(ZMsgRec$,44,2) = STR$(ZBPS) MID$(ZMsgRec$,46,2) = STR$(ZUpperCase) MID$(ZMsgRec$,48,5) = MKS$(ZNumDnldBytes!) + MID$(STR$(-ZBatchTransfer),2) 'Pe 02/16/90 MID$(ZMsgRec$,53,2) = STR$(ZWasGR) MID$(ZMsgRec$,55,2) = STR$(ZSysop) MID$(ZMsgRec$,65,3) = CHR$(VAL(LEFT$(ZTimeLoggedOn$,2))) + _ CHR$(VAL(MID$(ZTimeLoggedOn$,4,2))) + _ CHR$(VAL(MID$(ZTimeLoggedOn$,7,2))) MID$(ZMsgRec$,72,2) = STR$(ZPrivateDoor) MID$(ZMsgRec$,74,1) = MID$(STR$(ZTransferFunction),2,1) MID$(ZMsgRec$,75,1) = ZWasFT$ MID$(ZMsgRec$,113,2) = MKI$(CINT(ZTimeCredits!)/60) MID$(ZMsgRec$,79,8) = LEFT$(ZDooredTo$+" ",8) MID$(ZMsgRec$,91,2) = STR$(ZReliableMode) CALL BreakFileName (ZCurPUI$,ZOutTxt$,ZUserIn$,ZWasZ$,ZFalse) MID$(ZMsgRec$,93,8) = ZUserIn$ + SPACE$(8 - LEN(ZUserIn$)) IF ZLocalUser THEN _ ZWasZ$ = ZCarriageReturn$ + ZCarriageReturn$ _ ' KG030601 ELSE ZWasZ$ = " 0" ' KG030601 MID$(ZMsgRec$,101,2) = ZWasZ$ ' KG030601 MID$(ZMsgRec$,103,2) = STR$(ZLocalUserMode) ' KG030601 ZConfName$ = LEFT$(ZConfName$,INSTR(ZConfName$ + " "," ") - 1) MID$(ZMsgRec$,105,8) = ZConfName$ + SPACE$(8 - LEN(ZConfName$)) MID$(ZMsgRec$,115,1) = MID$(STR$(ZAutoLogoffReq),2,1) MID$(ZMsgRec$,117,2) = STR$(ZMenuIndex) MID$(ZMsgRec$,119,2) = LEFT$(DATE$,2) MID$(ZMsgRec$,121,2) = MID$(DATE$,4,2) MID$(ZMsgRec$,123,2) = RIGHT$(DATE$,2) MID$(ZMsgRec$,125,2) = LEFT$(TIME$,2) MID$(ZMsgRec$,127,2) = MID$(TIME$,4,2) ' *** Save additional parameters for door restoral CALL OpenOutW (ZNodeWorkDrvPath$+"DRST"+ZNodeFileID$+".DEF") CALL PrintWorkA (STR$(ZLimitMinsPerSession)) CLOSE 2 43080 PUT 1,ZNodeRecIndex ZSubParm = 2 CALL FileLock CALL OpenMsg END SUB 44000 ' $SUBTITLE: 'ReadProf - subroutine to restore a user profile' ' $PAGE ' ' NAME -- ReadProf ' ' INPUTS -- PARAMETER MEANING ' ZNodeRecIndex NODE RECORD TO USE ' ZSysopPswd1$ Sysop'S PSEUDONYM 1 ' ZSysopPswd2$ Sysop'S PSEUDONYM 2 ' ' OUTPUTS -- USER'S OPTIONS AND COMMUNICATIONS PARAMETERS ' UPON EXITING RBBS-PC TO A "DOOR" ' ' PURPOSE -- Reset a user's options and communications parameters ' that were saved in the node record when a user exited ' to a "door" so that he is in the same status as when ' he exited. ' SUB ReadProf STATIC FIELD 1, 128 AS ZMsgRec$ GET 1,ZNodeRecIndex ZReliableMode = VAL(MID$(ZMsgRec$,91,2)) MID$(ZMsgRec$,40,2) = "00" ZEightBit = VAL(MID$(ZMsgRec$,42,2)) ZBPS = VAL(MID$(ZMsgRec$,44,2)) CALL CommInfo ZBaudTest! = VAL(MID$(ZBaudRates$,(-5 * ZBPS),5)) ZUpperCase = VAL(MID$(ZMsgRec$,46,2)) ZNumDnldBytes! = CVS(MID$(ZMsgRec$,48,4)) 'Pe 02/16/90 ZBatchTransfer = (MID$(ZMsgRec$,52,1) = "1") ZWasGR = VAL(MID$(ZMsgRec$,53,2)) HourLoggedOn$ = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,65,1))),2),2) MinLoggedOn$ = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,66,1))),2),2) SecLoggedOn$ = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,67,1))),2),2) ZTimeLoggedOn$ = HourLoggedOn$ + _ ":" + _ MinLoggedOn$ + _ ":" + _ SecLoggedOn$ ZTransferFunction = VAL(MID$(ZMsgRec$,74,1)) ZWasFT$ = MID$(ZMsgRec$,75,1) ZTimeCredits! = 60!*CVI(MID$(ZMsgRec$,113,2)) 'KKG030901 ZDooredTo$ = MID$(ZMsgRec$,79,8) CALL Trim (ZDooredTo$) IF ZExitToDoors AND ZDooredTo$ <> "" THEN _ CALL OpenWork (2,ZDoorsDef$) : _ IF ZErrCode = 0 THEN _ CALL ReadParms (ZOutTxt$(),8,1) : _ WHILE ZErrCode = 0 AND ZOutTxt$(1) <> ZDooredTo$ : _ CALL ReadParms (ZOutTxt$(),8,1) : _ WEND : _ IF ZOutTxt$(1) = ZDooredTo$ THEN _ ZDoorSkipsPswd = (ZOutTxt$(6) <> "Y") : _ CALL BufFile (ZOutTxt$(7),WasX) ZErrCode = 0 ZMenuIndex = VAL(MID$(ZMsgRec$,117,2)) ZCurPUI$ = MID$(ZMsgRec$,93,8) CALL Remove (ZCurPUI$," ") IF ZCurPUI$ <> "" THEN _ CALL BreakFileName (ZMainPUI$,ZOutTxt$,ZUserIn$,ZWasZ$,ZTrue) : _ ZCurPUI$ = ZOutTxt$ + ZCurPUI$ + ZWasZ$ ZCustomPUI = (ZCurPUI$ <> "") ZLocalUser = (MID$(ZMsgRec$,101,2) = ZCarriageReturn$ + ZCarriageReturn$) ' KG030601 ZLocalUserMode = VAL(MID$(ZMsgRec$,103,2)) ZHomeConf$ = MID$(ZMsgRec$,105,8) ZAutoLogoffReq = (VAL(MID$(ZMsgRec$,115,1)) <> 0) CALL Trim (ZHomeConf$) IF ZRequiredRings > 0 AND _ INSTR(ZModemInitCmd$,"S0=255") THEN _ COLOR 7,0,0 _ ELSE COLOR ZFG,ZBG,ZBorder IF ZLocalUserMode THEN _ GOTO 44003 CALL SetBaud 44003 ZUserLogonTime! = VAL(HourLoggedOn$) * 3600! + _ ' KK030901 VAL(MinLoggedOn$) * 60! + _ ' KK030901 VAL(SecLoggedOn$) HourLoggedOn$ = "" MinLoggedOn$ = "" SecLoggedOn$ = "" IF ZMinsPerSession < 1 THEN _ ZMinsPerSession = 3 IF NOT ZEightBit THEN _ OUT ZLineCntlReg,&H1A IF LEFT$(ZMsgRec$,7) = "SYSOP " THEN _ ZFirstName$ = ZSysopPswd1$ : _ ZActiveUserName$ = ZSysopPswd1$ + " " + ZSysopPswd2$ _ ELSE ZFirstNameEnd = INSTR(ZMsgRec$," ") : _ ZLastNameEnd = INSTR(ZFirstNameEnd + 1,ZMsgRec$ + " "," ") : _ ZFirstName$ = LEFT$(ZMsgRec$,ZFirstNameEnd-1) : _ ZLastName$ = MID$(ZMsgRec$,ZFirstNameEnd + 1,ZLastNameEnd - (ZFirstNameEnd + 1)) : _ ZActiveUserName$ = MID$(ZFirstName$ + " " + ZLastName$,1,31) ZWasZ$ = ZFirstName$ CALL OpenWork (2,ZNodeWorkDrvPath$+"DRST"+ZNodeFileID$+".DEF") CALL ReadDir (2,1) ZLimitMinsPerSession = VAL (ZOutTxt$) CLOSE 2 END SUB 44020 ' $SUBTITLE: 'CommInfo - sub for variable of users baud/parity' ' $PAGE ' ' NAME -- CommInfo ' ' INPUTS -- PARAMETER MEANING ' ZBPS BAUD RATE INDICATOR ' ZEightBit INDICATE FOR N/8/1 ' ' OUTPUTS -- ZBaudParity$ ' ' PURPOSE -- Create a string that shows a users baud rate and parity ' SUB CommInfo STATIC ' ' ' * DETERMINE BAUD AND PARITY ' ' IF ZReliableMode THEN _ ReliableMode$ = "-R," _ ELSE ReliableMode$ = "," ZBaudParity$ = MID$(ZBaudRates$,(-5 * ZBPS),5) + _ " BAUD" + _ ReliableMode$ + _ MID$("N,8,1E,7,1",6 + 5 * ZEightBit,5) ZBaudTest! = VAL(ZBaudParity$) END SUB 50495 ' $SUBTITLE: 'DelayTime - sub to wait number of seconds specified' ' $PAGE ' ' NAME -- DelayTime ' ' INPUTS -- PARAMETER MEANING ' DelaySecs NUMBER OF SECONDS TO DELAY ' (0 TO 3,600) ' ' OUTPUTS -- NONE ' ' PURPOSE -- To wait the number of seconds indicated before ' returning control to the calling routine. ' SUB DelayTime (DelaySecs) STATIC IF DelaySecs < 1 THEN _ EXIT SUB ZDelay! = TIMER + DelaySecs 50500 CALL CheckTime(ZDelay!, TempElapsed!, 1) IF TempElapsed! > 0 THEN _ GOTO 50500 END SUB 52070 ' $SUBTITLE: 'ModemPut - sub to write modem commands to modem' ' $PAGE ' ' SUBROUTINE NAME -- ModemPut ' ' INPUT PARAMETERS -- PARAMETER MEANING ' Strng$ MODEM COMMAND ' ZCmdsBetweenRings INDICATOR TO WAIT FOR ' MODEM TO STOP RINGING ' BEFORE ISSUING COMMANDS ' ZDumbModem INDICATOR THAT MODEM WOULD ' NOT UNDERSTAND COMMANDS ' ' OUTPUT PARAMETERS -- NONE ' ' SUBROUTINE PURPOSE -- TO ISSUE MODEM COMMANDS TO THE MODEM ' SUB ModemPut (Strng$) STATIC ' ' ' * SEND MODEM COMMAND ' ' IF ZDumbModem THEN _ EXIT SUB IF NOT ZCmdsBetweenRings OR _ NOT (INP(ZModemStatusReg) AND &H40) THEN _ GOTO 52080 ConnectDelay! = TIMER + 7 52072 IF (INP(ZModemStatusReg) AND &H40) > 0 THEN _ CALL CheckTime(ConnectDelay!, TempElapsed!, 1) : _ IF ZSubParm = 2 THEN _ GOTO 52080 GOTO 52072 52080 CALL DelayTime (ZModemCmdDelayTime) WasX$ = " " FOR WasI = 1 TO LEN(Strng$) LSET WasX$ = MID$(Strng$,WasI,1) ON INSTR("{~",WasX$) GOTO 52082,52084 GOTO 52085 52082 LSET WasX$ = ZCarriageReturn$ GOTO 52085 52084 CALL DelayTime (1) GOTO 52086 52085 CALL CommPut (WasX$) 52086 NEXT CALL CommPut (ZCarriageReturn$) END SUB 57001 ' $SUBTITLE: 'DispCall - subroutine to display callers file' ' $PAGE ' ' NAME -- DispCall ' ' INPUTS -- PARAMETER MEANING ' ' OUTPUTS -- (NONE) ' ' PURPOSE -- Displays callers file to sysops and callers ' SUB DispCall STATIC IF ZCallersFilePrefix$ = "" THEN _ EXIT SUB CALL SkipLine (1) CallersFileIndexTemp! = ZCallersFileIndex! CLOSE 4 IF ZShareIt THEN _ OPEN ZCallersFile$ FOR RANDOM SHARED AS #4 LEN=64 _ ELSE OPEN "R",4,ZCallersFile$,64 FIELD 4,64 AS ZCallersRecord$ 57005 IF CallersFileIndexTemp! < 1 OR ZRet THEN _ EXIT SUB 57010 GET 4,CallersFileIndexTemp! ZOutTxt$ = ZCallersRecord$ IF LEFT$(ZOutTxt$,3) = " " OR _ INSTR(ZOutTxt$,"on at") = 0 THEN _ GOTO 57030 57025 CallersFileIndexTemp! = CallersFileIndexTemp! - 1 GET 4,CallersFileIndexTemp! WasZ = INSTR(ZCallersRecord$,"{") IF WasZ < 1 OR WasZ > 15 THEN _ WasZ = 15 IF ZSysop OR _ LEFT$(ZOutTxt$,3) <> " " THEN _ ZOutTxt$ = ZOutTxt$ + LEFT$(ZCallersRecord$,WasZ - 1) GOSUB 57100 IF ZSysop THEN _ ZOutTxt$ = MID$(ZCallersRecord$,WasZ) : _ GOSUB 57100 GOTO 57045 57030 IF ZSysop THEN _ GOSUB 57100 57045 CallersFileIndexTemp! = CallersFileIndexTemp! -1 GOTO 57005 57100 IF INSTR(ZOutTxt$,"LOGON DENIED") THEN _ IF NOT ZSysop THEN _ RETURN CALL QuickTPut1 (ZOutTxt$) CALL AskMore ("",ZTrue,ZTrue,WasX,ZFalse) IF ZNo OR ZSubParm = -1 THEN _ EXIT SUB RETURN END SUB 58050 ' $SUBTITLE: 'AllCaps - sub to convert string to upper case' ' $PAGE ' ' NAME -- AllCaps ' ' INPUTS -- PARAMETER MEANING ' ConvertField$ STRING TO MAKE UPPER CASE ' ' OUTPUTS -- ConvertField$ CONVERTED STRINGS ' ' PURPOSE -- Subroutine to convert a string to upper case ' SUB AllCaps (ConvertField$) STATIC IF ZTurboRBBS THEN _ CALL RBBSULC (ConvertField$) : _ EXIT SUB FOR WasZ = 1 TO LEN(ConvertField$) IF MID$(ConvertField$,WasZ,1) > "@" THEN _ MID$(ConvertField$,WasZ,1) = CHR$(ASC(MID$(ConvertField$,WasZ,1)) AND 223) NEXT END SUB 58060 ' $SUBTITLE: 'NameCaps - sub to convert name string to Proper Case' ' $PAGE ' ' NAME -- NameCaps ' ' INPUTS -- PARAMETER MEANING ' ConvertField$ STRING TO CONVERT ' ' OUTPUTS -- ConvertField$ CONVERTED STRINGS ' ' PURPOSE -- Subroutine to convert a string to Proper Case (1st char upper) ' SUB NameCaps (ConvertField$) STATIC CALL AllCaps(ConvertField$) FOR WasZ = 2 TO LEN(ConvertField$) IF MID$(ConvertField$,WasZ,1) > "@" AND _ MID$(ConvertField$,WasZ,1) < "[" AND _ MID$(ConvertField$,WasZ-1,1) <> " " THEN _ MID$(ConvertField$,WasZ,1) = CHR$(ASC(MID$(ConvertField$,WasZ,1)) OR 32) NEXT END SUB 58070 ' $SUBTITLE: 'CheckTime - sub to see how much time is remaining' ' $PAGE ' ' NAME -- CheckTime ' ' INPUTS -- PARAMETER MEANING ' TargetTime TARGET TIME ' ChectimeOption 1 = TELL US TIME REMAINING BETWEEN CURRENT ' TIME AND TargetTime ' 2 = TELL US TIME ELAPSED BETWEEN TargetTime ' AND CURRENT TIME ' ' OUTPUTS -- PARAMETER MEANING ' TimeRemaining! POSITIVE OR NEGATIVE NUMBER INDICATING ' TIME REMAINING OR ELAPSED. VALUE MAY BE ' TESTED FOR "TIME EXPIRED". NEGATIVE ' OR ZERO, AND THE TIME HAS BEEN REACHED. ' ELAPSED TIME CAN BE 0 TO 86400 (24 HRS) ' TIME REMAINING CAN BE 0 TO 43200 OR ' -43200 TO 0 (+ OR - 12 HRS) ' ZSubParm (Option 1 ONLY!) ' 1 = Time REMAINING is > 0 ' 2 = Time REMAINING is <= 0 ' ' ' PURPOSE -- Subroutine to provide time measurement functions. Will ' determine whether a target time has been reached, how much ' time is remaining, or how much time has elapsed. ' SUB CheckTime (TargetTime!, TimeRemaining!, CkOption) STATIC IF TargetTime! > 86400 THEN _ TestTime! = 86400 : _ OverTime! = TargetTime! - 86400 _ ELSE _ TestTime! = TargetTime! : _ OverTime! = 0 TimeRemaining! = (TestTime! - TIMER) + OverTime! IF CkOption = 2 THEN GOTO 58072 IF TimeRemaining! < -43200 THEN _ TimeRemaining! = TimeRemaining! + 86400 IF TimeRemaining! > 43200 THEN _ TimeRemaining! = TimeRemaining! - 86400 IF TimeRemaining! >= 0 THEN _ ZSubParm = 1 _ ELSE _ ZSubParm = 2 EXIT SUB 58072 IF TimeRemaining! > 0 THEN _ TimeRemaining! = 86400 - TimeRemaining! _ ELSE _ TimeRemaining! = -(TimeRemaining!) END SUB 58080 ' $SUBTITLE: 'HashRBBS - sub to determine where to look for user' ' $PAGE ' ' NAME -- HashRBBS ' ' INPUTS -- PARAMETER MEANING ' StringToHash$ USER NAME TO LOCATE ' MaxPosition MAXIMUM # USERS ' ' OUTPUTS -- PrimeHash WHERE TO LOOK First ' SecondHash LOOK THIS FAR AHEAD ' ' PURPOSE -- Where to look for a user in users file ' Look first at prime position, then add ' SecondHash until find or find unused record ' SUB HashRBBS (StringToHash$,MaxPosition,PrimeHash,SecondHash) STATIC SecondHash = (ASC(MID$(StringToHash$,2,1)) * 10 + 7) MOD _ MaxPosition PrimeHash = _ ((ASC(StringToHash$) * 100 + _ ASC(MID$(StringToHash$,(LEN(StringToHash$) / 2) + .1,1)) * _ 10 + _ ASC(RIGHT$(StringToHash$,1))) _ MOD MaxPosition) + 1 END SUB 58100 ' $SUBTITLE: 'SetOpts - sub to set prompts based on user security' ' $PAGE ' ' NAME -- SetOpts ' ' INPUTS -- PARAMETER MEANING ' First POSITION WHERE START LOOKING ' Last POSITION WHERE QUIT LOOKING ' ZUserSecLevel SECURITY OF USER ' ' OUTPUTS -- Options$ LIST OF COMMANDS USER CAN DO ' ' PURPOSE -- String together what commands user can do in a section ' SUB SetOpts (Options$,InvalidOptions$,First,Last) STATIC Options$ = "" InvalidOptions$ = "" FOR WasI = First TO Last IF ZUserSecLevel < ZOptSec(WasI) THEN _ InvalidOptions$ = InvalidOptions$ + _ MID$(ZAllOpts$,WasI,1) _ ELSE IF MID$(ZAllOpts$,WasI,1) <> " " THEN _ Options$ = Options$ + _ MID$(ZAllOpts$,WasI,1) NEXT CALL SortString (Options$) CALL SortString (InvalidOptions$) END SUB 58110 ' $SUBTITLE: 'CheckNewBul - sub to check whether got new bulletins' ' $PAGE ' ' NAME -- CheckNewBul ' ' INPUTS -- PARAMETER MEANING ' LastOn$ Last DATE OF LOGON ' FORMAT MM/DD/YY ' ZActiveBulletins # OF BULLETING ' ZBulletinPrefix$ FILESPEC FOR BULLETINS ' ' OUTPUTS -- NumNewBullets NUMBER OF NEW BULLETINS ' NewBullets$ LIST OF NEW BULLET #'S ' ZWasQ WHERE Last BULLETIN STORED ' IN ZUserIn$() ' ZUserIn$() BULLETINS #'S THAT ARE NEW ' (2,3,4,...) ' ' PURPOSE -- Checks how many bulletins have system date ' at or later than date caller last logged on ' SUB CheckNewBul (LastOn$,NumNewBullets,NewBullets$) STATIC IF ZExitToDoors OR ZBulletinPrefix$ = ZPrevPrefix$ THEN _ EXIT SUB ZPrevPrefix$ = ZBulletinPrefix$ NumNewBullets = 0 NewBullets$ = ": " BaseDate# = VAL(MID$(LastOn$,4,2)) + (100 * VAL(MID$(LastOn$,1,2))) + _ (10000# * (1900 + VAL(MID$(LastOn$,7,2)))) CALL FindIt (ZBulletinPrefix$ + ".FCK") WasX = 0 CALL QuickTPut ("For by grace are ye saved through faith",0) ' Bh IF ZOK THEN _ WHILE NOT EOF(2) : _ LINE INPUT #2,WasBN$ : _ GOSUB 58112 : _ WEND _ ELSE FOR WasI = 1 TO ZActiveBulletins : _ WasBN$ = MID$(STR$(WasI),2) : _ GOSUB 58112 : _ NEXT ZWasQ = NumNewBullets + 1 IF NumNewBullets < 1 THEN _ NewBullets$ = "" ' CALL SkipLine (1) CALL WipeLine (35) ZOutTxt$ = STR$(NumNewBullets) + _ " NEW BULLETIN(S) since last call" + _ NewBullets$ CALL QuickTPut1 (ZOutTxt$) EXIT SUB 58112 IF WasBN$ = "N" THEN _ WasX$ = ZNewsFileName$ + CHR$(0) _ ELSE WasX$ = ZBulletinPrefix$ + WasBN$ + CHR$(0) CALL MarkTime (WasX) CALL RBBSFind (WasX$,WasIX,Year,WasMM,WasDD) IF WasIX = 0 THEN _ FDate# = WasDD + (100 * WasMM) + (10000# * (Year + 1980)) : _ IF BaseDate# <= FDate# THEN _ NumNewBullets = NumNewBullets + 1 : _ ZUserIn$(NumNewBullets + 1) = WasBN$ : _ NewBullets$ = NewBullets$ + _ " " + _ WasBN$ RETURN END SUB 58120 ' $SUBTITLE: 'SortString - sub to sort characters in a string' ' $PAGE ' ' NAME -- SortString ' ' INPUTS -- PARAMETER MEANING ' Strng$ STRING TO SORT ' ' OUTPUTS -- Strng$ SORTED STRING ' ' PURPOSE -- Sorts characters in passed string. ' SUB SortString (Strng$) STATIC Sort0 = LEN(Strng$) Sort1 = Sort0 WasX$ = "!" 58122 Sort1 = Sort1\2 IF Sort1 = 0 THEN _ EXIT SUB Sort2 = Sort0 - Sort1 FOR Sort3 = 1 TO Sort2 Sort4 = Sort3 58124 Sort5 = Sort4 + Sort1 IF MID$(Strng$,Sort4,1) > MID$(Strng$,Sort5,1) THEN _ LSET WasX$ = MID$(Strng$,Sort4,1) : _ MID$(Strng$,Sort4,1) = MID$(Strng$,Sort5,1) : _ MID$(Strng$,Sort5,1) = WasX$ : _ Sort4 = Sort4 - Sort1 : _ IF Sort4 > 0 THEN _ GOTO 58124 NEXT GOTO 58122 END SUB 58130 ' $SUBTITLE: 'AddCommas - sub to format commands in command prompt' ' $PAGE ' ' NAME -- AddCommas ' ' INPUTS -- PARAMETER MEANING ' Strng$ STRING TO REPLACE ' ' OUTPUTS -- Strng$ REPLACED STRING ' ' PURPOSE -- Inserts commands between each letter in Strng$ ' and encloses in pointed brackets ' SUB AddCommas (Strng$) STATIC WasL = LEN(Strng$) IF WasL < 1 THEN _ EXIT SUB LSET ZLineMes$ = " <" + _ LEFT$(Strng$,1) FOR WasK = 2 TO WasL MID$(ZLineMes$,2 * WasK,2) = "," + _ MID$(Strng$,WasK,1) NEXT Strng$ = LEFT$(ZLineMes$,2 * WasL + 1) + _ ">" END SUB 58140 ' $SUBTITLE: 'LoadNew - subroutine to get latest uploads' ' $PAGE ' ' NAME -- LoadNew ' ' INPUTS -- PARAMETER MEANING ' ZUpldDir$ LIST OF FILES UPLOADED ' ' OUTPUTS -- ZOutTxt$ LATEST UPLOADS ' ' PURPOSE -- Loads table of most recent number of uploads by date ' SUB LoadNew (Ara(2)) STATIC IF ZFMSDirectory$ = "" THEN _ EXIT SUB ZPrevBase$ = "" IF PrevLoadNew$ = ZFMSDirectory$ THEN _ Ara(1,1) = 0 : _ EXIT SUB PrevLoadNew$ = ZFMSDirectory$ CALL OpenFMS (LastRec) ' FIELD 2, 23 AS PreDate$, _ ' 2 AS WasMM$, _ ' 1 AS Fill1$, _ ' 2 AS WasDD$, _ ' 1 AS Fill2$, _ ' 2 AS Year$, _ ' (2 + ZMaxDescLen) AS Fill3$, _ ' 3 AS Category$, _ ' 2 AS Fill4$ FIELD 2, 20 AS PreDate$, _ ' Bh 082790 2 AS WasMM$, _ 2 AS WasDD$, _ 2 AS Year$, _ (1 + ZMaxDescLen) AS Fill1$, _ 3 AS Category$, _ 2 AS Fill2$ MaxRecs = UBOUND(Ara,1) IF MaxRecs < 1 THEN _ MaxRecs = 1 _ 'ELSE IF MaxRecs > 23 THEN _ ' MaxRecs = 23 WasL = 0 WasK = LastRec WHILE WasK > 0 AND WasL < MaxRecs GET #2,WasK IF INSTR("\= ",LEFT$(PreDate$,1)) > 0 THEN _ GOTO 58142 IF (ZCanDnldFromUp OR Category$ <> ZDefaultCatCode$) THEN _ WasL = WasL + 1 : _ Ara(WasL,1) = 372! * (VAL(Year$) - 80!) + 31! * VAL(WasMM$) + VAL(WasDD$) ' KK030901 IF NOT ZCanDnldFromUp THEN _ WasX = ZMinSecToView _ ELSE IF Category$ = "***" THEN _ WasX = ZSysopSecLevel _ ELSE IF Category$ = ZDefaultCatCode$ THEN _ WasX = ZMinSecToView _ ELSE WasX = ZOptSec(19) Ara(WasL,2) = WasX 58142 WasK = WasK - 1 WEND CLOSE 2 END SUB 58150 ' $SUBTITLE: 'CountNewFiles - sub to count how many files new' ' $PAGE ' ' NAME -- CountNewFiles ' ' INPUTS -- PARAMETER MEANING ' LastOn$ Date of last logon ' UPLDS$ Latest uploads ' ' OUTPUTS -- NumNewFiles How many after last logon ' RptPrefix$ Set to "Over " if ' Bh 091090 ' above is a minimum ' ' PURPOSE -- Checks how many files in UPLDS$ were uploaded on or ' after date of last logon that the user can download ' SUB CountNewFiles (LastOn$,Upld(2),NumUserFiles,RptPrefix$) STATIC BaseDate = 372 * (VAL(MID$(LastOn$,7,2)) - 80) + _ 31 * (VAL(MID$(LastOn$,1,2))) + _ VAL(MID$(LastOn$,4,2)) NumNewFiles = 1 NumUserFiles = 0 WHILE (BaseDate <= Upld(NumNewFiles,1) AND _ Upld(NumNewFiles,1) > 0 AND _ NumNewFiles < UBOUND(Upld,1)) IF ZUserSecLevel => Upld(NumNewFiles,2) THEN _ NumUserFiles = NumUserFiles + 1 NumNewFiles = NumNewFiles + 1 WEND IF Upld(NumNewFiles,1) < 1 THEN _ NumNewFiles = NumNewFiles - 1 IF BaseDate <= Upld(NumNewFiles,1) THEN _ RptPrefix$ = "Over " _ ' Bh 091090 ELSE RptPrefix$ = "" END SUB 58160 ' $SUBTITLE: 'CountLines - sub to determine file categories ' ' $PAGE ' ' NAME -- CountLines ' ' INPUTS -- PARAMETER MEANING ' ZDirCatFile$ NAME OF THE FILE THAT HAS THE ' NUMBER OF CATEGORIES IN IT. ' ' OUTPUTS -- MaxEntries NUMBER OF FILE CATEGORIES ' ' PURPOSE -- Subroutine to count the number of categories that a ' file can be classified into. ' SUB CountLines (MaxEntries) STATIC CALL LinesInFile (ZDirCatFile$,MaxEntries) MaxEntries = MaxEntries + 3 IF MaxEntries < 10 THEN _ MaxEntries = 10 END SUB 58161 ' $SUBTITLE: 'CountLines - sub to determine file categories ' ' $PAGE ' ' NAME -- LinesInFile ' ' INPUTS -- PARAMETER MEANING ' FilName$ Name of file to use ' ' OUTPUTS -- LineCount Count of # of lines in file ' ' PURPOSE -- Subroutine to count the number of categories that a ' file can be classified into. ' SUB LinesInFile (FilName$,LineCount) STATIC CALL FindIt (FilName$) LineCount = 0 IF ZOK THEN _ WHILE NOT EOF(2) : _ LineCount = LineCount + 1 : _ LINE INPUT #2,ZOutTxt$ : _ WEND CLOSE 2 END SUB 58162 ' $SUBTITLE: 'InitFMS - sub to initialize file management system' ' $PAGE ' ' NAME -- InitFMS ' ' INPUTS -- PARAMETER MEANING ' ZFMSDirectory$ ' ' OUTPUTS -- ZCategoryName$() ELEMENTS 1,2, POSSIBLY MORE ' ZCategoryCode$() ELEMENTS 1,2, POSSIBLY MORE ' ZCategoryDesc$() ELEMENTS 1,2, POSSIBLY MORE ' CategoryIndex COUNT OF # ELEMENTS IN THE FILE ' MANAGMENT SYSTEM ' ' PURPOSE -- Subroutine to initialize the RBBS-PC File Management System ' SUB InitFMS (ZCategoryName$(1),ZCategoryCode$(1), _ ZCategoryDesc$(1),CategoryIndex) STATIC Blank$ = " " CategoryIndex = 0 IF ZFMSDirectory$ <> "" THEN _ CategoryIndex = CategoryIndex + 1 : _ CatN$ = ZCategoryName$(CategoryIndex) : _ CALL BreakFileName (ZFMSDirectory$,DrvPath$,CatN$,Extension$,ZFalse) : _ ZCategoryName$(CategoryIndex) = CatN$ : _ ZCategoryCode$(CategoryIndex) = "" : _ ZCategoryDesc$(CategoryIndex) = "All uploads"_ ELSE ZLimitSearchToFMS = ZFalse : _ EXIT SUB IF ZLimitSearchToFMS OR ZMasterDirName$ = ZMainFMSDir$ THEN _ CategoryIndex = CategoryIndex + 1 : _ ZCategoryName$(CategoryIndex) = "ALL" : _ ZCategoryCode$(CategoryIndex) = "" : _ ZCategoryDesc$(CategoryIndex) = "All files" CALL FindIt (ZDirCatFile$) IF NOT ZOK THEN _ EXIT SUB WHILE NOT EOF(2) CALL ReadParms (ZWorkAra$(),3,1) IF ZErrCode > 0 THEN _ ZErrCode = 0 : _ CALL PScrn (ZDirCatFile$+" invalid. Line" + STR$(CategoryIndex) + " needs 3 parms") : _ CALL DelayTime (4) _ ELSE CategoryIndex = CategoryIndex + 1 : _ ZCategoryName$(CategoryIndex) = ZWorkAra$(1) : _ ZCategoryCode$(CategoryIndex) = ZWorkAra$(2) : _ ZCategoryDesc$(CategoryIndex) = ZWorkAra$(3) : _ CatR$ = ZCategoryCode$(CategoryIndex) : _ CALL Remove (CatR$,Blank$) : _ ZCategoryCode$(CategoryIndex) = CatR$ WEND CLOSE 2 END SUB 58165 ' $SUBTITLE: 'DispUpDir - sub to display upload direcotry' ' $PAGE ' ' NAME -- DispUpDir ' ' INPUTS -- PARAMETER MEANING ' PassedCats$ FILE "CATEGORIES" TO BE INCLUDED IN ' THE SEARCH. ' SearchString$ STRING TO SEARCH ON WITHIN THE ' FILE "CATEGORIES" SELECTED ' SearchDate$ DATE EQUAL TO OR GREATER THAN TO BE ' SEARCHED FOR WITH THE "CATEGORIES" ' AND THE STRING TO SEARCH. ' DnldFlag SET TO RECORD # OF LINE TO BEGIN ' VIEWING - 0 IF AT END ' ' OUTPUTS -- DnldFlag WHENEVER DOWNLOAD REQUESTED, SETS ' TO NEXT RECORD TO VIEW. OTHERWISE ' LEAVES AT ZERO ' PURPOSE -- Display the files that meet the criteria selected in ' RBBS-PC upload management system on the users screen. ' SUB DispUpDir (PassedCats$,SearchString$, _ SearchDate$,DnldFlag,AbortIndex) STATIC CALL AllCaps (SearchString$) Blank$ = " " ZStopInterrupts = ZFalse ZLastIndex = 0 ZBobCount = 0 ' Bh 123190 Categories$ = "," + _ PassedCats$ + _ "," CanDnld = (ZUserSecLevel => ZOptSec(19)) ZJumpSupported = ZTrue ZJumpSearching = ZFalse GOSUB 58185 IF DnldFlag > 0 THEN _ UpldIndex = DnldFlag : _ DnldFlag = 0 : _ GOTO 58180 ZJumpLast$ = "" SearchFor$ = SearchString$ ExtraPrompt$ = LEFT$(",+)xtra info",12+4*ZExpertUser) 'Pe 10/21/89 ExtraPrompt$ = ExtraPrompt$ + LEFT$(",V)iew",6+4*ZExpertUser) 'Pe 10/21/89 IF CanDnld THEN _ ExtraPrompt$ = ExtraPrompt$ + ",D)ownload" MaxPrint = ZPageLength - 1 BelowMinSec = (ZUserSecLevel < ZMinSecToView) ZNonStop = ZNonStop OR (ZPageLength < 1) FMSCheckPoint = 0 WildSearch = (INSTR(SearchString$,"?") > 0) _ OR (INSTR(SearchString$,"*") > 0) 58168 UpldIndex = UpldIndex + ZUpInc IF UpldIndex = CutoffRec THEN _ GOTO 58182 GET #2,UpldIndex FMSCheckPoint = FMSCheckPoint + 1 ON INSTR("\* =",LEFT$(PartToPrint$,1)) GOTO 58168,58171,58170,58169 GOTO 58172 58169 CALL CheckInt (MID$(PartToPrint$,34)) IF ZUserSecLevel < ZTestedIntValue THEN _ LastOK = ZFalse : _ GOTO 58168 MID$(PartToPrint$,1,13) = MID$(PartToPrint$,2,12) + " " ZWasA = LEN(STR$(ZTestedIntValue)) MID$(PartToPrint$,34) = MID$(PartToPrint$,34 + ZWasA) + SPACE$(ZWasA) GOTO 58172 58170 IF ZExtendedOff THEN _ GOTO 58168 _ ELSE IF LastOK THEN _ GOTO 58175 _ ELSE IF ZJumpSearching THEN _ GOTO 58187 _ ELSE IF SearchString$ <> "" AND (NOT WildSearch) AND FailedSearch THEN _ GOTO 58187 _ ELSE GOTO 58168 58171 IF Category$ = "***" THEN _ GOTO 58176 _ ELSE HoldCat$ = "," + Category$ + "," : _ IF INSTR(Categories$,HoldCat$) > 0 THEN _ GOTO 58176 _ ELSE GOTO 58168 58172 LastOK = ZFalse FailedSearch = ZFalse LastFName = UpldIndex IF Category$ = "***" THEN _ IF NOT ZSysop THEN _ GOTO 58178 IF Category$ = ZDefaultCatCode$ THEN _ IF BelowMinSec THEN _ GOTO 58178 58173 IF LEN(Categories$) > 2 THEN _ HoldCat$ = "," + _ Category$ + _ "," : _ CALL Remove (HoldCat$,Blank$) : _ IF INSTR(Categories$,HoldCat$) = 0 THEN _ GOTO 58178 IF ZJumpSearching OR SearchString$ <> "" THEN _ ZOutTxt$ = PartToPrint$ : _ IF WildSearch THEN _ Temp$ = LEFT$(PartToPrint$,INSTR(PartToPrint$," ")-1) : _ Temp$ = MID$(Temp$,1-(LEFT$(Temp$,1)="=")) : _ CALL WildFile (SearchString$,Temp$,ZOK) : _ IF ZOK THEN _ FoundString$ = SearchString$ : _ GOTO 58175 _ ELSE GOTO 58178 _ ELSE CALL AllCaps (ZOutTxt$) : _ HiLitePos = INSTR(ZOutTxt$,SearchFor$) : _ IF HiLitePos = 0 THEN _ FailedSearch = ZTrue : _ GOTO 58178 _ ELSE HiLiteRec = UpldIndex : _ FoundString$ = SearchFor$ : _ IF ZJumpSearching THEN _ ZJumpSearching = ZFalse : _ SearchFor$ = PrevSearch$ 58174 IF SearchDate$ <> "" THEN _ HoldCat$ = MID$(PartToPrint$,25,2) + _ MID$(PartToPrint$,21,2) + _ MID$(PartToPrint$,23,2) : _ IF HoldCat$ < SearchDate$ THEN _ IF ZDateOrderedFMS THEN _ GOTO 58183 _ ELSE GOTO 58168 ' ' ' * Allow the FMS to be both fast and interruptable if a local ' * user or there is nothing in the input buffer by using QuickTPut. ' ' 58175 LastOK = ZTrue 58176 ZWasA = EndDesc IF LEFT$(PartToPrint$,5) = " " THEN _ GOTO 58178 ZOutTxt$ = PartToPrint$ CALL TrimTrail (ZOutTxt$," ") CALL ColorDir (ZOutTxt$,"Y") IF UpldIndex = HiLiteRec THEN _ HiLiteRec = -1 : _ HiLitePos = 0 : _ CALL CheckColor (ZOutTxt$,FoundString$,"") 58177 IF ZLocalUser THEN _ CALL QuickTPut1 (ZOutTxt$) : _ GOTO 58178 CALL EofComm (Char) IF Char = -1 THEN _ CALL QuickTPut1 (ZOutTxt$) _ ELSE ZSubParm = 5 : _ CALL TPut : _ IF ZRet THEN _ GOTO 58183 58178 IF ZLinesPrinted <= MaxPrint AND FMSCheckPoint < 2000 THEN _ GOTO 58168 CALL CheckCarrier IF ZSubParm = -1 THEN _ GOTO 58183 CALL TimeRemain (MinsRemaining) IF MinsRemaining <= 0 THEN _ ZSubParm = -1 : _ GOTO 58183 IF ZNonStop THEN _ GOTO 58168 ' IF ZLinesPrinted <= MaxPrint THEN _ ' Bh 082990 ' CALL QuickTPut1 (ZEmphasizeOff$ + "Files have been searched back to " + MID$(PartToPrint$,21,6)) ' Bh 071190 IF ZLinesPrinted <= MaxPrint THEN _ ' Bh 082990 ZBobCount = ZBobCount + 2000 : _ CALL QuickTPut1 (ZEmphasizeOff$ + "I've searched " + STR$(ZBobCount) + " files, and there are more...") ' Bh 083090 58180 ZTurboKey = -ZTurboKeyUser ZStackC = ZTrue CALL AskMore (ExtraPrompt$, ZTrue, ZFalse,AbortIndex,ZFalse) IF ZSubParm = -1 THEN _ GOTO 58183 IF ZNo THEN _ GOTO 58183 CALL AllCaps (ZUserIn$(1)) ' 'Type TXT file mod Pe 10/21/89 ' IF ZUserIn$(1) = "+" THEN _ ZLastIndex = ZWasQ : _ ZAnsIndex = 1 : _ CALL TypeFile : _ ZwasA = UpldIndex : _ GOSUB 58185 : _ UpldIndex = ZwasA : _ GOTO 58180 ' IF ZUserIn$(1) = "V" THEN _ ZLastIndex = ZWasQ : _ ZAnsIndex = 1 : _ CALL GetArc : _ ZJumpSupported = ZTrue : _ ZWasA = UpldIndex : _ GOSUB 58185 : _ UpldIndex = ZWasA : _ GOTO 58180 IF ZUserIn$(1) = "D" THEN _ ZOutTxt$ = "Download which file(s)" : _ ' Bh ZStackC = ZTrue : _ CALL PopCmdStack : _ IF ZWasQ = 0 THEN _ GOTO 58180 IF ZJumpSearching THEN _ PrevSearch$ = SearchFor$ : _ SearchFor$ = ZJumpTo$ _ ELSE SearchFor$ = SearchString$ : _ IF LEN(ZUserIn$(1)) > 1 THEN _ IF NOT ZYes AND CanDnld THEN _ CALL SkipLine (1) : _ DnldFlag = UpldIndex : _ ZLastIndex = ZWasQ : _ ZAnsIndex = 1 : _ EXIT SUB IF ZNonStop THEN IF UpldIndex > 999 THEN _ IF (SearchDate$ = "" OR NOT ZExpertUser) THEN _ ZOutTxt$ = STR$(UpldIndex) + _ " lines left to search. Do you REALLY want to go non-stop? (Y/[N])" : _ ' Bh ZNoAdvance = ZTrue : _ ZTurboKey = -ZTurboKeyUser : _ ZSubParm = 1 : _ CALL TGet : _ CALL WipeLine (79) : _ ZNonStop = ZYes FMSCheckPoint = 0 GOTO 58168 58182 IF ZChainedDir$ <> "" THEN _ ZActiveFMSDir$ = ZChainedDir$ : _ GOSUB 58185 : _ GOTO 58168 58183 CLOSE 2 ZNonStop = (ZPageLength < 1) ZStopInterrupts = ZFalse ZOutTxt$ = "" ZActiveFMSDir$ = "" ' KG031801 ZJumpSupported = ZFalse EXIT SUB 58185 CALL OpenFMS (UpldIndex) ' EndDesc = 33 + ZMaxDescLen EndDesc = 27 + ZMaxDescLen ' Bh 082790 FIELD 2, EndDesc AS PartToPrint$, _ 3 AS Category$, _ 2 AS Filler$ PrevFMS$ = ZActiveFMSDir$ IF ZUpInc = -1 THEN _ CutoffRec = 0 : _ UpldIndex = UpldIndex + 1 _ ELSE CutoffRec = UpldIndex + 1 : _ UpldIndex = 0 RETURN 58187 ZOutTxt$ = PartToPrint$ CALL AllCaps (ZOutTxt$) HiLitePos = INSTR(ZOutTxt$,SearchFor$) IF HiLitePos < 1 THEN _ GOTO 58168 HiLiteRec = UpldIndex UpldIndex = LastFName GET 2,UpldIndex FoundString$ = SearchFor$ IF ZJumpSearching THEN _ SearchFor$ = PrevSearch$ GOTO 58175 END SUB ' $SUBTITLE: 'CONVERT2ZIP - subroutine to Convert to ZIP format' ' $PAGE ' ' NAME -- CONVERT2ZIP ' ' PARAMETERs WDR$ drive/subdir were file is located ' WZZ$ Filename (no Extension) ' WX$ extension of file being converted ' DESC$ file description for ZIP comment 'Pe 10/05/89 ' ' PURPOSE -- Convert files to Zip format if remote user ' SUB CONVERT2ZIP (WDR$,WZZ$,WX$,Desc$) STATIC 'Pe 10/05/89 IF WX$ = ".ZIP" THEN _ CALL QuickTPut (ZFileNameHold$ +" Now being verified and re-Zipped Please wait!",1) : _ WasZ$ = "PKUNZIP -x " + ZFileName$ + " " _ ELSE _ CALL QuickTPut (ZFileNameHold$ +" Now being converted to .ZIP format. Please wait!",1) : _ IF WX$ = ".ARC" OR WX$ = ".PAK" THEN _ WasZ$ = "PAK e " + ZFileName$ + " " : _ ELSE IF WX$ = ".LZH" THEN _ WasZ$ = "LHARC e " + ZFileName$ + " " : _ ELSE IF WX$ = ".ZOO" THEN _ WasZ$ = "ZOO.BAT " + ZFileName$ + " " : _ ELSE _ WasZ$ = "COPY " +ZFileName$ + " " ' MplB$ = "CONVERT"+ZNodeID$+".BAT" CALL OpenOutW (MplB$) : _ PRINT #2, "MD " + ZLibWorkDiskPath$ + "WORK"+ZNodeID$ PRINT #2, "ECHO OFF" IF NOT ZNetworkType = 4 THEN _ 'LK 02/24/90 PRINT #2, "CTTY GATE"+RIGHT$(ZComPort$,1) PRINT #2, "SETERROR 0" IF WX$ = ".LZH" THEN _ PRINT #2, WasZ$ + ZLibWorkDiskPath$ +"WORK"+ ZNodeID$ +"\" _ ELSE _ PRINT #2, WasZ$ + ZLibWorkDiskPath$ +"WORK"+ ZNodeID$ PRINT #2, "DEL " + ZFileName$ PRINT #2, "SCAN "+ZLibWorkDiskPath$ +"WORK"+ ZNodeID$ 'Pe 11/27/89 PRINT #2, "IF ERRORLEVEL 1 GOTO ERR " PRINT #2, "PKZIP -m -ex " + WDR$ + WZZ$ + " " + _ ZLibWorkDiskPath$ + "WORK"+ZNodeID$ + "\*.*" PRINT #2,":ERR" IF NOT ZNetworkType = 4 THEN _ 'LK 02/24/90 PRINT #2, "CTTY CON" PRINT #2, "KDY " + ZLibWorkDiskPath$ + "WORK"+ZNodeID$ PRINT #2,"SETERROR 0" PRINT #2, "ECHO ON" PRINT #2, "EXIT" IF ZUseDeviceDriver$ <> "" AND ZFossil AND ZNetworkType = 4 THEN _ 'LK 02/24/90 MplB$ = "COMMAND.COM /C "+ MplB$ + _ 'LK 02/24/90 " > " + _ 'LK 02/24/90 ZUseDeviceDriver$ _ 'LK 02/24/90 ELSE _ 'LK 02/24/90 MplB$ = "COMMAND.COM /C "+ MplB$ 'Pe 10/05/89 CALL ShellExit (MplB$) 'Pe 10/05/89 ZFileNameHold$ = WZZ$ + ".ZIP" ZFileName$ = WDR$ + ZFileNameHold$ ' ' *** adds BBS name , users name and description to Zip comment if succesfull CALL FindIt (ZFileName$) IF ZOK THEN CLOSE 2 CALL QuickTPut ("Adding Your Name and File Description to "+ZFileNameHold$ + " .......",2) CommentName$ =ZUpldSubDir$ +"\UPLOAD.CMT ADDCMT1$ =ZCrLf$ +"Uploaded to "+ ZRBBSName$ +" By: "+ZActiveUserName$ ADDCMT2$ = ZCrLf$ +"Description: " + Desc$ ADDCOMMENT$ = ADDCMT1$ + ADDCMT2$ + ZCrLf$ CALL OpenOutW (CommentName$) PRINT #2, ADDCOMMENT$ CLOSE 2 ADDCMT$ = ZLibArcPath$+"PKZIP -z<"+CommentName$+" "+ ZFileName$ SHELL "COMMAND.COM /C "+ADDCMT$ END IF END SUB ' ' ' $SUBTITLE: 'LOCALCONVERT - subroutine to Convert to ZIP format' ' $PAGE ' ' NAME -- LOCALCONVERT ' ' PARAMETERs WDR$ drive/subdir were file is located ' WZZ$ Filename (no Extension) ' WX$ extension of file being converted ' DESC$ file description for ZIP comment 'Pe 10/05/89 ' ' PURPOSE -- Convert files to Zip format if LOCAL user ' SUB LOCALCONVERT (WDR$,WZZ$,WX$,Desc$) STATIC 'Pe 10/05/89 ' IF WX$ = ".ZIP" THEN _ CALL QuickTPut (ZFileNameHold$ +" Now being verified and re-Zipped Please wait!",1) : _ WasZ$ = "PKUNZIP -x " + ZFileName$ + " " _ ELSE _ CALL QuickTPut (ZFileNameHold$ +" Now being converted to .ZIP format. Please wait!",1) : _ IF WX$ = ".ARC" OR WX$ = ".PAK" THEN _ WasZ$ = "PAK e " + ZFileName$ + " " : _ ELSE IF WX$ = ".LZH" THEN _ WasZ$ = "LHARC e " + ZFileName$ + " " : _ ELSE IF WX$ = ".ZOO" THEN _ WasZ$ = "ZOO.BAT " + ZFileName$ + " " : _ ELSE _ WasZ$ = "COPY " +ZFileName$ + " " ' MplB$ = "CONVERT"+ZNodeID$+".BAT" CALL OpenOutW (MplB$) : _ PRINT #2, "MD " + ZLibWorkDiskPath$ + "WORK"+ZNodeID$ IF WX$ = ".LZH" THEN _ PRINT #2, WasZ$ + ZLibWorkDiskPath$ +"WORK"+ ZNodeID$ +"\" _ ELSE _ PRINT #2, WasZ$ + ZLibWorkDiskPath$ +"WORK"+ ZNodeID$ PRINT #2, "SCAN "+ZLibWorkDiskPath$ +"WORK"+ ZNodeID$ 'Pe 11/27/89 PRINT #2, "DEL " + ZFileName$ PRINT #2, "IF ERRORLEVEL 1 GOTO ERR " PRINT #2, "PKZIP -m -ex " + WDR$ +WZZ$ + " " + _ ZLibWorkDiskPath$ + "WORK"+ZNodeID$ + "\*.*" PRINT #2,":ERR" PRINT #2, "KDY " + ZLibWorkDiskPath$ + "WORK"+ZNodeID$ PRINT #2,"SETERROR 0" PRINT #2, "EXIT" CLOSE 2 SHELL MplB$ ZFileNameHold$ = WZZ$ + ".ZIP" ZFileName$ = WDR$ + ZFileNameHold$ CALL FindIt (ZFileName$) IF ZOK THEN CLOSE 2 CALL QuickTPut ("Adding Your Name and File Description to "+ZFileNameHold$ +" .......",2) CommentName$ = ZUpldSubDir$ +"\UPLOAD.CMT ADDCMT1$ =ZCrLf$ +"Uploaded to "+ ZRBBSName$ +" By: "+ZActiveUserName$ ADDCMT2$ = ZCrLf$ +"Description: " + Desc$ ADDCOMMENT$ = ADDCMT1$ + ADDCMT2$ + ZCrLf$ CALL OpenOutW (CommentName$) PRINT #2, ADDCOMMENT$ CLOSE 2 ADDCMT$ = ZLibArcPath$+"PKZIP -z<"+CommentName$+" "+ ZFileName$ SHELL ADDCMT$ END IF END SUB ' ' ' ' $SUBTITLE: 'TypeFile - subroutine to TYPE an ASCII FILE' ' $PAGE ' ' NAME -- TYPEAFILE ' ' PARAMETERs ' ' ' ' ' PURPOSE -- Type a ASCII file to screen ' SUB TypeFile STATIC 59141 CALL SkipLine (1) ZoutTxt$ = "Default Extension is .ZIP." + ZCrLf$ ' Bh ZOutTxt$ = ZOutTxt$ + "File name for Extra Info"+ZPressEnterExpert$ ' Bh CALL PopCmdStack IF ZSubParm = -1 OR ZWasQ = 0 THEN _ EXIT SUB 59142 ZViolation$ = "TYPE File" WasX = ZAnsIndex FOR ZAnsIndex = WasX TO ZLastIndex GOSUB 59143 IF ZSubParm < 0 THEN _ ZAnsIndex = ZLastIndex + 1 NEXT ZAnsIndex IF ZLastIndex > 1 THEN _ EXIT SUB _ ELSE GOTO 59141 59143 WasZ$ = ZUserIn$(ZAnsIndex) CALL AllCaps (WasZ$) IF INSTR(WasZ$,"*") OR INSTR(WasZ$,"?") THEN _ CALL QuickTPut ("Sorry, but Wildcards are NOT allowed !!",1) : _ ' Bh RETURN ZFileName$ = WasZ$ ZFileNameHold$ = WasZ$ CALL BadFile (ZFileNameHold$,BadFileNameIndex) ON BadFileNameIndex GOTO 59145,59148,59150 59145 CALL BadName (BadFileNameIndex) ON BadFileNameIndex GOTO 59146,59150 59146 dir$=LEFT$(ZFileName$,1) WasZ$ = ZWelcomeFileDrvPath$ + "RBBSEXTR\" + dir$ + "\" + ZFileName$ ' EDit the Subdir/Drive for your Setup CALL FindIt (WasZ$) ' checks to see if File really Exists IF ZOK THEN _ GOTO 59158 '59146 CALL RotorsDir (ZFileName$,ZSubDir$(),ZSubDirCount + (NOT ZSysop),ZTrue,"V") 'Pe 02/25/90 ' IF ZOK THEN _ ' Pe 02/06/90 ' GOTO 59158 59148 WasZ$ = ZUserIn$(ZAnsIndex) + _ " has NO extra info! There needs to be a + next to the date." + ZCrLf$ ' Bh ' WasZ$ = WasZ$ + _ ' "Did you give FULL FILENAME (including EXTENSION)?" + ZCrLf$ ' Bh CALL UpdtCalr ("Couldn't find Extra Info on " + ZFileName$,1) 'DGS-014 ' Bh 091990 ' CALL UpdtCalr (WasZ$,2) ZOutTxt$ = WasZ$ + _ "Perhaps you misspelled. Try typing it again ([RETURN] to quit)" ' Bh ZSubParm = 1 CALL TGet IF ZSubParm = -1 OR ZWasQ = 0 THEN _ RETURN ZUserIn$(ZAnsIndex) = ZUserIn$(1) GOTO 59143 59150 CALL SecViolation IF ZDenyAccess THEN _ EXIT SUB GOTO 59148 59158 CALL BreakFileName (WasZ$,Drive$,Prefix$,Ext$,ZFalse) IF Ext$ = "" THEN _ GOTO 59160 IF INSTR("DAT,BIN,",Ext$+",") > 0 THEN _ CALL QuickTPut ("Wrong format; I can't display info on files with " +Ext$ + " extensions",1) : _ ' Bh RETURN 59160 CALL BufFile (WasZ$,WasX) CALL UpdtCalr ("Read Extra Info on " + ZFileName$,1) 'DGS-014 ' Bh 091990 ' 59160 CALL BufFile ("E:\DES\"+ZFileName$) ' Bh 06/25/90 RETURN END SUB