Получение и парсинг html

[Talker1]

Привет!
Начинаю разбираться с Lazarus, до этого плотно сидел на Delphi.

Хочу написать программу-парсер сайта, для закачки данных в базу. Про работу с базами более-менее понятно, вопрос как в Lazarus получить страницу из инета?
В стандартном наборе компонент подходящих вроде нет. Подскажите есть ли готовые компоненты/библиотеки?
Для windjws/delphi библиотек море, хоть сам на api пиши, а на Lazarus хочу написать код кроссплатформенный.
Кто знает, подскажите в какую сторону смотреть?

[Ism]

http://synapse.ararat.cz/doku.php
Curl
Indy
http://grablib.org/

[debi12345]

Можно написать и на Synapse без использования компонентов, пример веб-робота (получает страницу - заполняет и шлет форму - парсит ответ) приаттачен (URL в примере - от балды).

[amateur]

деби: а не проще без регулялок?

да и вопрос был про получение страницы

плин и почитать не очень ... на форуме уже раз 10 + подобных вопросов, только по разному задаются

Ism питоновый зверь... Какова результативность?

[debi12345]

деби: а не проще без регулялок?

Хм, а что может быть проще регулорок ? И отфильтрует, и заменит, и разобьет на части по лыбому сплит-выражению ?

да и вопрос был про получение страницы

Вторая часть примера как раз анализирует и парсит ответную страницу (Synapse может загружать ее и в StringList - как првило для текущей обрааботки, и в MemoryStream - для отложенной обработки или сохранения в файл).
Если очень надо, то писАл апдэйтер софта - тоже на "синапсе", правда на МСЕ-компонетах. Это апдэйтер конретно страницей занимается - вычленяет заголовки, ... Прицепляю сетевые модули - может окажутся полезными :

Код: Выделить всё

unit netutils;
{$ifdef FPC}{$mode objfpc}{$h+}{$endif}

interface

uses
  msestrings
 ,httpsend
 ,classes {tsrream}
;  

const
  http_max_retries = 5;
  http_timeout = 45000; // ms

type
  treqresult = (REQ_SUCCESS = 0, REQ_FAILED = 1, REQ_NO_DATA = 2);
  updatelevelty = (UL_COMMON, UL_COMMON_OS, UL_EXACT, UL_EXACT_OS);  
  tmpupdatestatety = (TUS_UNKNOWN, TUS_REMOVED, TUS_DOWNLOADED, TUS_CANT_WRITE);

function connect_check(const host: msestring; const port: msestring; const timeoutms: cardinal = 0): boolean;
function is_ipaddr(const avalue: string): boolean;
function HTTPReqStatus(const HttpResultCode: integer): treqresult; 
function http_file_size(const http: thttpsend; const url: msestring; var filesize: integer; var hdrsize: cardinal): treqresult;
function http_get_file(const http: thttpsend; const url: msestring; const reqresult: tstream; ashift: integer = 0): treqresult;
function dnload_full(const http: thttpsend; const url: msestring; const tmpfile: msestring): tmpupdatestatety;

implementation

uses
  blcksock
 ,synacode // EncodeURLElement
 ,synautil // writestrtostream  
 ,regexpr
 ,sysutils 
 ,msestream
 ,miscutils
 ,msesys
 ,msefileutils
;

//-----------------------------

function connect_check(const host: msestring; const port: msestring; const timeoutms: cardinal = 0): boolean;
var
 Socket: TTCPBlockSocket;
begin
result:= false;
Socket := TTCPBlockSocket.Create;
try
  Socket.Connect(host, port); 
  result:= Socket.LastError = 0;
finally
 Socket.Free;
end;
end;

//-----------------------------

function is_ipaddr(const avalue: string): boolean;
begin
result:= execregexpr('[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}',avalue); end;
  
//-----------------------------

function HTTPReqStatus(const HttpResultCode: integer): treqresult; 
begin
case HttpResultcode of
  100..299: result:= REQ_SUCCESS; //informational, success
  300..399: result:= REQ_FAILED; //redirection. Not implemented, but could be.
  400..499: result:= REQ_FAILED; //client error; 404 not found etc
  500..599: result:= REQ_FAILED; //internal server error
