diff --git a/Host/MicroBoot.exe b/Host/MicroBoot.exe
index edd2c5b5..10c40f90 100644
Binary files a/Host/MicroBoot.exe and b/Host/MicroBoot.exe differ
diff --git a/Host/PCANBasic.dll b/Host/PCANBasic.dll
deleted file mode 100644
index 4836d8a8..00000000
Binary files a/Host/PCANBasic.dll and /dev/null differ
diff --git a/Host/Source/LibOpenBLT/bindings/pascal/openblt.pas b/Host/Source/LibOpenBLT/bindings/pascal/openblt.pas
index 7d7bcd64..a99415d3 100644
--- a/Host/Source/LibOpenBLT/bindings/pascal/openblt.pas
+++ b/Host/Source/LibOpenBLT/bindings/pascal/openblt.pas
@@ -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;
diff --git a/Host/Source/MicroBoot/MainUnit.dfm b/Host/Source/MicroBoot/MainUnit.dfm
deleted file mode 100644
index 67cc037a..00000000
Binary files a/Host/Source/MicroBoot/MainUnit.dfm and /dev/null differ
diff --git a/Host/Source/MicroBoot/MainUnit.pas b/Host/Source/MicroBoot/MainUnit.pas
deleted file mode 100644
index c22e14ac..00000000
--- a/Host/Source/MicroBoot/MainUnit.pas
+++ /dev/null
@@ -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 **********************************
-
diff --git a/Host/Source/MicroBoot/MicroBoot.dproj b/Host/Source/MicroBoot/MicroBoot.dproj
deleted file mode 100644
index 039f7f0c..00000000
--- a/Host/Source/MicroBoot/MicroBoot.dproj
+++ /dev/null
@@ -1,136 +0,0 @@
-
-
- {DF84500F-F9C3-464D-AB96-10E57464FFB5}
- MicroBoot.dpr
- True
- Debug
- 1
- Application
- VCL
- 18.1
- Win32
-
-
- true
-
-
- true
- Base
- true
-
-
- true
- Base
- true
-
-
- true
- Cfg_1
- true
- true
-
-
- true
- Base
- true
-
-
- true
- Cfg_2
- true
- true
-
-
- false
- false
- false
- 1
- Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win;$(DCC_Namespace)
- 00400000
- MicroBoot
- 1
- true
- false
- ../../
- 1
- true
- 1031
- Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40;$(DCC_UsePackage)
- CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=
-
-
- $(BDS)\bin\default_app.manifest
- Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
- true
- true
- 1033
-
-
- RELEASE;$(DCC_Define)
- 0
- false
- 0
-
-
- 1033
- MicroBoot.ico
- true
- true
- true
-
-
- DEBUG;$(DCC_Define)
- false
- true
-
-
- 3
- 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=
- true
- true
- 1033
- true
- MicroBoot.ico
-
-
-
- MainSource
-
-
-
-
-
-
-
-
-
-
- Cfg_2
- Base
-
-
- Base
-
-
- Cfg_1
- Base
-
-
-
- Delphi.Personality.12
-
-
-
-
- MicroBoot.dpr
-
-
-
- True
-
-
- 12
-
-
-
-
diff --git a/Host/Source/MicroBoot/MicroBoot.lpi b/Host/Source/MicroBoot/MicroBoot.lpi
new file mode 100644
index 00000000..993ae95b
--- /dev/null
+++ b/Host/Source/MicroBoot/MicroBoot.lpi
@@ -0,0 +1,273 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Host/Source/MicroBoot/MicroBoot.dpr b/Host/Source/MicroBoot/MicroBoot.lpr
similarity index 64%
rename from Host/Source/MicroBoot/MicroBoot.dpr
rename to Host/Source/MicroBoot/MicroBoot.lpr
index e5242bf6..ada6bd47 100644
--- a/Host/Source/MicroBoot/MicroBoot.dpr
+++ b/Host/Source/MicroBoot/MicroBoot.lpr
@@ -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 *********************************
+
diff --git a/Host/Source/MicroBoot/MicroBoot.lps b/Host/Source/MicroBoot/MicroBoot.lps
new file mode 100644
index 00000000..e0d25103
--- /dev/null
+++ b/Host/Source/MicroBoot/MicroBoot.lps
@@ -0,0 +1,415 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Host/Source/MicroBoot/MicroBoot.res b/Host/Source/MicroBoot/MicroBoot.res
new file mode 100644
index 00000000..f5bff5ee
Binary files /dev/null and b/Host/Source/MicroBoot/MicroBoot.res differ
diff --git a/Host/Source/MicroBoot/SettingsUnit.dfm b/Host/Source/MicroBoot/SettingsUnit.dfm
deleted file mode 100644
index 4e0f9173..00000000
Binary files a/Host/Source/MicroBoot/SettingsUnit.dfm and /dev/null differ
diff --git a/Host/Source/MicroBoot/SettingsUnit.pas b/Host/Source/MicroBoot/SettingsUnit.pas
deleted file mode 100644
index f7d73cd4..00000000
--- a/Host/Source/MicroBoot/SettingsUnit.pas
+++ /dev/null
@@ -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 ******************************
-
diff --git a/Host/Source/MicroBoot/configgroups.pas b/Host/Source/MicroBoot/configgroups.pas
new file mode 100644
index 00000000..c7caad9f
--- /dev/null
+++ b/Host/Source/MicroBoot/configgroups.pas
@@ -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 ******************************
+
diff --git a/Host/Source/MicroBoot/currentconfig.pas b/Host/Source/MicroBoot/currentconfig.pas
new file mode 100644
index 00000000..aa27edcd
--- /dev/null
+++ b/Host/Source/MicroBoot/currentconfig.pas
@@ -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;
+
+ //------------------------------ 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 *****************************
+
diff --git a/Host/Source/MicroBoot/customutil.pas b/Host/Source/MicroBoot/customutil.pas
new file mode 100644
index 00000000..37d728a5
--- /dev/null
+++ b/Host/Source/MicroBoot/customutil.pas
@@ -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 ********************************
+
diff --git a/Host/Source/MicroBoot/filelogger.pas b/Host/Source/MicroBoot/filelogger.pas
new file mode 100644
index 00000000..cb554717
--- /dev/null
+++ b/Host/Source/MicroBoot/filelogger.pas
@@ -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 ********************************
+
diff --git a/Host/Source/MicroBoot/firmwareupdate.pas b/Host/Source/MicroBoot/firmwareupdate.pas
new file mode 100644
index 00000000..1fc30c91
--- /dev/null
+++ b/Host/Source/MicroBoot/firmwareupdate.pas
@@ -0,0 +1,1210 @@
+unit FirmwareUpdate;
+//***************************************************************************************
+// Description: Contains the classes for handling firmwware updates through LibOpenBLT.
+// File Name: firmwareupdate.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
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ cmem, // the c memory manager is on some systems much faster for multi-threading
+ {$ENDIF}{$ENDIF}
+ Classes, SysUtils, CurrentConfig, ConfigGroups, OpenBlt;
+
+
+//***************************************************************************************
+// Type Definitions
+//***************************************************************************************
+type
+ // Forward declarations
+ TFirmwareUpdate = class;
+
+ //------------------------------ TFirmwareUpdateStartedEvent --------------------------
+ TFirmwareUpdateStartedEvent = procedure(Sender: TObject) of object;
+
+ //------------------------------ TFirmwareUpdateStoppedEvent --------------------------
+ TFirmwareUpdateStoppedEvent = procedure(Sender: TObject) of object;
+
+ //------------------------------ TFirmwareUpdateDoneEvent -----------------------------
+ TFirmwareUpdateDoneEvent = procedure(Sender: TObject) of object;
+
+ //------------------------------ TFirmwareUpdateInfoEvent -----------------------------
+ TFirmwareUpdateInfoEvent = procedure(Sender: TObject; InfoString: String) of object;
+
+ //------------------------------ TFirmwareUpdateLogEvent ------------------------------
+ TFirmwareUpdateLogEvent = procedure(Sender: TObject; LogString: String) of object;
+
+ //------------------------------ TFirmwareUpdateProgressEvent -------------------------
+ TFirmwareUpdateProgressEvent = procedure(Sender: TObject; Percentage: Integer) of object;
+
+ //------------------------------ TFirmwareUpdateErrorEvent ----------------------------
+ TFirmwareUpdateErrorEvent = procedure(Sender: TObject; ErrorString: String) of object;
+
+ //------------------------------ TFirmwareUpdateState ---------------------------------
+ TFirmwareUpdateState = ( FUS_IDLE = 0,
+ FUS_INITIALIZING,
+ FUS_CONNECTING,
+ FUS_LOADING_FIRMWARE,
+ FUS_ERASING_MEMORY,
+ FUS_PROGRAMMING_MEMORY,
+ FUS_FINISHING_UP );
+
+ //------------------------------ TFirmwareUpdateThread --------------------------------
+ TFirmwareUpdateThread = class(TThread)
+ private
+ FFirmwareUpdate: TFirmwareUpdate;
+ FFirmwareFile: String;
+ FState: TFirmwareUpdateState;
+ FInfoString: String;
+ FLogString: String;
+ FErrorString: String;
+ FPercentage: Integer;
+ procedure Initialize;
+ procedure Cleanup;
+ function GetSessionProtocolName: String;
+ procedure LogSessionProtocolSettings;
+ function GetTransportLayerName: String;
+ procedure LogTransportLayerSettings;
+ procedure SynchronizeStartedEvent;
+ procedure SynchronizeStoppedEvent;
+ procedure SynchronizeDoneEvent;
+ procedure SynchronizeInfoEvent;
+ procedure SynchronizeLogEvent;
+ procedure SynchronizeProgressEvent;
+ procedure SynchronizeErrorEvent;
+ protected
+ procedure Execute; override;
+ public
+ constructor Create(CreateSuspended : Boolean; FirmwareUpdate: TFirmwareUpdate); reintroduce;
+ property FirmwareFile: String read FFirmwareFile write FFirmwareFile;
+ property State: TFirmwareUpdateState read FState write FState;
+ end;
+
+ //------------------------------ TFirmwareUpdate --------------------------------------
+ TFirmwareUpdate = class (TObject)
+ private
+ FCurrentConfig: TCurrentConfig;
+ FWorkerThread: TFirmwareUpdateThread;
+ FStartedEvent: TFirmwareUpdateStartedEvent;
+ FStoppedEvent: TFirmwareUpdateStoppedEvent;
+ FDoneEvent: TFirmwareUpdateDoneEvent;
+ FInfoEvent: TFirmwareUpdateInfoEvent;
+ FLogEvent: TFirmwareUpdateLogEvent;
+ FProgressEvent: TFirmwareUpdateProgressEvent;
+ FErrorEvent: TFirmwareUpdateErrorEvent;
+ public
+ constructor Create(CurrentConfig: TCurrentConfig); reintroduce;
+ destructor Destroy; override;
+ function Start(FirmwareFile: String): Boolean;
+ procedure Stop;
+ property OnStarted: TFirmwareUpdateStartedEvent read FStartedEvent write FStartedEvent;
+ property OnStopped: TFirmwareUpdateStoppedEvent read FStoppedEvent write FStoppedEvent;
+ property OnDone: TFirmwareUpdateDoneEvent read FDoneEvent write FDoneEvent;
+ property OnInfo: TFirmwareUpdateInfoEvent read FInfoEvent write FInfoEvent;
+ property OnLog: TFirmwareUpdateLogEvent read FLogEvent write FLogEvent;
+ property OnProgress: TFirmwareUpdateProgressEvent read FProgressEvent write FProgressEvent;
+ property OnError: TFirmwareUpdateErrorEvent read FErrorEvent write FErrorEvent;
+ end;
+
+
+implementation
+//---------------------------------------------------------------------------------------
+//-------------------------------- TFirmwareUpdate --------------------------------------
+//---------------------------------------------------------------------------------------
+//***************************************************************************************
+// NAME: Create
+// PARAMETER: CurrentConfig Current configuration instance.
+// RETURN VALUE: none
+// DESCRIPTION: Class constructor.
+//
+//***************************************************************************************
+constructor TFirmwareUpdate.Create(CurrentConfig: TCurrentConfig);
+begin
+ // Call the inherited constructor.
+ inherited Create;
+ // Check parameters.
+ Assert(CurrentConfig <> nil, 'Current configuration instance cannot be null');
+ // Store the configuration instance.
+ FCurrentConfig := CurrentConfig;
+ // Initialize fields.
+ FStartedEvent := nil;
+ FStoppedEvent := nil;
+ FDoneEvent := nil;
+ FInfoEvent := nil;
+ FLogEvent := nil;
+ FProgressEvent := nil;
+ FErrorEvent := nil;
+ FWorkerThread := nil;
+end; //*** end of Create ***
+
+
+//***************************************************************************************
+// NAME: Destroy
+// PARAMETER: none
+// RETURN VALUE: none
+// DESCRIPTION: Class destructor.
+//
+//***************************************************************************************
+destructor TFirmwareUpdate.Destroy;
+begin
+ // Check if the worker thread is instanced.
+ if Assigned(FWorkerThread) then
+ begin
+ // Set termination request for the worker thread.
+ FWorkerThread.Terminate;
+ // Wait for thread termination to complete.
+ FWorkerThread.WaitFor;
+ // Release the thread instance.
+ FWorkerThread.Free;
+ end;
+ // call inherited destructor
+ inherited Destroy;
+end; //*** end of Destroy ***
+
+
+//***************************************************************************************
+// NAME: Start
+// PARAMETER: FirmwareFile Filename and path of the firmware file with program data
+// that is to be programmed on the target using the bootloader.
+// RETURN VALUE: True if successful, False otherwise.
+// DESCRIPTION: Starts the firmware update procedure.
+//
+//***************************************************************************************
+function TFirmwareUpdate.Start(FirmwareFile: String): Boolean;
+begin
+ // Initialize the result.
+ Result := False;
+ // Check if the worker thread is terminated but not yet freed from a previous update.
+ if Assigned(FWorkerThread) then
+ begin
+ if FWorkerThread.Finished then
+ begin
+ // Free it.
+ FreeAndNil(FWorkerThread);
+ end;
+ end;
+ // Only start a firmware update if another one is not already in progress.
+ if not Assigned(FWorkerThread) then
+ begin
+ // Only start the firmware update if the specified file exists.
+ if FileExists(FirmwareFile) then
+ begin
+ // Create the worker thread in a suspended state.
+ FWorkerThread := TFirmwareUpdateThread.Create(True, Self);
+ // Only continue if the worker thread could be instanced.
+ if Assigned(FWorkerThread) then
+ begin
+ // Pass the firmware file on to the worker thread.
+ FWorkerThread.FirmwareFile := FirmwareFile;
+ // Set the initial state for the worker thread so it knows where to start.
+ FWorkerThread.State := FUS_INITIALIZING;
+ // Start the worker thread, which handles the actual firmware update.
+ FWorkerThread.Start;
+ // Update the result.
+ Result := True;
+ end;
+ end;
+ end;
+end; //*** end of Start ***
+
+
+//***************************************************************************************
+// NAME: Stop
+// PARAMETER: none
+// RETURN VALUE: none
+// DESCRIPTION: Cancel an active firmware update procedure, if any.
+//
+//***************************************************************************************
+procedure TFirmwareUpdate.Stop;
+begin
+ // No need to stop the worker thread if it is not instanced.
+ if Assigned(FWorkerThread) then
+ begin
+ // Set worker thread state to idle.
+ FWorkerThread.State := FUS_IDLE;
+ // Set termination request for the worker thread.
+ FWorkerThread.Terminate;
+ // Wait for thread termination to complete.
+ FWorkerThread.WaitFor;
+ // Release the thread instance.
+ FreeAndNil(FWorkerThread);
+ end;
+end; //*** end of Stop ***
+
+
+//---------------------------------------------------------------------------------------
+//-------------------------------- TFirmwareUpdateThread --------------------------------
+//---------------------------------------------------------------------------------------
+//***************************************************************************************
+// NAME: Create
+// PARAMETER: CreateSuspended True to suspend the thread after creation.
+// FirmwareUpdate Instance of the TFirmwareUpdate class, needed to
+// trigger its events.
+// RETURN VALUE: none
+// DESCRIPTION: Thread constructor.
+//
+//***************************************************************************************
+constructor TFirmwareUpdateThread.Create(CreateSuspended : Boolean; FirmwareUpdate: TFirmwareUpdate);
+begin
+ // Call inherited constructor.
+ inherited Create(CreateSuspended);
+ // Configure the thread to not automatically free itself upon termination.
+ FreeOnTerminate := False;
+ // Initialize fields.
+ FFirmwareUpdate := FirmwareUpdate;
+ FFirmwareFile := '';
+ FState := FUS_IDLE;
+ FInfoString := '';
+ FLogString := '';
+ FErrorString := '';
+ FPercentage := 0;
+end; //*** end of Create ***
+
+
+//***************************************************************************************
+// NAME: Execute
+// PARAMETER: none
+// RETURN VALUE: none
+// DESCRIPTION: Thread execution function.
+//
+//***************************************************************************************
+procedure TFirmwareUpdateThread.Execute;
+const
+ ERASE_SIZE_MAX = 32768;
+ PROGRAM_SIZE_MAX = 256;
+var
+ initialized: Boolean;
+ errorDetected: Boolean;
+ firmwareDataTotalSize: LongWord;
+ firmwareDataTotalSegments: LongWord;
+ firmwareDataBaseAddress: LongWord;
+ segmentIdx: LongWord;
+ segmentLen: LongWord;
+ segmentBase: LongWord;
+ segmentData: PByte;
+ eraseCurrentLen: LongWord;
+ eraseCurrentBase: LongWord;
+ eraseStillLeft: LongWord;
+ eraseProgressPct: Integer;
+ eraseProgressLen: LongWord;
+ programCurrentLen: LongWord;
+ programCurrentBase: LongWord;
+ programCurrentDataPtr: PByte;
+ programStillLeft: LongWord;
+ programProgressPct: Integer;
+ programProgressLen: LongWord;
+begin
+ // Initialize locals.
+ initialized := False;
+ // Trigger the started event.
+ Synchronize(@SynchronizeStartedEvent);
+ // Enter thread's execution loop.
+ while not Terminated do
+ begin
+ // --------------------------- Initializing -----------------------------------------
+ if FState = FUS_INITIALIZING then
+ begin
+ // Initialize error flag.
+ errorDetected := False;
+ // Update the info.
+ FInfoString := 'Starting firmware update';
+ Synchronize(@SynchronizeInfoEvent);
+ // Update the log.
+ FLogString := FInfoString;
+ Synchronize(@SynchronizeLogEvent);
+ FLogString := 'Specified firmware file: ' + FFirmwareFile;
+ Synchronize(@SynchronizeLogEvent);
+ FLogString := 'Using LibOpenBLT version ' + BltVersionGetString;
+ Synchronize(@SynchronizeLogEvent);
+ FLogString := 'Detected session protocol: ' + GetSessionProtocolName;
+ Synchronize(@SynchronizeLogEvent);
+ FLogString := 'Using session protocol settings:';
+ Synchronize(@SynchronizeLogEvent);
+ LogSessionProtocolSettings;
+ FLogString := 'Detected transport layer: ' + GetTransportLayerName;
+ Synchronize(@SynchronizeLogEvent);
+ FLogString := 'Using transport layer settings:';
+ Synchronize(@SynchronizeLogEvent);
+ LogTransportLayerSettings;
+ FLogString := 'Initializing firmware update engine';
+ Synchronize(@SynchronizeLogEvent);
+ // Initialize LibOpenBLT modules.
+ Initialize;
+ initialized := True;
+ // Transition to the next state if all is okay.
+ if not errorDetected then
+ begin
+ FState := FUS_LOADING_FIRMWARE;
+ end;
+ end
+ // --------------------------- Loading firmware data --------------------------------
+ else if FState = FUS_LOADING_FIRMWARE then
+ begin
+ // Initialize error flag.
+ errorDetected := False;
+ // Update the info.
+ FInfoString := 'Loading firmware data from file';
+ Synchronize(@SynchronizeInfoEvent);
+ // Update the log.
+ FLogString := FInfoString;
+ Synchronize(@SynchronizeLogEvent);
+ // Load firmware data from the file.
+ if BltFirmwareLoadFromFile(PAnsiChar(AnsiString(FFirmwareFile)), 0) <> BLT_RESULT_OK then
+ begin
+ // Set error flag.
+ errorDetected := True;
+ // Cancel firmware update procedure by transitioning to the idle state.
+ FState := FUS_IDLE;
+ // Update the log.
+ FLogString := 'Error occured while loading firmware data from the file';
+ Synchronize(@SynchronizeLogEvent);
+ // Trigger error.
+ FErrorString := FLogString;
+ Synchronize(@SynchronizeErrorEvent);
+ end
+ // Display information regarding the loaded firmware data.
+ else
+ begin
+ // Store the number of segments.
+ firmwareDataTotalSegments := BltFirmwareGetSegmentCount();
+ // Initialize locals.
+ firmwareDataTotalSize := 0;
+ segmentBase := 0;
+ segmentLen := 0;
+ // Loop through all segments.
+ for segmentIdx := 0 to (firmwareDataTotalSegments - 1) do
+ begin
+ // Extract segment info.
+ segmentData := BltFirmwareGetSegment(segmentIdx, segmentBase, segmentLen);
+ // Validate the segment info
+ if (segmentData = nil) or (segmentLen = 0) then
+ begin
+ // Set error flag.
+ errorDetected := True;
+ // Cancel firmware update procedure by transitioning to the idle state.
+ FState := FUS_IDLE;
+ // Update the log.
+ FLogString := 'Invalid segment encountered in the firmware data';
+ Synchronize(@SynchronizeLogEvent);
+ // Trigger error.
+ FErrorString := FLogString;
+ Synchronize(@SynchronizeErrorEvent);
+ // No need to continue looping through segments.
+ Break;
+ end
+ // Segment is valid.
+ else
+ begin
+ // Update total size.
+ firmwareDataTotalSize := firmwareDataTotalSize + segmentLen;
+ // If it is the first segment, then store the base address.
+ if segmentIdx = 0 then
+ begin
+ firmwareDataBaseAddress := segmentBase;
+ end;
+ end;
+ end;
+ // Sanity check to make sure there was actually firmware data present.
+ if not errorDetected then
+ begin
+ if firmwareDataTotalSize = 0 then
+ begin
+ // Set error flag.
+ errorDetected := True;
+ // Cancel firmware update procedure by transitioning to the idle state.
+ FState := FUS_IDLE;
+ // Update the log.
+ FLogString := 'Firmware data is empty. Cannot continue with firmware update';
+ Synchronize(@SynchronizeLogEvent);
+ // Trigger error.
+ FErrorString := FLogString;
+ Synchronize(@SynchronizeErrorEvent);
+ end;
+ end;
+ end;
+ // Display information about the loaded firmware data
+ if not errorDetected then
+ begin
+ // Update the log.
+ FLogString := ' -> Number of segments: ' + IntToStr(firmwareDataTotalSegments);
+ Synchronize(@SynchronizeLogEvent);
+ FLogString := ' -> Base memory address: ' + Format('%.8xh', [firmwareDataBaseAddress]);
+ Synchronize(@SynchronizeLogEvent);
+ FLogString := ' -> Total data size: ' + IntToStr(firmwareDataTotalSize);
+ Synchronize(@SynchronizeLogEvent);
+ end;
+ // Transition to the next state if all is okay.
+ if not errorDetected then
+ begin
+ FState := FUS_CONNECTING;
+ end;
+ end
+ // --------------------------- Connecting to target ---------------------------------
+ else if FState = FUS_CONNECTING then
+ begin
+ // Initialize error flag.
+ errorDetected := False;
+ // Update the info.
+ FInfoString := 'Connecting to the target';
+ Synchronize(@SynchronizeInfoEvent);
+ // Update the log.
+ FLogString := FInfoString;
+ Synchronize(@SynchronizeLogEvent);
+ // Attempt connection with the target.
+ if BltSessionStart() <> BLT_RESULT_OK then
+ begin
+ // Not yet successful. Request the user to reset the system if it takes too long.
+ FInfoString := 'Connecting to the target (reset your target if this takes long time)';
+ Synchronize(@SynchronizeInfoEvent);
+ // Update the log.
+ FLogString := 'First connection attempt failed';
+ Synchronize(@SynchronizeLogEvent);
+ FLogString := 'Switching to backdoor entry mode';
+ Synchronize(@SynchronizeLogEvent);
+ // Now keep retrying until successful
+ while BltSessionStart() <> BLT_RESULT_OK do
+ begin
+ // Check for thread termination request
+ if Terminated then
+ begin
+ // Set error flag to force idle mode after breaking this loop.
+ errorDetected := True;
+ // Update the log.
+ FLogString := 'Cancellation request detected, so stopping firmware update';
+ Synchronize(@SynchronizeLogEvent);
+ // Trigger the stopped event.
+ Synchronize(@SynchronizeStoppedEvent);
+ // Cancel firmware update procedure by transitioning to the idle state.
+ FState := FUS_IDLE;
+ // Stop looping.
+ Break;
+ end;
+ // Delay a bit to not starve the CPU.
+ Sleep(20);
+ end;
+ end;
+ // Transition to the next state if all is okay.
+ if not errorDetected then
+ begin
+ FState := FUS_ERASING_MEMORY;
+ end;
+ end
+ // --------------------------- Erasing memory ---------------------------------------
+ else if FState = FUS_ERASING_MEMORY then
+ begin
+ // Initialize error flag.
+ errorDetected := False;
+ // Reset progress variables
+ eraseProgressPct := 0;
+ eraseProgressLen := 0;
+ // Loop through all segments.
+ for segmentIdx := 0 to (firmwareDataTotalSegments - 1) do
+ begin
+ // Don't bother looping if an error was detected.
+ if errorDetected then
+ begin
+ Break;
+ end;
+ // Extract segment info.
+ eraseCurrentBase := 0;
+ eraseStillLeft := 0;
+ segmentData := BltFirmwareGetSegment(segmentIdx, eraseCurrentBase, eraseStillLeft);
+ // Perform erase in chunks of maximum ERASE_SIZE_MAX. Otherwise the erase
+ // operation can take a long time, which would lead to a non-responsive user
+ // interface.
+ while eraseStillLeft > 0 do
+ begin
+ // Check for cancellation request.
+ if Terminated then
+ begin
+ // Set error flag to force idle mode after breaking this loop.
+ errorDetected := True;
+ // Update the log.
+ FLogString := 'Cancellation request detected, so stopping firmware update';
+ Synchronize(@SynchronizeLogEvent);
+ // Trigger the stopped event.
+ Synchronize(@SynchronizeStoppedEvent);
+ // Cancel firmware update procedure by transitioning to the idle state.
+ FState := FUS_IDLE;
+ // Stop looping.
+ Break;
+ end;
+ // Determine chunk size.
+ eraseCurrentLen := ERASE_SIZE_MAX;
+ if eraseCurrentLen > eraseStillLeft then
+ begin
+ eraseCurrentLen := eraseStillLeft;
+ end;
+ // Update the info.
+ FInfoString := Format('Erasing %u bytes starting at %.8xh', [eraseCurrentLen, eraseCurrentBase]);
+ Synchronize(@SynchronizeInfoEvent);
+ // Update the log.
+ FLogString := FInfoString;
+ Synchronize(@SynchronizeLogEvent);
+ // Perform the erase operation.
+ if BltSessionClearMemory(eraseCurrentBase, eraseCurrentLen) <> BLT_RESULT_OK then
+ begin
+ // Set error flag.
+ errorDetected := True;
+ // Cancel firmware update procedure by transitioning to the idle state.
+ FState := FUS_IDLE;
+ // Update the log.
+ FLogString := Format('Could not erase memory at %.8xh', [eraseCurrentBase]);
+ Synchronize(@SynchronizeLogEvent);
+ // Trigger error.
+ FErrorString := FLogString;
+ Synchronize(@SynchronizeErrorEvent);
+ // Stop looping
+ Break;
+ end
+ // Erase operation was successful. Update loop variables for the next chunk.
+ else
+ begin
+ eraseStillLeft := eraseStillLeft - eraseCurrentLen;
+ eraseCurrentBase := eraseCurrentBase + eraseCurrentLen;
+ // Update erase progress
+ eraseProgressLen := eraseProgressLen + eraseCurrentLen;
+ eraseProgressPct := (Int64(eraseProgressLen) * 100) div firmwareDataTotalSize;
+ // Dedicate the first 20% of the total firmware update progress to the
+ // erase operation.
+ FPercentage := (eraseProgressPct * 20) div 100;
+ Synchronize(@SynchronizeProgressEvent);
+ end;
+ end;
+ end;
+ // Transition to the next state if all is okay.
+ if not errorDetected then
+ begin
+ FState := FUS_PROGRAMMING_MEMORY;
+ end;
+ end
+ // --------------------------- Programming memory -----------------------------------
+ else if FState = FUS_PROGRAMMING_MEMORY then
+ begin
+ // Initialize error flag.
+ errorDetected := False;
+ // Reset progress variables
+ programProgressPct := 0;
+ programProgressLen := 0;
+ // Loop through all segments.
+ for segmentIdx := 0 to (firmwareDataTotalSegments - 1) do
+ begin
+ // Don't bother looping if an error was detected.
+ if errorDetected then
+ begin
+ Break;
+ end;
+ // Extract segment info.
+ programCurrentBase := 0;
+ programStillLeft := 0;
+ programCurrentDataPtr := BltFirmwareGetSegment(segmentIdx, programCurrentBase, programStillLeft);
+ // Perform programming in chunks of maximum PROGRAM_SIZE_MAX. Otherwise the
+ // programming operation can take a long time, which would lead to a non-
+ // responsive user interface.
+ while programStillLeft > 0 do
+ begin
+ // Check for cancellation request.
+ if Terminated then
+ begin
+ // Set error flag to force idle mode after breaking this loop.
+ errorDetected := True;
+ // Update the log.
+ FLogString := 'Cancellation request detected, so stopping firmware update';
+ Synchronize(@SynchronizeLogEvent);
+ // Trigger the stopped event.
+ Synchronize(@SynchronizeStoppedEvent);
+ // Cancel firmware update procedure by transitioning to the idle state.
+ FState := FUS_IDLE;
+ // Stop looping.
+ Break;
+ end;
+ // Determine chunk size.
+ programCurrentLen := PROGRAM_SIZE_MAX;
+ if programCurrentLen > programStillLeft then
+ begin
+ programCurrentLen := programStillLeft;
+ end;
+ // Update the info.
+ FInfoString := Format('Programming %u bytes starting at %.8xh', [programCurrentLen, programCurrentBase]);
+ Synchronize(@SynchronizeInfoEvent);
+ // Update the log.
+ FLogString := FInfoString;
+ Synchronize(@SynchronizeLogEvent);
+ // Perform the programming operation.
+ if BltSessionWriteData(programCurrentBase, programCurrentLen, programCurrentDataPtr) <> BLT_RESULT_OK then
+ begin
+ // Set error flag.
+ errorDetected := True;
+ // Cancel firmware update procedure by transitioning to the idle state.
+ FState := FUS_IDLE;
+ // Update the log.
+ FLogString := Format('Could not program memory at %.8xh', [programCurrentBase]);
+ Synchronize(@SynchronizeLogEvent);
+ // Trigger error.
+ FErrorString := FLogString;
+ Synchronize(@SynchronizeErrorEvent);
+ // Stop looping
+ Break;
+ end
+ // Program operation was successful. Update loop variables for the next chunk.
+ else
+ begin
+ programStillLeft := programStillLeft - programCurrentLen;
+ programCurrentBase := programCurrentBase + programCurrentLen;
+ programCurrentDataPtr := programCurrentDataPtr + programCurrentLen;
+ // Update programming progress
+ programProgressLen := programProgressLen + programCurrentLen;
+ programProgressPct := (Int64(programProgressLen) * 100) div firmwareDataTotalSize;
+ // Dedicate the remaining 80% of the total firmware update progress to the
+ // programing operation.
+ FPercentage := 20 + ((programProgressPct * 80) div 100);
+ Synchronize(@SynchronizeProgressEvent);
+ end;
+ end;
+ end;
+ // Transition to the next state if all is okay.
+ if not errorDetected then
+ begin
+ FState := FUS_FINISHING_UP;
+ end;
+ end
+ // --------------------------- Finishing up -----------------------------------------
+ else if FState = FUS_FINISHING_UP then
+ begin
+ // Initialize error flag.
+ errorDetected := False;
+ // Update the info.
+ FInfoString := 'Finishing programming session';
+ Synchronize(@SynchronizeInfoEvent);
+ // Update the log.
+ FLogString := FInfoString;
+ Synchronize(@SynchronizeLogEvent);
+ // Stop the session
+ BltSessionStop();
+ // Update the info.
+ FInfoString := 'Firmware update completed successfully';
+ Synchronize(@SynchronizeInfoEvent);
+ // Update the log.
+ FLogString := FInfoString;
+ Synchronize(@SynchronizeLogEvent);
+ // Set the progress to 100%
+ FPercentage := 100;
+ Synchronize(@SynchronizeProgressEvent);
+ // Trigger the OnDone event
+ Synchronize(@SynchronizeDoneEvent);
+ // Transition back to the idle state.
+ FState := FUS_IDLE;
+ end
+ // --------------------------- Idle -------------------------------------------------
+ else
+ begin
+ // Idle mode means that the worker thread is all done and can be exited.
+ Break;
+ end;
+ end;
+ // Cleanup LibOpenBLT modules if initialized.
+ if initialized then
+ begin
+ FLogString := 'Cleaning up firmware update engine';
+ Synchronize(@SynchronizeLogEvent);
+ initialized := False;
+ Cleanup;
+ end;
+end; //*** end of Execute ***
+
+
+//***************************************************************************************
+// NAME: Initialize
+// PARAMETER: none
+// RETURN VALUE: none
+// DESCRIPTION: Initializes the firmware update process.
+//
+//***************************************************************************************
+procedure TFirmwareUpdateThread.Initialize;
+var
+ sessionConfig: TSessionConfig;
+ sessionXcpConfig: TSessionXcpConfig;
+ transportConfig: TTransportConfig;
+ transportXcpRs232Config: TTransportXcpRs232Config;
+ transportXcpCanConfig: TTransportXcpCanConfig;
+ transportXcpTcpIpConfig: TTransportXcpTcpIpConfig;
+ sessionType: LongWord;
+ transportType: LongWord;
+ sessionSettingsXcp: tBltSessionSettingsXcpV10;
+ transportSettingsXcpRs232: tBltTransportSettingsXcpV10Rs232;
+ transportSettingsXcpCan: tBltTransportSettingsXcpV10Can;
+ transportSettingsXcpNet: tBltTransportSettingsXcpV10Net;
+ sessionSettingsPtr: Pointer;
+ transportSettingsPtr: Pointer;
+begin
+ // Initialize locals.
+ sessionSettingsPtr := nil;
+ transportSettingsPtr := nil;
+ // Initialize the firmware data module using the S-record parser.
+ BltFirmwareInit(BLT_FIRMWARE_PARSER_SRECORD);
+ // Determine the session protocol to use and set its settings.
+ sessionConfig := FFirmwareUpdate.FCurrentConfig.Groups[TSessionConfig.GROUP_NAME]
+ as TSessionConfig;
+ // ------------------------------------ XCP version 1.0 -------------------------------
+ if sessionConfig.Session = 'xcp' then
+ begin
+ // Store the session protocol type.
+ sessionType := BLT_SESSION_XCP_V10;
+ // Obtain access to the related configuration group.
+ sessionXcpConfig := FFirmwareUpdate.FCurrentConfig.Groups[TSessionXcpConfig.GROUP_NAME]
+ as TSessionXcpConfig;
+ // Copy over the settings.
+ sessionSettingsXcp.timeoutT1 := sessionXcpConfig.TimeoutT1;
+ sessionSettingsXcp.timeoutT3 := sessionXcpConfig.TimeoutT3;
+ sessionSettingsXcp.timeoutT4 := sessionXcpConfig.TimeoutT4;
+ sessionSettingsXcp.timeoutT5 := sessionXcpConfig.TimeoutT5;
+ sessionSettingsXcp.timeoutT7 := sessionXcpConfig.TimeoutT7;
+ sessionSettingsXcp.connectMode := sessionXcpConfig.ConnectMode;
+ sessionSettingsXcp.seedKeyFile := PAnsiChar(AnsiString(sessionXcpConfig.SeedKey));
+ // Point the session settings pointer to this one.
+ sessionSettingsPtr := @sessionSettingsXcp;
+ // Determine the transport layer and its settings.
+ transportConfig := FFirmwareUpdate.FCurrentConfig.Groups[TTransportConfig.GROUP_NAME]
+ as TTransportConfig;
+ // ---------------------------------- XCP on RS232 ----------------------------------
+ if transportConfig.Transport = 'xcp_rs232' then
+ begin
+ // Store the transport layer type.
+ transportType := BLT_TRANSPORT_XCP_V10_RS232;
+ // Obtain access to the related configuration group.
+ transportXcpRs232Config := FFirmwareUpdate.FCurrentConfig.Groups[TTransportXcpRs232Config.GROUP_NAME]
+ as TTransportXcpRs232Config;
+ // Copy over the settings.
+ transportSettingsXcpRs232.portName := PAnsiChar(AnsiString(transportXcpRs232Config.Device));
+ transportSettingsXcpRs232.baudrate := transportXcpRs232Config.Baudrate;
+ // Point the transport settings pointer to this one.
+ transportSettingsPtr := @transportSettingsXcpRs232;
+ end
+ // ---------------------------------- XCP on CAN ------------------------------------
+ else if transportConfig.Transport = 'xcp_can' then
+ begin
+ // Store the transport layer type.
+ transportType := BLT_TRANSPORT_XCP_V10_CAN;
+ // Obtain access to the related configuration group.
+ transportXcpCanConfig := FFirmwareUpdate.FCurrentConfig.Groups[TTransportXcpCanConfig.GROUP_NAME]
+ as TTransportXcpCanConfig;
+ // Copy over the settings.
+ transportSettingsXcpCan.deviceName := PAnsiChar(AnsiString(transportXcpCanConfig.Device));
+ transportSettingsXcpCan.deviceChannel := transportXcpCanConfig.Channel;
+ transportSettingsXcpCan.baudrate := transportXcpCanConfig.Baudrate;
+ transportSettingsXcpCan.transmitId := transportXcpCanConfig.TransmitId;
+ transportSettingsXcpCan.receiveId := transportXcpCanConfig.ReceiveId;
+ transportSettingsXcpCan.useExtended := transportXcpCanConfig.ExtendedId;
+ // Point the transport settings pointer to this one.
+ transportSettingsPtr := @transportSettingsXcpCan;
+ end
+ // ---------------------------------- XCP on USB ------------------------------------
+ else if transportConfig.Transport = 'xcp_usb' then
+ begin
+ // Store the transport layer type.
+ transportType := BLT_TRANSPORT_XCP_V10_USB;
+ // No settings to copy over for USB.
+ end
+ // ---------------------------------- XCP on TCP/IP ---------------------------------
+ else if transportConfig.Transport = 'xcp_net' then
+ begin
+ // Store the transport layer type.
+ transportType := BLT_TRANSPORT_XCP_V10_NET;
+ // Obtain access to the related configuration group.
+ transportXcpTcpIpConfig := FFirmwareUpdate.FCurrentConfig.Groups[TTransportXcpTcpIpConfig.GROUP_NAME]
+ as TTransportXcpTcpIpConfig;
+ // Copy over the settings.
+ transportSettingsXcpNet.address := PAnsiChar(AnsiString(transportXcpTcpIpConfig.Address));
+ transportSettingsXcpNet.port := transportXcpTcpIpConfig.Port;
+ // Point the transport settings pointer to this one.
+ transportSettingsPtr := @transportSettingsXcpNet;
+ end;
+ end;
+ // Initialize the session module using the detected settings.
+ BltSessionInit(sessionType, sessionSettingsPtr, transportType, transportSettingsPtr);
+end; //*** end of Initialize ***
+
+
+//***************************************************************************************
+// NAME: Cleanup
+// PARAMETER: none
+// RETURN VALUE: none
+// DESCRIPTION: Cleans up the firmware update process.
+//
+//***************************************************************************************
+procedure TFirmwareUpdateThread.Cleanup;
+begin
+ // Terminate the session.
+ BltSessionTerminate();
+ // Terminate the firmware data module.
+ BltFirmwareTerminate();
+end; //*** end of Cleanup ***
+
+
+//***************************************************************************************
+// NAME: GetSessionProtocolName
+// PARAMETER: none
+// RETURN VALUE: Name of the configured session protocol.
+// DESCRIPTION: Obtains the name of the session protocol that will be used for the
+// firmware update.
+//
+//***************************************************************************************
+function TFirmwareUpdateThread.GetSessionProtocolName: String;
+var
+ sessionConfig: TSessionConfig;
+begin
+ // Initialize the result.
+ Result := 'Unknown session protocol';
+ // Obtain access to the related configuration group.
+ sessionConfig := FFirmwareUpdate.FCurrentConfig.Groups[TSessionConfig.GROUP_NAME]
+ as TSessionConfig;
+ // Filter on the configured session protocol.
+ if sessionConfig.Session = 'xcp' then
+ begin
+ Result := 'XCP version 1.0';
+ end;
+end; //*** end of GetSessionProtocolName ***
+
+
+//***************************************************************************************
+// NAME: LogSessionProtocolSettings
+// PARAMETER: none
+// RETURN VALUE: none
+// DESCRIPTION: Logs the settings of the session protocol that will be used for the
+// firmware update.
+//
+//***************************************************************************************
+procedure TFirmwareUpdateThread.LogSessionProtocolSettings;
+var
+ sessionConfig: TSessionConfig;
+ sessionXcpConfig: TSessionXcpConfig;
+begin
+ // Obtain access to the related configuration group.
+ sessionConfig := FFirmwareUpdate.FCurrentConfig.Groups[TSessionConfig.GROUP_NAME]
+ as TSessionConfig;
+ // Filter on the configured session protocol.
+ if sessionConfig.Session = 'xcp' then
+ begin
+ // Obtain access to the related configuration group.
+ sessionXcpConfig := FFirmwareUpdate.FCurrentConfig.Groups[TSessionXcpConfig.GROUP_NAME]
+ as TSessionXcpConfig;
+ FLogString := ' -> Timeout T1: ' + IntToStr(sessionXcpConfig.TimeoutT1) + ' ms';
+ Synchronize(@SynchronizeLogEvent);
+ FLogString := ' -> Timeout T3: ' + IntToStr(sessionXcpConfig.TimeoutT3) + ' ms';
+ Synchronize(@SynchronizeLogEvent);
+ FLogString := ' -> Timeout T4: ' + IntToStr(sessionXcpConfig.TimeoutT4) + ' ms';
+ Synchronize(@SynchronizeLogEvent);
+ FLogString := ' -> Timeout T5: ' + IntToStr(sessionXcpConfig.TimeoutT5) + ' ms';
+ Synchronize(@SynchronizeLogEvent);
+ FLogString := ' -> Timeout T7: ' + IntToStr(sessionXcpConfig.TimeoutT7) + ' ms';
+ Synchronize(@SynchronizeLogEvent);
+ if sessionXcpConfig.SeedKey <> '' then
+ FLogString := ' -> Seed/Key file: ' + sessionXcpConfig.SeedKey
+ else
+ FLogString := ' -> Seed/Key file: ' + 'None';
+ Synchronize(@SynchronizeLogEvent);
+ FLogString := ' -> Connection mode: ' + IntToStr(sessionXcpConfig.ConnectMode);
+ Synchronize(@SynchronizeLogEvent);
+ end
+ else
+ begin
+ FLogString := ' -> Unknown session protocol settings';
+ Synchronize(@SynchronizeLogEvent);
+ end;
+end; //*** end of LogSessionProtocolSettings ***
+
+
+//***************************************************************************************
+// NAME: GetTransportLayerName
+// PARAMETER: none
+// RETURN VALUE: Name of the configured transport layer.
+// DESCRIPTION: Obtains the name of the tansport layer that will be used for the
+// firmware update.
+//
+//***************************************************************************************
+function TFirmwareUpdateThread.GetTransportLayerName: String;
+var
+ transportConfig: TTransportConfig;
+begin
+ // Initialize the result.
+ Result := 'Unknown transport layer';
+ // Obtain access to the related configuration group.
+ transportConfig := FFirmwareUpdate.FCurrentConfig.Groups[TTransportConfig.GROUP_NAME]
+ as TTransportConfig;
+ // Filter on the configured transport layer.
+ if transportConfig.Transport = 'xcp_rs232' then
+ begin
+ Result := 'XCP on RS232';
+ end
+ else if transportConfig.Transport = 'xcp_can' then
+ begin
+ Result := 'XCP on CAN';
+ end
+ else if transportConfig.Transport = 'xcp_usb' then
+ begin
+ Result := 'XCP on USB';
+ end
+ else if transportConfig.Transport = 'xcp_net' then
+ begin
+ Result := 'XCP on TCP/IP';
+ end;
+end; //*** end of GetTransportLayerName ***
+
+
+//***************************************************************************************
+// NAME: LogTransportLayerSettings
+// PARAMETER: none
+// RETURN VALUE: none
+// DESCRIPTION: Logs the settings of the transport layer that will be used for the
+// firmware update.
+//
+//***************************************************************************************
+procedure TFirmwareUpdateThread.LogTransportLayerSettings;
+var
+ transportConfig: TTransportConfig;
+ transportXcpRs232Config: TTransportXcpRs232Config;
+ transportXcpCanConfig: TTransportXcpCanConfig;
+ transportXcpTcpIpConfig: TTransportXcpTcpIpConfig;
+begin
+ // Obtain access to the related configuration group.
+ transportConfig := FFirmwareUpdate.FCurrentConfig.Groups[TTransportConfig.GROUP_NAME]
+ as TTransportConfig;
+ // Filter on the configured transport layer.
+ // ------------------------------------ XCP on RS232 ----------------------------------
+ if transportConfig.Transport = 'xcp_rs232' then
+ begin
+ // Obtain access to the related configuration group.
+ transportXcpRs232Config := FFirmwareUpdate.FCurrentConfig.Groups[TTransportXcpRs232Config.GROUP_NAME]
+ as TTransportXcpRs232Config;
+ FLogString := ' -> Device: ' + transportXcpRs232Config.Device;
+ Synchronize(@SynchronizeLogEvent);
+ FLogString := ' -> Baudrate: ' + IntToStr(transportXcpRs232Config.Baudrate) + ' bit/sec';
+ Synchronize(@SynchronizeLogEvent);
+ end
+ // ------------------------------------ XCP on CAN ------------------------------------
+ else if transportConfig.Transport = 'xcp_can' then
+ begin
+ // Obtain access to the related configuration group.
+ transportXcpCanConfig := FFirmwareUpdate.FCurrentConfig.Groups[TTransportXcpCanConfig.GROUP_NAME]
+ as TTransportXcpCanConfig;
+ FLogString := ' -> Device: ' + transportXcpCanConfig.Device + ' (channel ' +
+ IntToStr(transportXcpCanConfig.Channel) + ' )';
+ Synchronize(@SynchronizeLogEvent);
+ FLogString := ' -> Baudrate: ' + IntToStr(transportXcpCanConfig.Baudrate) + ' bit/sec';
+ Synchronize(@SynchronizeLogEvent);
+ FLogString := ' -> Transmit CAN identifer: ' + Format('%.xh', [transportXcpCanConfig.TransmitId]);
+ Synchronize(@SynchronizeLogEvent);
+ FLogString := ' -> Receive CAN identifer: ' + Format('%.xh', [transportXcpCanConfig.ReceiveId]);
+ Synchronize(@SynchronizeLogEvent);
+ FLogString := ' -> Use 29-bit CAN identifiers: ';
+ if transportXcpCanConfig.ExtendedId > 0 then
+ FLogString := FLogString + 'Yes'
+ else
+ FLogString := FLogString + 'No';
+ Synchronize(@SynchronizeLogEvent);
+ end
+ // ------------------------------------ XCP on USB ------------------------------------
+ else if transportConfig.Transport = 'xcp_usb' then
+ begin
+ FLogString := ' -> No additional settings required';
+ Synchronize(@SynchronizeLogEvent);
+ end
+ // ------------------------------------ XCP on TCP/IP ---------------------------------
+ else if transportConfig.Transport = 'xcp_net' then
+ begin
+ // Obtain access to the related configuration group.
+ transportXcpTcpIpConfig := FFirmwareUpdate.FCurrentConfig.Groups[TTransportXcpTcpIpConfig.GROUP_NAME]
+ as TTransportXcpTcpIpConfig;
+ FLogString := ' -> Address: ' + transportXcpTcpIpConfig.Address;
+ Synchronize(@SynchronizeLogEvent);
+ FLogString := ' -> Port: ' + IntToStr(transportXcpTcpIpConfig.Port);
+ Synchronize(@SynchronizeLogEvent);
+ end
+ else
+ begin
+ FLogString := ' -> Unknown transport layer settings';
+ Synchronize(@SynchronizeLogEvent);
+ end;
+end; //*** end of LogTransportLayerSettings ***
+
+
+//***************************************************************************************
+// NAME: SynchronizeStartedEvent
+// PARAMETER: none
+// RETURN VALUE: none
+// DESCRIPTION: Synchronizes to the main thread to execute the code inside this
+// procedure. This function should only be called from thread level,
+// so from Execute-method in the following manner: Synchronize(@).
+//
+//***************************************************************************************
+procedure TFirmwareUpdateThread.SynchronizeStartedEvent;
+begin
+ // Only continue if the event is set.
+ if Assigned(FFirmwareUpdate.FStartedEvent) then
+ begin
+ // Trigger the event.
+ FFirmwareUpdate.FStartedEvent(FFirmwareUpdate);
+ end;
+end; //*** end of SynchronizeStartedEvent ***
+
+
+//***************************************************************************************
+// NAME: SynchronizeStoppedEvent
+// PARAMETER: none
+// RETURN VALUE: none
+// DESCRIPTION: Synchronizes to the main thread to execute the code inside this
+// procedure. This function should only be called from thread level,
+// so from Execute-method in the following manner: Synchronize(@).
+//
+//***************************************************************************************
+procedure TFirmwareUpdateThread.SynchronizeStoppedEvent;
+begin
+ // Only continue if the event is set.
+ if Assigned(FFirmwareUpdate.FStoppedEvent) then
+ begin
+ // Trigger the event.
+ FFirmwareUpdate.FStoppedEvent(FFirmwareUpdate);
+ end;
+end; //*** end of SynchronizeStoppedEvent ***
+
+
+//***************************************************************************************
+// NAME: SynchronizeDoneEvent
+// PARAMETER: none
+// RETURN VALUE: none
+// DESCRIPTION: Synchronizes to the main thread to execute the code inside this
+// procedure. This function should only be called from thread level,
+// so from Execute-method in the following manner: Synchronize(@).
+//
+//***************************************************************************************
+procedure TFirmwareUpdateThread.SynchronizeDoneEvent;
+begin
+ // Only continue if the event is set.
+ if Assigned(FFirmwareUpdate.FDoneEvent) then
+ begin
+ // Trigger the event.
+ FFirmwareUpdate.FDoneEvent(FFirmwareUpdate);
+ end;
+end; //*** end of SynchronizeDoneEvent ***
+
+
+//***************************************************************************************
+// NAME: SynchronizeInfoEvent
+// PARAMETER: none
+// RETURN VALUE: none
+// DESCRIPTION: Synchronizes to the main thread to execute the code inside this
+// procedure. This function should only be called from thread level,
+// so from Execute-method in the following manner: Synchronize(@).
+// Make sure field FInfoString is set to the desired value.
+//
+//***************************************************************************************
+procedure TFirmwareUpdateThread.SynchronizeInfoEvent;
+begin
+ // Only continue if the event is set.
+ if Assigned(FFirmwareUpdate.FInfoEvent) then
+ begin
+ // Trigger the event.
+ FFirmwareUpdate.FInfoEvent(FFirmwareUpdate, FInfoString);
+ end;
+end; //*** end of SynchronizeInfoEvent ***
+
+
+//***************************************************************************************
+// NAME: SynchronizeLogEvent
+// PARAMETER: none
+// RETURN VALUE: none
+// DESCRIPTION: Synchronizes to the main thread to execute the code inside this
+// procedure. This function should only be called from thread level,
+// so from Execute-method in the following manner: Synchronize(@).
+// Make sure field FLogString is set to the desired value.
+//
+//***************************************************************************************
+procedure TFirmwareUpdateThread.SynchronizeLogEvent;
+begin
+ // Only continue if the event is set.
+ if Assigned(FFirmwareUpdate.FLogEvent) then
+ begin
+ // Trigger the event.
+ FFirmwareUpdate.FLogEvent(FFirmwareUpdate, FLogString);
+ end;
+end; //*** end of SynchronizeLogEvent ***
+
+
+//***************************************************************************************
+// NAME: SynchronizeProgressEvent
+// PARAMETER: none
+// RETURN VALUE: none
+// DESCRIPTION: Synchronizes to the main thread to execute the code inside this
+// procedure. This function should only be called from thread level,
+// so from Execute-method in the following manner: Synchronize(@).
+// Make sure field FPercentage is set to the desired value.
+//
+//***************************************************************************************
+procedure TFirmwareUpdateThread.SynchronizeProgressEvent;
+begin
+ // Only continue if the event is set.
+ if Assigned(FFirmwareUpdate.FProgressEvent) then
+ begin
+ // Trigger the event.
+ FFirmwareUpdate.FProgressEvent(FFirmwareUpdate, FPercentage);
+ end;
+end; //*** end of SynchronizeProgressEvent ***
+
+
+//***************************************************************************************
+// NAME: SynchronizeErrorEvent
+// PARAMETER: none
+// RETURN VALUE: none
+// DESCRIPTION: Synchronizes to the main thread to execute the code inside this
+// procedure. This function should only be called from thread level,
+// so from Execute-method in the following manner: Synchronize(@).
+// Make sure field FLogString is set to the desired value.
+//
+//***************************************************************************************
+procedure TFirmwareUpdateThread.SynchronizeErrorEvent;
+begin
+ // Only continue if the event is set.
+ if Assigned(FFirmwareUpdate.FErrorEvent) then
+ begin
+ // Trigger the event.
+ FFirmwareUpdate.FErrorEvent(FFirmwareUpdate, FErrorString);
+ end;
+end; //*** end of SynchronizeErrorEvent ***
+
+end.
+//******************************** end of firmwareupdate.pas ****************************
+
+
diff --git a/Host/Source/MicroBoot/interfaces/FirmwareData.pas b/Host/Source/MicroBoot/interfaces/FirmwareData.pas
deleted file mode 100644
index b1586ecc..00000000
--- a/Host/Source/MicroBoot/interfaces/FirmwareData.pas
+++ /dev/null
@@ -1,1780 +0,0 @@
-unit FirmwareData;
-//***************************************************************************************
-// Description: Class for managing and manipulating firmware data.
-// File Name: FirmwareData.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.
-//
-//***************************************************************************************
-{$IFDEF FPC}
-{$mode objfpc}
-{$ENDIF}
-
-interface
-
-
-//***************************************************************************************
-// Includes
-//***************************************************************************************
-uses
- SysUtils, Classes;
-
-
-//***************************************************************************************
-// Type Definitions
-//***************************************************************************************
-type
- //---------------------------------- TDataSegment -------------------------------------
- TDataSegment = class(TObject)
- private
- // array with actual data bytes of the segment.
- FDataBytes: array of Byte;
- // base memory address for the data of this segment.
- FBaseAddress: Longword;
- // number of data bytes in this segment.
- FDataSize: Integer;
- procedure SetBaseAddress(value: Longword);
- function GetLastAddress: Longword;
- function GetData(index: Integer): Byte;
- procedure GrowDataArray(numOfBytesToAdd: Integer);
- public
- constructor Create;
- destructor Destroy; override;
- procedure Clear;
- function Add(data: array of Byte; length: Integer; address: Longword): Boolean;
- function Remove(length: Integer; address: Longword): Boolean;
- procedure Dump;
- property Data[index: Integer]: Byte read GetData;
- property Size: Integer read FDataSize;
- property BaseAddress: Longword read FBaseAddress write SetBaseAddress;
- property LastAddress: Longword read GetLastAddress;
- end;
-
- //---------------------------------- TDataSegmentList ---------------------------------
- TDataSegmentList=class(TList)
- private
- function Get(Index: Integer): TDataSegment;
- protected
- { Protected declarations }
- public
- { Public declarations }
- constructor Create;
- destructor Destroy; override;
- function Add(segment: TDataSegment): Integer;
- procedure Delete(Index: Integer);
- property Items[Index: Integer]: TDataSegment read Get; default;
-end;
-
- //---------------------------------- TFirmwareFileType --------------------------------
- TFirmwareFileType =
- (
- FFT_UNKNOWN,
- FFT_SRECORD,
- FFT_BINARY
- );
-
-
- //---------------------------------- TFirmwareFileHandler -----------------------------
- TFirmwareFileHandler = class(TObject)
- type
- TFirmwareFileDataReadEvent = procedure(sender: TObject; data: array of Byte; length: Integer; address: Longword) of object;
- protected
- // event handler for when a chunk of data was read from the firmware file
- FOnDataRead: TFirmwareFileDataReadEvent;
- public
- constructor Create; virtual;
- function Load(firmwareFile: String): Boolean; virtual; abstract;
- function Save(firmwareFile: String; segments: TDataSegmentList): Boolean; virtual; abstract;
- property OnDataRead: TFirmwareFileDataReadEvent read FOnDataRead write FOnDataRead;
- end;
-
- //---------------------------------- TSRecordFileHandler ------------------------------
- TSRecordFileHandler = class(TFirmwareFileHandler)
- type
- TSRecordLineType = (ltInvalid, ltS0, ltS1, ltS2, ltS3, ltS7, ltS8, ltS9);
- private
- FDataBytesPerLineOnSave: Integer;
- class function GetLineType(line: String): TSRecordLineType; static;
- function GetLineData(line: String; var data: array of Byte; var length: Integer; var address: Longword): Boolean;
- function ConstructLine(data: array of Byte; length: Integer; address: Longword): String;
- public
- constructor Create; override;
- function Load(firmwareFile: String): Boolean; override;
- function Save(firmwareFile: String; segments: TDataSegmentList): Boolean; override;
- class function IsSRecordFile(firmwareFile: String): Boolean; static;
- property DataBytesPerLineOnSave: Integer read FDataBytesPerLineOnSave write FDataBytesPerLineOnSave;
- end;
-
- //---------------------------------- TBinaryFileHandler -------------------------------
- TBinaryFileHandler = class(TFirmwareFileHandler)
- private
- public
- constructor Create; override;
- function Load(firmwareFile: String): Boolean; override;
- function Save(firmwareFile: String; segments: TDataSegmentList): Boolean; override;
- end;
-
- //---------------------------------- TFirmwareData ------------------------------------
- TFirmwareData = class(TObject)
- private
- // list with data segments of the firmware
- FSegmentList: TDataSegmentList;
- function GetSegmentCount: Integer;
- function GetSegment(index: Integer): TDataSegment;
- procedure SortSegments;
- function FindSegmentIdx(address: Longword): Integer;
- function FindPrevSegmentIdx(address: Longword): Integer;
- function FindNextSegmentIdx(address: Longword): Integer;
- function GetFirmwareFileType(firmwareFile: String): TFirmwareFileType;
- procedure FirmwareFileDataRead(sender: TObject; data: array of Byte; length: Integer; address: Longword);
- public
- constructor Create;
- destructor Destroy; override;
- function AddData(data: array of Byte; length: Integer; address: Longword): Boolean;
- function RemoveData(length: Integer; address: Longword): Boolean;
- procedure ClearData;
- function LoadFromFile(firmwareFile: String; append: Boolean): Boolean;
- function SaveToFile(firmwareFile: String; firmwareFileType: TFirmwareFileType): Boolean;
- procedure Dump;
- property SegmentCount: Integer read GetSegmentCount;
- property Segment[index: Integer]: TDataSegment read GetSegment;
- end;
-
-
-implementation
-//---------------------------------------------------------------------------------------
-//-------------------------------- TDataSegment -----------------------------------------
-//---------------------------------------------------------------------------------------
-//***************************************************************************************
-// NAME: Create
-// PARAMETER: none
-// RETURN VALUE: none
-// DESCRIPTION: Class constructor
-//
-//***************************************************************************************
-constructor TDataSegment.Create;
-begin
- // call inherited constructor
- inherited Create;
- // clear segment contents
- Clear;
-end; //*** end of Create ***
-
-
-//***************************************************************************************
-// NAME: Destroy
-// PARAMETER: none
-// RETURN VALUE: none
-// DESCRIPTION: Class destructor
-//
-//***************************************************************************************
-destructor TDataSegment.Destroy;
-begin
- // release allocated array memory
- SetLength(FDataBytes, 0);
- // call inherited destructor
- inherited;
-end; //*** end of Destroy ***
-
-
-//***************************************************************************************
-// NAME: SetBaseAddress
-// PARAMETER: value New base address.
-// RETURN VALUE: none
-// DESCRIPTION: Setter for base address.
-//
-//***************************************************************************************
-procedure TDataSegment.SetBaseAddress(value: Longword);
-begin
- FBaseAddress := value;
-end; //*** end of SetBaseAddress ***
-
-
-//***************************************************************************************
-// NAME: GetLastAddress
-// PARAMETER: none
-// RETURN VALUE: Last address.
-// DESCRIPTION: Getter for last address in the segment.
-//
-//***************************************************************************************
-function TDataSegment.GetLastAddress: Longword;
-begin
- Result := 0;
- if FDataSize > 0 then
- Result := (FBaseAddress + LongWord(FDataSize)) - 1;
-end; //*** end of GetLastAddress ***
-
-
-//***************************************************************************************
-// NAME: GetData
-// PARAMETER: index Index into the data byte array.
-// RETURN VALUE: Byte value.
-// DESCRIPTION: Getter for a byte value from the array at the specified index.
-//
-//***************************************************************************************
-function TDataSegment.GetData(index: Integer): Byte;
-begin
- Result := 0;
- if (index < FDataSize) and (index >= 0) then
- Result := FDataBytes[index];
-end; //*** end of GetData ***
-
-
-//***************************************************************************************
-// NAME: Clear
-// PARAMETER: none
-// RETURN VALUE: none
-// DESCRIPTION: Allocates more space to the data array if necessary. Allocation is
-// done in chunks of DATA_ARRAY_GROWTH_STEP, because this is more
-// run-time efficient.
-//
-//***************************************************************************************
-procedure TDataSegment.GrowDataArray(numOfBytesToAdd: Integer);
-const
- DATA_ARRAY_GROWTH_STEP: Integer = 1024;
-var
- numOfBytesToGrow: Integer;
- numOfStepsToGrow: Integer;
- desiredArrayLength: Integer;
-begin
- if numOfBytesToAdd > 0 then
- begin
- // check if more space needs to be allocated
- if Length(FDataBytes) < (FDataSize + numOfBytesToAdd) then
- begin
- // determine how many bytes the array needs to grow
- numOfBytesToGrow := (FDataSize + numOfBytesToAdd) - Length(FDataBytes);
- if numOfBytesToGrow > 0 then
- begin
- // determine how many growth steps to add
- numOfStepsToGrow := numOfBytesToGrow div DATA_ARRAY_GROWTH_STEP;
- if (numOfBytesToGrow mod DATA_ARRAY_GROWTH_STEP) > 0 then
- numOfStepsToGrow := numOfStepsToGrow + 1;
- // determine desired new array length
- desiredArrayLength := Length(FDataBytes) + (numOfStepsToGrow * DATA_ARRAY_GROWTH_STEP);
- // grow the array
- SetLength(FDataBytes, desiredArrayLength);
- end;
- end;
- end;
-end; //*** end of GrowDataArray ***
-
-
-//***************************************************************************************
-// NAME: Clear
-// PARAMETER: none
-// RETURN VALUE: none
-// DESCRIPTION: Clears all databytes from the segment and resets its base address.
-//
-//***************************************************************************************
-procedure TDataSegment.Clear;
-begin
- FBaseAddress := 0;
- FDataSize := 0;
- SetLength(FDataBytes, 0);
-end; //*** end of Clear
-
-
-//***************************************************************************************
-// NAME: Add
-// PARAMETER: data Array with bytes to add to the segment.
-// length Number of bytes in the array.
-// address Address where to start adding bytes at in the segment.
-// RETURN VALUE: True if the data was added to the segment, False if it couldn't be
-// added. This latter situation happens if the data is not aligned to
-// the data the is already present in the segment.
-// DESCRIPTION: Adds data bytes to the segment starting at the specified address. This
-// function allows a new chunk of data to be added at the front or the
-// rear of the segment, as well as overwriting existing data.
-//
-//***************************************************************************************
-function TDataSegment.Add(data: array of Byte; length: Integer; address: Longword): Boolean;
-var
- byteIdx: Integer;
- numBytesToAppend: Integer;
-begin
- // init result
- Result := False;
-
- // check if there is something to add
- if length <= 0 then
- Exit;
- // the following checks assume there is already data in the segment
- if FDataSize > 0 then
- begin
- // check if the new data does not fit at the end
- if address > (GetLastAddress + 1) then
- Exit;
- // check if new data does not fit at the start
- if (address + Longword(length)) < FBaseAddress then
- Exit;
- end;
-
- // still here some there is something to add. check if the segment is currently empty
- if (FDataSize = 0) then
- begin
- // make sure enough elements are allocated in the data array
- GrowDataArray(length);
- // set the base address
- FBaseAddress := address;
- // add the data
- for byteIdx := 0 to (length - 1) do
- FDataBytes[byteIdx] := data[byteIdx];
- // set the new size
- FDataSize := length;
- // success
- Result := True;
- end
- // check if all data is for overwriting existing data
- else if (address >= FBaseAddress) and ((address + Longword(length - 1)) <= GetLastAddress) then
- begin
- // overwrite the data
- for byteIdx := 0 to (length - 1) do
- FDataBytes[(address - FBaseAddress) + Longword(byteIdx)] := data[byteIdx];
- // success
- Result := True;
- end
- // check if data should be appended at the end including partial overwrite at the end
- else if (address >= FBaseAddress) and ((address + Longword(length - 1)) > GetLastAddress) then
- begin
- // determine minimal required growth of the array
- numBytesToAppend := (address + Longword(length)) - (FBaseAddress + Longword(FDataSize));
- // make sure enough elements are allocated in the data array
- GrowDataArray(numBytesToAppend);
- // add the data
- for byteIdx := 0 to (length - 1) do
- FDataBytes[(address - FBaseAddress) + Longword(byteIdx)] := data[byteIdx];
- // set the new size
- FDataSize := FDataSize + numBytesToAppend;
- // success
- Result := True;
- end
- // check if data should be appended at the start including partial overwrite at the start
- else if (address < FBaseAddress) and ((address + Longword(length - 1)) <= GetLastAddress) then
- begin
- // determine minimal required growth of the array
- numBytesToAppend := FBaseAddress - address;
- // make sure enough elements are allocated in the data array
- GrowDataArray(numBytesToAppend);
- // set the base address
- FBaseAddress := address;
- // move current contents
- {for byteIdx := 0 to (FDataSize - 1) do
- FDataBytes[numBytesToAppend + byteIdx] := FDataBytes[byteIdx];}
- for byteIdx := (FDataSize - 1) downto 0 do
- FDataBytes[numbytesToAppend + byteIdx] := FDataBytes[byteIdx];
- // add the new data
- for byteIdx := 0 to (length - 1) do
- FDataBytes[byteIdx] := data[byteIdx];
- // set the new size
- FDataSize := FDataSize + numBytesToAppend;
- // success
- Result := True;
- end
- // check if data should be both appended at the start and the end. this is the case when
- // the to be added data is larger then the current segment and overlaps the entire current
- // segment
- else if (address < FBaseAddress) and ((address + Longword(length - 1)) > GetLastAddress) then
- begin
- // set the base address
- FBaseAddress := address;
- // make sure enough elements are allocated in the data array
- GrowDataArray(length);
- // add the new data. no need to first move current contents because they will be
- // fully overwritten anyways
- for byteIdx := 0 to (length - 1) do
- FDataBytes[byteIdx] := data[byteIdx];
- // set the new size
- FDataSize := length;
- // success
- Result := True;
- end;
-end; //*** end of Add ***
-
-
-//***************************************************************************************
-// NAME: Remove
-// PARAMETER: length Number of bytes to remove
-// address Address where to start removing data from.
-// RETURN VALUE: True if the data was removed, False if the data could not be removed
-// because this class cannot split a segment.
-// DESCRIPTION: Removes data from the segment. Note that the to be removed data
-// must be aligned to the start or the end of the segment, because this
-// class cannot split a segment.
-//
-//***************************************************************************************
-function TDataSegment.Remove(length: Integer; address: Longword): Boolean;
-var
- numOfBytesToRemove: Integer;
- byteIdx: Integer;
-begin
- Result := True;
-
- // if there is nothing to remove then we are done already
- if (length <= 0) or (FDataSize = 0) then
- begin
- Exit;
- end;
-
- // if the data is not in this segment the we are also done already
- if (address > GetLastAddress) or ((address + Longword(length - 1)) < FBaseAddress) then
- begin
- Exit;
- end;
-
- // check if the to be removed data overlaps with either the end or the start of the
- // segment. if not, then we cannot remove the data because this class cannot split the
- // segment
- if (address > FBaseAddress) and ((address + Longword(length - 1)) < GetLastAddress) then
- begin
- Result := False;
- Exit;
- end;
-
- // check if the entire segment should be removed
- if (address <= FBaseAddress) and ((address + Longword(length - 1)) >= GetLastAddress) then
- begin
- Clear;
- end
- // check if the to be removed data is at the start of the segment
- else if (address <= FBaseAddress) then
- begin
- numOfBytesToRemove := (address + Longword(length)) - FBaseAddress;
- // move remaining data to the start of the array
- for byteIdx := 0 to (FDataSize - numOfBytesToRemove - 1) do
- FDataBytes[byteIdx] := FDataBytes[byteIdx + numOfBytesToRemove];
- // adjust size and base address
- FDataSize := FDataSize - numOfBytesToRemove;
- FBaseAddress := FBaseAddress + Longword(numOfBytesToRemove);
- end
- // check if the to be removed data is at the end of the segment
- else if (address > FBaseAddress) and ((address + Longword(length - 1)) >= GetLastAddress) then
- begin
- numOfBytesToRemove := GetLastAddress - address + 1;
- FDataSize := FDataSize - numOfBytesToRemove;
- end;
-end; //*** end of Remove ***
-
-
-//***************************************************************************************
-// NAME: Dump
-// PARAMETER: none
-// RETURN VALUE: none
-// DESCRIPTION: Dumps the segment contents to the standard output for debugging
-// purposes.
-//
-//***************************************************************************************
-procedure TDataSegment.Dump;
-{$IFDEF DEBUG}
-var
- line: String;
- byteCnt: Integer;
-{$ENDIF}
-begin
- {$IFDEF DEBUG}
- // output address and size
- Writeln('Segment base address = $' + Format('%.8X', [BaseAddress]));
- Writeln('Segment data size = ' + IntToStr(Size));
- // output raw data
- Writeln('Segment data contents = ' + sLineBreak);
- line := ' ';
- for byteCnt := 1 to Size do
- begin
- line := line + Format('%.2X ', [Data[byteCnt - 1]]);
- if (byteCnt mod 16) = 0 then
- begin
- Writeln(line);
- line := ' ';
- end;
- end;
- Writeln(line);
- {$ENDIF}
-end; //*** end of Dump
-
-
-//---------------------------------------------------------------------------------------
-//-------------------------------- TDataSegmentList -------------------------------------
-//---------------------------------------------------------------------------------------
-//***************************************************************************************
-// NAME: Create
-// PARAMETER: none
-// RETURN VALUE: none
-// DESCRIPTION: Object constructor. Calls TObject's constructor and initializes
-// the private property variables to their default values.
-//
-//***************************************************************************************
-constructor TDataSegmentList.Create;
-begin
- // call inherited constructor
- inherited Create;
-end; //*** end of Create ***
-
-
-//***************************************************************************************
-// NAME: Destroy
-// PARAMETER: none
-// RETURN VALUE: none
-// DESCRIPTION: Component destructor.
-//
-//***************************************************************************************
-destructor TDataSegmentList.Destroy;
-var
- idx: Integer;
-begin
- // release allocated heap memory
- for idx := 0 to Count - 1 do
- TDataSegment(Items[idx]).Free;
- inherited;
-end; //*** end of Destroy ***
-
-
-//***************************************************************************************
-// NAME: Get
-// PARAMETER: Index Index in the list
-// RETURN VALUE: List item.
-// DESCRIPTION: Obtains an element from the list.
-//
-//***************************************************************************************
-function TDataSegmentList.Get(Index: Integer): TDataSegment;
-begin
- Result := TDataSegment(inherited Get(Index));
-end; //*** end of Get ***
-
-
-//***************************************************************************************
-// NAME: Add
-// PARAMETER: segment The data segment to add.
-// RETURN VALUE: Index of the newly added segment in the list if successful, -1
-// otherwise.
-// DESCRIPTION: Adds an element to the list.
-//
-//***************************************************************************************
-function TDataSegmentList.Add(segment: TDataSegment): Integer;
-begin
- // add the entry to the list
- Result := inherited Add(segment);
- // set correct value for error situation
- if Result < 0 then
- Result := -1;
-end; //*** end of Add ***
-
-
-//***************************************************************************************
-// NAME: Delete
-// PARAMETER: Index Index in the list.
-// RETURN VALUE: none
-// DESCRIPTION: Remove an element to the list as the specified index. It is automa-
-// tically freed as well.
-//
-//***************************************************************************************
-procedure TDataSegmentList.Delete(Index: Integer);
-var
- segment: TDataSegment;
-begin
- // only continue if the index is valid
- if (Index >= 0) and (Index < Count) then
- begin
- // obtain object first so we can free it afterwards
- segment := Get(Index);
- // delete it from the list
- inherited Delete(Index);
- // now free it
- segment.Free
- end;
-end; //*** end of Delete ***
-
-
-//---------------------------------------------------------------------------------------
-//-------------------------------- TFirmwareFileHandler ---------------------------------
-//---------------------------------------------------------------------------------------
-//***************************************************************************************
-// NAME: Create
-// PARAMETER: none
-// RETURN VALUE: none
-// DESCRIPTION: Class constructor
-//
-//***************************************************************************************
-constructor TFirmwareFileHandler.Create;
-begin
- // call inherited constructor
- inherited Create;
- // init fields
- FOnDataRead := nil;
-end; //*** end of Create ***
-
-
-//---------------------------------------------------------------------------------------
-//-------------------------------- TSRecordFileHandler ----------------------------------
-//---------------------------------------------------------------------------------------
-//***************************************************************************************
-// NAME: Create
-// PARAMETER: none
-// RETURN VALUE: none
-// DESCRIPTION: Class constructor
-//
-//***************************************************************************************
-constructor TSRecordFileHandler.Create;
-begin
- // call inherited constructor
- inherited Create;
- // set default number of data bytes to add to a line when saving an s-record
- FDataBytesPerLineOnSave := 16;
-end; //*** end of Create ***
-
-//***************************************************************************************
-// NAME: Load
-// PARAMETER: firmwareFile Filename with path of the file to load.
-// RETURN VALUE: True is successful, False otherwise.
-// DESCRIPTION: Loads the data in the specified firmware file. The OnDataRead event
-// handler is called each time a chunk of data was read from the file.
-//
-//***************************************************************************************
-function TSRecordFileHandler.Load(firmwareFile: String): Boolean;
-var
- srecordFile: TextFile;
- line: String;
- lineData: array of Byte;
- lineLength: Integer;
- lineAddr: Longword;
-begin
- // init result value and locals
- Result := True;
-
- // first check if the file actually exists
- if not FileExists(firmwareFile) then
- begin
- Result := False;
- Exit;
- end;
-
- // check if the event handler is configured, otherwise it is pointless to go through
- // the file
- if not Assigned(FOnDataRead) then
- begin
- Result := False;
- Exit;
- end;
-
- // create array with sufficient length
- SetLength(lineData, 1024);
- // go through the lines in the file to try and detect a line that is formatted as an
- // S-record. start by getting the file handle and going to the start of the file
- AssignFile(srecordFile, firmwareFile);
- Reset(srecordFile);
- // loop through the lines
- while not Eof(srecordFile) do
- begin
- // read the next line from the file
- ReadLn(srecordFile, line);
- // parse the line to extract the data bytes and address info
- if GetLineData(line, lineData, lineLength, lineAddr) then
- begin
- // invoke the event handler to inform about the new data
- FOnDataRead(Self, lineData, lineLength, lineAddr);
- end;
- end;
- // close the file
- CloseFile(srecordFile);
- // release array
- SetLength(lineData, 0);
-end; //*** end of Load ***
-
-
-//***************************************************************************************
-// NAME: Save
-// PARAMETER: firmwareFile Filename with path of the file to save.
-// segments List with data segments that need to be saved.
-// RETURN VALUE: True is successful, False otherwise.
-// DESCRIPTION: Saves the firmware data to the specified firmware file.
-//
-//***************************************************************************************
-function TSRecordFileHandler.Save(firmwareFile: String; segments: TDataSegmentList): Boolean;
-var
- srecordFile: TextFile;
- segmentIdx: Integer;
- byteIdx: Integer;
- line: String;
- programData: array of Byte;
- currentAddress: Longword;
- currentByteCnt: Integer;
- firmwareFileBytes: TBytes;
- headerByteCount: Integer;
- checksumCalc: Byte;
- addrByteCnt: Integer;
- charIdx: Integer;
-begin
- // init result
- Result := True;
-
- // check if there is actually something to write
- if segments.Count <= 0 then
- begin
- // no program data to write
- Result := False;
- Exit;
- end;
-
- // open the firmware file for writing
- AssignFile(srecordFile, firmwareFile);
- ReWrite(srecordFile);
-
- // ---- add the S0 header line that contains the filename ----
- SetLength(firmwareFileBytes, Length(firmwareFile));
- for charIdx := 1 to Length(firmwareFile) do
- firmwareFileBytes[charIdx - 1] := Ord(firmwareFile[charIdx]);
- headerByteCount := 3 + Length(firmwareFileBytes);
- line := 'S0' + Format('%.2X', [headerByteCount]) + '0000';
- for byteIdx := 0 to (Length(firmwareFileBytes) - 1) do
- begin
- line := line + Format('%.2X', [firmwareFileBytes[byteIdx]]);
- end;
- // compute checksum
- checksumCalc := 0;
- for byteIdx := 0 to (headerByteCount - 1) do
- begin
- checksumCalc := checksumCalc + StrToInt('$' + Copy(line, 3+(byteIdx*2), 2));
- end;
- // convert to one's complement and add it
- checksumCalc := not checksumCalc;
- line := line + Format('%.2X', [checksumCalc]);
- // add it to the file
- WriteLn(srecordFile, line);
-
- // ---- add the program data lines ----
- // init program data array
- SetLength(programData, DataBytesPerLineOnSave);
- // loop through all segments
- for segmentIdx := 0 to (segments.Count - 1) do
- begin
- // set current address and byte count
- currentAddress := segments[segmentIdx].BaseAddress;
- currentByteCnt := 0;
- // progress the data
- for byteIdx := 0 to (segments[segmentIdx].Size - 1) do
- begin
- // add the program data byte
- programData[currentByteCnt] := segments[segmentIdx].Data[byteIdx];
- currentByteCnt := currentByteCnt + 1;
- // check if desired program data bytes per line is reached
- if currentByteCnt = DataBytesPerLineOnSave then
- begin
- // construct the s-record line and add it to the file
- line := ConstructLine(programData, currentByteCnt, currentAddress);
- WriteLn(srecordFile, line);
- // refresh loop variables
- currentAddress := currentAddress + Longword(currentByteCnt);
- currentByteCnt := 0;
- end;
- end;
- // check if there are still bytes left to write to the file
- if currentByteCnt > 0 then
- begin
- // construct the s-record line and add it to the file
- line := ConstructLine(programData, currentByteCnt, currentAddress);
- WriteLn(srecordFile, line);
- end;
- end;
-
- // ---- add the termination line ----
- // determine the line type to use
- if segments[0].BaseAddress >= $FFFFFF then
- begin
- addrByteCnt := 4;
- line := 'S705' + Format('%.8X', [segments[0].BaseAddress]);
- end
- else if segments[0].BaseAddress >= $FFFF then
- begin
- addrByteCnt := 3;
- line := 'S804' + Format('%.6X', [segments[0].BaseAddress]);
- end
- else
- begin
- addrByteCnt := 2;
- line := 'S903' + Format('%.4X', [segments[0].BaseAddress]);
- end;
- // compute checksum
- checksumCalc := 0;
- for byteIdx := 0 to addrByteCnt do
- begin
- checksumCalc := checksumCalc + StrToInt('$' + Copy(line, 3+(byteIdx*2), 2));
- end;
- // convert to one's complement and add it
- checksumCalc := not checksumCalc;
- line := line + Format('%.2X', [checksumCalc]);
- WriteLn(srecordFile, line);
-
- // close the file
- CloseFile(srecordFile);
-end; //*** end of Save ***
-
-
-//***************************************************************************************
-// NAME: IsSRecordFile
-// PARAMETER: firmwareFile Filename with path of the file to check.
-// RETURN VALUE: True is the file has the S-Record format, False otherwise.
-// DESCRIPTION: Checks if the file contains data formatted as an S-Record.
-//
-//***************************************************************************************
-class function TSRecordFileHandler.IsSRecordFile(firmwareFile: String): Boolean;
-var
- srecordFile: TextFile;
- line: String;
-begin
- // init result value and locals
- Result := False;
-
- // first check if the file actually exists
- if not FileExists(firmwareFile) then
- Exit;
-
- // go through the lines in the file to try and detect a line that is formatted as an
- // S-record. start by getting the file handle and going to the start of the file
- AssignFile(srecordFile, firmwareFile);
- Reset(srecordFile);
- // loop through the lines
- while not Eof(srecordFile) do
- begin
- ReadLn(srecordFile, line); // read line from file
- if (TSRecordFileHandler.GetLineType(line) = ltS1) or
- (TSRecordFileHandler.GetLineType(line) = ltS2) or
- (TSRecordFileHandler.GetLineType(line) = ltS3) then
- begin
- // valid S-Record
- Result := true;
- // no need to continue looping
- Break;
- end;
- end;
- // close the file
- CloseFile(srecordFile);
-end; //*** end of IsSRecordFile ***
-
-
-//***************************************************************************************
-// NAME: GetLineType
-// PARAMETER: Line from S-Record
-// RETURN VALUE: line type
-// DESCRIPTION: Determines what type of S-Record line we're dealing with.
-//
-//***************************************************************************************
-class function TSRecordFileHandler.GetLineType(line: String): TSRecordLineType;
-begin
- Result := ltInvalid;
-
- if Pos('S0', UpperCase(line)) > 0 then
- begin
- Result := ltS0;
- Exit;
- end;
-
- if Pos('S1', UpperCase(line)) > 0 then
- begin
- Result := ltS1;
- Exit;
- end;
-
- if Pos('S2', UpperCase(line)) > 0 then
- begin
- Result := ltS2;
- Exit;
- end;
-
- if Pos('S3', UpperCase(line)) > 0 then
- begin
- Result := ltS3;
- Exit;
- end;
-
- if Pos('S7', UpperCase(line)) > 0 then
- begin
- Result := ltS7;
- Exit;
- end;
-
- if Pos('S8', UpperCase(line)) > 0 then
- begin
- Result := ltS8;
- Exit;
- end;
-
- if Pos('S9', UpperCase(line)) > 0 then
- begin
- Result := ltS9;
- Exit;
- end;
-end; //*** end of GetLineType ***
-
-
-//***************************************************************************************
-// NAME: GetLineData
-// PARAMETER: line Line from S-Record.
-// data Array where the data bytes are to be stored.
-// length Storage for number of bytes that were read.
-// address Storage for the address found on the S-Record line.
-// RETURN VALUE: True is successful, False otherwise
-// DESCRIPTION: Extracts the data bytes and address from the S-Record line.
-//
-//***************************************************************************************
-function TSRecordFileHandler.GetLineData(line: String; var data: array of Byte; var length: Integer; var address: Longword): Boolean;
-var
- lineType: TSRecordLineType;
- byteCount: Integer;
- byteIdx: Integer;
- checksumRead: Byte;
- checksumCalc: Byte;
- addrByteCnt: Integer;
-begin
- // init result
- Result := True;
- // read out the line type
- lineType := TSRecordFileHandler.GetLineType(line);
- // set line type specific settings
- case lineType of
- ltS1:
- begin
- addrByteCnt := 2;
- end;
- ltS2:
- begin
- addrByteCnt := 3;
- end;
- ltS3:
- begin
- addrByteCnt := 4;
- end;
- else
- // line does not contain program data
- Result := False;
- Exit;
- end;
-
- // extract count value from the line
- byteCount := StrToInt('$' + Copy(line, 3, 2));
- // extract address
- address := StrToInt('$' + Copy(line, 5, addrByteCnt*2));
- // determine number of data bytes = total bytes - address - checksum
- length := byteCount - addrByteCnt - 1;
- // read the checksum
- checksumRead := StrToInt('$' + Copy(line, (5+(addrByteCnt*2))+(length*2), 2));
- // compute checksum
- checksumCalc := 0;
- for byteIdx := 0 to (byteCount - 1) do
- begin
- checksumCalc := checksumCalc + StrToInt('$' + Copy(line, 3+(byteIdx*2), 2));
- end;
- // convert to one's complement
- checksumCalc := not checksumCalc;
- // validate checksum
- if checksumCalc <> checksumRead then
- begin
- // line contains an invalid checksum
- Result := False;
- Exit;
- end;
- // read all the data bytes
- for byteIdx := 0 to (length - 1) do
- begin
- data[byteIdx] := StrToInt('$' + Copy(line, (5+(addrByteCnt*2))+(byteIdx*2), 2));
- end;
-end; //*** end of GetLineData ***
-
-
-//***************************************************************************************
-// NAME: ConstructLine
-// PARAMETER: data Array with data bytes.
-// length Number of bytes in the array.
-// address Base address of the data.
-// RETURN VALUE: The constructed line if successful, '' otherwise.
-// DESCRIPTION: Constructs an S-record line with program data.
-//
-//***************************************************************************************
-function TSRecordFileHandler.ConstructLine(data: array of Byte; length: Integer; address: Longword): String;
-var
- addrByteCnt: Integer;
- byteCount: Integer;
- addressStr: String;
- byteIdx: Integer;
- checksumCalc: Byte;
-begin
- // determine the line type to use
- if address >= $FFFFFF then
- begin
- addrByteCnt := 4;
- addressStr := Format('%.8X', [address]);
- Result := 'S3';
- end
- else if address >= $FFFF then
- begin
- addrByteCnt := 3;
- addressStr := Format('%.6X', [address]);
- Result := 'S2';
- end
- else
- begin
- addrByteCnt := 2;
- addressStr := Format('%.4X', [address]);
- Result := 'S1';
- end;
- // determine number of bytes after the Sx, excluding checksum
- byteCount := addrByteCnt + length + 1;
- // add the count and address
- Result := Result + Format('%.2X', [byteCount]) + addressStr;
- // add all the data bytes
- for byteIdx := 0 to (length - 1) do
- begin
- Result := Result + Format('%.2X', [data[byteIdx]]);
- end;
- // compute checksum
- checksumCalc := 0;
- for byteIdx := 0 to (byteCount - 1) do
- begin
- checksumCalc := checksumCalc + StrToInt('$' + Copy(Result, 3+(byteIdx*2), 2));
- end;
- // convert to one's complement
- checksumCalc := not checksumCalc;
- // add the checksum
- Result := Result + Format('%.2X', [checksumCalc]);
-end; //*** end of ConstructLine ***/
-
-
-//---------------------------------------------------------------------------------------
-//-------------------------------- TBinaryFileHandler -----------------------------------
-//---------------------------------------------------------------------------------------
-//***************************************************************************************
-// NAME: Create
-// PARAMETER: none
-// RETURN VALUE: none
-// DESCRIPTION: Class constructor
-//
-//***************************************************************************************
-constructor TBinaryFileHandler.Create;
-begin
- // call inherited constructor
- inherited Create;
-end; //*** end of Create ***
-
-
-//***************************************************************************************
-// NAME: Load
-// PARAMETER: firmwareFile Filename with path of the file to load.
-// RETURN VALUE: True is successful, False otherwise.
-// DESCRIPTION: Loads the data in the specified firmware file. The OnDataRead event
-// handler is called each time a chunk of data was read from the file.
-//
-//***************************************************************************************
-function TBinaryFileHandler.Load(firmwareFile: String): Boolean;
-begin
- // loading from a binary file is not yet supported
- Result := False;
-end; //*** end of Load ***
-
-
-//***************************************************************************************
-// NAME: Save
-// PARAMETER: firmwareFile Filename with path of the file to save.
-// segments List with data segments that need to be saved.
-// RETURN VALUE: True is successful, False otherwise.
-// DESCRIPTION: Saves the firmware data to the specified firmware file.
-//
-//***************************************************************************************
-function TBinaryFileHandler.Save(firmwareFile: String; segments: TDataSegmentList): Boolean;
-var
- startAddr: Longword;
- endAddr: Longword;
- segmentIdx: Integer;
- progData: array of Byte;
- progLen: Longword;
- byteIdx: Longword;
- binaryFile: File;
-begin
- // init result and locals
- Result := False;
- startAddr := $FFFFFFFF;
- endAddr := 0;
-
- // first need to determine the start and end addresses for the firmware data
- for segmentIdx := 0 to (segments.Count - 1) do
- begin
- if segments[segmentIdx].BaseAddress < startAddr then
- startAddr := segments[segmentIdx].BaseAddress;
- if segments[segmentIdx].LastAddress > endAddr then
- endAddr := segments[segmentIdx].LastAddress;
- end;
-
- // plausibility check
- if startAddr > endAddr then
- Exit;
-
- // calculate program length
- progLen := endAddr - startAddr + 1;
-
- // init array size such that it can hold all program data, including filler bytes
- // for possible
- SetLength(progData, progLen);
- // fill it completely with filler bytes
- for byteIdx := 0 to (progLen - 1) do
- progData[byteIdx] := $FF;
-
- // add the segment data to the program data array
- for segmentIdx := 0 to (segments.Count - 1) do
- begin
- // loop through segment data bytes one-by-one
- for byteIdx := 0 to (segments[segmentIdx].Size - 1) do
- begin
- // at the byte at the correct index
- progData[(segments[segmentIdx].BaseAddress - startAddr) + byteIdx] := segments[segmentIdx].Data[byteIdx];
- end;
- end;
-
- // open the firmware file for writing
- AssignFile(binaryFile, firmwareFile);
- // define a record to be of size 1 byte.
- ReWrite(binaryFile, 1);
-
- // write all program bytes one-by-one to the file
- for byteIdx := 0 to (progLen - 1) do
- begin
- BlockWrite(binaryFile, progData[byteIdx], 1);
- end;
-
- // clean up
- CloseFile(binaryFile);
- Result := True;
-end; //*** end of Save ***
-
-
-//---------------------------------------------------------------------------------------
-//-------------------------------- TFirmwareData ----------------------------------------
-//---------------------------------------------------------------------------------------
-//***************************************************************************************
-// NAME: Create
-// PARAMETER: none
-// RETURN VALUE: none
-// DESCRIPTION: Class constructor
-//
-//***************************************************************************************
-constructor TFirmwareData.Create;
-begin
- // call inherited constructor
- inherited Create;
- // create empty data segments list
- FSegmentList := TDataSegmentList.Create();
-end; //*** end of Create ***
-
-
-//***************************************************************************************
-// NAME: Destroy
-// PARAMETER: none
-// RETURN VALUE: none
-// DESCRIPTION: Class destructor
-//
-//***************************************************************************************
-destructor TFirmwareData.Destroy;
-begin
- // release the data segments list
- FSegmentList.Free;
- // call inherited destructor
- inherited;
-end; //*** end of Destroy ***
-
-
-//***************************************************************************************
-// NAME: GetSegmentCount
-// PARAMETER: none
-// RETURN VALUE: Count of data segments.
-// DESCRIPTION: Getter for the count of data segments with firmware data.
-//
-//***************************************************************************************
-function TFirmwareData.GetSegmentCount: Integer;
-begin
- Result := FSegmentList.Count;
-end; //*** end of GetSegmentCount ***
-
-
-//***************************************************************************************
-// NAME: GetSegment
-// PARAMETER: index Index of the data segment to get.
-// RETURN VALUE: Data segment if successful, nil otherwise.
-// DESCRIPTION: Getter for a data segment at the specified index.
-//
-//***************************************************************************************
-function TFirmwareData.GetSegment(index: Integer): TDataSegment;
-begin
- Result := nil;
- if (index >= 0) and (index < FSegmentList.Count) then
- Result := FSegmentList[index];
-end; //*** end of GetSegment ***
-
-
-//***************************************************************************************
-// NAME: FirmwareDataCompareSegments
-// PARAMETER: Item1 First item for the comparison.
-// Item2 Second item for the comparison.
-// RETURN VALUE: 1 if Item1's identifier is larger, -1 if Item1's identifier is
-// smaller, 0 if the identifiers are equal.
-// DESCRIPTION: Custom sorting routine for the entries in filter.
-//
-//***************************************************************************************
-function FirmwareDataCompareSegments(Item1, Item2: Pointer): Integer;
-begin
- Result := TDataSegment(Item1).BaseAddress - TDataSegment(Item2).BaseAddress;
-end; //*** end of FirmwareDataCompareSegments ***
-
-
-//***************************************************************************************
-// NAME: SortSegments
-// PARAMETER: none
-// RETURN VALUE: none
-// DESCRIPTION: Sorts the segments based on the base address of the segment.
-//
-//***************************************************************************************
-procedure TFirmwareData.SortSegments;
-begin
- FSegmentList.Sort(@FirmwareDataCompareSegments);
-end; //*** end of SortSegments ***
-
-
-//***************************************************************************************
-// NAME: FindSegmentIdx
-// PARAMETER: address Address to match
-// RETURN VALUE: Segment index if found, -1 otherwise.
-// DESCRIPTION: Searches for a segment that contains the specified address.
-//
-//***************************************************************************************
-function TFirmwareData.FindSegmentIdx(address: Longword): Integer;
-var
- segmentIdx: Integer;
-begin
- Result := -1;
- // loop through segments
- for segmentIdx := 0 to (GetSegmentCount - 1) do
- begin
- // does this address fall into this segment?
- if (address >= FSegmentList[segmentIdx].BaseAddress) and (address <= FSegmentList[segmentIdx].LastAddress) then
- begin
- // match found
- Result := segmentIdx;
- // no need to continue loop
- Break;
- end;
- end;
-end; //*** end of FindSegmentIdx ***
-
-
-//***************************************************************************************
-// NAME: FindPrevSegmentIdx
-// PARAMETER: address Address to match
-// RETURN VALUE: Segment index if found, -1 otherwise.
-// DESCRIPTION: Searches for the previous segment. So a segment who's lastaddress is
-// closest to the specified address.
-//
-//***************************************************************************************
-function TFirmwareData.FindPrevSegmentIdx(address: Longword): Integer;
-var
- segmentIdx: Integer;
-begin
- Result := -1;
- // loop through segments and keep in mind that they are ordered by increasing memory
- // addresses
- for segmentIdx := (GetSegmentCount - 1) downto 0 do
- begin
- if FSegmentList[segmentIdx].LastAddress < address then
- begin
- // match found
- Result := segmentIdx;
- Break;
- end;
- end;
-end; //*** end of FindPrevSegmentIdx ***
-
-
-//***************************************************************************************
-// NAME: FindNextSegmentIdx
-// PARAMETER: address Address to match
-// RETURN VALUE: Segment index if found, -1 otherwise.
-// DESCRIPTION: Searches for the next segment. So a segment who's baseaddress is
-// closest to the specified address.
-//
-//***************************************************************************************
-function TFirmwareData.FindNextSegmentIdx(address: Longword): Integer;
-var
- segmentIdx: Integer;
-begin
- Result := -1;
- // loop through segments and keep in mind that they are ordered by increasing memory
- // addresses
- for segmentIdx := 0 to (GetSegmentCount - 1) do
- begin
- if FSegmentList[segmentIdx].BaseAddress > address then
- begin
- // match found
- Result := segmentIdx;
- Break;
- end;
- end;
-end; //*** end of FindNextSegmentIdx ***
-
-
-//***************************************************************************************
-// NAME: GetFirmwareFileType
-// PARAMETER: firmwareFile Filename with path of the file to check.
-// RETURN VALUE: The type of the firmware file.
-// DESCRIPTION: Determines the type of the firmware file.
-//
-//***************************************************************************************
-function TFirmwareData.GetFirmwareFileType(firmwareFile: String): TFirmwareFileType;
-begin
- // init result to unknown file type
- Result := FFT_UNKNOWN;
-
- // check if the file is formatted as an S-Record
- if TSRecordFileHandler.IsSRecordFile(firmwareFile) then
- Result := FFT_SRECORD;
-end; //*** end of GetFirmwareFileType ***
-
-
-//***************************************************************************************
-// NAME: FirmwareFileDataRead
-// PARAMETER: sender Object that triggered the event
-// data Array with data bytes that were read.
-// length Number of data bytes that were read.
-// address Start memory address that the bytes belong to.
-// RETURN VALUE: none
-// DESCRIPTION: Callback for when data was read from a firmware file during loading.
-//
-//***************************************************************************************
-procedure TFirmwareData.FirmwareFileDataRead(sender: TObject; data: array of Byte; length: Integer; address: Longword);
-begin
- // add the newly read firmware data
- AddData(data, length, address);
-end; //*** end of FirmwareFileDataRead ***
-
-
-//***************************************************************************************
-// NAME: AddData
-// PARAMETER: data Array with bytes to add.
-// length Number of bytes in the array.
-// address Address where to start adding bytes.
-// RETURN VALUE: True is successful, False otherwise.
-// DESCRIPTION: Adds firmware data to the data segments. Segments are automatically
-// created and joined where needed.
-//
-//***************************************************************************************
-function TFirmwareData.AddData(data: array of Byte; length: Integer; address: Longword): Boolean;
-var
- firstSegmentIdx: Integer;
- lastSegmentIdx: Integer;
- segmentIdx: Integer;
- joinedData: array of Byte;
- joinedSize: Integer;
- byteIdx: Integer;
-begin
- Result := True;
-
- // find the starting and ending segment index
- firstSegmentIdx := FindSegmentIdx(address);
- lastSegmentIdx := FindSegmentIdx(address + Longword(length) - 1);
-
- // try to snap segments if they are directly next to another one
- if firstSegmentIdx = -1 then
- begin
- segmentIdx := FindPrevSegmentIdx(address);
- if segmentIdx <> - 1 then
- begin
- if address = (FSegmentList[segmentIdx].LastAddress + 1) then
- firstSegmentIdx := segmentIdx;
- end;
- end;
- if lastSegmentIdx = -1 then
- begin
- segmentIdx := FindNextSegmentIdx(address + Longword(length) - 1);
- if segmentIdx <> - 1 then
- begin
- if (address + Longword(length)) = FSegmentList[segmentIdx].BaseAddress then
- lastSegmentIdx := segmentIdx;
- end;
- end;
-
- // begin and end belongs to existing segments?
- if (firstSegmentIdx <> -1) and (lastSegmentIdx <> -1) then
- begin
- // create new data array with a copy of the first segment at the start and a copy
- // of the last segment at the end.
- joinedSize := (FSegmentList[lastSegmentIdx].LastAddress + 1) - FSegmentList[firstSegmentIdx].BaseAddress;
- SetLength(joinedData, joinedSize);
- for byteIdx := 0 to (FSegmentList[firstSegmentIdx].Size - 1) do
- joinedData[byteIdx] := FSegmentList[firstSegmentIdx].Data[byteIdx];
- for byteIdx := 0 to (FSegmentList[lastSegmentIdx].Size - 1) do
- joinedData[(joinedSize - FSegmentList[lastSegmentIdx].Size) + byteIdx] := FSegmentList[lastSegmentIdx].Data[byteIdx];
- // now remove the affected segments in preparation to replace them with 1 big new one
- // but not the first one, because this one will be resized to be a big one that holds
- // all the data. keep in mind that the indexes change after deleting a segment, so
- // the to be deleted segment is always at index firstSegmentIdx + 1
- for segmentIdx := (firstSegmentIdx + 1) to lastSegmentIdx do
- begin
- FSegmentList.Delete(firstSegmentIdx + 1);
- end;
- // add the backed up data to the first segment, which will automatically be expanded
- Result := FSegmentList[firstSegmentIdx].Add(joinedData, joinedSize, FSegmentList[firstSegmentIdx].BaseAddress);
- // now add the actual data
- if Result then
- Result := FSegmentList[firstSegmentIdx].Add(data, length, address);
- // release array
- SetLength(joinedData, 0);
- // make sure segments are properly sorted
- SortSegments;
- // all done
- Exit;
- end;
-
- // begin and end do not belong to existing segments
- if (firstSegmentIdx = -1) and (lastSegmentIdx = -1) then
- begin
- // it could be there there are existing segments between the range that should be
- // removed. try to match the first and last segment index to snap to these.
- firstSegmentIdx := FindNextSegmentIdx(address);
- lastSegmentIdx := FindPrevSegmentIdx(address + Longword(length) - 1);
- // if these are both valid values, then there are segments in between that should
- // be removed
- if (firstSegmentIdx <> -1) and (lastSegmentIdx <> -1) then
- begin
- // remove the segments. keep in mind that the indexes change after deleting a
- // segment, so the to be deleted segment is always at index firstSegmentIdx
- for segmentIdx := firstSegmentIdx to lastSegmentIdx do
- begin
- FSegmentList.Delete(firstSegmentIdx);
- end;
- end;
- // now add the data as a new segment
- segmentIdx := FSegmentList.Add(TDataSegment.Create);
- if segmentIdx >= 0 then
- Result := FSegmentList[segmentIdx].Add(data, length, address)
- else
- Result := False;
- // make sure segments are properly sorted
- SortSegments;
- // all done
- Exit;
- end;
-
- // begin belongs to existing segments but the end does not?
- if (firstSegmentIdx <> -1) and (lastSegmentIdx = -1) then
- begin
- // snap last segment to the closest known one
- lastSegmentIdx := FindPrevSegmentIdx(address + Longword(length) - 1);
- // remove the overlapping segments, excluding the first one. keep in mind that the
- // indexes change after deleting a segment, so the to be deleted segment is always at
- // index firstSegmentIdx + 1
- for segmentIdx := (firstSegmentIdx + 1) to lastSegmentIdx do
- begin
- FSegmentList.Delete(firstSegmentIdx + 1);
- end;
- // now add the data to the first segment, which will automatically expand it
- Result := FSegmentList[firstSegmentIdx].Add(data, length, address);
- // make sure segments are properly sorted
- SortSegments;
- // all done
- Exit;
- end;
-
- // begin does not belong to an existing segment but the end does
- if (firstSegmentIdx = -1) and (lastSegmentIdx <> -1) then
- begin
- // snap first segment to the closest known one
- firstSegmentIdx := FindNextSegmentIdx(address);
- // remove the overlapping segments, excluding the last one. keep in mind that the
- // indexes change after deleting a segment, so the to be deleted segment is always at
- // index firstSegmentIdx
- for segmentIdx := firstSegmentIdx to (lastSegmentIdx - 1) do
- begin
- FSegmentList.Delete(firstSegmentIdx);
- end;
- // note that last segment index changed because we deleted segments so refresh it
- lastSegmentIdx := FindSegmentIdx(address + Longword(length) - 1);
- // try to snap it
- if lastSegmentIdx = -1 then
- begin
- segmentIdx := FindNextSegmentIdx(address + Longword(length) - 1);
- if segmentIdx <> - 1 then
- begin
- if (address + Longword(length)) = FSegmentList[segmentIdx].BaseAddress then
- lastSegmentIdx := segmentIdx;
- end;
- end;
- // now add the data to the first last, which will automatically expand it
- if lastSegmentIdx <> -1 then
- begin
- Result := FSegmentList[lastSegmentIdx].Add(data, length, address);
- end
- else
- begin
- Result := False;
- end;
- // make sure segments are properly sorted
- SortSegments;
- // all done
- Exit;
- end;
-end; //*** end of AddData ***
-
-
-//***************************************************************************************
-// NAME: RemoveData
-// PARAMETER: length Number of bytes to remove.
-// address Address where to start removing from.
-// RETURN VALUE: True is successful, False otherwise.
-// DESCRIPTION: Removes firmware data from the data segments.
-//
-//***************************************************************************************
-function TFirmwareData.RemoveData(length: Integer; address: Longword): Boolean;
-var
- firstSegmentIdx: Integer;
- lastSegmentIdx: Integer;
- segmentDelCnt: Integer;
- segmentIdx: Integer;
- byteIdx: Integer;
- remainderData: array of Byte;
- remainderLen: Integer;
- remainderAddr: Longword;
-begin
- Result := True;
-
- // find the starting and ending segment index
- firstSegmentIdx := FindSegmentIdx(address);
- lastSegmentIdx := FindSegmentIdx(address + Longword(length) - 1);
-
- // in case the start and end is not in a segment, try to align it to the closest one
- if firstSegmentIdx = -1 then
- firstSegmentIdx := FindNextSegmentIdx(address);
- if lastSegmentIdx = -1 then
- lastSegmentIdx := FindPrevSegmentIdx(address + Longword(length) - 1);
-
- // after the align operation both indexes must be valid, otherwise there are no
- // segments to remove, which means we are done already
- if (firstSegmentIdx = -1) or (lastSegmentIdx = -1) then
- Exit;
-
- // check if a segment split is needed, which is a special case and should be done first
- if (firstSegmentIdx = lastSegmentIdx) and
- (address > FSegmentList[firstSegmentIdx].BaseAddress) and
- ((address + Longword(length) - 1) < FSegmentList[lastSegmentIdx].LastAddress) then
- begin
- // copy remainder data after the split to a temporary buffer
- remainderAddr := address + Longword(length);
- remainderLen := (FSegmentList[firstSegmentIdx].LastAddress + 1) - remainderAddr;
- SetLength(remainderData, remainderLen);
- for byteIdx := 0 to (remainderLen - 1) do
- remainderData[byteIdx] := FSegmentList[firstSegmentIdx].Data[(FSegmentList[firstSegmentIdx].Size - remainderLen) + byteIdx];
- // create a new segment where the remainder data will be copied to
- segmentIdx := FSegmentList.Add(TDataSegment.Create);
- if segmentIdx >= 0 then
- Result := FSegmentList[segmentIdx].Add(remainderData, remainderLen, remainderAddr)
- else
- begin
- // this should not happen and indicates a severe error
- Result := False;
- end;
- // the part after the split can be safely removed no. by removing the length of the
- // segment, it is guaranteerd that the remainder after the split is also removed
- if Result then
- begin
- Result := FSegmentList[firstSegmentIdx].Remove(FSegmentList[firstSegmentIdx].Size, address);
- end;
- // a segment was added so perform sorting
- SortSegments;
- // all done
- Exit;
- end;
-
- // begin and end belongs to existing segments? note that this should always be the
- // case because of the segment alignment that is performed at the start.
- if (firstSegmentIdx <> -1) and (lastSegmentIdx <> -1) then
- begin
- // remove bytes from the end of the first segment. note that the remove will only
- // operates on the specified segment so no need to worry that it removes too many
- Result := FSegmentList[firstSegmentIdx].Remove(length, address);
- // remove bytes from the end of the last segment. note that the remove will only
- // operates on the specified segment so no need to worry that it removes too many
- if Result then
- Result := FSegmentList[lastSegmentIdx].Remove(length, address);
- // remove overlapping segments if any, but not the first and the last one. keep in
- // mind that the indexes change after deleting a segment so the to be deleted segment
- // is always firstSegmentIdx + 1
- if Result then
- begin
- segmentDelCnt := 0;
- for segmentIdx := (firstSegmentIdx + 1) to (lastSegmentIdx - 1) do
- begin
- FSegmentList.Delete(firstSegmentIdx + 1);
- segmentDelCnt := segmentDelCnt + 1;
- end;
- // refresh last segment index
- lastSegmentIdx := lastSegmentIdx - segmentDelCnt;
- // check if last segment is now empty and delete it if so
- if FSegmentList[lastSegmentIdx].Size = 0 then
- FSegmentList.Delete(lastSegmentIdx);
- // check if first segment is now empty and delete it if so
- if FSegmentList[firstSegmentIdx].Size = 0 then
- FSegmentList.Delete(firstSegmentIdx);
- end;
- // no need to sort again so all done
- Exit;
- end;
-end; //*** end of RemoveData ***
-
-
-//***************************************************************************************
-// NAME: ClearData
-// PARAMETER: none
-// RETURN VALUE: none
-// DESCRIPTION: Clear all segments with firmware data.
-//
-//***************************************************************************************
-procedure TFirmwareData.ClearData;
-begin
- FSegmentList.Clear;
-end; //*** end of ClearData ***
-
-
-//***************************************************************************************
-// NAME: LoadFromFile
-// PARAMETER: firmwareFile Filename with full path of the firmware file to load.
-// append True to append the firmware data to what is currently loaded,
-// False to clear the current firmware data first.
-// RETURN VALUE: True if successful, False otherwise.
-// DESCRIPTION: Loads firmware data from a firmware file.
-//
-//***************************************************************************************
-function TFirmwareData.LoadFromFile(firmwareFile: String; append: Boolean): Boolean;
-var
- firmwareFileType: TFirmwareFileType;
- firmwareFileHandler: TFirmwareFileHandler;
-begin
-
- // init locals and the result
- Result := False;
- firmwareFileHandler := nil;
-
- // determine firmware file type
- firmwareFileType := GetFirmwareFileType(firmwareFile);
-
- // check if the file type is an S-record and if so, load it
- if firmwareFileType = FFT_SRECORD then
- begin
- // create instance of the firmware file handler
- firmwareFileHandler := TSRecordFileHandler.Create;
- end;
-
- // check if the firmware file handler object was instantiated, which flags that a
- // firmware file can be loaded through it
- if Assigned(firmwareFileHandler) then
- begin
- // clear the current firmware data if we should not append the new data from the file
- if not append then
- begin
- ClearData;
- end;
-
- // set onload handler which does the actual data processing
- {$IFDEF FPC}
- firmwareFileHandler.OnDataRead := @FirmwareFileDataRead;
- {$ELSE}
- firmwareFileHandler.OnDataRead := FirmwareFileDataRead;
- {$ENDIF}
- // load data from the file
- Result := firmwareFileHandler.Load(firmwareFile);
-
- // release instance of the firmware file handler
- firmwareFileHandler.Free
- end;
-end; //*** end of LoadFromFile ***
-
-
-//***************************************************************************************
-// NAME: SaveToFile
-// PARAMETER: firmwareFile Filename with full path of the firmware file to save.
-// firwareFileType Firmware file type to use when saving.
-// RETURN VALUE: True if successful, False otherwise.
-// DESCRIPTION: Saves firmware data to a firmware file of the specified format.
-//
-//***************************************************************************************
-function TFirmwareData.SaveToFile(firmwareFile: String; firmwareFileType: TFirmwareFileType): Boolean;
-var
- firmwareFileHandler: TFirmwareFileHandler;
-begin
- // init result
- Result := False;
-
- // check if the file type is an S-record and if so, save it
- if firmwareFileType = FFT_SRECORD then
- begin
- // create instance of the firmware file handler
- firmwareFileHandler := TSRecordFileHandler.Create;
- // perform firmware file save operation
- Result := firmwareFileHandler.Save(firmwareFile, FSegmentList);
- // release the firmware file handler
- firmwareFileHandler.Free;
- end
- // check if the file type is a binary file and if so, save it
- else if firmwareFileType = FFT_BINARY then
- begin
- // create instance of the firmware file handler
- firmwareFileHandler := TBinaryFileHandler.Create;
- // perform firmware file save operation
- Result := firmwareFileHandler.Save(firmwareFile, FSegmentList);
- // release the firmware file handler
- firmwareFileHandler.Free;
- end;
-end; //*** end of SaveToFile ***
-
-
-//***************************************************************************************
-// NAME: Dump
-// PARAMETER: none
-// RETURN VALUE: none
-// DESCRIPTION: Dumps the segment contents to the standard output for debugging
-// purposes.
-//
-//***************************************************************************************
-procedure TFirmwareData.Dump;
-{$IFDEF DEBUG}
-var
- segmentIdx: Integer;
-{$ENDIF}
-begin
- {$IFDEF DEBUG}
- for segmentIdx := 0 to (SegmentCount - 1) do
- begin
- Writeln('Segment index = ' + IntToStr(segmentIdx));
- Segment[segmentIdx].Dump;
- end;
- {$ENDIF}
-end; //*** end of DumpFirmwareData ***
-
-
-end.
-//******************************** end of FirmwareData.pas ******************************
-
diff --git a/Host/Source/MicroBoot/interfaces/XcpIcon.png b/Host/Source/MicroBoot/interfaces/XcpIcon.png
deleted file mode 100644
index 6c0e1944..00000000
Binary files a/Host/Source/MicroBoot/interfaces/XcpIcon.png and /dev/null differ
diff --git a/Host/Source/MicroBoot/interfaces/XcpLoader.pas b/Host/Source/MicroBoot/interfaces/XcpLoader.pas
deleted file mode 100644
index 299f9876..00000000
--- a/Host/Source/MicroBoot/interfaces/XcpLoader.pas
+++ /dev/null
@@ -1,1306 +0,0 @@
-unit XcpLoader;
-//***************************************************************************************
-// Description: XCP Master Communication Protocol Layer for Bootloader.
-// File Name: XcpLoader.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, XcpTransport, XcpProtection, IniFiles;
-
-//***************************************************************************************
-// Global Constants
-//***************************************************************************************
-// XCP command codes
-const kCmdCONNECT = $FF;
-const kCmdDISCONNECT = $FE;
-const kCmdGET_STATUS = $FD;
-const kCmdSYNCH = $FC;
-const kCmdGET_ID = $FA;
-const kCmdGET_SEED = $F8;
-const kCmdUNLOCK = $F7;
-const kCmdSET_MTA = $F6;
-const kCmdUPLOAD = $F5;
-const kCmdSHORT_UPLOAD = $F4;
-const kCmdBUILD_CHECKSUM = $F3;
-const kCmdDOWNLOAD = $F0;
-const kCmdDOWNLOAD_MAX = $EE;
-const kCmdSET_CAL_PAGE = $EB;
-const kCmdGET_CAL_PAGE = $EA;
-const kCmdPROGRAM_START = $D2;
-const kCmdPROGRAM_CLEAR = $D1;
-const kCmdPROGRAM = $D0;
-const kCmdPROGRAM_RESET = $CF;
-const kCmdPROGRAM_PREPARE = $CC;
-const kCmdPROGRAM_MAX = $C9;
-
-// XCP command response packet IDs
-const kCmdPidRES = $FF; // positive response packet
-const kCmdPidERR = $FE; // error packet
-const kCmdPidEV = $FD; // event packet
-const kCmdPidSERV = $FC; // service request packet
-
-// XCP resources
-const kResPGM = $10; // programming resource
-
-// XCP error codes
-const kErrCMD_SYNCH = $00; // Command processor synchronization
-const kErrCMD_BUSY = $10; // Command was not executed.
-const kErrDAQ_ACTIVE = $11; // Command rejected because DAQ is running.
-const kErrPGM_ACTIVE = $12; // Command rejected because PGM is running.
-const kErrCMD_UNKNOWN = $20; // Unknown command or not implemented optional command.
-const kErrCMD_SYNTAX = $21; // Command syntax invalid
-const kErrOUT_OF_RANGE = $22; // Command syntax valid but command parameter(s) out of range.
-const kErrWRITE_PROTECTED = $23; // The memory location is write protected.
-const kErrACCESS_DENIED = $24; // The memory location is not accessible.
-const kErrACCESS_LOCKED = $25; // Access denied, Seed & Key is required
-const kErrPAGE_NOT_VALID = $26; // Selected page not available
-const kErrMODE_NOT_VALID = $27; // Selected page mode not available
-const kErrSEGMENT_NOT_VALID = $28; // Selected segment not valid
-const kErrSEQUENCE = $29; // Sequence error
-const kErrDAQ_CONFIG = $2A; // DAQ configuration not valid
-const kErrMEMORY_OVERFLOW = $30; // Memory overflow error
-const kErrGENERIC = $31; // Generic error
-const kErrVERIFY = $32; // The slave internal program verify routine detects an error.
-
-// Feaser error Codes
-const kErrFsrExecuteCmd = $80; // Could not execute command
-const kErrFsrResourceUnavailable = $81; // Resource needed but not available
-const kErrFsrSeedKeyDllInvalid = $82; // Seed/Key DLL is invalid
-const kErrFsrKeyAlgoMissing = $83; // Key computation algorithm is missing
-
-// Start programming session return codes
-const kProgSessionStarted = 0;
-const kProgSessionUnlockError = 1;
-const kProgSessionGenericError = 2;
-
-
-//***************************************************************************************
-// Type Definitions
-//***************************************************************************************
-type
- TXcpLoader = class(TObject)
- private
- FIsConnected : Boolean;
- FTimerInterval : array[1..7] of Word;
- FConnectCmdTimer : Word;
- FConnectMode : Byte;
- FIsIntel : Boolean;
- FCtoPacketLen : Byte;
- FCtoPGMPacketLen : Byte;
- FDtoPacketLen : Word;
- FSeedKeyDll : string;
- FLastError : Byte;
- FResources : Byte;
- FProtection : Byte;
- FMta : LongWord;
- procedure WaitT7;
- function GetOrderedWord(data : PByteArray) : Word;
- procedure SetOrderedLong(value: LongWord; data : PByteArray);
- function SendSynchedPacket(timeMs : Word; useMta : Boolean) : Boolean;
- function CmdSynch(useMta : Boolean) : Boolean;
- function CmdConnect(mode: Byte) : Boolean;
- function CmdDisconnect : Boolean;
- function CmdProgramStart : Boolean;
- function CmdGetStatus : Boolean;
- function CmdGetSeed(seed : PByteArray; resource : Byte; var len : Byte) : Boolean;
- function CmdUnlock(key : PByteArray; len : Byte) : Boolean;
- function CmdProgramReset : Boolean;
- function CmdProgram(data : PByteArray; len : Byte) : Boolean;
- function CmdProgramMax(data : PByteArray) : Boolean;
- function CmdSetMta(addr : LongWord) : Boolean;
- function CmdProgramClear(len : LongWord) : Boolean;
- public
- comDriver : TXcpTransport;
- constructor Create;
- destructor Destroy; override;
- function GetLastError(var info : string) : Byte;
- procedure Configure(iniFile : string);
- function Connect : Boolean;
- function IsComError : Boolean;
- procedure Disconnect;
- function StartProgrammingSession : Byte;
- function StopProgrammingSession : Boolean;
- function ClearMemory(addr : LongWord; len : LongWord) : Boolean;
- function WriteData(addr : LongWord; len : LongWord; data : PByteArray) : Boolean;
- end;
-
-
-implementation
-//***************************************************************************************
-// NAME: Create
-// PARAMETER: none
-// RETURN VALUE: none
-// DESCRIPTION: Class constructor
-//
-//***************************************************************************************
-constructor TXcpLoader.Create;
-begin
- // call inherited constructor
- inherited Create;
-
- // reset error
- FLastError := 0;
-
- // reset memory transfer address
- FMta := 0;
-
- // not connected upon creation
- FIsConnected := false;
-
- // reset seed/key dll filename
- FSeedKeyDll := '';
-
- // set communication defaults
- FIsIntel := False; // motorola byte order by default
- FResources := 0; // no resources available
- FProtection := 0; // all resources unprotected by default
-
- // set XCP packet length defaults
- FCtoPacketLen := 8; // must be at least 8 for connect command response
- FDtoPacketLen := 8;
- FCtoPGMPacketLen := 8;
-
- // set interval time defaults
- FTimerInterval[1] := 1000; // t1 = 1000ms - standard command timeout
- FTimerInterval[2] := 2000; // t2 = 2000ms - build checksum timeout
- FTimerInterval[3] := 2000; // t3 = 2000ms - program start timeout
- FTimerInterval[4] := 10000; // t4 = 10000ms - erase timeout
- FTimerInterval[5] := 1000; // t5 = 1000ms - write and reset timeout
- FTimerInterval[6] := 1000; // t6 = 1000ms - user specific connect
- FTimerInterval[7] := 2000; // t7 = 2000ms - wait timer
- // the connect command does not have a protocol specified timeout value. However, this
- // timeout is important for the OpenBLT timed backdoor feature. The backdoor time should
- // be at least 2.5 times the length of this timeout value.
- FConnectCmdTimer := 20; // 20 ms - connect command
- // set default connection mode
- FConnectMode := 0;
-
- // create instance of XCP transport layer object
- comDriver := TXcpTransport.Create;
-end; //*** end of Create ***
-
-
-//***************************************************************************************
-// NAME: Destroy
-// PARAMETER: none
-// RETURN VALUE: none
-// DESCRIPTION: Class destructor
-//
-//***************************************************************************************
-destructor TXcpLoader.Destroy;
-begin
- // disconnect the XCP transport layer
- comDriver.Disconnect;
-
- // release XCP transport layer object
- comDriver.Free;
-
- // call inherited destructor
- inherited;
-end; //*** end of Destroy ***
-
-
-//***************************************************************************************
-// NAME: WaitRoutine
-// PARAMETER: number of milliseconds to wait
-// RETURN VALUE: none
-// DESCRIPTION: Basic routine that waits for the specified amount of time before
-// continueing.
-//
-//***************************************************************************************
-procedure TXcpLoader.WaitT7;
-begin
- Sleep(FTimerInterval[7]);
-end; //*** end of WaitRoutine ***
-
-
-//***************************************************************************************
-// NAME: GetOrderedWord
-// PARAMETER: pointer to byte array
-// RETURN VALUE: word value
-// DESCRIPTION: Returns the word value from the byte array taking into account Intel
-// or Motorola byte ordering.
-//
-//***************************************************************************************
-function TXcpLoader.GetOrderedWord(data : PByteArray) : Word;
-begin
- result := 0;
-
- if FIsIntel then
- begin
- result := result or (data[1] shl 8);
- result := result or (data[0]);
- end
- else
- begin
- result := result or (data[0] shl 8);
- result := result or (data[1]);
- end;
-end; //*** end of GetOrderedWord ***
-
-
-//***************************************************************************************
-// NAME: SetOrderedLong
-// PARAMETER: pointer to byte array and 32-bit value
-// RETURN VALUE: none
-// DESCRIPTION: Stores a 32-bit value into a byte buffer taking into account Intel
-// or Motorola byte ordering.
-//
-//***************************************************************************************
-procedure TXcpLoader.SetOrderedLong(value: LongWord; data : PByteArray);
-begin
- if FIsIntel then
- begin
- data[3] := Byte(value shr 24);
- data[2] := Byte(value shr 16);
- data[1] := Byte(value shr 8);
- data[0] := Byte(value);
- end
- else
- begin
- data[0] := Byte(value shr 24);
- data[1] := Byte(value shr 16);
- data[2] := Byte(value shr 8);
- data[3] := Byte(value);
- end;
-end; //*** end of SetOrderedLong ***
-
-
-//***************************************************************************************
-// NAME: GetLastError
-// PARAMETER: destination string from error information
-// RETURN VALUE: error code
-// DESCRIPTION: Return the last error value.
-//
-//***************************************************************************************
-function TXcpLoader.GetLastError(var info : string) : Byte;
-begin
- // set info string
- case FLastError of
- kErrCMD_SYNCH : info := '0x00 - Command processor synchronization';
- kErrCMD_BUSY : info := '0x10 - Command was not executed';
- kErrDAQ_ACTIVE : info := '0x11 - Command rejected because DAQ is running';
- kErrPGM_ACTIVE : info := '0x12 - Command rejected because PGM is running';
- kErrCMD_UNKNOWN : info := '0x20 - Unknown command or not implemented optional command';
- kErrCMD_SYNTAX : info := '0x21 - Command syntax invalid';
- kErrOUT_OF_RANGE : info := '0x22 - Command syntax valid but command parameter(s) out of range';
- kErrWRITE_PROTECTED : info := '0x23 - The memory location is write protected';
- kErrACCESS_DENIED : info := '0x24 - The memory location is not accessible';
- kErrACCESS_LOCKED : info := '0x25 - Access denied, Seed & Key is required';
- kErrPAGE_NOT_VALID : info := '0x26 - Selected page not available';
- kErrMODE_NOT_VALID : info := '0x27 - Selected page mode not available';
- kErrSEGMENT_NOT_VALID : info := '0x28 - Selected segment not valid';
- kErrSEQUENCE : info := '0x29 - Sequence error';
- kErrDAQ_CONFIG : info := '0x2A - DAQ configuration not valid';
- kErrMEMORY_OVERFLOW : info := '0x30 - Memory overflow error';
- kErrGENERIC : info := '0x31 - Generic error';
- kErrVERIFY : info := '0x32 - The slave internal program verify routine detects an error';
- kErrFsrExecuteCmd : info := '0x80 - Could not execute command';
- kErrFsrResourceUnavailable: info := '0x81 - Resource needed but not available';
- kErrFsrSeedKeyDllInvalid : info := '0x82 - Seed/Key DLL is invalid';
- kErrFsrKeyAlgoMissing : info := '0x83 - Key computation algorithm is missing';
- end;
-
- // return the error code
- result := FLastError;
-end; //*** end of GetLastError ***
-
-
-//***************************************************************************************
-// NAME: Configure
-// PARAMETER: filename of the INI
-// RETURN VALUE: none
-// DESCRIPTION: Configures both this class and the transport layer from the settings
-// in the INI.
-//
-//***************************************************************************************
-procedure TXcpLoader.Configure(iniFile : string);
-var
- settingsIni : TIniFile;
- wasConnected : Boolean;
-begin
- // backup connection state
- wasConnected := FIsConnected;
-
- // disconnect
- if FIsConnected then DisConnect;
-
- // configure comDriver
- comDriver.Configure(iniFile);
-
- // read XCP configuration from INI
- if FileExists(iniFile) then
- begin
- // create ini file object
- settingsIni := TIniFile.Create(iniFile);
-
- FSeedKeyDll := settingsIni.ReadString('xcp', 'seedkey', ExtractFilePath(ParamStr(0))+'libseednkey.dll');
-
- // if no path specified, then assume dll is located in the executable's path
- if ExtractFilePath(FSeedKeyDll) = '' then
- FSeedKeyDll := ExtractFilePath(ParamStr(0))+FSeedKeyDll;
-
- FTimerInterval[1] := settingsIni.ReadInteger('xcp', 't1', 1000);
- FTimerInterval[3] := settingsIni.ReadInteger('xcp', 't3', 2000);
- FTimerInterval[4] := settingsIni.ReadInteger('xcp', 't4', 10000);
- FTimerInterval[5] := settingsIni.ReadInteger('xcp', 't5', 1000);
- FTimerInterval[7] := settingsIni.ReadInteger('xcp', 't7', 2000);
- FConnectCmdTimer := settingsIni.ReadInteger('xcp', 'tconnect', 20);
- FConnectMode := settingsIni.ReadInteger('xcp', 'connectmode', 0);
-
- // release ini file object
- settingsIni.Free;
- end;
-
- // restore connection
- if WasConnected then Connect;
-end; //*** end of Configure ***
-
-
-//***************************************************************************************
-// NAME: Connect
-// PARAMETER: none
-// RETURN VALUE: True if connected, False otherwise.
-// DESCRIPTION: Connects the XCP transport layer
-//
-//***************************************************************************************
-function TXcpLoader.Connect : Boolean;
-begin
- // connect the XCP transport layer
- if comDriver.Connect = true then
- begin
- FIsConnected := true;
- result := true;
- end
- else
- begin
- FIsConnected := false;
- result := false;
- end;
-end; //*** end of Connect ***
-
-
-//***************************************************************************************
-// NAME: Disconnect
-// PARAMETER: none
-// RETURN VALUE: none
-// DESCRIPTION: Disconnects the XCP transport layer
-//
-//***************************************************************************************
-procedure TXcpLoader.Disconnect;
-begin
- // disconnect the XCP transport layer
- FIsConnected := false;
- comDriver.Disconnect;
-end; //*** end of Disconnect ***
-
-
-//***************************************************************************************
-// NAME: IsComError
-// PARAMETER: none
-// RETURN VALUE: none
-// DESCRIPTION: Determines if a communication error is present in the transport layer.
-//
-//***************************************************************************************
-function TXcpLoader.IsComError : Boolean;
-begin
- result := comDriver.IsComError;
-end;
-
-
-//***************************************************************************************
-// NAME: SendSynchedPacket
-// PARAMETER: timeout time in ms and info if mta should be resend
-// RETURN VALUE: True is successful, False otherwise
-// DESCRIPTION: Sends out the XCP packet using the "2 Retry with SYNCH" method at
-// outlined in the XCP protocol error handling. in case an error
-// occurred, a FLastError will be set. If useMta = true then a SET_MTA
-// packet will be send right after the SYNCH packet.
-//
-//***************************************************************************************
-function TXcpLoader.SendSynchedPacket(timeMs : Word; useMta : Boolean) : Boolean;
-var
- dataCpy : array of Byte;
- cnt : Word;
-begin
- // init return value
- Result := false;
-
- // validate packet length. it must always be > 0
- if comDriver.packetLen = 0 then
- Exit;
-
- // make a copy of the packet data because the synch command could overwrite it
- SetLength(dataCpy, comDriver.packetLen);
- for cnt := 0 to comDriver.packetLen-1 do
- dataCpy[cnt] := comDriver.packetData[cnt];
-
- // send out the command with t1 timeout
- if not comDriver.SendPacket(timeMs) then
- begin
- CmdSynch(useMta); // perform pre-action for 1st retry
-
- // prepare to send the command packet again
- comDriver.packetLen := Length(dataCpy);
- for cnt := 0 to comDriver.packetLen-1 do
- comDriver.packetData[cnt] := dataCpy[cnt];
-
- if not comDriver.SendPacket(timeMs) then
- begin
- CmdSynch(useMta); // perform pre-action for 2nd and last retry
-
- // prepare to send the command packet again
- comDriver.packetLen := Length(dataCpy);
- for cnt := 0 to comDriver.packetLen-1 do
- comDriver.packetData[cnt] := dataCpy[cnt];
-
- if comDriver.SendPacket(timeMs) then
- result := true; // success
- end
- else
- result := true; // success
- end
- else
- result := true; // sucess
-
- if result = false then
- FLastError := kErrFsrExecuteCmd; // Could not execute command
-end; //*** end of SendSynchedPacket ***
-
-
-//***************************************************************************************
-// NAME: CmdSynch
-// PARAMETER: useMta is a SET_MTA should be included
-// RETURN VALUE: True is successful, False otherwise
-// DESCRIPTION: Sends out the synchronise command
-//
-//***************************************************************************************
-function TXcpLoader.CmdSynch(useMta : Boolean) : Boolean;
-begin
- // init return value
- Result := false;
-
- // prepare the command packet
- comDriver.packetData[0] := kCmdSYNCH;
- comDriver.packetLen := 1;
-
- // send out the command with t1 timeout
- if not comDriver.SendPacket(FTimerInterval[1]) then
- begin
- Exit;
- end;
-
- // is response an error packet as expected?
- if comDriver.packetData[0] = kCmdPidERR then
- begin
- // is it the expected processor synchronization error?
- if comDriver.packetData[1] = kErrCMD_SYNCH then
- begin
- result := true;
- end;
- end;
-
- // should MTA be resend aswell?
- if (useMta = true) and (result = true) then
- begin
- // prepare the command packet
- comDriver.packetData[0] := kCmdSET_MTA;
- comDriver.packetData[1] := 0; // reserved
- comDriver.packetData[2] := 0; // reserved
- comDriver.packetData[3] := 0; // address extension not supported
-
- // set address taking into account byte ordering
- SetOrderedLong(FMta, @comDriver.packetData[4]);
-
- comDriver.packetLen := 8;
-
- // send packet with SYNCH retry feature
- if not SendSynchedPacket(FTimerInterval[1], false) then
- begin
- result := false;
- Exit;
- end;
- end;
-end; //*** end of CmdSynch ***
-
-
-//***************************************************************************************
-// NAME: CmdConnect
-// PARAMETER: mode Connection mode.
-// RETURN VALUE: True is successful, False otherwise
-// DESCRIPTION: Connects the XCP slave to start the XCP session
-//
-//***************************************************************************************
-function TXcpLoader.CmdConnect(mode: Byte) : Boolean;
-begin
- // init return value
- Result := false;
-
- // prepare the connect command packet
- comDriver.packetData[0] := kCmdCONNECT;
- comDriver.packetData[1] := mode; // normal mode
- comDriver.packetLen := 2;
-
- // send out the command with 20ms timeout. note that this timeout is not required at
- // all by the XCP protocol. here it is set quite short to accomodate the OpenBTL
- // bootloader default backdoor entry feature
- if comDriver.SendPacket(FConnectCmdTimer) then
- begin
- // check to see if it was an error packet
- if comDriver.packetData[0] = kCmdPidERR then
- begin
- // store error and stop
- FLastError := comDriver.packetData[1];
- Exit;
- end;
-
- // store byte order configuration
- if (comDriver.packetData[2] and $01) = $00 then FIsIntel := true;
-
- // store available resources
- FResources := comDriver.packetData[1];
-
- // store cto packet length
- FCtoPacketLen := comDriver.packetData[3];
- FCtoPGMPacketLen := FCtoPacketLen;
-
- // store dto packet length
- FDtoPacketLen := GetOrderedWord(@comDriver.packetData[4]);
-
- // success
- result := true;
- end
- else
- begin
- FLastError := kErrFsrExecuteCmd; // Could not execute command;
- end;
-end; //*** end of CmdConnect ***
-
-
-//***************************************************************************************
-// NAME: CmdDisconnect
-// PARAMETER: none
-// RETURN VALUE: True is successful, False otherwise
-// DESCRIPTION: Disconnects the XCP slave to end the XCP session
-//
-//***************************************************************************************
-function TXcpLoader.CmdDisconnect : Boolean;
-begin
- // init return value
- Result := false;
-
- // prepare the disconnect command packet
- comDriver.packetData[0] := kCmdDISCONNECT;
- comDriver.packetLen := 1;
-
- // send packet with SYNCH retry feature
- if not SendSynchedPacket(FTimerInterval[1], false) then Exit;
-
- // was the response an error packet?
- if comDriver.packetData[0] = kCmdPidERR then
- begin
- // busy or programming active error received?
- if (comDriver.packetData[1] = kErrCMD_BUSY) or
- (comDriver.packetData[1] = kErrPGM_ACTIVE) then
- begin
- WaitT7; // wait the predescribed time
- result := CmdDisconnect; // repeat this command
- Exit;
- end
- else
- begin
- FLastError := comDriver.packetData[1]; // Store error info
- Exit;
- end;
- end;
-
- // no error so it must have been a positive response
- result := true;
-end; //*** end of CmdDisconnect ***
-
-
-//***************************************************************************************
-// NAME: CmdProgramStart
-// PARAMETER: none
-// RETURN VALUE: True is successful, False otherwise
-// DESCRIPTION: Informs the slave that programming of non volatile memory starts.
-//
-//***************************************************************************************
-function TXcpLoader.CmdProgramStart : Boolean;
-begin
- // init return value
- Result := false;
-
- // prepare the command packet
- comDriver.packetData[0] := kCmdPROGRAM_START;
- comDriver.packetLen := 1;
-
- // send packet with SYNCH retry feature
- if not SendSynchedPacket(FTimerInterval[3], false) then Exit;
-
- // was the response an error packet?
- if comDriver.packetData[0] = kCmdPidERR then
- begin
- // busy or programming active error received?
- if comDriver.packetData[1] = kErrCMD_BUSY then
- begin
- WaitT7; // wait the predescribed time
- result := CmdProgramStart; // repeat this command
- Exit;
- end
- else
- begin
- FLastError := comDriver.packetData[1]; // Store error info
- Exit;
- end;
- end;
-
- // no error so it must have been a positive response
- result := true;
-
- // update max cto packet length in programming mode if supported
- if comDriver.packetData[3] <> 0 then
- FCtoPGMPacketLen := comDriver.packetData[3];
-end; //*** end of CmdProgramStart ***
-
-
-//***************************************************************************************
-// NAME: CmdGetStatus
-// PARAMETER: none
-// RETURN VALUE: True is successful, False otherwise
-// DESCRIPTION: Obtains the resource protection info from the XCP slave
-//
-//***************************************************************************************
-function TXcpLoader.CmdGetStatus : Boolean;
-begin
- // init return value
- result := false;
-
- // prepare the get status command packet
- comDriver.packetData[0] := kCmdGET_STATUS;
- comDriver.packetLen := 1;
-
- // send packet with SYNCH retry feature
- if not SendSynchedPacket(FTimerInterval[1], false) then Exit;
-
- // was the response an error packet?
- if comDriver.packetData[0] = kCmdPidERR then
- begin
- FLastError := comDriver.packetData[1]; // Store error info
- Exit;
- end;
-
- // no error so it must have been a positive response. this response comes right after
- // the one from the connect command, which might be send out multiple time so make sure
- // that this is really a response to get_status by verifying its length.
- if comDriver.packetLen = 6 then
- begin
- result := true;
- end;
-
- // store protection info
- FProtection := comDriver.packetData[2];
-end; //*** end of CmdGetStatus ***
-
-
-//***************************************************************************************
-// NAME: CmdGetSeed
-// PARAMETER: seed destination buffer and the resource
-// RETURN VALUE: True is successful, False otherwise
-// DESCRIPTION: Obtains the seed from the specified resource
-//
-//***************************************************************************************
-function TXcpLoader.CmdGetSeed(seed : PByteArray; resource : Byte; var len : Byte) : Boolean;
-var
- cnt : byte;
-begin
- // init return value
- result := false;
-
- // prepare the get seed command packet
- comDriver.packetData[0] := kCmdGET_SEED;
- comDriver.packetData[1] := 0; // seeds of up to six bytes are supported
- comDriver.packetData[2] := resource;
- comDriver.packetLen := 3;
-
- // send packet with SYNCH retry feature
- if not SendSynchedPacket(FTimerInterval[1], false) then Exit;
-
- // was the response an error packet?
- if comDriver.packetData[0] = kCmdPidERR then
- begin
- // busy or programming active error received?
- if (comDriver.packetData[1] = kErrCMD_BUSY) or
- (comDriver.packetData[1] = kErrPGM_ACTIVE) then
- begin
- WaitT7; // wait the predescribed time
- result := CmdGetSeed(seed, resource, len); // repeat this command
- Exit;
- end
- else
- begin
- FLastError := comDriver.packetData[1]; // Store error info
- Exit;
- end;
- end;
-
- // no error so it must have been a positive response
- result := true;
-
- // now store the seed info
- len := comDriver.packetData[1];
- for cnt := 0 to len-1 do
- seed[cnt] := comDriver.packetData[cnt+2];
-end; //*** end of CmdGetSeed ***
-
-
-//***************************************************************************************
-// NAME: CmdUnlock
-// PARAMETER: key source buffer and key length
-// RETURN VALUE: True is successful, False otherwise
-// DESCRIPTION: Unlocks the resource by sending the key
-//
-//***************************************************************************************
-function TXcpLoader.CmdUnlock(key : PByteArray; len : Byte) : Boolean;
-var
- cnt : byte;
-begin
- // init return value
- result := false;
-
- // prepare the command packet
- comDriver.packetData[0] := kCmdUNLOCK;
- comDriver.packetData[1] := len; // key length
- for cnt := 0 to len-1 do
- comDriver.packetData[cnt+2] := key[cnt];
- comDriver.packetLen := len + 2;
-
- // send packet with SYNCH retry feature
- if not SendSynchedPacket(FTimerInterval[1], false) then Exit;
-
- // was the response an error packet?
- if comDriver.packetData[0] = kCmdPidERR then
- begin
- // busy or programming active error received?
- if (comDriver.packetData[1] = kErrCMD_BUSY) or
- (comDriver.packetData[1] = kErrPGM_ACTIVE) then
- begin
- WaitT7; // wait the predescribed time
- result := CmdUnlock(key, len); // repeat this command
- Exit;
- end
- else
- begin
- FLastError := comDriver.packetData[1]; // Store error info
- Exit;
- end;
- end;
-
- // no error so it must have been a positive response
- result := true;
-
- // store the new resource protection mask
- FProtection := comDriver.packetData[1];
-end; //*** end of CmdUnlock ***
-
-
-//***************************************************************************************
-// NAME: CmdProgramReset
-// PARAMETER: none
-// RETURN VALUE: True is successful, False otherwise
-// DESCRIPTION: Requests the ECU to perform a reset.
-//
-//***************************************************************************************
-function TXcpLoader.CmdProgramReset : Boolean;
-begin
- // init return value
- result := false;
-
- // prepare the command packet
- comDriver.packetData[0] := kCmdPROGRAM_RESET;
- comDriver.packetLen := 1;
-
- // send packet without SYNCH retry feature. ignore negative return value because this
- // command does not require a response
- if not comDriver.SendPacket(FTimerInterval[5]) then
- begin
- result := true; // ok to not have a response
- Exit; // no response to process to stop here
- end;
-
- // was the response an error packet?
- if comDriver.packetData[0] = kCmdPidERR then
- begin
- // busy or programming active error received?
- if (comDriver.packetData[1] = kErrCMD_BUSY) or
- (comDriver.packetData[1] = kErrPGM_ACTIVE) then
- begin
- WaitT7; // wait the predescribed time
- result := CmdProgramReset; // repeat this command
- Exit;
- end
- else
- begin
- FLastError := comDriver.packetData[1]; // Store error info
- Exit;
- end;
- end;
-
- // no error so it must have been a positive response
- result := true;
-end; //*** end of CmdProgramReset ***
-
-
-//***************************************************************************************
-// NAME: CmdProgram
-// PARAMETER: data source buffer and data length
-// RETURN VALUE: True is successful, False otherwise
-// DESCRIPTION: Programs the data into non-volatile memory
-//
-//***************************************************************************************
-function TXcpLoader.CmdProgram(data : PByteArray; len : Byte) : Boolean;
-var
- cnt : byte;
-begin
- // init return value
- result := false;
-
- // prepare the command packet
- comDriver.packetData[0] := kCmdPROGRAM;
- comDriver.packetData[1] := len; // key length
-
- if len > 0 then
- begin
- for cnt := 0 to len-1 do
- comDriver.packetData[cnt+2] := data[cnt];
- end;
- comDriver.packetLen := len + 2;
-
- // send packet with SYNCH retry feature
- if not SendSynchedPacket(FTimerInterval[5], true) then Exit;
-
- // was the response an error packet?
- if comDriver.packetData[0] = kCmdPidERR then
- begin
- // busy or programming active error received?
- if (comDriver.packetData[1] = kErrCMD_BUSY) then
- begin
- WaitT7; // wait the predescribed time
- result := CmdProgram(data, len); // repeat this command
- Exit;
- end
- else
- begin
- FLastError := comDriver.packetData[1]; // Store error info
- Exit;
- end;
- end;
-
- // no error so it must have been a positive response
- result := true;
-end; //*** end of CmdProgram ***
-
-
-//***************************************************************************************
-// NAME: CmdProgramMax
-// PARAMETER: data source buffer
-// RETURN VALUE: True is successful, False otherwise
-// DESCRIPTION: Programs the data into non-volatile memory
-//
-//***************************************************************************************
-function TXcpLoader.CmdProgramMax(data : PByteArray) : Boolean;
-var
- cnt : byte;
-begin
- // init return value
- result := false;
-
- // prepare the command packet
- comDriver.packetData[0] := kCmdPROGRAM_MAX;
- for cnt := 0 to FCtoPGMPacketLen-2 do
- comDriver.packetData[cnt+1] := data[cnt];
- comDriver.packetLen := FCtoPGMPacketLen;
-
- // send packet with SYNCH retry feature
- if not SendSynchedPacket(FTimerInterval[5], true) then Exit;
-
- // was the response an error packet?
- if comDriver.packetData[0] = kCmdPidERR then
- begin
- // busy or programming active error received?
- if (comDriver.packetData[1] = kErrCMD_BUSY) then
- begin
- WaitT7; // wait the predescribed time
- result := CmdProgramMax(data); // repeat this command
- Exit;
- end
- else
- begin
- FLastError := comDriver.packetData[1]; // Store error info
- Exit;
- end;
- end;
-
- // no error so it must have been a positive response
- result := true;
-end; //*** end of CmdProgramMax ***
-
-
-//***************************************************************************************
-// NAME: CmdSetMta
-// PARAMETER: 32-bit address
-// RETURN VALUE: True is successful, False otherwise
-// DESCRIPTION: Sets the memory transfer address
-//
-//***************************************************************************************
-function TXcpLoader.CmdSetMta(addr : LongWord) : Boolean;
-begin
- // init return value
- result := false;
-
- // prepare the command packet
- comDriver.packetData[0] := kCmdSET_MTA;
- comDriver.packetData[1] := 0; // reserved
- comDriver.packetData[2] := 0; // reserved
- comDriver.packetData[3] := 0; // address extension not supported
-
- // set address taking into account byte ordering
- SetOrderedLong(addr, @comDriver.packetData[4]);
-
- comDriver.packetLen := 8;
-
- // send packet with SYNCH retry feature
- if not SendSynchedPacket(FTimerInterval[1], false) then Exit;
-
- // was the response an error packet?
- if comDriver.packetData[0] = kCmdPidERR then
- begin
- // busy or programming active error received?
- if (comDriver.packetData[1] = kErrCMD_BUSY) or
- (comDriver.packetData[1] = kErrPGM_ACTIVE) then
- begin
- WaitT7; // wait the predescribed time
- result := CmdSetMta(addr); // repeat this command
- Exit;
- end
- else
- begin
- FLastError := comDriver.packetData[1]; // Store error info
- Exit;
- end;
- end;
-
- // no error so it must have been a positive response
- result := true;
-
- // store current memory transfer address
- FMta := addr;
-end; //*** end of CmdSetMta ***
-
-
-//***************************************************************************************
-// NAME: CmdProgramClear
-// PARAMETER: number of bytes in memory to clear
-// RETURN VALUE: True is successful, False otherwise
-// DESCRIPTION: Clears the number of bytes in non-volatile memory starting at the
-// mta address.
-//
-//***************************************************************************************
-function TXcpLoader.CmdProgramClear(len : LongWord) : Boolean;
-begin
- // init return value
- result := false;
-
- // prepare the command packet
- comDriver.packetData[0] := kCmdPROGRAM_CLEAR;
- comDriver.packetData[1] := 0; // use absolute mode
- comDriver.packetData[2] := 0; // reserved
- comDriver.packetData[3] := 0; // reserved
-
- // set address taking into account byte ordering
- SetOrderedLong(len, @comDriver.packetData[4]);
-
- comDriver.packetLen := 8;
-
- // send packet with SYNCH retry feature
- if not SendSynchedPacket(FTimerInterval[4], true) then Exit;
-
- // was the response an error packet?
- if comDriver.packetData[0] = kCmdPidERR then
- begin
- // busy or programming active error received?
- if comDriver.packetData[1] = kErrCMD_BUSY then
- begin
- WaitT7; // wait the predescribed time
- result := CmdProgramClear(len); // repeat this command
- Exit;
- end
- else
- begin
- FLastError := comDriver.packetData[1]; // Store error info
- Exit;
- end;
- end;
-
- // no error so it must have been a positive response
- result := true;
-end; //*** end of CmdProgramClear ***
-
-
-//***************************************************************************************
-// NAME: StartProgrammingSession
-// PARAMETER: none.
-// RETURN VALUE: kProgSessionStarted if successful, kProgSessionUnlockError in case
-// the PGM resource could not be unlocked or kProgSessionGenericError.
-// DESCRIPTION: Starts the programming session using the following XCP command
-// sequence:
-// * CONNECT
-// * GET_STATUS
-// * GETSEED (if applicable)
-// * UNLOCK (if applicable)
-// * PROGRAM_START
-//
-//***************************************************************************************
-function TXcpLoader.StartProgrammingSession : Byte;
-var
- xcpProtection : TXcpProtection;
- supportedRes : Byte;
- seedData : array[0..5] of Byte;
- seedLen : byte;
- keyData : array[0..5] of Byte;
- keyLen : byte;
-begin
- // send the CONNECT command
- if not CmdConnect(FConnectMode) then
- begin
- result := kProgSessionGenericError;
- Exit;
- end;
-
- // make sure the programming resource is supported
- if (FResources and kResPGM) <> kResPGM then
- begin
- FLastError := kErrFsrResourceUnavailable;
- result := kProgSessionGenericError;
- Exit;
- end;
-
- // send the GET_STATUS command
- if not CmdGetStatus then
- begin
- result := kProgSessionGenericError;
- Exit;
- end;
-
- // check if we need to unlock the programming resource
- if (FProtection and kResPGM) = kResPGM then
- begin
- // ceate xcp protection object
- xcpProtection := TXcpProtection.Create(FSeedKeyDll);
-
- // make sure it contains the unlock algorithm for the PGM resource
- if xcpProtection.GetPrivileges(@supportedRes) <> 0 then
- begin
- FLastError := kErrFsrSeedKeyDllInvalid; // error calling DLL function
- result := kProgSessionUnlockError;
- xcpProtection.Free; // release the object
- Exit;
- end;
- if (supportedRes and kResPGM) <> kResPGM then
- begin
- FLastError := kErrFsrKeyAlgoMissing; // key algorithm not present
- result := kProgSessionUnlockError;
- xcpProtection.Free; // release the object
- Exit;
- end;
-
- // obtain the seed for the programming resource
- if not CmdGetSeed(@seedData, kResPGM, seedLen) then
- begin
- result := kProgSessionUnlockError;
- xcpProtection.Free; // release the object
- Exit;
- end;
-
- // compute the key
- keyLen := Length(keyData);
- if xcpProtection.ComputKeyFromSeed(kResPGM, seedLen, @seedData, @keyLen, @keyData) <> 0 then
- begin
- FLastError := kErrFsrSeedKeyDllInvalid; // error calling DLL function
- result := kProgSessionUnlockError;
- xcpProtection.Free; // release the object
- Exit;
- end;
-
- // release the object..no longer needed
- xcpProtection.Free;
-
- // we have the key so now unlock the resource
- if not CmdUnlock(@keyData, keyLen) then
- begin
- result := kProgSessionUnlockError;
- Exit;
- end;
-
- // make sure the PGM resource is really unprotected now
- if (FProtection and kResPGM) = kResPGM then
- begin
- FLastError := kErrACCESS_LOCKED;
- result := kProgSessionUnlockError;
- Exit;
- end;
- end;
-
- // send the PROGRAM_START command
- if not CmdProgramStart then
- begin
- result := kProgSessionGenericError;
- Exit;
- end;
-
- // successfully started the programming session
- result := kProgSessionStarted;
-end; //*** end of StartProgrammingSession ***
-
-
-//***************************************************************************************
-// NAME: StopProgrammingSession
-// PARAMETER: none
-// RETURN VALUE: True is successful, False otherwise
-// DESCRIPTION: Stops the programming session using the following XCP command
-// sequence:
-// * PROGRAM (size=0)
-// * PROGRAM_RESET
-//
-//***************************************************************************************
-function TXcpLoader.StopProgrammingSession : Boolean;
-begin
- // init return value
- result := false;
-
- // send the program command with size 0 to indicate end of programming session
- if not CmdProgram(nil, 0) then Exit;
-
- // finish off by resetting the ECU
- if not CmdProgramReset then Exit;
-
- // successfully stopped the programming session
- result := true;
-end; //*** end of StopProgrammingSession ***
-
-
-//***************************************************************************************
-// NAME: ClearMemory
-// PARAMETER: start address and the number of bytes to clear
-// RETURN VALUE: True is successful, False otherwise
-// DESCRIPTION: Clears the specified memory range using the following XCP command
-// sequence:
-// * SET_MTA
-// * PROGRAM_CLEAR
-//
-//***************************************************************************************
-function TXcpLoader.ClearMemory(addr : LongWord; len : LongWord) : Boolean;
-begin
- // init return value
- result := false;
-
- // set the start address for the erase operation
- if not CmdSetMta(addr) then Exit;
-
- // finish off by resetting the ECU
- if not CmdProgramClear(len) then Exit;
-
- // successfully cleared the memory
- result := true;
-end; //*** end of ClearMemory ***
-
-
-//***************************************************************************************
-// NAME: WriteData
-// PARAMETER: start address, the number of bytes to program, and the data buffer
-// RETURN VALUE: True is successful, False otherwise
-// DESCRIPTION: Programs specified memory range using the following XCP command
-// sequence:
-// * SET_MTA
-// * PROGRAM(_MAX)
-//
-//***************************************************************************************
-function TXcpLoader.WriteData(addr : LongWord; len : LongWord; data : PByteArray) : Boolean;
-var
- currentWriteCnt : Byte;
- bufferOffset : LongWord;
-begin
- // init return value
- result := false;
-
- // validate FCtoPGMPacketLen because using it to prevent possible divide by 0
- if FCtoPGMPacketLen = 0 then
- exit;
-
- // set the start address for the program operation
- if not CmdSetMta(addr) then Exit;
-
- // init buffer indexer
- bufferOffset := 0;
-
- while len > 0 do
- begin
- // set the current write length to make optimal use of the available packet data
- currentWriteCnt := Integer(len) mod (Integer(FCtoPGMPacketLen)-1);
- if currentWriteCnt = 0 then currentWriteCnt := FCtoPGMPacketLen-1;
-
- // prepare the packet data for PROGRAM
- if currentWriteCnt < FCtoPGMPacketLen-1 then
- begin
- if not CmdProgram(@data[bufferOffset], currentWriteCnt) then Exit;
- end
- // prepare the packet data for PROGRAM_MAX
- else
- begin
- if not CmdProgramMax(@data[bufferOffset]) then Exit;
- end;
-
- // update loop variables
- len := len - currentWriteCnt;
- bufferOffset := bufferOffset + currentWriteCnt;
- end;
-
- // successfully programmed the memory
- result := true;
-end; //*** end of WriteData ***
-
-
-end.
-//******************************** end of XcpLoader.pas *********************************
-
diff --git a/Host/Source/MicroBoot/interfaces/XcpProtection.pas b/Host/Source/MicroBoot/interfaces/XcpProtection.pas
deleted file mode 100644
index d9b83c8a..00000000
--- a/Host/Source/MicroBoot/interfaces/XcpProtection.pas
+++ /dev/null
@@ -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 *****************************
-
diff --git a/Host/Source/MicroBoot/interfaces/can/kvaser/CANIcon.png b/Host/Source/MicroBoot/interfaces/can/kvaser/CANIcon.png
deleted file mode 100644
index ed2db00d..00000000
Binary files a/Host/Source/MicroBoot/interfaces/can/kvaser/CANIcon.png and /dev/null differ
diff --git a/Host/Source/MicroBoot/interfaces/can/kvaser/XcpSettings.dfm b/Host/Source/MicroBoot/interfaces/can/kvaser/XcpSettings.dfm
deleted file mode 100644
index 1fae1ce1..00000000
Binary files a/Host/Source/MicroBoot/interfaces/can/kvaser/XcpSettings.dfm and /dev/null differ
diff --git a/Host/Source/MicroBoot/interfaces/can/kvaser/XcpSettings.pas b/Host/Source/MicroBoot/interfaces/can/kvaser/XcpSettings.pas
deleted file mode 100644
index a1459d78..00000000
--- a/Host/Source/MicroBoot/interfaces/can/kvaser/XcpSettings.pas
+++ /dev/null
@@ -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 *******************************
-
-
diff --git a/Host/Source/MicroBoot/interfaces/can/kvaser/XcpTransport.pas b/Host/Source/MicroBoot/interfaces/can/kvaser/XcpTransport.pas
deleted file mode 100644
index ecfb479d..00000000
--- a/Host/Source/MicroBoot/interfaces/can/kvaser/XcpTransport.pas
+++ /dev/null
@@ -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 ******************************
-
diff --git a/Host/Source/MicroBoot/interfaces/can/kvaser/canlib.pas b/Host/Source/MicroBoot/interfaces/can/kvaser/canlib.pas
deleted file mode 100644
index bdfbab99..00000000
--- a/Host/Source/MicroBoot/interfaces/can/kvaser/canlib.pas
+++ /dev/null
@@ -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.
diff --git a/Host/Source/MicroBoot/interfaces/can/kvaser/openblt_can_kvaser.dpr b/Host/Source/MicroBoot/interfaces/can/kvaser/openblt_can_kvaser.dpr
deleted file mode 100644
index ff2852d7..00000000
--- a/Host/Source/MicroBoot/interfaces/can/kvaser/openblt_can_kvaser.dpr
+++ /dev/null
@@ -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 **********************
diff --git a/Host/Source/MicroBoot/interfaces/can/kvaser/openblt_can_kvaser.dproj b/Host/Source/MicroBoot/interfaces/can/kvaser/openblt_can_kvaser.dproj
deleted file mode 100644
index bbb33559..00000000
--- a/Host/Source/MicroBoot/interfaces/can/kvaser/openblt_can_kvaser.dproj
+++ /dev/null
@@ -1,120 +0,0 @@
-
-
- {C587575B-3E1C-4EA4-BB4F-912B83127DCE}
- openblt_can_kvaser.dpr
- True
- Debug
- 1
- Library
- VCL
- 18.2
- Win32
-
-
- true
-
-
- true
- Base
- true
-
-
- true
- Base
- true
-
-
- true
- Base
- true
-
-
- true
- Cfg_2
- true
- true
-
-
- true
- ../../../../../
- openblt_can_kvaser
- 1
- Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace)
- 00400000
- 1
- false
- false
- false
- true
- Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40;$(DCC_UsePackage)
- true
- 1031
- CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=
- 1
- false
-
-
- System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
- true
- 1033
-
-
- RELEASE;$(DCC_Define)
- 0
- false
- 0
-
-
- true
- DEBUG;$(DCC_Define)
- false
-
-
- CompanyName=;FileVersion=1.1.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.1.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName)
- 1
- C:\Work\software\OpenBLT\Host\MicroBoot.exe
- true
- (None)
- 1033
-
-
-
- MainSource
-
-
-
-
-
-
-
-
-
- Cfg_2
- Base
-
-
- Base
-
-
- Cfg_1
- Base
-
-
-
- Delphi.Personality.12
-
-
-
-
- openblt_can_kvaser.dpr
-
-
-
- True
-
-
- 12
-
-
-
-
diff --git a/Host/Source/MicroBoot/interfaces/can/lawicel/CANIcon.png b/Host/Source/MicroBoot/interfaces/can/lawicel/CANIcon.png
deleted file mode 100644
index ed2db00d..00000000
Binary files a/Host/Source/MicroBoot/interfaces/can/lawicel/CANIcon.png and /dev/null differ
diff --git a/Host/Source/MicroBoot/interfaces/can/lawicel/CanUsb.pas b/Host/Source/MicroBoot/interfaces/can/lawicel/CanUsb.pas
deleted file mode 100644
index b2ec4394..00000000
--- a/Host/Source/MicroBoot/interfaces/can/lawicel/CanUsb.pas
+++ /dev/null
@@ -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 *************************************
-
-
diff --git a/Host/Source/MicroBoot/interfaces/can/lawicel/XcpSettings.dfm b/Host/Source/MicroBoot/interfaces/can/lawicel/XcpSettings.dfm
deleted file mode 100644
index 8c0a0c74..00000000
Binary files a/Host/Source/MicroBoot/interfaces/can/lawicel/XcpSettings.dfm and /dev/null differ
diff --git a/Host/Source/MicroBoot/interfaces/can/lawicel/XcpSettings.pas b/Host/Source/MicroBoot/interfaces/can/lawicel/XcpSettings.pas
deleted file mode 100644
index 95d3986f..00000000
--- a/Host/Source/MicroBoot/interfaces/can/lawicel/XcpSettings.pas
+++ /dev/null
@@ -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 *******************************
-
-
diff --git a/Host/Source/MicroBoot/interfaces/can/lawicel/XcpTransport.pas b/Host/Source/MicroBoot/interfaces/can/lawicel/XcpTransport.pas
deleted file mode 100644
index fa961e29..00000000
--- a/Host/Source/MicroBoot/interfaces/can/lawicel/XcpTransport.pas
+++ /dev/null
@@ -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 ******************************
-
diff --git a/Host/Source/MicroBoot/interfaces/can/lawicel/openblt_can_lawicel.dpr b/Host/Source/MicroBoot/interfaces/can/lawicel/openblt_can_lawicel.dpr
deleted file mode 100644
index 367e72b3..00000000
--- a/Host/Source/MicroBoot/interfaces/can/lawicel/openblt_can_lawicel.dpr
+++ /dev/null
@@ -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 *********************
diff --git a/Host/Source/MicroBoot/interfaces/can/lawicel/openblt_can_lawicel.dproj b/Host/Source/MicroBoot/interfaces/can/lawicel/openblt_can_lawicel.dproj
deleted file mode 100644
index c176cd41..00000000
--- a/Host/Source/MicroBoot/interfaces/can/lawicel/openblt_can_lawicel.dproj
+++ /dev/null
@@ -1,120 +0,0 @@
-
-
- {C587575B-3E1C-4EA4-BB4F-912B83127DCE}
- openblt_can_lawicel.dpr
- True
- Debug
- 1
- Library
- VCL
- 18.2
- Win32
-
-
- true
-
-
- true
- Base
- true
-
-
- true
- Base
- true
-
-
- true
- Base
- true
-
-
- true
- Cfg_2
- true
- true
-
-
- true
- ../../../../../
- openblt_can_lawicel
- 1
- Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace)
- 00400000
- 1
- false
- false
- false
- true
- Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40;$(DCC_UsePackage)
- true
- 1031
- CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=
- 1
- false
-
-
- System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
- true
- 1033
-
-
- RELEASE;$(DCC_Define)
- 0
- false
- 0
-
-
- true
- DEBUG;$(DCC_Define)
- false
-
-
- CompanyName=;FileVersion=1.1.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.1.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName)
- 1
- C:\Work\software\OpenBLT\Host\MicroBoot.exe
- true
- (None)
- 1033
-
-
-
- MainSource
-
-
-
-
-
-
-
-
-
- Cfg_2
- Base
-
-
- Base
-
-
- Cfg_1
- Base
-
-
-
- Delphi.Personality.12
-
-
-
-
- openblt_can_lawicel.dpr
-
-
-
- True
-
-
- 12
-
-
-
-
diff --git a/Host/Source/MicroBoot/interfaces/can/peak/CANIcon.png b/Host/Source/MicroBoot/interfaces/can/peak/CANIcon.png
deleted file mode 100644
index ed2db00d..00000000
Binary files a/Host/Source/MicroBoot/interfaces/can/peak/CANIcon.png and /dev/null differ
diff --git a/Host/Source/MicroBoot/interfaces/can/peak/PCANBasic.pas b/Host/Source/MicroBoot/interfaces/can/peak/PCANBasic.pas
deleted file mode 100644
index c0257a96..00000000
--- a/Host/Source/MicroBoot/interfaces/can/peak/PCANBasic.pas
+++ /dev/null
@@ -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
-////////////////////////////////////////////////////////////
-
-///
-/// Initializes a PCAN Channel
-///
-/// The handle of a PCAN Channel
-/// The speed for the communication (BTR0BTR1 code)
-/// NON PLUG&PLAY: The type of hardware and operation mode
-/// NON PLUG&PLAY: The I/O address for the parallel port
-/// NON PLUG&PLAY: Interrupt number of the parallel port
-/// A TPCANStatus error code
-function CAN_Initialize(
- Channel: TPCANHandle;
- Btr0Btr1: TPCANBaudrate;
- HwType: TPCANType;
- IOPort: LongWord;
- Interrupt: Word
- ): TPCANStatus; stdcall;
-
-///
-/// Initializes a FD capable PCAN Channel
-///
-/// "The handle of a FD capable PCAN Channel"
-/// "The speed for the communication (FD bit rate string)"
-/// 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
-///
-/// 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
-/// "A TPCANStatus error code"
-function CAN_InitializeFD(
- Channel: TPCANHandle;
- BitrateFD: TPCANBitrateFD
- ): TPCANStatus; stdcall;
-
-///
-/// Uninitializes one or all PCAN Channels initialized by CAN_Initialize
-///
-/// Giving the TPCANHandle value "PCAN_NONEBUS",
-/// uninitialize all initialized channels
-/// The handle of a PCAN Channel
-/// A TPCANStatus error code
-function CAN_Uninitialize(
- Channel: TPCANHandle
- ): TPCANStatus; stdcall;
-
-///
-/// Resets the receive and transmit queues of the PCAN Channel
-///
-/// A reset of the CAN controller is not performed
-/// The handle of a PCAN Channel
-/// A TPCANStatus error code
-function CAN_Reset(
- Channel: TPCANHandle
- ): TPCANStatus; stdcall;
-
-///
-/// Gets the current status of a PCAN Channel
-///
-/// The handle of a PCAN Channel
-/// A TPCANStatus error code
-function CAN_GetStatus(
- Channel: TPCANHandle
- ): TPCANStatus; stdcall;
-
-///
-/// Reads a CAN message from the receive queue of a PCAN Channel
-///
-/// The handle of a PCAN Channel
-/// A TPCANMsg structure buffer to store the CAN message
-/// A TPCANTimestamp structure buffer to get
-/// the reception time of the message
-/// A TPCANStatus error code
-function CAN_Read(
- Channel: TPCANHandle;
- var MessageBuffer: TPCANMsg;
- TimestampBuffer: PTPCANTimestamp
- ):TPCANStatus; stdcall;
-
-///
-/// Reads a CAN message from the receive queue of a FD capable PCAN Channel
-///
-/// "The handle of a FD capable PCAN Channel"
-/// "A TPCANMsgFD structure buffer to store the CAN message"
-/// "A TPCANTimestampFD buffer to get
-/// the reception time of the message. If this value is not desired, this parameter
-/// should be passed as NULL"
-/// "A TPCANStatus error code"
-function CAN_ReadFD(
- Channel: TPCANHandle;
- var MessageBuffer: TPCANMsgFD;
- TimestampBuffer: PTPCANTimestampFD
- ): TPCANStatus; stdcall;
-
-///
-/// Transmits a CAN message
-///
-/// The handle of a PCAN Channel
-/// A TPCANMsg buffer with the message to be sent
-/// A TPCANStatus error code
-function CAN_Write(
- Channel: TPCANHandle;
- var MessageBuffer: TPCANMsg
- ): TPCANStatus; stdcall;
-
-///
-/// Transmits a CAN message over a FD capable PCAN Channel
-///
-/// "The handle of a FD capable PCAN Channel"
-/// "A TPCANMsgFD buffer with the message to be sent"
-/// "A TPCANStatus error code"
-function CAN_WriteFD(
- Channel: TPCANHandle;
- var MessageBuffer: TPCANMsgFD
- ): TPCANStatus; stdcall;
-
-///
-/// Configures the reception filter
-///
-/// 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
-/// The handle of a PCAN Channel
-/// The lowest CAN ID to be received
-/// The highest CAN ID to be received
-/// Message type, Standard (11-bit identifier) or
-/// Extended (29-bit identifier)
-/// A TPCANStatus error code
-function CAN_FilterMessages(
- Channel: TPCANHandle;
- FromID: LongWord;
- ToID: LongWord;
- Mode: TPCANMode
- ): TPCANStatus; stdcall;
-
-///
-/// Retrieves a PCAN Channel value
-///
-/// 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
-/// The handle of a PCAN Channel
-/// The TPCANParameter parameter to get
-/// Buffer for the parameter value
-/// Size in bytes of the buffer
-/// A TPCANStatus error code
-function CAN_GetValue(
- Channel: TPCANHandle;
- Parameter: TPCANParameter;
- Buffer: Pointer;
- BufferLength: LongWord
- ): TPCANStatus; stdcall;
-
-///
-/// Configures or sets a PCAN Channel value
-///
-/// 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
-/// The handle of a PCAN Channel
-/// The TPCANParameter parameter to set
-/// Buffer with the value to be set
-/// Size in bytes of the buffer
-/// A TPCANStatus error code
-function CAN_SetValue(
- Channel: TPCANHandle;
- Parameter: TPCANParameter;
- Buffer: Pointer;
- BufferLength: LongWord
- ): TPCANStatus; stdcall;
-
-///
-/// Returns a descriptive text of a given TPCANStatus error
-/// code, in any desired language
-///
-/// The current languages available for translation are:
-/// Neutral (0x00), German (0x07), English (0x09), Spanish (0x0A),
-/// Italian (0x10) and French (0x0C)
-/// A TPCANStatus error code
-/// Indicates a 'Primary language ID'
-/// Buffer for the text (must be at least 256 in length)
-/// A TPCANStatus error code
-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.
\ No newline at end of file
diff --git a/Host/Source/MicroBoot/interfaces/can/peak/XcpSettings.dfm b/Host/Source/MicroBoot/interfaces/can/peak/XcpSettings.dfm
deleted file mode 100644
index 4c88fb1b..00000000
Binary files a/Host/Source/MicroBoot/interfaces/can/peak/XcpSettings.dfm and /dev/null differ
diff --git a/Host/Source/MicroBoot/interfaces/can/peak/XcpSettings.pas b/Host/Source/MicroBoot/interfaces/can/peak/XcpSettings.pas
deleted file mode 100644
index 6a8729a7..00000000
--- a/Host/Source/MicroBoot/interfaces/can/peak/XcpSettings.pas
+++ /dev/null
@@ -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 *******************************
-
-
diff --git a/Host/Source/MicroBoot/interfaces/can/peak/XcpTransport.pas b/Host/Source/MicroBoot/interfaces/can/peak/XcpTransport.pas
deleted file mode 100644
index ef4183df..00000000
--- a/Host/Source/MicroBoot/interfaces/can/peak/XcpTransport.pas
+++ /dev/null
@@ -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 ******************************
-
diff --git a/Host/Source/MicroBoot/interfaces/can/peak/openblt_can_peak.dpr b/Host/Source/MicroBoot/interfaces/can/peak/openblt_can_peak.dpr
deleted file mode 100644
index 2c7cb362..00000000
--- a/Host/Source/MicroBoot/interfaces/can/peak/openblt_can_peak.dpr
+++ /dev/null
@@ -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 ************************
diff --git a/Host/Source/MicroBoot/interfaces/can/peak/openblt_can_peak.dproj b/Host/Source/MicroBoot/interfaces/can/peak/openblt_can_peak.dproj
deleted file mode 100644
index ee26432f..00000000
--- a/Host/Source/MicroBoot/interfaces/can/peak/openblt_can_peak.dproj
+++ /dev/null
@@ -1,121 +0,0 @@
-
-
- {C587575B-3E1C-4EA4-BB4F-912B83127DCE}
- openblt_can_peak.dpr
- True
- Debug
- 1
- Library
- VCL
- 18.2
- Win32
-
-
- true
-
-
- true
- Base
- true
-
-
- true
- Base
- true
-
-
- true
- Base
- true
-
-
- true
- Cfg_2
- true
- true
-
-
- true
- ../../../../../
- openblt_can_peak
- 1
- Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace)
- 00400000
- 1
- false
- false
- false
- true
- Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40;$(DCC_UsePackage)
- true
- 1031
- CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=
- 1
- false
-
-
- System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
- true
- 1033
-
-
- RELEASE;$(DCC_Define)
- 0
- false
- 0
-
-
- true
- DEBUG;$(DCC_Define)
- false
-
-
- CompanyName=;FileVersion=1.1.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.1.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName)
- 1
- C:\Work\software\OpenBLT\Host\MicroBoot.exe
- true
- (None)
- 1033
-
-
-
- MainSource
-
-
-
-
-
-
-
-
-
-
- Cfg_2
- Base
-
-
- Base
-
-
- Cfg_1
- Base
-
-
-
- Delphi.Personality.12
-
-
-
-
- openblt_can_peak.dpr
-
-
-
- True
-
-
- 12
-
-
-
-
diff --git a/Host/Source/MicroBoot/interfaces/net/WSockets.pas b/Host/Source/MicroBoot/interfaces/net/WSockets.pas
deleted file mode 100644
index e81d36d9..00000000
--- a/Host/Source/MicroBoot/interfaces/net/WSockets.pas
+++ /dev/null
@@ -1,1550 +0,0 @@
-unit WSockets;
-{
-
-WSockets Version 1.20 - A Simple VCL Encapsulation of the WinSocket API
-
-VCL Classes in this Unit:
- TTCPClient - A TCP Client (derived from TCustomWSocket)
- TTCPServer - A TCP Server (derived from TCustomWSocket)
- TUDPClient - A UDP Client (derived from TCustomWSocket)
- TUDPServer - A UDP Server (derived from TCustomWSocket)
-
-Other classes ni this Unit:
- TCustomWSocket - A generic base class for other socket classes
- TClientList - A list class used only by the TTCPServer class
-
-Legal issues:
-
-Copyright (C) 1997 by Robert T. Palmqvist
-
- This software is provided 'as-is', without any express or implied
- warranty. In no event will the author be held liable for any damages
- arising from the use of this software.
-
- Permission is granted to anyone to use this software for any purpose,
- including commercial applications, and to alter it and redistribute it
- freely, subject to the following restrictions:
-
- 1. The origin of this software must not be misrepresented, you must not
- claim that you wrote the original software. If you use this software
- in a product, an acknowledgment in the product documentation would be
- appreciated but is not required.
-
- 2. Altered source versions must be plainly marked as such, and must not be
- misrepresented as being the original software.
-
- 3. This notice may not be removed or altered from any source distribution.
-
-Credits go to:
-
- Gary T. Desrosiers. His unit "Sockets" inspired me to write my own.
-
- Martin Hall, Mark Towfig, Geoff Arnold, David Treadwell, Henry Sanders
- and InfoMagic, Inc. for their Windows Help File "WinSock.hlp".
-
- All the guys at Borland who gave us a marvellous tool named "Delphi"!
-
-Recommended information sources:
-
- Specification:
- Windows Sockets Version 1.1 Specification
-
- Textbook:
- Quinn and Shute. "Windows Sockets Network Programming"
- 1996 by Addison-Wesley Publishing Company, Inc. ISBN 0-201-63372-8
-
- World Wide Web:
- http://www.sockets.com
- http://www.stardust.com
-
- Network News:
- alt.winsock.programming
-
- Frequently Asked Questions:
- "WinSock Application FAQ" Mailto: info@lcs.com Subject: faq
-
- Requests for Comments:
- RFC 768 "User Datagram Protocol"
- RFC 791 "Internet Protocol"
- RFC 793 "Transmission Control Protocol"
-
-}
-interface
-
-uses
- Windows, WinSock, SysUtils, Classes, Messages, Forms;
-
-const
- WM_ASYNCSELECT = WM_USER + 1;
- READ_BUFFER_SIZE = 1024;
- MAX_LOOP = 100;
-
-type
- TSocketState = (ssNotStarted, ssClosed, ssConnected, ssListening, ssOpen);
-
- TOnError = procedure(Sender: TObject; Error: integer; Msg: string) of object;
- TOnData = procedure(Sender: TObject; Socket: TSocket) of object;
- TOnAccept = procedure(Sender: TObject; Socket: TSocket) of object;
- TOnConnect = procedure(Sender: TObject; Socket: TSocket) of object;
- TOnClose = procedure(Sender: TObject; Socket: TSocket) of object;
-
- TReadBuffer = array[1..READ_BUFFER_SIZE] of byte;
-
- TClientList = class(TObject)
- private
- FSockets: TList;
- protected
- function GetSockets(Index: integer): TSocket;
- function GetCount: integer;
- public
- constructor Create;
- destructor Destroy; override;
- function Add(Socket: TSocket): boolean;
- procedure Delete(Socket: TSocket);
- procedure Clear;
- function IndexOf(Socket: TSocket): integer;
- property Sockets[Index: integer]: TSocket read GetSockets; default;
- property Count: integer read GetCount;
- end;
-
- TCustomWSocket = class(TComponent)
- private
- {WinSocket Information Private Fields}
- FVersion: string;
- FDescription: string;
- FSystemStatus: string;
- FMaxSockets: integer;
- FMaxUDPSize: integer;
- {End WinSocket Information Private Fields}
- FProtocol: integer;
- FType: integer;
-
- FReadBuffer: TReadBuffer;
- FLocalSocket: TSocket;
- FSocketState: TSocketState;
- FLastError: integer;
- FOnError: TOnError;
- protected
- procedure SocketError(Error: integer);
- function LastErrorDesc: string;
-
- function GetLocalHostAddress: string;
- function GetLocalHostName: string;
- {Socket Helper Functions}
- procedure SocketClose(var Socket: TSocket; Handle: HWND);
- function SocketQueueSize(Socket: TSocket): longint;
-
- procedure SocketWrite(Socket: TSocket; Flag: integer; Data: string);
- function SocketRead(Socket: TSocket; Flag: integer): string;
- function SocketWriteBuffer(Socket: TSocket; Buffer: Pointer; Size, Flag: integer): integer;
- function SocketReadBuffer(Socket: TSocket; Buffer: Pointer; Size, Flag: integer): integer;
-
- procedure SocketWriteTo(Socket: TSocket; Flag: integer; Data: string; var SockAddrIn: TSockAddrIn);
- function SocketReadFrom(Socket: TSocket; Flag: integer; var SockAddrIn: TSockAddrIn): string;
- function SocketWriteBufferTo(Socket: TSocket; Buffer: Pointer; Size, Flag: integer; var SockAddrIn: TSockAddrIn): integer;
- function SocketReadBufferFrom(Socket: TSocket; Buffer: Pointer; Size, Flag: integer; var SockAddrIn: TSockAddrIn): integer;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- {Address and Port Resolving Helper Functions}
- function GetSockAddrIn(Host, Port: string; var SockAddrIn: TSockAddrIn): boolean;
- function GetAnySockAddrIn(Port: string; var SockAddrIn: TSockAddrIn): boolean;
- function GetBroadcastSockAddrIn(Port: string; var SockAddrIn: TSockAddrIn): boolean;
- function SockAddrInToName(SockAddrIn: TSockAddrIn): string;
- function SockAddrInToAddress(SockAddrIn: TSockAddrIn): string;
- function SockAddrInToPort(SockAddrIn: TSockAddrIn): string;
- function SocketToName(Socket: TSocket): string;
- function SocketToAddress(Socket: TSocket): string;
- function SocketToPort(Socket: TSocket): string;
- function PeerToName(Socket: TSocket): string;
- function PeerToAddress(Socket: TSocket): string;
- function PeerToPort(Socket: TSocket): string;
- {WinSocket Information Properties}
- property Version: string read FVersion;
- property Description: string read FDescription;
- property SystemStatus: string read FSystemStatus;
- property MaxSockets: integer read FMaxSockets;
- property MaxUDPSize: integer read FMaxUDPSize;
- {End WinSocket Information Properties}
- property LocalSocket: TSocket read FLocalSocket;
- property SocketState: TSocketState read FSocketState;
- property LastError: integer read FLastError;
- property LocalHostAddress: string read GetLocalHostAddress;
- property LocalHostName: string read GetLocalHostName;
- published
- property OnError: TOnError read FOnError write FOnError;
- end;
-
- TTCPClient = class(TCustomWSocket)
- private
- FHandle: HWND;
-
- FHost: string;
- FPort: string;
-
- FOnData: TOnData;
- FOnConnect: TOnConnect;
- FOnClose: TOnClose;
- protected
- procedure WndProc(var AMsg: TMessage);
- procedure OpenConnection(Socket: TSocket; Error: word);
- procedure IncommingData(Socket: TSocket; Error: word);
- procedure CloseConnection(Socket: TSocket; Error: word);
-
- function GetPeerAddress: string;
- function GetPeerPort: string;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
-
- procedure Open;
- procedure Close;
-
- function Peek: string;
-
- procedure Write(Data: string);
- function Read: string;
-
- function WriteBuffer(Buffer: Pointer; Size: integer): integer;
- function ReadBuffer(Buffer: Pointer; Size: integer): integer;
-
- property Handle: HWND read FHandle;
-
- property PeerAddress: string read GetPeerAddress;
- property PeerPort: string read GetPeerPort;
- published
- property Host: string read FHost write FHost;
- property Port: string read FPort write FPort;
-
- property OnData: TOnData read FOnData write FOnData;
- property OnConnect: TOnConnect read FOnConnect write FOnConnect;
- property OnClose: TOnClose read FOnClose write FOnClose;
- end;
-
- TTCPServer = class(TCustomWSocket)
- private
- FHandle: HWND;
- FPort: string;
-
- FOnData: TOnData;
- FOnAccept: TOnAccept;
- FOnClose: TOnClose;
-
- FClients: TClientList;
- protected
- procedure WndProc(var AMsg: TMessage);
- procedure OpenConnection(Socket: TSocket; Error: word);
- procedure IncommingData(Socket: TSocket; Error: word);
- procedure CloseConnection(Socket: TSocket; Error: word);
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
-
- procedure Open;
- procedure Close;
-
- function Peek(Socket: TSocket): string;
-
- procedure Write(Socket: TSocket; Data: string);
- function Read(Socket: TSocket): string;
-
- function WriteBuffer(Socket: TSocket; Buffer: Pointer; Size: integer): integer;
- function ReadBuffer(Socket: TSocket; Buffer: Pointer; Size: integer): integer;
-
- procedure Disconnect(Socket: TSocket);
-
- property Handle: HWND read FHandle;
- property Clients: TClientList read FClients;
- published
- property Port: string read FPort write FPort;
-
- property OnData: TOnData read FOnData write FOnData;
- property OnAccept: TOnAccept read FOnAccept write FOnAccept;
- property OnClose: TOnClose read FOnClose write FOnClose;
- end;
-
- TUDPClient = class(TCustomWSocket)
- private
- FHandle: HWND;
-
- FHost: string;
- FPort: string;
-
- FOnData: TOnData;
- protected
- procedure WndProc(var AMsg: TMessage);
- procedure IncommingData(Socket: TSocket; Error: word);
-
- function GetPeerAddress: string;
- function GetPeerPort: string;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
-
- procedure Open;
- procedure Close;
-
- function Peek: string;
-
- procedure Write(Data: string);
- function Read: string;
-
- function WriteBuffer(Buffer: Pointer; Size: integer): integer;
- function ReadBuffer(Buffer: Pointer; Size: integer): integer;
-
- property Handle: HWND read FHandle;
-
- property PeerAddress: string read GetPeerAddress;
- property PeerPort: string read GetPeerPort;
- published
- property Host: string read FHost write FHost;
- property Port: string read FPort write FPort;
-
- property OnData: TOnData read FOnData write FOnData;
- end;
-
- TUDPServer = class(TCustomWSocket)
- private
- FHandle: HWND;
- FPort: string;
-
- FOnData: TOnData;
- protected
- procedure WndProc(var AMsg: TMessage);
- procedure IncommingData(Socket: TSocket; Error: word);
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
-
- procedure Open;
- procedure Close;
-
- function Peek(Socket: TSocket; var SockAddrIn: TSockAddrIn): string;
-
- procedure Write(Socket: TSocket; Data: string; var SockAddrIn: TSockAddrIn);
- function Read(Socket: TSocket; var SockAddrIn: TSockAddrIn): string;
-
- function WriteBuffer(Socket: TSocket; Buffer: Pointer; Size: integer; var SockAddrIn: TSockAddrIn): integer;
- function ReadBuffer(Socket: TSocket; Buffer: Pointer; Size: integer; var SockAddrIn: TSockAddrIn): integer;
-
- property Handle: HWND read FHandle;
- published
- property Port: string read FPort write FPort;
-
- property OnData: TOnData read FOnData write FOnData;
- end;
-
-procedure Register;
-
-implementation
-
-procedure Register;
-begin
- RegisterComponents('Samples', [TTCPClient, TTCPServer, TUDPClient, TUDPServer]);
-end;
-
-(**** TClientList Class ****)
-
-constructor TClientList.Create;
-begin
- inherited Create;
- FSockets:= TList.Create;
-end;
-
-destructor TClientList.Destroy;
-begin
- Clear;
- FSockets.Free;
- inherited Destroy;
-end;
-
-function TClientList.GetSockets(Index: integer): TSocket;
-begin
- Result:= TSocket(FSockets[Index]);
-end;
-
-function TClientList.GetCount: integer;
-begin
- Result:= FSockets.Count;
-end;
-
-function TClientList.Add(Socket: TSocket): boolean;
-begin
- Result:= (FSockets.Add(Ptr(Socket)) >= 0);
-end;
-
-procedure TClientList.Delete(Socket: TSocket);
-var
- i: integer;
-begin
- for i:= 0 to FSockets.Count-1 do
- begin
- if TSocket(FSockets[i]) = Socket then
- begin
- FSockets.Delete(i);
- Break;
- end;
- end;
-end;
-
-procedure TClientList.Clear;
-begin
- FSockets.Clear;
-end;
-
-function TClientList.IndexOf(Socket: TSocket): integer;
-var
- i: integer;
-begin
- Result:= -1;
- for i:= 0 to FSockets.Count-1 do
- begin
- if TSocket(FSockets[i]) = Socket then
- begin
- Result:= i;
- Break;
- end;
- end;
-end;
-
-(**** TCustomWSocket Class ****)
-
-constructor TCustomWSocket.Create(AOwner: TComponent);
-var
- WSAData: TWSAData;
-begin
- inherited Create(AOwner);
- FProtocol:= IPPROTO_IP;
- FType:= SOCK_RAW;
- FLocalSocket:= INVALID_SOCKET;
- FSocketState:= ssNotStarted;
- FLastError:= WSAStartup($101, WSAData);
- if FLastError = 0 then
- begin
- FSocketState:= ssClosed;
- with WSAData do
- begin
- FVersion:= Concat(IntToStr(Hi(wVersion)),'.',(IntToStr(Lo(wVersion))));
- FDescription:= String(szDescription);
- FSystemStatus:= String(szSystemStatus);
- FMaxSockets:= iMaxSockets;
- FMaxUDPSize:= iMaxUDPDg;
- end;
- end
- else
- SocketError(FLastError);
-end;
-
-destructor TCustomWSocket.Destroy;
-begin
- if FLocalSocket <> INVALID_SOCKET then
- closesocket(FLocalSocket);
- if FSocketState <> ssNotStarted then
- if WSACleanUp = SOCKET_ERROR then
- SocketError(WSAGetLastError);
- inherited Destroy;
-end;
-
-function TCustomWSocket.GetSockAddrIn(
- Host, Port: string; var SockAddrIn: TSockAddrIn): boolean;
-var
- ProtoEnt: PProtoEnt;
- ServEnt: PServEnt;
- HostEnt: PHostEnt;
-begin
- Result:= false;
- SockAddrIn.sin_family:= AF_INET;
-
- ProtoEnt:= getprotobynumber(FProtocol);
- if ProtoEnt = nil then
- begin
- SocketError(WSAGetLastError);
- Exit;
- end;
-
- ServEnt:= getservbyname(PAnsiChar(AnsiString(Port)), ProtoEnt^.p_name);
- if ServEnt = nil then
- SockAddrIn.sin_port:= htons(StrToInt(Port))
- else
- SockAddrIn.sin_port:= ServEnt^.s_port;
-
- SockAddrIn.sin_addr.s_addr:= inet_addr(PAnsiChar(AnsiString(Host)));
- if SockAddrIn.sin_addr.s_addr = Integer(INADDR_NONE) then
- begin
- HostEnt:= gethostbyname(PAnsiChar(AnsiString(Host)));
- if HostEnt = nil then
- begin
- SocketError(WSAGetLastError);
- Exit;
- end;
- SockAddrIn.sin_addr.S_addr:= longint(plongint(HostEnt^.h_addr_list^)^);
- end;
- Result:= true;
-end;
-
-function TCustomWSocket.GetAnySockAddrIn(
- Port: string; var SockAddrIn: TSockAddrIn): boolean;
-var
- ProtoEnt: PProtoEnt;
- ServEnt: PServEnt;
-begin
- Result:= false;
- SockAddrIn.sin_family:= AF_INET;
-
- ProtoEnt:= getprotobynumber(FProtocol);
- if ProtoEnt = nil then
- Exit;
-
- ServEnt:= getservbyname(PAnsiChar(AnsiString(Port)), ProtoEnt^.p_name);
- if ServEnt = nil then
- SockAddrIn.sin_port:= htons(StrToInt(Port))
- else
- SockAddrIn.sin_port:= ServEnt^.s_port;
-
- SockAddrIn.sin_addr.s_addr:= INADDR_ANY;
- Result:= true;
-end;
-
-function TCustomWSocket.GetBroadcastSockAddrIn(
- Port: string; var SockAddrIn: TSockAddrIn): boolean;
-var
- ProtoEnt: PProtoEnt;
- ServEnt: PServEnt;
-begin
- Result:= false;
- SockAddrIn.sin_family:= AF_INET;
-
- ProtoEnt:= getprotobynumber(FProtocol);
- if ProtoEnt = nil then
- Exit;
-
- ServEnt:= getservbyname(PAnsiChar(AnsiString(Port)), ProtoEnt^.p_name);
- if ServEnt = nil then
- SockAddrIn.sin_port:= htons(StrToInt(Port))
- else
- SockAddrIn.sin_port:= ServEnt^.s_port;
-
- SockAddrIn.sin_addr.s_addr:= Integer(INADDR_BROADCAST);
- Result:= true;
-end;
-
-function TCustomWSocket.SockAddrInToName(SockAddrIn: TSockAddrIn): string;
-var
- HostEnt: PHostEnt;
-begin
- HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
- if HostEnt <> nil then
- Result:= String(AnsiString(HostEnt.h_name));
-end;
-
-function TCustomWSocket.SockAddrInToAddress(SockAddrIn: TSockAddrIn): string;
-begin
- Result:= String(AnsiString(inet_ntoa(SockAddrIn.sin_addr)));
-end;
-
-function TCustomWSocket.SockAddrInToPort(SockAddrIn: TSockAddrIn): string;
-begin
- Result:= IntToStr(ntohs(SockAddrIn.sin_port));
-end;
-
-function TCustomWSocket.SocketToName(Socket: TSocket): string;
-var
- SockAddrIn: TSockAddrIn;
- Len: integer;
- HostEnt: PHostEnt;
-begin
- if Socket <> INVALID_SOCKET then
- begin
- Len:= SizeOf(SockAddrIn);
- if getsockname(Socket, SockAddrIn, Len) <> SOCKET_ERROR then
- begin
- HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
- if HostEnt <> nil then
- Result:= String(AnsiString(HostEnt.h_name));
- end;
- end;
-end;
-
-function TCustomWSocket.SocketToAddress(Socket: TSocket): string;
-var
- SockAddrIn: TSockAddrIn;
- Len: integer;
-begin
- if Socket <> INVALID_SOCKET then
- begin
- Len:= SizeOf(SockAddrIn);
- if getsockname(Socket, SockAddrIn, Len) <> SOCKET_ERROR then
- Result:= String(AnsiString(inet_ntoa(SockAddrIn.sin_addr)));
- end;
-end;
-
-function TCustomWSocket.SocketToPort(Socket: TSocket): string;
-var
- SockAddrIn: TSockAddrIn;
- Len: integer;
-begin
- if Socket <> INVALID_SOCKET then
- begin
- Len:= SizeOf(SockAddrIn);
- if getsockname(Socket, SockAddrIn, Len) <> SOCKET_ERROR then
- Result:= IntToStr(ntohs(SockAddrIn.sin_port));
- end;
-end;
-
-function TCustomWSocket.PeerToName(Socket: TSocket): string;
-var
- SockAddrIn: TSockAddrIn;
- Len: integer;
- HostEnt: PHostEnt;
-begin
- if Socket <> INVALID_SOCKET then
- begin
- Len:= SizeOf(SockAddrIn);
- if getpeername(Socket, SockAddrIn, Len) <> SOCKET_ERROR then
- begin
- HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
- if HostEnt <> nil then
- Result:= String(AnsiString(HostEnt.h_name));
- end;
- end;
-end;
-
-function TCustomWSocket.PeerToAddress(Socket: TSocket): string;
-var
- SockAddrIn: TSockAddrIn;
- Len: integer;
-begin
- if Socket <> INVALID_SOCKET then
- begin
- Len:= SizeOf(SockAddrIn);
- if getpeername(Socket, SockAddrIn, Len) <> SOCKET_ERROR then
- Result:= String(AnsiString(inet_ntoa(SockAddrIn.sin_addr)));
- end;
-end;
-
-function TCustomWSocket.PeerToPort(Socket: TSocket): string;
-var
- SockAddrIn: TSockAddrIn;
- Len: integer;
-begin
- if Socket <> INVALID_SOCKET then
- begin
- Len:= SizeOf(SockAddrIn);
- if getpeername(Socket, SockAddrIn, Len) <> SOCKET_ERROR then
- Result:= IntToStr(ntohs(SockAddrIn.sin_port));
- end;
-end;
-
-procedure TCustomWSocket.SocketClose(var Socket: TSocket; Handle: HWND);
-var
- RC: integer;
-begin
- if Socket <> INVALID_SOCKET then
- begin
- if WSAASyncSelect(Socket, Handle, WM_ASYNCSELECT, 0) <> 0 then
- begin
- SocketError(WSAGetLastError);
- Exit;
- end;
-
- if shutdown(Socket, 1) <> 0 then
- if WSAGetLastError <> WSAENOTCONN then
- begin
- SocketError(WSAGetLastError);
- Exit;
- end;
-
- repeat
- RC:= recv(Socket, FReadBuffer, SizeOf(TReadBuffer), 0);
- until (RC = 0) or (RC = SOCKET_ERROR);
-
- if closesocket(Socket) <> 0 then
- SocketError(WSAGetLastError)
- else
- Socket:= INVALID_SOCKET;
- end;
-end;
-
-function TCustomWSocket.SocketQueueSize(Socket: TSocket): longint;
-var
- Size: longint;
-begin
- Result:= 0;
- if ioctlsocket(Socket, FIONREAD, Size) <> 0 then
- SocketError(WSAGetLastError)
- else
- Result:= Size;
-end;
-
-procedure TCustomWSocket.SocketWrite(Socket: TSocket; Flag: integer; Data: string);
-var
- TotSent, ToSend, Sent, ErrorLoop: integer;
-begin
- if Data <> '' then
- begin
- ErrorLoop:= 0;
- TotSent:= 0;
- ToSend:= Length(Data);
- repeat
- Sent:= send(Socket, Data[TotSent+1], (ToSend-TotSent), Flag);
- if Sent = SOCKET_ERROR then
- begin
- Inc(ErrorLoop);
- if WSAGetLastError <> WSAEWOULDBLOCK then
- begin
- SocketError(WSAGetLastError);
- Exit;
- end;
- end
- else
- Inc(TotSent, Sent);
- until (TotSent >= ToSend) or (ErrorLoop > MAX_LOOP);
- end;
-end;
-
-function TCustomWSocket.SocketRead(Socket: TSocket; Flag: integer): string;
-var
- Received: longint;
-begin
- Result:= '';
- Received:= recv(Socket, FReadBuffer, SizeOf(TReadBuffer), Flag);
- if Received = SOCKET_ERROR then
- begin
- if WSAGetLastError <> WSAEWOULDBLOCK then
- SocketError(WSAGetLastError);
- end
- else
- begin
- SetLength(Result, Received);
- Move(FReadBuffer, Result[1], Received);
- end;
-end;
-
-function TCustomWSocket.SocketWriteBuffer(Socket: TSocket; Buffer: Pointer; Size, Flag: integer): integer;
-begin
- Result:= send(Socket, Buffer^, Size, Flag);
- if Result = SOCKET_ERROR then
- begin
- Result:= 0;
- if WSAGetLastError <> WSAEWOULDBLOCK then
- SocketError(WSAGetLastError);
- end;
-end;
-
-function TCustomWSocket.SocketReadBuffer(Socket: TSocket; Buffer: Pointer; Size, Flag: integer): integer;
-begin
- Result:= recv(Socket, Buffer^, Size, Flag);
- if Result = SOCKET_ERROR then
- begin
- Result:= 0;
- if WSAGetLastError <> WSAEWOULDBLOCK then
- SocketError(WSAGetLastError);
- end;
-end;
-
-procedure TCustomWSocket.SocketWriteTo(Socket: TSocket; Flag: integer; Data: string; var SockAddrIn: TSockAddrIn);
-var
- TotSent, ToSend, Sent, ErrorLoop: integer;
-begin
- if Data <> '' then
- begin
- ErrorLoop:= 0;
- TotSent:= 0;
- ToSend:= Length(Data);
- repeat
- Sent:= sendto(Socket, Data[TotSent+1], (ToSend-TotSent), Flag, SockAddrIn, SizeOf(SockAddrIn));
- if Sent = SOCKET_ERROR then
- begin
- Inc(ErrorLoop);
- if WSAGetLastError <> WSAEWOULDBLOCK then
- begin
- SocketError(WSAGetLastError);
- Exit;
- end;
- end
- else
- Inc(TotSent, Sent);
- until (TotSent >= ToSend) or (ErrorLoop > MAX_LOOP);
- end;
-end;
-
-function TCustomWSocket.SocketReadFrom(Socket: TSocket; Flag: integer; var SockAddrIn: TSockAddrIn): string;
-var
- Len: integer;
- Received: longint;
-begin
- Len:= SizeOf(SockAddrIn);
- Received:= recvfrom(Socket, FReadBuffer, SizeOf(TReadBuffer), Flag, SockAddrIn, Len);
- if Received = SOCKET_ERROR then
- begin
- if WSAGetLastError <> WSAEWOULDBLOCK then
- SocketError(WSAGetLastError);
- end
- else
- begin
- SetLength(Result, Received);
- Move(FReadBuffer, Result[1], Received);
- end;
-end;
-
-function TCustomWSocket.SocketWriteBufferTo(Socket: TSocket; Buffer: Pointer; Size, Flag: integer; var SockAddrIn: TSockAddrIn): integer;
-begin
- Result:= sendto(Socket, Buffer^, Size, Flag, SockAddrIn, SizeOf(SockAddrIn));
- if Result = SOCKET_ERROR then
- begin
- Result:= 0;
- if WSAGetLastError <> WSAEWOULDBLOCK then
- SocketError(WSAGetLastError);
- end;
-end;
-
-function TCustomWSocket.SocketReadBufferFrom(Socket: TSocket; Buffer: Pointer; Size, Flag: integer; var SockAddrIn: TSockAddrIn): integer;
-var
- Len: integer;
-begin
- Len:= SizeOf(SockAddrIn);
- Result:= recvfrom(Socket, Buffer^, Size, Flag, SockAddrIn, Len);
- if Result = SOCKET_ERROR then
- begin
- Result:= 0;
- if WSAGetLastError <> WSAEWOULDBLOCK then
- SocketError(WSAGetLastError);
- end;
-end;
-
-procedure TCustomWSocket.SocketError(Error: integer);
-begin
- FLastError:= Error;
- if Assigned(FOnError) then
- FOnError(Self, FLastError, LastErrorDesc);
-end;
-
-function TCustomWSocket.LastErrorDesc: string;
-begin
- case FLastError of
- WSAEINTR : Result:= 'Interrupted system call';
- WSAEBADF : Result:= 'Bad file number';
- WSAEACCES : Result:= 'Permission denied';
- WSAEFAULT : Result:= 'Bad address';
- WSAEINVAL : Result:= 'Invalid argument';
- WSAEMFILE : Result:= 'Too many open files';
- WSAEWOULDBLOCK : Result:= 'Operation would block';
- WSAEINPROGRESS : Result:= 'Operation now in progress';
- WSAEALREADY : Result:= 'Operation already in progress';
- WSAENOTSOCK : Result:= 'Socket operation on nonsocket';
- WSAEDESTADDRREQ : Result:= 'Destination address required';
- WSAEMSGSIZE : Result:= 'Message too long';
- WSAEPROTOTYPE : Result:= 'Protocol wrong type for socket';
- WSAENOPROTOOPT : Result:= 'Protocol not available';
- WSAEPROTONOSUPPORT : Result:= 'Protocol not supported';
- WSAESOCKTNOSUPPORT : Result:= 'Socket not supported';
- WSAEOPNOTSUPP : Result:= 'Operation not supported on socket';
- WSAEPFNOSUPPORT : Result:= 'Protocol family not supported';
- WSAEAFNOSUPPORT : Result:= 'Address family not supported';
- WSAEADDRINUSE : Result:= 'Address already in use';
- WSAEADDRNOTAVAIL : Result:= 'Can''t assign requested address';
- WSAENETDOWN : Result:= 'Network is down';
- WSAENETUNREACH : Result:= 'Network is unreachable';
- WSAENETRESET : Result:= 'Network dropped connection on reset';
- WSAECONNABORTED : Result:= 'Software caused connection abort';
- WSAECONNRESET : Result:= 'Connection reset by peer';
- WSAENOBUFS : Result:= 'No buffer space available';
- WSAEISCONN : Result:= 'Socket is already connected';
- WSAENOTCONN : Result:= 'Socket is not connected';
- WSAESHUTDOWN : Result:= 'Can''t send after socket shutdown';
- WSAETOOMANYREFS : Result:= 'Too many references:can''t splice';
- WSAETIMEDOUT : Result:= 'Connection timed out';
- WSAECONNREFUSED : Result:= 'Connection refused';
- WSAELOOP : Result:= 'Too many levels of symbolic links';
- WSAENAMETOOLONG : Result:= 'File name is too long';
- WSAEHOSTDOWN : Result:= 'Host is down';
- WSAEHOSTUNREACH : Result:= 'No route to host';
- WSAENOTEMPTY : Result:= 'Directory is not empty';
- WSAEPROCLIM : Result:= 'Too many processes';
- WSAEUSERS : Result:= 'Too many users';
- WSAEDQUOT : Result:= 'Disk quota exceeded';
- WSAESTALE : Result:= 'Stale NFS file handle';
- WSAEREMOTE : Result:= 'Too many levels of remote in path';
- WSASYSNOTREADY : Result:= 'Network subsystem is unusable';
- WSAVERNOTSUPPORTED : Result:= 'Winsock DLL cannot support this application';
- WSANOTINITIALISED : Result:= 'Winsock not initialized';
- WSAHOST_NOT_FOUND : Result:= 'Host not found';
- WSATRY_AGAIN : Result:= 'Non authoritative - host not found';
- WSANO_RECOVERY : Result:= 'Non recoverable error';
- WSANO_DATA : Result:= 'Valid name, no data record of requested type'
- else
- Result:= 'Not a Winsock error';
- end;
-end;
-
-function TCustomWSocket.GetLocalHostAddress: string;
-var
- SockAddrIn: TSockAddrIn;
- HostEnt: PHostEnt;
- szHostName: array[0..128] of ansichar;
-begin
- if gethostname(szHostName, 128) = 0 then
- begin
- HostEnt:= gethostbyname(szHostName);
- if HostEnt = nil then
- Result:= ''
- else
- begin
- SockAddrIn.sin_addr.S_addr:= longint(plongint(HostEnt^.h_addr_list^)^);
- Result:= String(AnsiString(inet_ntoa(SockAddrIn.sin_addr)));
- end;
- end
- else
- SocketError(WSAGetLastError);
-end;
-
-function TCustomWSocket.GetLocalHostName: string;
-var
- szHostName: array[0..128] of ansichar;
-begin
- if gethostname(szHostName, 128) = 0 then
- Result:= String(AnsiString(szHostName))
- else
- SocketError(WSAGetLastError);
-end;
-
-(**** TTCPClient Class ****)
-
-constructor TTCPClient.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
- FHandle:= AllocateHWnd(WndProc);
- FProtocol:= IPPROTO_TCP;
- FType:= SOCK_STREAM;
-end;
-
-destructor TTCPClient.Destroy;
-begin
- Close;
- DeallocateHWnd(FHandle);
- inherited Destroy;
-end;
-
-procedure TTCPClient.OpenConnection(Socket: TSocket; Error: word);
-var
- EventMask: longint;
-begin
- if Error <> 0 then
- SocketError(Error)
- else
- begin
- EventMask:= FD_READ or FD_CLOSE;
- if WSAASyncSelect(FLocalSocket, FHandle, WM_ASYNCSELECT, EventMask) <> 0 then
- SocketError(WSAGetLastError)
- else
- begin
- if Assigned(FOnConnect) then
- FOnConnect(Self, Socket);
- FSocketState:= ssConnected;
- end;
- end;
-end;
-
-procedure TTCPClient.CloseConnection(Socket: TSocket; Error: word);
-begin
- if Error = WSAENETDOWN then
- SocketError(Error)
- else
- begin
- if Assigned(FOnClose) then
- FOnClose(Self, Socket);
- Close;
- end;
-end;
-
-procedure TTCPClient.IncommingData(Socket: TSocket; Error: word);
-begin
- if Error <> 0 then
- SocketError(Error)
- else
- if Assigned(FOnData) then
- FOnData(Self, Socket);
-end;
-
-procedure TTCPClient.WndProc(var AMsg: TMessage);
-var
- Error: word;
-begin
- with AMsg do
- case Msg of
- WM_ASYNCSELECT:
- begin
- if (FSocketState = ssClosed) then
- Exit;
- Error:= WSAGetSelectError(LParam);
- case WSAGetSelectEvent(LParam) of
- FD_READ : IncommingData(WParam, Error);
- FD_CONNECT: OpenConnection(WParam, Error);
- FD_CLOSE : CloseConnection(WParam, Error);
- else
- if Error <> 0 then
- SocketError(Error);
- end;
- end;
- else
- Result:= DefWindowProc(FHandle, Msg, WParam, LParam);
- end;
-end;
-
-procedure TTCPClient.Open;
-var
- SockAddrIn: TSockAddrIn;
- SockOpt: LongBool;
- EventMask: longint;
-begin
- if (FSocketState <> ssClosed) then
- Exit;
-
- if not GetSockAddrIn(FHost, FPort, SockAddrIn) then
- Exit;
-
- FLocalSocket:= socket(PF_INET, FType, 0);
- if FLocalSocket = INVALID_SOCKET then
- begin
- SocketError(WSAGetLastError);
- Exit;
- end;
-
- EventMask:= (FD_CONNECT or FD_READ or FD_CLOSE);
- if WSAASyncSelect(FLocalSocket, FHandle, WM_ASYNCSELECT, EventMask) <> 0 then
- begin
- SocketError(WSAGetLastError);
- closesocket(FLocalSocket);
- Exit;
- end;
-
- SockOpt:= true; {Enable OOB Data inline}
- if setsockopt(FLocalSocket, SOL_SOCKET, SO_OOBINLINE, PAnsiChar(@SockOpt), SizeOf(SockOpt)) <> 0 then
- begin
- SocketError(WSAGetLastError);
- closesocket(FLocalSocket);
- Exit;
- end;
-
- if connect(FLocalSocket, SockAddrIn, SizeOf(SockAddrIn)) <> 0 then
- begin
- if WSAGetLastError <> WSAEWOULDBLOCK then
- begin
- SocketError(WSAGetLastError);
- closesocket(FLocalSocket);
- Exit;
- end;
- end;
-
- FSocketState:= ssOpen;
-end;
-
-procedure TTCPClient.Close;
-begin
- if (FSocketState = ssNotStarted) or (FSocketState = ssClosed) then
- Exit;
-
- SocketClose(FLocalSocket, FHandle);
- if FLocalSocket = INVALID_SOCKET then
- FSocketState:= ssClosed;
-end;
-
-procedure TTCPClient.Write(Data: string);
-begin
- SocketWrite(FLocalSocket, 0, Data);
-end;
-
-function TTCPClient.Read: string;
-begin
- Result:= SocketRead(FLocalSocket, 0);
-end;
-
-function TTCPClient.Peek: string;
-begin
- Result:= SocketRead(FLocalSocket, MSG_PEEK);
-end;
-
-function TTCPClient.WriteBuffer(Buffer: Pointer; Size: integer): integer;
-begin
- Result:= SocketWriteBuffer(FLocalSocket, Buffer, Size, 0);
-end;
-
-function TTCPClient.ReadBuffer(Buffer: Pointer; Size: integer): integer;
-begin
- Result:= SocketReadBuffer(FLocalSocket, Buffer, Size, 0);
-end;
-
-function TTCPClient.GetPeerAddress: string;
-begin
- Result:= PeerToAddress(FLocalSocket);
-end;
-
-function TTCPClient.GetPeerPort: string;
-begin
- Result:= PeerToPort(FLocalSocket);
-end;
-
-(**** TTCPServer Class ****)
-
-constructor TTCPServer.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
- FHandle:= AllocateHWnd(WndProc);
- FProtocol:= IPPROTO_TCP;
- FType:= SOCK_STREAM;
- FClients:= TClientList.Create;
-end;
-
-destructor TTCPServer.Destroy;
-begin
- Close;
- DeallocateHWnd(FHandle);
- FClients.Free;
- inherited Destroy;
-end;
-
-procedure TTCPServer.OpenConnection(Socket: TSocket; Error: word);
-var
- Len: integer;
- NewSocket: TSocket;
- SockAddrIn: TSockAddrIn;
- SockOpt: LongBool;
- EventMask: longint;
-begin
- if Error <> 0 then
- SocketError(Error)
- else
- begin
- Len:= SizeOf(SockAddrIn);
- //{$IFDEF VER100} // Delphi 3
- NewSocket:= accept(FLocalSocket, @SockAddrIn, @Len);
- //{$ELSE} // Delphi 2
- //NewSocket:= accept(FLocalSocket, SockAddrIn, Len);
- //{$ENDIF}
- if NewSocket = INVALID_SOCKET then
- begin
- SocketError(WSAGetLastError);
- Exit;
- end;
-
- EventMask:= (FD_READ or FD_CLOSE);
- if WSAASyncSelect(NewSocket, FHandle, WM_ASYNCSELECT, EventMask) <> 0 then
- begin
- SocketError(WSAGetLastError);
- closesocket(NewSocket);
- Exit;
- end;
-
- SockOpt:= true; {Enable OOB Data inline}
- if setsockopt(NewSocket, SOL_SOCKET, SO_OOBINLINE , PAnsiChar(@SockOpt), SizeOf(SockOpt)) <> 0 then
- begin
- SocketError(WSAGetLastError);
- closesocket(NewSocket);
- Exit;
- end;
-
- if not FClients.Add(NewSocket) then
- SocketClose(NewSocket, FHandle)
- else
- if Assigned(FOnAccept) then
- FOnAccept(Self, NewSocket);
- end;
-end;
-
-procedure TTCPServer.CloseConnection(Socket: TSocket; Error: word);
-begin
- if Error = WSAENETDOWN then
- SocketError(Error)
- else
- begin
- if Assigned(FOnClose) then
- FOnClose(Self, Socket);
- Disconnect(Socket);
- end;
-end;
-
-procedure TTCPServer.IncommingData(Socket: TSocket; Error: word);
-begin
- if Error <> 0 then
- SocketError(Error)
- else
- if Assigned(FOnData) then
- FOnData(Self, Socket);
-end;
-
-procedure TTCPServer.WndProc(var AMsg: TMessage);
-var
- Error: word;
-begin
- with AMsg do
- case Msg of
- WM_ASYNCSELECT:
- begin
- if (FSocketState = ssClosed) then
- Exit;
- Error:= WSAGetSelectError(LParam);
- case WSAGetSelectEvent(LParam) of
- FD_READ : IncommingData(WParam, Error);
- FD_ACCEPT: OpenConnection(WParam, Error);
- FD_CLOSE : CloseConnection(WParam, Error);
- else
- if Error <> 0 then
- SocketError(Error);
- end;
- end;
- else
- Result:= DefWindowProc(FHandle, Msg, WParam, LParam);
- end;
-end;
-
-procedure TTCPServer.Open;
-var
- SockAddrIn: TSockAddrIn;
-begin
- if (FSocketState <> ssClosed) then
- Exit;
-
- if not GetAnySockAddrIn(FPort, SockAddrIn) then
- Exit;
-
- FLocalSocket:= socket(PF_INET, FType, 0);
- if FLocalSocket = INVALID_SOCKET then
- begin
- SocketError(WSAGetLastError);
- Exit;
- end;
-
- if WSAASyncSelect(FLocalSocket, FHandle, WM_ASYNCSELECT, FD_ACCEPT) <> 0 then
- begin
- SocketError(WSAGetLastError);
- closesocket(FLocalSocket);
- Exit;
- end;
-
- if bind(FLocalSocket, SockAddrIn, SizeOf(SockAddrIn)) <> 0 then
- begin
- SocketError(WSAGetLastError);
- closesocket(FLocalSocket);
- Exit;
- end;
-
- if listen(FLocalSocket, 5) <> 0 then
- begin
- SocketError(WSAGetLastError);
- closesocket(FLocalSocket);
- Exit;
- end;
-
- FSocketState:= ssListening;
-end;
-
-procedure TTCPServer.Close;
-var
- i: integer;
- Dummy: TSocket;
-begin
- if (FSocketState = ssNotStarted) or (FSocketState = ssClosed) then
- Exit;
-
- for i:= 0 to FClients.Count-1 do
- begin
- Dummy:= FClients[i];
- SocketClose(Dummy, FHandle);
- end;
- FClients.Clear;
-
- SocketClose(FLocalSocket, FHandle);
- if FLocalSocket = INVALID_SOCKET then
- FSocketState:= ssClosed;
-end;
-
-procedure TTCPServer.Write(Socket: TSocket; Data: string);
-begin
- SocketWrite(Socket, 0, Data);
-end;
-
-function TTCPServer.Read(Socket: TSocket): string;
-begin
- Result:= SocketRead(Socket, 0);
-end;
-
-function TTCPServer.Peek(Socket: TSocket): string;
-begin
- Result:= SocketRead(Socket, MSG_PEEK);
-end;
-
-function TTCPServer.WriteBuffer(Socket: TSocket; Buffer: Pointer; Size: integer): integer;
-begin
- Result:= SocketWriteBuffer(Socket, Buffer, Size, 0);
-end;
-
-function TTCPServer.ReadBuffer(Socket: TSocket; Buffer: Pointer; Size: integer): integer;
-begin
- Result:= SocketReadBuffer(Socket, Buffer, Size, 0);
-end;
-
-procedure TTCPServer.Disconnect(Socket: TSocket);
-begin
- FClients.Delete(Socket);
- SocketClose(Socket, FHandle);
-end;
-
-(**** TUDPClient Class ****)
-
-constructor TUDPClient.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
- FHandle:= AllocateHWnd(WndProc);
- FProtocol:= IPPROTO_UDP;
- FType:= SOCK_DGRAM;
-end;
-
-destructor TUDPClient.Destroy;
-begin
- Close;
- DeallocateHWnd(FHandle);
- inherited Destroy;
-end;
-
-procedure TUDPClient.IncommingData(Socket: TSocket; Error: word);
-begin
- if Error <> 0 then
- SocketError(Error)
- else
- if Assigned(FOnData) then
- FOnData(Self, Socket);
-end;
-
-procedure TUDPClient.WndProc(var AMsg: TMessage);
-var
- Error: word;
-begin
- with AMsg do
- case Msg of
- WM_ASYNCSELECT:
- begin
- if (FSocketState = ssClosed) then
- Exit;
- Error:= WSAGetSelectError(LParam);
- case WSAGetSelectEvent(LParam) of
- FD_READ : IncommingData(WParam, Error);
- else
- if Error <> 0 then
- SocketError(Error);
- end;
- end;
- else
- Result:= DefWindowProc(FHandle, Msg, WParam, LParam);
- end;
-end;
-
-procedure TUDPClient.Open;
-var
- SockAddrIn: TSockAddrIn;
-begin
- if (FSocketState <> ssClosed) then
- Exit;
-
- if not GetSockAddrIn(FHost, FPort, SockAddrIn) then
- Exit;
-
- FLocalSocket:= socket(PF_INET, FType, 0);
- if FLocalSocket = INVALID_SOCKET then
- begin
- SocketError(WSAGetLastError);
- Exit;
- end;
-
- if WSAASyncSelect(FLocalSocket, FHandle, WM_ASYNCSELECT, FD_READ) <> 0 then
- begin
- SocketError(WSAGetLastError);
- closesocket(FLocalSocket);
- Exit;
- end;
-
- if connect(FLocalSocket, SockAddrIn, SizeOf(SockAddrIn)) <> 0 then
- begin
- if WSAGetLastError <> WSAEWOULDBLOCK then
- begin
- SocketError(WSAGetLastError);
- closesocket(FLocalSocket);
- Exit;
- end;
- end;
-
- FSocketState:= ssOpen;
-end;
-
-procedure TUDPClient.Close;
-begin
- if (FSocketState = ssNotStarted) or (FSocketState = ssClosed) then
- Exit;
-
- SocketClose(FLocalSocket, FHandle);
- if FLocalSocket = INVALID_SOCKET then
- FSocketState:= ssClosed;
-end;
-
-procedure TUDPClient.Write(Data: string);
-begin
- SocketWrite(FLocalSocket, 0, Data);
-end;
-
-function TUDPClient.Read: string;
-begin
- Result:= SocketRead(FLocalSocket, 0);
-end;
-
-function TUDPClient.Peek: string;
-begin
- Result:= SocketRead(FLocalSocket, MSG_PEEK);
-end;
-
-function TUDPClient.WriteBuffer(Buffer: Pointer; Size: integer): integer;
-begin
- Result:= SocketWriteBuffer(FLocalSocket, Buffer, Size, 0);
-end;
-
-function TUDPClient.ReadBuffer(Buffer: Pointer; Size: integer): integer;
-begin
- Result:= SocketReadBuffer(FLocalSocket, Buffer, Size, 0);
-end;
-
-function TUDPClient.GetPeerAddress: string;
-begin
- Result:= PeerToAddress(FLocalSocket);
-end;
-
-function TUDPClient.GetPeerPort: string;
-begin
- Result:= PeerToPort(FLocalSocket);
-end;
-
-(**** TUDPServer Class ****)
-
-constructor TUDPServer.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
- FHandle:= AllocateHWnd(WndProc);
- FProtocol:= IPPROTO_UDP;
- FType:= SOCK_DGRAM;
-end;
-
-destructor TUDPServer.Destroy;
-begin
- Close;
- DeallocateHWnd(FHandle);
- inherited Destroy;
-end;
-
-procedure TUDPServer.IncommingData(Socket: TSocket; Error: word);
-begin
- if Error <> 0 then
- SocketError(Error)
- else
- if Assigned(FOnData) then
- FOnData(Self, Socket);
-end;
-
-procedure TUDPServer.WndProc(var AMsg: TMessage);
-var
- Error: word;
-begin
- with AMsg do
- case Msg of
- WM_ASYNCSELECT:
- begin
- if (FSocketState = ssClosed) then
- Exit;
- Error:= WSAGetSelectError(LParam);
- case WSAGetSelectEvent(LParam) of
- FD_READ : IncommingData(WParam, Error);
- else
- if Error <> 0 then
- SocketError(Error);
- end;
- end;
- else
- Result:= DefWindowProc(FHandle, Msg, WParam, LParam);
- end;
-end;
-
-procedure TUDPServer.Open;
-var
- SockAddrIn: TSockAddrIn;
- SockOpt: LongBool;
-begin
- if (FSocketState <> ssClosed) then
- Exit;
-
- if not GetAnySockAddrIn(FPort, SockAddrIn) then
- Exit;
-
- FLocalSocket:= socket(PF_INET, FType, 0);
- if FLocalSocket = INVALID_SOCKET then
- begin
- SocketError(WSAGetLastError);
- Exit;
- end;
-
- if WSAASyncSelect(FLocalSocket, FHandle, WM_ASYNCSELECT, FD_READ) <> 0 then
- begin
- SocketError(WSAGetLastError);
- closesocket(FLocalSocket);
- Exit;
- end;
-
- SockOpt:= true; {Enable Broadcasting on this Socket}
- if setsockopt(FLocalSocket, SOL_SOCKET, SO_BROADCAST, PAnsiChar(@SockOpt), SizeOf(SockOpt)) <> 0 then
- begin
- SocketError(WSAGetLastError);
- closesocket(FLocalSocket);
- Exit;
- end;
-
- if bind(FLocalSocket, SockAddrIn, SizeOf(SockAddrIn)) <> 0 then
- begin
- SocketError(WSAGetLastError);
- closesocket(FLocalSocket);
- Exit;
- end;
-
- FSocketState:= ssListening;
-end;
-
-procedure TUDPServer.Close;
-begin
- if (FSocketState = ssNotStarted) or (FSocketState = ssClosed) then
- Exit;
-
- SocketClose(FLocalSocket, FHandle);
- if FLocalSocket = INVALID_SOCKET then
- FSocketState:= ssClosed;
-end;
-
-procedure TUDPServer.Write(Socket: TSocket; Data: string; var SockAddrIn: TSockAddrIn);
-begin
- SocketWriteTo(Socket, 0, Data, SockAddrIn);
-end;
-
-function TUDPServer.Read(Socket: TSocket; var SockAddrIn: TSockAddrIn): string;
-begin
- Result:= SocketReadFrom(Socket, 0, SockAddrIn);
-end;
-
-function TUDPServer.Peek(Socket: TSocket; var SockAddrIn: TSockAddrIn): string;
-begin
- Result:= SocketReadFrom(Socket, MSG_PEEK, SockAddrIn);
-end;
-
-function TUDPServer.WriteBuffer(Socket: TSocket; Buffer: Pointer; Size: integer; var SockAddrIn: TSockAddrIn): integer;
-begin
- Result:= SocketWriteBufferTo(Socket, Buffer, Size, 0, SockAddrIn);
-end;
-
-function TUDPServer.ReadBuffer(Socket: TSocket; Buffer: Pointer; Size: integer; var SockAddrIn: TSockAddrIn): integer;
-begin
- Result:= SocketReadBufferFrom(Socket, Buffer, Size, 0, SockAddrIn);
-end;
-
-end.
diff --git a/Host/Source/MicroBoot/interfaces/net/XcpSettings.dfm b/Host/Source/MicroBoot/interfaces/net/XcpSettings.dfm
deleted file mode 100644
index 1d9d91c6..00000000
Binary files a/Host/Source/MicroBoot/interfaces/net/XcpSettings.dfm and /dev/null differ
diff --git a/Host/Source/MicroBoot/interfaces/net/XcpSettings.pas b/Host/Source/MicroBoot/interfaces/net/XcpSettings.pas
deleted file mode 100644
index 15b41053..00000000
--- a/Host/Source/MicroBoot/interfaces/net/XcpSettings.pas
+++ /dev/null
@@ -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 *******************************
-
-
diff --git a/Host/Source/MicroBoot/interfaces/net/XcpTransport.pas b/Host/Source/MicroBoot/interfaces/net/XcpTransport.pas
deleted file mode 100644
index 79bd37cc..00000000
--- a/Host/Source/MicroBoot/interfaces/net/XcpTransport.pas
+++ /dev/null
@@ -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 ******************************
-
diff --git a/Host/Source/MicroBoot/interfaces/net/net_icon.bmp b/Host/Source/MicroBoot/interfaces/net/net_icon.bmp
deleted file mode 100644
index 32e6de3f..00000000
Binary files a/Host/Source/MicroBoot/interfaces/net/net_icon.bmp and /dev/null differ
diff --git a/Host/Source/MicroBoot/interfaces/net/openblt_net.dpr b/Host/Source/MicroBoot/interfaces/net/openblt_net.dpr
deleted file mode 100644
index 38bda578..00000000
--- a/Host/Source/MicroBoot/interfaces/net/openblt_net.dpr
+++ /dev/null
@@ -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 *****************************
diff --git a/Host/Source/MicroBoot/interfaces/net/openblt_net.dproj b/Host/Source/MicroBoot/interfaces/net/openblt_net.dproj
deleted file mode 100644
index 1a5e6dbc..00000000
--- a/Host/Source/MicroBoot/interfaces/net/openblt_net.dproj
+++ /dev/null
@@ -1,121 +0,0 @@
-
-
- {B16E2683-DC28-4FA8-9418-7F3350903FA7}
- openblt_net.dpr
- True
- Debug
- 1
- Library
- VCL
- 18.2
- Win32
-
-
- true
-
-
- true
- Base
- true
-
-
- true
- Base
- true
-
-
- true
- Base
- true
-
-
- true
- Cfg_2
- true
- true
-
-
- true
- true
- Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40;IcsDel40;$(DCC_UsePackage)
- false
- false
- 1
- 1
- false
- openblt_net
- 1
- false
- true
- ../../../../
- 00400000
- 1043
- CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=
- Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace)
-
-
- 1033
- System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
- true
-
-
- 0
- 0
- false
- RELEASE;$(DCC_Define)
-
-
- true
- DEBUG;$(DCC_Define)
- false
-
-
- CompanyName=;FileVersion=1.1.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.1.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName)
- 1
- (None)
- 1033
- C:\Work\software\OpenBLT\Host\MicroBoot.exe
- true
-
-
-
- MainSource
-
-
-
-
-
-
-
-
-
-
- Cfg_2
- Base
-
-
- Base
-
-
- Cfg_1
- Base
-
-
-
- Delphi.Personality.12
-
-
-
-
- openblt_net.dpr
-
-
-
- True
-
-
- 12
-
-
-
-
diff --git a/Host/Source/MicroBoot/interfaces/uart/CPDrv.ico b/Host/Source/MicroBoot/interfaces/uart/CPDrv.ico
deleted file mode 100644
index d0125faa..00000000
Binary files a/Host/Source/MicroBoot/interfaces/uart/CPDrv.ico and /dev/null differ
diff --git a/Host/Source/MicroBoot/interfaces/uart/CPort.inc b/Host/Source/MicroBoot/interfaces/uart/CPort.inc
deleted file mode 100644
index eb736695..00000000
--- a/Host/Source/MicroBoot/interfaces/uart/CPort.inc
+++ /dev/null
@@ -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}
-
diff --git a/Host/Source/MicroBoot/interfaces/uart/CPort.pas b/Host/Source/MicroBoot/interfaces/uart/CPort.pas
deleted file mode 100644
index 286cbcc1..00000000
--- a/Host/Source/MicroBoot/interfaces/uart/CPort.pas
+++ /dev/null
@@ -1,3652 +0,0 @@
-(******************************************************
- * ComPort Library ver. 4.11 *
- * for Delphi 5, 6, 7, 2007-2010,XE and *
- * C++ Builder 3, 4, 5, 6 *
- * written by Dejan Crnila, 1998 - 2002 *
- * maintained by Lars B. Dybdahl, 2003 *
- * Homepage: http://comport.sf.net/ *
- * *
- * Brian Gochnauer Oct 2010 *
- * Removed ansi references for backward compat *
- * Made unicode ready *
- *****************************************************)
-
-
-unit CPort;
-{$Warnings OFF}
-{$I CPort.inc}
-{$DEFINE No_Dialogs} //removes forms setup/config code
-interface
-
-uses
- Windows, Messages, Classes, SysUtils, IniFiles, Registry, Types;
-
-type
- TComExceptions = ( CE_OpenFailed , CE_WriteFailed ,
- CE_ReadFailed , CE_InvalidAsync ,
- CE_PurgeFailed , CE_AsyncCheck ,
- CE_SetStateFailed , CE_TimeoutsFailed ,
- CE_SetupComFailed , CE_ClearComFailed ,
- CE_ModemStatFailed , CE_EscapeComFailed ,
- CE_TransmitFailed , CE_ConnChangeProp ,
- CE_EnumPortsFailed , CE_StoreFailed ,
- CE_LoadFailed , CE_RegFailed ,
- CE_LedStateFailed , CE_ThreadCreated ,
- CE_WaitFailed , CE_HasLink ,
- CE_RegError , CEPortNotOpen );
-
-
-
-
- // various types
- TPort = string;
- TBaudRate = (brCustom, br110, br300, br600, br1200, br2400, br4800, br9600, br14400,
- br19200, br38400, br56000, br57600, br115200, br128000, br256000);
- TStopBits = (sbOneStopBit, sbOne5StopBits, sbTwoStopBits);
- TDataBits = (dbFive, dbSix, dbSeven, dbEight);
- TParityBits = (prNone, prOdd, prEven, prMark, prSpace);
- TDTRFlowControl = (dtrDisable, dtrEnable, dtrHandshake);
- TRTSFlowControl = (rtsDisable, rtsEnable, rtsHandshake, rtsToggle);
- TFlowControl = (fcHardware, fcSoftware, fcNone, fcCustom);
- TComEvent = (evRxChar, evTxEmpty, evRxFlag, evRing, evBreak, evCTS, evDSR, evError, evRLSD, evRx80Full);
- TComEvents = set of TComEvent;
- TComSignal = (csCTS, csDSR, csRing, csRLSD);
- TComSignals = set of TComSignal;
- TComError = (ceFrame, ceRxParity, ceOverrun, ceBreak, ceIO, ceMode, ceRxOver, ceTxFull);
- TComErrors = set of TComError;
- TSyncMethod = (smThreadSync, smWindowSync, smNone);
- TStoreType = (stRegistry, stIniFile);
- TStoredProp = (spBasic, spFlowControl, spBuffer, spTimeouts, spParity, spOthers);
- TStoredProps = set of TStoredProp;
- TComLinkEvent = (leConn, leCTS, leDSR, leRLSD, leRing, leRx, leTx, leTxEmpty, leRxFlag);
- TRxCharEvent = procedure(Sender: TObject; Count: Integer) of object;
- TRxBufEvent = procedure(Sender: TObject; const Buffer; Count: Integer) of object;
- TComErrorEvent = procedure(Sender: TObject; Errors: TComErrors) of object;
- TComSignalEvent = procedure(Sender: TObject; OnOff: Boolean) of object;
- TComExceptionEvent = procedure(Sender:TObject;
- TComException:TComExceptions; ComportMessage:String;
- WinError:Int64; WinMessage:String) of object;
-
- // types for asynchronous calls
- TOperationKind = (okWrite, okRead);
- TAsync = record
- Overlapped: TOverlapped;
- Kind: TOperationKind;
- Data: Pointer;
- Size: Integer;
- end;
- PAsync = ^TAsync;
-
- {$IFNDEF Unicode}
- UnicodeString = Widestring;
- {$ENDIF}
-
- // TComPort component and asistant classes
- TCustomComPort = class; // forward declaration
-
- // class that links TCustomComPort events to other components
- TComLink = class
- private
- FOnConn: TComSignalEvent;
- FOnRxBuf: TRxBufEvent;
- FOnTxBuf: TRxBufEvent;
- FOnTxEmpty: TNotifyEvent;
- FOnRxFlag: TNotifyEvent;
- FOnCTSChange: TComSignalEvent;
- FOnDSRChange: TComSignalEvent;
- FOnRLSDChange: TComSignalEvent;
- FOnRing: TNotifyEvent;
- FOnTx: TComSignalEvent;
- FOnRx: TComSignalEvent;
- public
- property OnConn: TComSignalEvent read FOnConn write FOnConn;
- property OnRxBuf: TRxBufEvent read FOnRxBuf write FOnRxBuf;
- property OnTxBuf: TRxBufEvent read FOnTxBuf write FOnTxBuf;
- property OnTxEmpty: TNotifyEvent read FOnTxEmpty write FOnTxEmpty;
- property OnRxFlag: TNotifyEvent read FOnRxFlag write FOnRxFlag;
- property OnCTSChange: TComSignalEvent read FOnCTSChange write FOnCTSChange;
- property OnDSRChange: TComSignalEvent read FOnDSRChange write FOnDSRChange;
- property OnRLSDChange: TComSignalEvent read FOnRLSDChange write FOnRLSDChange;
- property OnRing: TNotifyEvent read FOnRing write FOnRing;
- property OnTx: TComSignalEvent read FOnTx write FOnTx;
- property OnRx: TComSignalEvent read FOnRx write FOnRx;
- end;
-
- // thread for background monitoring of port events
- TComThread = class(TThread)
- private
- FComPort: TCustomComPort;
- FStopEvent: THandle;
- FEvents: TComEvents;
- protected
- procedure DispatchComMsg;
- procedure DoEvents;
- procedure Execute; override;
- procedure SendEvents;
- procedure Stop;
- public
- constructor Create(AComPort: TCustomComPort);
- destructor Destroy; override;
- end;
-
- // timoeout properties for read/write operations
- TComTimeouts = class(TPersistent)
- private
- FComPort: TCustomComPort;
- FReadInterval: Integer;
- FReadTotalM: Integer;
- FReadTotalC: Integer;
- FWriteTotalM: Integer;
- FWriteTotalC: Integer;
- procedure SetComPort(const AComPort: TCustomComPort);
- procedure SetReadInterval(const Value: Integer);
- procedure SetReadTotalM(const Value: Integer);
- procedure SetReadTotalC(const Value: Integer);
- procedure SetWriteTotalM(const Value: Integer);
- procedure SetWriteTotalC(const Value: Integer);
- protected
- procedure AssignTo(Dest: TPersistent); override;
- public
- constructor Create;
- property ComPort: TCustomComPort read FComPort;
- published
- property ReadInterval: Integer read FReadInterval write SetReadInterval default -1;
- property ReadTotalMultiplier: Integer read FReadTotalM write SetReadTotalM default 0;
- property ReadTotalConstant: Integer read FReadTotalC write SetReadTotalC default 0;
- property WriteTotalMultiplier: Integer
- read FWriteTotalM write SetWriteTotalM default 100;
- property WriteTotalConstant: Integer
- read FWriteTotalC write SetWriteTotalC default 1000;
- end;
-
- // flow control settings
- TComFlowControl = class(TPersistent)
- private
- FComPort: TCustomComPort;
- FOutCTSFlow: Boolean;
- FOutDSRFlow: Boolean;
- FControlDTR: TDTRFlowControl;
- FControlRTS: TRTSFlowControl;
- FXonXoffOut: Boolean;
- FXonXoffIn: Boolean;
- FDSRSensitivity: Boolean;
- FTxContinueOnXoff: Boolean;
- FXonChar: Char;
- FXoffChar: Char;
- procedure SetComPort(const AComPort: TCustomComPort);
- procedure SetOutCTSFlow(const Value: Boolean);
- procedure SetOutDSRFlow(const Value: Boolean);
- procedure SetControlDTR(const Value: TDTRFlowControl);
- procedure SetControlRTS(const Value: TRTSFlowControl);
- procedure SetXonXoffOut(const Value: Boolean);
- procedure SetXonXoffIn(const Value: Boolean);
- procedure SetDSRSensitivity(const Value: Boolean);
- procedure SetTxContinueOnXoff(const Value: Boolean);
- procedure SetXonChar(const Value: Char);
- procedure SetXoffChar(const Value: Char);
- procedure SetFlowControl(const Value: TFlowControl);
- function GetFlowControl: TFlowControl;
- protected
- procedure AssignTo(Dest: TPersistent); override;
- public
- constructor Create;
- property ComPort: TCustomComPort read FComPort;
- published
- property FlowControl: TFlowControl read GetFlowControl write SetFlowControl stored False;
- property OutCTSFlow: Boolean read FOutCTSFlow write SetOutCTSFlow;
- property OutDSRFlow: Boolean read FOutDSRFlow write SetOutDSRFlow;
- property ControlDTR: TDTRFlowControl read FControlDTR write SetControlDTR;
- property ControlRTS: TRTSFlowControl read FControlRTS write SetControlRTS;
- property XonXoffOut: Boolean read FXonXoffOut write SetXonXoffOut;
- property XonXoffIn: Boolean read FXonXoffIn write SetXonXoffIn;
- property DSRSensitivity: Boolean
- read FDSRSensitivity write SetDSRSensitivity default False;
- property TxContinueOnXoff: Boolean
- read FTxContinueOnXoff write SetTxContinueOnXoff default False;
- property XonChar: Char read FXonChar write SetXonChar default #17;
- property XoffChar: Char read FXoffChar write SetXoffChar default #19;
- end;
-
- // parity settings
- TComParity = class(TPersistent)
- private
- FComPort: TCustomComPort;
- FBits: TParityBits;
- FCheck: Boolean;
- FReplace: Boolean;
- FReplaceChar: Char;
- procedure SetComPort(const AComPort: TCustomComPort);
- procedure SetBits(const Value: TParityBits);
- procedure SetCheck(const Value: Boolean);
- procedure SetReplace(const Value: Boolean);
- procedure SetReplaceChar(const Value: Char);
- protected
- procedure AssignTo(Dest: TPersistent); override;
- public
- constructor Create;
- property ComPort: TCustomComPort read FComPort;
- published
- property Bits: TParityBits read FBits write SetBits;
- property Check: Boolean read FCheck write SetCheck default False;
- property Replace: Boolean read FReplace write SetReplace default False;
- property ReplaceChar: Char read FReplaceChar write SetReplaceChar default #0;
- end;
-
- // buffer size settings
- TComBuffer = class(TPersistent)
- private
- FComPort: TCustomComPort;
- FInputSize: Integer;
- FOutputSize: Integer;
- procedure SetComPort(const AComPort: TCustomComPort);
- procedure SetInputSize(const Value: Integer);
- procedure SetOutputSize(const Value: Integer);
- protected
- procedure AssignTo(Dest: TPersistent); override;
- public
- constructor Create;
- property ComPort: TCustomComPort read FComPort;
- published
- property InputSize: Integer read FInputSize write SetInputSize default 1024;
- property OutputSize: Integer read FOutputSize write SetOutputSize default 1024;
- end;
-
- // main component
- TCustomComPort = class(TComponent)
- private
- FEventThread: TComThread;
- FThreadCreated: Boolean;
- FHandle: THandle;
- FWindow: THandle;
- FUpdateCount: Integer;
- FLinks: TList;
- FTriggersOnRxChar: Boolean;
- FEventThreadPriority: TThreadPriority;
- FHasLink: Boolean;
- FConnected: Boolean;
- FBaudRate: TBaudRate;
- FCustomBaudRate: Integer;
- FPort: TPort;
- FStopBits: TStopBits;
- FDataBits: TDataBits;
- FDiscardNull: Boolean;
- FEventChar: Char;
- FEvents: TComEvents;
- FBuffer: TComBuffer;
- FParity: TComParity;
- FTimeouts: TComTimeouts;
- FFlowControl: TComFlowControl;
- FSyncMethod: TSyncMethod;
- FStoredProps: TStoredProps;
- FOnRxChar: TRxCharEvent;
- FOnRxBuf: TRxBufEvent;
- FOnTxEmpty: TNotifyEvent;
- FOnBreak: TNotifyEvent;
- FOnRing: TNotifyEvent;
- FOnCTSChange: TComSignalEvent;
- FOnDSRChange: TComSignalEvent;
- FOnRLSDChange: TComSignalEvent;
- FOnError: TComErrorEvent;
- FOnRxFlag: TNotifyEvent;
- FOnAfterOpen: TNotifyEvent;
- FOnAfterClose: TNotifyEvent;
- FOnBeforeOpen: TNotifyEvent;
- FOnBeforeClose: TNotifyEvent;
- FOnRx80Full : TNotifyEvent;
- FOnException :TComExceptionEvent;
- FCodePage : Cardinal;
- function GetTriggersOnRxChar: Boolean;
- procedure SetTriggersOnRxChar(const Value: Boolean);
- procedure SetConnected(const Value: Boolean);
- procedure SetBaudRate(const Value: TBaudRate);
- procedure SetCustomBaudRate(const Value: Integer);
- procedure SetPort(const Value: TPort);
- procedure SetStopBits(const Value: TStopBits);
- procedure SetDataBits(const Value: TDataBits);
- procedure SetDiscardNull(const Value: Boolean);
- procedure SetEventChar(const Value: Char);
- procedure SetSyncMethod(const Value: TSyncMethod);
- procedure SetEventThreadPriority(const Value: TThreadPriority);
- procedure SetParity(const Value: TComParity);
- procedure SetTimeouts(const Value: TComTimeouts);
- procedure SetBuffer(const Value: TComBuffer);
- procedure SetFlowControl(const Value: TComFlowControl);
- function HasLink: Boolean;
- procedure TxNotifyLink(const Buffer; Count: Integer);
- procedure NotifyLink(FLinkEvent: TComLinkEvent);
- procedure SendSignalToLink(Signal: TComLinkEvent; OnOff: Boolean);
- procedure CheckSignals(Open: Boolean);
- procedure WindowMethod(var Message: TMessage);
- procedure CallAfterOpen;
- procedure CallAfterClose;
- procedure CallBeforeOpen;
- procedure CallBeforeClose;
- procedure CallRxChar;
- procedure CallTxEmpty;
- procedure CallBreak;
- procedure CallRing;
- procedure CallRxFlag;
- procedure CallCTSChange;
- procedure CallDSRChange;
- procedure CallError;
- procedure CallRLSDChange;
- procedure CallRx80Full;
- procedure CallException(AnException: Word; const WinError: Int64 =0);
- protected
- procedure Loaded; override;
- procedure DoAfterClose; dynamic;
- procedure DoAfterOpen; dynamic;
- procedure DoBeforeClose; dynamic;
- procedure DoBeforeOpen; dynamic;
- procedure DoRxChar(Count: Integer); dynamic;
- procedure DoRxBuf(const Buffer; Count: Integer); dynamic;
- procedure DoTxEmpty; dynamic;
- procedure DoBreak; dynamic;
- procedure DoRing; dynamic;
- procedure DoRxFlag; dynamic;
- procedure DoCTSChange(OnOff: Boolean); dynamic;
- procedure DoDSRChange(OnOff: Boolean); dynamic;
- procedure DoError(Errors: TComErrors); dynamic;
- procedure DoRLSDChange(OnOff: Boolean); dynamic;
- procedure DoRx80Full; dynamic;
- procedure StoreRegistry(Reg: TRegistry); virtual;
- procedure StoreIniFile(IniFile: TIniFile); virtual;
- procedure LoadRegistry(Reg: TRegistry); virtual;
- procedure LoadIniFile(IniFile: TIniFile); virtual;
- procedure CreateHandle; virtual;
- procedure DestroyHandle; virtual;
- procedure ApplyDCB; dynamic;
- procedure ApplyTimeouts; dynamic;
- procedure ApplyBuffer; dynamic;
- procedure SetupComPort; virtual;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure BeginUpdate;
- procedure EndUpdate;
- procedure StoreSettings(StoreType: TStoreType; StoreTo: string);
- procedure LoadSettings(StoreType: TStoreType; LoadFrom: string);
- procedure Open;
- procedure Close;
- {$IFNDEF No_Dialogs}procedure ShowSetupDialog;{$ENDIF}
- function InputCount: Integer;
- function OutputCount: Integer;
- function Signals: TComSignals;
- function StateFlags: TComStateFlags;
- procedure SetDTR(OnOff: Boolean);
- procedure SetRTS(OnOff: Boolean);
- procedure SetXonXoff(OnOff: Boolean);
- procedure SetBreak(OnOff: Boolean);
- procedure ClearBuffer(Input, Output: Boolean);
- function LastErrors: TComErrors;
-
- function Write(const Buffer; Count: Integer): Integer;
- function WriteStr( Str: string): Integer;
- function Read(var Buffer; Count: Integer): Integer;
- function ReadStr(var Str: string; Count: Integer): Integer;
- function WriteAsync(const Buffer; Count: Integer; var AsyncPtr: PAsync): Integer;
- function WriteStrAsync(var Str: string; var AsyncPtr: PAsync): Integer;
- function ReadAsync(var Buffer; Count: Integer; var AsyncPtr: PAsync): Integer;
- function ReadStrAsync(var Str: Ansistring; Count: Integer; var AsyncPtr: PAsync): Integer;
- function WriteUnicodeString(const Str: Unicodestring): Integer;
- function ReadUnicodeString(var Str: UnicodeString; Count: Integer): Integer;
-
- function WaitForAsync(var AsyncPtr: PAsync): Integer;
- function IsAsyncCompleted(AsyncPtr: PAsync): Boolean;
- procedure WaitForEvent(var Events: TComEvents; StopEvent: THandle; Timeout: Integer);
- procedure AbortAllAsync;
- procedure TransmitChar(Ch: Char);
- procedure RegisterLink(AComLink: TComLink);
- procedure UnRegisterLink(AComLink: TComLink);
- property Handle: THandle read FHandle;
- property TriggersOnRxChar: Boolean read GetTriggersOnRxChar write SetTriggersOnRxChar;
- property EventThreadPriority: TThreadPriority read FEventThreadPriority write SetEventThreadPriority;
- property StoredProps: TStoredProps read FStoredProps write FStoredProps;
- property Connected: Boolean read FConnected write SetConnected default False;
- property BaudRate: TBaudRate read FBaudRate write SetBaudRate;
- property CustomBaudRate: Integer read FCustomBaudRate write SetCustomBaudRate;
- property Port: TPort read FPort write SetPort;
- property Parity: TComParity read FParity write SetParity;
- property StopBits: TStopBits read FStopBits write SetStopBits;
- property DataBits: TDataBits read FDataBits write SetDataBits;
- property DiscardNull: Boolean read FDiscardNull write SetDiscardNull default False;
- property EventChar: Char read FEventChar write SetEventChar default #0;
- property Events: TComEvents read FEvents write FEvents;
- property Buffer: TComBuffer read FBuffer write SetBuffer;
- property FlowControl: TComFlowControl read FFlowControl write SetFlowControl;
- property Timeouts: TComTimeouts read FTimeouts write SetTimeouts;
- property SyncMethod: TSyncMethod read FSyncMethod write SetSyncMethod default smThreadSync;
- property OnAfterOpen: TNotifyEvent read FOnAfterOpen write FOnAfterOpen;
- property OnAfterClose: TNotifyEvent read FOnAfterClose write FOnAfterClose;
- property OnBeforeOpen: TNotifyEvent read FOnBeforeOpen write FOnBeforeOpen;
- property OnBeforeClose: TNotifyEvent read FOnBeforeClose write FOnBeforeClose;
- property OnRxChar: TRxCharEvent read FOnRxChar write FOnRxChar;
- property OnRxBuf: TRxBufEvent read FOnRxBuf write FOnRxBuf;
- property OnTxEmpty: TNotifyEvent read FOnTxEmpty write FOnTxEmpty;
- property OnBreak: TNotifyEvent read FOnBreak write FOnBreak;
- property OnRing: TNotifyEvent read FOnRing write FOnRing;
- property OnCTSChange: TComSignalEvent read FOnCTSChange write FOnCTSChange;
- property OnDSRChange: TComSignalEvent read FOnDSRChange write FOnDSRChange;
- property OnRLSDChange: TComSignalEvent read FOnRLSDChange write FOnRLSDChange;
- property OnRxFlag: TNotifyEvent read FOnRxFlag write FOnRxFlag;
- property OnError: TComErrorEvent read FOnError write FOnError;
- property OnRx80Full: TNotifyEvent read FOnRx80Full write FOnRx80Full;
- property OnException: TComExceptionEvent read FOnException write FOnException;
- // Translate strings between ANSI charsets
- property CodePage: Cardinal read FCodePage write FCodePage default 0;
- end;
-
- // publish the properties
- TComPort = class(TCustomComPort)
- property Connected;
- property BaudRate;
- property Port;
- property Parity;
- property StopBits;
- property DataBits;
- property DiscardNull;
- property EventChar;
- property Events;
- property Buffer;
- property FlowControl;
- property Timeouts;
- property StoredProps;
- property TriggersOnRxChar;
- property SyncMethod;
- property OnAfterOpen;
- property OnAfterClose;
- property OnBeforeOpen;
- property OnBeforeClose;
- property OnRxChar;
- property OnRxBuf;
- property OnTxEmpty;
- property OnBreak;
- property OnRing;
- property OnCTSChange;
- property OnDSRChange;
- property OnRLSDChange;
- property OnRxFlag;
- property OnError;
- property OnRx80Full;
- property OnException;
- property CodePage;
- end;
-
- TComStrEvent = procedure(Sender: TObject; const Str: string) of object;
- TCustPacketEvent = procedure(Sender: TObject; const Str: string;
- var Pos: Integer) of object;
-
- // component for reading data in packets
- TComDataPacket = class(TComponent)
- private
- FComLink: TComLink;
- FComPort: TCustomComPort;
- FStartString: string;
- FStopString: string;
- FMaxBufferSize: Integer;
- FSize: Integer;
- FIncludeStrings: Boolean;
- FCaseInsensitive: Boolean;
- FInPacket: Boolean;
- FBuffer: string;
- FOnPacket: TComStrEvent;
- FOnDiscard: TComStrEvent;
- FOnCustomStart: TCustPacketEvent;
- FOnCustomStop: TCustPacketEvent;
- procedure SetComPort(const Value: TCustomComPort);
- procedure SetCaseInsensitive(const Value: Boolean);
- procedure SetSize(const Value: Integer);
- procedure SetStartString(const Value: string);
- procedure SetStopString(const Value: string);
- procedure RxBuf(Sender: TObject; const Buffer; Count: Integer);
- procedure CheckIncludeStrings(var Str: string);
- function Upper(const Str: string): string;
- procedure EmptyBuffer;
- function ValidStop: Boolean;
- protected
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
- procedure DoDiscard(const Str: string); dynamic;
- procedure DoPacket(const Str: string); dynamic;
- procedure DoCustomStart(const Str: string; var Pos: Integer); dynamic;
- procedure DoCustomStop(const Str: string; var Pos: Integer); dynamic;
- procedure HandleBuffer; virtual;
- property Buffer: string read FBuffer write FBuffer;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure AddData(const Str: string);
- published
- procedure ResetBuffer;
- property ComPort: TCustomComPort read FComPort write SetComPort;
- property CaseInsensitive: Boolean read FCaseInsensitive write SetCaseInsensitive default False;
- property IncludeStrings: Boolean read FIncludeStrings write FIncludeStrings default False;
- property MaxBufferSize: Integer read FMaxBufferSize write FMaxBufferSize default 1024;
- property StartString: string read FStartString write SetStartString;
- property StopString: string read FStopString write SetStopString;
- property Size: Integer read FSize write SetSize default 0;
- property OnDiscard: TComStrEvent read FOnDiscard write FOnDiscard;
- property OnPacket: TComStrEvent read FOnPacket write FOnPacket;
- property OnCustomStart: TCustPacketEvent read FOnCustomStart write FOnCustomStart;
- property OnCustomStop: TCustPacketEvent read FOnCustomStop write FOnCustomStop;
- end;
-
- // com port stream
- TComStream = class(TStream)
- private
- FComPort: TCustomComPort;
- public
- constructor Create(AComPort: TCustomComPort);
- function Read(var Buffer; Count: Longint): Longint; override;
- function Write(const Buffer; Count: Longint): Longint; override;
- function Seek(Offset: Longint; Origin: Word): Longint; override;
- end;
-
- // exception class for ComPort Library errors
- EComPort = class(Exception)
- private
- FWinCode: Integer;
- FCode: Integer;
- public
- constructor Create(ACode: Integer; AWinCode: Integer);
- constructor CreateNoWinCode(ACode: Integer);
- property WinCode: Integer read FWinCode write FWinCode;
- property Code: Integer read FCode write FCode;
- end;
-
-// aditional procedures
-procedure InitAsync(var AsyncPtr: PAsync);
-procedure DoneAsync(var AsyncPtr: PAsync);
-procedure EnumComPorts(Ports: TStrings);
-
-// conversion functions
-function StrToBaudRate(Str: string): TBaudRate;
-function StrToStopBits(Str: string): TStopBits;
-function StrToDataBits(Str: string): TDataBits;
-function StrToParity(Str: string): TParityBits;
-function StrToFlowControl(Str: string): TFlowControl;
-function BaudRateToStr(BaudRate: TBaudRate): string;
-function StopBitsToStr(StopBits: TStopBits): string;
-function DataBitsToStr(DataBits: TDataBits): string;
-function ParityToStr(Parity: TParityBits): string;
-function FlowControlToStr(FlowControl: TFlowControl): string;
-function ComErrorsToStr(Errors:TComErrors):String;
-
-const
- // infinite wait
- WaitInfinite = Integer(INFINITE);
-
- // error codes
- CError_OpenFailed = 1;
- CError_WriteFailed = 2;
- CError_ReadFailed = 3;
- CError_InvalidAsync = 4;
- CError_PurgeFailed = 5;
- CError_AsyncCheck = 6;
- CError_SetStateFailed = 7;
- CError_TimeoutsFailed = 8;
- CError_SetupComFailed = 9;
- CError_ClearComFailed = 10;
- CError_ModemStatFailed = 11;
- CError_EscapeComFailed = 12;
- CError_TransmitFailed = 13;
- CError_ConnChangeProp = 14;
- CError_EnumPortsFailed = 15;
- CError_StoreFailed = 16;
- CError_LoadFailed = 17;
- CError_RegFailed = 18;
- CError_LedStateFailed = 19;
- CError_ThreadCreated = 20;
- CError_WaitFailed = 21;
- CError_HasLink = 22;
- CError_RegError = 23;
- CError_PortNotOpen = 24;
-
-implementation
-
-uses
- {$IFNDEF No_Dialogs} CPortSetup, {$ENDIF}
- Controls, Forms, WinSpool;
-
-var
- // error messages
- ComErrorMessages: array[1..24] of widestring;
-
-const
- // auxilary constants used not defined in windows.pas
- dcb_Binary = $00000001;
- dcb_Parity = $00000002;
- dcb_OutxCTSFlow = $00000004;
- dcb_OutxDSRFlow = $00000008;
- dcb_DTRControl = $00000030;
- dcb_DSRSensivity = $00000040;
- dcb_TxContinueOnXoff = $00000080;
- dcb_OutX = $00000100;
- dcb_InX = $00000200;
- dcb_ErrorChar = $00000400;
- dcb_Null = $00000800;
- dcb_RTSControl = $00003000;
- dcb_AbortOnError = $00004000;
-
- // com port window message
- CM_COMPORT = WM_USER + 1;
-
-(*****************************************
- * auxilary functions and procedures *
- *****************************************)
-function ComErrorsToStr(Errors:TComErrors):String;
- procedure e(msg:String);
- begin
- if result='' then
- result := msg
- else
- result := result+','+msg;
- end;
-begin
- result := '';
- if ceFrame in Errors then e('Frame');
- if ceRxParity in Errors then e('Parity');
- if ceOverrun in Errors then e('Overrun');
- if ceBreak in Errors then e('Break');
- if ceIO in Errors then e('IO');
- if ceMode in Errors then e('Mode');
- if ceRxOver in Errors then e('RxOver');
- if ceTxFull in Errors then e('TxFull');
- if result = '' then
- result := ''
- else
- result := '';
-end;
-
-// converts TComEvents type to Integer
-function EventsToInt(const Events: TComEvents): Integer;
-begin
- Result := 0;
- if evRxChar in Events then
- Result := Result or EV_RXCHAR;
- if evRxFlag in Events then
- Result := Result or EV_RXFLAG;
- if evTxEmpty in Events then
- Result := Result or EV_TXEMPTY;
- if evRing in Events then
- Result := Result or EV_RING;
- if evCTS in Events then
- Result := Result or EV_CTS;
- if evDSR in Events then
- Result := Result or EV_DSR;
- if evRLSD in Events then
- Result := Result or EV_RLSD;
- if evError in Events then
- Result := Result or EV_ERR;
- if evBreak in Events then
- Result := Result or EV_BREAK;
- if evRx80Full in Events then
- Result := Result or EV_RX80FULL;
-end;
-
-function IntToEvents(Mask: Integer): TComEvents;
-begin
- Result := [];
- if (EV_RXCHAR and Mask) <> 0 then
- Result := Result + [evRxChar];
- if (EV_TXEMPTY and Mask) <> 0 then
- Result := Result + [evTxEmpty];
- if (EV_BREAK and Mask) <> 0 then
- Result := Result + [evBreak];
- if (EV_RING and Mask) <> 0 then
- Result := Result + [evRing];
- if (EV_CTS and Mask) <> 0 then
- Result := Result + [evCTS];
- if (EV_DSR and Mask) <> 0 then
- Result := Result + [evDSR];
- if (EV_RXFLAG and Mask) <> 0 then
- Result := Result + [evRxFlag];
- if (EV_RLSD and Mask) <> 0 then
- Result := Result + [evRLSD];
- if (EV_ERR and Mask) <> 0 then
- Result := Result + [evError];
- if (EV_RX80FULL and Mask) <> 0 then
- Result := Result + [evRx80Full];
-end;
-
-(*****************************************
- * TComThread class *
- *****************************************)
-
-// create thread
-constructor TComThread.Create(AComPort: TCustomComPort);
-begin
- inherited Create(false);
- FStopEvent := CreateEvent(nil, True, False, nil);
- FComPort := AComPort;
- // set thread priority
- Priority := FComPort.EventThreadPriority;
- // select which events are monitored
- SetCommMask(FComPort.Handle, EventsToInt(FComPort.Events));
- // execute thread
- //{$IFDEF Unicode}Start; {$ELSE} Resume; {$ENDIF}
-end;
-
-// destroy thread
-destructor TComThread.Destroy;
-begin
- Stop;
- inherited Destroy;
-end;
-
-// thread action
-procedure TComThread.Execute;
-var
- EventHandles: array[0..1] of THandle;
- Overlapped: TOverlapped;
- Signaled, BytesTrans, Mask: DWORD;
-begin
- FillChar(Overlapped, SizeOf(Overlapped), 0);
- Overlapped.hEvent := CreateEvent(nil, True, True, nil);
- EventHandles[0] := FStopEvent;
- EventHandles[1] := Overlapped.hEvent;
- repeat
- // wait for event to occur on serial port
- WaitCommEvent(FComPort.Handle, Mask, @Overlapped);
- Signaled := WaitForMultipleObjects(2, @EventHandles, False, INFINITE);
- // if event occurs, dispatch it
- if (Signaled = WAIT_OBJECT_0 + 1)
- and GetOverlappedResult(FComPort.Handle, Overlapped, BytesTrans, False)
- then
- begin
- FEvents := IntToEvents(Mask);
- DispatchComMsg;
- end;
- until Signaled <> (WAIT_OBJECT_0 + 1);
- // clear buffers
- SetCommMask(FComPort.Handle, 0);
- PurgeComm(FComPort.Handle, PURGE_TXCLEAR or PURGE_RXCLEAR);
- CloseHandle(Overlapped.hEvent);
- CloseHandle(FStopEvent);
-end;
-
-// stop thread
-procedure TComThread.Stop;
-begin
- SetEvent(FStopEvent);
- Sleep(0);
-end;
-
-// dispatch events
-procedure TComThread.DispatchComMsg;
-begin
- case FComPort.SyncMethod of
- smThreadSync: Synchronize(DoEvents); // call events in main thread
- smWindowSync: SendEvents; // call events in thread that opened the port
- smNone: DoEvents; // call events inside monitoring thread
- end;
-end;
-
-// send events to TCustomComPort component using window message
-procedure TComThread.SendEvents;
-begin
- if evError in FEvents then
- SendMessage(FComPort.FWindow, CM_COMPORT, EV_ERR, 0);
- if evRxChar in FEvents then
- SendMessage(FComPort.FWindow, CM_COMPORT, EV_RXCHAR, 0);
- if evTxEmpty in FEvents then
- SendMessage(FComPort.FWindow, CM_COMPORT, EV_TXEMPTY, 0);
- if evBreak in FEvents then
- SendMessage(FComPort.FWindow, CM_COMPORT, EV_BREAK, 0);
- if evRing in FEvents then
- SendMessage(FComPort.FWindow, CM_COMPORT, EV_RING, 0);
- if evCTS in FEvents then
- SendMessage(FComPort.FWindow, CM_COMPORT, EV_CTS, 0);
- if evDSR in FEvents then
- SendMessage(FComPort.FWindow, CM_COMPORT, EV_DSR, 0);
- if evRxFlag in FEvents then
- SendMessage(FComPort.FWindow, CM_COMPORT, EV_RXFLAG, 0);
- if evRing in FEvents then
- SendMessage(FComPort.FWindow, CM_COMPORT, EV_RLSD, 0);
- if evRx80Full in FEvents then
- SendMessage(FComPort.FWindow, CM_COMPORT, EV_RX80FULL, 0);
-end;
-
-// call events
-procedure TComThread.DoEvents;
-begin
- if evError in FEvents then
- FComPort.CallError;
- if evRxChar in FEvents then
- FComPort.CallRxChar;
- if evTxEmpty in FEvents then
- FComPort.CallTxEmpty;
- if evBreak in FEvents then
- FComPort.CallBreak;
- if evRing in FEvents then
- FComPort.CallRing;
- if evCTS in FEvents then
- FComPort.CallCTSChange;
- if evDSR in FEvents then
- FComPort.CallDSRChange;
- if evRxFlag in FEvents then
- FComPort.CallRxFlag;
- if evRLSD in FEvents then
- FComPort.CallRLSDChange;
- if evRx80Full in FEvents then
- FComPort.CallRx80Full;
-end;
-
-(*****************************************
- * TComTimeouts class *
- *****************************************)
-
-// create class
-constructor TComTimeouts.Create;
-begin
- inherited Create;
- FReadInterval := -1;
- FWriteTotalM := 100;
- FWriteTotalC := 1000;
-end;
-
-// copy properties to other class
-procedure TComTimeouts.AssignTo(Dest: TPersistent);
-begin
- if Dest is TComTimeouts then
- begin
- with TComTimeouts(Dest) do
- begin
- FReadInterval := Self.ReadInterval;
- FReadTotalM := Self.ReadTotalMultiplier;
- FReadTotalC := Self.ReadTotalConstant;
- FWriteTotalM := Self.WriteTotalMultiplier;
- FWriteTotalC := Self.WriteTotalConstant;
- end
- end
- else
- inherited AssignTo(Dest);
-end;
-
-// select TCustomComPort to own this class
-procedure TComTimeouts.SetComPort(const AComPort: TCustomComPort);
-begin
- FComPort := AComPort;
-end;
-
-// set read interval
-procedure TComTimeouts.SetReadInterval(const Value: Integer);
-begin
- if Value <> FReadInterval then
- begin
- FReadInterval := Value;
- // if possible, apply the changes
- if FComPort <> nil then
- FComPort.ApplyTimeouts;
- end;
-end;
-
-// set read total constant
-procedure TComTimeouts.SetReadTotalC(const Value: Integer);
-begin
- if Value <> FReadTotalC then
- begin
- FReadTotalC := Value;
- if FComPort <> nil then
- FComPort.ApplyTimeouts;
- end;
-end;
-
-// set read total multiplier
-procedure TComTimeouts.SetReadTotalM(const Value: Integer);
-begin
- if Value <> FReadTotalM then
- begin
- FReadTotalM := Value;
- if FComPort <> nil then
- FComPort.ApplyTimeouts;
- end;
-end;
-
-// set write total constant
-procedure TComTimeouts.SetWriteTotalC(const Value: Integer);
-begin
- if Value <> FWriteTotalC then
- begin
- FWriteTotalC := Value;
- if FComPort <> nil then
- FComPort.ApplyTimeouts;
- end;
-end;
-
-// set write total multiplier
-procedure TComTimeouts.SetWriteTotalM(const Value: Integer);
-begin
- if Value <> FWriteTotalM then
- begin
- FWriteTotalM := Value;
- if FComPort <> nil then
- FComPort.ApplyTimeouts;
- end;
-end;
-
-(*****************************************
- * TComFlowControl class *
- *****************************************)
-
-// create class
-constructor TComFlowControl.Create;
-begin
- inherited Create;
- FXonChar := #17;
- FXoffChar := #19;
-end;
-
-// copy properties to other class
-procedure TComFlowControl.AssignTo(Dest: TPersistent);
-begin
- if Dest is TComFlowControl then
- begin
- with TComFlowControl(Dest) do
- begin
- FOutCTSFlow := Self.OutCTSFlow;
- FOutDSRFlow := Self.OutDSRFlow;
- FControlDTR := Self.ControlDTR;
- FControlRTS := Self.ControlRTS;
- FXonXoffOut := Self.XonXoffOut;
- FXonXoffIn := Self.XonXoffIn;
- FTxContinueOnXoff := Self.TxContinueOnXoff;
- FDSRSensitivity := Self.DSRSensitivity;
- FXonChar := Self.XonChar;
- FXoffChar := Self.XoffChar;
- end
- end
- else
- inherited AssignTo(Dest);
-end;
-
-// select TCustomComPort to own this class
-procedure TComFlowControl.SetComPort(const AComPort: TCustomComPort);
-begin
- FComPort := AComPort;
-end;
-
-// set input flow control for DTR (data-terminal-ready)
-procedure TComFlowControl.SetControlDTR(const Value: TDTRFlowControl);
-begin
- if Value <> FControlDTR then
- begin
- FControlDTR := Value;
- if FComPort <> nil then
- FComPort.ApplyDCB;
- end;
-end;
-
-// set input flow control for RTS (request-to-send)
-procedure TComFlowControl.SetControlRTS(const Value: TRTSFlowControl);
-begin
- if Value <> FControlRTS then
- begin
- FControlRTS := Value;
- if FComPort <> nil then
- FComPort.ApplyDCB;
- end;
-end;
-
-// set ouput flow control for CTS (clear-to-send)
-procedure TComFlowControl.SetOutCTSFlow(const Value: Boolean);
-begin
- if Value <> FOutCTSFlow then
- begin
- FOutCTSFlow := Value;
- if FComPort <> nil then
- FComPort.ApplyDCB;
- end;
-end;
-
-// set output flow control for DSR (data-set-ready)
-procedure TComFlowControl.SetOutDSRFlow(const Value: Boolean);
-begin
- if Value <> FOutDSRFlow then
- begin
- FOutDSRFlow := Value;
- if FComPort <> nil then
- FComPort.ApplyDCB;
- end;
-end;
-
-// set software input flow control
-procedure TComFlowControl.SetXonXoffIn(const Value: Boolean);
-begin
- if Value <> FXonXoffIn then
- begin
- FXonXoffIn := Value;
- if FComPort <> nil then
- FComPort.ApplyDCB;
- end;
-end;
-
-// set software ouput flow control
-procedure TComFlowControl.SetXonXoffOut(const Value: Boolean);
-begin
- if Value <> FXonXoffOut then
- begin
- FXonXoffOut := Value;
- if FComPort <> nil then
- FComPort.ApplyDCB;
- end;
-end;
-
-// set DSR sensitivity
-procedure TComFlowControl.SetDSRSensitivity(const Value: Boolean);
-begin
- if Value <> FDSRSensitivity then
- begin
- FDSRSensitivity := Value;
- if FComPort <> nil then
- FComPort.ApplyDCB;
- end;
-end;
-
-// set transfer continue when Xoff is sent
-procedure TComFlowControl.SetTxContinueOnXoff(const Value: Boolean);
-begin
- if Value <> FTxContinueOnXoff then
- begin
- FTxContinueOnXoff := Value;
- if FComPort <> nil then
- FComPort.ApplyDCB;
- end;
-end;
-
-// set Xon char
-procedure TComFlowControl.SetXonChar(const Value: Char);
-begin
- if Value <> FXonChar then
- begin
- FXonChar := Value;
- if FComPort <> nil then
- FComPort.ApplyDCB;
- end;
-end;
-
-// set Xoff char
-procedure TComFlowControl.SetXoffChar(const Value: Char);
-begin
- if Value <> FXoffChar then
- begin
- FXoffChar := Value;
- if FComPort <> nil then
- FComPort.ApplyDCB;
- end;
-end;
-
-// get common flow control
-function TComFlowControl.GetFlowControl: TFlowControl;
-begin
- if (FControlRTS = rtsHandshake) and (FOutCTSFlow)
- and (not FXonXoffIn) and (not FXonXoffOut)
- then
- Result := fcHardware
- else
- if (FControlRTS = rtsDisable) and (not FOutCTSFlow)
- and (FXonXoffIn) and (FXonXoffOut)
- then
- Result := fcSoftware
- else
- if (FControlRTS = rtsDisable) and (not FOutCTSFlow)
- and (not FXonXoffIn) and (not FXonXoffOut)
- then
- Result := fcNone
- else
- Result := fcCustom;
-end;
-
-// set common flow control
-procedure TComFlowControl.SetFlowControl(const Value: TFlowControl);
-begin
- if Value <> fcCustom then
- begin
- FControlRTS := rtsDisable;
- FOutCTSFlow := False;
- FXonXoffIn := False;
- FXonXoffOut := False;
- case Value of
- fcHardware:
- begin
- FControlRTS := rtsHandshake;
- FOutCTSFlow := True;
- end;
- fcSoftware:
- begin
- FXonXoffIn := True;
- FXonXoffOut := True;
- end;
- end;
- end;
- if FComPort <> nil then
- FComPort.ApplyDCB;
-end;
-
-(*****************************************
- * TComParity class *
- *****************************************)
-
-// create class
-constructor TComParity.Create;
-begin
- inherited Create;
- FBits := prNone;
-end;
-
-// copy properties to other class
-procedure TComParity.AssignTo(Dest: TPersistent);
-begin
- if Dest is TComParity then
- begin
- with TComParity(Dest) do
- begin
- FBits := Self.Bits;
- FCheck := Self.Check;
- FReplace := Self.Replace;
- FReplaceChar := Self.ReplaceChar;
- end
- end
- else
- inherited AssignTo(Dest);
-end;
-
-// select TCustomComPort to own this class
-procedure TComParity.SetComPort(const AComPort: TCustomComPort);
-begin
- FComPort := AComPort;
-end;
-
-// set parity bits
-procedure TComParity.SetBits(const Value: TParityBits);
-begin
- if Value <> FBits then
- begin
- FBits := Value;
- if FComPort <> nil then
- FComPort.ApplyDCB;
- end;
-end;
-
-// set check parity
-procedure TComParity.SetCheck(const Value: Boolean);
-begin
- if Value <> FCheck then
- begin
- FCheck := Value;
- if FComPort <> nil then
- FComPort.ApplyDCB;
- end;
-end;
-
-// set replace on parity error
-procedure TComParity.SetReplace(const Value: Boolean);
-begin
- if Value <> FReplace then
- begin
- FReplace := Value;
- if FComPort <> nil then
- FComPort.ApplyDCB;
- end;
-end;
-
-// set replace char
-procedure TComParity.SetReplaceChar(const Value: Char);
-begin
- if Value <> FReplaceChar then
- begin
- FReplaceChar := Value;
- if FComPort <> nil then
- FComPort.ApplyDCB;
- end;
-end;
-
-(*****************************************
- * TComBuffer class *
- *****************************************)
-
-// create class
-constructor TComBuffer.Create;
-begin
- inherited Create;
- FInputSize := 1024;
- FOutputSize := 1024;
-end;
-
-// copy properties to other class
-procedure TComBuffer.AssignTo(Dest: TPersistent);
-begin
- if Dest is TComBuffer then
- begin
- with TComBuffer(Dest) do
- begin
- FOutputSize := Self.OutputSize;
- FInputSize := Self.InputSize;
- end
- end
- else
- inherited AssignTo(Dest);
-end;
-
-// select TCustomComPort to own this class
-procedure TComBuffer.SetComPort(const AComPort: TCustomComPort);
-begin
- FComPort := AComPort;
-end;
-
-// set input size
-procedure TComBuffer.SetInputSize(const Value: Integer);
-begin
- if Value <> FInputSize then
- begin
- FInputSize := Value;
- if (FInputSize mod 2) = 1 then
- Dec(FInputSize);
- if FComPort <> nil then
- FComPort.ApplyBuffer;
- end;
-end;
-
-// set ouput size
-procedure TComBuffer.SetOutputSize(const Value: Integer);
-begin
- if Value <> FOutputSize then
- begin
- FOutputSize := Value;
- if (FOutputSize mod 2) = 1 then
- Dec(FOutputSize);
- if FComPort <> nil then
- FComPort.ApplyBuffer;
- end;
-end;
-
-(*****************************************
- * TCustomComPort component *
- *****************************************)
-
-// create component
-constructor TCustomComPort.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
- // component cannot reside on inheritable forms
- FComponentStyle := FComponentStyle - [csInheritable];
- FLinks := TList.Create;
- FTriggersOnRxChar := True;
- FEventThreadPriority := tpNormal;
- FBaudRate := br9600;
- FCustomBaudRate := 9600;
- FPort := 'COM1';
- FStopBits := sbOneStopBit;
- FDataBits := dbEight;
- FEvents := [evRxChar, evTxEmpty, evRxFlag, evRing, evBreak,
- evCTS, evDSR, evError, evRLSD, evRx80Full];
- FHandle := INVALID_HANDLE_VALUE;
- FStoredProps := [spBasic];
- FParity := TComParity.Create;
- FParity.SetComPort(Self);
- FFlowControl := TComFlowControl.Create;
- FFlowControl.SetComPort(Self);
- FTimeouts := TComTimeouts.Create;
- FTimeouts.SetComPort(Self);
- FBuffer := TComBuffer.Create;
- FBuffer.SetComPort(Self);
- FCodePage := CP_ACP;//0; // uses default system codepage
-end;
-
-// destroy component
-destructor TCustomComPort.Destroy;
-begin
- Close;
- FBuffer.Free;
- FFlowControl.Free;
- FTimeouts.Free;
- FParity.Free;
- inherited Destroy;
- FLinks.Free;
-end;
-
-//Handle Exceptions
-procedure TCustomComPort.CallException(AnException:Word; const WinError:Int64 =0);
-var winmessage:string;
-begin
- if Assigned(FOnException) then
- begin
- if WinError > 0 then //get windows error string
- try Win32Check(winerror = 0); except on E:Exception do WinMessage:=e.message; end;
- FOnException(self,TComExceptions(AnException),ComErrorMessages[AnException],WinError, WinMessage);
- end
- else
- if WinError > 0 then raise EComPort.Create(AnException, WinError)
- else raise EComPort.CreateNoWinCode(AnException);
-
-end;
-// create handle to serial port
-procedure TCustomComPort.CreateHandle;
-begin
- FHandle := CreateFile(
- PChar('\\.\' + FPort),
- GENERIC_READ or GENERIC_WRITE,
- 0,
- nil,
- OPEN_EXISTING,
- FILE_FLAG_OVERLAPPED,
- 0);
-
- if FHandle = INVALID_HANDLE_VALUE then
- //raise EComPort.Create
- CallException(CError_OpenFailed, GetLastError);
-end;
-
-// destroy serial port handle
-procedure TCustomComPort.DestroyHandle;
-begin
- if FHandle <> INVALID_HANDLE_VALUE then
- begin
- if CloseHandle(FHandle) then
- FHandle := INVALID_HANDLE_VALUE;
- end;
-end;
-
-procedure TCustomComPort.Loaded;
-begin
- inherited Loaded;
- // open port if Connected is True at design-time
- if FConnected and not (csDesigning in ComponentState) then
- begin
- FConnected := False;
- try
- Open;
- except
- Application.HandleException(Self);
- end;
- end;
-end;
-
-// call events which have been dispatch using window message
-procedure TCustomComPort.WindowMethod(var Message: TMessage);
-begin
- with Message do
- if Msg = CM_COMPORT then
- try
- if InSendMessage then
- ReplyMessage(0);
- if FConnected then
- case wParam of
- EV_RXCHAR: CallRxChar;
- EV_TXEMPTY: CallTxEmpty;
- EV_BREAK: CallBreak;
- EV_RING: CallRing;
- EV_CTS: CallCTSChange;
- EV_DSR: CallDSRChange;
- EV_RXFLAG: CallRxFlag;
- EV_RLSD: CallRLSDChange;
- EV_ERR: CallError;
- EV_RX80FULL: CallRx80Full;
- end
- except
- Application.HandleException(Self);
- end
- else
- Result := DefWindowProc(FWindow, Msg, wParam, lParam);
-end;
-
-// prevent from applying changes at runtime
-procedure TCustomComPort.BeginUpdate;
-begin
- FUpdateCount := FUpdateCount + 1;
-end;
-
-// apply the changes made since BeginUpdate call
-procedure TCustomComPort.EndUpdate;
-begin
- if FUpdateCount > 0 then
- begin
- FUpdateCount := FUpdateCount - 1;
- if FUpdateCount = 0 then
- SetupComPort;
- end;
-end;
-
-// open port
-procedure TCustomComPort.Open;
-begin
- // if already connected, do nothing
- if not FConnected and not (csDesigning in ComponentState) then
- begin
- CallBeforeOpen;
- // open port
- CreateHandle;
- FConnected := True;
- try
- // initialize port
- SetupComPort;
- except
- // error occured during initialization, destroy handle
- DestroyHandle;
- FConnected := False;
- raise;
- end;
- // if at least one event is set, create special thread to monitor port
- if (FEvents = []) then
- FThreadCreated := False
- else
- begin
- if (FSyncMethod = smWindowSync) then
-{$IFDEF DELPHI_6_OR_HIGHER}
- {$WARN SYMBOL_DEPRECATED OFF}
-{$ENDIF}
- FWindow := AllocateHWnd(WindowMethod);
-{$IFDEF DELPHI_6_OR_HIGHER}
- {$WARN SYMBOL_DEPRECATED ON}
-{$ENDIF}
- FEventThread := TComThread.Create(Self);
- FThreadCreated := True;
- end;
- // port is succesfully opened, do any additional initialization
- CallAfterOpen;
- end;
-end;
-
-// close port
-procedure TCustomComPort.Close;
-begin
- // if already closed, do nothing
- if FConnected and not (csDesigning in ComponentState) then
- begin
- CallBeforeClose;
- // abort all pending operations
- AbortAllAsync;
- // stop monitoring for events
- if FThreadCreated then
- begin
- FEventThread.Free;
- FThreadCreated := False;
- if FSyncMethod = smWindowSync then
-{$IFDEF DELPHI_6_OR_HIGHER}
- {$WARN SYMBOL_DEPRECATED OFF}
-{$ENDIF}
- DeallocateHWnd(FWindow);
-{$IFDEF DELPHI_6_OR_HIGHER}
- {$WARN SYMBOL_DEPRECATED ON}
-{$ENDIF}
- end;
- // close port
- DestroyHandle;
- FConnected := False;
- // port is closed, do any additional finalization
- CallAfterClose;
- end;
-end;
-
-// apply port properties
-procedure TCustomComPort.ApplyDCB;
-const
- CParityBits: array[TParityBits] of Integer =
- (NOPARITY, ODDPARITY, EVENPARITY, MARKPARITY, SPACEPARITY);
- CStopBits: array[TStopBits] of Integer =
- (ONESTOPBIT, ONE5STOPBITS, TWOSTOPBITS);
- CBaudRate: array[TBaudRate] of Integer =
- (0, CBR_110, CBR_300, CBR_600, CBR_1200, CBR_2400, CBR_4800, CBR_9600,
- CBR_14400, CBR_19200, CBR_38400, CBR_56000, CBR_57600, CBR_115200,
- CBR_128000, CBR_256000);
- CDataBits: array[TDataBits] of Integer = (5, 6, 7, 8);
- CControlRTS: array[TRTSFlowControl] of Integer =
- (RTS_CONTROL_DISABLE shl 12,
- RTS_CONTROL_ENABLE shl 12,
- RTS_CONTROL_HANDSHAKE shl 12,
- RTS_CONTROL_TOGGLE shl 12);
- CControlDTR: array[TDTRFlowControl] of Integer =
- (DTR_CONTROL_DISABLE shl 4,
- DTR_CONTROL_ENABLE shl 4,
- DTR_CONTROL_HANDSHAKE shl 4);
-
-var
- DCB: TDCB;
-
-begin
- // if not connected or inside BeginUpdate/EndUpdate block, do nothing
- if FConnected and (FUpdateCount = 0) and
- not ((csDesigning in ComponentState) or (csLoading in ComponentState)) then
- begin
- DCB.DCBlength := SizeOf(TDCB);
- DCB.XonLim := FBuffer.InputSize div 4;
- DCB.XoffLim := DCB.XonLim;
- DCB.EvtChar := AnsiChar(FEventChar);
-
- DCB.Flags := dcb_Binary;
- if FDiscardNull then
- DCB.Flags := DCB.Flags or dcb_Null;
-
- with FFlowControl do
- begin
- DCB.XonChar := AnsiChar(XonChar);
- DCB.XoffChar := AnsiChar(XoffChar);
- if OutCTSFlow then
- DCB.Flags := DCB.Flags or dcb_OutxCTSFlow;
- if OutDSRFlow then
- DCB.Flags := DCB.Flags or dcb_OutxDSRFlow;
- DCB.Flags := DCB.Flags or CControlDTR[ControlDTR]
- or CControlRTS[ControlRTS];
- if XonXoffOut then
- DCB.Flags := DCB.Flags or dcb_OutX;
- if XonXoffIn then
- DCB.Flags := DCB.Flags or dcb_InX;
- if DSRSensitivity then
- DCB.Flags := DCB.Flags or dcb_DSRSensivity;
- if TxContinueOnXoff then
- DCB.Flags := DCB.Flags or dcb_TxContinueOnXoff;
- end;
-
- DCB.Parity := CParityBits[FParity.Bits];
- DCB.StopBits := CStopBits[FStopBits];
- if FBaudRate <> brCustom then
- DCB.BaudRate := CBaudRate[FBaudRate]
- else
- DCB.BaudRate := FCustomBaudRate;
- DCB.ByteSize := CDataBits[FDataBits];
-
- if FParity.Check then
- begin
- DCB.Flags := DCB.Flags or dcb_Parity;
- if FParity.Replace then
- begin
- DCB.Flags := DCB.Flags or dcb_ErrorChar;
- DCB.ErrorChar := AnsiChar(FParity.ReplaceChar);
- end;
- end;
-
- // apply settings
- if not SetCommState(FHandle, DCB) then
- //raise EComPort.Create
- CallException(CError_SetStateFailed, GetLastError);
- end;
-end;
-
-// apply timeout properties
-procedure TCustomComPort.ApplyTimeouts;
-var
- Timeouts: TCommTimeouts;
-
- function GetTOValue(const Value: Integer): DWORD;
- begin
- if Value = -1 then
- Result := MAXDWORD
- else
- Result := Value;
- end;
-
-begin
- // if not connected or inside BeginUpdate/EndUpdate block, do nothing
- if FConnected and (FUpdateCount = 0) and
- not ((csDesigning in ComponentState) or (csLoading in ComponentState)) then
- begin
- Timeouts.ReadIntervalTimeout := GetTOValue(FTimeouts.ReadInterval);
- Timeouts.ReadTotalTimeoutMultiplier := GetTOValue(FTimeouts.ReadTotalMultiplier);
- Timeouts.ReadTotalTimeoutConstant := GetTOValue(FTimeouts.ReadTotalConstant);
- Timeouts.WriteTotalTimeoutMultiplier := GetTOValue(FTimeouts.WriteTotalMultiplier);
- Timeouts.WriteTotalTimeoutConstant := GetTOValue(FTimeouts.WriteTotalConstant);
-
- // apply settings
- if not SetCommTimeouts(FHandle, Timeouts) then
- //raise EComPort.Create
- CallException(CError_TimeoutsFailed, GetLastError);
- end;
-end;
-
-// apply buffers
-procedure TCustomComPort.ApplyBuffer;
-begin
- // if not connected or inside BeginUpdate/EndUpdate block, do nothing
- if FConnected and (FUpdateCount = 0) and
- not ((csDesigning in ComponentState) or (csLoading in ComponentState))
- then
- //apply settings
- if not SetupComm(FHandle, FBuffer.InputSize, FBuffer.OutputSize) then
- //raise EComPort.Create
- CallException(CError_SetupComFailed, GetLastError);
-end;
-
-// initialize port
-procedure TCustomComPort.SetupComPort;
-begin
- ApplyBuffer;
- ApplyDCB;
- ApplyTimeouts;
-end;
-
-// get number of bytes in input buffer
-function TCustomComPort.InputCount: Integer;
-var
- Errors: DWORD;
- ComStat: TComStat;
-begin
- if not ClearCommError(FHandle, Errors, @ComStat) then
- //raise EComPort.Create
- CallException(CError_ClearComFailed, GetLastError);
- Result := ComStat.cbInQue;
-end;
-
-// get number of bytes in output buffer
-function TCustomComPort.OutputCount: Integer;
-var
- Errors: DWORD;
- ComStat: TComStat;
-begin
- if not ClearCommError(FHandle, Errors, @ComStat) then
- //raise EComPort.Create
- CallException(CError_ClearComFailed, GetLastError);
- Result := ComStat.cbOutQue;
-end;
-
-// get signals which are in high state
-function TCustomComPort.Signals: TComSignals;
-var
- Status: DWORD;
-begin
- if not GetCommModemStatus(FHandle, Status) then
- //raise EComPort.Create
- CallException(CError_ModemStatFailed, GetLastError);
- Result := [];
-
- if (MS_CTS_ON and Status) <> 0 then
- Result := Result + [csCTS];
- if (MS_DSR_ON and Status) <> 0 then
- Result := Result + [csDSR];
- if (MS_RING_ON and Status) <> 0 then
- Result := Result + [csRing];
- if (MS_RLSD_ON and Status) <> 0 then
- Result := Result + [csRLSD];
-end;
-
-// get port state flags
-function TCustomComPort.StateFlags: TComStateFlags;
-var
- Errors: DWORD;
- ComStat: TComStat;
-begin
- if not ClearCommError(FHandle, Errors, @ComStat) then
- //raise EComPort.Create
- CallException(CError_ClearComFailed, GetLastError);
- Result := ComStat.Flags;
-end;
-
-// set hardware line break
-procedure TCustomComPort.SetBreak(OnOff: Boolean);
-var
- Act: Integer;
-begin
- if OnOff then
- Act := Windows.SETBREAK
- else
- Act := Windows.CLRBREAK;
-
- if not EscapeCommFunction(FHandle, Act) then
- //raise EComPort.Create
- CallException(CError_EscapeComFailed, GetLastError);
-end;
-
-// set DTR signal
-procedure TCustomComPort.SetDTR(OnOff: Boolean);
-var
- Act: DWORD;
-begin
- if OnOff then
- Act := Windows.SETDTR
- else
- Act := Windows.CLRDTR;
-
- if not EscapeCommFunction(FHandle, Act) then
- //raise EComPort.Create
- CallException(CError_EscapeComFailed, GetLastError);
-end;
-
-// set RTS signals
-procedure TCustomComPort.SetRTS(OnOff: Boolean);
-var
- Act: DWORD;
-begin
- if OnOff then
- Act := Windows.SETRTS
- else
- Act := Windows.CLRRTS;
-
- if not EscapeCommFunction(FHandle, Act) then
- //raise EComPort.Create
- CallException(CError_EscapeComFailed, GetLastError);
-end;
-
-// set XonXoff state
-procedure TCustomComPort.SetXonXoff(OnOff: Boolean);
-var
- Act: DWORD;
-begin
- if OnOff then
- Act := Windows.SETXON
- else
- Act := Windows.SETXOFF;
-
- if not EscapeCommFunction(FHandle, Act) then
- //raise EComPort.Create
- CallException(CError_EscapeComFailed, GetLastError);
-end;
-
-// clear input and/or output buffer
-procedure TCustomComPort.ClearBuffer(Input, Output: Boolean);
-var
- Flag: DWORD;
-begin
- Flag := 0;
- if Input then
- Flag := PURGE_RXCLEAR;
- if Output then
- Flag := Flag or PURGE_TXCLEAR;
-
- if not PurgeComm(FHandle, Flag) then
- //raise EComPort.Create
- CallException(CError_PurgeFailed, GetLastError);
-end;
-
-// return last errors on port
-function TCustomComPort.LastErrors: TComErrors;
-var
- Errors: DWORD;
- ComStat: TComStat;
-begin
- if not ClearCommError(FHandle, Errors, @ComStat) then
- //raise EComPort.Create
- CallException(CError_ClearComFailed, GetLastError);
- Result := [];
-
- if (CE_FRAME and Errors) <> 0 then
- Result := Result + [ceFrame];
- if ((CE_RXPARITY and Errors) <> 0) and FParity.Check then // get around a bug
- Result := Result + [ceRxParity];
- if (CE_OVERRUN and Errors) <> 0 then
- Result := Result + [ceOverrun];
- if (CE_RXOVER and Errors) <> 0 then
- Result := Result + [ceRxOver];
- if (CE_TXFULL and Errors) <> 0 then
- Result := Result + [ceTxFull];
- if (CE_BREAK and Errors) <> 0 then
- Result := Result + [ceBreak];
- if (CE_IOE and Errors) <> 0 then
- Result := Result + [ceIO];
- if (CE_MODE and Errors) <> 0 then
- Result := Result + [ceMode];
-end;
-
-// prepare PAsync variable for read/write operation
-procedure PrepareAsync(AKind: TOperationKind; const Buffer; Count: Integer; AsyncPtr: PAsync);
-begin
- with AsyncPtr^ do
- begin
- Kind := AKind;
- if Data <> nil then
- FreeMem(Data);
- GetMem(Data, Count);
- Move(Buffer, Data^, Count);
- Size := Count;
- end;
-end;
-
-// perform asynchronous write operation
-function TCustomComPort.WriteAsync(const Buffer; Count: Integer; var AsyncPtr: PAsync): Integer;
-var
- Success: Boolean;
- BytesTrans: DWORD;
-begin
- if AsyncPtr = nil then
- //raise EComPort.CreateNoWinCode
- CallException(CError_InvalidAsync);
- if FHandle = INVALID_HANDLE_VALUE then
- //raise EComPort.Create
- CallException(CError_PortNotOpen, -24);
- PrepareAsync(okWrite, Buffer, Count, AsyncPtr);
-
- Success := WriteFile(FHandle, Buffer, Count, BytesTrans, @AsyncPtr^.Overlapped)
- or (GetLastError = ERROR_IO_PENDING);
-
- if not Success then
- //raise EComPort.Create
- CallException(CError_WriteFailed, GetLastError);
-
- SendSignalToLink(leTx, True);
- Result := BytesTrans;
-end;
-
-// perform synchronous write operation
-function TCustomComPort.Write(const Buffer; Count: Integer): Integer;
-var
- AsyncPtr: PAsync;
-begin
- InitAsync(AsyncPtr);
- try
- WriteAsync(Buffer, Count, AsyncPtr);
- Result := WaitForAsync(AsyncPtr);
- finally
- DoneAsync(AsyncPtr);
- end;
-end;
-
-// perform asynchronous write operation
-function TCustomComPort.WriteStrAsync(var Str: string; var AsyncPtr: PAsync): Integer;
-var sa : Ansistring; var i:integer;
-begin
- if Length(Str) > 0 then
- begin
- setlength(sa,length(str));
- {$IFDEF Unicode}
- if length(sa)>0 then
- begin
- for i := 1 to length(str) do sa[i] := ansichar(byte(str[i]));
- move(sa[1],str[1],length(sa));
- end;
- {$ENDIF}
- Result := WriteAsync(Str[1], Length(Str), AsyncPtr)
- end
- else
- Result := 0;
-end;
-// perform synchronous write operation
-function TCustomComPort.WriteStr(Str: string): Integer;
-var
- AsyncPtr: PAsync;
-begin
- InitAsync(AsyncPtr);
- try
- WriteStrAsync(Str, AsyncPtr);
- Result := WaitForAsync(AsyncPtr);
- finally
- DoneAsync(AsyncPtr);
- end;
-end;
-//Pierre Yager - includes codepage converstion of strings being sent
-function TCustomComPort.WriteUnicodeString(const Str: Unicodestring): Integer;
-var
- l: Integer;
- rb: AnsiString;
-begin
- l := WideCharToMultiByte(FCodePage, 0, PWideChar(Str), Length(Str), nil, 0, nil, nil);
- SetLength(rb, l);
- WideCharToMultiByte(FCodePage, 0, PWideChar(Str), Length(Str), PAnsiChar(rb), l, nil, nil);
- Result := WriteStr(string(rb));
-end;
-
-//Pierre Yager - includes codepage converstion of strings received
-function TCustomComPort.ReadUnicodeString(var Str: UnicodeString; Count: Integer): Integer;
-var
- rb: AnsiString;
- l: Integer;
- AsyncPtr: PAsync;
-begin
- InitAsync(AsyncPtr);
- try
- setLength(rb,count);
- Result := ReadAsync(rb[1], Count, AsyncPtr); // ReadStr(s, Count);
- //{$IFDEF Unicode}rb := UTF8Encode(s);{$ELSE} rb := s; {$ENDIF}
- l := MultiByteToWideChar(FCodePage, 0, PAnsiChar(rb), Length(rb), nil, 0);
- SetLength(Str, l);
- Result := MultiByteToWideChar(FCodePage, 0, PAnsiChar(rb), Length(rb), PWideChar(Str), l);
- finally
- DoneAsync(AsyncPtr);
- end;
-end;
-
-// perform asynchronous read operation
-function TCustomComPort.ReadAsync(var Buffer; Count: Integer; var AsyncPtr: PAsync): Integer;
-var
- Success: Boolean;
- BytesTrans: DWORD;
-begin
- if AsyncPtr = nil then
- //raise EComPort.CreateNoWinCode
- CallException(CError_InvalidAsync);
- AsyncPtr^.Kind := okRead;
- if FHandle = INVALID_HANDLE_VALUE then
- //raise EComPort.Create
- CallException(CError_PortNotOpen, -24);
-
- Success := ReadFile(FHandle, Buffer, Count, BytesTrans, @AsyncPtr^.Overlapped)
- or (GetLastError = ERROR_IO_PENDING);
-
- if not Success then
- //raise EComPort.Create
- CallException(CError_ReadFailed, GetLastError);
-
- Result := BytesTrans;
-end;
-
-// perform synchronous read operation
-function TCustomComPort.Read(var Buffer; Count: Integer): Integer;
-var
- AsyncPtr: PAsync;
-begin
- InitAsync(AsyncPtr);
- try
- ReadAsync(Buffer, Count, AsyncPtr);
- Result := WaitForAsync(AsyncPtr);
- finally
- DoneAsync(AsyncPtr);
- end;
-end;
-
-// perform asynchronous read operation
-function TCustomComPort.ReadStrAsync(var Str: Ansistring; Count: Integer; var AsyncPtr: PAsync): Integer;
-begin
- setlength(str,count);
- if Count > 0 then
- Result := ReadAsync(str[1], Count, AsyncPtr)
- else
- Result := 0;
-end;
-
-// perform synchronous read operation
-function TCustomComPort.ReadStr(var Str: string; Count: Integer): Integer;
-var
- AsyncPtr: PAsync;
- sa :ansistring;
- i : integer;
-begin
- InitAsync(AsyncPtr);
- try
- ReadStrAsync(sa, Count, AsyncPtr);
- Result := WaitForAsync(AsyncPtr);
- SetLength(sa, Result);
- SetLength(str, Result);
- {$IFDEF Unicode}
- if length(sa)>0 then
- for i := 1 to length(sa) do str[i] := char(byte(sa[i]))
- {$ELSE}
- str := sa;
- {$ENDIF}
- finally
- DoneAsync(AsyncPtr);
- end;
-end;
-
-function ErrorCode(AsyncPtr: PAsync): Integer;
-begin
- Result := 0;
- case AsyncPtr^.Kind of
- okWrite: Result := CError_WriteFailed;
- okRead: Result := CError_ReadFailed;
- end;
-end;
-
-// wait for asynchronous operation to end
-function TCustomComPort.WaitForAsync(var AsyncPtr: PAsync): Integer;
-var
- BytesTrans, Signaled: DWORD;
- Success: Boolean;
-begin
- if AsyncPtr = nil then
- //raise EComPort.CreateNoWinCode
- CallException(CError_InvalidAsync);
-
- Signaled := WaitForSingleObject(AsyncPtr^.Overlapped.hEvent, INFINITE);
- Success := (Signaled = WAIT_OBJECT_0) and
- (GetOverlappedResult(FHandle, AsyncPtr^.Overlapped, BytesTrans, False));
-
- if not Success then
- //raise EComPort.Create
- CallException(ErrorCode(AsyncPtr), GetLastError);
-
- if (AsyncPtr^.Kind = okRead) and (InputCount = 0) then
- SendSignalToLink(leRx, False)
- else
- if AsyncPtr^.Data <> nil then
- TxNotifyLink(AsyncPtr^.Data^, AsyncPtr^.Size);
-
- Result := BytesTrans;
-end;
-
-// abort all asynchronous operations
-procedure TCustomComPort.AbortAllAsync;
-begin
- if not PurgeComm(FHandle, PURGE_TXABORT or PURGE_RXABORT) then
- //raise EComPort.Create
- CallException(CError_PurgeFailed, GetLastError);
-end;
-
-// detect whether asynchronous operation is completed
-function TCustomComPort.IsAsyncCompleted(AsyncPtr: PAsync): Boolean;
-var
- BytesTrans: DWORD;
-begin
- if AsyncPtr = nil then
- //raise EComPort.CreateNoWinCode
- CallException(CError_InvalidAsync);
-
- Result := GetOverlappedResult(FHandle, AsyncPtr^.Overlapped, BytesTrans, False);
- if not Result then
- if (GetLastError <> ERROR_IO_PENDING) and (GetLastError <> ERROR_IO_INCOMPLETE) then
- //raise EComPort.Create
- CallException(CError_AsyncCheck, GetLastError);
-end;
-
-// waits for event to occur on serial port
-procedure TCustomComPort.WaitForEvent(var Events: TComEvents;
- StopEvent: THandle; Timeout: Integer);
-var
- Overlapped: TOverlapped;
- Mask: DWORD;
- Success: Boolean;
- Signaled, EventHandleCount: Integer;
- EventHandles: array[0..1] of THandle;
-begin
- // cannot call method if event thread is running
- if FThreadCreated then
- //raise EComPort.CreateNoWinCode
- CallException(CError_ThreadCreated);
-
- FillChar(Overlapped, SizeOf(TOverlapped), 0);
- Overlapped.hEvent := CreateEvent(nil, True, False, nil);
- EventHandles[0] := Overlapped.hEvent;
- if StopEvent <> 0 then
- begin
- EventHandles[1] := StopEvent;
- EventHandleCount := 2;
- end
- else
- EventHandleCount := 1;
-
- try
- SetCommMask(FHandle, EventsToInt(Events));
- // let's wait for event or timeout
- Success := WaitCommEvent(FHandle, Mask, @Overlapped);
-
- if (Success) or (GetLastError = ERROR_IO_PENDING) then
- begin
- Signaled := WaitForMultipleObjects(EventHandleCount, @EventHandles,
- False, Timeout);
- Success := (Signaled = WAIT_OBJECT_0)
- or (Signaled = WAIT_OBJECT_0 + 1) or (Signaled = WAIT_TIMEOUT);
- SetCommMask(FHandle, 0);
- end;
-
- if not Success then
- //raise EComPort.Create
- CallException(CError_WaitFailed, GetLastError);
-
- Events := IntToEvents(Mask);
- finally
- CloseHandle(Overlapped.hEvent);
- end;
-end;
-
-// transmit char ahead of any pending data in ouput buffer
-procedure TCustomComPort.TransmitChar(Ch: Char);
-begin
- if not TransmitCommChar(FHandle, AnsiChar(Ch)) then
- //raise EComPort.Create
- CallException(CError_TransmitFailed, GetLastError);
-end;
-
-// show port setup dialog
-{$IFNDEF No_Dialogs}
-procedure TCustomComPort.ShowSetupDialog;
-begin
- EditComPort(Self);
-end;
-{$ENDIF}
-
-// some conversion routines
-function BoolToStr(const Value: Boolean): string;
-begin
- if Value then
- Result := 'Yes'
- else
- Result := 'No';
-end;
-
-function StrToBool(const Value: string): Boolean;
-begin
- if UpperCase(Value) = 'YES' then
- Result := True
- else
- Result := False;
-end;
-
-function DTRToStr(DTRFlowControl: TDTRFlowControl): string;
-const
- DTRStrings: array[TDTRFlowControl] of string = ('Disable', 'Enable',
- 'Handshake');
-begin
- Result := DTRStrings[DTRFlowControl];
-end;
-
-function RTSToStr(RTSFlowControl: TRTSFlowControl): string;
-const
- RTSStrings: array[TRTSFlowControl] of string = ('Disable', 'Enable',
- 'Handshake', 'Toggle');
-begin
- Result := RTSStrings[RTSFlowControl];
-end;
-
-function StrToRTS(Str: string): TRTSFlowControl;
-var
- I: TRTSFlowControl;
-begin
- I := Low(TRTSFlowControl);
- while (I <= High(TRTSFlowControl)) do
- begin
- if UpperCase(Str) = UpperCase(RTSToStr(I)) then
- Break;
- I := Succ(I);
- end;
- if I > High(TRTSFlowControl) then
- Result := rtsDisable
- else
- Result := I;
-end;
-
-function StrToDTR(Str: string): TDTRFlowControl;
-var
- I: TDTRFlowControl;
-begin
- I := Low(TDTRFlowControl);
- while (I <= High(TDTRFlowControl)) do
- begin
- if UpperCase(Str) = UpperCase(DTRToStr(I)) then
- Break;
- I := Succ(I);
- end;
- if I > High(TDTRFlowControl) then
- Result := dtrDisable
- else
- Result := I;
-end;
-
-function StrToChar(Str: string): Char;
-var
- A: Integer;
-begin
- if Length(Str) > 0 then
- begin
- if (Str[1] = '#') and (Length(Str) > 1) then
- begin
- try
- A := StrToInt(Copy(Str, 2, Length(Str) - 1));
- except
- A := 0;
- end;
- Result := Chr(Byte(A));
- end
- else
- Result := Str[1];
- end
- else
- Result := #0;
-end;
-
-function CharToStr(Ch: Char): string;
-begin
- {$IFDEF Unicode}
- if CharInSet(ch,[#33..#127]) then
- {$ELSE}
- if Ch in [#33..#127] then {$ENDIF}
- Result := Ch
- else
- Result := '#' + IntToStr(Ord(Ch));
-end;
-
-// store settings to ini file
-procedure TCustomComPort.StoreIniFile(IniFile: TIniFile);
-begin
- if spBasic in FStoredProps then
- begin
- IniFile.WriteString(Name, 'Port', Port);
- IniFile.WriteString(Name, 'BaudRate', BaudRateToStr(BaudRate));
- if BaudRate = brCustom then
- IniFile.WriteInteger(Name, 'CustomBaudRate', CustomBaudRate);
- IniFile.WriteString(Name, 'StopBits', StopBitsToStr(StopBits));
- IniFile.WriteString(Name, 'DataBits', DataBitsToStr(DataBits));
- IniFile.WriteString(Name, 'Parity', ParityToStr(Parity.Bits));
- IniFile.WriteString(Name, 'FlowControl', FlowControlToStr(FlowControl.FlowControl));
- end;
- if spOthers in FStoredProps then
- begin
- IniFile.WriteString(Name, 'EventChar', CharToStr(EventChar));
- IniFile.WriteString(Name, 'DiscardNull', BoolToStr(DiscardNull));
- end;
- if spParity in FStoredProps then
- begin
- IniFile.WriteString(Name, 'Parity.Check', BoolToStr(Parity.Check));
- IniFile.WriteString(Name, 'Parity.Replace', BoolToStr(Parity.Replace));
- IniFile.WriteString(Name, 'Parity.ReplaceChar', CharToStr(Parity.ReplaceChar));
- end;
- if spBuffer in FStoredProps then
- begin
- IniFile.WriteInteger(Name, 'Buffer.OutputSize', Buffer.OutputSize);
- IniFile.WriteInteger(Name, 'Buffer.InputSize', Buffer.InputSize);
- end;
- if spTimeouts in FStoredProps then
- begin
- IniFile.WriteInteger(Name, 'Timeouts.ReadInterval', Timeouts.ReadInterval);
- IniFile.WriteInteger(Name, 'Timeouts.ReadTotalConstant', Timeouts.ReadTotalConstant);
- IniFile.WriteInteger(Name, 'Timeouts.ReadTotalMultiplier', Timeouts.ReadTotalMultiplier);
- IniFile.WriteInteger(Name, 'Timeouts.WriteTotalConstant', Timeouts.WriteTotalConstant);
- IniFile.WriteInteger(Name, 'Timeouts.WriteTotalMultiplier', Timeouts.WriteTotalMultiplier);
- end;
- if spFlowControl in FStoredProps then
- begin
- IniFile.WriteString(Name, 'FlowControl.ControlRTS', RTSToStr(FlowControl.ControlRTS));
- IniFile.WriteString(Name, 'FlowControl.ControlDTR', DTRToStr(FlowControl.ControlDTR));
- IniFile.WriteString(Name, 'FlowControl.DSRSensitivity', BoolToStr(FlowControl.DSRSensitivity));
- IniFile.WriteString(Name, 'FlowControl.OutCTSFlow', BoolToStr(FlowControl.OutCTSFlow));
- IniFile.WriteString(Name, 'FlowControl.OutDSRFlow', BoolToStr(FlowControl.OutDSRFlow));
- IniFile.WriteString(Name, 'FlowControl.TxContinueOnXoff', BoolToStr(FlowControl.TxContinueOnXoff));
- IniFile.WriteString(Name, 'FlowControl.XonXoffIn', BoolToStr(FlowControl.XonXoffIn));
- IniFile.WriteString(Name, 'FlowControl.XonXoffOut', BoolToStr(FlowControl.XonXoffOut));
- IniFile.WriteString(Name, 'FlowControl.XoffChar', CharToStr(FlowControl.XoffChar));
- IniFile.WriteString(Name, 'FlowControl.XonChar', CharToStr(FlowControl.XonChar));
- end;
-end;
-
-// store settings to registry
-procedure TCustomComPort.StoreRegistry(Reg: TRegistry);
-begin
- if spBasic in FStoredProps then
- begin
- Reg.WriteString('Port', Port);
- Reg.WriteString('BaudRate', BaudRateToStr(BaudRate));
- if BaudRate = brCustom then
- Reg.WriteInteger('CustomBaudRate', CustomBaudRate);
- Reg.WriteString('StopBits', StopBitsToStr(StopBits));
- Reg.WriteString('DataBits', DataBitsToStr(DataBits));
- Reg.WriteString('Parity', ParityToStr(Parity.Bits));
- Reg.WriteString('FlowControl', FlowControlToStr(FlowControl.FlowControl));
- end;
- if spOthers in FStoredProps then
- begin
- Reg.WriteString('EventChar', CharToStr(EventChar));
- Reg.WriteString('DiscardNull', BoolToStr(DiscardNull));
- end;
- if spParity in FStoredProps then
- begin
- Reg.WriteString('Parity.Check', BoolToStr(Parity.Check));
- Reg.WriteString('Parity.Replace', BoolToStr(Parity.Replace));
- Reg.WriteString('Parity.ReplaceChar', CharToStr(Parity.ReplaceChar));
- end;
- if spBuffer in FStoredProps then
- begin
- Reg.WriteInteger('Buffer.OutputSize', Buffer.OutputSize);
- Reg.WriteInteger('Buffer.InputSize', Buffer.InputSize);
- end;
- if spTimeouts in FStoredProps then
- begin
- Reg.WriteInteger('Timeouts.ReadInterval', Timeouts.ReadInterval);
- Reg.WriteInteger('Timeouts.ReadTotalConstant', Timeouts.ReadTotalConstant);
- Reg.WriteInteger('Timeouts.ReadTotalMultiplier', Timeouts.ReadTotalMultiplier);
- Reg.WriteInteger('Timeouts.WriteTotalConstant', Timeouts.WriteTotalConstant);
- Reg.WriteInteger('Timeouts.WriteTotalMultiplier', Timeouts.WriteTotalMultiplier);
- end;
- if spFlowControl in FStoredProps then
- begin
- Reg.WriteString('FlowControl.ControlRTS', RTSToStr(FlowControl.ControlRTS));
- Reg.WriteString('FlowControl.ControlDTR', DTRToStr(FlowControl.ControlDTR));
- Reg.WriteString('FlowControl.DSRSensitivity', BoolToStr(FlowControl.DSRSensitivity));
- Reg.WriteString('FlowControl.OutCTSFlow', BoolToStr(FlowControl.OutCTSFlow));
- Reg.WriteString('FlowControl.OutDSRFlow', BoolToStr(FlowControl.OutDSRFlow));
- Reg.WriteString('FlowControl.TxContinueOnXoff', BoolToStr(FlowControl.TxContinueOnXoff));
- Reg.WriteString('FlowControl.XonXoffIn', BoolToStr(FlowControl.XonXoffIn));
- Reg.WriteString('FlowControl.XonXoffOut', BoolToStr(FlowControl.XonXoffOut));
- Reg.WriteString('FlowControl.XoffChar', CharToStr(FlowControl.XoffChar));
- Reg.WriteString('FlowControl.XonChar', CharToStr(FlowControl.XonChar));
- end;
-end;
-
-// load settings from ini file
-procedure TCustomComPort.LoadIniFile(IniFile: TIniFile);
-begin
- if spBasic in FStoredProps then
- begin
- Port := IniFile.ReadString(Name, 'Port', Port);
- BaudRate := StrToBaudRate(IniFile.ReadString(Name, 'BaudRate', BaudRateToStr(BaudRate)));
- if BaudRate = brCustom then
- CustomBaudRate := IniFile.ReadInteger(Name, 'CustomBaudRate', 9600);
- StopBits := StrToStopBits(IniFile.ReadString(Name, 'StopBits', StopBitsToStr(StopBits)));
- DataBits := StrToDataBits(IniFile.ReadString(Name, 'DataBits', DataBitsToStr(DataBits)));
- Parity.Bits := StrToParity(IniFile.ReadString(Name, 'Parity', ParityToStr(Parity.Bits)));
- FlowControl.FlowControl := StrToFlowControl(
- IniFile.ReadString(Name, 'FlowControl', FlowControlToStr(FlowControl.FlowControl)));
- end;
- if spOthers in FStoredProps then
- begin
- EventChar := StrToChar(IniFile.ReadString(Name, 'EventChar', CharToStr(EventChar)));
- DiscardNull := StrToBool(IniFile.ReadString(Name, 'DiscardNull', BoolToStr(DiscardNull)));
- end;
- if spParity in FStoredProps then
- begin
- Parity.Check := StrToBool(IniFile.ReadString(Name, 'Parity.Check', BoolToStr(Parity.Check)));
- Parity.Replace := StrToBool(IniFile.ReadString(Name, 'Parity.Replace', BoolToStr(Parity.Replace)));
- Parity.ReplaceChar := StrToChar(IniFile.ReadString(Name, 'Parity.ReplaceChar', CharToStr(Parity.ReplaceChar)));
- end;
- if spBuffer in FStoredProps then
- begin
- Buffer.OutputSize := IniFile.ReadInteger(Name, 'Buffer.OutputSize', Buffer.OutputSize);
- Buffer.InputSize := IniFile.ReadInteger(Name, 'Buffer.InputSize', Buffer.InputSize);
- end;
- if spTimeouts in FStoredProps then
- begin
- Timeouts.ReadInterval := IniFile.ReadInteger(Name, 'Timeouts.ReadInterval', Timeouts.ReadInterval);
- Timeouts.ReadTotalConstant := IniFile.ReadInteger(Name, 'Timeouts.ReadTotalConstant', Timeouts.ReadTotalConstant);
- Timeouts.ReadTotalMultiplier := IniFile.ReadInteger(Name, 'Timeouts.ReadTotalMultiplier', Timeouts.ReadTotalMultiplier);
- Timeouts.WriteTotalConstant := IniFile.ReadInteger(Name, 'Timeouts.WriteTotalConstant', Timeouts.WriteTotalConstant);
- Timeouts.WriteTotalMultiplier := IniFile.ReadInteger(Name, 'Timeouts.WriteTotalMultiplier', Timeouts.WriteTotalMultiplier);
- end;
- if spFlowControl in FStoredProps then
- begin
- FlowControl.ControlRTS := StrToRTS(IniFile.ReadString(Name, 'FlowControl.ControlRTS', RTSToStr(FlowControl.ControlRTS)));
- FlowControl.ControlDTR := StrToDTR(IniFile.ReadString(Name, 'FlowControl.ControlDTR', DTRToStr(FlowControl.ControlDTR)));
- FlowControl.DSRSensitivity := StrToBool(IniFile.ReadString(Name, 'FlowControl.DSRSensitivity', BoolToStr(FlowControl.DSRSensitivity)));
- FlowControl.OutCTSFlow := StrToBool(IniFile.ReadString(Name, 'FlowControl.OutCTSFlow', BoolToStr(FlowControl.OutCTSFlow)));
- FlowControl.OutDSRFlow := StrToBool(IniFile.ReadString(Name, 'FlowControl.OutDSRFlow', BoolToStr(FlowControl.OutCTSFlow)));
- FlowControl.TxContinueOnXoff := StrToBool(IniFile.ReadString(Name, 'FlowControl.TxContinueOnXoff', BoolToStr(FlowControl.TxContinueOnXoff)));
- FlowControl.XonXoffIn := StrToBool(IniFile.ReadString(Name, 'FlowControl.XonXoffIn', BoolToStr(FlowControl.XonXoffIn)));
- FlowControl.XonXoffOut := StrToBool(IniFile.ReadString(Name, 'FlowControl.XonXoffOut', BoolToStr(FlowControl.XonXoffOut)));
- FlowControl.XoffChar := StrToChar(IniFile.ReadString(Name, 'FlowControl.XoffChar', CharToStr(FlowControl.XoffChar)));
- FlowControl.XonChar := StrToChar(IniFile.ReadString(Name, 'FlowControl.XonChar', CharToStr(FlowControl.XonChar)));
- end;
-end;
-
-// load settings from registry
-procedure TCustomComPort.LoadRegistry(Reg: TRegistry);
-begin
- if spBasic in FStoredProps then
- begin
- Port := Reg.ReadString('Port');
- BaudRate := StrToBaudRate(Reg.ReadString('BaudRate'));
- if BaudRate = brCustom then
- CustomBaudRate := Reg.ReadInteger('CustomBaudRate');
- StopBits := StrToStopBits(Reg.ReadString('StopBits'));
- DataBits := StrToDataBits(Reg.ReadString('DataBits'));
- Parity.Bits := StrToParity(Reg.ReadString('Parity'));
- FlowControl.FlowControl := StrToFlowControl(Reg.ReadString('FlowControl'));
- end;
- if spOthers in FStoredProps then
- begin
- EventChar := StrToChar(Reg.ReadString('EventChar'));
- DiscardNull := StrToBool(Reg.ReadString('DiscardNull'));
- end;
- if spParity in FStoredProps then
- begin
- Parity.Check := StrToBool(Reg.ReadString('Parity.Check'));
- Parity.Replace := StrToBool(Reg.ReadString('Parity.Replace'));
- Parity.ReplaceChar := StrToChar(Reg.ReadString('Parity.ReplaceChar'));
- end;
- if spBuffer in FStoredProps then
- begin
- Buffer.OutputSize := Reg.ReadInteger('Buffer.OutputSize');
- Buffer.InputSize := Reg.ReadInteger('Buffer.InputSize');
- end;
- if spTimeouts in FStoredProps then
- begin
- Timeouts.ReadInterval := Reg.ReadInteger('Timeouts.ReadInterval');
- Timeouts.ReadTotalConstant := Reg.ReadInteger('Timeouts.ReadTotalConstant');
- Timeouts.ReadTotalMultiplier := Reg.ReadInteger('Timeouts.ReadTotalMultiplier');
- Timeouts.WriteTotalConstant := Reg.ReadInteger('Timeouts.WriteTotalConstant');
- Timeouts.WriteTotalMultiplier := Reg.ReadInteger('Timeouts.WriteTotalMultiplier');
- end;
- if spFlowControl in FStoredProps then
- begin
- FlowControl.ControlRTS := StrToRTS(Reg.ReadString('FlowControl.ControlRTS'));
- FlowControl.ControlDTR := StrToDTR(Reg.ReadString('FlowControl.ControlDTR'));
- FlowControl.DSRSensitivity := StrToBool(Reg.ReadString('FlowControl.DSRSensitivity'));
- FlowControl.OutCTSFlow := StrToBool(Reg.ReadString('FlowControl.OutCTSFlow'));
- FlowControl.OutDSRFlow := StrToBool(Reg.ReadString('FlowControl.OutDSRFlow'));
- FlowControl.TxContinueOnXoff := StrToBool(Reg.ReadString('FlowControl.TxContinueOnXoff'));
- FlowControl.XonXoffIn := StrToBool(Reg.ReadString('FlowControl.XonXoffIn'));
- FlowControl.XonXoffOut := StrToBool(Reg.ReadString('FlowControl.XonXoffOut'));
- FlowControl.XoffChar := StrToChar(Reg.ReadString('FlowControl.XoffChar'));
- FlowControl.XonChar := StrToChar(Reg.ReadString('FlowControl.XonChar'));
- end;
-end;
-
-// initialize registry
-procedure SetRegistry(Reg: TRegistry; Key: string; Name: string);
-var
- I: Integer;
- Temp: string;
-begin
- I := Pos('\', Key);
- if I > 0 then
- begin
- Temp := Copy(Key, 1, I - 1);
- if UpperCase(Temp) = 'HKEY_LOCAL_MACHINE' then
- Reg.RootKey := HKEY_LOCAL_MACHINE
- else
- if UpperCase(Temp) = 'HKEY_CURRENT_USER' then
- Reg.RootKey := HKEY_CURRENT_USER;
- Key := Copy(Key, I + 1, Length(Key) - I);
- if Key[Length(Key)] <> '\' then
- Key := Key + '\';
- Key := Key + Name;
- Reg.OpenKey(Key, True);
- end;
-end;
-
-// store settings
-procedure TCustomComPort.StoreSettings(StoreType: TStoreType; StoreTo: string);
-var
- IniFile: TIniFile;
- Reg: TRegistry;
-begin
- try
- if StoreType = stRegistry then
- begin
- Reg := TRegistry.Create;
- try
- SetRegistry(Reg, StoreTo, Name);
- StoreRegistry(Reg);
- finally
- Reg.Free;
- end
- end else
- begin
- IniFile := TIniFile.Create(StoreTo);
- try
- StoreIniFile(IniFile);
- finally
- IniFile.Free;
- end
- end;
- except
- //raise EComPort.CreateNoWinCode
- CallException(CError_StoreFailed);
- end;
-end;
-
-// load settings
-procedure TCustomComPort.LoadSettings(StoreType: TStoreType; LoadFrom: string);
-var
- IniFile: TIniFile;
- Reg: TRegistry;
-begin
- BeginUpdate;
- try
- try
- if StoreType = stRegistry then
- begin
- Reg := TRegistry.Create;
- try
- SetRegistry(Reg, LoadFrom, Name);
- LoadRegistry(Reg);
- finally
- Reg.Free;
- end
- end else
- begin
- IniFile := TIniFile.Create(LoadFrom);
- try
- LoadIniFile(IniFile);
- finally
- IniFile.Free;
- end
- end;
- finally
- EndUpdate;
- end;
- except
- //raise EComPort.CreateNoWinCode
- CallException(CError_LoadFailed);
- end;
-end;
-
-// register link from other component to TCustomComPort
-procedure TCustomComPort.RegisterLink(AComLink: TComLink);
-begin
- if FLinks.IndexOf(Pointer(AComLink)) > -1 then
- //raise EComPort.CreateNoWinCode
- CallException(CError_RegFailed)
- else
- FLinks.Add(Pointer(AComLink));
- FHasLink := HasLink;
-end;
-
-// unregister link from other component to TCustomComPort
-procedure TCustomComPort.UnRegisterLink(AComLink: TComLink);
-begin
- if FLinks.IndexOf(Pointer(AComLink)) = -1 then
- //raise EComPort.CreateNoWinCode
- CallException(CError_RegFailed)
- else
- FLinks.Remove(Pointer(AComLink));
- FHasLink := HasLink;
-end;
-
-// default actions on port events
-
-procedure TCustomComPort.DoBeforeClose;
-begin
- if Assigned(FOnBeforeClose) then
- FOnBeforeClose(Self);
-end;
-
-procedure TCustomComPort.DoBeforeOpen;
-begin
- if Assigned(FOnBeforeOpen) then
- FOnBeforeOpen(Self);
-end;
-
-procedure TCustomComPort.DoAfterOpen;
-begin
- if Assigned(FOnAfterOpen) then
- FOnAfterOpen(Self);
-end;
-
-procedure TCustomComPort.DoAfterClose;
-begin
- if Assigned(FOnAfterClose) then
- FOnAfterClose(Self);
-end;
-
-procedure TCustomComPort.DoRxChar(Count: Integer);
-begin
- if Assigned(FOnRxChar) then
- FOnRxChar(Self, Count);
-end;
-
-procedure TCustomComPort.DoRxBuf(const Buffer; Count: Integer);
-begin
- if Assigned(FOnRxBuf) then
- FOnRxBuf(Self, Buffer, Count);
-end;
-
-procedure TCustomComPort.DoBreak;
-begin
- if Assigned(FOnBreak) then
- FOnBreak(Self);
-end;
-
-procedure TCustomComPort.DoTxEmpty;
-begin
- if Assigned(FOnTxEmpty)
- then FOnTxEmpty(Self);
-end;
-
-procedure TCustomComPort.DoRing;
-begin
- if Assigned(FOnRing) then
- FOnRing(Self);
-end;
-
-procedure TCustomComPort.DoCTSChange(OnOff: Boolean);
-begin
- if Assigned(FOnCTSChange) then
- FOnCTSChange(Self, OnOff);
-end;
-
-procedure TCustomComPort.DoDSRChange(OnOff: Boolean);
-begin
- if Assigned(FOnDSRChange) then
- FOnDSRChange(Self, OnOff);
-end;
-
-procedure TCustomComPort.DoRLSDChange(OnOff: Boolean);
-begin
- if Assigned(FOnRLSDChange) then
- FOnRLSDChange(Self, OnOff);
-end;
-
-procedure TCustomComPort.DoError(Errors: TComErrors);
-begin
- if Assigned(FOnError) then
- FOnError(Self, Errors);
-end;
-
-procedure TCustomComPort.DoRxFlag;
-begin
- if Assigned(FOnRxFlag) then
- FOnRxFlag(Self);
-end;
-
-procedure TCustomComPort.DoRx80Full;
-begin
- if Assigned(FOnRx80Full) then
- FOnRx80Full(Self);
-end;
-
-// set signals to false on close, and to proper value on open,
-// because OnXChange events are not called automatically
-procedure TCustomComPort.CheckSignals(Open: Boolean);
-begin
- if Open then
- begin
- CallCTSChange;
- CallDSRChange;
- CallRLSDChange;
- end else
- begin
- SendSignalToLink(leCTS, False);
- SendSignalToLink(leDSR, False);
- SendSignalToLink(leRLSD, False);
- DoCTSChange(False);
- DoDSRChange(False);
- DoRLSDChange(False);
- end;
-end;
-
-// called in response to EV_X events, except CallXClose, CallXOpen
-
-procedure TCustomComPort.CallAfterClose;
-begin
- SendSignalToLink(leConn, False);
- DoAfterClose;
-end;
-
-procedure TCustomComPort.CallAfterOpen;
-begin
- SendSignalToLink(leConn, True);
- DoAfterOpen;
- CheckSignals(True);
-end;
-
-procedure TCustomComPort.CallBeforeClose;
-begin
- // shutdown com signals manually
- CheckSignals(False);
- DoBeforeClose;
-end;
-
-procedure TCustomComPort.CallBeforeOpen;
-begin
- DoBeforeOpen;
-end;
-
-procedure TCustomComPort.CallBreak;
-begin
- DoBreak;
-end;
-
-procedure TCustomComPort.CallCTSChange;
-var
- OnOff: Boolean;
-begin
- OnOff := csCTS in Signals;
- // check for linked components
- SendSignalToLink(leCTS, OnOff);
- DoCTSChange(OnOff);
-end;
-
-procedure TCustomComPort.CallDSRChange;
-var
- OnOff: Boolean;
-begin
- OnOff := csDSR in Signals;
- // check for linked components
- SendSignalToLink(leDSR, OnOff);
- DoDSRChange(OnOff);
-end;
-
-procedure TCustomComPort.CallRLSDChange;
-var
- OnOff: Boolean;
-begin
- OnOff := csRLSD in Signals;
- // check for linked components
- SendSignalToLink(leRLSD, OnOff);
- DoRLSDChange(OnOff);
-end;
-
-procedure TCustomComPort.CallError;
-var
- Errors: TComErrors;
-begin
- Errors := LastErrors;
- if Errors <> [] then
- DoError(Errors);
-end;
-
-procedure TCustomComPort.CallRing;
-begin
- NotifyLink(leRing);
- DoRing;
-end;
-
-procedure TCustomComPort.CallRx80Full;
-begin
- DoRx80Full;
-end;
-
-procedure TCustomComPort.CallRxChar;
-var
- Count: Integer;
-
- // read from input buffer
- procedure PerformRead(var P: Pointer);
- begin
- GetMem(P, Count);
- Read(P^, Count);
- // call OnRxBuf event
- DoRxBuf(P^, Count);
- end;
-
- // check if any component is linked, to OnRxChar event
- procedure CheckLinks;
- {$WARNINGS OFF}
- var
- I: Integer;
- P: Pointer;
- ComLink: TComLink;
- ReadFromBuffer: Boolean;
- begin
- // examine links
- if (Count > 0) and (not TriggersOnRxChar) then
- begin
- ReadFromBuffer := False;
- try
- // cycle through links
- for I := 0 to FLinks.Count - 1 do
- begin
- ComLink := TComLink(FLinks[I]);
- if Assigned(ComLink.OnRxBuf) then
- begin
- // link to OnRxChar event found
- if not ReadFromBuffer then
- begin
- // TCustomComPort must read from comport, so OnRxChar event is
- // not triggered
- ReadFromBuffer := True;
- PerformRead(P);
- end;
- // send data to linked component
- ComLink.OnRxBuf(Self, P^, Count);
- end
- end;
- if (not ReadFromBuffer) and (not FTriggersOnRxChar) then
- begin
- ReadFromBuffer := True;
- PerformRead(P);
- end;
- finally
- if ReadFromBuffer then
- begin
- FreeMem(P);
- // data is already out of buffer, prevent from OnRxChar event to occur
- Count := 0;
- end;
- end;
- end;
- end;
-
-begin
- Count := InputCount;
- if Count > 0 then
- SendSignalToLink(leRx, True);
- CheckLinks;
- if Count > 0 then
- DoRxChar(Count);
-end;
-
-procedure TCustomComPort.CallRxFlag;
-begin
- NotifyLink(leRxFlag);
- DoRxFlag;
-end;
-
-procedure TCustomComPort.CallTxEmpty;
-begin
- SendSignalToLink(leTx, False);
- NotifyLink(leTxEmpty);
- DoTxEmpty;
-end;
-
-// returns true if it has least one component linked to OnRxBuf event
-function TCustomComPort.HasLink: Boolean;
-var
- I: Integer;
- ComLink: TComLink;
-begin
- Result := False;
- // examine links
- if FLinks.Count > 0 then
- for I := 0 to FLinks.Count - 1 do
- begin
- ComLink := TComLink(FLinks[I]);
- if Assigned(ComLink.OnRxBuf) then
- Result := True;
- end;
-end;
-
-// send TxBuf notify to link
-procedure TCustomComPort.TxNotifyLink(const Buffer; Count: Integer);
-var
- I: Integer;
- ComLink: TComLink;
-begin
- if (FLinks.Count > 0) then
- for I := 0 to FLinks.Count - 1 do
- begin
- ComLink := TComLink(FLinks[I]);
- if Assigned(ComLink.OnTxBuf) then
- ComLink.OnTxBuf(Self, Buffer, Count);
- end;
-end;
-
-// send event notification to link
-procedure TCustomComPort.NotifyLink(FLinkEvent: TComLinkEvent);
-var
- I: Integer;
- ComLink: TComLink;
- Event: TNotifyEvent;
-begin
- if (FLinks.Count > 0) then
- for I := 0 to FLinks.Count - 1 do
- begin
- ComLink := TComLink(FLinks[I]);
- Event := nil;
- case FLinkEvent of
- leRing: Event := ComLink.OnRing;
- leTxEmpty: Event := ComLink.OnTxEmpty;
- leRxFlag: Event := ComLink.OnRxFlag;
- end;
- if Assigned(Event) then
- Event(Self);
- end;
-end;
-
-// send signal to linked components
-procedure TCustomComPort.SendSignalToLink(Signal: TComLinkEvent; OnOff: Boolean);
-var
- I: Integer;
- ComLink: TComLink;
- SignalEvent: TComSignalEvent;
-begin
- if (FLinks.Count > 0) then
- // cycle through links
- for I := 0 to FLinks.Count - 1 do
- begin
- ComLink := TComLink(FLinks[I]);
- SignalEvent := nil;
- case Signal of
- leCTS: SignalEvent := ComLink.OnCTSChange;
- leDSR: SignalEvent := ComLink.OnDSRChange;
- leRLSD: SignalEvent := ComLink.OnRLSDChange;
- leTx: SignalEvent := ComLink.OnTx;
- leRx: SignalEvent := ComLink.OnRx;
- leConn: SignalEvent := ComLink.OnConn;
- end;
- // if linked, trigger event
- if Assigned(SignalEvent) then
- SignalEvent(Self, OnOff);
- end;
-end;
-
-// set connected property, same as Open/Close methods
-procedure TCustomComPort.SetConnected(const Value: Boolean);
-begin
- if not ((csDesigning in ComponentState) or (csLoading in ComponentState)) then
- begin
- if Value <> FConnected then
- if Value then
- Open
- else
- Close;
- end
- else
- FConnected := Value;
-end;
-
-// set baud rate
-procedure TCustomComPort.SetBaudRate(const Value: TBaudRate);
-begin
- if Value <> FBaudRate then
- begin
- FBaudRate := Value;
- // if possible, apply settings
- ApplyDCB;
- end;
-end;
-
-// set custom baud rate
-procedure TCustomComPort.SetCustomBaudRate(const Value: Integer);
-begin
- if Value <> FCustomBaudRate then
- begin
- FCustomBaudRate := Value;
- ApplyDCB;
- end;
-end;
-
-// set data bits
-procedure TCustomComPort.SetDataBits(const Value: TDataBits);
-begin
- if Value <> FDataBits then
- begin
- FDataBits := Value;
- ApplyDCB;
- end;
-end;
-
-// set discard null characters
-procedure TCustomComPort.SetDiscardNull(const Value: Boolean);
-begin
- if Value <> FDiscardNull then
- begin
- FDiscardNull := Value;
- ApplyDCB;
- end;
-end;
-
-// set event characters
-procedure TCustomComPort.SetEventChar(const Value: Char);
-begin
- if Value <> FEventChar then
- begin
- FEventChar := Value;
- ApplyDCB;
- end;
-end;
-
-// set port
-procedure TCustomComPort.SetPort(const Value: TPort);
-begin
- // 11.1.2001 Ch. Kaufmann; removed function ComString, because there can be com ports
- // with names other than COMn.
- if Value <> FPort then
- begin
- FPort := Value;
- if FConnected and not ((csDesigning in ComponentState) or
- (csLoading in ComponentState)) then
- begin
- Close;
- Open;
- end;
- end;
-end;
-
-// set stop bits
-procedure TCustomComPort.SetStopBits(const Value: TStopBits);
-begin
- if Value <> FStopBits then
- begin
- FStopBits := Value;
- ApplyDCB;
- end;
-end;
-
-// set event synchronization method
-procedure TCustomComPort.SetSyncMethod(const Value: TSyncMethod);
-begin
- if Value <> FSyncMethod then
- begin
- if FConnected and not ((csDesigning in ComponentState) or
- (csLoading in ComponentState))
- then
- //raise EComPort.CreateNoWinCode
- CallException(CError_ConnChangeProp)
- else
- FSyncMethod := Value;
- end;
-end;
-
-// sets RxChar triggering
-procedure TCustomComPort.SetTriggersOnRxChar(const Value: Boolean);
-begin
- if FHasLink then
- //raise EComPort.CreateNoWinCode
- CallException(CError_HasLink);
- FTriggersOnRxChar := Value;
-end;
-
-// sets event thread priority
-procedure TCustomComPort.SetEventThreadPriority(const Value: TThreadPriority);
-begin
- if Value <> FEventThreadPriority then
- begin
- if FConnected and not ((csDesigning in ComponentState) or
- (csLoading in ComponentState))
- then
- //raise EComPort.CreateNoWinCode
- CallException(CError_ConnChangeProp)
- else
- FEventThreadPriority := Value;
- end;
-end;
-
-// returns true if RxChar is triggered when data arrives input buffer
-function TCustomComPort.GetTriggersOnRxChar: Boolean;
-begin
- Result := FTriggersOnRxChar and (not FHasLink);
-end;
-
-// set flow control
-procedure TCustomComPort.SetFlowControl(const Value: TComFlowControl);
-begin
- FFlowControl.Assign(Value);
- ApplyDCB;
-end;
-
-// set parity
-procedure TCustomComPort.SetParity(const Value: TComParity);
-begin
- FParity.Assign(Value);
- ApplyDCB;
-end;
-
-// set timeouts
-procedure TCustomComPort.SetTimeouts(const Value: TComTimeouts);
-begin
- FTimeouts.Assign(Value);
- ApplyTimeouts;
-end;
-
-// set buffer
-procedure TCustomComPort.SetBuffer(const Value: TComBuffer);
-begin
- FBuffer.Assign(Value);
- ApplyBuffer;
-end;
-
-(*****************************************
- * TComDataPacket component *
- *****************************************)
-
-// create component
-constructor TComDataPacket.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
- FComLink := TComLink.Create;
- FComLink.OnRxBuf := RxBuf;
- FMaxBufferSize := 1024;
-end;
-
-// destroy component
-destructor TComDataPacket.Destroy;
-begin
- ComPort := nil;
- FComLink.Free;
- inherited Destroy;
-end;
-
-// add custom data to packet buffer
-procedure TComDataPacket.AddData(const Str: string);
-begin
- if ValidStop then
- begin
- Buffer := Buffer + Str;
- HandleBuffer;
- end
- else
- DoPacket(Str);
-end;
-
-// remove ComPort property if being destroyed
-procedure TComDataPacket.Notification(AComponent: TComponent;
- Operation: TOperation);
-begin
- inherited Notification(AComponent, Operation);
- if (AComponent = FComPort) and (Operation = opRemove) then
- ComPort := nil;
-end;
-
-// call OnDiscard
-procedure TComDataPacket.DoDiscard(const Str: string);
-begin
- if Assigned(FOnDiscard) then
- FOnDiscard(Self, Str);
-end;
-
-// call OnPacket
-procedure TComDataPacket.DoPacket(const Str: string);
-begin
- if Assigned(FOnPacket) then
- FOnPacket(Self, Str);
-end;
-
-// call OnCustomStart
-procedure TComDataPacket.DoCustomStart(const Str: string;
- var Pos: Integer);
-begin
- if Assigned(FOnCustomStart) then
- FOnCustomStart(Self, Str, Pos);
-end;
-
-// call OnCustomStop
-procedure TComDataPacket.DoCustomStop(const Str: string; var Pos: Integer);
-begin
- if Assigned(FOnCustomStop) then
- FOnCustomStop(Self, Str, Pos);
-end;
-
-// discard start and stop strings
-procedure TComDataPacket.CheckIncludeStrings(var Str: string);
-var
- LenStart, LenStop: Integer;
-begin
- if FIncludeStrings then
- Exit;
- LenStart := Length(FStartString);
- LenStop := Length(FStopString);
- // remove start string
- if Pos(Upper(FStartString), Upper(Str)) = 1 then
- Str := Copy(Str, LenStart + 1, Length(Str) - LenStart);
- // remove stop string
- if Pos(Upper(FStopString), Upper(Str)) = (Length(Str) - LenStop + 1) then
- Str := Copy(Str, 1, Length(Str) - LenStop);
-end;
-
-// upper case
-function TComDataPacket.Upper(const Str: string): string;
-begin
- if FCaseInsensitive then
- Result := UpperCase(Str)
- else
- Result := Str;
-end;
-
-// split buffer in packets
-procedure TComDataPacket.HandleBuffer;
-
- procedure DiscardPacketToPos(Pos: Integer);
- var
- Str: string;
- begin
- FInPacket := True;
- if Pos > 1 then
- begin
- Str := Copy(Buffer, 1, Pos - 1); // some discarded data
- Buffer := Copy(Buffer, Pos, Length(Buffer) - Pos + 1);
- DoDiscard(Str);
- end;
- end;
-
- procedure FormPacket(CutSize: Integer);
- var
- Str: string;
- begin
- Str := Copy(Buffer, 1, CutSize);
- Buffer := Copy(Buffer, CutSize + 1, Length(Buffer) - CutSize);
- CheckIncludeStrings(Str);
- DoPacket(Str);
- end;
-
- procedure StartPacket;
- var
- Found: Integer;
- begin
- // check for custom start condition
- Found := -1;
- DoCustomStart(Buffer, Found);
- if Found > 0 then
- DiscardPacketToPos(Found);
- if Found = -1 then
- begin
- if Length(FStartString) > 0 then // start string valid
- begin
- Found := Pos(Upper(FStartString), Upper(Buffer));
- if Found > 0 then
- DiscardPacketToPos(Found);
- end
- else
- FInPacket := True;
- end;
- end;
-
- procedure EndPacket;
- var
- Found, CutSize, Len: Integer;
- begin
- // check for custom stop condition
- Found := -1;
- DoCustomStop(Buffer, Found);
- if Found > 0 then
- begin
- // custom stop condition detected
- CutSize := Found;
- FInPacket := False;
- end
- else
- if Found = -1 then
- begin
- Len := Length(Buffer);
- if (FSize > 0) and (Len >= FSize) then
- begin
- // size stop condition detected
- FInPacket := False;
- CutSize := FSize;
- end
- else
- begin
- Len := Length(FStartString);
- Found := Pos(Upper(FStopString),
- Upper(Copy(Buffer, Len + 1, Length(Buffer) - Len)));
- if Found > 0 then
- begin
- // stop string stop condition detected
- CutSize := Found + Length(FStopString) + Len - 1;
- FInPacket := False;
- end;
- end;
- end;
- if not FInPacket then
- FormPacket(CutSize); // create packet
- end;
-
- function IsBufferTooLarge: Boolean;
- begin
- Result := (Length(Buffer) >= FMaxBufferSize) and (FMaxBufferSize > 0);
- end;
-
-begin
- try
- if not FInPacket then
- StartPacket;
- if FInPacket then
- begin
- EndPacket;
- if not FInPacket then
- HandleBuffer;
- end;
- finally
- if IsBufferTooLarge then
- EmptyBuffer;
- end;
-end;
-
-// is stop condition valid?
-function TComDataPacket.ValidStop: Boolean;
-begin
- Result := (FSize > 0) or (Length(FStopString) > 0)
- or (Assigned(FOnCustomStop));
-end;
-
-// receive data
-procedure TComDataPacket.ResetBuffer;
-begin
- EmptyBuffer;
-end;
-
-procedure TComDataPacket.RxBuf(Sender: TObject; const Buffer; Count: Integer);
-var sa:AnsiString; Str: string;
- i:integer;
-begin
- SetLength(Str, Count);
- SetLength(Sa, Count);
- Move(Buffer, Sa[1], Count);
- {$IFDEF Unicode}
- if length(sa)>0 then
- for i := 1 to length(sa) do str[i] := char(byte(sa[i]));
- {$ELSE} str := sa; {$ENDIF}
- AddData(Str);
-end;
-
-// empty buffer
-procedure TComDataPacket.EmptyBuffer;
-begin
- if Buffer <> '' then
- begin
- try
- DoDiscard(Buffer);
- finally
- Buffer := '';
- FInPacket := False;
- end;
- end;
-end;
-
-// set com port
-procedure TComDataPacket.SetComPort(const Value: TCustomComPort);
-begin
- if Value <> FComPort then
- begin
- if FComPort <> nil then
- FComPort.UnRegisterLink(FComLink);
- FComPort := Value;
- if FComPort <> nil then
- begin
- FComPort.FreeNotification(Self);
- FComPort.RegisterLink(FComLink);
- end;
- end;
-end;
-
-// set case sensitivity
-procedure TComDataPacket.SetCaseInsensitive(const Value: Boolean);
-begin
- if FCaseInsensitive <> Value then
- begin
- FCaseInsensitive := Value;
- if not (csLoading in ComponentState) then
- EmptyBuffer;
- end;
-end;
-
-// set packet size
-procedure TComDataPacket.SetSize(const Value: Integer);
-begin
- if FSize <> Value then
- begin
- FSize := Value;
- if not (csLoading in ComponentState) then
- EmptyBuffer;
- end;
-end;
-
-// set start string
-procedure TComDataPacket.SetStartString(const Value: string);
-begin
- if FStartString <> Value then
- begin
- FStartString := Value;
- if not (csLoading in ComponentState) then
- EmptyBuffer;
- end;
-end;
-
-// set stop string
-procedure TComDataPacket.SetStopString(const Value: string);
-begin
- if FStopString <> Value then
- begin
- FStopString := Value;
- if not (csLoading in ComponentState) then
- EmptyBuffer;
- end;
-end;
-
-(*****************************************
- * EComPort exception *
- *****************************************)
-
-// create stream
-constructor TComStream.Create(AComPort: TCustomComPort);
-begin
- inherited Create;
- FComPort := AComPort;
-end;
-
-// read from stream
-function TComStream.Read(var Buffer; Count: Integer): Longint;
-begin
- FComPort.Read(Buffer, Count);
-end;
-
-// write to stream
-function TComStream.Write(const Buffer; Count: Integer): Longint;
-begin
- FComPort.Write(Buffer, Count);
-end;
-
-// seek always to 0
-function TComStream.Seek(Offset: Integer; Origin: Word): Longint;
-begin
- Result := 0;
-end;
-
-(*****************************************
- * EComPort exception *
- *****************************************)
-
-// create exception with windows error code
-constructor EComPort.Create(ACode: Integer; AWinCode: Integer);
-begin
- FWinCode := AWinCode;
- FCode := ACode;
- inherited CreateFmt(ComErrorMessages[ACode] + ' (Error: %d)', [AWinCode]);
-end;
-
-// create exception
-constructor EComPort.CreateNoWinCode(ACode: Integer);
-begin
- FWinCode := -1;
- FCode := ACode;
- inherited Create(ComErrorMessages[ACode]);
-end;
-
-(*****************************************
- * other procedures/functions *
- *****************************************)
-
-// initialization of PAsync variables used in asynchronous calls
-procedure InitAsync(var AsyncPtr: PAsync);
-begin
- New(AsyncPtr);
- with AsyncPtr^ do
- begin
- FillChar(Overlapped, SizeOf(TOverlapped), 0);
- Overlapped.hEvent := CreateEvent(nil, True, True, nil);
- Data := nil;
- Size := 0;
- end;
-end;
-
-// clean-up of PAsync variable
-procedure DoneAsync(var AsyncPtr: PAsync);
-begin
- with AsyncPtr^ do
- begin
- CloseHandle(Overlapped.hEvent);
- if Data <> nil then
- FreeMem(Data);
- end;
- Dispose(AsyncPtr);
- AsyncPtr := nil;
-end;
-
-procedure EnumComPorts(Ports: TStrings);
-var
- KeyHandle: HKEY;
- ErrCode, Index: Integer;
- ValueName, Data: string;
- ValueLen, DataLen, ValueType: DWORD;
- TmpPorts: TStringList;
-begin
- ErrCode := RegOpenKeyEx(
- HKEY_LOCAL_MACHINE,
- 'HARDWARE\DEVICEMAP\SERIALCOMM',
- 0,
- KEY_READ,
- KeyHandle);
-
- if ErrCode <> ERROR_SUCCESS then
- begin
- //raise EComPort.Create(CError_RegError, ErrCode);
- exit;
- end;
-
- TmpPorts := TStringList.Create;
- try
- Index := 0;
- repeat
- ValueLen := 256;
- DataLen := 256;
- SetLength(ValueName, ValueLen);
- SetLength(Data, DataLen);
- ErrCode := RegEnumValue(
- KeyHandle,
- Index,
- PChar(ValueName),
- {$IFDEF DELPHI_4_OR_HIGHER}
- Cardinal(ValueLen),
- {$ELSE}
- ValueLen,
- {$ENDIF}
- nil,
- @ValueType,
- PByte(PChar(Data)),
- @DataLen);
-
- if ErrCode = ERROR_SUCCESS then
- begin
- SetLength(Data, DataLen - 1);
- TmpPorts.Add(Data);
- Inc(Index);
- end
- else
- if ErrCode <> ERROR_NO_MORE_ITEMS then break;
- //raise EComPort.Create(CError_RegError, ErrCode);
-
- until (ErrCode <> ERROR_SUCCESS) ;
-
- TmpPorts.Sort;
- Ports.Assign(TmpPorts);
- finally
- RegCloseKey(KeyHandle);
- TmpPorts.Free;
- end;
-
-end;
-
-// string to baud rate
-function StrToBaudRate(Str: string): TBaudRate;
-var
- I: TBaudRate;
-begin
- I := Low(TBaudRate);
- while (I <= High(TBaudRate)) do
- begin
- if UpperCase(Str) = UpperCase(BaudRateToStr(TBaudRate(I))) then
- Break;
- I := Succ(I);
- end;
- if I > High(TBaudRate) then
- Result := br9600
- else
- Result := I;
-end;
-
-// string to stop bits
-function StrToStopBits(Str: string): TStopBits;
-var
- I: TStopBits;
-begin
- I := Low(TStopBits);
- while (I <= High(TStopBits)) do
- begin
- if UpperCase(Str) = UpperCase(StopBitsToStr(TStopBits(I))) then
- Break;
- I := Succ(I);
- end;
- if I > High(TStopBits) then
- Result := sbOneStopBit
- else
- Result := I;
-end;
-
-// string to data bits
-function StrToDataBits(Str: string): TDataBits;
-var
- I: TDataBits;
-begin
- I := Low(TDataBits);
- while (I <= High(TDataBits)) do
- begin
- if UpperCase(Str) = UpperCase(DataBitsToStr(I)) then
- Break;
- I := Succ(I);
- end;
- if I > High(TDataBits) then
- Result := dbEight
- else
- Result := I;
-end;
-
-// string to parity
-function StrToParity(Str: string): TParityBits;
-var
- I: TParityBits;
-begin
- I := Low(TParityBits);
- while (I <= High(TParityBits)) do
- begin
- if UpperCase(Str) = UpperCase(ParityToStr(I)) then
- Break;
- I := Succ(I);
- end;
- if I > High(TParityBits) then
- Result := prNone
- else
- Result := I;
-end;
-
-// string to flow control
-function StrToFlowControl(Str: string): TFlowControl;
-var
- I: TFlowControl;
-begin
- I := Low(TFlowControl);
- while (I <= High(TFlowControl)) do
- begin
- if UpperCase(Str) = UpperCase(FlowControlToStr(I)) then
- Break;
- I := Succ(I);
- end;
- if I > High(TFlowControl) then
- Result := fcCustom
- else
- Result := I;
-end;
-
-// baud rate to string
-function BaudRateToStr(BaudRate: TBaudRate): string;
-const
- BaudRateStrings: array[TBaudRate] of string = ('Custom', '110', '300', '600',
- '1200', '2400', '4800', '9600', '14400', '19200', '38400', '56000', '57600',
- '115200', '128000', '256000');
-begin
- Result := BaudRateStrings[BaudRate];
-end;
-
-// stop bits to string
-function StopBitsToStr(StopBits: TStopBits): string;
-const
- StopBitsStrings: array[TStopBits] of string = ('1', '1.5', '2');
-begin
- Result := StopBitsStrings[StopBits];
-end;
-
-// data bits to string
-function DataBitsToStr(DataBits: TDataBits): string;
-const
- DataBitsStrings: array[TDataBits] of string = ('5', '6', '7', '8');
-begin
- Result := DataBitsStrings[DataBits];
-end;
-
-// parity to string
-function ParityToStr(Parity: TParityBits): string;
-const
- ParityBitsStrings: array[TParityBits] of string = ('None', 'Odd', 'Even',
- 'Mark', 'Space');
-begin
- Result := ParityBitsStrings[Parity];
-end;
-
-// flow control to string
-function FlowControlToStr(FlowControl: TFlowControl): string;
-const
- FlowControlStrings: array[TFlowControl] of string = ('Hardware',
- 'Software', 'None', 'Custom');
-begin
- Result := FlowControlStrings[FlowControl];
-end;
-
-initialization
- ComErrorMessages[1]:='Unable to open com port';
- ComErrorMessages[2]:='WriteFile function failed';
- ComErrorMessages[3]:='ReadFile function failed';
- ComErrorMessages[4]:='Invalid Async parameter';
- ComErrorMessages[5]:='PurgeComm function failed';
- ComErrorMessages[6]:='Unable to get async status';
- ComErrorMessages[7]:='SetCommState function failed';
- ComErrorMessages[8]:='SetCommTimeouts failed';
- ComErrorMessages[9]:='SetupComm function failed';
- ComErrorMessages[10]:='ClearCommError function failed';
- ComErrorMessages[11]:='GetCommModemStatus function failed';
- ComErrorMessages[12]:='EscapeCommFunction function failed';
- ComErrorMessages[13]:='TransmitCommChar function failed';
- ComErrorMessages[14]:='Cannot set property while connected';
- ComErrorMessages[15]:='EnumPorts function failed';
- ComErrorMessages[16]:='Failed to store settings';
- ComErrorMessages[17]:='Failed to load settings';
- ComErrorMessages[18]:='Link (un)registration failed';
- ComErrorMessages[19]:='Cannot change led state if ComPort is selected';
- ComErrorMessages[20]:='Cannot wait for event if event thread is created';
- ComErrorMessages[21]:='WaitForEvent method failed';
- ComErrorMessages[22]:='A component is linked to OnRxBuf event';
- ComErrorMessages[23]:='Registry error';
- ComErrorMessages[24]:='Port Not Open';// CError_PortNotOpen
-
-
-end.
diff --git a/Host/Source/MicroBoot/interfaces/uart/XcpSettings.dfm b/Host/Source/MicroBoot/interfaces/uart/XcpSettings.dfm
deleted file mode 100644
index 28d45f21..00000000
Binary files a/Host/Source/MicroBoot/interfaces/uart/XcpSettings.dfm and /dev/null differ
diff --git a/Host/Source/MicroBoot/interfaces/uart/XcpSettings.pas b/Host/Source/MicroBoot/interfaces/uart/XcpSettings.pas
deleted file mode 100644
index 548fa338..00000000
--- a/Host/Source/MicroBoot/interfaces/uart/XcpSettings.pas
+++ /dev/null
@@ -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 *******************************
-
-
diff --git a/Host/Source/MicroBoot/interfaces/uart/XcpTransport.pas b/Host/Source/MicroBoot/interfaces/uart/XcpTransport.pas
deleted file mode 100644
index 3691a6fd..00000000
--- a/Host/Source/MicroBoot/interfaces/uart/XcpTransport.pas
+++ /dev/null
@@ -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 ******************************
-
diff --git a/Host/Source/MicroBoot/interfaces/uart/openblt_uart.dpr b/Host/Source/MicroBoot/interfaces/uart/openblt_uart.dpr
deleted file mode 100644
index 70a166d1..00000000
--- a/Host/Source/MicroBoot/interfaces/uart/openblt_uart.dpr
+++ /dev/null
@@ -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 ****************************
diff --git a/Host/Source/MicroBoot/interfaces/uart/openblt_uart.dproj b/Host/Source/MicroBoot/interfaces/uart/openblt_uart.dproj
deleted file mode 100644
index a227eea6..00000000
--- a/Host/Source/MicroBoot/interfaces/uart/openblt_uart.dproj
+++ /dev/null
@@ -1,121 +0,0 @@
-
-
- {38BAA5EC-0626-4775-9516-B3DED4560560}
- openblt_uart.dpr
- True
- Debug
- 1
- Library
- VCL
- 18.2
- Win32
-
-
- true
-
-
- true
- Base
- true
-
-
- true
- Base
- true
-
-
- true
- Base
- true
-
-
- true
- Cfg_2
- true
- true
-
-
- false
- Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace)
- Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40;$(DCC_UsePackage)
- false
- false
- 1031
- 00400000
- 1
- 1
- true
- CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=
- openblt_uart
- true
- false
- true
- ../../../../
- 1
-
-
- 1033
- System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
- true
-
-
- RELEASE;$(DCC_Define)
- 0
- false
- 0
-
-
- DEBUG;$(DCC_Define)
- true
- false
-
-
- 1
- CompanyName=;FileVersion=1.1.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.1.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName)
- 1033
- C:\Work\software\OpenBLT\Host\MicroBoot.exe
- (None)
- true
-
-
-
- MainSource
-
-
-
-
-
-
-
-
-
-
- Cfg_2
- Base
-
-
- Base
-
-
- Cfg_1
- Base
-
-
-
- Delphi.Personality.12
-
-
-
-
- openblt_uart.dpr
-
-
-
- True
-
-
- 12
-
-
-
-
diff --git a/Host/Source/MicroBoot/interfaces/usb/UsbBulkLib.pas b/Host/Source/MicroBoot/interfaces/usb/UsbBulkLib.pas
deleted file mode 100644
index c7df7292..00000000
--- a/Host/Source/MicroBoot/interfaces/usb/UsbBulkLib.pas
+++ /dev/null
@@ -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 ******************************
-
diff --git a/Host/Source/MicroBoot/interfaces/usb/XcpSettings.dfm b/Host/Source/MicroBoot/interfaces/usb/XcpSettings.dfm
deleted file mode 100644
index cdca8cc4..00000000
Binary files a/Host/Source/MicroBoot/interfaces/usb/XcpSettings.dfm and /dev/null differ
diff --git a/Host/Source/MicroBoot/interfaces/usb/XcpSettings.pas b/Host/Source/MicroBoot/interfaces/usb/XcpSettings.pas
deleted file mode 100644
index 0a73093d..00000000
--- a/Host/Source/MicroBoot/interfaces/usb/XcpSettings.pas
+++ /dev/null
@@ -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 *******************************
-
-
diff --git a/Host/Source/MicroBoot/interfaces/usb/XcpTransport.pas b/Host/Source/MicroBoot/interfaces/usb/XcpTransport.pas
deleted file mode 100644
index c5e3cdb2..00000000
--- a/Host/Source/MicroBoot/interfaces/usb/XcpTransport.pas
+++ /dev/null
@@ -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 ******************************
-
diff --git a/Host/Source/MicroBoot/interfaces/usb/openblt_usb.dpr b/Host/Source/MicroBoot/interfaces/usb/openblt_usb.dpr
deleted file mode 100644
index 352826b4..00000000
--- a/Host/Source/MicroBoot/interfaces/usb/openblt_usb.dpr
+++ /dev/null
@@ -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 *****************************
diff --git a/Host/Source/MicroBoot/interfaces/usb/openblt_usb.dproj b/Host/Source/MicroBoot/interfaces/usb/openblt_usb.dproj
deleted file mode 100644
index 2a2953e3..00000000
--- a/Host/Source/MicroBoot/interfaces/usb/openblt_usb.dproj
+++ /dev/null
@@ -1,121 +0,0 @@
-
-
- {5F773EB4-5A4B-4591-999A-E208B1A44407}
- openblt_usb.dpr
- True
- Debug
- 1
- Library
- VCL
- 18.2
- Win32
-
-
- true
-
-
- true
- Base
- true
-
-
- true
- Base
- true
-
-
- true
- Base
- true
-
-
- true
- Cfg_2
- true
- true
-
-
- false
- false
- 1
- true
- .\..\..\..\..\
- 1
- true
- false
- false
- 00400000
- true
- Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace)
- openblt_usb
- 1031
- 1
- CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=
- Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40;$(DCC_UsePackage)
-
-
- 1033
- System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
- true
-
-
- RELEASE;$(DCC_Define)
- false
- 0
- 0
-
-
- true
- DEBUG;$(DCC_Define)
- false
-
-
- 1
- CompanyName=;FileVersion=1.1.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.1.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName)
- C:\Work\software\OpenBLT\Host\MicroBoot.exe
- 1033
- (None)
- true
-
-
-
- MainSource
-
-
-
-
-
-
-
-
-
-
- Cfg_2
- Base
-
-
- Base
-
-
- Cfg_1
- Base
-
-
-
- Delphi.Personality.12
-
-
-
-
- openblt_usb.dpr
-
-
-
- True
-
-
- 12
-
-
-
-
diff --git a/Host/Source/MicroBoot/mainunit.lfm b/Host/Source/MicroBoot/mainunit.lfm
new file mode 100644
index 00000000..e4cd8d79
--- /dev/null
+++ b/Host/Source/MicroBoot/mainunit.lfm
@@ -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
diff --git a/Host/Source/MicroBoot/mainunit.pas b/Host/Source/MicroBoot/mainunit.pas
new file mode 100644
index 00000000..26f9ca30
--- /dev/null
+++ b/Host/Source/MicroBoot/mainunit.pas
@@ -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 **********************************
+
diff --git a/Host/Source/MicroBoot/miscellaneousdialog.lfm b/Host/Source/MicroBoot/miscellaneousdialog.lfm
new file mode 100644
index 00000000..405ce39c
--- /dev/null
+++ b/Host/Source/MicroBoot/miscellaneousdialog.lfm
@@ -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
diff --git a/Host/Source/MicroBoot/miscellaneousdialog.pas b/Host/Source/MicroBoot/miscellaneousdialog.pas
new file mode 100644
index 00000000..adea0f81
--- /dev/null
+++ b/Host/Source/MicroBoot/miscellaneousdialog.pas
@@ -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 ***********************
+
diff --git a/Host/Source/MicroBoot/sessionxcpdialog.lfm b/Host/Source/MicroBoot/sessionxcpdialog.lfm
new file mode 100644
index 00000000..394ea264
--- /dev/null
+++ b/Host/Source/MicroBoot/sessionxcpdialog.lfm
@@ -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
diff --git a/Host/Source/MicroBoot/sessionxcpdialog.pas b/Host/Source/MicroBoot/sessionxcpdialog.pas
new file mode 100644
index 00000000..f59762dd
--- /dev/null
+++ b/Host/Source/MicroBoot/sessionxcpdialog.pas
@@ -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 **************************
+
diff --git a/Host/Source/MicroBoot/settingsdialog.lfm b/Host/Source/MicroBoot/settingsdialog.lfm
new file mode 100644
index 00000000..822be818
--- /dev/null
+++ b/Host/Source/MicroBoot/settingsdialog.lfm
@@ -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
diff --git a/Host/Source/MicroBoot/settingsdialog.pas b/Host/Source/MicroBoot/settingsdialog.pas
new file mode 100644
index 00000000..c6a8798b
--- /dev/null
+++ b/Host/Source/MicroBoot/settingsdialog.pas
@@ -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 ****************************
+
diff --git a/Host/Source/MicroBoot/StopWatch.pas b/Host/Source/MicroBoot/stopwatch.pas
similarity index 57%
rename from Host/Source/MicroBoot/StopWatch.pas
rename to Host/Source/MicroBoot/stopwatch.pas
index 82d43883..f3f8fe43 100644
--- a/Host/Source/MicroBoot/StopWatch.pas
+++ b/Host/Source/MicroBoot/stopwatch.pas
@@ -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 *********************************
+
diff --git a/Host/Source/MicroBoot/transportxcpcandialog.lfm b/Host/Source/MicroBoot/transportxcpcandialog.lfm
new file mode 100644
index 00000000..f579162c
--- /dev/null
+++ b/Host/Source/MicroBoot/transportxcpcandialog.lfm
@@ -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
diff --git a/Host/Source/MicroBoot/transportxcpcandialog.pas b/Host/Source/MicroBoot/transportxcpcandialog.pas
new file mode 100644
index 00000000..cb089c8c
--- /dev/null
+++ b/Host/Source/MicroBoot/transportxcpcandialog.pas
@@ -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 *********************
+
diff --git a/Host/Source/MicroBoot/transportxcprs232dialog.lfm b/Host/Source/MicroBoot/transportxcprs232dialog.lfm
new file mode 100644
index 00000000..1779211b
--- /dev/null
+++ b/Host/Source/MicroBoot/transportxcprs232dialog.lfm
@@ -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
diff --git a/Host/Source/MicroBoot/transportxcprs232dialog.pas b/Host/Source/MicroBoot/transportxcprs232dialog.pas
new file mode 100644
index 00000000..1e65bf15
--- /dev/null
+++ b/Host/Source/MicroBoot/transportxcprs232dialog.pas
@@ -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 *******************
+
diff --git a/Host/Source/MicroBoot/transportxcptcpipdialog.lfm b/Host/Source/MicroBoot/transportxcptcpipdialog.lfm
new file mode 100644
index 00000000..5b598d2c
--- /dev/null
+++ b/Host/Source/MicroBoot/transportxcptcpipdialog.lfm
@@ -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
diff --git a/Host/Source/MicroBoot/transportxcptcpipdialog.pas b/Host/Source/MicroBoot/transportxcptcpipdialog.pas
new file mode 100644
index 00000000..55f6f05e
--- /dev/null
+++ b/Host/Source/MicroBoot/transportxcptcpipdialog.pas
@@ -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 *******************
+
diff --git a/Host/Source/MicroBoot/transportxcpusbdialog.lfm b/Host/Source/MicroBoot/transportxcpusbdialog.lfm
new file mode 100644
index 00000000..b8e4f5b1
--- /dev/null
+++ b/Host/Source/MicroBoot/transportxcpusbdialog.lfm
@@ -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
diff --git a/Host/Source/MicroBoot/transportxcpusbdialog.pas b/Host/Source/MicroBoot/transportxcpusbdialog.pas
new file mode 100644
index 00000000..8812171e
--- /dev/null
+++ b/Host/Source/MicroBoot/transportxcpusbdialog.pas
@@ -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 *********************
+
diff --git a/Host/Source/MicroBoot/uBootInterface.pas b/Host/Source/MicroBoot/uBootInterface.pas
deleted file mode 100644
index 92856138..00000000
--- a/Host/Source/MicroBoot/uBootInterface.pas
+++ /dev/null
@@ -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 *****************************
-
-
diff --git a/Host/canlib32.dll b/Host/canlib32.dll
deleted file mode 100644
index a9f9628f..00000000
Binary files a/Host/canlib32.dll and /dev/null differ
diff --git a/Host/openblt_can_kvaser.dll b/Host/openblt_can_kvaser.dll
deleted file mode 100644
index 9e1ce097..00000000
Binary files a/Host/openblt_can_kvaser.dll and /dev/null differ
diff --git a/Host/openblt_can_kvaser.ini b/Host/openblt_can_kvaser.ini
deleted file mode 100644
index 8c0447e7..00000000
--- a/Host/openblt_can_kvaser.ini
+++ /dev/null
@@ -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
diff --git a/Host/openblt_can_lawicel.dll b/Host/openblt_can_lawicel.dll
deleted file mode 100644
index 7d433068..00000000
Binary files a/Host/openblt_can_lawicel.dll and /dev/null differ
diff --git a/Host/openblt_can_lawicel.ini b/Host/openblt_can_lawicel.ini
deleted file mode 100644
index 3d86d224..00000000
--- a/Host/openblt_can_lawicel.ini
+++ /dev/null
@@ -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
diff --git a/Host/openblt_can_peak.dll b/Host/openblt_can_peak.dll
deleted file mode 100644
index c65ead73..00000000
Binary files a/Host/openblt_can_peak.dll and /dev/null differ
diff --git a/Host/openblt_can_peak.ini b/Host/openblt_can_peak.ini
deleted file mode 100644
index 3d86d224..00000000
--- a/Host/openblt_can_peak.ini
+++ /dev/null
@@ -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
diff --git a/Host/openblt_net.dll b/Host/openblt_net.dll
deleted file mode 100644
index cdf8ff3c..00000000
Binary files a/Host/openblt_net.dll and /dev/null differ
diff --git a/Host/openblt_net.ini b/Host/openblt_net.ini
deleted file mode 100644
index 2e85d789..00000000
--- a/Host/openblt_net.ini
+++ /dev/null
@@ -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
diff --git a/Host/openblt_uart.dll b/Host/openblt_uart.dll
deleted file mode 100644
index 30f49ca0..00000000
Binary files a/Host/openblt_uart.dll and /dev/null differ
diff --git a/Host/openblt_uart.ini b/Host/openblt_uart.ini
deleted file mode 100644
index f2fa1392..00000000
--- a/Host/openblt_uart.ini
+++ /dev/null
@@ -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
diff --git a/Host/openblt_usb.dll b/Host/openblt_usb.dll
deleted file mode 100644
index 13f0eb0f..00000000
Binary files a/Host/openblt_usb.dll and /dev/null differ
diff --git a/Host/openblt_usb.ini b/Host/openblt_usb.ini
deleted file mode 100644
index 4a94a536..00000000
--- a/Host/openblt_usb.ini
+++ /dev/null
@@ -1,9 +0,0 @@
-[xcp]
-seedkey=libseednkey.dll
-t1=1000
-t3=2000
-t4=10000
-t5=1000
-t7=2000
-tconnect=20
-connectmode=0