| 网站首页 | 业界新闻 | 小组 | 交易 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
共有 238 人关注过本帖
标题:如何提高文件读写速度?ictest 进来吧。
只看楼主 加入收藏
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:263
帖 子:4526
专家分:28025
注 册:2008-10-15
结帖率:100%
  问题点数:0  回复次数:3   
如何提高文件读写速度?ictest 进来吧。

接着 https://bbs.bccn.net/thread-500464-1-1.html 贴子。

思考了一下,然后动手写一截子代码,然后差点放弃了。。VB对于 BYTE数组,查找,分割等等 ,都没有函数支持,都需要自己写。代码好复杂。

在窗体上再放 Label1、Label2、Label3 三个控件显示三个时间。
我测试的结果依次为:
IDE:3.249375、3.218375、2.030875
编译后:3.20275、3.296875、0.343625


程序代码:
Option Explicit

Private Sub 连接字符写入()
Dim tttt As Single
    Dim strWj As String
    Dim strJ() As String
    Dim aryContent() As Byte
    Dim tmp() As String
    Dim i As Long
    Dim j As Long
    tttt = Timer
    Open App.Path & "\1.csv" For Binary As #1
        ReDim aryContent(LOF(1) - 1)
        Get #1, , aryContent
    Close #1
    Open App.Path & "\temp.txt" For Output As #2
    strWj = StrConv(aryContent, vbUnicode)
    strJ = Split(strWj, vbCrLf)
    For i = 0 To UBound(strJ)
        If IsNumeric(Left(strJ(i), 1)) = True Then
            tmp() = Split(strJ(i), ",")
                If tmp(2) = "True" Then
                    Print #2, tmp(5) & vbTab & tmp(6) & vbTab & tmp(16) & vbTab & tmp(20) & vbTab & tmp(23) & vbTab & tmp(24)
                End If
        End If
    Next i
    Close #2
Label1.Caption = Timer - tttt

End Sub

Private Sub 使用分号写入操作()
Dim tttt As Single
    Dim strWj As String
    Dim strJ() As String
    Dim aryContent() As Byte
    Dim tmp() As String
    Dim i As Long
    Dim j As Long
    
    tttt = Timer
    Open App.Path & "\1.csv" For Binary As #1
        ReDim aryContent(LOF(1) - 1)
        Get #1, , aryContent
    Close #1
    Open App.Path & "\temp2.txt" For Output As #2
    strWj = StrConv(aryContent, vbUnicode)
    strJ = Split(strWj, vbCrLf)
    For i = 0 To UBound(strJ)
        If IsNumeric(Left(strJ(i), 1)) = True Then
            tmp() = Split(strJ(i), ",")
                If tmp(2) = "True" Then
                    Print #2, tmp(5); vbTab; tmp(6); vbTab; tmp(16); vbTab; tmp(20); vbTab; tmp(23); vbTab; tmp(24)
                End If
        End If
    Next i
    Close #2
    
Label2.Caption = Timer - tttt

    
End Sub

Private Sub 全byte操作()
Dim tttt As Single

    Dim aryContent() As Byte            '原始数组
    Dim lenary As Long                  '原始数据长度
    
    'w1 每行第一个字符
    'w2 每行最后一个字符
    Dim w1 As Long, w2 As Long, w3 As Long
    Dim w4 As Long
    
    Dim nary() As Byte      '新数组
    Dim nw1 As Long         '新数组读写位置,也表示已经有数据长度
    
    tttt = Timer
    Open App.Path & "\1.csv" For Binary As #1
        lenary = LOF(1) - 1
        ReDim aryContent(lenary)
        ReDim nary(lenary)          '初始与原数据一样大
        Get #1, , aryContent
    Close #1

    w1 = 0              '开始位置
    nw1 = 0
    Do
        w2 = FSB(w1, aryContent, 13)          '这一行的数据结束位置
        If w2 = -1 Then w2 = lenary             '如果取数据结束位置失败,则把剩余内容当作一行处理
        If aryContent(w1) > 47 And aryContent(w1) < 58 Then '0-9之间
            w3 = FSD(w1, aryContent(), 1)    '第二个逗号,最后一个参数表示中间要跳过几个逗号
            If w3 > w2 Or w3 = 0 Then GoTo SkipDo       '如果第二个逗号超出本行结束位置,跳掉
            
            w4 = w3                           '第2个逗号后就是第3节
            If aryContent(w4 + 1) = 84 Then   '第3节第一个字符为 T
            
                w4 = FSD(w4 + 1, aryContent(), 2) '第5节,w4 为第2节开始
                nw1 = CopyByte(w4 + 1, aryContent(), nw1, nary(), 44)
                nary(nw1) = 9
                nw1 = nw1 + 1
                
                w4 = FSD(w4 + 1, aryContent(), 0) '第6节
                nw1 = CopyByte(w4 + 1, aryContent(), nw1, nary(), 44)
                nary(nw1) = 9
                nw1 = nw1 + 1
                
                w4 = FSD(w4 + 1, aryContent(), 9) '第16节
                nw1 = CopyByte(w4 + 1, aryContent(), nw1, nary(), 44)
                nary(nw1) = 9
                nw1 = nw1 + 1
                
                
                w4 = FSD(w4 + 1, aryContent(), 3) '第20节
                nw1 = CopyByte(w4 + 1, aryContent(), nw1, nary(), 44)
                nary(nw1) = 9
                nw1 = nw1 + 1
                
                w4 = FSD(w4 + 1, aryContent(), 2) '第23节
                nw1 = CopyByte(w4 + 1, aryContent(), nw1, nary(), 44)
                nary(nw1) = 9
                nw1 = nw1 + 1
                
                w4 = FSD(w4 + 1, aryContent(), 0) '第24节
                nw1 = CopyByte(w4 + 1, aryContent(), nw1, nary(), 44)
                nary(nw1) = 13
                nw1 = nw1 + 1
                nary(nw1) = 10
                nw1 = nw1 + 1
            
            End If
        End If
        
    '这行不处理的统统跳这里
