{-------------------------------------------------------------}
{
{    Webvox - Módulo de leitura HTML
{
{    Autor: Jose' Antonio Borges
{
{    Em 14/05/98
{
{-------------------------------------------------------------}

unit webcomp;
interface

uses windows, sysutils, shellApi,
     dvcrt, dvWin, winsock, dvexec, webUtil,
     webVars, webTraz, webUrl, webMsg, webGrava;

function extraiTagsPagina (nomeArqOrig: string): boolean;

implementation

const TAMBUFDISCO = 1024;
      ETX = #$03;

var arq: file;
    lido, areaSai: string;
    senhaAtualFTP: string;
    p: integer;
    emComando, emPre: boolean;
    emReferencia: boolean;
    nivelLista: integer;
    faltaFechar: boolean;

    bufDisco: array [0..TAMBUFDISCO-1] of char;
    lidosDisco, pb: integer;
    indiceLista: array [0..20] of integer;
    ultCmd: string;

{-------------------------------------------------------------}
{        traz uma linha do arquivo (com crlf no final)
{-------------------------------------------------------------}

function trazLinha (var lido: string): boolean;
var c: char;
begin
    trazLinha := false;
    lido := '';
    repeat
         if pb >= lidosDisco then
             begin
                 if eof (arq) then
                     begin
                         if lido <> '' then trazLinha := true;
                         exit;
                     end;
                 {$I-} blockRead (arq, bufDisco, TAMBUFDISCO, lidosDisco);  {$I+}
                 if ioresult <> 0 then exit;
                 pb := 0;
             end;

         c := bufDisco [pb];
         if c = ETX then c := '*'
                    else lido := lido + c;
         pb := pb + 1;
    until (c = #$0a) or ((c = '>') and (length (lido) > 160))
                     or ({(c = ' ') and }(length (lido) > 240));
    trazLinha := true;
end;

{-------------------------------------------------------------}
{                   calcula cadeia sem CRLF
{-------------------------------------------------------------}

function semLF (s: string): string;
begin
    if (s <> '') and (s[length(s)] = #$0a) then delete (s, length(s), 1);
    if (s <> '') and (s[length(s)] = #$0d) then delete (s, length(s), 1);
    semLF := s;
end;

{-------------------------------------------------------------}
{                       pega uma letra
{-------------------------------------------------------------}

procedure pegaLetra (var c: char);
begin
    c := ETX;
    if p >= length (lido) then
        begin
            if not trazLinha (lido) then exit;
            p := 0;
        end;

    p := p + 1;
    c := lido[p];
end;

{-------------------------------------------------------------}
{                      pega um comando
{-------------------------------------------------------------}

function pegaCmd: string;
var s: string;
    c: char;
begin
    repeat
        pegaLetra (c);
    until (c <> ' ') and (c <> #$09) and (c <> #$0d) and (c <> #$0a);

    if c in ['<', '>', '=', '!', ';', ETX] then
        begin
            pegaCmd := c;
            exit;
        end;

    s := '';
    while not (c in [' ', #$09, '<', '>', '=', ';', ETX, #$0d, #$0a]) do
        begin
            s := s + c;
            pegaLetra (c);
        end;

    p := p - 1;
    pegaCmd := s;
end;

{-------------------------------------------------------------}
{            pega comando, transforma em maiuscula
{-------------------------------------------------------------}

function pegaCmdMaiusc: string;
var i: integer;
    cmd: string;
begin
    cmd := pegaCmd;
    for i := 1 to length (cmd) do
        cmd[i] := upcase (cmd[i]);
    pegaCmdMaiusc := cmd;
end;

{-------------------------------------------------------------}
{                descarrega tag de texto
{-------------------------------------------------------------}

procedure descarrega;
begin
    if ntags > length(tagsPagina^) - 2 then
        setLength(tagsPagina^, length(tagsPagina^) + 50000);
    if areaSai <> '' then
        begin
            ntags := ntags + 1;
            if not emPre then
                areaSai := trim (areaSai);
            if charsetAtual = 'UTF-8' then
                 areaSai := utfToAnsi (areaSai);
            tagsPagina^[ntags] := 'T|' + areaSai;
        end;
    areaSai := '';
end;

{-------------------------------------------------------------}
{                  guarda um tag
{-------------------------------------------------------------}

procedure guardaTag (tag, conteudo: string);
begin
    descarrega;
    if ntags > length(tagsPagina^) - 2 then
        setLength(tagsPagina^, length(tagsPagina^) + 50000);

    ntags := ntags + 1;
    tagsPagina^[ntags] := tag + '|' + conteudo;
end;

{-------------------------------------------------------------}
{             guarda um tag de preenchimento
{-------------------------------------------------------------}

procedure guardaTagPreenc (tag, conteudo: string);
begin
    if ntagsForms > length(tagsForms^) - 2 then
        setLength(tagsForms^, length(tagsForms^) + 500);

    ntagsForms := nTagsForms + 1;

    with pilhaPag [topoPilhaPag]^ do
        if not jaCompilado then
            begin
                tagsForms^[ntagsForms] := tag + '|' + conteudo;
            end;
end;

{-------------------------------------------------------------}
{        guarda um tag comum e outro de preenchimento
{-------------------------------------------------------------}

procedure guardaTagForm (tag, conteudo: string);
var sf: string[5];
begin
    guardaTagPreenc (tag, conteudo);

    str (nTagsForms, sf);
    conteudo := sf + '|' + conteudo;
    guardaTag (tag, conteudo);
end;

{-------------------------------------------------------------}
{                    trata acentuações
{-------------------------------------------------------------}

function trataAcentos: char;
var especial: shortstring;
    c: char;
    n, salvap, base: integer;
begin
    especial := '';
    salvap := p;

    pegaLetra(c);

    if c = '#' then
        begin
            n := 0;
            base := 10;
            pegaLetra(c);
            if upcase(c) = 'X' then
                begin
                     base := 16;
                     pegaLetra(c);
                end;

            while upcase(c) in ['0'..'9', 'A'..'F'] do
                begin
                    if c in ['0'..'9'] then
                        n := n * base + (ord (c) - ord ('0'))
                    else
                        n := n * base + (ord (upcase(c)) - ord ('A') + 10);
                    pegaLetra(c);
                end;

            trataAcentos := chr(n);
            exit;
        end;

    p := p - 1;
    repeat
        pegaLetra(c);
        if especial <> '' then
            c := upcase (c);
        especial := especial + c;
    until not (upcase(c) in ['A'..'Z', '1'..'4']);

    { foi relaxado o fim do acento ter que ser ponto e virgula }

    delete (especial, length (especial), 1);

    if especial = 'aACUTE' then trataAcentos := 'á' else
    if especial = 'eACUTE' then trataAcentos := 'é' else
    if especial = 'iACUTE' then trataAcentos := 'í' else
    if especial = 'oACUTE' then trataAcentos := 'ó' else
    if especial = 'uACUTE' then trataAcentos := 'ú' else
    if especial = 'AACUTE' then trataAcentos := 'Á' else
    if especial = 'EACUTE' then trataAcentos := 'É' else
    if especial = 'IACUTE' then trataAcentos := 'Í' else
    if especial = 'OACUTE' then trataAcentos := 'Ó' else
    if especial = 'UACUTE' then trataAcentos := 'Ú' else

    if especial = 'aCIRC'  then trataAcentos := 'â' else
    if especial = 'eCIRC'  then trataAcentos := 'ê' else
    if especial = 'oCIRC'  then trataAcentos := 'ô' else
    if especial = 'ACIRC'  then trataAcentos := 'Â' else
    if especial = 'ECIRC'  then trataAcentos := 'Ê' else
    if especial = 'OCIRC'  then trataAcentos := 'Ô' else

    if especial = 'aTILDE' then trataAcentos := 'ã' else
    if especial = 'oTILDE' then trataAcentos := 'õ' else
    if especial = 'ATILDE' then trataAcentos := 'Ã' else
    if especial = 'OTILDE' then trataAcentos := 'Õ' else

    if especial = 'aGRAVE' then trataAcentos := 'à' else
    if especial = 'AGRAVE' then trataAcentos := 'À' else

    if especial = 'uTREMA' then trataAcentos := 'ü' else
    if especial = 'UTREMA' then trataAcentos := 'Ü' else

    if especial = 'uUML'   then trataAcentos := 'ü' else
    if especial = 'UUML'   then trataAcentos := 'Ü' else

    if especial = 'cCEDIL' then trataAcentos := 'ç' else
    if especial = 'CCEDIL' then trataAcentos := 'Ç' else

    if especial = 'nTILDE' then trataAcentos := 'ñ' else
    if especial = 'NTILDE' then trataAcentos := 'Ñ' else

    if especial = 'yACUTE' then trataAcentos := 'ý' else
    if especial = 'YACUTE' then trataAcentos := 'Ý' else

    if especial = 'eGRAVE' then trataAcentos := 'è' else
    if especial = 'iGRAVE' then trataAcentos := 'ì' else
    if especial = 'oGRAVE' then trataAcentos := 'ò' else
    if especial = 'uGRAVE' then trataAcentos := 'ù' else
    if especial = 'EGRAVE' then trataAcentos := 'È' else
    if especial = 'IGRAVE' then trataAcentos := 'Ì' else
    if especial = 'OGRAVE' then trataAcentos := 'Ò' else
    if especial = 'UGRAVE' then trataAcentos := 'Ù' else

    if especial = 'iCIRC'  then trataAcentos := 'î' else
    if especial = 'uCIRC'  then trataAcentos := 'û' else
    if especial = 'ICIRC'  then trataAcentos := 'Î' else
    if especial = 'UCIRC'  then trataAcentos := 'Û' else

    if especial = 'yTREMA' then trataAcentos := 'ÿ' else
    if especial = 'YTREMA' then trataAcentos := 'Ÿ' else
    if especial = 'yUML'   then trataAcentos := 'ÿ' else
    if especial = 'YUML'   then trataAcentos := 'Ÿ' else

    if especial = 'aRING'  then trataAcentos := 'å' else
    if especial = 'ARING'  then trataAcentos := 'Å' else

    if especial = 'aELIG'  then trataAcentos := 'æ' else
    if especial = 'AELIG'  then trataAcentos := 'Æ' else

    if especial = 'eTH'    then trataAcentos := 'ð' else
    if especial = 'ETH'    then trataAcentos := 'Ð' else

    if especial = 'oSLASH' then trataAcentos := 'ø' else
    if especial = 'OSLASH' then trataAcentos := 'Ø' else

    if especial = 'tHORN'  then trataAcentos := 'þ' else
    if especial = 'THORN'  then trataAcentos := 'Þ' else

    if especial = 'sZLIG'  then trataAcentos := 'ß' else

    begin
        especial [1] := upcase (especial [1]);
        if especial = 'TAB'              then trataAcentos := chr(9) else
        if especial = 'NEWLINE'          then trataAcentos := chr(10) else
        if especial = 'EXCL'             then trataAcentos := '!' else
        if especial = 'NUM'              then trataAcentos := '#' else
        if especial = 'DOLLAR'           then trataAcentos := '$' else
        if especial = 'PERCNT'           then trataAcentos := '%' else
        if especial = 'APOS'             then trataAcentos := '''' else
        if especial = 'LPAR'             then trataAcentos := '(' else
        if especial = 'RPAR'             then trataAcentos := ')' else
        if especial = 'MIDAST'           then trataAcentos := '*' else
        if especial = 'AST'              then trataAcentos := '*' else
        if especial = 'PLUS'             then trataAcentos := '+' else
        if especial = 'COMMA'            then trataAcentos := ',' else
        if especial = 'PERIOD'           then trataAcentos := '.' else
        if especial = 'SOL'              then trataAcentos := '/' else
        if especial = 'COLON'            then trataAcentos := ':' else
        if especial = 'SEMI'             then trataAcentos := ';' else
        if especial = 'EQUALS'           then trataAcentos := '=' else
        if especial = 'QUEST'            then trataAcentos := '?' else
        if especial = 'COMMAT'           then trataAcentos := '@' else
        if especial = 'LBRACK'           then trataAcentos := '[' else
        if especial = 'LSQB'             then trataAcentos := '[' else
        if especial = 'BSOL'             then trataAcentos := '\' else
        if especial = 'RBRACK'           then trataAcentos := ']' else
        if especial = 'RSQB'             then trataAcentos := ']' else
        if especial = 'HAT'              then trataAcentos := '^' else
        if especial = 'UNDERBAR'         then trataAcentos := '_' else
        if especial = 'LOWBAR'           then trataAcentos := '_' else
        if especial = 'DIACRITICALGRAVE' then trataAcentos := '`' else
        if especial = 'GRAVE'            then trataAcentos := '`' else
        if especial = 'LBRACE'           then trataAcentos := '{' else
        if especial = 'LCUB'             then trataAcentos := '{' else
        if especial = 'VERTICALLINE'     then trataAcentos := '|' else
        if especial = 'VERBAR'           then trataAcentos := '|' else
        if especial = 'VERT'             then trataAcentos := '|' else
        if especial = 'RBRACE'           then trataAcentos := '}' else
        if especial = 'RCUB'             then trataAcentos := '}' else
        if especial = 'NONBREAKINGSPACE' then trataAcentos := ' ' else
        if especial = 'DOUBLEDOT'        then trataAcentos := '¨' else
        if especial = 'DIE'              then trataAcentos := '¨' else
        if especial = 'DOT'              then trataAcentos := '¨' else
        if especial = 'CIRCLEDR'         then trataAcentos := '®' else
        if especial = 'STRNS'            then trataAcentos := '¯' else
        if especial = 'PM'               then trataAcentos := '±' else
        if especial = 'DIACRITICALACUTE' then trataAcentos := '´' else
        if especial = 'CENTERDOT'        then trataAcentos := '·' else
        if especial = 'CEDILLA'          then trataAcentos := '¸' else
        if especial = 'HALF'             then trataAcentos := '½' else
        if especial = 'DIVIDE'           then trataAcentos := '÷' else
        if especial = 'DIV'              then trataAcentos := '÷' else
        if especial = 'NBSP'             then trataAcentos := ' ' else
        if especial = 'ORDF'             then trataAcentos := 'ª' else
        if especial = 'ORDM'             then trataAcentos := 'º' else
        if especial = 'GT'               then trataAcentos := '>' else
        if especial = 'LT'               then trataAcentos := '<' else
        if especial = 'AMP'              then trataAcentos := '&' else
        if especial = 'COPY'             then trataAcentos := '©' else
        if especial = 'REG'              then trataAcentos := '®' else
        if especial = 'LAQUO'            then trataAcentos := '"' else
        if especial = 'RAQUO'            then trataAcentos := '"' else
        if especial = 'MIDDOT'           then trataAcentos := '*' else
        if especial = 'QUOT'             then trataAcentos := '"' else
        if especial = 'LDQUO'            then trataAcentos := '"' else
        if especial = 'RDQUO'            then trataAcentos := '"' else
        if especial = 'MDASH'            then trataAcentos := '-' else
        if especial = 'NDASH'            then trataAcentos := '-' else
        if especial = 'RSQUO'            then trataAcentos := '''' else
        if especial = 'SHY'              then trataAcentos := ' ' else
        if especial = 'SECT'             then trataAcentos := '§' else
        if especial = 'EURO'             then trataAcentos := '€' else
        if especial = 'TRADE'            then trataAcentos := '™' else
        if especial = 'SBQUO'            then trataAcentos := '''' else
        if especial = 'FNOF'             then trataAcentos := 'ƒ' else
        if especial = 'BDQUO'            then trataAcentos := '"' else
        if especial = 'CIRC'             then trataAcentos := '^' else
        if especial = 'PERMIL'           then trataAcentos := '‰' else
        if especial = 'LSAQUO'           then trataAcentos := '"' else
        if especial = 'LSQUO'            then trataAcentos := '`' else
        if especial = 'BULL'             then trataAcentos := '*' else
        if especial = 'TILDE'            then trataAcentos := '~' else
        if especial = 'RSAQUO'           then trataAcentos := '"' else
        if especial = 'IEXCL'            then trataAcentos := '¡' else
        if especial = 'CENT'             then trataAcentos := '¢' else
        if especial = 'POUND'            then trataAcentos := '£' else
        if especial = 'CURREN'           then trataAcentos := '¤' else
        if especial = 'YEN'              then trataAcentos := '¥' else
        if especial = 'BRVBAR'           then trataAcentos := '¦' else
        if especial = 'UML'              then trataAcentos := '¨' else
        if especial = 'NOT'              then trataAcentos := '¬' else
        if especial = 'MACR'             then trataAcentos := '¯' else
        if especial = 'DEG'              then trataAcentos := '°' else
        if especial = 'PLUSMN'           then trataAcentos := '±' else
        if especial = 'SUP2'             then trataAcentos := '²' else
        if especial = 'SUP3'             then trataAcentos := '³' else
        if especial = 'ACUTE'            then trataAcentos := '´' else
        if especial = 'MICRO'            then trataAcentos := 'µ' else
        if especial = 'PARA'             then trataAcentos := '¶' else
        if especial = 'CEDIL'            then trataAcentos := '¸' else
        if especial = 'SUP1'             then trataAcentos := '¹' else
        if especial = 'FRAC14'           then trataAcentos := '¼' else
        if especial = 'FRAC12'           then trataAcentos := '½' else
        if especial = 'FRAC34'           then trataAcentos := '¾' else
        if especial = 'IQUEST'           then trataAcentos := '¿' else
        if especial = 'TIMES'            then trataAcentos := '×' else
        if especial = 'HELLIP'           then trataAcentos := '…'

        else
            begin
                trataAcentos := '&';
                p := salvap;
            end;
    end;
end;

{-------------------------------------------------------------}
{                pega parametro de uma cláusula
{-------------------------------------------------------------}

function pegaParam: string;
var param: string;
    c: char;
label fim;
begin
    param := '';

    repeat                 {descobre primeira letra nao branca}
        pegaLetra(c);
    until (c <> ' ') and (c <> #$09) and (c <> #$0d) and (c <> #$0a);
    if c = '=' then
        repeat                 {primeira letra nao branca depois do igual}
            pegaLetra(c);
        until (c <> ' ') and (c <> #$09) and (c <> #$0d) and (c <> #$0a);

    if (c = '"') or (c = '''') then
         begin
             repeat
                 if c = '&' then
                     param := param + trataAcentos
                 else
                     param := param + c;
                 pegaLetra(c);
             until (c = param[1]) or (c = ETX);
             delete (param, 1, 1);
             goto fim;
         end;

    param := '';
    repeat
        if c = '&' then
            param := param + trataAcentos
        else
            param := param + c;
        pegaLetra (c);
    until (c = ' ') or (c = #$09) or (c = #$0d) or (c = #$0a) or
          (c = '>') or (c = ETX);

    if c = '>' then p := p - 1;

fim:
    pegaParam := param;
end;

{-------------------------------------------------------------}
{             simplifica a referencia a uma imagem
{-------------------------------------------------------------}

function simplificaImg (nome: string): string;
var p, p2, p1: integer;
begin
    p2 := length (nome);

    p := pos ('.gif', nome);
    if p <> 0 then p2 := p + 3;

    if p = 0 then
        begin
            p := pos ('.jpeg', nome);
            if p <> 0 then p2 := p + 3;
        end;

    if p = 0 then
        begin
            p := pos ('.ng', nome);
            if p <> 0 then p2 := p + 2;
        end;

    if p = 0 then
        begin
            p := pos ('.png', nome);
            if p <> 0 then p2 := p + 3;
        end;

    if p = 0 then
        begin
            p := pos ('.bmp', nome);
            if p <> 0 then p2 := p + 3;
        end;

    if p = 0 then
        begin
            p := pos ('.pcx', nome);
            if p <> 0 then p2 := p + 3;
        end;

    p1 := p2;
    while (p1 > 0) and not (nome[p1] in ['/', '\', '?', '&']) do
        p1 := p1 - 1;

    nome := copy (nome, p1+1, p2-p1);
    simplificaImg := nome;
end;

{-------------------------------------------------------------}
{                pega parametro numérico de uma cláusula
{-------------------------------------------------------------}

function pegaNum: string;
var param: string;
    c: char;
begin
    param := '';
    repeat
        pegaLetra (c);
    until (c in ['0'..'9']) or (c = ETX);
    param := c;
    repeat
        pegaLetra (c);
        if c in ['0'..'9'] then
            param := param + c;
    until not (c in ['0'..'9']);
    p := p - 1;

    pegaNum := param;
end;

{-------------------------------------------------------------}
{     transforma nome parcial em referencia completa http
{-------------------------------------------------------------}

function transfNomeRef (param: string): string;
var
    nomeAbsoluto, s: string;
    p, pp: integer;
label transformou;
begin
    param := trim (param);

(*
    repeat
        p := pos (' ', param);
        if p <> 0 then
            param := copy (param, 1, p-1) + '%20' +
                     copy (param, p+1, 999);
    until p = 0;
*)
    if charsetAtual = 'UTF-8' then
        param := utfToAnsi(param);
    param := urlenc (param);

    if (param <> '') and (param[1] = '#') then
        transfNomeRef := param
    else
        begin
            montaURLrelativa (param, nomeBase, nomeAbsoluto);

            if (maiusc (copy (nomeAbsoluto, 1, 4)) = 'FTP:') and
                (senhaAtualFTP <> '') then
                begin
                    p := pos ('@', nomeAbsoluto);
                    if p = 0 then goto transformou;
                    s := copy (nomePagAtual, 7, p-7);
                    pp := pos (':', s);
                    if pp <> 0 then goto transformou;

                    nomeAbsoluto := copy (nomeAbsoluto, 1, p-1) +
                                    ':' + senhaAtualFTP +
                                    copy (nomeAbsoluto, p, 200);
                end;

transformou:
            transfNomeRef := nomeAbsoluto;
        end;
end;

{-------------------------------------------------------------}
{                    processa comando
{-------------------------------------------------------------}

procedure processaComando;
const
    FIMPRE:      string[6]  = '</PRE>';
    FIMTEXTAREA: string[14] = '</TEXTAREA>';
    FIMSELECT:   string[9]  = '</SELECT>';

var cmd, cmdAnt, nomeImg: string;
    i, col, erro: integer;
    c: char;
    num: string [3];
    tecAtalho: string[1];
    nomeRef, nomeLoc, nome, valor, alvo, s: string;
    multiplo, cols, rows, selec, ativado, metodo, tipo, tamanho, tamVisual: string [10];
    prepreenc: integer;
    tipoEquiv: string;
    param: string;
    par: string;
    lixo: string;
    baserel: string;

label achouSubmit;

const
    nomeLista: pchar = '**.-..................';

begin
    faltaFechar := true;
    cmd := pegaCmdMaiusc;

    if cmd = '!' then
        begin
            cmd := pegaCmdMaiusc;

            if copy (cmd, 1, 2) <> '--' then    { comandos de controle }
                begin
                    repeat
                        pegaLetra (c);
                    until (c = ETX) or (c = '>');
                end
            else
                begin    {comentários}
                    delete (cmd, 1, 2);
                    repeat
                         cmdAnt := cmd;
                         cmd := pegaCmd;
                    until (cmd = ETX) or
                          (copy (cmdAnt, length (cmdAnt)-1, 2) = '--') and (cmd = '>');
                end;
            faltaFechar := false;
        end

    else

    if (cmd = 'HEAD')     or   (cmd = '/HEAD')    or
       (cmd = 'HTML')     or   (cmd = '/HTML')    or
       (cmd = 'HTMO')     or
       (cmd = 'TITLE')    or   (cmd = '/TITLE')   or
       (cmd = '/BODY')    or
       (cmd = 'CENTER')   or   (cmd = '/CENTER')  or
       (cmd = 'BR')       or   (cmd = 'P')        or
       (cmd = 'B')        or   (cmd = '/B')       or
       (cmd = 'I')        or   (cmd = '/I')       or
       (cmd = 'HR')       or
       (cmd = 'MARQUEE')  or   (cmd = '/MARQUEE') or
       (cmd = 'BLOCKQUOTE') or (cmd = '/BLOCKQUOTE')   then
            begin
                guardaTag (cmd, '');
            end

    else
    if (cmd = 'H1')       or
       (cmd = 'H2')       or
       (cmd = 'H3')       or
       (cmd = 'H4')       or
       (cmd = 'H5')       or
       (cmd = 'H6')       or
       (cmd = 'NAV')      then
            begin
                guardaTag (cmd, '');
            end

    else
    if cmd = 'BODY' then
        begin
            cmd := pegaCmdMaiusc;
            nomeRef := '';
            while cmd <> '>' do
                begin
                    if cmd = 'ONLOAD' then
                        begin
                            param := pegaParam;
                            i := pos ('=', param);
                            if i <> 0 then
                                begin
                                    delete (param, 1, i);
                                    nomeRef := transfNomeRef (param);
                                    if (nomeRef <> '') and (nomeRef[1] = '''') or (nomeRef[1] = '"') then
                                        begin
                                            delete (nomeRef, 1, 1);
                                            delete (nomeRef, length (nomeRef), 1);
                                        end;
                                end;
                        end;
                    if cmd <> '>' then
                        cmd := pegaCmdMaiusc;
                end;

            faltaFechar := false;

            guardaTag ('BODY', '');
            if nomeRef <> '' then
                begin
                    guardaTag ('A HREF', nomeRef);
                    guardaTag ('T', 'Página alternativa: ' + nomeRef);
                    guardaTag ('/A', '');
                end;

        end
    else
    if (cmd = 'PRE') then
        begin
            descarrega;
            emPre := true;
        end

    else
    if (cmd = '/PRE') then
        begin
            descarrega;
            emPre := false;
        end

    else
    if (cmd = 'TABLE')    or   (cmd = '/TABLE')   or
       (cmd = 'CAPTION')  or   (cmd = '/CAPTION')  or
       (cmd = 'TH')       or   (cmd = '/TH')  or
       (cmd = 'TD')       or   (cmd = '/TD')  or
       (cmd = 'TR')       then
            guardaTag (cmd, '')

    else
    if cmd = 'STYLE' then
        begin
            repeat
                repeat
                    pegaLetra (c);
                until (c = ETX) or (c = '<');
                if c = ETX then
                    cmd := '/STYLE'
                else
                    cmd := pegaCmdMaiusc;
            until (cmd = '/STYLE') or (cmd = ETX);
        end
    else

    if cmd = 'SCRIPT' then
        begin
            repeat
                repeat
                    pegaLetra (c);
                until (c = ETX) or (c = '<');
                if c = ETX then
                    cmd := '/SCRIPT'
                else
                    cmd := pegaCmdMaiusc;
            until (cmd = '/SCRIPT') or (cmd = ETX);
        end
    else

    if cmd = 'IMG' then
        begin
            nomeImg := '';
            nomeLoc := '';
            cmd := pegaCmdMaiusc;
            repeat
                if cmd = ETX then exit
                else
                if (cmd = 'SRC') then
                     nomeLoc := transfNomeRef (pegaParam)
                else
                if (cmd = 'ALT') then
                     nomeImg := pegaParam
                ;
                if cmd <> '>' then
                    cmd := pegaCmdMaiusc;
            until (cmd = '>') or (cmd = ETX);
            faltaFechar := false;

            if (nomeImg = '') and emReferencia then
                nomeImg := simplificaImg (nomeLoc);

            if nomeImg = '' then
                guardaTag ('IMG', nomeLoc)
            else
                begin
                    if charsetAtual = 'UTF-8' then
                         nomeImg := utfToAnsi (nomeImg);
                    guardaTag ('IMG', nomeLoc + '|' + nomeImg);
                end;
        end
    else

    if (cmd = 'OL') then
        begin
            if nivelLista < 1 then nivelLista := 0;
            nivelLista := nivelLista + 1;
            indiceLista [nivelLista] := 0;
            guardaTag (cmd, '');
        end

    else
    if cmd = 'UL' then
        begin
            if nivelLista < 1 then nivelLista := 0;
            nivelLista := nivelLista + 1;
            indiceLista [nivelLista] := -9999;
            guardaTag (cmd, '');
        end

    else
    if (cmd = '/UL') or (cmd = '/OL') then
        begin
            nivelLista := nivelLista - 1;
            guardaTag (cmd, '');
        end

    else
        if cmd = 'LI' then
            begin
                nome := '';
                if nivelLista < 0 then nivelLista := 0;
                for i := 1 to nivelLista do
                    nome := nome + '    ';

                if indiceLista [nivelLista] = -9999 then
                    nome := nome + nomeLista [nivelLista]
                else
                    begin
                        indiceLista [nivelLista] := indiceLista [nivelLista] + 1;
                        for i := 1 to nivelLista do
                            begin
                                 str (indiceLista [i], num);
                                 nome := nome + num;
                                 if i < nivelLista then
                                     nome := nome + '.';
                            end;
                    end;

                guardaTag (cmd, nome);
            end

    else
    if (cmd = 'DL') or (cmd = '/DL') then
        guardaTag (cmd, '')

    else
    if (cmd = 'MAP') or (cmd = '/MAP') then
        guardaTag (cmd, '')

    else
    if cmd = 'AREA' then   { processamento parcial de map }
        begin
            nomeRef := '';
            cmd := pegaCmdMaiusc;
            repeat
                if cmd = ETX     then exit
                else
                if cmd = 'HREF'   then  nomeRef := transfNomeRef (pegaParam)
                else
                if cmd = 'ALT' then  nomeImg := pegaParam
                else
                if cmd = 'TARGET' then  alvo := pegaParam
                else
                if cmd = 'ONMOUSEOVER' then  pegaParam  {ignora}
                ;
                if cmd <> '>' then
                    cmd := pegaCmdMaiusc;
            until (cmd = '>') or (cmd = ETX);
            faltaFechar := false;
            guardaTag ('AREA HREF', nomeRef + '|' + nomeImg)
        end

    else
    if cmd = 'A' then
        begin
            nomeRef := '';
            nomeLoc := '';
            tecAtalho := '';
            emReferencia := true;
            cmd := pegaCmdMaiusc;
            repeat
                if cmd = ETX then           exit
                else
                if cmd = 'HREF' then
                    begin
                         par := pegaParam;
                         nomeRef := transfNomeRef (par);
                    end
                else
                if cmd = 'ACCESSKEY' then  tecAtalho := pegaParam
                else
                if cmd = 'TARGET' then  alvo := pegaParam
                else
                if cmd = 'NAME' then  nomeLoc := pegaParam
                else
                if cmd = 'TITLE' then lixo := pegaParam
                else
                if cmd = 'ONMOUSEOVER' then  pegaParam  {ignora}
                else
                if (cmd = '<') then
                    begin    { procedimento para evitar erro comum em página}
                        cmd := '>';
                        p := p - 1;
                    end
                else
                ;
                if cmd <> '>' then
                     cmd := pegaCmdMaiusc;
            until (cmd = '>') or (cmd = ETX);
            faltaFechar := false;

            if tecAtalho <> '' then guardaTag('A ACCESSKEY', tecAtalho);                  {Diego}

            if (nomeRef = '') and (nomeLoc = '') then
                  guardaTag ('A HREF', '*Referência com erro')
            else
            if nomeLoc <> '' then    guardaTag ('A NAME', nomeLoc)
                             else    guardaTag ('A HREF', nomeRef);
        end

    else
    if cmd = '/A' then
        begin
            guardaTag ('/A', '');
            emReferencia := false;
        end

    else
    if cmd = 'META' then       // processamento parcial
        begin
            cmd := pegaCmdMaiusc;
            nomeRef := '';
            if cmd = 'CHARSET' then
                begin
                    if pos ('UTF-8', maiuscAnsi(pegaParam)) <> 0 then
                        charsetAtual := 'UTF-8';
                end
            else
            if cmd = 'HTTP-EQUIV' then
                begin
                    tipoEquiv := pegaParam;
                    if maiuscAnsi (tipoEquiv) = 'CONTENT-TYPE' then
                        begin
                            if pegaCmdMaiusc = 'CONTENT' then
                                if pos ('UTF-8', maiuscAnsi(pegaParam)) <> 0 then
                                    charsetAtual := 'UTF-8';
                        end
                    else
                    if maiuscAnsi (tipoEquiv) = 'REFRESH' then
                        begin
                            if pegaCmdMaiusc = 'CONTENT' then
                                begin
                                    param := pegaParam;
                                    i := pos ('URL=', maiuscAnsi (param));
                                    if i <> 0 then
                                        begin
                                            delete (param, 1, i+3);
                                            if param <> '' then
                                                begin
                                                    if (param[1] = '"') then
                                                        begin
                                                            delete (param, length(param), 1);
                                                            delete (param, 1, 1);
                                                        end;
                                                    param := transfNomeRef(param);
                                                    if copy(param, 1, 1) = '''' then
                                                        begin
                                                            delete(param, 1, 1);
                                                            delete(param, length(param), 1);
                                                        end;
                                                    guardaTag ('A HREF', param);
                                                    guardaTag ('T', TXTMETAACESSO);
                                                    guardaTag ('/A', '');
                                                    guardaTag ('BR', '');
                                                end;
                                        end;
                                end;
                        end;

                    while cmd <> '>' do cmd := pegaCmd;
                    faltaFechar := false;
                end
        end

    else
    if cmd = 'BASE' then
        begin
            cmd := pegaCmdMaiusc;
            if cmd = 'HREF' then
                begin
                    baseRel := pegaParam;
                    if upperCase(copy (baseRel, 1, 4)) = 'HTTP' then
                        nomeBase := baseRel
                    else
                    if (baseRel <> '') and (baseRel[1] <> '/') then
                        nomeBase := pegaparam
                    else
                        begin
                            if copy (nomeBase, length(nomeBase), 1) = '/' then
                                 delete (baseRel, 1, 1);
                            nomeBase := nomeBase + baseRel;
                        end;
                end;
        end

    else
    if cmd = 'FRAMESET' then
         guardaTag ('FRAMESET', '')
    else

    if (cmd = 'FRAME') or (cmd = 'IFRAME') then
        begin
            nomeRef := '';
            nome := '';

            cmd := pegaCmdMaiusc;
            repeat
                if cmd = ETX   then  exit
                else
                if cmd = 'SRC'  then  nomeRef := transfNomeRef (pegaParam)
                else
                if cmd = 'NAME' then  nome := pegaParam
                ;
                if cmd <> '>' then
                     cmd := pegaCmdMaiusc;
            until (cmd = '>') or (cmd = ETX);
            faltaFechar := false;

            if nomeRef = '' then  nomeRef := '*Referência com erro';
            guardaTag ('FRAME', nomeRef + '|' + nome);
        end
    else

    if cmd = 'NOFRAMES' then
        begin
            repeat
                cmd := pegaCmdMaiusc;
            until (cmd = '/NOFRAMES') or (cmd = ETX);
        end

    else
    if cmd = 'FORM' then
        begin
            { pega action e method }
            nomeRef := '';
            metodo := 'GET';
            formContentType := 'application/x-www-form-urlencoded';

            cmd := pegaCmdMaiusc;
            repeat
                if cmd = ETX     then  exit
                else
                if cmd = 'METHOD' then  metodo := maiuscAnsi (pegaParam)
                else
                if cmd = 'NAME'   then  nome := pegaParam
                else
                if cmd = 'ACTION' then  nomeRef := transfNomeRef (pegaParam)
                else
                if cmd = 'ENCTYPE' then  formContentType := pegaParam;

                if cmd <> '>' then
                     cmd := pegaCmdMaiusc;
            until (cmd = '>') or (cmd = ETX);
            faltaFechar := false;

            { para contornar o erro do altavista textual }
            if (nomeRef = '') and (
                    (pos ('/',     nome) <> 0) or
                    (pos ('.htm',  nome) <> 0) or
                    (pos ('.html', nome) <> 0))  then
                nomeRef := transfNomeRef (nome);

            guardaTagForm ('FORM', metodo + '|' + nomeRef + '|' + formContentType);
        end

    else
    if cmd = '/FORM' then
         begin
             i := ntags;
             s := '';
             while (s <> 'FORM') and (i > 1) do
                 begin
                     i := i - 1;
                     col := pos ('|', tagsPagina^[i]);
                     s := copy (tagsPagina^[i], 1, col-1);
                     if s = 'INPUT' then
                         begin
                             s := copy (tagsPagina^[i], col+1, length(tagsPagina^[i])-col);
                             col := pos ('|', s);
                             delete (s, 1, col);
                             col := pos ('|', s);
                             s := copy (s, 1, col-1);

                             if s = 'SUBMIT' then goto achouSubmit;
                             if s = 'IMAGE'  then goto achouSubmit;
                         end;
                 end;

             guardaTagForm ('INPUT', 'SUBMIT||1|1|');
             guardaTagForm ('INPUT2', ' |');

achouSubmit:
             guardaTagForm ('/FORM', '');
         end

    else
    if cmd = 'INPUT' then
        begin
            tipo := 'TEXT';
            ativado := ' ';
            nome := '';
            valor := '';
            nomeRef := '';
            tamanho := '230';
            tamVisual := '80';
            cmd := pegaCmdMaiusc;
            repeat
                if cmd = ETX         then  exit
                else
                if cmd = 'TYPE'       then  tipo := maiuscAnsi (pegaParam)
                else
                if cmd = 'NAME'       then  nome := pegaParam
                else
                if cmd = 'SIZE'       then  tamVisual := pegaNum
                else
                if cmd = 'MAXLENGTH'  then  tamanho := pegaNum
                else
                if cmd = 'VALUE'      then  valor := pegaParam
                else
                if cmd = 'SRC'        then  nomeRef := transfNomeRef (pegaParam)
                else
                if cmd = 'CHECKED'    then  ativado := 'S'
                ;
                if cmd <> '>' then
                     cmd := pegaCmdMaiusc;
            until (cmd = '>') or (cmd = ETX);
            faltaFechar := false;

            if tipo = 'BUTTON' then tipo := 'SUBMIT';
            if tipo = 'EMAIL' then
                tipo := 'TEXT';

            if ((tipo = 'RADIO') or (tipo = 'CHECKBOX')) and (ativado = ' ') then
                 ativado := 'N';

            guardaTagForm ('INPUT', tipo + '|' + nome + '|' + tamanho + '|' + tamVisual +
                                '|' + nomeRef);

            guardaTagForm ('INPUT2', ativado + '|' + valor);
        end

    else
    if cmd = 'TEXTAREA' then
        begin
            descarrega;
            cols := '80';
            rows := '1';

            cmd := pegaCmdMaiusc;
            repeat
                if cmd = ETX   then  exit
                else
                if cmd = 'NAME' then  nome := pegaParam
                else
                if cmd = 'COLS' then  cols := pegaNum
                else
                if cmd = 'ROWS' then  rows := pegaNum
                ;
                if cmd <> '>' then
                     cmd := pegaCmdMaiusc;
            until (cmd = '>') or (cmd = ETX);

            guardaTagForm ('TEXTAREA', nome + '|' + cols + '|' + rows);

            lido := copy (lido, p+1, 255);
            if semLF(lido) = '' then trazLinha (lido);   { fim de linha }

            prepreenc := 0;
            repeat
                s := maiuscAnsi (lido);
                p := pos ('</TEXTAREA>', s);
                if p = 0 then { linha sem /textarea}
                    begin
                        guardaTagForm ('TEXTAREA2', semLF(lido));
                        if not trazLinha (lido) then p := 255;
                    end
                else
                if p > 1 then
                     guardaTagForm ('TEXTAREA2', copy (lido, 1, p-1));
                prepreenc := prepreenc+1;
            until p > 0;

            lido := copy (lido, p+11, 255);
            p := 0;

            val (rows, i, erro);
            for i := prepreenc+1 to i do
                guardaTagForm ('TEXTAREA2', '');

            guardaTagForm ('/TEXTAREA', '');
        end

    else
    if cmd = 'SELECT' then
        begin
            descarrega;
            nome    := '';
            tamanho := '80';
            multiplo := '';

            cmd := pegaCmdMaiusc;
            repeat
                if cmd = ETX   then  exit
                else
                if cmd = 'NAME' then  nome := pegaParam
                else
                if cmd = 'SIZE' then  tamanho := pegaNum
                else
                if cmd = 'MULTIPLE' then  multiplo := 'MULTIPLE'
                ;
                if cmd <> '>' then
                     cmd := pegaCmdMaiusc;
            until (cmd = '>') or (cmd = ETX);
            faltaFechar := false;

            guardaTagForm ('SELECT', nome + '|' + tamanho + '|' + multiplo);
        end

    else
    if cmd = '/SELECT' then
        guardaTagForm (cmd, '')

    else
    if cmd = 'OPTION' then
        begin
            selec := '';
            valor := '';
            cmd := pegaCmdMaiusc;
            repeat
                if cmd = ETX   then  exit
                else
                if cmd = 'VALUE'    then  valor := pegaParam
                else
                if cmd = 'SELECTED' then  selec := 'SELECTED'
                ;
                if cmd <> '>' then
                     cmd := pegaCmdMaiusc;
            until (cmd = '>') or (cmd = ETX);

            nome := '';
            repeat
                pegaLetra (c);
                if c = '&' then c := trataAcentos;
                if (c <> ETX) and (c <> '<') then
                    nome := nome + c;
            until (c = ETX) or (c = '<');
            nome := trim (nome);
            p := p - 1;
            faltaFechar := false;

            if valor = '' then valor := nome;
            guardaTagForm ('OPTION', selec + '|' + nome + '|' + valor);
        end

    else
        guardaTag (cmd, '');    {Para possivel fala, mesmo que sem interpretação}

    if faltaFechar then
        repeat
            pegaLetra (c);
        until (c = ETX) or (c = '>');
end;

{-------------------------------------------------------------}
{                     pega senha de FTP
{-------------------------------------------------------------}

function pegaSenhaFTP (nomePag: string): string;
var p: integer;
    s: string;
begin
    pegaSenhaFTP := '';

    if (maiusc (copy (nomePag, 1, 6)) <> 'FTP://') then exit;

    p := pos ('@', nomePagAtual);
    if p = 0 then exit;

    s := copy (nomePagAtual, 7, p-7);
    p := pos (':', s);
    if p = 0 then exit;

    pegaSenhaFTP := copy (s, p+1, 99);
end;

{-------------------------------------------------------------}
{        gera estrutura de dados para processamento
{-------------------------------------------------------------}

function extraiTagsPagina (nomeArqOrig: string): boolean;
var
    compilando: boolean;
    c: char;
    i: integer;
    ultLetraProc: char;

label fim;

begin
    extraiTagsPagina := false;
    ultLetraProc := ' ';
    indiceLista [0] := -9999;
    ultCmd := '';

    ntagsForms := pilhaPag [topoPilhaPag]^.posFormPreenc;
    for i := 1 to ntags do
          tagsPagina^[i] := '';

    senhaAtualFTP := pegaSenhaFTP (nomePagAtual);

    ntags := 0;
    nivelLista := 0;

    assign (arq, nomeArqOrig);
    {$I-}  reset (arq, 1);  {$I+}
    if ioresult <> 0 then
        begin
            mensagem ('WBTRAAPA', 1);   {'Arquivo de trabalho foi apagado'}
            exit;
        end;

    lidosDisco := 0;
    pb := 0;

    emComando := false;
    emReferencia := false;
    emPre := false;
    areaSai := '';

    lido := '';
    p := 2;

    compilando := true;
    while compilando do
        begin
            pegaLetra (c);
            if c = ETX then goto fim;

            if c = '&' then
                areaSai := areaSai + trataAcentos
            else

            if c = #$0d then
            else
            if c = #$0a then
                begin
                    if emPre then
                        begin
                            if (areaSai <> '') and (areaSai [length(areaSai)] = #$0d) then
                                delete (areaSai, length (areaSai), 1);
                            descarrega;
                            guardaTag ('BR', '');
                        end
                    else
                        if (areaSai <> '') and (areaSai [length(areaSai)] <> ' ') then
                            areaSai := areaSai + ' ';
                end

            else
            if c <> '<' then
                begin
                    areaSai := areaSai + c;
                    if (c = ' ') and (ultLetraProc = '.') then
                        descarrega;
                end
            else
                begin
                    descarrega;
                    processaComando;
                end;

            ultLetraProc := c;
        end;

fim:
    descarrega;
    close (arq);

    if ntags = 0 then
        begin
            extraiTagsPagina := false;
            if fileExists (nomeTemp) then
                if DirectoryExists ( dirDownload)  then
                    gravarOriginal (true)
                else
                    mensagem ('WBTIPNAO', 1);   {'Tipo não processavel, para armazenar use a funcao O'}
            exit;
        end;

    pilhaPag [topoPilhaPag]^.jaCompilado := true;

    if tagsPagina^[ntags] <> '/HTML' then
        guardaTag ('/HTML', '');

    extraiTagsPagina := true;
end;

end.
