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)

Postby segin » Sep 04, 2007 15:49

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

Postby Frank Dodd » Sep 04, 2007 18:39

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:

Postby segin » Sep 05, 2007 15:57

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

Postby segin » Sep 06, 2007 15:54

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:

Postby notthecheatr » Sep 07, 2007 22:21

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
Contact:

Postby inded005 » Sep 08, 2007 17:18

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

Postby Loe » Sep 09, 2007 9:55

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:

Postby segin » Sep 11, 2007 16:10

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:

Postby segin » Sep 11, 2007 16:11

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

Postby Loe » Sep 15, 2007 2:57

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:

Postby segin » May 11, 2009 8:43

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

Postby Loe » May 12, 2009 0:33

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:

Postby segin » May 13, 2009 17:49

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:

Postby kiyotewolf » Jan 09, 2011 9:54

...
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:

Postby segin » Jan 09, 2011 11:25

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.

Return to “Projects”

Who is online

Users browsing this forum: No registered users and 0 guests