form100.frm

P1618QP bootloader code

Private Sub StatusBar1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 2 Then
        If PanelClicked = 1 Then
            PopupMenu M_Program, vbPopupMenuRightButton
        End If
    
        If PanelClicked = 3 Then
            M_PDevSelector_Click
        End If
    
        If PanelClicked = 4 Then
            PopupMenu M_PortSettings, vbPopupMenuRightButton
        End If
    
        If PanelClicked = 5 Then
            PopupMenu M_BitRateSettings, vbPopupMenuRightButton
        End If
    End If
End Sub

Private Sub StatusBar1_PanelClick(ByVal Panel As Panel)
    PanelClicked = Panel.Index
End Sub

















'******************************************************************************
'Main Form related functions
'******************************************************************************
Private Sub Form_Load()

    On Error GoTo ErrorHandler

    'Set the size
    Me.Height = Toolbar1.Height + StatusBar1.Height + 400
    Me.Width = 5000
                
    SetDisplayMode MODE_NOT_CONNECTED
    
    PicBootS.ProgMemFile = GetSetting("PIC18FBOOT", "progmem")
    PicBootS.EEDataFile = GetSetting("PIC18FBOOT", "eedata")
    PicBootS.UserIDFile = GetSetting("PIC18FBOOT", "userid")
    PicBootS.ConfigFile = GetSetting("PIC18FBOOT", "config")
    PicBootS.ErrorLogFile = GetSetting("PIC18FBOOT", "errorlog")
    PicBootS.CommTimeOut = Val(GetSetting("PIC18FBOOT", "CommTimeOut"))
    PicBootS.DebugLevel = Val(GetSetting("PIC18FBOOT", "debuglevel"))
    PicBootS.DeviceMode = Val(GetSetting("PIC18FBOOT", "devicemode"))
    PicBootS.MaxRetry = Val(GetSetting("PIC18FBOOT", "maxretry"))
    PicBootS.EditorFile = GetSetting("PIC18FBOOT", "editor")
    
    If CInt(GetSetting("PIC18FBOOT", "selectdevwin")) Then
        D_SelectDevice.Cm_DevList.ListIndex = 0
        D_SelectDevice.Show vbModal, Fm_Bootload
    End If
        
    PicBootS.ProgMemAddrH = &H200
    PicBootS.ProgMemAddrL = &H200
    PicBootS.EEDataAddrH = 0
    PicBootS.EEDataAddrL = 0
    PicBootS.ConfigAddrH = &H300000
    PicBootS.ConfigAddrL = &H300000
    PicBootS.UserIDAddrH = &H200000
    PicBootS.UserIDAddrL = &H200000
    
       
    MyIndex = GetSetting("PIC18FBOOT", "portindex")
    M_FPPort_Click (CInt(MyIndex))
    MyIndex = GetSetting("PIC18FBOOT", "bitrateindex")
    M_FPBaud_Click (CInt(MyIndex))
    
    StatusBar1.Panels(PANEL_STATUS).Text = STATUS_NOT_CON
    
    Exit Sub
    
ErrorHandler:
    
    StatusBar1.Panels(PANEL_STATUS).Text = "Core error:  " & Err.Description
    Err.Clear
End Sub


Private Sub Form_Unload(Cancel As Integer)
    'Close port if open
    If PicBootS.PortHandle > 0 Then
        ClosePIC (PicBootS.PortHandle)
        PicBootS.PortHandle = 0
    End If

    'Kill Fuse configurator
    Unload D_WriteFuses
End Sub


Private Sub Form_Resize()

    On Error GoTo ErrorHandler

    Me.Height = Toolbar1.Height + StatusBar1.Height + 400
    If Me.Width < 5000 Then
        Me.Width = 5000
    End If
    
    Exit Sub
ErrorHandler:
    Err.Clear

End Sub
'******************************************************************************










