netmsg version 1.0 (Networked chat program)

User projects written in or related to FreeBASIC.
segin
Posts: 126
Joined: Dec 27, 2005 5:22
Contact:

netmsg version 1.0 (Networked chat program)

Post by segin »

I wrote a program called netmsg. Basically it's a small client-server instant messenger for use on any TCP/IP network.

some code from examples/Windows/winsock/clientserver in the FreeBASIC distribution.

I'm short on time, so here's the code:

netmsg.bi:

Code: Select all

'
' Protocol definition
'

#ifndef __NETMSG_BI__
#define __NESMSG_BI__ 1

Type proto
	Type As string * 5
	UName as string * 31
	Msg as string * 81
End Type 

' This only defined a header, but that's better than nothing.
' This will allow for a more flexible protocol that's more realistic
' yet still compatable in design as the original "block" protocol.
' The main problem with the original proto is the implementation.
'
' The data packet must be sent in a single TCP/IP packet. 
' In the near future, I will design a "connectionless" server
' using datagrams over UDP/IP.
'

Type proto_ng
	Type As Integer
	User As Integer
	Msg As Integer
End Type

#define MAKEMSG(a0,a1,a2,a3) asc(a0) + asc(a1) shl 8 + asc(a2) shl 16 + asc(a3) shl 24

const SERVER_MSG_HELLO	= MAKEMSG( "H", "E", "L", "O" )
const SERVER_MSG_SUP	= MAKEMSG( "S", "U", "P", "!" )
const SERVER_MSG_CHAT	= MAKEMSG( "C", "H", "A", "T" )
const SERVER_MSG_BYE	= MAKEMSG( "B", "Y", "E", "!" )
const SERVER_MSG_CYA	= MAKEMSG( "C", "Y", "A", "!" )

#endif 
serv.bas:

Code: Select all

'
' Network messaging server.
' Copyright (C) 2007, Segin<segin2005@gmail.com>
'
' Licensed under the GPLv2
'
' Beware, heavy wizardry at work!
'

#include once "netmsg.bi"

#include once "windows.bi"
#include "win/winsock2.bi"
#ifdef __FB_DOS__
#error "Please provide info on Waterloo TCP/IP to maintainer"
#endif
#ifdef __FB_LINUX__
#include once "netinet/in.bi"
#include once "arpa/inet.bi"
#endif 

#ifdef __FB_WIN32__
function hStart( byval verhigh as integer = 2, byval verlow as integer = 0 ) as integer
	dim wsaData as WSAData
	
	if( WSAStartup( MAKEWORD( verhigh, verlow ), @wsaData ) <> 0 ) then
		return FALSE
	end if
	
	if( wsaData.wVersion <> MAKEWORD( verhigh, verlow ) ) then
		WSACleanup( )	
		return FALSE
	end if
	
	function = TRUE

end function
function hShutdown( ) as integer

	function = WSACleanup( )
	
end function
#define hPrintError(e) print "error calling "; #e; ": "; WSAGetLastError( )

#endif
#ifdef __FB_LINUX__
'
' Linux does NOT need socket library inits, unlike Windows...
'
function hStart() as integer
	return TRUE
end function

function hShutdown() as Integer
	return hStart()
end function
#define hPrintError(e) print "error calling "; #e; ": "; perror(#e)
#endif
function hResolve( byval hostname as string ) as integer
	dim ia as in_addr
	dim hostentry as hostent ptr

	'' check if it's an ip address
	ia.S_addr = inet_addr( hostname )
	if ( ia.S_addr = INADDR_NONE ) then
		
		'' if not, assume it's a name, resolve it
		hostentry = gethostbyname( hostname )
		if ( hostentry = 0 ) then
			exit function
		end if
		
		function = *cast( integer ptr, *hostentry->h_addr_list )
		
	else
	
		'' just return the address
		function = ia.S_addr
	
	end if
	
end function

'':::::
function hOpen( byval proto as integer = IPPROTO_TCP ) as SOCKET
	dim s as SOCKET
    
    s = opensocket( AF_INET, SOCK_STREAM, proto )
    if( s = NULL ) then
		return NULL
	end if
	
	function = s
	
end function

'':::::
function hConnect( byval s as SOCKET, byval ip as integer, byval port as integer ) as integer
	dim sa as sockaddr_in

	sa.sin_port			= htons( port )
	sa.sin_family		= AF_INET
	sa.sin_addr.S_addr	= ip
	
	function = connect( s, cast( PSOCKADDR, @sa ), len( sa ) ) <> SOCKET_ERROR
	
end function

'':::::
function hBind( byval s as SOCKET, byval port as integer ) as integer
	dim sa as sockaddr_in

	sa.sin_port			= htons( port )
	sa.sin_family		= AF_INET
	sa.sin_addr.S_addr	= INADDR_ANY 
	
	function = bind( s, cast( PSOCKADDR, @sa ), len( sa ) ) <> SOCKET_ERROR
	
end function

'':::::
function hListen( byval s as SOCKET, byval timeout as integer = SOMAXCONN ) as integer
	
	function = listen( s, timeout ) <> SOCKET_ERROR
	
end function

'':::::
function hAccept( byval s as SOCKET, byval sa as sockaddr_in ptr ) as SOCKET
	dim salen as integer 
	
	salen = len( sockaddr_in )
	function = accept( s, cast( PSOCKADDR, sa ), @salen )

end function	

'':::::
function hClose( byval s as SOCKET ) as integer

	shutdown( s, 2 )
	
	function = closesocket( s )
	
end function

'':::::
function hSend( byval s as SOCKET, byval buffer as zstring ptr, byval bytes as integer ) as integer

    function = send( s, buffer, bytes, 0 )
    
end function

'':::::
function hReceive( byval s as SOCKET, byval buffer as zstring ptr, byval bytes as integer ) as integer

    function = recv( s, buffer, bytes, 0 )
    
end function

'':::::
function hIp2Addr( byval ip as integer ) as zstring ptr
	dim ia as in_addr
	
	ia.S_addr = ip
	
	function = inet_ntoa( ia )

end function

#define CLIENTADDR(c) *hIp2Addr( c.sin_addr.S_addr ) & "(" & c.sin_addr & ")"


Dim shared sock As SOCKET
Dim ret As Integer
Dim Shared user As ZString * 30
Dim shared packet as Proto
Dim msg As ZString * 80
Dim shared sa As sockaddr_in
Dim shared s As SOCKET
Dim char As Byte
Dim shared nick As String
Dim Shared Connected As Integer
Dim Threads(2) as Any Ptr 
Dim Shared Running As Integer
Dim Shared mutex As Any Ptr

const SERVER_PORT = 1337

cls
 
function serverIni( ) as integer

	'' start winsock
	if( hStart( ) = FALSE ) then
		hPrintError( hStart )
		return FALSE
	end if
	
	'' create a socket for listening
	sock = hOpen( )
	if( sock = NULL ) then
		hPrintError( hOpen )
		return FALSE
	end if
	
	'' bind it to the server port
	if( hBind( sock, SERVER_PORT ) = FALSE ) then
		hPrintError( hBind )
		return FALSE
	end if	
	
	function = TRUE
	
