用户登录  |  用户注册
首 页商业源码原创产品编程论坛
当前位置:PB创新网文章中心编程技巧VisualBasic

VB6+ADO+ListView数据库分页显示

减小字体 增大字体 作者:佚名  来源:本站整理  发布时间:2009-03-16 19:53:18
  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

Tags:

作者:佚名

文章评论评论内容只代表网友观点,与本站立场无关!

   评论摘要(共 0 条,得分 0 分,平均 0 分) 查看完整评论
PB创新网ourmis.com】Copyright © 2000-2009 . All Rights Reserved .
页面执行时间:10,265.63000 毫秒
Email:ourmis@126.com QQ:2322888 蜀ICP备05006790号