VB 版 (精华区)

发信人: bloom (又臭又硬小石头), 信区: VB
标  题: Telnet client 源码[demo]               fjl (转寄)(转载)
发信站: 哈工大紫丁香 (2000年07月11日14:07:21 星期二), 转信

【 以下文字转载自 bloom 的信箱 】
【 原文由 qquy.bbs@smth.org 所发表 】
发信人: chzh (zhch from nju), 信区: VisualBasic
标  题: Telnet client 源码[demo]
发信站: BBS 水木清华站 (Sat Mar 20 19:18:48 1999) WWW-POST





VERSION 5.00 
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX" 
Begin VB.Form bbs 
AutoRedraw = -1 'True 
Caption = "bbs" 
ClientHeight = 2496 
ClientLeft = 48 
ClientTop = 336 
ClientWidth = 3744 
LinkTopic = "Form1" 
ScaleHeight = 208 
ScaleMode = 3 'Pixel 
ScaleWidth = 312 
StartUpPosition = 3 'Windows Default 
Begin VB.Timer Timer1 
Interval = 100 
Left = 360 
Top = 0 
End 
Begin MSWinsockLib.Winsock Winsock1 
Left = 0 
Top = 0 
_ExtentX = 593 
_ExtentY = 593 
End 
End 
Attribute VB_Name = "bbs" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Rem Nju Telnet Client Programed by chzh, nju, 1998 
DefInt A-Z 
Dim Bold, Reverse, Bcolor, Fcolor, Css, ox, oy 

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) 
Select Case KeyCode 
Case 38: SendChars "27;91;65" 
Case 40: SendChars "27;91;66" 
Case 37: SendChars "27;91;68" 
Case 39: SendChars "27;91;67" 
End Select 
End Sub 

Private Sub Form_KeyPress(KeyAscii As Integer) 
If KeyAscii >= 0 Then SendChars Str$(KeyAscii) Else l& = KeyAscii + 65536: 
SendChars Str$(l& \ 256) + ";" + Str$(l& Mod 256) 
End Sub 

Private Sub Form_Load() 
Fcolor = 7: Bcolor = 0: BackColor = 0 
bbs.Width = 648 * 12: bbs.Height = 416 * 12 
Winsock1.Connect "202.119.38.2", 23 
End Sub 

Private Sub Timer1_Timer() 
Main 
Css = (Css + 1) Mod 10: x = CurrentX: y = CurrentY 
If x <> ox Or y <> oy Then Line (ox, oy + 15)-Step(7, 0), QBColor(Bcolor): ox 

= x: oy = y 
If Css < 5 Then c = Bcolor Else c = Fcolor 
Line (x, y + 15)-Step(7, 0), QBColor(c): CurrentX = x: CurrentY = y 
End Sub 

Function Inkey() As Byte 
Dim b As Byte 
While Winsock1.BytesReceived = 0: Nop: Wend 
Winsock1.GetData b: Inkey = b 
End Function 

Sub Nop() 
DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: 
DoEvents: DoEvents 
End Sub 

Function VVV(d$) 
VVV = Val(d$): d$ = Mid$(d$, InStr(d$ + ";", ";") + 1) 
End Function 

Sub SendChars(d$) 
Dim b As Byte 
While d$ <> "": b = VVV(d$): Winsock1.SendData b: Wend 
End Sub 

Sub Main() 
Dim b As Byte, LL 
While Winsock1.BytesReceived > 0 
b = Inkey 
Select Case b 
Case 255 
c = Inkey: d = Inkey 
If c = 253 And (d = 1 Or d = 24) Then SendChars "255;251;" & d: GoTo L2 
If c = 254 And d = 1 Then SendChars "255;252;1": GoTo L2 
If c = 251 And d = 1 Then SendChars "255;253;1": GoTo L2 
If c = 250 Then While d <> 240: d = Inkey: Wend: SendChars "255;250;24;0;118; 

116;49;48;48;255;240": GoTo L2 
If c = 253 Then SendChars "255;252;" & d: GoTo L2 
Case 27 
s$ = "": c = Inkey: If c <> 91 Then GoTo L2 
L1: dat$ = Chr$(Inkey): If InStr(" 0123456789;", dat$) > 1 Then s$ = s$ + 
dat$: GoTo L1 
Select Case dat$ 
Case "m" 
If s$ = "" Then s$ = "0" 
While s$ <> "" 
v = VVV(s$) 
If v > 29 And v < 38 Then Fcolor = v - 30 + Bold * 8 
If v > 39 And v < 48 Then Bcolor = v - 40 
If v = 0 Then Bold = 0: Reverse = 0: Fcolor = 7: Bcolor = 0: 'Fcolor Mod 
8 
If Bcolor = 4 Then Bcolor = 1 
If v = 1 Then Bold = 1: Fcolor = Fcolor Mod 8 + 8 
If v = 7 Then Reverse = 1 
ForeColor = QBColor(Fcolor) 
Wend 
Case "K": x = CurrentX: y = CurrentY: Line (x, y)-Step(720, 15), 
QBColor(Bcolor), BF: CurrentX = x: CurrentY = y 
Case "C": xx = VVV(s$): CurrentX = CurrentX + xx * 8 
Case "H": yy = VVV(s$): xx = VVV(s$): If xx > 0 And yy > 0 Then CurrentX = 
(xx - 1) * 8: CurrentY = (yy - 1) * 16 
Case "J": bbs.Picture = LoadPicture(): bbs.Cls 
End Select 
Case 7: Beep 
Case 8: If CurrentX > 0 Then CurrentX = CurrentX - 8 
Case 13: CurrentX = 0 
Case 0 
Case 10: CurrentY = CurrentY + 16: If CurrentY >= 384 Then CurrentY = 
CurrentY - 16: bbs.Picture = bbs.Image: PaintPicture bbs.Picture, 0, -16: oy 

= oy - 16 
Case Else 
p& = -1 
If b < 128 Then LL = 0: p& = b 
If b >= 128 And LL = 0 Then LL = b Else p& = LL * 256& + b: LL = 0 
If p& > 256 Then l = 16 Else l = 8 
x = CurrentX: y = CurrentY: F = Fcolor: b = Bcolor 
If Reverse Then t = F: F = b: b = t 
ForeColor = QBColor(F) 
If p& >= 0 Then Line (x, y)-Step(l - 1, 15), QBColor(b), BF: CurrentX = x: 
CurrentY = y: Print Chr$(p&);: CurrentX = x + l 
End Select 
L2: Wend 
End Sub 

Private Sub Winsock1_Close() 
End 
End Sub 

--
※ 来源:·BBS 水木清华站 bbs.net.tsinghua.edu.cn·[FROM: 202.119.45.54] 
--
※ 转载:．哈工大紫丁香 bbs.hit.edu.cn．[FROM: 202.118.226.245]