XProfan

Español

Andreas
Gaida


' Winsocks.inc
' -----------------------------------------------------------------------------------------
' Winsocks XProfan Incluir Vers. 0.02
' Autor Andreas Gaida
' El Incluir Expediente ha con Sicherheit todavía Reichlich Fehler Sollte aber en el Groben Funktionieren
' Was Yo pero no Versprechen kann .
' Das Benutzen el Incluir Expediente oder deren Prozeduren geschieht en propio 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 seleccionar(5) !wsock32,seleccionar
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 en6_addr =  uint8_t%,s6_addr#(16)                                ' Für el Neuen 16 Byte Adressen
STRUCT sockadd_in6 =  sin6_family%,sin6_port%,sin6_flowinfo%,en6_addr   ' ka si el correcto umgesetzt wurde
Declarar IP_Addr_Inc#,l_Param&,w_Param&
Declarar ENDE&
Dim     IP_Addr_Inc#,16
' -----------------------------------------------------------------------------------------
' Diese Proc Initialisiert el Winsocks; como Parámetro benötigt ellos el Winsocks Versión
' el verwendet voluntad se z.B  1.1  Init 1,1 oder 2.0  Init 2,0  oder 2,2  Init 2,2
' muss siempre como erstes ausgeführt voluntad

PROC Init

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

    IF Error& <> 0

        MessageBox "!!! WSocks32 podría no comenzó voluntad !!! Error Code: "+@Str$(Error&),"Meldung...",0

    ENDIF

    Disponer WSAData#
    Volver Error&

ENDPROC

' -----------------------------------------------------------------------------------------
' Diese Proc Initialisiert una TCP Socket el sólo en eingehende Verbindungen wartet
' en el ihr übergebenen Port.En eingehenden verbindung envía lo el übergebene Message
' a el übergebene Ventana z.B Socket: Socket&, Port: 6969 , Message: $2700 , Ventana: %hWnd

PROC InitTCP

    Parámetros socketconnect&,Port&,Messagenr&,FensterHandle&
    Declarar Addr# ,IP$,Error&,backlog&
    Dim Addr#,SOCKADDR_IN
    socketconnect& = socket(%AF_INET,%SOCK_STREAM,0)
    Imprimir  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 podría no Gebunden voluntad !!! Error Code: "+@Str$(Error&),"Meldung...",0

    ENDIF

    ' Error& = w32_WSAAsyncSelect(socketconnect&,FensterHandle&,Messagenr&, 1 | 2 | 4 | 8 | 16 | 32 ) ' esta Variante todavía no 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 podría no ausgeführt voluntad !!! Error Code: "+@Str$(Error&),"Meldung...",0

    ENDIF

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

    IF Error& <> 0

        MessageBox "!!! Listen podría no ausgeführt voluntad !!! Error Code: "+@Str$(Error&),"Meldung...",0

    ENDIF

    Disponer Addr#
    Volver socketconnect&

ENDPROC

' -----------------------------------------------------------------------------------------
' -----------------------------------------------------------------------------------------
' Diese Proc liefert el Nummer des Sockets el una eingehende Verbindung aufgenommen ha

PROC GetConnectSocket

    Parámetros socketconnect&
    Declarar Pointer& ,socketnr&
    Pointer& = addr(IP_Addr_Inc#)
    socketnr& = w32_accept(socketconnect&,IP_Addr_Inc#,addr(Pointer&))
    Volver socketnr&

ENDPROC

' -----------------------------------------------------------------------------------------
' Diese Proc Gibt el Adresse IP des Senders uno TCP Nachricht(Daten) oder en una
' Verbindungsaufbau a(En TCP sólo en Connect y en UDP en cada Daten Packet)

PROC GetIP

    Parámetros
    Declarar 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))
    Volver IPinc$

ENDPROC

' -----------------------------------------------------------------------------------------
' Stellt una verbindung her por una Socket

PROC ConnectTcpTo

    Parámetros Port&,IP$,Socket&
    Declarar 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#))
    Disponer Addr#
    Volver Error&

ENDPROC

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

PROC CreateSocketTcp

    Declarar socket&
    socket& = socket(%AF_INET,%SOCK_STREAM,0)
    Volver socket&

ENDPROC

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

