frmppt.frm

一个自己做的电力管理系统,主要用于电力电业行业的管理

VERSION 5.00
Begin VB.Form frmPPt 
   Caption         =   "电子教案"
   ClientHeight    =   5400
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4875
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   5400
   ScaleWidth      =   4875
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox txtData 
      Height          =   375
      Index           =   0
      Left            =   1440
      TabIndex        =   16
      Top             =   240
      Width           =   1455
   End
   Begin VB.Frame Frame1 
      Height          =   3735
      Left            =   0
      TabIndex        =   3
      Top             =   0
      Width           =   3015
      Begin VB.TextBox txtData 
         Height          =   375
         Index           =   6
         Left            =   1440
         TabIndex        =   22
         Top             =   3120
         Width           =   1455
      End
      Begin VB.TextBox txtData 
         Height          =   375
         Index           =   5
         Left            =   1440
         TabIndex        =   21
         Top             =   2640
         Width           =   1455
      End
      Begin VB.TextBox txtData 
         Height          =   375
         Index           =   4
         Left            =   1440
         TabIndex        =   20
         Top             =   2160
         Width           =   1455
      End
      Begin VB.TextBox txtData 
         Height          =   375
         Index           =   3
         Left            =   1440
         TabIndex        =   19
         Top             =   1680
         Width           =   1455
      End
      Begin VB.TextBox txtData 
         Height          =   375
         Index           =   2
         Left            =   1440
         TabIndex        =   18
         Top             =   1200
         Width           =   1455
      End
      Begin VB.TextBox txtData 
         Height          =   375
         Index           =   1
         Left            =   1440
         TabIndex        =   17
         Top             =   720
         Width           =   1455
      End
      Begin VB.Label Label1 
         Caption         =   "电子教案号："
         Height          =   375
         Left            =   120
         TabIndex        =   10
         Top             =   360
         Width           =   1215
      End
      Begin VB.Label Label2 
         Caption         =   "PPT教案："
         Height          =   375
         Left            =   120
         TabIndex        =   9
         Top             =   720
         Width           =   1215
      End
      Begin VB.Label Label3 
         Caption         =   "DOC教案："
         Height          =   375
         Left            =   120
         TabIndex        =   8
         Top             =   1200
         Width           =   1215
      End
      Begin VB.Label Label4 
         Caption         =   "HTML教案："
         Height          =   255
         Left            =   120
         TabIndex        =   7
         Top             =   1680
         Width           =   1095
      End
      Begin VB.Label Label5 
         Caption         =   "PDF教案："
         Height          =   375
         Left            =   120
         TabIndex        =   6
         Top             =   2160
         Width           =   1215
      End
      Begin VB.Label Label6 
         Caption         =   "RAR教案："
         Height          =   375
         Left            =   120
         TabIndex        =   5
         Top             =   2520
         Width           =   1095
      End
      Begin VB.Label Label7 
         Caption         =   "ZIP教案："
         Height          =   375
         Left            =   120
         TabIndex        =   4
         Top             =   3120
         Width           =   1095
      End
   End
   Begin VB.Frame Frame2 
      Height          =   3735
      Left            =   3120
      TabIndex        =   2
      Top             =   0
      Width           =   1695
      Begin VB.CommandButton cmdCancel 
         Caption         =   "取消 "
         Height          =   375
         Left            =   480
         TabIndex        =   15
         Top             =   3120
         Width           =   975
      End
      Begin VB.CommandButton cmdSave 
         Caption         =   "保存"
         BeginProperty Font 
            Name            =   "新宋体"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   480
         TabIndex        =   14
         Top             =   2400
         Width           =   975
      End
      Begin VB.CommandButton cmdDel 
         Caption         =   "删除"
         Height          =   375
         Left            =   480
         TabIndex        =   13
         Top             =   960
         Width           =   975
      End
      Begin VB.CommandButton cmdUpdata 
         Caption         =   "更新"
         Height          =   375
         Left            =   480
         TabIndex        =   12
         Top             =   1680
         Width           =   975
      End
      Begin VB.CommandButton cmdAdd 
         Caption         =   "添加"
         Height          =   375
         Left            =   480
         TabIndex        =   11
         Top             =   240
         Width           =   975
      End
   End
   Begin VB.Frame Frame3 
      Caption         =   "查询信息："
      BeginProperty Font 
         Name            =   "新宋体"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1455
      Left            =   0
      TabIndex        =   0
      Top             =   3840
      Width           =   4815
      Begin VB.CommandButton cmdExit 
         Caption         =   "退出窗体"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   -1  'True
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   3240
         TabIndex        =   26
         Top             =   840
         Width           =   1215
      End
      Begin VB.CommandButton cmdSelect 
         Caption         =   "开始查询"
         Height          =   375
         Left            =   240
         TabIndex        =   25
         Top             =   840
         Width           =   975
      End
      Begin VB.CommandButton cmdClean 
         Caption         =   "数据清除"
         Height          =   375
         Left            =   1680
         TabIndex        =   24
         Top             =   840
         Width           =   1215
      End
      Begin VB.TextBox txtData 
         Height          =   375
         Index           =   7
         Left            =   2280
         TabIndex        =   23
         Top             =   240
         Width           =   2415
      End
      Begin VB.Label Label8 
         Caption         =   "请输入你要查询的教案号："
         ForeColor       =   &H00C0C000&
         Height          =   375
         Left            =   120
         TabIndex        =   1
         Top             =   360
         Width           =   2175
      End
   End
