Недавно добавленные исходники

•  TDictionary Custom Sort  3 227

•  Fast Watermark Sources  2 992

•  3D Designer  4 751

•  Sik Screen Capture  3 259

•  Patch Maker  3 469

•  Айболит (remote control)  3 529

•  ListBox Drag & Drop  2 904

•  Доска для игры Реверси  80 795

•  Графические эффекты  3 843

•  Рисование по маске  3 172

•  Перетаскивание изображений  2 544

•  Canvas Drawing  2 674

•  Рисование Луны  2 501

•  Поворот изображения  2 094

•  Рисование стержней  2 121

•  Paint on Shape  1 525

•  Генератор кроссвордов  2 183

•  Головоломка Paletto  1 731

•  Теорема Монжа об окружностях  2 159

•  Пазл Numbrix  1 649

•  Заборы и коммивояжеры  2 017

•  Игра HIP  1 262

•  Игра Go (Го)  1 201

•  Симулятор лифта  1 425

•  Программа укладки плитки  1 178

•  Генератор лабиринта  1 512

•  Проверка числового ввода  1 297

•  HEX View  1 466

•  Физический маятник  1 322

•  Задача коммивояжера  1 357

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Как форматировать диск



Автор: Baa

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.







Copyright © 2004-2024 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте