Kontroller om pc er online

uses wininet;

function InternetConnected: Boolean;
CONST
  INTERNET_CONNECTION_MODEM      = 1;
  INTERNET_CONNECTION_LAN        = 2;
  INTERNET_CONNECTION_PROXY      = 4;
  INTERNET_CONNECTION_MODEM_BUSY = 8;
var
  dwConnectionTypes : DWORD;
begin
  dwConnectionTypes := INTERNET_CONNECTION_MODEM + INTERNET_CONNECTION_LAN + INTERNET_CONNECTION_PROXY;
  Result := InternetGetConnectedState(@dwConnectionTypes,0);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if InternetConnected = true then
begin
Label1.Caption:='Du er på.';
end
else
begin
Label1.Caption:='Du er ikke på.';
end;
end;

http://www.swissdelphicenter.ch/torry/showcode.php?id=466

I stedet for
if InternetConnected = true then
kan du bare skrive
if InternetConnected then

hmm... jeg kan ikke rigtigt få det til at virke. kan det have noget at gøre med, at jeg benytter 2 netkort? - Kan man ikke istedet lave en direkte kontrol efter, og systemet kan finde en bestemt fil såsom www.netjay.dk/images/warning.gif

den siger jeg er connected selvom jeg hiver kabelmodemmet fra

uses
  WinInet;

function IsConnectedToInternet: Boolean;
var
  dwConnectionTypes: DWORD;
begin
  dwConnectionTypes :=
    INTERNET_CONNECTION_MODEM +
    INTERNET_CONNECTION_LAN +
    INTERNET_CONNECTION_PROXY;
  Result := InternetGetConnectedState(@dwConnectionTypes, 0);
end;

Den kode virker hos mig... ADSL...

Prøv med en timer med et interval på 1000 :-)

den bliver ved med at sige jeg er online selvom jeg hiver netkablet ud

Og du har prøvet at sætte timerens interval til 1000?

ja, jeg har også lavet en knap til manuelt forsøg

Hmm... hvor længe lod du net-stikket være ude?

et par min... prøver lige igen i længere tid. Kunne godt tænke mig, at den kontrollerede en direkte URL, så funktionen samtidig kunne kontrollere om eens side var gået ned...

Her, måske: http://www.eksperten.dk/kat/7?searchtype=txt&words=ping&method=and&sort=score&catid=7

http://www.swissdelphicenter.com/en/showcode.php?id=70, måske. Ligner dog noget af det du allerede har prøvet...

Måske virker det vist du fjerner INTERNET_CONNECTION_LAN:

function IsConnectedToInternet: Boolean;
var
  dwConnectionTypes: DWORD;
begin
  dwConnectionTypes :=
    INTERNET_CONNECTION_MODEM +
    INTERNET_CONNECTION_PROXY;
  Result := InternetGetConnectedState(@dwConnectionTypes, 0);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if IsConnectedToInternet then
    ShowMessage('Connected.')
  else
    ShowMessage('Not Connected.')
end;

nej den siger stadig online... vil prøve at satse på ping...

1)

Kopier og gem den følgende unit :

interface
uses
  Classes, Sysutils, IdIcmpClient, IdAntiFreeze, IdHTTP;

type
  TDNSResolver = class
  private
    FTarget: string;
    FTraceList: TStringList;
    FMaxHops: Integer;
    FTraceLog: TStringList;
    ResolvedHost: string;
    IdIcmpClient: TIdIcmpClient;
    IdAntiFreeze1: TIdAntiFreeze;
    procedure SetTarget(const Value: string);
    procedure SetMaxHops(const Value: Integer);
    procedure Trace;
  public
    constructor Create;
    destructor Destroy; override;
    function Execute: Boolean;
    function PingHost(Host: string; TTL: Integer): Boolean;
  published
    property Target: string read FTarget write SetTarget;
    property TraceList: TStringList read FTraceList;
    property TraceLog: TStringList read FTraceLog;
    property MaxHops: Integer read FMaxHops write SetMaxHops default 30;
  end;

  THttpCheckSum = class
  private
    FTarget: string;
    procedure SetTarget(const Value: string);
  public
    function Execute: string;
    property Target: string read FTarget write SetTarget;
  end;

implementation
uses
  idStack, IdException, MD5;

{ TDNSResolver }

constructor TDNSResolver.Create;
begin
  inherited;
  FTraceList := TStringList.Create;
  FTraceLog := TStringList.Create;
  FMaxHops := 30;
  FTarget := ''; //localhost
  IdIcmpClient := TIdIcmpClient.Create(nil);
  IdAntiFreeze1 := TIdAntiFreeze.Create(nil);
end;

destructor TDNSResolver.Destroy;
begin
  FreeAndNil(FTraceList);
  FreeAndNil(FTraceLog);
  FreeAndNil(IdIcmpClient);
  FreeAndNil(IdAntiFreeze1);
  inherited;
end;

