Bucle while sólo devuelve un valor

[Jovalca]

Hola a todos.

Ante todo y como siempre, gracias por leer este post y a ver si alguien puede echarme una mano.

Estoy desarrollando una aplicación, en principio sencilla, que obtiene el código fuente HTML de un sitio web y lo guarda en un TMemoryStream. Posteriormente, este código lo cargo en un TStringList para poder manipularlo y extraer la información que necesito mediante algunas funciones que ya tengo preparadas. Hasta aquí bien.

Lo que ocurre ahora es que los resultados son varios a lo largo del código fuente y para cogerlos todos he creado el siguiente código:

Código Delphi [-]
var
  i: integer;
begin
  for i:= 0 to Lista.Count -1 do
    begin
    i:= i+1;
    Memo2.Lines.Add(ExtractTagAndTextInsideGivenTagEx('tr',Lista[i]));
  end;
end;

Tambien he probado con:

Código Delphi [-]
while i < Lista.Count -1 do
  begin
    i:= i+1;
    Memo2.Lines.Add(ExtractTagAndTextInsideGivenTagEx('tr',Lista[i]));
  end;

Lo que me ocurre con ambos es que sólo me devuelve el primer resultado que hay en el código... Y al menos hay 7 resultados. Si es capaz de sacar el primer resultado, porqué se detiene y no obtiene los siguientes? Que estoy haciendo mal?

Gracias de antemano.
Saludos.

[[nlsgarcia]]

Jovalca,

Empezado por Jovalca

...Bucle (For/While)...sólo devuelve un valor...Y al menos hay 7 resultados...¿Porqué se detiene y no obtiene los siguientes?...

Revisa esta código:

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function ExtractTagAndTextInsideGivenTagEx(TR, Lista : String) : String;
begin
   Result := UpperCase(TR) + '-' + Lista;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
   i : integer;
   Lista : TStringList;

begin

   Lista := TStringList.Create;

   for i := 1 to 10 do
      Lista.Add('Item-' + IntToStr(i));

   Memo1.Clear;

   for i := 0 to Lista.Count -1 do
   begin
      Memo1.Lines.Add(ExtractTagAndTextInsideGivenTagEx('tr',Lista[i]));
   end;

   Lista.Free;

end;

procedure TForm1.Button2Click(Sender: TObject);
var
   i : integer;
   Lista : TStringList;

begin

   Lista := TStringList.Create;

   for i := 1 to 10 do
      Lista.Add('Item-' + IntToStr(i));

   Memo1.Clear;

   i := 0;

   while i <= Lista.Count - 1 do
   begin
      Memo1.Lines.Add(ExtractTagAndTextInsideGivenTagEx('tr',Lista[i]));
      i := i + 1;
   end;

   Lista.Free;

end;

end.

El código anterior en Delphi 7 sobre Windows 7 Professional x32, genera valores en un TStringList, los procesa y muestra posteriormente en un TMemo para simular la aplicación descrita en el Msg #1.

Espero sea útil

Nelson.

[Jovalca]

Muchas gracias por tu respuesta Nelson.

Lo único es que no veo si puede ayudarme ya que es prácticamente lo que tengo yo.

En tu mensaje:

Código Delphi [-]
begin

   Lista := TStringList.Create; //Creas la lista

   for i := 1 to 10 do
      Lista.Add('Item-' + IntToStr(i)); // Añades 10 lineas

   Memo1.Clear; 

   i := 0;

   while i <= Lista.Count - 1 do //mientras i sea igual o menor que los elementos de la lista
   begin
      Memo1.Lines.Add(ExtractTagAndTextInsideGivenTagEx('tr',Lista[i])); // buscamos "tr" en cada linea
      i := i + 1; // incrementamos i
   end;

   Lista.Free;

end;

Lo unico que no comprendo es esto:

Código Delphi [-]
Result := UpperCase(TR) + '-' + Lista;

La verdad, se me mezcla todo un poco en la cabeza porque hacia tiempo que no cogía este lenguaje ya que últimamente ando con php,html,css...

