PC World Komputer 1998 April A/Pcwk4a98.iso/Wtestowe/OnNet16/TNTEACH.TOS

Text File | 1996-12-09 | 11.8 KB | 431 lines

' Template for the teach mode script. The teach mode output script
' is first initialized with this template. The other variables are
' appended to this file, along with the OLE automation commands.

Const APPNAME = "TNVTPlus Script"
Const SCRIPTINPROGRESS = "Script in Progress. Please wait."

Const GL_FAIL = -1
Const GL_SUCCESS = 1
Const GL_TIMOUT = 2
Const GL_IDLE = 3

Const GR_CANCEL = 0
Const GR_NORMAL = 1
Const GR_IGNORE = 2
Const GR_DONE = 4
Const GR_PASSWORD = 5
Const GR_LOGIN = 6

Const bmaxlen = 1024

Dim waittime as String
Dim endtime as Long
Dim Username as String, Password as String
Dim ReadCount as Integer
Dim hostname as string
Dim port as string
Dim curindex as Integer

Dim Telnet as object
Dim Session as object

Dim wCreateSte as Integer
Dim wSavePassword as Integer

Dim tn_target() As String
Dim tn_numtargets As Integer
Dim tn_response() As String
Dim tn_responsetype() As Integer
Dim response As String

Const MAXBUFLEN = 4000
Const MAXLEN = MAXBUFLEN*2 + 1
Dim gl_bfr As String       ' Global input buffer
Dim gl_linbuf As String    ' Line buffer - parsed from input stream
Dim gl_lastline As String  ' Last line of text from host
Dim gl_lastatom As String  ' Last line of text from host
Dim custominit as Integer

' Add target and response to playback tables
Sub AddResponse(target As String, resp As String, rtype As Integer)
   ReDim Preserve tn_target(tn_numtargets)
   ReDim Preserve tn_response(tn_numtargets)
   ReDim Preserve tn_responsetype(tn_numtargets)

   tn_target(tn_numtargets) = target
   tn_response(tn_numtargets) = resp
   tn_responsetype(tn_numtargets) = rtype

   tn_numtargets = tn_numtargets + 1
End Sub

Sub SendPassword()
    Dim psw As String

    psw = Session.Password
    If psw = "" Then
        psw=PasswordBox("Enter your login password","TNVTPlus Script: Password ")
    End If

    Session.SendKeys(psw + "<Enter>")
End Sub


Function GetOptions%(id$, act%, spv&)
static tmptime As String, tmpchar As String


     Select Case act
      Case 1
          DlgText 4, waittime
          DlgText 1, hostpromptchar
          DlgValue 0, wVisible

      Case 2
         If DlgControlID(id) = DlgControlID("cancel") Then
             Exit Function
         End If

         If DlgControlID(id) = DlgControlID("ok") Then
             If DlgValue(0) = 1 Then
                 wVisible = 1
                 Telnet.Visible = TRUE
             Else
                 wVisible = 0
                 Telnet.Visible = FALSE
             End If

             waittime = DlgText(4)
             If VAL(waittime) < 0 Or VAL(waittime) > 300 Then
                 waittime = "30"
             End If

             hostpromptchar = DlgText(1)
             Exit Function
         End If


     End Select

End Function
Sub SetOptions()

ctext1$ = ">"+CHR$(9)+"$"+chr$(9)+"#"+chr$(9)+"yourtext>"
ctext2$ = "30"+chr$(9)+"60"+chr$(9)+"90"+chr$(9)+"120"

Begin Dialog optionsdlg 273, 116, "Create Startup Script Wizard:  Change Options", .GetOptions
   CheckBox  10, 66, 117, 11, "Make TNVTPlus Window &Visible", .CheckBox1
   DropComboBox  131, 10, 107, 70, ctext1, .DropComboBox1
   Text  9, 12, 117, 10, "Additional Host Prompt Strings:", .Text1
   Text  9, 39, 117, 11, "Change Host Timeout:"
   DropComboBox  131, 34, 107, 70, ctext2, .DropComboBox2
   OkButton  137, 92, 50, 14, .ok
   CancelButton  189, 92, 50, 14, .cancel
End Dialog



   Dim optdlg as optionsdlg

   res = Dialog(optdlg)

