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

2016-02-19 20:46 75 1 收藏

图老师小编精心整理的一个多线程后台扫描的程序和源代码希望大家喜欢，觉得好的亲们记得收藏起来哦！您的支持就是小编更新的动力~

【 tulaoshi.com - 编程语言】

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

　　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://www.tulaoshi.com/bianchengyuyan/）（本文来源于图老师网站，更多请访问http://www.tulaoshi.com/bianchengyuyan/）
　　
（本文来源于图老师网站，更多请访问http://www.tulaoshi.com/bianchengyuyan/）（本文来源于图老师网站，更多请访问http://www.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

　　!----

　　!----

来源:http://www.tulaoshi.com/n/20160219/1624474.html

上一篇： Surface RT如何创建恢复盘？
下一篇：基于Access数据库的抽奖系统设计

看过《一个多线程后台扫描的程序和源代码》的人还看了以下文章更多>>

Java代码构建一个线程池

标签： Java JAVA基础

在现代的操作系统中，有一个很重要的概念――线程，几乎所有目前流行的操作系统都支持线程，线程来源于操作系统中进程的概念，进程有自己的虚拟地址空间以及正文段、数据段及堆栈，而且各自占有不同的系统资源（例如文件、环境变量等等）。与此不同，线程不能单独存在，它依附于进程，只能由进程派生。如果一个进程派生出了两个...

Java多线程程序设计

标签： Java JAVA基础

一：理解多线程 多线程是这样一种机制，它允许在程序中并发执行多个指令流，每个指令流都称为一个线程，彼此间互相独立。线程又称为轻量级进程，它和进程一样拥有独立的执行控制，由操作系统负责调度，区别在于线程没有独立的存储空间，而是和所属进程中的其它线程共享一个存储空间，这使得线程间的通信远较进程简单。 ...

C#多线程学习(一) 多线程的相关概念

标签：编程语言网络编程

什么是进程？当一个程序开始运行时，它就是一个进程，进程包括运行中的程序和程序所使用到的内存和系统资源。而一个进程又是由多个线程所组成的。什么是线程？线程是程序中的一个执行流，每个线程都有自己的专有寄存器(栈指针、程序计数器等)，但代码区是共享的，即不同的线程可以执行同样的函数。什么是多线程？多线程是指程序中包含多...

一个简单的C#多线程间同步的例子

标签：编程语言网络编程

在开发中经常会遇到线程的例子，如果某个后台操作比较费时间，我们就可以启动一个线程去执行那个费时的操作，同时程序继续执行。在某些情况下可能会出现多个线程的同步协同的问题，下面的例子就展示了在两个线程之间如何协同工作。这个程序的思路是共同做一件事情（从一个ArrayList中删除元素）,如果执行完成了，两个线程都停止执行。代码...

一个用java作的日历的源代码

标签：编程语言网络编程

import java.awt.*; import java.awt.event.*; import java.util.*; public class CalenderCreator extends Frame { Button days[]=new Button[49]; Choice Month=new Choice(); Choice Year=new Choice(); Label lmonth=new Label("MONTH"); Label lyear=new Label("Year"); Label ltext=new Label("YEAR UPTO:...

查看更多精彩>>