导航

心动吧DELPHI网络书

自发研究:须要多维思想而且要想不可能为可能的人才能做到

« Delphi 替换和安装新svchost服务用DDDK编写驱动,修改SSDT表HOOK NTDebugActiveProcess函数 »

WinInet 下载文件示例

 

Uses WinInet
(1)HTTP下载
Function WWWDownFile(Const FTURL,LocalFile : String) : Boolean; //下载函数.
Const
FTAcceptTypes = '*/*';
FTAgent = 'Explorer';
FTUserName = ''; //用户名.
FTPassword = ''; //密码.
FTPort = 80; //端口.
FTPostQuery = 'GET';
FTReferer = '';

Var
hSession, hConnect, hRequest: hInternet;
HostName, FileName: String;
f: File;
Buf: Pointer;
dwBufLen, dwIndex: DWord;
Data: Array[0..$400] of Char;
RequestMethod: PChar;
InternetFlag: DWord;
TimeOut : Cardinal;
AcceptType: LPStr;
BytesToRead,BytesReaded : DWord;
FTFileSize : integer;

Procedure ParseURL(URL: String; var HostName, FileName: String);
Var
i: Integer;
Begin
if Pos('http://', LowerCase(URL)) <> 0 then
System.Delete(URL, 1, 7);

i := Pos('/', URL);
HostName := Copy(URL, 1, i);
FileName := Copy(URL, i, Length(URL) - i + 1);
if (Length(HostName) > 0) and (HostName[Length(HostName)] = '/') then
SetLength(HostName, Length(HostName) - 1);
End;

Procedure CloseHandles;
begin
InternetCloseHandle(hRequest);
InternetCloseHandle(hConnect);
InternetCloseHandle(hSession);
end;

begin
TimeOut := 6000000;
ParseURL(FTURL, HostName, FileName);
RequestMethod := PChar(FTPostQuery); // 'GET'
InternetFlag := 0;
AcceptType := PChar('Accept: ' + FTAcceptTypes);