End
Attribute VB_Name = "frmPPt"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public i As Integer           'i 为输出数据项的文本框数组的下标
Public dataTable As String    'datatable为所要的查询表
Public selectkey As String    'selectKey 为所要查询的关键字
Private Sub cmdAdd_Click()                '添加数据
  Me.cmdDel.Enabled = False               '使删除按钮和更新按钮无效
  Me.cmdUpdata.Enabled = False
  Me.cmdSave.Enabled = True
End Sub

Private Sub cmdCancel_Click()            '取消操作
    Me.cmdAdd.Enabled = True
    Me.cmdDel.Enabled = True
    Me.cmdUpdata.Enabled = True
    Me.cmdSave.Enabled = False
End Sub

Private Sub cmdClean_Click()              '清除数据
   Dim j As Integer
   For j = 0 To i
       Me.txtData(j).Text = ""
       Next j
End Sub

Private Sub cmdDel_Click()                 '删除数据
 On Error GoTo errh
 Dim str As String                              '接受查询语句
 Dim Answer As String
 Dim j As Integer
If Me.txtData(0).Text = "" Then                             '学号为空时不能删除数据
   MsgBox " 你没有要删除的数据，请查询数据后再删除"
   Exit Sub
End If
 Answer = MsgBox("删除后无法恢复，你可要想好了，确实要删除吗？", vbYesNo, "警告！！")
 If Answer = vbYes Then
    Set rs = New ADODB.Recordset
    MakeConnection                                  '连接数据库
    Set rs.ActiveConnection = CN
    rs.Source = "select * from " & dataTable
    rs.Open                                         '删除信息
    str = "delete * from " & dataTable & " where " & selectkey & "='" & Me.txtData(0).Text & "'"
    CN.Execute str
    delConnection                                    '断开数据库
                   '清空纪录
    For j = 0 To i
        Me.txtData(j) = ""
        Next j
    MsgBox "删除成功！"
    Exit Sub
 Else
    Exit Sub             '防止没有操作时，出现错误提示框
 End If
errh:
     MsgBox Err.Description
End Sub

Private Sub cmdExit_Click()             '退出窗体
    Unload Me
End Sub

Private Sub cmdSave_Click()             '保存数据
 Dim str As String
 Dim strLb As String
If Me.txtData(0).Text = "" Then
   strLb = "请输入" & Trim(Left(Me.Label1.Caption, Len(Trim(Me.Label1.Caption)) - 1))
   MsgBox strLb
   Me.txtData(0).SetFocus
   Exit Sub
End If
If Me.txtData(1).Text = "" Then
   strLb = "请输入" & Trim(Left(Me.Label2.Caption, Len(Trim(Me.Label2.Caption)) - 1))
   MsgBox strLb
   Me.txtData(1).SetFocus
   Exit Sub
End If
If Me.txtData(2).Text = "" Then
   strLb = "请输入" & Trim(Left(Me.Label3.Caption, Len(Trim(Me.Label3.Caption)) - 1))
   MsgBox strLb
   Me.txtData(2).SetFocus
   Exit Sub
End If
If Me.txtData(3).Text = "" Then
   strLb = "请输入" & Trim(Left(Me.Label4.Caption, Len(Trim(Me.Label4.Caption)) - 1))
   MsgBox strLb
   Me.txtData(3).SetFocus
   Exit Sub
