frmserver.frm

用VB做的简单的局域网通信程序

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmServer 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "服务器端 Server"
   ClientHeight    =   3240
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4545
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3240
   ScaleWidth      =   4545
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.CheckBox jixieshou 
      Caption         =   "jixieshou"
      Height          =   375
      Left            =   2880
      TabIndex        =   10
      Top             =   2640
      Value           =   1  'Checked
      Width           =   1335
   End
   Begin VB.CheckBox yeya 
      Caption         =   "yeya"
      Height          =   375
      Left            =   1680
      TabIndex        =   9
      Top             =   2640
      Width           =   1095
   End
   Begin VB.CheckBox chechuang 
      Caption         =   "chechuang"
      Height          =   375
      Left            =   2880
      TabIndex        =   8
      Top             =   2160
      Width           =   1335
   End
   Begin VB.CheckBox xichuang 
      Caption         =   "xichaung"
      Height          =   375
      Left            =   1680
      TabIndex        =   7
      Top             =   2160
      Value           =   1  'Checked
      Width           =   1095
   End
   Begin VB.ListBox List1 
      Height          =   1140
      Left            =   2880
      TabIndex        =   4
      Top             =   600
      Width           =   1575
   End
   Begin MSWinsockLib.Winsock wsckServer 
      Index           =   0
      Left            =   960
      Top             =   2400
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Frame Frame1 
      Caption         =   "收到的命令"
      Height          =   1335
      Left            =   120
      TabIndex        =   1
      Top             =   480
      Width           =   2655
      Begin VB.TextBox Text1 
         Height          =   975
         Left            =   120
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   2
         Text            =   "frmServer.frx":0000
         Top             =   240
         Width           =   2415
      End
   End
   Begin VB.CommandButton Command1 
      Caption         =   "退出"
      Height          =   375
      Left            =   120
      TabIndex        =   0
      Top             =   1920
      Width           =   1215
   End
   Begin MSWinsockLib.Winsock wsckListener 
      Left            =   360
      Top             =   2400
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "个客户端连接到本服务器"
      Height          =   180
      Left            =   840
      TabIndex        =   6
      Top             =   120
      Width           =   1980
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "0"
      Height          =   180
      Left            =   600
      TabIndex        =   5
      Top             =   120
      Width           =   90
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "共有"
      Height          =   180
      Left            =   120
      TabIndex        =   3
      Top             =   120
      Width           =   360
   End
End
Attribute VB_Name = "frmServer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
    '定义常量
    Const BUSY   As Boolean = False
    Const FREE   As Boolean = True
    '定义连接状态
    Dim ConnectState()     As Boolean
Private Sub Form_Load()
    ReDim Preserve ConnectState(0 To 1)
    On Error Resume Next
    ConnectState(0) = FREE
    ConnectState(1) = FREE
    With wsckListener
        .LocalPort = 3025
        .Bind
        .Listen
    End With
    
End Sub

Private Sub wsckListener_Close()
    With wsckListener
        .Close
        .Listen
    End With
End Sub

Private Sub wsckListener_ConnectionRequest(ByVal requestID As Long)
    Dim SockIndex As Integer
    Dim SockNum As Integer
    On Error Resume Next
    'Text1.Text = requestID & "连接请求"
    '查找连接的用户数
    SockNum = UBound(ConnectState)
    If SockNum > 99 Then
        'Text1.Text = SockIndex & ""
        Exit Sub
    End If
    '查找空闲的sock
    SockIndex = FindFreeSocket()
    '如果已有的sock都忙，而且sock数不超过100个，动态添加sock
    If SockIndex > SockNum Then
        Load wsckServer(SockIndex)
    End If
    ConnectState(SockIndex) = BUSY
    wsckServer(SockIndex).Tag = SockIndex
    '接受请求
    wsckServer(SockIndex).Accept (requestID)
    List1.AddItem SockIndex & "接受请求"
    Label2.Caption = SockIndex + 1
End Sub

'客户断开，关闭相应的sock
Private Sub wsckServer_Close(Index As Integer)
    If wsckServer(Index).State <> sckClosed Then
        wsckServer(Index).Close
    End If
    ConnectState(Index) = FREE
    List1.AddItem Index & "退出连接"
    Label2.Caption = Val(Label2.Caption) - 1
End Sub
      
'接收数据
Private Sub wsckServer_DataArrival(Index As Integer, ByVal bytesTotal As Long)
    Dim dx As String
    'Text1.Text = "数据来自" & Index
    wsckServer(Index).GetData dx
    Frame1.Caption = "数据来自" & Index & "号客户端" & "内容是："
    Text1.Text = dx
    'wsckServer(Index).SendData "命令执行成功"
    Select Case Text1.Text
        Case "xichaung"
            If xichuang.Value = 1 Then
                wsckServer(Index).SendData "mang"
            Else
                xichuang.Value = 1
                wsckServer(Index).SendData "xian"
            End If
        Case "chechuang"
            If chechuang.Value = 1 Then
                wsckServer(Index).SendData "mang"
            Else
                chechuang.Value = 1
                wsckServer(Index).SendData "xian"
            End If
        Case "yeya"
            If yeya.Value = 1 Then
                wsckServer(Index).SendData "mang"
            Else
                yeya.Value = 1
                wsckServer(Index).SendData "xian"
            End If
        Case "jixieshou"
            If jixieshou.Value = 1 Then
                wsckServer(Index).SendData "mang"
            Else
                jixieshou.Value = 1
                wsckServer(Index).SendData "xian"
            End If
        Case "clearall"
            jixieshou.Value = 0
            xichuang.Value = 0
            chechuang.Value = 0
            yeya.Value = 0
    End Select
End Sub
      
'寻找空闲的sock
Public Function FindFreeSocket()
    Dim SockCount, i As Integer
    SockCount = UBound(ConnectState)
    For i = 0 To SockCount
        If ConnectState(i) = FREE Then
            FindFreeSocket = i
            Exit Function
        End If
    Next i
    ReDim Preserve ConnectState(0 To SockCount + 1)
    FindFreeSocket = UBound(ConnectState)
End Function