pax_global_header 0000666 0000000 0000000 00000000064 13254235131 0014511 g ustar 00root root 0000000 0000000 52 comment=f19220ffa3c5e526f66ebbded5e0e1e789e7255d
etherbone-core-f19220ffa3c5e526f66ebbded5e0e1e789e7255d/ 0000775 0000000 0000000 00000000000 13254235131 0021652 5 ustar 00root root 0000000 0000000 etherbone-core-f19220ffa3c5e526f66ebbded5e0e1e789e7255d/GUI/ 0000775 0000000 0000000 00000000000 13254235131 0022276 5 ustar 00root root 0000000 0000000 etherbone-core-f19220ffa3c5e526f66ebbded5e0e1e789e7255d/GUI/XMLdevice/ 0000775 0000000 0000000 00000000000 13254235131 0024116 5 ustar 00root root 0000000 0000000 etherbone-core-f19220ffa3c5e526f66ebbded5e0e1e789e7255d/GUI/XMLdevice/Global.pas 0000664 0000000 0000000 00000001635 13254235131 0026030 0 ustar 00root root 0000000 0000000 // Copyright (C) 2011
// GSI Helmholtzzentrum fr Schwerionenforschung GmbH
//
// Author: M.Zweig
//
unit Global;
interface
uses etherbone,wrdevice_unit;
const
First_DNSAdress = 'asl720.acc.gsi.de:8989';
First_PortNumber= '400';
ArrayRange = 256;
var
myDNSAdress :string;
myAddress :eb_address_t;
myDevice :Twrdevice;
DeviceOffsetCount:Word;
DeviceCtrRegCount:Word;
DeviceDataCount :Word;
SendingCnt :integer;
PaketCnt :integer;
DeviceOffset:array[0..ArrayRange] of LongWord;
DeviceCtrReg:array[0..ArrayRange] of LongWord;
DeviceData :array[0..ArrayRange] of LongWord;
type TWrPacket= RECORD CASE Int64 OF
1: (wpack: Int64);
2: (r : PACKED RECORD
data : LongWord;
Adr : LongWord;
END;);
END;
implementation
end.
etherbone-core-f19220ffa3c5e526f66ebbded5e0e1e789e7255d/GUI/XMLdevice/UserSendData.dfm 0000664 0000000 0000000 00000006260 13254235131 0027134 0 ustar 00root root 0000000 0000000 object SendUserdata_Form: TSendUserdata_Form
Left = 0
Top = 0
Width = 505
Height = 275
AutoSize = True
Caption = 'Send User data'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 19
object Loop_SpeedButton: TSpeedButton
Left = 0
Top = 208
Width = 89
Height = 33
AllowAllUp = True
GroupIndex = 1
Caption = 'Loop'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
OnClick = Loop_SpeedButtonClick
end
object Send_SpeedButton: TSpeedButton
Left = 408
Top = 208
Width = 89
Height = 33
AllowAllUp = True
GroupIndex = 1
Caption = 'Send'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
OnClick = Send_SpeedButtonClick
end
object Panel1: TPanel
Left = 0
Top = 0
Width = 497
Height = 201
BevelInner = bvLowered
TabOrder = 0
object Label1: TLabel
Left = 16
Top = 139
Width = 131
Height = 19
Caption = 'Data to send (hex)'
end
object Label2: TLabel
Left = 16
Top = 8
Width = 79
Height = 19
Caption = 'Offset(hex)'
end
object Label3: TLabel
Left = 16
Top = 72
Width = 130
Height = 19
Caption = 'Register Adr.(hex)'
end
object DataToWrite_Edit: TEdit
Left = 13
Top = 161
Width = 250
Height = 27
TabOrder = 0
OnKeyPress = DataToWrite_EditKeyPress
end
object Offset_Edit: TEdit
Left = 15
Top = 30
Width = 98
Height = 27
TabOrder = 1
OnKeyPress = Offset_EditKeyPress
end
object RegArd_Edit: TEdit
Left = 15
Top = 94
Width = 130
Height = 27
TabOrder = 2
OnKeyPress = RegArd_EditKeyPress
end
object Panel2: TPanel
Left = 272
Top = 0
Width = 225
Height = 201
BevelInner = bvLowered
TabOrder = 3
object Send_Label: TLabel
Left = 16
Top = 16
Width = 80
Height = 19
Caption = 'Sending...'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
end
object Adress_Panel: TPanel
Left = 15
Top = 38
Width = 97
Height = 25
BevelInner = bvLowered
Caption = '00000000'
TabOrder = 0
end
object Data_Panel: TPanel
Left = 110
Top = 38
Width = 97
Height = 25
BevelInner = bvLowered
Caption = '00000000'
TabOrder = 1
end
end
end
object Timer1: TTimer
OnTimer = Timer1Timer
Left = 224
Top = 208
end
end
etherbone-core-f19220ffa3c5e526f66ebbded5e0e1e789e7255d/GUI/XMLdevice/UserSendData.pas 0000664 0000000 0000000 00000013051 13254235131 0027145 0 ustar 00root root 0000000 0000000 // Copyright (C) 2011
// GSI Helmholtzzentrum fr Schwerionenforschung GmbH
//
// Author: M.Zweig
//
unit UserSendData;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, StdCtrls, ExtCtrls,Global, etherbone, wrdevice_unit;
type
TSendUserdata_Form = class(TForm)
Panel1: TPanel;
Label1: TLabel;
Loop_SpeedButton:TSpeedButton;
Send_SpeedButton: TSpeedButton;
Timer1: TTimer;
DataToWrite_Edit: TEdit;
Label2: TLabel;
Offset_Edit: TEdit;
Label3: TLabel;
RegArd_Edit: TEdit;
Panel2: TPanel;
Send_Label: TLabel;
Adress_Panel: TPanel;
Data_Panel: TPanel;
procedure DataToWrite_EditKeyPress(Sender: TObject; var Key: Char);
procedure RegArd_EditKeyPress(Sender: TObject; var Key: Char);
procedure Offset_EditKeyPress(Sender: TObject; var Key: Char);
procedure Loop_SpeedButtonClick(Sender: TObject);
procedure Send_SpeedButtonClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormShow(Sender: TObject);
function ReadUserInput(var WrPacket:TWrPacket):boolean;
const
Text_Send= 'Sending...';
public
{ Public-Deklarationen }
end;
Var
SendUserdata_Form:TSendUserdata_Form;
implementation
{$R *.dfm}
procedure TSendUserdata_Form.FormShow(Sender: TObject);
begin
Send_Label.Caption:='';
end;
procedure TSendUserdata_Form.Timer1Timer(Sender: TObject);
begin
if(Loop_Speedbutton.Down) or (Send_Speedbutton.Down) then begin
if(Send_Label.Caption = Text_Send) then Send_Label.Caption:=''
else Send_Label.Caption:= Text_Send
end else Send_Label.Caption:='';
Application.ProcessMessages;
end;
// User daten einmal an device senden
procedure TSendUserdata_Form.Send_SpeedButtonClick(Sender: TObject);
var status:string;
WrPacket:TWrPacket;
begin
if(Send_SpeedButton.Down) then begin
if (ReadUserInput(WrPacket)) then begin
// datenanzeigen
Adress_Panel.Caption:= IntToHex(WrPacket.r.Adr,8);
Data_Panel.Caption := IntToHex(WrPacket.r.data,8);
// daten schreiben
if not(myDevice.DeviceCacheWR(myAddress,WrPacket.wpack,status)) then
Application.MessageBox(PChar(status),'Dave? What are you doing?', 16);
myDevice.DeviceCacheSend(status);
end;
Send_SpeedButton.Down:=false;
Send_SpeedButton.Click;
end;
end;
// User daten im loop an die device senden
procedure TSendUserdata_Form.Loop_SpeedButtonClick(Sender: TObject);
var WrPacket:TWrPacket;
status:string;
index:integer;
begin
index:= 0;
if (ReadUserInput(WrPacket)) then begin
// datenanzeigen
Adress_Panel.Caption:= IntToHex(WrPacket.r.Adr,8);
Data_Panel.Caption := IntToHex(WrPacket.r.data,8);
while(Loop_SpeedButton.Down) do begin
index:=index+1;
if (ReadUserInput(WrPacket)) then begin
// daten schreiben
if not(myDevice.DeviceCacheWR(myAddress,WrPacket.wpack,status)) then begin
Application.MessageBox(PChar(status),'Finish Him', 16);
Loop_SpeedButton.Down:=false;
Loop_SpeedButton.Click;
end else myDevice.DeviceCacheSend(status);
end;
if((index mod 100)=0) then begin
index:= 0;
Application.ProcessMessages;
end;
end;
end;
end;
// User daten uebernehem und in das record uebertragen
function TSendUserdata_Form.ReadUserInput(var WrPacket:TWrPacket):boolean;
var offset :LongWord;
ErrFound :boolean;
begin
ErrFound:= false;
while length(Offset_Edit.Text)< 8 do
Offset_Edit.Text:='0'+Offset_Edit.Text;
//Offset uebernehem
try
offset:= StrToInt('$'+ Offset_Edit.Text);
except
Application.MessageBox('This is not a valid hex data', 'You will never win !', 16);
ErrFound:= true;
end;
while length(RegArd_Edit.Text)< 8 do
RegArd_Edit.Text:='0'+RegArd_Edit.Text;
//Adresse uebernehmen
if not(ErrFound) then begin
try
WrPacket.r.Adr:= StrToInt('$'+RegArd_Edit.Text);
except
Application.MessageBox('This is not a valid hex Adress', 'You are false data...', 16);
ErrFound:= true;
end;
end;
while length(DataToWrite_Edit.Text)< 8 do
DataToWrite_Edit.Text:='0'+DataToWrite_Edit.Text;
//Daten uebernehmen
if not(ErrFound) then begin
try
WrPacket.r.data:= StrToInt('$'+ DataToWrite_Edit.Text);
except
Application.MessageBox('This is not a valid hex Adress', 'Let there be light...', 16);
ErrFound:= true;
end;
end;
//Adresse + Offset -> device prefix
if not(ErrFound) then begin
WrPacket.r.Adr:= WrPacket.r.Adr + offset;
end;
ReadUserInput:= not(ErrFound)
end;
procedure TSendUserdata_Form.Offset_EditKeyPress(Sender: TObject;
var Key: Char);
begin
if not(Key in ['0'..'9', 'A'..'F', 'a'..'f'])or (length(Offset_Edit.Text)>= 8) then begin
//Edit_WR_Constant.Text:='0000';
Key:= #0;
end;
end;
procedure TSendUserdata_Form.RegArd_EditKeyPress(Sender: TObject;
var Key: Char);
begin
begin
if not(Key in ['0'..'9', 'A'..'F', 'a'..'f'])or (length(RegArd_Edit.Text)>= 8) then begin
//Edit_WR_Constant.Text:='0000';
Key:= #0;
end;
end;
end;
procedure TSendUserdata_Form.DataToWrite_EditKeyPress(Sender: TObject;
var Key: Char);
begin
begin
if not(Key in ['0'..'9', 'A'..'F', 'a'..'f'])or (length(DataToWrite_Edit.Text) >= 8) then begin
//Edit_WR_Constant.Text:='0000';
Key:= #0;
end;
end;
end;
end. etherbone-core-f19220ffa3c5e526f66ebbded5e0e1e789e7255d/GUI/XMLdevice/WR.bdsproj 0000664 0000000 0000000 00000017564 13254235131 0026050 0 ustar 00root root 0000000 0000000
7.0
8
1
1
1
0
0
1
1
1
0
0
1
0
1
0
1
0
0
0
0
0
1
0
1
1
1
True
True
WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
False
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
True
False
False
False
True
True
True
0
0
1
False
False
False
16384
1048576
4194304
rtl;vcl;dbrtl;vcldb;vclx;adortl;dbxcds;dbexpress;vclib;ibxpress;IntrawebDB_72_90;Intraweb_72_90;xmlrtl;vclie;inet;inetdbbde;inetdbxpress;IndySystem;IndyCore;dclOfficeXP;VclSmp;soaprtl;dsnap;IndyProtocols;inetdb;bdertl;vcldbx;webdsnap;websnap;vclactnband;vclshlctrls;teeui;teedb;tee;dsnapcon;Rave60VCL
False
False
False
$00000000
False
False
1
0
0
0
False
False
False
False
False
1031
1252
1.0.0.0
1.0.0.0
etherbone-core-f19220ffa3c5e526f66ebbded5e0e1e789e7255d/GUI/XMLdevice/WR.bdsproj.local 0000664 0000000 0000000 00000006132 13254235131 0027126 0 ustar 00root root 0000000 0000000
2011.04.01 12:19:06.708.pas,E:\Documents and Settings\localadmin\My Documents\Borland Studio-Projekte\Unit1.pas=F:\Projekte\Timing\xml\whiterabbit\XMLdevice\XML_WR.pas
2011.04.01 12:19:06.708.dfm,E:\Documents and Settings\localadmin\My Documents\Borland Studio-Projekte\Unit1.dfm=F:\Projekte\Timing\xml\whiterabbit\XMLdevice\XML_WR.dfm
2011.04.04 09:14:45.590.pas,F:\Projekte\Timing\xml\whiterabbit\XMLdevice\Unit1.pas=F:\Projekte\Timing\xml\whiterabbit\XMLdevice\device_unit.pas
2011.04.04 12:02:24.754.pas,F:\Projekte\Timing\xml\whiterabbit\XMLdevice\device_unit.pas=F:\Projekte\Timing\xml\whiterabbit\XMLdevice\wrdevice_unit.pas
2011.04.04 16:05:21.523.pas,F:\Projekte\Timing\xml\whiterabbit\XMLdevice\Unit2.pas=F:\Projekte\Timing\xml\whiterabbit\XMLdevice\device_setup.pas
2011.04.04 16:05:21.523.dfm,F:\Projekte\Timing\xml\whiterabbit\XMLdevice\Unit2.dfm=F:\Projekte\Timing\xml\whiterabbit\XMLdevice\device_setup.dfm
2011.04.04 16:34:13.557.pas,F:\Projekte\Timing\xml\whiterabbit\XMLdevice\Unit1.pas=F:\Projekte\Timing\xml\whiterabbit\XMLdevice\Global.pas
2011.04.05 08:57:37.062.pas,F:\Projekte\Timing\xml\whiterabbit\XMLdevice\Unit2.pas=F:\Projekte\Timing\xml\whiterabbit\XMLdevice\UserSendData.pas
2011.04.05 08:57:37.062.dfm,F:\Projekte\Timing\xml\whiterabbit\XMLdevice\Unit2.dfm=F:\Projekte\Timing\xml\whiterabbit\XMLdevice\UserSendData.dfm
2011.04.06 13:59:40.907.pas,F:\Projekte\Timing\xml\whiterabbit\XMLdevice\UserSendData.pas=
2011.04.06 13:59:40.907.dfm,F:\Projekte\Timing\xml\whiterabbit\XMLdevice\UserSendData.dfm=
2011.04.06 15:32:39.998.pas,F:\Projekte\Timing\etherbone-core\api\etherbone.pas=
2011.04.06 15:41:11.594.pas,F:\Projekte\Timing\etherbone-core\GUI\XMLdevice\wrdevice_unit.pas=
2011.04.06 15:41:19.735.pas,F:\Projekte\Timing\etherbone-core\GUI\XMLdevice\UserSendData.pas=
2011.04.06 15:41:19.735.dfm,F:\Projekte\Timing\etherbone-core\GUI\XMLdevice\UserSendData.dfm=
2011.04.06 15:41:27.641.pas,F:\Projekte\Timing\etherbone-core\GUI\XMLdevice\Global.pas=
2011.04.06 15:41:29.485.pas,F:\Projekte\Timing\etherbone-core\api\etherbone.pas=
2011.04.06 15:41:30.172.pas,F:\Projekte\Timing\etherbone-core\GUI\XMLdevice\device_setup.pas=
2011.04.06 15:41:30.172.dfm,F:\Projekte\Timing\etherbone-core\GUI\XMLdevice\device_setup.dfm=
2011.04.08 15:55:31.433.pas,F:\Projekte\Timing\etherbone-core\GUI\XMLdevice\Unit1.pas=F:\Projekte\Timing\etherbone-core\GUI\XMLdevice\XML_collector.pas
etherbone-core-f19220ffa3c5e526f66ebbded5e0e1e789e7255d/GUI/XMLdevice/WR.cfg 0000664 0000000 0000000 00000000762 13254235131 0025134 0 ustar 00root root 0000000 0000000 -$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"E:\Documents and Settings\localadmin\My Documents\Borland Studio-Projekte\Bpl"
-LN"E:\Documents and Settings\localadmin\My Documents\Borland Studio-Projekte\Bpl"
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST
etherbone-core-f19220ffa3c5e526f66ebbded5e0e1e789e7255d/GUI/XMLdevice/WR.dpr 0000664 0000000 0000000 00000001207 13254235131 0025155 0 ustar 00root root 0000000 0000000 program WR;
uses
Forms,
XML_WR in 'XML_WR.pas' {Form1},
wrdevice_unit in 'wrdevice_unit.pas',
device_setup in 'device_setup.pas' {DevSet_Form},
device_unit in 'device_unit.pas',
Global in 'Global.pas',
UserSendData in 'UserSendData.pas' {SendUserdata_Form},
etherbone in '..\..\api\etherbone.pas',
XML_collector in 'XML_collector.pas';
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.CreateForm(TDevSet_Form, DevSet_Form);
Application.CreateForm(TSendUserdata_Form, SendUserdata_Form);
Application.Run;
end.
etherbone-core-f19220ffa3c5e526f66ebbded5e0e1e789e7255d/GUI/XMLdevice/WR.identcache 0000664 0000000 0000000 00000001227 13254235131 0026461 0 ustar 00root root 0000000 0000000 3F:\Projekte\Timing\etherbone-core\api\etherbone.pas 6F:\Projekte\Timing\etherbone-core\GUI\XMLdevice\WR.dpr :F:\Projekte\Timing\etherbone-core\GUI\XMLdevice\XML_WR.pas AF:\Projekte\Timing\etherbone-core\GUI\XMLdevice\XML_collector.pas @F:\Projekte\Timing\etherbone-core\GUI\XMLdevice\UserSendData.pas @F:\Projekte\Timing\etherbone-core\GUI\XMLdevice\device_setup.pas AF:\Projekte\Timing\etherbone-core\GUI\XMLdevice\wrdevice_unit.pas :F:\Projekte\Timing\etherbone-core\GUI\XMLdevice\Global.pas ?F:\Projekte\Timing\etherbone-core\GUI\XMLdevice\device_unit.pas etherbone-core-f19220ffa3c5e526f66ebbded5e0e1e789e7255d/GUI/XMLdevice/WR.res 0000664 0000000 0000000 00000010454 13254235131 0025165 0 ustar 00root root 0000000 0000000 ( @ U_U U?U U_U U?U U_* U_U U?U U_U U_U U?U U_U U?U U_U U?U U_U U_U U_U U_U U _U _U _U _U U?U U U U U U U_U U U U?U U_U _ U U_U U U _U _U U U?U U U U U U?U U_U U_U U_U U U_ _U _U _U _* U_U U U U U U_U U_U U_U U_U U U_U U _* _U _U U?U U U U?U U U U_ U _U _U _U _U U_U U U U U_U U U U U UU U?U U?U U_U U?U U_U U_* U?U U?U U_U U?U U_U ?U U?U U_U U U U U_ ? ?U U?U U_U U U U? ? _U UU UU U U UU U?U U U U? _U U U_ ? U? ? U?U UU UU U U U UU U?U U U U_ ? U U_ U U U? _ U U_U U U U U U U_U ʦ U U _ ?U U_ ?U U_ U U_ ? ? U?U U UU UU U U U U?U ʦ _ U _ U_ ?U U_ ? U_U U U U? U_ ? U_U UU U U U U U_* _ _ U_ _ U?U U_ U_ U_U U_U U_ U_U U_U U_ U_U U_U U_ U_U U_U U_U U_ _ U_ _ U? ?U _ ? U U ? U? _ _ _ UU U?U U_ _ U U U_ U?U U U U _ ? U? ? ? ?U ? ? U U_ U? U_ ?U U U U U? ? _ U_ U_ U U_U ? U_ U_ _ U_ ? U U U _ U_ _ U ? ? ? U? _ _ U_ ? U? U U U_U U U_ U_ U_ U U? ? _ U_ ? U U ?U U U U U U U U_ U U?U _ ? ?U U_ U? ? U U U?U U_U U_ UU U_ ? U ? U U U U_ ?U _ U_ U_U U_U _ UU U U U_ U U ? U_ _ U UU _U U_ U_ ? U U? U ? U_ _ U _ U_U ? ?U U U U U U U U ? ? ? ? _ UU U? ? ?U ?U ? ? ? ? U_ _ U? ? ? ? ? U? U_ ʦ ʦ ? 0 M A I N I C O N etherbone-core-f19220ffa3c5e526f66ebbded5e0e1e789e7255d/GUI/XMLdevice/XML_WR.dfm 0000664 0000000 0000000 00000017612 13254235131 0025665 0 ustar 00root root 0000000 0000000 object Form1: TForm1
Left = 0
Top = 0
Width = 657
Height = 601
AutoSize = True
Caption = 'whiterabbit'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Tahoma'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 19
object Panel1: TPanel
Left = 0
Top = 0
Width = 457
Height = 385
BevelInner = bvLowered
TabOrder = 0
object Label1: TLabel
Left = 16
Top = 7
Width = 66
Height = 19
Caption = 'XML Tree'
end
object XML_TreeView: TTreeView
Left = 15
Top = 31
Width = 426
Height = 338
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Tahoma'
Font.Style = [fsBold]
Indent = 19
ParentFont = False
TabOrder = 0
end
end
object Panel2: TPanel
Left = 0
Top = 384
Width = 504
Height = 163
BevelInner = bvLowered
TabOrder = 1
object messages_ListBox: TListBox
Left = 8
Top = 8
Width = 487
Height = 129
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = 'Tahoma'
Font.Style = []
ItemHeight = 18
ParentFont = False
TabOrder = 0
end
object Clear_Button: TButton
Left = 429
Top = 140
Width = 65
Height = 17
Caption = 'Clear'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
TabOrder = 1
OnClick = Clear_ButtonClick
end
end
object Panel3: TPanel
Left = 448
Top = 0
Width = 201
Height = 386
BevelInner = bvLowered
TabOrder = 2
object Panel4: TPanel
Left = 0
Top = 0
Width = 201
Height = 49
BevelInner = bvLowered
TabOrder = 0
object Label2: TLabel
Left = 24
Top = 13
Width = 91
Height = 19
Caption = 'Device active'
end
object DeviceActiv_Shape: TShape
Left = 148
Top = 11
Width = 33
Height = 25
Brush.Color = clRed
Shape = stCircle
end
end
object Panel5: TPanel
Left = 0
Top = 46
Width = 201
Height = 108
BevelInner = bvLowered
TabOrder = 1
object Label3: TLabel
Left = 8
Top = 8
Width = 46
Height = 19
Caption = 'Device'
end
object SendData_Button: TButton
Left = 7
Top = 39
Width = 105
Height = 25
Caption = 'Send Data'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 0
OnClick = SendData_ButtonClick
end
object Panel6: TPanel
Left = 0
Top = 67
Width = 201
Height = 41
BevelInner = bvLowered
TabOrder = 1
object ReadData_Button: TButton
Left = 8
Top = 8
Width = 105
Height = 25
Caption = 'Read Data'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 0
OnClick = ReadData_ButtonClick
end
object LoopRD_CheckBox: TCheckBox
Left = 129
Top = 12
Width = 65
Height = 17
Caption = 'Loop'
Enabled = False
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
TabOrder = 1
OnClick = LoopRD_CheckBoxClick
end
end
object LoopSD_CheckBox: TCheckBox
Left = 128
Top = 43
Width = 65
Height = 17
Caption = 'Loop'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
TabOrder = 2
OnClick = LoopSD_CheckBoxClick
end
end
object Panel7: TPanel
Left = 0
Top = 152
Width = 201
Height = 113
BevelInner = bvLowered
TabOrder = 2
object Label4: TLabel
Left = 8
Top = 16
Width = 48
Height = 18
Caption = 'Pakets:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
end
object Label5: TLabel
Left = 8
Top = 56
Width = 62
Height = 18
Caption = 'Sendings:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
end
object PaketsCnt_Panel: TPanel
Left = 80
Top = 15
Width = 107
Height = 26
BevelInner = bvLowered
Caption = '0'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
TabOrder = 0
end
object Sendings_Panel: TPanel
Left = 80
Top = 52
Width = 107
Height = 26
BevelInner = bvLowered
Caption = '0'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
TabOrder = 1
end
object ClearCnt_Button: TButton
Left = 120
Top = 87
Width = 65
Height = 17
Caption = 'Clear'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
TabOrder = 2
OnClick = ClearCnt_ButtonClick
end
end
end
object PollSocket_Timer: TTimer
Interval = 100
OnTimer = PollSocket_TimerTimer
Left = 512
Top = 392
end
object OpenDialog1: TOpenDialog
Filter = 'XML Files |*.xml'
Left = 512
Top = 424
end
object MainMenu1: TMainMenu
Left = 512
Top = 456
object D1: TMenuItem
Caption = 'Datei'
object XMLLaden1: TMenuItem
Caption = 'XML-Laden'
OnClick = XMLLaden1Click
end
object Exit1: TMenuItem
Caption = 'Exit'
OnClick = Exit1Click
end
end
object Device1: TMenuItem
Caption = 'Device'
object Setup1: TMenuItem
Caption = 'Setup'
OnClick = Setup1Click
end
object ConnectDevice1: TMenuItem
Caption = 'Connect Device'
OnClick = ConnectDevice1Click
end
object DisconnectDevice1: TMenuItem
Caption = 'Disconnect Device'
OnClick = DisconnectDevice1Click
end
end
object Extras1: TMenuItem
Caption = 'Extras'
object SendManual1: TMenuItem
Caption = 'Send Manual'
OnClick = SendManual1Click
end
end
end
object XMLDoc: TXMLDocument
Left = 512
Top = 488
DOMVendorDesc = 'MSXML'
end
object Lamp_Timer: TTimer
OnTimer = Lamp_TimerTimer
Left = 544
Top = 392
end
end
etherbone-core-f19220ffa3c5e526f66ebbded5e0e1e789e7255d/GUI/XMLdevice/XML_WR.pas 0000664 0000000 0000000 00000023674 13254235131 0025707 0 ustar 00root root 0000000 0000000 // Copyright (C) 2011
// GSI Helmholtzzentrum fr Schwerionenforschung GmbH
//
// Author: M.Zweig
//
unit XML_WR;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, xmldom, XMLIntf, Menus, msxmldom, XMLDoc, ComCtrls, ExtCtrls,
StdCtrls,wrdevice_unit, device_setup,etherbone,Global,UserSendData,XML_collector;
type
TForm1 = class(TForm)
Panel1: TPanel;
XML_TreeView: TTreeView;
Label1: TLabel;
Panel2: TPanel;
messages_ListBox: TListBox;
Clear_Button: TButton;
Panel3: TPanel;
Panel4: TPanel;
Label2: TLabel;
DeviceActiv_Shape: TShape;
Panel5: TPanel;
SendData_Button: TButton;
Label3: TLabel;
PollSocket_Timer: TTimer;
OpenDialog1: TOpenDialog;
MainMenu1: TMainMenu;
D1: TMenuItem;
XMLLaden1: TMenuItem;
Exit1: TMenuItem;
Device1: TMenuItem;
ConnectDevice1: TMenuItem;
DisconnectDevice1: TMenuItem;
Setup1: TMenuItem;
XMLDoc: TXMLDocument;
Extras1: TMenuItem;
SendManual1: TMenuItem;
Panel6: TPanel;
ReadData_Button: TButton;
LoopSD_CheckBox: TCheckBox;
Lamp_Timer: TTimer;
LoopRD_CheckBox: TCheckBox;
Panel7: TPanel;
Label4: TLabel;
PaketsCnt_Panel: TPanel;
Label5: TLabel;
Sendings_Panel: TPanel;
ClearCnt_Button: TButton;
procedure ClearCnt_ButtonClick(Sender: TObject);
procedure LoopRD_CheckBoxClick(Sender: TObject);
procedure Lamp_TimerTimer(Sender: TObject);
procedure LoopSD_CheckBoxClick(Sender: TObject);
procedure SendData_ButtonClick(Sender: TObject);
procedure XMLLaden1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure SendManual1Click(Sender: TObject);
procedure ReadData_ButtonClick(Sender: TObject);
//procedure myCallback(var user: eb_user_data_t; var status: eb_status_t; var data:eb_data_t );
procedure PollSocket_TimerTimer(Sender: TObject);
procedure Clear_ButtonClick(Sender: TObject);
procedure DisconnectDevice1Click(Sender: TObject);
procedure ConnectDevice1Click(Sender: TObject);
procedure Setup1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure SendPacketsaway(offset:longword);
procedure NodeGetAttribute(node:IXMLNode; var kindknoten:TTreeNode; knoten:TTreeNode);
procedure UpdateCntPanels();
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1 :TForm1;
myStatus :string;
XML_collector:TXML_collector;
myDeviceisOpen:boolean;
implementation
{$R *.dfm}
procedure myCallback(var user: eb_user_data_t; var status: eb_status_t; var data:eb_data_t );
begin
Form1.messages_ListBox.Items.Add('Data receive: '+IntToHex(data,32));
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
myDevice:= Twrdevice.Create;
myDeviceisOPen:=false;
PaketsCnt_Panel.Caption:='0';
Sendings_Panel.Caption:='0';
SendingCnt := 0;
PaketCnt := 0;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
myDeviceisOPen:=false;
LoopSD_CheckBox.Checked:=false;
Form1.Update;
Application.ProcessMessages();
myDevice.DeviceClose(myStatus);
myDevice.Free;
end;
procedure TForm1.Setup1Click(Sender: TObject);
begin
DevSet_Form.Show;
end;
procedure TForm1.ConnectDevice1Click(Sender: TObject);
begin
messages_ListBox.Items.Add('Try to Open: '+ myDNSAdress+
' Port:'+IntTohex(myAddress,4));
messages_ListBox.TopIndex:= messages_ListBox.Items.Count-1;
if(myDevice.DeviceOpen(Pchar(myDNSAdress), myAddress, myStatus)) then begin
DeviceActiv_Shape.Brush.Color:=clLime;
myDeviceisOPen:=true;
end else DeviceActiv_Shape.Brush.Color:=clRed;
messages_ListBox.Items.Add('Device Open: '+myStatus);
messages_ListBox.TopIndex:= messages_ListBox.Items.Count-1;
end;
procedure TForm1.DisconnectDevice1Click(Sender: TObject);
begin
if(myDevice.DeviceClose(myStatus)) then begin
DeviceActiv_Shape.Brush.Color:= clRed;
myDeviceisOPen:=false;
end else DeviceActiv_Shape.Brush.Color:=clYellow;
messages_ListBox.Items.Add('Device Close: '+myStatus);
messages_ListBox.TopIndex:= messages_ListBox.Items.Count-1;
end;
procedure TForm1.Clear_ButtonClick(Sender: TObject);
begin
messages_ListBox.Items.Clear;
end;
procedure TForm1.PollSocket_TimerTimer(Sender: TObject);
begin
myDevice.DevicePoll();
end;
procedure TForm1.ReadData_ButtonClick(Sender: TObject);
begin
if not(myDevice.DeviceRead(@myCallback, myAddress, myStatus)) then begin
messages_ListBox.Items.Add('Device Read: '+myStatus);
messages_ListBox.TopIndex:= messages_ListBox.Items.Count-1;
end;
end;
procedure TForm1.SendManual1Click(Sender: TObject);
begin
SendUserdata_Form.Show();
end;
procedure TForm1.Exit1Click(Sender: TObject);
begin
Form1.Close;
end;
procedure TForm1.XMLLaden1Click(Sender: TObject);
var
node : IXMLNode;
nodes : IXMLNodeList;
knoten : TTreeNode;
s : string;
i : integer;
procedure erweitere(node : IXMLNode;knoten : TTreeNode);
var
nodes : IXMLNodeList;
kindknoten : TTreeNode;
i : integer;
begin
if node.HasChildNodes then
begin
nodes := node.ChildNodes;
for i := 0 to nodes.Count - 1 do
begin
case nodes[i].NodeType of
ntElement : NodeGetAttribute(nodes[i],kindknoten,knoten);
ntText : kindknoten := XML_TreeView.Items.AddChild(knoten,nodes[i].text);
end; // of case
erweitere(nodes[i],kindknoten);
end;
end;
end;
begin
if OpenDialog1.Execute then
try
XML_TreeView.Items.Clear;
XMLDoc.LoadFromFile(OpenDialog1.FileName);
node := XMLDoc.DocumentElement;
nodes := node.AttributeNodes;
s := '';
for i := 0 to nodes.Count - 1 do
s := s + nodes[i].NodeName + ' = ' +nodes[i].NodeValue + ' ';
knoten := XML_TreeView.Items.Add(nil,'<'+node.NodeName+'> '+s);
erweitere(node,knoten);
except
on E:Exception do
messages_Listbox.Items.Add(E.Message);
end;
end;
procedure TForm1.SendData_ButtonClick(Sender: TObject);
var index:integer;
nodes: IXMLNodeList;
begin
if XMLDoc.Active and myDeviceisOpen then begin
nodes:= XMLDoc.DocumentElement.ChildNodes;
for index:=0 to Nodes.Count-1 do begin
XML_collector.AnalyseXMLTree(Nodes[index].Childnodes);
SendPacketsaway(StrToInt('$'+VarToStr(Nodes[index].GetAttribute('value'))));
end;
end else Application.MessageBox('Device not open or XML not loaded !','Whats up doc?', 16);
end;
procedure TForm1.SendPacketsaway(offset:longword);
var index:integer;
status:string;
WrPacket:TWrPacket;
errorfound:boolean;
begin
errorfound:=false;
for index:= 0 to DeviceCtrRegCount-1 do begin
DeviceCtrReg[index]:= DeviceCtrReg[index] + offset;
WrPacket.r.Adr := DeviceCtrReg[index];
WrPacket.r.data:= DeviceData [index];
if not(myDevice.DeviceCacheWR(myAddress,WrPacket.wpack,status)) then begin
messages_ListBox.Items.Add('DeviceCache:'+status);
errorfound:=true;
end else PaketCnt:=PaketCnt+1;
end;
if not errorfound then begin
if not (myDevice.DeviceCacheSend(status)) then
messages_ListBox.Items.Add('DeviceCacheSend:'+status);
SendingCnt:=SendingCnt+1;
if not (LoopSD_CheckBox.Checked) then begin
messages_ListBox.Items.Add('sending....');
messages_ListBox.TopIndex:= messages_ListBox.Items.Count-1;
UpdateCntPanels();
end else begin
if ((SendingCnt mod 100)=0)then begin
UpdateCntPanels();
end;
end;
end;
end;
procedure TForm1.NodeGetAttribute(node:IXMLNode; var kindknoten:TTreeNode; knoten:TTreeNode);
begin
if node.HasChildNodes then begin
kindknoten := XML_TreeView.Items.AddChild(knoten,'<'+ node.NodeName+'>'+
'*value:'+VarToStr(node.Attributes['value']));
end else begin
kindknoten := XML_TreeView.Items.AddChild(knoten,'<'+
node.NodeName+'>'+' *value:'+VarToStr(node.Attributes['value'])+
' *bitpos:'+ VarToStr(node.Attributes['bitpos']));
end;
end;
procedure TForm1.LoopSD_CheckBoxClick(Sender: TObject);
var index: integer;
begin
while LoopSD_CheckBox.Checked and myDeviceisOpen and XMLDoc.Active do begin
SendData_Button.Enabled:= false;
SendData_Button.Click;
index:=index+1;
if((index mod 100)=0) then begin
index:= 0;
Application.ProcessMessages;
end;
end;
LoopSD_CheckBox.Checked:= false;
SendData_Button.Enabled:= true;
end;
procedure TForm1.Lamp_TimerTimer(Sender: TObject);
begin
if ((LoopSD_CheckBox.Checked) or (LoopRD_CheckBox.Checked)) and
(DeviceActiv_Shape.Brush.Color=clLime) then begin
if DeviceActiv_Shape.Brush.Color = clLime then DeviceActiv_Shape.Brush.Color:=clYellow else
DeviceActiv_Shape.Brush.Color:=clLime;
end else if(DeviceActiv_Shape.Brush.Color <> clRed) then DeviceActiv_Shape.Brush.Color:=clLime;
end;
procedure TForm1.LoopRD_CheckBoxClick(Sender: TObject);
var index:integer;
begin
while LoopRD_CheckBox.Checked and myDeviceisOpen do begin
ReadData_Button.Enabled:= false;
index:=index+1;
// if((index mod 50)=0) then
if((index mod 100)=0) then begin
index:= 0;
ReadData_Button.Click;
Application.ProcessMessages;
end;
end;
LoopRD_CheckBox.Checked:= false;
ReadData_Button.Enabled:= true;
end;
procedure TForm1.ClearCnt_ButtonClick(Sender: TObject);
begin
PaketsCnt_Panel.Caption:='0';
Sendings_Panel.Caption:='0';
SendingCnt := 0;
PaketCnt := 0;
end;
procedure TForm1.UpdateCntPanels();
begin
Sendings_Panel.Caption :=IntToStr(SendingCnt);
PaketsCnt_Panel.Caption :=IntToStr(PaketCnt);
end;
end.
etherbone-core-f19220ffa3c5e526f66ebbded5e0e1e789e7255d/GUI/XMLdevice/XML_collector.dcu 0000664 0000000 0000000 00000007705 13254235131 0027332 0 ustar 00root root 0000000 0000000
>Ql>
XML_collector