{--------------------------------------------------------}
{            Discavox - Folheador de cartas
{--------------------------------------------------------}

unit disFolhe;

interface

uses
    winDos, dvCrt, dvWin, strings,
    disvars, dismsg, disutil, disprot,
    disfala, disdos;

procedure folheiaCartas;

implementation

type
    regCarta = record
        nomArqCarta: string[12];
        datahora: longint;
    end;

var
    numRegs: integer;
    regLido: array [1..200] of regCarta;
    arq: file of regCarta;
    cartaRec: text;

{--------------------------------------------------------}
{              monta lista de cartas
{--------------------------------------------------------}

procedure montaListaDeCartas;
var
    DirInfo: TSearchRec;
    i, j: integer;
    temp: regCarta;

begin
    numRegs := 0;
    mensagem ('DIMONLIS', 1); {Ordenando a lista de cartas por hora de chegada...}

    FindFirst ('*.CAR', FaArchive, DirInfo);
    while DosError = 0 do
            begin
                numRegs := numregs + 1;
                with regLido [numRegs] do
                    begin
                        nomArqCarta := strPas (dirInfo.name);
                        while (nomArqCarta <> '') and
                              (nomArqCarta [length (nomArqCarta)] = ' ') do
                                   delete (nomArqCarta, length (nomArqCarta), 1);
                        dataHora := dirInfo.Time;
                        FindNext (DirInfo);
                    end;
            end;

    for i := 1 to numRegs-1 do
        for j := i+1 to numRegs do
            begin
                if regLido[i].dataHora > regLido[j].dataHora then
                    begin
                        temp := reglido[i];
                        reglido[i] := reglido[j];
                        reglido[j] := temp;
                    end;
            end;


    if numRegs <> 0 then
        mensagem ('DIOKORD', 1); {Ok, cartas ordenadas.}
end;


{--------------------------------------------------------}
{               busca uma cadeia na carta
{--------------------------------------------------------}

function buscaNaCarta (ncar: integer; texto: string): string;
var s: string;
    i: integer;
label pula, achou;
begin
    buscaNaCarta := '';

    assign (cartaRec, regLido [ncar].nomArqCarta);
    {$I-}  reset (cartaRec);  {$I+}
    if ioresult <> 0 then
        begin
            mensagem ('DICARSU', 1); {Erro no disco: carta sumiu}
            exit;
        end;

    while not eof (cartaRec) do
        begin
            readln (cartaRec, s);
            for i := 1 to length (texto) do
                if upcase (texto[i]) <> upcase (s[i]) then
                    goto pula;

            buscaNaCarta := copy (s, length(texto) + 1, length (s) - length(texto));
            goto achou;
pula:;
        end;

achou:

    close (cartaRec);
end;


{--------------------------------------------------------}
{            isola o nome do autor e a data              }
{--------------------------------------------------------}

procedure pegaAutorData (texto: string; var autor, data: string);
var i, npal: integer;
begin
    while (texto <> ' ') and (texto [1] = ' ')  do
        delete (texto, 1, 1);

    if texto = '' then
        begin
            autor := '';
            data := '';
            exit;
        end;

    i := length (texto);

    for npal := 1 to 5 do
        begin
            while (i > 0) and (texto [i] <> ' ') do
                i := i - 1;
            while (i > 0) and (texto [i] = ' ') do
                i := i - 1;
        end;

    autor := copy (texto, 1, i);
    data  := copy (texto, i+2, length(texto) - i+1);
end;

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

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

            while autor [length(autor)] = ' ' do
                delete (autor, length(autor), 1);
            if autor [length (autor)] = ')' then
                delete (autor, length(autor), 1);

            if autor = '' then
                autor := texto;
        end;

    writeln (autor);

    case comoLe of
        0: sintetiza (autor);
        1: sintSoletra (autor);
    end;
end;

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

procedure ajudaFolheia;
begin
    textBackground(BLUE);

    if not keypressed then
        mensagem ('DIAJUFL1', 1); {Folheie as cartas recebidas com as setas, depois tecle:}
    if not keypressed then
        mensagem ('DIAJUFL2', 1); {L - para ler carta}
    if not keypressed then
        mensagem ('DIAJUFL3', 1); {I - para obter informações sobre a carta}
    if not keypressed then
        mensagem ('DIAJUFL4', 1); {A - apagar a carta}
    if not keypressed then
        mensagem ('DIAJUFL5', 1); {E - editar resposta}
    if not keypressed then
        mensagem ('DIAJUFL6', 1); {C - copiar a carta para um arquivo}
    if not keypressed then
        mensagem ('DIAJUFL7', 1); {ESC terminar folheamento}

    textBackground(BLACK);
    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;

begin
    nomarq := regLido [ncar].nomArqCarta;

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

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

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

    data := buscaNaCarta (ncar, 'Date:');
    while (data <> '') and (data [1] = ' ') do delete (data, 1, 1);
    mensagem ('DIDATENV', 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 ('DIDATCHE', 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;
begin
    nomeProg := sintAmbiente ('DISCAVOX', 'LEITOR');
    if nomeProg = '' then
        nomeProg := sintAmbiente ('CARTAVOX', 'LEITOR');
    writeln (nomeProg, '+', regLido [ncar].nomarqCarta);
    if executaProg (nomeProg, '', regLido [ncar].nomarqCarta) then;
    esperaProgVoltar;
end;

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

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

    writeln (s);
    sintetiza (s);
    mensagem ('DISIMNAO', 0); {(S/N) ? }
    c := letecla (1);

    if upcase(c) = 'S' then
        begin
            assign (arq, regLido [ncar].nomarqCarta);
            {$I-}  erase (arq);  {$I+}
            if ioresult <> 0 then
                mensagem ('DIERRDSK', 1) {Erro de escrita no disco}
            else
                begin
                    mensagem ('DIOKAPA', 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 `a carta
{--------------------------------------------------------}

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

label fim;

begin
    nomeDest := buscaNaCarta (ncar, 'From:');

    while (nomeDest <> '') and (nomeDest [1] = ' ') do
        delete (nomeDest, 1, 1);

    mensagem ('DIPOSMAN', 1); {Posso mandar para }
    write (nomeDest);
    sintetiza (nomeDest);
    mensagem ('DISIMNAO', 0); { (s/n) ? }
    c := letecla (1);

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

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

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

    mensagem ('DICOPORG', 0); {Jogo no editor o texto original (s/n) ? }
    c := letecla (1);

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

            {$I-} rewrite (arqout);  {$i+}
            if ioresult <> 0 then
                begin
                    mensagem ('DIERRESC', 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 ('DIERRLEI', 1); {Erro de leitura do arquivo}
                            goto fim;
                        end;
                    {$I-} writeln (arqout, s);  {$I+}
                    if ioresult <> 0 then
                        begin
                            mensagem ('DIERRDSK', 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;

    nomeProg := sintAmbiente ('DISCAVOX', 'EDITOR');
    if nomeProg = '' then
        nomeProg := sintAmbiente ('CARTAVOX', 'EDITOR');
    writeln (nomeProg, '+', nomeArq);
    if not executaProg (nomeProg, '', nomeArq) then exit;
    esperaProgVoltar;

    mensagem ('DICNFENV', 0); {Confirma envio (s/n) ? }
    c := letecla (1);
    if upcase (c) <> 'N' then
        begin
            mensagem ('DIASSUN', 1); {Qual o assunto da carta ?}
            sintReadln (assunto);

            nCartas := nCartas + 1;
            arqCarta [nCartas] := nomeArq;
            destCarta [nCartas] := nomeDest;
            assuntoCarta [nCartas] := assunto;

            mensagem ('DIENVIO', 1); {Carta preparada para envio}
        end;
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;

label fim;

begin
    mensagem ('DIINFDST', 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 exit;
    {$I-} rewrite (arqout, 1); {$I+}
    if ioresult <> 0 then exit;

    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 ('DIERRLEI', 1); {Erro de leitura do arquivo}
                    goto fim;
                end;

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

            tam := tam - BUFSIZE;
        end;

fim:

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

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

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

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

begin
    montaListaDeCartas;

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

    textBackGround (MAGENTA);
    mensagem ('DIPODFOL', 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;

                    F1: ajudaFolheia;

                    GOTFOCUS:
                        begin
                            textBackGround (MAGENTA);
                            mensagem ('DICNTFOL', 0); {Continue folheando ou tecle ESC}
                            textBackGround (BLACK);
                            writeln;
                        end;

                    NOFOCUS: ;
                end;
            end
        else
            begin
                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 ('DISEMCAR', 1); {Não tem carta nenhuma neste diret¢rio}
                                         exit;
                                     end;
                             end;
                        'E': editaResposta (ncar);
                        'C': copiarCartaParaArquivo (ncar);
                    end
                else
                    ajudaFolheia;

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

    until c = #$1b;
end;

begin
end.