Esta es la funcion que uso para encontrar y extraer la etiqueta en la lista.
Es posible que algo esté mal aquí?

Código Delphi [-]
function ExtractTagAndTextInsideGivenTagEx(const Tag, Text: string): string;
var
  StartPos, EndPos: integer;
begin
  result := '';
  StartPos := Pos('<' + Tag, Text);
  EndPos:= Pos('<' + '/' + Tag + '>', Text);
  if (StartPos > 0) and (EndPos > StartPos) then
    result := Copy(Text, StartPos, EndPos - StartPos + length(Tag) + 3);
end;

Gracias de nuevo.

[[nlsgarcia]]

Jovalca,

Empezado por Jovalca

...Lo único es que no veo si puede ayudarme ya que es prácticamente lo que tengo yo...

Te comento:

1- El código propuesto en el Msg #2 tiene como único objetivo simular la aplicación mencionada del Msg #1 y mostrar como utilizar los ciclos For y While en dicha simulación.

2- Este es el ciclo For del Msg #1:

Código Delphi [-]
var
  i: integer;
begin
  for i:= 0 to Lista.Count -1 do
    begin
    i:= i+1;
    Memo2.Lines.Add(ExtractTagAndTextInsideGivenTagEx('tr',Lista[i]));
  end;
end;

La línea destacada en rojo produce un error de compilación : [DCC Error] Unit1.pas(32): E2081 Assignment to FOR-Loop variable 'i', no se puede modificar el índice del ciclo For durante su ejecución.

3- Este es el ciclo While del Msg #1:

Código Delphi [-]
while i < Lista.Count -1 do
  begin
    i:= i+1;
    Memo2.Lines.Add(ExtractTagAndTextInsideGivenTagEx('tr',Lista[i]));
  end;

La línea destacada en rojo, incrementa el contador del indice antes de obtener el primer valor de Lista, debe ser después y no indica en que punto fue inicializada a cero dado que en Delphi los indices inician generalmente en dicho valor.

4- La función ExtractTagAndTextInsideGivenTagEx del Msg #2, tiene como único objetivo simular dicha función para efectos de los ciclos For y While.

5- Te sugiero hacer un Debug a la función ExtractTagAndTextInsideGivenTagEx del Msg #3 y verificar si esta retorna en todos casos los valores esperados.

Empezado por Jovalca

...hacia tiempo que no cogía este lenguaje ya que últimamente ando con php, html, css...

Revisa esta información:

Libros y tutoriales para aprender Delphi

Espero sea útil

Nelson.

[Jovalca]

Hola de nuevo Nelson.

Otra vez, gracias por tu tiempo.

Entiendo ahora tus ejemplos.
He reescrito el código y ahora creo que está correcto, al menos no hay advertencias ni corta en ningún momento. Este es el código completo.

Código Delphi [-]
function ExtractCode(const Tag, Text: String): string;
var
  StartPos, EndPos: integer;
begin
  Result:= '';
  StartPos:= Pos('<' + Tag, Text);
  EndPos:= Pos('<' + '/' + Tag + '>', Text);
  if (StartPos > 0) and (EndPos > StartPos) then
    Result:= Copy(Text, StartPos, EndPos - StartPos + Length(Tag) + 3);
end;   

procedure TForm1.StartClick(Sender: TObject);
var
  URL: string;
  SearchParams: string;
  httpClient: THTTPSend;
  Page: TMemoryStream;
  Line: integer;
begin
  URL:= 'http://webpage.com';
  SearchParams:= SearchBox.Text;
  httpClient:= THTTPSend.Create;
  if httpClient.HTTPMethod('GET', (URL+SearchParams)) then
    Page:= TMemoryStream.Create;
    httpClient.Document.SaveToStream(Page);
    httpClient.Free;
    Page.Position:=0;
    PageStrings:= TStringList.Create;
    PageStrings.LoadFromStream(Page);
    Page.Position:=0;
    Memo1.Lines.LoadFromStream(Page);
    Line:= 0;
    while Line <= PageStrings.Count -1 do
      begin
        Memo2.Lines.Add(ExtractCode('tr',PageStrings[Line]));
        Line:= Line+1;
      end;
