Buscar por:

Aboutdisk

Código

Unit AboutDisk;

interface

uses

  Windows, Classes, SysUtils;

{$IFDEF VER90}      {Delphi 2.0}

  {$DEFINE NO64}

{$ENDIF}

{$IFDEF VER93}      {BCB 1.0}

  {$DEFINE NO64}

{$ENDIF}

{$IFDEF VER100}     {Delphi 3}

  {$DEFINE NO64}

{$ENDIF}

{$IFDEF VER110}     {BCB 3}

  {$DEFINE NO64}

{$ENDIF}

{$IFDEF NO64}

type

  Int64 = DWord; 

{$ENDIF}  

type

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

  TAboutDisk = class(TComponent)

  private

    FDisk: Char;

    FSerialNumberStr: String;

    FSerialNumber: LongInt;

    FVolumeLabel: String;

    FFileSystem: String;

    FDriveType: TDriveType;

    FDiskSize: Int64;

    FDiskFree: Int64;

    procedure SetDisk(Value: Char);

    procedure SetNothing(Value: String); procedure SetNothingLong(Value: LongInt); procedure SetNothingInt64(Value: Int64); procedure SetNothingDT(Value: TDriveType);

  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;

  end;

procedure Register;

implementation

constructor TAboutDisk.Create(aOwner: TComponent);

begin

  inherited Create(aOwner);

  Disk := 'C';

end;

procedure TAboutDisk.SetDisk(Value: Char);

var

  VolumeLabel, FileSystem: Array[0..$FF] of Char;

  SerialNumber, DW, SysFlags: DWord;

  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, DW, 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) - $40);

    FDiskFree := SysUtils.DiskFree(Byte(Value) - $40);

   end

end;

procedure TAboutDisk.SetNothing(Value: String); 

begin 

{} 

end; 

procedure TAboutDisk.SetNothingLong(Value: LongInt); 

begin 

{} 

end;

procedure TAboutDisk.SetNothingInt64(Value: Int64); 

begin

 {} 

end; 

procedure TAboutDisk.SetNothingDT(Value: TDriveType); 

begin 

{} 

end;

procedure Register;

begin

  RegisterComponents('Delphi Dev', [TAboutDisk]);

end;

end.