{-------------------------------------------------------------}
{
{    Telnet Falado
{
{    Rotinas de conexão e negociação
{
{    Autor: Jose' Antonio Borges
{
{    Em 24/04/98
{
{-------------------------------------------------------------}

unit tnrede;

interface

uses dvcrt, strings, dvWin, winsock, tnVars, tnMsg;

function abreConexao: boolean;
procedure fechaConexao;
function checaEvento: integer;
procedure sendIAC (c1, c2: char);
procedure preNegociaOpcoes;
procedure processaRede;
procedure erroRede;

procedure lelink (var c: char);
procedure esclink (c: char);
procedure escLetras (s: string);
procedure escBuf (c: char);
function chegouLink: boolean;
procedure flushBuf;

const
    TAMBUF = 20000;
    TAMBUFTRANS = 1024;
var
    bufLink: array [0..TAMBUF-1] of char;
    pins, pret: integer;
    bufTrans: array [0..TAMBUFTRANS-1] of char;
    ptrans: integer;

implementation

{-------------------------------------------------------------}
{                     Erro na rede
{-------------------------------------------------------------}

procedure erroRede;
begin
    emulando := false;

    window (1, 1, 80, numLinhasTerm+1);
    textColor (WHITE);
    gotoxy (1, numLinhasTerm+1);
    clreol;
    textBackGround (RED);
    mensagem ('TNCONCAI', 0);  {'Conexao remota caiu'}
    textBackGround (BLACK);
    clreol;
    writeln;
end;

{-------------------------------------------------------------}
{                     abre a conexao
{-------------------------------------------------------------}

function abreConexao: boolean;
var
    localAddr,                          { descricao dos endereços local e remoto }
    remoteAddr: sockaddr_in;
    enderHost: longint;
    hip: phostent;		        { retorna o endereco IP do soquete }
    ret: integer;
    wsaData: LPWSADATA;
    s: string;

begin
    abreConexao := false;

    ret := WSAStartup ($0101, wsaData);
    with wsadata do
        begin
            writeln;
            writeln ('Versão da biblioteca: ', wVersion shr 8 , '.', wVersion and $ff);
            writebuf (szDescription, strlen (szDescription));      writeln;
            writebuf (szsystemStatus, strlen (szsystemstatus));    writeln;
        end;

    if ret <> 0 then
        begin
            mensagem ('TNERRCOM', 1);  {'Não consegui ativar o sistema de comunicações do micro'}
            exit;
        end;

    {************ Cria soquete ***********}

    sock := _socket (AF_INET, SOCK_STREAM, IPPROTO_TCP);
    if (sock = -1) then
        begin
            mensagem ('TNNAOSOQ', 1);  {'Não consegui criar soquete'}
            exit;
        end;

    {************ Aloca uma porta para o processamento ***********}

    fillchar (localAddr, sizeof (localAddr), 0);
    with localAddr do
        begin
            sin_family := AF_INET ;
            sin_addr.s_addr := htonl (INADDR_ANY);
            sin_port := htons (0);
        end;

    ret := bind (sock, localAddr, sizeof(localAddr));
    if (ret = -1)  then
        begin
            mensagem ('TNERBIND', 1);  {'Não consegui alocar porta (bind)'}
            exit;
        end;

    {************ Descobre endereco IP do computador ***********}

    if (nomeHost[0] >= '0') and (nomeHost[0] <= '9')  then
        enderHost := inet_addr (nomeHost)
    else
        begin
            hip := gethostbyname (nomeHost);
            if (hip = NIL)  then
                begin
                    while keypressed do readkey;
    	            mensagem ('TNSEMSRV', 1);  {'Não consegui achar um servidor com este nome'}
                    exit;
                end;
            move (hip^.h_addr_list^[0]^, enderHost, 4);
        end;

    {************ Conecta computador ***********}

    fillchar (remoteAddr, sizeof (remoteAddr), 0);
    with remoteAddr do
        begin
            sin_family := AF_INET;
            move (enderHost, sin_addr, 4);
            sin_port := htons (porta);
        end;

    with remoteAddr.sin_addr do
        begin
            s := 'Conectando com ';
            write (s);
            writeln (strPas (inet_ntoa (enderHost)));
        end;

    if (connect (sock, remoteAddr, sizeof (remoteAddr)) = -1) then
        begin
            while keypressed do readkey;
            mensagem ('TNNAOCON', 1);  {'Não consegui realizar a conexao'}
            exit;
        end;

    writeln;
    mensagem ('TNCONOK', 1);  {'Conexão realizada'}

    abreConexao := true;
end;

{-------------------------------------------------------------}
{		     fecha o soquete
{-------------------------------------------------------------}

procedure fechaConexao;
begin
    closeSocket (sock);
    wsaCleanup;
end;

{-------------------------------------------------------------}
{                     espera chegar um evento
{-------------------------------------------------------------}

function checaEvento: integer;
var
    entradas: fd_set;
    tempoZero: timeVal;

begin
    with tempoZero do
        begin
            tv_sec := 0;
            tv_usec := 0;
        end;

    if keypressed then
        begin
            checaEvento := CHEGOU_TECLA;
            exit;
        end;

    FD_ZERO (entradas);	 { monitora soquete }
    _FD_SET (sock, entradas);
    select (sock+1, @entradas, NIL, NIL, tempoZero);

    if FD_ISSET (sock, entradas) then
        checaEvento := CHEGOU_REDE
    else
        checaEvento := NADA_CHEGOU;
end;

{-------------------------------------------------------------}
{		  envia uma sequencia de negociacao
{-------------------------------------------------------------}

procedure sendIAC (c1, c2: char);
var
    buf: array [0..2] of char;
begin
    buf[0] := IAC;
    buf[1] := c1;
    buf[2] := c2;
    send (sock, buf, 3, 0);
end;

{-------------------------------------------------------------}
{                     negocia as primeiras opcoes
{-------------------------------------------------------------}

procedure procTermType (tipoTerm: string);
var
    vetResp: array [0..30] of char;
    i: integer;
begin
    vetResp [0] := IAC;
    vetResp [1] := SUBNEG;
    vetResp [2] := TERMTYPE;
    vetResp [3] := TT_IS;
    for i := 1 to length (tipoTerm) do
        vetResp [3+i] := tipoTerm [i];
    i := 4 + length (tipoTerm);
    vetResp [i] := IAC;     i := i + 1;
    vetResp [i] := SUBEND;  i := i + 1;
    send (sock, @vetResp, i, 0);
end;

{-------------------------------------------------------------}

procedure preNegociaOpcoes;
begin
    sendIAC (DOTEL, ECHO);
end;

{-------------------------------------------------------------}
{                     processa dado vindo da rede
{-------------------------------------------------------------}

procedure processaRede;
var
    p: pChar;
    i, lidos: integer;

begin
    lidos := recv (sock, buf, BUFSIZE, 0);
    if (lidos <= 0) then
        begin
            erroRede;
            exit;
        end;

	{ simplificando: assumindo que nao chegam negociacoes em blocos separados }

	p := buf;
        i := 0;
        while i < lidos do
            begin
	        if (p^ <> IAC) then
                    begin
                        bufLink [pins] := p^;
                        pins := (pins + 1) mod TAMBUF;
                    end
	        else
                    begin
                        p := p + 1;
                        i := i + 1;

		        case p^ of    { so negocia eco ! }
		             #255:
                                    begin   { realmente um caractere }
                                        bufLink [pins] := p^;
                                        pins := (pins + 1) mod TAMBUF;
                                    end;

		             DOTEL:
                                    begin
                                        p := p + 1;
                                        i := i + 1;
                                        if (p^ = ECHO) or (p^ = TERMTYPE) then
                                            sendIAC (WILLTEL,p^)
                                        else
                                            sendIAC (WONTTEL,p^);
                                    end;

		             DONTTEL, WILLTEL, WONTTEL:
                                            begin
                                                p := p + 1;
                                                i := i + 1;
				            end;

                             SUBNEG:
                                 begin
                                     p := p + 4;
                                     i := i + 4;
                                     procTermType (tipoTerminal);
                                 end;
                        end;
	            end;

                p := p + 1;
                i := i + 1;
	    end;
end;

{-------------------------------------------------------------}
{                tira um caractere do buffer
{-------------------------------------------------------------}

procedure lelink (var c: char);
begin
    repeat until chegouLink;

    c := bufLink [pret];
    pret := (pret + 1) mod TAMBUF;
end;

{-------------------------------------------------------------}
{                ve se chegou dado para ser lido
{-------------------------------------------------------------}

function chegouLink: boolean;
begin
    if pins = pret then
        if checaEvento = CHEGOU_REDE then
             processaRede;

    chegouLink := pins <> pret;
end;

{-------------------------------------------------------------}
{                escreve um dado direto no link
{-------------------------------------------------------------}

procedure esclink (c: char);
begin
    keypressed;  { ativa windows }

    if send (sock, addr(c), 1, 0) <> 1 then
       erroRede;
end;

{-------------------------------------------------------------}
{                escreve uma cadeia direto no link
{-------------------------------------------------------------}

procedure escLetras (s: string);
begin
    keypressed;  { ativa windows }

    if send (sock, addr(s[1]), length(s), 0) <> length(s) then
        erroRede;
end;

{-------------------------------------------------------------}
{          escreve um dado no buffer de transmissão
{-------------------------------------------------------------}

procedure escBuf (c: char);
begin
    bufTrans [ptrans] := c;
    ptrans := ptrans + 1;
    if ptrans >= TAMBUFTRANS then
        flushBuf;
end;

{-------------------------------------------------------------}
{                  descarrega buffer de escrita
{-------------------------------------------------------------}

procedure flushBuf;
var i, transm: integer;
begin
    if ptrans = 0 then exit;
    i := 0;
    while i < ptrans do
        begin
            keypressed;  { ativa windows }

            transm := send (sock, addr(bufTrans[i]), ptrans-i, 0);
            if transm = 0 then
                 begin
                     erroRede;
                     ptrans := 0;
                     exit;
                 end;
            i := i + transm;

            sintClek;
        end;

    ptrans := 0;
end;

{-------------------------------------------------------------}
{                       inicialização
{-------------------------------------------------------------}

begin
    pins := 0;
    pret := 0;
    ptrans := 0;
end.
