WinInetを使ったHTTPでのファイルダウンロードについて

解決


Fusa  2004-12-05 07:47:20  No: 12107

別スレッドで出ていた
HTTPでのファイルダウンロードで
WinInetについて調べてみました。
FileStreamを使った保存方法はうまく動くのですが

AssigneFileを使って
TextFileやFileを指定して保存する方法がどうしてもうまくいきません。

メモリ確保や、ファイル書き込みバイトの
何かが間違っていると思いますが
わかりませんので、教えてください。

FileStreamを使った
WinInet_URLDownloadToFile3
WinInet_URLDownloadToFile4
は、正しく動作します。

型無しファイルを使った
WinInet_URLDownloadToFile1
は、微妙に時々のバイトが変になっています。

テキストファイルを使った
WinInet_URLDownloadToFile2
は、かなりのバイト数が変になります。

以下、ソースになります。長くてすいません。
function WinInet_URLDownloadToFile1(URL: String; FileName: String): Boolean;
var
  hSession, hService: HINTERNET;
  lpBuffer: PChar;
  dwBytesRead: DWORD;
  dwBytesAvailable: DWORD;

  fp: File;
  BufferStr: String;
begin
  Result := False;

  hSession := InternetOpen( 'MyApp', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0 ); try
  if Assigned( hSession ) then
  begin
    hService := InternetOpenUrl( hSession, PChar(URL), nil, 0, 0, 0); try
    if Assigned( hService ) then
    begin
      AssignFile(fp, FileName); try
      Rewrite(fp, 1);

      while true do
      begin
        dwBytesRead := 0;
        InternetQueryDataAvailable( hService, dwBytesAvailable, 0, 0 );
        GetMem(lpBuffer, dwBytesAvailable); try
        InternetReadFile( hService, lpBuffer, dwBytesAvailable, dwBytesRead );
        BufferStr := String(lpBuffer);
        BlockWrite(fp, PChar(BufferStr)^, Length(BufferStr) );
        if dwBytesRead = 0 then break;
        finally FreeMem(lpBuffer); end;
      end;

      finally CloseFile(fp); end;
      Result := True;
    end;
    finally InternetCloseHandle( hService ); end;
  end;
  finally InternetCloseHandle( hSession ); end;
end;

      
function WinInet_URLDownloadToFile2(URL: String; FileName: String): Boolean;
var
  hSession, hService: HINTERNET;
  lpBuffer: PChar;
  dwBytesRead: DWORD;
  fp: TextFile;
begin
  Result := False;

  hSession := InternetOpen( 'MyApp', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0 ); try
  if Assigned( hSession ) then
  begin
    hService := InternetOpenUrl( hSession, PChar(URL), nil, 0, 0, 0); try
    if Assigned( hService ) then
    begin
      AssignFile(fp, FileName); try
      Rewrite(fp);

      GetMem(lpBuffer, 1024); try
      while true do
      begin
        dwBytesRead := 0;
        InternetReadFile( hService, lpBuffer, 1024, dwBytesRead);
        Write(fp, lpBuffer: (dwBytesRead));
        if dwBytesRead = 0 then break;
      end;
      finally FreeMem(lpBuffer); end;

      finally CloseFile(fp); end;
      Result := True;
    end;
    finally InternetCloseHandle( hService ); end;
  end;
  finally InternetCloseHandle( hSession ); end;
end;

function WinInet_URLDownloadToStream1(URL: String; Stream: TStream): Boolean;
var
  hSession, hService: HINTERNET;
  lpBuffer: PChar;
  dwBytesRead: DWORD;
  dwBytesAvailable: DWORD;
begin
  Result := False;

  hSession := InternetOpen( 'MyApp', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0 ); try
  if Assigned( hSession ) then
  begin
    hService := InternetOpenUrl( hSession, PChar(URL), nil, 0, 0, 0); try
    if Assigned( hService ) then
    begin
      Stream.Position := 0;

      while true do
      begin
        InternetQueryDataAvailable( hService, dwBytesAvailable, 0, 0);
        GetMem(lpBuffer, dwBytesAvailable); try
        InternetReadFile( hService, lpBuffer, dwBytesAvailable, dwBytesRead);
        Stream.Write(lpBuffer^, dwBytesRead);
        if dwBytesRead = 0 then break;
        finally FreeMem(lpBuffer); end;
      end;

      Stream.Position := 0;
      Result := True;
    end;
    finally InternetCloseHandle( hService ); end;
  end;
  finally InternetCloseHandle( hSession ); end;
end;

function WinInet_URLDownloadToFile3(URL: String; FileName: String): Boolean;
var
  fs: TFileStream;
begin
  fs := TFileStream.Create(FileName, fmOpenWrite or fmCreate); try
  Result := WinInet_URLDownloadToStream1(URL, fs);
  finally fs.Free; end;
end;

function WinInet_URLDownloadToStream2(URL: String; Stream: TStream): Boolean;
var
  hSession, hService: HINTERNET;
  lpBuffer: PChar;
  dwBytesRead: DWORD;
