Автор: Baa
WEB-сайт: http://forum.vingrad.ru

unit Unit1;
interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls;

type
  TUndocSHFormat = class(TForm)
    Label1: TLabel;
    Combo1: TComboBox;
    cmdSHFormat: TButton;
    cmdEnd: TButton;
    lbMessage: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure cmdSHFormatClick(Sender: TObject);
    procedure cmdEndClick(Sender: TObject);
  private
    procedure LoadAvailableDrives;
  public
  end;

var
  UndocSHFormat: TUndocSHFormat;

implementation

{$R *.DFM}

type
  POSVERSIONINFO = ^TOSVERSIONINFO;
  TOSVERSIONINFO = record
    dwOSVersionInfoSize: Longint;
    dwMajorVersion: Longint;
    dwMinorVersion: Longint;
    dwBuildNumber: Longint;
    dwPlatformId: Longint;
    szCSDVersion: PChar;
  end;

function GetVersionEx(lpVersionInformation: POSVERSIONINFO): Longint; stdcall;
  external 'kernel32.dll' name 'GetVersionExA';

const
  VER_PLATFORM_WIN32s = 0;
const
  VER_PLATFORM_WIN32_WINDOWS = 1;
const
  VER_PLATFORM_WIN32_NT = 2;

function SHFormatDrive(hwndOwner: longint; iDrive: Longint; iCapacity: LongInt;
  iFormatType: LongInt): Longint;
  stdcall; external 'shell32.dll';

const
  SHFD_CAPACITY_DEFAULT = 0;
const
  SHFD_CAPACITY_360 = 3;
const
  SHFD_CAPACITY_720 = 5;

  //Win95
  //Const SHFD_FORMAT_QUICK = 0;
  //Const SHFD_FORMAT_FULL = 1;
  //Const SHFD_FORMAT_SYSONLY = 2;

  //WinNT
  //Public Const SHFD_FORMAT_FULL = 0
  //Public Const SHFD_FORMAT_QUICK = 1

const
  SHFD_FORMAT_QUICK: LongInt = 0;
const
  SHFD_FORMAT_FULL: LongInt = 1;
const
  SHFD_FORMAT_SYSONLY: LongInt = 2;

function GetLogicalDriveStrings(nBufferLength: LongInt; lpBuffer: PChar):
  LongInt;
  stdcall; external 'kernel32.dll' name 'GetLogicalDriveStringsA';

function GetDriveType(nDrive: PChar): LongInt;
  stdcall; external 'kernel32.dll' name 'GetDriveTypeA';

const
  DRIVE_REMOVABLE = 2;
const
  DRIVE_FIXED = 3;
const
  DRIVE_REMOTE = 4;
const
  DRIVE_CDROM = 5;
const
  DRIVE_RAMDISK = 6;

function IsWinNT: Boolean;
var
  osvi: TOSVERSIONINFO;
begin
  osvi.dwOSVersionInfoSize := SizeOf(osvi);
  GetVersionEx(@osvi);
  IsWinNT := (osvi.dwPlatformId = VER_PLATFORM_WIN32_NT);
end;

function GetDriveDisplayString(currDrive: PChar): pchar;
begin
  GetDriveDisplayString := nil;
  case GetDriveType(currDrive) of
    0, 1: GetDriveDisplayString := ' - Undetermined Drive Type -';
    DRIVE_REMOVABLE:
      case currDrive[1] of
        'A', 'B': GetDriveDisplayString := 'Floppy drive';
      else
        GetDriveDisplayString := 'Removable drive';
      end;
    DRIVE_FIXED: GetDriveDisplayString := 'Fixed (Hard) drive';
    DRIVE_REMOTE: GetDriveDisplayString := 'Remote drive';
    DRIVE_CDROM: GetDriveDisplayString := 'CD ROM';
    DRIVE_RAMDISK: GetDriveDisplayString := 'Ram disk';
  end;
end;

procedure TUndocSHFormat.LoadAvailableDrives;
var
  a, r: LongInt;
  lpBuffer: array[0..256] of char;
  currDrive: array[0..256] of char;
  lpDrives: pchar;

begin
  getmem(lpDrives, 256);
  fillchar(lpBuffer, 64, ' ');

  r := GetLogicalDriveStrings(255, lpBuffer);

  if r <> 0 then
  begin
    strlcopy(lpBuffer, lpBuffer, r);
    for a := 0 to r do
      lpDrives[a] := lpBuffer[a];
    lpBuffer[r + 1] := #0;
    repeat
      strlcopy(currDrive, lpDrives, 3);
      lpDrives := @lpDrives[4];
      Combo1.Items.Add(strpas(currDrive) + ' ' +
        GetDriveDisplayString(currDrive));
    until lpDrives[0] = #0;
  end;
end;

procedure TUndocSHFormat.FormCreate(Sender: TObject);
begin
  lbMessage.caption := '';
  LoadAvailableDrives;
  Combo1.ItemIndex := 0;
  if IsWinNT then
  begin
    SHFD_FORMAT_FULL := 0;
    SHFD_FORMAT_QUICK := 1;
  end
  else //it's Win95
  begin
    SHFD_FORMAT_QUICK := 0;
    SHFD_FORMAT_FULL := 1;
    SHFD_FORMAT_SYSONLY := 2;
  end;
end;

procedure TUndocSHFormat.cmdSHFormatClick(Sender: TObject);
var
  resp: Integer;
  drvToFormat: Integer;
  prompt: string;
begin
  drvToFormat := Combo1.ItemIndex;
  prompt := 'Are you sure you want to run the Format dialog against ' +
    Combo1.Text;

  if drvToFormat > 0 then
    resp := MessageDLG(prompt, mtConfirmation, [mbYes, mbNo], 0)
  else
    resp := mrYes;

  if resp = mrYes then
  begin
    lbMessage.Caption := 'Checking drive for disk...';
    Application.ProcessMessages;
    SHFormatDrive(handle, drvToFormat, SHFD_CAPACITY_DEFAULT,
      SHFD_FORMAT_QUICK);
    lbMessage.caption := '';
  end;
end;

procedure TUndocSHFormat.cmdEndClick(Sender: TObject);
begin
  close;
end;

end.