end function

function GetString(Prompt As String = "> ") As String
	Dim char As Byte
	Dim Path As String
	Dim X As Integer
	Dim Y As Integer
	Dim TY as Integer
	Dim TX As Integer
	MutexLock(mutex)
	X = CsrLin()
	Y = Pos()
	Locate 1,1
	Print Space(80);
	Locate 1,1
	Print Prompt;
	MutexUnlock(mutex)
	do while char <> 13
	char = Asc(inkey$)
	if char > 31 And char < 127 then 
		If Len(Path) = 79 Then Goto StartScreenUpdate
		If Len(Path) > 79 Then Path = Left(Path,79)
		Path+=Chr(char)
		Goto StartScreenUpdate
	end if 
	if char = 8 Then
		Path = Left(Path, Len(Path) - 1)
		Goto StartScreenUpdate
	End If
	
	StartScreenUpdate:
	MutexLock(mutex)
		' Screenlock to prevent flicker
		' Useless in console modes
		ScreenLock
			Locate 1,1
			Print Space(80);
			Locate 1,1
			Print Prompt;
			Locate 1,1+Len(Prompt)
			Print Right(Path,80 - Len(Prompt));
		ScreenUnlock
	EndScreenUpdate:
	TY = Pos()
	TX = CsrLin() 
	Locate X, Y
	sleep 50
	X = CsrLin
	Y = Pos()
	Locate TX, TY
	MutexUnlock(mutex)
	loop
	Locate 1,1
	Print Space(80);
	Locate X, Y
	Return Path
End Function

Sub Quit(ret As Integer = 0)
	MutexDestroy(mutex)
	End ret
End Sub

Sub UpdateStatusBar() 
	MutexLock(mutex)
	Dim X As Integer
	Dim Y As Integer
	X = CsrLin()
	Y = Pos()
	Locate 2,1
	Color 0,7
	Print Space(80)
	Locate 2,2
	Print "-- Connection from " + *hIp2Addr( sa.sin_addr.S_addr ) + " (" + nick + ") [server] --"
	Color 7,0
	Locate X, Y
	MutexUnlock(mutex)
End Sub

Color 7,0
mutex = MutexCreate
Running = 1
ret = serverIni( )
if ret = FALSE then
	print "Error in netmsgd server init"
	hShutdown
	Quit
end if
if( hListen( sock ) = FALSE ) then
	hPrintError( hListen )
	hShutdown
	Quit FALSE
end if

locate 3,1
UpdateStatusBar() 

Nickname:
Print "Please enter a nick." 
msg = GetString("nick> ")
nick = Left(msg,30)
if Len(nick) = 0 goto Nickname
UpdateStatusBar() 
Print "Using nickname " + nick
print "Waiting for connection on port 1337"

s = hAccept( sock, @sa )
if( s = INVALID_SOCKET ) then
	hPrintError( hAccept )
end if
UpdateStatusBar() 
print "Connection from " + *hIp2Addr( sa.sin_addr.S_addr ) + "(" &  sa.sin_port & ")"
Connected = 1

Sub SendMsg(mType As String, msg As String)
	MutexLock(mutex)
	If Len(msg) = 0 Then Exit Sub
	packet.msg = msg
	packet.type = mType
	packet.uname = Cast(String, Left(Nick,30))
	hSend(s, @packet, Sizeof(packet))
	Color 2 
	if mType = "CHAT" then
		Print packet.uname + ": " + packet.msg
	End If
	color 7
	MutexUnlock(mutex)
	UpdateStatusBar() 
End Sub

Sub RecvThread()
	Dim msg As Proto
	Dim bytes As Integer
	Dim msgType As String
	Dim msgUser As String
	Dim msgMsg As String
	Dim i as Integer
	Do
	bytes = hReceive( s, @packet, Sizeof(packet) )
	msgUser = Str(bytes)
	if bytes <> Sizeof(packet) Then 
		If bytes = -1 Or bytes = 0 Then
			'Server has died without telling us.
			print "Connection closed by client."
			Connected = 0
			cls
			hShutdown
			quit		
			Goto EndThread	
		End If
		print "hRecieve() returned " & bytes & " bytes."
		Goto EndRecv
	End If
	Select Case packet.type
		Case "CHAT"
			' This is the only screen operation IN threaded section
			' of program execution in which locking mutex = bad stuff
			Color 6 
			Print packet.uNAME + ": " + packet.msg
			color 7
			UpdateStatusBar() 
		Case "BYE!" 
			SendMsg("CYA!","server to client: clear to disconnect.")
			Connected = 0
			cls
			hShutdown
			quit
			Goto EndThread	
		Case else
			print !"Unknown packet type:\"" + packet.type + !"\"." 
			Print "Sizeof(packet) = " & Sizeof(packet) & ", bytes = " & bytes
			Sleep(1)
		
	End Select 
	EndRecv:
	Loop	
	EndThread:
	Running = 0	
End Sub


Threads(2) = ThreadCreate(@RecvThread)

Do While Connected
msg = GetString
if Left(msg, 5) = "/quit" Then 
	SendMsg("CYA!","server to client: please disconnect now.") 
	Connected = 0
	Goto EndSend
End If
If Len(msg) > 1 Then
	SendMsg("CHAT", msg)
End If
EndSend:
Loop
Running = 0
hClose(s)
hClose(sock)
hShutdown()
cls
quit
client.bas:

Code: Select all

'
' Network messaging client.
' Copyright (C) 2007, Segin<segin2005@gmail.com>
'
' Licensed under the GPLv2
'
' Beware, heavy wizardry at work!
'

#include once "netmsg.bi"

#include "win/winsock2.bi"
#ifdef __FB_DOS__
#error "Please provide info on Waterloo TCP/IP to maintainer"
#endif
#ifdef __FB_LINUX__
#include once "netinet/in.bi"
#include once "arpa/inet.bi"
#endif 

#ifdef __FB_WIN32__
function hStart( byval verhigh as integer = 2, byval verlow as integer = 0 ) as integer
	dim wsaData as WSAData
	
	if( WSAStartup( MAKEWORD( verhigh, verlow ), @wsaData ) <> 0 ) then
		return FALSE
	end if
	
	if( wsaData.wVersion <> MAKEWORD( verhigh, verlow ) ) then
		WSACleanup( )	
		return FALSE
	end if
	
	function = TRUE

end function
function hShutdown( ) as integer

	function = WSACleanup( )
	
end function
#define hPrintError(e) print "error calling "; #e; ": "; WSAGetLastError( )

#endif
#ifdef __FB_LINUX__
'
' Linux does NOT need socket library inits, unlike Windows...
'
function hStart() as integer
	return TRUE
end function

function hShutdown() as Integer
	return hStart()