begin
  Result := False;

  hSession := InternetOpen( 'MyApp', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0 ); try
  if Assigned( hSession ) then
  begin
    hService := InternetOpenUrl( hSession, PChar(URL), nil, 0, 0, 0); try
    if Assigned( hService ) then
    begin
      Stream.Position := 0;

      GetMem(lpBuffer, 1024); try
      while true do
      begin
        dwBytesRead := 0;
        InternetReadFile( hService, lpBuffer, 1024, dwBytesRead);
        if dwBytesRead = 0 then break;
        Stream.Write(lpBuffer^, dwBytesRead);
      end;
      finally FreeMem(lpBuffer); end;

      Stream.Position := 0;
      Result := True;
    end;
    finally InternetCloseHandle( hService ); end;
  end;
  finally InternetCloseHandle( hSession ); end;
end;

function WinInet_URLDownloadToFile4(URL: String; FileName: String): Boolean;
var
  fs: TFileStream;
begin
  fs := TFileStream.Create(FileName, fmOpenWrite or fmCreate); try
  Result := WinInet_URLDownloadToStream2(URL, fs);
  finally fs.Free; end;
end;

function DownloadFileName(URL: String): String;
begin
  Result := StringReplace(URL, 'http://',
    ExtractFilePath(Application.ExeName) + 'http\', [rfIgnorecase]);
  Result := StringReplace(Result, '/', '\', [rfReplaceAll]);
end;

procedure testWinInet_URLDownloadToFile;
var
  SaveFileName, SaveURL: String;
  WriteFileName1: String;
  WriteFileName2: String;
  WriteFileName3: String;
  WriteFileName4: String;
begin
  SaveURL := 'http://www.borland.co.jp/index.html';
  SaveFileName := DownloadFileName(SaveURL);
  ForceDirectories( ExtractFileDir( SaveFileName ));

  WriteFileName1 := ChangeFileExt(SaveFileName, '1.htm');
  WinInet_URLDownloadToFile1(SaveURL, WriteFileName1);

  WriteFileName2 := ChangeFileExt(SaveFileName, '2.htm');
  WinInet_URLDownloadToFile2(SaveURL, WriteFileName2);

  WriteFileName3 := ChangeFileExt(SaveFileName, '3.htm');
  WinInet_URLDownloadToFile3(SaveURL, WriteFileName3);

  WriteFileName4 := ChangeFileExt(SaveFileName, '4.htm');
  WinInet_URLDownloadToFile4(SaveURL, WriteFileName4);
end;


Fusa  2004-12-05 11:30:57  No: 12108

いろいろやっていたら解決できました。
TextFileではなく、Fileを使うといいようです。

WinInet_URLDownloadToFile1とWinInet_URLDownloadToFile2を
以下のように書きかえる正しく動作しています。

メモリ確保などが複雑な順番なので
間違っていましたらご指摘ください。

function WinInet_URLDownloadToFile1(URL: String; FileName: String): Boolean;
var
  hSession, hService: HINTERNET;
  lpBuffer: PChar;
  dwBytesRead: DWORD;
  dwBytesAvailable: DWORD;
  fp: File;
begin
  Result := False;

  hSession := InternetOpen( 'MyApp', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0 ); try
  if Assigned( hSession ) then
  begin
    hService := InternetOpenUrl( hSession, PChar(URL), nil, 0, 0, 0); try
    if Assigned( hService ) then
    begin
      AssignFile(fp, FileName); try
      Rewrite(fp, 1);

      while true do
      begin
        dwBytesRead := 0;
        InternetQueryDataAvailable( hService, dwBytesAvailable, 0, 0 );
        GetMem(lpBuffer, dwBytesAvailable); try
        InternetReadFile( hService, lpBuffer, dwBytesAvailable, dwBytesRead );
        BlockWrite(fp, lpBuffer^, dwBytesRead );
        if dwBytesRead = 0 then break;
        finally FreeMem(lpBuffer); end;
      end;

      finally CloseFile(fp); end;
      Result := True;
    end;
    finally InternetCloseHandle( hService ); end;
  end;
  finally InternetCloseHandle( hSession ); end;
end;

function WinInet_URLDownloadToFile2(URL: String; FileName: String): Boolean;
var
  hSession, hService: HINTERNET;
  lpBuffer: PChar;
  dwBytesRead: DWORD;
  fp: File;
begin
  Result := False;

  hSession := InternetOpen( 'MyApp', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0 ); try
  if Assigned( hSession ) then
  begin
    hService := InternetOpenUrl( hSession, PChar(URL), nil, 0, 0, 0); try
    if Assigned( hService ) then
    begin
      AssignFile(fp, FileName); try
      Rewrite(fp, 1);

      GetMem(lpBuffer, 1024); try
      while true do
      begin
        dwBytesRead := 0;
        InternetReadFile( hService, lpBuffer, 1024, dwBytesRead);
        BlockWrite(fp, lpBuffer^, dwBytesRead );
        if dwBytesRead = 0 then break;
      end;
      finally FreeMem(lpBuffer); end;

      finally CloseFile(fp); end;
      Result := True;
    end;
    finally InternetCloseHandle( hService ); end;
  end;
  finally InternetCloseHandle( hSession ); end;
end;


※返信する前に利用規約をご確認ください。

※Google reCAPTCHA認証からCloudflare Turnstile認証へ変更しました。






  このエントリーをはてなブックマークに追加