Dim link1 As New ADODB.Connection 　　Dim rs As New ADODB.Recordset 　　Dim page As Integer 　　Dim pubdatapath As String 　　Sub opendatabase(datapath As String) ’打开数据库函数 　　page = 1 ’首次定义打开时的页码为1 　　If link1.State = 1 Then ’如果以连接过，则关闭，初始化下次事务 　　link1.Close: list2.ListItems.Clear: list2.ColumnHeaders.Clear: c.Clear: list1.ListItems.Clear 　　End If 　　link1.ConnectionString = "Provider=microsoft.jet.oledb.4.0;data source=" & datapath 　　link1.Open 　　pubdatapath = datapath 　　Set biaoming = link1.OpenSchema(adSchemaColumns) ’创建数据库记录集 　　tablename = "" 　　Do Until biaoming.EOF 　　If biaoming("table_name") <> tablename Then ’列出所有表 　　tablename = biaoming("table_name") 　　list1.ListItems.Add , , tablename 　　End If 　　biaoming.MoveNext 　　Loop 　　Set biaoming = Nothing 　　menu1.Enabled = True 　　list1_MouseUp 1, 0, 10, 10 　　End Sub 　　Private Sub Command1_Click() ’打开数据库 　　d.DialogTitle = "打开一个数据库文件进行浏览" 　　d.InitDir = App.Path 　　d.FileName = "" 　　d.Filter = "Access数据库(mdb后缀,推荐格式)　*.mdb" 　　d.ShowOpen 　　If d.FileName = "" Then Exit Sub 　　opendatabase d.FileName 　　End Sub 　　 　　Private Sub Command4_Click() 　　str1 = InputBox("请输入一个1-5000之间的数字", "重设", Text1.Text) 　　If str1 = Text1.Text Or str1 = "" Then Exit Sub 　　If IsNumeric(str1) = False Then Exit Sub 　　If str1 > 5000 Or str1 < 1 Then Exit Sub 　　Text1.Text = str1 　　If list1.ListItems.Count = 0 Then Exit Sub Else list1_MouseUp 1, 0, 10, 10 　　End Sub　　 　　Private Sub down_Click() ’功能，下一页 　　page = page + 1: list1_MouseUp 1, 0, 10, 10 　　End Sub　　 　　Private Sub findstr_Click() ’查询数据 　　If InStr(Text2.Text, "’") <> 0 Then MsgBox "查询时关键字不允许包含 ’ 符号", vbCritical, "无效字符": Exit Sub 　　If rs.State = 1 Then rs.Close 　　rs.Open "select " & c.Text & " from " & list1.SelectedItem.Text & " where " & c.Text & " like ’%" & Text2.Text & "%’", link1, adOpenStatic, adLockReadOnly 　　If rs.EOF Then MsgBox "没有符号条件的记录,请从新查找", vbCritical, "未发现记录": Exit Sub 　　Do While Not rs.EOF 　　i = i + 1 　　str1 = str1 & i & " ： " & rs(0) & vbCrLf 　　rs.MoveNext 　　Loop 　　MsgBox str1, vbExclamation, "查询结果 - " & rs.RecordCount & "匹配" 　　End Sub 　　　　 　　Private Sub Form_Resize() 　　list1.ColumnHeaders(1).Width = list1.Width - 80 　　list2.Width = Me.ScaleWidth - list2.Left - 30 　　list1.Height = Me.ScaleHeight - list1.Top - 30 　　list2.Height = Me.ScaleHeight - (Me.ScaleHeight - down.Top) - 150 　　End Sub 　　Private Sub Form_Unload(Cancel As Integer) 　　If rs.State = 1 Then rs.Close 　　If link1.State = 1 Then link1.Close 　　Set rs = Nothing: Set link1 = Nothing 　　End Sub　　 　　Private Sub list1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) ’切换表 　　On Error Resume Next 　　If list1.ListItems.Count = 0 Then Exit Sub 　　If rs.State = 1 Then rs.Close 　　list2.ListItems.Clear: list2.ColumnHeaders.Clear: c.Clear 　　rs.Open "select * from " & list1.SelectedItem.Text, link1, adOpenStatic, adLockReadOnly 　　If Err.Number <> 0 Then 　　MsgBox "该数据表不能支持的游标模式", vbCritical, "不规则的格式": Exit Sub 　　End If 　　rs.PageSize = Text1.Text 　　rslen = rs.RecordCount 　　If rs.PageCount < page Then page = 1 　　Label3.Caption = "共" & rslen & "条记录,共" & rs.PageCount & "页,当前页码 " & page 　　If rs.PageCount > page Then down.Enabled = True Else down.Enabled = False 　　If page <> 1 Then up.Enabled = True Else up.Enabled = False 　　Set ziduan = rs.Fields ’定义字段记录集 　　For i = 0 To ziduan.Count - 1 　　list2.ColumnHeaders.Add , , ziduan(i).Name ’根据字段指定视图列 　　c.AddItem ziduan(i).Name 　　rs.MoveFirst ’记录到尾后填充下一列 　　rs.AbsolutePage = page ’定义记录集的绝对页码 　　For r = 0 To rs.PageSize - 1 　　If rs.EOF Then Exit For 　　rstext = rs(i) 　　If i = 0 Then ’首次直接填充第一列 　　list2.ListItems.Add , , rstext 　　Else ’非首次填充下一下 　　If rstext <> Empty Then list2.ListItems(r + 1).ListSubItems.Add , , rstext Else list2.ListItems(r + 1).ListSubItems.Add , , "" 　　End If 　　rs.MoveNext 　　Next 　　Next 　　If c.ListCount <> 0 Then c.ListIndex = 0: findstr.Enabled = True Else findstr.Enabled = False 　　Set ziduan = Nothing 　　End Sub　　 　　Private Sub menu01_Click(Index As Integer) 　　Select Case Index 　　Case 1: ’建新表演示 　　str1 = 1 　　For i = 1 To list1.ListItems.Count 　　If InStr(list1.ListItems(i).Text, "新建表") = 1 Then str1 = str1 + 1 　　Next 　　link1.Execute "create table 新建表" & str1 & "(会员名 Text,密码 Varchar(8),年龄 int not null,经验值 " & _ 　　"integer,加入日期 DateTime null)" 　　link1.Execute "insert into 新建表" & str1 & "(会员名,密码,年龄,经验值,加入日期) values (’风云舞’,’12345678’" & _ 　　",18,365,’" & Now & "’)" 　　link1.Execute "insert into 新建表" & str1 & "(会员名,密码,年龄,经验值,加入日期) values (’Lshdic’,’87654321’" & _ 　　",18,365,’" & Now & "’)" 　　opendatabase pubdatapath ’刷新重装载列表 　　Case 2: ’刷新——重装载 　　opendatabase pubdatapath 　　Case 3: ’删除 　　If rs.State = 1 Then rs.Close 　　link1.Execute "Drop table " & list1.SelectedItem.Text 　　opendatabase pubdatapath 　　Case 4: ’表属性 　　If rs.State = 1 Then rs.Close 　　rs.Open "select * from " & list1.SelectedItem.Text, link1, adOpenStatic, adLockReadOnly 　　For i = 0 To rs.Fields.Count - 1 　　str1 = str1 & rs.Fields(i).Name & "," 　　str2 = str2 & rs.Fields(i).Type & "," 　　str3 = str3 & rs.Fields(i).ActualSize & "," 　　str4 = str4 & rs.Fields(i).DefinedSize & "," 　　Next 　　MsgBox "包含字段:" & str1 & vbCrLf & vbCrLf & "字段类型:" & str2 & vbCrLf & vbCrLf & "第一行数据大小:" & _ 　　str3 & vbCrLf & vbCrLf & "每行数据预设容量:" & str4, vbExclamation, "表属性" 　　End Select 　　End Sub　　 　　Private Sub Text2_GotFocus() 　　If Text2.Text = "查找关键字..." Then Text2.Text = "" 　　End Sub　　 　　Private Sub Text2_LostFocus() 　　If Text2.Text = "" Then Text2.Text = "查找关键字..." 　　End Sub　　 　　Private Sub up_Click() ’功能，上一页 　　page = page - 1: list1_MouseUp 1, 0, 10, 10 　　End Sub

评论