OS/2 Shareware BBS: 10 Tools/10-Tools.zip/pc3270sa.zip/vbdde/fsesexwa.frm

Text File | 2002-02-28 | 17KB | 556 lines

VERSION 4.00
Begin VB.Form FormSessExMacroWait
   Caption         =   "Wait"
   ClientHeight    =   5532
   ClientLeft      =   3588
   ClientTop       =   1728
   ClientWidth     =   4956
   BeginProperty Font
      name            =   "MS Sans Serif"
      charset         =   0
      weight          =   700
      size            =   7.8
      underline       =   0   'False
      italic          =   0   'False
      strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H80000008&
   Height          =   5856
   Left            =   3540
   LinkMode        =   1  'Source
   LinkTopic       =   "Form3"
   ScaleHeight     =   5532
   ScaleWidth      =   4956
   Top             =   1452
   Width           =   5052
   Begin VB.ComboBox SessionIdList
      BackColor       =   &H00FFFFC0&
      ForeColor       =   &H00000000&
      Height          =   288
      ItemData        =   "FSESEXWA.frx":0000
      Left            =   1200
      List            =   "FSESEXWA.frx":0052
      Sorted          =   -1  'True
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   360
      Width           =   492
   End
   Begin VB.CommandButton ExitDlg
      Cancel          =   -1  'True
      Caption         =   "E&xit"
      Height          =   372
      Left            =   3120
      TabIndex        =   26
      Top             =   5040
      Width           =   852
   End
   Begin VB.CommandButton Execute
      Caption         =   "&Execute"
      Default         =   -1  'True
      Height          =   372
      Left            =   960
      TabIndex        =   25
      Top             =   5040
      Width           =   852
   End
   Begin VB.Frame StringFrame
      Caption         =   "String"
      Enabled         =   0   'False
      ForeColor       =   &H80000008&
      Height          =   852
      Left            =   2160
      TabIndex        =   23
      Top             =   3960
      Width           =   2508
      Begin VB.TextBox StringText
         BackColor       =   &H00FFFFC0&
         Enabled         =   0   'False
         ForeColor       =   &H00000000&
         Height          =   492
         Left            =   96
         MaxLength       =   255
         MultiLine       =   -1  'True
         ScrollBars      =   1  'Horizontal
         TabIndex        =   24
         Top             =   240
         Width           =   2316
      End
   End
   Begin VB.CheckBox DefPSPosCheck
      Caption         =   "&Define PS position"
      Enabled         =   0   'False
      ForeColor       =   &H80000008&
      Height          =   375
      Left            =   216
      TabIndex        =   17
      Top             =   3360
      Width           =   1830
   End
   Begin VB.Frame CursorPosFrame
      Caption         =   "cursor position"
      Enabled         =   0   'False
      ForeColor       =   &H80000008&
      Height          =   612
      Left            =   2160
      TabIndex        =   18
      Top             =   3240
      Width           =   2508
      Begin VB.TextBox ColumnText
         BackColor       =   &H00FFFFC0&
         Enabled         =   0   'False
         ForeColor       =   &H00000000&
         Height          =   288
         Left            =   1824
         TabIndex        =   22
         Text            =   "01"
         Top             =   240
         Width           =   372
      End
      Begin VB.TextBox RowText
         BackColor       =   &H00FFFFC0&
         Enabled         =   0   'False
         ForeColor       =   &H00000000&
         Height          =   288
         Left            =   576
         TabIndex        =   20
         Text            =   "01"
         Top             =   240
         Width           =   396
      End
      Begin VB.Label ColumnLabel
         Caption         =   "&Column"
         Enabled         =   0   'False
         ForeColor       =   &H80000008&
         Height          =   252
         Left            =   1152
         TabIndex        =   21
         Top             =   240
         Width           =   684
      End
      Begin VB.Label RowLabel
         Caption         =   "&Row"
         Enabled         =   0   'False
         ForeColor       =   &H80000008&
         Height          =   252
         Left            =   96
         TabIndex        =   19
         Top             =   240
         Width           =   492
      End
   End
   Begin VB.Frame TrigerTypeFrame
      Caption         =   "Triger type"
      Enabled         =   0   'False
      ForeColor       =   &H80000008&
      Height          =   615
      Left            =   2520
      TabIndex        =   14
      Top             =   2400
      Width           =   2130
      Begin VB.OptionButton StringOption
         Caption         =   "&String"
         Enabled         =   0   'False
         ForeColor       =   &H80000008&
         Height          =   255
         Left            =   1050
         TabIndex        =   16
         Top             =   240
         Width           =   900
      End
      Begin VB.OptionButton CursorOption
         Caption         =   "Cu&rsor"
         Enabled         =   0   'False
         ForeColor       =   &H80000008&
         Height          =   255
         Left            =   90
         TabIndex        =   15
         Top             =   240
         Value           =   -1  'True
         Width           =   885
      End
   End
   Begin VB.Frame WaitTypeFrame
      Caption         =   "Waiting type"
      Enabled         =   0   'False
      ForeColor       =   &H80000008&
      Height          =   615
      Left            =   408
      TabIndex        =   11
      Top             =   2400
      Width           =   1935
      Begin VB.OptionButton UntilOption
         Caption         =   "&Until"
         Enabled         =   0   'False
         ForeColor       =   &H80000008&
         Height          =   252
         Left            =   1155
         TabIndex        =   13
         Top             =   240
         Width           =   684
      End
      Begin VB.OptionButton WhileOption
         Caption         =   "W&hile"
         Enabled         =   0   'False
         ForeColor       =   &H80000008&
         Height          =   252
         Left            =   120
         TabIndex        =   12
         Top             =   240
         Value           =   -1  'True
         Width           =   876
      End
   End
   Begin VB.CheckBox WaitConCheck
      Caption         =   "&Wait Condition"
      ForeColor       =   &H80000008&
      Height          =   375
      Left            =   240
      TabIndex        =   10
      Top             =   2040
      Width           =   1545
   End
   Begin VB.Frame TimeOutFrame
      Caption         =   "&Time out value"
      Enabled         =   0   'False
      ForeColor       =   &H80000008&
      Height          =   612
      Left            =   312
      TabIndex        =   4
      Top             =   1080
      Width           =   4260
      Begin VB.OptionButton HourOption
         Caption         =   "hour"
         Enabled         =   0   'False
         ForeColor       =   &H80000008&
         Height          =   255
         Left            =   3432
         TabIndex        =   9
         Top             =   240
         Width           =   720
      End
      Begin VB.OptionButton MinuteOption
         Caption         =   "minute"
         Enabled         =   0   'False
         ForeColor       =   &H80000008&
         Height          =   255
         Left            =   2568
         TabIndex        =   8
         Top             =   240
         Width           =   930
      End
      Begin VB.OptionButton SecOption
         Caption         =   "sec"
         Enabled         =   0   'False
         ForeColor       =   &H80000008&
         Height          =   255
         Left            =   1896
         TabIndex        =   7
         Top             =   240
         Width           =   645
      End
      Begin VB.OptionButton MsecOption
         Caption         =   "msec"
         Enabled         =   0   'False
         ForeColor       =   &H80000008&
         Height          =   255
         Left            =   1128
         TabIndex        =   6
         Top             =   240
         Value           =   -1  'True
         Width           =   870
      End
      Begin VB.TextBox TimeOutText
         Alignment       =   2  'Center
         BackColor       =   &H00FFFFC0&
         Enabled         =   0   'False
         ForeColor       =   &H00000000&
         Height          =   288
         Left            =   120
         MaxLength       =   6
         TabIndex        =   5
         Text            =   "000000"
         Top             =   240
         Width           =   732
      End
   End
   Begin VB.CheckBox TimeOutCheck
      Caption         =   "Time &Out"
      ForeColor       =   &H80000008&
      Height          =   252
      Left            =   216
      TabIndex        =   3
      Top             =   720
      Width           =   1164
   End
   Begin VB.TextBox DataText
      Height          =   372
      Left            =   2280
      TabIndex        =   27
      Text            =   "Text1"
      Top             =   5040
      Visible         =   0   'False
      Width           =   204
   End
   Begin VB.Frame Frame1
      Caption         =   "Input Parameters"
      Height          =   4812
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   4692
      Begin VB.Label Label1
         Caption         =   "Session &Id"
         Height          =   252
         Left            =   120
         TabIndex        =   1
         Top             =   240
         Width           =   972
      End
   End
