unit verif_version;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls , ComCtrls ,WinInet, ExtCtrls , StrUtils, unitPrinc,
ShellAPI ;
type
TFormVersion = class(TForm)
TimerVerif: TTimer;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure TimerVerifTimer(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
FormVersion: TFormVersion;
Lance_verif : integer;
verifVersion,notificationVersion : boolean;
Const Version='7.0'; // 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;
function DownloadURL_NOCache(aUrl: string;s : string;var taille : longint): Boolean;
function url_github(var url: string) : boolean;
implementation
uses unitconfig;
{$R *.dfm}
Procedure Aff(s : string);
begin
FormVersion.Memo1.lines.add(s);
end;
function GetCurrentProcessEnvVar(const VariableName: string): string;
var
nSize: DWord;
begin
nSize:=0;
nSize:=GetEnvironmentVariable(PChar(VariableName), nil, nSize);
if nSize=0 then
begin
result:='';
end
else
begin
SetLength(result,nSize-1);
if GetEnvironmentVariable(PChar(VariableName), PChar(result), nSize) <> nSize - 1 then
raise Exception.Create(SysErrorMessage(GetlastError))
end;
end;
// récupère l'url de téléchargement du github avec curl
// curl -s https://api.github.com/repos/f1iwq2/signaux_complexes_gl/releases/latest \
function url_github(var url: string) : boolean;
var s : string;
retour,i : integer;
trouve : boolean;
fichier : text;
begin
result:=false;
url:='';
s:='-s -o url.txt https://api.github.com/repos/f1iwq2/signaux_complexes_gl/releases/latest'; // résultat dans url.txt
//s:='';
retour:=ShellExecute(Formprinc.Handle,'open',
Pchar('curl.exe'),
//Pchar('cmd.exe'),
Pchar(s), // paramètre
Pchar('') // répertoire
,SW_HIDE); // pas d'affichage
if retour>32 then
begin
result:=true;
assign(fichier,'url.txt');
reset(fichier);
trouve:=false;
while not(eof(fichier)) or not trouve do
begin
readln(fichier,s);
if pos('browser_download_url',s)<>0 then
begin
trouve:=true;
i:=pos('https',s);
delete(s,1,i-1);
i:=pos('"',s);
s:=copy(s,1,i-1);
url:=s;
end;
end;
end
end;
// téléchargement d'une page internet sans cache dans un fichier
// 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;
i : integer;
t : longint;
begin
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
//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;
InternetReadFile(hService,@lpBuffer,1024,dwBytesRead);
fs.WriteBuffer(lpBuffer,dwBytesRead);
t:=t+dwBytesRead;
if dwBytesRead=0 then break;
end;
Result := True;
taille:=t;
finally
InternetCloseHandle(hService);
end;
end;
finally
InternetCloseHandle(hSession);
end;
finally
fs.Free;
end;
end;
// renvoie le numéro de version depuis le forum CDM
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_utile,V_publie : real;
SV_publie : char;
taille : longint;
comm : array[1..10] of string;
begin
//Affiche('vérifie version',clLime);
// tester si on peut extraire l'url par curl
//if url_github(UrlGIT) then affiche('curl ok',clyellow);
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,taille) then
begin
AssignFile(fichier,LocalFile);
reset(fichier);
while not(eof(fichier)) and (not(trouve_version) or not(trouve_zip)) do
begin
readln(fichier,s);
//Affiche(s,clyellow);
//s:=LowerCase(s);
if not(trouve_version) then
begin
i:=pos('version ',LowerCase(s));
trouve_version:=i<>0;
if trouve_version then
begin
s2:=s;zone_comm:=true;
//Affiche('trouvé version',clOrange);
end;
end;
if not(trouve_zip) then
begin
i:=pos('.zip',LowerCase(s));
trouve_zip:=i<>0;
//if trouve_zip then Affiche(s,clyellow);
if trouve_zip then
begin
s3:=s;
//zone_comm:=false;
end;
end;
// commentaire en gras
if zone_comm then
begin
i:=pos('bold">',LowerCase(s))+6;i2:=posEx('
',LowerCase(s),i+1); i3:=posEx('',LowerCase(s),i+1) ;
if i<>6 then
begin
//Affiche(s,clred);
inc(ncomm);
if i3',LowerCase(s))+6;i3:=posEx('',LowerCase(s),i+1);i2:=posEx('
',LowerCase(s),i+1);
inc(ncomm);
if i20 then s[i]:=',';
s2:=version;
// i:=pos('.',s2);if i<>0 then s2[i]:=',';
s:=AnsiUppercase(s);
l:=length(s);
SV_publie:=s[l];
if Sv_publie in ['0'..'9'] then Sv_Publie:=' ' else begin s:=copy(s,1,l-1);Version_P:=s;end;
val(s,V_publie,erreur);
if erreur<>0 then exit;
val(s2,V_utile,erreur);
if erreur<>0 then exit;
if (V_utile0 then
begin
Aff('Nouveautés de la V'+version_p+SV_publie+' de Signaux_Complexes_GL :');
aff(' ');
for i:=1 to ncomm-1 do aff(comm[i]);
end;
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\'+Nomfichier;
Aff('Téléchargement de '+s3+' dans ');
Aff(s);
if DownloadURL_NOCache(s3,s,taille) then
begin
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 1 de téléchargement');
end
else formVersion.Free;
end;
result:=V_publie;
end;
end
else
begin
result:=0;
if notificationVersion then Affiche('Pas d''accès au site ou échec téléchargement',clorange);
end;
end;
procedure TFormVersion.FormCreate(Sender: TObject);
begin
if debug=1 then Affiche('Création fenêtre version',clLime);
Timerverif.Interval:=1000; // timer à 1 seconde
Lance_verif:=2; // lancer la vérification de version dans 3s
if debug=1 then Affiche('Fin création fenêtre version',clLime);
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=0 then
begin
timerVerif.Enabled:=false;
if not(AvecInit) then exit;
if not(verifVersion) then exit;
if debug=1 then Affiche('Vérification version en ligne',clLime);
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
end.