form1.frm

VISUAL BASIC 循环冗余校验程序源码

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   5250
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7335
   LinkTopic       =   "Form1"
   ScaleHeight     =   5250
   ScaleWidth      =   7335
   StartUpPosition =   3  'Windows Default
   Begin MSCommLib.MSComm MSComm1 
      Left            =   1320
      Top             =   3960
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      InputMode       =   1
   End
   Begin VB.TextBox Text4 
      Height          =   495
      Left            =   4200
      TabIndex        =   8
      Top             =   2400
      Width           =   1815
   End
   Begin VB.TextBox Text3 
      Height          =   495
      Left            =   240
      TabIndex        =   4
      Top             =   720
      Width           =   2175
   End
   Begin VB.TextBox Text2 
      Height          =   495
      Left            =   4200
      TabIndex        =   3
      Top             =   720
      Width           =   1815
   End
   Begin VB.CommandButton Command2 
      Caption         =   "转换"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   2760
      TabIndex        =   2
      Top             =   720
      Width           =   1215
   End
   Begin VB.TextBox Text1 
      Height          =   495
      Left            =   240
      TabIndex        =   1
      Top             =   2400
      Width           =   2175
   End
   Begin VB.CommandButton Command1 
      Caption         =   "转换"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   2760
      TabIndex        =   0
      Top             =   2400
      Width           =   1215
   End
   Begin VB.Label Label3 
      Caption         =   "校验和码"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   4200
      TabIndex        =   9
      Top             =   2040
      Width           =   1695
   End
   Begin VB.Label Label2 
      Caption         =   "待转换的信息"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   240
      TabIndex        =   7
      Top             =   2040
      Width           =   1815
   End
   Begin VB.Label Label1 
      Caption         =   "循环冗余校验码"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   4200
      TabIndex        =   6
      Top             =   360
      Width           =   1935
   End
   Begin VB.Label 待传送的信息 
      Caption         =   "待传送的信息"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   240
      TabIndex        =   5
      Top             =   360
      Width           =   1455
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Private Function StrCrc(ByVal strsend As String) As String
    Dim iCrcr As Long '循环冗余寄存器的值
    Dim iChushu As Long  '循环冗余所用的固定除数
    Dim iLen As Integer '待发字符长度
    Dim iYUSHU As Integer '余数
    Dim strSingle As String
    Dim iAscii As Integer
    Dim iDemc, iMc As Integer
    Dim strP1, strP2 As String
    iChushu = 40961 '十六进制数为A001H，由协议决定
    iCrcr = 65535 '设定冗余寄存器初始值
    iLen = Len(strsend) / 2
    iYUSHU = 0
    
    
    Dim i As Integer
    For i = 1 To iLen
        strSingle = Right(Left(strsend, i * 2), 2)
        Dim str1 As String
        Dim str2 As String
        Dim int1 As Integer
        Dim int2 As Integer
        
        str1 = Right(strSingle, 1)
        str2 = Left(strSingle, 1)
        int1 = Asc(str1)
        int2 = Asc(str2)
        If int1 <= 57 And int2 <= 57 Then
            iDemc = (int1 - 48) + (int2 - 48) * 16
        ElseIf int1 <= 57 And int2 > 57 Then
            iDemc = (int1 - 48) + (int2 - 55) * 16
        ElseIf int1 > 57 And int2 > 57 Then
            iDemc = (int1 - 55) + (int2 - 55) * 16
        ElseIf int1 > 57 And int2 <= 57 Then
            iDemc = (int1 - 55) + (int2 - 48) * 16
        End If
        
        'iAscii = Asc(strSingle)
        strCrcr = Hex(iCrcr)
        strP1 = Right(strCrcr, 1)
        strP2 = Left(Right(strCrcr, 2), 1)
        'strP3 = Left(Right(strCrcr, 3), 1)
        'strP4 = Left(Right(strCrcr, 4), 1)
        
        int1 = Asc(strP1)
        int2 = Asc(strP2)
        If int1 <= 57 And int2 <= 57 Then
            iMc = (int1 - 48) + (int2 - 48) * 16
        ElseIf int1 <= 57 And int2 > 57 Then
            iMc = (int1 - 48) + (int2 - 55) * 16
        ElseIf int1 > 57 And int2 > 57 Then
            iMc = (int1 - 55) + (int2 - 55) * 16
        ElseIf int1 > 57 And int2 <= 57 Then
            iMc = (int1 - 55) + (int2 - 48) * 16
        End If
        
        iCrcr = (iCrcr - iMc) + iMc Xor iDemc
        'iCrcr = iCrcr Xor iDemc
        Dim J As Integer
        J = 1
        For J = 1 To 8
            iYUSHU = iCrcr Mod 2
            iCrcr = Int(iCrcr / 2)
            If iYUSHU = 1 Then
                iCrcr = iCrcr Xor iChushu
            End If
        Next J
    Next i
    StrCrc = Hex(iCrcr)
    End Function



Private Sub Command2_Click()
    Text2.Text = StrCrc(Text3.Text)
    Text3.Text = Hex(33 Xor 11)
End Sub