frmdatabase.frm

网上教务管理系统 包括（教师

         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   4740
      TabIndex        =   15
      Top             =   210
      Width           =   2310
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "数据库表字段显示"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   2400
      TabIndex        =   3
      Top             =   210
      Width           =   1680
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "已生成的成绩数据库表"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   120
      TabIndex        =   1
      Top             =   210
      Width           =   2100
   End
End
Attribute VB_Name = "FRMDATABASE"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim DAT As Database
Dim STR As String
Dim TDF As TableDef
Dim TEMPDATA As String
Private Sub Command1_Click()
  On Error GoTo ErOut1
  Dim STR, SQL_STUD As String
  Dim REC, RECSTUD As Recordset
  Dim N, L As Integer
  STR = List1.List(List1.ListIndex)
  If MsgBox("确信要删除吗？", vbQuestion + vbYesNo, "重要提示") = vbNo Then Exit Sub
    If Trim(STR) = "" Then Exit Sub
    '检查表是否已存在
    Set DAT = OpenDatabase(App.Path + "\database\mark.mdb", , False)
    Set REC = DAT.OpenRecordset("select ID from banjgl where Banjmc='" & Trim(STR) & "'")
    If REC.EOF = True And REC.BOF = True Then MsgBox "此班级成绩库不已存在.", vbInformation + vbOKOnly, "出错!": REC.Close: DAT.Close: Exit Sub
    '删除banjgl的记录
    N = REC.Fields(0)
    REC.Delete
    REC.Close
    '将表中的ID进行更改
    Set REC = DAT.OpenRecordset("select ID from banjgl where ID > " & N & " order by ID")
    Do Until REC.EOF = True
    REC.Edit
    REC.Fields(0) = REC.Fields(0) - 1
    REC.Update
    REC.MoveNext
    Loop
    REC.Close
    
    '清除STUD表中的记录
  L = Len(STR) - 2
  SQL_STUD = "SELECT * FROM STUD WHERE 班级= '" & Right(Trim(STR), L) & "'"
  'DAT.Execute SQL_STUD
  Set RECSTUD = DAT.OpenRecordset(SQL_STUD, dbOpenDynaset)
   If Not (RECSTUD.BOF And RECSTUD.EOF) Then RECSTUD.MoveLast: RECSTUD.MoveFirst
  'RECSTUD.MoveLast
  'RECSTUD.MoveFirst
  For I = 0 To RECSTUD.RecordCount - 1
 
  RECSTUD.Delete
  RECSTUD.MoveNext
  DAT.Recordsets.Refresh
  Next I
  'RECSTUD.Close
  
  
    
    
    '删除表
    DAT.TableDefs.Delete Trim(STR)
    '去掉lstBanj之中的Item
    List1.RemoveItem N - 1
    List2.Clear
  
  
  Exit Sub
  
ErOut1:
  REC.Close
  DAT.Close
End Sub

Private Sub Command10_Click()
    If Trim(Text4.Text) = "" Then Exit Sub
    Set DAT = OpenDatabase(App.Path + "\DATABASE\MARK.mdb", , False)
    Set TDF = DAT.TableDefs(Text3.Text)
   'On Error GoTo ErOut1  '设定错误陷阱
    TDF.Fields.Append TDF.CreateField(Trim(Text4.Text), dbSingle)  '添加字段
   'On Error GoTo 0  '关闭错误陷阱
    DAT.Close
    List2.AddItem Text4.Text
    Text4.Text = ""
    List1.Refresh
    List2.Refresh
   '  DAT.Close
'     TDF.RefreshLink
End Sub

Private Sub Command11_Click()
    On Error GoTo err
    If Trim(Text4.Text) = "" Then Exit Sub
    If Trim(Text3.Text) = "" Then MsgBox "请选择数据库!", vbInformation + vbOKOnly, "出错提示": Exit Sub
    Set DAT = OpenDatabase(App.Path + "\DATABASE\MARK.mdb", , False)
    Set TDF = DAT.TableDefs(Text3.Text)    'BanJi在lstBanj_dblclick中已赋值
    '删除字段
   'On Error GoTo ErOut1              '设定错误陷阱
    If MsgBox("确信要删除此字段?", vbQuestion + vbYesNo, "确认提示") = vbNo Then Exit Sub
    TDF.Fields.Delete Trim(Text4.Text)
  ' On Error GoTo 0                   '关闭错误陷阱
    '去掉lstKem之中的Item
    DAT.Close
    For I = 0 To List2.ListCount - 1
     If List2.List(I) = Trim(Text4.Text) Then N = I: Exit For
    Next I
    List2.RemoveItem N
    Text4.Text = ""
    Exit Sub
err:
    MsgBox err.Description
End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Command3_Click()
If Command3.Caption = "字段操作" Then
If FRMDATABASE.Width >= 9600 Then Exit Sub
FRMDATABASE.Width = 9600
FRMDATABASE.Left = (Screen.Width - FRMDATABASE.Width) / 2
Command3.Caption = "还原"
Else
FRMDATABASE.Width = 4800
FRMDATABASE.Left = (Screen.Width - FRMDATABASE.Width) / 2
Command3.Caption = "字段操作"
End If
End Sub

