Диски

Cуществует ли диск в системе?

2017-09-30T01:37:29+07:00

Code:

function DriveExists (Drive: Byte) : boolean;

begin

Result := Boolean (GetLogicalDrives and (1 shl Drive));

end;

procedure TForm1.Button1Click(Sender : TObject);

var Drive : byte;

begin

for Drive := 0 to 25 do

If DriveExists (Drive) then

begin

ListBox1.Items.Add (Chr(Drive+$41));

end;

Информация о дисках

2017-09-30T02:06:21+07:00

Часть информации о диске можно получить при помощи функции GetVolumeInformation. Она позволяет узнать метку, тип файловой системы, серийный номер, максимальную длину имен файлов, а также несколько параметров, связанных с регистром букв в именах файлов, сжатием информации и др.

Для определения типа диска используется функция GetDriveType. Для определения объема диска и свободного пространства - GetDiskFreeSpaceEx. Для определения размера кластера и сектора можно использовать GetDiskFreeSpace. Здесь это не используется.

Подробнее...

Информация о логических дисках

2017-09-30T01:39:07+07:00

Теперь об информации о дисках:

исчерпывающую информацию по этому поводу дает функция GetVolumeInformation,

посмотри help, там все понятно (там и серийный номер диска, и тип файловой системы, и прочее и прочее).

Вот параметры FileSysFlags:

Подробнее...

Информация о физических дисках

2017-09-30T01:43:13+07:00

Посмотри функцию DeviceIoControl - может там что получиться. Я ее мало использовал, но что-то там было.

Там есть ссылка на CreateFile - эта функция под NT может действительно вернуть хэндл на физический диск.

You can use the CreateFile function to open a disk drive or a partition on a disk drive. The function returns a handle to the disk device; that handle can be used with the DeviceIOControl function.

Автор AntonSaburov

Поличение серийного номера IDE диска.

Подробнее...

Как заблокировать доступ к дисководу?

2017-09-30T02:05:22+07:00

Code:

const

{©Drkb v.3}

FILE_DEVICE_FILE_SYSTEM: Integer = $00000009;

METHOD_BUFFERED: Integer = $00000000;

FILE_ANY_ACCESS: Integer = $00000000;

function CTL_CODE(DeviceType, FunctionNo, Method, Access: Integer): Integer;

begin

Result := (DeviceType shl 16) or (Access shl 14) or (FunctionNo shl 2) or (Method);

end;

procedure TForm1.Button1Click(Sender: TObject);

var

LHandle: THandle;

BytesReturned: Cardinal;

MsgBuf: PChar;

FSCTL_LOCK_VOLUME: Integer;

begin

FSCTL_LOCK_VOLUME := CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 6,

METHOD_BUFFERED, FILE_ANY_ACCESS);

LHandle := CreateFile('\\.\A:', GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ

or FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or

FILE_FLAG_DELETE_ON_CLOSE, 0);

if LHandle <> 0 then

begin

if DeviceIOControl(LHandle, FSCTL_LOCK_VOLUME, nil, 0, nil, 0, BytesReturned, nil) then

ShowMessage('Дисковод заблокирован. Нажмите ОК для разблокирования.')

else

begin

if FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER or

FORMAT_MESSAGE_FROM_SYSTEM, nil, GetLastError(), 0, @MsgBuf, 0, nil) > 0 then

begin

ShowMessage('Ошибка DeviceIOControl: ' + MsgBuf);

LocalFree(Cardinal(MsgBuf));

end

else

ShowMessage('Ошибка при вызове DeviceIOControl!');

end;

CloseHandle(LHandle);

end

else

ShowMessage('Ошибка при вызове CreateFile!');

end;

Как получить инфу о SCSI дисках?

2017-09-30T01:44:22+07:00

Code:

program ScsiSN;

// PURPOSE: Simple console application that display SCSI harddisk serial number

{$APPTYPE CONSOLE}

uses

Windows, SysUtils;

//-------------------------------------------------------------

function GetDeviceHandle(sDeviceName: string): THandle;

begin

