unit ToolsCan; interface uses Windows, extctrls, {VarVar,} slcan, Messages, SysUtils, Variants, Classes, Graphics, Controls, Dialogs, StdCtrls, ComCtrls, Registry; type tCanMsgStruct = Record m_dwID : DWORD; // CAN identifier m_bFF : BYTE; // CAN frame format m_bDLC : BYTE; // CAN data length code m_bData : array[1..8] of BYTE; // CAN data m_dwTime : DWORD; // Receipt time in ms end; procedure OpenSlavna(speedcancode, select_port:integer); procedure CloseSlavna(); procedure InitSlavnaDll(); function ReadMessageCanID(timerc:Integer):Integer; procedure FreeSlavnaDll(); procedure SetFilterIDCan(m_dwID : DWORD); function WriteMessageCanID(cb:integer; var outstr:string):Integer; var arrspeedcan : array [0..4] of Word = (SLCAN_BR_100K,SLCAN_BR_CIA_125K,SLCAN_BR_CIA_250K,SLCAN_BR_CIA_500K,SLCAN_BR_CIA_1000K); //can devicecount:longword; hDevice:TSlCanDevice; br:TSlCanBitRate; OutMsg:TSlCanMessage; OutMsgArr:array[0..100] of TSlCanMessage; // InMsg:array [0..99] of TSlCanMessage; CanInitedDLL : Boolean = False; CanOpened : Boolean = False; InMsgCan : array [0..60000] of TSlCanMessage; InEventCan : array [0..60000] of TSlCanEvent; InEventCanTime : array [0..60000] of Longword; ReadCountCan:longword; ArrCanMessage : array [0..60000] of tCanMsgStruct; ArrCanMessageSend : array [0..30] of tCanMsgStruct; CanMessageTransmit : tCanMsgStruct; FilterIDCAN : DWORD = 0; TimePauseCanIn : longword; implementation procedure SetFilterIDCan(m_dwID : DWORD); begin FilterIDCAN := m_dwID; end; function WriteMessageCanID(cb:integer; var outstr:string):Integer ; const cTxStatus:array [0..7] of string =('OK','TimeOut','BusOff','Abort','Disable','One shot error','Invalid mode','Unknown'); var i : Integer; WriteStatus:byte; WriteCount:Integer; b: Boolean; begin for i:=0 to cb-1 do begin OutMsg.ID:=ArrCanMessageSend[i].m_dwID; OutMsg.Info:=SLCAN_MES_INFO_EXT; OutMsg.DataCount:= ArrCanMessageSend[0].m_bDLC; //8; OutMsg.Data[0]:=ArrCanMessageSend[i].m_bData[1]; OutMsg.Data[1]:=ArrCanMessageSend[i].m_bData[2]; OutMsg.Data[2]:=ArrCanMessageSend[i].m_bData[3]; OutMsg.Data[3]:=ArrCanMessageSend[i].m_bData[4]; OutMsg.Data[4]:=ArrCanMessageSend[i].m_bData[5]; OutMsg.Data[5]:=ArrCanMessageSend[i].m_bData[6]; OutMsg.Data[6]:=ArrCanMessageSend[i].m_bData[7]; OutMsg.Data[7]:=ArrCanMessageSend[i].m_bData[8]; OutMsgArr[i]:=OutMsg; end; if (SlCan_DeviceWriteMessages(hDevice,@OutMsgArr,cb,@WriteStatus)) then begin if WriteStatus > 7 then WriteStatus:=7; if WriteStatus = 0 then outstr:=Format('Status CAN = %s.',[cTxStatus[0]]) else outstr:=Format('Status CAN = %s.',[cTxStatus[WriteStatus]]) end else begin outstr:=' Transmit error'; result:= 7; end; result:= WriteStatus; { for i:=0 to cb-1 do begin OutMsg.ID:=ArrCanMessageSend[i].m_dwID; OutMsg.Info:=SLCAN_MES_INFO_EXT; OutMsg.DataCount:= 8; OutMsg.Data[0]:=ArrCanMessageSend[i].m_bData[1]; OutMsg.Data[1]:=ArrCanMessageSend[i].m_bData[2]; OutMsg.Data[2]:=ArrCanMessageSend[i].m_bData[3]; OutMsg.Data[3]:=ArrCanMessageSend[i].m_bData[4]; OutMsg.Data[4]:=ArrCanMessageSend[i].m_bData[5]; OutMsg.Data[5]:=ArrCanMessageSend[i].m_bData[6]; OutMsg.Data[6]:=ArrCanMessageSend[i].m_bData[7]; OutMsg.Data[7]:=ArrCanMessageSend[i].m_bData[8]; b:=SlCan_DeviceWriteMessages(hDevice,@OutMsg,1,@WriteStatus); if (not b) then begin result:=-1; exit ; end; // Проверим статус передачи if (WriteStatus<>SLCAN_TX_STATUS_OK) then begin result:=-2; exit; end; end; result := 0; } end; function ReadMessageCanID(timerc:Integer):Integer ; var b:longbool; k ,i , can1, can_error, can2 : Integer; deltat : Longword; begin can_error:=0; TimePauseCanIn:=0; if CanOpened then begin for i:=0 to 60000-1 do begin InEventCanTime[i]:=0; end; // if (SlCan_DeviceSetStartTimeStamp(hDevice, 0)=False) then // exit; // b:=SlCan_DeviceReadMessages(hDevice,timerc,@InMsgCan,60000,@ReadCountCan); // b:=SlCan_DeviceReadEvents(hDevice,timerc,@InEventCan,60000,@ReadCountCan); b:=SlCan_DeviceReadEvents(hDevice,timerc,@InEventCan,1000,@ReadCountCan); if (not b) then begin // CanMessage.m_dwID := 0; result:=0; // exit; end; if (ReadCountCan>0 ) then begin can1:=0; can2:=0; for i:=0 to ReadCountCan-1 do begin if (InEventCan[i].EventType=0) then begin InMsgCan[can1] := InEventCan[i].Msg; deltat:=0; if (i>0) then deltat:=InEventCan[i].TimeStampLo - InEventCan[i-1].TimeStampLo else deltat:=0; inc(can1); if (deltat<>0) then begin InEventCanTime[can2]:= deltat; inc(can2); if (TimePauseCanIn0) and ((InMsgCan[i].ID=FilterIDCAN) or (InMsgCan[i].ID=(FilterIDCAN+$01)) )) or (FilterIDCAN=0) then begin ArrCanMessage[k].m_dwID := InMsgCan[i].ID; ArrCanMessage[k].m_bDLC := InMsgCan[i].DataCount; ArrCanMessage[k].m_bData[1] := InMsgCan[i].Data[0]; ArrCanMessage[k].m_bData[2] := InMsgCan[i].Data[1]; ArrCanMessage[k].m_bData[3] := InMsgCan[i].Data[2]; ArrCanMessage[k].m_bData[4] := InMsgCan[i].Data[3]; ArrCanMessage[k].m_bData[5] := InMsgCan[i].Data[4]; ArrCanMessage[k].m_bData[6] := InMsgCan[i].Data[5]; ArrCanMessage[k].m_bData[7] := InMsgCan[i].Data[6]; ArrCanMessage[k].m_bData[8] := InMsgCan[i].Data[7]; Inc(k); end else begin end; end; result:=k; // InMsg. // Writeln(Format('read %d messages',[ReadCount])); end else begin // CanMessage.m_dwID := 0; result:=0; end; { k:=0; for i:=0 to ReadCountCan-1 do begin if ((FilterIDCAN>0) and ((InMsgCan[i].ID=FilterIDCAN) or (InMsgCan[i].ID=(FilterIDCAN+$01)) )) or (FilterIDCAN=0) then begin ArrCanMessage[k].m_dwID := InMsgCan[i].ID; ArrCanMessage[k].m_bData[1] := InMsgCan[i].Data[0]; ArrCanMessage[k].m_bData[2] := InMsgCan[i].Data[1]; ArrCanMessage[k].m_bData[3] := InMsgCan[i].Data[2]; ArrCanMessage[k].m_bData[4] := InMsgCan[i].Data[3]; ArrCanMessage[k].m_bData[5] := InMsgCan[i].Data[4]; ArrCanMessage[k].m_bData[6] := InMsgCan[i].Data[5]; ArrCanMessage[k].m_bData[7] := InMsgCan[i].Data[6]; ArrCanMessage[k].m_bData[8] := InMsgCan[i].Data[7]; Inc(k); end else begin end; end; result:=k; // InMsg. // Writeln(Format('read %d messages',[ReadCount])); end else begin // CanMessage.m_dwID := 0; result:=0; end; } end else Result:=0; if (can_error>100) then result:=1; end; procedure InitSlavnaDll(); var b:longbool; begin // Загрузим библиотеку. Необходимо это сделать один раз // до вызова любой другой функции библиотеки. CanInitedDLL:=SlCan_Load(nil,nil); end; procedure FreeSlavnaDll(); var b:longbool; begin // Загрузим библиотеку. Необходимо это сделать один раз // до вызова любой другой функции библиотеки. SlCan_Free(False); CanInitedDLL:=False; end; procedure OpenSlavna(speedcancode,select_port:integer); var b:longbool; begin if (not CanInitedDLL) then exit; if CanOpened then Exit; // Выясним, сколько устройств доступно devicecount:= SlCan_GetDeviceCount(); if (devicecount=0) or (devicecount=INVALID_HANDLE_VALUE) or (devicecount=INVALID_HANDLE_VALUE-1) then exit; if (select_port>1) then begin if (select_port>devicecount) then select_port:=devicecount; end else select_port:=1; // Получим ссылку на первое устройство hDevice:= SlCan_GetDevice(select_port-1); if (hDevice=INVALID_HANDLE_VALUE) then exit; // Откроем устройство. b:= SlCan_DeviceOpen(hDevice); if (not b) then exit; // При открытии устройства устанавливается максимально возможная // скорость передачи. Но мы установим 125kb/s br.BRP:=arrspeedcan[speedcancode]; b:=SlCan_DeviceSetBitRate(hDevice,@br); if (not b) then exit; b:= SlCan_DeviceSetEventLevel(hDevice,SLCAN_EVT_LEVEL_TIME_STAMP); if (not b) then exit; // Установим режим SLCAN_MODE_NORMAL b:= SlCan_DeviceSetMode(hDevice,SLCAN_MODE_NORMAL); if (not b) then exit; b:= SlCan_DeviceSetTXTimeOut(hDevice,100); if (not b) then exit; CanOpened:=True; end; procedure CloseSlavna(); var b:longbool; begin { // Выясним, сколько устройств доступно devicecount:= SlCan_GetDeviceCount(); if (devicecount=0) then exit; // Получим ссылку на первое устройство hDevice:= SlCan_GetDevice(0); } if (hDevice=INVALID_HANDLE_VALUE) then exit; // Закроем устройство. b:= SlCan_DeviceClose(hDevice); if (not b) then exit; CanOpened := False; { // При открытии устройства устанавливается максимально возможная // скорость передачи. Но мы установим 125kb/s br.BRP:=speedcan[rgBaudCAN.ItemIndex]; b:=SlCan_DeviceSetBitRate(hDevice,@br); if (not b) then exit; // Установим режим SLCAN_MODE_NORMAL b:= SlCan_DeviceSetMode(hDevice,SLCAN_MODE_NORMAL); if (not b) then exit; } end; end.