end function
#define hPrintError(e) print "error calling "; #e; ": "; perror(#e)
#endif
function hResolve( byval hostname as string ) as integer
	dim ia as in_addr
	dim hostentry as hostent ptr

	'' check if it's an ip address
	ia.S_addr = inet_addr( hostname )
	if ( ia.S_addr = INADDR_NONE ) then
		
		'' if not, assume it's a name, resolve it
		hostentry = gethostbyname( hostname )
		if ( hostentry = 0 ) then
			exit function
		end if
		
		function = *cast( integer ptr, *hostentry->h_addr_list )
		
	else
	
		'' just return the address
		function = ia.S_addr
	
	end if
	
end function

'':::::
function hOpen( byval proto as integer = IPPROTO_TCP ) as SOCKET
	dim s as SOCKET
    
    s = opensocket( AF_INET, SOCK_STREAM, proto )
    if( s = NULL ) then
		return NULL
	end if
	
	function = s
	
end function

'':::::
function hConnect( byval s as SOCKET, byval ip as integer, byval port as integer ) as integer
	dim sa as sockaddr_in

	sa.sin_port			= htons( port )
	sa.sin_family		= AF_INET
	sa.sin_addr.S_addr	= ip
	
	function = connect( s, cast( PSOCKADDR, @sa ), len( sa ) ) <> SOCKET_ERROR
	
end function

'':::::
function hBind( byval s as SOCKET, byval port as integer ) as integer
	dim sa as sockaddr_in

	sa.sin_port			= htons( port )
	sa.sin_family		= AF_INET
	sa.sin_addr.S_addr	= INADDR_ANY 
	
	function = bind( s, cast( PSOCKADDR, @sa ), len( sa ) ) <> SOCKET_ERROR
	
end function

'':::::
function hListen( byval s as SOCKET, byval timeout as integer = SOMAXCONN ) as integer
	
	function = listen( s, timeout ) <> SOCKET_ERROR
	
end function

'':::::
function hAccept( byval s as SOCKET, byval sa as sockaddr_in ptr ) as SOCKET
	dim salen as integer 
	
	salen = len( sockaddr_in )
	function = accept( s, cast( PSOCKADDR, sa ), @salen )

end function	

'':::::
function hClose( byval s as SOCKET ) as integer

	shutdown( s, 2 )
	
	function = closesocket( s )
	
end function

'':::::
function hSend( byval s as SOCKET, byval buffer as zstring ptr, byval bytes as integer ) as integer

    function = send( s, buffer, bytes, 0 )
    
end function

'':::::
function hReceive( byval s as SOCKET, byval buffer as zstring ptr, byval bytes as integer ) as integer

    function = recv( s, buffer, bytes, 0 )
    
end function

'':::::
function hIp2Addr( byval ip as integer ) as zstring ptr
	dim ia as in_addr
	
	ia.S_addr = ip
	
	function = inet_ntoa( ia )

end function

#define CLIENTADDR(c) *hIp2Addr( c.sin_addr.S_addr ) & "(" & c.sin_addr & ")"


Dim shared sock As SOCKET
Dim ret As Integer
Dim Shared user As ZString * 30
Dim shared packet as Proto
Dim msg As ZString * 80
Dim shared sa As sockaddr_in
Dim shared s As SOCKET
Dim char As Byte
Dim shared nick As String
Dim Shared Connected As Integer
Dim Threads(2) as Any Ptr 
Dim Shared Running As Integer
Dim Shared serv As String * 60
Dim Shared mutex As Any Ptr

const SERVER_PORT = 1337

serv = "0.0.0.0"

cls
 
function clientIni( ) as integer

	'' start winsock
	if( hStart( ) = FALSE ) then
		hPrintError( hStart )
		return FALSE
	end if
	
	'' create a socket for a connection
	sock = hOpen( )
	if( sock = NULL ) then
		hPrintError( hOpen )
		return FALSE
	end if
	
	function = TRUE
	
end function

function GetString(Prompt As String = "> ") As String
	Dim char As Byte
	Dim Path As String
	Dim X As Integer
	Dim Y As Integer
	Dim TY as Integer
	Dim TX as Integer
	MutexLock(mutex)
	X = CsrLin()
	Y = Pos()
	Locate 1,1
	Print Space(80);
	Locate 1,1
	Print Prompt;
	MutexUnlock(mutex)
	do while char <> 13
	char = Asc(inkey$)
	if char > 31 And char < 127 then 
		If Len(Path) = 79 Then Goto StartScreenUpdate
		If Len(Path) > 79 Then Path = Left(Path,79)
		Path+=Chr(char)
		Goto StartScreenUpdate
	end if 
	if char = 8 Then
		Path = Left(Path, Len(Path) - 1)
		Goto StartScreenUpdate
	End If
	
	StartScreenUpdate:
	MutexLock(mutex)
		' Screenlock to prevent flicker
		' Useless in console modes
		ScreenLock
			Locate 1,1
			Print Space(80);
			Locate 1,1
			Print Prompt;
			Locate 1,1+Len(Prompt)
			Print Right(Path,80 - Len(Prompt));
		ScreenUnlock
	EndScreenUpdate:
	TY = Pos()
	TX = CsrLin() 
	Locate X, Y
	sleep 50 
	X = CsrLin
	Y = Pos()
	Locate TX, TY
	MutexUnlock(mutex)
	loop
	Locate 1,1
	Print Space(80);
	Locate X, Y
	Return Path
End Function

Sub Quit(ret As Integer = 0)
	MutexDestroy(mutex)
	End ret
End Sub

Sub UpdateStatusBar() 
	MutexLock(mutex)
	Dim X As Integer
	Dim Y As Integer
	X = CsrLin()
	Y = Pos()
	Locate 2,1
	Color 0,7
	Print Space(80)
	Locate 2,2
	Print "-- Connected to " + serv + " (" + nick + ") [client] --"
	Color 7,0
	Locate X, Y
	MutexUnlock(mutex)
End Sub

Color 7,0
mutex = MutexCreate
Running = 1
ret = clientIni( )
if ret = FALSE then
	print "Error in netmsg client init"
	hShutdown
	Quit(FALSE)	
end if


locate 3,1
UpdateStatusBar() 
Nickname:
Print "Please enter a nick." 
msg = GetString("nick> ")
nick = Left(msg,30)
if Len(nick) = 0 goto Nickname
UpdateStatusBar() 
Print "Using nickname " + nick
Print "Please enter the server address (IP or hostname)"
serv = Left(GetString("server> "),60)
UpdateStatusBar() 
print "Connecting to " +serv + " on port 1337"

if( hConnect( sock, hResolve( serv ), 1337 ) = FALSE ) then
	hPrintError( hConnect )
	quit
end if

print "Connected to " + serv + "(" &  1337 & ")"
Connected = 1

