V1.3
This commit is contained in:
f1iwq2
Binary file not shown.
@@ -12,7 +12,7 @@
|
||||
-$L+
|
||||
-$M-
|
||||
-$N+
|
||||
-$O-
|
||||
-$O+
|
||||
-$P+
|
||||
-$Q-
|
||||
-$R-
|
||||
@@ -33,10 +33,3 @@
|
||||
-K$00400000
|
||||
-LE"c:\program files (x86)\borland\delphi7\Projects\Bpl"
|
||||
-LN"c:\program files (x86)\borland\delphi7\Projects\Bpl"
|
||||
-U"c:\program files (x86)\borland\delphi7\Lib\Debug"
|
||||
-O"c:\program files (x86)\borland\delphi7\Lib\Debug"
|
||||
-I"c:\program files (x86)\borland\delphi7\Lib\Debug"
|
||||
-R"c:\program files (x86)\borland\delphi7\Lib\Debug"
|
||||
-w-UNSAFE_TYPE
|
||||
-w-UNSAFE_CODE
|
||||
-w-UNSAFE_CAST
|
||||
|
||||
@@ -15,7 +15,7 @@ K=0
|
||||
L=1
|
||||
M=0
|
||||
N=1
|
||||
O=0
|
||||
O=1
|
||||
P=1
|
||||
Q=0
|
||||
R=0
|
||||
@@ -76,9 +76,9 @@ LocaleToUnicode=1
|
||||
ImagebaseMultiple=1
|
||||
SuspiciousTypecast=1
|
||||
PrivatePropAccessor=1
|
||||
UnsafeType=0
|
||||
UnsafeCode=0
|
||||
UnsafeCast=0
|
||||
UnsafeType=1
|
||||
UnsafeCode=1
|
||||
UnsafeCast=1
|
||||
[Linker]
|
||||
MapFile=0
|
||||
OutputObjs=0
|
||||
@@ -94,8 +94,8 @@ OutputDir=
|
||||
UnitOutputDir=
|
||||
PackageDLLOutputDir=
|
||||
PackageDCPOutputDir=
|
||||
SearchPath=$(DELPHI)\Lib\Debug
|
||||
Packages=vcl;rtl;vclx;VclSmp;vclshlctrls
|
||||
SearchPath=
|
||||
Packages=
|
||||
Conditionals=
|
||||
DebugSourceDirs=
|
||||
UsePackages=0
|
||||
@@ -107,7 +107,7 @@ UseLauncher=0
|
||||
DebugCWD=
|
||||
[Version Info]
|
||||
IncludeVerInfo=1
|
||||
AutoIncBuild=1
|
||||
AutoIncBuild=0
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
Release=0
|
||||
@@ -130,9 +130,3 @@ OriginalFilename=
|
||||
ProductName=
|
||||
ProductVersion=1.0.0.0
|
||||
Comments=
|
||||
[HistoryLists\hlUnitAliases]
|
||||
Count=1
|
||||
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
|
||||
[HistoryLists\hlSearchPath]
|
||||
Count=1
|
||||
Item0=$(DELPHI)\Lib\Debug
|
||||
|
||||
@@ -6,7 +6,9 @@ uses
|
||||
UnitDebug in 'UnitDebug.pas' {FormDebug},
|
||||
verif_version in 'verif_version.pas' {FormVersion},
|
||||
UnitPilote in 'UnitPilote.pas' {FormPilote},
|
||||
UnitSimule in 'UnitSimule.pas' {FormSimulation};
|
||||
UnitSimule in 'UnitSimule.pas' {FormSimulation},
|
||||
UnitTCO in 'UnitTCO.pas' {FormTCO},
|
||||
listeusb in 'listeusb.pas';
|
||||
|
||||
{$R *.res}
|
||||
|
||||
@@ -16,5 +18,6 @@ begin
|
||||
Application.CreateForm(TFormDebug, FormDebug);
|
||||
Application.CreateForm(TFormPilote, FormPilote);
|
||||
Application.CreateForm(TFormSimulation, FormSimulation);
|
||||
Application.CreateForm(TFormTCO, FormTCO);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
BIN
UnitDebug.dcu
BIN
UnitDebug.dcu
Binary file not shown.
@@ -1,6 +1,6 @@
|
||||
object FormDebug: TFormDebug
|
||||
Left = 509
|
||||
Top = 108
|
||||
Left = 302
|
||||
Top = 166
|
||||
BorderStyle = bsSingle
|
||||
Caption = 'Fen'#234'tre de d'#233'bug'
|
||||
ClientHeight = 639
|
||||
@@ -19,8 +19,8 @@ object FormDebug: TFormDebug
|
||||
PixelsPerInch = 96
|
||||
TextHeight = 13
|
||||
object Label1: TLabel
|
||||
Left = 456
|
||||
Top = 36
|
||||
Left = 464
|
||||
Top = 28
|
||||
Width = 108
|
||||
Height = 13
|
||||
Caption = 'Niveau du Debug (0-3)'
|
||||
@@ -64,8 +64,8 @@ object FormDebug: TFormDebug
|
||||
WordWrap = True
|
||||
end
|
||||
object EditNivDebug: TEdit
|
||||
Left = 576
|
||||
Top = 36
|
||||
Left = 592
|
||||
Top = 20
|
||||
Width = 73
|
||||
Height = 21
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
@@ -117,7 +117,7 @@ object FormDebug: TFormDebug
|
||||
end
|
||||
object CheckAffSig: TCheckBox
|
||||
Left = 448
|
||||
Top = 64
|
||||
Top = 48
|
||||
Width = 297
|
||||
Height = 17
|
||||
Caption = 'Affichage du fonctionnement des signaux'
|
||||
@@ -176,10 +176,11 @@ object FormDebug: TFormDebug
|
||||
end
|
||||
object CheckAffAffecTrains: TCheckBox
|
||||
Left = 448
|
||||
Top = 88
|
||||
Top = 64
|
||||
Width = 289
|
||||
Height = 17
|
||||
Caption = 'Affichage d'#39'affectation des trains aux d'#233'tecteurs'
|
||||
Enabled = False
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clBlack
|
||||
Font.Height = -11
|
||||
@@ -191,7 +192,7 @@ object FormDebug: TFormDebug
|
||||
end
|
||||
object CheckBoxTraceLIste: TCheckBox
|
||||
Left = 448
|
||||
Top = 112
|
||||
Top = 80
|
||||
Width = 289
|
||||
Height = 17
|
||||
Caption = 'Affichage des '#233'valuations des routes'
|
||||
@@ -204,8 +205,33 @@ object FormDebug: TFormDebug
|
||||
TabOrder = 10
|
||||
OnClick = CheckBoxTraceLIsteClick
|
||||
end
|
||||
object SaveDialog: TSaveDialog
|
||||
Left = 464
|
||||
object CheckTrame: TCheckBox
|
||||
Left = 448
|
||||
Top = 96
|
||||
Width = 281
|
||||
Height = 17
|
||||
Caption = 'Affichage des trames '#233'chang'#233'es avec LENZ'
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clBlack
|
||||
Font.Height = -11
|
||||
Font.Name = 'MS Sans Serif'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
TabOrder = 11
|
||||
OnClick = CheckTrameClick
|
||||
end
|
||||
object ButtonCop: TButton
|
||||
Left = 448
|
||||
Top = 384
|
||||
Width = 97
|
||||
Height = 49
|
||||
Caption = 'Copie fen'#234'te principale dans debug'
|
||||
TabOrder = 12
|
||||
WordWrap = True
|
||||
OnClick = ButtonCopClick
|
||||
end
|
||||
object SaveDialog: TSaveDialog
|
||||
Left = 680
|
||||
Top = 8
|
||||
end
|
||||
end
|
||||
|
||||
@@ -23,6 +23,8 @@ type
|
||||
ButtonAffEvtChrono: TButton;
|
||||
CheckAffAffecTrains: TCheckBox;
|
||||
CheckBoxTraceLIste: TCheckBox;
|
||||
CheckTrame: TCheckBox;
|
||||
ButtonCop: TButton;
|
||||
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure ButtonEcrLogClick(Sender: TObject);
|
||||
@@ -33,6 +35,8 @@ type
|
||||
procedure ButtonAffEvtChronoClick(Sender: TObject);
|
||||
procedure CheckAffAffecTrainsClick(Sender: TObject);
|
||||
procedure CheckBoxTraceLIsteClick(Sender: TObject);
|
||||
procedure CheckTrameClick(Sender: TObject);
|
||||
procedure ButtonCopClick(Sender: TObject);
|
||||
private
|
||||
{ Déclarations privées }
|
||||
public
|
||||
@@ -172,7 +176,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TFormDebug.ButtonAffEvtChronoClick(Sender: TObject);
|
||||
var i,j,etat : integer;
|
||||
s : string;
|
||||
@@ -201,4 +204,15 @@ begin
|
||||
TraceListe:=CheckBoxTraceLIste.checked;
|
||||
end;
|
||||
|
||||
procedure TFormDebug.CheckTrameClick(Sender: TObject);
|
||||
begin
|
||||
trace:=CheckTrame.Checked;
|
||||
end;
|
||||
|
||||
procedure TFormDebug.ButtonCopClick(Sender: TObject);
|
||||
var i : integer;
|
||||
begin
|
||||
MemoDebug.Lines:=Formprinc.ListBox1.Items
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
BIN
UnitPilote.dcu
BIN
UnitPilote.dcu
Binary file not shown.
@@ -4,7 +4,7 @@ object FormPilote: TFormPilote
|
||||
BorderStyle = bsDialog
|
||||
Caption = 'Pilotage'
|
||||
ClientHeight = 350
|
||||
ClientWidth = 542
|
||||
ClientWidth = 346
|
||||
Color = clBtnFace
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
@@ -202,48 +202,4 @@ object FormPilote: TFormPilote
|
||||
Text = 'EditNbFeux'
|
||||
OnKeyPress = EditNbreFeuxKeyPress
|
||||
end
|
||||
object GroupBox3: TGroupBox
|
||||
Left = 328
|
||||
Top = 48
|
||||
Width = 209
|
||||
Height = 97
|
||||
Caption = 'pilotage unisemaf'
|
||||
TabOrder = 4
|
||||
object RadioButton1: TRadioButton
|
||||
Left = 8
|
||||
Top = 24
|
||||
Width = 145
|
||||
Height = 17
|
||||
Caption = 'Algo1 pilotage inverse'
|
||||
TabOrder = 0
|
||||
OnClick = RadioButton1Click
|
||||
end
|
||||
object RadioButton2: TRadioButton
|
||||
Left = 8
|
||||
Top = 40
|
||||
Width = 145
|
||||
Height = 17
|
||||
Caption = 'Algo2 pilotage normal'
|
||||
TabOrder = 1
|
||||
OnClick = RadioButton2Click
|
||||
end
|
||||
object RadioButton3: TRadioButton
|
||||
Left = 8
|
||||
Top = 56
|
||||
Width = 193
|
||||
Height = 17
|
||||
Caption = 'Algo3 pilotage bits '#224' 1 seuls normal'
|
||||
TabOrder = 2
|
||||
OnClick = RadioButton3Click
|
||||
end
|
||||
object RadioButton4: TRadioButton
|
||||
Left = 8
|
||||
Top = 72
|
||||
Width = 193
|
||||
Height = 17
|
||||
Caption = 'Algo4 pilotage bits '#224' 1 seuls inverse'
|
||||
TabOrder = 3
|
||||
OnClick = RadioButton4Click
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
@@ -31,11 +31,6 @@ type
|
||||
ButtonPilote: TButton;
|
||||
EditNbreFeux: TEdit;
|
||||
LabelNbFeux: TLabel;
|
||||
GroupBox3: TGroupBox;
|
||||
RadioButton1: TRadioButton;
|
||||
RadioButton2: TRadioButton;
|
||||
RadioButton3: TRadioButton;
|
||||
RadioButton4: TRadioButton;
|
||||
procedure RadioVertClick(Sender: TObject);
|
||||
procedure RadioVertCliClick(Sender: TObject);
|
||||
procedure RadioJauneClick(Sender: TObject);
|
||||
@@ -54,10 +49,6 @@ type
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure ButtonPiloteClick(Sender: TObject);
|
||||
procedure EditNbreFeuxKeyPress(Sender: TObject; var Key: Char);
|
||||
procedure RadioButton1Click(Sender: TObject);
|
||||
procedure RadioButton2Click(Sender: TObject);
|
||||
procedure RadioButton3Click(Sender: TObject);
|
||||
procedure RadioButton4Click(Sender: TObject);
|
||||
private
|
||||
{ Déclarations privées }
|
||||
public
|
||||
@@ -263,36 +254,5 @@ if ord(Key) = VK_RETURN then
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFormPilote.RadioButton1Click(Sender: TObject);
|
||||
begin
|
||||
uni1:=RadioButton1.checked;
|
||||
uni2:=RadioButton2.checked;
|
||||
uni3:=RadioButton3.checked;
|
||||
uni4:=RadioButton4.checked;
|
||||
end;
|
||||
|
||||
procedure TFormPilote.RadioButton2Click(Sender: TObject);
|
||||
begin
|
||||
uni1:=RadioButton1.checked;
|
||||
uni2:=RadioButton2.checked;
|
||||
uni3:=RadioButton3.checked;
|
||||
uni4:=RadioButton4.checked;
|
||||
end;
|
||||
|
||||
procedure TFormPilote.RadioButton3Click(Sender: TObject);
|
||||
begin
|
||||
uni1:=RadioButton1.checked;
|
||||
uni2:=RadioButton2.checked;
|
||||
uni3:=RadioButton3.checked;
|
||||
uni4:=RadioButton4.checked;
|
||||
end;
|
||||
|
||||
procedure TFormPilote.RadioButton4Click(Sender: TObject);
|
||||
begin
|
||||
uni1:=RadioButton1.checked;
|
||||
uni2:=RadioButton2.checked;
|
||||
uni3:=RadioButton3.checked;
|
||||
uni4:=RadioButton4.checked;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
BIN
UnitPrinc.dcu
BIN
UnitPrinc.dcu
Binary file not shown.
124
UnitPrinc.dfm
124
UnitPrinc.dfm
@@ -1,9 +1,9 @@
|
||||
object FormPrinc: TFormPrinc
|
||||
Left = 33
|
||||
Top = 205
|
||||
Left = 34
|
||||
Top = 494
|
||||
BorderStyle = bsSingle
|
||||
Caption = 'Client TCP-IP CDM Rail ou USB - syst'#232'me LENZ'
|
||||
ClientHeight = 607
|
||||
ClientHeight = 601
|
||||
ClientWidth = 1196
|
||||
Color = clBtnFace
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
@@ -33,9 +33,9 @@ object FormPrinc: TFormPrinc
|
||||
ParentFont = False
|
||||
end
|
||||
object LabelEtat: TLabel
|
||||
Left = 440
|
||||
Left = 344
|
||||
Top = 8
|
||||
Width = 80
|
||||
Width = 305
|
||||
Height = 22
|
||||
Caption = 'LabelEtat'
|
||||
Font.Charset = ANSI_CHARSET
|
||||
@@ -596,10 +596,10 @@ object FormPrinc: TFormPrinc
|
||||
Visible = False
|
||||
end
|
||||
object Image3feux: TImage
|
||||
Left = 600
|
||||
Left = 616
|
||||
Top = 0
|
||||
Width = 49
|
||||
Height = 105
|
||||
Width = 33
|
||||
Height = 57
|
||||
Picture.Data = {
|
||||
07544269746D617006090000424D060900000000000036040000280000001A00
|
||||
00002C0000000100080000000000D0040000C40E0000C40E0000000100000000
|
||||
@@ -678,7 +678,7 @@ object FormPrinc: TFormPrinc
|
||||
end
|
||||
object Image2feux: TImage
|
||||
Left = 1096
|
||||
Top = 104
|
||||
Top = 128
|
||||
Width = 33
|
||||
Height = 57
|
||||
Picture.Data = {
|
||||
@@ -1090,8 +1090,8 @@ object FormPrinc: TFormPrinc
|
||||
Visible = False
|
||||
end
|
||||
object Image6Dir: TImage
|
||||
Left = 1120
|
||||
Top = 96
|
||||
Left = 1112
|
||||
Top = 128
|
||||
Width = 81
|
||||
Height = 25
|
||||
Picture.Data = {
|
||||
@@ -1198,8 +1198,8 @@ object FormPrinc: TFormPrinc
|
||||
Visible = False
|
||||
end
|
||||
object BoutVersion: TButton
|
||||
Left = 656
|
||||
Top = 0
|
||||
Left = 1008
|
||||
Top = 8
|
||||
Width = 83
|
||||
Height = 33
|
||||
Caption = 'Dem version'
|
||||
@@ -1225,7 +1225,7 @@ object FormPrinc: TFormPrinc
|
||||
end
|
||||
object BoutonRaf: TButton
|
||||
Left = 912
|
||||
Top = 64
|
||||
Top = 8
|
||||
Width = 89
|
||||
Height = 33
|
||||
Caption = 'Rafraichissement'
|
||||
@@ -1234,18 +1234,18 @@ object FormPrinc: TFormPrinc
|
||||
end
|
||||
object ScrollBox1: TScrollBox
|
||||
Left = 648
|
||||
Top = 164
|
||||
Top = 160
|
||||
Width = 537
|
||||
Height = 401
|
||||
Height = 405
|
||||
Color = clWhite
|
||||
ParentColor = False
|
||||
TabOrder = 3
|
||||
end
|
||||
object GroupBox1: TGroupBox
|
||||
Left = 656
|
||||
Top = 40
|
||||
Top = 0
|
||||
Width = 249
|
||||
Height = 65
|
||||
Height = 97
|
||||
Caption = 'Commande d'#39'accessoires'
|
||||
TabOrder = 4
|
||||
object Label2: TLabel
|
||||
@@ -1282,6 +1282,7 @@ object FormPrinc: TFormPrinc
|
||||
Top = 32
|
||||
Width = 41
|
||||
Height = 21
|
||||
Hint = 'Entrez 1 ou 2 pour un accessoire DCC et 1 '#224' 255 pour un CV'
|
||||
TabOrder = 1
|
||||
Text = '1'
|
||||
OnEnter = EditvalEnter
|
||||
@@ -1291,25 +1292,37 @@ object FormPrinc: TFormPrinc
|
||||
Top = 24
|
||||
Width = 109
|
||||
Height = 33
|
||||
Hint = 'Ecriture des accessoires DCC'
|
||||
Caption = 'Envoi commande'
|
||||
TabOrder = 2
|
||||
WordWrap = True
|
||||
OnClick = ButtonCommandeClick
|
||||
end
|
||||
object ButtonEcrCV: TButton
|
||||
Left = 8
|
||||
Top = 64
|
||||
Width = 225
|
||||
Height = 25
|
||||
Hint = 'Ecriture CV en mode direct sur voie de programmation'
|
||||
Caption = 'Ecriture CV - 1 '#224' 255 par bus XpressNet'
|
||||
TabOrder = 3
|
||||
WordWrap = True
|
||||
OnClick = ButtonEcrCVClick
|
||||
end
|
||||
end
|
||||
object ButtonTest: TButton
|
||||
Left = 832
|
||||
Top = 0
|
||||
Width = 105
|
||||
Left = 912
|
||||
Top = 88
|
||||
Width = 89
|
||||
Height = 33
|
||||
Caption = 'Demande '#233'tat de la r'#233'trosignalisation'
|
||||
Caption = 'Demande '#233'tat r'#233'trosignalisation'
|
||||
TabOrder = 5
|
||||
WordWrap = True
|
||||
OnClick = ButtonTestClick
|
||||
end
|
||||
object ButtonInfo: TButton
|
||||
Left = 1008
|
||||
Top = 64
|
||||
Top = 48
|
||||
Width = 81
|
||||
Height = 33
|
||||
Caption = 'Informations'
|
||||
@@ -1318,11 +1331,12 @@ object FormPrinc: TFormPrinc
|
||||
end
|
||||
object GroupBox2: TGroupBox
|
||||
Left = 654
|
||||
Top = 111
|
||||
Width = 419
|
||||
Top = 103
|
||||
Width = 211
|
||||
Height = 46
|
||||
Caption = 'Trains'
|
||||
TabOrder = 6
|
||||
Visible = False
|
||||
object Label1: TLabel
|
||||
Left = 16
|
||||
Top = 20
|
||||
@@ -1342,15 +1356,15 @@ object FormPrinc: TFormPrinc
|
||||
end
|
||||
object StatusBar1: TStatusBar
|
||||
Left = 0
|
||||
Top = 577
|
||||
Top = 571
|
||||
Width = 1196
|
||||
Height = 30
|
||||
Panels = <>
|
||||
SimplePanel = True
|
||||
end
|
||||
object MSCommUSBLenz: TMSComm
|
||||
Left = 1120
|
||||
Top = 8
|
||||
Left = 880
|
||||
Top = 128
|
||||
Width = 32
|
||||
Height = 32
|
||||
OnComm = MSCommUSBLenzComm
|
||||
@@ -1359,8 +1373,8 @@ object FormPrinc: TFormPrinc
|
||||
00020000802500000000080000000000000000003F00000001000000}
|
||||
end
|
||||
object loco: TButton
|
||||
Left = 944
|
||||
Top = 0
|
||||
Left = 1096
|
||||
Top = 8
|
||||
Width = 75
|
||||
Height = 33
|
||||
Caption = 'loco'
|
||||
@@ -1368,19 +1382,31 @@ object FormPrinc: TFormPrinc
|
||||
OnClick = locoClick
|
||||
end
|
||||
object ButtonAffDebug: TButton
|
||||
Left = 744
|
||||
Top = 0
|
||||
Width = 81
|
||||
Left = 912
|
||||
Top = 48
|
||||
Width = 89
|
||||
Height = 33
|
||||
Caption = 'Affiche debug'
|
||||
TabOrder = 11
|
||||
OnClick = ButtonAffDebugClick
|
||||
end
|
||||
object ButtonReprise: TButton
|
||||
Left = 1096
|
||||
Top = 48
|
||||
Width = 75
|
||||
Height = 33
|
||||
Hint =
|
||||
'Relance du bus DCC apr'#232's une '#233'criture d'#39'un CV ou une mise hors t' +
|
||||
'ension de la centrale'
|
||||
Caption = 'Reprise DCC'
|
||||
TabOrder = 12
|
||||
OnClick = ButtonRepriseClick
|
||||
end
|
||||
object Timer1: TTimer
|
||||
Interval = 100
|
||||
OnTimer = Timer1Timer
|
||||
Left = 1072
|
||||
Top = 8
|
||||
Left = 888
|
||||
Top = 80
|
||||
end
|
||||
object ClientSocketLenz: TClientSocket
|
||||
Active = False
|
||||
@@ -1464,6 +1490,9 @@ object FormPrinc: TFormPrinc
|
||||
Caption = 'Divers'
|
||||
object FichierSimu: TMenuItem
|
||||
Caption = 'Ouvrir un fichier de simulation'
|
||||
Hint =
|
||||
'Ouvre un fichier de simulation des d'#233'tecteurs pour simuler un fo' +
|
||||
'nctionnement'
|
||||
OnClick = FichierSimuClick
|
||||
end
|
||||
object Versions1: TMenuItem
|
||||
@@ -1471,6 +1500,23 @@ object FormPrinc: TFormPrinc
|
||||
Hint = 'Versions'
|
||||
OnClick = Versions1Click
|
||||
end
|
||||
object N1: TMenuItem
|
||||
Caption = '-'
|
||||
end
|
||||
object LireunfichierdeCV1: TMenuItem
|
||||
Caption = 'Lire un fichier de CV vers un accessoire'
|
||||
Hint =
|
||||
'Ouvre un fichier de CV pour l'#39'envoyer vers un accessoire branch'#233 +
|
||||
' sur la voie de programmation'
|
||||
OnClick = LireunfichierdeCV1Click
|
||||
end
|
||||
object LireunaccessoireversunfichierdeCV1: TMenuItem
|
||||
Caption = 'Lire un accessoire vers un fichier de CV'
|
||||
Hint =
|
||||
'Lire les CV d'#39'un accessoire branch'#233' sur la voie de programmation' +
|
||||
' vers un fichier'
|
||||
OnClick = LireunaccessoireversunfichierdeCV1Click
|
||||
end
|
||||
end
|
||||
end
|
||||
object ClientSocketCDM: TClientSocket
|
||||
@@ -1483,4 +1529,12 @@ object FormPrinc: TFormPrinc
|
||||
OnError = ClientSocketCDMError
|
||||
Left = 352
|
||||
end
|
||||
object OpenDialog: TOpenDialog
|
||||
Left = 1080
|
||||
Top = 88
|
||||
end
|
||||
object SaveDialog: TSaveDialog
|
||||
Left = 1120
|
||||
Top = 88
|
||||
end
|
||||
end
|
||||
|
||||
793
UnitPrinc.pas
793
UnitPrinc.pas
File diff suppressed because it is too large
Load Diff
BIN
UnitSimule.dcu
BIN
UnitSimule.dcu
Binary file not shown.
BIN
UnitTCO.dcu
Normal file
BIN
UnitTCO.dcu
Normal file
Binary file not shown.
94
UnitTCO.dfm
Normal file
94
UnitTCO.dfm
Normal file
@@ -0,0 +1,94 @@
|
||||
object FormTCO: TFormTCO
|
||||
Left = 1549
|
||||
Top = 156
|
||||
Width = 928
|
||||
Height = 590
|
||||
Caption = 'FormTCO'
|
||||
Color = clBtnFace
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'MS Sans Serif'
|
||||
Font.Style = []
|
||||
OldCreateOrder = False
|
||||
OnActivate = FormActivate
|
||||
OnCreate = FormCreate
|
||||
PixelsPerInch = 96
|
||||
TextHeight = 13
|
||||
object LabelX: TLabel
|
||||
Left = 32
|
||||
Top = 16
|
||||
Width = 53
|
||||
Height = 19
|
||||
Caption = 'LabelX'
|
||||
Font.Charset = ANSI_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -16
|
||||
Font.Name = 'Arial'
|
||||
Font.Style = [fsBold]
|
||||
ParentFont = False
|
||||
end
|
||||
object Label2: TLabel
|
||||
Left = 16
|
||||
Top = 16
|
||||
Width = 13
|
||||
Height = 13
|
||||
Caption = 'X='
|
||||
end
|
||||
object Label3: TLabel
|
||||
Left = 104
|
||||
Top = 16
|
||||
Width = 13
|
||||
Height = 13
|
||||
Caption = 'X='
|
||||
end
|
||||
object LabelY: TLabel
|
||||
Left = 120
|
||||
Top = 16
|
||||
Width = 51
|
||||
Height = 19
|
||||
Caption = 'Label1'
|
||||
Font.Charset = ANSI_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -16
|
||||
Font.Name = 'Arial'
|
||||
Font.Style = [fsBold]
|
||||
ParentFont = False
|
||||
end
|
||||
object DrawGrid: TDrawGrid
|
||||
Left = 48
|
||||
Top = 408
|
||||
Width = 521
|
||||
Height = 137
|
||||
Color = clBlack
|
||||
DefaultColWidth = 30
|
||||
DefaultRowHeight = 30
|
||||
FixedCols = 0
|
||||
FixedRows = 0
|
||||
TabOrder = 0
|
||||
OnDrawCell = DrawGridDrawCell
|
||||
end
|
||||
object Button1: TButton
|
||||
Left = 320
|
||||
Top = 16
|
||||
Width = 75
|
||||
Height = 25
|
||||
Caption = 'Button1'
|
||||
TabOrder = 1
|
||||
OnClick = Button1Click
|
||||
end
|
||||
object ScrollBox: TScrollBox
|
||||
Left = 16
|
||||
Top = 40
|
||||
Width = 865
|
||||
Height = 353
|
||||
TabOrder = 2
|
||||
object ImageTCO: TImage
|
||||
Left = 0
|
||||
Top = 0
|
||||
Width = 857
|
||||
Height = 345
|
||||
OnClick = ImageTCOClick
|
||||
end
|
||||
end
|
||||
end
|
||||
323
UnitTCO.pas
Normal file
323
UnitTCO.pas
Normal file
@@ -0,0 +1,323 @@
|
||||
unit UnitTCO;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
||||
Dialogs, Grids , UnitPrinc, StdCtrls, ExtCtrls;
|
||||
|
||||
type
|
||||
TFormTCO = class(TForm)
|
||||
DrawGrid: TDrawGrid;
|
||||
Button1: TButton;
|
||||
LabelX: TLabel;
|
||||
Label2: TLabel;
|
||||
Label3: TLabel;
|
||||
LabelY: TLabel;
|
||||
ScrollBox: TScrollBox;
|
||||
ImageTCO: TImage;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure DrawGridDrawCell(Sender: TObject; ACol, ARow: Integer;
|
||||
Rect: TRect; State: TGridDrawState);
|
||||
procedure Button1Click(Sender: TObject);
|
||||
procedure ImageTCOClick(Sender: TObject);
|
||||
procedure FormActivate(Sender: TObject);
|
||||
private
|
||||
{ Déclarations privées }
|
||||
public
|
||||
{ Déclarations publiques }
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
FormTCO: TFormTCO;
|
||||
NbreCellX,NbreCellY,HtImageTCO,LargImageTCO,XclicCell,YclicCell : integer;
|
||||
LargeurCell,HauteurCell,Xclic,Yclic : integer;
|
||||
tco : array[1..20,1..20] of Tbranche;
|
||||
|
||||
procedure construit_TCO;
|
||||
procedure affiche_TCO;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
|
||||
|
||||
procedure grille;
|
||||
var x,y : integer;
|
||||
r : Trect;
|
||||
begin
|
||||
HtImageTCO:=FormTCO.ImageTCO.Height;
|
||||
HtImageTCO:=FormTCO.ImageTCO.Height;
|
||||
LargImageTCO:=FormTCO.ImageTCO.Width;
|
||||
|
||||
With FormTCO.ImageTCO.canvas do
|
||||
begin
|
||||
Brush.Style:=bsSolid;
|
||||
Brush.Color:=clBlack;
|
||||
pen.color:=clyellow;
|
||||
r:=rect(1,1,LargImageTCO,HtImageTco);
|
||||
FillRect(r);
|
||||
|
||||
|
||||
pen.color:=$707070;
|
||||
for x:=1 to NbreCellx do
|
||||
begin
|
||||
moveto(x*LargeurCell,1);
|
||||
LineTo(x*LargeurCell,HtImageTCO);
|
||||
end;
|
||||
for y:=1 to NbreCelly do
|
||||
begin
|
||||
moveto(1,y*HauteurCell);
|
||||
LineTo(LargimageTCO,y*HauteurCell);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure dessin_voie(x,y : integer);
|
||||
var x1,y1 : integer;
|
||||
r : Trect;
|
||||
begin
|
||||
with FormTCO.ImageTCO.Canvas do
|
||||
begin
|
||||
x1:=x*LargeurCell;
|
||||
y1:=y*HauteurCell;
|
||||
end;
|
||||
with formTCO.ImageTCO.canvas do
|
||||
begin
|
||||
r:=Rect(x1,y1+(HauteurCell div 2)-5,x1+LargeurCell,y1 + (HauteurCell div 2)+5);
|
||||
Brush.COlor:=ClRed;
|
||||
FillRect(r);
|
||||
end;
|
||||
end;
|
||||
|
||||
// aiguillage pointe à gauche, monte gauche
|
||||
procedure dessin_AigPGMG(x,y : integer;couleur : Tcolor);
|
||||
var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer;
|
||||
r : Trect;
|
||||
begin
|
||||
x0:=x*LargeurCell;
|
||||
y0:=y*HauteurCell;
|
||||
|
||||
with formTCO.ImageTCO.canvas do
|
||||
begin
|
||||
Brush.COlor:=couleur;
|
||||
pen.color:=couleur;
|
||||
|
||||
jy1:=y0+(HauteurCell div 2)-3; // pos Y de la bande sup
|
||||
jy2:=y0+(HauteurCell div 2)+3; // pos Y de la bande inf
|
||||
|
||||
|
||||
r:=Rect(x0,jy1,x0+LargeurCell,jy2);
|
||||
FillRect(r);
|
||||
|
||||
//brush.color:=clblue;
|
||||
x1:=x0+(largeurCell div 2);
|
||||
y1:=jy1;
|
||||
x2:=x0+largeurCell-3;
|
||||
y2:=y0;
|
||||
x3:=x0+largeurCell;
|
||||
y3:=y0+3;
|
||||
x4:=x0+(largeurCell div 2)+7;
|
||||
y4:=jy1;
|
||||
Polygon([point(x1,y1),Point(x2,y2),Point(x3+2,y3-2),Point(x4+2,y4-2)]);
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
// courbe bas gauche vers droit
|
||||
procedure dessin_cbgd(x,y : integer;couleur : Tcolor);
|
||||
var jy1,jy2,x0,y0,i,x1,y1,x2,y2,x3,y3,x4,y4 : integer;
|
||||
r : Trect;
|
||||
begin
|
||||
x0:=x*LargeurCell;
|
||||
y0:=y*HauteurCell;
|
||||
|
||||
with formTCO.ImageTCO.canvas do
|
||||
begin
|
||||
Brush.COlor:=Couleur;
|
||||
pen.color:=Couleur;
|
||||
|
||||
jy1:=y0+(HauteurCell div 2)-3; // pos Y de la bande sup
|
||||
jy2:=y0+(HauteurCell div 2)+3; // pos Y de la bande inf
|
||||
r:=Rect(x0+(largeurCell div 2),jy1,x0+LargeurCell,jy2);
|
||||
FillRect(r);
|
||||
|
||||
// brush.color:=clblue;
|
||||
x1:=x0;
|
||||
y1:=y0+HauteurCell-3;
|
||||
x2:=x0+(LargeurCell div 2) -0;
|
||||
y2:=jy1;
|
||||
x3:=x0+(LargeurCell div 2) +2;
|
||||
y3:=jy2;
|
||||
x4:=x0+3;
|
||||
y4:=y0+HauteurCell;
|
||||
Polygon([point(x1-2,y1+2),Point(x2,y2),Point(x3,y3),Point(x4-2,y4+2)]);
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure construit_TCO;
|
||||
var x,y,i,j,Max,indexMax : integer;
|
||||
begin
|
||||
// étape 0 Raz du TCO
|
||||
for y:=1 to 20 do
|
||||
for x:=1 to 20 do
|
||||
begin
|
||||
TCO[x,y].Adresse:=0;
|
||||
TCO[x,y].Btype:=0;
|
||||
end;
|
||||
|
||||
//étape 1 trouver la branche la plus longue
|
||||
Max:=0;
|
||||
for i:=1 to NbreBranches do
|
||||
begin
|
||||
j:=0;
|
||||
repeat
|
||||
inc(j);
|
||||
until BrancheN[i,j].Adresse=0;
|
||||
if j>Max then begin Max:=j-1;IndexMax:=i;end;
|
||||
end;
|
||||
Affiche('La branche la plus grande a pour index '+IntToSTR(IndexMax),clOrange);
|
||||
|
||||
// stocker cette branche au milieu du TCO (en 5)
|
||||
for i:=1 to Max do
|
||||
begin
|
||||
TCO[i,5].Adresse:=BrancheN[IndexMax,i].Adresse;
|
||||
TCO[i,5].Btype:=BrancheN[IndexMax,i].Btype;
|
||||
end;
|
||||
|
||||
|
||||
end;
|
||||
|
||||
procedure Affiche_TCO ;
|
||||
var i,j,x,y,xOrg,Yorg,btype : integer;
|
||||
s : string;
|
||||
begin
|
||||
with formTCO.ImageTCO.Canvas do
|
||||
begin
|
||||
Brush.color:=ClBlack;
|
||||
font.color:=clWhite;
|
||||
end;
|
||||
for y:=1 to 10 do
|
||||
for x:=1 to 20 do
|
||||
begin
|
||||
i:=tco[x,y].Adresse;
|
||||
btype:=tco[x,y].Btype;
|
||||
with formTCO.ImageTCO.Canvas do
|
||||
begin
|
||||
Xorg:=(x-1)*LargeurCell;
|
||||
Yorg:=(y-1)*HauteurCell;
|
||||
|
||||
s:=IntToSTR(i);
|
||||
if Btype=2 then s:='A'+s;
|
||||
if Btype=3 then s:='A'+s+'B';
|
||||
|
||||
Textout(Xorg+2,Yorg+2,s);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TFormTCO.FormCreate(Sender: TObject);
|
||||
begin
|
||||
|
||||
caption:='TCO';
|
||||
NbreCellX:=20;
|
||||
NbreCellY:=10;
|
||||
LargeurCell:=35;
|
||||
HauteurCell:=35;
|
||||
//grille;
|
||||
// HtImageTCO:=ImageTCO.Height;
|
||||
|
||||
end;
|
||||
|
||||
// x y = numéro cellule
|
||||
Procedure dessine(x,y : integer);
|
||||
Var Xorg,Yorg : integer;
|
||||
begin
|
||||
Xorg:=x*LargeurCell;
|
||||
Yorg:=y*HauteurCell;
|
||||
with FormTCO.DrawGrid.Canvas do
|
||||
begin
|
||||
Pen.width:=3;
|
||||
Pen.Color:=clyellow;
|
||||
Brush.Style:=bsSolid;
|
||||
MoveTo(xorg,yorg);LineTo(xorg+120,yorg+150) ;
|
||||
Pen.Color:=clred;
|
||||
MoveTo(1,1);LineTo(120,160) ;
|
||||
|
||||
end;
|
||||
formTCO.refresh;
|
||||
|
||||
end;
|
||||
|
||||
|
||||
|
||||
procedure TFormTCO.DrawGridDrawCell(Sender: TObject; ACol, ARow: Integer;
|
||||
Rect: TRect; State: TGridDrawState);
|
||||
var s : string;
|
||||
aCanvas : Tcanvas;
|
||||
begin
|
||||
exit;
|
||||
dessine(2,2);
|
||||
|
||||
if (Acol=3) and (ARow=3) then with Sender as TDrawGrid do Canvas.Draw(Rect.left,Rect.Top,Formprinc.Image6Dir.picture.bitmap);
|
||||
|
||||
if (Acol=2) and (Arow=1) then
|
||||
begin
|
||||
with Sender as TDrawGrid do
|
||||
begin
|
||||
//Canvas.Pen:=psSolid;
|
||||
With canvas do
|
||||
begin
|
||||
Pen.width:=3;
|
||||
Pen.Color:=clyellow;
|
||||
MoveTo(1,1);LineTo(150,150) ;
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
|
||||
|
||||
procedure TFormTCO.Button1Click(Sender: TObject);
|
||||
begin
|
||||
grille;
|
||||
dessin_voie(3,3);
|
||||
dessin_voie(10,4);
|
||||
dessin_AigPGMG(7,6,clyellow);
|
||||
end;
|
||||
|
||||
|
||||
procedure TFormTCO.ImageTCOClick(Sender: TObject);
|
||||
var Position: TPoint;
|
||||
begin
|
||||
GetCursorPos(Position);
|
||||
Position:=ImageTCO.screenToCLient(Position);
|
||||
Xclic:=position.X;YClic:=position.Y;
|
||||
XclicCell:=Xclic div largeurCell +1;
|
||||
YclicCell:=Yclic div hauteurCell +1;
|
||||
LabelX.caption:=IntToSTR(XclicCell);
|
||||
LabelY.caption:=IntToSTR(YclicCell);
|
||||
|
||||
|
||||
end;
|
||||
|
||||
procedure TFormTCO.FormActivate(Sender: TObject);
|
||||
begin
|
||||
|
||||
grille;
|
||||
dessin_voie(3,3);
|
||||
dessin_voie(10,4);
|
||||
dessin_AigPGMG(7,6,clyellow);
|
||||
dessin_cbgd(8,5,clyellow);
|
||||
|
||||
formprinc.Hide;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -29,12 +29,14 @@
|
||||
192.168.1.23:5550
|
||||
/
|
||||
/ port COM de l'adresse USB de l'interface LI100
|
||||
/ attention de 1 à 9 - Si le port de l'interface USB LI100 >9, il faut le changer
|
||||
/ attention de COM1 à 9 - Si le port de l'interface USB LI100 >9, il faut le changer
|
||||
/ manuellement dans le gestionnaire des périphériques
|
||||
/ mettre 0 si inutilisée ou si CDM est utilisé en parallèle de ce programme (car CDM utilise la liaison USB)
|
||||
/ Le programme ne tentera pas de se connecter à la centrale si CDM rail est détécté
|
||||
/ COMx:57600,N,8,1,2 = interfaces LENZ LI-USB et compatibles (le dernier paramètre est le protocole matériel: 0=aucun 1=Xon-Xoff 2=cts 3=RTS-Xon-Xoff)
|
||||
/ COMx:9600,N,8,1,0 = interfaces GENLI USB-RS232 et compatibles (0=pas de protocole)
|
||||
/
|
||||
3
|
||||
COM3:57600,N,8,1,2
|
||||
/
|
||||
/ Avec (1) ou sans (0) initialisation des aiguillages au démarrage selon le tableau ci après
|
||||
0
|
||||
|
||||
@@ -107,7 +107,6 @@ A31,0
|
||||
476,9,0,1,(538,A23),1
|
||||
497,9,0,4,(531,A19),1
|
||||
600,7,0,0,(521,A8),1
|
||||
197,5,0,6,(520,A20),0,51
|
||||
0
|
||||
/
|
||||
|
||||
|
||||
30
liste_cv.txt
Normal file
30
liste_cv.txt
Normal file
@@ -0,0 +1,30 @@
|
||||
Fichier décodeur unisemaf
|
||||
cible de forme 51
|
||||
CV valeur
|
||||
----aspect1
|
||||
35 63 affecte les sorties aspect
|
||||
36 36
|
||||
37 0
|
||||
38 0
|
||||
-----aspect2
|
||||
39 63
|
||||
40 33
|
||||
41 0
|
||||
42 0
|
||||
-----aspect3
|
||||
43 63
|
||||
44 34
|
||||
45 0
|
||||
46 0
|
||||
-----aspect4
|
||||
47 63
|
||||
48 10
|
||||
49 0
|
||||
50 0
|
||||
-----aspect5
|
||||
51 63
|
||||
52 16
|
||||
53 0
|
||||
54 0
|
||||
|
||||
|
||||
BIN
listeusb.dcu
Normal file
BIN
listeusb.dcu
Normal file
Binary file not shown.
167
listeusb.pas
Normal file
167
listeusb.pas
Normal file
@@ -0,0 +1,167 @@
|
||||
unit listeusb;
|
||||
|
||||
//=================================================//
|
||||
// Nicolas Paglieri (ni69) //
|
||||
// www.ni69.info //
|
||||
// & www.delphifr.com //
|
||||
//=================================================//
|
||||
// Merci à DelphiProg pour son aide précieuse ! ;) //
|
||||
//=================================================//
|
||||
|
||||
|
||||
interface
|
||||
|
||||
uses Registry,ShellAPI, ComCtrls,
|
||||
Windows, Messages, SysUtils, Variants, Classes;// Graphics, Controls,
|
||||
|
||||
|
||||
var
|
||||
line : array of string;
|
||||
NumLine : integer;
|
||||
|
||||
procedure EnumerateDevices;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
//============================================================================//
|
||||
// Fonction de traduction en français des noms anglais des catégories de périphériques
|
||||
// On ajoute ici l'index de l'icône de catégorie après un # pour gérer l'affichage
|
||||
//============================================================================//
|
||||
function Translate(English: string): string;
|
||||
begin
|
||||
if English = 'CDROM' then result := 'Lecteurs de CD-ROM/DVD-ROM#09'
|
||||
else if English = 'Computer' then result := 'Ordinateur#14'
|
||||
else if English = 'DiskDrive' then result := 'Lecteurs de disque#10'
|
||||
else if English = 'Display' then result := 'Cartes Graphiques#01'
|
||||
else if English = 'fdc' then result := 'Contrôleur de lecteur de disquettes#04'
|
||||
else if English = 'FloppyDisk' then result := 'Lecteurs de disquettes#11'
|
||||
else if English = 'hdc' then result := 'Contrôleurs ATA/ATAPI IDE#05'
|
||||
else if English = 'Image' then result := 'Périphériques d''image#15'
|
||||
else if English = 'Keyboard' then result := 'Claviers#03'
|
||||
else if English = 'LegacyDriver' then result := 'Pilotes non Plug-and-Play#17'
|
||||
else if English = 'MEDIA' then result := 'Contrôleurs audio, vidéo et jeu#06'
|
||||
else if English = 'Modem' then result := 'Modems#12'
|
||||
else if English = 'Monitor' then result := 'Moniteurs#13'
|
||||
else if English = 'Mouse' then result := 'Souris et autres périphériques de pointage#20'
|
||||
else if English = 'Net' then result := 'Cartes réseau#02'
|
||||
else if English = 'NtApm' then result := 'Prise en charge NT APM/hérité#19'
|
||||
else if English = 'Ports' then result := 'Ports (COM et LPT)#18'
|
||||
else if English = 'Printer' then result := 'Imprimantes#08'
|
||||
else if English = 'System' then result := 'Périphériques Système#14'
|
||||
else if English = 'USB' then result := 'Contrôleurs de bus USB#07'
|
||||
else if English = 'Volume' then result := 'Volumes de stockage#21'
|
||||
else result := English+'#22'; // Périphérique inconnu
|
||||
end;
|
||||
//============================================================================//
|
||||
|
||||
|
||||
|
||||
|
||||
//============================================================================//
|
||||
// PROCEDURE D'ENUMERATION DES PERIPHERIQUES SUR WINDOWS XP-7 //
|
||||
// ne marche pas avec W10
|
||||
//============================================================================//
|
||||
procedure EnumerateDevices;
|
||||
var
|
||||
CategoriesList, SubCatList, SubSubCatList, FinalList : TStringList;
|
||||
nb, nb2, nb3 ,num: integer;
|
||||
Reg1, Reg2, Reg3 : TRegistry;
|
||||
HasBeenFound : boolean;
|
||||
listeCles : Tstrings;
|
||||
|
||||
begin
|
||||
|
||||
|
||||
CategoriesList := TStringList.Create; // Liste des catégories principales du registre
|
||||
SubCatList := TStringList.Create; // Liste intermédiaire
|
||||
SubSubCatList := TStringList.Create; // Liste intermédiaire
|
||||
FinalList := TStringList.Create; // Liste finale comprenant les périphériques
|
||||
|
||||
// On crée les objets TRegistry qui serviront à parcourir l'arborescence
|
||||
Reg1 := TRegistry.Create;
|
||||
Reg2 := TRegistry.Create;
|
||||
Reg3 := TRegistry.Create;
|
||||
|
||||
try
|
||||
// Définition de la clé racine
|
||||
Reg1.RootKey := HKEY_LOCAL_MACHINE;
|
||||
Reg2.RootKey := HKEY_LOCAL_MACHINE;
|
||||
Reg3.RootKey := HKEY_LOCAL_MACHINE;
|
||||
|
||||
//----------------------------------------------------------------------------------------
|
||||
// 1ère ETAPE : ENUMARTION DES CATEGORIES DU REGISTRE (différentes des catégories finales)
|
||||
with TRegistry.Create do try
|
||||
RootKey := HKEY_LOCAL_MACHINE;
|
||||
|
||||
//! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
|
||||
// IMPORTANT : DROITS D'ACCES
|
||||
// On ouvre les clés en lecture seule avec OpenKeyReadOnly
|
||||
// car on dispose de la valeur de sécurité d'accès KEY_READ.
|
||||
// En effet, seul SYSTEM a le droit d'ouvrir cette clé en écriture en temps normal.
|
||||
//! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
|
||||
|
||||
OpenKeyReadOnly('SYSTEM\CurrentControlSet\Enum');
|
||||
GetKeyNames(CategoriesList); // Récupération des catégories
|
||||
CloseKey;
|
||||
finally
|
||||
free;
|
||||
end;
|
||||
|
||||
num:=1;Setlength(line,num+1);
|
||||
//-----------------------------------------------------------------------------------------------------------------------------------
|
||||
// 2eme ETAPE : PARCOURS DE L'ARBORESCENCE DU REGISTRE (les clés contenant les informations utiles sont contenues dans d'autres clés)
|
||||
for nb := 0 to CategoriesList.Count-1 do begin
|
||||
Reg1.OpenKeyReadOnly('SYSTEM\CurrentControlSet\Enum\'+CategoriesList[nb]);
|
||||
Reg1.GetKeyNames(SubCatList);
|
||||
Reg1.CloseKey;
|
||||
for nb2 := 0 to SubCatList.Count-1 do begin
|
||||
Reg2.OpenKeyReadOnly('SYSTEM\CurrentControlSet\Enum\'+CategoriesList[nb]+'\'+SubCatList[nb2]);
|
||||
Reg2.GetKeyNames(SubSubCatList);
|
||||
Reg2.CloseKey;
|
||||
for nb3 := 0 to SubSubCatList.Count-1 do begin
|
||||
Reg3.OpenKeyReadOnly('SYSTEM\CurrentControlSet\Enum\'+CategoriesList[nb]+'\'+SubCatList[nb2]+'\'+SubSubCatList[nb3]);
|
||||
|
||||
// Si on ne dispose ni du type de périphérique, ni de son nom,
|
||||
// Ou alors si le périphérique n'est plus disponible (si la clé "Control" n'est pas présente), on ne l'ajoute pas
|
||||
if ((Reg3.ReadString('Class')='') and (Reg3.ReadString('DeviceDesc')='')) or (not Reg3.KeyExists('Control')) then begin
|
||||
Reg3.CloseKey;
|
||||
continue;
|
||||
// Si il s'agit d'un lecteur CD, d'un disque dur ou d'un port (COM ou LPT), on remplace la description du périphérique par un nom plus parlant
|
||||
end else if (Reg3.ReadString('Class')='CDROM') or (Reg3.ReadString('Class')='DiskDrive') or (Reg3.ReadString('Class')='Ports') then
|
||||
line[num] := Translate(Reg3.ReadString('Class'))+'|'+Reg3.ReadString('FriendlyName')
|
||||
else line[num] := Translate(Reg3.ReadString('Class'))+'|'+Reg3.ReadString('DeviceDesc');
|
||||
// Ajout des informations si elles sont présentes dans le registre
|
||||
if Reg3.ValueExists('DeviceDesc') then Line[num] := Line[num] + '§Description@'+Reg3.ReadString('DeviceDesc');
|
||||
if Reg3.ValueExists('FriendlyName') then Line[num] := Line[num] + '§FriendlyName@'+Reg3.ReadString('FriendlyName');
|
||||
if Reg3.ValueExists('Mfg') then Line[num] := Line[num] + '§Fabriquant@'+Reg3.ReadString('Mfg');
|
||||
if Reg3.ValueExists('Service') then Line[num] := Line[num] + '§Service@'+Reg3.ReadString('Service');
|
||||
if Reg3.ValueExists('LocationInformation') then Line[num] := Line[num] + '§Emplacement@'+Reg3.ReadString('LocationInformation');
|
||||
if Reg3.ValueExists('Class') then Line[num] := Line[num] + '§Enumérateur@'+Reg3.ReadString('Class');
|
||||
FinalList.Add(line[num]);
|
||||
inc(num);
|
||||
//Affiche(line,clyellow);
|
||||
Reg3.CloseKey;Setlength(line,num+1);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
NumLine:=num-1;
|
||||
|
||||
finally
|
||||
// On libère les éléments créés au départ
|
||||
Reg3.Free;
|
||||
Reg2.Free;
|
||||
Reg1.Free;
|
||||
FinalList.Free;
|
||||
SubSubCatList.Free;
|
||||
SubCatList.Free;
|
||||
CategoriesList.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
|
||||
|
||||
Binary file not shown.
@@ -22,7 +22,7 @@ var
|
||||
FormVersion: TFormVersion;
|
||||
Lance_verif : integer;
|
||||
|
||||
Const Version='1.2';// sert à la comparaison de la version publiée
|
||||
Const Version='1.3'; //Version='1.2';// sert à la comparaison de la version publiée
|
||||
|
||||
implementation
|
||||
|
||||
@@ -97,7 +97,7 @@ procedure verifie_version;
|
||||
var s,s2,s3,Version_p,Url,LocalFile : string;
|
||||
trouve_version,trouve_zip : boolean;
|
||||
fichier : text;
|
||||
i,j : integer;
|
||||
i,j,erreur : integer;
|
||||
V_publie,V_utile : real;
|
||||
begin
|
||||
//Affiche('vérifie version',clLime);
|
||||
@@ -147,12 +147,13 @@ begin
|
||||
|
||||
// changer le . en ,
|
||||
s:=Version_p;
|
||||
i:=pos('.',s);if i<>0 then s[i]:=',';
|
||||
// i:=pos('.',s);if i<>0 then s[i]:=',';
|
||||
s2:=version;
|
||||
i:=pos('.',s2);if i<>0 then s2[i]:=',';
|
||||
// i:=pos('.',s2);if i<>0 then s2[i]:=',';
|
||||
|
||||
val(s,V_publie,erreur); if erreur<>0 then exit;
|
||||
val(s2,V_utile,erreur); if erreur<>0 then exit;
|
||||
|
||||
V_publie:=StrToFloat(s);
|
||||
V_utile:=StrToFloat(s2);
|
||||
if V_utile<V_publie then
|
||||
begin
|
||||
FormVersion.show;
|
||||
|
||||
Reference in New Issue
Block a user