else //unknown code
  result:= REQ_FAILED; end;
if HttpResultcode = 404 then result:= REQ_NO_DATA;end;

//-----------------------------

function http_file_size(const http: thttpsend; const url: msestring; var filesize: integer; var hdrsize: cardinal): treqresult;
var 
  i:integer;
  sz:string;
  ch:char;
  httpresult: boolean;
  retriescnt: integer;
begin
filesize:= -1;
result:= REQ_FAILED;
with http do begin 
retriescnt:= 0;
clear; // на всякий случай
httpresult:= HTTPMethod('GET', url);
while (not httpresult) and (http_max_retries > retriescnt) do begin
  sleep(500*retriescnt);
  httpresult:= HTTPMethod('HEAD', url);
  inc(retriescnt); end;
result:= HTTPReqStatus(resultcode);
if result = REQ_SUCCESS then begin
  hdrsize:= Length(Headers.Text);
  for i:= 0 to Headers.Count-1 do begin
    if pos('content-length',lowercase(Headers[i])) > 0 then begin
      sz:= '';
      for ch in Headers[i] do if ch in ['0'..'9'] then sz:= sz + ch;
      filesize:= StrToInt(sz);   
      break; end; end; end; end; end;

//-----------------------------

function http_get_file(const http: thttpsend; const url: msestring; const reqresult: tstream; ashift: integer = 0): treqresult;
var
  httpresult: boolean;
  retriescnt: integer;
  filesize: integer;
  hdrsize: cardinal;
begin
filesize:= -1;
hdrsize:= 0;
result:= REQ_FAILED;
if reqresult = nil then exit;
if ashift > 0 then begin
  reqresult.position:= ashift
end else begin
  reqresult.size:= 0;
end; 
with http do begin
// если не удалось подключиться для чтения размера,
// или файла на сервере нет, то нет смысла общаться с сервером дальше
result:= http_file_size(http,url,filesize,hdrsize);
if result <> REQ_SUCCESS then exit;
if filesize = 0 then begin // если файл на сервере пустой
  reqresult.size:= 0;  // то обрезать выходной поток до нулевой длины 
  result:= REQ_SUCCESS; // и сказать что все ОК
  exit; end 
else  
  if filesize = ashift then begin // файл уже выкачан
    result:= REQ_SUCCESS; // то не качатьснова, а сказать что все ОК
    exit; end;
  clear; // на всякий случай
  RangeStart:= ashift; 
  retriescnt:= 0;
  httpresult:= HTTP.HTTPMethod('GET', url);
  while (not httpresult) and (http_max_retries > retriescnt) do begin
    sleep(500*retriescnt);
    httpresult:= HTTP.HTTPMethod('GET', url);
    inc(retriescnt);end;
  result:= HTTPReqStatus(resultcode);
  if result = REQ_SUCCESS then begin
    reqresult.copyfrom(document,document.size);
    reqresult.position:= 0; end; end; end;

//-----------------------------

function dnload_full(const http: thttpsend; const url: msestring; const tmpfile: msestring): tmpupdatestatety;
var
outstr: tmsefilestream;
rr: treqresult;
shift: cardinal;
begin
result:= TUS_UNKNOWN; // по умолчанию - состояние неизвестно
outstr:= nil;
try
  shift:= file_size(tmpfile); // для докачки
  try
    if shift <= 0 then
      outstr:= tmsefilestream.create(tmpfile,fm_create)
    else
      outstr:= tmsefilestream.create(tmpfile,fm_append);
  except 
    on e:Exception do begin
      result:= TUS_CANT_WRITE;
      exit;
    end;
//    raise exception.create('Can not open temp update file ' + tmpfile + ' for writting'); 
  end;
  rr:= http_get_file(http,url,outstr,{filesize_remote,}shift);
  if rr = REQ_NO_DATA then begin // обновление для данного файла отсутствует на сервере
    outstr.close;
    if findfile(tmpfile) then 
      deletefile(tmpfile); // значит и обновлять нечем, с перестраховкой
    result:= TUS_REMOVED; 
  end 
  else   
    if rr = REQ_SUCCESS then 
      result:= TUS_DOWNLOADED; // обновление скачалось