if FTAgent <> '' then
hSession := InternetOpen(PChar(FTAgent),
INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0)
else
hSession := InternetOpen(nil,
INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

hConnect := InternetConnect(hSession, PChar(HostName),
FTPort, PChar(FTUserName), PChar(FTPassword),
INTERNET_SERVICE_HTTP, 0, 0);
hRequest := HttpOpenRequest(hConnect, RequestMethod, PChar(FileName), 'HTTP/1.1',
PChar(FTReferer), @AcceptType, InternetFlag, 0);
InternetSetOption(hRequest, INTERNET_OPTION_CONNECT_TIMEOUT,
@TimeOut, SizeOf(TimeOut));
InternetSetOption(hRequest, INTERNET_OPTION_DATA_RECEIVE_TIMEOUT,
@TimeOut, SizeOf(TimeOut));


if FTPostQuery = '' then
HttpSendRequest(hRequest, nil, 0, nil, 0)
else
HttpSendRequest(hRequest, 'Content-Type: application/x-www-form-urlencoded', 47,
PChar(FTPostQuery), Length(FTPostQuery));

dwIndex := 0;
dwBufLen := 1024;
GetMem(Buf, dwBufLen);

Result := HttpQueryInfo(hRequest, HTTP_QUERY_CONTENT_LENGTH,
Buf, dwBufLen, dwIndex);

if Result then begin
BytesReaded := 0;
FTFileSize := StrToInt(StrPas(Buf));
AssignFile(f, LocalFile);
Rewrite(f, 1);
while True do begin
if not InternetReadFile(hRequest, @Data, SizeOf(Data), BytesToRead) then
break
else if BytesToRead = 0 then Break
else
BlockWrite(f, Data, BytesToRead);
BytesReaded := BytesReaded + BytesToRead;
End;
Result := FTFileSize = Integer(BytesReaded);
CloseFile(f);
End;
FreeMem(Buf);
CloseHandles;
end;

(2)FTP下载
function TForm1.GetList(ip:string):bool; //得到远程抓拍机内的文件名列表
var
hNet, hFTP,hFind: HINTERNET;
bSuccess: Boolean;
FindData: TWin32FindData;
str:Tstrings ;
begin
//timer1.Enabled:=true;
//control := true;
hNet := InternetOpen('Program_Name', // Agent
INTERNET_OPEN_TYPE_PRECONFIG, // AccessType
nil, // ProxyName
nil, // ProxyBypass
0); // or INTERNET_FLAG_ASYNC / INTERNET_FLAG_OFFLINE
if hNet = nil then
begin
memo1.Lines.Add('缺少动态连接库WinInet.Dll!');
Result := False;
Exit;
end;


timer1.Enabled:=true;
application.ProcessMessages();
{ Connect to the FTP Server }
hFTP := InternetConnect(hNet, // Handle from InternetOpen
pchar('192.168.0.253'), // FTP server
21, // (INTERNET_DEFAULT_FTP_PORT),
PChar('root'), // username
PChar(''), // password
INTERNET_SERVICE_FTP, // FTP, HTTP, or Gopher?
0, // flag: 0 or INTERNET_FLAG_PASSIVE
255);// User defined number for callback
if hFTP = nil then
begin
InternetCloseHandle(hNet);
memo1.Lines.Add('连接'+ip+'成功!准备开始下载!');
Result := False;
Exit;
end;
timer1.Enabled :=false;

{ Change directory }
//timer1.Enabled:=true;
bSuccess := FtpSetCurrentDirectory(hFTP, PChar('/mnt/imagefolder'));
if not bSuccess then
begin
InternetCloseHandle(hFTP);
InternetCloseHandle(hNet);
memo1.Lines.Add('操作抓拍机错误,请检查!');
Result := False;
Exit;
end;
timer1.Enabled:=false;

hFind:= FtpFindFirstFile(hFtp, '*.jpg',FindData, 0, 0);
if hFind = nil then
begin
memo1.lines.add('抓拍机内暂无图片!');
InternetCloseHandle(hFTP);
InternetCloseHandle(hNet);
Result:=false;
Exit;
end;

str:=tstringlist.Create;
str.Clear;
while InternetFindnextFile(hFind, @FindData) do
begin
str.Add(FindData.cfilename);
end;

InternetCloseHandle(hFind);
InternetCloseHandle(hFTP);
InternetCloseHandle(hNet);
Result := true;

end;

function TForm1.download(ReFile,LoFile,ip:string):Bool;
var
Hnet,Hftp:HINTERNET;
bSuccess: Boolean;
bGetFile: Boolean;
begin
hNet := InternetOpen('Program_Name', // Agent
INTERNET_OPEN_TYPE_PRECONFIG, // AccessType
nil, // ProxyName
nil, // ProxyBypass
0); // or INTERNET_FLAG_ASYNC / INTERNET_FLAG_OFFLINE
if hNet = nil then
begin
memo1.Lines.Add('缺少动态连接库WinInet.Dll!');
Result := False;
Exit;
end;

{ Connect to the FTP Server }
hFTP := InternetConnect(hNet, // Handle from InternetOpen
PChar(ip), // FTP server
21, // (INTERNET_DEFAULT_FTP_PORT),
PChar('root'), // username
PChar(''), // password
INTERNET_SERVICE_FTP, // FTP, HTTP, or Gopher?
INTERNET_FLAG_PASSIVE, // flag: 0 or INTERNET_FLAG_PASSIVE
0);// User defined number for callback
if hFTP = nil then
begin
InternetCloseHandle(hNet);
memo1.Lines.add(ip+'不存在!');
Result := False;
Exit;
end;

{ Change directory }
bSuccess := FtpSetCurrentDirectory(hFTP, PChar('/mnt/imagefolder'));
if not bSuccess then
begin
InternetCloseHandle(hFTP);
InternetCloseHandle(hNet);
memo1.Lines.Add('操作错误,请检查!');
Result := False;
Exit;
end;

memo1.Lines.Add('正在下载!'+ReFile);
bGetFile:=ftpgetfile(hftp,
PChar(ReFile),
pchar(LoFile),
false,
File_Attribute_Normal,
Ftp_Transfer_Type_Binary,
0);
if not bGetFile then
begin
memo1.Lines.Add(ReFile+'下载失败!');
inc(ErrNum);
InternetCloseHandle(hFTP);
InternetCloseHandle(hNet);
Result:=False;
Exit;
end;

memo1.lines.add(ReFile+'下载成功!');
sleep(20);
InternetCloseHandle(hFTP);
InternetCloseHandle(hNet);
end;

 

原创文章如转载,请注明:转载自心动吧DELPHI网络书 [ http://www.abcxd.com/delphi/ ]

本文链接地址:http://www.abcxd.com/delphi/abcxddelphi/DELPHIHACKER/delphi-WinInet_5558.html

发表评论:

◎欢迎参与讨论,请在这里发表您的看法、交流您的观点。

热文排行使用

本年排行使用

本月排行使用

网站分类

搜索内容

最新评论及回复

最近发表

所属分类下的文章

日历

Copyright ⊙ 2004-2009 心动吧 UrL:ABCXD.CoM All RiGhts Reserved