freepascal.ru

И снова здравствуйте.
Собственно сабж.
Предыстория: под линуксом пытаюсь загрузить из сети и распарсить html-страницу, передаваемую сервером с gzip-сжатием, пример взят с сайта ув. тов. Vlad'a. Только в отличии от первоисточника пытаюсь всё провернуть не на GZip, а на zstream.
Загрузить получилось, скинуть на диск и расжать получилось (внешней программой), а вот разжать поток напрямую почему-то не выходит.
Код юнита:

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

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  HTTPSend, synacode, synautil, zstream;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var OS: TDecompressionStream;
begin
  with THTTPSend.Create do
  begin
    Headers.Add('Accept-Encoding: gzip,deflate');
    Headers.Add('User-Agent: Mozilla/5.0 (X11; Linux i686) AppleWebKit/537.22 (KHTML, like Gecko) Chrome/25.0.1364.172 Safari/537.22');
    Protocol:='1.1';
    if HTTPMethod('GET', Edit1.Text) then
    begin
      HeadersToList(Headers);//привели заголовки к виду Name=Value
      {проверяем заголовок}
      if Trim(Headers.Values['Content-Encoding']) = 'gzip' then
      begin
        try
          Document.Position:=0;
          OS:=TDecompressionStream.Create(Document);
          Memo1.Lines.LoadFromStream(OS);
        finally
          OS.Free;
        end;
      end
      else
        Memo1.Lines.LoadFromStream(Document);
    end;
  end;
end;

end.


Ругается ошибкой EDecompressionError: data error.
Lazarus 0.9.31; fpc 2.6.0
Вот здесь, например, товарищ seba22 пишет что всё работает, однако версии компиляторов не указаны. Тема интересна и под windows и под линукс. Спасибо.

Добавлено спустя 12 минут 47 секунд:
на сайте lazarus.su в разделе архивация есть библиотека Lazarus Zlib 1.2.5, но, на сколько я понял с её помощью не получится расжать gz, поправьте, если ошибаюсь...
на сайте самой библиотеки delphi zlib нет скомпилированной библиотеки, а только сорцы на си... есть вресия 1.2.7 с нужным функционалом, но собрать не могу...

paszlib тебе в помощь

вот рабочий код, правда через TGZFileStream, TDecompressionStream так и не осилил - валится с "data error"

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

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, SynMemo, SynEdit, Forms, Controls, Graphics,
  Dialogs, StdCtrls, HTTPSend, synacode, synautil, zstream, libtar,
  LConvEncoding;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Memo1: TMemo;
    Memo2: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

const gzipfile = 'file1.gz';

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var gz: TGZFileStream;
    sl: TStringList;
begin
  with THTTPSend.Create do
  begin
    Headers.Add('Accept-Encoding: gzip,deflate');
    Headers.Add('User-Agent: Mozilla/5.0 (X11; Linux i686) AppleWebKit/537.22 (KHTML, like Gecko) Chrome/25.0.1364.172 Safari/537.22');
    Protocol:='1.1';
    //Headers.Text:=Memo2.Lines.Text;
    if HTTPMethod('GET', Edit1.Text) then
    begin
      HeadersToList(Headers);//привели заголовки к виду Name=Value
      {проверяем заголовок}
      if Trim(Headers.Values['Content-Encoding']) = 'gzip' then
      begin
        Document.SaveToFile(gzipfile);
        gz := TGZFileStream.Create(gzipfile,gzOpenRead);
        sl:= TStringList.Create;
        sl.LoadFromStream(gz);
        sl.Text:=CP1251ToUTF8(sl.Text);
        Memo1.Lines.Text:=sl.Text;
        sl.Free;
        gz.Free;
      end
      else
        Memo1.Lines.LoadFromStream(Document);
    end;
  end;
end;

end.