Re: cSortedDictionary sort mode alphanumeric

Tech-Archive recommends: Repair Windows Errors & Optimize Windows Performance


"MP" <NoSpam@xxxxxxxxxx> schrieb im Newsbeitrag
news:upRoZd38IHA.356@xxxxxxxxxxxxxxxxxxxxxxx

it adds more time than i thought it would

'total 700 items sorted
'without padding Total time: 0.797 Seconds
That timing seems a bit high for the Dictionary, if
you stopped that without using any Padding-Function.
I assume, 700 items is the ItemCount inside the Dictionary
after you checked for existance (and counted) much more
than just 700 Keys against it.

On my old PIII-500MHz, the following Code needs
only 50msec (in the IDE), to check 3000 items with Padding -
after the Counting-Check there are then 2000 remaining
"unique-items" in the Dictionary.

'***Into a Form (needs a List1-Listbox on it - and
'***a reference to dhRichClient.dll for cSortedDictionary
Option Explicit

Private oDicCounting As cPaddedCounting, oDict As cSortedDictionary

Private Sub Form_Load()
Set oDicCounting = New cPaddedCounting
End Sub

Private Sub Form_Click()
Dim i&, A_Arr$(999), ZZZ_Arr$(999), T!

Set oDict = New cSortedDictionary
oDict.StringCompareMode = BinaryCompare

'prefill some StringArrays for testing
For i = 0 To 999
A_Arr(i) = "A" & i
ZZZ_Arr(i) = "ZZZ" & i
Next i

'let's time the counting of 3000 Keys (with padding)
T = Timer
For i = 0 To 999
oDicCounting.PadKeyAndCountIt ZZZ_Arr(i), oDict
Next i

For i = 0 To 999 'now the A's, just to stress the sorting a bit
oDicCounting.PadKeyAndCountIt A_Arr(i), oDict
Next i

For i = 0 To 999
oDicCounting.PadKeyAndCountIt ZZZ_Arr(i), oDict
Next i
'write the time for checking 3000 Keys with padding into
'the Forms Caption, in the Dict are only 2000 items now BTW
Caption = Timer - T & " Dict.Count = " & oDict.Count

'only to check for correctly sorted Keys
List1.Clear
For i = 0 To oDict.Count - 1
List1.AddItem oDict.KeyByIndex(i) & " - Count = " & _
oDict.ItemByIndex(i)
Next i
End Sub


And here the Padding-Function, wrapped in a Class, to ensure
automatic initializing and resetting of the safeArray-Helper-
constructs.
Probably a bit over-dimensioned for your case - just to
demonstrate, how to handle that task in a not much more
optimizable way (without any String-Allocations).

'***Into a Class named cPaddedCounting
Option Explicit

Private Type SAFEARRAY1D
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
cElements As Long
lLbound As Long
End Type

Private Declare Sub BindArray Lib "kernel32" Alias "RtlMoveMemory" _
(PArr() As Any, PSrc&, Optional ByVal cb& = 4)
Private Declare Sub ReleaseArray Lib "kernel32" Alias "RtlMoveMemory" _
(PArr() As Any, Optional PSrc& = 0, Optional ByVal cb& = 4)

Private S1Arr() As Integer, saS1Arr As SAFEARRAY1D
Private S2Arr() As Integer, saS2Arr As SAFEARRAY1D, S2 As String

'the trick here is, to not use any String-Allocation in
'this padding-routine
Friend Sub PadKeyAndCountIt(Key As String, oDict As cSortedDictionary)
Dim i&, j&
saS1Arr.cElements = Len(Key)
saS1Arr.pvData = StrPtr(Key)

Do Until i = saS1Arr.cElements
If S1Arr(i) > 64 Then 'copy the Char to S2
S2Arr(i) = S1Arr(i)
Else 'first numeric Digit
j = i
S2Arr(j) = 48: j = j + 1 'set first Digit to zero
S2Arr(j) = 48: j = j + 1 'set second Digit to zero

For i = saS1Arr.cElements - 1 To i Step -1
S2Arr(j) = S1Arr(i): j = j - 1
Next i
S2Arr(i + 4) = 0 'follow the Bstr-Convention and add a NullWChar
S2Arr(-2) = i + i + 8 'that's the StrLenB of our PadBuffer now
Exit Do
End If
i = i + 1
Loop

'S2 contains the padded Key now
If oDict.Exists(S2) Then
oDict.Item(S2) = oDict.Item(S2) + 1
Else
oDict.Add S2, 1
End If

'reset S2 to its original allocated StrLenB
S2Arr(-2) = saS2Arr.cElements + saS2Arr.cElements
End Sub

Private Sub Class_Initialize()
saS1Arr.cDims = 1: saS1Arr.cbElements = 2 '2 Bytes per Element
BindArray S1Arr, VarPtr(saS1Arr)

'the second Binding will be completely fixed here -
'we bind explicitely to S2, which acts as a static buffer
S2 = Space(100) 'allocate BufSpace for 100 Chars
saS2Arr.cDims = 1: saS2Arr.cbElements = 2
saS2Arr.cElements = Len(S2) + 2
saS2Arr.lLbound = -2 'the integer-array starts at -2...
BindArray S2Arr, VarPtr(saS2Arr)
'...so that we can access the BSTR-LenDescriptor with it too -
'by simply setting the StrPtr with 4Bytes negative Offset
saS2Arr.pvData = StrPtr(S2) - 4
End Sub

Private Sub Class_Terminate()
ReleaseArray S1Arr 'resets S1Arr into its original, "virginal" state
ReleaseArray S2Arr 'resets S1Arr into its original, "virginal" state
End Sub

Olaf


.

Relevant Pages

  • Re: About padding with files in AES
    ... Upon decryption, the decrypting system just needs to look at ... The cyphertext could in a long ... a valid padding. ... added data as a check when only a small number of keys are involved. ...
    (sci.crypt)
  • Re: Decrypt CipherValue with different DES2 keys getting a correct padding ?
    ... sufficient for correct padding. ... keys, still pretty trivial. ... siging the plain data first and the encrypt plain data and signature. ...
    (sci.crypt)
  • Re: Im still amused.
    ... keys with certain algorithms. ... true permutations but the function will use any entry in a way to ... When your text is evaluated using my Texstego program and the padding ... Texstego key mapping to produce geaupoUe/K, ...
    (sci.crypt)
  • Re: AES or Triple DES?
    ... > qualifications. ... > this padding can add up on lots of short messages. ... > My idea is to change keys every XXX messages (XXX to be ...
    (sci.crypt)