• We recently switched our forum platform. If you experience any issues please email support@crystalfontz.com

Visual Basic 6.0 and CRC Checks


New member
I'm sure other people have had troubles with this in the past. So, I'm going to explain where I've gotten with the 633 and Visual Basic.

For the last 5 days I've been scratching my head trying to figure out how the hell to reporduce a CRC check. I took the test software for the 633 and looped it back into another program to get the code and then took my program and put that data back to the LCD. This worked. However, all I did was send a packet to a port monitor and duplicate that packet. Not going to do much for usefullness. But that meant that it worked through Visual Basic. Something I'd never been able to do.

It's like this.... The binary function of the MSComm control is crap. So, I had to use Ascii for the input property. So that meant I had to convert it from ascii to binary. Easy enough with this function I made:

Public Function TextToBinary(StringT As String) As String
Dim Ascii, FinalBinary$, GetNum&
FinalBinary$ = ""

For GetNum& = 1 To Len(StringT$)
Ascii = ChrAscii(Mid(StringT$, GetNum, 1))
' 128

If Ascii >= 128 Then
FinalBinary$ = FinalBinary$ & "1"
Ascii = Ascii - 128
FinalBinary$ = FinalBinary$ & "0"
End If

' 64

If Ascii >= 64 Then
FinalBinary$ = FinalBinary$ & "1"
Ascii = Ascii - 64
FinalBinary$ = FinalBinary$ & "0"
End If

' 32

If Ascii >= 32 Then
FinalBinary$ = FinalBinary$ & "1"
Ascii = Ascii - 32
FinalBinary$ = FinalBinary$ & "0"
End If

' 16

If Ascii >= 16 Then
FinalBinary$ = FinalBinary$ & "1"
Ascii = Ascii - 16
FinalBinary$ = FinalBinary$ & "0"
End If

' 8

If Ascii >= 8 Then
FinalBinary$ = FinalBinary$ & "1"
Ascii = Ascii - 8
FinalBinary$ = FinalBinary$ & "0"
End If

' 4

If Ascii >= 4 Then
FinalBinary$ = FinalBinary$ & "1"
Ascii = Ascii - 4
FinalBinary$ = FinalBinary$ & "0"
End If

' 2

If Ascii >= 2 Then
FinalBinary$ = FinalBinary$ & "1"
Ascii = Ascii - 2
FinalBinary$ = FinalBinary$ & "0"
End If

' 1

If Ascii >= 1 Then
FinalBinary$ = FinalBinary$ & "1"
Ascii = Ascii - 1
FinalBinary$ = FinalBinary$ & "0"
End If

If Mid(StringT$, GetNum + 1, 1) = Chr(32) Then
FinalBinary$ = FinalBinary$ '& " "
FinalBinary$ = FinalBinary$ '& Chr(32)
End If
Next GetNum&
TextToBinary$ = FinalBinary$
End Function

Great. Now we have the binary of the packet that was sent to us. Now we have to change it from binary, to decimal. Easy enough with another function:

Public Function BinaryToDecimal(oString As String)

'Convert binary to decimal

Dim NewText As String
Dim i As Integer, count As Integer, BinaryString As String
Dim n As Integer, Character As String, Value As Integer
Dim CompletedString As String
'NewText is the text without spaces, this makes it
'Easier to count 8 characters then count again
'instead of counting 8 adding one etc.
'NewText = RemoveExtraSpaces(oString)

'Remove all spaces but don't show the text without them
NewText = RemoveChar(oString)

'Add a space
'txtNew.Text = txtNew.Text & vbCrLf

For i = 1 To Len(NewText)
'Get the 8 char long string
''debug.print "I: "; i & vbCrLf
BinaryString = BinaryString & Mid(NewText, i, 1)
''debug.print "BinaryString: "; BinaryString & vbCrLf
count = count + 1
If count = 8 Then
For n = 1 To Len(BinaryString)
Character = Mid(BinaryString, n, 1)
'debug.print "Character: "; Character & vbCrLf
If Val(Character) = 1 Then
If n = 1 Then
Value = Value + 128
ElseIf n = 2 Then
Value = Value + 64
ElseIf n = 3 Then
Value = Value + 32
ElseIf n = 4 Then
Value = Value + 16
ElseIf n = 5 Then
Value = Value + 8
ElseIf n = 6 Then
Value = Value + 4
ElseIf n = 7 Then
Value = Value + 2
ElseIf n = 8 Then
Value = Value + 1
End If
'debug.print "Value: "; Value & vbCrLf
End If
Next n
CompletedString = CompletedString & Value & " "
Value = 0
count = 0
BinaryString = ""
End If
Next i
'clear the counter and binary string
BinaryToDecimal = CompletedString
CompletedString = ""

End Function

Now we have our packet. We'll have to analyse this, to respond to what the display is sending us; however not right now, cause I havn't gotten to that part.

In order to SEND a packet.... we have to figure out what the packet is going to be.... I'm still working on this, however this is a start and should get you on you're way.

We have to create a CRC of the packet.

Let's say the packet should contain the following decimal numbers:

16 1 15

Which if you will notice will turn the reporting of all 4 fans on. We send this with the following command:

