Super Net 1/SUPERNET_1.iso/PC/OTROS/EXTRAS/WINWAIS/VB/DIAL.FRM

Visual Basic Form | 1993-12-07 | 20.8 KB | 644 lines

VERSION 2.00
Begin Form dial_form
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "SLIP Dialer"
   ClientHeight    =   2940
   ClientLeft      =   1005
   ClientTop       =   2370
   ClientWidth     =   7350
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   FontBold        =   0   'False
   FontItalic      =   0   'False
   FontName        =   "MS Sans Serif"
   FontSize        =   8.25
   FontStrikethru  =   0   'False
   FontUnderline   =   0   'False
   Height          =   3345
   Icon            =   DIAL.FRX:0000
   Left            =   945
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2940
   ScaleWidth      =   7350
   Top             =   2025
   Width           =   7470
   Begin SSPanel Panel3D8
      Align           =   1  'Align Top
      Alignment       =   6  'Center - TOP
      BackColor       =   &H00C0C0C0&
      Font3D          =   0  'None
      ForeColor       =   &H00000000&
      Height          =   600
      Left            =   0
      TabIndex        =   22
      Top             =   0
      Width           =   7350
      Begin CommandButton edit_script
         Caption         =   "Edit"
         Height          =   345
         Left            =   6510
         TabIndex        =   1
         Top             =   150
         Width           =   705
      End
      Begin SSPanel Panel3D9
         Alignment       =   6  'Center - TOP
         BackColor       =   &H00C0C0C0&
         BevelOuter      =   1  'Inset
         Caption         =   "Select a Script"
         Font3D          =   0  'None
         ForeColor       =   &H00000000&
         Height          =   465
         Left            =   120
         TabIndex        =   24
         Top             =   60
         Width           =   885
      End
      Begin ComboBox dial_script
         Height          =   300
         Left            =   1050
         Sorted          =   -1  'True
         Style           =   2  'Dropdown List
         TabIndex        =   23
         Top             =   180
         Width           =   5385
      End
   End
   Begin CommandButton done
      Caption         =   "Done"
      Height          =   345
      Left            =   4740
      TabIndex        =   21
      Top             =   2460
      Width           =   1005
   End
   Begin CommandButton hangup_button
      Caption         =   "HangUp"
      Height          =   345
      Left            =   3660
      TabIndex        =   20
      Top             =   2460
      Width           =   975
   End
   Begin CommandButton stop_script
      Caption         =   "Stop"
      Height          =   345
      Left            =   2580
      TabIndex        =   19
      Top             =   2460
      Width           =   975
   End
   Begin CommandButton run_script
      Caption         =   "Start"
      Height          =   345
      Left            =   1530
      TabIndex        =   18
      Top             =   2460
      Width           =   945
   End
   Begin SSPanel Panel3D3
      Align           =   1  'Align Top
      BackColor       =   &H00C0C0C0&
      Font3D          =   1  'Raised w/light shading
      ForeColor       =   &H00000000&
      Height          =   540
      Left            =   0
      TabIndex        =   9
      Top             =   600
      Width           =   7350
      Begin SSPanel Panel3D7
         Alignment       =   1  'Left Justify - MIDDLE
         BackColor       =   &H00C0C0C0&
         BevelOuter      =   1  'Inset
         Caption         =   " Data Bits"
         Font3D          =   0  'None
         ForeColor       =   &H00000000&
         Height          =   345
         Left            =   5760
         TabIndex        =   16
         Top             =   120
         Width           =   1485
         Begin ComboBox databits
            Height          =   300
            Left            =   900
            Style           =   2  'Dropdown List
            TabIndex        =   17
            Top             =   30
            Width           =   555
         End
      End
      Begin SSPanel Panel3D6
         Alignment       =   1  'Left Justify - MIDDLE
         BackColor       =   &H00C0C0C0&
         BevelOuter      =   1  'Inset
         Caption         =   " Parity"
         Font3D          =   0  'None
         ForeColor       =   &H00000000&
         Height          =   345
         Left            =   4020
         TabIndex        =   14
         Top             =   120
         Width           =   1515
         Begin ComboBox parity
            Height          =   300
            Left            =   630
            Style           =   2  'Dropdown List
            TabIndex        =   15
            Top             =   30
            Width           =   855
         End
      End
      Begin SSPanel Panel3D5
         Alignment       =   1  'Left Justify - MIDDLE
         BackColor       =   &H00C0C0C0&
         BevelOuter      =   1  'Inset
         Caption         =   " Speed"
         Font3D          =   0  'None
         ForeColor       =   &H00000000&
         Height          =   345
         Left            =   2160
         TabIndex        =   12
         Top             =   120
         Width           =   1605
         Begin ComboBox speed
            Height          =   300
            Left            =   690
            Style           =   2  'Dropdown List
            TabIndex        =   13
            Top             =   30
            Width           =   885
         End
      End
      Begin SSPanel Panel3D4
         Alignment       =   1  'Left Justify - MIDDLE
         BackColor       =   &H00C0C0C0&
         BevelOuter      =   1  'Inset
         Caption         =   " Com Port"
         Font3D          =   0  'None
         ForeColor       =   &H00000000&
         Height          =   345
         Left            =   150
         TabIndex        =   10
         Top             =   120
         Width           =   1785
         Begin ComboBox commport
            Height          =   300
            Left            =   900
            Style           =   2  'Dropdown List
            TabIndex        =   11
            Top             =   30
            Width           =   855
         End
      End
   End
   Begin SSPanel Panel3D1
      Align           =   1  'Align Top
      Alignment       =   0  'Left Justify - TOP
      BackColor       =   &H00C0C0C0&
      Font3D          =   1  'Raised w/light shading
      ForeColor       =   &H00000000&
      Height          =   1245
      Left            =   0
      TabIndex        =   0
      Top             =   1140
      Width           =   7350
      Begin MSComm Comm
         Interval        =   1000
         Left            =   6780
         Top             =   330
      End
      Begin SSPanel label3
         Alignment       =   6  'Center - TOP
         BackColor       =   &H00C0C0C0&
         BevelOuter      =   1  'Inset
         Caption         =   "Status"
         Font3D          =   0  'None
         ForeColor       =   &H00000000&
         Height          =   315
         Left            =   150
         TabIndex        =   8
         Top             =   720
         Width           =   885
      End
      Begin SSPanel label2
         Alignment       =   6  'Center - TOP
         BackColor       =   &H00C0C0C0&
         BevelOuter      =   1  'Inset
         Caption         =   "Reply"
         Font3D          =   0  'None
         ForeColor       =   &H00000000&
         Height          =   255
         Left            =   150
         TabIndex        =   7
         Top             =   420
         Width           =   885
      End
      Begin SSPanel label1
         Alignment       =   6  'Center - TOP
         BackColor       =   &H00C0C0C0&
         BevelOuter      =   1  'Inset
         Caption         =   "Send"
         Font3D          =   0  'None
         ForeColor       =   &H00000000&
         Height          =   285
         Left            =   150
         TabIndex        =   6
         Top             =   90
         Width           =   885
      End
      Begin SSPanel Panel3D2
         BackColor       =   &H00C0C0C0&
         BevelOuter      =   1  'Inset
         Font3D          =   1  'Raised w/light shading
         ForeColor       =   &H00000000&
         Height          =   945
         Left            =   1050
         TabIndex        =   2
         Top             =   90
         Width           =   6225
         Begin Label xmit
            BackColor       =   &H00FFFFFF&
            BorderStyle     =   1  'Fixed Single
            FontBold        =   0   'False
            FontItalic      =   0   'False
            FontName        =   "Terminal"
            FontSize        =   9
            FontStrikethru  =   0   'False
            FontUnderline   =   0   'False
            Height          =   255
            Left            =   30
            TabIndex        =   5
            Top             =   30
            Width           =   6135
         End
         Begin Label recv
            BackColor       =   &H00FFFFFF&
            BorderStyle     =   1  'Fixed Single
            FontBold        =   0   'False
            FontItalic      =   0   'False
            FontName        =   "Terminal"
            FontSize        =   9
            FontStrikethru  =   0   'False
            FontUnderline   =   0   'False
            Height          =   255
            Left            =   30
            TabIndex        =   4
            Top             =   330
            Width           =   6135
         End
         Begin Label status
            BackColor       =   &H00FFFFFF&
            BorderStyle     =   1  'Fixed Single
            FontBold        =   0   'False
            FontItalic      =   0   'False
            FontName        =   "Terminal"
            FontSize        =   9
            FontStrikethru  =   0   'False
            FontUnderline   =   0   'False
            Height          =   255
            Left            =   30
            TabIndex        =   3
            Top             =   630
            Width           =   6135
         End
      End
   End
   Begin Timer interval_timer
      Enabled         =   0   'False
      Interval        =   1
      Left            =   3240
      Top             =   540
   End
