Dimlink1AsNewADODB.Connection
　　DimrsAsNewADODB.Recordset
　　DimpageAsInteger
　　DimpubdatapathAsString
　　Subopendatabase(datapathAsString)'打开数据库函数
　　page=1'首次定义打开时的页码为1
　　Iflink1.State=1Then'如果以连接过，则关闭，初始化下次事务
　　link1.Close:list2.ListItems.Clear:list2.ColumnHeaders.Clear:c.Clear:list1.ListItems.Clear
　　EndIf
　　link1.ConnectionString="Provider=microsoft.jet.oledb.4.0;datasource="&datapath
　　link1.Open
　　pubdatapath=datapath
　　Setbiaoming=link1.OpenSchema(adSchemaColumns)'创建数据库记录集
　　tablename=""
　　DoUntilbiaoming.EOF
　　Ifbiaoming("table_name")<>tablenameThen'列出所有表
　　tablename=biaoming("table_name")
　　list1.ListItems.Add,,tablename
　　EndIf
　　biaoming.MoveNext
　　Loop
　　Setbiaoming=Nothing
　　menu1.Enabled=True
　　list1_MouseUp1,0,10,10
　　EndSub
　　PrivateSubCommand1_Click()'打开数据库
　　d.DialogTitle="打开一个数据库文件进行浏览"
　　d.InitDir=App.Path
　　d.FileName=""
　　d.Filter="Access数据库(mdb后缀,推荐格式)　*.mdb"
　　d.ShowOpen
　　Ifd.FileName=""ThenExitSub
　　opendatabased.FileName
　　EndSub
　　
　　PrivateSubCommand4_Click()
　　str1=InputBox("请输入一个1-5000之间的数字","重设",Text1.Text)
　　Ifstr1=Text1.TextOrstr1=""ThenExitSub
　　IfIsNumeric(str1)=FalseThenExitSub
　　Ifstr1>5000Orstr1<1ThenExitSub
　　Text1.Text=str1
　　Iflist1.ListItems.Count=0ThenExitSubElselist1_MouseUp1,0,10,10
　　EndSub　　
　　PrivateSubdown_Click()'功能，下一页
　　page=page 1:list1_MouseUp1,0,10,10
　　EndSub　　
　　PrivateSubfindstr_Click()'查询数据
　　IfInStr(Text2.Text,"'")<>0ThenMsgBox"查询时关键字不允许包含'符号",vbCritical,"无效字符":ExitSub
　　Ifrs.State=1Thenrs.Close
　　rs.Open"select"&c.Text&"from"&list1.SelectedItem.Text&"where"&c.Text&"like'"&Text2.Text&"'",
link1,adOpenStatic,adLockReadOnly
　　Ifrs.EOFThenMsgBox"没有符号条件的记录,请从新查找",vbCritical,"未发现记录":ExitSub
　　DoWhileNotrs.EOF
　　i=i 1
　　str1=str1&i&"："&rs(0)&vbCrLf
　　rs.MoveNext
　　Loop
　　MsgBoxstr1,vbExclamation,"查询结果-"&rs.RecordCount&"匹配"
　　EndSub
　　　　
　　PrivateSubForm_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
　　EndSub
　　PrivateSubForm_Unload(CancelAsInteger)
　　Ifrs.State=1Thenrs.Close
　　Iflink1.State=1Thenlink1.Close
　　Setrs=Nothing:Setlink1=Nothing
　　EndSub　　
　　PrivateSublist1_MouseUp(ButtonAsInteger,ShiftAsInteger,xAsSingle,yAsSingle)'切换表
　　OnErrorResumeNext
　　Iflist1.ListItems.Count=0ThenExitSub
　　Ifrs.State=1Thenrs.Close
　　list2.ListItems.Clear:list2.ColumnHeaders.Clear:c.Clear
　　rs.Open"select*from"&list1.SelectedItem.Text,link1,adOpenStatic,adLockReadOnly
　　IfErr.Number<>0Then
　　MsgBox"该数据表不能支持的游标模式",vbCritical,"不规则的格式":ExitSub
　　EndIf
　　rs.PageSize=Text1.Text
　　rslen=rs.RecordCount
　　Ifrs.PageCount<pageThenpage=1
　　Label3.Caption="共"&rslen&"条记录,共"&rs.PageCount&"页,当前页码"&page
　　Ifrs.PageCount>pageThendown.Enabled=TrueElsedown.Enabled=False
　　Ifpage<>1Thenup.Enabled=TrueElseup.Enabled=False
　　Setziduan=rs.Fields'定义字段记录集
　　Fori=0Toziduan.Count-1
　　list2.ColumnHeaders.Add,,ziduan(i).Name'根据字段指定视图列
　　c.AddItemziduan(i).Name
　　rs.MoveFirst'记录到尾后填充下一列
　　rs.AbsolutePage=page'定义记录集的绝对页码
　　Forr=0Tors.PageSize-1
　　Ifrs.EOFThenExitFor
　　rstext=rs(i)
　　Ifi=0Then'首次直接填充第一列
　　list2.ListItems.Add,,rstext
　　Else'非首次填充下一下
　　Ifrstext<>EmptyThenlist2.ListItems(r 1).ListSubItems.Add,,rstextElselist2.ListItems(r 1).ListSubItems.Add,,""
　　EndIf
　　rs.MoveNext
　　Next
　　Next
　　Ifc.ListCount<>0Thenc.ListIndex=0:findstr.Enabled=TrueElsefindstr.Enabled=False
　　Setziduan=Nothing
　　EndSub　　
　　PrivateSubmenu01_Click(IndexAsInteger)
　　SelectCaseIndex
　　Case1:'建新表演示
　　str1=1
　　Fori=1Tolist1.ListItems.Count
　　IfInStr(list1.ListItems(i).Text,"新建表")=1Thenstr1=str1 1
　　Next
　　link1.Execute"createtable新建表"&str1&"(会员名Text,密码Varchar(8),年龄intnotnull,经验值"&_
　　"integer,加入日期DateTimenull)"
　　link1.Execute"insertinto新建表"&str1&"(会员名,密码,年龄,经验值,加入日期)values('风云舞','12345678'"&_
　　",18,365,'"&Now&"')"
　　link1.Execute"insertinto新建表"&str1&"(会员名,密码,年龄,经验值,加入日期)values('Lshdic','87654321'"&_
　　",18,365,'"&Now&"')"
　　opendatabasepubdatapath'刷新重装载列表
　　Case2:'刷新——重装载
　　opendatabasepubdatapath
　　Case3:'删除
　　Ifrs.State=1Thenrs.Close
　　link1.Execute"Droptable"&list1.SelectedItem.Text
　　opendatabasepubdatapath
　　Case4:'表属性
　　Ifrs.State=1Thenrs.Close
　　rs.Open"select*from"&list1.SelectedItem.Text,link1,adOpenStatic,adLockReadOnly
　　Fori=0Tors.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,"表属性"
　　EndSelect
　　EndSub　　
　　PrivateSuBText2_GotFocus()
　　IfText2.Text="查找关键字..."ThenText2.Text=""
　　EndSub　　
　　PrivateSuBText2_LostFocus()
　　IfText2.Text=""ThenText2.Text="查找关键字..."
　　EndSub　　
　　PrivateSubup_Click()'功能，上一页
　　page=page-1:list1_MouseUp1,0,10,10
　　EndSub