该如何得到要下载的文件的大小和下载的进度啊?(50分)

  • 主题发起人 主题发起人 wtzwtz
  • 开始时间 开始时间
W

wtzwtz

Unregistered / Unconfirmed
GUEST, unregistred user!
请问用如下函数下载网络文件时,该如何得到要下载的文件的大小和下载的进度啊?
function DownloadFile(Source, Dest: string): Boolean;
begin
try
Result := UrlDownloadToFile(nil, PChar(source), PChar(Dest), 0, nil) = 0;
except
Result := False;
end;
 
UrlDownloadToFile是哪里的函数啊

Delphi网络通信协议分析与应用实现/chap4/HTTPGET
http://www.delphifans.com/SoftView/SoftView_130.html
 
第一个参数传一个接口你就知道了。我倒是写了个控件,我去找找。
 
{
UrlDownloader 1.0
Url下载控件,可显示进度
作者:zqw0117
邮箱:zqw0117@sina.com
请保留头文件说明,谢谢
}
unit UrlDownloader;

interface

uses Windows, SysUtils, Classes, UrlMon, ActiveX;

type

TURLDownloadStatus = (dsFindingResource, dsConnecting, dsRedirecting,
dsBeginDownloadData, dsDownloadingData, dsEndDownloadData,
dsBeginDownloadComponents, dsInstallingComponents,
dsEndDownloadComponents, dsUsingCachedCopy, dsSendingRequest,
dsClassIDAvailable, dsMIMETypeAvailable, dsCacheFileNameAvailable,
dsBeginSyncOperation, dsEndSyncOperation, dsBeginUploadData,
dsUploadingData, dsEndUploadData, dsProtocolClassID, dsEncoding,
dsVerifiedMIMETypeAvailable, dsClassInstallLocation, dsDecoding,
dsLoadingMIMEHandler, dsContentDispositionAttach, dsFilterReportMIMEType,
dsCLSIDCanInstantiate, dsIUnKnownAvailable, dsDirectBind, dsRawMIMEType,
dsProxyDetecting, dsAcceptRanges, dsCookieSent, dsCompactPolicyReceived,
dsCookieSuppressed, dsCookieStateUnknown, dsCookieStateAccept,
dsCookeStateReject, dsCookieStatePrompt, dsCookieStateLeash,
dsCookieStateDowngrade, dsPolicyHREF, dsP3PHeader, dsSessionCookieReceived,
dsPersistentCookieReceived, dsSessionCookiesAllowed);

TCustomDownloader = class;

TDownloadProgressEvent = procedure(Sender: TCustomDownloader; Progress,
ProgressMax: Cardinal; StatusCode: TURLDownloadStatus; StatusText: string;
var Cancel: Boolean) of object;

TCustomDownloader = class(TComponent, IBindStatusCallback)
private
FUrl: string;
FFileName: string;
FOnDownloadProcess: TDownloadProgressEvent;
FOnBeforeDownload: TNotifyEvent;
FOnAfterDownload: TNotifyEvent;
procedure SetUrl(const AValue: string);
procedure SetFileName(const AValue: string);
protected
{ IBindStatusCallback }
function GetBindInfo(out grfBINDF: Cardinal;
var bindinfo: _tagBINDINFO): HRESULT; stdcall;
function GetPriority(out nPriority): HRESULT; stdcall;
function OnDataAvailable(grfBSCF: Cardinal; dwSize: Cardinal;
formatetc: PFormatEtc; stgmed: PStgMedium): HRESULT; stdcall;
function OnLowResource(reserved: Cardinal): HRESULT; stdcall;
function OnObjectAvailable(const iid: TGUID; punk: IUnknown): HRESULT; stdcall;
function OnProgress(ulProgress: Cardinal; ulProgressMax: Cardinal;
ulStatusCode: Cardinal; szStatusText: PWideChar): HRESULT; stdcall;
function OnStartBinding(dwReserved: Cardinal; pib: IBinding): HRESULT; stdcall;
function OnStopBinding(hresult: HRESULT; szError: PWideChar): HRESULT; stdcall;

{ Self methods }
procedure DoBeforeDownload; dynamic;
procedure DoAfterDownload; dynamic;
public
destructor Destroy; override;
procedure Download; virtual;
published
property URL: string read FUrl write SetUrl;
property FileName: string read FFileName write SetFileName;
property OnDownloadProcess: TDownloadProgressEvent read FOnDownloadProcess
write FOnDownloadProcess;
property OnBeforeDownload: TNotifyEvent read FOnBeforeDownload
write FOnBeforeDownload;
property OnAfterDownload: TNotifyEvent read FOnAfterDownload
write FOnAfterDownload;
end;

implementation

