我写了个类似.net 中的 stringbuilder 类,挂在测试工程中测试,10000次字符串连接只用了0.4秒,速度还可以,可是我把它单独封装成activex dll 在别的程序中调用,10000次连接居然用了7秒多(组件创建的时间忽略不计),天啊,怎么会相差这么多,哪位给解释一下这是怎么回事,有没有解决办法.很急啊!!!

解决方案 »

  1.   

    这段代码是个老外写的,我把他贴出来,大家可以按我的方法分开测试,用append方法就可以了Option ExplicitPrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
          (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
    Private m_sString As String
    Private m_iChunkSize As Long
    Private m_iPos As Long
    Private m_iLen As LongPublic Property Get Length() As Long
       Length = m_iPos \ 2
    End PropertyPublic Property Get Capacity() As Long
       Capacity = m_iLen \ 2
    End PropertyPublic Property Get ChunkSize() As Long
       ' Return the unicode character chunk size:
       ChunkSize = m_iChunkSize \ 2
    End PropertyPublic Property Let ChunkSize(ByVal iChunkSize As Long)
       ' Set the chunksize.  We multiply by 2 because internally
       ' we are considering bytes:
       m_iChunkSize = iChunkSize * 2
    End PropertyPublic Property Get ToString() As String
       ' The internal string:
       If m_iPos > 0 Then
          ToString = Left$(m_sString, m_iPos \ 2)
       End If
    End PropertyPublic Property Let TheString(ByRef sThis As String)
    Dim lLen As Long
       
       ' Setting the string:
       lLen = LenB(sThis)
       If lLen = 0 Then
          'Clear
          m_sString = ""
          m_iPos = 0
          m_iLen = 0
       Else
          If m_iLen < lLen Then
             ' Need to expand string to accommodate:
             Do
                m_sString = m_sString & Space$(m_iChunkSize \ 2)
                m_iLen = m_iLen + m_iChunkSize
             Loop While m_iLen < lLen
          End If
          CopyMemory ByVal StrPtr(m_sString), ByVal StrPtr(sThis), lLen
          m_iPos = lLen
       End If
       
    End PropertyPublic Sub Append(ByRef sThis As String)
    Dim lLen As Long   ' Append an item to the string:
       lLen = LenB(sThis)
       If (m_iPos + lLen) > m_iLen Then
          m_sString = m_sString & Space$(m_iChunkSize \ 2)
          m_iLen = m_iLen + m_iChunkSize
       End If
       
       CopyMemory ByVal UnsignedAdd(StrPtr(m_sString), m_iPos), ByVal StrPtr(sThis), lLen
       m_iPos = m_iPos + lLen
       
    End SubPublic Sub AppendByVal(ByVal sThis As String)
       Append sThis
    End SubPublic Sub Insert(ByVal iIndex As Long, ByRef sThis As String)
    Dim lLen As Long
    Dim lPos As Long
    Dim lSize As Long
       
       ' is iIndex within bounds?
       If (iIndex * 2 > m_iPos) Then
          Err.Raise 9
       Else
       
          lLen = LenB(sThis)
          If (m_iPos + lLen) > m_iLen Then
             m_sString = m_sString & Space$(m_iChunkSize \ 2)
             m_iLen = m_iLen + m_iChunkSize
          End If
          
          ' Move existing characters from current position
          lPos = UnsignedAdd(StrPtr(m_sString), iIndex * 2)
          lSize = m_iPos - iIndex * 2
          
          ' moving from iIndex to iIndex + lLen
          CopyMemory ByVal UnsignedAdd(lPos, lLen), ByVal lPos, lSize
          
          ' Insert new characters:
          CopyMemory ByVal lPos, ByVal StrPtr(sThis), lLen
          
          m_iPos = m_iPos + lLen
       
       End If
       
    End Sub
    Public Sub InsertByVal(ByVal iIndex As Long, ByVal sThis As String)
       Insert iIndex, sThis
    End SubPublic Sub Remove(ByVal iIndex As Long, ByVal lLen As Long)
    Dim lSrc As Long
    Dim lDst As Long
    Dim lSize As Long   ' is iIndex within bounds?
       If (iIndex * 2 > m_iPos) Then
          Err.Raise 9
       Else
          ' is there sufficient length?
          If ((iIndex + lLen) * 2 > m_iPos) Then
             Err.Raise 9
          Else
             ' Need to copy characters from iIndex*2 to m_iPos back by lLen chars:
             lSrc = UnsignedAdd(StrPtr(m_sString), (iIndex + lLen) * 2)
             lDst = UnsignedAdd(StrPtr(m_sString), iIndex * 2)
             lSize = (m_iPos - (iIndex + lLen) * 2)
             CopyMemory ByVal lDst, ByVal lSrc, lSize
             m_iPos = m_iPos - lLen * 2
          End If
       End If
    End SubPublic Function Find(ByVal sToFind As String, _
       Optional ByVal lStartIndex As Long = 1, _
       Optional ByVal compare As VbCompareMethod = vbTextCompare _
       ) As Long
    Dim lInstr As Long
       If (lStartIndex > 0) Then
          lInstr = InStr(lStartIndex, m_sString, sToFind, compare)
       Else
          lInstr = InStr(m_sString, sToFind, compare)
       End If
       If (lInstr < m_iPos \ 2) Then
          Find = lInstr
       End If
    End FunctionPublic Sub HeapMinimize()
    Dim iLen As Long
       
       ' Reduce the string size so only the minimal chunks
       ' are allocated:
       If (m_iLen - m_iPos) > m_iChunkSize Then
          iLen = m_iLen
          Do While (iLen - m_iPos) > m_iChunkSize
             iLen = iLen - m_iChunkSize
          Loop
          m_sString = Left$(m_sString, iLen \ 2)
          m_iLen = iLen
       End If
       
    End Sub
    Private Function UnsignedAdd(Start As Long, Incr As Long) As Long
    ' This function is useful when doing pointer arithmetic,
    ' but note it only works for positive values of Incr   If Start And &H80000000 Then 'Start < 0
          UnsignedAdd = Start + Incr
       ElseIf (Start Or &H80000000) < -Incr Then
          UnsignedAdd = Start + Incr
       Else
          UnsignedAdd = (Start + &H80000000) + (Incr + &H80000000)
       End If
       
    End Function
    Private Sub Class_Initialize()
       ' The default allocation: 8192 characters.
       m_iChunkSize = 163840
    End Sub
      

  2.   

    大家所说的方法都是针对组件加载时的性能问题,我所说的是组件运行时的,我把问题在明确一下,我们创建一个vb exe工程,在此工程中增加我说的私有类,stringbuilder。然后生成一个1000次字符串连接的循环体,大家可以在循环开始和结束时分别打印 debug.print now然后在构造一个新的测试工程,把stringbuilder类编译成activex dll,然后在测试工程中引用这个dll 跟上面一样的方法在做一遍测试,就可以发现同样的1000次循环运行时间差异很大,我不知道这是不是vb的问题!