zoukankan      html  css  js  c++  java
  • 美丽人生论坛看贴工具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/

  • 相关阅读:
    火狐插件火狐黑客插件将Firefox变成黑客工具的七个插件
    memcache安装环境:WINDOWS 7
    PHP正则表达式
    968. 监控二叉树 力扣(困难) dfs 官方说DP
    375. 猜数字大小 II 力扣(中等) 区间动态规划、记忆化搜索
    629. K个逆序对数组 力扣(困难) 区间动态规划
    剑指 Offer 51. 数组中的逆序对 力扣(困难) 巧用归并排序算法
    488. 祖玛游戏 力扣(困难) dfs
    16. 最接近的三数之和 力扣(中等) 双指针
    319. 灯泡开关 力扣(中等) 数论
  • 原文地址:https://www.cnblogs.com/hackpig/p/1668571.html
Copyright © 2011-2022 走看看