Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
Разработка программного обеспечения
KANSoftWare

Получить объем диска и его свободного места

Delphi , Файловая система , Диски

Получить объем диска и его свободного места

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

{ 
  * Place a Button1 and DriveComboBox1 on your form. 
  * The function "SetCurrentDir" well be true if the disk in drive 
  * The procedure "GetDiskFreeSpaceEx" returns the free and total disk size 
}

 uses
   SysUtils;

 implementation

 function GetDiskSize(drive: Char; var free_size, total_size: Int64): Boolean;
 var
   RootPath: array[0..4] of Char;
   RootPtr: PChar;
   current_dir: string;
 begin
   RootPath[0] := Drive;
   RootPath[1] := ':';
   RootPath[2] := '\';
   RootPath[3] := #0;
   RootPtr := RootPath;
   current_dir := GetCurrentDir;
   if SetCurrentDir(drive + ':\') then
   begin
     GetDiskFreeSpaceEx(RootPtr, Free_size, Total_size, nil);
     // this to turn back to original dir 
    SetCurrentDir(current_dir);
     Result := True;
   end
   else
   begin
     Result := False;
     Free_size  := -1;
     Total_size := -1;
   end;
 end;


 procedure TForm1.Button1Click(Sender: TObject);
 var
   free_size, total_size: Int64;
 begin
   if GetDiskSize(DriveComboBox1.Drive, free_size, total_size) then
     ShowMessage('free space =' +
       IntToStr(free_size) + #13 + 'total size=' +
       IntToStr(total_size))
   else
     ShowMessage('No disk in drive!');
 end;

Статья Получить объем диска и его свободного места раздела Файловая система Диски может быть полезна для разработчиков на Delphi и FreePascal.


Комментарии и вопросы


Ваше мнение или вопрос к статье в виде простого текста (Tag <a href=... Disabled). Все комментарии модерируются, модератор оставляет за собой право удалить непонравившейся ему комментарий.

заголовок

e-mail

Ваше имя

Сообщение

Введите код




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.



:: Главная :: Диски ::


реклама

::


©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru Rambler's Top100
13.08.2020 06:25:24/0.074748039245605/0