Other systems

Development Platform:
Visual Basic

Form1.frm：Code Content
							VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "数据库操作实例-----简易通讯录-----By AlicE-----西工大17191班"
   ClientHeight    =   5985
   ClientLeft      =   -645
   ClientTop       =   150
   ClientWidth     =   7110
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   5985
   ScaleWidth      =   7110
   Begin VB.Frame Frame3 
      Caption         =   "修改、删除"
      Height          =   1935
      Left            =   240
      TabIndex        =   13
      Top             =   3840
      Width           =   6375
      Begin VB.TextBox Text13 
         BackColor       =   &H80000004&
         Height          =   375
         Left            =   1680
         TabIndex        =   32
         Top             =   1440
         Width           =   1695
      End
      Begin VB.TextBox Text12 
         BackColor       =   &H80000004&
         Height          =   375
         Left            =   4440
         TabIndex        =   30
         Top             =   840
         Width           =   1815
      End
      Begin VB.CommandButton Command5 
         Caption         =   "删除"
         Height          =   495
         Left            =   3480
         TabIndex        =   23
         Top             =   240
         Width           =   1215
      End
      Begin VB.CommandButton Command4 
         Caption         =   "修改"
         Height          =   495
         Left            =   4920
         TabIndex        =   22
         Top             =   240
         Width           =   1335
      End
      Begin VB.TextBox Text9 
         BackColor       =   &H80000004&
         Height          =   375
         Left            =   3840
         TabIndex        =   21
         Top             =   1440
         Width           =   2415
      End
      Begin VB.TextBox Text8 
         BackColor       =   &H80000004&
         Height          =   375
         Left            =   1680
         TabIndex        =   18
         Top             =   840
         Width           =   1860
      End
      Begin VB.CommandButton Command3 
         Caption         =   "显示结果"
         Height          =   495
         Left            =   2040
         TabIndex        =   16
         Top             =   240
         Width           =   1215
      End
      Begin VB.TextBox Text7 
         Height          =   375
         Left            =   960
         TabIndex        =   15
         Top             =   240
         Width           =   735
      End
      Begin VB.Label Label14 
         Caption         =   "访问次数"
         Height          =   255
         Left            =   840
         TabIndex        =   31
         Top             =   1560
         Width           =   735
      End
      Begin VB.Label Label13 
         Caption         =   "验证码"
         Height          =   375
         Left            =   3720
         TabIndex        =   29
         Top             =   960
         Width           =   855
      End
      Begin VB.Label Label10 
         Caption         =   "备注"
         Height          =   255
         Left            =   3480
         TabIndex        =   20
         Top             =   1560
         Width           =   495
      End
      Begin VB.Label Label9 
         Caption         =   "文件名"
         Height          =   375
         Left            =   1080
         TabIndex        =   19
         Top             =   960
         Width           =   615
      End
      Begin VB.Label Label8 
         Caption         =   "当前数据："
         Height          =   375
         Left            =   120
         TabIndex        =   17
         Top             =   960
         Width           =   975
      End
      Begin VB.Label Label7 
         Caption         =   "ID值"
         Height          =   255
         Left            =   480
         TabIndex        =   14
         Top             =   360
         Width           =   495
      End
   End
   Begin VB.Frame Frame2 
      Caption         =   "添加"
      Height          =   1695
      Left            =   240
      TabIndex        =   7
      Top             =   2040
      Width           =   6375
      Begin VB.TextBox Text11 
         Height          =   375
         Left            =   960
         TabIndex        =   28
         Top             =   960
         Width           =   1575
      End
      Begin VB.TextBox Text10 
         Height          =   375
         Left            =   3240
         TabIndex        =   26
         Top             =   240
         Width           =   1335
      End
      Begin VB.CommandButton Command6 
         Caption         =   "显示所有"
         Height          =   495
         Left            =   4920
         TabIndex        =   24
         Top             =   240
         Width           =   1335
      End
      Begin VB.CommandButton Command2 
         Caption         =   "添加"
         Height          =   495
         Left            =   4920
         TabIndex        =   12
         Top             =   840
         Width           =   1335
      End
      Begin VB.TextBox Text6 
         Height          =   375
         Left            =   3120
         TabIndex        =   11
         Top             =   960
         Width           =   1575
      End
      Begin VB.TextBox Text5 
         Height          =   375
         Left            =   960
         TabIndex        =   10
         Top             =   240
         Width           =   1455
      End
      Begin VB.Label Label12 
         Caption         =   "访问次数"
         Height          =   375
         Left            =   120
         TabIndex        =   27
         Top             =   1080
         Width           =   855
      End
      Begin VB.Label Label11 
         Caption         =   "验证码"
         Height          =   375
         Left            =   2520
         TabIndex        =   25
         Top             =   360
         Width           =   735
      End
      Begin VB.Label Label6 
         Caption         =   "备注"
         Height          =   375
         Left            =   2640
         TabIndex        =   9
         Top             =   1080
         Width           =   495
      End
      Begin VB.Label Label5 
         Caption         =   "文件名"
         Height          =   255
         Left            =   120
         TabIndex        =   8
         Top             =   360
         Width           =   735
      End
   End
   Begin VB.CommandButton Command1 
      Caption         =   "查询"
      Height          =   375
      Left            =   1920
      TabIndex        =   0
      Top             =   960
      Width           =   975
   End
   Begin VB.Frame Frame1 
      Caption         =   "查询"
      Height          =   1575
      Left            =   240
      TabIndex        =   1
      Top             =   120
      Width           =   6375
      Begin VB.TextBox Text1 
         Height          =   375
         Left            =   3480
         TabIndex        =   35
         Top             =   360
         Width           =   2535
      End
      Begin VB.ComboBox Combo2 
         Height          =   300
         ItemData        =   "Form1.frx":038A
         Left            =   1920
         List            =   "Form1.frx":03A0
         TabIndex        =   34
         Text            =   "请选择表"
         Top             =   360
         Width           =   1215
      End
      Begin VB.ComboBox Combo1 
         Height          =   300
         ItemData        =   "Form1.frx":03D2
         Left            =   360
         List            =   "Form1.frx":03D4
         TabIndex        =   33
         Text            =   "请选择库"
         Top             =   360
         Width           =   1335
      End
      Begin VB.TextBox Text4 
         BackColor       =   &H80000004&
         Enabled         =   0   'False
         Height          =   375
         Left            =   5160
         TabIndex        =   5
         Top             =   840
         Width           =   735
      End
      Begin VB.TextBox Text3 
         BackColor       =   &H80000004&
         Enabled         =   0   'False
         Height          =   375
         Left            =   3960
         TabIndex        =   2
         Top             =   840
         Width           =   735
      End
      Begin VB.Label Label3 
         Height          =   495
         Left            =   1800
         TabIndex        =   6
         Top             =   240
         Width           =   1335
      End
      Begin VB.Label Label2 
         Caption         =   "到"
         Height          =   255
         Left            =   4800
         TabIndex        =   4
         Top             =   960
         Width           =   255
      End
      Begin VB.Label Label1 
         Caption         =   "ID的范围从"
         Height          =   255
         Left            =   2880
         TabIndex        =   3
         Top             =   960
         Width           =   975
      End
   End
   Begin VB.Menu File1 
      Caption         =   "文件(&F)"
      Begin VB.Menu source1 
         Caption         =   "源码(&S)"
      End
      Begin VB.Menu exit1 
         Caption         =   "退出(&X)"
      End
   End
   Begin VB.Menu beifen 
      Caption         =   "备份(&E)"
   End
   Begin VB.Menu about1 
      Caption         =   "关于(&A)"
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim DBS As Database
Dim counter As Integer
Private Sub about1_Click()
frmAbout.Show
End Sub
Private Sub beifen_Click()
Dim fso As New FileSystemObject, fil As File
Set fil = fso.GetFile(AppP & "data.mdb")
fil.Copy (AppP & "backupdata_" & Date & ".mdb")
MsgBox "数据备份已经成功完成！" & vbCrLf & "数据备份到文件夹：" & AppP & "backup" & vbCrLf & _
"数据还原方法：拷贝备份文件到" & AppP & "替换原数据文件", vbInformation, "备份提示"
End Sub
Private Sub Combo2_Click()
If Combo2.ListIndex = 5 Then
Text1.BackColor = &H80000004
Text3.BackColor = &H80000005
Text4.BackColor = &H80000005
Text3.Enabled = True
Text4.Enabled = True
Text1.Enabled = False
Else
Text3.BackColor = &H80000004
Text4.BackColor = &H80000004
Text1.BackColor = &H80000005
Text3.Enabled = False
Text4.Enabled = False
Text1.Enabled = True
End If
End Sub
Private Sub Command1_Click()
'ID查询
If Combo2.ListIndex = 0 Then
LSQL = Trim(Text1.Text)
SQLNow = "select * from info where ID like '%" & LSQL & "%'  order by ID"
Form3.Show
End If
'文件名查询
If Combo2.ListIndex = 1 Then
LSQL = Trim(Text1.Text)
SQLNow = "select * from info where 文件名 like '%" & LSQL & "%'  order by ID"
Form3.Show
End If
'验证码查询
If Combo2.ListIndex = 2 Then
LSQL = Trim(Text1.Text)
SQLNow = "select * from info where 验证码 like '%" & LSQL & "%'  order by ID"
Form3.Show
End If
'访问次数查询
If Combo2.ListIndex = 3 Then
LSQL = Trim(Text1.Text)
SQLNow = "select * from info where 访问次数 like '%" & LSQL & "%'  order by ID"
Form3.Show
End If
'状态查询
If Combo2.ListIndex = 4 Then
LSQL = Trim(Text1.Text)
SQLNow = "select * from info where 状态 like '%" & LSQL & "%'  order by ID"
Form3.Show
End If
'ID查询
If Combo2.ListIndex = 5 Then
If Trim(Text3.Text) = "" Or Trim(Text4.Text) = "" Then
MsgBox "请输入数值！", vbExclamation, "错误提示"
Exit Sub
ElseIf CInt(Trim(Text4.Text)) < CInt(Trim(Text3.Text)) Then
MsgBox "请输入正确的数值！", vbExclamation, "错误提示"
Else
LSQL = "where 文件名 like '此列为%' or ID>=" & CInt(Trim(Text3.Text)) & " and ID<=" & CInt(Trim(Text4.Text)) & "  order by ID"
SQLNow = "select * from info " & LSQL
Form3.Show
End If
End If
End Sub
Private Sub Command2_Click()
Dim RSEMail As Recordset
Dim counter As String
If Trim(Text5.Text) = "" Then
MsgBox "名称不能为空！", vbExclamation, "错误提示"
Exit Sub
Else
value1 = Trim(Text5.Text)
value2 = Trim(Text6.Text)
value3 = Trim(Text10.Text)
value4 = Trim(Text11.Text)
Call InsertFunction
End If
End Sub
Private Sub Command3_Click()
Dim DataID As Integer
If Trim(Text7.Text) = "" Then
MsgBox "请输入正确的ID值！", vbExclamation, "错误提示"
Exit Sub
End If
Set DBEmail = OpenDatabase(AppP & "data.mdb", ture, ture, ";Pwd=lyttlyqjhqjw ")
Set RSEMail = DBEmail.OpenRecordset("select 文件名,验证码,访问次数,状态 from info where ID=" & CInt(Trim(Text7.Text)), dbOpenDynaset, dbSeeChanges, dbOptimistic)
If RSEMail.EOF Then
MsgBox "没有这个ID的纪录！", vbInformation, "错误提示"
RSEMail.Close
Set RSEMail = Nothing
Exit Sub
End If
Text8.Text = RSEMail.Fields("文件名").Value & ""
Text12.Text = RSEMail.Fields("验证码").Value & ""
Text13.Text = RSEMail.Fields("访问次数").Value & ""
Text9.Text = RSEMail.Fields("状态").Value & ""
RSEMail.Close
Set RSEMail = Nothing
Text7.BackColor = &H80000004
Text8.BackColor = &H80000005
Text9.BackColor = &H80000005
Text12.BackColor = &H80000005
Text13.BackColor = &H80000005
End Sub
Private Sub Command4_Click()
If Trim(Text8.Text) = "" Then
MsgBox "先按下显示结果按钮才能更新修改数据。", vbInformation, "提示"
Exit Sub
End If
If MsgBox("你真的要修改这个纪录吗？", vbYesNo + vbQuestion, "确认修改") = vbYes Then
Set DBEmail = OpenDatabase(AppP & "data.mdb", ture, ture, ";Pwd=lyttlyqjhqjw ")
Set RSEMail = DBEmail.OpenRecordset("select * from info where ID=" & CInt(Trim(Text7.Text)), dbOpenDynaset, dbSeeChanges, dbOptimistic)
RSEMail.Edit
RSEMail.Fields("文件名") = Trim(Text8.Text)
RSEMail.Fields("验证码") = Trim(Text12.Text)
RSEMail.Fields("访问次数") = Trim(Text13.Text)
RSEMail.Fields("状态") = Trim(Text9.Text)
RSEMail.Update
RSEMail.Close
Set RSEMail = Nothing
MsgBox "修改成功！" & vbCrLf & "相关信息：" & vbCrLf & "文件名：" & Trim(Text8.Text) _
& vbCrLf & "验证码：" & Trim(Text12.Text) & vbCrLf & "访问次数：" & Trim(Text13.Text) & vbCrLf _
& "备注：" & Trim(Text9.Text), vbInformation, "提示"
End If
End Sub
Private Sub Command5_Click()
If Trim(Text7.Text) = "" Then
MsgBox "请输入正确的ID值！", vbExclamation, "错误提示"
Exit Sub
End If
Set DBEmail = OpenDatabase(AppP & "data.mdb", ture, ture, ";Pwd=lyttlyqjhqjw ")
Set RSEMail = DBEmail.OpenRecordset("select 文件名 from info where ID=" & CInt(Trim(Text7.Text)), dbOpenDynaset, dbSeeChanges, dbOptimistic)
If RSEMail.EOF Then
MsgBox "没有这个ID的纪录！", vbInformation, "提示"
RSEMail.Close
Set RSEMail = Nothing
Exit Sub
End If
datavalue = RSEMail.Fields("文件名").Value
If MsgBox("你真的要删除这个纪录吗？", vbYesNo + vbQuestion, "确认删除") = vbYes Then
RSEMail.Edit
RSEMail.Delete
RSEMail.Close
Set RSEMail = Nothing
MsgBox "纪录" & datavalue & "已经被删除。", vbInformation, "提示"
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
End If
End Sub
Private Sub Command6_Click()
Dim RS As Recordset
Dim AppPath
Form2.Show
End Sub
Private Sub exit1_Click()
End
End Sub
Private Sub Form_Load()
Dim X0 As Long
Dim Y0 As Long
Call GetAppPath
    '让窗体居中
    X0 = Screen.Width
    Y0 = Screen.Height
    X0 = (X0 - Me.Width) / 2
    Y0 = (Y0 - Me.Height) / 2
    Me.Move X0, Y0
End Sub
Private Sub Form_Unload(Cancel As Integer)
Cancel = True
 Select Case MsgBox("您真的想退出吗?", vbOKCancel + vbQuestion, "确认退出本程序")
Case vbOK
End
Cancel = False
Case Else
Cancel = True
End Select
End Sub
Private Sub Option1_Click()
Text1.BackColor = &H80000004
Text2.BackColor = &H80000005
Text3.BackColor = &H80000004
Text4.BackColor = &H80000004
End Sub
Private Sub Option2_Click()
Text1.BackColor = &H80000005
Text2.BackColor = &H80000004
Text3.BackColor = &H80000004
Text4.BackColor = &H80000004
End Sub
Private Sub Option3_Click()
Text1.BackColor = &H80000004
Text2.BackColor = &H80000004
Text3.BackColor = &H80000005
Text4.BackColor = &H80000005
End Sub
Private Sub source1_Click()
form4.Show
End Sub
Private Sub Text7_GotFocus()
Text7.BackColor = &H80000005
End Sub

						