![]()  | 
	
 
  | 
		
			
  | 	
	
	
		
		|||||||
| Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны | 
![]()  | 
	
	
| 
		 | 
	Опции темы | Поиск в этой теме | Опции просмотра | 
| 
		 
			 
			#1  
			
			
			
			
		 
		
		
	 | 
||||
		
		
  | 
||||
| 
	
	
		
			
			 Как узнать свободное и занятое место на определленном диске - и отображать не с байтами а Кб, Мб, Гб, Тбайтами?????? 
		
	
		
		
		
		
		
	
		
		
	
	
	Заранее благодарю!!  | 
| 
		 
			 
			#2  
			
			
			
			
		 
		
		
	 | 
||||
		
		
  | 
||||
| 
	
	
		
			
			 Если что - 1 Тб - 1024 Гб. 
		
	
		
		
		
		
			
		
		
		
		
		
			Код: 
	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;Последний раз редактировалось Winny, 26.09.2007 в 10:19.  | 
| 
		 
			 
			#3  
			
			
			
			
		 
		
		
	 | 
||||
		
		
  | 
||||
| 
	
	
		
			
			 А потом получившееся число можно перевести в Терра Байты 
		
	
		
		
		
		
			
		
		
		
		
	
		
		
	
	
	 | 
| 
		 
			 
			#4  
			
			
			
			
		 
		
		
	 | 
||||
		
		
  | 
||||
| 
	
	
		
			
			 В том то и дело что у мя не получаеться перевести полученное на Гб или в Мб -ты 
		
	
		
		
		
		
		
		
			и еще нелзяли без сомбобох драйва - у мя уже диск выбран С:\ типа так Код: 
	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);
  label1.Caption:='Îáøèé = '+(FloatToStr(TotalBytes));
  label2.Caption:='Ñâîáîäíî = '+(FloatToStr(TotalFree));
end;Последний раз редактировалось Electronic_Arts, 25.09.2007 в 21:31.  | 
| 
		 
			 
			#5  
			
			
			
			
		 
		
		
	 | 
||||
		
		
  | 
||||
| 
	
	
		
			
			 Цитата: 
	
  | 
| 
		 
			 
			#6  
			
			
			
			
		 
		
		
	 | 
||||
		
		
  | 
||||
| 
	
	
		
			
			 Обоже - да вы вообще читаете что я пишу - как перевести дайте какой нить исходник у меня не получаеться 
		
	
		
		
		
		
		
	
		
		
	
	
	 | 
| 
		 
			 
			#7  
			
			
			
			
		 
		
		
	 | 
||||
		
		
  | 
||||
| 
	
	
		
			
			 Вот, не парься: 
		
	
		
		
		
		
			
		
		
		
		
		
			Код: 
	function GetFreeDriveSpace(sDriveLetter, sSizeType: String): Int64;
const
  CharString: String[26] = 'abcdefghijklmnopqrstuvwxyz';
var
  FreeBytesAvailableToCaller: Int64;
  FreeSize:                   Int64;
  TotalSize:                  Int64;
  btCounter:                  Byte;
  bContain:                   Boolean;
begin
  Result := 0;
  sDriveLetter := LowerCase(sDriveLetter);
  SetLength(sDriveLetter,2);
  sDriveLetter[2] := ':';
  bContain := False;
  for btCounter := 0 to 26 do
  begin
    if AnsiStartsText(CharString[btCounter],sDriveLetter) = True then
    begin
      bContain := True;
      Break;
    end;
  end;
  if bContain = False then
  begin
    Result := 0;
    Exit;
  end;
  GetDiskFreeSpaceEx(PChar(sDriveLetter),FreeBytesAvailableToCaller,Totalsize,@FreeSize);
  if LowerCase(sSizeType) = 'b' then
  begin
      Result := FreeBytesAvailableToCaller;
  end
  else if LowerCase(sSizeType) = 'kb' then
  begin
      Result := FreeBytesAvailableToCaller div 1024;
  end
  else if LowerCase(sSizeType) = 'mb' then
  begin
      Result := FreeBytesAvailableToCaller div 1048576;
  end
  else if LowerCase(sSizeType) = 'gb' then
  begin
      Result := FreeBytesAvailableToCaller div 1073741824;
  end
  else if LowerCase(sSizeType) = 'tb' then
  begin
        Result := FreeBytesAvailableToCaller div 1073741824; // написал в 2 строки, т.к. не помню, выйдет ли 
        Result := Result div 1024;                                      // за рамки допустимого число  1099511627776, так сказать, чтобы не рисковать =)
  end;
end;Набросал на скорую руку (не проверял в делфе), можно сделать оптимизированнее. PS: в качестве параметра sDriveLetter передавай только букву диска, без двоеточия и слэша, т.е. не C:\ или C:, а просто C. в качестве параметра sSizeType передавай b,kb,mb,gb,tb - ну соответственно, результатом ф-ии будет размер в байтах, килобайтах, мегабайтах, гигабайтах или террабайтах. Последний раз редактировалось 4kusNick, 26.09.2007 в 22:40.  |