frmaddress.frm

彩票 查询 ACCE 数据库 支持 添加 删除 搜索 等操作

VERSION 5.00
Begin VB.Form frmMain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "数据库控制演示程序"
   ClientHeight    =   2025
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4515
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2025
   ScaleWidth      =   4515
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox Text1 
      Height          =   270
      Left            =   2280
      TabIndex        =   10
      Text            =   "Text1"
      Top             =   600
      Width           =   2175
   End
   Begin VB.Timer Timer1 
      Interval        =   200
      Left            =   120
      Top             =   1560
   End
   Begin VB.ComboBox Combo1 
      Height          =   300
      Left            =   720
      TabIndex        =   9
      Text            =   "Combo1"
      Top             =   600
      Width           =   1455
   End
   Begin VB.CommandButton cmdDelete 
      Caption         =   "删除"
      Height          =   255
      Left            =   1920
      TabIndex        =   8
      Top             =   1080
      Width           =   735
   End
   Begin VB.CommandButton cmdAdd 
      Caption         =   "添加"
      Height          =   255
      Left            =   960
      TabIndex        =   7
      Top             =   1080
      Width           =   735
   End
   Begin VB.CommandButton cmdSearch 
      Caption         =   "搜索"
      Height          =   255
      Left            =   2880
      TabIndex        =   6
      Top             =   1080
      Width           =   735
   End
   Begin VB.CommandButton cmdBack 
      Caption         =   "<<"
      Height          =   255
      Left            =   120
      TabIndex        =   5
      ToolTipText     =   "上一条"
      Top             =   1080
      Width           =   615
   End
   Begin VB.CommandButton cmdForward 
      Caption         =   ">>"
      Height          =   255
      Left            =   3840
      TabIndex        =   4
      ToolTipText     =   "下一条"
      Top             =   1080
      Width           =   615
   End
   Begin VB.TextBox txtcal 
      Height          =   285
      Left            =   2280
      TabIndex        =   1
      Top             =   120
      Width           =   2175
   End
   Begin VB.TextBox txtno 
      Height          =   285
      Left            =   720
      TabIndex        =   0
      Top             =   120
      Width           =   855
   End
   Begin VB.Label Label2 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      Caption         =   "号码:"
      Height          =   180
      Left            =   1680
      TabIndex        =   3
      Top             =   120
      Width           =   450
   End
   Begin VB.Label Label1 
      Alignment       =   1  'Right Justify
      Caption         =   "期号:"
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   495
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim db As Database
Dim rs As Recordset


Private Sub cmdAdd_Click()
no = InputBox("输入期号", "输入期号")
cal = InputBox("输入号码", "输入号码")
'newPhone = InputBox("输入电话", "AddressBook")
'newFax = InputBox("输入传真", "AddressBook")

With rs
.AddNew
!no = LCase(no)
!cal = LCase(cal)
'!Phone = LCase(newPhone)
'!Fax = LCase(newFax)
.Update
End With

MsgBox (no & "期 添加成功")


End Sub

Private Sub cmdBack_Click()
On Error Resume Next
rs.MovePrevious
txtno = rs.Fields("no")
txtcal = rs.Fields("call")
'txtPhone = rs.Fields("Phone")
'txtFax = rs.Fields("Fax")
End Sub


Private Sub cmdDelete_Click()

Set rs = db.OpenRecordset("SELECT 2009.no, 2009.cal from 2009 where 2009.no = " + Chr$(34) + txtno.Text + Chr$(34) + ";")
', ppl.phone, ppl.fax From ppl WHERE ppl.name = " + Chr$(34) + txtName.Text + Chr$(34) + ";")

On Error Resume Next
rs.MoveFirst
Do Until rs.EOF
rs.Delete
rs.MoveNext
Loop
db.Close




End Sub

Private Sub cmdForward_Click()
On Error Resume Next
rs.MoveNext
txtno = rs.Fields("no")
txtcal = rs.Fields("cal")
'txtPhone = rs.Fields("Phone")
'txtFax = rs.Fields("Fax")
End Sub

Private Sub cmdSearch_Click()
Set rs = db.OpenRecordset("SELECT * FROM 2009")
noQuery = InputBox("请输入期号，格式例如|： 20090101 ", "查询")


rs.MoveFirst
Do Until rs.EOF

If rs.Fields("no") Like "*" & LCase(noQuery) & "*" Then
txtno = rs.Fields("no")
txtcal = rs.Fields("cal")
'txtPhone = rs.Fields("Phone")
'txtFax = rs.Fields("Fax")
Exit Sub
Else
rs.MoveNext
End If


Loop







End Sub

Private Sub Form_Load()
Set db = OpenDatabase(App.Path + "/2009.mdb")
Set rs = db.OpenRecordset("2009")

'----------
cmdDelete.Enabled = False
'---------

If rs.EOF Then
MsgBox "Please Add Someone To The Databse"
Else
rs.MoveFirst
txtno = rs.Fields("no")
txtcal = rs.Fields("cal")
'txtPhone = rs.Fields("Phone")
'txtFax = rs.Fields("Fax")
End If

'For i = 2009001 To 2009041
'Combo1.AddItem (i)
'
'Next i



Do Until rs.EOF
Combo1.AddItem rs("no")
rs.MoveNext
Loop

End Sub


Private Sub Timer1_Timer()
'Set db = OpenDatabase(App.Path + "/2009.mdb")
Set rs = db.OpenRecordset("2009")
Dim n As Integer
n = rs.RecordCount
For i = 0 To n
Select Case Combo1.ListIndex
Case i
rs.Move i
Text1 = rs("no")
End Select
Next i
End Sub