OS/2 Shareware BBS: 3 Comm/03-Comm.zip/te2pro20.zip/TPHOST.SCR

Text File | 1996-05-31 | 14KB | 570 lines

/* TE/2 Pro! host Mode Script */
signal on syntax

/* Control variable */
HostModeActive = 1

/* Handy character constants */
lf          = D2C(10)
ff          = D2C(12)
cr          = D2C(13)
esc         = D2C(27)
crlf        = cr||lf

/* Modem initialization.  Edit these for your modem. */
ModemInit   = 'ATZ'||cr
AnswerCall  = 'ATA'||cr
MaximumBaud = 57600
StdParity   = 'none'
StdWordLen  = 8
StdStopBits = 1
MatchBaud   = 0
DevHandle   = 0 /* This is filled in at startup */

/* Files and paths.  Edit these for your system. */
HomePath    = 'C:\te2pro\host'
PublicPath  = 'C:\te2pro\host\dl'
HostULPath  = 'C:\te2pro\host\ul'
UserFile    = 'C:\te2pro\host\user.tph'

/* Control variable.  None of these are active at present, they are */
/* reserved for future use.                                         */
WatchUser   = 1
HotKeys     = 1
LocalLogin  = 0

/* Timing for WatForCall routine. WaitCallD1 is timeout value while */
/* waiting for "RING", WaitCallD2 is sleep time between waits.      */
WaitCallD1  = 60
WaitCallD2  = 1

/* Set MatchBaud to 1 if your modem needs to match baud to the      */
/* caller (2400bps modems) or set to 0 otherwise.  CallerBaud       */
/* records the caller's baud if MatchBaud is 1 or is set to         */
/* MaximumBaud otherwise.                                           */
MatchBaud   = 0
CallerBaud  = 0

/* Color attributes for menus, etc. */
DfltAttr    = esc||'[36;0m'
BoldOn      = esc||'[33;1m'
BoldOff     = DfltAttr
WarnOn      = esc||'[37;1m'
WarnOff     = DfltAttr
ClrTerm     = esc||'[2J'

/* Menus */
Menu.       = ''
Menu.0      = 4
Menu.1      = '[F]ile directory'
Menu.2      = '[D]ownload'
Menu.3      = '[U]pload'
Menu.4      = '[G]oodbye'

XMenu.      = ''
XMenu.0     = 6
XMenu.1     = '[X]modem'
XMenu.2     = 'Xmodem-[1]K'
XMenu.3     = '[Y]modem'
XMenu.4     = 'Ymodem-[G]'
XMenu.5     = '[Z]modem'
XMenu.6     = '[ENTER] = return to main menu.'

/* User list and current user */
Users.      = ''
Users.0     = 0
CurUser     = 0
UserOK      = 0


/* ---------------------------------------------------------------------
   -- FaxWorks interoperability section
      FaxAns  is a boolean flag to enable or disable answering of
              incoming fax calls.  Set to 1 to enable, 0 to disable.
      FaxPgm  is the full path to your copy of the FaxWorks executable
              file.
      FaxInit is your modem setup to enable answering of both fax and
              data calls.  For Class 1 fax modems, this would be
              "AT+FAE=1"||cr.  For Class 2 and 2.0 modems, this would be
              "AT+FAA=1"||cr.
------------------------------------------------------------------------ */
FaxAns  = 0
FaxPgm  = 'd:\comm\pmfax\pmfax.exe'
FaxInit = 'AT+FAE=1'||cr
/* --------------------------------------------------------------------- */


Main:
  call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  call SysLoadFuncs
  call ReadUserList
  SavedPath = directory()
  'query devicehandle DevHandle'
  do while HostModeActive = 1
    'cls'
    say 'TE/2 Pro Host Mode Script'
    say
    say
    call InitModem
    call WaitForCall
    if HostModeActive = 1 then call HostMode
  end
  call directory SavedPath
  exit 0