Private Sub ConnectToPIC()
    Dim TempReturn As String
    Dim RetStat As Integer
    Dim picb As PIC
    Dim DevID(10) As Byte
        
    On Error GoTo ErrorHandler
    
    If PicBootS.PortHandle <= 0 Then
        PicBootS.PortHandle = OpenPIC(PicBootS.CommPort, PicBootS.BitRate, PicBootS.CommTimeOut)
    End If
    If PicBootS.PortHandle < 0 Then
        StatusBar1.Panels(PANEL_STATUS) = STATUS_FAILED_TO_OPEN_PORT
        Toolbar1.Buttons(9).Value = tbrUnpressed
        Exit Sub
    End If
    
    'Get firmware version
    StatusBar1.Panels(PANEL_FWVER) = ReadVersion
    If StatusBar1.Panels(PANEL_FWVER) = Empty Then
        StatusBar1.Panels(PANEL_STATUS) = STATUS_NO_VERSION_INFO
    End If
    
    'Read associated device name
    If PicBootS.DeviceMode = 0 Then 'manual or automatic
        PicBootS.DeviceCode = ReadDeviceID
        PicBootS.DeviceName = GetSetting("DEVICELIST", PicBootS.DeviceCode)
    End If
    
    'Read in the memory ranges
    PicBootS.ProgMemAddrL = Val("&H" & GetSetting(PicBootS.DeviceName, "pmrangelow"))
    PicBootS.ProgMemAddrH = Val("&H" & GetSetting(PicBootS.DeviceName, "pmrangehigh"))
    PicBootS.EEDataAddrL = Val("&H" & GetSetting(PicBootS.DeviceName, "eerangelow"))
    PicBootS.EEDataAddrH = Val("&H" & GetSetting(PicBootS.DeviceName, "eerangehigh"))
    PicBootS.UserIDAddrL = Val("&H" & GetSetting(PicBootS.DeviceName, "usrrangelow"))
    PicBootS.UserIDAddrH = Val("&H" & GetSetting(PicBootS.DeviceName, "usrrangehigh"))
    PicBootS.ConfigAddrL = Val("&H" & GetSetting(PicBootS.DeviceName, "cfgrangelow"))
    PicBootS.ConfigAddrH = Val("&H" & GetSetting(PicBootS.DeviceName, "cfgrangehigh"))
    
    PicBootS.DevBytesPerAddr = Val(GetSetting(PicBootS.DeviceName, "bytesperaddr"))
    PicBootS.MaxPacketSize = Val(GetSetting(PicBootS.DeviceName, "maxpacketsize"))
    PicBootS.DeviceErsBlock = Val(GetSetting(PicBootS.DeviceName, "eraseblock"))
    PicBootS.DeviceRdBlock = Val(GetSetting(PicBootS.DeviceName, "readblock"))
    PicBootS.DeviceWrtBlock = Val(GetSetting(PicBootS.DeviceName, "writeblock"))
    PicBootS.DeviceType = Val(GetSetting(PicBootS.DeviceName, "devicetype"))
 
    'Read in the config bytes
    D_WriteFuses.C_ConfigBytes.Clear
    For i = PicBootS.ConfigAddrL To PicBootS.ConfigAddrH
        TempReturn = GetSetting(PicBootS.DeviceName, Dec2Hex(CLng(i), 6))
        If StrComp(TempReturn, "") <> 0 Then
            D_WriteFuses.C_ConfigBytes.AddItem TempReturn
            D_WriteFuses.C_ConfigBytes.ItemData(MyCount) = i
            MyCount = MyCount + 1
        End If
    Next i
    StatusBar1.Panels(PANEL_DEVICE) = PicBootS.DeviceName
    StatusBar1.Panels(PANEL_STATUS) = STATUS_FOUND_DEVICE
    
    SetDisplayMode MODE_CONNECTED_IDLE
    
    Exit Sub

'Handle some errors
ErrorHandler:
     
    StatusBar1.Panels(PANEL_STATUS).Text = "Core error:  " & Err.Description
    Err.Clear
End Sub







Private Sub M_About_Click()
    frmAbout.Show vbModal, Fm_Bootload
End Sub





'******************************************************************************
'Data file related functions
'******************************************************************************
Private Sub EraseDataFiles()
    
    Open VB.App.Path & "\" & PicBootS.ProgMemFile For Output As #1
    Close #1
    
    Open VB.App.Path & "\" & PicBootS.EEDataFile For Output As #1
    Close #1
    
    Open VB.App.Path & "\" & PicBootS.UserIDFile For Output As #1
    Close #1
    
    Open VB.App.Path & "\" & PicBootS.ConfigFile For Output As #1
    Close #1
