博客
关于我
强烈建议你试试无所不能的chatGPT,快点击我
用Wininet来下载文件
阅读量:4992 次
发布时间:2019-06-12

本文共 7525 字,大约阅读时间需要 25 分钟。

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;implementationuses {$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;

转载于:https://www.cnblogs.com/luckyso999/archive/2011/11/24/2261586.html

你可能感兴趣的文章
根据控件名称反射查找控件
查看>>
编写和执行C#代码的插件:CS-Script for Notepad++
查看>>
BZOJ3569: DZY Loves Chinese II(线性基构造)
查看>>
Android系统源码下载及使用(Android 14到19源码)
查看>>
绑定dropdownlist
查看>>
[LeetCode] Sudoku Solver
查看>>
实验四
查看>>
Python Day04
查看>>
Android新增API之AudioEffect中文API与应用实例
查看>>
颜色空间RGB与HSV(HSL)的转换
查看>>
swift 用协议实现代理传值功能
查看>>
深入懂得android view 生命周期
查看>>
android.widget.FrameLayout$LayoutParams cannot be cast to android.widget.LinearLayout$LayoutParams
查看>>
Android 中 更新视图的函数ondraw() 和dispatchdraw()的区别
查看>>
《Java源码解析》之NIO的Selector机制(Part1:Selector.open())
查看>>
webpack安装问题
查看>>
Qt学习记录--Qt::CaseSensitive
查看>>
你的灯还亮着吗阅读笔记之一
查看>>
python介绍
查看>>
Unity-Editor按钮和菜单显示
查看>>