(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
unit AHMTDriveDetails;

interface
{$I AHM.INC}
uses
  Windows,Classes, AHMSystemClass,AHMSystemConst;

type
  TAHMDriveType=(dUnknown,dNonExisting,dRemoveable,dFixed,dRemote,dCDRom,dRamDisk);
  TAHMDriveDetailFlags = (isPreservedCase,isCaseSensitive,hasUniCodeStoredOnDisk,hasPersistentACLS,hasFileCompression,isCompressed);
  TAHMDriveDetailSet = Set of TAHMDriveDetailFlags;
  TAHMDriveDetails = class(TAHMSystemsComponent)
  private
    FVolumeLabel : String;
    FSerialNumber : String;
    FMaxFileLength : DWord;
    FDriveType : TAHMDriveType;
    FDrive: String;
    FDrives : TStrings;
    FSystemName: String;
    FSystemFlags : DWord;
   {$IFDEF AHMONLY4}
    FFreeBytes : String;
    FFreeBytesToUser : String;
    FTotalBytes : String;
    FUsedBytes : String;
    {$ENDIF}
    FOnUpdate: TNotifyevent;
    function GetMaxFileLength: DWord;
    function GetSerialNumber: String;
    function GetVolumeLabel: String;
    procedure SetDrive(const Value: String);
    procedure SetMaxFileLength(const Value: DWord);
    function GetSystemFlags: TAHMDriveDetailSet;
    function GetSystemName: String;
    procedure SetSystemFlags(const Value: TAHMDriveDetailSet);
    procedure SetDriveType(const Value: TAHMDriveType);
    function GetAHMDriveType: TAHMDriveType;
    {$IFDEF AHMONLY4}
    function GetFreeBytes: String;
    function GetFreeBytesToUser: String;
    function GetTotalBytes: String;
    function GetUsedBytes: String;
    {$ENDIF}
    function GetDrives: TStrings;
    procedure SetStringValue(Const Value : String);
    procedure SetAHMVolumeLabel(const Value: String);
  protected
  public
    Constructor Create(AOwner : TComponent); override;
    procedure SetDriveDetails(NewDrive : String);
    procedure Loaded; override;
    Destructor Destroy; override;
    property Drives : TStrings read GetDrives;
  published
    property Drive : String read FDrive write SetDrive stored False;
    property VolumeLabel : String read GetVolumeLabel write SetAHMVolumeLabel stored False;
    property SerialNumber : String read GetSerialNumber write SetStringValue stored False;
    property MaxFilesLength : DWord read GetMaxFileLength write SetMaxFileLength stored False;
    property SystemName : String read GetSystemName write SetStringValue stored False;
    property SystemFlags : TAHMDriveDetailSet read GetSystemFlags write SetSystemFlags stored False;
    Property DriveType : TAHMDriveType read GetAHMDriveType write SetDriveType stored False;
   {$IFDEF AHMONLY4}
    Property FreeBytes : String read GetFreeBytes write SetStringValue stored False;
    Property TotalBytes : String read GetTotalBytes write SetStringValue stored False;
    Property FreeBytesToUser : String read GetFreeBytesToUser write SetStringValue stored False;
    Property UsedBytes : String read GetUsedBytes write SetStringValue stored False;
   {$ENDIF}
    property OnUpdate : TNotifyevent read FOnUpdate write FOnUpdate;
  end;

implementation
uses SysUtils;
{ TAHMDriveDetails }

constructor TAHMDriveDetails.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDrives:=TStringList.Create;
  SetDriveDetails(FDrive);
end;

procedure TAHMDriveDetails.Loaded;
begin
  inherited Loaded;
  SetDriveDetails(FDrive);
end;


destructor TAHMDriveDetails.Destroy;
begin
  FDrives.Free;
  inherited Destroy;
end;

type
   PFNGetDiskFreeSpaceEx = ^TFNGetDiskFreeSpaceEx;
   TFNGetDiskFreeSpaceEx = function(lpDirectoryName: PChar;
  var lpFreeBytesAvailableToCaller, lpTotalNumberOfBytes; lpTotalNumberOfFreeBytes: PLargeInteger): DWord; stdcall;
Var
   AHMGetDiskFreeSpaceEx : TFNGetDiskFreeSpaceEx = nil;
function GetDiskFreeSpaceEx(lpDirectoryName: PChar;
  var lpFreeBytesAvailableToCaller, lpTotalNumberOfBytes; lpTotalNumberOfFreeBytes: PLargeInteger): DWord;
Var BinModule : HModule;
begin
  Result := 0;
  BinModule := LoadLibrary(PChar(ahmsckernel32));
  if BinModule<>0 then
  begin
    if @AHMGetDiskFreeSpaceEx = nil then @AHMGetDiskFreeSpaceEx := GetProcAddress(BinModule,PChar('GetDiskFreeSpaceExA'));
    if @AHMGetDiskFreeSpaceEx <> nil then
    Result := AHMGetDiskFreeSpaceEx(lpDirectoryName,lpFreeBytesAvailableToCaller,lpTotalNumberOfBytes,lpTotalNumberOfFreeBytes);
  end;
  if BinModule <> 0 then FreeLibrary(BinModule);
end;


procedure TAHMDriveDetails.SetDriveDetails(NewDrive: String);
Var BVolumeName : array [0..MAX_PATH] of Char;
    BSystemName : array [0..MAX_PATH] of Char;
    BSerialNumber : DWord;
    BMaxLength : DWord;
{$IFDEF AHMONLY4}
    FA,FB,FC:Windows.PLargeInteger;
    IFA,IFB,IFC:LongLong;
{$ENDIF}
begin
  FDrive :=NewDrive;
  FillChar(BVolumename,SizeOf(BVolumeName),0);
  FillChar(BSystemname,SizeOf(BSystemName),0);
  BMaxLength:=0; BSerialNumber:=0; FSystemFlags:=0;
  GetVolumeInformation(PChar(FDrive),@BVolumeName,SizeOf(BVolumeName),@BSerialNumber,BMaxLength,FSystemFlags,@BSystemName,SizeOf(BSystemName));
  FVolumeLabel:=String(BVolumeName);
  FSystemName:=String(BSystemName);
  FMaxFileLength:=BMaxLength;
  FSerialNumber:=Copy(AnsiUpperCase(IntToHex(BSerialNumber,8)), 1, 4)+':'+Copy(AnsiUpperCase(IntToHex(BSerialNumber,8)),5,4);
  Case GetDriveType(PChar(FDrive)) of
    1 : FDriveType:=dNonExisting;
    DRIVE_REMOVABLE : FDriveType:=dRemoveable;
    DRIVE_REMOTE : FDriveType:=dRemote;
    DRIVE_FIXED : FDriveType:=dFixed;
    DRIVE_CDROM : FDriveType:=dCDRom;
    DRIVE_RAMDISK : FDriveType:=dRamDisk;
  else
    FDriveType:=dUnknown;
  end;
  {$IFDEF AHMONLY4}
  FFreeBytesToUser:='';
  FTotalBytes:='';
  FFreeBytes:='';
  IFA:=0; FA:=@IFA;
  IFB:=0; FB:=@IFB;
  IFC:=0; FC:=@IFC;
  if GetDiskFreeSpaceEx(PChar(FDrive),FA,FB,FC)<>0 then
  begin
    FFreeBytesToUser:=InttoStr(Int64(FA));
    FTotalBytes:=InttoStr(Int64(FB));
    {Strange behaviour of this function ... note that I have to typecast the first two values in order to get the correct result
     however typecasting the last value just makes it incorrect. I wonder why ..... so much for Microsofts fix}
    FFreeBytes:=InttoStr(IFC);
    FUsedBytes:=InttoStr(Int64(FB)-(IFC));
  end else
  begin
    FFreeBytesToUser:='0';
    FTotalBytes:='0';
    FFreeBytes:='0';
    FUsedBytes:='0';
  end;
  {$ENDIF AHMDELPHI3}
  if assigned(FOnUpdate) then FOnUpdate(Self);
end;


function TAHMDriveDetails.GetMaxFileLength: DWord;
begin
  result:=FMaxFileLength;
end;

function TAHMDriveDetails.GetSerialNumber: String;
begin
  result:=FSerialNumber;
end;

function TAHMDriveDetails.GetSystemFlags: TAHMDriveDetailSet;
begin
  result:=[];
  if (FSystemFlags and FS_UNICODE_STORED_ON_DISK)=FS_UNICODE_STORED_ON_DISK then Include(result,hasUniCodeStoredOnDisk);
  if (FSystemFlags and FS_CASE_IS_PRESERVED)=FS_CASE_IS_PRESERVED then Include(result,isPreservedCase);
  if (FSystemFlags and FS_CASE_SENSITIVE)=FS_CASE_SENSITIVE then Include(result,isCaseSensitive);
  if (FSystemFlags and FS_PERSISTENT_ACLS)=FS_PERSISTENT_ACLS then Include(result,hasPersistentACLS);
  if (FSystemFlags and FS_FILE_COMPRESSION)=FS_FILE_COMPRESSION then Include(result,hasFileCompression);
  if (FSystemFlags and FS_VOL_IS_COMPRESSED)=FS_VOL_IS_COMPRESSED then Include(result,isCompressed);
end;

function TAHMDriveDetails.GetSystemName: String;
begin
  result:=FSystemName;
end;

function TAHMDriveDetails.GetVolumeLabel: String;
begin
  result:=FVolumeLabel;
end;

procedure TAHMDriveDetails.SetDrive(const Value: String);
begin
  FDrive := Value;
  SetDriveDetails(FDrive);
end;

procedure TAHMDriveDetails.SetMaxFileLength(const Value: DWord);
begin
  {Designtime viewing only}
end;

procedure TAHMDriveDetails.SetSystemFlags(const Value: TAHMDriveDetailSet);
begin
   {Designtime viewing only}
end;

procedure TAHMDriveDetails.SetDriveType(const Value: TAHMDriveType);
begin
  {Designtime viewing only}
end;

function TAHMDriveDetails.GetAHMDriveType: TAHMDriveType;
begin
  result:=FDriveType;
end;
{$IFDEF AHMONLY4}
function TAHMDriveDetails.GetFreeBytes: String;
begin
  result:=FFreeBytes;
end;
function TAHMDriveDetails.GetFreeBytesToUser: String;
begin
  result:=FFreeBytesToUser;
end;
function TAHMDriveDetails.GetTotalBytes: String;
begin
  result:=FTotalBytes;
end;
function TAHMDriveDetails.GetUsedBytes: String;
begin
  result:=FUsedBytes;
end;
{$ENDIF}
function TAHMDriveDetails.GetDrives: TStrings;
Var Buffer : array [0..5000] of Char;
    ADrive : String;
    I : Integer;
begin
  FDrives.Clear;
  FillChar(Buffer,SizeOf(Buffer),0);
  ADrive:=''; I:=0;
  GetLogicalDriveStrings(SizeOf(Buffer),@Buffer);
  while not((Buffer[I]=#0) and (Buffer[I+1]=#0)) do
  begin
    if (Buffer[I]=#0) and (ADrive<>'') then
    begin
      FDrives.Add(ADrive);
      ADrive:='';
    end else ADrive:=ADrive+Buffer[I];
    Inc(I);
  end;
  if ADrive<>'' then FDrives.Add(ADrive);
  result:=FDrives;
end;

procedure TAHMDriveDetails.SetStringValue(const Value: String);
begin
  {Designtime viewing only}
end;

procedure TAHMDriveDetails.SetAHMVolumeLabel(const Value: String);
begin
  if (Value<>'') and (FDrive<>'') then
  if SetVolumeLabel(PChar(FDrive),PChar(Value)) then FVolumeLabel:=Value;
end;

end.


