easylinux/SignauxComplexes
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

V5.75+

Browse Source
This commit is contained in:
f1iwq2
2023-04-12 17:51:51 +02:00
parent 1eaadabf4b
commit 21344ebd93
21 changed files with 273 additions and 114 deletions
Download Patch File Download Diff File Expand all files Collapse all files
UnitCDF.dcu
BIN
View File
Binary file not shown.
UnitConfig.dcu
BIN
View File
Binary file not shown.
UnitConfig.pas
+13 -2
View File
@@ -1635,7 +1635,7 @@ var s,sa,SOrigine: string;
trouve_section_branche,trouve_section_sig,trouve_section_act,trouve_tempo_feu,
trouve_algo_uni,croi,trouve_Nb_cantons_Sig,trouve_dem_aig,trouve_demcnxCOMUSB,trouve_demcnxEth : boolean;
virgule,i_detect,i,erreur,aig2,detect,offset,j,position,
ComptEl,Compt_IT,Num_Element,adr,t,Nligne,postriple,itl,
ComptEl,Compt_IT,Num_Element,adr,Nligne,postriple,itl,
postjd,postjs,nv,it,Num_Champ,asp,adraig,poscroi : integer;
function lit_ligne : string ;
@@ -6682,6 +6682,8 @@ begin
i:=index_feu(adr);
dec:=feux[i].decodeur;
x:=feux[i].aspect;
// signal directionnel
if x>10 then
begin
nombre_adresses_signal:=x-10;
@@ -6708,7 +6710,16 @@ begin
93,94,95,96,97,98,99 : nc:=4;
end;
end;
if dec=7 then nc:=8; // sr
if dec=7 then nc:=8; // sr
if dec=8 then
begin
case x of
3 : nc:=3;
4,5 : nc:=4;
7 : nc:=5;
9 : nc:=5;
end;
end;
nombre_adresses_signal:=nc;
end;
UnitConfigCellTCO.dcu
BIN
View File
Binary file not shown.
UnitConfigTCO.dcu
BIN
View File
Binary file not shown.
UnitDebug.dcu
BIN
View File
Binary file not shown.
UnitPilote.dcu
BIN
View File
Binary file not shown.
UnitPrinc.dcu
BIN
View File
Binary file not shown.
UnitPrinc.dfm
+7 -3
View File
@@ -18,7 +18,7 @@ object FormPrinc: TFormPrinc
OnCreate = FormCreate
DesignSize = (
1197
612)
611)
PixelsPerInch = 96
TextHeight = 13
object LabelTitre: TLabel
@@ -1203,7 +1203,7 @@ object FormPrinc: TFormPrinc
object SplitterH: TSplitter
Left = 0
Top = 0
Height = 590
Height = 589
end
object ScrollBox1: TScrollBox
Left = 632
@@ -1268,7 +1268,7 @@ object FormPrinc: TFormPrinc
end
object StatusBar1: TStatusBar
Left = 0
Top = 590
Top = 589
Width = 1197
Height = 22
Panels = <>
@@ -1928,6 +1928,10 @@ object FormPrinc: TFormPrinc
Caption = 'A propos'
OnClick = Apropos1Click
end
object Vrifiernouvelleversion1: TMenuItem
Caption = 'V'#233'rifier nouvelle version'
OnClick = Vrifiernouvelleversion1Click
end
end
object Roulage1: TMenuItem
Caption = 'Roulage'
UnitPrinc.pas
+152 -44
View File
@@ -163,6 +163,7 @@ type
Panel2: TPanel;
FenRich: TRichEdit;
SplitterV: TSplitter;
Vrifiernouvelleversion1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure MSCommUSBLenzComm(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
@@ -241,6 +242,7 @@ type
procedure EditAdrTrainChange(Sender: TObject);
procedure SplitterVMoved(Sender: TObject);
procedure PopupMenuFeuPopup(Sender: TObject);
procedure Vrifiernouvelleversion1Click(Sender: TObject);
private
{ Déclarations privées }
procedure DoHint(Sender : Tobject);
@@ -288,15 +290,14 @@ Max_Simule=10000;
Max_Event_det_tick=30000;
EtatSign : array[0..13] of string[20] =('carré','sémaphore','sémaphore cli','vert','vert cli','violet',
'blanc','blanc cli','jaune','jaune cli','ral 30','ral 60','rappel 30','rappel 60');
NbDecodeur = 8;
decodeur : array[0..NbDecodeur-1] of string[20] =('rien','Digital Bahn','CDF','LDT','LEB','Digikeijs 4018','Unisemaf Paco','SR');
NbDecodeur = 9;
decodeur : array[0..NbDecodeur-1] of string[20] =('rien','Digital Bahn','CDF','LDT','LEB','Digikeijs 4018','Unisemaf Paco','Stéphane Ravaut','Arcomora');
Etats : array[0..19] of string[30]=('Non commandé',
'carré','sémaphore','sémaphore cli','vert','vert cli','violet','blanc','blanc cli','jaune','jaune cli',
'ralen 30','ralen 60','ralen 60 + jaune cli','rappel 30','rappel 60','rappel 30 + jaune','rappel 30 + jaune cli','rappel 60 + jaune','rappel 60 + jaune cli');
type
Taccessoire = (aigP,feu); // aiguillage ou feu
TMA = (valide,devalide);
TEquipement = (rien,aig,tjd,tjs,triple,det,buttoir,voie,crois,act); // voie uniquement pour le tco
TBranche = record
BType : Tequipement ; // ne prend que les valeurs suivantes: dét aig Buttoir
@@ -1537,9 +1538,9 @@ begin
width:=LargImg;
Height:=HtImg;
s:='Index='+IntToSTR(rang)+' @='+inttostr(Adresse)+' Décodeur='+intToSTR(feux[rang].Decodeur)+
' Adresse détecteur associé='+intToSTR(feux[rang].Adr_det1)+
' Adresse élement suivant='+intToSTR(feux[rang].Adr_el_suiv1);
s:='Index='+IntToSTR(rang)+' @='+inttostr(Adresse)+' Décodeur='+decodeur[feux[rang].Decodeur]+
' Adresse détecteur associé='+intToSTR(feux[rang].Adr_det1)+
' Adresse élement suivant='+intToSTR(feux[rang].Adr_el_suiv1);
if feux[rang].Btype_suiv1=aig then s:=s+' (aig)';
Hint:=s;
@@ -2214,7 +2215,7 @@ begin
end;
end;
feux[i].EtatSignal:=code;
Dessine_feu_mx(Feux[Index_Feu(adr)].Img.Canvas,0,0,1,1,adr,1);
Dessine_feu_mx(Feux[Index_Feu(adr)].Img.Canvas,0,0,1,1,adr,1);
end;
end;
@@ -2564,41 +2565,135 @@ begin
AfficheDebug(s,clyellow);
end;
Sleep(60); // si le feu se positionne à la suite d'un positionnement d'aiguillage, on peut avoir le message station occupée
//Affiche(IntToSTR(aspect)+' '+inttoSTR(combine),clOrange);
if (aspect<>-1) and (combine=-1) then
Sleep(60); // si le feu se positionne à la suite d'un positionnement d'aiguillage, on peut avoir le message station occupée
//Affiche(IntToSTR(aspect)+' '+inttoSTR(combine),clOrange);
if (aspect<>-1) and (combine=-1) then
begin
if (aspect=carre) then envoi5_LEB(0);
if (aspect=violet) then envoi5_LEB(1);
if (aspect=blanc_cli) then envoi5_LEB(2);
if (aspect=blanc) then envoi5_LEB(3);
if (aspect=semaphore) then envoi5_LEB(4);
if (aspect=semaphore_cli) then envoi5_LEB(5);
if (aspect=jaune) then envoi5_LEB(8);
if (aspect=jaune_cli) then envoi5_LEB($a);
if (aspect=vert_cli) then envoi5_LEB($c);
if (aspect=vert) then envoi5_LEB($d);
if (aspect=rappel_30) then envoi5_LEB(6);
if (aspect=rappel_60) then envoi5_LEB(7);
if (aspect=ral_30) then envoi5_LEB(9);
if (aspect=ral_60) then envoi5_LEB($b);
end;
if (combine<>-1) and (aspect=-1) then
begin
if (Combine=rappel_30) then envoi5_LEB(6);
if (Combine=rappel_60) then envoi5_LEB(7);
if (Combine=ral_30) then envoi5_LEB(9);
if (Combine=ral_60) then envoi5_LEB($b);
end;
if ((Combine=rappel_30) and (aspect=jaune)) then envoi5_LEB($e);
if ((Combine=rappel_30) and (aspect=jaune_cli)) then envoi5_LEB($f);
if ((Combine=rappel_60) and (aspect=jaune)) then envoi5_LEB($10);
if ((Combine=rappel_60) and (aspect=jaune_cli)) then envoi5_LEB($11);
if ((Combine=ral_60) and (aspect=jaune_cli)) then envoi5_LEB($12);
end;
end;
// pilote le décodeur arcomora
procedure envoi_arcomora(adresse :integer);
var asp,aspect,combine,code,offset,sortie : integer;
s : string;
begin
index:=index_feu(adresse);
if (feux[index].AncienEtat<>feux[index].EtatSignal) then //; && (stop_cmd==FALSE))
begin
if (aspect=carre) then envoi5_LEB(0);
if (aspect=violet) then envoi5_LEB(1);
if (aspect=blanc_cli) then envoi5_LEB(2);
if (aspect=blanc) then envoi5_LEB(3);
if (aspect=semaphore) then envoi5_LEB(4);
if (aspect=semaphore_cli) then envoi5_LEB(5);
if (aspect=jaune) then envoi5_LEB(8);
if (aspect=jaune_cli) then envoi5_LEB($a);
if (aspect=vert_cli) then envoi5_LEB($c);
if (aspect=vert) then envoi5_LEB($d);
if (aspect=rappel_30) then envoi5_LEB(6);
if (aspect=rappel_60) then envoi5_LEB(7);
if (aspect=ral_30) then envoi5_LEB(9);
if (aspect=ral_60) then envoi5_LEB($b);
end;
if (combine<>-1) and (aspect=-1) then
begin
if (Combine=rappel_30) then envoi5_LEB(6);
if (Combine=rappel_60) then envoi5_LEB(7);
if (Combine=ral_30) then envoi5_LEB(9);
if (Combine=ral_60) then envoi5_LEB($b);
end;
if ((Combine=rappel_30) and (aspect=jaune)) then envoi5_LEB($e);
if ((Combine=rappel_30) and (aspect=jaune_cli)) then envoi5_LEB($f);
if ((Combine=rappel_60) and (aspect=jaune)) then envoi5_LEB($10);
if ((Combine=rappel_60) and (aspect=jaune_cli)) then envoi5_LEB($11);
if ((Combine=ral_60) and (aspect=jaune_cli)) then envoi5_LEB($12);
code:=feux[index].EtatSignal;
asp:=feux[index].aspect;
code_to_aspect(code,aspect,combine);
s:='Signal Arcomora: ad'+IntToSTR(adresse)+'='+chaine_signal(code);
if traceSign then affiche(s,clOrange);
if Affsignal then afficheDebug(s,clOrange);
if AffDetSig then
begin
s:='Tick='+IntToSTR(tick)+' Signal '+IntToSTR(adresse)+'='+chaine_signal(feux[index].EtatSignal);
AfficheDebug(s,clyellow);
end;
Sleep(60);
if asp=2 then
begin
case aspect of
violet : begin offset:=0;sortie:=2;end;
blanc : begin offset:=0;sortie:=1;end;
blanc_cli : begin offset:=1;sortie:=1;end;
end;
end;
if asp=3 then
begin
case aspect of
vert : begin offset:=0;sortie:=1;end;
jaune : begin offset:=0;sortie:=2;end;
semaphore : begin offset:=1;sortie:=1;end;
vert_cli : begin offset:=1;sortie:=2;end;
semaphore_cli : begin offset:=2;sortie:=1;end;
jaune_cli : begin offset:=2;sortie:=2;end;
end;
end;
if (asp=4) or (asp=5) then
begin
case aspect of
vert : begin offset:=0;sortie:=1;end;
jaune : begin offset:=0;sortie:=2;end;
semaphore : begin offset:=1;sortie:=1;end;
carre : begin offset:=1;sortie:=2;end;
vert_cli : begin offset:=2;sortie:=1;end;
jaune_cli : begin offset:=2;sortie:=2;end;
semaphore_cli : begin offset:=3;sortie:=1;end;
end;
end;
if (asp=7) then
begin
case aspect of
vert : begin offset:=0;sortie:=1;end;
jaune : begin offset:=0;sortie:=2;end;
semaphore : begin offset:=1;sortie:=1;end;
carre : begin offset:=1;sortie:=2;end;
vert_cli : begin offset:=4;sortie:=1;end;
semaphore_cli : begin offset:=4;sortie:=2;end;
end;
case combine of
ral_30 : begin offset:=2;sortie:=1;end;
ral_60 : begin offset:=3;sortie:=1;end;
end;
end;
if (asp=9) then
begin
case aspect of
vert : begin offset:=0;sortie:=1;end;
jaune : begin offset:=0;sortie:=2;end;
semaphore : begin offset:=1;sortie:=1;end;
carre : begin offset:=1;sortie:=2;end;
vert_cli : begin offset:=4;sortie:=1;end;
semaphore_cli : begin offset:=4;sortie:=2;end;
end;
case combine of
ral_30 : begin offset:=2;sortie:=1;end;
rappel_30 : begin offset:=2;sortie:=2;end;
ral_60 : begin offset:=3;sortie:=1;end;
rappel_60 : begin offset:=3;sortie:=2;end;
end;
end;
end;
Pilote_acc(adresse+offset,sortie,feu);
end;
(*==========================================================================
envoie les données au décodeur NMRA étendu
adresse=adresse sur le BUS DCC
@@ -2643,9 +2738,6 @@ begin
AfficheDebug(s,clyellow);
end;
// attention: impossible d'envoyer des octets en XpressNet!!
// NMRA ne focntionnera pas..
case aspect of
carre : valeur:=0;
semaphore : valeur:=1;
@@ -3538,6 +3630,7 @@ begin
5 : digi_4018(Adr);
6 : envoi_UniSemaf(Adr);
7 : envoi_SR(Adr);
8 : envoi_arcomora(Adr);
end;
// Gestion démarrage temporisé des trains si on quitte le rouge : ne fonctionne qu'en roulage
@@ -8871,9 +8964,9 @@ end;
// traitement des évènements actionneurs (detecteurs aussi)
// adr adr2 : pour mémoire de zone
procedure Event_act(adr,adr2,etat : integer;trainDecl : string);
var typ,i,v,va,etatAct,Af,Ao,Access,sortie,dZ1F,dZ2F,dZ1O,dZ2O : integer;
var typ,i,v,etatAct,Af,Ao,Access,sortie,dZ1F,dZ2F,dZ1O,dZ2O : integer;
s,st,trainDest : string;
fm,fd,presTrain_PN,adresseOk,etatvalide : boolean;
fm,fd,adresseOk,etatvalide : boolean;
Ts : TAccessoire;
begin
if adr<=0 then exit;
@@ -10526,7 +10619,7 @@ end;
// Lance et connecte CDM rail. en sortie si CDM est lancé Lance_CDM=true,
function Lance_CDM : boolean;
var i,retour,retour2 : integer;
var i,retour : integer;
repertoire,s : string;
cdm_lanceLoc : boolean;
begin
@@ -13640,6 +13733,21 @@ begin
ob.Items[1].Caption:='Informations du signal '+intToSTR(AdrPilote);
end;
begin
procedure TFormPrinc.Vrifiernouvelleversion1Click(Sender: TObject);
var s : string;
v_publie,v_utile : real;
erreur : integer;
begin
V_publie:=verifie_version;
str(v_publie:2:2,s);
if v_publie>0 then
begin
val(version,V_utile,erreur);
if V_utile=V_publie then Affiche('Votre version '+Version+SousVersion+' est à jour',clLime);
if V_utile>V_publie then Affiche('Votre version '+version+SousVersion+' est plus récente que la version publiée '+s,clLime);
end
else Affiche('Site CDM-Rail inateignable',clred);
end;
end.
UnitSR.dcu
BIN
View File
Binary file not shown.
UnitSimule.dcu
BIN
View File
Binary file not shown.
UnitTCO.dcu
BIN
View File
Binary file not shown.
UnitTCO.pas
+3 -6
View File
@@ -2521,7 +2521,7 @@ end;
// Element 24
procedure dessin_24(Canvas : Tcanvas;x,y,mode: integer);
var x0,y0,xc,yc,jx1,jy1,jx2,xf,yf,position : integer;
var x0,y0,xc,yc,jx1,jy1,xf,yf,position : integer;
r : Trect;
fond: tcolor;
@@ -4196,7 +4196,6 @@ end;
procedure TFormTCO.FormActivate(Sender: TObject);
var s : string;
r :Trect;
begin
if affevt then Affiche('Form TCO activate',clyellow);
if not(Forminit) then
@@ -4347,8 +4346,7 @@ end;
// vérifie que les icones adjacentes sont cohérentes
function verif_cellule(x,y,Bim : integer) : boolean;
var res,verif : boolean;
Bimz,i : integer;
bl,bz : integer;
Bimz,i,bl : integer;
begin
result:=true;
verif:=false;
@@ -5361,8 +5359,7 @@ end;
procedure TFormTCO.ImageTCOMouseMove(Sender: TObject; Shift: TShiftState;X, Y: Integer);
var r : Trect;
cellX,cellY,x0,y0,XSel1,YSel1,XSel2,YSel2,Bimage,xMiniSelP,yMiniSelP,xMaxiSelP,yMaxiSelP : integer;
s : string;
cellX,cellY,XSel1,YSel1,XSel2,YSel2,Bimage,xMiniSelP,yMiniSelP,xMaxiSelP,yMaxiSelP : integer;
begin
//Affiche('ImageTCOMouseMove',clLime);
if Temposouris<1 then exit;
Unit_Pilote_aig.dcu
BIN
View File
Binary file not shown.
Unitplace.dcu
BIN
View File
Binary file not shown.
signaux_complexes_5.74.zip
BIN
View File
Binary file not shown.
verif_version.dcu
BIN
View File
Binary file not shown.
verif_version.dfm
+4 -4
View File
@@ -1,8 +1,8 @@
object FormVersion: TFormVersion
Left = 222
Top = 260
BorderIcons = []
BorderStyle = bsNone
BorderIcons = [biSystemMenu]
BorderStyle = bsDialog
Caption = 'V'#233'rification de version'
ClientHeight = 234
ClientWidth = 645
@@ -18,9 +18,9 @@ object FormVersion: TFormVersion
TextHeight = 20
object Memo1: TMemo
Left = 8
Top = 16
Top = 8
Width = 625
Height = 209
Height = 217
Color = clNavy
Font.Charset = ANSI_CHARSET
Font.Color = clYellow
verif_version.pas
+93 -55
View File
@@ -23,11 +23,12 @@ var
Lance_verif : integer;
verifVersion,notificationVersion : boolean;
Const Version='5.74'; // sert à la comparaison de la version publiée
Const Version='5.75'; // sert à la comparaison de la version publiée
SousVersion=' '; // A B C ... en cas d'absence de sous version mettre un espace
function GetCurrentProcessEnvVar(const VariableName: string): string;
function verifie_version : real;
implementation
{$R *.dfm}
@@ -57,40 +58,47 @@ end;
// téléchargement d'une page internet sans cache dans un fichier
function DownloadURL_NOCache(aUrl: string;s : string): Boolean;
// aUrl = adresse URL du fichier - S : chemin et nom du fichier à écrire - taille : renvoie la taille lue en octets
function DownloadURL_NOCache(aUrl: string;s : string;var taille : longint): Boolean;
var
hSession: HINTERNET;
hService: HINTERNET;
Fs:TFileStream;
lpBuffer: array[0..1024 + 1] of byte;
dwBytesRead: DWORD;
dwTimeout : integer;
i : integer;
t : longint;
begin
Result:=False;
DeleteFile(s);
//Affiche('VV1',clLime);
Application.ProcessMessages;
Try Fs:=TFileStream.Create(s,fmCreate,fmShareDenyNone);
hSession:=InternetOpen('MyApp',INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
Result := False;
t:=0;
Try Fs := TFileStream.Create(s,fmCreate);
//hSession := InternetOpen('MyApp', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
hSession := InternetOpen('MyApp', INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY, nil, nil, 0);
try
if Assigned(hSession) then
begin
// fonction longue
dwTimeout:=2000; //2s
//Affiche('VV2',clLime);
Application.ProcessMessages;
InternetSetOption(hSession,INTERNET_OPTION_CONNECT_TIMEOUT,@dwTimeOut, SizeOf(dwTimeOut));
hService:=InternetOpenUrl(hSession, PChar(aUrl), nil, 0, INTERNET_FLAG_RELOAD, 0);
//Affiche('Session assignée',clLime);
hService := InternetOpenUrl(hSession, PChar(aUrl), nil, 0, INTERNET_FLAG_RELOAD, 0);
i:=getLastError;
if i<>0 then
case i of
12037 : Affiche('Erreur validité de certificat',clred);
12157 : Affiche('Erreur canal sécurisé SSL 2.0',clred);
else affiche('Erreur '+intToSTR(i),clred);
end;
if Assigned(hService) then
try
//Affiche('Service assigné',clLime);
while True do
begin
dwBytesRead:=1024;
dwBytesRead := 1024;
InternetReadFile(hService,@lpBuffer,1024,dwBytesRead);
fs.WriteBuffer(lpBuffer,dwBytesRead);
t:=t+dwBytesRead;
if dwBytesRead=0 then break;
end;
Result:=True;
Result := True;
taille:=t;
finally
InternetCloseHandle(hService);
end;
@@ -103,25 +111,25 @@ begin
end;
end;
procedure verifie_version;
var s,s2,s3,Version_p,Url,LocalFile : string;
trouve_version,trouve_zip,zone_comm : boolean;
function verifie_version : real;
var s,s2,s3,Version_p,Url,LocalFile,nomfichier : string;
trouve_version,trouve_zip,zone_comm,LocZip : boolean;
fichier : text;
i,j,erreur,Ncomm,i2,i3,l : integer;
V_publie,V_utile : real;
V_utile,V_publie : real;
SV_publie : char;
taille : longint;
comm : array[1..10] of string;
begin
//Affiche('vérifie version',clLime);
if not(AvecInit) then exit ;
if not(verifVersion) then exit;
Url:='http://cdmrail.free.fr/ForumCDR/viewtopic.php?f=77&t=3906#p50499';
LocalFile:='page.txt';
trouve_version:=false;
trouve_zip:=false;
zone_comm:=false;
Ncomm:=0;
if DownloadURL_NOCache(Url,localFile) then
if DownloadURL_NOCache(Url,localFile,taille) then
begin
AssignFile(fichier,LocalFile);
reset(fichier);
@@ -129,10 +137,10 @@ begin
begin
readln(fichier,s);
//Affiche(s,clyellow);
s:=LowerCase(s);
//s:=LowerCase(s);
if not(trouve_version) then
begin
i:=pos('version ',s);
i:=pos('version ',LowerCase(s));
trouve_version:=i<>0;
if trouve_version then
begin
@@ -142,7 +150,7 @@ begin
end;
if not(trouve_zip) then
begin
i:=pos('.zip',s);
i:=pos('.zip',LowerCase(s));
trouve_zip:=i<>0;
//if trouve_zip then Affiche(s,clyellow);
if trouve_zip then
@@ -154,7 +162,7 @@ begin
// commentaire en gras
if zone_comm then
begin
i:=pos('bold">',s)+6;i2:=posEx('<br />',s,i+1); i3:=posEx('</span>',s,i+1) ;
i:=pos('bold">',LowerCase(s))+6;i2:=posEx('<br />',LowerCase(s),i+1); i3:=posEx('</span>',LowerCase(s),i+1) ;
if i<>6 then
begin
//Affiche(s,clred);
@@ -164,7 +172,7 @@ begin
Delete(s,1,i2-1);
j:=0;
repeat
i:=pos('<br />',s)+6;i3:=posEx('</span>',s,i+1);i2:=posEx('<br />',s,i+1);
i:=pos('<br />',LowerCase(s))+6;i3:=posEx('</span>',LowerCase(s),i+1);i2:=posEx('<br />',LowerCase(s),i+1);
inc(ncomm);
if i2<i3 then
begin
@@ -177,7 +185,7 @@ begin
inc(j);
until (i3<i2) or (ncomm=10) or (j=20);
zone_comm:=false;
end;
end;
end;
end;
closefile(fichier);
@@ -185,24 +193,39 @@ begin
if trouve_version and trouve_zip then
begin
// isoler le champ version
i:=pos('version ',s2);
i:=pos('version ',LowerCase(s2));
delete(s2,1,i+7);
j:=pos(' ',s2);
Version_p:=copy(s2,1,j-1); // version dans version_p Exemple V4.73b
// isoler l'url du zip
i:=pos('href="',s3);
delete(s3,1,i+5);
j:=pos('"',s3);
s3:=copy(s3,1,j-1);
i:=pos('.',s3);
if i<>0 then delete(s3,i,1); // supprimer le .
s3:='http://cdmrail.free.fr/ForumCDR'+s3 ;
i:=pos('.zip',LowerCase(s3));
repeat
dec(i);
locZip:=s3[i]='=';
until (i=1) or LocZip;
if locZip then
begin
delete(s3,1,i+1);
end;
i:=pos('zip"',LowerCase(s3)); // s3 contient l'url du zip
s3:=copy(s3,1,i+2);
//isoler le nom du fichier
i:=length(s3);
repeat
dec(i);
locZip:=s3[i]='/';
until (i=1) or LocZip;
nomfichier:=copy(s3,i+1,length(s3)-i);
//Affiche(s3,clLime);
//Affiche(nomfichier,clred);
// changer le . en ,
s:=Version_p;
// 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]:=',';
s:=AnsiUppercase(s);
l:=length(s);
@@ -220,7 +243,6 @@ begin
FormVersion.Top:=10;
FormVersion.Left:=10;
FormVersion.show;
//aff(s3); // url dans s3
s:='Vous utilisez la version '+version+SousVersion+' mais il existe la version '+Version_p+SV_publie;
if ncomm>0 then
begin
@@ -231,31 +253,31 @@ begin
if MessageDlg(s+'. Voulez-vous la télécharger?',mtConfirmation,[mbYes,mbNo],0)=mrYes then
begin
// récupérer depuis la variable d'environnement windows USERPROFILE le repertoire de la session ouverte
s:=GetCurrentProcessEnvVar('USERPROFILE')+'\Downloads\Signaux_Complexes_GL.Zip';
s:=GetCurrentProcessEnvVar('USERPROFILE')+'\Downloads\'+Nomfichier;
Aff('Téléchargement de '+s3+' dans ');
Aff(s);
if DownloadURL_NOCache(s3,s) then
//if true then
if DownloadURL_NOCache(s3,s,taille) then
begin
Aff('Téléchargement réussi');
Aff('Vous pouvez ouvrir le dossier de téléchargement, décomprimer le zip et l''installer');
if taille>700000 then
begin
Aff('Téléchargement réussi');
Aff('Vous pouvez ouvrir le dossier de téléchargement, décomprimer le zip et l''installer');
end
else Aff('Echec 2 de téléchargement');
end
else Aff('Echec de téléchargement');
else Aff('Echec 1 de téléchargement');
end
else formVersion.Free;
end;
result:=V_publie;
if notificationVersion then
begin
if V_utile=V_publie then Affiche('Votre version '+Version_p+SousVersion+' est à jour',clLime);
if V_utile>V_publie then Affiche('Votre version '+version+SousVersion+' est plus récente que la version publiée '+Version_p+SV_publie,clLime);
end;
end;
end
else
begin
if notificationVersion then Affiche('Pas d''accès au site CDM rail ou échec téléchargement',clorange);
result:=0;
if notificationVersion then Affiche('Pas d''accès au site ou échec téléchargement',clorange);
end;
end;
@@ -263,13 +285,29 @@ end;
procedure TFormVersion.FormCreate(Sender: TObject);
begin
Timerverif.Interval:=1000; // timer à 1 seconde
Lance_verif:=3; // lancer la vérification de version dans 1s
Lance_verif:=2; // lancer la vérification de version dans 3s
end;
procedure TFormVersion.TimerVerifTimer(Sender: TObject);
var V_utile,V_publie : real;
erreur: integer;
s : string;
begin
if lance_verif>0 then dec(lance_verif);
if lance_verif=1 then begin lance_verif:=0;verifie_version;end;
if lance_verif=0 then
begin
timerVerif.Enabled:=false;
if not(AvecInit) then exit;
if not(verifVersion) then exit;
V_publie:=verifie_version;
if notificationVersion and (v_publie>0) then
begin
val(version,V_utile,erreur);
str(v_publie:2:2,s);
if V_utile=V_publie then Affiche('Votre version '+Version+SousVersion+' est à jour',clLime);
if V_utile>V_publie then Affiche('Votre version '+version+SousVersion+' est plus récente que la version publiée '+s,clLime);
end;
end;
end;
begin
versions.txt
+1
View File
@@ -162,4 +162,5 @@ version 5.73 : Ajout d'un bouton d'autorisation pour le pare-feu windows.
version 5.74 : Correction bug création nouveau TCO.
Nouvel installeur-> Signaux complexes s'installe dans c:\programmes\signaux_complexes.
avec un raccourci sur le bureau.
version : Gestion du décodeur de signaux Arcomora.