This is a stripped down and working code example to logon into a TSO session on an IBM mainframe via Telnet:
Code: Select all
; Example code to logon into TSO on an IBM Mainframe via Telnet
; ----- Change these settings to those of your mainframe account
#AccountNumber = "Your account number"
#Password = "Your password"
#ServerIPAddress = "Your mainframe IP"
#StartProcedure = "Name of your TSO start procedure"
#UserID = "Your mainframe UserID"
; --------------------------------------------------------------
#Cmd_WILL = 251
#Cmd_WONT = 252
#Cmd_DO = 253
#Cmd_DONT = 254
#Cmd_IAC = 255
#CmdList = "WILLWONTDO DONT"
#DataBufferSize = 4096
#ServerPort = 23
#TimeOutSeconds = 10
Enumeration
#Logoff
#Logon
EndEnumeration
ClientReply.S
CmdOptionMax.B
ConnectionID.L
i.W
OptionName.S
ServerReply.S
ServerReplyLength.L
StartTimeWaiting.L
StatusFlag.W
Declare.W ParseServerReply(ReplyLength.L)
Declare ParseServerMsg(Msg.S)
Declare SendStringToServer(String.S)
Repeat
Read OptionName
If OptionName = #EOT$
CmdOptionMax = i
Break
Else
i = i + 1
EndIf
ForEver
Global Dim OptionName.S(CmdOptionMax)
Restore TelnetOptions
For i = 0 To 49
Read OptionName(i)
Next i
StatusFlag = #Logon
If InitNetwork() = #False
MessageRequester("Error", "Initialization of network failed!", #MB_ICONERROR)
End
EndIf
*DataBuffer = AllocateMemory(#DataBufferSize)
If *DataBuffer = 0
MessageRequester("Error", "Allocation of memory buffer failed!", #MB_ICONERROR)
End
EndIf
ConnectionID = OpenNetworkConnection(#ServerIPAddress, #ServerPort)
If ConnectionID = 0
MessageRequester("Error", "Connection setup to mainframe failed!", #MB_ICONERROR)
End
EndIf
ClientReply = ""
ServerReply = ""
StartTimeWaiting = ElapsedMilliseconds()
Repeat
Select NetworkClientEvent(ConnectionID)
Case 2
ServerReplyLength = ReceiveNetworkData(ConnectionID, *DataBuffer, #DataBufferSize)
For i = 0 To ServerReplyLength - 1
ServerReply = ServerReply + Str(PeekB(*DataBuffer + i)) + " "
Next i
If ServerReplyLength = #DataBufferSize
Debug "The buffer size of " + Str(#DataBufferSize) + " bytes was too small for message received from server!"
Break
EndIf
If ParseServerReply(ServerReplyLength) = #False
Break
EndIf
StartTimeWaiting = ElapsedMilliseconds()
EndSelect
If StatusFlag = #Logoff
SendStringToServer("LOGOFF")
Debug "C: LOGOFF"
Break
EndIf
If ElapsedMilliseconds() - StartTimeWaiting >= #TimeoutSeconds * 1000
MessageRequester("Error", "Timeout during wait for server reply!", #MB_ICONERROR)
Break
EndIf
ForEver
CloseNetworkConnection(ConnectionID)
End
DataSection
TelnetOptions:
Data.S "Binary Transmission"
Data.S "Echo"
Data.S "Reconnection"
Data.S "Suppress Go Ahead"
Data.S "Approx Message Size Negotiation"
Data.S "Status"
Data.S "Timing Mark"
Data.S "Remote Controlled Trans And Echo"
Data.S "Output Line Width"
Data.S "Output Page Size"
Data.S "Output Carriage-Return Disposition"
Data.S "Output Horizontal Tab Stops"
Data.S "Output Horizontal Tab Disposition"
Data.S "Output Formfeed Disposition"
Data.S "Output Vertical Tabstops"
Data.S "Output Vertical Tab Disposition"
Data.S "Output Linefeed Disposition"
Data.S "Extended ASCII"
Data.S "Logout"
Data.S "Byte Macro"
Data.S "Data Entry Terminal"
Data.S "SUPDUP"
Data.S "SUPDUP Output"
Data.S "Send Location"
Data.S "Terminal Type"
Data.S "End of Record"
Data.S "TACACS User Indentification"
Data.S "Output Marking"
Data.S "Terminate Location Number"
Data.S "Telnet 3270 Regime"
Data.S "X.3 PAD"
Data.S "Negotiate About Window Size"
Data.S "Terminal Speed"
Data.S "Remote Flow Control"
Data.S "Linemode"
Data.S "X Display Location"
Data.S "Telnet Environment Option"
Data.S "Telnet Authentication Option"
Data.S "Telnet Encryption Option"
Data.S "Telnet Environment Option"
Data.S "TN3270E"
Data.S "XAUTH"
Data.S "CHARSET"
Data.S "Telnet Remote Serial Port"
Data.S "Com Port Control Option"
Data.S "Telnet Suppress Local Echo"
Data.S "Telnet Start TLS"
Data.S "Kermit"
Data.S "Send URL"
Data.S "FORWARD_X"
Data.S #EOT$
EndDataSection
Procedure.W ParseServerReply(ServerReplyLength.L)
Shared ClientReply.S
Shared CmdOptionMax.B
Shared ConnectionID.L
Shared *DataBuffer
Static CharPtr.L
CmdID.B
CmdName.S
CmdOption.B
CmdOptionName.S
Msg.S
CharPtr = 0
Repeat
Select StrU(PeekB(*DataBuffer + CharPtr), #Byte)
Case StrU(#Cmd_IAC, #Byte)
CmdID = PeekB(*DataBuffer + CharPtr + 1)
If StrU(CmdID, #Byte) >= StrU(#Cmd_WILL, #Byte)
CmdName = Trim(Mid(#CmdList, (5 + CmdID) * 4 + 1, 4))
CmdOption = PeekB(*DataBuffer + CharPtr + 2)
If Val(StrU(CmdOption, #Byte)) <= Val(StrU(CmdOptionMax, #Byte))
CmdOptionName = " '" + OptionName(CmdOption) + "'"
Else
If StrU(CmdOption, #Byte) = "255"
CmdOptionName = " 'Extended Option List'"
Else
CmdOptionName = " " + StrU(CmdOption, #Byte)
EndIf
EndIf
Debug "S: " + CmdName + CmdOptionName
If CmdName = "DO"
PokeB(*DataBuffer, #Cmd_IAC)
PokeB(*DataBuffer + 1, #Cmd_WONT)
PokeB(*DataBuffer + 2, CmdOption)
If SendNetworkData(ConnectionID, *DataBuffer, 3) = -1
Debug "Telnet server didn't accept command!"
ProcedureReturn #False
EndIf
Debug "C: WONT" + CmdOptionName
EndIf
CharPtr = CharPtr + 3
EndIf
Default
Msg = ""
While PeekB(*DataBuffer + CharPtr) <> #CR And PeekB(*DataBuffer + CharPtr + 1) <> #LF
Msg = Msg + Chr(PeekB(*DataBuffer + CharPtr))
CharPtr = CharPtr + 1
Wend
CharPtr = CharPtr + 2
If Left(Msg, 2) = #CRLF$
Msg = Mid(Msg, 3, 1)
EndIf
If Msg <> ""
Debug "S: " + Msg
ParseServerMsg(Msg)
EndIf
EndSelect
Until CharPtr >= ServerReplyLength
If ClientReply <> ""
Debug ClientReply
ClientReply = ""
EndIf
ProcedureReturn #True
EndProcedure
Procedure SendStringToServer(String.S)
Shared ConnectionID.L
Shared *DataBuffer
PokeS(*DataBuffer, String)
PokeB(*DataBuffer + Len(String), #LF)
PokeB(*DataBuffer + Len(String) + 1, #CR)
SendNetworkData(ConnectionID, *DataBuffer, Len(String) + 2)
EndProcedure
Procedure ParseServerMsg(Msg.S)
Shared ClientReply.S
Shared *DataBuffer
Shared StatusFlag.W
If FindString(UCase(Msg), "ENTER USERID", 1) > 0
If StatusFlag <> #Logoff
SendStringToServer(#UserID)
Debug "C: " + #UserID
EndIf
ElseIf FindString(UCase(Msg), "ENTER CURRENT PASSWORD", 1) > 0
SendStringToServer(#Password)
Debug "C: " + LSet("", Len(#Password), "*")
ElseIf FindString(UCase(Msg), "PASSWORD NOT AUTHORIZED FOR USERID", 1) > 0
StatusFlag = #Logoff
Debug "Vour Password is invalid!"
ElseIf FindString(UCase(Msg), "ALREADY LOGGED ON TO SYSTEM", 1) > 0
StatusFlag = #Logoff
Debug "Your UserID " + #UserID + " is alredy logged on!"
ElseIf FindString(UCase(Msg), "ENTER ACCOUNT NUMBER", 1) > 0
SendStringToServer(#AccountNumber)
Debug "C: " + #AccountNumber
ElseIf FindString(UCase(Msg), "ENTER PROCEDURE NAME", 1) > 0
SendStringToServer(#StartProcedure)
Debug "C: " + #StartProcedure
ElseIf FindString(UCase(Msg), "UNABLE TO LOCATE USER", 1) > 0
Debug "Your User-ID " + #UserID + " is not defined on the mainframe!"
ElseIf FindString(UCase(Msg), "READY", 1) > 0
If StatusFlag = #Logon
StatusFlag = #Logoff
MessageRequester("Info", "You are succesfully logged on to the mainframe" + #CR$ + #CR$ + "Are you ready to logoff?", #MB_ICONINFORMATION)
EndIf
EndIf
EndProcedure