设为首页收藏本站新闻投稿

MOD中国同盟社

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 959|回复: 0

[原创] 2种Api下载文件的例子[WinInet or Socket] For Delphi [复制链接]

Rank: 3Rank: 3

帖子
195
精华
0
声望
762 点
金币
155 Mold
被赞许
0 次
注册时间
2009-7-3
发表于 2011-1-12 06:23:18 |显示全部楼层
Socket版 代码太长打包
  1. // 很久很久以前写的WinInet版

  2. function FileSize(SizeInBytes: dword): string;  
  3. const
  4.   Formats: array[0..3] of string =  (' Bytes', ' KB', ' MB', ' GB');  
  5.   FormatSpecifier: array[Boolean] of string = ('%n', '%.2n');  
  6. var  
  7.   iLoop: integer;  
  8.   TempSize: Real;  
  9. begin  
  10.   iLoop := -1;  
  11.   TempSize := SizeInBytes;  
  12.   while (iLoop <= 3) do
  13.   begin  
  14.     TempSize := TempSize / 1024;  
  15.     inc(iLoop);  
  16.     if Trunc(TempSize) = 0 then  
  17.     begin  
  18.       TempSize := TempSize * 1024;  
  19.       Break;  
  20.     end;  
  21.   end;  
  22.   Result := Format(FormatSpecifier[((Frac(TempSize)*10) > 1)], [TempSize]);  
  23.   if Copy(Result, Length(Result) - 2, 3) = '.00' then  
  24.     Result := Copy(Result, 1, Length(Result) - 3);  
  25.   Result := Result + Formats[iLoop];  
  26. end;  

  27. function ExtractURLSite(FileName: string): string;  
  28. begin  
  29.   Result := Copy(FileName, 1, Pos('/', FileName) - 1);  
  30. end;  

  31. function ExtractURLPath(FileName: string): string;  
  32. begin  
  33.   Result := Copy(FileName, Pos('/', FileName), Length(FileName) - Pos('/', FileName) + 1);  
  34. end;  

  35. function Split(Input: string; Deliminator: string; Index: integer): string;  
  36. var  
  37.   StringLoop, StringCount: integer;  
  38.   Buffer: string;  
  39. begin  
  40.   Buffer := '';  
  41.   if Index < 1 then Exit;  
  42.   StringCount := 0;  
  43.   StringLoop := 1;  
  44.   while (StringLoop <= Length(Input)) do
  45.   begin  
  46.     if (Copy(Input, StringLoop, Length(Deliminator)) = Deliminator) then  
  47.     begin  
  48.       Inc(StringLoop, Length(Deliminator) - 1);  
  49.       Inc(StringCount);  
  50.       if StringCount = Index then  
  51.       begin  
  52.         Result := Buffer;  
  53.         Exit;  
  54.       end  
  55.       else
  56.       begin  
  57.         Buffer := '';  
  58.       end;  
  59.     end  
  60.     else
  61.     begin  
  62.       Buffer := Buffer + Copy(Input, StringLoop, 1);  
  63.     end;  
  64.     Inc(StringLoop, 1);  
  65.   end;  
  66.   Inc(StringCount);  
  67.   if StringCount < Index then Buffer := '';  
  68.   Result := Buffer;  
  69. end;  

  70. function ThreadProc(lpParam: Pointer): DWORD; stdcall;  
  71. const
  72.   BufferSize = 1024;  
  73.   Agent = 'Internet Explorer 9.9';  
  74. var  
  75.   Session, Connect, Resource, OpenUrl: HINTERNET;  
  76.   Buffer: array[1..BufferSize] of Byte;  
  77.   BufferLen: DWORD;  
  78.   f: File;  
  79.   FileSize, ReseRved, _SizeOf, ReadSize:DWORD;  
  80.   UrlFile, FileName, Site, URL, Location: string;  
  81. begin  
  82. FileName:= 'c:\x.exe';  
  83. Result:=0;  
  84. UrlFile := 'http://xxxxxxxxxxxx/xxxxxxx.exe';  
  85. Location := Split(UrlFile, '://', 2);  
  86. URL := ExtractURLPath(Location);  
  87. Site := ExtractURLSite(Location);  
  88. Session := InternetOpenA(PAnsiChar(Agent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);  
  89. if Assigned(Session) then  
  90. begin  
  91.   try
  92.    Connect := InternetConnectA(Session, PAnsiChar(Site), INTERNET_DEFAULT_HTTP_PORT, nil, nil, INTERNET_SERVICE_HTTP, 0, 0);  
  93.    if  Assigned(Connect) then  
  94.    begin  
  95.     try
  96.      Resource := HttpOpenRequestA(Connect, 'HEAD', PChar(URL), nil, nil, nil, 0, 0);  
  97.      if Assigned(Resource) then  
  98.      begin  
  99.       try
  100.        if HttpSendRequestA(Resource, nil, 0, nil, 0) then  
  101.        begin  
  102.         _SizeOf := SizeOf(FileSize);
  103.         ReseRved := 0;  
  104.         FileSize := 0;  
  105.         ReadSize := 0;  
  106.         if (HttpQueryInfoA(Resource, HTTP_QUERY_CONTENT_LENGTH or HTTP_QUERY_FLAG_NUMBER, @FileSize, _SizeOf, ReseRved)) and (FileSize <> 0) then  
  107.         begin  
  108.          try
  109.           OpenUrl := InternetOpenUrlA(Session, PAnsiChar(UrlFile),  nil,0,0,0);  
  110.           if Assigned(OpenUrl) then  
  111.           begin  
  112.           try
  113.            AssignFile(f, FileName);  
  114.            Rewrite(f,1);  
  115.            repeat  
  116.             if InternetReadFile(OpenUrl, @Buffer,SizeOf(Buffer), BufferLen) then  
  117.             begin  
  118.              BlockWrite(f, Buffer, BufferLen);  
  119.              Inc(ReadSize,BufferLen);  
  120.              Form1.SkinGauge.Value:=ReadSize;  
  121.             end;  
  122.            until BufferLen = 0;  
  123.            CloseFile(f);  
  124.           finally  
  125.             InternetCloseHandle(OpenUrl)  
  126.           end  
  127.           end;  
  128.          finally  
  129.          end;  
  130.         end;  
  131.        end;  
  132.       finally  
  133.        InternetCloseHandle(Resource)  
  134.       end;  
  135.      end;  
  136.     finally  
  137.      InternetCloseHandle(Connect)  
  138.     end;  
  139.    end;  
  140.   finally  
  141.    InternetCloseHandle(Session)  
  142.   end;  
  143. end;  
  144. end;  

  145. procedure TForm1.Button1Click(Sender: TObject);  
  146. var  
  147.   ID: DWORD;  
  148. begin  
  149. CreateThread(nil, 0, @ThreadProc, nil, 0, ID);  
  150. end;
复制代码
附件: 你需要登录才可以下载或查看附件。没有帐号?注册

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

回顶部