sysmocom
/
openblt
11
0
Fork 0
Code Issues Pull Requests Releases Activity

Refs #319. Merged the new cross-platform MicroBoot version 2.0 from the development branch into the trunk. 

git-svn-id: https://svn.code.sf.net/p/openblt/code/trunk@477 5dc33758-31d5-4daf-9ae8-b24bf3d40d73
This commit is contained in:
Frank Voorburg 2018-04-13 13:53:30 +00:00
parent 3336887939
commit b7cc72f9f4
94 changed files with 7592 additions and 21927 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
Host/MicroBoot.exe
View File

Binary file not shown.

BIN
Host/PCANBasic.dll
View File

Binary file not shown.

11
Host/Source/LibOpenBLT/bindings/pascal/openblt.pas
View File

@ -73,7 +73,11 @@ const
// Transport layer for the XCP v1.0 protocol that uses Controller Area Network (CAN)
// for data exchange.
BLT_TRANSPORT_XCP_V10_CAN: LongWord = 1;
// Transport layer for the XCP v1.0 protocol that uses USB for data exchange.
BLT_TRANSPORT_XCP_V10_USB: LongWord = 2;
// Transport layer for the XCP v1.0 protocol that uses TCP/IP for data exchange.
BLT_TRANSPORT_XCP_V10_NET: LongWord = 3;
type
// Structure layout of the XCP version 1.0 session settings.
@ -103,6 +107,13 @@ type
useExtended: LongWord; // Boolean to configure 29-bit CAN identifiers.
end;
// Structure layout of the XCP version 1.0 NET transport layer settings.
tBltTransportSettingsXcpV10Net = record
address: PAnsiChar; // Target IP-address or hostname on the network.
port: Word; // TCP port to use.
end;
procedure BltSessionInit(sessionType: LongWord;
sessionSettings: Pointer;
transportType: LongWord;

BIN
Host/Source/MicroBoot/MainUnit.dfm
View File

Binary file not shown.

801
Host/Source/MicroBoot/MainUnit.pas
View File

@ -1,801 +0,0 @@
unit MainUnit;
//***************************************************************************************
// Project Name: MicroBoot for Borland Delphi
// Description: Contains the GUI for MicroBoot
// File Name: MainUnit.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2011 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,
ExtCtrls, StdCtrls, Menus, ComCtrls, uBootInterface, Registry, SettingsUnit, StopWatch;
//***************************************************************************************
// Type Definitions
//***************************************************************************************
type
TmainForm = class(TForm)
pnlHeader: TPanel;
imgHeader: TImage;
lblAppName: TLabel;
lblInterfaceName: TLabel;
bvlFooter: TBevel;
btnCancel: TButton;
btnSettings: TButton;
ntbPages: TNotebook;
edtDownloadFile: TEdit;
btnBrowse: TButton;
lblDownloadFile: TLabel;
prgDownload: TProgressBar;
lblDownloadProgress: TLabel;
OpenDialog: TOpenDialog;
Timer: TTimer;
lblElapsedTime: TLabel;
procedure btnCancelClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btnBrowseClick(Sender: TObject);
procedure btnSettingsClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TimerTimer(Sender: TObject);
procedure edtDownloadFileKeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
MbiLogging : Boolean;
MbiLibFile : ShortString;
MbiInterfaced : Boolean;
MbiInterface : TMicroBootInterface;
LogLines : TStrings;
ExePath : string;
StopWatch : TStopWatch;
StayOpen : Boolean;
FormCaption : string;
DownloadInProgress: Boolean;
procedure OnMbiStarted(length: Longword);
procedure OnMbiProgress(progress: Longword);
procedure OnMbiDone;
procedure OnMbiError(error: ShortString);
procedure OnMbiLog(info: ShortString);
procedure OnMbiInfo(info: ShortString);
procedure StartFileDownload(fileName : ShortString);
procedure UpdateInterfaceLabel;
procedure ResetUserInterface;
public
{ Public declarations }
function IsMbiInterface(libFile : string) : Boolean;
function GetMbiInfoString(libFile : string) : string;
function GetActiveMbi : string;
procedure SetActiveMbi(libFile : string);
procedure ConfigureMbi;
procedure GetInterfaceFileList(fileList : TStrings);
end;
//***************************************************************************************
// Global Variables
//***************************************************************************************
var
mainForm: TmainForm;
implementation
{$R *.DFM}
//***************************************************************************************
// NAME: OnMbiStarted
// PARAMETER: length of the download in bytes.
// RETURN VALUE: none
// DESCRIPTION: Called by the Mbi interface DLL after successfully starting a down-
// load. The value of the length parameter can be used to set the max
// value of the progress bar.
//
//***************************************************************************************
procedure TmainForm.OnMbiStarted(length: Longword);
begin
prgDownload.Max := length; // set max length for progress bar
lblElapsedTime.Caption := 'Elapsed time: ' + StopWatch.Interval;
StopWatch.Start; // start the stopwatch
Timer.Enabled := true; // start the timer to update the stopwatch interval display
end; //*** end of OnMbiStarted ***
//***************************************************************************************
// NAME: OnMbiProgress
// PARAMETER: number of already downloaded bytes.
// RETURN VALUE: none
// DESCRIPTION: Called by the Mbi interface DLL to provide us with an update on the
// download progress. The progress parameter can be used to update the
// position of the progress bar.
//
//***************************************************************************************
procedure TmainForm.OnMbiProgress(progress: Longword);
begin
prgDownload.Position := progress; // update the progress bar
prgDownload.Position := progress-1; // fix for progress bar not going to 100%
prgDownload.Position := progress; // update the progress bar
end; //*** end of OnMbiProgress ***
//***************************************************************************************
// NAME: OnMbiDone
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Called by the Mbi interface DLL when a download was successfully
// completed.
//
//***************************************************************************************
procedure TmainForm.OnMbiDone;
begin
DownloadInProgress := False; // reset flag
Timer.Enabled := false; // stop the timer
StopWatch.Stop; // stop the stopwatch
mainForm.Caption := FormCaption; // restore caption
if StayOpen then
ResetUserInterface // reset the user interface to allow a new download to be started
else
Close; // done so close the application
end; //*** end of OnMbiDone ***
//***************************************************************************************
// NAME: OnMbiError
// PARAMETER: additional info on the error that occurred in string format.
// RETURN VALUE: none
// DESCRIPTION: Called by the Mbi interface DLL in case an error occurred. The para-
// meter contains more information on the error.
//
//***************************************************************************************
procedure TmainForm.OnMbiError(error: ShortString);
begin
DownloadInProgress := False; // reset flag
ShowMessage(String(error)); // display error
Timer.Enabled := false; // stop the timer
StopWatch.Stop; // stop the stopwatch
mainForm.Caption := FormCaption; // restore caption
ResetUserInterface; // download failed so reset user interface for retry
end; //*** end of OnMbiError ***
//***************************************************************************************
// NAME: OnMbiLog
// PARAMETER: info on the log event in string format.
// RETURN VALUE: none
// DESCRIPTION: Called by the Mbi interface DLL in case info for logging purpose
// was made available by the DLL.
//
//***************************************************************************************
procedure TmainForm.OnMbiLog(info: ShortString);
begin
if MbiLogging = True then
begin
LogLines.Add(String(info)); // add to log
end;
end; //*** end of OnMbiLog ***
//***************************************************************************************
// NAME: OnMbiInfo
// PARAMETER: details on the info event in string format.
// RETURN VALUE: none
// DESCRIPTION: Called by the Mbi interface DLL in case details for info purposes
// were made available by the DLL.
//
//***************************************************************************************
procedure TmainForm.OnMbiInfo(info: ShortString);
begin
if NtbPages.PageIndex = 1 then
lblDownloadProgress.Caption := String(info);
end; //*** end of OnMbiLog ***
//***************************************************************************************
// NAME: GetActiveMbi
// PARAMETER: none
// RETURN VALUE: filename with full path
// DESCRIPTION: Returns the file name with full path of the active Mbi interface
// library
//
//***************************************************************************************
function TmainForm.GetActiveMbi : string;
begin
if IsMbiInterface(String(MbiLibFile)) then
Result := String(MbiLibFile)
else
Result := '';
end; //*** end of GetActiveMbi ***
//***************************************************************************************
// NAME: SetActiveMbi
// PARAMETER: filename with full path
// RETURN VALUE: none
// DESCRIPTION: Enables the Mbi interface library that is specified as the parameter.
//
//***************************************************************************************
procedure TmainForm.SetActiveMbi(libFile : string);
begin
MbiInterfaced := false; // reset
if IsMbiInterface(libFile) then
begin
MbiLibFile := ShortString(libFile);
MbiInterfaced := MbiInterface.Enable(libFile, OnMbiStarted, OnMbiProgress,
OnMbiDone, OnMbiError, OnMbiLog, OnMbiInfo);
end;
UpdateInterfaceLabel;
end; //*** end of SetActiveMbi ***
//***************************************************************************************
// NAME: ConfigureMbi
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Submits request to the Mbi interface library for the user to configure
// the interface.
//
//***************************************************************************************
procedure TmainForm.ConfigureMbi;
begin
if MbiInterfaced = True then
begin
MbiInterface.Configure;
end;
end; //*** end of ConfigureMbi ***
//***************************************************************************************
// NAME: IsMbiInterface
// PARAMETER: filename with full path of the Mbi interface DLL
// RETURN VALUE: true if it is a valid Mbi interface DLL, otherwise false
// DESCRIPTION: Called to check whether a specified interface DLL is truly an Mbi
// interface DLL.
//
//***************************************************************************************
function TmainForm.IsMbiInterface(libFile : string) : Boolean;
var
LibHandle : THandle;
LibValid : Boolean;
begin
LibValid := False;
// make sure the file exists
if FileExists(libFile) then
begin
// make sure it is a DLL file
if LowerCase(ExtractFileExt(libFile)) = '.dll' then
begin
// make sure the DLL file is a microBoot interface library
LibHandle := LoadLibrary(PChar(ExtractShortPathName(libFile))); // get handle
if LibHandle <> 0 then
begin
if GetProcAddress(LibHandle, 'MbiInit') <> nil then
begin
LibValid := True;
FreeLibrary(LibHandle);
end;
end;
end;
end;
Result := LibValid;
end;
//*** end of IsMbiInterface ***
//***************************************************************************************
// NAME: GetMbiInfoString
// PARAMETER: filename with full path of the Mbi interface DLL
// RETURN VALUE: string that described the name and version of the Mbi interface DLL
// DESCRIPTION: Used to obtain a string that describes the Mbi interface DLL.
//
//***************************************************************************************
function TmainForm.GetMbiInfoString(libFile : string) : string;
var
LibHandle : THandle;
DescriptionFnc : TDllMbiDescription;
VersionFnc : TDllMbiVersion;
Major : integer;
Minor : integer;
Bugfix : integer;
begin
Result := '';
// make sure the file is a valid Mbi interface library
if IsMbiInterface(libFile) then
begin
LibHandle := LoadLibrary(PChar(ExtractShortPathName(libFile))); // get handle
if LibHandle <> 0 then
begin
// obtain DLL function pointers
@DescriptionFnc := GetProcAddress(LibHandle, 'MbiDescription');
@VersionFnc := GetProcAddress(LibHandle, 'MbiVersion');
if Assigned(DescriptionFnc) then
begin
Result := Result + String(DescriptionFnc);
end;
if Assigned(VersionFnc) then
begin
// split up version numbers
Major := VersionFnc div 10000;
Minor := (versionFnc mod 10000) div 100;
Bugfix := (versionFnc mod 100);
Result := Result + ' (' + Format('v%d.%2.2d.%2.2d', [Major, Minor, Bugfix]) + ')';
end;
FreeLibrary(LibHandle);
end;
end;
end; //*** end of GetMbiInfoString ***
//***************************************************************************************
// NAME: GetInterfaceFileList
// PARAMETER: string list where filelist will be stored
// RETURN VALUE: none
// DESCRIPTION: Searches all the DLL files in the directory where the program's EXE
// runs from. If the found DLL file is a valib Mbi interface library,
// then it is added to the list.
//
//***************************************************************************************
procedure TmainForm.GetInterfaceFileList(fileList : TStrings);
var
SR : TSearchRec;
begin
// search all dll's in the applicatioin's directory
fileList.BeginUpdate;
if FindFirst(ExePath + '*.dll', faAnyFile, SR) = 0 then
begin
repeat
if (SR.Attr <> faDirectory) then
begin
if IsMbiInterface(ExePath + SR.Name) = True then
fileList.Add(SR.Name);
end;
until FindNext(SR) <> 0;
FindClose(SR);
end;
fileList.EndUpdate;
end; //*** end of GetInterfaceFileList ***
//***************************************************************************************
// NAME: StartFileDownload
// PARAMETER: file that is to be downloaded
// RETURN VALUE: none
// DESCRIPTION: Initiates the file download. The file is verified for existence and if
// all is okay, the next page is shown and the download is started.
//
//***************************************************************************************
procedure TmainForm.StartFileDownload(fileName : ShortString);
begin
if FileExists(String(fileName)) and (MbiInterfaced = True) then
begin
mainForm.Caption := FormCaption + ' - Downloading ' +
ExtractFileName(String(fileName)) + '...';
prgDownload.Position := 0; // reset the progress bar
NtbPages.PageIndex := 1; // go to the next page
btnSettings.Enabled := false; // settings can't be changed anymore
btnCancel.Caption := 'Cancel'; // change caption to cancel download
DownloadInProgress := True; // set flag
MbiInterface.Download(fileName);
end;
end; //*** end of StartFileDownload ***
//***************************************************************************************
// NAME: UpdateInterfaceLabel
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Updates the interface label caption based on the active Mbi interface
// library
//
//***************************************************************************************
procedure TmainForm.UpdateInterfaceLabel;
begin
// display interface library description
if MbiInterfaced = True then
begin
lblInterfaceName.Caption := 'for ' + String(MbiInterface.Description);
end
else
begin
lblInterfaceName.Caption := 'Error - No Interface Library Loaded';
end;
end; //*** end of UpdateInterfaceLabel ***
//***************************************************************************************
// NAME:
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Resets the user interface to the default state, which is the state
// when the program is started for the first time.
//
//***************************************************************************************
procedure TmainForm.ResetUserInterface;
begin
// stop the timer
Timer.Enabled := False;
// stop the stopwatch
StopWatch.Stop;
// restore form caption
mainForm.Caption := FormCaption;
// clear download file
edtDownloadFile.Text := '';
// go to the default page
NtbPages.PageIndex := 0;
// enable settings button
btnSettings.Enabled := True;
// change caption to exit program
btnCancel.Caption := 'Exit';
// empty elapsted time label
lblElapsedTime.Caption := '';
end; //*** end of ResetUserInterface ***
//***************************************************************************************
// NAME: btnCancelClick
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Exits the application
//
//***************************************************************************************
procedure TmainForm.btnCancelClick(Sender: TObject);
begin
// pass on cancel request to the library
if MbiInterfaced = True then
begin
MbiInterface.Cancel;
end;
// no download in progress so just close the program
if not DownloadInProgress then
begin
Close;
end
end; //*** end of btnCancelClick ***
//***************************************************************************************
// NAME: FormCreate
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Initializes all the class properties and attempts to search and enable
// the Mbi interface library.
//
//***************************************************************************************
procedure TmainForm.FormCreate(Sender: TObject);
var
cnt : integer;
foundInterface : boolean;
foundLibrary : string;
winRegistry : TRegistry;
libFileList : TStrings;
begin
btnCancel.Caption := 'Exit'; // change caption to exit program
DownloadInProgress := False; // init flag
FormCaption := mainForm.Caption; // backup original caption
LogLines := TStringList.Create;
StayOpen := false;
MbiLogging := false;
MbiInterfaced := false; // Mbi interface not enabled at startup
MbiLibFile := ''; // reset lib file
MbiInterface := TMicroBootInterface.Create(Self); // create instance
foundInterface := false; // init before searching
ExePath := ExtractFilePath(Application.ExeName);
// determine if logging should be enabled
if (ParamCount > 0) then
begin
// no options will be in Param 0
for cnt := 1 to ParamCount do
begin
// look for -l option
if System.Pos('-l', ParamStr(cnt)) > 0 then
begin
MbiLogging := True;
end;
end;
end;
// determine if tool should stay open after a download completion
if (ParamCount > 0) then
begin
// no options will be in Param 0
for cnt := 1 to ParamCount do
begin
// look for -s option
if System.Pos('-s', ParamStr(cnt)) > 0 then
begin
StayOpen := True;
end;
end;
end;
// determine what interface library to use on startup
// 1) -------- From commandline parameter ---------------
foundLibrary := '';
// parameters okay, now extract the command line options if any
if (ParamCount > 0) then
begin
// no options will be in Param 0
for cnt := 1 to ParamCount do
begin
// look for -i option
if System.Pos('-i', ParamStr(cnt)) > 0 then
begin
foundLibrary := ExePath + System.Copy(ParamStr(cnt),
System.Pos('-i', ParamStr(cnt))+2, Length(ParamStr(cnt)));
end;
end;
end;
// interface library specified on the commandline?
if foundLibrary <> '' then
begin
// is it a valid Mbi interface library?
if IsMbiInterface(foundLibrary) = True then
begin
MbiLibFile := ShortString(foundLibrary);
foundInterface := True;
end;
end;
// 2) -------- From registry ---------------
if not foundInterface then
begin
// open registry key
winRegistry := TRegistry.Create;
winRegistry.RootKey := HKEY_CURRENT_USER;
winRegistry.OpenKeyReadOnly('Software\Feaser\MicroBoot');
// attempt to read out the stored interface filename (without path)
if winRegistry.ReadString('Interface') <> '' then
begin
// obtain the interface library file name from the registry key
foundLibrary := ExePath + winRegistry.ReadString('Interface');
// is it a valid Mbi interface library?
if IsMbiInterface(foundLibrary) = True then
begin
MbiLibFile := ShortString(foundLibrary);
foundInterface := True;
end;
end;
winRegistry.Free; // registry access no longer needed
end;
// 3) -------- first interface library found ---------------
if not foundInterface then
begin
libFileList := TStringList.Create;
libFileList.Clear;
GetInterfaceFileList(libFileList);
if libFileList.Count > 0 then
begin
foundLibrary := ExePath + libFileList.Strings[0];
// is it a valid Mbi interface library?
if IsMbiInterface(foundLibrary) = True then
begin
MbiLibFile := ShortString(foundLibrary);
foundInterface := True;
end;
end;
libFileList.Free;
end;
// did we find a Mbi interface library?
if foundInterface = True then
begin
SetActiveMbi(String(MbiLibFile));
end;
// create the stopwatch timer
StopWatch := TStopWatch.Create;
end; //*** end of FormCreate ***
//***************************************************************************************
// NAME: FormDestroy
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: DeInitializes all the class properties that where instanciated.
//
//***************************************************************************************
procedure TmainForm.FormDestroy(Sender: TObject);
begin
MbiInterface.Free; // release the interface
LogLines.Free;
// release the stopwatch timer
StopWatch.Free;
end; //*** end of FormDestroy ***
//***************************************************************************************
// NAME: FormShow
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Loads and displays the interface library description. If a valid
// download file is selected as a command line parameter the download
// is started right away. If the -p command line parameter was specified,
// then the open file dialog is displayed automatically.
//
//***************************************************************************************
procedure TmainForm.FormShow(Sender: TObject);
var
cnt : integer;
begin
UpdateInterfaceLabel;
// was an existing download file specified as a command line param?
if (ParamCount > 0) and (FileExists(ParamStr(ParamCount))) then
begin
edtDownloadFile.Text := ParamStr(ParamCount);
StartFileDownload(ShortString(ParamStr(ParamCount)));
Exit; // nothing more todo
end;
// was the -p command line option specified?
// parameters okay, now extract the command line options if any
if (ParamCount > 0) then
begin
// no options will be in Param 0
for cnt := 1 to ParamCount do
begin
// look for -p option
if System.Pos('-p', ParamStr(cnt)) > 0 then
begin
if OpenDialog.Execute then
begin
if FileExists(OpenDialog.FileName) then
begin
edtDownloadFile.Text := OpenDialog.FileName;
StartFileDownload(ShortString(OpenDialog.FileName));
end;
end;
end;
end;
end;
end; //*** end of FormShow ***
//***************************************************************************************
// NAME: btnBrowseClick
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Prompts the user to select a file to download.
//
//***************************************************************************************
procedure TmainForm.btnBrowseClick(Sender: TObject);
begin
if OpenDialog.Execute then
begin
if FileExists(OpenDialog.FileName) then
begin
edtDownloadFile.Text := OpenDialog.FileName;
StartFileDownload(ShortString(OpenDialog.FileName));
end;
end;
end; //*** end of btnBrowseClick ***
//***************************************************************************************
// NAME: btnSettingsClick
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Opens the settings form where the user can select and configure the
// Mbi interface library.
//
//***************************************************************************************
procedure TmainForm.btnSettingsClick(Sender: TObject);
var
winRegistry : TRegistry;
begin
if SettingsForm.ShowModal = mrOK then
begin
if MbiInterfaced then
begin
// store last used library in register
winRegistry := TRegistry.Create;
winRegistry.RootKey := HKEY_CURRENT_USER;
winRegistry.OpenKey('Software\Feaser\MicroBoot', true);
winRegistry.WriteString('Interface', ExtractFileName(String(MbiLibFile)));
winRegistry.Free;
end;
UpdateInterfaceLabel;
end;
end; //*** end of btnSettingsClick ***
//***************************************************************************************
// NAME: FormClose
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Saves the log to a file before closing the application.
//
//***************************************************************************************
procedure TmainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// save the log to a file before closing the app
if MbiLogging = True then
begin
LogLines.SaveToFile(ExePath + 'log.txt');
end;
// pass on cancel request to the library if a download is in progress
if MbiInterfaced = True then
begin
MbiInterface.Cancel;
end;
end; //*** end of FormClose ***
//***************************************************************************************
// NAME: TimeTimer
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Timer event handler to update stopwatch info
//
//***************************************************************************************
procedure TmainForm.TimerTimer(Sender: TObject);
begin
lblElapsedTime.Caption := 'Elapsed time: ' + StopWatch.Interval;
end; //*** end of TimerTimer ***
procedure TmainForm.edtDownloadFileKeyPress(Sender: TObject;
var Key: Char);
begin
// filter out enter key
if key = #13 then
begin
// ignore further enter key processing
key := #0;
// start the download
if FileExists(edtDownloadFile.Text) then
begin
StartFileDownload(ShortString(edtDownloadFile.Text));
end;
end;
end;
end.
//******************************** end of MainUnit.pas **********************************

136
Host/Source/MicroBoot/MicroBoot.dproj
View File

@ -1,136 +0,0 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{DF84500F-F9C3-464D-AB96-10E57464FFB5}</ProjectGuid>
<MainSource>MicroBoot.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Application</AppType>
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>18.1</ProjectVersion>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
<Cfg_1_Win32>true</Cfg_1_Win32>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
<Cfg_2_Win32>true</Cfg_2_Win32>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_E>false</DCC_E>
<DCC_K>false</DCC_K>
<DCC_F>false</DCC_F>
<DCC_DebugInformation>1</DCC_DebugInformation>
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win;$(DCC_Namespace)</DCC_Namespace>
<DCC_ImageBase>00400000</DCC_ImageBase>
<SanitizedProjectName>MicroBoot</SanitizedProjectName>
<DCC_SymbolReferenceInfo>1</DCC_SymbolReferenceInfo>
<DCC_N>true</DCC_N>
<DCC_S>false</DCC_S>
<DCC_ExeOutput>../../</DCC_ExeOutput>
<DCC_Alignment>1</DCC_Alignment>
<DCC_WriteableConstants>true</DCC_WriteableConstants>
<VerInfo_Locale>1031</VerInfo_Locale>
<DCC_UsePackage>Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40;$(DCC_UsePackage)</DCC_UsePackage>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
<DCC_Namespace>Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Locale>1033</VerInfo_Locale>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_DebugInformation>0</DCC_DebugInformation>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<VerInfo_Locale>1033</VerInfo_Locale>
<Icon_MainIcon>MicroBoot.ico</Icon_MainIcon>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<AppEnableHighDPI>true</AppEnableHighDPI>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_Optimize>false</DCC_Optimize>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<VerInfo_MinorVer>3</VerInfo_MinorVer>
<VerInfo_Keys>CompanyName=Feaser;FileDescription=PC download tool for the OpenBLT bootloader;FileVersion=1.3.0.0;InternalName=;LegalCopyright=Feaser;LegalTrademarks=;OriginalFilename=;ProductName=MicroBoot;ProductVersion=1.3.0.0;Comments=</VerInfo_Keys>
<AppEnableHighDPI>true</AppEnableHighDPI>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<VerInfo_Locale>1033</VerInfo_Locale>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<Icon_MainIcon>MicroBoot.ico</Icon_MainIcon>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="MainUnit.pas">
<Form>mainForm</Form>
</DCCReference>
<DCCReference Include="SettingsUnit.pas">
<Form>settingsForm</Form>
</DCCReference>
<DCCReference Include="StopWatch.pas"/>
<DCCReference Include="uBootInterface.pas"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">MicroBoot.dpr</Source>
</Source>
</Delphi.Personality>
<Platforms>
<Platform value="Win32">True</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
</Project>

273
Host/Source/MicroBoot/MicroBoot.lpi Normal file
View File

@ -0,0 +1,273 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="10"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="MicroBoot"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="3">
<Item1 Name="Default" Default="True"/>
<Item2 Name="Debug">
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="../../MicroBoot"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="../LibOpenBLT/bindings/pascal;../.."/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<IOChecks Value="True"/>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
<VerifyObjMethodCallValidity Value="True"/>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf2Set"/>
<TrashVariables Value="True"/>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<Options>
<PassLinkerOptions Value="True"/>
<LinkerOptions Value="-R ./"/>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CustomOptions Value="-dUseCThreads"/>
<OtherDefines Count="1">
<Define0 Value="UseCThreads"/>
</OtherDefines>
</Other>
</CompilerOptions>
</Item2>
<Item3 Name="Release">
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="../../MicroBoot"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="../LibOpenBLT/bindings/pascal;../.."/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
</Debugging>
<LinkSmart Value="True"/>
<Options>
<PassLinkerOptions Value="True"/>
<LinkerOptions Value="-R ./"/>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerMessages>
<IgnoredMessages idx5058="True" idx5036="True"/>
</CompilerMessages>
<CustomOptions Value="-dUseCThreads"/>
<OtherDefines Count="1">
<Define0 Value="UseCThreads"/>
</OtherDefines>
</Other>
</CompilerOptions>
</Item3>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="16">
<Unit0>
<Filename Value="MicroBoot.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="mainunit.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="MainUnit"/>
</Unit1>
<Unit2>
<Filename Value="../LibOpenBLT/bindings/pascal/openblt.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="OpenBlt"/>
</Unit2>
<Unit3>
<Filename Value="currentconfig.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="CurrentConfig"/>
</Unit3>
<Unit4>
<Filename Value="configgroups.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ConfigGroups"/>
</Unit4>
<Unit5>
<Filename Value="settingsdialog.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="SettingsForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="SettingsDialog"/>
</Unit5>
<Unit6>
<Filename Value="sessionxcpdialog.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="SessionXcpForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="SessionXcpDialog"/>
</Unit6>
<Unit7>
<Filename Value="customutil.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="CustomUtil"/>
</Unit7>
<Unit8>
<Filename Value="transportxcprs232dialog.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="TransportXcpRs232Form"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="TransportXcpRs232Dialog"/>
</Unit8>
<Unit9>
<Filename Value="transportxcpcandialog.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="TransportXcpCanForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="TransportXcpCanDialog"/>
</Unit9>
<Unit10>
<Filename Value="transportxcpusbdialog.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="TransportXcpUsbForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="TransportXcpUsbDialog"/>
</Unit10>
<Unit11>
<Filename Value="transportxcptcpipdialog.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="TransportXcpTcpIpForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="TransportXcpTcpIpDialog"/>
</Unit11>
<Unit12>
<Filename Value="miscellaneousdialog.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MiscellaneousForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="MiscellaneousDialog"/>
</Unit12>
<Unit13>
<Filename Value="firmwareupdate.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="FirmwareUpdate"/>
</Unit13>
<Unit14>
<Filename Value="stopwatch.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="StopWatch"/>
</Unit14>
<Unit15>
<Filename Value="filelogger.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="FileLogger"/>
</Unit15>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="../../MicroBoot"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="../LibOpenBLT/bindings/pascal;../.."/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Options>
<PassLinkerOptions Value="True"/>
<LinkerOptions Value="-R ./"/>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CustomOptions Value="-dUseCThreads"/>
<OtherDefines Count="1">
<Define0 Value="UseCThreads"/>
</OtherDefines>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

110
Host/Source/MicroBoot/MicroBoot.dpr → Host/Source/MicroBoot/MicroBoot.lpr
View File

@ -1,51 +1,59 @@
program MicroBoot;
//***************************************************************************************
// Project Name: MicroBoot for Borland Delphi
// Description: Contains the main program entry
// File Name: MicroBoot.dpr
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2011 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.
//
//***************************************************************************************
uses
Forms,
MainUnit in 'MainUnit.pas' {mainForm},
SettingsUnit in 'SettingsUnit.pas' {settingsForm},
StopWatch in 'StopWatch.pas',
uBootInterface in 'uBootInterface.pas';
{$R *.RES}
begin
Application.Initialize;
Application.Title := 'MicroBoot';
Application.CreateForm(TmainForm, mainForm);
Application.CreateForm(TsettingsForm, settingsForm);
Application.Run;
end.
//******************************** end of MicroBoot.dpr *********************************
program MicroBoot;
//***************************************************************************************
// Description: Contains the main program entry.
// File Name: MicroBoot.lpr
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2018 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.
//
//***************************************************************************************
{$IFDEF FPC}
{$MODE objfpc}{$H+}
{$ENDIF}
//***************************************************************************************
// Includes
//***************************************************************************************
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
cmem, // the c memory manager is on some systems much faster for multi-threading
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, MainUnit, CurrentConfig, ConfigGroups, SettingsDialog,
SessionXcpDialog, CustomUtil, TransportXcpTcpIpDialog, MiscellaneousDialog,
FirmwareUpdate, StopWatch, FileLogger
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.
//******************************** end of MicroBoot.lpr *********************************

415
Host/Source/MicroBoot/MicroBoot.lps Normal file
View File

@ -0,0 +1,415 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<Version Value="9"/>
<BuildModes Active="Release"/>
<Units Count="32">
<Unit0>
<Filename Value="MicroBoot.lpr"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="9"/>
<CursorPos X="40" Y="47"/>
<UsageCount Value="87"/>
</Unit0>
<Unit1>
<Filename Value="mainunit.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="MainUnit"/>
<TopLine Value="291"/>
<CursorPos X="11" Y="296"/>
<UsageCount Value="87"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="../LibOpenBLT/bindings/pascal/openblt.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="OpenBlt"/>
<EditorIndex Value="-1"/>
<TopLine Value="53"/>
<CursorPos Y="80"/>
<UsageCount Value="87"/>
</Unit2>
<Unit3>
<Filename Value="currentconfig.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="CurrentConfig"/>
<EditorIndex Value="-1"/>
<TopLine Value="17"/>
<CursorPos Y="34"/>
<UsageCount Value="87"/>
</Unit3>
<Unit4>
<Filename Value="configgroups.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ConfigGroups"/>
<EditorIndex Value="-1"/>
<TopLine Value="27"/>
<CursorPos X="52" Y="103"/>
<UsageCount Value="84"/>
</Unit4>
<Unit5>
<Filename Value="settingsdialog.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="SettingsForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="SettingsDialog"/>
<EditorIndex Value="-1"/>
<TopLine Value="252"/>
<CursorPos Y="278"/>
<UsageCount Value="79"/>
</Unit5>
<Unit6>
<Filename Value="sessionxcpdialog.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="SessionXcpForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="SessionXcpDialog"/>
<EditorIndex Value="-1"/>
<TopLine Value="114"/>
<CursorPos X="43" Y="127"/>
<UsageCount Value="76"/>
</Unit6>
<Unit7>
<Filename Value="customutil.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="CustomUtil"/>
<EditorIndex Value="-1"/>
<TopLine Value="51"/>
<CursorPos X="28" Y="76"/>
<UsageCount Value="69"/>
</Unit7>
<Unit8>
<Filename Value="transportxcprs232dialog.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="TransportXcpRs232Form"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="TransportXcpRs232Dialog"/>
<EditorIndex Value="-1"/>
<TopLine Value="14"/>
<CursorPos X="47" Y="34"/>
<UsageCount Value="62"/>
</Unit8>
<Unit9>
<Filename Value="transportxcpcandialog.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="TransportXcpCanForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="TransportXcpCanDialog"/>
<EditorIndex Value="-1"/>
<TopLine Value="212"/>
<CursorPos X="75" Y="239"/>
<UsageCount Value="62"/>
</Unit9>
<Unit10>
<Filename Value="transportxcpusbdialog.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="TransportXcpUsbForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="TransportXcpUsbDialog"/>
<EditorIndex Value="-1"/>
<TopLine Value="25"/>
<CursorPos Y="50"/>
<UsageCount Value="62"/>
</Unit10>
<Unit11>
<Filename Value="transportxcptcpipdialog.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="TransportXcpTcpIpForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="TransportXcpTcpIpDialog"/>
<EditorIndex Value="-1"/>
<TopLine Value="26"/>
<CursorPos Y="49"/>
<UsageCount Value="61"/>
</Unit11>
<Unit12>
<Filename Value="miscellaneousdialog.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MiscellaneousForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="MiscellaneousDialog"/>
<EditorIndex Value="-1"/>
<TopLine Value="152"/>
<CursorPos X="56" Y="57"/>
<UsageCount Value="51"/>
</Unit12>
<Unit13>
<Filename Value="firmwareupdate.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="FirmwareUpdate"/>
<EditorIndex Value="1"/>
<TopLine Value="1032"/>
<CursorPos X="58" Y="1044"/>
<UsageCount Value="49"/>
<Bookmarks Count="1">
<Item0 X="23" Y="995" ID="1"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit13>
<Unit14>
<Filename Value="stopwatch.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="StopWatch"/>
<EditorIndex Value="-1"/>
<TopLine Value="57"/>
<CursorPos Y="67"/>
<UsageCount Value="27"/>
</Unit14>
<Unit15>
<Filename Value="filelogger.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="FileLogger"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="2"/>
<TopLine Value="134"/>
<CursorPos X="19" Y="140"/>
<UsageCount Value="24"/>
<Loaded Value="True"/>
</Unit15>
<Unit16>
<Filename Value="/usr/share/fpcsrc/3.0.0/rtl/objpas/sysutils/osutilsh.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="7"/>
<CursorPos X="10" Y="43"/>
<UsageCount Value="10"/>
</Unit16>
<Unit17>
<Filename Value="/usr/share/fpcsrc/3.0.0/rtl/unix/sysutils.pp"/>
<EditorIndex Value="-1"/>
<TopLine Value="82"/>
<CursorPos X="68"/>
<UsageCount Value="10"/>
</Unit17>
<Unit18>
<Filename Value="/usr/share/fpcsrc/3.0.0/rtl/objpas/sysutils/sysutilh.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="130"/>
<CursorPos X="22" Y="171"/>
<UsageCount Value="10"/>
</Unit18>
<Unit19>
<Filename Value="/usr/share/fpcsrc/3.0.0/rtl/objpas/fgl.pp"/>
<EditorIndex Value="-1"/>
<UsageCount Value="10"/>
</Unit19>
<Unit20>
<Filename Value="/usr/lib/lazarus/1.6.2/lcl/forms.pp"/>
<UnitName Value="Forms"/>
<EditorIndex Value="-1"/>
<TopLine Value="591"/>
<CursorPos X="14" Y="614"/>
<UsageCount Value="10"/>
</Unit20>
<Unit21>
<Filename Value="/usr/lib/lazarus/1.6.2/lcl/controls.pp"/>
<UnitName Value="Controls"/>
<EditorIndex Value="-1"/>
<TopLine Value="144"/>
<CursorPos X="3" Y="169"/>
<UsageCount Value="10"/>
</Unit21>
<Unit22>
<Filename Value="/usr/lib/lazarus/1.6.2/lcl/lcltype.pp"/>
<UnitName Value="LCLType"/>
<EditorIndex Value="-1"/>
<TopLine Value="41"/>
<CursorPos X="3" Y="66"/>
<UsageCount Value="10"/>
</Unit22>
<Unit23>
<Filename Value="/usr/share/fpcsrc/3.0.0/packages/rtl-objpas/src/inc/strutils.pp"/>
<EditorIndex Value="-1"/>
<TopLine Value="9"/>
<CursorPos X="65" Y="31"/>
<UsageCount Value="10"/>
</Unit23>
<Unit24>
<Filename Value="/usr/lib/lazarus/1.6.2/lcl/include/control.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="3243"/>
<CursorPos Y="3268"/>
<UsageCount Value="10"/>
</Unit24>
<Unit25>
<Filename Value="/usr/share/fpcsrc/3.0.0/rtl/objpas/classes/classesh.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="1619"/>
<CursorPos X="17" Y="1643"/>
<UsageCount Value="10"/>
</Unit25>
<Unit26>
<Filename Value="/usr/lib/lazarus/1.6.2/lcl/extctrls.pp"/>
<UnitName Value="ExtCtrls"/>
<EditorIndex Value="-1"/>
<TopLine Value="127"/>
<CursorPos X="3" Y="182"/>
<UsageCount Value="10"/>
</Unit26>
<Unit27>
<Filename Value="/usr/lib/lazarus/1.6.2/lcl/customtimer.pas"/>
<UnitName Value="CustomTimer"/>
<EditorIndex Value="-1"/>
<TopLine Value="25"/>
<CursorPos X="3" Y="29"/>
<UsageCount Value="10"/>
</Unit27>
<Unit28>
<Filename Value="/usr/share/fpcsrc/3.0.0/packages/sdl/src/logger.pas"/>
<EditorIndex Value="-1"/>
<UsageCount Value="10"/>
</Unit28>
<Unit29>
<Filename Value="/usr/share/fpcsrc/3.0.0/packages/fcl-base/src/eventlog.pp"/>
<EditorIndex Value="-1"/>
<UsageCount Value="10"/>
</Unit29>
<Unit30>
<Filename Value="/usr/lib/lazarus/1.6.2/components/lazutils/lazfileutils.pas"/>
<UnitName Value="LazFileUtils"/>
<EditorIndex Value="-1"/>
<TopLine Value="73"/>
<UsageCount Value="10"/>
</Unit30>
<Unit31>
<Filename Value="/usr/lib/lazarus/1.6.2/components/lazutils/fileutil.pas"/>
<UnitName Value="FileUtil"/>
<EditorIndex Value="-1"/>
<TopLine Value="102"/>
<CursorPos X="26" Y="144"/>
<UsageCount Value="10"/>
</Unit31>
</Units>
<OtherDefines Count="1">
<Define0 Value="UseCThreads"/>
</OtherDefines>
<JumpHistory Count="29" HistoryIndex="28">
<Position1>
<Filename Value="firmwareupdate.pas"/>
<Caret Line="365" Column="39" TopLine="344"/>
</Position1>
<Position2>
<Filename Value="firmwareupdate.pas"/>
<Caret Line="385" Column="39" TopLine="344"/>
</Position2>
<Position3>
<Filename Value="firmwareupdate.pas"/>
<Caret Line="395" Column="41" TopLine="354"/>
</Position3>
<Position4>
<Filename Value="firmwareupdate.pas"/>
<Caret Line="423" Column="45" TopLine="382"/>
</Position4>
<Position5>
<Filename Value="firmwareupdate.pas"/>
<Caret Line="453" Column="45" TopLine="412"/>
</Position5>
<Position6>
<Filename Value="firmwareupdate.pas"/>
<Caret Line="468" Column="23" TopLine="427"/>
</Position6>
<Position7>
<Filename Value="firmwareupdate.pas"/>
<Caret Line="469" Column="41" TopLine="428"/>
</Position7>
<Position8>
<Filename Value="firmwareupdate.pas"/>
<Caret Line="487" Column="39" TopLine="446"/>
</Position8>
<Position9>
<Filename Value="firmwareupdate.pas"/>
<Caret Line="497" Column="23" TopLine="456"/>
</Position9>
<Position10>
<Filename Value="firmwareupdate.pas"/>
<Caret Line="498" Column="41" TopLine="457"/>
</Position10>
<Position11>
<Filename Value="firmwareupdate.pas"/>
<Caret Line="509" Column="45" TopLine="468"/>
</Position11>
<Position12>
<Filename Value="firmwareupdate.pas"/>
<Caret Line="559" Column="45" TopLine="518"/>
</Position12>
<Position13>
<Filename Value="firmwareupdate.pas"/>
<Caret Line="578" Column="43" TopLine="537"/>
</Position13>
<Position14>
<Filename Value="firmwareupdate.pas"/>
<Caret Line="588" Column="45" TopLine="547"/>
</Position14>
<Position15>
<Filename Value="firmwareupdate.pas"/>
<Caret Line="648" Column="45" TopLine="607"/>
</Position15>
<Position16>
<Filename Value="firmwareupdate.pas"/>
<Caret Line="667" Column="43" TopLine="626"/>
</Position16>
<Position17>
<Filename Value="firmwareupdate.pas"/>
<Caret Line="677" Column="45" TopLine="636"/>
</Position17>
<Position18>
<Filename Value="firmwareupdate.pas"/>
<Caret Line="716" Column="39" TopLine="675"/>
</Position18>
<Position19>
<Filename Value="firmwareupdate.pas"/>
<Caret Line="724" Column="39" TopLine="683"/>
</Position19>
<Position20>
<Filename Value="firmwareupdate.pas"/>
<Caret Line="744" Column="37" TopLine="703"/>
</Position20>
<Position21>
<Filename Value="firmwareupdate.pas"/>
<Caret Line="1129" Column="39" TopLine="1087"/>
</Position21>
<Position22>
<Filename Value="firmwareupdate.pas"/>
<Caret Line="1138" Column="52" TopLine="1096"/>
</Position22>
<Position23>
<Filename Value="firmwareupdate.pas"/>
<Caret Line="1126" Column="64" TopLine="1104"/>
</Position23>
<Position24>
<Filename Value="firmwareupdate.pas"/>
</Position24>
<Position25>
<Filename Value="firmwareupdate.pas"/>
<Caret Line="98" Column="43" TopLine="93"/>
</Position25>
<Position26>
<Filename Value="firmwareupdate.pas"/>
<Caret Line="745" TopLine="719"/>
</Position26>
<Position27>
<Filename Value="firmwareupdate.pas"/>
<Caret Line="98" Column="72" TopLine="68"/>
</Position27>
<Position28>
<Filename Value="firmwareupdate.pas"/>
<Caret Line="947" TopLine="938"/>
</Position28>
<Position29>
<Filename Value="firmwareupdate.pas"/>
<Caret Line="1053" Column="19" TopLine="1018"/>
</Position29>
</JumpHistory>
</ProjectSession>
</CONFIG>

BIN
Host/Source/MicroBoot/MicroBoot.res Normal file
View File

Binary file not shown.

BIN
Host/Source/MicroBoot/SettingsUnit.dfm
View File

Binary file not shown.

225
Host/Source/MicroBoot/SettingsUnit.pas
View File

@ -1,225 +0,0 @@
unit SettingsUnit;
//***************************************************************************************
// Project Name: MicroBoot for Borland Delphi
// Description: Contains the Settings Window for MicroBoot
// File Name: SettingsUnit.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2011 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, ExtCtrls;
//***************************************************************************************
// Type Definitions
//***************************************************************************************
type
TsettingsForm = class(TForm)
btnOk: TButton;
pnlFooter: TPanel;
grbTargetInterface: TGroupBox;
cbbInterfaces: TComboBox;
btnOptions: TButton;
procedure btnOkClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btnOptionsClick(Sender: TObject);
procedure cbbInterfacesChange(Sender: TObject);
private
{ Private declarations }
libFileNameList : TStrings;
libFileInfoList : TStrings;
ExePath : string;
public
{ Public declarations }
end;
//***************************************************************************************
// Global Variables
//***************************************************************************************
var
settingsForm: TsettingsForm;
implementation
//***************************************************************************************
// Local Includes
//***************************************************************************************
uses MainUnit;
{$R *.DFM}
//***************************************************************************************
// NAME: btnOkClick
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Closes the dialog and sends a positive response back to the
// application.
//
//***************************************************************************************
procedure TsettingsForm.btnOkClick(Sender: TObject);
begin
ModalResult := mrOK;
end; //*** end of btnOkClick ***
//***************************************************************************************
// NAME: FormCreate
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Constructs the form an creates instances of the objects we intend to
// use.
//
//***************************************************************************************
procedure TsettingsForm.FormCreate(Sender: TObject);
begin
// instanciate string lists
libFileNameList := TStringList.Create;
libFileInfoList := TStringList.Create;
ExePath := ExtractFilePath(Application.ExeName);
end; //*** end of FormCreate ***
//***************************************************************************************
// NAME: FormDestroy
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Destroys the form an frees instances of the objects we used.
//
//***************************************************************************************
procedure TsettingsForm.FormDestroy(Sender: TObject);
begin
libFileNameList.Free;
libFileInfoList.Free;
end; //*** end of FormDestroy ***
//***************************************************************************************
// NAME: FormShow
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Obtains list with interface libraries and adds each one of these
// to the combobox with a description so it's easy for users to select
// one.
//
//***************************************************************************************
procedure TsettingsForm.FormShow(Sender: TObject);
var
cnt : integer;
activeLib : string;
begin
// clear string lists before using them
libFileNameList.Clear;
libFileInfoList.Clear;
cbbInterfaces.Items.Clear;
// obtian list with available Mbi interface DLL's that are found in the EXE path
mainForm.GetInterfaceFileList(libFileNameList);
activeLib := ExtractFileName(mainForm.GetActiveMbi);
for cnt := 0 to libFileNameList.Count-1 do
begin
cbbInterfaces.Items.Add(mainForm.GetMbiInfoString(ExePath +
libFileNameList[cnt]));
//select the active one
if libFileNameList[cnt] = activeLib then
begin
cbbInterfaces.ItemIndex := cnt;
end;
end;
end; //*** end of FormShow ***
//***************************************************************************************
// NAME: btnOptionsClick
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Submits a request to the interface library to display extra
// configuration options.
//
//***************************************************************************************
procedure TsettingsForm.btnOptionsClick(Sender: TObject);
var
cnt : integer;
activeLib : string;
begin
// submit configuration request to interface library
mainForm.ConfigureMbi;
// clear string lists before using them
libFileNameList.Clear;
libFileInfoList.Clear;
cbbInterfaces.Items.Clear;
// obtian list with available Mbi interface DLL's that are found in the EXE path
mainForm.GetInterfaceFileList(libFileNameList);
activeLib := ExtractFileName(mainForm.GetActiveMbi);
for cnt := 0 to libFileNameList.Count-1 do
begin
cbbInterfaces.Items.Add(mainForm.GetMbiInfoString(ExePath +
libFileNameList[cnt]));
//select the active one
if libFileNameList[cnt] = activeLib then
begin
cbbInterfaces.ItemIndex := cnt;
end;
end;
end; //*** end of btnOptionsClick ***
//***************************************************************************************
// NAME: cbbInterfacesChange
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Updates the interface library that is linked to the application.
//
//***************************************************************************************
procedure TsettingsForm.cbbInterfacesChange(Sender: TObject);
begin
// enable the selected mbi interface
mainForm.SetActiveMbi(ExePath + libFileNameList[cbbInterfaces.ItemIndex]);
end; //*** end of cbbInterfacesChange ***
end.
//******************************** end of SettingsUnit.pas ******************************

881
Host/Source/MicroBoot/configgroups.pas Normal file
View File

@ -0,0 +1,881 @@
unit ConfigGroups;
//***************************************************************************************
// Description: Configuration groups available to the program.
// File Name: configgroups.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2018 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.
//
//***************************************************************************************
{$IFDEF FPC}
{$MODE objfpc}{$H+}
{$ENDIF}
interface
//***************************************************************************************
// Includes
//***************************************************************************************
uses
Classes, SysUtils, CurrentConfig, XMLConf;
//***************************************************************************************
// Type Definitions
//***************************************************************************************
type
//------------------------------ TMainWindowConfig ------------------------------------
TMainWindowConfig = class (TConfigGroup)
private
FWidth: Integer;
FHeight: Integer;
public
const GROUP_NAME='MainWindow';
constructor Create;
procedure Defaults; override;
procedure LoadFromFile(XmlConfig: TXMLConfig); override;
procedure SaveToFile(XmlConfig: TXMLConfig); override;
property Width: Integer read FWidth write FWidth;
property Height: Integer read FHeight write FHeight;
end;
//------------------------------ TMiscellaneousConfig ---------------------------------
TMiscellaneousConfig = class (TConfigGroup)
private
FLogging: Integer;
FLogFile: String;
public
const GROUP_NAME='Miscellaneus';
constructor Create;
procedure Defaults; override;
procedure LoadFromFile(XmlConfig: TXMLConfig); override;
procedure SaveToFile(XmlConfig: TXMLConfig); override;
property Logging: Integer read FLogging write FLogging;
property LogFile: String read FLogFile write FLogFile;
end;
//------------------------------ TSessionConfig ---------------------------------------
TSessionConfig = class (TConfigGroup)
private
FSession: String;
public
const GROUP_NAME='Session';
constructor Create;
procedure Defaults; override;
procedure LoadFromFile(XmlConfig: TXMLConfig); override;
procedure SaveToFile(XmlConfig: TXMLConfig); override;
property Session: String read FSession write FSession;
end;
//------------------------------ TSessionXcpConfig ------------------------------------
TSessionXcpConfig = class (TConfigGroup)
private
FTimeoutT1: Integer;
FTimeoutT3: Integer;
FTimeoutT4: Integer;
FTimeoutT5: Integer;
FTimeoutT7: Integer;
FConnectMode: Integer;
FSeedKey: String;
public
const GROUP_NAME='Session/Xcp';
constructor Create;
procedure Defaults; override;
procedure LoadFromFile(XmlConfig: TXMLConfig); override;
procedure SaveToFile(XmlConfig: TXMLConfig); override;
property TimeoutT1: Integer read FTimeoutT1 write FTimeoutT1;
property TimeoutT3: Integer read FTimeoutT3 write FTimeoutT3;
property TimeoutT4: Integer read FTimeoutT4 write FTimeoutT4;
property TimeoutT5: Integer read FTimeoutT5 write FTimeoutT5;
property TimeoutT7: Integer read FTimeoutT7 write FTimeoutT7;
property ConnectMode: Integer read FConnectMode write FConnectMode;
property SeedKey: String read FSeedKey write FSeedKey;
end;
//------------------------------ TTransportConfig -------------------------------------
TTransportConfig = class (TConfigGroup)
private
FTransport: String;
public
const GROUP_NAME='Transport';
constructor Create;
procedure Defaults; override;
procedure LoadFromFile(XmlConfig: TXMLConfig); override;
procedure SaveToFile(XmlConfig: TXMLConfig); override;
property Transport: String read FTransport write FTransport;
end;
//------------------------------ TTransportXcpRs232Config -----------------------------
TTransportXcpRs232Config = class (TConfigGroup)
private
FDevice: String;
FBaudrate: Integer;
public
const GROUP_NAME='Transport/Xcp/Rs232';
constructor Create;
procedure Defaults; override;
procedure LoadFromFile(XmlConfig: TXMLConfig); override;
procedure SaveToFile(XmlConfig: TXMLConfig); override;
property Device: String read FDevice write FDevice;
property Baudrate: Integer read FBaudrate write FBaudrate;
end;
//------------------------------ TTransportXcpCanConfig -------------------------------
TTransportXcpCanConfig = class (TConfigGroup)
private
FDevice: String;
FChannel: LongWord;
FBaudrate: Integer;
FTransmitId: LongWord;
FReceiveId: LongWord;
FExtendedId: Integer;
public
const GROUP_NAME='Transport/Xcp/Can';
constructor Create;
procedure Defaults; override;
procedure LoadFromFile(XmlConfig: TXMLConfig); override;
procedure SaveToFile(XmlConfig: TXMLConfig); override;
property Device: String read FDevice write FDevice;
property Channel: LongWord read FChannel write FChannel;
property Baudrate: Integer read FBaudrate write FBaudrate;
property TransmitId: LongWord read FTransmitId write FTransmitId;
property ReceiveId: LongWord read FReceiveId write FReceiveId;
property ExtendedId: Integer read FExtendedId write FExtendedId;
end;
//------------------------------ TTransportXcpUsbConfig -------------------------------
TTransportXcpUsbConfig = class (TConfigGroup)
private
public
const GROUP_NAME='Transport/Xcp/Usb';
constructor Create;
procedure Defaults; override;
procedure LoadFromFile(XmlConfig: TXMLConfig); override;
procedure SaveToFile(XmlConfig: TXMLConfig); override;
end;
//------------------------------ TTransportXcpTcpIpConfig -----------------------------
TTransportXcpTcpIpConfig = class (TConfigGroup)
private
FAddress: String;
FPort: Word;
public
const GROUP_NAME='Transport/Xcp/TcpIp';
constructor Create;
procedure Defaults; override;
procedure LoadFromFile(XmlConfig: TXMLConfig); override;
procedure SaveToFile(XmlConfig: TXMLConfig); override;
property Address: String read FAddress write FAddress;
property Port: Word read FPort write FPort;
end;
implementation
//---------------------------------------------------------------------------------------
//-------------------------------- TMainWindowConfig ------------------------------------
//---------------------------------------------------------------------------------------
//***************************************************************************************
// NAME: Create
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Class constructor.
//
//***************************************************************************************
constructor TMainWindowConfig.Create;
begin
// Call inherited constructor.
inherited Create;
// Set fields.
FName := GROUP_NAME;
Defaults;
end; //*** end of Create ***
//***************************************************************************************
// NAME: Defaults
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Sets default values for this group's settings.
//
//***************************************************************************************
procedure TMainWindowConfig.Defaults;
begin
FWidth := 500;
FHeight := 180;
end; //*** end of Defaults ***
//***************************************************************************************
// NAME: LoadFromFile
// PARAMETER: XmlConfig XML configuration instance.
// RETURN VALUE: none
// DESCRIPTION: Loads this group's configuration settings using the XML configuration
// instance.
//
//***************************************************************************************
procedure TMainWindowConfig.LoadFromFile(XmlConfig: TXMLConfig);
begin
// Open this group's key.
XmlConfig.OpenKey(UnicodeString(Self.Name));
// Load all settings.
FWidth := XmlConfig.GetValue('width', FWidth);
FHeight := XmlConfig.GetValue('height', FHeight);
// Close this group's key.
XmlConfig.CloseKey;
end; //*** end of LoadFromFile ***/
//***************************************************************************************
// NAME: SaveToFile
// PARAMETER: XmlConfig XML configuration instance.
// RETURN VALUE: none
// DESCRIPTION: Saves this group's configuration settings using the XML configuration
// instance.
//
//***************************************************************************************
procedure TMainWindowConfig.SaveToFile(XmlConfig: TXMLConfig);
begin
// Open this group's key.
XmlConfig.OpenKey(UnicodeString(Self.Name));
// Store all settings.
XmlConfig.SetValue('width', FWidth);
XmlConfig.SetValue('height', FHeight);
// Close this group's key.
xmlConfig.CloseKey;
end; //*** end of SaveToFile ***
//---------------------------------------------------------------------------------------
//-------------------------------- TMiscellaneousConfig ---------------------------------
//---------------------------------------------------------------------------------------
//***************************************************************************************
// NAME: Create
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Class constructor.
//
//***************************************************************************************
constructor TMiscellaneousConfig.Create;
begin
// Call inherited constructor.
inherited Create;
// Set fields.
FName := GROUP_NAME;
Defaults;
end; //*** end of Create ***
//***************************************************************************************
// NAME: Defaults
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Sets default values for this group's settings.
//
//***************************************************************************************
procedure TMiscellaneousConfig.Defaults;
begin
FLogging := 0;
FLogFile := '';
end; //*** end of Defaults ***
//***************************************************************************************
// NAME: LoadFromFile
// PARAMETER: XmlConfig XML configuration instance.
// RETURN VALUE: none
// DESCRIPTION: Loads this group's configuration settings using the XML configuration
// instance.
//
//***************************************************************************************
procedure TMiscellaneousConfig.LoadFromFile(XmlConfig: TXMLConfig);
begin
// Open this group's key.
XmlConfig.OpenKey(UnicodeString(Self.Name));
// Load all settings.
FLogging := XmlConfig.GetValue('logging', FLogging);
FLogFile := String(XmlConfig.GetValue('log_file', UnicodeString(FLogFile)));
// Close this group's key.
XmlConfig.CloseKey;
end; //*** end of LoadFromFile ***/
//***************************************************************************************
// NAME: SaveToFile
// PARAMETER: XmlConfig XML configuration instance.
// RETURN VALUE: none
// DESCRIPTION: Saves this group's configuration settings using the XML configuration
// instance.
//
//***************************************************************************************
procedure TMiscellaneousConfig.SaveToFile(XmlConfig: TXMLConfig);
begin
// Open this group's key.
XmlConfig.OpenKey(UnicodeString(Self.Name));
// Store all settings.
XmlConfig.SetValue('logging', FLogging);
XmlConfig.SetValue('log_file', UnicodeString(FLogFile));
// Close this group's key.
XmlConfig.CloseKey;
end; //*** end of SaveToFile ***
//---------------------------------------------------------------------------------------
//-------------------------------- TSessionConfig ---------------------------------------
//---------------------------------------------------------------------------------------
//***************************************************************************************
// NAME: Create
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Class constructor.
//
//***************************************************************************************
constructor TSessionConfig.Create;
begin
// Call inherited constructor.
inherited Create;
// Set fields.
FName := GROUP_NAME;
Defaults;
end; //*** end of Create ***
//***************************************************************************************
// NAME: Defaults
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Sets default values for this group's settings.
//
//***************************************************************************************
procedure TSessionConfig.Defaults;
begin
FSession := 'xcp';
end; //*** end of Defaults ***
//***************************************************************************************
// NAME: LoadFromFile
// PARAMETER: XmlConfig XML configuration instance.
// RETURN VALUE: none
// DESCRIPTION: Loads this group's configuration settings using the XML configuration
// instance.
//
//***************************************************************************************
procedure TSessionConfig.LoadFromFile(XmlConfig: TXMLConfig);
begin
// Open this group's key.
XmlConfig.OpenKey(UnicodeString(Self.Name));
// Load all settings.
FSession := String(XmlConfig.GetValue('session', UnicodeString(FSession)));
// Close this group's key.
XmlConfig.CloseKey;
end; //*** end of LoadFromFile ***/
//***************************************************************************************
// NAME: SaveToFile
// PARAMETER: XmlConfig XML configuration instance.
// RETURN VALUE: none
// DESCRIPTION: Saves this group's configuration settings using the XML configuration
// instance.
//
//***************************************************************************************
procedure TSessionConfig.SaveToFile(XmlConfig: TXMLConfig);
begin
// Open this group's key.
XmlConfig.OpenKey(UnicodeString(Self.Name));
// Store all settings.
XmlConfig.SetValue('session', UnicodeString(FSession));
// Close this group's key.
XmlConfig.CloseKey;
end; //*** end of SaveToFile ***
//---------------------------------------------------------------------------------------
//-------------------------------- TSessionXcpConfig ------------------------------------
//---------------------------------------------------------------------------------------
//***************************************************************************************
// NAME: Create
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Class constructor.
//
//***************************************************************************************
constructor TSessionXcpConfig.Create;
begin
// Call inherited constructor.
inherited Create;
// Set fields.
FName := GROUP_NAME;
Defaults;
end; //*** end of Create ***
//***************************************************************************************
// NAME: Defaults
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Sets default values for this group's settings.
//
//***************************************************************************************
procedure TSessionXcpConfig.Defaults;
begin
FTimeoutT1 := 1000;
FTimeoutT3 := 2000;
FTimeoutT4 := 10000;
FTimeoutT5 := 1000;
FTimeoutT7 := 2000;
FConnectMode := 0;
FSeedKey := '';
end; //*** end of Defaults ***
//***************************************************************************************
// NAME: LoadFromFile
// PARAMETER: XmlConfig XML configuration instance.
// RETURN VALUE: none
// DESCRIPTION: Loads this group's configuration settings using the XML configuration
// instance.
//
//***************************************************************************************
procedure TSessionXcpConfig.LoadFromFile(XmlConfig: TXMLConfig);
begin
// Open this group's key.
XmlConfig.OpenKey(UnicodeString(Self.Name));
// Load all settings.
FTimeoutT1 := XmlConfig.GetValue('timeout_t1', FTimeoutT1);
FTimeoutT3 := XmlConfig.GetValue('timeout_t3', FTimeoutT3);
FTimeoutT4 := XmlConfig.GetValue('timeout_t4', FTimeoutT4);
FTimeoutT5 := XmlConfig.GetValue('timeout_t5', FTimeoutT5);
FTimeoutT7 := XmlConfig.GetValue('timeout_t7', FTimeoutT7);
FConnectMode := XmlConfig.GetValue('connect_mode', FConnectMode);
FSeedKey := String(XmlConfig.GetValue('seed_key', UnicodeString(FSeedKey)));
// Close this group's key.
XmlConfig.CloseKey;
end; //*** end of LoadFromFile ***/
//***************************************************************************************
// NAME: SaveToFile
// PARAMETER: XmlConfig XML configuration instance.
// RETURN VALUE: none
// DESCRIPTION: Saves this group's configuration settings using the XML configuration
// instance.
//
//***************************************************************************************
procedure TSessionXcpConfig.SaveToFile(XmlConfig: TXMLConfig);
begin
// Open this group's key.
XmlConfig.OpenKey(UnicodeString(Self.Name));
// Store all settings.
XmlConfig.SetValue('timeout_t1', FTimeoutT1);
XmlConfig.SetValue('timeout_t3', FTimeoutT3);
XmlConfig.SetValue('timeout_t4', FTimeoutT4);
XmlConfig.SetValue('timeout_t5', FTimeoutT5);
XmlConfig.SetValue('timeout_t7', FTimeoutT7);
XmlConfig.SetValue('connect_mode', FConnectMode);
XmlConfig.SetValue('seed_key', UnicodeString(FSeedKey));
// Close this group's key.
XmlConfig.CloseKey;
end; //*** end of SaveToFile ***
//---------------------------------------------------------------------------------------
//-------------------------------- TTransportConfig -------------------------------------
//---------------------------------------------------------------------------------------
//***************************************************************************************
// NAME: Create
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Class constructor.
//
//***************************************************************************************
constructor TTransportConfig.Create;
begin
// Call inherited constructor.
inherited Create;
// Set fields.
FName := GROUP_NAME;
Defaults;
end; //*** end of Create ***
//***************************************************************************************
// NAME: Defaults
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Sets default values for this group's settings.
//
//***************************************************************************************
procedure TTransportConfig.Defaults;
begin
FTransport := 'xcp_rs232';
end; //*** end of Defaults ***
//***************************************************************************************
// NAME: LoadFromFile
// PARAMETER: XmlConfig XML configuration instance.
// RETURN VALUE: none
// DESCRIPTION: Loads this group's configuration settings using the XML configuration
// instance.
//
//***************************************************************************************
procedure TTransportConfig.LoadFromFile(XmlConfig: TXMLConfig);
begin
// Open this group's key.
XmlConfig.OpenKey(UnicodeString(Self.Name));
// Load all settings.
FTransport := String(XmlConfig.GetValue('transport', UnicodeString(FTransport)));
// Close this group's key.
XmlConfig.CloseKey;
end; //*** end of LoadFromFile ***/
//***************************************************************************************
// NAME: SaveToFile
// PARAMETER: XmlConfig XML configuration instance.
// RETURN VALUE: none
// DESCRIPTION: Saves this group's configuration settings using the XML configuration
// instance.
//
//***************************************************************************************
procedure TTransportConfig.SaveToFile(XmlConfig: TXMLConfig);
begin
// Open this group's key.
XmlConfig.OpenKey(UnicodeString(Self.Name));
// Store all settings.
XmlConfig.SetValue('transport', UnicodeString(FTransport));
// Close this group's key.
XmlConfig.CloseKey;
end; //*** end of SaveToFile ***
//---------------------------------------------------------------------------------------
//-------------------------------- TTransportXcpRs232Config -----------------------------
//---------------------------------------------------------------------------------------
//***************************************************************************************
// NAME: Create
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Class constructor.
//
//***************************************************************************************
constructor TTransportXcpRs232Config.Create;
begin
// Call inherited constructor.
inherited Create;
// Set fields.
FName := GROUP_NAME;
Defaults;
end; //*** end of Create ***
//***************************************************************************************
// NAME: Defaults
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Sets default values for this group's settings.
//
//***************************************************************************************
procedure TTransportXcpRs232Config.Defaults;
begin
FDevice := '';
FBaudrate := 57600;
end; //*** end of Defaults ***
//***************************************************************************************
// NAME: LoadFromFile
// PARAMETER: XmlConfig XML configuration instance.
// RETURN VALUE: none
// DESCRIPTION: Loads this group's configuration settings using the XML configuration
// instance.
//
//***************************************************************************************
procedure TTransportXcpRs232Config.LoadFromFile(XmlConfig: TXMLConfig);
begin
// Open this group's key.
XmlConfig.OpenKey(UnicodeString(Self.Name));
// Load all settings.
FDevice := String(XmlConfig.GetValue('device', UnicodeString(FDevice)));
FBaudrate := XmlConfig.GetValue('baudrate', FBaudrate);
// Close this group's key.
XmlConfig.CloseKey;
end; //*** end of LoadFromFile ***/
//***************************************************************************************
// NAME: SaveToFile
// PARAMETER: XmlConfig XML configuration instance.
// RETURN VALUE: none
// DESCRIPTION: Saves this group's configuration settings using the XML configuration
// instance.
//
//***************************************************************************************
procedure TTransportXcpRs232Config.SaveToFile(XmlConfig: TXMLConfig);
begin
// Open this group's key.
XmlConfig.OpenKey(UnicodeString(Self.Name));
// Store all settings.
XmlConfig.SetValue('device', UnicodeString(FDevice));
XmlConfig.SetValue('baudrate', FBaudrate);
// Close this group's key.
XmlConfig.CloseKey;
end; //*** end of SaveToFile ***
//---------------------------------------------------------------------------------------
//-------------------------------- TTransportXcpCanConfig -------------------------------
//---------------------------------------------------------------------------------------
//***************************************************************************************
// NAME: Create
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Class constructor.
//
//***************************************************************************************
constructor TTransportXcpCanConfig.Create;
begin
// Call inherited constructor.
inherited Create;
// Set fields.
FName := GROUP_NAME;
Defaults;
end; //*** end of Create ***
//***************************************************************************************
// NAME: Defaults
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Sets default values for this group's settings.
//
//***************************************************************************************
procedure TTransportXcpCanConfig.Defaults;
begin
FDevice := '';
FChannel := 0;
FBaudrate := 500000;
FTransmitId := $667;
FReceiveId := $7E1;
FExtendedId := 0;
end; //*** end of Defaults ***
//***************************************************************************************
// NAME: LoadFromFile
// PARAMETER: XmlConfig XML configuration instance.
// RETURN VALUE: none
// DESCRIPTION: Loads this group's configuration settings using the XML configuration
// instance.
//
//***************************************************************************************
procedure TTransportXcpCanConfig.LoadFromFile(XmlConfig: TXMLConfig);
begin
// Open this group's key.
XmlConfig.OpenKey(UnicodeString(Self.Name));
// Load all settings.
FDevice := String(XmlConfig.GetValue('device', UnicodeString(FDevice)));
FChannel := XmlConfig.GetValue('channel', FChannel);
FBaudrate := XmlConfig.GetValue('baudrate', FBaudrate);
FTransmitId := XmlConfig.GetValue('transmit_id', FTransmitId);
FReceiveId := XmlConfig.GetValue('receive_id', FReceiveId);
FExtendedId := XmlConfig.GetValue('extended_id', FExtendedId);
// Close this group's key.
XmlConfig.CloseKey;
end; //*** end of LoadFromFile ***/
//***************************************************************************************
// NAME: SaveToFile
// PARAMETER: XmlConfig XML configuration instance.
// RETURN VALUE: none
// DESCRIPTION: Saves this group's configuration settings using the XML configuration
// instance.
//
//***************************************************************************************
procedure TTransportXcpCanConfig.SaveToFile(XmlConfig: TXMLConfig);
begin
// Open this group's key.
XmlConfig.OpenKey(UnicodeString(Self.Name));
// Store all settings.
XmlConfig.SetValue('device', UnicodeString(FDevice));
XmlConfig.SetValue('channel', FChannel);
XmlConfig.SetValue('baudrate', FBaudrate);
XmlConfig.SetValue('transmit_id', FTransmitId);
XmlConfig.SetValue('receive_id', FReceiveId);
XmlConfig.SetValue('extended_id', FExtendedId);
// Close this group's key.
XmlConfig.CloseKey;
end; //*** end of SaveToFile ***
//---------------------------------------------------------------------------------------
//-------------------------------- TTransportXcpUsbConfig -------------------------------
//---------------------------------------------------------------------------------------
//***************************************************************************************
// NAME: Create
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Class constructor.
//
//***************************************************************************************
constructor TTransportXcpUsbConfig.Create;
begin
// Call inherited constructor.
inherited Create;
// Set fields.
FName := GROUP_NAME;
Defaults;
end; //*** end of Create ***
//***************************************************************************************
// NAME: Defaults
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Sets default values for this group's settings.
//
//***************************************************************************************
procedure TTransportXcpUsbConfig.Defaults;
begin
// USB transport layer currently does not require any additional settings.
end; //*** end of Defaults ***
//***************************************************************************************
// NAME: LoadFromFile
// PARAMETER: XmlConfig XML configuration instance.
// RETURN VALUE: none
// DESCRIPTION: Loads this group's configuration settings using the XML configuration
// instance.
//
//***************************************************************************************
procedure TTransportXcpUsbConfig.LoadFromFile(XmlConfig: TXMLConfig);
begin
// Open this group's key.
XmlConfig.OpenKey(UnicodeString(Self.Name));
// Load all settings.
// USB transport layer currently does not require any additional settings.
// Close this group's key.
XmlConfig.CloseKey;
end; //*** end of LoadFromFile ***/
//***************************************************************************************
// NAME: SaveToFile
// PARAMETER: XmlConfig XML configuration instance.
// RETURN VALUE: none
// DESCRIPTION: Saves this group's configuration settings using the XML configuration
// instance.
//
//***************************************************************************************
procedure TTransportXcpUsbConfig.SaveToFile(XmlConfig: TXMLConfig);
begin
// Open this group's key.
XmlConfig.OpenKey(UnicodeString(Self.Name));
// Store all settings.
// USB transport layer currently does not require any additional settings.
// Close this group's key.
XmlConfig.CloseKey;
end; //*** end of SaveToFile ***
//---------------------------------------------------------------------------------------
//-------------------------------- TTransportXcpTcpIpConfig -----------------------------
//---------------------------------------------------------------------------------------
//***************************************************************************************
// NAME: Create
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Class constructor.
//
//***************************************************************************************
constructor TTransportXcpTcpIpConfig.Create;
begin
// Call inherited constructor.
inherited Create;
// Set fields.
FName := GROUP_NAME;
Defaults;
end; //*** end of Create ***
//***************************************************************************************
// NAME: Defaults
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Sets default values for this group's settings.
//
//***************************************************************************************
procedure TTransportXcpTcpIpConfig.Defaults;
begin
FAddress := '192.168.178.23';
FPort := 1000;
end; //*** end of Defaults ***
//***************************************************************************************
// NAME: LoadFromFile
// PARAMETER: XmlConfig XML configuration instance.
// RETURN VALUE: none
// DESCRIPTION: Loads this group's configuration settings using the XML configuration
// instance.
//
//***************************************************************************************
procedure TTransportXcpTcpIpConfig.LoadFromFile(XmlConfig: TXMLConfig);
begin
// Open this group's key.
XmlConfig.OpenKey(UnicodeString(Self.Name));
// Load all settings.
FAddress := String(XmlConfig.GetValue('address', UnicodeString(FAddress)));
FPort := XmlConfig.GetValue('port', FPort);
// Close this group's key.
XmlConfig.CloseKey;
end; //*** end of LoadFromFile ***/
//***************************************************************************************
// NAME: SaveToFile
// PARAMETER: XmlConfig XML configuration instance.
// RETURN VALUE: none
// DESCRIPTION: Saves this group's configuration settings using the XML configuration
// instance.
//
//***************************************************************************************
procedure TTransportXcpTcpIpConfig.SaveToFile(XmlConfig: TXMLConfig);
begin
// Open this group's key.
XmlConfig.OpenKey(UnicodeString(Self.Name));
// Store all settings.
XmlConfig.SetValue('address', UnicodeString(FAddress));
XmlConfig.SetValue('port', FPort);
// Close this group's key.
XmlConfig.CloseKey;
end; //*** end of SaveToFile ***
end.
//******************************** end of configgroups.pas ******************************

251
Host/Source/MicroBoot/currentconfig.pas Normal file
View File

@ -0,0 +1,251 @@
unit CurrentConfig;
//***************************************************************************************
// Description: Program configuration management and persistency.
// File Name: currentconfig.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2018 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.
//
//***************************************************************************************
{$IFDEF FPC}
{$MODE objfpc}{$H+}
{$ENDIF}
interface
//***************************************************************************************
// Includes
//***************************************************************************************
uses
Classes, SysUtils, Fgl, XMLConf, LazFileUtils;
//***************************************************************************************
// Type Definitions
//***************************************************************************************
type
//------------------------------ TConfigGroup -----------------------------------------
TConfigGroup = class (TObject)
protected
FName: String;
public
procedure Defaults; virtual; abstract;
procedure LoadFromFile(XmlConfig: TXMLConfig); virtual; abstract;
procedure SaveToFile(XmlConfig: TXMLConfig); virtual; abstract;
property Name: String read FName;
end;
//------------------------------ TConfigGroupList -------------------------------------
TConfigGroupList = specialize TFPGObjectList<TConfigGroup>;
//------------------------------ TCurrentConfig ---------------------------------------
TCurrentConfig = class (TObject)
private
FConfigFile: String;
FGroups: TConfigGroupList;
function GetGroup(Name: String): TConfigGroup;
public
constructor Create;
destructor Destroy; override;
procedure LoadFromFile;
procedure SaveToFile;
procedure AddGroup(Group: TConfigGroup);
property ConfigFile: String read FConfigFile;
property Groups[Name: String]: TConfigGroup read GetGroup;
end;
implementation
//---------------------------------------------------------------------------------------
//-------------------------------- TCurrentConfig ---------------------------------------
//---------------------------------------------------------------------------------------
//***************************************************************************************
// NAME: Create
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Class constructor.
//
//***************************************************************************************
constructor TCurrentConfig.Create;
begin
// Call inherited constructor.
inherited Create;
// Set fields.
FConfigFile := GetAppConfigFile(False, True);
// Validate the configuration file.
Assert(FConfigFile <> '', 'Could not get application configuration filename.');
// Create instance of the groups list.
FGroups := TConfigGroupList.Create;
end; //*** end of Create ***
//***************************************************************************************
// NAME: Destroy
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Class destructor.
//
//***************************************************************************************
destructor TCurrentConfig.Destroy;
begin
// Free the groups list instance. Note that this automatically frees the config groups
// in the list.
FGroups.Free;
// call inherited destructor
inherited Destroy;
end; //*** end of Destroy ***
//***************************************************************************************
// NAME: LoadFromFile
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Loads the program's configuration from the configuration file.
//
//***************************************************************************************
procedure TCurrentConfig.LoadFromFile;
var
idx: Integer;
xmlConfig: TXMLConfig;
begin
// Loop through all groups to set defaults just in case the configuration file does
// no exist.
for idx := 0 to (FGroups.Count - 1) do
begin
// Request group to load its settings from the configuration file.
FGroups[idx].Defaults;
end;
// Check that the configuration file exists.
if FileExists(configFile) then
begin
// Construct XML configuration object.
xmlConfig := TXMLConfig.Create(nil);
xmlConfig.Filename := configFile;
// Loop through all groups.
for idx := 0 to (FGroups.Count - 1) do
begin
// Request group to load its settings from the configuration file.
FGroups[idx].LoadFromFile(xmlConfig);
end;
// Release the XML configuration object.
xmlConfig.Free;
end;
end; //*** end of LoadFromFile ***
//***************************************************************************************
// NAME: SaveToFile
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Saves the program's configuration to the configuration file.
//
//***************************************************************************************
procedure TCurrentConfig.SaveToFile;
var
idx: Integer;
configDir: String;
xmlConfig: TXMLConfig;
begin
// Extract the directory of the config file.
configDir := ExtractFilePath(FConfigFile);
// Validate the directory.
Assert(configDir <> '', 'Configuration directory is invalid.');
// Double check that the directory is actually there.
if not DirectoryExists(configDir) then
begin
// Force the directory creation.
ForceDirectories(configDir);
end;
// Only save settings if the directory is there and is writable.
if DirectoryExists(configDir) and DirectoryIsWritable(configDir) then
begin
// Construct XML configuration object.
xmlConfig := TXMLConfig.Create(nil);
xmlConfig.Filename := configFile;
// Loop through all groups.
for idx := 0 to (FGroups.Count - 1) do
begin
// Request group to save its settings to the configuration file.
FGroups[idx].SaveToFile(xmlConfig);
end;
// Write and release the XML configuration object.
xmlConfig.Flush;
xmlConfig.Free;
end;
end; //*** end of SaveToFile ***
//***************************************************************************************
// NAME: AddGroup
// PARAMETER: Group The configuration group to add.
// RETURN VALUE: none
// DESCRIPTION: Adds a configuration group under management of the current
// configuration.
//
//***************************************************************************************
procedure TCurrentConfig.AddGroup(Group: TConfigGroup);
begin
// Check parameters.
Assert(Group <> nil, 'Invalid group specified as a parameter.');
// Add the group.
FGroups.Add(Group);
end; //*** end of AddGroup ***
//***************************************************************************************
// NAME: GetGroup
// PARAMETER: Name Name of the configuration group to obtain.
// RETURN VALUE: Configuration group.
// DESCRIPTION: Obtains the configuration group based on the specified name.
//
//***************************************************************************************
function TCurrentConfig.GetGroup(Name: String): TConfigGroup;
var
idx: Integer;
begin
// Initialize the result value.
Result := nil;
// Check parameters.
Assert(Name <> '', 'Group name can not be empty.');
// Loop through all groups.
for idx := 0 to (FGroups.Count - 1) do
begin
// Is this the group we are looking for?
if FGroups[idx].Name = Name then
begin
// Set the result value.
Result := FGroups[idx];
// No need to continue looping.
Break;
end;
end;
// Verify the result value.
Assert(Result <> nil, 'Invalid group name specified.');
end; //*** end of GetGroup ***
end.
//******************************** end of currentconfig.pas *****************************

153
Host/Source/MicroBoot/customutil.pas Normal file
View File

@ -0,0 +1,153 @@
unit CustomUtil;
//***************************************************************************************
// Description: Contains custom utility functions and procedures.
// File Name: customutil.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2018 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.
//
//***************************************************************************************
{$IFDEF FPC}
{$MODE objfpc}{$H+}
{$ENDIF}
interface
//***************************************************************************************
// Includes
//***************************************************************************************
uses
Classes, SysUtils;
//***************************************************************************************
// Prototypes
//***************************************************************************************
function CustomUtilValidateNumberRange(Source: String; Min: Integer; Max: Integer; IsHex: Boolean = False): String;
procedure CustomUtilValidateKeyAsInt(var Key: Char);
procedure CustomUtilValidateKeyAsHex(var Key: Char);
implementation
//***************************************************************************************
// NAME: CustomUtilValidateNumberRange
// PARAMETER: Source The source string to validate.
// Min The minimum allowed value of the number in the string.
// Max The maximum allowed value of the number in the string.
// RETURN VALUE: The same as the source string, if successful. A range limited value
// otherwise. '0' in case of error.
// DESCRIPTION: Validates if the string contains a number in the specified range.
//
//***************************************************************************************
function CustomUtilValidateNumberRange(Source: String; Min: Integer; Max: Integer; IsHex: Boolean): String;
var
Value: Int64;
begin
// Check parameters.
Assert(Source <> '', 'Source string cannot be empty.');
Assert(Min < Max, 'Invalid range specified.');
// Attempt to convert the contents of the string to a number.
try
if IsHex then
begin
Value := StrToInt64('$' + Source);
// Set initial result.
Result := Format('%.x', [Value]);
end
else
begin
Value := StrToInt64(Source);
// Set initial result.
Result := IntToStr(Value);
end;
// Check lower range.
if Value < Min then
begin
if IsHex then
Result := Format('%.x', [Min])
else
Result := IntToStr(Min);
end
// Check upper range
else if Value > Max then
begin
if IsHex then
Result := Format('%.x', [Max])
else
Result := IntToStr(Max);
end;
except
// Default to 0 in case the string could not be converted to a number.
Result := '0';
end;
end; //*** end of CustomUtilValidateNumberRange ***
//***************************************************************************************
// NAME: CustomUtilValidateKeyAsInt
// PARAMETER: Key Value of the key that was pressed.
// RETURN VALUE: none
// DESCRIPTION: Checks if the specified key contains a character that in the range
// 0..9. Additionally, CTRL-V, -X, -C, -A and backspace are allowed. Can
// be used in the OnKeyPress events to validate the pressed key.
//
//***************************************************************************************
procedure CustomUtilValidateKeyAsInt(var Key: Char);
begin
if not (Key In ['0'..'9', #8, ^V, ^X, ^C, ^A]) then
begin
// Ignore it.
Key := #0;
end;
end; //*** end of CustomUtilValidateKeyAsInt ***
//***************************************************************************************
// NAME: CustomUtilValidateKeyAsHex
// PARAMETER: Key Value of the key that was pressed.
// RETURN VALUE: none
// DESCRIPTION: Checks if the specified key contains a character that in the range
// 0..9 and a..f. Additionally, CTRL-V, -X, -C, -A and backspace are
// allowed. Can be used in the OnKeyPress events to validate the pressed
// key. Note that hexadecimal keys (a..f) are automatically converted to
// upper case.
//
//***************************************************************************************
procedure CustomUtilValidateKeyAsHex(var Key: Char);
begin
if not (Key In ['0'..'9', 'a'..'f', 'A'..'F', #8, ^V, ^X, ^C, ^A]) then
begin
// Ignore it.
Key := #0;
end;
// Convert a..f to upper case
if Key In ['a'..'f'] then
begin
Key := UpCase(Key);
end;
end; //*** end of CustomUtilValidateKeyAsHex ***
end.
//******************************** end of customutil.pas ********************************

238
Host/Source/MicroBoot/filelogger.pas Normal file
View File

@ -0,0 +1,238 @@
unit FileLogger;
//***************************************************************************************
// Description: Contains functionality for logging events to a file.
// File Name: filelogger.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2018 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.
//
//***************************************************************************************
{$IFDEF FPC}
{$MODE objfpc}{$H+}
{$ENDIF}
interface
//***************************************************************************************
// Includes
//***************************************************************************************
uses
Classes, SysUtils, FileUtil, EventLog, LazFileUtils;
//***************************************************************************************
// Type Definitions
//***************************************************************************************
type
//------------------------------ TFileLoggerEntryType ---------------------------------
TFileLoggerEntryType = ( FLET_INFO = 0,
FLET_ERROR );
//------------------------------ TFileLoggerStartedEvent ------------------------------
TFileLoggerStartedEvent = procedure(Sender: TObject) of object;
//------------------------------ TFileLoggerStoppedEvent ------------------------------
TFileLoggerStoppedEvent = procedure(Sender: TObject) of object;
//------------------------------ TFileLoggerLogEvent ----------------------------------
TFileLoggerLogEvent = procedure(Sender: TObject; LogString: String; EntryType: TFileLoggerEntryType) of object;
//------------------------------ TFileLogger ------------------------------------------
TFileLogger = class(TObject)
private
FStartedEvent: TFileLoggerStartedEvent;
FStoppedEvent: TFileLoggerStoppedEvent;
FLogEvent: TFileLoggerLogEvent;
FEventLog: TEventLog;
FStarted: Boolean;
FLogFile: String;
public
constructor Create;
destructor Destroy; override;
function Start: Boolean;
procedure Stop;
procedure Log(LogString: String; EntryType: TFileLoggerEntryType = FLET_INFO);
property LogFile: String read FLogFile write FLogFile;
property Started: Boolean read FStarted;
property OnStarted: TFileLoggerStartedEvent read FStartedEvent write FStartedEvent;
property OnStopped: TFileLoggerStoppedEvent read FStoppedEvent write FStoppedEvent;
property OnLog: TFileLoggerLogEvent read FLogEvent write FLogEvent;
end;
implementation
//***************************************************************************************
// NAME: Create
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Class constructor
//
//***************************************************************************************
constructor TFileLogger.Create;
begin
// Call inherited constructor.
inherited Create;
// Initialize fields
FStartedEvent := nil;
FStoppedEvent := nil;
FLogEvent := nil;
FEventLog := nil;
FStarted := False;
FLogFile := '';
end; //*** end of Create ***
//***************************************************************************************
// NAME: Destroy
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Class destructor.
//
//***************************************************************************************
destructor TFileLogger.Destroy;
begin
// Stop logging.
Stop;
// Call inherited destructor.
inherited Destroy;
end; //*** end of Destroy ***
//***************************************************************************************
// NAME: Start
// PARAMETER: none
// RETURN VALUE: True if successful, False otherwise.
// DESCRIPTION: Starts the logger.
//
//***************************************************************************************
function TFileLogger.Start: Boolean;
var
logDir: String;
begin
// Initialize the result.
Result := False;
// Make sure logging is stopped.
Stop;
// Only continue if the log file was set.
if FLogFile <> '' then
begin
// Extract the directory of the log file.
logDir := ExtractFilePath(FLogFile);
// If the directory is empty, then it means the directory of the application.
if logDir = '' then
begin
// set directory to application directory.
logDir := ProgramDirectory;
end;
// Double check that the directory is actually there.
if not DirectoryExists(logDir) then
begin
// Force the directory creation.
ForceDirectories(logDir);
end;
// Only attempt to start logging if the directory is there and is writable.
if DirectoryExists(logDir) and DirectoryIsWritable(logDir) then
begin
// Create, configure and start an eventlog instance.
FEventLog := TEventLog.Create(nil);
FEventLog.LogType := ltFile;
FEventLog.FileName := FLogFile;
FEventLog.Active := True;
// Update state.
FStarted := True;
// Update the result.
Result := True;
// Trigger the event if it is set.
if Assigned(FStartedEvent) then
begin
FStartedEvent(Self);
end;
end;
end;
end; //*** end of Start ***
//***************************************************************************************
// NAME: Stop
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Stops the logger.
//
//***************************************************************************************
procedure TFileLogger.Stop;
begin
// Check if the eventlog was instanced.
if Assigned(FEventLog) then
begin
// Deactivate logging.
FEventLog.Active := False;
// Update state.
FStarted := False;
// Release the instance.
FreeAndNil(FEventLog);
end;
// Trigger the event if it is set.
if Assigned(FStoppedEvent) then
begin
FStoppedEvent(Self);
end;
end; //*** end of Stop ***
//***************************************************************************************
// NAME: Log
// PARAMETER: LogString The string to log.
// EntryType The type of the log entry.
// RETURN VALUE: none
// DESCRIPTION: Logs a string.
//
//***************************************************************************************
procedure TFileLogger.Log(LogString: String; EntryType: TFileLoggerEntryType);
begin
// Only log if the event log is instanced and logging was started.
if Assigned(FEventLog) then
begin
if FStarted then
begin
// Enter the log message in the requested format.
if EntryType = FLET_INFO then
begin
FEventLog.Info(LogString);
end
else if EntryType = FLET_ERROR then
begin
FEventLog.Error(LogString);
end;
end;
end;
// Trigger the event if it is set.
if Assigned(FLogEvent) then
begin
FLogEvent(Self, LogString, EntryType);
end;
end; //*** end of Log ***
end.
//******************************** end of filelogger.pas ********************************

1210
Host/Source/MicroBoot/firmwareupdate.pas Normal file
View File

File diff suppressed because it is too large Load Diff

1780
Host/Source/MicroBoot/interfaces/FirmwareData.pas
View File

File diff suppressed because it is too large Load Diff

BIN
Host/Source/MicroBoot/interfaces/XcpIcon.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 1.1 KiB

1306
Host/Source/MicroBoot/interfaces/XcpLoader.pas
View File

File diff suppressed because it is too large Load Diff

167
Host/Source/MicroBoot/interfaces/XcpProtection.pas
View File

@ -1,167 +0,0 @@
unit XcpProtection;
//***************************************************************************************
// Description: XCP seed and key resource protection interface.
// File Name: XcpProtection.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2011 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;
//***************************************************************************************
// Type Definitions
//***************************************************************************************
// DLL Interface Methods
type
TXcpGetAvailablePrivileges = function(resourcePtr: PByte) : DWORD; cdecl;
TXcpComputKeyFromSeed = function(resource: Byte; seedLen: Byte; seedPtr: PByteArray;
keyLenPtr: PByte; keyPtr: PByteArray) : DWORD; cdecl;
type
TXcpProtection = class(TObject)
private
FLibHandle : THandle;
FLibInitialized : Boolean;
FGetAvailablePrivileges: TXcpGetAvailablePrivileges;
FComputKeyFromSeed : TXcpComputKeyFromSeed;
public
constructor Create(libFile: string);
destructor Destroy; override;
function GetPrivileges(resourcePtr: PByte) : DWORD;
function ComputKeyFromSeed(resource: Byte; seedLen: Byte; seedPtr: PByteArray;
keyLenPtr: PByte; keyPtr: PByteArray) : DWORD;
end;
implementation
//***************************************************************************************
// NAME: Create
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Class constructor
//
//***************************************************************************************
constructor TXcpProtection.Create(libFile: string);
begin
// call inherited constructor
inherited Create;
// library not yet initialized
FLibInitialized := false;
// attempt to obtain the library handle
if (FileExists(libFile)) and (LowerCase(ExtractFileExt(libFile)) = '.dll') then
begin
FLibHandle := LoadLibrary(PChar(libFile));
if FLibHandle <> 0 then FLibInitialized := true;
end;
// only continue if everything was okay sofar
if FLibInitialized = false then Exit;
// attempt to obtain the function pointers from the interface library
@FComputKeyFromSeed := GetProcAddress(FLibHandle, 'XCP_ComputeKeyFromSeed');
@FGetAvailablePrivileges := GetProcAddress(FLibHandle, 'XCP_GetAvailablePrivileges');
// check if the functions were found in the interface library
if not Assigned(FComputKeyFromSeed) then FLibInitialized := false;
if not Assigned(FGetAvailablePrivileges) then FLibInitialized := false;
end; //*** end of Create ***
//***************************************************************************************
// NAME: Destroy
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Class destructor
//
//***************************************************************************************
destructor TXcpProtection.Destroy;
begin
// release the library and its handle
if FLibHandle <> 0 then
begin
FreeLibrary(FLibHandle);
end;
// call inherited destructor
inherited;
end; //*** end of Destroy ***
//***************************************************************************************
// NAME: GetPrivileges
// PARAMETER: resourcePtr : pointer where to store the supported resources
// for the key computation
// RETURN VALUE: 0 if success
// DESCRIPTION: obtains the privileges with available unlock algorithms in the
// external library file
//
//***************************************************************************************
function TXcpProtection.GetPrivileges(resourcePtr: PByte) : DWORD;
begin
if FLibInitialized then
result := FGetAvailablePrivileges(resourcePtr)
else
result := 0;
end; //*** end of GetPrivileges ***
//***************************************************************************************
// NAME: ComputKeyFromSeed
// PARAMETER: resource : resource for which the unlock key is requested
// seedLen : length of the seed
// seedPtr : pointer to the seed data
// keyLenPtr: pointer where to store the key length
// keyPtr : pointer where to store the key data
// RETURN VALUE: 0 if success
// DESCRIPTION: Computes the key for the requested resource.
//
//***************************************************************************************
function TXcpProtection.ComputKeyFromSeed(resource: Byte; seedLen: Byte;
seedPtr: PByteArray; keyLenPtr: PByte;
keyPtr: PByteArray) : DWORD;
begin
if FLibInitialized then
result := FComputKeyFromSeed(resource, seedLen, seedPtr, keyLenPtr, keyPtr)
else
result := 0;
end; //*** end of ComputKeyFromSeed ***
end.
//******************************** end of XcpProtection.pas *****************************

BIN
Host/Source/MicroBoot/interfaces/can/kvaser/CANIcon.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 538 B

BIN
Host/Source/MicroBoot/interfaces/can/kvaser/XcpSettings.dfm
View File

Binary file not shown.

496
Host/Source/MicroBoot/interfaces/can/kvaser/XcpSettings.pas
View File

@ -1,496 +0,0 @@
unit XcpSettings;
//***************************************************************************************
// Description: XCP settings interface for CAN
// File Name: XcpSettings.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2017 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;
tabSession: TTabSheet;
iconXcp3: TImage;
lblXcpSession: TLabel;
lblConnectMode: TLabel;
cmbConnectMode: 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;
oldSelectedIdx: Integer;
begin
// init to safe value
maxChannels := 1;
case cmbHardware.ItemIndex of
0: { KVASER_LEAFLIGHT_V2 }
begin
maxChannels := 1;
end;
end;
// backup currently selected channel
oldSelectedIdx := cmbChannel.ItemIndex;
// update the combobox contents
cmbChannel.Items.Clear;
for channelCnt := 1 to maxChannels do
begin
cmbChannel.Items.Add('Channel' + IntToStr(channelCnt));
end;
cmbChannel.DropDownCount := maxChannels;
// restore the selected channel
if oldSelectedIdx >= (maxChannels) then
begin
cmbChannel.ItemIndex := 0;
end
else
begin
cmbChannel.ItemIndex := oldSelectedIdx;
end;
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', 1);
if settingsInt >= FSettingsForm.cmbBaudrate.Items.Count then
settingsInt := 1;
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', ExtractFilePath(ParamStr(0))+'');
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));
FSettingsForm.cmbConnectMode.ItemIndex := settingsIni.ReadInteger('xcp', 'connectmode', 0);
// 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 := 1;
FSettingsForm.chbExtendedId.Checked := false;
FSettingsForm.edtTransmitId.Text := Format('%x',[$667]);
FSettingsForm.edtReceiveId.Text := Format('%x',[$7e1]);
// XCP related elements
FSettingsForm.edtSeedKey.Text := ExtractFilePath(ParamStr(0))+'';
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);
FSettingsForm.cmbConnectMode.ItemIndex := 0;
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));
settingsIni.WriteInteger('xcp', 'connectmode', FSettingsForm.cmbConnectMode.ItemIndex);
// 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 *******************************

423
Host/Source/MicroBoot/interfaces/can/kvaser/XcpTransport.pas
View File

@ -1,423 +0,0 @@
unit XcpTransport;
//***************************************************************************************
// Description: XCP transport layer for CAN.
// File Name: XcpTransport.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2017 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, canlib;
//***************************************************************************************
// Global Constants
//***************************************************************************************
// a CAN message can only have up to 8 bytes
const kMaxPacketSize = 8;
//***************************************************************************************
// Type Definitions
//***************************************************************************************
type
TKvaserHardware = ( KVASER_LEAFLIGHT_V2 = $01 );
TXcpTransport = class(TObject)
private
packetTxId : LongWord;
packetRxId : LongWord;
extendedId : Boolean;
kvaserHandle : canHandle;
canHardware : TKvaserHardware; { KVASER_xxx }
canChannel : Word; { currently supported is 1..1 }
canBaudrate : LongWord; { in bits/sec }
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;
// 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;
// invalidate the handle
kvaserHandle := canINVALID_HANDLE;
// initialize the library
canInitializeLibrary;
end; //*** end of Create ***
//***************************************************************************************
// NAME: Destroy
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Class destructor
//
//***************************************************************************************
destructor TXcpTransport.Destroy;
begin
// unload the library
canUnloadLibrary;
// 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;
baudrateIdx : Integer;
const
baudrateLookupTable : array[0..7] of LongWord =
(
// list baudrates in the same order as they appear in the combobox on the settings
// form. this way the combobox's ItemIndex property can be used as an indexer to this
// array.
1000000, 500000, 250000, 125000, 100000, 83333, 50000, 10000
);
begin
// read XCP configuration from INI
if FileExists(iniFile) then
begin
// create ini file object
settingsIni := TIniFile.Create(iniFile);
// set hardware configuration
case settingsIni.ReadInteger('can', 'hardware', 0) of
0: canHardware := KVASER_LEAFLIGHT_V2;
else
canHardware := KVASER_LEAFLIGHT_V2;
end;
// set channel configuration
canChannel := settingsIni.ReadInteger('can', 'channel', 0) + 1;
// set baudrate configuration
baudrateIdx := settingsIni.ReadInteger('can', 'baudrate', 1);
canBaudrate := 500000;
if (baudrateIdx >= 0) and (baudrateIdx < Length(baudrateLookupTable)) then
canBaudrate := baudrateLookupTable[baudrateIdx];
// 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
openFlags: Integer;
frequency: Integer;
begin
// init result value
result := false;
// disconnect first if still connected
if connected then
Disconnect;
// the current version only supports the leaf light v2
if canHardware = KVASER_LEAFLIGHT_V2 then
begin
// open the CAN channel if valid
if canChannel > 0 then
begin
// set the open flags
openFlags := canOPEN_REQUIRE_INIT_ACCESS;
if extendedId then
begin
openFlags := openFlags or canOPEN_REQUIRE_EXTENDED;
end;
kvaserHandle := canOpenChannel(canChannel - 1, openFlags);
// only continue if the channel was opened and the handle is not valid
if kvaserHandle >= 0 then
begin
case canBaudrate of
1000000: frequency := canBITRATE_1M;
500000: frequency := canBITRATE_500K;
250000: frequency := canBITRATE_250K;
125000: frequency := canBITRATE_125K;
100000: frequency := canBITRATE_100K;
83333: frequency := canBITRATE_83K;
50000: frequency := canBITRATE_50K;
10000: frequency := canBITRATE_10K;
else
frequency := canBITRATE_500K;
end;
// configure the baudrate
if canSetBusParams(kvaserHandle, frequency, 0, 0, 0, 0, 0) = canOK then
begin
// configure output control to the default normal mode
if canSetBusOutputControl(kvaserHandle, canDRIVER_NORMAL) = canOK then
begin
// go on the bus
if canBusOn(kvaserHandle) = canOK then
begin
// connection was established
connected := true;
result := true;
end;
end;
end;
end;
end;
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
statusFlags: Cardinal;
begin
// init result to no error.
result := false;
// do not check if the handle is invalid
if kvaserHandle <= canINVALID_HANDLE then
begin
Exit;
end;
// check for bus off error or error passive if connected
if connected then
begin
if canReadStatus(kvaserHandle, statusFlags) = canOK then
begin
// check for bus off or error passive bits
if (statusFlags and (canSTAT_BUS_OFF or canSTAT_ERROR_PASSIVE)) > 0 then
begin
result := true;
end;
end
else
begin
// could not read the status which is also an indicator that something is wrong
result := true
end;
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
responseReceived: Boolean;
timeoutTime: DWORD;
txId: LongInt;
txData: array[0..kMaxPacketSize-1] of Byte;
txFlags: Cardinal;
rxId: LongInt;
rxData: array[0..kMaxPacketSize-1] of Byte;
rxFlags: Cardinal;
rxLen: Cardinal;
rxTime: Cardinal;
byteIdx: Byte;
status: canStatus;
idTypeOk: Boolean;
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;
// do not send if the handle is invalid
if kvaserHandle <= canINVALID_HANDLE then
begin
Exit;
end;
// prepare the packet for transmission in a CAN message
txId := packetTxId;
for byteIdx := 0 to (packetLen - 1) do
begin
txData[byteIdx] := packetData[byteIdx];
end;
if extendedId then
txFlags := canMSG_EXT
else
txFlags := canMSG_STD;
// submit the packet for transmission via the CAN bus
if canWrite(kvaserHandle, txId, @txData[0], packetLen, txFlags) <> canOK 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
// prepare message reception
rxId := packetRxId;
// attempt to read the packet response from the reception queue
status := canReadSpecificSkip(kvaserHandle, rxId, @rxData[0], rxLen, rxFlags, rxTime);
// check if an error was detected
if (status <> canOK) and (status <> canERR_NOMSG) then
begin
// error detected. stop loop.
Break;
end;
// no error, now check if a message was actually received
if status = canOK then
begin
// a message with the identifier of the response packet was received. now check
// that the identifier type also matches
idTypeOk := false;
if extendedId then
begin
if (rxFlags and canMSG_EXT) > 0 then
idTypeOk := true;
end
else
begin
if (rxFlags and canMSG_STD) > 0 then
idTypeOk := true;
end;
if idTypeOk then
begin
// response received. set flag
responseReceived := true;
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 received response packet
packetLen := rxLen;
for byteIdx := 0 to (packetLen - 1) do
begin
packetData[byteIdx] := rxData[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
// only disconnect if the handle is valid
if kvaserHandle > canINVALID_HANDLE then
begin
// take the channel from the bus
canBusOff(kvaserHandle);
// close the channel
canClose(kvaserHandle);
end;
end;
kvaserHandle := canINVALID_HANDLE;
connected := false;
end; //*** end of Disconnect ***
end.
//******************************** end of XcpTransport.pas ******************************

943
Host/Source/MicroBoot/interfaces/can/kvaser/canlib.pas
View File

@ -1,943 +0,0 @@
unit CANLIB;
(*
** Copyright 1995-2013 by KVASER AB
** WWW: http://www.kvaser.com
**
** This software is furnished under a license and may be used and copied
** only in accordance with the terms of such license.
**
*)
(*
** This unit defines an interface for Delphi to CANLIB32.DLL.
** It has been tested with Delphi 2007.
*)
interface
uses
Messages, Windows;
const
canINVALID_HANDLE = -1;
canOK = 0;
canERR_PARAM = -1; {// Error in parameter}
canERR_NOMSG = -2; {// No messages available}
canERR_NOTFOUND = -3; {// Specified hw not found}
canERR_NOMEM = -4; {// Out of memory}
canERR_NOCHANNELS = -5; {// No channels avaliable}
canERR_RESERVED_3 = -6;
canERR_TIMEOUT = -7; {// Timeout occurred}
canERR_NOTINITIALIZED = -8; {// Lib not initialized}
canERR_NOHANDLES = -9; {// Can't get handle}
canERR_INVHANDLE = -10; {// Handle is invalid}
canERR_INIFILE = -11; {// Error in the ini-file (16-bit only)}
canERR_DRIVER = -12; {// CAN driver type not supported}
canERR_TXBUFOFL = -13; {// Transmit buffer overflow}
canERR_RESERVED_1 = -14;
canERR_HARDWARE = -15; {// Some hardware error has occurred}
canERR_DYNALOAD = -16; {// Can't find requested DLL}
canERR_DYNALIB = -17; {// DLL seems to be wrong version}
canERR_DYNAINIT = -18; {// Error when initializing DLL}
canERR_NOT_SUPPORTED = -19;
canERR_RESERVED_5 = -20;
canERR_RESERVED_6 = -21;
canERR_RESERVED_2 = -22;
canERR_DRIVERLOAD = -23; {// Can't find/load driver}
canERR_DRIVERFAILED = -24; {// DeviceIOControl failed; use Win32 GetLastError()}
canERR_NOCONFIGMGR = -25; {// Can't find req'd config s/w (e.g. CS/SS)}
canERR_NOCARD = -26; {// The card was removed or not inserted}
canERR_RESERVED_7 = -27;
canERR_REGISTRY = -28; // Error in the Registry
canERR_LICENSE = -29; // The license is not valid.
canERR_INTERNAL = -30; // Internal error in the driver.
canERR_NO_ACCESS = -31; // Access denied
canERR_NOT_IMPLEMENTED = -32; // Requested function is not implemented
canERR_DEVICE_FILE = -33;
canERR_HOST_FILE = -34;
canERR_DISK = -35;
canERR_CRC = -36;
canERR_CONFIG = -37;
canERR_MEMO_FAIL = -38;
canERR_SCRIPT_FAIL = -39;
canERR_SCRIPT_WRONG_VERSION = -40;
canERR__RESERVED = -41; // RESERVED
WM__CANLIB = (WM_USER + 16354); {Windows message from Can unit.}
canEVENT_RX = 32000; {Receive event}
canEVENT_TX = 32001; {Transmit event}
canEVENT_ERROR = 32002; {Error event}
canEVENT_STATUS = 32003; {Change-of-status event}
canEVENT_ENVVAR = 32004; {An envvar changed}
canEVENT_BUSONOFF = 32005; {Bus on/off status changed}
canEVENT_REMOVED = 32006; {Device removed}
{Used in canSetNotify}
canNOTIFY_RX = $0001; { Notify on receive }
canNOTIFY_TX = $0002; { Notify on transmit }
canNOTIFY_ERROR = $0004; { Notify on error }
canNOTIFY_STATUS = $0008; { Notify on (some) status change events }
canNOTIFY_ENVVAR = $0010; { An environment variable was changed by a script }
canNOTIFY_BUSONOFF = $0020; { Notify on bus on/off status changed }
canNOTIFY_REMOVED = $0040; { Notify on device removed }
{Circuit status flags}
canSTAT_ERROR_PASSIVE = $00000001; {The circuit is error passive}
canSTAT_BUS_OFF = $00000002; {The circuit is Off Bus}
canSTAT_ERROR_WARNING = $00000004; {At least one error counter > 96}
canSTAT_ERROR_ACTIVE = $00000008; {The circuit is error active.}
canSTAT_TX_PENDING = $00000010; {There are messages pending transmission}
canSTAT_RX_PENDING = $00000020; {There are messages in the receive buffer}
canSTAT_RESERVED_1 = $00000040;
canSTAT_TXERR = $00000080; {There has been at least one TX error}
canSTAT_RXERR = $00000100; {There has been at least one RX error of some sort}
canSTAT_HW_OVERRUN = $00000200; {The has been at least one HW buffer overflow}
canSTAT_SW_OVERRUN = $00000400; {The has been at least one SW buffer overflow}
{Message information flags}
canMSG_MASK = $00FF; { Used to mask the non-info bits }
canMSG_RTR = $0001; { Message is a remote request }
canMSG_STD = $0002; { Message has a standard ID }
canMSG_EXT = $0004; { Message has an extended id }
canMSG_WAKEUP = $0008; { Message is a SWC wakeup frame}
canMSG_STATUS = $0008; { Obsolete - retained for compatibility }
canMSG_NERR = $0010; { Message sent/received with TJA1054 (etc.) NERR active }
canMSG_ERROR_FRAME = $0020; { Message is an error frame }
canMSG_TXACK = $0040; { Message is a TX ACK (msg is really sent) }
canMSG_TXRQ = $0080; { Message is a TX REQUEST (msg is transfered to the chip)}
canMSG_DELAY_MSG = $0100; { Message is NOT sent on the bus. The transmission of messages are delayed.
The dlc specifies the delay in milliseconds }
{Message error flags, >= $0100}
canFDMSG_MASK = $ff0000; { Used to mask the non-info bits }
canFDMSG_EDL = $010000; { Obsolete, use canFDMSG_FDF instead}
canFDMSG_FDF = $010000; { Indicate if message is an FD message }
canFDMSG_BRS = $020000; { Indicate if message should be sent with bit rate switch }
canFDMSG_ESI = $040000; { Indicate if the sender of this message is in error passive mode }
// single shot flags:
canMSG_SINGLE_SHOT = $1000000; // Message is Single Shot, try to send once, no retransmission (only tx)
canMSG_TXNACK = $2000000; // Message is a failed Single Shot, message was not sent (only rx)
canMSG_ABL = $4000000; // Only together with canMSG_TXNACK, Single shot message was not sent because arbitration was lost (only rx)
{Message error flags, >= $0100}
canMSGERR_MASK = $FF00; { Used to mask the non-error bits }
{ $0100 reserved }
canMSGERR_HW_OVERRUN = $0200; { HW buffer overrun }
canMSGERR_SW_OVERRUN = $0400; { SW buffer overrun }
canMSGERR_STUFF = $0800; { Stuff error }
canMSGERR_FORM = $1000; { Form error }
canMSGERR_CRC = $2000; { CRC error }
canMSGERR_BIT0 = $4000; { Sent dom, read rec}
canMSGERR_BIT1 = $8000; { Sent rec, read dom}
{Convenience values}
canMSGERR_OVERRUN = $0600; { Any overrun condition.}
canMSGERR_BIT = $C000; { Any bit error (note: TWO bits)}
canMSGERR_BUSERR = $F800; { Any RX error}
canCIRCUIT_ANY = -1; { Any circuit will do }
canCARD_ANY = -1; { Any card will do}
canCHANNEL_ANY = -1; { Any channel will do}
{Flags for canAccept}
canFILTER_ACCEPT = 1;
canFILTER_REJECT = 2;
canFILTER_SET_CODE_STD = 3;
canFILTER_SET_MASK_STD = 4;
canFILTER_SET_CODE_EXT = 5;
canFILTER_SET_MASK_EXT = 6;
canFILTER_NULL_MASK = 0;
canDRIVER_NORMAL = 4;
canDRIVER_SILENT = 1;
canDRIVER_SELFRECEPTION = 8;
canDRIVER_OFF = 0;
{ "shortcut" baud rates; use with canBusParams or canTranslateBaud }
{ canBAUD_xxx is obsolete; use canBITRATE_xxx instead }
canBAUD_1M = -1;
canBAUD_500K = -2;
canBAUD_250K = -3;
canBAUD_125K = -4;
canBAUD_100K = -5;
canBAUD_62K = -6;
canBAUD_50K = -7;
canBAUD_83K = -8;
canBITRATE_1M = -1;
canBITRATE_500K = -2;
canBITRATE_250K = -3;
canBITRATE_125K = -4;
canBITRATE_100K = -5;
canBITRATE_62K = -6;
canBITRATE_50K = -7;
canBITRATE_83K = -8;
canBITRATE_10K = -9;
canFD_BITRATE_500K_80P = -1000;
canFD_BITRATE_1M_80P = -1001;
canFD_BITRATE_2M_80P = -1002;
canFD_BITRATE_4M_80P = -1003;
canFD_BITRATE_8M_60P = -1004;
canIOCTL_PREFER_EXT = 1;
canIOCTL_PREFER_STD = 2;
{ 3,4 reserved }
canIOCTL_CLEAR_ERROR_COUNTERS = 5;
canIOCTL_SET_TIMER_SCALE = 6;
canIOCTL_SET_TXACK = 7;
canIOCTL_GET_RX_BUFFER_LEVEL = 8;
canIOCTL_GET_TX_BUFFER_LEVEL = 9;
canIOCTL_FLUSH_RX_BUFFER = 10;
canIOCTL_FLUSH_TX_BUFFER = 11;
canIOCTL_GET_TIMER_SCALE = 12;
canIOCTL_SET_TX_REQUESTS = 13;
canIOCTL_GET_EVENTHANDLE = 14;
canIOCTL_SET_BYPASS_MODE = 15;
canIOCTL_SET_WAKEUP = 16;
canIOCTL_GET_DRIVERHANDLE = 17;
canIOCTL_MAP_RXQUEUE = 18;
canIOCTL_GET_WAKEUP = 19;
canIOCTL_SET_REPORT_ACCESS_ERRORS = 20;
canIOCTL_GET_REPORT_ACCESS_ERRORS = 21;
canIOCTL_CONNECT_TO_VIRTUAL_BUS = 22;
canIOCTL_DISCONNECT_FROM_VIRTUAL_BUS = 23;
canIOCTL_SET_USER_IOPORT = 24;
canIOCTL_GET_USER_IOPORT = 25;
canIOCTL_SET_BUFFER_WRAPAROUND_MODE = 26;
canIOCTL_SET_RX_QUEUE_SIZE = 27;
canIOCTL_SET_USB_THROTTLE = 28;
canIOCTL_GET_USB_THROTTLE = 29;
canIOCTL_SET_BUSON_TIME_AUTO_RESET = 30;
canIOCTL_GET_TXACK = 31;
canIOCTL_SET_LOCAL_TXECHO = 32;
canIOCTL_SET_ERROR_FRAMES_REPORTING = 33;
canIOCTL_GET_CHANNEL_QUALITY = 34;
canIOCTL_GET_ROUNDTRIP_TIME = 35;
canIOCTL_GET_BUS_TYPE = 36;
canIOCTL_GET_DEVNAME_ASCII = 37;
canIOCTL_GET_TIME_SINCE_LAST_SEEN = 38;
canIOCTL_GET_TREF_LIST = 39;
canIOCTL_TX_INTERVAL = 40;
canIOCTL_SET_THROTTLE_SCALED = 41;
canIOCTL_GET_THROTTLE_SCALED = 42;
canIOCTL_SET_BRLIMIT = 43;
canIOCTL_RESET_OVERRUN_COUNT = 44;
//Type of buffer
canOBJBUF_TYPE_AUTO_RESPONSE = $01;
canOBJBUF_TYPE_PERIODIC_TX = $02;
// The buffer responds to RTRs only, not regular messages.
canOBJBUF_AUTO_RESPONSE_RTR_ONLY = $01;
// Check for specific version(s) of CANLIB.
canVERSION_DONT_ACCEPT_LATER = $01;
canVERSION_DONT_ACCEPT_BETAS = $02;
CANID_METAMSG = (-1);
CANID_WILDCARD = (-2);
kvENVVAR_TYPE_INT = 1;
kvENVVAR_TYPE_FLOAT = 2;
kvENVVAR_TYPE_STRING = 3;
kvEVENT_TYPE_KEY = 1;
kvSCRIPT_STOP_NORMAL = 0;
kvSCRIPT_STOP_FORCED = -9;
kvDEVICE_MODE_INTERFACE = $00;
kvDEVICE_MODE_LOGGER = $01;
canVERSION_CANLIB32_VERSION = 0;
canVERSION_CANLIB32_PRODVER = 1;
canVERSION_CANLIB32_PRODVER32 = 2;
canVERSION_CANLIB32_BETA = 3;
kvBUSTYPE_NONE = 0;
kvBUSTYPE_PCI = 1;
kvBUSTYPE_PCMCIA = 2;
kvBUSTYPE_USB = 3;
kvBUSTYPE_WLAN = 4;
kvBUSTYPE_PCI_EXPRESS = 5;
kvBUSTYPE_ISA = 6;
kvBUSTYPE_VIRTUAL = 7;
kvBUSTYPE_PC104_PLUS = 8;
kvBUSTYPE_LAN = 9;
kvBUSTYPE_GROUP_VIRTUAL = 1; ///< ::kvBUSTYPE_VIRTUAL
kvBUSTYPE_GROUP_LOCAL = 2; ///< ::kvBUSTYPE_USB
kvBUSTYPE_GROUP_REMOTE = 3; ///< ::kvBUSTYPE_WLAN
kvBUSTYPE_GROUP_INTERNAL = 4; ///< ::kvBUSTYPE_PCI, ::kvBUSTYPE_PCMCIA, ...
///
///
kvSCRIPT_REQUEST_TEXT_UNSUBSCRIBE = 1;
kvSCRIPT_REQUEST_TEXT_SUBSCRIBE = 2;
kvSCRIPT_REQUEST_TEXT_ALL_SLOTS = 255;
type
{ This one is primarily used by WCANKING }
TMsgRec = record
{This record holds information about a CAN message.}
envelope: Longint; {The CAN envelope.}
dlc: Integer; {The data length code.}
flag: Integer; {The flag have information about remote request and
#X Return flags}
case indexType: Integer of
0: (data: array[0..7] of AnsiChar); {CAN data as char.}
1: (shData: array[0..7] of ShortInt); {CAN data as shortint.}
2: (bData: array[0..7] of Byte); {CAN data as byte.}
3: (iData: array[0..3] of SmallInt); {CAN data as smallint.}
4: (lData: array[0..1] of LongInt); {CAN data as Longint.}
6: (wData: array[0..3] of Word); {CAN data as word.}
7: (tData: string[7]); {CAN data as string[7].}
8: (fData: array[0..1] of Single); {CAN data as float.}
9: (rData: Real); {CAN data as real.}
10: (dData: Double); {CAN data as double.}
11: (cData: Comp); {CAN data as comp.}
end;
{ This one is primarily used by WCANKING }
TMsgObj = class(TObject)
{ A TMsgObj holds a TMsgRec, so it can be used as an object in TStringList.}
public
{Public declarations}
txm: Boolean; {True if CAN message sent, false if received.}
time: LongInt; {Receive time in milliseconds.}
count: Integer; {Message number.}
MsgRec: TMsgRec; {The CAN message.}
end;
canMemoryAllocator = TFarProc; {Memory allocator, if nil malloc is used.}
canMemoryDeallocator = TFarProc; {Memory deallocator, if nil free is used.}
canAction = TFarProc; {Currently unsupported.}
BYTEPTR = PAnsiChar; {Byte pointer.}
{Can hardware descriptor, holds information about CAN card
and CAN circuit used.}
canHWDescr = record
circuitType: integer; { The CAN circuit.}
cardType: integer;
channel: integer;
end;
{ Used in canOpen. Obsolete. }
canSWDescr = record
rxBufSize: integer; {Requested receive buffer size [1, 32767].}
txBufSize: integer; {Requested transmit buffer size [0, 32767].}
alloc: canMemoryAllocator; {Memory allocator.}
deAlloc: canMemoryDeallocator; {Memory deallocator.}
end;
canSWDescrPointer = ^canSWDescr;
TWMCan = record {Type declaration for windows or dos message}
Msg: Cardinal;
case Integer of
0: (WParam: Cardinal;
LParam: Longint;
Result: Longint);
1: (handle: Cardinal; {CAN handle issuing message.}
minorMsg: Word; {Message types.}
status: Word; ); {Status.}
end;
canStatus = integer;
canHandle = integer;
kvEnvHandle = Int64;
canBusStatistics = record
stdData: Cardinal;
stdRemote: Cardinal;
extData: Cardinal;
extRemote: Cardinal;
errFrame: Cardinal; // Error frames
busLoad: Cardinal; // 0 .. 10000 meaning 0.00-100.00%
overruns: Cardinal;
end;
canUserIoPortData = record
portNo: Cardinal;
portValue: Cardinal;
end;
TCanInterface = class(TObject)
public
channel : Integer;
eanhi, eanlo : Cardinal;
serial : Cardinal;
hnd : canHandle;
name: String;
Constructor create(canChannel: Integer);overload;
private
end;
{------------------------------------------------------------+
| End of type definitions. |
+------------------------------------------------------------}
function canLocateHardware: canStatus; stdcall;
procedure canInitializeLibrary; stdcall;
function canUnloadLibrary: Integer; stdcall;
procedure SetDllName(s: string);
type
kvCallback_t = procedure(handle: canHandle; context: Pointer; notifyEvent: Cardinal); stdcall;
kvStatus = canStatus;
kvTimeDomain = Cardinal; { Really a pointer to something }
kvTimeDomainData = packed record
nMagiSyncGroups: Integer;
nMagiSyncedMembers: Integer;
nNonMagiSyncCards: Integer;
nNonMagiSyncedMembers: Integer;
end;
var
canOpen: function(const hwdescr: canHWDescr; swdescr: Pointer; flags: Cardinal): canHandle; stdcall;
canClose: function(handle: canHandle): canStatus; stdcall;
canBusOn: function(handle: canHandle): canStatus; stdcall;
canBusOff: function(handle: canHandle): canStatus; stdcall;
canSetBusParams: function(handle: canHandle; freq: Longint; tseg1, tseg2, sjw, noSamp, syncmode: Cardinal): canStatus; stdcall;
canGetBusParams: function(handle: canHandle; var freq: Longint; var tseg1, tseg2, sjw, noSamp, syncmode: Cardinal): canStatus; stdcall;
canSetBusParamsFd: function(handle: canHandle; freq: Longint; tseg1, tseg2, sjw: Cardinal): canStatus; stdcall;
canGetBusParamsFd: function(handle: canHandle; var freq: Longint; var tseg1, tseg2, sjw: Cardinal): canStatus; stdcall;
canSetBusOutputControl: function(handle: canHandle; drivertype: Cardinal): canStatus; stdcall;
canGetBusOutputControl: function(handle: canHandle; var drivertype: Cardinal): canStatus; stdcall;
canAccept: function(handle: canHandle; envelope: Longint; flag: Cardinal): canStatus; stdcall;
canReadStatus: function(handle: canHandle; var flags: Cardinal): canStatus; stdcall;
canReadErrorCounters: function(handle: canHandle; var txErr, rxErr, ovErr: Cardinal): canStatus; stdcall;
canWrite: function(handle: canHandle; id: Longint; msg: Pointer; dlc: Cardinal; flag: Cardinal): canStatus; stdcall;
canWriteSync: function(handle: canHandle; timeout: Cardinal): canStatus; stdcall;
canRead: function(handle: canHandle; var id: Longint; msg: Pointer; var dlc: Cardinal; var flag: Cardinal; var time: Cardinal): canStatus; stdcall;
canReadWait: function(handle: canHandle; var id: Longint; msg: Pointer; var dlc: Cardinal; var flag: Cardinal; var time: Cardinal; timeout: Cardinal): canStatus; stdcall;
canReadSpecific: function(handle: canHandle; id: Longint; msg: Pointer; var dlc: Cardinal; var flag: Cardinal; var time: Cardinal): canStatus; stdcall;
canReadSync: function(handle: canHandle; timeout: Cardinal): canStatus; stdcall;
canReadSyncSpecific: function(handle: canHandle; id, timeout: Cardinal): canStatus; stdcall;
canReadSpecificSkip: function(handle: canHandle; id: Longint; msg: Pointer; var dlc: Cardinal; var flag: Cardinal; var time: Cardinal): canStatus; stdcall;
canInstallAction: function(handle: canHandle; id: Longint; fn: Pointer): canStatus; stdcall;
canUninstallAction: function(handle: canHandle; id: Longint): canStatus; stdcall;
canInstallOwnBuffer: function(handle: canHandle; id: Longint; len: Cardinal; buf: Pointer): canStatus; stdcall;
canUninstallOwnBuffer: function(handle: canHandle; id: Longint): canStatus; stdcall;
canSetNotify: function(handle: canHandle; aHWnd: HWND; aNotifyFlags: Cardinal): canStatus; stdcall;
canTranslateBaud: function(var freq: longint; var tseg1, tseg2, sjw, noSamp, syncMode: Cardinal): canStatus; stdcall;
canGetErrorText: function(err: canStatus; buf: PAnsiChar; bufsiz: Cardinal): canStatus; stdcall;
canGetVersion: function: Word; stdcall;
canIoCtl: function(handle: canHandle; func: Cardinal; buf: Pointer; buflen: Cardinal): canStatus; stdcall;
canReadTimer: function(handle: canHandle): Cardinal; stdcall;
kvReadTimer: function(handle: canHandle; var time: Cardinal): kvStatus; stdcall;
kvReadTimer64: function(handle: canHandle; var time: Int64): kvStatus; stdcall;
canGetNumberOfChannels: function(var channelCount: Integer): canStatus; stdcall;
canGetChannelData: function(channel, item: Integer; var buffer; bufsize: Cardinal): canStatus; stdcall;
canOpenChannel: function(channel: Integer; flags: Integer): canHandle; stdcall;
canWaitForEvent: function(hnd: canHandle; timeout: Cardinal): canStatus; stdcall;
canSetBusParamsC200: function(hnd: canHandle; btr0, btr1: byte): canStatus; stdcall;
canGetVersionEx: function(itemCode: Cardinal): Cardinal; stdcall;
canSetDriverMode: function(hnd: canHandle; lineMode, resNet: Integer): canStatus; stdcall;
canGetDriverMode: function(hnd: canHandle; var lineMode: Integer; var resNet: Integer): canStatus; stdcall;
canParamGetCount: function(): canStatus; stdcall;
canParamCommitChanges: function(): canStatus; stdcall;
canParamDeleteEntry: function(index: Integer): canStatus; stdcall;
canParamCreateNewEntry: function(): canStatus; stdcall;
canParamSwapEntries: function(index1, index2: Integer): canStatus; stdcall;
canParamGetName: function(index: Integer; buffer: PAnsiChar; maxlen: Integer): canStatus; stdcall;
canParamGetChannelNumber: function(index: Integer): canStatus; stdcall;
canParamGetBusParams: function(index: Integer; var bitrate: LongInt; var tseg1: Cardinal; var tseg2: Cardinal; var sjw: Cardinal; var nosamp: Cardinal): canStatus; stdcall;
canParamSetName: function(index: Integer; buffer: PAnsiChar): canStatus; stdcall;
canParamSetChannelNumber: function(index, channel: Integer): canStatus; stdcall;
canParamSetBusParams: function(index: Integer; bitrate: longint; tseq1, tseq2, sjw, noSamp: Cardinal): canStatus; stdcall;
canParamFindByName: function(const Name: PAnsiChar):canStatus; stdcall;
canObjBufFreeAll: function(handle: canHandle): canStatus; stdcall;
canObjBufAllocate: function(handle: canHandle; tp: Integer): canStatus; stdcall;
canObjBufFree: function(handle: canHandle; idx: Integer): canStatus; stdcall;
canObjBufWrite: function(handle: canHandle; idx, id: Integer; var msg; dlc, flags: cardinal): canstatus; stdcall;
canObjBufSetFilter: function(handle: canHandle; idx: Integer; code, mask: Cardinal): canStatus; stdcall;
canObjBufSetFlags: function(handle: canHandle; idx: Integer; flags: Cardinal): canStatus; stdcall;
canObjBufEnable: function(handle: canHandle; idx: Integer): canStatus; stdcall;
canObjBufDisable: function(handle: canHandle; idx: Integer): canStatus; stdcall;
canObjBufSetPeriod: function(handle: canHandle; idx: Integer; period: Cardinal): canStatus; stdcall;
canObjBufSetMsgCount: function(handle: canHandle; idx: Integer; count: Cardinal): canStatus; stdcall;
canObjBufSendBurst: function(handle: canHandle; idx: Integer; burstLen: Cardinal): canStatus; stdcall;
canProbeVersion: function(handle: canHandle; major, minor, oem_id: Integer; flags: Cardinal): Boolean; stdcall;
canResetBus: function(handle: canHandle): canStatus; stdcall;
canWriteWait: function(handle: canHandle; id: longint; var msg; dlc, flag, timeout : Cardinal): canStatus; stdcall;
canSetAcceptanceFilter: function(handle: canHandle; code, mask: Cardinal; is_extended: Integer): canStatus; stdcall;
canFlushReceiveQueue: function(handle: canHandle): canStatus; stdcall;
canFlushTransmitQueue: function(handle: canHandle): canStatus; stdcall;
canRequestChipStatus:function(handle: canHandle): canStatus; stdcall;
canRequestBusStatistics: function(handle: canHandle): canStatus; stdcall;
canGetBusStatistics: function(handle: canHandle; var stat: canBusStatistics; bufsiz: Cardinal): canStatus; stdcall;
kvAnnounceIdentity: function(handle: canHandle; var buf; bufsiz: Cardinal): canStatus; stdcall;
kvAnnounceIdentityEx: function(handle: canHandle; typ: Integer; var buf; bufsiz: Cardinal): canStatus; stdcall;
kvSetNotifyCallback: function(handle: canHandle; callback: kvCallback_t; context: Pointer; notifyFlags: Cardinal): canStatus; stdcall;
kvBeep: function(handle: canHandle; freq: Integer; duration: Cardinal): canStatus; stdcall;
kvSelfTest: function(handle: canHandle; var presults: Cardinal): canStatus; stdcall;
kvFlashLeds: function(handle: canHandle; action: Integer; timeout: Integer): canStatus; stdcall;
canSetBitrate: function(handle: canHandle; bitrate: Integer): canStatus; stdcall;
canGetHandleData: function(handle: canHandle; item: Integer; var Buffer; bufsize: Cardinal): canStatus; stdcall;
kvGetApplicationMapping: function(busType: Integer; appName: PAnsiChar; appChannel: Integer; var resultingChannel: Integer): canStatus; stdcall;
kvTimeDomainCreate: function(var domain: kvTimeDomain): kvStatus; stdcall;
kvTimeDomainDelete: function(domain: kvTimeDomain): kvStatus; stdcall;
kvTimeDomainResetTime: function(domain: kvTimeDomain): kvStatus; stdcall;
kvTimeDomainGetData: function(domain: kvTimeDomain; var data: kvTimeDomainData; bufsiz: Cardinal): kvStatus; stdcall;
kvTimeDomainAddHandle: function(domain: kvTimeDomain; handle: canHandle): kvStatus; stdcall;
kvTimeDomainRemoveHandle: function(domain: kvTimeDomain; handle: canHandle): kvStatus; stdcall;
kvReadDeviceCustomerData: function(hnd: canHandle;userNumber, itemNumber: Integer; var data; bufsize: Cardinal): kvStatus; stdcall;
kvGetSupportedInterfaceInfo: function(index: Integer; hwName: PAnsiChar; nameLen: Cardinal; var hwType: Integer; var hwBusType: Integer): kvStatus; stdcall;
kvScriptStart: function(const hnd: canHandle; slotNo: integer): kvStatus; stdcall;
kvScriptStatus: function(const hnd: canHandle; slotNo: integer; var status: integer): kvStatus; stdcall;
kvScriptStop: function(const hnd: canHandle; slotNo: integer; mode: integer): kvStatus; stdcall;
kvScriptUnload: function(const hnd: canHandle; slotNo: integer): kvStatus; stdcall;
kvScriptSendEvent: function(const hnd: canHandle;
slotNo: integer;
eventType: integer;
eventNo: integer;
data: Cardinal): kvStatus; stdcall;
kvScriptEnvvarOpen: function(const hnd: canHandle; envvarName: PAnsiChar; var envvarType: Integer; var envvarSize: Integer): kvEnvHandle; stdcall;
kvScriptEnvvarClose: function(const eHnd: kvEnvHandle): kvStatus; stdcall;
kvScriptEnvvarSetInt: function(const eHnd: kvEnvHandle; val: Integer): kvStatus; stdcall;
kvScriptEnvvarGetInt: function(const eHnd: kvEnvHandle; var val: Integer): kvStatus; stdcall;
kvScriptEnvvarSetFloat: function(const eHnd: kvEnvHandle; val: Single): kvStatus; stdcall;
kvScriptEnvvarGetFloat: function(const eHnd: kvEnvHandle; var val: Single): kvStatus; stdcall;
kvScriptEnvvarSetData: function(const eHnd: kvEnvHandle; var buf; start_index: Integer; data_len: Integer): kvStatus; stdcall;
kvScriptEnvvarGetData: function(const eHnd: kvEnvHandle; var buf; start_index: Integer; data_len: Integer): kvStatus; stdcall;
kvScriptGetMaxEnvvarSize: function(hnd: canHandle; var envvarSize: Integer): kvStatus; stdcall;
kvScriptLoadFileOnDevice: function(hnd: canHandle; slotNo: Integer; localFile: PAnsiChar): kvStatus; stdcall;
kvScriptLoadFile: function(hnd: canHandle; slotNo: Integer; filePathOnPC: PAnsiChar): kvStatus; stdcall;
kvScriptRequestText: function(hnd: canHandle; slotNo: cardinal; request: cardinal): kvStatus; stdcall;
kvScriptGetText: function(hnd: canHandle; var slot: integer; var time: Cardinal; var flags: Cardinal; buf: PAnsiChar; bufsize: Cardinal): kvStatus; stdcall;
kvFileCopyToDevice: function(hnd: canHandle; hostFileName: PAnsiChar; deviceFileName: PAnsiChar): kvStatus; stdcall;
kvFileCopyFromDevice: function(hnd: canHandle; deviceFileName: PAnsiChar; hostFileName: PAnsiChar): kvStatus; stdcall;
kvFileDelete: function(hnd: canHandle; deviceFileName: PAnsiChar): kvStatus; stdcall;
kvFileGetName: function(hnd: canHandle; fileNo: Integer; name: PAnsiChar; namelen: Integer): kvStatus; stdcall;
kvFileGetCount: function(hnd: canHandle; var count: Integer): kvStatus; stdcall;
kvFileGetSystemData: function(hnd: canHandle; itemCode: Integer; var result: Integer): kvStatus; stdcall;
kvDeviceSetMode: function(hnd: canHandle; mode: Integer): kvStatus; stdcall;
kvDeviceGetMode: function(hnd: canHandle; var mode: Integer): kvStatus; stdcall;
kvPingRequest: function(hnd: canHandle; var requestTime: Cardinal): kvStatus; stdcall;
kvPingGetLatest: function(hnd: canHandle; var requestTime: Cardinal; var pingTime: Cardinal): kvStatus; stdcall;
const
kvLED_ACTION_ALL_LEDS_ON = 0;
kvLED_ACTION_ALL_LEDS_OFF = 1;
kvLED_ACTION_LED_0_ON = 2;
kvLED_ACTION_LED_0_OFF = 3;
kvLED_ACTION_LED_1_ON = 4;
kvLED_ACTION_LED_1_OFF = 5;
kvLED_ACTION_LED_2_ON = 6;
kvLED_ACTION_LED_2_OFF = 7;
kvLED_ACTION_LED_3_ON = 8;
kvLED_ACTION_LED_3_OFF = 9;
canCHANNELDATA_CHANNEL_CAP = 1;
canCHANNELDATA_TRANS_CAP = 2;
canCHANNELDATA_CHANNEL_FLAGS = 3; // available, etc
canCHANNELDATA_CARD_TYPE = 4; // canHWTYPE_xxx
canCHANNELDATA_CARD_NUMBER = 5; // Number in machine, 0,1,...
canCHANNELDATA_CHAN_NO_ON_CARD = 6;
canCHANNELDATA_CARD_SERIAL_NO = 7;
canCHANNELDATA_TRANS_SERIAL_NO = 8;
canCHANNELDATA_CARD_FIRMWARE_REV = 9;
canCHANNELDATA_CARD_HARDWARE_REV = 10;
canCHANNELDATA_CARD_UPC_NO = 11;
canCHANNELDATA_TRANS_UPC_NO = 12;
canCHANNELDATA_CHANNEL_NAME = 13;
canCHANNELDATA_DLL_FILE_VERSION = 14;
canCHANNELDATA_DLL_PRODUCT_VERSION = 15;
canCHANNELDATA_DLL_FILETYPE = 16;
canCHANNELDATA_TRANS_TYPE = 17;
canCHANNELDATA_DEVICE_PHYSICAL_POSITION = 18;
canCHANNELDATA_UI_NUMBER = 19;
canCHANNELDATA_TIMESYNC_ENABLED = 20;
canCHANNELDATA_DRIVER_FILE_VERSION = 21;
canCHANNELDATA_DRIVER_PRODUCT_VERSION = 22;
canCHANNELDATA_MFGNAME_UNICODE = 23;
canCHANNELDATA_MFGNAME_ASCII = 24;
canCHANNELDATA_DEVDESCR_UNICODE = 25;
canCHANNELDATA_DEVDESCR_ASCII = 26;
canCHANNELDATA_DRIVER_NAME = 27;
canCHANNELDATA_CHANNEL_QUALITY = 28;
canCHANNELDATA_ROUNDTRIP_TIME = 29;
canCHANNELDATA_BUS_TYPE = 30;
canCHANNELDATA_DEVNAME_ASCII = 31;
canCHANNELDATA_TIME_SINCE_LAST_SEEN = 32;
canCHANNELDATA_REMOTE_OPERATIONAL_MODE = 33;
canCHANNELDATA_REMOTE_PROFILE_NAME = 34;
canCHANNELDATA_REMOTE_HOST_NAME = 35;
canCHANNELDATA_REMOTE_MAC = 36;
canCHANNELDATA_MAX_BITRATE = 37;
canCHANNELDATA_CHANNEL_CAP_MASK = 38;
canCHANNELDATA_CUST_CHANNEL_NAME = 39;
canCHANNELDATA_IS_REMOTE = 40;
canCHANNELDATA_REMOTE_TYPE = 41;
canCHANNELDATA_LOGGER_TYPE = 42;
// channelFlags in canChannelData
canCHANNEL_IS_EXCLUSIVE = $0001;
canCHANNEL_IS_OPEN = $0002;
canCHANNEL_IS_CANFD = $0004;
// For canOpen(), canOpenChannel()
canWANT_EXCLUSIVE = $08; { Don't allow sharing }
canWANT_EXTENDED = $10; { Extended CAN is required }
canWANT_VIRTUAL = $0020;
canOPEN_EXCLUSIVE = canWANT_EXCLUSIVE;
canOPEN_REQUIRE_EXTENDED = canWANT_EXTENDED;
canOPEN_ACCEPT_VIRTUAL = canWANT_VIRTUAL;
canOPEN_OVERRIDE_EXCLUSIVE = $0040;
canOPEN_REQUIRE_INIT_ACCESS = $0080;
canOPEN_NO_INIT_ACCESS = $0100;
canOPEN_ACCEPT_LARGE_DLC = $0200;
canOPEN_CAN_FD = $0400;
canOPEN_CAN_FD_NONISO = $0800;
// Hardware types.
canHWTYPE_NONE = 0; // Unknown
canHWTYPE_VIRTUAL = 1; // Virtual channel.
canHWTYPE_LAPCAN = 2; // LAPcan family
canHWTYPE_CANPARI = 3; // CANpari (not supported.)
canHWTYPE_PCCAN = 8; // PCcan family
canHWTYPE_PCICAN = 9; // PCIcan family
canHWTYPE_USBCAN = 11; // USBcan family
canHWTYPE_PCICAN_II = 40;
canHWTYPE_USBCAN_II = 42;
canHWTYPE_SIMULATED = 44;
canHWTYPE_ACQUISITOR = 46;
canHWTYPE_LEAF = 48;
canHWTYPE_PC104_PLUS = 50; // PC104+
canHWTYPE_PCICANX_II = 52; // PCIcanx II
canHWTYPE_MEMORATOR_II = 54; // Memorator Professional
canHWTYPE_MEMORATOR_PRO = 54; // Memorator Professional
canHWTYPE_USBCAN_PRO = 56; // USBcan Professional
canHWTYPE_IRIS = 58; // Obsolete name, use canHWTYPE_BLACKBIRD instead
canHWTYPE_BLACKBIRD = 58;
canHWTYPE_MEMORATOR_LIGHT = 60; ///< Kvaser Memorator Light
canHWTYPE_MINIHYDRA = 62; ///< Obsolete name, use canHWTYPE_EAGLE instead
canHWTYPE_EAGLE = 62; ///< Kvaser Eagle family
canHWTYPE_BAGEL = 64; ///< Obsolete name, use canHWTYPE_BLACKBIRD_V2 instead
canHWTYPE_BLACKBIRD_V2 = 64; ///< Kvaser BlackBird v2
canHWTYPE_MINIPCIE = 66; ///< "Mini PCI Express" for now, subject to change.
canHWTYPE_USBCAN_KLINE = 68; ///< USBcan Pro HS/K-Line
canHWTYPE_ETHERCAN = 70; ///< Kvaser Ethercan
canHWTYPE_USBCAN_LIGHT = 72; ///< Kvaser USBcan Light
canHWTYPE_USBCAN_PRO2 = 74; ///< Kvaser USBcan Pro 5xHS
canHWTYPE_PCIE_V2 = 76; ///< PCIe for now
canHWTYPE_MEMORATOR_PRO2 = 78; ///< Kvaser Memorator Pro 5xHS
canHWTYPE_LEAF2 = 80; ///< Kvaser Leaf Pro HS v2 and variants
canHWTYPE_MEMORATOR_V2 = 82; ///< Kvaser Memorator (2nd generation)
canTRANSCEIVER_TYPE_UNKNOWN = 0;
canTRANSCEIVER_TYPE_251 = 1;
canTRANSCEIVER_TYPE_252 = 2;
canTRANSCEIVER_TYPE_DNOPTO = 3;
canTRANSCEIVER_TYPE_W210 = 4;
canTRANSCEIVER_TYPE_SWC_PROTO = 5;
canTRANSCEIVER_TYPE_SWC = 6;
canTRANSCEIVER_TYPE_EVA = 7;
canTRANSCEIVER_TYPE_FIBER = 8;
canTRANSCEIVER_TYPE_K251 = 9;
canTRANSCEIVER_TYPE_K = 10;
canTRANSCEIVER_TYPE_1054_OPTO = 11;
canTRANSCEIVER_TYPE_SWC_OPTO = 12;
canTRANSCEIVER_TYPE_TT = 13;
canTRANSCEIVER_TYPE_1050 = 14;
canTRANSCEIVER_TYPE_1050_OPTO = 15;
canTRANSCEIVER_TYPE_1041 = 16;
canTRANSCEIVER_TYPE_1041_OPTO = 17;
canTRANSCEIVER_TYPE_RS485 = 18;
canTRANSCEIVER_TYPE_LIN = 19;
canTRANSCEIVER_TYPE_KONE = 20;
canTRANSCEIVER_TYPE_CANFD = 22;
canTRANSCEIVER_TYPE_LINX_LIN = 64;
canTRANSCEIVER_TYPE_LINX_J1708 = 66;
canTRANSCEIVER_TYPE_LINX_K = 68;
canTRANSCEIVER_TYPE_LINX_SWC = 70;
canTRANSCEIVER_TYPE_LINX_LS = 72;
// Channel capabilities.
canCHANNEL_CAP_EXTENDED_CAN = $00000001; ///< Can use extended identifiers
canCHANNEL_CAP_BUS_STATISTICS = $00000002; ///< Can report busload etc
canCHANNEL_CAP_ERROR_COUNTERS = $00000004; ///< Can return error counters
canCHANNEL_CAP_CAN_DIAGNOSTICS = $00000008; ///< Can report CAN diagnostics
canCHANNEL_CAP_GENERATE_ERROR = $00000010; ///< Can send error frames
canCHANNEL_CAP_GENERATE_OVERLOAD = $00000020; ///< Can send CAN overload frame
canCHANNEL_CAP_TXREQUEST = $00000040; ///< Can report when a CAN messsage transmission is initiated
canCHANNEL_CAP_TXACKNOWLEDGE = $00000080; ///< Can report when a CAN messages has been transmitted
canCHANNEL_CAP_VIRTUAL = $00010000; ///< Virtual CAN channel
canCHANNEL_CAP_SIMULATED = $00020000; ///< Simulated CAN channel
canCHANNEL_CAP_REMOTE = $00040000; ///< Remote CAN channel (e.g. BlackBird).
canCHANNEL_CAP_CAN_FD = $00080000; ///< CAN-FD ISO compliant channel
canCHANNEL_CAP_CAN_FD_NONISO = $00100000; ///< CAN-FD NON-ISO compliant channel
canCHANNEL_CAP_SILENT_MODE = $00200000; ///< Channel supports Silent mode
canCHANNEL_CAP_SINGLE_SHOT = $00400000; ///< Channel supports Single Shot messages
canCHANNEL_CAP_LOGGER = $00800000; ///< Channel has logger capabilities.
canCHANNEL_CAP_REMOTE_ACCESS = $01000000; ///< Channel has remote capabilities
canCHANNEL_CAP_SCRIPT = $02000000; ///< Channel has script capabilities.
// Driver (transceiver) capabilities
canDRIVER_CAP_HIGHSPEED = $00000001;
implementation
uses
SysUtils;
var
hDLL: THandle;
realCanLocateHardware: function: canStatus;
realCanInitializeLibrary: procedure;
realCanUnloadLibrary: function: Integer;
DLLName: array[0..50] of char = 'CANLIB32.DLL';
Constructor TCanInterface.create(canChannel: Integer) overload;
Var
cname: packed array[0..256] of AnsiChar;
begin
channel := canChannel;
canGetChannelData(channel, canCHANNELDATA_CHANNEL_NAME, cname, 256);
//OutputDebugString(PCHAR(inttostr(status)));
name := Format('%s', [cname]);
//Inherited Create;
end;
procedure LoadDLL; forward;
procedure UnloadDLL; forward;
procedure canInitializeLibrary;
begin
if hDLL <> 0 then Exit;
LoadDLL;
if hDLL <> 0 then begin
realCanInitializeLibrary;
end;
end;
function canLocateHardware: canStatus;
begin
if hDLL <> 0 then begin
Result := canOK;
Exit;
end;
LoadDLL;
if hDLL = 0 then begin
Result := canERR_DYNALOAD;
end else begin
Result := realCanLocateHardware;
end;
end;
function canUnloadLibrary: Integer;
begin
if hDLL = 0 then begin
Result := canOK;
Exit;
end;
if Assigned(realCanUnloadLibrary) then realCanUnloadLibrary;
UnloadDLL;
Result := canOK;
end;
function GPA(const proc: string): Pointer;
var s: array[0..300] of char;
begin
StrPCopy(s, proc);
Result := GetProcAddress(hDLL, s);
if Result = nil then begin
raise Exception.CreateFmt('CANLIB: function %s not found.', [proc]);
end;
end;
procedure SetDllName(s: string);
begin
StrPCopy(DLLName, s);
end;
procedure LoadDLL;
var
err: integer;
begin
hDLL := LoadLibrary(DLLName);
err := GetLastError;
if hDLL = 0 then begin
raise Exception.Create(Format('Can not load the CAN driver - is it correctly installed? ' +
'(Error 0x%8.8x)', [err]));
Exit;
end;
@realCanLocateHardware := GPA('canLocateHardware');
@realCanInitializeLibrary := GPA('canInitializeLibrary');
@canOpen := GPA('canOpen');
@canClose := GPA('canClose');
@canBusOn := GPA('canBusOn');
@canBusOff := GPA('canBusOff');
@canSetBusParams := GPA('canSetBusParams');
@canGetBusParams := GPA('canGetBusParams');
@canSetBusParamsFd := GPA('canSetBusParamsFd');
@canGetBusParamsFd := GPA('canGetBusParamsFd');
@canSetBusOutputControl := GPA('canSetBusOutputControl');
@canGetBusOutputControl := GPA('canGetBusOutputControl');
@canAccept := GPA('canAccept');
@canReadStatus := GPA('canReadStatus');
@canReadErrorCounters := GPA('canReadErrorCounters');
@canWrite := GPA('canWrite');
@canWriteSync := GPA('canWriteSync');
@canRead := GPA('canRead');
@canReadWait := GPA('canReadWait');
@canReadSpecific := GPA('canReadSpecific');
@canReadSync := GPA('canReadSync');
@canReadSyncSpecific := GPA('canReadSyncSpecific');
@canReadSpecificSkip := GPA('canReadSpecificSkip');
@canInstallAction := nil;
@canUninstallAction := nil;
@canInstallOwnBuffer := nil;
@canUninstallOwnBuffer := nil;
@canSetNotify := GPA('canSetNotify');
@canTranslateBaud := GPA('canTranslateBaud');
@canGetErrorText := GPA('canGetErrorText');
@canGetVersion := GPA('canGetVersion');
@canIoCtl := GPA('canIoCtl');
@canReadTimer := GPA('canReadTimer');
@canGetNumberOfChannels := GPA('canGetNumberOfChannels');
@canGetChannelData := GPA('canGetChannelData');
@canOpenChannel := GPA('canOpenChannel');
@canWaitForEvent := GPA('canWaitForEvent');
@canSetBusParamsC200 := GPA('canSetBusParamsC200');
@canGetVersionEx := GPA('canGetVersionEx');
@canSetDriverMode := GPA('canSetDriverMode');
@canGetDriverMode := GPA('canGetDriverMode');
@canParamGetCount := GPA('canParamGetCount');
@canParamCommitChanges := GPA('canParamCommitChanges');
@canParamDeleteEntry := GPA('canParamDeleteEntry');
@canParamCreateNewEntry := GPA('canParamCreateNewEntry');
@canParamSwapEntries := GPA('canParamSwapEntries');
@canParamGetName := GPA('canParamGetName');
@canParamGetChannelNumber := GPA('canParamGetChannelNumber');
@canParamGetBusParams := GPA('canGetBusParams');
@canParamSetName := GPA('canParamSetName');
@canParamSetChannelNumber := GPA('canParamSetChannelNumber');
@canParamSetBusParams := GPA('canParamSetBusParams');
@canParamFindByName := GPA('canParamFindByName');
@canObjBufFreeAll := GPA('canObjBufFreeAll');
@canObjBufAllocate := GPA('canObjBufAllocate');
@canObjBufFree := GPA('canObjBufFree');
@canObjBufWrite := GPA('canObjBufWrite');
@canObjBufSetFilter := GPA('canObjBufSetFilter');
@canObjBufSetFlags := GPA('canObjBufSetFilter');
@canObjBufEnable := GPA('canObjBufEnable');
@canObjBufDisable := GPA('canObjBufDisable');
@canProbeVersion := GPA('canProbeVersion');
@canResetBus := GPA('canResetBus');
@canWriteWait := GPA('canWriteWait');
@canSetAcceptanceFilter :=GPA('canSetAcceptanceFilter');
@canRequestChipStatus := GPA('canRequestChipStatus');
@canRequestBusStatistics := GPA('canRequestBusStatistics');
@canGetBusStatistics := GPA('canGetBusStatistics');
@kvAnnounceIdentity := GPA('kvAnnounceIdentity');
@kvSetNotifyCallback := GPA('kvSetNotifyCallback');
@kvBeep := GPA('kvBeep');
@kvSelfTest := GPA('kvSelfTest');
@kvFlashLeds := GPA('kvFlashLeds');
@canSetBitrate := GPA('canSetBitrate');
@canGetHandleData := GPA('canGetHandleData');
@kvTimeDomainCreate := GPA('kvTimeDomainCreate');
@kvTimeDomainDelete := GPA('kvTimeDomainDelete');
@kvTimeDomainResetTime := GPA('kvTimeDomainResetTime');
@kvTimeDomainGetData := GPA('kvTimeDomainGetData');
@kvTimeDomainAddHandle := GPA('kvTimeDomainAddHandle');
@kvTimeDomainRemoveHandle := GPA('kvTimeDomainRemoveHandle');
@kvReadDeviceCustomerData := GPA('kvReadDeviceCustomerData');
@kvReadTimer := GPA('kvReadTimer');
@kvReadTimer64 := GPA('kvReadTimer64');
@canObjBufSetPeriod := GPA('canObjBufSetPeriod');
@canObjBufSetMsgCount := GPA('canObjBufSetMsgCount');
@canObjBufSendBurst := GPA('canObjBufSendBurst');
@canFlushReceiveQueue := GPA('canFlushReceiveQueue');
@canFlushTransmitQueue := GPA('canFlushTransmitQueue');
@kvAnnounceIdentityEx := GPA('kvAnnounceIdentityEx');
@kvGetApplicationMapping := GPA('kvGetApplicationMapping');
@kvGetSupportedInterfaceInfo := GPA('kvGetSupportedInterfaceInfo');
@kvScriptStart := GPA('kvScriptStart');
@kvScriptStatus := GPA('kvScriptStatus');
@kvScriptStop := GPA('kvScriptStop');
@kvScriptUnload := GPA('kvScriptUnload');
@kvScriptSendEvent := GPA('kvScriptSendEvent');
@kvScriptEnvvarOpen := GPA('kvScriptEnvvarOpen');
@kvScriptEnvvarClose := GPA('kvScriptEnvvarClose');
@kvScriptEnvvarSetInt := GPA('kvScriptEnvvarSetInt');
@kvScriptEnvvarGetInt := GPA('kvScriptEnvvarGetInt');
@kvScriptEnvvarSetFloat := GPA('kvScriptEnvvarSetFloat');
@kvScriptEnvvarGetFloat := GPA('kvScriptEnvvarGetFloat');
@kvScriptEnvvarSetData := GPA('kvScriptEnvvarSetData');
@kvScriptEnvvarGetData := GPA('kvScriptEnvvarGetData');
@kvScriptGetMaxEnvvarSize := GPA('kvScriptGetMaxEnvvarSize');
@kvScriptLoadFileOnDevice := GPA('kvScriptLoadFileOnDevice');
@kvScriptLoadFile := GPA('kvScriptLoadFile');
@kvScriptRequestText := GPA('kvScriptRequestText');
@kvScriptGetText := GPA('kvScriptGetText');
@kvFileCopyToDevice := GPA('kvFileCopyToDevice');
@kvFileCopyFromDevice := GPA('kvFileCopyFromDevice');
@kvFileDelete := GPA('kvFileDelete');
@kvFileGetName := GPA('kvFileGetName');
@kvFileGetCount := GPA('kvFileGetCount');
@kvFileGetSystemData := GPA('kvFileGetSystemData');
@kvDeviceSetMode := GPA('kvDeviceSetMode');
@kvDeviceGetMode := GPA('kvDeviceGetMode');
@kvPingRequest := GPA('kvPingRequest');
@kvPingGetLatest := GPA('kvPingGetLatest');
{--}
@realCanUnloadLibrary := GPA('canUnloadLibrary');
end;
procedure UnloadDLL;
begin
if not Assigned(realCanUnloadLibrary) then Exit;
realCanUnloadLibrary;
FreeLibrary(hDLL);
hDLL := 0;
end;
end.

694
Host/Source/MicroBoot/interfaces/can/kvaser/openblt_can_kvaser.dpr
View File

@ -1,694 +0,0 @@
library openblt_can_kvaser;
//***************************************************************************************
// Project Name: MicroBoot Interface for Delphi
// Description: XCP - CAN interface for MicroBoot supporting Kvaser Leaf Light v2
// File Name: openblt_can_kvaser.dpr
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2017 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',
XcpLoader in '..\..\XcpLoader.pas',
XcpTransport in 'XcpTransport.pas',
XcpSettings in 'XcpSettings.pas' {XcpSettingsForm},
FirmwareData in '..\..\FirmwareData.pas';
//***************************************************************************************
// 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 : TFirmwareData;
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;
segmentCnt : longword;
byteCnt : longword;
currentWriteCnt : word;
sessionStartResult : byte;
bufferOffset : longword;
addr : longword;
len : longword;
dataSizeKB : real;
dataSizeBytes : integer;
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
// disconnect the transport layer
MbiCallbackOnLog('Disconnecting the transport layer. t='+ShortString(TimeToStr(Time)));
loader.Disconnect;
MbiCallbackOnLog('Programming session cancelled by user. t='+ShortString(TimeToStr(Time)));
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)));
// read the firmware file
MbiCallbackOnInfo('Reading firmware file.');
MbiCallbackOnLog('Reading firmware file. t='+ShortString(TimeToStr(Time)));
// create the datafile object and load the file contents
datafile := TFirmwareData.Create;
if not datafile.LoadFromFile(progfile, False) then
begin
MbiCallbackOnLog('Could not read firmware file (' + ShortString(ExtractFilename(progfile)) +'). t='+ShortString(TimeToStr(Time)));
MbiCallbackOnError('Could not read firmware file (' + ShortString(ExtractFilename(progfile)) +').');
datafile.Free;
Exit;
end;
// compute the size in kbytes
dataSizeBytes := 0;
// loop through all segment to get the total byte count
for segmentCnt := 0 to (datafile.SegmentCount - 1) do
begin
dataSizeBytes := dataSizeBytes + datafile.Segment[segmentCnt].Size;
end;
// convert bytes to kilobytes
dataSizeKB := dataSizeBytes / 1024;
// Call application callback when we start the actual download
MbiCallbackOnStarted(dataSizeBytes);
// Init progress to 0 progress
progress := 0;
MbiCallbackOnProgress(progress);
//---------------- next clear the memory regions --------------------------------------
// update the user info
MbiCallbackOnInfo('Erasing memory...');
for segmentCnt := 0 to (datafile.SegmentCount - 1) do
begin
// check if the user cancelled
if stopRequest then
begin
// disconnect the transport layer
MbiCallbackOnLog('Disconnecting the transport layer. t='+ShortString(TimeToStr(Time)));
loader.Disconnect;
MbiCallbackOnLog('Programming session cancelled by user. t='+ShortString(TimeToStr(Time)));
MbiCallbackOnError('Programming session cancelled by user.');
datafile.Free;
Exit;
end;
// obtain the region info
addr := datafile.Segment[segmentCnt].BaseAddress;
len := datafile.Segment[segmentCnt].Size;
// 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 segmentCnt := 0 to (datafile.SegmentCount - 1) do
begin
// update the user info
MbiCallbackOnInfo('Reading file...');
// obtain the region info
addr := datafile.Segment[segmentCnt].BaseAddress;
len := datafile.Segment[segmentCnt].Size;
SetLength(progdata, len);
for byteCnt := 0 to (len - 1) do
begin
progdata[byteCnt] := datafile.Segment[segmentCnt].Data[byteCnt];
end;
bufferOffset := 0;
while len > 0 do
begin
// check if the user cancelled
if stopRequest then
begin
// disconnect the transport layer
MbiCallbackOnLog('Disconnecting the transport layer. t='+ShortString(TimeToStr(Time)));
loader.Disconnect;
MbiCallbackOnLog('Programming session cancelled by user. t='+ShortString(TimeToStr(Time)));
MbiCallbackOnError('Programming session cancelled by user.');
datafile.Free;
Exit;
end;
// 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 := dataSizeBytes;
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_kvaser.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;
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 Kvaser';
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 Kvaser CAN Interface';
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 := 10100; // v1.01.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_kvaser.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_kvaser.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_kvaser.dpr **********************

120
Host/Source/MicroBoot/interfaces/can/kvaser/openblt_can_kvaser.dproj
View File

@ -1,120 +0,0 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{C587575B-3E1C-4EA4-BB4F-912B83127DCE}</ProjectGuid>
<MainSource>openblt_can_kvaser.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Library</AppType>
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>18.2</ProjectVersion>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
<Cfg_2_Win32>true</Cfg_2_Win32>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_N>true</DCC_N>
<DCC_ExeOutput>../../../../../</DCC_ExeOutput>
<SanitizedProjectName>openblt_can_kvaser</SanitizedProjectName>
<DCC_SymbolReferenceInfo>1</DCC_SymbolReferenceInfo>
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace)</DCC_Namespace>
<DCC_ImageBase>00400000</DCC_ImageBase>
<DCC_Alignment>1</DCC_Alignment>
<DCC_E>false</DCC_E>
<DCC_K>false</DCC_K>
<DCC_F>false</DCC_F>
<GenDll>true</GenDll>
<DCC_UsePackage>Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40;$(DCC_UsePackage)</DCC_UsePackage>
<DCC_WriteableConstants>true</DCC_WriteableConstants>
<VerInfo_Locale>1031</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<DCC_DebugInformation>1</DCC_DebugInformation>
<DCC_S>false</DCC_S>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_Namespace>System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Locale>1033</VerInfo_Locale>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_DebugInformation>0</DCC_DebugInformation>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_Optimize>false</DCC_Optimize>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<VerInfo_Keys>CompanyName=;FileVersion=1.1.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.1.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName)</VerInfo_Keys>
<VerInfo_MinorVer>1</VerInfo_MinorVer>
<Debugger_HostApplication>C:\Work\software\OpenBLT\Host\MicroBoot.exe</Debugger_HostApplication>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<Manifest_File>(None)</Manifest_File>
<VerInfo_Locale>1033</VerInfo_Locale>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="..\..\XcpProtection.pas"/>
<DCCReference Include="..\..\XcpLoader.pas"/>
<DCCReference Include="XcpTransport.pas"/>
<DCCReference Include="XcpSettings.pas">
<Form>XcpSettingsForm</Form>
</DCCReference>
<DCCReference Include="..\..\FirmwareData.pas"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">openblt_can_kvaser.dpr</Source>
</Source>
</Delphi.Personality>
<Platforms>
<Platform value="Win32">True</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
</Project>

BIN
Host/Source/MicroBoot/interfaces/can/lawicel/CANIcon.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 538 B

496
Host/Source/MicroBoot/interfaces/can/lawicel/CanUsb.pas
View File

@ -1,496 +0,0 @@
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 *************************************

BIN
Host/Source/MicroBoot/interfaces/can/lawicel/XcpSettings.dfm
View File

Binary file not shown.

478
Host/Source/MicroBoot/interfaces/can/lawicel/XcpSettings.pas
View File

@ -1,478 +0,0 @@
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;
tabSession: TTabSheet;
iconXcp3: TImage;
lblXcpSession: TLabel;
lblConnectMode: TLabel;
cmbConnectMode: 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', ExtractFilePath(ParamStr(0))+'');
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));
FSettingsForm.cmbConnectMode.ItemIndex := settingsIni.ReadInteger('xcp', 'connectmode', 0);
// 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 := ExtractFilePath(ParamStr(0))+'';
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);
FSettingsForm.cmbConnectMode.ItemIndex := 0;
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));
settingsIni.WriteInteger('xcp', 'connectmode', FSettingsForm.cmbConnectMode.ItemIndex);
// 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 *******************************

330
Host/Source/MicroBoot/interfaces/can/lawicel/XcpTransport.pas
View File

@ -1,330 +0,0 @@
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 ******************************

694
Host/Source/MicroBoot/interfaces/can/lawicel/openblt_can_lawicel.dpr
View File

@ -1,694 +0,0 @@
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',
XcpLoader in '..\..\XcpLoader.pas',
XcpTransport in 'XcpTransport.pas',
XcpSettings in 'XcpSettings.pas' {XcpSettingsForm},
FirmwareData in '..\..\FirmwareData.pas';
//***************************************************************************************
// 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 : TFirmwareData;
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;
segmentCnt : longword;
byteCnt : longword;
currentWriteCnt : word;
sessionStartResult : byte;
bufferOffset : longword;
addr : longword;
len : longword;
dataSizeKB : real;
dataSizeBytes : integer;
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
// disconnect the transport layer
MbiCallbackOnLog('Disconnecting the transport layer. t='+ShortString(TimeToStr(Time)));
loader.Disconnect;
MbiCallbackOnLog('Programming session cancelled by user. t='+ShortString(TimeToStr(Time)));
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)));
// read the firmware file
MbiCallbackOnInfo('Reading firmware file.');
MbiCallbackOnLog('Reading firmware file. t='+ShortString(TimeToStr(Time)));
// create the datafile object and load the file contents
datafile := TFirmwareData.Create;
if not datafile.LoadFromFile(progfile, False) then
begin
MbiCallbackOnLog('Could not read firmware file (' + ShortString(ExtractFilename(progfile)) +'). t='+ShortString(TimeToStr(Time)));
MbiCallbackOnError('Could not read firmware file (' + ShortString(ExtractFilename(progfile)) +').');
datafile.Free;
Exit;
end;
// compute the size in kbytes
dataSizeBytes := 0;
// loop through all segment to get the total byte count
for segmentCnt := 0 to (datafile.SegmentCount - 1) do
begin
dataSizeBytes := dataSizeBytes + datafile.Segment[segmentCnt].Size;
end;
// convert bytes to kilobytes
dataSizeKB := dataSizeBytes / 1024;
// Call application callback when we start the actual download
MbiCallbackOnStarted(dataSizeBytes);
// Init progress to 0 progress
progress := 0;
MbiCallbackOnProgress(progress);
//---------------- next clear the memory regions --------------------------------------
// update the user info
MbiCallbackOnInfo('Erasing memory...');
for segmentCnt := 0 to (datafile.SegmentCount - 1) do
begin
// check if the user cancelled
if stopRequest then
begin
// disconnect the transport layer
MbiCallbackOnLog('Disconnecting the transport layer. t='+ShortString(TimeToStr(Time)));
loader.Disconnect;
MbiCallbackOnLog('Programming session cancelled by user. t='+ShortString(TimeToStr(Time)));
MbiCallbackOnError('Programming session cancelled by user.');
datafile.Free;
Exit;
end;
// obtain the region info
addr := datafile.Segment[segmentCnt].BaseAddress;
len := datafile.Segment[segmentCnt].Size;
// 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 segmentCnt := 0 to (datafile.SegmentCount - 1) do
begin
// update the user info
MbiCallbackOnInfo('Reading file...');
// obtain the region info
addr := datafile.Segment[segmentCnt].BaseAddress;
len := datafile.Segment[segmentCnt].Size;
SetLength(progdata, len);
for byteCnt := 0 to (len - 1) do
begin
progdata[byteCnt] := datafile.Segment[segmentCnt].Data[byteCnt];
end;
bufferOffset := 0;
while len > 0 do
begin
// check if the user cancelled
if stopRequest then
begin
// disconnect the transport layer
MbiCallbackOnLog('Disconnecting the transport layer. t='+ShortString(TimeToStr(Time)));
loader.Disconnect;
MbiCallbackOnLog('Programming session cancelled by user. t='+ShortString(TimeToStr(Time)));
MbiCallbackOnError('Programming session cancelled by user.');
datafile.Free;
Exit;
end;
// 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 := dataSizeBytes;
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;
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 := 10100; // v1.01.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 *********************

120
Host/Source/MicroBoot/interfaces/can/lawicel/openblt_can_lawicel.dproj
View File

@ -1,120 +0,0 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{C587575B-3E1C-4EA4-BB4F-912B83127DCE}</ProjectGuid>
<MainSource>openblt_can_lawicel.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Library</AppType>
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>18.2</ProjectVersion>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
<Cfg_2_Win32>true</Cfg_2_Win32>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_N>true</DCC_N>
<DCC_ExeOutput>../../../../../</DCC_ExeOutput>
<SanitizedProjectName>openblt_can_lawicel</SanitizedProjectName>
<DCC_SymbolReferenceInfo>1</DCC_SymbolReferenceInfo>
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace)</DCC_Namespace>
<DCC_ImageBase>00400000</DCC_ImageBase>
<DCC_Alignment>1</DCC_Alignment>
<DCC_E>false</DCC_E>
<DCC_K>false</DCC_K>
<DCC_F>false</DCC_F>
<GenDll>true</GenDll>
<DCC_UsePackage>Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40;$(DCC_UsePackage)</DCC_UsePackage>
<DCC_WriteableConstants>true</DCC_WriteableConstants>
<VerInfo_Locale>1031</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<DCC_DebugInformation>1</DCC_DebugInformation>
<DCC_S>false</DCC_S>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_Namespace>System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Locale>1033</VerInfo_Locale>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_DebugInformation>0</DCC_DebugInformation>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_Optimize>false</DCC_Optimize>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<VerInfo_Keys>CompanyName=;FileVersion=1.1.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.1.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName)</VerInfo_Keys>
<VerInfo_MinorVer>1</VerInfo_MinorVer>
<Debugger_HostApplication>C:\Work\software\OpenBLT\Host\MicroBoot.exe</Debugger_HostApplication>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<Manifest_File>(None)</Manifest_File>
<VerInfo_Locale>1033</VerInfo_Locale>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="..\..\XcpProtection.pas"/>
<DCCReference Include="..\..\XcpLoader.pas"/>
<DCCReference Include="XcpTransport.pas"/>
<DCCReference Include="XcpSettings.pas">
<Form>XcpSettingsForm</Form>
</DCCReference>
<DCCReference Include="..\..\FirmwareData.pas"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">openblt_can_lawicel.dpr</Source>
</Source>
</Delphi.Personality>
<Platforms>
<Platform value="Win32">True</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
</Project>

BIN
Host/Source/MicroBoot/interfaces/can/peak/CANIcon.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 538 B

557
Host/Source/MicroBoot/interfaces/can/peak/PCANBasic.pas
View File

@ -1,557 +0,0 @@
// PCANBasic.pas
//
// ~~~~~~~~~~~~
//
// PCAN-Basic API
//
// ~~~~~~~~~~~~
//
// ------------------------------------------------------------------
// Author : Keneth Wagner
// Last change: 18.05.2016 Wagner
//
// Language: Pascal
// ------------------------------------------------------------------
//
// Copyright (C) 1999-2016 PEAK-System Technik GmbH, Darmstadt
// more Info at http://www.peak-system.com
//
unit PCANBasic;
interface
const
////////////////////////////////////////////////////////////
// Value definitions
////////////////////////////////////////////////////////////
// Currently defined and supported PCAN channels
//
PCAN_NONEBUS = $00; // Undefined/default value for a PCAN bus
PCAN_ISABUS1 = $21; // PCAN-ISA interface, channel 1
PCAN_ISABUS2 = $22; // PCAN-ISA interface, channel 2
PCAN_ISABUS3 = $23; // PCAN-ISA interface, channel 3
PCAN_ISABUS4 = $24; // PCAN-ISA interface, channel 4
PCAN_ISABUS5 = $25; // PCAN-ISA interface, channel 5
PCAN_ISABUS6 = $26; // PCAN-ISA interface, channel 6
PCAN_ISABUS7 = $27; // PCAN-ISA interface, channel 7
PCAN_ISABUS8 = $28; // PCAN-ISA interface, channel 8
PCAN_DNGBUS1 = $31; // PPCAN-Dongle/LPT interface, channel 1
PCAN_PCIBUS1 = $41; // PCAN-PCI interface, channel 1
PCAN_PCIBUS2 = $42; // PCAN-PCI interface, channel 2
PCAN_PCIBUS3 = $43; // PCAN-PCI interface, channel 3
PCAN_PCIBUS4 = $44; // PCAN-PCI interface, channel 4
PCAN_PCIBUS5 = $45; // PCAN-PCI interface, channel 5
PCAN_PCIBUS6 = $46; // PCAN-PCI interface, channel 6
PCAN_PCIBUS7 = $47; // PCAN-PCI interface, channel 7
PCAN_PCIBUS8 = $48; // PCAN-PCI interface, channel 8
PCAN_PCIBUS9 = $409; // PCAN-PCI interface, channel 9
PCAN_PCIBUS10 = $40A; // PCAN-PCI interface, channel 10
PCAN_PCIBUS11 = $40B; // PCAN-PCI interface, channel 11
PCAN_PCIBUS12 = $40C; // PCAN-PCI interface, channel 12
PCAN_PCIBUS13 = $40D; // PCAN-PCI interface, channel 13
PCAN_PCIBUS14 = $40E; // PCAN-PCI interface, channel 14
PCAN_PCIBUS15 = $40F; // PCAN-PCI interface, channel 15
PCAN_PCIBUS16 = $410; // PCAN-PCI interface, channel 16
PCAN_USBBUS1 = $51; // PCAN-USB interface, channel 1
PCAN_USBBUS2 = $52; // PCAN-USB interface, channel 2
PCAN_USBBUS3 = $53; // PCAN-USB interface, channel 3
PCAN_USBBUS4 = $54; // PCAN-USB interface, channel 4
PCAN_USBBUS5 = $55; // PCAN-USB interface, channel 5
PCAN_USBBUS6 = $56; // PCAN-USB interface, channel 6
PCAN_USBBUS7 = $57; // PCAN-USB interface, channel 7
PCAN_USBBUS8 = $58; // PCAN-USB interface, channel 8
PCAN_USBBUS9 = $509; // PCAN-USB interface, channel 9
PCAN_USBBUS10 = $50A; // PCAN-USB interface, channel 10
PCAN_USBBUS11 = $50B; // PCAN-USB interface, channel 11
PCAN_USBBUS12 = $50C; // PCAN-USB interface, channel 12
PCAN_USBBUS13 = $50D; // PCAN-USB interface, channel 13
PCAN_USBBUS14 = $50E; // PCAN-USB interface, channel 14
PCAN_USBBUS15 = $50F; // PCAN-USB interface, channel 15
PCAN_USBBUS16 = $510; // PCAN-USB interface, channel 16
PCAN_PCCBUS1 = $61; // PCAN-PC Card interface, channel 1
PCAN_PCCBUS2 = $62; // PCAN-PC Card interface, channel 2
PCAN_LANBUS1 = $801; // PCAN-LAN interface, channel 1
PCAN_LANBUS2 = $802; // PCAN-LAN interface, channel 2
PCAN_LANBUS3 = $803; // PCAN-LAN interface, channel 3
PCAN_LANBUS4 = $804; // PCAN-LAN interface, channel 4
PCAN_LANBUS5 = $805; // PCAN-LAN interface, channel 5
PCAN_LANBUS6 = $806; // PCAN-LAN interface, channel 6
PCAN_LANBUS7 = $807; // PCAN-LAN interface, channel 7
PCAN_LANBUS8 = $808; // PCAN-LAN interface, channel 8
PCAN_LANBUS9 = $809; // PCAN-LAN interface, channel 9
PCAN_LANBUS10 = $80A; // PCAN-LAN interface, channel 10
PCAN_LANBUS11 = $80B; // PCAN-LAN interface, channel 11
PCAN_LANBUS12 = $80C; // PCAN-LAN interface, channel 12
PCAN_LANBUS13 = $80D; // PCAN-LAN interface, channel 13
PCAN_LANBUS14 = $80E; // PCAN-LAN interface, channel 14
PCAN_LANBUS15 = $80F; // PCAN-LAN interface, channel 15
PCAN_LANBUS16 = $810; // PCAN-LAN interface, channel 16
// Represent the PCAN error and status codes
//
PCAN_ERROR_OK = $00000; // No error
PCAN_ERROR_XMTFULL = $00001; // Transmit buffer in CAN controller is full
PCAN_ERROR_OVERRUN = $00002; // CAN controller was read too late
PCAN_ERROR_BUSLIGHT = $00004; // Bus error: an error counter reached the 'light' limit [Not used with the *FD functions]
PCAN_ERROR_BUSHEAVY = $00008; // Bus error: an error counter reached the 'heavy' limit
PCAN_ERROR_BUSWARNING = PCAN_ERROR_BUSHEAVY; // An error counter reached the 'warning' limit [ONLY used with the *FD functions]
PCAN_ERROR_BUSPASSIVE = $40000; // Bus error: the CAN controller is in bus-off state
PCAN_ERROR_BUSOFF = $00010; // Bus error: the CAN controller is in bus-off state
PCAN_ERROR_ANYBUSERR = PCAN_ERROR_BUSWARNING Or PCAN_ERROR_BUSLIGHT Or PCAN_ERROR_BUSHEAVY Or PCAN_ERROR_BUSOFF Or PCAN_ERROR_BUSPASSIVE; // Mask for all bus errors
PCAN_ERROR_QRCVEMPTY = $00020; // Receive queue is empty
PCAN_ERROR_QOVERRUN = $00040; // Receive queue was read too late
PCAN_ERROR_QXMTFULL = $00080; // Transmit queue is full
PCAN_ERROR_REGTEST = $00100; // Test of the CAN controller hardware registers failed (no hardware found)
PCAN_ERROR_NODRIVER = $00200; // Driver not loaded
PCAN_ERROR_HWINUSE = $00400; // Hardware already in use by a Net
PCAN_ERROR_NETINUSE = $00800; // A Client is already connected to the Net
PCAN_ERROR_ILLHW = $01400; // Hardware handle is invalid
PCAN_ERROR_ILLNET = $01800; // Net handle is invalid
PCAN_ERROR_ILLCLIENT = $01C00; // Client handle is invalid
PCAN_ERROR_ILLHANDLE = PCAN_ERROR_ILLHW Or PCAN_ERROR_ILLNET Or PCAN_ERROR_ILLCLIENT; // Mask for all handle errors
PCAN_ERROR_RESOURCE = $02000; // Resource (FIFO, Client, timeout) cannot be created
PCAN_ERROR_ILLPARAMTYPE = $04000; // Invalid parameter
PCAN_ERROR_ILLPARAMVAL = $08000; // Invalid parameter value
PCAN_ERROR_UNKNOWN = $10000; // Unknown error
PCAN_ERROR_ILLDATA = $20000; // Invalid data, function, or action
PCAN_ERROR_CAUTION = $2000000; // An operation was successfully carried out, however, irregularities were registered
PCAN_ERROR_INITIALIZE = $4000000; // Channel is not initialized [Value was changed from 0x40000 to 0x4000000]
PCAN_ERROR_ILLOPERATION = $8000000; // Invalid operation [Value was changed from 0x80000 to 0x8000000]
// PCAN devices
//
PCAN_NONE = $00; // Undefined, unknown or not selected PCAN device value
PCAN_PEAKCAN = $01; // PCAN Non-Plug&Play devices. NOT USED WITHIN PCAN-Basic API
PCAN_ISA = $02; // PCAN-ISA, PCAN-PC/104, and PCAN-PC/104-Plus
PCAN_DNG = $03; // PCAN-Dongle
PCAN_PCI = $04; // PCAN-PCI, PCAN-cPCI, PCAN-miniPCI, and PCAN-PCI Express
PCAN_USB = $05; // PCAN-USB and PCAN-USB Pro
PCAN_PCC = $06; // PCAN-PC Card
PCAN_VIRTUAL = $07; // PCAN Virtual hardware. NOT USED WITHIN PCAN-Basic API
PCAN_LAN = $08; // PCAN Gateway devices
// PCAN parameters
//
PCAN_DEVICE_NUMBER = $01; // PCAN-USB device number parameter
PCAN_5VOLTS_POWER = $02; // PCAN-PC Card 5-Volt power parameter
PCAN_RECEIVE_EVENT = $03; // PCAN receive event handler parameter
PCAN_MESSAGE_FILTER = $04; // PCAN message filter parameter
PCAN_API_VERSION = $05; // PCAN-Basic API version parameter
PCAN_CHANNEL_VERSION = $06; // PCAN device channel version parameter
PCAN_BUSOFF_AUTORESET = $07; // PCAN Reset-On-Busoff parameter
PCAN_LISTEN_ONLY = $08; // PCAN Listen-Only parameter
PCAN_LOG_LOCATION = $09; // Directory path for log files
PCAN_LOG_STATUS = $0A; // Debug-Log activation status
PCAN_LOG_CONFIGURE = $0B; // Configuration of the debugged information (LOG_FUNCTION_***)
PCAN_LOG_TEXT = $0C; // Custom insertion of text into the log file
PCAN_CHANNEL_CONDITION = $0D; // Availability status of a PCAN-Channel
PCAN_HARDWARE_NAME = $0E; // PCAN hardware name parameter
PCAN_RECEIVE_STATUS = $0F; // Message reception status of a PCAN-Channel
PCAN_CONTROLLER_NUMBER = $10; // CAN-Controller number of a PCAN-Channel
PCAN_TRACE_LOCATION = $11; // Directory path for PCAN trace files
PCAN_TRACE_STATUS = $12; // CAN tracing activation status
PCAN_TRACE_SIZE = $13; // Configuration of the maximum file size of a CAN trace
PCAN_TRACE_CONFIGURE = $14; // Configuration of the trace file storing mode (TRACE_FILE_***)
PCAN_CHANNEL_IDENTIFYING = $15; // Physical identification of a USB based PCAN-Channel by blinking its associated LED
PCAN_CHANNEL_FEATURES = $16; // Capabilities of a PCAN device (FEATURE_***)
PCAN_BITRATE_ADAPTING = $17; // Using of an existing bit rate (PCAN-View connected to a channel)
PCAN_BITRATE_INFO = $18; // Configured bit rate as Btr0Btr1 value
PCAN_BITRATE_INFO_FD = $19; // Configured bit rate as TPCANBitrateFD string
PCAN_BUSSPEED_NOMINAL = $1A; // Configured nominal CAN Bus speed as Bits per seconds
PCAN_BUSSPEED_DATA = $1B; // Configured CAN data speed as Bits per seconds
PCAN_IP_ADDRESS = $1C; // Remote address of a LAN channel as string in IPv4 format
PCAN_LAN_SERVICE_STATUS = $1D; // Status of the Virtual PCAN-Gateway Service
// PCAN parameter values
//
PCAN_PARAMETER_OFF = $00; // The PCAN parameter is not set (inactive)
PCAN_PARAMETER_ON = $01; // The PCAN parameter is set (active)
PCAN_FILTER_CLOSE = $00; // The PCAN filter is closed. No messages will be received
PCAN_FILTER_OPEN = $01; // The PCAN filter is fully opened. All messages will be received
PCAN_FILTER_CUSTOM = $02; // The PCAN filter is custom configured. Only registered
PCAN_CHANNEL_UNAVAILABLE = $00; // The PCAN-Channel handle is illegal, or its associated hardware is not available
PCAN_CHANNEL_AVAILABLE = $01; // The PCAN-Channel handle is available to be connected (Plug&Play Hardware: it means furthermore that the hardware is plugged-in)
PCAN_CHANNEL_OCCUPIED = $02; // The PCAN-Channel handle is valid, and is already being used
PCAN_CHANNEL_PCANVIEW = PCAN_CHANNEL_AVAILABLE Or PCAN_CHANNEL_OCCUPIED; // The PCAN-Channel handle is already being used by a PCAN-View application, but is available to connect
LOG_FUNCTION_DEFAULT = $00; // Logs system exceptions / errors
LOG_FUNCTION_ENTRY = $01; // Logs the entries to the PCAN-Basic API functions
LOG_FUNCTION_PARAMETERS = $02; // Logs the parameters passed to the PCAN-Basic API functions
LOG_FUNCTION_LEAVE = $04; // Logs the exits from the PCAN-Basic API functions
LOG_FUNCTION_WRITE = $08; // Logs the CAN messages passed to the CAN_Write function
LOG_FUNCTION_READ = $10; // Logs the CAN messages received within the CAN_Read function
LOG_FUNCTION_ALL = $FFFF;// Logs all possible information within the PCAN-Basic API functions
TRACE_FILE_SINGLE = $00; // A single file is written until it size reaches PAN_TRACE_SIZE
TRACE_FILE_SEGMENTED = $01; // Traced data is distributed in several files with size PAN_TRACE_SIZE
TRACE_FILE_DATE = $02; // Includes the date into the name of the trace file
TRACE_FILE_TIME = $04; // Includes the start time into the name of the trace file
TRACE_FILE_OVERWRITE = $80; // Causes the overwriting of available traces (same name)
FEATURE_FD_CAPABLE = $01; // Device supports flexible data-rate (CAN-FD)
SERVICE_STATUS_STOPPED = $01; // The service is not running
SERVICE_STATUS_RUNNING = $04; // The service is running
// PCAN message types
//
PCAN_MESSAGE_STANDARD = $00; // The PCAN message is a CAN Standard Frame (11-bit identifier)
PCAN_MESSAGE_RTR = $01; // The PCAN message is a CAN Remote-Transfer-Request Frame
PCAN_MESSAGE_EXTENDED = $02; // The PCAN message is a CAN Extended Frame (29-bit identifier)
PCAN_MESSAGE_FD = $04; // The PCAN message represents a FD frame in terms of CiA Specs
PCAN_MESSAGE_BRS = $08; // The PCAN message represents a FD bit rate switch (CAN data at a higher bit rate)
PCAN_MESSAGE_ESI = $10; // The PCAN message represents a FD error state indicator(CAN FD transmitter was error active)
PCAN_MESSAGE_STATUS = $80; // The PCAN message represents a PCAN status message
// Frame Type / Initialization Mode
//
PCAN_MODE_STANDARD = PCAN_MESSAGE_STANDARD; // Mode is Standard (11-bit identifier)
PCAN_MODE_EXTENDED = PCAN_MESSAGE_EXTENDED; // Mode is Extended (29-bit identifier)
// Baud rate codes = BTR0/BTR1 register values for the CAN controller.
// You can define your own Baud rate with the BTROBTR1 register.
// Take a look at www.peak-system.com for our free software "BAUDTOOL"
// to calculate the BTROBTR1 register for every bit rate and sample point.
//
PCAN_BAUD_1M = $0014; // 1 MBit/s
PCAN_BAUD_800K = $0016; // 800 kBit/s
PCAN_BAUD_500K = $001C; // 500 kBit/s
PCAN_BAUD_250K = $011C; // 250 kBit/s
PCAN_BAUD_125K = $031C; // 125 kBit/s
PCAN_BAUD_100K = $432F; // 100 kBit/s
PCAN_BAUD_95K = $C34E; // 95,238 kBit/s
PCAN_BAUD_83K = $852B; // 83,333 kBit/s
PCAN_BAUD_50K = $472F; // 50 kBit/s
PCAN_BAUD_47K = $1414; // 47,619 kBit/s
PCAN_BAUD_33K = $8B2F; // 33,333 kBit/s
PCAN_BAUD_20K = $532F; // 20 kBit/s
PCAN_BAUD_10K = $672F; // 10 kBit/s
PCAN_BAUD_5K = $7F7F; // 5 kBit/s
// Represents the configuration for a CAN bit rate
// Note:
// * Each parameter and its value must be separated with a '='.
// * Each pair of parameter/value must be separated using ','.
//
// Example:
// f_clock=80000000,nom_brp=0,nom_tseg1=13,nom_tseg2=0,nom_sjw=0,data_brp=0,data_tseg1=13,data_tseg2=0,data_sjw=0
//
PCAN_BR_CLOCK = 'f_clock';
PCAN_BR_CLOCK_MHZ = 'f_clock_mhz';
PCAN_BR_NOM_BRP = 'nom_brp';
PCAN_BR_NOM_TSEG1 = 'nom_tseg1';
PCAN_BR_NOM_TSEG2 = 'nom_tseg2';
PCAN_BR_NOM_SJW = 'nom_sjw';
PCAN_BR_NOM_SAMPLE = 'nom_sam';
PCAN_BR_DATA_BRP = 'data_brp';
PCAN_BR_DATA_TSEG1 = 'data_tseg1';
PCAN_BR_DATA_TSEG2 = 'data_tseg2';
PCAN_BR_DATA_SJW = 'data_sjw';
PCAN_BR_DATA_SAMPLE = 'data_ssp_offset';
// Type of PCAN (non plug&play) hardware
//
PCAN_TYPE_ISA = $01; // PCAN-ISA 82C200
PCAN_TYPE_ISA_SJA = $09; // PCAN-ISA SJA1000
PCAN_TYPE_ISA_PHYTEC = $04; // PHYTEC ISA
PCAN_TYPE_DNG = $02; // PCAN-Dongle 82C200
PCAN_TYPE_DNG_EPP = $03; // PCAN-Dongle EPP 82C200
PCAN_TYPE_DNG_SJA = $05; // PCAN-Dongle SJA1000
PCAN_TYPE_DNG_SJA_EPP = $06; // PCAN-Dongle EPP SJA1000
type
////////////////////////////////////////////////////////////
// Type definitions
////////////////////////////////////////////////////////////
TPCANHandle = Word; // Represents a PCAN hardware channel handle
TPCANStatus = Longword; // Represents a PCAN status/error code
TPCANParameter = Byte; // Represents a PCAN parameter to be read or set
TPCANDevice = Byte; // Represents a PCAN device
TPCANMessageType = Byte; // Represents the type of a PCAN message
TPCANType = Byte; // Represents the type of PCAN hardware to be initialized
TPCANMode = Byte; // Represents a PCAN filter mode
TPCANBaudrate = Word; // Represents a PCAN Baud rate register value
TPCANBitrateFD = PAnsiChar;// Represents a PCAN-FD bit rate string
TPCANTimestampFD = UInt64; // Represents a timestamp of a received PCAN FD message
////////////////////////////////////////////////////////////
// Structure definitions
////////////////////////////////////////////////////////////
// Represents a PCAN message
//
TPCANMsg = record
ID: Longword; // 11/29-bit message identifier
MSGTYPE: TPCANMessageType; // Type of the message
LEN: Byte; // Data Length Code of the message (0..8)
DATA: array[0..7] of Byte; // Data of the message (DATA[0]..DATA[7])
end;
// Represents a timestamp of a received PCAN message.
// Total Microseconds = micros + 1000 * millis + 0x100000000 * 1000 * millis_overflow
//
TPCANTimestamp = record
millis: Longword; // Base-value: milliseconds: 0.. 2^32-1
millis_overflow: Word; // Roll-arounds of millis
micros: Word; // Microseconds: 0..999
end;
PTPCANTimestamp = ^TPCANTimestamp;
// Represents a PCAN message from a FD capable hardware
//
TPCANMsgFD = record
ID: Longword; // 11/29-bit message identifier
MSGTYPE: TPCANMessageType; // Type of the message
DLC: Byte; // Data Length Code of the message (0..15)
DATA: array[0..63] of Byte; // Data of the message (DATA[0]..DATA[63])
end;
PTPCANTimestampFD = ^TPCANTimestampFD;
////////////////////////////////////////////////////////////
// PCAN-Basic API function declarations
////////////////////////////////////////////////////////////
/// <summary>
/// Initializes a PCAN Channel
/// </summary>
/// <param name="Channel">The handle of a PCAN Channel</param>
/// <param name="Btr0Btr1">The speed for the communication (BTR0BTR1 code)</param>
/// <param name="HwType">NON PLUG&PLAY: The type of hardware and operation mode</param>
/// <param name="IOPort">NON PLUG&PLAY: The I/O address for the parallel port</param>
/// <param name="Interrupt">NON PLUG&PLAY: Interrupt number of the parallel port</param>
/// <returns>A TPCANStatus error code</returns>
function CAN_Initialize(
Channel: TPCANHandle;
Btr0Btr1: TPCANBaudrate;
HwType: TPCANType;
IOPort: LongWord;
Interrupt: Word
): TPCANStatus; stdcall;
/// <summary>
/// Initializes a FD capable PCAN Channel
/// </summary>
/// <param name="Channel">"The handle of a FD capable PCAN Channel"</param>
/// <param name="BitrateFD">"The speed for the communication (FD bit rate string)"</param>
/// <remarks>See PCAN_BR_* values
/// * parameter and values ust be separated by '='
/// * Couples of Parameter/value must be separated by ','
/// * Following Parameter must be filled out: f_clock, data_brp, data_sjw, data_tseg1, data_tseg2,
/// nom_brp, nom_sjw, nom_tseg1, nom_tseg2.
/// * Following Parameters are optional (not used yet): data_ssp_offset, nom_samp
///</remarks>
/// <example>f_clock_mhz=80,nom_brp=0,nom_tseg1=13,nom_tseg2=0,nom_sjw=0,data_brp=0,
/// data_tseg1=13,data_tseg2=0,data_sjw=0</example>
/// <returns>"A TPCANStatus error code"</returns>
function CAN_InitializeFD(
Channel: TPCANHandle;
BitrateFD: TPCANBitrateFD
): TPCANStatus; stdcall;
/// <summary>
/// Uninitializes one or all PCAN Channels initialized by CAN_Initialize
/// </summary>
/// <remarks>Giving the TPCANHandle value "PCAN_NONEBUS",
/// uninitialize all initialized channels</remarks>
/// <param name="Channel">The handle of a PCAN Channel</param>
/// <returns>A TPCANStatus error code</returns>
function CAN_Uninitialize(
Channel: TPCANHandle
): TPCANStatus; stdcall;
/// <summary>
/// Resets the receive and transmit queues of the PCAN Channel
/// </summary>
/// <remarks>A reset of the CAN controller is not performed</remarks>
/// <param name="Channel">The handle of a PCAN Channel</param>
/// <returns>A TPCANStatus error code</returns>
function CAN_Reset(
Channel: TPCANHandle
): TPCANStatus; stdcall;
/// <summary>
/// Gets the current status of a PCAN Channel
/// </summary>
/// <param name="Channel">The handle of a PCAN Channel</param>
/// <returns>A TPCANStatus error code</returns>
function CAN_GetStatus(
Channel: TPCANHandle
): TPCANStatus; stdcall;
/// <summary>
/// Reads a CAN message from the receive queue of a PCAN Channel
/// </summary>
/// <param name="Channel">The handle of a PCAN Channel</param>
/// <param name="MessageBuffer">A TPCANMsg structure buffer to store the CAN message</param>
/// <param name="TimestampBuffer">A TPCANTimestamp structure buffer to get
/// the reception time of the message</param>
/// <returns>A TPCANStatus error code</returns>
function CAN_Read(
Channel: TPCANHandle;
var MessageBuffer: TPCANMsg;
TimestampBuffer: PTPCANTimestamp
):TPCANStatus; stdcall;
/// <summary>
/// Reads a CAN message from the receive queue of a FD capable PCAN Channel
/// </summary>
/// <param name="Channel">"The handle of a FD capable PCAN Channel"</param>
/// <param name="MessageBuffer">"A TPCANMsgFD structure buffer to store the CAN message"</param>
/// <param name="TimestampBuffer">"A TPCANTimestampFD buffer to get
/// the reception time of the message. If this value is not desired, this parameter
/// should be passed as NULL"</param>
/// <returns>"A TPCANStatus error code"</returns>
function CAN_ReadFD(
Channel: TPCANHandle;
var MessageBuffer: TPCANMsgFD;
TimestampBuffer: PTPCANTimestampFD
): TPCANStatus; stdcall;
/// <summary>
/// Transmits a CAN message
/// </summary>
/// <param name="Channel">The handle of a PCAN Channel</param>
/// <param name="MessageBuffer">A TPCANMsg buffer with the message to be sent</param>
/// <returns>A TPCANStatus error code</returns>
function CAN_Write(
Channel: TPCANHandle;
var MessageBuffer: TPCANMsg
): TPCANStatus; stdcall;
/// <summary>
/// Transmits a CAN message over a FD capable PCAN Channel
/// </summary>
/// <param name="Channel">"The handle of a FD capable PCAN Channel"</param>
/// <param name="MessageBuffer">"A TPCANMsgFD buffer with the message to be sent"</param>
/// <returns>"A TPCANStatus error code"</returns>
function CAN_WriteFD(
Channel: TPCANHandle;
var MessageBuffer: TPCANMsgFD
): TPCANStatus; stdcall;
/// <summary>
/// Configures the reception filter
/// </summary>
/// <remarks>The message filter will be expanded with every call to
/// this function. If it is desired to reset the filter, please use
/// the 'SetValue' function</remarks>
/// <param name="Channel">The handle of a PCAN Channel</param>
/// <param name="FromID">The lowest CAN ID to be received</param>
/// <param name="ToID">The highest CAN ID to be received</param>
/// <param name="Mode">Message type, Standard (11-bit identifier) or
/// Extended (29-bit identifier)</param>
/// <returns>A TPCANStatus error code</returns>
function CAN_FilterMessages(
Channel: TPCANHandle;
FromID: LongWord;
ToID: LongWord;
Mode: TPCANMode
): TPCANStatus; stdcall;
/// <summary>
/// Retrieves a PCAN Channel value
/// </summary>
/// <remarks>Parameters can be present or not according with the kind
/// of Hardware (PCAN Channel) being used. If a parameter is not available,
/// a PCAN_ERROR_ILLPARAMTYPE error will be returned</remarks>
/// <param name="Channel">The handle of a PCAN Channel</param>
/// <param name="Parameter">The TPCANParameter parameter to get</param>
/// <param name="Buffer">Buffer for the parameter value</param>
/// <param name="BufferLength">Size in bytes of the buffer</param>
/// <returns>A TPCANStatus error code</returns>
function CAN_GetValue(
Channel: TPCANHandle;
Parameter: TPCANParameter;
Buffer: Pointer;
BufferLength: LongWord
): TPCANStatus; stdcall;
/// <summary>
/// Configures or sets a PCAN Channel value
/// </summary>
/// <remarks>Parameters can be present or not according with the kind
/// of Hardware (PCAN Channel) being used. If a parameter is not available,
/// a PCAN_ERROR_ILLPARAMTYPE error will be returned</remarks>
/// <param name="Channel">The handle of a PCAN Channel</param>
/// <param name="Parameter">The TPCANParameter parameter to set</param>
/// <param name="Buffer">Buffer with the value to be set</param>
/// <param name="BufferLength">Size in bytes of the buffer</param>
/// <returns>A TPCANStatus error code</returns>
function CAN_SetValue(
Channel: TPCANHandle;
Parameter: TPCANParameter;
Buffer: Pointer;
BufferLength: LongWord
): TPCANStatus; stdcall;
/// <summary>
/// Returns a descriptive text of a given TPCANStatus error
/// code, in any desired language
/// </summary>
/// <remarks>The current languages available for translation are:
/// Neutral (0x00), German (0x07), English (0x09), Spanish (0x0A),
/// Italian (0x10) and French (0x0C)</remarks>
/// <param name="Error">A TPCANStatus error code</param>
/// <param name="Language">Indicates a 'Primary language ID'</param>
/// <param name="StringBuffer">Buffer for the text (must be at least 256 in length)</param>
/// <returns>A TPCANStatus error code</returns>
function CAN_GetErrorText(
Error: TPCANStatus;
Language: Word;
StringBuffer: PAnsiChar
): TPCANStatus; stdcall;
implementation
uses SysUtils;
const DLL_Name = 'PCANBASIC.DLL';
function CAN_Initialize(Channel: TPCANHandle; Btr0Btr1: TPCANBaudrate; HwType: TPCANType; IOPort: LongWord; Interrupt: Word): TPCANStatus; stdcall;
external DLL_Name;
function CAN_InitializeFD(Channel: TPCANHandle; BitrateFD: TPCANBitrateFD): TPCANStatus; stdcall;
external DLL_Name;
function CAN_Uninitialize(Channel: TPCANHandle): TPCANStatus; stdcall;
external DLL_Name;
function CAN_Reset(Channel: TPCANHandle): TPCANStatus; stdcall;
external DLL_Name;
function CAN_GetStatus(Channel: TPCANHandle): TPCANStatus; stdcall;
external DLL_Name;
function CAN_Read(Channel: TPCANHandle; var MessageBuffer: TPCANMsg; TimestampBuffer: PTPCANTimestamp):TPCANStatus; stdcall;
external DLL_Name;
function CAN_ReadFD(Channel: TPCANHandle; var MessageBuffer: TPCANMsgFD; TimestampBuffer: PTPCANTimestampFD):TPCANStatus; stdcall;
external DLL_Name;
function CAN_Write(Channel: TPCANHandle; var MessageBuffer: TPCANMsg): TPCANStatus; stdcall;
external DLL_Name;
function CAN_WriteFD(Channel: TPCANHandle; var MessageBuffer: TPCANMsgFD): TPCANStatus; stdcall;
external DLL_Name;
function CAN_FilterMessages(Channel: TPCANHandle; FromID: LongWord; ToID: LongWord; Mode: TPCANMode): TPCANStatus; stdcall;
external DLL_Name;
function CAN_GetValue(Channel: TPCANHandle; Parameter: TPCANParameter; Buffer: Pointer; BufferLength: LongWord): TPCANStatus; stdcall;
external DLL_Name;
function CAN_SetValue(Channel: TPCANHandle; Parameter: TPCANParameter; Buffer: Pointer; BufferLength: LongWord): TPCANStatus; stdcall;
external DLL_Name;
function CAN_GetErrorText(Error: TPCANStatus; Language: Word; StringBuffer: PAnsiChar): TPCANStatus; stdcall;
external DLL_Name;
end.

BIN
Host/Source/MicroBoot/interfaces/can/peak/XcpSettings.dfm
View File

Binary file not shown.

500
Host/Source/MicroBoot/interfaces/can/peak/XcpSettings.pas
View File

@ -1,500 +0,0 @@
unit XcpSettings;
//***************************************************************************************
// Description: XCP settings interface for CAN
// File Name: XcpSettings.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2011 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;
tabSession: TTabSheet;
iconXcp3: TImage;
lblXcpSession: TLabel;
lblConnectMode: TLabel;
cmbConnectMode: 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;
oldSelectedIdx: Integer;
begin
// init to safe value
maxChannels := 2;
case cmbHardware.ItemIndex of
0 , 1: { PCAN USB or PCAN PCI }
begin
maxChannels := 8;
end;
2: { PCAN PC Card }
begin
maxChannels := 2;
end;
end;
// backup currently selected channel
oldSelectedIdx := cmbChannel.ItemIndex;
// update the combobox contents
cmbChannel.Items.Clear;
for channelCnt := 1 to maxChannels do
begin
cmbChannel.Items.Add('Channel' + InttoStr(channelCnt));
end;
cmbChannel.DropDownCount := maxChannels;
// restore the selected channel
if oldSelectedIdx >= (maxChannels) then
begin
cmbChannel.ItemIndex := 0;
end
else
begin
cmbChannel.ItemIndex := oldSelectedIdx;
end;
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', ExtractFilePath(ParamStr(0))+'');
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));
FSettingsForm.cmbConnectMode.ItemIndex := settingsIni.ReadInteger('xcp', 'connectmode', 0);
// 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 := ExtractFilePath(ParamStr(0))+'';
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);
FSettingsForm.cmbConnectMode.ItemIndex := 0;
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));
settingsIni.WriteInteger('xcp', 'connectmode', FSettingsForm.cmbConnectMode.ItemIndex);
// 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 *******************************

369
Host/Source/MicroBoot/interfaces/can/peak/XcpTransport.pas
View File

@ -1,369 +0,0 @@
unit XcpTransport;
//***************************************************************************************
// Description: XCP transport layer for CAN.
// File Name: XcpTransport.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2011 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, PCANBasic;
//***************************************************************************************
// Global Constants
//***************************************************************************************
// a CAN message can only have up to 8 bytes
const kMaxPacketSize = 8;
//***************************************************************************************
// Type Definitions
//***************************************************************************************
type
TPCANhardware = ( PCAN_PCI = $40, PCAN_USB = $50, PCAN_PCC = $60 );
TXcpTransport = class(TObject)
private
packetTxId : LongWord;
packetRxId : Longword;
extendedId : Boolean;
canHardware : TPCANhardware; { PCAN_xxx }
canChannel : Word; { currently supported is 1..8 }
canBaudrate : Word; { in bits/sec }
connected : Boolean;
function ConstructPeakHandle(hardware: TPCANhardware; channel: Word): TPCANHandle;
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;
// 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
// 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
case settingsIni.ReadInteger('can', 'hardware', 0) of
0: canHardware := PCAN_USB;
1: canHardware := PCAN_PCI;
2: canHardware := PCAN_PCC;
else
canHardware := PCAN_USB;
end;
canChannel := settingsIni.ReadInteger('can', 'channel', 0) + 1;
case settingsIni.ReadInteger('can', 'baudrate', 2) of
0: canBaudrate := PCAN_BAUD_1M;
1: canBaudrate := PCAN_BAUD_800K;
2: canBaudrate := PCAN_BAUD_500K;
3: canBaudrate := PCAN_BAUD_250K;
4: canBaudrate := PCAN_BAUD_125K;
5: canBaudrate := PCAN_BAUD_100K;
6: canBaudrate := PCAN_BAUD_83K;
7: canBaudrate := PCAN_BAUD_33K;
8: canBaudrate := PCAN_BAUD_20K;
9: canBaudrate := PCAN_BAUD_10K;
10: canBaudrate := PCAN_BAUD_5K;
else
canBaudrate := PCAN_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
status: TPCANStatus;
iBuffer : Integer;
begin
// init result value
result := false;
// disconnect first if still connected
if connected then
Disconnect;
// attempt to connect to the CAN hardware interface
status := CAN_Initialize(ConstructPeakHandle(canHardware, canChannel), canBaudrate, 0, 0, 0);
// process the result
if status = PCAN_ERROR_OK then
begin
// connected. now enable the bus off automatic reset
iBuffer := PCAN_PARAMETER_ON;
status := CAN_SetValue(ConstructPeakHandle(canHardware, canChannel), PCAN_BUSOFF_AUTORESET,
PLongWord(@iBuffer), sizeof(iBuffer));
if status = PCAN_ERROR_OK then
begin
connected := true;
result := true;
end;
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: TPCANStatus;
begin
// init result to no error.
result := false;
// check for bus off error if connected
if connected then
begin
status := CAN_GetStatus(ConstructPeakHandle(canHardware, canChannel));
if (status = PCAN_ERROR_BUSOFF) or (status = PCAN_ERROR_BUSHEAVY) then
begin
result := true;
end;
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: TPCANMsg;
rxMsg: TPCANMsg;
byteIdx: Byte;
status: TPCANStatus;
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.MSGTYPE := PCAN_MESSAGE_EXTENDED
else
txMsg.MSGTYPE := PCAN_MESSAGE_STANDARD;
txMsg.LEN := packetLen;
for byteIdx := 0 to (packetLen-1) do
begin
txMsg.DATA[byteIdx] := packetData[byteIdx];
end;
// transmit the packet via CAN
status := CAN_Write(ConstructPeakHandle(canHardware, canChannel), txMsg);
if status <> PCAN_ERROR_OK 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
status := CAN_Read(ConstructPeakHandle(canHardware, canChannel), rxMsg, nil);
// check if an error occurred
if (status <> PCAN_ERROR_OK) and (status <> PCAN_ERROR_QRCVEMPTY) then
begin
// error detected. stop loop.
Break;
end
// no error occurred, so either a message was received or the queue was
// empty. check for the latter condition
else if status = PCAN_ERROR_OK 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.MSGTYPE = PCAN_MESSAGE_STANDARD) and (not extendedId)) or
((rxMsg.MSGTYPE = PCAN_MESSAGE_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
CAN_Uninitialize(ConstructPeakHandle(canHardware, canChannel));
end;
connected := false;
end; //*** end of Disconnect ***
//***************************************************************************************
// NAME: ConstructPeakHandle
// PARAMETER: hardware Peak hardware identifier.
// channel Peak channel.
// RETURN VALUE: Peak hardware channel handle.
// DESCRIPTION: Converts this class' hardware and channel values into a handle that
// can be passed to the Peak API.
//
//***************************************************************************************
function TXcpTransport.ConstructPeakHandle(hardware: TPCANhardware; channel: Word): TPCANHandle;
begin
result := Word(hardware) + channel;
end; //*** end of ConstructPeakHandle ***
end.
//******************************** end of XcpTransport.pas ******************************

695
Host/Source/MicroBoot/interfaces/can/peak/openblt_can_peak.dpr
View File

@ -1,695 +0,0 @@
library openblt_can_peak;
//***************************************************************************************
// Project Name: MicroBoot Interface for Borland Delphi
// Description: XCP - CAN interface for MicroBoot supporting PEAK CAN
// File Name: openblt_can_peak.dpr
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2011 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',
XcpLoader in '..\..\XcpLoader.pas',
XcpTransport in 'XcpTransport.pas',
XcpSettings in 'XcpSettings.pas' {XcpSettingsForm},
PCANBasic in 'PCANBasic.pas',
FirmwareData in '..\..\FirmwareData.pas';
//***************************************************************************************
// 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 : TFirmwareData;
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;
segmentCnt : longword;
byteCnt : longword;
currentWriteCnt : word;
sessionStartResult : byte;
bufferOffset : longword;
addr : longword;
len : longword;
dataSizeKB : real;
dataSizeBytes : integer;
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
// disconnect the transport layer
MbiCallbackOnLog('Disconnecting the transport layer. t='+ShortString(TimeToStr(Time)));
loader.Disconnect;
MbiCallbackOnLog('Programming session cancelled by user. t='+ShortString(TimeToStr(Time)));
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)));
// read the firmware file
MbiCallbackOnInfo('Reading firmware file.');
MbiCallbackOnLog('Reading firmware file. t='+ShortString(TimeToStr(Time)));
// create the datafile object and load the file contents
datafile := TFirmwareData.Create;
if not datafile.LoadFromFile(progfile, False) then
begin
MbiCallbackOnLog('Could not read firmware file (' + ShortString(ExtractFilename(progfile)) +'). t='+ShortString(TimeToStr(Time)));
MbiCallbackOnError('Could not read firmware file (' + ShortString(ExtractFilename(progfile)) +').');
datafile.Free;
Exit;
end;
// compute the size in kbytes
dataSizeBytes := 0;
// loop through all segment to get the total byte count
for segmentCnt := 0 to (datafile.SegmentCount - 1) do
begin
dataSizeBytes := dataSizeBytes + datafile.Segment[segmentCnt].Size;
end;
// convert bytes to kilobytes
dataSizeKB := dataSizeBytes / 1024;
// Call application callback when we start the actual download
MbiCallbackOnStarted(dataSizeBytes);
// Init progress to 0 progress
progress := 0;
MbiCallbackOnProgress(progress);
//---------------- next clear the memory regions --------------------------------------
// update the user info
MbiCallbackOnInfo('Erasing memory...');
for segmentCnt := 0 to (datafile.SegmentCount - 1) do
begin
// check if the user cancelled
if stopRequest then
begin
// disconnect the transport layer
MbiCallbackOnLog('Disconnecting the transport layer. t='+ShortString(TimeToStr(Time)));
loader.Disconnect;
MbiCallbackOnLog('Programming session cancelled by user. t='+ShortString(TimeToStr(Time)));
MbiCallbackOnError('Programming session cancelled by user.');
datafile.Free;
Exit;
end;
// obtain the region info
addr := datafile.Segment[segmentCnt].BaseAddress;
len := datafile.Segment[segmentCnt].Size;
// 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 segmentCnt := 0 to (datafile.SegmentCount - 1) do
begin
// update the user info
MbiCallbackOnInfo('Reading file...');
// obtain the region info
addr := datafile.Segment[segmentCnt].BaseAddress;
len := datafile.Segment[segmentCnt].Size;
SetLength(progdata, len);
for byteCnt := 0 to (len - 1) do
begin
progdata[byteCnt] := datafile.Segment[segmentCnt].Data[byteCnt];
end;
bufferOffset := 0;
while len > 0 do
begin
// check if the user cancelled
if stopRequest then
begin
// disconnect the transport layer
MbiCallbackOnLog('Disconnecting the transport layer. t='+ShortString(TimeToStr(Time)));
loader.Disconnect;
MbiCallbackOnLog('Programming session cancelled by user. t='+ShortString(TimeToStr(Time)));
MbiCallbackOnError('Programming session cancelled by user.');
datafile.Free;
Exit;
end;
// 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 := dataSizeBytes;
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_peak.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;
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 Peak';
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 Peak CAN Interface';
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 := 10100; // v1.01.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_peak.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_peak.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_peak.dpr ************************

121
Host/Source/MicroBoot/interfaces/can/peak/openblt_can_peak.dproj
View File

@ -1,121 +0,0 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{C587575B-3E1C-4EA4-BB4F-912B83127DCE}</ProjectGuid>
<MainSource>openblt_can_peak.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Library</AppType>
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>18.2</ProjectVersion>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
<Cfg_2_Win32>true</Cfg_2_Win32>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_N>true</DCC_N>
<DCC_ExeOutput>../../../../../</DCC_ExeOutput>
<SanitizedProjectName>openblt_can_peak</SanitizedProjectName>
<DCC_SymbolReferenceInfo>1</DCC_SymbolReferenceInfo>
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace)</DCC_Namespace>
<DCC_ImageBase>00400000</DCC_ImageBase>
<DCC_Alignment>1</DCC_Alignment>
<DCC_E>false</DCC_E>
<DCC_K>false</DCC_K>
<DCC_F>false</DCC_F>
<GenDll>true</GenDll>
<DCC_UsePackage>Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40;$(DCC_UsePackage)</DCC_UsePackage>
<DCC_WriteableConstants>true</DCC_WriteableConstants>
<VerInfo_Locale>1031</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<DCC_DebugInformation>1</DCC_DebugInformation>
<DCC_S>false</DCC_S>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_Namespace>System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Locale>1033</VerInfo_Locale>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_DebugInformation>0</DCC_DebugInformation>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_Optimize>false</DCC_Optimize>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<VerInfo_Keys>CompanyName=;FileVersion=1.1.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.1.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName)</VerInfo_Keys>
<VerInfo_MinorVer>1</VerInfo_MinorVer>
<Debugger_HostApplication>C:\Work\software\OpenBLT\Host\MicroBoot.exe</Debugger_HostApplication>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<Manifest_File>(None)</Manifest_File>
<VerInfo_Locale>1033</VerInfo_Locale>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="..\..\XcpProtection.pas"/>
<DCCReference Include="..\..\XcpLoader.pas"/>
<DCCReference Include="XcpTransport.pas"/>
<DCCReference Include="XcpSettings.pas">
<Form>XcpSettingsForm</Form>
</DCCReference>
<DCCReference Include="PCANBasic.pas"/>
<DCCReference Include="..\..\FirmwareData.pas"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">openblt_can_peak.dpr</Source>
</Source>
</Delphi.Personality>
<Platforms>
<Platform value="Win32">True</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
</Project>

1550
Host/Source/MicroBoot/interfaces/net/WSockets.pas
View File

File diff suppressed because it is too large Load Diff

BIN
Host/Source/MicroBoot/interfaces/net/XcpSettings.dfm
View File

Binary file not shown.

277
Host/Source/MicroBoot/interfaces/net/XcpSettings.pas
View File

@ -1,277 +0,0 @@
unit XcpSettings;
//***************************************************************************************
// Description: XCP settings interface for NET (TCP/IP)
// File Name: XcpSettings.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2014 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;
tabNet: TTabSheet;
iconNet: TImage;
lblNet: TLabel;
lblXcp: TLabel;
iconXcp2: TImage;
lblNetport: TLabel;
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;
openDialog: TOpenDialog;
lblNethost: TLabel;
edtHostname: TEdit;
edtPort: TEdit;
edtTconnect: TEdit;
lblTconnect: TLabel;
tabSession: TTabSheet;
iconXcp3: TImage;
lblXcpSession: TLabel;
lblConnectMode: TLabel;
cmbConnectMode: TComboBox;
procedure btnOKClick(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
procedure btnBrowseClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
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: 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;
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);
// NET related elements
FSettingsForm.edtHostname.Text := settingsIni.ReadString('net', 'hostname', '169.254.19.63');
FSettingsForm.edtPort.Text := settingsIni.ReadString('net', 'port', '1000');
// XCP related elements
FSettingsForm.edtSeedKey.Text := settingsIni.ReadString('xcp', 'seedkey', ExtractFilePath(ParamStr(0))+'');
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', 300));
FSettingsForm.cmbConnectMode.ItemIndex := settingsIni.ReadInteger('xcp', 'connectmode', 0);
// release ini file object
settingsIni.Free;
end
else
begin
// set defaults
// NET related elements
FSettingsForm.edtHostname.Text := '169.254.19.63';
FSettingsForm.edtPort.Text := '1000';
// XCP related elements
FSettingsForm.edtSeedKey.Text := ExtractFilePath(ParamStr(0))+'';
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(300);
FSettingsForm.cmbConnectMode.ItemIndex := 0;
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);
// NET related elements
settingsIni.WriteString('net', 'hostname', FSettingsForm.edtHostname.Text);
settingsIni.WriteString('net', 'port', FSettingsForm.edtPort.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));
settingsIni.WriteInteger('xcp', 'connectmode', FSettingsForm.cmbConnectMode.ItemIndex);
// 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 *******************************

403
Host/Source/MicroBoot/interfaces/net/XcpTransport.pas
View File

@ -1,403 +0,0 @@
unit XcpTransport;
//***************************************************************************************
// Description: XCP transport layer for NET.
// File Name: XcpTransport.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2014 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, WinSock, WSockets;
//***************************************************************************************
// Global Constants
//***************************************************************************************
const kMaxPacketSize = 256 + 4; // 4 extra for TCP/IP counter overhead
const kTcpConnectedTimeoutMs = 1000; // timeout for connecting the socket
//***************************************************************************************
// Type Definitions
//***************************************************************************************
type
TXcpTransportInfo = (kNone, kResponse, kError);
type
TXcpTransport = class(TObject)
private
comEventInfo : TXcpTransportInfo;
comEvent : THandle;
socket : TTCPClient;
hostname : string;
port : string;
croCounter : LongWord;
procedure OnSocketDataAvailable(Sender: TObject; WinSocket: TSocket);
function MsgWaitForSingleObject(hHandle: THandle; dwMilliseconds: DWORD): DWORD;
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;
// reset can event info
comEventInfo := kNone;
// create the event that requires manual reset
comEvent := CreateEvent(nil, True, False, nil);
if comEvent = 0 then
Application.MessageBox( 'Could not obtain event placeholder.',
'Error', MB_OK or MB_ICONERROR );
// create a socket instance
socket := TTCPClient.Create(nil);
// set the socket event handlers
socket.OnData := OnSocketDataAvailable;
// init CRO counter value
croCounter := 1;
// reset packet length
packetLen := 0;
end; //*** end of Create ***
//***************************************************************************************
// NAME: Destroy
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Class destructor
//
//***************************************************************************************
destructor TXcpTransport.Destroy;
begin
// release socket instance
socket.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);
// configure hostname
hostname := settingsIni.ReadString('net', 'hostname', '169.254.19.63');
// configure port
port := settingsIni.ReadString('net', 'port', '1000');
// release ini file object
settingsIni.Free;
end
else
begin
// configure default hostname
hostname := '169.254.19.63';
// configure default port
port := '1000';
end;
end; //*** end of Configure ***
//***************************************************************************************
// NAME: Connect
// PARAMETER: none
// RETURN VALUE: True if connected, False otherwise.
// DESCRIPTION: Connects the transport layer device.
//
//***************************************************************************************
function TXcpTransport.Connect: Boolean;
var
connectTimeout : DWord;
begin
// init CRO counter value
croCounter := 1;
// make sure the socket is closed
if socket.SocketState <> ssClosed then
begin
Disconnect;
end;
// set the hostname and port
socket.Host := hostname;
socket.Port := port;
// set timeout time
connectTimeout := GetTickCount + 1000;
// submit request to open the socket
socket.Open;
// wait for the connection to be established
while socket.SocketState <> ssConnected do
begin
// check for timeout
if GetTickCount > connectTimeout then
begin
result := false;
Exit;
end;
Application.ProcessMessages;
Sleep(1);
end;
// successfully connected
result := true;
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;
begin
result := false;
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
msgData : array of Byte;
cnt : byte;
waitResult: Integer;
begin
// make sure the event is reset
ResetEvent(comEvent);
comEventInfo := kNone;
// init the return value
result := false;
// prepare the packet. the first 4 bytes contain the CRO counter followed by the actual
// packet data
SetLength(msgData, packetLen+4);
// first store the CRO counter
msgData[0] := Byte(croCounter);
msgData[1] := Byte(croCounter shr 8);
msgData[2] := Byte(croCounter shr 16);
msgData[3] := Byte(croCounter shr 24);
// increment the CRO counter for the next packet
croCounter := croCounter + 1;
// copy the packet data
for cnt := 0 to packetLen-1 do
begin
msgData[cnt+4] := packetData[cnt];
end;
// submit the packet transmission request
if socket.WriteBuffer(@msgData[0], packetLen+4) = -1 then
begin
// unable to submit tx request
Exit;
end;
// packet is being transmitted. Now wait for the response to come in
waitResult := MsgWaitForSingleObject(comEvent, timeOutms);
if waitResult <> WAIT_OBJECT_0 then
begin
// no com event triggered so either a timeout or internal error occurred
result := False;
Exit;
end;
// com event was triggered. now check if the reponse was correctly received
if comEventInfo <> kResponse then
begin
result := False;
Exit;
end;
// packet successfully transmitted and response packet received
result := True;
end; //*** end of SendPacket ***
//***************************************************************************************
// NAME: Disconnect
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Disconnects the transport layer device.
//
//***************************************************************************************
procedure TXcpTransport.Disconnect;
begin
// close the socket
socket.Close;
end; //*** end of Disconnect ***
//***************************************************************************************
// NAME: OnSocketDataAvailable
// PARAMETER: Sender is the source that triggered the event.
// Socket is the socket on which the event occurred.
// RETURN VALUE: none
// DESCRIPTION: Socket data reception event handler
//
//***************************************************************************************
procedure TXcpTransport.OnSocketDataAvailable(Sender: TObject; WinSocket: TSocket);
var
tempBuffer : array[0..kMaxPacketSize-1] of Byte;
count : Integer;
idx : Integer;
begin
count := socket.ReadBuffer(@tempBuffer[0], kMaxPacketSize);
// the first 4 bytes contains the dto counter in which we are not really interested
packetLen := count - 4;
// store the response data
for idx := 0 to packetLen-1 do
begin
packetData[idx] := tempBuffer[idx+4];
end;
if packetLen = 0 then
// set event flag
comEventInfo := kError
else
// set event flag
comEventInfo := kResponse;
// trigger the event
SetEvent(comEvent);
end; //*** end of OnSocketDataAvailable ***
//***************************************************************************************
// NAME: MsgWaitForSingleObject
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Improved version of WaitForSingleObject. This version actually
// processes messages in the queue instead of blocking them.
//
//***************************************************************************************
function TXcpTransport.MsgWaitForSingleObject(hHandle: THandle; dwMilliseconds: DWORD): DWORD;
var
dwEnd:DWord;
begin
// compute the time when the WaitForSingleObject is supposed to time out
dwEnd := GetTickCount + dwMilliseconds;
repeat
// wait for an event to happen or a message to be in the queue
result := MsgWaitForMultipleObjects(1, hHandle, False, dwMilliseconds, QS_ALLINPUT);
// a message was in the queue?
if result = WAIT_OBJECT_0 + 1 then
begin
// process these messages
Application.ProcessMessages;
// check for timeout manually because if a message in the queue occurred, the
// MsgWaitForMultipleObjects will be called again and the timer will start from
// scratch. we need to make sure the correct timeout time is used.
dwMilliseconds := GetTickCount;
if dwMilliseconds < dwEnd then
begin
dwMilliseconds := dwEnd - dwMilliseconds;
end
else
begin
// timeout occured
result := WAIT_TIMEOUT;
Break;
end;
end
else
// the event occured?
begin
// we can stop
Break;
end;
until True = False;
end; //*** end of MsgWaitForSingleObject ***
end.
//******************************** end of XcpTransport.pas ******************************

BIN
Host/Source/MicroBoot/interfaces/net/net_icon.bmp
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 3.1 KiB

733
Host/Source/MicroBoot/interfaces/net/openblt_net.dpr
View File

@ -1,733 +0,0 @@
library openblt_net;
//***************************************************************************************
// Project Name: MicroBoot Interface for Borland Delphi
// Description: XCP - NET (TCP/IP) interface for MicroBoot
// File Name: openblt_net.dpr
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2014 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',
XcpLoader in '..\XcpLoader.pas',
XcpTransport in 'XcpTransport.pas',
XcpSettings in 'XcpSettings.pas' {XcpSettingsForm},
WSockets in 'WSockets.pas',
FirmwareData in '..\FirmwareData.pas';
//***************************************************************************************
// 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 : TFirmwareData;
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;
segmentCnt : longword;
byteCnt : longword;
currentWriteCnt : word;
sessionStartResult : byte;
bufferOffset : longword;
addr : longword;
len : longword;
dataSizeKB : real;
dataSizeBytes : integer;
begin
timer.Enabled := False;
// connect the transport layer
MbiCallbackOnInfo('Connecting to target via TCP/IP. Reset your target if this takes a long time.');
MbiCallbackOnLog('Connecting to target via TCP/IP. t='+ShortString(TimeToStr(Time)));
Application.ProcessMessages;
if not loader.Connect then
begin
// update the user info
MbiCallbackOnInfo('Could not connect via TCP/IP. Retrying. Reset your target if this takes a long time.');
MbiCallbackOnLog('Transport layer connection failed. Check the configured IP address and port. t='+ShortString(TimeToStr(Time)));
MbiCallbackOnLog('Retrying transport layer connection. Reset your target if this takes a long time. t='+ShortString(TimeToStr(Time)));
Application.ProcessMessages;
// continuously try to connect the transport layer
while not loader.Connect do
begin
Application.ProcessMessages;
Sleep(5);
if stopRequest then
begin
MbiCallbackOnLog('Transport layer connection cancelled by user. t='+ShortString(TimeToStr(Time)));
MbiCallbackOnError('Transport layer connection cancelled by user.');
Exit;
end;
end;
end;
// we now have a socket connected to the target. next attempt to connect to the target
// via XCP.
MbiCallbackOnLog('Starting the programming session. t='+ShortString(TimeToStr(Time)));
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;
if sessionStartResult <> kProgSessionStarted then
begin
// note that a running user program might have received the connect command and
// performed a software reset to activate the bootloader. this causes a reconfigu-
// ration of the ethernet controller so we need to disconnect the socket here and
// wait for it to reconnect.
MbiCallbackOnInfo('No response from target. Disconnecting TCP/IP socket.');
MbiCallbackOnLog('No response from target. Disconnecting TCP/IP socket. t='+ShortString(TimeToStr(Time)));
loader.Disconnect;
// connect the transport layer
MbiCallbackOnInfo('Connecting to target via TCP/IP. Reset your target if this takes a long time.');
MbiCallbackOnLog('Connecting to target via TCP/IP. t='+ShortString(TimeToStr(Time)));
Application.ProcessMessages;
if not loader.Connect then
begin
// update the user info
MbiCallbackOnInfo('Could not connect via TCP/IP. Retrying. Reset your target if this takes a long time.');
MbiCallbackOnLog('Transport layer connection failed. Check the configured IP address and port. t='+ShortString(TimeToStr(Time)));
MbiCallbackOnLog('Retrying transport layer connection. Reset your target if this takes a long time. t='+ShortString(TimeToStr(Time)));
Application.ProcessMessages;
// continuously try to connect the transport layer
while not loader.Connect do
begin
Application.ProcessMessages;
Sleep(5);
if stopRequest then
begin
MbiCallbackOnLog('Transport layer connection cancelled by user. t='+ShortString(TimeToStr(Time)));
MbiCallbackOnError('Transport layer connection cancelled by user.');
Exit;
end;
end;
end;
//---------------- start the programming session --------------------------------------
MbiCallbackOnLog('Starting the programming session. t='+ShortString(TimeToStr(Time)));
// try initial connect via XCP
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;
if sessionStartResult <> kProgSessionStarted then
begin
// update the user info
MbiCallbackOnInfo('Could not connect. Please reset your target...');
MbiCallbackOnLog('Connect failed. Switching to backdoor entry mode. t='+ShortString(TimeToStr(Time)));
Application.ProcessMessages;
// continuously try to connect via XCP true the backdoor
sessionStartResult := kProgSessionGenericError;
while sessionStartResult <> kProgSessionStarted do
begin
sessionStartResult := loader.StartProgrammingSession;
Application.ProcessMessages;
Sleep(5);
// 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
// disconnect the transport layer
MbiCallbackOnLog('Disconnecting the transport layer. t='+ShortString(TimeToStr(Time)));
loader.Disconnect;
MbiCallbackOnLog('Programming session cancelled by user. t='+ShortString(TimeToStr(Time)));
MbiCallbackOnError('Programming session cancelled by user.');
Exit;
end;
end;
end;
end;
// still here so programming session was started
MbiCallbackOnLog('Programming session started. t='+ShortString(TimeToStr(Time)));
// read the firmware file
MbiCallbackOnInfo('Reading firmware file.');
MbiCallbackOnLog('Reading firmware file. t='+ShortString(TimeToStr(Time)));
// create the datafile object and load the file contents
datafile := TFirmwareData.Create;
if not datafile.LoadFromFile(progfile, False) then
begin
MbiCallbackOnLog('Could not read firmware file (' + ShortString(ExtractFilename(progfile)) +'). t='+ShortString(TimeToStr(Time)));
MbiCallbackOnError('Could not read firmware file (' + ShortString(ExtractFilename(progfile)) +').');
datafile.Free;
Exit;
end;
// compute the size in kbytes
dataSizeBytes := 0;
// loop through all segment to get the total byte count
for segmentCnt := 0 to (datafile.SegmentCount - 1) do
begin
dataSizeBytes := dataSizeBytes + datafile.Segment[segmentCnt].Size;
end;
// convert bytes to kilobytes
dataSizeKB := dataSizeBytes / 1024;
// Call application callback when we start the actual download
MbiCallbackOnStarted(dataSizeBytes);
// Init progress to 0 progress
progress := 0;
MbiCallbackOnProgress(progress);
//---------------- next clear the memory regions --------------------------------------
// update the user info
MbiCallbackOnInfo('Erasing memory...');
for segmentCnt := 0 to (datafile.SegmentCount - 1) do
begin
// check if the user cancelled
if stopRequest then
begin
// disconnect the transport layer
MbiCallbackOnLog('Disconnecting the transport layer. t='+ShortString(TimeToStr(Time)));
loader.Disconnect;
MbiCallbackOnLog('Programming session cancelled by user. t='+ShortString(TimeToStr(Time)));
MbiCallbackOnError('Programming session cancelled by user.');
datafile.Free;
Exit;
end;
// obtain the region info
addr := datafile.Segment[segmentCnt].BaseAddress;
len := datafile.Segment[segmentCnt].Size;
// 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 segmentCnt := 0 to (datafile.SegmentCount - 1) do
begin
// update the user info
MbiCallbackOnInfo('Reading file...');
// obtain the region info
addr := datafile.Segment[segmentCnt].BaseAddress;
len := datafile.Segment[segmentCnt].Size;
SetLength(progdata, len);
for byteCnt := 0 to (len - 1) do
begin
progdata[byteCnt] := datafile.Segment[segmentCnt].Data[byteCnt];
end;
bufferOffset := 0;
while len > 0 do
begin
// check if the user cancelled
if stopRequest then
begin
// disconnect the transport layer
MbiCallbackOnLog('Disconnecting the transport layer. t='+ShortString(TimeToStr(Time)));
loader.Disconnect;
MbiCallbackOnLog('Programming session cancelled by user. t='+ShortString(TimeToStr(Time)));
MbiCallbackOnError('Programming session cancelled by user.');
datafile.Free;
Exit;
end;
// 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 := dataSizeBytes;
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_net.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;
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 TCP/IP';
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 TCP/IP';
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 := 10100; // v1.01.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_net.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_net.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_net.dpr *****************************

121
Host/Source/MicroBoot/interfaces/net/openblt_net.dproj
View File

@ -1,121 +0,0 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{B16E2683-DC28-4FA8-9418-7F3350903FA7}</ProjectGuid>
<MainSource>openblt_net.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Library</AppType>
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>18.2</ProjectVersion>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
<Cfg_2_Win32>true</Cfg_2_Win32>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_N>true</DCC_N>
<DCC_WriteableConstants>true</DCC_WriteableConstants>
<DCC_UsePackage>Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40;IcsDel40;$(DCC_UsePackage)</DCC_UsePackage>
<DCC_S>false</DCC_S>
<DCC_F>false</DCC_F>
<DCC_DebugInformation>1</DCC_DebugInformation>
<DCC_SymbolReferenceInfo>1</DCC_SymbolReferenceInfo>
<DCC_K>false</DCC_K>
<SanitizedProjectName>openblt_net</SanitizedProjectName>
<DCC_Alignment>1</DCC_Alignment>
<DCC_E>false</DCC_E>
<GenDll>true</GenDll>
<DCC_ExeOutput>../../../../</DCC_ExeOutput>
<DCC_ImageBase>00400000</DCC_ImageBase>
<VerInfo_Locale>1043</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace)</DCC_Namespace>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<VerInfo_Locale>1033</VerInfo_Locale>
<DCC_Namespace>System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_DebugInformation>0</DCC_DebugInformation>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_Optimize>false</DCC_Optimize>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<VerInfo_Keys>CompanyName=;FileVersion=1.1.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.1.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName)</VerInfo_Keys>
<VerInfo_MinorVer>1</VerInfo_MinorVer>
<Manifest_File>(None)</Manifest_File>
<VerInfo_Locale>1033</VerInfo_Locale>
<Debugger_HostApplication>C:\Work\software\OpenBLT\Host\MicroBoot.exe</Debugger_HostApplication>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="..\XcpProtection.pas"/>
<DCCReference Include="..\XcpLoader.pas"/>
<DCCReference Include="XcpTransport.pas"/>
<DCCReference Include="XcpSettings.pas">
<Form>XcpSettingsForm</Form>
</DCCReference>
<DCCReference Include="WSockets.pas"/>
<DCCReference Include="..\FirmwareData.pas"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">openblt_net.dpr</Source>
</Source>
</Delphi.Personality>
<Platforms>
<Platform value="Win32">True</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
</Project>

BIN
Host/Source/MicroBoot/interfaces/uart/CPDrv.ico
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 766 B

227
Host/Source/MicroBoot/interfaces/uart/CPort.inc
View File

@ -1,227 +0,0 @@
{ ComPort Library global definitions }
{ Fixed up for Delphi 2009 by W.Postma. }
{$B-}
{$X+}
{$H+}
{$IFDEF VER110} { C++ Builder 3 }
{$ObjExportAll On}
{$DEFINE VER_RECOGNIZED}
{$ENDIF}
{$IFDEF VER120} { Delphi 4 }
{$DEFINE DELPHI_4_OR_HIGHER}
{$DEFINE DELPHI_4}
{$DEFINE VER_RECOGNIZED}
{$ENDIF}
{$IFDEF VER125} { C++ Builder 4 }
{$DEFINE DELPHI_4_OR_HIGHER}
{$DEFINE DELPHI_4}
{$ObjExportAll On}
{$DEFINE VER_RECOGNIZED}
{$ENDIF}
{$IFDEF VER130} { Delphi 5 and C++ Builder 5 }
{$DEFINE DELPHI_4_OR_HIGHER}
{$DEFINE DELPHI_5_OR_HIGHER}
{$DEFINE DELPHI_5}
{$IFDEF BCBNOTDELPHI}
{$ObjExportAll On}
{$ENDIF}
{$DEFINE VER_RECOGNIZED}
{$ENDIF}
{$IFDEF VER140} { Delphi 6 and C++ Builder 6}
{$DEFINE DELPHI_4_OR_HIGHER}
{$DEFINE DELPHI_5_OR_HIGHER}
{$DEFINE DELPHI_6_OR_HIGHER}
{$DEFINE DELPHI_6}
{$IFDEF BCBNOTDELPHI}
{$ObjExportAll On}
{$ENDIF}
{$DEFINE VER_RECOGNIZED}
{$ENDIF}
{$IFDEF VER150} { Delphi 7 }
{$DEFINE DELPHI_4_OR_HIGHER}
{$DEFINE DELPHI_5_OR_HIGHER}
{$DEFINE DELPHI_6_OR_HIGHER}
{$DEFINE DELPHI_7_OR_HIGHER}
{$DEFINE DELPHI_7}
{$IFDEF BCBNOTDELPHI}
{$ObjExportAll On}
{$ENDIF}
{$WARN UNSAFE_TYPE OFF}
{$WARN UNSAFE_CODE OFF}
{$WARN UNSAFE_CAST OFF}
{$DEFINE VER_RECOGNIZED}
{$ENDIF}
{$IFDEF VER160} { Delphi 8 }
{$DEFINE DELPHI_4_OR_HIGHER}
{$DEFINE DELPHI_5_OR_HIGHER}
{$DEFINE DELPHI_6_OR_HIGHER}
{$DEFINE DELPHI_7_OR_HIGHER}
{$DEFINE DELPHI_8_OR_HIGHER}
{$DEFINE DELPHI_8}
{$IFDEF BCBNOTDELPHI}
{$ObjExportAll On}
{$ENDIF}
{$WARN UNSAFE_TYPE OFF}
{$WARN UNSAFE_CODE OFF}
{$WARN UNSAFE_CAST OFF}
{$DEFINE VER_RECOGNIZED}
{$ENDIF}
{$IFDEF VER170} { Delphi 9 (2005) }
{$DEFINE DELPHI_4_OR_HIGHER}
{$DEFINE DELPHI_5_OR_HIGHER}
{$DEFINE DELPHI_6_OR_HIGHER}
{$DEFINE DELPHI_7_OR_HIGHER}
{$DEFINE DELPHI_8_OR_HIGHER}
{$DEFINE DELPHI_2005_OR_HIGHER}
{$DEFINE DELPHI_2005}
{$IFDEF BCBNOTDELPHI}
{$ObjExportAll On}
{$ENDIF}
{$WARN UNSAFE_TYPE OFF}
{$WARN UNSAFE_CODE OFF}
{$WARN UNSAFE_CAST OFF}
{$DEFINE VER_RECOGNIZED}
{$ENDIF}
{$IFDEF VER180} { Delphi 10 (2006) }
{$DEFINE DELPHI_4_OR_HIGHER}
{$DEFINE DELPHI_5_OR_HIGHER}
{$DEFINE DELPHI_6_OR_HIGHER}
{$DEFINE DELPHI_7_OR_HIGHER}
{$DEFINE DELPHI_8_OR_HIGHER}
{$DEFINE DELPHI_2005_OR_HIGHER}
{$DEFINE DELPHI_2006_OR_HIGHER}
{$DEFINE DELPHI_2006}
{$IFDEF BCBNOTDELPHI}
{$ObjExportAll On}
{$ENDIF}
{$WARN UNSAFE_TYPE OFF}
{$WARN UNSAFE_CODE OFF}
{$WARN UNSAFE_CAST OFF}
{$DEFINE VER_RECOGNIZED}
{$ENDIF}
{$IFDEF VER185} { Delphi 11 - 2007 }
{$DEFINE DELPHI_4_OR_HIGHER}
{$DEFINE DELPHI_5_OR_HIGHER}
{$DEFINE DELPHI_6_OR_HIGHER}
{$DEFINE DELPHI_7_OR_HIGHER}
{$DEFINE DELPHI_8_OR_HIGHER}
{$DEFINE DELPHI_2005_OR_HIGHER}
{$DEFINE DELPHI_2006_OR_HIGHER}
{$DEFINE DELPHI_2007_OR_HIGHER}
{$DEFINE DELPHI_2007}
{$WARN UNSAFE_TYPE OFF}
{$WARN UNSAFE_CODE OFF}
{$WARN UNSAFE_CAST OFF}
{$IFDEF BCB}
{$DEFINE BCB11}
{$ObjExportAll On}
{$ENDIF}
{$DEFINE VER_RECOGNIZED}
{$ENDIF}
{$IFDEF VER190} { Delphi 12 2008 }
{$DEFINE DELPHI_4_OR_HIGHER}
{$DEFINE DELPHI_5_OR_HIGHER}
{$DEFINE DELPHI_6_OR_HIGHER}
{$DEFINE DELPHI_7_OR_HIGHER}
{$DEFINE DELPHI_8_OR_HIGHER}
{$DEFINE DELPHI_2005_OR_HIGHER}
{$DEFINE DELPHI_2006_OR_HIGHER}
{$DEFINE DELPHI_2007_OR_HIGHER}
{$DEFINE DELPHI_2008_OR_HIGHER}
{$DEFINE DELPHI_2008}
{$DEFINE DELPHI_UNICODE}
{$IFDEF BCBNOTDELPHI}
{$ObjExportAll On}
{$ENDIF}
{$WARN UNSAFE_TYPE OFF}
{$WARN UNSAFE_CODE OFF}
{$WARN UNSAFE_CAST OFF}
{$DEFINE VER_RECOGNIZED}
{$ENDIF}
{$IFDEF VER200} { Delphi 14 2009 UNICODE }
{$DEFINE DELPHI_4_OR_HIGHER}
{$DEFINE DELPHI_5_OR_HIGHER}
{$DEFINE DELPHI_6_OR_HIGHER}
{$DEFINE DELPHI_7_OR_HIGHER}
{$DEFINE DELPHI_8_OR_HIGHER}
{$DEFINE DELPHI_2005_OR_HIGHER}
{$DEFINE DELPHI_2006_OR_HIGHER}
{$DEFINE DELPHI_2007_OR_HIGHER}
{$DEFINE DELPHI_2008_OR_HIGHER}
{$DEFINE DELPHI_2009_OR_HIGHER}
{$DEFINE DELPHI_2009}
{$DEFINE DELPHI_UNICODE}
{$IFDEF BCBNOTDELPHI}
{$ObjExportAll On}
{$ENDIF}
{$WARN UNSAFE_TYPE OFF}
{$WARN UNSAFE_CODE OFF}
{$WARN UNSAFE_CAST OFF}
{$DEFINE VER_RECOGNIZED}
{$ENDIF}
{$IFDEF VER210} { Delphi 15 XE 2010 UNICODE }
{$DEFINE DELPHI_4_OR_HIGHER}
{$DEFINE DELPHI_5_OR_HIGHER}
{$DEFINE DELPHI_6_OR_HIGHER}
{$DEFINE DELPHI_7_OR_HIGHER}
{$DEFINE DELPHI_8_OR_HIGHER}
{$DEFINE DELPHI_2005_OR_HIGHER}
{$DEFINE DELPHI_2006_OR_HIGHER}
{$DEFINE DELPHI_2007_OR_HIGHER}
{$DEFINE DELPHI_2008_OR_HIGHER}
{$DEFINE DELPHI_2009_OR_HIGHER}
{$DEFINE DELPHI_2010_OR_HIGHER}
{$DEFINE DELPHI_2010}
{$DEFINE DELPHI_UNICODE}
{$IFDEF BCBNOTDELPHI}
{$ObjExportAll On}
{$ENDIF}
{$WARN UNSAFE_TYPE OFF}
{$WARN UNSAFE_CODE OFF}
{$WARN UNSAFE_CAST OFF}
{$DEFINE VER_RECOGNIZED}
{$ENDIF}
{... Lets try to make it work, for Delphi 2011 and later, right now...}
{$IFNDEF VER_RECOGNIZED}
{$DEFINE DELPHI_4_OR_HIGHER}
{$DEFINE DELPHI_5_OR_HIGHER}
{$DEFINE DELPHI_6_OR_HIGHER}
{$DEFINE DELPHI_7_OR_HIGHER}
{$DEFINE DELPHI_8_OR_HIGHER}
{$DEFINE DELPHI_2005_OR_HIGHER}
{$DEFINE DELPHI_2006_OR_HIGHER}
{$DEFINE DELPHI_2007_OR_HIGHER}
{$DEFINE DELPHI_2009_OR_HIGHER}
{$DEFINE DELPHI_2010_OR_HIGHER}
{$DEFINE DELPHI_UNICODE}
{$WARN UNSAFE_TYPE OFF}
{$WARN UNSAFE_CODE OFF}
{$WARN UNSAFE_CAST OFF}
{$ENDIF}
{$UNDEF VER_RECOGNIZED}

3652
Host/Source/MicroBoot/interfaces/uart/CPort.pas
View File

File diff suppressed because it is too large Load Diff

BIN
Host/Source/MicroBoot/interfaces/uart/XcpSettings.dfm
View File

Binary file not shown.

277
Host/Source/MicroBoot/interfaces/uart/XcpSettings.pas
View File

@ -1,277 +0,0 @@
unit XcpSettings;
//***************************************************************************************
// Description: XCP settings interface for SCI
// File Name: XcpSettings.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2011 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;
tabSci: TTabSheet;
iconSci: TImage;
lblSci: TLabel;
lblXcp: TLabel;
iconXcp2: TImage;
lblComport: TLabel;
cmbComport: TComboBox;
lblBaudrate: TLabel;
cmbBaudrate: TComboBox;
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;
openDialog: TOpenDialog;
edtTconnect: TEdit;
lblTconnect: TLabel;
tabSession: TTabSheet;
iconXcp3: TImage;
lblXcpSession: TLabel;
lblConnectMode: TLabel;
cmbConnectMode: TComboBox;
procedure btnOKClick(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
procedure btnBrowseClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
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: 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;
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);
// SCI related elements
FSettingsForm.cmbComport.ItemIndex := settingsIni.ReadInteger('sci', 'port', 0);
FSettingsForm.cmbBaudrate.ItemIndex := settingsIni.ReadInteger('sci', 'baudrate', 6);
// XCP related elements
FSettingsForm.edtSeedKey.Text := settingsIni.ReadString('xcp', 'seedkey', ExtractFilePath(ParamStr(0))+'');
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));
FSettingsForm.cmbConnectMode.ItemIndex := settingsIni.ReadInteger('xcp', 'connectmode', 0);
// release ini file object
settingsIni.Free;
end
else
begin
// set defaults
// SCI related elements
FSettingsForm.cmbComport.ItemIndex := 0;
FSettingsForm.cmbBaudrate.ItemIndex := 6;
// XCP related elements
FSettingsForm.edtSeedKey.Text := ExtractFilePath(ParamStr(0))+'';
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);
FSettingsForm.cmbConnectMode.ItemIndex := 0;
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);
// SCI related elements
settingsIni.WriteInteger('sci', 'port', FSettingsForm.cmbComport.ItemIndex);
settingsIni.WriteInteger('sci', 'baudrate', FSettingsForm.cmbBaudrate.ItemIndex);
// 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));
settingsIni.WriteInteger('xcp', 'connectmode', FSettingsForm.cmbConnectMode.ItemIndex);
// 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 *******************************

345
Host/Source/MicroBoot/interfaces/uart/XcpTransport.pas
View File

@ -1,345 +0,0 @@
unit XcpTransport;
//***************************************************************************************
// Description: XCP transport layer for SCI.
// File Name: XcpTransport.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2011 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, CPort, IniFiles;
//***************************************************************************************
// Global Constants
//***************************************************************************************
const kMaxPacketSize = 256;
//***************************************************************************************
// Type Definitions
//***************************************************************************************
type
TXcpTransport = class(TObject)
private
public
packetData : array[0..kMaxPacketSize-1] of Byte;
packetLen : Word;
sciDriver : TComPort;
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;
// reset packet length
packetLen := 0;
// create a sci driver instance
sciDriver := TComPort.Create(nil);
// init sci settings
try
sciDriver.DataBits := dbEight;
sciDriver.StopBits := sbOneStopBit;
sciDriver.Parity.Bits := prNone;
sciDriver.FlowControl.XonXoffOut := false;
sciDriver.FlowControl.XonXoffIn := false;
sciDriver.FlowControl.ControlRTS := rtsDisable;
sciDriver.FlowControl.ControlDTR := dtrEnable;
except
Exit;
end;
end; //*** end of Create ***
//***************************************************************************************
// NAME: Destroy
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Class destructor
//
//***************************************************************************************
destructor TXcpTransport.Destroy;
begin
// release sci driver instance
sciDriver.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;
configIndex : integer;
baudrateValue: TBaudRate;
begin
// read XCP configuration from INI
if FileExists(iniFile) then
begin
// create ini file object
settingsIni := TIniFile.Create(iniFile);
// read baudrate
configIndex := settingsIni.ReadInteger('sci', 'baudrate', 6);
// init to default baudrate value
baudrateValue := br38400;
case configIndex of
0 : baudrateValue := br1200;
1 : baudrateValue := br2400;
2 : baudrateValue := br4800;
3 : baudrateValue := br9600;
4 : baudrateValue := br14400;
5 : baudrateValue := br19200;
6 : baudrateValue := br38400;
7 : baudrateValue := br56000;
8 : baudrateValue := br57600;
9 : baudrateValue := br115200;
10: baudrateValue := br128000;
11: baudrateValue := br256000;
end;
// read port
configIndex := settingsIni.ReadInteger('sci', 'port', 0);
// release ini file object
settingsIni.Free;
// set the port and the baudrate
try
sciDriver.Port := Format( 'COM%d', [ord(configIndex + 1)] );
sciDriver.BaudRate := baudrateValue;
except
Exit;
end;
end;
end; //*** end of Configure ***
//***************************************************************************************
// NAME: Connect
// PARAMETER: none
// RETURN VALUE: True is successful, False otherwise.
// DESCRIPTION: Connects the transport layer device.
//
//***************************************************************************************
function TXcpTransport.Connect : Boolean;
begin
try
sciDriver.Open;
result := sciDriver.Connected;
except
result := False;
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;
begin
result := false;
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
msgData : array of Byte;
resLen : byte;
cnt : byte;
rxCnt : byte;
dwEnd : DWord;
bytesRead : integer;
begin
// init the return value
result := false;
// during high burst I/O the USB/RS232 emulated COM-ports sometimes have problems
// processing all the data. therefore, add a small delay time between packet I/O.
// exclude the CONNECT command because of the default small backdoor time of the
// bootloader
if packetData[0] <> $FF then
begin
Application.ProcessMessages;
Sleep(5);
end;
// prepare the packet. length goes in the first byte followed by the packet data
SetLength(msgData, packetLen+1);
msgData[0] := packetLen;
for cnt := 0 to packetLen-1 do
begin
msgData[cnt+1] := packetData[cnt];
end;
// configure transmit timeout. timeout = (MULTIPLIER) * number_of_bytes + CONSTANT
try
sciDriver.Timeouts.WriteTotalConstant := 0;
sciDriver.Timeouts.WriteTotalMultiplier := timeOutms div (packetLen+1);
except
Exit;
end;
// submit the packet transmission request
if sciDriver.Write(msgData[0], packetLen+1) <> (packetLen+1) then
begin
// unable to submit tx request
Exit;
end;
// give application the opportunity to process the messages
Application.ProcessMessages;
// confgure the reception timeout. timeout = (MULTIPLIER) * number_of_bytes + CONSTANT
try
sciDriver.Timeouts.ReadTotalConstant := timeOutms;
sciDriver.Timeouts.ReadTotalMultiplier := 0;
except
Exit;
end;
// compute timeout time for receiving the response
dwEnd := GetTickCount + timeOutms;
// receive the first byte which should hold the packet length
try
bytesRead := sciDriver.Read(resLen, 1);
except
Exit;
end;
if bytesRead = 1 then
begin
// init the number of received bytes to 0
rxCnt := 0;
packetLen := 0;
// only attempt to receive the remainder of the packet if its length is valid
if resLen > 0 then
begin
// re-confgure the reception timeout now that the total packet length is known.
// timeout = (MULTIPLIER) * number_of_bytes + CONSTANT
try
sciDriver.Timeouts.ReadTotalConstant := 0;
sciDriver.Timeouts.ReadTotalMultiplier := timeOutms div resLen;
except
Exit;
end;
// attempt to receive the bytes of the response packet one by one
while (rxCnt < resLen) and (GetTickCount < dwEnd) do
begin
// receive the next byte
try
bytesRead := sciDriver.Read(packetData[rxCnt], 1);
except
Exit;
end;
if bytesRead = 1 then
begin
// increment counter
rxCnt := rxCnt + 1;
end;
end;
// check to see if all bytes were received. if not, then a timeout must have
// happened.
if rxCnt = resLen then
begin
packetLen := resLen;
result := true;
end;
end;
end;
end; //*** end of SendPacket ***
//***************************************************************************************
// NAME: Disconnect
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Disconnects the transport layer device.
//
//***************************************************************************************
procedure TXcpTransport.Disconnect;
begin
try
sciDriver.Close;
except
Exit;
end;
end; //*** end of Disconnect ***
end.
//******************************** end of XcpTransport.pas ******************************

672
Host/Source/MicroBoot/interfaces/uart/openblt_uart.dpr
View File

@ -1,672 +0,0 @@
library openblt_uart;
//***************************************************************************************
// Project Name: MicroBoot Interface for Borland Delphi
// Description: XCP - SCI interface for MicroBoot
// File Name: openblt_uart.dpr
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2011 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',
XcpLoader in '..\XcpLoader.pas',
XcpTransport in 'XcpTransport.pas',
XcpSettings in 'XcpSettings.pas' {XcpSettingsForm},
CPort in 'CPort.pas',
FirmwareData in '..\FirmwareData.pas';
//***************************************************************************************
// 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 : TFirmwareData;
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;
segmentCnt : longword;
byteCnt : longword;
currentWriteCnt : word;
sessionStartResult : byte;
bufferOffset : longword;
addr : longword;
len : longword;
dataSizeKB : real;
dataSizeBytes : integer;
begin
timer.Enabled := False;
// connect the transport layer
MbiCallbackOnInfo('Connecting to the COM port.');
MbiCallbackOnLog('Connecting to the COM port. t='+ShortString(TimeToStr(Time)));
Application.ProcessMessages;
if not loader.Connect then
begin
// update the user info
MbiCallbackOnError('Could not connect to COM port. Check your configuration.');
MbiCallbackOnLog('Could not connect to COM port. 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 loader.StartProgrammingSession <> 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;
// continuously try to connect via XCP true the backdoor
sessionStartResult := kProgSessionGenericError;
while sessionStartResult <> kProgSessionStarted do
begin
// disconnect COM-port for board that have on board FTDI type chip that powers down
// during power cycling
loader.Disconnect;
// reconnect COM-port. no need to check the return value because it might fail when
// an FTDI type chip is on board while it is cycling power.
if loader.Connect then
begin
sessionStartResult := loader.StartProgrammingSession;
Application.ProcessMessages;
Sleep(5);
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
// disconnect the transport layer
MbiCallbackOnLog('Disconnecting the transport layer. t='+ShortString(TimeToStr(Time)));
loader.Disconnect;
MbiCallbackOnLog('Programming session cancelled by user. t='+ShortString(TimeToStr(Time)));
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)));
// read the firmware file
MbiCallbackOnInfo('Reading firmware file.');
MbiCallbackOnLog('Reading firmware file. t='+ShortString(TimeToStr(Time)));
// create the datafile object and load the file contents
datafile := TFirmwareData.Create;
if not datafile.LoadFromFile(progfile, False) then
begin
MbiCallbackOnLog('Could not read firmware file (' + ShortString(ExtractFilename(progfile)) +'). t='+ShortString(TimeToStr(Time)));
MbiCallbackOnError('Could not read firmware file (' + ShortString(ExtractFilename(progfile)) +').');
datafile.Free;
Exit;
end;
// compute the size in kbytes
dataSizeBytes := 0;
// loop through all segment to get the total byte count
for segmentCnt := 0 to (datafile.SegmentCount - 1) do
begin
dataSizeBytes := dataSizeBytes + datafile.Segment[segmentCnt].Size;
end;
// convert bytes to kilobytes
dataSizeKB := dataSizeBytes / 1024;
// Call application callback when we start the actual download
MbiCallbackOnStarted(dataSizeBytes);
// Init progress to 0 progress
progress := 0;
MbiCallbackOnProgress(progress);
//---------------- next clear the memory regions --------------------------------------
// update the user info
MbiCallbackOnInfo('Erasing memory...');
for segmentCnt := 0 to (datafile.SegmentCount - 1) do
begin
// check if the user cancelled
if stopRequest then
begin
// disconnect the transport layer
MbiCallbackOnLog('Disconnecting the transport layer. t='+ShortString(TimeToStr(Time)));
loader.Disconnect;
MbiCallbackOnLog('Programming session cancelled by user. t='+ShortString(TimeToStr(Time)));
MbiCallbackOnError('Programming session cancelled by user.');
datafile.Free;
Exit;
end;
// obtain the region info
addr := datafile.Segment[segmentCnt].BaseAddress;
len := datafile.Segment[segmentCnt].Size;
// 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 segmentCnt := 0 to (datafile.SegmentCount - 1) do
begin
// update the user info
MbiCallbackOnInfo('Reading file...');
// obtain the region info
addr := datafile.Segment[segmentCnt].BaseAddress;
len := datafile.Segment[segmentCnt].Size;
SetLength(progdata, len);
for byteCnt := 0 to (len - 1) do
begin
progdata[byteCnt] := datafile.Segment[segmentCnt].Data[byteCnt];
end;
bufferOffset := 0;
while len > 0 do
begin
// check if the user cancelled
if stopRequest then
begin
// disconnect the transport layer
MbiCallbackOnLog('Disconnecting the transport layer. t='+ShortString(TimeToStr(Time)));
loader.Disconnect;
MbiCallbackOnLog('Programming session cancelled by user. t='+ShortString(TimeToStr(Time)));
MbiCallbackOnError('Programming session cancelled by user.');
datafile.Free;
Exit;
end;
// 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 := dataSizeBytes;
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_uart.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;
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 UART';
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 UART';
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 := 10100; // v1.01.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_uart.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_uart.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_uart.dpr ****************************

121
Host/Source/MicroBoot/interfaces/uart/openblt_uart.dproj
View File

@ -1,121 +0,0 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{38BAA5EC-0626-4775-9516-B3DED4560560}</ProjectGuid>
<MainSource>openblt_uart.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Library</AppType>
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>18.2</ProjectVersion>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
<Cfg_2_Win32>true</Cfg_2_Win32>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_K>false</DCC_K>
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace)</DCC_Namespace>
<DCC_UsePackage>Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40;$(DCC_UsePackage)</DCC_UsePackage>
<DCC_S>false</DCC_S>
<DCC_F>false</DCC_F>
<VerInfo_Locale>1031</VerInfo_Locale>
<DCC_ImageBase>00400000</DCC_ImageBase>
<DCC_SymbolReferenceInfo>1</DCC_SymbolReferenceInfo>
<DCC_DebugInformation>1</DCC_DebugInformation>
<DCC_N>true</DCC_N>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<SanitizedProjectName>openblt_uart</SanitizedProjectName>
<GenDll>true</GenDll>
<DCC_E>false</DCC_E>
<DCC_WriteableConstants>true</DCC_WriteableConstants>
<DCC_ExeOutput>../../../../</DCC_ExeOutput>
<DCC_Alignment>1</DCC_Alignment>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<VerInfo_Locale>1033</VerInfo_Locale>
<DCC_Namespace>System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_DebugInformation>0</DCC_DebugInformation>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
<DCC_Optimize>false</DCC_Optimize>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<VerInfo_MinorVer>1</VerInfo_MinorVer>
<VerInfo_Keys>CompanyName=;FileVersion=1.1.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.1.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName)</VerInfo_Keys>
<VerInfo_Locale>1033</VerInfo_Locale>
<Debugger_HostApplication>C:\Work\software\OpenBLT\Host\MicroBoot.exe</Debugger_HostApplication>
<Manifest_File>(None)</Manifest_File>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="..\XcpProtection.pas"/>
<DCCReference Include="..\XcpLoader.pas"/>
<DCCReference Include="XcpTransport.pas"/>
<DCCReference Include="XcpSettings.pas">
<Form>XcpSettingsForm</Form>
</DCCReference>
<DCCReference Include="CPort.pas"/>
<DCCReference Include="..\FirmwareData.pas"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">openblt_uart.dpr</Source>
</Source>
</Delphi.Personality>
<Platforms>
<Platform value="Win32">True</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
</Project>

125
Host/Source/MicroBoot/interfaces/usb/UsbBulkLib.pas
View File

@ -1,125 +0,0 @@
unit UsbBulkLib;
//***************************************************************************************
// Project Name: Wrapper interface for accessing the UsbBulkLib DLL.
// Description: UsbBulkLib DLL interface unit for Delphi
// File Name: UsbBulkLib.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2011 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
//***************************************************************************************
// Global includes
//****************************************************************************************
uses
SysUtils;
//***************************************************************************************
// Global constant declarations
//****************************************************************************************
const
UBL_ERROR = 0;
UBL_OKAY = 1;
UBL_TIMEOUT = 2;
//***************************************************************************************
// Function prototypes
//****************************************************************************************
function UblOpen(guid: PGUID): Byte; stdcall;
procedure UblClose; stdcall;
function UblTransmit(data: PByteArray; len: Word): Byte; stdcall;
function UblReceive(data: PByteArray; len: Word; timeout: Longword): Byte; stdcall;
implementation
//***************************************************************************************
// Local constant declarations
//****************************************************************************************
const DLL_Name = 'UsbBulkLib.dll';
//***************************************************************************************
// NAME: UblOpen
// PARAMETER: guid pointer to GUID of the USB bulk device as found in the driver's
// INF-file.
// RETURN VALUE: UBL_OKAY if successful, UBL_ERROR otherwise.
// DESCRIPTION: Opens and configures the connection with the USB bulk device.
//
//***************************************************************************************
function UblOpen(guid: PGUID): Byte; stdcall;
external DLL_Name;
//***************************************************************************************
// NAME: UblClose
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Closes the connection with the USB bulk device and frees all the
// related handles.
//
//***************************************************************************************
procedure UblClose; stdcall;
external DLL_Name;
//***************************************************************************************
// NAME: UblTransmit
// PARAMETER: data pointer to byte array with transmit data.
// len number of bytes to transmit.
// RETURN VALUE: UBL_OKAY if successful, UBL_ERROR otherwise.
// DESCRIPTION: Starts transmission of the data on the bulk OUT pipe. Because USB
// bulk transmissions are quick, this function does not use the
// overlapped functionality, which means the caller is blocked until
// the tranmission completed.
//
//***************************************************************************************
function UblTransmit(data: PByteArray; len: Word): Byte; stdcall;
external DLL_Name;
//***************************************************************************************
// NAME: UblReceive
// PARAMETER: data pointer to byte array where the data will be stored.
// len number of bytes to receive.
// timeout max time in milliseconds for the read to complete.
// RETURN VALUE: UBL_OKAY if successful, UBL_TIMEOUT if failure due to timeout or
// UBL_ERROR otherwise.
// DESCRIPTION: Starts the asynchronous reception of the data from the bulk IN pipe.
// This function makes use of the overlapped functionality, which means
// the calling thread if placed into sleep mode until the reception is
// complete.
//
//***************************************************************************************
function UblReceive(data: PByteArray; len: Word; timeout: Longword): Byte; stdcall;
external DLL_Name;
end.
//********************************** end of UsbBulkLib.pas ******************************

BIN
Host/Source/MicroBoot/interfaces/usb/XcpSettings.dfm
View File

Binary file not shown.

258
Host/Source/MicroBoot/interfaces/usb/XcpSettings.pas
View File

@ -1,258 +0,0 @@
unit XcpSettings;
//***************************************************************************************
// Description: XCP settings interface for SCI
// File Name: XcpSettings.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2011 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;
lblXcp: TLabel;
iconXcp2: TImage;
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;
openDialog: TOpenDialog;
edtTconnect: TEdit;
lblTconnect: TLabel;
tabSession: TTabSheet;
iconXcp3: TImage;
lblXcpSession: TLabel;
lblConnectMode: TLabel;
cmbConnectMode: TComboBox;
procedure btnOKClick(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
procedure btnBrowseClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
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: 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;
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);
// XCP related elements
FSettingsForm.edtSeedKey.Text := settingsIni.ReadString('xcp', 'seedkey', ExtractFilePath(ParamStr(0))+'');
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));
FSettingsForm.cmbConnectMode.ItemIndex := settingsIni.ReadInteger('xcp', 'connectmode', 0);
// release ini file object
settingsIni.Free;
end
else
begin
// set defaults
// XCP related elements
FSettingsForm.edtSeedKey.Text := ExtractFilePath(ParamStr(0))+'';
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);
FSettingsForm.cmbConnectMode.ItemIndex := 0;
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);
// 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));
settingsIni.WriteInteger('xcp', 'connectmode', FSettingsForm.cmbConnectMode.ItemIndex);
// 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 *******************************

225
Host/Source/MicroBoot/interfaces/usb/XcpTransport.pas
View File

@ -1,225 +0,0 @@
unit XcpTransport;
//***************************************************************************************
// Description: XCP transport layer for USB.
// File Name: XcpTransport.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2011 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, UsbBulkLib, IniFiles;
//***************************************************************************************
// Global Constants
//***************************************************************************************
const kMaxPacketSize = 256;
//***************************************************************************************
// Type Definitions
//***************************************************************************************
type
TXcpTransport = class(TObject)
private
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;
//***************************************************************************************
// Constant data declarations
//***************************************************************************************
const
deviceGuid: tguid = '{807999C3-E4E0-40EA-8188-48E852B54F2B}';
implementation
//***************************************************************************************
// NAME: Create
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Class constructore
//
//***************************************************************************************
constructor TXcpTransport.Create;
begin
// call inherited constructor
inherited Create;
// the DLL for UsbBulkLib is automatically loaded, so nothing to be done here
// reset packet length
packetLen := 0;
end; //*** end of Create ***
//***************************************************************************************
// NAME: Destroy
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Class destructor
//
//***************************************************************************************
destructor TXcpTransport.Destroy;
begin
// the DLL for UsbBulkLib is automatically unloaded, so nothing to be done here
// 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);
begin
// there are no communication specific settings for USB
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;
begin
result := true;
if UblOpen(Addr(deviceGuid)) <> UBL_OKAY then
result := false;
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;
begin
result := false;
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
msgData : array of Byte;
resLen : byte;
cnt : byte;
dwEnd :DWord;
begin
// init the return value
result := false;
// prepare the packet. length goes in the first byte followed by the packet data
SetLength(msgData, packetLen+1);
msgData[0] := packetLen;
for cnt := 0 to packetLen-1 do
begin
msgData[cnt+1] := packetData[cnt];
end;
// submit the packet transmission request
if UblTransmit(@msgData[0], packetLen+1) <> UBL_OKAY then
begin
// unable to submit tx request
Exit;
end;
// give application the opportunity to process the messages
Application.ProcessMessages;
// compute timeout time
dwEnd := GetTickCount + timeOutms;
// receive the first byte which holds the packet length
if UblReceive(Addr(resLen), 1, timeOutms) = UBL_OKAY then
begin
timeOutms := GetTickCount;
if timeOutms >= dwEnd then
begin
Exit; // timed out
end;
// receive the actual packet data
if UblReceive(Addr(packetData[0]), resLen, dwEnd - timeOutms) = UBL_OKAY then
begin
packetLen := resLen;
result := true;
end;
end;
end; //*** end of SendPacket ***
//***************************************************************************************
// NAME: Disconnect
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Disconnects the transport layer device.
//
//***************************************************************************************
procedure TXcpTransport.Disconnect;
begin
UblClose;
end; //*** end of Disconnect ***
end.
//******************************** end of XcpTransport.pas ******************************

675
Host/Source/MicroBoot/interfaces/usb/openblt_usb.dpr
View File

@ -1,675 +0,0 @@
library openblt_usb;
//***************************************************************************************
// Project Name: MicroBoot Interface for Borland Delphi
// Description: XCP - USB interface for MicroBoot
// File Name: openblt_usb.dpr
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2011 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',
XcpLoader in '..\XcpLoader.pas',
XcpTransport in 'XcpTransport.pas',
XcpSettings in 'XcpSettings.pas' {XcpSettingsForm},
UsbBulkLib in 'UsbBulkLib.pas',
FirmwareData in '..\FirmwareData.pas';
//***************************************************************************************
// 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 : TFirmwareData;
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;
segmentCnt : longword;
byteCnt : longword;
currentWriteCnt : word;
sessionStartResult : byte;
bufferOffset : longword;
addr : longword;
len : longword;
dataSizeKB : real;
dataSizeBytes : integer;
begin
timer.Enabled := False;
// connect the transport layer
MbiCallbackOnInfo('Connecting to target via USB.');
MbiCallbackOnLog('Connecting to target via USB. t='+ShortString(TimeToStr(Time)));
Application.ProcessMessages;
if not loader.Connect then
begin
// update the user info
MbiCallbackOnInfo('Could not connect via USB. Retrying. Reset your target if this takes a long time.');
MbiCallbackOnLog('Transport layer connection failed. t='+ShortString(TimeToStr(Time)));
MbiCallbackOnLog('Retrying transport layer connection. Reset your target if this takes a long time. t='+ShortString(TimeToStr(Time)));
Application.ProcessMessages;
// continuously try to coonect the transport layer
while not loader.Connect do
begin
Application.ProcessMessages;
Sleep(5);
if stopRequest then
begin
MbiCallbackOnError('Transport layer connection cancelled by user.');
Exit;
end;
end;
end;
//---------------- start the programming session --------------------------------------
MbiCallbackOnLog('Starting the programming session. t='+ShortString(TimeToStr(Time)));
// try initial connect via XCP
if loader.StartProgrammingSession <> 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;
// continuously try to connect via XCP true the backdoor
sessionStartResult := kProgSessionGenericError;
while sessionStartResult <> kProgSessionStarted do
begin
sessionStartResult := loader.StartProgrammingSession;
Application.ProcessMessages;
Sleep(5);
// 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
// disconnect the transport layer
MbiCallbackOnLog('Disconnecting the transport layer. t='+ShortString(TimeToStr(Time)));
loader.Disconnect;
MbiCallbackOnLog('Programming session cancelled by user. t='+ShortString(TimeToStr(Time)));
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)));
// read the firmware file
MbiCallbackOnInfo('Reading firmware file.');
MbiCallbackOnLog('Reading firmware file. t='+ShortString(TimeToStr(Time)));
// create the datafile object and load the file contents
datafile := TFirmwareData.Create;
if not datafile.LoadFromFile(progfile, False) then
begin
MbiCallbackOnLog('Could not read firmware file (' + ShortString(ExtractFilename(progfile)) +'). t='+ShortString(TimeToStr(Time)));
MbiCallbackOnError('Could not read firmware file (' + ShortString(ExtractFilename(progfile)) +').');
datafile.Free;
Exit;
end;
// compute the size in kbytes
dataSizeBytes := 0;
// loop through all segment to get the total byte count
for segmentCnt := 0 to (datafile.SegmentCount - 1) do
begin
dataSizeBytes := dataSizeBytes + datafile.Segment[segmentCnt].Size;
end;
// convert bytes to kilobytes
dataSizeKB := dataSizeBytes / 1024;
// Call application callback when we start the actual download
MbiCallbackOnStarted(dataSizeBytes);
// Init progress to 0 progress
progress := 0;
MbiCallbackOnProgress(progress);
//---------------- next clear the memory regions --------------------------------------
// update the user info
MbiCallbackOnInfo('Erasing memory...');
for segmentCnt := 0 to (datafile.SegmentCount - 1) do
begin
// check if the user cancelled
if stopRequest then
begin
// disconnect the transport layer
MbiCallbackOnLog('Disconnecting the transport layer. t='+ShortString(TimeToStr(Time)));
loader.Disconnect;
MbiCallbackOnLog('Programming session cancelled by user. t='+ShortString(TimeToStr(Time)));
MbiCallbackOnError('Programming session cancelled by user.');
datafile.Free;
Exit;
end;
// obtain the region info
addr := datafile.Segment[segmentCnt].BaseAddress;
len := datafile.Segment[segmentCnt].Size;
// 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 segmentCnt := 0 to (datafile.SegmentCount - 1) do
begin
// update the user info
MbiCallbackOnInfo('Reading file...');
// obtain the region info
addr := datafile.Segment[segmentCnt].BaseAddress;
len := datafile.Segment[segmentCnt].Size;
SetLength(progdata, len);
for byteCnt := 0 to (len - 1) do
begin
progdata[byteCnt] := datafile.Segment[segmentCnt].Data[byteCnt];
end;
bufferOffset := 0;
while len > 0 do
begin
// check if the user cancelled
if stopRequest then
begin
// disconnect the transport layer
MbiCallbackOnLog('Disconnecting the transport layer. t='+ShortString(TimeToStr(Time)));
loader.Disconnect;
MbiCallbackOnLog('Programming session cancelled by user. t='+ShortString(TimeToStr(Time)));
MbiCallbackOnError('Programming session cancelled by user.');
datafile.Free;
Exit;
end;
// 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 := dataSizeBytes;
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_usb.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;
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 USB';
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 USB';
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 := 10100; // v1.01.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_usb.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_usb.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_usb.dpr *****************************

121
Host/Source/MicroBoot/interfaces/usb/openblt_usb.dproj
View File

@ -1,121 +0,0 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{5F773EB4-5A4B-4591-999A-E208B1A44407}</ProjectGuid>
<MainSource>openblt_usb.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Library</AppType>
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>18.2</ProjectVersion>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
<Cfg_2_Win32>true</Cfg_2_Win32>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_K>false</DCC_K>
<DCC_F>false</DCC_F>
<DCC_DebugInformation>1</DCC_DebugInformation>
<GenDll>true</GenDll>
<DCC_ExeOutput>.\..\..\..\..\</DCC_ExeOutput>
<DCC_Alignment>1</DCC_Alignment>
<DCC_N>true</DCC_N>
<DCC_E>false</DCC_E>
<DCC_S>false</DCC_S>
<DCC_ImageBase>00400000</DCC_ImageBase>
<DCC_WriteableConstants>true</DCC_WriteableConstants>
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace)</DCC_Namespace>
<SanitizedProjectName>openblt_usb</SanitizedProjectName>
<VerInfo_Locale>1031</VerInfo_Locale>
<DCC_SymbolReferenceInfo>1</DCC_SymbolReferenceInfo>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<DCC_UsePackage>Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40;$(DCC_UsePackage)</DCC_UsePackage>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<VerInfo_Locale>1033</VerInfo_Locale>
<DCC_Namespace>System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_DebugInformation>0</DCC_DebugInformation>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_Optimize>false</DCC_Optimize>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<VerInfo_MinorVer>1</VerInfo_MinorVer>
<VerInfo_Keys>CompanyName=;FileVersion=1.1.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.1.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName)</VerInfo_Keys>
<Debugger_HostApplication>C:\Work\software\OpenBLT\Host\MicroBoot.exe</Debugger_HostApplication>
<VerInfo_Locale>1033</VerInfo_Locale>
<Manifest_File>(None)</Manifest_File>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="..\XcpProtection.pas"/>
<DCCReference Include="..\XcpLoader.pas"/>
<DCCReference Include="XcpTransport.pas"/>
<DCCReference Include="XcpSettings.pas">
<Form>XcpSettingsForm</Form>
</DCCReference>
<DCCReference Include="UsbBulkLib.pas"/>
<DCCReference Include="..\FirmwareData.pas"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">openblt_usb.dpr</Source>
</Source>
</Delphi.Personality>
<Platforms>
<Platform value="Win32">True</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
</Project>

325
Host/Source/MicroBoot/mainunit.lfm Normal file
View File

@ -0,0 +1,325 @@
object MainForm: TMainForm
Left = 505
Height = 180
Top = 293
Width = 500
ActiveControl = BtnBrowse
Caption = 'MicroBoot'
ClientHeight = 180
ClientWidth = 500
Constraints.MinHeight = 180
Constraints.MinWidth = 500
Icon.Data = {
BE0800000000010001002020000000000000A808000016000000280000002000
0000400000000100080000000000800400000000000000000000000100000000
0000000000000E0E0E00053A2600323232003E3E3E000050320000573700005A
3900005F3D0000623E0000654000006B4400007048000072490000734A000074
4A00007D5000007D51004A4A4A0056565600626262006E6E6E007A7A7A000082
540000865700008857000088580000905E0000915E0000915F0000925F000096
6200009A650000A0690000A56C0000AB700000B0730000B2750000B5770000B8
790000B97A00007AB90000C3810000C8850000CA860000CF8A0000D38C0000D9
900000DB910000DC92000092DC0000AAFF0048B8FF006BFFC6006BC6FF008686
8600929292009E9E9E00AAAAAA00B6B6B6008ED4FF00B1E2FF00C2C2C200CECE
CE00DADADA00E6E6E600F2F2F200FFFFFF00B2164000820000000000000028CD
490014E8B900820000000000000078E8B9003B16400082000000000000000700
0000C8E8B9003879000014E9B900AC0D00001101000096800000040D00000000
000000000000000000001810400002000000C8E8B900387900006001A7002CE8
B900B4E8B900CAF848000000000094E8B900C6154000000000008C0E00008200
000018104000A09EF90000C0F800E43306002880F700004C58003CC0F80000C0
F800E43306002880F700004C5800000000008F92F70000C0F8000000000000E9
B900E71A32003F0100000CC0F80000C0F800E43306002880F700004C58000000
00000CC0D70000C0D700E43306002880F700DC4B5800000000008F92F70000C0
D7000000000048E9B900E71A7A003F01000000C0D600F88FD800EC46F70000C0
D70000000000FC8FD8007CE9B900E71A7A003F010000FC8FD800791AF7005CE9
B9003525F90000C0D6008C0E000000000000791AF7009C7900008CEAB9002E19
F700E71A7A00000000007A79A7001701000000004600000000000200FC000200
07002800E700170100008C0E0000E7AF1700D4793500AF1700008C0E000044EA
B90034D3140040EAB9008C0E0000A8E9B9000000D700F0EAB900F88CFB00E213
F70064EAB90014FB170060EAB900900ACC00CCE9B90044EAB900F0EAB900F88C
FB00E213F70037010000731AEC0014FB1700C8B6620064EAB90064EAB90014FB
17002CEAB9006917EC0014FB1700C8B6620064EAB90014FB1700000000000300
0000807ACC00807ACC0050EAB900A2084900000000005CEAB900411D4000807A
CC00807ACC006CEAB900FAF84800B798F700CF98F700A4F15A00807ACC009111
0000D8230400807ACC00CF13000009000000807ACC0078D10300901B40000070
CC00F5954400807ACC00682D6300682D6300D50445000000CC00C078CC008067
BB000000000000000000D4EC4C00D4EC4C00D4EC4C00D4EC4C00E213F7003701
0000EF16EC0034D3140034D31400DCB8400034D3140018104000181040000200
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000003D333C3336323632343234293329332933293329332933320000
0000000000000000000000000000000000000000000000000000000000000000
00000000000001313131312D2A28282523211F1F1C19100D0C0A070502010000
000000000000483100000031000000280000001F000000170E00000005020000
00000000000048310037003100370028001500280015001E1100130005050000
00000000000048310037003100150028001400280013001F1A00040005050000
0000000000004831000000310000002B000000280000001F1D00000006050000
000000000000483131313131302F2E2C282827262422201B18110F0B09080000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000001515000000000000000000000000000000
0000000000000000000000000000001213000000000000000000000000000000
0000000000000000000000000000000412000000000000000000000000000000
0000000000000000000000000000000304000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000041214141414151515151616161637373716163737393B000000
00000000000014153738393A3B3E3E3E3E3E3E3E3E3E3E04281F373F3F000000
00000000000014163738393A3B3E3E3E3E3E3E3E3E3E3E043528163F3F000000
00000000000015163738393A3B3E3E3E3E3E3E3E3E3E3E161315373F3F000000
000000000000161638393A3B3E3E3E3E3E3F3F4040414142424242423F000000
000000000000161603041213141515161637373838383838383838403F000000
0000000000001616030404121314151516163737383838383838383F3F000000
0000000000003738393A3B3B3E3E3E3E3E3E3E3E3E3E3E3E3E3E3E3E3E000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FFFFFFFFC0000003C0000003C0000003C0000003E0000007C0000003C000
0003C0000003C0000003C0000003C0000003C0000003FFE07FFFFFE03FFFFFE0
3FFFFFE07FFFC0000007C0000007C0000007C0000007C0000007C0000007C000
0007C0000007C0000007C0000007C0000007C0000007FFFFFFFFFFFFFFFFFFFF
FFFF
}
OnCreate = FormCreate
OnDestroy = FormDestroy
Position = poScreenCenter
LCLVersion = '1.6.2.0'
object PnlBody: TPanel
Left = 0
Height = 84
Top = 50
Width = 500
Align = alClient
BevelInner = bvLowered
Caption = 'PnlBody'
ClientHeight = 84
ClientWidth = 500
TabOrder = 0
object PnlBodyRight: TPanel
Left = 400
Height = 80
Top = 2
Width = 98
Align = alRight
BevelOuter = bvNone
Caption = 'PnlBodyRight'
ClientHeight = 80
ClientWidth = 98
TabOrder = 0
object BtnBrowse: TButton
Left = 10
Height = 28
Top = 34
Width = 83
Caption = 'Browse..'
OnClick = BtnBrowseClick
TabOrder = 0
end
end
object PnlBodyMain: TPanel
Left = 2
Height = 80
Top = 2
Width = 398
Align = alClient
BevelOuter = bvNone
Caption = 'PnlBodyMain'
ClientHeight = 80
ClientWidth = 398
TabOrder = 1
OnResize = PnlBodyMainResize
object PgbFirmwareUpdate: TProgressBar
Left = 16
Height = 28
Top = 34
Width = 379
Position = 35
Smooth = True
Step = 1
TabOrder = 0
end
object LblFirmwareUpdateInfo: TLabel
Left = 16
Height = 17
Top = 14
Width = 132
Caption = 'LblFirmwareUpdateInfo'
ParentColor = False
end
end
end
object PnlFooter: TPanel
Left = 0
Height = 46
Top = 134
Width = 500
Align = alBottom
BevelOuter = bvNone
Caption = 'PnlFooter'
ClientHeight = 46
ClientWidth = 500
TabOrder = 1
object PnlFooterButtons: TPanel
Left = 306
Height = 46
Top = 0
Width = 194
Align = alRight
BevelOuter = bvNone
Caption = 'PnlFooterButtons'
ClientHeight = 46
ClientWidth = 194
TabOrder = 0
object BtnExit: TButton
Left = 104
Height = 28
Top = 8
Width = 83
Caption = 'Exit'
OnClick = BtnExitClick
TabOrder = 1
end
object BtnSettings: TButton
Left = 8
Height = 28
Top = 8
Width = 83
Caption = 'Settings..'
OnClick = BtnSettingsClick
TabOrder = 0
end
end
object LblElapsedTime: TLabel
Left = 16
Height = 17
Top = 14
Width = 88
Caption = 'LblElapsedTime'
ParentColor = False
end
end
object PnlHeader: TPanel
Left = 0
Height = 50
Top = 0
Width = 500
Align = alTop
BevelOuter = bvNone
Caption = 'PnlHeader'
ClientHeight = 50
ClientWidth = 500
TabOrder = 2
object ImgHeader: TImage
Left = 448
Height = 50
Top = 0
Width = 52
Align = alRight
Center = True
Picture.Data = {
055449636F6EBE0800000000010001002020000000000000A808000016000000
2800000020000000400000000100080000000000800400000000000000000000
0001000000000000000000000E0E0E00053A2600323232003E3E3E0000503200
00573700005A3900005F3D0000623E0000654000006B44000070480000724900
00734A0000744A00007D5000007D51004A4A4A0056565600626262006E6E6E00
7A7A7A000082540000865700008857000088580000905E0000915E0000915F00
00925F0000966200009A650000A0690000A56C0000AB700000B0730000B27500
00B5770000B8790000B97A00007AB90000C3810000C8850000CA860000CF8A00
00D38C0000D9900000DB910000DC92000092DC0000AAFF0048B8FF006BFFC600
6BC6FF0086868600929292009E9E9E00AAAAAA00B6B6B6008ED4FF00B1E2FF00
C2C2C200CECECE00DADADA00E6E6E600F2F2F200FFFFFF00B216400082000000
0000000028CD490014E8B900820000000000000078E8B9003B16400082000000
0000000007000000C8E8B9003879000014E9B900AC0D00001101000096800000
040D00000000000000000000000000001810400002000000C8E8B90038790000
6001A7002CE8B900B4E8B900CAF848000000000094E8B900C615400000000000
8C0E00008200000018104000A09EF90000C0F800E43306002880F700004C5800
3CC0F80000C0F800E43306002880F700004C5800000000008F92F70000C0F800
0000000000E9B900E71A32003F0100000CC0F80000C0F800E43306002880F700
004C5800000000000CC0D70000C0D700E43306002880F700DC4B580000000000
8F92F70000C0D7000000000048E9B900E71A7A003F01000000C0D600F88FD800
EC46F70000C0D70000000000FC8FD8007CE9B900E71A7A003F010000FC8FD800
791AF7005CE9B9003525F90000C0D6008C0E000000000000791AF7009C790000
8CEAB9002E19F700E71A7A00000000007A79A700170100000000460000000000
0200FC00020007002800E700170100008C0E0000E7AF1700D4793500AF170000
8C0E000044EAB90034D3140040EAB9008C0E0000A8E9B9000000D700F0EAB900
F88CFB00E213F70064EAB90014FB170060EAB900900ACC00CCE9B90044EAB900
F0EAB900F88CFB00E213F70037010000731AEC0014FB1700C8B6620064EAB900
64EAB90014FB17002CEAB9006917EC0014FB1700C8B6620064EAB90014FB1700
0000000003000000807ACC00807ACC0050EAB900A2084900000000005CEAB900
411D4000807ACC00807ACC006CEAB900FAF84800B798F700CF98F700A4F15A00
807ACC0091110000D8230400807ACC00CF13000009000000807ACC0078D10300
901B40000070CC00F5954400807ACC00682D6300682D6300D50445000000CC00
C078CC008067BB000000000000000000D4EC4C00D4EC4C00D4EC4C00D4EC4C00
E213F70037010000EF16EC0034D3140034D31400DCB8400034D3140018104000
1810400002000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000003D333C3336323632343234293329332933293329
3329333200000000000000000000000000000000000000000000000000000000
00000000000000000000000001313131312D2A28282523211F1F1C19100D0C0A
070502010000000000000000483100000031000000280000001F000000170E00
00000502000000000000000048310037003100370028001500280015001E1100
13000505000000000000000048310037003100150028001400280013001F1A00
0400050500000000000000004831000000310000002B000000280000001F1D00
000006050000000000000000483131313131302F2E2C282827262422201B1811
0F0B090800000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000001515000000000000000000
0000000000000000000000000000000000000000001213000000000000000000
0000000000000000000000000000000000000000000412000000000000000000
0000000000000000000000000000000000000000000304000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000412141414141515151516161616373737161637
37393B00000000000000000014153738393A3B3E3E3E3E3E3E3E3E3E3E04281F
373F3F00000000000000000014163738393A3B3E3E3E3E3E3E3E3E3E3E043528
163F3F00000000000000000015163738393A3B3E3E3E3E3E3E3E3E3E3E161315
373F3F000000000000000000161638393A3B3E3E3E3E3E3F3F40404141424242
42423F0000000000000000001616030412131415151616373738383838383838
38403F0000000000000000001616030404121314151516163737383838383838
383F3F0000000000000000003738393A3B3B3E3E3E3E3E3E3E3E3E3E3E3E3E3E
3E3E3E0000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000FFFFFFFFC0000003C0000003C0000003C0000003E0000007
C0000003C0000003C0000003C0000003C0000003C0000003C0000003FFE07FFF
FFE03FFFFFE03FFFFFE07FFFC0000007C0000007C0000007C0000007C0000007
C0000007C0000007C0000007C0000007C0000007C0000007C0000007FFFFFFFF
FFFFFFFFFFFFFFFF
}
end
object LblProgramName: TLabel
Left = 8
Height = 17
Top = 8
Width = 60
Caption = 'MicroBoot'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
object LblProgramConfig: TLabel
Left = 16
Height = 17
Top = 29
Width = 101
Caption = 'LblProgramConfig'
ParentColor = False
end
end
object OpenDialog: TOpenDialog
Filter = ' Motorola S-record (*.s19;*.s28;*.s37;*.sx;*.srec;*.mot)|*.s19;*.s28;*.s37;*.sx;*.srec;*.mot|All files (*.*)|*.*'
Options = [ofFileMustExist, ofEnableSizing, ofViewDetail]
left = 384
end
object TmrClose: TTimer
Enabled = False
Interval = 200
OnTimer = TmrCloseTimer
left = 312
end
end

697
Host/Source/MicroBoot/mainunit.pas Normal file
View File

@ -0,0 +1,697 @@
unit MainUnit;
//***************************************************************************************
// Description: Contains the main user interface for MicroBoot.
// File Name: mainunit.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2018 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.
//
//***************************************************************************************
{$IFDEF FPC}
{$MODE objfpc}{$H+}
{$ENDIF}
interface
//***************************************************************************************
// Includes
//***************************************************************************************
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, LCLType,
ExtCtrls, ComCtrls, CurrentConfig, ConfigGroups, SettingsDialog, FirmwareUpdate,
StopWatch, FileLogger;
//***************************************************************************************
// Constant declarations.
//***************************************************************************************
const
PROGRAM_NAME_STR = 'MicroBoot';
PROGRAM_VERSION_STR = 'v2.00';
//***************************************************************************************
// Type Definitions
//***************************************************************************************
type
//------------------------------ TUserInterfaceSetting --------------------------------
TUserInterfaceSetting = ( UIS_DEFAULT = 0,
UIS_FIRMWARE_UPDATE );
//------------------------------ TMainForm --------------------------------------------
TMainForm = class(TForm)
BtnExit: TButton;
BtnSettings: TButton;
BtnBrowse: TButton;
ImgHeader: TImage;
LblElapsedTime: TLabel;
LblFirmwareUpdateInfo: TLabel;
LblProgramConfig: TLabel;
LblProgramName: TLabel;
OpenDialog: TOpenDialog;
PnlBodyMain: TPanel;
PnlBodyRight: TPanel;
PnlHeader: TPanel;
PnlFooterButtons: TPanel;
PnlFooter: TPanel;
PnlBody: TPanel;
PgbFirmwareUpdate: TProgressBar;
TmrClose: TTimer;
procedure BtnBrowseClick(Sender: TObject);
procedure BtnExitClick(Sender: TObject);
procedure BtnSettingsClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure PnlBodyMainResize(Sender: TObject);
procedure TmrCloseTimer(Sender: TObject);
private
FCurrentConfig: TCurrentConfig;
FFirmwareUpdate: TFirmwareUpdate;
FUISetting: TUserInterfaceSetting;
FStopWatch: TStopWatch;
FFileLogger: TFileLogger;
FHFreeSpaceProgressBar: Integer;
FCmdOptionFileFound: Boolean;
FFirmwareFile: String;
procedure ParseCommandLine;
function StartFirmwareUpdate: Boolean;
procedure FinishFirmwareUpdate(CloseProgram: Boolean);
procedure CancelFirmwareUpdate;
procedure HandleFirmwareUpdateError(ErrorString: String);
procedure UpdateUserInterface;
procedure UpdateElapsedTime(Interval: String);
procedure StopWatchUpdateEvent(Sender: TObject; Interval: String);
procedure FirmwareUpdateStarted(Sender: TObject);
procedure FirmwareUpdateStopped(Sender: TObject);
procedure FirmwareUpdateDone(Sender: TObject);
procedure FirmwareUpdateInfo(Sender: TObject; InfoString: String);
procedure FirmwareUpdateLog(Sender: TObject; LogString: String);
procedure FirmwareUpdateProgress(Sender: TObject; Percentage: Integer);
procedure FirmwareUpdateError(Sender: TObject; ErrorString: String);
function GetConfigSummary: String;
public
end;
//***************************************************************************************
// Global Variables
//***************************************************************************************
var
MainForm: TMainForm;
implementation
{$R *.lfm}
//---------------------------------------------------------------------------------------
//-------------------------------- TMainForm --------------------------------------------
//---------------------------------------------------------------------------------------
//***************************************************************************************
// NAME: FormCreate
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Form constructor.
//
//***************************************************************************************
procedure TMainForm.FormCreate(Sender: TObject);
var
mainWindowConfig: TMainWindowConfig;
begin
// Clear panel captions as these are only needed as hint during design time.
PnlHeader.Caption := '';
PnlBody.Caption := '';
PnlBodyMain.Caption := '';
PnlBodyRight.Caption := '';
PnlFooter.Caption := '';
PnlFooterButtons.Caption := '';
// Store the default difference in width between the progress bar and its parent panel.
FHFreeSpaceProgressBar := PnlBodyMain.Width - PgbFirmwareUpdate.Width;
// Initialize the user interface.
FUISetting := UIS_DEFAULT;
UpdateUserInterface();
// Initialize fields.
FCmdOptionFileFound := False;
FFirmwareFile := '';
// Parse the command line.
ParseCommandLine;
// Create instance to manage the program's configuration and add the configuration
// group instances.
FCurrentConfig := TCurrentConfig.Create;
FCurrentConfig.AddGroup(TMainWindowConfig.Create);
FCurrentConfig.AddGroup(TMiscellaneousConfig.Create);
FCurrentConfig.AddGroup(TSessionConfig.Create);
FCurrentConfig.AddGroup(TSessionXcpConfig.Create);
FCurrentConfig.AddGroup(TTransportConfig.Create);
FCurrentConfig.AddGroup(TTransportXcpRs232Config.Create);
FCurrentConfig.AddGroup(TTransportXcpCanConfig.Create);
FCurrentConfig.AddGroup(TTransportXcpUsbConfig.Create);
FCurrentConfig.AddGroup(TTransportXcpTcpIpConfig.Create);
// Load the program's configuration from the configuration file.
FCurrentConfig.LoadFromFile;
// Update the program configuration label.
LblProgramConfig.Caption := GetConfigSummary;
// Set main window configuration settings.
mainWindowConfig := FCurrentConfig.Groups[TMainWindowConfig.GROUP_NAME]
as TMainWindowConfig;
MainForm.Width := mainWindowConfig.Width;
MainForm.Height := mainWindowConfig.Height;
// Create instance of the firmware update class.
FFirmwareUpdate := TFirmwareUpdate.Create(FCurrentConfig);
// Register its event handlers.
FFirmwareUpdate.OnStarted := @FirmwareUpdateStarted;
FFirmwareUpdate.OnStopped := @FirmwareUpdateStopped;
FFirmwareUpdate.OnDone := @FirmwareUpdateDone;
FFirmwareUpdate.OnInfo := @FirmwareUpdateInfo;
FFirmwareUpdate.OnLog := @FirmwareUpdateLog;
FFirmwareUpdate.OnProgress := @FirmwareUpdateProgress;
FFirmwareUpdate.OnError := @FirmwareUpdateError;
// Create and configure stopwatch instance.
FStopWatch := TStopWatch.Create;
FStopWatch.OnUpdate := @StopWatchUpdateEvent;
// Create the file logger instance.
FFileLogger := TFileLogger.Create;
// Automatically kick off the firmware update procedure if a firmware file was
// specified on the command line.
if FCmdOptionFileFound then
begin
StartFirmwareUpdate;
end;
end; //*** end of FormCreate
//***************************************************************************************
// NAME: FormDestroy
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Form destructor.
//
//***************************************************************************************
procedure TMainForm.FormDestroy(Sender: TObject);
var
mainWindowConfig: TMainWindowConfig;
begin
// Release the file logger instance.
FFileLogger.Free;
// Release stopwatch instance.
FStopWatch.Free;
// Release instance of the firmware update class.
FFirmwareUpdate.Free;
// Store main window configuration settings.
mainWindowConfig := FCurrentConfig.Groups[TMainWindowConfig.GROUP_NAME]
as TMainWindowConfig;
mainWindowConfig.Width := MainForm.Width;
mainWindowConfig.Height := MainForm.Height;
// Save the program's configuration to the configuration file.
FCurrentConfig.SaveToFile;
// Release the instance that manages the program's configuration.
FCurrentConfig.Free;
end; //*** end of FormDestroy ***
//***************************************************************************************
// NAME: ParseCommandLine
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Parses the command line parameters.
//
//***************************************************************************************
procedure TMainForm.ParseCommandLine;
begin
// The program currently support one command line parameter, which is the firmware
// file. If a valid file is specified, the firmware update should start automatically.
if ParamCount = 1 then
begin
// Check if parameter contains an existing file.
if FileExists(ParamStr(1)) then
begin
// Store the filename.
FFirmwareFile := ParamStr(1);
// Set flag for later processing.
FCmdOptionFileFound := True;
end;
end;
end; //*** end of ParseCommandLine ***
//***************************************************************************************
// NAME: PnlBodyMainResize
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Event handler that gets called when the panel is resized.
//
//***************************************************************************************
procedure TMainForm.PnlBodyMainResize(Sender: TObject);
begin
// Also resize the progress bar.
PgbFirmwareUpdate.Width := PnlBodyMain.Width - FHFreeSpaceProgressBar;
end; //*** end of PnlBodyMainResize ***
//***************************************************************************************
// NAME: TmrCloseTimer
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Event handler that gets called when the timer expires.
//
//***************************************************************************************
procedure TMainForm.TmrCloseTimer(Sender: TObject);
begin
// Disable the timer, because it is a one-shot timer.
TmrClose.Enabled := False;
// Close the program.
Close;
end; //*** end of TmrCloseTimer ***
//***************************************************************************************
// NAME: StartFirmwareUpdate
// PARAMETER: none
// RETURN VALUE: True if successful, False otherwise.
// DESCRIPTION: Starts the firmware update procedure.
//***************************************************************************************
function TMainForm.StartFirmwareUpdate: Boolean;
var
miscellaneousConfig: TMiscellaneousConfig;
begin
// Initialize the result.
Result := False;
// Attempt to start the firmware update.
if FFirmwareUpdate.Start(FFirmwareFile) then
begin
// Update the user interface setting.
FUISetting := UIS_FIRMWARE_UPDATE;
// Update the user interface.
UpdateUserInterface;
// Determine if file logging is requested.
miscellaneousConfig := FCurrentConfig.Groups[TMiscellaneousConfig.GROUP_NAME]
as TMiscellaneousConfig;
if (miscellaneousConfig.Logging <> 0) and (miscellaneousConfig.LogFile <> '') then
begin
// Configure and start file logging.
FFileLogger.LogFile := miscellaneousConfig.LogFile;
FFileLogger.Start;
end;
// Start the stop watch refresh timer.
FStopWatch.Start;
end;
end; //*** end of StartFirmwareUpdate ***
//***************************************************************************************
// NAME: FinishFirmwareUpdate
// PARAMETER: CloseProgram True if the program should be closed, false otherwise.
// RETURN VALUE: none
// DESCRIPTION: Finished the firmware update after the firmware update procedure
// completed.
//***************************************************************************************
procedure TMainForm.FinishFirmwareUpdate(CloseProgram: Boolean);
begin
// Stop file logging.
FFileLogger.Stop;
// Close the program if requested.
if CloseProgram then
begin
// Start timer to perform a delayed closing of the program. This procedure could be
// called from one of the OnXxx event handlers of the firmware update class. These
// events are synchronized to the main loop, meaning that the internal thread of the
// firmware update class is suspended until the event function completes. When you
// close the program, it will also free the firmware update class, which in turn
// terminates its internal thread. This could deadlock, because it might still be
// suspended. The timer makes it possible for the internal thread of the firmware
// update class to complete and terminate itself, preventing the deadlock situation.
TmrClose.Enabled := True;
end
else
begin
// Stop the stop watch refresh timer.
FStopWatch.Stop;
// Update the user interface setting.
FUISetting := UIS_DEFAULT;
// Update the user interface.
UpdateUserInterface;
end;
end; //*** end of FinishFirmwareUpdate ***
//***************************************************************************************
// NAME: CancelFirmwareUpdate
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Cancels an ongoing firmware update procedure.
//***************************************************************************************
procedure TMainForm.CancelFirmwareUpdate;
begin
// Stop the stop watch refresh timer.
FStopWatch.Stop;
// Cancel the firmware update.
FFirmwareUpdate.Stop;
// Update the user interface setting.
FUISetting := UIS_DEFAULT;
// Update the user interface.
UpdateUserInterface;
end; //*** end of CancelFirmwareUpdate ***
//***************************************************************************************
// NAME: HandleFirmwareUpdateError
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Handles the situation when an error was detected during a firmware
// update.
//***************************************************************************************
procedure TMainForm.HandleFirmwareUpdateError(ErrorString: String);
var
boxStyle: Integer;
begin
// Stop the stop watch refresh timer.
FStopWatch.Stop;
// Configure the message box.
boxStyle := MB_ICONERROR + MB_OK;
// Display the message box.
Application.MessageBox(PAnsiChar(AnsiString(ErrorString)), 'Error detected', boxStyle);
// Update the user interface setting.
FUISetting := UIS_DEFAULT;
// Update the user interface.
UpdateUserInterface;
end; //*** end of HandleFirmwareUpdateError ***
//***************************************************************************************
// NAME: UpdateUserInterface
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Updates the user interface look and layout based on the current
// setting.
//
//***************************************************************************************
procedure TMainForm.UpdateUserInterface;
begin
// Update look and layout for the default setting.
if FUISetting = UIS_DEFAULT then
begin
Caption := PROGRAM_NAME_STR + ' ' + PROGRAM_VERSION_STR;
LblFirmwareUpdateInfo.Caption := 'Select file to start the firmware update';
LblElapsedTime.Caption := '';
PgbFirmwareUpdate.Position := 0;
BtnBrowse.Enabled := True;
BtnSettings.Enabled := True;
BtnExit.Caption := 'Exit';
end
// Update look and layout for the firmware update setting.
else if FUISetting = UIS_FIRMWARE_UPDATE then
begin
Caption := PROGRAM_NAME_STR +' ' + PROGRAM_VERSION_STR + ' - ' +
ExtractFileName(FFirmwareFile) + '..';
UpdateElapsedTime('');
PgbFirmwareUpdate.Position := 0;
BtnBrowse.Enabled := False;
BtnSettings.Enabled := False;
BtnExit.Caption := 'Cancel';
end;
end; //*** end of UpdateUserInterface ***
//***************************************************************************************
// NAME: UpdateElapsedTime
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Updates the elapsed time on the user interface.
//
//***************************************************************************************
procedure TMainForm.UpdateElapsedTime(Interval: String);
begin
LblElapsedTime.Caption := 'Elapsed time: ' + Interval;
end; //*** end of UpdateElapsedTime ***
//***************************************************************************************
// NAME: StopWatchUpdateEvent
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Event handler that gets called when the stopwatch got updated.
//
//***************************************************************************************
procedure TMainForm.StopWatchUpdateEvent(Sender: TObject; Interval: String);
begin
// Update the elapsed time on the user interface.
UpdateElapsedTime(Interval);
end; //*** end of StopWatchUpdateEvent ***
//***************************************************************************************
// NAME: FirmwareUpdateStarted
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Event handler that gets called when a firmware update just started.
//
//***************************************************************************************
procedure TMainForm.FirmwareUpdateStarted(Sender: TObject);
begin
// Nothing need to be done here for now.
end; //*** end of FirmwareUpdateStarted ***
//***************************************************************************************
// NAME: FirmwareUpdateStopped
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Event handler that gets called when a firmware update was stopped.
//
//***************************************************************************************
procedure TMainForm.FirmwareUpdateStopped(Sender: TObject);
begin
// Finish up to firmware update but do not close the program, because the firmware
// update was cancelled. This makes if possible for the user to retry.
FinishFirmwareUpdate(False);
end; //*** end of FirmwareUpdateStopped ***
//***************************************************************************************
// NAME: FirmwareUpdateDone
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Event handler that gets called when a firmware update finished.
//
//***************************************************************************************
procedure TMainForm.FirmwareUpdateDone(Sender: TObject);
begin
// Finish firmware update and close the program
FinishFirmwareUpdate(True);
end; //*** end of FirmwareUpdateDone ***
//***************************************************************************************
// NAME: FirmwareUpdateInfo
// PARAMETER: Sender Source of the event.
// InfoString One liner with info text.
// RETURN VALUE: none
// DESCRIPTION: Event handler that gets called when a firmware update process has new
// info to report. The info string can be used to update a label on the
// user interface to inform the user of what the firmware updater is
// currently working on.
//
//***************************************************************************************
procedure TMainForm.FirmwareUpdateInfo(Sender: TObject; InfoString: String);
begin
// Display the info on the user interface.
LblFirmwareUpdateInfo.Caption := InfoString;
end; //*** end of FirmwareUpdateInfo ***
//***************************************************************************************
// NAME: FirmwareUpdateLog
// PARAMETER: Sender Source of the event.
// LogString Text for logging purposes.
// RETURN VALUE: none
// DESCRIPTION: Event handler that gets called when a firmware update process has new
// log information to report. The log string can be used to display
// details regarding the firmware update process to the user or to write
// this information to a log-file.
//
//***************************************************************************************
procedure TMainForm.FirmwareUpdateLog(Sender: TObject; LogString: String);
begin
// Pass the log event on to the file logger, if active.
if FFileLogger.Started then
begin
FFileLogger.Log(LogString);
end;
end; //*** end of FirmwareUpdateLog ***
//***************************************************************************************
// NAME: FirmwareUpdateProgress
// PARAMETER: Sender Source of the event.
// Percentage Firmware update progress as a percentage (0..100).
// RETURN VALUE: none
// DESCRIPTION: Event handler that gets called when a firmware update process has new
// progress to report. The progress information can be used to update
// a progress bar for example.
//
//***************************************************************************************
procedure TMainForm.FirmwareUpdateProgress(Sender: TObject; Percentage: Integer);
begin
// Display the progress on the user interface.
PgbFirmwareUpdate.Position := Percentage;
// Fix for progress bar not going 100%
PgbFirmwareUpdate.Position := Percentage - 1;
// Update progress bar one more time.
PgbFirmwareUpdate.Position := Percentage;
end; //*** end of FirmwareUpdateProgress ***
//***************************************************************************************
// NAME: FirmwareUpdateError
// PARAMETER: Sender Source of the event.
// ErrorString Descriptive text regarding the error that occurred.
// RETURN VALUE: none
// DESCRIPTION: Event handler that gets called when an error was detected during the
// firmware update process. This information can be used for logging
// purposes and also to stop the firmware update process.
//
//***************************************************************************************
procedure TMainForm.FirmwareUpdateError(Sender: TObject; ErrorString: String);
begin
// Handle the error.
HandleFirmwareUpdateError(ErrorString);
end; //*** end of FirmwareUpdateError ***
//***************************************************************************************
// NAME: GetConfigSummary
// PARAMETER: Sender Source of the event.
// RETURN VALUE: Configuration summary.
// DESCRIPTION: Obtains a string that contains a summary of the current active
// configuration, for example: 'for OpenBLT using XCP on UART'.
//
//***************************************************************************************
function TMainForm.GetConfigSummary: String;
var
sessionConfig: TSessionConfig;
transportConfig: TTransportConfig;
begin
// Initialize the result.
Result := 'Unknown configuration';
// Obtain access to the session configuration group.
sessionConfig := FCurrentConfig.Groups[TSessionConfig.GROUP_NAME]
as TSessionConfig;
// Obtain access to the transport configuration group.
transportConfig := FCurrentConfig.Groups[TTransportConfig.GROUP_NAME]
as TTransportConfig;
// Filter on the configured session protocol.
if sessionConfig.Session = 'xcp' then
begin
Result := 'for OpenBLT using XCP ';
if transportConfig.Transport = 'xcp_rs232' then
begin
Result := Result + 'on RS232';
end
else if transportConfig.Transport = 'xcp_can' then
begin
Result := Result + 'on CAN';
end
else if transportConfig.Transport = 'xcp_usb' then
begin
Result := Result + 'on USB';
end
else if transportConfig.Transport = 'xcp_net' then
begin
Result := Result + 'on TCP/IP';
end;
end;
end; //*** end of GetConfigSummary ***
//***************************************************************************************
// NAME: BtnExitClick
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Event handler that gets called when the button is clicked.
//
//***************************************************************************************
procedure TMainForm.BtnExitClick(Sender: TObject);
begin
if BtnExit.Caption = 'Exit' then
begin
// Exit the program.
Close;
end
else
begin
// Cancel the firmware update.
CancelFirmwareUpdate;
end;
end; //*** end of BtnExitClick ***
//***************************************************************************************
// NAME: BtnBrowseClick
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Event handler that gets called when the button is clicked.
//
//***************************************************************************************
procedure TMainForm.BtnBrowseClick(Sender: TObject);
begin
// Reset firmware file name.
FFirmwareFile := '';
// Display the dialog to prompt the user to pick a file.
if OpenDialog.Execute then
begin
// Read out the selected file.
FFirmwareFile := OpenDialog.FileName;
// Start the actual firmware update.
StartFirmwareUpdate;
end;
end; //*** end of BtnBrowseClick ***
//***************************************************************************************
// NAME: BtnSettingsClick
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Event handler that gets called when the button is clicked.
//
//***************************************************************************************
procedure TMainForm.BtnSettingsClick(Sender: TObject);
var
settingsDialog: TSettingsForm;
begin
// Create the dialog and make us the owner.
settingsDialog := TSettingsForm.Create(Self, FCurrentConfig);
// Show the dialog in the modal state.
if settingsDialog.ShowModal = mrOK then
begin
// Save the new settings to the file.
FCurrentConfig.SaveToFile;
// Update the program configuration label.
LblProgramConfig.Caption := GetConfigSummary;
end;
// Release the dialog.
settingsDialog.Free;
end; //*** end of BtnSettingsClick ***
end.
//******************************** end of mainunit.pas **********************************

69
Host/Source/MicroBoot/miscellaneousdialog.lfm Normal file
View File

@ -0,0 +1,69 @@
object MiscellaneousForm: TMiscellaneousForm
Left = 1305
Height = 308
Top = 322
Width = 407
Caption = 'Miscellaneous Settings'
ClientHeight = 308
ClientWidth = 407
OnCreate = FormCreate
OnDestroy = FormDestroy
LCLVersion = '1.6.2.0'
object LblLogging: TLabel
Left = 8
Height = 17
Top = 8
Width = 50
Caption = 'Logging'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
object CbxLogging: TCheckBox
Left = 23
Height = 23
Hint = 'Check this box to generate a log-file during a firmware update'
Top = 35
Width = 128
Caption = 'Enable file logging'
OnChange = CbxLoggingChange
ParentShowHint = False
ShowHint = True
TabOrder = 0
end
object EdtLogFile: TEdit
Left = 48
Height = 29
Hint = 'Specify the name and location of the log-file to write to'
Top = 93
Width = 256
ParentShowHint = False
ShowHint = True
TabOrder = 1
Text = 'EdtLogFile'
end
object BtnLogFile: TButton
Left = 312
Height = 28
Top = 93
Width = 83
Caption = 'Browse..'
OnClick = BtnLogFileClick
TabOrder = 2
end
object LblLogFile: TLabel
Left = 48
Height = 17
Top = 69
Width = 150
Caption = 'Log-file name and location:'
ParentColor = False
end
object SaveDialog: TSaveDialog
Title = 'Log-file selection'
DefaultExt = '.*.log'
Filter = 'Log files (*.log)|*.log|All files (*.*)|*.*'
left = 340
top = 32
end
end

229
Host/Source/MicroBoot/miscellaneousdialog.pas Normal file
View File

@ -0,0 +1,229 @@
unit MiscellaneousDialog;
//***************************************************************************************
// Description: Implements the miscellaneous settings dialog.
// File Name: miscellaneousdialog.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2018 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.
//
//***************************************************************************************
{$IFDEF FPC}
{$MODE objfpc}{$H+}
{$ENDIF}
interface
//***************************************************************************************
// Includes
//***************************************************************************************
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, StrUtils,
ConfigGroups;
//***************************************************************************************
// Type Definitions
//***************************************************************************************
type
//------------------------------ TMiscellaneousForm -----------------------------------
{ TMiscellaneousForm }
TMiscellaneousForm = class(TForm)
BtnLogFile: TButton;
CbxLogging: TCheckBox;
EdtLogFile: TEdit;
LblLogFile: TLabel;
LblLogging: TLabel;
SaveDialog: TSaveDialog;
procedure BtnLogFileClick(Sender: TObject);
procedure CbxLoggingChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FMiscellaneousConfig: TMiscellaneousConfig;
procedure UpdateUserInterface;
public
procedure LoadConfig(Config: TMiscellaneousConfig);
procedure SaveConfig(Config: TMiscellaneousConfig);
end;
implementation
{$R *.lfm}
//---------------------------------------------------------------------------------------
//-------------------------------- TMiscellaneousForm -----------------------------------
//---------------------------------------------------------------------------------------
//***************************************************************************************
// NAME: FormCreate
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Form constructor.
//
//***************************************************************************************
procedure TMiscellaneousForm.FormCreate(Sender: TObject);
begin
// Create configuration group instance.
FMiscellaneousConfig := TMiscellaneousConfig.Create;
// Align browse button vertically to the related edit box.
BtnLogFile.Top := EdtLogFile.Top;
BtnLogFile.Height := EdtLogFile.Height + 1;
// Empty the log-file edit box.
EdtLogFile.Text := '';
end; //*** end of FormCreate ***
//***************************************************************************************
// NAME: CbxLoggingChange
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Event handler that gets called when the checkbox changes.
//
//***************************************************************************************
procedure TMiscellaneousForm.CbxLoggingChange(Sender: TObject);
begin
// Update the user interface.
UpdateUserInterface;
end; //*** end of CbxLoggingChange ***
//***************************************************************************************
// NAME: BtnLogFileClick
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Event handler that gets called when the button is clicked.
//
//***************************************************************************************
procedure TMiscellaneousForm.BtnLogFileClick(Sender: TObject);
var
initialDir: String;
logFile: String;
begin
// If a file is already specified in the associated edit box, then use that directory.
// Otherwise use the program's current working directory as the initial directory.
initialDir := GetCurrentDir;
if EdtLogFile.Text <> '' then
begin
if DirectoryExists(ExtractFileDir(EdtLogFile.Text)) then
initialDir := ExtractFileDir(EdtLogFile.Text);
end;
SaveDialog.InitialDir := initialDir;
// Display the dialog to prompt the user to pick a file.
if SaveDialog.Execute then
begin
// Read out the selected file.
logFile := SaveDialog.FileName;
// Make it a relative path if it is in the current working directory or a
// subdirectory there of.
if AnsiStartsText(GetCurrentDir, logFile) then
begin
logFile := ExtractRelativepath(GetCurrentDir + PathDelim,
ExtractFilePath(logFile)) + ExtractFileName(logFile);
end;
// Set the filename in the associated edit box.
EdtLogFile.Text := logFile;
end;
end; //*** end of BtnLogFileClick ***
//***************************************************************************************
// NAME: FormDestroy
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Form destructor.
//
//***************************************************************************************
procedure TMiscellaneousForm.FormDestroy(Sender: TObject);
begin
// Release the configuration group instance.
FMiscellaneousConfig.Free;
end; //*** end of FormDestroy ***
//***************************************************************************************
// NAME: UpdateUserInterface
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Refreshes the user interface.
//
//***************************************************************************************
procedure TMiscellaneousForm.UpdateUserInterface;
begin
EdtLogFile.Enabled := CbxLogging.Checked;
BtnLogFile.Enabled := CbxLogging.Checked;
end; //*** end of UpdateUserInterface ***
//***************************************************************************************
// NAME: LoadConfig
// PARAMETER: Config Configuration instance to load from.
// RETURN VALUE: none
// DESCRIPTION: Loads the configuration values from the specified instance and
// initializes the user interface accordingly.
//
//***************************************************************************************
procedure TMiscellaneousForm.LoadConfig(Config: TMiscellaneousConfig);
begin
// Load configuration.
FMiscellaneousConfig.Logging := Config.Logging;
FMiscellaneousConfig.LogFile := Config.LogFile;
// Initialize user interface.
if FMiscellaneousConfig.Logging = 0 then
CbxLogging.Checked := False
else
CbxLogging.Checked := True;
EdtLogFile.Text := FMiscellaneousConfig.LogFile;
// Update the user interface.
UpdateUserInterface;
end; //*** end of LoadConfig ***
//***************************************************************************************
// NAME: SaveConfig
// PARAMETER: Config Configuration instance to save to.
// RETURN VALUE: none
// DESCRIPTION: Reads the configuration values from the user interface and stores them
// in the specified instance.
//
//***************************************************************************************
procedure TMiscellaneousForm.SaveConfig(Config: TMiscellaneousConfig);
begin
// Start out with default configuration settings.
FMiscellaneousConfig.Defaults;
// Read configuration from the user interface.
if CbxLogging.Checked then
FMiscellaneousConfig.Logging := 1
else
FMiscellaneousConfig.Logging := 0;
FMiscellaneousConfig.LogFile := EdtLogFile.Text;
// Store configuration.
Config.Logging := FMiscellaneousConfig.Logging;
Config.LogFile := FMiscellaneousConfig.LogFile;
end; //*** end of SaveConfig ***
end.
//******************************** end of miscellaneousdialog.pas ***********************

455
Host/Source/MicroBoot/sessionxcpdialog.lfm Normal file
View File

@ -0,0 +1,455 @@
object SessionXcpForm: TSessionXcpForm
Left = 1306
Height = 308
Top = 661
Width = 407
Caption = 'XCP Session'
ClientHeight = 308
ClientWidth = 407
OnCreate = FormCreate
OnDestroy = FormDestroy
LCLVersion = '1.6.2.0'
object LblTimeouts: TLabel
Left = 8
Height = 17
Top = 160
Width = 56
Caption = 'Timeouts'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
object LblTimeoutT1: TLabel
Left = 23
Height = 17
Top = 187
Width = 45
Caption = 'T1 (ms):'
ParentColor = False
end
object EdtTimeoutT1: TEdit
Left = 80
Height = 29
Hint = 'Command response timeout in milliseconds as a 16-bit value (Default = 1000 ms)'
Top = 184
Width = 115
OnChange = EdtTimeoutChange
OnKeyPress = EdtTimeoutKeyPress
ParentShowHint = False
ShowHint = True
TabOrder = 3
end
object LblTimeoutT3: TLabel
Left = 23
Height = 17
Top = 227
Width = 45
Caption = 'T3 (ms):'
ParentColor = False
end
object EdtTimeoutT3: TEdit
Left = 80
Height = 29
Hint = 'Start programming timeout in milliseconds as a 16-bit value (Default = 2000 ms)'
Top = 224
Width = 115
OnChange = EdtTimeoutChange
OnKeyPress = EdtTimeoutKeyPress
ParentShowHint = False
ShowHint = True
TabOrder = 4
end
object LblTimeoutT4: TLabel
Left = 23
Height = 17
Top = 267
Width = 45
Caption = 'T4 (ms):'
ParentColor = False
end
object EdtTimeoutT4: TEdit
Left = 80
Height = 29
Hint = 'Erase memory timeout in milliseconds as a 16-bit value (Default = 10000 ms)'
Top = 264
Width = 115
OnChange = EdtTimeoutChange
OnKeyPress = EdtTimeoutKeyPress
ParentShowHint = False
ShowHint = True
TabOrder = 5
end
object LblTimeoutT5: TLabel
Left = 226
Height = 17
Top = 187
Width = 45
Caption = 'T5 (ms):'
ParentColor = False
end
object EdtTimeoutT5: TEdit
Left = 280
Height = 29
Hint = 'Program memory and target reset timeout in milliseconds as a 16-bit value (Default = 1000 ms)'
Top = 184
Width = 115
OnChange = EdtTimeoutChange
OnKeyPress = EdtTimeoutKeyPress
ParentShowHint = False
ShowHint = True
TabOrder = 6
end
object LblTimeoutT7: TLabel
Left = 226
Height = 17
Top = 227
Width = 45
Caption = 'T7 (ms):'
ParentColor = False
end
object EdtTimeoutT7: TEdit
Left = 280
Height = 29
Hint = 'Busy wait timer timeout in milliseconds as a 16-bit value (Default = 2000 ms)'
Top = 224
Width = 115
OnChange = EdtTimeoutChange
OnKeyPress = EdtTimeoutKeyPress
ParentShowHint = False
ShowHint = True
TabOrder = 7
end
object LblConnection: TLabel
Left = 8
Height = 17
Top = 8
Width = 68
Caption = 'Connection'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
object LblConnectMode: TLabel
Left = 23
Height = 17
Top = 38
Width = 35
Caption = 'Mode:'
ParentColor = False
end
object CmbConnectMode: TComboBox
Left = 80
Height = 27
Hint = 'Connection mode value sent in the XCP connect command as a 8-bit value (Default=0)'
Top = 35
Width = 120
ItemHeight = 0
ItemIndex = 0
Items.Strings = (
'0'
'1'
'2'
'3'
'4'
'5'
'6'
'7'
'8'
'9'
'10'
'11'
'12'
'13'
'14'
'15'
'16'
'17'
'18'
'19'
'20'
'21'
'22'
'23'
'24'
'25'
'26'
'27'
'28'
'29'
'30'
'31'
'32'
'33'
'34'
'35'
'36'
'37'
'38'
'39'
'40'
'41'
'42'
'43'
'44'
'45'
'46'
'47'
'48'
'49'
'50'
'51'
'52'
'53'
'54'
'55'
'56'
'57'
'58'
'59'
'60'
'61'
'62'
'63'
'64'
'65'
'66'
'67'
'68'
'69'
'70'
'71'
'72'
'73'
'74'
'75'
'76'
'77'
'78'
'79'
'80'
'81'
'82'
'83'
'84'
'85'
'86'
'87'
'88'
'89'
'90'
'91'
'92'
'93'
'94'
'95'
'96'
'97'
'98'
'99'
'100'
'101'
'102'
'103'
'104'
'105'
'106'
'107'
'108'
'109'
'110'
'111'
'112'
'113'
'114'
'115'
'116'
'117'
'118'
'119'
'120'
'121'
'122'
'123'
'124'
'125'
'126'
'127'
'128'
'129'
'130'
'131'
'132'
'133'
'134'
'135'
'136'
'137'
'138'
'139'
'140'
'141'
'142'
'143'
'144'
'145'
'146'
'147'
'148'
'149'
'150'
'151'
'152'
'153'
'154'
'155'
'156'
'157'
'158'
'159'
'160'
'161'
'162'
'163'
'164'
'165'
'166'
'167'
'168'
'169'
'170'
'171'
'172'
'173'
'174'
'175'
'176'
'177'
'178'
'179'
'180'
'181'
'182'
'183'
'184'
'185'
'186'
'187'
'188'
'189'
'190'
'191'
'192'
'193'
'194'
'195'
'196'
'197'
'198'
'199'
'200'
'201'
'202'
'203'
'204'
'205'
'206'
'207'
'208'
'209'
'210'
'211'
'212'
'213'
'214'
'215'
'216'
'217'
'218'
'219'
'220'
'221'
'222'
'223'
'224'
'225'
'226'
'227'
'228'
'229'
'230'
'231'
'232'
'233'
'234'
'235'
'236'
'237'
'238'
'239'
'240'
'241'
'242'
'243'
'244'
'245'
'246'
'247'
'248'
'249'
'250'
'251'
'252'
'253'
'254'
'255'
)
ParentShowHint = False
ShowHint = True
Style = csDropDownList
TabOrder = 0
Text = '0'
end
object LblSecurity: TLabel
Left = 8
Height = 17
Top = 72
Width = 49
Caption = 'Security'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
object LblSeedKey: TLabel
Left = 23
Height = 17
Top = 96
Width = 276
Caption = 'Select your seed/key algorithm shared library file:'
ParentColor = False
end
object EdtSeedKey: TEdit
Left = 23
Height = 29
Hint = 'Seed/key algorithm shared library filename (Optional)'
Top = 120
Width = 281
ParentShowHint = False
ShowHint = True
TabOrder = 1
end
object BtnSeedKey: TButton
Left = 312
Height = 28
Top = 120
Width = 83
Caption = 'Browse..'
OnClick = BtnSeedKeyClick
TabOrder = 2
end
object OpenDialog: TOpenDialog
Filter = 'Shared libraries (*.dll;*.so)|*.dll;*.so|All files (*.*)|*.*'
Options = [ofFileMustExist, ofEnableSizing, ofViewDetail]
left = 344
top = 31
end
end

266
Host/Source/MicroBoot/sessionxcpdialog.pas Normal file
View File

@ -0,0 +1,266 @@
unit SessionXcpDialog;
//***************************************************************************************
// Description: Implements the XCP session dialog.
// File Name: sessionxcpdialog.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2018 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.
//
//***************************************************************************************
{$IFDEF FPC}
{$MODE objfpc}{$H+}
{$ENDIF}
interface
//***************************************************************************************
// Includes
//***************************************************************************************
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, ConfigGroups, StrUtils, CustomUtil;
//***************************************************************************************
// Type Definitions
//***************************************************************************************
type
//------------------------------ TSessionXcpForm ----------------------------------------
TSessionXcpForm = class(TForm)
BtnSeedKey: TButton;
CmbConnectMode: TComboBox;
EdtSeedKey: TEdit;
EdtTimeoutT1: TEdit;
EdtTimeoutT3: TEdit;
EdtTimeoutT4: TEdit;
EdtTimeoutT5: TEdit;
EdtTimeoutT7: TEdit;
LblConnection: TLabel;
LblSeedKey: TLabel;
LblSecurity: TLabel;
LblTimeoutT1: TLabel;
LblTimeouts: TLabel;
LblConnectMode: TLabel;
LblTimeoutT3: TLabel;
LblTimeoutT4: TLabel;
LblTimeoutT5: TLabel;
LblTimeoutT7: TLabel;
OpenDialog: TOpenDialog;
procedure BtnSeedKeyClick(Sender: TObject);
procedure EdtTimeoutChange(Sender: TObject);
procedure EdtTimeoutKeyPress(Sender: TObject; var Key: char);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FSessionXcpConfig: TSessionXcpConfig;
public
procedure LoadConfig(Config: TSessionXcpConfig);
procedure SaveConfig(Config: TSessionXcpConfig);
end;
implementation
{$R *.lfm}
//---------------------------------------------------------------------------------------
//-------------------------------- TSessionXcpForm --------------------------------------
//---------------------------------------------------------------------------------------
//***************************************************************************************
// NAME: FormCreate
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Form constructor.
//
//***************************************************************************************
procedure TSessionXcpForm.FormCreate(Sender: TObject);
begin
// Create configuration group instance.
FSessionXcpConfig := TSessionXcpConfig.Create;
// Align browse button vertically to the related edit box.
BtnSeedKey.Top := EdtSeedKey.Top;
BtnSeedKey.Height := EdtSeedKey.Height + 1;
end; //*** end of FormCreate ***
//***************************************************************************************
// NAME: FormDestroy
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Form destructor.
//
//***************************************************************************************
procedure TSessionXcpForm.FormDestroy(Sender: TObject);
begin
// Release the configuration group instance.
FSessionXcpConfig.Free;
end; //*** end of FormDestroy ***
//***************************************************************************************
// NAME: BtnSeedKeyClick
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Event handler that gets called when the button is clicked.
//
//***************************************************************************************
procedure TSessionXcpForm.BtnSeedKeyClick(Sender: TObject);
var
initialDir: String;
sharedLibrary: String;
begin
// If a file is already specified in the associated edit box, then use that directory.
// Otherwise use the program's current working directory as the initial directory.
initialDir := GetCurrentDir;
if EdtSeedKey.Text <> '' then
begin
if DirectoryExists(ExtractFileDir(EdtSeedKey.Text)) then
initialDir := ExtractFileDir(EdtSeedKey.Text);
end;
OpenDialog.InitialDir := initialDir;
// Display the dialog to prompt the user to pick a file.
if OpenDialog.Execute then
begin
// Read out the selected file.
sharedLibrary := OpenDialog.FileName;
// Make it a relative path if it is in the current working directory or a
// subdirectory there of.
if AnsiStartsText(GetCurrentDir, sharedLibrary) then
begin
sharedLibrary := ExtractRelativepath(GetCurrentDir + PathDelim,
ExtractFilePath(sharedLibrary)) + ExtractFileName(sharedLibrary);
end;
// Set the filename in the associated edit box.
EdtSeedKey.Text := sharedLibrary;
end;
end; //*** end of BtnSeedKeyClick ***
//***************************************************************************************
// NAME: EdtTimeoutChange
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Event handler that gets called when the contents in one of the Timeout
// edit boxes changed.
//
//***************************************************************************************
procedure TSessionXcpForm.EdtTimeoutChange(Sender: TObject);
var
timeoutEdtBox: TEdit;
begin
// Make sure the event source is an instance of class TEdit.
Assert(Sender.InheritsFrom(TEdit), 'Event is triggered by an invalid sender.');
timeoutEdtBox := Sender as TEdit;
// Validate the edit box contents to make sure that it is a number within an allowed
// range.
if timeoutEdtBox.Text <> '' then
timeoutEdtBox.Text := CustomUtilValidateNumberRange(timeoutEdtBox.Text, 0, 65535)
end; //*** end of EdtTimeoutChange ***
//***************************************************************************************
// NAME: EdtTimeoutKeyPress
// PARAMETER: Sender Source of the event.
// Key Key that was pressed.
// RETURN VALUE: none
// DESCRIPTION: Event handler that gets called when a key on one or the Timeout edit
// boxes was pressed.
//
//***************************************************************************************
procedure TSessionXcpForm.EdtTimeoutKeyPress(Sender: TObject; var Key: char);
begin
// Validate the key to make sure it is a character that is part of a number.
CustomUtilValidateKeyAsInt(Key);
end; //*** end of EdtTimeoutKeyPress ***
//***************************************************************************************
// NAME: LoadConfig
// PARAMETER: Config Configuration instance to load from.
// RETURN VALUE: none
// DESCRIPTION: Loads the configuration values from the specified instance and
// initializes the user interface accordingly.
//
//***************************************************************************************
procedure TSessionXcpForm.LoadConfig(Config: TSessionXcpConfig);
begin
// Load configuration.
FSessionXcpConfig.TimeoutT1 := Config.TimeoutT1;
FSessionXcpConfig.TimeoutT3 := Config.TimeoutT3;
FSessionXcpConfig.TimeoutT4 := Config.TimeoutT4;
FSessionXcpConfig.TimeoutT5 := Config.TimeoutT5;
FSessionXcpConfig.TimeoutT7 := Config.TimeoutT7;
FSessionXcpConfig.ConnectMode := Config.ConnectMode;
FSessionXcpConfig.SeedKey := Config.SeedKey;
// Initialize user interface.
CmbConnectMode.ItemIndex := FSessionXcpConfig.ConnectMode;
EdtSeedKey.Text := FSessionXcpConfig.SeedKey;
EdtTimeoutT1.Text := IntToStr(FSessionXcpConfig.TimeoutT1);
EdtTimeoutT3.Text := IntToStr(FSessionXcpConfig.TimeoutT3);
EdtTimeoutT4.Text := IntToStr(FSessionXcpConfig.TimeoutT4);
EdtTimeoutT5.Text := IntToStr(FSessionXcpConfig.TimeoutT5);
EdtTimeoutT7.Text := IntToStr(FSessionXcpConfig.TimeoutT7);
end; //*** end of LoadConfig ***
//***************************************************************************************
// NAME: SaveConfig
// PARAMETER: Config Configuration instance to save to.
// RETURN VALUE: none
// DESCRIPTION: Reads the configuration values from the user interface and stores them
// in the specified instance.
//
//***************************************************************************************
procedure TSessionXcpForm.SaveConfig(Config: TSessionXcpConfig);
begin
// Start out with default configuration settings.
FSessionXcpConfig.Defaults;
// Read configuration from the user interface.
FSessionXcpConfig.ConnectMode := CmbConnectMode.ItemIndex;
FSessionXcpConfig.SeedKey := EdtSeedKey.Text;
if EdtTimeoutT1.Text <> '' then
FSessionXcpConfig.TimeoutT1 := StrToInt(EdtTimeoutT1.Text);
if EdtTimeoutT3.Text <> '' then
FSessionXcpConfig.TimeoutT3 := StrToInt(EdtTimeoutT3.Text);
if EdtTimeoutT4.Text <> '' then
FSessionXcpConfig.TimeoutT4 := StrToInt(EdtTimeoutT4.Text);
if EdtTimeoutT5.Text <> '' then
FSessionXcpConfig.TimeoutT5 := StrToInt(EdtTimeoutT5.Text);
if EdtTimeoutT7.Text <> '' then
FSessionXcpConfig.TimeoutT7 := StrToInt(EdtTimeoutT7.Text);
// Store configuration.
Config.TimeoutT1 := FSessionXcpConfig.TimeoutT1;
Config.TimeoutT3 := FSessionXcpConfig.TimeoutT3;
Config.TimeoutT4 := FSessionXcpConfig.TimeoutT4;
Config.TimeoutT5 := FSessionXcpConfig.TimeoutT5;
Config.TimeoutT7 := FSessionXcpConfig.TimeoutT7;
Config.ConnectMode := FSessionXcpConfig.ConnectMode;
Config.SeedKey := FSessionXcpConfig.SeedKey;
end; //*** end of SaveConfig ***
end.
//******************************** end of sessionxcpdialog.pas **************************

205
Host/Source/MicroBoot/settingsdialog.lfm Normal file
View File

@ -0,0 +1,205 @@
object SettingsForm: TSettingsForm
Left = 1349
Height = 441
Top = 344
Width = 422
ActiveControl = BtnOk
BorderStyle = bsDialog
Caption = 'Settings'
ClientHeight = 441
ClientWidth = 422
KeyPreview = True
OnCreate = FormCreate
OnDestroy = FormDestroy
OnKeyPress = FormKeyPress
Position = poOwnerFormCenter
LCLVersion = '1.6.2.0'
object PnlFooter: TPanel
Left = 0
Height = 46
Top = 395
Width = 422
Align = alBottom
BevelOuter = bvNone
Caption = 'PnlFooter'
ClientHeight = 46
ClientWidth = 422
TabOrder = 1
object PnlFooterButtons: TPanel
Left = 228
Height = 46
Top = 0
Width = 194
Align = alRight
BevelOuter = bvNone
Caption = 'PnlFooterButtons'
ClientHeight = 46
ClientWidth = 194
TabOrder = 0
object BtnCancel: TButton
Left = 102
Height = 28
Top = 8
Width = 83
Caption = 'Cancel'
OnClick = BtnCancelClick
TabOrder = 1
end
object BtnOk: TButton
Left = 8
Height = 28
Top = 8
Width = 83
Caption = 'OK'
OnClick = BtnOkClick
TabOrder = 0
end
end
end
object PnlBody: TPanel
Left = 0
Height = 395
Top = 0
Width = 422
Align = alClient
BevelOuter = bvNone
Caption = 'PnlBody'
ClientHeight = 395
ClientWidth = 422
TabOrder = 0
object PageCtrlSettings: TPageControl
Left = 0
Height = 395
Top = 0
Width = 422
ActivePage = TabCommunicationInterface
Align = alClient
TabIndex = 0
TabOrder = 0
object TabCommunicationInterface: TTabSheet
Caption = 'Communication Interface'
ClientHeight = 364
ClientWidth = 412
object PnlCommunicationTop: TPanel
Left = 0
Height = 44
Top = 0
Width = 412
Align = alTop
BevelOuter = bvNone
Caption = 'PnlCommunicationTop'
ClientHeight = 44
ClientWidth = 412
TabOrder = 0
object LblInterface: TLabel
Left = 8
Height = 17
Top = 11
Width = 107
Caption = 'Interface selection:'
ParentColor = False
end
object CmbInterface: TComboBox
Left = 120
Height = 27
Hint = 'Select the communication hardware interface to use during firmware updates'
Top = 8
Width = 200
DropDownCount = 4
ItemHeight = 0
ItemIndex = 0
Items.Strings = (
'XCP on RS232'
'XCP on CAN'
'XCP on USB'
'XCP on TCP/IP'
)
OnChange = CmbInterfaceChange
ParentShowHint = False
ShowHint = True
Style = csDropDownList
TabOrder = 0
Text = 'XCP on RS232'
end
end
object PnlCommunicationBody: TPanel
Left = 0
Height = 320
Top = 44
Width = 412
Align = alClient
BevelOuter = bvNone
Caption = 'PnlCommunicationBody'
TabOrder = 1
end
end
object TabSessionProtocol: TTabSheet
Caption = 'Session Protocol'
ClientHeight = 364
ClientWidth = 412
object PnlSessionTop: TPanel
Left = 0
Height = 44
Top = 0
Width = 412
Align = alTop
BevelOuter = bvNone
Caption = 'PnlSessionTop'
ClientHeight = 44
ClientWidth = 412
TabOrder = 0
object CmbProtocol: TComboBox
Left = 120
Height = 31
Hint = 'Select the communication protocol to use during firmware updates'
Top = 8
Width = 200
DropDownCount = 4
ItemHeight = 0
Items.Strings = (
'XCP version 1.0'
)
OnChange = CmbProtocolChange
ParentShowHint = False
ShowHint = True
Style = csDropDownList
TabOrder = 0
end
object LblProtocol: TLabel
Left = 8
Height = 17
Top = 11
Width = 102
Caption = 'Protocol selection:'
ParentColor = False
end
end
object PnlSessionBody: TPanel
Left = 0
Height = 320
Top = 44
Width = 412
Align = alClient
BevelOuter = bvNone
Caption = 'PnlSessionBody'
TabOrder = 1
end
end
object TabMiscellaneous: TTabSheet
Caption = 'Miscellaneous'
ClientHeight = 364
ClientWidth = 412
object PnlMiscellaneousBody: TPanel
Left = 0
Height = 364
Top = 0
Width = 412
Align = alClient
BevelOuter = bvNone
Caption = 'PnlMiscellaneousBody'
TabOrder = 0
end
end
end
end
end

467
Host/Source/MicroBoot/settingsdialog.pas Normal file
View File

@ -0,0 +1,467 @@
unit SettingsDialog;
//***************************************************************************************
// Description: Implements the settings dialog for configuring MicroBoot.
// File Name: settingsdialog.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2018 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.
//
//***************************************************************************************
{$IFDEF FPC}
{$MODE objfpc}{$H+}
{$ENDIF}
interface
//***************************************************************************************
// Includes
//***************************************************************************************
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls, ComCtrls, CurrentConfig, ConfigGroups, SessionXcpDialog,
TransportXcpRs232Dialog, TransportXcpCanDialog, TransportXcpUsbDialog,
TransportXcpTcpIpDialog, MiscellaneousDialog;
//***************************************************************************************
// Type Definitions
//***************************************************************************************
type
//------------------------------ TSettingsForm ------------------------------------------
TSettingsForm = class(TForm)
BtnCancel: TButton;
BtnOk: TButton;
CmbProtocol: TComboBox;
CmbInterface: TComboBox;
LblProtocol: TLabel;
LblInterface: TLabel;
PageCtrlSettings: TPageControl;
PnlMiscellaneousBody: TPanel;
PnlCommunicationBody: TPanel;
PnlCommunicationTop: TPanel;
PnlSessionBody: TPanel;
PnlSessionTop: TPanel;
PnlBody: TPanel;
PnlFooterButtons: TPanel;
PnlFooter: TPanel;
TabSessionProtocol: TTabSheet;
TabCommunicationInterface: TTabSheet;
TabMiscellaneous: TTabSheet;
procedure BtnCancelClick(Sender: TObject);
procedure BtnOkClick(Sender: TObject);
procedure CmbInterfaceChange(Sender: TObject);
procedure CmbProtocolChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: char);
private
FCurrentConfig: TCurrentConfig;
FSessionConfig: TSessionConfig;
FTransportConfig: TTransportConfig;
FSessionXcpForm: TSessionXcpForm;
FTransportXcpRs232Form: TTransportXcpRs232Form;
FTransportXcpCanForm: TTransportXcpCanForm;
FTransportXcpUsbForm: TTransportXcpUsbForm;
FTransportXcpTcpIpForm: TTransportXcpTcpIpForm;
FMiscellaneousForm: TMiscellaneousForm;
procedure UpdateSessionPanel;
procedure UpdateCommunicationPanel;
public
constructor Create(TheOwner: TComponent; CurrentConfig: TCurrentConfig); reintroduce;
end;
implementation
{$R *.lfm}
//---------------------------------------------------------------------------------------
//-------------------------------- TSettingsForm ----------------------------------------
//---------------------------------------------------------------------------------------
//***************************************************************************************
// NAME: FormCreate
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Form constructor.
//
//***************************************************************************************
procedure TSettingsForm.FormCreate(Sender: TObject);
var
sessionConfig: TSessionConfig;
transportConfig: TTransportConfig;
miscellaneousConfig: TMiscellaneousConfig;
sessionXcpConfig: TSessionXcpConfig;
transportXcpRs232Config: TTransportXcpRs232Config;
transportXcpCanConfig: TTransportXcpCanConfig;
transportXcpUsbConfig: TTransportXcpUsbConfig;
transportXcpTcpIpConfig: TTransportXcpTcpIpConfig;
begin
// Clear panel captions as these are only needed as hint during design time.
PnlBody.Caption := '';
PnlFooter.Caption := '';
PnlFooterButtons.Caption := '';
PnlSessionTop.Caption := '';
PnlSessionBody.Caption := '';
PnlCommunicationTop.Caption := '';
PnlCommunicationBody.Caption := '';
PnlMiscellaneousBody.Caption := '';
// Set the active page on the page control.
PageCtrlSettings.ActivePage := TabCommunicationInterface;
// Set fixed space between labels and the related controls.
CmbProtocol.Left := LblProtocol.Left + LblProtocol.Width + 8;
CmbInterface.Left := LblInterface.Left + LblInterface.Width + 8;
// Construct the session configuration instance and initialize its settings.
FSessionConfig := TSessionConfig.Create;
sessionConfig := FCurrentConfig.Groups[TSessionConfig.GROUP_NAME] as TSessionConfig;
FSessionConfig.Session := sessionConfig.Session;
// Construct the transport configuration instance and initialize its settings.
FTransportConfig := TTransportConfig.Create;
transportConfig := FCurrentConfig.Groups[TTransportConfig.GROUP_NAME]
as TTransportConfig;
FTransportConfig.Transport := transportConfig.Transport;
// Construct all embeddable dialogs and initialize their configuration settings.
// Miscellaneous settings embeddable dialog.
FMiscellaneousForm := TMiscellaneousForm.Create(Self);
FMiscellaneousForm.Parent := PnlMiscellaneousBody;
FMiscellaneousForm.BorderStyle := bsNone;
FMiscellaneousForm.Align := alClient;
miscellaneousConfig := FCurrentConfig.Groups[TMiscellaneousConfig.GROUP_NAME]
as TMiscellaneousConfig;
FMiscellaneousForm.LoadConfig(miscellaneousConfig);
// XCP session embeddable dialog.
FSessionXcpForm := TSessionXcpForm.Create(Self);
FSessionXcpForm.Parent := PnlSessionBody;
FSessionXcpForm.BorderStyle := bsNone;
FSessionXcpForm.Align := alClient;
sessionXcpConfig := FCurrentConfig.Groups[TSessionXcpConfig.GROUP_NAME]
as TSessionXcpConfig;
FSessionXcpForm.LoadConfig(sessionXcpConfig);
// XCP on RS232 transport layer embeddable dialog.
FTransportXcpRs232Form := TTransportXcpRs232Form.Create(Self);
FTransportXcpRs232Form.Parent := PnlCommunicationBody;
FTransportXcpRs232Form.BorderStyle := bsNone;
FTransportXcpRs232Form.Align := alClient;
transportXcpRs232Config := FCurrentConfig.Groups[TTransportXcpRs232Config.GROUP_NAME]
as TTransportXcpRs232Config;
FTransportXcpRs232Form.LoadConfig(transportXcpRs232Config);
// XCP on CAN transport layer embeddable dialog.
FTransportXcpCanForm := TTransportXcpCanForm.Create(Self);
FTransportXcpCanForm.Parent := PnlCommunicationBody;
FTransportXcpCanForm.BorderStyle := bsNone;
FTransportXcpCanForm.Align := alClient;
transportXcpCanConfig := FCurrentConfig.Groups[TTransportXcpCanConfig.GROUP_NAME]
as TTransportXcpCanConfig;
FTransportXcpCanForm.LoadConfig(transportXcpCanConfig);
// XCP on USB transport layer embeddable dialog.
FTransportXcpUsbForm := TTransportXcpUsbForm.Create(Self);
FTransportXcpUsbForm.Parent := PnlCommunicationBody;
FTransportXcpUsbForm.BorderStyle := bsNone;
FTransportXcpUsbForm.Align := alClient;
transportXcpUsbConfig := FCurrentConfig.Groups[TTransportXcpUsbConfig.GROUP_NAME]
as TTransportXcpUsbConfig;
FTransportXcpUsbForm.LoadConfig(transportXcpUsbConfig);
// XCP on TCP/IP transport layer embeddable dialog.
FTransportXcpTcpIpForm := TTransportXcpTcpIpForm.Create(Self);
FTransportXcpTcpIpForm.Parent := PnlCommunicationBody;
FTransportXcpTcpIpForm.BorderStyle := bsNone;
FTransportXcpTcpIpForm.Align := alClient;
transportXcpTcpIpConfig := FCurrentConfig.Groups[TTransportXcpTcpIpConfig.GROUP_NAME]
as TTransportXcpTcpIpConfig;
FTransportXcpTcpIpForm.LoadConfig(transportXcpTcpIpConfig);
// Embed the miscellaneous setting dialog.
FMiscellaneousForm.Show;
// Embed the correct session dialog based on the currently configured session.
UpdateSessionPanel;
// Embed the correct transport dialog based on the currently configured transport
// layer.
UpdateCommunicationPanel;
end; //*** end of FormCreate ***
//***************************************************************************************
// NAME: FormDestroy
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Form destructor.
//
//***************************************************************************************
procedure TSettingsForm.FormDestroy(Sender: TObject);
begin
// Release the configuration instances.
FTransportConfig.Free;
FSessionConfig.Free;
end; //*** end of FormDestroy ***
//***************************************************************************************
// NAME: FormKeyPress
// PARAMETER: Sender Signal source.
// Key The key's character code that was pressed
// RETURN VALUE: None.
// DESCRIPTION: Called when a key is pressed.
//
//***************************************************************************************
procedure TSettingsForm.FormKeyPress(Sender: TObject; var Key: char);
begin
// Was the escape key pressed?
if Key = Char(27) then
begin
// Simulate button cancel click.
BtnCancelClick(Sender)
end
// Was the enter key pressed?
else if Key = Char(13) then
begin
if ActiveControl.Name = 'BtnCancel' then
// Simulate button cancel click.
BtnCancelClick(Sender)
else
// Simulate button ok click.
BtnOKClick(Sender);
end;
end; //*** end of FormKeyPress ***
//***************************************************************************************
// NAME: BtnOkClick
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Event handler that gets called when the button is clicked.
//
//***************************************************************************************
procedure TSettingsForm.BtnOkClick(Sender: TObject);
var
sessionConfig: TSessionConfig;
sessionXcpConfig: TSessionXcpConfig;
miscellaneousConfig: TMiscellaneousConfig;
transportConfig: TTransportConfig;
transportXcpRs232Config: TTransportXcpRs232Config;
transportXcpCanConfig: TTransportXcpCanConfig;
transportXcpUsbConfig: TTransportXcpUsbConfig;
transportXcpTcpIpConfig: TTransportXcpTcpIpConfig;
begin
// Update the session settings in current config.
sessionConfig := FCurrentConfig.Groups[TSessionConfig.GROUP_NAME] as TSessionConfig;
sessionConfig.Session := FSessionConfig.Session;
// Update the XCP session settings in current config.
sessionXcpConfig := FCurrentConfig.Groups[TSessionXcpConfig.GROUP_NAME]
as TSessionXcpConfig;
FSessionXcpForm.SaveConfig(sessionXcpConfig);
// Update the transport layer settings in current config.
transportConfig := FCurrentConfig.Groups[TTransportConfig.GROUP_NAME]
as TTransportConfig;
transportConfig.Transport := FTransportConfig.Transport;
// Update the miscellanouse settings in the current config.
miscellaneousConfig := FCurrentConfig.Groups[TMiscellaneousConfig.GROUP_NAME]
as TMiscellaneousConfig;
FMiscellaneousForm.SaveConfig(miscellaneousConfig);
// Update the XCP on RS232 transport layer settings in current config.
transportXcpRs232Config := FCurrentConfig.Groups[TTransportXcpRs232Config.GROUP_NAME]
as TTransportXcpRs232Config;
FTransportXcpRs232Form.SaveConfig(transportXcpRs232Config);
// Update the XCP on CAN transport layer settings in current config.
transportXcpCanConfig := FCurrentConfig.Groups[TTransportXcpCanConfig.GROUP_NAME]
as TTransportXcpCanConfig;
FTransportXcpCanForm.SaveConfig(transportXcpCanConfig);
// Update the XCP on USB transport layer settings in current config.
transportXcpUsbConfig := FCurrentConfig.Groups[TTransportXcpUsbConfig.GROUP_NAME]
as TTransportXcpUsbConfig;
FTransportXcpUsbForm.SaveConfig(transportXcpUsbConfig);
// Update the XCP on TCP/IP transport layer settings in current config.
transportXcpTcpIpConfig := FCurrentConfig.Groups[TTransportXcpTcpIpConfig.GROUP_NAME]
as TTransportXcpTcpIpConfig;
FTransportXcpTcpIpForm.SaveConfig(transportXcpTcpIpConfig);
// Set the modal result value, which also closes the dialog.
ModalResult := mrOK;
end; //*** end of BtnOkClick ***
//***************************************************************************************
// NAME: BtnCancelClick
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Event handler that gets called when the button is clicked.
//
//***************************************************************************************
procedure TSettingsForm.BtnCancelClick(Sender: TObject);
begin
// Set the modal result value, which also closes the dialog.
ModalResult := mrCancel;
end; //*** end of BtnCancelClick ***
//***************************************************************************************
// NAME: CmbProtocolChange
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Event handler that gets called when the selected entry in the combobox
// changed.
//
//***************************************************************************************
procedure TSettingsForm.CmbProtocolChange(Sender: TObject);
begin
// Configure the correct protocol session based on the selected combobox entry.
if CmbProtocol.Text = 'XCP version 1.0' then
begin
FSessionConfig.Session := 'xcp';
end
// Unknown protocol session
else
begin
Assert(False, 'Unknown session protocol encountered in the combobox.');
end;
// Embed the correct session dialog based on the currently configured session.
UpdateSessionPanel;
end; //*** end of CmbProtocolChange ***
//***************************************************************************************
// NAME: CmbInterfaceChange
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Event handler that gets called when the selected entry in the combobox
// changed.
//
//***************************************************************************************
procedure TSettingsForm.CmbInterfaceChange(Sender: TObject);
begin
// Configure the correct communication interface based on the selected combobox entry.
if CmbInterface.Text = 'XCP on RS232' then
begin
FTransportConfig.Transport := 'xcp_rs232';
end
else if CmbInterface.Text = 'XCP on CAN' then
begin
FTransportConfig.Transport := 'xcp_can';
end
else if CmbInterface.Text = 'XCP on USB' then
begin
FTransportConfig.Transport := 'xcp_usb';
end
else if CmbInterface.Text = 'XCP on TCP/IP' then
begin
FTransportConfig.Transport := 'xcp_net';
end
// Unknown protocol session
else
begin
Assert(False, 'Unknown communication interface encountered in the combobox.');
end;
// Embed the correct transport layer dialog based on the currently configured transport
// layer
UpdateCommunicationPanel;
end; //*** end of CmbInterfaceChange ***
//***************************************************************************************
// NAME: UpdateSessionPanel
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Embeds the correct protocol session configuration dialog.
//
//***************************************************************************************
procedure TSettingsForm.UpdateSessionPanel;
begin
// First hide all protocol session related forms.
FSessionXcpForm.Hide;
// Show the correct protocol session form.
if FSessionConfig.Session = 'xcp' then
begin
CmbProtocol.ItemIndex := 0;
FSessionXcpForm.Show;
end
// Default configuration
else
begin
CmbProtocol.ItemIndex := 0;
FSessionXcpForm.Show;
end;
end; //*** end of UpdateSessionPanel ***
//***************************************************************************************
// NAME: UpdateCommunicationPanel
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Embeds the correct communication interface configuration dialog.
//
//***************************************************************************************
procedure TSettingsForm.UpdateCommunicationPanel;
begin
// First hide all communication interface related forms.
FTransportXcpRs232Form.Hide;
FTransportXcpCanForm.Hide;
FTransportXcpUsbForm.Hide;
FTransportXcpTcpIpForm.Hide;
// Show the correct communication interface form.
if FTransportConfig.Transport = 'xcp_rs232' then
begin
CmbInterface.ItemIndex := 0;
FTransportXcpRs232Form.Show;
end
else if FTransportConfig.Transport = 'xcp_can' then
begin
CmbInterface.ItemIndex := 1;
FTransportXcpCanForm.Show;
end
else if FTransportConfig.Transport = 'xcp_usb' then
begin
CmbInterface.ItemIndex := 2;
FTransportXcpUsbForm.Show;
end
else if FTransportConfig.Transport = 'xcp_net' then
begin
CmbInterface.ItemIndex := 3;
FTransportXcpTcpIpForm.Show;
end
// Default configuration
else
begin
CmbInterface.ItemIndex := 0;
FTransportXcpRs232Form.Show;
end;
end; //*** end of UpdateCommunicationPanel ***
//***************************************************************************************
// NAME: Create
// PARAMETER: TheOwner Owner of the settings form instance.
// CurrentConfig Current configuration instance.
// RETURN VALUE: none
// DESCRIPTION: Class constructor.
//
//***************************************************************************************
constructor TSettingsForm.Create(TheOwner: TComponent; CurrentConfig: TCurrentConfig);
begin
// Call the inherited constructor.
inherited Create(TheOwner);
// Check parameters.
Assert(CurrentConfig <> nil, 'Current configuration instance cannot be null');
// Store the configuration instance.
FCurrentConfig := CurrentConfig;
end; //*** end of Create ***
end.
//******************************** end of settingsdialog.pas ****************************

332
Host/Source/MicroBoot/StopWatch.pas → Host/Source/MicroBoot/stopwatch.pas
View File

@ -1,138 +1,194 @@
unit StopWatch;
//***************************************************************************************
// Description: StopWatch timer for counting minutes and seconds
// File Name: StopWatch.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2011 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, ExtCtrls;
//***************************************************************************************
// Type Definitions
//***************************************************************************************
type
TStopWatch = class(TObject)
private
FStartTime : TDateTime;
FRunning : boolean;
public
constructor Create;
procedure Start;
procedure Stop;
function Interval : string;
end;
implementation
//***************************************************************************************
// NAME: Create
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Class constructor
//
//***************************************************************************************
constructor TStopWatch.Create;
begin
// call inherited constructor
inherited Create;
// initialize variables
FRunning := false;
end; //*** end of Create ***
//***************************************************************************************
// NAME: Start
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Starts the stopwatch timer
//
//***************************************************************************************
procedure TStopWatch.Start;
begin
// store the start time
FStartTime := Time;
// start the stopwatch
FRunning := true;
end; //*** end of Start ***
//***************************************************************************************
// NAME: Stop
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Stops the stopwatch timer
//
//***************************************************************************************
procedure TStopWatch.Stop;
begin
// stop the stopwatch
FRunning := false;
end; //*** end of Stop ***
//***************************************************************************************
// NAME: Interval
// PARAMETER: none
// RETURN VALUE: stopwatch time as string in format [min]:[sec].
// DESCRIPTION: Obtains the stopwatch time as a formatted string.
//
//***************************************************************************************
function TStopWatch.Interval : string;
var
hr : word;
min : word;
sec : word;
ms : word;
begin
// decode the elased stopwatch time
DecodeTime(Time-FStartTime, hr, min, sec, ms);
// check if stopwatch is running
if not FRunning then
begin
min := 0;
sec := 0;
end;
// update the formatted stopwatch time string
result := Format('%2.2d:%2.2d', [min, sec]);
end; //*** end of Interval ***
end.
//******************************** end of StopWatch.pas *********************************
unit StopWatch;
//***************************************************************************************
// Description: StopWatch timer for counting minutes and seconds.
// File Name: stopwatch.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2018 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.
//
//***************************************************************************************
{$IFDEF FPC}
{$MODE objfpc}{$H+}
{$ENDIF}
interface
//***************************************************************************************
// Includes
//***************************************************************************************
uses
Classes, SysUtils, ExtCtrls;
//***************************************************************************************
// Type Definitions
//***************************************************************************************
type
//------------------------------ TStopWatchUpdateEvent --------------------------------
TStopWatchUpdateEvent = procedure(Sender: TObject; Interval: String) of object;
//------------------------------ TStopWatch -------------------------------------------
TStopWatch = class(TObject)
private
FStartTime: TDateTime;
FRunning: Boolean;
FInterval: String;
FInternalTimer: TTimer;
FUpdateEvent: TStopWatchUpdateEvent;
function GetInterval: String;
procedure InternalTimerOnTimer(Sender: TObject);
public
constructor Create;
destructor Destroy; override;
procedure Start;
procedure Stop;
property Interval: String read GetInterval;
property OnUpdate: TStopWatchUpdateEvent read FUpdateEvent write FUpdateEvent;
end;
implementation
//***************************************************************************************
// NAME: Create
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Class constructor
//
//***************************************************************************************
constructor TStopWatch.Create;
begin
// Call inherited constructor.
inherited Create;
// Initialize variables.
FRunning := False;
FInterval := '';
FUpdateEvent := nil;
// Create timer instance.
FInternalTimer := TTimer.Create(nil);
// Configure the timer instance.
FInternalTimer.Enabled := False;
FInternalTimer.Interval := 100;
FInternalTimer.OnTimer := @InternalTimerOnTimer;
end; //*** end of Create ***
//***************************************************************************************
// NAME: Destroy
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Class destructor.
//
//***************************************************************************************
destructor TStopWatch.Destroy;
begin
// Stop the stopwatch.
Stop;
// Release timer instance.
FInternalTimer.Free;
// Call inherited destructor.
inherited Destroy;
end; //*** end of Destroy ***
//***************************************************************************************
// NAME: Start
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Starts the stopwatch timer
//
//***************************************************************************************
procedure TStopWatch.Start;
begin
// Store the start time.
FStartTime := Time;
// Start the stopwatch.
FRunning := True;
// Start the internal timer.
FInternalTimer.Enabled := True;
end; //*** end of Start ***
//***************************************************************************************
// NAME: Stop
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Stops the stopwatch timer
//
//***************************************************************************************
procedure TStopWatch.Stop;
begin
// Stop the internal timer.
FInternalTimer.Enabled := False;
// Stop the stopwatch.
FRunning := False;
end; //*** end of Stop ***
//***************************************************************************************
// NAME: GetInterval
// PARAMETER: none
// RETURN VALUE: Stopwatch time as string in format [min]:[sec].
// DESCRIPTION: Obtains the stopwatch time as a formatted string.
//
//***************************************************************************************
function TStopWatch.GetInterval : String;
var
hr : word;
min : word;
sec : word;
ms : word;
begin
// Decode the elased stopwatch time.
DecodeTime(Time-FStartTime, hr, min, sec, ms);
// Check if stopwatch is running.
if not FRunning then
begin
min := 0;
sec := 0;
end;
// Update the formatted stopwatch time string.
Result := Format('%2.2d:%2.2d', [min, sec]);
end; //*** end of GetInterval ***
//***************************************************************************************
// NAME: InternalTimerOnTimer
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Event handler that gets called when the timer expires.
//
//***************************************************************************************
procedure TStopWatch.InternalTimerOnTimer(Sender: TObject);
begin
// Trigger the OnUpdate method.
if Assigned(FUpdateEvent) then
begin
FUpdateEvent(Self, GetInterval);
end;
end; //*** end of InternalTimerOnTimer ***
end.
//******************************** end of stopwatch.pas *********************************

180
Host/Source/MicroBoot/transportxcpcandialog.lfm Normal file
View File

@ -0,0 +1,180 @@
object TransportXcpCanForm: TTransportXcpCanForm
Left = 1287
Height = 308
Top = 261
Width = 407
Caption = 'XCP on CAN'
ClientHeight = 308
ClientWidth = 407
OnCreate = FormCreate
OnDestroy = FormDestroy
LCLVersion = '1.6.2.0'
object LblCommunication: TLabel
Left = 8
Height = 17
Top = 8
Width = 96
Caption = 'Communication'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
object CmbDevice: TComboBox
Left = 120
Height = 31
Hint = 'Name of the CAN adapter'
Top = 35
Width = 224
ItemHeight = 0
Items.Strings = (
'Peak System PCAN-USB'
'Kvaser Leaf Light v2'
'Lawicel CANUSB'
)
ParentShowHint = False
ShowHint = True
Style = csDropDownList
TabOrder = 0
end
object LblDevice: TLabel
Left = 24
Height = 17
Top = 38
Width = 41
Caption = 'Device:'
ParentColor = False
end
object CmbChannel: TComboBox
Left = 120
Height = 31
Hint = 'Zero based index of the CAN channel, if multiple CAN channels are supported for the CAN adapter'
Top = 75
Width = 224
ItemHeight = 0
Items.Strings = (
'0'
'1'
'2'
'3'
'4'
'5'
'6'
'7'
'8'
'9'
'10'
'11'
'12'
'13'
'14'
'15'
)
ParentShowHint = False
ShowHint = True
Style = csDropDownList
TabOrder = 1
end
object LblChannel: TLabel
Left = 24
Height = 17
Top = 78
Width = 49
Caption = 'Channel:'
ParentColor = False
end
object CmbBaudrate: TComboBox
Left = 120
Height = 31
Hint = 'The communication speed in bits per second'
Top = 115
Width = 224
ItemHeight = 0
Items.Strings = (
'1 MBit/sec'
'800 kBit/sec'
'500 kBit/sec'
'250 kBit/sec'
'125 kBit/sec'
'100 kBit/sec'
'50 kBit/sec'
'20 kBit/sec'
'10 kBit/sec'
)
ParentShowHint = False
ShowHint = True
Style = csDropDownList
TabOrder = 2
end
object LblBaudrate: TLabel
Left = 24
Height = 17
Top = 118
Width = 55
Caption = 'Baudrate:'
ParentColor = False
end
object LblIdentifiers: TLabel
Left = 8
Height = 17
Top = 160
Width = 63
Caption = 'Identifiers'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
object EdtTransmitId: TEdit
Left = 120
Height = 29
Hint = 'CAN identifier for transmitting XCP command messages from the host to the target, as a 32-bit hexadecimal value (Default = 667h)'
Top = 187
Width = 224
OnChange = EdtCanIdChange
OnKeyPress = EdtCanIdKeyPress
ParentShowHint = False
ShowHint = True
TabOrder = 3
Text = 'EdtTransmitId'
end
object LblTransmitId: TLabel
Left = 24
Height = 17
Top = 190
Width = 84
Caption = 'Transmit (hex):'
ParentColor = False
end
object EdtReceiveId: TEdit
Left = 120
Height = 29
Hint = 'CAN identifier for receiving XCP response messages from the target to the host, as a 32-bit hexadecimal value (Default = 7E1h)'
Top = 227
Width = 224
OnChange = EdtCanIdChange
OnKeyPress = EdtCanIdKeyPress
ParentShowHint = False
ShowHint = True
TabOrder = 4
Text = 'EdtReceiveId'
end
object LblReceiveId: TLabel
Left = 24
Height = 17
Top = 230
Width = 77
Caption = 'Receive (hex):'
ParentColor = False
end
object CbxExtended: TCheckBox
Left = 120
Height = 23
Hint = 'Check if the CAN identifiers are 29-bit extended (Default = 11-bit standard)'
Top = 267
Width = 200
Caption = '29-bit extended CAN identifiers'
OnChange = CbxExtendedChange
ParentShowHint = False
ShowHint = True
TabOrder = 5
end
end

305
Host/Source/MicroBoot/transportxcpcandialog.pas Normal file
View File

@ -0,0 +1,305 @@
unit TransportXcpCanDialog;
//***************************************************************************************
// Description: Implements the XCP on CAN transport layer dialog.
// File Name: transportxcpcandialog.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2018 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.
//
//***************************************************************************************
{$IFDEF FPC}
{$MODE objfpc}{$H+}
{$ENDIF}
interface
//***************************************************************************************
// Includes
//***************************************************************************************
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ConfigGroups, CustomUtil;
//***************************************************************************************
// Type Definitions
//***************************************************************************************
type
//------------------------------ TTransportXcpCanForm ---------------------------------
TTransportXcpCanForm = class(TForm)
CbxExtended: TCheckBox;
CmbDevice: TComboBox;
CmbChannel: TComboBox;
CmbBaudrate: TComboBox;
EdtReceiveId: TEdit;
EdtTransmitId: TEdit;
LblReceiveId: TLabel;
LblTransmitId: TLabel;
LblIdentifiers: TLabel;
LblBaudrate: TLabel;
LblChannel: TLabel;
LblDevice: TLabel;
LblCommunication: TLabel;
procedure CbxExtendedChange(Sender: TObject);
procedure EdtCanIdChange(Sender: TObject);
procedure EdtCanIdKeyPress(Sender: TObject; var Key: char);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FTransportXcpCanConfig: TTransportXcpCanConfig;
public
procedure LoadConfig(Config: TTransportXcpCanConfig);
procedure SaveConfig(Config: TTransportXcpCanConfig);
end;
implementation
{$R *.lfm}
//---------------------------------------------------------------------------------------
//-------------------------------- TTransportXcpCanForm ---------------------------------
//---------------------------------------------------------------------------------------
//***************************************************************************************
// NAME: FormCreate
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Form constructor.
//
//***************************************************************************************
procedure TTransportXcpCanForm.FormCreate(Sender: TObject);
{$IFDEF UNIX}
var
idx: Integer;
{$ENDIF}
begin
// Create configuration group instance.
FTransportXcpCanConfig := TTransportXcpCanConfig.Create;
{$IFDEF UNIX}
// By default the device combobox is a dropdown list with the possible values that are
// supported under Windows. When using a Unix-based OS it should contain different
// entries and have a standard dropdown style, such that the user could manually enter
// a device as well.
CmbDevice.Style := csDropDown;
CmbDevice.Items.Clear;
for idx := 0 to 3 do
begin
CmbDevice.Items.Add('can' + IntToStr(idx));
end;
for idx := 0 to 3 do
begin
CmbDevice.Items.Add('slcan' + IntToStr(idx));
end;
CmbDevice.ItemIndex := 0;
{$ENDIF}
end; //*** end of FormCreate ***
//***************************************************************************************
// NAME: EdtCanIdChange
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Event handler that gets called when the contents in one of the CAN
// identifier edit boxes changed.
//
//***************************************************************************************
procedure TTransportXcpCanForm.EdtCanIdChange(Sender: TObject);
var
canIdEdtBox: TEdit;
maxIdValue: Integer;
begin
// Make sure the event source is an instance of class TEdit.
Assert(Sender.InheritsFrom(TEdit), 'Event is triggered by an invalid sender.');
canIdEdtBox := Sender as TEdit;
// Validate the edit box contents to make sure that it is a number within an allowed
// range.
maxIdValue := $7FF;
if CbxExtended.Checked then
maxIdValue := $1FFFFFFF;
if canIdEdtBox.Text <> '' then
canIdEdtBox.Text := CustomUtilValidateNumberRange(canIdEdtBox.Text, 0, maxIdValue, True)
end; //*** end of EdtCanIdChange
//***************************************************************************************
// NAME: CbxExtendedChange
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Event handler that gets called when the state of the checkbox changed.
//
//***************************************************************************************
procedure TTransportXcpCanForm.CbxExtendedChange(Sender: TObject);
begin
// If it change from 29-bit to 11-bit, the currently entered values of the CAN
// identifiers might be to large. Validate and change where necessary.
EdtCanIdChange(EdtTransmitId);
EdtCanIdChange(EdtReceiveId);
end; //*** end of CbxExtendedChange ***
//***************************************************************************************
// NAME: EdtCanIdKeyPress
// PARAMETER: Sender Source of the event.
// Key Key that was pressed.
// RETURN VALUE: none
// DESCRIPTION: Event handler that gets called when a key on one or the CAN identifier
// edit boxes was pressed.
//
//***************************************************************************************
procedure TTransportXcpCanForm.EdtCanIdKeyPress(Sender: TObject; var Key: char);
begin
// Validate the key to make sure it is a character that is part of a hexadecimal
// number.
CustomUtilValidateKeyAsHex(Key);
end; //*** end of EdtCanIdKeyPress ***
//***************************************************************************************
// NAME: FormDestroy
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Form destructor.
//
//***************************************************************************************
procedure TTransportXcpCanForm.FormDestroy(Sender: TObject);
begin
// Release the configuration group instance.
FTransportXcpCanConfig.Free;
end; //*** end of FormDestroy ***
//***************************************************************************************
// NAME: LoadConfig
// PARAMETER: Config Configuration instance to load from.
// RETURN VALUE: none
// DESCRIPTION: Loads the configuration values from the specified instance and
// initializes the user interface accordingly.
//
//***************************************************************************************
procedure TTransportXcpCanForm.LoadConfig(Config: TTransportXcpCanConfig);
begin
// Load configuration.
FTransportXcpCanConfig.Device := Config.Device;
FTransportXcpCanConfig.Channel := Config.Channel;
FTransportXcpCanConfig.Baudrate := Config.Baudrate;
FTransportXcpCanConfig.TransmitId := Config.TransmitId;
FTransportXcpCanConfig.ReceiveId := Config.ReceiveId;
FTransportXcpCanConfig.ExtendedId := Config.ExtendedId;
// Initialize user interface.
{$IFDEF UNIX}
if FTransportXcpCanConfig.Device = '' then
CmbDevice.Text := CmbDevice.Items[0]
else
CmbDevice.Text := FTransportXcpCanConfig.Device;
{$ELSE}
// Match CAN device to the correct item in the combobox. Default to Peak PCAN-USB.
CmbDevice.ItemIndex := 0;
if FTransportXcpCanConfig.Device = 'kvaser_leaflight' then
CmbDevice.ItemIndex := 1
else if FTransportXcpCanConfig.Device = 'lawicel_canusb' then
CmbDevice.ItemIndex := 2;
{$ENDIF}
CmbChannel.ItemIndex := 0;
if FTransportXcpCanConfig.Channel <= LongWord(CmbChannel.Items.Count) then
CmbChannel.ItemIndex := FTransportXcpCanConfig.Channel;
case FTransportXcpCanConfig.Baudrate of
1000000: CmbBaudrate.ItemIndex := 0;
800000: CmbBaudrate.ItemIndex := 1;
500000: CmbBaudrate.ItemIndex := 2;
250000: CmbBaudrate.ItemIndex := 3;
125000: CmbBaudrate.ItemIndex := 4;
100000: CmbBaudrate.ItemIndex := 5;
50000: CmbBaudrate.ItemIndex := 6;
20000: CmbBaudrate.ItemIndex := 7;
10000: CmbBaudrate.ItemIndex := 8;
else
CmbBaudrate.ItemIndex := 2;
end;
EdtTransmitId.Text := Format('%.x', [FTransportXcpCanConfig.TransmitId]);
EdtReceiveId.Text := Format('%.x', [FTransportXcpCanConfig.ReceiveId]);
if FTransportXcpCanConfig.ExtendedId = 0 then
CbxExtended.Checked := False
else
CbxExtended.Checked := True;
end; //*** end of LoadConfig ***
//***************************************************************************************
// NAME: SaveConfig
// PARAMETER: Config Configuration instance to save to.
// RETURN VALUE: none
// DESCRIPTION: Reads the configuration values from the user interface and stores them
// in the specified instance.
//
//***************************************************************************************
procedure TTransportXcpCanForm.SaveConfig(Config: TTransportXcpCanConfig);
begin
// Start out with default configuration settings.
FTransportXcpCanConfig.Defaults;
// Read configuration from the user interface.
{$IFDEF UNIX}
FTransportXcpCanConfig.Device := CmbDevice.Text;
{$ELSE}
// Convert combobox item index to CAN device string. Default to Peak PCAN-USB.
FTransportXcpCanConfig.Device := 'peak_pcanusb';
if CmbDevice.ItemIndex = 1 then
FTransportXcpCanConfig.Device := 'kvaser_leaflight'
else if CmbDevice.ItemIndex = 2 then
FTransportXcpCanConfig.Device := 'lawicel_canusb';
{$ENDIF}
FTransportXcpCanConfig.Channel := CmbChannel.ItemIndex;
case CmbBaudrate.ItemIndex of
0: FTransportXcpCanConfig.Baudrate := 1000000;
1: FTransportXcpCanConfig.Baudrate := 800000;
2: FTransportXcpCanConfig.Baudrate := 500000;
3: FTransportXcpCanConfig.Baudrate := 250000;
4: FTransportXcpCanConfig.Baudrate := 125000;
5: FTransportXcpCanConfig.Baudrate := 100000;
6: FTransportXcpCanConfig.Baudrate := 50000;
7: FTransportXcpCanConfig.Baudrate := 20000;
8: FTransportXcpCanConfig.Baudrate := 10000;
else
FTransportXcpCanConfig.Baudrate := 500000;
end;
if EdtTransmitId.Text <> '' then
FTransportXcpCanConfig.TransmitId := StrToInt('$' + EdtTransmitId.Text);
if EdtReceiveId.Text <> '' then
FTransportXcpCanConfig.ReceiveId := StrToInt('$' + EdtReceiveId.Text);
if CbxExtended.Checked then
FTransportXcpCanConfig.ExtendedId := 1
else
FTransportXcpCanConfig.ExtendedId := 0;
// Store configuration.
Config.Device := FTransportXcpCanConfig.Device;
Config.Channel := FTransportXcpCanConfig.Channel;
Config.Baudrate := FTransportXcpCanConfig.Baudrate;
Config.TransmitId := FTransportXcpCanConfig.TransmitId;
Config.ReceiveId := FTransportXcpCanConfig.ReceiveId;
Config.ExtendedId := FTransportXcpCanConfig.ExtendedId;
end; //*** end of SaveConfig ***
end.
//******************************** end of transportxcpcandialog.pas *********************

78
Host/Source/MicroBoot/transportxcprs232dialog.lfm Normal file
View File

@ -0,0 +1,78 @@
object TransportXcpRs232Form: TTransportXcpRs232Form
Left = 1297
Height = 308
Top = 271
Width = 407
Caption = 'XCP on RS232'
ClientHeight = 308
ClientWidth = 407
OnCreate = FormCreate
OnDestroy = FormDestroy
LCLVersion = '1.6.2.0'
object LlbCommunication: TLabel
Left = 8
Height = 17
Top = 8
Width = 96
Caption = 'Communication'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
object CmbDevice: TComboBox
Left = 96
Height = 29
Hint = 'Name of the communication device'
Top = 35
Width = 192
ItemHeight = 0
ParentShowHint = False
ShowHint = True
TabOrder = 0
Text = 'CmbDevice'
end
object LblDevice: TLabel
Left = 24
Height = 17
Top = 38
Width = 41
Caption = 'Device:'
ParentColor = False
end
object CmbBaudrate: TComboBox
Left = 96
Height = 27
Hint = 'The communication speed in bits per second, as a 32-bit value (Default = 57600)'
Top = 75
Width = 192
ItemHeight = 0
ItemIndex = 0
Items.Strings = (
'1200'
'2400'
'4800'
'9600'
'14400'
'19200'
'38400'
'56000'
'57600'
'115200'
'128000'
'256000'
)
ParentShowHint = False
ShowHint = True
Style = csDropDownList
TabOrder = 1
Text = '1200'
end
object LblBaudrate: TLabel
Left = 24
Height = 17
Top = 78
Width = 55
Caption = 'Baudrate:'
ParentColor = False
end
end

183
Host/Source/MicroBoot/transportxcprs232dialog.pas Normal file
View File

@ -0,0 +1,183 @@
unit TransportXcpRs232Dialog;
//***************************************************************************************
// Description: Implements the XCP on RS232 transport layer dialog.
// File Name: transportxcprs232dialog.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2018 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.
//
//***************************************************************************************
{$IFDEF FPC}
{$MODE objfpc}{$H+}
{$ENDIF}
interface
//***************************************************************************************
// Includes
//***************************************************************************************
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ConfigGroups;
//***************************************************************************************
// Type Definitions
//***************************************************************************************
type
//------------------------------ TTransportXcpRs232Form -------------------------------
TTransportXcpRs232Form = class(TForm)
CmbDevice: TComboBox;
CmbBaudrate: TComboBox;
LblBaudrate: TLabel;
LblDevice: TLabel;
LlbCommunication: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FTransportXcpRs232Config: TTransportXcpRs232Config;
public
procedure LoadConfig(Config: TTransportXcpRs232Config);
procedure SaveConfig(Config: TTransportXcpRs232Config);
end;
implementation
{$R *.lfm}
//---------------------------------------------------------------------------------------
//-------------------------------- TTransportXcpRs232Form -------------------------------
//---------------------------------------------------------------------------------------
//***************************************************************************************
// NAME: FormCreate
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Form constructor.
//
//***************************************************************************************
procedure TTransportXcpRs232Form.FormCreate(Sender: TObject);
var
portIdx: Integer;
begin
// Create configuration group instance.
FTransportXcpRs232Config := TTransportXcpRs232Config.Create;
// Populate the device combobox with platform specific items.
CmbDevice.Items.Clear;
{$IFDEF UNIX}
for portIdx := 0 to 3 do
begin
CmbDevice.Items.Add('/dev/ttyUSB' + IntToStr(portIdx));
end;
for portIdx := 0 to 3 do
begin
CmbDevice.Items.Add('/dev/ttyACM' + IntToStr(portIdx));
end;
for portIdx := 0 to 7 do
begin
CmbDevice.Items.Add('/dev/ttyS' + IntToStr(portIdx));
end;
{$ELSE}
for portIdx := 1 to 16 do
begin
CmbDevice.Items.Add('COM' + IntToStr(portIdx));
end;
{$ENDIF}
CmbDevice.ItemIndex := 0;
end; //*** end of FormCreate ***
//***************************************************************************************
// NAME: FormDestroy
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Form destructor.
//
//***************************************************************************************
procedure TTransportXcpRs232Form.FormDestroy(Sender: TObject);
begin
// Release the configuration group instance.
FTransportXcpRs232Config.Free;
end; //*** end of FormDestroy ***
//***************************************************************************************
// NAME: LoadConfig
// PARAMETER: Config Configuration instance to load from.
// RETURN VALUE: none
// DESCRIPTION: Loads the configuration values from the specified instance and
// initializes the user interface accordingly.
//
//***************************************************************************************
procedure TTransportXcpRs232Form.LoadConfig(Config: TTransportXcpRs232Config);
var
baudIdx: Integer;
begin
// Load configuration.
FTransportXcpRs232Config.Device := Config.Device;
FTransportXcpRs232Config.Baudrate := Config.Baudrate;
// Initialize user interface.
if FTransportXcpRs232Config.Device = '' then
CmbDevice.Text := CmbDevice.Items[0]
else
CmbDevice.Text := FTransportXcpRs232Config.Device;
CmbBaudrate.ItemIndex := 0;
for baudIdx := 0 to (CmbDevice.Items.Count - 1) do
begin
// Is this combobox entry the currently configured value?
if StrToInt(CmbBaudrate.Items[baudIdx]) = FTransportXcpRs232Config.Baudrate then
begin
// Select this item in the combobox.
CmbBaudrate.ItemIndex := baudIdx;
// Match found so no need to continue looping.
Break;
end;
end;
end; //*** end of LoadConfig ***
//***************************************************************************************
// NAME: SaveConfig
// PARAMETER: Config Configuration instance to save to.
// RETURN VALUE: none
// DESCRIPTION: Reads the configuration values from the user interface and stores them
// in the specified instance.
//
//***************************************************************************************
procedure TTransportXcpRs232Form.SaveConfig(Config: TTransportXcpRs232Config);
begin
// Start out with default configuration settings.
FTransportXcpRs232Config.Defaults;
// Read configuration from the user interface.
FTransportXcpRs232Config.Device := CmbDevice.Text;
FTransportXcpRs232Config.Baudrate := StrToInt(CmbBaudrate.Text);
// Store configuration.
Config.Device := FTransportXcpRs232Config.Device;
Config.Baudrate := FTransportXcpRs232Config.Baudrate;
end; //*** end of SaveConfig ***
end.
//******************************** end of transportxcprs232dialog.pas *******************

62
Host/Source/MicroBoot/transportxcptcpipdialog.lfm Normal file
View File

@ -0,0 +1,62 @@
object TransportXcpTcpIpForm: TTransportXcpTcpIpForm
Left = 1279
Height = 308
Top = 273
Width = 407
Caption = 'XCP on TCP/IP'
ClientHeight = 308
ClientWidth = 407
OnCreate = FormCreate
OnDestroy = FormDestroy
LCLVersion = '1.6.2.0'
object LblCommunication: TLabel
Left = 8
Height = 17
Top = 8
Width = 96
Caption = 'Communication'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
object EdtAddress: TEdit
Left = 88
Height = 29
Hint = 'The IP address or hostname of the target to connect to. For example 192.168.178.23 or mydevice.mydomain.com'
Top = 35
Width = 288
ParentShowHint = False
ShowHint = True
TabOrder = 0
Text = 'EdtAddress'
end
object EdtPort: TEdit
Left = 88
Height = 29
Hint = 'The TCP port number to use, as a 16-bit value (Default = 1000)'
Top = 75
Width = 144
OnChange = EdtPortChange
OnKeyPress = EdtPortKeyPress
ParentShowHint = False
ShowHint = True
TabOrder = 1
Text = 'EdtPort'
end
object LblAddress: TLabel
Left = 24
Height = 17
Top = 38
Width = 49
Caption = 'Address:'
ParentColor = False
end
object LblPort: TLabel
Left = 24
Height = 17
Top = 78
Width = 26
Caption = 'Port:'
ParentColor = False
end
end

185
Host/Source/MicroBoot/transportxcptcpipdialog.pas Normal file
View File

@ -0,0 +1,185 @@
unit TransportXcpTcpIpDialog;
//***************************************************************************************
// Description: Implements the XCP on TCP/IP transport layer dialog.
// File Name: transportxcptcpipdialog.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2018 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.
//
//***************************************************************************************
{$IFDEF FPC}
{$MODE objfpc}{$H+}
{$ENDIF}
interface
//***************************************************************************************
// Includes
//***************************************************************************************
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ConfigGroups, CustomUtil;
//***************************************************************************************
// Type Definitions
//***************************************************************************************
type
//------------------------------ TTransportXcpTcpIpForm -------------------------------
TTransportXcpTcpIpForm = class(TForm)
EdtPort: TEdit;
EdtAddress: TEdit;
LblPort: TLabel;
LblAddress: TLabel;
LblCommunication: TLabel;
procedure EdtPortChange(Sender: TObject);
procedure EdtPortKeyPress(Sender: TObject; var Key: char);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FTransportXcpTcpIpConfig: TTransportXcpTcpIpConfig;
public
procedure LoadConfig(Config: TTransportXcpTcpIpConfig);
procedure SaveConfig(Config: TTransportXcpTcpIpConfig);
end;
implementation
{$R *.lfm}
//---------------------------------------------------------------------------------------
//-------------------------------- TTransportXcpTcpIpForm -------------------------------
//---------------------------------------------------------------------------------------
//***************************************************************************************
// NAME: FormCreate
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Form constructor.
//
//***************************************************************************************
procedure TTransportXcpTcpIpForm.FormCreate(Sender: TObject);
begin
// Create configuration group instance.
FTransportXcpTcpIpConfig := TTransportXcpTcpIpConfig.Create;
end; //*** end of FormCreate ***
//***************************************************************************************
// NAME: EdtPortChange
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Event handler that gets called when the contents in one of the Timeout
// edit boxes changed.
//
//***************************************************************************************
procedure TTransportXcpTcpIpForm.EdtPortChange(Sender: TObject);
var
portEdtBox: TEdit;
begin
// Make sure the event source is an instance of class TEdit.
Assert(Sender.InheritsFrom(TEdit), 'Event is triggered by an invalid sender.');
portEdtBox := Sender as TEdit;
// Validate the edit box contents to make sure that it is a number within an allowed
// range.
if portEdtBox.Text <> '' then
portEdtBox.Text := CustomUtilValidateNumberRange(portEdtBox.Text, 0, 65535)
end; //*** end of EdtPortChange ***
//***************************************************************************************
// NAME: EdtPortKeyPress
// PARAMETER: Sender Source of the event.
// Key Key that was pressed.
// RETURN VALUE: none
// DESCRIPTION: Event handler that gets called when a key on one or the Timeout edit
// boxes was pressed.
//
//***************************************************************************************
procedure TTransportXcpTcpIpForm.EdtPortKeyPress(Sender: TObject; var Key: char);
begin
// Validate the key to make sure it is a character that is part of a number.
CustomUtilValidateKeyAsInt(Key);
end; //*** end of EdtPortKeyPress ***
//***************************************************************************************
// NAME: FormDestroy
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Form destructor.
//
//***************************************************************************************
procedure TTransportXcpTcpIpForm.FormDestroy(Sender: TObject);
begin
// Release the configuration group instance.
FTransportXcpTcpIpConfig.Free;
end; //*** end of FormDestroy ***
//***************************************************************************************
// NAME: LoadConfig
// PARAMETER: Config Configuration instance to load from.
// RETURN VALUE: none
// DESCRIPTION: Loads the configuration values from the specified instance and
// initializes the user interface accordingly.
//
//***************************************************************************************
procedure TTransportXcpTcpIpForm.LoadConfig(Config: TTransportXcpTcpIpConfig);
begin
// Load configuration.
FTransportXcpTcpIpConfig.Address := Config.Address;
FTransportXcpTcpIpConfig.Port := Config.Port;
// Initialize user interface.
if FTransportXcpTcpIpConfig.Address = '' then
EdtAddress.Text := '192.168.178.23'
else
EdtAddress.Text := FTransportXcpTcpIpConfig.Address;
EdtPort.Text := IntToStr(FTransportXcpTcpIpConfig.Port);
end; //*** end of LoadConfig ***
//***************************************************************************************
// NAME: SaveConfig
// PARAMETER: Config Configuration instance to save to.
// RETURN VALUE: none
// DESCRIPTION: Reads the configuration values from the user interface and stores them
// in the specified instance.
//
//***************************************************************************************
procedure TTransportXcpTcpIpForm.SaveConfig(Config: TTransportXcpTcpIpConfig);
begin
// Start out with default configuration settings.
FTransportXcpTcpIpConfig.Defaults;
// Read configuration from the user interface.
FTransportXcpTcpIpConfig.Address := EdtAddress.Text;
FTransportXcpTcpIpConfig.Port := StrToInt(EdtPort.Text);
// Store configuration.
Config.Address := FTransportXcpTcpIpConfig.Address;
Config.Port := FTransportXcpTcpIpConfig.Port;
end; //*** end of SaveConfig ***
end.
//******************************** end of transportxcptcpipdialog.pas *******************

64
Host/Source/MicroBoot/transportxcpusbdialog.lfm Normal file
View File

@ -0,0 +1,64 @@
object TransportXcpUsbForm: TTransportXcpUsbForm
Left = 1285
Height = 308
Top = 253
Width = 407
Caption = 'XCP on USB'
ClientHeight = 308
ClientWidth = 407
OnCreate = FormCreate
OnDestroy = FormDestroy
LCLVersion = '1.6.4.0'
object LblCommunication: TLabel
Left = 8
Height = 15
Top = 8
Width = 87
Caption = 'Communication'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
object EdtVID: TEdit
Left = 128
Height = 23
Hint = 'The vendor identifier of the USB device (read only)'
Top = 35
Width = 168
Enabled = False
ParentShowHint = False
ReadOnly = True
ShowHint = True
TabOrder = 0
Text = '1D50'
end
object EdtPID: TEdit
Left = 128
Height = 23
Hint = 'The product identifier of the USB device (read only)'
Top = 75
Width = 168
Enabled = False
ParentShowHint = False
ReadOnly = True
ShowHint = True
TabOrder = 1
Text = '60AC'
end
object LblVID: TLabel
Left = 24
Height = 15
Top = 38
Width = 83
Caption = 'Vendor ID (hex):'
ParentColor = False
end
object LblPID: TLabel
Left = 24
Height = 15
Top = 78
Width = 88
Caption = 'Product ID (hex):'
ParentColor = False
end
end

137
Host/Source/MicroBoot/transportxcpusbdialog.pas Normal file
View File

@ -0,0 +1,137 @@
unit TransportXcpUsbDialog;
//***************************************************************************************
// Description: Implements the XCP on USB transport layer dialog.
// File Name: transportxcpusbdialog.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2018 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.
//
//***************************************************************************************
{$IFDEF FPC}
{$MODE objfpc}{$H+}
{$ENDIF}
interface
//***************************************************************************************
// Includes
//***************************************************************************************
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ConfigGroups;
//***************************************************************************************
// Type Definitions
//***************************************************************************************
type
//------------------------------ TTransportXcpUsbForm ---------------------------------
TTransportXcpUsbForm = class(TForm)
EdtPID: TEdit;
EdtVID: TEdit;
LblPID: TLabel;
LblVID: TLabel;
LblCommunication: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FTransportXcpUsbConfig: TTransportXcpUsbConfig;
public
procedure LoadConfig(Config: TTransportXcpUsbConfig);
procedure SaveConfig(Config: TTransportXcpUsbConfig);
end;
implementation
{$R *.lfm}
//---------------------------------------------------------------------------------------
//-------------------------------- TTransportXcpUsbForm ---------------------------------
//---------------------------------------------------------------------------------------
//***************************************************************************************
// NAME: FormCreate
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Form constructor.
//
//***************************************************************************************
procedure TTransportXcpUsbForm.FormCreate(Sender: TObject);
begin
// Create configuration group instance.
FTransportXcpUsbConfig := TTransportXcpUsbConfig.Create;
end; //*** end of FormCreate ***
//***************************************************************************************
// NAME: FormDestroy
// PARAMETER: Sender Source of the event.
// RETURN VALUE: none
// DESCRIPTION: Form destructor.
//
//***************************************************************************************
procedure TTransportXcpUsbForm.FormDestroy(Sender: TObject);
begin
// Release the configuration group instance.
FTransportXcpUsbConfig.Free;
end; //*** end of FormDestroy ***
//***************************************************************************************
// NAME: LoadConfig
// PARAMETER: Config Configuration instance to load from.
// RETURN VALUE: none
// DESCRIPTION: Loads the configuration values from the specified instance and
// initializes the user interface accordingly.
//
//***************************************************************************************
procedure TTransportXcpUsbForm.LoadConfig(Config: TTransportXcpUsbConfig);
begin
// Load configuration and initilize use interface. Note that USB does not require
// any additional configuration so nothing need to be done here.
Config := Config; // Suppress compiler hint due to unused parameter.
end; //*** end of LoadConfig ***
//***************************************************************************************
// NAME: SaveConfig
// PARAMETER: Config Configuration instance to save to.
// RETURN VALUE: none
// DESCRIPTION: Reads the configuration values from the user interface and stores them
// in the specified instance.
//
//***************************************************************************************
procedure TTransportXcpUsbForm.SaveConfig(Config: TTransportXcpUsbConfig);
begin
// Start out with default configuration settings.
FTransportXcpUsbConfig.Defaults;
// Read configuration from the user interface and store the configuration. Note that
// USB does not require any additional configuration so nothing needs to be done here.
Config := Config; // Suppress compiler hint due to unused parameter.
end; //*** end of SaveConfig ***
end.
//******************************** end of transportxcpusbdialog.pas *********************

424
Host/Source/MicroBoot/uBootInterface.pas
View File

@ -1,424 +0,0 @@
unit uBootInterface;
//***************************************************************************************
// Project Name: TMicroBootInterface component for Borland Delphi
// Description: Encapsulates the MicroBoot DLL interface
// File Name: uBootInterface.pas
//
//---------------------------------------------------------------------------------------
// C O P Y R I G H T
//---------------------------------------------------------------------------------------
// Copyright (c) 2011 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;
//***************************************************************************************
// 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;
// DLL Interface Methods - modifications requires potential update of all interfaces!
type
TDllMbiInit = procedure(cbStarted: TStartedEvent; cbProgress: TProgressEvent;
cbDone: TDoneEvent; cbError: TErrorEvent;
cbLog: TLogEvent; cbInfo: TInfoEvent); stdcall;
TDllMbiStart = procedure(fileName: ShortString); stdcall;
TDllMbiStop = procedure; stdcall;
TDllMbiDeInit = procedure; stdcall;
TDllMbiName = function : ShortString; stdcall;
TDllMbiDescription = function : ShortString; stdcall;
TDllMbiVersion = function : Longword; stdcall;
TDllMbiConfigure = procedure; stdcall;
TDllMbiVInterface = function : Longword; stdcall;
// Interface Class
type
TMicroBootInterface = class(TComponent)
private
{ Private declarations }
DllMbiInit : TDllMbiInit;
DllMbiStart : TDllMbiStart;
DllMbiStop : TDllMbiStop;
DllMbiDeInit : TDllMbiDeInit;
DllMbiName : TDllMbiName;
DllMbiDescription : TDllMbiDescription;
DllMbiVersion : TDllMbiVersion;
DllMbiConfigure : TDllMbiConfigure;
DllMbiVInterface : TDllMbiVInterface;
protected
{ Protected declarations }
FLibraryFile : string;
FLibraryHandle : THandle;
FOnStarted : TStartedEvent;
FOnProgress : TProgressEvent;
FOnDone : TDoneEvent;
FOnError : TErrorEvent;
FOnLog : TLogEvent;
FOnInfo : TInfoEvent;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function Enable(libraryFile: string; evStarted: TStartedEvent;
evProgress: TProgressEvent; evDone: TDoneEvent;
evError: TErrorEvent; evLog: TLogEvent;
evInfo: TInfoEvent) : Boolean;
procedure Disable;
procedure Download(fileName: ShortString);
procedure Cancel;
function Name : ShortString;
function Description : ShortString;
function Version : Longword;
procedure Configure;
function VInterface : Longword;
published
{ Published declarations }
end;
implementation
//***************************************************************************************
// NAME: Create
// PARAMETER: AOwner : owner of the component
// RETURN VALUE: none
// DESCRIPTION: Component constructor. Calls TComponent's constructor and initializes
// the private property variables to their default values.
//
//***************************************************************************************
constructor TMicroBootInterface.Create(AOwner: TComponent);
begin
// call inherited constructor
inherited Create( AOwner );
// initialize the callback pointers
FOnStarted := nil;
FOnProgress := nil;
FOnDone := nil;
FOnError := nil;
FOnLog := nil;
FOnInfo := nil;
// initialize the properties
FLibraryFile := '';
FLibraryHandle := 0;
end; //*** end of Create ***
//***************************************************************************************
// NAME: Destroy
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Component destructor. Calls TComponent's destructor
//
//***************************************************************************************
destructor TMicroBootInterface.Destroy;
begin
if FLibraryHandle <> 0 then
begin
FreeLibrary(FLibraryHandle); // release the handle
end;
inherited Destroy; // call inherited destructor
end; //*** end of Destroy ***
//***************************************************************************************
// NAME: Enable
// PARAMETER: name of library file and pointers to the callback functions.
// RETURN VALUE: true: interface library ready, false: error occurred.
// DESCRIPTION: Used to connect the interface library to the application.
//
//***************************************************************************************
function TMicroBootInterface.Enable(libraryFile: string; evStarted: TStartedEvent;
evProgress: TProgressEvent; evDone: TDoneEvent;
evError: TErrorEvent; evLog: TLogEvent;
evInfo :TInfoEvent) : Boolean;
var
Initialized : Boolean;
begin
Initialized := True;
// first make sure the interface is disabled
Disable;
// set the library file
if (FileExists(libraryFile)) and (LowerCase(ExtractFileExt(libraryFile)) = '.dll') then
begin
FLibraryFile := libraryFile;
end;
// set the callback functions
if Assigned(evStarted) then FOnStarted := evStarted;
if Assigned(evProgress) then FOnProgress := evProgress;
if Assigned(evDone) then FOnDone := evDone;
if Assigned(evError) then FOnError := evError;
if Assigned(evLog) then FOnLog := evLog;
if Assigned(evInfo) then FOnInfo := evInfo;
// check if callback functions are configured properly
if not Assigned(FOnStarted) then Initialized := False;
if not Assigned(FOnProgress) then Initialized := False;
if not Assigned(FOnDone) then Initialized := False;
if not Assigned(FOnError) then Initialized := False;
if not Assigned(FOnLog) then Initialized := False;
if not Assigned(FOnInfo) then Initialized := False;
// check if a proper library file is configured
if FLibraryFile = '' then Initialized := False;
// only continue if everything was okay sofar
if Initialized = True then
begin
// attempt to obtain a handle to the interface library
FLibraryHandle := LoadLibrary(PChar(FLibraryFile));
if FLibraryHandle = 0 then Initialized := False;
end;
// only continue if everything was okay sofar
if Initialized = True then
begin
// attempt to obtain the function pointers from the interface library
@DllMbiInit := GetProcAddress(FLibraryHandle, 'MbiInit');
@DllMbiStart := GetProcAddress(FLibraryHandle, 'MbiStart');
@DllMbiStop := GetProcAddress(FLibraryHandle, 'MbiStop');
@DllMbiDeInit := GetProcAddress(FLibraryHandle, 'MbiDeInit');
@DllMbiName := GetProcAddress(FLibraryHandle, 'MbiName');
@DllMbiDescription := GetProcAddress(FLibraryHandle, 'MbiDescription');
@DllMbiVersion := GetProcAddress(FLibraryHandle, 'MbiVersion');
@DllMbiConfigure := GetProcAddress(FLibraryHandle, 'MbiConfigure');
@DllMbiVInterface := GetProcAddress(FLibraryHandle, 'MbiVInterface');
end;
// check if the functions were found in the interface library
if not Assigned(DllMbiInit) then Initialized := False;
if not Assigned(DllMbiStart) then Initialized := False;
if not Assigned(DllMbiStop) then Initialized := False;
if not Assigned(DllMbiDeInit) then Initialized := False;
if not Assigned(DllMbiName) then Initialized := False;
if not Assigned(DllMbiDescription) then Initialized := False;
if not Assigned(DllMbiVersion) then Initialized := False;
if not Assigned(DllMbiConfigure) then Initialized := False;
if not Assigned(DllMbiVInterface) then Initialized := False;
// only continue if everything was okay sofar
if Initialized = True then
begin
// pass callback function pointers on to the interface library
DllMbiInit(FOnStarted, FOnProgress, FOnDone, FOnError, FOnLog, FOnInfo);
end
else
begin
// error occured so make sure to reset the handle to the interface library
FLibraryHandle := 0;
end;
Result := Initialized;
end; //*** end of Enable ***
//***************************************************************************************
// NAME: Download
// PARAMETER: filename with full path
// RETURN VALUE: none
// DESCRIPTION: Requests the interface library to start the download of a file.
//
//***************************************************************************************
procedure TMicroBootInterface.Download(fileName: ShortString);
begin
// only continue with we have a valid interface library handle
if FLibraryHandle <> 0 then
begin
// pass control for file download to the library
DllMbiStart(fileName);
end;
end; //*** end of Download ***
//***************************************************************************************
// NAME: Cancel
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Cancels a possible active file download.
//
//***************************************************************************************
procedure TMicroBootInterface.Cancel;
begin
// only continue with we have a valid interface library handle
if FLibraryHandle <> 0 then
begin
DllMbiStop; // let interface library handle the stop request
end;
end; //*** end of Cancel ***
//***************************************************************************************
// NAME: Disable
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Disables the interface library.
//
//***************************************************************************************
procedure TMicroBootInterface.Disable;
begin
// only continue with we have a valid interface library handle
if FLibraryHandle <> 0 then
begin
DllMbiDeInit; // inform the dll aswell that we're disabling
FreeLibrary(FLibraryHandle); // release the handle
end;
// initialize the callback pointers
FOnStarted := nil;
FOnProgress := nil;
FOnDone := nil;
FOnError := nil;
FOnLog := nil;
FOnInfo := nil;
// initialize the properties
FLibraryFile := '';
FLibraryHandle := 0;
end; //*** end of Disable ***
//***************************************************************************************
// NAME: Name
// PARAMETER: none
// RETURN VALUE: Name of the interface library
// DESCRIPTION: Obtains the name of the interface library.
//
//***************************************************************************************
function TMicroBootInterface.Name : ShortString;
begin
// only continue with we have a valid interface library handle
if FLibraryHandle <> 0 then
begin
Result := DllMbiName; // obtain the request info from the interface
end
else
begin
Result := '';
end;
end; //*** end of Name ***
//***************************************************************************************
// NAME: Description
// PARAMETER: none
// RETURN VALUE: Description of the interface library
// DESCRIPTION: Obtains the description of the interface library.
//
//***************************************************************************************
function TMicroBootInterface.Description : ShortString;
begin
// only continue with we have a valid interface library handle
if FLibraryHandle <> 0 then
begin
Result := DllMbiDescription; // obtain the request info from the interface
end
else
begin
Result := '';
end;
end; //*** end of Description ***
//***************************************************************************************
// NAME: Version
// PARAMETER: none
// RETURN VALUE: version of the library interface
// DESCRIPTION: Obtains the version of the interface library.
//
//***************************************************************************************
function TMicroBootInterface.Version : Longword;
begin
// only continue with we have a valid interface library handle
if FLibraryHandle <> 0 then
begin
Result := DllMbiVersion; // obtain the request info from the interface
end
else
begin
Result := 0;
end;
end; //*** end of Version ***
//***************************************************************************************
// NAME: VInterface
// PARAMETER: none
// RETURN VALUE: Version of uBootInterface.pas
// DESCRIPTION: Obtains the version of the uBootInterface that is supported by the
// interface library.
//
//***************************************************************************************
function TMicroBootInterface.VInterface : Longword;
begin
// only continue with we have a valid interface library handle
if FLibraryHandle <> 0 then
begin
Result := DllMbiVInterface; // obtain the request info from the interface
end
else
begin
Result := 0;
end;
end; //*** end of Version ***
//***************************************************************************************
// NAME: Configure
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Used to request the configuration of the interface library.
//
//***************************************************************************************
procedure TMicroBootInterface.Configure;
begin
// only continue with we have a valid interface library handle
if FLibraryHandle <> 0 then
begin
DllMbiConfigure; // let interface handle the configuration request
end;
end; //*** end of Configure ***
end.
//******************************* end of uBootInterface.pas *****************************

BIN
Host/canlib32.dll
View File

Binary file not shown.

BIN
Host/openblt_can_kvaser.dll
View File

Binary file not shown.

16
Host/openblt_can_kvaser.ini
View File

@ -1,16 +0,0 @@
[can]
hardware=0
channel=0
baudrate=1
extended=0
txid=1639
rxid=2017
[xcp]
seedkey=libseednkey.dll
t1=1000
t3=2000
t4=10000
t5=1000
t7=2000
tconnect=20
connectmode=0

BIN
Host/openblt_can_lawicel.dll
View File

Binary file not shown.

16
Host/openblt_can_lawicel.ini
View File

@ -1,16 +0,0 @@
[can]
hardware=0
channel=0
baudrate=2
extended=0
txid=1639
rxid=2017
[xcp]
seedkey=libseednkey.dll
t1=1000
t3=2000
t4=10000
t5=1000
t7=2000
tconnect=20
connectmode=0

BIN
Host/openblt_can_peak.dll
View File

Binary file not shown.

16
Host/openblt_can_peak.ini
View File

@ -1,16 +0,0 @@
[can]
hardware=0
channel=0
baudrate=2
extended=0
txid=1639
rxid=2017
[xcp]
seedkey=libseednkey.dll
t1=1000
t3=2000
t4=10000
t5=1000
t7=2000
tconnect=20
connectmode=0

BIN
Host/openblt_net.dll
View File

Binary file not shown.

12
Host/openblt_net.ini
View File

@ -1,12 +0,0 @@
[net]
hostname=169.254.19.63
port=1000
[xcp]
seedkey=libseednkey.dll
t1=1000
t3=2000
t4=10000
t5=1000
t7=2000
tconnect=300
connectmode=0

BIN
Host/openblt_uart.dll
View File

Binary file not shown.

12
Host/openblt_uart.ini
View File

@ -1,12 +0,0 @@
[sci]
port=5
baudrate=8
[xcp]
seedkey=libseednkey.dll
t1=1000
t3=2000
t4=10000
t5=1000
t7=2000
tconnect=20
connectmode=0

BIN
Host/openblt_usb.dll
View File

Binary file not shown.

9
Host/openblt_usb.ini
View File

@ -1,9 +0,0 @@
[xcp]
seedkey=libseednkey.dll
t1=1000
t3=2000
t4=10000
t5=1000
t7=2000
tconnect=20
connectmode=0