Sorry your browser is not supported!

//-----------------------------------------------
//DECLARAÇÃO DE VARIÁVEIS
Global Mens as list_mensage
Global dim Menss(100) as list_mensage
Global dim Plr(100) as list_mensage
Global Maxp$
Global Ip$
Global Logged
Global mensagecount

//-----------------------------------------------
//CONSTRUÇÃO DE TIPOS
Type list_mensage
	Ini as string
	Send as string
	Adv as string
	Times as string
	Login as string
	Senha as string
	Status as integer
	Ends as string
	Get as string
	Kik as string
	Cap as string
	Byt as integer
endtype

//-----------------------------------------------
//CONFIGURANDO IP
Ip$=GetMyIp()
iplen=len(Ip$)
make memblock  1,iplen
for i=1 to iplen
	write memblock byte 1,i-1,asc(mid$(Ip$,i))
next i
arq$="ip.net"
if file exist(arq$)=1 then delete file arq$
open to write 1,arq$
make file from memblock 1,1
delete memblock 1
close file 1

//-----------------------------------------------
//CARREGANDO DATABASE
end$="C:\Program Files (x86)\The Game Creators\Dark Basic Professional\Projects\Projetos de Estudo\Online\ChatBoxLock\Host\user1.mdb"
uid$="Administrador"
pas$="esternocli"
con$="Driver={Microsoft Access Driver (*.mdb, *.accdb)};Dbq="+end$+";Uid="+uid$+";Pwd="+pas$+";"
result=DBConnect(con$) 
If result<>1
	Print_stats("db_error1")
	wait 6*1000
	end
endif
qy$="SELECT * FROM USERS"


//-----------------------------------------------
//CONFIGURAÇÕES DA REDE
GetConfig()
NET HOST Val(Maxp$),Ip$

//-----------------------------------------------
//LOOP PRINCIPAL
load_mens()
Do

	//-----------------------------------------------
	//DETALHES
	Cls
	Print ">>>>HOST<<<<"
	Print
	Print "IP SERVER: ",Ip$
	Print "TAMANHO: ",Maxp$," clients"
	Print "MENSAGEM INICIAL: ",Mens.Ini
	Print
	Print "--------------------------------------"
	Print
	Print ">>>>COMANDOS<<<<"
	Print "B para BANIR"
	Print "Ctrl para ESCREVER"
	Print "Enter para ENVIAR"
	Print "P para OBTER PORTA"
	Print "I para OBTER IP"
	Print
	Print ">>>>Status<<<<"
	Print
	Print ">>LOGADOS<<"
	For X=1 to NET GET PLAYER AMOUNT()
		If NET PLAYER CONNECTED(X)=1
			Print Plr(X).Login+" (jogador "+str$(Plr(X).Status)+") esta logado!"
		endif 	
	Next X
	Print "--------------------------------------"
	Print
	Print ">>>>MENSAGENS<<<<"
	For X=1 to mensagecount
		men$=Menss(X).Times+" : "+Menss(X).Send
		Print men$
	Next X
	Print "--------------------------------------"
	

	//-----------------------------------------------
	//ADICIONANDO JOGADORES
	New#=Net Player Joined()
	If New#>0
		NET PUT STRING Mens.Ini
		NET SEND New#
		New#=0
	endif
	
	
	//RECEBE MENSAGENS E REDIRECIONA A TODOS OS USUÁRIOS
	If NET GET MESSAGE()=1
		Mens.Byt=NET GET BYTE()
		Mens.Get=NET GET STRING()
		select Mens.Byt
		
			case 2
				Plr$=str$(NET MESSAGE FROM())
				Mens.Send=access_db(Mens.Get,val(Plr$))
				NET PUT BYTE 2
				NET PUT STRING Mens.Send
				NET SEND val(Plr$)
			endcase
			
			case 1
				Mens.Send=Mens.Get
				NET PUT STRING Mens.Send
				NET SEND ALL
			endcase
			
		endselect
		
		add_mens()
		
	endif

	
	//-----------------------------------------------
	//COMANDOS
	ke=scancode()
	select ke
		case 29
			escrever()
		endcase
		case 48
			banir()
		endcase
		case 25
			porta()
		endcase
		case 23
			iplay()
		endcase
	
	endselect
	
	