finally
  if outstr <> nil then begin
    outstr.close;
    outstr.free; end; end; end;

//-----------------------------------

end.

Вроде работает как часы.

[amateur]

эхх: думал увижу велик о редиректе , а увидел

//redirection. Not implemented, but could be

или плохо смотрел...

Вот почему редирект токо в инди встречается (говорят что он иногда партачит, но у меня норм, может плохо ломал). А в остальных только велики надо пришпиливать .

Регулярки не всегда хороши (возможно). Пробывал применить, но автоматами легче получается. Вроде и контролирую процесс и читаемость вменяема, да и скорость моно подвинтить (а регулярка для меня - ооочень темный и ддремучий лес, особенно если иногда они бывают ну оочень длинны).

[debi12345]

думал увижу велик о редиректе , а увидел

Его нетрудно эмулировать - парсингом первичного ответа и повторным вызовом по результатам парсинга.

Добавлено спустя 24 минуты 27 секунд:
Можно даже дописать синапсовый HTTPMethod :
http://www.webdelphi.ru/2010/10/class-helper-dlya-synapse/

Здесь мы вначале перед отправкой данных на сервер сохраняем значения Cookies, Headers и Document для того, чтобы в случае наличия редиректа не потерять эти данные (они автоматически заменяться на заголовки, куки и html-код перенаправления соответственно). Затем отправляем данные с использованием «родного» HTTPMethod и анализируем результат. Если получили код перенаправления, то определяем значение заголовка location и снова отправляем запрос.
Для бОльшей универсальности необходимо было бы сделать подсчёт редиректов и перенаправлять до тех пор пока не получим код отличный от 3хх, но мне такая универсальность не нужна, а Вы сможете дописать метод в любой момент.

Код: Выделить всё

type
 THTTPSend_ = class helper for THTTPSend
 public
   function HeaderNameByIndex(index:integer):string;
   function HeaderByName(const HeaderName:string):string;
 end;

function THTTPSend_.HeaderNameByIndex(index: integer): string;
begin
  if (index>(Headers.Count-1))or(index<0) then Exit;
  Result:=copy(Headers[index],0, pos(':',Headers[index])-1)
end;
 
function THTTPSend_.HeaderByName(const HeaderName: string): string;
var i:integer;
begin
  for i:=0 to Headers.Count-1 do
    begin
      if LowerCase(HeaderNameByIndex(i))=lowercase(HeaderName) then
        begin
          Result:=copy(Headers[i],pos(':',
                       LowerCase(Headers[i]))+2,
                       Length(Headers[i])-length(HeaderName));
          break;
        end;
    end;
end;

function THTTPSend_.HTTPMethod(const Method, URL: string): Boolean;
var Heads: TStringList;
    Cooks: TStringList;
    Redirect: string;
    Doc:TMemoryStream;
begin
  try
    Heads:=TStringList.Create;
    Cooks:=TStringList.Create;
    Doc:=TMemoryStream.Create;
    Doc.LoadFromStream(Document);
    Cooks.Assign(Cookies);
    Heads.Assign(Headers);
    Result:=inherited HTTPMethod(Method,URL);
    if (ResultCode=301)or(ResultCode=302) then
      begin
        Redirect:=HeaderByName('location');
        Headers.Assign(Heads);
        Document.Clear;
        Document.LoadFromStream(Doc);
        Cookies.Assign(Cooks);
        Result:=inherited HTTPMethod(Method,Redirect);
       end;
  finally
    FreeAndNil(Heads);
    FreeAndNil(Cooks);
    FreeAndNil(Doc)
  end;
end;

var HTTP: THTTPSend;
begin
try
  HTTP:=THTTPSend.Create;
    if HTTP.HTTPMethod('GET','AnyURL') then
    begin
      Memo1.Lines.Add('-----------------------------');
      Memo1.Lines.Add(HTTP.Headers.Text);
      Memo1.Lines.Add('-----------------------------');
    end