End Sub


Private Sub ViewDataFiles()
    'MsgBox VB.App.Path
    
    If M_MemAccess(1).Checked = True Then
        test = Shell(PicBootS.EditorFile & " " & VB.App.Path & "\" & PicBootS.ProgMemFile, vbNormalFocus)
    End If
    
    If M_MemAccess(2).Checked = True Then
        test = Shell(PicBootS.EditorFile & " " & VB.App.Path & "\" & PicBootS.EEDataFile, vbNormalFocus)
    End If
    
    If M_MemAccess(3).Checked = True Then
        test = Shell(PicBootS.EditorFile & " " & VB.App.Path & "\" & PicBootS.ConfigFile, vbNormalFocus)
    End If
    
    If M_MemAccess(4).Checked = True Then
        test = Shell(PicBootS.EditorFile & " " & VB.App.Path & "\" & PicBootS.UserIDFile, vbNormalFocus)
    End If
    
End Sub
'******************************************************************************







'******************************************************************************
'Port related setting functions
'******************************************************************************
Private Sub M_FPBaud_Click(Index As Integer)
    
    DisconnectDev
    
    M_FPBaud(1).Checked = Not CBool(Index Xor 1)
    M_FPBaud(2).Checked = Not CBool(Index Xor 2)
    M_FPBaud(3).Checked = Not CBool(Index Xor 3)
    M_FPBaud(4).Checked = Not CBool(Index Xor 4)
    M_FPBaud(5).Checked = Not CBool(Index Xor 5)
    
    PicBootS.BitRate = CLng(M_FPBaud(Index).Caption)
    
    StatusBar1.Panels(PANEL_BITRATE) = M_FPBaud(Index).Caption
    
    SetDisplayMode MODE_NOT_CONNECTED
            
End Sub


Private Sub M_FPPort_Click(Index As Integer)
        
    DisconnectDev
            
    M_FPPort(1).Checked = Not CBool(Index Xor 1)
    M_FPPort(2).Checked = Not CBool(Index Xor 2)
    M_FPPort(3).Checked = Not CBool(Index Xor 3)
    M_FPPort(4).Checked = Not CBool(Index Xor 4)
     
    PicBootS.CommPort = M_FPPort(Index).Caption
     
    StatusBar1.Panels(PANEL_PORT) = M_FPPort(Index).Caption
     
    SetDisplayMode MODE_NOT_CONNECTED
        
End Sub
'******************************************************************************




Private Sub M_MemAccess_Click(Index As Integer)
    If M_MemAccess(Index).Checked = True Then
        M_MemAccess(Index).Checked = False
    Else
        M_MemAccess(Index).Checked = True
    End If
End Sub









'******************************************************************************
'Toolbar related functions
'******************************************************************************
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Dim sFile As String


    Select Case Button.Key
        Case "Open"
                
            With CommonDialog1
                .DialogTitle = "Open HEX File"
                .CancelError = False
                'ToDo: set the flags and attributes of the common dialog control
                .Flags = cdlOFNHideReadOnly
                .Filter = "INHEX32 Files (*.HEX)|*.HEX|All Files (*.*)|*.*"
                .ShowOpen
                If Len(.FileName) = 0 Then
                    Exit Sub
                End If
            '    if .Action
                
                PicBootS.InFileName = .FileName
                .FileName = ""
            End With
            
            
        '    ConvertHEX PicBootS.InFileName, "TESTA.HEX"
            
            If PicBootS.DeviceType = 1 Then
                RetStat = ImportP18HEXFile(PicBootS.InFileName)
            Else
                RetStat = ImportP16HEXFile(PicBootS.InFileName)
            End If
            
            
            If RetStat = -2 Then
                StatusBar1.Panels(PANEL_STATUS).Text = STATUS_HEX_FORMAT
            Else
                If RetStat > 0 Then
                    StatusBar1.Panels(PANEL_STATUS).Text = STATUS_HEX_IMPORTED
                Else
                    StatusBar1.Panels(PANEL_STATUS).Text = STATUS_INVALID_HEX
                End If
            End If