{*************************************************************}
{            DiskInfo component for Delphi 32                 }
{ Version:   1.2                                              }
{ Author:    Aleksey Kuznetsov                                }
{ E-Mail:    info@utilmind.com                                }
{ Home Page: http://www.utilmind.com                          }
{ Created:   May, 4, 1999                                     }
{ Modified:  January, 15, 2000                                }
{ Legal:     Copyright (c) 1999-2000, UtilMind Solutions      }
{ Modified By: Cayetano Gуmez ( cayetano@iname.com )          }
{*************************************************************}
{  TDiskInfo (English):                                       }
{ Component determines the information about specified local  }
{ or a network disk - Serial number, Volume label, type of    }
{ file system, type of a disk, size of free and engaged space }
{*************************************************************}
{  TDiskInfo (Russian):                                       }
{ Компонента определяет информацию об указанном локальном или }
{ сетевом диске - Серийный номер, метку тома, тип файловой    }
{ системы, тип диска, размер свободного и занятого            }
{ пространства.                                               }
{*************************************************************}
{ PROPERTIES:                                                 }
{   Disk: Char - Drive letter                                 }
{                                                             }
{ READ-ONLY PROPERTIES (results)                              }
{   SerialNumberStr: String                                   }
{   SerialNumber: LongInt                                     }
{   VolumeLabel: String                                       }
{   FileSystem: String                                        }
{   DriveType: TDriveType                                     }
{   DiskSize: Int64                                           }
{   DiskFree: Int64                                           }
{   DiskFreeStr: String                                       }
{   DiskSizeStr: String                                       }
{*************************************************************}
{ Please see demo program for more information.               }
{*************************************************************}
{                     IMPORTANT NOTE:                         }
{ This software is provided 'as-is', without any express or   }
{ implied warranty. In no event will the author be held       }
{ liable for any damages arising from the use of this         }
{ software.                                                   }
{ Permission is granted to anyone to use this software for    }
{ any purpose, including commercial applications, and to      }
{ alter it and redistribute it freely, subject to the         }
{ following restrictions:                                     }
{ 1. The origin of this software must not be misrepresented,  }
{    you must not claim that you wrote the original software. }
{    If you use this software in a product, an acknowledgment }
{    in the product documentation would be appreciated but is }
{    not required.                                            }
{ 2. Altered source versions must be plainly marked as such,  }
{    and must not be misrepresented as being the original     }
{    software.                                                }
{ 3. This notice may not be removed or altered from any       }
{    source distribution.                                     }
{*************************************************************}

unit DiskInfo;

interface

uses
    Windows, Classes, SysUtils;

type
    TDriveType = (dtUnknown, dtNoDrive, dtFloppy, dtFixed, dtNetwork,
                  dtCDROM, dtRAM);

    TDiskInfo = class(TComponent)
    private
        FDisk: Char;
        FSerialNumberStr: String;
        FSerialNumber: LongInt;
        FVolumeLabel: String;
        FFileSystem: String;
        FDriveType: TDriveType;
        FDiskSize: Int64;
        FDiskFree: Int64;
        FDIskSizeStr: String;
        FDiskFreeStr: String;

        procedure SetDisk(Value: Char);
        procedure SetNothing(Value: String);
        procedure SetNothingLong(Value: LongInt);
        procedure SetNothingINT64(Value: Int64);
        procedure SetNothingDT(Value: TDriveType);

        function GetStrCant(nOrg: Int64) : String;

    protected
    public
        constructor Create(aOwner: TComponent); override;

    published
      property Disk: Char read FDisk write SetDisk;
      property SerialNumberStr: String read FSerialNumberStr write SetNothing;
      property SerialNumber: LongInt read FSerialNumber write SetNothingLong;
      property VolumeLabel: String read FVolumeLabel write SetNothing;
      property FileSystem: String read FFileSystem write SetNothing;
      property DriveType: TDriveType read FDriveType write SetNothingDT;
      property DiskSize: Int64 read FDiskSize write SetNothingInt64;
      property DiskFree: Int64 read FDiskFree write SetNothingInt64;
      property DiskSizeStr: String read FDiskSizeStr write SetNothing;
      property DiskFreeStr: String read FDiskFreeStr write SetNothing;
    end;

procedure Register;

implementation

constructor TDiskInfo.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FDisk := 'C';
end;

procedure TDiskInfo.SetDisk(Value: Char);
var
    VolumeLabel, FileSystem: Array[0..$FF] of Char;
{$IFDEF Ver120}     // Delphi4 requires DWord !
  {$DEFINE ENABLEDWORD}
{$endIF}
{$IFDEF Ver125}     // CB4 requires DWord !
  {$DEFINE ENABLEDWORD}
{$endIF}
{$IFDEF Ver130}     // Delphi5 requires DWord !
  {$DEFINE ENABLEDWORD}
{$endIF}
{$IFDEF Ver135}     // CB5 requires DWord !
  {$DEFINE ENABLEDWORD}
{$endIF}
{$IFDEF ENABLEDWORD}
    SerialNumber, Comps, SysFlags : DWord;
{$ELSE}
    SerialNumber, Comps, SysFlags : Integer;
{$endIF}

    function DecToHex(aValue: LongInt): String;
    var
      w: Array[1..2] of Word absolute aValue;

      function HexByte(b: Byte): String;
      const
        Hex: Array[$0..$F] of Char = '0123456789ABCDEF';
      begin
        HexByte := Hex[b shr 4] + Hex[b and $F];
      end;

      function HexWord(w: Word): String;
      begin
        HexWord := HexByte(Hi(w)) + HexByte(Lo(w));
      end;

    begin
      Result := HexWord(w[2]) + HexWord(w[1]);
    end;

begin
    Value := UpCase(Value);
    if (Value >= 'A') and (Value <= 'Z') then
     begin
       FDisk := Value;
       GetVolumeInformation(PChar(Value + ':\'), VolumeLabel,
                            SizeOf(VolumeLabel),
                            @SerialNumber, Comps, SysFlags,
                            FileSystem, SizeOf(FileSystem));
       FSerialNumber := SerialNumber;
       FSerialNumberStr := DecToHex(SerialNumber);
       Insert('-', FSerialNumberStr, 5);
       FVolumeLabel := VolumeLabel;
       FFileSystem := FileSystem;
       FDriveType := TDriveType(GetDriveType(PChar(Value + ':\')));
       FDiskSize := SysUtils.DiskSize(Byte(Value) - 64);
       FDiskFree := SysUtils.DiskFree(Byte(Value) - 64);
       FDiskSizeStr := GetStrCant(FDiskSize);
       FDiskFreeStr := GetStrCant(FDiskFree);
    end
end;

procedure TDiskInfo.SetNothing(Value: String);
begin               {}
end;

procedure TDiskInfo.SetNothingLong(Value: LongInt);
begin               {}
end;

procedure TDiskInfo.SetNothingInt64(Value: Int64);
begin               {}
end;

procedure TDiskInfo.SetNothingDT(Value: TDriveType);
begin               {}
end;

procedure Register;
begin
    RegisterComponents('UtilMind', [TDiskInfo]);
end;


function TDiskInfo.GetStrCant( nOrg : Int64 ) : String;
var
    cUnit : String;
    nCant : Double;
begin
    cUnit := ' ';
    nCant := nOrg;  // cast
    if nCant > 1024 then
     begin
      nCant := nCant / 1024;
      cUnit := 'K'
     end;

    if nCant > 1024 then
     begin
      nCant := nCant / 1024;
      cUnit := 'M'
     end;

    if nCant > 1024 then
     begin
      nCant := nCant / 1024;
      cUnit := 'G'
     end;

    if nCant > 1024 then
     begin           // :-))
      nCant := nCant / 1024;
      cUnit := 'T'
     end;

    Result := Format('%3.2f %s', [nCant, cUnit])
end;

end.