寻求源代码，有关于服务器端的，100分相送！

是啊,用email发都发过不过来了,等一下,我把我那个源码给你贴过来吧

解决方案 »

  1.   

    这是服务器的,label你不用管,那是管提示用的Dim nSocket As Integer
    Private Sub Form_Load()
        srSocket(0).LocalPort = 1549
        srSocket(0).Listen
    End Sub
    Private Sub srSocket_Close(Index As Integer)
        lblRemoteHost(Index).Caption = ""
        lblInfo(Index).Caption = "此连接已经断开"
        srSocket(Index).Close
        Unload srSocket(Index)
    End Sub
    Private Sub srSocket_ConnectionRequest(Index As Integer, ByVal requestID As Long)
        nSocket = nSocket + 1
        Load srSocket(nSocket)
        srSocket(nSocket).Accept requestID
        lblRemoteHost(nSocket).Caption = srSocket(nSocket).RemoteHostIP
    End Sub
    Private Sub srSocket_DataArrival(Index As Integer, ByVal bytesTotal As Long)
        Dim Rec As String
        srSocket(Index).GetData Rec, vbString
        lblInfo(Index).Caption = Rec
    End Sub
      

  2.   

    这是客户端的Private Sub clSocket_Close()
        clSocket.Close
        MsgBox "连接已经断开"
    End SubPrivate Sub clSocket_Connect()
        clSocket.SendData "客户端已成功登录"
    End SubPrivate Sub cmdJoin_Click()
        clSocket.RemoteHost = "10.2.6.84"
        clSocket.RemotePort = 1549
        clSocket.Connect
    End Sub
    Private Sub cmdSendData_Click()
        Static num As Integer
        num = num + 1
        clSocket.SendData Str(num)
    End Sub
    Private Sub cmdCutoff_Click()
        Call clSocket_Close
    End Sub
      

  3.   

    别忘了把IP改了,那是我机器的IP
      

  4.   

    一个MSDN关于Winsock的例子：
    Accepting More than One Connection RequestThe basic server outlined above accepts only one connection request. However, it is possible to accept several connection requests using the same control by creating a control array. In that case, you do not need to close the connection, but simply create a new instance of the control (by setting its Index property), and invoking the Accept method on the new instance.The code below assumes there is a Winsock control on a form named sckServer, and that its Index property has been set to 0; thus the control is part of a control array. In the Declarations section, a module-level variable intMax is declared. In the form's Load event, intMax is set to 0, and the LocalPort property for the first control in the array  is set to 1001. Then the Listen method is invoked on the control, making it the "listening control. As each connection request arrives, the code tests to see if the Index is 0 (the value of the "listening" control). If so, the listening control increments intMax, and uses that number to create a new control instance. The new control instance is then used to accept the connection request.Private intMax As LongPrivate Sub Form_Load()
       intMax = 0
       sckServer(0).LocalPort = 1001
       sckServer(0).Listen
    End SubPrivate Sub sckServer_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
      

  5.   

    我有我有，前段日子做的，来信我给你好了
    [email protected]
      

  6.   

    '*********************server******************
    VERSION 5.00
    Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
    Begin VB.Form Form1 
       Caption         =   "Server"
       ClientHeight    =   4650
       ClientLeft      =   60
       ClientTop       =   345
       ClientWidth     =   4755
       LinkTopic       =   "Form1"
       ScaleHeight     =   4650
       ScaleWidth      =   4755
       StartUpPosition =   3  'Windows Default
       Begin VB.CommandButton cmdMsgBox 
          Caption         =   "Popup Message Box"
          Height          =   255
          Left            =   2400
          TabIndex        =   9
          Top             =   4320
          Width           =   2175
       End
       Begin VB.CommandButton cmdCaption 
          Caption         =   "Set their Caption"
          Height          =   255
          Left            =   120
          TabIndex        =   8
          Top             =   4320
          Width           =   2175
       End
       Begin VB.TextBox txtReceived 
          Height          =   1335
          Left            =   120
          MultiLine       =   -1  'True
          TabIndex        =   6
          Top             =   2880
          Width           =   4455
       End
       Begin VB.TextBox txtSendMessage 
          Height          =   285
          Left            =   2400
          TabIndex        =   4
          Top             =   480
          Width           =   2175
       End
       Begin VB.TextBox txtErrors 
          Height          =   1335
          Left            =   2400
          MultiLine       =   -1  'True
          TabIndex        =   2
          Top             =   1080
          Width           =   2175
       End
       Begin MSWinsockLib.Winsock wsArray 
          Index           =   0
          Left            =   4320
          Top             =   2520
          _ExtentX        =   741
          _ExtentY        =   741
          _Version        =   393216
          LocalPort       =   2500
       End
       Begin MSWinsockLib.Winsock wsListen 
          Left            =   0
          Top             =   2520
          _ExtentX        =   741
          _ExtentY        =   741
          _Version        =   393216
          LocalPort       =   2400
       End
       Begin VB.ListBox lstUsers 
          Height          =   2010
          Left            =   120
          TabIndex        =   0
          Top             =   360
          Width           =   2055
       End
       Begin VB.Label Label5 
          Alignment       =   2  'Center
          Caption         =   "(shift-enter to broadcast)"
          Height          =   255
          Left            =   2400
          TabIndex        =   10
          Top             =   240
          Width           =   2175
       End
       Begin VB.Label Label4 
          Alignment       =   2  'Center
          Caption         =   "Received"
          Height          =   255
          Left            =   120
          TabIndex        =   7
          Top             =   2640
          Width           =   4455
       End
       Begin VB.Label Label3 
          Alignment       =   2  'Center
          Caption         =   "Send Message"
          Height          =   255
          Left            =   2400
          TabIndex        =   5
          Top             =   0
          Width           =   2175
       End
       Begin VB.Label Label2 
          Alignment       =   2  'Center
          Caption         =   "Error Log"
          Height          =   255
          Left            =   2400
          TabIndex        =   3
          Top             =   840
          Width           =   2175
       End
       Begin VB.Label Label1 
          Alignment       =   2  'Center
          Caption         =   "Users"
          Height          =   255
          Left            =   120
          TabIndex        =   1
          Top             =   120
          Width           =   2055
       End
    End
    Attribute VB_Name = "Form1"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = False
    Attribute VB_PredeclaredId = True
    Attribute VB_Exposed = False
    ' We'll limit it to 101 users at a time! ;)
    Dim Users(0 To 100) As StringPrivate Sub cmdCaption_Click()
    Dim User As Integer
        ' Get Username to send to
        User = RetrieveUser(lstUsers.Text)
        If User = -1 Then
            MsgBox "Invalid User!", vbCritical, "Error"
            Exit Sub
        End If
        wsArray(User).SendData "c" & Chr(1) & InputBox("What do you want to have their caption set to?", "Alter Caption", "Hi!")
    End SubPrivate Sub cmdMsgBox_Click()
    Dim User As Integer
        ' Get Username to send to
        User = RetrieveUser(lstUsers.Text)
        If User = -1 Then
            MsgBox "Invalid User!", vbCritical, "Error"
            Exit Sub
        End If
        wsArray(RetrieveUser(lstUsers.Text)).SendData "m" & Chr(1) & InputBox("What do you want to have displayed on their machine?", "Popup MsgBox", "Hi!")
    End SubPrivate Sub Form_Load()
        wsListen.Listen  ' make it listen
    End SubPrivate Sub txtSendMessage_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim User As Integer
        
        'First, check to make sure someone's logged in
        If lstUsers.ListCount = 0 And KeyCode = 13 Then
        
            'Display popup
            MsgBox "Nobody to send to!", vbExclamation, "Cannot send"
            
            'Clear input
            txtSendMessage.Text = ""
            Exit Sub
        End If    ' If it was enter and shift wasn't pressed, then...
        If KeyCode = 13 And Shift = 0 Then
            ' Get Username to send to
            User = RetrieveUser(lstUsers.Text)
            ' RetrieveUser returns -1 if the user wasn't found
            If User = -1 Then
                Exit Sub
            End If
            ' format the message
            wsArray(User).SendData "t" & Chr(1) & txtSendMessage.Text
            ' Blank the input
            txtSendMessage.Text = ""
        
        ElseIf KeyCode = 13 And Shift = 1 Then
            
            ' Loop through the users.
            ' There's better ways of doing this
            For X = 0 To 100
                
                ' If there's a username listed for them
                If Users(X) <> "" Then
                    
                    'Send the message
                    wsArray(X).SendData "t" & Chr(1) & txtSendMessage.Text
                    
                    ' Don't know why this needs to be
                    ' in here to work - someone tell me?
                    DoEvents
                End If
            Next X
            txtSendMessage.Text = ""
        End IfEnd SubPrivate Function RetrieveUser(UserName As String) As Integer
    Dim X As Integer    'Check to see if nothing was selected
        If UserName = "" Then
            
            'OK, nothing selected, let's see how full
            ' the list is!
            If lstUsers.ListCount = 0 Then
                
                'Nothing in the list, so return -1
                RetrieveUser = -1
                Exit Function
            End If
            
            'If there is something in the list, send it to
            ' the first one =)
            UserName = lstUsers.List(0)
        End If
        
        ' Count through the users
        For X = 0 To 100
            
            'Check username to see if it is the right one
            If Users(X) = UserName Then
            
                'Ok, this is our man, so let's return his
                ' winsock index
                RetrieveUser = X
                Exit Function
            End If
        Next X
        RetrieveUser = -1
    End FunctionPrivate Sub txtSendMessage_KeyPress(KeyAscii As Integer)
        'Let's get rid of the annoying beep =)
        If KeyAscii = 13 Then KeyAscii = 0
    End SubPrivate Sub wsArray_Close(Index As Integer)
        ' Let's cycle through the list, looking for their
        ' name
        For X = 0 To lstUsers.ListCount - 1
        
            ' Check to see if it matches
            If lstUsers.List(X) = Users(Index) Then
            
                ' It matches, so let's remove it form the
                ' list and the array
                Users(Index) = ""
                lstUsers.RemoveItem X
                
                Exit For
            End If
        Next X
    End SubPrivate Sub wsArray_DataArrival(Index As Integer, ByVal bytesTotal As Long)
    Dim Data As String, CtrlChar As String
        wsArray(Index).GetData Data
        
        ' Our format for our messages is this:
        ' CtrlChar & chr(1) & <info>
        If InStr(1, Data, Chr(1)) <> 2 Then
        ' If the 2nd char isn't chr(1), we know we have a prob
        
            MsgBox "Unknown Data Format: " & vbCrLf & _
                    Data, vbCritical, "Error receiving"
            ' Make sure to leave the sub so it doesn't
            ' try to process the invalid info!
            Exit Sub
        End If
        
        'Retrieve First Character
        CtrlChar = Left(Data, 1)
      
        'Make sure to trim it, and chr(1), off
        Data = Mid(Data, 3)
        
        ' Check what it is, without regard to case
        Select Case LCase(CtrlChar)
            
            'This is to display a msgbox.
            ' I didn't enable the ability on the clients --
            '  for obvious reasons ;)
            Case "m"
                MsgBox Data, vbInformation, "Msg from client"
            
            'This is to change the caption.
            ' I didn't enable the ability on the clients --
            '  for obvious reasons ;)
            Case "c"
                Me.Caption = "Server - " & Data
            
            'This is their "login" key
            Case "u"
            
                'Add their name to the list
                lstUsers.AddItem Data
                
                'Add their name to the array
                Users(Index) = Data
                
                ' We need to remember that both
                ' the winsock index and the user array
                ' index correspond.  So you can find a
                ' users name by going "Users(<winsock index>)"
                ' or you can find the winsock index with
                ' a text name by cycling through the array.
                ' That's what the function "RetrieveUser"
                ' does - gets their winsock index from their
                ' username
                
            ' If all else fails, print it to output =)
            Case Else
                txtReceived.SelStart = Len(txtReceived.Text)
                txtReceived.SelText = Data & vbCrLf
        End Select
    End SubPrivate Sub wsArray_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)
        
        ' This sets the "cursor" to the end of the textbox
        txtErrors.SelStart = Len(txtErrors.Text)
        
        ' This inserts the error message at the "cursor"
        txtErrors.SelText = "wsArray(" & Index & ") - " & Number & " - " & Description & vbCrLf
        
        ' Close it =)
        wsArray(Index).Close
        
    End SubPrivate Sub wsListen_ConnectionRequest(ByVal requestID As Long)
        Index = FindOpenWinsock
        
        ' Accept the request using the created winsock
        wsArray(Index).Accept requestID
    End SubPrivate Sub wsListen_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)
        
        ' This sets the "cursor" to the end of the textbox
        txtErrors.SelStart = Len(txtErrors.Text)
        
        ' This inserts the error message at the "cursor"
        txtErrors.SelText = "wsListen - " & Number & " - " & Description & vbCrLf
    End SubPrivate Function FindOpenWinsock()
    Static LocalPorts As Integer  ' Static keeps the
                                  ' variable's state
        
        For X = 0 To wsArray.UBound
            If wsArray(X).State = 0 Then
                
                ' We found one that's state is 0, which
                '  means "closed", so let's use it
                FindOpenWinsock = X
                
                ' make sure to leave function
                Exit Function
            End If
        Next X    '  OK, none are open so let's make one
        Load wsArray(wsArray.UBound + 1)
        
        '  Let's make sure we don't get conflicting local ports
        LocalPorts = LocalPorts + 1
        wsArray(wsArray.UBound).LocalPort = wsArray(wsArray.UBound).LocalPort + LocalPorts
        
        '  and then let's return it's index value
        FindOpenWinsock = wsArray.UBoundEnd Function'＊＊＊＊＊＊＊＊＊＊客戶端＊＊＊＊＊＊＊＊＊＊＊＊＊
    VERSION 5.00
    Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
    Begin VB.Form Form1 
       Caption         =   "Client"
       ClientHeight    =   3495
       ClientLeft      =   60
       ClientTop       =   345
       ClientWidth     =   3255
       LinkTopic       =   "Form1"
       ScaleHeight     =   3495
       ScaleWidth      =   3255
       StartUpPosition =   3  'Windows Default
       Begin VB.TextBox txtUserName 
          Height          =   285
          Left            =   1800
          TabIndex        =   5
          Top             =   120
          Width           =   1335
       End
       Begin VB.TextBox txtReceived 
          Height          =   1815
          Left            =   120
          MultiLine       =   -1  'True
          TabIndex        =   2
          Top             =   1560
          Width           =   3015
       End
       Begin VB.TextBox txtMessage 
          Enabled         =   0   'False
          Height          =   285
          Left            =   120
          TabIndex        =   1
          Top             =   840
          Width           =   3015
       End
       Begin MSWinsockLib.Winsock wsMain 
          Left            =   2880
          Top             =   240
          _ExtentX        =   741
          _ExtentY        =   741
          _Version        =   393216
          RemoteHost      =   "127.0.0.1"
          RemotePort      =   2400
       End
       Begin VB.CommandButton Command1 
          Caption         =   "Connect"
          Height          =   375
          Left            =   120
          TabIndex        =   0
          Top             =   120
          Width           =   855
       End
       Begin VB.Label Label3 
          Caption         =   "Name:"
          Height          =   255
          Left            =   1200
          TabIndex        =   6
          Top             =   120
          Width           =   495
       End
       Begin VB.Label Label2 
          Alignment       =   2  'Center
          Caption         =   "Send Message"
          Height          =   255
          Left            =   120
          TabIndex        =   4
          Top             =   600
          Width           =   3015
       End
       Begin VB.Label Label1 
          Alignment       =   2  'Center
          Caption         =   "Received From Server"
          Height          =   255
          Left            =   120
          TabIndex        =   3
          Top             =   1320
          Width           =   3015
       End
    End
    Attribute VB_Name = "Form1"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = False
    Attribute VB_PredeclaredId = True
    Attribute VB_Exposed = False
    Private Sub Command1_Click()
        If txtUserName.Text = "" Then
            MsgBox "You need to type your username!", vbCritical, "Unable to complete"
            Exit Sub
        End If
        wsMain.Connect
        Do Until wsMain.State = 7
            ' 0 is closed, 9 is error
            If wsMain.State = 0 Or wsMain.State = 9 Then
                MsgBox "Error in connecting!", vbCritical, "Winsock Error"
                ' there was an error, so let's leave
                Exit Sub
            End If
            DoEvents  'don't freeze the system!
        Loop
        ' "log-in":
        wsMain.SendData "U" & Chr(1) & txtUserName.Text
        txtUserName.Enabled = False
        txtMessage.Enabled = True
    End SubPrivate Sub txtMessage_KeyPress(KeyAscii As Integer)
        If KeyAscii = 13 Then
            wsMain.SendData "t" & Chr(1) & txtMessage.Text
            txtMessage.Text = ""
            KeyAscii = 0
        End If
    End SubPrivate Sub wsMain_DataArrival(ByVal bytesTotal As Long)
    Dim Data As String, CtrlChar As String
        wsMain.GetData Data
        CtrlChar = Left(Data, 1) ' Let's get the first char
        Data = Mid(Data, 3)      ' Then cut it off
        Select Case LCase(CtrlChar)   ' Check what it is
            Case "m"   ' Do stuff depending on it
                MsgBox Data, vbInformation, "Msg from server"
            Case "c"
                Me.Caption = "Client - " & Data
            Case Else
                txtReceived.SelStart = Len(txtReceived.Text)
                txtReceived.SelText = Data & vbCrLf
        End Select
    End SubPrivate Sub wsMain_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)
        MsgBox "Winsock Error: " & Number & vbCrLf & Description, vbCritical, "Winsock Error"
    End Sub