加快此查找/筛选器操作-（VB6，TextFile，ADO，VFP 6.0数据库） [英] Speed up this Find/Filter Operation - (VB6, TextFile, ADO, VFP 6.0 Database)

问题描述

我正在尝试找出如何加快此操作的速度。从文本文件导入记录之前，我首先需要查看数据库中是否存在记录。如果确实存在，我将对其执行更新操作。如果不存在，那么我将创建一个新记录。

I'm trying to figure out how to speed up this operation. Before I import a record from the text file I first need to see if one exists in the database. If it does exist I'm going to perform an update operation on it. If it does not exist I'm going to create a new record.

运行此操作下方的代码，大约需要3个小时。

Running the code you see below this operation takes somewhere in the neighborhood of 3 hours.

我尝试使用ADO的find方法，它实际上似乎比filter方法要慢。

I've tried using ADO's find method and it actually appears to be slower than the filter method.

数据库是一个Visual Foxpro 6数据库。该表的确在item_cd字段上具有索引，但是该表未建立任何主键。这是我无法控制的，因为我没有编写软件，并且试图避免对数据库进行任何结构性更改。

The database is a Visual Foxpro 6 database. The table does have an index on the item_cd field but the table does not have any primary key established. This is out of my control since I didn't write the software and I'm trying to stay away from making any structural changes to the database.

有46652行在文本文件中，在ADO记录集中大约有650,000条记录/行。我认为缩小记录集将是解决此问题的最大步骤，但我还没有提出任何解决办法。由于没有主键，因此我试图防止创建重复的记录，因此，我真的需要在记录集中包含整个表。

There are 46652 rows in the text file and about 650,000 records/rows in the ADO recordset. I think slimming down the recordset would be the biggest step in fixing this but I haven't come up with any way of doing that. I'm trying to prevent creating duplicate records since there is no primary key and so I really need to have the entire table in my recordset.

因为我正在运行此记录在我的本地计算机上，该操作似乎受CPU能力的限制。实际上，这可能会在整个网络中使用，尤其是如果我可以使其更快地运行。

Because I'm running this on my local machine it appears that the operation is limited by the power of the CPU. In actuality this might be used across the network, especially if I can get it to go faster.

Dim sFileToImport As String
sFileToImport = Me.lstFiles.Text
If sFileToImport = "" Then
    MsgBox "You must select a file from the listbox to import."
    Exit Sub
End If

If fConnectToDatabase = False Then Exit Sub

With gXRst
    .CursorLocation = adUseClient
    .CursorType = adOpenKeyset
    .LockType = adLockReadOnly
    .Open "SELECT item_cd FROM xmsalinv ORDER BY item_cd ASC", gXCon
End With



Call fStartProgress("Running speed test.")

Dim rstTxtFile As ADODB.Recordset
Set rstTxtFile = New ADODB.Recordset
Dim con As ADODB.Connection
Set con = New ADODB.Connection

Dim sConString As String, sSQL As String
Dim lRecCount As Long, l As Long
Dim s As String

sConString = "DRIVER={Microsoft Text Driver (*.txt; *.csv)};Dbq=" & gsImportFolderPath & ";Extensions=asc,csv,tab,txt;Persist Security Info=False;"
con.Open sConString

sSQL = "SELECT * FROM [" & sFileToImport & "]"

rstTxtFile.Open sSQL, con, adOpenKeyset, adLockPessimistic
If Not (rstTxtFile.EOF And rstTxtFile.BOF) = True Then
    rstTxtFile.MoveFirst
    lRecCount = rstTxtFile.RecordCount
    Do Until rstTxtFile.EOF = True

        'This code appears to actually be slower than the filter method I'm now using
        'gXRst.MoveFirst
        'gXRst.Find "item_cd = '" & fPQ(Trim(rstTxtFile(0))) & "'"

        gXRst.Filter = "item_cd = '" & fPQ(Trim(rstTxtFile(0))) & "'"
        If Not (gXRst.EOF And gXRst.BOF) = True Then
            s = "Item Found  -  " & Trim(rstTxtFile(0)) 'item found
        Else
           s = "Item Not Found  -  " & Trim(rstTxtFile(0)) 'Item not found found
        End If
        l = l + 1
        Call subProgress(l, lRecCount, s)
        rstTxtFile.MoveNext
    Loop
End If

Call fEndProgress("Finished running speed test.")

Cleanup:
    rstTxtFile.Close
    Set rstTxtFile = Nothing
    gXRst.Close

推荐答案

Bob Riemersma的帖子，文本文件没有引起速度问题。我已经更改了代码，以打开一个查询集来查找单个项目的记录集。现在，此代码在1分钟2秒内运行，而不是我在另一眼中看到的3到4个小时。

In response to Bob Riemersma's post, the text file is not causing the speed issues. I've changed my code to open a recordset with a query looking for a single item. This code now runs in 1 minute and 2 seconds as opposed to the three to four hours I was looking at the other way.

Dim sFileToImport As String
sFileToImport = Me.lstFiles.Text
If sFileToImport = "" Then
    MsgBox "You must select a file from the listbox to import."
    Exit Sub
End If

If fConnectToDatabase = False Then Exit Sub


Call fStartProgress("Running speed test.")

Dim rstTxtFile As ADODB.Recordset
Set rstTxtFile = New ADODB.Recordset
Dim con As ADODB.Connection
Set con = New ADODB.Connection

Dim sConString As String, sSQL As String
Dim lRecCount As Long, l As Long
Dim sngQty As Single, sItemCat As String

sConString = "DRIVER={Microsoft Text Driver (*.txt; *.csv)};Dbq=" & gsImportFolderPath & ";Extensions=asc,csv,tab,txt;Persist Security Info=False;"
con.Open sConString

sSQL = "SELECT * FROM [" & sFileToImport & "]"

rstTxtFile.Open sSQL, con, adOpenKeyset, adLockPessimistic

If Not (rstTxtFile.EOF And rstTxtFile.BOF) = True Then
    rstTxtFile.MoveFirst
    lRecCount = rstTxtFile.RecordCount
    Do Until rstTxtFile.EOF = True
        l = l + 1
        sItemCat = fItemCat(Trim(rstTxtFile(0)))
        If sItemCat <> "[item not found]" Then
           sngQty = fItemQty(Trim(rstTxtFile(0)))
        End If
        Call subProgress(l, lRecCount, sngQty & " - " & sItemCat & " - " & rstTxtFile(0))
        sngQty = 0
        rstTxtFile.MoveNext
    Loop
End If

Call fEndProgress("Finished running speed test.")

Cleanup:
    rstTxtFile.Close
    Set rstTxtFile = Nothing

我的函数：

Private Function fItemCat(sItem_cd As String) As String

    'Returns blank if nothing found

    If sItem_cd <> "" Then

        With gXRstFind
            .CursorLocation = adUseClient
            .CursorType = adOpenKeyset
            .LockType = adLockReadOnly
            .Open "SELECT item_cd, ccategory FROM xmsalinv WHERE item_cd = '" & fPQ(sItem_cd) & "'", gXCon
        End With
        If Not (gXRstFind.EOF And gXRstFind.BOF) = True Then
            'An item can technically have a blank category although it never should have
            If gXRstFind!ccategory = "" Then
                fItemCat = "[blank]"
            Else
                fItemCat = gXRstFind!ccategory
            End If
        Else
           fItemCat = "[item not found]"
        End If
        gXRstFind.Close
    End If

End Function

Private Function fIsStockItem(sItem_cd As String, Optional bConsiderItemsInStockAsStockItems As Boolean = False) As Boolean

    If sItem_cd <> "" Then

        With gXRstFind
            .CursorLocation = adUseClient
            .CursorType = adOpenKeyset
            .LockType = adLockReadOnly
            .Open "SELECT item_cd, bal_qty, sug_qty FROM xmsalinv WHERE item_cd = '" & fPQ(sItem_cd) & "'", gXCon
        End With
        If Not (gXRstFind.EOF And gXRstFind.BOF) = True Then
            If gXRstFind!sug_qty > 0 Then
                fIsStockItem = True
            Else
                If bConsiderItemsInStockAsStockItems = True Then
                    If gXRstFind!bal_qty > 0 Then
                        fIsStockItem = True
                    End If
                End If
            End If
        End If
        gXRstFind.Close
    End If

End Function


Private Function fItemQty(sItem_cd As String) As Single

    'Returns 0 if nothing found

    If sItem_cd <> "" Then

        With gXRstFind
            .CursorLocation = adUseClient
            .CursorType = adOpenKeyset
            .LockType = adLockReadOnly
            .Open "SELECT item_cd, bal_qty FROM xmsalinv WHERE item_cd = '" & fPQ(sItem_cd) & "'", gXCon
        End With
        If Not (gXRstFind.EOF And gXRstFind.BOF) = True Then
            fItemQty = CSng(gXRstFind!bal_qty)
        End If
        gXRstFind.Close
    End If

End Function

这篇关于加快此查找/筛选器操作-（VB6，TextFile，ADO，VFP 6.0数据库）的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！