Dim time_expired As Integer
Dim recv_matched As Integer
Dim rcv As String
Dim do_capture As Integer
Dim captured As String
Dim cancel_script As Integer
Dim init_file As String
Dim init_section As String
'---------------------------------------
'Comm Control
'---------------------------------------
'Handshaking
Const MSCOMM_HANDSHAKE_NONE = 0
Const MSCOMM_HANDSHAKE_XONXOFF = 1
Const MSCOMM_HANDSHAKE_RTS = 2
Const MSCOMM_HANDSHAKE_RTSXONXOFF = 3
'Event constants
Const MSCOMM_EV_SEND = 1
Const MSCOMM_EV_RECEIVE = 2
Const MSCOMM_EV_CTS = 3
Const MSCOMM_EV_DSR = 4
Const MSCOMM_EV_CD = 5
Const MSCOMM_EV_RING = 6
Const MSCOMM_EV_EOF = 7
'Error code constants
Const MSCOMM_ER_BREAK = 1001
Const MSCOMM_ER_CTSTO = 1002
Const MSCOMM_ER_DSRTO = 1003
Const MSCOMM_ER_FRAME = 1004
Const MSCOMM_ER_OVERRUN = 1006
Const MSCOMM_ER_CDTO = 1007
Const MSCOMM_ER_RXOVER = 1008
Const MSCOMM_ER_RXPARITY = 1009
Const MSCOMM_ER_TXFULL = 1010
Declare Function GetINIInt Lib "kernel" Alias "GetPrivateProfileInt" (ByVal app As String, ByVal key As String, ByVal def As Integer, ByVal fn As String) As Integer
Declare Function GetINIString Lib "kernel" Alias "GetPrivateProfileString" (ByVal app As String, ByVal key As String, ByVal def As String, ByVal ret As String, ByVal retsz As Integer, ByVal fn As String) As Integer
Declare Function PutINIString Lib "kernel" Alias "WritePrivateProfileString" (ByVal app As String, ByVal key As String, ByVal arg As Any, ByVal fn As String) As Integer
Sub done_click ()
  End
