This commit is contained in:
Dimas 2025-04-07 18:09:53 +03:00
parent 3853236e01
commit 8afa7b0ec6
22 changed files with 4160 additions and 0 deletions

BIN
CAN_Terminal.dcu Normal file

Binary file not shown.

BIN
CAN_Terminal.ddp Normal file

Binary file not shown.

345
CAN_Terminal.dfm Normal file
View File

@ -0,0 +1,345 @@
object CANTerminal: TCANTerminal
Left = 992
Top = 100
Width = 801
Height = 538
Caption = 'CANTerminal "Hunderitter" v.07.04.2025'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Icon.Data = {
0000010001002020100000000000E80200001600000028000000200000004000
0000010004000000000080020000000000000000000000000000000000000000
000000008000008000000080800080000000800080008080000080808000C0C0
C0000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000077788F000000087FF0008000000000
0077788F000000087FF000800000000000000000FFFFFFF00000778F00000000
00000000FFFFFFF00000778F000000000000FFFFFFFFFFFFF000778F00000000
0000FFFFFFFFFFFFF000778F000000000000FFFFFFFFFFFFF000778F00000000
00000FFFF000FFFF0000778F0000000000000FFFF000FFFF0000778F00000000
08FF000FF000FFF00000778F0000000008FF000FF000FFF00000778F00000000
78FF000000000000000BBB9BBB00000078FF000000000000000BBB9BBB000077
8F00000FF000FFF00007BBBF000000778F00000FF000FFF00007BBBF00000000
78FF0FFF00000FFF077888000000000078FF0FFF00000FFF0778880000000000
0888FFFFFFFFFFFF7888FF00000000000888FFFFFFFFFFFF7888FF0000000000
00778FFFFFFFFFFF888000000000000000778FF00000000F8880000000000000
00778F0077788F0088800000000000000000000777788FF00000000000000000
0000000777788FF000000000000000000000000770088FF00000000000000000
0000000770088FF0000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000FFFF
FFFFF80780CFF80780CFF800000FF800000FFC000003FC000003FC000003FC00
0003FC000003F8000603F8000603F0000003F0000003C0600E01C0600E018080
000380800003C000000FC000000FF000001FF000001FF80000FFF80000FFF800
00FFFC0001FFFC0001FFFF800FFFFF800FFFFF800FFFFF800FFFFFFFFFFF}
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object RxLabel1: TRxLabel
Left = 245
Top = 440
Width = 39
Height = 13
Caption = 'CAN on'
end
object ProjectBox: TComboBox
Left = 10
Top = 20
Width = 150
Height = 21
ItemHeight = 13
TabOrder = 0
Text = 'ProjectBox'
OnChange = ProjectBoxChange
Items.Strings = (
'+ + Add project + +')
end
object GroupBox: TGroupBox
Left = 10
Top = 48
Width = 765
Height = 337
Caption = ' '#1055#1088#1086#1077#1082#1090' '
TabOrder = 1
object Label1: TLabel
Left = 32
Top = 40
Width = 15
Height = 13
Caption = 'RS'
end
object Label2: TLabel
Left = 104
Top = 48
Width = 60
Height = 13
Caption = #1059#1089#1090#1088#1086#1081#1089#1090#1074#1086
end
object Label3: TLabel
Left = 176
Top = 64
Width = 67
Height = 13
Caption = #1055#1088#1080#1077#1084' <-- '#1057#1059
end
object Label4: TLabel
Left = 248
Top = 72
Width = 82
Height = 13
Caption = #1055#1077#1088#1077#1076#1072#1095#1072' --> '#1057#1059
end
object Label5: TLabel
Left = 328
Top = 80
Width = 14
Height = 13
Caption = 'Go'
end
object Label6: TLabel
Left = 48
Top = 152
Width = 15
Height = 13
Caption = 'RS'
end
object Label7: TLabel
Left = 136
Top = 184
Width = 60
Height = 13
Caption = #1059#1089#1090#1088#1086#1081#1089#1090#1074#1086
end
object Label8: TLabel
Left = 240
Top = 208
Width = 67
Height = 13
Caption = #1055#1088#1080#1077#1084' <-- '#1057#1059
end
object Label9: TLabel
Left = 352
Top = 232
Width = 82
Height = 13
Caption = #1055#1077#1088#1077#1076#1072#1095#1072' --> '#1057#1059
end
object Label10: TLabel
Left = 456
Top = 248
Width = 14
Height = 13
Caption = 'Go'
end
end
object Memo1: TMemo
Left = 10
Top = 390
Width = 225
Height = 100
Lines.Strings = (
'')
TabOrder = 2
end
object CANswitch: TRxSwitch
Left = 248
Top = 390
Width = 33
Height = 49
Caption = 'CANswitch'
TabOrder = 3
OnClick = CANswitchClick
end
object GroupBox1: TGroupBox
Left = 472
Top = 400
Width = 273
Height = 169
Caption = 'UART'
TabOrder = 4
Visible = False
object RxLabel2: TRxLabel
Left = 24
Top = 18
Width = 31
Height = 13
Caption = 'Com:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object RxLabel6: TRxLabel
Left = 81
Top = 148
Width = 56
Height = 13
Caption = 'TimeWait'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object AbortKey: TSpeedButton
Left = 8
Top = 80
Width = 17
Height = 17
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
04000000000000010000130B0000130B00001000000000000000000000000000
800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
3333333333FFFFF3333333333999993333333333F77777FFF333333999999999
33333337777FF377FF3333993370739993333377FF373F377FF3399993000339
993337777F777F3377F3393999707333993337F77737333337FF993399933333
399377F3777FF333377F993339903333399377F33737FF33377F993333707333
399377F333377FF3377F993333101933399377F333777FFF377F993333000993
399377FF3377737FF7733993330009993933373FF3777377F7F3399933000399
99333773FF777F777733339993707339933333773FF7FFF77333333999999999
3333333777333777333333333999993333333333377777333333}
NumGlyphs = 2
Visible = False
end
object CBLockRS: TCheckBox
Left = 32
Top = 46
Width = 73
Height = 17
Caption = 'LockRS'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 0
OnClick = CBLockRSClick
end
object RCom: TRxSpinEdit
Left = 64
Top = 16
Width = 41
Height = 21
MaxValue = 255.000000000000000000
Value = 1.000000000000000000
TabOrder = 1
OnChange = RComChange
end
object RGBaud: TRadioGroup
Left = 120
Top = 16
Width = 73
Height = 57
BiDiMode = bdLeftToRight
Caption = 'Baud'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -9
Font.Name = 'MS Sans Serif'
Font.Style = []
ItemIndex = 1
Items.Strings = (
'57600'
'115200')
ParentBiDiMode = False
ParentFont = False
TabOrder = 2
OnClick = RGBaudClick
end
object TimeWait: TRxSpinEdit
Left = 10
Top = 140
Width = 55
Height = 21
Value = 10.000000000000000000
TabOrder = 3
end
object PBRs: TProgressBar
Left = 40
Top = 80
Width = 73
Height = 17
Step = 2
TabOrder = 4
end
object Memo2: TMemo
Left = 162
Top = 88
Width = 167
Height = 73
Font.Charset = RUSSIAN_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'Courier'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 5
OnChange = Memo2Change
end
end
object RadioGroup1: TRadioGroup
Left = 296
Top = 390
Width = 73
Height = 65
Caption = ' Can Speed '
TabOrder = 5
end
object Button125: TRadioButton
Left = 304
Top = 408
Width = 50
Height = 17
Caption = '125K'
TabOrder = 6
end
object Button250: TRadioButton
Left = 304
Top = 432
Width = 50
Height = 17
Caption = '250K'
Checked = True
TabOrder = 7
TabStop = True
end
object CanTimer: TTimer
Interval = 10
OnTimer = CanTimerTimer
Left = 744
Top = 8
end
object MyCommPort: TApdComPort
ComNumber = 1
Baud = 115200
PromptForPort = False
StopBits = 2
InSize = 65500
OutSize = 65000
AutoOpen = False
DTR = False
BufferFull = 58500
BufferResume = 5850
TraceSize = 4000000
TraceName = 'e:\APRO.TRC'
TraceHex = False
LogSize = 4000000
LogName = 'e:\APRO.LOG'
LogHex = False
UseEventWord = False
CommNotificationLevel = 1
TapiMode = tmNone
Left = 696
Top = 8
end
end

687
CAN_Terminal.pas Normal file
View File

