www.pudn.com > source.rar > 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