form1.frm

BV写的CRC16生成器

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   6120
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   8880
   LinkTopic       =   "Form1"
   ScaleHeight     =   6120
   ScaleWidth      =   8880
   StartUpPosition =   3  '窗口缺省
   Begin VB.Frame Frame2 
      Caption         =   "多项式计算"
      Height          =   3015
      Left            =   120
      TabIndex        =   1
      Top             =   3000
      Width           =   8655
      Begin MSComctlLib.ProgressBar ProgressBar1 
         Height          =   255
         Left            =   240
         TabIndex        =   15
         Top             =   2640
         Width           =   7455
         _ExtentX        =   13150
         _ExtentY        =   450
         _Version        =   393216
         Appearance      =   1
      End
      Begin VB.TextBox Text7 
         Height          =   975
         Left            =   6480
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   14
         Top             =   600
         Width           =   1575
      End
      Begin VB.CommandButton Command2 
         Caption         =   "生成"
         Height          =   495
         Left            =   6480
         TabIndex        =   13
         Top             =   1800
         Width           =   1215
      End
      Begin VB.TextBox Text6 
         Height          =   375
         Left            =   3600
         TabIndex        =   12
         Top             =   600
         Width           =   1215
      End
      Begin VB.TextBox Text5 
         Height          =   375
         Left            =   1800
         TabIndex        =   11
         Top             =   600
         Width           =   1215
      End
      Begin VB.TextBox Text4 
         Height          =   1335
         Left            =   240
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   10
         Top             =   1200
         Width           =   5895
      End
      Begin VB.Label Label12 
         Caption         =   "0%"
         Height          =   255
         Left            =   7800
         TabIndex        =   23
         Top             =   2640
         Width           =   615
      End
      Begin VB.Label Label10 
         Caption         =   "多项式"
         Height          =   255
         Left            =   6480
         TabIndex        =   21
         Top             =   240
         Width           =   855
      End
      Begin VB.Label Label9 
         Caption         =   "低位"
         Height          =   255
         Left            =   3600
         TabIndex        =   20
         Top             =   240
         Width           =   855
      End
      Begin VB.Label Label8 
         Caption         =   "CRC校验码：高位"
         Height          =   255
         Left            =   1560
         TabIndex        =   19
         Top             =   240
         Width           =   1575
      End
      Begin VB.Label Label7 
         Caption         =   "数据输入"
         Height          =   255
         Left            =   240
         TabIndex        =   18
         Top             =   840
         Width           =   855
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "CRC校验计算"
      Height          =   2775
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   8655
      Begin VB.CommandButton Command1 
         Caption         =   "生成"
         Height          =   375
         Left            =   5640
         TabIndex        =   5
         Top             =   2040
         Width           =   1095
      End
      Begin VB.TextBox Text3 
         Height          =   375
         Left            =   7200
         TabIndex        =   4
         Top             =   600
         Width           =   1215
      End
      Begin VB.TextBox Text2 
         Height          =   375
         Left            =   5640
         TabIndex        =   3
         Top             =   600
         Width           =   1095
      End
      Begin VB.TextBox Text1 
         Height          =   1815
         Left            =   240
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   2
         Top             =   600
         Width           =   5175
      End
      Begin VB.Label Label11 
         Caption         =   "CRC校验码："
         Height          =   375
         Left            =   5760
         TabIndex        =   22
         Top             =   1680
         Width           =   1095
      End
      Begin VB.Label Label6 
         Caption         =   "低位"
         Height          =   255
         Left            =   7200
         TabIndex        =   17
         Top             =   240
         Width           =   735
      End
      Begin VB.Label Label5 
         Caption         =   "多项式：高位"
         Height          =   255
         Left            =   5520
         TabIndex        =   16
         Top             =   240
         Width           =   1455
      End
      Begin VB.Label Label4 
         Caption         =   "低位"
         Height          =   255
         Left            =   7560
         TabIndex        =   9
         Top             =   1320
         Width           =   615
      End
      Begin VB.Label Label3 
         Caption         =   "高位"
         Height          =   255
         Left            =   6840
         TabIndex        =   8
         Top             =   1320
         Width           =   495
      End
      Begin VB.Label Label2 
         Caption         =   "数据输入"
         Height          =   375
         Left            =   480
         TabIndex        =   7
         Top             =   240
         Width           =   975
      End
      Begin VB.Label Label1 
         Height          =   375
         Left            =   7080
         TabIndex        =   6
         Top             =   1680
         Width           =   1215
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Function CRC16_1(data() As String, datalen As Byte)
Dim CRC16Lo As Byte, CRC16Hi As Byte      'CRC寄存器
Dim CL As Byte, CH As Byte                '多项式码&HA001
Dim SaveHi As Byte, SaveLo As Byte
Dim i As Integer
Dim Flag As Integer
Dim iCL As String, iCH As String
Dim oCL As Byte, oCH As Byte
      iCL = Text3.Text
      iCH = Text2.Text
      Call zhuanhuan_1(iCL, oCL)
      Call zhuanhuan_1(iCH, oCH)
  
      CRC16Lo = &HFF
      CRC16Hi = &HFF
     
      For i = 0 To datalen
        CRC16Lo = CRC16Lo Xor data(i) '每一个数据与CRC寄存器进行异或
        For Flag = 0 To 7
          SaveHi = CRC16Hi
          SaveLo = CRC16Lo
          CRC16Hi = CRC16Hi \ 2            '高位右移一位
          CRC16Lo = CRC16Lo \ 2            '低位右移一位
          If ((SaveHi And &H1) = &H1) Then '如果高位字节最后一位为1
            CRC16Lo = CRC16Lo Or &H80      '则低位字节右移后前面补1
          End If                           '否则自动补0
          If ((SaveLo And &H1) = &H1) Then '如果LSB为1，则与多项式码进行异或
            CRC16Hi = CRC16Hi Xor oCH
            CRC16Lo = CRC16Lo Xor oCL
          End If
        Next Flag
      Next i
      Dim ReturnData(1) As Byte
      ReturnData(0) = CRC16Hi              'CRC高位
      ReturnData(1) = CRC16Lo              'CRC低位
      CRC16_1 = (Hex(CRC16Hi) & " " & Hex(CRC16Lo))
 