Sub SendMsg(mType As String, msg As String)
	MutexLock(mutex)
	If Len(msg) = 0 Then Exit Sub
	packet.msg = msg
	packet.type = "CHAT"
	packet.uname = Cast(String, Left(Nick,30))
	hSend(sock, @packet, Sizeof(packet))
	Color 2 
	if mType = "CHAT" then
		Print packet.uname + ": " + packet.msg
	End If
	color 7
	MutexUnlock(mutex)
	UpdateStatusBar() 
End Sub

Sub RecvThread()
	Dim msg As Proto
	Dim bytes As Integer
	Dim msgType As String
	Dim msgUser As String
	Dim msgMsg As String
	Dim i as Integer
	Do
	msgType = "" : msgUser = "" : msgMsg = ""
	bytes = hReceive( sock, @packet, Sizeof(packet) )
	if bytes <> Sizeof(packet) Then 
		If bytes = -1 Or bytes = 0 Then
			'Server has died without telling us.
			print serv +": Connection closed by remote host."
			Connected = 0
			cls
			hShutdown
			quit
			Goto EndThread	
		End If
		print "hRecieve() returned " & bytes & " bytes."
		Goto EndRecv
	End If
	Select Case packet.type
		Case "CHAT"
			Color 6
			Print packet.uNAME + ": " + packet.msg
			Color 7
			UpdateStatusBar() 
		Case "CYA!" 
			Connected = 0
			cls
			hShutdown
			quit
			Goto EndThread	
		Case else
			print !"Unknown packet type:\"" + packet.type + !"\"." 
			Print "Sizeof(packet) = " & Sizeof(packet) & ", bytes = " & bytes
			Sleep(1)
		
	End Select 
	EndRecv:
	Loop	
	EndThread:
	Running = 0	
End Sub

Threads(2) = ThreadCreate(@RecvThread)

Do While Connected
msg = GetString
if Left(msg, 5) = "/quit" Then 
	SendMsg("BYE!","client to server: request to disconnect.") 
	Sleep(4000)
	Goto EndSend
End If
If Len(msg) > 1 Then
	SendMsg("CHAT", msg)
End If
EndSend:
Loop
Running = 0
hClose(s)
hClose(sock)
hShutdown()
cls
quit
README.txt:

Code: Select all

This is Netmsg version 1.0
============================

Netmsg is a two-way communications system that runs in a client-server fashion.
One machine run as the server, and another as a client. Netmsg is basically a
simple instant-messaging system.

The server will only handle one client. Any attempts to connect additional
clients will not work (they will connect, but the server has no means of 
attaching to them)

This program is currently Win32-specific, but would require VERY minor changes
for Linux support. There is no DOS support, but if I find a copy of the DOS
pthreads library, I might be able to convince the FreeBASIC maintainers to
use it for RTLib's DOS target. DOS support will also require Waterloo TCP.

This program is also very CPU and memory efficent. The total CPU usage 
for a 30 minute chat session (in seconds) is around 15 seconds for both 
client and server.

It might seem odd that the client and server act a lot alike. The client is
actually a modified version of the server's code.

To compile:

fbc serv.bas
fbc client.bas

RUNNING NETMSG
===========================

Netmsg is designed with a server-client model. Thus, the server machine must
be started before the client can connect. Please note that the client CAN
connect to the server as soon as it is started, but any messages sent by the
client to the server before the chat nickname is entered on the server are 
silently dropped. This is belived to be a bug in the server, but I don't feel
like fixing it.

BUG REPORTS
============================

Netmsg has a few graphical glitches at times, and most of the potential ones
are taken care of (prevented) by using mutexes and thread locking. On
occasion, the status bar will end up being shown twice, on the input entry 
line. This is not fatal, and will not affect the running of the program.

If something serious happens, please send a sensible and in-depth report to
segin2005@gmail.com. Send an email saying something "netmsg crashed, pls help"
tells me nothing. It's like finding a dead body. Sure, you know he's dead, but
you don't know how he died, or who you need to arrest for his murder, or even
if it was murder at all!


TEXT ENTRY (FOR ADVANCED USERS AND PROGRAMMERS)
============================

Netmsg uses a custom-made input entry loop. The loop is capable of managing
text slightly better than the traditional BASIC input statements, including
the ability to save the cursor position for incoming messages and restore it
after preforming the input check. Input is checked every 50 milliseconds. One
side effect of the save/restore of the cursor position is that the console 
caret will always appear in the message area. This can be confusing if you 
accidently type a space, and then leave your computer. It it probably possible
to emulate the proper cursor, it would probably break the code. If it ain't 
broke, don't fix it.
Please email me <segin2005@gmail.com> for prebuilt binaries.
Frank Dodd
Posts: 444
Joined: Mar 10, 2006 19:22

Post by Frank Dodd »

Great job with this its a good foundation for network chat in games, I have only run it connected though 'localhost' but it seamed to work well. Thanks for the sharing this.

Do you have any plans for it?
segin
Posts: 126
Joined: Dec 27, 2005 5:22
Contact:

Post by segin »

Plans? Clean up the source, for starters. Linux support, and I also plan on producing binaries for Win32, Linux, and FreeBSD. It will also support being used as a proxy by abusing the messaging protocol (each packet has a type, "CHAT" is messages, and "BACK" will be proxy, like BACKdoor or BACKbone)

If anyone is intrested, could you assist me with adding multiple client support?
segin
Posts: 126
Joined: Dec 27, 2005 5:22
Contact:

Updated code, Linux support

Post by segin »

At this time, I present netmsg version 1.01. Linux support is finished, and by proxy, so is FreeBSD.

serv.bas:

Code: Select all

'
' Network messaging server.
' Copyright (C) 2007, Segin<segin2005@gmail.com>
'
' Licensed under the GPLv2
'
' Beware, heavy wizardry at work!
'

#include once "netmsg.bi"

#ifdef __FB_WIN32__
#include "win/winsock2.bi"
#endif
#ifdef __FB_DOS__
#error "Please provide info on Waterloo TCP/IP to maintainer"
#endif
#if defined(__FB_LINUX__) or defined(__FB_FREEBSD__)
#include once "crt/netinet/in.bi"
#include once "crt/arpa/inet.bi"
#include once "crt/netdb.bi"
#include once "crt/sys/socket.bi"
#include once "crt/errno.bi"
#define TRUE	1
#define FALSE	0
'Linux console is not appropriate for attempting to get input due to
'the fact it is a data stream, and there's no API to get things like
'keycodes, only hacks. Pity.
'
'This does have advantages over Windows, though.
'gfxlib also supports the use of a framebuffer so X11 is not needed 
'to be running, only installed.
screen 12
#endif 
#ifdef __FB_WIN32__
function hStart( byval verhigh as integer = 2, byval verlow as integer = 0 ) as integer
	dim wsaData as WSAData
	
	if( WSAStartup( MAKEWORD( verhigh, verlow ), @wsaData ) <> 0 ) then
		return FALSE
	end if
	
	if( wsaData.wVersion <> MAKEWORD( verhigh, verlow ) ) then
		WSACleanup( )	
		return FALSE
	end if
	
	function = TRUE

