VB クライアントから Linux サーバーへの telnet ログインするには? (ID:89970)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

ソース2個目です

↓↓↓↓ ソース2 ↓↓↓↓
'***********************************************************
'** TCP 通信 エラー 用
'***********************************************************
Private Sub tcpClient_Error(ByVal Number As Integer, Description As String, _
                            ByVal Scode As Long, ByVal Source As String, _
                            ByVal HelpFile As String, ByVal HelpContext As Long, _
                            CancelDisplay As Boolean)
    CancelDisplay = True
    Call ErrorReport(ERROR_IVENT_ARRISEN, Number, Description)
End Sub

'*******************************************************************
'** TCP 通信 : Telent ネゴシエートコマンドを受信する
'** argCnt = -1 : 受信済のものすべてを読み込む
'** argCnt <>-1 : 指定バイトだけ読み込む
'*******************************************************************
Private Function TelnetGetData(ByRef argStr As String, ByVal argCnt As Long)
On Error Resume Next
    Dim bytTmp()    As Byte
    Dim intIndex    As Integer

If argCnt = -1 Then
        Call Me.tcpClient.GetData(bytTmp, vbByte + vbArray)
    Else
        Call Me.tcpClient.GetData(bytTmp, vbByte + vbArray, argCnt)
    End If

Call HexConvStr(bytTmp, argStr)

End Function

'***********************************************************
'** TCP 通信 : Telent ネゴシエートコマンドを送信する
'***********************************************************
Private Sub TelnetNego()
On Error GoTo ErrorHandler
    Dim bytNego(128)    As Byte
    Dim strNego         As String

strNego = "FFFB18FFFD03FFFB03FFFD01FFFB1F" ' telnet ネゴシエートコマンド
    Call StrConvHex(strNego, bytNego)
    Call tcpClient.SendData(bytNego)

Exit Sub
ErrorHandler:
    Call ErrorReport(ERROR_TRAPPED, Err.Number, Err.Description)
End Sub

'***********************************************************
'** TCP 通信 : Telent ネゴシエートコマンドを１個ずつ読む
'***********************************************************
Private Function TelnetReadCmd() As String
On Error GoTo ErrorHandler
    Dim bytTmp(2)   As Byte
    Dim intRc       As Integer
    Dim strCmd      As String
    Dim strTmp      As String
    Dim intIndex    As Integer

TelnetReadCmd = ""
    mStrCmd = ""
    While Len(mStrCmd) < 6    '** mStrCmd はグローバル変数
        intRc = TelnetGetData(strTmp, 3) '** 16進モード
        If intRc <> 0 Then
            Exit Function
        End If
        If Len(strTmp) <= 0 Then
            Exit Function
        End If
        mStrCmd = mStrCmd & strTmp
    Wend
    strTmp = Mid(mStrCmd, 1, 4)
    If strTmp = "FFFB" Or strTmp = "FFFD" Or strTmp = "FFFE" Then ' FFxxxx
        TelnetReadCmd = Mid(mStrCmd, 1, 6)
        Exit Function
    End If
    If strTmp = "FFFA" Then  ' SB 可変長。SE(FFF0) までがコマンド
        While InStr(mStrCmd, "FFF0") <= 0
            intRc = TelnetGetData(strTmp, -1) ' 16進モード
            If intRc <> 0 Then
                Exit Function
            End If
            mStrCmd = mStrCmd & CStr(bytTmp)
        Wend
        intIndex = InStr(mStrCmd, "FFF0")
        TelnetReadCmd = Mid(mStrCmd, 1, intIndex + 3)
        mStrCmd = Mid(mStrCmd, intIndex + 4)
    End If

Exit Function

ErrorHandler:
    Call ErrorReport(ERROR_TRAPPED, Err.Number, Err.Description)
End Function

'***********************************************************
'** TCP 通信 :
'** Telent ネゴシエートコマンドを１個ずつ読む
'** および、対応した データを送信する
'***********************************************************
Private Sub TelnetRecvData()
On Error GoTo ErrorHandler
    Dim strCmd      As String
    Dim strTmp      As String
    Dim bytCmd(128) As Byte

Do While 1  ' telnet ネゴシエート開始
        strCmd = TelnetReadCmd()  ' 16進モードでコマンドを受信
        Select Case strCmd
            Case "FFFD20", "FFFD23", "FFFD27", "FFFD24", "FFFE23", "FFFE27", "FFFE24", "FFFD01", "FFFD21"
                Call StrConvHex("FFFC" & Mid(strCmd, 5), bytCmd)
                Call tcpClient.SendData(bytCmd)
            Case "FFFB01"
                Call StrConvHex("FFFC" & Mid(strCmd, 5), bytCmd)
                Call tcpClient.SendData(bytCmd)
            Case "FFFB03"
                Call StrConvHex("FFFC" & Mid(strCmd, 5), bytCmd)
                Call tcpClient.SendData(bytCmd)
            Case "FFFB05"
                Call StrConvHex("FFFE" & Mid(strCmd, 5), bytCmd)
                Call tcpClient.SendData(bytCmd)
            Case "FFFD1F"  ' IAC SB Window
                Call StrConvHex("FFFA1F00500018FFF0", bytCmd)
                Call tcpClient.SendData(bytCmd)   ' window size  80x24
                'Call StrConvHex("FFFA1F00840020FFF0", bytCmd)
                'Call tcpClient.SendData(bytCmd)   ' window size  132x32
            Case "FFFA18"  ' IAC SB Terminal-Type
                Call StrConvHex("FFFA18007674313030FFF0", bytCmd)
                Call tcpClient.SendData(bytCmd)   ' IAC SB Terminal-Type vt100
            Case ""  ' コマンド終了
                Exit Do
        End Select
    Loop

Exit Sub

ErrorHandler:
    Call ErrorReport(ERROR_TRAPPED, Err.Number, Err.Description)
End Sub

'***********************************************************
'** TCP 通信 用 Hex => 文字列 変換
'***********************************************************
Private Sub HexConvStr(ByRef argByt() As Byte, ByRef argStr As String)
    Dim strTmp      As String
    Dim intIndex    As Integer

intIndex = 0
    While intIndex <= UBound(argByt)
        If Len(Hex(argByt(intIndex))) < 2 Then
            strTmp = strTmp & "0" & Hex(argByt(intIndex))
        Else
            strTmp = strTmp & Hex(argByt(intIndex))
        End If
        intIndex = intIndex + 1
    Wend

argStr = strTmp
End Sub

'***********************************************************
'** TCP 通信 用 文字列 => Hex 変換
'***********************************************************
Private Sub StrConvHex(ByVal argStr As String, ByRef argByt() As Byte)
    Dim strTmp      As String
    Dim intIndex    As Integer
    Dim intLen      As Integer
    Dim bytTmp      As Byte
    
    intIndex = 1
    intLen = 0
    While intIndex < Len(argStr)
        strTmp = Mid(argStr, intIndex, 2)
        bytTmp = CLng("&H" & strTmp)
        argByt(intLen) = bytTmp
        intLen = intLen + 1
        intIndex = intIndex + 2
    Wend
End Sub

←解決時は質問者本人がここをチェックしてください。

戻る

VB クライアント から Linux サーバー への telnet ログインするには? (ID:89970)

VB クライアントから Linux サーバーへの telnet ログインするには? (ID:89970)