home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
pc3270sa.zip
/
vbdde
/
fgetps.frm
< prev
next >
Wrap
Text File
|
2002-02-28
|
21KB
|
619 lines
VERSION 4.00
Begin VB.Form FormGetPS
Caption = "Get Presentation Space"
ClientHeight = 6270
ClientLeft = 720
ClientTop = 990
ClientWidth = 8070
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 6675
Left = 660
LinkMode = 1 'Source
LinkTopic = "Form1"
ScaleHeight = 6270
ScaleWidth = 8070
Top = 645
Width = 8190
Begin VB.CommandButton Execute
Caption = "&Execute"
Default = -1 'True
Height = 375
Left = 2040
TabIndex = 2
Top = 5760
Width = 975
End
Begin VB.CommandButton ExitDlg
Cancel = -1 'True
Caption = "E&xit"
Height = 372
Left = 5040
TabIndex = 1
Top = 5760
Width = 972
End
Begin VB.TextBox PartialPSDataText
BackColor = &H00C0FFFF&
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "System"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 372
Left = 3720
Locked = -1 'True
MultiLine = -1 'True
TabIndex = 0
TabStop = 0 'False
Top = 5760
Visible = 0 'False
Width = 396
End
Begin TabDlg.SSTab SSTab1
Height = 5535
Left = 120
TabIndex = 3
Top = 120
Width = 7815
_ExtentX = 13785
_ExtentY = 9763
_Version = 393216
TabHeight = 423
TabCaption(0) = "Input Parameter"
Tab(0).ControlEnabled= -1 'True
Tab(0).Control(0)= "Frame1"
Tab(0).Control(0).Enabled= 0 'False
Tab(0).ControlCount= 1
TabCaption(1) = "PS Info and Data"
Tab(1).ControlEnabled= 0 'False
Tab(1).Control(0)= "PSDataFrame"
Tab(1).Control(1)= "Frame4"
Tab(1).Control(2)= "Frame5"
Tab(1).Control(3)= "Frame6"
Tab(1).ControlCount= 4
TabCaption(2) = "Field Info"
Tab(2).ControlEnabled= 0 'False
Tab(2).Control(0)= "Frame8"
Tab(2).ControlCount= 1
Begin VB.Frame Frame6
Caption = "Number of Columns"
Height = 612
Left = -71040
TabIndex = 31
Top = 360
Width = 1812
Begin VB.Label ColumnsLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 32
Top = 240
Width = 1572
End
End
Begin VB.Frame Frame5
Caption = "Number of Rows"
Height = 612
Left = -72960
TabIndex = 29
Top = 360
Width = 1812
Begin VB.Label RowsLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 30
Top = 240
Width = 1572
End
End
Begin VB.Frame Frame4
Caption = "Size Of PS"
Height = 612
Left = -74880
TabIndex = 27
Top = 360
Width = 1812
Begin VB.Label LengthLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 28
Top = 240
Width = 1572
End
End
Begin VB.Frame Frame1
Caption = "Input Parameter"
Height = 612
Left = 360
TabIndex = 24
Top = 720
Width = 1692
Begin VB.ComboBox SessionIdList
BackColor = &H00FFFFC0&
ForeColor = &H00000000&
Height = 288
ItemData = "FGETPS.frx":0000
Left = 1080
List = "FGETPS.frx":0052
Sorted = -1 'True
Style = 2 'Dropdown List
TabIndex = 26
Top = 240
Width = 492
End
Begin VB.Label Label2
Caption = "Session &Id"
Height = 252
Left = 120
TabIndex = 25
Top = 240
Width = 1092
End
End
Begin VB.Frame PSDataFrame
Caption = "PS Data"
Height = 4212
Left = -74880
TabIndex = 22
Top = 1080
Width = 7572
Begin VB.TextBox PSDataText
BackColor = &H00C0FFFF&
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "IBM3270"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3852
Left = 120
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 23
Top = 240
Width = 7332
End
End
Begin VB.Frame Frame8
Caption = "Field Information"
Height = 3372
Left = -74040
TabIndex = 4
Top = 1080
Width = 6012
Begin VB.Frame Frame9
Caption = "Number of Fields"
Height = 612
Left = 120
TabIndex = 20
Top = 240
Width = 1812
Begin VB.Label NumberLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 21
Top = 240
Width = 1572
End
End
Begin VB.Frame Frame10
Caption = "Fields"
Height = 2172
Left = 120
TabIndex = 5
Top = 960
Width = 5652
Begin VB.Frame Frame11
Caption = "Field Range"
Height = 612
Left = 120
TabIndex = 17
Top = 600
Width = 1572
Begin VB.Label FieldRangeLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 18
Top = 240
Width = 1332
End
End
Begin VB.Frame Frame12
Caption = "Type of Data"
Height = 612
Left = 1800
TabIndex = 15
Top = 600
Width = 1572
Begin VB.Label TypeOfDataLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 16
Top = 240
Width = 1332
End
End
Begin VB.Frame Frame13
Caption = "Intensity"
Height = 612
Left = 3480
TabIndex = 13
Top = 600
Width = 1572
Begin VB.Label IntensityLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 14
Top = 240
Width = 1332
End
End
Begin VB.Frame Frame14
Caption = "Pen Detectable"
Height = 612
Left = 120
TabIndex = 11
Top = 1320
Width = 1572
Begin VB.Label PenDectionLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 12
Top = 240
Width = 1332
End
End
Begin VB.Frame Frame15
Caption = "Is Modified"
Height = 612
Left = 1800
TabIndex = 9
Top = 1320
Width = 1572
Begin VB.Label IsModifiedLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 10
Top = 240
Width = 1332
End
End
Begin VB.ComboBox FieldCombo
BackColor = &H00C0FFFF&
ForeColor = &H00000000&
Height = 288
ItemData = "FGETPS.frx":00A4
Left = 600
List = "FGETPS.frx":00A6
Style = 2 'Dropdown List
TabIndex = 8
Top = 240
Width = 492
End
Begin VB.Frame Frame16
Caption = "Is Protected"
Height = 612
Left = 3480
TabIndex = 6
Top = 1320
Width = 1572
Begin VB.Label IsProtectedLabel
Alignment = 2 'Center
Height = 252
Left = 120
TabIndex = 7
Top = 240
Width = 1332
End
End
Begin VB.Label Label8
Caption = "Field"
Height = 252
Left = 120
TabIndex = 19
Top = 240
Width = 492
End
End
End
End
End
Attribute VB_Name = "FormGetPS"
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
Dim MainMinimumWidth As Long
Dim MainMinimumHeight As Long
Dim PSDataTextWidth As Long
Dim PSDataTextHeight As Long
Dim PSDataFrameWidth As Long
Dim PSDataFrameHeight As Long
Dim ExecuteTop As Long
Dim ExecuteLeft As Long
Dim ExitDlgTop As Long
Dim ExitDlgLeft As Long
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" + temp$
Else
MousePointer = OldMousePointer
MsgBox MSG_PARA_ERROR, 48, MSG_SAMPLE_PROG
Exit Sub
End If
Item$ = "PS"
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.LinkMode = COLD
PartialPSDataText.LinkItem = Item$
PartialPSDataText.LinkRequest
PartialPSDataText.LinkMode = NONE
MousePointer = OldMousePointer
If FunctionComp = True Then
GetPSInfo
If CInt(NumberLabel.Caption) <> 0 Then
FieldCombo.ListIndex = 0
End If
SSTab1.Tab = 1
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$ + ":Get 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
Loged = True
Exit Sub
ErrHandler:
FunctionComp = False
Resume Next
End Sub
Private Sub ExitDlg_Click()
Hide
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 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
'MFWU change Asc to be AscB
FieldAttribute = AscB(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
MainMinimumWidth = Width
MainMinimumHeight = Height
PSDataTextWidth = PSDataText.Width
PSDataTextHeight = PSDataText.Height
PSDataFrameWidth = PSDataFrame.Width
PSDataFrameHeight = PSDataFrame.Height
ExecuteTop = Execute.Top
ExecuteLeft = Execute.Left
ExitDlgTop = ExitDlg.Top
ExitDlgLeft = ExitDlg.Left
End Sub
Private Sub Form_Resize()
If WindowState = 1 Then ' Iconic
Exit Sub
End If
If (Width < MainMinimumWidth) Then
Width = MainMinimumWidth
End If
If (Height < MainMinimumHeight) Then
Height = MainMinimumHeight
End If
WidthDelta = Width - MainMinimumWidth
HeightDelta = Height - MainMinimumHeight
PSDataText.Width = PSDataTextWidth + WidthDelta
PSDataText.Height = PSDataTextHeight + HeightDelta
PSDataFrame.Width = PSDataFrameWidth + WidthDelta
PSDataFrame.Height = PSDataFrameHeight + HeightDelta
Execute.Top = ExecuteTop + HeightDelta
Execute.Left = ExecuteLeft + (WidthDelta / 2)
ExitDlg.Top = ExitDlgTop + HeightDelta
ExitDlg.Left = ExitDlgLeft + (WidthDelta / 2)
Refresh
End Sub
Private Sub GetPSInfo()
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
'MFWU change the following line.
'EndPosition = InStr(BeginPosition, PartialPSDataText.Text, Chr$(9))
EndPosition = BeginPosition + 1
If EndPosition = 0 Then
MsgBox "EndPostion is 0"
End If
'MFWU change Mid to be MidB
FieldAttributes(Counter) = MidB(PartialPSDataText.Text, BeginPosition, EndPosition - BeginPosition)
FieldCombo.AddItem Counter
Next Counter
End If
End Sub
Private Sub TabStrip1_Click(Index As Integer)
End Sub
