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

Refs #51, #53. 

- Ported MicroBoot program and interface DLLs from Delphi 4 to Delphi 10.1 Berlin. 

git-svn-id: https://svn.code.sf.net/p/openblt/code/trunk@153 5dc33758-31d5-4daf-9ae8-b24bf3d40d73
This commit is contained in:
Frank Voorburg 2016-10-12 09:24:52 +00:00
parent c6125bed87
commit 215ec94269
69 changed files with 5659 additions and 6339 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
Host/MicroBoot.exe
View File

Binary file not shown.

BIN
Host/PCANBasic.dll Normal file
View File

Binary file not shown.

BIN
Host/Pcan_usb.dll
View File

Binary file not shown.

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

Binary file not shown.

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

@ -141,6 +141,8 @@ end; //*** end of OnMbiStarted ***
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 ***
@ -178,7 +180,7 @@ end; //*** end of OnMbiDone ***
//***************************************************************************************
procedure TmainForm.OnMbiError(error: ShortString);
begin
ShowMessage(error); // display error
ShowMessage(String(error)); // display error
Timer.Enabled := false; // stop the timer
StopWatch.Stop; // stop the stopwatch
mainForm.Caption := FormCaption; // restore caption
@ -205,7 +207,7 @@ procedure TmainForm.OnMbiLog(info: ShortString);
begin
if MbiLogging = True then
begin
LogLines.Add(info); // add to log
LogLines.Add(String(info)); // add to log
end;
end; //*** end of OnMbiLog ***
@ -221,7 +223,7 @@ end; //*** end of OnMbiLog ***
procedure TmainForm.OnMbiInfo(info: ShortString);
begin
if NtbPages.PageIndex = 1 then
lblDownloadProgress.Caption := info;
lblDownloadProgress.Caption := String(info);
end; //*** end of OnMbiLog ***
@ -235,8 +237,8 @@ end; //*** end of OnMbiLog ***
//***************************************************************************************
function TmainForm.GetActiveMbi : string;
begin
if IsMbiInterface(MbiLibFile) then
Result := MbiLibFile
if IsMbiInterface(String(MbiLibFile)) then
Result := String(MbiLibFile)
else
Result := '';
end; //*** end of GetActiveMbi ***
@ -255,7 +257,7 @@ begin
if IsMbiInterface(libFile) then
begin
MbiLibFile := libFile;
MbiLibFile := ShortString(libFile);
MbiInterfaced := MbiInterface.Enable(libFile, OnMbiStarted, OnMbiProgress,
OnMbiDone, OnMbiError, OnMbiLog, OnMbiInfo);
end;
@ -315,7 +317,8 @@ begin
end;
end;
Result := LibValid;
end; //*** end of IsMbiInterface ***
end;
//*** end of IsMbiInterface ***
//***************************************************************************************
@ -348,7 +351,7 @@ begin
if Assigned(DescriptionFnc) then
begin
Result := Result + DescriptionFnc;
Result := Result + String(DescriptionFnc);
end;
if Assigned(VersionFnc) then
@ -406,11 +409,11 @@ end; //*** end of GetInterfaceFileList ***
//***************************************************************************************
procedure TmainForm.StartFileDownload(fileName : ShortString);
begin
if FileExists(fileName) and (MbiInterfaced = True) then
if FileExists(String(fileName)) and (MbiInterfaced = True) then
begin
FormCaption := mainForm.Caption; // backup original caption
mainForm.Caption := FormCaption + ' - Downloading ' +
ExtractFileName(fileName) + '...';
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
@ -432,7 +435,7 @@ begin
// display interface library description
if MbiInterfaced = True then
begin
lblInterfaceName.Caption := 'for ' + MbiInterface.Description;
lblInterfaceName.Caption := 'for ' + String(MbiInterface.Description);
end
else
begin
@ -538,7 +541,7 @@ begin
// is it a valid Mbi interface library?
if IsMbiInterface(foundLibrary) = True then
begin
MbiLibFile := foundLibrary;
MbiLibFile := ShortString(foundLibrary);
foundInterface := True;
end;
end;
@ -560,7 +563,7 @@ begin
// is it a valid Mbi interface library?
if IsMbiInterface(foundLibrary) = True then
begin
MbiLibFile := foundLibrary;
MbiLibFile := ShortString(foundLibrary);
foundInterface := True;
end;
end;
@ -579,7 +582,7 @@ begin
// is it a valid Mbi interface library?
if IsMbiInterface(foundLibrary) = True then
begin
MbiLibFile := foundLibrary;
MbiLibFile := ShortString(foundLibrary);
foundInterface := True;
end;
end;
@ -589,7 +592,7 @@ begin
// did we find a Mbi interface library?
if foundInterface = True then
begin
SetActiveMbi(MbiLibFile);
SetActiveMbi(String(MbiLibFile));
end;
// create the stopwatch timer
@ -634,7 +637,7 @@ begin
if (ParamCount > 0) and (FileExists(ParamStr(ParamCount))) then
begin
edtDownloadFile.Text := ParamStr(ParamCount);
StartFileDownload(ParamStr(ParamCount));
StartFileDownload(ShortString(ParamStr(ParamCount)));
Exit; // nothing more todo
end;
@ -653,7 +656,7 @@ begin
if FileExists(OpenDialog.FileName) then
begin
edtDownloadFile.Text := OpenDialog.FileName;
StartFileDownload(OpenDialog.FileName);
StartFileDownload(ShortString(OpenDialog.FileName));
end;
end;
end;
@ -676,7 +679,7 @@ begin
if FileExists(OpenDialog.FileName) then
begin
edtDownloadFile.Text := OpenDialog.FileName;
StartFileDownload(OpenDialog.FileName);
StartFileDownload(ShortString(OpenDialog.FileName));
end;
end;
end; //*** end of btnBrowseClick ***
@ -702,7 +705,7 @@ begin
winRegistry := TRegistry.Create;
winRegistry.RootKey := HKEY_CURRENT_USER;
winRegistry.OpenKey('Software\Feaser\MicroBoot', true);
winRegistry.WriteString('Interface', ExtractFileName(MbiLibFile));
winRegistry.WriteString('Interface', ExtractFileName(String(MbiLibFile)));
winRegistry.Free;
end;
UpdateInterfaceLabel;
@ -751,7 +754,7 @@ begin
// start the download
if FileExists(edtDownloadFile.Text) then
begin
StartFileDownload(edtDownloadFile.Text);
StartFileDownload(ShortString(edtDownloadFile.Text));
end;
end;

35
Host/Source/MicroBoot/MicroBoot.cfg
View File

@ -1,35 +0,0 @@
-$A+
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J+
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-E../../
-LNc:\borland\delphi4\Lib

89
Host/Source/MicroBoot/MicroBoot.dof
View File

@ -1,89 +0,0 @@
[Compiler]
A=1
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=1
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=../../
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
[Version Info]
IncludeVerInfo=0
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1031
CodePage=1252
[Version Info Keys]
CompanyName=
FileDescription=
FileVersion=1.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=1.0.0.0
Comments=
[Excluded Packages]
$(DELPHI)\Lib\dclusr40.bpl=Borland User
$(DELPHI)\Components\tsock\tsock.bpl=(untitled)
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[HistoryLists\hlOutputDirectorry]
Count=3
Item0=../../
Item1=../..
Item2=../

3
Host/Source/MicroBoot/MicroBoot.dpr
View File

@ -35,7 +35,8 @@ uses
Forms,
MainUnit in 'MainUnit.pas' {mainForm},
SettingsUnit in 'SettingsUnit.pas' {settingsForm},
StopWatch in 'StopWatch.pas';
StopWatch in 'StopWatch.pas',
uBootInterface in 'uBootInterface.pas';
{$R *.RES}

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

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

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

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 2.4 KiB

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

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.1 KiB

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

@ -453,6 +453,10 @@ 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
@ -1256,6 +1260,10 @@ 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;

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

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 2.4 KiB

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

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 538 B

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

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

559
Host/Source/MicroBoot/interfaces/can/peak/PCANdrvD.pas
View File

@ -1,559 +0,0 @@
unit PCANdrvD;
//***************************************************************************************
// Project Name: TPCanDriver component for Borland Delphi
// Description: Encapsulates PCAN's Light driver into a VCL component for PCANUSB 1CH.
// File Name: PCANdrvD.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, Pcan_usb;
//***************************************************************************************
// Type Definitions
//***************************************************************************************
type
TPCanChannel = ( pcanchannel0 );
TPCanHardware = ( PCAN_USB1CH );
TPCanDirection = ( PcanTx, PCanRx );
TPCanMessage = packed record
id : LongInt;
dlc : Byte;
data : array [0..7] of Byte;
time : LongInt;
ext : Boolean;
end;
type
TPCanMessageEvent = procedure( Sender: TObject; Direction: TPCanDirection; Message: TPCanMessage ) of object;
type
TPCanEventThread = class(TThread)
private
{ Private declarations }
FMethod: TThreadMethod;
protected
procedure Execute; override;
public
property Method : TThreadMethod read FMethod write FMethod;
end;
type
TPCanDriver = class(TComponent)
private
{ Private declarations }
FCanEventThread: TPCanEventThread;
FThreadRunning : boolean;
FCanConnected : boolean;
FStartTickCnt : DWORD;
function IsThreadRunning: boolean;
procedure ProcessReception;
protected
{ Protected declarations }
FBaudRate : LongInt;
FChannel : TPCanChannel;
FHardware : TPCanHardware;
FPriority : TThreadPriority;
FExtendedId : Boolean;
FOnMessage : TPCanMessageEvent;
procedure SetBaudRate( Value: LongInt );
procedure SetChannel( Value: TPCanChannel );
procedure SetHardware( Value: TPCanHardware );
procedure SetPriority( Value: TThreadPriority );
procedure SetExtendedId( Value: Boolean );
public
{ Public declarations }
constructor Create( AOwner: TComponent ); override;
destructor Destroy; override;
function Connect: boolean; virtual;
procedure Disconnect; virtual;
function Transmit( Message: TPCanMessage): boolean; virtual;
function IsConnected: boolean; virtual;
function IsComError: boolean; virtual;
published
{ Published declarations }
property BaudRate : LongInt read FBaudRate write SetBaudRate default 500000;
property Channel : TPCanChannel read FChannel write SetChannel default pcanchannel0;
property Hardware : TPCanHardware read FHardware write SetHardware default PCAN_USB1CH;
property Priority : TThreadPriority read FPriority write SetPriority default tpNormal;
property ExtendedId : Boolean read FExtendedId write SetExtendedId default False;
property OnMessage : TPCanMessageEvent read FOnMessage write FOnMessage;
end;
//***************************************************************************************
// Prototypes
//***************************************************************************************
procedure Register;
implementation
//***************************************************************************************
// NAME: Execute
// PRECONDITIONS: none
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Overriden Execute function for the CanEventThread. Calls and synchro-
// nizes with the TCanDriver.ProcessEvents function.
//
//***************************************************************************************
procedure TPCanEventThread.Execute;
begin
while not Terminated do
begin
if Assigned(Method) then // make sure TPCanDriver.ProcessEvents is set
Synchronize(Method); // call and synchronize
end;
end; //*** end of Execute ***
//***************************************************************************************
// NAME: Create
// PRECONDITIONS: none
// 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 TPCanDriver.Create( AOwner: TComponent );
begin
// call inherited constructor
inherited Create( AOwner );
// set defaults for internal variables
FThreadRunning := False;
FCanConnected := False;
// set defaults for properties
FBaudRate := 500000;
FChannel := pcanchannel0;
FHardware := PCAN_USB1CH;
FPriority := tpNormal;
FExtendedId := False;
end; //*** end of Create ***
//***************************************************************************************
// NAME: Destroy
// PRECONDITIONS: none
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Component destructor. Calls TComponent's destructor
//
//***************************************************************************************
destructor TPCanDriver.Destroy;
begin
Disconnect; // close the port and driver
inherited Destroy; // call inherited destructor
end; //*** end of Destroy ***
//***************************************************************************************
// NAME: IsConnected
// PRECONDITIONS: none
// PARAMETER: none
// RETURN VALUE: True or False
// DESCRIPTION: Determines whether or not the CAN driver is connected and active
//
//***************************************************************************************
function TPCanDriver.IsConnected: boolean;
begin
Result := FCanConnected;
end; //*** end of IsConnected ***
//***************************************************************************************
// NAME: IsComError
// PRECONDITIONS: none
// PARAMETER: none
// RETURN VALUE: True if the communication interface is in error state, False otherwise
// DESCRIPTION: Determines whether or not the CAN controller is in error state.
//
//***************************************************************************************
function TPCanDriver.IsComError: boolean;
begin
// check for bus off
result := ((CAN_Status and CAN_ERR_BUSOFF) <> 0);
end; //*** end of IsComError ***
//***************************************************************************************
// NAME: IsThreadRunning
// PRECONDITIONS: none
// PARAMETER: none
// RETURN VALUE: True or False
// DESCRIPTION: Determines whether or not the CAN event thread is running
//
//***************************************************************************************
function TPCanDriver.IsThreadRunning: boolean;
begin
if FThreadRunning = True then
Result := True
else
Result := False;
end; //*** end of IsThreadRunning ***
//***************************************************************************************
// NAME: SetBaudRate
// PRECONDITIONS: none
// PARAMETER: Value : new baudrate value [0 - 1000000 bps]
// RETURN VALUE: none
// DESCRIPTION: Configures the baudrate
//
// |------------------------------------------------------------------------------------
// | Update baudrate configuration
// |------------------------------------------------------------------------------------
//***************************************************************************************
procedure TPCanDriver.SetBaudRate( Value: LongInt );
begin
FBaudRate := Value; // update property
end; //*** end of SetBaudRate ***
//***************************************************************************************
// NAME: SetChannel
// PRECONDITIONS: none
// PARAMETER: Value : channel0 or channel1
// RETURN VALUE: none
// DESCRIPTION: Configures the used CAN channel
//
// |------------------------------------------------------------------------------------
// | Update channel configuration
// |------------------------------------------------------------------------------------
//***************************************************************************************
procedure TPCanDriver.SetChannel( Value: TPCanChannel );
begin
FChannel := Value;
end; //*** end of SetChannel ***
//***************************************************************************************
// NAME: SetHardware
// PRECONDITIONS: none
// PARAMETER: Value : type of CAN hardware (Virtual, CANcardXL, etc.)
// RETURN VALUE: none
// DESCRIPTION: Configures the used CAN hardware
//
// |------------------------------------------------------------------------------------
// | Update hardware configuration
// |------------------------------------------------------------------------------------
//***************************************************************************************
procedure TPCanDriver.SetHardware( Value: TPCanHardware );
begin
FHardware := Value;
end; //*** end of SetHardware ***
//***************************************************************************************
// NAME: SetPriority
// PRECONDITIONS: none
// PARAMETER: Value : thread priority
// RETURN VALUE: none
// DESCRIPTION: Configures the priority for the CAN event thread
//
// |------------------------------------------------------------------------------------
// | y\ Is Thread running? /n
// |------------------------------------------------------------------------------------
// | Stop Thread |
// | Update Thread priority | Update Thread priority
// | Restart Thread |
// |------------------------------------------------------------------------------------
//***************************************************************************************
procedure TPCanDriver.SetPriority( Value: TThreadPriority );
begin
if IsThreadRunning then
begin
FCanEventThread.Suspend; // suspend the thread
FPriority := Value; // update the priority
FCanEventThread.Resume; // resume the thread
end
else
begin
FPriority := Value; // update the priority
end;
end; //*** end of SetPriority ***
//***************************************************************************************
// NAME: SetExtendedId
// PRECONDITIONS: none
// PARAMETER: Value : true = support only 29-bit id's, false = support only 11-bit
// RETURN VALUE: none
// DESCRIPTION: Configures the support of extended 29-bit identifiers
//
// |------------------------------------------------------------------------------------
// | Update extended id support selection
// |------------------------------------------------------------------------------------
//***************************************************************************************
procedure TPCanDriver.SetExtendedId( Value: Boolean );
begin
FExtendedId := Value;
end; //*** end of SetExtendedId ***/
//***************************************************************************************
// NAME: Connect
// PRECONDITIONS: Disconnected from CAN bus
// PARAMETER: none
// RETURN VALUE: True or False for succees or error, respectively
// DESCRIPTION: Initializes the CAN driver and synchronizes the hardware with the CAN
// bus.
//
//***************************************************************************************
function TPCanDriver.Connect: boolean;
var
Baudcode : Word;
MsgType : Integer;
begin
Result := False;
FThreadRunning := False;
FCanConnected := False;
// convert baudrate in bps to supported baudrate code
Baudcode := CAN_BAUD_500K; // init local
case FBaudRate of
5000 : Baudcode := CAN_BAUD_5K;
10000 : Baudcode := CAN_BAUD_10K;
20000 : Baudcode := CAN_BAUD_20K;
33333 : Baudcode := $1D14;
50000 : Baudcode := CAN_BAUD_50K;
83333 : Baudcode := $4B14;
100000 : Baudcode := CAN_BAUD_100K;
125000 : Baudcode := CAN_BAUD_125K;
250000 : Baudcode := CAN_BAUD_250K;
500000 : Baudcode := CAN_BAUD_500K;
1000000 : Baudcode := CAN_BAUD_1M;
end;
// convert extented id info
if FExtendedId then
MsgType := 1
else
MsgType := 0;
//-------------------------- open the driver ------------------------------------------
if CAN_Init(Baudcode, MsgType) <> CAN_ERR_OK then Exit;
//-------------------------- open the acceptance filter --------------------------------
if CAN_ResetFilter <> CAN_ERR_OK then
begin
CAN_Close;
Exit;
end;
if FExtendedId then
begin
if CAN_MsgFilter($000, $1FFFFFFF, MSGTYPE_EXTENDED) <> CAN_ERR_OK then
begin
CAN_Close;
Exit;
end;
end
else
begin
if CAN_MsgFilter($000, $7FF, MSGTYPE_STANDARD) <> CAN_ERR_OK then
begin
CAN_Close;
Exit;
end;
end;
//-------------------------- reset message queues -------------------------------------
if CAN_ResetClient <> CAN_ERR_OK then
begin
CAN_Close;
Exit;
end;
//-------------------------- start CAN event thread -----------------------------------
FCanEventThread := TPCanEventThread.Create(True); // create and suspend
FCanEventThread.FreeOnTerminate := True; // auto free on termination
FCanEventThread.Method := ProcessReception; // set method
FCanEventThread.Resume; // start
FThreadRunning := True;
//-------------------------- store start time for time stamps -------------------------
FStartTickCnt := GetTickCount;
//-------------------------- success --------------------------------------------------
FCanConnected := True;
Result := True; // successfully initialized the driver
end; //*** end of Connect ***
//***************************************************************************************
// NAME: Disconnect
// PRECONDITIONS: none
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Disconnects the CAN driver
//
//***************************************************************************************
procedure TPCanDriver.Disconnect;
begin
if IsConnected = True then // are we connected?
begin
FCanConnected := False;
// close the channel
CAN_Close;
end;
if IsThreadRunning then
begin
FCanEventThread.Terminate; // stop
FThreadRunning := False;
end;
end; //*** end of Disconnect ***
//***************************************************************************************
// NAME: Transmit
// PRECONDITIONS: Driver initialized using 'Connect'
// PARAMETER: Message: CAN message that is to be transmitted
// RETURN VALUE: True or False for succees or error, respectively
// DESCRIPTION: Transmits a CAN message.
//
//***************************************************************************************
function TPCanDriver.Transmit( Message: TPCanMessage): boolean;
var
cnt : Byte;
msg : TPCANMsg;
msgcpy : TPCanMessage;
begin
// make sure the CAN driver is connected
if not IsConnected then
begin
Result := False; // can't transmit it not connected
exit; // no need to continue
end;
// set the message identifier
msg.ID := Message.id;
if Message.ext then
msg.MSGTYPE := MSGTYPE_EXTENDED
else
msg.MSGTYPE := MSGTYPE_STANDARD;
// set the data length
msg.LEN := Message.dlc;
// store the data bytes
for cnt :=0 to Message.dlc do
begin
msg.DATA[cnt] := Message.data[cnt];
end;
// submit the transmit request
if CAN_Write(msg) <> CAN_ERR_OK then
begin
Result := False;
exit;
end;
//---------------- process transmission confirmation --------------------------
if Assigned( FOnMessage ) then
begin
msgcpy := Message;
msgcpy.time := GetTickCount - FStartTickCnt;
FOnMessage( Self, PCanTx, msgcpy ); // call application's event handler
end;
Result := True;
end; //*** end of Transmit ***
//***************************************************************************************
// NAME: ProcessReception
// PRECONDITIONS: thread running
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Called by the CAN event tread. This function traps and processes CAN
// events for OnMessage.
//
//***************************************************************************************
procedure TPCanDriver.ProcessReception;
var
cnt : Byte;
msg : TPCanMessage;
msgraw : TPCANMsg;
begin
//---------------- process reception indication -------------------------------
// continue only if a new message is present in the queue
if CAN_Read(msgraw) <> CAN_ERR_OK then
Exit;
// only process CAN messages and not the status messages
if (msgraw.MSGTYPE = MSGTYPE_EXTENDED) or (msgraw.MSGTYPE = MSGTYPE_STANDARD) then
begin
// copy the message info
msg.time := GetTickCount - FStartTickCnt;
msg.id := msgraw.ID;
msg.dlc := msgraw.LEN;
// store the data bytes
for cnt :=0 to msg.dlc do
begin
msg.data[cnt] := msgraw.DATA[cnt];
end;
if Assigned( FOnMessage ) then
begin
FOnMessage( Self, PCanRx, msg ); // call application's event handler
end;
end;
end; //*** end of ProcessReception ***
//***************************************************************************************
// NAME: Register
// PRECONDITIONS: none
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Registers the TPCanDriver component into Borland Delphi's IDE.
//
//***************************************************************************************
procedure Register;
begin
RegisterComponents('Feaser', [TPCanDriver]);
end; //*** end of Register ***
end.
//********************************** end of PCANdrvD.pas ********************************

