unit filelist;
{ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß Filesele ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}
{
  Tato jednotka je soucasti baliku Wokna32 od Laaci.
  Je to jednoducha jednotka, ktera vytvari seznamy souboru podle specifikace
  Prevazne pouzivane jednotkou FileSele.
}
{ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}
{$INCLUDE defines.inc}
{Zde jsou definovane pomocne typy k fileselectorum}

interface
uses Lacrt,Vaznik;

type
PSoubor_szn=^TSoubor_szn;
TSoubor_szn=record
        jmeno:pstring;{jmeno a koncovka jsou zvlast, protoze se s tim pak lip pracuje}
        koncovka:pstring;{koncovka je bez predchazejici tecky}
        _internal_JmenoVelkymi:pstring;
        atributy:byte;
        velikost:longint;{v bytech}
        zmeneno:longint;{na rozbaleni casu je Unpacktime}
        data:pointer;   {ukazatel na pripadne rozsirujici data}
        end;

PAdresar_szn=^TAdresar_szn;
TAdresar_szn=record
         jmeno:pstring;{predpokladam jmena adresaru bez koncovky}
         _internal_JmenoVelkymi:pstring;
         atributy:byte;
         zmeneno:longint;
         data:pointer;   {ukazatel na pripadne rozsirujici data}
         end;

procedure NactiSeznamSouboru(var seznam:PVaznik;maska:string);
procedure NactiSeznamAdresaru(var seznam:PVaznik;maska:string);
procedure ZrusSeznamSouboru(var seznam:PVaznik);
procedure ZrusSeznamAdresaru(var seznam:PVaznik);
function NactiPrvniRadkuSouboru(adr:string;ts:TSoubor_szn):string;
function Vyhledej_soubor_podle_nazvu(seznam:PVaznik;s:string):longint;
Procedure Smaz_VS_S(var n:pointer);
Procedure Smaz_VS_A(var n:pointer);


implementation
uses Dos;

Function Trideni_S(p,q:pointer):boolean;
var v1,v2:Psoubor_szn;
begin
v1:=p;v2:=q;
Trideni_S:=v1^._internal_JmenoVelkymi^<v2^._internal_JmenoVelkymi^;
end;

Function Trideni_A(p,q:pointer):boolean;
var v1,v2:Padresar_szn;
begin
v1:=p;v2:=q;
if v1^.jmeno^='..' then Exit(true) else
if v2^.jmeno^='..' then Exit(false) else
Trideni_A:=v1^._internal_JmenoVelkymi^<v2^._internal_JmenoVelkymi^;
end;


procedure NactiSeznamSouboru(var seznam:PVaznik;maska:string);
var soubor:Psoubor_szn;
    vysledek:searchrec;
    _cesta,_jmeno,_koncovka:string;

Begin{seznamsouboru}
{vytvareni seznamu souboru:}

seznam:=New(PVaznik,Init);
seznam^.porovnejproc:=@Trideni_S;

if maska='' then maska:='*.*';
findfirst(maska,readonly+directory+sysfile+archive+hidden,vysledek);
while doserror=0 do{dokud je neco nalezeno...}
   begin
   if (vysledek.attr and directory)=0 then{...a neni to adresar (ma se delat seznam souboru, ne adresaru)}
      begin
      fsplit(vysledek.name,_cesta,_jmeno,_koncovka);
      New(soubor);
      soubor^.data:=nil;
      soubor^.jmeno:=NaPstring(_jmeno);
      if (_koncovka<>'')and(_koncovka[1]='.') then delete(_koncovka,1,1);{umazani tecky z koncovky}
      soubor^.koncovka:=NaPstring(_koncovka);
      soubor^._internal_JmenoVelkymi:=NaPstring(Convert_Up(vysledek.name));
      soubor^.atributy:=vysledek.attr;
      soubor^.velikost:=vysledek.size;
      soubor^.zmeneno:=vysledek.time;
      seznam^.InsertSort(soubor);
      end;{if}
   findnext(vysledek);
   end;{while}
FindClose(vysledek);
End;{seznamsouboru}


Procedure Smaz_VS_S(var n:pointer);
var p:Psoubor_szn;
begin
p:=n;
ZrusPstring(p^.jmeno);
ZrusPstring(p^._internal_JmenoVelkymi);
ZrusPstring(p^.koncovka);
if p^.data<>nil then FreeMem(p^.data);
Dispose(p);p:=nil;
end;

Procedure Smaz_VS_A(var n:pointer);
var p:Padresar_szn;
begin
p:=n;
ZrusPstring(p^.jmeno);
ZrusPstring(p^._internal_JmenoVelkymi);
if p^.data<>nil then FreeMem(p^.data);
Dispose(p);p:=nil;
end;

procedure ZrusSeznamSouboru(var seznam:PVaznik);
Begin
Vaznik_done_all(seznam,@Smaz_VS_S);
End;


procedure NactiSeznamAdresaru(var seznam:PVaznik;maska:string);
var adresar:Padresar_szn;
    vysledek:searchrec;

Begin{seznamsouboru}
{vytvareni seznamu souboru:}
seznam:=New(PVaznik,Init);
seznam^.porovnejproc:=@Trideni_A;
findfirst(maska,readonly+directory+sysfile+archive+hidden,vysledek);
while doserror=0 do{dokud je neco nalezeno...}
   begin
   if ((vysledek.attr and directory)=directory)and(vysledek.name<>'.') then{adresar jiny nez ten, ve kterem zrovna jsme}
      begin
      New(adresar);
      adresar^.data:=nil;
      adresar^.jmeno:=NaPstring(vysledek.name);
      adresar^._internal_JmenoVelkymi:=NaPstring(Convert_Up(vysledek.name));
      adresar^.atributy:=vysledek.attr;
      adresar^.zmeneno:=vysledek.time;
      seznam^.InsertSort(adresar);
      end;{if}
   findnext(vysledek);
   end;{while}
FindClose(vysledek);
End;{seznamsouboru}

procedure ZrusSeznamAdresaru(var seznam:PVaznik);
Begin
Vaznik_done_all(seznam,@Smaz_VS_A);
End;{zrusseznamadresaru}


Function NactiPrvniRadkuSouboru(adr:string;ts:TSoubor_szn):string;
var t:text;
    s:string;
begin
adr:=adr+ts.jmeno^+'.'+ts.koncovka^;
if ExistFile(adr) then
   begin
   Assign(t,adr);
   Reset(t);
   readln(t,s);
   NactiPrvniRadkuSouboru:=SkipBegSpaces(SkipEndSpaces(s));
   Close(t);
   end
   else NactiPrvniRadkuSouboru:='';
end;


function Vyhledej_soubor_podle_nazvu(seznam:PVaznik;s:string):longint;
{predpoklada, ze <S> realne existuje}
var t,u:string;
    i:longint;
    v:PSoubor_szn;
begin
t:=Convert_Up(s);
i:=0;
seznam^.Reset;
while not seznam^.Konec do
   begin
   inc(i);
   v:=seznam^.Nacti;
   u:=Convert_Up(v^.jmeno^+'.'+v^.koncovka^);
   if u[Length(u)]='.' then dec(s[0]); {abychom nekoncili teckou}
   if u=t then Exit(i);
   end;
Vyhledej_soubor_podle_nazvu:=0;
end;


end.
