{-------------------------------------------------------------}
{
{    Webvox - Módulo de correio eletrônico
{
{    Autor: Jose' Antonio Borges
{
{    Em 18/12/99
{
{-------------------------------------------------------------}

unit webMail;

interface
uses dvcrt, dvWin, windos, winProcs, winTypes, dvInet, dvExec, strings, winsock,
     webVars, webMsg;

procedure miniCorreio (enderElet: string);

implementation

{-------------------------------------------------------------}
{                     transmite a carta
{-------------------------------------------------------------}

procedure transmiteCarta (enderElet, meuEnder, assunto, nomeArq: string);
const
    portaSMTP = 25;
    tabMes: array [1..12] of string [3] = (
       'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
var
    arq: text;
    bufEnvia, bufRecebe: array [0..256] of char;
    n, lidos: integer;
    Year, Month, Day, DayOfWeek: Word;
    Hour, Minute, Second, Sec100: Word;
    sockSMTP: integer;
    s, hostSMTP: string;

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

    function strg (i: integer): string;
    var s: string;
    begin
        str (i, s);
        strg := s;
    end;

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

    function enviar (frase: string): boolean;
    var ok: boolean;
    begin
        StrPCopy (bufEnvia, frase + CRLF);
        ok := send (sockSMTP, bufEnvia, strlen (bufEnvia), 0) <> 0;
        write (bufEnvia); clreol;
        if not ok then
            strCopy (bufRecebe, 'Conexão caiu');
        enviar := ok;
    end;

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

    function resposta2xx: boolean;
    begin
        resposta2xx := false;
        strCopy (bufRecebe, 'Conexão caiu');
        lidos := recv (sockSMTP, bufRecebe, BUFSIZE, 0);
        if lidos <= 0 then
            exit;
        bufRecebe [lidos] := #$0;
        write (bufRecebe);
        resposta2xx := bufRecebe[0] = '2';
    end;

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

label fim, erro, erroSemFechar;
begin
    assign (arq, nomeArq);
    {$I-} reset (arq); {$I+}
    if ioresult <> 0 then
        begin
            mensagem ('WBCARNAO', 1);   {'Erro no disco, carta não foi enviada'}
            exit;
        end;

    mensagem ('WBENVCAR', 1);  {'Enviando a carta'}
    writeln;

    bufRecebe [0] := #$0;
    hostSMTP := sintAmbiente ('CARTAVOX', 'SERVIDORSMTP');
    if hostSMTP = '' then goto erro;

    sockSMTP := abreConexao (hostSMTP, portaSMTP);
    if sockSMTP = -1 then goto erroSemFechar;

    textColor (BROWN);

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

    if strlcomp (bufRecebe, '220', 3) <> 0 then
        begin
            textColor (LIGHTGRAY);
            textBackGround (RED);
            mensagem ('WBSRVNAO', 0);  {'Servidor não aceitou conexão, diagnóstico '}
            textBackGround (BLACK);
            writeln;
            sintWriteln (strPas (bufRecebe));
            goto erro;
        end;

    gethostname (bufRecebe, 80);
    computLocal := strPas (bufRecebe);
    if not enviar ('HELO ' + computLocal) then goto erro;
    if not resposta2xx then goto erro;

    getDate(Year, Month, Day, DayOfWeek);
    getTime (Hour, Minute, Second, Sec100);

    if not enviar ('MAIL FROM:<' + meuEnder + '>') then goto erro;
    if not resposta2xx then goto erro;

    if not enviar ('RCPT TO:<' + enderElet + '>')  then goto erro;
    if not resposta2xx then goto erro;

    if not enviar ('DATA') then goto erro;
    if not resposta2xx then;    {na verdade aqui é 354}

    if not enviar ('Date: ' + strg(Day) + ' ' + tabMes [Month] +  ' ' + strg(Year) + ' ' +
                    strg(Hour) + ':' + strg(Minute) + ':' + strg(Second)) then goto erro;
    if not enviar ('Subject: ' + assunto)      then goto erro;
    if not enviar ('From: <' + meuEnder + '>') then goto erro;
    if not enviar ('To: <' + enderElet+ '>')   then goto erro;
    if not enviar ('') then goto erro;

    while not eof (arq) do
        begin
            readln (arq, s);
            if s = '.' then s := ' .';
            if not enviar (s) then goto erro;
        end;

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

    if not enviar ('.') then goto erro;
    if not resposta2xx then goto erro;

    if not enviar ('QUIT') then goto erro;
    if not resposta2xx then goto erro;

    textColor (LIGHTGRAY);
    mensagem ('WBFIMENV', 1);   {'Fim do envio'}

    closeSocket (sockSMTP);
    exit;

erro:
    closeSocket (sockSMTP);

erroSemFechar:
    textColor (LIGHTGRAY);
    while keypressed do readkey;
    mensagem ('WBERRENV', 1);  {'Erro de comunicação ao enviar a carta'}
    sintWriteln (strPas (bufRecebe));
end;

{-------------------------------------------------------------}
{                  prepara carta e envia
{-------------------------------------------------------------}

procedure miniCorreio (enderElet: string);
var meuEnder, assunto, nomeEditor, nomeArq: string;
    TempFileName: array [0..144] of char;
    c1, c2: char;
begin
    textBackground (BLUE);
    mensagem ('WBABREDI', 0);  {'Abrindo editor'}
    textBackground (BLACK);
    writeln;

    GetTempFileName(#$0, 'WEB', 0, TempFileName);
    nomeArq := strPas (TempFileName);

    nomeEditor := sintAmbiente ('CARTAVOX', 'EDITOR');
    if nomeEditor = '' then
         nomeEditor := 'c:\winvox\minied.exe';

    while sintFalando do;
    if executaProg (nomeEditor, '', nomeArq) > 32 then
       begin
            esperaProgVoltar;
            sintBip;
            delay (1000);
        end
    else
        begin
            mensagem ('WBERREDI', 1);    {'Erro ao acionar o editor de textos'}
            exit;
        end;

    mensagem ('WBASSCAR', 1);  {'Qual o assunto da carta ? '}
    sintReadln (assunto);
    if assunto = '' then
         assunto := nomePagAtual;

    mensagem ('WBSEUEND', 1);  {'Seu endereço eletrônico é'}
    meuEnder := sintAmbiente ('CARTAVOX', 'ENDERUSUARIO');
    sintWriteln (meuEnder);

    while keypressed do readkey;
    mensagem ('WBCNFENV', 0);    {'Confirma envio (s/n) ?'}
    sintLeTecla (c1, c2);
    writeln;
    if upcase (c1) = 'N' then exit;

    transmiteCarta (enderElet, meuEnder, assunto, nomeArq);

    while keypressed do readkey;
end;

end.
