美丽人生论坛看贴工具delphi版

程序界面

测试是在本机测试的，注意不能是127.0.0.1或者localhost，不然idhttp会罢工。由于测试论坛没有几篇文章，所以“下一页”，其实只读取了第一页。上一页还没做呢，呵。

源代码：

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdHTTP,perlregex,SHDocVw;

type
    bbslist=record
    flName:string;
    flUrl:string;
end;

type
TForm1 = class(TForm)
    ListBox1: TListBox;
    Label1: TLabel;
    ListView1: TListView;
    Label2: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    IdHTTP1: TIdHTTP;
    procedure FormShow(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ListView1DblClick(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
*******
    { Private declarations }
public
    { Public declarations }

end;

var
Form1: TForm1;
bbsfl:array of bbslist;
reg:tperlregex;
userSelect:string;

implementation

{$R *.dfm}
{$APPTYPE CONSOLE}

procedure TForm1.Button1Click(Sender: TObject);
var
url: string;
idhttp1: TIdhttp;
streamstr1: TStringStream;
html: string;
i: Integer;
n: Integer;
begin
//下一页
//如果listbox没有选择则返回
if(Length(userSelect)<2)then
exit;

streamstr1:=TStringStream.Create('');
idhttp1:=TIdHTTP.Create(nil);
idhttp1.ConnectTimeout:=12000;
idhttp1.ReadTimeout:=12000;

//按栏目取url
for I := 0 to 19 do
    begin
      if(bbsfl[i].flName=userSelect) then
        url:=trim(form1.Edit1.Text)+ bbsfl[i].flUrl;
    end;
writeln(url);
//exit;
//url:='http://58.49.129.177/asp/forum.asp?forum_id=32';

idhttp1.Get(url,streamstr1);
html:=streamstr1.DataString;
//Writeln(html);
//正则分析
reg:=TPerlRegEx.Create(nil);
reg.Subject:=html;
reg.RegEx:='^<a\s|href=''([\w\d\.\?_=&]+)''>([^<^>]+)</a>';

//清空litview
n:=ListView1.Items.Count;
for i := 0 to n - 1 do
listview1.items.delete(0);
i:=0;

while reg.MatchAgain do
begin
//写入listview
inc(i);

with listview1.items.add do
begin
    //编号
    Caption:=inttostr(i);
    //标题
    SubItems.Add(reg.SubExpressions[2]);
    //点击
    SubItems.Add('0');
    //地址
    SubItems.Add(trim(form1.Edit1.Text)+reg.SubExpressions[1]);
end;

//Writeln(reg.SubExpressions[2]);
end;

streamstr1.Free;
idhttp1.Free;
reg.Free;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
//bbsfl=nil;
halt;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
idhttp1:TIdHTTP;
streamHtml:TStringStream;
htmlStr:string;
s1: string;
s2: string;
i: Integer;

begin
//读论坛栏目列表
idhttp1.ReadTimeout:=12000;
idhttp1.ConnectTimeout:=12000;
//idhttp1.Request.UserAgent:='Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0; .NET CLR 1.1.4322)';

idhttp1:=TIdHTTP.Create(nil);
streamHtml:=TStringStream.Create('',TEncoding.GetEncoding(936));

try
    idhttp1.Get(trim(form1.Edit1.Text),streamHtml);
    htmlStr:=streamHtml.DataString;
    //writeln(htmlStr);
    //正则分析
    reg:=tperlregex.Create(nil);
    reg.Subject:=htmlStr;
    reg.RegEx:='<a\s+href=''([\w\.\?_=\d]+)''><font\s+color=#[\w\d]+><b>(.+)</b>';
    //设置动态数组bbsfl

SetLength(bbsfl,20);

    i:=0;
    while reg.MatchAgain do
    begin
       s1:=reg.SubExpressions[1];
       s2:=reg.SubExpressions[2];
       //writeln(reg.SubExpressions[0]);
       bbsfl[i].flName:=s2;
       bbsfl[i].flUrl:=s1;
       form1.ListBox1.Items.Add(s2);
       inc(i);
    end;

except
    on e:Exception do
    begin
      ShowMessage(e.Message);
    end;
end;
streamHtml.Free;

end;

procedure TForm1.FormShow(Sender: TObject);
begin
ListView1.Clear;
ListView1.Columns.Clear;
ListView1.Columns.Add;
ListView1.Columns.Add;
ListView1.Columns.Add;
ListView1.Columns.Add;
ListView1.Columns.Items[0].Caption:='编号';
ListView1.Columns.Items[1].Caption:='主题';
ListView1.Columns.Items[2].Caption:='点击/回复';
ListView1.Columns.Items[3].Caption:='地址';
ListView1.Columns.Items[0].Width:=40;
ListView1.Columns.Items[1].Width:=210;
ListView1.Columns.Items[2].Width:=80;
ListView1.Columns.Items[3].Width:=120;
Listview1.ViewStyle:=vsreport;
Listview1.GridLines:=true;

edit1.Text:='http://58.49.129.177/asp/';
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
if ListBox1.Selected[ListBox1.ItemIndex] then
userSelect:=ListBox1.Items[ListBox1.ItemIndex];
end;

procedure TForm1.ListView1DblClick(Sender: TObject);
var
url: string;
ie:OleVariant;
begin
//双击阅读贴子
//writeln(ListView1.Selected.SubItems.Strings[0]);
url:=ListView1.Selected.SubItems.Strings[2];
ie:=CoInternetExplorer.Create;
ie.Visible := True;
ie.Navigate2(url);

end;

end.

界面代码：

---------------------------------------------------------------------------------

object Form1: TForm1
Left = 0
Top = 0
BorderIcons = [biSystemMenu, biMinimize]
Caption = #32654#20029#20154#29983#35770#22363#35835#36148' '#29482#24735#33021
ClientHeight = 299
ClientWidth = 346
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
    Left = 8
    Top = 36
    Width = 36
    Height = 13
    Caption = #36873#29256#65306
end
object Label2: TLabel
    Left = 9
    Top = 9
    Width = 23
    Height = 13
    Caption = 'URL:'
end
object ListBox1: TListBox
    Left = 42
    Top = 36
    Width = 224
    Height = 46
    ItemHeight = 13
    TabOrder = 0
    OnClick = ListBox1Click
end
object ListView1: TListView
    Left = 8
    Top = 88
    Width = 329
    Height = 169
    Columns = <>
    FlatScrollBars = True
    GridLines = True
    HideSelection = False
    RowSelect = True
    TabOrder = 1
    OnDblClick = ListView1DblClick
end
object Edit1: TEdit
    Left = 42
    Top = 9
    Width = 224
    Height = 21
    TabOrder = 2
end
object Button1: TButton
    Left = 202
    Top = 263
    Width = 65
    Height = 28
    Caption = #19979#19968#39029
    TabOrder = 3
    OnClick = Button1Click
end
object Button2: TButton
    Left = 131
    Top = 263
    Width = 65
    Height = 28
    Caption = #19978#19968#39029
    TabOrder = 4
end
object Button3: TButton
    Left = 273
    Top = 263
    Width = 65
    Height = 28
    Caption = #36864#20986
    TabOrder = 5
    OnClick = Button3Click
end
object Button4: TButton
    Left = 273
    Top = 8
    Width = 49
    Height = 21
    Caption = 'GO'
    TabOrder = 6
    OnClick = Button4Click
end
object IdHTTP1: TIdHTTP
    AllowCookies = True
    ProxyParams.BasicAuthentication = False
    ProxyParams.ProxyPort = 0
    Request.ContentLength = -1
    Request.Accept = 'text/html, */*'
    Request.BasicAuthentication = False
    Request.UserAgent = 'Mozilla/3.0 (compatible; Indy Library)'
    HTTPOptions = [hoForceEncodeParams]
    Left = 8
    Top = 256
end
end

源代码下载：http://www.rayfile.com/files/3075d042-15c9-11df-9cf8-0015c55db73d/