End Sub


Function WaitForData(target As String, response as String, rtype as Integer) As Integer

    Dim position as Integer
    Dim x as Long
    Static cc as Integer

    gl_bfr = ""

    If timer < endtime  Then
      ' Check for more input data
      gl_bfr = Session.GetEmulatorData(MAXBUFLEN)
      cc = Session.LastReadCount     ' Chars returned
      x = timer
      While timer < x+2
      Wend
      If cc > 0 Then
          gl_linbuf = gl_linbuf + Left$(gl_bfr, cc) ' append data just read to gl_linbuf
          ReadCount = ReadCount + cc
          endtime = timer + VAL(waittime)                  ' reset the timeout timer every time we get more data
          If ReadCount > MAXLEN Then
              gl_linbuf = Left$(gl_bfr, MAXBUFLEN)
              ReadCount = MAXBUFLEN
          End If
      End If
      position=InStr(gl_linbuf, target)
      If position <> 0 Then
          if rtype = GR_PASSWORD Then
               SendPassword
          else
               Session.SendKeys(response)
          End If
          WaitForData = GL_SUCCESS
          Exit Function
      End If
      WaitForData = GL_IDLE
      Exit Function

 End If

 WaitForData = -1

End Function


Function rspdlgfunc%(id$, act%, spv&)


   Select Case act
      Case 1
         DlgEnable DlgControlID("customtext"), custominit
         If custominit = 1 Then
             DlgFocus DlgControlID("customtext")
         Else
             DlgFocus DlgControlID("ok")
         End If
         AppActivate APPNAME


      Case 2
         If DlgControlID(id) = DlgControlID("options") Then
            SetOptions
            rspdlgfunc = 1
         Else

            ' Enable custom text box if selected
            If DlgControlID(id) = DlgControlID("selectcustom") Then
               DlgEnable DlgControlID("customtext"), 1
               DlgFocus DlgControlID("customtext")
            Else
               DlgEnable DlgControlID("customtext"), 0
            End If

         End If

         If DlgControlID(id) = DlgControlID("ok") Then Exit Function

     Case 4
         ' Do not allow prompt control to gain focus
         If DlgControlID(id) = DlgControlID("expect") Then DlgFocus spv

   End Select
End Function

' Converts character pairs ^<char> to special controls

Function CCString(inpstr As String) As String
   CCString = inpstr
End Function


Function GetResponse(expect As String, suggest As Integer, newresp As String, oldresp As String, outresp as String) As Integer

  Begin Dialog responsedlg 1, 5, 230, 172, APPNAME, .rspdlgfunc
   OkButton  173, 106, 46, 15, .ok
   CancelButton  173, 127, 46, 15
   OptionGroup .response
      OptionButton  13, 87, 50, 10, "&Username", .selectusername
      OptionButton  13, 106, 50, 10, "&Password", .selectpassword
      OptionButton  13, 125, 39, 8, "&Ignore", .OptionButton1
      OptionButton  13, 144, 40, 10, "&Custom:", .selectcustom
      OptionButton  70, 87, 50, 10, "<&Enter> key", .selectCR
      OptionButton  70, 107, 60, 10, "&Quit script", .selectdone
   TextBox  56, 144, 91, 10, .customtext
   Text  0, 0, 205, 16, "The script expected to receive:"
   TextBox  6, 15, 182, 18, .expect
   Text  2, 37, 200, 10, "Instead it received:"
   TextBox  6, 53, 182, 18, .receive
   GroupBox  5, 75, 155, 94, "Respond with"
   PushButton  173, 82, 46, 15, "&Options...", .options
End Dialog



   Dim getuser As responsedlg
   Dim res As Integer


   getuser.expect = expect              ' Seed dialog
   getuser.receive = newresp
   getuser.customtext = oldresp
   getuser.response = suggest

   If suggest = 3 Then
       custominit = 1
   Else
       custominit = 0
   End If


   res = Dialog(getuser)
   If res = 0 Then
      GetResponse = GR_CANCEL         ' Cancel
      Exit Function
   End If

   GetResponse = GR_NORMAL            ' Assume normal return

   Select Case getuser.response
      Case 0                  ' Username
         outresp = Session.Username + "<Enter>"
         GetResponse = GR_LOGIN
      Case 1                  ' Password
         GetResponse = GR_PASSWORD
      Case 2                  ' Ignore input -- continue
         GetResponse = GR_IGNORE
      Case 3                  ' Custom entry
         outresp = CCString(getuser.customtext) + "<Enter>"
      Case 4
         outresp = "<Enter>"     ' CR
         GetResponse = GR_ENTER
      Case 5                  ' All done with input
         GetResponse = GR_DONE
   End Select

