home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
pc3270sa.zip
/
vbdde
/
vbdde.frm
< prev
next >
Wrap
Text File
|
2002-02-28
|
25KB
|
963 lines
VERSION 4.00
Begin VB.Form MainForm
Caption = "DDE Test Program"
ClientHeight = 4524
ClientLeft = 1956
ClientTop = 3120
ClientWidth = 8460
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 = 5076
Left = 1908
LinkMode = 1 'Source
LinkTopic = "Form1"
ScaleHeight = 4524
ScaleWidth = 8460
Top = 2616
Width = 8556
Begin VB.TextBox SessionCoordsTextBox
Height = 372
Left = 8280
TabIndex = 33
Text = "Text1"
Top = 1920
Visible = 0 'False
Width = 252
End
Begin VB.TextBox SessionDimensionsTextBox
Height = 372
Left = 8280
TabIndex = 32
Text = "Text1"
Top = 2400
Visible = 0 'False
Width = 252
End
Begin VB.TextBox GetDisplayTypeText
Height = 372
Left = 8280
TabIndex = 31
Text = "Text1"
Top = 3000
Visible = 0 'False
Width = 252
End
Begin VB.Timer SessionUpdateTimer
Interval = 5000
Left = 8160
Top = 3600
End
Begin VB.TextBox SystemTopicsText
Height = 372
Left = 8160
TabIndex = 30
Text = "Text1"
Top = 4080
Visible = 0 'False
Width = 252
End
Begin VB.TextBox FunctionLog
BackColor = &H00C0FFFF&
BorderStyle = 0 'None
BeginProperty Font
name = "System"
charset = 0
weight = 700
size = 9.6
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 3372
Left = 360
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 0
TabStop = 0 'False
Top = 360
Width = 7692
End
Begin VB.Frame FunctionLogFrame
Caption = "DDE Function Call Log"
Height = 3732
Left = 240
TabIndex = 1
Top = 120
Width = 7932
End
Begin VB.Label SessionLabel
Alignment = 2 'Center
Caption = "Z"
ForeColor = &H00808080&
Height = 252
Index = 25
Left = 7920
TabIndex = 29
Top = 4080
Width = 252
End
Begin VB.Label SessionLabel
Alignment = 2 'Center
Caption = "Y"
ForeColor = &H00808080&
Height = 252
Index = 24
Left = 7680
TabIndex = 28
Top = 4080
Width = 252
End
Begin VB.Label SessionLabel
Alignment = 2 'Center
Caption = "X"
ForeColor = &H00808080&
Height = 252
Index = 23
Left = 7440
TabIndex = 27
Top = 4080
Width = 252
End
Begin VB.Label SessionLabel
Alignment = 2 'Center
Caption = "W"
ForeColor = &H00808080&
Height = 252
Index = 22
Left = 7200
TabIndex = 26
Top = 4080
Width = 252
End
Begin VB.Label SessionLabel
Alignment = 2 'Center
Caption = "V"
ForeColor = &H00808080&
Height = 252
Index = 21
Left = 6960
TabIndex = 25
Top = 4080
Width = 252
End
Begin VB.Label SessionLabel
Alignment = 2 'Center
Caption = "U"
ForeColor = &H00808080&
Height = 252
Index = 20
Left = 6720
TabIndex = 24
Top = 4080
Width = 252
End
Begin VB.Label SessionLabel
Alignment = 2 'Center
Caption = "T"
ForeColor = &H00808080&
Height = 252
Index = 19
Left = 6480
TabIndex = 23
Top = 4080
Width = 252
End
Begin VB.Label SessionLabel
Alignment = 2 'Center
Caption = "S"
ForeColor = &H00808080&
Height = 252
Index = 18
Left = 6240
TabIndex = 22
Top = 4080
Width = 252
End
Begin VB.Label SessionLabel
Alignment = 2 'Center
Caption = "R"
ForeColor = &H00808080&
Height = 252
Index = 17
Left = 6000
TabIndex = 21
Top = 4080
Width = 252
End
Begin VB.Label SessionLabel
Alignment = 2 'Center
Caption = "Q"
ForeColor = &H00808080&
Height = 252
Index = 16
Left = 5760
TabIndex = 20
Top = 4080
Width = 252
End
Begin VB.Label SessionLabel
Alignment = 2 'Center
Caption = "P"
ForeColor = &H00808080&
Height = 252
Index = 15
Left = 5520
TabIndex = 19
Top = 4080
Width = 252
End
Begin VB.Label SessionLabel
Alignment = 2 'Center
Caption = "O"
ForeColor = &H00808080&
Height = 252
Index = 14
Left = 5280
TabIndex = 18
Top = 4080
Width = 252
End
Begin VB.Label SessionLabel
Alignment = 2 'Center
Caption = "N"
ForeColor = &H00808080&
Height = 252
Index = 13
Left = 5040
TabIndex = 17
Top = 4080
Width = 252
End
Begin VB.Label SessionLabel
Alignment = 2 'Center
Caption = "M"
ForeColor = &H00808080&
Height = 252
Index = 12
Left = 4800
TabIndex = 16
Top = 4080
Width = 252
End
Begin VB.Label SessionLabel
Alignment = 2 'Center
Caption = "L"
ForeColor = &H00808080&
Height = 252
Index = 11
Left = 4560
TabIndex = 15
Top = 4080
Width = 252
End
Begin VB.Label SessionLabel
Alignment = 2 'Center
Caption = "K"
ForeColor = &H00808080&
Height = 252
Index = 10
Left = 4320
TabIndex = 14
Top = 4080
Width = 252
End
Begin VB.Label SessionLabel
Alignment = 2 'Center
Caption = "J"
ForeColor = &H00808080&
Height = 252
Index = 9
Left = 4080
TabIndex = 13
Top = 4080
Width = 252
End
Begin VB.Label SessionLabel
Alignment = 2 'Center
Caption = "I"
ForeColor = &H00808080&
Height = 252
Index = 8
Left = 3840
TabIndex = 12
Top = 4080
Width = 252
End
Begin VB.Label SessionLabel
Alignment = 2 'Center
Caption = "H"
ForeColor = &H00808080&
Height = 252
Index = 7
Left = 3600
TabIndex = 11
Top = 4080
Width = 252
End
Begin VB.Label SessionLabel
Alignment = 2 'Center
Caption = "G"
ForeColor = &H00808080&
Height = 252
Index = 6
Left = 3360
TabIndex = 10
Top = 4080
Width = 252
End
Begin VB.Label SessionLabel
Alignment = 2 'Center
Caption = "F"
ForeColor = &H00808080&
Height = 252
Index = 5
Left = 3120
TabIndex = 9
Top = 4080
Width = 252
End
Begin VB.Label SessionLabel
Alignment = 2 'Center
Caption = "E"
ForeColor = &H00808080&
Height = 252
Index = 4
Left = 2880
TabIndex = 8
Top = 4080
Width = 252
End
Begin VB.Label SessionLabel
Alignment = 2 'Center
Caption = "D"
ForeColor = &H00808080&
Height = 252
Index = 3
Left = 2640
TabIndex = 7
Top = 4080
Width = 252
End
Begin VB.Label SessionLabel
Alignment = 2 'Center
Caption = "C"
ForeColor = &H00808080&
Height = 252
Index = 2
Left = 2400
TabIndex = 6
Top = 4080
Width = 252
End
Begin VB.Label SessionLabel
Alignment = 2 'Center
Caption = "B"
ForeColor = &H00808080&
Height = 252
Index = 1
Left = 2160
TabIndex = 5
Top = 4080
Width = 252
End
Begin VB.Label SessionLabel
Alignment = 2 'Center
Caption = "A"
ForeColor = &H00808080&
Height = 252
Index = 0
Left = 1920
TabIndex = 4
Top = 4080
Width = 252
End
Begin VB.Label Label2
Caption = "Inactive Session"
ForeColor = &H00808080&
Height = 252
Left = 360
TabIndex = 3
Top = 4200
Width = 1452
End
Begin VB.Label Label1
Caption = "Active Session"
ForeColor = &H000000FF&
Height = 252
Left = 360
TabIndex = 2
Top = 3960
Width = 1452
End
Begin MSComDlg.CommonDialog FileSaveAsCommonDialog
Left = 8040
Top = 0
_Version = 65536
_ExtentX = 677
_ExtentY = 677
_StockProps = 0
End
Begin VB.Menu MenuFile
Caption = "&File"
Begin VB.Menu MenuSave
Caption = "&Save Log As ..."
End
Begin VB.Menu MenuClear
Caption = "&Clear Log"
End
Begin VB.Menu MenuExit
Caption = "E&xit"
End
End
Begin VB.Menu MenuSysRequest
Caption = "&SysRequest"
Begin VB.Menu MenuSysFormats
Caption = "Get System &Formats"
End
Begin VB.Menu MenuSysStatus
Caption = "Get System &Status"
End
Begin VB.Menu MenuSysConfiguration
Caption = "Get System &Configuration"
End
Begin VB.Menu MenuSysSysItems
Caption = "Get System S&ysItems"
End
Begin VB.Menu MenuSysTopics
Caption = "Get System &Topics"
End
End
Begin VB.Menu MenuRequest
Caption = "&Request"
Begin VB.Menu MenuGetParPS
Caption = "&Get Partial PS"
End
Begin VB.Menu MenuFindField
Caption = "&Find Field"
End
Begin VB.Menu MenuGetOIA
Caption = "Get &OIA"
End
Begin VB.Menu MenuGetPS
Caption = "Get &PS"
End
Begin VB.Menu MenuGetSessStat
Caption = "Get &Session Status"
End
Begin VB.Menu MenuSearchforString
Caption = "Search for S&tring"
End
Begin VB.Menu MenuGetTrimRect
Caption = "Get Trim&Rect"
End
End
Begin VB.Menu MenuExecute
Caption = "&Execute"
Begin VB.Menu MenuExecuteWindow
Caption = "&Window"
End
Begin VB.Menu MenuExecuteSendkey
Caption = "&Sendkey"
End
Begin VB.Menu MenuExecuteKeylock
Caption = "&Keylock"
End
Begin VB.Menu MenuExecuteXfer
Caption = "&File Transfer"
End
Begin VB.Menu MenuExecuteWait
Caption = "W&ait"
End
End
Begin VB.Menu MenuPoke
Caption = "&Poke"
Begin VB.Menu MenuPutDataToPs
Caption = "&Put Data to PS"
End
Begin VB.Menu MenuSetCursorPosition
Caption = "&Set Cursor Position"
End
End
Begin VB.Menu MenuAdvise
Caption = "&Advise"
Begin VB.Menu MenuStartCloseIntercept
Caption = "Start &Close Intercept"
End
Begin VB.Menu MenuStartKeystrokeIntercept
Caption = "Start &Keystroke Intercept"
End
Begin VB.Menu MenuStartSessionAdvise
Caption = "Start &Session Advise"
Begin VB.Menu MenuAdvicePS
Caption = "&Presentation Space"
End
Begin VB.Menu MenuAdviseOIA
Caption = "&Operator Indicator Area"
End
Begin VB.Menu MenuAdviseTrimRect
Caption = "&Trim Rectangle"
End
End
Begin VB.Menu MenuStartMouseIntercept
Caption = "Start &Mouse Intercept"
End
End
End
Attribute VB_Name = "MainForm"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Dim NumberOfOpenForms As Boolean
Dim MainMinimumWidth As Long
Dim MainMinimumHeight As Long
Dim FunctionLogWidth As Long
Dim FunctionLogHeight As Long
Dim FunctionLogFrameWidth As Long
Dim FunctionLogFrameHeight As Long
Dim FunctionLogChanged As Boolean
Private Sub Form_Load()
NumberOfOpenForms = 0
LogTop = 0
LogEnd = 0
Loged = False
MSG_SAMPLE_PROG = "DDE TEST PROGRAM"
MSG_APPLICATION = "Application = "
MSG_TOPIC = "Topic = "
MSG_ITEM = "Item = "
MSG_FUNCTION_COMP = "Function was successful!"
MSG_DDE_ERROR = "An error has occurred in DDE Conversation"
MSG_PARA_ERROR = "You must set necessary parameters"
MSG_INVALID_DATA = "Invalid Data was returned"
MSG_OK = "OK"
MSG_NG = "Not Good"
MSG_INVALID_PSID = "Could not find session: "
' APPLICATION_NAME = "IBM327032"
MainMinimumWidth = Width
MainMinimumHeight = Height
FunctionLogWidth = FunctionLog.Width
FunctionLogHeight = FunctionLog.Height
FunctionLogFrameWidth = FunctionLogFrame.Width
FunctionLogFrameHeight = FunctionLogFrame.Height
FunctionLogChanged = False
For Counter = 0 To 25
SavedSessionInfo(Counter) = False
Next Counter
UpdateActiveSessionInfo
End Sub
Private Sub Host3270Option_Click()
End Sub
Private Sub Host5250Option_Click()
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
FunctionLog.Width = FunctionLogWidth + WidthDelta
FunctionLog.Height = FunctionLogHeight + HeightDelta
FunctionLogFrame.Width = FunctionLogFrameWidth + WidthDelta
FunctionLogFrame.Height = FunctionLogFrameHeight + HeightDelta
Refresh
End Sub
Private Sub FunctionLog_Change()
FunctionLogChanged = True
End Sub
Private Sub MenuAdvicePS_Click()
FormStartPSAdvise.Show 0
End Sub
Private Sub MenuAdviseOIA_Click()
FormStartOIAAdvise.Show 0
End Sub
Private Sub MenuAdviseTrimRect_Click()
FormStartTrimRectAdvise.Show 0
End Sub
Private Sub MenuClear_Click()
LogTop = 0
LogEnd = 0
FunctionLog.Text = ""
FunctionLogChanged = False
For i% = 0 To MAXLOGNUM
LogData$(i%) = ""
Next
Loged = False
End Sub
Private Sub MenuEnableLog_Click()
End Sub
Private Sub MenuExecuteKeylock_Click()
FormSessExMacroKeyboard.Show 0
End Sub
Private Sub MenuExecuteSendkey_Click()
FormSessExMacroSendKey.Show 1
If Loged = True Then
UpdateLog
End If
Unload FormSessExMacroSendKey
End Sub
Private Sub MenuExecuteWait_Click()
FormSessExMacroWait.Show 1
If Loged = True Then
UpdateLog
End If
Unload FormSessExMacroWait
End Sub
Private Sub MenuExecuteWindow_Click()
FormSessExMacroWin.Show 1
If Loged = True Then
UpdateLog
End If
Unload FormSessExMacroWin
End Sub
Private Sub MenuExecuteXfer_Click()
FormSessExMacroXfer.Show 1
If Loged = True Then
UpdateLog
End If
Unload FormSessExMacroXfer
End Sub
Private Sub MenuExit_Click()
End
End Sub
Private Sub MenuFindField_Click()
FormFindField.Show 1
If Loged = True Then
UpdateLog
End If
Unload FormFindField
End Sub
Private Sub MenuGetOIA_Click()
FormGetOIA.Show 1
If Loged = True Then
UpdateLog
End If
Unload FormGetOIA
End Sub
Private Sub MenuGetParPS_Click()
FormGetPartialPS.Show 1
If Loged = True Then
UpdateLog
End If
Unload FormGetPartialPS
End Sub
Private Sub MenuGetPS_Click()
FormGetPS.Show 1
If Loged = True Then
UpdateLog
End If
Unload FormGetPS
End Sub
Private Sub MenuGetSessStat_Click()
FormGetSessStatus.Show 1
If Loged = True Then
UpdateLog
End If
Unload FormGetSessStatus
End Sub
Private Sub MenuGetTrimRect_Click()
FormGetTrimRect.Show 1
If Loged = True Then
UpdateLog
End If
Unload FormGetTrimRect
End Sub
Private Sub MenuPutDataToPs_Click()
FormPutDataToPS.Show 1
If Loged = True Then
UpdateLog
End If
Unload FormPutDataToPS
End Sub
Private Sub MenuSave_Click()
SaveLog
End Sub
Private Sub MenuSearchforString_Click()
FormSearchForString.Show 1
If Loged = True Then
UpdateLog
End If
Unload FormSearchForString
End Sub
Private Sub MenuSetCursorPosition_Click()
FormSetCursorPosition.Show 1
If Loged = True Then
UpdateLog
End If
Unload FormSetCursorPosition
End Sub
Private Sub MenuStartCloseIntercept_Click()
FormStartCloseIntercept.Show 0
End Sub
Private Sub MenuStartKeystrokeIntercept_Click()
FormStartKeystrokeIntercept.Show 0
End Sub
Private Sub MenuStartMouseIntercept_Click()
FormStartMouseIntercept.Show 0
End Sub
Private Sub MenuSysConfiguration_Click()
FormGetSysConfiguration.Show 1
If Loged = True Then
UpdateLog
End If
Unload FormGetSysConfiguration
End Sub
Private Sub MenuSysFormats_Click()
FormGetSysFormats.Show 1
If Loged = True Then
UpdateLog
End If
Unload FormGetSysFormats
End Sub
Private Sub MenuSysStatus_Click()
FormGetSysStatus.Show 1
If Loged = True Then
UpdateLog
End If
Unload FormGetSysStatus
End Sub
Private Sub MenuSysSysItems_Click()
FormGetSysSysItems.Show 1
If Loged = True Then
UpdateLog
End If
Unload FormGetSysSysItems
End Sub
Private Sub MenuSysTopics_Click()
FormGetSysTopics.Show 1
If Loged = True Then
UpdateLog
End If
Unload FormGetSysTopics
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
FunctionLog.Text = temp$
Loged = False
End Sub
Private Sub SaveLog()
On Error GoTo SaveLogErrorHandler
FileSaveAsCommonDialog.Filter = "Log Files (*.log)|*.log|All Files (*.*)|*.*"
FileSaveAsCommonDialog.FilterIndex = 0
FileSaveAsCommonDialog.CancelError = True
FileSaveAsCommonDialog.Flags = cdlOFNOverwritePrompt Or cdlOFNHideReadOnly Or cdlOFNPathMustExist Or cdlOFNLongNames
FileSaveAsCommonDialog.ShowSave
MsgBox FileSaveAsCommonDialog.filename
FileNumber = FreeFile
Open FileSaveAsCommonDialog.filename For Output As #FileNumber
Print #FileNumber, FunctionLog.Text
Close #FileNumber
Exit Sub
SaveLogErrorHandler:
If Err = 32755 Then
' User Canceled Save As Dialog
Else
MsgBox "Error Number " & Err & " while saving Log."
End If
End Sub
Private Sub Test_Click()
SaveLog
End Sub
Private Function UpdateActiveSessionInfo()
Dim NewSessionInfo(26) As Boolean
UpdateSystemTopics
For Counter = 0 To 25
NewSessionInfo(Counter) = False
Next Counter
StartPos& = 1
Do While True
EndPos& = InStr(StartPos&, SystemTopicsText.Text, Chr$(9))
If EndPos& = 0 Then
temp$ = LTrim$(RTrim$(Mid$(SystemTopicsText.Text, StartPos&)))
If Mid$(temp$, 1, 7) = "Session" Then
PSID = Asc(Mid$(temp$, 8, 1)) - Asc("A")
NewSessionInfo(PSID) = True
End If
Exit Do
Else
temp$ = LTrim$(RTrim$(Mid$(SystemTopicsText.Text, StartPos&, EndPos& - StartPos&)))
If Mid$(temp$, 1, 7) = "Session" Then
PSID = Asc(Mid$(temp$, 8, 1)) - Asc("A")
NewSessionInfo(PSID) = True
End If
End If
StartPos& = EndPos& + 1
Loop
For Counter = 0 To 25
If SavedSessionInfo(Counter) <> NewSessionInfo(Counter) Then
If NewSessionInfo(Counter) = True Then
SessionLabel(Counter).ForeColor = &HFF&
Else
SessionLabel(Counter).ForeColor = &H808080
End If
SavedSessionInfo(Counter) = NewSessionInfo(Counter)
End If
Next Counter
End Function
Private Sub UpdateSystemTopics()
On Error GoTo ErrHandler
FunctionComp = True
SystemTopicsText.Text = ""
rc = DoEvents() 'If you use VisualBasic V2.0, call
'DoEvents function each time before
'starting DDE conversation.
SystemTopicsText.LinkTimeout = -1
SystemTopicsText.LinkTopic = "IBM327032|System"
SystemTopicsText.LinkMode = COLD
SystemTopicsText.LinkItem = "Topics"
SystemTopicsText.LinkRequest
SystemTopicsText.LinkMode = NONE
If FunctionComp = True Then
' Everything went well;
' atleast one Session is open but necessarily active.
Else
SystemTopicsText.Text = ""
End If
Exit Sub
ErrHandler:
FunctionComp = False
Resume Next
End Sub
Private Sub SessionLabelA_Click(Index As Integer)
End Sub
Private Sub SessionUpdateTimer_Timer()
UpdateActiveSessionInfo
End Sub
Private Sub Text1_Change()
End Sub