vba get random with string as seed - vba

I'm working under MS-Visio 2010 in VBA (not an expert) and I want to generate a random number (several numbers would be even better) based on a string as seed.
I know that Rnd(seed) with seed as a negative number exists. However, I don't know about any random generator with a string as seed. Maybe some kind of hash function with a number as result ?
I'd like something like :
print function("abc")
45
print function("xyz abc-5")
86
print function("abc")
45
with spaces, symbols and numbers support when inside the seed string.
I may see a workaround by converting each character to some ascii number corresponding and somehow using this big number as seed with Rnd but it definitely feels far-fetched. Does anyone knows of a fancier way of doing so ?

Combined these examples
VBA hash string
Convert HEX string to Unsigned INT (VBA)
to:
Function hash4(txt)
' copied from the example
Dim x As Long
Dim mask, i, j, nC, crc As Integer
Dim c As String
crc = &HFFFF
For nC = 1 To Len(txt)
j = Asc(Mid(txt, nC)) ' <<<<<<< new line of code - makes all the difference
' instead of j = Val("&H" + Mid(txt, nC, 2))
crc = crc Xor j
For j = 1 To 8
mask = 0
If crc / 2 <> Int(crc / 2) Then mask = &HA001
crc = Int(crc / 2) And &H7FFF: crc = crc Xor mask
Next j
Next nC
c = Hex$(crc)
' <<<<< new section: make sure returned string is always 4 characters long >>>>>
' pad to always have length 4:
While Len(c) < 4
c = "0" & c
Wend
Dim Hex2Dbl As Double
Hex2Dbl = CDbl("&h0" & c) ' Overflow Error if more than 2 ^ 64
If Hex2Dbl < 0 Then Hex2Dbl = Hex2Dbl + 4294967296# ' 16 ^ 8 = 4294967296
hash4 = Hex2Dbl
End Function
Try in immediate (Ctrl + G in VBA editor window):
?hash4("Value 1")
31335
?hash4("Value 2")
31527
This function will:
return different number for different input strings
sometimes they will match, it is called hash-collisions
if it is critical, you can use md5, sha-1 hashes, their examples in VBA also available
return same number for same input strings

Related

VB .NET Convert string to array of bytes without converting the characters

I'm trying to split a string of 32 numerical characters into a 16 length Array of Byte and each value has to stay numerical
from "70033023311330000000004195081460" to array {&H_70, &H_03, &H_30, &H_23, ..}
I've tried multiple stuff but each time either it's the conversion that's wrong or I can't find the appropriate combination of functions to implement it.
'it splits but per 1 character only instead of two
str.Select(Function(n) Convert.ToByte(n, 10)).ToArray
'I also tried looping but then the leading zero disappears and the output is a string converted to HEX which is also not what I want.
Function ConvertStringToHexBinary(str As String) As Byte()
Dim arr(15) As Byte
Dim k = 0
For i As Integer = 0 To str.Length - 1
arr(k) = str(i) & str(i + 1)
k += 1
i += 1
Next
Return arr
End Function
Anyone got any suggestion what to do?
G3nt_M3caj's use of LINQ might be.. er.. appealing to the LINQ lovers but it's horrifically inefficient. LINQ is a hammer; not everything is a nail.
This one is about 3 times faster than the LINQ version:
Dim str As String = "70033023311330000000004195081460"
Dim byt(str.Length/2) as Byte
For i = 0 to str.Length - 1 Step 2
byt(i/2) = Convert.ToByte(str.Substring(i, 2))
Next i
And this one, which does it all with math and doesn't do any new stringing at all is just under 3 times faster than the above (making it around 9 times faster than the LINQ version):
Dim str As String = "70033023311330000000004195081460"
Dim byt(str.Length / 2) As Byte
For i = 0 To str.Length - 1
If i Mod 2 = 0 Then
byt(i / 2) = (Convert.ToByte(str(i)) - &H30) * &HA
Else
byt(i / 2) += Convert.ToByte(str(i)) - &H30
End If
Next i
Of the two, I prefer the stringy version because it's easier to read and work out what's going on - another advantage loops approaches often have over a LINQ approach
Do you need something like this?
Dim str As String = "70033023311330000000004195081460"
Dim mBytes() As Byte = str.
Select(Function(x, n) New With {x, n}).
GroupBy(Function(x) x.n \ 2, Function(x) x.x).
Select(Function(y) Convert.ToByte(New String(y.ToArray()), 10)).ToArray

