2010-08-12 10:56:24
Made By ForDream
一个简单的小工具、主要是用了正则表达式、没什么技术含量、代码贴出来、记录一下、
双击可以下载、右键可以进行搜索、速度还不错
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, IdHTTP, ComCtrls, PerlRegEx, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, ShellAPI, Menus; type TForm1 = class(TForm) lv1: TListView; idhtp1: TIdHTTP; pm1: TPopupMenu; N1: TMenuItem; procedure FormShow(Sender: TObject); procedure lv1DblClick(Sender: TObject); procedure N1Click(Sender: TObject); private { Private declarations } procedure AnalyzeInfo(const Html:string;const TypeOfAnalyze:Integer=0); public { Public declarations } end; var Form1: TForm1; AddressList:TStringList; implementation {$R *.dfm} procedure TForm1.AnalyzeInfo(const Html:string;const TypeOfAnalyze:Integer=0); type MyInfo=record sTime,sType,sName,sSize,sZhongzi,sDownload:string; end; var Reg,RegTd:TPerlRegEx; s:string; i:Cardinal; //ItemNum:Cardinal; sInfo:MyInfo; begin Reg:=TPerlRegEx.Create(Self); RegTd:=TPerlRegEx.Create(Self); if TypeOfAnalyze = 0 then begin Reg.RegEx:='<tr\x20class="alt\d">(\d|\D)*?</tr>'; AddressList.Clear; lv1.Clear; end else Reg.RegEx:='(<td\x20\D*?>|<td\>)(\d|\D)*?</td>'; Reg.Options:=[preCaseLess]; Reg.Subject:=Html; i:=0; //Reg.Match; while Reg.MatchAgain do begin if TypeOfAnalyze = 0 then AnalyzeInfo(Reg.MatchedExpression,1) else begin s:=Reg.MatchedExpression; RegTd.Subject:=s; case i mod 7 of//获取资源信息 0://日期 begin RegTd.RegEx:='[0-9]{2,2}/[0-9]{2,2}'; if RegTd.Match then sInfo.sTime:=RegTd.MatchedExpression else sInfo.sTime:='获取失败'; end; 1://类型 begin RegTd.RegEx:='>[^\x00-\xff]{4,}<'; if RegTd.Match then begin s:=RegTd.MatchedExpression; sInfo.sType:=Copy(s,2,length(s) - 2); end else sInfo.sType:='获取失败'; end; 2://资源名 begin RegTd.RegEx:='\Qshow.php?hash=\E[a-zA-Z0-9\n\t\x20]*';//匹配下载页面地址 if RegTd.Match then begin AddressList.Add(RegTd.MatchedExpression);//保存下载页面的地址 RegTd.RegEx:='<td\x20style(\d|\D)*?<(img|a\x20href)(\d|\D)*?">'; if RegTd.Match then begin s:=StringReplace(s,RegTd.MatchedExpression,'',[rfReplaceAll,rfIgnoreCase]); RegTd.Subject:=s; RegTd.RegEx:='</a>\xD*?\xA*?\n*?\t*?\x20*?</td>'; if RegTd.Match then begin s:=StringReplace(s,RegTd.MatchedExpression,'',[rfReplaceAll,rfIgnoreCase]); s:=StringReplace(s,'<span class="keyword">','',[rfReplaceAll,rfIgnoreCase]); s:=StringReplace(s,'</span>','',[rfReplaceAll,rfIgnoreCase]); sInfo.sName:=s; end else sInfo.sName:='获取失败'; end else sInfo.sName:='获取失败'; end else sInfo.sName:='获取失败'; end; 3://资源大小 begin RegTd.RegEx:='[0-9.]*(MB|GB)'; if regtd.Match then sInfo.sSize:=RegTd.MatchedExpression else sInfo.sSize:='获取失败'; end; 4://种子数 begin RegTd.RegEx:='<td\x20nowrap="nowrap">\xD*?\xA*?\n*?\t*?<span\x20class="bts_(1|2|3)">'; if RegTd.Match then begin s:=StringReplace(s,RegTd.MatchedExpression,'',[rfReplaceAll,rfIgnoreCase]); RegTd.RegEx:='</span>\xD*?\xA*?\n*?\t*?\x20*?</td>'; if RegTd.Match then begin s:=StringReplace(s,RegTd.MatchedExpression,'',[rfReplaceAll,rfIgnoreCase]); sInfo.sZhongzi:=s; end else sInfo.sZhongzi:='获取失败'; end else sInfo.sZhongzi:='获取失败'; end; 5://下载数 begin RegTd.RegEx:='<td\x20nowrap="nowrap">\xD*?\xA*?\n*?\t*?<span\x20class="btl_(1|2|3)">'; if RegTd.Match then begin s:=StringReplace(s,RegTd.MatchedExpression,'',[rfReplaceAll,rfIgnoreCase]); RegTd.RegEx:='</span>\xD*?\xA*?\n*?\t*?</td>'; if RegTd.Match then begin s:=StringReplace(s,RegTd.MatchedExpression,'',[rfReplaceAll,rfIgnoreCase]); sInfo.sDownload:=s; end else sInfo.sDownload:='获取失败'; end else sInfo.sDownload:='获取失败'; end; 6://加入表格 begin with lv1.Items.Add do begin Caption:=sInfo.sTime; SubItems.Add(sInfo.sType); SubItems.Add(sInfo.sName); SubItems.Add(sInfo.sSize); SubItems.Add(sInfo.sZhongzi); SubItems.Add(sInfo.sDownload); //SubItems.Add() end; end; end; Inc(i); end; end; if lv1.Items.Count = 0 then ShowMessage('你搜索的结果为空') else Caption:='共有' + IntToStr(lv1.Items.Count) + '个结果'; FreeAndNil(Reg); FreeAndNil(RegTd); end; procedure TForm1.FormShow(Sender: TObject); begin AddressList:=TStringList.Create; AnalyzeInfo(idhtp1.Get('http://bt.hliang.com/')); end; procedure TForm1.lv1DblClick(Sender: TObject); var Html:string; sFile:TFileStream; sSavaPath:string; Reg:TPerlRegEx; const Host='http://bt.hliang.com/'; begin if lv1.SelCount > 0 then begin //'down\.php\?date=\d*?\&hash=[a-zA-Z0-9]*' Reg:=TPerlRegEx.Create(Self); Caption:='正在下载种子'; sSavaPath:=ExtractFilePath(Application.ExeName) + '种子存放处\'; if not DirectoryExists(sSavaPath) then CreateDir(sSavaPath); sSavaPath:=sSavaPath + lv1.Selected.SubItems[1] + '.torrent'; sSavaPath:=StringReplace(sSavaPath,#13#10#9#9,'',[rfReplaceAll,rfIgnoreCase]); sFile:=TFileStream.Create(sSavaPath, fmCreate); //ShowMessage(AddressList[lv1.Selected.Index]); Html:=idhtp1.Get(Host + AddressList[lv1.Selected.Index]); Reg.Subject:=Html; Reg.RegEx:='down\.php\?date=\d*?\&hash=[a-zA-Z0-9]*';//下载页面匹配下载地址 if Reg.Match then begin Html:=Host + Reg.MatchedExpression; idhtp1.Get(Html,sFile);//下载种子文件 sFile.Free; ShellExecute(Self.Handle,'Open',PChar(sSavaPath),'','',SW_SHOW); //ShowMessage('请查看相关BT下载的工具是否出现、种子下载完毕'); end else begin ShowMessage('找不到种子下载地址'); sFile.Free; end; FreeAndNil(Reg); end; end; procedure TForm1.N1Click(Sender: TObject); var sSearch:string; begin sSearch:=InputBox('','输入搜索的关键字',''); AnalyzeInfo(idhtp1.Get( idhtp1.URL.URLEncode('http://bt.hliang.com/search.php?keyword=' + sSearch) )); end; end.
