Using WinInet functions to download a file asynchronously in Delphi

 [转自]http://www.neugls.info/?p=191

(注：不好意思，如果你已经应用了该代码的话，请注意，在HttpQueryInfoA函数之前加上一个Reservered:=0;不然，会不能正确的获取到文件的大小。)

WinInet functions were used in windows to help developers develop network application more conveniently, but there is no Delphi  code example on the internet, so I give some code here, help it useful for you.

Please first look at the following code:

type
TNTDownLoadProgressCallBack = reference to procedure(Current,
Total: Cardinal);
TNTDownLoadFinishedCallBack = reference to procedure(Status: NativeInt);
TNTShouldExit=reference to function():Boolean;

procedure DownLoadToFile(
const URL, SavePath: string;
ProgressCallBack: TNTDownLoadProgressCallBack;
FinishCallBack: TNTDownLoadFinishedCallBack;
CanExit:TNTShouldExit
);
const
USER_EXIT_DOWNLOAD_PROCESS=$666666;

implementation

uses
{$IFDEF VER230}
Winapi.Windows, System.SysUtils, Winapi.WinInet
{$ELSE}
Windows, SysUtils,WinInet
{$ENDIF};

var
Header: String = // 'GET %s HTTP/1.1'+sLineBreak+
'Host: %s' + sLineBreak +
'Connection: keep-alive' + sLineBreak +
'User-Agent: NeuglsWorkStudio-Auto-updater' + sLineBreak +
'Accept: text/html,application/xhtml+xml,application/*;q=0.9,*/*;q=0.8' +sLineBreak +
'Accept-Encoding: gzip,deflate,sdch' + sLineBreak +
'Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.3' + sLineBreak +
'Accept-Language: *' + sLineBreak + 'Referer: http://neuglsworkstudio.com/';

var
RequestHandle: HINTERNET;
ConnetHandle: HINTERNET;

ConnectEvent: THandle;
RequestOpendEvent:THandle;
RequestCompleteEvent: THandle;
ShouldExit:Boolean;
TheExitCode:Cardinal;

procedure InternetStatusCallback(hInt: HINTERNET; dwContext: DWORD_PTR;
dwInternetStatus: DWORD; lpvStatusInformation: LPVOID;
dwStatusInformationLength: DWORD); stdcall;
var
InternetAsyncResult: TInternetAsyncResult;
begin
case dwContext of
1: if (dwInternetStatus = INTERNET_STATUS_HANDLE_CREATED) then
begin
InternetAsyncResult:=TInternetAsyncResult(lpvStatusInformation^);
ConnetHandle:=Pointer(InternetAsyncResult.dwResult);
SetEvent(ConnectEvent);
end;
2: case dwInternetStatus of
INTERNET_STATUS_HANDLE_CREATED:
begin
InternetAsyncResult:=TInternetAsyncResult(lpvStatusInformation^);
RequestHandle:=Pointer(InternetAsyncResult.dwResult);
SetEvent(RequestOpendEvent);
end;
INTERNET_STATUS_REQUEST_COMPLETE:
begin
SetEvent(RequestCompleteEvent);
end;
end;
end;
end;

procedure DownLoadToFile(const URL, SavePath: string;
ProgressCallBack: TNTDownLoadProgressCallBack;
FinishCallBack: TNTDownLoadFinishedCallBack;
CanExit:TNTShouldExit);
{$IFDEF MSWINDOWS}
const
BufferSize = 1024*4;
var
Session: HINTERNET;
FHeader: AnsiString;
dwReceived: Cardinal;
Reservered: Cardinal;
Buffer: PAnsiChar;
dwBufferLength: Cardinal;
BOK: Boolean;
FileStream: TFileStream;
InternetBuffer: TInternetBuffersA;
CallBackPointer: PFNInternetStatusCallback;

dwFileSize: Cardinal;
dwSize,: Cardinal;
I:Cardinal;

label
ToExit;

function GetHost(TheURL: string): String;
var
FURL: String;
begin
FURL := TheURL + '555';
if pos(UpperCase('http://'), UpperCase(FURL)) > 0 then
begin
Delete(FURL, 1, Length('http://'));
end;
Result := Copy(FURL, 1, pos('/', FURL) - 1);
end;

function GetURI():string;
var
s:String;
begin
S:=GetHost(URL) ;
Result := Copy(URL, pos(s, URL) + Length(s) + 1, MaxInt);
end;

begin
{Init the event}
ConnectEvent:=CreateEvent(nil,false,false,'ConnectEvent');
RequestCompleteEvent:=CreateEvent(nil,false,false,'RequestCompleteEvent');
RequestOpendEvent:= CreateEvent(nil,false,false,'requestOpen');

