加快查找/过滤操作 - (VB6, TextFile, ADO, VFP 6.0 Database)答案

【问题标题】：Speed up this Find/Filter Operation - (VB6, TextFile, ADO, VFP 6.0 Database)加快查找/过滤操作 - (VB6, TextFile, ADO, VFP 6.0 Database)
【发布时间】：2013-04-24 05:18:53
【问题描述】：

我正试图弄清楚如何加快此操作。在从文本文件导入记录之前，我首先需要查看数据库中是否存在一条记录。如果它确实存在，我将对它执行更新操作。如果它不存在，我将创建一个新记录。

运行您在下面看到的代码，此操作大约需要 3 小时。

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

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

文本文件中有 46652 行，ADO 记录集中大约有 650,000 条记录/行。我认为精简记录集将是解决此问题的最大步骤，但我还没有想出任何方法来做到这一点。我试图防止创建重复记录，因为没有主键，所以我真的需要在我的记录集中拥有整个表。

因为我在本地机器上运行它，所以该操作似乎受到 CPU 能力的限制。实际上，这可能会在整个网络中使用，尤其是如果我能让它运行得更快的话。

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

【问题讨论】：

顺便说一句，fpq 是一个自定义函数，用两个单引号替换单引号。
更新：纯粹作为一个实验，我尝试将 item_cd 字段设置为主键。看来它可能会进一步减慢此操作。

标签： vb6 ado text-files visual-foxpro

【解决方案1】：

加快 Yours_Rs.find 响应的一个简单解决方案是，如果可能的话，首先使用 Yours_Rs.move 语句。我所做的是在使用 MyRs.find 之前使用 MyRs.move 语句来靠近我的实际记录。它对我来说真的很有效，因为 move 声明的响应非常活跃。

我用它来查找病历。因此，将指针移动到实际记录附近的记录使 MyRs.find 语句以光速工作。

问候，

MAS。

【讨论】：

【解决方案2】：

没有回答你的问题，这是一个很老的帖子，但是为什么不将文本文件导入数据库上的临时表然后进行连接？就像是 SELECT tt.* FROM texttemp tt left outer join xmsalinv xal on tt.field1=xal.item_cd 其中 xal.item_cd 为空

这应该返回您导入的文本文件的内容，该文件在数据库中没有任何 item_cd 匹配项，因为您正在处理一个使查询复杂化的文本文件，这就是为什么我想知道您没有导入内容的原因到一个临时表。

现在假设您知道字段的映射，您也可以使用它来插入假设您的数据库接受插入选择表示法，它将被插入到 xmsalinv (fields) select (matching fields) from (如上... ) 这会将您的瓶颈转移到导入过程，我希望它很快。

ado 集合看起来很愚蠢，因此它们不会从任何关于数据的知识中受益，而且速度有点慢。

“vb6 过滤器”上的下一项 google http://www.techrepublic.com/article/why-ados-find-method-is-the-devil/1045830

此回复基于基本的 sql 知识，并非针对 foxpro 量身定制的

【讨论】：

【解决方案3】：

如果您不使用 VFP 查询的结果，请使用 firehose 光标，并在此处查看您的其他帖子以获取有关文本文件 Recordset 的建议。

也许更好的是，您可以尝试摆脱缓慢的“循环和搜索”方法。

我可能会为您要查找的每个文本文件从头开始创建一个临时的 Jet 4.0 MDB。导入文本数据，索引您的关键字段。使用 ADOX 在 VFP 数据库中定义链接表。使用查询进行匹配。

之后关闭并处理 MDB。

【讨论】：

【解决方案4】：

针对 Bob Riemersma 的帖子，文本文件不会导致速度问题。我已更改代码以打开记录集，其中包含查找单个项目的查询。这段代码现在运行时间为 1 分 2 秒，而我在其他方面则需要 3 到 4 小时。

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

【讨论】：

不知道为什么我必须等待两天才能接受我自己的答案作为答案。

【解决方案5】：

首先可以尝试使用gXRst!item_cd.Properties("OPTIMIZE").Value = True 在item_cd 上创建内存索引，这将加快Find 和Filter 的速度。

为了获得最快的搜索速度，像这样初始化助手索引Collection

Set cIndex = New Collection
On Error Resume Next
Do While Not gXRst.EOF
    cIndex.Add gXRst.Bookmark, "#" & gXRst!item_cd.Value
    gXRst.MoveNext
Loop
On Error GoTo ErrorHandler

Find 的 insetad 使用类似这样的函数

Public Function SearchCollection(Col As Object, Index As Variant) As Boolean
    On Error Resume Next
    IsObject Col(Index)
    SearchCollection = (Err.Number = 0)
    On Error GoTo 0
End Function

【讨论】：

您在这里收集的方法对我来说是新的。可以用同样的方法来模仿ADO的过滤功能吗？我假设不是。
我尝试了您的第一个建议，但它甚至无法编译。请记住，我将 VB6 与 Classic ADO 一起使用。我是否需要设置对库的引用才能使其正常工作？
好的，看来我知道如何创建您所说的索引了：msdn.microsoft.com/en-us/library/ms677521(v=vs.85).aspx
我的错，这是Properties 收藏。我正在使用一个包装函数来在一个参数数组上设置这个属性，比如SetFieldOptimize rs!MyField1, rs!MyField2, rs!MyField3, ...

【解决方案6】：

3 小时只记录几十万条记录！！！你做错了。简单地： - 将文本文件附加到 VFP 表， - 然后使用单个 SQL 插入现有表中不存在的表 - 并使用另一个更新 sql 更新存在的那些。

这就是全部，应该不到一分钟（一分钟甚至非常慢）。您可以使用 VFPOLEDB 驱动程序完成所有这些操作，并且您拥有 VFP6 数据库并不重要，VFPOLEDB 内置了 VFP9 引擎。

【讨论】：