* ------------[ BLED merge (c) Ken Goosens ]-------------
* Merge this against D:\172B\RBBSSUB3.BAS to produce RBBSSUB3.BAS
* D:\172B\RBBSSUB3.BAS:  Date 2-11-1990  Size 114935 bytes
* ------------[ Created 05-20-1990 20:26:37 ]------------
* REPLACING old line(s) by new
20293 ' $SUBTITLE: 'SendName - send FILENAME using EXEC-PC protocol'
' $PAGE
'
'  NAME    -- SendName
'
'  INPUTS  --  PARAMETER                    MEANING
'              ZUserIn$()                ARRAY OF FILENAME FOR AUTODOWNLOAD
* ------[ first line different ]------
'              ZAnsIndex                 Index OF FILENAME TO Transfer ' RH021501
'
'  OUTPUTS --  ZAbort                    -1 FOR AN ABORTED ATTEMPT
'
'  PURPOSE -- Send the download filename to user during an autodownload
'
      SUB SendName STATIC
'
'
' *  Transfer FILENAME TO USER
' *         PROCESS - SEND USER THE "ALERT" CHARACTER SEQUENCE -- <ESC>OD
' *                   THEN THIS IS FOLLOWED BY CHARACTER-BY-CHARACTER
' *                   TRANSMISSION OF THE FILENAME WITH ECHO.  IF ANY OF THE
' *                   CHARACTERS OF THE FILENMAE ARE GARBLED A SERIES OF
' *                   <CAN> ARE SENT, OTHERWISE AN <ACK> IS SENT AT
' *                   COMPLETION AND FILE Transfer BEGINS.
'
'
      ZAbort = ZFalse                    ' RESET ABORT FLAG
      Attempts = 0                       ' RESET COUNT FOR # OF TRANS Attempts
* REPLACING old line(s) by new
20296 CALL FlushCom(ZWasY$)              ' CLEAR THE COMM BUFFER OF GARBAGE
      IF ZSubParm = -1 THEN _
         EXIT SUB
      CALL PutCom (ZEscape$+"OD")         ' SEND "ALERT" STRING
      IF ZSubParm = -1 THEN _
         EXIT SUB
      IF ZAbort = ZTrue THEN _
         GOTO 20306
      CALL LPrnt("Sending FILENAME -- ",1)
      CALL LPrnt(ZReturnLineFeed$ + CHR$(9),0)
      CALL DelayTime (1)                   ' WAIT 1 SECOND FOR SETUP
'
'               SEND ONE CHARACTER AT A TIME
'
* ------[ first line different ]------
      CALL BreakFileName (ZUserIn$(ZAnsIndex),WasX$,ZOutTxt$,ZWasY$,ZTrue) ' RH021501
      ZOutTxt$ = ZOutTxt$ + ZWasY$ + "=X"                            ' RH021501
      FOR WasX = 1 TO LEN(ZOutTxt$)
         CALL PutCom (MID$(ZOutTxt$,WasX,1))     ' SEND 1 CHARACTER
         IF ZSubParm = -1 THEN _
            EXIT SUB
         IF ZAbort = ZTrue THEN _
            GOTO 20306
         CALL LPrnt(MID$(ZOutTxt$,WasX,1),0)     ' DISPLAY IF NEEDED
         ZDelay! = TIMER + 10            ' SET MAXIMUM TIME TO WAIT FOR Reply
         Char = ZTrue
         WHILE Char = -1
            CALL CheckTime(ZDelay!, TempElapsed!, 1)
            IF TempElapsed! <= 0 THEN _
               GOTO 20300     ' IF ZNo ECHO, CANCEL FILENAME Transfer
            CALL EofComm (Char)
         WEND                 ' JUMP OUT IF CHARACTER IS RECEIVED
* REPLACING old line(s) by new
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)
* ------[ first line different ]------
      MID$(ZMsgRec$,48,5) = MKS$(ZNumDnldBytes!) + MID$(STR$(-ZBatchTransfer),2) ' KG022101
      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
* REPLACING old line(s) by new
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))
* ------[ first line different ]------
      ZNumDnldBytes! = CVS(MID$(ZMsgRec$,48,4))                      ' KG022101
      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
* REPLACING old line(s) by new
* ------[ first line different ]------
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
* REPLACING old line(s) by new
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$ = ""
* ------[ first line different ]------
      FirstWarning = ZTrue                                           ' KG041103
      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$
      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 _
            IF VAL(Year$) > 79 THEN _                                ' KG041103
               WasL = WasL + 1 : _                                   ' KG041103
               Ara(WasL,1) = 372! * (VAL(Year$) - 80!) + 31! * VAL(WasMM$) + VAL(WasDD$) _' KK030901
            ELSE IF FirstWarning THEN _                              ' KG041103
                    FirstWarning = ZFalse : _                        ' KG041103
                    ZWasZ$ = "Invalid FMS format " + ZFMSDirectory$ : _ ' KG041103
                    CALL PScrn (ZWasZ$) : _                          ' KG041103
                    CALL UpdtCalr (ZWasZ$,2)                         ' KG041103
         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
* REPLACING old line(s) by new
58169 CALL CheckInt (MID$(PartToPrint$,34))
      IF ZUserSecLevel < ZTestedIntValue THEN _
         LastOK = ZFalse : _
* ------[ first line different ]------
         FailedSearch = ZFalse : _                                   ' DA042401
         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
* REPLACING old line(s) by new
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))
      IF ZUserIn$(1) = "V" THEN _
         ZLastIndex = ZWasQ : _
         ZAnsIndex = 1 : _
         CALL GetArc : _
* ------[ first line different ]------
         ZJumpSupported = ZTrue : _                                  ' KG022201
         ZWasA = UpldIndex : _
         GOSUB 58185 : _
         UpldIndex = ZWasA : _
         GOTO 58180
      IF ZUserIn$(1) = "D" THEN _
         ZOutTxt$ = "Download what file(s)" : _
         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.  Really go non-stop? (Y/[N])" : _
            ZNoAdvance = ZTrue : _
            ZTurboKey = -ZTurboKeyUser : _
            ZSubParm = 1 : _
            CALL TGet : _
            CALL WipeLine (79) : _
            ZNonStop = ZYes
      FMSCheckPoint = 0
      GOTO 58168
* REPLACING old line(s) by new
58183 CLOSE 2
      ZNonStop = (ZPageLength < 1)
      ZStopInterrupts = ZFalse
      ZOutTxt$ = ""
* ------[ first line different ]------
      ZActiveFMSDir$ = ""                                            ' KG031801
      ZJumpSupported = ZFalse
      EXIT SUB