怎么做一个类似网页或者文件的下载的程序？ ( 积分: 200 )

我想做一个下载网页或者文件的工具。不需要多进程。
只要可以下就可以了。怎么做啊。

我看了INDY的例子IDHTTP的例子。作了一个。
可是都没有问题，但是突然有一天出现"cannot allocate socket" Indy错误，不过今天就好了。使用WEBBROWER也好了。奇怪了。
奇怪。。。。。。。怎么回事呢。

uses Wininet

function DownloadFile(
const url:string;
const destinationFileName:string):boolean;
var
hInet:HINTERNET;
hFile:HINTERNET;
localFile:file;
buffer:array[1..10240] of byte;
bytesReadWORD;
begin
result := False;
hInet := InternetOpen(PChar(application.title),
INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
hFile := InternetOpenURL(hInet, PChar(url), nil, 0, 0, 0);

if Assigned(hFile) then
begin
AssignFile(localFile, destinationFileName);
Rewrite(localFile, 1);

repeat
InternetReadFile(hFile, @buffer, SizeOf(buffer), bytesRead);
BlockWrite(localFile, buffer, bytesRead);

until bytesRead = 0;
CloseFile(localFile);
result := true;
InternetCloseHandle(hFile);
end;
InternetCloseHandle(hInet);
end;

可否适合网页。。

我用的ftp控件下载东西的，http还真不知道，学习之。

unit IEDownload;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,ScktComp,UPublicDef,ComCtrls,InIFIles,CPUCounter_Hss;

type
Tbufchar=array[0..BufSize-1] of char;
Tbufbyte=array[0..BufSize-1] of byte;

type
TIEDownloadThread=Class(TThread)
private
FClientSocket:TClientSocket;
FBufByte:Tbufbyte;
FBufChar:Tbufchar;
FUrlHost:String;
FUrlFile:String;
FThreadIndex:Integer;
FThreadCount:Integer;
FFilePosBeginWord;
FFilePosEndWord;
FFileStream: TFileStream;
FCriticalSection: TRTLCriticalSection;
FComplete: Boolean;
FFileID: Integer;
FHaveDownLoadLength: DWord;
FIniFile: TIniFile;
FTryConnectCount: Byte;
procedure SetUrlFile(const Value: String);
procedure SetUrlHost(const Value: String);
procedure SetThreadIndex(const Value: Integer);
procedure SetFilePosBegin(const Value: DWord);
procedure SetFilePosEnd(const Value: DWord);
procedure SetThreadCount(const Value: Integer);
function BeforeDownLoad():Bool;
Procedure BeginDownLoad();
Procedure AfterDownLoad();
function InitSocket():Boolean;
function FinalSocket():Boolean;
procedure SetComplete(const Value: Boolean);
procedure SetFileID(const Value: Integer);
procedure SetHaveDownLoadLength(const Value: DWord);
procedure SetTryConnectCount(const Value: Byte);
protected
procedure Execute(); override;
public
property UrlFile:String read FUrlFile write SetUrlFile;
property UrlHost:String read FUrlHost write SetUrlHost;
property ClientSocket:TClientSocket read FClientSocket write FClientSocket;
property ThreadIndex:Integer read FThreadIndex write SetThreadIndex;
property ThreadCount:Integer read FThreadCount write SetThreadCount;
property FilePosBeginWord read FFilePosBegin write SetFilePosBegin;
property FilePosEndWord read FFilePosEnd write SetFilePosEnd;
property FileStream:TFileStream read FFileStream write FFileStream;
property IniFile:TIniFile read FIniFile write FIniFile;
property CriticalSection :TRTLCriticalSection read FCriticalSection write FCriticalSection;
property Complete:Boolean read FComplete write SetComplete;
property FileID:Integer read FFileID write SetFileID;
property HaveDownLoadLengthWord read FHaveDownLoadLength write SetHaveDownLoadLength;
property TryConnectCount:Byte read FTryConnectCount write SetTryConnectCount;
{互斥}
function InitializeCriticalSectionA():Boolean;
function EnterCriticalSectionA ():Boolean;
function DeleteCriticalSectionA():Boolean;
function LeaveCriticalSectionA():Boolean;
end;

type
TArrayDownLoadThread=array of TIEDownloadThread;

TFileInfo = record
TotalLength : DWord;
ISCanRec : Boolean;
RecRang : String;
end;

TIEDownload=Class(TThread)
private
FClientSocket : TClientSocket;
FBufByte : Tbufbyte;
FThreadCount : DWOrd;
FFileStream : TFileStream;
FDownLoadThread : TArrayDownLoadThread;
FFileUrl: String;
FFilePath: String;
FCriticalSection: TRTLCriticalSection;
FThreadIndex: Byte;
FFileType: String;
FFileID: Integer;
FIniFile: TIniFile;
procedure SetThreadCount(const Value: DWord);
function GetTrueUrl(Url:String):string;
function GetUrlHost(Url:String):String;
function GetUrlFile(Url:String):String;
function GetFileName(Url:String):String;
function GetNewUrlStr(URLFile,UrlHost:String):String;
function GetFileInfo(URLFile,UrlHost:String):TFileInfo;
function InitSocket():Boolean;
function FinalSocket():Boolean;
procedure SetFileUrl(const Value: String);
procedure SetFilePath(const Value: String);
procedure SetThreadIndex(const Value: Byte);
procedure SetFileType(const Value: String);
function InitializeCriticalSectionA():Boolean;
function DeleteCriticalSectionA():Boolean;
procedure SetFileID(const Value: Integer);
protected
procedure Execute(); override;
public
property FileUrl:String read FFileUrl write SetFileUrl;
property FilePath:String read FFilePath write SetFilePath;
property FileType:String read FFileType write SetFileType;
property ThreadIndex:Byte read FThreadIndex write SetThreadIndex;
property ThreadCountword read FThreadCount write SetThreadCount;
property FileStream : TFileStream read FFileStream write FFileStream;
property IniFile:TIniFile read FIniFile write FIniFile;
property ClientSocket:TClientSocket read FClientSocket write FClientSocket;
property CriticalSection :TRTLCriticalSection read FCriticalSection write FCriticalSection;
property DownLoadThread:TArrayDownLoadThread read FDownLoadThread write FDownLoadThread;
property FileID:Integer read FFileID write SetFileID;
procedure Start;
procedure Stop;
end;

var
Download:array of TIEDownload;

function GetThreadIndex():Integer; {查询哪个线程处于空闲状态}
procedure CreateDownLoadThread(URL:String
;SavePath:String
;DownLoadThread:Integer
;FileID:String
;FileType:String);

implementation

uses
UXSDownLoad;


{ TIEDownloadThread }

{-----------------如果有连接，那么就将连接释放---------------------------------}
{--------------------------------------------------------}
{ 函数名称:CriticalSection }
{ 函数作用:同步 }
{ 日 期:2006/6/26 10:29 }
{--------------------------------------------------------}
function TIEDownloadThread.InitializeCriticalSectionA():Boolean;
begin
Result:=False;
try
InitializeCriticalSection(FCriticalSection);
Result:=True;
except
end;
end;

function TIEDownloadThread.EnterCriticalSectionA ():Boolean;
begin
Result:=False;
try
EnterCriticalSection(FCriticalSection);
Result:=True;
except
end;
end;

function TIEDownloadThread.LeaveCriticalSectionA():Boolean;
begin
Result:=False;
try
LeaveCriticalSection(FCriticalSection);
Result:=True;
except
end;
end;

function TIEDownloadThread.DeleteCriticalSectionA():Boolean;
begin
Result:=False;
try
DeleteCriticalSection(FCriticalSection);
Result:=True;
except
end;
end;

function TIEDownloadThread.FinalSocket: Boolean;
begin
Result:=False;
try
if Assigned(FClientSocket) then
FClientSocket.Free;
Result:=True;
except
end;
end;

{-----------------初始化连接->如果没有创建，那就创建一个连接--------------------}
function TIEDownloadThread.InitSocket: Boolean;
begin
Result:=False;
try
if Not Assigned(FClientSocket) then
FClientSocket:=TClientSocket.Create(nil);
FClientSocket.ClientType:=ctBlocking;
Result:=True;
except
end;
end;

function TIEDownloadThread.BeforeDownLoad():Bool;
begin
Result:=False;
FComplete:=False;
FHaveDownLoadLength:=0;
{如果文件的开始就是文件的结束，那么就是文件已经下载完毕}
if FilePosBegin>=FilePosEnd then
begin
FComplete:=True;
Exit;
end;
{如果文件没有打开那么，退出}
if FileStream=Nil then Exit;

Result:=True;
end;

{-----------------开始下载文件-------------------------------------------------}
procedure TIEDownloadThread.BeginDownLoad();
var
UrlStr:String;
RecLengthOnceword;
FStringStream:TStringStream;
FSocketStream:TWinSocketStream;
ConnectCount:Byte;

procedure WriteProcessToFile;
begin
IniFile.WriteString('File'
,'Thread'+IntToStr(ThreadIndex)
,IntToStr(FilePosBegin)+'-'+IntToStr(FilePosEnd));
end;

begin
if InitSocket then
begin
If Not Assigned(ClientSocket) Then
begin
Exit;
end;

ConnectCount:=0;

while (not self.Terminated ) and (ConnectCount<=TryConnectCount) do
begin

try
ClientSocket.Close;
if pos(':',UrlHost)>0 then
begin
ClientSocket.Host:=Copy(UrlHost,1,pos(':',UrlHost)-1);
ClientSocket.Port:=StrToInt(Copy(UrlHost,pos(':',UrlHost)+1,Length(UrlHost)-pos(':',UrlHost)));
end else
begin
ClientSocket.Host:=UrlHost;
ClientSocket.Port:=80;
end;
ClientSocket.Open;
except
_ShowSystemInfo('线程：'+IntToStr(ThreadIndex)+'连接失败，准备重试');
Inc(ConnectCount);
Continue;
end;

try
UrlStr:='';
UrlStr:=UrlStr+'GET /'+UrlFile+' HTTP/1.1'+#13#10;
UrlStr:=UrlStr+'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*'+#13#10;
UrlStr:=UrlStr+'Pragma: no-cache'+#13#10;
UrlStr:=UrlStr+'Cache-Control: no-cache'+#13#10;
UrlStr:=UrlStr+'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)'+#13#10;
UrlStr:=UrlStr+'RANGE: bytes='+inttostr(FilePosBegin)+'-'+IntToStr(FilePosEnd)+#13#10;
UrlStr:=UrlStr+'Host: '+UrlHost+#13#10;
UrlStr:=UrlStr+#13#10;
//DisPlayMessage('线程编号'+inttostr(ThreadIndex)+'文件开始'+inttostr(FilePosBegin)+'文件结束'+inttostr(FilePosEnd));
ClientSocket.Socket.SendText(UrlStr);
//--------------------------------------------------------------------去掉头文件
//RelRecLength:=0;
FStringStream:=TStringStream.Create('');
FSocketStream:=TWinSocketStream.create(ClientSocket.Socket, 60*1000);

try
While ClientSocket.Active Do
begin
ZeroMemory(@FBufChar,SizeOf(FBufChar));
RecLengthOnce:=FsocketStream.Read(FBufChar, 1);
if RecLengthOnce=0 then
begin
_ShowSystemInfo('线程：'+IntToStr(ThreadIndex)+'读数据失败，准备重试');
Inc(ConnectCount);
Continue;
end;

FStringStream.Write(FBufChar,RecLengthOnce);
if Pos(#13#10,FStringStream.DataString)<>0 then
begin
if FStringStream.DataString=#13#10 then
begin
//FSocketStream.Free;
//FStringStream.Free;
Break;
end;
FStringStream.Free;
FStringStream:=TStringStream.Create('');
end;
end;
finally
FStringStream.Free;
FSocketStream.Free;
end;

//----------------------------------------------------------------------下载正文
While ClientSocket.Active Do
begin
ZeroMemory(@FBufByte,sizeof(FBufByte));
RecLengthOnce:=ClientSocket.Socket.ReceiveBuf(FBufByte,sizeof(FBufByte));

if RecLengthOnce=0 then
begin
_ShowSystemInfo('线程：'+IntToStr(ThreadIndex)+'读数据失败，准备重试');
Inc(ConnectCount);
Continue;
end;

EnterCriticalSectionA(); //进入互斥
FileStream.Seek(FilePosBegin,0);
FileStream.WriteBuffer(FBufByte,RecLengthOnce);
FilePosBegin:=FilePosBegin+RecLengthOnce;
FHaveDownLoadLength:=FHaveDownLoadLength+RecLengthOnce;
{写进度到配置文件}
WriteProcessToFile;
LeaveCriticalSectionA(); //离开互斥

if FilePosBegin>=FilePosEnd then
begin
LeaveCriticalSectionA(); //离开互斥
FComplete:=True;
Break;
end;
application.ProcessMessages;
end;

{完成后}
if FilePosBegin>=FilePosEnd then
begin
FComplete:=True;
Break;
end else
begin
_ShowSystemInfo('线程：'+IntToStr(ThreadIndex)+'读数据错误，准备重试');
Inc(ConnectCount);
Continue;
end;

except
_ShowSystemInfo('线程：'+IntToStr(ThreadIndex)+'读数据错误，准备重试');
Inc(ConnectCount);
Continue;
end;
end;

FComplete:=True;

ClientSocket.Active:=false;
end;
end;

procedure TIEDownloadThread.AfterDownLoad;
begin
FinalSocket;
end;

procedure TIEDownloadThread.Execute;
begin
inherited;
if Not BeforeDownLoad then
Exit;
BeginDownLoad();
AfterDownLoad;
end;


procedure TIEDownloadThread.SetUrlFile(const Value: String);
begin
FUrlFile := Value;
end;

procedure TIEDownloadThread.SetUrlHost(const Value: String);
begin
FUrlHost := Value;
end;

procedure TIEDownloadThread.SetThreadIndex(const Value: Integer);
begin
FThreadIndex := Value;
end;

procedure TIEDownloadThread.SetFilePosBegin(const Value: DWord);
begin
FFilePosBegin := Value;
end;

procedure TIEDownloadThread.SetFilePosEnd(const Value: DWord);
begin
FFilePosEnd := Value;
end;

procedure TIEDownloadThread.SetThreadCount(const Value: Integer);
begin
FThreadCount := Value;
end;

procedure TIEDownloadThread.SetComplete(const Value: Boolean);
begin
FComplete := Value;
end;

procedure TIEDownloadThread.SetFileID(const Value: Integer);
begin
FFileID := Value;
end;

procedure TIEDownloadThread.SetHaveDownLoadLength(const Value: DWord);
begin
FHaveDownLoadLength := Value;
end;

procedure TIEDownloadThread.SetTryConnectCount(const Value: Byte);
begin
FTryConnectCount := Value;
end;












{ TIEDownload }

{-----------------初始化连接->如果没有创建，那就创建一个连接--------------------}
function TIEDownload.InitSocket: Boolean;
begin
Result:=False;
try
if Not Assigned(FClientSocket) then
FClientSocket:=TClientSocket.Create(nil);
FClientSocket.ClientType:=ctBlocking;
Result:=True;
except
end;
end;

{-----------------如果有连接，那么就将连接释放---------------------------------}
function TIEDownload.FinalSocket: Boolean;
begin
Result:=False;
try
if Assigned(FClientSocket) then
FreeAndNil(FClientSocket);
Result:=True;
except
end;
end;

{-----------------如果URL里有参数，那么就处理得到真实的连接--------------------}
function TIEDownload.GetTrueUrl(Url: String):string;
begin
if pos('?',Url)>0 then
begin
Result:=GetNewUrlStr(GetUrlFile(URL),GetUrlHost(URL));
end else Result:=URL;
end;

{-----------------得到连接里的文件名称-----------------------------------------}
function TIEDownload.GetUrlFile(Url: String):String;
var
UrlStr:String;
begin
UrlStr:=trim(Url);
if pos('http://',lowercase(UrlStr))=1 then
begin
UrlStr:=copy(UrlStr,length('http://')+1,length(UrlStr));
end;
If pos('/',UrlStr)<>0 Then
begin
UrlStr:=copy(UrlStr,pos('/',UrlStr)+1,length(UrlStr));
end;
Result:=UrlStr;
end;

{-----------------得到连接里的文件名称-----------------------------------------}
function TIEDownload.GetFileName(Url:String):String;
var
UrlStr:String;
begin
UrlStr:=trim(Url);
if pos('http://',lowercase(UrlStr))=1 then
begin
UrlStr:=copy(UrlStr,length('http://')+1,length(UrlStr));
end;
While pos('/',UrlStr)<>0 Do
begin
UrlStr:=copy(UrlStr,pos('/',UrlStr)+1,length(UrlStr));
end;
Result:=UrlStr;
end;

{-----------------得到连接里的主机地址-----------------------------------------}
function TIEDownload.GetUrlHost(Url: String):String;
var
UrlStr:String;
begin
UrlStr:=trim(Url);
if pos('http://',lowercase(UrlStr))=1 then
begin
UrlStr:=copy(UrlStr,length('http://')+1,length(UrlStr));
end;
if pos('/',UrlStr)<>0 then
begin
UrlStr:=copy(UrlStr,0,pos('/',UrlStr)-1);
end;
Result:=UrlStr;
end;

{-----------------发送请求得到URL的真实的地址----------------------------------}
function TIEDownload.GetNewUrlStr(URLFile,UrlHost:String):String;
var
UrlStr:String;
UrlHead:String;
begin
if InitSocket then
begin
If Not Assigned(ClientSocket) Then
begin
Result:='';
Exit;
end;

try
_ShowSystemInfo('连接'+UrlHost+'....');
ClientSocket.Close;
{如果端口不是80，那么就使用新的端口}
if pos(':',UrlHost)>0 then
begin
ClientSocket.Host:=Copy(UrlHost,1,pos(':',UrlHost)-1);
ClientSocket.Port:=StrToInt(Copy(UrlHost,pos(':',UrlHost)+1,Length(UrlHost)-pos(':',UrlHost)));
end else
begin
ClientSocket.Host:=UrlHost;
ClientSocket.Port:=80;
end;
ClientSocket.Open;
if ClientSocket.Socket.Connected then
_ShowSystemInfo('连接'+UrlHost+'成功')
else
_ShowSystemInfo('连接'+UrlHost+'失败')
except
_ShowSystemInfo('无法解析域名：'+UrlHost);
Result:='';
Exit;
end;

try
{发送HTTP请求}
UrlStr:='';
UrlStr:=UrlStr+'HEAD /'+UrlFile+' HTTP/1.1'+#13#10;
UrlStr:=UrlStr+'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*'+#13#10;
UrlStr:=UrlStr+'Pragma: no-cache'+#13#10;
UrlStr:=UrlStr+'Cache-Control: no-cache'+#13#10;
UrlStr:=UrlStr+'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)'+#13#10;
UrlStr:=UrlStr+'Host: '+UrlHost+#13#10;
UrlStr:=UrlStr+#13#10;
ClientSocket.Socket.SendText(UrlStr);
ZeroMemory(@FBufByte,sizeof(FBufByte));
ClientSocket.Socket.ReceiveBuf(FBufByte,sizeof(FBufByte));
UrlHead:='';
UrlHead:=strpas(@FBufByte);
application.ProcessMessages;
ClientSocket.Active:=false;
if Pos('Location:',UrlHead)>0 then
begin
UrlHead:=Copy(UrlHead,Pos('Location:',UrlHead),Length(UrlHead)-Pos('Location:',UrlHead)+1);
Result:=Trim(Copy(UrlHead,Pos(':',UrlHead)+1,Pos(#13#10,UrlHead)-Pos(':',UrlHead)+1));
end else
begin
Result:='';
end;
except
_ShowSystemInfo('请求解析域名失败：'+UrlHost);
Result:='';
end;
end;
end;

{--------------------------------------------------------}
{ 函数名称:CriticalSection }
{ 函数作用:同步 }
{ 日 期:2006/6/26 10:29 }
{--------------------------------------------------------}
function TIEDownload.InitializeCriticalSectionA():Boolean;
begin
Result:=False;
try
InitializeCriticalSection(FCriticalSection);
Result:=True;
except
end;
end;

function TIEDownload.DeleteCriticalSectionA():Boolean;
begin
Result:=False;
try
DeleteCriticalSection(FCriticalSection);
Result:=True;
except
end;
end;


{-----------------发送请求得到文件的信息 大小，是否允许下载--------------------}
function TIEDownload.GetFileInfo(URLFile,UrlHost:String):TFileInfo;
var
UrlStr:String;
UrlHead:String;
begin
if InitSocket then
begin
If Not Assigned(ClientSocket) Then
begin
Result.TotalLength:=0;
Result.ISCanRec:=False;
Result.RecRang:='';
Exit;
end;

try
_ShowSystemInfo('连接'+UrlHost+'....');
ClientSocket.Close;
if pos(':',UrlHost)>0 then
begin
ClientSocket.Host:=Copy(UrlHost,1,pos(':',UrlHost)-1);
ClientSocket.Port:=StrToInt(Copy(UrlHost,pos(':',UrlHost)+1,Length(UrlHost)-pos(':',UrlHost)));
end else
begin
ClientSocket.Host:=UrlHost;
ClientSocket.Port:=80;
end;
ClientSocket.Open;
except
_ShowSystemInfo('无法解析域名：'+UrlHost);
Result.TotalLength:=0;
Result.ISCanRec:=False;
Result.RecRang:='';
Exit;
end;

try
{发送GET命令}
UrlStr:='';
UrlStr:=UrlStr+'GET /'+UrlFile+' HTTP/1.1'+#13#10;
UrlStr:=UrlStr+'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*'+#13#10;
UrlStr:=UrlStr+'Pragma: no-cache'+#13#10;
UrlStr:=UrlStr+'Cache-Control: no-cache'+#13#10;
UrlStr:=UrlStr+'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)'+#13#10;
UrlStr:=UrlStr+'RANGE: bytes='+inttostr(0)+'-'+#13#10;
UrlStr:=UrlStr+'Host: '+UrlHost+#13#10;
UrlStr:=UrlStr+#13#10;

ClientSocket.Socket.SendText(UrlStr);
ZeroMemory(@FBufByte,sizeof(FBufByte));
ClientSocket.Socket.ReceiveBuf(FBufByte,sizeof(FBufByte));
UrlHead:='';
UrlHead:=strpas(@FBufByte);
application.ProcessMessages;
ClientSocket.Active:=false;
if Pos(LowerCase('Content-Length:'),LowerCase(UrlHead))>0 then
begin
UrlHead:=Copy(
UrlHead,Pos('Content-Length:',UrlHead)
,Length(UrlHead)-Pos('Content-Length:'
,UrlHead)+1);

Result.TotalLength:=StrToInt(Trim(Copy(UrlHead,Pos(':',UrlHead)+1,Pos(#13#10,UrlHead)-Pos(':',UrlHead)+1)));
end else
begin
Result.TotalLength:=0;
end;

if pos('Content-Range:',UrlHead)>1 then
begin
Result.ISCanRec:=True;
UrlHead:=Copy(UrlHead,Pos('Content-Range:',UrlHead),Length(UrlHead)-Pos('Content-Range:',UrlHead)+1);
Result.RecRang:=Trim(Copy(UrlHead,Pos(':',UrlHead)+1,Pos(#13#10,UrlHead)-Pos(':',UrlHead)+1));
end else Result.ISCanRec:=False;

except
_ShowSystemInfo('请求解析域名失败：'+UrlHost);
Result.TotalLength:=0;
Result.ISCanRec:=False;
Result.RecRang:='';
end;
end;
end;

procedure TIEDownload.Start();
type
TFilePos=record
BeginPosWord;
EndPosWord;
end;

var
I:Integer;
Url:String;
TrueUrlStr:String;
FIleInfo:TFileInfo;
FileName:String;
UrlFile,UrlHost:String;
FileList:TListItem;
//IniFile:TIniFile;

NeedThreadCountWord;
NeedBufCountWord;
LeftBufSizeword;

Complete:Boolean;
CurrentLengthWord;

BeginTime,EndTimeouble;
AllHaveDownLoadLengthWord;

TempConfigFileName,TempFileName:String;


{得到线程 ThreadID 读取文件的开始位置和结束位置}
function GetFilePosBeginEnd(ThreadIDWOrd;ThreadCountWord):TFilePos;
var
ThreadBufCountWord;
ThreadBufCountLeftWord;
begin
ThreadBufCount:=NeedBufCount div ThreadCount;
ThreadBufCountLeft:=NeedBufCount mod ThreadCount;

if ThreadID<=ThreadBufCountLeft then
begin
if ThreadBufCountLeft>0 then
begin
Result.BeginPos:=(ThreadID-1)*(ThreadBufCount+1)*OneThreadDownLoadMinSize;
Result.EndPos:=(ThreadID)*(ThreadBufCount+1)*OneThreadDownLoadMinSize;
end else
begin
Result.BeginPos:=(ThreadID-1)*(ThreadBufCount)*OneThreadDownLoadMinSize;
Result.EndPos:=(ThreadID)*(ThreadBufCount)*OneThreadDownLoadMinSize;
end;
end else
begin
Result.BeginPos:=NeedBufCount*OneThreadDownLoadMinSize
-ThreadBufCount*OneThreadDownLoadMinSize*(ThreadCount-ThreadID+1);
Result.EndPos:=NeedBufCount*OneThreadDownLoadMinSize
-ThreadBufCount*OneThreadDownLoadMinSize*(ThreadCount-ThreadID);
end;

{如果是最后一个线程，那结束位置就要加上剩余的数据}
if ThreadID=ThreadCount then
Result.EndPos:=Result.EndPos+ LeftBufSize;
end;

function GetFilePosBeginEndA(ThreadIDWOrd;ThreadCount:Integer):TFilePos;
var
ThreadBeginEndStr:String;
BeginPos,EndPosWord;
begin
ThreadBeginEndStr:=IniFile.ReadString('File','Thread'+IntToStr(ThreadID),'');

if ThreadBeginEndStr='' then
begin
Result:=GetFilePosBeginEnd(ThreadID,ThreadCount);
Exit;
end;

if pos('-',ThreadBeginEndStr)<=0 then
begin
Result:=GetFilePosBeginEnd(ThreadID,ThreadCount);
Exit;
end;

try
BeginPos:=StrToInt(Copy(ThreadBeginEndStr,1,pos('-',ThreadBeginEndStr)-1));
except
Result:=GetFilePosBeginEnd(ThreadID,ThreadCount);
Exit;
end;
try
EndPos:=StrToInt(Copy(ThreadBeginEndStr
,pos('-',ThreadBeginEndStr)+1
,Length(ThreadBeginEndStr)-pos('-',ThreadBeginEndStr)));
except
Result:=GetFilePosBeginEnd(ThreadID,ThreadCount);
Exit;
end;
Result.BeginPos:=BeginPos;
Result.EndPos:=EndPos;

end;

procedure AddFileToListView;
var
I:Integer;
begin
for I:=0 to OnDownFileList.Items.Count-1 do
begin
if OnDownFileList.Items.Caption=IntToStr(FileID) then
Exit;
end;

FileList:=OnDownFileList.Items.Add;
FileList.Caption:=IntToStr(FileID);
FileList.SubItems.Add(GetUrlFile(URL));
FileList.SubItems.Add('准备中');
FileList.SubItems.Add(FileType);
FileList.SubItems.Add('0');
FileList.SubItems.Add('0');
FileList.SubItems.Add('0');
FileList.SubItems.Add('0');
FileList.SubItems.Add('0');
end;

procedure _CreateTempFile;
begin
TempFileName:=FilePath+'/'+FileName+'.XS';
TempConfigFileName:=FilePath+'/'+FileName+'.XS.CFG';

_ShowSystemInfo('检查临时文件....');
if (FileExists(TempFileName))
and (FileExists(TempConfigFileName)) then
begin
FileStream:=CreateTempFile(TempFileName,FIleInfo.TotalLength,1);
if FIleStream<>Nil then
_ShowSystemInfo('临时文件和临时配置文件都存在，打开临时文件')
else
_ShowSystemInfo('临时文件打开失败')
end else if (FileExists(TempConfigFileName)=False)
and (FileExists(TempFileName)) then
begin
TempFileName:=TempFileName+'.'+FormatDatetime('HHMMSS',Now);
FileStream:=CreateTempFile(TempFileName,FIleInfo.TotalLength,0);
if FileStream<>Nil then
_ShowSystemInfo('临时文件存在但是配置文件不存在，重新创建临时文件，重新下载')
else
_ShowSystemInfo('临时文件创建失败')
end else
begin
FileStream:=CreateTempFile(TempFileName,FIleInfo.TotalLength,0);
if FileExists(TempConfigFileName) then
DeleteFile(TempConfigFileName);
if FileStream<>Nil then
_ShowSystemInfo('临时文件不存在，创建临时文件，开始下载')
else
_ShowSystemInfo('临时文件创建失败')
end;
end;

procedure _CreateDownLoadThread;
var
I:Integer;
begin
{读取配置文件看是否是最新的文件，然后根据信息创建线程 }
IniFile:=TIniFile.Create(TempConfigFileName);
NeedThreadCount:= IniFile.ReadInteger('FIle','ThreadCount',0);
if NeedThreadCount>0 then
begin
{如果配置文件中线程数>0，那么根据配置文件中的线程数，下载}

SetLength(FDownLoadThread,NeedThreadCount);
_ShowFileOtherInfo(FileID,1,'正在下载');

for i:=1 to NeedThreadCount do
begin
DownloadThread[i-1]:=TIEDownloadThread.Create(True);
DownloadThread[i-1].ThreadIndex:=I;
DownloadThread[i-1].ThreadCount:=NeedThreadCount;
DownloadThread[i-1].FFilePosBegin:=GetFilePosBeginEndA(I,NeedThreadCount).BeginPos;
DownloadThread[i-1].FFilePosEnd:=GetFilePosBeginEndA(I,NeedThreadCount).EndPos;
DownloadThread[i-1].UrlFile:=UrlFile;
DownloadThread[i-1].UrlHost:=UrlHost;
DownloadThread[i-1].TryConnectCount:=5;
DownloadThread[i-1].FileStream:=FileStream;
DownloadThread[i-1].IniFile:=IniFile;
DownloadThread[i-1].FCriticalSection:=FCriticalSection;
DownloadThread[i-1].FileID:=FileID;
DownloadThread[i-1].Resume;
end;
end else
begin
{如果配置文件中线程数为0，那么自动分配线程，重新下载}
NeedBufCount:=FIleInfo.TotalLength div OneThreadDownLoadMinSize; //总共数据块
LeftBufSize:=FIleInfo.TotalLength mod OneThreadDownLoadMinSize; //剩下数据

if NeedBufCount>=ThreadCount then
NeedThreadCount:=ThreadCount
else
NeedThreadCount:=NeedBufCount;

if NeedThreadCount=0 then NeedThreadCount:=1;

IniFile.WriteString('File','Name',FileName);
IniFile.WriteString('File','URL',URL);
IniFile.WriteString('File','FileSize',IntToStr(FIleInfo.TotalLength));
IniFile.WriteInteger('File','ThreadCount',NeedThreadCount);
SetLength(FDownLoadThread,NeedThreadCount);
_ShowFileOtherInfo(FileID,1,'正在下载');

//创建线程
for i:=1 to NeedThreadCount do
begin
DownloadThread[i-1]:=TIEDownloadThread.Create(True);
DownloadThread[i-1].ThreadIndex:=I;
DownloadThread[i-1].ThreadCount:=NeedThreadCount;
DownloadThread[i-1].FFilePosBegin:=GetFilePosBeginEnd(I,NeedThreadCount).BeginPos;
DownloadThread[i-1].FFilePosEnd:=GetFilePosBeginEnd(I,NeedThreadCount).EndPos;
DownloadThread[i-1].UrlFile:=UrlFile;
DownloadThread[i-1].UrlHost:=UrlHost;
DownloadThread[i-1].TryConnectCount:=5;
DownloadThread[i-1].FileStream:=FileStream;
DownloadThread[i-1].IniFile:=IniFile;
DownloadThread[i-1].FCriticalSection:=FCriticalSection;
DownloadThread[i-1].FileID:=FileID;
DownloadThread[i-1].Resume;
//_ShowSystemInfo(inttostr(DownloadThread[i-1].FFilePosBegin)+'-'+IntToStr(DownloadThread[i-1].FFilePosEnd));
end;
end;
end;

procedure SaveFileToDownLoadIngFile;
var
FileList:TStrings;
FileInfoStr:String;
begin
FileList:=TStringList.Create;
try
if FileExists(DownLoadIngHistoryFile) then
FileList.LoadFromFile(DownLoadIngHistoryFile);

//正在下载文件历史信息格式是：
// 文件类型 文件保存路径 文件的URL 下载时间
FileInfoStr:=IntToStr(FileID)+
#9+FIleTYpe+
#9+FilePath+
#9+URL+
#9+FormatDateTime('YYYY-MM-DD HH:MM:SS',Now)+
#9+FormatDateTime('YYYY-MM-DD HH:MM:SS',Now)+
#9+FileName+
#9+IntToStr(FIleInfo.TotalLength)+
#9+IntToStr(NeedThreadCount)
+#9;

FileList.Add(FileInfoStr);
FIleList.SaveToFile(DownLoadIngHistoryFile);
finally
FreeAndNil(FileList);
end;
end;

procedure DeleteDownLoadInfFile(FileID:Integer);
var
FileList:TStrings;
I:Integer;
begin
FileList:=TStringList.Create;
try
if FileExists(DownLoadIngHistoryFile) then
FileList.LoadFromFile(DownLoadIngHistoryFile);

for I:=0 to FileList.Count-1 do
begin
if Copy(FileList.Strings,1,pos(#9,FileList.Strings)-1)=IntToStr(FileID) then
FileList.Delete(I);
end;

FIleList.SaveToFile(DownLoadIngHistoryFile);
finally
FreeAndNil(FileList);
end;
end;

procedure SaveFileToDownLoadFile;
var
FileList:TStrings;
FileInfoStr:String;
begin
FileList:=TStringList.Create;
try
if FileExists(DownLoadHistoryFile) then
FileList.LoadFromFile(DownLoadHistoryFile);

//下载完成文件历史信息格式是：
// 文件ID 文件类型 文件保存路径 文件的URL 下载时间
FileInfoStr:=IntToStr(FileID)+
#9+FIleTYpe+
#9+FilePath+
#9+URL+
#9+FormatDateTime('YYYY-MM-DD HH:MM:SS',Now)+
#9+FormatDateTime('YYYY-MM-DD HH:MM:SS',Now)+
#9+FileName+
#9+IntToStr(FIleInfo.TotalLength)+
#9+IntToStr(NeedThreadCount)
+#9;

FileList.Add(FileInfoStr);
FIleList.SaveToFile(DownLoadHistoryFile);
finally
FreeAndNil(FileList);
end;
end;

procedure DeleteDownLoadFileOnListView;
var
I:Integer;
begin
for I:=0 to OnDownFileList.Items.Count-1 do
begin
if OnDownFileList.Items.Caption=IntToStr(FileID) then
OnDownFileList.Items.Delete;
end;
end;

begin
try
InitializeCriticalSectionA;

URL:=FileUrl;

{得到文件真实的URL-如果有?那么就要请求得到真实的连接}
_ShowSystemInfo('开始解析连接....');

{添加初始信息到列表里}
AddFileToListView;

TrueUrlStr:=GetTrueUrl(URL);
if TrueUrlStr='' then
begin
_ShowSystemInfo('没有解析出文件，停止下载，退出线程');
_ShowFileOtherInfo(FileID,1,'不能下载');
Exit;
end;
_ShowSystemInfo('文件地址：'+TrueUrlStr);

{文件名称}
FileName:=GetFileName(TrueUrlStr);
_ShowSystemInfo('文件名称：'+FileName);
_ShowFileOtherInfo(FileID,0,FIleName);

{主机地址}
UrlFile:=GetUrlFile(TrueUrlStr);
UrlHost:=GetUrlHost(TrueUrlStr);
_ShowSystemInfo('主机地址：'+UrlHost);

{文件长度}
FIleInfo:=GetFileInfo(UrlFile,UrlHost);
_ShowSystemInfo('文件长度：'+IntToStr(FIleInfo.TotalLength));
_ShowFileOtherInfo(FileID,3,IntToStr(Round(FIleInfo.TotalLength/1000)));

if FileInfo.ISCanRec then
begin
_ShowSystemInfo('文件允许下载：'+FileName);
_ShowSystemInfo('下载范围：'+FIleInfo.RecRang);
end else
begin
_ShowSystemInfo('文件不允许下载：'+FileName);
_ShowFileOtherInfo(FileID,1,'不能下载');
Exit;
end;

{创建临时文件}
_CreateTempFile;
{创建下载线程}
_CreateDownLoadThread;

{保存信息到正在下载历史文件里}
SaveFileToDownLoadIngFile;

{监控过程}
AllHaveDownLoadLength:=0;
BeginTime:=CPUTimeCounterQPC;
while not Self.Terminated do
begin
Complete:=True;
CurrentLength:=0;

{判断文件是否已经完成。。。。}
for I:=0 to NeedThreadCount-1 do
begin
Complete:=Complete and DownloadThread.FComplete;
CurrentLength:=CurrentLength+(DownloadThread.FFilePosEnd-DownloadThread.FFilePosBegin);
//AllHaveDownLoadLength:=AllHaveDownLoadLength+DownloadThread.HaveDownLoadLength;
end;

EndTime:=CPUTimeCounterQPC;

_ShowFileProcess(FileID,FIleInfo.TotalLength,FIleInfo.TotalLength-CurrentLength);
//_ShowDownSpeed(FileID,Round(AllHaveDownLoadLength*1000/(EndTime-BeginTime)));

if Complete then
begin
_ShowFileOtherInfo(FileID,1,'下载完成');
Sleep(1000);

{关闭文件}
if Assigned(FFileStream) then
FreeAndNil(FFileStream);
if Assigned(FIniFile) then
FreeAndNil(FIniFile);

try
{删除配置文件}
DeleteFile(TempConfigFileName);
{修改文件名}
if FIleExists(FilePath+'/'+FileName) then
RenameFile(TempFileName,FilePath
+'/'
+Copy(FileName,1,pos('.',FIleName)-1)
+FormatDatetime('HHMMSS',Now)
+ExtractFileExt(FIleName)
)
else
RenameFile(TempFileName,FilePath+'/'+FileName);

{删除正在下载的信息，添加文件信息到已经下载完成的历史文件里}
DeleteDownLoadInfFile(FileID);
SaveFileToDownLoadFile;
{下载完毕，从Listview的正在下载里面，删除信息}
DeleteDownLoadFileOnListView;
except
end;
{退出线程}
Break;
end;
end;
except
end;
end;

procedure TIEDownload.Stop;
var
I:Integer;
begin
try
{释放下载线程}
for i:=0 to Length(FDownLoadThread)-1 do
begin
DownloadThread.Terminate;
FreeAndNil(DownloadThread);
end;
{结束临界区}
DeleteCriticalSectionA();
{释放SOCK}
FinalSocket;
{释放自己}
_ShowSystemInfo('结束下载'+FileUrl+'任务线程');
if Assigned(DownLoad[THreadIndex].FFileStream) then
FreeAndNil(DownLoad[THreadIndex].FFileStream);
if Assigned(DownLoad[THreadIndex].FIniFile) then
FreeAndNil(DownLoad[THreadIndex].FIniFile);
FreeAndNil(DownLoad[THreadIndex]);
except
end;
end;

procedure TIEDownload.Execute;
begin
inherited;
Start;
Stop;
end;

procedure TIEDownload.SetThreadCount(const Value: Dword);
begin
FThreadCount := Value;
end;

procedure TIEDownload.SetFileUrl(const Value: String);
begin
FFileUrl := Value;
end;

procedure TIEDownload.SetFilePath(const Value: String);
begin
FFilePath := Value;
end;

procedure TIEDownload.SetThreadIndex(const Value: Byte);
begin
FThreadIndex := Value;
end;

procedure TIEDownload.SetFileType(const Value: String);
begin
FFileType := Value;
end;

procedure TIEDownload.SetFileID(const Value: Integer);
begin
FFileID := Value;
end;


//------------------------------------------------------------------------------





















{-----------------得到空闲线程的编号-------------------------------------------}
function GetThreadIndex():Integer;
var
I:Integer;
begin
Result:=-1;
for I:=0 to MaxWorkCount-1 do
if Download=Nil then {如果线程没空，那么就选择这个}
begin
Result:=I;
Exit;
end;
end;

{-----------------创建下载线程-------------------------------------------------}
procedure CreateDownLoadThread(URL:String
;SavePath:String
;DownLoadThread:Integer
;FileID:String
;FileType:String);
var
ThreadIndex:Integer;

function GetFileID:String;
begin
Result:=FormatDateTime('DDHHMMSS',Now);
end;

begin
ThreadIndex:=GetThreadIndex;
if ThreadIndex=-1 then
begin
MessageBox(Application.Handle,'任务已满，请梢侯在下载','注意！',MB_OK);
Exit;
end;

_ShowSystemInfo('------------------------------------------------------------------------------');
_ShowSystemInfo('创建第'+IntToStr(ThreadIndex+1)+'个任务线程');
Download[ThreadIndex]:=TIEDownload.Create(True);
Download[ThreadIndex].FileUrl:=URL;
DownLoad[ThreadIndex].FilePath:=SavePath;
DownLoad[ThreadIndex].ThreadCount:=DownLoadThread;
Download[ThreadIndex].ThreadIndex:=ThreadIndex;

if FIleID='' then
Download[ThreadIndex].FileID:=StrToInt(GetFileID)
else
Download[ThreadIndex].FileID:=StrToInt(FileID);

Download[ThreadIndex].FileType:=FileType;
Download[ThreadIndex].Resume;
end;


end.

多线程有点问题，你改一下，单线程应该没有问题

多人接受答案了。