loop


//-----------------------------------------------
//FUNÇOES
Function add_mens()
	inc mensagecount,1
	Menss(mensagecount).Send=Mens.Send
	Menss(mensagecount).Times=get time$()
	Mens.Send=""
endfunction

Function banir()
	Input "NUMERO DO JOGADOR: ",num$
	num$=right$(num$,len(num$)-1)
	Net Kick Val(num$)
	Mens.Send=replace$(Mens.Kik,"inf$",num$)
	NET PUT STRING Mens.Send
	NET SEND ALL
	add_mens()
endfunction

Function porta()
	Input "NUMERO DO JOGADOR: ",num$
	num$=right$(num$,len(num$)-1)
	Mens.Send="A PORT do jogador "+num$+" e "+str$(Net get player port (val(num$)))
	add_mens()
endfunction

Function iplay()
	Input "NUMERO DO JOGADOR: ",num$
	num$=right$(num$,len(num$)-1)
	Mens.Send="O IP do jogador "+num$+" e "+Net get player ip (val(num$))
	add_mens()
endfunction

Function escrever()
	
	Input "HOST>> ",Mens.Cap
	Mens.Send="HOST>> "+Mens.Cap
	NET PUT STRING Mens.Send
	NET SEND ALL
	add_mens()
	
endfunction

Function GetConfig()
	
	//ABRINDO ARQUIVO
	open to read 1, "rede.txt"
	read string 1,num$
	close file 1
	
	//CRIANDO ARRAY
	global dim config(val(num$)+1) as string
	load array "rede.txt",config(0)
	Maxp$=config(1)
	
	//RESETANDO VARIÁVEIS
	num$=""
	close file 1
	
	//ABRINDO ARQUIVO
	open to read 2,"mens.txt"
	read string 2,num$
	close file 2
	
	//CRIANDO ARRAY
	global dim mens(val(num$)+1) as string
	load array "mens.txt",mens(0)
	repeat
		num_r=rnd(val(num$))	
	until num_r>0
	Mens.Ini=mens(num_r)
	close file 2
		
	//RESETANDO VARIÁVEIS
	num$=""
	
endfunction

Function access_db(text$,plrs)

	Mens.Login=first token$(text$,"*")
	Mens.Senha=next token$("*")
	
	Plr(plrs).Login=Mens.Login
	Plr(plrs).Status=plrs
	
	qy$="SELECT * FROM USERS WHERE LOGIN = '"+Mens.Login+"'"
	res=DBRunSQL(qy$)
	If res>0
		an$=DBGetDataByColName(0, "SENHA")
		if Mens.Senha=an$
			Resul_valid=9
			
		else
			Resul_valid=rnd(8)
		endif 	
	Else
		Resul_valid=rnd(8)
	endif
	
	Valid$=generate_valid(Resul_valid) 		
	
endfunction Valid$

Function Print_stats(texto$)
	
	Select texto$
		case "db_error1"
			text$="DATA BASE ERROR 1 (CAN CONNECT)"	
		endcase
		case default
			text$=texto$
		endcase
	endselect
	
	X=Text Width(text$)
	Y=Text Height(text$)
	Posx=Screen Width()/2-X/2
	Posy=Screen Height()/2-Y/2
	
	Text Posx,Posy,text$
	
endfunction

Function generate_valid(result)
	
	num1=rnd(result)	
	num2=result-num1
	
	Valid$=str$(num1)+str$(num2)
	
endfunction Valid$

Function load_mens()

	Mens.Kik="O jogador de numero inf$ foi kikado!"
	Mens.Ends="O jogador [+inf$+] deixou o jogo!"
	Mens.Login="O jogador [+inf$+] se logou!"
	
endfunction

DISABLE ESCAPEKEY

