{-------------------------------------------------------------}
{
{    Modulo genérico de conexão
{
{    Autor: Jose' Antonio Borges
{
{    Em 14/05/98
{
{-------------------------------------------------------------}

unit dvinet;

interface
uses winProcs, winDos, winTypes, shellApi,
     dvcrt, strings, dvWin, winsock;

const
    MAXBUF = 4096;

type
    TbufRede = record
        sock: integer;
        buf: array [0..MAXBUF-1] of char;
        p: integer;
        lidos: integer;
    end;

    PbufRede = ^TbufRede;

function abreWinSock: boolean;
procedure fechaWinSock;

function abreConexao (nomeComput: string; porta: integer): integer;
procedure fechaConexao (sock: integer);
function escutaConexao (porta: integer): integer;
function aceitaConexao (sock: integer): integer;
function chegouRede (sock: integer): boolean;

function inicBufRede (sock: integer): PbufRede;
procedure fimBufRede (pbuf: PBufRede);
function temDadoBufRede (pbuf: PbufRede): boolean;
function readlnBufRede (pbuf: PbufRede; var s: string; maxTempo: integer): boolean;
function leCaracBufRede (pbuf: PbufRede; var c: char): boolean;

function writelnRede (sock: integer; s: string): boolean;

var
    debugConexao: boolean;
    enderLocal, enderRemoto: longint;
                {atualizado quando se conecta ou aceita}

implementation

{-------------------------------------------------------------}
{                     abre Windows Sockets
{-------------------------------------------------------------}

function abreWinSock: boolean;
var
    wsaData: LPWSADATA;
begin
    abreWinSock := WSAStartup ($0101, wsaData) = 0;
end;

{-------------------------------------------------------------}
{                    fecha Windows Sockets
{-------------------------------------------------------------}

procedure fechaWinSock;
begin
    WSACleanup;
end;

{-------------------------------------------------------------}
{                abre a conexao (-1 = não abriu)
{-------------------------------------------------------------}

function abreConexao (nomeComput: string; porta: integer): integer;
var
    localAddr,                          { descricao dos endereços local e remoto }
    remoteAddr: sockaddr_in;
    hip: phostent;                        { retorna o endereco IP do soquete }
    ret: integer;
    s: string;
    hostName: array [0..128] of char;
    sock: integer;
    tam: integer;

begin
    abreConexao := -1;

    { cria socket e seleciona porta }

    sock := _socket (AF_INET, SOCK_STREAM, IPPROTO_TCP);
    if (sock = -1) then exit;

    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 exit;

    { Descobre endereco IP do computador }

    strPCopy (hostName, nomeComput);
    if (hostName[0] >= '0') and (hostName[0] <= '9')  then
        enderRemoto := inet_addr (hostName)
    else
        begin
            hip := gethostbyname (hostName);
            if (hip = NIL)  then
                exit;
            move (hip^.h_addr_list^[0]^, enderRemoto, 4);
        end;

    { conecta com servidor }

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

    if (connect (sock, remoteAddr, sizeof (remoteAddr)) = -1) then
         exit;

    tam := sizeof (localAddr);
    getSockName (sock, localAddr, tam);
    enderLocal := localAddr.sin_addr.s_addr;

    abreConexao := sock;
end;

{-------------------------------------------------------------}
{               espera algum cliente conectar
{-------------------------------------------------------------}

function escutaConexao (porta: integer): integer;
var
    localAddr,                          { descricao dos endereços local e remoto }
    remoteAddr: sockaddr_in;
    hip: phostent;                        { retorna o endereco IP do soquete }
    ret: integer;
    s: string;
    hostName: array [0..128] of char;
    sock: integer;
    tam: integer;

begin
    escutaConexao := -1;

    { cria socket e seleciona porta }

    sock := _socket (AF_INET, SOCK_STREAM, IPPROTO_TCP);
    if (sock = -1) then exit;

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

    ret := bind (sock, localAddr, sizeof(localAddr));
    if (ret = -1)  then exit;

    { conecta com servidor }

    if (listen (sock, 3) = -1) then
         exit;

    tam := sizeof (localAddr);
    getSockName (sock, localAddr, tam);
    enderLocal := localAddr.sin_addr.s_addr;

    escutaConexao := sock;
end;

{--------------------------------------------------------}
{                fecha a conexao
{--------------------------------------------------------}

procedure fechaConexao (sock: integer);
begin
    if sock >= 0 then
        closeSocket (sock);
end;

{-------------------------------------------------------------}
{                      aceita a conexao
{-------------------------------------------------------------}

function aceitaConexao (sock: integer): integer;
var
    localAddr,
    remoteAddr: sockaddr_in;
    tam: integer;
    newsock: integer;
begin
    aceitaConexao := -1;
    tam := sizeof (remoteAddr);
    newsock := accept (sock, remoteAddr, tam);
    if newSock = -1 then exit;

    enderRemoto := remoteAddr.sin_addr.s_addr;

    tam := sizeof (localAddr);
    getSockName (newsock, localAddr, tam);
    enderLocal := localAddr.sin_addr.s_addr;

    aceitaConexao := newsock;
end;

{-------------------------------------------------------------}
{               ve se chegou dado ou conexao
{-------------------------------------------------------------}

function chegouRede (sock: integer): boolean;
var
    entradas: fd_set;
    tempoZero: timeVal;
    esperando: boolean;
begin
    with tempoZero do
        begin
            tv_sec := 0;
            tv_usec := 0;
        end;

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

    chegouRede := FD_ISSET (sock, entradas);
    keypressed;
end;

{-------------------------------------------------------------}
{                inicializa o buffer de rede
{-------------------------------------------------------------}

function inicBufRede (sock: integer): PbufRede;
var pbuf: PBufRede;
begin
    getMem (pbuf, sizeof (TBufRede));
    pbuf^.p := MAXBUF;
    pbuf^.lidos := 0;
    pbuf^.sock := sock;
    inicBufRede := pbuf;
end;

{-------------------------------------------------------------}
{                     desaloca o buffer
{-------------------------------------------------------------}

procedure fimBufRede (pbuf: PbufRede);
begin
    freeMem (pbuf, sizeof (TBufRede));
end;

{-------------------------------------------------------------}
{                   lê um caractere do buffer
{-------------------------------------------------------------}

function temDadoBufRede (pbuf: PbufRede): boolean;
begin
    temDadoBufRede := false;
    if pbuf = NIL then exit;

    with pbuf^ do
        temDadoBufRede := (p < lidos) or chegouRede (sock);
end;

{-------------------------------------------------------------}
{                   lê um caractere do buffer
{-------------------------------------------------------------}

function leCaracBufRede (pbuf: PbufRede; var c: char): boolean;
begin
    leCaracBufRede := false;
    c := #$0;
    if pbuf = NIL then exit;

    with pbuf^ do
        begin
            if p >= lidos then
                begin
                    p := 0;
                    lidos := recv (sock, buf, MAXBUF, 0);
                    if lidos <= 0 then exit;
                end;

            c := buf [p];
            p := p + 1;
        end;

    leCaracBufRede := true;
end;

{-------------------------------------------------------------}
{         pega uma linha da rede com timeout
{-------------------------------------------------------------}

function readlnBufRede (pbuf: PbufRede; var s: string; maxTempo: integer): boolean;
var c: char;
    contaTempo: integer;
begin
    readlnBufRede := false;
    s := '';

    contaTempo := 0;
    repeat
        while not temDadoBufRede (pbuf) do
            begin
                delay (100);
                contaTempo := contaTempo + 1;
                if maxTempo <> 0 then
                    if contaTempo > (maxTempo*10) then exit;
            end;

        if not leCaracBufRede (pbuf, c) then exit;
        s := s + c;
    until c = #$0a;

    delete (s, length (s), 1);
    if s[length(s)] = #$0d then
        delete (s, length (s), 1);

    readlnBufRede := true;
end;

{-------------------------------------------------------------}
{           escreve uma linha pequena num socket
{-------------------------------------------------------------}
                
function writelnRede (sock: integer; s: string): boolean;
begin
    s := s + #$0d + #$0a;
    writelnRede := send (sock, @s[1], length (s), 0) > 0;
end;

begin
    debugConexao := false;
end.
