www.pudn.com > mdb数据库到Txt文件的转换..zip > frmMain.frm


VERSION 5.00 
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX" 
Begin VB.Form frmMain  
   BorderStyle     =   1  'Fixed Single 
   Caption         =   "Listbox/Listview/Database Population Example" 
   ClientHeight    =   4884 
   ClientLeft      =   36 
   ClientTop       =   264 
   ClientWidth     =   7116 
   LinkTopic       =   "Form1" 
   MaxButton       =   0   'False 
   MinButton       =   0   'False 
   ScaleHeight     =   4884 
   ScaleWidth      =   7116 
   StartUpPosition =   3  'Windows Default 
   Begin VB.CommandButton cmd_lvRandomPop  
      Caption         =   "random pop" 
      Height          =   372 
      Left            =   5160 
      TabIndex        =   14 
      Top             =   3480 
      Width           =   1272 
   End 
   Begin VB.CommandButton cmd_lvPopDBLock  
      Caption         =   "lock n' pop db" 
      Height          =   372 
      Left            =   5160 
      TabIndex        =   13 
      Top             =   4440 
      Width           =   1272 
   End 
   Begin VB.CommandButton cmd_lvPopFileLock  
      Caption         =   "lock n' pop file" 
      Height          =   372 
      Left            =   5160 
      TabIndex        =   12 
      Top             =   3960 
      Width           =   1272 
   End 
   Begin VB.CommandButton cmd_lvDumpDB  
      Caption         =   "dump to db" 
      Height          =   372 
      Left            =   4080 
      TabIndex        =   11 
      Top             =   2520 
      Width           =   972 
   End 
   Begin VB.CommandButton cmd_lvClear  
      Caption         =   "clear list" 
      Height          =   372 
      Left            =   4080 
      TabIndex        =   10 
      Top             =   3480 
      Width           =   972 
   End 
   Begin VB.CommandButton cmd_lvPopDB  
      Caption         =   "pop db" 
      Height          =   372 
      Left            =   4080 
      TabIndex        =   9 
      Top             =   4440 
      Width           =   972 
   End 
   Begin VB.CommandButton cmd_lvDumpFile  
      Caption         =   "dump to file" 
      Height          =   372 
      Left            =   4080 
      TabIndex        =   8 
      Top             =   3000 
      Width           =   972 
   End 
   Begin VB.CommandButton cmd_lvPopFile  
      Caption         =   "pop file" 
      Height          =   372 
      Left            =   4080 
      TabIndex        =   7 
      Top             =   3960 
      Width           =   972 
   End 
   Begin MSComctlLib.ListView ListView1  
      Height          =   4752 
      Left            =   60 
      TabIndex        =   6 
      Top             =   60 
      Width           =   3912 
      _ExtentX        =   6900 
      _ExtentY        =   8382 
      View            =   3 
      LabelWrap       =   -1  'True 
      HideSelection   =   -1  'True 
      FullRowSelect   =   -1  'True 
      _Version        =   393217 
      ForeColor       =   -2147483640 
      BackColor       =   -2147483643 
      BorderStyle     =   1 
      Appearance      =   1 
      NumItems        =   3 
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}  
         Text            =   "Data1" 
         Object.Width           =   2540 
      EndProperty 
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}  
         SubItemIndex    =   1 
         Text            =   "Data2" 
         Object.Width           =   2540 
      EndProperty 
      BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}  
         SubItemIndex    =   2 
         Text            =   "Data3" 
         Object.Width           =   2540 
      EndProperty 
   End 
   Begin VB.CommandButton cmd_lbPopFile  
      Caption         =   "pop file" 
      Height          =   372 
      Left            =   6000 
      TabIndex        =   5 
      Top             =   1560 
      Width           =   972 
   End 
   Begin VB.CommandButton cmd_lbDumpFile  
      Caption         =   "dump to file" 
      Height          =   372 
      Left            =   6000 
      TabIndex        =   4 
      Top             =   600 
      Width           =   972 
   End 
   Begin VB.CommandButton cmd_lbPopDB  
      Caption         =   "pop db" 
      Height          =   372 
      Left            =   6000 
      TabIndex        =   3 
      Top             =   2040 
      Width           =   972 
   End 
   Begin VB.CommandButton cmd_lbListClear  
      Caption         =   "clear list" 
      Height          =   372 
      Left            =   6000 
      TabIndex        =   2 
      Top             =   1080 
      Width           =   972 
   End 
   Begin VB.CommandButton cmd_lbDumpDB  
      Caption         =   "dump to db" 
      Height          =   372 
      Left            =   6000 
      TabIndex        =   1 
      Top             =   120 
      Width           =   972 
   End 
   Begin VB.ListBox List1  
      Height          =   2352 
      Left            =   4020 
      TabIndex        =   0 
      Top             =   60 
      Width           =   1872 
   End 
