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
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
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.
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.
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).
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