End
Attribute VB_Name = "FormSessExMacroWait"
Attribute VB_Creatable = False
Attribute VB_Exposed = False

Private Sub ChangeCursorPosGroup(Status As Integer)

   CursorPosFrame.Enabled = Status
   RowLabel.Enabled = Status
   RowText.Enabled = Status
   ColumnLabel.Enabled = Status
   ColumnText.Enabled = Status
End Sub

Private Sub ChangeStringGroup(Status As Integer)

   StringFrame.Enabled = Status
   StringText.Enabled = Status
End Sub

Private Sub ChangeTimeOutGroup(Status As Integer)

   TimeOutFrame.Enabled = Status
   TimeOutText.Enabled = Status
   MsecOption.Enabled = Status
   SecOption.Enabled = Status
   MinuteOption.Enabled = Status
   HourOption.Enabled = Status

End Sub

Private Sub ChangeWaitConGroup(Status As Integer)

   WaitTypeFrame.Enabled = Status
   WhileOption.Enabled = Status
   UntilOption.Enabled = Status
   TrigerTypeFrame.Enabled = Status
   CursorOption.Enabled = Status
   StringOption.Enabled = Status
End Sub

Private Sub CursorOption_Click()

   DefPSPosCheck.Enabled = False
   ChangeStringGroup (False)
   ChangeCursorPosGroup (True)