const
UrlMonLib = 'URLMON.DLL'; { do not localize }
SURLMonDownloadToFileA = 'URLDownloadToFileA'; { do not localize }
resourcestring
SInvalidEnumValue = 'Invalid Enum Value';
SErrorDownloadingURL = 'Error downloading URL: %s';
SUrlMonDllMissing = 'Unable to load %s';
SUrlMissing = 'Url is empty';
SFileNameMissing = 'File name is empty';

type
TUrlMonDownloadToFile = function(Caller: IUnknown; URL: PAnsiChar; FileName: PAnsiChar;
Reserved: DWORD; StatusCB: IBindStatusCallback): HResult; stdcall;
const
// Maps to the status codes for IBindStatusCallBack
BindStatusCode: array[0..54] of DWORD =
(BINDSTATUS_FINDINGRESOURCE,
BINDSTATUS_CONNECTING,
BINDSTATUS_REDIRECTING,
BINDSTATUS_BEGINDOWNLOADDATA,
BINDSTATUS_DOWNLOADINGDATA,
BINDSTATUS_ENDDOWNLOADDATA,
BINDSTATUS_BEGINDOWNLOADCOMPONENTS,
BINDSTATUS_INSTALLINGCOMPONENTS,
BINDSTATUS_ENDDOWNLOADCOMPONENTS,
BINDSTATUS_USINGCACHEDCOPY,
BINDSTATUS_SENDINGREQUEST,
BINDSTATUS_CLASSIDAVAILABLE,
BINDSTATUS_MIMETYPEAVAILABLE,
BINDSTATUS_CACHEFILENAMEAVAILABLE,
BINDSTATUS_BEGINSYNCOPERATION,
BINDSTATUS_ENDSYNCOPERATION,
BINDSTATUS_BEGINUPLOADDATA,
BINDSTATUS_UPLOADINGDATA,
BINDSTATUS_ENDUPLOADDATA,
BINDSTATUS_PROTOCOLCLASSID,
BINDSTATUS_ENCODING,
BINDSTATUS_VERIFIEDMIMETYPEAVAILABLE,
BINDSTATUS_CLASSINSTALLLOCATION,
BINDSTATUS_DECODING,
BINDSTATUS_LOADINGMIMEHANDLER,
BINDSTATUS_CONTENTDISPOSITIONATTACH,
BINDSTATUS_FILTERREPORTMIMETYPE,
BINDSTATUS_CLSIDCANINSTANTIATE,
BINDSTATUS_IUNKNOWNAVAILABLE,
BINDSTATUS_DIRECTBIND,
BINDSTATUS_RAWMIMETYPE,
BINDSTATUS_PROXYDETECTING,
BINDSTATUS_ACCEPTRANGES,
BINDSTATUS_CONTENTDISPOSITIONATTACH,
BINDSTATUS_FILTERREPORTMIMETYPE,
BINDSTATUS_CLSIDCANINSTANTIATE,
BINDSTATUS_IUNKNOWNAVAILABLE,
BINDSTATUS_DIRECTBIND,
BINDSTATUS_RAWMIMETYPE,
BINDSTATUS_PROXYDETECTING,
BINDSTATUS_ACCEPTRANGES,
BINDSTATUS_COOKIE_SENT,
BINDSTATUS_COMPACT_POLICY_RECEIVED,
BINDSTATUS_COOKIE_SUPPRESSED,
BINDSTATUS_COOKIE_STATE_UNKNOWN,
BINDSTATUS_COOKIE_STATE_ACCEPT,
BINDSTATUS_COOKIE_STATE_REJECT,
BINDSTATUS_COOKIE_STATE_PROMPT,
BINDSTATUS_COOKIE_STATE_LEASH,
BINDSTATUS_COOKIE_STATE_DOWNGRADE,
BINDSTATUS_POLICY_HREF,
BINDSTATUS_P3P_HEADER,
BINDSTATUS_SESSION_COOKIE_RECEIVED,
BINDSTATUS_PERSISTENT_COOKIE_RECEIVED,
BINDSTATUS_SESSION_COOKIES_ALLOWED
);

var
UrlMonHandle: HMODULE;
UrlMonDownloadToFile: TUrlMonDownloadToFile;
UrlMonInitialized: Boolean;

function DWordEnumToPascalEnumOrd(EnumArray: array of DWORD; Value: DWORD): Integer;
begin
for Result := Low(EnumArray) to High(EnumArray) do
if Value = EnumArray[Result] then Exit;
raise Exception.CreateRes(@SInvalidEnumValue);
end;

{ TCustomDownloader }

destructor TCustomDownloader.Destroy;
begin
inherited Destroy;
end;

procedure TCustomDownloader.DoAfterDownload;
begin
if Assigned(FOnAfterDownload) then
FOnAfterDownload(Self);
end;

