Comment
=============================================================

MarxMenu BBS Program
Copyright 1992-93 by Marc Perkel * All Rights Reserved

This program demonstrates how MarxMenu can be used as a Bulletin Board.
It isn't done yet but it does work.

This software is operational on Computer Tyme BBS on 3 lines.
The number is 417-866-1665.

=============================================================
EndComment


var
  AbortBBS
  BarString
  FilesToDownload
  UploadName
  LastFile
  StartTime
  LogonTime
  LogoutTime
  Sysop
  IdleStart
  DisconnectTime
  CallLimit
  StatusWindow
  BBSWindow
  ConnectSpeed
  ConnectString
  SupportPeople
  LastMenu
  LastMessage
  OrigMessage
  MessageFrom
  MessageConnection
  Downloading
  LoginCount
  BBSLine
  Stats
  TodayLogFileName
  YesterdayLogFileName
  TimeToLogin
  PortInitialized
  Sending
  SendFileTo


Include 'BBSDEF.INC'

;----- FileNames

var
  LogFileName = 'V:\BBS.LOG'
  TempLogFileName = 'H:\BBSTEMP.LOG'
  CountFile = 'V:\LOGIN.CNT'


;----- Initialization

Mouse Off
AnsiWindows

ComPort = Com1

BarString = 'лллллллллллллллллллллллллллллллллллллллллллллллллллллл'


Procedure InitComPort
   Write 'Initializing Comport ... '
   if PortInitialized then Return
   ComInitPort(57600,8,'N',1)
   Hangup
   ResetModem On
   Writeln 'Ready'
   PortInitialized On
EndProc


Procedure ResetModem (Answer)
   ComWatchCD Off
   ComEchoRecChar Off
   ComEchoSendChar Off
   ComWriteln 'ATZ'
   WaitFor 'OK'
   if Answer
      ComWriteln 'AT S0=1 M0'
      WaitFor 'OK'
   endif
EndProc


Procedure Hangup
   if ComCD
;      ComDrainSendBuffer
      Wait 300
      ComDTR Off
      Wait 100
      ComDTR
      Wait 200
   endif
   AbortBBS
EndProc


Procedure WaitFor (St)
var S
   S = Now
   ComLastLine = ''
   while (ComLastLine <> St) and (Now - S < 20)
      ComCheckActivity
   endwhile
   Wait 20
EndProc


Procedure WaitForKey
   ComEchoRecChar Off
   ComLastChar = ''
   IdleStart = Now
   while ComLastChar = ''
      ComCheckActivity
   endwhile
   ComEchoRecChar
EndProc


Procedure GarbageInString (St)
   Loop Length St
      if not within (Ord(Mid(St,LoopIndex,1)),32,170)
         Return True
      endif
   EndLoop
   Return False
EndProc

;------ Yes or No

Procedure YesNo (Prompt, Orig)
var Answer
   ComWrite Prompt '? ' Orig Char(8)
   WaitForKey
   if ComLastChar = CR then ComLastChar = Orig
   Answer = ComLastChar = 'Y'
   if Answer
      ComWriteln 'Yes'
   else
      ComWriteln 'No'
   endif
   Wait 20
   Return Answer
EndProc


Procedure BBSPause (St)
var BlankSt
   ComWrite(St)
   BlankSt = ''
   Length(BlankSt) = Length(St)
   WaitForKey
   ComWrite(CR + BlankSt + CR)
   LastMenu = ''
EndProc


Procedure SendArray (A)
var LineCount Line
   ComLastChar = ''
   Loop A
      ComCheckActivity
      LineCount = LineCount + 1
      if LineCount = 24
         LineCount = 0
         BBSPause('More [Y/n] ... ')
      endif
      if (ComLastChar = 'N') or (ComLastChar = 'S')
         EmptyBuf
         return
      endif
      Line = LoopVal
      ComWriteln Line
   EndLoop
   if Line > '' then ComWriteln
   BBSPause('Press Any Key ... ')
EndProc


Procedure EmptyBuf
   ComEmptySendBuffer
EndProc


Procedure DateTimeSt
   Return DateString + ' ' + TimeString
EndProc


Procedure LogBBSEvent (St)
   FileLog(TempLogFileName,St)
EndProc


Procedure SendMenuScreen (A)
   EmptyBuf
   Loop A
      ComWriteln LoopVal
   EndLoop
EndProc

;----- User Log Routines

Procedure FindUserName
   BtrvGetEqual(User,LoginName,2,UserFileHandle)
   Sysop = User.Access >= 100
EndProc


Procedure UpdateUserLog
   BtrvUpdate(User,UserFileHandle)
EndProc


Procedure CountLogins
   if ExistFile CountFile
      ReadTextFile(CountFile,LoginCount)
      LoginCount[1] = Str(Value(LoginCount[1]) + 1)
   else
      LoginCount[1] = '0'
   endif
   WriteTextFile(CountFile,LoginCount)
   LoginCount = Value(LoginCount[1])
EndProc


Procedure AskForAddress
   ComWriteln
   ComWriteln 'Example: "Denver CO" or "Bonn Germany"
   ComWrite   'Where are you from: '
   InputLine(Yes)
   User.From = ComLastLine
   ComWriteln
EndProc


Procedure AskForPhone
   ComWriteln
   ComWriteln 'Enter your phone number with area code as follows: 417-866-1665'
   ComWriteln 'If you live outside North America then include your country code.'
   ComWriteln
   ComWrite   'Your voice phone number: '
   InputLine(Yes)
   User.Phone = ComLastLine
   ComWriteln
EndProc


Procedure AskForCompany
   ComWriteln
   ComWriteln 'What company are you with? - Enter NONE if not with a Company.'
   ComWriteln
   ComWrite   'Your Company: '
   InputLine(Yes)
   User.Company = ComLastLine
   ComWriteln
EndProc


