谢谢两位，问题已经解决，我手头没有HTTP SERVER，只有这个借用的FTP。
由于只是演示，在下载精度方面未作过多考虑，这方面还需要细化。代码如下：
unit MainUnit;
{design by sodme}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, StdCtrls, ScktComp;
type
Tbuf_char=array[0..4095] of char;
type
TDownThread = class(TThread)
private
FTempfile: file;
FHostName, FHostFile, FFileName: string;
FBlockSize, FSectionSize, FFileLength, FStartPos, FEndPos, FRevLen: integer;
DownClient : TClientSocket;
protected
procedure Execute;override;
function SocketRecLine(socket1: TCustomWinSocket;timeout1: integer; crlf1:string=#13#10): string;
public
constructor Create(StartPos, FileLength, SectionSize, BlockSize: integer; HostName, HostFile, SaveFile:string);
end;
type
TMainForm = class(TForm)
UrlEdit: TEdit;
SaveFileEdit: TEdit;
downbtn: TButton;
SpeedButton1: TSpeedButton;
closebtn: TBitBtn;
SaveFileDialog: TSaveDialog;
Edit1: TEdit;
Edit2: TEdit;
procedure SpeedButton1Click(Sender: TObject);
procedure closebtnClick(Sender: TObject);
procedure downbtnClick(Sender: TObject);
private
procedure InitDown;
procedure Down;
procedure EndDown;
function SocketRecLine(socket1:TCustomWinSocket;timeout1:integer;crlf1:string=#13#10):string;
{ Private declarations }
public
procedure ThreadDone(Sender : TObject);
function GetHostName(url: string): string;
function GetHostFile(url: string): string;
{ Public declarations }
end;
var
MainForm: TMainForm;
DownloadCS : TRTLCriticalSection;
TempFile : file;
hostname, hostfile, FileDate : string; //主机名，远程文件及文件日期
BlockSize, FileLength, SectionSize : integer; //每次请求的块大小，文件总长，线程长度
CanResume : Boolean;
savefile : string; //本地保存的文件名
WriteDoneFlags : integer; // 线程完成的数目
implementation
{$R *.dfm}
procedure TMainForm.SpeedButton1Click(Sender: TObject);
begin
if SaveFileDialog.Execute then
begin
SaveFileEdit.Text := SaveFileDialog.FileName;
end;
end;
procedure TMainForm.closebtnClick(Sender: TObject);
begin
close;
end;
procedure TMainForm.downbtnClick(Sender: TObject);
begin
InitDown;
Down;
// EndDown;
end;
procedure TMainForm.Down;
var
DownThrds : array[1..10] of TDownThread;
i ,test : integer;
TempSecSize, StartPos: integer;
begin
SectionSize := FileLength div 10;
BlockSize := 4096;
for i:=1 to 10 do
begin
startpos := SectionSize*(i-1);
DownThrds := TDownThread.create(StartPos, FileLength, SectionSize, BlockSize, HostName, HostFile, SaveFile);
sleep(10);
end;
//
end;
procedure TMainForm.EndDown;
begin
//
end;
procedure TMainForm.InitDown;
var
TempClient : TClientSocket;
TempURL : string; //用于向HTTP服务器发请求信息的临时变量
TempRecvStr : string; //用于存放发送请求返回的信息
begin
InitializeCriticalSection(DownloadCS);
hostfile := gethostfile(UrlEdit.Text); //获得远程主机文件名
hostname := gethostname(UrlEdit.Text); //获得远程主机名
savefile := SaveFileEdit.text; //取本地保存的文件名
{
assignfile(tempfile,savefile); //文件初始化
if FileExists(savefile) then
reset(tempfile,1)
else
rewrite(tempfile,1); }
TempClient := TClientSocket.Create(application); //创建一临时client，以获得
//以获得文件的一些必要信息
tempclient.Socket.ClientType := ctBlocking;
tempclient.Active := false;
tempclient.Host := hostname;
tempclient.Port := 80;
//11111111---------以下是实现head请求，求出文件总长----------111111111//
tempurl := '';
//此处是给出head请求关键字，http服务器会自动侦听
tempurl := tempurl+'HEAD /'+hostfile+' HTTP/1.1'+#13#10;
tempurl := tempurl+'Pragma: no-cache'+#13#10;
tempurl := tempurl+'Cache-Control: no-cache'+#13#10;
tempurl := tempurl+'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)'+#13#10;
tempurl := tempurl+'Host: '+hostname+#13#10;
tempurl := tempurl+#13#10;
tempclient.Active := true;
tempclient.Socket.SendText(tempurl);
//逐行取出服务器的反馈信息，服务器反馈信息的结束是以独行内容为：#13#10结束的
while tempclient.Active = true do
begin
TempRecvStr := SocketRecLine(tempclient.Socket,60*1000);
if TempRecvStr=#13#10 then break;
if pos(lowercase('Last-Modified: '),lowercase(TempRecvStr))=1 then
FileDate := trim(copy(TempRecvStr,length('Last-Modified: ')+1,length(TempRecvStr)));
if pos(lowercase('Accept-Ranges: '),lowercase(TempRecvStr))=1 then
CanResume := true;
if pos(lowercase('Content-Length: '),lowercase(TempRecvStr))=1 then
FileLength:=strtoint(trim(copy(TempRecvStr,length('Content-Length: ')+1,length(TempRecvStr))));
end;
tempclient.Free;
end;
procedure TMainForm.ThreadDone(Sender : TObject);
var
i : integer;
begin
inc(WriteDoneFlags);
edit2.Text := inttostr(WriteDoneFlags);
if WriteDoneFlags = 10 then
begin
closefile(tempfile);
DeleteCriticalSection(DownloadCS);
end;
end;
function TMainForm.GetHostFile(url: string): string;
//从URL中提取文件名
var
in1 : string;
begin
in1:=trim(url);
if pos('http://',lowercase(in1))=1 then
begin
in1:=copy(in1,length('http://')+1,length(in1));
end;
if pos('/',in1)<>0 then
begin
in1:=copy(in1,pos('/',in1)+1,length(in1));
end;
result:=in1;
end;
function TMainForm.GetHostName(url: string): string;
//从URL中提取主机名
var
in1 : string;
begin
in1:=trim(url);
if pos('http://',lowercase(in1))=1 then
begin
in1:=copy(in1,length('http://')+1,length(in1));
end;
if pos('/',in1)<>0 then
begin
in1:=copy(in1,0,pos('/',in1)-1);
end;
result:=in1;
end;
function TMainForm.SocketRecLine(socket1: TCustomWinSocket;
timeout1: integer; crlf1:string=#13#10): string;
var
buf1:Tbuf_char;
r1:integer;
ts1:TStringStream; //保存所有的数据
FSocketStream: TWinSocketStream;
begin
ts1:=TStringStream.Create('');
FSocketStream:= TWinSocketStream.create(Socket1, timeout1);
while (socket1.Connected=true) do
begin
if not FSocketStream.WaitForData(timeout1) then break;
zeromemory(@buf1,sizeof(buf1));
r1 := FsocketStream.Read(buf1, 1);
if r1=0 then break; //test
ts1.Write(buf1,r1);
if pos(crlf1,ts1.DataString)<>0 then
begin
break;
end;
end;
result:=ts1.DataString;
if pos(crlf1,result)=0 then
begin
result:='';
end;
ts1.Free;
FSocketStream.Free;
end;
{ TDownThread }
constructor TDownThread.Create(StartPos, FileLength, SectionSize, BlockSize: integer; HostName, HostFile, SaveFile:string);
begin
inherited Create(false);
FStartPos := StartPos;
FEndPos := StartPos; //初始化本线程通用变量
FFileLength := FileLength;
FSectionSize := SectionSize;
FBlockSize := BlockSize;
FHostName := HostName;
FHostFile := HostFile;
FFileName := SaveFile;
FRevLen :=0;
DownClient := TClientSocket.Create(application); //初始化下载socket
DownClient.Socket.ClientType := ctBlocking;
DownClient.Active := false;
DownClient.Host := HostName;
DownClient.Port := 80;
FreeOnTerminate := true;
OnTerminate := mainform.ThreadDone;
EnterCriticalSection(DownloadCS); //对读写文件进行临界区保护
assignfile(FTempFile,FFilename);
if FileExists(FFileName) then
begin
reset(FTempFile,1);
end
else
begin
rewrite(FTempFile,1);
end;
LeaveCriticalSection(DownloadCS);
end;
procedure TDownThread.Execute;
var
ReqUrl, TempRcvStr: string;
RealRecLen, CanReceiveLen, TempReceiveLength: integer;
CanReceive : Boolean;
buf1 : Tbuf_char;
i : integer;
begin
repeat
ReqUrl := '';
ReqUrl := ReqUrl+'GET /'+FHostFile+' HTTP/1.1'+#13#10;
ReqUrl := ReqUrl+'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*'+#13#10;
ReqUrl := ReqUrl+'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)'+#13#10;
ReqUrl := ReqUrl+'RANGE: bytes='+inttostr(FEndPos)+'-'+inttostr(FEndPos+FBlockSize)+#13#10;
ReqUrl := ReqUrl+'Host: '+FHostName+#13#10;
ReqUrl := ReqUrl+#13#10;
DownClient.Active := true;
DownClient.Socket.SendText(ReqUrl);
while DownClient.Active=true do
begin
TempRcvStr := SocketRecLine(DownClient.Socket,60*1000);
if TempRcvStr=#13#10 then break;
if pos(lowercase('Content-Range:'),lowercase(TempRcvStr))=1 then //是否可接收
begin
CanReceive:=true;
end;
if pos(lowercase('Content-Length: '),lowercase(TempRcvStr))=1 then //计算要接收的长度
begin
CanReceiveLen:=strtoint(trim(copy(TempRcvStr,length('Content-Length: ')+1,length(TempRcvStr))));
end;
end;
RealRecLen:=0;
while DownClient.Active=true do
begin
if CanReceive=false then break; //不能接收则退出
if filesize(FTempFile)>=FFileLength then //如果文件当前的长度大于服务器标识的长度,则是出错了，不要写入文件中
begin
showmessage('文件已经下载完毕了！');
break;
end;
zeromemory(@buf1,sizeof(buf1));
TempReceiveLength := DownClient.Socket.ReceiveBuf(buf1,sizeof(buf1));
//如果实际收到的长度大于服务器标识的长度,则是出错了，不要写入文件中
if RealRecLen>=CanReceiveLen then
begin
showmessage('文件已经下载完毕了！');
break;
end;
if FEndPos=CanReceiveLen then //如果当前的长度大于服务器标识的长度,则是出错了，不要写入文件中
begin
showmessage('文件已经下载完毕了！');
break;
end;
EnterCriticalSection(DownloadCS); //用临界区同时读写
seek(FTempFile,FEndPos);
//FillChar(buf1,sizeof(buf1),'f');
//blockwrite(FTempFile,buf1,sizeof(buf1));
blockwrite(FTempFile,buf1,TempReceiveLength);
LeaveCriticalSection(DownloadCS);
//FEndPos := FEndPos+4096;
FEndPos := FEndPos+TempReceiveLength;
application.ProcessMessages;
end;
until (FEndPos > FStartPos+FSectionSize);
inherited;
end;
function TDownThread.SocketRecLine(socket1: TCustomWinSocket;
timeout1: integer; crlf1:string=#13#10): string;
var
buf1:Tbuf_char;
r1:integer;
ts1:TStringStream; //保存所有的数据
FSocketStream: TWinSocketStream;
begin
ts1:=TStringStream.Create('');
FSocketStream:= TWinSocketStream.create(Socket1, timeout1);
while (socket1.Connected=true) do
begin
if not FSocketStream.WaitForData(timeout1) then break;
zeromemory(@buf1,sizeof(buf1));
r1 := FsocketStream.Read(buf1, 1);
if r1=0 then break; //test
ts1.Write(buf1,r1);
if pos(crlf1,ts1.DataString)<>0 then
begin
break;
end;
end;
result:=ts1.DataString;
if pos(crlf1,result)=0 then
begin
result:='';
end;
ts1.Free;
FSocketStream.Free;
end;
end.
