{-------------------------------------------------------------}
{                   CartaVox - Cliente POP3
{-------------------------------------------------------------}

unit carPop3;
interface

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

procedure receberCartas;

implementation

var mudo: boolean;

{-------------------------------------------------------------}
{              recebe multiplas linhas do POP3
{-------------------------------------------------------------}

function multiLineReceive (nomeArq: string): boolean;
var
   arq: text;
   s: string;
   i, lidos: integer;
   trazendo: boolean;
   maxLidos: integer;
   gravouAlgo: boolean;
   c: char;

label erro, erroDisco;
begin
    multiLineReceive := true;
    gravouAlgo := false;

    assign (arq, nomeArq);
    {$I-}  rewrite (arq);  {$I+}
    if ioresult <> 0 then
        begin
erroDisco:
            mensagem ('CTPROGRV', 1);  {'Problemas para gravar carta no disco'}
            multiLineReceive := false;
            {$I-}  close (arq);  {$I+}
            if ioresult <> 0 then;
            exit;
        end;

    s := '';
    maxlidos := 0;
    trazendo := true;
    while trazendo do
        begin
            if keypressed then     { cancelamento }
                begin
                    c := readkey;
                    if c = #$1b then goto erro;
                    if c = ' ' then mudo := not mudo;
                end;

            lidos := recv (sockPOP3, bufRecebe, BUFSIZE, 0);
            if (lidos <= 0) then
                begin
                    mensagem ('CTPROCON', 1);  {'Problemas na conexão'}
                    goto erro;
                end;
            bufRecebe [lidos] := #$0;

            maxLidos := maxLidos + lidos;
            if maxLidos > 1024 then
                begin
                    write ('*');
                    if not mudo then
                        if bipaNoSpeaker then bipSpeaker (22)
                                         else sintClek;
                    maxLidos := maxLidos - 1024;
                end;
            for i := 0 to lidos-1 do
                begin
                    s := s + bufRecebe[i];
                    if bufRecebe[i] = #$0a then
                         begin
                             delete (s, length (s), 1);
                             if s [length(s)] = #$0d then
                                 delete (s, length (s), 1);
                             while (s <> '') and (s[length(s)] = ' ') do
                                  delete (s, length (s), 1);
                             if (s = '.') then
                                 trazendo := false
                             else
                                 begin
                                     gravouAlgo := true;
                                     {$I-}  writeln (arq, s);   {$I+}
                                     if ioresult <> 0 then goto erroDisco;
                                 end;

                             s := '';
                         end;

                    if (s = '.' + #$0d) then
                        trazendo := false;
                end;
        end;

    {$I-}  close (arq);  {$I+}
    if ioresult <> 0 then goto erroDisco;
    writeln;
    exit;

erro:
    {$I-}  close (arq);  {$I+}
    if ioresult <> 0 then;

    if not gravouAlgo then
        begin
            {$I-}  erase (arq);  {$I+}
            if ioresult <> 0 then;
        end;

    writeln;
    multiLineReceive := false;
end;

{-------------------------------------------------------------}
{      envia conta e senha para POP3 e ve quantas cartas
{-------------------------------------------------------------}

function inicializaPOP3: boolean;
var
    i, lidos, posErro: integer;
    salvaAttr: word;
    s, senha: string;
    c1, c2: char;
label deNovo, erro;
begin
    inicializaPOP3 := false;

    StrPCopy (bufEnvia, 'USER '+ contaUsuario + CRLF);
    send (sockPOP3, bufEnvia, strlen (bufEnvia), 0);
    netDebug (bufEnvia, strlen (bufEnvia));

    lidos := recv (sockPOP3, bufRecebe, BUFSIZE, 0);
    if (lidos <= 0) then
        goto erro;
    bufRecebe [lidos] := #$0;

    if bufRecebe [0] <> '+' then
        begin
            mensagem ('CTACONT', 0);  {'A conta '}
            sintwrite (contaUsuario);
            mensagem ('CTNAOACE', 1);  {' não foi aceita, servidor falou assim'}
            sintWriteln (strPas (bufRecebe));
            goto erro;
        end
    else
        netDebug (bufRecebe, lidos);

    mensagem ('CTINFSEN', 1);  {'Informe sua senha'}
    salvaAttr := textAttr;
    textColor (black);
    readln (senha);
    textAttr := salvaAttr;

    StrPCopy (bufEnvia, 'PASS '+ senha + CRLF);
    send (sockPOP3, bufEnvia, strlen (bufEnvia), 0);
    netDebug (bufEnvia, strlen (bufEnvia));

    lidos := recv (sockPOP3, bufRecebe, BUFSIZE, 0);
    if (lidos <= 0) then
        goto erro;
    bufRecebe [lidos] := #$0;
    if bufRecebe [0] <> '+' then
        begin
            mensagem ('CTASENHA', 0);  {'A senha '}
            mensagem ('CTNAOACE', 1);  {' não foi aceita, servidor falou assim'}
            sintWriteln (strPas (bufRecebe));
            goto erro;
        end
    else
        netDebug ('PASS ...', 8);

    StrPCopy (bufEnvia, 'STAT' + CRLF);
    send (sockPOP3, bufEnvia, strlen (bufEnvia), 0);
    netDebug (bufEnvia, strlen (bufEnvia));

    lidos := recv (sockPOP3, bufRecebe, BUFSIZE, 0);
    if lidos <= 0 then
        goto erro;
    bufRecebe [lidos] := #$0;
    netDebug (bufRecebe, lidos);

    s := strPas (bufRecebe) + ' 0 0 ';   {sentinela}
    i := 1;
    while not (s[i] in ['0'..'9']) do i := i + 1;
    numCartasPOP3 := 0;
    while s[i] in ['0'..'9'] do
        begin
            numCartasPOP3 := (numCartasPOP3 * 10) + (ord(s[i]) - ord ('0'));
            i := i + 1;
        end;

    while not (s[i] in ['0'..'9']) do i := i + 1 ;
    numBytesPOP3 := 0;
    while s[i] in ['0'..'9'] do
        begin
            numBytesPOP3 := (numBytesPOP3 * 10) + (ord(s[i]) - ord ('0'));
            i := i + 1;
        end;

    mensagem ('CTEXISTE', 0);  {'Existem no servidor '}
    sintWriteInt (numCartasPOP3);
    mensagem ('CTCOMUSO', 0);  {' cartas com uso de '}
    sintWriteInt (numBytesPop3);
    writeln;

    if numCartasPOP3 > 15 then
        begin
deNovo:
            textBackground (MAGENTA);
            mensagem ('CTMUICAR', 0);   {'São muitas cartas, quantas trago agora ? '}
            textBackground (BLACK);
            sintReadln (s);
            val (s, i, posErro);
            if (posErro = 0) and (i > 0) and (numCartasPOP3 > i) then
                numCartasPOP3 := i;
        end;

    while keypressed do readkey;
    interativoPOP3 := false;
    if numCartasPOP3 > 1 then
        begin
            textBackground (MAGENTA);
            mensagem ('CTSELINT', 0);  {'Quer selecionar interativamente ? '}
            textBackground (BLACK);
            sintLeTecla (c1, c2);
            writeln;
            interativoPOP3 := upcase(c1) = 'S';
        end;

    inicializaPOP3 := true;
    exit;

erro:
end;

{-------------------------------------------------------------}
{                   pega o tamanho da carta
{-------------------------------------------------------------}

function pegaTamanhoCarta (qual: integer): longint;
var
    s: string;
    lidos: integer;
    tamanho: longint;
    i: integer;
begin
    pegaTamanhoCarta := 0;

    str (qual, s);
    StrPCopy (bufEnvia, 'LIST ' + s + CRLF);
    send (sockPOP3, bufEnvia, strlen (bufEnvia), 0);
    netDebug (bufEnvia, strlen (bufEnvia));

    lidos := recv (sockPOP3, bufRecebe, BUFSIZE, 0);
    if (lidos <= 0) then
        exit;
    bufRecebe [lidos] := #$0;
    netDebug (bufRecebe, strlen (bufRecebe));
    if bufRecebe [0] <> '+' then
        exit;

    s := strPas (bufRecebe) + ' 0 0 ' ;  { sentinela }
    i := 1;
    while not (s[i] in ['0'..'9']) do i := i + 1;
    while (s[i] in ['0'..'9']) do i := i + 1;
    while not (s[i] in ['0'..'9']) do i := i + 1;
    tamanho := 0;
    while s[i] in ['0'..'9'] do
        begin
            tamanho := (tamanho * 10) + (ord(s[i]) - ord ('0'));
            i := i + 1;
        end;

    pegaTamanhoCarta := tamanho;
end;

{-------------------------------------------------------------}
{                       pega uma carta
{-------------------------------------------------------------}

{ Retornos }
const
    COD_OK = 0;
    COD_DESIST    = 1;
    COD_CANCELA   = 2;
    COD_ERRODISCO = 3;

function pegaUmaCartaPOP3 (qual: integer): integer;
var s, nomeTemp, nomeArqRecebe: string;
    tempFileName: array [0..144] of char;
    arq: text;
    lidos: integer;
    tamanho: longint;
    c1, c2: char;
label erroDisco, pula;

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

    procedure apagaCarta;
    begin
           str (qual, s);
           StrPCopy (bufEnvia, 'DELE ' + s + CRLF);
           send (sockPOP3, bufEnvia, strlen (bufEnvia), 0);
           netDebug (bufEnvia, strlen (bufEnvia));

           lidos := recv (sockPOP3, bufRecebe, BUFSIZE, 0);
           if lidos > 0 then
               begin
                   bufRecebe [lidos] := #$0;
                   netDebug (bufRecebe, lidos);
               end;
    end;

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

begin
    pegaUmaCartaPOP3 := COD_OK;

    tamanho := pegaTamanhoCarta (qual);

    if interativoPOP3 or (tamanho > maxTamAuto) then
        begin
            tamanho := pegaTamanhoCarta (qual);
            str (qual, s);
            StrPCopy (bufEnvia, 'TOP ' + s + ' 0' + CRLF);
            send (sockPOP3, bufEnvia, strlen (bufEnvia), 0);
            netDebug (bufEnvia, strlen (bufEnvia));

            getTempFileName(getTempDrive ('C'), 'xxx', 0, tempFileName);
            nomeTemp := strPas (tempFileName);
            if not multiLineReceive (nomeTemp) then
                 begin
erroDisco:
                     mensagem ('CTERRTMP', 1);  {'Problemas no arquivo temporário'}
                     pegaUmaCartaPOP3 := COD_ERRODISCO;
                     exit;
                 end;

            assign (arq, nomeTemp);
            {$I-}  reset (arq);   {$I+}
            if ioresult <> 0 then
                goto erroDisco;

            while not eof (arq) do
                begin
                    readln (arq, s);
                    if copy (s, 1, 5) = 'From:'    then
                        begin
                            mensagem ('CTENVPOR', 0);  {'Enviada por'}
                            sintWriteln (copy (s, 6, length (s)-5));
                        end;

                    if keypressed then goto pula;

                    if copy (s, 1, 8) = 'Subject:' then
                        begin
                            mensagem ('CTASSUNT', 0);  {'Assunto '}
                            sintWriteln (copy (s, 9, length (s)-8));
                        end;

                    if keypressed then goto pula;
                end;

            mensagem ('CTTAMAN', 0 );   {'Tamanho '}
            sintWriteInt (tamanho);
            writeln;
pula:
            close (arq);
            {$I-}  erase (arq);  {$I+}
            if ioresult <> 0 then ;

            mensagem ('CTPODTRA', 0);  {'Quer trazer ? '}
            sintLeTecla (c1, c2);
            writeln;

            case upcase (c1) of
                #$1b:   begin
                            pegaUmaCartaPOP3 := COD_CANCELA;
                            exit;
                        end;

                'N':    begin
                            pegaUmaCartaPOP3 := COD_DESIST;
                            mensagem ('CTAPGCAR', 0);  {'Apago do servidor '}
                            mensagem ('CTSIMNAO', 0);  {'(S/N) ?'}
                            sintLeTecla (c1, c2);
                            writeln;
                            if upcase(c1) = 'S' then
                                apagaCarta;
                            exit;
                        end;

                'D':    begin
                             debug := not debug;
                             if debug then
                                 mensagem ('CTMODDEB', 1)   {'Modo debug: cartas não serão apagadas'}
                             else
                                 mensagem ('CTMODNOR', 1);  {'Modo normal'}
                        end;
            end;

        end;

    {--- pega finalmente a carta ---}

    str (qual, s);
    StrPCopy (bufEnvia, 'RETR ' + s + CRLF);
    send (sockPOP3, bufEnvia, strlen (bufEnvia), 0);
    netDebug (bufEnvia, strlen (bufEnvia));

    nomeArqRecebe := novoNomeCarta (nbaseRecebe, dirRecebe, 'CAR');
    if not multiLineReceive (nomeArqRecebe) then
        pegaUmaCartaPOP3 := COD_CANCELA
    else
        apagaCarta;
end;

{-------------------------------------------------------------}
{               comunicação com o servidor POP3
{-------------------------------------------------------------}

procedure receberCartas;
var interativo: boolean;
    c1, c2: char;
    lidos, i, codPega: integer;
label abandona, erro;
begin
    textBackground (MAGENTA);
    mensagem ('CTCONTAC', 0);  {'Contactando servidor para receber correspondência'}
    textBackGround (BLACK);
    writeln;

    sockPOP3 := abreConexao (hostPOP3, portaPOP3);
    if sockPOP3 = -1 then
        goto erro;

    lidos := recv (sockPOP3, bufRecebe, BUFSIZE, 0);
    if (lidos <= 0) then
        goto erro;
    bufRecebe [lidos] := #$0;
    netDebug (bufRecebe, lidos);

    mensagem ('CTPEGCOR', 1);  {'Pegando a correspondência'}

    if not inicializaPOP3 then goto erro;

    mudo := false;
    for i := 1 to numCartasPOP3 do
        begin
            textBackGround (BROWN);
            if interativoPOP3 then
                begin
                    mensagem ('CTCARTA', 0);  {'Carta '}
                    sintWriteint (i);
                end
            else
                write ('Carta ', i);
            textBackGround (BLACK);
            writeln;

            codPega := pegaUmaCartaPOP3 (i);
            if codPega in [COD_CANCELA, COD_ERRODISCO]  then
                goto abandona;
        end;

abandona:
    if debug then
        begin
            StrPCopy (bufEnvia, 'RSET' + CRLF);
            send (sockPOP3, bufEnvia, strlen (bufEnvia), 0);
            netDebug (bufEnvia, strlen (bufEnvia));
            lidos := recv (sockPOP3, bufRecebe, BUFSIZE, 0);
            netDebug (bufRecebe, lidos);
        end;

    StrPCopy (bufEnvia, 'QUIT' + CRLF);
    send (sockPOP3, bufEnvia, strlen (bufEnvia), 0);
    netDebug (bufEnvia, strlen (bufEnvia));

    lidos := recv (sockPOP3, bufRecebe, BUFSIZE, 0);
    if lidos <= 0 then
        goto erro;
    bufRecebe [lidos] := #$0;
    netDebug (bufRecebe, lidos);

    if codPega = COD_CANCELA then goto erro;

    closeSocket (sockPOP3);
    wsaCleanup;
    mensagem ('CTOKPEG', 1);  {'Ok, peguei a correspondência'}
    exit;

erro:
    if sockPOP3 >= 0 then
        closeSocket (sockPOP3);
    wsaCleanup;
    writeln;
    while keypressed do readkey;
    mensagem ('CTCONCAN', 1);  {'Conexao com servidor foi cancelada'}
end;

end.
