I am trying to figure out a CRC check for a serial controlled device.
I have an example, when I send this example to the device, it responds correctly.
This is the complete serial string which the device responds to:
\x00\x17\x3d\x30\x32\x32\x30\x39\x39\x30\x30\x30\x30\x30\x30\x30\x30\x30\x37\x34\x30\x30\x30\x30\x30\x01\x28
(The last 2 bytes (\x01\x28) are the CRC outcomes).
This is my code:
Dim Send As String
Dim CRC1 As String
Dim CRC2 As String
Dim TEMP As String
Private Sub Command1_Click()
Send = &H0 & &H17 & "=" & "022" & "099" & "00" & "00" & "0000074" & "00000"
CRC1 = &H0
CRC2 = &H0
TEMP = &H0
For i = 1 To Len(Send)
TEMP = CRC1
CRC1 = CRC2 Xor Asc(Mid$(Send, i, 1))
CRC2 = TEMP
Next i
Text1.Text = "CRC1= " & CRC1 & " / CRC2= " & CRC2
End Sub
The output should be: CRC1 = 1 (decimal) and CRC2 = 40 (decimal)
But I am getting 51/60.
I think is has something to do with datatypes.
This is the original CRC formula from the device:
Set <CRC1> and <CRC2> to zero.
For every <CHAR> in <MSG> do
<TEMP> = <CRC1>
<CRC1> = <CRC2> XOR <CHAR>
<CRC2> = <TEMP>
Thanks in advance!
You should have looked at your string Send to make sure that it's what you wanted. It isn't. Its construction needs to be:
Send = Chr(&H0) & Chr(&H17) & ...
Then you get the answer you're looking for.
By the way, the thing you are computing is not in any way a CRC. Whoever wrote that formula had no idea what they were talking about. What they constructed is a lousy check value algorithm, so they also had no idea what they were doing.
Related
hi all i have this question as bellow
how capitalize full in one vb6 Vb6 string variable
‘example
‘my fullname
Dim fullname as string
Fullname = “abdirahman abdirisaq ali”
Msgbox capitalize(fullname)
it prints abdirahmanAbdirisaq ali that means it skips the middle name space even if I add more spaces its same .
this is my own code and efforts it takes me at least 2 hours and still .
I tired it tired tired please save me thanks more.
Please check my code and help me what is type of mistakes I wrote .
This is my code
Private Function capitalize(txt As String) As String
txt = LTrim(txt)
temp_str = ""
Start_From = 1
spacing = 0
For i = 1 To Len(txt)
If i = 1 Then
temp_str = UCase(Left(txt, i))
Else
Start_From = Start_From + 1
If Mid(txt, i, 1) = " " Then
Start_From = i
spacing = spacing + 1
temp_str = temp_str & UCase(Mid(txt, Start_From + 1, 1))
Start_From = Start_From + 1
Else
temp_str = temp_str & LCase(Mid(txt, Start_From, 1))
End If
End If
Next i
checkName = temp_str
End Function
It's far simpler than that. In VB6 you should use Option Explicit to properly type your variables. That also requires you to declare them.
Option Explicit
Private Function capitalize(txt As String) As String
Dim temp_str as String
Dim Names As Variant
Dim Index As Long
'Remove leading and trailing spaces
temp_str = Trim$(txt)
'Remove any duplicate spaces just to be sure.
Do While Instr(temp_str, " ") > 0
temp_str = Replace(temp_str, " ", " ")
Loop
'Create an array of the individual names, separating them by the space delimiter
Names = Split(temp_str, " ")
'Now put them, back together with capitalisation
temp_str = vbnullstring
For Index = 0 to Ubound(Names)
temp_str = temp_str + Ucase$(Left$(Names(Index),1)) + Mid$(Names(Index),2) + " "
Next
'Remove trailing space
capitalize = Left$(temp_str, Len(temp_str) - 1)
End Function
That's the fairly easy part. If you are only going to handle people's names it still needs more work to handle names like MacFarland, O'Connor, etc.
Business names get more complicated with since they can have a name like "Village on the Lake Apartments" where some words are not capitalized. It's a legal business name so the capitalization is important.
Professional and business suffixes can also be problematic if everything is in lower case - like phd should be PhD, llc should be LLC, and iii, as in John Smith III, would come out Iii.
There is also a VB6 function that will capitalize the first letter of each word. It is StrConv(string,vbProperCase) but it also sets everything that is not the first letter to lower case. So PhD becomes Phd and III becomes Iii. Where as the above code does not change the trailing portion to lower case so if it is entered correctly it remains correct.
Try this
Option Explicit
Private Sub Form_Load()
MsgBox capitalize("abdirahman abdirisaq ali")
MsgBox capitalize("abdirahman abdirisaq ali")
End Sub
Private Function capitalize(txt As String) As String
Dim Names() As String
Dim NewNames() As String
Dim i As Integer
Dim j As Integer
Names = Split(txt, " ")
j = 0
For i = 0 To UBound(Names)
If Names(i) <> "" Then
Mid(Names(i), 1, 1) = UCase(Left(Names(i), 1))
ReDim Preserve NewNames(j)
NewNames(j) = Names(i)
j = j + 1
End If
Next
capitalize = Join(NewNames, " ")
End Function
Use the VB6 statement
Names = StrConv(Names, vbProperCase)
it's all you need (use your own variable instead of Names)
I'm trying to compile the following code, and I keep getting an error. I got this erro before multiple times so I was forced to use workaround functions. This time I'm really tired of this issue and I need to know what's wrong here.
sub SQL_AddTestResults (byval sData as string, byval testID as integer)
dim i as integer
dim dataChain as string
dim aData (Split(sData, ";").length) as string
aData = Split(sData, ";")
for i = 0 to aData.Length
if(i = 4) then
goto skip
elseif (i = 68) then
goto skip
elseif (i = 72) then
goto skip
end if
if(i = aData.length) then
dataChain = dataChain & aData(i)
else
dataChain = dataChain & aData(i) & ", "
end if
skip:
next
MsgBox (dataChain)
SQL_statement = "INSERT INTO ""TestData"" VALUES (" & dataChain & ");"
Stmt = connection.createStatement()
Stmt.executeUpdate(SQL_statement)
end sub
Compiling this code gives me the following error on "for i = 0 to aData.Length" line:
Basic syntax error.
Symbol aData already defined differently.
Have no idea why. Apologies if that's a trivial problem, but I'm completely new to VB. C++ didn't prepare me for this.
Arrays in classic VB don't have a "length" property. I'm not sure where you got that from.
The way to get the bounds of an array in classic VB is with the LBound and UBound functions.
for i = LBound(aData) to UBound(aData)
This way you can even handle arrays that don't have 0 as the starting index, as yes, one of VB's wonderful quirks is that it lets you use any range of numbers for your indexes.
VB6 isn't a language I'd recommend for new development. If you're trying to learn something new, there are plenty of other options. As you've no doubt noticed, it's harder and harder to find documentation on how classic VB does things, and how it differs from VBScript and VB.NET. If you need to be maintaining an older VB6 code base, I'd recommend finding a used book somewhere that goes over VB6 syntax and usage.
Try this code corrected code:
sub SQL_AddTestResults (byval sData as string, byval testID as integer)
dim i as integer
dim dataChain as string
dim aData as variant
aData = Split(sData, ";")
for i = 0 to ubound(aData)
if(i = 4) then
goto skip
elseif (i = 68) then
goto skip
elseif (i = 72) then
goto skip
end if
if(i = ubound(aData)) then
dataChain = dataChain & aData(i)
else
dataChain = dataChain & aData(i) & ", "
end if
skip:
next
MsgBox (dataChain)
SQL_statement = "INSERT INTO ""TestData"" VALUES (" & dataChain & ");"
Stmt = connection.createStatement()
Stmt.executeUpdate(SQL_statement)
end sub
What I could gather, you are defining aData twice but in different ways -
dim aData (Split(sData, ";").length) as string
aData = Split(sData, ";")
aData length will return an integer of the actual length whilst you are asking it to return a string, and you are using it in your integer loop for i as counter.
Immediately after that you are telling it to return just some data causing the crash. Rather use another nominator to hold the two different kinds of returned information you need -
dim aData (Split(sData, ";").length) as Long ''Rather use long as the length might exceed the integer type. Use the same for i, change integer to long
Dim bData = Split(sData, ";") as String
for i = 0 to aData.Length
if(i = 4) then
goto skip
elseif (i = 68) then
goto skip
elseif (i = 72) then
goto skip
end if
if(i = aData.length) then
dataChain = dataChain & bData(i)
else
dataChain = dataChain & bData(i) & ", "
end if
skip:
next
I've got a user-form that generates a large amount of text and puts it into a Textbox.
I have the following function to append the next line of text to the textbox:
Sub AddLineToSQL(sLine As String)
frmSQL.txtSQL.Value = frmSQL.txtSQL.Value & sLine & vbCr
End Sub
When adding several hundred lines of text it takes a while to process (up to 20 seconds).
The problem with this is that there is the possibility of adding more than a thousand lines of text.
We have an old form that does basically the same thing, but I'm trying to create a cleaner user experience. the old form wrote the text to a worksheet, and it seems to work much quicker than appending to the textbox.
Is there a More efficient way to append text to a textbox than what I have above?
should I just do what the old form did and write lines to a worksheet?
Thanks,
Mark
Do not appending line by line to the TextBox. Instead do concatenating a String with all lines and then set that String as the TextBox value.
Sub test()
Dim sTxtSQL As String
For i = 1 To 5000
sTxtSQL = sTxtSQL & "This is row " & i & vbCrLf
Next
frmSQL.txtSQL.Value = sTxtSQL
frmSQL.Show
End Sub
should your amount of text be veeery large then you could use this class:
' Class: StringBuilder
' from http://stackoverflow.com/questions/1070863/hidden-features-of-vba
Option Explicit
Private Const initialLength As Long = 32
Private totalLength As Long ' Length of the buffer
Private curLength As Long ' Length of the string value within the buffer
Private buffer As String ' The buffer
Private Sub Class_Initialize()
' We set the buffer up to it's initial size and the string value ""
totalLength = initialLength
buffer = Space(totalLength)
curLength = 0
End Sub
Public Sub Append(Text As String)
Dim incLen As Long ' The length that the value will be increased by
Dim newLen As Long ' The length of the value after being appended
incLen = Len(Text)
newLen = curLength + incLen
' Will the new value fit in the remaining free space within the current buffer
If newLen <= totalLength Then
' Buffer has room so just insert the new value
Mid(buffer, curLength + 1, incLen) = Text
Else
' Buffer does not have enough room so
' first calculate the new buffer size by doubling until its big enough
' then build the new buffer
While totalLength < newLen
totalLength = totalLength + totalLength
Wend
buffer = Left(buffer, curLength) & Text & Space(totalLength - newLen)
End If
curLength = newLen
End Sub
Public Property Get Length() As Integer
Length = curLength
End Property
Public Property Get Text() As String
Text = Left(buffer, curLength)
End Property
Public Sub Clear()
totalLength = initialLength
buffer = Space(totalLength)
curLength = 0
End Sub
just place it in any Class Module and name it after "StringBuilder"
then you can test it similarly as per Axel answer:
Sub test()
Dim i As Long
Dim sb As StringBuilder
Dim sTxtSQL As String
Dim timeCount As Long
timeCount = Timer
Set sb = New StringBuilder
For i = 1 To 50000
sb.Append "This is row " & CStr(i) & vbCrLf
Next i
sTxtSQL = sb.Text
MsgBox Timer - timeCount
frmSQL.txtSQL.Value = sTxtSQL
frmSQL.Show
End Sub
My test showed significant time reduction for "i" loops over 50k
So I've been trying for hours to figure out how to display the length of word count in vb.
For example, if I type in a sentence in a rich textbox and I click a button, I want a form to show up listing the number of one-letter words, two-letter words, three-letter words and so on within that sentence. The number of words of specific length will be outputted in labels, of course.
I found this short code online for word count:
dim wordcount as integer
dim a as string() = RichText.Text.Split(" ")
wordcount = a.length
However, I'm not sure if this code can be used to get the length of word count. Any ideas of how I can achieve outputting the number of words of a specific length in a label? Thank you.
What about something like:
Private Sub mnuCount_Click()
Const DELIMITERS As String = vbNewLine & " !"",.:;?"
Dim WordCounts(1 To 100) As Long
Dim Msg As String
Dim I As Integer
Dim WordCount As Long
With RTB
.Visible = False
.SelStart = 0
Do
.UpTo DELIMITERS, vNegate:=True
.Span DELIMITERS, vNegate:=True
If .SelLength > 0 Then
WordCounts(.SelLength) = WordCounts(.SelLength) + 1
.SelStart = .SelStart + .SelLength
Else
Exit Do
End If
Loop
.SelStart = 0
.Visible = True
End With
Msg = "Length" & vbTab & "Count"
For I = 1 To 100
If WordCounts(I) > 0 Then
Msg = Msg & vbNewLine _
& CStr(I) & vbTab & CStr(WordCounts(I))
WordCount = WordCount + WordCounts(I)
End If
Next
Msg = Msg & vbNewLine _
& "Grand total:" & vbNewLine _
& vbTab & CStr(WordCount)
MsgBox Msg
End Sub
Pradnya's code, translated to VB6:
Option Explicit
Private Sub Command1_Click()
Dim str As String
Dim splitStr() As String
Dim i As Integer
str = "ABC DEF GHIJ KLMNOPQ"
splitStr = Split(str, " ")
MsgBox "Number of words = " & UBound(splitStr) + 1 & vbCrLf & _
"Average Length = " & Len(Replace(str, " ", "")) / (UBound(splitStr) + 1)
End Sub
I made a few simplifications as well. There's no need to go through the loop to get the average. All you have to do to get the length of the whole is remove the spaces and divide by the number of elements in the array.
However, if you want to get a count of the number of words of each length, you'll have to loop through the array, getting the length of each word and storing those values one by one. Best way to do that is to set a reference to scrrun.dll (Windows Scripting Runtime) and use a Dictionary object to store the values.
I can't figure out how to calculate the checksum after input in text1 for the data, input text1 for the divisor in binary bytes. I tried checksum.text = Text1.Text Xor Text2.Text but its not working, i searched already in internet but its only apply for C++ and java, is it possible in VB?
You cannot XOR on a string. You must do it on 2 numbers, not a string.
Try:
checksum.text = CStr(Clng(Text1.Text) Xor CLng(Text2.Text))
#George
Private Sub Command1_Click()
If Len(Text1.Text) & (Text2.Text) = 0 Or Text1.Text & Text2.Text) Like "[!0-1]" Then
Text3 = "Wrong Input, Please Correct it!!"
Else
checksum.Text = CStr(CLng(Text1.Text) Xor CLng(Text2.Text))
Trans(2).Text = (Text1.Text) + (checksum.Text)
Text3 = "Congratulation CRC is generated"
End If
End Sub