{-------------------------------------------------------------}
{          cartaVox - manipulador de cópias carbono
{-------------------------------------------------------------}

unit carCC;
interface

uses winTypes, winProcs, winDos, shellApi, strings, winSock,
     dvcrt, dvWin,
     carVars, carMsg, carUtil, carApeli;

procedure limpaListaCarbono;
procedure geraListaCarbono;
procedure geraRCPTCC;

procedure gravaCC;
procedure selecionaCC (nomeArq: string);

implementation

{-------------------------------------------------------------}
{                 gera lista de cópias carbono
{-------------------------------------------------------------}

procedure limpaListaCarbono;
var prox: pListaCC;
begin
    while pCC <> NIL do
        begin
            prox := pCC^.prox;
            dispose (pCC);
            pCC := prox;
        end;

    while pBCC <> NIL do
        begin
            prox := pBCC^.prox;
            dispose (pBCC);
            pBCC := prox;
        end;
end;

{-------------------------------------------------------------}
{                 inverte a ordem de uma lista
{-------------------------------------------------------------}

procedure inverteListaCC (var pl: pListaCC);
var p, aux: pListaCC;
begin
    p := NIL;
    while pl <> NIL do
        begin
            aux := pl;
            pl := pl^.prox;

            aux^.prox := p;
            p := aux;
        end;
    pl := p;
end;

{-------------------------------------------------------------}
{               le a lista de arquivos CC ou BCC
{-------------------------------------------------------------}

procedure leListaCC (var pl: pListaCC);
var
    s: string;
    c1, c2: char;
    pCarb: pListaCC;
label deNovo;
begin
    repeat
deNovo:
        sintBip;

        sintReadln (s);
        if s <> '' then
            begin
                if s[1] = '*' then
                    begin
                        delete (s, 1, 1);
                        s := buscaApelido (s);
                        if s = '' then
                            begin
                                mensagem ('CTAPEINV', 1);   {'Apelido inválido'}
                                goto deNovo;
                            end;

                        mensagem ('CTENVPAR', 0);   {'Enviando para: '}
                        sintWriteln (s);
                        mensagem ('CTCNFDST', 0);  {'Confirma destino {s/n) ? '}
                        sintLeTecla (c1, c2);
                        writeln;
                        if c1 = ESC then exit;

                        if upcase (c1) = 'N' then goto deNovo;
                    end;

                new (pCarb);
                with pCarb^ do
                    begin
                        nome := s;
                        prox := pl;
                        pl := pCarb;
                    end;
            end;

    until s = '';
end;

{-------------------------------------------------------------}
{                 gera lista de cópias carbono
{-------------------------------------------------------------}

procedure geraListaCarbono;
var resp: char;

begin
    {cuidado, esta rotina adiciona dados as listas CC e BCC atuais, nao as limpa !}

    mensagem ('CTDIGCC', 1);   {'Digite os endereços eletrônicos para os carbonos'}
    mensagem ('CTENTCC', 1);   {'Tecle ENTER após cada nome e após o último tecle mais um ENTER'}

    leListaCC (pCC);
    inverteListaCC (pCC);

    mensagem ('CTENVBCC', 0);  {'Deseja enviar cópias não identificadas desta carta ? '}
    resp := sintReadkey;
    writeln (resp);
    if upcase (resp) <> 'S' then exit;

    mensagem ('CTENTCC', 1);   {'Tecle ENTER após cada nome e após o último tecle mais um ENTER'}

    leListaCC (pBCC);
    inverteListaCC (pBCC);
end;

{-------------------------------------------------------------}
{       grava cabeçalho das CC e BCC no arquivo a enviar
{-------------------------------------------------------------}

procedure geraRCPTCC;

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

    procedure grava (p: pListaCC);
    var s: string;
        i1, i2: integer;
    begin
        while p <> NIL do
            begin
                i1 := pos ('<', p^.nome);
                if i1 <> 0 then
                    begin
                        i2 := pos ('>', p^.nome);
                        if i2 = 0 then i2 := length (p^.nome);
                        s := copy (p^.nome, i1, i2-i1+1);
                        writeln (arqEnv, 'RCPT TO:', s)
                    end
                else
                    writeln (arqEnv, 'RCPT TO:<', p^.nome, '>');

                p := p^.prox;
            end;
    end;

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

begin
    grava (pCC);
    grava (pBCC);
end;

{-------------------------------------------------------------}
{                 grava CC no arquivo a enviar
{-------------------------------------------------------------}

procedure gravaCC;
var p: pListaCC;
begin
    if pCC <> NIL then
        begin
            write (arqEnv, 'Cc: ');
            p := pCC;
            while p <> NIL do
                begin
                   write (arqEnv, p^.nome);
                   p := p^.prox;
                   if p <> NIL then
                       begin
                           writeln (arqEnv, ',');
                           write (arqEnv, '    ');
                       end
                   else
                       writeln (arqEnv);
                end;
        end;
end;

{-------------------------------------------------------------}
{       remove brancos do início e final de uma cadeia
{-------------------------------------------------------------}

function trim (s: string): string;
begin
    while (s <> '') and ((s[1] = ' ') or (s[1] = ^I)) do
       delete (s, 1, 1);
    while (s <> '') and ((s[length (s)] = ' ') or (s[length(s)] = ^I)) do
       delete (s, 1, 1);
    trim := s;
end;

{-------------------------------------------------------------}
{              extrai uma lista de CC de uma carta
{-------------------------------------------------------------}

procedure extraiCC (nomeArq: string);
var s: string;
    cartaRec: text;
    i, n: integer;
    ultimoReg: boolean;
    p: plistaCC;

const cc: string[3] = 'CC:';
label pula, achou, outroNome;

begin
    pCc := NIL;
    pBcc := NIL;

    assign (cartaRec, nomeArq);
    {$I-}  reset (cartaRec);  {$I+}
    if ioresult <> 0 then exit;

    s := 'a';
    while (s <> '') and (not eof (cartaRec)) do
        begin
            {$I-}  readln (cartaRec, s);  {$I+}
            if ioresult <> 0 then exit;

            if length (s) < length (cc) then goto pula;
            for i := 1 to length (cc) do
                if cc[i] <> upcase (s[i]) then
                    goto pula;

            goto achou;
pula:
        end;

    exit;   {não achou}

achou:
    s := copy (s, length(cc)+1, length(s)-length(cc));
    repeat
        ultimoReg := true;

        if (s <> '') and (s[length(s)] = '\') then
            begin
                delete (s, length (s), 1);
                ultimoReg := false;
            end;

        s := trim (s);
        if (s <> '') and (s[length(s)] = ',') then ultimoReg := false;

        if s <> '' then
            repeat
                n := pos (',', s);
                if n = 0 then n := length (s) + 1;

                new (p);
                p^.nome := trim(copy (s, 1, n-1));
                p^.prox := pCc;
                pCc := p;

                delete (s, 1, n);
                s := trim (s);
            until s = '';

        if not ultimoReg then
            begin
                if not eof (cartarec) then
                    begin
                        {$I-}  readln (cartaRec, s);  {$I+}
                        if ioresult <> 0 then ultimoReg := true;
                    end
                else
                    ultimoReg := true;
            end;

    until ultimoReg;

    close (cartaRec);
end;

{-------------------------------------------------------------}
{                     seleciona alguns CC
{-------------------------------------------------------------}

procedure selecionaCC (nomeArq: string);
var resp: char;
begin
    textBackground (MAGENTA);
    mensagem ('CTENVCC', 0);   {'Deseja enviar cópias carbono desta carta ? '}
    textBackground (BLACK);
    resp := sintReadkey;
    writeln (resp);
    if upcase (resp) <> 'S' then
        begin
            limpaListaCarbono;
            exit;
        end;

    extraiCc (nomeArq);

    if pCC <> NIL then
        begin
            mensagem ('CTRSPOUT', 1);  {'A carta a que você está respondendo tinha sido enviada a outras pessoas'}
            mensagem ('CTENVIAT', 0);  {'Quer enviar sua resposta também para elas ? '}
            resp := sintReadkey;
            writeln (resp);
            if upcase (resp) <> 'S' then limpaListaCarbono;
        end;

    geraListaCarbono;
end;

end.
