frmtcpserver.frm

远程访问sql server 的源码

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmTcpServer 
   Caption         =   "服务器端"
   ClientHeight    =   5295
   ClientLeft      =   2580
   ClientTop       =   1665
   ClientWidth     =   7530
   LinkTopic       =   "Form1"
   ScaleHeight     =   5295
   ScaleWidth      =   7530
   Begin VB.Frame fraTCPServer 
      Caption         =   "服务器端设置："
      Height          =   2655
      Left            =   5400
      TabIndex        =   1
      Top             =   480
      Width           =   2055
      Begin VB.CommandButton cmdClose 
         Caption         =   "结束服务"
         Height          =   375
         Left            =   360
         TabIndex        =   6
         Top             =   2160
         Width           =   1575
      End
      Begin VB.TextBox txtServerPort 
         Height          =   285
         Left            =   360
         TabIndex        =   3
         Top             =   720
         Width           =   1575
      End
      Begin VB.CommandButton cmdOpenPort 
         Caption         =   "打开服务器端口"
         Height          =   375
         Left            =   360
         TabIndex        =   2
         Top             =   1440
         Width           =   1575
      End
      Begin VB.Label Label3 
         Caption         =   "设置服务器端口："
         Height          =   255
         Left            =   120
         TabIndex        =   4
         Top             =   360
         Width           =   1455
      End
   End
   Begin VB.TextBox txtTCPChat 
      Height          =   4335
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   0
      Top             =   480
      Width           =   5175
   End
   Begin MSWinsockLib.Winsock WinsockTCP 
      Index           =   0
      Left            =   6720
      Top             =   3720
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Label Label4 
      Caption         =   "交谈显示窗口："
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   240
      Width           =   1455
   End
End
Attribute VB_Name = "frmTcpServer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim HostName As String * 256    '获取主机名
Dim HostIP As String            '本地机器的IP地址
Dim colHostName As New Collection '存放登录的计算机名

Private Sub cmdClose_Click()
    Unload Me
End Sub

Private Sub cmdOpenPort_Click()
    If Trim$(txtServerPort.Text) = vbNullString Then
        MsgBox "请指定端口号！"
        Exit Sub
    End If
    '设置服务器端的端口号
    WinsockTCP(0).LocalPort = CLng(Trim$(txtServerPort.Text))
    '服务器端WinSockTCP（0）控件执行监听功能
    WinsockTCP(0).Listen
End Sub

Private Sub Form_Load()
    '获取本地计算机的名称和IP，可以用来判断服务器还是客户机
    HostName = WinsockTCP(0).LocalHostName
    HostIP = WinsockTCP(0).LocalIP
    '设置为TCP协议，默认方式就是TCP
    WinsockTCP(0).Protocol = sckTCPProtocol
 
    '初始化端口号为1001
    txtServerPort.Text = 1001
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim i As Long
    WinsockTCP(0).Close
    '关闭WinSockTcp控件
    For i = 1 To WinsockTCP.UBound
        On Error Resume Next
        WinsockTCP(i).Close
        Unload WinsockTCP(i)
    Next i
End Sub

Private Sub WinsockTCP_Close(Index As Integer)
    Dim i As Long
    On Error Resume Next
    If Index <> 0 Then
        Unload WinsockTCP(Index)
    End If
    
    '向每个客户端发出信息，通告某个客户端的退出
    For i = 1 To WinsockTCP.UBound
        WinsockTCP(i).SendData colHostName(Index) & " 已经退出系统！"
    Next i
End Sub

Private Sub WinsockTCP_ConnectionRequest(Index As Integer, ByVal requestID As Long)
    Dim sIp As String
    Dim i As Long
    On Error Resume Next
    
    '利用WinSock控件数组响应多个请求
    sIp = WinsockTCP(0).RemoteHostIP '获得登录者的IP地址
    i = 1
    Do While i <= WinsockTCP.UBound '检查是否已经有该地址的记录
        If WinsockTCP(i).RemoteHostIP = sIp Then '如有，不必加载新的控件
            
            '因为遇见错误就执行下一条语句，为了确保正确的执行，需要加以判断
            
            WinsockTCP(i).LocalPort = 0
            If err.Number = 0 Then '如果没有错误，即搜索到可用的存在的IP地址
                '用动态生成的WinSockTCP的实例进行接听客户端请求
                '每个客户端会对应一个WinSockTCP控件的实例
                WinsockTCP(i).Accept requestID
            
                Exit Sub
            ElseIf err.Number <> 0 Then
                '清空错误号
                err.Clear
            End If
        End If
        i = i + 1
    Loop
    
    '如果这个连接请求是新的，那么，就增加新的控件实例
    '向集合中加入该客户端的IP地址。
    colHostName.Add WinsockTCP(0).RemoteHostIP
    Load WinsockTCP(i) '否则，加载新的控件
    WinsockTCP(i).LocalPort = 0
    WinsockTCP(i).Accept requestID
    
    'DoEvents
    
    Exit Sub
err:
    MsgBox err.Description
End Sub

Private Sub WinsockTCP_DataArrival(Index As Integer, ByVal bytesTotal As Long)
    Dim sData As String
    Dim j As Long
    
    On Error Resume Next
   
    j = 1 '用来设置循环向每个客户端显示数据，除过发送数据的客户端
  
    WinsockTCP(Index).GetData sData
    
    '从上一条语句开始可能产生错误，因此，需要对错误号进行捕获
    '根据是否有错误来执行相关的操作
    If err.Number = 0 Then
        
        '将信息在服务器端显示，注意加上换行符号
        txtTCPChat.Text = Trim$(txtTCPChat.Text) & Trim$(sData) & vbCrLf
        If Len(txtTCPChat.Text) > 5000 Then
            txtTCPChat.Text = vbNullString
        End If
        
        '每收到一条数据，服务器端程序就负责将这些信息转发到每个客户端
        '返回的客户端包括发送该数据的客户端，这样可以使得客户端确定数据
        '已经为服务器端所处理了
       
        For j = 1 To WinsockTCP.UBound
            If sData <> vbNullString Then
                WinsockTCP(j).SendData sData
                '调用DoEvents事件，等待上条语句处理结束，保证数据的传送
                DoEvents
            End If
        Next j
        
    Else
        '清空错误号，以执行下次循环
        err.Clear
    End If
    
    Exit Sub
err:
    MsgBox err.Description
End Sub