Random number creating

I got some help from one, and the code works perfectly fine.
What im looking for, is an explanation of the code, since my basic VBA-knowledge does not provide me with it.
Can someone explain what happens from "Function" and down?
Sub Opgave8()
For i = 2 To 18288
If Left(Worksheets("arab").Cells(i, 12), 6) = "262015" Then
Worksheets("arab").Cells(i, 3) = "18" & UniqueRandDigits(5)
End If
Next i
End Sub
Function UniqueRandDigits(x As Long) As String
Dim i As Long
Dim n As Integer
Dim s As String
Do
n = Int(Rnd() * 10)
If InStr(s, n) = 0 Then
s = s & n
i = i + 1
End If
Loop Until i = x + 1
UniqueRandDigits = s
End Function
n = Int(Rnd()*10) returns a value between 0 and 9, since Rnd returns a value between 0 and 1 and Int converts it to an integer, aka, a natural number.
Then If InStr(s, n) = 0 checks if the random number is already in your result: if not, it adds it using the string concatenation operator &.
This process loops (do) until i = x + 1 where x is your input argument, so you get a string of length x. Then the first part just fills rows with these random strings.
N.B. : I explained using the logical order of the code. Your friend function UniqRandDigits is defined after the "business logic", but it's the root of the code.
The code loops from row 2 to 18288 in Worksheet "arab". If first 6 characters in 12th column are "262015", then in 3rd column macro will fill cell with value "18" followed by result of function UniqueRandDigits(5) which generates 5 unique digits (0-9).
About the UniqueRandDigits function, the most important is that Rnd() returns a value lesser than 1 but greater than or equal to zero.
Int returns integer value, so Int(Rnd() * 10) will generate a random integer number from 0 to 9.
If InStr(s, n) = 0 Then makes sure than generated integer value doesn't exist in already generated digits of this number, because as the function name says, they must be unique.

signed result of Val function in VBA

I use vba in ms access,and found that ,if my parameter greater than 0x8000
less than 0x10000, the result is minus number
eg. Val("&H8000") = -32768 Val("&HFFFF")= -1
how can i get the unsigned number?
thanks!
There's a problem right here:
?TypeName(&HFFFF)
Integer
The Integer type is 16-bit, and 65,535 overflows it. This is probably overkill, but it was fun to write:
Function ConvertHex(ByVal value As String) As Double
If Left(value, 2) = "&H" Then
value = Right(value, Len(value) - 2)
End If
Dim result As Double
Dim i As Integer, j As Integer
For i = Len(value) To 1 Step -1
Dim digit As String
digit = Mid$(value, i, 1)
result = result + (16 ^ j) * Val("&H" & digit)
j = j + 1
Next
ConvertHex = result
End Function
This function iterates each digit starting from the right, computing its value and adding it to the result as it moves to the leftmost digit.
?ConvertHex("&H10")
16
?ConvertHex("&HFF")
255
?ConvertHex("&HFFFF")
65535
?ConvertHex("&HFFFFFFFFFFFFF")
281474976710655
UPDATE
As I suspected, there's a much better way to do this. Credits to #Jonbot for this one:
Function ConvertHex(ByVal value As String) As Currency
Dim result As Currency
result = CCur(value)
If result < 0 Then
'Add two times Int32.MaxValue and another 2 for the overflow
'Because the hex value is apparently parsed as a signed Int64/Int32
result = result + &H7FFFFFFF + &H7FFFFFFF + 2
End If
ConvertHex = result
End Function
Append an ampersand to the hex literal to force conversion to a 32bit integer:
Val("&HFFFF" & "&") == 65535
Val("&H8000&") == +32768
Don't use Val. Use one of the built-in conversion functions instead:
?CCur("&HFFFF")
65535
?CDbl("&HFFFF")
65535
Prefer Currency over Double in this case, to avoid floating-point issues.

VB6 comparing only numeric characters in srings

