XProfan

' Winsocks.inc
' -----------------------------------------------------------------------------------------
' Winsocks XProfan Include verse. 0.02
' Author Andreas Gaida
' The Include File has with safety yet plenty Error ought to but in the Groben functions
' what I but not promise can .
' the using the Include File or its Procedures happens on Own menace
' -----------------------------------------------------------------------------------------
Def WSAStartup(2) !wsock32,WSAStartup
Def WSACleanup(0) !wsock32,WSACleanup
Def WSAGetLastError(0) !wsock32,WSAGetLastError
Def closesocket(1) !wsock32,closesocket
Def socket(3) !wsock32,socket
Def htons(1) !wsock32,htons
Def inet_addr(1) !wsock32,inet_addr
Def connect(3) !wsock32,connect
Def gethostbyname(1) !wsock32,gethostbyname
Def w32_recv(4) !wsock32,recv
Def w32_bind(3) !wsock32,bind
Def select(5) !wsock32,select
Def w32_send(4) !wsock32,send
Def w32_WSAAsyncSelect(4) !wsock32,WSAAsyncSelect
Def w32_sendto(6) !wsock32,sendto
Def w32_recvfrom(6) !wsock32,recvfrom
Def w32_accept(3) !wsock32,accept
Def w32_listen(2) !wsock32,lists
Def WSAAsyncGetHostByAddr(7) !wsock32,WSAAsyncGetHostByAddr
Def w32_inet_ntoa(1) !wsock32,inet_ntoa
Def w32_gethostname(2) !wsock32,gethostname
Def htonl(1) !wsock32,htonl
Def ntohl(1) !wsock32,ntohl
Def %SOCK_STREAM  1
Def %AF_INET 2
Def %SOCK_DGRAM 2
Def %MSG_PEEK        0x2
STRUCT WSADATA = wVersion%,wHighVersion%,szDescription#(256+1),szSystemStatus#(128+1), iMaxSockets%, iMaxUdpDg%,lpVendorInfo&
STRUCT SOCKADDR_IN  = sin_family%,sin_port%,sin_addr&,sin_zero#(8)
STRUCT HOSTENT =  h_name&, h_aliases&,h_addrtype%,h_length%, h_addr_list&
STRUCT in6_addr =  uint8_t%,s6_addr#(16)                                ' for the new 16 byte Adressen
STRUCT sockadd_in6 =  sin6_family%,sin6_port%,sin6_flowinfo%,in6_addr   ' ka whether the right umgesetzt watts
Declare IP_Addr_Inc#,l_Param&,w_Param&
Declare ENDE&
Dim     IP_Addr_Inc#,16
' -----------------------------------------------------------------------------------------
' These Proc Initialisiert the Winsocks; as Parameter needed tappt im dunkeln The Winsocks Version
' The uses go should z.B  1.1  Init 1,1 or 2.0  Init 2,0  or 2,2  Init 2,2
' must always first thing carryed out go

