この発言は
#00126　Satobe          さんのﾃﾞｨｽｸの空き容量を取得(2GB超HD対応)
に対するコメントです







  ２ヶ所ほどバグが発見されましたので、修正版をアップします。

uses
  Windows;

//===================================================================
// ドライブの全容量・空き容量を取得する
//     2GB超のハードディスクにも対応している（一部制限あり）
//-------------------------------------------------------------------
// Entry
//     RootPathName  'C:\' のように文字列で指定する
//     AllBytes      全容量が代入される
//     FreeBytes     空き容量が代入される
// 戻り値
//     GetDiskFreeSpace(Ex) API の戻り値をそのまま返す
//     False なら容量の取得に失敗したと判断すること
//===================================================================
function GetDiskFreeInfo(const RootPathName: String;
                     var AllBytes, FreeBytes: Extended): Boolean;
type
  TGetDiskFreeSpaceEx = function(const lpDirectoryName: PChar;
                             var lpFreeBytesAvailableToCaller,
                                 lpTotalNumberOfBytes,
                                 lpTotalNumberOfFreeBytes: Comp)
                                 : BOOL; stdcall;
var
  rc: Boolean;
  VerInfo: TOSVersionInfo;
  hLib: THandle;
  GetDiskFreeSpaceEx: TGetDiskFreeSpaceEx;
  CompFreeBytesToCaller,
  CompAllBytes,
  CompFreeBytes: Comp;
  lpSectorsPerCluster,
  lpBytesPerSector,
  lpNumberOfFreeClusters,
  lpTotalNumberOfClusters: Integer;
begin
  {これはなくてもいいと思いますが}
  FillChar(VerInfo, SizeOf(VerInfo), #0);
  VerInfo.dwOSVersionInfoSize := SizeOf(VerInfo);
  rc := GetVersionEx(VerInfo);
  {*}Assert(rc, 'GetVersionEx() Error!');
  //
  // Win95 ビルド番号チェックのバグを修正
  //
  if ((VerInfo.dwPlatformId = VER_PLATFORM_WIN32_NT)
      and (VerInfo.dwMajorVersion >= 4)) or          //NT4.0以降
     ((VerInfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS)
      and (VerInfo.dwMajorVersion > 4)) or           //Win98以降？
     ((VerInfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS)
      and (LoWord(VerInfo.dwBuildNumber) > 1000))    //Win95 OSR2
    then
    begin
      hLib := LoadLibrary(PChar('KERNEL32.DLL'));
      {*}Assert(hLib<>0, 'LoadLibrary("KERNEL32.DLL") Error!');
      try
        @GetDiskFreeSpaceEx := GetProcAddress(hLib,
                               PChar('GetDiskFreeSpaceExA'));
        {*}Assert(@GetDiskFreeSpaceEx<>nil,
                     'GetProcAddress("GetDiskFreeSpaceExA") Error');
      //ShowMessage('GetDiskFreeSpaceExA()を使います');
        Result := GetDiskFreeSpaceEx(PChar(RootPathName),
                                     CompFreeBytesToCaller,
                                     CompAllBytes,
                                     CompFreeBytes);
        if Result then begin
          AllBytes  := CompAllBytes;
          FreeBytes := CompFreeBytesToCaller;
        //FreeBytes := CompFreeBytes;
        end;
      finally
        FreeLibrary(hLib);
      end;
    end
  else
    begin
      Result := GetDiskFreeSpace(PChar(RootPathName),
                                 lpSectorsPerCluster,
                                 lpBytesPerSector,
                                 lpNumberOfFreeClusters,
                                 lpTotalNumberOfClusters);
      if Result then begin
        //
        // NTでGetDiskFreeSpaceを使うと、2GB超の答えが返る場合がある
        // その時、計算結果がマイナスになってしまうバグを修正
        //
        AllBytes  := lpTotalNumberOfClusters;
        AllBytes  := AllBytes
                   * lpSectorsPerCluster
                   * lpBytesPerSector;
        FreeBytes := lpNumberOfFreeClusters;
        FreeBytes := FreeBytes
                   * lpSectorsPerCluster
                   * lpBytesPerSector;
      end;
    end;
end;

  呼び出し方法は以前と同じです。

  ２ＧＢ超に関しては、ローカルディスクならば正常に動作します。
  ネットワークドライブの場合（使用ＯＳによっては）２ＧＢで切られて
  しまうことがあります。
  ※ Win95(4.00.950/4.00.950a）は２ＧＢ超のディスクにはＯＳが対応
     しておりません

  望月　俊男 様のご協力により、２ＧＢを超えるハードディスクでの
  動作テストが行われました。
  その結果、ネットワークドライブの場合に一部正常に動作しないこと
  （GetDiskFreeSpaceEx API が正しい値を返さない）が発見されました。

  ネットワークドライブ（２ＧＢ超ハードディスク）でのテスト結果を
  掲載いたします。

  Client      Server      使用API             ２ＧＢ超でのテスト結果
  =====================================================================
  NT WS3.51   NT SV3.51   GetDiskFreeSpace    ○
  Win95(OSR2) NT SV3.51   GetDiskFreeSpaceEx  ×（２ＧＢで切られる）
  NT WS3.51   NW SV       GetDiskFreeSpace    ○（約３ＧＢで確認）
  Win95(OSR2) NW SV       GetDiskFreeSpaceEx  ○（約３ＧＢで確認）
  ---------------------------------------------------------------------
  NT WS4.0    NT SV4.0    GetDiskFreeSpaceEx  未確認
  Win95(OSR2) NT SV4.0    GetDiskFreeSpaceEx  未確認
  =====================================================================
  ※ NT WS: NT WorkStation
     NT SV: NT Server
     NW SV: NetWare Server

  ※［未確認］部分は、２ＧＢ超の場合に正しい答えが取得できるのか
    どうか、テストできておりません。

  望月　俊男 様、動作テスト ありがとうございました。m(_ _)m
                                     97/11/17(月) 23:52 Satobe(JCG00336)

Original document by Satobe          氏 ID:(JCG00336)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。