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="

　　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

　　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