424 lines
14 KiB
ObjectPascal
424 lines
14 KiB
ObjectPascal
unit XcpTransport;
|
|
//***************************************************************************************
|
|
// Description: XCP transport layer for CAN.
|
|
// File Name: XcpTransport.pas
|
|
//
|
|
//---------------------------------------------------------------------------------------
|
|
// C O P Y R I G H T
|
|
//---------------------------------------------------------------------------------------
|
|
// Copyright (c) 2017 by Feaser http://www.feaser.com All rights reserved
|
|
//
|
|
// This software has been carefully tested, but is not guaranteed for any particular
|
|
// purpose. The author does not offer any warranties and does not guarantee the accuracy,
|
|
// adequacy, or completeness of the software and is not responsible for any errors or
|
|
// omissions or the results obtained from use of the software.
|
|
//
|
|
//---------------------------------------------------------------------------------------
|
|
// L I C E N S E
|
|
//---------------------------------------------------------------------------------------
|
|
// This file is part of OpenBLT. OpenBLT is free software: you can redistribute it and/or
|
|
// modify it under the terms of the GNU General Public License as published by the Free
|
|
// Software Foundation, either version 3 of the License, or (at your option) any later
|
|
// version.
|
|
//
|
|
// OpenBLT is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
|
|
// without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
|
|
// PURPOSE. See the GNU General Public License for more details.
|
|
//
|
|
// You have received a copy of the GNU General Public License along with OpenBLT. It
|
|
// should be located in ".\Doc\license.html". If not, contact Feaser to obtain a copy.
|
|
//
|
|
//***************************************************************************************
|
|
interface
|
|
|
|
|
|
//***************************************************************************************
|
|
// Includes
|
|
//***************************************************************************************
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Forms, IniFiles, canlib;
|
|
|
|
|
|
//***************************************************************************************
|
|
// Global Constants
|
|
//***************************************************************************************
|
|
// a CAN message can only have up to 8 bytes
|
|
const kMaxPacketSize = 8;
|
|
|
|
|
|
//***************************************************************************************
|
|
// Type Definitions
|
|
//***************************************************************************************
|
|
type
|
|
TKvaserHardware = ( KVASER_LEAFLIGHT_V2 = $01 );
|
|
|
|
TXcpTransport = class(TObject)
|
|
private
|
|
packetTxId : LongWord;
|
|
packetRxId : LongWord;
|
|
extendedId : Boolean;
|
|
kvaserHandle : canHandle;
|
|
canHardware : TKvaserHardware; { KVASER_xxx }
|
|
canChannel : Word; { currently supported is 1..1 }
|
|
canBaudrate : LongWord; { in bits/sec }
|
|
connected : Boolean;
|
|
public
|
|
packetData : array[0..kMaxPacketSize-1] of Byte;
|
|
packetLen : Word;
|
|
constructor Create;
|
|
procedure Configure(iniFile : string);
|
|
function Connect: Boolean;
|
|
function SendPacket(timeOutms: LongWord): Boolean;
|
|
function IsComError: Boolean;
|
|
procedure Disconnect;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
//***************************************************************************************
|
|
// NAME: Create
|
|
// PARAMETER: none
|
|
// RETURN VALUE: none
|
|
// DESCRIPTION: Class constructore
|
|
//
|
|
//***************************************************************************************
|
|
constructor TXcpTransport.Create;
|
|
begin
|
|
// call inherited constructor
|
|
inherited Create;
|
|
|
|
// reset the packet ids
|
|
packetTxId := 0;
|
|
packetRxId := 0;
|
|
// use standard id's by default
|
|
extendedId := false;
|
|
// reset packet length
|
|
packetLen := 0;
|
|
// disconnected by default
|
|
connected := false;
|
|
// invalidate the handle
|
|
kvaserHandle := canINVALID_HANDLE;
|
|
// initialize the library
|
|
canInitializeLibrary;
|
|
end; //*** end of Create ***
|
|
|
|
|
|
//***************************************************************************************
|
|
// NAME: Destroy
|
|
// PARAMETER: none
|
|
// RETURN VALUE: none
|
|
// DESCRIPTION: Class destructor
|
|
//
|
|
//***************************************************************************************
|
|
destructor TXcpTransport.Destroy;
|
|
begin
|
|
// unload the library
|
|
canUnloadLibrary;
|
|
// call inherited destructor
|
|
inherited;
|
|
end; //*** end of Destroy ***
|
|
|
|
|
|
//***************************************************************************************
|
|
// NAME: Configure
|
|
// PARAMETER: filename of the INI
|
|
// RETURN VALUE: none
|
|
// DESCRIPTION: Configures both this class from the settings in the INI.
|
|
//
|
|
//***************************************************************************************
|
|
procedure TXcpTransport.Configure(iniFile : string);
|
|
var
|
|
settingsIni : TIniFile;
|
|
baudrateIdx : Integer;
|
|
const
|
|
baudrateLookupTable : array[0..7] of LongWord =
|
|
(
|
|
// list baudrates in the same order as they appear in the combobox on the settings
|
|
// form. this way the combobox's ItemIndex property can be used as an indexer to this
|
|
// array.
|
|
1000000, 500000, 250000, 125000, 100000, 83333, 50000, 10000
|
|
);
|
|
begin
|
|
// read XCP configuration from INI
|
|
if FileExists(iniFile) then
|
|
begin
|
|
// create ini file object
|
|
settingsIni := TIniFile.Create(iniFile);
|
|
|
|
// set hardware configuration
|
|
case settingsIni.ReadInteger('can', 'hardware', 0) of
|
|
0: canHardware := KVASER_LEAFLIGHT_V2;
|
|
else
|
|
canHardware := KVASER_LEAFLIGHT_V2;
|
|
end;
|
|
// set channel configuration
|
|
canChannel := settingsIni.ReadInteger('can', 'channel', 0) + 1;
|
|
// set baudrate configuration
|
|
baudrateIdx := settingsIni.ReadInteger('can', 'baudrate', 1);
|
|
canBaudrate := 500000;
|
|
if (baudrateIdx >= 0) and (baudrateIdx < Length(baudrateLookupTable)) then
|
|
canBaudrate := baudrateLookupTable[baudrateIdx];
|
|
// set message configuration
|
|
packetTxId := settingsIni.ReadInteger('can', 'txid', $667);
|
|
packetRxId := settingsIni.ReadInteger('can', 'rxid', $7e1);
|
|
extendedId := settingsIni.ReadBool('can', 'extended', false);
|
|
|
|
// release ini file object
|
|
settingsIni.Free;
|
|
end;
|
|
end; //*** end of Configure ***
|
|
|
|
|
|
//***************************************************************************************
|
|
// NAME: Connect
|
|
// PARAMETER: none
|
|
// RETURN VALUE: True if successful, False otherwise.
|
|
// DESCRIPTION: Connects the transport layer device.
|
|
//
|
|
//***************************************************************************************
|
|
function TXcpTransport.Connect: Boolean;
|
|
var
|
|
openFlags: Integer;
|
|
frequency: Integer;
|
|
begin
|
|
// init result value
|
|
result := false;
|
|
|
|
// disconnect first if still connected
|
|
if connected then
|
|
Disconnect;
|
|
|
|
// the current version only supports the leaf light v2
|
|
if canHardware = KVASER_LEAFLIGHT_V2 then
|
|
begin
|
|
// open the CAN channel if valid
|
|
if canChannel > 0 then
|
|
begin
|
|
// set the open flags
|
|
openFlags := canOPEN_REQUIRE_INIT_ACCESS;
|
|
if extendedId then
|
|
begin
|
|
openFlags := openFlags or canOPEN_REQUIRE_EXTENDED;
|
|
end;
|
|
kvaserHandle := canOpenChannel(canChannel - 1, openFlags);
|
|
// only continue if the channel was opened and the handle is not valid
|
|
if kvaserHandle >= 0 then
|
|
begin
|
|
case canBaudrate of
|
|
1000000: frequency := canBITRATE_1M;
|
|
500000: frequency := canBITRATE_500K;
|
|
250000: frequency := canBITRATE_250K;
|
|
125000: frequency := canBITRATE_125K;
|
|
100000: frequency := canBITRATE_100K;
|
|
83333: frequency := canBITRATE_83K;
|
|
50000: frequency := canBITRATE_50K;
|
|
10000: frequency := canBITRATE_10K;
|
|
else
|
|
frequency := canBITRATE_500K;
|
|
end;
|
|
// configure the baudrate
|
|
if canSetBusParams(kvaserHandle, frequency, 0, 0, 0, 0, 0) = canOK then
|
|
begin
|
|
// configure output control to the default normal mode
|
|
if canSetBusOutputControl(kvaserHandle, canDRIVER_NORMAL) = canOK then
|
|
begin
|
|
// go on the bus
|
|
if canBusOn(kvaserHandle) = canOK then
|
|
begin
|
|
// connection was established
|
|
connected := true;
|
|
result := true;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end; //*** end of Connect ***
|
|
|
|
|
|
//***************************************************************************************
|
|
// NAME: IsComError
|
|
// PARAMETER: none
|
|
// RETURN VALUE: True if in error state, False otherwise.
|
|
// DESCRIPTION: Determines if the communication interface is in an error state.
|
|
//
|
|
//***************************************************************************************
|
|
function TXcpTransport.IsComError: Boolean;
|
|
var
|
|
statusFlags: Cardinal;
|
|
begin
|
|
// init result to no error.
|
|
result := false;
|
|
|
|
// do not check if the handle is invalid
|
|
if kvaserHandle <= canINVALID_HANDLE then
|
|
begin
|
|
Exit;
|
|
end;
|
|
|
|
// check for bus off error or error passive if connected
|
|
if connected then
|
|
begin
|
|
if canReadStatus(kvaserHandle, statusFlags) = canOK then
|
|
begin
|
|
// check for bus off or error passive bits
|
|
if (statusFlags and (canSTAT_BUS_OFF or canSTAT_ERROR_PASSIVE)) > 0 then
|
|
begin
|
|
result := true;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
// could not read the status which is also an indicator that something is wrong
|
|
result := true
|
|
end;
|
|
end;
|
|
end; //*** end of IsComError ***
|
|
|
|
|
|
//***************************************************************************************
|
|
// NAME: SendPacket
|
|
// PARAMETER: the time[ms] allowed for the reponse from the slave to come in.
|
|
// RETURN VALUE: True if response received from slave, False otherwise
|
|
// DESCRIPTION: Sends the XCP packet using the data in 'packetData' and length in
|
|
// 'packetLen' and waits for the response to come in.
|
|
//
|
|
//***************************************************************************************
|
|
function TXcpTransport.SendPacket(timeOutms: LongWord): Boolean;
|
|
var
|
|
responseReceived: Boolean;
|
|
timeoutTime: DWORD;
|
|
txId: LongInt;
|
|
txData: array[0..kMaxPacketSize-1] of Byte;
|
|
txFlags: Cardinal;
|
|
rxId: LongInt;
|
|
rxData: array[0..kMaxPacketSize-1] of Byte;
|
|
rxFlags: Cardinal;
|
|
rxLen: Cardinal;
|
|
rxTime: Cardinal;
|
|
byteIdx: Byte;
|
|
status: canStatus;
|
|
idTypeOk: Boolean;
|
|
begin
|
|
// initialize the result value
|
|
result := false;
|
|
|
|
// do not send data when the packet length is invalid or when not connected
|
|
// to the CAN hardware
|
|
if (packetLen > kMaxPacketSize) or (not connected) then
|
|
begin
|
|
Exit;
|
|
end;
|
|
|
|
// do not send if the handle is invalid
|
|
if kvaserHandle <= canINVALID_HANDLE then
|
|
begin
|
|
Exit;
|
|
end;
|
|
|
|
// prepare the packet for transmission in a CAN message
|
|
txId := packetTxId;
|
|
for byteIdx := 0 to (packetLen - 1) do
|
|
begin
|
|
txData[byteIdx] := packetData[byteIdx];
|
|
end;
|
|
if extendedId then
|
|
txFlags := canMSG_EXT
|
|
else
|
|
txFlags := canMSG_STD;
|
|
|
|
// submit the packet for transmission via the CAN bus
|
|
if canWrite(kvaserHandle, txId, @txData[0], packetLen, txFlags) <> canOK then
|
|
begin
|
|
Exit;
|
|
end;
|
|
|
|
// reset flag and set the reception timeout time
|
|
responseReceived := false;
|
|
timeoutTime := GetTickCount + timeOutms;
|
|
|
|
// attempt to receive the packet response within the timeout time
|
|
repeat
|
|
// prepare message reception
|
|
rxId := packetRxId;
|
|
// attempt to read the packet response from the reception queue
|
|
status := canReadSpecificSkip(kvaserHandle, rxId, @rxData[0], rxLen, rxFlags, rxTime);
|
|
// check if an error was detected
|
|
if (status <> canOK) and (status <> canERR_NOMSG) then
|
|
begin
|
|
// error detected. stop loop.
|
|
Break;
|
|
end;
|
|
// no error, now check if a message was actually received
|
|
if status = canOK then
|
|
begin
|
|
// a message with the identifier of the response packet was received. now check
|
|
// that the identifier type also matches
|
|
idTypeOk := false;
|
|
if extendedId then
|
|
begin
|
|
if (rxFlags and canMSG_EXT) > 0 then
|
|
idTypeOk := true;
|
|
end
|
|
else
|
|
begin
|
|
if (rxFlags and canMSG_STD) > 0 then
|
|
idTypeOk := true;
|
|
end;
|
|
if idTypeOk then
|
|
begin
|
|
// response received. set flag
|
|
responseReceived := true;
|
|
end;
|
|
end;
|
|
// give the application a chance to use the processor
|
|
Application.ProcessMessages;
|
|
until (GetTickCount > timeoutTime) or (responseReceived);
|
|
|
|
// check if the response was correctly received
|
|
if responseReceived then
|
|
begin
|
|
// copy the received response packet
|
|
packetLen := rxLen;
|
|
for byteIdx := 0 to (packetLen - 1) do
|
|
begin
|
|
packetData[byteIdx] := rxData[byteIdx];
|
|
end;
|
|
// success
|
|
result := true;
|
|
end;
|
|
end; //*** end of SendPacket ***
|
|
|
|
|
|
//***************************************************************************************
|
|
// NAME: Disconnect
|
|
// PARAMETER: none
|
|
// RETURN VALUE: none
|
|
// DESCRIPTION: Disconnects the transport layer device.
|
|
//
|
|
//***************************************************************************************
|
|
procedure TXcpTransport.Disconnect;
|
|
begin
|
|
// disconnect CAN interface if connected
|
|
if connected then
|
|
begin
|
|
// only disconnect if the handle is valid
|
|
if kvaserHandle > canINVALID_HANDLE then
|
|
begin
|
|
// take the channel from the bus
|
|
canBusOff(kvaserHandle);
|
|
// close the channel
|
|
canClose(kvaserHandle);
|
|
end;
|
|
end;
|
|
kvaserHandle := canINVALID_HANDLE;
|
|
connected := false;
|
|
end; //*** end of Disconnect ***
|
|
|
|
end.
|
|
//******************************** end of XcpTransport.pas ******************************
|
|
|