End 
Attribute VB_Name = "frmMain" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Option Explicit 
 
' This program was written and tested on a system 
' with the following specifications: 
' 
' CPU: Intel Pentium II 400Mhz 
' RAM: 128 MB 
' OS: Windows 98 
' Visual Basic 6.0 
' 
' NOTE: "Microsoft DAO 3.51 Object Library" MUST be referenced. 
'                To do so, select Project > References from the menu. In the 
'                 resulting dialog box select "Microsoft DAO 3.51 Object Library" 
'                 and click OK. 
 
' This stops an hWnd from being updated. It should speed up 
' our listbox/listview population considerably. Pass it an hWnd 
' to lock, to unlock, pass zero (0). 
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long 
 
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long 
 
Private Const LVM_FIRST = &H1000 
Private Const LVM_DELETEALLITEMS = (LVM_FIRST + 9) 
 
' Crate new data access object variables 
Private dbWorkspace As Workspace 
Private dbDatabase As Database 
Private dbTable As Recordset 
Private dbName As Field 
Private dbBday As Field 
 
Private sFileName As String 
' 
 
Public Function TrimNull(ByVal What As String) 
 
    ' Function: TrimNull 
    ' 
    ' Takes a string as input and returns 
    ' a string with  all instances of the 
    ' null character Chr$(0), leading and 
    ' trailing spaces, and vbCrLf removed. 
     
    What = Trim$(What) 
    If InStr(What, Chr(0)) <> 0 Then What = RemoveChar(What, Chr(0)) 
    If InStr(What, vbCrLf) <> 0 Then What = RemoveChar(What, vbCrLf) 
         
    Do: DoEvents 
    If Right(What, 1) = Chr(10) Or Right(What, 1) = Chr(13) Then What = Mid(What, 1, Len(What) - 1) 
    Loop Until Right(What, 1) <> Chr(10) And Right(What, 1) <> Chr(13) 
     
    Do: DoEvents 
    If Left(What, 1) = Chr(10) Or Left(What, 1) = Chr(13) Then What = Mid(What, 2) 
    Loop Until Left(What, 1) <> Chr(10) And Left(What, 1) <> Chr(13) 
     
    TrimNull = What 
     
End Function 
 
 
' 
Public Function GetListItem(ByVal xItem As ListItem, Optional ByVal sDelimiter As String = "") As String 
 
' Function: GetListItem 
' 
' Arguments: ListItem - Listview item you want returned as a string 
'                        sDelimiter - Delimiter you want inserted between each subitem 
' 
' Returns: A string containing all subitems seperated by sDelimiter 
 
Dim i As Integer 
 
' First we set GetListItem to the main item's text, tag, and check status 
GetListItem = xItem.Text & sDelimiter & xItem.Tag & sDelimiter & xItem.Checked 
 
' Then we loop through the subitems and add their text to each item 
For i = 1 To xItem.ListSubItems.Count 
    GetListItem = GetListItem & sDelimiter & xItem.SubItems(i) 
Next i 
 
End Function 
 
Public Function FileExists(Optional ByVal sFileName As Variant, Optional ByVal sPath As Variant) As Boolean 
 
    ' By PCC MikeD 
     
    ' Function: FileExists 
    ' 
    ' Checks whether sFileName exists in sPath. 
    ' If only sPath is passed to the function, 
    ' the existance of sPath is checked. 
    ' Returns either 'True' or 'False' 
     
    On Error GoTo Oops 
    If IsMissing(sPath) Then 
        'Only a file name was passed. 
        If Len(Dir$(sFileName)) Then FileExists = True 
    Else 
        'A directory was passed 
        'Append a backslash to the pathname, if necessary. 
        If Right$(sPath, 1) <> "\" Then sPath = sPath & "\" 
        If IsMissing(sFileName) Then 
            'Directory was passed, but not a file, so determine if 
            'the directory exists 
            If Len(Dir$(sPath, vbDirectory)) Then FileExists = True 
        Else 
            'Both a directory and a file were passed, so determine 
            'if the file exists in the specified directory. 
            If Len(Dir$(sPath & sFileName)) Then FileExists = True 
        End If 
    End If 
    Exit Function 
     
