{--------------------------------------------------------}
{
{     Rotinas de comunicacao serial
{
{     Autor:  José Antonio Borges
{
{     Em 26/04/98
{
{--------------------------------------------------------}

Unit disComm;

interface
uses
    winProcs, winTypes, strings, dvcrt;

function inicLink (porta: word; vel: longint;  nbits, nstop: byte;  tipoParid: byte): integer;
			    { Obs: nbits= 5, 6, 7, 8; nstop = 1, 2 }
			    { paridade: 0-sem,  1-impar,  2-par }
                            { erros:   0 = ok }
                            {    ERRO_DCB_COMM  = erro ao montar dcb }
                            {    ERRO_ABRE_COMM = erro ao abrir porta com }
                            {    ERRO_CONF_COMM = erro ao configurar porta com }


procedure finalLink;
procedure escLink (c: char);
Function  chegouLink: boolean;
procedure leLink (var c: char);
function erroLink: integer;

const
    ERRO_DCB_COMM  = 1;    { erro ao montar dcb }
    ERRO_ABRE_COMM = 2;    { erro ao abrir porta com }
    ERRO_CONF_COMM = 3;    { erro ao configurar porta com }


Implementation

{ constantes, tipos e variaveis }

const
    TAMBUFREC   = 8192;          { tamanho dos buffers }
    TAMBUFTRANS = 4096;
    TAMBUFLOCAL = 2400;          { buffer fora do Windows, para gastar menos CPU }

var
    modemDCB: TDCB;              { controles da comunicacao }
    comId: integer;
    pstatus: pWord;
    erroCom: integer;
    stat: TComStat;

    ncBufLocal: integer;          { controles do intermediário de recepçao }
    pbuf: integer;
    bufLocal: array [0..TAMBUFLOCAL] of char;

    LINESTATUS, TXBUF: word;      { portas do hardware }

{--------------------------------------------------------}
{              inicializacao das interrupcoes
{--------------------------------------------------------}

function inicLink (porta: word;
                    vel: longint;  nbits, nstop: byte;
		    tipoParid: byte): integer;
var
    modemInit: array [0..80] of char;
    cmdOpen: array [0..5] of char;
    num: string [7];
    d: word;

begin
    if (porta < 1) or (porta > 4) then
        begin
            inicLink := ERRO_CONF_COMM;
            exit;
        end;

    strCopy (modemInit, 'COM');

    str (porta, num);   num := num + #$0;
    strCat (modemInit, @num[1]);
    strCat (modemInit, ':');

    str (vel, num);   num := num + #$0;
    strCat (modemInit, @num[1]);
    strCat (modemInit, ',');

    case tipoParid of
        1: strCat (modemInit, 'O');
        2: strCat (modemInit, 'E');
    else
        strCat (modemInit, 'N');
    end;
    strCat (modemInit, ',');

    str (nbits, num);   num := num + #$0;
    strCat (modemInit, @num[1]);
    strCat (modemInit, ',');

    str (nstop, num);   num := num + #$0;
    strCat (modemInit, @num[1]);
    strCat (modemInit, ',P');

    if buildCommDCB (modemInit, modemDCB) < 0 then
        begin
            inicLink := ERRO_DCB_COMM;
            exit;
        end;

    strCopy (cmdOpen, 'COM');
    str (porta, num);   num := num + #$0;
    strCat (cmdOpen, @num[1]);

    comId := openComm (cmdOpen, TAMBUFREC, TAMBUFTRANS);
    if comId < 0 then
        begin
            inicLink := ERRO_ABRE_COMM;
            exit;
        end;

    modemDCB.flags := modemDCB.flags or dcb_Binary;
    if setCommState (modemDCB) < 0 then
        begin
            inicLink := ERRO_CONF_COMM;
            exit;
        end;

    pstatus := setCommEventMask (comId, EV_RXCHAR);
    inicLink := 0;
    erroCom := 0;

    ncBufLocal := 0;
    pbuf := 1;

    {--- para acesso direto a porta de escrita ---}

    case porta of
        1:  d := 0;
        2:  d := $100;
        3:  d := $10;
        4:  d := $110;
    end;

    LINESTATUS := $3fd-d;
    TXBUF      := $3f8-d;
end;

{--------------------------------------------------------}
{              finalizacao das interrupcoes
{--------------------------------------------------------}

procedure finalLink;
begin
    closeComm (comID);
    erroCom := erroCom or GetCommError(comId, stat);
end;

{--------------------------------------------------------}
{              escreve um byte na porta serial
{--------------------------------------------------------}

procedure escLink (c: char);
begin
(*
    WriteComm (comId, @c, 1);
    erroCom := erroCom or GetCommError(comId, stat);
*)
    repeat until (port [LINESTATUS] and $20) <> 0;
    port [TXBUF] := ord (c);
end;

{--------------------------------------------------------}
{           ve se chegou dado na porta serial
{--------------------------------------------------------}

function chegouLink: boolean;
begin
    if pbuf >= ncBufLocal then
        if (getCommEventMask (comId, EV_RXCHAR) <> 0) or (ncBufLocal <> 0) then
            begin
                ncBufLocal := readComm (comId, bufLocal, 1);
                if ncBufLocal <> 0 then
                    pbuf := 0;
                erroCom := erroCom or GetCommError(comId, stat);
            end;

    if pbuf >= ncBufLocal then keypressed;

    chegouLink := pbuf < ncBufLocal;
end;

{--------------------------------------------------------}
{             le um dado do buffer local
{--------------------------------------------------------}

procedure leLink (var c: char);
begin
    repeat until chegoulink;

    c := bufLocal [pbuf];
    pbuf := pbuf + 1;

    if chegouLink then;   { pega mais alguns, se for o caso }
end;

{--------------------------------------------------------}
{             verifica o erro e zera ele
{--------------------------------------------------------}

function erroLink: integer;
begin
    erroLink := erroCom;
    erroCom := 0;
end;

end.
