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][/color:dee85dadca]
Então, no evento OnDocumentComplete do WebBrowser o código abaixo para recuperar os links:
[color=green:dee85dadca][/color:dee85dadca]
E finalmente a procedure que efetivamente baixa e salva as páginas:
[color=green:dee85dadca][/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.
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;
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;
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;
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
Curtir tópico
+ 0
Responder
Clique aqui para fazer login e interagir na Comunidade :)