@ -0,0 +1,687 @@
unit CAN_Terminal;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, IniFiles, UNiiefa, ToolsCan, RXSwitch,
ComCtrls, Buttons, OoMisc, AdPort, Mask, RXSpin, RXCtrls;
type
TCANTerminal = class(TForm)
ProjectBox: TComboBox;
GroupBox: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
CanTimer: TTimer;
Memo1: TMemo;
CANswitch: TRxSwitch;
GroupBox1: TGroupBox;
CBLockRS: TCheckBox;
RxLabel2: TRxLabel;
RCom: TRxSpinEdit;
RGBaud: TRadioGroup;
MyCommPort: TApdComPort;
RxLabel6: TRxLabel;
TimeWait: TRxSpinEdit;
AbortKey: TSpeedButton;
PBRs: TProgressBar;
Memo2: TMemo;
RadioGroup1: TRadioGroup;
Button125: TRadioButton;
Button250: TRadioButton;
RxLabel1: TRxLabel;
procedure FormCreate(Sender: TObject);
procedure LoadProjectAdres(ProjID: string);
procedure ShowProjectAdres();
procedure ShoWinClick(Sender: TObject);
procedure CanTimerTimer(Sender: TObject);
procedure CANswitchClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure RGBaudClick(Sender: TObject);
procedure RComChange(Sender: TObject);
procedure CBLockRSClick(Sender: TObject);
procedure Memo2Change(Sender: TObject);
procedure ProjectBoxChange(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TBar = record
RSadr: TPanel;
RXadr: TPanel;
TXadr: TPanel;
Name: TPanel;
Go: TButton;
end;
TUKSS = record
Bar: TBar;
RSadr: cardinal;
RXadr: longword;
TXadr: longword;
Use: boolean;
Exist: boolean;
Name: string;
Wind: TModbusForm;
end;
TBars = record
BaseAdr: TPanel;
CommAdr: TPanel;
Name: TPanel;
end;
TProject = record
Bars: TBars;
BaseAdr: longword;
PlusAdr: integer;
CommAdr: longword;
UKSS: array[0..15] of TUKSS;
Name: string;
DigiButNames: array[0..16] of string;
DigiButNameChange: boolean;
Protokol: integer;
end;
Tbox = record
adr: longword;
qua: cardinal;
end;
Tboxx = record
box : array[1..100] of Tbox; // edit boxlen!
qua: cardinal;
end;
var
CANTerminal: TCANTerminal;
Project : TProject;
PathExe : String;
ProjectQua : integer = 0;
ProjectNum : integer = 0;
Boxx : Tboxx;
const
boxlen = 100;
implementation
{$R *.dfm}
procedure TCANTerminal.FormCreate(Sender: TObject);
var i: integer;
inifile : TIniFile;
nom,num: string;
wid,hei,tab,lef,top,lev : integer;
begin
InitSlavnaDll();
Project.Bars.Name := TPanel.Create(self);
Project.Bars.Name.Parent := GroupBox;
Project.Bars.Name.Left :=10;
Project.Bars.Name.Top :=15;
Project.Bars.Name.Width :=100;
Project.Bars.Name.Height := 30;
Project.Bars.BaseAdr := TPanel.Create(self);
Project.Bars.BaseAdr.Parent := GroupBox;
Project.Bars.BaseAdr.Left :=10+100+10;
Project.Bars.BaseAdr.Top :=15;
Project.Bars.BaseAdr.Width :=100;
Project.Bars.BaseAdr.Height := 30;
Project.Bars.CommAdr := TPanel.Create(self);
Project.Bars.CommAdr.Parent := GroupBox;
Project.Bars.CommAdr.Left :=10+100+10+100+10;
Project.Bars.CommAdr.Top :=15;
Project.Bars.CommAdr.Width :=100;
Project.Bars.CommAdr.Height := 30;
tab:=5;
Label1.Top := Project.Bars.Name.Top + Project.Bars.Name.Height + tab*3;
Label2.Top := Label1.Top; Label3.Top := Label1.Top; Label4.Top := Label1.Top;
Label5.Top := Label1.Top; Label6.Top := Label1.Top; Label7.Top := Label1.Top;
Label8.Top := Label1.Top; Label9.Top := Label1.Top; Label10.Top := Label1.Top;
for i:= 0 to 15 do
begin
hei := 25;
top := Label1.Top + Label1.Height + tab + (hei+tab)*(i mod 8);
lef := 10 + (i div 8)*(lev);
wid := hei;
Project.UKSS[i].Bar.RSadr := TPanel.Create(self);
Project.UKSS[i].Bar.RSadr.Parent := GroupBox;
Project.UKSS[i].Bar.RSadr.Width := wid;
Project.UKSS[i].Bar.RSadr.Height := hei;
Project.UKSS[i].Bar.RSadr.Left :=lef;
Project.UKSS[i].Bar.RSadr.Top :=top;
if i=0 then Label1.Left := lef;
if i=8 then Label6.Left := lef;
lef := lef + wid + tab;
wid := 110;
Project.UKSS[i].Bar.Name := TPanel.Create(self);
Project.UKSS[i].Bar.Name.Parent := GroupBox;
Project.UKSS[i].Bar.Name.Width :=wid;
Project.UKSS[i].Bar.Name.Height := hei;
Project.UKSS[i].Bar.Name.Left :=lef;
Project.UKSS[i].Bar.Name.Top :=top;
if i=0 then Label2.Left := lef;
if i=8 then Label7.Left := lef;
lef := lef + wid + tab;
wid := 90;
Project.UKSS[i].Bar.RXadr := TPanel.Create(self);
Project.UKSS[i].Bar.RXadr.Parent := GroupBox;
Project.UKSS[i].Bar.RXadr.Width :=wid;
Project.UKSS[i].Bar.RXadr.Height := hei;
Project.UKSS[i].Bar.RXadr.Left :=lef;
Project.UKSS[i].Bar.RXadr.Top :=top;
if i=0 then Label3.Left := lef;
if i=8 then Label8.Left := lef;
lef := lef + wid + tab;
wid := 90;
Project.UKSS[i].Bar.TXadr := TPanel.Create(self);
Project.UKSS[i].Bar.TXadr.Parent := GroupBox;
Project.UKSS[i].Bar.TXadr.Width :=wid;
Project.UKSS[i].Bar.TXadr.Height := hei;
Project.UKSS[i].Bar.TXadr.Left :=lef;
Project.UKSS[i].Bar.TXadr.Top :=top;
if i=0 then Label4.Left := lef;
if i=8 then Label9.Left := lef;
lef := lef + wid + tab;
wid := hei;
Project.UKSS[i].Bar.Go := TButton.Create(self);
Project.UKSS[i].Bar.Go.Parent := GroupBox;
Project.UKSS[i].Bar.Go.Width :=wid;
Project.UKSS[i].Bar.Go.Height := hei;
Project.UKSS[i].Bar.Go.Left :=lef;
Project.UKSS[i].Bar.Go.Top :=top;
Project.UKSS[i].Bar.Go.Caption :='S';
Project.UKSS[i].Bar.Go.Font.Style:=[fsBold];
Project.UKSS[i].Bar.Go.Tag := i;
Project.UKSS[i].Bar.Go.OnClick := ShoWinClick;
if i=0 then Label5.Left := lef;
if i=8 then Label10.Left := lef;
if i<8 then lev := lef + wid + tab*2;
end;
PathExe:=ExtractFileDir(ParamStr(0))+'\';
inifile := TIniFile.Create(PathExe+'Projects.ini');
ProjectQua := Inifile.ReadInteger('Projects','ProjectQua',0);
ProjectNum := Inifile.ReadInteger('Projects','ProjectNum',0);
for i:=1 to ProjectQua do
begin
Num := 'Project'+inttostr(i);
Nom := Inifile.ReadString('Projects',Num,Num);
ProjectBox.Items.add(Nom);
end;
inifile.Free;
Project.Name := ProjectBox.Items[ProjectNum];
ProjectBox.ItemIndex := ProjectNum;
ProjectBoxChange(Sender);
end;
procedure TCANTerminal.ShowProjectAdres();
var
i: integer;
begin
Project.Bars.Name.Caption := Project.Name;
Project.Bars.BaseAdr.Caption := '0x'+inttohex(Project.BaseAdr,8);
if Project.CommAdr = 0
then Project.Bars.CommAdr.Caption := ''
else Project.Bars.CommAdr.Caption := '0x'+inttohex(Project.CommAdr,8);
for i:=0 to 15 do
begin
Project.UKSS[i].Bar.RXadr.Tag:=0;
Project.UKSS[i].Bar.TXadr.Tag:=0;
if Project.UKSS[i].Use then
begin
Project.UKSS[i].Bar.RSadr.Caption := inttostr(Project.UKSS[i].RSadr);
Project.UKSS[i].Bar.RXadr.Caption := '0x' + inttohex(Project.UKSS[i].RXadr,8);
Project.UKSS[i].Bar.TXadr.Caption := '0x' + inttohex(Project.UKSS[i].TXadr,8);
Project.UKSS[i].Bar.Name.Caption := Project.UKSS[i].Name;
Project.UKSS[i].Bar.Go.Caption := 'S';
Project.UKSS[i].Bar.Go.Enabled:=true;
Project.UKSS[i].Bar.Name.Color:=clWindow;
Project.UKSS[i].Bar.RSadr.Color:=clWindow;
Project.UKSS[i].Bar.RXadr.Color := clWindow;
Project.UKSS[i].Bar.TXadr.Color := clWindow;
end else
begin
Project.UKSS[i].Bar.RSadr.Caption := '';
Project.UKSS[i].Bar.RXadr.Caption := '';
Project.UKSS[i].Bar.TXadr.Caption := '';
Project.UKSS[i].Bar.Name.Caption := '';
Project.UKSS[i].Bar.Go.Caption := '';
Project.UKSS[i].Bar.Go.Enabled:=false;
Project.UKSS[i].Bar.Name.Color:=clBtnFace;
Project.UKSS[i].Bar.RSadr.Color:=clBtnFace;
Project.UKSS[i].Bar.RXadr.Color := clBtnFace;
Project.UKSS[i].Bar.TXadr.Color := clBtnFace;
end;
end;
end;
procedure TCANTerminal.LoadProjectAdres(ProjID: string);
var i,adr: integer;
inifile : TIniFile;
nom,nym: string;
num: longword;
left: integer;
begin
inifile := TIniFile.Create(PathExe+'Projects.ini');
Project.Protokol := Inifile.ReadInteger(ProjID,'Protokol',0);
if Project.Protokol = 3 then
begin
Project.BaseAdr := 0;
Project.PlusAdr := 1 shl 28;
left:=24;
end else begin
Project.BaseAdr := Inifile.ReadInteger(ProjID,'BaseAdr',0);
Project.PlusAdr := Inifile.ReadInteger(ProjID,'PlusAdr',16);
left:=0;
end;
Project.CommAdr := Inifile.ReadInteger(ProjID,'CommAdr',0);
adr:=-1;
for i:=0 to 15 do
begin
nom := 'Use_'+inttostr(i);
Project.UKSS[i].Use := inifile.ReadBool(ProjID,nom,false);
if Project.UKSS[i].Use then
begin
nom := 'CANadr_'+inttostr(i);
adr := inifile.ReadInteger(ProjID,nom,adr+1);
nom := 'RSadr_'+inttostr(i);
Project.UKSS[i].RSadr := inifile.ReadInteger(ProjID,nom,i);
nom := 'TXadr_'+inttostr(i);
num := Project.BaseAdr+Project.PlusAdr+(adr shl left);
Project.UKSS[i].TXadr := inifile.ReadInteger(ProjID,nom,num);
nom := 'RXadr_'+inttostr(i);
num := Project.BaseAdr+(adr shl left);
Project.UKSS[i].RXadr := inifile.ReadInteger(ProjID,nom,num);
nom := 'Name_'+inttostr(i);
nym := 'UKSS_'+inttostr(i);
Project.UKSS[i].Name := inifile.ReadString(ProjID,nom,nym);
end;
end;
inifile.Free;
ShowProjectAdres();
end;
procedure TCANTerminal.ShoWinClick(Sender: TObject);
var
Tagg : integer;
begin
Tagg:= (Sender as TButton).Tag;
if not Project.UKSS[Tagg].Exist then
begin
Project.UKSS[Tagg].Wind := TModbusForm.Create(nil);
Project.UKSS[Tagg].Wind.Caption := Project.Name+': '+Project.UKSS[Tagg].Name;
Project.UKSS[Tagg].Wind.Numer:= Tagg;
Project.UKSS[Tagg].Wind.RSadr:= Project.UKSS[Tagg].RSadr;
Project.UKSS[Tagg].Wind.RXadr:= Project.UKSS[Tagg].RXadr;
Project.UKSS[Tagg].Wind.TXadr:= Project.UKSS[Tagg].TXadr;
Project.UKSS[Tagg].Wind.Protokol:= Project.Protokol;
Project.UKSS[Tagg].Exist := true;
end;
Project.UKSS[Tagg].Wind.show;
end;
procedure TCANTerminal.CanTimerTimer(Sender: TObject);
var
i,j,pak, paks : integer;
newstring: string;
adr: longword;
Mess: Tmessag;
begin
paks :=ReadMessageCanID(CanTimer.Interval);
if paks > 0 then
begin
for pak := 0 to paks-1 do
begin
if Project.Protokol=3
then adr := ArrCanMessage[pak].m_dwID and $1F000000
else adr := ArrCanMessage[pak].m_dwID;
if boxx.qua = 0 then
begin
boxx.qua := 1;
boxx.box[1].qua := 1;
boxx.box[1].adr := adr;
end else
begin
i:=0;
repeat i:=i+1
until (boxx.box[i].adr = adr) or (i > boxx.qua);
if i <= boxx.qua then
begin
boxx.box[i].qua := boxx.box[i].qua + 1;
if boxx.box[i].qua > 1000 then
begin
boxx.qua := 1;
boxx.box[1].qua := 1;
boxx.box[1].adr := adr;
end else
begin
if i > 1 then
begin
if boxx.box[i].qua > boxx.box[i-1].qua then
begin
boxx.box[i].adr := boxx.box[i-1].adr;
boxx.box[i-1].adr := adr;
boxx.box[i-1].qua := boxx.box[i].qua;
boxx.box[i].qua := boxx.box[i].qua-1;
end
end
end
end else
begin
if i > boxlen then
begin
boxx.qua := 1;
boxx.box[1].qua := 1;
boxx.box[1].adr := adr;
end else
begin
boxx.qua := i;
boxx.box[i].qua := 1;
boxx.box[i].adr := adr;
end
end
end;
for i:=0 to 15 do
if Project.UKSS[i].Use then
begin
if Project.UKSS[i].RXadr = adr then
begin
Project.UKSS[i].Bar.RXadr.Color := $FFD0A0; //clMoneyGreen;
Project.UKSS[i].Bar.RXadr.Tag := 5000 div CANTimer.Interval;
end;
if Project.UKSS[i].TXadr = adr then
begin
Project.UKSS[i].Bar.TXadr.Color := $A0FFC0; //clMoneyGreen;
Project.UKSS[i].Bar.TXadr.Tag := 5000 div CANTimer.Interval;
end;
if (Project.UKSS[i].RXadr = adr)
or (Project.UKSS[i].TXadr = adr) then
begin
if project.Protokol = 3 then
begin
mess.Leng := ArrCanMessage[pak].m_bDLC shr 1;
mess.Addr := ArrCanMessage[pak].m_dwID and $0000007F;
mess.Mask := $FF;
mess.Data[0] := ArrCanMessage[pak].m_bData[1] shl 8;
mess.Data[0] := ArrCanMessage[pak].m_bData[2] or mess.Data[0];
mess.Data[1] := ArrCanMessage[pak].m_bData[3] shl 8;
mess.Data[1] := ArrCanMessage[pak].m_bData[4] or mess.Data[1];
mess.Data[2] := ArrCanMessage[pak].m_bData[5] shl 8;
mess.Data[2] := ArrCanMessage[pak].m_bData[6] or mess.Data[2];
mess.Data[3] := ArrCanMessage[pak].m_bData[7] shl 8;
mess.Data[3] := ArrCanMessage[pak].m_bData[8] or mess.Data[3];
end else begin
mess.Mask := ArrCanMessage[pak].m_bData[5] shr 5;
mess.Addr :=(ArrCanMessage[pak].m_bData[5] and $1F) shl 8;
mess.Addr := ArrCanMessage[pak].m_bData[6] or mess.Addr;
mess.Leng := 3;
mess.Data[0] := ArrCanMessage[pak].m_bData[7] shl 8;
mess.Data[0] := ArrCanMessage[pak].m_bData[8] or mess.Data[0];
mess.Data[1] := ArrCanMessage[pak].m_bData[1] shl 8;
mess.Data[1] := ArrCanMessage[pak].m_bData[2] or mess.Data[1];
mess.Data[2] := ArrCanMessage[pak].m_bData[3] shl 8;
mess.Data[2] := ArrCanMessage[pak].m_bData[4] or mess.Data[2];
end;
if(Project.UKSS[i].TXadr = adr) then mess.Surs := 0;
if(Project.UKSS[i].RXadr = adr) then mess.Surs := 1;
if Project.UKSS[i].Exist then
Project.UKSS[i].Wind.ReceiveCanData(mess);
end
end
end;
newstring:='';
for i:= 1 to boxx.qua do
newstring:= newstring +
'0x'+ inttohex(boxx.box[i].adr,8) +
'(' + inttostr(boxx.box[i].qua) + ') ';
Memo1.Clear;
Memo1.Lines[0] := newstring;
end;
if CANswitch.StateOn then
for i:=0 to 15 do
if Project.UKSS[i].Use then
begin
if Project.UKSS[i].Bar.RXadr.Tag = 0
then Project.UKSS[i].Bar.RXadr.Color := clWindow
else
begin
Project.UKSS[i].Bar.RXadr.Tag := Project.UKSS[i].Bar.RXadr.Tag - 1;
if Project.UKSS[i].Bar.RXadr.Tag < 4000 div CANTimer.Interval
then Project.UKSS[i].Bar.RXadr.Color := $F0E0D0;
end;
if Project.UKSS[i].Bar.TXadr.Tag = 0
then Project.UKSS[i].Bar.TXadr.Color := clWindow
else
begin
Project.UKSS[i].Bar.TXadr.Tag := Project.UKSS[i].Bar.TXadr.Tag - 1;
if Project.UKSS[i].Bar.TXadr.Tag < 4000 div CANTimer.Interval
then Project.UKSS[i].Bar.TXadr.Color := $D0F0E0;
end
end;
end;
procedure TCANTerminal.CANswitchClick(Sender: TObject);
var
i: integer;
begin
if CANswitch.StateOn then
begin
if Button125.Checked then OpenSlavna(1,8);
if Button250.Checked then OpenSlavna(2,8);
CanTimer.Enabled:=true;
end else
begin
CloseSlavna();
CanTimer.Enabled:=false;
boxx.qua := 0;
for i:=0 to 15 do
begin
Project.UKSS[i].Bar.RXadr.Color := clBtnFace;
Project.UKSS[i].Bar.TXadr.Color := clBtnFace;
end;
end;
end;
procedure TCANTerminal.FormClose(Sender: TObject;
var Action: TCloseAction);
var i: integer;
inifile : TIniFile;
nom: string;
begin
if Project.DigiButNameChange then
begin
inifile := TIniFile.Create(PathExe+'Projects.ini');
for i:=0 to 16 do
begin
nom := 'DigiBut_'+inttostr(i);
inifile.WriteString(Project.Name,nom,Project.DigiButNames[i]);
end;
inifile.Free;
end;
CloseSlavna();
FreeSlavnaDll();
end;
procedure TCANTerminal.RGBaudClick(Sender: TObject);
begin
if RGBaud.ItemIndex=0 then MyCommPort.Baud:=57600;
if RGBaud.ItemIndex=1 then MyCommPort.Baud:=115200;
end;
procedure TCANTerminal.RComChange(Sender: TObject);
begin
MyCommPort.Open:=False;
MyCommPort.ComNumber:= Round(RCom.Value);
end;
procedure TCANTerminal.CBLockRSClick(Sender: TObject);
begin
MyCommPort.Open := CBLockRS.Checked;
end;
procedure TCANTerminal.Memo2Change(Sender: TObject);
begin
if Memo1.Lines.Count > 100 then Memo1.Clear;
end;
procedure TCANTerminal.ProjectBoxChange(Sender: TObject);
var i : integer;
inifile : TIniFile;
nom, num: string;
begin
for i:=0 to 15 do
if Project.UKSS[i].Exist then
begin
Project.UKSS[i].Wind.Close;
Project.UKSS[i].Exist:=false;
end;
Project.Name := ProjectBox.Items[ProjectBox.ItemIndex];
if ProjectBox.ItemIndex >0 then
LoadProjectAdres(Project.Name);
inifile := TIniFile.Create(PathExe+'Projects.ini');
nom:='ProjectNum';
num:=inttostr(ProjectBox.ItemIndex);
inifile.WriteString('Projects',nom,num);
for i:=0 to 16 do
begin
num := 'DigiBut_'+inttostr(i);
Project.DigiButNames[i] := inifile.ReadString(Project.Name,num,'-');
end;
Project.DigiButNameChange := false;
inifile.Free;
boxx.qua:=0;
for i:= 1 to 100 do
begin
boxx.box[i].adr:=0;
boxx.box[i].qua:=0;
end;
end;
end.

407
Projects.ini Normal file
View File

@ -0,0 +1,407 @@
[Projects]
ProjectQua=9
ProjectNum=6
Project1=Áóêñèð
Project2=ÑÝÄÁÌ
Project3=Ëåäîêîë
Project4=Áàëüçàì
Project5=23550
Project6=23550.X
Project7=23550.2
Project8=ßíòàðü
Project9=23550 ÁÑÓ
[Áóêñèð]
BaseAdr=$00318200
PlusAdr=$10
Use_0=1
Use_1=1
Use_2=1
Use_3=1
RSadr_0=1
RSadr_1=2
RSadr_2=3
RSadr_3=4
Name_0=ÓÊÑÑ ÑÁ
Name_1=ÁÊÑÑ ÃÄ
Name_2=ÓÊÑÂÝÏ
Name_3=Çàäàò÷èê
DigiBut_0=Test
DigiBut_1=Def
DigiBut_2=Save
DigiBut_3=Load
DigiBut_4=Calibr
DigiBut_5=Calcul
DigiBut_6=Secret
DigiBut_7=Light
DigiBut_8=Raw
DigiBut_9=-
DigiBut_10=-
DigiBut_11=-
DigiBut_12=-
DigiBut_13=-
DigiBut_14=-
DigiBut_15=Reset
DigiBut_16=Nothing at all
[ÑÝÄÁÌ]
BaseAdr=$1051020
PlusAdr=$10
Use_0=1
Use_1=1
Use_2=1
Use_3=1
Use_4=1
Use_5=1
Use_6=1
Use_8=1
Use_9=1
Use_10=1
Use_11=1
Use_12=1
Use_13=1
Use_14=1
Use_15=1
CANadr_8=$20
Name_0=ÓÊÑÑ ÑÊ1 ÑÁ1
Name_1=ÓÊÑÑ ÑÊ2 ÑÁ1
Name_2=ÓÊÑÑ ÑÊ3 ÑÁ1
Name_3=ÓÊÑÑ ÑÊ4 ÑÁ1
Name_4=ÓÊÑÑÂÝÏ ÑÁ1
Name_5=Çàäàò÷èê ÑÁ1
Name_6=ÁÒÐ ÈÒÝÑ
Name_8=ÓÊÑÑ ÑÊ1 ÑÁ2
Name_9=ÓÊÑÑ ÑÊ2 ÑÁ2
Name_10=ÓÊÑÑ ÑÊ3 ÑÁ2
Name_11=ÓÊÑÑ ÑÊ4 ÑÁ2
Name_12=ÓÊÑÑÂÝÏ ÑÁ2
Name_13=Çàäàò÷èê ÑÁ2
Name_14=ÓÊÑÑ ÁÎÈÍ
Name_15=ÓÊÑÂÝÏ ÁÎÈÍ
DigiBut_0=Test
DigiBut_1=Def
DigiBut_2=Save
DigiBut_3=Load
DigiBut_4=Calibr
DigiBut_5=Calcul
DigiBut_6=Secret
DigiBut_7=Raw
DigiBut_8=HiVolt
DigiBut_9=-
DigiBut_10=-
DigiBut_11=-
DigiBut_12=-
DigiBut_13=-
DigiBut_14=-
DigiBut_15=Reset
DigiBut_16=Nothing at all
[Ëåäîêîë]
BaseAdr=$01CE020
PlusAdr=-$20
Use_0=1
Use_1=1
Use_2=1
Use_3=1
Use_4=1
Use_5=1
Use_8=1
Use_9=1
Use_10=1
Use_11=1
Use_12=1
Use_13=1
CANadr_0=0
CANadr_1=2
CANadr_2=4
CANadr_3=6
CANadr_4=8
CANadr_5=10
CANadr_8=1
CANadr_9=3
CANadr_10=5
CANadr_11=7
CANadr_12=9
CANadr_13=11
RSadr_0=1
RSadr_1=3
RSadr_2=5
RSadr_3=7
RSadr_4=9
RSadr_5=11
RSadr_8=2
RSadr_9=4
RSadr_10=6
RSadr_11=8
RSadr_12=10
RSadr_13=12
Name_0=ÓÊÑÑ ÁÂ1 Ï×1
Name_8=ÓÊÑÑ ÁÂ1 Ï×2
Name_1=ÓÊÑÑ ÁÂ1 Ï×1
Name_9=ÓÊÑÑ ÁÂ2 Ï×2
Name_2=ÓÊÑÑ ÁÈ1 Ï×1
Name_10=ÓÊÑÑ ÁÈ1 Ï×2
Name_3=ÓÊÑÑ ÁÈ2 Ï×1
Name_11=ÓÊÑÑ ÁÈ2 Ï×2
Name_4=ÓÊÑÑÂÝÏ1 Ï×1
Name_12=ÓÊÑÑÂÝÏ1 Ï×2
Name_5=ÓÊÑÑÂÝÏ2 Ï×1
Name_13=ÓÊÑÑÂÝÏ2 Ï×2
DigiBut_0=Test
DigiBut_1=Def
DigiBut_2=Save
DigiBut_3=Load
DigiBut_4=Raw
DigiBut_5=Read
DigiBut_6=ExtLamp
DigiBut_7=ExtLite
DigiBut_8=No log
DigiBut_9=-
DigiBut_10=-
DigiBut_11=-
DigiBut_12=-
DigiBut_13=-
DigiBut_14=-
DigiBut_15=Reset
DigiBut_16=Nothing at all
[Áàëüçàì]
BaseAdr=$0BA0000
PlusAdr=$10
Use_0=1
Use_1=1
Use_2=1
Use_3=1
Use_4=1
Use_5=1
Use_8=1
Use_9=1
Use_10=1
CANadr_0=0
CANadr_1=2
CANadr_2=4
CANadr_3=6
CANadr_4=7
CANadr_5=8
CANadr_8=1
CANadr_9=3
CANadr_10=5
RSadr_0=1
RSadr_1=3
RSadr_2=5
RSadr_3=7
RSadr_4=9
RSadr_5=11
RSadr_8=2
RSadr_9=4
RSadr_10=6
Name_0=ÁÊÑÑ Òð1
Name_8=ÁÊÑÑ Òð2
Name_1=ÓÊÑÑ ÑÁ1
Name_9=ÓÊÑÑ ÑÁ2
Name_2=ÓÊÑÑ ÓÌÏ1
Name_10=ÓÊÑÑ ÓÌÏ2
Name_3=ÁÊÑÑ ÃÄ
Name_4=Çàäàò÷èê
Name_5=ÓÊÑÑ ÂÝÏ
DigiBut_0=Test
DigiBut_1=Def
DigiBut_2=Save
DigiBut_3=Load
DigiBut_4=Calibr
DigiBut_5=Calcul
DigiBut_6=Stop
DigiBut_7=Start
DigiBut_8=Init
DigiBut_9=Tune
DigiBut_10=Secret
DigiBut_11=Light
DigiBut_12=Raw
DigiBut_13=-
DigiBut_14=-
DigiBut_15=Reset
DigiBut_16=Nothing at all
[23550]
BaseAdr=$00235500
PlusAdr=$10
Use_0=1
Use_1=1
Use_2=1
Use_3=1
RSadr_0=1
RSadr_1=2
RSadr_2=3
RSadr_3=4
Name_0=Çàäàò÷èê
Name_1=Âûíîñíîé ïóëüò
Name_2=ÓÊÑÂÝÏ
Name_3=ÁÊÑÑ ÃÄ
DigiBut_0=Test
DigiBut_1=Def
DigiBut_2=Save
DigiBut_3=Load
DigiBut_4=Calibr
DigiBut_5=Read
DigiBut_6=Secret
DigiBut_7=Send
DigiBut_8=-
DigiBut_9=-
DigiBut_10=-
DigiBut_11=-
DigiBut_12=-
DigiBut_13=-
DigiBut_14=-
DigiBut_15=Reset
DigiBut_16=Nothing at all
[23550.X]
Protokol=3
Use_0=1
Use_1=1
Use_2=1
Use_3=1
RSadr_0=1
RSadr_1=2
RSadr_2=3
RSadr_3=4
Name_0=Çàäàò÷èê
Name_1=Âûíîñíîé ïóëüò
Name_2=ÓÊÑÂÝÏ
Name_3=ÁÊÑÑ ÃÄ
DigiBut_0=Test
DigiBut_1=Def
DigiBut_2=Save
DigiBut_3=Load
DigiBut_4=Calibr
DigiBut_5=Read
DigiBut_6=Secret
DigiBut_7=Send
DigiBut_8=-
DigiBut_9=-
DigiBut_10=-
DigiBut_11=-
DigiBut_12=-
DigiBut_13=-
DigiBut_14=-
DigiBut_15=Reset
DigiBut_16=Nothing at all
[ßíòàðü]
BaseAdr=$00213000
PlusAdr=$10
Use_0=1
Use_1=1
Use_2=1
Use_3=1
Use_4=1
Use_5=1
Use_6=1
RSadr_0=1
RSadr_1=2
RSadr_2=3
RSadr_3=4
RSadr_4=5
RSadr_5=6
RSadr_6=7
Name_0=ÓÊÑÑ ÁÂ
Name_1=ÓÊÑÑ ÁÈ1
Name_2=ÓÊÑÑ ÁÈ2
Name_3=ÁÊÑÑ ÃÄ
Name_4=ÓÊÑÂÝÏ
Name_5=Çàäàò÷èê
Name_6=Âûíîñíîé ïóëüò
DigiBut_0=Test
DigiBut_1=Def
DigiBut_2=Save
DigiBut_3=Load
DigiBut_4=Calibr
DigiBut_5=Calcul
DigiBut_6=Secret
DigiBut_7=Light
DigiBut_8=Raw
DigiBut_9=-
DigiBut_10=-
DigiBut_11=-
DigiBut_12=-
DigiBut_13=-
DigiBut_14=-
DigiBut_15=Reset
DigiBut_16=Nothing at all
[23550.2]
BaseAdr=$00235500
PlusAdr=$10
Use_0=1
Use_1=1
Use_2=1
Use_3=1
Use_4=1
Use_5=1
Use_11=1
Use_12=1
Use_13=1
CANadr_0=0
CANadr_1=1
CANadr_2=2
CANadr_3=4
CANadr_4=6
CANadr_5=8
CANadr_11=5
CANadr_12=7
CANadr_13=9
RSadr_0=1
RSadr_1=2
RSadr_2=3
RSadr_3=4
RSadr_4=6
RSadr_5=8
RSadr_11=5
RSadr_12=7
RSadr_13=9
Name_0=Çàäàò÷èê
Name_1=Âûíîñíîé ïóëüò
Name_2=ÁÊÑÑ ÃÄ
Name_3=ÓÊÑÑ ÑÈ ÑÁ1
Name_4=ÓÊÑÑ ÑÂÔ ÑÁ1
Name_5=ÓÊÑÂÝÏ ÑÁ1
Name_11=ÓÊÑÑ ÑÈ ÑÁ2
Name_12=ÓÊÑÑ ÑÂÔ ÑÁ2
Name_13=ÓÊÑÂÝÏ ÑÁ2
DigiBut_0=Test
DigiBut_1=Def
DigiBut_2=Save
DigiBut_3=Load
DigiBut_4=Calibr
DigiBut_5=Calc
DigiBut_6=Secret
DigiBut_7=Send
DigiBut_8=Raw
DigiBut_9=-
DigiBut_10=-
DigiBut_11=-
DigiBut_12=-
DigiBut_13=-
DigiBut_14=-
DigiBut_15=Reset
DigiBut_16=Nothing at all
[23550 ÁÑÓ]
BaseAdr=$0CEB0F1
PlusAdr=-$10
Use_0=1
Use_1=1
Name_0=ÁÑÓ1
Name_1=ÁÑÓ2
DigiBut_16=Nothing at all

39
SetTerminal_UKSS_CAN.cfg Normal file
View File

@ -0,0 +1,39 @@
-$A8
-$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
-LE"d:\borland\delphi7\Projects\Bpl"
-LN"d:\borland\delphi7\Projects\Bpl"
-LUvcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOfficeXP;AsyncPro
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST

139
SetTerminal_UKSS_CAN.dof Normal file
View File

@ -0,0 +1,139 @@
[FileVersion]
Version=7.0
[Compiler]
A=8
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=0
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;
NamespacePrefix=
SymbolDeprecated=1
SymbolLibrary=1
SymbolPlatform=1
UnitLibrary=1
UnitPlatform=1
UnitDeprecated=1
HResultCompat=1
HidingMember=1
HiddenVirtual=1
Garbage=1
BoundsError=1
ZeroNilCompat=1
StringConstTruncated=1
ForLoopVarVarPar=1
TypedConstVarPar=1
AsgToTypedConst=1
CaseLabelRange=1
ForVariable=1
ConstructingAbstract=1
ComparisonFalse=1
ComparisonTrue=1
ComparingSignedUnsigned=1
CombiningSignedUnsigned=1
UnsupportedConstruct=1
FileOpen=1
FileOpenUnitSrc=1
BadGlobalSymbol=1
DuplicateConstructorDestructor=1
InvalidDirective=1
PackageNoLink=1
PackageThreadVar=1
ImplicitImport=1
HPPEMITIgnored=1
NoRetVal=1
UseBeforeDef=1
ForLoopVarUndef=1
UnitNameMismatch=1
NoCFGFileFound=1
MessageDirective=1
ImplicitVariants=1
UnicodeToLocale=1
LocaleToUnicode=1
ImagebaseMultiple=1
SuspiciousTypecast=1
PrivatePropAccessor=1
UnsafeType=0
UnsafeCode=0
UnsafeCast=0
[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=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOfficeXP;AsyncPro
Conditionals=
DebugSourceDirs=
UsePackages=1
[Parameters]
RunParams=
HostApplication=
Launcher=
UseLauncher=0
DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=D:\Borland\Delphi7\Bin\
[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=1049
CodePage=1251
[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;

16
SetTerminal_UKSS_CAN.dpr Normal file
View File

@ -0,0 +1,16 @@
program SetTerminal_UKSS_CAN;
uses
Forms,
CAN_Terminal in 'CAN_Terminal.pas' {CANTerminal},
UNiiefa in 'UNiiefa.pas' {UNiiefa};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TCANTerminal, CANTerminal);
Application.CreateForm(TModbusForm, ModbusForm);
Application.Run;
end.

BIN
SetTerminal_UKSS_CAN.exe Normal file

Binary file not shown.

BIN
SetTerminal_UKSS_CAN.res Normal file

Binary file not shown.

BIN
ToolsCan.dcu Normal file

Binary file not shown.

443
ToolsCan.pas Normal file
View File

@ -0,0 +1,443 @@
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 (TimePauseCanIn<deltat) then TimePauseCanIn:=deltat;
end;
end
else
begin
inc(can_error);
end;
end;
k:=0;
for i:=0 to can1-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_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.

BIN
ToolsRS.dcu Normal file

Binary file not shown.

285
ToolsRS.pas Normal file
View File

@ -0,0 +1,285 @@
unit ToolsRS;
interface
uses
Forms, AdPort, OoMisc;
var
BufIn, BufOut : Array [0..200000] of byte;
FlagRS : Boolean = false;
FlagAbortKey : Boolean = false;
Count_error : Integer = 0;
RSTimeOut : Boolean = True;
procedure SendAddress (AdrCon:Byte);
function RunCmdNew (Cmd : Byte; LengthOut,LengthIn :LongWord): Byte;
function ContrlolSumCRC16(BufCRC : Array of Byte; LengthB : LongWord): Word;
function LB(X: Word): Byte;
function HB(X: Word): Byte;
implementation
uses CAN_Terminal;
Function ContrlolSumCRC16(BufCRC : Array of Byte; LengthB : LongWord) : Word;
Var
CRC : Word;
Index1,
Index2: LongWord;
rb : Byte;
Begin
CRC := $ffff;
For Index1 := 0 To LengthB-1 Do
Begin
CRC := (CRC and $FFFF);
CRC := (CRC XOR (BufCRC[Index1]));
For Index2 := 1 To 8 Do
If ((CRC And $1) <> 0) Then
CRC := ((CRC SHR 1) xor $A001) else CRC := (CRC SHR 1)
end;
Result := (CRC and $FFFF);
end;
procedure SendAddress (AdrCon:Byte);
var
ET : EventTimer;
begin
if AdrCon = 0 then exit;
CANTerminal.MyCommPort.Parity:=pNone;
CANTerminal.MyCommPort.PutChar(Chr(AdrCon));
end;
function RunCmdNew(Cmd : Byte; LengthOut,LengthIn :LongWord): Byte;
var
b : Byte;
CSum,PAdr : Word;
CSumb : Byte;
BB : LongWord;
bb1,bb2 : Word;
i,i1,i2 : LongWord;
ET : EventTimer;
Ch : Char;
BufSize : LongWord ;
Posit : LongWord;
Block1 : Array [0..9000] of byte;
FlagOpenRS : Boolean;
Fr : Byte;
begin
if CANTerminal.MyCommPort.OutBuffUsed <> 0 then exit;
FlagRs:=True;
FlagAbortKey:=False;
CANTerminal.AbortKey.Visible:=True;
FlagOpenRS := CANTerminal.MyCommPort.Open;
CANTerminal.MyCommPort.Open:=True;
CANTerminal.MyCommPort.FlushInBuffer;
CANTerminal.MyCommPort.FlushOutBuffer;
Posit:=0;
CANTerminal.PBRs.Position:=0;
CANTerminal.PBRs.Max:=LengthOut+LengthIn;
Count_error := 0;
BufIn[0]:=0;
BufIn[1]:=0;
BufIn[2]:=0;
BufIn[3]:=0;
BufIn[4]:=0;
BufIn[5]:=0;
BufIn[6]:=0;
BufIn[7]:=0;
BufIn[8]:=0;
BufIn[9]:=0;
Padr:=$3f8+5;
if Cmd<>0 then SendAddress(Cmd);
BufOut[LengthOut]:=0;
BufOut[LengthOut+1]:=0;
BufOut[LengthOut+2]:=0;
BufOut[LengthOut+3]:=0;
i1:=LengthOut+1;
i2:=0;
repeat
if i1>=1024 then begin
for i:=0 to 1023 do Block1[i] := BufOut[i+i2];
while CANTerminal.MyCommPort.OutBuffUsed<>0 do;
CANTerminal.MyCommPort.PutBlock(Block1,1024);
Posit:=Posit+1024;
i1:=i1-1024;
i2:=i2+1024;
end
else
begin
if ((i1<1024) and (i1>0)) then begin
for i:=0 to i1-1 do Block1[i] := BufOut[i+i2];
while CANTerminal.MyCommPort.OutBuffUsed<>0 do;
CANTerminal.MyCommPort.PutBlock(Block1,i1);
Posit:=Posit+i1;
while CANTerminal.MyCommPort.OutBuffUsed<>0 do;
i1:=0;
i2:=LengthOut;
end;
end;
CANTerminal.PBRs.Position:=Posit;
Application.ProcessMessages;
if FlagAbortKey then begin
Result:=3;
FlagRs:=False;
CANTerminal.MyCommPort.Open:=FlagOpenRS;
exit;
FlagAbortKey:=False;
CANTerminal.AbortKey.Visible:=False;
end;
until (i1=0);
while CANTerminal.MyCommPort.OutBuffUsed<>0 do;
i:=0;
while i<(LengthIn) do begin
bb:=0;
RSTimeOut:= false;
NewTimer(ET,Round(CANTerminal.TimeWait.Value));
repeat
CANTerminal.MyCommPort.ProcessCommunications;
// Application.ProcessMessages;
if CANTerminal.MyCommPort.InBuffUsed>1024 then begin
CANTerminal.MyCommPort.GetBlock(Block1,1024);
for i1:=0 to 1023 do BufIn[i+i1]:=Block1[i1];
i:=i+i1;
Posit:=Posit+1024;
end;
If CANTerminal.MyCommPort.CharReady then
begin
inc(Posit);
CANTerminal.PBRs.Position:=Posit;
Ch:=CANTerminal.MyCommPort.GetChar;
bb:=1;
BufIn[i]:=Ord(Ch);
inc(i);
// if not ((i>2) and (i > BufIn[2]+4))
// then Application.ProcessMessages;
Break;
end;
if FlagAbortKey then begin
FlagAbortKey:=False;
CANTerminal.AbortKey.Visible:=False;
Result:=3; // Ïîëó÷åíèå ïðåðâàíî êíîïêîé
FlagRs:=False;
CANTerminal.MyCommPort.Open:=FlagOpenRS;
exit;
end;
until TimerExpired(ET) { or (RSTimeOut) };
If bb=0 then Break;
end;
CANTerminal.MyCommPort.FlushInBuffer;
CANTerminal.MyCommPort.FlushOutBuffer;
FlagAbortKey:=False;
CANTerminal.AbortKey.Visible:=False;
If bb=0 then
begin
Result:=1; // íè÷åãî íå ïðèøëî...
CANTerminal.MyCommPort.Open:=FlagOpenRS;
FlagRs:=False;
exit;
end;
Csum:=ContrlolSumCRC16(BufIn,LengthIn-2);
if CSum<>(BufIn[LengthIn-2]+BufIn[LengthIn-1]*256) then
begin
Result:=2; // íå ñîøëàñü êîíòðîëüíàÿ ñóììà
FlagRs:=False;
CANTerminal.MyCommPort.Open:=FlagOpenRS;
exit;
end
else
Result:=0;
CANTerminal.MyCommPort.Open:=FlagOpenRS;
FlagRs:=False;
CSum:=i;
if PAdr=0 then CSum:=i;
end;
{Ïîëó÷åíèå ìëàäøåãî áàéòà}
function LB(X: Word): Byte;
var b1: Byte;
begin
asm
mov ax,X
mov b1,al
end;
Result:=b1;
end;
{Ïîëó÷åíèå ñòàðøåãî áàéòà}
function HB(X: Word): Byte;
var b1: Byte;
begin
asm
mov ax,X
mov b1,ah
end;
Result:=b1;
end;
end.

BIN
UNiiefa.dcu Normal file

Binary file not shown.

BIN
UNiiefa.ddp Normal file

Binary file not shown.

BIN
UNiiefa.dfm Normal file

Binary file not shown.

1253
UNiiefa.pas Normal file

File diff suppressed because it is too large Load Diff

BIN
slcan.dcu Normal file

Binary file not shown.

BIN
slcan.dll Normal file

Binary file not shown.

546
slcan.pas Normal file
View File

@ -0,0 +1,546 @@
unit slcan;
interface
uses Windows;
const
SLCAN_PROPERTY_INDEX_LINKNAME = 0;
SLCAN_PROPERTY_INDEX_INSTANCEID = 1;
SLCAN_PROPERTY_INDEX_DEVICEDESC = 2;
SLCAN_PROPERTY_INDEX_FRIENDLYNAME = 3;
SLCAN_PROPERTY_INDEX_PHOBJECTNAME = 4;
SLCAN_PROPERTY_INDEX_MFG = 5;
SLCAN_PROPERTY_INDEX_LOCATIONINFO = 6;
SLCAN_PROPERTY_INDEX_ENUMERATOR = 7;
SLCAN_PROPERTY_INDEX_CLASS = 8;
SLCAN_PROPERTY_INDEX_CLASSGUID = 9;
SLCAN_PROPERTY_INDEX_SERVICE = 10;
SLCAN_PROPERTY_INDEX_DRIVER = 11;
SLCAN_PROPERTY_INDEX_PORTNAME = 12;
SLCAN_PROPERTY_INDEX_PRODUCT = 13;
SLCAN_PROPERTY_INDEX_MANUFACTURER = 14;
SLCAN_PROPERTY_INDEX_CONFIGURATION = 15;
SLCAN_PROPERTY_INDEX_INTERFACE = 16;
SLCAN_PROPERTY_INDEX_SERIAL = 17;
SLCAN_PROPERTY_INDEX_ALIAS = 18;
SLCAN_PROPERTY_INDEX_CHANNELLINK = 19;
SLCAN_PROPERTY_INDEX_SERIALID = 20;
SLCAN_MODE_CONFIG = $00;
SLCAN_MODE_NORMAL = $01;
SLCAN_MODE_LISTENONLY = $02;
SLCAN_MODE_LOOPBACK = $03;
SLCAN_MODE_SLEEP = $04;
SLCAN_BR_CIA_1000K = $8000;
SLCAN_BR_CIA_800K = $8001;
SLCAN_BR_CIA_500K = $8002;
SLCAN_BR_CIA_250K = $8003;
SLCAN_BR_CIA_125K = $8004;
SLCAN_BR_CIA_50K = $8005;
SLCAN_BR_CIA_20K = $8006;
SLCAN_BR_CIA_10K = $8007;
SLCAN_BR_400K = $8008;
SLCAN_BR_200K = $8009;
SLCAN_BR_100K = $800A;
SLCAN_BR_83333 = $800B;
SLCAN_BR_33333 = $800C;
SLCAN_BR_25K = $800D;
SLCAN_BR_5K = $800E;
SLCAN_BR_30K = $800F;
SLCAN_BR_300K = $8010;
SLCAN_BR_LASTINDEX = SLCAN_BR_33333;
SLCAN_CAP_MODE_NORMAL = $01;
SLCAN_CAP_MODE_LISTEN_ONLY = $02;
SLCAN_CAP_MODE_LOOP_BACK = $04;
SLCAN_CAP_MODE_SLEEP = $08;
SLCAN_CAP_TXMODE_ONE_SHOT = $01;
SLCAN_CAP_TXMODE_TIME_STAMP = $02;
SLCAN_CAP_CONTR_EXTERNAL = $00;
SLCAN_CAP_CONTR_MCP2515 = $01;
SLCAN_CAP_CONTR_SJA1000 = $02;
SLCAN_CAP_CONTR_INTERNAL = $80;
SLCAN_CAP_CONTR_LPC = $81;
SLCAN_CAP_CONTR_STM32 = $82;
SLCAN_CAP_CONTR_STM8 = $83;
SLCAN_CAP_CONTR_PIC = $84;
SLCAN_CAP_CONTR_PIC_ECAN = $85;
SLCAN_CAP_PHYS_HS = $01;
SLCAN_CAP_PHYS_LS = $02;
SLCAN_CAP_PHYS_SW = $04;
SLCAN_CAP_PHYS_J1708 = $08;
SLCAN_CAP_PHYS_LIN = $10;
SLCAN_CAP_PHYS_KLINE = $20;
SLCAN_CAP_PHYS_LOAD = $01;
SLCAN_CAP_BITRATE_INDEX = $01;
SLCAN_CAP_BITRATE_CUSTOM = $02;
SLCAN_CAP_BITRATE_AUTO = $04;
SLCAN_EVT_LEVEL_RX_MSG = 0;
SLCAN_EVT_LEVEL_TIME_STAMP = 1;
SLCAN_EVT_LEVEL_TX_MSG = 2;
SLCAN_EVT_LEVEL_BUS_STATE = 3;
SLCAN_EVT_LEVEL_COUNTS = 4;
SLCAN_EVT_LEVEL_ERRORS = 5;
SLCAN_EVT_TYPE_RX = $0;
SLCAN_EVT_TYPE_START_TX = $1;
SLCAN_EVT_TYPE_END_TX = $2;
SLCAN_EVT_TYPE_ABORT_TX = $3;
SLCAN_EVT_TYPE_BUS_STATE = $4;
SLCAN_EVT_TYPE_ERROR_COUNTS = $5;
SLCAN_EVT_TYPE_BUS_ERROR = $6;
SLCAN_EVT_TYPE_ARBITRATION = $7;
SLCAN_EVT_TYPE_STAMP_INC = $F;
SLCAN_BUS_STATE_ERROR_ACTIVE = $00;
SLCAN_BUS_STATE_ERROR_ACTIVE_WARN = $01;
SLCAN_BUS_STATE_ERROR_PASSIVE = $02;
SLCAN_BUS_STATE_BUSOFF = $03;
SLCAN_MES_INFO_EXT = $01;
SLCAN_MES_INFO_RTR = $02;
SLCAN_MES_INFO_ONESHOT = $04;
SLCAN_DEVOP_CREATE = $00000000;
SLCAN_DEVOP_CREATEHANDLE = $00000001;
SLCAN_DEVOP_OPEN = $00000002;
SLCAN_DEVOP_CLOSE = $00000003;
SLCAN_DEVOP_DESTROYHANDLE = $00000004;
SLCAN_DEVOP_DESTROY = $00000005;
SLCAN_DEVOP_INFO = $00000006;
SLCAN_DEVOP_USER = $00000007;
SLCAN_INVALID_HANDLE_ERROR = $E0001001;
SLCAN_DEVICE_INVALID_HANDLE_ERROR = $E0001120;
SLCAN_HANDLE_INIT_ERROR = $E0001017;
SLCAN_DEVICE_NOTOPEN_ERROR = $E0001121;
SLCAN_EVT_ERR_TYPE_BIT = $00;
SLCAN_EVT_ERR_TYPE_FORM = $01;
SLCAN_EVT_ERR_TYPE_STUFF = $02;
SLCAN_EVT_ERR_TYPE_OTHER = $03;
SLCAN_EVT_ERR_DIR_TX = $00;
SLCAN_EVT_ERR_DIR_RX = $01;
SLCAN_EVT_ERR_FRAME_SOF = $03;
SLCAN_EVT_ERR_FRAME_ID28_ID21 = $02;
SLCAN_EVT_ERR_FRAME_ID20_ID18 = $06;
SLCAN_EVT_ERR_FRAME_SRTR = $04;
SLCAN_EVT_ERR_FRAME_IDE = $05;
SLCAN_EVT_ERR_FRAME_ID17_ID13 = $07;
SLCAN_EVT_ERR_FRAME_ID12_ID5 = $0F;
SLCAN_EVT_ERR_FRAME_ID4_ID0 = $0E;
SLCAN_EVT_ERR_FRAME_RTR = $0C;
SLCAN_EVT_ERR_FRAME_RSRV0 = $0D;
SLCAN_EVT_ERR_FRAME_RSRV1 = $09;
SLCAN_EVT_ERR_FRAME_DLC = $0B;
SLCAN_EVT_ERR_FRAME_DATA = $0A;
SLCAN_EVT_ERR_FRAME_CRC_SEQ = $08;
SLCAN_EVT_ERR_FRAME_CRC_DEL = $18;
SLCAN_EVT_ERR_FRAME_ACK_SLOT = $19;
SLCAN_EVT_ERR_FRAME_ACK_DEL = $1B;
SLCAN_EVT_ERR_FRAME_EOF = $1A;
SLCAN_EVT_ERR_FRAME_INTER = $12;
SLCAN_EVT_ERR_FRAME_AER_FLAG = $11;
SLCAN_EVT_ERR_FRAME_PER_FLAG = $16;
SLCAN_EVT_ERR_FRAME_TDB = $13;
SLCAN_EVT_ERR_FRAME_ERR_DEL = $17;
SLCAN_EVT_ERR_FRAME_OVER_FLAG = $1C;
SLCAN_TX_STATUS_OK =$00;
SLCAN_TX_STATUS_TIMEOUT =$01;
SLCAN_TX_STATUS_BUSOFF =$02;
SLCAN_TX_STATUS_ABORT =$03;
SLCAN_TX_STATUS_NOT_ENA =$04;
SLCAN_TX_STATUS_ERROR_ONE_SHOT =$05;
SLCAN_TX_STATUS_INVALID_MODE =$06;
SLCAN_TX_STATUS_UNKNOWN =$0F;
SLCAN_PURGE_TX_ABORT =$01;
SLCAN_PURGE_RX_ABORT =$02;
SLCAN_PURGE_TX_CLEAR =$04;
SLCAN_PURGE_RX_CLEAR =$08;
type
//{$IFDEF CompilerVersion}
//{$IF CompilerVersion >= 16 }
//TSlCanDevice = NativeUInt;
//{$ELSE}
//TSlCanDevice = longword;
//{$ENDIF}
//{$ELSE}
TSlCanDevice = longword;
//{$ENDIF}
PSlCanCapabilities = ^TSlCanCapabilities;
TSlCanCapabilities = packed record
bModes:byte;
bTXModes:byte;
bMaxEventLevel:byte;
bController:byte;
bPhysical:byte;
bPhysicalLoad:byte;
bBitrates:byte;
bAdvancedModes:byte;
dwCanBaseClk:longword;
dwTimeStampClk:longword;
wMaxBrp:word;
end;
PSlCanState = ^TSlCanState;
TSlCanState = packed record
States: array [0 .. 1] of byte;
ErrCountRX:byte;
ErrCountTX:byte;
end;
PSlCanMessage = ^TSlCanMessage;
TSlCanMessage = packed record
Info:byte;
ID:longword;
DataCount:byte;
Data: array [0 .. 7] of byte;
end;
PSlCanTxMessage = ^TSlCanTxMessage;
TSlCanTxMessage = packed record
dwDelay:longint;
Msg:TSlCanMessage;
end;
PSlCanEvent = ^TSlCanEvent;
TSlCanEvent = packed record
EventType:byte;
TimeStampLo:longword;
case integer of
0:(Msg:TSlCanMessage);
1:(TimeStamp: array [0 .. 1] of longword);
2:(TimeStamp64: UInt64);
3:(BusMode:byte;
bDummy1:byte;
ErrCountRX:byte;
ErrCountTX:byte;
ErrType:byte;
ErrDir:byte;
ErrFrame:byte;
LostArbitration:byte);
end;
PSlCanBitRate = ^TSlCanBitRate;
TSlCanBitRate = packed record
BRP:word;
TSEG1:byte;
TSEG2:byte;
SJW:byte;
SAM:byte;
end;
PSlCanTimeStamp = ^TSlCanTimeStamp;
TSlCanTimeStamp = packed record
case integer of
0:(Value:int64);
1:(dwValue: array [0 .. 1] of longword);
2:(wValue: array [0 .. 3] of word);
3:(bValue: array [0 .. 7] of byte);
end;
TSlCan_DeviceCallBack = procedure(
hDevice: TSlCanDevice;
dwIndex: longword;
Operation: longword;
pContext: pointer;
dwContextSize: longword
);stdcall;
TSlCan_DeviceListCallBack = procedure(
hDevice: TSlCanDevice;
dwIndex: longword;
pContext: pointer;
dwContextSize: longword
);stdcall;
function SlCan_Load(
DeviceProc: TSlCan_DeviceCallBack;
DeviceListProc: TSlCan_DeviceListCallBack
):longbool;stdcall;
function SlCan_Free(
bDoCallBack:longbool
):longbool;stdcall;
function SlCan_Update:longbool;stdcall;
function SlCan_GetDeviceCount:longword;stdcall;
function SlCan_GetDevice(
dwIndex:longword
):TSlCanDevice;stdcall;
function SlCan_DeviceGetHandle(
hDevice:TSlCanDevice
):THandle;stdcall;
function SlCan_DeviceGetProperty(
hDevice: TSlCanDevice;
dwIndex: longword;
pBuf: pAnsiChar;
dwSize: longword
):longword;stdcall;
function SlCan_DeviceGetPropertyW(
hDevice: TSlCanDevice;
dwIndex: longword;
pBuf: PWideChar;
dwSize: longword
):longword;stdcall;
function SlCan_DeviceGetRegKey(
hDevice: TSlCanDevice;
dwIndex: longword
):HKEY;stdcall;
function SlCan_DeviceSetContext(
hDevice:TSlCanDevice;
pBuf: pointer;
dwBufSize:longword
):pointer;stdcall;
function SlCan_DeviceGetContext(hDevice:TSlCanDevice):pointer;stdcall;
function SlCan_DeviceGetContextSize(
hDevice: TSlCanDevice
):longword;stdcall;
function SlCan_DeviceSetAlias(
hDevice: TSlCanDevice;
pBuf: PAnsiChar
):longbool;stdcall;
function SlCan_DeviceGetAlias(
hDevice:TSlCanDevice;
pBuf: PAnsiChar;
dwSize: longword
):longword;stdcall;
function SlCan_DeviceSetAliasW(
hDevice: TSlCanDevice;
pBuf: PWideChar
):longbool;stdcall;
function SlCan_DeviceGetAliasW(
hDevice: TSlCanDevice;
pBuf: PWideChar;
dwSize: longword
):longword;stdcall;
function SlCan_DeviceGetCapabilities(
hDevice: TSlCanDevice;
pCap: PSlCanCapabilities
):longbool;stdcall;
function SlCan_DeviceOpen(
hDevice:TSlCanDevice
):longbool;stdcall;
function SlCan_DeviceClose(
hDevice:TSlCanDevice
):longbool;stdcall;
function SlCan_DeviceSetMode(
hDevice: TSlCanDevice;
dwMode: longword
):longbool;stdcall;
function SlCan_DeviceGetMode(
hDevice: TSlCanDevice;
pdwMode: Plongword
):longbool;stdcall;
function SlCan_DeviceGetState(
hDevice:TSlCanDevice;
pState: PSlCanState
):longbool;stdcall;
function SlCan_DeviceSetTXTimeOut(
hDevice: TSlCanDevice;
dwValue: longword):longbool;stdcall;
function SlCan_DeviceGetTXTimeOut(
hDevice: TSlCanDevice;
pdwValue:Plongword
):longbool;stdcall;
function SlCan_DeviceGetBitRate(
hDevice: TSlCanDevice;
pBitRate:PSlCanBitRate
):longbool;stdcall;
function SlCan_DeviceSetBitRate(
hDevice: TSlCanDevice;
pBitRate:PSlCanBitRate
):longbool;stdcall;
function SlCan_DeviceEnaRec(
hDevice: TSlCanDevice;
bValue: byte
):longbool;stdcall;
function SlCan_DeviceSetLatency(
hDevice: TSlCanDevice;
bValue: byte
):longbool;stdcall;
function SlCan_DeviceGetLatency(
hDevice: TSlCanDevice;
pbValue: pbyte
):longbool;stdcall;
function SlCan_DevicePurge(
hDevice:TSlCanDevice;
bValue: byte
):longbool;stdcall;
function SlCan_DeviceSetEventLevel(
hDevice:TSlCanDevice;
bValue: byte
):longbool;stdcall;
function SlCan_DeviceGetEventLevel(
hDevice:TSlCanDevice;
pbValue: pbyte
):longbool;stdcall;
function SlCan_DeviceSetStartTimeStamp(
hDevice: TSlCanDevice;
pValue: PSlCanTimeStamp
):longbool;stdcall;
function SlCan_DeviceGetStartTimeStamp(
hDevice: TSlCanDevice;
pValue: PSlCanTimeStamp
):longbool;stdcall;
function SlCan_DeviceGetTimeStamp(
hDevice: TSlCanDevice;
pValue: PSlCanTimeStamp
):longbool;stdcall;
function SlCan_DeviceSetTimeStampPeriod(
hDevice: TSlCanDevice;
lValue: longint
):longbool;stdcall;
function SlCan_DeviceGetTimeStampPeriod(
hDevice: TSlCanDevice;
plValue: PLongint
):longbool;stdcall;
function SlCan_DeviceSetExMode(
hDevice: TSlCanDevice;
bMode: byte
):longbool;stdcall;
function SlCan_DeviceGetExMode(
hDevice:TSlCanDevice;
pbMode: pbyte
):longbool;stdcall;
function SlCan_DeviceWriteMessages(
hDevice: TSlCanDevice;
pMsg: PSlCanMessage;
Count: longword;
pStatus: pbyte
):longbool;stdcall;
function SlCan_DeviceWriteMessagesEx(
hDevice: TSlCanDevice;
pMsg: PSlCanTxMessage;
Count: longword;
pStatus: pbyte;
pdwCount:Plongword
):longbool;stdcall;
function SlCan_DeviceReadMessages(
hDevice: TSlCanDevice;
dwTimeOut:longword;
pMsg: PSlCanMessage;
Count: longword;
pCount: Plongword
):longbool;stdcall;
function SlCan_DeviceReadEvents(
hDevice: TSlCanDevice;
dwTimeOut:longword;
pEvent: PSlCanEvent;
Count: longword;
pCount: Plongword
):longbool;stdcall;
implementation
const
Dll = 'slcan.dll';
function SlCan_Load;stdcall;external Dll;
function SlCan_Free;stdcall;external Dll;
function SlCan_Update;stdcall;external Dll;
function SlCan_GetDeviceCount;stdcall;external Dll;
function SlCan_GetDevice;stdcall;external Dll;
function SlCan_DeviceGetHandle;stdcall;external Dll;
function SlCan_DeviceOpen;stdcall;external Dll;
function SlCan_DeviceClose;stdcall;external Dll;
function SlCan_DeviceGetProperty;stdcall;external Dll;
function SlCan_DeviceGetPropertyW;stdcall;external Dll;
function SlCan_DeviceGetRegKey;stdcall;external Dll;
function SlCan_DeviceSetAlias;stdcall;external Dll;
function SlCan_DeviceGetAlias;stdcall;external Dll;
function SlCan_DeviceSetAliasW;stdcall;external Dll;
function SlCan_DeviceGetAliasW;stdcall;external Dll;
function SlCan_DeviceGetCapabilities;stdcall;external Dll;
function SlCan_DeviceSetContext;stdcall;external Dll;
function SlCan_DeviceGetContext;stdcall;external Dll;
function SlCan_DeviceGetContextSize;stdcall;external Dll;
function SlCan_DeviceSetMode;stdcall;external Dll;
function SlCan_DeviceGetMode;stdcall;external Dll;
function SlCan_DeviceGetState;stdcall;external Dll;
function SlCan_DeviceSetTXTimeOut;stdcall;external Dll;
function SlCan_DeviceGetTXTimeOut;stdcall;external Dll;
function SlCan_DeviceGetBitRate;stdcall;external Dll;
function SlCan_DeviceSetBitRate;stdcall;external Dll;
function SlCan_DeviceEnaRec;stdcall;external Dll;
function SlCan_DeviceSetLatency;stdcall;external Dll;
function SlCan_DeviceGetLatency;stdcall;external Dll;
function SlCan_DevicePurge;stdcall;external Dll;
function SlCan_DeviceSetEventLevel;stdcall;external Dll;
function SlCan_DeviceGetEventLevel;stdcall;external Dll;
function SlCan_DeviceSetStartTimeStamp;stdcall;external Dll;
function SlCan_DeviceGetStartTimeStamp;stdcall;external Dll;
function SlCan_DeviceGetTimeStamp;stdcall;external Dll;
function SlCan_DeviceSetTimeStampPeriod;stdcall;external Dll;
function SlCan_DeviceGetTimeStampPeriod;stdcall;external Dll;
function SlCan_DeviceSetExMode;stdcall;external Dll;
function SlCan_DeviceGetExMode;stdcall;external Dll;
function SlCan_DeviceWriteMessages;stdcall;external Dll;
function SlCan_DeviceWriteMessagesEx;stdcall;external Dll;
function SlCan_DeviceReadMessages;stdcall;external Dll;
function SlCan_DeviceReadEvents;stdcall;external Dll;
end.

BIN
white_hero.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 766 B