FreebasicNetChat

[mrminecrafttnt]

This one is an Idea to chat over an approved Networkfolder with read/write rights, simple encryption included.. ;)
-Edit: some Bugs are already fixed ;)

Code: Select all

open "FBChat.dat" for binary as #1

sub write_msg(msg as string)
    dim as ushort length = len(msg)
    dim as ubyte buffer(length)
    for i as integer = 0 to length-1
        buffer(i)=msg[i]
    next
    put #1,1,length
    put #1,,buffer()
end sub

function read_msg as string
    dim as string msg
    dim as ushort length
    get #1,1,length
    dim as ubyte buffer(length)
    get #1,,buffer()
    msg = space(length)
    dim as integer count
    for i as integer = 0 to length-1
        msg[i]=buffer(i)
    next
    return msg
end function

sub msgprinter (msg as string)
    static as ubyte p,c
    c+=1
    c mod = 8
    p=18+c
    locate p,1
    print msg
end sub


function encrypter(message as string) as string
    dim as ubyte key = int(rnd*256)
    dim as string tmp = space(1)
    tmp[0]=key
    for i as integer = 0 to len(message)-1
        tmp+=chr(message[i] xor tmp[0])
    next
    return tmp
end function

function decrypter(message as string) as string
    dim as ubyte key = message[0]
    dim as string tmp
    for i as integer = 1 to len(message)-1
        tmp+=chr(message[i] xor key)
    next
    return tmp
end function

sub writer
    dim as string username,Message
    do
        locate 2,1
        Input "Username : ",Username
    loop until Username <> ""
    do
        do
            locate 3,1
            sleep 10
        loop until csrlin = 3 and pos = 1
       
        Input "Message : ",Message
        Message = TIME +" "+ Username + " : "+ Message
        Message = EnCrypter(Message)
        write_msg(Message)
        sleep 10,1
    loop
end sub

sub reader
    dim as string oldmessage,newmessage
    do
        newmessage = read_msg
        if newmessage <> oldmessage then
            oldmessage = newmessage
            msgprinter DeCrypter(newmessage)
        end if
        sleep 1,1
    loop
end sub

Print "FreebasicNetChat(FBNC) 0.0.1 - Press ESC to exit"
threadcreate (@reader)
sleep 10
threadcreate (@writer)

do
    sleep 1000,1
loop until inkey = chr(27)