End Function

' Return last atom at the end of a data buffer

Function GetLastAtom(bfr As String, spos As Integer) As String
   Dim ix As Integer, ll As Integer

   ' Scan left from spos for first space

   For ix = spos To 1 Step -1
      if Mid$(bfr, ix, 1) = Chr$(CSP) Then Exit For
   Next ix

   ' Return last (space delimited) atom at end-of-line

   GetLastAtom = Mid$(bfr, ix + 1, spos - ix)
End Function

' get last line of data for user prompt dialog box
Sub GetLastLine(bfr As String, spos As Integer)
   Dim ix As Integer, ll As Integer
   Dim temp As String, x As String

   ' Scan left from spos for first space

   For ix = spos To 1 Step -1
      x = Mid$(bfr, ix, 1)
      if x = CHR$(10) OR x = CHR$(CCR) OR x = CHR$(CLF) OR x = CHR$(0) Then Exit For
   Next ix

   ' Return last line of text (delimited by CR or LF)
   temp$ = Mid$(bfr, ix + 1, spos - ix)
   gl_lastline = temp
End Sub

Function ProcessData%(id$, act%, spv&)
Static index as Integer
Static res as Integer

    Select Case act
    Case 1
        index = curindex
        endtime = timer + VAL(waittime)
        gl_linbuf = ""
        AppActivate APPNAME

    Case 2
         If DlgControlID(id) = DlgControlID("cancel") Then
            DlgEnd GL_CANCEL
         End If

    Case 5
        res = WaitForData(tn_target(index), tn_response(index), tn_responsetype(index))

        If res = GL_IDLE Then
            goto idleloop
        End If

        AppActivate APPNAME
        If res = -1 Then
            curindex = index
            DlgEnd GL_TIMOUT
        End If

        ' we just sent a response, so increment the index and init gl_linbuf.
        index = index + 1
        gl_linbuf = ""

        If index = tn_numtargets Then
            DlgEnd GL_SUCCESS                   ' we're done
        End If

    End Select

idleloop:
    ProcessData = 1

End Function


Function ProcessTargets As Integer
    Dim res As Integer

    Begin Dialog processdlg 129, 47, APPNAME, .ProcessData
       CancelButton  39, 28, 50, 14, .cancel
       Text  7, 9, 115, 15, SCRIPTINPROGRESS, .waittext
    End Dialog

    Dim processdatadlg as processdlg

    curindex = 0
reprocess:
    res = Dialog(processdatadlg)
    ProcessTargets = res
    Select Case res
        Case GL_CANCEL
            GoTo ExitTeach
        Case GL_DONE
            Exit Function
        Case GL_SUCCESS
            Exit Function
        Case GL_TIMOUT
            GetLastLine gl_linbuf, ReadCount
            gl_lastline = Trim$(gl_lastline)
            gl_lastatom = GetLastAtom(gl_lastline, Len(gl_lastline$))

            response = tn_response(curindex)
            res = GetResponse(tn_target(curindex), 3, gl_lastline, tn_response(curindex), response)
            Select Case res
                Case GR_NORMAL
                    Session.SendKeys(response)
                Case GR_PASSWORD
                    Session.SendKeys(response)
                Case GR_LOGIN
                    Session.SendKeys(response)
                Case GR_CANCEL
                     GoTo CancelTeach
                Case GR_ENTER
                    Session.SendKeys(response)
                Case GR_IGNORE
                    GoTo reprocess
                Case GR_DONE
                    GoTo ExitTeach:
            End Select
            curindex = curindex + 1
            if curindex < tn_numtargets Then
                goto reprocess
            End If
    End Select

Exit Function

CancelTeach:
ExitTeach:
         Telnet.Quit
         Set Telnet = Nothing
End Function

Sub Main

   tn_numtargets = 0