35.txt

图书管理系统源码 Microsoft Visual Basic6.0提供了开发Microsoft Windows应用程序的最迅速、最简捷的方法。”Visual”的意思是“可视化程序设计”

标准模块：
Option Explicit
Public dsn As String
Public uid As String
Public pwd As String
Public ll As Boolean
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpbuffer As String, nSize As Long) As Long
Public OK As Boolean
Private Sub Form_Load()
'    Dim sBuffer As String
'    Dim lSize As Long
'
'    sBuffer = Space$(255)
'    lSize = Len(sBuffer)
'    Call GetUserName(sBuffer, lSize)
'    If lSize > 0 Then
'        txtUserName.Text = Left$(sBuffer, lSize)
'    Else
'        txtUserName.Text = vbNullString
'    End If
End Sub

Private Sub cmdCancel_Click()
    OK = False
    End
End Sub

Private Sub cmdOK_Click()
Module1.dsn = Trim(txtdsn.Text)
'Module1.uid = Trim(txtuid.Text)
'Module1.pwd = Trim(txtpwd.Text)
    Dim mrcc As ADODB.Recordset
    Dim txtSQL As String
    Dim MsgText As String
    Set mrcc = ExecuteSQL(txtSQL, MsgText)
    Module1.ll = True
    'ToDo: create test for correct password
    'check for correct password
    OK = True
    If Trim(txtPassword.Text) = "auq" Then
        OK = True
        Unload Me
    Else
        MsgBox "Invalid Password, try again!", , "Login"
       ' txtdsn.SetFocus
        'txtPassword.SetFocus
        txtPassword.SelStart = 0
        txtPassword.SelLength = Len(txtPassword.Text)
    End If
End Sub

书籍信息列表：
Option Explicit
Public txtSQL As String
Dim mrc As ADODB.Recordset
Dim MsgText As String

Private Sub Form_Load()
    
    ShowTitle
    ShowData
    flagBedit = True
End Sub

Private Sub Form_Resize()
    If Me.WindowState <> vbMinimized And fMainForm.WindowState <> vbMinimized Then
        '边界处理
        If Me.ScaleHeight < 10 * lblTitle.Height Then
            
            Exit Sub
        End If
        If Me.ScaleWidth < lblTitle.Width + lblTitle.Width / 2 Then
            
            Exit Sub
        End If
        '控制控件的位置
                
        lblTitle.Top = lblTitle.Height
        lblTitle.Left = (Me.Width - lblTitle.Width) / 2
        
        msgList.Top = lblTitle.Top + lblTitle.Height + lblTitle.Height / 2
        msgList.Width = Me.ScaleWidth - 200
        msgList.Left = Me.ScaleLeft + 100
        msgList.Height = Me.ScaleHeight - msgList.Top - 200
    End If
End Sub

Public Sub FormClose()
    Unload Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
    flagBedit = False
    
    gintBmode = 0
End Sub

'显示Grid的内容

Private Sub ShowData()
    
    Dim j As Integer
    Dim i As Integer

  
    Set mrc = ExecuteSQL(txtSQL, MsgText)
        With msgList
        .Rows = 1
        
        Do While Not mrc.EOF
            .Rows = .Rows + 1
            For i = 1 To mrc.Fields.Count
                Select Case mrc.Fields(i - 1).Type
                    Case adDBDate
                        .TextMatrix(.Rows - 1, i) = Format(mrc.Fields(i - 1) & "", "yyyy-mm-dd")
                    Case Else
                        .TextMatrix(.Rows - 1, i) = mrc.Fields(i - 1) & ""
                End Select
            Next i
            mrc.MoveNext
        Loop
        
          
    End With
    mrc.Close
    
    
End Sub


'显示Grid表头
Private Sub ShowTitle()
    Dim i As Integer
    
    With msgList
        .Cols = 12
        .TextMatrix(0, 1) = ""
        .TextMatrix(0, 2) = "书籍名称"
        .TextMatrix(0, 3) = "书籍类别"
        .TextMatrix(0, 4) = "作者姓名"
        .TextMatrix(0, 5) = "出版社名称"
        .TextMatrix(0, 6) = "出版日期"
        .TextMatrix(0, 7) = "书籍页码"
        .TextMatrix(0, 8) = "关键词"
        .TextMatrix(0, 9) = "登记日期"
        .TextMatrix(0, 10) = "是否被借"
        .TextMatrix(0, 11) = "备注信息"
       
        
        '固定表头
        .FixedRows = 1
                
        '设置各列的对齐方式
        For i = 0 To 11
            .ColAlignment(i) = 0
        Next i
        
        
        '表头项居中
        .FillStyle = flexFillRepeat
        .Col = 0
        .Row = 0
        .RowSel = 1
        .ColSel = .Cols - 1
        .CellAlignment = 4
        
        '设置单元大小
        .ColWidth(0) = 1000
        .ColWidth(1) = 0
        .ColWidth(2) = 3000
        .ColWidth(3) = 2000
        .ColWidth(4) = 3000
        .ColWidth(5) = 3000
        .ColWidth(6) = 1000
        .ColWidth(7) = 1000
        .ColWidth(8) = 1000
        .ColWidth(9) = 1000
        .ColWidth(10) = 1000
        .ColWidth(11) = 1000
        
        .Row = 1
        
    End With
End Sub

Private Sub msgList_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    '右键弹出
    If Button = 2 And Shift = 0 Then
        PopupMenu fMainForm.menuBooks
    End If
    
End Sub

书籍信息：
Option Explicit
'是否改动过记录，ture为改过
Dim mblChange As Boolean
Dim mrc As ADODB.Recordset
Public txtSQL As String


Private Sub cboItem_Change(Index As Integer)
    '有变化设置gblchange
    mblChange = True
End Sub

Private Sub cboItem_Click(Index As Integer)
    Dim sSql As String
    Dim MsgText As String
    Dim mrcc As ADODB.Recordset
  
End Sub

Private Sub cboItem_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    EnterToTab KeyCode
    
End Sub

Private Sub cmdExit_Click()
    If mblChange And cmdSave.Enabled Then
        If MsgBox("保存当前记录的变化吗？", vbOKCancel + vbExclamation, "警告") = vbOK Then
            '保存
            Call cmdSave_Click
        End If
    End If
    Unload Me
End Sub

Private Sub cmdSave_Click()
    Dim intCount As Integer
    Dim sMeg As String
    Dim mrcc As ADODB.Recordset
    Dim MsgText As String
    
    For intCount = 0 To 6
        If Trim(txtItem(intCount) & " ") = "" Then
            Select Case intCount
                Case 0
                    sMeg = "书籍名称"
                Case 1
                    sMeg = "作者姓名"
                Case 2
                    sMeg = "出版社名称"
                Case 3
                    sMeg = "出版日期"
                Case 4
                    sMeg = "书籍页码"
                Case 5
                    sMeg = "关键词"
                Case 6
                    sMeg = "登记日期"
                
            End Select
            sMeg = sMeg & "不能为空！"
            MsgBox sMeg, vbOKOnly + vbExclamation, "警告"
            txtItem(intCount).SetFocus
        
            Exit Sub
        End If
    Next intCount
    
    For intCount = 3 To 6 Step 3
        If Not IsDate(Trim(txtItem(intCount) & " ")) Then
            Select Case intCount
                Case 3
                    sMeg = "出版日期"
                Case 6
                    sMeg = "登记日期"
                
            End Select
            sMeg = sMeg & "请输入日期！"
            MsgBox sMeg, vbOKOnly + vbExclamation, "警告"
            txtItem(intCount).SetFocus
        
            Exit Sub
        End If
    Next intCount
        
   
    
    If gintBmode = 1 Then
        txtSQL = "select * from books where bookname ='" & Trim(txtItem(0)) & "' and bookauthor = '" & Trim(txtItem(1)) & "' and bookpub = '" & Trim(txtItem(2)) & "'"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        If mrc.EOF = False Then
            MsgBox "已经存在此书籍的记录！", vbOKOnly + vbExclamation, "警告"
            txtItem(0).SetFocus
            Exit Sub
        End If
        mrc.Close
    End If
    
    
    If gintBmode = 2 Then
        '先删除已有记录
        txtSQL = "delete from books where bookid ='" & Trim(txtNo) & "'"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
    End If
    
    '再加入新记录
    txtSQL = "select * from books"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    mrc.AddNew
    mrc.Fields(0) = Trim(txtNo)
    mrc.Fields(1) = Trim(txtItem(0))
    mrc.Fields(2) = Trim(cboItem(0))
    
    For intCount = 3 To 8
        If Trim(txtItem(intCount - 2) & " ") = "" Then
            mrc.Fields(intCount) = Null
        Else
            mrc.Fields(intCount) = Trim(txtItem(intCount - 2))
        End If
    Next intCount
    
    mrc.Fields(9) = " "
    mrc.Fields(10) = Trim(txtItem(7))
    
    mrc.Update
    mrc.Close
   
    
        
    If gintBmode = 1 Then
        For intCount = 0 To 7
            txtItem(intCount) = ""
        Next intCount
        
        mblChange = False
        If flagBedit Then
            Unload frmBook
            frmBook.txtSQL = "select * from books"
            frmBook.Show
        End If
    ElseIf gintBmode = 2 Then
        Unload Me
        If flagBedit Then
            Unload frmBook
        End If
        frmBook.txtSQL = "select * from books"
        frmBook.Show
        
    End If
    
End Sub

Private Sub Form_Load()
    Dim sSql As String
    Dim intCount As Integer
    Dim MsgText As String
    Dim mrcc As ADODB.Recordset
    
    
   
    If gintBmode = 1 Then
        Me.Caption = Me.Caption & "添加"
        
        '初始化物资名称
        txtSQL = "select DISTINCT typename from booktype"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        
        If Not mrc.EOF Then
            
                Do While Not mrc.EOF
                    cboItem(0).AddItem Trim(mrc.Fields(0))
                    mrc.MoveNext
                Loop
                cboItem(0).ListIndex = 0
            
        Else
            MsgBox "请先进行书籍标准设置！", vbOKOnly + vbExclamation, "警告"
            cmdSave.Enabled = False
            Exit Sub
        End If
        mrc.Close
        txtNo = GetRkno()
        
        
                
    ElseIf gintBmode = 2 Then
       
        
        
        Set mrcc = ExecuteSQL(txtSQL, MsgText)
        
        If mrcc.EOF = False Then
            With mrcc
            
                txtNo = .Fields(0)
                
                txtItem(0) = .Fields(1)
                
                
                                
                For intCount = 1 To 6
                    If Not IsNull(.Fields(intCount + 2)) Then
                        txtItem(intCount) = .Fields(intCount + 2)
                    End If
                Next intCount
                
                txtItem(7) = .Fields(9)
                
                txtSQL = "select DISTINCT typename from booktype"
                cboItem(0).Clear
                Set mrc = ExecuteSQL(txtSQL, MsgText)
                
                If Not mrc.EOF Then
                    
                        Do While Not mrc.EOF
                            cboItem(0).AddItem Trim(mrc.Fields(0))
                            mrc.MoveNext
                        Loop
                        
                    
                Else
                    MsgBox "请先进行书籍种类设置！", vbOKOnly + vbExclamation, "警告"
                    cmdSave.Enabled = False
                    Exit Sub
                End If
                mrc.Close
                
                             
            End With
            
        End If
        mrcc.Close
        Me.Caption = Me.Caption & "修改"
            
        
    End If
    
    mblChange = False
    
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    gintBmode = 0
End Sub

Private Sub txtItem_Change(Index As Integer)
    '有变化设置gblchange
    mblChange = True
    
    
End Sub