Posted By: Jovo () on 'CZmsdos'
Title:     .. doplnek
Date:      Fri Feb 27 11:36:09 1998

... eh nejak jsem zapomel dopsat, ze mam takovy maly pascalovsky programek, 
ktery projede adresar (mozno zapnout rekurzivnost) a s kazdym souborem neco 
udela. Uz jsem tim tvoril napriklad batak k prevodu vsech .JPG na .GIF ve 
dvou mych podadresarich (odesel jsem mezitim zatopit v kotli a kdyz jsem se 
vratil, batak dobeh k naproste spokojenosti).
  Na konec jsem dopsal upravenou procedurku, takze si to zkopni. Koho to 
nezajima, at si skipne zbytek postu :-)

Jovo.
-------------------------------------------------------------------------------
program File_neco;
{
  by xhovor00@stud.fee.vutbr.cz
  prohleda i rekurzivne vsechny podadresare a dany adresar (volitelne DIRFLAG)
  a aplikuje na vsechny vyhovujici soubory prodeduru DOWITHFILE
}
uses dos,crt;

var DirFlag:word;



procedure DoWithFile(var name:string);
begin;
  writeln(Name);
end;


procedure DoWithParam(name:string);
  var
    DirInfo: SearchRec;
    fullname,PushName:string;
    l:word;
    {                  /--- pointry (adr) taky neco zaberou
     43 + 2*256 + 2 + 2*4 = 565
     16ti Kilovy stack se nam zhrouti +- az po 25ti zanorenich (teda
     kdyz si DoWithFile nenapushuje moc
    }
  begin
    fullname := FExpand (Name);
    FindFirst(FullName, AnyFile , DirInfo);
    {vyhledani prvniho souboru....}
    while (DosError = 0) do {napriklad 18 = NoMoreFiles = Uz jsem nic nenasel}
      begin
          if (DirInfo.attr <> Directory) AND (DirInfo.name[1]<>'.') then
          {vynechani '.' a '..' a ostatnich podadresaru}
              begin;
                PushName := FullName;
                l:=length(PushName);
                while PushName[l]<>'' do
                  begin;
                    Delete(PushName,l,1);
                    l:=length(PushName);
                  end;
                PushName:=PushName+DirInfo.Name;
                DoWithFile(PushName);{... jeho zpracovani ...}
              end;
          FindNext(DirInfo);{... a dalsi pan na holeni}
      end;


    if DirFlag = 0 then exit;{budou se prohledavat i podadresare ? }
    pushname:=fullname;
    l:=length(PushName);
    while PushName[l]<>'' do
      begin;
        Delete(PushName,l,1);
        l:=length(PushName);
      end;
    pushname:=pushname+'*.*';

    FindFirst(PushName, Directory, DirInfo);
    {Najde se prvni podadresar a pustime na nej ...}
    While DosError = 0 do
      begin;
        if (DirInfo.Attr = Directory) AND (DirInfo.name[1]<>'.') then
          {SHIT ! FindFirst najde prvni DIR, ale FindNext do toho pak
           napere JKAYKOLI soubnor (*.*), Tak tohle se Borlandum nepovedlo.
           I v Helpu maji, ze to vyhleda stejne atributy, ale me to nejak
           nechodilo. Jestli je chyba ve me, tak nevim kde.}
          begin;
           Pushname:=Fullname;
           L:=length(Pushname);
           While (l>1) AND (Pushname[l]<>'') do dec(l);
           Insert('',pushname,l+1);
           Insert(DirInfo.name,pushname,l+1);
           DoWithParam(PushName);{... rekurzivne tu samou proceduru....}
          end;
        FindNext(DirInfo);{... atohle zajisti, ze se prolezou vsechny.}
      end;
  end;



{main}
var i,j:word;
    s:string;

begin;
  clrscr;
  DirFlag:=1;
  for i:=1 to paramcount do
    begin;
      DoWithParam(paramstr(i));
    end;
  {tohle si odpoznamkuj
    writeln(':end ');
   }
end.

{tady je ta prepsana procedurka}
procedure DoWithFile(var name:string);
begin;
  write('dosamp ');
  writeln(Name);
  writeln('choice .....<sem si dopln spravne parametry>');
  writeln('if errorlevel ...<:-)>... goto end');
end;
-----------------------------------------------------------------------