end;

He hecho una prueba con este html en vez de cargar la página.

<t>115451</t><t>fgfdgdfg<dfg/tdfdsf>fdgfdnkjghrehiu4yi5yuihgfjdrgjkbdfnjgkndfjkngjkndfkjgnkjdfnjkgjkdfngjkdnfjkgkjdfngh<t>45345456gdf</t><t>wwwwwwwwwwwwwwwww</t>



<t>00000000</t><t>534fdgfd45345</t><t>gdfdfg</t>

<t>24981vvvvvvvvv</t>       <t>21f5f1eeeeeeeeee</t>

<t>24981vvvvvvvvv</t> <t>21f5f1eeeeeeeeee</t>

El resultado es el siguiente:

<t>115451</t>
<t>115451</t>
<t>115451</t>
<t>115451</t>
<t>115451</t>
<t>115451</t>
<t>115451</t> 

// El primer valor repetido 7 veces.

En cambio si cargo la pagina completa, el resultado solo se muestra una vez, pero siempre es el primero y no carga mas.

No se, quizá pueda ser algo relacionado con el formato de html? Es que parece como si no incrementara el indice y parara nada mas encontrar la primera.

Yo sigo probando y probando, pero si se te ocurre alguna cosa, te lo agradecería.

Gracias.

[[nlsgarcia]]

Jovalca,

Empezado por Jovalca

...si se te ocurre alguna cosa...

Pregunto:

1- ¿Que versión de Windows utilizas?, ¿Es de 32 o 64 bits?.

2- ¿Que versión de Delphi utilizas?.

3- ¿Estas usando la librería Synapse para obtener la página web?.

4- ¿Cuales son los parámetros de búsqueda en SearchParams?.

5- ¿Cual es la página real que quieres obtener?.

6- ¿Haz realizado un Debug a tu aplicación para verificar su funcionamiento?.

Espero sea útil

Nelson.

[Jovalca]

Veamos:

Sistema operativo OS X Yosemite 64 bits. (Aunque he probado la aplicacion en windows 7 32 bits y tengo el mismo problema).

Lazarus 1.4.0 RC2.

Si, uso la libreria synapse.

Los parametros de busqueda, cualquiera, es una cadena de texto. Por ejemplo, music.

Intento obtener resultados de mp3juices.to

No, aun no he realizado un debug, aunque todo parece correcto.

Gracias otra vez.

[ecfisa]

Hola Jovalca

Empezado por Jovalca

...
He hecho una prueba con este html en vez de cargar la página.

<t>115451</t><t>fgfdgdfg<dfg/tdfdsf>fdgfdnkjghrehiu4yi5yuihgfjdrgjkbdfnjgkndfjkngjkndfkjgnkjdfnjkgjkdfngjkdnfjkgkjdfngh<t>45345456gdf</t><t>wwwwwwwwwwwwwwwww</t>



<t>00000000</t><t>534fdgfd45345</t><t>gdfdfg</t>

<t>24981vvvvvvvvv</t>       <t>21f5f1eeeeeeeeee</t>

<t>24981vvvvvvvvv</t> <t>21f5f1eeeeeeeeee</t>

El resultado es el siguiente:

<t>115451</t>
<t>115451</t>
<t>115451</t>
<t>115451</t>
<t>115451</t>
<t>115451</t>
<t>115451</t> 

// El primer valor repetido 7 veces.

¿ Deseas que el resultado también muestre <t> y </t> al inicio y final del texto que comprenden ? , es decir:

<t>115451</t>

o solamente

115451

Saludos

[Jovalca]

Hola ecfisa.

Ante todo, gracias por tu respuesta.

En principio, me gustaria que las lineas extraídas mostraran tambien las etiquetas, es decir:

<tag> TEXTO </tag>

Mas que nada por que tendría que extraer en este caso, algunas lineas con la etiqueta "<tr>" y otras cuantas con "<td>", etc. Asi que si conservaran la etiqueta mucho mejor porque asi podría diferenciarlas para extraer valores determinados posteriormente.

Crees que el fallo puede estar en la función de extraer?

