全部博文(788)
分类:
2009-05-26 17:33:23
小弟写了一个多线程下载的程序,总是有死循环的迹象,不过我认为可能是产生了死锁。可是当单步跟踪的时候产生错误大家帮小弟看看啊:
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都死
掉
{==============================================================}