Oops: 
    Exit Function 
 
End Function 
 
Public Function LoadList(ByVal sFileName As String, Optional lbList As ListBox, Optional lvList As ListView) As Boolean 
 
' Make sure a list was passed to us 
If TypeName(lbList) = "Nothing" And TypeName(lvList) = "Nothing" Then LoadList = False: Exit Function 
 
Dim fileNum As Integer ' freefile 
Dim i As Long ' loop counter 
Dim j As Integer ' loop counter 
Dim sDelimiter As String 
Dim fileInput As String 
Dim fileArray As Variant 
Dim itemArray As Variant 
Dim xItem As ListItem 
 
sDelimiter = "$^e&p%q#!" ' We want something extremely unique to delimit 
                                                     ' each of the subitems if we get a listview. This 
                                                     ' should do it, but you can change this here 
                                                     ' if necessary 
 
' Find a free file number to use 
fileNum = FreeFile 
 
If Not FileExists(sFileName) Then Exit Function 
 
Open sFileName For Input As fileNum 
    i = FileLen(sFileName) 
     
    ' The file passed doesn't contain any data. Exit the function 
    If i = 0 Then Close fileNum: LoadList = False: Exit Function 
     
    fileInput = Input(i, fileNum) 
Close fileNum 
 
    ' If the user passes us a listview, but the delimiter is not present in the file, 
    ' then the file was not saved using the sister function, SaveList. Exit. 
    If (Not TypeName(lvList) = "Nothing") And (InStr(fileInput, sDelimiter) = 0) Then LoadList = False: Exit Function 
    fileArray = Split(fileInput, vbCrLf) 
 
 
    If (Not TypeName(lbList) = "Nothing") Then ' A listbox was passed, loop through it 
        For i = 0 To UBound(fileArray) 
            lbList.AddItem fileArray(i) 
        Next i ' = 0 To UBound(fileArray) 
    Else ' A listview was passed. loop through it and it's subitems 
        For i = 0 To UBound(fileArray) 
            If (Not TrimNull(fileArray(i)) = "") Then 
                itemArray = Split(fileArray(i), sDelimiter) 
                For j = 0 To UBound(itemArray) 
                    Select Case j 
                        Case 0 
                            Set xItem = lvList.ListItems.Add(, , itemArray(j)) 
                        Case 1 
                            xItem.Tag = itemArray(j) 
                        Case 2 
                            If itemArray(j) = "True" Then xItem.Checked = True 
                        Case Else 
                            xItem.SubItems(j - 2) = itemArray(j) 
                    End Select ' j 
                Next j ' = 0 To UBound(itemArray) 
            End If ' (Not TrimNull(hdrArray(i)) = "") 
        Next i ' = 0 To UBound(fileArray) 
    End If ' (TypeName(lbList) = "Nothing") 
     
LoadList = True 
                 
End Function 
 
Public Function SaveList(ByVal sFileName As String, Optional lbList As ListBox, Optional lvList As ListView, Optional ByVal sCriteria As String, Optional ByVal iSubItem As Integer, Optional ByVal useTag As Boolean = False, Optional matchCase As Boolean = True) As Boolean 
 
' Make sure a list was passed to us 
If TypeName(lbList) = "Nothing" And TypeName(lvList) = "Nothing" Then SaveList = False: Exit Function 
 
Dim fileNum As Integer 
Dim i As Long 
Dim sDelimiter As String 
Dim curItem As String 
 
sDelimiter = "$^e&p%q#!" ' We want something extremely unique to delimit 
                                                     ' each of the subitems if we get a listview. This 
                                                     ' should do it, but you can change this here 
                                                     ' if necessary 
 
' Find a free file number to use 
fileNum = FreeFile 
 
If FileExists(sFileName) Then Kill (sFileName) 
 
