找了一些相应的文章说,在vb 工程中调用其他组件性能很差,我把原码贴出来,大家可以试试 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
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
速度上讲: Active Exe < Active DLL < 标准DLL楼主可以用PowerBasic为VB写一些DLL,PowerBasic写的DLL的执行效率接近C语言。请看我的一个帖子 http://community.csdn.net/Expert/topic/3271/3271952.xml?temp=.5445063
dll中相应的创建应该差距不大才对.但组件创建本身是需要时间的.
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
Active Exe < Active DLL < 标准DLL楼主可以用PowerBasic为VB写一些DLL,PowerBasic写的DLL的执行效率接近C语言。请看我的一个帖子
http://community.csdn.net/Expert/topic/3271/3271952.xml?temp=.5445063