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, The appears, if one Netzwerkereignis stattfindet (WSAAsyncSelect)

proc ?_getTime

    parameters netadr$,netport&,count&,pointer&,erlaubt&
    Winsock - variables
    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
    control and Control
    declare  end%,Result$,tstring$
    System-Time etc
    declare wYear%,wMonth%,wDay%,wHour%,wMinute%,wSecond%
    Result$ =
    Bich I (already) drin ???

    ifnot InternetGetConnectedState(0,0)

        Result$ = error 1
        return Result$

    endif

    Winsock.dll initialisieren
    clear wsadata#

    if WSAStart($101,wsadata#)

        Result$ = error 2
        return Result$

    endif

    Streamsocket produce
    P1: (AF_INET = 2) internet log Version 4 (IPv4) Adressfamilie/// P2: (SOCK_STREAM = 1)
    it should one Streamsocket created go/// P3: 0 - Provider certainly the log
    mysocket&=socket(2,1,0)

    if mysocket& = -1

        Result$ = error 3
        WSAClean()
        return Result$

    endif

    Nonblocking mode / User Message übergeben

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

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

    endif

    clear Inetadresse#
    string Inetadresse#,0=netadr$
    dummy&=gethostbyname(Inetadresse#)     supply Pointer on Hostent - structure

    if dummy& = 0                          Internetadresse could not found/ aufgelöst go

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

    endif

    clear hostent#
    copy the Info from the hostent - structure ( dummy& ) in The Own Memory-Variable 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&)
    structure for winsock connect (log, Port, address ) fill
    word sockaddr_in#,0=2 AF_inet
    word sockaddr_in#,2=xnetport&
    long sockaddr_in#,4=xnetorderadr&
    Streamsocket contact...
    wsaerror& = connect(mysocket&,sockaddr_in#,16)

    if wsaerror& = -1

        wsaerror& = WSAGetLastError()

        ifnot (wsaerror& = 10035) | (wsaerror& = 0)  0 = no Error, 10035 = WSAWOULDBLOCK, these

            Result$ = error 6                       Message results because of the NonBlocking - mode,
            closesocket(mysocket&)                      is but for us unbeachtlich
            WSAClean()
            return Result$

        endif

    endif

    The follow up Loop could abgeändert go, because in example SLEEP count& (= Parameter P3)
    uses and The amount the Durchläufe herabgesetzt becomes
    likewise could too The USERMESSAGE 4100 quizzed go, for whom of me intended object
    genügte these Variante ( i.d.R. lying one Result to about 50 Durchläufen to ).

    if Result$ =

        avdat&=0

        Whileloop count&

            ioctlsocket(mysocket&,$4004667F,addr(avdat&))  $4004667F = FIONREAD - checks whether data receive

            if avdat& > 0                                  get and gives The amount in avdat& back

                dim zwbuf#,avdat&
                clear zwbuf#
                recv(mysocket&,zwbuf#,avdat&,0)               reads The amount the conceived data (avdat&)
                break                                         in zwbuf# one

            endif

        endwhile

        if avdat& > 0

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

            ifnot pointer&=0                              Parameter 4 the Unit, pointer& is The address

                wYear% = val(right$(Result$,4))            of/ one übergebenen SystemTime - structure
                RtlMoveMemory(pointer&,addr(wYear%),2)       structure becomes filled....
                case instr(JAN,Upper $(Result$)) : wMonth% = 1
                case instr(FEB,Upper $(Result$)) : wMonth% = 2
                case instr(MAR,Upper $(Result$)) : wMonth% = 3
                case instr(APR,Upper $(Result$)) : wMonth% = 4
                case instr(MAY,Upper $(Result$)) : wMonth% = 5
                case instr(JUN,Upper $(Result$)) : wMonth% = 6
                case instr(JUL,Upper $(Result$)) : wMonth% = 7
                case instr(AUG,Upper $(Result$)) : wMonth% = 8
                case instr(SEP,Upper $(Result$)) : wMonth% = 9
                case instr(OCT,Upper $(Result$)) : wMonth% = 10
                case instr(NOV,Upper $(Result$)) : wMonth% = 11
                case instr(DEC,Upper $(Result$)) : wMonth% = 12
                RtlMoveMemory(pointer&+2,addr(wmonth%),2)
                wDay% = val(substr$(Result$,3,chr $(32)))
                RtlMoveMemory(pointer&+6,addr(wDay%),2)
                tstring$ = substr$(Result$,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                        No structure übergeben, means no permit to that
                endif                                settle the System-Time = ignoriere Parameter 5

            else

                Result$ = error 7           it get no data receive

            endif

            closesocket(mysocket&)
            WSAClean()

        endif

        if erlaubt&                             Parameter 5 the Unit: settle the System-Time allows

            SetSystemTime(pointer&)
            dummy& = SetLocalTime(pointer&)
            casenot dummy& : Result$ = error 8     Error at settle the system ( local ) Time

        endif

        return Result$

    endproc