Open sFileName For Append As fileNum 
    If Not TypeName(lbList) = "Nothing" Then ' A listbox was passed, loop through it 
        For i = 0 To lbList.ListCount - 1 
            If (sCriteria <> "") Then 
                If (matchCase = True) Then 
                    If InStr(lbList.List(i), sCriteria) Then Print #fileNum, lbList.List(i) 
                Else 
                    If InStr(LCase(lbList.List(i)), LCase(sCriteria)) Then Print #fileNum, lbList.List(i) 
                End If ' (matchCase = True) 
            Else 
                Print #fileNum, lbList.List(i) 
            End If ' (sCriteria <> "") 
        Next i ' i = 0 To lbList.ListCount - 1 
    Else ' A listview was passed. loop through it and it's subitems 
        For i = 1 To lvList.ListItems.Count 
            If (sCriteria <> "") Then 
                If (useTag = True) Then 
                    curItem = lvList.ListItems.item(i).Tag 
                    If (matchCase = True) Then 
                        If curItem Like sCriteria Then Print #fileNum, GetListItem(lvList.ListItems.item(i), sDelimiter) 
                    Else 
                        If LCase(curItem) Like LCase(sCriteria) Then Print #fileNum, GetListItem(lvList.ListItems.item(i), sDelimiter) 
                    End If ' (matchCase = True) 
                Else 
                    ' If iSubItem is 0 then use the item.text instead 
                    If iSubItem <> 0 Then curItem = lvList.ListItems.item(i).SubItems(iSubItem) Else curItem = lvList.ListItems.item(i).Text 
                    If (matchCase = True) Then 
                        If curItem Like sCriteria Then Print #fileNum, GetListItem(lvList.ListItems.item(i), sDelimiter) 
                    Else 
                        If LCase(curItem) Like LCase(sCriteria) Then Print #fileNum, GetListItem(lvList.ListItems.item(i), sDelimiter) 
                    End If ' (matchCase = True) 
                End If ' (useTag = True) 
            Else 
                Print #fileNum, GetListItem(lvList.ListItems.item(i), sDelimiter) 
            End If ' (sCriteria <> "") 
        Next i ' i = 1 To lvList.ListItems.Count 
    End If 
Close fileNum 
 
SaveList = True 
                 
End Function 
 
 
Private Sub cmd_lbDumpDB_Click() 
 
Dim tmr As New CStopWatch, i As Long 
     
    tmr.Reset 
     
    ' Create data access objects 
    Set dbWorkspace = DBEngine.Workspaces(0) 
     
    ' Change database path if necessary 
    Set dbDatabase = dbWorkspace.OpenDatabase(sFileName) 
     
    ' Open the table we want to work on 
    Set dbTable = dbDatabase.OpenRecordset("List1", dbOpenTable) 
     
    For i = 0 To List1.ListCount - 1 
        ' Add new record 
        dbTable.AddNew 
         
        ' Set the field to the current list item 
        dbTable!Elements = List1.List(i) 
 
        ' Tell the DB to update the current record (i.e. save the field) 
        dbTable.Update 
         
        ' Jump to the last record, not sure if this is necessray 
        ' for dumping a list ot a DB. 
        ' dbTable.MoveLast 
    Next i 
     
    dbTable.Close 
    dbWorkspace.Close 
     
    Debug.Print "[" & Time & "] DB dump successfully completed in " & tmr.Elapsed / 1000 & " seconds." 
     
End Sub 
 
Private Sub cmd_lbDumpFile_Click() 
 
Dim tmr As New CStopWatch, i 
 
tmr.Reset 
 
Open "g:\temp\newsreader\db dump.txt" For Append As #1 
    For i = 0 To List1.ListCount - 1 
        Print #1, List1.List(i) 
    Next i 
Close #1 
 
Debug.Print "[" & Time & "] File dump successfully completed in " & tmr.Elapsed / 1000 & " seconds." 
 
End Sub 
 
Private Sub cmd_lbListClear_Click() 
 
List1.Clear 
 
End Sub 
 
