{ -----------------------------------
WinInetを利用するユニット
2004/12/31
  作成
//----------------------------------- }
unit WinInetUnit;

interface

uses
  SysUtils, //fmOpenRead
  Types,    //DWORD
  Classes,  //TStream
  Forms,    //Application
  WinInet,
  StringUnitHeavy,  //LoadStringFromFile
  XPtest;

function WinInet_URLDownloadToFile1(URL: String; FileName: String): Boolean;
function WinInet_URLDownloadToFile2(URL: String; FileName: String): Boolean;
function WinInet_URLDownloadToFile3(URL: String; FileName: String): Boolean;
function WinInet_URLDownloadToFile4(URL: String; FileName: String): Boolean;
function WinInet_URLDownloadToStream1(URL: String; Stream: TStream): Boolean;
function WinInet_URLDownloadToStream2(URL: String; Stream: TStream): Boolean;


implementation

//テキストファイルに対してURLから一気に読み込みます
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;

//テキストファイルに対してURLから徐々に読み込みます
//1024バイト毎にファイルを取得してファイルに書き込んでいます
//使用メモリは少ないような気がする。
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;


//ストリームに対してURLから一気に読み込みます
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;


//ストリームに対してURLから徐々に読み込みます
//1024バイト毎にファイルを取得してファイルに書き込んでいます
//使用メモリは少ないような気がする。
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;

//同一の内容のテキストファイルかどうかを調べます。
//デバッグ用に使います。
//LoadStringFromFileはファイルを文字列として返す関数
function SameTextFile(F1, F2: String): Boolean;
var
  S1, S2: String;
begin
  Result := False;
  if (not FileExists(F1)) or (not FileExists(F2)) then
    Exit;

  S1 := LoadStringFromFile(F1);
  S2 := LoadStringFromFile(F2);
  if S1 = S2 then Result := True;
end;

//同一の内容のバイナリファイルかどうか調べます
//デバッグ用に使います。
function SameBinaryFile(F1, F2: String): Boolean;
var
  FS1, FS2: TFileStream;
    buf1, buf2: array[0..4095] of Char;
    n1, n2: Integer;
begin
  Result := False;
  if (not FileExists(F1)) or (not FileExists(F2)) then
    Exit;

  FS1 := TFileStream.Create(F1, fmOpenRead); try
  FS2 := TFileStream.Create(F2, fmOpenRead); try

      repeat
        n1 := fs1.Read(buf1, 4096);
        n2 := fs2.Read(buf2, 4096);
        if (n1 = n2) and (n1 > 0) and
           not CompareMem(@buf1, @buf2, n1) then
          Exit;
      until (n1 <> n2) or (n1 < 4096) or (n2 < 4096);
      if n1 = n2 then Result := True;

  finally FS2.Free; end;
  finally FS1.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.html');
  DeleteFile(WriteFileName1);
  Check(True, WinInet_URLDownloadToFile1(SaveURL, WriteFileName1));

  WriteFileName2 := ChangeFileExt(SaveFileName, '2.html');
  DeleteFile(WriteFileName2);
  Check(True, WinInet_URLDownloadToFile2(SaveURL, WriteFileName2));

  WriteFileName3 := ChangeFileExt(SaveFileName, '3.html');
  DeleteFile(WriteFileName3);
  Check(True, WinInet_URLDownloadToFile3(SaveURL, WriteFileName3));

  WriteFileName4 := ChangeFileExt(SaveFileName, '4.html');
  DeleteFile(WriteFileName4);
  Check(True, WinInet_URLDownloadToFile4(SaveURL, WriteFileName4));

  Check(True, SameTextFile(WriteFileName1, WriteFileName2));
  Check(True, SameTextFile(WriteFileName2, WriteFileName3));
  Check(True, SameTextFile(WriteFileName3, WriteFileName4));

  //画像やフラッシュやExe/lzh/zipファイルのURLを指定してください
  SaveURL := 'http://www.geocities.jp/flashgame_zone/_geo_contents_/cubev100.swf';
  SaveFileName := DownloadFileName(SaveURL);
  ForceDirectories( ExtractFileDir( SaveFileName ));

  WriteFileName1 := ChangeFileExt(SaveFileName, '1.swf');
  DeleteFile(WriteFileName1);
  Check(True, WinInet_URLDownloadToFile1(SaveURL, WriteFileName1));

  WriteFileName2 := ChangeFileExt(SaveFileName, '2.swf');
  DeleteFile(WriteFileName2);
  Check(True, WinInet_URLDownloadToFile2(SaveURL, WriteFileName2));

  WriteFileName3 := ChangeFileExt(SaveFileName, '3.swf');
  DeleteFile(WriteFileName3);
  Check(True, WinInet_URLDownloadToFile3(SaveURL, WriteFileName3));

  WriteFileName4 := ChangeFileExt(SaveFileName, '4.swf');
  DeleteFile(WriteFileName4);
  Check(True, WinInet_URLDownloadToFile4(SaveURL, WriteFileName4));

  Check(True, SameBinaryFile(WriteFileName1, WriteFileName2));
  Check(True, SameBinaryFile(WriteFileName2, WriteFileName3));
  Check(True, SameBinaryFile(WriteFileName3, WriteFileName4));


  //違うファイルがあるところに上書きが成功しているかどうかを調査
  //0の大きさのファイルが新規作成できるかどうか調査
  //0の大きさのファイルが上書きされるかどうか調査
  //回線が接続されていない場合の例外が正しく出ることを確認
end;

//直接、文字列を取得する場合下記のようにするとよい
//
//function GetStringFromStream(Stream: TStream): String;
//begin
//  SetLength(Result, Stream.Size);
//  Stream.Position := 0;
//
//  Stream.ReadBuffer(Result[1], Stream.Size);
//end;
//
//procedure TForm1.Button5Click(Sender: TObject);
//var
//  SaveFileName, SaveURL: String;
//  ms: TMemoryStream;
//begin
//  SaveURL := Edit1.Text;
//
//  ms := TMemoryStream.Create;
//
//  WinInet_URLDownloadToStream1(SaveURL, ms);
//
//  ShowMessage(GetStringFromStream(ms));
//  ms.Free;
//end;

end.