美丽人生论坛看贴工具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/