Gracias de nuevo.

[ecfisa]

Hola Jovalca.

Empezado por Jovalca

Crees que el fallo puede estar en la función de extraer?

Yo creo que si, fijate de este modo:

...
uses StrUtils;

procedure ExtractText(const Tag, Text: string; TS: TStrings);
var
  p1, p2: Integer;
  sufijo, prefijo: string;
begin
  sufijo := '<' + Tag;
  prefijo:= '</' + Tag + '>';
  p1:= Pos(sufijo, Text);
  repeat
    p2:= PosEx(prefijo, Text, p1 + 1);
    if p2 > p1 then
      TS.Add(Copy(Text, p1, p2 - p1 + Length(prefijo)));
    p1:= PosEx(sufijo, Text, p2);
  until p1 < p2;
end;

Usando la cadena que pusiste en el mensaje #5,

procedure TForm1.Button1Click(Sender: TObject);
var
  s: AnsiString;
begin
  s:= '<t>115451</t>'+
      '<t>fgfdgdfg<dfg/tdfdsf>fdgfdnkjghrehiu4yi5yuihgfjdrgjkbdfnjgkndfjkngjkndfkjgnkjdfnjkgjkdfngjkdnfjkgkjdfngh<t>45345456gdf</t>'+
      '<t>wwwwwwwwwwwwwwwww<1/t>'+
      '<t>00000000</t>'+
      '<t>534fdgfd45345</t>'+
      '<t>gdfdfg</t>'+
      '<t>24981vvvvvvvvv</t>'+
      '     <t>21f5f1eeeeeeeeee</t>'+
      '<t>24981vvvvvvvvv</t> <t>21f5f1eeeeeeeeee</t>';
  Memo1.Clear;
  ExtractText('t', s, Memo1.Lines);
end;

se obtiene este resultado:



Saludos

Nota: Usé etiquetas code para evitar la desaparición de texto por las secuencias <t>, </t>.

[Jovalca]

Gracias ecfisa por tu respuesta.

La he probado y ahora si que devuelve todos los resultados. Si que había pensado en meter el bucle en la función a ver si hacía algo, pero entre probar y no probar cosas al final se me pasó.

Gracias por tu tiempo y tu ayuda. Lo que me ocurre ahora es que este "filtro" para obtener etiquetas, le tengo que aplicar varias veces con distintas etiquetas, para ir quedándome sólo con el código que me interesa. Lo que ocurre es que según le voy aplicando, los resultados cada vez son menos coherentes y extrae junto con las etiquetas que necesito, otras tantas que no debería y en una ordenación confusa.

Lo que creo que ocurre es que cuando la cadena de texto está bien separadas por lineas, funciona bien. Pero en cambio, el código fuente de las paginas que obtengo, va con etiquetas que se abren y cierran en lineas distintas y por decirlo de alguna manera, está todo mezclado.

Voy a ver si consigo hacer una función que recorra el texto completo del código fuente, haciendo saltos de linea en cada cierre de etiqueta, es decir ">" para así tener en cada línea una etiqueta y a ver si con esto obtengo unos resultados mejores.

Gracias de nuevo por tu tiempo.
Saludos.

[Jovalca]

Hola de nuevo.

He estado probando a hacer lo que comentaba en el mensaje anterior (hacer salto de linea en cada ">"), puesto que el código fuente que obtengo viene de esta forma y no creo que sea adecuado para manipularlo en un TStringList:

