PAGUE 6 MESES
LEVE 12 MESES
GARANTIR DESCONTO

Fórum Recuperando Links de uma página da Internet #237630

14/06/2004

0

Olá amigos do fórum,

Estou com um pequeno problema.

Me foi solicitado um programinha que salvasse as páginas do site do TJ-RJ mediante uma busca.
No atual estágio já consegui que o programa fizesse a busca mediante os parâmetros passados pelo usuário, retornasse e salvasse as 10 primeiras páginas.
Meu problema agora está sendo em como salvar as páginas posteriores.
Quando realizamos uma busca no proprio site ele nos retorna 10 resultados e um link no final da página para irmos para os 10 seguintes.

Vou indicar o código que estou usando para este processo.

Ao clicar no botão iniciar:

[color=green:dee85dadca]
Var
 AnoInicio, AnoFim : String;
Begin
   If (EditParametroTJRJ.Text = ´´) or (EditParametroTJRJ.Text = Null) Then
    Begin
     MessageBox(Handle, PChar(´Favor Informar o critério da busca.´), PChar(´Aviso´), 8224);
     EditParametroTJRJ.SetFocus;
     EditParametroTJRJ.Color := clAqua;
     Exit;
    End
  Else
    Begin
     If (CBoxOrigem.Text = ´´) or (CBoxOrigem.Text = Null) Then
      Begin
       MessageBox(Handle, PChar(´Favor Informar a origem para da busca.´), PChar(´Aviso´), 8224);
       CBoxOrigem.SetFocus;
       Exit;
      End
  Else
   Begin
     TBTJRJ.First;
      While Not TBTJRJ.Eof Do
       Begin
        TBTJRJ.Delete;
       End;

    AnoInicio := IntToStr(EditDataInicial.Year);
    AnoFim := IntToStr(EditDataFinal.Year);

    UrlTJRJ := ´http://www.tj.rj.gov.br/scripts/weblink.mgw?MGWLPN=JURIS&LAB=JRP&ORIGEM=´ +
    Origem + ´&PALAVRA=´ + EditParametroTJRJ.Text + ´&PGM=WJURIS02&ROTINA=WJURIS02&TRIPA=NUMERO&ANOINI=´ +
    AnoInicio + ´&ANOFIM=´ + AnoFim;

    urlnavigate := UrlTJRJ;
    WebBrowser1.Navigate2(urlnavigate);
  End;  
 End;
End;
[/color:dee85dadca]

Então, no evento OnDocumentComplete do WebBrowser o código abaixo para recuperar os links:

[color=green:dee85dadca]
Var
 Document : IHtmlDocument2;
 Link     : IHTMLElement;
 StrLinks : String;
 Z        : integer;
 NroLink  : Integer;
 Begin
  Document := WebBrowser1.Document as IHTMlDocument2;
   For Z := 0 To Document.Links.Length - 1 Do
    Begin
     Link := Document.Links.Item(Z, 0) as IHTMLElement;
     StrLinks := Link.ToString + #1310;
     ListBox1.Items.Add(StrLinks);
    End;

  If (ListBox1.Items.Count = 0) or (ListBox1.Items.Count = 1) Then
   Begin
    ListBox1.Items.Clear;
    MessageBox(Handle, PChar(´Nenhum Resultado Encontrado´), PChar(´Informação´), 64);
    Exit;
   End

  Else

   Begin
    With ListBox1 Do
     Begin
      Selected[Count - 1] := True;  // á página sempre traz um link em javascript, que não interessa
      DeleteSelected;
      ClearSelection;
      Selected[Count - 1] := True; // link para a proxima página de resultados
      DeleteSelected;
      ClearSelection;
     End;
   End;

  For NroLink :=0  To ListBox1.Items.Count - 1 Do
   Begin
    TBTJRJ.Append;
    TBTJRJ.FieldByName(´Link´).AsString := ListBox1.Items.Strings[NroLink];
    TBTJRJ.Post;
   End;
  BaixaPaginas;
 End;
[/color:dee85dadca]

E finalmente a procedure que efetivamente baixa e salva as páginas:

[color=green:dee85dadca]
Procedure TfrmPrincipal.BaixaPaginas;
Var
X : Integer;
Begin
TBTJRJ.First;
 HttpStatus := True;
 Inicia_Barra2;
 x := 1;
 While Not TBTJRJ.Eof Do
  Begin
   BaixaUrl := TBTJRJ.FieldValues[´Link´];
    Try
    MEMOTJRJ.Clear;
    MemoTJRJ.Text := AdjustLineBreaks(Trim(Http1.Get(BaixaUrl)));
     Except
     MessageBox(Handle, PChar(´Impossível Conectar ao Site.´ + 1013 + ´Verifique a conexão e tente novamente.´), PChar(´Informação´), 64);
    End;
     MemoTJRJ.Lines.SaveToFile(ExtractFilePath(Application.ExeName)+´Html\TJ-RJ\´ + IntToStr(x) + ´.html´);
     Inc (x);
     Bar2.Position := x;
     Application.ProcessMessages;
   TBTJRJ.Next;
  End;
  HttpStatus := False;
 MessageBox(Handle, PChar(´Extração Concluída com Sucesso!´), PChar(´Informação´), 64);
End;
[/color:dee85dadca]

Talvez esse(s) procedimento(s) possa(m) ser de valia para alguém. Por isso coloquei-o aqui.

Bom, ficaria grato por qualquer sugestão.

No mais abraços à todos.


Plautz

Plautz

Responder

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários, consulte nossa política de privacidade.

Aceitar