{--------------------------------------------------------}
{       Cartavox - verificador de cartas enviadas
{--------------------------------------------------------}

unit carVerif;

interface

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

procedure verificarEnviadas;

implementation

var dirAtual: string;

{--------------------------------------------------------}
{              le o destinatario da carta
{--------------------------------------------------------}

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

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

    p := pos ('=?iso-8859-1?Q?', dest);
    if p <> 0 then
        begin
             delete (dest, 1, p+14);
             repeat
                 p := pos ('?=', dest);
                 if p <> 0 then
                     delete (dest, p, 2);
             until p = 0;
             dest := convIso (dest);

             for i := 1 to length (dest) do
                  if dest [i] = '_' then
                      dest [i] := ' ';
        end;

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

    if dest = '' then dest := texto;    { casos estranhos... }

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

    writeln (dest);

    case comoLe of
        0: begin
               if not keypressed then
                   sintetiza (dest);
           end;
        1: sintSoletra (dest);
    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 a 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 ('CTAJFL06', 1);  {'C - copiar a carta para um arquivo'}
    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);
    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;

    function LeadingZero(w : Word) : String;
    var
        s : String;
    begin
        Str(w:0, s);
        if Length(s) = 1 then
           s := '0' + s;
        LeadingZero := s;
    end;

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);
    s := convIso (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 ('CTDATPRP', 0);  {'Data de preparação: '}
    unpackTime (regLido [ncar]^.datahora, dt);
    with dt do
        begin
            sintWrite (leadingZero(day)   + '/' +
                       leadingZero(month) + '/' +
                       leadingZero(year)  + ' ');
            sintClek;
            sintWrite (leadingZero (hour) + ':' +
                       leadingZero(min));
        end;
    writeln;
end;

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

procedure leCarta (ncar: integer);
var nomeProg: string;
begin
    mensagem ('CTLEALTE', 1);       {'Lendo e alterando carta.'}

    while sintFalando do;
    nomeProg := sintAmbiente ('CARTAVOX', 'EDITOR');
    if executaProg (nomeProg, dirEnvia, 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:');
    if s = '' then s := '(nulo)';
    if s[1] = ' ' then delete (s, 1, 1);

    removeIso (s);
    s := convIso (s);
    sintWriteln (s);
    c := sintReadkey;
    writeln (c);
    if upcase(c) <> 'S' then
        exit;

    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;

{--------------------------------------------------------}
{                 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 ('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 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 ('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;

fim:

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

{--------------------------------------------------------}
{               verificar cartas enviadas
{--------------------------------------------------------}

procedure verificarEnviadas;
var
    c: char;
    ncar: integer;
    tipoVerif: string [3];

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

begin
    mensagem ('CTQUEVER', 0);    {'Verificar preparadas ou transmitidas ? '}
    c := readkey;
    sintWriteln (c);

    case upcase (c) of
        ESC: exit;
        'P': tipoVerif := 'CPR';
        'T': tipoVerif := 'ENV';
    else
        mensagem ('CTOPCINV', 1);  {'Opção inválida'}
        exit;
    end;

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

    montaListaDeCartas (tipoVerif);

    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
                                    leDestinatario (ncar, 0);
                            end;

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

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

                    DIR:   if (ncar > 0) and (ncar <= numRegs) then
                                leDestinatario (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 (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;
                        'C': copiarCartaParaArquivo (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.
