unit mainunit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, sockets, baseunix, can, linux;
type
{ TFCANTest }
TFCANTest = class(TForm)
bInitcan0: TButton;
bSendData: TButton;
bReceiveData: TButton;
BClosecan0: TButton;
bEpollCreate: TButton;
bEpollQuery: TButton;
mLog: TMemo;
mLogTest: TMemo;
STnum_events: TStaticText;
STevents_pending: TStaticText;
StaticText3: TStaticText;
StaticText4: TStaticText;
procedure BClosecan0Click(Sender: TObject);
procedure bEpollCreateClick(Sender: TObject);
procedure bEpollQueryClick(Sender: TObject);
procedure bInitcan0Click(Sender: TObject);
procedure bReceiveDataClick(Sender: TObject);
procedure bSendDataClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
procedure Addmessages(mess2show: string);
public
end;
const
AF_CAN = 29;
PF_CAN = 29;
CANDevice ='can0';
type
if_info = record
s : integer;
cmdlinename : ^byte;
dropcnt,
last_dropcnt : uint32;
end;
{
type
EPoll_Data = record
case integer of
0: (ptr: pointer);
1: (fd: cint);
2: (u32: cuint);
3: (u64: cuint64);
end;
TEPoll_Data = Epoll_Data;
PEPoll_Data = ^Epoll_Data;
EPoll_Event = record
Events: cuint32;
Data : TEpoll_Data;
end;
TEPoll_Event = Epoll_Event;
PEpoll_Event = ^Epoll_Event;
}
var
FCANTest : TFCANTest;
sock_info : if_info;
events_pending : EPoll_Event;
event_setup : EPoll_Event;
Pevent_Setup : PEPoll_Event;
PPoll_Event : PEPoll_Event;
fd_epoll,
num_events,
currmax : integer;
s: cint;
addr: sockaddr_can;
ifr: ifreq;
frame: can_frame;
timeout_ms : integer; //* default to no timeout */
implementation
{$R *.lfm}
{ TFCANTest }
procedure TFCANTest.Addmessages(mess2show: string);
begin
mLogtest.Lines.BeginUpdate;
mLogtest.Lines.Add(mess2show);
mLogtest.Lines.EndUpdate;
mLogtest.SelStart := Length(mLogtest.Lines.Text)-1;
mLogtest.SelLength:=0;
end;
procedure TFCANTest.FormCreate(Sender: TObject);
begin
currmax :=16; // number of CAN devices
event_setup.events :=EPOLLIN;
Pevent_Setup :=@(event_setup);
PPoll_event :=@(events_pending);
timeout_ms :=10;
bInitcan0.caption :=bInitcan0.caption + ' ' + CANDevice;
bClosecan0.caption :=bclosecan0.caption + ' ' + CANDevice;
end;
procedure TFCANTest.bInitcan0Click(Sender: TObject);
var
perror : string;
begin
s := fpsocket(PF_CAN, SOCK_RAW, CAN_RAW);
if s < 0 then
begin
perror:='socket creation error';
mLog.Lines.Add(perror);
Addmessages(perror);
Exit;
end else begin
mLog.Lines.Add('Socket: '+inttostr(s));
Addmessages('Socket: '+inttostr(s));
end;
strcopy(ifr.ifr_name, CANDevice);
if fpioctl(s, SIOCGIFINDEX, @ifr) < 0 then
begin
perror:='error IOctl';
mLog.Lines.Add(perror);
Addmessages(perror);
Exit;
end;
memset(@addr, 0, sizeof(addr));
addr.can_family := AF_CAN;
addr.can_ifindex := ifr.ifr_ifindex;
if fpbind(s, @addr, sizeof(addr)) < 0 then // if fpbind(s, Psockaddr(@addr), sizeof(addr)) < 0 then
begin
perror:='error bind';
mLog.Lines.Add(perror);
Addmessages(perror);
Exit;
end;
end;
procedure TFCANTest.bReceiveDataClick(Sender: TObject);
var
nbytes,
i : integer;
perror : string;
begin
nbytes := fpread(s, frame, sizeof(can_frame));
if nbytes < 0 then
begin
perror:='Error during Read';
mLog.Lines.Add(perror);
Addmessages(perror);
Exit;
end;
if nbytes < sizeof(can_frame) then // paranoid check
begin
perror:='Read: Incomplete CAN frame';
mLog.Lines.Add(perror);
Addmessages(perror);
Exit;
end;
Perror:=Format('0x%03X [%d] ', [frame.can_id and CAN_SFF_MASK, frame.can_dlc]);
for i := 0 to frame.can_dlc - 1 do
Perror:=Perror + Format('%02.2X ', [frame.data[i]]);
mLog.Lines.Add(perror);
Addmessages(perror);
end;
procedure TFCANTest.bSendDataClick(Sender: TObject);
var
perror : string;
psizef : integer;
begin
frame.can_id := $020; // CAN message ID
frame.can_dlc := 8; // payload length will be 8 bytes
frame.data[0] := $10;
frame.data[1] := $11;
frame.data[2] := $12;
frame.data[3] := $13;
frame.data[4] := $14;
frame.data[5] := $15;
frame.data[6] := $16;
frame.data[7] := $17;
psizef:= fpwrite(s, frame, sizeof(can_frame));
if psizef <> sizeof(can_frame) then
begin
perror:='error write ' + InttoStr(psizef);
mLog.Lines.Add(perror);
Addmessages(perror);
Exit;
end else begin
mLog.Lines.Add(InttoStr(psizef) + ' bytes written');
Addmessages(InttoStr(psizef) + ' bytes written');
end;
end;
procedure TFCANTest.BClosecan0Click(Sender: TObject);
var
perror : string;
begin
if fpclose(s) < 0 then
begin
perror:='error close socket ';
mLog.Lines.Add(perror);
Addmessages(perror);
Exit;
end;
if fpclose(fd_epoll) < 0 then
begin
perror:='error close epoll ';
mLog.Lines.Add(perror);
Addmessages(perror);
Exit;
end;
end;
procedure TFCANTest.bEpollCreateClick(Sender: TObject);
var
pepollerr : integer;
begin
fd_epoll := epoll_create(1);
if fd_epoll < 0 then begin
mLog.Lines.Add('epoll create error');
Addmessages('epoll create error');
Exit;
end;
pepollerr:= epoll_ctl(fd_epoll, EPOLL_CTL_ADD, s, pevent_setup);
if pepollerr< 0 then begin
mLog.Lines.Add(IntTostr(pepollerr)+ ' epoll add to socket error');
Addmessages(IntTostr(pepollerr)+ ' epoll add to socket error');
Exit;
end;
end;
procedure TFCANTest.bEpollQueryClick(Sender: TObject);
begin
num_events := epoll_wait(fd_epoll, PPoll_event, currmax, timeout_ms);
STnum_events.caption:= IntToStr(num_events);
STevents_pending.caption:=IntToStr(PPoll_event^.Events);
end;
end.