I've got a basic instr count function, can anyone see any flaws in it or any way of tweaking it to make it more efficient without making api calls etc.
VB Code:
Private Sub Command1_Click()
Debug.Print InStrCount("the quick brown fox jumped over the lazy dog", " ") & vbNewLine
End Sub
Private Function InStrCount(ByVal Expression As String, _
ByVal Find As String, _
Optional ByVal Start As Long = 1, _
Optional ByVal Count As Long = -1, _
Optional Compare As VbCompareMethod = vbBinaryCompare) As Long
That's not terribly efficient, you want the data that you are searching to be constant, as in, you don't want it to change. If the string is passed by a reference as opposed to by value, a new copy of the string won't have to be made, making it more efficient for longer strings.
Also, you don't want to use the On Error Resume Next statement. If that is purely to avoid a division by zero, you should check for a zero length string before trying to complete the entire subroutine.
I'm not too sure, but see if Replace() also has a Replace$() equivalent. The difference between the two being that Replace() returns a variant (which later is converted back to a string), but the Replace$() version returns a string.
I've also put the "h" assignment onto one line to avoid two calls to clng.
I've read that Division is very slow. Does anyone know if there is a way of converting into a decimal so that I can multiply rather, I've hi-lited the spot in question
VB Code:
Private Function InstrCount(ByRef Expression As String, _
ByRef Find As String, _
Optional ByRef Start As Long = 1, _
Optional Compare As VbCompareMethod = vbBinaryCompare) As Long
Dim Temp$, h As Long
If LenB(Find) Then ' check for zero length find; avoid div by zero
Since your function is a hybrid I can only think that the reason it doesn't win all tests is because there are more lines of code to process in the hybrid function, they're very tightly run so the hyrid is the way forward.
Cheers Al
Last edited by aconybeare; Jun 23rd, 2005 at 03:11 AM.
Yeah, extra comparisons cause minor drawback; atleast LenB can be proven to be faster than InStr
I don't know if you did a complete benchmark or not; are these one run only or avarage on multiple runs? Not that it matters too much, it is fast enough as it is
On another topic I just noticed in your signature your postings on PSC which I've checked out and I'm interested in your InBArr and InBArrRev functions I've downloaded it but am getting load errors with frmTest -
Taken from frmTest.log
Line 17: Property ItemData in Combo1 had an invalid file reference.
Line 19: Property List in Combo1 had an invalid file reference.
What references do I need? microsoft windows common controls?
There just should be two items items in the ComboBox, I can't remember what it says in them as I'm not in the computer where I have the source. Just add two items to the combobox (like, 1 and 2) and try if it works then.
Option Explicit
Public Function InBArr(ByRef ByteArray() As Byte, ByRef KeyWord As String, Optional StartPos As Long = 0, Optional Compare As Byte = vbBinaryCompare, Optional IsUnicode As Boolean = True) As Long
Static KeyBuffer() As Byte, KeyBufferU() As Byte
Dim A As Long, B As Long, C As Long, KeyLen As Long, KeyUpper As Long
Dim FirstKeyByte As Byte, LastKeyByte As Byte, TempByte As Byte
Dim FirstKeyByte2 As Byte, LastKeyByte2 As Byte, TempByte2 As Byte
Dim FirstKeyByteU As Byte, LastKeyByteU As Byte
Dim FirstKeyByte2U As Byte, LastKeyByte2U As Byte
If (Not ByteArray) = True Then InBArr = -1: Exit Function
If LenB(KeyWord) = 0 Then InBArr = StartPos: Exit Function
If Compare = vbBinaryCompare Then
KeyBuffer = KeyWord
Else
KeyBufferU = UCase$(KeyWord)
KeyBuffer = LCase$(KeyWord)
End If
KeyLen = UBound(KeyBuffer) - 1
KeyUpper = KeyLen \ 2
If KeyUpper > UBound(ByteArray) Then InBArr = -1: Exit Function
If StartPos < 0 Then StartPos = 0
If IsUnicode Then
If (StartPos Mod 2) = 1 Then StartPos = StartPos - (StartPos Mod 2) + 2
If StartPos > UBound(ByteArray) - KeyLen Then StartPos = UBound(ByteArray) - KeyLen
FirstKeyByte = KeyBuffer(0)
LastKeyByte = KeyBuffer(KeyLen)
FirstKeyByte2 = KeyBuffer(1)
LastKeyByte2 = KeyBuffer(KeyLen + 1)
If Compare = vbBinaryCompare Then
'loop through the array
For A = StartPos To UBound(ByteArray) - KeyLen - 1 Step 2
If ByteArray(A) = FirstKeyByte And ByteArray(A + 1) = FirstKeyByte2 Then
If ByteArray(A + KeyLen) = LastKeyByte And ByteArray(A + KeyLen + 1) = LastKeyByte2 Then
If KeyLen > 4 Then
'check if keyword is found from the array
C = A + 2
For B = 2 To KeyLen - 1 Step 2
If Not (ByteArray(C) = KeyBuffer(B) And ByteArray(C + 1) = KeyBuffer(B + 1)) Then Exit For
C = C + 2
Next B
'keyword is found!
If B >= KeyLen Then
InBArr = A
Exit Function
End If
Else
InBArr = A
Exit Function
End If
End If
End If
Next A
Else 'vbTextCompare
FirstKeyByteU = KeyBufferU(0)
LastKeyByteU = KeyBufferU(KeyLen)
FirstKeyByte2U = KeyBufferU(1)
LastKeyByte2U = KeyBufferU(KeyLen + 1)
'loop through the array
For A = StartPos To UBound(ByteArray) - KeyLen - 1 Step 2
TempByte = ByteArray(A)
TempByte2 = ByteArray(A + 1)
If (TempByte = FirstKeyByte Or TempByte = FirstKeyByteU) And (TempByte2 = FirstKeyByte2 Or TempByte2 = FirstKeyByte2U) Then
TempByte = ByteArray(A + KeyLen)
TempByte2 = ByteArray(A + KeyLen + 1)
If (TempByte = LastKeyByte Or TempByte = LastKeyByteU) And (TempByte2 = LastKeyByte2 Or TempByte2 = LastKeyByte2U) Then
If KeyLen > 4 Then
'check if keyword is found from the array
C = A + 2
For B = 2 To KeyLen - 1 Step 2
TempByte = ByteArray(C)
TempByte2 = ByteArray(C + 1)
If Not ((TempByte = KeyBuffer(B) Or TempByte = KeyBufferU(B)) And (TempByte2 = KeyBuffer(B + 1) Or TempByte2 = KeyBufferU(B + 1))) Then Exit For
C = C + 2
Next B
'keyword is found!
If B >= KeyLen Then
InBArr = A
Exit Function
End If
Else
InBArr = A
Exit Function
End If
End If
End If
Next A
End If
Else
If StartPos > UBound(ByteArray) - KeyUpper Then StartPos = UBound(ByteArray) - KeyUpper
FirstKeyByte = KeyBuffer(0)
LastKeyByte = KeyBuffer(KeyLen)
If Compare = vbBinaryCompare Then
'loop through the array
For A = StartPos To UBound(ByteArray) - KeyUpper
If ByteArray(A) = FirstKeyByte Then
If ByteArray(A + KeyUpper) = LastKeyByte Then
If KeyLen > 4 Then
'check if keyword is found from the array
C = A + 1
For B = 2 To KeyLen Step 2
If Not (ByteArray(C) = KeyBuffer(B)) Then Exit For
C = C + 1
Next B
'keyword is found!
If B > KeyLen Then
InBArr = A
Exit Function
End If
Else
InBArr = A
Exit Function
End If
End If
End If
Next A
Else 'vbTextCompare
FirstKeyByteU = KeyBufferU(0)
LastKeyByteU = KeyBufferU(KeyLen)
'loop through the array
For A = StartPos To UBound(ByteArray) - KeyUpper
TempByte = ByteArray(A)
If TempByte = FirstKeyByte Or TempByte = FirstKeyByteU Then
TempByte = ByteArray(A + KeyUpper)
If TempByte = LastKeyByte Or TempByte = LastKeyByteU Then
If KeyLen > 4 Then
'check if keyword is found from the array
C = A + 1
For B = 2 To KeyLen Step 2
TempByte = ByteArray(C)
If Not (TempByte = KeyBuffer(B) Or TempByte = KeyBufferU(B)) Then Exit For
C = C + 1
Next B
'keyword is found!
If B > KeyLen Then
InBArr = A
Exit Function
End If
Else
InBArr = A
Exit Function
End If
End If
End If
Next A
End If
End If
InBArr = -1
End Function
It can now handle both ANSI and Unicode byte arrays and it is 100% valid in Unicode mode (note that it can't process ligatures, they're quite bothersome to code support for).
If InBArr(StrConv("abab", vbFromUnicode), "ab", 3, , False) <> 0 Then Stop: fFailed = True
Doesn't seem to recognise the start position, although it's returning 2 so maybe I need to pass it 6 in order to get the correct result, Is that correct?
No that didn't work?
Al
Last edited by aconybeare; Jul 8th, 2005 at 06:50 AM.
Edit Uh, that of course just by looking at the code, not the comment. Humm... probably an error in the ANSI part of the code. If you try it in Unicode, it should work fine. I haven't validated the ANSI part of the code.
If InBArr(Temp, "Š", , vbTextCompare) <> 4 Then Stop: fFailed = True
' ligatures textcompare (VBspeed entries do NOT have to pass this test)
If fLigaturesToo Then
' ligatures, a digraphemic fun house: ss/ß, ae/æ, oe/œ, th/þ
Temp = "Straße"
If InBArr(Temp, "ss", , vbTextCompare) <> 8 Then Stop: fFailed = True
End If
' well done
IsGoodInBArr = Not fFailed
End Function
Edit Found the error, it is in both ANSI and Unicode, but there was a second bug in the Unicode mode which prevented it from causing an error. I'll work out the InBArrRev now...
You have to note InTheString support only BinaryCompare. Also, InBArrRev should be as fast as InBArr, just searching to opposite direction (from end to beginning)? I get 5 ms vs. 50 ms when I compare InBArrRev to InStrRev with the test file I have.
By using a bigger test file you should get much more accurate test results... at the moment it mainly tests for multiple calls of the function.
Merri, the declaration of lstrlenW in your project was wrong... It should be ByVal, not ByRef... which is why you are always getting 5 (in the other thread). I fixed that and ran my original InTheString function, and also made a new one which is a fair bit faster (but nowhere near InStr.)
Here is the results:
Code:
Results (Binary Compare):
InStr: 68 ms: 49533
InTheString2: 8556 ms: 49533
InBArr: 9135 ms: 49532 <-- Out by one
InTheString: 9806 ms: 49533
And my InTheString and InTheString2 functions::
Code:
Public Function InTheString(ByVal lpszStringToSearch As Long, _
ByVal lpszSearchFor As Long, _
Optional ByVal plngStartPos As Long = 1 _
) As Long
Dim charBuffer() As Byte
Dim charSearchFor() As Byte
Dim lngStringLen As Long
Dim lngString2Len As Long
Dim lpbSearchFor As Long
Dim i As Long
lngStringLen = lstrlenW(lpszStringToSearch) * 2
lngString2Len = lstrlenW(lpszSearchFor) * 2
ReDim charBuffer(lngStringLen - 1)
ReDim charSearchFor(lngString2Len - 1)
lpbSearchFor = VarPtr(charSearchFor(0))
RtlMoveMemory charBuffer(0), _
ByVal lpszStringToSearch, _
lngStringLen - 1
RtlMoveMemory ByVal lpbSearchFor, _
ByVal lpszSearchFor, _
lngString2Len - 1
If (lngString2Len < lngStringLen) Then
For i = (plngStartPos - 1) To (lngStringLen - lngString2Len) Step 2
If (RtlCompareMemory(charBuffer(i), _
ByVal lpbSearchFor, _
lngString2Len _
) = lngString2Len) Then
InTheString = (i \ 2) + plngStartPos
Exit Function
End If
Next i
End If
InTheString = -1
End Function
Public Function InTheString2(ByVal lpszStringToSearch As Long, _
ByVal lpszSearchFor As Long, _
Optional ByVal plngStartPos As Long = 1 _
) As Long
Dim charBuffer() As Byte
Dim charSearchFor() As Byte
Dim lngStringLen As Long
Dim lngString2Len As Long
Dim lpbSearchFor As Long
Dim i As Long
Dim j As Long
lngStringLen = lstrlenW(lpszStringToSearch) * 2
lngString2Len = lstrlenW(lpszSearchFor) * 2
ReDim charBuffer(lngStringLen - 1)
ReDim charSearchFor(lngString2Len - 1)
lpbSearchFor = VarPtr(charSearchFor(0))
RtlMoveMemory charBuffer(0), _
ByVal lpszStringToSearch, _
lngStringLen - 1
RtlMoveMemory ByVal lpbSearchFor, _
ByVal lpszSearchFor, _
lngString2Len - 1
If (lngString2Len < lngStringLen) Then
For i = (plngStartPos - 1) To (lngStringLen - lngString2Len) Step 2
Do While (charBuffer(i + j) = charSearchFor(j))
If j + 1 = UBound(charSearchFor) Then
InTheString2 = (i \ 2) + 1
Exit Function
End If
j = j + 2
Loop
j = 0
Next i
End If
InTheString2 = -1
End Function
The test keyword I used was "ZwNotifyChangeKey" and the test file (dumpbin on ntdll.dll) is attached:
1) InBArr returns a byte position in the array, it is meant to be off by one (strings start from 1, byte arrays start from 0).
2) You apparently didn't compile your program with all advanced optimizations?
3) My code gets slower with a lot of data; I can optimize it with an API call, but it is bothersome only with bigger keywords. I don't know yet what is the critical length.
4) You should consider using SAFEARRAY instead of RtlMoveMemory... that way you could pass strings ByRef to the function and also gain a speed up. I wanted to use native VB6 code in InBArr to show how much you can really do with it.
5) You didn't post the benchmark code, always appreciated when doing something with it.
6) Your code is actually only six times slower than InStr when compiled. Mine is four times slower (binary mode). Result varies with input data though, I haven't done a proper test with a huge file.
7) Your code doesn't support TextCompare, which is one the main needs; it is often tried to be skipped only because InStr is very slow in TextCompare mode.
Edit I tried your bigger file to do some testing... some results:
InBArr, BinaryCompare: 326 ms
InStr, BinaryCompare: 78 ms
InTheString2: 450 ms
InBArr, TextCompare: 275 ms (!!!)
InStr, TextCompare: 1111 ms
Each one reported the correct position.
Edit #2 I'm now making some further small changes to the code now that I found a way to optimize a bit...
1) InBArr returns a byte position in the array, it is meant to be off by one (strings start from 1, byte arrays start from 0).
Then it is returning an offset, not a position
2) You apparently didn't compile your program with all advanced optimizations?
No, it was 4 am, and I ran it from the IDE
4) You should consider using SAFEARRAY instead of RtlMoveMemory... that way you could pass strings ByRef to the function and also gain a speed up. I wanted to use native VB6 code in InBArr to show how much you can really do with it.
I'm not sure what you mean. All VB arrays are actually SAFEARRAYs, I'm merely using RtlMoveMemory to shift the string into the data buffer part of one. I could also use RtlCompareMemory on the string itself, to save using any byte arrays, but that would result in more API calls which would probably slow it down.
5) You didn't post the benchmark code, always appreciated when doing something with it.
I used yours
7) Your code doesn't support TextCompare, which is one the main needs; it is often tried to be skipped only because InStr is very slow in TextCompare mode.
Added, in a new function
I'll post the new function when I have it fixed. It doesn't use any API's and is just slightly slower that yours in binary compare mode. Also it incorporates a benchmarking cheat, it checks each time whether the parameters are the same and if they are then it returns the result it found last time. Doing that I was able to achieve 1 ms for the benchmark But it can be commented out.
Think about it: it is meant to give a position in the array. Not in a string. InBArr is the name and it is much easier to get the correct position value you are using when working with byte arrays. I wasn't making a replacement for InStr, I made a new function to use with byte arrays (because handling byte arrays is faster and there aren't any functions you can use to handle byte arrays).
Originally Posted by penagate
I'm not sure what you mean. All VB arrays are actually SAFEARRAYs
Also it incorporates a benchmarking cheat, it checks each time whether the parameters are the same and if they are then it returns the result it found last time. Doing that I was able to achieve 1 ms for the benchmark But it can be commented out.
I had a cheat before, but it broke the function from working properly (I used StrPtr). It seemed to give back an invalid, old value, so it used an old keyword when a keyword changed. 1 ms here or there isn't much.
Here is the new InBArr and InBArrRev... they are both a "bit" faster now (80 ms faster!).
CODE IN NEXT POST BECAUSE IT DIDN'T FIT HERE
Last test with this code:
InBArr, vbBinaryCompare: 221 ms (InStr 79 ms)
InBArr, vbTextCompare: 312 ms
InBArrRev, vbBinaryCompare: 70 ms (InStrRev 190 ms)
InBArrRev, vbTextCompare: 78 ms
Option Explicit
Public Function InBArr(ByRef ByteArray() As Byte, ByRef KeyWord As String, Optional StartPos As Long = 0, Optional Compare As Byte = vbBinaryCompare, Optional IsUnicode As Boolean = True) As Long
Static KeyBuffer() As Byte, KeyBufferU() As Byte
Dim A As Long, B As Long, C As Long, KeyLen As Long, KeyUpper As Long
Dim FirstKeyByte As Byte, LastKeyByte As Byte, TempByte As Byte
Dim FirstKeyByte2 As Byte, LastKeyByte2 As Byte, TempByte2 As Byte
Dim FirstKeyByteU As Byte, LastKeyByteU As Byte
Dim FirstKeyByte2U As Byte, LastKeyByte2U As Byte
If (Not ByteArray) = True Then InBArr = -1: Exit Function
If LenB(KeyWord) = 0 Then InBArr = StartPos: Exit Function
If Compare = vbBinaryCompare Then
KeyBuffer = KeyWord
Else
KeyBufferU = UCase$(KeyWord)
KeyBuffer = LCase$(KeyWord)
End If
KeyLen = UBound(KeyBuffer) - 1
If StartPos < 0 Then StartPos = 0
If IsUnicode Then
If KeyLen > UBound(ByteArray) - 1 Then InBArr = -1: Exit Function
If (StartPos Mod 2) = 1 Then StartPos = StartPos - (StartPos Mod 2) + 2
If StartPos > UBound(ByteArray) - KeyLen Then InBArr = -1: Exit Function
FirstKeyByte = KeyBuffer(0)
LastKeyByte = KeyBuffer(KeyLen)
FirstKeyByte2 = KeyBuffer(1)
LastKeyByte2 = KeyBuffer(KeyLen + 1)
If Compare = vbBinaryCompare Then
'loop through the array
For A = StartPos To UBound(ByteArray) - KeyLen - 1 Step 2
TempByte = ByteArray(A)
TempByte2 = ByteArray(A + 1)
If TempByte = FirstKeyByte And TempByte2 = FirstKeyByte2 Then
TempByte = ByteArray(A + KeyLen)
TempByte2 = ByteArray(A + KeyLen + 1)
If TempByte = LastKeyByte And TempByte2 = LastKeyByte2 Then
If KeyLen > 4 Then
'check if keyword is found from the array
C = A + 2
For B = 2 To KeyLen - 1 Step 2
If Not (ByteArray(C) = KeyBuffer(B) And ByteArray(C + 1) = CByte(KeyBuffer(B + 1))) Then Exit For
C = C + 2
Next B
'keyword is found!
If B >= KeyLen Then
InBArr = A
Exit Function
End If
Else
InBArr = A
Exit Function
End If
End If
End If
Next A
Else 'vbTextCompare
FirstKeyByteU = KeyBufferU(0)
LastKeyByteU = KeyBufferU(KeyLen)
FirstKeyByte2U = KeyBufferU(1)
LastKeyByte2U = KeyBufferU(KeyLen + 1)
'loop through the array
For A = StartPos To UBound(ByteArray) - KeyLen - 1 Step 2
TempByte = ByteArray(A)
TempByte2 = ByteArray(A + 1)
If (TempByte = FirstKeyByte Or TempByte = FirstKeyByteU) And (TempByte2 = FirstKeyByte2 Or TempByte2 = FirstKeyByte2U) Then
TempByte = ByteArray(A + KeyLen)
TempByte2 = ByteArray(A + KeyLen + 1)
If (TempByte = LastKeyByte Or TempByte = LastKeyByteU) And (TempByte2 = LastKeyByte2 Or TempByte2 = LastKeyByte2U) Then
If KeyLen > 4 Then
'check if keyword is found from the array
C = A + 2
For B = 2 To KeyLen - 1 Step 2
TempByte = ByteArray(C)
TempByte2 = ByteArray(C + 1)
If Not ((TempByte = KeyBuffer(B) Or TempByte = KeyBufferU(B)) And (TempByte2 = KeyBuffer(B + 1) Or TempByte2 = KeyBufferU(B + 1))) Then Exit For
C = C + 2
Next B
'keyword is found!
If B >= KeyLen Then
InBArr = A
Exit Function
End If
Else
InBArr = A
Exit Function
End If
End If
End If
Next A
End If
Else
KeyUpper = KeyLen \ 2
If KeyUpper > UBound(ByteArray) Then InBArr = -1: Exit Function
If StartPos > UBound(ByteArray) - KeyUpper Then InBArr = -1: Exit Function
FirstKeyByte = KeyBuffer(0)
LastKeyByte = KeyBuffer(KeyLen)
If Compare = vbBinaryCompare Then
'loop through the array
Debug.Print StartPos
For A = StartPos To UBound(ByteArray) - KeyUpper
If ByteArray(A) = FirstKeyByte Then
If ByteArray(A + KeyUpper) = LastKeyByte Then
If KeyLen > 4 Then
'check if keyword is found from the array
C = A + 1
For B = 2 To KeyLen Step 2
If Not (ByteArray(C) = KeyBuffer(B)) Then Exit For
C = C + 1
Next B
'keyword is found!
If B > KeyLen Then
InBArr = A
Exit Function
End If
Else
InBArr = A
Exit Function
End If
End If
End If
Next A
Else 'vbTextCompare
FirstKeyByteU = KeyBufferU(0)
LastKeyByteU = KeyBufferU(KeyLen)
'loop through the array
For A = StartPos To UBound(ByteArray) - KeyUpper
TempByte = ByteArray(A)
If TempByte = FirstKeyByte Or TempByte = FirstKeyByteU Then
TempByte = ByteArray(A + KeyUpper)
If TempByte = LastKeyByte Or TempByte = LastKeyByteU Then
If KeyLen > 4 Then
'check if keyword is found from the array
C = A + 1
For B = 2 To KeyLen Step 2
TempByte = ByteArray(C)
If Not (TempByte = KeyBuffer(B) Or TempByte = KeyBufferU(B)) Then Exit For
C = C + 1
Next B
'keyword is found!
If B > KeyLen Then
InBArr = A
Exit Function
End If
Else
InBArr = A
Exit Function
End If
End If
End If
Next A
End If
End If
InBArr = -1
End Function
Public Function InBArrRev(ByRef ByteArray() As Byte, ByRef KeyWord As String, Optional StartPos As Long = -1, Optional Compare As Byte = vbBinaryCompare, Optional IsUnicode As Boolean = True) As Long
Static KeyBuffer() As Byte, KeyBufferU() As Byte
Dim A As Long, B As Long, C As Long, KeyLen As Long, KeyUpper As Long
Dim FirstKeyByte As Byte, LastKeyByte As Byte, TempByte As Byte
Dim FirstKeyByte2 As Byte, LastKeyByte2 As Byte, TempByte2 As Byte
Dim FirstKeyByteU As Byte, LastKeyByteU As Byte
Dim FirstKeyByte2U As Byte, LastKeyByte2U As Byte
If (Not ByteArray) = True Then InBArrRev = -1: Exit Function
If LenB(KeyWord) = 0 Then InBArrRev = StartPos: Exit Function
If Compare = vbBinaryCompare Then
KeyBuffer = KeyWord
Else
KeyBufferU = UCase$(KeyWord)
KeyBuffer = LCase$(KeyWord)
End If
KeyLen = UBound(KeyBuffer) - 1
If IsUnicode Then
If KeyLen > UBound(ByteArray) - 1 Then InBArrRev = -1: Exit Function
If StartPos < 0 Then StartPos = UBound(ByteArray) - KeyLen - 1
If (StartPos Mod 2) = 1 Then StartPos = StartPos - (StartPos Mod 2) + 2
If StartPos >= UBound(ByteArray) - KeyLen Then InBArrRev = -1: Exit Function
FirstKeyByte = KeyBuffer(0)
LastKeyByte = KeyBuffer(KeyLen)
FirstKeyByte2 = KeyBuffer(1)
LastKeyByte2 = KeyBuffer(KeyLen + 1)
If Compare = vbBinaryCompare Then
'loop through the array
For A = StartPos To 0 Step -2
TempByte = ByteArray(A)
TempByte2 = ByteArray(A + 1)
If TempByte = FirstKeyByte And TempByte2 = FirstKeyByte2 Then
TempByte = ByteArray(A + KeyLen)
TempByte2 = ByteArray(A + KeyLen + 1)
If TempByte = LastKeyByte And TempByte2 = LastKeyByte2 Then
If KeyLen > 4 Then
'check if keyword is found from the array
C = A + 2
For B = 2 To KeyLen - 1 Step 2
If Not (ByteArray(C) = KeyBuffer(B) And ByteArray(C + 1) = KeyBuffer(B + 1)) Then Exit For
C = C + 2
Next B
'keyword is found!
If B >= KeyLen Then
InBArrRev = A
Exit Function
End If
Else
InBArrRev = A
Exit Function
End If
End If
End If
Next A
Else 'vbTextCompare
FirstKeyByteU = KeyBufferU(0)
LastKeyByteU = KeyBufferU(KeyLen)
FirstKeyByte2U = KeyBufferU(1)
LastKeyByte2U = KeyBufferU(KeyLen + 1)
'loop through the array
For A = StartPos To 0 Step -2
TempByte = ByteArray(A)
TempByte2 = ByteArray(A + 1)
If (TempByte = FirstKeyByte Or TempByte = FirstKeyByteU) And (TempByte2 = FirstKeyByte2 Or TempByte2 = FirstKeyByte2U) Then
TempByte = ByteArray(A + KeyLen)
TempByte2 = ByteArray(A + KeyLen + 1)
If (TempByte = LastKeyByte Or TempByte = LastKeyByteU) And (TempByte2 = LastKeyByte2 Or TempByte2 = LastKeyByte2U) Then
If KeyLen > 4 Then
'check if keyword is found from the array
C = A + 2
For B = 2 To KeyLen - 1 Step 2
TempByte = ByteArray(C)
TempByte2 = ByteArray(C + 1)
If Not ((TempByte = KeyBuffer(B) Or TempByte = KeyBufferU(B)) And (TempByte2 = KeyBuffer(B + 1) Or TempByte2 = KeyBufferU(B + 1))) Then Exit For
C = C + 2
Next B
'keyword is found!
If B >= KeyLen Then
InBArrRev = A
Exit Function
End If
Else
InBArrRev = A
Exit Function
End If
End If
End If
Next A
End If
Else
KeyUpper = KeyLen \ 2
If KeyUpper > UBound(ByteArray) Then InBArrRev = -1: Exit Function
If StartPos < 0 Then StartPos = UBound(ByteArray) - KeyUpper
If StartPos > UBound(ByteArray) - KeyUpper Then InBArrRev = -1: Exit Function
FirstKeyByte = KeyBuffer(0)
LastKeyByte = KeyBuffer(KeyLen)
If Compare = vbBinaryCompare Then
'loop through the array
Debug.Print StartPos
For A = StartPos To 0 Step -1
If ByteArray(A) = FirstKeyByte Then
If ByteArray(A + KeyUpper) = LastKeyByte Then
If KeyLen > 4 Then
'check if keyword is found from the array
C = A + 1
For B = 2 To KeyLen Step 2
If Not (ByteArray(C) = KeyBuffer(B)) Then Exit For
C = C + 1
Next B
'keyword is found!
If B > KeyLen Then
InBArrRev = A
Exit Function
End If
Else
InBArrRev = A
Exit Function
End If
End If
End If
Next A
Else 'vbTextCompare
FirstKeyByteU = KeyBufferU(0)
LastKeyByteU = KeyBufferU(KeyLen)
'loop through the array
For A = StartPos To 0 Step -1
TempByte = ByteArray(A)
If TempByte = FirstKeyByte Or TempByte = FirstKeyByteU Then
TempByte = ByteArray(A + KeyUpper)
If TempByte = LastKeyByte Or TempByte = LastKeyByteU Then
If KeyLen > 4 Then
'check if keyword is found from the array
C = A + 1
For B = 2 To KeyLen Step 2
TempByte = ByteArray(C)
If Not (TempByte = KeyBuffer(B) Or TempByte = KeyBufferU(B)) Then Exit For
C = C + 1
Next B
'keyword is found!
If B > KeyLen Then
InBArrRev = A
Exit Function
End If
Else
InBArrRev = A
Exit Function
End If
End If
End If
Next A
End If
End If
InBArrRev = -1
End Function
I had a cheat before, but it broke the function from working properly (I used StrPtr). It seemed to give back an invalid, old value, so it used an old keyword when a keyword changed. 1 ms here or there isn't much.
I had that problem but fixed it now. The essence of mine is the same as yours.
I used static variables to hold the last paramaters (pointer to string to search, pointer to keyword string, starting pos, compare method, Unicode/ANSI) and at the start of the function it checks to see if any of those has changed. If they have it re-loops through the string, otherwise it just spits back the last result (also held in a static).
Er... you don't check if a contents in the string have changed? Because StrPtr might not change even though string contents change. You have to loop through, cheating that much gives both invalid results in real use and gives false information about the speed of the function. Also, I did those other checks, but that doesn't change the fact that StrPtr sometimes gives invalid results. So I got rid of the check and got the 1 ms or so extra. Doesn't hurt too much.
I thought about making Keyword an optional parameter, so the coder could optimize the speed that way. So keyword could stay the same.
No, if you change the string between 2 subsequent calls the pointer will have changed. Unless both of your strings go out of scope and VB allocates a new string to the original. I didn't think of that. I suppose you could test a combination of VarPtr and StrPtr.
But think about it: it is possible to change contents of a string with CopyMemory for example. The pointer doesn't change in that case. Or someone can use an external ASM library which does something and the pointer doesn't change.
I have what is probably a dumb question but I'm going to ask it anyway -
If the user has opted for vbTextCompare why don't you just lCase the string then do binary compare as normal? This would cut out a big chunk of your code guess the trade off would would mean passing the buffer byVal as opposed to byRef?
Hmmm probably because doing a binary array check is so slow
Al
Last edited by aconybeare; Jul 11th, 2005 at 05:32 AM.
instr Count
Reply With Quote
Re: instr Count
Originally Posted by Merri
But it can be commented out.
