home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
pc3270sa.zip
/
vbdde
/
fstpsad.frm
< prev
next >
Wrap
Text File
|
2002-02-28
|
30KB
|
868 lines
VERSION 4.00
Begin VB.Form FormStartPSAdvise
BorderStyle = 3 'Fixed Dialog
Caption = "Start Session Advise (PS)"
ClientHeight = 6492
ClientLeft = 1980
ClientTop = 1536
ClientWidth = 8772
ControlBox = 0 'False
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 = 6816
Left = 1932
LinkMode = 1 'Source
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6492
ScaleWidth = 8772
ShowInTaskbar = 0 'False
Top = 1260
Width = 8868
Begin VB.TextBox PartialPSDataText
BackColor = &H00C0FFFF&
BeginProperty Font
name = "System"
charset = 0
weight = 700
size = 9.6
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 372
Left = 3360
Locked = -1 'True
MultiLine = -1 'True
TabIndex = 4
TabStop = 0 'False
Top = 6000
Visible = 0 'False
Width = 396
End
Begin VB.CommandButton ExitCommand
Cancel = -1 'True
Caption = "E&xit"
Height = 372
Left = 5760
TabIndex = 3
Top = 6000
Width = 852
End
Begin VB.CommandButton StopCommand
Caption = "&End"
Enabled = 0 'False
Height = 372
Left = 3960
TabIndex = 1
Top = 6000
Width = 852
End
Begin VB.CommandButton StartCommand
Caption = "&Begin"
Default = -1 'True
Height = 372
Left = 2160
TabIndex = 0
Top = 6000
Width = 852
End
Begin TabDlg.SSTab SSTab1
Height = 5532
Left = 120
TabIndex = 5
Top = 120
Width = 8532
_Version = 65536
_ExtentX = 15050
_ExtentY = 9758
_StockProps = 15
Caption = "PS Info and Data"
TabsPerRow = 3
Tab = 1
TabOrientation = 0
Tabs = 3
Style = 0
TabMaxWidth = 0
TabHeight = 423
TabCaption(0) = "Input Parametrs"
Tab(0).ControlCount= 1
Tab(0).ControlEnabled= 0 'False
Tab(0).Control(0)= "Frame1"
TabCaption(1) = "PS Info and Data"
Tab(1).ControlCount= 1
Tab(1).ControlEnabled= -1 'True
Tab(1).Control(0)= "PSInfoFrame"
TabCaption(2) = "Field Info"
Tab(2).ControlCount= 1
Tab(2).ControlEnabled= 0 'False
Tab(2).Control(0)= "Frame8"
Begin VB.Frame Frame8
Caption = "Field Information"
Height = 3372
Left = -73560
TabIndex = 32
Top = 1320
Width = 5652
Begin VB.ComboBox FieldCombo
BackColor = &H00C0FFFF&
ForeColor = &H00000000&
Height = 288
ItemData = "FSTPSAD.frx":0000
Left = 120
List = "FSTPSAD.frx":0002
Style = 2 'Dropdown List
TabIndex = 46
Top = 600
Width = 492
End
Begin VB.Frame Frame10
Caption = "Field"
Height = 1932
Left = 120
TabIndex = 33
Top = 1080
Width = 5292
Begin VB.Frame Frame16
Caption = "Is Protected"
Height = 612
Left = 1800
TabIndex = 44
Top = 1080
Width = 1572
Begin VB.Label IsProtectedLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 45
Top = 240
Width = 1332
End
End
Begin VB.Frame Frame15
Caption = "Is Modified"
Height = 612
Left = 120
TabIndex = 42
Top = 1080
Width = 1572
Begin VB.Label IsModifiedLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 43
Top = 240
Width = 1332
End
End
Begin VB.Frame Frame14
Caption = "Pen Detectable"
Height = 612
Left = 3480
TabIndex = 40
Top = 1080
Width = 1572
Begin VB.Label PenDectionLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 41
Top = 240
Width = 1332
End
End
Begin VB.Frame Frame13
Caption = "Intensity"
Height = 612
Left = 3480
TabIndex = 38
Top = 240
Width = 1572
Begin VB.Label IntensityLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 39
Top = 240
Width = 1332
End
End
Begin VB.Frame Frame12
Caption = "Type of Data"
Height = 612
Left = 1800
TabIndex = 36
Top = 240
Width = 1572
Begin VB.Label TypeOfDataLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 37
Top = 240
Width = 1332
End
End
Begin VB.Frame Frame11
Caption = "Field Range"
Height = 612
Left = 120
TabIndex = 34
Top = 240
Width = 1572
Begin VB.Label FieldRangeLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 35
Top = 240
Width = 1332
End
End
End
Begin VB.Label Label8
Caption = "Field"
Height = 252
Left = 120
TabIndex = 47
Top = 360
Width = 492
End
End
Begin VB.Frame PSInfoFrame
Caption = "PSInfo"
Height = 5052
Left = 120
TabIndex = 21
Top = 360
Width = 8292
Begin VB.Frame Frame2
Caption = "Length of Data"
Height = 612
Left = 120
TabIndex = 30
Top = 240
Width = 1812
Begin VB.Label LengthLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 31
Top = 240
Width = 1572
End
End
Begin VB.Frame Frame5
Caption = "Number of Rows"
Height = 612
Left = 2040
TabIndex = 28
Top = 240
Width = 1812
Begin VB.Label RowsLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 29
Top = 240
Width = 1572
End
End
Begin VB.Frame Frame6
Caption = "Number of Columns"
Height = 612
Left = 3960
TabIndex = 26
Top = 240
Width = 1812
Begin VB.Label ColumnsLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 27
Top = 240
Width = 1572
End
End
Begin VB.Frame PSDataFrame
Caption = "PS Data"
Height = 3972
Left = 120
TabIndex = 24
Top = 960
Width = 8052
Begin VB.TextBox PSDataText
BackColor = &H00C0FFFF&
BeginProperty Font
name = "IBM3270"
charset = 0
weight = 400
size = 10.8
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 3612
Left = 120
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 25
Top = 240
Width = 7812
End
End
Begin VB.Frame Frame9
Caption = "Number of Fields"
Height = 612
Left = 5880
TabIndex = 22
Top = 240
Width = 1812
Begin VB.Label NumberLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 23
Top = 240
Width = 1572
End
End
End
Begin VB.Frame Frame1
Caption = "Input Parameters"
Height = 4092
Left = -73920
TabIndex = 6
Top = 840
Width = 6372
Begin VB.Frame Frame4
Caption = "Topic"
Height = 612
Left = 240
TabIndex = 18
Top = 2520
Width = 2412
Begin VB.Label TopicLabel
Alignment = 2 'Center
Caption = "SessionA"
Height = 252
Left = 120
TabIndex = 19
Top = 240
Width = 2172
End
End
Begin VB.ComboBox SessionIdList
BackColor = &H00FFFFC0&
ForeColor = &H00000000&
Height = 288
ItemData = "FSTPSAD.frx":0004
Left = 1320
List = "FSTPSAD.frx":0056
Sorted = -1 'True
Style = 2 'Dropdown List
TabIndex = 17
Top = 480
Width = 492
End
Begin VB.Frame PSCondFrame
Caption = "Conditions"
Enabled = 0 'False
ForeColor = &H80000008&
Height = 2052
Left = 3720
TabIndex = 11
Top = 1800
Width = 2412
Begin VB.CheckBox PSCondCaseSenCheck
Caption = "Case &Sensitive"
Enabled = 0 'False
ForeColor = &H80000008&
Height = 252
Left = 240
TabIndex = 15
Top = 1680
Width = 1572
End
Begin VB.TextBox PSCondPosText
BackColor = &H00FFFFC0&
Enabled = 0 'False
ForeColor = &H00000000&
Height = 288
Left = 1200
TabIndex = 14
Text = "0000"
Top = 360
Width = 468
End
Begin VB.Frame Frame7
Caption = "Target String"
Height = 852
Left = 120
TabIndex = 12
Top = 720
Width = 2172
Begin VB.TextBox PSCondStrText
BackColor = &H00FFFFC0&
Enabled = 0 'False
ForeColor = &H00000000&
Height = 492
Left = 120
MultiLine = -1 'True
ScrollBars = 1 'Horizontal
TabIndex = 13
Top = 240
Width = 1932
End
End
Begin VB.Label PSCondPosLabel
Caption = "PS &Position"
Enabled = 0 'False
ForeColor = &H80000008&
Height = 252
Left = 120
TabIndex = 16
Top = 360
Width = 1068
End
End
Begin VB.CheckBox PSCondCheck
Caption = "Set PS &Condition"
ForeColor = &H80000008&
Height = 252
Left = 3720
TabIndex = 10
Top = 1440
Width = 1836
End
Begin VB.Frame UserDefFrame
Caption = "User &Defined String"
Enabled = 0 'False
ForeColor = &H80000008&
Height = 612
Left = 240
TabIndex = 8
Top = 1800
Width = 2412
Begin VB.TextBox UserDefStrText
BackColor = &H00FFFFC0&
Enabled = 0 'False
ForeColor = &H00000000&
Height = 288
Left = 120
TabIndex = 9
Text = "example"
Top = 240
Width = 2172
End
End
Begin VB.CheckBox TopicCheck
Caption = "&Use Session Topic Name "
ForeColor = &H80000008&
Height = 252
Left = 240
TabIndex = 7
Top = 1440
Value = 1 'Checked
Width = 2508
End
Begin VB.Label Label1
Caption = "Session &Id"
Height = 252
Left = 240
TabIndex = 20
Top = 480
Width = 1092
End
End
End
Begin VB.Label ResultMessageLabel
Alignment = 2 'Center
Caption = "DDE Conversation Started"
ForeColor = &H00FF0000&
Height = 252
Left = 120
TabIndex = 2
Top = 5760
Visible = 0 'False
Width = 8532
End
End
Attribute VB_Name = "FormStartPSAdvise"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
' Should dynamically base these off of the number of fields.
Dim FieldStarts(0 To 1000) As String
Dim FieldLengths(0 To 1000) As String
Dim FieldAttributes(0 To 1000) As String
Private Sub ChangePSCondGroup(Status As Integer)
PSCondFrame.Enabled = Status
TargetStringFrame.Enabled = Status
PSCondStrText.Enabled = Status
PSCondPosLabel.Enabled = Status
PSCondPosText.Enabled = Status
PSCondCaseSenCheck.Enabled = Status
End Sub
Private Sub GetAdvisePSInfo()
Dim BeginPosition As Integer
Dim EndPosition As Integer
BeginPosition = 1
EndPosition = InStr(BeginPosition, PartialPSDataText.Text, Chr$(9))
LengthLabel.Caption = Mid(PartialPSDataText.Text, BeginPosition, EndPosition - BeginPosition)
BeginPosition = EndPosition + 1
EndPosition = InStr(BeginPosition, PartialPSDataText.Text, Chr$(9))
RowsLabel.Caption = Mid(PartialPSDataText.Text, BeginPosition, EndPosition - BeginPosition)
BeginPosition = EndPosition + 1
EndPosition = InStr(BeginPosition, PartialPSDataText.Text, Chr$(9))
ColumnsLabel.Caption = Mid(PartialPSDataText.Text, BeginPosition, EndPosition - BeginPosition)
BeginPosition = EndPosition + 1
PSDataText.Text = Mid(PartialPSDataText.Text, BeginPosition, CInt(LengthLabel.Caption))
BeginPosition = BeginPosition + CInt(LengthLabel.Caption) + 1 + 2 * (CInt(RowsLabel.Caption) - 1)
' +1 for Tab Character and + 1 for each newline character between each row
EndPosition = InStr(BeginPosition, PartialPSDataText.Text, Chr$(9))
NumberLabel.Caption = Mid(PartialPSDataText.Text, BeginPosition, EndPosition - BeginPosition)
FieldCombo.Clear
FieldRangeLabel.Caption = ""
TypeOfDataLabel.Caption = ""
IntensityLabel.Caption = ""
PenDectionLabel.Caption = ""
IsModifiedLabel.Caption = ""
If CInt(NumberLabel.Caption) <> 0 Then
For Counter = 1 To CInt(NumberLabel.Caption)
' Field Start
BeginPosition = EndPosition + 1
BeginFieldPosition = BeginPosition
EndPosition = InStr(BeginPosition, PartialPSDataText.Text, Chr$(9))
FieldStarts(Counter) = Mid(PartialPSDataText.Text, BeginPosition, EndPosition - BeginPosition)
' Field Length
BeginPosition = EndPosition + 1
EndPosition = InStr(BeginPosition, PartialPSDataText.Text, Chr$(9))
FieldLengths(Counter) = Mid(PartialPSDataText.Text, BeginPosition, EndPosition - BeginPosition)
' Field Attribute
BeginPosition = EndPosition + 1
EndPosition = InStr(BeginPosition, PartialPSDataText.Text, Chr$(9))
' A temporary fix.
If EndPosition = 0 Then
MsgBox "EndPostion is 0"
Else
FieldAttributes(Counter) = Mid(PartialPSDataText.Text, BeginPosition, EndPosition - BeginPosition)
FieldCombo.AddItem Counter
End If
Next Counter
End If
End Sub
Private Sub BeginLabel_Click()
End Sub
Private Sub ExitCommand_Click()
Unload FormStartPSAdvise
End Sub
Private Function GetPSItemName() As String
Dim FuncStatus As Integer
FuncStatus = ST_OK
ReturnString$ = "PS"
If PSCondCheck.Value = CHECKED Then
PSPos$ = RTrim$(LTrim$(PSCondPosText.Text))
If Len(PSPos$) > 0 Then
TempStr$ = RTrim$(LTrim$(PSCondStrText.Text))
If Len(TempStr$) > 0 Then
If Left$(TempStr$, 1) = """" Then
TargetStr$ = TempStr$
TargetStrLen$ = LTrim$(Str$(Len(TargetStr$)))
Else
TargetStr$ = """" + TempStr$ + """"
TargetStrLen$ = LTrim$(Str$(Len(TargetStr$) - 2))
End If
If PSCondCaseSenCheck.Value = CHECKED Then
CaseSen$ = "1"
Else
CaseSen$ = "0"
End If
ReturnString$ = ReturnString$ + "(" + PSPos$ + "," + TargetStrLen$ + "," + CaseSen$ + "," + TargetStr$ + ")"
Else
FuncStatus = ST_ERROR
End If
Else
FuncStatus = ST_ERROR
End If
End If
If FuncStatus = ST_OK Then
GetPSItemName = ReturnString$
Else
MsgBox MSG_PARA_ERROR, 48, MSG_SAMPLE_PROG
End If
End Function
Private Function GetTopicName() As String
If Len(SessionIdList.Text) > 0 Then
If TopicCheck.Value = CHECKED Then
ReturnString$ = "Session" + SessionIdList.Text
Else
ReturnString$ = "Sess" + SessionIdList.Text + "_" + UserDefStrText.Text
End If
GetTopicName = ReturnString$
Else
MsgBox MSG_PARA_ERROR, 48, MSG_SAMPLE_PROG
End If
End Function
Private Sub FieldCombo_Click()
Dim FieldAttribute As Byte
Dim StartOfField As Integer
Dim length As Integer
Dim EndOfField As Integer
StartOfField = FieldStarts(FieldCombo.Text)
length = FieldLengths(FieldCombo.Text)
EndOfField = StartOfField + length - 1
FieldAttribute = Asc(FieldAttributes(FieldCombo.Text))
FieldRangeLabel.Caption = StartOfField & "-" & EndOfField
If FieldAttribute And &H10& Then
TypeOfDataLabel.Caption = "Numeric"
Else
TypeOfDataLabel.Caption = "AlphaNumeric"
End If
If FieldAttribute And &H20& Then
IsProtectedLabel.Caption = "Yes"
Else
IsProtectedLabel.Caption = "No"
End If
If ((FieldAttribute And &HC&) = &H0&) Then
IntensityLabel.Caption = "Normal"
PenDectionLabel.Caption = "No"
ElseIf ((FieldAttribute And &HC&) = &H4&) Then
IntensityLabel.Caption = "Normal"
PenDectionLabel.Caption = "Yes"
ElseIf ((FieldAttribute And &HC&) = &H8&) Then
IntensityLabel.Caption = "High"
PenDectionLabel.Caption = "Yes"
Else
IntensityLabel.Caption = "Non-Display"
PenDectionLabel.Caption = "No"
End If
If FieldAttribute And &H1& Then
IsModifiedLabel.Caption = "Yes"
Else
IsModifiedLabel.Caption = "No"
End If
End Sub
Private Sub Form_Load()
SessionIdList.ListIndex = 0
AdjustForNT351 FormStartPSAdvise
End Sub
Private Sub PartialPSDataText_Change()
If StartCommand.Enabled = False Then
PSDataLen& = Val(Left$(PartialPSDataText.Text, 4)) + 15
LogData$(LogEnd) = Time$ + ":PS was updated :" + Chr$(13) + Chr$(10)
UpdateLogPointer
UpdateLog
GetAdvisePSInfo
If CInt(NumberLabel.Caption) <> 0 Then
FieldCombo.ListIndex = 0
End If
SSTab1.Tab = 1
End If
End Sub
Private Sub PSCondCheck_Click()
If PSCondCheck.Value = CHECKED Then
ChangePSCondGroup (True)
Else
ChangePSCondGroup (False)
End If
End Sub
Private Sub PSDataText_Change()
' If StartCommand.Enabled = False Then
' PSDataLen& = Val(Left$(PSDataText.Text, 4)) + 15
' LogData$(LogEnd) = Time$ + ":PS was updated :" + Chr$(13) + Chr$(10)
' UpdateLogPointer
' UpdateLog
' End If
End Sub
Private Sub StartCommand_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
Topic$ = GetTopicName()
If Len(Topic$) <= 0 Then
MsgBox MSG_PARA_ERROR, 48, MSG_SAMPLE_PROG
MousePointer = OldMousePointer
Exit Sub
End If
Item$ = GetPSItemName()
If Len(Item$) <= 0 Then
MsgBox MSG_PARA_ERROR, 48, MSG_SAMPLE_PROG
MousePointer = OldMousePointer
Exit Sub
End If
rc = DoEvents() 'If you use VisualBasic V2.0, call
'DoEvents function each time before
'starting DDE conversation.
PartialPSDataText.LinkTimeout = -1
PartialPSDataText.LinkTopic = APPLICATION_NAME + "|" + Topic$
PartialPSDataText.LinkItem = Item$
PartialPSDataText.LinkMode = HOT
MousePointer = OldMousePointer
If FunctionComp = True Then
ResultMessageLabel.Visible = True
StartCommand.Enabled = False
StopCommand.Enabled = True
ExitCommand.Enabled = False
EndStatus$ = MSG_OK
Else
ResultMessageLabel.Visible = False
MsgBox MSG_DDE_ERROR, 48, MSG_SAMPLE_PROG
EndStatus$ = MSG_NG
End If
TempLogData$ = Time$ + ":Start Session Advise (PS) : " + 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$ + MSG_ITEM + """" + Item$ + """" + Chr$(13) + Chr$(10)
LogData$(LogEnd) = TempLogData$
UpdateLogPointer
UpdateLog
Exit Sub
ErrHandler:
FunctionComp = False
Resume Next
End Sub
Private Sub StopCommand_Click()
On Error GoTo StopErrHandler
FunctionComp = True
PartialPSDataText.LinkTimeout = -1
PartialPSDataText.LinkMode = NONE
If FunctionComp = True Then
ResultMessageLabel.Visible = False
EndStatus$ = MSG_OK
StopCommand.Enabled = False
StartCommand.Enabled = True
ExitCommand.Enabled = True
Else
MsgBox MSG_DDE_ERROR, 48, MSG_SAMPLE_PROG
EndStatus$ = MSG_NG
End If
LogData$(LogEnd) = Time$ + ":Stop Session Advise (PS) : " + EndStatus$ + Chr$(13) + Chr$(10)
UpdateLogPointer
UpdateLog
Exit Sub
StopErrHandler:
FunctionEnd = False
Resume Next
End Sub
Private Sub TopicCheck_Click()
If TopicCheck.Value = CHECKED Then
UserDefFrame.Enabled = False
UserDefStrText.Enabled = False
Else
UserDefFrame.Enabled = True
UserDefStrText.Enabled = True
End If
TopicLabel.Caption = GetTopicName()
End Sub
Private Sub UpdateLog()
temp$ = " "
If LogTop > LogEnd Then
For i% = LogTop To MAXLOGNUM
temp$ = temp$ + LogData$(i%)
Next
For i% = 0 To LogEnd
temp$ = temp$ + LogData$(i%)
Next
ElseIf LogTop < LogEnd Then
For i% = LogTop To LogEnd
temp$ = temp$ + LogData(i%)
Next
Else
temp$ = LogData(i%)
End If
MainForm.FunctionLog.Text = temp$
Loged = False
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 UserDefStrText_Change()
TopicLabel.Caption = GetTopicName()
End Sub