多线程下载问题（IDHTTP） Delphi / Windows SDK/APIhttp://www.delphi2007.net/DelphiNetwork/html/delphi_20061125181049257.html
小弟写了一个多线程下载的程序，总是有死循环的迹象，不过我认为可能是产生了死锁。可是当单步跟踪的时候产生错误大家帮小弟看看啊：
unit IndyMThread;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdHTTP;
type
TForm1 = class(TForm)
BtnDowload: TButton;
BtnCancel: TButton;
EdtURL: TEdit;
Label1: TLabel;
REdtMess: TRichEdit;
IdHTTP1: TIdHTTP;
procedure BtnDowloadClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TThreadLoad = class(TThread)
private
{private declatation}
m_sURL:string;
protected
{protected declaration}
procedure GetFile(var sFileName:string);
procedure REditAdd;
procedure Execute;override;
public
{Public declarations }
REdt:TRichEdit;
Constructor Create(bWait:Boolean;const URL:string);
// Destructor Destroy;override;
end;
var
Form1: TForm1;
m_ArrayImage: Array[0..4]of string;
g_i:integer;
CriticalSec:TRTLCriticalSection;
implementation
{$R *.dfm}
procedure TThreadLoad.GetFile(var sFileName:string);
var
i:integer;
begin
for i:=0 to 4 do
begin
if m_arrayimage[i]='' then continue;
sFileName:=m_arrayimage[i];
m_arrayimage[i]:='';
exit;
end;
end;
procedure TThreadLoad.REditAdd;
begin
REdt.Lines.Append('正在保存');
end;
procedure TThreadLoad.Execute;
var
IDHttp2:TIDHttp;
file_name:string;
Streamfile1:TMemoryStream;
begin
while not terminated do
begin
EnterCriticalSection(CriticalSec);//进入临界段
try
GetFile(File_name);
IDHttp2:=TIDHttp.Create(nil);
try
StreamFile1:=TMemoryStream.Create;
try
IDHttp2.Head(m_sURL);
IDHttp2.Get(m_sURL,StreamFile1);
StreamFile1.SaveToFile('d:\'+file_name);
finally
StreamFile1.Free;
end;
finally
idhttp2.Free;
end;
// synchronize(REditAdd);
finally
LeaveCriticalSection(CriticalSec);
end;
if file_name='' then exit;
end;//begin
end;
procedure TForm1.BtnDowloadClick(Sender: TObject);
var
i,k:integer;
ThreadArray:array[0..4]of TThreadLoad;
begin
for i:=0 to 4 do
begin
ThreadArray[i]:=tthreadLoad.Create(true,EdtURL.Text+'/'+m_arrayimage[i]);
ThreadArray[i].REdt:=REdtMess;
end;
for k:=0 to 4 do ThreadArray[k].Resume;
end;
Constructor TThreadLoad.Create(bWait:boolean;const URL:string);
begin
inherited create(bWait);
m_sURL:=URL;
end;
{Destructor TThreadLoad.Destroy;
begin
inherited Destroy;
end; }
procedure TForm1.FormCreate(Sender: TObject);
begin
m_ArrayImage[0]:='aa.bmp';
m_arrayImage[4]:='4.jpg';
m_arrayimage[2]:='1.jpg';
m_arrayimage[3]:='2.jpg';
m_arrayimage[1]:='3.jpg';
g_i:=0;
InitializeCriticalSection(CriticalSec)
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteCriticalSection(CriticalSec);
end;
end.
{==============================================================}
delphi的单步跟踪的时候产生错误错误提示，有的时候会整个delphi都死
掉
{==============================================================}
{=======================}
{=问题已经解决,代码如下=}
{=======================}
unit IndyMThread;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdHTTP;
type
TForm1 = class(TForm)
BtnDowload: TButton;
BtnCancel: TButton;
EdtURL: TEdit;
Label1: TLabel;
REdtMess: TRichEdit;
IdHTTP1: TIdHTTP;
procedure BtnDowloadClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TThreadLoad = class(TThread)
private
{private declatation}
m_sURL:string;
protected
{protected declaration}
procedure GetFile(var sFileName:string);
procedure REditAdd;
procedure Execute;override;
function GetFileName(const sURL:string):string;
public
{Public declarations }
REdt:TRichEdit;
Constructor Create(bWait:Boolean;const URL:string);
end;
var
Form1: TForm1;
m_ArrayImage: Array[0..4]of string;
CriticalSec:TRTLCriticalSection;
implementation
{$R *.dfm}
function TThreadLoad.GetFileName(const sURL:string):string;
var
URlName:string;
i:integer;
begin
URLName:=sURL;
i:=Pos('/',URLName);
while i<>0 do
begin
i:=Pos('/',URLName);
delete(URLName,1,i);
end;
Result:=URLName;
end;
procedure TThreadLoad.GetFile(var sFileName:string);
var
i:integer;
begin
sFileName:='';
for i:=0 to 4 do
begin
if m_arrayimage[i]='' then continue;
sFileName:=m_arrayimage[i];
m_arrayimage[i]:='';
exit;
end;
end;
procedure TThreadLoad.REditAdd;
begin
REdt.Lines.Append('正在保存');
end;
procedure TThreadLoad.Execute;
var
IDHttp2:TIDHttp;
file_name:string;
Streamfile1:TMemoryStream;
filename1:string;
begin
while not terminated do
begin
EnterCriticalSection(CriticalSec);//进入临界段
try
GetFile(File_name);
filename1:=GetFileName(File_name);
finally
LeaveCriticalSection(CriticalSec); //退出临界段
end;
if file_name='' then exit;
IDHttp2:=TIDHttp.Create(nil);
try
StreamFile1:=TMemoryStream.Create;
try
IDHttp2.Head(File_name);
IDHttp2.Get(File_name,StreamFile1);
StreamFile1.SaveToFile('d:\'+filename1);
finally
StreamFile1.Free;
end;
finally
idhttp2.Free;
end;
synchronize(REditAdd);
end;//while
end;
procedure TForm1.BtnDowloadClick(Sender: TObject);
var
i,k:integer;
ThreadArray:array[0..4]of TThreadLoad;
begin
for i:=0 to 4 do
begin
ThreadArray[i]:=tthreadLoad.Create(true,trim(REdtMess.Text));
ThreadArray[i].REdt:=REdtMess;
end;
for k:=0 to 4 do ThreadArray[k].Resume;
end;
Constructor TThreadLoad.Create(bWait:boolean;const URL:string);
begin
inherited create(bWait);
m_sURL:=URL;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
m_ArrayImage[0]:='http://localhost/Test/123/aa.rar';
m_arrayImage[4]:='http://localhost/Test/123/4.jpg';
m_arrayimage[2]:='http://localhost/Test/123/1.jpg';
m_arrayimage[3]:='http://localhost/Test/123/2.jpg';
m_arrayimage[1]:='http://localhost/Test/123/3.jpg';
InitializeCriticalSection(CriticalSec)
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteCriticalSection(CriticalSec);
end;
end.
^
JF
学习！！
你的 “临界段” 保持的时间太久了
其他进程访问不到资源就死掉了
建议参照TThreadList类封装需要保护的对象