Category : BBS Programs+Doors
Archive   : RBBS-MRG.ZIP
Filename : RSB41028.MRG
* Merge this against 17.3A\RBBSSUB4.BAS to produce 17.3B\RBBSSUB4.BAS
* 17.3A\RBBSSUB4.BAS: Date 9-25-1990 Size 127433 bytes
* ------------[ Created 10-28-1990 12:00:02 ]------------
* REPLACING old line(s) by new
' $linesize:132
* ------[ first line different ]------
' $title: 'RBBSSUB4.BAS 17.3B, Copyright 1986 - 90 by D. Thomas Mack' ' DA081003
' Copyright 1990 by D. Thomas Mack, all rights reserved.
' Name ...............: RBBSSUB4.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
' AnyBut 59760 Determine where a "word" begins
' AskUsers 64003 Ask users questions based on a script and save answers
' AskMore 59858 Check whether screen full
' AutoPage 60300 Check whether to notify sysop caller is on
' BadFileChar 59800 Check file name for bad character
' Bracket 59960 Puts strings around a substring
' BufFile 58400 Write a file to the user quickly
' BufString 58300 Write a string with imbedded CR/LF to the user quickly
' CheckColor 59930 Highlighting based on search string
' SearchArray 58190 Check for the occurance of a string in an array
' ColorDir 59920 Adds colorization to FMS directory entry
' ColorPrompt 59940 Colorizes prompts
' CompDate 59880+ Produces a computational data from YY, MM, DD
' ConfMail 59854 Check conference mail waiting
' ConvertDir 58950 Checks for U & A (shorthand) and converts appropriately
' PackDate 59201 Compress date in string format to 2 characters
' EofComm 60000 Determine whether any chars in comm port buffer
' ExpireDate 59890 Calculate registration expiration date
' FakeXRpt 62650 Write out file transfer report for protocols that don't
' FindEnd 58770 Find where a "word" ends
' FindFile 58790 Determine whether a file exists without opening it
' FindLast 58600 Find last occurence of a string
' FMS 58200 Search the upload management system for entries
' GetAll 59780 Get list of all directories to display
' GetDirs 58895 Prompts for directories for file list/new/search cmds
' GetMsgAttr 62530 Restore attributes of original message
' GetYMD 59204 Pulls YY, MM, or DD from a 2 byte stored date
' GlobalSrchRepl 60100 Global search and replace
' LogPDown 59400 Records download in private directory
' MarkTime 60200 Give visual feedback during lengthy process
' MetaGSR 60130 Meta statement global search and replace
' MsgImport 59698 Allow local user to import a text file to a message
' Muzak 59100 Play musical themes for different RBBS functions
' NewPassword 60668 Get a new password
' PersFile 59300 View and select personal files for downloading
' Protocol 62600 Determine if external protocols are available
' PutMsgAttr 62520 Save attributes of original message
' Remove 58210 Remove characters from within strings
' RotorsDir 58700 Searches for a file using list of subdirs
' RptTime 62540 Report date/time and time on
' SetEcho 59600 Set RBBS properly for who is to echo
' SetHiLite 59934 Set user preference on highlighting
' SetGraphic 59980 Sets graphic preference for text file display
' SmartText 58250 Process SMART TEXT control strings
' SubMenu 59500 Processes options that have sub-menus
' TimedOut 63000 Write timed exit semaphore file
' TimeLock 60180 Check for TIME LOCK on certain features
' Transfer 62624 RBBS-PC support for external protocols for file transfer
' Toggle 57000 Toggles or views user options
' TwoByteDate 59200 Reduces a data to 2 byte string for space compression
' UnPackDate 59902 Uncompresses a 2 byte date
' UserColor 59965 Lets user set color for text and whether bold
' UserFace 59450 Processes programmable user interface
' ViewArc 64600 Display .ARC file contents to user
' PrivDoorRtn 62629 Private door exit routine
' WipeLine 58800 Wipes away a line so next prints in its place
' WordWrap 59710 Adjust a msg -- wrap lines and perserve paragraphs
'
' $INCLUDE: 'RBBS-VAR.BAS'
'
* REPLACING old line(s) by new
59400 ' $SUBTITLE: 'LogPDown -- subroutine to record private downloads'
' $PAGE
'
' NAME -- LogPDown
'
' INPUTS -- PARAMETER MEANING
'
' OUTPUTS --
'
' PURPOSE -- Puts a "!" in place of an "*" in private directory
' after downloaded
'
SUB LogPDown (PrivateDnld,DwnIndex) STATIC ' RH021501
IF NOT PrivateDnld THEN _
EXIT SUB
ZWasEN$ = ZPersonalDir$
WasBX = &H4
ZSubParm = 9
CALL FileLock
WasL = 36 + ZMaxDescLen + ZPersonalLen
CLOSE 2
IF ZShareIt THEN _
OPEN ZWasEN$ FOR RANDOM SHARED AS #2 LEN=WasL _
ELSE OPEN "R",2,ZPersonalDir$,WasL
FIELD #2,WasL AS PersonalRec$
* ------[ first line different ]------
FOR Temp = 1 TO ZDownFiles ' KG102702
ZWasA = VAL(MID$(ZUserIn$(0),5 * (DwnIndex - Temp) + 1,5)) ' KG102702
GET #2,ZWasA ' KG102702
MID$(PersonalRec$,WasL-2,1) = "!" ' KG102702
PUT #2,ZWasA ' KG102702
NEXT ' KG102702
CALL UnLockAppend
END SUB
* REPLACING old line(s) by new
59510 ZFileName$ = CurMenu$
InMenu = ZTrue ' KG041701
* ------[ first line different ]------
CALL BreakFileName (FrontOpt$,WasX$,FrontPre$,ZWasDF$,ZTrue) ' KG101101
CALL BreakFileName (CurMenu$,MenuDrv$,WasX$,ZWasDF$,ZTrue)
MenuFront$ = MenuDrv$ + LEFT$(WasX$,LEN(WasX$)-LEN(PreSuf$)) ' KG090801
IF CurMenu$ = LastSubMenu$ THEN _ ' KG090801
MenuFront$ = LEFT$(MenuFront$,LEN(MenuFront$)-1) ' KG090801
CALL Graphic (GRDefault$,ZFileName$)
CurMenuVer$ = ZFileName$
ZStopInterrupts = ZFalse
IF ZAnsIndex < ZLastIndex OR ZExpertUser THEN _
GOTO 59520
* REPLACING old line(s) by new
59530 ZWasZ$ = ZUserIn$(ZAnsIndex)
CALL AllCaps (ZWasZ$)
IF INSTR(ReturnOn$,ZWasZ$) THEN _ 'check whether calling pgm wants
EXIT SUB
IF INSTR("LH?",ZWasZ$) THEN _ 'check whether caller wants help
GOTO 59515
IF INSTR(ZWasZ$,".") > 0 THEN _
GOTO 59532
CALL BadFile (ZWasZ$,WasBF) ' KG081705
IF WasBF > 1 THEN _ ' KG081705
GOTO 59532 ' KG081705
FPre$ = MenuFront$ ' check for sub-option ' KG081603
PreSuf$ = "-" ' KG090801
CALL BadFile (FPRE$ + ZWasZ$ + "-",WasBF) ' KG090801
ZOK = ZFalse ' KG082401
IF WasBF < 2 THEN _ ' KG082401
VerifyInMenu = ZFalse : _ ' KG082401
GOSUB 59538
PreSuf$ = "" ' KG090801
VerifyInMenu = PassedVerifyInMenu ' KG082005
IF NOT ZOK THEN _ ' KG081603
FPre$ = FrontOpt$ : _ ' check standard option ' KG081603
GOSUB 59538 : _
IF NOT ZOK THEN _ ' check option where menu is ' KG081603
* ------[ first line different ]------
FPre$ = MenuDrv$ + FrontPre$ : _ ' KG101101
IF FrontOpt$ <> FPre$ THEN _ ' KG101101
GOSUB 59538 ' KG101101
IF NewMenu THEN _
NewMenu = ZFalse : _
GOTO 59515
IF ZOK THEN _
EXIT SUB
* REPLACING old line(s) by new
* ------[ first line different ]------
59532 IF INSTR(ReturnOn$,LEFT$(ZWasZ$,1)) > 0 THEN _ ' KG102202
ZWasZ$ = LEFT$(ZWasZ$,1) : _ ' KG102202
EXIT SUB
GOSUB 59547
GOTO 59515
* REPLACING old line(s) by new
59538 FilName$ = FPre$ + ZWasZ$ + PreSuf$ ' KG090801
ZFileName$ = FilName$ + BackOpt$ ' KG090801
* ------[ first line different ]------
GOSUB 59543 ' KG101201
IF WasBF > 1 THEN _ ' KG101201
ZOK = ZFalse : _ ' KG101201
RETURN ' KG101201
CALL Graphic (GRDefault$,ZFileName$)
IF NOT ZOK THEN _
IF BackOpt2$ <> "" THEN _
ZFileName$ = FilName$ + _
BackOpt2$ : _
GOSUB 59543 : _ ' KG101201
IF WasBF > 1 THEN _ ' KG101201
ZOK = ZFalse : _ ' KG101201
RETURN _ ' KG101201
ELSE CALL Graphic (GRDefault$,ZFileName$) ' KG101201
IF ZOK THEN _ ' KG092301
CALL WordInFile (CurMenu$,ZWasZ$,InMenu) : _ ' KG092301
IF ZSysop OR InMenu OR (NOT RequireInMenu) THEN _ ' KG092301
RETURN _
ELSE GOTO 59540
IF (NOT VerifyInMenu) THEN _
GOTO 59540
CALL WordInFile (CurMenu$,ZWasZ$,InMenu) 'verify against menu itself ' KG032502
IF InMenu THEN _ ' KG032502
IF AllMenuOK THEN _
RETURN
* INSERTING new line(s)
59543 WasZ$ = ZWasZ$ ' KG101201
CALL BadName (WasBF,ZFalse) ' KG101201
ZWasZ$ = WasZ$ ' KG101201
RETURN ' KG101201
* REPLACING old line(s) by new
60300 ' $SUBTITLE: 'AutoPage - NOTIFIES ZSysop WHEN SPECIFIC USER CALLS'
' $PAGE
'
' NAME -- AutoPage 'Contributed by Gregg and Bob Snyder
' 'and RoseMarie Siddiqui
'
' INPUTS -- ZAutoPageDef$ List of conditions that trigger
' notification and how
'
' OUTPUTS -- NONE
'
' PURPOSE -- Search ZAutoPageDef$ for match on whether
' on name, security level, whether new user.
' Also controls whether caller notified and
' number of times sysop has bell rung.
' And what tune to play (if any).
'
SUB AutoPage STATIC
CALL FindIt (ZAutoPageDef$)
IF NOT ZOK THEN _
EXIT SUB
ZErrCode = 0
ZOK = ZFalse
WHILE NOT EOF(2) AND ZOK = ZFalse AND ZErrCode = 0
CALL ReadParms (ZWorkAra$(),4,1)
IF ZErrCode = 0 THEN _
ZOK = (ZWorkAra$(1) = ZActiveUserName$) : _
IF NOT ZOK THEN _
IF ZNewUser AND ZWorkAra$(1) = "NEWUSER" THEN _
ZOK = ZTrue _
ELSE IF LEFT$(ZWorkAra$(1),1) = "/" AND LEN(ZWorkAra$(1)) > 2 THEN _
ZWasB = INSTR (2,ZWorkAra$(1),"/") : _
IF ZWasB > 0 AND LEN(ZWorkAra$(1)) > ZWasB THEN _
IF ZUserSecLevel <= VAL(MID$(ZWorkAra$(1),ZWasB+1)) AND _
ZUserSecLevel >= VAL(MID$(ZWorkAra$(1),2)) THEN _
ZOK = ZTrue
WEND
CLOSE 2
IF ZErrCode > 0 OR NOT ZOK THEN _
ZErrCode = 0 : _
EXIT SUB
ZPageStatus$ = "AP!" ' DA080902
IF LEFT$(ZWorkAra$(2),1) = "N" THEN _
ZOutTxt$ = "Telling sysop you're on..." : _
CALL RingCaller
ZWasB = (ZWorkAra$(4) = "")
ZWorkAra$(5) = ""
* ------[ first line different ]------
TempSnoop = ZSnoop ' DA101801
ZSnoop = ZTrue ' DA101801
CALL Line25 ' DA102401
FOR WasI = 1 TO VAL(ZWorkAra$(3))
IF ZWasB THEN _
CALL LPrnt (ZBellRinger$,0) : _
ELSE ZWorkAra$(5) = ZWorkAra$(5) + "O4 X" + VARPTR$(ZWorkAra$(4))
NEXT
IF NOT ZWasB THEN _
CALL RBBSPlay (ZWorkAra$(5))
ZSnoop = TempSnoop ' DA101801
END SUB
* REPLACING old line(s) by new
64462 CALL CheckInt (ZOutTxt$)
IF ZErrCode = 0 THEN _
Temp = ZUserSecLevel + _
WasX * ZTestedIntValue : _
IF Temp <= MaxSecLevel THEN _
ZUserSecLevel = Temp : _
ZUserSecSave = ZUserSecLevel : _
ZAdjustedSecurity = ZTrue
* ------[ first line different ]------
IF ZOrigMsgFile$ = ZActiveMessageFile$ THEN _ ' KG102703
ZOrigSec = ZUserSecLevel ' KG102703
GOTO 64110
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/