I need to compare phone numbers from a CSV file to phone numbers in an SSMS database in VB6 without using the .Net Library. One may have a number as 555-555-5555 and the other may have the same number as (555) 555-5555 which obviously kicks back as different when strings are compared.
I know I can use for loops and a buffer to pull out only numeric characters like:
Public Function PhoneNumberNumeric(PhoneNumberCSV As String) As String
Dim CharNdx As Integer
Dim buffer As String
For CharNdx = 1 To Len(PhoneNumberCSV) Step 1
If IsNumeric(Mid(PhoneNumberCSV, CharNdx, 1)) Then
buffer = buffer + Mid(PhoneNumberCSV, CharNdx, 1)
End If
Next
PhoneNumberNumeric = buffer
End Function
but this is expensive. Is there a less expensive way to do this?
This should be a bit quicker:
Private Function Clean(ByRef Original As String) As String
Dim I As Long
Dim J As Long
Dim Char As Long
Clean = Space$(10)
For I = 1 To Len(Original)
Char = AscW(Mid$(Original, I, 1))
If 48 <= Char And Char <= 57 Then
J = J + 1
If J > 10 Then Exit For 'Or raise an exception.
Mid$(Clean, J, 1) = ChrW$(Char)
End If
Next
End Function
It avoids string concatenation, ANSI conversions, and VBScript-form "pigeon VB" (use of slow Variant functions).

How do I convert VB's Double to COBOL's COMP-3?

Does anyone here know how to convert a VB Double to Cobol S9(15)V99 Comp-3 data type?
If it doesn't need to be done in the same program, it seems to me it would be easier to find a common format that both VB and COBOL can understand.
That would be text. In other words, the simplest solution may be to write the number out to a file as text "3.14159" and have the COBOL code read it in in that format and MOVE it to the COMP-3 field?
If that's not possible, the COMP-3 is a fairly simple BCD type. I would convert the number to a string anyway then take it two characters at a time into a byte array.
The S9(15)V99 requires 18 nybbles (a nybble being 4 bits, or half an octet) to store:
the integer bit (fifteen nybbles).
the fractional bit (two nybbles).
the sign (one nybble).
No space is needed for the decimal point since a V is an implied decimal, not a real one.
So the number 3.14 would be represented as the bytes:
00 00 00 00 00 00 00 31 4C
The only tricky bit is that final sign nybble (C for positive and D for negative).
Here's a bit of code I whipped up in Excel VBA (I don't have VB installed on this machine unfortunately) that shows you how to do it. The makeComp3() function should be easily transferred into a real VB program.
The macro test program outputs the values 0, 49 and 76 which are hex 00, 31 and 4C respectively (00314C is +3.14).
The first step (after all the declarations) is to make the double an implied decimal by multiplying it by the relevant power of ten then turning it into an integer:
Option Explicit
' makeComp3. '
' inp is the double to convert. '
' sz is the minimum final size (with sign). '
' frac is the number of fractional places. '
Function makeComp3(inp As Double, sz As Integer, frac As Integer) As String
Dim inpshifted As Double
Dim outstr As String
Dim outbcd As String
Dim i As Integer
Dim outval As Integer
Dim zero As Integer
zero = Asc("0")
' Make implied decimal. '
inpshifted = Abs(inp)
While frac > 0
inpshifted = inpshifted * 10
frac = frac - 1
Wend
inpshifted = Int(inpshifted)
Next, we make it into a string of the correct size, to make processing easier:
' Get as string and expand to correct size. '
outstr = CStr(inpshifted)
While Len(outstr) < sz - 1
outstr = "0" & outstr
Wend
If Len(outstr) Mod 2 = 0 Then
outstr = "0" & outstr
End If
Then we process that string two digits at a time and each pair is combined into an output nybble. The final step is to process the last digit along with the sign:
' Process each nybble pair bar the last. '
outbcd = ""
For i = 1 To Len(outstr) - 2 Step 2
outval = (Asc(Mid(outstr, i)) - zero) * 16
outval = outval + Asc(Mid(outstr, i + 1)) - zero
outbcd = outbcd & Chr(outval)
Next i
' Process final nybble including the sign. '
outval = (Asc(Right(outstr, 1)) - zero) * 16 + 12
If inp < 0 Then
outval = outval + 1
End If
makeComp3 = outbcd & Chr(outval)
End Function
And this is just the test harness, though it could probably do with a few more test cases :-)
Sub Macro1()
Dim i As Integer
Dim cobol As String
cobol = makeComp3(3.14159, 6, 2)
For i = 1 To Len(cobol)
MsgBox CStr(Asc(Mid(cobol, i)))
Next i
End Sub