Internetverbindung prüfen

[alexander]

Hi,

wie überprüfe ich ob eine Internetverbindung besteht? (Mit synapse wäre es schön, da ich es auch sonst synapse benutze)

Unter Indy (damals in Delphi) war es:
If InternetGetConnectedState(nil, 0) then


Gruß Alexander

[theo]

InternetGetConnectedState ist Winapi und scheint's auch nicht zuverlässig.
Wozu willst du denn das überhaupt wissen?

[alexander]

damit ich mit synapse die versionsdatei von meinem Webspace runterladen kann.
Wenn ich das Internet nämlich nicht da ist und versuche runterzuladen braucht synapse gaaaaaanz lange....

[theo]

Wenn ich das Internet nämlich nicht da ist und versuche runterzuladen braucht synapse gaaaaaanz lange....

Da wird wahrsch. vor allem auf die Namensauflösung gewartet.
Da hast du wenig direkten Einfluss.
Ich würde die Socket Geschichte in einem separaten Thread abwickeln.
Den kannst du dann einfach abknallen, wenn du nicht mehr warten willst.
(Das machen Web-Browser ja auch so)

[alexander]

hmmmm gibt es keine einfachere Lösung?

[theo]

Mir ist keine einfachere bekannt. Was passt dir denn daran nicht?
Ist doch eine saubere Sache und du brauchst dich nicht mit irgendwelchen Netzwerk API's rumschlagen.

[alexander]

hmmm ich habe mich mit threads noch nicht so beschäftigt und müsste mich reinarbeiten, wie man was macht....

[theo]

Ich hab dir kurz ne Demo gemacht. Ist nicht so schwer in deinem Fall.
Vergiss nicht unter Linux im Projektsource (project1.lpr) den UseCThreads Switch zu löschen oder diesen dem Compilier mitzugeben.

Code: Alles auswählen

unit Unit1; 
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, httpsend;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Start: TButton;
    Stop: TButton;
    Memo1: TMemo;
    procedure StartClick(Sender: TObject);
    procedure StopClick(Sender: TObject);
  private
    { private declarations }
    procedure ThreadTerminates(Sender: TObject);
  public
    { public declarations }
  end; 
 
  { THTTPThread }
 
  THTTPThread=class(TThread)
  private
    fData: String;
    fURL: String;
    fHTTP: THTTPSend;
  protected
   procedure Execute; override;
  public
  procedure SoftAbort;
  procedure HardAbort;
  property URL:String read fURL write fURL;
  property Data:String read fData;
  end;
 
var
  Form1: TForm1; 
  MyThrd:THTTPThread;
 
implementation
 
{ TForm1 }
 
procedure TForm1.StartClick(Sender: TObject);
begin
  MyThrd := THTTPThread.Create(True);
  MyThrd.OnTerminate := @ThreadTerminates;
  MyThrd.URL := 'http://www.lazarusforum.de';
  MyThrd.FreeOnTerminate := true;
  MyThrd.Resume;
end;
 
procedure TForm1.StopClick(Sender: TObject);
begin
  MyThrd.HardAbort;
end;
 
procedure TForm1.ThreadTerminates(Sender: TObject);
begin
  Memo1.Text:=MyThrd.Data;
end;
 
{ THTTPThread }
 
procedure THTTPThread.Execute;
var Success:boolean;
begin
  fHTTP := THTTPSend.Create;
  try
    Success := fHTTP.HTTPMethod('GET', fURL);
    if Success then
    begin
     fHTTP.Document.Position := 0;
     SetString(fData, PChar(fHTTP.Document.Memory), fHTTP.Document.Size);
    end;
  finally
    fHTTP.Free;
  end;
end;
 
procedure THTTPThread.SoftAbort;
begin
  Terminate;
  fHTTP.Abort; //stop flag setzen
end;
 
procedure THTTPThread.HardAbort;
begin
  SoftAbort;
  FreeAndNil(fHTTP);
end;
 
initialization
  {$I unit1.lrs}
 
end.

[alexander]

erstmal riesen DANK. Das Demo ist super!

ok das ist interessant...
Jaaa es klappt! (danke für den Hinweis mit UseCThreads (hatte ich ganz vergessen))

hmmm nur stop bringt einen Fehler...
und zwar hier:

Code: Alles auswählen

fHTTP.Abort; //stop flag setzen

EDIT: Ahh es bringt nur einen Fehler wenn es schon fertig ist!
Das ist SUUUUUUPER!

Riesen Dank


