XProfan

' Winsocks.inc
' -----------------------------------------------------------------------------------------
' Winsocks XProfan Include Vers. 0.02
' Autor Andreas Gaida
' qui Include Dossier hat avec Sicherheit encore Reichlich faute Sollte mais im Groben marcher
' quoi je mais pas Versprechen peux .
' cela Benutzen qui Include Dossier ou bien en Prozeduren geschieht sur eigene péril
' -----------------------------------------------------------------------------------------
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 sélectionner(5) !wsock32,sélectionner
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,listen
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 dans6_addr =  uint8_t%,s6_addr#(16)                                ' Pour qui Neuen 16 Byte Adressen
STRUCT sockadd_in6 =  sin6_family%,sin6_port%,sin6_flowinfo%,dans6_addr   ' ka si cela richtig mise en œuvre wurde
Déclarer IP_Addr_Inc#,l_Param&,w_Param&
Déclarer ENDE&
Faible     IP_Addr_Inc#,16
' -----------------------------------------------------------------------------------------
' cet Proc Initialisiert cela Winsocks; comme paramètre nécessaire vous qui Winsocks Version
' qui verwendet volonté soll z.B  1.1  Init 1,1 ou bien 2.0  Init 2,0  ou bien 2,2  Init 2,2
' muss toujours comme erstes fonctionnement volonté