//-----------------------------------------------
//DECLARAÇÃO DE VARIÁVEIS
Global Ip$
Global Nick$
Global Pass$
Global Mens as list_mens
Global dim Menss(100) as list_mens
Global Plr$

Type list_mens
	Times as string
	Send as string
	Error_Login as string
	Load as string
	Ini as string
	Ends as string
	Login as string
	Byt as integer
endtype


//-----------------------------------------------
//DECLARAÇÃO DE VARIÁVEIS
arq$="ip.net"
open to read 1,arq$
read string 1,ip$

//-----------------------------------------------
//COMEÇA CONEXÃO COM O HOST
NET CONNECT ip$
while NET GET MESSAGE()=0

endwhile
Mens.Ini=NET GET STRING()


//-----------------------------------------------
//LOGIN E SENHA

//PEGA O NICK DO JOGADOR
retorno_login:
Input "LOGIN : ",Nick$
Input "SENHA : ",Pass$

//CARREGANDO MENSAGENS
load_mens()

//TEMPO DE ESPERA
Print_stats(Mens.Load)

//ENVIA INFORMAÇÕES
If NET CONNECTED()=1 
	NET PUT BYTE 2
	NET PUT STRING Nick$+"*"+Pass$
	NET SEND 1
endif
while NET GET MESSAGE()=0

endwhile
//VALIDA INFORMAÇÕES
Mens.Byt=NET GET BYTE()
GetMensageValid$=NET GET STRING()

If Mens.Byt=2
	Valid=Val(mid$(GetMensageValid$,1))+Val(mid$(GetMensageValid$,2))
endif
If Valid<>9
	Cls
	Print GetMensageValid$,Plr$+Nick$+"*"+Pass$
	Print_stats(Mens.Error_Login)
	goto retorno_login
Endif
Cls
//-----------------------------------------------
//ENTROU NO SISTEMA
If NET CONNECTED()=1 
	Mensage_nick$=Mens.Login
	NET PUT BYTE 1
	NET PUT STRING Mensage_nick$
	NET SEND 1
endif
Cls
Print Mens.Ini

Do
	If KEYSTATE(1) then left_game()
	If NET CONNECTED()=0
		Print "ERROR : "+NET GET ERROR()
		wait 3000
		end
	endif
	If NET GET MESSAGE()=1 
		Message$=NET GET STRING()
		If left$(Message$,len(Nick$))<>Nick$
			If left$(Message$,len("Host"))="HOST"
				ink rgb(255,0,0),rgb(0,0,0)
			Else
				ink rgb(255,255,255),rgb(0,0,0)
			endif
			Print Message$
			ink rgb(255,255,255),rgb(0,0,0)
		endif
	endif
	If Controlkey()=1
		Input Nick$+">> ",Message$
		Msg$=Nick$+">> "+Message$
		NET PUT BYTE 1
		NET PUT STRING Msg$
		NET SEND 1
	endif
loop


Function load_mens()

	Mens.Load="CARREGANDO INFORMAÇÕES DO SERVIDOR!"
	Mens.Error_Login="LOGIN OU SENHA INCORRETOS!"
	Mens.Ends="O jogador ["+Nick$+"] deixou o jogo!"
	Mens.Login="O jogador ["+Nick$+"] se logou!"
	
endfunction

Function Print_stats(text$)
	
	X=Text Width(text$)
	Y=Text Height(text$)
	Posx=Screen Width()/2-X/2
	Posy=Screen Height()/2-Y/2
	
	Text Posx,Posy,text$
	
endfunction

Function left_game()
	
	NET PUT BYTE 1
	NET PUT STRING Mens.Ends
	NET SEND 1
	
	end
	
endfunction 

function GetMyIp()
	if WSAStartup() = 0
	   ip$ = GetLocalIP(0)
	   WSACleanup()
	endif
endfunction ip$

//======================================functions==========================================

function GetLocalIP(index as integer)
   local ip as string
   local p as DWORD
   local HOSTENT as DWORD

   HOSTENT=make memory(256)

   if GetHostName( HOSTENT, 256 ) = 0
      HostInfo=GetHostByName( HOSTENT )
      if HostInfo <> 0
         p=HostInfo+12
         p=*p
         p=*p
         p=p+(index*4)
         ip=INET_ntoa( *p )
      endif
   endif

   delete memory HOSTENT
