,老子连基本也不过关~
还有,老子写的代码作风是十分PL的,但一贴百度就变2B代码了~ 与偶无关,呜呜呜~
这个代码貌似很简略,实在写得很挫,有一些挫挫的处所,我就不说出来了,本人摸索~
{
阐明:所援用的WinInet API函数都动态载入~
无敌可恶的下载单元, By:7dBi 2009/04/01
GetWebPage:获取网页内容,参数为网页地址,返回网页内容
用法:GetWebPage('http://127.0.0.1/index.htm');
GetWebFile:下载文件函数,第一个参数为下载地址,第二个是文件保存门路
用法:GetWebFile('http://127.0.0.1/mm.exe','C:\mm.exe') ;
DownAllFile:下载多项文件函数,地址内容为一行一条下载地址~第一个参数是多项的下载地址,第二个是保存的目录(注意:只是目录,保存的文件名将以地址上的文件名相同),
第三个参数为翻开的方法,第四个参数为每个文件距离下载时光~
用法:DownAllFile('http://127.0.0.1/List.txt','C:\',SW_ SHOW,明星网,3000);
Update:2009/05/04
解释:此次更新令下载更强盛.本来是有两种方式下载的,一种读从HTTP头部读取资源大小,而后调配必定内存,并读取网络上的文件.
另外一种方式是定义一定大小,轮回读取直到读完.然而鉴于Linux体系的HTTP头部并没有返回资源大小.只好用后者方式实现读取文件.
这次的更新首先应用第一种方式实现读取,失败后再使用第二种,很好地作了兼用性.且DownAllFile函数作了比拟完美的重复下载处置,更完善地实现下载!
PS:由原来WinExec改为鄙陋的ShellExecuteA打开文件.
DownAllFile:下载多项文件函数,地址内容为一行一条下载地址~第一个参数是多项的下载地址,第二个是保留的目录(留神:只是目录,保存的文件名将以地址上的文件名雷同),
第三个参数是失败后尝试反复下载的次数,第四个参数为打开的方式,第五个参数为每个文件距离下载时间~
用法:DownAllFile('http://127.0.0.1/List.txt','C:\',3,S W_SHOW,3000);
}
unit Unit_GetWeb;
interface
uses
Windows;
const
lpCode = '200';
HTTP_VERSION = 'HTTP/1.0';
INTERNET_DEFAULT_HTTP_PORT = 80;
HTTP_QUERY_STATUS_CODE = 19;
INTERNET_FLAG_RELOAD = $80000000;
INTERNET_FLAG_NO_CACHE_WRITE = $04000000;
INTERNET_OPEN_TYPE_PRECONFIG = 0;
INTERNET_SERVICE_HTTP = 3;
HTTP_QUERY_CONTENT_LENGTH = 5;
Type
SArray = array of string;
type
HINTERNET = Pointer;
{$EXTERNALSYM HINTERNET}
PHINTERNET = ^HINTERNET;
LPHINTERNET = PHINTERNET;
{$EXTERNALSYM LPHINTERNET}
INTERNET_PORT = Word;
{$EXTERNALSYM INTERNET_PORT}
PINTERNET_PORT = ^INTERNET_PORT;
LPINTERNET_PORT = PINTERNET_PORT;
{$EXTERNALSYM LPINTERNET_PORT}
var
URLArray:SArray;
hWinInet:THandle;
function GetWebPage(const FileURL: String):String;stdcall;
function GetWebFile(const FileURL, FilePath: String):Boolean;stdcall;
function GetWebPageW(const FileURL: String):String;stdcall;
function GetWebFileW(const FileURL, FilePath: String):Boolean;stdcall;
function DownAllFile(lpDownURL,lpFilePath:String;dwTryDown: DWORD=0;dwRunMode:Integer=-1;dwSleep:DWORD=0):Boole an;stdcall;
var
MyInternetOpen:function(lpszAgent: PChar; dwAccessType: DWORD; lpszProxy, lpszProxyBypass: PChar; dwFlags: DWORD): HINTERNET; stdcall;
MyInternetOpenUrl:function(hInet: HINTERNET; lpszUrl: PChar; lpszHeaders: PChar; dwHeadersLength: DWORD; dwFlags: DWORD; dwContext: DWORD): HINTERNET; stdcall;
MyHttpQueryInfo:function(hRequest: HINTERNET; dwInfoLevel: DWORD; lpvBuffer: Pointer; var lpdwBufferLength: DWORD; var lpdwReserved: DWORD): BOOL; stdcall;
MyInternetConnect:function(hInet: HINTERNET; lpszServerName: PChar; nServerPort: INTERNET_PORT; lpszUsername: PChar; lpszPassword: PChar; dwService: DWORD; dwFlags: DWORD; dwContext: DWORD): HINTERNET; stdcall;
MyHttpOpenRequest:function(hConnect: HINTERNET; lpszVerb: PChar; lpszObjectName: PChar; lpszVersion: PChar; lpszReferrer: PChar; lplpszAcceptTypes: PLPSTR; dwFlags: DWORD; dwContext: DWORD): HINTERNET; stdcall;
MyHttpSendRequest:function(hRequest: HINTERNET; lpszHeaders: PChar; dwHeadersLength: DWORD; lpOptional: Pointer; dwOptionalLength: DWORD): BOOL; stdcall;
MyInternetReadFile:function(hFile: HINTERNET; lpBuffer: Pointer; dwNumberOfBytesToRead: DWORD; var lpdwNumberOfBytesRead: DWORD): BOOL; stdcall;
MyInternetCloseHandle:function(hInet: HINTERNET): BOOL; stdcall;
MyShellExecute:function(hWnd: HWND; Operation, FileName, Parameters,Directory: PChar; ShowCmd: Integer):Cardinal; stdcall;
implementation
function StrPas(const Str: PChar): string;
begin
Result := Str;
end;
function StrToInt(const S: string): integer;
var
v1: Integer;
begin
Val(S, Result, v1);
end;
function Split(const Source,Delimiter:String):SArray;
var
iCount,iPos,iLength: Integer;
sTemp: String;
aSplit:SArray;
begin
sTemp := Source;
iCount := 0;
iLength := Length(Delimiter) - 1;
repeat
iPos := Pos(Delimiter, sTemp);
if iPos = 0 then Break
else
begin
Inc(iCount);
SetLength(aSplit, iCount);
aSplit[iCount - 1] := Copy(sTemp, 1, iPos - 1);
Delete(sTemp, 1, iPos + iLength);
end;
until False;
if Length(sTemp) > 0 then
begin
Inc(iCount);
SetLength(aSplit, iCount);
aSplit[iCount - 1] := sTemp;
end;
Result := aSplit;
end;
function ExtractURLFile(Fn:String):String;
var
s: Byte;
begin
for s:=Length(Fn) Downto 1 do
if (Fn[s]='/') or (Fn[s]='\') Then
begin
Result:=Copy(Fn,s+1,255);
Break;
end;
end;
function GetWebData(const FileURL:String;var dwFileSize:Int64): Pointer;stdcall;
const
RequestMethod = 'POST';
var
dwIndex,dwCodeLen:DWORD;
dwSize:DWORD;
dwBytesRead,dwReserved:DWORD;
hSession,hConnection,hURL,hHTTP:HInternet;
dwCode:array[1..20] of Char;
ContentSize:array[1..1024] of Char;
HostPort:Integer;
HostName,FileName:String;
procedure ParseURL(URL: string;var HostName,FileName:string;var HostPort:Integer);
var
i,p,k: DWORD;
function StrToIntDef(const S: string; Default: Integer): Integer;
var
E: Integer;
begin
Val(S, Result, E);
if E <> 0 then Result := Default;
end;
begin
if lstrcmpi('http://',PChar(Copy(URL,1,7))) = 0 then System.Delete(URL, 1, 7);
HostName := URL;
FileName := '/';
HostPort := INTERNET_DEFAULT_HTTP_PORT;
i := Pos('/', URL);
if i <> 0 then
begin
HostName := Copy(URL, 1, i-1);
FileName := Copy(URL, i, Length(URL) - i + 1);
end;
p:=pos(':',HostName);
if p <> 0 then
begin
k:=Length(HostName)-p;
HostPort:=StrToIntDef(Copy(HostName,p+1,k),INTERNE T_DEFAULT_HTTP_PORT);
Delete(HostName,p,k+1);
end;
end;
begin
Result := Pointer(-1);
dwFileSize:=0;
dwIndex := 0;
dwCodeLen := 10;
ParseURL(FileURL,HostName,FileName,HostPort);
hSession := MyInternetOpen('', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
hURL := MyInternetOpenURL(hSession, PChar(FileURL), nil, 0, INTERNET_FLAG_RELOAD, 0) ;
MyHttpQueryInfo(hURL, HTTP_QUERY_STATUS_CODE, @dwCode, dwCodeLen, dwIndex);
// MessAgeBox(0,PChar(@dwCode),'OK',0);
if PChar(@dwCode) = lpCode then
begin
hConnection:=MyInternetConnect(hSession,PChar(Host Name),HostPort,nil,nil,INTERNET_SERVICE_HTTP,0,0);
hHTTP:=MyHttpOpenRequest(hConnection,RequestMethod ,PChar(FileName),HTTP_VERSION,'',nil,INTERNET_FLAG_ RELOAD or INTERNET_FLAG_NO_CACHE_WRITE ,0);
if MyHttpSendRequest(hHTTP,nil,0,nil,0) then
begin
dwReserved:=0;
dwSize:=SizeOf(ContentSize);
if MyHttpQueryInfo(hHTTP,HTTP_QUERY_CONTENT_LENGTH,@C ontentSize,dwSize,dwReserved) then
begin
dwFileSize:=StrToInt(StrPas(@ContentSize));
GetMem(Result, dwFileSize);
MyInternetReadFile(hURL,Result,dwFileSize,dwBytesR ead);
end;
end;
MyInternetCloseHandle(hHTTP);
MyInternetCloseHandle(hConnection);
end;
MyInternetCloseHandle(hURL);
MyInternetCloseHandle(hSession);
end;
function GetWebPage(const FileURL: String):String;stdcall;
var
FileSize:Int64;
lpFile:PChar;
begin
Result:='';
lpFile:=GetWebData(FileURL,FileSize);
if lpFile <> Pointer(-1) then
begin
Result:=StrPas(lpFile);
end
else Result:=GetWebPageW(FileURL);
end;
function IntToStr(I: integer):string;
var
v1: string;
begin
Str(I, v1);
Result := v1;
end;
function GetWebFile(const FileURL, FilePath: String):Boolean;stdcall;
var
hFile:THandle;
lpFile:PChar;
FileSize:Int64;
dwBytesRead:DWORD;
begin
Result:=False;
lpFile:=GetWebData(FileURL,FileSize);
if lpFile <> Pointer(-1) then
begin
hFile := CreateFile(PChar(FilePath), GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
Try
if (hFile = INVALID_HANDLE_VALUE) then Exit;
Result := WriteFile(hFile, lpFile^, FileSize, dwBytesRead, nil);
SetEndOfFile(hFile);
Finally
CloseHandle(hFile);
End;
end
else Result:=GetWebFileW(FileURL,FilePath);
end;
function GetWebPageW(const FileURL: String):String;stdcall;
var
Session,HttpFile:HINTERNET;
szSizeBuffer:Pointer;
dwLengthSizeBuffer:DWord;
dwReserved,dwBytesRead:DWord;
dwFileSize:Int64;
Contents:PChar;
dwIndex,dwCodeLen:Dword;
dwCode:array[1..20] of Char;
begin
Result:='';
Session:=MyInternetOpen('',0,niL,niL,0);
HttpFile:=MyInternetOpenURL(Session,PChar(FileURL) ,niL,0,0,0);
dwIndex:=0;
dwCodeLen:=10;
dwFileSize:=1024*1024;
dwLengthSizeBuffer:=1024;
MyHttpQueryInfo(HttpFile, HTTP_QUERY_STATUS_CODE, @dwCode, dwCodeLen, dwIndex);
if (PChar(@dwCode) = lpCode) then
begin
MyHttpQueryInfo(HttpFile,HTTP_QUERY_CONTENT_LENGTH ,szSizeBuffer,dwLengthSizeBuffer,dwReserved);
GetMem(Contents,明星网,dwFileSize);
MyInternetReadFile(HttpFile,Contents,dwFileSize,dw BytesRead);
Result:=StrPas(Contents);
FreeMem(Contents);
end;
MyInternetCloseHandle(HttpFile);
MyInternetCloseHandle(Session);
end;
function GetWebFileW(const FileURL,FilePath:String): Boolean;stdcall;
const
BufferSize = 1024;
RequestMethod = 'POST';
var
dwIndex,dwCodeLen:DWORD;
dwSize:DWORD;
dwBytesRead,dwReserved:DWORD;
hSession,hConnection,hURL,hHTTP:HInternet;
dwCode:array[1..20] of Char;
ContentSize:array[1..1024] of Char;
Buffer: array[1..BufferSize] of Char;
HostPort:Integer;
HostName,FileName:String;
BufferLen: DWORD;
TempStr:String;
hFile:THandle;
F:File;
procedure ParseURL(URL: string;var HostName,FileName:string;var HostPort:Integer);
var
i,p,k: DWORD;
function StrToIntDef(const S: string; Default: Integer): Integer;
var
E: Integer;
begin
Val(S, Result, E);
if E <> 0 then Result := Default;
end;
begin
if lstrcmpi('http://',PChar(Copy(URL,1,7))) = 0 then System.Delete(URL, 1, 7);
HostName := URL;
FileName := '/';
HostPort := INTERNET_DEFAULT_HTTP_PORT;
i := Pos('/', URL);
if i <> 0 then
begin
HostName := Copy(URL, 1, i-1);
FileName := Copy(URL,明星网, i, Length(URL) - i + 1);
end;
p:=pos(':',HostName);
if p <> 0 then
begin
k:=Length(HostName)-p;
HostPort:=StrToIntDef(Copy(HostName,p+1,k),INTERNE T_DEFAULT_HTTP_PORT);
Delete(HostName,p,k+1);
end;
end;
begin
Result := False;
dwIndex := 0;
dwCodeLen := 10;
ParseURL(FileURL,HostName,FileName,HostPort);
hSession := MyInternetOpen('', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
hURL := MyInternetOpenURL(hSession, PChar(FileURL), nil, 0, INTERNET_FLAG_RELOAD, 0) ;
MyHttpQueryInfo(hURL, HTTP_QUERY_STATUS_CODE, @dwCode, dwCodeLen, dwIndex);
if PChar(@dwCode) = lpCode then
begin
hFile := CreateFile(PChar(FilePath), GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
Try
if (hFile = INVALID_HANDLE_VALUE) then Exit;
repeat
if MyInternetReadFile(hURL, @Buffer, SizeOf(Buffer), BufferLen) then
WriteFile(hFile, Buffer, BufferLen, dwBytesRead, nil);
until BufferLen = 0;
SetEndOfFile(hFile);
Result := True;
Finally
CloseHandle(hFile);
End;
end;
MyInternetCloseHandle(hURL);
MyInternetCloseHandle(hSession);
end;
function DownAllFile(lpDownURL,lpFilePath:String;dwTryDown: DWORD=0;dwRunMode:Integer=-1;dwSleep:DWORD=0):Boole an;stdcall;
var
i:Integer;
bDown:Boolean;
dwDown:Integer;
TempURL,TempPath,lpWeb:PChar;
begin
Result:=False;
lpWeb:=PChar(GetWebPage(lpDownURL));
if lpWeb = '' then Exit;
URLArray:=Split(lpWeb,#13#10);
for i:=0 to Length(URLArray)-1 do
begin
TempURL:=PChar(URLArray);
TempPath:=PChar(lpFilePath+ExtractURLFile(TempURL) );
if lstrcmpi('http://',PChar(Copy(TempURL,1,7))) = 0 then
begin
dwDown:=0;
bDown:=False;
repeat
Inc(dwDown);
if (dwDown > 1) and (dwTryDown <> 0) then Sleep(500);
if GetWebFile(TempURL,TempPath) then
begin
bDown:=True;
if dwRunMode <> -1 then MyShellExecute(0,'Open',PChar(TempPath),nil,nil,dw RunMode); //WinExec(PChar(TempPath),dwRunMode);
Result:=True;
end;
until (dwTryDown = 0) or (bDown or ((dwTryDown <> 0) and (dwTryDown < dwDown)));
end;
if i <> Length(URLArray)-1 then Sleep(dwSleep);
end;
end;
initialization
hWinInet:=LoadLibrary('wininet.dll');
@MyInternetOpen := GetProcAddress(hWinInet, PChar('InternetOpenA'));
@MyInternetOpenUrl := GetProcAddress(hWinInet, PChar('InternetOpenUrlA'));
@MyHttpQueryInfo := GetProcAddress(hWinInet, PChar('HttpQueryInfoA'));
@MyInternetConnect := GetProcAddress(hWinInet, PChar('InternetConnectA'));
@MyHttpOpenRequest := GetProcAddress(hWinInet, PChar('HttpOpenRequestA'));
@MyHttpSendRequest := GetProcAddress(hWinInet, PChar('HttpSendRequestA'));
@MyInternetReadFile := GetProcAddress(hWinInet, PChar('InternetReadFile'));
@MyInternetCloseHandle := GetProcAddress(hWinInet, PChar('InternetCloseHandle'));
@MyShellExecute := GetProcAddress(LoadLibrary('Shell32.dll'), PChar('ShellExecuteA'));
finalization
end.
相关的主题文章：
于是找到了好朋友肉丸！肉丸拍拍胸脯说
如缘老和尚开示节选
