VB6 ADO ListView数据库分页显示

核心提示：Dimlink1AsNewADODB.ConnectionDimrsAsNewADODB.RecordsetDimpageAsIntegerDimpubdatapathAsStringSubopendatabase(datapathAsString)'打开数据库函数page=1'首次定义打开时的页码为1

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

->