The main reason for the speed improvement is due to its doing its own memory management. The string is allocated statically at a fixed size that cannot be modified. Attempting to overflow the string results in clipping.
First is a little test driver, then the actual library, then finally an equivalent program to the first two using native code and my old QBMID routine from the "Snips" section. On my system, the library's driver is more than one second faster than the native code example.
Code: |
ITERATIONS = 40
STRINGSIZE = 4000 t = Time$("ms") aString = NewStr(STRINGSIZE) For i = 1 To ITERATIONS For c = 1 To STRINGSIZE Call MidStrN aString, c, 1, "X" Next c Next i Call KillStr aString Print Time$("ms") - t End |
Code: |
'== Large String Library
'== By Brent D. Thorn, 11/2007 Function NewStr( Size ) '-- Creates a new string of a given size. '-- Paramters ' Size - number of bytes '-- Returns ' a pointer to the string or NULL Struct cbStr, cb As ULong Global g.hProcessHeap CallDLL #kernel32, "GetProcessHeap", g.hProcessHeap As ULong If Size < 1 Then Exit Function cbHeap = Size + 4 CallDLL #kernel32, "HeapAlloc", g.hProcessHeap As ULong, 0 As ULong, cbHeap As ULong, NewStr As ULong cbStr.cb.struct = 0 CallDLL #kernel32, "RtlMoveMemory", NewStr As ULong, cbStr As Struct, 4 As ULong, ret As Void End Function Sub KillStr pStr '-- Destroys a string created by 'NewStr' '-- Parameters ' pStr - a pointer to a string CallDLL #kernel32, "HeapFree", g.hProcessHeap As ULong, 0 As ULong, pStr As ULong, ret As Long End Sub Function LenStr( pStr ) '-- Equivalent of the LEN function '-- Parameters ' pStr - a pointer to a string created by 'NewStr' '-- Returns ' the length of the string in bytes '[safe] CallDLL #kernel32, "RtlMoveMemory", cbStr As Struct, pStr As ULong, 4 As ULong, ret As Void cbStr.struct = pStr '[unsafe] LenStr = cbStr.cb.struct End Function Sub LetStr pDst, Src$ '-- Equivalent of LET for a string created by 'NewStr' '-- Paramters ' pDst - a pointer to the string to be assigned a new value ' Src$ - a string that holds the new value to be assigned CallDLL #kernel32, "HeapSize", g.hProcessHeap As ULong, 0 As ULong, pDst As ULong, cbHeap As ULong pStr = pDst + 4 cbSrc = Min(cbHeap - 4, Len(Src$)) CallDLL #kernel32, "RtlMoveMemory", pStr As ULong, Src$ As Ptr, cbSrc As ULong, ret As Void cbStr.cb.struct = cbSrc CallDLL #kernel32, "RtlMoveMemory", pDst As ULong, cbStr As Struct, 4 As ULong, ret As Void End Sub Sub CatStr pDst, Src$ '-- Concatenates a string onto a string created by 'NewStr' '-- Parameters ' pDst - a pointer to a string to be modified ' Src$ - a string to be concatenated CallDLL #kernel32, "HeapSize", g.hProcessHeap As ULong, 0 As ULong, pDst As ULong, cbHeap As ULong '[safe] CallDLL #kernel32, "RtlMoveMemory", cbStr As Struct, pDst As ULong, 4 As ULong, ret As Void cbStr.struct = pDst '[unsafe] cbDst = cbStr.cb.struct cbSrc = Min(cbHeap - 4 - cbDst, Len(Src$)) pStr = pDst + 4 + cbDst CallDLL #kernel32, "RtlMoveMemory", pStr As ULong, Src$ As Ptr, cbSrc As ULong, ret As Void cbStr.cb.struct = cbDst + cbSrc CallDLL #kernel32, "RtlMoveMemory", pDst As ULong, cbStr As Struct, 4 As ULong, ret As Void End Sub Function GetStr$( pStr ) '-- Somewhat equivalent to WINSTRING '-- Parameters ' pStr - a pointer to a string created by 'NewStr' '-- Returns ' the string value regardless of NUL characters '[safe] CallDLL #kernel32, "RtlMoveMemory", cbStr As Struct, pStr As ULong, 4 As ULong, ret As Void cbStr.struct = pStr '[unsafe] cbStr = cbStr.cb.struct GetStr$ = Space$(cbStr) pStr = pStr + 4 CallDLL #kernel32, "RtlMoveMemory", GetStr$ As Ptr, pStr As ULong, cbStr As ULong, ret As Void End Function Sub MidStr pDst, Pos, Src$ '-- Equivalent to QB's MID$ statement with two params ' E.g. MID$(d$, p) = s$ '[safe] CallDLL #kernel32, "RtlMoveMemory", cbStr As Struct, pDst As ULong, 4 As ULong, ret As Void cbStr.struct = pDst '[unsafe] cbDst = cbStr.cb.struct pDst = pDst + 3 + Pos cnt = Len(Src$) If Pos + cnt > cbDst Then _ cnt = cbDst - Pos + 1 If cnt > 0 Then _ CallDLL #kernel32, "RtlMoveMemory", pDst As ULong, Src$ As Ptr, cnt As ULong, ret As Void End Sub Sub MidStrN pDst, Pos, Cnt, Src$ '-- Equivalent to QB's MID$ statement with three params ' E.g. MID$(d$, p, c) = s$ '[safe] CallDLL #kernel32, "RtlMoveMemory", cbStr As Struct, pDst As ULong, 4 As ULong, ret As Void cbStr.struct = pDst '[unsafe] cbDst = cbStr.cb.struct pDst = pDst + 3 + Pos If Cnt > Len(Src$) Then Cnt = Len(Src$) If Pos + Cnt > cbDst Then _ Cnt = cbDst - Pos + 1 If Cnt > 0 Then _ CallDLL #kernel32, "RtlMoveMemory", pDst As ULong, Src$ As Ptr, Cnt As ULong, ret As Void End Sub |
Code: |
ITERATIONS = 40
STRINGSIZE = 4000 t = Time$("ms") a$ = Space$(STRINGSIZE) For i = 1 To ITERATIONS For c = 1 To STRINGSIZE Call QBMID a$, c, 1, "X" Next c Next i Print Time$("ms") - t End Sub QBMID ByRef Dst$, Pos, Cnt, Src$ '-- Equivalent to QB's MID$(d$,p,c)=s$ command. '-- Usage: Call QBMID d$,p,c,s$ '-- Provided freely by Brent D. Thorn. '-- http://www.b6sw.com If Cnt > Len(Src$) Then Cnt = Len(Src$) If Pos + Cnt > Len(Dst$) Then _ Cnt = Len(Dst$) - Pos + 1 If Cnt > 0 Then Dst$ = Left$(Dst$, Pos - 1) _ + Left$(Src$, Cnt) _ + Mid$(Dst$, Pos + Cnt) End If End Sub |