Procedure AskForPassword
   repeat
      ComWriteln
      ComWrite   ' Enter a Password: '
      InputLine(No)
      User.Password = ComLastLine
      ComWrite CR 'Enter Password again for Verification: '
      InputLine(No)
      ComWriteln
      if User.Password = ComLastLine
      else
         ComWriteln 'Password mismatch, Try Again!'
         Wait 100
      endif
   until User.Password = ComLastLine
EndProc


Procedure AskForInformation
   if User.From = ''
      AskForAddress
   endif
   if User.Company = ''
      AskForCompany
   endif
   if User.Phone = ''
      AskForPhone
   endif
   if User.Password = ''
      AskForPassword
   endif
EndProc


Procedure CreateNewUser
var New
   TimeToLogin = 300
   ClearScreen
   ComWriteln
   ComWriteln 'Welcome ' LoginName
   ComWriteln
   ComWriteln 'I need a few pieces of information for our records.'
   ComWriteln "I'll need to know where you're from, phone, company, and a password."
   AskForInformation
   ComWriteln 'You are ' LoginName ' from ' User.From
   if YesNo('Is this Correct','Y')
      ComWriteln
      User.RecNum = 0
      User.Name = LoginName
      User.Access = 0
      User.Flags = ''
      User.FirstCall = DateString
      User.LastCall = User.FirstCall
      User.Calls = 1
      BtrvInsert(User,UserFileHandle)
      BtrvGetEqual(User,User.Name,2,UserFileHandle)
      NewUser
   else
      dispose(User)
      LoginName = ''
   endif
EndProc


Procedure LoginToBBS
var PromptUser
   Dispose(User)
   LoginName = ''
   PromptUser On
   while not AbortBBS
      if PromptUser
         ComLastLine = ''
         ComWriteln
         ComEchoRecChar = User.Password = ''
         if ComEchoRecChar
            ComWrite 'What is your FULL name: '
         else
            ComWrite 'Password: '
         endif
         PromptUser Off
      endif
      ComCheckActivity
      if ComLastLine > ''
         PromptUser On
         if GarbageInString(ComLastLine)
            ComWriteln
            ComWriteln
            ComWriteln 'I got some line noise in that entry. Try Again!
            ComLastLine = ''
         else
            if User.Password = ''
               LoginName = ComLastLine
               ComLastLine = ''
               if pos(' ',LoginName) = 0
                  ComWriteln
                  ComWriteln
                  ComWriteln 'You need to enter your FIRST and LAST name!
                  LoginName = ''
               else
                  FindUserName
                  if User.Password = ''
                     ComWriteln
                     ComWriteln 'User ' LoginName ' not Found!'
                     ComWriteln
                     if YesNo('Login as New User','Y')
                        CreateNewUser
                        if LoginName > '' then Return
                     endif
                  endif
               endif
            else
               if ComLastLine = User.Password
                  ComWriteln
                  AskForInformation
                  if pos('MARX',User.Password) > 0
                     ComWriteln
                     ComWriteln 'You need to change your password!'
                     ComWriteln
                     AskForPassword
                  endif
                  Sysop = User.Access >= 100
                  ComWriteln
                  Return
               else
                  ComWriteln
                  ComWriteln 'Bad Password!'
                  dispose(User)
                  ComLastLine = ''
               endif
            endif
         endif
      endif
   endwhile
EndProc


Procedure ChoiceLine (St)
var CapPos
   CapPos = 1
   while not (Mid(St,CapPos,1) within ('A','Z'))
      CapPos = CapPos + 1
   endwhile
   ComWrite Left(St,CapPos - 1)
   TextColor Yellow Black
   ComWrite Mid(St,CapPos,1)
   TextColor Brown Black
   ComWriteln Mid(St,CapPos + 1,255)
EndProc


Var CurrentMenu MenuStack


Procedure TextHeader (L1,L2)
var Wide LeftEdge

   TextColor Brown Black
   ClearScreen

   Wide = Length(L1)
   LeftEdge = 32 - (Wide / 2)

   if L2 > ''

      GotoXY(LeftEdge + 4,6)
      TextColor Brown Black
      ComWrite Left(BarString,Wide + 6)

      GotoXY(LeftEdge + 4,2)
      ComWrite Left(BarString,Wide + 6)

      GotoXY(LeftEdge,4)
      TextColor Mag Black
      ComWrite Left(BarString,Wide + 14)

      GotoXY(LeftEdge + 2,3)
      TextColor Brown Black
      ComWrite Left(BarString,4)
      TextColor Yellow Black
      ComWrite ' ' L1 ' '
      TextColor Mag Black
      ComWrite Left(BarString,4)

      GotoXY(LeftEdge + 2,5)
      ComWrite Left(BarString,4)
      TextColor Yellow Black
      ComWrite ' ' L2 ' '
      TextColor Brown Black
      ComWrite Left(BarString,4)
      GotoXY(25,8)

   else

      GotoXY(LeftEdge + 4,2)
      TextColor Brown Black
      ComWrite Left(BarString,Wide + 6)

      GotoXY(LeftEdge + 4,3)
      ComWrite Left(BarString,2)
      TextColor Yellow Black
      ComWrite ' ' L1 ' '
      TextColor Mag Black
      ComWrite Left(BarString,2)

      GotoXY(LeftEdge + 4,4)
      ComWrite Left(BarString,Wide + 6)
      TextColor Brown Black
      GotoXY(25,6)

   endif

EndProc


Procedure MenuHeader (L1,L2)

   TextHeader (L1,L2)

   ComWrite '<'
   TextColor Yellow Black
   ComWrite '0'
   TextColor Brown Black
   ComWrite '> Main Menu   <'
   TextColor Yellow Black
   ComWrite 'G'
   TextColor Brown Black
   ComWrite '> GoodBye'

   if L2 = ''
      GotoXY(25,7)
   else
      GotoXY(25,9)
   endif

   ComWrite '<'
   TextColor Yellow Black
   ComWrite '-'
   TextColor Brown Black
   ComWrite '> Prev Menu   <'
   TextColor Yellow Black
   ComWrite '*'
   TextColor Brown Black
   ComWrite '> Utility'
   ComWriteln
   ComWriteln