Private Sub cmd_lbPopDB_Click() 
 
    Dim i As Integer 
    Dim tmr As New CStopWatch 
     
    tmr.Reset 
     
    ' Create data access objects 
    Set dbWorkspace = DBEngine.Workspaces(0) 
     
    ' Change database path if necessary 
    Set dbDatabase = dbWorkspace.OpenDatabase(sFileName) 
     
    ' Open the table we want to work on 
    Set dbTable = dbDatabase.OpenRecordset("List1", dbOpenTable) 
     
    'Use special handling if new database (i.e. no records in the table) 
    If dbTable.BOF And dbTable.EOF Then 
        Debug.Print "[" & Time & "] No Records Found." 
        dbTable.Close 
        dbWorkspace.Close 
    End If 
     
    'Start on first record 
    dbTable.MoveFirst 
 
    Do Until dbTable.EOF 
        List1.AddItem dbTable!Elements 
        dbTable.MoveNext 
    Loop 
     
    ' We're finished so close the table and DB 
    ' and exit 
    dbTable.Close 
    dbWorkspace.Close 
     
    Debug.Print "[" & Time & "] DB population successfully completed in " & tmr.Elapsed / 1000 & " seconds." 
     
End Sub 
 
Private Sub cmd_lbPopFile_Click() 
 
Dim tmr As New CStopWatch, i As Long 
Dim fileInput$, fileArray As Variant 
 
tmr.Reset 
 
Open "g:\temp\newsreader\db dump.txt" For Input As #1 
    i = FileLen("g:\temp\newsreader\db dump.txt") 
    fileInput = Input(i, 1) 
Close #1 
 fileArray = Split(fileInput, vbCrLf) 
 
For i = 0 To UBound(fileArray) 
    List1.AddItem fileArray(i) 
Next i 
 
Debug.Print "[" & Time & "] File population successfully completed in " & tmr.Elapsed / 1000 & " seconds." 
 
End Sub 
 
Private Sub cmd_lvClear_Click() 
 
Dim tmr As New CStopWatch 
 
tmr.Reset 
 
 ' We don't want to use listview1.listitems.clear 
 ' because it seems to take a lot longer to clear 
 ' the list. To see these results for yourself, 
 ' uncomment the following line and comment out 
 ' the line w/ sendmessage. 
 ' NOTE: Doing this will cause VB to appear to hang. 
' ListView1.ListItems.Clear 
SendMessage Me.ListView1.hwnd, LVM_DELETEALLITEMS, 0, 0 
 
Debug.Print "[" & Time & "] Listview successfully cleared in " & tmr.Elapsed / 1000 & " seconds." 
 
End Sub 
 
Private Sub cmd_lvDumpDB_Click() 
 
Dim i As Long, itmx As ListItem, tmr As New CStopWatch 
         
    tmr.Reset 
     
    ' Create data access objects 
    Set dbWorkspace = DBEngine.Workspaces(0) 
     
    ' Change database path if necessary 
    Set dbDatabase = dbWorkspace.OpenDatabase(sFileName) 
     
    ' Open the table we want to work on 
    Set dbTable = dbDatabase.OpenRecordset("List2", dbOpenTable) 
     
    ' Loop through the items in the listview and dump to DB 
    For i = 1 To ListView1.ListItems.Count 
        ' Set itmx to the current listview item 
        Set itmx = ListView1.ListItems.item(i) 
        ' Add new record 
        dbTable.AddNew 
         
        ' Set each field in the new record to the 
        ' corresponding listview item 
        dbTable!Data1 = itmx.Text 
        dbTable!Data2 = itmx.SubItems(1) 
        dbTable!Data3 = itmx.SubItems(2) 
        dbTable!Tag = itmx.Tag 
 
        ' Tell the DB to update the current record (i.e. save the field) 
        dbTable.Update 
         
        ' Jump to the last record, not sure if this is necessray 
        ' for dumping a list ot a DB. 
        ' dbTable.MoveLast 
    Next i 
     
    dbTable.Close 
    dbWorkspace.Close 
     
    Debug.Print "[" & Time & "] Listview DB dump successfully completed in " & tmr.Elapsed / 1000 & " seconds." 
     
End Sub 
 
Private Sub cmd_lvDumpFile_Click() 
 
Dim i, tmr As New CStopWatch 
 
tmr.Reset 
SaveList "g:\temp\newsreader\listview dump.txt", , ListView1 
Debug.Print "[" & Time & "] Listview FILE dump successfully completed in " & tmr.Elapsed / 1000 & " seconds." 
 
End Sub 
 
