Code: |
unit Unit1; {©Drkb v.3}
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. |
Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.
ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!