End Sub
Sub edit_script_Click ()
  z = Shell("notepad " + dial_script.Text + ".slp", 1)
End Sub
Sub Form_Load ()
  CommPort.AddItem "COM1"
  CommPort.AddItem "COM2"
  CommPort.AddItem "COM3"
  CommPort.AddItem "COM4"
  parity.AddItem "EVEN"
  parity.AddItem "ODD"
  parity.AddItem "NONE"
  parity.AddItem "MARK"
  parity.AddItem "SPACE"
  speed.AddItem "300"
  speed.AddItem "1200"
  speed.AddItem "2400"
  speed.AddItem "9600"
  speed.AddItem "19200"
  databits.AddItem "8"
  databits.AddItem "7"
  parity.ListIndex = GetINIInt("Slip", "Parity", 0, "wais.ini")
  CommPort.ListIndex = GetINIInt("Slip", "Port", 0, "wais.ini")
  speed.ListIndex = GetINIInt("Slip", "Speed", 0, "wais.ini")
  databits.ListIndex = GetINIInt("Slip", "DataBits", 0, "wais.ini")
  If comm.PortOpen = True Then
    run_script.Enabled = False
    stop_script.Enabled = False
    hangup_button.Enabled = True
  Else
    run_script.Enabled = True
    stop_script.Enabled = False
    hangup_button.Enabled = False
  End If
  dial_script.Clear
  sc$ = Dir$("*.slp")
  While sc$ <> ""
    sc$ = Left$(sc$, InStr(sc$, ".") - 1)
    dial_script.AddItem sc$
    sc$ = Dir$
  Wend
  dial_script.ListIndex = 0