Indy - для продвинутых, Synapse - для ленивых

Вот еще вариант с расширением класса HTTPSend (подходит для ФПЦ, так как не нуждается в HELPER-классах):

Код: Выделить всё

{Unit: IngHTTPSend}
{Author: Pikhovkin S.}
{E-mail: pikhovkins@gmail.com}

unit IngHTTPSend;

interface

uses
  Classes, SysUtils, HTTPSend, ZLibExGZ, SSL_OpenSSL;

type
  { TIngHTTPSend }
  TIngHTTPSend = class(THTTPSend)
  private
    fGZIPDecode: Boolean;
    fOutStream: TMemoryStream;
    function GetDefaultHeader: String;
    procedure SetGZIPDecode(Value: Boolean);
  protected

  public
    constructor Create;
    destructor Destroy; override;
    function SendHTTP(const ToHeader, ToURL, ToDocument: string): Integer;
    function GetParamValue(const PosParam: String; const PosValue: String = ''): String;
    function URLDecode(const Value: String): String;
    function URLEncode(const Value: String): String;
    function HTTPEncode(const Value: String): String;
  published
    property Headers;
    property Cookies;
    property Document;
    property MimeType;
    property Protocol;
    property KeepAlive;
    property Status100;
    property ProxyHost;
    property ProxyPort;
    property ProxyUser;
    property ProxyPass;
    property UserAgent;
    property ResultCode;
    property ResultString;
    //-------------------
    property DefaultHeader: String read GetDefaultHeader;
    property GZIPDecode: Boolean write SetGZIPDecode default true;
  end;

implementation

{ TIngHTTPSend }

constructor TIngHTTPSend.Create;
begin
  inherited;
  fOutStream := TMemoryStream.Create;
  fGZIPDecode := true;
  fProtocol := '1.1';
  fUserAgent := 'Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.1.2) Gecko/20090729 Firefox/3.5.2 (.NET CLR 3.5.30729)';
end;

destructor TIngHTTPSend.Destroy;
begin
  fOutStream.Free;
  inherited;
end;

function TIngHTTPSend.GetDefaultHeader: String;
begin
  Result := 'Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8' + #13#10 +
    'Accept-Language: ru,en-us;q=0.7,en;q=0.3' + #13#10 +
    'Accept-Encoding: gzip,deflate' + #13#10 +
    'Accept-Charset: windows-1251,utf-8;q=0.7,*;q=0.7';
end;

function TIngHTTPSend.GetParamValue(const PosParam: String; const PosValue: String = ''): String;
var
  PosList: TStringList;
begin
  Result := '';
  PosList := TStringList.Create;
  try
    PosList.Assign(Headers);
    PosList.NameValueSeparator := ':';
    if PosValue = '' then
      Result := Trim(PosList.Values[PosParam]) else
      if Pos(PosValue, PosList.Values[PosParam]) > 0
      then Result := PosValue;
  finally
    PosList.Free;
  end;
end;

function TIngHTTPSend.SendHTTP(const ToHeader, ToURL, ToDocument: string): Integer;
var
  HttpMethodKind: String;
  SL: TStringList;
begin
  HttpMethodKind := 'GET';
  Headers.Clear;
  Document.Clear;
  if ToHeader = '' then
    Headers.Add(DefaultHeader) else
    Headers.Add(ToHeader);
  MimeType := '';
  if ToDocument <> '' then
  begin
    HttpMethodKind := 'POST';
    MimeType := 'application/x-www-form-urlencoded';
    Document.Write(PChar(ToDocument)^, Length(ToDocument));
  end;
  HTTPMethod(HttpMethodKind, ToURL);
  Result := ResultCode;
  if {(Document.Size > 0) and} (ResultCode = 200) then
    if fGZIPDecode then
      if (GetParamValue('Content-Encoding', 'gzip') = 'gzip') and ((GetParamValue('Content-Type', 'text/') = 'text/') or (Pos('https://', ToURL) = 1)) then
      begin
        try
          GZDecompressStream(Document, fOutStream);
          Document.LoadFromStream(fOutStream);
          Document.Position := 0;
          fOutStream.Clear;
        except
          Result := 0;
          Document.SaveToFile('error_Decomp_' + FormatDateTime('hh-nn-ss-zzz', Time)+'.html');
          Document.Clear;
          SL := TStringList.Create;
          SL.Add('Result = ' + IntToStr(ResultCode) + ' ' + ResultString);
          SL.Add(ToURL);
          SL.Add(ToDocument);
          SL.SaveToFile('error_Decomp_' + FormatDateTime('hh-nn-ss-zzz', Time)+'.log');
          SL.Free;
        end;
      end;
