{--------------------------------------------------------}
{            Cartavox - Folheador de cartas
{--------------------------------------------------------}

unit carFolhe;

interface

uses winProcs, winDos, winTypes, shellApi,
     dvcrt, strings, dvWin, winsock,
     carVars, carUtil, carSMTP, carMsg, carLeit, carList, carApeli, carCC;

procedure folhearCartas;

implementation

var dirAtual: string;

{--------------------------------------------------------}
{                    le o autor da carta
{--------------------------------------------------------}

procedure leAutorCarta (ncar, comoLe: integer);
var texto, autor, data: string;
    i, p: integer;
begin
    texto := buscaNaCarta (ncar, 'From:');
    while (texto <> '') and (texto [1] = ' ') do
        delete (texto, 1, 1);
    autor := texto;

    p := pos ('(', autor);
    if p <> 0 then
        begin
            delete (autor, 1, p);
            while autor [length(autor)] = ' ' do
                delete (autor, length(autor), 1);
            if autor [length (autor)] = ')' then
                delete (autor, length(autor), 1);
        end;

    removeIso (autor);
    if autor = '' then autor := texto;    { casos estranhos... }

    for i := length (autor) downto 1 do
        if autor[i] = '"' then delete (autor, i, 1);

    writeln (autor);

    case comoLe of
        0: begin
               if not keypressed then
                   begin
                        if pos ('<', autor) > 6 then
                             sintetiza (copy (autor, 1, pos ('<', autor)-1))
                        else
                             sintetiza (autor);
                   end;
           end;
        1: sintSoletra (autor);
    end;
end;

{--------------------------------------------------------}
{                  ajuda no folheamento
{--------------------------------------------------------}

procedure ajudaFolheia;
begin
    textBackground(BLUE);

    if not keypressed then
        mensagem ('CTAJFL01', 1);  {'Folheie as cartas com as setas, depois tecle:'}
    if not keypressed then
        mensagem ('CTAJFL02', 1);  {'L - para ler carta'}
    if not keypressed then
        mensagem ('CTAJFL03', 1);  {'I - para obter informações sobre a carta'}
    if not keypressed then
        mensagem ('CTAJFL04', 1);  {'A - apagar a carta'}
    if not keypressed then
        mensagem ('CTAJFL05', 1);  {'E - editar resposta'}
    if not keypressed then
        mensagem ('CTAJFL06', 1);  {'C - copiar a carta para um arquivo'}
    if not keypressed then
        mensagem ('CTAJFL08', 1);  {'T - transmitir cartas já digitadas'}
    if not keypressed then
        mensagem ('CTAJFL09', 1);  {'S - selecionar o nome do remetente associando-o a um apelido'}
    if not keypressed then
        mensagem ('CTAJFL12', 1);  {'O - editar o texto original recebido'}
    if not keypressed then
        mensagem ('CTAJFL10', 1);  {'F5 - procurar um texto no cabeçalho da carta'}
    if not keypressed then
        mensagem ('CTAJFL11', 1);  {'CTL F5 - procurar de novo'}
    if not keypressed then
        mensagem ('CTAJFL07', 1);  {'ESC terminar folheamento'}

    textBackground(BLACK);  clreol;
    writeln;
end;

{--------------------------------------------------------}
{               informacoes sobre a carta
{--------------------------------------------------------}

procedure infoCarta (ncar: integer);
var s, autor, data: string;
    dia, mes, ano, hora, min: string[4];
    sem: string[10];
    nomarq: string;
    dt: TdateTime;
    versaoMime: string;
    c: char;
    nomeProg: string;

begin
    nomarq := regLido [ncar]^.nomArqCarta;

    mensagem ('CTASSUNT', 0);  {'Assunto: '}
    s := buscaNaCarta (ncar, 'Subject:');
    if s = '' then s := '(nulo)';
    if s[1] = ' ' then delete (s, 1, 1);
    removeIso (s);
    sintWriteln (s);

    mensagem ('CTARQUIV', 0);  {'Arquivo '}
    sintWriteln (nomarq);

    versaoMime := buscaNaCarta (ncar, 'Mime-Version');
    if versaoMime <> '' then
         mensagem ('CTTEMATT', 1);     {'Contém arquivos inclusos'}

    mensagem ('CTENVPOR', 0);  {'Enviada por '}
    s := buscaNaCarta (ncar, 'From:');
    if (s <> '') and (s[1] = ' ') then delete (s, 1, 1);
    removeIso (s);
    sintWriteln (s);

    data := buscaNaCarta (ncar, 'Date:');
    while (data <> '') and (data [1] = ' ') do delete (data, 1, 1);
    mensagem ('CTDATENV', 0);  {'Data de envio: '}

    sem := '';
    if not (data[1] in ['0'..'9']) then
        begin
           sem := copy (data, 1, 3);
           delete (data, 1, 5);
        end;

    dia := data[1];
    delete (data, 1, 1);
    if data [1] <> ' ' then
        begin
            dia := dia + data[1];
            delete (data, 1, 1);
        end;
    delete (data, 1, 1);

    mes := copy (data, 1, 3);
    delete (data, 1, 4);
    ano := '';
    data := data + ' ';
    while data[1] <> ' ' do
        begin
            ano := ano + data [1];
            delete (data, 1, 1);
        end;

    if sem = 'Sun' then sem := 'Domingo' else
    if sem = 'Mon' then sem := 'Segunda' else
    if sem = 'Tue' then sem := 'Terca'   else
    if sem = 'Wed' then sem := 'Quarta'  else
    if sem = 'Thu' then sem := 'Quinta'  else
    if sem = 'Fri' then sem := 'Sexta'   else
    if sem = 'Sat' then sem := 'Sabado';

    if mes = 'Jan' then mes := '1'  else
    if mes = 'Feb' then mes := '2'  else
    if mes = 'Mar' then mes := '3'  else
    if mes = 'Apr' then mes := '4'  else
    if mes = 'May' then mes := '5'  else
    if mes = 'Jun' then mes := '6'  else
    if mes = 'Jul' then mes := '7'  else
    if mes = 'Aug' then mes := '8'  else
    if mes = 'Sep' then mes := '9'  else
    if mes = 'Oct' then mes := '10' else
    if mes = 'Nov' then mes := '11' else
    if mes = 'Dec' then mes := '12';

    s := sem + ' ' + dia+ '/' + mes + '/' + ano;
    sintWriteln (s);

    mensagem ('CTDATCHE', 0);  {'Data de chegada: '}
    unpackTime (reglido [ncar]^.datahora, dt);
    str (dt.day, dia);    str (dt.month, mes);  str (dt.year, ano);
    s := dia + '/' + mes + '/' + ano;

    sintWriteln (s);
end;

{--------------------------------------------------------}
{                le a carta com o Levox
{--------------------------------------------------------}

procedure leCarta (ncar: integer);
var nomeProg: string;
    arq, arqTemp: text;
    tempFileName: array [0..144] of char;
    houveErro, acabouCab: boolean;
    s: string;
begin
    mensagem ('CTASSUNT', 0);  {'Assunto: '}
    s := buscaNaCarta (ncar, 'Subject:');
    if s = '' then s := '(nulo)';
    if s[1] = ' ' then delete (s, 1, 1);
    removeIso (s);
    s := convIso (s);
    sintWriteln (s);

    if buscaNaCarta (ncar, 'Mime-Version') <> '' then
        leituraMime (regLido [ncar]^.nomarqCarta)
    else
        begin
            GetTempFileName('C', 'CAR', 0, TempFileName);
            assign (arqTemp, strPas(TempFileName));
            {$I-}  rewrite (arqTemp);   {$I+}
            if ioresult <> 0 then
                begin
                    mensagem ('CTERRTMP', 1);  {'Problemas no arquivo temporário'}
                    exit;
                end;

            assign (arq, regLido [ncar]^.nomarqCarta);
            {$I-} reset (arq);  {$I+}
            if ioresult = 0 then
                begin
                    houveErro := false;
                    acabouCab := false;
                    while (not houveErro) and (not eof (arq)) do
                        begin
                            {$I-}  readln (arq, s);  {$I+}
                            if ioresult = 0 then
                                begin
                                    if acabouCab then
                                        writeln (arqTemp, s);
                                    if s = '' then acabouCab := true;
                                end
                            else
                                begin
                                    mensagem ('CTERRDSK', 1);  {'Erro de escrita no disco'}
                                    houveErro := true;
                                end;
                        end;

                    close (arq);
                    close (arqtemp);

                    while sintFalando do;
                    nomeProg := sintAmbiente ('CARTAVOX', 'LEITOR');
                    if executaProg (nomeProg, dirRecebe, strPas (tempFileName)) then;
                    esperaProgVoltar;
                    delay (1000);
                    while sintFalando do;
                end
            else
                mensagem ('CTCARSUM', 1);  {'Erro no disco: carta sumiu'}

            {$I-}  erase (arqTemp);  {$I+}
            if ioresult <> 0 then;
        end;
end;

{-------------------------------------------------------------}
{                    le o texto original
{-------------------------------------------------------------}

procedure leOriginal (ncar: integer);
var nomeProg: string;
begin
    while sintFalando do;
    nomeProg := sintAmbiente ('CARTAVOX', 'EDITOR');
    if executaProg (nomeProg, dirRecebe, regLido [ncar]^.nomarqCarta) then;
    esperaProgVoltar;
    delay (1000);
    while sintFalando do;
end;

{--------------------------------------------------------}
{                    apaga a carta
{--------------------------------------------------------}

procedure apagaCarta (var ncar: integer);
var s: string;
    c: char;
    i: integer;
    arq: text;
begin
    mensagem ('CTCNFAPA', 1);  {'Confirma o apagamento desta carta com assunto'}
    s := buscaNaCarta (ncar, 'Subject:');
    while (s <> '') and (s[1] = ' ') do
        delete (s, 1, 1);
    removeIso (s);
    if s = '' then s := '(nulo)'
              else s := convIso (s);
    sintWriteln (s);

    mensagem ('CTSIMNAO', 0);  {'(S/N) ? '}
    c := sintReadkey;
    writeln (c);

    if upcase(c) = 'S' then
        begin
            assign (arq, regLido [ncar]^.nomarqCarta);
            {$I-}  erase (arq);  {$I+}
            if ioresult <> 0 then
                mensagem ('CTERRDSK', 1)  {'Erro de escrita no disco'}
            else
                begin
                    mensagem ('CTOKAPA', 1);  {'Ok, carta apagada'}
                    numRegs := numRegs - 1;
                    for i := ncar to numRegs do
                        regLido [i] := regLido [i+1];
                    ncar := ncar - 1;
                end;
        end;
end;

{--------------------------------------------------------}
{                 edita a resposta à carta
{--------------------------------------------------------}

procedure editaResposta (ncar: integer);
var
    nomeProg, nomeArq, nomeDest: string;
    c, c1, c2: char;
    arqin, arqout: text;
    s, assunto: string;

label fim;

begin
    nomeDest := buscaNaCarta (ncar, 'From:');
    while (nomeDest <> '') and (nomeDest [1] = ' ') do
        delete (nomeDest, 1, 1);
    if nomeDest [1] = ' ' then delete (nomeDest, 1, 1);
    removeIso (nomeDest);

    mensagem ('CTPOSMAN', 0);  {'Posso mandar para '}
    write (nomeDest);
    sintetiza (nomeDest);
    mensagem ('CTSIMNAO', 0);  {' (s/n) ? '}
    c := upcase(sintReadKey);
    writeln (c);

    if c = 'N' then
        begin
            mensagem ('CTENDDST', 1);  {'Qual o endereço eletrônico do destinatário? '}
            sintReadln (nomeDest);
            if nomeDest = '' then
                begin
                    mensagem ('CTDESIST', 1);  {'Desistiu...'}
                    exit;
                end;

                if nomeDest [1] = '*' then
                    begin
                        delete (nomeDest, 1, 1);
                        nomeDest := buscaApelido (nomeDest);
                        if nomeDest = '' then
                             mensagem ('CTAPEINV', 1)   {'Apelido inválido'}
                        else
                            begin
                                textBackground (MAGENTA);
                                mensagem ('CTENVPAR', 0);   {'Enviando para: '}
                                textBackground (BLACK);   clreol;
                                sintWriteln (nomeDest);
                                mensagem ('CTCNFDST', 0);  {'Confirma destino {s/n) ? '}
                                sintLeTecla (c1, c2);
                                writeln;
                                if (upcase (c1) = 'N') or (c1 = ESC) then exit;
                            end;
                    end;
        end;

    nomeArq := regLido [ncar]^.nomarqCarta;
    nomeArq := copy (nomearq, 1, length (nomearq)-3) + 'RSP';
    assign (arqin, regLido [ncar]^.nomarqCarta);
    assign (arqout, nomearq);

    mensagem ('CTJOGEDI', 0);  {'Jogo no editor o texto original (s/n) ? '}
    c := sintReadkey;
    writeln (c);

    if upcase (c) = 'S' then
        begin
            assign (arqin, regLido [ncar]^.nomarqCarta);
            assign (arqout, nomearq);

            {$I-} reset (arqin); {$I+}
            if ioresult <> 0 then
                begin
                    mensagem ('CTERRLEI', 1);  {'Erro de leitura do arquivo'}
                    exit;
                end;

            {$I-} rewrite (arqout);  {$i+}
            if ioresult <> 0 then
                begin
                    mensagem ('CTERRDSK', 1);  {'Erro de escrita no disco'}
                    {$I-} close (arqin); {$I+}
                    if ioresult <> 0 then;
                    exit;
                end;

            while not eof (arqin) do
                begin
                    {$I-}  readln (arqin, s);  {$I+}
                    if ioresult <> 0 then
                        begin
                            mensagem ('CTERRLEI', 1);  {'Erro de leitura do arquivo'}
                            goto fim;
                        end;
                    {$I-} writeln (arqout, s);  {$I+}
                    if ioresult <> 0 then
                        begin
                            mensagem ('CTERRDSK', 1);  {'Erro de escrita no disco'}
                            goto fim;
                        end;
                end;

fim:
            {$I-} close (arqin); {$I+}
            if ioresult <> 0 then;
            {$I-} close (arqout); {$I+}
            if ioresult <> 0 then;
        end;

    while sintFalando do;
    nomeProg := sintAmbiente ('CARTAVOX', 'EDITOR');
    if not executaProg (nomeProg, dirRecebe, nomeArq) then exit;

    esperaProgVoltar;
    while sintFalando do;
    while keypressed do readkey;
    delay (1500);
    sintBip;

    anexaAssinatura (nomeArq);

    mensagem ('CTQASSUN', 1);  {'Qual o assunto da carta, enter se só resposta ? '}
    sintReadln (assunto);
    if assunto = '' then
        begin
            assunto := buscaNaCarta (ncar, 'Subject:');
            removeIso (assunto);
            assunto := 'Re: ' + assunto;
        end;

    selecionaCC (regLido [ncar]^.nomarqCarta);

    mensagem ('CTCNFENV', 0);  {'Confirma envio (s/n) ? '}
    c := sintReadkey;
    writeln (c);
    if upcase (c) <> 'N' then
        begin
            chaveMime := '';
            geraTextoSMTP (nomeArq, nomeDest, assunto, pCc, pBcc);
        end;

    {$I-} erase (arqOut);  {$I+}
    if ioresult <> 0 then;
end;

{--------------------------------------------------------}
{                 joga a carta num arquivo
{--------------------------------------------------------}

procedure copiarCartaParaArquivo (ncar: integer);
const
    BUFSIZE = 1024;

var nomearq: string;
    arqin, arqout: file;
    buf: array [0..BUFSIZE-1] of byte;
    erro, nbytes: integer;
    tam: longint;
    c: char;

label fim;

begin
    mensagem ('CTINFDST', 1);  {'Informe o nome completo do arquivo destino:'}
    sintReadln (nomearq);
    if nomearq = '' then
        exit;

    assign (arqin, regLido [ncar]^.nomarqCarta);
    assign (arqout, nomearq);

    {$I-} reset (arqin, 1); {$I+}
    if ioresult <> 0 then
        begin
            mensagem ('CTERRLEI', 1);  {'Erro de leitura do arquivo'}
            exit;
        end;

    {$I-} reset (arqout, 1); {$I+}
    if ioresult = 0 then
        begin
            mensagem ('CTREESCR', 0);   {'Arquivo existente, reescreve ?'}
            c := sintReadkey;
            writeln (c);
            if upcase (c) <> 'S' then
                goto fim;
            close (arqOut);
        end;

    {$I-} rewrite (arqout, 1); {$I+}
    if ioresult <> 0 then
        begin
            mensagem ('CTERRDSK', 1);  {'Erro de escrita no disco'}
            goto fim;
        end;

    tam := filesize (arqin);
    while tam > 0 do
        begin
            nbytes := BUFSIZE;
            if tam < BUFSIZE then nbytes := tam;

            {$I-} blockread  (arqin,  buf, nbytes); {$I+}
            if ioresult <> 0 then
                begin
                    mensagem ('CTERRLEI', 1);  {'Erro de leitura do arquivo'}
                    goto fim;
                end;

            {$I-} blockwrite (arqout, buf, nbytes); {$I+}
            erro := ioresult;
            if erro = 101 then
                begin
                    mensagem ('CTERRDSK', 1);  {'Erro de escrita no disco'}
                    goto fim;
                end;

            tam := tam - BUFSIZE;
        end;

    mensagem ('CTOK', 1);   {'OK'}

fim:
    {$I-} close (arqin);  {$I+}
    if ioresult <> 0 then;
    {$I-} close (arqout); {$I+}
    if ioresult <> 0 then;
end;

{--------------------------------------------------------}
{               associa nome a um apelido
{--------------------------------------------------------}

procedure selecionaApelido (ncar: integer);
var
   nome, apelido: string;
begin
    nome := buscaNaCarta (ncar, 'From:');
    while (nome <> '') and (nome [1] = ' ') do
        delete (nome, 1, 1);
    removeIso (nome);

    mensagem ('CTQAPELI', 1);    {'Informe o apelido desejado para '}
    sintWriteln (nome);
    sintReadln (apelido);

    if apelido <> '' then
        begin
            trocaApelido (apelido, nome);
            mensagem ('CTOK', 1);   {'Ok'}
        end
    else
        mensagem ('CTDESIST', 1);   {'Desistiu'}
end;

{--------------------------------------------------------}
{               folheia e responde cartas
{--------------------------------------------------------}

procedure folhearCartas;
var
    c: char;
    ncar: integer;

    procedure ultimoArquivo;
    begin
        textBackGround (MAGENTA);
        mensagem ('CTULTARQ', 0);  {'Ultimo arquivo...'}
        textBackGround (BLACK);
        writeln;
    end;

begin
    getDir (0, dirAtual);
    {$I-}  chdir (dirRecebe);  {$I+}
    if ioresult <> 0 then ;

    montaListaDeCartas ('CAR');

    if numRegs = 0 then
        begin
            mensagem ('CTSEMCAR', 1);  {'Não tem carta nenhuma neste diretório'}
            exit;
        end;

    textBackGround (MAGENTA);
    mensagem ('CTUSESET', 0);  {'Folheando: use as setas, depois tecle sua opção'}
    textBackground (BLACK);
    writeln;
    ncar := 0;

    repeat
        c := readkey;
        if c = #0 then
            begin
                c := readkey;
                case c of
                    BAIX:   begin
                                ncar := ncar + 1;
                                if ncar > numRegs then
                                    begin
                                        ncar := numRegs + 1;
                                        ultimoArquivo;
                                    end
                                else
                                    leAutorCarta (ncar, 0);
                            end;

                    CIMA:   begin
                                ncar := ncar - 1;
                                if ncar < 1 then
                                    begin
                                        ncar := 0;
                                        ultimoArquivo;
                                    end
                                else
                                    leAutorCarta (ncar, 0);
                            end;

                    ESQ:   if (ncar > 0) and (ncar <= numRegs) then
                                leAutorCarta (ncar, 0);  { todo }

                    DIR:   if (ncar > 0) and (ncar <= numRegs) then
                                leAutorCarta (ncar, 1);  { soletrando }

                    PGUP:   begin
                                ncar := ncar - 5;
                                if ncar < 1 then
                                    begin
                                        ncar := 0;
                                        ultimoArquivo;
                                    end;
                            end;

                    PGDN:   begin
                                ncar := ncar + 5;
                                if ncar > numRegs then
                                    begin
                                        ncar := numRegs + 1;
                                        ultimoArquivo;
                                    end;
                            end;

                    CTLPGUP:  ncar := 0;
                    CTLPGDN:  ncar := numRegs + 1;
                    CTLINS:   poeAreaTransf (ncar);

                    F1:    ajudaFolheia;
                    F5:    procurar (ncar);
                    CTLF5: procuraDeNovo (ncar);
                end;
            end
        else
            begin
                if upcase (c) = 'T' then
                    transmitirCartas
                else
                if (ncar > 0) and (ncar <= numRegs) then
                    case upcase(c) of
                        'I': infoCarta (ncar);
                        'L': leCarta (ncar);
                        'A': begin
                                 apagaCarta (ncar);
                                 if numRegs < 1 then
                                     begin
                                         mensagem ('CTSEMCAR', 1);  {'Não tem carta nenhuma neste diretório'}
                                         exit;
                                     end;
                             end;
                        'E': editaResposta (ncar);
                        'C': copiarCartaParaArquivo (ncar);
                        'S': selecionaApelido (ncar);
                        'O': leOriginal (ncar);
                    else
                        if c <> ESC then mensagem ('CTOPVINV', 1);
                    end;

                if c <> ESC then
                    begin
                        textBackGround (MAGENTA);
                        mensagem ('CTCNTFOL', 0);  {'Continue folheando ou tecle ESC'}
                        textBackGround (BLACK);
                        writeln;
                    end;
            end;

    until c = #$1b;

    while numRegs > 0 do
        begin
            dispose (regLido [numRegs]);
            numRegs := numregs - 1;
        end;
    chDir (dirAtual);
    mensagem ('CTFOLFIM', 1);  {'Folheamento terminado'}
end;

begin
end.

