Dim MySession As Reflection.Session 'This object is used throughout the whole class
Private Sub Class_Initialize()
Set MySession = CreateObject("ReflectionIBM.Session")
End Sub
Private Sub Class_Terminate()
Set MySession = Nothing
End Sub
Public Sub Connect()
MySession.Visible = True
MySession.OpenSettings 1, "C:\Documents and Settings\sshahzad\Desktop\Reflection.rsf" 'Change this to your settingsfile
If MySession.Connected = False Then MySession.Connect
End Sub
'---------------------------------------------------------------------------------------
' Procedure : TransmitText
' Author : Morten Broberg Kristensen
' Date : 17.01.2011
' Purpose : Send text to the host, either to a specified location or to where the
' cursor might be. Optional TextLength, and also it will truncate to fieldlen
'---------------------------------------------------------------------------------------
Public Function TransmitText(ByVal text As String, Optional Row As Long, Optional Column As Long, Optional TextLength As Long)
Dim fieldLen As Long
On Error GoTo TransmitText_Error
If Not Row = 0 Then 'If we give it a row then first move the cursor!
MySession.MoveCursor Row, Column
MySession.WaitForEvent rcKbdEnabled, "30", "0", 1, 1 'Wait 30 sec for keyboard or time out
MySession.TransmitTerminalKey rcIBMEraseEOFKey 'Clear field
MySession.WaitForEvent rcKbdEnabled, "30", "0", 1, 1 'Wait 30 sec for keyboard or time out
End If
MySession.FindField CursorRow, CursorColumn, rcCurrent, rcAnyField 'Find any field in current field specified by cursorrow and cursorcol and set the properties
fieldLen = MySession.FoundFieldLength 'Get the foundfieldlength property and use that as amount of chars to retrieve, ie. the full length of the field.
If Not TextLength = 0 Then 'If textlengh is set then
text = VBA.Left$(text, Min(TextLength, fieldLen)) 'Truncate text by the lesser of the lengths
Else
text = VBA.Left$(text, fieldLen) 'If textlength is not set then truncate by fieldlength
End If
'And then just send the text
MySession.TransmitANSI text
MySession.WaitForEvent rcKbdEnabled, "30", "0", 1, 1 'Wait 30 sec for
keyboard or time out
On Error GoTo 0
Exit Function
TransmitText_Error:
Err.Raise Err.Number, "@[Parser.TransmitText] " & Err.Source, Err.Description
End Function
Public Function Min(ByVal num1 As Variant, ByVal num2 As Variant) As Variant
On Error GoTo ErrHandler:
If num1 < num2 Then
Min = num1
Else
Min = num2
End If
Exit Function
ErrHandler:
Debug.Print "Sommat went wrong"
End Function
'---------------------------------------------------------------------------------------
' Procedure : SendTerminalKey
' Author : Morten Broberg Kristensen
' Date : 15.09.2010
' Purpose : Will try to send the corresponding rc terminalkey
'---------------------------------------------------------------------------------------
Public Function SendTerminalKey(ByVal k As Long) As Boolean
On Error GoTo SendTerminalKey_Error
MySession.TransmitTerminalKey k
MySession.WaitForEvent rcKbdEnabled, "30", "0", 1, 1 'Try to wait for enabled keyboard before we continue
' The code outcommented below is just used internally in my code to count amount of transaction used, and the up'n'down keys are "free" on my system
' Select Case k
' Case rcIBMPf7Key
'
' Case rcIBMPf8Key
'
' Case Else
' Transactions = Transactions + 1 'increment the trans-counter
' End Select
On Error GoTo 0
Exit Function
SendTerminalKey_Error:
Err.Raise Err.Number, "@[Parser.SendTerminalKey] " & Err.Source, Err.Description
End Function
