IDFTP的多线程扫描问题?(200分相送)(100分)

  • 主题发起人 bamfk1023
  • 开始时间
B

bamfk1023

Unregistered / Unconfirmed
GUEST, unregistred user!
main.asp (主程序)
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
SHELLAPI,Dialogs, StdCtrls,unit2, ExtCtrls, Psock, NMFtp, Spin, ComCtrls,
Menus,winsock, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdFTP;
type
TForm1 = class(TForm)
port: TEdit;
Scan: TButton;
Label2: TLabel;
ListBox1: TListBox;
Label4: TLabel;
p1: TEdit;
p3: TEdit;
p5: TEdit;
p7: TEdit;
Label5: TLabel;
p2: TEdit;
p4: TEdit;
p6: TEdit;
p8: TEdit;
Panel1: TPanel;
Label1: TLabel;
Label3: TLabel;
Label6: TLabel;
Label7: TLabel;
Splitter1: TSplitter;
ListBox2: TListBox;
SpinEdit1: TSpinEdit;
ListBox3: TListBox;
Stopscan: TButton;
StatusBar1: TStatusBar;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
Button1: TButton;
OpenDialog1: TOpenDialog;
IdFTP1: TIdFTP;
procedure ScanClick(Sender: TObject);
procedure p8Exit(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure SpinEdit1Exit(Sender: TObject);
procedure onthreadend(sender:tobject);
procedure StopscanClick(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure p1Change(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure ListBox3DblClick(Sender: TObject);
private
scan1:array of scanFtp;
exitscan:boolean;
{ Private declarations }
public
index:integer;
//当前和最大的线程数
scanlist:tlist;
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses Unit3;
{$R *.dfm}
procedure TForm1.p8Exit(Sender: TObject);
var i,j,k,l:integer;
t:string;
//初始化来源列表
begin
listbox1.Clear;
for i:=strtoint(p1.Text) to strtoint(p2.Text)do
for j:=strtoint(p3.Text) to strtoint(p4.Text)do
for k:=strtoint(p5.Text) to strtoint(p6.Text)do
for l:=strtoint(p7.Text) to strtoint(p8.Text)do
begin
t:=inttostr(i)+'.'+inttostr(j)+'.'+inttostr(k)+'.'+inttostr(l);
listbox1.Items.Add(t);
listbox1.Hint:='共:'+inttostr(listbox1.Items.Count)+'项资源';
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
Wsadata:Twsadata;
begin
WSAStartup(Makeword(2,0),Wsadata);//
form1.exitscan:=false;
form1.p8Exit(nil);
index:=0;
end;

procedure TForm1.SpinEdit1Exit(Sender: TObject);
begin
//设置线程数
if (spinedit1.Value>500) or (spinedit1.Value <2) then
spinedit1.Value:=100;
end;

//开始扫描
procedure TForm1.ScanClick(Sender: TObject);
var i:integer;
begin
if spinedit1.Value >listbox1.Count then
begin
showmessage('线程数太多!');
exit;
end;
application.Initialize;
statusbar1.SimpleText:='扫描中 . . .';
Stopscan.Visible:=true;
stopscan.Enabled:=true;
scan.Enabled:=false;
scan.Visible:=false;
try
scanlist:=tlist.Create;
except
statusbar1.SimpleText:='出错啦!';
exit;
end;
exitscan:=false;
setlength(scan1,listbox1.Count);
index:=0;
listbox3.Clear;
listbox2.Clear;
listbox2.Items.Add('扫描中 . . . ');
try
for i:=0 to spinedit1.Value-1do
begin
scan1:=scanftp.Create(listbox1.Items,listbox3);
~~~~~~~~~~这里出错!!!
scan1.FreeOnTerminate:=true;
//线程终止后自动释放内存
scan1.OnTerminate:=OnThreadend;
scan1.Resume;
scanlist.Add(scan1[index]);
index:=index+1;
end;
except
statusbar1.SimpleText:='出错啦!';
exit;
// On E:Exceptiondo
statusbar1.SimpleText:=e.message;
end;
end;
//第一个线程完毕后递归或退出
procedure TForm1.onthreadend(sender: tobject);
var i:integer;
begin
if exitscan then
exit;
//是否被停止了
i:=scanlist.IndexOf(sender);
if i>=0 then
scanlist.Delete(i);
Label1.Caption:=' 状态:主机 '+inttostr(ListBox1.Count)+' 台 '
+'已扫描 '+inttostr(listbox2.Count-1)+' 台'
+'找到 '+inttostr(listbox3.Count)+' 台';
listbox2.Selected[listbox2.Items.Count-1]:=true;
//是否所有线程都完成
if listbox2.Items.Count-1=listbox1.Items.Count then
begin
statusbar1.SimpleText:=('服务器扫描完毕');
exitscan:=true;
scanlist.Free;
scan.Visible:=true;
scan.Enabled:=true;
stopscan.Visible:=false;
stopscan.Enabled:=false;
listbox3.Hint:='找到'+inttostr(listbox3.Items.Count)+'台服务器';
end;
if (index>listbox1.Count-1) or exitscan then
exit;
try
scan1[index]:=scanftp.Create(listbox1.Items[index],listbox3);
~~~~~~~~~~这里也出错!!!
scan1[index].FreeOnTerminate:=true;
scan1[index].OnTerminate:=OnThreadend;
scan1[index].Resume;
scanlist.Add(scan1[index]);
except
statusbar1.SimpleText:='出错啦!';
exit;
// On E:Exceptiondo
statusbar1.SimpleText:=e.message;
end;
listbox3.Hint:='找到'+inttostr(listbox3.Items.Count)+'台服务器';
index:=index+1;
end;

//中止线程 未完成
procedure TForm1.StopscanClick(Sender: TObject);
var j:integer;
temp:scanftp;
begin
stopscan.Enabled:=false;
exitscan:=true;
statusbar1.SimpleText:='稍候,正在停止线程 . . .';
try
for j:=0 to scanlist.Count-1do
begin
temp:=scanlist.items[j];
temp.Terminate;
end;
except
statusbar1.SimpleText:='出错啦!';
exit;
end;
scanlist.Free;
sleep(100);
listbox3.Hint:='找到'+inttostr(listbox3.Items.Count)+'台服务器';
statusbar1.SimpleText:='停止完毕';
scan.Visible:=true;
scan.Enabled:=true;
stopscan.Visible:=false;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
aboutbox.show;
end;

procedure TForm1.p1Change(Sender: TObject);
begin
//IP输入方式设定
//showmessage('asd');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if opendialog1.Execute then
listbox3.Items.SaveToFile(opendialog1.FileName);
end;

procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
WSAcleanUP;
end;
procedure TForm1.ListBox3DblClick(Sender: TObject);
var s:string;
//双击找开FTP服务器
begin
if listbox3.Items.Count=0 then
exit;
s:=listbox3.Items[listbox3.itemindex];
shellexecute(Handle,nil,pchar(s),nil,nil,sw_shownormal);
end;
end.

scanftp.pas (多线程部分)
unit Unit2;
interface
uses
Classes, stdCtrls, winsock,windows,sysutils ,Dialogs,IdFTP;
type
scanftp = class(TThread)
private
addr:tidftp;
output:tlistbox;
ip:string;
{ Private declarations }
protected
procedure Execute;
override;
private
public
Constructor Create(ip1:string;output1:tlistbox);
end;

implementation
uses unit1 ;
constructor scanftp.Create(ip1: string;output1:tlistbox);
begin
ip:=ip1;
//服务器的IP
output:=output1;
//输出控件
addr.Username:='anonymous';
addr.Password:='asdf@163.com';
addr.ReadTimeout:=1000;
addr.RecvBufferSize:=4086;
addr.SendBufferSize:=2048;
inherited Create(suspended);
//表示创建后立即挂起
end;

procedure scanftp.Execute;
var WSAData:Twsadata;
begin
if terminated then
exit;
//terminated supspended assigned
Form1.ListBox2.Items.Add('扫描: '+ip+' . . .');
try
if (Wsastartup(MAKEWORD(2,0),wsadata)<>0) then
exit;
//初始化Sock
addr.Connect(true);
if addr.Connected then
begin
form1.ListBox2.items.Add('ftp://'+ip+' 成功');
form1.ListBox3.Items.add('ftp://'+ip);
end;
except
On E:Exceptiondo
form1.ListBox2.Items.Add(e.message);
end;
wsacleanup();
end;
end.

无法新建多个IDFTP线程.
 
UP 两个地方出错了
 
线程中少了Create
 
接受答案了.
 

Similar threads

顶部