这里有个程序,你自己参考人家怎么作好了。 \\\\\\\\\\\\\用Delphi实现文件下载的几种方法(UrlDownloadToFile) 笔者最近开发的系统中需要写一个下载文件的功能。以前用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 doBegin 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的实现以跟踪下载进度或控制中止下载。简单的场合一句话就搞定了。--回复得分 0--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 uHTTPApp;interfaceuses Windows, Messages, SysUtils, Winsock2; function GetURL(URL:string;Request:string=''):string; function PostURL(URL,PostStr:string;Request:string=''):string; function DownloadFile(URL,ToFile:string;Request:string=''):boolean; function GetRawHeaders(Content:string;HeaderName:string=''):string; function SocketTCP(lpIP:string;lpPort:integer;lpData:string;lpToFile:string=''):string;implementationfunction SocketTCP(lpIP:string;lpPort:integer;lpData:string;lpToFile:string=''):string; //读取网站数据 var intRet:integer; f:file; bToFile,bStart:boolean; Buff:array[0..8191] of char; SockAddrIn:TSockaddr; lpSocket:TSocket; HostEnt: PHostEnt; intReadCount:integer; begin result:=''; gethostname (Buff, sizeof (Buff)); StrPCopy(Buff, lpIP); HostEnt := gethostbyname (Buff); if Assigned (HostEnt) then begin if Assigned (HostEnt^.h_addr_list) then begin if Assigned (hostEnt^.h_addr_list^) then begin lpIP := Format ('%d.%d.%d.%d', [ byte(hostEnt^.h_addr_list^[0]), byte(hostEnt^.h_addr_list^[1]), byte(hostEnt^.h_addr_list^[2]), byte(hostEnt^.h_addr_list^[3])]); end; end; end; lpSocket := socket(PF_INET, SOCK_STREAM,IPPROTO_IP); SockAddrIn.sin_addr.s_addr:=inet_addr(PChar(lpIP)); SockAddrIn.sin_family := PF_INET; SockAddrIn.sin_port :=htons(lpPort); intRet:=connect(lpSocket,@SockAddrIn, SizeOf(SockAddrIn));//连接 if intRet<>0 then exit; bToFile:=lpToFile<>''; bStart:=false; if bToFile then begin AssignFile(f, lpToFile); Rewrite(f, 1); end; send(lpSocket,lpData[1],length(lpData),MSG_DONTROUTE);//发送 while WSAGetLastError=0 do begin fillchar(Buff,sizeof(Buff),0); intReadCount:=recv(lpSocket,Buff,8192,0); //读取数据 if intReadCount<=0 then break else begin if bToFile then begin if bStart then BlockWrite(f, Buff, intReadCount) else begin intRet:= pos(#13#10#13#10,Buff); if intRet>0 then begin bStart:=true; BlockWrite(f, Buff[intRet+3], intReadCount-intRet-3) end; end; end; //tofile result:=result+Buff; end; end; if bToFile then CloseFile(f); closesocket(lpSocket);//关闭 end;procedure ParseURL(URL: String; var HostName,Port, FileName: String); procedure ReplaceChar(c1, c2: Char; var St: String); var p: Integer; begin while True do begin p := Pos(c1, St); if p = 0 then Break else St[p] := c2; end; end; var i: Integer; begin if Pos('http://', LowerCase(URL)) <> 0 then System.Delete(URL, 1, 7); i := Pos('/', URL); HostName := Copy(URL, 1, i-1); FileName := Copy(URL, i, Length(URL) - i + 1); if (Length(HostName) > 0) and (HostName[Length(HostName)] = '/') then SetLength(HostName, Length(HostName) - 1); i := Pos(':', HostName); if i>0 then begin Port:= copy(HostName,i+1,10); System.Delete(HostName,i,100); end else Port:= '80'; end;function GetURL(URL:string;Request:string=''):string; var HostName,Port, FileName: String ; begin ParseURL(URL, HostName, Port, FileName); result:='GET '+FileName+' HTTP/1.1'+#13#10; result:=result+'Accept: text/html, */*'+#13#10; result:=result+'Accept-Language: zh-cn'+#13#10; result:=result+'Accept-Encoding: identity'+#13#10;//gzip, deflate result:=result+'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1))'+#13#10; result:=result+'Host: '+HostName+#13#10; result:=result+'Connection: close'+#13#10; result:=result+Request+#13#10; if Request<>'' then result:=result+#13#10; result:=SocketTCP(HostName,strtoint(Port),result); end;function PostURL(URL,PostStr:string;Request:string=''):string; var HostName,Port, FileName: String ; begin ParseURL(URL, HostName, Port, FileName); result:='POST '+FileName+' HTTP/1.1'+#13#10; result:=result+'Accept: text/html, */*'+#13#10; result:=result+'Accept-Language: zh-cn'+#13#10; result:=result+'Accept-Encoding: identity'+#13#10; result:=result+'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)'+#13#10; result:=result+'Content-Type: application/x-www-form-urlencoded'+#13#10; result:=result+'Host: '+HostName+#13#10; result:=result+'Content-Length: '+inttostr(length(PostStr))+#13#10; result:=result+'Connection: close'+#13#10; result:=result+Request+#13#10; if Request<>'' then result:=result+#13#10; result:=result+PostStr; result:=SocketTCP(HostName,strtoint(Port),result); end;function DownloadFile(URL,ToFile:string;Request:string=''):boolean; var HostName,Port, FileName,RawHeaders: String ; begin ParseURL(URL, HostName, Port, FileName); RawHeaders:='GET '+FileName+' HTTP/1.1'+#13#10; RawHeaders:=RawHeaders+'Accept: text/html, */*'+#13#10; RawHeaders:=RawHeaders+'Accept-Language: zh-cn'+#13#10; RawHeaders:=RawHeaders+'Accept-Encoding: identity'+#13#10;//gzip, deflate RawHeaders:=RawHeaders+'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1))'+#13#10; RawHeaders:=RawHeaders+'Host: '+HostName+#13#10; RawHeaders:=RawHeaders+'Connection: close'+#13#10; RawHeaders:=RawHeaders+Request+#13#10; if Request<>'' then RawHeaders:=RawHeaders+#13#10; RawHeaders:=SocketTCP(HostName,strtoint(Port),RawHeaders,ToFile); result:=pos(' 200 OK',RawHeaders)>0; end;function GetRawHeaders(Content:string;HeaderName:string=''):string; var i:integer; begin i:=pos(#13#10#13#10,Content)+3; result:=copy(Content,1,i); if HeaderName='' then exit; HeaderName:=HeaderName+':'; i:=pos(lowercase(HeaderName),lowercase(Content)); delete(result,1,i-1); i:=pos(#13#10,result)-1; result:=copy(result,1,i); delete(result,1,length(HeaderName)); result:=trim(result); end;//--------------------------------------------------------------------------// var wsa : TWSAData; initialization if WSAStartup(MAKEWORD(2,2), wsa )<>0 then windows.MessageBox (0,PChar(format('WSAStartup 错误代码: %d',[WSAGetLastError])),'错误',MB_ICONERROR); finalization WSACleanup();end.
根据传回的转向地址设置名字。
idhttp.response.content-type
idhttp.response.redirection
笔者最近开发的系统中需要写一个下载文件的功能。以前用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 doBegin
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的实现以跟踪下载进度或控制中止下载。简单的场合一句话就搞定了。--回复得分 0--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;//---------------------------
Windows, Messages, SysUtils, Winsock2; function GetURL(URL:string;Request:string=''):string;
function PostURL(URL,PostStr:string;Request:string=''):string;
function DownloadFile(URL,ToFile:string;Request:string=''):boolean;
function GetRawHeaders(Content:string;HeaderName:string=''):string;
function SocketTCP(lpIP:string;lpPort:integer;lpData:string;lpToFile:string=''):string;implementationfunction SocketTCP(lpIP:string;lpPort:integer;lpData:string;lpToFile:string=''):string; //读取网站数据
var
intRet:integer;
f:file;
bToFile,bStart:boolean;
Buff:array[0..8191] of char;
SockAddrIn:TSockaddr;
lpSocket:TSocket;
HostEnt: PHostEnt;
intReadCount:integer;
begin
result:='';
gethostname (Buff, sizeof (Buff));
StrPCopy(Buff, lpIP);
HostEnt := gethostbyname (Buff);
if Assigned (HostEnt) then
begin
if Assigned (HostEnt^.h_addr_list) then
begin
if Assigned (hostEnt^.h_addr_list^) then
begin
lpIP := Format ('%d.%d.%d.%d', [
byte(hostEnt^.h_addr_list^[0]),
byte(hostEnt^.h_addr_list^[1]),
byte(hostEnt^.h_addr_list^[2]),
byte(hostEnt^.h_addr_list^[3])]);
end;
end;
end;
lpSocket := socket(PF_INET, SOCK_STREAM,IPPROTO_IP);
SockAddrIn.sin_addr.s_addr:=inet_addr(PChar(lpIP));
SockAddrIn.sin_family := PF_INET;
SockAddrIn.sin_port :=htons(lpPort);
intRet:=connect(lpSocket,@SockAddrIn, SizeOf(SockAddrIn));//连接
if intRet<>0 then
exit;
bToFile:=lpToFile<>''; bStart:=false;
if bToFile then
begin
AssignFile(f, lpToFile);
Rewrite(f, 1);
end;
send(lpSocket,lpData[1],length(lpData),MSG_DONTROUTE);//发送
while WSAGetLastError=0 do
begin
fillchar(Buff,sizeof(Buff),0);
intReadCount:=recv(lpSocket,Buff,8192,0); //读取数据
if intReadCount<=0 then
break
else begin
if bToFile then
begin
if bStart then
BlockWrite(f, Buff, intReadCount)
else begin
intRet:= pos(#13#10#13#10,Buff);
if intRet>0 then
begin
bStart:=true;
BlockWrite(f, Buff[intRet+3], intReadCount-intRet-3)
end;
end;
end; //tofile
result:=result+Buff;
end;
end;
if bToFile then
CloseFile(f);
closesocket(lpSocket);//关闭
end;procedure ParseURL(URL: String; var HostName,Port, FileName: String); procedure ReplaceChar(c1, c2: Char; var St: String);
var
p: Integer;
begin
while True do
begin
p := Pos(c1, St);
if p = 0 then Break
else St[p] := c2;
end;
end; var
i: Integer;
begin
if Pos('http://', LowerCase(URL)) <> 0 then
System.Delete(URL, 1, 7); i := Pos('/', URL);
HostName := Copy(URL, 1, i-1);
FileName := Copy(URL, i, Length(URL) - i + 1); if (Length(HostName) > 0) and (HostName[Length(HostName)] = '/') then
SetLength(HostName, Length(HostName) - 1); i := Pos(':', HostName);
if i>0 then
begin
Port:= copy(HostName,i+1,10);
System.Delete(HostName,i,100);
end
else
Port:= '80';
end;function GetURL(URL:string;Request:string=''):string;
var HostName,Port, FileName: String ;
begin
ParseURL(URL, HostName, Port, FileName);
result:='GET '+FileName+' HTTP/1.1'+#13#10;
result:=result+'Accept: text/html, */*'+#13#10;
result:=result+'Accept-Language: zh-cn'+#13#10;
result:=result+'Accept-Encoding: identity'+#13#10;//gzip, deflate
result:=result+'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1))'+#13#10;
result:=result+'Host: '+HostName+#13#10;
result:=result+'Connection: close'+#13#10;
result:=result+Request+#13#10;
if Request<>'' then
result:=result+#13#10;
result:=SocketTCP(HostName,strtoint(Port),result);
end;function PostURL(URL,PostStr:string;Request:string=''):string;
var HostName,Port, FileName: String ;
begin
ParseURL(URL, HostName, Port, FileName);
result:='POST '+FileName+' HTTP/1.1'+#13#10;
result:=result+'Accept: text/html, */*'+#13#10;
result:=result+'Accept-Language: zh-cn'+#13#10;
result:=result+'Accept-Encoding: identity'+#13#10;
result:=result+'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)'+#13#10;
result:=result+'Content-Type: application/x-www-form-urlencoded'+#13#10;
result:=result+'Host: '+HostName+#13#10;
result:=result+'Content-Length: '+inttostr(length(PostStr))+#13#10;
result:=result+'Connection: close'+#13#10;
result:=result+Request+#13#10;
if Request<>'' then
result:=result+#13#10;
result:=result+PostStr;
result:=SocketTCP(HostName,strtoint(Port),result);
end;function DownloadFile(URL,ToFile:string;Request:string=''):boolean;
var HostName,Port, FileName,RawHeaders: String ;
begin
ParseURL(URL, HostName, Port, FileName);
RawHeaders:='GET '+FileName+' HTTP/1.1'+#13#10;
RawHeaders:=RawHeaders+'Accept: text/html, */*'+#13#10;
RawHeaders:=RawHeaders+'Accept-Language: zh-cn'+#13#10;
RawHeaders:=RawHeaders+'Accept-Encoding: identity'+#13#10;//gzip, deflate
RawHeaders:=RawHeaders+'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1))'+#13#10;
RawHeaders:=RawHeaders+'Host: '+HostName+#13#10;
RawHeaders:=RawHeaders+'Connection: close'+#13#10;
RawHeaders:=RawHeaders+Request+#13#10;
if Request<>'' then
RawHeaders:=RawHeaders+#13#10;
RawHeaders:=SocketTCP(HostName,strtoint(Port),RawHeaders,ToFile);
result:=pos(' 200 OK',RawHeaders)>0;
end;function GetRawHeaders(Content:string;HeaderName:string=''):string;
var i:integer;
begin
i:=pos(#13#10#13#10,Content)+3;
result:=copy(Content,1,i);
if HeaderName='' then exit;
HeaderName:=HeaderName+':';
i:=pos(lowercase(HeaderName),lowercase(Content));
delete(result,1,i-1);
i:=pos(#13#10,result)-1;
result:=copy(result,1,i);
delete(result,1,length(HeaderName));
result:=trim(result);
end;//--------------------------------------------------------------------------//
var
wsa : TWSAData;
initialization
if WSAStartup(MAKEWORD(2,2), wsa )<>0 then
windows.MessageBox (0,PChar(format('WSAStartup 错误代码: %d',[WSAGetLastError])),'错误',MB_ICONERROR);
finalization
WSACleanup();end.
var dwLengthSizeBuffer,dwReserved:DWord;
begin
dwReserved:=0;dwLengthSizeBuffer:=1024;
SetLength(result,dwLengthSizeBuffer+1);
fillchar(result[1],dwLengthSizeBuffer,0);
HttpQueryInfo(hRequest,dwInfoLevel,@result[1],dwLengthSizeBuffer,dwReserved);
end;function GetWebPage(const Url: string):string;
var
Session,HttpFile:HINTERNET;
dwFileSize:DWord;
dwBytesRead:DWord;
Contents:PChar;
szContentLength,szContentType:string;
begin
Session:=InternetOpen(nil,0,niL,niL,0);
HttpFile:=InternetOpenUrl(Session,PChar(Url),nil,0,0,0);
szContentType:=trim(QueryInfo2(HttpFile,HTTP_QUERY_CONTENT_TYPE));//类型
szContentLength:=trim(QueryInfo2(HttpFile,HTTP_QUERY_CONTENT_LENGTH)); //长度
dwFileSize:=strtoint(szContentLength);
GetMem(Contents,dwFileSize);
InternetReadFile(HttpFile,Contents,dwFileSize,dwBytesRead);
InternetCloseHandle(HttpFile);
InternetCloseHandle(Session);
Result:=StrPas(Contents);
FreeMem(Contents);
Form1.Edit1.Text := format('类型: %s 长度: %s',[szContentType,szContentLength]);
end;
var
Session,HttpFile:HINTERNET;
dwFileSize:DWord;
dwBytesRead:DWord;
Contents:Pointer;
szContentLength,szContentType:string;
f: File;
begin
Session:=InternetOpen(nil,0,niL,niL,0);
HttpFile:=InternetOpenUrl(Session,PChar(Url),nil,0,0,0);
szContentType:=trim(QueryInfo2(HttpFile,HTTP_QUERY_CONTENT_TYPE));//类型
szContentLength:=trim(QueryInfo2(HttpFile,HTTP_QUERY_CONTENT_LENGTH)); //长度
dwFileSize:=strtoint(szContentLength);
GetMem(Contents,dwFileSize);
InternetReadFile(HttpFile,Contents,dwFileSize,dwBytesRead);
result:=strSavePath+'001.'+copy(szContentType,pos('/',szContentType)+1,4);//设置文件名
AssignFile(f, result);
Rewrite(f, 1);
BlockWrite(f, Contents^, dwFileSize);
CloseFile(f);
InternetCloseHandle(HttpFile);
InternetCloseHandle(Session);
FreeMem(Contents);
end;//调用
Memo1.Text := UrlDownloadToFile2('http://community.csdn.net/logo/Images/eye001.gif','E:\download\');