XProfan

' Winsocks.inc
' -----------------------------------------------------------------------------------------
' Winsocks XProfan Include Vers. 0.02
' Autor Andreas Gaida
' Die Include File hat mit Sicherheit noch Reichlich Fehler Sollte aber im Groben Funktionieren
' Was ich aber nicht Versprechen kann .
' Das Benutzen der Include File oder deren Prozeduren geschieht auf eigene Gefahr
' -----------------------------------------------------------------------------------------
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,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 in6_addr =  uint8_t%,s6_addr#(16)                                ' Für die Neuen 16 Byte Adressen
STRUCT sockadd_in6 =  sin6_family%,sin6_port%,sin6_flowinfo%,in6_addr   ' ka ob das richtig umgesetzt wurde
Declare IP_Addr_Inc#,l_Param&,w_Param&
Declare ENDE&
Dim     IP_Addr_Inc#,16
' -----------------------------------------------------------------------------------------
' Diese Proc Initialisiert das Winsocks; als Parameter necessario sie die Winsocks Version
' die verwendet werden soll z.B  1.1  Init 1,1 oder 2.0  Init 2,0  oder 2,2  Init 2,2
' muss immer als erstes corsa werden

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 konnte nicht gestartet werden !!! Error Code: "+@Str$(Error&),"Meldung...",0

    ENDIF

    Dispose WSAData#
    Return Error&

ENDPROC

' -----------------------------------------------------------------------------------------
' Diese Proc Initialisiert einen TCP Socket der nur auf eingehende Verbindungen wartet
' auf dem ihr übergebenen Port.Bei eingehenden verbindung sendet es die übergebene Message
' an das übergebene Fenster z.B Socket: Socket&, Port: 6969 , Message: $2700 , Fenster: %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 konnte nicht Gebunden werden !!! Error Code: "+@Str$(Error&),"Meldung...",0

    ENDIF

    ' Error& = w32_WSAAsyncSelect(socketconnect&,FensterHandle&,Messagenr&, 1 | 2 | 4 | 8 | 16 | 32 ) ' diese Variante noch nicht 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 nicht corsa werden !!! Error Code: "+@Str$(Error&),"Meldung...",0

    ENDIF

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

    IF Error& <> 0

        MessageBox "!!! Listen konnte nicht corsa werden !!! Error Code: "+@Str$(Error&),"Meldung...",0

    ENDIF

    Dispose Addr#
    Return socketconnect&

ENDPROC

' -----------------------------------------------------------------------------------------
' -----------------------------------------------------------------------------------------
' Diese Proc liefert die Nummer des Sockets der eine eingehende Verbindung aufgenommen hat

PROC GetConnectSocket

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

ENDPROC

' -----------------------------------------------------------------------------------------
' Diese Proc Gibt die Adresse IP des Senders einer TCP Nachricht(Daten) oder bei einen
' Verbindungsaufbau an(Bei TCP nur bei Connect und bei UDP bei jeden Daten Packet)

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

' -----------------------------------------------------------------------------------------
' Stellt eine verbindung her durch einen 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 nur mit UPD ,zumindest habe ich es noch mit TCP nicht ans laufen gebracht

    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 konnte nicht corsa werden !!! Error Code: "+@Str$(Error&),"Meldung...",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 mit 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 mit TCP und UDP  Holt ankommende Daten

    Parameters Socket&
    Declare Pointer& ,Error&,data$,Buffer#
    Dim buffer#,2048  ' Eventuell kann man den buffer noch erhöhen habe noch nicht getestet wie weit es Problemlos geht
    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 mit TCP Holt ankommende Daten

    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

' -----------------------------------------------------------------------------------------
' Sendet Daten circa einen Socket der vorher verbunden wurde

Proc SendTCP

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

ENDPROC

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