Result := CreateFile(PChar('\\.\' + sDeviceName),

GENERIC_READ or GENERIC_WRITE,

FILE_SHARE_READ or FILE_SHARE_WRITE,

nil, OPEN_EXISTING, 0, 0)

end;

//-------------------------------------------------------------

function ScsiHddSerialNumber(DeviceHandle: THandle): string;

{$ALIGN ON}

type

TScsiPassThrough = record

Length: Word;

ScsiStatus: Byte;

PathId: Byte;

TargetId: Byte;

Lun: Byte;

CdbLength: Byte;

SenseInfoLength: Byte;

DataIn: Byte;

DataTransferLength: ULONG;

TimeOutValue: ULONG;

DataBufferOffset: DWORD;

SenseInfoOffset: ULONG;

Cdb: array[0..15] of Byte;

end;

TScsiPassThroughWithBuffers = record

spt: TScsiPassThrough;

bSenseBuf: array[0..31] of Byte;

bDataBuf: array[0..191] of Byte;

end;

{ALIGN OFF}

var

dwReturned: DWORD;

len: DWORD;

Buffer: array[0..SizeOf(TScsiPassThroughWithBuffers) +

SizeOf(TScsiPassThrough) - 1] of Byte;

sptwb: TScsiPassThroughWithBuffers absolute Buffer;

begin

Result := '';

FillChar(Buffer, SizeOf(Buffer), #0);

with sptwb.spt do

begin

Length := SizeOf(TScsiPassThrough);

CdbLength := 6; // CDB6GENERIC_LENGTH

SenseInfoLength := 24;

DataIn := 1; // SCSI_IOCTL_DATA_IN

DataTransferLength := 192;

TimeOutValue := 2;

DataBufferOffset := PChar(@sptwb.bDataBuf) - PChar(@sptwb);

SenseInfoOffset := PChar(@sptwb.bSenseBuf) - PChar(@sptwb);

Cdb[0] := $12; // OperationCode := SCSIOP_INQUIRY;

Cdb[1] := $01; // Flags := CDB_INQUIRY_EVPD; Vital product data

Cdb[2] := $80; // PageCode Unit serial number

Cdb[4] := 192; // AllocationLength

end;

len := sptwb.spt.DataBufferOffset + sptwb.spt.DataTransferLength;

if DeviceIoControl(DeviceHandle, $0004D004, @sptwb, SizeOf(TScsiPassThrough),

@sptwb, len, dwReturned, nil)

and ((PChar(@sptwb.bDataBuf) + 1)^ = #$80) then

SetString(Result, PChar(@sptwb.bDataBuf) + 4,

Ord((PChar(@sptwb.bDataBuf) + 3)^));

end;

/=============================================================

var

hDevice: THandle = 0;

sSerNum, sDeviceName: string;

begin

sDeviceName := ParamStr(1);

if sDeviceName = '' then

begin

WriteLn;

WriteLn('Display SCSI-2 device serial number.');

WriteLn;

WriteLn('Using:');

WriteLn;

if Win32Platform = VER_PLATFORM_WIN32_NT then // Windows NT/2000

WriteLn(' ScsiSN PhysicalDrive0')

else

WriteLn(' ScsiSN C:');

WriteLn(' ScsiSN Cdrom0');

WriteLn(' ScsiSN Tape0');

WriteLn;

Exit;

end;

hDevice := GetDeviceHandle(sDeviceName);

if hDevice = INVALID_HANDLE_VALUE then

WriteLn('Error on GetDeviceHandle: ', SysErrorMessage(GetLastError))

else

try

sSerNum := ScsiHddSerialNumber(hDevice);

if sSerNum = '' then

WriteLn('Error on DeviceIoControl: ',

SysErrorMessageGetLastError))

else

WriteLn('Device ' + sDeviceName

+ ' serial number = "', sSerNum, '"');

finally

CloseHandle(hDevice);

end;

end.

Как получить серийный номер тома жесткого диска?

2017-09-30T02:07:00+07:00

Code:

procedure TForm1.Button1Click(Sender: TObject);

var

VolumeName,

FileSystemName : array [0..MAX_PATH-1] of Char;

VolumeSerialNo : DWord;

MaxComponentLength,

FileSystemFlags : Integer;

begin

GetVolumeInformation('C:\',VolumeName,MAX_PATH,@VolumeSerialNo,

MaxComponentLength,FileSystemFlags,

FileSystemName,MAX_PATH);

Memo1.Lines.Add('VName = '+VolumeName);

Memo1.Lines.Add('SerialNo = $'+IntToHex(VolumeSerialNo,8));

Memo1.Lines.Add('CompLen = '+IntToStr(MaxComponentLength));

Memo1.Lines.Add('Flags = $'+IntToHex(FileSystemFlags,4));

Memo1.Lines.Add('FSName = '+FileSystemName);

end;

Как сделать виртуальный диск?

2017-09-30T01:59:58+07:00

Code:

{ ... }

if DefineDosDevice(DDD_RAW_TARGET_PATH, 'P:', 'F:\Backup\Music\Modules') then

ShowMessage('Drive was created successfully')

else

ShowMessage('Error creating drive');

{ ... }

Как узнать, находится ли дискета в дисководе?

2017-09-30T01:58:49+07:00

Code:

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 }

Подробнее...

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

2017-09-30T01:56:41+07:00

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;

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;

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;

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;

procedure TUndocSHFormat.cmdEndClick(Sender: TObject);

begin

close;

end;

end.

Можно ли удалять из списка TDriveComboBox диски которые отключены?

2017-09-30T02:01:08+07:00

На некоторых laptop компьютерах может не быть флоппи дисковода. Можно ли удалять из списка TDriveComboBox диски которые отключены?

В примере TDriveComboBox не показывает дисководы, которые не готовы. (not ready). Учтите что на многих компьютерах будет ощутимая задержка при поверке plug&play флоппи дисковода.

Подробнее...

Определение типов логических дисков

2017-09-30T02:08:28+07:00

Code:

unit Unit1;

{©Drkb v.3}

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

type

TForm1 = class(TForm)

Memo1: TMemo;

Button1: TButton;

procedure Button1Click(Sender: TObject);

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

const

NameSize = 4;

VolumeCount = 26;

TotalSize = NameSize * VolumeCount;

Report = 'Volume: %s %s';

var

Buff, Volume: String;

lpQuery: array [0..MAXCHAR - 1] of Char;

I, Count: Integer;

begin

SetLength(Buff, TotalSize);

Count := GetLogicalDriveStrings(TotalSize, @Buff[1]) div NameSize;

if Count = 0 then

Memo1.Lines.Add(SysErrorMessage(GetLastError))

else

for I := 0 to Count - 1 do

begin

Volume := PChar(@Buff[(I * NameSize) + 1]);

case GetDriveType(PChar(Volume)) of

DRIVE_UNKNOWN: Memo1.Lines.Add(Format(Report, [Volume,

'The drive type cannot be determined.']));

DRIVE_NO_ROOT_DIR: Memo1.Lines.Add(Format(Report, [Volume,

'The root path is invalid. For example, no volume is mounted at the path.']));

DRIVE_REMOVABLE:

begin

Volume[3] := #0;

QueryDosDevice(PChar(Volume), @lpQuery[0], MAXCHAR);

Volume[3] := '\';

if String(lpQuery) = '\Device\Floppy0' then

Memo1.Lines.Add(Format(Report, [Volume, 'The drive is a Floppy disk A:.']))

else

if String(lpQuery) = '\Device\Floppy1' then

Memo1.Lines.Add(Format(Report, [Volume, 'The drive is a Floppy disk B:.']))

else

Memo1.Lines.Add(Format(Report, [Volume, 'The drive is a Flash Drive.']));

end;

DRIVE_FIXED:

begin

Volume[3] := #0;

QueryDosDevice(PChar(Volume), @lpQuery[0], MAXCHAR);

Volume[3] := '\';

if Copy(String(lpQuery), 1, 22) = '\Device\HarddiskVolume' then

Memo1.Lines.Add(Format(Report, [Volume,

'The disk cannot be removed from the drive.']))

else

Memo1.Lines.Add(Format(Report, [Volume,

'The drive is a SUBST disk on path: "' +

Copy(String(lpQuery), 5, Length(String(lpQuery))) + '"']));

end;

DRIVE_REMOTE: Memo1.Lines.Add(Format(Report, [Volume,

'The drive is a remote (network) drive.']));

DRIVE_CDROM: Memo1.Lines.Add(Format(Report, [Volume,

'The drive is a CD-ROM drive.']));

DRIVE_RAMDISK: Memo1.Lines.Add(Format(Report, [Volume,

'The drive is a RAM disk.']));

else

Memo1.Lines.Add(Format(Report, [Volume, 'Xpen znaet chto :)']));

end;

end.

Автор: Александр (Rouse_) Багель

Прочитать boot сектор

2017-09-30T02:03:02+07:00

Вообще-то загрузочный сектор можно прочитать вот так:

Code:

type

TSector = array[0..511] of Byte;

var

Boot: TSector;

begin

ReadBoot(Drive, Boot);

Подробнее...

Редактор диска своими руками

2017-09-30T02:11:05+07:00

Многие помнят легендарный Norton DiskEditor - утилиту, дающую огромный простор для исследовательской и прочей деятельности. И сейчас есть множество аналогов. WinHex, например.

В этой статье я расскажу как написать свой простой редактор диска. Нужную функциональность каждый сможет добавить сам, я покажу основы.

Для начала разберемся как происходит само чтение диска. Проще всего это делать в Windows 2000/XP (с правами администратора, конечно). Работа с жестким диском в этих операционных системах производится путем открытия диска как файла с помощью функции CreateFile и указания диска или раздела по схеме Device Namespace (открывается физический диск - '\\.\PHYSICALDRIVE<n>'), полученный хэндл в дальнейшем используется для работы с диском с помощью функций ReadFile, WriteFile и DeviceIoControl.

Подробнее...

Управление метками томов дисков

2017-09-30T02:04:36+07:00

Данный совет содержит исходный код модуля, который может помочь Вам получить, установить и удалить метку тома гибкого или жесткого диска. Код получения метки тома содержит функцию Delphi FindFirst, код для установки и удаления метки тома использует вызов DOS-прерывания 21h и функции 16h и 13h соответственно. Поскольку функция 16h не поддерживается Windows, она должна вызываться через DPMI-прерывание 31h, функцию 300h.

Подробнее...