ReadUserList:
  r = stream(UserFile, 'C', 'open read')
  if r = 'READY:' then
    do
      do while lines(UserFile) > 0
        r = linein(UserFile)
        if length(r) > 0 then
          do
            parse var r lv ',' ln ',' fn ',' pw ',' cf ',' ct
            if length(ct) > 0 then
              do
                i = Users.0 + 1
                Users.i.Level     = lv
                Users.i.LastName  = ln
                Users.i.FirstName = fn
                Users.i.Password  = pw
                Users.i.Color     = translate(cf)
                Users.i.Lines     = ct
                Users.0 = i
              end
          end
      end
      call stream UserFile, 'C', 'close'
    end
  else
    say 'Cannot read User File:' UserFile '(rescode='r')'
  return



InitModem:
  'set baud'     MaximumBaud
  'set parity'   StdParity
  'set databits' StdWordLen
  'set stopbits' StdStopBits
  'transmit' ModemInit
  'sleep 2'
  if FaxAns = 1 then
    do
      'transmit' FaxInit
      'sleep 2'
    end
  return



WaitForCall:
  say 'Waiting for call...'
  do forever
    say date() time() 'Waiting...'
    'wait' WaitCallD1 'RING'
    WaitResult = rc
    select
      when WaitResult = 1 then
        do
          'rcvcapture true'
          'transmit' AnswerCall
          GotFax = 0
          if FaxAns = 1 then
            do 5
              'receive CR255 10 NOECHO'
              ln = FixRmtInp(rc)
              select
                when translate(word(ln, 1)) = 'DATA' then
                  leave
                when translate(word(ln, 1)) = 'FAX' then
                  do
                    GotFax = 1
                    leave
                  end
                otherwise
                  nop
              end
            end
          if GotFax = 1 then
            do
              'rcvcapture false'
              call ReceiveFax
              iterate
            end

          GotConnect = 0
          do 5
            'receive CR255 10 NOECHO'
            ln = FixRmtInp(rc)
            if translate(word(ln, 1)) = 'CONNECT' then
              do
                GotConnect = 1
                leave
              end
          end
          'rcvcapture false'
          if GotConnect = 1 then
            do
              if MatchBaud = 1 then
                do
                  tmpstrg = substr(ln, wordindex(ln, 2))
                  do i = 1 to length(tmpstrg)
                    if datatype(substr(tmpstrg)) \= 'NUM' then
                      do
                        tmpstrg = substr(tmpstrg, i)
                        leave
                      end
                  end
                  CallerBaud = tmpstrg
                  'set baud' CallerBaud
                end
              else
                CallerBaud = MaximumBaud
              leave
            end
        end
      when WaitResult = 10000 then
        do
          AskYN.Text  = 'Okay to exit host mode?'
          AskYN.Title = 'TE/2 Pro! Host Mode'
          AskYN.Style = X2D('4014') /* MB_MOVEABLE|MB_ICONQUESTION|MB_YESNO */
          'messageboxv askyn'
          if rc = 6 /* MBID_YES */ then
            do
              HostModeActive = 0
              leave
            end
        end
      otherwise
        'sleep' WaitCallD2
    end
  end
  return



HostMode:
  'sleep 3'
  'transmit "'ff||crlf'Hello Caller...'crlf'"'
  say
  say date() time() 'Answered call'
  'rcvcapture true'
  call GetLogin
  MenuLevel = 'MAIN'
  if CurUser > 0 & UserOK > 0 then
    do forever
      'query carrier'
      if rc = 1 then
        do
          call ShowMenu MenuLevel
          call ExecMenu MenuLevel
        end
      else
        leave
    end
  else
    'hangup'
  'rcvcapture false'
  return



