I did not write this vb6 code but I am responsible for converting it to vb.net. as I complete the rest of the applications conversion. I am looking for a way around using the Lset statements as they are no longer supported in vb.net
Public Structure BigEndian
Dim b1 As Byte
Dim b2 As Byte
Dim b3 As Byte
Dim b4 As Byte
Dim b5 As Byte
Dim b6 As Byte
Dim b7 As Byte
Dim b8 As Byte
End Structure
Public Structure VBInteger <--This used to be Long in vb6
Dim Value As Integer <-- same here
End Structure
Private Function SwapBytes(theBytes() As Byte, index As Integer, Count As Integer)
Dim i As Integer
Dim ix As Integer
Dim result(Count) As Byte
Dim Bytes As BigEndian
Dim tmp As VBInteger
ix = Count - 1
For i = 0 To (Count - 1)
result(ix - i) = theBytes(index + i)
Next
Select Case Count
Case 4
Bytes.b4 = result(3)
Bytes.b3 = result(2)
Bytes.b2 = result(1)
Bytes.b1 = result(0)
LSet tmp = Bytes
SwapBytes = tmp.Value
Case 8
Bytes.b8 = result(7)
Bytes.b7 = result(6)
Bytes.b6 = result(5)
Bytes.b5 = result(4)
Bytes.b4 = result(3)
Bytes.b3 = result(2)
Bytes.b2 = result(1)
Bytes.b1 = result(0)
LSet tmp = Bytes
SwapBytes = tmp.Value
End Select
End Function
This would be called from something like this:
Private Function GetQInt32() As Integer
GetQInt32 = SwapBytes(Data, iStart, 4)
iStart = iStart + 4
End Function
Related
I tried to calculate CRC using VB.Net but the value is different.
Example if I use 05 03 0B D3 00 01 data CRC code should be 76 53 but I get B6 45
This is my VB.Net code.
Private Function CRC(data As Byte()) As Byte()
Dim crcfull As UShort = &HFFFF
Dim crchigh As Byte = &HF, crclow As Byte = &HFF
Dim crclsb As Char
Dim result As Byte() = New Byte(1) {}
For i As Integer = 0 To (data.Length) - 3
crcfull = CUShort(crcfull Xor data(i))
For j As Integer = 0 To 7
crclsb = ChrW(crcfull And &H1)
crcfull = CUShort((crcfull >> 1) And &H7FFF)
If Convert.ToInt32(crclsb) Then
crcfull = CUShort(crcfull Xor &HA001)
End If
Next
Next
crchigh = CByte((crcfull >> 8) And &HFF)
crclow = CByte(crcfull And &HFF)
Return New Byte(1) {crclow, crchigh}
End Function
What is the problem?
You should turn option strict on, you would see that this line has a problem.
If Convert.ToInt32(crclsb) Then
I'm not sure what it is supposed to do, but you can't do an If statement with an integer, it has to be a Boolean.
I'm not really a VB expert, I do mostly C, C++ and C#, but I think it was one of your conversions which I don't think are needed. This works for me:
Function CRC16(data As Byte()) As Byte()
Dim crcfull As UInt16 = &HFFFF
Dim crchigh As Byte, crclow As Byte
Dim crclsb As Byte
For i As Integer = 0 To data.Length - 1
crcfull = crcfull Xor data(i)
For j As Integer = 0 To 7
crclsb = crcfull And &H1
crcfull = crcfull >> 1
If (crclsb <> 0) Then
crcfull = crcfull Xor &HA001
End If
Next
Next
crchigh = (crcfull >> 8) And &HFF
crclow = crcfull And &HFF
Return New Byte(1) {crclow, crchigh}
End Function
I need some help with creating checksum for tcp packet from an array
of byte.
This is code is working as I've tested it with
string.
Problem is I've to pass an array of byte to this
function.
At this moment I've created it simple by using hard
embedded time serial number otherwise it is very long code to login
to a device.
Value of this is b1:68:de:3a:15:cd:5b:07 checked with wireshark and CRC should be E2B6 checked with online crc this
Now, coming to main point I just can't call this method as this method is expecting some string values and I've to pass hex values. How I can do that.
Private Sub ConnectTCP_Click(sender As Object, e As EventArgs) Handles ConnectTCP.Click
Dim Serial As UInt32 = "123456789"
Dim time As UInt32 = "987654321"
Dim buffer2() As Byte = BitConverter.GetBytes(time)
Dim buffer3() As Byte = BitConverter.GetBytes(Serial)
Dim array4(buffer2.Length + buffer3.Length - 1) As Byte
Array.Copy(buffer2, array4, buffer2.Length)
Array.Copy(buffer3, 0, array4, buffer2.Length, buffer3.Length)
getCRC16(array4) 'What I need to do here
end sub
"CRC16 CCITT function""
Public Function getCRC16(ByVal strInput As String)
Dim lngCheck As Long
Dim Power(7) As Integer
Dim I As Integer
Dim J As Integer
Dim Poly As Long
Dim CRC As Long
Dim TestBit As Boolean
Dim TestBit1 As Boolean
Dim TestBit2 As Boolean
Poly = &H1021
CRC = &HFFFF
For J = 0 To 7
Power(J) = 2 ^ J
Next J
For I = 1 To Len(strInput)
lngCheck = Asc(Mid$(strInput, I, 1))
For J = 7 To 0 Step -1
If (CRC And 32768) = 32768 Then
TestBit1 = True
Else
TestBit1 = False
End If
If (lngCheck And Power(J)) = Power(J) Then
TestBit2 = True
Else
TestBit2 = False
End If
TestBit = TestBit1 Xor TestBit2
CRC = (CRC And 32767) * 2
If TestBit = True Then
CRC = CRC Xor Poly
End If
Next J
Next I
Dim tmp As String
tmp = Hex(CRC)
CRCTCP.Text = tmp
getCRC16 = tmp
End Function
Finally, Found It.
Public Class CRC16CCITT
Public Enum InitialCRCValue
Zeroes = 0
NonZero1 = &HFFFF
NonZero2 = &H1D0F
'NonZero3 = &H0
End Enum
Private Const poly As UShort = &H1021 'polynomial
Dim table(255) As UShort
Dim intValue As UShort = 0
Public Function ComputeCheckSum(ByVal bytes As Byte()) As UShort
Dim crc As UShort = Me.intValue
'Dim x As String
For i As Integer = 0 To bytes.Length - 1
crc = CUShort(((crc << 8) Xor table(((crc >> 8) Xor (&HFF And bytes(i))))))
'crc = (crc << 8) ^ (x << 15) ^ (x << 2) ^ x
Next
Return crc
End Function
Public Function ComputeCheckSumBytes(ByVal bytes As Byte()) As Byte()
Dim crc As UShort = ComputeCheckSum(bytes)
Return BitConverter.GetBytes(crc)
End Function
Public Sub New(ByVal initialvalue As InitialCRCValue)
Me.intValue = CUShort(initialvalue)
Dim temp, a As UShort
For i As Integer = 0 To table.Length - 1
temp = 0
a = CUShort(i << 8)
For j As Integer = 0 To 7
If ((temp Xor a) And &H8000) <> 0 Then
temp = CUShort((temp << 1) Xor poly)
Else
temp <<= 1
End If
a <<= 1
Next
table(i) = temp
Next
End Sub
End Class
With reference to this link
Calculate CRC32 of an String or Byte Array
I modified the code in order to calculate the CRC16 instead of CRC32, however I am getting wrong result, can some one point me where is the mistake?
Private Sub Main()
Crc16.ComputeChecksum(Encoding.UTF8.GetBytes("Some string"))
End Sub
Public Class CRC16
Shared table As UShort()
Shared Sub New()
Dim poly As UShort = &HA001US 'calculates CRC-16 using A001 polynomial (modbus)
table = New UShort(255) {}
Dim temp As UShort = 0
For i As UShort = 0 To table.Length - 1
temp = i
For j As Integer = 8 To 1 Step -1
If (temp And 1) = 1 Then
temp = CUShort((temp >> 1) Xor poly)
Else
temp >>= 1
End If
Next
table(i) = temp
Next
End Sub
Public Shared Function ComputeChecksum(ByVal bytes As Byte()) As UShort
Dim crc As UShort = &H0US ' The calculation start with 0x00
For i As Integer = 0 To bytes.Length - 1
Dim index As Byte = CByte(((crc) And &HFF) Xor bytes(i))
crc = CUShort((crc >> 8) Xor table(index))
Next
Return Not crc
End Function
End Class
Try this, it's working VB6 code for Instrument control. (sCommand is a temp string which contains all Bytes, Result is added to sCommand, Modbus is using LSB first, TextToString and StringToAscii are functions to convert a readable string "FF EE" into ASCII and back, thus they are not of interest here.):
Private Sub cmdCRC16_Click()
Dim sCommand As String
Dim x As Long
Dim y As Long
Dim lCRC As Long
sCommand = TextToString(txtASCII)
'Initial value
lCRC = 65535 '(&HFFFF results in Integer -1)
For x = 1 To Len(sCommand)
lCRC = lCRC Xor Asc(Mid(sCommand, x, 1))
For y = 1 To 8
If (lCRC Mod 2) > 0 Then
lCRC = (lCRC And 65534) / 2
lCRC = lCRC Xor 40961 '(&HA001 results in whatever negative integer)
Else
lCRC = (lCRC And 65534) / 2
End If
Next y
Next x
'Add CRC with LSB first
sCommand = sCommand + Chr(lCRC And 255)
sCommand = sCommand + Chr((lCRC And 65280) / 256)
txtASCII = StringToASCII(sCommand)
End Sub
I just came accross the same issue. Simple solution is to omit negation at the end, so just change your "Return Not crc" to "Return crc" and you be fine.
There are various variants of CRC-16, where "CRC-16" normally refers to the IBM variant, also called "ARC". It uses an XorOut value of zero. See Catalogue of parametrised CRC algorithms with 16 bits.
well i know that there are a lot of these threads but im new to vb.net yet i cant edit the sources given to make what i really want
so i want a function that will generate random strings which will contain from 15-32 characters each and each of them will have the following chars ( not all at the same string but some of them ) :
A-Z
a-z
0-9
here is my code so far
Functon RandomString()
Dim s As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
Dim r As New Random
Dim sb As New StringBuilder
For i As Integer = 1 To 8
Dim idx As Integer = r.Next(0, 35)
sb.Append(s.Substring(idx, 1))
Next
return sb.ToString()
End Function
Change the string to include the a-z characters:
Dim s As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
Change the loop to create a random number of characters:
Dim cnt As Integer = r.Next(15, 33)
For i As Integer = 1 To cnt
Note that the upper boundary in the Next method is exclusive, so Next(15, 33) gives you a value that can range from 15 to 32.
Use the length of the string to pick a character from it:
Dim idx As Integer = r.Next(0, s.Length)
As you are going to create random strings, and not a single random string, you should not create the random number generator inside the function. If you call the function twice too close in time, you would end up with the same random string, as the random generator is seeded using the system clock. So, you should send the random generator in to the function:
Function RandomString(r As Random)
So, all in all:
Function RandomString(r As Random)
Dim s As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
Dim sb As New StringBuilder
Dim cnt As Integer = r.Next(15, 33)
For i As Integer = 1 To cnt
Dim idx As Integer = r.Next(0, s.Length)
sb.Append(s.Substring(idx, 1))
Next
return sb.ToString()
End Function
Usage example:
Dim r As New Random
Dim strings As New List<string>()
For i As Integer = 1 To 10
strings.Add(RandomString(r))
Next
Try something like this:-
stringToReturn&= Guid.NewGuid.ToString().replace("-","")
You can also check this:-
Sub Main()
Dim KeyGen As RandomKeyGenerator
Dim NumKeys As Integer
Dim i_Keys As Integer
Dim RandomKey As String
''' MODIFY THIS TO GET MORE KEYS - LAITH - 27/07/2005 22:48:30 -
NumKeys = 20
KeyGen = New RandomKeyGenerator
KeyGen.KeyLetters = "abcdefghijklmnopqrstuvwxyz"
KeyGen.KeyNumbers = "0123456789"
KeyGen.KeyChars = 12
For i_Keys = 1 To NumKeys
RandomKey = KeyGen.Generate()
Console.WriteLine(RandomKey)
Next
Console.WriteLine("Press any key to exit...")
Console.Read()
End Sub
Using your function as a guide, I modified it to:
Randomize the length (between minChar & maxCharacters)
Randomize the string produced each time (by using the static Random)
Code:
Function RandomString(minCharacters As Integer, maxCharacters As Integer)
Dim s As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
Static r As New Random
Dim chactersInString As Integer = r.Next(minCharacters, maxCharacters)
Dim sb As New StringBuilder
For i As Integer = 1 To chactersInString
Dim idx As Integer = r.Next(0, s.Length)
sb.Append(s.Substring(idx, 1))
Next
Return sb.ToString()
End Function
Try this out:
Private Function RandomString(ByRef Length As String) As String
Dim str As String = Nothing
Dim rnd As New Random
For i As Integer = 0 To Length
Dim chrInt As Integer = 0
Do
chrInt = rnd.Next(30, 122)
If (chrInt >= 48 And chrInt <= 57) Or (chrInt >= 65 And chrInt <= 90) Or (chrInt >= 97 And chrInt <= 122) Then
Exit Do
End If
Loop
str &= Chr(chrInt)
Next
Return str
End Function
You need to change the line For i As Integer = 1 To 8 to For i As Integer = 1 To ? where ? is the number of characters long the string should be. This changes the number of times it repeats the code below so more characters are appended to the string.
Dim idx As Integer = r.Next(0, 35)
sb.Append(s.Substring(idx, 1))
My $.02
Dim prng As New Random
Const minCH As Integer = 15 'minimum chars in random string
Const maxCH As Integer = 35 'maximum chars in random string
'valid chars in random string
Const randCH As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
Private Function RandomString() As String
Dim sb As New System.Text.StringBuilder
For i As Integer = 1 To prng.Next(minCH, maxCH + 1)
sb.Append(randCH.Substring(prng.Next(0, randCH.Length), 1))
Next
Return sb.ToString()
End Function
please note that the
r.Next(0, 35)
tend to hang and show the same result Not sure whay; better to use
CInt(Math.Ceiling(Rnd() * N)) + 1
see it here Random integer in VB.NET
I beefed up Nathan Koop's function for my own needs, and thought I'd share.
I added:
Ability to add Prepended and Appended text to the random string
Ability to choose the casing of the allowed characters (letters)
Ability to choose to include/exclude numbers to the allowed characters
NOTE: If strictly looking for an exact length string while also adding pre/appended strings you'll need to deal with that; I left out any logic to handle that.
Example Usages:
' Straight call for a random string of 20 characters
' All Caps + Numbers
String_Random(20, 20, String.Empty, String.Empty, 1, True)
' Call for a 30 char string with prepended string
' Lowercase, no numbers
String_Random(30, 30, "Hey_Now_", String.Empty, 2, False)
' Call for a 15 char string with appended string
' Case insensitive + Numbers
String_Random(15, 15, String.Empty, "_howdy", 3, True)
.
Public Function String_Random(
intMinLength As Integer,
intMaxLength As Integer,
strPrepend As String,
strAppend As String,
intCase As Integer,
bIncludeDigits As Boolean) As String
' Allowed characters variable
Dim s As String = String.Empty
' Set the variable to user's choice of allowed characters
Select Case intCase
Case 1
' Uppercase
s = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Case 2
' Lowercase
s = "abcdefghijklmnopqrstuvwxyz"
Case Else
' Case Insensitive + Numbers
s = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
End Select
' Add numbers to the allowed characters if user chose so
If bIncludeDigits = True Then s &= "0123456789"
Static r As New Random
Dim chactersInString As Integer = r.Next(intMinLength, intMaxLength)
Dim sb As New StringBuilder
' Add the prepend string if one was passed
If String.IsNullOrEmpty(strPrepend) = False Then sb.Append(strPrepend)
For i As Integer = 1 To chactersInString
Dim idx As Integer = r.Next(0, s.Length)
sb.Append(s.Substring(idx, 1))
Next
' Add the append string if one was passed
If String.IsNullOrEmpty(strAppend) = False Then sb.Append(strAppend)
Return sb.ToString()
End Function
I'm trying to convert some Java code to Excel and the required hashcode function generates an overflow error, instead of wrapping to the negative
Function FnGetStringHashCode(ByVal str As String) As Integer
Dim result, i
FnGetStringHashCode = 17
For i = 1 To Len(str)
Dim c, a
c = Mid(str, i, 1)
a = AscW(c)
FnGetStringHashCode = 31 * FnGetStringHashCode + a
Next i
End Function
Is there a way of doing this in Excel VBA?
Although there is no built-in way to do this, the computation is simple:
Public Function coerceLongToInt(toCoerce As Long) As Integer
Const MIN_INT As Long = -32768
Const MAX_INT As Long = 32767
Const NUM_INTS As Long = MAX_INT - MIN_INT + 1
Dim remainder As Long
remainder = toCoerce Mod NUM_INTS
If remainder > MAX_INT Then
coerceLongToInt = remainder - NUM_INTS
ElseIf remainder < MIN_INT Then
coerceLongToInt = remainder + NUM_INTS
Else
coerceLongToInt = remainder
End If
End Function
This is the behavior you want, right?
?coerceLongToInt(-32769)
32767
?coerceLongToInt(-32768)
-32768
?coerceLongToInt(-1)
-1
?coerceLongToInt(0)
0
?coerceLongToInt(1)
1
?coerceLongToInt(32767)
32767
?coerceLongToInt(32768)
-32768
You would use it like this:
Function FnGetStringHashCode(ByVal str As String) As Integer
Dim result, i
FnGetStringHashCode = 17
For i = 1 To Len(str)
Dim c, a
c = Mid(str, i, 1)
a = AscW(c)
FnGetStringHashCode = coerceLongToInt(31 * CLng(FnGetStringHashCode) + a)
Next i
End Function
You need the 'CLng' call in there to prevent VBA from raising an overflow error when it computes the intermediate value (31 * [some integer >= 1058]).
I have modified a little the script of ours. The main difference is returning type of your function. Now it returns Variant. As decimal is a subset of Variant, and it can store bigger numbers than long I think it is a good solution (see VBA data types) - I do not know is it possible to explicitly return Decimal. Here is the script
Function FnGetStringHashCode(ByVal str As String) As Variant
Dim tmp As Variant, c As String, a As Integer, i As Integer
tmp = 17
For i = 1 To Len(str)
c = Mid$(str, i, 1)
a = AscW(c)
tmp = 31 * tmp + a
Next i
FnGetStringHashCode = tmp
End Function
And a little test routine
Sub test()
Debug.Print CStr(FnGetStringHashCode("dawdaedae"))
End Sub