program ConsoleApplication;
{$mode delphi}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils, CustApp,
{ you can add units after this }
crt, { for the keypressed function }
sockets, baseunix, can; { for socketCAN support }
const
PF_CAN = 29; // Not defined in libraries yet.
AF_CAN = 29;
type
{ TMyApplication }
TMyApplication = class(TCustomApplication)
protected
procedure DoRun; override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure WriteHelp; virtual;
procedure perror(const S : string);
procedure MyApplicationMain;
end;
{ TMyApplication }
procedure TMyApplication.perror(const S : string);
begin
WriteLn(S, ', SocketError = ', SocketError);
end;
procedure TMyApplication.MyApplicationMain;
var
s, i, nbytes, err: cint;
addr: sockaddr_can;
ifr: ifreq;
frame: canfd_frame;
begin
// Writeln('Hello World from Console Application');
WriteLn('CAN Sockets Receive Demo Rev 0.1 Build 5');
// writeln('fpsocket call');
s := fpsocket(PF_CAN, SOCK_RAW, CAN_RAW);
if s < 0 then
begin
perror('Socket');
Exit;
end;
// writeln('fpioctl call');
strcopy(ifr.ifr_name, 'slcan0'); // ifr.ifr_name := 'vcan0' + #0;
if fpioctl(s, SIOCGIFINDEX, @ifr) < 0 then
begin
perror('IOctl');
Exit;
end;
// writeln('fpbind call');
memset(@addr, 0, sizeof(addr));
addr.can_family := AF_CAN;
addr.can_ifindex := ifr.ifr_ifindex;
if fpbind(s, @addr, sizeof(addr)) < 0 then
begin
perror('Bind');
Exit;
end;
while (not keypressed) do begin
// writeln('fpread call');
nbytes := fpread(s, frame, sizeof(frame));
if nbytes < 0 then
begin
perror('Read');
Exit;
end;
if nbytes = CANFD_MTU then // test CAN FD with 'cansend vcan0 123##1223344556677889900'
WriteLn('CAN FD frame received with length ', IntToStr(frame.len))
else if nbytes = CAN_MTU then // test Standard CAN with 'cansend vcan0 456#DEADBEEF'
// WriteLn('Standard CAN frame received with length ', IntToStr(frame.len))
write(ifr.ifr_name, ' ')
else
WriteLn('Invalid CAN(FD) frame received');
Write(Format('%03X [%d] ', [frame.can_id and CAN_EFF_MASK, frame.len]));
for i := 0 to frame.len - 1 do
Write(Format('%02.2X ', [frame.data[i]]));
WriteLn('');
end;
if fpclose(s) < 0 then
begin
perror('Close');
Exit;
end;
end;
procedure TMyApplication.DoRun;
var
ErrorMsg: String;
begin
// quick check parameters
ErrorMsg:=CheckOptions('h', 'help');
if ErrorMsg<>'' then begin
ShowException(Exception.Create(ErrorMsg));
Terminate;
Exit;
end;
// parse parameters
if HasOption('h', 'help') then begin
WriteHelp;
Terminate;
Exit;
end;
{ add your program here }
MyApplicationMain;
// stop program loop
Terminate;
end;
constructor TMyApplication.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
StopOnException:=True;
end;
destructor TMyApplication.Destroy;
begin
inherited Destroy;
end;
procedure TMyApplication.WriteHelp;
begin
{ add your help code here }
writeln('Usage: ', ExeName, ' -h');
end;
var
Application: TMyApplication;
begin
Application:=TMyApplication.Create(nil);
Application.Title:='My Application';
Application.Run;
Application.Free;
end.