VB6+ADO+ListView数据库分页显示                  作者：unknown 更新时间： 2005-05-02                                              　　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

评论