Private Sub cmd_lvPopDB_Click() 
 
    Dim i As Integer, itmx As ListItem 
    Dim tmr As New CStopWatch 
     
    tmr.Reset 
     
    ' Create data access objects 
    Set dbWorkspace = DBEngine.Workspaces(0) 
     
    ' Change database path if necessary 
    Set dbDatabase = dbWorkspace.OpenDatabase(sFileName) 
     
    ' Open the table we want to work on 
    Set dbTable = dbDatabase.OpenRecordset("List2", dbOpenTable) 
 
    'Use special handling if new database (i.e. no records in the table) 
    If dbTable.BOF And dbTable.EOF Then 
        Debug.Print "[" & Time & "] No Records Found." 
        dbTable.Close 
        dbWorkspace.Close 
    End If 
     
    'Start on first record 
    dbTable.MoveFirst 
 
    ' As per dogbert's suggestion, we use "With" 
    ' instead of dbTable.xxx. This has no effect on 
    ' clearing the listview as expected. No effect on 
    ' LV population either 
    With dbTable 
     
            Do While (.EOF = False) 
                Set itmx = ListView1.ListItems.Add(, , !Data1) 
                itmx.SubItems(1) = !Data2 
                itmx.SubItems(2) = !Data3 
                itmx.Tag = !Tag 
                 
                .MoveNext 
             
            Loop 
     
        ' We're finished so close the table and DB 
        ' and exit 
        .Close 
        dbWorkspace.Close 
         
    End With 
     
    Debug.Print "[" & Time & "] Listview DB population successfully completed in " & tmr.Elapsed / 1000 & " seconds." 
     
End Sub 
 
Private Sub cmd_lvPopDBLock_Click() 
 
    Dim i As Integer, itmx As ListItem 
    Dim tmr As New CStopWatch 
     
    ' lock listview1 - don't let it update 
    ' this will speed up operation 
    LockWindowUpdate ListView1.hwnd 
     
    tmr.Reset 
     
    ' Create data access objects 
    Set dbWorkspace = DBEngine.Workspaces(0) 
     
    ' Change database path if necessary 
    Set dbDatabase = dbWorkspace.OpenDatabase(sFileName) 
     
    ' Open the table we want to work on 
    Set dbTable = dbDatabase.OpenRecordset("List2", dbOpenTable) 
 
    'Use special handling if new database (i.e. no records in the table) 
    If dbTable.BOF And dbTable.EOF Then 
        Debug.Print "[" & Time & "] No Records Found." 
        LockWindowUpdate 0 
        ListView1.Refresh 
        dbTable.Close 
        dbWorkspace.Close 
    End If 
     
    'Start on first record 
    dbTable.MoveFirst 
 
    Do Until dbTable.EOF 
         
        Set itmx = ListView1.ListItems.Add(, , dbTable!Data1) 
        itmx.SubItems(1) = dbTable!Data2 
        itmx.SubItems(2) = dbTable!Data3 
        itmx.Tag = dbTable!Tag 
         
        ' Move on to the next item in the DB 
        dbTable.MoveNext 
         
    Loop 
     
    ' We're finished so close the table and DB 
    ' and exit 
    dbTable.Close 
    dbWorkspace.Close 
     
    ' unlock listview1 so we can see the items 
    LockWindowUpdate 0 
    ListView1.Refresh 
     
    Debug.Print "[" & Time & "] Listview DB population w/ LOCKING successfully completed in " & tmr.Elapsed / 1000 & " seconds." 
    Exit Sub 
     
End Sub 
 
 
Private Sub cmd_lvPopFile_Click() 
 
Dim tmr As New CStopWatch, i 
 
tmr.Reset 
 
LoadList "g:\temp\newsreader\listview dump.txt", , ListView1 
 
Debug.Print "[" & Time & "] Listview FILE population successfully completed in " & tmr.Elapsed / 1000 & " seconds." 
 
End Sub 
 
 
Private Sub cmd_lvPopFileLock_Click() 
 
Dim tmr As New CStopWatch 
 
' lock listview1 - don't let it update 
' this will speed up operation 
LockWindowUpdate ListView1.hwnd 
     
tmr.Reset 
 
LoadList "g:\temp\newsreader\listview dump.txt", , ListView1 
 
' unlock listview1 so we can see the items 
LockWindowUpdate 0 
ListView1.Refresh 
     
Debug.Print "[" & Time & "] Listview FILE population w/ LOCKING successfully completed in " & tmr.Elapsed / 1000 & " seconds." 
 
