PureBasic Forums - English

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