数据库数据显示演示程序，在win98调试通过，详细请自行下载进行学习测试，程序大小29k
完整原程序下载地址:http://www.lshdic.com/download/lshdic/vb_adoread.zip
代码浏览：
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
