utility.bas

VB代码

Attribute VB_Name = "utility"
Option Explicit

Const c_CharNumberPerLine = 16

Public Function SendDataBuffCheckSum(ByVal ucDataLength As Byte) As Byte
    
    Dim ucCount As Byte
    Dim uCheckSum As Integer
    
    uCheckSum = 0
    
    For ucCount = 0 To ucDataLength - 1 Step 1
        uCheckSum = (uCheckSum + ucComSendDataBuff(ucCount)) Mod &H100
    Next ucCount
    
    SendDataBuffCheckSum = CByte(uCheckSum)

End Function


Public Function ReceiveDataBuffCheckSum(ByVal ucDataLength As Byte) As Byte
    
    Dim ucCount As Byte
    Dim uCheckSum As Integer
    
    uCheckSum = 0
    
    For ucCount = 0 To ucDataLength - 1 Step 1
        uCheckSum = (uCheckSum + ucReceiveDataBuff(ucCount)) Mod &H100
    Next ucCount
    
    ReceiveDataBuffCheckSum = CByte(uCheckSum)
End Function
Public Function ConvertComReceiveToDispString() As String
    Dim sDestinationString As String
    Dim ucCount As Byte
    
    sDestinationString = ""
    For ucCount = 0 To ucReceiveDataLength - 1 Step 1
        sDestinationString = sDestinationString & CStr_Hex(ucReceiveDataBuff(ucCount)) & " "
    Next ucCount
    
    ConvertComReceiveToDispString = sDestinationString
End Function


Function ShiftDataRight(ByVal ucSrcData As Byte) As Byte
        
        ShiftDataRight = ucSrcData \ &H2

End Function

Function CStr_Hex(ucSrcValue As Byte) As String
    Dim ucHighHex As Byte
    Dim ucLowHex As Byte


    ucHighHex = ucSrcValue \ 16
    ucLowHex = ucSrcValue Mod 16
        
    If ucHighHex < 10 Then
        ucHighHex = ucHighHex + &H30
    Else
        ucHighHex = ucHighHex + &H30 + 7
    End If
    
    If ucLowHex < 10 Then
        ucLowHex = ucLowHex + &H30      '转换成ascii码准备显示
    Else
        ucLowHex = ucLowHex + &H30 + 7
    End If

    CStr_Hex = Chr$(ucHighHex) + Chr$(ucLowHex)
End Function
Function CIntToHexStr(iSrcValue As Integer) As String
    Dim ucHighByte As Byte
    Dim ucLowByte As Byte

    ucHighByte = iSrcValue \ &H100
    ucLowByte = iSrcValue Mod &H100
        
    CIntToHexStr = CStr_Hex(ucHighByte) & CStr_Hex(ucLowByte)

End Function
Function CLongToHexStr(lSrcValue As Long) As String
    Dim ucOneByte As Byte
    Dim ucTwoByte As Byte
    Dim ucThreeByte As Byte
    Dim ucFourByte As Byte
    Dim lTempValue As Long
    
    lTempValue = lSrcValue
     
    ucOneByte = CByte(lTempValue \ &H1000000)
    lTempValue = lTempValue Mod &H1000000
    ucTwoByte = CByte(lTempValue \ &H10000)
    lTempValue = lTempValue Mod &H10000
    ucThreeByte = CByte(lTempValue \ &H100)
    lTempValue = lTempValue Mod &H100
    ucFourByte = CByte(lTempValue)
       
    CLongToHexStr = CStr_Hex(ucOneByte) & CStr_Hex(ucTwoByte) & CStr_Hex(ucThreeByte) & CStr_Hex(ucFourByte)

End Function


'Function ConvertDataBuffContentToFormatString() As String
'    Dim iAddrCount As Integer
'    Dim ucCount As Byte
'    Dim lLineCount As Integer
'    Dim lDataLineNumber As Integer
'    Dim sDestinationString As String
'
'    iAddrCount = 0
'    sDestinationString = ""
'
'    lDataLineNumber = lMaxCodeLength / c_CharNumberPerLine
'
'    For lLineCount = 0 To lDataLineNumber - 1 Step 1
'        sDestinationString = sDestinationString & CIntToHexStr(iAddrCount) & " "
'        For ucCount = 0 To c_CharNumberPerLine - 1 Step 1
'            sDestinationString = sDestinationString & CStr_Hex(ucDataBuff(lLineCount * c_CharNumberPerLine + ucCount)) & " "
'        Next ucCount
        
'        sDestinationString = sDestinationString & Chr(13) & Chr(10)
        
'        iAddrCount = iAddrCount + c_CharNumberPerLine
        
'    Next lLineCount
    
'    ConvertDataBuffContentToFormatString = sDestinationString
'End Function

'备注：
'由于受TextBox 控件最大32K的容量限制以及VB转换速度较慢的原因
'只对数据缓冲区的前8K数据+尾部1K进行转换与显示。

