📄 wuziserver.frm
字号:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form WuziServer
BorderStyle = 4 'Fixed ToolWindow
Caption = "五子棋服务器端程序"
ClientHeight = 6345
ClientLeft = 2265
ClientTop = 1725
ClientWidth = 7365
Icon = "WuziServer.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6345
ScaleWidth = 7365
Begin VB.Frame Frame1
BorderStyle = 0 'None
Height = 1215
Left = 120
TabIndex = 10
Top = 4680
Width = 2175
Begin VB.OptionButton Option1
Caption = "Private"
Height = 255
Index = 0
Left = 1080
TabIndex = 12
Top = 840
Width = 975
End
Begin VB.OptionButton Option1
Caption = "Shout"
Height = 375
Index = 1
Left = 1080
TabIndex = 11
Top = 120
Width = 975
End
Begin VB.Label Label1
Caption = "选择方式"
Height = 495
Left = 240
TabIndex = 13
Top = 480
Width = 495
End
End
Begin VB.ListBox UserName
Height = 2040
ItemData = "WuziServer.frx":0442
Left = 2400
List = "WuziServer.frx":0444
TabIndex = 9
Top = 3840
Width = 1335
End
Begin VB.CommandButton Send
Caption = "发送"
Height = 375
Left = 3960
TabIndex = 8
Top = 4320
Width = 735
End
Begin VB.TextBox MessageSend
Height = 375
Left = 3960
TabIndex = 7
Top = 3840
Width = 3255
End
Begin VB.TextBox FormerMessageBox
Height = 3615
Left = 4320
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 6
Top = 120
Width = 2895
End
Begin VB.CommandButton cmdOpen
Caption = "以前信息"
Height = 375
Left = 120
TabIndex = 5
Top = 3840
Width = 1095
End
Begin VB.CommandButton cmdSave
Caption = "保存信息"
Height = 375
Left = 120
TabIndex = 4
Top = 4200
Width = 1095
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 4320
Top = 120
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 3
Top = 5970
Width = 7365
_ExtentX = 12991
_ExtentY = 661
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 3
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 7805
Text = "五子棋服务器端程序"
TextSave = "五子棋服务器端程序"
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 6
TextSave = "2005-6-14"
EndProperty
BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 5
TextSave = "22:35"
EndProperty
EndProperty
End
Begin VB.CommandButton Clear
Caption = "清屏"
Height = 375
Left = 1200
TabIndex = 2
Top = 4200
Width = 1095
End
Begin MSWinsockLib.Winsock Winsocks
Index = 0
Left = 5760
Top = 5040
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.CommandButton Users
Caption = "在线用户"
Height = 375
Left = 1200
TabIndex = 1
Top = 3840
Width = 1095
End
Begin VB.TextBox MessageBox
Height = 3615
Left = 120
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 0
Top = 120
Width = 4095
End
Begin MSWinsockLib.Winsock TCP1
Left = 120
Top = 5040
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.Menu mnuFile
Caption = "&File"
Begin VB.Menu mnuSave
Caption = "&Save"
End
Begin VB.Menu mnuOpen
Caption = "&Open"
End
Begin VB.Menu mnuExit
Caption = "&Exit"
End
End
End
Attribute VB_Name = "WuziServer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const MaxConnect = 8
Dim UserId As Integer
Dim UserInformation(MaxConnect) As UserInfo
'说明是否任连接到服务器
Dim UsersConnect(MaxConnect) As Boolean
'记录某人对局对方的索引号
Dim OpponentPlayNum(MaxConnect) As Integer
'说明某人是否在对局
Dim EveryOnePlaying(MaxConnect) As Boolean
'存放对局的每步信息
Dim Buffer(MaxConnect) As String
'存放每个人对局信息的索引，如果为i，在表示存在buffer(i)中
Dim PlayInfoNum(MaxConnect) As Integer
'记录每盘比赛的观战人数
Dim Watchers(MaxConnect, MaxConnect) As Integer
'记录总棋局数
Dim TotalQiJuShu As Integer
'记录聊天的方式
Dim TalkStyle As Integer
Private Sub Clear_Click()
Dim answer As Integer
answer = MsgBox("需要寸盘吗？", vbYesNo)
If answer = vbYes Then
cmdSave_Click
End If
MessageBox.Text = ""
End Sub
Private Sub cmdOpen_Click()
Dim Str As String
CommonDialog1.Filter = "*.mes|*.mes"
CommonDialog1.ShowOpen
FormerMessageBox.Text = ""
FileName = CommonDialog1.FileName
If FileName <> "" Then
FileNum = FreeFile
Open FileName For Input As FileNum
Do While Not EOF(FileNum)
Line Input #FileNum, Str
FormerMessageBox.Text = FormerMessageBox.Text & Str & _
vbCrLf
Loop
Close #FileNum
End If
End Sub
Private Sub cmdSave_Click()
If MessageBox.Text <> "" Then
CommonDialog1.Filter = "*.mes|*.mes"
CommonDialog1.ShowSave
FileName = CommonDialog1.FileName
FileNum = FreeFile
Open FileName For Output As FileNum
Print #FileNum, MessageBox.Text
Close #FileNum
End If
End Sub
Private Sub Form_Load()
UserId = 0
With TCP1
' intMax = 0
' WuziServer(0).LocalPort = 1001
' WuziServer(0).Listen
.Protocol = 0
.LocalPort = 2002
.Listen
End With
End Sub
Private Sub MessageBox_Change()
End Sub
Private Sub mnuExit_Click()
Unload Me
End Sub
Private Sub Option1_Click(Index As Integer)
TalkStyle = Index
End Sub
Private Sub Send_Click()
If MessageSend.Text <> "" Then
If Left(MessageSend.Text, 1) <> "/" Then
Select Case TalkStyle
Case 0
For i = 1 To MaxConnect
If UsersConnect(i) Then
Winsocks(i).SendData "/3:" & MessageSend.Text
DoEvents
End If
Next i
Case 1
tempname = UserName.List(UserName.ListIndex)
For j = 1 To MaxConnect
If UsersConnect(j) Then
If UserInformation(j).NickName = tempname Then
Winsocks(j).SendData "/4:管理员<只对你说>" & MessageSend.Text
Exit For
End If
End If
Next j
End Select
End If
End If
End Sub
Private Sub TCP1_ConnectionRequest(ByVal requestID As Long)
Dim i As Long
'MaxConnect为最大连接数
For i = 1 To MaxConnect
'利用usersconnect（i）数组来保存winsock控件数组得使用情况
If Not UsersConnect(i) Then
UsersConnect(i) = True
Exit For
End If
Next i
If i > MaxConnect Then
Exit Sub
End If
'winsocks（i）为控件数组
Load Winsocks(i)
If Winsocks(i).State <> sckClosed Then
Winsocks(i).Close
End If
Winsocks(i).Accept requestID
'实际登陆人数
UserId = UserId + 1
'实际建立连接
'Winsocks(i).Accept requestID
'开始发送数据,发送某个用户的索引号
Winsocks(i).SendData "/0:" & i
End Sub
'Private Sub Wuziserver_ConnectionRequest _
'(Index As Integer, ByVal requestID As Long)
' If Index = 0 Then
' intMax = intMax + 1
' Load sckServer(intMax)
' sckServer(intMax).LocalPort = 0
' sckServer(intMax).Accept requestID
' Load txtData(intMax)
' End If
'End Sub
Private Sub Users_Click()
For i = 1 To MaxConnect
If UsersConnect(i) Then
MessageBox.Text = MessageBox.Text + UserInformation(i).NickName + Chr$(13) + Chr$(10)
UserName.AddItem UserInformation(i).NickName
End If
Next
End Sub
Private Sub Winsocks_Close(Index As Integer)
'关闭连接
Winsocks(Index).Close
'卸栽winsock控件
Unload Winsocks(Index)
UsersConnect(Index) = False
For i = 1 To MaxConnect
If UsersConnect(i) Then
Winsocks(i).SendData "/Q:" & UserInformation(Index).NickName
DoEvents
End If
Next i
End Sub
Private Sub Winsocks_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim Information As String
'Dim TempNum As Integer
Dim TempNum1 As Integer
Dim Alluser As String
Alluser = ""
On Error Resume Next
Winsocks(Index).GetData Information
If Left(Information, 1) = "/" Then
Select Case Mid$(Information, 2, 1)
Case 1
TempNum1 = InStr(1, Information, ":", vbTextCompare)
UserInformation(Index).NickName = Mid$(Information, TempNum1 _
+ 1, InStr(TempNum1 + 1, Information, ":", vbTextCompare) - _
TempNum1 - 1)
TempNum1 = InStr(TempNum1 + 1, Information, ":", vbTextCompare)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -