Długie nazwy plików

1 Długie nazwy plików
     1.1 Wstęp
2 Opis
     2.2 Typy
     2.3 FindFirst, FindNext
     2.4 Rename, MkDir
     2.5 Rozszerzanie nazwy

Wstęp

Dawno dawno temu M$ zaimplementował długie nazwy plików pod Windowsem.

W sumie to miło z ich strony, ale pojawił się mały problem: jak DOSowy (znaczy się TurboPascalowy) program może się do nich dossać? Długo szukać nie trzeba - należy skorzystać z odpowiedniej funkcji przerwania DOS - int 21h. To jednak rodzi następny problem - nasza funkcja jest dostępna TYLKO jeśli w tle działa Windows... Można to obejść i napisać bibliotekę czytającą bezpośrednio z systemu plików, ale to bardzo skomplikowana robota.
Dlatego zadowolimy się obsługą długich nazw tylko w przypadku, kiedy w tle jest uruchomiony Windows.

Opis

Korzystamy z funkcji 71h przerwania DOS (21h), na jej bazie zbudujemy interfejs podobny do tego z modułu dos.

Typy

Najpierw zdefiniujemy nieco zmodyfikowany rekord SearchRec:

type
  FindData = record
               handle           : word;
               attribs          : longint;
               creationtime     : array[1..2] of longint;
               lastaccestime    : array[1..2] of longint;
               lastmodifytime   : array[1..2] of longint;
               filesize_high    : longint;
               filesize_low     : longint;
               reserved         : array[1..8] of char;
               fullfilename     : array[1..260] of char;
               shortfilename    : array[1..14] of char;
             end;

gdzie:

handle - uchwyt do sesji wyszukiwania;
attribs - wymagane atrybuty szukanego pliku;
creationtime - czas utworzenia pliku;
lastaccestime - czas ostatniego otwarcia pliku;
lastmodifytime - czas ostatniego zmodyfikowania pliku;
filesize_high - rozmiar pliku (jeśli przekracza 2GB);
filesize_low - standardowy rozmiar pliku (do 2GB);
reserved - zarezerwowane;
fullfilename - długa nazwa pliku;
shortfilename - krótka (dosowa) nazwa; pole wypełniane tylko wtedy
gdy istnieje długa nazwa pliku.

Potrzebujemy też unitu strings, gdzie są zdefiniowane procedury zamiany PChar - string, oraz unitu dos (zmienna DosError). Moduł dos można wywalić z deklaracji po wcześniejszym zadeklarowaniu w nagłówku zmiennej DosError typu integer (albo word - jak kto woli).
Teraz możemy zdefiniować funkcje FindFirst i FindNext:

FindFirst, FindNext

function findfirst95(const path : array of char;attrib : word;
                     var dane : FindData) : integer; assembler;
asm
  mov DosError,0
  push ds
  mov ax,714Eh
  mov si,1
  mov cx,attrib
  lds dx,path
  les di,dane
  add di,2

  int 21h

  les di,dane
  mov [es:di],ax
  pop ds

  jc @@1
  xor ax,ax
  jmp @@2
@@1:
  mov doserror,ax
@@2:
end;

function findnext95(var dane : FindData) : integer; assembler;
asm
  mov DosError,0
  mov ax,714Fh
  mov si,1

  les di,dane
  mov bx,[es:di]
  add di,2

  int 21h
  jc @@1
  xor ax,ax
  jmp @@2
@@1:
  mov DosError,ax
  mov cx,ax
  mov ax,71A1h
  les di,dane
  mov bx,[es:di]
  int 21h
  mov ax,cx
@@2:
end;

procedure TermFind(var dane : FindData); assembler;
asm
  mov DosError,0
  mov ax,71A1h
  les di,dane
  mov bx,[es:di]
  int 21h
end;

Do czego służy procedura TermFind? Jest ona niezbędna do zamknięcia
sesji wyszukiwania plików - w ten sposób informujemy Windę, że może
zwolnić zasoby zaalokowane do wyszukiwania. Dlatego po każdym
przeszukaniu katalogu musisz wywołać tą procedurę (chyba, że
wyszukiwanie zakończyło się błędem, np.: 18 - No More Files; wtedy
procedura TermFind jest wywoływana automatycznie).