GetLogin:
  CurUser = 0
  UserOK  = 0
  do 4
    'transmit "'crlf'Enter FIRST and LAST name: '
    'receive CR255 120 ECHO'
    r = FixRmtInp(rc)
    say
    if length(r) > 0 then
      do
        parse upper var r fn ln
        do i = 1 to Users.0
          say fn ln 'vs.' Users.i.FirstName Users.i.LastName
          if translate(Users.i.FirstName) = fn & translate(Users.i.LastName) = ln then
            do
              CurUser = i
              leave
            end
        end
        if CurUser > 0 then
          leave
        else
          'transmit "'crlf'Could not locate username: 'r'"'
      end
  end
  if CurUser > 0 then
    do 4
      'transmit "'crlf'Enter password: '
      'receive CR255 120 NOECHO'
      r = FixRmtInp(rc)
      if length(r) > 0 then
        do
          if translate(Users.CurUser.Password) = translate(r) then
            do
              UserOK = 1
              leave
            end
          else
            'transmit "'crlf'Wrong password!"'
        end
    end
  if CurUser > 0 & UserOK > 0 then
    'transmit "Welcome' Users.CurUser.FirstName Users.CurUser.LastName||cr||lf'"'
  else
    'transmit "Bye!"'
  return



ShowMenu:
  parse arg MenuID

  TmpMenu.  = ''
  select
    when MenuID = 'MAIN' then
      do
        TmpMenu.0 = Menu.0
        do i = 1 to Menu.0
          TmpMenu.i = Menu.i
        end
      end
    when MenuID = 'DOWNLOAD' | MenuID = 'UPLOAD' then
      do
        TmpMenu.0 = XMenu.0
        do i = 1 to XMenu.0
          TmpMenu.i = XMenu.i
        end
      end
    otherwise TmpMenu.0 = 0
  end

  if TmpMenu.0 > 0 then
    do
      if Users.CurUser.Color = 'Y' then
        do
          'transmit "'clrTerm'"'
          'transmit "'BoldOn||MenuID||DfltAttr' Menu'crlf||crlf
        end
      else
        do
          'transmit "'crlf||crlf'"'
          'transmit "'MenuID' Menu'crlf||crlf
        end

      do i = 1 to TmpMenu.0
        tmp = TmpMenu.i
        if Users.CurUser.Color = 'Y' then
          do
            x1 = pos('[', tmp)
            x2 = pos(']', tmp)
            tmp = DfltAttr ||,
                  substr(tmp, 1,    x1)      ||BoldOn  ||,
                  substr(tmp, x1+1, x2-x1-1) ||DfltAttr||,
                  substr(tmp, x2)
          end
        'transmit "'tmp||crlf'"'
      end

      'transmit "'crlf||crlf'"'
      prmpt = 'Select: '
      if Users.CurUser.Color = 'Y' then
        prmpt = WarnOn||prmpt||WarnOff
      'transmit "'prmpt'"'
    end

  return



ExecMenu:
  parse arg MenuID

  'receive CR255 180 ECHO'
  r = FixRmtInp(rc)
  if length(r) > 0 then
    do
      r = translate(substr(r, 1))
      select
        when MenuID = 'MAIN' then
          do
            select
              when r = 'F' then
                call GetFileDirectory
              when r = 'D' then
                MenuLevel = 'DOWNLOAD'
              when r = 'U' then
                MenuLevel = 'UPLOAD'
              when r = 'G' then
                do
                  if Users.CurUser.Color = 'Y' then
                    'transmit "'crlf||crlf||BoldOn'Bye!'BoldOff||crlf||crlf'"'
                  else
                    'transmit "'crlf||crlf'Bye!'crlf||crlf'"'
                  'hangup'
                  'sleep 5'
                end
              otherwise
                nop
            end
          end

        when MenuID = 'DOWNLOAD' then
          do
            select
              when r = 'X' then call SendFile r
              when r = '1' then call SendFile r
              when r = 'Y' then call SendFile r
              when r = 'G' then call SendFile r
              when r = 'Z' then call SendFile r
              otherwise
                nop
            end
          end

        when MenuID = 'UPLOAD' then
          do
            select
              when r = 'X' then call GetFile r
              when r = '1' then call GetFile r
              when r = 'Y' then call GetFile r
              when r = 'G' then call GetFile r
              when r = 'Z' then call GetFile r
              otherwise
                nop
            end
          end

        otherwise
          nop
      end
    end
  else
    MenuLevel = 'MAIN'

  return



