我最近也在做一个启动多个线程同时下载多个文件的程序（一个线程下载一个文件，各个线程相互独立），可是在设计的过程中发现一个奇怪的问题，就是在使用buttom的点击事件中处理的时候可以启动线程并下载成功，但是如果把这个处理过程放置在菜单的点击事件里头处理，结果就不一样了，线程能够创建，可是下载不会成功。我使用的环境是d5的环境，一直不明白这个到底是什么问题。
我使用的是http下载：
下载的主程序如下：
Type
PDownParam=^TDownParam;
TDownParam=Record
sServer : string;
// Server Name + Server Path + serverFileName
sFile : string;
// Server File Name -- not use right now
sDir : string;
// Local Directory + local filename
sName : string;
// Local File Name -- not use right now
PB : TProgressBar;
// Reference to ProgressBar
iBufferSize : integer;
// the buffer size fordo
wnloading
iTotalSize : integer;
// total size ofdo
wnload file
iByteReaded : integer;
//the bytes has read
sItemName : string;
// The name of thedo
wnload project
sOwner : string;
// The name of the owner
bDnFinished : boolean;
// Hasdo
wnload finished.
bPauseDnload : boolean;
// Pausedo
wnload flag ,False to continue, TRUE to pause.
iError : integer;
//错误编号
end;
type
TMyThread = class(TThread)
private
//PB : TProgressBar;
// Reference to ProgressBar
do
wnParam : PDownParam;
//do
wnload parameters
//procedure InitProgressBar;
// Setup ProgressBar
procedure UpdateProgressBar;
// Update ProgressBar
procedure InitDownParams;
//init thedo
wnload params
proceduredo
DownLoad;
//dodo
wnload;
protected
procedure Execute;
override;
// Main thread execution
published
constructor CreateIt(PriorityLevel: cardinal;
dnParam : PDownParam);
//PriorityLevel [0..6]
destructor Destroy;
override;
end;
constructor TMyThread.CreateIt(PriorityLevel: cardinal;
dnParam : PDownParam);
begin
inherited Create(true);
// Create thread suspended
Priority := TThreadPriority(PriorityLevel);
// Set Priority Level
FreeOnTerminate := true;
// Thread Free Itself when terminated
do
wnParam := dnParam;
Synchronize(InitDownParams);
//Synchronize(InitProgressBar);
// Setup the ProgressBar
Suspended := false;
// Continue the thread
end;
destructor TMyThread.Destroy;
begin
PostMessage(frmMain.Handle,wm_ThreadDoneMsg,self.ThreadID,0);
{
This posts a message to the main form, tells us when and which thread
isdo
ne executing.
}
inherited destroy;
end;
procedure TMyThread.doDownLoad;
var
hSession : HInternet;
hConnect : HInternet;
hRequest : HInternet;
lpData : array [0..1024] of Char;
dwIndex : DWORD;
dwBufLen : DWORD;
dwBtRead : DWORD;
lpBuf : Pointer;
fFile : File;
i : Integer;
FTRslt : Boolean;
HostName, FileName: String;
procedure ParseURL(URL: String;
var HostName, FileName: String);
var
i: Integer;
begin
if Pos('http://', LowerCase(URL)) <> 0 then
System.Delete(URL, 1, 7);
i := Pos('/', URL);
HostName := Copy(URL, 1, i);
FileName := Copy(URL, i, Length(URL) - i + 1);
if (Length(HostName) > 0) and (HostName[Length(HostName)] = '/') then
SetLength(HostName, Length(HostName) - 1);
end;
procedure CloseHandles;
begin
InternetCloseHandle(hRequest);
InternetCloseHandle(hConnect);
InternetCloseHandle(hSession);
end;
begin
try
ParseURL(downParam^.sServer, HostName, FileName);
hSession := InternetOpen(nil,
INTERNET_OPEN_TYPE_PRECONFIG,
nil,
nil,
0);
hConnect := InternetConnect(hSession,
PChar(HostName),
INTERNET_DEFAULT_HTTP_PORT,
nil,
nil,
INTERNET_SERVICE_HTTP,
0,
0);
hRequest := HttpOpenRequest(hConnect,
'GET',
PChar(FileName),
'HTTP/1.0',
nil,
nil,
INTERNET_FLAG_RELOAD,
0);
HttpSendRequest(hRequest,
nil,
0,
nil,
0);
dwIndex := 0;
// dwBufLen := 1024;
dwBufLen :=do
wnParam^.iBufferSize;
GetMem(lpBuf, dwBufLen);
FTRslt := HttpQueryInfo(hRequest,
HTTP_QUERY_CONTENT_LENGTH,
lpBuf,
dwBufLen,
dwIndex);
if FTRslt = true then
begin
do
wnParam^.iTotalSize := StrToInt(StrPas(lpBuf));
do
wnParam^.iByteReaded := 0;
//showmessage('HostName:'+HostName +',filename:' + filename);
//showmessage(downParam^.sDir);
AssignFile(fFile,downParam^.sDir);
Rewrite(fFile,1);
while (notdo
wnParam^.bPauseDnload)do
begin
if not InternetReadFile(hRequest,
@lpData,
SizeOf(lpData),
dwBtRead)
then
begin
break;
end
else
begin
if dwBtRead = 0 then
begin
break;
end
else
begin
BlockWrite(fFile, lpData, dwBtRead);
inc(downParam^.iByteReaded,dwBtRead);
Synchronize(UpdateProgressBar);
// Update ProgressBar, uses sychronize because ProgressBar is in another thread
end;
end;
end;
CloseFile(fFile);
end;
FreeMem(lpBuf);
CloseHandles;
except
do
wnParam^.iError := 1;
end;
do
wnParam^.bDnFinished := FTRslt;
//setdo
wnload finish flag
end;
procedure TMyThread.Execute;
// Main execution for thread
var
// i : cardinal;
bDnResult : boolean;
begin
// if (Terminated = false) then
showmessage('Terminated = false');
// if (downParam^.bDnFinished = false) then
showmessage('downParam^.bDnFinished = false');
while ((Terminated = false) and (not (downParam^.bDnFinished)))do
begin
// 执行下载操作
//showmessage('here to begin
do
wnload') ;
do
DownLoad;
// if Terminated is true, this loop exits prematurely so the thread will terminate
end;
end;
{
procedure TMyThread.InitProgressBar;
// setup/initialize the ProgressBar
begin
PB.Min := 1;
// minimum value for bar
PB.Max :=do
wnParam^.iTotalSize;
// maximum value for bar
PB.Step :=do
wnParam^.iBufferSize;
// size will be used by each call to StepIt
PB.Position := 1;
// set position to begin
ing
end;
}
//对下载参数进行初始化
procedure TMyThread.InitDownParams;
begin
//set the urlimg (file todo
wnload, file to save to, sizebuffer...)
do
wnParam^.sServer := SetDownParamServer(downParam.sServer);
//downParam^.sDir := SetDownParamDir(downParam.sDir);
do
wnParam^.iBufferSize := setDownParamBufferSize(downParam.iBufferSize);
do
wnParam^.iTotalSize := 2;
do
wnParam^.bDnFinished := false;
do
wnParam^.iError := -1;
do
wnParam^.bPauseDnload := false;
do
wnParam^.iByteReaded := 0 ;
do
wnParam^.PB.Min := 1;
// minimum value for bar
do
wnParam^.PB.Max :=do
wnParam^.iTotalSize;
// maximum value for bar
do
wnParam^.PB.Step :=do
wnParam^.iBufferSize;
// size will be used by each call to StepIt
do
wnParam^.PB.Position := 1;
// set position to begin
ing
// bDnFinished
end;
procedure TMyThread.UpdateProgressBar;
// Updates the ProgressBar
begin
// do
wnParam^.pb.Max :=do
wnParam^.iTotalSize ;
do
wnParam^.pb.Position :=do
wnParam^.iByteReaded;
//PB.StepIt;
// step the bar
end;
buttom和菜单的处理事件如下：
procedure TfrmMain.Button1Click(Sender: TObject);
var pb: TProgressBar;
begin
if (MyThread1 = nil) or (Thread1Active = false) then
// make sure its not already running
begin
//GetMem(mypDnParam, sizeof(TDownParam));
new(mypDnParam);
mypDnParam^.sServer := ‘http://delphi.about.com/library/forminbpl.zip';
mypDnParam^.sDir:='d:/test/aaaa.exe';
mypDnParam^.bPauseDnload := false ;
//showmessage('begin
todo
wnload');
pb := TProgressBar.Create(Self);
mypDnParam^.PB := pb ;
MyThread1 := TMyThread.CreateIt(3, mypDnParam);
Thread1Active := true;
end
else
ShowMessage('Thread still executing');
end;
希望这个代码对你有帮助，也希望有人能够从中发现是否能有问题。