Co dalej? Przydałoby się zdefiniować coś, co działa identycznie jak
procedury FindFirst i FindNext z modułu dos. Proszę bardzo:

procedure wfindfirst(path : PathStr;Attr: Word;var F: SearchRec);
var
  d      : FindData;

begin
  path := path + #0;
  findfirst95(path[1],attr,d);
  handle := d.handle;
  if DosError > 0 then exit;

  f.size := d.filesize_low;
  f.time := d.lastmodifytime[1];
  f.attr := d.attribs;

  move(d.FullFileName,f.name[1],12);
  if d.ShortFileName[1] <> #0 then
    move(d.ShortFileName,f.fill,14)
else
    move(d.FullFileName,f.fill,14);

  f.name[0] := #12;
  if pos(#0,f.name) > 0 then f.name[0] := char(pos(#0,f.name)-1)
end;

procedure wfindnext(var F: SearchRec);
var
  d      : FindData;

begin
  d.handle := handle;
  findnext95(d);
  if DosError > 0 then          begin TermFind(d); exit; end;
  move(d.FullFileName,f.name[1],12);

  if d.ShortFileName[1] > #0 then
  move(d.ShortFileName,f.fill,14) else
  move(d.FullFileName,f.fill,14);

  f.size := d.filesize_low;
  f.time := d.lastmodifytime[1];
  f.attr := d.attribs;
  f.name[0] := #12;
  if pos(#0,f.name) > 0 then f.name[0] := char(pos(#0,f.name)-1)
end;

Jednak proponuję korzystać bezpośrednio z procedur opisanych dużo
wcześniej w asemblerze - choćby dlatego, że ze względu na ograniczenia
rekordu SearchRec nie można w nich umieścić nazwy pliku dłuższej od
12 znaków.

Rename, MkDir

Coś jeszcze? Przydałoby się coś w rodzaju rename i mkdir.

Oto jest:

function Rename_95(const s,d : array of char) : boolean; assembler;

asm
  push ds
  mov DosError,0
  lds dx,s
  les di,d
  mov ax,7156h
  int 21h
  jc @@1
  mov DosError,0
  jmp @@2
@@1:
  mov DosError,ax { > $FF = OK }
@@2:
  pop ds
end;

function Rename95(s,d : string) : boolean;
begin
  s := s + #0;
  d := d + #0;
  Rename95 := Rename_95(s[1],d[1]);
end;

function MkDir_95(const d : array of char) : boolean; assembler;
asm
  push ds
  lds dx,d
  mov ax,7139h
  int 21h
  mov DosError,ax { > $FF = OK }
  jc @@1
  mov DosError,0
  jmp @@2
@@1:
  mov DosError,ax { > $FF = OK }
@@2:
  pop ds
end;

function MkDir95(d : string) : boolean;
begin
  d := d + #0;
  MkDir95 := MkDir_95(d[1]);
end;

Po dwie wersje - jedna działa na tablicach znaków (coś jak PChar^),
druga na stringach. Tu również proponuję korzystać z wersji napisanych
w asemblerze - czyli tych działających na łańcuchach.

Rozszerzanie nazwy

Na sam koniec jeszcze funkcje, które z krótkiej, DOSowej nazwy zrobią długą.

WinExpName12 jak sama nazwa wskazuje zwraca nie całą długą nazwę,
lecz tylko jej pierwsze 12 znaków (to się przydaje dla kompatybilności z
DOSową konwencją nazewniczą).

function WinExpName(name : string) : string;
var
  dane   : FindData;

begin
  name := name + #0;

  findfirst95(name[1],$FF,dane);
  if DosError <> 0 then
  begin
    dec(name[0]);
    WinExpName := name;
    exit;
  end;
  TermFind(dane);

  WinExpName := Strpas(@dane.fullfilename);
end;

function WinExpName12(name : string) : string12;
var
  dane   : FindData;

begin
  name := name + #0;
  if findfirst95(name[1],$FF,dane) <> 0 then
  begin
    dec(name[0]);
    WinExpName12 := name;
    exit;
  end;
  TermFind(dane);

  WinExpName12 := copy(StrPas(@dane.fullfilename),1,12)+'                 ';
end;

Efekt moich zmagań i mały przykładzik znajduje się w pliku dir95.zip.

Jeśli masz jakieś sugestie dotyczące dodania jakiejś funkcji - pisz do mnie.