fileaccess.bas

PIC24FJ32GA002单片机bootloader rs485通信移植

Attribute VB_Name = "FileAccess"
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Public Const LOWER_BYTE_MASK = 255
Public Const LOWER_WORD_MASK = 65535
Public Const FULL_ADDRESS_MASK = 33554431
Public Const UPPER_BYTE_MASK = 16711680
Public Const ROW_START_MASK = 16776960
Public Const HEX_LINE_MASK = 16777200
Public Const UPPER_BYTE_MASK2 = 33488896

Public Type HEXDATA
    address As Long
    datLen As Integer
    data As String
End Type


Public Function GetSetting(INISection As String, INIKey As String) As String
    Dim MyString As String
    
    MyString = "                                                      "
    RetStat = GetPrivateProfileString(INISection, INIKey, "", MyString, 20, VB.App.Path & "\" & VB.App.EXEName & ".INI") '   "\P1618QP.INI")
    GetSetting = Mid(MyString, 1, InStr(1, MyString, Chr(0), vbBinaryCompare) - 1)
End Function



Public Function SetSetting(MySetting As String, INISection As String, INIKey As String) As Long
    SetSetting = WritePrivateProfileString(INISection, INIKey, MySetting, VB.App.Path & "\" & VB.App.EXEName & ".INI") ' "\P1618QP.INI")
End Function



Public Function ExportP24HEXFile(OutHEXFile As String) As Integer
    Dim Checksum As Long
    Dim address As Long
    Dim OldAddress As Long
    Dim FileLine As String
    Dim OutFileLine As String

    
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set OutFile = fs.CreateTextFile(OutHEXFile, True)
    Set PMIn = fs.OpenTextFile(VB.App.Path & "\" & PicBootS.ProgMemFile, 1, False, 0)
    Set EEIn = fs.OpenTextFile(VB.App.Path & "\" & PicBootS.EEDataFile, 1, False, 0)
    Set CFGIn = fs.OpenTextFile(VB.App.Path & "\" & PicBootS.ConfigFile, 1, False, 0)

    address = &HFFFFFF
    Do While PMIn.AtEndOfStream <> True
        FileLine = PMIn.ReadLine
        OldAddress = address
        
        address = Val("&H" & Mid(FileLine, 1, 6)) And FULL_ADDRESS_MASK
        
        If (address And UPPER_BYTE_MASK) <> (OldAddress And UPPER_BYTE_MASK) Then
            OutFileLine = ":0200000400" & UCase(Dec2Hex((address And UPPER_BYTE_MASK) \ 65536, 2))
            Checksum = 0
            For i = 0 To 5
                Checksum = Checksum + Val("&H" & Mid(OutFileLine, (i * 2) + 2, 2) & "&")
            Next i
            OutFileLine = OutFileLine & Dec2Hex((256 - (Checksum And 255)) And 255, 2)
            OutFile.WriteLine (OutFileLine)
        End If
        
        OutFileLine = ":10" & UCase(Dec2Hex(address And LOWER_WORD_MASK, 4) & "00")
        For i = 0 To 15
            OutFileLine = OutFileLine & UCase(Mid(FileLine, (i * 3) + 8, 2))
        Next i
        
        Checksum = 0
        For i = 0 To 19
            Checksum = Checksum + Val("&H" & Mid(OutFileLine, (i * 2) + 2, 2))
        Next i
        
        OutFileLine = OutFileLine & UCase(Dec2Hex((256 - (Checksum And 255)) And 255, 2))
        OutFile.WriteLine (OutFileLine)
    Loop
          
    Do While EEIn.AtEndOfStream <> True
        FileLine = EEIn.ReadLine
        OldAddress = address
        
        address = (Val("&H" & Mid(FileLine, 1, 6)) And FULL_ADDRESS_MASK)
        
        If (address And UPPER_BYTE_MASK) <> (OldAddress And UPPER_BYTE_MASK) Then
            OutFileLine = ":0200000400" & Dec2Hex((address And UPPER_BYTE_MASK) \ 65536, 2)
            Checksum = 0
            For i = 0 To 5
                Checksum = Checksum + Val("&H" & Mid(OutFileLine, (i * 2) + 2, 2))
            Next i
            OutFileLine = OutFileLine & Dec2Hex((256 - (Checksum And 255)) And 255, 2)
            OutFile.WriteLine (OutFileLine)
        End If
        
        OutFileLine = ":10" & Dec2Hex(address And LOWER_WORD_MASK, 4) & "00"
        For i = 0 To 15
            OutFileLine = OutFileLine & Mid(FileLine, (i * 3) + 8, 2)
        Next i
        
        Checksum = 0
        For i = 0 To 19
            Checksum = Checksum + Val("&H" & Mid(OutFileLine, (i * 2) + 2, 2) & "&")
        Next i
        
        OutFileLine = OutFileLine & Dec2Hex((256 - (Checksum And 255)) And 255, 2)
        OutFile.WriteLine (OutFileLine)
    Loop

    Do While CFGIn.AtEndOfStream <> True
        FileLine = CFGIn.ReadLine
        OldAddress = address
        
        address = Val("&H" & Mid(FileLine, 1, 7)) And FULL_ADDRESS_MASK
        
        If (address And UPPER_BYTE_MASK2) <> (OldAddress And UPPER_BYTE_MASK2) Then
            OutFileLine = ":02000004" & Dec2Hex((address And UPPER_BYTE_MASK2) \ 65536, 4)
            Checksum = 0
            For i = 0 To 5
                Checksum = Checksum + Val("&H" & Mid(OutFileLine, (i * 2) + 2, 2) & "&")
            Next i
            OutFileLine = OutFileLine & Dec2Hex((256 - (Checksum And 255)) And 255, 2)
            OutFile.WriteLine (OutFileLine)
        End If
        
        '***MODIFIED FOR AES - CONFIG LINES HAVE FULL 16-BYTE PADDING WHEN ENCRYPTED
        If PicBootS.AESEnable Then
            OutFileLine = ":10" & Dec2Hex(address And LOWER_WORD_MASK, 4) & "00"
        Else
            OutFileLine = ":04" & Dec2Hex(address And LOWER_WORD_MASK, 4) & "00"
        End If
            
        For i = 0 To 15
            OutFileLine = OutFileLine & Mid(FileLine, (i * 3) + 9, 2)
        Next i
        
        Checksum = 0
        For i = 0 To 19
            Checksum = Checksum + Val("&H" & Mid(OutFileLine, (i * 2) + 2, 2) & "&")
        Next i
        
        OutFileLine = OutFileLine & Dec2Hex((256 - (Checksum And 255)) And 255, 2)
        OutFile.WriteLine (OutFileLine)
    Loop
    

    OutFile.WriteLine (":00000001FF")


    OutFile.Close
    PMIn.Close
    EEIn.Close
    CFGIn.Close
End Function





Function ValidateHEXFile(InHEXFile As String) As Integer
    Dim Checksum As Integer
    Dim InFileLine As String
    Dim DataCount As Integer
    Dim AddrCode As Integer
    Dim address As Long
    Dim DataByte As Integer
        
    On Error GoTo ErrorHandler
    
        
    Set fs = CreateObject("Scripting.FileSystemObject")
    ChDir VB.App.Path
    Set InFile = fs.OpenTextFile(InHEXFile, 1, False, 0)
    
    'Check for an empty file
    If InFile.AtEndOfStream = True Then
        ValidateHEXFile = -1
        InFile.Close
        Exit Function
    End If
    
    'Validate the file before using it
    Do While InFile.AtEndOfStream <> True
        InFileLine = InFile.ReadLine
        
        AddrCode = 0
        If Mid(InFileLine, 1, 1) = "" Then
            DataByte = Asc(" ")
        Else
            DataByte = Asc(Mid(InFileLine, 1, 1))
        End If
        
        'check the line
        Select Case DataByte
            Case Asc(":")
                AddrCode = Val("&H" & Mid(InFileLine, 8, 2))
                DataCount = Val("&H" & Mid(InFileLine, 2, 2))
                address = Val("&H" & Mid(InFileLine, 4, 4)) And LOWER_WORD_MASK

            
                Checksum = 0
                For i = 0 To DataCount + 4
                    Checksum = Checksum + Val("&H" & Mid(InFileLine, (2 * i) + 2, 2))
                Next i
            
                If (Checksum And 255) <> 0 Then
                    ValidateHEXFile = -3
                    InFile.Close
                    Exit Function
                End If
            Case Asc(" "), Asc(vbTab), Asc(vbCr), Asc(vbLf)
            Case Else
                ValidateHEXFile = -4
                InFile.Close
                Exit Function
        End Select
        
        If AddrCode = 1 Then
            Exit Do
        End If
        
        If InFile.AtEndOfStream = True Then
            ValidateHEXFile = -5
            InFile.Close
            Exit Function
        End If
    Loop
    
    If ValidateHEXFile <> -2 Then
        ValidateHEXFile = 1
    End If
    
    InFile.Close
    Exit Function
    
ErrorHandler:
    Err.Clear
    ValidateHEXFile = -6
    InFile.Close
End Function



Function ConvertHEX(InHEXFile As String, OutHEXFile As String) As Integer
    Dim BufferData(256) As Byte
    Dim BufferCount As Integer
    Dim Checksum As Integer
    Dim InFileLine As String
    Dim OutFileLine As String
    Dim DataString As String
    Dim DataCount As Integer
    Dim DataCode As Integer
    Dim address As Integer
    Dim HighAddress As Long
    Dim DataStr As String
    Dim NewAddr As Long

    'Open file objects
    Set fs = CreateObject("Scripting.FileSystemObject")
    ChDir VB.App.Path
    Set InFile = fs.OpenTextFile(InHEXFile, 1, False, 0)
    Set OutFile = fs.CreateTextFile(OutHEXFile, True)


    Do While InFile.AtEndOfStream <> True
        InFileLine = InFile.ReadLine
        
        If Mid(InFileLine, 1, 1) = ":" Then
            DataCount = Val("&H" & Mid(InFileLine, 2, 2))
            DataCode = Val("&H" & Mid(InFileLine, 8, 2))
            address = Val("&H" & Mid(InFileLine, 4, 4)) And LOWER_WORD_MASK
            DataStr = Mid(InFileLine, 10, DataCount * 2)
            
            
            Select Case DataCode
                Case 0
                    For i = 0 To DataCount - 1
                        BufferData(i) = Val("&H" & Mid(DataStr, (i * 2) + 1, 2))
                    Next i
                    
                
                Case 1
                    Exit Do
                Case 4
                    HighAddress = Val("&H" & DataStr)
            
            End Select
        End If