Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Низкоуровневое программирование > Win Api
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 02.06.2016, 12:00   #1
grh
Пользователь
 
Регистрация: 24.09.2010
Сообщений: 35
По умолчанию Delphi 2010, WinAPI-функция GetDiskFreeSpaceEx

Всем привет. У меня такая проблема:
Необходимо вывести информацию о диске 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'.

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

Последний раз редактировалось grh; 02.06.2016 в 12:03.
grh вне форума Ответить с цитированием
Старый 02.06.2016, 12:18   #2
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

Цитата:
Код:
lpRootPathName:=StringToOleStr('C:\');
попробуйте заменить на:
Код:
lpRootPathName := 'C:\';
Serge_Bliznykov вне форума Ответить с цитированием
Старый 02.06.2016, 12:20   #3
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

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

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;
Serge_Bliznykov вне форума Ответить с цитированием
Старый 02.06.2016, 12:32   #4
grh
Пользователь
 
Регистрация: 24.09.2010
Сообщений: 35
По умолчанию

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

Цитата:
ShowMessage('Диск С:'+#13#10+
grh вне форума Ответить с цитированием
Старый 02.06.2016, 13:29   #5
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

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;

Последний раз редактировалось Serge_Bliznykov; 02.06.2016 в 13:38.
Serge_Bliznykov вне форума Ответить с цитированием
Старый 02.06.2016, 16:34   #6
grh
Пользователь
 
Регистрация: 24.09.2010
Сообщений: 35
По умолчанию

Код:
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'
grh вне форума Ответить с цитированием
Старый 02.06.2016, 16:39   #7
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

а так?

Код:
  if not Windows.GetDiskFreeSpaceEx(lpRootPathName,@lpFreeBytesAvailable,
  @lpTotalNumberOfBytes, @lpTotalNumberOfFreeBytes) then
  begin
Serge_Bliznykov вне форума Ответить с цитированием
Старый 02.06.2016, 17:26   #8
grh
Пользователь
 
Регистрация: 24.09.2010
Сообщений: 35
По умолчанию

Код:
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
grh вне форума Ответить с цитированием
Старый 02.06.2016, 17:59   #9
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

ну, тогда, извините, я - пас.
Тогда берите свой первоначальный вариант и проходите в отладчике пошагово!
Serge_Bliznykov вне форума Ответить с цитированием
Старый 02.06.2016, 18:06   #10
Аватар
Старожил
 
Аватар для Аватар
 
Регистрация: 17.11.2010
Сообщений: 19,042
По умолчанию

Для 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;
Если бы архитекторы строили здания так, как программисты пишут программы, то первый залетевший дятел разрушил бы цивилизацию
Аватар вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
GetDiskFreeSpaceEx, ошибка в определении объёма. Диман56 Общие вопросы C/C++ 6 06.03.2013 10:51
Функция WINAPI WinMain apeorin Общие вопросы C/C++ 11 14.12.2012 20:20
Использование функций WinApi в VS 2010 Lazio Win Api 4 05.09.2012 18:16
использование WinApi в VS 2010 Denis83 Помощь студентам 2 23.08.2012 10:31
Delphi: winAPI функция DlgDirListComboBox Ни могу понять... excorsist Помощь студентам 2 22.03.2010 14:56