我有TELNET的VB源代程，如下：其中SECOND FORM、MAIN FORM等是注解
Second form
Option Explicit
Private Sub Check1_Click()
If Check1.Value = 1 Then
frmTelnet.TraceTelnet = True
frmTelnet.Tracevt100 = True
Else
frmTelnet.TraceTelnet = False
frmTelnet.Tracevt100 = False
End If
End Sub
Private Sub cmdOKCancel_Click(Index As Integer)
On Error Resume Next
Select Case Index
Case 0
frmTelnet.WinsockClient.Close
frmTelnet.WinsockClient.LocalPort = 0
frmTelnet.RemoteIPAd = txtRemoteAddress
frmTelnet.RemotePort = txtPort
frmTelnet.WinsockClient.RemotePort = txtPort
frmTelnet.WinsockClient.RemoteHost = txtRemoteAddress
If Err > 0 Then
MsgBox Error
Else
Unload Me
End If
Case 1
Unload Me
End Select
End Sub
Private Sub Form_Load()
txtRemoteAddress = frmTelnet.RemoteIPAd
txtPort = frmTelnet.RemotePort
Check1.Value = -(frmTelnet.TraceTelnet)
End Sub
Main form
Option Explicit
Const GO_norM = 0
Const GO_ESC1 = 1
Const GO_ESC2 = 2
Const GO_ESC3 = 3
Const GO_ESC4 = 4
Const GO_ESC5 = 5
Const GO_IAC1 = 6
Const GO_IAC2 = 7
Const GO_IAC3 = 8
Const GO_IAC4 = 9
Const GO_IAC5 = 10
Const GO_IAC6 = 11
Const SUSP = 237
Const ABORT = 238 'Abort
Const SE = 240 'End of Subnegotiation
Const nop = 241
Const DM = 242 'Data Mark
Const BREAK = 243 'BREAK
Const IP = 244 'Interrupt Process
Const AO = 245 'Abort Output
Const AYT = 246 'Are you there
Const EC = 247 'Erase character
Const EL = 248 'Erase Line
Const GOAHEAD = 249 'Go Ahead
Const SB = 250 'What follows is subnegotiation
Const WILLTEL = 251
Const WONTTEL = 252
Const DOTEL = 253
Const DONTTEL = 254
Const IAC = 255
Const BINARY = 0
Const ECHO = 1
Const RECONNECT = 2
Const SGA = 3
Const AMSN = 4
Const STATUS = 5
Const TIMING = 6
Const RCTAN = 7
Const OLW = 8
Const OPS = 9
Const OCRD = 10
Const OHTS = 11
Const OHTD = 12
Const OFFD = 13
Const OVTS = 14
Const OVTD = 15
Const OLFD = 16
Const XASCII = 17
Const logoUT = 18
Const BYTEM = 19
Const DET = 20
Const SUPDUP = 21
Const SUPDUPOUT = 22
Const SENDLOC = 23
Const TERMTYPE = 24
Const EOR = 25
Const TACACSUID = 26
Const OUTPUTMARK = 27
Const TErmlOCNUM = 28
Const REGIME3270 = 29
Const X3PAD = 30
Const NAWS = 31
Const TERMSPEED = 32
Const TFLOWCNTRL = 33
Const LINEMODE = 34
Const disPLOC = 35
Const ENVIRON = 36
Const AUTHENTICATION = 37
Const UNKNowN39 = 39
Const EXTENDED_OPTIONS_LIST = 255
Const RANDOM_LOSE = 256
'------------------------------------------------------------
Private Operating As Boolean
Private Connected As Boolean
Public Receiving As Boolean
Private parsedata(10) As Integer
Private ppno As Integer
Private control_on As Boolean
Public RemoteIPAd As String
Public RemotePort As Integer
Public TraceTelnet As Boolean
Public Tracevt100 As Boolean
Private sw_ugoahead As Boolean
Private sw_igoahead As Boolean
Private sw_echo As Boolean
Private sw_linemode As Boolean
Private sw_termsent As Boolean
Private substate As Boolean
Private Sub cursor_timer_Timer()
If Not Receiving Then
' Debug.Print "Timer"
term_DriveCursor
End If
End Sub
Private Sub Form_KeyDown(KeyCode As Integer,Shift As Integer)
Dim CH As String
CH = Chr$(0)
'Translate keycodes to VT100 escape sequences
Select Case KeyCode
Case vbKeyControl
control_on = True
Case vbKeyEnd
CH = Chr$(27) + "[K"
Case vbKeyHome
CH = Chr$(27) + "[H"
Case vbKeyLeft
CH = Chr$(27) + "[D"
Case vbKeyUp
CH = Chr$(27) + "[A"
Case vbKeyRight
CH = Chr$(27) + "[C"
Case vbKeyDown
CH = Chr$(27) + "[B"
Case vbKeyF1
CH = Chr$(27) + "OP"
Case vbKeyF2
CH = Chr$(27) + "OQ"
Case vbKeyF3
CH = Chr$(27) + "OR"
Case vbKeyF4
CH = Chr$(27) + "OS"
Case Else
If control_on And KeyCode > 63 Then
CH = Chr$(KeyCode - 64)
End If
End Select
If CH > Chr$(0) And Connected Then
WinsockClient.SendData CH
If TraceTelnet Then Debug.Print CH
End If
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
Dim CH As String
If Connected Then
CH = Chr$(KeyAscii)
If control_on Then
If KeyAscii > 63 Then
CH = Chr$(KeyAscii - 64)
Else
CH = Chr$(0)
End If
End If
If CH > Chr$(0) Then
If CH = Chr$(13) Then
CH = CH & Chr$(10)
End If
WinsockClient.SendData CH
End If
End If
End Sub
Private Sub Form_KeyUp(KeyCode As Integer,Shift As Integer)
Select Case KeyCode
Case vbKeyControl
control_on = False
End Select
End Sub
Private Sub Form_Load()
RemoteIPAd = "fastlane.net"
RemotePort = 23
stbStatusBar.Panels(2).Text = WinsockClient.LocalIP
term_init
End Sub
Private Sub Form_Paint()
term_redrawscreen
End Sub
Private Sub Form_QueryUnload(Cancel As Integer,UnloadMode As Integer)
With WinsockClient
.Close ' Clear any errors...
.RemoteHost = "0.0.0.0"
.RemotePort = 0
End With
Operating = False
Connected = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
End ' End program forcefully
End Sub
Private Sub mClose_Click()
WinsockClient_Close
End Sub
Private Sub mExit_Click()
End
End Sub
Private Sub mOpen_Click()
On Error Resume Next ' Handle errors...
'------------------------------------------------------------
If Not Operating Then
Operating = True
If TraceTelnet Then Debug.Print Int(Timer) & " - [DoConnect] : " & vbCrLf
With WinsockClient
If .State <> 0 Then
.Close
.RemotePort = 0
.LocalPortPort = 0
Do
Loop Until .State = 0
End If
.RemoteHost = RemoteIPAd
.RemotePort = RemotePort
.Connect ' Attempt new connection
term_init
frmTelnet.stbStatusBar.Panels(4).Text = "Connecting to Remote Host"
End With
End If
End Sub
Private Sub mSettings_Click()
frmTCPIP.Show vbModal,frmTelnet
End Sub
Private Sub WinsockClient_Close()
frmTelnet.stbStatusBar.Panels(1).Text = "Closed"
frmTelnet.stbStatusBar.Panels(3).Text = WinsockClient.LocalIP
frmTelnet.stbStatusBar.Panels(2).Text = ""
frmTelnet.stbStatusBar.Panels(4).Text = "Connection Reset"
If TraceTelnet Then Debug.Print Int(Timer) & " - [Closed ] : Connection Reset By Peer "
With WinsockClient
.Close ' Clear any errors...
.RemotePort = 0
.LocalPort = 0
End With
Operating = False
Connected = False
End Sub
Private Sub WinsockClient_Connect()
Dim ConnectString As String
'------------------------------------------------------------
If TraceTelnet Then Debug.Print Int(Timer) & " - [Connect] : " & _
"[" & WinsockClient.RemoteHost & "] " & _
"[" & WinsockClient.RemoteHostIP & "] " & _
"[" & CStr(WinsockClient.RemotePort) & "]" ' display connection info
sw_ugoahead = True
sw_igoahead = False
sw_echo = True
sw_linemode = False
sw_termsent = False
substate = False
ConnectString = Chr$(IAC) & Chr$(DOTEL) & Chr$(ECHO) _
& Chr$(IAC) & Chr$(DOTEL) & Chr$(SGA) _
& Chr$(IAC) & Chr$(WILLTEL) & Chr$(NAWS) _
& Chr$(IAC) & Chr$(WILLTEL) & Chr$(TERMTYPE) _
& Chr$(IAC) & Chr$(WILLTEL) & Chr$(TERMSPEED)
WinsockClient.SendData ConnectString
If TraceTelnet Then Debug.Print "SENT: DOTEL ECHO SGA"
If TraceTelnet Then Debug.Print "SENT: WILL NAWS TERMTYPE TERMSPEED"
Connected = True
frmTelnet.stbStatusBar.Panels(1).Text = "Connected"
frmTelnet.stbStatusBar.Panels(3).Text = WinsockClient.LocalIP
frmTelnet.stbStatusBar.Panels(2).Text = WinsockClient.RemoteHostIP
frmTelnet.stbStatusBar.Panels(4).Text = "Connection Accepted By Remote Host"
End Sub
Private Sub WinsockClient_DataArrival(ByVal bytesTotal As Long)
Dim CH() As Byte
Dim test() As Integer
Dim I As Integer
Static cmd As Byte
'------------------------------------------------------------
If Not Receiving Then
Receiving = True
term_CaretControl True
Else
Exit Sub
End If
If (bytesTotal > 0) Then ' If there is any data...
WinsockClient.GetData CH,vbByte + vbArray,bytesTotal
' CH = Buf
For I = 0 To bytesTotal - 1
Select Case cmd
Case GO_norM
cmd = term_process_char(CH(I))
Case GO_IAC1
cmd = iac1(CH(I))
Case GO_IAC2
cmd = iac2(CH(I))
Case GO_IAC3
cmd = iac3(CH(I))
Case GO_IAC4
cmd = iac4(CH(I))
Case GO_IAC5
cmd = iac5(CH(I))
Case GO_IAC6
cmd = iac6(CH(I))
Case Else
If TraceTelnet Then Debug.Print "Invalid 'next (" + Str$(cmd) + ")' processing routine in cmd loop"
End Select
Next I
End If
term_CaretControl False
Receiving = False
End Sub
Private Function iac1(CH As Byte) As Integer
' Debug.Print "IAC : ";
iac1 = GO_norM
Select Case CH
Case DOTEL
iac1 = GO_IAC2
Case DONTTEL
iac1 = GO_IAC6
Case WILLTEL
iac1 = GO_IAC3
Case WONTTEL
iac1 = GO_IAC4
Case SB
iac1 = GO_IAC5
ppno = 0
Case SE
' End of negotiation string,string is in parsedata()
Select Case parsedata(0)
Case TERMTYPE
If parsedata(1) = 1 Then
If TraceTelnet Then Debug.Print "SENT: SB TERMTYPE VT100"
WinsockClient.SendData Chr$(IAC) & Chr$(SB) & Chr$(TERMTYPE) & "DEC-VT100" & Chr$(0) & Chr$(IAC) & Chr$(SE)
End If
Case TERMSPEED
If parsedata(1) = 1 Then
' Debug.Print "TERMSPEED"
If TraceTelnet Then Debug.Print "SENT: SB TERMSPEED 38400"
WinsockClient.SendData Chr$(IAC) & Chr$(WILLTEL) & Chr$(CH)
WinsockClient.SendData Chr$(IAC) & Chr$(SB) _
& Chr$(TERMSPEED) & Chr$(0) _
& "57600,57600" _
& Chr$(IAC) & Chr$(SE)
End If
End Select
End Select
End Function
Private Function iac2(CH As Byte) As Integer
'DO Processing Respond with WILL or WONT
If TraceTelnet Then Debug.Print " RECEIVED DO : ";
iac2 = GO_norM
Select Case CH
Case BINARY
If TraceTelnet Then Debug.Print "BINARY"
WinsockClient.SendData Chr$(IAC) & Chr$(WONTTEL) & Chr$(BINARY)
If TraceTelnet Then Debug.Print "SENT: WONT BINARY"
Case ECHO
If TraceTelnet Then Debug.Print "ECHO"
WinsockClient.SendData Chr$(IAC) & Chr$(WONTTEL) & Chr$(ECHO)
If TraceTelnet Then Debug.Print "SENT: WONT ECHO"
Case NAWS
If TraceTelnet Then Debug.Print "WINDOW SIZE"
WinsockClient.SendData Chr$(IAC) & Chr$(SB) & Chr$(NAWS) & Chr$(0) & Chr$(80) & Chr$(0) & Chr$(24) & Chr$(IAC) & Chr$(SE)
If TraceTelnet Then Debug.Print "SENT: SB WINDOW SIZE 80x24"
Case SGA
If TraceTelnet Then Debug.Print "SGA"
If Not sw_igoahead Then
If TraceTelnet Then Debug.Print "SENT: WILL SGA"
WinsockClient.SendData Chr$(IAC) & Chr$(WILLTEL) & Chr$(SGA)
sw_igoahead = True
Else
If TraceTelnet Then Debug.Print "DID NOT RESPOND"
End If
Case TERMTYPE
If TraceTelnet Then Debug.Print "TERMTYPE"
If Not sw_termsent Then
If TraceTelnet Then Debug.Print "SENT: WILL TERMTYPE"
sw_termsent = True
WinsockClient.SendData Chr$(IAC) & Chr$(WILLTEL) & Chr$(TERMTYPE)
If TraceTelnet Then Debug.Print "SENT: SB TERMTYPE VT100"
WinsockClient.SendData Chr$(IAC) & Chr$(SB) & Chr$(TERMTYPE) & _
Chr$(0) & "VT100" & Chr$(IAC) & Chr$(SE)
Else
If TraceTelnet Then Debug.Print "DID NOT RESPOND"
End If
Case TERMSPEED
If TraceTelnet Then Debug.Print "TERMSPEED"
If TraceTelnet Then Debug.Print "SENT: WILL TERMSPEED"
WinsockClient.SendData Chr$(IAC) & Chr$(WILLTEL) & Chr$(TERMSPEED)
If TraceTelnet Then Debug.Print "SENT: SB TERMSPEED 57600"
WinsockClient.SendData Chr$(IAC) & Chr$(SB) & Chr$(TERMSPEED) & Chr$(0)
WinsockClient.SendData "57600,57600"
WinsockClient.SendData Chr$(IAC) & Chr$(SE)
Case TFLOWCNTRL
If TraceTelnet Then Debug.Print "TFLOWCNTRL"
If TraceTelnet Then Debug.Print "SENT: WONT FLOWCONTROL"
WinsockClient.SendData Chr$(IAC) & Chr$(WONTTEL) & Chr$(CH)
Case LINEMODE
If TraceTelnet Then Debug.Print "LINEMODE"
If TraceTelnet Then Debug.Print "SENT: WONT LINEMODE"
WinsockClient.SendData Chr$(IAC) & Chr$(WONTTEL) & Chr$(CH)
Case STATUS
If TraceTelnet Then Debug.Print "STATUS"
If TraceTelnet Then Debug.Print "SENT: WONT STATUS"
WinsockClient.SendData Chr$(IAC) & Chr$(WONTTEL) & Chr$(CH)
Case TIMING
If TraceTelnet Then Debug.Print "TIMING"
If TraceTelnet Then Debug.Print "SENT: WONT TIMING"
WinsockClient.SendData Chr$(IAC) & Chr$(WONTTEL) & Chr$(CH)
Case disPLOC
If TraceTelnet Then Debug.Print "disPLOC"
If TraceTelnet Then Debug.Print "SENT: WONT disPLOC"
WinsockClient.SendData Chr$(IAC) & Chr$(WONTTEL) & Chr$(CH)
Case ENVIRON
If TraceTelnet Then Debug.Print "ENVIRON"
If TraceTelnet Then Debug.Print "SENT: WONT ENVIRON"
WinsockClient.SendData Chr$(IAC) & Chr$(WONTTEL) & Chr$(CH)
Case UNKNowN39
If TraceTelnet Then Debug.Print "UNKNowN39"
If TraceTelnet Then Debug.Print "SENT: WONT " & Asc(CH)
WinsockClient.SendData Chr$(IAC) & Chr$(WONTTEL) & Chr$(CH)
Case AUTHENTICATION
If TraceTelnet Then Debug.Print "AUTHENTICATION"
If TraceTelnet Then Debug.Print "SENT: WILL "; AUTHENTICATION; ""
WinsockClient.SendData Chr$(IAC) & Chr$(WILLTEL) & Chr$(CH)
If TraceTelnet Then Debug.Print "SENT: SB AUTHENTICATION"
WinsockClient.SendData Chr$(IAC) & _
Chr$(SB) & _
Chr$(AUTHENTICATION) & _
Chr$(0) & Chr$(0) & Chr$(0) & Chr$(0) & _
Chr$(IAC) & _
Chr$(SE)
Case Else
If TraceTelnet Then Debug.Print "UNKNowN CMD " & Asc(CH)
If TraceTelnet Then Debug.Print "SENT: WONT UNKNowN CMD " & CH
WinsockClient.SendData Chr$(IAC) & Chr$(WONTTEL) & Chr$(CH)
End Select
End Function
Private Function iac3(CH As Byte) As Integer
' WILL Processing - Respond with DO or DONT
If TraceTelnet Then Debug.Print "RECEIVED WILL : ";
iac3 = GO_norM
Select Case CH
Case ECHO
If TraceTelnet Then Debug.Print "ECHO"
If Not sw_echo Then
sw_echo = True
WinsockClient.SendData Chr$(IAC) & Chr$(DOTEL) & Chr$(ECHO)
If TraceTelnet Then Debug.Print "SENT: DO ECHO"
End If
Case SGA
If TraceTelnet Then Debug.Print "SGA"
If Not sw_ugoahead Then
sw_ugoahead = True
WinsockClient.SendData Chr$(IAC) & Chr$(DOTEL) & Chr$(SGA)
If TraceTelnet Then Debug.Print "SENT: DOTEL SGA"
End If
Case TERMSPEED
If TraceTelnet Then Debug.Print "TERMSPEED"
If TraceTelnet Then Debug.Print "SENT: DONT TERMSPEED"
WinsockClient.SendData Chr$(IAC) & Chr$(DONTTEL) & Chr$(CH)
Case TFLOWCNTRL
If TraceTelnet Then Debug.Print "TFLOWCNTRL"
If TraceTelnet Then Debug.Print "SENT: DONT FLOWCONTROL"
WinsockClient.SendData Chr$(IAC) & Chr$(DONTTEL) & Chr$(CH)
Case LINEMODE
If TraceTelnet Then Debug.Print "LINEMODE"
If TraceTelnet Then Debug.Print "SENT: DONT LINEMODE"
WinsockClient.SendData Chr$(IAC) & Chr$(DONTTEL) & Chr$(CH)
Case STATUS
If TraceTelnet Then Debug.Print "STATUS"
If TraceTelnet Then Debug.Print "SENT: DONT STATUS"
WinsockClient.SendData Chr$(IAC) & Chr$(DONTTEL) & Chr$(CH)
Case TIMING
If TraceTelnet Then Debug.Print "TIMING"
If TraceTelnet Then Debug.Print "SENT: DONT TIMING"
WinsockClient.SendData Chr$(IAC) & Chr$(DONTTEL) & Chr$(CH)
Case disPLOC
If TraceTelnet Then Debug.Print "disPLOC"
If TraceTelnet Then Debug.Print "SENT: WONT disPLOC"
WinsockClient.SendData Chr$(IAC) & Chr$(DONTTEL) & Chr$(CH)
Case ENVIRON
If TraceTelnet Then Debug.Print "ENVIRON"
If TraceTelnet Then Debug.Print "SENT: WONT ENVIRON"
WinsockClient.SendData Chr$(IAC) & Chr$(DONTTEL) & Chr$(CH)
Case UNKNowN39
If TraceTelnet Then Debug.Print "UNKNowN39"
If TraceTelnet Then Debug.Print "SENT: WONT " & Asc(CH)
WinsockClient.SendData Chr$(IAC) & Chr$(DONTTEL) & Chr$(CH)
Case Else
If TraceTelnet Then Debug.Print "UNKNowN CMD " & Asc(CH)
If TraceTelnet Then Debug.Print "SENT: WONT UNKNowN CMD " & Asc(CH)
WinsockClient.SendData Chr$(IAC) & Chr$(DONTTEL) & Chr$(CH)
End Select
End Function
Private Function iac4(CH As Byte) As Integer
' WONT Processing
If TraceTelnet Then Debug.Print " RECEIVED WONT : ";
iac4 = GO_norM
Select Case CH
Case ECHO
If TraceTelnet Then Debug.Print "ECHO"
If sw_echo = True Then
WinsockClient.SendData Chr$(IAC) & Chr$(DONTTEL) & Chr$(ECHO)
If TraceTelnet Then Debug.Print "SENT: DONTEL ECHO"
sw_echo = False
End If
Case SGA
If TraceTelnet Then Debug.Print "SGA"
If TraceTelnet Then Debug.Print "SENT: DONT SGA"
WinsockClient.SendData Chr$(IAC) & Chr$(DONTTEL) & Chr$(SGA)
sw_igoahead = False
Case TERMSPEED
If TraceTelnet Then Debug.Print "TERMSPEED"
If TraceTelnet Then Debug.Print "SENT: DONT TERMSPEED"
WinsockClient.SendData Chr$(IAC) & Chr$(DONTTEL) & Chr$(CH)
Case TFLOWCNTRL
If TraceTelnet Then Debug.Print "FLOWCONTROL"
If TraceTelnet Then Debug.Print "SENT: DONT FLOWCONTROL"
WinsockClient.SendData Chr$(IAC) & Chr$(DONTTEL) & Chr$(CH)
Case LINEMODE
If TraceTelnet Then Debug.Print "LINEMODE"
If TraceTelnet Then Debug.Print "SENT: DONT LINEMODE"
WinsockClient.SendData Chr$(IAC) & Chr$(DONTTEL) & Chr$(CH)
Case STATUS
If TraceTelnet Then Debug.Print "STATUS"
If TraceTelnet Then Debug.Print "SENT: DONT STATUS"
WinsockClient.SendData Chr$(IAC) & Chr$(DONTTEL) & Chr$(CH)
Case TIMING
If TraceTelnet Then Debug.Print "TIMING"
If TraceTelnet Then Debug.Print "SENT: DONT TIMING"
WinsockClient.SendData Chr$(IAC) & Chr$(DONTTEL) & Chr$(CH)
Case disPLOC
If TraceTelnet Then Debug.Print "disPLOC"
If TraceTelnet Then Debug.Print "SENT: DONT disPLOC"
WinsockClient.SendData Chr$(IAC) & Chr$(DONTTEL) & Chr$(CH)
Case ENVIRON
If TraceTelnet Then Debug.Print "ENVIRON"
If TraceTelnet Then Debug.Print "SENT: DONT ENVIRON"
WinsockClient.SendData Chr$(IAC) & Chr$(DONTTEL) & Chr$(CH)
Case UNKNowN39
If TraceTelnet Then Debug.Print "UNKNowN39"
If TraceTelnet Then Debug.Print "SENT: DONT " & Asc(CH)
WinsockClient.SendData Chr$(IAC) & Chr$(DONTTEL) & Chr$(CH)
Case Else
If TraceTelnet Then Debug.Print "UNKNowN CMD " & Asc(CH)
If TraceTelnet Then Debug.Print "SENT: DONT UNKNowN CMD " & Asc(CH)
WinsockClient.SendData Chr$(IAC) & Chr$(WONTTEL) & Chr$(CH)
End Select
End Function
Private Function iac5(CH As Byte) As Integer
Dim ich As Integer
' Collect parms after SB and until another IAC
ich = CH
If ich = IAC Then
iac5 = GO_IAC1
Exit Function
End If
If TraceTelnet Then Debug.Print "RECEIVED : ";
If TraceTelnet Then Debug.Print "SB("; ppno; ") = " & ich
parsedata(ppno) = ich
ppno = ppno + 1
iac5 = GO_IAC5
End Function
Private Function iac6(CH As Byte) As Integer
'DONT Processing
iac6 = GO_norM
Select Case CH
Case SE
If TraceTelnet Then Debug.Print " RECEIVED SE"
If TraceTelnet Then Debug.Print "SENT: SE_ACK " & CH
Case ECHO
If TraceTelnet Then Debug.Print " RECEIVED DONT : ";
If TraceTelnet Then Debug.Print "ECHO"
If Not sw_echo Then
sw_echo = True
WinsockClient.SendData Chr$(IAC) & Chr$(WONTTEL) & Chr$(ECHO)
If TraceTelnet Then Debug.Print "SENT: WONT ECHO"
End If
Case SGA
If TraceTelnet Then Debug.Print "RECEIVED DONT : ";
If TraceTelnet Then Debug.Print "SGA"
If Not sw_ugoahead Then
sw_ugoahead = True
WinsockClient.SendData Chr$(IAC) & Chr$(WONTTEL) & Chr$(SGA)
If TraceTelnet Then Debug.Print "SENT: WONT SGA"
End If
Case TERMSPEED
If TraceTelnet Then Debug.Print "RECEIVED DONT : ";
If TraceTelnet Then Debug.Print "TERMSPEED"
If TraceTelnet Then Debug.Print "SENT: WONT TERMSPEED"
WinsockClient.SendData Chr$(IAC) & Chr$(WONTTEL) & Chr$(CH)
Case TFLOWCNTRL
If TraceTelnet Then Debug.Print "RECEIVED DONT : ";
If TraceTelnet Then Debug.Print "TFLOWCNTRL"
If TraceTelnet Then Debug.Print "SENT: WONT FLOWCONTROL"
WinsockClient.SendData Chr$(IAC) & Chr$(WONTTEL) & Chr$(CH)
Case LINEMODE
If TraceTelnet Then Debug.Print "RECEIVED DONT : ";
If TraceTelnet Then Debug.Print "LINEMODE"
If TraceTelnet Then Debug.Print "SENT: WONT LINEMODE"
WinsockClient.SendData Chr$(IAC) & Chr$(WONTTEL) & Chr$(CH)
Case STATUS
If TraceTelnet Then Debug.Print "RECEIVED DONT : ";
If TraceTelnet Then Debug.Print "STATUS"
If TraceTelnet Then Debug.Print "SENT: WONT STATUS"
WinsockClient.SendData Chr$(IAC) & Chr$(WONTTEL) & Chr$(CH)
Case TIMING
If TraceTelnet Then Debug.Print "RECEIVED DONT : ";
If TraceTelnet Then Debug.Print "TIMING"
If TraceTelnet Then Debug.Print "SENT: WONT TIMING"
WinsockClient.SendData Chr$(IAC) & Chr$(WONTTEL) & Chr$(CH)
Case disPLOC
If TraceTelnet Then Debug.Print "RECEIVED DONT : ";
If TraceTelnet Then Debug.Print "disPLOC"
If TraceTelnet Then Debug.Print "SENT: WONT disPLOC"
WinsockClient.SendData Chr$(IAC) & Chr$(WONTTEL) & Chr$(CH)
Case ENVIRON
If TraceTelnet Then Debug.Print "RECEIVED DONT : ";
If TraceTelnet Then Debug.Print "ENVIRON"
If TraceTelnet Then Debug.Print "SENT: WONT ENVIRON"
WinsockClient.SendData Chr$(IAC) & Chr$(WONTTEL) & Chr$(CH)
Case UNKNowN39
If TraceTelnet Then Debug.Print "RECEIVED DONT : ";
If TraceTelnet Then Debug.Print "UNKNowN39"
If TraceTelnet Then Debug.Print "SENT: WONT " & Asc(CH)
WinsockClient.SendData Chr$(IAC) & Chr$(WONTTEL) & Chr$(CH)
Case Else
If TraceTelnet Then Debug.Print "RECEIVED DONT : ";
If TraceTelnet Then Debug.Print "UNKNowN CMD " & Asc(CH)
If TraceTelnet Then Debug.Print "SENT: WONT UNKNowN CMD " & Asc(CH)
WinsockClient.SendData Chr$(IAC) & Chr$(WONTTEL) & Chr$(CH)
End Select
End Function
Private Sub WinsockClient_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)
frmTelnet.stbStatusBar.Panels(4).Text = Number & " - " & Description
Operating = False
Connected = False
End Sub
Module code
Option Explicit
'Windows RECT structure
Private Type RECT
Left As Long
Top As Long
Right As Long
bottom As Long
End Type
Private Declare Function ScrollWindow Lib "user32" (ByVal hWnd As Long,ByVal XAmount As Long,ByVal YAmount As Long,lpRect As RECT,lpClipRect As RECT) As Long
Private Declare Function ScrollDC Lib "user32" (ByVal hdc As Long,ByVal dx As Long,ByVal dy As Long,lprcScroll As RECT,lprcclip As RECT,ByVal hRgnUpdate As Long,lprcUpdate As RECT) As Long
Private Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long,ByVal X As Long,ByVal Y As Long,ByVal nwidth As Long,ByVal nheight As Long,ByVal dwRop As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long,ByVal nBkMode As Long) As Long
Private Declare Function textout Lib "gdi32" Alias "textoutA" (ByVal hdc As Long,ByVal lpString As String,ByVal nCount As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long,ByVal crColor As Long) As Long
Private Declare Function GetBkColor Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetBkMode Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetTextColor Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function PaintRgn Lib "gdi32" (ByVal hdc As Long,ByVal hRgn As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long,ByVal newcolor As Long) As Long
Private Declare Function IsCharalpha Lib "user32" Alias "IsCharalphaA" (ByVal cChar As Byte) As Long
'=================== Ternary raster operations ============
Private Const PATcopY = &HF00021 ' (DWORD) dest = pattern
Private Const PATPAINT = &HFB0A09 ' (DWORD) dest = DPSnoo
Private Const PATINVERT = &H5A0049 ' (DWORD) dest = pattern XOR dest
Private Const DSTINVERT = &H550009 ' (DWORD) dest = (NOT dest)
Private Const BLACKnesS = &H42& ' (DWORD) dest = BLACK
Private Const WHITEnesS = &HFF0062 ' (DWORD) dest = WHITE
Private Const TRANSPARENT = 1
Private Const OPAQUE = 2
Private Const GO_IAC1 = 6
Private Const LinesPerPage = 25
Private Const CharsPerLine = 80
Private Const TabsPerPage = 20
Private Const LastLine = LinesPerPage - 1
Private Const LastChar = CharsPerLine - 1
Private Const LastTab = 19
Private ScrImage(LinesPerPage) As String * CharsPerLine
Private ScrAttr(LinesPerPage) As String * CharsPerLine
Private norm_Attr As String * CharsPerLine
Private Blank_Line As String * CharsPerLine
Private TermTextColor As Long
Private TermBkColor As Long
Private tabno As Integer
Private tab_table(TabsPerPage) As Integer
Private curattr As String
Private lprcScroll As RECT
Private lprcclip As RECT
Private hRgnUpdate As Integer
Private lprcUpdate As RECT
' Current Buffered Text waiting for output on screen
Private OutStr As String
Private outlen As Integer
' Flag to indicate that we're ready to run
Private FlagInit As Integer
Private CurX As Integer
Private CurY As Integer
Private SavecurX As Integer
Private SavecurY As Integer
Private Inescape As Boolean ' Processing an escape seq?
Private EscString As String ' String so far
Private charheight As Single
Private charWidth As Single
Private CurState As Boolean
Private Ret As Long
Public Function term_process_char(CH As Byte)
If (Inescape) Then
Call term_escapeProcess(CH)
Else
Select Case CH
Case 0
Case 7
Beep
Case 8
If CurX > 0 Then ' if not at line begin
CurX = CurX - 1 ' adjust back 1 spc
End If
Case 9
Dim tY As Integer
For tY = 0 To 19
If CurY < tab_table(tY) Then
Exit For
End If
Next tY
CurY = tab_table(tY)
Case 10,11,12
If (CurY = LastLine) Then ' if line left on scrn
Call term_scroll_up ' .. scroll upwards
CurY = LastLine ' .. use blank line
Else
CurY = CurY + 1 ' goto next line
End If
Case 13
CurX = 0
Case 27
Inescape = True
EscString = ""
Case 255
term_process_char = GO_IAC1
Case Else
' if (CH > 31) Then ' And (CH < 128)
term_write CH
Mid$(ScrImage(CurY + 1),CurX,1) = Chr$(CH)
Mid$(ScrAttr(CurY + 1),1) = curattr
' End If
End Select
End If
End Function
Public Sub term_CaretControl(TurnOff As Boolean)
Static SaveState As Boolean
If TurnOff = True Then
SaveState = CurState
term_Carethide
Else
If SaveState = True Then
term_Caretshow
End If
End If
End Sub
Private Sub term_Carethide()
If CurState = True Then
If frmTelnet.WindowState <> 1 Then
Ret = PatBlt(frmTelnet.hdc,CurX * charWidth,CurY * charheight,charWidth,charheight,DSTINVERT)
End If
CurState = False
End If
End Sub
Private Sub term_Caretshow()
'------------------------------------------------------------------------
' term_CaretShow
' display the inverted block cursor on the screen.
' currently uses PatBlt.
'------------------------------------------------------------------------
Dim Ret As Integer
If frmTelnet.WindowState <> 1 Then
Ret = PatBlt(frmTelnet.hdc,DSTINVERT)
End If
CurState = True
End Sub
Public Sub term_DriveCursor()
If CurState = False Then
Call term_Caretshow
Else
Call term_Carethide
End If
End Sub
Private Sub term_eraseBOL()
'------------------------------------------------------------------------
' term_eraseBOL
' erase from beginning of current line
'------------------------------------------------------------------------
Dim Ret As Integer
If frmTelnet.WindowState <> 1 Then
' Ret = PatBlt(frmTelnet.hdc,curX * charWidth,BLACKnesS)
Ret = textout(frmTelnet.hdc,Blank_Line,CharsPerLine)
End If
Mid$(ScrImage(CurY + 1),1,CurX + 1) = Space$(CurX + 1)
Mid$(ScrAttr(CurY + 1),CurX + 1) = String$(CurX + 1,"0")
End Sub
Private Sub term_eraseBOS()
'------------------------------------------------------------------------
' term_eraseBOS
' erase all lines from beginning of screen to and including current
'------------------------------------------------------------------------
Dim Y As Integer
'Erase the current line first
Call term_eraseBOL
'Erase everything up to current line
If (CurY > 0) Then
If frmTelnet.WindowState <> 1 Then
Ret = textout(frmTelnet.hdc,Space$(CharsPerLine * CurY + CurX),CharsPerLine * CurY + CurX)
End If
' reset screen buffer contents
For Y = 1 To CurY
ScrImage(Y) = Blank_Line
ScrAttr(Y) = norm_Attr
Next Y
End If
End Sub
Private Sub term_eraseBUFFER()
Dim I As Integer
For I = 1 To LinesPerPage
ScrImage(I) = Blank_Line
ScrAttr(I) = norm_Attr
Next I
End Sub
Private Sub term_eraseEOL()
' Erase to End of Line
If frmTelnet.WindowState <> 1 Then
Ret = textout(frmTelnet.hdc,Space$(CharsPerLine - CurX),CharsPerLine - CurX)
End If
'Update screen buffer
Mid$(ScrImage(CurY + 1),CurX + 1,CharsPerLine - CurX) = Space$(CharsPerLine - CurX)
Mid$(ScrAttr(CurY + 1),CharsPerLine - CurX) = String$(CharsPerLine - CurX,"0")
End Sub
Private Sub term_eraseEOS()
' Erase to end of screen
Dim Y As Integer
Call term_eraseEOL
If (CurY <> LastLine) Then
If frmTelnet.WindowState <> 1 Then
Ret = textout(frmTelnet.hdc,(CurY + 1) * charheight,Space$((LastLine - CurY) * CharsPerLine),(LastLine - CurY) * CharsPerLine)
End If
For Y = CurY + 2 To LinesPerPage
ScrImage(Y) = Blank_Line
ScrAttr(Y) = norm_Attr
Next Y
End If
End Sub
Private Sub term_eraseLINE()
' Erase Line
If frmTelnet.WindowState <> 1 Then
Ret = textout(frmTelnet.hdc,CharsPerLine)
End If
ScrImage(CurY + 1) = Blank_Line
ScrAttr(CurY + 1) = norm_Attr
End Sub
Private Sub term_eraseSCREEN()
'Assume that they want to repaint using the latest background color
TermBkColor = GetBkColor(frmTelnet.hdc)
TermTextColor = GetTextColor(frmTelnet.hdc)
frmTelnet.BackColor = TermBkColor
frmTelnet.ForeColor = TermTextColor
term_eraseBUFFER
frmTelnet.Cls
CurX = 0
CurY = 0
End Sub
Private Function term_escapeParseArg(S As String) As String
' PopArg takes the next argument (digits up to a ;) and
' returns it. It also removes the arg and the ; from
' the "s"
Dim I As Integer
I = InStr(S,";")
If I = 0 Then
term_escapeParseArg = S
S = ""
Else
term_escapeParseArg = Left$(S,I - 1)
S = Mid$(S,I + 1)
End If
End Function
Private Sub term_escapeProcess(CH As Byte)
Dim c As String
Dim yDiff As Integer
Dim xDiff As Integer
c = Chr$(CH)
If EscString = "" Then
'No start character yet
Select Case c
Case "["
Case "("
Case ")"
Case "#"
Case Chr$(8) ' embedded backspace
CurX = CurX - 1
term_validatecurX
Inescape = False
Case "7" ' save cursor
'Save cursor position
SavecurX = CurX
SavecurY = CurY
Inescape = False
Case "8" ' restore cursor
'restore cursor position
CurX = SavecurX
CurY = SavecurY
Inescape = False
Case "c" ' look at VSIreset()
Case "D" ' cursor down
CurY = CurY + 1
term_validatecurY
Inescape = False
Case "E" ' next line
CurY = CurY + 1
CurX = 0
term_validatecurY
term_validatecurX
Inescape = False
Case "H" ' set tab
tab_table(tabno) = CurY
tabno = tabno + 1
Inescape = False
Case "I" ' look at bp_ESC_I()
Inescape = False
Case "M" ' cursor up
CurY = CurY - 1
term_validatecurY
Case "Z" ' send ident
Inescape = False
Case Else
'Invalid start of escape sequence
If frmTelnet.Tracevt100 Then Debug.Print CH
Inescape = False
Exit Sub
End Select
End If
EscString = EscString & c
If IsCharalpha(CH) = 0 Then
' Not a character ...
If Len(EscString) > 15 Then
If frmTelnet.Tracevt100 Then Debug.Print CH
Inescape = False
End If
Exit Sub
End If
Select Case c
Case "A"
' A ==> move cursor up
EscString = Mid$(EscString,2)
yDiff = Val(term_escapeParseArg(EscString))
If yDiff = 0 Then
yDiff = 1
End If
CurY = CurY - yDiff
term_validatecurY
Case "B"
' B ==> move cursor down
EscString = Mid$(EscString,2)
yDiff = Val(term_escapeParseArg(EscString))
If yDiff = 0 Then
yDiff = 1
End If
CurY = CurY + yDiff
term_validatecurY
Case "C"
' C ==> move cursor right
EscString = Mid$(EscString,2)
xDiff = Val(term_escapeParseArg(EscString))
If xDiff = 0 Then
xDiff = 1
End If
CurX = CurX + xDiff
term_validatecurX
Case "D"
' D ==> move cursor left
EscString = Mid$(EscString,2)
xDiff = Val(term_escapeParseArg(EscString))
If xDiff = 0 Then
xDiff = 1
End If
CurX = CurX - xDiff
term_validatecurX
Case "H"
'Goto cursor position indicated by escape sequence
EscString = Mid$(EscString,2)
CurY = Val(term_escapeParseArg(EscString)) - 1
term_validatecurY
CurX = Val(EscString) - 1
term_validatecurX
Case "J"
'Erase display
Select Case Val(Mid$(EscString,2))
Case 0
If CurX = 0 And CurY = 0 Then
Call term_eraseSCREEN
Else
Call term_eraseEOS
End If
Case 1
Call term_eraseBOS
Case 2
Call term_eraseSCREEN
End Select
Case "K"
'Erase line
Select Case Val(Mid$(EscString,2))
Case 0
'erase to end of line
Call term_eraseEOL
Case 1
'erase to end of line
Call term_eraseBOL
Case 2
Call term_eraseLINE
End Select
Case "f"
'Goto cursor position indicated by escape sequence
EscString = Mid$(EscString,2)
CurY = Val(term_escapeParseArg(EscString)) - 1
term_validatecurY
CurX = Val(EscString) - 1
term_validatecurX
Case "g"
' clear tabs
Dim tY As Integer
For tY = 0 To 19
tab_table(tY) = 0
Next tY
Case "h"
'restore cursor position
CurX = SavecurX
CurY = SavecurY
Case "i"
' print though mode
Case "l"
'Save cursor position
SavecurX = CurX
SavecurY = CurY
Case "m"
'Change text attributes,screen colors
EscString = Mid$(EscString,2)
Do
Call term_setattr(Chr$(Val(term_escapeParseArg(EscString))))
Loop While EscString <> ""
Case "r"
'Set scrollable region
EscString = Mid$(EscString,2)
lprcScroll.Top = (Val(term_escapeParseArg(EscString)) - 1) * charheight
lprcclip = lprcScroll
Case "s"
'Save cursor position
SavecurX = CurX
SavecurY = CurY
Case "u"
'restore cursor position
CurX = SavecurX
CurY = SavecurY
Case Else
If frmTelnet.Tracevt100 Then Debug.Print EscString
End Select
Inescape = False
EscString = ""
End Sub
Public Sub term_init()
'Get the pixel metrics of the current font
frmTelnet.FontUnderline = False
frmTelnet.FontItalic = False
frmTelnet.FontBold = False
frmTelnet.ScaleMode = 3
charheight = frmTelnet.TextHeight("M")
charWidth = frmTelnet.TextWidth("M")
'Set up the vt100 screen
frmTelnet.ScaleMode = 1
frmTelnet.Height = (frmTelnet.Height - frmTelnet.ScaleHeight) + LinesPerPage * frmTelnet.TextHeight("M")
frmTelnet.Height = frmTelnet.Height + frmTelnet.stbStatusBar.Height
frmTelnet.Width = (frmTelnet.Width - frmTelnet.ScaleWidth) + CharsPerLine * frmTelnet.TextWidth("M")
'Set the user scale of the display
frmTelnet.ScaleMode = 0
frmTelnet.ScaleWidth = LinesPerPage
frmTelnet.ScaleWidth = CharsPerLine
frmTelnet.Scale (0,0)-(LastChar,LastLine)
'Set up the scoll region and clip region structures
lprcScroll.Top = 0
lprcScroll.Left = 0
lprcScroll.Right = CharsPerLine * charWidth
lprcScroll.bottom = LinesPerPage * charheight
lprcclip = lprcScroll
hRgnUpdate = 0
'Initialize module level flags and variables
Inescape = False
CurState = False
curattr = "0"
CurX = 0
CurY = 0
'Set the default foreground and background colors
Ret = SetBkMode(frmTelnet.hdc,OPAQUE)
frmTelnet.ForeColor = QBColor(15)
frmTelnet.BackColor = QBColor(0)
Ret = SetBkColor(frmTelnet.hdc,frmTelnet.BackColor)
Ret = SetTextColor(frmTelnet.hdc,frmTelnet.ForeColor)
TermTextColor = GetTextColor(frmTelnet.hdc)
TermBkColor = GetBkColor(frmTelnet.hdc)
'Initialize repaint buffer
norm_Attr = String$(CharsPerLine,"0")
Blank_Line = Space$(CharsPerLine)
term_eraseBUFFER
FlagInit = True
'Do the cursor thing
term_Caretshow
frmTelnet.cursor_timer.Enabled = True
End Sub
Private Function Term_FindChange(InArray As String,ByVal CurrentValue As String,ByteLen As Integer) As Integer
Dim RetValue As Integer
Dim CurrentByte As Byte
Dim InByte() As Byte
CurrentByte = CurrentValue
InByte = InArray
For RetValue = 1 To ByteLen
If InByte(RetValue) <> CurrentByte Then
Exit For
End If
Next
Term_FindChange = RetValue - 1
End Function
Public Sub term_redrawscreen()
If Not FlagInit Or frmTelnet.WindowState = 1 Then
Exit Sub
End If
Dim oldcur As Boolean
Dim oldattr As String
Dim newattr As String
Dim Y As Integer
Dim X1 As Integer
Dim X2 As Integer
Dim AttrChange As Integer
Dim tAttr As String * CharsPerLine
Dim tLine As String * CharsPerLine
oldcur = CurState
oldattr = curattr
If Not frmTelnet.Receiving Then
Call term_Carethide
End If
Call term_setattr("0")
For Y = 1 To LinesPerPage
tAttr = ScrAttr(Y)
tLine = ScrImage(Y)
If (tAttr = norm_Attr) Then
'normal Lines can be repainted directly
Ret = textout(frmTelnet.hdc,(Y - 1) * charheight,tLine,CharsPerLine)
Else
'Complex lines must have attribute changes found using the
'Term_function FindChange.
X1 = 1 'Start the scan on the complete line
X2 = CharsPerLine
do while (X2 > 0)
AttrChange = Term_FindChange(Mid(tAttr,X1,X2),curattr,X2)
Ret = textout(frmTelnet.hdc,(X1 - 1) * charWidth,Mid$(tLine,AttrChange),AttrChange)
X2 = X2 - AttrChange
If X2 > 0 Then
X1 = X1 + AttrChange
newattr = Mid$(tAttr,1)
If newattr <> "0" Then
term_setattr newattr
Else
curattr = newattr
End If
End If
Loop
End If
Next Y
Call term_setattr(oldattr)
If Not frmTelnet.Receiving Then
If oldcur = True Then
Call term_Caretshow
End If
End If
End Sub
Private Sub term_scroll_up()
Dim I As Integer
Dim S As Integer
If frmTelnet.WindowState <> 1 Then
Ret = ScrollDC(frmTelnet.hdc,-charheight,lprcScroll,lprcclip,hRgnUpdate,lprcUpdate)
Ret = textout(frmTelnet.hdc,CharsPerLine)
End If
'Update the redisplay buffer (only update the scrollable region)
'Might consider making this a circular array so only one line
'needs to be written per scroll,rather than relinking the array
S = (lprcScroll.Top \ charheight + 1)
For I = S To LastLine
ScrImage(I) = ScrImage(I + 1)
ScrAttr(I) = ScrAttr(I + 1)
Next I
ScrImage(LinesPerPage) = Blank_Line
ScrAttr(LinesPerPage) = norm_Attr
End Sub
Private Sub term_setattr(CH As String)
Dim Attr_BitMap As Integer
Select Case Asc(CH)
Case 0 ' normal
' Attr_BitMap = Attr_norm
frmTelnet.FontUnderline = False
frmTelnet.FontItalic = False
frmTelnet.FontBold = False
Ret = SetTextColor(frmTelnet.hdc,TermTextColor)
Ret = SetBkColor(frmTelnet.hdc,TermBkColor)
Case 1 ' Bold
' Attr_BitMap = Attr_BitMap And Attr_norm
frmTelnet.FontBold = True
' Ret = SetTextColor(frmTelnet.hdc,QBColor(9))
Case 5 ' Blinking
' Attr_BitMap = Attr_BitMap And Attr_Blink
frmTelnet.FontItalic = True
' Ret = SetTextColor(frmTelnet.hdc,QBColor(3))
Case 4 ' Underscore
' Attr_BitMap = Attr_BitMap And Attr_Under
frmTelnet.FontUnderline = True
Case 7 ' Reverse Video
' Attr_BitMap = Attr_BitMap And ATTR_REVERSE
Ret = SetTextColor(frmTelnet.hdc,TermBkColor)
Ret = SetBkColor(frmTelnet.hdc,TermTextColor)
Case 8 ' Cancel (Invisible)
'Attr_BitMap = Attr_BitMap And ATTR_INVISIBLE
Ret = SetTextColor(frmTelnet.hdc,TermBkColor)
'=======================================================
Case 30 ' Black Foreground
Ret = SetTextColor(frmTelnet.hdc,QBColor(0))
Case 31 ' Red Foreground
Ret = SetTextColor(frmTelnet.hdc,QBColor(4))
Case 32 ' Green Foreground
Ret = SetTextColor(frmTelnet.hdc,QBColor(2))
Case 33 ' Yellow Foreground
Ret = SetTextColor(frmTelnet.hdc,QBColor(14))
Case 34 ' Blue Foreground
Ret = SetTextColor(frmTelnet.hdc,QBColor(1))
Case 35 ' magenta Foreground
Ret = SetTextColor(frmTelnet.hdc,QBColor(5))
Case 36 ' Cyan Foreground
Ret = SetTextColor(frmTelnet.hdc,QBColor(3))
Case 37 ' White Foreground
Ret = SetTextColor(frmTelnet.hdc,QBColor(15))
'=========================================================
Case 40 ' Black Background
Ret = SetBkColor(frmTelnet.hdc,QBColor(0))
Case 41 ' Red Background
Ret = SetBkColor(frmTelnet.hdc,QBColor(4))
Case 42 ' Green Background
Ret = SetBkColor(frmTelnet.hdc,QBColor(2))
Case 43 ' Yellow Background
Ret = SetBkColor(frmTelnet.hdc,QBColor(14))
Case 44 ' Blue Background
Ret = SetBkColor(frmTelnet.hdc,QBColor(1))
Case 45 ' magenta Background
Ret = SetBkColor(frmTelnet.hdc,QBColor(5))
Case 46 ' Cyan Background
Ret = SetBkColor(frmTelnet.hdc,QBColor(3))
Case 47 ' White Background
Ret = SetBkColor(frmTelnet.hdc,QBColor(15))
Case Else
Exit Sub
End Select
curattr = CH
End Sub
Private Sub term_validatecurX()
If (CurX < 0) Then
CurX = 0
ElseIf CurX > LastChar Then
CurX = LastChar
End If
End Sub
Private Sub term_validatecurY()
If (CurY < 0) Then
CurY = 0
ElseIf CurY > LastLine Then
CurY = LastLine
End If
End Sub
Private Sub term_write(CH As Byte)
If frmTelnet.WindowState <> 1 Then
Ret = textout(frmTelnet.hdc,Chr$(CH),1)
End If
If Not (CurX = LastChar) Then
CurX = CurX + 1
End If
End Sub
附：
Second form： Name：frmTCPIP
TextBox控件： Name: txtRemoteAddress
TextBox控件： Name: txtPort
CheckBox控件： Name: Check1
CommandButton控件： Name: cmdOKCancel
CommandButton控件： Name: cmdOKCancel
注：CommadButton控件为数组控件。
Main form： Name: frmTelnet
Winsock控件： Name: WinsockClient
StatusBar控件： Name: StbStatusBar
Protocol: SckTCPProtocol
Timer控件： Name: cursor_timer
下拉菜单： Ｎａｍｅ
Ｆｉｌｅ mfile
…Ｅｘｉｔ mexit
Ｃｏｎｎｅｃｔｉｏｎ mconnection
…Ｓｅｔｔｉｎｇｓ msettings
…Ｏｐｅｎ mopen
…Ｃｌｏｓｅ mclose
Top
z_47你认为用Telnet的原理来写Mud的客户端的方法可行吗？如可行代码中的那些部分较为重要请指导一下！Top
回复于 2001-01-08 16:28:00 得分 0最近以使用Delphi4实现了telnet for windows，支持中文、彩色、ascii制表
符。详细内容可浏览http://oopsware.qzone.com
有我的telnet 1.0b版，及原程序！ Top
引文来源 telnet的源代码 VB / 基础类 - CSDN社区 community.csdn.net