程序界面

测试是在本机测试的，注意不能是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/