unit DiskInfo;

interface

uses
  Windows,
  Classes,  //TComponent
  Controls, //TBevelCut
  StdCtrls, //TLabel
  ExtCtrls, //TCustomPanel
  ColorProgressBar, //TColorProgressBar
  SysUtils, //IntToStr
  Graphics, //TColor i stale koloru
  System.Text; //StringBuilder


type
TDiskInfoStruct = record
  literaDysku :Char;
  czyDyskDostepny :Boolean;

  typDysku :Integer;
  typDyskuOpis :String;

  calkowitaPrzestrzen :Int64;
  wolnaPrzestrzen :Int64;
  zajetaPrzestrzen :Int64;

  wolnaPrzestrzenUlamek :Double;
  wolnaPrzestrzenProcenty :Cardinal;

  nazwaDysku :String;
  numerSeryjnyDysku :Cardinal;
  nazwaFAT :String;
  maksymalnaDlugoscPlikuLubKatalogu :Cardinal;

  maksymalnaDlugoscSciezki :Cardinal;
end;

TDiskInfo=class
private
  FLiteraDysku :Char;
  FInformacje :TDiskInfoStruct; //struktura przechowujaca informacje o dysku
  procedure SetLiteraDysku(ALiteraDysku :Char);
public
  constructor Create(ALiteraDysku :Char = 'c'); //konstruktor klasy
published
  property LiteraDysku :Char read FLiteraDysku write SetLiteraDysku default 'c';
  property Informacje :TDiskInfoStruct read FInformacje;
end;

TDiskInfoPanel=class(TCustomPanel)
private
  FLiteraDysku :Char;
  FInformacje :TDiskInfoStruct; //struktura przechowujaca informacje o dysku
  procedure SetLiteraDysku(ALiteraDysku :Char);
  procedure ZmianaRozmiaru(Sender :TObject);
public
  constructor Create(AOwner :TComponent); override; //konstruktory klasy
published
  property LiteraDysku :Char read FLiteraDysku write SetLiteraDysku default 'c';
  property Informacje :TDiskInfoStruct read FInformacje;
private
  opisLewy,opisPrawy :TLabel;
  pasek :TColorProgressBar;
published
  property Align;
  property Color;
  property Constraints;
  property OnEnter;
  property OnExit;
  property OnKeyDown;
  property OnKeyUp;
  property OnKeyPress;
  property OnMouseDown;
  property OnMouseUp;
  property OnMouseMove;
  property OnClick;
end;

function PobierzInformacjeODysku(literaDysku :Char; var diskInfo : TDiskInfoStruct) :Boolean;
procedure Register;

implementation

function PobierzInformacjeODysku(literaDysku :Char; var diskInfo : TDiskInfoStruct) :Boolean;
type CString = StringBuilder;
var
   katalogGlownyDysku :String;
   wlasnosciSystemuPlikow :Cardinal;
   nazwaDysku_CString,nazwaFAT_CString :CString;
   wolneMiejsceDostepneUzytkownikowi :Int64;
begin
diskInfo.literaDysku:=UpCase(literaDysku);

//W calej funkcji korzysta sie z tego with
with diskInfo do begin

//Ustalanie wstepnych wartosci
czyDyskDostepny:=True;

typDysku:=0;
typDyskuOpis:='';
calkowitaPrzestrzen:=0;
wolnaPrzestrzen:=0;
zajetaPrzestrzen:=0;
wolnaPrzestrzenUlamek:=0;
wolnaPrzestrzenProcenty:=0;
nazwaDysku:='';
numerSeryjnyDysku:=0;
nazwaFAT:='';
maksymalnaDlugoscPlikuLubKatalogu:=0;
maksymalnaDlugoscSciezki:=0;

//Sciezka katalogu glownego na dysku
katalogGlownyDysku:=literaDysku+':\';

//Typ napedu (drive type)
typDysku:=GetDriveType(katalogGlownyDysku);
case (typDysku) of
    0:
      begin
      typDyskuOpis:='Napęd nie istnieje';
      czyDyskDostepny:=False;
      end;
    1:
      begin
      typDyskuOpis:='Dysk nie jest sformatowany';
      czyDyskDostepny:=False;
      end;
    DRIVE_REMOVABLE: typDyskuOpis:='Dysk wymienny';
    DRIVE_FIXED: typDyskuOpis:='Dysk lokalny';
    DRIVE_REMOTE: typDyskuOpis:='Dysk sieciowy';
    DRIVE_CDROM: typDyskuOpis:='Płyta CDROM';
    DRIVE_RAMDISK: typDyskuOpis:='RAM Drive';
    else
    typDyskuOpis:='Typ dysku nierozpoznany';
    end;

//Jezeli dysk niedostepny, to konczymy
if (not czyDyskDostepny) then
   begin
   Result:=false;
   Exit;
   end;

//Ilosc wolnego miejsca na dysku
Result:=GetDiskFreeSpaceEx(katalogGlownyDysku,
   wolneMiejsceDostepneUzytkownikowi,
   calkowitaPrzestrzen,
   wolnaPrzestrzen);

zajetaPrzestrzen:=calkowitaPrzestrzen-wolnaPrzestrzen;

