XProfan

Deutsch

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Internet: Prüfen, ob Rechner online ist (per Rootserver-IP)
*------------------------------------------------*
* Prüfen ob Rechner online ist per Rootserver IP *
*                                                *
* Original von A. Miethe in 2001                 *
*------------------------------------------------*
DEF IcmpCreateFile(0)  !ICMP.DLL,IcmpCreateFile
DEF IcmpSendEcho(8)    !ICMP.DLL,IcmpSendEcho
DEF IcmpCloseHandle(1) !ICMP.DLL,IcmpCloseHandle
DEF inet_addr(1)       !WS2_32.DLL,inet_addr

Proc Online_Test

    Declare hIcmp&,Ip&,Rv&,TimeOut&
    Declare Ip$,Result$
    Declare Reply#,IP#
    Ip$ = 198.41.0.4
    *---andere Rootserver IPS
    *-ROOT-SERVERS.NET IP = 128.9.0.107
    *-ROOT-SERVERS.NET IP = 192.33.4.12
    *-ROOT-SERVERS.NET IP = 128.8.10.90
    *-ROOT-SERVERS.NET IP = 192.203.230.10
    *-ROOT-SERVERS.NET IP = 192.5.5.241
    *-ROOT-SERVERS.NET IP = 192.112.36.4
    *-ROOT-SERVERS.NET IP = 128.63.2.53
    *-ROOT-SERVERS.NET IP = 192.36.148.17
    Dim Ip#,32
    String Ip#,0 = Ip$
    Let Ip& = inet_addr(Addr(Ip$))
    *---ICMP-Handle öffnen
    Let hIcmp& = IcmpCreateFile()
    *---Echo senden
    Dim Reply#,32
    Long Reply#,8 = $FFFFFFFF
    Let Timeout& = 1000
    Let Rv& = IcmpSendEcho(hIcmp&,Ip&,0,0,0,Reply#,32+8,TimeOut&)
    *---ICMP-Handle schließen
    IcmpCloseHandle(hIcmp&)

    If Rv&=0

        Result$ = Rechner ist nicht online

    Else

        Result$ = Rechner ist online

    EndIf

    WindowTitle Result$

EndProc

CLS
WindowTitle Prüfe Online-Status
Online_Test
WaitInput
*---Aufräumen
Dispose ip#,Reply#
*---Ende:
End