Includes | | | | 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 |
| | | | |
| | funkheld | Oh my God, so tricky is the in XProfan? time look whether I the hinkriege.
greeting |
| | | | |
| | 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 ▲ |
| |
|
AnswerTopic-Options | 11.309 Views |
Themeninformationenthis Topic has 3 subscriber: |