PROC SocketToThreat ' Funtioniert sólo UPD ,zumindest Yo lo todavía con TCP no ans laufen gebracht

    Parámetros Socket&,Message&,FensterHandle&,Port&
    Declarar 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 podría no ausgeführt voluntad !!! 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&))
    Disponer Addr#
    Volver Error&

ENDPROC

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

PROC SocketToThreatTcp  ' Funtioniert con TCP

    Parámetros Socket&,Message&,FensterHandle&
    Declarar 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
    Volver Error&

ENDPROC

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

PROC SendUdpTo

    Parámetros Socket&,IP$,Port&,DATA$
    Declarar 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#))
    Disponer Addr#
    Volver Error&

ENDPROC

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

PROC CreateSocketUDP

    Declarar socket&
    socket& = socket(%AF_INET,%SOCK_DGRAM,0)
    Volver socket&

ENDPROC

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

PROC recfrom     ' Funtioniert con TCP y UDP  Holt ankommende Daten

    Parámetros Socket&
    Declarar Pointer& ,Error&,data$,Buffer#
    Dim buffer#,2048  ' Eventuell puede ser el buffer todavía erhöhen habe todavía no getestet como weit lo Problemlos va
    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

        Disponer Buffer#
        Volver Error&

    ENDIF

    Disponer Buffer#
    Volver data$

ENDPROC

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