function TDNSResolver.Execute: Boolean;
begin
  Result := False;
  FTraceList.Clear;
  FTraceLog.Clear;

  FTraceLog.Add(Format('resolving %s', [Target]));
  try
    ResolvedHost := gStack.WSGetHostByName(Target);
    Result := True;
    FTraceLog.Add(format('%s resolved to %s', [Target, ResolvedHost]));
  except
    on e: EIdSocketError do
      FTraceLog.Text := FTraceLog.Text + e.message;
  end;

  if Result then
  begin
    PingHost(ResolvedHost, MaxHops);
    Trace;
  end;
end;

function TDNSResolver.PingHost(Host: string; TTL: Integer): Boolean;
begin
  Result := False;

  FTraceLog.Add(Format('Ping %s', [Host]));

  IdIcmpClient.Host := Host;
  IdIcmpClient.TTL := TTL;
  IdIcmpClient.ReceiveTimeout := 5000;
  IdIcmpClient.Ping;
  with IdIcmpClient, ReplyStatus do
    case IdIcmpClient.ReplyStatus.ReplyStatusType of
      rsEcho:
        begin
          FTraceLog.Add(Format('response from host %s in %d millisec.', [FromIpAddress, MsRoundTripTime]));
          Result := True;
        end;
      rsError:
        FTraceLog.Add('Unknown error.');
      rsTimeOut:
        FTraceLog.Add('Timed out.');
      rsErrorUnreachable:
        FTraceLog.Add(format('Host %s reports destination network unreachable.', [FromIpAddress]));
      rsErrorTTLExceeded:
        FTraceLog.Add(format('Hope %d %s: TTL expired.', [TTL, FromIpAddress]));
    end; // case
end;

procedure TDNSResolver.SetMaxHops(const Value: Integer);
begin
  FMaxHops := Value;
end;

procedure TDNSResolver.SetTarget(const Value: string);
begin
  FTarget := Value;
end;

procedure TDNSResolver.Trace;
var
  TTL: Integer;
  Reached: Boolean;
  aItem: string;
begin
  TTL := 0;
  reached := False;
  FTraceList.Clear;
  repeat
    inc(TTL);
    IdIcmpClient.Host := ResolvedHost;
    IdIcmpClient.TTL := TTL;
    IdIcmpClient.ReceiveTimeout := 5000;
    IdIcmpClient.Ping;
    aItem := '';
    case IdIcmpClient.ReplyStatus.ReplyStatusType of
      rsEcho:
        begin
          aItem := IdIcmpClient.ReplyStatus.FromIpAddress + #9 + format('Reached in : %d ms', [IdIcmpClient.ReplyStatus.MsRoundTripTime]);
          reached := True;
        end;
      rsError:
        begin
          aItem := IdIcmpClient.ReplyStatus.FromIpAddress + #9 + 'Unknown error.';
        end;
      rsTimeOut:
        begin
          aItem := '?.?.?.?'#9'Timed out.';
        end;
      rsErrorUnreachable:
        begin
          aItem := IdIcmpClient.ReplyStatus.FromIpAddress + #9 + format('Destination network unreachable', [IdIcmpClient.ReplyStatus.MsRoundTripTime]);
          break;
        end;
      rsErrorTTLExceeded:
        begin
          aItem := IdIcmpClient.ReplyStatus.FromIpAddress + #9 + format('TTL=%d', [IdIcmpClient.ReplyStatus.TimeToLive]);
        end;
    end; // case
    FTraceList.Add(IntToStr(TTL) + #9 + aItem);
  until reached or (TTL > MaxHops);
end;

{ THttpCheckSum }

function THttpCheckSum.Execute: string;
begin
  with TIdHTTP.Create(nil) do
  try
    Result := StrMd5(Get(Target));
  finally
    free;
  end;
end;

procedure THttpCheckSum.SetTarget(const Value: string);
begin
  if not SameText(copy(Value, 1,  7), 'http://') then
    FTarget := 'http://' + Value
  else
    FTarget := Value;
end;

end.



2)
Smid en knap, et Edit felt (EditIP), og et Memo på din form.
3)
  Prøv så det her :
  with TDNSResolver.Create do
  try
    Target := EditIP.Text;
    Execute;
    Memo1.Text := ' === Trace Log === ';
    Memo1.Lines.AddStrings(TraceLog);
    Memo1.Lines.Add('');
    Memo1.Lines.Add(' === Trace List ===');
    Memo1.Lines.AddStrings(TraceList);
  finally
    free;
  end;

Jens B

Hej borrisholt.

jeg får fejlen : Error in Unit1 - Declaration of class TForm1 is missing or incorrect, men efter at have prøvet lidt, kan jeg se, at den mangler MD5.dcu. Hvis du gider, må du gerne maile mig et eksempel på netjay@get2net.dk

Nej jeg vil heller stille eksemplet til rådighed for alle :-)

http://Borrisholt.com/Eksperten/DNS.zip

Jens B

THttpCheckSum skal du som ikke bruge i den her sammenhæng. Den er lavet til at checke on en side ændere sig !

Jens B

Ja, det er også meget bedre, når man har en side, at lægge det ud på :)
...Men dit eksempel kan lige nøjagtig det jeg søger,
så jeg takker mange gange.