SkipDo:

    w1 = w2 + 2             '处理下一行开始位置
    If w1 > lenary Then Exit Do
    Loop
    
    If nw1 > 1 Then
        nw1 = nw1 - 1
        ReDim Preserve nary(nw1)    '干掉多余内容,如果最后一个回车符不要,就要 nw1-2
        If Dir(App.Path & "\temp3.txt") <> "" Then
            Kill App.Path & "\temp3.txt"
        End If
        Open App.Path & "\temp3.txt" For Binary As #2
            Put #2, , nary
        Close #2
    End If
Label3.Caption = Timer - tttt
'    MsgBox "完成"
    
'MsgBox Timer - tttt
End Sub

Public Function FSB(start As Long, strary() As Byte, ByVal str2 As Byte) As Long '搜索数组
Dim i As Long
Dim o As Long

o = UBound(strary)
For i = start To o
    If strary(i) = str2 Then
        Exit For
    End If
Next i
If i > o Then
    FSB = -1
Else
    FSB = i
End If
End Function

Public Function FSD(start As Long, strary() As Byte, ByVal SkipD As Long) As Long    '查找逗号
Dim i As Long
Dim o As Long
o = UBound(strary)
For i = start To o
    If strary(i) = 44 Then      '找到逗号
        If SkipD <= 0 Then      '不需要再跳过了
            Exit For
        Else                    '否则跳过
            SkipD = SkipD - 1
        End If
    End If
Next i
If i > o Then
    FSD = -1
Else
    FSD = i
End If
End Function

Public Function CopyByte(s1 As Long, ary1() As Byte, S2 As Long, newary() As Byte, ByVal E As Byte) As Long
'返回新数组里下一个准备写入的位置
'如果起始位置超过数组大小,会导致没有数据被复制
Dim i As Long
Dim o As Long
Dim j As Long
j = S2
o = UBound(ary1)
For i = s1 To o
    If ary1(i) = E Then     '找到结束字符
        Exit For
    Else
        newary(j) = ary1(i) '否则复制这个字节
        j = j + 1
    End If
Next i
CopyByte = j

End Function

Private Sub Command1_Click()

Call 连接字符写入
Call 使用分号写入操作
Call 全byte操作
MsgBox "完成"
End Sub




[此贴子已经被作者于2020-3-22 12:46编辑过]

搜索更多相关主题的帖子: Dim tmp Long If End 
2020-03-22 12:43
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:263
帖 子:4526
专家分:28025
注 册:2008-10-15
  得分:0 
注意,我的代码不能在 根目录下运行。

生成的文件,以 temp 为标准,
使用 FC 命令带参数 b 进行比较,提示没有差异。

D:\1\fc temp.txt temp2.txt /b
正在比较文件 temp.txt 和 TEMP2.TXT
FC: 找不到相异处

D:\1\fc temp.txt temp3.txt /b
正在比较文件 temp.txt 和 TEMP3.TXT
FC: 找不到相异处


授人于鱼,不如授人于渔
早已停用QQ了
2020-03-22 12:46
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:263
帖 子:4526
专家分:28025
注 册:2008-10-15
  得分:0 
再解释几个数值,为了追求速度,代码里对于字符要求使用直接数,按编程原则,应该定义常量,偷懒就直接使用了 立即数。
VBcrlf = chr(13) & chr(10),长度为2
第一个字节为 13

逗号: 为44
T :84
>47 ,最小为 48 ,=0
<58 ,最大为 57 ,=9

这个程序里,因为比较判断需要继续写子程序,这里偷懒只比较了第一个字符。是否为数值也只判断了第一个字符。

另外没去测试 按值传递一点,还是按地址传递快一点,下意识认为按值传递要快一点。
目前 只把标志字符的 立即数 按 值传递了,应该把开始位置也一并按值传递下。


[此贴子已经被作者于2020-3-22 13:05编辑过]


授人于鱼,不如授人于渔
早已停用QQ了
2020-03-22 12:56
ictest
Rank: 2
等 级:论坛游民
帖 子:271
专家分:97
注 册:2010-2-17
  得分:0 
    我的一个简短问题竟然引起版主大大这么关注,我深感愧疚。
    这个世界上最害怕什么?“认真”二字!确实,“认真”成为我们干好事业的重要原则。“认真”是一种态度,做事需要踏踏实实,才能真正学习到东西。认真用心、坚持到底是成功的保证!认真的人,会在同样的事情上花费更多的时间和精力,就是想要尽力做到最好,虽然结果也总是让人满意,但那其中的过程不是那些“随意懒散”的人所能体会的。
    对比版主大大,深感惭愧,在学习与工作上,我就是缺乏版主大大的这种钉子精神,钻研精神,要向版主大大学习!
2020-03-22 17:44
快速回复:如何提高文件读写速度?ictest 进来吧。
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.108923 second(s), 8 queries.
Copyright©2004-2020, BCCN.NET, All Rights Reserved