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

unit webcomp;
interface

uses winProcs, winDos, winTypes, shellApi,
     dvcrt, strings, dvWin, winsock, dvexec,
     webVars, webTraz, webUrl, webMsg;

function extraiTagsPagina (nomeArqOrig: string): boolean;

implementation

const TAMBUFDISCO = 1024;

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

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

{-------------------------------------------------------------}
{        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];
         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 := #$ff;
    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 <> #$0d) and (c <> #$0a);

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

    s := '';
    while not (c in [' ', '<', '>', '=', ';', #$ff, #$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;
var i, nbr, ult: integer;
    resto: string;
begin
    while areaSai <> '' do
        begin
            if length (areaSai) < 80 then
                ult := length (areaSai)
            else
                ult := 80;
            while (ult > 40) and (areaSai[ult] <> ' ') do
                ult := ult - 1;

            if (ult = 40) and (length (areaSai) > 80) then
                begin
                    resto := copy (areaSai, 81, length(areaSai)-81+1);
                    areaSai := copy (areaSai, 1, 80);
                end
            else
                begin
                    while (ult > 1) and (areaSai [ult] = ' ') do
                        ult := ult - 1;
                    resto := copy (areaSai, ult+1, length(areaSai)-ult);
                    areaSai := copy (areaSai, 1, ult);
                    while (resto <> '') and (resto[1] = ' ') do
                        delete (resto, 1, 1);
                end;

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

            if areaSai <> '' then
                begin
                    ntags := ntags + 1;
                    getmem (tagsPagina^[ntags], length (areaSai) + 3);
                    tagsPagina^[ntags]^ := 'T|' + areaSai;
                end;

            areaSai := resto;
        end;

    areaSai := '';
end;

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

procedure guardaTag (tag, conteudo: string);
begin
    descarrega;
    if ntags >= MAXTAGSPROG-1 then exit;

    ntags := ntags + 1;
    getmem (tagsPagina^[ntags], length (tag) + length (conteudo) + 2);
    tagsPagina^[ntags]^ := tag + '|' + conteudo;
end;

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

procedure guardaTagPreenc (tag, conteudo: string);
begin
    if ntagsForms >= MAXTAGSPROG-1 then exit;

    ntagsForms := nTagsForms + 1;

    with pilhaPag [topoPilhaPag]^ do
        if not jaCompilado then
            begin
                getmem (tagsForms^[ntagsForms], length (tag) + length (conteudo) + 2);
                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: string;
    c: char;
    n, salvap: integer;
begin
    especial := '';
    salvap := p;

    pegaLetra(c);

    if c = '#' then
        begin
            n := 0;
            repeat
                pegaLetra(c);
                if c in ['0'..'9'] then
                    n := n * 10 + (ord (c) - ord ('0'));
            until not (c in ['0'..'9']);
            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']);

    { 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

    begin
        especial [1] := upcase (especial [1]);
        if especial = 'NBSP'   then trataAcentos := ' ' else
        if especial = 'ORDF'   then trataAcentos := 'a' else
        if especial = 'ORDM'   then trataAcentos := 'o' 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 = 'LAQUO'  then trataAcentos := '"' else
        if especial = 'RAQUO'  then trataAcentos := '"' else
        if especial = 'QUOT'   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 <> #$0d) and (c <> #$0a);
    if c = '=' then
        repeat                 {primeira letra nao branca depois do igual}
            pegaLetra(c);
        until (c <> ' ') 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 = #$ff);
             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 = #$0d) or (c = #$0a) or
          (c = '>') or (c = #$ff);

    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;
    n, erro: integer;
    c: char;
begin
    param := '';
    repeat
        pegaLetra (c);
    until (c in ['0'..'9']) or (c = #$ff);
    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
    if 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;

{-------------------------------------------------------------}
{                  pega url em comando META
{-------------------------------------------------------------}

function pegaURLMeta: string;
var penultima, s: string;
    i: integer;
begin
    pegaURLMeta := '';
    s := '';
    penultima := '';

    repeat
        repeat
            s := pegaCmdMaiusc;
            if s <> '=' then
                penultima := s;
        until (s = '>') or (s = '=');

        if s = '>' then
            begin
                p := p - 1;
                exit;
            end;
    until penultima = 'URL';

    s := pegaParam;
    if s = '>' then exit;

    if s <> '' then
        begin
            if (s[length(s)] = '"') or (s[length(s)] = '''') then
                delete (s, length(s), 1);
            s := transfNomeRef(s);
        end;

    pegaURLMeta := s;
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];
    nomeRef, nomeLoc, nome, valor, alvo, s: string;
    multiplo, cols, rows, selec, ativado, metodo, tipo, tamanho, tamVisual: string [10];
    refLocal, acabouTab: boolean;
    indiceLista: array [1..20] of integer;
    prepreenc: integer;

label achouSubmit;

const
    nomeLista: string [20] = '*.-.................';

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 = #$ff) or (c = '>');
                end
            else
                begin    {comentários}
                    delete (cmd, 1, 2);
                    repeat
                         cmdAnt := cmd;
                         cmd := pegaCmd;
                    until (cmd = #$ff) 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 = '/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')     then

            guardaTag (cmd, '')

    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 = #$ff) or (c = '<');
                if c = #$ff then
                    cmd := '/STYLE'
                else
                    cmd := pegaCmdMaiusc;
            until (cmd = '/STYLE') or (cmd = #$ff);
        end
    else

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

    if cmd = 'IMG' then
        begin
            nomeImg := '';
            nomeLoc := '';
            cmd := pegaCmdMaiusc;
            repeat
                if cmd = #$ff 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 = #$ff);
            faltaFechar := false;

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

            if nomeImg = '' then
                guardaTag ('IMG', nomeLoc)
            else
                guardaTag ('IMG', nomeLoc + '|' + nomeImg);
        end
    else

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

    else
    if cmd = 'UL' then
        begin
            if nivelLista < 1 then nivelLista := 1;
            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 := '';
                for i := 1 to nivelLista do
                    nome := nome + '    ';

                if nivelLista = 0 then
                    begin
                         nivelLista := 1;
                         indiceLista [1] := -9999;
                    end;

                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 = #$ff     then exit
                else
                if cmd = 'HREF'   then  nomeRef := transfNomeRef (pegaParam)
                else
                if cmd = 'TARGET' then  alvo := pegaParam
                else
                if cmd = 'ONMOUSEOVER' then  pegaParam  {ignora}
                ;
                if cmd <> '>' then
                    cmd := pegaCmdMaiusc;
            until (cmd = '>') or (cmd = #$ff);
            faltaFechar := false;
            guardaTag ('AREA HREF', nomeRef)
        end

    else
    if cmd = 'A' then
        begin
            nomeRef := '';
            nomeLoc := '';
            emReferencia := true;
            cmd := pegaCmdMaiusc;
            refLocal := false;
            repeat
                if cmd = #$ff then      exit
                else
                if cmd = 'HREF' then    nomeRef := transfNomeRef (pegaParam)
                else
                if cmd = 'TARGET' then  alvo := pegaParam
                else
                if cmd = 'NAME' then    nomeLoc := 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 = #$ff);
            faltaFechar := false;

            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
        begin
            cmd := pegaCmdMaiusc;
            nomeRef := '';
            if cmd = 'HTTP-EQUIV' then
                begin
                    if nomeRef = '' then
                        begin
                            repeat
                                 cmd := pegaCmdMaiusc;
                            until (cmd = 'CONTENT') or (cmd = '>');
                            if cmd = '>' then
                                faltaFechar := false
                            else
                                begin
                                    nomeRef := pegaURLMeta;
                                    if nomeRef <> '' then
                                        begin
                                            guardaTag ('A HREF', nomeRef);
                                            guardaTag ('T', TXTMETAACESSO);
                                            guardaTag ('/A', '');
                                            guardaTag ('BR', '');
                                        end;
                                end;
                        end;
                end
        end

    else
    if cmd = 'BASE' then
        begin
            cmd := pegaCmdMaiusc;
            if cmd = 'HREF' then    nomeBase := pegaParam;
        end

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

    if cmd = 'FRAME' then
        begin
            nomeRef := '';
            nome := '';

            cmd := pegaCmdMaiusc;
            repeat
                if cmd = #$ff   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 = #$ff);
            faltaFechar := false;

            if nome = '' then nome := nomeRef;
            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 = #$ff);
        end

    else
    if cmd = 'FORM' then
        begin
            { pega action e method }
            nomeRef := '';
            metodo := 'GET';

            cmd := pegaCmdMaiusc;
            repeat
                if cmd = #$ff     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);

                if cmd <> '>' then
                     cmd := pegaCmdMaiusc;
            until (cmd = '>') or (cmd = #$ff);
            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);
        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 = #$ff         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 = #$ff);
            faltaFechar := false;

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

            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 = #$ff   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 = #$ff);

            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 = #$ff   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 = #$ff);
            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 = #$ff   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 = #$ff);

            nome := '';
            repeat
                pegaLetra (c);
                if c = '&' then c := trataAcentos;
                if (c <> #$ff) and (c <> '<') then
                    nome := nome + c;
            until (c = #$ff) or (c = '<');
            while nome [length(nome)] = ' ' do
                delete (nome, length(nome), 1);
            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 = #$ff) 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;
    s: string;
    i: integer;
    tempFileName: array [0..144] of char;

label fim;

begin
    extraiTagsPagina := false;

    ntagsForms := pilhaPag [topoPilhaPag]^.posFormPreenc;
    for i := 1 to ntags do
        freemem (tagsPagina^[i], length (tagsPagina^[i]^) + 1);

    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 = #$ff 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 [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 = ' ') then
                        begin
                            if length (areaSai) > 72 then
                                begin
                                    delete (areaSai, length (areaSai), 1);
                                    descarrega;
                                    if emPre then guardaTag ('BR', '');
                                end
                        end;
                end
            else
                begin
                    descarrega;
                    processaComando;
                end;
        end;

fim:
    descarrega;
    close (arq);

    if ntags = 0 then
        begin
            extraiTagsPagina := false;
            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.