PROC GetComputerName

    Declare Rechnername#,Name$
    Dim Rechnername#,1024 ' Weis nicht Wie lang so ein Computername sein darf bin deshalb auf nummer sicher gegangen mit 1024 Bytes
    w32_gethostname(Rechnername#,1024)
    Name$ = String$(Rechnername#,0)
    Dispose Rechnername#
    Return Name$

ENDPROC

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

PROC CloseWinsocks   ' Bin mir nicht sicher ob auch damit alle Sockets geschlossen werden

    Declare Error&
    Dispose IP_Addr_Inc# ' wenn man auf nummer sicher gehen will sollte man alle sockets mit der Routine CloseSocketx
    Error& = WSACleanup()         ' einzeln schliesen
    Return Error&

ENDPROC

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

Proc HostToIP   ' Ermittelt die IP von einen 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 Bei meinen Computer der hat mehrere IPs die erste IP @long(Addr&,0),
        ' die zweite IP @long(Addr&,4),die dritte IP @long(Addr&,8)
        Addr2& = w32_inet_ntoa(addr&)

        If Addr2& > 0

            IP$ = String$(Addr2&,0)

        EndIf

    EndIf

    Return IP$

EndProc

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

PROC CloseSocketx    ' Schliesst einen Socket wenn Socket geschlossen werden konnte ist

    Parameters Socket&   ' Error& = 0 bei einen Fehler -1
    Declare Error&
    Error& = closesocket(Socket&)
    Return Error&

ENDPROC

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

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




CLS                                              'Bevor man einen Socket als Threat laufen lässt muss man ein Fenster geöffnet haben kann auch ein Unsichtbares Fenster sein
USERMESSAGES 5000,5001                           'Definiert eigene Usermessages
Print " C Stellt Verbindung zum Server Programm her"
Print " t Sendet aktuelle Rechner Zeit zum Server"
Print " g holt Daten vom Socket wenn mal eine Message nicht ankommen sollte"
Print " X Beendet das Programm"

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

CreateSocketTcp                                  'Stellt einen Socket her
print "Server Socket Nr.               : ";@&(0)
socket_TCP_Server& = @&(0)                       'Socket den andere Clients konntaktieren können
InitTCP socket_TCP_Server&,80,5000,%hWnd         'Socket wird als Threat initialisiert und wartet auf eingehende Verbindungen

CreateSocketTcp
print "Client Socket Nr.               : ";@&(0)
socket_TCP_Client& = @&(0)                       'Socket mit dem man andere Server konntaktieren kann

SocketToThreatTcp socket_TCP_Client&,5001,%hWnd  'Socket wird als Threat gestartet so blockiet der socket nicht bei vielen befehlen/ wenn diese Proc Error (0 ist Ok ,alles andere Error) liefert bitte
print "Client Socket to Threat bei 0 OK:";@&(0)  'die reihenfolge der Parameter in der Winsoks.inc überprüfen habe da einen dreher in der 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)
print "Computername: ";Host_Name$
HostToIP Host_Name$,1                       'ermitelt die erste IP des Computers
print @$(0)
HostToIP Host_Name$,2                       'ermitelt die zweite IP des Computers (falls vorhanden)
print @$(0)
HostToIP Host_Name$,3                       'ermitelt die dritte IP des Computers (falls vorhanden)
print @$(0)                                 'Leider weis ich noch nicht wie man die gesammt Anzahl der vorhandenen IP Adressen ermiteln kann
                                            'wenn man mehr IP Adressen versucht auszulesen als vorhanden bekommt man Adressen geliefert die es gar nicht gibt

WhileNot Ende%                               'Beginn Hauptschleife
WAITINPUT
w_Param& = &wParam                           '&wParam wird in Variable übertragen weil nach mehrmaliger Abfrage von &wParam und &lParam ich üngültige werte bekommen habe potuto sein das in der zwieschenzeit einlaufende Messages sie verändern
l_Param& = &lParam                           'In w_Param& Steht die Socket Nummer und in &lParam die Nummer des Codes z.B 8 per Acceptierte eingehende Verbindung oder 32 per Close

 IF %UMessage = 5000                         'Message vom Server Socket wenn Daten eintrefen

    IF  l_Param& = 1                         '1  FD_READ Daten auf Socket zum lesen eingetroffen
    recfrom w_Param&                         '   liest Daten vom Socket der in w_Param& steht
    data1$ =  @$(0)                          '   Daten von dem Socket werden in die Variable data1$ kopiert
    getIP
    print @$(0)
    print data1$
    ENDIF


    IF  l_Param& = 2                         '2  FD_WRITE_BIT wird gesendet wenn beim senden circa einen Socket ein Fehler aufgetreten ist
                                             'damit wird signalisiert das auf dem Socket wieder weiter gesendet werden kann. In w_Param& steht die Socket Nummer des betrefenden Sockets.
    ENDIF

    IF  l_Param& = 8                         'ACCEPT ein Client hat eine Verbindung aufgenommen (der Socket des Clients hat eine verbindung aufgebaut zum Socket des Server Programms,der Socket wird automatisch erstelt und von der Proc GetConnectSocket seine Nummer zurückgeliefert)

    Clear IP_Addr_Inc#                       'der Bereich der die IP übernehmen wird in der Proc GetConnectSocket wird sicherheitshalber geleert
    GetConnectSocket w_Param&                'liefert den Socket zurück der die verbindung mit einen Client aufgenommen hat
    socket_TCP_Temp& = @&(0)                 'kann nur ein Client Socket aufnehmen sollen mehr Clients Gleichzeitig aktiv sein
                                             'muss eine erweiterte Routine dies verwalten

    getIP                                    'IP des Sockets der die Verbindung aufgenommen hat
    IP_inc$ = @$(0)                          'bei mehreren Verbindungen sollte die IP mit dem dzu gehörenden Socketnummer gesichert werden und verwaltet
                                             'da bei TCP die IP nicht mit gesendet wird und so nach dem recfrom nicht ausgelesen werden kann

    SocketToThreatTcp socket_TCP_Temp&,%hWnd,5001    'der Socket der die verbindung aufgenommen hat wird veranlast im hintergrund
                                                     'auf eingehende Daten zu warten und bei eingehenden Daten die Definierte Message zu senden
    print "IP: ";IP_inc$;" hat Verbindung aufgenommen circa Socket:";socket_TCP_Temp&
    ENDIF

    IF  l_Param& = 32                        'CLOSE schliest den Socket der die Message gesendet hat
    CloseSocketx w_Param&                    'Die Nummer des Sockets liegt in w_Param&
    print "Socket Close x :";w_Param&
    ENDIF
 ENDIF

 IF %UMessage = 5001                         'Message vom Sockets wenn Daten eintrefen

 IF  l_Param& = 1                            '1  FD_READ Daten auf Socket zum lesen eingetroffen
 recfrom w_Param&                            'liest Daten vom Socket der in w_Param& steht
 data1$ =  @$(0)                             'Daten von dem Socket werden in die Variable data1$ kopiert
 getIP
 print @$(0)
 print data1$
 ENDIF

 IF  l_Param& = 2                         '2  FD_WRITE_BIT wird gesendet wenn beim senden circa einen Socket ein Fehler aufgetreten ist
 Print Socket Ready for Write           'damit wird signalisiert das auf dem Socket wieder weiter gesendet werden kann. In w_Param& steht die Socket Nummer des betrefenden Sockets.
 
 ENDIF

 ENDIF

 IF %key = 88                               ' X Taste Beendet das Programm und schliest die selbst erstellten Socket
 CloseSocketx socket_TCP_Server&            ' Sollten einige Clients einige Sockets geöffnet haben müssen sie noch extra geschlossen werden
 print @&(0)
 CloseSocketx socket_TCP_Client&
 print @&(0)
 CloseSocketx socket_TCP_Temp&
 print @&(0)
 CloseWinsocks                              ' Schliest Winsocks
 print @&(0)
 Ende% = 1
 Endif

 IF %key = 67                                        ' C Taste Stellt eine Verbindung mit einen Server her
 sleep 300
 ConnectTcpTo 80,"192.168.2.34",socket_TCP_Client&   ' Liefert Error (-1) weil Socket als Task corre
 print @&(0)
                                                 
 
 ENDIF

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

IF  %key = 103                                 ' g Taste
    recfrom socket_TCP_Temp&                   ' liest Daten vom Socket der in socket_TCP_Temp& steht
    data1$ =  @$(0)                            ' Daten von dem Socket werden in die Variable data1$ kopiert
    getIP
    print @$(0)
    print data1$
 ENDIF

endwhile                                        ' Ende Hauptschleife
print "PROGRAMM STOP"

Sleep 1000