Private Sub Command4_Click()
TEMPDATA = Text3.Text
Text1.Text = List2.List(List2.ListIndex)

End Sub

Private Sub Command5_Click()
Text2.Text = List1.List(List1.ListIndex)
End Sub

Private Sub Command6_Click()
    On Error GoTo err
    If Trim(Text1.Text) = "" Then Exit Sub
    If Text2.Text = "" Then MsgBox "请选择目标数据库!", vbInformation + vbOKOnly, "出错提示": Exit Sub
    Set DAT = OpenDatabase(App.Path + "\DATABASE\MARK.mdb", , False)
    Set TDF = DAT.TableDefs(Text2.Text)
    If MsgBox("确信要转移 [" & TEMPDATA & "] 库中 [" & Text1.Text & "]字段到 [" & Text2.Text & "] 数据库中?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
    If Text2.Text = TEMPDATA Then Exit Sub
    TDF.Fields.Append TDF.CreateField(Trim(Text1.Text), dbSingle)  '添加字段
    DAT.Close
    Set DAT = OpenDatabase(App.Path + "\DATABASE\MARK.mdb", , False)
    Set TDF = DAT.TableDefs(TEMPDATA)    'BanJi在lstBanj_dblclick中已赋值
    TDF.Fields.Delete Trim(Text1.Text)
    DAT.Close
    For I = 0 To List2.ListCount - 1
     If List2.List(I) = Trim(Text1.Text) Then N = I: Exit For
    Next I
    List2.RemoveItem N
    Text1.Text = ""
    Exit Sub
err:
    MsgBox err.Description
    End Sub

Private Sub Command7_Click()
On Error GoTo err
Dim I As Integer
Dim SQLMARK2 As String
Dim RECMARK2 As Recordset
If Trim(Text1.Text) = "" Then Exit Sub
    If Text2.Text = "" Then MsgBox "请选择目标数据库!", vbInformation + vbOKOnly, "出错提示": Exit Sub
    Set DAT = OpenDatabase(App.Path + "\DATABASE\MARK.mdb", , False)
    Set TDF = DAT.TableDefs(Text2.Text)
    If MsgBox("确信要复制 [" & TEMPDATA & "] 库中 [" & Text1.Text & "]字段到 [" & Text2.Text & "] 数据库中?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
    If Text2.Text = TEMPDATA Then Exit Sub
    TDF.Fields.Append TDF.CreateField(Trim(Text1.Text), dbSingle)  '添加字段
    
    SQLMARK2 = "SELECT * FROM " & Trim(Text2.Text)
    Set RECMARK2 = DAT.OpenRecordset(SQLMARK2, dbOpenDynaset)
    If RECMARK2.BOF And RECMARK2.EOF Then Exit Sub
    RECMARK2.MoveLast
    RECMARK2.MoveFirst
    RECMARK2.Edit
    For I = 1 To RECMARK2.RecordCount
    If RECMARK2.Fields(RECMARK2.Fields.Count - 1).Value = Null Then RECMARK2.Fields(RECMARK2.Fields.Count - 1).Value = 0
    RECMARK2.MoveNext
    Next I
    RECMARK2.Update
    RECMARK2.Close
    
    DAT.Close
    Exit Sub
err:
MsgBox err.Description, vbCritical + vbOKOnly, "错误"
    
End Sub

Private Sub Command8_Click()
Text3.Text = List1.List(List1.ListIndex)
End Sub

Private Sub Command9_Click()
Text4.Text = List2.List(List2.ListIndex)
End Sub

Private Sub Form_Load()

Dim REC As Recordset
Dim SQL As String
Dim N As Integer
FRMDATABASE.Width = 4800

'SQL = "SELECT * FROM " & BANJGL & ""
SQL = "SELECT * FROM BANJGL"
Set DAT = OpenDatabase(App.Path + "\DATABASE\MARK.MDB", , False)
Set REC = DAT.OpenRecordset(SQL, dbOpenDynaset)
If Not REC.EOF Then REC.MoveLast: REC.MoveFirst
N = REC.RecordCount
Dim I As Integer
For I = 1 To N
List1.AddItem REC.Fields(1).Value
If Not REC.EOF Then REC.MoveNext
Next I
End Sub

Private Sub List1_Click()
Text3.Text = List1.List(List1.ListIndex)
End Sub

Private Sub List1_DblClick()
Dim SQLBJ, sqlzd As String
Dim RECBJ, reczd As Recordset
Dim I As Integer
Dim DAT As Database

List2.Clear
If Not IsNull(List1.List(List1.ListIndex)) Then
'On Error Resume Next
    'sqlbj = "select * from " + Trim(List1.List(List1.ListIndex)) + ""
    '    Set recbj = DAT.OpenRecordset(sqlbj, dbOpenSnapshot)
     
     sqlzd = "select * from " + Trim(List1.List(List1.ListIndex)) + ""
     Set DAT = OpenDatabase(App.Path + "\DATABASE\MARK.MDB", , False)
     Set reczd = DAT.OpenRecordset(sqlzd, dbOpenDynaset)
        For I = 0 To reczd.Fields.Count - 1
          List2.AddItem reczd.Fields(I).Name
        Next I
End If
Text3.Text = List1.List(List1.ListIndex)
End Sub