End Function

Sub zhuanhuan_1(X As String, Y As Variant)

    
    Y = CLng("&H" & X)

    If Y < 0 Then Y = Y + 65536    ' returns 65534
    
  

End Sub
Private Sub Command1_Click()
Dim data() As String
Dim idata() As String
Dim a As String
Dim b As Variant
Dim odata() As String
Dim d() As String
Dim oh As String, ol As String
If Text1.Text = "" Then
c = MsgBox("请输入数据")
Else
idata() = Split(Text1.Text, " ")
For i = 0 To UBound(idata())
a = idata(i)

Call zhuanhuan_1(a, Y)
ReDim Preserve odata(UBound(idata()))

odata(i) = Y
Next i
b = CRC16_1(odata(), UBound(idata()))

End If
d() = Split(b, " ")
Call zhuanhuan_1(d(0), oh)
Call zhuanhuan_1(d(1), ol)




If oh < 15 Then
If ol < 15 Then
crc_16 = "0" & Hex(oh) & "  " & "0" & Hex(ol)
End If
End If
If oh < 15 Then
If ol > 15 Then
crc_16 = "0" & Hex(oh) & "  " & Hex(ol)
End If
End If
If oh > 15 Then
If ol > 15 Then
crc_16 = Hex(oh) & "  " & Hex(ol)
End If
End If
If oh > 15 Then
If ol < 15 Then

crc_16 = Hex(oh) & "  " & "0" & Hex(ol)
End If
End If



Label1.Caption = crc_16
End Sub






Private Function CRC16_2(data() As String, datalen As Byte) As String

