Bu durumda bir thread altına almak durumundasınız. Böylece sorgulamadan bağımsız bir yapı kurmuş olursunuz.
Siz dilediğiniz kadar bekler bekleme sonunda Global değişken içeriği neyse ona göre davranırsınız.
Not: showmessage'lere takılmayın onları silebilirsiniz de, burada ne kadar erken geç onu test için ekledim. Siz projenizin içerisinde sadece bu ShowMessage yazan kısımdaki
FIntAvail değişlenini soracaksınız.
* Bekleyeceğiniz süre içerisinde Thread başarılı bitmişse sonuç internet bağlantısı TRUE/FALSE olacak,
* Sorgu zamanı uzar da thread işini bitirmeden erkenden sorarsanız garanti size FALSE cevabı hazır olacaktır.
EK : unutmayın buradaki thread, paralel bir işlem yaptığından hemen aşağıda sorarsanız FALSE cevabı alabilirsiniz. Çünkü THREAD daha sorgusunu yapamadan sizin buton işlemi bir alt satıra 100 milisaniye içinde geçecektir. Size sunulan çözüm, işlem sürüyor olsa bile en fazla 3 saniye bekleme yapmak şeklinde. BU 3000 rakamını 1000 x saniye olarak değerlendirin. Çünkü değerler milisaniye cinsinden...
Örnek :
procedure TForm1.BitBtn2Click(Sender: TObject);
var
LTimeOut : cardinal;
begin
BitBtn1Click(BitBtn1);
LTimeOut := GetTickCount + 3000; // şimdiden 3 saniye ötesine kadar
while (LTimeOut > GetTickCount) and (NOT FIntAvail) do
begin
Application.ProcessMessages;
Sleep(10);
end;
// şimdi internet sonucu ya gelmiştir ya da 3 saniye beklemiştir.
if FIntAvail
then Showmessage('OK')
else Showmessage('FAIL');
end;
Ana projenizdeki yapı şu şekilde olabilir. (
google drive linki )
uses InternetCheckerU;
var
FIntCheck : InternetCheckerU.tInternetChecker;
FIntAvail : boolean;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
if Assigned( FIntCheck ) then
exit;
FIntAvail := false;
FIntCheck := tInternetChecker.Create(true);
FIntCheck.OnTerminate := FIntCheckTerminated;
FIntCheck.OnState := FIntState;
sleep(100);
FIntCheck.Start;
end;
procedure TForm1.FIntCheckTerminated(sender:TObject);
begin
FIntCheck := nil;
end;
procedure TForm1.FIntState(sender:TObject);
begin
FIntAvail := FIntCheck.IsInternetAvailable;
// if FIntAvail
// then Showmessage('OK')
// else Showmessage('FAIL');
end;
bu da Thread içeren unit
unit InternetCheckerU;
interface
uses System.SysUtils, System.Classes, System.Types;
type tInternetChecker = class( TThread )
private
var
FInternetAvail : boolean;
FOnState : TNotifyEvent;
function CheckConnection(url: string): boolean;
protected
procedure Execute; override;
public
constructor Create(CreateSuspended: Boolean);
destructor Destroy; override;
property IsInternetAvailable: boolean read FInternetAvail;
property OnState : TNotifyEvent read FOnState write FOnState;
end;
implementation
uses WinInet;
{ tInternetChecker }
function tInternetChecker.CheckConnection(url:string):boolean;
var
hSession, hfile: hInternet;
dwindex,dwcodelen :dword;
dwcode:array[1..20] of char;
res : pchar;
begin
if pos('https://',lowercase(url))=0
then
url := 'https://'+url;
Result := false;
hSession := InternetOpen('InetURL:/1.0',
INTERNET_OPEN_TYPE_PRECONFIG,nil, nil, 0);
if assigned(hsession) then
begin
hfile := InternetOpenUrl( hsession,
pchar(url),
nil,
0,
INTERNET_FLAG_RELOAD,
0 );
dwIndex := 0;
dwCodeLen := 10;
HttpQueryInfo( hfile, HTTP_QUERY_STATUS_CODE,
@dwcode, dwcodeLen, dwIndex );
res := pchar(@dwcode);
result := (res ='200') or (res ='302');
if assigned(hfile)
then
InternetCloseHandle(hfile);
InternetCloseHandle(hsession);
end;
end;
constructor tInternetChecker.Create(CreateSuspended: Boolean);
begin
inherited Create(CreateSuspended);
FInternetAvail := false;
Self.FreeOnTerminate := True;
end;
destructor tInternetChecker.Destroy;
begin
inherited;
end;
procedure tInternetChecker.Execute;
begin
try
FInternetAvail := CheckConnection( 'https://www.google.com');
if Assigned(FOnState) then FOnState(self);
except on E: Exception do
end;
end;
end.