endfunction ip

function GetHostName(memptr as DWORD, size as integer)
   local r as integer
   local a as DWORD
   local s as DWORD
   r=call dll(201, "gethostname", memptr, size)
endfunction r

function GetHostByName(memptr as DWORD)
   local r as integer
   r=call dll(201, "gethostbyname", memptr)
endfunction r

function INET_ntoa(addr as DWORD)
   local ip as string
   ip=call dll(201, "inet_ntoa", addr)
endfunction ip

function WSAStartup()
   local WSADATA as DWORD
   local r as integer
   local v as WORD

   load dll "wsock32.dll",201

   WSADATA=make memory(16384)

   v=2
   r=call dll(201, "WSAStartup", v, WSADATA)

   delete memory WSADATA
endfunction r

function WSACleanup()
   call dll 201, "WSACleanup"
   delete dll 201
endfunction

function getIP$()
IP as string,ReadLine as string
if file exist("temp.dat")
    delete file "temp.dat"
Endif
load dll "urlmon.dll", 1
Status = call dll(1, "URLDownloadToFileA", 0,"http://whatismyipaddress.com", "temp.dat", 0, 0)
delete dll 1
if Status = 0
    open to read 1, "temp.dat"
    repeat
        read string 1, ReadLine
        if file end(1) = 0
            if ReadLine = "<!-- do not script -->"
                read string 1, IP
            endif
        endif
    until file end(1) or IP<>""
    close file 1
endif
if file exist("temp.dat")
    delete file "temp.dat"
endif
Endfunction IP

always active on
set window on
sync on

global pingmark as integer

`windows firewall
if net firewall enabled()=1 then FWstatus=net firewall enable application("iptest.exe","iptest")
sync
print "App->Firewall= ";FWstatus
sync

`get IPs
wanIP$=getIP$()
lanIP$=multiplayer get ip address()
net set port 8000

state=1

do
sync
cls

set cursor 0,0 : print "WAN: "+wanIP$
set cursor 0,20 : print "LAN: "+lanIP$

select state
   `select mode
   case 1
      set cursor 0,40 : print "1-host"
      set cursor 0,60 : print "2-connect via LAN"
      set cursor 0,80 : print "3-connect via WAN"
      set cursor 0,120 : input "Enter mode type: ", mode
      if mode>0 then state=2
   endcase
   `initialize connection
   case 2
      select mode
         case 1
            set cursor 0,40 : print "Hosting: Attempting to initialize a session."
            netstatus=net host(10)
            if netstatus=1 then state=3
         endcase
         case 2
            set cursor 0,40 : print "Connecting via LAN: Attempting to connect to a session."
            netstatus=net connect(lanIP$)
            if netstatus=1
               state=3
            else
               neterror$=net get error()
               set cursor 0,60 : print neterror$
            endif
         endcase
         case 3
            set cursor 0,40 : print "Connecting via WAN: Attempting to connect to a session."
            netstatus=net connect(wanIP$)
            if netstatus=1
               state=3
            else
               neterror$=net get error()
               set cursor 0,60 : print neterror$
            endif
         endcase
      endselect
   endcase
   `main
   case 3
      select mode
         case 1
            newclient=net player joined()
            oldclient=net player left()
            clientsnow=net get player amount()
            set cursor 0,40 : print "Hosting: #Clients connected= "; clientsnow
         endcase
         case 2
            netstatus=net connected()
            if netstatus=1
               set cursor 0,40 : print "Connecting via LAN: Connected"
               set cursor 0,60 : print "Ping "+str$(ping)+"ms"
            else
               neterror$=net get error()
               set cursor 0,40 : print "Connecting via LAN: Not Connected"
               set cursor 0,60 : print neterror$
            endif
         endcase
         case 3
            netstatus=net connected()
            if netstatus=1
               set cursor 0,40 : print "Connecting via WAN: Connected"
               set cursor 0,60 : print "Ping "+str$(ping)+"ms"
            else
               neterror$=net get error()
               set cursor 0,40 : print "Connecting via WAN: Not Connected"
               set cursor 0,60 : print neterror$
            endif
         endcase
      endselect

      `handle messages
      if mode=1
        `server
        set cursor 0,60 : print "received ping from "+str$(replyTo)
        if net get message()>0
            msg$=net get string()
            replyTo=net message from()
            if msg$="ping"
                net put string "pong"
                net send replyTo
            endif
        endif
      else
        `clients
        if net get message()>0
            msg$=net get string()
            replyTo=net message from()
            if msg$="pong"
                pingStop=hitimer()
                ping=pingStop-pingStart
            endif
        endif
        if timer()-pingMark>5000
            pingMark=timer()
            net put string "ping"
            pingStart=hitimer()
            net send
        endif
      endif

   endcase