Function ConvertDataBuffContentToFormatString() As String
    Dim lAddressCount As Long
    Dim ucCount As Byte
    Dim lLineCount As Long
    Dim lDataLineNumber As Long
    Dim sDestinationString As String
    Dim sOneLineTempString As String
    Dim sOneLineAsciiString As String
    
    Dim iBaseNumber As Integer
    Dim ucCompleteRatio As Byte
    
    Dim lReserveCount As Long
    Dim lTailStartAddr As Long
    
    Dim ucProgramCode As Byte
    
    lAddressCount = 0
    sDestinationString = ""
    
    If (lMaxCodeLength = 0) Then
        ConvertDataBuffContentToFormatString = sDestinationString
        Exit Function
    End If
   ' If (lMaxCodeLength > &H2000) Then
   '     lDataLineNumber = &H2000 \ c_CharNumberPerLine
        
   '     lReserveCount = lMaxCodeLength - &H2000                     '附加数据长度
   '     If (lReserveCount >= &H400) Then
   '         lTailStartAddr = lMaxCodeLength - &H400                    '尾部数据显示起始单元
   '     Else
   '         lTailStartAddr = &H2000
   '     End If
        
   '    lDataLineNumber = lDataLineNumber + &H800 \ c_CharNumberPerLine
   '
   ' Else
        lDataLineNumber = lMaxCodeLength \ c_CharNumberPerLine
   ' End If
    
    
    FrmMain.Lbl_ProgressPrompt.Caption = "完成进度"
    FrmMain.Lbl_ProgressPrompt.Visible = True
    FrmMain.Lbl_ProgressPrompt.Refresh
    
    FrmMain.WritePGMCodeProgressBar.Min = 0
    FrmMain.WritePGMCodeProgressBar.Max = lDataLineNumber
    FrmMain.WritePGMCodeProgressBar.Value = 0
    FrmMain.WritePGMCodeProgressBar.Visible = True
    
    iBaseNumber = lDataLineNumber / 100 + 1
    ucCompleteRatio = 0
    FrmMain.lbl_DispCompleteRatio.Caption = CStr(ucCompleteRatio) & "%"
    FrmMain.lbl_DispCompleteRatio.Visible = True
    FrmMain.lbl_DispCompleteRatio.Refresh
    
    lLineCount = 0
    
    'If (lMaxCodeLength > &H2000) Then
    '    Do While (lAddressCount < &H2000)
    '        sOneLineTempString = CLongToHexStr(lAddressCount) & " "
    '        sOneLineAsciiString = "    "
    '        For ucCount = 0 To c_CharNumberPerLine - 1 Step 1
    '            ucProgramCode = ucDataBuff(lAddressCount)
    '            If ((ucProgramCode > &H20) And (ucProgramCode < &H7F)) Then
    '                sOneLineAsciiString = sOneLineAsciiString & Chr(ucProgramCode)
    '            Else
    '                sOneLineAsciiString = sOneLineAsciiString & "."
    '            End If
    '
    '            sOneLineTempString = sOneLineTempString & CStr_Hex(ucDataBuff(lAddressCount)) & " "
    '            lAddressCount = lAddressCount + 1
    '
    '        Next ucCount
    '        sOneLineTempString = sOneLineTempString & sOneLineAsciiString & vbCrLf
    '        sDestinationString = sDestinationString & sOneLineTempString
    '        lLineCount = lLineCount + 1
            
            'FrmMain.TxtDataBuffDispBox.Text = FrmMain.TxtDataBuffDispBox & sOneLineTempString
    '        FrmMain.WritePGMCodeProgressBar.Value = lLineCount
        
    '        ucCompleteRatio = lLineCount \ iBaseNumber
    '        FrmMain.lbl_DispCompleteRatio.Caption = CStr(ucCompleteRatio) & "%"
    '        FrmMain.lbl_DispCompleteRatio.Refresh
                
    'Loop
        
    '    sOneLineTempString = "........ -- -- -- -- -- --" & vbCrLf
    '    sOneLineTempString = sOneLineTempString & "........ -- -- -- -- -- --" & vbCrLf
    '    sOneLineTempString = sOneLineTempString & "........ -- -- -- -- -- --" & vbCrLf

    '    sDestinationString = sDestinationString & sOneLineTempString
        
     '   lAddressCount = lTailStartAddr
      '  Do While (lAddressCount < lMaxCodeLength)
        
       '     sOneLineTempString = CLongToHexStr(lAddressCount) & " "
        '    sOneLineAsciiString = "    "

         '   For ucCount = 0 To c_CharNumberPerLine - 1 Step 1
          '      ucProgramCode = ucDataBuff(lAddressCount)
          '      If ((ucProgramCode > &H20) And (ucProgramCode < &H7F)) Then
          '          sOneLineAsciiString = sOneLineAsciiString & Chr(ucProgramCode)
          '      Else
          '          sOneLineAsciiString = sOneLineAsciiString & "."
          '      End If
                            
           '     sOneLineTempString = sOneLineTempString & CStr_Hex(ucDataBuff(lAddressCount)) & " "
           '     lAddressCount = lAddressCount + 1
                
           ' Next ucCount
           ' sOneLineTempString = sOneLineTempString & sOneLineAsciiString & vbCrLf
           ' sDestinationString = sDestinationString & sOneLineTempString
            'lLineCount = lLineCount + 1
            
          '  FrmMain.TxtDataBuffDispBox.Text = FrmMain.TxtDataBuffDispBox & sOneLineTempString
            'FrmMain.WritePGMCodeProgressBar.Value = lLineCount
        
            'ucCompleteRatio = lLineCount \ iBaseNumber
            'FrmMain.lbl_DispCompleteRatio.Caption = CStr(ucCompleteRatio) & "%"
                        
        'Loop
    'Else
    
        lAddressCount = 0
        Do While (lAddressCount < lMaxCodeLength)
            sOneLineTempString = CLongToHexStr(lAddressCount) & " "
            sOneLineAsciiString = "    "
            
            For ucCount = 0 To c_CharNumberPerLine - 1 Step 1
                ucProgramCode = ucDataBuff(lAddressCount)
                If ((ucProgramCode > &H20) And (ucProgramCode < &H7F)) Then
                    sOneLineAsciiString = sOneLineAsciiString & Chr(ucProgramCode)
                Else
                    sOneLineAsciiString = sOneLineAsciiString & "."
                End If
                
                sOneLineTempString = sOneLineTempString & CStr_Hex(ucDataBuff(lAddressCount)) & " "
                lAddressCount = lAddressCount + 1
                
            Next ucCount
            sOneLineTempString = sOneLineTempString & sOneLineAsciiString & vbCrLf
            sDestinationString = sDestinationString & sOneLineTempString
            lLineCount = lLineCount + 1
            
        '    FrmMain.TxtDataBuffDispBox.Text = FrmMain.TxtDataBuffDispBox & sOneLineTempString
            FrmMain.WritePGMCodeProgressBar.Value = lLineCount
        
            ucCompleteRatio = lLineCount \ iBaseNumber
            FrmMain.lbl_DispCompleteRatio.Caption = CStr(ucCompleteRatio) & "%"
            FrmMain.lbl_DispCompleteRatio.Refresh
                
        Loop
    
    'End If
    
    ucCompleteRatio = 100
    FrmMain.lbl_DispCompleteRatio.Caption = CStr(ucCompleteRatio) & "%"

    
    FrmMain.Lbl_ProgressPrompt.Visible = False
    FrmMain.lbl_DispCompleteRatio.Visible = False
    FrmMain.WritePGMCodeProgressBar.Visible = False
        
 
    ConvertDataBuffContentToFormatString = sDestinationString
