frmserver.frm

1.打开文件。在服务器计算机上运行服务器可执行程序

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmserver 
   Caption         =   "server"
   ClientHeight    =   5310
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   6150
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   5310
   ScaleWidth      =   6150
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton exit 
      Caption         =   "退出"
      Height          =   375
      Left            =   4560
      TabIndex        =   4
      Top             =   4800
      Width           =   735
   End
   Begin VB.CommandButton Command1 
      Caption         =   "清空"
      Height          =   375
      Left            =   2640
      TabIndex        =   1
      Top             =   4800
      Width           =   735
   End
   Begin VB.TextBox txtreceive 
      Height          =   4455
      Left            =   600
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Top             =   240
      Width           =   4815
   End
   Begin MSWinsockLib.Winsock sckServer 
      Index           =   0
      Left            =   5520
      Top             =   1440
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock sckBusy 
      Left            =   5520
      Top             =   840
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock sckListen 
      Left            =   5520
      Top             =   240
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Caption         =   "Label2"
      Height          =   255
      Left            =   1320
      TabIndex        =   3
      Top             =   4920
      Width           =   2655
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "本机IP地址:"
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   4920
      Width           =   1095
   End
End
Attribute VB_Name = "frmserver"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private intmax As Integer  '定义联入线的最大值

Private Sub Command1_Click()
txtreceive.Text = ""
End Sub

Private Sub exit_Click()
Unload Me
End Sub

Private Sub Form_Load()
    Dim i As Integer
    intmax = 15
     For i = 1 To intmax - 1
     Load sckServer(i)
    Next i
    sckListen.LocalPort = 1011
    sckListen.Listen
    Label2.Caption = sckListen.LocalIP
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 intmax - 1
     If sckServer(i).State = sckClosed Then
      Exit For
     End If
    Next i
    If sckServer(i).State = sckClosed 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 = 1011
    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 intmax - 1
     If sckServer(i).State = sckConnected Then
     sckServer(i).SendData Trim(s)
     DoEvents
     End If
    Next i
    txtreceive.Text = txtreceive.Text + Chr$(13) + Chr$(10) + 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