1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62
| uses ...., fphttpclient, fpopenssl, openssl, opensslsockets;
....
TAboutBox = class(TForm)
....
public
function ChkNewVersion (url: string=''): string;
end;
implementation
....
function TAboutBox.ChkNewVersion(url: string=''): string;
var
MyHTTPCli: TFPHTTPClient;
spage: string;
stagurl: string;
titlebeg, titleend: Integer;
A: TStringArray;
sl: TStringList;
s: string;
i, p: integer;
begin
result:= '';
sl:= TStringList.create();
// if length(url)=0 then url:= ChkVerUrl; //Sans objet ici
{ SSL initialization has to be done by hand here }
InitSSLInterface;
MyHTTPCli:= TFPHTTPClient.Create(nil);
try
MyHTTPCli.IOTimeout:= 20000;
MyHTTPCli.AllowRedirect:= true;
MyHTTPCli.AddHeader('User-Agent','Mozilla 5.0 (bb84000 '+ProgName+')');
// Parse last release page to get last version
// <title>Release Version 0.9.1.7 - 08/04/2021 etc
sl.text:= MyHTTPCli.Get(url);
Application.ProcessMessages; //let loading complete
if sl.Count > 0 then
begin
for i:= 0 to sl.Count-1 do
begin
p:= pos('<title>', sl.Strings[i]) ;
if p > 0 then
begin
s:=Copy(sl.Strings[i], p+8, 40);
A:= s.Split(' ');
break;
end;
end;
// Avoid exception if we dont find the proper line
if length(A)>=2 then result:= A[2]
else result:= '';
end;
except
on e:Exception do
ErrorMessage:= e.message
end;
if Assigned(MyHTTPCli) then MyHTTPCli.Free;
if Assigned(sl) then sl.free;
end; |
Partager