A database paging display program based on VB6 + ADO + ListView (complete original procedure)

Database Data Displays the demo, in Win98 debugging, please download your own learning test, program size 29k

Complete original program download address: http://www.lshdic.com/download/lshdic/vb_adoread.zip

Code Browse:

DIM LINK1 AS New Adodb.ConnectionDim Rs as new adodb.recordsetdim Page As integerdim PubdataPath As String

Sub OpenDatabase (DataPath AS String) 'Opens Database Function Page = 1' First Defining Time The page number is 1IF link1.state = 1 Then 'If connected, turn off, initialize the next transaction link1.close: list2.listItems. Clear: list2.ColumnHeaders.Clear: c.Clear: list1.ListItems.ClearEnd Iflink1.ConnectionString = "Provider = microsoft.jet.oledb.4.0; data source =" & datapathlink1.Openpubdatapath = datapathSet biaoming = link1.OpenSchema (adSchemaColumns) 'Create database records tablename = "" Do Until biaoming.EOFIf biaoming ( "table_name") <> tablename Then' lists all tables tablename = biaoming ( "table_name") list1.ListItems.Add,, tablenameEnd Ifbiaoming.MoveNextLoopSet biaoming = NothingMenu1.enabled = truelist1_mouseup 1, 0, 10, 10nd Subprivate Sub Command1_Click () 'Open Database D.Dialogtitle = "Open a database file for browsing" D.INITDIR = App.PathD.FileName = "" D.Filter = "Access Database (MDB suffix, recommended format) | * .MDB "D.ShowOpenif D.FileName =" "" "The EXIT Subopendatabase D.FileNameEnd Sub

Private subss4_click () str1 = inputbox ("Please enter a number of 1-5000 between", "Reset", Text1.Text) if str1 = text1.text or str1 = "" "" "" "" "" "" "" "" "" "" " False THEN EXIT SUBIF STR1> 5000 or str1 <1 thr1if list1.listitems.count = 0 THEN EXIT SUB ELSE LIST1_MOUSEUP 1, 0, 10, 10END SUB

Private sub Down_Click () function, next page Page 1: List1_mouseup 1, 0, 10, 10nd subprivate sub findstr_click () 'query data if INSTR (Text2.Text, "'") <> 0 THEN MSGBOX " The keyword does not allow the keyword to contain 'symbols, Vbcritical, "invalid characters": exit subif rt.State = 1 Then rs.close.open "SELECT" & C.Text & "from" & list1.selectedItem.text & " WHERE "& C.TEXT &" Like '% "& text2.text &"%' ", link1, adopenstatic, AdlockReadonlyif Rs.eof kilobox" No symbol condition record, please from the new look ", vbcritical," no record ": EXIT SUBDO While NOT RS.EOFI = I 1Str1 = STR1 & I & I &": "& VBCRLFRS.MOVENEXTLOOPMSGBOX STR1, VBEXCLAMATION," Query Results - "& rs.RecordCount &" Match "End Sub

Private Sub Form_Resize () list1.ColumnHeaders (1) .Width = list1.Width - 30list1.Height = Me.ScaleHeight - - 80list2.Width = Me.ScaleWidth - list2.Left list1.Top - 30list2.Height = Me.ScaleHeight - (ME.SCALEHEIGHT - DOWN.TOP) - 150END SUB

Private Sub Form_Unload (Cancel As Integer) if rs.State = 1 Then = 1 Then Link1.closset RS = Nothing: Set link1 = nothingend sub

Private Sub list1_MouseUp (Button As Integer, Shift As Integer, x As Single, y As Single) 'switching table On Error Resume NextIf list1.ListItems.Count = 0 Then Exit SubIf rs.State = 1 Then rs.Closelist2.ListItems.Clear : list2.columnheaders.clear: c. C. CLEARRS.OPEN "Select * from" & list1.selectedItem.text, link1, adopenStatic, AdlockReadonlyif err.number <> 0 Thenmsgbox "Camper mode cannot be supported by this data", vbcritical, " Irregular format ": EXIT SUBEND IFRS.PAGESIZE = text1.textrslen = rs.recordcountif rPageCount Page the down.enabled = true else down.enabled = falseif page <> 1 Tenabled = true else up.enabled = falseset ziduan = rs.fields' definition field record set for i = 0 to ziduan.count - 1List2.columnheaders.add, ziduan (i) .name 'According to field specified view column C.Additem Ziduan (i) .Namers.Movefirst' records the next column after filling the next column rs.absolutePage = Page 'Defined Record Set of Absolute Page in For R = 0 TO Rs.PageSize - 1IF Rs.eof Then EXIT FORRSTEXT = RS (I) IF i = 0 THEN 'The first time I first fill the first column list2.listitems.add, RSTextelse' non-RSTEXT <> EMPTY THEN List2.ListItems (R 1). ListSubitems.Add, RSText else list2.listItems (R 1 ) .Listsubitems.add,, "" endiffnextNextNextif C.ListCount <> 0 THEN C.LISTINDEX = 0: FindStr.Nabled = true else FindStr.enabled = falseset ziduan = Nothingend Sub

Private sub menu01_click (index as integer) Select Case Indexcase 1: 'Construction of New Feelings STR1 = 1for I = 1 to list1.listitems.countif inStr (List1.ListItems (i) .text, "New Table") = 1 Then Str1 = STR1 1NEXTLINK1.EXECUTE "CREATE TABLE new table" & str1 & "(member name text, password varchar (8), age int not null, experience value" & _ "Integer, joined date datetime null" link1.execute "insert INTO new table "& str1 &" (member name, password, age, experience value, joining date) VALUES ('Fengyun ",' 12345678 '" & _ ", 18, 365,'" & now & ")" Link1. " Execute "INSERT INTO" & str1 & "(member name, password, age, experience value, joining date) VALUES ('lshdic', '87654321'" & _ ", 18, 365, '" & now & ")" opendatabase pubdatapath 'reload refresh list Case 2:' refresh - reload opendatabase pubdatapathCase 3: 'delete If rs.State = 1 Then rs.Closelink1.Execute "Drop table" & list1.SelectedItem.Textopendatabase pubdatapathCase 4:' table properties IF = 0 = 0 To rsfields.count - 1Str1 = Str1 & Rount - 1Str1 = Str1 & Rount - 1Str1 = STR1 & RS.FIELDS (I). Name & "," str2 = str2 & rs.fields (i) .type & "," str3 = str3 & rs.fields (i) .Actualsize & "," str4 = str4 & rs.fields (i) .definedsize & "," nextmsgbox "contains fields:" & str1 & vbcrf & vbcrlf & "Type:" & str2 & vbcrf & vbcrlf & "first Row Data Size: "& _STR3 & VBCRLF & VBCRLF &" Data Preset Capacity: "& Str4, Vbexclamation," Table Properties "end SelectenD Sub

Private sub text2_gotfocus () if text2.text = "Find keywords ..." Ten Text2.text = "" "" f text2.text = "" TEXT2.TEXT = "Find Keywords ... "END SUB

Private sub Up_click () function, Previous page = page - 1: list1_mouseup 1, 0, 10, 10nd Sub