end function
function hShutdown( ) as integer

	function = WSACleanup( )
	
end function
#define hPrintError(e) print "error calling "; #e; ": "; WSAGetLastError( )

#endif
#ifdef __FB_LINUX__
'
' Linux does NOT need socket library inits, unlike Windows...
'
function hStart() as integer
	return TRUE
end function

function hShutdown() as Integer
	return hStart()
end function
#define hPrintError(e) print "error calling "; #e; "."  
#endif
function hResolve( byval hostname as string ) as integer
	dim ia as in_addr
	dim hostentry as hostent ptr

	'' check if it's an ip address
	ia.S_addr = inet_addr( hostname )
	if ( ia.S_addr = INADDR_NONE ) then
		
		'' if not, assume it's a name, resolve it
		hostentry = gethostbyname( hostname )
		if ( hostentry = 0 ) then
			exit function
		end if
		
		function = *cast( integer ptr, *hostentry->h_addr_list )
		
	else
	
		'' just return the address
		function = ia.S_addr
	
	end if
	
end function

'':::::
function hOpen( byval proto as integer = IPPROTO_TCP ) as SOCKET
	dim s as SOCKET
    
    s = opensocket( AF_INET, SOCK_STREAM, proto )
    if( s = NULL ) then
		return NULL
	end if
	
	function = s
	
end function

'':::::
function hConnect( byval s as SOCKET, byval ip as integer, byval port as integer ) as integer
	dim sa as sockaddr_in

	sa.sin_port			= htons( port )
	sa.sin_family		= AF_INET
	sa.sin_addr.S_addr	= ip
	
	function = connect( s, cast( PSOCKADDR, @sa ), len( sa ) ) <> SOCKET_ERROR
	
end function

'':::::
function hBind( byval s as SOCKET, byval port as integer ) as integer
	dim sa as sockaddr_in

	sa.sin_port			= htons( port )
	sa.sin_family		= AF_INET
	sa.sin_addr.S_addr	= INADDR_ANY 
	
	function = bind( s, cast( PSOCKADDR, @sa ), len( sa ) ) <> SOCKET_ERROR
	
end function

'':::::
function hListen( byval s as SOCKET, byval timeout as integer = SOMAXCONN ) as integer
	
	function = listen( s, timeout ) <> SOCKET_ERROR
	
end function

'':::::
function hAccept( byval s as SOCKET, byval sa as sockaddr_in ptr ) as SOCKET
	dim salen as integer 
	
	salen = len( sockaddr_in )
	function = accept( s, cast( PSOCKADDR, sa ), @salen )

end function	

'':::::
function hClose( byval s as SOCKET ) as integer

	shutdown( s, 2 )
	
	#ifdef __FB_WIN32__
	function = closesocket( s )
	#endif
	#if defined(__FB_LINUX__) or defined(__FB_FREEBSD__)
	function = close(s)
	#endif
	
end function

'':::::
function hSend( byval s as SOCKET, byval buffer as zstring ptr, byval bytes as integer ) as integer

    function = send( s, buffer, bytes, 0 )
    
end function

'':::::
function hReceive( byval s as SOCKET, byval buffer as zstring ptr, byval bytes as integer ) as integer

    function = recv( s, buffer, bytes, 0 )
    
end function

'':::::
function hIp2Addr( byval ip as integer ) as zstring ptr
	dim ia as in_addr
	
	ia.S_addr = ip
	
	function = inet_ntoa( ia )

end function

#define CLIENTADDR(c) *hIp2Addr( c.sin_addr.S_addr ) & "(" & c.sin_addr & ")"


Dim shared sock As SOCKET
Dim ret As Integer
Dim Shared user As ZString * 30
Dim shared packet as Proto
Dim msg As ZString * 80
Dim shared sa As sockaddr_in
Dim shared s As SOCKET
Dim char As Byte
Dim shared nick As String
Dim Shared Connected As Integer
Dim Threads(2) as Any Ptr 
Dim Shared Running As Integer
Dim Shared mutex As Any Ptr

const SERVER_PORT = 1337

cls
 
function serverIni( ) as integer

	'' start winsock
	if( hStart( ) = FALSE ) then
		hPrintError( hStart )
		return FALSE
	end if
	
	'' create a socket for listening
	sock = hOpen( )
	if( sock = NULL ) then
		hPrintError( hOpen )
		return FALSE
	end if
	
	'' bind it to the server port
	if( hBind( sock, SERVER_PORT ) = FALSE ) then
		hPrintError( hBind )
		return FALSE
	end if	
	
	function = TRUE
	
end function

function GetString(Prompt As String = "> ") As String
	Dim char As Byte
	Dim Path As String
	Dim X As Integer
	Dim Y As Integer
	Dim TY as Integer
	Dim TX As Integer
	MutexLock(mutex)
	X = CsrLin()
	Y = Pos()
	Locate 1,1
	Print Space(80);
	Locate 1,1
	Print Prompt;
	MutexUnlock(mutex)
	do while char <> 13
	char = Asc(inkey$)
	if char > 31 And char < 127 then 
		If Len(Path) = 79 Then Goto StartScreenUpdate
		If Len(Path) > 79 Then Path = Left(Path,79)
		Path+=Chr(char)
		Goto StartScreenUpdate
	end if 
	if char = 8 Then
		Path = Left(Path, Len(Path) - 1)
		Goto StartScreenUpdate
	End If
	
	StartScreenUpdate:
	MutexLock(mutex)
		' Screenlock to prevent flicker
		' Useless in console modes
		ScreenLock
			Locate 1,1
			Print Space(80);
			Locate 1,1
			Print Prompt;
			Locate 1,1+Len(Prompt)
			Print Right(Path,80 - Len(Prompt));
		ScreenUnlock
	EndScreenUpdate:
	TY = Pos()
	TX = CsrLin() 
	Locate X, Y
	sleep 50
	X = CsrLin
	Y = Pos()
	Locate TX, TY
	MutexUnlock(mutex)
	loop
	Locate 1,1
	Print Space(80);
	Locate X, Y
	Return Path
End Function

Sub Quit(ret As Integer = 0)
	MutexDestroy(mutex)
	End ret
End Sub

Sub UpdateStatusBar() 
	MutexLock(mutex)
	Dim X As Integer
	Dim Y As Integer
	X = CsrLin()
	Y = Pos()
	Locate 2,1
	Color 0,7
	Print Space(80)
	Locate 2,2
	Print "-- Connection from " + *hIp2Addr( sa.sin_addr.S_addr ) + " (" + nick + ") [server] --"
	Color 7,0
	Locate X, Y
	MutexUnlock(mutex)
End Sub

Color 7,0
mutex = MutexCreate
Running = 1
ret = serverIni( )
if ret = FALSE then
	print "Error in netmsgd server init"
	hShutdown
	Quit
