form1.vb

vb。net 2003数据库设计整套源代码

    Private Sub MenuAddManager_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuAddManager.Click
        If ManagerName <> "Admin" Then
            MsgBox("只有超级管理员才有此权限！", MsgBoxStyle.Exclamation, Me.Text)
            Exit Sub
        End If
        Dim FrmObj As New FrmAddManager()
        FrmObj.MdiParent = Me
        FrmObj.Show()
    End Sub

    Private Sub MenuDelManager_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuDelManager.Click
        If ManagerName <> "Admin" Then
            MsgBox("你没有此权限！", MsgBoxStyle.Exclamation, Me.Text)
            Exit Sub
        End If
        Dim FrmObj As New FrmDelManager()
        FrmObj.MdiParent = Me
        FrmObj.Show()
    End Sub

    Private Sub MenuAddUser_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuAddUser.Click
        Dim FrmObj As New FrmAddUser()
        FrmObj.MdiParent = Me
        FrmObj.Show()
    End Sub

    Private Sub MenuAddTime_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuAddTime.Click
        Dim FrmObj As New FrmAddTime()
        FrmObj.MdiParent = Me
        FrmObj.Show()
    End Sub

    Private Sub MenuModifyUPwd_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuModifyUPwd.Click
        Dim FrmObj As New FrmModUserPwd()
        FrmObj.MdiParent = Me
        FrmObj.Show()
    End Sub

    Private Sub MenuDelUser_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuDelUser.Click
        Dim FrmObj As New FrmDelUser()
        FrmObj.MdiParent = Me
        FrmObj.Show()
    End Sub

    Private Sub MenuMLog_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuMLog.Click
        Dim FrmObj As New FrmMLog()
        FrmObj.MdiParent = Me
        FrmObj.Show()
    End Sub

    Private Sub MenuULog_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuULog.Click
        Dim FrmObj As New FrmULog()
        FrmObj.MdiParent = Me
        FrmObj.Show()
    End Sub

    Private Sub MenuAbout_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuAbout.Click
        MsgBox("计算机机房管理系统" & vbCrLf & "设计人：银华强", MsgBoxStyle.OKOnly, "关于")
    End Sub

    Private Sub MenuBroadcast_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuBroadcast.Click
        Dim info As String
        info = InputBox("请输入广播信息", "系统广播")
        Dim i As Integer
        For i = 0 To 127
            If Not socket(i) Is Nothing Then
                SendInfo("MM" & info, i)
            End If
        Next
    End Sub


    Function LoginConfirm(ByVal IDOrder As String, ByVal Password As String) As String
        Dim SQLString As String
        SQLString = "SELECT * FROM tbUser WHERE IDOrder='" & IDOrder & "'"
        'SQL查询语句
        Dim ObjectdsDataSet As New DataSet()
        Dim oleconn As New OleDb.OleDbConnection(CONN)
        Dim adapter As New OleDb.OleDbDataAdapter()
        adapter.TableMappings.Add("Table", "User")
        Dim cmd As OleDb.OleDbCommand = New OleDb.OleDbCommand(SQLString, oleconn)
        cmd.CommandType = CommandType.Text
        adapter.SelectCommand = cmd
        If oleconn.State <> ConnectionState.Open Then
            oleconn.Open() '打开数据库连接
        End If
        cmd.ExecuteNonQuery() '执行SQ语句
        If oleconn.State <> ConnectionState.Closed Then
            oleconn.Close()   '关闭数据库连接
        End If
        adapter.Fill(ObjectdsDataSet) '填充数据集
        If ObjectdsDataSet.Tables("User").Rows.Count = 0 Then
            Return "L0" '输入的编号或密码错误
            Exit Function
        End If
        If ObjectdsDataSet.Tables("User").Rows(0)("Pwd").ToString = Password Then
            If ObjectdsDataSet.Tables("User").Rows(0)("RemainTime") <= 0 Then
                Return "L2"  '余额不足
                Exit Function
            End If
            If ObjectdsDataSet.Tables("User").Rows(0)("OnLine") = 0 Then
                SQLString = "UPDATE tbUser SET LoginTime='" & Date.Now & "',Online='1' WHERE IDOrder='" & IDOrder & "'"
                CommandRecord(SQLString)
            End If
            Return "L1" '登录成功
        Else

            Return "L0"  '输入的编号或密码错误
            Exit Function
        End If
    End Function


    Function LogoutConfirm(ByVal IDOrder As String, ByVal Password As String) As String
        Dim RemainTime As Double
        Dim SQLString As String
        SQLString = "SELECT * FROM tbUser WHERE IDOrder='" & IDOrder & "'"
        'SQL查询语句
        Dim ObjectdsDataSet As New DataSet()
        Dim oleconn As New OleDb.OleDbConnection(CONN)
        Dim adapter As New OleDb.OleDbDataAdapter()
        adapter.TableMappings.Add("Table", "User")
        Dim cmd As OleDb.OleDbCommand = New OleDb.OleDbCommand(SQLString, oleconn)
        cmd.CommandType = CommandType.Text
        adapter.SelectCommand = cmd
        If oleconn.State <> ConnectionState.Open Then
            oleconn.Open()  '打开数据库连接
        End If
        cmd.ExecuteNonQuery()  '执行SQ语句
        If oleconn.State <> ConnectionState.Closed Then
            oleconn.Close() '关闭数据库连接
        End If
        adapter.Fill(ObjectdsDataSet) '填充数据集
        If ObjectdsDataSet.Tables("User").Rows.Count = 0 Then
            Return "E0" '输入的编号或密码错误
            Exit Function
        End If
        If ObjectdsDataSet.Tables("User").Rows(0)("Pwd").ToString = Password Then
            RemainTime = ObjectdsDataSet.Tables("User").Rows(0)("RemainTime")
            RemainTime = RemainTime - Date.Now.Subtract(ObjectdsDataSet.Tables("User").Rows(0)("LoginTime")).TotalHours()
            If RemainTime <= 0 Then
                SQLString = "UPDATE tbUser SET RemainTime='" & RemainTime & "',Online='0' WHERE IDOrder='" & IDOrder & "'"
                CommandRecord(SQLString)
                Return "E2"  '余额不足
            Else
                SQLString = "UPDATE tbUser SET RemainTime='" & RemainTime & "',Online='0' WHERE IDOrder='" & IDOrder & "'"
                CommandRecord(SQLString)
                Return "E1"  '成功退出
                Exit Function
            End If
        Else
            Return "L0"
            Exit Function
        End If
    End Function

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        Dim ASCII As System.Text.Encoding = System.Text.Encoding.ASCII
        Dim receivebyte(16) As Byte '17个字节的数组
        Dim receivePage As String = String.Empty
        Dim i As Integer
        For i = 0 To socketCount
            If Not socket(i) Is Nothing Then
                If socket(i).Available <> 0 Then
                    '检查【Available】属性值
                    socket(i).SetSocketOption(SocketOptionLevel.Socket, SocketOptionName.ReceiveTimeout, 1000)
                    Dim bytes As Int32 = socket(i).Receive(receivebyte, receivebyte.Length, 0)
                    '接收信息
                    receivePage = ASCII.GetString(receivebyte, 0, bytes)
                    '转换为ASCII码
                    ProcessInfo(receivePage, i)  '处理信息
                End If
            End If
        Next
    End Sub
    Function SendInfo(ByVal Info As String, ByVal SocketIndex As Integer)
        Dim ASCII As System.Text.Encoding = System.Text.Encoding.ASCII
        Dim SendStr As String = Info
        Dim byteSend As Byte()
        byteSend = ASCII.GetBytes(SendStr) '转换为二进制字节
        socket(SocketIndex).Send(byteSend, byteSend.Length, 0) '发送
    End Function
    Public Sub ProcessInfo(ByVal info As String, ByVal SocketIndex As Integer)
        Dim IDOrder As String
        Dim Password As String
        Dim flag As String
        Dim i As Integer
        flag = info.Substring(0, 1)
        Select Case flag
            Case "L"
                IDOrder = info.Substring(1, 6)
                Password = info.Substring(7, 9)
                Dim result As String
                result = LoginConfirm(Trim(IDOrder), Trim(Password))
                SendInfo(result, SocketIndex)
            Case "E"
                IDOrder = info.Substring(1, 6)
                Password = info.Substring(7, 9)
                Dim result As String
                result = LogoutConfirm(Trim(IDOrder), Trim(Password))
                SendInfo(result, SocketIndex)
        End Select
    End Sub


    Sub establistsocket(ByVal state As Object)
        While run
            Dim listener As Socket
            listener = New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
            Dim serveradd As IPAddress = Dns.Resolve("127.0.0.1").AddressList(0)
            Dim enpoint As New IPEndPoint(serveradd, 50) '设置端口
            listener.Bind(enpoint) '绑定本机的IP地址
            listener.Listen(0)    '侦听
            socket(socketCount) = listener.Accept  '接收连接请求，并实例化一个Socket对象
            listener.Close() '关闭侦听
            socketCount = socketCount + 1
        End While
    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        ThreadPool.QueueUserWorkItem(New System.Threading.WaitCallback(AddressOf establistsocket))
    End Sub

    Private Sub MenuStatus_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuStatus.Click
        Dim FrmObj As New FrmStaus()
        FrmObj.MdiParent = Me
        FrmObj.Show()
    End Sub
End Class