Советы по Delphi

         

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


Управление метками томов дисков из Delphi-приложений

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

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

interface

uses
Classes, SysUtils, WinProcs;

type
EInterruptError = class(Exception);

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
SR: TSearchRec; 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 *** }

[000628]



Содержание раздела