frmserver.frm

简单的聊天程序！很好用的。你会很容易地自己编写出自己的聊天程序。

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "mswinsck.ocx"
Begin VB.Form Server 
   BackColor       =   &H80000013&
   Caption         =   "Form1"
   ClientHeight    =   6660
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   6435
   LinkTopic       =   "Form1"
   ScaleHeight     =   6660
   ScaleWidth      =   6435
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton cmdexit 
      BackColor       =   &H00400000&
      Caption         =   "退出"
      Height          =   495
      Left            =   4440
      MaskColor       =   &H00FFFF80&
      TabIndex        =   1
      Top             =   5760
      Width           =   1575
   End
   Begin VB.ListBox lstReceive 
      Height          =   5280
      ItemData        =   "frmServer.frx":0000
      Left            =   1080
      List            =   "frmServer.frx":0002
      TabIndex        =   0
      Top             =   120
      Width           =   4935
   End
   Begin MSWinsockLib.Winsock sckBusy 
      Left            =   360
      Top             =   2520
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock sckListen 
      Left            =   360
      Top             =   1560
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock sckServer 
      Index           =   0
      Left            =   360
      Top             =   480
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
End
Attribute VB_Name = "Server"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private MaxChan As Integer


Private Sub cmdexit_Click()
End
End Sub

Private Sub Form_Load()

Dim i As Integer

MaxChan = 15

For i = 1 To MaxChan - 1

Load sckServer(i)

Next i

sckListen.LocalPort = 1001

sckListen.Listen

End Sub



Private Sub sckBusy_Close()

sckBusy.Close

End Sub



Private Sub sckBusy_DataArrival(ByVal bytesTotal As Long)

sckBusy.SendData "服务器忙，请稍后再连接！"

DoEvents

End Sub



Private Sub sckListen_ConnectionRequest(ByVal requestID As Long)

Dim i As Integer

'决定由哪一Winsock接受请求

For i = 0 To MaxChan - 1

If sckServer(i).State = 0 Then

Exit For

End If

Next i

If sckServer(i).State = 0 Then

sckServer(i).Accept requestID

Exit Sub

End If

'如果所有Winsock都用完则由专门的“忙”Winsock接受请求，以免用户要求得不到响应

sckBusy.Close

sckBusy.Accept requestID

End Sub



Private Sub sckListen_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)

sckListen.Close

sckListen.LocalPort = 1000

sckListen.Listen

End Sub



Private Sub sckServer_Close(Index As Integer)

sckServer(Index).Close

End Sub



Private Sub sckServer_DataArrival(Index As Integer, ByVal bytesTotal As Long)

Dim s As String

Dim i As Integer

sckServer(Index).GetData s



For i = 0 To MaxChan - 1

'利用winsock的State属性给所有连接在服务器上的客户发消息

If sckServer(i).State = 7 Then

sckServer(i).SendData "Channel " & Index & " " & Trim(s)

DoEvents



End If
Next i

lstReceive.AddItem "Channel " & Index & " " & Trim(s)

End Sub



Private Sub sckServer_Error(Index As Integer, 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)

sckServer(Index).Close

End Sub