EndProc


Procedure RJNumber (N,Size)
var St
   St = Str(N)
   while length St < Size
      St = ' ' + St
   endwhile
   Return St
EndProc


Procedure DirName
   Return 'F:\BBS\DLOADS\' + CurrentMenu + '\'
EndProc

;----- ESC aborts UpLoad or Download

Procedure XmitAbort
var Ch
   if AbortBBS then Return True
   if not KbdReady then Return False
   Ch = ReadKey
   if Ch <> Esc then Return False
   Return True
EndProc

;----- If same file name then overwrite

Procedure FileNameCollision
   if ExistFile ComFullFileName
      DelFile ComFullFileName
   endif
   Return True
EndProc


Procedure ResultString
   if ComResult = 0
      Return ''

   elseif ComResult = 2
      Return 'File not Found'

   elseif ComResult = 3
      Return 'Path not Found'

   elseif ComResult = 5
      Return 'Access Denied'

   elseif ComResult = 2923
      Return 'Timeout'

   elseif (ComResult = 9901) or (ComResult = 9902)
      Return 'Aborted'

   elseif ComResult = 9920
      Return 'Too Many Errors'

   elseif ComResult = 9930
      Return 'Skipped File'

   else
      Return Str(ComResult)

   endif

EndProc


Procedure LogFileTransfer (FileName)
var St Dow SendTo
   if FileName = '' then Return
   St = ResultString
   if St > '' then St = ' - ' + St
   if Sending
      Dow = ' Download: '
   else
      Dow = ' Upload: '
      if SendFileTo > '' then SendTo = ' to ' + SendFileTo
   endif
   LogBBSEvent('   ' + ComProtocol + Dow + FileName + St + SendTo)
EndProc


;----- Display file transfer status

Procedure XmitStatus
var Progress ProgAdjust BarSize X
   IdleStart = Now
   if ComXmitStarting
      DoubleLineBox
      BoxBorderColor LCyan Mag
      BoxInsideColor White Mag
      BoxHeaderColor Yellow Cyan
      BoxHeader ' Transfer Status - ' + ComProtocol + ' '
      DrawBox 43 6 35 11

   elseif ComXmitEnding
      EraseTopWindow
      LastFile = ''
   else

      BarSize = WindowWidth - 9
      if ComFileName <> LastFile
         LastFile = ComFileName
         StartTime = Now
      endif

      GotoXY 1 1
      Write '         File Name: ' ComFileName
      ClearLine
      Writeln

      Write ' Bytes Transferred: ' ComBytesTransferred
      ClearLine
      Writeln

      Write '   Bytes Remaining: ' ComBytesRemaining
      ClearLine
      Writeln

      Write '               CPS: '
      if Now > StartTime
         X = ComBytesTransferred / (Now - StartTime)
         if X / 20 > 0
            X = X / (X / 20) * (X / 20)
         endif
         Write X
      else
         Write '0'
      endif
      ClearLine
      Writeln

      Write '         File Size: ' ComFileSize
      ClearLine
      Writeln

      Write '        Block Size: ' ComBlockSize
      ClearLine
      Writeln

      Write '      Block Errors: ' ComBlockErrors
      ClearLine
      Writeln

      Write '      Total Errors: ' ComTotalErrors
      ClearLine

      if ComFileSize > 0
         ProgAdjust = ComFileSize / BarSize / 2
         Progress = ComBytesTransferred + ProgAdjust * BarSize / ComFileSize
         Writeln
         Write ' ['
         Loop Progress
            Write 'А'
         endloop
         Loop BarSize - Progress
            Write ' '
         endloop
         Write '] ' ComBytesTransferred * 100 / ComFileSize '%'
         ClearLine
      endif

   endif
EndProc


Procedure PickProtocol
   ClearScreen
   TextColor Yellow Black
   ComWriteln 'Choose Upload/Download Protocol'
   TextColor Brown Black
   ComWriteln
   if NumberOfElements(FilesToDownLoad) < 2
      ComWriteln '1 - Xmodem'
      ComWriteln '2 - 1kXmodem'
   endif
   ComWriteln '3 - Ymodem'
   ComWriteln '4 - YmodemG'
   ComWriteln '5 - Zmodem'
   ComWriteln '6 - Kermit'
   ComWriteln
   ComWrite   'Select: '
   WaitForKey
   if ComLastChar = '1'
      ComWriteln CR 'Protocol=Xmodem'
      Return 1

   elseif ComLastChar = '2'
      ComWriteln CR 'Protocol=1kXmodem'
      Return 2

   elseif ComLastChar = '3'
      ComWriteln CR 'Protocol=Ymodem'
      Return 3

   elseif ComLastChar = '4'
      ComWriteln CR 'Protocol=YmodemG'
      Return 4

   elseif ComLastChar = '5'
      ComWriteln CR 'Protocol=Zmodem'
      Return 5

   elseif ComLastChar = '6'
      ComWriteln CR 'Protocol=Kermit'
      Return 6

   endif
   Return 0
EndProc


Procedure DownloadFiles
var Proto
   Proto = PickProtocol
   ComWriteln 'Start your download now.'
   Sending On
   if Proto = 1
      ComSendXmodem(FilesToDownload)

   elseif Proto = 2
      ComSend1kXmodem(FilesToDownload)

   elseif Proto = 3
      ComSendYmodem(FilesToDownload)

   elseif Proto = 4
      ComSendYmodemG(FilesToDownload)

   elseif Proto = 5
      ComTraceInit
      ComSendZmodem(FilesToDownload)

      ;- Trace Zmodem errors

      if ComResult <> 2921
         ComTraceAbort
      else
         ComTraceDump 'V:\ZDMP'
      endif

   elseif Proto = 6
      ComSendKermit(FilesToDownload)

   endif
   LastMenu = ''
   Dispose(FilesToDownLoad)
EndProc


Procedure GetUploadName
   ComWrite CR 'Name of File: '
   InputLine(Yes)
   UploadName = ComLastLine
   ComWriteln
   Return UploadName
EndProc


Procedure UploadFiles
var Proto
   Proto = PickProtocol
   ComWriteln 'Start your upload now.'
   Sending Off
   if Proto = 1
      ComRecXmodem(GetUploadName)

   elseif Proto = 2
      ComRec1kXmodem(GetUploadName)

   elseif Proto = 3
      ComRecYmodem

   elseif Proto = 4
      ComRecYmodemG

   elseif Proto = 5
      ComRecZmodem

   elseif Proto = 6
      ComRecKermit

   endif
EndProc


Procedure UploadAnyFile
var OldUploadDir
   LastMenu = ''
   OldUploadDir = ComRecDirectory
   ComWrite CR 'Upload Directory: '
   InputLine(Yes)
   ComRecDirectory = ComLastLine
   UploadFiles
   ComRecDirectory = OldUploadDir
EndProc


Procedure InputLine (Show)
   ComLastLine = ''
   ComLastChar = ''
   ComEchoRecChar Show
   IdleStart = Now
   repeat
      ComCheckActivity
   until (ComLastLine > '') or AbortBBS or (ComLastChar = CR)
   ComEchoRecChar Off
EndProc


Procedure Numeric (St)
   loop length(St)
      if not (Mid(St,LoopIndex,1) within('0','9')) then Return False
   endloop
   Return True
EndProc


Procedure DisplayDirectory
var
   DirArray FileArray DispArray Line FileCount FileName FullName St
   LineCount Quiet V DispName

   ClearScreen
   Dispose(FilesToDownload)
   ComLastChar = ''
   ReadTextFile(DirName + CurrentMenu + '.DIR',DirArray)
   loop DirArray
      ComCheckActivity
      if ComLastChar = 'S'
         Quiet
      endif
      Line = LoopVal
      if left(Line,1) = ';'
         if not Quiet
            delete(Line,1,1)
            ComWriteln Line
         endif
      elseif Line > ' '
         FileCount = FileCount + 1
         DispName = UpperCase(NextWord(Line))
         FileName = UpperCase(NextWord(Line))
         FullName = FileName
         if pos('\',FileName) = 0
            FullName = DirName + FileName
         endif
         FileArray[FileCount] = FullName
         DispArray[FileCount] = DispName
         if not Quiet
            ComWrite RJNumber(FileCount,2) ' '
            ComWrite DispName
            loop 13 - Length DispName
               ComWrite ' '
            endloop
            if ExistFile FullName
               ComWrite RJNumber(FileSize(FullName) - 1 / 1024 + 1,4) 'k'
               St = NextWord(Line)
               ComWriteln Line ' (' DateString(FileTime(FullName)) ')'
            else
               ComWriteln '(Missing)'
            endif
         endif
      endif
      if not Quiet then LineCount = LineCount + 1
      if LineCount > 22
         BBSPause ('More [Y/n] ... ')
         if ComLastChar = 'N'
            Quiet
         endif
         LineCount = 0
      endif
   endloop

   ComWriteln
   ComWrite 'Download what Files: '
   InputLine(Yes)

   dispose FilesToDownload
   Line = ComLastLine
   while Line > ''
      St = UpperCase(NextWord(Line))
      if Numeric(St)
         V = Value St
         if V within(1,NumberOfElements(FileArray))
            AppendArray(FilesToDownload,FileArray[V])
         endif
      else
         V = PosInList(St,DispArray)
         if V > 0
            AppendArray(FilesToDownload,FileArray[V])
         endif
      endif
   endwhile
   if NumberofElements FilesToDownLoad = 0 then Return
   ComWriteln
   St = Path
   ChDir CleanFileName(DirName)
   DownloadFiles
   ChDir St
EndProc


Procedure UploadFile
Var UploadName Selection
   if Sysop
      NovGroupMembers('PEOPLE',SupportPeople)
   else
      NovGroupMembers('SUPPORT',SupportPeople)
   endif
   SortArray(SupportPeople)
   ComWriteln
   ComWriteln
   Comwriteln 'Who should receive this file?'
   ComWriteln
   Loop SupportPeople
      ComWriteln LoopIndex ' - ' LoopVal
   endloop
   ComWriteln
   ComWrite   'Select: '
   WaitForKey

   Selection = ord(ComLastChar) - 48
   if not (Selection within(1,NumberOfElements(SupportPeople))) then return

   SendFileTo = SupportPeople[Selection]

   ComWriteln SendFileTo
   Wait 50
   UploadFiles
   SendFileMHS(SendFileTo)
   SendFileTo = ''
   LastMenu = ''
EndProc


Procedure SendFileMHS (SendTo)
var Message ParcelName Unique FileList FileName Attach AttachName St
   ReadDirectory(ComRecDirectory,FileList)
   if NumberOfElements(FileList) = 0 then Return
   AppendArray(Message,'SMF-70')
   AppendArray(Message,'FROM:' + NovLoginName + ' @ CTYME')
   AppendArray(Message,'TO:' + SendTo + ' @ CTYME')
   AppendArray(Message,'SUBJECT:BBS file from: ' + User.Name)
   ComWriteln
   Loop FileList
      FileName = LoopVal
      Unique = UniqueName
      ParcelName = MhsMailDirectory + '\PARCEL\' + Unique
      Attach = Attach + ',' + Unique
      AttachName = AttachName + ',' + FilePart(FileName)
      ComDrainSendBuffer
      Execute 'MOVE.EXE ' + FileName + ' ' + ParcelName
      ComWriteln 'File ' FilePart(FileName) ' sent to ' SendTo '.'
   EndLoop
   delete(Attach,1,1)
   delete(AttachName,1,1)
   AppendArray(Message,'ATTACHMENT:' + Attach)
   AppendArray(Message,'ATTACHMENT-NAME:' + AttachName)
   ComWriteln
   AppendArray(Message,'')
   AppendArray(Message,'')
   AppendArray(Message,' Name: ' + User.Name + ' (' + AccessString + ') ' + DateString + ' ' + TimeString)
   AppendArray(Message,' From: ' + User.Company + ' * ' + User.From)
   AppendArray(Message,'Phone: ' + User.Phone)
   AppendArray(Message,'')
   AppendArray(Message,'Press F6 to receive incoming support file.')
   AppendArray(Message,'')
   AppendArray(Message,'Files Received:')
   loop FileList
      AppendArray(Message,'=> ' + FilePart(LoopVal))
   endloop
   WriteTextFile(MhsSendDirectory + '\' + UniqueFileName,Message)
   Wait 100
EndProc


Procedure PushMenu
Var X
   X = NumberOfElements(MenuStack)
   if X = 0
      AppendArray(MenuStack,CurrentMenu)
   elseif MenuStack[X] <> CurrentMenu
      AppendArray(MenuStack,CurrentMenu)
   endif
EndProc


Procedure PopMenu
var X
   X = NumberOfElements(MenuStack)
   if X > 0
      CurrentMenu = MenuStack[X]
      delete(MenuStack,X,1)
   endif
EndProc


Procedure DisplayMenu (F)
var T
   ReadTextFile(F,T)
   SendMenuScreen(T)
EndProc


Procedure DisplayFile (F)
var T
   if AbortBBS then Return
   ClearScreen
   ReadTextFile(F,T)
   SendArray(T)
EndProc


Procedure Goodbye
   TextHeader('Thank you for Calling','Computer Tyme MarxBBS')
   TextColor LRed Black
   ComWriteln '  [*] Home of Marx Menu [*]'
   TextColor Brown Black
   ComWriteln
   LogoutTime = Now
   ComWriteln 'Logged on  at: ' TimeString(LogonTime)
   ComWriteln 'Logged off at: ' TimeString(LogoutTime)
   ComWriteln
   ComWriteln 'Time on BBS: ' TimeString(LogoutTime - LogonTime)
   ComWriteln
   ComWriteln '[Click]'
   TextColor Grey Black
   Hangup
EndProc


Procedure GeneralMenu
   if ComLastChar = CR
      LastMenu = ''

   elseif ComLastChar = '-'
      PopMenu

   elseif ComLastChar = '0'
      dispose(MenuStack)
      CurrentMenu = 'MAIN'

   elseif ComLastChar = '*'
      PushMenu
      CurrentMenu = 'UTIL'

   elseif ComLastChar = 'G'
      GoodBye

   endif
EndProc


Procedure GeneralMenu2
   if ComLastChar = 'D'
      DisplayDirectory

   elseif ComLastChar = 'U'
      UploadFile

   endif
EndProc


Procedure MainMenu
   if ComLastChar = 'P' and (User.Access > 0)
      PushMenu
      CurrentMenu = 'SPECIAL'

   elseif ComLastChar = 'M'
      PushMenu
      CurrentMenu = 'MARX'

   elseif ComLastChar = 'T'
      PushMenu
      CurrentMenu = 'TYMESOFT'

   elseif ComLastChar = 'A'
      PushMenu
      CurrentMenu = 'THINK'

   else
      GeneralMenu

   endif
EndProc


Procedure ThinkMenu
   GeneralMenu
   GeneralMenu2
EndProc


Procedure PriorityMenu
   GeneralMenu
   GeneralMenu2
EndProc


Procedure ToolBoxMenu
   GeneralMenu
   GeneralMenu2
EndProc


Procedure MarxMenu
   GeneralMenu
   GeneralMenu2
   if ComLastChar = 'M'
      dispose(FilesToDownload)
      FilesToDownload[1] = 'F:\BBS\DLOADS\MARX\MXMENU.EXE'
      DownloadFiles
   endif
EndProc


Procedure RestartBBS
   AbortBBS
   if ComCD
      ComWriteln
      ComWriteln
      ComWriteln 'Restarting System & Hanging Up ...'
      Wait 200
      GoodBye
   endif
   Execute 'MARXCOMP.EXE V:FAXSERV.MNU'
   StuffKBD 'S' + CR
   %BBSCMD% = ''
   ExitMenu
EndProc


Procedure UtilMenu
var Pass Connections SendTo
   GeneralMenu
   if ComLastChar = 'T'
      ClearScreen
      DispStats
      ComWriteln
      ComWriteln 'You logged on at: ' TimeString (LogonTime)
      ComWriteln 'It is now: ' TimeString (Now)
      ComWriteln 'You have been on for ' Now - LogonTime / 60 ' minutes.'
      if CallLimit > 0
         ComWriteln 'You have ' LogonTime + CallLimit - Now / 60 ' minutes left.'
      endif
      ComWriteln
      BBSPause('Press Any Key ... ')

   elseif ComLastChar = 'P'
      LastMenu = ''
      ComWrite CR 'Enter New Password: '
      InputLine(No)
      Pass[1] = ComLastLine
      ComWrite CR 'Enter Password Again: '
      InputLine(No)
      Pass[2] = ComLastLine
      if Pass[1] = Pass[2]
         ComWriteln
         ComWrite 'Changing Password ... '
         User.Password = Pass[1]
         UpdateUserLog
      else
         ComWriteln
         ComWriteln "Error: Passwords didn't Match!"
         Wait 100
      endif

   endif
   if Sysop

      if ComLastChar = 'L'
         DisplayFile(TodayLogFileName)

      elseif ComLastChar = 'Y'
         DisplayFile(YesterdayLogFileName)

      elseif ComLastChar = 'W'
         Loop 3
            if LoopIndex <> BBSLine
               SendTo = 'BBS' + Str(LoopIndex)
               NovGetConnections(Connections,SendTo,1)
               if Connections[1] > 0
                  SendMessage('WHO',Connections[1])
                  ComWriteln
               else
                  ComWriteln
                  ComWriteln
                  ComWriteln Char(7) SendTo ' is Down!'
               endif
               Wait 200
            endif
         EndLoop

      elseif ComLastChar = 'S'
         PushMenu
         CurrentMenu = 'SYSOP'

      endif
   endif
EndProc


Procedure SysopMenu
var Pass Connections SendTo
   GeneralMenu
   if ComLastChar = 'D'
      LastMenu = ''
      ComWrite CR 'Download what file: '
      InputLine(Yes)
      dispose(FilesToDownload)
      FilesToDownload[1] = ComLastLine
      if ExistFile(FilesToDownload[1])
         DownloadFiles
      else
         ComWriteln
         ComWriteln
         ComWriteln Char(7) 'File ' FilesToDownload[1] ' not found!'
         Wait 200
      endif

   elseif ComLastChar = 'U'
      UploadAnyFile

   elseif ComLastChar = 'S'
      ComWrite CR 'Message to Who: '
      InputLine(Yes)
      SendTo = ComLastLine
      if SendTo = ''
         LastMenu = ''
         Return
      endif
      ComWrite CR 'Enter Message to Send: '
      InputLine(Yes)
      if ComLastLine > ''
         NovGetConnections(Connections,SendTo,1)
         if Connections[1] > 0
            SendMessage(ComLastLine,Connections[1])
            ComWriteln
         else
            ComWriteln
            ComWriteln
            ComWriteln Char(7) SendTo ' is not logged in!'
            Wait 200
         endif
      else
         LastMenu = ''
      endif

   elseif ComLastChar = 'R'
      RestartBBS

   elseif ComLastChar = 'C'
      ComWriteln
      ComWriteln
      ComWriteln 'Rebooting System ...'
      Wait 200
      GoodBye
      Reboot

   elseif ComLastChar = 'A'
      ComWriteln
      ComWriteln
      ComWriteln 'You have 5 minutes to call back with AWREMOTE ...'
      Wait 200
      %BBSCMD% = 'LOADAWR'
      GoodBye
      ExitMenu

   endif
EndProc


Procedure CommonChoices
   ChoiceLine('Download .............. Download a file.')
   ChoiceLine('Upload ................ Upload a file.')
EndProc


Procedure MenuSystem
   CurrentMenu = 'MAIN'
   while not AbortBBS
      if (CurrentMenu <> LastMenu) and not ComCharReady
         if CurrentMenu = 'MAIN'
            MenuHeader('* The Computer Tyme *','Techincal Support BBS')

            ChoiceLine('ToolBox ............... DOS ToolBox Shareware Files')
            ChoiceLine('MarxMenu .............. MarxMenu Shareware Files')
            ChoiceLine('Argue ................. Thinking Magazine * BBS Political')
            if User.Access >= 10
               ChoiceLine('Priority Support ...... Real Version of Software')
            endif

         elseif CurrentMenu = 'MARX'
            MenuHeader('* * The Computer Tyme * *','Marx Menu Support Section')
            ChoiceLine('MarxMenu .............. Download MXMENU.EXE (Eval)')
            CommonChoices

         elseif CurrentMenu = 'TYMESOFT'
            MenuHeader('Computer Tyme',' DOS ToolBox ')
            CommonChoices

         elseif CurrentMenu = 'SPECIAL'
            MenuHeader('* Computer Tyme OnLine *','Priority Support Service')
            CommonChoices

         elseif CurrentMenu = 'THINK'
            MenuHeader('Thinking Magazine',' Political Views ')
            CommonChoices

         elseif CurrentMenu = 'UTIL'
            MenuHeader('Utilities Menu','')
            ChoiceLine('Time .................. Your Connect Time.')
            ChoiceLine('Password .............. Change your Password.')
            if Sysop
               ChoiceLine("Who ................... Who's on the other line")
               ChoiceLine("Log ................... View Today's BBS Activity")
               ChoiceLine("Yesterday ............. View Yesterday's BBS Activity")
               ChoiceLine('Sysop ................. Sysop Menu')
            endif

         elseif CurrentMenu = 'SYSOP'
            MenuHeader('Sysop Menu','')
            ChoiceLine('Download .............. Download any File')
            ChoiceLine('Upload ................ Upload any File')
            ChoiceLine('Send .................. Send a Message')
            ChoiceLine('Anywhere .............. Load PC-AnyWhere')
            ChoiceLine('Recompile ............. Recompile & Restart BBS')
            ChoiceLine('ColdBoot .............. Cold Boot Computer')

         endif

         LastMenu = CurrentMenu
         ComWriteln
         ComWrite('Select: ')
      endif
      WaitForKey
      if CurrentMenu = 'MAIN'
         MainMenu

      elseif (CurrentMenu = 'SPECIAL') and (User.Access >= 10)
         PriorityMenu

      elseif CurrentMenu = 'THINK'
         ThinkMenu

      elseif CurrentMenu = 'TYMESOFT'
         ToolBoxMenu

      elseif CurrentMenu = 'MARX'
         MarxMenu

      elseif CurrentMenu = 'UTIL'
         UtilMenu

      elseif CurrentMenu = 'SYSOP'
         SysopMenu

      endif
   endwhile
EndProc


Procedure SendMessage(St,Conn)
   St = 'From ' + NovLoginName + '[' + Str(NovConnection) + ']: ' + St
   NovSendMessage(St,Conn)
EndProc


Procedure GetMessage
var St P
   OrigMessage = NovGetMessage
   LastMessage = UpperCase(OrigMessage)
   if LastMessage > ''
      St = NextWord(LastMessage)
      MessageFrom = NextWord(LastMessage)
      Sender = MessageFrom
      delete(LastMessage,1,1)
      P = pos(']',LastMessage)
      MessageConnection = Value(Left(LastMessage,P-1))
      delete(LastMessage,1,pos(' ',LastMessage))
   endif
   Return LastMessage
EndProc


Procedure ProcessMessage (St)
var UserX
   if St = 'UPGRADE'
      User.Access = 10
      LastMenu = ''

   elseif St = 'RESTART'
      if Left(MessageFrom,3) = 'BBS'
         SendMessage('System Restarting ...',MessageConnection)
      endif
      RestartBBS

   elseif St = 'REBOOT'
      if Left(MessageFrom,3) = 'BBS'
         SendMessage('System Rebooting ...',MessageConnection)
      endif
      Wait 100
      Reboot

   elseif St = 'NUKEFAX'
      Execute 'ZDEL.EXE H:\FAX\QUEUE\*.*/N'

   elseif St = 'WHO'
      if User.Name > ''
         UserX = 'UserName ' + User.Name + ' * ' + User.From + ' * ' + TimeString(LogonTime)
         if Downloading
            UserX = UserX + ' * Downloading ' + ComFileName
         endif
      else
         UserX = 'None'
      endif
      SendMessage(UserX,MessageConnection)

   else
      if ComCD
         ComWriteln
         ComWriteln '>> ' OrigMessage
      endif

   endif

EndProc


Procedure AccessString
   if User.Access >= 100
      Return 'Sysop'
   elseif User.Access >= 10
      Return 'Member'
   elseif NewUser
      Return 'New'
   else
      Return 'Guest'
   endif
EndProc


;----- BBS Background Tasker - Runs every 18 ticks or once a second

Procedure BBSTasker
var OldEchoSendChar OldEchoRecChar Message St
   if AbortBBS then Return
   if ComCDAbort
      AbortBBS
      Return
   endif
   if User.Name = ''
      if Now - LogonTime = (TimeToLogin - 30)
         ComWriteln
         ComWriteln 'You Have 30 seconds to log in.'
         ComWriteln
      endif
      if Now - LogonTime > TimeToLogin
         ComWriteln
         ComWrite 'This BBS requires that you log in within '
         ComWriteln TimeToLogin / 60 ' minutes.'
         Hangup
         Return
      endif
   else
      if Now = (IdleStart + DisconnectTime - 30)
         ComWriteln
         ComWriteln
         ComWriteln 'Inactivity logoff in 30 seconds.' Char(7)
         ComWriteln
      endif
      if Now > (IdleStart + DisconnectTime)
         LogBBSEvent('   Inactivity Timeout')
         GoodBye
         Return
      endif
      if CallLimit > 0
         if Now = (LogonTime + CallLimit - 60)
            ComWriteln
            ComWriteln
            ComWriteln 'You have 1 minute left.' Char(7)
            ComWriteln
         endif
         if Now > (LogonTime + CallLimit)
            LogBBSEvent('   Call Limit Timeout')
            GoodBye
            Return
         endif
      endif
   endif

   if GetMessage > ''
      St = LastMessage
      LastMessage = ''
      ProcessMessage(St)
   endif

   OldEchoSendChar = ComEchoSendChar
   OldEchoRecChar = ComEchoRecChar
   ComEchoSendChar Off
   ComEchoRecChar Off
   SetTopWindow StatusWindow
   GotoXY 2 1
   if User.Name = ''
      Write 'Logging On'
   else
      Write ' ' User.Name ' * '
      if (User.Company = '') or (User.Company = 'NONE')
         Write User.From
      else
         Write User.Company
      endif
      Write ' * ' ConnectSpeed ' baud * '
      Write AccessString
   endif
   Write ' * '
   Write TimeString(Now - LogonTime)
   ClearLine
   SetWindowUnder(StatusWindow,StatusWindow + 1)
   ComEchoSendChar = OldEchoSendChar
   ComEchoRecChar = OldEchoRecChar
EndProc


Procedure SetupScreen
   ClockPos 0 0
   NoBoxBorder
   if ColorScreen
      BoxInsideColor Black Green
   else
      BoxInsideColor Black Grey
   endif
   DrawBox 1 1 ScreenWidth 1
   StatusWindow = CurrentWindow
   BoxInsideColor Grey Black
   DrawBox 1 2 ScreenWidth ScreenHeight - 1
   BBSWindow = CurrentWindow
EndProc


Procedure SetConnectSpeed
var St B
   ConnectString = ComLastLine
   St = ConnectString
   delete(St,1,8)
   B = 1
   while mid(St,B,1) within ('0','9')
      B = B + 1
   endwhile
   ConnectSpeed = Value(Left(St,B - 1))
EndProc


;----- Calculates Today File Name

Procedure GetTodayLogFile
var DirInfo
   TodayLogFileName = 'F:\BBS\DAY' + Str(DayOfWeekOf(LogonTime)) + '.LOG'
   YesterdayLogFileName = 'F:\BBS\DAY' + Str(DayOfWeekOf(LogonTime) + 6 mod 7) + '.LOG'

   ;- If file is a week old then delete it

   ReadSqDirectory(TodayLogFileName,DirInfo)

   ;- If File Exists

   if NumberofElements DirInfo > 0

      ;- Element 2 is file date

      if DateString(DirInfo[1,2]) <> DateString(Now)
         DelFile(TodayLogFileName)
      endif
   endif
EndProc


Procedure SetupBBS
   BlankTime = 0
   LogonTime = Now
   IdleStart = Now
   AbortBBS Off
   ComRecDirectory = 'F:\HOME\' + NovLoginName + '\FAX\INBOX'
   ComXmitAbortProgram = loc XmitAbort
   ComXmitStatusProgram = loc XmitStatus
   ComAcceptFileProgram = loc FileNameCollision
   UpperCaseOnly
   AbortBBS Off
   Dispose MenuStack
   ComEchoSendChar
   ComEchoRecChar
   ComLocalInput
   ComZRecover
   ComWatchCD
   DisconnectTime = 180
   TimeToLogin = 120
   CallLimit = 0
   User.Access = 0
   User.Phone = ''
   User.From = ''
   NewUser Off
   BBSLine = 1
   if NovLoginName = 'BBS2'
      BBSline = 2
   elseif NovLoginName = 'BBS3'
      BBSline = 3
   endif
   GetTodayLogFile
   SetTimerTask (loc BBSTasker,18)
   KeyEvent(AltH)  = loc Hangup
EndProc


Procedure DaylightSavingsTime
var B E

   ;- First Sunday in April

   B = TimeOf('04-01-' + Str(Year))
   while DayOfWeekOf(B) <> 0
      B = B + SecondsInDay
   endwhile

   ;- Last Sunday in October

   E = TimeOf('10-31-' + Str(Year))
   while DayOfWeekOf(E) <> 0
      E = E - SecondsInDay
   endwhile

   Return Now Within(B,E)
EndProc


Procedure Greeting
var N
   ComWriteln
   ComWriteln
   ClearScreen
   TextColor White Black
   ComWrite   '[*] '
   TextColor Yellow Black
   ComWrite   'Welcome to Computer Tyme MarxMenu Technical Support BBS'
   TextColor White Black
   ComWriteln ' [*]'
   TextColor Green Black
   ComWriteln
   ComWriteln 'I have changed BBS software so things may not be the'
   ComWriteln 'same as it was the last time you logged in. This BBS'
   ComWriteln 'is written in MarxMenu script language.'
   TextColor Cyan Black
   ComWriteln
   ComWriteln 'This BBS uses ANSI or VT100 codes. If you get a lot of'
   ComWriteln 'little arrows on the screen then you need to turn ANSI on.'
   TextColor LRed Black
   ComWriteln
   N = Now
   ComWrite   'Time Sync: ' DateString(N) ' ' TimeString(N)
   if DaylightSavingsTime
      ComWriteln ' CDT'
   else
      ComWriteln ' CST'
   endif
   TextColor Mag Black
   ComWriteln
   ComWriteln 'You are connected to line ' BBSLine ' at ' Str(ConnectSpeed) '.'
   TextColor Brown Black
EndProc


Procedure AfterHangup
var Log F St
   LogBBSEvent('   Off at: ' + DateTimeSt)

   if ExistFile TempLogFileName
      ReadTextFile(TempLogFileName,Log)

   ;- append TempLogFile to LogFile

      FileAssign(F,LogFileName)
      FileAppend(F)
      loop Log
         FileWriteln(F,LoopVal)
      endloop
      FileClose(F)

   ;- append TempLogFile to TodayLogFile

      FileAssign(F,TodayLogFileName)
      FileAppend(F)
      loop Log
         FileWriteln(F,LoopVal)
      endloop
      FileClose(F)

      DelFile TempLogFileName
      UnBlank
      BlankTime = 1
   endif

   EraseTopWindow
   EraseTopWindow
   BlockBox
   if User.Name > ''
      St = DateString(LogonTime) + ' ' + TimeString(LogonTime) + ' * ' + User.Name + ' * '
      if (User.Company > '') and (User.Company <> 'NONE')
         St = St + User.Company + ' * '
      endif
      St = St + User.From
      Writeln St
      User.Name = ''
   endif
   ComTraceAbort
EndProc


Procedure DispStats
   Stats = User.Name + ' from ' + User.From
   if (User.Company > '') and (User.Company <> 'NONE')
      Stats = Stats + ' with ' + User.Company
   endif
   Stats = Stats + ' on line ' + Str(BBSLine) + ' at ' + Str(ConnectSpeed)
   ComWriteln
   ComWriteln Stats
   ComWriteln
   ComWriteln 'You are caller ' LoginCount
   if not NewUser
      ComWriteln 'You have called ' User.Calls ' times before.'
      ComWriteln 'Your last call was on ' User.LastCall
   endif
   if CallLimit > 0
      ComWriteln
      ComWriteln 'You have ' CallLimit / 60 ' minutes this call.'
   endif
   if User.ExpDate > ''
      if TimeOf(User.ExpDate) > Now
         ComWriteln
         ComWriteln 'Your Fast Update access is good till ' User.ExpDate
      else
         ComWriteln
         ComWriteln 'Your Fast Update access expired on ' User.ExpDate
         ComWriteln 'Contact Computer Tyme @ 417-866-1665 to renew.
         User.Access = 0
         UpdateUserLog
      endif
   endif
EndProc


Procedure LogUserHeader
var St
   LogBBSEvent('')
   St = TimeString + ' ' + User.Name + ' (' + AccessString + ') from ' + User.From
   St = St + ' on line ' + Str(BBSLine)
   LogBBSEvent(St)
   LogBBSEvent('   ' + ConnectString)
   St = ''
   if (User.Company > '') and (User.Company <> 'NONE')
      St = 'Company: ' + User.Company
   endif
   if User.Phone > ''
      if St > '' then St = St + ' * '
      St = St + 'Phone: ' + User.Phone
   endif
   if St > ''
      LogBBSEvent('   ' + St)
   endif
EndProc


Procedure RunBBS
   SetConnectSpeed
   OpenDataBase

   SetupScreen
   SetupBBS
   Greeting
   LoginToBBS
   if not AbortBBS
      TextColor LRed Black
      if User.Access < 10
         CallLimit = 5400    ;90 minutes
      endif
      CountLogins
      DispStats
      Wait 300
      if not NewUser
         User.Calls = User.Calls + 1
         User.LastCall = DateString
         UpdateUserLog
      endif
      LogUserHeader
      DisplayFile('V:\INTRO.SCR')
      MenuSystem
   endif
   Hangup
   ResetModem On
   AfterHangup
   BtrvClose(UserFileHandle)
EndProc
