modtelnet.bas

这是书上的代码

Attribute VB_Name = "modTelnet"
Option Explicit
'------------------------------------------
Private Const F_IAC = 255      'Telnet命令首字符
Private Const F_DO = 253       'DO协商
Private Const F_DONT = 254     'DO NOT协商
Private Const F_WILL = 251     'WILL 协商
Private Const F_WONT = 252     'WILL NOT协商
Private Const F_GOAHEAD = 3
Private Const F_ECHO = 1
'-------------------------------
Private Const TELNET_PORT = 23   'Telnet默认端口


'----------------------------------------------------
Dim blnSendLogin As Boolean       '是否发送Login注册用户名
Dim blnSendPassword As Boolean    '是否发送Login注册用户密码


'==========================================
' WinSock控件初始化
'==========================================
Public Sub InitTelnetWinSock(ByVal sckTelnet As Winsock, _
                             ByVal strRemoteHostIP As String)
With sckTelnet
    .RemoteHost = strRemoteHostIP
    .RemotePort = TELNET_PORT
End With
blnSendLogin = False
blnSendPassword = False
End Sub


'===========================================
'
' 远程登录 Unix ,成功返回True
'
' 参数说明：
'   sckTelnet   远程登录时使用的WinSock控件名
'   strUserName   远程登录UNIX系统时的用户名
'   strPassword   远程登录UNIX系统时的密码
'   byteSckReceiveBuf()  WinSock接收到的字符串
'
'===========================================
Public Function RemoteLogin(ByVal sckTelnet As Winsock, _
                            ByVal strUserName As String, _
                            ByVal strPassword As String, _
                            ByRef byteSckReceiveBuf() As Byte) As Boolean

Dim byteReply(2) As Byte     '客户端回复Telnet协议命令
Dim strMtp As String         '客户端注册、执行命令
Dim strReply As String       '
Dim byteCh As Byte
Dim byteCmd As Byte
Dim byteNOpt As Byte
Dim lngCursor As Long
Dim intTp As Integer
Dim blnRst As Boolean
Dim lngLenBuf As Long

blnRst = False
lngCursor = 0
strMtp = ""
lngLenBuf = UBound(byteSckReceiveBuf)
While lngCursor < lngLenBuf
    byteCh = byteSckReceiveBuf(lngCursor)
    If byteCh = F_IAC Then
        lngCursor = lngCursor + 1
        byteCmd = byteSckReceiveBuf(lngCursor)
        If ((byteCmd = F_DO) Or (byteCmd = F_WILL) Or (byteCmd = F_DONT) Or (byteCmd = F_WONT)) Then
            lngCursor = lngCursor + 1
            byteNOpt = byteSckReceiveBuf(lngCursor)
            byteReply(0) = F_IAC
            byteReply(2) = byteNOpt
            If byteNOpt = F_GOAHEAD Or byteNOpt = F_ECHO Then
                If byteCmd = F_DO Then byteReply(1) = F_WILL
                If byteCmd = F_WILL Then byteReply(1) = F_DO
            Else
                Select Case byteCmd
                    Case F_DO
                        byteReply(1) = F_WONT
                    Case F_WILL
                        byteReply(1) = F_DONT
                    Case F_DONT
                        byteReply(1) = F_DONT
                    Case F_WONT
                        byteReply(1) = F_WONT
                End Select
            End If
            sckTelnet.SendData byteReply
        End If
    Else
       strMtp = strMtp + Chr(byteCh)
    End If
    lngCursor = lngCursor + 1
Wend
If Len(strMtp) > 0 Then     '主机传回要在客户端Telnet终端上显示的字符文本
    While InStr(1, strMtp, "login:", vbTextCompare) > 0 And Not blnSendLogin
         strReply = strUserName + vbCrLf
         sckTelnet.SendData strReply     '发送注册用户名
         blnSendLogin = True
    Wend
    While InStr(1, strMtp, "password:", vbTextCompare) > 0 And Not blnSendPassword
         strReply = strPassword + vbCrLf
         sckTelnet.SendData strReply     '发送注册用户密码
         blnSendPassword = True
    Wend
    
    '最下行有"Last login:"字符串
    If InStr(1, strMtp, "Last login:", vbTextCompare) > 0 Then blnRst = True
End If
RemoteLogin = blnRst
End Function

'=====================================
' 远程执行 Unix 命令,成功返回True
'=====================================
Public Function RemoteExeUnixCommand(ByVal sckTelnet As Winsock, _
                                ByVal strUnixCommand As String) As Boolean
Dim strReply As String
    strReply = strUnixCommand + vbCrLf    '执行命令
    On Error GoTo ERR
    sckTelnet.SendData strReply
    DoEvents
    RemoteExeUnixCommand = True
    Exit Function
ERR:
    RemoteExeUnixCommand = False
End Function