End If
If Me.txtData(4).Text = "" Then
   strLb = "请输入" & Trim(Left(Me.Label5.Caption, Len(Trim(Me.Label5.Caption)) - 1))
   MsgBox strLb
   Me.txtData(4).SetFocus
   Exit Sub
End If
If Me.txtData(5).Text = "" Then
   strLb = "请输入" & Trim(Left(Me.Label6.Caption, Len(Trim(Me.Label6.Caption)) - 1))
   MsgBox strLb
   Me.txtData(5).SetFocus
   Exit Sub
Else
   Set rs = New ADODB.Recordset
   MakeConnection
   Set rs.ActiveConnection = CN
   rs.Source = "select * from " & dataTable & " where " & selectkey & "='" & Me.txtData(0).Text & "'"
   rs.Open
   If rs.EOF Then
       delConnection                           '断开数据库的连接
       MakeConnection                          '重新连接数据库
       Set rs = New ADODB.Recordset
       rs.LockType = adLockOptimistic
       rs.CursorType = adOpenKeyset
       rs.Open dataTable, CN, , , adCmdTable
       rs.AddNew
       For j = 0 To i - 1
           rs.Fields(j).Value = Me.txtData(j).Text
           Next j
       rs.Update                      '更新数据库
       delConnection                  '断开连接
       MsgBox "保存在成功！", vbOKOnly, "恭喜你！"
       Exit Sub
   Else
      If Me.txtData(0).Text = rs.Fields(0).Value Then
          MsgBox "数据库中已经存在数据，请重新输入"
          Me.txtData(0).SetFocus
          Exit Sub
      End If
   End If
End If

errh:                         '错误信息
     MsgBox Err.Description
End Sub

Private Sub cmdSelect_Click()       '查询信息
 On Error GoTo errh
If txtData(i).Text = "" Then
    MsgBox "请在框中输入关键的数据，以便查询"
    txtData(i).SetFocus
    Exit Sub
End If
Dim str As String
Dim j As Integer
Set rs = New ADODB.Recordset
   MakeConnection                      '连接数据库
Set rs.ActiveConnection = CN
rs.Source = " select * from " & dataTable & " where  " & selectkey & "='" & txtData(i).Text & "'"
rs.Open
If rs.EOF Then
    MsgBox "没有找到你所要求的纪录！请重新输入关键字！"
    delConnection
    Me.txtData(i) = ""
    Me.txtData(i).SetFocus
    Exit Sub
Else
   If txtData(i).Text = rs.Fields(0).Value Then
      For j = 0 To i - 1                             '将数据库的值显示出来
          Me.txtData(j).Text = rs.Fields(j).Value
          Next j
      delConnection               '断开连接数据库
      MsgBox "找到你要查询的数据"
      Exit Sub
    End If
End If
errh:
     MsgBox Err.Description
End Sub

Private Sub cmdUpdata_Click()
 On Error GoTo errh
 Dim j As Integer
 Dim str As String
    Me.cmdAdd.Enabled = False
    Me.cmdDel.Enabled = False
    Me.cmdSave.Enabled = True
    If Me.txtData(0).Text = "" Then
        MsgBox "你没有要更新的内容，请查询后再更新！"
        Exit Sub
    End If
    Set rs = New ADODB.Recordset       '更新之前，先删除旧的信息
    MakeConnection
    Set rs.ActiveConnection = CN
    rs.Source = "select * from " & dataTable
    rs.Open
    str = "delete * from " & dataTable & " where " & selectkey & "='" & Me.txtData(0).Text & "'"
    CN.Execute str
    delConnection      '断开连接
                       '写入新数据
    MakeConnection
    Set rs = New ADODB.Recordset
    rs.LockType = adLockOptimistic
    rs.CursorType = adOpenKeyset
    rs.Open dataTable, CN, , , adCmdTable
    rs.AddNew
    For j = 0 To i - 1
        rs.Fields(j).Value = Me.txtData(j).Text
        Next j
    rs.Update
    delConnection        '断开连接
    MsgBox "更新成功！", vbOKOnly, "恭喜你！"
    Exit Sub
    
errh:                                '出错处理
         MsgBox Err.Description
End Sub

Private Sub Form_Load()
    i = 7
    dataTable = "电子教案表"
    selectkey = "电子教案号"
    MakeCenter Me                       '窗体位于屏幕中间
End Sub