<!DOCTYPE html><html><head><meta charset="utf-8" /><title>Well MP3 Download: FREE Music</title><meta name="description" content="well FREE Mp3 Download & well Songs. Download And Listen Top well Music,  Songs & MP3s. Download well With MP3 search for Top Songs and Music." /><meta name="keywords" content="well mp3, well download, free music" /><meta http-equiv="X-UA-Compatible" content="IE=edge,chrome=1" /><meta name="author" content="MP3Juices" /><link rel="shortcut icon" type="image/x-icon" href="http://mp3juices.to/favicon.ico"><link rel="stylesheet" type="text/css" href="http://static.mp3juices.to/stylesheet.min.css" /><script src="//ajax.googleapis.com/ajax/libs/jquery/1.8.3/jquery.min.js"></script><script type="text/javascript" src="http://static.mp3juices.to/scripts.js?wow=1"></script><script>(function(i,s,o,g,r,a,m){i["GoogleAnalyticsObject"]=r;i[r]=i[r]||function(){ (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o), m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m) })(window,document,"script","//www.google-analytics.com/analytics.js","ga"); ga("create", "UA-43693247-1", "auto"); ga("send", "pageview"); </script></head><body><!-- Tag - Site-Under --><script async="true" src="//s.ad2387.com/script.js?i=876191"></script><!-- Tag - END --><!-- Tag - Top banner --><script async="true" src="//s.ad2387.com/script.js?i=876193"></script>

Y hasta ahora he conseguido esto:

Código Delphi [-]
      PageSource:= TStringList.Create; // creo un stringlist
      PageSource.LoadFromStream(LoadPage); //Cargo el codigo fuente desde un TMemoryStream
      LoadPage.Free;
      for SourcePos:= Length(PageSource.Text) downto 0 do // Como no es adecuado para cargarlo por lineas, lo cargo como una sola cadena
      begin
        if PageSource.Text[SourcePos] = '>' then // Si el index actual de la cadena es igual a '>' entonces
          PageSource.Insert(SourcePos + 1, #13 + #10); //en el index actual + 1 inserto el salto de linea
      end;

Pero con esto me devuelve un error "List index () out of bounds"...
Si pruebo con PageSource.ToString me devuelve un error "Access Violation"
También he probado con el bucle for:

Código Delphi [-]
for SourcePos:= 1 to Length(PageSource.Text) do

Pero obtengo los mismos errores.

La verdad no se si puede manipular un TStringList así y tampoco he encontrado ejemplos claros de como hacerlo.
¿Quizá debería cargar el código de otra forma?

Gracias por cualquier ayuda.
Saludos.

[ecfisa]

Hola Jovalca.

Empezado por Jovalca

Lo que ocurre es que según le voy aplicando, los resultados cada vez son menos coherentes y extrae junto con las etiquetas que necesito, otras tantas que no debería y en una ordenación confusa.
...
Voy a ver si consigo hacer una función que recorra el texto completo del código fuente, haciendo saltos de linea en cada cierre de etiqueta, es decir ">" para así tener en cada línea una etiqueta y a ver si con esto obtengo unos resultados mejores.

Entiendo el problema, pero no sé si será la solución... De todos modos para insertar los saltos de línea yo haría:

Código Delphi [-]
procedure InsertCRLF(var Text: string; const Ch: Char);
const
  CRLF = #$D#$A;
var
  i: Integer;
begin
  i:= 0;
  while i < Length(Text) do
  begin
    if Text[i] = Ch then
    begin
      Insert(CRLF, Text, i+1);
      Inc(i, Length(CRLF));
    end
    else
     Inc(i);
  end;
end;

Prueba:

Código Delphi [-]
procedure TForm1.Button1Click(Sender: TObject);
var
  s : AnsiString;
begin
  with TStringList.Create do
  try
    LoadFromFile('c:\tmp\Jovalca.txt');
    s:= Text;
  finally
    Free;
  end;
  Memo1.Text:= s;
  InsertCRLF(s,'>');
  Memo2.Text:= s;
end;

Salida:



Saludos

[[nlsgarcia]]

Jovalca,

Empezado por Jovalca

...La verdad no se si puede manipular un TStringList así y tampoco he encontrado ejemplos claros de como hacerlo...

Revisa esta información:

1- TStringList
2- El objeto StringList (I)
3- El objeto StringList (II)
4- El objeto StringList (y III)

Espero sea útil

Nelson.

[Jovalca]

Mil Gracias a los dos de nuevo.

Pero cierto, parece que no es la solución ya que ahora después de ordenar el código así, vuelve a darme solo un resultado al extraer las etiquetas con la función.

Gracias de cualquier modo por vuestra ayuda. Voy a plantearme este proyecto desde cero a ver que saco en claro.

Saludos.