unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    StatusBar: TStatusBar;
    lbNameList: TListBox;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    NTDeviceName: TEdit;
    DOSDeviceName: TEdit;
    btnGetName: TButton;
    btnAddName: TButton;
    btnDelName: TButton;
    btnGetList: TButton;
    procedure btnGetNameClick(Sender: TObject);
    procedure btnAddNameClick(Sender: TObject);
    procedure btnDelNameClick(Sender: TObject);
    procedure btnGetListClick(Sender: TObject);
    procedure lbNameListDblClick(Sender: TObject);
  private
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{Получение NT-имени по DOS-имени}
procedure TForm1.btnGetNameClick(Sender: TObject);
Var Result : Array [1..MAX_PATH] of Char;
begin
 If (QueryDosDevice(PChar(DOSDeviceName.Text), @Result, MAX_PATH) <> 0) then
  NtDeviceName.Text:= StrPas(@Result)
 Else
  NtDeviceName.Text:= 'Устройство не существует';
end;

{Добавить DOS-имя для NT-имени}
procedure TForm1.btnAddNameClick(Sender: TObject);
begin
 If not DefineDosDevice(
   DDD_RAW_TARGET_PATH,
   PChar(DosDeviceName.Text),
   PChar(NtDeviceName.Text))
 then
  StatusBar.Panels[0].Text:= 'Ошибка добавления имени';
end;

{Удалить DOS-имя}
procedure TForm1.btnDelNameClick(Sender: TObject);
Var Result : Array [1..MAX_PATH] of Char;
begin
 {Ищем NT-имя для удаляемого DOS-имени}
 If not(QueryDosDevice(PChar(DOSDeviceName.Text), @Result, MAX_PATH) <> 0) then begin
  StatusBar.Panels[0].Text:= 'DOS-имя не определено';
  Exit;
 End;

 {Удаляем DOS-имя}
 If not DefineDosDevice(
   DDD_RAW_TARGET_PATH or DDD_REMOVE_DEFINITION or DDD_EXACT_MATCH_ON_REMOVE,
   PChar(DosDeviceName.Text),
   PChar(NtDeviceName.Text)
 ) then
  StatusBar.Panels[0].Text:= 'Ошибка удаления имени';
end;

{Получение всех имен устройства}
procedure TForm1.btnGetListClick(Sender: TObject);
var BufSize : Cardinal; P, PName : Pointer; SName : String;
begin
 {Очищаем предыдущий список}
 lbNameList.Items.Clear;

 {Размер буфера}
 BufSize:= 10240;
 {Распределяем память для буфера}
 GetMem(P, BufSize);
 {Запрашиваем список имен}
 If QueryDosDevice(nil, P, BufSize) <> 0 then begin
  {Цикл по всем именам...}
  PName:= P;
  While (True) do begin
   SName:= StrPas(PName);
   If SName = '' then Break;
   {Добавляем в список}
   lbNameList.Items.Add(SName);
   {Переход к следующему устройству}
   {Сдвигаем указатель на следующую строку}
   PName:= Pointer(LongInt(PName) + Length(SName)+1);
  End;
 End; 
 {Освобождаем буфер}
 FreeMem(P);
end;

{Сортировка списка по двойному щелчку}
procedure TForm1.lbNameListDblClick(Sender: TObject);
begin
 lbNameList.Sorted:= True;
 lbNameList.Sorted:= False;
end;

end.