End Function
'Function ChangeStringToNumber(ByVal sSrcString As String) As Byte
'    Dim ucReturnValue As Byte
'    Dim sHighString As String
'    Dim sLowString As String
    
'    sHighString = UCase(Mid(sSrcString, 1, 1))
'    sLowString = UCase(Mid(sSrcString, 2, 1))
   
    
'End Function

Function IntelHexFile_RecordLine_CheckSum(ByVal sOnePackageProgramCode As String) As String
    Dim sTempString As String
    Dim ucTempValue As Byte
  '  Dim ucCheckSumValue As Byte
    Dim ucCount As Byte
    Dim ucRecordCount As Byte
    Dim ucReturnValue As Byte
    Dim lCheckSumValue As Long
    
    'ucCheckSumValue = 0
    lCheckSumValue = 0
    
    sTempString = Mid(sOnePackageProgramCode, 2, 2)
 '   ucRecordCount = Val(sTempString)   'bug xg 07-04-07
    ucRecordCount = Val("&H" & sTempString)
    
    'ucCheckSumValue = ucCheckSumValue + ucRecordCount
    lCheckSumValue = lCheckSumValue + ucRecordCount
    
    For ucCount = 0 To ucRecordCount + 2 Step 1
        
        sTempString = Mid(sOnePackageProgramCode, 4 + ucCount * 2, 2)
    '    ucCheckSumValue = ucCheckSumValue + Val("&H" & sTempString)
        lCheckSumValue = lCheckSumValue + Val("&H" & sTempString)
    
    Next ucCount
    
    lCheckSumValue = lCheckSumValue - (CInt(lCheckSumValue \ 256)) * 256
    
    If (lCheckSumValue = 0) Then
        ucReturnValue = 0
    Else
        ucReturnValue = 256 - CByte(lCheckSumValue)
    End If
    
    IntelHexFile_RecordLine_CheckSum = CStr_Hex(ucReturnValue)

End Function