XProfan

Inettime
 $L
Def WSAStart(2) !wsock32.dll,WSAStartup
Def socket(3) !wsock32.dll,socket
Def WSAAsyncSelect(4) !wsock32.dll,WSAAsyncSelect
Def htons(1) !wsock32.dll,htons
Def connect(3) !wsock32.dll,connect
Def gethostbyname(1) !wsock32.dll,gethostbyname
Def recv(4) !wsock32.dll,recv
Def ioctlsocket(3) !wsock32.dll,ioctlsocket
Def closesocket(1) !wsock32.dll,closesocket
Def WSAClean(0) !wsock32.DLL,WSACleanup
Def WSAGetLastError(0) !wsock32.dll,WSAGetLastError
Def RtlMoveMemory(3) !kernel32,RtlMoveMemory
Def InternetGetConnectedState(2) !WININET.DLL,InternetGetConnectedState
Def SetSystemTime(1) !KERNEL32,SetSystemTime
Def SetLocalTime(1) !KERNEL32,SetLocalTime
USERMESSAGES 4100    Message, die auftritt, wenn ein Netzwerkereignis stattfindet (WSAAsyncSelect)

proc ?_getTime

    parameters netadr$,netport&,count&,pointer&,erlaubt&
    Winsock - Variablen
    declare wsaerror&,Inetadresse#,sockaddr_in#,zwbuf#,avdat&
    declare dummy&,hostent#,xnetport&,xnetorderadr&,wsadata#,mysocket&
    dim Inetadresse#,255
    dim wsadata#,526
    dim sockaddr_in#,16
    dim hostent#,$5000
    Kontrolle und Steuerung
    declare  ende%,ergebnis$,tstring$
    Systemzeit etc
    declare wYear%,wMonth%,wDay%,wHour%,wMinute%,wSecond%
    ergebnis$ =
    Bich ich (schon) drin ???

    ifnot InternetGetConnectedState(0,0)

        ergebnis$ = error 1
        return ergebnis$

    endif

    Winsock.dll initialisieren
    clear wsadata#

    if WSAStart($101,wsadata#)

        ergebnis$ = error 2
        return ergebnis$

    endif

    Streamsocket erzeugen
    P1: (AF_INET = 2) Internet Protokoll version 4 (IPv4) Adressfamilie/// P2: (SOCK_STREAM = 1)
    es soll ein Streamsocket erzeugt werden/// P3: 0 - Provider bestimmt das Protokoll
    mysocket&=socket(2,1,0)

    if mysocket& = -1

        ergebnis$ = error 3
        WSAClean()
        return ergebnis$

    endif

    Nonblocking modus / Usermessage übergeben

    if WSAAsyncSelect(mysocket&,%hwnd,4100,$1) <> 0

        ergebnis$ = error 4
        closesocket(mysocket&)
        WSAClean()
        return ergebnis$

    endif

    clear Inetadresse#
    string Inetadresse#,0=netadr$
    dummy&=gethostbyname(Inetadresse#)     liefert Pointer auf Hostent - Struktur

    if dummy& = 0                          Internetadresse konnte nicht gefunden/ aufgelöst werden

        ergebnis$ = error 5
        closesocket(mysocket&)
        WSAClean()
        return ergebnis$

    endif

    clear hostent#
    Kopieren der Infos aus der hostent - Struktur ( dummy& ) in die eigene Bereichsvariable hostent#
    RtlMoveMemory(hostent#,dummy&,16)
    dummy&=long(hostent#,12)
    RtlMoveMemory(hostent#,dummy&,4)
    dummy&=long(hostent#,0)
    RtlMoveMemory(hostent#,dummy&,255)
    xnetorderadr&=long(hostent#,0)
    xnetport&=htons(netport&)
    Struktur für winsock connect (Protokoll, Port, Adresse ) füllen
    word sockaddr_in#,0=2 AF_inet
    word sockaddr_in#,2=xnetport&
    long sockaddr_in#,4=xnetorderadr&
    Streamsocket verbinden...
    wsaerror& = connect(mysocket&,sockaddr_in#,16)

    if wsaerror& = -1

        wsaerror& = WSAGetLastError()

        ifnot (wsaerror& = 10035) | (wsaerror& = 0)  0 = kein Fehler, 10035 = WSAWOULDBLOCK, diese

            ergebnis$ = error 6                       Meldung erfolgt wegen dem NonBlocking - Modus,
            closesocket(mysocket&)                      ist aber für uns unbeachtlich
            WSAClean()
            return ergebnis$

        endif

    endif

    Die nachfolgende Schleife könnte abgeändert werden, indem z.B. SLEEP count& (= Parameter P3)
    verwendet und die Anzahl der Durchläufe herabgesetzt wird
    ebenso könnte auch die USERMESSAGE 4100 abgefragt werden, für den von mir beabsichtigten Zweck
    genügte diese Variante ( i.d.R. liegt ein Ergebnis nach etwa 50 Durchläufen vor ).

    if ergebnis$ =

        avdat&=0

        Whileloop count&

            ioctlsocket(mysocket&,$4004667F,addr(avdat&))  $4004667F = FIONREAD - prüft ob Daten empfangen

            if avdat& > 0                                  wurden und gibt die Anzahl in avdat& zurück

                dim zwbuf#,avdat&
                clear zwbuf#
                recv(mysocket&,zwbuf#,avdat&,0)               liest die Anzahl der empfangenen Daten (avdat&)
                break                                         in zwbuf# ein

            endif

        endwhile

        if avdat& > 0

            ergebnis$ = string$(zwbuf#,0)
            ergebnis$=translate$(ergebnis$,chr$(13)+chr$(10),)   Carriage return / Line Feed entfernen

            ifnot pointer&=0                              Parameter 4 der Unit, pointer& ist die Adresse

                wYear% = val(right$(ergebnis$,4))            einer übergebenen SystemTime - Struktur
                RtlMoveMemory(pointer&,addr(wYear%),2)       Struktur wird gefüllt....
                case instr(JAN,Upper$(ergebnis$)) : wMonth% = 1
                case instr(FEB,Upper$(ergebnis$)) : wMonth% = 2
                case instr(MAR,Upper$(ergebnis$)) : wMonth% = 3
                case instr(APR,Upper$(ergebnis$)) : wMonth% = 4
                case instr(MAY,Upper$(ergebnis$)) : wMonth% = 5
                case instr(JUN,Upper$(ergebnis$)) : wMonth% = 6
                case instr(JUL,Upper$(ergebnis$)) : wMonth% = 7
                case instr(AUG,Upper$(ergebnis$)) : wMonth% = 8
                case instr(SEP,Upper$(ergebnis$)) : wMonth% = 9
                case instr(OCT,Upper$(ergebnis$)) : wMonth% = 10
                case instr(NOV,Upper$(ergebnis$)) : wMonth% = 11
                case instr(DEC,Upper$(ergebnis$)) : wMonth% = 12
                RtlMoveMemory(pointer&+2,addr(wmonth%),2)
                wDay% = val(substr$(ergebnis$,3,chr$(32)))
                RtlMoveMemory(pointer&+6,addr(wDay%),2)
                tstring$ = substr$(ergebnis$,4,chr$(32))
                wHour% = val(substr$(tstring$,1,:))
                RtlMoveMemory(pointer&+8,addr(wHour%),2)
                wMinute% = val(substr$(tstring$,2,:))
                RtlMoveMemory(pointer&+10,addr(wMinute%),2)
                wSecond% = val(substr$(tstring$,3,:))
                RtlMoveMemory(pointer&+12,addr(wSecond%),2)

            else

                erlaubt& = 0                        Keine Struktur übergeben, also keine Erlaubnis zum
                endif                                Setzen der Systemzeit = ignoriere Parameter 5

            else

                ergebnis$ = error 7           es wurden keine Daten empfangen

            endif

            closesocket(mysocket&)
            WSAClean()

        endif

        if erlaubt&                             Parameter 5 der Unit: Setzen der Systemzeit erlaubt

            SetSystemTime(pointer&)
            dummy& = SetLocalTime(pointer&)
            casenot dummy& : ergebnis$ = error 8     Fehler beim Setzen der System ( lokalen ) Zeit

        endif

        return ergebnis$

    endproc