Вводишь № темы в Edit1, жмешь Button1 - через пару секунд выведутся в RichEdit все посты этой темы (при этом разделяются на имя юзера, дату, и сам текс поста):
| Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdHTTP;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Label1: TLabel;
RichEdit1: TRichEdit;
IdHTTP1: TIdHTTP;
procedure Button1Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
StrUtils;
const
HostName = 'games.yek.ru';
URL = 'http://' + HostName + '/gud4/viewtopic.php?';
type
TPost = record User, PostDate, Text : string; end;
TPosts = array of TPost;
function GetPosts (const HTML : string; var Posts : TPosts) : integer;
var
p1, p2 : integer;
_User, _PostDate, _Text : string;
procedure DeleteTags (var s : string);
var i1, i2 : integer;
begin
repeat
i1 := Pos('<br />', s);
if i1 = 0 then Break;
Delete (s, i1, 5);
s[i1] := #$0D;
until False;
repeat
i1 := Pos('<', s);
if i1 = 0 then Break;
i2 := Pos('>', s);
if i2 = 0 then i2 := Length(s);
Delete (s, i1, i2-i1+1);
until False;
repeat
i1 := Pos(#$0A, s);
if i1 = 0 then Break;
Delete (s, i1, 1);
until False;
i1 := 1;
repeat
i1 := PosEx(#$0D, s, i1);
if i1 = 0 then Break;
Insert (#$0A, s, i1+1);
Inc(i1, 2);
until False;
end;
begin
Result := 0;
p1 := 1;
repeat
p1 := PosEx('<span class="name">', html, p1);
p2 := PosEx('</span>', html, p1);
if (p1 = 0) or (p2 = 0) then Break;
_User := Copy(html, p1, p2-p1);
DeleteTags (_User);
p1 := PosEx('<span class="postdetails">Добавлено:', html, p1);
p2 := PosEx('<span class="gen">', html, p1);
if (p1 = 0) or (p2 = 0) then Break;
_PostDate := Copy(html, p1, p2-p1);
DeleteTags (_PostDate);
p1 := PosEx('<span class="postbody">', html, p1);
p2 := PosEx('</span><span class="gensmall">', html, p1);
if (p1 = 0) or (p2 = 0) then Break;
_Text := Copy(html, p1, p2-p1);
DeleteTags (_Text);
SetLength (Posts, Length(Posts)+1);
with Posts[Length(Posts)-1] do
begin
User := _User;
PostDate := _PostDate;
Text := _Text;
end;
Inc(Result);
until False;
end;
procedure TForm1.Button1Click(Sender : TObject);
var
Adr, html : string;
Posts : TPosts;
PostNo, i : integer;
procedure AddText (const txt : string; c : TColor; fs : TFontStyles);
var st : integer;
begin
st := RichEdit1.SelStart;
RichEdit1.Lines.Add(txt);
RichEdit1.SelStart := st;
RichEdit1.SelLength := Length(txt);
RichEdit1.SelAttributes.Color := c;
RichEdit1.SelAttributes.Style := fs;
RichEdit1.SelectAll;
RichEdit1.SelStart := RichEdit1.SelLength;
end;
begin
RichEdit1.Lines.Clear;
SetLength (Posts, 0);
IdHTTP1.Host := HostName;
IdHTTP1.Connect;
PostNo := 0;
repeat
AddText ('Get from PostNo: ' + IntToStr(PostNo), clBlue, []);
RichEdit1.Update;
Adr := URL + 't=' + Edit1.Text + '&start=' + IntToStr(PostNo);
html := IdHTTP1.Get(Adr);
i := GetPosts(html, Posts);
Inc (PostNo, i);
until i = 0;
for i := 0 to Length(Posts)-1 do
begin
AddText (Posts[i].User, clBlack, [fsBold]);
AddText (Posts[i].PostDate, clGreen, [fsItalic]);
AddText (Posts[i].Text, clBlack, []);
AddText ('', clBlack, []);
end;
IdHTTP1.Disconnect;
end;
end.
|
|