PROC Init

    Paramètres a&,b&
    Déclarer Error&,WSAData#
    Def MakeWord(2) ((%(1) & $ff) | ((%(2) & $ff)) << 8)
    Faible  WSAData#,WSADATA
    Error& = WSAStartup(MAKEWORD(a&,b&),WSAData#)

    IF Error& <> 0

        MessageBox "!!! WSocks32 konnte pas gestartet volonté !!! Error Code: "+@Str$(Error&),"annonce...",0

    ENDIF

    Dispose WSAData#
    Retour Error&

ENDPROC

' -----------------------------------------------------------------------------------------
' cet Proc Initialisiert une TCP Socket qui seulement sur eingehende Verbindungen wartet
' sur dem son übergebenen Port.chez eingehenden liaison sendet es qui übergebene Message
' à cela übergebene la fenêtre z.B Socket: Socket&, Port: 6969 , Message: $2700 , la fenêtre: %hWnd

PROC InitTCP

    Paramètres socketconnect&,Port&,Messagenr&,FensterHandle&
    Déclarer Addr# ,IP$,Error&,backlog&
    Faible Addr#,SOCKADDR_IN
    socketconnect& = socket(%AF_INET,%SOCK_STREAM,0)
    Imprimer  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 konnte pas attaché volonté !!! Error Code: "+@Str$(Error&),"annonce...",0

    ENDIF

    ' Error& = w32_WSAAsyncSelect(socketconnect&,FensterHandle&,Messagenr&, 1 | 2 | 4 | 8 | 16 | 32 ) ' cet variante encore pas 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 konnte pas fonctionnement volonté !!! Error Code: "+@Str$(Error&),"annonce...",0

    ENDIF

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

    IF Error& <> 0

        MessageBox "!!! Listen konnte pas fonctionnement volonté !!! Error Code: "+@Str$(Error&),"annonce...",0

    ENDIF

    Dispose Addr#
    Retour socketconnect&

ENDPROC

' -----------------------------------------------------------------------------------------
' -----------------------------------------------------------------------------------------
' cet Proc liefert qui numéro des Sockets qui une eingehende liaison aufgenommen hat

PROC GetConnectSocket

    Paramètres socketconnect&
    Déclarer Pointer& ,socketnr&
    Pointer& = addr(IP_Addr_Inc#)
    socketnr& = w32_accept(socketconnect&,IP_Addr_Inc#,addr(Pointer&))
    Retour socketnr&

ENDPROC

' -----------------------------------------------------------------------------------------
' cet Proc Gibt qui Adresse IP des Senders einer TCP nouvelle(données) ou bien chez une
' Verbindungsaufbau à(chez TCP seulement chez Connect et chez UDP chez jeden données Packet)

PROC GetIP

    Paramètres
    Déclarer 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))
    Retour IPinc$

ENDPROC

' -----------------------------------------------------------------------------------------
' Stellt une liaison her par une Socket

PROC ConnectTcpTo

    Paramètres Port&,IP$,Socket&
    Déclarer Error& ,Addr#
    Faible 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#
    Retour Error&

ENDPROC

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

PROC CreateSocketTcp

    Déclarer socket&
    socket& = socket(%AF_INET,%SOCK_STREAM,0)
    Retour socket&

ENDPROC

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

PROC SocketToThreat ' Funtioniert seulement avec UPD ,zumindest habe je es encore avec TCP pas à l' courir gebracht

    Paramètres Socket&,Message&,FensterHandle&,Port&
    Déclarer Error& ,Addr#,Remote$,backlog&
    Remote$ = "0192.168.0.3"
    Faible 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 konnte pas fonctionnement volonté !!! Error Code: "+@Str$(Error&),"annonce...",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#
    Retour Error&

ENDPROC

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

PROC SocketToThreatTcp  ' Funtioniert avec TCP

    Paramètres Socket&,Message&,FensterHandle&
    Déclarer 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
    Retour Error&

ENDPROC

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

PROC SendUdpTo

    Paramètres Socket&,IP$,Port&,DATA$
    Déclarer 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#
    Retour Error&

ENDPROC

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

PROC CreateSocketUDP

    Déclarer socket&
    socket& = socket(%AF_INET,%SOCK_DGRAM,0)
    Retour socket&

ENDPROC

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

PROC recfrom     ' Funtioniert avec TCP et UDP  Holt ankommende données

    Paramètres Socket&
    Déclarer Pointer& ,Error&,data$,Buffer#
    Faible buffer#,2048  ' Eventuell peux on den buffer encore erhöhen habe encore pas getestet comment large es Problemlos allez
    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#
        Retour Error&

    ENDIF

    Dispose Buffer#
    Retour data$

ENDPROC

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

PROC rec    ' Funtioniert avec TCP Holt ankommende données

    Paramètres Socket&
    Déclarer Error&,data$,Buffer#
    Faible buffer#,2048
    Error& = w32_recv(Socket&,buffer#,Sizeof(buffer#),0)

    IF Error& > 0

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

    ENDIF

    Dispose Buffer#
    Retour data$

ENDPROC

' -----------------------------------------------------------------------------------------
' Sendet données sur une Socket qui auparavant verbunden wurde

Proc SendTCP

    Paramètres Socket&,DATA$
    Déclarer Error& ,Addr#
    Error& = w32_send(Socket&,Addr(DATA$),len(DATA$),0)
    Dispose Addr#
    Retour Error&

ENDPROC

' -----------------------------------------------------------------------------------------
' Ermitelt den Computernamen (Hostnamen) des eigenen Rechners

PROC GetComputerName

    Déclarer Rechnername#,nom$
    Faible Rechnername#,1024 ' Weis pas comment long so un Computername son darf suis c'est pourquoi sur numéro sûrement gegangen avec 1024 Bytes
    w32_gethostname(Rechnername#,1024)
    nom$ = String$(Rechnername#,0)
    Dispose Rechnername#
    Retour nom$

ENDPROC

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

PROC CloseWinsocks   ' suis Je ne sûrement si aussi avec cela alle Sockets geschlossen volonté

    Déclarer Error&
    Dispose IP_Addr_Inc# ' si on sur numéro sûrement aller veux sollte on alle sockets avec qui Routine CloseSocketx
    Error& = WSACleanup()         ' einzeln schliesen
    Retour Error&

ENDPROC

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

Proc HostToIP   ' Ermittelt qui IP de une Hostnamen

    Paramètres Hostname$,x&
    Déclarer Addr&,Addr2&,IP$
    Addr2& = gethostbyname(Addr(Hostname$))

    Si Addr2& > 0

        addr& = @long(Addr2&,12)
        addr& = @long(Addr&,0)
        addr& = @long(Addr&,((x&-1)*4)) ' Ermittelte chez meinen ordinateur qui hat plusieurs IPs la première IP @long(Addr&,0),
        ' qui zweite IP @long(Addr&,4),la troisième IP @long(Addr&,8)
        Addr2& = w32_inet_ntoa(addr&)

        Si Addr2& > 0

            IP$ = String$(Addr2&,0)

        EndIf

    EndIf

    Retour IP$

ENDPROC

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

PROC CloseSocketx    ' Schliesst une Socket si Socket geschlossen volonté konnte ist

    Paramètres Socket&   ' Error& = 0 chez une faute -1
    Déclarer Error&
    Error& = closesocket(Socket&)
    Retour Error&

ENDPROC

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

$I Winsocks.inc
Déclarer data1$,data2$,IP$,IP_inc$,Host_Name$,zeit$
Déclarer socket_TCP_Server&, socket_TCP_Client&, w_Param&, l_Param&, socket_TCP_Temp&
Déclarer a1&,a2&,Ende%




CLS                                              'Bevor on une Socket comme Threat courir peut muss on un la fenêtre ouvert avons peux aussi un Unsichtbares la fenêtre son
USERMESSAGES 5000,5001                           'défini eigene Usermessages
Imprimer " C Stellt liaison zum Server Programme her"
Imprimer " t Sendet aktuelle calculateur Zeit zum Server"
Imprimer " g holt données vom Socket si la fois une Message pas arriver sollte"
Imprimer " X finissez cela Programme"

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

CreateSocketTcp                                  'Stellt une Socket her
imprimer "Server Socket Nr.               : ";@&(0)
socket_TCP_Server& = @&(0)                       'Socket den autre Clients konntaktieren peut
InitTCP socket_TCP_Server&,80,5000,%hWnd         'Socket wird comme Threat initialisiert et wartet sur eingehende Verbindungen

CreateSocketTcp
imprimer "Client Socket Nr.               : ";@&(0)
socket_TCP_Client& = @&(0)                       'Socket avec dem on autre Server konntaktieren peux

SocketToThreatTcp socket_TCP_Client&,5001,%hWnd  'Socket wird comme Threat gestartet so blockiet qui socket pas chez vielen befehlen/ si cet Proc Error (0 ist Ok ,alles autre Error) liefert s'il te plaît
imprimer "Client Socket to Threat chez 0 OK:";@&(0)  'qui reihenfolge qui paramètre dans qui Winsoks.inc überprüfen habe là une dreher dans qui Proc SocketToThreatTcp
                                                 'Falsche   Error& = w32_WSAAsyncSelect(Socket&,Message&,FensterHandle&, 1 )  reihenfolge
                                                 'Richtige  Error& = w32_WSAAsyncSelect(Socket&,FensterHandle&,Message&, 1)   reihenfolge
GetComputerName                              'Ermitelt den eigenen Computernamen
Host_Name$ = @$(0)
imprimer "Computername: ";Host_Name$
HostToIP Host_Name$,1                       'ermitelt la première IP des Computers
imprimer @$(0)
HostToIP Host_Name$,2                       'ermitelt qui zweite IP des Computers (si vorhanden)
imprimer @$(0)
HostToIP Host_Name$,3                       'ermitelt la troisième IP des Computers (si vorhanden)
imprimer @$(0)                                 'malheureusement weis je encore pas comment on qui gesammt Nombre de vorhandenen IP Adressen ermiteln peux
                                            'si on plus IP Adressen versucht auszulesen comme vorhanden bekommt on Adressen geliefert qui es gar pas gibt

WhileNot Ende%                               'Beginn Hauptschleife
WAITINPUT
w_Param& = &wParam                           '&wParam wird dans Variable übertragen weil pour mehrmaliger Abfrage de &wParam et &lParam je üngültige werte bekommen habe pourrait son cela dans qui zwieschenzeit einlaufende Messages vous verändern
l_Param& = &lParam                           'dans w_Param& Steht qui Socket numéro et dans &lParam qui numéro des Codes z.B 8 pour Acceptierte eingehende liaison ou bien 32 pour Fermer

 IF %UMessage = 5000                         'Message vom Server Socket si données eintrefen

    IF  l_Param& = 1                         '1  FD_READ données sur Socket zum lesen eingetroffen
    recfrom w_Param&                         '   liest données vom Socket qui dans w_Param& steht
    data1$ =  @$(0)                          '   données de dem Socket volonté dans qui Variable data1$ kopiert
    getIP
    imprimer @$(0)
    imprimer data1$
    ENDIF


    IF  l_Param& = 2                         '2  FD_WRITE_BIT wird gesendet si beim senden sur une Socket un faute aufgetreten ist
                                             'avec cela wird signalisiert cela sur dem Socket wieder plus gesendet volonté peux. dans w_Param& steht qui Socket numéro des betrefenden Sockets.
    ENDIF

    IF  l_Param& = 8                         'ACCEPT un Client hat une liaison aufgenommen (qui Socket des Clients hat une liaison aufgebaut zum Socket des Server Programms,qui Socket wird automatisch erstelt et de qui Proc GetConnectSocket sa numéro zurückgeliefert)

    Claire IP_Addr_Inc#                       'qui Bereich qui qui IP prendre wird dans qui Proc GetConnectSocket wird sicherheitshalber geleert
    GetConnectSocket w_Param&                'liefert den Socket zurück qui qui liaison avec une Client aufgenommen hat
    socket_TCP_Temp& = @&(0)                 'peux seulement un Client Socket aufnehmen devoir plus Clients Gleichzeitig aktiv son
                                             'muss une Avancé Routine ca verwalten

    getIP                                    'IP des Sockets qui qui liaison aufgenommen hat
    IP_inc$ = @$(0)                          'chez mehreren Verbindungen sollte qui IP avec dem dzu gehörenden Socketnummer gesichert volonté et verwaltet
                                             'là chez TCP qui IP pas avec gesendet wird et so pour dem recfrom pas ausgelesen volonté peux

    SocketToThreatTcp socket_TCP_Temp&,%hWnd,5001    'qui Socket qui qui liaison aufgenommen hat wird veranlast im hintergrund
                                                     'sur eingehende données trop attendre et chez eingehenden données qui Definierte Message trop senden
    imprimer "IP: ";IP_inc$;" hat liaison aufgenommen sur Socket:";socket_TCP_Temp&
    ENDIF

    IF  l_Param& = 32                        'CLOSE schliest den Socket qui qui Message gesendet hat
    CloseSocketx w_Param&                    'qui numéro des Sockets liegt dans w_Param&
    imprimer "Socket Fermer x :";w_Param&
    ENDIF
 ENDIF

 IF %UMessage = 5001                         'Message vom Sockets si données eintrefen

 IF  l_Param& = 1                            '1  FD_READ données sur Socket zum lesen eingetroffen
 recfrom w_Param&                            'liest données vom Socket qui dans w_Param& steht
 data1$ =  @$(0)                             'données de dem Socket volonté dans qui Variable data1$ kopiert
 getIP
 imprimer @$(0)
 imprimer data1$
 ENDIF

 IF  l_Param& = 2                         '2  FD_WRITE_BIT wird gesendet si beim senden sur une Socket un faute aufgetreten ist
 Imprimer Socket Ready for Write           'avec cela wird signalisiert cela sur dem Socket wieder plus gesendet volonté peux. dans w_Param& steht qui Socket numéro des betrefenden Sockets.
 
 ENDIF

 ENDIF

 IF %clé = 88                               ' X bouton finissez cela Programme et schliest qui selbst erstellten Socket
 CloseSocketx socket_TCP_Server&            ' Sollten quelques Clients quelques Sockets ouvert avons doit vous encore extra geschlossen volonté
 imprimer @&(0)
 CloseSocketx socket_TCP_Client&
 imprimer @&(0)
 CloseSocketx socket_TCP_Temp&
 imprimer @&(0)
 CloseWinsocks                              ' Schliest Winsocks
 imprimer @&(0)
 Ende% = 1
 Endif

 IF %clé = 67                                        ' C bouton Stellt une liaison avec une Server her
 sleep 300
 ConnectTcpTo 80,"192.168.2.34",socket_TCP_Client&   ' Liefert Error (-1) weil Socket comme Task fonctionne
 imprimer @&(0)
                                                 
 
 ENDIF

 IF  %clé = 116                               '  t bouton
 zeit$ = @Time$(0)+@Time$(1)
 imprimer zeit$
 sendTCP socket_TCP_Client&,zeit$
 
 ENDIF

IF  %clé = 103                                 ' g bouton
    recfrom socket_TCP_Temp&                   ' liest données vom Socket qui dans socket_TCP_Temp& steht
    data1$ =  @$(0)                            ' données de dem Socket volonté dans qui Variable data1$ kopiert
    getIP
    imprimer @$(0)
    imprimer data1$
 ENDIF

endwhile                                        ' Ende Hauptschleife
imprimer "PROGRAMM STOP"

Sleep 1000