PROC Init

    Parameters a&,b&
    Declare Error&,WSAData#
    Def MakeWord(2) ((%(1) & $ff) | ((%(2) & $ff)) << 8)
    Dim  WSAData#,WSADATA
    Error& = WSAStartup(MAKEWORD(a&,b&),WSAData#)

    IF Error& <> 0

        MessageBox "!!! WSocks32 couldn't launched go !!! Error code: "+@Str$(Error&),"Message...",0

    ENDIF

    Dispose WSAData#
    Return Error&

ENDPROC

' -----------------------------------------------------------------------------------------
' These Proc Initialisiert a TCP Socket the only on thorough connections wait
' on the your übergebenen Port.with thorough link sends it The übergebene Message
' on the übergebene Window z.B Socket: Socket&, Port: 6969 , Message: $2700 , Window: %hWnd

PROC InitTCP

    Parameters socketconnect&,Port&,Messagenr&,FensterHandle&
    Declare Addr# ,IP$,Error&,backlog&
    Dim Addr#,SOCKADDR_IN
    socketconnect& = socket(%AF_INET,%SOCK_STREAM,0)
    Print  Messagenr& ; ' Message
    IP$ = 0
    Addr#.sin_family% = %AF_INET
    Addr#.sin_port% = htons(Port&)
    Addr#.sin_addr& = inet_addr(Addr(IP$))
    Error& = w32_bind(socketconnect&,Addr#,Sizeof(Addr#))

    IF Error& <> 0

        MessageBox "!!! Socket couldn't tied go !!! Error code: "+@Str$(Error&),"Message...",0

    ENDIF

    ' Error& = w32_WSAAsyncSelect(socketconnect&,FensterHandle&,Messagenr&, 1 | 2 | 4 | 8 | 16 | 32 ) ' these Variante not yet Getestet
    Error& = w32_WSAAsyncSelect(socketconnect&,FensterHandle&,Messagenr&, 1 | 2 | 8 | 16 | 32 )
    ' 1  FD_READ_BIT     2  FD_WRITE_BIT    4  FD_OOB_BIT    8  ACCEPT   16 CONNECT    32 CLOSE

    IF Error& <> 0

        MessageBox "!!! WSAAsyncSelect couldn't carryed out go !!! Error code: "+@Str$(Error&),"Message...",0

    ENDIF

    backlog& = 5
    Error& = w32_listen(socketconnect&,addr(backlog&))

    IF Error& <> 0

        MessageBox "!!! lists couldn't carryed out go !!! Error code: "+@Str$(Error&),"Message...",0

    ENDIF

    Dispose Addr#
    Return socketconnect&

ENDPROC

' -----------------------------------------------------------------------------------------
' -----------------------------------------------------------------------------------------
' These Proc supply The number the Sockets the a thorough link adopted has

PROC GetConnectSocket

    Parameters socketconnect&
    Declare Pointer& ,socketnr&
    Pointer& = addr(IP_Addr_Inc#)
    socketnr& = w32_accept(socketconnect&,IP_Addr_Inc#,addr(Pointer&))
    Return socketnr&

ENDPROC

' -----------------------------------------------------------------------------------------
' These Proc gives The address IP the Senders of/ one TCP Message(data) or with a
' Verbindungsaufbau on(with TCP only Connect and with UDP with each data Pack)

PROC GetIP

    Parameters
    Declare Pointer& ,socketnr&,IPinc$
    IPinc$ =             @Str$(@byte(IP_Addr_Inc#,4))
    IPinc$ = IPinc$+"."+ @Str$(@byte(IP_Addr_Inc#,5))
    IPinc$ = IPinc$+"."+ @Str$(@byte(IP_Addr_Inc#,6))
    IPinc$ = IPinc$+"."+ @Str$(@byte(IP_Addr_Inc#,7))
    Return IPinc$

ENDPROC

' -----------------------------------------------------------------------------------------
' position a link since by a Socket

PROC ConnectTcpTo

    Parameters Port&,IP$,Socket&
    Declare Error& ,Addr#
    Dim Addr#,SOCKADDR_IN
    Addr#.sin_family% = %AF_INET
    Addr#.sin_port% = htons(Port&)
    Addr#.sin_addr& = inet_addr(Addr(IP$))
    Error& = connect(Socket&,Addr#,Sizeof(Addr#))
    Dispose Addr#
    Return Error&

ENDPROC

' -----------------------------------------------------------------------------------------

PROC CreateSocketTcp

    Declare socket&
    socket& = socket(%AF_INET,%SOCK_STREAM,0)
    Return socket&

ENDPROC

' -----------------------------------------------------------------------------------------

PROC SocketToThreat ' Funtioniert only with UPD ,at least have I it yet with TCP not ans walk brought

    Parameters Socket&,Message&,FensterHandle&,Port&
    Declare Error& ,Addr#,Remote$,backlog&
    Remote$ = "0192.168.0.3"
    Dim Addr#,SOCKADDR_IN
    Addr#.sin_family% = %AF_INET
    Addr#.sin_port% = htons(Port&)
    Addr#.sin_addr& = inet_addr(addr(Remote$))
    Error& = w32_bind(Socket&,Addr#,Sizeof(Addr#))

    IF Error& <> 0

        MessageBox "!!! Bind couldn't carryed out go !!! Error code: "+@Str$(Error&),"Message...",0

    ENDIF

    Error& = w32_WSAAsyncSelect(Socket&,FensterHandle&,Message&, 1 )
    ' 1  FD_READ_BIT     2  FD_WRITE_BIT    4  FD_OOB_BIT    8  ACCEPT   16 CONNECT    32 CLOSE
    backlog& = 5
    Error& = w32_listen(Socket&,addr(backlog&))
    Dispose Addr#
    Return Error&

ENDPROC

' -----------------------------------------------------------------------------------------

PROC SocketToThreatTcp  ' Funtioniert with TCP

    Parameters Socket&,Message&,FensterHandle&
    Declare Error&
    ' Error& = w32_WSAAsyncSelect(Socket&,FensterHandle&,Message&, 1 | 2 | 4 | 8 | 16 | 32 )
    Error& = w32_WSAAsyncSelect(Socket&,FensterHandle&,Message&, 1 | 2 )
    ' 1  FD_READ_BIT     2  FD_WRITE_BIT    4  FD_OOB_BIT    8  ACCEPT   16 CONNECT    32 CLOSE
    Return Error&

ENDPROC

' -----------------------------------------------------------------------------------------

PROC SendUdpTo

    Parameters Socket&,IP$,Port&,DATA$
    Declare Error& ,Addr#
    dim Addr#,SOCKADDR_IN
    Addr#.sin_family% = %AF_INET
    Addr#.sin_port% = htons(Port&)
    Addr#.sin_addr& = inet_addr(addr(IP$))
    Error& = w32_sendto(Socket&,addr(DATA$),len(DATA$),0,addr(Addr#),Sizeof(Addr#))
    Dispose Addr#
    Return Error&

ENDPROC

' -----------------------------------------------------------------------------------------

PROC CreateSocketUDP

    Declare socket&
    socket& = socket(%AF_INET,%SOCK_DGRAM,0)
    Return socket&

ENDPROC

' -----------------------------------------------------------------------------------------

PROC recfrom     ' Funtioniert with TCP and UDP  fetch arriving data

    Parameters Socket&
    Declare Pointer& ,Error&,data$,Buffer#
    Dim buffer#,2048  ' possible can whom buffer yet raise have not yet tested how far it free from problems goes
    Pointer& = addr(IP_Addr_Inc#)
    Error& = w32_recvfrom(Socket&,buffer#,Sizeof(buffer#),0,addr(IP_Addr_Inc#),addr(pointer&))
    data$  = String$(Buffer#,0)

    IF Error& > 0

        data$ = Char$(Buffer#,0,Error&)

    ENDIF

    IF Error& = -1

        Dispose Buffer#
        Return Error&

    ENDIF

    Dispose Buffer#
    Return data$

ENDPROC

' -----------------------------------------------------------------------------------------

PROC rec    ' Funtioniert with TCP fetch arriving data

    Parameters Socket&
    Declare Error&,data$,Buffer#
    Dim buffer#,2048
    Error& = w32_recv(Socket&,buffer#,Sizeof(buffer#),0)

    IF Error& > 0

        data$ = Char$(Buffer#,0,Error&)

    ENDIF

    Dispose Buffer#
    Return data$

ENDPROC

' -----------------------------------------------------------------------------------------
' sends data a Socket the before joined watts

Proc SendTCP

    Parameters Socket&,DATA$
    Declare Error& ,Addr#
    Error& = w32_send(Socket&,Addr(DATA$),len(DATA$),0)
    Dispose Addr#
    Return Error&

ENDPROC

' -----------------------------------------------------------------------------------------
' Ermitelt whom Computernamen (Hostnamen) of their own Rechners

PROC GetComputerName

    Declare Rechnername#,name$
    Dim Rechnername#,1024 ' wisely not How long so one Computername his must be therefore at number sure gone with 1024 Bytes
    w32_gethostname(Rechnername#,1024)
    name$ = String$(Rechnername#,0)
    Dispose Rechnername#
    Return name$

ENDPROC

' -----------------------------------------------------------------------------------------

PROC CloseWinsocks   ' be I do not sure whether too so any Sockets closed go

    Declare Error&
    Dispose IP_Addr_Inc# ' if one at number sure weg wants ought to one any sockets with the routine CloseSocketx
    Error& = WSACleanup()         ' particular slept
    Return Error&

ENDPROC

' -----------------------------------------------------------------------------------------

Proc HostToIP   ' determined The IP of a Hostnamen

    Parameters Hostname$,x&
    Declare Addr&,Addr2&,IP$
    Addr2& = gethostbyname(Addr(Hostname$))

    If Addr2& > 0

        addr& = @long(Addr2&,12)
        addr& = @long(Addr&,0)
        addr& = @long(Addr&,((x&-1)*4)) ' Ermittelte with my computer the has several IPs The first IP @long(Addr&,0),
        ' the second IP @long(Addr&,4),The dritte IP @long(Addr&,8)
        Addr2& = w32_inet_ntoa(addr&)

        If Addr2& > 0

            IP$ = String$(Addr2&,0)

        EndIf

    EndIf

    Return IP$

ENDPROC

' -----------------------------------------------------------------------------------------

PROC CloseSocketx    ' close a Socket if Socket closed go could is

    Parameters Socket&   ' Error& = 0 with a Error -1
    Declare Error&
    Error& = closesocket(Socket&)
    Return Error&

ENDPROC

' -----------------------------------------------------------------------------------------
' -----------------------------------------------------------------------------------------

$I Winsocks.inc
Declare data1$,data2$,IP$,IP_inc$,Host_Name$,time$
Declare socket_TCP_Server&, socket_TCP_Client&, w_Param&, l_Param&, socket_TCP_Temp&
Declare a1&,a2&,end%




CLS                                              'before one a Socket as Threat walk can must one one Window opened may have too one Unsichtbares Window his
USERMESSAGES 5000,5001                           'Definiert Own User Messages
Print " C position link to that Server Program since"
Print " t sends actually computer Time to that Server"
Print " g fetch data of Socket if time a Message not arrive ought to"
Print " X exits the program"

Init 1,1                                         'Initialisiert Winsocks 1.1
print "Winsocks Init with 0 OK          : ";@&(0)

CreateSocketTcp                                  'position a Socket since
print "Server Socket Nr.               : ";@&(0)
socket_TCP_Server& = @&(0)                       'Socket whom others Clients konntaktieren can
InitTCP socket_TCP_Server&,80,5000,%hWnd         'Socket becomes as Threat initialized and wait on thorough connections

CreateSocketTcp
print "Client Socket Nr.               : ";@&(0)
socket_TCP_Client& = @&(0)                       'Socket the one with others Server konntaktieren can

SocketToThreatTcp socket_TCP_Client&,5001,%hWnd  'Socket becomes as Threat launched so blockiet the socket not many command/ if these Proc Error (0 is OK ,everything else Error) supply Please
print "Client Socket to Threat with 0 OK:";@&(0)  'The reihenfolge the Parameter in the Winsoks.inc to check on have as a dreher in Proc SocketToThreatTcp
                                                 'incorrect   Error& = w32_WSAAsyncSelect(Socket&,Message&,FensterHandle&, 1 )  reihenfolge
                                                 'Right thing  Error& = w32_WSAAsyncSelect(Socket&,FensterHandle&,Message&, 1)   reihenfolge
GetComputerName                              'Ermitelt whom own Computernamen
Host_Name$ = @$(0)
print "Computername: ";Host_Name$
HostToIP Host_Name$,1                       'ermitelt The first IP the computers
print @$(0)
HostToIP Host_Name$,2                       'ermitelt the second IP the computers (if present)
print @$(0)
HostToIP Host_Name$,3                       'ermitelt The dritte IP the computers (if present)
print @$(0)                                 'unfortunately wisely I not yet How one The gesammt Number of vorhandenen IP Adressen ermiteln can
                                            'if one More IP Adressen attempts auszulesen as present get one Adressen supplied The it none gives

WhileNot end%                               'Beginn Hauptschleife
WAITINPUT
w_Param& = &wParam                           '&wParam becomes in Variable transfer because to mehrmaliger request of &wParam and &lParam I üngültige values get have could his the in the zwieschenzeit einlaufende Messages tappt im dunkeln change
l_Param& = &lParam                           'In w_Param& standing The Socket number and &lParam The number the Codes z.B 8 for Acceptierte thorough link or 32 for Close

 IF %UMessage = 5000                         'Message of Server Socket if data eintrefen

    IF  l_Param& = 1                         '1  FD_READ data on Socket to that reading eingetroffen
    recfrom w_Param&                         '   reads data of Socket the in w_Param& standing
    data1$ =  @$(0)                          '   data from the Socket go into Variable data1$ copies
    getIP
    print @$(0)
    print data1$
    ENDIF


    IF  l_Param& = 2                         '2  FD_WRITE_BIT becomes gesendet if at Send a Socket one Error aufgetreten is
                                             'so becomes signals the on the Socket again moreover gesendet go can. In w_Param& standing The Socket number the betrefenden Sockets.
    ENDIF

    IF  l_Param& = 8                         'ACCEPT one Client has a link adopted (the Socket the Clients has a link aufgebaut to that Socket the Server Program,the Socket becomes automatically erstelt and from the Proc GetConnectSocket its number zurückgeliefert)

    Clear IP_Addr_Inc#                       'the area the The IP take becomes in Proc GetConnectSocket becomes as a precaution geleert
    GetConnectSocket w_Param&                'supply whom Socket back the The link with a Client adopted has
    socket_TCP_Temp& = @&(0)                 'can only one Client Socket take in should More Clients at the same time active his
                                             'must erweiterte routine this manage

    getIP                                    'IP the Sockets the The link adopted has
    IP_inc$ = @$(0)                          'with several connections ought to The IP with the dzu gehörenden Socketnummer ensured and be manages
                                             'there with TCP The IP not gesendet and is so to the recfrom not read go can

    SocketToThreatTcp socket_TCP_Temp&,%hWnd,5001    'the Socket the The link adopted has becomes veranlast in the background
                                                     'on thorough data To Waiting and with thorough data The defined Message To Send
    print "IP: ";IP_inc$;" has link adopted over Socket:";socket_TCP_Temp&
    ENDIF

    IF  l_Param& = 32                        'CLOSE schliest whom Socket the The Message gesendet has
    CloseSocketx w_Param&                    'The number the Sockets lying in w_Param&
    print "Socket Close x :";w_Param&
    ENDIF
 ENDIF

 IF %UMessage = 5001                         'Message of Sockets if data eintrefen

 IF  l_Param& = 1                            '1  FD_READ data on Socket to that reading eingetroffen
 recfrom w_Param&                            'reads data of Socket the in w_Param& standing
 data1$ =  @$(0)                             'data from the Socket go into Variable data1$ copies
 getIP
 print @$(0)
 print data1$
 ENDIF

 IF  l_Param& = 2                         '2  FD_WRITE_BIT becomes gesendet if at Send a Socket one Error aufgetreten is
 Print Socket Ready for Write           'so becomes signals the on the Socket again moreover gesendet go can. In w_Param& standing The Socket number the betrefenden Sockets.
 
 ENDIF

 ENDIF

 IF %key = 88                               ' X Button exits the program and schliest The self erstellten Socket
 CloseSocketx socket_TCP_Server&            ' should some Clients some Sockets opened having must tappt im dunkeln yet extra closed go
 print @&(0)
 CloseSocketx socket_TCP_Client&
 print @&(0)
 CloseSocketx socket_TCP_Temp&
 print @&(0)
 CloseWinsocks                              ' Schliest Winsocks
 print @&(0)
 end% = 1
 Endif

 IF %key = 67                                        ' C Button position a link with a Server since
 sleep 300
 ConnectTcpTo 80,"192.168.2.34",socket_TCP_Client&   ' supply Error (-1) because Socket as task runs
 print @&(0)
                                                 
 
 ENDIF

 IF  %key = 116                               '  t Button
 time$ = @time$(0)+@time$(1)
 print time$
 sendTCP socket_TCP_Client&,time$
 
 ENDIF

IF  %key = 103                                 ' g Button
    recfrom socket_TCP_Temp&                   ' reads data of Socket the in socket_TCP_Temp& standing
    data1$ =  @$(0)                            ' data from the Socket go into Variable data1$ copies
    getIP
    print @$(0)
    print data1$
 ENDIF

endwhile                                        ' end Hauptschleife
print "PROGRAMM STOP"

Sleep 1000