Delphi 2010, WinAPI-функция GetDiskFreeSpaceEx

[grh]

Всем привет. У меня такая проблема:
Необходимо вывести информацию о диске C:\ с помощью WinAPI-функции GetDiskFreeSpaceEx. Имеется следующий программный код:

procedure TForm1.Button1Click(Sender: TObject);
var
  lpRootPathName:PChar;
  lpFreeBytesAvailable:PLargeInteger;
  lpTotalNumberOfBytes:PLargeInteger;
  lpTotalNumberOfFreeBytes:PLargeInteger;
begin
  new(lpFreeBytesAvailable);
  new(lpTotalNumberOfBytes);
  new(lpTotalNumberOfFreeBytes);
  lpRootPathName:=StringToOleStr('C:\');
  if not Windows.GetDiskFreeSpaceEx(lpRootPathName,lpFreeBytesAvailable,
  lpTotalNumberOfBytes,lpTotalNumberOfFreeBytes) then
  begin
    lpFreeBytesAvailable^:=0;
    lpTotalNumberOfBytes^:=0;
    lpTotalNumberOfFreeBytes^:=0;
  end;
  ShowMessage('Диск С:'+#13#10+
  'lpFreeBytesAvailable = '+inttostr(lpFreeBytesAvailable^)+#13#10+
  'lpTotalNumberOfBytes = '+inttostr(lpTotalNumberOfBytes^)+#13#10+
  'lpTotalNumberOfFreeBytes = '+inttostr(lpTotalNumberOfFreeBytes^))
end;

После запуска программы и нажатия кнопки Button1 на экране появляется сообщение об ошибке:

Project Project1.exe raised exception class EAccessViolation with message 'Access violation at address 004B3465 in module 'Project1.exe'. Read of address 00000008'.

Как исправить ошибку, подскажите пожалуйста.

[Serge_Bliznykov]

lpRootPathName:=StringToOleStr('C:\');

попробуйте заменить на:

lpRootPathName := 'C:\';

[Serge_Bliznykov]

а ещё попробуйте пример на оффсайте

http://community.embarcadero.com/art...n-large-drives

function GetDiskFreeSpaceEx(lpDirectoryName: PAnsiChar;
  var lpFreeBytesAvailableToCaller : Integer;
  var lpTotalNumberOfBytes: Integer;
  var lpTotalNumberOfFreeBytes: Integer) : bool;
  stdcall;
  external kernel32
  name 'GetDiskFreeSpaceExA';


procedure GetDiskSizeAvail(TheDrive : PChar;
                           var TotalBytes : double;
                           var TotalFree : double);
var
  AvailToCall : integer;
  TheSize : integer;
  FreeAvail : integer;
begin
  GetDiskFreeSpaceEx(TheDrive,
                     AvailToCall,
                     TheSize,
                     FreeAvail);
{$IFOPT Q+}
 {$DEFINE TURNOVERFLOWON}
 {$Q-}
{$ENDIF}
  if TheSize >= 0 then
    TotalBytes := TheSize else
  if TheSize = -1 then begin
    TotalBytes := $7FFFFFFF;
    TotalBytes := TotalBytes * 2;
    TotalBytes := TotalBytes + 1;
  end else
  begin
    TotalBytes := $7FFFFFFF;
    TotalBytes := TotalBytes + abs($7FFFFFFF - TheSize);
  end;

  if AvailToCall >= 0 then
    TotalFree := AvailToCall else
  if AvailToCall = -1 then begin
    TotalFree := $7FFFFFFF;
    TotalFree := TotalFree * 2;
    TotalFree := TotalFree + 1;
  end else
  begin
    TotalFree := $7FFFFFFF;
    TotalFree := TotalFree + abs($7FFFFFFF - AvailToCall);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  TotalBytes : double;
  TotalFree : double;
begin
  GetDiskSizeAvail('C:\',
                   TotalBytes,
                   TotalFree);
  ShowMessage(FloatToStr(TotalBytes));
  ShowMessage(FloatToStr(TotalFree));
end;

[grh]

Ошибка возникает в строке:

ShowMessage('Диск С:'+#13#10+

[Serge_Bliznykov]

grh, посмотрите в отладчике, что возвращает вызов функции и что в переменных.
А Вы пример, который я выложил попробовали? Он работает?


а если переписать код без указателей?
просто учитывая, что в Delphi

 PLargeInteger = ^TLargeInteger;
 TLargeInteger = Int64;

такой код что выдаёт?

procedure TForm1.Button1Click(Sender: TObject);
var
  lpRootPathName:PChar;
  lpFreeBytesAvailable,  lpTotalNumberOfBytes, lpTotalNumberOfFreeBytes:int64;
begin
  lpRootPathName:='C:\';
  if not Windows.GetDiskFreeSpaceEx(lpRootPathName,lpFreeBytesAvailable,
  lpTotalNumberOfBytes,lpTotalNumberOfFreeBytes) then
  begin
    lpFreeBytesAvailable:=0;
    lpTotalNumberOfBytes:=0;
    lpTotalNumberOfFreeBytes:=0;
  end;
  ShowMessage('Диск С:'+#13#10+
  'lpFreeBytesAvailable = '+inttostr(lpFreeBytesAvailable)+#13#10+
  'lpTotalNumberOfBytes = '+inttostr(lpTotalNumberOfBytes)+#13#10+
  'lpTotalNumberOfFreeBytes = '+inttostr(lpTotalNumberOfFreeBytes))
end;

[grh]

function GetDiskFreeSpaceEx(lpDirectoryName: PAnsiChar;
  var lpFreeBytesAvailableToCaller : Integer;
  var lpTotalNumberOfBytes: Integer;
  var lpTotalNumberOfFreeBytes: Integer) : bool;
  stdcall;
  external kernel32
  name 'GetDiskFreeSpaceExA';


procedure GetDiskSizeAvail(TheDrive : PChar;
                           var TotalBytes : double;
                           var TotalFree : double);
var
  AvailToCall : integer;
  TheSize : integer;
  FreeAvail : integer;
begin
  GetDiskFreeSpaceEx(TheDrive,
                     AvailToCall,
                     TheSize,
                     FreeAvail);
{$IFOPT Q+}
 {$DEFINE TURNOVERFLOWON}
 {$Q-}
{$ENDIF}
  if TheSize >= 0 then
    TotalBytes := TheSize else
  if TheSize = -1 then begin
    TotalBytes := $7FFFFFFF;
    TotalBytes := TotalBytes * 2;
    TotalBytes := TotalBytes + 1;
  end else
  begin
    TotalBytes := $7FFFFFFF;
    TotalBytes := TotalBytes + abs($7FFFFFFF - TheSize);
  end;

  if AvailToCall >= 0 then
    TotalFree := AvailToCall else
  if AvailToCall = -1 then begin
    TotalFree := $7FFFFFFF;
    TotalFree := TotalFree * 2;
    TotalFree := TotalFree + 1;
  end else
  begin
    TotalFree := $7FFFFFFF;
    TotalFree := TotalFree + abs($7FFFFFFF - AvailToCall);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  TotalBytes : double;
  TotalFree : double;
begin
  GetDiskSizeAvail('C:\',
                   TotalBytes,
                   TotalFree);
  ShowMessage(FloatToStr(TotalBytes));
  ShowMessage(FloatToStr(TotalFree));
end;

слишком сложный, по-моему задача должна решаться проще.

procedure TForm1.Button1Click(Sender: TObject);
var
  lpRootPathName:PChar;
  lpFreeBytesAvailable,  lpTotalNumberOfBytes, lpTotalNumberOfFreeBytes:int64;
begin
  lpRootPathName:='C:\';
  if not Windows.GetDiskFreeSpaceEx(lpRootPathName,lpFreeBytesAvailable,
  lpTotalNumberOfBytes,lpTotalNumberOfFreeBytes) then
  begin
    lpFreeBytesAvailable:=0;
    lpTotalNumberOfBytes:=0;
    lpTotalNumberOfFreeBytes:=0;
  end;
  ShowMessage('Диск С:'+#13#10+
  'lpFreeBytesAvailable = '+inttostr(lpFreeBytesAvailable)+#13#10+
  'lpTotalNumberOfBytes = '+inttostr(lpTotalNumberOfBytes)+#13#10+
  'lpTotalNumberOfFreeBytes = '+inttostr(lpTotalNumberOfFreeBytes))
end;

выдает ошибку на этапе компиляции:

[DCC Error] Unit1.pas(59): E2010 Incompatible types: 'PLargeInteger' and 'Int64'

[Serge_Bliznykov]

а так?

  if not Windows.GetDiskFreeSpaceEx(lpRootPathName,@lpFreeBytesAvailable,
  @lpTotalNumberOfBytes, @lpTotalNumberOfFreeBytes) then
  begin

[grh]

procedure TForm1.Button1Click(Sender: TObject);
var
  lpRootPathName:PChar;
  lpFreeBytesAvailable,  lpTotalNumberOfBytes, lpTotalNumberOfFreeBytes:int64;
begin
  lpRootPathName:='C:\';
  if not Windows.GetDiskFreeSpaceEx(lpRootPathName,@lpFreeBytesAvailable,
  @lpTotalNumberOfBytes,@lpTotalNumberOfFreeBytes) then
  begin
    lpFreeBytesAvailable:=0;
    lpTotalNumberOfBytes:=0;
    lpTotalNumberOfFreeBytes:=0;
  end;
  ShowMessage('Диск С:'+#13#10+
  'lpFreeBytesAvailable = '+inttostr(lpFreeBytesAvailable)+#13#10+
  'lpTotalNumberOfBytes = '+inttostr(lpTotalNumberOfBytes)+#13#10+
  'lpTotalNumberOfFreeBytes = '+inttostr(lpTotalNumberOfFreeBytes))
end;

выдает ошибку на этапе компиляции:

[DCC Error] Unit1.pas(60): E2197 Constant object cannot be passed as var parameter

[Serge_Bliznykov]

ну, тогда, извините, я - пас.
Тогда берите свой первоначальный вариант и проходите в отладчике пошагово!

[Аватар]

Для XE2 и D7 все Ok

var FreeAvailable, TotalSpace, TotalFree: TLargeInteger;
    PTotalFree: PLargeInteger ;
begin
  PTotalFree:=Addr(TotalFree);
  GetDiskFreeSpaceEx('d:\',FreeAvailable, TotalSpace, PTotalFree);
  Edit1.Text:=IntToStr(FreeAvailable);
  Edit2.Text:=IntToStr(TotalSpace);
  Edit3.Text:=IntToStr(TotalFree);
end;