if (Result and (calkowitaPrzestrzen<>0)) then
  begin
  wolnaPrzestrzenUlamek:=wolnaPrzestrzen/calkowitaPrzestrzen;
  wolnaPrzestrzenProcenty:=Round(100*wolnaPrzestrzenUlamek);
  end
  else
  begin
  wolnaPrzestrzenUlamek:=0;
  wolnaPrzestrzenProcenty:=0;
  czyDyskDostepny:=false;
  Result:=false;
  Exit;
  end;

//Nazwa dysku, typ FAT, numer seryjny (GetVolumeInformation)
nazwaDysku_CString:=StringBuilder.Create;
nazwaFAT_CString:=StringBuilder.Create;

Result:=GetVolumeInformation(
        katalogGlownyDysku,
        nazwaDysku_CString,
        nazwaDysku_CString.Capacity,
        numerSeryjnyDysku,
        maksymalnaDlugoscPlikuLubKatalogu,
        wlasnosciSystemuPlikow,
        nazwaFAT_CString,
        nazwaFAT_CString.Capacity);

nazwaDysku:=nazwaDysku_CString.ToString;
nazwaFAT:=nazwaFAT_CString.ToString;

maksymalnaDlugoscSciezki:=MAX_PATH;

end; //koniec od with diskInfo
end;

// --------------------------------------------------------

procedure TDiskInfo.SetLiteraDysku(ALiteraDysku :Char);
begin
FLiteraDysku:=ALiteraDysku;
PobierzInformacjeODysku(FLiteraDysku,FInformacje);
end;

constructor TDiskInfo.Create(ALiteraDysku :Char = 'c'); //konstruktor klasy
begin
inherited Create;
SetLiteraDysku(ALiteraDysku);
end;

// --------------------------------------------------------

procedure TDiskInfoPanel.SetLiteraDysku(ALiteraDysku :Char);
const
  poziomNiski=50;
  poziomWysoki=90;
  BtoGB=1024*1024*1024;
var calkowitaPrzestrzenGB,wolnaPrzestrzenGB,zajetaPrzestrzenGB :Double;
begin
FLiteraDysku:=ALiteraDysku;
PobierzInformacjeODysku(FLiteraDysku,FInformacje);

with Informacje do
  begin
  calkowitaPrzestrzenGB:=Round(10*calkowitaPrzestrzen/BtoGB)/10;
  wolnaPrzestrzenGB:=Round(10*wolnaPrzestrzen/BtoGB)/10;
  zajetaPrzestrzenGB:=Round(10*zajetaPrzestrzen/BtoGB)/10;

  opisLewy.Caption:=literaDysku+':  '+nazwaDysku+' ('+nazwaFAT+')';
  opisPrawy.Caption:=FloatToStr(zajetaPrzestrzenGB)+'/'+FloatToStr(wolnaPrzestrzenGB)+'/'+FloatToStr(calkowitaPrzestrzenGB)+' GB  ('+IntToStr(100-wolnaPrzestrzenProcenty)+'%)';
  pasek.Position:=100-wolnaPrzestrzenProcenty;

  if not czyDyskDostepny then
    begin
    opisLewy.Caption:=literaDysku+':  Dysk niedostępny!';
    opisPrawy.Caption:='';
    pasek.Position:=100;
    end;
  end;

ZmianaRozmiaru(nil);

with pasek do
  begin
  if Position>=poziomWysoki then
    begin
    ColorBegin:=clRed;
    ColorEnd:=clMaroon;
    end;
  if (Position>=poziomNiski) and (Position<poziomWysoki) then
    begin
    ColorBegin:=clYellow;
    ColorEnd:=clOlive;
    end;
  if Position<poziomNiski then
    begin
    ColorBegin:=clLime;
    ColorEnd:=clGreen;
    end;
  if Informacje.typDysku=DRIVE_CDROM then
    begin
    ColorBegin:=clFuchsia;
    ColorEnd:=clPurple;
    end;
  if not Informacje.czyDyskDostepny then
    begin
    ColorBegin:=clSilver;
    ColorEnd:=clGray;
    end;
  end;
end;

procedure TDiskInfoPanel.ZmianaRozmiaru(Sender :TObject);
begin
inherited;
opisLewy.Left:=0; opisLewy.Top:=0;
opisLewy.Font.Height:=2*(Height div 5);
opisPrawy.Font.Height:=2*(Height div 5);
opisPrawy.Left:=Width-opisPrawy.Width; opisPrawy.Top:=0;
pasek.Left:=0;
pasek.Top:=Height div 2;
pasek.Height:=Height div 2;
pasek.Width:=Self.Width;
pasek.AutoStep:=True;
end;

constructor TDiskInfoPanel.Create(AOwner :TComponent);
begin
inherited Create(AOwner);
OnResize:=ZmianaRozmiaru;

BevelOuter:=bvNone;
opisLewy:=TLabel.Create(Self);
opisPrawy:=TLabel.Create(Self);
pasek:=TColorProgressBar.Create(Self);

SetLiteraDysku('c');

opisLewy.Parent:=Self;
opisPrawy.Parent:=Self;
pasek.Parent:=Self;

Self.Caption:=' ';
end;

//Rejestracja komponentu
procedure Register;
begin
RegisterComponents('JM', [TDiskInfoPanel]);
end;

end.

