📄 frmclient.frm
字号:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmClient
BorderStyle = 1 'Fixed Single
Caption = "聊天室客户端 制作：陈德嘉"
ClientHeight = 6375
ClientLeft = 45
ClientTop = 330
ClientWidth = 9555
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 6375
ScaleWidth = 9555
StartUpPosition = 3 '窗口缺省
Begin VB.HScrollBar HScroll1
Height = 255
LargeChange = 100
Left = 120
Max = 780
SmallChange = 10
TabIndex = 9
Top = 4775
Width = 7550
End
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 4665
Left = 120
ScaleHeight = 4605
ScaleWidth = 7515
TabIndex = 6
Top = 120
Width = 7575
Begin VB.VScrollBar VScroll1
Height = 4605
LargeChange = 19
Left = 7245
Max = 19
Min = 19
TabIndex = 8
Top = 0
Value = 19
Width = 270
End
Begin VB.TextBox Text1
ForeColor = &H00808000&
Height = 4680
Left = -50
Locked = -1 'True
MultiLine = -1 'True
TabIndex = 7
Top = -50
Width = 15150
End
End
Begin VB.ListBox List1
BackColor = &H00C0C000&
ForeColor = &H00000000&
Height = 5820
Left = 7800
TabIndex = 5
Top = 360
Width = 1575
End
Begin VB.Frame Frame1
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1215
Left = 120
TabIndex = 0
Top = 5040
Width = 7575
Begin VB.CheckBox Check1
Caption = "私聊"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 120
TabIndex = 13
Top = 720
Width = 975
End
Begin VB.ComboBox Combo1
BackColor = &H00C0C000&
Height = 360
Left = 480
Style = 2 'Dropdown List
TabIndex = 11
Top = 240
Width = 1455
End
Begin VB.Timer Timer1
Interval = 1000
Left = 5520
Top = 720
End
Begin VB.CommandButton cmdExit
Caption = "退出"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6720
TabIndex = 4
Top = 720
Width = 615
End
Begin VB.CommandButton cmdCls
Caption = "清屏"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4200
TabIndex = 3
Top = 720
Width = 735
End
Begin VB.CommandButton cmdSend
Caption = "发送 < Enter>"
Default = -1 'True
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2160
TabIndex = 2
Top = 720
Width = 1935
End
Begin VB.TextBox txtSend
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2520
TabIndex = 1
Top = 240
Width = 4815
End
Begin VB.Label Label3
Caption = "说："
Height = 255
Left = 2040
TabIndex = 12
Top = 300
Width = 615
End
Begin VB.Label Label2
Caption = "对："
Height = 255
Left = 120
TabIndex = 10
Top = 300
Width = 495
End
End
Begin MSWinsockLib.Winsock sckClient
Left = 360
Top = 3960
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.Label Label1
BackColor = &H00D38F3D&
BorderStyle = 1 'Fixed Single
Caption = " 0人在线"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Left = 7800
TabIndex = 14
Top = 120
Width = 1575
End
End
Attribute VB_Name = "frmClient"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Hig As Long
Dim con As Integer
Private Sub ConnectServer()
On Error GoTo ErrorPro
sckClient.Connect
Exit Sub
ErrorPro:
MsgBox "服务器未开或网络出错！"
End
End Sub
Private Sub cmdSend_Click()
Dim recUser As String
recUser = Combo1.Text
If Combo1.Text <> "所有人" Then recUser = "<" & recUser & ">"
If Check1.Value = 0 Or Combo1.Text = "所有人" Then
sckClient.SendData "<" & userName & ">" & "对" & recUser & "说：" & txtSend.Text
DoEvents
Else
sckClient.SendData Combo1.Text & "038868SendToOne" & "<" & userName & ">" & "悄悄对" & recUser & "说：" & txtSend.Text
DoEvents
End If
txtSend.Text = ""
End Sub
Private Sub cmdCls_Click()
Text1.Text = ""
Text1.Height = 4680
Text1.Top = -50
VScroll1.Max = 19
VScroll1.Min = 19
Hig = 19
con = 0
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub Command1_Click()
sckClient.SendData Text2.Text
End Sub
Private Sub Form_Load()
Hig = 19
' RemoteComputerName为服务器端的计算机名或IP地址。
Msgnum = 0
connecting_Time = 0 '连接用去的秒数
connect_OutTime = 3 ' 连接超时时限为3秒
sckClient.RemoteHost = ServerIP
sckClient.RemotePort = 1000
Call ConnectServer
Combo1.AddItem "所有人"
Combo1.ListIndex = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
sckClient.Close
End Sub
Private Sub HScroll1_Change()
Text1.Left = -50 - HScroll1.Value * 10
End Sub
Private Sub sckClient_Close()
MsgBox "服务器通道已关闭！", 0 + 16 + 0, "聊天室客户端"
End
End Sub
Private Sub sckClient_Connect()
sckClient.SendData userName
If InStr(1, userName, "*") = 1 Then
userName = Right(userName, Len(userName) - 1)
End If
End Sub
Private Sub sckClient_DataArrival(ByVal bytesTotal As Long)
Dim s As String
Msgnum = Msgnum + 1
sckClient.GetData s
If InStr(1, s, "SystemOrder:") = 1 Then
If s = "SystemOrder:服务器忙，请稍后再连接！" Then
sckClient.Close
MsgBox "聊天室人满为患，请稍后再进！"
frmLogin.Command1.Enabled = True
Unload Me
Exit Sub
End If
If s = "SystemOrder:IP重复，客户端退出重进！" Then
sckClient.Close
MsgBox "您不能使用同一个IP地址重复登录！"
frmLogin.Command1.Enabled = True
Unload Me
Exit Sub
End If
If s = "SystemOrder:姓名重复，客户端退出重进！" Then
sckClient.Close
MsgBox "很抱歉，这个姓名有人正在使用，请换一个再试！"
frmLogin.Command1.Enabled = True
Unload Me
Exit Sub
End If
If s = "SystemOrder:boot" Then
sckClient.Close
MsgBox "很抱歉，你被管理员踢出！"
Unload Me
Exit Sub
End If
If InStr(1, s, "SystemOrder:addtolist") = 1 Then
s = Right(s, Len(s) - 21)
Call GetUsersName(s)
If sckClient.State = 7 Then Timer1.Enabled = False
frmClient.Show
Unload frmLogin
Exit Sub
End If
If InStr(1, s, "SystemOrder:removefromlist") = 1 Then
Call RemoveFromlist(s)
Exit Sub
End If
End If
Call AddToText1(s)
End Sub
Private Sub sckClient_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)
Unload Me
MsgBox "连接服务器失败！", 0 + 16 + 0, "聊天室客户端"
frmLogin.Command1.Enabled = True
End Sub
Private Sub AddToList(ss As String)
Combo1.AddItem ss
List1.AddItem ss
Label1.Caption = " " & List1.ListCount & "人在线"
End Sub
Private Sub RemoveFromlist(ss As String)
Dim olduser As String
olduser = Right(ss, Len(ss) - 26)
For i = 0 To List1.ListCount - 1
If List1.List(i) = olduser Then Exit For
Next
List1.RemoveItem i
Combo1.RemoveItem i + 1
Combo1.ListIndex = 0
Label1.Caption = " " & List1.ListCount & "人在线"
End Sub
Private Sub GetUsersName(s As String)
Dim user As String
Dim i As Integer
i = 0
s = Trim(s)
If s = "" Then Exit Sub
user = dividemsgleft(s, "038868")
Call AddToList(user)
s = Trim(dividemsgright(s, "038868"))
GetUsersName (s)
End Sub
Private Function dividemsgleft(s1 As String, s2 As String)
dividemsgleft = Left(s1, InStr(1, s1, s2) - 1)
End Function
Private Function dividemsgright(s1 As String, s2 As String)
dividemsgright = Right(s1, Len(s1) - InStr(1, s1, s2) - 5)
End Function
Private Sub AddToText1(s As String)
con = con + 1
If con > 19 Then
Text1.Height = Text1.Height + 4560 / 19
VScroll1.Min = VScroll1.Min + 1
Text1.Top = Text1.Top - 4560 / 19
End If
Text1.Text = Text1.Text & s & Chr(13) & Chr(10)
End Sub
Private Sub Timer1_Timer()
If connecting_Time < connect_OutTime Then
connecting_Time = connecting_Time + 1
Exit Sub
End If
If sckClient.State = 7 Then
Timer1.Enabled = False
Exit Sub
Else
Unload Me
MsgBox "连接服务器失败！", 0 + 16 + 0, "聊天室客户端"
frmLogin.Command1.Enabled = True
End If
End Sub
Private Sub VScroll1_Change()
ChangHeight = VScroll1.Value - Hig
Text1.Top = Text1.Top + ChangHeight * (4560 / 19)
Hig = VScroll1.Value
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -