frmnewlei.frm

一个很全的书店的图书管理系统 做的很好希望和大家分享~！ 是用VB+ACCE

VERSION 5.00
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Begin VB.Form FrmNewLei 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "新书登记  添加类别"
   ClientHeight    =   2280
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6510
   Icon            =   "FrmNewLei.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2280
   ScaleWidth      =   6510
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin MSAdodcLib.Adodc Adodc1 
      Height          =   330
      Left            =   4800
      Top             =   1680
      Visible         =   0   'False
      Width           =   1200
      _ExtentX        =   2117
      _ExtentY        =   582
      ConnectMode     =   0
      CursorLocation  =   3
      IsolationLevel  =   -1
      ConnectionTimeout=   15
      CommandTimeout  =   30
      CursorType      =   3
      LockType        =   3
      CommandType     =   8
      CursorOptions   =   0
      CacheSize       =   50
      MaxRecords      =   0
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   1
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   ""
      OLEDBString     =   ""
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   ""
      Caption         =   "Adodc1"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
   Begin VB.ComboBox ComboFuLei 
      Height          =   300
      Left            =   1320
      TabIndex        =   2
      Text            =   "选择父类"
      Top             =   1275
      Width           =   3015
   End
   Begin VB.TextBox TxtLeiBie 
      Height          =   390
      Left            =   1320
      TabIndex        =   1
      Top             =   690
      Width           =   3015
   End
   Begin VB.TextBox TxtBianHao 
      Height          =   390
      Left            =   1320
      TabIndex        =   0
      Top             =   120
      Width           =   3015
   End
   Begin VB.CommandButton CmdClose 
      Cancel          =   -1  'True
      Caption         =   "返回(&C)"
      Height          =   375
      Left            =   4680
      TabIndex        =   5
      Top             =   1200
      Width           =   1575
   End
   Begin VB.CommandButton CmdLei 
      Caption         =   "保存并返回(&R)"
      Height          =   375
      Left            =   4680
      TabIndex        =   4
      Top             =   555
      Width           =   1575
   End
   Begin VB.CommandButton CmdNewGYS 
      Caption         =   "保存并继续(&N)"
      Height          =   375
      Left            =   4680
      TabIndex        =   3
      Top             =   120
      Width           =   1575
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "说明：创建第一级分类请不要选择“所属父类”，创建子类请选择父类。"
      Height          =   180
      Left            =   240
      TabIndex        =   9
      Top             =   1920
      Width           =   5760
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "所属父类："
      Height          =   180
      Left            =   240
      TabIndex        =   8
      Top             =   1395
      Width           =   900
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "类别名称："
      Height          =   180
      Left            =   240
      TabIndex        =   7
      Top             =   840
      Width           =   900
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "类别编号："
      Height          =   180
      Left            =   240
      TabIndex        =   6
      Top             =   240
      Width           =   900
   End
End
Attribute VB_Name = "FrmNewLei"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim FuLeiBianHao As String

Public Function checkGYSID(UID As String) As Boolean
Dim userDB As Database
Dim userRD As Recordset
Dim dbName As String
Dim STRSQL As String

Screen.MousePointer = 11

On Error GoTo errEnd

dbName = App.Path
If Right(dbName, 1) <> "\" Then dbName = dbName + "\"
dbName = dbName + "DataBase\WFSSDataBase.mdb"
STRSQL = "select [图书分类] from [图书分类] where [图书分类号]=""" & UID & """"

'打开数据库
Set userDB = DBEngine.Workspaces(0).OpenDatabase(dbName, False, True)
'检索用户,验证密码
Set userRD = userDB.OpenRecordset(STRSQL, dbOpenSnapshot)

If userRD.RecordCount > 0 Then
    '关闭数据库
    userRD.Close
    Set userRD = Nothing
    userDB.Close
    Set userDB = Nothing
    
    checkGYSID = True
    Screen.MousePointer = vbDefault
Else
    '关闭数据库
    userRD.Close
    Set userRD = Nothing
    userDB.Close
    Set userDB = Nothing
    
    Screen.MousePointer = vbDefault
    checkGYSID = False
End If
Exit Function

errEnd:
    Screen.MousePointer = vbDefault
    MsgBox Err.Description, vbOKOnly + vbExclamation, "创建类别"
    Err.Clear
    '关闭数据库
    userRD.Close
    Set userRD = Nothing
    userDB.Close
    Set userDB = Nothing
End Function

Public Function checkFenLei(UID As String) As Boolean
Dim userDB As Database
Dim userRD As Recordset
Dim dbName As String
Dim STRSQL As String

Screen.MousePointer = 11

On Error GoTo errEnd

dbName = App.Path
If Right(dbName, 1) <> "\" Then dbName = dbName + "\"
dbName = dbName + "DataBase\WFSSDataBase.mdb"
STRSQL = "select [图书分类] from [图书分类] where [图书分类]=""" & UID & """"

'打开数据库
Set userDB = DBEngine.Workspaces(0).OpenDatabase(dbName, False, True)
'检索用户,验证密码
Set userRD = userDB.OpenRecordset(STRSQL, dbOpenSnapshot)

If userRD.RecordCount > 0 Then
    '关闭数据库
    userRD.Close
    Set userRD = Nothing
    userDB.Close
    Set userDB = Nothing
    
    checkFenLei = True
    Screen.MousePointer = vbDefault
Else
    '关闭数据库
    userRD.Close
    Set userRD = Nothing
    userDB.Close
    Set userDB = Nothing
    
    Screen.MousePointer = vbDefault
    checkFenLei = False
End If
Exit Function

errEnd:
    Screen.MousePointer = vbDefault
    MsgBox Err.Description, vbOKOnly + vbExclamation, "创建类别"
    Err.Clear
    '关闭数据库
    userRD.Close
    Set userRD = Nothing
    userDB.Close
    Set userDB = Nothing
End Function

Private Sub CmdClose_Click()
Unload Me
Load FrmBook
FrmBook.Show vbModal
End Sub

Private Sub CmdLei_Click()
On Error GoTo errEnd
If TxtBianHao.Text = "" Then
    MsgBox "请填写图书分类号!", vbOKOnly + vbExclamation, "创建分类"
    TxtBianHao.SetFocus
    Exit Sub
End If
If TxtLeiBie.Text = "" Then
    MsgBox "请填写图书分类名称!", vbOKOnly + vbExclamation, "创建分类"
    TxtLeiBie.SetFocus
    Exit Sub
End If
If checkFenLei(TxtLeiBie.Text) Then
    MsgBox "图书分类名称不唯一，请另选一个！", vbOKOnly + vbExclamation, "创建分类"
    TxtLeiBie.SetFocus
    TxtLeiBie.SelStart = 0
    TxtLeiBie.SelLength = Len(TxtLeiBie.Text)
    Exit Sub
End If
If ComboFuLei.Text <> "" And ComboFuLei.Text <> "选择父类" Then
    If Not checkFenLei(ComboFuLei.Text) Then
        MsgBox "所选父类不存在！请重试！", vbOKOnly + vbExclamation, "选择父类"
        ComboFuLei.SetFocus
        Exit Sub
    End If
    Adodc1.CommandType = adCmdText
    Adodc1.RecordSource = "select [图书分类号] from [图书分类] where [图书分类号]=[所属父类编号] and [图书分类]=""" & ComboFuLei.Text & """"
    Adodc1.Refresh
    Adodc1.Recordset.MoveFirst
    FuLeiBianHao = Adodc1.Recordset!图书分类号
End If
If checkGYSID(TxtBianHao.Text) Then
    MsgBox "图书分类编号不唯一，请另选一个！", vbOKOnly + vbExclamation, "创建分类"
    TxtBianHao.SetFocus
    TxtBianHao.SelStart = 0
    TxtBianHao.SelLength = Len(TxtBianHao.Text)
    Exit Sub
End If
If FuLeiBianHao = "" Then FuLeiBianHao = TxtBianHao.Text

Adodc1.CommandType = adCmdTable
Adodc1.RecordSource = "图书分类"
Adodc1.Refresh

Adodc1.Recordset.AddNew
Adodc1.Recordset!图书分类号 = TxtBianHao.Text
Adodc1.Recordset!图书分类 = TxtLeiBie.Text
Adodc1.Recordset!所属父类编号 = FuLeiBianHao
Adodc1.Recordset.Update

MsgBox "创建分类成功！", vbOKOnly + vbInformation, "创建分类"
Call CmdClose_Click

Exit Sub
errEnd:
    MsgBox "更新数据库失败!", vbOKOnly + vbExclamation, "数据库出错"
End Sub

Private Sub CmdNewGYS_Click()
On Error GoTo errEnd
If TxtBianHao.Text = "" Then
    MsgBox "请填写图书分类号!", vbOKOnly + vbExclamation, "创建分类"
    TxtBianHao.SetFocus
    Exit Sub
End If
If TxtLeiBie.Text = "" Then
    MsgBox "请填写图书分类名称!", vbOKOnly + vbExclamation, "创建分类"
    TxtLeiBie.SetFocus
    Exit Sub
End If
If checkFenLei(TxtLeiBie.Text) Then
    MsgBox "图书分类名称不唯一，请另选一个！", vbOKOnly + vbExclamation, "创建分类"
    TxtLeiBie.SetFocus
    TxtLeiBie.SelStart = 0
    TxtLeiBie.SelLength = Len(TxtLeiBie.Text)
    Exit Sub
End If
If ComboFuLei.Text <> "" And ComboFuLei.Text <> "选择父类" Then
    If Not checkFenLei(ComboFuLei.Text) Then
        MsgBox "所选父类不存在！请重试！", vbOKOnly + vbExclamation, "选择父类"
        ComboFuLei.SetFocus
        Exit Sub
    End If
    Adodc1.CommandType = adCmdText
    Adodc1.RecordSource = "select [图书分类号] from [图书分类] where [图书分类号]=[所属父类编号] and [图书分类]=""" & ComboFuLei.Text & """"
    Adodc1.Refresh
    Adodc1.Recordset.MoveFirst
    FuLeiBianHao = Adodc1.Recordset!图书分类号
End If
If checkGYSID(TxtBianHao.Text) Then
    MsgBox "图书分类编号不唯一，请另选一个！", vbOKOnly + vbExclamation, "创建分类"
    TxtBianHao.SetFocus
    TxtBianHao.SelStart = 0
    TxtBianHao.SelLength = Len(TxtBianHao.Text)
    Exit Sub
End If
If FuLeiBianHao = "" Then FuLeiBianHao = TxtBianHao.Text

Adodc1.CommandType = adCmdTable
Adodc1.RecordSource = "图书分类"
Adodc1.Refresh

Adodc1.Recordset.AddNew
Adodc1.Recordset!图书分类号 = TxtBianHao.Text
Adodc1.Recordset!图书分类 = TxtLeiBie.Text
Adodc1.Recordset!所属父类编号 = FuLeiBianHao
Adodc1.Recordset.Update

MsgBox "创建分类成功！", vbOKOnly + vbInformation, "创建分类"
TxtBianHao.Text = ""
TxtLeiBie.Text = ""
ComboFuLei.Text = "选择父类"
FuLeiBianHao = ""
TxtFuLei.Text = ""
TxtBianHao.SetFocus

Exit Sub
errEnd:
    MsgBox "更新数据库失败!", vbOKOnly + vbExclamation, "数据库出错"
End Sub

Private Sub ComboFuLei_Click()
On Error GoTo errEnd

If ComboFuLei.Text <> "" Then
    Adodc1.CommandType = adCmdText
    Adodc1.RecordSource = "select [图书分类号] from [图书分类] where [图书分类号]=[所属父类编号] and [图书分类]=""" & ComboFuLei.Text & """"
    Adodc1.Refresh
    Adodc1.Recordset.MoveFirst
    FuLeiBianHao = Adodc1.Recordset!图书分类号 & ""
End If

Exit Sub
errEnd:
    MsgBox "检索数据库失败！找不到该类别！", vbOKOnly + vbExclamation, "数据库出错"
End Sub

Private Sub Form_Activate()
On Error GoTo errEnd

Adodc1.CommandType = adCmdText
Adodc1.RecordSource = "select [图书分类] from [图书分类] where [图书分类号]=[所属父类编号]"
Adodc1.Refresh

ComboFuLei.AddItem ""
If Adodc1.Recordset.RecordCount > 0 Then
    Adodc1.Recordset.MoveFirst
    While Not Adodc1.Recordset.EOF
        ComboFuLei.AddItem Adodc1.Recordset!图书分类
        Adodc1.Recordset.MoveNext
    Wend
End If
Exit Sub
errEnd:
    MsgBox "检索数据库失败！", vbOKOnly + vbExclamation, "数据库出错"
End Sub

Private Sub Form_Load()
Dim dbName As String
Dim connSTR As String

On Error GoTo errEnd

ChDir App.Path
dbName = App.Path
If Right(dbName, 1) <> "\" Then dbName = dbName + "\"
dbName = dbName + "DataBase\WFSSDataBase.mdb"

connSTR = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbName & ";Persist Security Info=False"
Adodc1.ConnectionString = connSTR

Exit Sub

errEnd:
    MsgBox "连接数据库失败!", vbOKOnly + vbExclamation, "打开数据库出错"
    End
End Sub