PROC rec    ' Funtioniert con TCP Holt ankommende Daten

    Parámetros Socket&
    Declarar Error&,data$,Buffer#
    Dim buffer#,2048
    Error& = w32_recv(Socket&,buffer#,Sizeof(buffer#),0)

    IF Error& > 0

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

    ENDIF

    Disponer Buffer#
    Volver data$

ENDPROC

' -----------------------------------------------------------------------------------------
' Sendet Daten encima una Socket el vorher verbunden wurde

Proc SendTCP

    Parámetros Socket&,DATA$
    Declarar Error& ,Addr#
    Error& = w32_send(Socket&,Addr(DATA$),len(DATA$),0)
    Disponer Addr#
    Volver Error&

ENDPROC

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

PROC GetComputerName

    Declarar Rechnername#,Name$
    Dim Rechnername#,1024 ' Weis no Como lang así una Computername ser darf bin deshalb en nummer sicher gegangen con 1024 Bytes
    w32_gethostname(Rechnername#,1024)
    Name$ = String$(Rechnername#,0)
    Disponer Rechnername#
    Volver Name$

ENDPROC

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

PROC CloseWinsocks   ' Bin No sicher si auch así todos Sockets geschlossen voluntad

    Declarar Error&
    Disponer IP_Addr_Inc# ' si uno en nummer sicher ir voluntad debería uno todos sockets con el Rutina CloseSocketx
    Error& = WSACleanup()         ' einzeln schliesen
    Volver Error&

ENDPROC

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

Proc HostToIP   ' Ermittelt el IP de una Hostnamen

    Parámetros Hostname$,x&
    Declarar 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 En media Computer el ha mehrere IPs el erste IP @long(Addr&,0),
        ' el zweite IP @long(Addr&,4),el dritte IP @long(Addr&,8)
        Addr2& = w32_inet_ntoa(addr&)

        If Addr2& > 0

            IP$ = String$(Addr2&,0)

        EndIf

    EndIf

    Volver IP$

ENDPROC

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

PROC CloseSocketx    ' Schliesst una Socket si Socket geschlossen voluntad podría es

    Parámetros Socket&   ' Error& = 0 en una Fehler -1
    Declarar Error&
    Error& = closesocket(Socket&)
    Volver Error&

ENDPROC

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

Athlon X2 4800 , 2GB Ram , GeForce 7800GT
Windows XP Pro , XProfan 10 und 11 , Profan2Cpp 1.6b

25.06.2006 ▲

Vollständiges Zitat

Absatzweise Cita Zeilenweise Cita

Andreas
Gaida

Kleines Ejemplo Programa para el Winsocks.inc arbeitet como Server y Client
IP Adressen necesario todavía angepast voluntad

Kompilieren Marca Separación


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




CLS                                              'Antes uno una Socket como Threat laufen lässt muss uno una Ventana geöffnet haben kann auch una Unsichtbares Ventana ser
USERMESSAGES 5000,5001                           'Definiert propio Usermessages
Imprimir " C Stellt Verbindung para Server Programa her"
Imprimir " t Sendet aktuelle Rechner Tiempo para Server"
Imprimir " g holt Daten vom Socket si veces una Message no ankommen debería"
Imprimir " X Beendet el Programa"

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

CreateSocketTcp                                  'Stellt una Socket her
imprimir "Server Socket Nr.               : ";@&(0)
socket_TCP_Server& = @&(0)                       'Socket el otro Clients konntaktieren puede
InitTCP socket_TCP_Server&,80,5000,%hWnd         'Socket se como Threat initialisiert y wartet en eingehende Verbindungen

CreateSocketTcp
imprimir "Client Socket Nr.               : ";@&(0)
socket_TCP_Client& = @&(0)                       'Socket con el uno otro Server konntaktieren kann

SocketToThreatTcp socket_TCP_Client&,5001,%hWnd  'Socket se como Threat comenzó así blockiet el socket no en vielen befehlen/ si esta Proc Error (0 es Ok ,alles otro Error) liefert Por favor,
imprimir "Client Socket to Threat en 0 OK:";@&(0)  'el reihenfolge el Parámetro en el Winsoks.inc überprüfen habe como una dreher en el Proc SocketToThreatTcp
                                                 'Falsche   Error& = w32_WSAAsyncSelect(Socket&,Message&,FensterHandle&, 1 )  reihenfolge
                                                 'Richtige  Error& = w32_WSAAsyncSelect(Socket&,FensterHandle&,Message&, 1)   reihenfolge
GetComputerName                              'Ermitelt el eigenen Computernamen
Host_Name$ = @$(0)
imprimir "Computername: ";Host_Name$
HostToIP Host_Name$,1                       'ermitelt el erste IP des Computers
imprimir @$(0)
HostToIP Host_Name$,2                       'ermitelt el zweite IP des Computers (si disponible)
imprimir @$(0)
HostToIP Host_Name$,3                       'ermitelt el dritte IP des Computers (si disponible)
imprimir @$(0)                                 'Leider weis Todavía no cómo el gesammt Anzahl el vorhandenen IP Adressen ermiteln kann
                                            'si uno mehr IP Adressen intenta auszulesen como disponible bekommt uno Adressen geliefert el lo nada son

Sinestar encargado Ende%                               'Beginn Hauptschleife
WAITINPUT
w_Param& = &wParam                           '&wParam se en Variable übertragen porque después de mehrmaliger Abfrage de &wParam y &lParam Yo üngültige werte bekommen habe podría ser el en el zwieschenzeit einlaufende Messages ellos verändern
l_Param& = &lParam                           'In w_Param& Steht el Socket Nummer y &lParam el Nummer des Codes z.B 8 para Acceptierte eingehende Verbindung oder 32 para Cerrar

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

    IF  l_Param& = 1                         '1  FD_READ Daten en Socket para lesen eingetroffen
    recfrom w_Param&                         '   liest Daten vom Socket el en w_Param& es
    data1$ =  @$(0)                          '   Daten de el Socket voluntad en el Variable data1$ kopiert
    getIP
    imprimir @$(0)
    imprimir data1$
    ENDIF


    IF  l_Param& = 2                         '2  FD_WRITE_BIT se gesendet si beim senden encima una Socket una Fehler aufgetreten es
                                             'así se signalisiert el en el Socket otra vez más gesendet voluntad kann. In w_Param& es el Socket Nummer des betrefenden Sockets.
    ENDIF

    IF  l_Param& = 8                         'ACCEPT una Client ha una Verbindung aufgenommen (el Socket des Clients ha una verbindung aufgebaut para Socket des Server Programms,el Socket se automáticamente erstelt y de el Proc GetConnectSocket seine Nummer zurückgeliefert)

    Claro IP_Addr_Inc#                       'el Zona el el IP tomar se en el Proc GetConnectSocket se sicherheitshalber geleert
    GetConnectSocket w_Param&                'liefert el Socket zurück el el verbindung con una Client aufgenommen ha
    socket_TCP_Temp& = @&(0)                 'kann sólo una Client Socket aufnehmen debería mehr Clients Gleichzeitig aktiv ser
                                             'muss una erweiterte Rutina dies verwalten

    getIP                                    'IP des Sockets el el Verbindung aufgenommen ha
    IP_inc$ = @$(0)                          'en más Verbindungen debería el IP con el dzu gehörenden Socketnummer gesichert y ser verwaltet
                                             'como en TCP el IP no con gesendet se y así después de el recfrom no ausgelesen voluntad kann

    SocketToThreatTcp socket_TCP_Temp&,%hWnd,5001    'el Socket el el verbindung aufgenommen ha se veranlast en el hintergrund
                                                     'en eingehende Daten a warten y en eingehenden Daten el Definierte Message a senden
    imprimir "IP: ";IP_inc$;" ha Verbindung aufgenommen encima Socket:";socket_TCP_Temp&
    ENDIF

    IF  l_Param& = 32                        'CLOSE schliest el Socket el el Message gesendet ha
    CloseSocketx w_Param&                    'El Nummer des Sockets liegt en w_Param&
    imprimir "Socket Cerrar x :";w_Param&
    ENDIF
 ENDIF

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

 IF  l_Param& = 1                            '1  FD_READ Daten en Socket para lesen eingetroffen
 recfrom w_Param&                            'liest Daten vom Socket el en w_Param& es
 data1$ =  @$(0)                             'Daten de el Socket voluntad en el Variable data1$ kopiert
 getIP
 imprimir @$(0)
 imprimir data1$
 ENDIF

 IF  l_Param& = 2                         '2  FD_WRITE_BIT se gesendet si beim senden encima una Socket una Fehler aufgetreten es
 Imprimir Socket Ready for Write           'así se signalisiert el en el Socket otra vez más gesendet voluntad kann. In w_Param& es el Socket Nummer des betrefenden Sockets.
 
 ENDIF

 ENDIF

 IF %key = 88                               ' X Taste Beendet el Programa y schliest el incluso erstellten Socket
 CloseSocketx socket_TCP_Server&            ' Sollten algunos Clients algunos Sockets geöffnet haben necesario ellos todavía extra geschlossen voluntad
 imprimir @&(0)
 CloseSocketx socket_TCP_Client&
 imprimir @&(0)
 CloseSocketx socket_TCP_Temp&
 imprimir @&(0)
 CloseWinsocks                              ' Schliest Winsocks
 imprimir @&(0)
 Ende% = 1
 Endif

 IF %key = 67                                        ' C Taste Stellt una Verbindung con una Server her
 sleep 300
 ConnectTcpTo 80,"192.168.2.34",socket_TCP_Client&   ' Liefert Error (-1) porque Socket como Task se ejecuta
 imprimir @&(0)
                                                 
 
 ENDIF

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

IF  %key = 103                                 ' g Taste
    recfrom socket_TCP_Temp&                   ' liest Daten vom Socket el en socket_TCP_Temp& es
    data1$ =  @$(0)                            ' Daten de el Socket voluntad en el Variable data1$ kopiert
    getIP
    imprimir @$(0)
    imprimir data1$
 ENDIF

endwhile                                        ' Ende Hauptschleife
imprimir "PROGRAMM STOP"

Sleep 1000

Athlon X2 4800 , 2GB Ram , GeForce 7800GT
Windows XP Pro , XProfan 10 und 11 , Profan2Cpp 1.6b

25.06.2006 ▲

Vollständiges Zitat

Absatzweise Cita Zeilenweise Cita

funkheld

Hmmm.... puede ser dieses Ding oben veces komplett Salonfähig hacer para XPSE ?

Gracias.

Gruss

XProfan 11

05.12.2013 ▲

Vollständiges Zitat

Absatzweise Cita Zeilenweise Cita

funkheld

Ach du schreck, así kompliziert es el en XProfan?
Tiempo schauen si Yo el hinkriege.

Gruss

XProfan 11

29.04.2016 ▲

Vollständiges Zitat

Absatzweise Cita Zeilenweise Cita

Michael
W.

Como sowohl el Kommentarzeichen como auch el Anführungszeichen fehlten, weiß Yo no si ahora se ejecuta...

Corrección en el Original durchgeführt...

El Características voluntad como Prozeduren aufgerufen y el Parámetro entonces con el @&()-Parámetro-Características abgeholt... Klingt después de altem Profano, es aber neueres XProfan (laut Texto).

System: Windows 8/10, XProfan X4
Programmieren, das spannendste Detektivspiel der Welt.

29.04.2016 ▲

Vollständiges Zitat

Absatzweise Cita Zeilenweise Cita