GetFileDirectory:
  'transmit "'crlf||crlf'Enter file spec [CR=*]:"'
  'receive CR255 180 ECHO'
  r = FixRmtInp(rc)
  if length(r) = 0 then r = '*'
  Files.  = ''
  Files.0 = 0
  call SysFileTree r, 'Files'
  'transmit "'Files.0' files found:'crlf'"'
  do i = 1 to Files.0
    'transmit "'Files.i||crlf'"'
  end
  'transmit "'crlf'Press ENTER:"'
  'receive CR255 180 NOECHO'
  return



SendFile:
  parse arg XferType
  select
    when XferType = 'X' then XferType = 'xmodem'
    when XferType = '1' then XferType = 'xmodem1k'
    when XferType = 'Y' then XferType = 'ymodem'
    when XferType = 'G' then XferType = 'ymodemg'
    when XferType = 'Z' then XferType = 'zmodem'
    otherwise nop
  end

  'transmit "'crlf||crlf'Enter file spec:"'
  'receive CR255 180 ECHO'
  r = FixRmtInp(rc)
  if length(r) > 0 then
    do
      fspec = r
      r = stream(fspec, 'C', 'query exists')
      if length(r) > 0 then
        do
          'transmit "'crlf'Start your 'XferType' receive...'
          'upload' XferType fspec
          /*
          if rc \= 0 then
            'transmit "ERROR starting' XferType' file transfer."'
          else
            'waitxfer'
          */
          'sleep 2'
          'waitxfer'
        end
      else
        'transmit "'crlf'ERROR: 'fspec' not found!'crlf'"'

      'transmit "Press ENTER:"'
      'receive CR255 180 NOECHO'
    end
  return



GetFile:
  parse arg XferType
  select
    when XferType = 'X' then XferType = 'xmodem'
    when XferType = '1' then XferType = 'xmodem1k'
    when XferType = 'Y' then XferType = 'ymodem'
    when XferType = 'G' then XferType = 'ymodemg'
    when XferType = 'Z' then XferType = 'zmodem'
    otherwise nop
  end

  if XferType = 'xmodem' | XferType = 'xmodem1k' then
    do
      'transmit "'crlf||crlf'Enter file name:"'
      'receive CR255 180 ECHO'
      r = FixRmtInp(rc)
    end
  else
    r = 'automatic'

  if length(r) > 0 then
    do
      'transmit "'crlf'Start your 'XferType' upload...'
      'download' XferType r
      'sleep 2'
      'waitxfer'
      'transmit "Press ENTER:"'
      'receive CR255 180 NOECHO'
    end

  return



FixRmtInp:
  parse arg friRC
  friRC = strip(friRC, 'B', D2C(13))
  friRC = strip(friRC, 'B', D2C(10))
  friRC = strip(friRC, 'B', D2C(13))
  friRC = strip(friRC, 'B', D2C(10))
  return friRC



ReceiveFax:
  'execwait' FaxPgm '-n7,'||DevHandle
  return


syntax:
  syxRC = rc
  msgbox.Text  = 'rc    =' syxRC||D2C(10)||,
                 'line# =' sigl||D2C(10)||,
                 'line  = ['sourceline(sigl)']'
  msgbox.Title = 'Syntax Error!'
  msgbox.Style = X2D('4046') /* MB_MOVEABLE|MB_CRITICAL|MB_CANCEL */
  'messageboxv msgbox'
  exit 1