Ниже привожу полный код модуля парсера.unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, DBGrids, DB, ADODB, DBCtrls, StdCtrls, IdBaseComponent,
IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, RegExpr, ExtCtrls, jpeg, GIFImg;
type
TForm1 = class(TForm)
ADOConnection1: TADOConnection;
DataSource1: TDataSource;
ADOTable1: TADOTable;
DBGrid1: TDBGrid;
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Memo1: TMemo;
IdHTTP1: TIdHTTP;
Image1: TImage;
Button2: TButton;
ADOQuery1: TADOQuery;
Edit5: TEdit;
Edit4: TEdit;
Memo2: TMemo;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure DBGrid1CellClick(Column: TColumn);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
html:string;
DestEncoding:TStream;
mm:TStringList;
id, xxx:string;
r : TRegExpr;
ImgGif:TGifImage;
ImgJpg:TJpegImage;
posn,posk:integer;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
//Получаем HTML код сайта в переменную html и мемо полеDestEncoding:= TMemoryStream.Create;
IdHTTP1.Get(edit5.Text,DestEncoding);
DestEncoding.Position :=0;
mm:=TStringList.Create;
mm.LoadFromStream(DestEncoding);
html:=mm.Text;
DestEncoding.Free;
mm.Free;
//ищем начало каталогаr.Expression:='<tr class="productListing-(odd|even)">';
//запускаем цикл пока есть товары в каталоге?
while r.Exec (html) do
begin
if r.Exec (html) then begin
edit1.Text:= r.Match [0];
//удаляем лишнее
Delete(html,1,r.MatchPos[0]-1);
memo1.Text:=html;
//ищем код товараr.Expression:='<td class="productListing-data">.*?(\d{6}).*?</td>';
if r.Exec (html) then begin
edit2.Text:= r.Match [1];
id:=r.Match [1];
//добавляем новую запись в базу данных ADOTable1.Append;
//записываем в базу код товара ADOTable1.FieldByName('CODE').Value:=Trim(r.Match [1]);
end;
//ищем url адрес изображения товараr.Expression:='id='+Trim(id)+'.+?"><img src="(.*?)\.(.*?)"';
if r.Exec (html) then begin
edit3.Text:='http://price.portalkirov.ru/cat/'+ r.Match [1];
DestEncoding:=TMemoryStream.Create;
//грузим в память изображение товара по его url адресу IdHTTP1.Get('http://price.portalkirov.ru/cat/'+r.Match [1]+'.'+r.Match [2], DestEncoding);
DestEncoding.Position :=0;
//записываем изображение товара в BlobField поле базы данных TBlobField(Form1.ADOTable1.FieldByName('foto')).LoadFromStream(DestEncoding);
DestEncoding.Free;
//записываем расширение картинки в базу данных ADOTable1.FieldByName('ext').Value:=r.Match [2];
end;
//ищем наименование товараr.Expression:='<td class="productListing-data">.*id='+id+'.+?">.*?</a><br>(.*?)</td>';
if r.Exec (html) then begin
//ищем символы ' ' для удаления r.Expression:=' ';
//заменяем найденные символы на '' xxx:= r.Replace(r.Match [1],'', True);
memo2.Text:=xxx;
//записываем наименование товара в базу данных ADOTable1.FieldByName('name_tovara').Value:=xxx;
end;
//ищем цену товараr.Expression:='<td align="right" class="productListing-data">(.*?)руб..*?</td>';
if r.Exec (html) then begin
posk:=r.MatchPos[0]+r.MatchLen[0];
//ищем символы ' ' для удаления r.Expression:=' ';
//заменяем найденные символы на '' xxx:=Trim(r.Replace(r.Match [1],'', True));
//записываем цену товара в базу данных ADOTable1.FieldByName('cost').Value:=strtofloat(xxx);
edit4.Text:= xxx;
//удаляем найденный товар из HTML кода Delete(html,1,posk);
beep;
end;
//сохраняем записьADOTable1.Post;
end;
//задаем выражение для следующего поискаr.Expression:='<tr class="productListing-(odd|even)">';
end;
end;
//очистка базы данныхprocedure TForm1.Button2Click(Sender: TObject);
begin
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.Add('DELETE katalog.* FROM katalog;');
ADOQuery1.ExecSQL;
ADOQuery1.Active:=false;
ADOTable1.Active:=False;
ADOTable1.Active:=True;
end;
//просмотр изображений в базе в зависимости от рассширения изображения ( jpg или gif)procedure TForm1.DBGrid1CellClick(Column: TColumn);
begin
DestEncoding:=TMemoryStream.Create;
TBlobField(Form1.ADOTable1.FieldByName('foto')).SaveToStream(DestEncoding);
DestEncoding.Position :=0;
if (LowerCase(ADOTable1.FieldByName('ext').Value)='jpg') or (LowerCase(ADOTable1.FieldByName('ext').Value)='jpeg') then
begin
Imgjpg:=TJpegImage.Create;
Imgjpg.LoadFromStream(DestEncoding);
Image1.Picture.Assign(Imgjpg);
Imgjpg.Free;
end;
if (LowerCase(ADOTable1.FieldByName('ext').Value)='gif') then
begin
ImgGif:=TGifImage.Create;
ImgGif.LoadFromStream(DestEncoding);
Image1.Picture.Assign(ImgGif);
ImgGif.Free;
end;
DestEncoding.Free;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
//освобаждаем памятьr.Free;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
//создаем объект для работа с регулярными выражениямиr := TRegExpr.Create;
end;
end.
Думаю убрать все лишнее из кода не составит труда.
В нашем случае мы сохраняем изображения товаров прямо в базе, к сожалению это приводит к значительному увеличению размера файла базы
MS Access. Поэтому во многих случаях в базе хранят не сами изображения, а имена файлов изображений. А сами изображения помещают отдельную папку.
На этом урок закончен.
Скачать исходники можно
здесь.
Автор
xaramamburu, сайт
basicsprog.ucoz.ruПри копировании материалов ссылка на сайт обязательна.