End Sub

Private Sub DefPSPosCheck_Click()
   If DefPSPosCheck.Value = CHECKED Then
      ChangeCursorPosGroup (True)
   Else
      ChangeCursorPosGroup (False)
   End If
End Sub

Private Sub Execute_Click()
On Error GoTo ErrHandler
   FunctionComp = True

   OldMousePointer = MousePointer
   MousePointer = 11 ' Hour Glass Mouse Pointer

   DisplayType$ = GetDisplayType$(SessionIdList.Text)

   If DisplayType$ = "NONE" Then
      MousePointer = OldMousePointer
      MsgBox MSG_INVALID_PSID + SessionIdList.Text, 48, MSG_SAMPLE_PROG
      Exit Sub
   End If

   temp$ = LTrim$(RTrim$(SessionIdList.Text))
   If Len(temp$) > 0 Then
      Topic$ = "Session" + SessionIdList.Text
   Else
      MousePointer = OldMousePointer
      MsgBox MSG_PARA_ERROR, 48, MSG_SAMPLE_PROG
      Exit Sub
   End If
   CommandString$ = GetSessExMacroWaitData()

   rc = DoEvents()              'If you use VisualBasic V2.0, call
                                'DoEvents function each time before
                                'starting DDE conversation.
   DataText.LinkTimeout = -1
   DataText.LinkTopic = APPLICATION_NAME + "|" + Topic$
   DataText.LinkMode = COLD
   DataText.LinkExecute CommandString$
   DataText.LinkMode = NONE

   MousePointer = OldMousePointer
   If FunctionComp = True Then
      MsgBox MSG_FUNCTION_COMP, 64, MSG_SAMPLE_PROG
      EndStatus$ = MSG_OK
   Else
      MsgBox MSG_DDE_ERROR, 48, MSG_SAMPLE_PROG
      EndStatus$ = MSG_NG
   End If
   TempLogData$ = Time$ + ":Session Execute Macro : " + EndStatus$ + Chr$(13) + Chr$(10) + Chr$(9)
   TempLogData$ = TempLogData$ + MSG_APPLICATION + APPLICATION_NAME + """""" + Chr$(13) + Chr$(10) + Chr$(9)
   TempLogData$ = TempLogData$ + MSG_TOPIC + """" + Topic$ + """" + Chr$(13) + Chr$(10) + Chr$(9)
   TempLogData$ = TempLogData$ + "Command = " + """" + CommandString$ + """" + Chr$(13) + Chr$(10)
   LogData$(LogEnd) = TempLogData$
   UpdateLogPointer
   Loged = True
   Exit Sub