372
Host/Source/MicroBoot/interfaces/can/peak/Pcan_usb.pas
View File

@ -1,372 +0,0 @@
///////////////////////////////////////////////////////////////////////////////
// PCAN-Light
// PCAN_USB.pas
//
// Version 2.x
//
// ~~~~~~~~~~
//
// Definition of the PCAN-Light API.
// The Driver support a Hardware and a Software who want to communicate with CAN-busses
//
// ~~~~~~~~~~~~
//
// PCAN-Light-API
//
// ~~~~~~~~~~~~
//
// - CAN_Init(wBTR0BTR1: Word; CANMsgType: Integer)
// - CAN_Close()
// - CAN_Status()
// - CAN_Write(var MsgBuff: TPCANMsg)
// - CAN_Read(var MsgBuff: TPCANMsg)
// - CAN_ReadEx(var MsgBuff: TPCANMsg; var RcvTime: TPCANTimestamp)
// - CAN_VersionInfo(lpszTextBuff: PChar)
// - CAN_DLLVersionInfo(lpszTextBuff: PChar)
// - CAN_SpecialFunktion(distributorcode: LongWord; codenumber: Integer)
// - CAN_ResetClient()
// - CAN_MsgFilter(FromID, ToID: LongWord; _Type: Integer)
// - CAN_ResetFilter()
// - SetUSBDeviceNr(DevNum: Integer)
// - GetUSBDeviceNr(var DevNum: Integer)
// - CAN_SetRcvFunc(hEvent: THandle)
//
// ------------------------------------------------------------------
// Author : Hoppe, Wilhelm
// Modified By: Wagner (29.09.2009)
//
// Language: PASCAL OO
// ------------------------------------------------------------------
//
// Copyright (C) 1999-2009 PEAK-System Technik GmbH, Darmstadt
//
unit pcan_usb;
interface
const
// Constants definitions - Frame Type
//
CAN_INIT_TYPE_EX = $01; //Extended Frame
CAN_INIT_TYPE_ST = $00; //Standart Frame
// Constants definitions - ID
//
CAN_MAX_STANDARD_ID = $7ff;
CAN_MAX_EXTENDED_ID = $1fffffff;
// Constants definitions - CAN message types
//
MSGTYPE_STANDARD = $00; // Standard Data frame (11-bit ID)
MSGTYPE_RTR = $01; // 1, if Remote Request frame
MSGTYPE_EXTENDED = $02; // 1, if Extended Data frame (CAN 2.0B, 29-bit ID)
MSGTYPE_ERROR = $80; // 1, if Status information
// Baud rate codes = BTR0/BTR1 register values for the CAN controller.
// You can define your own Baudrate with the BTROBTR1 register !!
// take a look at www.peak-system.com for our software BAUDTOOL to
// calculate the BTROBTR1 register for every baudrate and sample point.
//
CAN_BAUD_1M = $0014; // 1 MBit/s
CAN_BAUD_500K = $001C; // 500 kBit/s
CAN_BAUD_250K = $011C; // 250 kBit/s
CAN_BAUD_125K = $031C; // 125 kBit/s
CAN_BAUD_100K = $432F; // 100 kBit/s
CAN_BAUD_50K = $472F; // 50 kBit/s
CAN_BAUD_20K = $532F; // 20 kBit/s
CAN_BAUD_10K = $672F; // 10 kBit/s
CAN_BAUD_5K = $7F7F; // 5 kBit/s
// Error codes (bit code)
//
CAN_ERR_OK = $0000; // No error
CAN_ERR_XMTFULL = $0001; // Transmit buffer in CAN controller is full
CAN_ERR_OVERRUN = $0002; // CAN controller was read too late
CAN_ERR_BUSLIGHT = $0004; // Bus error: an error counter reached the 'light' limit
CAN_ERR_BUSHEAVY = $0008; // Bus error: an error counter reached the 'heavy' limit
CAN_ERR_BUSOFF = $0010; // Bus error: the CAN controller is in bus-off state
CAN_ERR_QRCVEMPTY = $0020; // Receive queue is empty
CAN_ERR_QOVERRUN = $0040; // Receive queue was read too late
CAN_ERR_QXMTFULL = $0080; // Transmit queue ist full
CAN_ERR_REGTEST = $0100; // Test of the CAN controller hardware registers failed (no hardware found)
CAN_ERR_NOVXD = $0200; // Driver not loaded
CAN_ERR_NODRIVER = $0200; // Driver not loaded
CAN_ERRMASK_ILLHANDLE=$1C00; // Mask for all handle errors
CAN_ERR_HWINUSE = $0400; // Hardware already in use by a Net
CAN_ERR_NETINUSE = $0800; // a Client is already connected to the Net
CAN_ERR_ILLHW = $1400; // Hardware handle is invalid
CAN_ERR_ILLNET = $1800; // Net handle is invalid
CAN_ERR_ILLCLIENT = $1C00; // Client handle is invalid
CAN_ERR_RESOURCE = $2000; // Resource (FIFO, Client, timeout) cannot be created
CAN_ERR_ILLPARAMTYPE = $4000; // Invalid parameter
CAN_ERR_ILLPARAMVAL = $8000; // Invalid parameter value
CAN_ERR_UNKNOWN = $10000; // Unknown error
CAN_ERR_ANYBUSERR = (CAN_ERR_BUSLIGHT or CAN_ERR_BUSHEAVY or CAN_ERR_BUSOFF);
type
// CAN Message
//
TPCANMsg = record
ID: LongWord; // 11/29 bit identifier
MSGTYPE: Byte; // Bits from MSGTYPE_*
LEN: Byte; // Data Length Code of the Msg (0..8)
DATA: array[0..7] of Byte; // Data 0 .. 7
end;
// Timestamp of a receive/transmit event
// Total microseconds = micros + 1000 * millis + 0xFFFFFFFF * 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;
///////////////////////////////////////////////////////////////////////////////
// CAN_Init()
// This function make the following:
// - Activate a Hardware
// - Make a Register Test of 82C200/SJA1000
// - Allocate a Send buffer and a Hardware handle
// - Programs the configuration of the transmit/receive driver
// - Set the Baudrate register
// - Set the Controller in RESET condition
//
// If CANMsgType=0 ---> ID 11Bit
// If CANMsgType=1 ---> ID 11/29Bit
//
// Possible Errors: NOVXD ILLHW REGTEST RESOURCE
//
function CAN_Init(wBTR0BTR1: Word;
CANMsgType: Integer): LongWord; stdcall;
///////////////////////////////////////////////////////////////////////////////
// CAN_Close()
// This function terminate and release the configured hardware and all
// allocated resources
//
// Possible Errors: NOVXD
//
function CAN_Close: LongWord; stdcall;
///////////////////////////////////////////////////////////////////////////////
// CAN_Status()
// This function request the current status of the hardware (b.e. BUS-OFF)
//
// Possible Errors: NOVXD BUSOFF BUSHEAVY OVERRUN
//
function CAN_Status: LongWord; stdcall;
///////////////////////////////////////////////////////////////////////////////
// CAN_Write()
// This function Place a CAN message into the Transmit Queue of the CAN Hardware
//
// Possible Errors: NOVXD RESOURCE BUSOFF QXMTFULL
//
function CAN_Write(var MsgBuff: TPCANMsg): LongWord; stdcall;
///////////////////////////////////////////////////////////////////////////////
// CAN_Read()
// This function get the next message or the next error from the Receive Queue of
// the CAN Hardware.
// REMARK:
// - Check always the type of the received Message (MSGTYPE_STANDARD,MSGTYPE_RTR,
// MSGTYPE_EXTENDED,MSGTYPE_STATUS)
// - The function will return ERR_OK always that you receive a CAN message successfully
// although if the messages is a MSGTYPE_STATUS message.
// - When a MSGTYPE_STATUS mesasge is got, the ID and Length information of the message
// will be treated as indefined values. Actually information of the received message
// should be interpreted using the first 4 data bytes as follow:
// * Data0 Data1 Data2 Data3 Kind of Error
// 0x00 0x00 0x00 0x02 CAN_ERR_OVERRUN 0x0002 CAN Controller was read to late
// 0x00 0x00 0x00 0x04 CAN_ERR_BUSLIGHT 0x0004 Bus Error: An error counter limit reached (96)
// 0x00 0x00 0x00 0x08 CAN_ERR_BUSHEAVY 0x0008 Bus Error: An error counter limit reached (128)
// 0x00 0x00 0x00 0x10 CAN_ERR_BUSOFF 0x0010 Bus Error: Can Controller went "Bus-Off"
// - If a CAN_ERR_BUSOFF status message is received, the CAN Controller must to be
// initialized again using the Init() function. Otherwise, will be not possible
// to send/receive more messages.
// - The message will be written to 'msgbuff'.
//
// Possible Errors: NOVXD QRCVEMPTY
//
function CAN_Read(var MsgBuff: TPCANMsg): LongWord; stdcall;
///////////////////////////////////////////////////////////////////////////////
// CAN_ReadEx()
// This function get the next message or the next error from the Receive Queue of
// the CAN Hardware and the time when the message arrived.
// REMARK:
// - Check always the type of the received Message (MSGTYPE_STANDARD,MSGTYPE_RTR,
// MSGTYPE_EXTENDED,MSGTYPE_STATUS)
// - The function will return ERR_OK always that you receive a CAN message successfully
// although if the messages is a MSGTYPE_STATUS message.
// - When a MSGTYPE_STATUS mesasge is got, the ID and Length information of the message
// will be treated as indefined values. Actually information of the received message
// should be interpreted using the first 4 data bytes as follow:
// * Data0 Data1 Data2 Data3 Kind of Error
// 0x00 0x00 0x00 0x02 CAN_ERR_OVERRUN 0x0002 CAN Controller was read to late
// 0x00 0x00 0x00 0x04 CAN_ERR_BUSLIGHT 0x0004 Bus Error: An error counter limit reached (96)
// 0x00 0x00 0x00 0x08 CAN_ERR_BUSHEAVY 0x0008 Bus Error: An error counter limit reached (128)
// 0x00 0x00 0x00 0x10 CAN_ERR_BUSOFF 0x0010 Bus Error: Can Controller went "Bus-Off"
// - If a CAN_ERR_BUSOFF status message is received, the CAN Controller must to be
// initialized again using the Init() function. Otherwise, will be not possible
// to send/receive more messages.
// - The message will be written to 'msgbuff'.
// Since Version 2.x the Ext. Version is available - new Parameter:
// - Receive timestamp
//
// Possible Errors: NOVXD QRCVEMPTY
//
function CAN_ReadEx(
var MsgBuff: TPCANMsg;
var RcvTime: TPCANTimestamp
): LongWord; stdcall;
///////////////////////////////////////////////////////////////////////////////
// CAN_VersionInfo()
// This function get the Version and copyright of the hardware as text
// (max. 255 characters)
//
// Possible Errors: NOVXD
//
function CAN_VersionInfo(
lpszTextBuff: PChar
): LongWord; stdcall;
///////////////////////////////////////////////////////////////////////////////
// CAN_DLLVersionInfo()
// This function is used to get the Version and copyright of the DLL as
// text (max. 255 characters)
//
// Possible Errors: -1 for NULL-Pointer parameters :-)
//
function CAN_DLLVersionInfo(
lpszTextBuff: PChar
): LongWord; stdcall;
///////////////////////////////////////////////////////////////////////////////
// CAN_SpecialFunktion()
// This function is an special function to be used "ONLY" for distributors
// Return: 1 - the given parameters and the parameters in the hardware agree
// 0 - otherwise
//
// Possible Errors: NOVXD
//
function CAN_SpecialFunktion(
distributorcode: LongWord;
codenumber: Integer
): LongWord; stdcall;
//////////////////////////////////////////////////////////////////////////////
// CAN_ResetClient()
// This function delete the both queues (Transmit,Receive) of the CAN Controller
// using a RESET
//
// Possible Errors: ERR_ILLCLIENT ERR_NOVXD
//
function CAN_ResetClient: LongWord; stdcall;
///////////////////////////////////////////////////////////////////////////////
// CAN_MsgFilter(FromID, ToID, int Type)
// This function set the receive message filter of the CAN Controller.
// REMARK:
// - A quick register of all messages is possible using the parameters FromID and ToID = 0
// - Every call of this function maybe cause an extention of the receive filter of the
// CAN controller, which one can go briefly to RESET
// - New in Ver 2.x:
// * Standard frames will be put it down in the acc_mask/code as Bits 28..13
// * Hardware driver for 82C200 must to be moved to Bits 10..0 again!
// WARNING:
// It is not guaranteed to receive ONLY the registered messages.
//
// Possible Errors: NOVXD ILLCLIENT ILLNET REGTEST
//
function CAN_MsgFilter(FromID, ToID: LongWord; _Type: Integer): LongWord; stdcall;
///////////////////////////////////////////////////////////////////////////////
// CAN_ResetFilter()
// This function close completely the Message Filter of the Hardware.
// They will be no more messages received.
//
// Possible Errors: NOVXD
//
function CAN_ResetFilter: LongWord; stdcall;
//////////////////////////////////////////////////////////////////////////////
// SetUSBDeviceNr()
// This function set an identification number to the USB CAN hardware
//
// Possible Errors: NOVXD ILLHW ILLPARAMTYPE ILLPARAMVAL REGTEST
//
function SetUSBDeviceNr(DevNum: LongWord): LongWord; stdcall;
//////////////////////////////////////////////////////////////////////////////
// GetUSBDeviceNr()
// This function read the device number of a USB CAN Hardware
//
// Possible Errors: NOVXD ILLHW ILLPARAMTYPE
//
function GetUSBDeviceNr(var DevNum: LongWord): LongWord; stdcall;
///////////////////////////////////////////////////////////////////////////////
// CAN_SetRcvEvent()
// This function is used to set the Event for the Event Handler
//
// Possible Errors: ILLCLIENT ILLPARAMTYPE ILLPARAMVAL NOVXD
//
function CAN_SetRcvEvent(hEvent: LongInt): LongWord; stdcall;
implementation
uses SysUtils;
const DLL_Name = 'PCAN_USB.dll';
function CAN_Init(wBTR0BTR1: Word; CANMsgType: Integer): LongWord; stdcall;
external DLL_Name;
function CAN_Close: LongWord; stdcall;
external DLL_Name;
function CAN_Status: LongWord; stdcall;
external DLL_Name;
function CAN_Write(var MsgBuff: TPCANMsg): LongWord; stdcall;
external DLL_Name;
function CAN_Read(var MsgBuff: TPCANMsg): LongWord; stdcall;
external DLL_Name;
function CAN_ReadEx(var MsgBuff: TPCANMsg; var RcvTime: TPCANTimestamp): LongWord; stdcall;
external DLL_NAME;
function CAN_VersionInfo(lpszTextBuff: PChar): LongWord; stdcall;
external DLL_Name;
function CAN_DLLVersionInfo(lpszTextBuff: PChar): LongWord; stdcall;
external DLL_Name;
function CAN_SpecialFunktion(distributorcode: LongWord; codenumber: Integer): LongWord; stdcall;
external DLL_Name;
function CAN_ResetClient: LongWord; stdcall;
external DLL_Name;
function CAN_MsgFilter(FromID, ToID: LongWord; _Type: Integer): LongWord; stdcall;
external DLL_Name;
function CAN_ResetFilter: LongWord; stdcall;
external DLL_Name;
function SetUSBDeviceNr(DevNum: LongWord): LongWord; stdcall;
external DLL_Name;
function GetUSBDeviceNr(var DevNum: LongWord): LongWord; stdcall;
external DLL_Name;
function CAN_SetRcvEvent(hEvent: LongInt):LongWord; stdcall;
external DLL_Name;
end.

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

Binary file not shown.

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

@ -36,7 +36,7 @@ interface
//***************************************************************************************
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, ExtCtrls, IniFiles;
StdCtrls, ComCtrls, ExtCtrls, IniFiles, Vcl.Imaging.pngimage;
//***************************************************************************************
@ -60,7 +60,6 @@ type
cmbChannel: TComboBox;
lblBaudRate: TLabel;
chbExtendedId: TCheckBox;
edtBaudRate: TEdit;
lblT1: TLabel;
lblT3: TLabel;
lblT4: TLabel;
@ -83,13 +82,22 @@ type
openDialog: TOpenDialog;
edtTconnect: TEdit;
lblTconnect: TLabel;
cmbBaudrate: TComboBox;
procedure btnOKClick(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
procedure btnBrowseClick(Sender: TObject);
procedure cmbHardwareChange(Sender: TObject);
procedure edtTransmitIdChange(Sender: TObject);
procedure edtTransmitIdKeyPress(Sender: TObject; var Key: Char);
procedure edtReceiveIdKeyPress(Sender: TObject; var Key: Char);
procedure edtReceiveIdChange(Sender: TObject);
private
{ Private declarations }
procedure ValidateHexCanIdInputChange(EdtID: TEdit);
procedure ValidateHexCanIdInputPress(Sender: TObject; var Key: char);
public
{ Public declarations }
procedure SetAvailableChannels;
end;
type
@ -106,6 +114,187 @@ type
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
@ -196,6 +385,7 @@ end; //*** end of Destroy ***
function TXcpSettings.Configure : Boolean;
var
settingsIni: TIniFile;
settingsInt: Integer;
begin
// initialize the return value
result := false;
@ -207,9 +397,22 @@ begin
settingsIni := TIniFile.Create(FIniFile);
// CAN related elements
FSettingsForm.cmbHardware.ItemIndex := settingsIni.ReadInteger('can', 'hardware', 0);
FSettingsForm.cmbChannel.ItemIndex := settingsIni.ReadInteger('can', 'channel', 0);
FSettingsForm.edtBaudRate.Text := IntToStr(settingsIni.ReadInteger('can', 'baudrate', 500));
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)]);
@ -231,8 +434,9 @@ begin
// set defaults
// CAN related elements
FSettingsForm.cmbHardware.ItemIndex := 0;
FSettingsForm.SetAvailableChannels;
FSettingsForm.cmbChannel.ItemIndex := 0;
FSettingsForm.edtBaudRate.Text := IntToStr(500);
FSettingsForm.cmbBaudrate.ItemIndex := 2;
FSettingsForm.chbExtendedId.Checked := false;
FSettingsForm.edtTransmitId.Text := Format('%x',[$667]);
FSettingsForm.edtReceiveId.Text := Format('%x',[$7e1]);
@ -258,7 +462,7 @@ begin
// CAN related elements
settingsIni.WriteInteger('can', 'hardware', FSettingsForm.cmbHardware.ItemIndex);
settingsIni.WriteInteger('can', 'channel', FSettingsForm.cmbChannel.ItemIndex);
settingsIni.WriteInteger('can', 'baudrate', StrToInt(FSettingsForm.edtBaudRate.Text));
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));

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