EDIT2: Wie kann ich prüfen ob die Überprüfung noch läuft?
(Damit man bei dem Fall nur noch freeannil macht)

hmmm das in StopClick:

Code: Alles auswählen

if assigned(MyThrd) then
    MyThrd.SoftAbort;

bringt auch nichts.....


EDIT3: so ganz verstehe ich es nicht...

Code: Alles auswählen

unit Unit1; 
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, HTTPSend;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Start: TButton;
    Stop: TButton;
    Memo1: TMemo;
    procedure StartClick(Sender: TObject);
    procedure StopClick(Sender: TObject);
  private
    { private declarations }
    procedure ThreadTerminates(Sender: TObject);
  public
    { public declarations }
  end; 
       { THTTPThread }
 
  THTTPThread=class(TThread)
  private
    fData: String;
    fURL: String;
    fHTTP: THTTPSend;
  protected
   procedure Execute; override;
  public
    procedure SoftAbort;
    procedure HardAbort;
    property URL:String read fURL write fURL;
    property Data:String read fData;
  end;
 
 
var
  Form1: TForm1;
  MyThrd:THTTPThread;
 
implementation
 
{ TForm1 }
 
procedure TForm1.StartClick(Sender: TObject);
begin
  MyThrd := THTTPThread.Create(True);
  MyThrd.OnTerminate := @ThreadTerminates;
  MyThrd.URL := 'http://www.lazarusforum.de';
  MyThrd.FreeOnTerminate := true;
  Memo1.Text:='Start'+#13;
  MyThrd.Resume;
end;
 
procedure TForm1.StopClick(Sender: TObject);
begin
  if assigned(MyThrd) then
    MyThrd.HardAbort;
end;
 
procedure TForm1.ThreadTerminates(Sender: TObject);
begin
  Memo1.Text:=Memo1.Text+MyThrd.Data;
  Memo1.Text:=Memo1.Text+#13+'ende';
end;
 
{ THTTPThread }
 
procedure THTTPThread.Execute;
var Success:boolean;
begin
  fHTTP := THTTPSend.Create;
  try
    Success := fHTTP.HTTPMethod('GET', fURL);
    if Success then
    begin
     fHTTP.Document.Position := 0;
     SetString(fData, PChar(fHTTP.Document.Memory), fHTTP.Document.Size);
    end;
  finally
    fHTTP.Free;
  end;
  sleep(2000);
end;
 
procedure THTTPThread.SoftAbort;
begin
  Terminate;
  fHTTP.Abort; //stop flag setzen
end;
 
procedure THTTPThread.HardAbort;
begin
  SoftAbort;
  FreeAndNil(fHTTP);
end;
 
initialization
  {$I unit1.lrs}
 
end.

[theo]

EDIT2: Wie kann ich prüfen ob die Überprüfung noch läuft?
(Damit man bei dem Fall nur noch freeannil macht, aber nicht mehr den stop flag setzt, da sonst anscheinend ein fehler kommt)

Naja, das sind dann die Feinheiten..

Du kannst in ThreadTerminates einfach am Schluss MyThrd:=nil setzen.
Dann vor dem Zugriff prüfen:
if Assigned(MyThrd) then MyThrd.HardAbort;

Alternativ kannst du auch den Stop Button nach dem Resume aktivieren und bei ThreadTerminates deaktivieren

Lass dir was einfallen...

[alexander]

hmmm ok ich habe ein bisschen noch mit sleep rumprobiert um herauszufinden ob der stop button während der ausführung klappt. Sleep scheint aber nicht so gut zu sein...

hmmm ich muss schauen wie ich mache , dass er weiß das das programm beendet ist...

VIELEN DANK

Gruß Alexander

[theo]

> EDIT3: so ganz verstehe ich es nicht..

Was?

[alexander]

ich weiß es noch nicht, ich bin noch am ausprobieren/verstehen

[petermännchen]

sleep ist wirklich schlecht.
Besser wäre
//Ersatz für sleep
//sleep hält das gesamte System an

t := time;
repeat
application.processmessages;
until time - t >= strtotime('00:00:05');

Wartet ca. 5 Sekunden und gibt dem PC zwischenzeitlich Zeit zum Arbeiten. Man merkt diese Routine kaum.

Gruß

Peter

[theo]

@petermännchen: Aber erst müsste man mal den Grund wissen, weshalb Alexander überhaupt sleepen will.
Ausserdem bringt dein Vorschlag in einem separaten Thread nix