【图】一个多线程后台扫描的程序和源代码

　　界面是防明小子的那个扫描工具写的，算是学习多线程的一个例子把
　　
　　界面图示：

　　http://www.wrsky.com/attachment/3_1875.jpg
　　
　　程序和源代码：

　　http://downloads.2ccc.com/general/internet_lan/hnxyy_scan.rar

　　使用D7编写，主要部分代码：
　　
　　
　　//主界面部分
　　unit1.pas
　　
　　unit Unit1;
　　
　　interface
　　
　　uses
　　Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
　　Dialogs, StdCtrls, Tabs, ExtCtrls, ComCtrls, IdHTTP, Unit2;
　　
　　type
　　TForm1 = class(TForm)
　　 Label1: TLabel;
　　 Edit1: TEdit;
　　 Button1: TButton;
　　 TabSet1: TTabSet;
　　 StatusBar1: TStatusBar;
　　 ProgressBar1: TProgressBar;
　　 Panel1: TPanel;
　　 GroupBox1: TGroupBox;
　　 Memo1: TMemo;
　　 Edit2: TEdit;
　　 Button2: TButton;
　　 Button3: TButton;
　　 Button4: TButton;
　　 GroupBox2: TGroupBox;
　　 Memo2: TMemo;
　　 GroupBox3: TGroupBox;
　　 Memo3: TMemo;
　　 Button5: TButton;
　　 OpenDialog1: TOpenDialog;
　　 procedure TabSet1Click(Sender: TObject);
　　 procedure Button5Click(Sender: TObject);
　　 procedure Button2Click(Sender: TObject);
　　 procedure Button1Click(Sender: TObject);
　　 procedure Button4Click(Sender: TObject);
　　 procedure Button3Click(Sender: TObject);
　　private
　　 { Private declarations }
　　 //弹出信息框
　　 procedure MsgBox(strMsg: string);
　　 procedure ThreadExit(sender: TObject);
　　public
　　 { Public declarations }
　　end;
　　
　　var
　　Form1: TForm1;
　　Thread1: array of T1; // 定义线程数组
　　n: integer = 0;
　　bool: boolean = True;
　　
　　implementation
　　
　　{$R *.dfm}
　　
　　procedure TForm1.TabSet1Click(Sender: TObject);
　　begin
　　if TabSet1.TabIndex = 0 then
　　begin
　　 GroupBox2.Visible :=true;
　　 GroupBox3.Visible :=true;
　　 GroupBox1.Visible :=false;
　　 Panel1.Visible :=False;
　　end else
　　begin
　　 GroupBox2.Visible :=false;
　　 GroupBox3.Visible :=false;
　　 GroupBox1.Visible :=true;
　　 Panel1.Visible :=true;
　　end;
　　
　　end;
　　
　　procedure TForm1.Button5Click(Sender: TObject);
　　var
　　i:integer;
　　url:string;
　　begin
　　if Edit1.Text='' then
　　begin
　　 MsgBox('请输入要检测的网站地址！');
　　 exit;
　　end;
　　Memo3.Clear;
　　Memo2.Clear;
　　ProgressBar1.Min :=0;
　　ProgressBar1.Max :=Memo1.Lines.Count;
　　ProgressBar1.Step :=1;
　　ProgressBar1.Position :=0;
　　for i:=0 to Memo1.Lines.Count - 1 do
　　begin
　　 url :=trim(Edit1.Text)+Memo1.Lines;
　　 Memo3.Lines.Add(url);
　　 GroupBox3.Caption :='信息：已检测'+inttostr(Memo3.Lines.Count)+'个页面';
　　 ProgressBar1.StepIt;
　　 if CheckUrl(url) then
　　 begin
　　 Memo2.Lines.Add('该URL存在! - '+url);
　　 GroupBox2.Caption :='存在：共找到'+inttostr(Memo2.Lines.Count)+'条路径';
　　 end;
　　end;
　　end;
　　
　　procedure TForm1.MsgBox(strMsg: string);
　　begin
　　Application.MessageBox(pchar(strMsg), '提示信息', mb_iconinformation);
　　end;
　　
　　procedure TForm1.Button2Click(Sender: TObject);
　　begin
　　if trim(Edit2.Text)'' then
　　 Memo1.Lines.Add(trim(Edit2.Text));
　　end;
　　
　　procedure TForm1.Button1Click(Sender: TObject);
　　var
　　i: integer;
　　Sum:integer;
　　begin
　　if bool then
　　begin
　　 Memo3.Clear;
　　 Memo2.Clear;
　　 n :=0;
　　 Sum :=Memo1.lines.count;
　　 SetLength(Thread1,Sum); // 动态设置线程的数量
　　 ProgressBar1.Min :=0;
　　 ProgressBar1.Max :=sum;
　　 ProgressBar1.Step :=1;
　　 ProgressBar1.Position :=0;
　　 for i := 0 to Sum - 1 do
　　 begin
　　 Thread1 := T1.Create(Memo1,Memo2,Memo3,i);
　　 Thread1.OnTerminate := ThreadExit;
　　 //ProgressBar1.StepIt;
　　 //sleep(30);
　　 end;
　　end;
　　bool := False; // 关闭开关
　　end;
　　
　　procedure TForm1.ThreadExit(sender: TObject);
　　begin
　　ProgressBar1.StepIt;
　　Memo3.Lines.Add(trim(Edit1.Text)+Memo1.Lines[n]);
　　GroupBox3.Caption :='信息：已检测'+inttostr(Memo3.Lines.Count)+'个页面';
　　inc(n); // 线程结束后自增1
　　if N = Memo1.lines.count then
　　begin
　　 bool := true; // 打开开关
　　 exit;
　　end;
　　end;
　　
　　procedure TForm1.Button4Click(Sender: TObject);
　　begin
　　if OpenDialog1.Execute then
　　 Memo1.Lines.LoadFromFile(OpenDialog1.FileName);
　　end;
　　
　　procedure TForm1.Button3Click(Sender: TObject);
　　begin
　　Memo1.Lines.Delete(Memo1.Lines.Count-1);
　　end;
　　
　　end.
　　
　　//处理线程部分
　　unit2.pas
　　
　　
　　unit Unit2;
　　
　　interface
　　
　　uses
　　Classes,StdCtrls,Windows,SysUtils,wininet,IdHTTP;
　　
　　var
　　CS:TRTLCriticalSection; //定义全局临界区
　　
　　type
　　T1 = class(TThread)
　　private
　　 TmpM1,TmpM2,TmpM3: TMemo;
　　 TmpNum: integer;
　　 Str :string;
　　 procedure DataMemo;
　　protected
　　 procedure Execute; override;
　　public
　　 constructor Create(M1,M2,M3: TMemo; Num: integer);
　　end;
　　
　　function Get(URL: string): boolean;
　　function CheckUrl(url: string; TimeOut: integer = 5000): boolean;
　　
　　implementation
　　
　　uses Unit1;
　　
　　{ T1 }
　　
　　constructor T1.Create(M1,M2,M3: TMemo; Num: integer);
　　begin
　　TmpNum := Num; // 传递参数
　　TmpM1 :=M1; // 绑定控件
　　TmpM2 :=M2;
　　TmpM3 :=M3;
　　FreeOnTerminate := True; // 自动删除
　　InitializeCriticalSection(CS); //初始化临界区
　　inherited Create(False); // 直接运行
　　end;
　　
　　function Get(URL: string): boolean;
　　var
　　IDHTTP: TIDHttp;
　　ss: String;
　　begin
　　Result:= False;
　　IDHTTP:= TIDHTTP.Create(nil);
　　try
　　 try
　　 idhttp.HandleRedirects:= true; //必须支持重定向否则可能出错
　　 idhttp.ReadTimeout:= 30000; //超过这个时间则不再访问
　　 ss:= IDHTTP.Get(URL);
　　 if IDHTTP.ResponseCode=200 then
　　 Result :=true;
　　 except
　　 end;
　　finally
　　 IDHTTP.Free;
　　end;
　　end;
　　
　　//====================== 判断网址是否存在的函数 =======================
　　function CheckUrl(url: string; TimeOut: integer = 5000): boolean;
　　var
　　hSession, hfile, hRequest: hInternet;
　　dwindex, dwcodelen: dword;
　　dwcode: array[1..20] of char;
　　res: pchar;
　　re: integer;
　　Err1: integer;
　　j: integer;
　　begin
　　if pos('http://', lowercase(url)) = 0 then
　　 url := 'http://' + url;
　　Result := false;
　　InternetSetOption(hSession, Internet_OPTION_CONNECT_TIMEOUT, @TimeOut, 4);
　　hSession := InternetOpen('Mozilla/4.0', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
　　 //设置超时
　　if assigned(hsession) then
　　begin
　　 j := 1;
　　 while true do
　　 begin
　　 hfile := InternetOpenUrl(hsession, pchar(url), nil, 0, INTERNET_FLAG_RELOAD, 0);
　　 if hfile = nil then
　　 begin
　　 j := j + 1;
　　 Err1 := GetLastError;
　　 if j 5 then break;
　　 if (Err1 12002) or (Err1 12152) then break;
　　 sleep(2);
　　 end
　　 else begin
　　 break;
　　 end;
　　 end;
　　 dwIndex := 0;
　　 dwCodeLen := 10;
　　 HttpQueryInfo(hfile, HTTP_QUERY_STATUS_CODE, @dwcode, dwcodeLen, dwIndex);
　　 res := pchar(@dwcode);
　　 re := strtointdef(res, 404);
　　 case re of
　　 400..450: result := false;
　　 else result := true;
　　 end;
　　 if assigned(hfile) then
　　 InternetCloseHandle(hfile);
　　 InternetCloseHandle(hsession);
　　 end;
　　end;
　　
　　function GetBackSpaceCount(str:string):string;
　　var i,iCount:integer;
　　begin
　　 iCount :=50-length(str);
　　 for i:=0 to iCount-1 do
　　 begin
　　 Result :=Result+' ';
　　 end;
　　end;
　　
　　procedure T1.DataMemo;
　　begin
　　TmpM2.Lines.Add(str+GetBackSpaceCount(str)+'线程'+inttostr(TmpNum+1)+'检测结果');
　　Form1.GroupBox2.Caption :='存在：共找到'+inttostr(TmpM2.Lines.Count)+'条路径';
　　end;
　　
　　procedure T1.Execute;
　　begin
　　Str :=trim(Form1.Edit1.Text) + TmpM1.Lines[TmpNum];
　　EnterCriticalSection(cs); //进入临界区
　　if CheckUrl(Str) then
　　begin
　　 Synchronize(DataMemo); // 同步
　　end;
　　LeaveCriticalSection(CS); //退出临界区
　　//sleep(20); // 线程挂起;
　　end;
　　
　　end.
　　

　　!----

（本文来源于图老师网站，更多请访问http://m.tulaoshi.com/bianchengyuyan/）
　　
（本文来源于图老师网站，更多请访问http://m.tulaoshi.com/bianchengyuyan/）
　　
（本文来源于图老师网站，更多请访问http://m.tulaoshi.com/bianchengyuyan/）
　　

　　界面是防明小子的那个扫描工具写的，算是学习多线程的一个例子把
　　
　　界面图示：

　　http://www.wrsky.com/attachment/3_1875.jpg
　　
　　程序和源代码：

　　http://downloads.2ccc.com/general/internet_lan/hnxyy_scan.rar

　　!----

　　!----

　　界面是防明小子的那个扫描工具写的，算是学习多线程的一个例子把
　　
　　界面图示：

　　http://www.wrsky.com/attachment/3_1875.jpg
　　
　　程序和源代码：

　　http://downloads.2ccc.com/general/internet_lan/hnxyy_scan.rar

　　!----

　　!----

　　界面是防明小子的那个扫描工具写的，算是学习多线程的一个例子把
　　
　　界面图示：

　　http://www.wrsky.com/attachment/3_1875.jpg
　　
　　程序和源代码：

　　http://downloads.2ccc.com/general/internet_lan/hnxyy_scan.rar

　　!----

　　!----

热门搜索

一个多线程后台扫描的程序和源代码

猜你喜欢

一个多线程后台扫描的程序和源代码

扫描整个网段的多线程程序

s8lol主宰符文怎么配

一个BBS的源代码(一)

一个BBS的源代码(三)

lol偷钱流符文搭配推荐

一个BBS的源代码(六)

一个BBS的源代码(二)

lolAD刺客新符文搭配推荐

Surface RT如何创建恢复盘？

基于Access数据库的抽奖系统设计