procedure TCustomDownloader.DoBeforeDownload;
begin
if Assigned(FOnBeforeDownload) then
FOnBeforeDownload(Self);
end;

procedure TCustomDownloader.Download;
begin
if Trim(URL) = '' then raise Exception.CreateRes(@SUrlMissing);
if Trim(FileName) = '' then raise Exception.CreateRes(@SFileNameMissing);
if not UrlMonInitialized then
begin
UrlMonHandle := LoadLibrary(UrlMonLib);
if UrlMonHandle <> 0 then
UrlMonDownloadToFile := GetProcAddress(UrlMonHandle, PChar(sURLMonDownloadToFileA));
UrlMonInitialized := True;
end;
if Assigned(UrlMonDownloadToFile) then
begin
if URLMonDownloadToFile(nil, PChar(URL), PChar(FileName), 0, Self as IBindStatusCallBack) <> S_OK then
raise Exception.CreateResFmt(@SErrorDownloadingURL, ); end else raise Exception.C... 0) then FreeLibrary(UrlMonHandle); end.
 
者最近开发的系统中需要写一个下载文件的功能。以前用BCB调用API写的很烦琐,忽然想起有一个API就可以搞定了,于是一大早就来搜索。这个API就是UrlDownloadToFile。不仅如此,Delphi的一些控件也可以轻松实现下载,如NMHTTP,指定NMHTTP1.InputFileMode := ture; 指定Body为本地文件名,指定Get就可以下载了。下面是详细代码,均出自CSDN。我把它们都整理到这儿,让大家方便查阅。

=================
uses UrlMon;
function DownloadFile(Source, Dest: string): Boolean;
begin
try
Result := UrlDownloadToFile(nil, PChar(source), PChar(Dest), 0, nil) = 0;
except
Result := False;
end;
end;

if DownloadFile('http://www.borland.com/delphi6.zip, 'c:/kylix.zip') then
ShowMessage('Download succesful')
else ShowMessage('Download unsuccesful')

========================
例程:

Uses URLMon, ShellApi;
function DownloadFile(SourceFile, Destfile: string): Boolean;
begin
try
Result := UrlDownloadToFile(nil, PChar(SourceFile), PChar(DestFile), 0, nil) = 0;
except
Result := False;
end;
end;

procedure TForm1.Button1.Click(Sender: TObject);
const
// URL Location
SourceFile := 'http://www.google.com/intl/de/images/home_title.gif';
// Where to save the file
DestFile := 'c:/temp/google-image.gif';
begin
if DownloadFile(SourceFile, DestFile) then
begin
ShowMessage('Download succesful!');
// Show downloaded image in your browser
ShellExecute(Application.Handle,PChar('open'),PChar(DestFile),PChar(''),nil,SW_NORMAL)
end
else
ShowMessage('Error while downloading ' + SourceFile)
end;

=================

加入如下代码:

NMHTTP1.InputFileMode := ture;
NMHTTP1.Body := '本地文件名';
NMHTTP1.Header := 'Head.txt';
NMHTTP1.OutputFileMode := FALSE;
NMHTTP1.ReportLevel := Status_Basic;
NMHTTP1.Proxy := '代理服务器的IP地址';
NMHTTP1.ProxyPort := '代理服务器的端口号';
With NMHTTP1.HeaderInfo do

Begin
Cookie := '';
LocalMailAddress := '';
LocalProgram := '';
Referer := '';
UserID := '用户名称';
Password := '用户口令';
End;

NMHTTP1.Get(‘http://www.abcdefg.com/software/a.zip’);

试试吧,Delphi的目录中有TNMHTTP控件的例子。NT4+,Win95+,IE3+,你可以用URL Moniker的功能。

uses URLMon;

...

OleCheck(URLDownloadToFile(nil,'URL','Filename',0,nil));

其中最后一个参数你还可以传入一个IBindStatusCallback的实现以跟踪下载进度或控制中止下载。简单的场合一句话就搞定了。

BTW, URL Moniker封装了大多数URL,而不是像NMHTTP那样封装协议,因此你可以用URLDownloadToFile下载HTTP,FTP甚至本地文件和局域网文件,还有其他的custom moniker,比如MSITSTORE(MSDN Library的文档moniker实现)。

============
用IdHTTP控件吧!
var
DownLoadfile:TFileStream;
beginio
DownLoadfile:=TFileStream.Create('c:/aa.rar',fmCreate);
IdHTTP1.Get('http://www.sina.com.cn/download/aa.rar',DownLoadFile);
DownLoadFile.Free;
end;

//---------------------------
 
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;
form1.pb.Max:=TotalLength;
GetFilePos;
GetFilePosBeginEnd;
form1.pb.Position:=form1.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));
form1.pb.Position:=form1.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.
 
后退
顶部