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, el auftritt, si una Netzwerkereignis stattfindet (WSAAsyncSelect)

proc ?_getTime

    parámetros netadr$,netport&,count&,pointer&,erlaubt&
    Winsock - Variables
    declarar wsaerror&,Inetadresse#,sockaddr_in#,zwbuf#,avdat&
    declarar dummy&,hostent#,xnetport&,xnetorderadr&,wsadata#,mysocket&
    dim Inetadresse#,255
    dim wsadata#,526
    dim sockaddr_in#,16
    dim hostent#,$5000
    Kontrolle y Steuerung
    declarar  ende%,ergebnis$,tstring$
    Systemzeit etc
    declarar wYear%,wMonth%,wDay%,wHour%,wMinute%,wSecond%
    ergebnis$ =
    Bich Yo (ya) drin ???

    ifnot InternetGetConnectedState(0,0)

        ergebnis$ = error 1
        volver ergebnis$

    endif

    Winsock.dll inicializar
    clear wsadata#

    if WSAStart($101,wsadata#)

        ergebnis$ = error 2
        volver ergebnis$

    endif

    Streamsocket erzeugen
    P1: (AF_INET = 2) Internet Protokoll version 4 (IPv4) Adressfamilie/// P2: (SOCK_STREAM = 1)
    lo se una Streamsocket producido voluntad/// P3: 0 - Provider determinado el Protokoll
    mysocket&=socket(2,1,0)

    if mysocket& = -1

        ergebnis$ = error 3
        WSAClean()
        volver ergebnis$

    endif

    Nonblocking modus / Usermessage übergeben

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

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

    endif

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

    if dummy& = 0                          Internetadresse podría no gefunden/ aufgelöst voluntad

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

    endif

    clear hostent#
    Kopieren el Infos de el hostent - Struktur ( dummy& ) en el propio 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 para 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, esta

            ergebnis$ = error 6                       Meldung es wegen el NonBlocking - Modus,
            closesocket(mysocket&)                      es aber para uns unbeachtlich
            WSAClean()
            volver ergebnis$

        endif

    endif

    El nachfolgende Bucle podría abgeändert voluntad, indem por ejemplo SLEEP count& (= Parámetro P3)
    verwendet y el Anzahl el Durchläufe herabgesetzt se
    ebenso podría auch el USERMESSAGE 4100 abgefragt voluntad, para el de me beabsichtigten Zweck
    genügte esta Variante ( i.d.R. liegt una Ergebnis después de etwa 50 Durchläufen antes ).

    if ergebnis$ =

        avdat&=0

        Whileloop count&

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

            if avdat& > 0                                  fueron y son el Anzahl en avdat& zurück

                dim zwbuf#,avdat&
                clear zwbuf#
                recv(mysocket&,zwbuf#,avdat&,0)               liest el Anzahl el empfangenen Daten (avdat&)
                romper                                         en zwbuf# una

            endif

        endwhile

        if avdat& > 0

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

            ifnot pointer&=0                              Parámetro 4 el Unit, pointer& es el Adresse

                wYear% = val(right$(ergebnis$,4))            uno übergebenen SystemTime - Struktur
                RtlMoveMemory(pointer&,addr(wYear%),2)       Struktur se gefüllt....
                caso instr(JAN,Upper$(ergebnis$)) : wMonth% = 1
                caso instr(FEB,Upper$(ergebnis$)) : wMonth% = 2
                caso instr(MAR,Upper$(ergebnis$)) : wMonth% = 3
                caso instr(APR,Upper$(ergebnis$)) : wMonth% = 4
                caso instr(MAY,Upper$(ergebnis$)) : wMonth% = 5
                caso instr(JUN,Upper$(ergebnis$)) : wMonth% = 6
                caso instr(JUL,Upper$(ergebnis$)) : wMonth% = 7
                caso instr(AUG,Upper$(ergebnis$)) : wMonth% = 8
                caso instr(SEP,Upper$(ergebnis$)) : wMonth% = 9
                caso instr(OCT,Upper$(ergebnis$)) : wMonth% = 10
                caso instr(NOV,Upper$(ergebnis$)) : wMonth% = 11
                caso 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)

            más

                erlaubt& = 0                        Keine Struktur übergeben, also no Erlaubnis para
                endif                                Setzen el Systemzeit = ignoriere Parámetro 5

            más

                ergebnis$ = error 7           lo fueron no Daten empfangen

            endif

            closesocket(mysocket&)
            WSAClean()

        endif

        if erlaubt&                             Parámetro 5 el Unit: Setzen el Systemzeit erlaubt

            SetSystemTime(pointer&)
            dummy& = SetLocalTime(pointer&)
            casenot dummy& : ergebnis$ = error 8     Fehler beim Setzen el Sistema ( lokalen ) Tiempo

        endif

        volver ergebnis$

    ENDPROC