end if
if( hListen( sock ) = FALSE ) then
	hPrintError( hListen )
	hShutdown
	Quit FALSE
end if

locate 3,1
UpdateStatusBar() 

Nickname:
Print "Please enter a nick." 
msg = GetString("nick> ")
nick = Left(msg,30)
if Len(nick) = 0 goto Nickname
UpdateStatusBar() 
Print "Using nickname " + nick
print "Waiting for connection on port 1337"

s = hAccept( sock, @sa )
if( s = -1 ) then
	hPrintError( hAccept )
end if
UpdateStatusBar() 
print "Connection from " + *hIp2Addr( sa.sin_addr.S_addr ) + "(" &  sa.sin_port & ")"
Connected = 1

Sub SendProtoMsg(mType As String, msg As String)
	MutexLock(mutex)
	If Len(msg) = 0 Then Exit Sub
	packet.msg = msg
	packet.type = mType
	packet.uname = Cast(String, Left(Nick,30))
	hSend(s, @packet, Sizeof(packet))
	Color 2 
	if mType = "CHAT" then
		Print packet.uname + ": " + packet.msg
	End If
	color 7
	MutexUnlock(mutex)
	UpdateStatusBar() 
End Sub

Sub RecvThread()
	Dim msg As Proto
	Dim bytes As Integer
	Dim msgType As String
	Dim msgUser As String
	Dim msgMsg As String
	Dim i as Integer
	Do
	bytes = hReceive( s, @packet, Sizeof(packet) )
	msgUser = Str(bytes)
	if bytes <> Sizeof(packet) Then 
		If bytes = -1 Or bytes = 0 Then
			'Server has died without telling us.
			print "Connection closed by client."
			Connected = 0
			cls
			hShutdown
			quit		
			Goto EndThread	
		End If
		print "hRecieve() returned " & bytes & " bytes."
		Goto EndRecv
	End If
	Select Case packet.type
		Case "CHAT"
			' This is the only screen operation IN threaded section
			' of program execution in which locking mutex = bad stuff
			Color 6 
			Print packet.uNAME + ": " + packet.msg
			color 7
			UpdateStatusBar() 
		Case "BYE!" 
			SendProtoMsg("CYA!","server to client: clear to disconnect.")
			Connected = 0
			cls
			hShutdown
			quit
			Goto EndThread	
		Case else
			print !"Unknown packet type:\"" + packet.type + !"\"." 
			Print "Sizeof(packet) = " & Sizeof(packet) & ", bytes = " & bytes
			Sleep(1)
		
	End Select 
	EndRecv:
	Loop	
	EndThread:
	Running = 0	
End Sub


Threads(2) = ThreadCreate(@RecvThread)

Do While Connected
msg = GetString
if Left(msg, 5) = "/quit" Then 
	SendProtoMsg("CYA!","server to client: please disconnect now.") 
	Connected = 0
	Goto EndSend
End If
If Len(msg) > 1 Then
	SendProtoMsg("CHAT", msg)
End If
EndSend:
Loop
Running = 0
hClose(s)
hClose(sock)
hShutdown()
cls
quit
client.bas:

Code: Select all

'
' Network messaging client.
' Copyright (C) 2007, Segin<segin2005@gmail.com>
'
' Licensed under the GPLv2
'
' Beware, heavy wizardry at work!
'

#include once "netmsg.bi"

#ifdef __FB_WIN32__
#include "win/winsock2.bi"
#endif
#ifdef __FB_DOS__
#error "Please provide info on Waterloo TCP/IP to maintainer"
#endif
#if defined(__FB_LINUX__) or defined(__FB_FREEBSD__)
#include once "crt/netinet/in.bi"
#include once "crt/arpa/inet.bi"
#include once "crt/netdb.bi"
#include once "crt/sys/socket.bi"
#include once "crt/errno.bi"
#define TRUE	1
#define FALSE	0
screen 12
#endif 

#ifdef __FB_WIN32__
function hStart( byval verhigh as integer = 2, byval verlow as integer = 0 ) as integer
	dim wsaData as WSAData
	
	if( WSAStartup( MAKEWORD( verhigh, verlow ), @wsaData ) <> 0 ) then
		return FALSE
	end if
	
	if( wsaData.wVersion <> MAKEWORD( verhigh, verlow ) ) then
		WSACleanup( )	
		return FALSE
	end if
	
	function = TRUE

end function
function hShutdown( ) as integer

	function = WSACleanup( )
	
end function
#define hPrintError(e) print "error calling "; #e; ": "; WSAGetLastError( )

#endif
#ifdef __FB_LINUX__
'
' Linux does NOT need socket library inits, unlike Windows...
'
function hStart() as integer
	return TRUE
end function

function hShutdown() as Integer
	return hStart()
end function
#define hPrintError(e) print "error calling "; #e; "."  
#endif
function hResolve( byval hostname as string ) as integer
	dim ia as in_addr
	dim hostentry as hostent ptr

	'' check if it's an ip address
	ia.S_addr = inet_addr( hostname )
	if ( ia.S_addr = INADDR_NONE ) then
		
		'' if not, assume it's a name, resolve it
		hostentry = gethostbyname( hostname )
		if ( hostentry = 0 ) then
			exit function
		end if
		
		function = *cast( integer ptr, *hostentry->h_addr_list )
		
	else
	
		'' just return the address
		function = ia.S_addr
	
	end if
	
end function

'':::::
function hOpen( byval proto as integer = IPPROTO_TCP ) as SOCKET
	dim s as SOCKET
    
    s = opensocket( AF_INET, SOCK_STREAM, proto )
    if( s = NULL ) then
		return NULL
	end if
	
	function = s
	
end function

'':::::
function hConnect( byval s as SOCKET, byval ip as integer, byval port as integer ) as integer
	dim sa as sockaddr_in

	sa.sin_port			= htons( port )
	sa.sin_family		= AF_INET
	sa.sin_addr.S_addr	= ip
	
	function = connect( s, cast( PSOCKADDR, @sa ), len( sa ) ) <> SOCKET_ERROR
	
end function

'':::::
function hBind( byval s as SOCKET, byval port as integer ) as integer
	dim sa as sockaddr_in

	sa.sin_port			= htons( port )
	sa.sin_family		= AF_INET
	sa.sin_addr.S_addr	= INADDR_ANY 
	
	function = bind( s, cast( PSOCKADDR, @sa ), len( sa ) ) <> SOCKET_ERROR
	
end function

'':::::
function hListen( byval s as SOCKET, byval timeout as integer = SOMAXCONN ) as integer
	
	function = listen( s, timeout ) <> SOCKET_ERROR
	
end function

'':::::
function hAccept( byval s as SOCKET, byval sa as sockaddr_in ptr ) as SOCKET
	dim salen as integer 
	
	salen = len( sockaddr_in )
	function = accept( s, cast( PSOCKADDR, sa ), @salen )

end function	

