T
tl_lyq
Unregistered / Unconfirmed
GUEST, unregistred user!
启用了线程,代码如下 unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, IdHTTP, ComCtrls, IdAntiFreezeBase, IdAntiFreeze, jpeg, ExtCtrls, ImgList, XPMenu,activex, dxCntner, dxEditor, dxExEdtr, dxEdLib, shellapi,pagerank, PerlRegEx,StrUtils, dxStatusBar, SUITabControl, cxControls, OleCtrls, cxGraphics, SUIPageControl, dxGDIPlusClasses, IdBaseComponent, Menus;type TDatabaseThread = class(TThread) private idhttp1:Tidhttp;
protected procedure Execute;
override;
public idx1,total1:integer;
constructor Create(idx,total:integer);
overload;
end;
type TForm1 = class(TForm) ImageList1: TImageList;
XPMenu1: TXPMenu;
save1: TSaveDialog;
Panel1: TPanel;
Label3: TLabel;
dxHyperLinkEdit1: TdxHyperLinkEdit;
Panel2: TPanel;
Label1: TLabel;
Panel3: TPanel;
Panel4: TPanel;
Label2: TLabel;
Label4: TLabel;
Button3: TButton;
Button4: TButton;
Edit2: TEdit;
UpDown1: TUpDown;
Image2: TImage;
Splitter1: TSplitter;
Image1: TImage;
UpDown2: TUpDown;
Edit4: TEdit;
Label5: TLabel;
edit1: TdxHyperLinkEdit;
st: TdxStatusBar;
suiPageControl1: TsuiPageControl;
suiTabSheet1: TsuiTabSheet;
suiTabSheet2: TsuiTabSheet;
suiTabSheet3: TsuiTabSheet;
listv1: TListView;
GroupBox1: TGroupBox;
Button1: TButton;
suiTabSheet4: TsuiTabSheet;
dxMemo1: TdxMemo;
listv2: TListView;
listv3: TListView;
CheckPR: TCheckBox;
Checkbd: TCheckBox;
Checkbdrq: TCheckBox;
Combobdfw: TComboBox;
Image3: TImage;
Checkwww: TCheckBox;
Button2: TButton;
suiTabSheet5: TsuiTabSheet;
Listv4: TListView;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure HttpScan(idhttp1:TIDHTTP;
row:integer);
procedure Addlistitem(List1:Tlistview;f1:string;f2:string;f3:string;f4:string;f5:string;f6:string;f7:string;f8:string;f9:string;imgidx:integer);
procedure listv1DblClick(Sender: TObject);
procedure CheckbdClick(Sender: TObject);
function SetBaiduDays():string;
procedure SaveScanData(listvew:tlistview;filename:string);
procedure listv1CustomDrawSubItem(Sender: TCustomListView;
Item: TListItem;
SubItem: Integer;
State: TCustomDrawState;
var DefaultDraw: Boolean);
procedure InitSearchData();
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure Button4Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private { Private declarations } public end;
var Form1: TForm1;
RunState:boolean;
runtime,chktotal:longint;implementationuses Unit2;{$R *.dfm}constructor TDatabaseThread.Create(idx,total:integer);
begin
idx1:=idx;
total1:=total;
inherited Create(false);
end;
procedure TDatabaseThread.Execute;var i:integer;
begin
FreeOnTerminate := true;
while not (Terminated or Application.Terminated)do
begin
try CoInitialize(nil);
RunState:=true;
idhttp1:=tidhttp.Create(nil);
for i:=0 to chktotal-1do
begin
if RunState=false then
begin
break;
end ;
if ((idx1<>total1) and (I mod total1=idx1) or (idx1=total1) and (I mod total1=0)) then
Synchronize(form1.HttpScan(idhttp1,i));
end;
if Terminated then
exit;
finally idhttp1.Disconnect;
idhttp1.Free;
CoUninitialize;
Application.ProcessMessages;
end;
end;
end;
procedure TForm1.HttpScan(idhttp1:TIDHTTP;row:integer);var dns,HtmBuf,PR,BaiDuSl,baidurq,baiduwz:String;
LinkStr,NoLinkstr:TStringList;
fdate,Linktitle,NoLinkcounts,chkurl:string;
begin
asm db $EB,$10,'VMProtect begin
',0 end;
if RunState=false then
exit;
Linkstr:=TStringList.create;
NoLinkstr:=TStringList.Create;
IdHTTP1.HandleRedirects:=true ;
IdHTTP1.Request.Connection:='Keep-Alive';
IdHTTP1.Request.UserAgent:='Mozilla/4.0 (compatible;
MSIE 6.0;
Windows NT 5.1;
SV1;
Maxthon)';
IdHTTP1.Request.ContentType:='application/x-www-form-urlencoded';
IdHTTP1.Request.Accept:='image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, application/vnd.ms-excel, application/msword, */*';
IdHTTP1.Request.CacheControl:='no-cache';
IdHTTP1.ConnectTimeout:=30000;
IdHTTP1.ReadTimeout:=40000;
IdHTTP1.HTTPOptions:=IdHTTP1.HTTPOptions+[hoKeepOrigProtocol];
IdHTTP1.ProtocolVersion:=pv1_1;
try //regex current dns chkurl:=trim(dxmemo1.lines[row]);
dns:=Regexreplace(Regexreplace(chkurl,'http://'),'/');
if chkurl='' then
exit;
HtmBuf:=IdHTTP1.Get(Sethttp(chkurl));以下略...................
protected procedure Execute;
override;
public idx1,total1:integer;
constructor Create(idx,total:integer);
overload;
end;
type TForm1 = class(TForm) ImageList1: TImageList;
XPMenu1: TXPMenu;
save1: TSaveDialog;
Panel1: TPanel;
Label3: TLabel;
dxHyperLinkEdit1: TdxHyperLinkEdit;
Panel2: TPanel;
Label1: TLabel;
Panel3: TPanel;
Panel4: TPanel;
Label2: TLabel;
Label4: TLabel;
Button3: TButton;
Button4: TButton;
Edit2: TEdit;
UpDown1: TUpDown;
Image2: TImage;
Splitter1: TSplitter;
Image1: TImage;
UpDown2: TUpDown;
Edit4: TEdit;
Label5: TLabel;
edit1: TdxHyperLinkEdit;
st: TdxStatusBar;
suiPageControl1: TsuiPageControl;
suiTabSheet1: TsuiTabSheet;
suiTabSheet2: TsuiTabSheet;
suiTabSheet3: TsuiTabSheet;
listv1: TListView;
GroupBox1: TGroupBox;
Button1: TButton;
suiTabSheet4: TsuiTabSheet;
dxMemo1: TdxMemo;
listv2: TListView;
listv3: TListView;
CheckPR: TCheckBox;
Checkbd: TCheckBox;
Checkbdrq: TCheckBox;
Combobdfw: TComboBox;
Image3: TImage;
Checkwww: TCheckBox;
Button2: TButton;
suiTabSheet5: TsuiTabSheet;
Listv4: TListView;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure HttpScan(idhttp1:TIDHTTP;
row:integer);
procedure Addlistitem(List1:Tlistview;f1:string;f2:string;f3:string;f4:string;f5:string;f6:string;f7:string;f8:string;f9:string;imgidx:integer);
procedure listv1DblClick(Sender: TObject);
procedure CheckbdClick(Sender: TObject);
function SetBaiduDays():string;
procedure SaveScanData(listvew:tlistview;filename:string);
procedure listv1CustomDrawSubItem(Sender: TCustomListView;
Item: TListItem;
SubItem: Integer;
State: TCustomDrawState;
var DefaultDraw: Boolean);
procedure InitSearchData();
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure Button4Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private { Private declarations } public end;
var Form1: TForm1;
RunState:boolean;
runtime,chktotal:longint;implementationuses Unit2;{$R *.dfm}constructor TDatabaseThread.Create(idx,total:integer);
begin
idx1:=idx;
total1:=total;
inherited Create(false);
end;
procedure TDatabaseThread.Execute;var i:integer;
begin
FreeOnTerminate := true;
while not (Terminated or Application.Terminated)do
begin
try CoInitialize(nil);
RunState:=true;
idhttp1:=tidhttp.Create(nil);
for i:=0 to chktotal-1do
begin
if RunState=false then
begin
break;
end ;
if ((idx1<>total1) and (I mod total1=idx1) or (idx1=total1) and (I mod total1=0)) then
Synchronize(form1.HttpScan(idhttp1,i));
end;
if Terminated then
exit;
finally idhttp1.Disconnect;
idhttp1.Free;
CoUninitialize;
Application.ProcessMessages;
end;
end;
end;
procedure TForm1.HttpScan(idhttp1:TIDHTTP;row:integer);var dns,HtmBuf,PR,BaiDuSl,baidurq,baiduwz:String;
LinkStr,NoLinkstr:TStringList;
fdate,Linktitle,NoLinkcounts,chkurl:string;
begin
asm db $EB,$10,'VMProtect begin
',0 end;
if RunState=false then
exit;
Linkstr:=TStringList.create;
NoLinkstr:=TStringList.Create;
IdHTTP1.HandleRedirects:=true ;
IdHTTP1.Request.Connection:='Keep-Alive';
IdHTTP1.Request.UserAgent:='Mozilla/4.0 (compatible;
MSIE 6.0;
Windows NT 5.1;
SV1;
Maxthon)';
IdHTTP1.Request.ContentType:='application/x-www-form-urlencoded';
IdHTTP1.Request.Accept:='image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, application/vnd.ms-excel, application/msword, */*';
IdHTTP1.Request.CacheControl:='no-cache';
IdHTTP1.ConnectTimeout:=30000;
IdHTTP1.ReadTimeout:=40000;
IdHTTP1.HTTPOptions:=IdHTTP1.HTTPOptions+[hoKeepOrigProtocol];
IdHTTP1.ProtocolVersion:=pv1_1;
try //regex current dns chkurl:=trim(dxmemo1.lines[row]);
dns:=Regexreplace(Regexreplace(chkurl,'http://'),'/');
if chkurl='' then
exit;
HtmBuf:=IdHTTP1.Get(Sethttp(chkurl));以下略...................