English
Includes

tcp: TCP and UDP Programming

 

Andreas
Gaida


' 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

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




Andreas
Gaida
small example Program for Winsocks.inc operates as Server and Client
IP Adressen must yet angepast go

$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
 
Athlon X2 4800 , 2GB Ram , GeForce 7800GT
Windows XP Pro , XProfan 10 und 11 , Profan2Cpp 1.6b
06/25/06  
 




funkheld
Hmmm.... can this thing supra time complete Salonfähig make for XPSE ?

Thank you.

greeting
 
12/05/13  
 




funkheld
Oh my God, so tricky is the in XProfan?
time look whether I the hinkriege.

greeting
 
04/29/16  
 




Michael
W.
there sowohl The Kommentarzeichen as well as The quotation marks fehlten, white I do not whether it now runs...

Korrektur in the Original implemented...

The functions go as Procedures called and the Parameter then with the @&()-Parameter-functions abgeholt... sound to old Profan, is neueres XProfan (loudly Text).
 
System: Windows 8/10, XProfan X4
Programmieren, das spannendste Detektivspiel der Welt.
04/29/16  
 



Answer


Topictitle, max. 100 characters.
 

Systemprofile:

no Systemprofil laid out. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Please register circa a Posting To verfassen.
 

Topic-Options

11.309 Views

Themeninformationen



Admins  |  AGB  |  Applications  |  Authors  |  Chat  |  Privacy Policy  |  Download  |  Entrance  |  Help  |  Merchantportal  |  Imprint  |  Mart  |  Interfaces  |  SDK  |  Services  |  Games  |  Search  |  Support

One proposition all XProfan, The there's!


My XProfan
Private Messages
Own Storage Forum
Topics-Remember-List
Own Posts
Own Topics
Clipboard
Log off
 Deutsch English Français Español Italia
Translations

Privacy Policy


we use Cookies only as Session-Cookies because of the technical necessity and with us there no Cookies of Drittanbietern.

If you here on our Website click or navigate, stimmst You ours registration of Information in our Cookies on XProfan.Net To.

further Information To our Cookies and moreover, How You The control above keep, find You in ours nachfolgenden Datenschutzerklärung.


all rightDatenschutzerklärung
i want none Cookie