@ -36,36 +36,35 @@ interface
// Includes
//***************************************************************************************
uses
Windows, Messages, SysUtils, Classes, Forms, IniFiles, PCANdrvD;
Windows, Messages, SysUtils, Classes, Forms, IniFiles, PCANBasic;
//***************************************************************************************
// Global Constants
//***************************************************************************************
const kMaxPacketSize = 256;
// a CAN message can only have up to 8 bytes
const kMaxPacketSize = 8;
//***************************************************************************************
// Type Definitions
//***************************************************************************************
type
TXcpTransportInfo = (kNone, kResponse, kError);
TPCANhardware = ( PCAN_PCI = $40, PCAN_USB = $50, PCAN_PCC = $60 );
type
TXcpTransport = class(TObject)
private
comEventInfo : TXcpTransportInfo;
comEvent : THandle;
packetTxId : LongWord;
packetRxId : Longword;
extendedId : Boolean;
procedure OnCanMessage(Sender: TObject; Direction: TPCanDirection; Message: TPCanMessage);
function MsgWaitForSingleObject(hHandle: THandle; dwMilliseconds: DWORD): DWORD;
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;
pcanDriver : TPCanDriver;
constructor Create;
procedure Configure(iniFile : string);
function Connect: Boolean;
@ -90,22 +89,6 @@ 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 pcan driver instance
pcanDriver := TPCanDriver.Create(nil);
// set can driver event handlers
pcanDriver.OnMessage := OnCanMessage;
// reset the packet ids
packetTxId := 0;
packetRxId := 0;
@ -115,6 +98,9 @@ begin
// reset packet length
packetLen := 0;
// disconnected by default
connected := false;
end; //*** end of Create ***
@ -127,12 +113,6 @@ end; //*** end of Create ***
//***************************************************************************************
destructor TXcpTransport.Destroy;
begin
// release can driver instance
pcanDriver.Free;
// release event handle
CloseHandle(comEvent);
// call inherited destructor
inherited;
end; //*** end of Destroy ***
@ -148,7 +128,6 @@ end; //*** end of Destroy ***
procedure TXcpTransport.Configure(iniFile : string);
var
settingsIni : TIniFile;
hwIndex : integer;
begin
// read XCP configuration from INI
if FileExists(iniFile) then
@ -156,24 +135,37 @@ 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);
// configure can hardware
hwIndex := settingsIni.ReadInteger('can', 'hardware', 0);
pcanDriver.Hardware := PCAN_USB1CH; // init to PCAN_USB1CH
case hwIndex of
0 : pcanDriver.Hardware := PCAN_USB1CH;
end;
// configure baudrate
pcanDriver.BaudRate := settingsIni.ReadInteger('can', 'baudrate', 500) * 1000;
// only 1 channel on PCAN USB 1CH
pcanDriver.Channel := pcanchannel0;
// release ini file object
settingsIni.Free;
end;
@ -188,10 +180,33 @@ end; //*** end of Configure ***
//
//***************************************************************************************
function TXcpTransport.Connect: Boolean;
var
status: TPCANStatus;
iBuffer : Integer;
begin
result := true;
if not pcanDriver.Connect then
result := false;
// 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 ***
@ -203,8 +218,21 @@ end; //*** end of Connect ***
//
//***************************************************************************************
function TXcpTransport.IsComError: Boolean;
var
status: TPCANStatus;
begin
result := pcanDriver.IsComError;
// 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 ***
@ -218,57 +246,89 @@ end; //*** end of IsComError ***
//***************************************************************************************
function TXcpTransport.SendPacket(timeOutms: LongWord): Boolean;
var
pcanmsg : TPCanMessage;
cnt : byte;
waitResult: Integer;
txMsg: TPCANMsg;
rxMsg: TPCANMsg;
byteIdx: Byte;
status: TPCANStatus;
responseReceived: Boolean;
timeoutTime: DWORD;
begin
// do not send any more data on the network when we are in bus off state.
if IsComError then
// 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
result := false;
Exit;
end;
// prepare the packet
pcanmsg.id := LongInt(PacketTxId);
pcanmsg.dlc := packetLen;
pcanmsg.ext := extendedId;
for cnt := 0 to packetLen-1 do
// 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
pcanmsg.data[cnt] := packetData[cnt];
txMsg.DATA[byteIdx] := packetData[byteIdx];
end;
// make sure the event is reset
ResetEvent(comEvent);
comEventInfo := kNone;
// submit the packet transmission request
if not pcanDriver.Transmit(pcanmsg) then
// transmit the packet via CAN
status := CAN_Write(ConstructPeakHandle(canHardware, canChannel), txMsg);
if status <> PCAN_ERROR_OK then
begin
// unable to submit tx request
result := False;
Exit;
end;
// packet is being transmitted. Now wait for the response to come in
waitResult := MsgWaitForSingleObject(comEvent, timeOutms);
// reset flag and set the reception timeout time
responseReceived := false;
timeoutTime := GetTickCount + timeOutms;
if waitResult <> WAIT_OBJECT_0 then
// 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
// no com event triggered so either a timeout or internal error occurred
result := False;
Exit;
// 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;
// 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 ***
@ -281,97 +341,28 @@ end; //*** end of SendPacket ***
//***************************************************************************************
procedure TXcpTransport.Disconnect;
begin
pcanDriver.Disconnect;
// disconnect CAN interface if connected
if connected then
begin
CAN_Uninitialize(ConstructPeakHandle(canHardware, canChannel));
end;
connected := false;
end; //*** end of Disconnect ***
//***************************************************************************************
// NAME: OnCanMessage
// PRECONDITIONS: none
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Can message event handler
// 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.
//
//***************************************************************************************
procedure TXcpTransport.OnCanMessage(Sender: TObject; Direction: TPCanDirection; Message: TPCanMessage);
var
cnt : integer;
function TXcpTransport.ConstructPeakHandle(hardware: TPCANhardware; channel: Word): TPCANHandle;
begin
// the event we are interested in is the reception of the command response from
// slave.
if Direction = PCanRx then
begin
if Message.id = LongInt(PacketRxId) then
begin
// store response data
for cnt := 0 to Message.dlc-1 do
begin
packetData[cnt] := Message.data[cnt];
end;
// store response length
packetLen := Message.dlc;
// set event flag
comEventInfo := kResponse;
// trigger the event
SetEvent(comEvent);
end;
end;
end; //*** end of OnCanMessage ***
//***************************************************************************************
// NAME: MsgWaitForSingleObject
// PRECONDITIONS: none
// 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 ***
result := Word(hardware) + channel;
end; //*** end of ConstructPeakHandle ***
end.
//******************************** end of XcpTransport.pas ******************************

35
Host/Source/MicroBoot/interfaces/can/peak/openblt_can_peak.cfg
View File

@ -1,35 +0,0 @@
-$A+
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J+
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-E../../../../../
-LNc:\borland\delphi4\Lib

88
Host/Source/MicroBoot/interfaces/can/peak/openblt_can_peak.dof
View File

@ -1,88 +0,0 @@
[Compiler]
A=1
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=1
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=../../../../../
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
[Version Info]
IncludeVerInfo=0
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1031
CodePage=1252
[Version Info Keys]
CompanyName=
FileDescription=
FileVersion=1.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=1.0.0.0
Comments=
[Excluded Packages]
$(DELPHI)\Lib\dclusr40.bpl=Borland User
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[HistoryLists\hlOutputDirectorry]
Count=3
Item0=../../../../../
Item1=../../../../
Item2=../../../

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