End Sub
Sub Form_Unload (cancel As Integer)
  If cancel Then
    If comm.PortOpen = True Then
      comm.PortOpen = False
    End If
  End If
  End
End Sub
Sub hangup_button_Click ()
  If comm.PortOpen = True Then
    comm.PortOpen = False
  End If
  run_script.Enabled = True
  stop_script.Enabled = False
  hangup_button.Enabled = False
End Sub
Sub interval_timer_Timer ()
    If arg = "" Then
      recv_matched = True
    Else
      time_expired = True
    End If
End Sub
Sub process_script ()
Dim op1 As Integer
Dim op2 As Integer
Dim ln As String
Dim ch As String
Dim comd As String
  label1.Refresh
  label2.Refresh
  label3.Refresh
  z = PutINIString("Slip", "Parity", Str$(parity.ListIndex), "wais.ini")
  z = PutINIString("Slip", "Speed", Str$(speed.ListIndex), "wais.ini")
  z = PutINIString("Slip", "Port", Str$(CommPort.ListIndex), "wais.ini")
  z = PutINIString("Slip", "DataBits", Str$(databits.ListIndex), "wais.ini")
  comm.CommPort = Val(Right$(CommPort.List(CommPort.ListIndex), 1))
  cs$ = speed.List(speed.ListIndex) + ","
  cs$ = cs$ + Left$(parity.List(parity.ListIndex), 1) + ","
  cs$ = cs$ + databits.List(databits.ListIndex) + "," + "1"
  comm.Settings = cs$

  comm.InputLen = 1
  comm.PortOpen = True
  run_script.Enabled = False
  stop_script.Enabled = True
  done.Enabled = False
  script_handle = FreeFile
  Open dial_script.Text + ".slp" For Input As script_handle
  Do While Not EOF(script_handle)

    Line Input #script_handle, ln
    ln = Trim$(ln)
    c = InStr(ln, "#")
    If c > 0 Then
      ln = Left$(ln, c - 1)
    End If
    If Len(ln) > 0 Then
      op1 = InStr(ln, " ")
      If op1 = 0 Then
        MsgBox "Command " + ln + " has no operands", MB_INFO
        Exit Do
      End If

      comd = LCase$(Left$(ln, op1 - 1))

      Select Case comd
        Case "file"
          init_file = Trim$(Right$(ln, Len(ln) - op1)) + ".ini"

        Case "section"
          init_section = Trim$(Right$(ln, Len(ln) - op1))

        Case "set"
          If init_file = "" Or init_section = "" Then
            MsgBox "Missing INI file name or section", MB_INFO
            Close (slip_handle)
            comm.PortOpen = False
            End
          End If
          op2 = InStr(ln, "=")
          cmd$ = Trim$(Mid$(ln, op1, op2 - op1))
          cmdval$ = Right$(ln, Len(ln) - op2)

          Select Case cmdval$
            Case "capture"
              z = PutINIString(init_section, cmd$, captured, init_file)
            Case "port"
              z = PutINIString(init_section, cmd$, Str$(CommPort.ListIndex + 1), init_file)
            Case "speed"
              txt$ = speed.Text
              z = PutINIString(init_section, cmd$, txt$, init_file)
            Case Else
              z = PutINIString(init_section, cmd$, cmdval$, init_file)
          End Select

        Case "send", "prompt"
          GoSub get_time_and_arg
          If comd = "prompt" Then
            prompt_form.prompt.Caption = arg
            prompt_form.Show 1
            Unload prompt_form
          End If
          status.Caption = "Sending output"
          status.Refresh
          xmit.Caption = ""
          xmit.Refresh
          For x = 1 To Len(arg)
            ch = Mid$(arg, x, 1)
            If ch = "^" Then
              xmit.Caption = xmit.Caption + ch
              x = x + 1
              ch = Chr$(Asc(Mid$(arg, x, 1)) And &H3F)
            End If
            comm.Output = ch
            If comd = "prompt" Then
              xmit.Caption = xmit.Caption + "*"
            Else
              xmit.Caption = xmit.Caption + ch
            End If
            If Len(xmit.Caption) > 50 Then
              xmit.Caption = Right$(xmit.Caption, 50)
            End If
            xmit.Refresh
          Next x

        Case "wait", "capture"
          Debug.Print ln
          GoSub get_time_and_arg
          If comd = "capture" Then
            do_capture = True
            captured = ""
          Else
            do_capture = False
          End If

          status.Caption = "Waiting" + Str$(time_to_wait) + " seconds"
          If arg <> "" Then
            status.Caption = status.Caption + " for: " + arg
            If InStr(arg, "^") > 0 Then
              tmp$ = ""
              For x = 1 To Len(arg)
                If Mid$(arg, x, 1) = "^" Then
                  ctrlc = True
                Else
                  If ctrlc = True Then
                    tmp$ = tmp$ + Chr$(Asc(Mid$(arg, x, 1)) And &H3F)
                    ctrlc = False
                  Else
                    tmp$ = tmp$ + Mid$(arg, x, 1)
                  End If
                End If
              Next x
              arg = tmp$
            End If
          End If
          status.Refresh
          recv.Caption = ""
          recv.Refresh

          time_expired = False
          recv_matched = False
          cancel_script = False

          interval_timer.Interval = time_to_wait * 1000
          interval_timer.Enabled = True

          'char_timer.Enabled = True

          Do While time_expired = False And recv_matched = False And cancel_script = False
            z = DoEvents()
            If comm.PortOpen = False Then
              Exit Do
            End If
            ch = comm.Input
            If Len(ch) > 0 Then
              If do_capture = True Then
                captured = captured + ch
              End If
              rcv = rcv + ch
              If Len(rcv) > Len(arg) Then
                rcv = Right$(rcv, Len(arg))
              End If
              recv.Caption = recv.Caption + ch
              If Len(recv.Caption) > 50 Then
                recv.Caption = Right$(recv.Caption, 50)
              End If
              If arg <> "" And rcv = arg Then
                recv_matched = True
                If do_capture = True Then
                  captured = Left$(captured, Len(captured) - Len(arg))
                End If
              End If
              If Asc(ch) < 32 Then
                recv.Caption = ""
              End If
            End If
          Loop

          'char_timer.Enabled = False
          interval_timer.Enabled = False

          If time_expired Then
            MsgBox "Time expired", MB_INFO
            Close (slip_handle)
            comm.PortOpen = False
            End
          End If
          If cancel_script Then
            Close (slip_handle)
            If comm.PortOpen = True Then
              comm.PortOpen = False
            End If
            run_script.Enabled = True
            stop_script.Enabled = False
            done.Enabled = True
            Exit Do
          End If
        Case Else
          MsgBox "Unrecognized command: " + comd$, MB_INFO
      End Select
    End If
  Loop
  Close (slip_handle)
  ' leave the line connected
  Exit Sub
get_time_and_arg:

  time_to_wait = Val(Right$(ln, Len(ln) - op1))
  op1 = InStr(ln, Chr$(34))
  If op1 = 0 Then
    arg = ""
  Else
    op2 = InStr(op1 + 1, ln, Chr$(34))
    arg = Mid$(ln, op1 + 1, op2 - op1 - 1)
  End If
  Return
End Sub
Sub run_script_Click ()
  process_script
  If cancel_script = False Then
    End
  End If
End Sub
Sub stop_script_Click ()
  cancel_script = True
End Sub