VPF::форматирование жесткого диска

SULLEN_27

Дата 19.5.2008, 12:38 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 61
Регистрация: 9.2.2008

Репутация: нет
Всего: -2

Всем привет! Ну если знаете то положите пожалуйста код уже желательно работающей программы для форматирования жесткого диска на Delphi. Просто действительно нет времени искать и читать а нужно срочно. зараннее благодарю!

Rennigth

Дата 19.5.2008, 12:56 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1708
Регистрация: 21.6.2004
Где: Moscow

Репутация: 15
Всего: 76

ну а воспользоваться вызовом существующего Format.exe(com) неподходит?

--------------------

(* Honesta mors turpi vita potior *)

Frees

Дата 19.5.2008, 14:46 (ссылка)

(голосов:2)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 2233
Регистрация: 2.12.2005
Где: Екатеринбург

Репутация: 16
Всего: 54

SULLEN_27, Вирусы пишеш?

Добавлено через 5 минут и 2 секунды

Код


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.

--------------------

Кольцов Виктор Владимирович

SULLEN_27

Дата 20.5.2008, 16:16 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 61
Регистрация: 9.2.2008

Репутация: нет
Всего: -2

Спасибо Вам парни за такую опертивную подсказку. нет вирусы я не пишу, просто н smile

адо действительно для одного дела, для хорошего дела.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Для новичков \| Следующая тема »