end;  

procedure TIngHTTPSend.SetGZIPDecode(Value: Boolean);
begin
  fGZIPDecode := Value;
end;

function TIngHTTPSend.URLDecode(const Value: String): String;
var
  Sp, Rp, Cp, Tp: PChar;
  int: Integer;
  S: String;
begin
  SetLength(Result, Length(Value));
  Sp := PChar(Value);
  Rp := PChar(Result);
  while Sp^ <> #0 do
  begin
    case Sp^ of
      '+': Rp^ := ' ';
      '%':
        begin
          Tp := Sp;
          Inc(Sp);
          if Sp^ = '%' then
            Rp^ := '%' else
          begin
            Cp := Sp;
            Inc(Sp);
            if (Cp^ <> #0) and (Sp^ <> #0) then
            begin
              S := '$' + Cp^ + Sp^;
              if TryStrToInt(s, int) then
                Rp^ := Chr(int)
              else
              begin
                Rp^ := '%';
                Sp := Tp;
              end;
            end
            else
            begin
              Rp^ := '%';
              Sp := Tp;
            end;
          end;
        end; // '%':
      else Rp^ := Sp^;
    end; // case of
    Inc(Rp);
    Inc(Sp);
  end; // while Sp^ <> #0 do
  SetLength(Result, Rp - PChar(Result));
end;

function TIngHTTPSend.URLEncode(const Value: String): String;
const
  NoConversion =
    ['A'..'Z', 'a'..'z', '*', '@', '.', '_', '-', '0'..'9', '$', '!', '''', '(', ')'];
var
  Sp, Rp: PChar;
begin
  SetLength(Result, Length(Value) * 3);
  Sp := PChar(Value);
  Rp := PChar(Result);
  while Sp^ <> #0 do
  begin
    if Sp^ in NoConversion then
      Rp^ := Sp^ else
      begin
        FormatBuf(Rp^, 3, '%%%.2x', 6, [Ord(Sp^)]);
        Inc(Rp,2);
      end;
    Inc(Rp);
    Inc(Sp);
  end;
  SetLength(Result, Rp - PChar(Result));
end;

function TIngHTTPSend.HTTPEncode(const Value: String): String;
var
  vI, vN: Integer;
  vStr, S: String;
  vSLDest: TStringList;
  P: PChar;
begin
  if (Pos('http', Value) = 1) and (Pos('?', Value) > 0) then
  begin
    vStr := Value;
    Result := Copy(vStr, 1, Pos('?', vStr));
    Delete(vStr, 1, Pos('?', vStr));
    vSLDest := TStringList.Create;
    try
      S := '';
      P := PChar(vStr);
      while P^ <> #0 do
      begin
        if P^ <> '&' then
          S := S + P^ else
          begin
            vSLDest.Add(S);
            S := '';
          end;
        //{$IFDEF MSWINDOWS}          P := CharNext(P);        {$ELSE}
          Inc(P);
        //{$ENDIF}
      end;
      if vStr <> '' then
        vSLDest.Add(S);

      vN := vSLDest.Count - 1;
      for vI := 0 to vN do
      begin
        vSLDest.ValueFromIndex[vI] := URLEncode(vSLDest.ValueFromIndex[vI]);
        Result := Result + vSLDest.Strings[vI];
        if vi < vN then
          Result := Result + '&';
      end;
    finally
      vSLDest.Free;
    end;
  end else
    Result := URLEncode(Value);
end;

end.

Добавлено спустя 16 минут 59 секунд:
В принципе, человек пишет пргу для общения с корпоративным сайтом - там редирект не нужен.

[amateur]

да я к слову сказал debi12345

про ресурс знаю, но он не один такой. Для начала норм.

Indy - для продвинутых, Synapse - для ленивых

а если я пользуюсь тем чем хочу и меня не напрягает чем Get Pos делать. Эт тода че получается.

для общения с корпоративным сайтом - там редирект не нужен.

спорно. Пока не нужен, а так, уже включено

[debi12345]

Пока не нужен, а так, уже включено

Для корпоративных прог (БД, обновления софта и тарифов, тарифы,..) 100% не будет нужно - наверное поэтому синапсовцы не чешутся с авто-перенаправлением Они другие (более важные) фишки делают - SSL, прокcирование,..

ПС:
Мне их подход нравится тем, что говоришь "скачать то-то отуда-то" - тупо молча скачивает в пределах ,отведенных попытками и таймаутами, без возни с буферами и порциями, а для осблуживания прогресс-баров (=порций) предосталяются коллбэки.

[Ism]

Indy - для продвинутых, Synapse - для ленивых

Не скажите, Indy дико глючит, по крайней мере с Imap, Synapse очень прост и надежен.
Обратите внимание на http://grablib.org/ , она создана для парсинга

Уроки
http://www.youtube.com/watch?v=AugQn3SdvxY
http://www.youtube.com/watch?v=cB5mLUmgjkk

Мощнейшая вещь

[amateur]

Indy - для продвинутых, Synapse - для ленивых

Ism эт, кажись сарказм ...

Indy дико глючит

я уже это слышал. И кроме АААААААААААА инди глючит более ничего. А предлагать питоновый костыль - классная мысль.

Может мне кажется но, цель в синапсе и инди одинаковы но способ получения разный.

[debi12345]

А предлагать питоновый костыль - классная мысль.

%)) Но ведь не С#-ковый ! И позволит также изучить - как устанавливать и вызывать "питона", как пайпить вывод процесса в ФЦП-прогу и парсить его - то есть круче, чем напрямую загрузить с вэб-сайта... За одну задачу можно сразу стать крутым широкопрофильным знатоком темы

[Ism]

А предлагать питоновый костыль - классная мысль.

%)) Но ведь не С#-ковый ! И позволит также изучить - как устанавливать и вызывать "питона", как пайпить вывод процесса в ФЦП-прогу и парсить его - то есть круче, чем напрямую загрузить с вэб-сайта... За одну задачу можно сразу стать крутым широкопрофильным знатоком темы

Вообще паринг лучше работает на Питоне, fpc не лучший вариант, в нем нет отработанных решений. А использовать Indy или Synapse для этого мазохизм

[debi12345]

А использовать Indy или Synapse для этого мазохизм

Регулярки в зубы
(ох и выручалчки ! написал с ними наверное тысячи утиллиток на BASH+SED+AWK)
Или Вы имеете ввиду DOM (XML)-парсер ? В ФПЦ кажется есть неплохой оный, АФАЙК.

Вообще паринг лучше работает на Питоне

Не "на Питоне", а сообщество Питона тупо не поленилось его написать Возможно точно также не поленится кто-то из ФПЦ-сообщества.

[amateur]

вообщет уже есть около 5 оберток для парсинга (то что под лазарь и фпс заточены). Плюс, небось о торри забыли уже... А в фпс парсер у меня сдох при открытии простенького такого хтмл (ругнулся токо чуток с вылетом). Хотя parsewikipage.lpi в примере работает на ура (но тама и страницы слабее чем я пихал).

А так без регулялок вытягиваются ссылки, майлы и всякая другая кака. Включая json и т.д... Ляпота, однако. А вот регулярки не пользуются. Автомат + некоторые наработки и зачем эти регулярки. Хотя регулярка - тоже автомат

И зачем мне си, джава или питон? Есть наработки- класс (но их еще изучать нуно + знать что куда "пихать" а это гдет пол года в топку).