MSComm1.output = chr(16) & chr(1) & chr(15)

But we havn't gotten to the CRC check, so don't send it yet.

To do the CRC check we take our packet:

Packet = chr(16) & chr(1) & chr(15)

Then we create a CRC packet based on this packet, using a OCX that I found, this is relativly simple (webpage address to OCX is located at bottom of this post).

Function CalculateCRC(oString As String)

Dim crc As String

crc = VbCrC.CrcCalc(oString, CCITT)
'crc is now a decimal of the full 16 bit CRC.
'We have to convert that to two 8 bit CRC's for the display

crc = dec2bin(crc)
'Changed to binary.
crc = Format(crc, "0000000000000000")
'vbCRC will remove leading zero's, we have to add those back.
crc2 = Left(crc, 8)
'Get the left ones, this is the first crc, so it's reversed.
crc1 = Right(crc, 8)
'Grab second crc.

crc1 = BinaryToDecimal(Format(crc1, "00000000"))
'convert it from binary to decimal.
crc2 = BinaryToDecimal(Format(crc2, "00000000"))

CalculateCRC = Chr(crc1) & Chr(crc2)
'Spit it out.

End Function

Great. Now we have a function to get a CRC packet generated.

So, this will show you how to deal with those pesky CRC's.

I have not yet built a sub routine to determine if the packet sent has a accurate CRC. But that's coming soon.

I just wanted to get all this out so those who are currently working on the 633 and VB can get this part out of the way. I'm SURE many people can clean up my code and make it more efficient but this works and it's a step in the right direction for those who are stuck at this point.

Any questions are welcome!

vbCRC: http://www.iland.net/~jhaase/vbcrc/
Looking for additional LCD resources? Check out our LCD blog for the latest developments in LCD technology.


New member
I looked over the sample VB code. This code is MUCH cleaner and much better than my code. Anyone attempting to program the 633 or 631 in VB should follow CF's method, not mine. Mine had some fatal bugs, and used OCX's from other party's, the CF's approach is standalone and requires no third party code to work.



New member
Yeah, I think there is a problem with the vbCrC control when it encounters CHR(0) in a packet. CF method works much better.

Kudos to CF Tech, you guys are awesome!!


CF Tech

1) I am glad you like the code.

2) Please do not ever make me look at VB again [CF Tech winces in pain at the memory] :)


New member
CF Tech said:
1) I am glad you like the code.

2) Please do not ever make me look at VB again [CF Tech winces in pain at the memory] :)

If only you could have developed it earlier.... :p

There's nothing I can't find to bitch at. My employee's give me all the excuses and all the bitches.

You do it, they bitch, you don't do it, they bitch, you do do it, they bitch about how it sohuld have been done earlier.

There's a cartoon in the business....... it's earily familiar.... The cotor's sitting there with a disgruntled patient... The caption of the doctor reads: "If we give you a full refund, Make a new pair of glasses at no charge, fire the optician, and burn down the office, will that satisfy you Mrs. Jones?"



New member
I would like to use this to generate CRC in VB.net for the 633. CF Tech talks of minimal changes to the VB 6 code, I have changed the baud rate to 19200 and commands to 7 and 8 and tried to run that, but to no avail. Could you give us a bit more info on the minimal changes. Or even better still, if someone has succesfully converted the VB to VB.net I would love to see it.
Last edited:


New member
I've got this code from an application i'm working on that connects to the rs232 port of the computer.

    Private Sub connectToPort()
            If (MSComm1.PortOpen = True) Then
                MSComm1.PortOpen = False
            End If
            'Purpose: to communicate to the phone device on comm port1
            MSComm1.CommPort = CShort(port.SelectedIndex + 1)
            MSComm1.Settings = "9600,n,8,1"
            MSComm1.PortOpen = True
            MsgBox("Connection problem or invalid port")
        End Try
    End Sub
    Private Sub Form1_(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    End Sub
    Private Sub MSComm1_OnComm(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MSComm1.OnComm
        Text1.Text = Text1.Text.ToString + MSComm1.Input
        Text1.SelectionStart() = 9999
    End Sub
    Private Sub messanger_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles messanger.KeyDown
        If e.KeyCode = Keys.Enter Then
            MSComm1.Output = messanger.Text.ToString + Chr(13)
        End If
    End Sub
    Private Sub Form1_Closing(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing
            MSComm1.PortOpen = False
        End Try
    End Sub
    Private Sub port_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles port.SelectedIndexChanged
    End Sub


New member
hi friend .
tell me how calculate full packed crc to big command for send to comport.

example :

26 00 03 12 34 56 78 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
00 00 00 00 00 00 .... + packed crc.

tell me how add to my program for calculated automatic full packed to length in VB6


We put together a small Visual Basic program to demonstrate sending packets to the CFA-631.


The code could also be modified to work with the CFA-633 with only minimal changes.
Last edited:


New member
CRC Calculation

Is the CRC Table unique to CrystalFontz? The one in:
Sub Initialize_CRC_Lookup_Table()
  crcLookupTable(0).Lo = &H0
  crcLookupTable(0).Hi = &H0
  crcLookupTable(1).Lo = &H89
  crcLookupTable(1).Hi = &H11