Printable View
Merri,
Nice one, I think I must be doing something wrong, I'm testing it using this -
VB Code:
I'm getting -1 back when I'm expecting it to return 1??
Any ideas?
Cheers Al
You don't need to use StrConv. It is now Unicode-aware. It will return 2, because a character is two bytes.
VB Code:
Merri,
This one is failing am I doing something wrong?
VB Code:
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
You should have -1 there, not 0 :)
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.
When I try running it in uni mode I get the following error -
Compile Error:
Typemismatch: Array or user defined type expected
here is my call -
VB Code:
Oops, my mistake in the example code there. Should've been:
VB Code:
Here is a complete test code so you don't need to bother as much with the Unicode side of the code. I'm fixing the ANSI side atm.
VB Code:
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...
Here is a fresh test project. Try and see if there are any problems :)
Excellent!
These are my test results -
If you can do binary search then InStr is like lighteningVB Code:
but with textCompare InBArr rules
Obviously this is just one check I'll need to do more thorough testing to get a better idea of it's overall capabilities,
InBRev is very, very slow with both BinaryCompare and TextCompare
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:
And my InTheString and InTheString2 functions::Code:Results (Binary Compare):
InStr: 68 ms: 49533
InTheString2: 8556 ms: 49533
InBArr: 9135 ms: 49532 <-- Out by one
InTheString: 9806 ms: 49533
The test keyword I used was "ZwNotifyChangeKey" and the test file (dumpbin on ntdll.dll) is attached: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
A few things to think about :)
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...
Then it is returning an offset, not a position ;)Quote:
Originally Posted by Merri
No, it was 4 am, and I ran it from the IDE :eek:Quote:
2) You apparently didn't compile your program with all advanced optimizations?
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.Quote:
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 used yours ;)Quote:
5) You didn't post the benchmark code, always appreciated when doing something with it.
Added, in a new function :)Quote:
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.
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 :p 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).Quote:
Originally Posted by penagate
Take a look at VBspeed: http://www.xbeat.net/vbspeed/i_Dope.htm#modulesQuote:
Originally Posted by penagate
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.Quote:
Originally Posted by penagate
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
*sniff* Wished I could post longer posts.Code: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
Code: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 that problem but fixed it now. The essence of mine is the same as yours.Quote:
Originally Posted by Merri
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.
Merri,
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