Dim CRC16Lo As Byte, CRC16Hi As Byte      'CRC寄存器
Dim iCRCH As String, iCRCL As String                '多项式码&HA001
Dim SaveHi As Byte, SaveLo As Byte
Dim i As Integer
Dim Flag As Integer
Dim oCRCH As String, oCRCL As String
      ProgressBar1.Value = 0
      ProgressBar1.Max = 256
      ProgressBar1.Min = 0
      For m = 0 To 255
      CL = m
      ProgressBar1.Value = m + 1
      Label12.Caption = Format((m / 255), "#%")
      DoEvents '交出控制权,不然用sleep()会卡死看不到的
      Sleep (2) '延时2ms
      For n = 0 To 255
      CH = n
      CRC16Lo = &HFF
      CRC16Hi = &HFF
      
      
      
      For i = 0 To datalen
        CRC16Lo = CRC16Lo Xor data(i) '每一个数据与CRC寄存器进行异或
        For Flag = 0 To 7
          SaveHi = CRC16Hi
          SaveLo = CRC16Lo
          CRC16Hi = CRC16Hi \ 2            '高位右移一位
          CRC16Lo = CRC16Lo \ 2            '低位右移一位
          If ((SaveHi And &H1) = &H1) Then '如果高位字节最后一位为1
            CRC16Lo = CRC16Lo Or &H80      '则低位字节右移后前面补1
          End If                           '否则自动补0
          If ((SaveLo And &H1) = &H1) Then '如果LSB为1，则与多项式码进行异或
            CRC16Hi = CRC16Hi Xor CH
            CRC16Lo = CRC16Lo Xor CL
          End If
        Next Flag
      Next i
      Dim ReturnData(1) As Byte
      ReturnData(0) = CRC16Hi              'CRC高位
      ReturnData(1) = CRC16Lo              'CRC低位
      CRC16_2 = (Hex(CRC16Hi) & Hex(CRC16Lo))
iCRCH = Text5.Text
iCRCL = Text6.Text
Call zhuanhuan_2(iCRCH, oCRCH)
Call zhuanhuan_2(iCRCL, oCRCL)
If CRC16Hi = oCRCH Then
If CRC16Lo = oCRCL Then
If CH < 15 Then
If CL < 15 Then
Text7.Text = Text7.Text & "," & "0" & Hex(CH) & " " & "0" & Hex(CL)
End If
End If
End If
End If
If CRC16Hi = oCRCH Then
If CRC16Lo = oCRCL Then
If CH < 15 Then
If CL > 15 Then
Text7.Text = Text7.Text & "," & "0" & Hex(CH) & " " & Hex(CL)
End If
End If
End If
End If
If CRC16Hi = oCRCH Then
If CRC16Lo = oCRCL Then
If CH > 15 Then
If CL > 15 Then
Text7.Text = Text7.Text & "," & Hex(CH) & " " & Hex(CL)
End If
End If
End If
End If

If CRC16Hi = oCRCH Then
If CRC16Lo = oCRCL Then
If CH > 15 Then
If CL < 15 Then


Text7.Text = Hex(CH) & " " & "0" & Hex(CL) & "," & Text7.Text



End If
End If
End If
End If
Next n
Next m

End Function

Sub zhuanhuan_2(X As String, Y As String)

    
    Y = CLng("&H" & X)

    If Y < 0 Then Y = Y + 65536    ' returns 65534
    
  

End Sub
Private Sub Command2_Click()
Dim idata() As String
Dim data() As String
Dim a As String
Dim z As String
Dim b As Variant
Dim odata() As String
Text7.Text = ""
idata() = Split(Text4.Text, " ")

ReDim Preserve data(i)
For i = 0 To UBound(idata())

a = idata(i)

Call zhuanhuan_2(a, z)
ReDim Preserve odata(i)
odata(i) = z


Next i

b = CRC16_2(odata(), UBound(idata()))

End Sub