endselect

loop
end

function getIP$()
IP as string,ReadLine as string
if file exist("temp.dat")
    delete file "temp.dat"
Endif
load dll "urlmon.dll", 1
Status = call dll(1, "URLDownloadToFileA", 0,"http://whatismyipaddress.com", "temp.dat", 0, 0)
delete dll 1
if Status = 0
    open to read 1, "temp.dat"
    repeat
        read string 1, ReadLine
        if file end(1) = 0
            if ReadLine = "<!-- do not script -->"
                read string 1, IP
            endif
        endif
    until file end(1) or IP<>""
    close file 1
endif
if file exist("temp.dat")
    delete file "temp.dat"
endif
Endfunction IP

REM Project: HTTPAccess
REM Created: 02/02/2009 12:41:55
REM

rem Secure HTTPS Access
`port=80 : access=0x00000000 : rem HTTP
port=443 : access=0x00800000 : rem HTTPS

rem Connect to HTTP server
http connect "www.fpscreator.com",port

rem Make a data request
action$="" : return$=HTTP REQUEST DATA("POST", "gamehost/whatismyip.php",action$,access)

rem Handle return strin
if return$<>""
 `
 rem Parse string to screen
 print "YOUR IP IS : "+return$
 `
else
 `
 rem No string returned
 print "no data returned"
 `
endif
`
rem Close connection
http disconnect

rem User wait
wait key
end

//----------------------------------------------------
//COMANDOS DE INICIAÇÃO DE GRÁFICO
ALWAYS ACTIVE ON
SET WINDOW ON
SYNC ON

//----------------------------------------------------
//DECLARAÇÕES
GLOBAL dim mens(0) as string
GLOBAL num

//----------------------------------------------------
//FIREWALL
file$="Server.exe"
name$="Server"
IF net firewall enabled()=1 THEN result$=str$(net firewall enable application(file$,name$))
print_stats("Firewall ativado: "+result$)
cls


//----------------------------------------------------
//IP
ip$=getip$()
saveip("ip.net",ip$)
net set port 8000
print_stats(ip$)


//----------------------------------------------------
//HOST
CLS
hoststatus=NET HOST(10)
IF hoststatus=1
    DO
        //----------------------------------------------------
        //CLIENTS
        newclient=net player joined()
        oldclient=net player left()
        clientsnow=net get player amount()
        print_stats("Clients: "+str$(clientsnow))
         
        //----------------------------------------------------
        //MENSAGENS
        IF net get message()=1
            mens$=net get string()
            net put string mens$
            net send all
            add_message(mens$)
        ENDIF
    LOOP
ELSE
    print_stats("ERROR")
ENDIF



END
//----------------------------------------------------
//FUNÇÕES GRÁFICO
FUNCTION print_stats(text$)
    SYNC
    TEXT (screen width()/2)-(text width(text$)/2),(screen height()/2)-(text height(text$)/2),text$
    SYNC
ENDFUNCTION

FUNCTION text_stats(text$)
    SYNC
    TEXT 0,screen height()/2 + 10 + num*text height(text$),text$ 
    SYNC
