diff --git a/Host/Source/MicroBoot/interfaces/can/lawicel/CANIcon.png b/Host/Source/MicroBoot/interfaces/can/lawicel/CANIcon.png new file mode 100644 index 00000000..ed2db00d Binary files /dev/null and b/Host/Source/MicroBoot/interfaces/can/lawicel/CANIcon.png differ diff --git a/Host/Source/MicroBoot/interfaces/can/lawicel/CanUsb.pas b/Host/Source/MicroBoot/interfaces/can/lawicel/CanUsb.pas new file mode 100644 index 00000000..b2ec4394 --- /dev/null +++ b/Host/Source/MicroBoot/interfaces/can/lawicel/CanUsb.pas @@ -0,0 +1,496 @@ +unit CanUsb; +//*************************************************************************************** +// Description: Lawicel CANUSB API interface wrapper. +// File Name: CanUsb.pas +// +//--------------------------------------------------------------------------------------- +// C O P Y R I G H T +//--------------------------------------------------------------------------------------- +// Copyright (c) 2016 by Feaser http://www.feaser.com All rights reserved +// +// This software has been carefully tested, but is not guaranteed for any particular +// purpose. The author does not offer any warranties and does not guarantee the accuracy, +// adequacy, or completeness of the software and is not responsible for any errors or +// omissions or the results obtained from use of the software. +// +//--------------------------------------------------------------------------------------- +// L I C E N S E +//--------------------------------------------------------------------------------------- +// This file is part of OpenBLT. OpenBLT is free software: you can redistribute it and/or +// modify it under the terms of the GNU General Public License as published by the Free +// Software Foundation, either version 3 of the License, or (at your option) any later +// version. +// +// OpenBLT is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; +// without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR +// PURPOSE. See the GNU General Public License for more details. +// +// You have received a copy of the GNU General Public License along with OpenBLT. It +// should be located in ".\Doc\license.html". If not, contact Feaser to obtain a copy. +// +//*************************************************************************************** +interface + + +//*************************************************************************************** +// Includes +//*************************************************************************************** +uses + Windows, Messages, SysUtils, Classes; + + +//*************************************************************************************** +// Global constant declarations +//*************************************************************************************** +const + // filter mask settings + CANUSB_ACCEPTANCE_CODE_ALL = $00000000; + CANUSB_ACCEPTANCE_MASK_ALL = $FFFFFFFF; + + // message flags + CANMSG_EXTENDED = $80; + CANMSG_RTR = $40; + + // status bits + CANSTATUS_RECEIVE_FIFO_FULL = $01; + CANSTATUS_TRANSMIT_FIFO_FULL = $02; + CANSTATUS_ERROR_WARNING = $04; + CANSTATUS_DATA_OVERRUN = $08; + CANSTATUS_ERROR_PASSIVE = $20; + CANSTATUS_ARBITRATION_LOST = $40; + CANSTATUS_BUS_ERROR = $80; + + +//*************************************************************************************** +// Type Definitions +//*************************************************************************************** +type + // CAN handle to the actual hardware adapter + CANHANDLE = Longint; + + // CAN baudrate identifiers + CANBaudrate = ( CAN_BAUD_1M = 0, // 1 MBit/sec + CAN_BAUD_800K = 1, // 800 kBit/sec + CAN_BAUD_500K = 2, // 500 kBit/sec + CAN_BAUD_250K = 3, // 250 kBit/sec + CAN_BAUD_125K = 4, // 125 kBit/sec + CAN_BAUD_100K = 5, // 100 kBit/sec + CAN_BAUD_50K = 6, // 50 kBit/sec + CAN_BAUD_20K = 7, // 20 kBit/sec + CAN_BAUD_10K = 8 // 10 kBit/sec + ); + + // CAN Frame + CANMsg = record + id : Longword; // message id + timestamp : Longword; // timestamp in + flags : Byte; // [extended_id|1][RTR:1][reserver:6] + len : Byte; // frame size (0.8) + data : array[0..7] of Byte; // databytes 0..7 + end; + + // DLL interface methods + TDllCanUsbOpen = function(szID: PAnsiChar; szBitrate: PAnsiChar; acceptance_code: Longword; acceptance_mask: Longword; flags: Longword): CANHANDLE; stdcall; + TDllCanUsbClose = function(h: CANHANDLE): Integer; stdcall; + TDllCanUsbRead = function(h: CANHANDLE; var msg: CANMsg): Integer; stdcall; + TDllCanUsbWrite = function(h: CANHANDLE; var msg: CANMsg): Integer; stdcall; + TDllCanUsbStatus = function(h: CANHANDLE): Integer; stdcall; + + // CANUSB API interface wrapper class + TCanUsb = class(TObject) + private + { Private declarations } + FDllCanUsbOpen: TDllCanUsbOpen; + FDllCanUsbClose: TDllCanUsbClose; + FDllCanUsbRead: TDllCanUsbRead; + FDllCanUsbWrite: TDllCanUsbWrite; + FDllCanUsbStatus: TDllCanUsbStatus; + FHCanUsbAdapter: CANHANDLE; + FHCanUsbLib: THandle; + protected + { Protected declarations } + public + { Public declarations } + constructor Create; + destructor Destroy; override; + function LoadDll: Boolean; + procedure UnloadDll; + function IsDllLoaded: Boolean; + function Connect(baudRate: CANBaudrate; acceptanceCode: Longword; acceptanceMask: Longword): Boolean; + function Disconnect: Boolean; + function Transmit(msg: CANMsg): Boolean; + function Receive(var msg: CANMsg): Boolean; + function Status: Integer; + procedure FindOptimumSingleRxFilter(id: Longword; ext: Boolean; var code: Longword; var mask: Longword); + end; + + +implementation +//*************************************************************************************** +// Local constant declarations +//*************************************************************************************** +const + CANBaudrateVals: array[0..8] of AnsiString = + ( '1000', // CAN_BAUD_1M + '800', // CAN_BAUD_800K + '500', // CAN_BAUD_500K + '250', // CAN_BAUD_250K + '125', // CAN_BAUD_125K + '100', // CAN_BAUD_100K + '50', // CAN_BAUD_50K + '20' , // CAN_BAUD_20K + '10' // CAN_BAUD_10K + ) ; + + // error return codes + ERROR_CANUSB_OK = 1; + ERROR_CANUSB_GENERAL = -(1); + ERROR_CANUSB_OPEN_SUBSYSTEM = -(2); + ERROR_CANUSB_COMMAND_SUBSYSTEM = -(3); + ERROR_CANUSB_NOT_OPEN = -(4); + ERROR_CANUSB_TX_FIFO_FULL = -(5); + ERROR_CANUSB_INVALID_PARAM = -(6); + ERROR_CANUSB_NO_MESSAGE = -(7); + ERROR_CANUSB_MEMORY_ERROR = -(8); + ERROR_CANUSB_NO_DEVICE = -(9); + ERROR_CANUSB_TIMEOUT = -(10); + ERROR_CANUSB_INVALID_HARDWARE = -(11); + + +//*************************************************************************************** +// NAME: Create +// PARAMETER: none +// RETURN VALUE: none +// DESCRIPTION: Object constructor. Calls TObject's constructor and initializes the +// private member variables to their default values. +// +//*************************************************************************************** +constructor TCanUsb.Create; +begin + // call inherited constructor + inherited Create; + + // initialize private members + FHCanUsbLib := 0; + FHCanUsbAdapter := 0; + FDllCanUsbOpen := nil; + FDllCanUsbClose := nil; + FDllCanUsbRead := nil; + FDllCanUsbWrite := nil; + FDllCanUsbStatus := nil; +end; //*** end of Create *** + + +//*************************************************************************************** +// NAME: Destroy +// PARAMETER: none +// RETURN VALUE: none +// DESCRIPTION: Object destructor. Calls TObject's destructor +// +//*************************************************************************************** +destructor TCanUsb.Destroy; +begin + // clean up by unloading the dll + UnloadDll; + + // call inherited destructor + inherited Destroy; +end; //*** end of Destroy *** + + +//*************************************************************************************** +// NAME: LoadDll +// PARAMETER: none +// RETURN VALUE: True if the DLL was successfully loaded, False otherwise. +// DESCRIPTION: Loads the CANUSB API dll. +// +//*************************************************************************************** +function TCanUsb.LoadDll: Boolean; +begin + // init result + Result := True; + + // nothing to do if the dll is already loaded + if IsDllLoaded then + begin + Exit; + end; + + // attempt to load the CANUSB API dll + FHCanUsbLib := LoadLibrary(PChar('CANUSBDRV.DLL')); + // check result + if FHCanUsbLib = 0 then + begin + Result := False; + Exit; + end; + + // still here so library loaded. attempt to obtain the function pointers + @FDllCanUsbOpen := GetProcAddress(FHCanUsbLib, 'canusb_Open'); + @FDllCanUsbClose := GetProcAddress(FHCanUsbLib, 'canusb_Close'); + @FDllCanUsbRead := GetProcAddress(FHCanUsbLib, 'canusb_Read'); + @FDllCanUsbWrite := GetProcAddress(FHCanUsbLib, 'canusb_Write'); + @FDllCanUsbStatus := GetProcAddress(FHCanUsbLib, 'canusb_Status'); + + // check if the functions were found in the interface library + if not Assigned(FDllCanUsbOpen) then Result := False; + if not Assigned(FDllCanUsbClose) then Result := False; + if not Assigned(FDllCanUsbRead) then Result := False; + if not Assigned(FDllCanUsbWrite) then Result := False; + if not Assigned(FDllCanUsbStatus) then Result := False; + + // check if functions were all successfully loaded + if not Result then + begin + FreeLibrary(FHCanUsbLib); + FHCanUsbLib := 0; + end; +end; //*** end of LoadDll *** + + +//*************************************************************************************** +// NAME: UnloadDll +// PARAMETER: none +// RETURN VALUE: none +// DESCRIPTION: Unloads the CANUSB API dll. +// +//*************************************************************************************** +procedure TCanUsb.UnloadDll; +begin + // only continue if the dll is actually loaded at this point + if not IsDllLoaded then + begin + Exit; + end; + + // make sure that the connection with the CANUSB adapter is closed + Disconnect; + + // unload the DLL + FreeLibrary(FHCanUsbLib); + FHCanUsbLib := 0; +end; //*** end of UnloadDll *** + + +//*************************************************************************************** +// NAME: IsDllLoaded +// PARAMETER: none +// RETURN VALUE: True if the DLL is loaded, False otherwise. +// DESCRIPTION: Determines if the CANUSB API dll is currently loaded. +// +//*************************************************************************************** +function TCanUsb.IsDllLoaded: Boolean; +begin + Result := (FHCanUsbLib <> 0); +end; //*** end of IsDllLoaded *** + + +//*************************************************************************************** +// NAME: Connect +// PARAMETER: baudRate Baudrate id. +// acceptanceCode Code part of the acceptance filter. Set to +// CANUSB_ACCEPTANCE_CODE_ALL to get all messages. +// acceptanceMask Mask part of the acceptance filter. Set to +// CANUSB_ACCEPTANCE_MASk_ALL to get all messages. +// RETURN VALUE: True if successful, False otherwise. +// DESCRIPTION: Opens the connection with the first CANUSB hardware adapter found. +// +//*************************************************************************************** +function TCanUsb.Connect(baudRate: CANBaudrate; acceptanceCode: Longword; acceptanceMask: Longword): Boolean; +begin + // initialize the result + Result := True; + + // do not continue if the DLL is not loaded + if not IsDllLoaded then + begin + Result := False; + Exit; + end; + + // make sure the connection is closed before opening + Disconnect; + + // open the connection + FHCanUsbAdapter := FDllCanUsbOpen(nil, PAnsiChar(CANBaudrateVals[Ord(baudRate)]), acceptanceCode, acceptanceMask, 0); + + // check the result + if FHCanUsbAdapter <= 0 then + begin + Result := False; + FHCanUsbAdapter := 0; + end; +end; //*** end of Connect *** + + +//*************************************************************************************** +// NAME: Disconnect +// PARAMETER: none +// RETURN VALUE: True if successful, False otherwise. +// DESCRIPTION: Closes the connection with the CANUSB hardware adapter +// +//*************************************************************************************** +function TCanUsb.Disconnect: Boolean; +begin + // initialize the result + Result := True; + + // only continue if the DLL is loaded + if IsDllLoaded then + begin + // check if the connection with the CANUSB adapter is open + if FHCanUsbAdapter <> 0 then + begin + // close the connection and set the result + Result := (FDllCanUsbClose(FHCanUsbAdapter) > 0); + FHCanUsbAdapter := 0; + end; + end; +end; //*** end of Disconnect *** + + +//*************************************************************************************** +// NAME: Transmit +// PARAMETER: msg CAN message to transmit. +// RETURN VALUE: True if successful, False otherwise. +// DESCRIPTION: Submits a CAN message for transmission. +// +//*************************************************************************************** +function TCanUsb.Transmit(msg: CANMsg): Boolean; +begin + // only continue if the DLL is loaded + if not IsDllLoaded then + begin + Result := False; + Exit; + end; + + // check if the connection with the CANUSB adapter is open + if FHCanUsbAdapter = 0 then + begin + Result := False; + Exit; + end; + + // submit message for transmission and set the result + Result := (FDllCanUsbWrite(FHCanUsbAdapter, msg) = ERROR_CANUSB_OK); +end; //*** end of Transmit *** + + +//*************************************************************************************** +// NAME: Receive +// PARAMETER: msg CAN message to store received message. +// RETURN VALUE: True if successful, False otherwise. +// DESCRIPTION: Receives the oldest message from the receive fifo, if one is present. +// +//*************************************************************************************** +function TCanUsb.Receive(var msg: CANMsg): Boolean; +begin + // only continue if the DLL is loaded + if not IsDllLoaded then + begin + Result := False; + Exit; + end; + + // check if the connection with the CANUSB adapter is open + if FHCanUsbAdapter = 0 then + begin + Result := False; + Exit; + end; + + // extract oldest message from the receive fifo, if one is present + Result := (FDllCanUsbRead(FHCanUsbAdapter, msg) = ERROR_CANUSB_OK); +end; //*** end of Receive *** + + +//*************************************************************************************** +// NAME: Status +// PARAMETER: none +// RETURN VALUE: Status bits (CANSTATUS_xxx). +// DESCRIPTION: Obtains status of the CANUSB adapter. +// +//*************************************************************************************** +function TCanUsb.Status: Integer; +begin + // init result + Result := 0; + + // only continue if the DLL is loaded + if not IsDllLoaded then + begin + Exit; + end; + + // check if the connection with the CANUSB adapter is open + if FHCanUsbAdapter = 0 then + begin + Exit; + end; + + // read and return status bits + Result := FDllCanUsbStatus(FHCanUsbAdapter); +end; //*** end of Status *** + + +//*************************************************************************************** +// NAME: FindOptimumSingleRxFilter +// PARAMETER: id CAN message identifier to optimize the filter for. +// ext True if the id is 29-bit, False otherwise. +// code Buffer for storing the code part of the acceptance filter. +// mask Buffer for storing the mask part of the acceptance filter. +// RETURN VALUE: none +// DESCRIPTION: Finds the best code and mask values for receiving just a single CAN +// message with the reception acceptance filter. For 11-bit identifiers, +// this will find a perfect match, for 29-bit identfiers, it will always +// still let a group of messages pass because bits 0..12 are always +// don't care. +// +//*************************************************************************************** +procedure TCanUsb.FindOptimumSingleRxFilter(id: Longword; ext: Boolean; var code: Longword; var mask: Longword); +var + ACR0, ACR1, ACR2, ACR3: Byte; + AMR0, AMR1, AMR2, AMR3: Byte; +begin + // CANUSB's SJA1000 is in dual filter mode. this means it can be set to receive 1 single + // 11-bit identifier or a small group of 29-bit identifiers. + if not ext then + begin + ACR0 := Byte(id shr 3); + AMR0 := $00; + ACR1 := (Byte(id shl 5) or $1f); + AMR1 := $1F; + ACR2 := Byte(id shr 3); + AMR2 := $00; + ACR3 := (Byte(id shl 5) or $1f); + AMR3 := $1F; + end + else + begin + ACR0 := Byte(id shr 21); + AMR0 := $00; + ACR1 := Byte(id shr 13); + AMR1 := $00; + ACR2 := Byte(id shr 21); + AMR2 := $00; + ACR3 := Byte(id shr 13); + AMR3 := $00; + end; + + // set the results + code := (ACR3 shl 24) and $ff000000; + code := code or ((ACR2 shl 16) and $00ff0000); + code := code or ((ACR1 shl 8) and $0000ff00); + code := code or ((ACR0 shl 0) and $000000ff); + mask := (AMR3 shl 24) and $ff000000; + mask := mask or ((AMR2 shl 16) and $00ff0000); + mask := mask or ((AMR1 shl 8) and $0000ff00); + mask := mask or ((AMR0 shl 0) and $000000ff); +end; //*** end of FindOptimumSingleRxFilter *** + + +end. +//******************************* end of CanUsb.pas ************************************* + + diff --git a/Host/Source/MicroBoot/interfaces/can/lawicel/XcpSettings.dfm b/Host/Source/MicroBoot/interfaces/can/lawicel/XcpSettings.dfm new file mode 100644 index 00000000..86c8c2b4 Binary files /dev/null and b/Host/Source/MicroBoot/interfaces/can/lawicel/XcpSettings.dfm differ diff --git a/Host/Source/MicroBoot/interfaces/can/lawicel/XcpSettings.pas b/Host/Source/MicroBoot/interfaces/can/lawicel/XcpSettings.pas new file mode 100644 index 00000000..2b4ce334 --- /dev/null +++ b/Host/Source/MicroBoot/interfaces/can/lawicel/XcpSettings.pas @@ -0,0 +1,470 @@ +unit XcpSettings; +//*************************************************************************************** +// Description: XCP settings interface for CAN +// File Name: XcpSettings.pas +// +//--------------------------------------------------------------------------------------- +// C O P Y R I G H T +//--------------------------------------------------------------------------------------- +// Copyright (c) 2016 by Feaser http://www.feaser.com All rights reserved +// +// This software has been carefully tested, but is not guaranteed for any particular +// purpose. The author does not offer any warranties and does not guarantee the accuracy, +// adequacy, or completeness of the software and is not responsible for any errors or +// omissions or the results obtained from use of the software. +// +//--------------------------------------------------------------------------------------- +// L I C E N S E +//--------------------------------------------------------------------------------------- +// This file is part of OpenBLT. OpenBLT is free software: you can redistribute it and/or +// modify it under the terms of the GNU General Public License as published by the Free +// Software Foundation, either version 3 of the License, or (at your option) any later +// version. +// +// OpenBLT is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; +// without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR +// PURPOSE. See the GNU General Public License for more details. +// +// You have received a copy of the GNU General Public License along with OpenBLT. It +// should be located in ".\Doc\license.html". If not, contact Feaser to obtain a copy. +// +//*************************************************************************************** +interface + +//*************************************************************************************** +// Includes +//*************************************************************************************** +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, ComCtrls, ExtCtrls, IniFiles, Vcl.Imaging.pngimage; + + +//*************************************************************************************** +// Type Definitions +//*************************************************************************************** +type + TXcpSettingsForm = class(TForm) + pnlFooter: TPanel; + btnOK: TButton; + btnCancel: TButton; + pageControl: TPageControl; + tabXcp: TTabSheet; + tabCan: TTabSheet; + iconCan: TImage; + lblCan: TLabel; + lblXcp: TLabel; + iconXcp2: TImage; + lblHardware: TLabel; + cmbHardware: TComboBox; + lblChannel: TLabel; + cmbChannel: TComboBox; + lblBaudRate: TLabel; + chbExtendedId: TCheckBox; + lblT1: TLabel; + lblT3: TLabel; + lblT4: TLabel; + lblT5: TLabel; + lblT7: TLabel; + edtT1: TEdit; + edtT3: TEdit; + edtT4: TEdit; + edtT5: TEdit; + edtT7: TEdit; + tabProt: TTabSheet; + iconXcp1: TImage; + lblPort: TLabel; + edtSeedKey: TEdit; + btnBrowse: TButton; + lblTransmitId: TLabel; + Label1: TLabel; + edtTransmitId: TEdit; + edtReceiveId: TEdit; + openDialog: TOpenDialog; + edtTconnect: TEdit; + lblTconnect: TLabel; + cmbBaudrate: TComboBox; + procedure btnOKClick(Sender: TObject); + procedure btnCancelClick(Sender: TObject); + procedure btnBrowseClick(Sender: TObject); + procedure cmbHardwareChange(Sender: TObject); + procedure edtTransmitIdChange(Sender: TObject); + procedure edtTransmitIdKeyPress(Sender: TObject; var Key: Char); + procedure edtReceiveIdKeyPress(Sender: TObject; var Key: Char); + procedure edtReceiveIdChange(Sender: TObject); + private + { Private declarations } + procedure ValidateHexCanIdInputChange(EdtID: TEdit); + procedure ValidateHexCanIdInputPress(Sender: TObject; var Key: char); + public + { Public declarations } + procedure SetAvailableChannels; + end; + +type + TXcpSettings = class(TObject) + private + FSettingsForm : TXcpSettingsForm; + FIniFile : string; + public + constructor Create(iniFile : string); + destructor Destroy; override; + function Configure : Boolean; + end; + + +implementation +{$R *.DFM} + +//*************************************************************************************** +// NAME: SetAvailableChannels +// PARAMETER: none +// RETURN VALUE: none +// DESCRIPTION: Updates the items in the channels combobox based on the selected +// hardware. +// +//*************************************************************************************** +procedure TXcpSettingsForm.SetAvailableChannels; +var + maxChannels: Integer; + channelCnt: Integer; +begin + // all supported CAN interfaces from Lawical only have 1 channel + maxChannels := 1; + + // update the combobox contents + cmbChannel.Items.Clear; + for channelCnt := 1 to maxChannels do + begin + cmbChannel.Items.Add('Channel' + InttoStr(channelCnt)); + end; + cmbChannel.DropDownCount := maxChannels; + + // set selected channel + cmbChannel.ItemIndex := 0; +end; //*** end of SetAvailableChannels *** + + +//*************************************************************************************** +// NAME: ValidateHexCanIdInputChange +// PARAMETER: EdtID Signal source. +// RETURN VALUE: none. +// DESCRIPTION: Checks to see if a valid hexadecimal CAN identifier was entered in +// the specified edit box. Should be called in the edit box's onChange +// event handler. +// +//*************************************************************************************** +procedure TXcpSettingsForm.ValidateHexCanIdInputChange(EdtID: TEdit); +var + value: Int64; +begin + // prevent a message identifier > 0x1FFFFFFF from being entered + if EdtID.Text <> '' then + begin + try + value := StrToInt64('$' + EdtID.Text); + if value < 0 then + begin + EdtID.Text := '0'; + end + else if value > $1FFFFFFF then + begin + EdtID.Text := '1FFFFFFF'; + end; + // automatically set extended if flag + if value > $7ff then + chbExtendedId.Checked := True; + except + // use id 0 if a non hex value was entered, for example through copy-paste + EdtID.Text := '0'; + end; + end; +end; //*** end of ValidateHexCanIdInputChange *** + + +//*************************************************************************************** +// NAME: ValidateHexCanIdInputPress +// PARAMETER: Sender Signal source. +// Key The key's character code that was pressed. +// RETURN VALUE: none. +// DESCRIPTION: Checks to see if a valid hexadecimal CAN identifier was entered in +// the specified edit box. Should be called in the edit box's onPress +// event handler. +// +//*************************************************************************************** +procedure TXcpSettingsForm.ValidateHexCanIdInputPress(Sender: TObject; var Key: char); +begin + if not (AnsiChar(Key) In ['0'..'9', 'a'..'f', 'A'..'F', #8, ^V, ^C]) then // #8 = backspace + begin + // ignore it + Key := #0; + end; + // convert a..f to upper case + if AnsiChar(Key) In ['a'..'f'] then + begin + Key := UpCase(Key); + end; +end; //*** end of ValidateHexCanIdInputPress *** + + +//*************************************************************************************** +// NAME: cmbHardwareChange +// PARAMETER: none +// RETURN VALUE: modal result +// DESCRIPTION: Event handler for when the hardware combobox selection changed. +// +//*************************************************************************************** +procedure TXcpSettingsForm.cmbHardwareChange(Sender: TObject); +begin + SetAvailableChannels; +end; //*** end of cmbHardwareChange *** + + +//*************************************************************************************** +// NAME: edtTransmitIdChange +// PARAMETER: Sender Signal source. +// RETURN VALUE: None. +// DESCRIPTION: Called when the text in the edit box changed. +// +//*************************************************************************************** +procedure TXcpSettingsForm.edtReceiveIdChange(Sender: TObject); +begin + ValidateHexCanIdInputChange(edtReceiveId); +end; //*** end of edtReceiveIdChange *** + + +//*************************************************************************************** +// NAME: edtReceiveIdKeyPress +// PARAMETER: Sender Signal source. +// Key The key's character code that was pressed. +// RETURN VALUE: None. +// DESCRIPTION: Called when a key is pressed. +// +//*************************************************************************************** +procedure TXcpSettingsForm.edtReceiveIdKeyPress(Sender: TObject; var Key: Char); +begin + ValidateHexCanIdInputPress(edtReceiveId, Key); +end; //*** end of edtReceiveIdKeyPress *** + + +//*************************************************************************************** +// NAME: edtTransmitIdChange +// PARAMETER: Sender Signal source. +// RETURN VALUE: None. +// DESCRIPTION: Called when the text in the edit box changed. +// +//*************************************************************************************** +procedure TXcpSettingsForm.edtTransmitIdChange(Sender: TObject); +begin + ValidateHexCanIdInputChange(edtTransmitId); +end; //*** end of edtTransmitIdChange *** + + +//*************************************************************************************** +// NAME: edtTransmitIdKeyPress +// PARAMETER: Sender Signal source. +// Key The key's character code that was pressed. +// RETURN VALUE: None. +// DESCRIPTION: Called when a key is pressed. +// +//*************************************************************************************** +procedure TXcpSettingsForm.edtTransmitIdKeyPress(Sender: TObject; var Key: Char); +begin + ValidateHexCanIdInputPress(edtTransmitId, Key); +end; //*** end of edtTransmitIdKeyPress *** + + +//*************************************************************************************** +// NAME: btnOKClick +// PARAMETER: none +// RETURN VALUE: modal result +// DESCRIPTION: Sets the module result to okay. +// +//*************************************************************************************** +procedure TXcpSettingsForm.btnOKClick(Sender: TObject); +begin + ModalResult := mrOK; +end; //*** end of btnOKClick *** + + +//*************************************************************************************** +// NAME: btnCancelClick +// PARAMETER: none +// RETURN VALUE: modal result +// DESCRIPTION: Sets the module result to cancel. +// +//*************************************************************************************** +procedure TXcpSettingsForm.btnCancelClick(Sender: TObject); +begin + ModalResult := mrCancel; +end; //*** end of btnCancelClick *** + + +//*************************************************************************************** +// NAME: btnBrowseClick +// PARAMETER: none +// RETURN VALUE: none +// DESCRIPTION: Prompts the user to select the seed/key dll file. +// +//*************************************************************************************** +procedure TXcpSettingsForm.btnBrowseClick(Sender: TObject); +begin + openDialog.InitialDir := ExtractFilePath(ParamStr(0)); + if openDialog.Execute then + begin + edtSeedKey.Text := openDialog.FileName; + end; +end; //*** end of btnBrowseClick *** + + +//*************************************************************************************** +// NAME: Create +// PARAMETER: Name of the INI file where the settings are and will be stored +// RETURN VALUE: none +// DESCRIPTION: Class constructor +// +//*************************************************************************************** +constructor TXcpSettings.Create(iniFile : string); +begin + // call inherited constructor + inherited Create; + + // set the inifile + FIniFile := iniFile; + + // create an instance of the settings form + FSettingsForm := TXcpSettingsForm.Create(nil); +end; //*** end of Create *** + + +//*************************************************************************************** +// NAME: Destroy +// PARAMETER: none +// RETURN VALUE: none +// DESCRIPTION: Class destructor +// +//*************************************************************************************** +destructor TXcpSettings.Destroy; +begin + // releaase the settings form object + FSettingsForm.Free; + + // call inherited destructor + inherited; +end; //*** end of Destroy *** + + +//*************************************************************************************** +// NAME: Configure +// PARAMETER: none +// RETURN VALUE: True if configuration was successfully changed, False otherwise +// DESCRIPTION: Allows the user to configure the XCP interface using a GUI. +// +//*************************************************************************************** +function TXcpSettings.Configure : Boolean; +var + settingsIni: TIniFile; + settingsInt: Integer; +begin + // initialize the return value + result := false; + + // init the form elements using the configuration found in the INI + if FileExists(FIniFile) then + begin + // create ini file object + settingsIni := TIniFile.Create(FIniFile); + + // CAN related elements + settingsInt := settingsIni.ReadInteger('can', 'hardware', 0); + if settingsInt > FSettingsForm.cmbHardware.Items.Count then + settingsInt := 0; + FSettingsForm.cmbHardware.ItemIndex := settingsInt; + FSettingsForm.SetAvailableChannels; + + settingsInt := settingsIni.ReadInteger('can', 'channel', 0); + if settingsInt >= FSettingsForm.cmbChannel.Items.Count then + settingsInt := 0; + FSettingsForm.cmbChannel.ItemIndex := settingsInt; + + settingsInt := settingsIni.ReadInteger('can', 'baudrate', 2); + if settingsInt >= FSettingsForm.cmbBaudrate.Items.Count then + settingsInt := 2; + FSettingsForm.cmbBaudrate.ItemIndex := settingsInt; + + FSettingsForm.chbExtendedId.Checked := settingsIni.ReadBool('can', 'extended', false); + FSettingsForm.edtTransmitId.Text := Format('%x',[settingsIni.ReadInteger('can', 'txid', $667)]); + FSettingsForm.edtReceiveId.Text := Format('%x',[settingsIni.ReadInteger('can', 'rxid', $7e1)]); + + // XCP related elements + FSettingsForm.edtSeedKey.Text := settingsIni.ReadString('xcp', 'seedkey', ''); + FSettingsForm.edtT1.Text := IntToStr(settingsIni.ReadInteger('xcp', 't1', 1000)); + FSettingsForm.edtT3.Text := IntToStr(settingsIni.ReadInteger('xcp', 't3', 2000)); + FSettingsForm.edtT4.Text := IntToStr(settingsIni.ReadInteger('xcp', 't4', 10000)); + FSettingsForm.edtT5.Text := IntToStr(settingsIni.ReadInteger('xcp', 't5', 1000)); + FSettingsForm.edtT7.Text := IntToStr(settingsIni.ReadInteger('xcp', 't7', 2000)); + FSettingsForm.edtTconnect.Text := IntToStr(settingsIni.ReadInteger('xcp', 'tconnect', 20)); + + // release ini file object + settingsIni.Free; + end + else + begin + // set defaults + // CAN related elements + FSettingsForm.cmbHardware.ItemIndex := 0; + FSettingsForm.SetAvailableChannels; + FSettingsForm.cmbChannel.ItemIndex := 0; + FSettingsForm.cmbBaudrate.ItemIndex := 2; + FSettingsForm.chbExtendedId.Checked := false; + FSettingsForm.edtTransmitId.Text := Format('%x',[$667]); + FSettingsForm.edtReceiveId.Text := Format('%x',[$7e1]); + + // XCP related elements + FSettingsForm.edtSeedKey.Text := ''; + FSettingsForm.edtT1.Text := IntToStr(1000); + FSettingsForm.edtT3.Text := IntToStr(2000); + FSettingsForm.edtT4.Text := IntToStr(10000); + FSettingsForm.edtT5.Text := IntToStr(1000); + FSettingsForm.edtT7.Text := IntToStr(2000); + FSettingsForm.edtTconnect.Text := IntToStr(20); + end; + + // show the form as modal so we can get the result here + if FSettingsForm.ShowModal = mrOK then + begin + if FIniFile <> '' then + begin + // create ini file object + settingsIni := TIniFile.Create(FIniFile); + + // CAN related elements + settingsIni.WriteInteger('can', 'hardware', FSettingsForm.cmbHardware.ItemIndex); + settingsIni.WriteInteger('can', 'channel', FSettingsForm.cmbChannel.ItemIndex); + settingsIni.WriteInteger('can', 'baudrate', FSettingsForm.cmbBaudrate.ItemIndex); + settingsIni.WriteBool('can', 'extended', FSettingsForm.chbExtendedId.Checked); + settingsIni.WriteInteger('can', 'txid', StrToInt('$'+FSettingsForm.edtTransmitId.Text)); + settingsIni.WriteInteger('can', 'rxid', StrToInt('$'+FSettingsForm.edtReceiveId.Text)); + + // XCP related elements + settingsIni.WriteString('xcp', 'seedkey', FSettingsForm.edtSeedKey.Text); + settingsIni.WriteInteger('xcp', 't1', StrToInt(FSettingsForm.edtT1.Text)); + settingsIni.WriteInteger('xcp', 't3', StrToInt(FSettingsForm.edtT3.Text)); + settingsIni.WriteInteger('xcp', 't4', StrToInt(FSettingsForm.edtT4.Text)); + settingsIni.WriteInteger('xcp', 't5', StrToInt(FSettingsForm.edtT5.Text)); + settingsIni.WriteInteger('xcp', 't7', StrToInt(FSettingsForm.edtT7.Text)); + settingsIni.WriteInteger('xcp', 'tconnect', StrToInt(FSettingsForm.edtTconnect.Text)); + + // release ini file object + settingsIni.Free; + + // indicate that the settings where successfully updated + result := true; + end; + end; +end; //*** end of Configure *** + + +end. +//******************************** end of XcpSettings.pas ******************************* + + diff --git a/Host/Source/MicroBoot/interfaces/can/lawicel/XcpTransport.pas b/Host/Source/MicroBoot/interfaces/can/lawicel/XcpTransport.pas new file mode 100644 index 00000000..fa961e29 --- /dev/null +++ b/Host/Source/MicroBoot/interfaces/can/lawicel/XcpTransport.pas @@ -0,0 +1,330 @@ +unit XcpTransport; +//*************************************************************************************** +// Description: XCP transport layer for CAN. +// File Name: XcpTransport.pas +// +//--------------------------------------------------------------------------------------- +// C O P Y R I G H T +//--------------------------------------------------------------------------------------- +// Copyright (c) 2016 by Feaser http://www.feaser.com All rights reserved +// +// This software has been carefully tested, but is not guaranteed for any particular +// purpose. The author does not offer any warranties and does not guarantee the accuracy, +// adequacy, or completeness of the software and is not responsible for any errors or +// omissions or the results obtained from use of the software. +// +//--------------------------------------------------------------------------------------- +// L I C E N S E +//--------------------------------------------------------------------------------------- +// This file is part of OpenBLT. OpenBLT is free software: you can redistribute it and/or +// modify it under the terms of the GNU General Public License as published by the Free +// Software Foundation, either version 3 of the License, or (at your option) any later +// version. +// +// OpenBLT is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; +// without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR +// PURPOSE. See the GNU General Public License for more details. +// +// You have received a copy of the GNU General Public License along with OpenBLT. It +// should be located in ".\Doc\license.html". If not, contact Feaser to obtain a copy. +// +//*************************************************************************************** +interface + + +//*************************************************************************************** +// Includes +//*************************************************************************************** +uses + Windows, Messages, SysUtils, Classes, Forms, IniFiles, CanUsb; + + +//*************************************************************************************** +// Global Constants +//*************************************************************************************** +// a CAN message can only have up to 8 bytes +const kMaxPacketSize = 8; + + +//*************************************************************************************** +// Type Definitions +//*************************************************************************************** +type + TXcpTransport = class(TObject) + private + packetTxId : LongWord; + packetRxId : Longword; + extendedId : Boolean; + canDriver : TCanUsb; + canHardware : Integer; { not used right now } + canChannel : Word; { currently supported is 1 } + canBaudrate : CANBaudrate; { as enum } + connected : Boolean; + public + packetData : array[0..kMaxPacketSize-1] of Byte; + packetLen : Word; + constructor Create; + procedure Configure(iniFile : string); + function Connect: Boolean; + function SendPacket(timeOutms: LongWord): Boolean; + function IsComError: Boolean; + procedure Disconnect; + destructor Destroy; override; + end; + + +implementation + +//*************************************************************************************** +// NAME: Create +// PARAMETER: none +// RETURN VALUE: none +// DESCRIPTION: Class constructore +// +//*************************************************************************************** +constructor TXcpTransport.Create; +begin + // call inherited constructor + inherited Create; + + // construct the can driver object + canDriver := TCanUsb.Create; + // load the CAN driver's dll + canDriver.LoadDll; + + // reset the packet ids + packetTxId := 0; + packetRxId := 0; + + // use standard id's by default + extendedId := false; + + // reset packet length + packetLen := 0; + + // disconnected by default + connected := false; +end; //*** end of Create *** + + +//*************************************************************************************** +// NAME: Destroy +// PARAMETER: none +// RETURN VALUE: none +// DESCRIPTION: Class destructor +// +//*************************************************************************************** +destructor TXcpTransport.Destroy; +begin + // unload the CAN driver's dll + canDriver.UnloadDll; + // release the CAN driver + canDriver.Free; + // call inherited destructor + inherited; +end; //*** end of Destroy *** + + +//*************************************************************************************** +// NAME: Configure +// PARAMETER: filename of the INI +// RETURN VALUE: none +// DESCRIPTION: Configures both this class from the settings in the INI. +// +//*************************************************************************************** +procedure TXcpTransport.Configure(iniFile : string); +var + settingsIni : TIniFile; +begin + // read XCP configuration from INI + if FileExists(iniFile) then + begin + // create ini file object + settingsIni := TIniFile.Create(iniFile); + + // set hardware configuration + canHardware := settingsIni.ReadInteger('can', 'hardware', 0); + canChannel := settingsIni.ReadInteger('can', 'channel', 0) + 1; + + case settingsIni.ReadInteger('can', 'baudrate', 2) of + 0: canBaudrate := CAN_BAUD_1M; + 1: canBaudrate := CAN_BAUD_800K; + 2: canBaudrate := CAN_BAUD_500K; + 3: canBaudrate := CAN_BAUD_250K; + 4: canBaudrate := CAN_BAUD_125K; + 5: canBaudrate := CAN_BAUD_100K; + 6: canBaudrate := CAN_BAUD_50K; + 7: canBaudrate := CAN_BAUD_20K; + 8: canBaudrate := CAN_BAUD_10K; + else + canBaudrate := CAN_BAUD_500K; + end; + + // set message configuration + packetTxId := settingsIni.ReadInteger('can', 'txid', $667); + packetRxId := settingsIni.ReadInteger('can', 'rxid', $7e1); + extendedId := settingsIni.ReadBool('can', 'extended', false); + + // release ini file object + settingsIni.Free; + end; +end; //*** end of Configure *** + + +//*************************************************************************************** +// NAME: Connect +// PARAMETER: none +// RETURN VALUE: True if successful, False otherwise. +// DESCRIPTION: Connects the transport layer device. +// +//*************************************************************************************** +function TXcpTransport.Connect: Boolean; +var + code, mask: Longword; +begin + // init result value + result := false; + + // disconnect first if still connected + if connected then + Disconnect; + + // get the optimum setting for the acceptance filter for receiving just 1 identifier + canDriver.FindOptimumSingleRxFilter(packetRxId, extendedId, code, mask); + + // attempt to connect to the CAN hardware interface + if canDriver.Connect(canBaudrate, code, mask) then + begin + connected := true; + result := true; + end; +end; //*** end of Connect *** + + +//*************************************************************************************** +// NAME: IsComError +// PARAMETER: none +// RETURN VALUE: True if in error state, False otherwise. +// DESCRIPTION: Determines if the communication interface is in an error state. +// +//*************************************************************************************** +function TXcpTransport.IsComError: Boolean; +var + status: Integer; +begin + // init result to no error. + result := false; + + // check for bus off and bus heavy conditions + status := canDriver.Status; + if ((status and CANSTATUS_BUS_ERROR) <> 0) then + begin + result := true; + end; +end; //*** end of IsComError *** + + +//*************************************************************************************** +// NAME: SendPacket +// PARAMETER: the time[ms] allowed for the reponse from the slave to come in. +// RETURN VALUE: True if response received from slave, False otherwise +// DESCRIPTION: Sends the XCP packet using the data in 'packetData' and length in +// 'packetLen' and waits for the response to come in. +// +//*************************************************************************************** +function TXcpTransport.SendPacket(timeOutms: LongWord): Boolean; +var + txMsg: CANMsg; + rxMsg: CANMsg; + byteIdx: Byte; + responseReceived: Boolean; + timeoutTime: DWORD; +begin + // initialize the result value + result := false; + + // do not send data when the packet length is invalid or when not connected + // to the CAN hardware + if (packetLen > kMaxPacketSize) or (not connected) then + begin + Exit; + end; + + // prepare the packet for transmission in a CAN message + txMsg.id := packetTxId; + if extendedId then + txMsg.flags := CANMSG_EXTENDED + else + txMsg.flags := 0; + txMsg.len := packetLen; + for byteIdx := 0 to (packetLen-1) do + begin + txMsg.data[byteIdx] := packetData[byteIdx]; + end; + + // transmit the packet via CAN + if not canDriver.Transmit(txMsg) then + begin + Exit; + end; + + // reset flag and set the reception timeout time + responseReceived := false; + timeoutTime := GetTickCount + timeOutms; + + // attempt to receive the packet response within the timeout time + repeat + // read out the next message in the receive queue + if canDriver.Receive(rxMsg) then + begin + // was the newly received CAN message the response we are waiting for? + if rxMsg.id = packetRxId then + begin + // was the id type also a match? + if ((rxMsg.flags = 0) and (not extendedId)) or + ((rxMsg.flags = CANMSG_EXTENDED) and (extendedId)) then + begin + // response received. set flag + responseReceived := true; + end; + end; + end; + // give the application a chance to use the processor + Application.ProcessMessages; + until (GetTickCount > timeoutTime) or (responseReceived); + + // check if the response was correctly received + if responseReceived then + begin + // copy the response for futher processing + packetLen := rxMsg.len; + for byteIdx := 0 to (packetLen-1) do + begin + packetData[byteIdx] := rxMsg.data[byteIdx]; + end; + // success + result := true; + end; +end; //*** end of SendPacket *** + + +//*************************************************************************************** +// NAME: Disconnect +// PARAMETER: none +// RETURN VALUE: none +// DESCRIPTION: Disconnects the transport layer device. +// +//*************************************************************************************** +procedure TXcpTransport.Disconnect; +begin + // disconnect CAN interface if connected + if connected then + begin + canDriver.Disconnect; + end; + connected := false; +end; //*** end of Disconnect *** + +end. +//******************************** end of XcpTransport.pas ****************************** + diff --git a/Host/Source/MicroBoot/interfaces/can/lawicel/openblt_can_lawicel.dpr b/Host/Source/MicroBoot/interfaces/can/lawicel/openblt_can_lawicel.dpr new file mode 100644 index 00000000..6af1359f --- /dev/null +++ b/Host/Source/MicroBoot/interfaces/can/lawicel/openblt_can_lawicel.dpr @@ -0,0 +1,651 @@ +library openblt_can_lawicel; +//*************************************************************************************** +// Project Name: MicroBoot Interface for Delphi +// Description: XCP - CAN interface for MicroBoot supporting Lawicel CANUSB. +// File Name: openblt_can_lawicel.dpr +// +//--------------------------------------------------------------------------------------- +// C O P Y R I G H T +//--------------------------------------------------------------------------------------- +// Copyright (c) 2016 by Feaser http://www.feaser.com All rights reserved +// +// This software has been carefully tested, but is not guaranteed for any particular +// purpose. The author does not offer any warranties and does not guarantee the accuracy, +// adequacy, or completeness of the software and is not responsible for any errors or +// omissions or the results obtained from use of the software. +// +//--------------------------------------------------------------------------------------- +// L I C E N S E +//--------------------------------------------------------------------------------------- +// This file is part of OpenBLT. OpenBLT is free software: you can redistribute it and/or +// modify it under the terms of the GNU General Public License as published by the Free +// Software Foundation, either version 3 of the License, or (at your option) any later +// version. +// +// OpenBLT is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; +// without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR +// PURPOSE. See the GNU General Public License for more details. +// +// You have received a copy of the GNU General Public License along with OpenBLT. It +// should be located in ".\Doc\license.html". If not, contact Feaser to obtain a copy. +// +//*************************************************************************************** + + +//*************************************************************************************** +// Includes +//*************************************************************************************** +uses + Windows, + Messages, + Graphics, + Controls, + Forms, + Dialogs, + SysUtils, + Classes, + Extctrls, + XcpProtection in '..\..\XcpProtection.pas', + SRecReader in '..\..\SRecReader.pas', + XcpDataFile in '..\..\XcpDataFile.pas', + XcpLoader in '..\..\XcpLoader.pas', + XcpTransport in 'XcpTransport.pas', + XcpSettings in 'XcpSettings.pas' {XcpSettingsForm}; + +//*************************************************************************************** +// Global Constants +//*************************************************************************************** +const kMaxProgLen = 256; // maximum number of bytes to progam at one time + + +//*************************************************************************************** +// Type Definitions +//*************************************************************************************** +// DLL Interface Callbacks - modifications requires potential update of all interfaces! +type + TStartedEvent = procedure(length: Longword) of object; + TProgressEvent = procedure(progress: Longword) of object; + TDoneEvent = procedure of object; + TErrorEvent = procedure(error: ShortString) of object; + TLogEvent = procedure(info: ShortString) of object; + TInfoEvent = procedure(info: ShortString) of object; + +type + TEventHandlers = class // create a dummy class + procedure OnTimeout(Sender: TObject); + end; + +//*************************************************************************************** +// Global Variables +//*************************************************************************************** +var + //--- begin of don't change --- + AppOnStarted : TStartedEvent; + AppOnProgress : TProgressEvent; + AppOnDone : TDoneEvent; + AppOnError : TErrorEvent; + AppOnLog : TLogEvent; + AppOnInfo : TInfoEvent; + //--- end of don't change --- + timer : TTimer; + events : TEventHandlers; + loader : TXcpLoader; + datafile : TXcpDataFile; + progdata : array of Byte; + progfile : string; + stopRequest : boolean; + + +//*************************************************************************************** +// NAME: MbiCallbackOnStarted +// PARAMETER: length of the file that is being downloaded. +// RETURN VALUE: none +// DESCRIPTION: Wrapper function for safely calling an application callback +// +//*************************************************************************************** +procedure MbiCallbackOnStarted(length: Longword); +begin + if Assigned(AppOnStarted) then + begin + AppOnStarted(length); + end; +end; //** end of MbiCallbackOnStarted *** + + +//*************************************************************************************** +// NAME: MbiCallbackOnProgress +// PARAMETER: progress of the file download. +// RETURN VALUE: none +// DESCRIPTION: Wrapper function for safely calling an application callback +// +//*************************************************************************************** +procedure MbiCallbackOnProgress(progress: Longword); +begin + if Assigned(AppOnProgress) then + begin + AppOnProgress(progress); + end; +end; //** end of MbiCallbackOnProgress *** + + +//*************************************************************************************** +// NAME: MbiCallbackOnDone +// PARAMETER: none +// RETURN VALUE: none +// DESCRIPTION: Wrapper function for safely calling an application callback +// +//*************************************************************************************** +procedure MbiCallbackOnDone; +begin + if Assigned(AppOnDone) then + begin + AppOnDone; + end; +end; //** end of MbiCallbackOnDone *** + + +//*************************************************************************************** +// NAME: MbiCallbackOnError +// PARAMETER: info about the error that occured. +// RETURN VALUE: none +// DESCRIPTION: Wrapper function for safely calling an application callback +// +//*************************************************************************************** +procedure MbiCallbackOnError(error: ShortString); +begin + if Assigned(AppOnError) then + begin + AppOnError(error); + end; +end; //** end of MbiCallbackOnError *** + + +//*************************************************************************************** +// NAME: MbiCallbackOnLog +// PARAMETER: info on the log event. +// RETURN VALUE: none +// DESCRIPTION: Wrapper function for safely calling an application callback +// +//*************************************************************************************** +procedure MbiCallbackOnLog(info: ShortString); +begin + if Assigned(AppOnLog) then + begin + AppOnLog(info); + end; +end; //** end of MbiCallbackOnLog *** + + +//*************************************************************************************** +// NAME: MbiCallbackOnInfo +// PARAMETER: details on the info event. +// RETURN VALUE: none +// DESCRIPTION: Wrapper function for safely calling an application callback +// +//*************************************************************************************** +procedure MbiCallbackOnInfo(info: ShortString); +begin + if Assigned(AppOnInfo) then + begin + AppOnInfo(info); + end; +end; //** end of MbiCallbackOnLog *** + + +//*************************************************************************************** +// NAME: LogData +// PARAMETER: pointer to byte array and the data length +// RETURN VALUE: none +// DESCRIPTION: Writes the program data formatted to the logfile +// +//*************************************************************************************** +procedure LogData(data : PByteArray; len : longword); stdcall; +var + currentWriteCnt : byte; + cnt : byte; + logStr : string; + bufferOffset : longword; +begin + bufferOffset := 0; + + while len > 0 do + begin + // set the current write length optimized to log 32 bytes per line + currentWriteCnt := len mod 32; + if currentWriteCnt = 0 then currentWriteCnt := 32; + logStr := ''; + + // prepare the line to add to the log + for cnt := 0 to currentWriteCnt-1 do + begin + logStr := logStr + Format('%2.2x ', [data[bufferOffset+cnt]]); + end; + + // update the log + MbiCallbackOnLog(ShortString(logStr)); + + // update loop variables + len := len - currentWriteCnt; + bufferOffset := bufferOffset + currentWriteCnt; + end; +end; //*** end of LogData *** + + +//*************************************************************************************** +// NAME: OnTimeout +// PARAMETER: none +// RETURN VALUE: none +// DESCRIPTION: Timer event handler. A timer is used in this example to simulate the +// progress of a file download. It also demonstrates how to use the +// application callbacks to keep the application informed. +// +//*************************************************************************************** +procedure TEventHandlers.OnTimeout(Sender: TObject); +var + errorInfo : string; + progress : longword; + regionCnt : longword; + currentWriteCnt : word; + sessionStartResult : byte; + bufferOffset : longword; + addr : longword; + len : longword; + dataSizeKB : real; +begin + timer.Enabled := False; + + // connect the transport layer + MbiCallbackOnInfo('Connecting to the CAN interface.'); + MbiCallbackOnLog('Connecting to the CAN interface. t='+ShortString(TimeToStr(Time))); + Application.ProcessMessages; + if not loader.Connect then + begin + // update the user info + MbiCallbackOnError('Could not connect to CAN interface. Check your configuration.'); + MbiCallbackOnLog('Could not connect to CAN interface. Check your configuration and try again. t='+ShortString(TimeToStr(Time))); + Exit; + end; + + //---------------- start the programming session -------------------------------------- + MbiCallbackOnLog('Starting the programming session. t='+ShortString(TimeToStr(Time))); + + // try initial connect via XCP. if the user program is able to reactivate the bootloader + // it will do so now + sessionStartResult := loader.StartProgrammingSession; + if sessionStartResult = kProgSessionUnlockError then + begin + MbiCallbackOnLog('Security issue. Could not unprotect the programming resource. Check your configured XCP protection DLL. t='+ShortString(TimeToStr(Time))); + MbiCallbackOnError('Security issue. Could not unprotect the programming resource.'); + loader.Disconnect; + Exit; + end; + // try initial connect via XCP + if sessionStartResult <> kProgSessionStarted then + begin + // update the user info + MbiCallbackOnInfo('Could not connect. Retrying. Reset your target if this takes a long time.'); + MbiCallbackOnLog('Connect failed. Switching to backdoor entry mode. t='+ShortString(TimeToStr(Time))); + Application.ProcessMessages; + // possible that the bootloader is being activated, which means that the target's + // CAN controller is being reinitialized. We should not send any data on the CAN + // network for this to finish. 200ms should do it. note that the backdoor entry time + // should be at least 2.5x this. + Sleep(200); + // continuously try to connect via XCP true the backdoor + sessionStartResult := kProgSessionGenericError; + while sessionStartResult <> kProgSessionStarted do + begin + sessionStartResult := loader.StartProgrammingSession; + Application.ProcessMessages; + Sleep(5); + // if the hardware is in reset or otherwise does not have the CAN controller synchronized to + // the CAN bus, we will be generating error frames, possibly leading to a bus off. + // check for this + if loader.IsComError then + begin + // bus off state, so try to recover. + MbiCallbackOnLog('Communication error detected. Trying automatic recovery. t='+ShortString(TimeToStr(Time))); + loader.Disconnect; + if not loader.Connect then + begin + MbiCallbackOnLog('Could not connect to CAN interface. Check your configuration and try again. t='+ShortString(TimeToStr(Time))); + MbiCallbackOnError('Could not connect to CAN interface. Check your configuration.'); + Exit; + end; + Sleep(200); + end; + // don't retry if the error was caused by not being able to unprotect the programming resource + if sessionStartResult = kProgSessionUnlockError then + begin + MbiCallbackOnLog('Security issue. Could not unprotect the programming resource. Check your configured XCP protection DLL. t='+ShortString(TimeToStr(Time))); + MbiCallbackOnError('Security issue. Could not unprotect the programming resource.'); + Exit; + end; + + // check if the user cancelled + if stopRequest then + begin + MbiCallbackOnError('Programming session cancelled by user.'); + Exit; + end; + end; + end; + + // still here so programming session was started + MbiCallbackOnLog('Programming session started. t='+ShortString(TimeToStr(Time))); + + // create the datafile object + datafile := TXcpDataFile.Create(progfile); + + // compute the size in kbytes + dataSizeKB := datafile.GetDataCnt / 1024; + + // Call application callback when we start the actual download + MbiCallbackOnStarted(datafile.GetDataCnt); + + // Init progress to 0 progress + progress := 0; + MbiCallbackOnProgress(progress); + + //---------------- next clear the memory regions -------------------------------------- + + // update the user info + MbiCallbackOnInfo('Erasing memory...'); + + for regionCnt := 0 to datafile.GetRegionCnt-1 do + begin + // obtain the region info + datafile.GetRegionInfo(regionCnt, addr, len); + + // erase the memory + MbiCallbackOnLog('Clearing Memory '+ShortString(Format('addr:0x%x,len:0x%x',[addr,len]))+'. t='+ShortString(TimeToStr(Time))); + if not loader.ClearMemory(addr, len) then + begin + loader.GetLastError(errorInfo); + MbiCallbackOnLog('Could not clear memory ('+ShortString(errorInfo)+'). t='+ShortString(TimeToStr(Time))); + MbiCallbackOnError('Could not clear memory ('+ShortString(errorInfo)+').'); + datafile.Free; + Exit; + end; + MbiCallbackOnLog('Memory cleared. t='+ShortString(TimeToStr(Time))); + end; + + //---------------- next program the memory regions ------------------------------------ + for regionCnt := 0 to datafile.GetRegionCnt-1 do + begin + // update the user info + MbiCallbackOnInfo('Reading file...'); + + // obtain the region info + datafile.GetRegionInfo(regionCnt, addr, len); + // dynamically allocated buffer memory + SetLength(progdata, len); + // obtain the regiond data + datafile.GetRegionData(regionCnt, progdata); + + bufferOffset := 0; + while len > 0 do + begin + // set the current write length taking into account kMaxProgLen + currentWriteCnt := len mod kMaxProgLen; + if currentWriteCnt = 0 then currentWriteCnt := kMaxProgLen; + + // program the data + MbiCallbackOnLog('Programming Data '+ShortString(Format('addr:0x%x,len:0x%x',[addr,currentWriteCnt]))+'. t='+ShortString(TimeToStr(Time))); + LogData(@progdata[bufferOffset], currentWriteCnt); + + if not loader.WriteData(addr, currentWriteCnt, @progdata[bufferOffset]) then + begin + loader.GetLastError(errorInfo); + MbiCallbackOnLog('Could not program data ('+ShortString(errorInfo)+'). t='+ShortString(TimeToStr(Time))); + MbiCallbackOnError('Could not program data ('+ShortString(errorInfo)+').'); + datafile.Free; + Exit; + end; + MbiCallbackOnLog('Data Programmed. t='+ShortString(TimeToStr(Time))); + + // update progress + progress := progress + currentWriteCnt; + MbiCallbackOnProgress(progress); + + // update loop variables + len := len - currentWriteCnt; + addr := addr + currentWriteCnt; + bufferOffset := bufferOffset + currentWriteCnt; + + // update the user info + MbiCallbackOnInfo('Programming data... ' + ShortString(Format('(%.1n of %.1n Kbytes)',[(progress/1024), dataSizeKB]))); + + end; + end; + + //---------------- stop the programming session --------------------------------------- + MbiCallbackOnLog('Stopping the programming session. t='+ShortString(TimeToStr(Time))); + if not loader.StopProgrammingSession then + begin + loader.GetLastError(errorInfo); + MbiCallbackOnLog('Could not stop the programming session ('+ShortString(errorInfo)+'). t='+ShortString(TimeToStr(Time))); + MbiCallbackOnError('Could not stop the programming session ('+ShortString(errorInfo)+').'); + datafile.Free; + Exit; + end; + MbiCallbackOnLog('Programming session stopped. t='+ShortString(TimeToStr(Time))); + + // all done so set progress to 100% and finish up + progress := datafile.GetDataCnt; + datafile.Free; + MbiCallbackOnProgress(progress); + MbiCallbackOnLog('File successfully downloaded t='+ShortString(TimeToStr(Time))); + MbiCallbackOnDone; + +end; //*** end of OnTimeout *** + + +//*************************************************************************************** +// NAME: MbiInit +// PARAMETER: callback function pointers +// RETURN VALUE: none +// DESCRIPTION: Called by the application to initialize the interface library. +// +//*************************************************************************************** +procedure MbiInit(cbStarted: TStartedEvent; cbProgress: TProgressEvent; + cbDone: TDoneEvent; cbError: TErrorEvent; cbLog: TLogEvent; + cbInfo: TInfoEvent); stdcall; +begin + //--- begin of don't change --- + AppOnStarted := cbStarted; + AppOnProgress := cbProgress; + AppOnDone := cbDone; + AppOnLog := cbLog; + AppOnInfo := cbInfo; + AppOnError := cbError; + //--- end of don't change --- + + // create xcp loader object + loader := TXcpLoader.Create; + + // update to the latest configuration + loader.Configure(ExtractFilePath(ParamStr(0))+'openblt_can_lawicel.ini'); + + // create and init a timer + events := TEventHandlers.Create; + timer := TTimer.Create(nil); + timer.Enabled := False; + timer.Interval := 100; + timer.OnTimer := events.OnTimeout; +end; //*** end of MbiInit *** + + +//*************************************************************************************** +// NAME: MbiStart +// PARAMETER: filename of the file that is to be downloaded. +// RETURN VALUE: none +// DESCRIPTION: Called by the application to request the interface library to download +// the file that is passed as a parameter. +// +//*************************************************************************************** +procedure MbiStart(fileName: ShortString); stdcall; +begin + // update the user info + MbiCallbackOnInfo(''); + + // start the log + MbiCallbackOnLog('--- Downloading "'+fileName+'" ---'); + + // reset stop request + stopRequest := false; + + // start the startup timer which gives microBoot a chance to paint itself + timer.Enabled := True; + + // store the program's filename + progfile := String(fileName); +end; //*** end of MbiStart *** + + +//*************************************************************************************** +// NAME: MbiStop +// PARAMETER: none +// RETURN VALUE: none +// DESCRIPTION: Called by the application to request the interface library to stop +// a download that could be in progress. +// +//*************************************************************************************** +procedure MbiStop; stdcall; +begin + // set stop request + stopRequest := true; + + // disconnect the transport layer + MbiCallbackOnLog('Disconnecting the transport layer. t='+ShortString(TimeToStr(Time))); + loader.Disconnect; +end; //*** end of MbiStop *** + + +//*************************************************************************************** +// NAME: MbiDeInit +// PARAMETER: none +// RETURN VALUE: none +// DESCRIPTION: Called by the application to uninitialize the interface library. +// +//*************************************************************************************** +procedure MbiDeInit; stdcall; +begin + // release xcp loader object + loader.Free; + + // release the timer and events object + timer.Free; + events.Free; + + //--- begin of don't change --- + AppOnStarted := nil; + AppOnProgress := nil; + AppOnDone := nil; + AppOnLog := nil; + AppOnInfo := nil; + AppOnError := nil; + //--- end of don't change --- +end; //*** end of MbiDeInit *** + + +//*************************************************************************************** +// NAME: MbiName +// PARAMETER: none +// RETURN VALUE: name of the interface library +// DESCRIPTION: Called by the application to obtain the name of the interface library. +// +//*************************************************************************************** +function MbiName : ShortString; stdcall; +begin + Result := 'OpenBLT CAN Lawicel'; +end; //*** end of MbiName *** + + +//*************************************************************************************** +// NAME: MbiDescription +// PARAMETER: none +// RETURN VALUE: description of the interface library +// DESCRIPTION: Called by the application to obtain the description of the interface +// library. +// +//*************************************************************************************** +function MbiDescription : ShortString; stdcall; +begin + Result := 'OpenBLT using Lawicel CANUSB'; +end; //*** end of MbiDescription *** + + +//*************************************************************************************** +// NAME: MbiVersion +// PARAMETER: none +// RETURN VALUE: version number +// DESCRIPTION: Called by the application to obtain the version number of the +// interface library. +// +//*************************************************************************************** +function MbiVersion : Longword; stdcall; +begin + Result := 10000; // v1.00.00 +end; //*** end of MbiVersion *** + + +//*************************************************************************************** +// NAME: MbiVInterface +// PARAMETER: none +// RETURN VALUE: version number of the supported interface +// DESCRIPTION: Called by the application to obtain the version number of the +// Mbi interface uBootInterface.pas (not the interface library). This can +// be used by the application for backward compatibility. +// +//*************************************************************************************** +function MbiVInterface : Longword; stdcall; +begin + Result := 10001; // v1.00.01 +end; //*** end of MbiVInterface *** + + +//*************************************************************************************** +// NAME: MbiConfigure +// PARAMETER: none +// RETURN VALUE: none +// DESCRIPTION: Called by the application to enable the user to configure the inter- +// face library through the application. +// +//*************************************************************************************** +procedure MbiConfigure; stdcall; +var + settings : TXcpSettings; +begin + // create xcp settings object + settings := TXcpSettings.Create(ExtractFilePath(ParamStr(0))+'openblt_can_lawicel.ini'); + + // display the modal configuration dialog + settings.Configure; + + // release the xcp settings object + settings.Free; + + // update to the latest configuration + loader.Configure(ExtractFilePath(ParamStr(0))+'openblt_can_lawicel.ini'); +end; //*** end of MbiConfigure *** + + +//*************************************************************************************** +// External Declarations +//*************************************************************************************** +exports + //--- begin of don't change --- + MbiInit, + MbiStart, + MbiStop, + MbiDeInit, + MbiName, + MbiDescription, + MbiVersion, + MbiConfigure, + MbiVInterface; + //--- end of don't change --- + +end. +//********************************** end of openblt_can_lawicel.dpr ********************* diff --git a/Host/Source/MicroBoot/interfaces/can/lawicel/openblt_can_lawicel.dproj b/Host/Source/MicroBoot/interfaces/can/lawicel/openblt_can_lawicel.dproj new file mode 100644 index 00000000..b0ce97ec --- /dev/null +++ b/Host/Source/MicroBoot/interfaces/can/lawicel/openblt_can_lawicel.dproj @@ -0,0 +1,119 @@ + + + {C587575B-3E1C-4EA4-BB4F-912B83127DCE} + openblt_can_lawicel.dpr + True + Debug + 1 + Library + VCL + 18.1 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + ../../../../../ + openblt_can_lawicel + 1 + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) + 00400000 + 1 + false + false + false + true + Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40;$(DCC_UsePackage) + true + 1031 + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + 1 + false + + + System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + true + 1033 + + + RELEASE;$(DCC_Define) + 0 + false + 0 + + + true + DEBUG;$(DCC_Define) + false + + + C:\Work\software\OpenBLT\Host\MicroBoot.exe + true + (None) + 1033 + + + + MainSource + + + + + + + +
XcpSettingsForm
+ + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + + + + + openblt_can_lawicel.dpr + + + + True + + + 12 + + + + diff --git a/Host/openblt_can_lawicel.dll b/Host/openblt_can_lawicel.dll new file mode 100644 index 00000000..c5c75fbf Binary files /dev/null and b/Host/openblt_can_lawicel.dll differ diff --git a/Host/openblt_can_lawicel.ini b/Host/openblt_can_lawicel.ini new file mode 100644 index 00000000..a0c9bdec --- /dev/null +++ b/Host/openblt_can_lawicel.ini @@ -0,0 +1,15 @@ +[can] +hardware=0 +channel=0 +baudrate=2 +extended=0 +txid=1639 +rxid=2017 +[xcp] +seedkey=FeaserKey.dll +t1=1000 +t3=2000 +t4=10000 +t5=1000 +t7=2000 +tconnect=20