form1.frm

简单的通讯薄 名字=文件名=此列为文件名 QQ=验证码=此列为验证码 电话=访问次数=此列为访问次数

         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 & "backup\data_" & 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