unit IEDownload;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,ScktComp;
type
Tbufchar=array[0..4095] of char;
Tbufbyte=array[0..4095] of byte;
type
TFileData=Record
FileName:String;
FileBeginPos:Integer;
end;
type
TIEDownloadThread=Class(TThread)
private
FClientSocket:TClientSocket;
FRecLength:Integer;
FRelRecLength:Integer;
FTotalLength:Integer;
FPos:Integer;
FBufByte:Tbufbyte;
FBufChar:Tbufchar;
FUrlHost:String;
FUrlFile:String;
FFileName:String;
FUrl:String;
FCanReceive:Bool;
DownLoadFile:file;
FThreadIndex:Integer;
FThreadCount:Integer;
FFilePosBegin:Integer;
FFilePosEnd:Integer;
procedure SetRecLength(const Value: Integer);
procedure SetRelRecLength(const Value: Integer);
procedure SetPos(const Value: Integer);
procedure SetUrlFile(const Value: String);
procedure SetUrlHost(const Value: String);
procedure SetCanReceive(const Value: Bool);
procedure SetTotalLength(const Value: Integer);
procedure SetFileName(const Value: String);
procedure SetThreadIndex(const Value: Integer);
procedure SetFilePosBegin(const Value: Integer);
procedure SetFilePosEnd(const Value: Integer);
procedure SetThreadCount(const Value: Integer);
procedure GetFilePos();
procedure GetRecLength();
procedure GetFilePosBeginEnd();
procedure SetUrl(const Value: String);
function BeforeDownLoad():Bool;
Procedure BeginDownLoad(FilePosBegin, FilePosEnd: Integer);
Procedure AfterDownLoad();
procedure Execute(); override;
procedure DisPlayMessage(MessageStr:String);
function InitSocket():Boolean;
function FinalSocket():Boolean;
constructor Create(ThreadIndex,ThreadCount:integer);
protected
FileData:TFileData;
public
property TotalLength:Integer read FTotalLength write SetTotalLength;
property RecLength:Integer read FRecLength write SetRecLength;
property RelRecLength:Integer read FRelRecLength write SetRelRecLength;
property FilePos:Integer read FPos write SetPos;
property UrlFile:String read FUrlFile write SetUrlFile;
property UrlHost:String read FUrlHost write SetUrlHost;
property ClientSocket:TClientSocket read FClientSocket write FClientSocket;
property CanReceive:Bool read FCanReceive write SetCanReceive;
property FileName:String read FFileName write SetFileName;
property Url:String read FUrl write SetUrl;
property ThreadIndex:Integer read FThreadIndex write SetThreadIndex;
property ThreadCount:Integer read FThreadCount write SetThreadCount;
property FilePosBegin:Integer read FFilePosBegin write SetFilePosBegin;
property FilePosEnd:Integer read FFilePosEnd write SetFilePosEnd;
end;
type
TIEDownload=Class
private
FClientSocket:TClientSocket;
FUrlHost:String;
FUrlFile:String;
FFileName:String;
FTotalLength:Integer;
FBufByte:Tbufbyte;
FBufChar:Tbufchar;
procedure SetFileName(const Value: String);
procedure SetTotalLength(const Value: Integer);
procedure SetUrlFile(const Value: String);
procedure SetUrlHost(const Value: String);
procedure GetUrlHost(Url:String);
procedure GetUrlFile(Url:String);
procedure GetFileName(Url:String);
procedure GetTotalLength();
procedure DisPlayMessage(MessageStr:String);
function InitSocket():Boolean;
function FinalSocket():Boolean;
protected
public
property UrlFile:String read FUrlFile write SetUrlFile;
property UrlHost:String read FUrlHost write SetUrlHost;
property FileName:String read FFileName write SetFileName;
property TotalLength:Integer read FTotalLength write SetTotalLength;
property ClientSocket:TClientSocket read FClientSocket write FClientSocket;
procedure Start(URL:String);
procedure Stop;
procedure CreateFile;
end;
var
Download:TIEDownload;
DownloadThread:Array[1..5] of TIEDownloadThread;
implementation
uses
U_DOWNLOAD;
{ TIEDownloadThread }
////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////IE多线程下载///////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
//----------------------------------------------------------------------系统结束
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;
//----------------------------------------------------------------取得文件的位置
procedure TIEDownloadThread.GetFilePos;
begin
AssignFile(DownLoadFile,'C:/DOWNLOAD/'+IntToStr(ThreadIndex)+'-'+FileName);
if FileExists('C:/DOWNLOAD/'+IntToStr(ThreadIndex)+'-'+FileName)=True then
begin
Reset(DownLoadFile,1);
FilePos:=FileSize(DownLoadFile);
end else
begin
rewrite(DownLoadFile,1);
FilePos:=0;
end;
Seek(DownLoadFile,FilePos);
DisPlayMessage('线程编号:'+inttostr(ThreadIndex)+'文件开始位置:'+inttostr(FilePos));
end;
//--------------------------------------------------------取得文件应该下载的大小
procedure TIEDownloadThread.GetRecLength;
var
UrlStr:String;
RecLengthOnce:Integer;
FStringStream:TStringStream;
FSocketStream: TWinSocketStream;
begin
if InitSocket then
begin
If Not Assigned(ClientSocket) Then
begin
Exit;
end;
CanReceive:=False;
RecLength:=0;
ClientSocket.Active:=False;
ClientSocket.Host:=UrlHost;
ClientSocket.Port:=80;
ClientSocket.Active:=True;
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);
RelRecLength:=0;
FStringStream:=TStringStream.Create('');
FSocketStream:=TWinSocketStream.create(ClientSocket.Socket, 60*1000);
//------------------------------------------取得是否可以下载和要接受的文件的大小
While ClientSocket.Active Do
begin
ZeroMemory(@FBufChar,SizeOf(FBufChar));
RecLengthOnce:=FsocketStream.Read(FBufChar, 1);
if RecLengthOnce=0 then Break;
FStringStream.Write(FBufChar,RecLengthOnce);
if Pos(#13#10,FStringStream.DataString)<>0 then
begin
if Pos('Content-Length:',FStringStream.DataString)>0 then
begin
RecLength:=StrToInt(Trim(Copy(FStringStream.DataString,Pos(':',FStringStream.DataString)+1,Pos(#13#10,FStringStream.DataString)-Pos(':',FStringStream.DataString)+1)));
end;
if Pos('Content-Range:',FStringStream.DataString)>0 then
begin
CanReceive:=True;
end;
if FStringStream.DataString=#13#10 then
begin
FSocketStream.Free;
FStringStream.Free;
Break;
end;
FStringStream.Free;
FStringStream:=TStringStream.Create('');
end;
end;
end;
end;
//--------------------------------------------------得到文件下载的开始和结束位置
procedure TIEDownloadThread.GetFilePosBeginEnd;
var
BufCount:Integer;
BufLeft:Integer;
ThreadBufCount:Integer;
ThreadBufCountLeft:Integer;
I:Integer;
begin
FilePosBegin:=0;
FilePosEnd:=0;
BufCount:=TotalLength Div Length(FBufByte);
BufLeft:=TotalLength Mod Length(FBufByte);
if BufCount>=5 then//------------------------------------------------数据块>=5
begin
ThreadBufCount:=BufCount Div 5;
ThreadBufCountLeft:=BufCount Mod 5;
if ThreadBufCountLeft=0 then
begin
if ThreadIndex=5 then
begin
FilePosBegin:=FilePos+(ThreadIndex-1)*ThreadBufCount*Length(FBufByte);
FilePosEnd:=ThreadIndex*ThreadBufCount*Length(FBufByte)+BufLeft-1;
end else
begin
FilePosBegin:=FilePos+(ThreadIndex-1)*ThreadBufCount*Length(FBufByte);
FilePosEnd:=ThreadIndex*ThreadBufCount*Length(FBufByte)-1;
end;
end else
begin
for i:=1 to ThreadBufCountLeft do
begin
if ThreadIndex=I then
begin
FilePosBegin:=FilePos+(ThreadIndex-1)*(ThreadBufCount+1)*Length(FBufByte);
FilePosEnd:=ThreadIndex*(ThreadBufCount+1)*Length(FBufByte)-1;
end;
end;
for I:=ThreadBufCountLeft+1 to 5 do
begin
if ThreadIndex=I then
begin
if ThreadIndex=5 then
begin
FilePosBegin:=FilePos+
ThreadBufCountLeft*Length(FBufByte)+
(ThreadIndex-1)*ThreadBufCount*Length(FBufByte);
FilePosEnd:=ThreadBufCountLeft*Length(FBufByte)+
ThreadIndex*ThreadBufCount*Length(FBufByte)+
BufLeft-1;
end else
begin
FilePosBegin:=FilePos+
ThreadBufCountLeft*Length(FBufByte)+
(ThreadIndex-1)*ThreadBufCount*Length(FBufByte);
FilePosEnd:=ThreadBufCountLeft*Length(FBufByte)+
ThreadIndex*ThreadBufCount*Length(FBufByte)-1;
end;
end;
end;
end;
end else//------------------------------------------------------------数据块<5
begin
if BufCount=0 then
begin
if ThreadIndex=1 then
begin
FilePosBegin:=FilePos;
FilePosEnd:=BufLeft-1;
end;
end;
for i:=1 to BufCount do
begin
if ThreadIndex=I then
begin
if ThreadIndex=BufCount then
begin
FilePosBegin:=FilePos+(I-1)*Length(FBufByte);
FilePosEnd:=I*Length(FBufByte)+BufLeft-1;
end else
begin
FilePosBegin:=FilePos+(I-1)*Length(FBufByte);
FilePosEnd:=I*Length(FBufByte)-1;
end;
end;
end;
end;
DisPlayMessage('线程编号:'+inttostr(threadindex)
+'文件开始位置:'+inttostr(FilePosBegin)
+'文件结束位置:'+inttostr(FilePosEnd)
+' '+inttostr(ThreadBufCount)
+' '+inttostr(ThreadBufCountLeft));
end;
constructor TIEDownloadThread.Create(ThreadIndex,ThreadCount:integer);
begin
FThreadIndex:=ThreadIndex;
FThreadCount:=ThreadCount;
Inherited Create(true);
end;
procedure TIEDownloadThread.Execute;
begin
inherited;
if Not BeforeDownLoad then Exit;
if FilePosBegin>=FilePosEnd then
begin
DisPlayMessage('文件下载完毕');
Exit;
end;
BeginDownLoad(FilePosBegin,FilePosEnd);
AfterDownLoad;
end;
function TIEDownloadThread.BeforeDownLoad():Bool;
begin
Result:=False;
if InitSocket then
begin
If Not Assigned(ClientSocket) Then
begin
Exit;
end;
DownLoadFrm.pb.Max:=TotalLength;
GetFilePos;
GetFilePosBeginEnd;
DownLoadFrm.pb.Position:=DownLoadFrm.pb.Position+FilePos;
GetRecLength;
if RecLength=0 then
begin
DisPlayMessage('文件下载完毕');
Exit;
end;
if FilePos=RecLength then
begin
DisPlayMessage('文件下载完毕');
Exit;
end;
if FileSize(DownLoadFile)>=RecLength then
begin
DisPlayMessage('文件下载完毕');
Exit;
end;
if CanReceive=false then
begin
DisPlayMessage('文件下载完毕');
Exit;
end;
Filedata.FileName:=IntToStr(ThreadIndex)+'-'+FileName;
Filedata.FileBeginPos:=FilePosBegin;
end;
Result:=True;
end;
//------------------------------------------------------------------开始下载文件
procedure TIEDownloadThread.BeginDownLoad(FilePosBegin, FilePosEnd: Integer);
var
UrlStr:String;
RecLengthOnce:Integer;
FStringStream:TStringStream;
FSocketStream:TWinSocketStream;
begin
if InitSocket then
begin
If Not Assigned(ClientSocket) Then
begin
Exit;
end;
ClientSocket.Active:=False;
ClientSocket.Host:=UrlHost;
ClientSocket.Port:=80;
ClientSocket.Active:=True;
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);
//--------------------------------------------------------------------去掉头文件
While ClientSocket.Active Do
begin
ZeroMemory(@FBufChar,SizeOf(FBufChar));
RecLengthOnce:=FsocketStream.Read(FBufChar, 1);
if RecLengthOnce=0 then Break;
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;
//----------------------------------------------------------------------下载正文
While ClientSocket.Active Do
begin
if FileSize(DownLoadFile)>=RecLength then Break;
ZeroMemory(@FBufByte,sizeof(FBufByte));
RecLengthOnce:=ClientSocket.Socket.ReceiveBuf(FBufByte,sizeof(FBufByte));
DownLoadFrm.pb.Position:=DownLoadFrm.pb.Position+RecLengthOnce;
BlockWrite(DownLoadFile,FBufByte,RecLengthOnce);
application.ProcessMessages;
end;
DisPlayMessage('文件下载完毕');
ClientSocket.Active:=false;
Closefile(DownLoadFile);
end;
end;
procedure TIEDownloadThread.AfterDownLoad;
begin
end;
procedure TIEDownloadThread.DisPlayMessage(MessageStr: String);
begin
//Form1.Memo1.Lines.Add(MessageStr);
end;
procedure TIEDownloadThread.SetUrlFile(const Value: String);
begin
FUrlFile := Value;
end;
procedure TIEDownloadThread.SetUrlHost(const Value: String);
begin
FUrlHost := Value;
end;
procedure TIEDownloadThread.SetPos(const Value: Integer);
begin
FPos := Value;
end;
procedure TIEDownloadThread.SetRecLength(const Value: Integer);
begin
FRecLength := Value;
end;
procedure TIEDownloadThread.SetRelRecLength(const Value: Integer);
begin
FRelRecLength := Value;
end;
procedure TIEDownloadThread.SetCanReceive(const Value: Bool);
begin
FCanReceive := Value;
end;
procedure TIEDownloadThread.SetTotalLength(const Value: Integer);
begin
FTotalLength := Value;
end;
procedure TIEDownloadThread.SetFileName(const Value: String);
begin
FFileName := Value;
end;
procedure TIEDownloadThread.SetUrl(const Value: String);
begin
FUrl := Value;
end;
procedure TIEDownloadThread.SetThreadIndex(const Value: Integer);
begin
FThreadIndex := Value;
end;
procedure TIEDownloadThread.SetFilePosBegin(const Value: Integer);
begin
FFilePosBegin := Value;
end;
procedure TIEDownloadThread.SetFilePosEnd(const Value: Integer);
begin
FFilePosEnd := Value;
end;
procedure TIEDownloadThread.SetThreadCount(const Value: Integer);
begin
FThreadCount := 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
FClientSocket.Free;
Result:=True;
except
end;
end;
//-----------------------------------------------------------------取得URL文件名
procedure TIEDownload.GetUrlFile(Url: 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;
UrlFile:=UrlStr;
end;
//-----------------------------------------------------------------取得URL文件名
Procedure TIEDownload.GetFileName(Url: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;
FileName:=UrlStr;
end;
//-------------------------------------------------------------------取得URL地址
procedure TIEDownload.GetUrlHost(Url: 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;
UrlHost:=UrlStr;
end;
//----------------------------------------------------------------取得文件总长度
procedure TIEDownload.GetTotalLength;
var
UrlStr:String;
UrlHead:String;
RecLengthOnce:Integer;
begin
if InitSocket then
begin
If Not Assigned(ClientSocket) Then
begin
TotalLength:=0;
Exit;
end;
ClientSocket.Active:=False;
ClientSocket.Host:=UrlHost;
ClientSocket.Port:=80;
ClientSocket.Active:=True;
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));
RecLengthOnce:=ClientSocket.Socket.ReceiveBuf(FBufByte,sizeof(FBufByte));
UrlHead:='';
UrlHead:=strpas(@FBufByte);
application.ProcessMessages;
ClientSocket.Active:=false;
if Pos('Content-Length:',UrlHead)>0 then
begin
UrlHead:=Copy(UrlHead,Pos('Content-Length:',UrlHead),Length(UrlHead)-Pos('Content-Length:',UrlHead)+1);
TotalLength:=StrToInt(Trim(Copy(UrlHead,Pos(':',UrlHead)+1,Pos(#13#10,UrlHead)-Pos(':',UrlHead)+1)));
end else
begin
TotalLength:=0;
end;
end;
displaymessage('文件总长度:'+inttostr(TotalLength));
end;
procedure TIEDownload.Start(URL: String);
var
I:Integer;
begin
try
GetUrlFile(Url);
GetUrlHost(Url);
GetFileName(Url);
GetTotalLength;
for i:=1 to 5 do
begin
DownloadThread:=TIEDownloadThread.Create(i,5);
DownloadThread.UrlFile:=UrlFile;
DownloadThread.UrlHost:=UrlHost;
DownloadThread.FileName:=FileName;
DownloadThread.TotalLength:=TotalLength;
DownloadThread.Resume;
end;
except
end;
end;
procedure TIEDownload.Stop;
var
I:Integer;
begin
try
for i:=1 to 5 do
begin
DownloadThread.Suspend;
end;
except
end;
end;
procedure TIEDownload.CreateFile;
var
I:Integer;
f1,f2:file;
str:Tstringlist;
str1:Tstringlist;
filename:string;
begin
str:=tstringlist.Create;
str1:=tstringlist.Create;
str1.Text:='';
for i:=1 to 5 do
begin
filename:='C:/download/'+inttostr(i)+'-'+'20050815-008-i32.exe';
str.LoadFromFile(filename);
str1.AddStrings(str);
end;
str1.SaveToFile('c:/download/1.exe');
end;
procedure TIEDownload.DisPlayMessage(MessageStr: String);
begin
//Form1.Memo1.Lines.Add(MessageStr);
end;
procedure TIEDownload.SetFileName(const Value: String);
begin
FFileName := Value;
end;
procedure TIEDownload.SetTotalLength(const Value: Integer);
begin
FTotalLength := Value;
end;
procedure TIEDownload.SetUrlFile(const Value: String);
begin
FUrlFile := Value;
end;
procedure TIEDownload.SetUrlHost(const Value: String);
begin
FUrlHost := Value;
end;
end.
