bwebset.pas

百度知道的自动发帖回复机器人。可以用来发广告

{∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑
◎→
◎→            百度知道挂分
◎→  Project: Baidu
◎→  Start Date:2006/4/15
◎→  Change Date:2006/4/15
◎→  System: Delphi6+WinXP
◎→  Author: tresss
◎→  My Home:http://www.tresss.com
◎→  E-Mail:[e-mail]
◎→  Explain:主要网页处理功能;
◎→
◎→
∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑}
unit BWebSet;
Interface
Uses Windows,Classes,Sysutils,mshtml,Main,BConst;

  Procedure ValidateCon;        //验证版本;
  Procedure WebLogin;           //登陆;
  Procedure WebAlaType;         //分析列出分类版块并随机打开一个版块;
  Procedure WebRandTips;        //随机打开一个贴子;
  Procedure WebAnswerTips;      //回复一个贴子;

implementation

Procedure ValidateCon;
Var
  HDoc:IHtmlDocument2;
  StrTmp:String;
Begin
  HDoc:=FrmMain.Web.Document as IHtmlDocument2;
  StrTmp:=HDoc.Title;
  If Trim(StrTmp)<>'0.2' Then
  Begin
    If WebState='Control' Then      //第一次验证为'tresss.com'站点中,第二次为'english.tresss.com'站点中.
    Begin
      FrmMain.PnlBottom.Caption:='版本测试中,请稍候  >>>>>>';
      FrmMain.Web.Navigate(UrlControl1);
      WebState:='Control1';
      Exit;
    End
    Else
    Begin
      FrmMain.PnlBottom.Caption:='版本错误,请更新!';
      FrmMain.Timer1.Enabled:=False;
      FrmMain.BtnEnable.Enabled:=False;
      exit;
    End;
  End;
  FrmMain.PnlBottom.Caption:='版本正确,正在打开百度知道!';
  StrUrlType:=TSTringList.Create;
  WebState:='Logining';
  FrmMain.Web.Navigate(UrlLogin);
End;

//登陆操作;
Procedure WebLogin;
var
  hform:IHTMLFormelement;
  hdoc:ihtmldocument2;
  hall:ihtmlelementcollection;
  Hinput:IHTMLinputelement;
  hlen,Intloop:integer;
  vk:oleVariant;
  dispatch:Idispatch;
Begin
  If Assigned(FrmMain.Web) Then
  Begin
    FrmMain.PnlBottom.Caption:='正在登陆百度知道!';
    hdoc:=FrmMain.Web.Document as ihtmlDocument2;
    hall:=HDoc.Get_All;
    Hlen:=Hall.Get_Length;
    For IntLoop:=0 To Hlen-1 Do
    Begin
      vk:=IntLoop;
      DisPatch:=Hall.Item(Vk,0);
      If Succeeded(Dispatch.QueryInterface(IHTMLInputelement,hinput)) Then
      Begin
        If Uppercase(hinput.type_)='TEXT' Then
        Begin
          hinput.value:=FrmMain.EdtName.Text;
        End
        Else If Uppercase(hinput.type_)='PASSWORD' Then
        Begin
          hinput.value:=FrmMain.EdtPass.Text;
          Break;
        End;
      End;
    End;    //For End;
    For IntLoop:=0 To Hlen-1 Do
    Begin
      vk:=IntLoop;
      DisPatch:=Hall.Item(Vk,0);
      If Succeeded(dispatch.QueryInterface(IHTMLFormElement,hform)) Then
      Begin
        If UpperCase(hform.Action)='./?LOGIN' Then
        Begin
          Hform.submit;
          WebState:='Logined';
          break;
        End;
      End;
    End;     //For  End;
  End;
End;

//列表分类版块;
Procedure WebAlaType;
var
  hdoc:ihtmldocument2;
  hall:ihtmlelementcollection;
  HUrl:IHTMLAnchorElement;
  hlen,Intloop:integer;
  vk:oleVariant;
  dispatch:Idispatch;
  StrTmp:String;
  IntTmp:Integer;
