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

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

{ *** НАЧАЛО КОДА МОДУЛЯ VOLLABEL *** } unit VolLabel;

interface

uses Classes, SysUtils, WinProcs;

type

EDPMIError = class(EInterruptError);

Str11 = String[11];

procedure SetVolumeLabel(NewLabel: Str11; Drive: Char);
function GetVolumeLabel(Drive: Char): Str11;
procedure DeleteVolumeLabel(Drv: Char);

implementation

type

PRealModeRegs = ^TRealModeRegs;

TRealModeRegs = record

case Integer of

0: (

EDI, ESI, EBP, EXX, EBX, EDX, ECX, EAX: Longint;

Flags, ES, DS, FS, GS, IP, CS, SP, SS: Word);

1: (

DI, DIH, SI, SIH, BP, BPH, XX, XXH: Word;

case Integer of

0: (

BX, BXH, DX, DXH, CX, CXH, AX, AXH: Word);

1: (

BL, BH, BLH, BHH, DL, DH, DLH, DHH,

CL, CH, CLH, CHH, AL, AH, ALH, AHH: Byte));

end;

PExtendedFCB = ^TExtendedFCB;

TExtendedFCB = Record

ExtendedFCBflag : Byte;

Reserved1       : array[1..5] of Byte;

Attr            : Byte;

DriveID         : Byte;

FileName        : array[1..8] of Char;

FileExt         : array[1..3] of Char;

CurrentBlockNum : Word;

RecordSize      : Word;

FileSize        : LongInt;

PackedDate      : Word;

PackedTime      : Word;

Reserved2       : array[1..8] of Byte;

CurrentRecNum   : Byte;

RandomRecNum    : LongInt;

end;

procedure RealModeInt(Int: Byte; var Regs: TRealModeRegs); { процедура работает с прерыванием 31h, функцией 0300h для иммитации }
{ прерывания режима реального времени для защищенного режима. }
var

ErrorFlag: Boolean;

begin

asm

mov ErrorFlag, 0       { успешное завершение }

mov ax, 0300h          { функция 300h }

mov bl, Int            { прерывание режима реального времени, которое необходимо выполнить }

mov bh, 0              { требуется }

mov cx, 0              { помещаем слово в стек для копирования, принимаем ноль }

les di, Regs           { es:di = Regs }

int 31h                { DPMI-прерывание 31h }

jnc @@End              { адрес перехода установлен в error }

@@Error:

mov ErrorFlag, 1       { возвращаем false в error }

@@End:

end;

if ErrorFlag then

raise EDPMIError.Create('Неудача при выполнении DPMI-прерывания');

end;

function DriveLetterToNumber(DriveLet: Char): Byte;
{ функция преобразования символа буквы диска в цифровой эквивалент. }
begin

if DriveLet in ['a'..'z'] then

DriveLet := Chr(Ord(DriveLet) -32);

if not (DriveLet in ['A'..'Z']) then

raise EConvertError.CreateFmt('Не могу преобразовать %s в числовой эквивалент диска',

[DriveLet]);

Result := Ord(DriveLet) - 64;

end;

procedure PadVolumeLabel(var Name: Str11);
{ процедура заполнения метки тома диска строкой с пробелами }
var

i: integer;

begin

for i := Length(Name) + 1 to 11 do

Name := Name + ' ';

end;

function GetVolumeLabel(Drive: Char): Str11;
{ функция возвращает метку тома диска }
var

DriveLetter: Char;

SearchString: String[7];

P: Byte;

begin

SearchString := Drive + ':\*.*';

{ ищем метку тома }

if FindFirst(SearchString, faVolumeID, SR) = 0 then begin

P := Pos('.', SR.Name);

if P > 0 then begin                      { если у него есть точка... }

Result := '           ';               { пространство между именами }

Move(SR.Name[1], Result[1], P - 1);    { и расширениями }

Move(SR.Name[P + 1], Result[9], 3);

end

else begin

Result := SR.Name;            { в противном случае обходимся без пробелов }

PadVolumeLabel(Result);

end;

end

else

Result := '';

end;

procedure DeleteVolumeLabel(Drv: Char);
{ процедура удаления метки тома с данного диска }
var

CurName: Str11;

FCB: TExtendedFCB;

ErrorFlag: WordBool;

begin

ErrorFlag := False;

CurName := GetVolumeLabel(Drv);        { получение текущей метки тома }

FillChar(FCB, SizeOf(FCB), 0);         { инициализируем FCB нулями }

with FCB do begin

ExtendedFCBflag := $FF;              { всегда }

Attr := faVolumeID;                  { Аттрибут Volume ID }

DriveID := DriveLetterToNumber(Drv); { Номер диска }

Move(CurName[1], FileName, 8);       { необходимо ввести метку тома }

Move(CurName[9], FileExt, 3);

end;

asm

push ds                             { сохраняем ds }

mov ax, ss                          { помещаем сегмент FCB (ss) в ds }

mov ds, ax

lea dx, FCB                         { помещаем смещение FCB в dx }

mov ax, 1300h                       { функция 13h }

Call DOS3Call                       { вызываем int 21h }

pop ds                              { восстанавливаем ds }

cmp al, 00h                         { проверка на успешность выполнения }

je @@End

@@Error:                              { устанавливаем флаг ошибки }

mov ErrorFlag, 1

@@End:

end;

if ErrorFlag then

raise EInterruptError.Create('Не могу удалить имя тома');

end;

procedure SetVolumeLabel(NewLabel: Str11; Drive: Char);
{ процедура присваивания метки тома диска. Имейте в виду, что }
{ данная процедура удаляет текущую метку перед установкой новой. }
{ Это необходимое требование для функции установки метки. }
var

Regs: TRealModeRegs;

FCB: PExtendedFCB;

Buf: Longint;

begin

PadVolumeLabel(NewLabel);

if GetVolumeLabel(Drive) <> '' then            { если имеем метку... }

DeleteVolumeLabel(Drive);                      { удаляем метку }

Buf := GlobalDOSAlloc(SizeOf(PExtendedFCB));   { распределяем реальный буфер }

FCB := Ptr(LoWord(Buf), 0);

FillChar(FCB^, SizeOf(FCB), 0);                { инициализируем FCB нулями }

with FCB^ do begin

ExtendedFCBflag := $FF;                     { требуется }

Attr := faVolumeID;                         { Аттрибут Volume ID }

DriveID := DriveLetterToNumber(Drive);      { Номер диска }

Move(NewLabel[1], FileName, 8);             { устанавливаем новую метку }

Move(NewLabel[9], FileExt, 3);

end;

FillChar(Regs, SizeOf(Regs), 0);

with Regs do begin                            { Сегмент FCB }

ds := HiWord(Buf);                          { отступ = ноль }

dx := 0;

ax := $1600;                                { Функция 16h }

end;

RealModeInt($21, Regs);                       { создаем файл }

if (Regs.al <> 0) then                        { проверка на успешность выполнения }

raise EInterruptError.Create('Не могу создать метку тома');

end;

end.
{ *** КОНЕЦ КОДА МОДУЛЯ VOLLABEL *** }