End Sub 
 
 
Private Sub cmd_lvRandomPop_Click() 
 
Dim StartTime, EndTime, i As Long, itmx As ListItem 
 
        StartTime = GetTickCount 
         
        ' Populate the listview control 
        For i = 1 To 50000 
            Set itmx = ListView1.ListItems.Add(, , "abc" & i) 
            itmx.SubItems(1) = "def" & i 
            itmx.SubItems(2) = "ghi" & i 
            itmx.Tag = "jkl" & i 
        Next i 
         
        EndTime = GetTickCount - StartTime 
         
        Debug.Print "[" & Time & "] Random LISTVIEW generation successfully completed in " & EndTime / 1000 & " seconds." 
         
End Sub 
 
Private Sub Form_Load() 
 
Dim i As Long, itmx As ListItem 
Dim popStart As Integer 
Dim tmr As New CStopWatch 
 
' Path to the test database. Change here if necessary 
 sFileName = "abc123.mdb" 
  
' This controls whether or not we are 
' going to populate our controls on 
' startup and which control to fill. 
' 0 = none, 1 = listview, 2 = listbox 
' 3 = pop from DB to LV 
popStart = 0 
 
Select Case popStart 
         
    Case 1 
     
        tmr.Reset 
         
        ' Populate the listview control 
        For i = 1 To 50000 
            Set itmx = ListView1.ListItems.Add(, , "abc" & i) 
            itmx.SubItems(1) = "def" & i 
            itmx.SubItems(2) = "ghi" & i 
            itmx.Tag = "jkl" & i 
        Next i 
 
        Debug.Print "[" & Time & "] Random LISTVIEW generation successfully completed in " & tmr.Elapsed / 1000 & " seconds." 
         
    Case 2 
        tmr.Reset 
         
        ' Populate our listbox 
        For i = 1 To 10000 
            List1.AddItem "abc" & i 
        Next i 
         
        Debug.Print "[" & Time & "] Random LISTBOX generation successfully completed in " & tmr.Elapsed / 1000 & " seconds." 
         
    Case 3 
        tmr.Reset 
         
        ' Create data access objects 
        Set dbWorkspace = DBEngine.Workspaces(0) 
         
        ' Change database path if necessary 
        Set dbDatabase = dbWorkspace.OpenDatabase(sFileName) 
         
        ' Open the table we want to work on 
        Set dbTable = dbDatabase.OpenRecordset("List2", dbOpenTable) 
         
        'Start on first record 
        dbTable.MoveFirst 
     
        Do Until dbTable.EOF 
             
            'Set itmx = ListView1.ListItems.Add(, "abc" & Format(Time, "hhmmss") & ListView1.ListItems.Count + 1, dbTable!Data1) 
            Set itmx = ListView1.ListItems.Add(, , dbTable!Data1) 
            itmx.SubItems(1) = dbTable!Data2 
            itmx.SubItems(2) = dbTable!Data3 
            itmx.Tag = dbTable!Tag 
             
            ' Move on to the next item in the DB 
            dbTable.MoveNext 
             
        Loop 
         
        ' We're finished so close the table and DB 
        ' and exit 
        dbTable.Close 
        dbWorkspace.Close 
         
        Debug.Print "[" & Time & "] Listview DB population successfully completed in " & tmr.Elapsed / 1000 & " seconds." 
     
End Select 
 
End Sub 
Public Function RemoveChar$(ByVal Buf As String, ByVal Char As String) 
 
    ' Function: RemoveChar$ 
    ' 
    ' Removes all occurrences of 'Char' in 'Buf' 
    ' and returns the new string 
     
    Dim Check% 
    Dim LeftOf$, RightOf$ 
     
    Do 
        DoEvents 
        Check% = InStr(Buf$, Char$) 
        If Check% > 0 Then 
            LeftOf$ = Left(Buf$, Check% - 1) 
            RightOf$ = Right(Buf$, Len(Buf$) - Check%) 
            Buf$ = LeftOf$ & RightOf$ 
        End If 
    Loop Until Check% = 0 
     
    RemoveChar$ = Buf$ 
 
End Function 
 
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) 
 
End 
 
End Sub 
 
Private Sub ListView1_ItemClick(ByVal item As MSComctlLib.ListItem) 
 
Me.Caption = "Listbox/Listview/Database Population Example - " & item.Tag 
 
End Sub