Begin
  If Assigned(FrmMain.Web) Then
  Begin
    FrmMain.PnlBottom.Caption:='正在分析百度知道分类!';
    hdoc:=FrmMain.Web.Document as ihtmlDocument2;
    hall:=HDoc.Get_All;
    Hlen:=Hall.Get_Length;
    StrUrlType.Clear;
    For IntLoop:=0 To Hlen-1 Do
    Begin
      vk:=IntLoop;
      DisPatch:=Hall.Item(Vk,0);
      If Succeeded(Dispatch.QueryInterface(IHTMLAnchorElement,HUrl)) Then
      Begin
        StrTmp:=HUrl.href;
        If Pos('browse',StrTmp)=25 Then
          StrUrlType.Add(StrTmp);        
      End;
    End;    //For End;
    randomize;          //取随机分类;
    IntTmp:=random(StrUrlType.Count);
    StrTmp:=StrUrlType.Strings[IntTmp];
    WebState:='OneType';
    FrmMain.PnlBottom.Caption:='随机打开一个分类: '+StrTmp;
    FrmMain.Web.Navigate(StrTmp);
  End;
End;

//随机打开一个贴子;
Procedure WebRandTips;
var
  hdoc:ihtmldocument2;
  hall:ihtmlelementcollection;
  HUrl:IHTMLAnchorElement;
  hlen,Intloop:integer;
  vk:oleVariant;
  dispatch:Idispatch;
  StrTmp:String;
  IntTmp:Integer;
Begin
  If Assigned(FrmMain.Web) Then
  Begin
    FrmMain.PnlBottom.Caption:='随机打开一个贴子!';
    hdoc:=FrmMain.Web.Document as ihtmlDocument2;
    hall:=HDoc.Get_All;
    Hlen:=Hall.Get_Length;
    StrUrlType.Clear;
    For IntLoop:=0 To Hlen-1 Do
    Begin
      vk:=IntLoop;
      DisPatch:=Hall.Item(Vk,0);
      If Succeeded(Dispatch.QueryInterface(IHTMLAnchorElement,HUrl)) Then
      Begin
        StrTmp:=HUrl.href;
        If Pos('question',StrTmp)=25 Then
          StrUrlType.Add(StrTmp);
      End;
    End;    //For End;
    randomize;          //取随机分类;
    IntTmp:=random(StrUrlType.Count);
    StrTmp:=StrUrlType.Strings[IntTmp];
    WebState:='OneTips';
    FrmMain.PnlBottom.Caption:='随机打开一个贴子: '+StrTmp;
    FrmMain.Web.Navigate(StrTmp);
  End;
End;

//回复一个贴子;
Procedure WebAnswerTips;
var
  hdoc:ihtmldocument2;
  hall:ihtmlelementcollection;
  HText:IHTMLTextAreaElement;
  HForm:IHTMLFormelement;
  hlen,Intloop:integer;
  vk:oleVariant;
  dispatch:Idispatch;
  IntTmp:Integer;
  StrTmp:String;
Begin
  Randomize;
  IntTmp:=Random(30);
  If IntTmp=19 Then
    StrTmp:=TipsText
  Else
  Begin
    StrTmp:=StrRep[IntRepIndex];
    If StrTmp='' Then StrTmp:=TipsText;
    Inc(IntRepIndex);
    If IntRepIndex>6 Then IntRepIndex:=1;
  End;
  If Assigned(FrmMain.Web) Then
  Begin
    FrmMain.PnlBottom.Caption:='回复一个贴子!';
    hdoc:=FrmMain.Web.Document as ihtmlDocument2;
    hall:=HDoc.Get_All;
    Hlen:=Hall.Get_Length;
    StrUrlType.Clear;
    WebState:='TipsAnswer';
    For IntLoop:=5 To Hlen-1 Do
    Begin
      vk:=IntLoop;
      DisPatch:=Hall.Item(Vk,0);
      If Succeeded(Dispatch.QueryInterface(IHTMLTextAreaElement,HText)) Then
      Begin
        HText.value:=StrTmp;
        Break;
      End;
    End;    //For End;
    For IntLoop:=0 To Hlen-1 Do
    Begin
      vk:=IntLoop;
      DisPatch:=Hall.Item(Vk,0);
      If Succeeded(dispatch.QueryInterface(IHTMLFormElement,hform)) Then
      Begin
        If HForm.Name='fdf' Then
        Begin
          Hform.submit;
          break;
        End;
      End;
    End;     //For  End;
    WebState:='TipsAnswer';
  End;
End;


end.