ErrHandler:
   FunctionComp = False
   Resume Next
End Sub

Private Sub ExitDlg_Click()
    Hide
End Sub

Private Function GetSessExMacroWaitData() As String
   Dim ReturnString As String
   Dim CursorPos As String
   Dim Status As Integer
   Status = True

   If TimeOutCheck.Value = CHECKED Then
      temp$ = RTrim$(LTrim$(TimeOutText.Text))
      If Len(temp$) > 0 Then
         If MsecOption.Value = True Then
            temp$ = temp$ + " msec"
         ElseIf SecOption.Value = True Then
            temp$ = temp$ + " sec"
         ElseIf MinuteOption.Value = True Then
            temp$ = temp$ + " minute"
         Else
            temp$ = temp$ + " hour"
         End If
         ReturnString = temp$
      Else
         Status = False
      End If
   End If

   If (Status = True) And WaitConCheck.Value = CHECKED Then
      If WhileOption.Value = True Then
         temp$ = "while "
      Else
         temp$ = "until "
      End If

      If DefPSPosCheck.Value = CHECKED Or DefPSPosCheck.Enabled = False Then
         Row$ = RTrim$(LTrim$(RowText.Text))
         Col$ = RTrim$(LTrim$(ColumnText.Text))
         If (Len(Row$) > 0) And (Len(Col$)) > 0 Then
            CursorPos = "(" + Row$ + "," + Col$ + ")"
         Else
            Status = False
         End If
      End If

      If Status = True Then
         If (CursorOption.Value = True) Then
            temp$ = temp$ + "cursor at " + CursorPos
         Else
            Triger$ = RTrim$(LTrim$(StringText.Text))
            If Len(Triger$) > 0 Then
               If Left$(Triger$, 1) = """""" Then
                  temp$ = temp$ + Triger$ + " "
               Else
                  temp$ = temp$ + """""" + Triger$ + """""" + " "
               End If
               If DefPSPosCheck.Value = CHECKED Then
                  temp$ = temp$ + "at " + CursorPos
               End If
            Else
               Status = False
            End If
         End If
         If Status = True Then
            ReturnString = ReturnString + " " + temp$
         End If
      End If
   End If
   If Status = True Then
     GetSessExMacroWaitData = "[WAIT(" + """" + ReturnString + """)]"
   End If
End Function

Private Sub Form_Load()
  SessionIdList.ListIndex = 0
  AdjustForNT351 FormSessExMacroWait
End Sub

Private Sub StringOption_Click()

   DefPSPosCheck.Enabled = True
   ChangeStringGroup (True)
   If DefPSPosCheck.Value = CHECKED Then
      ChangeCursorPosGroup (True)
   Else
      ChangeCursorPosGroup (False)
   End If
End Sub

Private Sub TimeOutCheck_Click()

   If TimeOutCheck.Value = CHECKED Then
      ChangeTimeOutGroup (True)
   Else
      ChangeTimeOutGroup (False)
   End If
End Sub

Private Sub UpdateLogPointer()
    LogEnd = LogEnd + 1
    If LogEnd = MAXLOGNUM + 1 Then
       LogEnd = 0
    End If

    If LogTop = LogEnd Then
       LogTop = LogTop + 1
       If LogTop = MAXLOGNUM + 1 Then
          LogTop = 0
       End If
    End If
End Sub

Private Sub WaitConCheck_Click()

   If WaitConCheck.Value = CHECKED Then
      ChangeWaitConGroup (True)
      If CursorOption.Value = True Then
         ChangeCursorPosGroup (True)
      Else
         ChangeStringGroup (True)
         DefPSPosCheck.Enabled = True
         If DefPSPosCheck.Value = CHECKED Then
            ChangeCursorPosGroup (True)
         End If
      End If
   Else
      ChangeWaitConGroup (False)
      ChangeCursorPosGroup (False)
      ChangeStringGroup (False)
      DefPSPosCheck.Enabled = False
   End If
End Sub