@ -51,9 +51,7 @@ uses
XcpLoader in '..\..\XcpLoader.pas',
XcpTransport in 'XcpTransport.pas',
XcpSettings in 'XcpSettings.pas' {XcpSettingsForm},
pcan_usb in 'Pcan_usb.pas',
PCANdrvD in 'PCANdrvD.pas';
PCANBasic in 'PCANBasic.pas';
//***************************************************************************************
// Global Constants
@ -225,7 +223,7 @@ begin
end;
// update the log
MbiCallbackOnLog(logStr);
MbiCallbackOnLog(ShortString(logStr));
// update loop variables
len := len - currentWriteCnt;
@ -259,25 +257,25 @@ begin
// connect the transport layer
MbiCallbackOnInfo('Connecting to the CAN interface.');
MbiCallbackOnLog('Connecting to the CAN interface. t='+TimeToStr(Time));
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='+TimeToStr(Time));
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='+TimeToStr(Time));
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='+TimeToStr(Time));
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;
@ -287,11 +285,11 @@ begin
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='+TimeToStr(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. not that the backdoor entry time
// 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
@ -301,17 +299,17 @@ begin
sessionStartResult := loader.StartProgrammingSession;
Application.ProcessMessages;
Sleep(5);
// if the is in reset of otherwise does not have the CAN controller synchronized to
// 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='+TimeToStr(Time));
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='+TimeToStr(Time));
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;
@ -320,7 +318,7 @@ begin
// 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='+TimeToStr(Time));
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;
@ -335,7 +333,7 @@ begin
end;
// still here so programming session was started
MbiCallbackOnLog('Programming session started. t='+TimeToStr(Time));
MbiCallbackOnLog('Programming session started. t='+ShortString(TimeToStr(Time)));
// create the datafile object
datafile := TXcpDataFile.Create(progfile);
@ -361,16 +359,16 @@ begin
datafile.GetRegionInfo(regionCnt, addr, len);
// erase the memory
MbiCallbackOnLog('Clearing Memory '+Format('addr:0x%x,len:0x%x',[addr,len])+'. t='+TimeToStr(Time));
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 ('+errorInfo+'). t='+TimeToStr(Time));
MbiCallbackOnError('Could not clear memory ('+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='+TimeToStr(Time));
MbiCallbackOnLog('Memory cleared. t='+ShortString(TimeToStr(Time)));
end;
//---------------- next program the memory regions ------------------------------------
@ -394,18 +392,18 @@ begin
if currentWriteCnt = 0 then currentWriteCnt := kMaxProgLen;
// program the data
MbiCallbackOnLog('Programming Data '+Format('addr:0x%x,len:0x%x',[addr,currentWriteCnt])+'. t='+TimeToStr(Time));
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 ('+errorInfo+'). t='+TimeToStr(Time));
MbiCallbackOnError('Could not program data ('+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='+TimeToStr(Time));
MbiCallbackOnLog('Data Programmed. t='+ShortString(TimeToStr(Time)));
// update progress
progress := progress + currentWriteCnt;
@ -417,28 +415,28 @@ begin
bufferOffset := bufferOffset + currentWriteCnt;
// update the user info
MbiCallbackOnInfo('Programming data... ' + Format('(%.1n of %.1n Kbytes)',[(progress/1024), dataSizeKB]));
MbiCallbackOnInfo('Programming data... ' + ShortString(Format('(%.1n of %.1n Kbytes)',[(progress/1024), dataSizeKB])));
end;
end;
//---------------- stop the programming session ---------------------------------------
MbiCallbackOnLog('Stopping the programming session. t='+TimeToStr(Time));
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 ('+errorInfo+'). t='+TimeToStr(Time));
MbiCallbackOnError('Could not stop the programming session ('+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='+TimeToStr(Time));
MbiCallbackOnLog('Programming session stopped. t='+ShortString(TimeToStr(Time)));
// all done so set progress to 100% and finish up
progress := datafile.GetDataCnt;
datafile.Free;
MbiCallbackOnProgress(progress);
MbiCallbackOnLog('File successfully downloaded t='+TimeToStr(Time));
MbiCallbackOnLog('File successfully downloaded t='+ShortString(TimeToStr(Time)));
MbiCallbackOnDone;
end; //*** end of OnTimeout ***
@ -502,7 +500,7 @@ begin
timer.Enabled := True;
// store the program's filename
progfile := fileName;
progfile := String(fileName);
end; //*** end of MbiStart ***
@ -520,7 +518,7 @@ begin
stopRequest := true;
// disconnect the transport layer
MbiCallbackOnLog('Disconnecting the transport layer. t='+TimeToStr(Time));
MbiCallbackOnLog('Disconnecting the transport layer. t='+ShortString(TimeToStr(Time)));
loader.Disconnect;
end; //*** end of MbiStop ***
@ -639,15 +637,15 @@ end; //*** end of MbiConfigure ***
//***************************************************************************************
exports
//--- begin of don't change ---
MbiInit index 1,
MbiStart index 2,
MbiStop index 3,
MbiDeInit index 4,
MbiName index 5,
MbiDescription index 6,
MbiVersion index 7,
MbiConfigure index 8,
MbiVInterface index 9;
MbiInit,
MbiStart,
MbiStop,
MbiDeInit,
MbiName,
MbiDescription,
MbiVersion,
MbiConfigure,
MbiVInterface;
//--- end of don't change ---
end.

120
Host/Source/MicroBoot/interfaces/can/peak/openblt_can_peak.dproj Normal file
View File

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

BIN
Host/Source/MicroBoot/interfaces/can/vector/CANIcon.bmp
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 2.4 KiB

754
Host/Source/MicroBoot/interfaces/can/vector/CANdrvD.pas
View File

@ -1,754 +0,0 @@
unit CANdrvD;
//***************************************************************************************
// Project Name: TCanDriver component for Borland Delphi
// Description: Encapsulates Vector's CANlib v4.3 into a VCL component
// File Name: CANdrvD.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, CANlibD;
//***************************************************************************************
// Type Definitions
//***************************************************************************************
type
TChannel = ( channel0, channel1 );
THardware = ( Virtual, CANcardX, CANcardXL, CANcaseXL, CANboardXL,
CANboardXL_Compact, CANac2, CANac2Pci, CANpari, CANdongle,
CANcard, CANcardY, CANcard2, EDICcard );
TDirection = ( Tx, Rx );
TCanMsg = packed record
id : LongInt;
dlc : Byte;
data : array [0..MAX_MSG_LEN-1] of Byte;
time : LongInt;
ext : Boolean;
end;
type
TMessageEvent = procedure( Sender: TObject; Direction: TDirection; Message: TCanMsg ) of object;
TErrorFrameEvent = procedure( Sender: TObject; time: LongInt ) of object;
TBusOffEvent = procedure( Sender: TObject; time: LongInt ) of object;
type
TCanEventThread = class(TThread)
private
{ Private declarations }
FMethod: TThreadMethod;
protected
FEventHndl: LongInt;
procedure Execute; override;
public
property Method : TThreadMethod read FMethod write FMethod;
property EventHandle: LongInt read FEventHndl write FEventHndl;
end;
type
TCanDriver = class(TComponent)
private
{ Private declarations }
FPortHandle : VPortHandle;
FChannelMask : Vaccess;
FPermissionMask: Vaccess;
FCanEventThread: TCanEventThread;
FThreadRunning : boolean;
FEventHandle : LongInt;
FBusOffPending : Boolean;
function IsThreadRunning: boolean;
procedure ProcessEvents;
procedure CopyMessage(event: Vevent; var msg: TCanMsg);
protected
{ Protected declarations }
FBaudRate : LongInt;
FChannel : TChannel;
FHardware : THardware;
FFilterMask : LongInt;
FFilterCode : LongInt;
FPriority : TThreadPriority;
FExtendedId : Boolean;
FOnMessage : TMessageEvent;
FOnErrorFrame: TErrorFrameEvent;
FOnBusOff : TBusOffEvent;
procedure SetBaudRate( Value: LongInt );
procedure SetChannel( Value: TChannel );
procedure SetHardware( Value: THardware );
procedure SetFilterMask( Value: LongInt );
procedure SetFilterCode( Value: LongInt );
procedure SetPriority( Value: TThreadPriority );
procedure SetExtendedId( Value: Boolean );
public
{ Public declarations }
constructor Create( AOwner: TComponent ); override;
destructor Destroy; override;
function Connect: boolean; virtual;
procedure Disconnect; virtual;
function Transmit( Message: TCanMsg): boolean; virtual;
function IsConnected: boolean; virtual;
function IsComError: boolean; virtual;
published
{ Published declarations }
property BaudRate : LongInt read FBaudRate write SetBaudRate default 500000;
property Channel : TChannel read FChannel write SetChannel default channel0;
property Hardware : THardware read FHardware write SetHardware default Virtual;
property FilterMask : LongInt read FFilterMask write SetFilterMask default 0;
property FilterCode : LongInt read FFilterCode write SetFilterCode default 0;
property Priority : TThreadPriority read FPriority write SetPriority default tpNormal;
property ExtendedId : Boolean read FExtendedId write SetExtendedId default False;
property OnMessage : TMessageEvent read FOnMessage write FOnMessage;
property OnErrorFrame: TErrorFrameEvent read FOnErrorFrame write FOnErrorFrame;
property OnBusOff : TBusOffEvent read FOnBusOff write FOnBusOff;
end;
//***************************************************************************************
// Prototypes
//***************************************************************************************
procedure Register;
implementation
//***************************************************************************************
// Constants
//***************************************************************************************
const
Channels: array[channel0..channel1] of integer = ( 0, 1 );
HardwareTypes: array[Virtual..EDICcard] of integer = (
HWTYPE_VIRTUAL, HWTYPE_CANCARDX, HWTYPE_CANCARDXL, HWTYPE_CANCASEXL, HWTYPE_CANBOARDXL,
HWTYPE_CANBOARDXL_COMPACT, HWTYPE_CANAC2, HWTYPE_CANAC2PCI, HWTYPE_CANPARI,
HWTYPE_CANDONGLE, HWTYPE_CANCARD, HWTYPE_CANCARDY, HWTYPE_CANCARD2, HWTYPE_EDICCARD);
//***************************************************************************************
// NAME: Execute
// PRECONDITIONS: none
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Overriden Execute function for the CanEventThread. Calls and synchro-
// nizes with the TCanDriver.ProcessEvents function.
//
//***************************************************************************************
procedure TCanEventThread.Execute;
begin
while not Terminated do
begin
if FEventHndl <> 0 then // make sure event is configured
begin
// wait for receive event
WaitForSingleObject(FEventHndl, 1000);
if Assigned(Method) then // make sure TCanDriver.ProcessEvents is set
Synchronize(Method); // call and synchronize
end;
end;
end; //*** end of Execute ***
//***************************************************************************************
// NAME: Create
// PRECONDITIONS: none
// 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 TCanDriver.Create( AOwner: TComponent );
begin
// call inherited constructor
inherited Create( AOwner );
// set defaults for internal variables
FPortHandle := INVALID_PORTHANDLE;
FChannelMask := 0;
FPermissionMask:= 0;
FThreadRunning := False;
FEventHandle := 0;
FBusOffPending := False;
// set defaults for properties
FBaudRate := 500000;
FChannel := channel0;
FHardware := Virtual;
FFilterMask := 0;
FFilterCode := 0;
FPriority := tpNormal;
FExtendedId := False;
end; //*** end of Create ***
//***************************************************************************************
// NAME: Destroy
// PRECONDITIONS: none
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Component destructor. Calls TComponent's destructor
//
//***************************************************************************************
destructor TCanDriver.Destroy;
begin
Disconnect; // close the port and driver
inherited Destroy; // call inherited destructor
end; //*** end of Destroy ***
//***************************************************************************************
// NAME: IsConnected
// PRECONDITIONS: none
// PARAMETER: none
// RETURN VALUE: True or False
// DESCRIPTION: Determines whether or not the CAN driver is connected and active
//
//***************************************************************************************
function TCanDriver.IsConnected: boolean;
begin
if FPortHandle <> INVALID_PORTHANDLE then
Result := True
else
Result := False;
end; //*** end of IsConnected ***
//***************************************************************************************
// NAME: IsComError
// PRECONDITIONS: none
// PARAMETER: none
// RETURN VALUE: True if the communication interface is in error state, False otherwise
// DESCRIPTION: Determines whether or not the CAN controller is in error state.
//
//***************************************************************************************
function TCanDriver.IsComError: boolean;
begin
result := FBusOffPending;
end; //*** end of IsComError ***
//***************************************************************************************
// NAME: IsThreadRunning
// PRECONDITIONS: none
// PARAMETER: none
// RETURN VALUE: True or False
// DESCRIPTION: Determines whether or not the CAN event thread is running
//
//***************************************************************************************
function TCanDriver.IsThreadRunning: boolean;
begin
if FThreadRunning = True then
Result := True
else
Result := False;
end; //*** end of IsThreadRunning ***
//***************************************************************************************
// NAME: CopyMessage
// PRECONDITIONS: none
// PARAMETER: event: msg tx or rx event information (source)
// msg: buffer to copy message to (destination)
// RETURN VALUE: none
// DESCRIPTION: Copies a CAN message from an event type to a TCanMsg type.
//
//***************************************************************************************
procedure TCanDriver.CopyMessage(event: Vevent; var msg: TCanMsg);
var
cnt: integer;
begin
if (event.msg.id and EXT_MSG) = EXT_MSG then // 29-bit id?
begin
msg.id := (event.msg.id and not EXT_MSG); // reset ext bit
msg.ext := True; // this is an 29-bit id
end
else
begin
msg.id := event.msg.id; // store id
msg.ext := False; // this is an 11-bit id
end;
msg.dlc := event.msg.dlc;
msg.time := event.timeStamp;
// copy the data bytes
for cnt :=0 to MAX_MSG_LEN-1 do
begin
if cnt < event.msg.dlc then
msg.data[cnt] := event.msg.data[cnt]
else
msg.data[cnt] := 0;
end;
end; //*** end of CopyMessage ***
//***************************************************************************************
// NAME: SetBaudRate
// PRECONDITIONS: none
// PARAMETER: Value : new baudrate value [0 - 1000000 bps]
// RETURN VALUE: none
// DESCRIPTION: Configures the baudrate
//
// |------------------------------------------------------------------------------------
// | Update baudrate configuration
// |------------------------------------------------------------------------------------
//***************************************************************************************
procedure TCanDriver.SetBaudRate( Value: LongInt );
begin
FBaudRate := Value; // update property
end; //*** end of SetBaudRate ***
//***************************************************************************************
// NAME: SetChannel
// PRECONDITIONS: none
// PARAMETER: Value : channel0 or channel1
// RETURN VALUE: none
// DESCRIPTION: Configures the used CAN channel
//
// |------------------------------------------------------------------------------------
// | Update channel configuration
// |------------------------------------------------------------------------------------
//***************************************************************************************
procedure TCanDriver.SetChannel( Value: TChannel );
begin
FChannel := Value;
end; //*** end of SetChannel ***
//***************************************************************************************
// NAME: SetHardware
// PRECONDITIONS: none
// PARAMETER: Value : type of CAN hardware (Virtual, CANcardXL, etc.)
// RETURN VALUE: none
// DESCRIPTION: Configures the used CAN hardware
//
// |------------------------------------------------------------------------------------
// | Update hardware configuration
// |------------------------------------------------------------------------------------
//***************************************************************************************
procedure TCanDriver.SetHardware( Value: THardware );
begin
FHardware := Value;
end; //*** end of SetHardware ***
//***************************************************************************************
// NAME: SetFilterMask
// PRECONDITIONS: none
// PARAMETER: Value : acceptance filter mask
// RETURN VALUE: none
// DESCRIPTION: Configures the acceptance filter mask for the CAN channel
//
// |------------------------------------------------------------------------------------
// | Update filter mask value
// |------------------------------------------------------------------------------------
//***************************************************************************************
procedure TCanDriver.SetFilterMask( Value: LongInt );
begin
FFilterMask := Value;
end; //*** end of SetFilterMask ***
//***************************************************************************************
// NAME: SetFilterCode
// PRECONDITIONS: none
// PARAMETER: Value : acceptance filter code
// RETURN VALUE: none
// DESCRIPTION: Configures the acceptance filter code for the CAN channel
//
// |------------------------------------------------------------------------------------
// | Update filter code value
// |------------------------------------------------------------------------------------
//***************************************************************************************
procedure TCanDriver.SetFilterCode( Value: LongInt );
begin
FFilterCode := Value;
end; //*** end of SetFilterCode ***
//***************************************************************************************
// NAME: SetPriority
// PRECONDITIONS: none
// PARAMETER: Value : thread priority
// RETURN VALUE: none
// DESCRIPTION: Configures the priority for the CAN event thread
//
// |------------------------------------------------------------------------------------
// | y\ Is Thread running? /n
// |------------------------------------------------------------------------------------
// | Stop Thread |
// | Update Thread priority | Update Thread priority
// | Restart Thread |
// |------------------------------------------------------------------------------------
//***************************************************************************************
procedure TCanDriver.SetPriority( Value: TThreadPriority );
begin
if IsThreadRunning then
begin
FCanEventThread.Suspend; // suspend the thread
FPriority := Value; // update the priority
FCanEventThread.Resume; // resume the thread
end
else
begin
FPriority := Value; // update the priority
end;
end; //*** end of SetPriority ***
//***************************************************************************************
// NAME: SetExtendedId
// PRECONDITIONS: none
// PARAMETER: Value : true = support only 29-bit id's, false = support only 11-bit
// RETURN VALUE: none
// DESCRIPTION: Configures the support of extended 29-bit identifiers
//
// |------------------------------------------------------------------------------------
// | Update extended id support selection
// |------------------------------------------------------------------------------------
//***************************************************************************************
procedure TCanDriver.SetExtendedId( Value: Boolean );
begin
FExtendedId := Value;
end; //*** end of SetExtendedId ***/
//***************************************************************************************
// NAME: Connect
// PRECONDITIONS: Disconnected from CAN bus
// PARAMETER: none
// RETURN VALUE: True or False for succees or error, respectively
// DESCRIPTION: Initializes the CAN driver and synchronizes the hardware with the CAN
// bus.
//
// |------------------------------------------------------------------------------------
// | y\ Connected? /n
// |------------------------------------------------------------------------------------
// | Open the driver (ncdOpenDriver)
// | Obtain mask to channel (ncdGetChannelMask)
// | Open the port using this mask (ncdOpenPort)
// |------------------------------------------------------------------------------------
// | y\ Permission to change settings? /n
// |------------------------------------------------------------------------------------
// | Configure baudrate (ncdSetChannelBitrate) |
// |------------------------------------------------------------------------------------
// | Configure acceptance filter (ncdSetChannelAcceptance)
// | Enable error frames and chipstate events (ncdSetReceiveMode)
// | Create synchronizatio object (ncdSetNotification)
// | Reset internal clock (ncdResetClock)
// | Sync to the CAN bus (ncdActivateChannel)
// | Empty transmit and receive queue's (ncdFlushXxxQueue)
// |------------------------------------------------------------------------------------
// | y\ Errors occurred during init? /n
// |------------------------------------------------------------------------------------
// | y\ Port opened? /n |
// |-------------------------------------------------------------| Start CAN event thread
// | Close port (ncdClosePort) | | Return TRUE
// |-------------------------------------------------------------|
// | Return FALSE |
// |------------------------------------------------------------------------------------
//***************************************************************************************
function TCanDriver.Connect: boolean;
var
vErr : Vstatus;
acc : VsetAcceptance;
label
error;
begin
// reset internal variables
FPortHandle := INVALID_PORTHANDLE;
FChannelMask := 0;
FPermissionMask:= 0;
FThreadRunning := False;
FEventHandle := 0;
FBusOffPending := False;
//-------------------------- open the driver ------------------------------------------
vErr := ncdOpenDriver;
if vErr <> VSUCCESS then goto error;
//-------------------------- select a channel -----------------------------------------
FChannelMask := ncdGetChannelMask(HardwareTypes[FHardware], 0, Channels[FChannel]);
if FChannelMask=0 then goto error;
//-------------------------- open a port ----------------------------------------------
FPermissionMask := FChannelMask;
vErr := ncdOpenPort(FPortHandle, 'TCanDriver0', FChannelMask, FPermissionMask,
FPermissionMask, 1024);
if vErr <> VSUCCESS then goto error;
//-------------------------- set baudrate ---------------------------------------------
if FPermissionMask<>0 then
begin
vErr := ncdSetChannelBitrate(FPortHandle, FPermissionMask, FBaudRate);
if vErr <> VSUCCESS then goto error;
end;
//-------------------------- set the acceptance filter --------------------------------
acc.mask := FFilterMask;
acc.code := FFilterCode;
if FExtendedId = True then // 29-bit id used?
begin
acc.mask := acc.mask or LongInt(EXT_MSG);
acc.code := acc.code or LongInt(EXT_MSG);
end;
vErr := ncdSetChannelAcceptance(FPortHandle, FChannelMask, acc);
if vErr <> VSUCCESS then goto error;
//-------------------------- enable error frames and chipstate events -----------------
vErr := ncdSetReceiveMode(FPortHandle, 0, 0);
if vErr <> VSUCCESS then goto error;
//-------------------------- create synchronisation object ----------------------------
FEventHandle := CreateEvent(nil, FALSE, FALSE, nil);
if FEventHandle = 0 then goto error;
vErr := ncdSetNotification(FPortHandle, FEventHandle, 1);
if vErr<>VSUCCESS then goto error;
//-------------------------- reset the clock ------------------------------------------
vErr := ncdResetClock(FPortHandle);
if vErr <> VSUCCESS then goto error;
//-------------------------- sync with bus --------------------------------------------
vErr := ncdActivateChannel(FPortHandle, FChannelMask);
if vErr <> VSUCCESS then goto error;
//-------------------------- flush queue's --------------------------------------------
vErr := ncdFlushReceiveQueue(FPortHandle);
if vErr <> VSUCCESS then goto error;
vErr := ncdFlushTransmitQueue(FPortHandle, FChannelMask);
if vErr <> VSUCCESS then goto error;
//-------------------------- start CAN event thread -----------------------------------
FCanEventThread := TCanEventThread.Create(True); // create and suspend
FCanEventThread.FreeOnTerminate := True; // auto free on termination
FCanEventThread.Method := ProcessEvents; // set method
FCanEventThread.FEventHndl := FEventHandle; // set event handle
FCanEventThread.Resume; // start
FThreadRunning := True;
//-------------------------- success --------------------------------------------------
Result := True; // successfully initialized the driver
exit; // stop here
//-------------------------- error occurred -------------------------------------------
error:
if FEventHandle <> 0 then
CloseHandle(FEventHandle);
if FPortHandle <> INVALID_PORTHANDLE then
begin
ncdClosePort(FPortHandle);
FPortHandle := INVALID_PORTHANDLE;
end;
Result := False;
end; //*** end of Connect ***
//***************************************************************************************
// NAME: Disconnect
// PRECONDITIONS: none
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Disconnects the CAN driver
//
// |------------------------------------------------------------------------------------
// | y\ Connected? /n
// |------------------------------------------------------------------------------------
// | Deactivate the channel (ncdDeactivateChannel) |
// | Close port (ncdClosePort) |
// |------------------------------------------------------------------------------------
// | Close the driver (ncdCloseDriver)
// |------------------------------------------------------------------------------------
// | y\ CAN event thread active? /n
// |------------------------------------------------------------------------------------
// | Stop CAN event thread |
// |------------------------------------------------------------------------------------
//***************************************************************************************
procedure TCanDriver.Disconnect;
begin
if IsConnected = True then begin // are we connected?
ncdDeactivateChannel(FPortHandle, FChannelMask); // deactivate channel
if FEventHandle <> 0 then
CloseHandle(FEventHandle);
ncdClosePort(FPortHandle); // close the port
FPortHandle := INVALID_PORTHANDLE; // invalidate handle
end;
ncdCloseDriver; // close the driver
if IsThreadRunning then
begin
FCanEventThread.FEventHndl := 0; // reset event handle
FCanEventThread.Terminate; // stop
FThreadRunning := False;
end;
end; //*** end of Disconnect ***
//***************************************************************************************
// NAME: Transmit
// PRECONDITIONS: Driver initialized using 'Connect'
// PARAMETER: Message: CAN message that is to be transmitted
// RETURN VALUE: True or False for succees or error, respectively
// DESCRIPTION: Transmits a CAN message.
//
// |------------------------------------------------------------------------------------
// | y\ Connected? /n
// |------------------------------------------------------------------------------------
// | Transmit message using ncdTransmit |
// |----------------------------------------------| Return FALSE
// | Return TRUE |
// |------------------------------------------------------------------------------------
//***************************************************************************************
function TCanDriver.Transmit( Message: TCanMsg): boolean;
var
vErr : Vstatus;
event : Vevent;
cnt : integer;
begin
// make sure the CAN driver is connected
if not IsConnected then
begin
Result := False; // can't transmit it not connected
exit; // no need to continue
end;
// configure message as tx with acknowledge
event.tag := V_TRANSMIT_MSG;
event.msg.flags := MSGFLAG_TX;
// set the message identifier
if Message.ext = True then
event.msg.id := Message.id or LongInt(EXT_MSG)
else
event.msg.id := Message.id;
// set the data length
event.msg.dlc := Message.dlc;
// store the data bytes
for cnt :=0 to MAX_MSG_LEN-1 do
begin
event.msg.data[cnt] := Message.data[cnt];
end;
vErr := ncdTransmit(FPortHandle, FChannelMask, event);
if vErr <> VSUCCESS then
Result := False
else
Result := True;
end; //*** end of Transmit ***
//***************************************************************************************
// NAME: ProcessEvents
// PRECONDITIONS: thread running
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Called by the CAN event tread. This function traps and processes CAN
// events for OnMessage, OnBusOff, and OnErrorFrame.
//
//***************************************************************************************
procedure TCanDriver.ProcessEvents;
var
vErr : Vstatus;
pEvent : PVEvent;
msg : TCanMsg;
begin
while True do
begin
vErr := ncdReceive1(FPortHandle, pEvent);
if (vErr<>VSUCCESS) and (vErr<>VERR_QUEUE_IS_EMPTY) then break;
if vErr=VERR_QUEUE_IS_EMPTY then break;
case pEvent^.tag of
V_RECEIVE_MSG, V_TRANSMIT_MSG:
begin
if (pEvent^.msg.flags and MSGFLAG_ERROR_FRAME) = MSGFLAG_ERROR_FRAME then
begin
//---------------- process errorframe -----------------------------------------
if Assigned( FOnErrorFrame ) then
begin
FOnErrorFrame( Self, pEvent^.timeStamp ); // call application's event handler
end;
end
else if pEvent^.msg.flags = 0 then // msg rx indication
begin
//---------------- process reception indication -------------------------------
CopyMessage(pEvent^, msg);
if Assigned( FOnMessage ) then
begin
FOnMessage( Self, Rx, msg ); // call application's event handler
end;
end
else if (pEvent^.msg.flags and MSGFLAG_TX) = MSGFLAG_TX then // msg tx confirmation
begin
//---------------- process transmission confirmation --------------------------
CopyMessage(pEvent^, msg);
if Assigned( FOnMessage ) then
begin
FOnMessage( Self, Tx, msg ); // call application's event handler
end;
end;
end;
V_CHIP_STATE:
begin
if (pEvent^.chipState.busStatus and CHIPSTAT_BUSOFF) = CHIPSTAT_BUSOFF then
begin
//---------------- process bus off event --------------------------------------
FBusOffPending := True;
if Assigned( FOnBusOff ) then
begin
FOnBusOff( Self, pEvent^.timeStamp ); // call application's event handler
end;
end;
end;
end;
end;
end; //*** end of ProcessEvents ***
//***************************************************************************************
// NAME: Register
// PRECONDITIONS: none
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Registers the TCanDriver component into Borland Delphi's IDE.
//
//***************************************************************************************
procedure Register;
begin
RegisterComponents('Feaser', [TCanDriver]);
end; //*** end of Register ***
end.
//********************************** end of CANdrvD.pas *********************************

959
Host/Source/MicroBoot/interfaces/can/vector/CANlibD.pas
View File

@ -1,959 +0,0 @@
unit CANlibD;
(*----------------------------------------------------------------------------
| File:
| CANlibD.pas
| Project:
| Unit for Delphi32 samples (V2.0)
|
|-----------------------------------------------------------------------------
| Ported from cantrace.c by Torsten Lang
|-----------------------------------------------------------------------------
| Copyright (c) 1998 BSK Datentechnik GmbH, Kiesacker 14, 35418 Buseck /
| 1998 by Vector Informatik GmbH, Friolzheimer Str. 6, 70499 Stuttgart
| All rights reserved.
|
| BSK Datentechnik räumt der Vector Informatik GmbH das nicht ausschließliche Recht
| ein, CANlibD.pas für eigene Zwecke zu nutzen. Vector ist es gestattet, die
| Software zu kopieren, abzuändern, zu erweitern, weiterzugeben und in Software von
| Vector zu integrieren. Im Quelltext enthaltene Copyright-Hinweise dürfen hierbei
| nicht entfernt oder geändert werden.
| Vector darf aus von ihm vorgenommenen Anpassungen und/oder Erweiterungen der
| CANlibD.pas keine Rechte an irgendwelchen Teilen der Software gegenüber BSK
| Datentechnik geltend machen.
----------------------------------------------------------------------------*)
{ environment switches }
(*******************************************************************************
Attention:
1. All functions that use pointers to structures (either explicitly or by using
var parameters) may change the contents of the structures right after the
funtction returns.
*******************************************************************************)
{$ifdef WIN32}
{$define CanLib4Delphi32}
{$else}
{$ifdef CONSOLE}
{$define CanLib4Delphi32}
{$endif}
{$endif}
{ public interface }
interface
type
ncdStringType = PChar;
Vstatus = Word;
const
MAX_APPNAME = 32;
VCAN_WAIT = 0;
VCAN_POLL = 1;
{$ifdef CanLib4Delphi32}
{ Attention: This exists only under Win32 }
VCAN_NOTIFY = 2;
{$endif}
VSUCCESS = 0;
VPENDING = 1;
VERROR = 255;
VERR_QUEUE_IS_EMPTY = 10;
VERR_QUEUE_IS_FULL = 11;
VERR_TX_NOT_POSSIBLE = 12;
VERR_NO_LICENSE = 14;
VERR_WRONG_PARAMETER = 101;
VERR_TWICE_REGISTER = 110;
VERR_INVALID_CHAN_INDEX = 111;
VERR_INVALID_ACCESS = 112;
VERR_PORT_IS_OFFLINE = 113;
VERR_CHAN_IS_ONLINE = 116;
VERR_INVALID_PORT = 118;
VERR_HW_NOT_READY = 120;
VERR_CMD_TIMEOUT = 121;
VERR_HW_NOT_PRESENT = 129;
VERR_NOTIFY_ALREADY_ACTIVE = 131;
VERR_CANNOT_OPEN_DRIVER = 201;
{
//------------------------------------------------------------------------------
// accessmask
}
type
Vaccess = LongInt; { unsigned long doesn't exist for Delphi32 / Borland Pascal 7! }
{
//------------------------------------------------------------------------------
// porthandle
}
const
INVALID_PORTHANDLE = -1;
type
VportHandle = LongInt;
{
//------------------------------------------------------------------------------
// acceptance filter
}
type
VsetAcceptance = packed record
code : LongInt; {unsigned long doesn't exist!}
mask : LongInt; {unsigned long doesn't exist!}
end;
PVsetAcceptance = ^VsetAcceptance;
{
//------------------------------------------------------------------------------
// bit timing
}
type
VchipParams = packed record
bitRate : LongInt; {unsigned long doesn't exist!}
sjw : Byte;
tseg1 : Byte;
tseg2 : Byte;
sam : Byte; { 1 or 3 }
end;
PVchipParams = ^VchipParams;
{
//------------------------------------------------------------------------------
// definitions for the events and commands used by the driver
}
const
V_RECEIVE_MSG = 1;
V_CHIP_STATE = 4;
V_CLOCK_OVERFLOW = 5;
V_TRIGGER = 6;
V_TIMER = 8;
V_TRANSCEIVER = 9;
V_TRANSMIT_MSG = 10;
type
VeventTag = Byte;
{
//------------------------------------------------------------------------------
// events
}
{
//------------------------------------------------------------------------------
// structure for V_RECEIVE_MSG
}
const
MAX_MSG_LEN = 8;
EXT_MSG = $80000000; { signs an extended identifier }
MSGFLAG_ERROR_FRAME = $01; { Msg is a bus error }
MSGFLAG_OVERRUN = $02; { Msgs following this has been lost }
MSGFLAG_NERR = $04; { NERR active during this msg }
MSGFLAG_WAKEUP = $08; { Msg rcv'd in wakeup mode }
MSGFLAG_REMOTE_FRAME = $10; { Msg is a remote frame }
MSGFLAG_RESERVED_1 = $20; { Reserved for future usage }
MSGFLAG_TX = $40; { TX acknowledge }
MSGFLAG_TXRQ = $80; { TX request }
type
_Vmsg = packed record
id : LongInt; {unsigned long doesn't exist!}
flags : Byte;
dlc : Byte;
data : array [0..MAX_MSG_LEN-1] of Byte;
end; { 14 Bytes }
_PVmsg = ^_Vmsg;
{
// structure for V_CHIP_STATE
}
const
CHIPSTAT_BUSOFF = $01;
CHIPSTAT_ERROR_PASSIVE = $02;
CHIPSTAT_ERROR_WARNING = $04;
CHIPSTAT_ERROR_ACTIVE = $08;
type
_VchipState = packed record
busStatus : Byte;
txErrorCounter : Byte;
rxErrorCounter : Byte;
end;
_PVchipState = ^_VchipState;
{
// structure for V_TRANSCEIVER
}
const
TRANSCEIVER_EVENT_ERROR = 1;
TRANSCEIVER_EVENT_CHANGED = 2;
TRANSCEIVER_TYPE_NONE = 0;
TRANSCEIVER_TYPE_251 = 1;
TRANSCEIVER_TYPE_252 = 2;
TRANSCEIVER_TYPE_DNOPTO = 3;
TRANSCEIVER_TYPE_W210 = 4;
TRANSCEIVER_LINEMODE_NA = 0;
TRANSCEIVER_LINEMODE_TWO_LINE = 1;
TRANSCEIVER_LINEMODE_CAN_H = 2;
TRANSCEIVER_LINEMODE_CAN_L = 3;
TRANSCEIVER_RESNET_NA = 0;
TRANSCEIVER_RESNET_MASTER = 1;
TRANSCEIVER_RESNET_MASTER_STBY = 2;
TRANSCEIVER_RESNET_SLAVE = 3;
type
_Vtransceiver = packed record
event : Byte; { TRANSCEIVER_EVENT_xxx }
end;
_PVtransceiver = ^_Vtransceiver;
Vevent = packed record
tag : VeventTag; { 1 }
chanIndex : Byte; { 1 }
_transId : Byte; { 1 not implemented yet !!!! }
portHandle : Byte; { 1 internal use only !!!! }
timeStamp : LongInt; { 4 } { unsigned long doesn't exist! }
case {tagData:}Byte of
0 : (msg : _Vmsg);
1 : (chipState : _VchipState);
2 : (transceiver : _Vtransceiver);
{ 14 Bytes (_VMessage) }
end;
{ -------- }
{ 22 Bytes }
PVevent = ^Vevent;
{
//------------------------------------------------------------------------------
// structure for SET_OUTPUT_MODE
}
const
OUTPUT_MODE_SILENT = 0;
OUTPUT_MODE_NORMAL = 1;
{
//------------------------------------------------------------------------------
// configuration
}
{
// defines for the supported hardware
}
const
HWTYPE_NONE = 0;
HWTYPE_VIRTUAL = 1;
HWTYPE_CANCARDX = 2;
HWTYPE_CANPARI = 3;
HWTYPE_CANDONGLE = 4;
HWTYPE_CANAC2 = 5;
HWTYPE_CANAC2PCI = 6;
HWTYPE_CANCARD = 7;
HWTYPE_CANCARDY = 12;
HWTYPE_CANCARDXL = 15;
HWTYPE_CANCARD2 = 17;
HWTYPE_EDICCARD = 19;
HWTYPE_CANCASEXL = 21;
HWTYPE_CANBOARDXL = 25;
HWTYPE_CANBOARDXL_COMPACT = 27;
MAX_HWTYPE = 27;
{
// defines for the tranceiver type
}
const
(*
TRANSCEIVER_TYPE_NONE = 0;
TRANSCEIVER_TYPE_251 = 1;
TRANSCEIVER_TYPE_252 = 2;
TRANSCEIVER_TYPE_DNOPTO = 3;
TRANSCEIVER_TYPE_W210 = 4;
*) { These have already been defined above }
MAX_TRANSCEIVER_TYPE = 4;
MAX_CHAN_NAME = 31;
MAX_DRIVER_NAME = 31;
type
VChannelConfig = packed record
name : array [0..MAX_CHAN_NAME] of Char;
hwType : Byte; { HWTYPE_xxxx (see above) }
hwIndex : Byte; { Index of the hardware (same type) (0,1,...) }
hwChannel : Byte; { Index of the channel (same hardware) (0,1,...) }
tranceiverType : Byte; { TRANCEIVER_TYPE_xxxx (see above) }
channelIndex : Byte; { Global channel index (0,1,...) }
channelMask : LongInt; { Global channel mask (=1<<channelIndex) }
{ Sorry, no unsigned long here! }
{
// Channel
}
isOnBus : Byte; { The channel is on bus }
chipParams : VchipParams; { Actual bittiming }
outputMode : Byte; { Actual output mode }
flags : Byte; { Actual options MSGFLAG_TX,MSGFLAG_TXRQ }
end;
PVChannelConfig = ^VChannelConfig;
VDriverConfig = packed record
driverName : array [0..MAX_DRIVER_NAME] of Char;
driverVersion : Word;
dispatcher : Pointer;
channelCount : Byte; { total number of channels }
channel : array [0..0] of VChannelConfig;
{ [channelCount] }
end;
PVDriverConfig = ^VDriverConfig;
function ncdOpenDriver : Vstatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdGetDriverConfig (var pChanCount : LongInt;
pDriverConfig : PVDriverConfig) : Vstatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdGetChannelIndex (hwType : LongInt; hwIndex : LongInt;
hwChannel : LongInt) : LongInt;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdGetChannelMask (hwType : LongInt; hwIndex : LongInt;
hwChannel : LongInt) : Vaccess;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdOpenPort (var portHandle : VportHandle; userName : PChar;
accessMask : Vaccess; initMask : Vaccess;
var permissionMask : Vaccess;
rxQueueSize : LongInt) : Vstatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdSetChannelMode (portHandle : VportHandle; accessMask : Vaccess;
tx, txrq : LongInt) : Vstatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdSetChannelOutput (portHandle : VportHandle; accessMask : Vaccess;
mode : LongInt) : Vstatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdSetChannelTransceiver(portHandle : VportHandle; accessMask : Vaccess;
typ : LongInt; lineMode : LongInt; resNet : LongInt) : Vstatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdSetChannelParams (portHandle : VportHandle; accessMask : Vaccess;
var pChipParams : VchipParams) : Vstatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdSetChannelParamsC200(portHandle : VportHandle; accessMask : Vaccess;
btr0, btr1 : Byte) : Vstatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdSetChannelBitrate (portHandle : VportHandle; accessMask : Vaccess;
bitrate : LongInt) : Vstatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdSetChannelAcceptance(portHandle : VportHandle; accessMask : Vaccess;
var filter : VsetAcceptance) : Vstatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdSetTimerRate (portHandle : VportHandle; timerRate : LongInt) : Vstatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdResetClock (portHandle : VportHandle) : Vstatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
{$ifdef CanLib4Delphi32}
function ncdSetNotification (portHandle : VportHandle; var handle : LongInt;
queueLevel : LongInt) : Vstatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
{$endif}
function ncdTransmit (portHandle : VportHandle; accessMask : Vaccess;
var pEvent : Vevent) : Vstatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdReceive1 (portHandle : VportHandle; var ppEvent : PVevent) : Vstatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
{$ifdef CanLib4Delphi32}
{ Attention: This function works only under Win32! }
function ncdReceive (portHandle : VportHandle; receiveMode : LongInt;
waitHandle : Word; var pEventCount : LongInt;
var pEventList : Vevent) : Vstatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
{$endif}
function ncdRequestChipState (portHandle : VportHandle; accessMask : Vaccess) : Vstatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdFlushTransmitQueue (portHandle : VportHandle; accessMask : Vaccess) : Vstatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdFlushReceiveQueue (portHandle : VportHandle) : Vstatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdGetReceiveQueueLevel(portHandle : VportHandle; var level : LongInt) : Vstatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdGetState (portHandle : VportHandle) : Vstatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdActivateChannel (portHandle : VportHandle; accessMask : Vaccess) : Vstatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdDeactivateChannel (portHandle : VportHandle; accessMask : Vaccess) : Vstatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdClosePort (portHandle : VportHandle) : Vstatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdCloseDriver : VStatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdGetErrorString (err : Vstatus) : ncdStringType;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdGetEventString (var ev : Vevent) : ncdStringType;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdGetApplConfig (appName : PChar; appChannel : LongInt;
var hwType : LongInt; var hwIndex : LongInt;
var hwChannel : LongInt ) : VStatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdSetApplConfig (appName : PChar; appChannel : LongInt;
hwType : LongInt; hwIndex : LongInt;
hwChannel : LongInt ) : VStatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdGetChannelVersion (ChannelIndex : LongInt; var FwVersion : LongInt;
var HwVersion : LongInt; var SerialNumber : LongInt ) : VStatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdSetReceiveMode (Port : VportHandle; ErrorFrame : Byte;
ChipState : Byte ) : VStatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdAddAcceptanceRange (Port : VportHandle; accessMask : Vaccess;
first_id : LongInt; last_id : LongInt ) : Vstatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdRemoveAcceptanceRange(Port : VportHandle; accessMask : Vaccess;
first_id : LongInt; last_id : LongInt ) : Vstatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function ncdResetAcceptance (Port : VportHandle; accessMask : Vaccess;
extended : LongInt ) : Vstatus;
{$ifdef CanLib4Delphi32} stdcall {$else} far {$endif};
function CHANNEL_MASK (val : Byte) : LongInt;
{$ifndef CanLib4Delphi32} far; {$endif}
function SIZEOF_VDRIVERCONFIG (n : Byte) : LongInt;
{$ifndef CanLib4Delphi32} far; {$endif}
implementation
const
{$ifdef CanLib4Delphi32}
OrdinalOffset = 0;
DLL_Name = 'VCanD32.DLL'; { '.DLL' seems to be NOT added by NT when not searching in the }
{$else} { actual directory. === }
OrdinalOffset = 1;
DLL_Name = 'VCAND16';
{$endif}
(*******************************************************************
ncdOpenDriver():
The Application calls this function to get access to the driver.
*)
//function ncdOpenDriver : Vstatus; external DLL_Name index 1+OrdinalOffset;
function ncdOpenDriver : Vstatus; external DLL_Name name 'ncdOpenDriver';
(********************************************************************
ncdGetDriverConfig():
The application gets the information, which
CAN channels are available in the system. The user
must provide the memory, pChanCount is pointing to
and the size of pDriverConfig. Passing NULL
for pDriverConfig only the ChanCount is given back.
Attention: We use a pointer instead of a var for the second parameter
since we need the possibility to pass a nil pointer here.
*)
function ncdGetDriverConfig
(
var pChanCount : LongInt;
pDriverConfig : PVDriverConfig
) : Vstatus; external DLL_Name name 'ncdGetDriverConfig';
(********************************************************************
ncdGetChannelIndex():
ncdGetChannelMask():
Get the channel index for a channel of a certain hardware.
Parameter -1 means "don't care"
Result -1 (ncdGetChannelIndex) or 0 (ncdGetChannelMask) means "not found"
*)
function ncdGetChannelIndex
(
hwType : LongInt; { [-1,HWTYPE_CANCARDX,HWTYPE_VIRTUAL,...] }
hwIndex : LongInt; { [-1,0,1] }
hwChannel : LongInt { [-1,0,1] }
) : LongInt; external DLL_Name name 'ncdGetChannelIndex';
function ncdGetChannelMask
(
hwType : LongInt; { [-1,HWTYPE_CANCARDX,HWTYPE_VIRTUAL,...] }
hwIndex : LongInt; { [-1,0,1] }
hwChannel : LongInt { [-1,0,1] }
) : Vaccess; external DLL_Name name 'ncdGetChannelMask';
(********************************************************************
ncdOpenPort():
The application tells the driver to which channels
it wants to get access to and which of these channels
it wants to get the permission to initialize the channel.
Only one port can get the permission to initialize a channel.
The permitted init access is returned.
*)
function ncdOpenPort
(
var portHandle : VportHandle;
userName : PChar;
accessMask : Vaccess;
initMask : Vaccess;
var permissionMask : Vaccess;
rxQueueSize : LongInt
) : Vstatus; external DLL_Name name 'ncdOpenPort';
(********************************************************************
ncdSetChannelMode():
For the CAN channels defined by AccessMask is set
whether the caller will get a TX and/or a TXRQ
receipt for transmitted messages.
The port must have init access to the channels.
*)
function ncdSetChannelMode
(
portHandle : VportHandle;
accessMask : Vaccess;
tx, txrq : LongInt
) : Vstatus; external DLL_Name name 'ncdSetChannelMode';
(********************************************************************
ncdSetChannelOutput():
The output mode for the CAN chips of the channels defined by accessMask, is set
to OUTPUT_MODE_NORMAL or OUTPUT_MODE_SILENT.
The port must have init access to the channels.
*)
function ncdSetChannelOutput
(
portHandle : VportHandle;
accessMask : Vaccess;
mode : LongInt
) : Vstatus; external DLL_Name name 'ncdSetChannelOutput';
(********************************************************************
ncdSetChannelTransceiver():
The transceiver mode for the channels defined by accessMask, is set.
The port must have init access to the channels.
*)
function ncdSetChannelTransceiver
(
portHandle : VportHandle;
accessMask : Vaccess;
typ : LongInt;
lineMode : LongInt;
resNet : LongInt
) : Vstatus; external DLL_Name name 'ncdSetChannelTransceiver';
(********************************************************************
ncdSetChannelParams():
ncdSetChannelParamsC200():
ncdSetChannelBitrate():
The channels defined by accessMask will be initialized with the
given parameters.
The port must have init access to the channels.
*)
function ncdSetChannelParams
(
portHandle : VportHandle;
accessMask : Vaccess;
var pChipParams : VchipParams
) : Vstatus; external DLL_Name name 'ncdSetChannelParams';
function ncdSetChannelParamsC200
(
portHandle : VportHandle;
accessMask : Vaccess;
btr0, btr1 : Byte
) : Vstatus; external DLL_Name name 'ncdSetChannelParamsC200';
function ncdSetChannelBitrate
(
portHandle : VportHandle;
accessMask : Vaccess;
bitrate : LongInt { unsigned long doesn't exist! }
) : Vstatus; external DLL_Name name 'ncdSetChannelBitrate';
(********************************************************************
ncdSetAcceptance():
Set the acceptance filter
Filters for std and ext ids are handled independant in the driver.
Use mask=0xFFFF,code=0xFFFF or mask=0xFFFFFFFF,code=0xFFFFFFFF to fully close
the filter.
*)
function ncdSetChannelAcceptance
(
portHandle : VportHandle;
accessMask : Vaccess;
var filter : VsetAcceptance
) : Vstatus; external DLL_Name name 'ncdSetChannelAcceptance';
(********************************************************************
ncdSetTimerRate():
The timer of the port will be activated/deacticated and the
rate for cyclic timer events is set (10us resolution).
*)
function ncdSetTimerRate
(
portHandle : VportHandle;
timerRate : LongInt { unsigned long gibt's hier leider nicht! }
) : Vstatus; external DLL_Name name 'ncdSetTimerRate';
(********************************************************************
ncdResetClock():
The clock generating timestamps for the port will be reset
*)
function ncdResetClock
(
portHandle : VportHandle
) : Vstatus; external DLL_Name name 'ncdResetClock';
(********************************************************************
ncdSetNotification():
Setup a event to notify the application if there are messages in the
ports receive queue.
queueLevel specifies the number of messages that triggeres the event.
Note that the event is triggered only once, when the queueLevel is
reached. An application should read all available messages by ncdReceive
to be sure to reenable the event.
Attention: This function doesn't work in 16 bit environments so we
disable it here!
*)
{$ifdef CanLib4Delphi32}
function ncdSetNotification
(
portHandle : VportHandle;
var handle : LongInt; { unsigned long gibt's hier leider nicht! }
queueLevel : LongInt
) : Vstatus; external DLL_Name name 'ncdSetNotification';
{$endif}
(********************************************************************
ncdTransmit():
A CAN message will be put to the designated channels to be transmitted.
*)
function ncdTransmit
(
portHandle : VportHandle;
accessMask : Vaccess;
var pEvent : Vevent
) : Vstatus; external DLL_Name name 'ncdTransmit';
(********************************************************************
ncdReceive1():
The driver is asked to retrieve a single Events from the
application's receive queue. This function is optimized
for speed. It returns a pointer to the received event.
Lifetime of the data is until the next call of ncdReceive1.
It returns VERR_QUEUE_IS_EMPTY and *ppEvent=NULL if no event
is available.
*)
function ncdReceive1
(
portHandle : VportHandle;
var ppEvent : PVevent
) : Vstatus; external DLL_Name name 'ncdReceive1';
(********************************************************************
ncdReceive():
The driver is asked to retrieve Events from the
application's receive queue. You can choose wether
it will be polled or waited for an incoming event.
Its possible to read multiple events at a time, but the
caller must provide the memory. In pEventCount the actual
number of received events will be returned.
Attention: This function doesn't work in 16 bit environments so we
disable it here!
*)
{$ifdef CanLib4Delphi32}
function ncdReceive
(
portHandle : VportHandle;
receiveMode : LongInt;
waitHandle : Word;
var pEventCount : LongInt;
var pEventList : Vevent
) : Vstatus; external DLL_Name name 'ncdReceive';
{$endif}
(********************************************************************
ncdRequestChipState():
The state of the selected channels is requested.
The answer will be received as an event (V_CHIP_STATE).
*)
function ncdRequestChipState
(
portHandle : VportHandle;
accessMask : Vaccess
) : Vstatus; external DLL_Name name 'ncdRequestChipState';
(********************************************************************
ncdFlushTransmitQueue():
The transmit queue of the selected channel will be flushed.
*)
function ncdFlushTransmitQueue
(
portHandle : VportHandle;
accessMask : Vaccess
) : Vstatus; external DLL_Name name 'ncdFlushTransmitQueue';
(********************************************************************
ncdFlushReceiveQueue():
The receive queue of the port will be flushed.
*)
function ncdFlushReceiveQueue
(
portHandle : VportHandle
) : Vstatus; external DLL_Name name 'ncdFlushReceiveQueue';
(********************************************************************
ncdGetReceiveQueueLevel():
The count of event´s in the receive queue of the port will be returned.
*)
function ncdGetReceiveQueueLevel
(
portHandle : VportHandle;
var level : LongInt
) : Vstatus; external DLL_Name name 'ncdGetReceiveQueueLevel';
(********************************************************************
ncdGetState():
The state of the port is returned.
*)
function ncdGetState
(
portHandle : VportHandle
) : Vstatus; external DLL_Name name 'ncdGetState';
(********************************************************************
ncdActivateChannel():
The selected channels go 'on the bus'.
*)
function ncdActivateChannel
(
portHandle : VportHandle;
accessMask : Vaccess
) : Vstatus; external DLL_Name name 'ncdActivateChannel';
(********************************************************************
DeactivateChannel():
The selected channels go 'off the bus'.
Its now possible to initialize
*)
function ncdDeactivateChannel
(
portHandle : VportHandle;
accessMask : Vaccess
) : Vstatus; external DLL_Name name 'ncdDeactivateChannel';
(********************************************************************
ncdClosePort():
The port is closed, channels are deactivated.
*)
function ncdClosePort
(
portHandle : VportHandle
) : Vstatus; external DLL_Name name 'ncdClosePort';
(********************************************************************
ncdCloseDriver ():
The driver is closed.
This is used to unload the driver, if no more application is useing it.
Does not close the open ports !!!
*)
function ncdCloseDriver : VStatus; external DLL_Name name 'ncdCloseDriver';
(********************************************************************
ncdGetErrorString()
ncdGetEventString()
Utility Functions
*)
function ncdGetErrorString
(
err : Vstatus
) : ncdStringType; external DLL_Name name 'ncdGetErrorString';
function ncdGetEventString
(
var ev : Vevent
) : ncdStringType; external DLL_Name name 'ncdGetEventString';
(********************************************************************
ncdGetApplConfig ():
Returns the hwIndex, hwChannel and hwType for a specific Application and application channel.
This gives the ability to register own applications into the Vector
CAN driver configuration.
AppName: Zero terminated string containing the Name of the Application.
AppChannel: Channel of the application
hwType, hwIndex, hwChannel: contains the the hardware information on success.
This values can be used in a subsequent call to ncdGetChannelMask or ncdGetChannelIndex.
*)
function ncdGetApplConfig
(
appName : PChar;
appChannel : LongInt;
var hwType : LongInt;
var hwIndex : LongInt;
var hwChannel : LongInt
) : Vstatus; external DLL_Name name 'ncdGetApplConfig';
(********************************************************************
ncdSetApplConfig ():
Correspondig to ncdGetApplConfig this function sets the Application
Configuration, but it can also done in the CAN Configuration.
If the Applicationname does not exist a new is generated.
*)
function ncdSetApplConfig
(
appName : PChar;
appChannel : LongInt;
hwType : LongInt;
hwIndex : LongInt;
hwChannel : LongInt
) : Vstatus; external DLL_Name name 'ncdSetApplConfig';
(********************************************************************
ncdGetChannelVersion ():
Get Version Information if available *)
function ncdGetChannelVersion
(
ChannelIndex : LongInt;
var FwVersion : LongInt;
var HwVersion : LongInt;
var SerialNumber : LongInt
) : Vstatus; external DLL_Name name 'ncdGetChannelVersion';
(********************************************************************
ncdSetReceiveMode ():
Suppress Error Frames and ChipState Events *)
function ncdSetReceiveMode
(
Port : VportHandle;
ErrorFrame : Byte;
ChipState : Byte
) : Vstatus; external DLL_Name name 'ncdSetReceiveMode';
(********************************************************************
ncdAddAcceptanceRange ():
Opens the Acceptance filter for a range of IDs *)
function ncdAddAcceptanceRange
(
Port : VportHandle;
accessMask : Vaccess;
first_id : LongInt;
last_id : LongInt
) : Vstatus; external DLL_Name name 'ncdAddAcceptanceRange';
(********************************************************************
ncdRemoveAcceptanceRange ():
Closes the Acceptance filter for a range of IDs *)
function ncdRemoveAcceptanceRange
(
Port : VportHandle;
accessMask : Vaccess;
first_id : LongInt;
last_id : LongInt
) : Vstatus; external DLL_Name name 'ncdRemoveAcceptanceRange';
(********************************************************************
ncdResetAcceptance ():
Resets the Acceptance filter. Filter is closed. *)
function ncdResetAcceptance
(
Port : VportHandle;
accessMask : Vaccess;
extended : LongInt
) : Vstatus; external DLL_Name name 'ncdResetAcceptance';
(********************************************************************
This function had been defined as macros originally (C header)
*)
function CHANNEL_MASK
(
val : Byte
) : LongInt;
begin
CHANNEL_MASK := 1 shl val;
end;
(********************************************************************
SIZEOF_VDRIVERCONFIG() returns the amount of memory needed for the
VDriverConfig record with n channels. Use this function to allocate
memory for the data ncdDriverConfig returns.
*)
function SIZEOF_VDRIVERCONFIG
(
n : Byte
) : LongInt;
begin
SIZEOF_VDRIVERCONFIG := sizeof(VDriverConfig)+(n-1)*sizeof(VChannelConfig);
end;
{$ifdef CanLib4Delphi32}
{$undef CanLib4Delphi32}
{$endif}
end.

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

Binary file not shown.

288
Host/Source/MicroBoot/interfaces/can/vector/XcpSettings.pas
View File

@ -1,288 +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;
//***************************************************************************************
// 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;
edtBaudRate: TEdit;
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;
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);
// CAN related elements
FSettingsForm.cmbHardware.ItemIndex := settingsIni.ReadInteger('can', 'hardware', 0);
FSettingsForm.cmbChannel.ItemIndex := settingsIni.ReadInteger('can', 'channel', 0);
FSettingsForm.edtBaudRate.Text := IntToStr(settingsIni.ReadInteger('can', 'baudrate', 500));
FSettingsForm.chbExtendedId.Checked := settingsIni.ReadBool('can', 'extended', false);
FSettingsForm.edtTransmitId.Text := Format('%x',[settingsIni.ReadInteger('can', 'txid', $667)]);
FSettingsForm.edtReceiveId.Text := Format('%x',[settingsIni.ReadInteger('can', 'rxid', $7e1)]);
// XCP related elements
FSettingsForm.edtSeedKey.Text := settingsIni.ReadString('xcp', 'seedkey', '');
FSettingsForm.edtT1.Text := IntToStr(settingsIni.ReadInteger('xcp', 't1', 1000));
FSettingsForm.edtT3.Text := IntToStr(settingsIni.ReadInteger('xcp', 't3', 2000));
FSettingsForm.edtT4.Text := IntToStr(settingsIni.ReadInteger('xcp', 't4', 10000));
FSettingsForm.edtT5.Text := IntToStr(settingsIni.ReadInteger('xcp', 't5', 1000));
FSettingsForm.edtT7.Text := IntToStr(settingsIni.ReadInteger('xcp', 't7', 2000));
FSettingsForm.edtTconnect.Text := IntToStr(settingsIni.ReadInteger('xcp', 'tconnect', 20));
// release ini file object
settingsIni.Free;
end
else
begin
// set defaults
// CAN related elements
FSettingsForm.cmbHardware.ItemIndex := 0;
FSettingsForm.cmbChannel.ItemIndex := 0;
FSettingsForm.edtBaudRate.Text := IntToStr(500);
FSettingsForm.chbExtendedId.Checked := false;
FSettingsForm.edtTransmitId.Text := Format('%x',[$667]);
FSettingsForm.edtReceiveId.Text := Format('%x',[$7e1]);
// XCP related elements
FSettingsForm.edtSeedKey.Text := '';
FSettingsForm.edtT1.Text := IntToStr(1000);
FSettingsForm.edtT3.Text := IntToStr(2000);
FSettingsForm.edtT4.Text := IntToStr(10000);
FSettingsForm.edtT5.Text := IntToStr(1000);
FSettingsForm.edtT7.Text := IntToStr(2000);
FSettingsForm.edtTconnect.Text := IntToStr(20);
end;
// show the form as modal so we can get the result here
if FSettingsForm.ShowModal = mrOK then
begin
if FIniFile <> '' then
begin
// create ini file object
settingsIni := TIniFile.Create(FIniFile);
// CAN related elements
settingsIni.WriteInteger('can', 'hardware', FSettingsForm.cmbHardware.ItemIndex);
settingsIni.WriteInteger('can', 'channel', FSettingsForm.cmbChannel.ItemIndex);
settingsIni.WriteInteger('can', 'baudrate', StrToInt(FSettingsForm.edtBaudRate.Text));
settingsIni.WriteBool('can', 'extended', FSettingsForm.chbExtendedId.Checked);
settingsIni.WriteInteger('can', 'txid', StrToInt('$'+FSettingsForm.edtTransmitId.Text));
settingsIni.WriteInteger('can', 'rxid', StrToInt('$'+FSettingsForm.edtReceiveId.Text));
// XCP related elements
settingsIni.WriteString('xcp', 'seedkey', FSettingsForm.edtSeedKey.Text);
settingsIni.WriteInteger('xcp', 't1', StrToInt(FSettingsForm.edtT1.Text));
settingsIni.WriteInteger('xcp', 't3', StrToInt(FSettingsForm.edtT3.Text));
settingsIni.WriteInteger('xcp', 't4', StrToInt(FSettingsForm.edtT4.Text));
settingsIni.WriteInteger('xcp', 't5', StrToInt(FSettingsForm.edtT5.Text));
settingsIni.WriteInteger('xcp', 't7', StrToInt(FSettingsForm.edtT7.Text));
settingsIni.WriteInteger('xcp', 'tconnect', StrToInt(FSettingsForm.edtTconnect.Text));
// release ini file object
settingsIni.Free;
// indicate that the settings where successfully updated
result := true;
end;
end;
end; //*** end of Configure ***
end.
//******************************** end of XcpSettings.pas *******************************

414
Host/Source/MicroBoot/interfaces/can/vector/XcpTransport.pas
View File

@ -1,414 +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, CANdrvD, IniFiles;
//***************************************************************************************
// Global Constants
//***************************************************************************************
const kMaxPacketSize = 256;
//***************************************************************************************
// Type Definitions
//***************************************************************************************
type
TXcpTransportInfo = (kNone, kResponse, kError);
type
TXcpTransport = class(TObject)
private
comEventInfo : TXcpTransportInfo;
comEvent : THandle;
packetTxId : LongWord;
packetRxId : Longword;
extendedId : Boolean;
procedure OnCanMessage(Sender: TObject; Direction: TDirection; Message: TCanMsg);
procedure OnBusOff(Sender: TObject; time: LongInt);
function MsgWaitForSingleObject(hHandle: THandle; dwMilliseconds: DWORD): DWORD;
public
packetData : array[0..kMaxPacketSize-1] of Byte;
packetLen : Word;
canDriver : TCanDriver;
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 can driver instance
canDriver := TCanDriver.Create(nil);
// set can driver event handlers
canDriver.OnMessage := OnCanMessage;
canDriver.OnBusOff := OnBusOff;
// reset the packet ids
packetTxId := 0;
packetRxId := 0;
// use standard id's by default
extendedId := false;
// reset packet length
packetLen := 0;
end; //*** end of Create ***
//***************************************************************************************
// NAME: Destroy
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Class destructor
//
//***************************************************************************************
destructor TXcpTransport.Destroy;
begin
// release can driver instances
canDriver.Free;
// release event handle
CloseHandle(comEvent);
// 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;
hwIndex : integer;
begin
// read XCP configuration from INI
if FileExists(iniFile) then
begin
// create ini file object
settingsIni := TIniFile.Create(iniFile);
// set message configuration
packetTxId := settingsIni.ReadInteger('can', 'txid', $667);
packetRxId := settingsIni.ReadInteger('can', 'rxid', $7e1);
extendedId := settingsIni.ReadBool('can', 'extended', false);
// configure can hardware
hwIndex := settingsIni.ReadInteger('can', 'hardware', 0);
canDriver.Hardware := Virtual; // init to virtual channel
case hwIndex of
0 : canDriver.Hardware := Virtual;
1 : canDriver.Hardware := CANcardX;
2 : canDriver.Hardware := CANcardXL;
3 : canDriver.Hardware := CANcaseXL;
4 : canDriver.Hardware := CANboardXL;
5 : canDriver.Hardware := CANboardXL_Compact;
6 : canDriver.Hardware := CANac2;
7 : canDriver.Hardware := CANac2Pci;
8 : canDriver.Hardware := CANpari;
9 : canDriver.Hardware := CANdongle;
10: canDriver.Hardware := CANcard;
11: canDriver.Hardware := CANcardY;
12: canDriver.Hardware := CANcard2;
13: canDriver.Hardware := EDICcard;
end;
// configure baudrate
canDriver.BaudRate := settingsIni.ReadInteger('can', 'baudrate', 500) * 1000;
if settingsIni.ReadInteger('can', 'channel', 0) = 0 then
canDriver.Channel := channel0
else
canDriver.Channel := channel1;
// 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;
begin
result := true;
if not canDriver.Connect 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 := canDriver.IsComError;
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
msg: TCanMsg;
cnt : byte;
waitResult: Integer;
begin
// do not send any more data on the network when we are in bus off state.
if IsComError then
begin
result := false;
Exit;
end;
// prepare the packet
msg.id := LongInt(PacketTxId);
msg.dlc := packetLen;
msg.ext := extendedId;
for cnt := 0 to packetLen-1 do
begin
msg.data[cnt] := packetData[cnt];
end;
// make sure the event is reset
ResetEvent(comEvent);
comEventInfo := kNone;
// submit the packet transmission request
if not canDriver.Transmit(msg) then
begin
// unable to submit tx request
result := False;
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
canDriver.Disconnect;
end; //*** end of Disconnect ***
//***************************************************************************************
// NAME: OnCanMessage
// PRECONDITIONS: none
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Can message event handler
//
//***************************************************************************************
procedure TXcpTransport.OnCanMessage( Sender: TObject; Direction: TDirection; Message: TCanMsg );
var
cnt : integer;
begin
// the event we are interested in is the reception of the command response from
// slave.
if Direction = Rx then
begin
if Message.id = LongInt(PacketRxId) then
begin
// store response data
for cnt := 0 to Message.dlc-1 do
begin
packetData[cnt] := Message.data[cnt];
end;
// store response length
packetLen := Message.dlc;
// set event flag
comEventInfo := kResponse;
// trigger the event
SetEvent(comEvent);
end;
end;
end; //*** end of OnCanMessage ***
//***************************************************************************************
// NAME: OnBusOff
// PRECONDITIONS: none
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Bus off event handler
//
//***************************************************************************************
procedure TXcpTransport.OnBusOff(Sender: TObject; time: LongInt);
begin
// set error event flag
comEventInfo := kError;
// trigger the event
SetEvent(comEvent);
end; //*** end of OnBusOff ***
//***************************************************************************************
// NAME: MsgWaitForSingleObject
// PRECONDITIONS: none
// 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 ******************************

35
Host/Source/MicroBoot/interfaces/can/vector/openblt_can_vector.cfg
View File

@ -1,35 +0,0 @@
-$A+
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J+
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-E../../../../../
-LNc:\borland\delphi4\Lib

87
Host/Source/MicroBoot/interfaces/can/vector/openblt_can_vector.dof
View File

@ -1,87 +0,0 @@
[Compiler]
A=1
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=1
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=../../../../../
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
[Version Info]
IncludeVerInfo=0
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1031
CodePage=1252
[Version Info Keys]
CompanyName=
FileDescription=
FileVersion=1.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=1.0.0.0
Comments=
[Excluded Packages]
$(DELPHI)\Lib\dclusr40.bpl=Borland User
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[HistoryLists\hlOutputDirectorry]
Count=2
Item0=../../../../../
Item1=../../../../

653
Host/Source/MicroBoot/interfaces/can/vector/openblt_can_vector.dpr
View File

@ -1,653 +0,0 @@
library openblt_can_vector;
//***************************************************************************************
// Project Name: MicroBoot Interface for Borland Delphi
// Description: XCP - CAN interface for MicroBoot supporting Vector CAN
// File Name: openblt_can_vector.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',
SRecReader in '..\..\SRecReader.pas',
XcpDataFile in '..\..\XcpDataFile.pas',
XcpLoader in '..\..\XcpLoader.pas',
XcpTransport in 'XcpTransport.pas',
CANdrvD in 'CANdrvD.pas',
CANlibD in 'CANlibD.pas',
XcpSettings in 'XcpSettings.pas' {XcpSettingsForm};
//***************************************************************************************
// Global Constants
//***************************************************************************************
const kMaxProgLen = 256; // maximum number of bytes to progam at one time
//***************************************************************************************
// Type Definitions
//***************************************************************************************
// DLL Interface Callbacks - modifications requires potential update of all interfaces!
type
TStartedEvent = procedure(length: Longword) of object;
TProgressEvent = procedure(progress: Longword) of object;
TDoneEvent = procedure of object;
TErrorEvent = procedure(error: ShortString) of object;
TLogEvent = procedure(info: ShortString) of object;
TInfoEvent = procedure(info: ShortString) of object;
type
TEventHandlers = class // create a dummy class
procedure OnTimeout(Sender: TObject);
end;
//***************************************************************************************
// Global Variables
//***************************************************************************************
var
//--- begin of don't change ---
AppOnStarted : TStartedEvent;
AppOnProgress : TProgressEvent;
AppOnDone : TDoneEvent;
AppOnError : TErrorEvent;
AppOnLog : TLogEvent;
AppOnInfo : TInfoEvent;
//--- end of don't change ---
timer : TTimer;
events : TEventHandlers;
loader : TXcpLoader;
datafile : TXcpDataFile;
progdata : array of Byte;
progfile : string;
stopRequest : boolean;
//***************************************************************************************
// NAME: MbiCallbackOnStarted
// PARAMETER: length of the file that is being downloaded.
// RETURN VALUE: none
// DESCRIPTION: Wrapper function for safely calling an application callback
//
//***************************************************************************************
procedure MbiCallbackOnStarted(length: Longword);
begin
if Assigned(AppOnStarted) then
begin
AppOnStarted(length);
end;
end; //** end of MbiCallbackOnStarted ***
//***************************************************************************************
// NAME: MbiCallbackOnProgress
// PARAMETER: progress of the file download.
// RETURN VALUE: none
// DESCRIPTION: Wrapper function for safely calling an application callback
//
//***************************************************************************************
procedure MbiCallbackOnProgress(progress: Longword);
begin
if Assigned(AppOnProgress) then
begin
AppOnProgress(progress);
end;
end; //** end of MbiCallbackOnProgress ***
//***************************************************************************************
// NAME: MbiCallbackOnDone
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Wrapper function for safely calling an application callback
//
//***************************************************************************************
procedure MbiCallbackOnDone;
begin
if Assigned(AppOnDone) then
begin
AppOnDone;
end;
end; //** end of MbiCallbackOnDone ***
//***************************************************************************************
// NAME: MbiCallbackOnError
// PARAMETER: info about the error that occured.
// RETURN VALUE: none
// DESCRIPTION: Wrapper function for safely calling an application callback
//
//***************************************************************************************
procedure MbiCallbackOnError(error: ShortString);
begin
if Assigned(AppOnError) then
begin
AppOnError(error);
end;
end; //** end of MbiCallbackOnError ***
//***************************************************************************************
// NAME: MbiCallbackOnLog
// PARAMETER: info on the log event.
// RETURN VALUE: none
// DESCRIPTION: Wrapper function for safely calling an application callback
//
//***************************************************************************************
procedure MbiCallbackOnLog(info: ShortString);
begin
if Assigned(AppOnLog) then
begin
AppOnLog(info);
end;
end; //** end of MbiCallbackOnLog ***
//***************************************************************************************
// NAME: MbiCallbackOnInfo
// PARAMETER: details on the info event.
// RETURN VALUE: none
// DESCRIPTION: Wrapper function for safely calling an application callback
//
//***************************************************************************************
procedure MbiCallbackOnInfo(info: ShortString);
begin
if Assigned(AppOnInfo) then
begin
AppOnInfo(info);
end;
end; //** end of MbiCallbackOnLog ***
//***************************************************************************************
// NAME: LogData
// PARAMETER: pointer to byte array and the data length
// RETURN VALUE: none
// DESCRIPTION: Writes the program data formatted to the logfile
//
//***************************************************************************************
procedure LogData(data : PByteArray; len : longword); stdcall;
var
currentWriteCnt : byte;
cnt : byte;
logStr : string;
bufferOffset : longword;
begin
bufferOffset := 0;
while len > 0 do
begin
// set the current write length optimized to log 32 bytes per line
currentWriteCnt := len mod 32;
if currentWriteCnt = 0 then currentWriteCnt := 32;
logStr := '';
// prepare the line to add to the log
for cnt := 0 to currentWriteCnt-1 do
begin
logStr := logStr + Format('%2.2x ', [data[bufferOffset+cnt]]);
end;
// update the log
MbiCallbackOnLog(logStr);
// update loop variables
len := len - currentWriteCnt;
bufferOffset := bufferOffset + currentWriteCnt;
end;
end; //*** end of LogData ***
//***************************************************************************************
// NAME: OnTimeout
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Timer event handler. A timer is used in this example to simulate the
// progress of a file download. It also demonstrates how to use the
// application callbacks to keep the application informed.
//
//***************************************************************************************
procedure TEventHandlers.OnTimeout(Sender: TObject);
var
errorInfo : string;
progress : longword;
regionCnt : longword;
currentWriteCnt : word;
sessionStartResult : byte;
bufferOffset : longword;
addr : longword;
len : longword;
dataSizeKB : real;
begin
timer.Enabled := False;
// connect the transport layer
MbiCallbackOnInfo('Connecting to the CAN interface.');
MbiCallbackOnLog('Connecting to the CAN interface. t='+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='+TimeToStr(Time));
Exit;
end;
//---------------- start the programming session --------------------------------------
MbiCallbackOnLog('Starting the programming session. t='+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='+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='+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. not 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 is in reset of 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='+TimeToStr(Time));
loader.Disconnect;
if not loader.Connect then
begin
MbiCallbackOnLog('Could not connect to CAN interface. Check your configuration and try again. t='+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='+TimeToStr(Time));
MbiCallbackOnError('Security issue. Could not unprotect the programming resource.');
Exit;
end;
// check if the user cancelled
if stopRequest then
begin
MbiCallbackOnError('Programming session cancelled by user.');
Exit;
end;
end;
end;
// still here so programming session was started
MbiCallbackOnLog('Programming session started. t='+TimeToStr(Time));
// create the datafile object
datafile := TXcpDataFile.Create(progfile);
// compute the size in kbytes
dataSizeKB := datafile.GetDataCnt / 1024;
// Call application callback when we start the actual download
MbiCallbackOnStarted(datafile.GetDataCnt);
// Init progress to 0 progress
progress := 0;
MbiCallbackOnProgress(progress);
//---------------- next clear the memory regions --------------------------------------
// update the user info
MbiCallbackOnInfo('Erasing memory...');
for regionCnt := 0 to datafile.GetRegionCnt-1 do
begin
// obtain the region info
datafile.GetRegionInfo(regionCnt, addr, len);
// erase the memory
MbiCallbackOnLog('Clearing Memory '+Format('addr:0x%x,len:0x%x',[addr,len])+'. t='+TimeToStr(Time));
if not loader.ClearMemory(addr, len) then
begin
loader.GetLastError(errorInfo);
MbiCallbackOnLog('Could not clear memory ('+errorInfo+'). t='+TimeToStr(Time));
MbiCallbackOnError('Could not clear memory ('+errorInfo+').');
datafile.Free;
Exit;
end;
MbiCallbackOnLog('Memory cleared. t='+TimeToStr(Time));
end;
//---------------- next program the memory regions ------------------------------------
for regionCnt := 0 to datafile.GetRegionCnt-1 do
begin
// update the user info
MbiCallbackOnInfo('Reading file...');
// obtain the region info
datafile.GetRegionInfo(regionCnt, addr, len);
// dynamically allocated buffer memory
SetLength(progdata, len);
// obtain the regiond data
datafile.GetRegionData(regionCnt, progdata);
bufferOffset := 0;
while len > 0 do
begin
// set the current write length taking into account kMaxProgLen
currentWriteCnt := len mod kMaxProgLen;
if currentWriteCnt = 0 then currentWriteCnt := kMaxProgLen;
// program the data
MbiCallbackOnLog('Programming Data '+Format('addr:0x%x,len:0x%x',[addr,currentWriteCnt])+'. t='+TimeToStr(Time));
LogData(@progdata[bufferOffset], currentWriteCnt);
if not loader.WriteData(addr, currentWriteCnt, @progdata[bufferOffset]) then
begin
loader.GetLastError(errorInfo);
MbiCallbackOnLog('Could not program data ('+errorInfo+'). t='+TimeToStr(Time));
MbiCallbackOnError('Could not program data ('+errorInfo+').');
datafile.Free;
Exit;
end;
MbiCallbackOnLog('Data Programmed. t='+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... ' + Format('(%.1n of %.1n Kbytes)',[(progress/1024), dataSizeKB]));
end;
end;
//---------------- stop the programming session ---------------------------------------
MbiCallbackOnLog('Stopping the programming session. t='+TimeToStr(Time));
if not loader.StopProgrammingSession then
begin
loader.GetLastError(errorInfo);
MbiCallbackOnLog('Could not stop the programming session ('+errorInfo+'). t='+TimeToStr(Time));
MbiCallbackOnError('Could not stop the programming session ('+errorInfo+').');
datafile.Free;
Exit;
end;
MbiCallbackOnLog('Programming session stopped. t='+TimeToStr(Time));
// all done so set progress to 100% and finish up
progress := datafile.GetDataCnt;
datafile.Free;
MbiCallbackOnProgress(progress);
MbiCallbackOnLog('File successfully downloaded t='+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_vector.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 := fileName;
end; //*** end of MbiStart ***
//***************************************************************************************
// NAME: MbiStop
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Called by the application to request the interface library to stop
// a download that could be in progress.
//
//***************************************************************************************
procedure MbiStop; stdcall;
begin
// set stop request
stopRequest := true;
// disconnect the transport layer
MbiCallbackOnLog('Disconnecting the transport layer. t='+TimeToStr(Time));
loader.Disconnect;
end; //*** end of MbiStop ***
//***************************************************************************************
// NAME: MbiDeInit
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Called by the application to uninitialize the interface library.
//
//***************************************************************************************
procedure MbiDeInit; stdcall;
begin
// release xcp loader object
loader.Free;
// release the timer and events object
timer.Free;
events.Free;
//--- begin of don't change ---
AppOnStarted := nil;
AppOnProgress := nil;
AppOnDone := nil;
AppOnLog := nil;
AppOnInfo := nil;
AppOnError := nil;
//--- end of don't change ---
end; //*** end of MbiDeInit ***
//***************************************************************************************
// NAME: MbiName
// PARAMETER: none
// RETURN VALUE: name of the interface library
// DESCRIPTION: Called by the application to obtain the name of the interface library.
//
//***************************************************************************************
function MbiName : ShortString; stdcall;
begin
Result := 'OpenBLT CAN Vector';
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 Vector 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 := 10000; // v1.00.00
end; //*** end of MbiVersion ***
//***************************************************************************************
// NAME: MbiVInterface
// PARAMETER: none
// RETURN VALUE: version number of the supported interface
// DESCRIPTION: Called by the application to obtain the version number of the
// Mbi interface uBootInterface.pas (not the interface library). This can
// be used by the application for backward compatibility.
//
//***************************************************************************************
function MbiVInterface : Longword; stdcall;
begin
Result := 10001; // v1.00.01
end; //*** end of MbiVInterface ***
//***************************************************************************************
// NAME: MbiConfigure
// PARAMETER: none
// RETURN VALUE: none
// DESCRIPTION: Called by the application to enable the user to configure the inter-
// face library through the application.
//
//***************************************************************************************
procedure MbiConfigure; stdcall;
var
settings : TXcpSettings;
begin
// create xcp settings object
settings := TXcpSettings.Create(ExtractFilePath(ParamStr(0))+'openblt_can_vector.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_vector.ini');
end; //*** end of MbiConfigure ***
//***************************************************************************************
// External Declarations
//***************************************************************************************
exports
//--- begin of don't change ---
MbiInit index 1,
MbiStart index 2,
MbiStop index 3,
MbiDeInit index 4,
MbiName index 5,
MbiDescription index 6,
MbiVersion index 7,
MbiConfigure index 8,
MbiVInterface index 9;
//--- end of don't change ---
end.
//********************************** end of openblt_can_vector.dpr **********************

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

@ -425,8 +425,8 @@ begin
with WSAData do
begin
FVersion:= Concat(IntToStr(Hi(wVersion)),'.',(IntToStr(Lo(wVersion))));
FDescription:= StrPas(szDescription);
FSystemStatus:= StrPas(szSystemStatus);
FDescription:= String(szDescription);
FSystemStatus:= String(szSystemStatus);
FMaxSockets:= iMaxSockets;
FMaxUDPSize:= iMaxUDPDg;
end;
@ -462,16 +462,16 @@ begin
Exit;
end;
ServEnt:= getservbyname(PChar(Port), ProtoEnt^.p_name);
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(PChar(Host));
if SockAddrIn.sin_addr.s_addr = INADDR_NONE then
SockAddrIn.sin_addr.s_addr:= inet_addr(PAnsiChar(AnsiString(Host)));
if SockAddrIn.sin_addr.s_addr = Integer(INADDR_NONE) then
begin
HostEnt:= gethostbyname(PChar(Host));
HostEnt:= gethostbyname(PAnsiChar(AnsiString(Host)));
if HostEnt = nil then
begin
SocketError(WSAGetLastError);
@ -495,7 +495,7 @@ begin
if ProtoEnt = nil then
Exit;
ServEnt:= getservbyname(PChar(Port), ProtoEnt^.p_name);
ServEnt:= getservbyname(PAnsiChar(AnsiString(Port)), ProtoEnt^.p_name);
if ServEnt = nil then
SockAddrIn.sin_port:= htons(StrToInt(Port))
else
@ -518,13 +518,13 @@ begin
if ProtoEnt = nil then
Exit;
ServEnt:= getservbyname(PChar(Port), ProtoEnt^.p_name);
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_BROADCAST;
SockAddrIn.sin_addr.s_addr:= Integer(INADDR_BROADCAST);
Result:= true;
end;
@ -534,12 +534,12 @@ var
begin
HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
if HostEnt <> nil then
Result:= HostEnt.h_name;
Result:= String(AnsiString(HostEnt.h_name));
end;
function TCustomWSocket.SockAddrInToAddress(SockAddrIn: TSockAddrIn): string;
begin
Result:= inet_ntoa(SockAddrIn.sin_addr);
Result:= String(AnsiString(inet_ntoa(SockAddrIn.sin_addr)));
end;
function TCustomWSocket.SockAddrInToPort(SockAddrIn: TSockAddrIn): string;
@ -560,7 +560,7 @@ begin
begin
HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
if HostEnt <> nil then
Result:= HostEnt.h_name;
Result:= String(AnsiString(HostEnt.h_name));
end;
end;
end;
@ -574,7 +574,7 @@ begin
begin
Len:= SizeOf(SockAddrIn);
if getsockname(Socket, SockAddrIn, Len) <> SOCKET_ERROR then
Result:= inet_ntoa(SockAddrIn.sin_addr);
Result:= String(AnsiString(inet_ntoa(SockAddrIn.sin_addr)));
end;
end;
@ -604,7 +604,7 @@ begin
begin
HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
if HostEnt <> nil then
Result:= HostEnt.h_name;
Result:= String(AnsiString(HostEnt.h_name));
end;
end;
end;
@ -618,7 +618,7 @@ begin
begin
Len:= SizeOf(SockAddrIn);
if getpeername(Socket, SockAddrIn, Len) <> SOCKET_ERROR then
Result:= inet_ntoa(SockAddrIn.sin_addr);
Result:= String(AnsiString(inet_ntoa(SockAddrIn.sin_addr)));
end;
end;
@ -881,7 +881,7 @@ function TCustomWSocket.GetLocalHostAddress: string;
var
SockAddrIn: TSockAddrIn;
HostEnt: PHostEnt;
szHostName: array[0..128] of char;
szHostName: array[0..128] of ansichar;
begin
if gethostname(szHostName, 128) = 0 then
begin
@ -891,7 +891,7 @@ begin
else
begin
SockAddrIn.sin_addr.S_addr:= longint(plongint(HostEnt^.h_addr_list^)^);
Result:= inet_ntoa(SockAddrIn.sin_addr);
Result:= String(AnsiString(inet_ntoa(SockAddrIn.sin_addr)));
end;
end
else
@ -900,10 +900,10 @@ end;
function TCustomWSocket.GetLocalHostName: string;
var
szHostName: array[0..128] of char;
szHostName: array[0..128] of ansichar;
begin
if gethostname(szHostName, 128) = 0 then
Result:= szHostName
Result:= String(AnsiString(szHostName))
else
SocketError(WSAGetLastError);
end;
@ -1019,7 +1019,7 @@ begin
end;
SockOpt:= true; {Enable OOB Data inline}
if setsockopt(FLocalSocket, SOL_SOCKET, SO_OOBINLINE, PChar(@SockOpt), SizeOf(SockOpt)) <> 0 then
if setsockopt(FLocalSocket, SOL_SOCKET, SO_OOBINLINE, PAnsiChar(@SockOpt), SizeOf(SockOpt)) <> 0 then
begin
SocketError(WSAGetLastError);
closesocket(FLocalSocket);
@ -1136,7 +1136,7 @@ begin
end;
SockOpt:= true; {Enable OOB Data inline}
if setsockopt(NewSocket, SOL_SOCKET, SO_OOBINLINE , PChar(@SockOpt), SizeOf(SockOpt)) <> 0 then
if setsockopt(NewSocket, SOL_SOCKET, SO_OOBINLINE , PAnsiChar(@SockOpt), SizeOf(SockOpt)) <> 0 then
begin
SocketError(WSAGetLastError);
closesocket(NewSocket);
@ -1495,7 +1495,7 @@ begin
end;
SockOpt:= true; {Enable Broadcasting on this Socket}
if setsockopt(FLocalSocket, SOL_SOCKET, SO_BROADCAST, PChar(@SockOpt), SizeOf(SockOpt)) <> 0 then
if setsockopt(FLocalSocket, SOL_SOCKET, SO_BROADCAST, PAnsiChar(@SockOpt), SizeOf(SockOpt)) <> 0 then
begin
SocketError(WSAGetLastError);
closesocket(FLocalSocket);

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

Binary file not shown.

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

@ -36,7 +36,7 @@ interface
//***************************************************************************************
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, ExtCtrls, IniFiles;
StdCtrls, ComCtrls, ExtCtrls, IniFiles, Vcl.Imaging.pngimage;
//***************************************************************************************
@ -76,7 +76,6 @@ type
edtPort: TEdit;
edtTconnect: TEdit;
lblTconnect: TLabel;
chbSocketRetry: TCheckBox;
procedure btnOKClick(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
procedure btnBrowseClick(Sender: TObject);
@ -203,7 +202,6 @@ begin
// NET related elements
FSettingsForm.edtHostname.Text := settingsIni.ReadString('net', 'hostname', '169.254.19.63');
FSettingsForm.edtPort.Text := settingsIni.ReadString('net', 'port', '1000');
FSettingsForm.chbSocketRetry.Checked := settingsIni.ReadBool('net', 'retry', false);
// XCP related elements
FSettingsForm.edtSeedKey.Text := settingsIni.ReadString('xcp', 'seedkey', ExtractFilePath(ParamStr(0))+'');
@ -223,7 +221,6 @@ begin
// NET related elements
FSettingsForm.edtHostname.Text := '169.254.19.63';
FSettingsForm.edtPort.Text := '1000';
FSettingsForm.chbSocketRetry.Checked := false;
// XCP related elements
FSettingsForm.edtSeedKey.Text := ExtractFilePath(ParamStr(0))+'';
@ -246,7 +243,6 @@ begin
// NET related elements
settingsIni.WriteString('net', 'hostname', FSettingsForm.edtHostname.Text);
settingsIni.WriteString('net', 'port', FSettingsForm.edtPort.Text);
settingsIni.WriteBool('net', 'retry', FSettingsForm.chbSocketRetry.Checked);
// XCP related elements
settingsIni.WriteString('xcp', 'seedkey', FSettingsForm.edtSeedKey.Text);

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

@ -61,7 +61,6 @@ type
socket : TTCPClient;
hostname : string;
port : string;
connectRetry : Boolean;
croCounter : LongWord;
procedure OnSocketDataAvailable(Sender: TObject; WinSocket: TSocket);
function MsgWaitForSingleObject(hHandle: THandle; dwMilliseconds: DWORD): DWORD;
@ -156,9 +155,6 @@ begin
// configure port
port := settingsIni.ReadString('net', 'port', '1000');
// configure the connection retry feature
connectRetry := settingsIni.ReadBool('net', 'retry', false);
// release ini file object
settingsIni.Free;
end
@ -169,9 +165,6 @@ begin
// configure default port
port := '1000';
// configure default connection retry feature setting
connectRetry := false;
end;
end; //*** end of Configure ***
@ -208,15 +201,11 @@ begin
// wait for the connection to be established
while socket.SocketState <> ssConnected do
begin
// check timeout if connection retry feature is enabled
if connectRetry then
// check for timeout
if GetTickCount > connectTimeout then
begin
// check for timeout
if GetTickCount > connectTimeout then
begin
result := false;
Exit;
end;
result := false;
Exit;
end;
Application.ProcessMessages;

35
Host/Source/MicroBoot/interfaces/net/openblt_net.cfg
View File

@ -1,35 +0,0 @@
-$A+
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J+
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-E../../../../
-LNc:\borland\delphi4\Lib

85
Host/Source/MicroBoot/interfaces/net/openblt_net.dof
View File

@ -1,85 +0,0 @@
[Compiler]
A=1
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=1
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=../../../../
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40;IcsDel40
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
[Version Info]
IncludeVerInfo=0
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1043
CodePage=1252
[Version Info Keys]
CompanyName=
FileDescription=
FileVersion=1.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=1.0.0.0
Comments=
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[HistoryLists\hlOutputDirectorry]
Count=2
Item0=../../../../
Item1=../../../

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

@ -224,7 +224,7 @@ begin
end;
// update the log
MbiCallbackOnLog(logStr);
MbiCallbackOnLog(ShortString(logStr));
// update loop variables
len := len - currentWriteCnt;
@ -258,14 +258,14 @@ begin
// 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='+TimeToStr(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='+TimeToStr(Time));
MbiCallbackOnLog('Retrying transport layer connection. Reset your target if this takes a long time. t='+TimeToStr(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
@ -282,11 +282,11 @@ begin
// we now have a socket connected to the target. next attempt to connect to the target
// via XCP.
MbiCallbackOnLog('Starting the programming session. t='+TimeToStr(Time));
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='+TimeToStr(Time));
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;
@ -299,18 +299,18 @@ begin
// 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='+TimeToStr(Time));
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='+TimeToStr(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='+TimeToStr(Time));
MbiCallbackOnLog('Retrying transport layer connection. Reset your target if this takes a long time. t='+TimeToStr(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
@ -325,12 +325,12 @@ begin
end;
end;
//---------------- start the programming session --------------------------------------
MbiCallbackOnLog('Starting the programming session. t='+TimeToStr(Time));
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='+TimeToStr(Time));
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;
@ -341,7 +341,7 @@ begin
begin
// update the user info
MbiCallbackOnInfo('Could not connect. Please reset your target...');
MbiCallbackOnLog('Connect failed. Switching to backdoor entry mode. t='+TimeToStr(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;
@ -353,7 +353,7 @@ begin
// 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='+TimeToStr(Time));
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;
@ -369,7 +369,7 @@ begin
end;
// still here so programming session was started
MbiCallbackOnLog('Programming session started. t='+TimeToStr(Time));
MbiCallbackOnLog('Programming session started. t='+ShortString(TimeToStr(Time)));
// create the datafile object
datafile := TXcpDataFile.Create(progfile);
@ -394,16 +394,16 @@ begin
datafile.GetRegionInfo(regionCnt, addr, len);
// erase the memory
MbiCallbackOnLog('Clearing Memory '+Format('addr:0x%x,len:0x%x',[addr,len])+'. t='+TimeToStr(Time));
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 ('+errorInfo+'). t='+TimeToStr(Time));
MbiCallbackOnError('Could not clear memory ('+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='+TimeToStr(Time));
MbiCallbackOnLog('Memory cleared. t='+ShortString(TimeToStr(Time)));
end;
//---------------- next program the memory regions ------------------------------------
@ -427,18 +427,18 @@ begin
if currentWriteCnt = 0 then currentWriteCnt := kMaxProgLen;
// program the data
MbiCallbackOnLog('Programming Data '+Format('addr:0x%x,len:0x%x',[addr,currentWriteCnt])+'. t='+TimeToStr(Time));
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 ('+errorInfo+'). t='+TimeToStr(Time));
MbiCallbackOnError('Could not program data ('+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='+TimeToStr(Time));
MbiCallbackOnLog('Data Programmed. t='+ShortString(TimeToStr(Time)));
// update progress
progress := progress + currentWriteCnt;
@ -450,28 +450,28 @@ begin
bufferOffset := bufferOffset + currentWriteCnt;
// update the user info
MbiCallbackOnInfo('Programming data... ' + Format('(%.1n of %.1n Kbytes)',[(progress/1024), dataSizeKB]));
MbiCallbackOnInfo('Programming data... ' + ShortString(Format('(%.1n of %.1n Kbytes)',[(progress/1024), dataSizeKB])));
end;
end;
//---------------- stop the programming session ---------------------------------------
MbiCallbackOnLog('Stopping the programming session. t='+TimeToStr(Time));
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 ('+errorInfo+'). t='+TimeToStr(Time));
MbiCallbackOnError('Could not stop the programming session ('+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='+TimeToStr(Time));
MbiCallbackOnLog('Programming session stopped. t='+ShortString(TimeToStr(Time)));
// all done so set progress to 100% and finish up
progress := datafile.GetDataCnt;
datafile.Free;
MbiCallbackOnProgress(progress);
MbiCallbackOnLog('File successfully downloaded t='+TimeToStr(Time));
MbiCallbackOnLog('File successfully downloaded t='+ShortString(TimeToStr(Time)));
MbiCallbackOnDone;
end; //*** end of OnTimeout ***
@ -535,7 +535,7 @@ begin
timer.Enabled := True;
// store the program's filename
progfile := fileName;
progfile := String(fileName);
end; //*** end of MbiStart ***
@ -553,7 +553,7 @@ begin
stopRequest := true;
// disconnect the transport layer
MbiCallbackOnLog('Disconnecting the transport layer. t='+TimeToStr(Time));
MbiCallbackOnLog('Disconnecting the transport layer. t='+ShortString(TimeToStr(Time)));
loader.Disconnect;
end; //*** end of MbiStop ***
@ -672,15 +672,15 @@ end; //*** end of MbiConfigure ***
//***************************************************************************************
exports
//--- begin of don't change ---
MbiInit index 1,
MbiStart index 2,
MbiStop index 3,
MbiDeInit index 4,
MbiName index 5,
MbiDescription index 6,
MbiVersion index 7,
MbiConfigure index 8,
MbiVInterface index 9;
MbiInit,
MbiStart,
MbiStop,
MbiDeInit,
MbiName,
MbiDescription,
MbiVersion,
MbiConfigure,
MbiVInterface;
//--- end of don't change ---
end.

120
Host/Source/MicroBoot/interfaces/net/openblt_net.dproj Normal file
View File

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

1158
Host/Source/MicroBoot/interfaces/uart/CPDrv.pas
View File

File diff suppressed because it is too large Load Diff

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

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

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

File diff suppressed because it is too large Load Diff

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

Binary file not shown.

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

@ -36,7 +36,7 @@ interface
//***************************************************************************************
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, ExtCtrls, IniFiles;
StdCtrls, ComCtrls, ExtCtrls, IniFiles, Vcl.Imaging.pngimage;
//***************************************************************************************

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

@ -36,7 +36,7 @@ interface
// Includes
//***************************************************************************************
uses
Windows, Messages, SysUtils, Classes, Forms, CPDrv, IniFiles;
Windows, Messages, SysUtils, Classes, Forms, CPort, IniFiles;
//***************************************************************************************
@ -54,7 +54,7 @@ type
public
packetData : array[0..kMaxPacketSize-1] of Byte;
packetLen : Word;
sciDriver : TCommPortDriver;
sciDriver : TComPort;
constructor Create;
procedure Configure(iniFile : string);
function Connect : Boolean;
@ -80,14 +80,12 @@ begin
inherited Create;
// create a sci driver instance
sciDriver := TCommPortDriver.Create(nil);
sciDriver := TComPort.Create(nil);
// init sci settings
sciDriver.DataBits := db8BITS;
sciDriver.StopBits := sb1BITS;
sciDriver.Parity := ptNONE;
sciDriver.SwFlow := sfNONE;
sciDriver.PollingDelay := 5;
sciDriver.DataBits := dbEight;
sciDriver.StopBits := sbOneStopBit;
sciDriver.Parity.Bits := prNone;
// reset packet length
packetLen := 0;
@ -149,8 +147,7 @@ begin
// configure port
configIndex := settingsIni.ReadInteger('sci', 'port', 0);
sciDriver.Port := pnCustom;
sciDriver.PortName := Format( '\\.\COM%d', [ord(configIndex + 1)] );
sciDriver.Port := Format( 'COM%d', [ord(configIndex + 1)] );
// release ini file object
settingsIni.Free;
@ -167,9 +164,8 @@ end; //*** end of Configure ***
//***************************************************************************************
function TXcpTransport.Connect : Boolean;
begin
result := true;
if not sciDriver.Connect then
result := false;
sciDriver.Open;
result := sciDriver.Connected;
end; //*** end of Connect ***
@ -199,7 +195,6 @@ var
msgData : array of Byte;
resLen : byte;
cnt : byte;
dwEnd :DWord;
begin
// init the return value
result := false;
@ -222,35 +217,26 @@ begin
msgData[cnt+1] := packetData[cnt];
end;
// configure transmit timeout. timeout = (MULTIPLIER) * number_of_bytes + CONSTANT
sciDriver.Timeouts.WriteTotalConstant := 0;
sciDriver.Timeouts.WriteTotalMultiplier := timeOutms div (packetLen+1);
// submit the packet transmission request
if sciDriver.SendData(@msgData[0], packetLen+1) <> (packetLen+1) then
if sciDriver.Write(msgData[0], packetLen+1) <> (packetLen+1) then
begin
// unable to submit tx request
Exit;
end;
// compute timeout time
dwEnd := GetTickCount + timeOutms;
// configure reception timeout. timeout = (MULTIPLIER) * number_of_bytes + CONSTANT
sciDriver.Timeouts.ReadTotalConstant := timeOutms;
sciDriver.Timeouts.ReadTotalMultiplier := 0;
// configure timeout for first byte
sciDriver.InputTimeout := timeOutms;
// receive the first byte which holds the packet length
if sciDriver.ReadByte(resLen) = true then
// receive the first byte which should hold the packet length
if sciDriver.Read(resLen, 1) = 1 then
begin
timeOutms := GetTickCount;
if timeOutms < dwEnd then
begin
// configure timeout for remaining bytes
sciDriver.InputTimeout := dwEnd - timeOutms;
end
else
begin
Exit; // timed out
end;
// receive the actual packet data
if sciDriver.ReadData(@packetData[0], resLen) = resLen then
if sciDriver.Read(packetData[0], resLen) = resLen then
begin
packetLen := resLen;
result := true;
@ -268,7 +254,7 @@ end; //*** end of SendPacket ***
//***************************************************************************************
procedure TXcpTransport.Disconnect;
begin
sciDriver.Disconnect;
sciDriver.Close;
end; //*** end of Disconnect ***

35
Host/Source/MicroBoot/interfaces/uart/openblt_uart.cfg
View File

@ -1,35 +0,0 @@
-$A+
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J+
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-E../../../../
-LNc:\borland\delphi4\Lib

87
Host/Source/MicroBoot/interfaces/uart/openblt_uart.dof
View File

@ -1,87 +0,0 @@
[Compiler]
A=1
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=1
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=../../../../
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
[Version Info]
IncludeVerInfo=0
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1031
CodePage=1252
[Version Info Keys]
CompanyName=
FileDescription=
FileVersion=1.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=1.0.0.0
Comments=
[Excluded Packages]
$(DELPHI)\Lib\dclusr40.bpl=Borland User
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[HistoryLists\hlOutputDirectorry]
Count=2
Item0=../../../../
Item1=../../../

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

@ -51,8 +51,7 @@ uses
XcpLoader in '..\XcpLoader.pas',
XcpTransport in 'XcpTransport.pas',
XcpSettings in 'XcpSettings.pas' {XcpSettingsForm},
CPDrv in 'CPDrv.pas';
CPort in 'CPort.pas';
//***************************************************************************************
// Global Constants
@ -224,7 +223,7 @@ begin
end;
// update the log
MbiCallbackOnLog(logStr);
MbiCallbackOnLog(ShortString(logStr));
// update loop variables
len := len - currentWriteCnt;
@ -258,25 +257,25 @@ begin
// connect the transport layer
MbiCallbackOnInfo('Connecting to the COM port.');
MbiCallbackOnLog('Connecting to the COM port. t='+TimeToStr(Time));
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='+TimeToStr(Time));
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='+TimeToStr(Time));
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='+TimeToStr(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;
@ -296,7 +295,7 @@ begin
// 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='+TimeToStr(Time));
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;
@ -311,7 +310,7 @@ begin
end;
// still here so programming session was started
MbiCallbackOnLog('Programming session started. t='+TimeToStr(Time));
MbiCallbackOnLog('Programming session started. t='+ShortString(TimeToStr(Time)));
// create the datafile object
datafile := TXcpDataFile.Create(progfile);
@ -336,16 +335,16 @@ begin
datafile.GetRegionInfo(regionCnt, addr, len);
// erase the memory
MbiCallbackOnLog('Clearing Memory '+Format('addr:0x%x,len:0x%x',[addr,len])+'. t='+TimeToStr(Time));
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 ('+errorInfo+'). t='+TimeToStr(Time));
MbiCallbackOnError('Could not clear memory ('+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='+TimeToStr(Time));
MbiCallbackOnLog('Memory cleared. t='+ShortString(TimeToStr(Time)));
end;
//---------------- next program the memory regions ------------------------------------
@ -369,18 +368,18 @@ begin
if currentWriteCnt = 0 then currentWriteCnt := kMaxProgLen;
// program the data
MbiCallbackOnLog('Programming Data '+Format('addr:0x%x,len:0x%x',[addr,currentWriteCnt])+'. t='+TimeToStr(Time));
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 ('+errorInfo+'). t='+TimeToStr(Time));
MbiCallbackOnError('Could not program data ('+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='+TimeToStr(Time));
MbiCallbackOnLog('Data Programmed. t='+ShortString(TimeToStr(Time)));
// update progress
progress := progress + currentWriteCnt;
@ -392,30 +391,29 @@ begin
bufferOffset := bufferOffset + currentWriteCnt;
// update the user info
MbiCallbackOnInfo('Programming data... ' + Format('(%.1n of %.1n Kbytes)',[(progress/1024), dataSizeKB]));
MbiCallbackOnInfo('Programming data... ' + ShortString(Format('(%.1n of %.1n Kbytes)',[(progress/1024), dataSizeKB])));
end;
end;
//---------------- stop the programming session ---------------------------------------
MbiCallbackOnLog('Stopping the programming session. t='+TimeToStr(Time));
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 ('+errorInfo+'). t='+TimeToStr(Time));
MbiCallbackOnError('Could not stop the programming session ('+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='+TimeToStr(Time));
MbiCallbackOnLog('Programming session stopped. t='+ShortString(TimeToStr(Time)));
// all done so set progress to 100% and finish up
progress := datafile.GetDataCnt;
datafile.Free;
MbiCallbackOnProgress(progress);
MbiCallbackOnLog('File successfully downloaded t='+TimeToStr(Time));
MbiCallbackOnLog('File successfully downloaded t='+ShortString(TimeToStr(Time)));
MbiCallbackOnDone;
end; //*** end of OnTimeout ***
@ -477,7 +475,7 @@ begin
timer.Enabled := True;
// store the program's filename
progfile := fileName;
progfile := String(fileName);
end; //*** end of MbiStart ***
@ -495,7 +493,7 @@ begin
stopRequest := true;
// disconnect the transport layer
MbiCallbackOnLog('Disconnecting the transport layer. t='+TimeToStr(Time));
MbiCallbackOnLog('Disconnecting the transport layer. t='+ShortString(TimeToStr(Time)));
loader.Disconnect;
end; //*** end of MbiStop ***
@ -614,15 +612,15 @@ end; //*** end of MbiConfigure ***
//***************************************************************************************
exports
//--- begin of don't change ---
MbiInit index 1,
MbiStart index 2,
MbiStop index 3,
MbiDeInit index 4,
MbiName index 5,
MbiDescription index 6,
MbiVersion index 7,
MbiConfigure index 8,
MbiVInterface index 9;
MbiInit,
MbiStart,
MbiStop,
MbiDeInit,
MbiName,
MbiDescription,
MbiVersion,
MbiConfigure,
MbiVInterface;
//--- end of don't change ---
end.

120
Host/Source/MicroBoot/interfaces/uart/openblt_uart.dproj Normal file
View File

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

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

@ -89,7 +89,7 @@ external DLL_Name;
//***************************************************************************************
// NAME: UblDllTransmit
// 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.
@ -104,7 +104,7 @@ external DLL_Name;
//***************************************************************************************
// NAME: UblDllReceive
// 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.

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

Binary file not shown.

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

@ -36,7 +36,7 @@ interface
//***************************************************************************************
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, ExtCtrls, IniFiles;
StdCtrls, ComCtrls, ExtCtrls, IniFiles, Vcl.Imaging.pngimage;
//***************************************************************************************
@ -102,7 +102,8 @@ implementation
procedure TXcpSettingsForm.btnOKClick(Sender: TObject);
begin
ModalResult := mrOK;
end; //*** end of btnOKClick ***
end;
//*** end of btnOKClick ***
//***************************************************************************************

35
Host/Source/MicroBoot/interfaces/usb/openblt_usb.cfg
View File

@ -1,35 +0,0 @@
-$A+
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J+
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-E.\..\..\..\..\
-LNc:\borland\delphi4\Lib

87
Host/Source/MicroBoot/interfaces/usb/openblt_usb.dof
View File

@ -1,87 +0,0 @@
[Compiler]
A=1
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=1
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=.\..\..\..\..\
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
[Version Info]
IncludeVerInfo=0
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1031
CodePage=1252
[Version Info Keys]
CompanyName=
FileDescription=
FileVersion=1.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=1.0.0.0
Comments=
[Excluded Packages]
$(DELPHI)\Lib\dclusr40.bpl=Borland User
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[HistoryLists\hlOutputDirectorry]
Count=2
Item0=.\..\..\..\..\
Item1=.\..\..\..\

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

@ -224,7 +224,7 @@ begin
end;
// update the log
MbiCallbackOnLog(logStr);
MbiCallbackOnLog(ShortString(logStr));
// update loop variables
len := len - currentWriteCnt;
@ -258,14 +258,14 @@ begin
// connect the transport layer
MbiCallbackOnInfo('Connecting to target via USB.');
MbiCallbackOnLog('Connecting to target via USB. t='+TimeToStr(Time));
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='+TimeToStr(Time));
MbiCallbackOnLog('Retrying transport layer connection. Reset your target if this takes a long time. t='+TimeToStr(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
@ -281,14 +281,14 @@ begin
end;
//---------------- start the programming session --------------------------------------
MbiCallbackOnLog('Starting the programming session. t='+TimeToStr(Time));
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='+TimeToStr(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;
@ -300,7 +300,7 @@ begin
// 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='+TimeToStr(Time));
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;
@ -315,7 +315,7 @@ begin
end;
// still here so programming session was started
MbiCallbackOnLog('Programming session started. t='+TimeToStr(Time));
MbiCallbackOnLog('Programming session started. t='+ShortString(TimeToStr(Time)));
// create the datafile object
datafile := TXcpDataFile.Create(progfile);
@ -340,16 +340,16 @@ begin
datafile.GetRegionInfo(regionCnt, addr, len);
// erase the memory
MbiCallbackOnLog('Clearing Memory '+Format('addr:0x%x,len:0x%x',[addr,len])+'. t='+TimeToStr(Time));
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 ('+errorInfo+'). t='+TimeToStr(Time));
MbiCallbackOnError('Could not clear memory ('+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='+TimeToStr(Time));
MbiCallbackOnLog('Memory cleared. t='+ShortString(TimeToStr(Time)));
end;
//---------------- next program the memory regions ------------------------------------
@ -373,18 +373,18 @@ begin
if currentWriteCnt = 0 then currentWriteCnt := kMaxProgLen;
// program the data
MbiCallbackOnLog('Programming Data '+Format('addr:0x%x,len:0x%x',[addr,currentWriteCnt])+'. t='+TimeToStr(Time));
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 ('+errorInfo+'). t='+TimeToStr(Time));
MbiCallbackOnError('Could not program data ('+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='+TimeToStr(Time));
MbiCallbackOnLog('Data Programmed. t='+ShortString(TimeToStr(Time)));
// update progress
progress := progress + currentWriteCnt;
@ -396,28 +396,28 @@ begin
bufferOffset := bufferOffset + currentWriteCnt;
// update the user info
MbiCallbackOnInfo('Programming data... ' + Format('(%.1n of %.1n Kbytes)',[(progress/1024), dataSizeKB]));
MbiCallbackOnInfo('Programming data... ' + ShortString(Format('(%.1n of %.1n Kbytes)',[(progress/1024), dataSizeKB])));
end;
end;
//---------------- stop the programming session ---------------------------------------
MbiCallbackOnLog('Stopping the programming session. t='+TimeToStr(Time));
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 ('+errorInfo+'). t='+TimeToStr(Time));
MbiCallbackOnError('Could not stop the programming session ('+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='+TimeToStr(Time));
MbiCallbackOnLog('Programming session stopped. t='+ShortString(TimeToStr(Time)));
// all done so set progress to 100% and finish up
progress := datafile.GetDataCnt;
datafile.Free;
MbiCallbackOnProgress(progress);
MbiCallbackOnLog('File successfully downloaded t='+TimeToStr(Time));
MbiCallbackOnLog('File successfully downloaded t='+ShortString(TimeToStr(Time)));
MbiCallbackOnDone;
end; //*** end of OnTimeout ***
@ -481,7 +481,7 @@ begin
timer.Enabled := True;
// store the program's filename
progfile := fileName;
progfile := String(fileName);
end; //*** end of MbiStart ***
@ -499,7 +499,7 @@ begin
stopRequest := true;
// disconnect the transport layer
MbiCallbackOnLog('Disconnecting the transport layer. t='+TimeToStr(Time));
MbiCallbackOnLog('Disconnecting the transport layer. t='+ShortString(TimeToStr(Time)));
loader.Disconnect;
end; //*** end of MbiStop ***
@ -618,16 +618,15 @@ end; //*** end of MbiConfigure ***
//***************************************************************************************
exports
//--- begin of don't change ---
MbiInit index 1,
MbiStart index 2,
MbiStop index 3,
MbiDeInit index 4,
MbiName index 5,
MbiDescription index 6,
MbiVersion index 7,
MbiConfigure index 8,
MbiVInterface index 9;
MbiInit,
MbiStart,
MbiStop,
MbiDeInit,
MbiName,
MbiDescription,
MbiVersion,
MbiConfigure,
MbiVInterface;
//--- end of don't change ---
end.
//********************************** end of openblt_usb.dpr *****************************

120
Host/Source/MicroBoot/interfaces/usb/openblt_usb.dproj Normal file
View File

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

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

@ -148,7 +148,7 @@ end; //*** end of Create ***
//***************************************************************************************
destructor TMicroBootInterface.Destroy;
begin
if FLibraryHandle = 0 then //##Vg shouldn't this be <> 0?
if FLibraryHandle <> 0 then
begin
FreeLibrary(FLibraryHandle); // release the handle
end;

BIN
Host/openblt_can_peak.dll
View File

Binary file not shown.

2
Host/openblt_can_peak.ini
View File

@ -1,7 +1,7 @@
[can]
hardware=0
channel=0
baudrate=500
baudrate=2
extended=0
txid=1639
rxid=2017

BIN
Host/openblt_can_vector.dll
View File

Binary file not shown.

15
Host/openblt_can_vector.ini
View File

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

BIN
Host/openblt_net.dll
View File

Binary file not shown.

3
Host/openblt_net.ini
View File

@ -1,7 +1,6 @@
[net]
hostname=169.254.19.63
hostname=192.168.178.38
port=1000
retry=1
[xcp]
seedkey=FeaserKey.dll
t1=1000

BIN
Host/openblt_uart.dll
View File

Binary file not shown.

2
Host/openblt_uart.ini
View File

@ -1,5 +1,5 @@
[sci]
port=2
port=7
baudrate=8
[xcp]
seedkey=FeaserKey.dll

BIN
Host/openblt_usb.dll
View File

Binary file not shown.

BIN
Host/vcand32.dll
View File

Binary file not shown.