Wake on LAN Problem :-(

[paritycheck]

Hi,

Wenn es nur darum geht zu überprüfen ob ein Rechner im Netzwerk eingeschaltet ist oder nicht nehme ich meistens diese Funktion. Indys gehen auch aber z.B bei Konsolenanwendungen wird mir dann die Exe zu groß

Delphi-Quellcode:

unit hostalive;

interface

function IsHostAlive(Hostname: String; pTripTime: PCardinal = nil; Timeout: Integer = 1000; TTL: Integer = 255): Boolean;

implementation

uses
  Windows,
  Winsock;

type
  IP_OPTION_INFORMATION = packed record
    TTL: byte;
    TOS: byte;
    Flags: byte;
    OptionsSize: byte;
    OptionsData: pchar;
  end;
  PIP_OPTION_INFORMATION = ^IP_OPTION_INFORMATION;

  ICMP_ECHO_REPLY = packed record
    Address: in_addr;
    Status: Cardinal;
    RoundTripTime: Cardinal;
    DataSize: word;
    Reserved: word;
    Data: pointer;
    Options: IP_OPTION_INFORMATION;
  end;
  PICMP_ECHO_REPLY = ^ICMP_ECHO_REPLY;

function IcmpCreateFile(): Cardinal; stdcall; external 'Iphlpapi.dll' name 'IcmpCreateFile';
function IcmpCloseHandle(IcmpHandle: Cardinal): Boolean; stdcall; external 'Iphlpapi.dll' name 'IcmpCloseHandle';
function IcmpSendEcho(IcmpHandle: Cardinal; DestinationAddress: Cardinal; RequestData: Pointer; RequestSize: Word; RequestOptions: PIP_OPTION_INFORMATION; ReplyBuffer: Pointer; ReplySize: Cardinal; Timeout: Cardinal): Cardinal; stdcall; external 'Iphlpapi.dll' name 'IcmpSendEcho';

function IsHostAlive(Hostname: String; pTripTime: PCardinal = nil; Timeout: Integer = 1000; TTL: Integer = 255): Boolean;
const
  SendBuffer: array[0..31] of char =
              ('p', 'i', 'n', 'g', 'p', 'o', 'n', 'g',
               'p', 'i', 'n', 'g', 'p', 'o', 'n', 'g',
               'p', 'i', 'n', 'g', 'p', 'o', 'n', 'g',
               'p', 'i', 'n', 'g', 'p', 'o', 'n', 'g');
var
  WSA: TWSADATA;
  Reply: PICMP_ECHO_REPLY;
  Addr: Integer;
  hIcmp: cardinal;
  Options: IP_OPTION_INFORMATION;

  function ResolveHost(Hostname: String): Integer;
  type
    PPInAddr= ^PInAddr;
  var
    HostInfo: PHostEnt;
    T: PPInAddr;
  begin
    t:= nil;
    Result:= inet_addr(PChar(Hostname));
    if result = INADDR_NONE then begin
       HostInfo:= gethostbyname(PChar(Hostname));
       if HostInfo <> nil then
          T:= Pointer(HostInfo^.h_addr_list);
       if (T <> nil) and (T^<> nil) then begin
          Result:= T^^.S_addr;
       end;
    end;
  end;

begin
  Result:= False;
  FillChar(Options, sizeof(IP_OPTION_INFORMATION), #0);
  Reply:= nil;
  options.TTL:= TTL;
  options.TOS:= 1;
  if WSAStartUp(((0 shl 8)+2), WSA) = 0 then begin
     Addr:= ResolveHost(Hostname);
     if Addr <> INADDR_NONE then begin
        hIcmp:= IcmpCreateFile();
        if hicmp <> INVALID_HANDLE_VALUE then try
           Reply:= AllocMem(sizeof(ICMP_ECHO_REPLY)+sizeof(SendBuffer));
           IcmpSendEcho(hIcmp, Addr, @SendBuffer[0], sizeof(SendBuffer), @Options, Reply, sizeof(ICMP_ECHO_REPLY)+sizeof(SendBuffer), timeout);
           Result:= (Reply^.Status = 0);
           if Result and (pTripTime <> nil) then
              pTripTime^:= Reply^.RoundTripTime;
        finally
           IcmpCloseHandle(hIcmp);
           if Reply <> nil then
              FreeMem(Reply);
           WSACleanup();
        end;
     end else begin
        WSACleanup();
       // Hostname konnte nicht aufgelöst werden.
     end;
  end else begin
       // Winsock konnte nicht gestartet werden.
  end;
end;

end.

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var
  RTT:Cardinal;
begin
  if IsHostalive('google.de', @RTT) then
     showmessage(inttostr(RTT)+'ms');
end;