#include "win/winsock2.bi" ' CONSTants CONST Socket_Buffer_Size = 2048 ' Socket Send/Receive buffer size CONST Socket_Buffer_Get = 255 ' How many bytes to get per loop CONST Socket_Is_Closed = 0 ' Socket is closed, or not used. CONST Socket_Is_Open = 1 ' Socket is open. CONST Socket_Is_Listening = 2 ' Socket is listening. CONST Socket_Is_Connecting = 3 ' Socket is connecting. CONST Socket_Is_Connected = 4 ' Socket is connected. CONST Socket_Is_Closing = 5 ' Socket is closing connection. CONST Socket_Is_Error = 6 ' Socket encountered an error. ' Types TYPE Our_Socket_Type sSocket AS SOCKET ' Winsock assigns its own SOCKET data type for sSocket. State AS UBYTE ' This is the status. SendBuffer AS ZSTRING * Socket_Buffer_Size ' 2k is sufficient enough. SendBytes AS ULONG ' The amount of bytes to send. RecvBuffer AS ZSTRING * Socket_Buffer_Size ' 2k is sufficient enough. RecvBytes AS ULONG ' The amount of bytes to receive. END TYPE ' We'll use 3 sockets in our chat program. CONST Max_Sockets = 3 DIM SHARED Our_Sockets(1 TO Max_Sockets) AS Our_Socket_Type ' Our sockets' handles. DIM SHARED Listen_Socket AS UBYTE, Main_Socket AS UBYTE, HTTP_Socket AS UBYTE, PORT AS UINTEGER ' Socket handles used in Connect 4 FB. DIM SHARED Workpage AS INTEGER, Polling AS INTEGER DECLARE SUB AddMessage (stMessage AS STRING) ' Add message to our screen. DECLARE SUB CustomInput (Text AS STRING, MaxLength AS INTEGER, KeyChar AS STRING, BYREF CursorPosition AS INTEGER) ' Custom INPUT that works in background! DECLARE SUB MakeBox (Row1 AS INTEGER, Col1 AS INTEGER, Row2 AS INTEGER, Col2 AS INTEGER) ' Make a text box DECLARE SUB PrintErrorEnd (ErrorMessage AS STRING) DECLARE SUB Process_Remote_Data () DECLARE SUB SendThis (stAction AS STRING) ' Shortened wrapper for sending data. ' Winsock specific calls. DECLARE SUB Winsock_Close () DECLARE SUB Winsock_Start () DECLARE FUNCTION GetMyIP (BYREF IPState AS INTEGER) AS STRING DECLARE FUNCTION Make_Socket_Accept (BYREF This_Socket AS UBYTE, BYREF Second_Socket AS UBYTE) AS SOCKET ' Accept incoming connection. DECLARE FUNCTION Make_Socket_Bind (BYREF This_Socket AS UBYTE, BYVAL PORT AS INTEGER) AS INTEGER ' Bind the socket to a particular port. DECLARE FUNCTION Make_Socket_Close (BYREF This_Socket AS UBYTE) AS BYTE ' Close the socket. DECLARE FUNCTION Make_Socket_Connect (BYREF This_Socket AS UBYTE, BYVAL stHostName AS STRING, BYVAL PORT AS INTEGER) AS BYTE DECLARE FUNCTION Make_Socket_Listen (BYREF This_Socket AS UBYTE, BYVAL TimeOut AS INTEGER = SOMAXCONN) AS BYTE DECLARE FUNCTION Make_Socket_Open (BYREF This_Socket AS UBYTE) AS BYTE ' Open up a socket. DECLARE FUNCTION Make_Socket_Receive (BYREF This_Socket AS UBYTE) AS INTEGER ' Get stuff from remote user. DECLARE FUNCTION Make_Socket_Resolve (BYVAL stHostName AS STRING) AS INTEGER DECLARE FUNCTION Make_Socket_Send (BYREF This_Socket AS UBYTE) AS INTEGER DECLARE FUNCTION Poll_Our_Sockets () AS INTEGER DECLARE FUNCTION Socket_Index (BYREF sSocket AS SOCKET) AS BYTE ' Find Socket's UID by sSocket's ID DECLARE FUNCTION Socket_New () AS INTEGER ' Finds an unused socket to use. DECLARE FUNCTION ValidIP (BYVAL IPAddr AS STRING) AS INTEGER ' Detect valid IP address. DIM SHARED Messages(0 TO 15) AS STRING ' Message DIM SHARED DummyStringA AS STRING, WinsockVersion AS STRING DIM SHARED YourIP AS STRING, GrabbedIP AS STRING, IPstate AS INTEGER ' GrabbedIP$ is a buffer for Your attained IP address. IPState indicates progress on getting IP address. DIM SHARED TheirIP AS STRING, TheirIPCursor AS INTEGER ' This is for entering their IP address. DIM SHARED YourName AS STRING, YourNameCursor AS INTEGER ' This is for entering your nick name. DIM SHARED TheirName AS STRING ' Remote user's nick name. DIM SHARED FrameAnimate AS INTEGER DIM SHARED Listening AS INTEGER DIM SHARED ChatInputText AS STRING, ChatInputTextCursor AS INTEGER ' Custom string routines. DIM SHARED Key AS STRING, InsertKey AS INTEGER ' Keyboard input stuff for later on. CONST LoopState_Setup_Listening = 0 ' Initiating our loop. CONST LoopState_Enter_Their_IP = 1 ' Enter their IP address. CONST LoopState_Retry = 2 ' Retry connection. CONST LoopState_Connecting = 3 ' Connecting.... CONST LoopState_Connected_Enter_Your_Name = 4 ' Connected, enter your name. CONST LoopState_Waiting_Their_Name = 5 ' Waiting on remote user to enter their nick name. CONST LoopState_Chat = 6 ' Chatting! DIM SHARED LoopState AS BYTE ' This will be used to check our loop states. ' Randomly selected port number to use for listening and/or connecting. PORT = 49952 ' 640 x 480 SCREEN 18, 8, 2 Winsock_Start DO ' ======= MAIN LOOP ' Update screen. SCREENSET Workpage, Workpage XOR 1 CLS ' Animate some of our stuff, and use this as the frame counter/index. FrameAnimate = (FrameAnimate + 1) AND 255 ' Socket must always poll! Polling = Poll_Our_Sockets ' Keyboard Key = INKEY ' Grab our key from keyboard. IF Key = CHR(255) + CHR(82) THEN InsertKey = InsertKey XOR 1 ' Toggle insert key state. ' Print version. LOCATE 1, 25: PRINT "Your version of Winsock is " + WinsockVersion ' Check all available sockets for incoming connection: IF HTTP_Socket = 0 THEN ' Once we got our IP address, let's open a listening socket. FOR Check_This_Socket AS INTEGER = 1 TO UBOUND(Our_Sockets) IF Our_Sockets(Check_This_Socket).State = Socket_Is_Connected OR Our_Sockets(Check_This_Socket).State = Socket_Is_Closing THEN IF LEN(Our_Sockets(Check_This_Socket).RecvBuffer) > 0 THEN ' Received our "Hello" from other instance. IF LoopState = LoopState_Enter_Their_IP AND LEFT(Our_Sockets(Check_This_Socket).RecvBuffer, 6) = "Hello." THEN Our_Sockets(Check_This_Socket).RecvBuffer = MID(Our_Sockets(Check_This_Socket).RecvBuffer, 7) ' Increment our buffer Main_Socket = Check_This_Socket ' Our listening socket now becomes our main socket. END IF END IF END IF NEXT Check_This_Socket END IF ' Received remote user's nick name. IF LEN(TheirName) = 0 THEN IF INSTR(Our_Sockets(Main_Socket).RecvBuffer, CHR(1)) > 0 THEN ' Handshake. Hi other user TheirName = LEFT(Our_Sockets(Main_Socket).RecvBuffer, INSTR(Our_Sockets(Main_Socket).RecvBuffer, CHR(1)) - 1) Our_Sockets(Main_Socket).RecvBuffer = MID(Our_Sockets(Main_Socket).RecvBuffer, INSTR(Our_Sockets(Main_Socket).RecvBuffer, CHR(1)) + 1) END IF END IF ' ========= Initate a listening socket. IF LoopState = LoopState_Setup_Listening THEN LoopState = LoopState_Enter_Their_IP ' Initiate a listening socket. IF Make_Socket_Open(Listen_Socket) THEN ' Succeeded, opened a socket IF Make_Socket_Bind(Listen_Socket, PORT) THEN ' Succeeded; bind socket to port ' Succeeded; bind socket to port IF Make_Socket_Listen(Listen_Socket, 0) THEN ' No time out needed. Listening = 1 ' Succeeded; socket listening for incoming. ELSE Make_Socket_Close(Listen_Socket) ' Close it END IF ELSE Make_Socket_Close(Listen_Socket) ' Mostly likey, port is already used by our first instance. This is normal. END IF ELSE PrintErrorEND "Unable to open socket!" END IF END IF ' We're still connecting... IF Our_Sockets(Main_Socket).State = Socket_Is_Connecting THEN LoopState = LoopState_Connecting LOCATE 15, 5: PRINT "Connecting" LOCATE 15, 15: PRINT STRING(FrameAnimate SHR 2, ".") END IF ' An established connection has been terminated. IF LoopState = LoopState_Retry THEN COLOR 12 LOCATE 13, 25: PRINT "Connection has terminated!" LOCATE 15, 25: PRINT "Hit ENTER to retry or ESC to quit." IF Key = CHR(13) THEN LoopState = LoopState_Enter_Their_IP COLOR 15 END IF ' We're connected? What? Ok! Now let's tell that to our main loop! IF Our_Sockets(Main_Socket).State = Socket_Is_Connected THEN IF LoopState < LoopState_Connected_Enter_Your_Name THEN LoopState = LoopState_Connected_Enter_Your_Name END IF END IF ' ======== We're connected, now enter nick name! IF LoopState = LoopState_Connected_Enter_Your_Name THEN IF Key = CHR(13) THEN IF LEN(LTRIM(RTRIM(YourName))) THEN LoopState = LoopState_Waiting_Their_Name SendThis YourName ' Send it to them. END IF END IF LOCATE 11, 30: PRINT "CONNECTED! YES!" CustomInput YourName, 10, Key, YourNameCursor LOCATE 13, 20: PRINT "Now enter your nick name: (10 Chars Max)" LOCATE 15, 20: PRINT YourName IF FrameAnimate AND 32 THEN LOCATE 15, 20 + YourNameCursor IF InsertKey THEN PRINT CHR(219) ELSE PRINT "_" END IF END IF ' ======== Waiting for them to enter their nick name! IF LoopState = LoopState_Waiting_Their_Name THEN LOCATE 15, 15: PRINT "Waiting on remote user to enter their nick name..." IF LEN(TheirName) THEN LoopState = LoopState_Chat END IF ' ======== Ah, finally, let's chat, damn it! IF LoopState = LoopState_Chat THEN ' Display our message history! FOR I AS INTEGER = 0 TO 15 IF LEFT(Messages(I), 2) = "R:" THEN ' Remote user COLOR 9 LOCATE I + 4, 5: PRINT TheirName + ": " + MID(Messages(I), 3) END IF IF LEFT(Messages(I), 2) = "L:" THEN ' Local user COLOR 12 LOCATE I + 4, 5: PRINT YourName + ": " + MID(Messages(I), 3) END IF NEXT COLOR 15 LOCATE 25, 5: PRINT "Type your text and hit ENTER to send the message." CustomInput ChatInputText, 60, Key, ChatInputTextCursor ' Send our text now! IF Key = CHR(13) THEN ' Enter to send text. IF LEN(ChatInputText) THEN AddMessage "L:" + ChatInputText ' Local window gets message. SendThis "R:" + ChatInputText ' Remote window gets message. ChatInputText = "" END IF END IF LOCATE 22, 17: PRINT ChatInputText IF FrameAnimate AND 32 THEN LOCATE 22, 17 + ChatInputTextCursor IF InsertKey THEN PRINT CHR(219) ELSE PRINT "_" END IF ' FrameAnimate MakeBox 3, 3, 20, 78 MakeBox 21, 15, 23, 78 END IF ' ========= Start up screen. IF LoopState = LoopState_Enter_Their_IP THEN MakeBox 15, 3, 17, 40 LOCATE 16, 5: PRINT "Your IP address: " + YourIP IF Listening THEN LOCATE 3, 5: PRINT "You can enter their IP address or wait for them to connect to you!" COLOR 11: LOCATE 8, 5: PRINT "Listening is enabled." ELSE LOCATE 3, 5: PRINT "You'll have to type in the IP address since listening is disabled." COLOR 12: LOCATE 8, 5: PRINT "Listening is disabled." END IF ' Listening CustomInput TheirIP, 15, Key, TheirIPCursor ' Input text and print it out. COLOR 15 LOCATE 5, 5: PRINT TheirIP IF FrameAnimate AND 32 THEN LOCATE 5, 5 + TheirIPCursor IF InsertKey THEN PRINT CHR(219) ELSE PRINT "_" END IF ' FrameAnimate IF ValidIP(TheirIP) THEN ' User hits ENTER, let's fire up a socket! IF Key = CHR(13) THEN IF Make_Socket_Open(Main_Socket) THEN ' Close down listening socket if we're connecting. IF Our_Sockets(Listen_Socket).State = Socket_Is_Listening THEN IF Make_Socket_Close(Listen_Socket) = 0 THEN PrintErrorEND "Error in closing the listening socket!" END IF ' close socket END IF ' status listening IF Make_Socket_Connect(Main_Socket, TheirIP, PORT) THEN SendThis "Hello." ' This is the connection request, or hand-shake, as some would say. LoopState = LoopState_Connecting ELSE PrintErrorEND "Error in connecting routine!" END IF ' connect ELSE PrintErrorEND "Error in opening our main socket!" END IF ' open socket END IF ' enter key COLOR 10: LOCATE 12, 5: PRINT "Valid IP address has been typed! Hit ENTER to initiate connection!" COLOR 15 ELSE ' Still waiting for valid IP COLOR 12: LOCATE 12, 5: PRINT "Please type a valid IP address! Example: x.x.x.x x = 0 to 255." COLOR 15 END IF ' End waiting on valid IP END IF ' End of our start screen. ' What to do with our received data. Process_Remote_Data ' Grabbing IP address smoothly in background. YourIP = GetMyIP(IPState) 'DummyStringA$ = YourIP$ ' Print Polling status. 'LOCATE 26, 5: PRINT DummyStringA$ ' Grabbing IP address smoothly in background. COLOR 14 LOCATE 28, 5 + (FrameAnimate SHR 3): PRINT ".. Polling our sockets in background .." COLOR 15 LOCATE 29, 5: PRINT "Hit ESC any time to quit this chat app!" ' Flip work page. WorkPage XOR = 1 SLEEP 5 LOOP UNTIL Key = CHR(27) OR Key = CHR(255) + "k" ' == END OF MAIN LOOP ' Tell our connected user goodbye! IF Our_Sockets(Main_Socket).State = Socket_Is_Connected THEN SendThis "BYE:" Polling = Poll_Our_Sockets ' For some reason, some delay is needed, so the remote user gets the goodbye message. SLEEP 100 ' Close Winsock and end the program! Winsock_Close SUB AddMessage (stMessage AS STRING) ' Message history being updated. FOR I AS INTEGER = 0 TO 14 Messages(I) = Messages(I + 1) NEXT Messages(15) = stMessage END SUB SUB CustomInput (Text AS STRING, MaxLength AS INTEGER, KeyChar AS STRING, BYREF CursorPosition AS INTEGER) /' This is your custom INPUT. Unlike INPUT, You can run this one in the looping background. You can still edit text by adding a character, inserting a character, backspacing, deleting, and change the cursor position with left/right arrow keys, Home, and End. You can also limit the character length of your input string. '/ DIM Length AS INTEGER, AAL AS STRING, AAR AS STRING ' Modify STRING Length = LEN(Text) IF CursorPosition > Length THEN CursorPosition = Length SELECT CASE KeyChar CASE CHR(8) ' Backspace IF Length AND CursorPosition > 0 THEN CursorPosition = CursorPosition - 1 AAL = LEFT(Text, CursorPosition) AAR = RIGHT(Text, Length - CursorPosition - 1) Text = AAL + AAR END IF CASE CHR(255) + CHR(71) ' Home key CursorPosition = 0 CASE CHR(255) + CHR(75) ' Left key CursorPosition = CursorPosition + (CursorPosition > 0) CASE CHR(255) + CHR(77) ' Right key CursorPosition = CursorPosition - (CursorPosition < Length) CASE CHR(255) + CHR(79) ' End key CursorPosition = Length CASE CHR(255) + CHR(83) ' Delete key IF CursorPosition < Length THEN AAL = LEFT(Text, CursorPosition) AAR = RIGHT(Text, LEN(Text) - CursorPosition - 1) Text = AAL + AAR END IF END SELECT ' Add to text STRING IF LEN(KeyChar) = 1 THEN ' Make sure character length is 1. IF ASC(KeyChar) > 31 AND CursorPosition < MaxLength THEN IF InsertKey THEN ' Insert character and replace. IF CursorPosition < Length THEN MID(Text, CursorPosition + 1, 1) = KeyChar IF CursorPosition = Length THEN Text += KeyChar CursorPosition = CursorPosition + 1 ELSE IF MaxLength > LEN(Text) THEN ' Insert and move text to right. AAL = LEFT(Text, CursorPosition) AAR = RIGHT(Text, Length - CursorPosition) Text = LEFT(AAL + KeyChar + AAR, MaxLength) CursorPosition = CursorPosition + 8 END IF END IF END IF END IF END SUB FUNCTION GetMyIP (BYREF IPState AS INTEGER) AS STRING DIM HTTP_PORT AS UINTEGER DIM HTTP_HOST AS STRING DIM HTTP_HOST_SCRIPT AS STRING DIM HTTP_REQUEST AS STRING DIM ByteReceived AS INTEGER DIM DataReceived AS STRING DIM ValidCharIP AS STRING, Dot1 AS INTEGER, Dot2 AS INTEGER, Dot3 AS INTEGER DIM BytesReceived AS INTEGER, Dummy AS INTEGER DIM Char1 AS STRING, AddIP AS STRING HTTP_PORT = 80 ' Port 80 is common for HTTP. HTTP_HOST = "www.marcade.net" ' Marcade has a website that outputs your IP address. HTTP_HOST_SCRIPT = "/whatsmyip.php" ' This php script will output your public Ip address. ValidCharIP = "0123456789." ' This will be used to make sure IP address has valid characters. ' HTTP protocol header stuff to use when trying to communicate with an HTTP web server. HTTP_REQUEST = "GET " + HTTP_HOST_SCRIPT + " HTTP/1.0" + CHR(13, 10) + "Host: " + HTTP_HOST + CHR(13, 10) + CHR(13, 10) IF IPState = 0 THEN IF Make_Socket_Open(HTTP_Socket) THEN IF Make_Socket_Connect(HTTP_Socket, HTTP_HOST, HTTP_PORT) THEN ' Open + Connect IPState = 1 EXIT FUNCTION END IF END IF END IF IF IPState = 1 THEN ' Request Our_Sockets(HTTP_Socket).SendBuffer = HTTP_REQUEST IPState = 2 EXIT FUNCTION END IF IF IPState = 2 THEN ' Receive Chunk #1. Most of the data received will contain DataReceived = Our_Sockets(HTTP_Socket).RecvBuffer ' non-essential data for this program. We're just interested BytesReceived = LEN(LTRIM(RTRIM(DataReceived))) ' in grabbing the IP address. The buffer gets 255 bytes at a IF BytesReceived > 0 THEN ' time. The total amount of web data is greater than that. IPState = 3 EXIT FUNCTION END IF END IF IF IPState = 3 THEN ' Receive Chunk #2, now close the socket. We're done! DataReceived = Our_Sockets(HTTP_Socket).RecvBuffer ' Chunk #2 should contain our IP address in there. BytesReceived = LEN(LTRIM(RTRIM(DataReceived))) IF BytesReceived > 0 THEN IPState = 4 Dummy = Make_Socket_Close(HTTP_Socket) FOR iTemp AS INTEGER = LEN(DataReceived) TO 1 STEP -1 ' Since the IP address will be last, we'll go backwards. Char1 = MID(DataReceived, iTemp, 1) IF Char1 = "." THEN Dot1 += 1 ' Count our dots and make sure we only have 3. IF Dot1 > 3 THEN EXIT FOR ' Too many dots. IF Dot1 = 3 THEN Dot2 = 1 IF INSTR(ValidCharIP, Char1) THEN ' Extract and verify that it is an IP address! AddIP = Char1 + AddIP ' Building our IP address. ELSE IF Dot2 = 1 THEN EXIT FOR ' No more valid characters, and we have 3 dots, so that's it! END IF NEXT IF ValidIP(AddIP) THEN GrabbedIP = AddIP ' Use our custom valid IP routine, just to double check! END IF END IF IF IPState = 4 THEN GetMyIP = GrabbedIP ' GrabbedIP$ will permanently contain our IP address. END FUNCTION FUNCTION Make_Socket_Accept (BYREF This_Socket AS UBYTE, BYREF Second_Socket AS UBYTE) AS SOCKET ' Socket address and length. DIM sa AS sockaddr_in DIM salen AS INTEGER ' Get a new socket reserved for our accepted connection. Second_Socket = Socket_New IF Second_Socket = -1 THEN ' No more sockets available. Cannot accept connection Make_Socket_Accept = Make_Socket_Close(This_Socket) EXIT FUNCTION END IF ' Get length salen = LEN(sa) ' Accept any incoming connections and use our new socket for it. Our_Sockets(Second_Socket).sSocket = Accept(Our_Sockets(This_Socket).sSocket, CAST(PSOCKADDR, @sa), @salen) IF Our_Sockets(Second_Socket).sSocket > 0 THEN ' Succeeded in accepting connection Our_Sockets(Second_Socket).State = Socket_Is_Connected END IF END FUNCTION FUNCTION Make_Socket_Bind (BYREF This_Socket AS UBYTE, BYVAL PORT AS INTEGER) AS INTEGER ' Socket address header DIM sa AS sockaddr_in sa.sin_port = htons(PORT) ' Convert the byte order for PORT. sa.sin_family = AF_INET ' IPv4 sa.sin_addr.S_addr = INADDR_ANY ' Any address format. ' Here, we associate a socket with our port. Make_Socket_Bind = Bind(Our_Sockets(This_Socket).sSocket, CAST(PSOCKADDR, @sa), LEN(sa)) <> SOCKET_ERROR END FUNCTION FUNCTION Make_Socket_Close (BYREF This_Socket AS UBYTE) AS BYTE ' Winsock's routine to close down both incoming and outgoing networking operations. ShutDown Our_Sockets(This_Socket).sSocket, SD_BOTH ' ow disconnect the handle and check to see if it's closed completely. IF CloseSocket(Our_Sockets(This_Socket).sSocket) = 0 THEN Our_Sockets(This_Socket).State = Socket_Is_Closed ' Closed socket This_Socket = 0 ' Unassign socket Make_Socket_Close = -1 ' Return true for successful close down. ELSE Our_Sockets(This_Socket).State = Socket_Is_Error ' Failed to close socket Make_Socket_Close = 0 END IF END FUNCTION FUNCTION Make_Socket_Connect (BYREF This_Socket AS UBYTE, BYVAL stHostName AS STRING, BYVAL PORT AS INTEGER) AS BYTE ' Socket address and IP DIM sa AS sockaddr_in DIM iIP AS INTEGER ' Check IF Socket is in Open State IF Our_Sockets(This_Socket).State <> Socket_Is_Open THEN EXIT FUNCTION ' Resolve address iIP = Make_Socket_Resolve(stHostName) ' Socket address header sa.sin_port = htons(PORT) ' htons changes the byte format. Port number gets associated. sa.sin_family = AF_INET ' IPv4 address as opposed to IPv6 (AF_INET6) sa.sin_addr.S_addr = iIP ' Our resolved IP number. ' This is Winsock's connect routine. IF Connect(Our_Sockets(This_Socket).sSocket, CAST(PSOCKADDR, @sa), LEN(sa)) <> SOCKET_ERROR THEN Our_Sockets(This_Socket).State = Socket_Is_Connecting ' Socket connecting Make_Socket_Connect = -1 ELSE IF WSAGetLastError = WSAEWOULDBLOCK THEN ' Normal, blocking mode is on. Our_Sockets(This_Socket).State = Socket_Is_Connecting ' Socket connecting Make_Socket_Connect = -1 ELSE Our_Sockets(This_Socket).State = Socket_Is_Error ' Failed to connect END IF END IF END FUNCTION FUNCTION Make_Socket_Listen (BYREF This_Socket AS UBYTE, BYVAL TimeOut AS INTEGER = SOMAXCONN) AS BYTE ' Winsock's Listen() routine doesn't need a non-zero number for TimeOut since we're in non-blocking mode. IF Listen(Our_Sockets(This_Socket).sSocket, TimeOut) <> SOCKET_ERROR THEN Our_Sockets(This_Socket).State = Socket_Is_Listening Make_Socket_Listen = -1 END IF END FUNCTION FUNCTION Make_Socket_Open (BYREF This_Socket AS UBYTE) AS BYTE ' Set Non-blocking mode on. DIM NonBlocking AS LONG NonBlocking = 1 ' Get unused Socket from our routine! This_Socket = Socket_New IF This_Socket = -1 THEN EXIT FUNCTION ' No more sockets available! ' Winsock's open socket routine Our_Sockets(This_Socket).sSocket = OpenSocket(AF_INET, SOCK_STREAM, IPPROTO_TCP) /' Winsock's socket protocol parameters: This is what we'll use. AF_INET (As opposed to AF_INET6) Since we're using IPv4 instead of IPv6 for IP addresses. SOCK_STREAM (As opposed to SOCK_DGRAM) Since we're using a connection-based socket, we use this. IPPROTO_TCP (As opposed to IPPROTO_UDP) TCP is slower than UDP, but ensures reliability and delivers data in the correct order. The first parameter is the address family. We'll be using IPv4. While IPv6 is slowly catching up (as of now), IPv4 is still the standard. It's also easier to type since it only goes up to 15 characters with decimal numbers. The second parameter is simply telling it we're using a stream (constant connection, kinda like a live phone connection) that will be used for TCP. For chatting, we're using TCP protocol. TCP is a connection-based real time protocol. Unlike UDP (Datagram), TCP is designed to make sure you receive packets (chunks of data), and in the correct order they were sent out. UDP (Datagram) is faster, doesn't need a constant streaming connection, however, it doesn't check to see if you received your packets in order, or if you even got the packets at all! For this reason, TCP is much easier to work with since it's designed to be reliable. '/ IF Our_Sockets(This_Socket).sSocket = NULL THEN EXIT FUNCTION /' The ioctlsocket function controls the I/O mode of a socket, which you will put your sockets into non-blocking mode. The FIONBIO and @lNonBlocking mode is basically telling FIONBIO (non-blocking command) to equal to 1, meaning non-blocking is now enabled (nonzero value enables it). Since you have non-blocking mode on, this will prevent the recv() function from halting your program. '/ IF ioctlsocket(Our_Sockets(This_Socket).sSocket, FIONBIO, @NonBlocking) = -1 THEN EXIT FUNCTION Our_Sockets(This_Socket).State = Socket_Is_Open ' Now tell it that the socket is open. Make_Socket_Open = -1 END FUNCTION FUNCTION Make_Socket_Receive (BYREF This_Socket AS UBYTE) AS INTEGER DIM zsBuffer AS ZSTRING * (Socket_Buffer_Get + 1) DIM BytesReceived AS INTEGER ' Maximum amount to grab at a time. BytesReceived = Socket_Buffer_Get ' Running out of buffer, let's roll it over. IF LEN(Our_Sockets(This_Socket).RecvBuffer) + Socket_Buffer_Get > SIZEOF(Our_Sockets(This_Socket).RecvBuffer) THEN BytesReceived = SIZEOF(Our_Sockets(This_Socket).RecvBuffer) - LEN(Our_Sockets(This_Socket).RecvBuffer) - 1 IF BytesReceived < 1 THEN EXIT FUNCTION END IF ' Winsock's routine to receive data BytesReceived = Recv(Our_Sockets(This_Socket).sSocket, @zsBuffer, Socket_Buffer_Get, 0) ' Data has been received! Now let's put it into our buffer! IF BytesReceived > 0 THEN Our_Sockets(This_Socket).RecvBuffer = Our_Sockets(This_Socket).RecvBuffer + zsBuffer Our_Sockets(This_Socket).RecvBytes = Our_Sockets(This_Socket).RecvBytes + BytesReceived END IF ' This will return non-zero for data being received. Make_Socket_Receive = BytesReceived END FUNCTION FUNCTION Make_Socket_Resolve (BYVAL stHostName AS STRING) AS INTEGER ' Internet address and host entry header. DIM ia AS in_addr DIM hostentry AS hostent PTR ' Check if it's an actual ip address ia.S_addr = inet_addr(stHostName) ' This converts a string containing an IPv4 dotted-decimal ' address into a proper address for the IN_ADDR structure. IF ia.S_addr = INADDR_NONE THEN ' IF not, assume it's a name. Use Winsock's routine to resolve it. hostentry = gethostbyname(stHostName) IF hostentry = 0 THEN EXIT FUNCTION Make_Socket_Resolve = *CAST(INTEGER PTR, *hostentry->h_addr_list) ELSE ' Just return the address Make_Socket_Resolve = ia.S_addr END IF END FUNCTION FUNCTION Make_Socket_Send (BYREF This_Socket AS UBYTE) AS INTEGER DIM BytesToSend AS INTEGER DIM zsBuffer AS ZSTRING * (Socket_Buffer_Get + 1) ' Get length BytesToSend = LEN(Our_Sockets(This_Socket).SendBuffer) IF BytesToSend = 0 THEN EXIT FUNCTION ' Truncate data to maxmimum get IF BytesToSend > Socket_Buffer_Get THEN BytesToSend = Socket_Buffer_Get ' Grab a small chunk of our data. zsBuffer = LEFT(Our_Sockets(This_Socket).SendBuffer, BytesToSend) ' Update the buffer's string and length. Our_Sockets(This_Socket).SendBuffer = MID(Our_Sockets(This_Socket).SendBuffer, BytesToSend + 1) Our_Sockets(This_Socket).SendBytes = Our_Sockets(This_Socket).SendBytes + BytesToSend ' Tell Winsock to send our small chunk of data. BytesToSend = Send(Our_Sockets(This_Socket).sSocket, @zsBuffer, BytesToSend, 0) Make_Socket_Send = BytesToSend END FUNCTION SUB MakeBox (Row1 AS INTEGER, Col1 AS INTEGER, Row2 AS INTEGER, Col2 AS INTEGER) DIM RowDist AS INTEGER, ColDist AS INTEGER ' Swap coordinates that are greater. IF Row1 > Row2 THEN SWAP Row1, Row2 IF Col1 > Col2 THEN SWAP Col1, Col2 ' Box isn't big enough RowDist = (Row2 - Row1) - 1 ColDist = (Col2 - Col1) - 1 IF RowDist <= 0 THEN EXIT SUB IF ColDist <= 0 THEN EXIT SUB ' Top part LOCATE Row1, Col1: PRINT CHR(201) + STRING(ColDist, CHR(205)) + CHR(187) FOR iRow AS INTEGER = (Row1 + 1) TO (Row2 - 1) LOCATE iRow, Col1: PRINT CHR(186) LOCATE iRow, Col2: PRINT CHR(186) NEXT LOCATE Row2, Col1: PRINT CHR(200) + STRING(ColDist, CHR(205)) + CHR(188) END SUB FUNCTION Poll_Our_Sockets AS INTEGER ' Winsock has their own DATA types. DIM read_fd_set AS fd_set ' sSocket ID and counter will be utilized by these. DIM write_fd_set AS fd_set DIM except_fd_set AS fd_set DIM TimeOutValues AS timeval ' We'll use zero since we're in non-blocking mdoe. DIM Dummy AS INTEGER DIM iTemp AS INTEGER ' Loop counter. DIM This_Socket AS BYTE ' Checking our used sockets counter. DIM Second_Socket AS BYTE ' When accepting a connection, the second socket will be a copy of the listening socket. DIM CheckThis AS INTEGER DIM iRetVal AS INTEGER ' We will check all the sockets for any active operations. FOR This_Socket = 1 TO UBOUND(Our_Sockets) ' If a socket is listening, connecting, connected, or closing, then add them to the list. CheckThis = 0 SELECT CASE Our_Sockets(This_Socket).State CASE Socket_Is_Listening: CheckThis = 1 CASE Socket_Is_Connecting: CheckThis = 1 CASE Socket_Is_Connected: CheckThis = 1 CASE Socket_Is_Closing: CheckThis = 1 END SELECT /' When a socket needs to be checked, we add it to the list of sockets to be read and polled later on by SelectSocket(). '/ IF CheckThis THEN ' Add the active socket to the list. read_fd_set.fd_array(read_fd_set.fd_count) = Our_Sockets(This_Socket).sSocket read_fd_set.fd_count = read_fd_set.fd_count + 1 write_fd_set.fd_array(write_fd_set.fd_count) = Our_Sockets(This_Socket).sSocket write_fd_set.fd_count = write_fd_set.fd_count + 1 except_fd_set.fd_array(except_fd_set.fd_count) = Our_Sockets(This_Socket).sSocket except_fd_set.fd_count = except_fd_set.fd_count + 1 END IF NEXT This_Socket ' IF there's nothing to poll, then leave this routine! IF read_fd_set.fd_count = 0 AND write_fd_set.fd_count = 0 AND except_fd_set.fd_count = 0 THEN EXIT FUNCTION /' When you're polling your sockets, you'll end up checking all possible read, write, and error operations that have happened. Winsock's internal routines will capture all the current r/w/e updates, as long as we keep calling SelectSocket. This is where all the read/write/error polling happens! '/ Dummy = SelectSocket(read_fd_set.fd_count, @read_fd_set, @write_fd_set, @except_fd_set, @TimeOutValues) ' Debugging purposes. Sometimes, we want to know if our sockets are reading, writing, or having errors, at all! DummyStringA = "READ: " + STR(read_fd_set.fd_count) + " WRITE: " + STR(write_fd_set.fd_count) + " EXCEPT: " + STR(except_fd_set.fd_count ) ' IF return value is zero, no changes IF Dummy = 0 THEN EXIT FUNCTION ' IF it is less than zero, something happened IF Dummy < 0 THEN Poll_Our_Sockets = -1 ' Check readability of sockets FOR iTemp = 0 TO (read_fd_set.fd_count - 1) ' Remember this routine? Let's find which socket handle needs polling by its sSocket ID. This_Socket = Socket_Index(read_fd_set.fd_array(iTemp)) IF This_Socket > -1 THEN ' Socket is readable. /' Since the socket is now readable, let's make it to where... 1) A listening socket accepts an incoming connection. 2) A connecting socket becomes a connected socket. 3) A connected socket grabbing any possible incoming data. 4) A closing socket becomes a closed socket. '/ SELECT CASE Our_Sockets(This_Socket).State CASE Socket_Is_Listening Dummy = Make_Socket_Accept(This_Socket, Second_Socket) CASE Socket_Is_Connecting Our_Sockets(This_Socket).State = Socket_Is_Connected CASE Socket_Is_Connected Dummy = Make_Socket_Receive(This_Socket) IF Dummy = 0 THEN ' 0 bytes received, means remote peer closed connection Our_Sockets(This_Socket).State = Socket_Is_Closing END IF CASE Socket_Is_Closing IF LEN(Our_Sockets(This_Socket).RecvBuffer) = 0 THEN Dummy = Make_Socket_Close(This_Socket) ' IF receive buffer is empty, close socket END IF END SELECT END IF NEXT iTemp ' Check writability of sockets FOR iTemp = 0 TO (write_fd_set.fd_count - 1) This_Socket = Socket_Index(write_fd_set.fd_array(iTemp)) IF This_Socket > -1 THEN ' Socket is writable. /' Since the socket is now writable, let's make it to where... 1) A connecting socket becomes a connected socket. 2) A connected socket sends any available content. '/ SELECT CASE Our_Sockets(This_Socket).State CASE Socket_Is_Connecting Our_Sockets(This_Socket).State = Socket_Is_Connected CASE Socket_Is_Connected iRetVal = Make_Socket_Send(This_Socket) END SELECT END IF NEXT iTemp ' Check exceptions of sockets FOR iTemp = 1 TO (except_fd_set.fd_count - 1) This_Socket = Socket_Index(except_fd_set.fd_array(iTemp)) IF This_Socket > -1 THEN ' Socket encountered an error. ' An error occured with the socket. Our_Sockets(This_Socket).State = Socket_Is_Error iRetVal = Make_Socket_Close(This_Socket) END IF NEXT iTemp END FUNCTION SUB Process_Remote_Data DIM ParseThis AS STRING ' The string to extract. DIM stCommand AS STRING ' Custom command. DIM stValue AS STRING ' Custom value. DIM EndString AS INTEGER ' The end position of the string. DIM Colon AS INTEGER ' Colon contained in our received data. GoBackForMore: EndString = INSTR(Our_Sockets(Main_Socket).RecvBuffer, CHR(1)) - 1 ' Get the length/end position of the string. IF EndString <= 0 THEN EXIT SUB ParseThis = LEFT(Our_Sockets(Main_Socket).RecvBuffer, EndString): ParseThis = LTRIM(RTRIM(ParseThis)) ' Clean up stAction and make a copy. IF ParseThis = "" THEN EXIT SUB Colon = INSTR(ParseThis, ":") ' Colon has to be present. IF Colon THEN stCommand = LEFT(ParseThis, Colon - 1) ' Left most stuff, these will be our custom commands. stValue = MID(ParseThis, Colon + 1) ' Right most stuff, these will be our command values. ELSE EXIT SUB END IF ' Remote user has sent us something. SELECT CASE stCommand CASE "BYE" Our_Sockets(Main_Socket).State = Socket_Is_Closing LoopState = LoopState_Retry TheirName = "" CASE "R" ' The Remote User sends a message stValue = LTRIM(RTRIM(stValue)) AddMessage "R:" + stValue ' Add message to local window. ParseThis = "" END SELECT Our_Sockets(Main_Socket).RecvBuffer = MID(Our_Sockets(Main_Socket).RecvBuffer, EndString + 2) ' + 2 to offset from CHR(0) on the right side. GOTO GoBackForMore ' This is assuming we have more receiving data pending before the next loop cycle. END SUB SUB PrintErrorEnd (ErrorMessage AS STRING) ' END Program with error. ' Here, you'd like to know why you got an error, so print it out on screen! CLS COLOR 15 WSACleanUp PRINT ErrorMessage PRINT "Error code: (IF applicable)", WSAGetLastError SLEEP END END SUB FUNCTION Socket_Index (BYREF sSocket AS SOCKET) AS BYTE DIM Check_This_Socket AS BYTE ' Look through our sockets and identify which one has our sSocket value. FOR Check_This_Socket = 1 TO UBOUND(Our_Sockets) IF Our_Sockets(Check_This_Socket).sSocket = sSocket THEN Socket_Index = Check_This_Socket EXIT FOR END IF NEXT Check_This_Socket ' Not found IF Check_This_Socket > UBOUND(Our_Sockets) THEN Socket_Index = -1 END FUNCTION SUB SendThis (stAction AS STRING) ' Add to our send buffer! Our_Sockets(Main_Socket).SendBuffer = Our_Sockets(Main_Socket).SendBuffer + stAction + CHR(1) END SUB FUNCTION Socket_New AS INTEGER DIM Check_This_Socket AS BYTE ' Look through all of our sockets, and find one that's not used. FOR Check_This_Socket AS INTEGER = 1 TO UBOUND(Our_Sockets) IF Our_Sockets(Check_This_Socket).State = Socket_Is_Closed THEN ' New unused socket found, use it Our_Sockets(Check_This_Socket).sSocket = 0 ' Making sure everything is NULL. Our_Sockets(Check_This_Socket).SendBuffer = "" Our_Sockets(Check_This_Socket).SendBytes = 0 Our_Sockets(Check_This_Socket).RecvBuffer = "" Our_Sockets(Check_This_Socket).RecvBytes = 0 Socket_New = Check_This_Socket ' Return the value of the unused socket that was found. EXIT FOR END IF NEXT Check_This_Socket END FUNCTION FUNCTION ValidIP (BYVAL IPAddr AS STRING) AS INTEGER /' This custom routine checks for a valid IP address. We use the traditional dotted IP address format. We know that valid IP addresses have the following: 1) The length must be 7 to 15 characters in length (x.x.x.x to xxx.xxx.xxx.xxx) 2) It must contain dots, numbers, and nothing else. 3) It must contain exactly 3 dots. 4) The dots will be in between numbers. 5) The numbers' values will have a range of 0 to 255. '/ DIM ValidCharIP AS STRING, Dot1 AS INTEGER, Dot2 AS INTEGER, Dot3 AS INTEGER DIM Length AS INTEGER, Val1 AS INTEGER , Val2 AS INTEGER, Val3 AS INTEGER, Val4 AS INTEGER DIM Char1 AS STRING ValidCharIP = "0123456789." IPAddr = LTRIM(RTRIM(IPAddr)) Length = LEN(IPAddr) IF Length < 7 OR Length > 15 THEN EXIT FUNCTION ' Invalid length detected FOR IP Address. FOR Temp AS INTEGER = 1 TO Length Char1 = MID(IPAddr, Temp, 1) IF Char1 = "." THEN IF Dot3 THEN EXIT FUNCTION ' Too many dots. IF Dot3 = 0 AND Dot2 > 0 THEN Dot3 = Temp: IF Temp = Length THEN EXIT FUNCTION ' No dot should be at END. IF Dot2 = 0 AND Dot1 > 0 THEN Dot2 = Temp IF Dot1 = 0 THEN Dot1 = Temp: IF Temp < 2 THEN EXIT FUNCTION ' No dot should be at the beginning. END IF IF INSTR(ValidCharIP, Char1) = 0 THEN EXIT FUNCTION ' Invalid characters detected. NEXT Temp IF Dot3 = 0 THEN EXIT FUNCTION ' Not enough dots were detected. (There must always be 3) IF Dot2 - Dot1 < 2 OR Dot2 - Dot1 > 4 THEN EXIT FUNCTION ' Dots should have 1 to 3 digits in between. IF Dot3 - Dot2 < 2 OR Dot3 - Dot2 > 4 THEN EXIT FUNCTION ' Dots should have 1 to 3 digits in between. IF Length - Dot3 < 1 OR Length - Dot3 > 3 THEN EXIT FUNCTION Val1 = VAL(LEFT(IPAddr, Dot1 - 1)) ' Tokenizing values from IPaddr$ Val2 = VAL(MID(IPAddr, Dot1 + 1, Dot2 - Dot1 - 1)) val3 = VAL(MID(IPAddr, Dot2 + 1, Dot3 - Dot2 - 1)) Val4 = VAL(RIGHT(IPAddr, Length - Dot3)) IF Val1 > 255 THEN EXIT FUNCTION ' Values are out of range. Must be in 0 - 255 range. IF Val2 > 255 THEN EXIT FUNCTION IF Val3 > 255 THEN EXIT FUNCTION IF Val4 > 255 THEN EXIT FUNCTION ValidIP = -1 END FUNCTION SUB Winsock_Close ' Winsock's shut down routine that cleans up everything associated with Winsock. WSACleanUp END END SUB SUB Winsock_Start ' Winsock's data structure has to be used to retrieve our version info. DIM MakeOurWSAData AS WSAdata DIM OurVersionMajor AS STRING, OurVersionMinor AS STRING ' Fire up Winsock! We're requesting v2.0 IF WSAStartup(MAKEWORD(2, 0), @MakeOurWSAData) THEN SELECT CASE WSAGetLastError CASE WSASYSNOTREADY PRINT "Underlying Network subsystem is not ready." CASE WSAVERNOTSUPPORTED PRINT "The requested version is not supported." CASE WSAEINPROGRESS PRINT "A blocking Windows Sockets 1.1 operation is in progress." CASE WSAEPROCLIM PRINT "Winsock's usage has reached its limits by other programs." CASE WSAEFAULT PRINT "The second parameter is not a valid WSAData type." CASE ELSE PRINT "Unknown error. Error code (if any): ", WSAGetLastError END SELECT SLEEP END END IF /' Even though we know that 2.0 (or higher) is supported, we will go ahead and check the highest version you have available. You may now use the returned values from MakeOurWSAData to pull up the highest available version of Winsock. '/ OurVersionMajor = LTRIM(STR(MakeOurWSAData.wHighVersion AND 255)) OurVersionMinor = LTRIM(STR(MakeOurWSAData.wHighVersion SHR 8)) WinsockVersion = "v" + OurVersionMajor + "." + OurVersionMinor END SUB