server.frm

这是一个企业版的人力资源管理源码,很适合初级开发人员

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Server 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "服务器程序"
   ClientHeight    =   3765
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6180
   Icon            =   "Server.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   Picture         =   "Server.frx":0CCA
   ScaleHeight     =   3765
   ScaleWidth      =   6180
   StartUpPosition =   2  '屏幕中心
   Begin MSWinsockLib.Winsock Server 
      Index           =   0
      Left            =   600
      Top             =   3240
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock Listener 
      Left            =   0
      Top             =   3240
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      LocalPort       =   4477
   End
   Begin VB.Shape Shape1 
      BorderColor     =   &H00800000&
      BorderStyle     =   4  'Dash-Dot
      BorderWidth     =   2
      Height          =   615
      Left            =   2040
      Shape           =   4  'Rounded Rectangle
      Top             =   2520
      Width           =   2055
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "退出系统"
      BeginProperty Font 
         Name            =   "幼圆"
         Size            =   15.75
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00800000&
      Height          =   315
      Left            =   2400
      TabIndex        =   0
      Top             =   2640
      Width           =   1380
   End
End
Attribute VB_Name = "Server"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const MaxConnect = 100

Dim TotalClient As Integer
Dim InUsed(MaxConnect) As Boolean
Dim Connect_No(MaxConnect) As Integer
Dim RemoteIP(MaxConnect) As String

Private Sub Form_Load()
  Dim TmpStat As Long  'SQLConnect()函数的返回值
  For i = 1 To MaxConnect
    Connect_No(i) = -1
    InUsed(i) = False
    RemoteIP(i) = ""
  Next
  
  '分配环境句柄，保存在变量Henv中
  If SQLAllocEnv(Henv) Then
    MsgBox "无法初始化ODBC环境!", , "ODBC API执行错误"
    End
  End If
  '根据环境句柄，分配连接句柄，保存在变量Hdbc中
  If SQLAllocConnect(Henv, Hdbc) Then
    MsgBox "无法连接ODBC!", , "ODBC API执行错误"
    End
  End If
  '根据连接句柄、数据源、用户名和密码连接指定的数据库
  TmpStat = SQLConnect(Hdbc, DSN, Len(DSN), DB_USER_NAME, _
            Len(DB_USER_NAME), DB_PASSWORD, Len(DB_PASSWORD))
  '如果连接不成功则退出程序
  If TmpStat <> SQL_SUCCESS And _
     TmpStat <> SQL_SUCCESS_WITH_INFO Then
    MsgBox "无法连接数据库!", , "ODBC API执行错误"
    End
  End If
  Listener.Listen
End Sub

Private Sub Label1_Click()
  Unload Me
End Sub

Private Sub Listener_ConnectionRequest(ByVal requestID As Long)
  Dim i As Long
  For i = 1 To MaxConnect
    If Not InUsed(i) Then
      InUsed(i) = True
      Exit For
    End If
  Next i
  
  If i > MaxConnect Then
    Exit Sub
  End If
  
  Load Server(i)
  
  Server(i).Accept requestID
  RemoteIP(i) = Server(i).RemoteHostIP
End Sub

Private Sub Server_Close(Index As Integer)
  Server(Index).Close
  Unload Server(Index)
  InUsed(Index) = False
  Connect_No(Index) = -1
  
  TotalClient = TotalClient - 1
  
  Lbl_ClientNum = Trim(Str(TotalClient))
End Sub

Private Sub Server_DataArrival(Index As Integer, ByVal bytesTotal As Long)
  Dim InString As String
  
  Server(Index).GetData InString
End Sub