@winni
unit NetAlive1;
{$mode objfpc}{$H+}
// Winni Bartnick, 18.9.2019
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
procedure GetMyIPAddress;
procedure Timer1Timer(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
uses
fphttpclient, RegexPr;
{$R *.lfm}
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
begin
Close;
end;
// stolen fom https://wiki.lazarus.freepascal.org/fphttpclient
// modified
procedure TForm1.GetMyIPAddress;
var
HTTPClient: TFPHTTPClient;
IPRegex: TRegExpr;
RawData: string;
msg: string;
begin
try
HTTPClient := TFPHTTPClient.Create(nil);
IPRegex := TRegExpr.Create;
try
//returns something like:
{
<html><head><title>Current IP Check</title></head><body>Current IP Address: 44.151.191.44</body></html>
}
RawData := HTTPClient.Get('http://checkip.dyndns.org');
// adjust for expected output; we just capture the first IP address now:
IPRegex.Expression := RegExprString('\b\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\b');
//or
//\b(?:\d{1,3}\.){3}\d{1,3}\b
if IPRegex.Exec(RawData) then
begin
msg := IPRegex.Match[0];
end
else
begin
msg := 'Got invalid results getting external IP address.';
// Details:'+LineEnding+ RawData;
end;
except
on E: Exception do
begin
msg := 'Error retrieving external IP address '; //+E.Message;
end;
end;
Label1.Caption := msg;
finally
HTTPClient.Free;
IPRegex.Free;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
GetMyIPAddress;
Label2.Caption := TimeToStr(Time);
Timer1.Enabled := True;
end;
end.
Tested it out, also added Timer1.Enabled so that timer doesnt fire every second but after function finishes.
It is fast, but not any faster than Ping request or HTTPMethod("HEAD" request (when there is a connection). And yes, there is no problem when there is connection and when device is online but when there is no connection or when router loses connection to ISP for example (i simulate every possible situation) one request can hang for 30 seconds which is a long time.
Is there a timeout that actually works for HTTPClient because i tried everything i found in documentation and internet but no property affects that hang time when there is no connection.
Thats my real problem i cant figure out how to solve, even if i put it in thread, thread would still need to finish that job (wait for 30 secs) before it will terminate (the clean way).
Recent
