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, qui auftritt, si un 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 et Contrôle
    declare  ende%,ergebnis$,tstring$
    Systemzeit etc
    declare wYear%,wMonth%,wDay%,wHour%,wMinute%,wSecond%
    ergebnis$ =
    Bich je (déjà) drin ???

    ifnot InternetGetConnectedState(0,0)

        ergebnis$ = error 1
        return ergebnis$

    endif

    Winsock.dll initialisieren
    clear wsadata#

    si 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 un Streamsocket erzeugt volonté/// P3: 0 - Provider bestimmt cela Protokoll
    mysocket&=socket(2,1,0)

    si mysocket& = -1

        ergebnis$ = error 3
        WSAClean()
        return ergebnis$

    endif

    Nonblocking modus / Usermessage übergeben

    si 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 sur Hostent - Struktur

    si dummy& = 0                          Internetadresse konnte pas trouvé/ aufgelöst volonté

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

    endif

    clear hostent#
    Kopieren qui Infos aus qui hostent - Struktur ( dummy& ) dans qui 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 pour 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 relier...
    wsaerror& = connect(mysocket&,sockaddr_in#,16)

    si wsaerror& = -1

        wsaerror& = WSAGetLastError()

        ifnot (wsaerror& = 10035) | (wsaerror& = 0)  0 = ne...aucune faute, 10035 = WSAWOULDBLOCK, cet

            ergebnis$ = error 6                       annonce erfolgt à cause de dem NonBlocking - Modus,
            closesocket(mysocket&)                      ist mais pour uns unbeachtlich
            WSAClean()
            return ergebnis$

        endif

    endif

    qui nachfolgende Boucle pourrait abgeändert volonté, indem z.B. SLEEP count& (= paramètre P3)
    verwendet et qui Anzahl qui Durchläufe herabgesetzt wird
    ebenso pourrait aussi qui USERMESSAGE 4100 abgefragt volonté, pour den de mir beabsichtigten Zweck
    genügte cet variante ( i.d.R. liegt un Ergebnis pour etwa 50 Durchläufen avant ).

    si ergebnis$ =

        avdat&=0

        Whileloop count&

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

            si avdat& > 0                                  wurden et gibt qui Anzahl dans avdat& zurück

                dim zwbuf#,avdat&
                clear zwbuf#
                recv(mysocket&,zwbuf#,avdat&,0)               liest qui Anzahl qui empfangenen données (avdat&)
                pause                                         dans zwbuf# un

            endif

        endwhile

        si avdat& > 0

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

            ifnot pointer&=0                              paramètre 4 qui Unit, pointer& ist qui Adresse

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

            d'autre

                erlaubt& = 0                        aucun Struktur übergeben, alors aucun Erlaubnis zum
                endif                                mettons qui Systemzeit = ignoriere paramètre 5

            d'autre

                ergebnis$ = error 7           es wurden aucun données empfangen

            endif

            closesocket(mysocket&)
            WSAClean()

        endif

        si erlaubt&                             paramètre 5 qui Unit: mettons qui Systemzeit erlaubt

            SetSystemTime(pointer&)
            dummy& = SetLocalTime(pointer&)
            casenot dummy& : ergebnis$ = error 8     faute beim mettons qui System ( lokalen ) Zeit

        endif

        return ergebnis$

    endproc