Session := InternetOpenA(PAnsiChar(AnsiString('NWSDownloader')),
INTERNET_OPEN_TYPE_PRECONFIG, niL, niL, INTERNET_FLAG_ASYNC);
if not Assigned(Session) then
goto ToExit;

CallBackPointer := @InternetStatusCallback;
CallBackPointer := InternetSetStatusCallback(Session, CallBackPointer);
if NativeInt(CallBackPointer) = INTERNET_INVALID_STATUS_CALLBACK then
raise Exception.Create('callback function is not valid');

ConnetHandle:=InternetConnectA(
Session,
PAnsiChar(AnsiString(GetHost(URL))),
INTERNET_DEFAULT_HTTP_PORT,
nil,
nil,
INTERNET_SERVICE_HTTP,
0,
1);
if not Assigned(ConnetHandle) then
begin
if GetLastError=ERROR_IO_PENDING then
WaitForSingleObject(ConnectEvent,INFINITE) //wait connection complete.
else
goto ToExit;
end;

RequestHandle:=HttpOpenRequestA(ConnetHandle,
PAnsiChar('GET'),
PAnsiChar(AnsiString(GetURI())),
nil,
nil,
nil,
INTERNET_FLAG_RELOAD or INTERNET_FLAG_NO_CACHE_WRITE,
2);
if not Assigned(RequestHandle) then
begin
if GetLastError=ERROR_IO_PENDING then
WaitForSingleObject(RequestOpendEvent,INFINITE) //wait connection complete.
else
goto ToExit;
end;

FHeader := AnsiString(Format(Header, [GetHost(URL)]));
if not HttpSendRequestA(RequestHandle,
PAnsiChar(FHeader),
SizeOf(AnsiChar)*Length(FHeader),
nil,
0)
then
if GetLastError<>ERROR_IO_PENDING then
Goto ToExit;

WaitForSingleObject(RequestCompleteEvent,INFINITE); //wait request complete.

//get Content-Length
dwFileSize:=0;
dwSize:= Sizeof(dwFileSize);
Reservered:=0;
HttpQueryInfoA(
RequestHandle,
HTTP_QUERY_CONTENT_LENGTH or HTTP_QUERY_FLAG_NUMBER,
@dwFileSize,
dwSize,Reservered
);

GetMem(Buffer, BufferSize);
ZeroMemory(@InternetBuffer,SizeOf(InternetBuffer));
FileStream := TFileStream.Create(SavePath, fmCreate);
dwReceived := 0;
I:=0;
TheExitCode:=0;
ShouldExit:=False;
try

while (True) do
begin
ZeroMemory(@InternetBuffer,SizeOf(InternetBuffer));
InternetBuffer.dwStructSize := SizeOf(InternetBuffer);
InternetBuffer.lpvBuffer := Buffer;
InternetBuffer.dwBufferLength := BufferSize;

ResetEvent(RequestCompleteEvent);
Reservered:=1;
BOK := InternetReadFileExA(RequestHandle, @InternetBuffer, IRF_NO_WAIT,
Reservered);
if BOK then
begin
Inc(I);
FileStream.Write(Buffer^, InternetBuffer.dwBufferLength);
ZeroMemory(Buffer, BufferSize);
dwReceived := dwReceived + InternetBuffer.dwBufferLength;
if I mod 3=0 then
ProgressCallBack(dwReceived, dwFileSize);
end
else
begin
if GetLastError=ERROR_IO_PENDING then
WaitForSingleObject(RequestCompleteEvent,INFINITE); //wait request complete.
end;
if (InternetBuffer.dwBufferLength=0) and(dwReceived=dwFileSize) then
Break;
if ShouldExit then
Break;
if CanExit then
begin
TheExitCode:=USER_EXIT_DOWNLOAD_PROCESS;
Break;
end;
end;
finally
FreeMem(Buffer);
FileStream.Free;
end;
InternetCloseHandle(RequestHandle);
InternetCloseHandle(ConnetHandle);
InternetSetStatusCallback(Session, nil);
InternetCloseHandle(Session);
FinishCallBack(TheExitCode);
Exit;
ToExit:
FinishCallBack(GetLastError);
Exit;
{$ENDIF}
end;

If you want to know much more about why the code should like this, you may visit the following website pages:

• Using WinInet HTTP functions in Full Asynchronous Mode
• SAMPLE: How to Use AsyncHTTP to Call WinInet APIs Asynchronously

转载于:https://www.cnblogs.com/neugls/archive/2011/11/10/2245041.html

• 点赞
• 收藏
• 分享
• 文章举报