| Код |
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,#32);
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.
|
--------------------
"Duty is everything; the greatest of joys, the deepest of sorrows" Aribeth de Tylmarande |
Форматим диск, Пример кода 
Загрузка ...
