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

Данный совет содержит исходный код модуля, который может помочь Вам получить, установить и удалить метку тома гибкого или жесткого диска. Код получения метки тома содержит функцию 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 *** }

Другое по теме:

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