ENDFUNCTION


FUNCTION add_message(text$)
    INC num,1
    GLOBAL dim mens(num) as string
    mens(num)=text$
    text_stats(text$)
ENDFUNCTION

FUNCTION saveip(file$,ip$)
    IF file exist(file$)
        delete file file$
    ENDIF
    
    open to write 1,file$
    write to clipboard ip$
    iplen=len(ip$)
    make memblock 1,iplen
    make file from memblock 1,1
    close file 1
    delete memblock 1
    FOR i=1 TO iplen
        write byte to file file$,i-1,asc(mid$(ip$,i))
    NEXT i
    
    
ENDFUNCTION


FUNCTION getip$()
IP as string
ReadLine as string
if file exist("temp.dat")
    delete file "temp.dat"
Endif
load dll "urlmon.dll", 1
Status = call dll(1, "URLDownloadToFileA", 0,"http://whatismyipaddress.com", "temp.dat", 0, 0)
delete dll 1
if Status = 0
    open to read 1, "temp.dat"
    repeat
        read string 1, ReadLine
        if file end(1) = 0
            if ReadLine = "<!-- do not script -->"
                read string 1, IP
            endif
        endif
    until file end(1) or IP<>""
    close file 1
endif
if file exist("temp.dat")
    delete file "temp.dat"
endif
Endfunction IP

//----------------------------------------------------
//DECLARAÇÕES
GLOBAL dim mens(0) as string
GLOBAL num

//----------------------------------------------------
//FIREWALL
file$="Client.exe"
name$="Client"
IF net firewall enabled()=1 THEN result$=str$(net firewall enable application(file$,name$))
print_stats("Firewall ativado: "+result$)
cls

//----------------------------------------------------
//PEGAR IP
file$="ip.net"
IF file exist(file$)
	open to read 1,file$
		read string 1,ip$
	close file 1
ENDIF

//----------------------------------------------------
//NICK
print ip$
INPUT "Nome: ",Nick$

//----------------------------------------------------
//CONECTAR

clientstatus=net connect(ip$)
cls
IF clientstatus=1
	DO
		IF Controlkey()=1
			Input Nick$+">> ",Message$
			Msg$=Nick$+">> "+Message$
			NET PUT STRING Msg$
			NET SEND 1
		ENDIF
		IF net get message()=1
			
		ENDIF
	LOOP
ELSE
	print_stats("ERROR "+net get error())
	wait key
ENDIF

END
//----------------------------------------------------
//FUNÇÕES GRÁFICO
FUNCTION print_stats(text$)
    SYNC
    TEXT (screen width()/2)-(text width(text$)/2),(screen height()/2)-(text height(text$)/2),text$
    SYNC
ENDFUNCTION

FUNCTION text_stats(text$)
    SYNC
    TEXT 0,screen height()/2 + 10 + num*text height(text$),text$ 
    SYNC
ENDFUNCTION

FUNCTION add_message(text$)
    INC num,1
    GLOBAL dim mens(num) as string
    mens(num)=text$
    text_stats(text$)
ENDFUNCTION

hoststatus=NET HOST(10)

hoststatus=NET HOST(10,ip$)

//----------------------------------------------------
//COMANDOS DE INICIAÇÃO DE GRÁFICO
ALWAYS ACTIVE ON
SET WINDOW ON
SYNC ON

//----------------------------------------------------
//DECLARAÇÕES
GLOBAL dim mens(0) as string
GLOBAL num