'':::::
function hClose( byval s as SOCKET ) as integer

	shutdown( s, 2 )
	
	#ifdef __FB_WIN32__
	function = closesocket( s )
	#endif
	#if defined(__FB_LINUX__) or defined(__FB_FREEBSD__)
	function = close(s)
	#endif
	
end function

'':::::
function hSend( byval s as SOCKET, byval buffer as zstring ptr, byval bytes as integer ) as integer

    function = send( s, buffer, bytes, 0 )
    
end function

'':::::
function hReceive( byval s as SOCKET, byval buffer as zstring ptr, byval bytes as integer ) as integer

    function = recv( s, buffer, bytes, 0 )
    
end function

'':::::
function hIp2Addr( byval ip as integer ) as zstring ptr
	dim ia as in_addr
	
	ia.S_addr = ip
	
	function = inet_ntoa( ia )

end function

#define CLIENTADDR(c) *hIp2Addr( c.sin_addr.S_addr ) & "(" & c.sin_addr & ")"


Dim shared sock As SOCKET
Dim ret As Integer
Dim Shared user As ZString * 30
Dim shared packet as Proto
Dim msg As ZString * 80
Dim shared sa As sockaddr_in
Dim shared s As SOCKET
Dim char As Byte
Dim shared nick As String
Dim Shared Connected As Integer
Dim Threads(2) as Any Ptr 
Dim Shared Running As Integer
Dim Shared serv As String * 60
Dim Shared mutex As Any Ptr

const SERVER_PORT = 1337

serv = "0.0.0.0"

cls
 
function clientIni( ) as integer

	'' start winsock
	if( hStart( ) = FALSE ) then
		hPrintError( hStart )
		return FALSE
	end if
	
	'' create a socket for a connection
	sock = hOpen( )
	if( sock = NULL ) then
		hPrintError( hOpen )
		return FALSE
	end if
	
	function = TRUE
	
end function

function GetString(Prompt As String = "> ") As String
	Dim char As Byte
	Dim Path As String
	Dim X As Integer
	Dim Y As Integer
	Dim TY as Integer
	Dim TX as Integer
	MutexLock(mutex)
	X = CsrLin()
	Y = Pos()
	Locate 1,1
	Print Space(80);
	Locate 1,1
	Print Prompt;
	MutexUnlock(mutex)
	do while char <> 13
	char = Asc(inkey$)
	if char > 31 And char < 127 then 
		If Len(Path) = 79 Then Goto StartScreenUpdate
		If Len(Path) > 79 Then Path = Left(Path,79)
		Path+=Chr(char)
		Goto StartScreenUpdate
	end if 
	if char = 8 Then
		Path = Left(Path, Len(Path) - 1)
		Goto StartScreenUpdate
	End If
	
	StartScreenUpdate:
	MutexLock(mutex)
		' Screenlock to prevent flicker
		' Useless in console modes
		ScreenLock
			Locate 1,1
			Print Space(80);
			Locate 1,1
			Print Prompt;
			Locate 1,1+Len(Prompt)
			Print Right(Path,80 - Len(Prompt));
		ScreenUnlock
	EndScreenUpdate:
	TY = Pos()
	TX = CsrLin() 
	Locate X, Y
	sleep 50 
	X = CsrLin
	Y = Pos()
	Locate TX, TY
	MutexUnlock(mutex)
	loop
	Locate 1,1
	Print Space(80);
	Locate X, Y
	Return Path
End Function

Sub Quit(ret As Integer = 0)
	MutexDestroy(mutex)
	End ret
End Sub

Sub UpdateStatusBar() 
	MutexLock(mutex)
	Dim X As Integer
	Dim Y As Integer
	X = CsrLin()
	Y = Pos()
	Locate 2,1
	Color 0,7
	Print Space(80)
	Locate 2,2
	Print "-- Connected to " + serv + " (" + nick + ") [client] --"
	Color 7,0
	Locate X, Y
	MutexUnlock(mutex)
End Sub

Color 7,0
mutex = MutexCreate
Running = 1
ret = clientIni( )
if ret = FALSE then
	print "Error in netmsg client init"
	hShutdown
	Quit(FALSE)	
end if


locate 3,1
UpdateStatusBar() 
Nickname:
Print "Please enter a nick." 
msg = GetString("nick> ")
nick = Left(msg,30)
if Len(nick) = 0 goto Nickname
UpdateStatusBar() 
Print "Using nickname " + nick
Print "Please enter the server address (IP or hostname)"
serv = Left(GetString("server> "),60)
UpdateStatusBar() 
print "Connecting to " +serv + " on port 1337"

if( hConnect( sock, hResolve( serv ), 1337 ) = FALSE ) then
	hPrintError( hConnect )
	quit
end if

print "Connected to " + serv + "(" &  1337 & ")"
Connected = 1

Sub SendProtoMsg(mType As String, msg As String)
	MutexLock(mutex)
	If Len(msg) = 0 Then Exit Sub
	packet.msg = msg
	packet.type = "CHAT"
	packet.uname = Cast(String, Left(Nick,30))
	hSend(sock, @packet, Sizeof(packet))
	Color 2 
	if mType = "CHAT" then
		Print packet.uname + ": " + packet.msg
	End If
	color 7
	MutexUnlock(mutex)
	UpdateStatusBar() 
End Sub

Sub RecvThread()
	Dim msg As Proto
	Dim bytes As Integer
	Dim msgType As String
	Dim msgUser As String
	Dim msgMsg As String
	Dim i as Integer
	Do
	msgType = "" : msgUser = "" : msgMsg = ""
	bytes = hReceive( sock, @packet, Sizeof(packet) )
	if bytes <> Sizeof(packet) Then 
		If bytes = -1 Or bytes = 0 Then
			'Server has died without telling us.
			print serv +": Connection closed by remote host."
			Connected = 0
			cls
			hShutdown
			quit
			Goto EndThread	
		End If
		print "hRecieve() returned " & bytes & " bytes."
		Goto EndRecv
	End If
	Select Case packet.type
		Case "CHAT"
			Color 6
			Print packet.uNAME + ": " + packet.msg
			Color 7
			UpdateStatusBar() 
		Case "CYA!" 
			Connected = 0
			cls
			hShutdown
			quit
			Goto EndThread	
		Case else
			print !"Unknown packet type:\"" + packet.type + !"\"." 
			Print "Sizeof(packet) = " & Sizeof(packet) & ", bytes = " & bytes
			Sleep(1)
		
	End Select 
	EndRecv:
	Loop	
	EndThread:
	Running = 0	
End Sub

Threads(2) = ThreadCreate(@RecvThread)

Do While Connected
msg = GetString
if Left(msg, 5) = "/quit" Then 
	SendProtoMsg("BYE!","client to server: request to disconnect.") 
	Sleep(4000)
	Goto EndSend
End If
If Len(msg) > 1 Then
	SendProtoMsg("CHAT", msg)
End If
EndSend:
Loop
Running = 0
hClose(s)
hClose(sock)
hShutdown()
cls
quit
netmsg.bi:

