Программы   Загрузка Партнерство   О компании Контакты  
 
                    
  Карта Сайта   
   





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

Автор: 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;
           




Программы  |  Загрузка  |  Партнерство  |  О компании  |  Контакты

Copyright © LSD Software 2006 - 2011