//----------------------------------------------------
//FIREWALL
file$=\"Server.exe\"
name$=\"Server\"
IF net firewall enabled()=1 THEN result$=str$(net firewall enable application(file$,name$))
print_stats(\"Firewall ativado: \"+result$)
cls


//----------------------------------------------------
//IP
ip$=getip$()
saveip(\"ip.net\",ip$)
net set port 3999
print_stats(ip$)

//----------------------------------------------------
//HOST
CLS
hoststatus=NET HOST(10,\"192.168.1.2\")
IF hoststatus=1
    DO
    
        //----------------------------------------------------
        //CLIENTS
        newclient=net player joined()
        oldclient=net player left()
        clientsnow=net get player amount()
        print_stats(\"Clients: \"+str$(clientsnow)+\" of (\"+ip$+\")\")
         
        //----------------------------------------------------
        //MENSAGENS
        IF net get message()=1
            mens$=net get string()
            net put string mens$
            net send all
            add_message(mens$)
        ENDIF
    SYNC
    LOOP
ELSE
    print_stats(\"ERROR\")
    do
    print \"Shi...\"
    loop
ENDIF



END
//----------------------------------------------------
//FUNÇÕES GRÁFICO
FUNCTION print_stats(text$)
    SYNC
    TEXT (screen width()/2)-(text width(text$)/2),(screen height()/2)-(text height(text$)/2),text$
    SYNC
ENDFUNCTION

FUNCTION text_stats(text$)
    SYNC
    TEXT 0,screen height()/2 + 10 + num*text height(text$),text$ 
    SYNC
ENDFUNCTION


FUNCTION add_message(text$)
    INC num,1
    GLOBAL dim mens(num) as string
    mens(num)=text$
    text_stats(text$)
ENDFUNCTION

FUNCTION saveip(file$,ip$)
    IF file exist(file$)
        delete file file$
    ENDIF
    
    open to write 1,file$
//    write to clipboard ip$
    iplen=len(ip$)
    make memblock 1,iplen
    make file from memblock 1,1
    close file 1
    delete memblock 1
    FOR i=1 TO iplen
        write byte to file file$,i-1,asc(mid$(ip$,i))
    NEXT i
    
    
ENDFUNCTION


FUNCTION getip$()
IP as string
ReadLine as string
if file exist(\"temp.dat\")
    delete file \"temp.dat\"
Endif
load dll \"urlmon.dll\", 1
Status = call dll(1, \"URLDownloadToFileA\", 0,\"http://whatismyipaddress.com\", \"temp.dat\", 0, 0)
delete dll 1
if Status = 0
    open to read 1, \"temp.dat\"
    repeat
        read string 1, ReadLine
        if file end(1) = 0
            if ReadLine = \"<!-- do not script -->\"
                read string 1, IP
            endif
        endif
    until file end(1) or IP<>\"\"
    close file 1
endif
if file exist(\"temp.dat\")
    delete file \"temp.dat\"
endif
Endfunction IP

//----------------------------------------------------
//DECLARAÇÕES
GLOBAL dim mens(0) as string
GLOBAL num

//----------------------------------------------------
//FIREWALL
file$=\"Client.exe\"
name$=\"Client\"
IF net firewall enabled()=1 THEN result$=str$(net firewall enable application(file$,name$))
print_stats(\"Firewall ativado: \"+result$)
cls

//----------------------------------------------------
//PEGAR IP
file$=\"ip.net\"
IF file exist(file$)
	open to read 1,file$
		read string 1,ip$
	close file 1
ENDIF

//----------------------------------------------------
//NICK
print ip$
INPUT \"Nome: \",Nick$

//----------------------------------------------------
//CONECTAR
net set port 8000
clientstatus=net connect(ip$)
cls
IF clientstatus=1
	DO
		IF Controlkey()=1
			Input Nick$+\">> \",Message$
			Msg$=Nick$+\">> \"+Message$
			NET PUT STRING Msg$
			NET SEND 1
		ENDIF
		IF net get message()=1
			
		ENDIF
	LOOP
ELSE
	print_stats(\"ERROR \"+net get error())
	wait key
ENDIF

END
//----------------------------------------------------
//FUNÇÕES GRÁFICO
FUNCTION print_stats(text$)
    SYNC
    TEXT (screen width()/2)-(text width(text$)/2),(screen height()/2)-(text height(text$)/2),text$
    SYNC
ENDFUNCTION

FUNCTION text_stats(text$)
    SYNC
    TEXT 0,screen height()/2 + 10 + num*text height(text$),text$ 
    SYNC
ENDFUNCTION

FUNCTION add_message(text$)
    INC num,1
    GLOBAL dim mens(num) as string
    mens(num)=text$
    text_stats(text$)
ENDFUNCTION

always active on
set window on
sync on

global pingmark as integer

`windows firewall
if net firewall enabled()=1 then FWstatus=net firewall enable application("iptest.exe","iptest")
sync
print "App->Firewall= ";FWstatus
sync

`get IPs
wanIP$=getIP$()
lanIP$=multiplayer get ip address()
net set port 8000

state=1

do
sync
cls

set cursor 0,0 : print "WAN: "+wanIP$
set cursor 0,20 : print "LAN: "+lanIP$

select state
   `select mode
   case 1
      set cursor 0,40 : print "1-host"
      set cursor 0,60 : print "2-connect via LAN"
      set cursor 0,80 : print "3-connect via WAN"
      set cursor 0,120 : input "Enter mode type: ", mode
      if mode>0 then state=2
   endcase
   `initialize connection
   case 2
      select mode
         case 1
            set cursor 0,40 : print "Hosting: Attempting to initialize a session."
            netstatus=net host(10)
            if netstatus=1 then state=3
         endcase
         case 2
            set cursor 0,40 : print "Connecting via LAN: Attempting to connect to a session."
            netstatus=net connect(lanIP$)
            if netstatus=1
               state=3
            else
               neterror$=net get error()
               set cursor 0,60 : print neterror$
            endif
         endcase
         case 3
            set cursor 0,40 : print "Connecting via WAN: Attempting to connect to a session."
            netstatus=net connect(wanIP$)
            if netstatus=1
               state=3
            else
               neterror$=net get error()
               set cursor 0,60 : print neterror$
            endif
         endcase
      endselect
   endcase
   `main
   case 3
      select mode
         case 1
            newclient=net player joined()
            oldclient=net player left()
            clientsnow=net get player amount()
            set cursor 0,40 : print "Hosting: #Clients connected= "; clientsnow
         endcase
         case 2
            netstatus=net connected()
            if netstatus=1
               set cursor 0,40 : print "Connecting via LAN: Connected"
               set cursor 0,60 : print "Ping "+str$(ping)+"ms"
            else
               neterror$=net get error()
               set cursor 0,40 : print "Connecting via LAN: Not Connected"
               set cursor 0,60 : print neterror$
            endif
         endcase
         case 3
            netstatus=net connected()
            if netstatus=1
               set cursor 0,40 : print "Connecting via WAN: Connected"
               set cursor 0,60 : print "Ping "+str$(ping)+"ms"
            else
               neterror$=net get error()
               set cursor 0,40 : print "Connecting via WAN: Not Connected"
               set cursor 0,60 : print neterror$
            endif
         endcase
      endselect

      `handle messages
      if mode=1
        `server
        set cursor 0,60 : print "received ping from "+str$(replyTo)
        if net get message()>0
            msg$=net get string()
            replyTo=net message from()
            if msg$="ping"
                net put string "pong"
                net send replyTo
            endif
        endif
      else
        `clients
        if net get message()>0
            msg$=net get string()
            replyTo=net message from()
            if msg$="pong"
                pingStop=hitimer()
                ping=pingStop-pingStart
            endif
        endif
        if timer()-pingMark>5000
            pingMark=timer()
            net put string "ping"
            pingStart=hitimer()
            net send
        endif
      endif

   endcase
endselect

loop
end

function getIP$()
IP as string,ReadLine as string
if file exist("temp.dat")
    delete file "temp.dat"
Endif
load dll "urlmon.dll", 1
Status = call dll(1, "URLDownloadToFileA", 0,"http://whatismyipaddress.com", "temp.dat", 0, 0)
delete dll 1
if Status = 0
    open to read 1, "temp.dat"
    repeat
        read string 1, ReadLine
        if file end(1) = 0
            if ReadLine = "<!-- do not script -->"
                read string 1, IP
            endif
        endif
    until file end(1) or IP<>""
    close file 1
endif
if file exist("temp.dat")
    delete file "temp.dat"
endif
Endfunction IP