Code: Select all

'
' Protocol definition
'

#ifndef __NETMSG_BI__
#define __NESMSG_BI__ 1

Type proto
	Type As string * 5
	UName as string * 31
	Msg as string * 81
End Type 

' This only defined a header, but that's better than nothing.
' This will allow for a more flexible protocol that's more realistic
' yet still compatable in design as the original "block" protocol.
' The main problem with the original proto is the implementation.
'
' The data packet must be sent in a single TCP/IP packet. 
' In the near future, I will design a "connectionless" server
' using datagrams over UDP/IP.
'

Type proto_ng
	Type As Integer
	User As Integer
	Msg As Integer
End Type

#define MAKEMSG(a0,a1,a2,a3) asc(a0) + asc(a1) shl 8 + asc(a2) shl 16 + asc(a3) shl 24

const SERVER_MSG_HELLO	= MAKEMSG( "H", "E", "L", "O" )
const SERVER_MSG_SUP	= MAKEMSG( "S", "U", "P", "!" )
const SERVER_MSG_CHAT	= MAKEMSG( "C", "H", "A", "T" )
const SERVER_MSG_BYE	= MAKEMSG( "B", "Y", "E", "!" )
const SERVER_MSG_CYA	= MAKEMSG( "C", "Y", "A", "!" )
const SERVER_BACKEND	= MAKEMSG( "B", "A", "C", "K" )

#endif 
1.02 will be available tomorrow after I finish cleaning it up a bit.
notthecheatr
Posts: 1759
Joined: May 23, 2007 21:52
Location: Cut Bank, MT
Contact:

Post by notthecheatr »

Tip: It would be helpful if you put it all in a ZIP and put it somewhere we could download. If you don't have a webhost, it would probably be good to get one - phatc0de.net is nice.
inded005
Posts: 126
Joined: Jan 04, 2006 5:43
Location: Kingaroy Australia

Post by inded005 »

this is basically the same as the example provide in the freebasic download.
...i'm ironing out bugs in my mic networking chat prog using the same example as a base.
Loe
Posts: 323
Joined: Apr 30, 2006 14:49

Post by Loe »

Hi segin,
Currently I writting an anonymous LAN ChatWare with Freebasic.
It featured:
-Group chat, use udp multicast
-Private chat, use udp
-file transfer, use udp with custom protocol

but I have a problem with big size file in a poor network environment.
I want to change private chat & file transfer protocol to TCP, but dont know how to write it in FreeBasic.
I tried to use Chaos Chisock but still dont have any idea how to useit as file transfer.

Can you or anyone helpme how to send file with TCP? or how to use Chisock.
Any help would be appreciated.
segin
Posts: 126
Joined: Dec 27, 2005 5:22
Contact:

Post by segin »

Loe wrote:Hi segin,
Currently I writting an anonymous LAN ChatWare with Freebasic.
It featured:
-Group chat, use udp multicast
-Private chat, use udp
-file transfer, use udp with custom protocol

but I have a problem with big size file in a poor network environment.
I want to change private chat & file transfer protocol to TCP, but dont know how to write it in FreeBasic.
I tried to use Chaos Chisock but still dont have any idea how to useit as file transfer.

Can you or anyone helpme how to send file with TCP? or how to use Chisock.
Any help would be appreciated.
Copying files via TCP isn't hard. You just send the file as chunks.

First, send a integer number that specifies the number of file bytes that come next, then send EXACTLY that many bytes of the file, and repeat. You might want to create a "magic" and a checksum for your packets.

Example:

Type packet
magic As String * 4 = "FILE"
len As Integer
data As Any Ptr
End Type

packet.data would be the actual file data, and it can be of any length. I suggest using CRT function fopen/
fread/fwrite with this.
segin
Posts: 126
Joined: Dec 27, 2005 5:22
Contact:

Post by segin »

inded005 wrote:this is basically the same as the example provide in the freebasic download.
...i'm ironing out bugs in my mic networking chat prog using the same example as a base.
No, it uses some of the code from that example, but only some, and most of the mechanisms are written from scratch.
Loe
Posts: 323
Joined: Apr 30, 2006 14:49

Post by Loe »

thx Segin,
cause there is Chisock already, I just dont want reinvent the wheel.
if we see internal code of chisock,
it already threaded with the chunk size of 1K (if Im not wrong)
your suggestion about send integer first before send actual string worked but only for small size string, say about 100KB.
If we send say 100MB string it will eat PC resource and make PC so slow. The data transfer become unpredictable.

Can you explain your chunk and magic with the code?
just for the file transfer.
segin
Posts: 126
Joined: Dec 27, 2005 5:22
Contact:

Post by segin »

If we send say 100MB string it will eat PC resource and make PC so slow. The data transfer become unpredictable.
Why would anyone want to send a 100MB string? Even for file transfers, it would be logical to send small, sequenced packets each containing a small chunk of the original file.
Loe
Posts: 323
Joined: Apr 30, 2006 14:49

Post by Loe »

it take sooo looong to get answer ^_^

yupz, it is for file transfer
Can you explain your chunk and magic with the code?
just for the file transfer.
currently im still using multicast UDP, both for message and file transfer.
cause i still got no idea how to make it with TCP.
segin
Posts: 126
Joined: Dec 27, 2005 5:22
Contact:

Post by segin »

Loe wrote:it take sooo looong to get answer ^_^

yupz, it is for file transfer
Can you explain your chunk and magic with the code?
just for the file transfer.
currently im still using multicast UDP, both for message and file transfer.
cause i still got no idea how to make it with TCP.
I use TCP because I have no idea how to do it with UDP.

By the way, my system is not a multiuser relay (i.e. not a chat room), instead it is more like an IM. To get chatroom-like functionality using TCP, you need a server that relays (repeats) any message sent to it to EVERY OTHER connected client. This means managing connected clients and having a way to make sure you don't send the data back to the original client (unless you want to for verification purposes)

Hit me up on IRC, irc.oftc.net #interix if you want to discuss. Note that I haven't played with the source to this (and right now I am trying to recover the source, the fscking filesystem gor corrupted, a rather evolved version with single-source for both client and server and the beginnings of VoIP might be lost forever)
kiyotewolf
Posts: 1009
Joined: Oct 11, 2008 7:42
Location: ABQ, NM
Contact:

Post by kiyotewolf »

...
Last edited by kiyotewolf on Jan 09, 2011 20:26, edited 1 time in total.
segin
Posts: 126
Joined: Dec 27, 2005 5:22
Contact:

Post by segin »

kiyotewolf wrote:I would use BASE64 encoding for sending chunks of files.
I'd agree, if we were living in 1980-something, and 7-bit machines hadn't been melted down to make Core 2 Duos.

As it is, we live in an era where virtually everything uses 8-bit bytes and is binary-safe.

Finally, why are you replying to a thread that hasn't been posted to in about 18 months? Obvious troll is obvious.
Post Reply