📄 server.frm
字号:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmServer
Caption = "QICQ服务器"
ClientHeight = 2805
ClientLeft = 60
ClientTop = 345
ClientWidth = 5115
Icon = "Server.frx":0000
LinkTopic = "Form1"
ScaleHeight = 2805
ScaleWidth = 5115
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton cmdClose
Caption = "关闭系统"
Height = 495
Left = 3720
TabIndex = 7
Top = 360
Width = 1215
End
Begin VB.CommandButton cmdBc
Caption = "广播"
Height = 495
Left = 3720
TabIndex = 6
Top = 1440
Width = 1215
End
Begin VB.CommandButton txtDB
Caption = "用户管理"
Height = 495
Left = 3720
TabIndex = 5
Top = 2040
Width = 1215
End
Begin VB.CommandButton cmdCon
Caption = "连接管理"
Height = 495
Left = 2400
TabIndex = 4
Top = 2040
Width = 1215
End
Begin VB.CommandButton cmdSent
Caption = "发送信息"
Height = 495
Left = 2400
TabIndex = 3
Top = 1440
Width = 1215
End
Begin VB.CommandButton cmdPort
Caption = "设置"
Height = 375
Left = 480
TabIndex = 2
Top = 1200
Width = 855
End
Begin VB.TextBox txtPort
Height = 270
Left = 480
TabIndex = 1
Top = 720
Width = 975
End
Begin MSWinsockLib.Winsock wskServer
Index = 0
Left = 4080
Top = 0
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.Label Label2
Caption = "设置端口号："
Height = 255
Left = 480
TabIndex = 0
Top = 420
Width = 1215
End
End
Attribute VB_Name = "frmServer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'连接的个数
Public intConnectCount As Integer
Private Sub cmdClose_Click()
'关闭所有的连接！
CloseAll
End Sub
Private Sub cmdPort_Click()
MsgBox "在这里设置服务器QICQ端口，在设置前，先端口所有的连接！"
End Sub
Private Sub Command1_Click()
MsgBox "管理员可以向某人发送信息！"
End Sub
Private Sub Command2_Click()
MsgBox "管理员对某连接进行管理！"
End Sub
Private Sub Command3_Click()
MsgBox "管理员在这里对所有的连接进行广播！"
End Sub
Private Sub Form_Load()
'初始化
txtPort.Text = "716"
intConnectCount = 0
wskServer(0).LocalPort = 716
wskServer(0).Listen
g_bClose = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
If Not g_bClose Then
MsgBox "请先关闭系统！", vbInformation, "关闭"
Cancel = 1
End If
End Sub
Private Sub txtDB_Click()
MsgBox "管理员在这里针对某用户的注册信息进行管理。"
End Sub
Private Sub wskServer_ConnectionRequest(Index As Integer, ByVal requestID As Long)
If g_bClose = False Then
If Index = 0 Then
'增加
intConnectCount = intConnectCount + 1
Load wskServer(intConnectCount)
End If
'随机端口
wskServer(intConnectCount).LocalPort = 0
wskServer(intConnectCount).Accept requestID
End If
' MsgBox CStr(intConnectCount)
End Sub
Private Sub wskServer_DataArrival(Index As Integer, ByVal bytesTotal As Long)
'开始接收数据
Dim k As Long
Dim strSub As String
Dim varData As String
Dim location As Integer
Dim strusername As String
Dim strConQuery As String
Dim port As Long
location = 0
wskServer(Index).GetData varData, vbString
g_strIP = wskServer(Index).RemoteHostIP
g_intPort = CLng(wskServer(Index).RemotePort)
Select Case Left(varData, 7)
Case "QICQREG"
'注册信息
varData = Right(varData, Len(varData) - 7)
Do While location < 9
k = InStr(1, varData, "QICQREG", vbTextCompare)
strSub = Left(varData, k - 1)
location = location + 1
varData = Right(varData, Len(varData) - k - 6)
Select Case location
Case 1
g_strName = strSub
Case 2
g_strPwd = strSub
Case 3
g_strNickName = strSub
Case 4
g_intImg = Int(strSub)
Case 5
If strSub <> "" Then
g_intAge = Int(strSub)
Else
g_intAge = -1
End If
Case 6
g_intSex = Int(strSub)
Case 7
g_strEmail = strSub
Case 8
g_strAddress = strSub
Case 9
g_strIntroduce = strSub
End Select
Loop
'注册新用户
RegisterNewUser Index
Case "QICQLOG"
'登录信息
varData = Right(varData, Len(varData) - 7)
Do While location < 2
k = InStr(1, varData, "QICQLOG", vbTextCompare)
strSub = Left(varData, k - 1)
location = location + 1
varData = Right(varData, Len(varData) - k - 6)
Select Case location
Case 1
g_strName = strSub
Case 2
g_strPwd = strSub
End Select
Loop
'用户登录
'MsgBox g_strName & g_strPwd
Loginuser Index
Case "QICQOUT"
'注销
'MsgBox varData
varData = Right(varData, Len(varData) - 7)
Do While location < 2
k = InStr(1, varData, "QICQOUT", vbTextCompare)
strSub = Left(varData, k - 1)
location = location + 1
varData = Right(varData, Len(varData) - k - 6)
Select Case location
Case 1
g_strName = strSub
Case 2
g_strPwd = strSub
End Select
Loop
Logoutuser Index
Case "QICQFND"
'查找
varData = Right(varData, Len(varData) - 7)
If varData = "all" Then
Findalluser Index
Else
End If
Case "QICQFAD"
'增加好友
varData = Right(varData, Len(varData) - 7)
Addfrd varData, Index
Case "QICQHAD"
'增加坏人
varData = Right(varData, Len(varData) - 7)
AddHate varData, Index
Case "QICQRTC"
'申请与网友二人世界连接
varData = Right(varData, Len(varData) - 7)
Do While location < 2
k = InStr(1, varData, ",", vbTextCompare)
strSub = Left(varData, k - 1)
location = location + 1
varData = Right(varData, Len(varData) - k)
Select Case location
Case 1
strusername = strSub
Case 2
port = CLng(strSub)
End Select
Loop
strConQuery = varData
SendTwoRequest Index, strusername, port, strConQuery
Case "QICQATC"
'二人世界回答
varData = Right(varData, Len(varData) - 7)
k = InStr(1, varData, ",", vbTextCompare)
strSub = Left(varData, k - 1)
varData = Right(varData, Len(varData) - k)
SendTwoResponse Index, CLng(strSub), varData
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -