home *** CD-ROM | disk | FTP | other *** search
/ Current Shareware 1994 January / SHAR194.ISO / dos_util / af126.zip / AF.PAS < prev    next >
Pascal/Delphi Source File  |  1993-08-14  |  60KB  |  1,459 lines
  1. Program AF; {Archive Finder}
  2. {.$Define Err}
  3. {$R+}
  4.  
  5. {.$DEFINE ENGLISH}
  6.  
  7. Uses Crt,Dos{$IfDef Err},Err{$Endif};
  8.  
  9. Const motRep         = {$IfDef English} 'Directory';
  10.                        {$Else}          'Répertoire'; {$Endif}
  11.       motKo          = {$IfDef English} 'Kb';
  12.                        {$Else}          'Ko'; {$Endif}
  13. Const PatcherIci     : String[7] = 'Config:';
  14. Const SousRepAussi   : Boolean = True;
  15.       EcrireToutesA  : Boolean = False;
  16.       ArchivesSeules : Boolean = False;
  17.       NomComplet     : Boolean = False;
  18.       Globale        : Boolean = True;
  19.       PasLesArchives : Boolean = False;
  20.       VueRapide      : Boolean = False;
  21.       UniquementTot  : Boolean = False;
  22.       AffTotaux      : Boolean = False;
  23.       TousReps       : Boolean = True;
  24.       BelleVue       : Boolean = True;
  25.       ProcessExe     : Boolean = True;
  26.       UnCluster      : Word    = 0;
  27.       DefaultRep     = '\';
  28.       DefRep         : String[64] = DefaultRep;
  29.       Lecteurs       : String[26] = 'CDE';
  30.       DateMini       : LongInt = 0;
  31.       DateMaxi       : LongInt = $7FFFFFFF;
  32.       TailleMini     : LongInt = 0;
  33.       TailleMaxi     : LongInt = $7FFFFFFF;
  34. Type  Fichier        = Record
  35.                              Nam : String[12];
  36.                              Att : Byte;
  37.                              Dat : LongInt;
  38.                              Siz : LongInt;
  39.                        End;
  40. Const MaxFichiers    = 65000 div SizeOf(Fichier);
  41. Type  FichiersT      = Array[1..MaxFichiers] of Fichier;
  42. Var   Fichiers       : ^FichiersT;
  43.       NbFics         : Word;
  44.  
  45. Const MaxMask        = 20;
  46. Var   Mask           : Array[1..MaxMask] of String[128];
  47.       NbMasques      : Byte;
  48.  
  49.       NbArch         : Word;
  50.       Ext            : String[10];
  51.  
  52.       RepOriginal    : String;
  53.       KeepExit       : Pointer;
  54.       Redirige       : Boolean;
  55.       CrtS           : Text;
  56.       TotalFound     : LongInt;
  57.       SearchMask     : String;
  58.       TotDsk,TotDskR : LongInt;
  59.       TotArc,TotArcR : LongInt;
  60.       NumA,NumD      : Word;
  61.       NbArcFound     : Word; {nbre d'archives trouvées par -a}
  62.       ChercheTailleClust : Boolean; {spécial quand on ne sait pas sur quel
  63.                                      disk sera faite la recherche}
  64. Const Pile           : Byte = 0;
  65.  
  66.  
  67. Function OteBs(x:String):String;
  68. {Supprime le \ final si ce n'est pas le rep principal qui est spécifié}
  69. Begin
  70.      if (x<>'\') and (Length(x)>1) and (x[Length(x)]='\') then
  71.      if x[Pred(Length(x))]<>':' then dec(x[0]);
  72.      OteBs:=x;
  73. End;
  74.  
  75.  
  76. Function AjouteBs(x:String):String;
  77. {Ajoute un \ final}
  78. Begin
  79.      if x='' then x:='.\' else
  80.      if x[Length(x)]=':' then x:=x+'.\' else
  81.      if x[Length(x)]<>'\' then x:=x+'\';
  82.      AjouteBs:=x;
  83. End;
  84.  
  85.  
  86. Function Redir:Boolean;
  87. {pas encore implémenté la manière parfaite de détecter la redirection,
  88.  mais je dois avoir le source quelque part...}
  89. Var b : Array[1..256] of Byte;
  90. Begin
  91.      Move(Mem[PrefixSeg:0],B,SizeOf(b)); Redir:=B[26]<>1;
  92. End;
  93.  
  94.  
  95. Function ClusterSize(c:Char):Word;
  96. Type DPB = Record
  97.                  Numero     : Byte;
  98.                  SousUnite  : Byte;
  99.                  OctPSect   : Word;
  100.                  Interleave : Byte;
  101.                  SectPClust : Byte;
  102.                  Reserves   : Word;
  103.                  NbreDeFats : Byte;
  104.                  RootDir    : Word;
  105.                  PremSect   : Word;
  106.                  DernClust  : Word;
  107.                  SectPFat   : Byte;
  108.                  DataSect1  : Word;
  109.                  Driver     : Pointer;
  110.                  Media      : Byte;
  111.                  Flag       : Byte;
  112.                  NextDPB    : Pointer;
  113.            End;
  114. Var  p:^DPB;
  115.      b:Byte;
  116.      r:Registers;
  117. Begin
  118.      b:=Byte(UpCase(c)); ClusterSize:=0;
  119.      if b in [$41..$5A] then
  120.      Begin
  121.           b:=b-$40;
  122.           With r do
  123.           Begin
  124.                Ah:=$32; Dl:=b; MsDos(r);
  125.                p:=Ptr(ds,bx);
  126.                if Al=0 then
  127.                With p^ do ClusterSize:=(1 shl SectPClust)*OctPSect;
  128.           End;
  129.      End;
  130. End;
  131.  
  132.  
  133. Function FullSize(s:LongInt):LongInt;
  134. Var z:LongInt;
  135. Begin
  136.      z:=0;
  137.      if UnCluster>0 then
  138.      Begin
  139.           z:=(s div UnCluster)*UnCluster;
  140.           if s mod UnCluster<>0 then z:=z+UnCluster;
  141.      End;
  142.      FullSize:=z;
  143. End;
  144.  
  145.  
  146. Procedure ProcessKey;
  147. Var c:Char;
  148. Begin
  149.      if Keypressed then
  150.      Begin
  151.           c:=ReadKey;
  152.           if c in [#0,'',' '] then {^S,' '=pause, #0=tche de fonction}
  153.              Begin
  154.                   {$IfDef English}
  155.                   Write(CrtS,'≡≡≡ P a u s e ≡≡≡   Press a key to continue');
  156.                   {$Else}
  157.                   Write(CrtS,'≡≡≡ P a u s e ≡≡≡   Une touche pour continuer');
  158.                   {$Endif}
  159.                   c:=ReadKey;
  160.                   Write(CrtS,^M); ClrEol;
  161.              End;
  162.           if c in [^C,#27] then Halt;
  163.      End;
  164. End;
  165.  
  166.  
  167. Function Justify(x:String; b:Byte):String;
  168. Var Len:Byte absolute x;
  169. Begin
  170.      if Len>=b then Len:=b else While Len<b do x:=x+' '; Justify:=x;
  171. End;
  172.  
  173.  
  174. Function AffDate(d:DateTime):String;
  175. Const Months : Array[0..12] of String[3]
  176.              {$IfDef English}
  177.              = ('???','Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
  178.              {$Else}
  179.              = ('???','Jan','Fév','Mar','Avr','Mai','Jun','Jul','Aoû','Sep','Oct','Nov','Déc');
  180.              {$Endif}
  181. Var x,y,z:String[3];
  182. Begin
  183.      With d do
  184.      Begin
  185.           Str(Day:2,x); Str(Year mod 100:2,z); y:=Months[Month];
  186.      End;
  187.      {$IfDef ENGLISH}
  188.      AffDate:=y+' '+x+' '+z;
  189.      {$Else}
  190.      AffDate:=x+'-'+y+'-'+z;
  191.      {$Endif}
  192. End;
  193.  
  194.  
  195. Function AffHeure(d:DateTime):String;
  196. Var x,y:String[3];
  197. Begin
  198.      With d do
  199.      Begin
  200.           Str(Hour,x); if Hour<10 then x:='0'+x;
  201.           Str(Min,y);  if Min<10  then y:='0'+y;
  202.      End;
  203.      AffHeure:=x+':'+y;
  204. End;
  205.  
  206.  
  207. {$i C:\bp\cat\AF.INC}
  208.  
  209.  
  210. Function Check(s:String):Boolean;
  211. Var k:Byte;
  212.     Foo:Boolean;
  213. Begin
  214.      k:=0;
  215.      Repeat
  216.            Inc(k); if Pos('.',s)=0 then s:=s+'.'; Foo:=sCheck(Mask[k],s);
  217.      Until foo or (k=NbMasques);
  218.      Check:=foo;
  219. End;
  220.  
  221.  
  222. function GetExeSize(ExeName:String; var TotSize,Expect:LongInt):Boolean;
  223.  { returns true if EXE is already bind }
  224.  { if Expect=0, file is not EXE        }
  225. Type ExeHeaderRec = {Information describing EXE file}
  226.      Record
  227.            Signature         : Word; {EXE file signature}
  228.            LengthRem         : Word; {Number of bytes in last page of EXE image}
  229.            LengthPages       : Word; {Number of 512 byte pages in EXE image}
  230.            NumReloc          : Word; {Number of relocation items}
  231.            HeaderSize        : Word; {Number of paragraphs in EXE header}
  232.            MinHeap,MaxHeap   : Word; {Paragraphs to keep beyond end of image}
  233.            StackSeg,StackPtr : Word; {Initial SS:SP, StackSeg relative to image base}
  234.            CheckSum          : Word; {EXE file check sum, not used}
  235.            IpInit, CodeSeg   : Word; {Initial CS:IP, CodeSeg relative to image base}
  236.            RelocOfs          : Word; {Bytes into EXE for first relocation item}
  237.            OverlayNum        : Word; {Overlay number, not used here}
  238.      End;
  239. Var ExeF : file;
  240.     ExeHeader : ExeHeaderRec;
  241.     ExeValue : LongInt;
  242.     count : Word;
  243. Begin
  244.      TotSize:=0; Expect:=0;
  245.      Assign(ExeF,ExeName); Reset(ExeF,1);
  246.      if IoResult=0 then
  247.      Begin
  248.           TotSize:=FileSize(ExeF);
  249.           BlockRead(ExeF,ExeHeader,SizeOf(ExeHeaderRec),Count);
  250.           With ExeHeader do
  251.           if Signature=$5A4D then
  252.           Begin
  253.                if LengthRem=0 then ExeValue:=LongInt(LengthPages) shl 9
  254.                               else ExeValue:=(LongInt(Pred(LengthPages)) shl 9)+LongInt(LengthRem);
  255.                Expect:=ExeValue;
  256.           End;
  257.      End;
  258.      Close(ExeF);
  259.      GetExeSize:=(TotSize>Expect) and (Expect<>0);
  260. End;
  261.  
  262.  
  263. Procedure Reverse(Var l:LongInt);
  264. {pour les .SIT (Mac) les nombres hexa sont dans l'ordre inverse...}
  265. {Merci à Motorola et Intel de se mettre d'accord...}
  266. Var l1:LongInt;
  267. Begin
  268.      l1:=((l and $FF000000) shr 24) or ((l and $00FF0000) shr 8) or
  269.          ((l and $0000FF00) shl 8)  or ((l and $000000FF) shl 24);
  270.      l:=l1;
  271. End;
  272.  
  273.  
  274. Function OteRep(s:String):String;
  275. Var i:Byte;
  276. Begin
  277.      i:=Length(s); While (i>0) and (s[i]<>'\') and (s[i]<>':') do Dec(i);
  278.      if i>0 then Delete(s,1,i);
  279.      OteRep:=s;
  280. End;
  281.  
  282.  
  283. Procedure Examine(Nom:String; Taille:LongInt);
  284. {Examen d'une archive, quel que soit son type}
  285. Const MaxTampon = 200;
  286.       ZooId     = $FDC4A7DC;
  287. Type  ZooHdrTyp = Record
  288.                         Zoo_Text  : Array[1..20] of Char; { Nom du compacteur }
  289.                         Zoo_Tag   : LongInt;              { Identifie une archive Zoo }
  290.                         Zoo_Start : LongInt;              { Début des données }
  291.                         Zoo_Minus : LongInt;              { Vérification de concordance }
  292.                         Zoo_Major : Char;                 { Version n° }
  293.                         Zoo_Minor : Char;                 { Sous-version n° }
  294.                   End;
  295. Label Fin;      {- Oui, je sais}
  296. Var   f         : File;
  297.       Tampon    : Array[1..MaxTampon] of Byte;
  298.       Lu        : Word;
  299.       j1,j2     : Word; { pour compter la taille du nomfic et du commentaire }
  300.  
  301.       NomFic    : String;     { Nom du fichier       }
  302.       Algo      : String[5];  { Algo de compression  }
  303.       PSize     : LongInt;    { Packed Size          }
  304.       USize     : LongInt;    { Unpacked (real) size }
  305.       Date      : DateTime;   { Date du fichier      }
  306.  
  307.       Flusher   : LongInt;    { Nombre d'octets à sauter jusqu'au prochain fichier }
  308.       i         : Byte;
  309.       w         : Word;
  310.       Li        : LongInt;
  311.       Found     : Word;        { Nbr de fichiers trouvés }
  312.       Count     : LongInt;     { Position dans le fichier }
  313.       ZooHdr    : ZooHdrTyp;
  314.       PassEntry : Boolean;
  315.       NumOnLine : Byte;
  316.       SizeP,SizeU : LongInt;   { Tailles totales (Packed et Unpacked) }
  317.       Cmt       : Boolean;     { Est-ce un commentaire ? }
  318.       d1,d2     : LongInt;     {taille des Datas pour les .SIT}
  319.       TailleDisk: LongInt;     {Taille sur le disque}
  320.       St        : String;
  321.       KeepAttr  : Word;
  322.       b1        : Byte;        {utilisé pour les EXE}
  323. Begin
  324.      HighVideo;
  325.      Write(CrtS,^M);
  326.      if Redirige then ClrEol;
  327.      if ArchivesSeules and AffTotaux and not Redirige then Write(CrtS,Taille:9,'  ');
  328.      if NomComplet then Write(CrtS,Nom) else Write(CrtS,'Archive '+Nom);
  329.      ClrEol;
  330.  
  331.      Inc(NbArch);
  332.      Found:=0; Assign(f,Nom); GetFAttr(f,KeepAttr); SetFAttr(f,0);
  333.      Reset(f,1); Lu:=0; Count:=0;
  334.      if Ext='EXE' then Begin
  335.        if (not GetExeSize(Nom,d1,d2)) or (d2=0) then Begin Write(CrtS,^M); Goto Fin; End;
  336.        BlockRead(f,Tampon[1],MaxTampon,Lu);
  337.        if Lu<MaxTampon then Begin Write(CrtS,^M); Goto Fin; End;
  338.        if MaxTampon>255 then b1:=255 else b1:=MaxTampon;
  339.        Move(Tampon[1],St[1],b1); St[0]:=Chr(b1);
  340.        if Pos('Yoshi',St)<>0 then Begin Ext:='LZH'; Count:=d2; End else
  341.        if Pos('RJSX',St)<>0  then Begin Ext:='ARJ'; Count:=d2+2; End else
  342.          Begin Ext:='ZIP'; Count:=d2; End;
  343.          {Begin Write(CrtS,^M); Goto Fin; End;}
  344.          {Pkware ayant la fâcheuse habitude de ne pas faire les choses
  345.           simplement, les Zip2Exe ne sont pas reconnus pour le moment.
  346.           Bien fait !}
  347.          if not NomComplet then Write(CrtS,' ('+Ext+')');
  348.      End else
  349.      if Ext='ZOO' then
  350.      Begin
  351.           BlockRead(f,ZooHdr,SizeOf(ZooHdr),Lu);
  352.           if Lu<SizeOf(ZooHdr) then Begin Write(CrtS,^M); Goto Fin; End;
  353.           Count:=ZooHdr.Zoo_Start;
  354.      End else
  355.      if Ext='SIT' then
  356.      Begin
  357.           Count:=150; {moi non plus, je ne sais plus pourquoi}
  358.      End;
  359.      Write(CrtS,^M);
  360.      NumOnLine:=0; SizeP:=0; SizeU:=0; TailleDisk:=0;
  361.      Repeat
  362.            Seek(f,Count); PassEntry:=False; Cmt:=False;
  363.            ProcessKey;
  364.            BlockRead(f,Tampon[1],MaxTampon,Lu);
  365.            if Lu<26 then Goto Fin;
  366.  
  367.            if Ext='SIT' then
  368.            Begin
  369.                 Move(Tampon[3],NomFic,64);
  370.                 Move(Tampon[85],USize,4); Reverse(USize);
  371.                 Move(Tampon[93],PSize,4); Reverse(PSize);
  372.                 Move(Tampon[89],d1,4); Reverse(d1);
  373.                 Move(Tampon[97],d2,4); Reverse(d2);
  374.                 PSize:=PSize+d2; USize:=USize+d1;
  375.                 if Tampon[1]=0 then i:=Tampon[2] else i:=Tampon[1];
  376.                 Case i of
  377.                      0: Algo:='Stord';
  378.                      2: Algo:=' LZW ';
  379.                    else Algo:='?????';
  380.                 End;
  381.                 Li:=0;
  382.                 Flusher:=100+PSize+12; {Pourquoi 12 ? Bonne question}
  383.            End else
  384.            if Ext='ZOO' then
  385.            Begin
  386.                 Move(Tampon[1],Li,4);
  387.                 if Li<>ZooId then Goto Fin;
  388.                 Case Tampon[6] of
  389.                      0: Algo:='Store';
  390.                      1: Algo:=' Lzw ';
  391.                    else Begin Str(Tampon[6]:3,Algo); Algo:='? '+Algo; End;
  392.                 End;
  393.                 Move(Tampon[25],PSize,4);
  394.                 Move(Tampon[21],USize,4);
  395.                 i:=39; NomFic:='';
  396.                 While Tampon[i]<>0 do Begin NomFic:=NomFic+UpCase(Chr(Tampon[i])); Inc(i); End;
  397.                 Flusher:=0; Move(Tampon[7],Count,4);
  398.                 Move(Tampon[15],w,2); Li:=LongInt(w) shl 16;
  399.                 Move(Tampon[17],w,2); Li:=Li+w;
  400.            End else
  401.            if Ext='TPZ' then
  402.            Begin
  403.                 Case Tampon[25] of
  404.                      0: Algo:='inclu';
  405.                      1: Algo:='implo';
  406.                 End;
  407.                 Move(Tampon[26],USize,4);
  408.                 Move(Tampon[30],PSize,4);
  409.                 NomFic:='';
  410.                 i:=56;
  411.                 While (Tampon[i]<>32) And (i<56+67) do
  412.                 Begin
  413.                      NomFic:=NomFic+UpCase(Chr(Tampon[i])); Inc(i);
  414.                 End;
  415.                 i:=43;
  416.                 While (Tampon[i]<>32) And (i<43+12) do
  417.                 Begin
  418.                      NomFic:=NomFic+UpCase(Chr(Tampon[i])); Inc(i);
  419.                 End;
  420.                 Flusher:=PSize+122;
  421.                 Move(Tampon[36],Li,4);
  422.            End else
  423.            if Ext='LZH' then
  424.            Begin
  425.                 Move(Tampon[3],St[1],3); St[0]:=#3;
  426.                 if St<>'-lh' then Goto Fin;
  427.                 Move(Tampon[22],NomFic,Tampon[22]+1);
  428.                 Algo[0]:=#5; Move(Tampon[3],Algo[1],5);
  429.                 Move(Tampon[8],PSize,4);
  430.                 Move(Tampon[12],USize,4);
  431.                 Move(Tampon[18],w,2); Li:=LongInt(w) shl 16;
  432.                 Move(Tampon[16],w,2); Li:=Li+w;
  433.                 Flusher:=PSize+2+Tampon[1];
  434.            End else
  435.            if (Ext='ARJ') or ((Ext[1]='A') and (Ext[2] in ['0'..'9'])) then
  436.            Begin
  437.                 Move(Tampon[1],w,2);
  438.                 if w<>$EA60 then
  439.                    Goto Fin;
  440.                 Move(Tampon[17],PSize,4);
  441.                 Move(Tampon[21],USize,4);
  442.                 i:=35; NomFic:=''; j1:=1;
  443.                 While Tampon[i]<>0 do Begin
  444.                   NomFic:=NomFic+Chr(Tampon[i]); Inc(i); Inc(j1);
  445.                 End;
  446.                 Case Tampon[10] of
  447.                      0: Algo:='Store';
  448.                    else Algo:='Met.'+Chr($30+Tampon[10]);
  449.                 End;
  450.                 Cmt:=Tampon[11]=2;
  451.                 Move(Tampon[3],w,2);
  452.                 Move(Tampon[13],Li,4);
  453.                 if Cmt then Begin
  454.                   Flusher:=4+w+4+2;
  455.                 End else Flusher:=14+w+PSize-4;
  456.            End else
  457.            if Ext='ZIP' then
  458.            Begin
  459.                 if (Tampon[1]<>Ord('P')) or (Tampon[2]<>Ord('K')) then Goto Fin;
  460.                 Move(Tampon[1],Li,4); if Li=$02014B50 then Goto Fin;
  461.                 Move(Tampon[9],w,2);
  462.                 Case w of
  463.                      0: Algo:='Stord';
  464.                      1: Algo:='Shrun';
  465.                      2: Algo:='Redu1';
  466.                      3: Algo:='Redu2';
  467.                      4: Algo:='Redu3';
  468.                      5: Algo:='Redu4';
  469.                      6: Algo:='Implo';
  470.                      7: Algo:='Token';
  471.                      8: Algo:='Defla'; {or EXTRA compression}
  472.                    else Str(w:5,Algo);
  473.                 End;
  474.                 Move(Tampon[13],w,2); Li:=LongInt(w) shl 16;
  475.                 Move(Tampon[11],w,2); Li:=Li+w;
  476.                 Move(Tampon[19],PSize,4);
  477.                 Move(Tampon[23],USize,4);
  478.                 Move(Tampon[27],w,2); if w>255 then w:=255;
  479.                 NomFic[0]:=Chr(w); Move(Tampon[31],NomFic[1],w);
  480.                 Flusher:=30+w+PSize;
  481.                 Move(Tampon[29],w,2);
  482.                 Flusher:=Flusher+w;
  483.            End else
  484.            if (Ext='ARC') or (Ext='PAK') then
  485.            Begin
  486.                 Case Tampon[2] of
  487.                      0: Goto Fin;
  488.                      1: Algo:='Stor1';
  489.                      2: Algo:='Stor2';
  490.                      3: Algo:='Packd';
  491.                      4: Algo:='Squzd';
  492.                      5: Algo:='Crun1';
  493.                      6: Algo:='Crun2';
  494.                      7: Algo:='Crun3';
  495.                      8: Algo:='Crun4';
  496.                      9: Algo:='Sqash';
  497.                    else Algo:='  ?  ';
  498.                 End;
  499.  
  500.                 i:=3; NomFic:='';
  501.                 While Tampon[i]<>0 do Begin NomFic:=NomFic+Chr(Tampon[i]); Inc(i); End;
  502.                 Move(Tampon[16],PSize,4);
  503.                 if Tampon[2]=1 then USize:=PSize
  504.                                else Move(Tampon[26],USize,4);
  505.                 if Tampon[2]=1 then Flusher:=25+PSize
  506.                                else Flusher:=29+Psize;
  507.                 Move(Tampon[18],Li,4);
  508.            End;
  509.            UnPackTime(Li,Date);
  510.  
  511.            While Pos('/',NomFic)<>0 do NomFic[Pos('/',NomFic)]:='\';
  512.            if (Li>=DateMini) and (Li and $FFFF0000<=DateMaxi) and
  513.               (USize>=TailleMini) and (USize<=TailleMaxi) then
  514.            if (NomFic<>'') and not Cmt then if Check(OteRep(NomFic)) then
  515.            Begin
  516.                 if Found=0 then
  517.                 Begin
  518.                      if Redirige and (ArchivesSeules or not EcrireToutesA) then
  519.                        if NomComplet then WriteLn(Nom)
  520.                                      else WriteLn('Archive '+Nom);
  521.                      if not Redirige then Begin LowVideo; WriteLn(CrtS); End;
  522.                      if not (VueRapide or UniquementTot or NomComplet or ArchivesSeules) then
  523.                      Begin
  524.                           {$IfDef English}
  525.                           WriteLn('File name                      Methd UnpSize  PakSize Prct    Date    Time ');
  526.                           {$Else}
  527.                           WriteLn('Nom du fichier                 Méthd TRéelle  TComprs Prct    Date    Heure');
  528.                           {$Endif}
  529.                           WriteLn('------------------------------ ----- -------  ------- ----  --------- -----');
  530.                      End;
  531.                 End;
  532.                 Inc(Found); Inc(TotalFound); Inc(SizeU,USize); Inc(SizeP,PSize);
  533.                 Inc(NumA);
  534.                 Inc(TotArc,USize);
  535.                 Inc(TotArcR,FullSize(USize));
  536.                 TailleDisk:=TailleDisk+FullSize(USize);
  537.                 if not (UniquementTot or ArchivesSeules) then
  538.                 if VueRapide then
  539.                 Begin
  540.                      Inc(NumOnLine);
  541.                      While Pos('\',NomFic)<>0 do Delete(NomFic,1,Pos('\',NomFic));
  542.                      Write('  '+Justify(NomFic,12));
  543.                      if NumOnLine=5 then
  544.                      Begin
  545.                           WriteLn(' '); NumOnLine:=0;
  546.                      End else Write('  ');
  547.                 End else
  548.                 if NomComplet
  549.                    then WriteLn(NomFic)
  550.                    else Begin
  551.                              Write(Justify(NomFic,30),' '+Algo,USize:8,' ',PSize:8,' ');
  552.                              if USize>0 then Write(LongInt(PSize)*100 div USize:3,'%')
  553.                                         else Write('100%');
  554.                              if Li<>0 then Write('  ',AffDate(Date),' ',AffHeure(Date));
  555.                              WriteLn;
  556.                         End;
  557.            End;
  558.            if ArchivesSeules and (found>0) then Begin
  559.              Inc(NbArcFound); Goto Fin;
  560.            End;
  561.            Inc(Count,Flusher);
  562.      Until false;
  563. Fin: Close(f);
  564.      SetFAttr(f,KeepAttr);
  565.      if VueRapide and (NumOnLine>0) then WriteLn;
  566.      if Found>0 then if NomComplet and not ArchivesSeules then WriteLn else
  567.      if not ArchivesSeules then
  568.      if AffTotaux then
  569.      Begin
  570.           if not (VueRapide or UniquementTot) then
  571.              WriteLn('------------------------------       -------  -------');
  572.           if TailleDisk=0 then St:='' else
  573.           Begin
  574.                Str(TailleDisk,St);
  575.                St:='('+St+')';
  576.           End;
  577.           if VueRapide then i:=24 else i:=36;
  578.           if Found=1 then
  579.             {$IfDef ENGLISH}
  580.             Write(Justify('1 file '+St,i)) else
  581.             {$Else}
  582.             Write(Justify('1 fichier '+St,i)) else
  583.             {$Endif}
  584.           Begin
  585.                Str(Found,Algo);
  586.                {$IfDef ENGLISH}
  587.                Write(Justify(Algo+' files '+St,i));
  588.                {$Else}
  589.                Write(Justify(Algo+' fichiers '+St,i));
  590.                {$Endif}
  591.           End;
  592.           WriteLn(SizeU:8,' ',SizeP:8,' ',SizeP*100 div SizeU:3,'%');
  593.           WriteLn;
  594.      End else if Found>0 then WriteLn;
  595. End;
  596.  
  597.  
  598. Function WriteAttr(b:Byte):String;
  599. Var x:String;
  600. Begin
  601.      x:='';
  602.      if b and $1 =$1  then x:=x+'r' else x:=x+' ';
  603.      if b and $2 =$2  then x:=x+'h' else x:=x+' ';
  604.      if b and $4 =$4  then x:=x+'s' else x:=x+' ';
  605.      if b and $20=$20 then x:=x+'a' else x:=x+' ';
  606.      WriteAttr:=x;
  607. End;
  608.  
  609.  
  610. Var TmpStr    : String; {Cherche est récursive !}
  611.     Dt        : DateTime;
  612.     i         : Word;
  613.     NumOnLine : Byte;
  614.     TotalSize : LongInt;
  615.     TotalDisk : LongInt;
  616.     St2       : String;
  617.  
  618. Procedure Cherche(Rep:ComStr);
  619. {Recherche récursive sur les fichiers du disque.}
  620. Type RepTypPtr = ^RepTyp;
  621.      RepTyp    = Record
  622.                        n:RepTypPtr; {pointe sur le prochain}
  623.                        s:String[12];
  624.                  End;
  625. Var Sr:SearchRec;
  626.     FirstRep,ChnRep:RepTypPtr;
  627. Begin
  628.      Inc(Pile);
  629.      {$i-} ChDir(Rep); {$i+}
  630.      if IoResult<>0 then
  631.      Begin
  632.           if EcrireToutesA and not NomComplet then
  633.           Begin
  634.                {$IfDef English}
  635.                TmpStr:='Invalid directory '+Rep;
  636.                {$Else}
  637.                TmpStr:='Répertoire '+Rep+' invalide';
  638.                {$Endif}
  639.                HighVideo;
  640.                if Redirige then Begin Write(TmpStr); ClrEol; WriteLn; End
  641.                            else Begin
  642.                                      Write(CrtS,^M+TmpStr); ClrEol;
  643.                                      LowVideo; WriteLn(CrtS);
  644.                                 End;
  645.           End;
  646.           Exit;
  647.      End;
  648.      GetDir(0,TmpStr); if TmpStr[Length(TmpStr)]<>'\' then TmpStr:=TmpStr+'\';
  649.      if ChercheTailleClust then
  650.      Begin
  651.           ChercheTailleClust:=false; UnCluster:=ClusterSize(TmpStr[1]);
  652.      End;
  653.      HighVideo;
  654.      Write(CrtS,^M+motRep+' '+OteBS(TmpStr)); ClrEol; Write(CrtS,^M);
  655.      LowVideo;
  656.      NbFics:=0;
  657.  
  658.      FindFirst(SearchMask,AnyFile-VolumeId,Sr); ProcessKey;
  659.  
  660.      if TousReps then
  661.      Begin
  662.           New(ChnRep); FillChar(ChnRep^,Sizeof(ChnRep^),0); FirstRep:=ChnRep;
  663.      End;
  664.  
  665.      if DosError=0 then
  666.      With Sr do While DosError=0 do
  667.      Begin
  668.           if Attr and Directory<>0 then
  669.           Begin
  670.                if TousReps and (Name<>'.') and (Name<>'..') then
  671.                Begin
  672.                     ChnRep^.s:=Name; New(ChnRep^.n);
  673.                     ChnRep:=ChnRep^.n;  FillChar(ChnRep^,SizeOf(ChnRep^),0);
  674.                End;
  675.           End else
  676.           Begin
  677.                if Time<0 then Time:=0;
  678.                if Globale and (Time>=DateMini)
  679.                           and (Time and $FFFF0000<=DateMaxi)
  680.                           and (Size>=TailleMini)
  681.                           and (Size<=TailleMaxi)
  682.                           and Check(Name)
  683.                           then
  684.                Begin
  685.                     Inc(NbFics); Inc(TotalFound); Inc(NumD);
  686.                     With Fichiers^[NbFics] do
  687.                     Begin
  688.                          Nam:=Name; Siz:=Size; Dat:=Time; Att:=Attr;
  689.                          Inc(TotDsk,Size); Inc(TotDskR,FullSize(Size));
  690.                     End;
  691.                End;
  692.                if not PasLesArchives then
  693.                Begin
  694.                     if Pos('.',Name)<>0 then Ext:=Copy(Name,Pos('.',Name)+1,3)
  695.                                         else Ext:='';
  696.                     if (Ext='LZH') or (Ext='ARJ') or (Ext='ZIP') or (Ext='ARC') or
  697.                        (Ext='PAK') or (Ext='ZOO') or (Ext='SIT') or (Ext='TPZ')
  698.                        or ((Ext='EXE') and ProcessExe)
  699.                        or ((Ext[1]='A') and (Ext[2] in ['0'..'9']) and (Ext[3] in ['0'..'9']))
  700.                        then Examine(TmpStr+Name,Size)
  701.                End;
  702.           End;
  703.           ProcessKey; FindNext(Sr);
  704.      End;
  705.      if NbFics>0 then
  706.      Begin
  707.           NumOnLine:=0; HighVideo; TotalSize:=0; TotalDisk:=0;
  708.           if BelleVue or NomComplet then Begin LowVideo; ClrEol; End else
  709.           if Redirige then Begin Write(motRep+' '+OteBs(TmpStr)); ClrEol; WriteLn; End
  710.                       else Begin
  711.                                 Write(CrtS,^M+MotRep+' '+OteBs(TmpStr)); ClrEol;
  712.                                 LowVideo; WriteLn(CrtS);
  713.                            End;
  714.           LowVideo;
  715.           if not (BelleVue or NomComplet or VueRapide or UniquementTot) then
  716.           Begin
  717.                {$IfDef English}
  718.                WriteLn('File name       Size     Date     Time ');
  719.                {$Else}
  720.                WriteLn('Nom fichier    Taille    Date     Heure');
  721.                {$Endif}
  722.                WriteLn('------------  -------  ---------  -----');
  723.           End;
  724.           For i:=1 to NbFics do With Fichiers^[i] do
  725.           Begin
  726.                TotalSize:=TotalSize+Siz; TotalDisk:=TotalDisk+FullSize(Siz);
  727.                ProcessKey;
  728.                UnpackTime(Dat,DT);
  729.                if NomComplet then WriteLn(AjouteBs(OteBs(TmpStr))+Nam) else
  730.                if not UniquementTot then
  731.                if BelleVue then
  732.                   WriteLn(Justify(Nam,12)+' ',Siz:8,'  '+AffDate(Dt)+'  '+
  733.                           AffHeure(Dt)+'  '+AjouteBs(OteBs(TmpStr))) else
  734.                if VueRapide then
  735.                Begin
  736.                     Inc(NumOnLine);
  737.                     Write('  '+Justify(Nam,12));
  738.                     if NumOnLine=5 then
  739.                     Begin
  740.                          WriteLn; NumOnLine:=0;
  741.                     End else Write('  ');
  742.                End else
  743.                   WriteLn(Justify(Nam,12)+' ',Siz:8,'  '+AffDate(Dt)+'  '+AffHeure(Dt));
  744.           End;
  745.           if VueRapide and (NumOnLine<>0) then WriteLn;
  746.           if AffTotaux then
  747.           Begin
  748.                if not (VueRapide or UniquementTot) then
  749.                   WriteLn('              -------');
  750.                if NbFics=1 then {$IfDef English}Write(Justify('1 file',13))
  751.                                 {$Else}Write(Justify('1 fichier',13)){$Endif}
  752.                            else
  753.                Begin
  754.                     Str(NbFics,St2);
  755.                     {$IfDef English}
  756.                     Write(Justify(St2+' files',13));
  757.                     {$Else}
  758.                     Write(Justify(St2+' fichiers',13));
  759.                     {$Endif}
  760.                End;
  761.                WriteLn(' ',TotalSize:7,'  (',TotalDisk,')');
  762.           End;
  763.           if not NomComplet then WriteLn;
  764.      End else if (not ArchivesSeules and EcrireToutesA) then
  765.          if Redirige then Writeln(motRep+' '+OteBs(TmpStr))
  766.                      else Begin LowVideo; WriteLn(CrtS); End;
  767.      if SousRepAussi then
  768.      Begin
  769.           if not TousReps then
  770.           Begin
  771.                FindFirst('*.',Directory,Sr);
  772.                With Sr do While DosError=0 do
  773.                Begin
  774.                     if (Attr and Directory=Directory) and (Name<>'.') and (Name<>'..') then
  775.                        Cherche(Name);
  776.                     FindNext(Sr);
  777.                End;
  778.           End else
  779.           if (FirstRep^.n<>Nil) or (FirstRep^.s<>'') then
  780.           Begin
  781.                ChnRep:=FirstRep;
  782.                While ChnRep<>Nil do
  783.                Begin
  784.                     if ChnRep^.s<>'' then Cherche(ChnRep^.s);
  785.                     FirstRep:=ChnRep; ChnRep:=ChnRep^.n; Dispose(FirstRep);
  786.                End;
  787.           End else Dispose(FirstRep);
  788.      End;
  789.      Dec(Pile); if Pile>0 then ChDir('..');
  790.      Write(CrtS,^M); ClrEol; LowVideo;
  791. End;
  792.  
  793.  
  794. Function PlusMoins(Var x:String):Byte;
  795. {Gestion des paramètres de la ligne de commande}
  796. Begin
  797.      Delete(x,1,1);
  798.      if x[1]='-' then Begin PlusMoins:=0; Delete(x,1,1); End else
  799.      if x[1]='+' then Begin PlusMoins:=1; Delete(x,1,1); End else
  800.                             PlusMoins:=2;
  801. End;
  802.  
  803.  
  804. Function LisDate(Var s:String):LongInt;
  805. Var Dt:DateTime;
  806.     L:LongInt;
  807.     dow:Word;
  808.     ErrVal:Integer;
  809. Begin
  810.      Delete(s,1,1); L:=-1;
  811.      With Dt do
  812.      if Length(s)>=6 then
  813.      Begin
  814.           {$IfDef English}
  815.           Val(Copy(s,3,2),Day,ErrVal); if ErrVal<>0 then Day:=1;
  816.           Val(Copy(s,1,2),Month,ErrVal); if ErrVal<>0 then Month:=1;
  817.           {$Else}
  818.           Val(Copy(s,1,2),Day,ErrVal); if ErrVal<>0 then Day:=1;
  819.           Val(Copy(s,3,2),Month,ErrVal); if ErrVal<>0 then Month:=1;
  820.           {$Endif}
  821.           Val(Copy(s,5,2),Year,ErrVal); if ErrVal<>0 then Year:=1;
  822.           Year:=Year+1900; While Year<1980 do Inc(Year,100);
  823.           Hour:=0; Min:=0; Sec:=0;
  824.           PackTime(Dt,L); Delete(s,1,6);
  825.      End else
  826.      if (s='') or (s[1]<'0') or (s[1]>'9') then
  827.      Begin
  828.           GetDate(Year,Month,Day,Dow); Hour:=0; Min:=0; Sec:=0;
  829.           While Year<1980 do Inc(Year,100);
  830.           PackTime(Dt,l);
  831.      End else {$IfDef English}
  832.               WriteLn('/D invalid date (mmddyy)');
  833.               {$Else}
  834.               WriteLn('/D date invalide (JJMMYY)');
  835.               {$Endif}
  836.      LisDate:=L;
  837. End;
  838.  
  839.  
  840. Function ShowDate(l:LongInt):String;
  841. Var s,x:String[6];
  842.     Dt:DateTime;
  843. Begin
  844.      UnpackTime(l,Dt);
  845.      With Dt do Begin
  846.        s:='';
  847.        {$IfDef English}
  848.        if Month<10 then s:=s+'0'; Str(Month,x); s:=s+x;
  849.        if Day<10   then s:=s+'0'; Str(Day,x); s:=s+x;
  850.        {$Else}
  851.        if Day<10   then s:=s+'0'; Str(Day,x); s:=s+x;
  852.        if Month<10 then s:=s+'0'; Str(Month,x); s:=s+x;
  853.        {$Endif}
  854.        Year:=Year mod 100; if Year<10 then s:=s+'0'; Str(Year,x); s:=s+x;
  855.      End;
  856.      ShowDate:=s;
  857. End;
  858.  
  859.  
  860. Function LisTaille(Var x:String):LongInt;
  861. {Extraction de la taille après /i±999}
  862. Var s:String;
  863.     L:LongInt;
  864.     ErrVal:Integer;
  865. Begin
  866.      Delete(x,1,1); LisTaille:=-1;
  867.      if x<>'' then
  868.      Begin
  869.           s:='';
  870.           While (x<>'') and (x[1]>='0') and (x[1]<='9') do
  871.           Begin
  872.                s:=s+x[1]; Delete(x,1,1);
  873.           End;
  874.           Val(s,L,ErrVal); if ErrVal<>0 then L:=-1;
  875.           LisTaille:=L;
  876.      End;
  877. End;
  878.  
  879.  
  880. Procedure LisParametres;
  881. Const Pm : Array[Boolean] of Char = ('-','+');
  882. Var Msk,Ext,x,y,z,t,Rep:String;
  883.     i,j:Byte;
  884.     Stupid,DefRepSet,AffHelp,Debug:Boolean; {Si /R a déjà été spécifié}
  885. Begin
  886.      SearchMask:='*.*'; NbMasques:=0; DefRepSet:=False; Rep:=''; Stupid:=False;
  887.      ChercheTailleClust:=False; AffHelp:=False; Debug:=False;
  888.      if ParamCount>0 then
  889.      Begin
  890.           For i:=1 to ParamCount do
  891.           Begin
  892.                x:=ParamStr(i); For j:=1 to Length(x) do x[j]:=UpCase(x[j]);
  893.                if x[1]='?' then AffHelp:=True else
  894.                if (x[1]='/') or (x[1]='-') then
  895.                Begin
  896.                     Delete(x,1,1);
  897.                     While x<>'' do
  898.                     Case x[1] of
  899.                          'A' : Begin
  900.                                     Case PlusMoins(x) of
  901.                                          0: ArchivesSeules:=False;
  902.                                          1: ArchivesSeules:=True;
  903.                                          2: ArchivesSeules:=not ArchivesSeules;
  904.                                     End;
  905.                                     if ArchivesSeules then
  906.                                     Begin
  907.                                          EcrireToutesA:=True; Globale:=False;
  908.                                     End;
  909.                                End;
  910.                          'B' : Case PlusMoins(x) of
  911.                                     0: BelleVue:=False;
  912.                                     1: BelleVue:=True;
  913.                                     2: BelleVue:=not BelleVue;
  914.                                End;
  915.                          'C' : Begin
  916.                                     Case PlusMoins(x) of
  917.                                          0: SousRepAussi:=False;
  918.                                          1: SousRepAussi:=True;
  919.                                          2: SousRepAussi:=not SousRepAussi;
  920.                                     End;
  921.                                     if not DefRepSet then
  922.                                     Begin
  923.                                          DefRep:='';
  924.                                          DefRepSet:=True;
  925.                                          GetDir(0,y); Lecteurs:=y[1];
  926.                                     End;
  927.                                End;
  928.                          'D' : Begin
  929.                                     Delete(x,1,1);
  930.                                     Case x[1] of
  931.                                          '+': DateMini:=LisDate(x);
  932.                                          '-': DateMaxi:=LisDate(x);
  933.                                          '=': Begin
  934.                                                    DateMini:=LisDate(x);
  935.                                                    DateMaxi:=DateMini;
  936.                                               End;
  937.                                          else {$IfDef English} WriteLn('/D incorrect syntax');
  938.                                               {$Else} WriteLn('/D syntaxe incorrecte'); {$Endif}
  939.                                     End;
  940.                                End;
  941.                          'E' : Case PlusMoins(x) of
  942.                                     0: EcrireToutesA:=False;
  943.                                     1: EcrireToutesA:=True;
  944.                                     2: EcrireToutesA:=not EcrireToutesA;
  945.                                End;
  946.                          'F' : Case PlusMoins(x) of
  947.                                     0: AffTotaux:=False;
  948.                                     1: AffTotaux:=True;
  949.                                     2: AffTotaux:=not AffTotaux;
  950.                                End;
  951.                          'G' : Case PlusMoins(x) of
  952.                                     0: Globale:=False;
  953.                                     1: Globale:=True;
  954.                                     2: Globale:=not Globale;
  955.                                End;
  956.                          'I' : Begin
  957.                                     Delete(x,1,1);
  958.                                     Case x[1] of
  959.                                          '+': TailleMini:=LisTaille(x);
  960.                                          '-': TailleMaxi:=LisTaille(x);
  961.                                          '=': Begin
  962.                                                    TailleMini:=LisTaille(x);
  963.                                                    TailleMaxi:=TailleMini;
  964.                                               End;
  965.                                          else {$IfDef English} WriteLn('/I incorrect syntax');
  966.                                               {$Else} WriteLn('/I syntaxe incorrecte'); {$Endif}
  967.                                     End;
  968.                                End;
  969.                          'L' : Begin
  970.                                     Delete(x,1,1);
  971.                                     if x<>'' then
  972.                                     if x='0' then Begin
  973.                                       GetDir(0,y); Lecteurs:=y[1];
  974.                                     End else Lecteurs:=x;
  975.                                     x:='';
  976.                                End;
  977.                          'M' : Begin
  978.                                     Delete(x,1,1);
  979.                                     if x<>'' then
  980.                                     Begin
  981.                                          FSplit(x,y,z,t);
  982.                                          if y<>'' then DefRep:=OteBS(y);
  983.                                          if Pos(':',y)<>0 then Begin
  984.                                            Lecteurs:=y[1];
  985.                                          End;
  986.                                          SearchMask:=z+t; x:='';
  987.                                     End;
  988.                                End;
  989.                          'N' : Case PlusMoins(x) of
  990.                                     0: NomComplet:=False;
  991.                                     1: NomComplet:=True;
  992.                                     2: NomComplet:=not NomComplet;
  993.                                End;
  994.                          'P' : Case PlusMoins(x) of
  995.                                     0: PasLesArchives:=False;
  996.                                     1: PasLesArchives:=True;
  997.                                     2: PasLesArchives:=not PasLesArchives;
  998.                                End;
  999.                          'R' : Begin
  1000.                                     Delete(x,1,1);
  1001.                                     if x<>'' then
  1002.                                     Begin
  1003.                                          DefRep:=x; DefRepSet:=True;
  1004.                                          if x[2]=':' then Lecteurs:=x[1];
  1005.                                          x:='';
  1006.                                     End;
  1007.                                End;
  1008.                          'S' : Case PlusMoins(x) of
  1009.                                     0: SousRepAussi:=False;
  1010.                                     1: SousRepAussi:=True;
  1011.                                     2: SousRepAussi:=not SousRepAussi;
  1012.                                End;
  1013.                          'T' : Begin
  1014.                                     Delete(x,1,1);
  1015.                                     if x<>'' then
  1016.                                     Begin
  1017.                                          AffTotaux:=True;
  1018.                                          if x[1]='0' then
  1019.                                          Begin
  1020.                                               ChercheTailleClust:=True;
  1021.                                               Delete(x,1,1);
  1022.                                          End else
  1023.                                          if x[1] in ['A'..'Z'] then
  1024.                                          Begin
  1025.                                               UnCluster:=ClusterSize(x[1]);
  1026.                                               Delete(x,1,1);
  1027.                                               ChercheTailleClust:=False;
  1028.                                          End else
  1029.                                          if x[1]='-' then
  1030.                                          Begin
  1031.                                               Delete(x,1,1); ChercheTailleClust:=False;
  1032.                                          End;
  1033.                                     End;
  1034.                                End;
  1035.                          'U' : Case PlusMoins(x) of
  1036.                                     0: UniquementTot:=False;
  1037.                                     1: UniquementTot:=True;
  1038.                                     2: UniquementTot:=not UniquementTot;
  1039.                                End;
  1040.                          'W' : Case PlusMoins(x) of
  1041.                                     0: VueRapide:=False;
  1042.                                     1: VueRapide:=True;
  1043.                                     2: VueRapide:=not VueRapide;
  1044.                                End;
  1045.                          'X' : Case PlusMoins(x) of
  1046.                                     0: ProcessExe:=False;
  1047.                                     1: ProcessExe:=True;
  1048.                                     2: ProcessExe:=not ProcessExe;
  1049.                                End;
  1050.                          '*' : Case PlusMoins(x) of
  1051.                                     0: TousReps:=False;
  1052.                                     1: TousReps:=True;
  1053.                                     2: TousReps:=not TousReps;
  1054.                                End;
  1055.                          '#' : Case PlusMoins(x) of
  1056.                                     0: Redirige:=False;
  1057.                                     1: Redirige:=True;
  1058.                                     2: Redirige:=not Redirige;
  1059.                                End;
  1060.                          '?' : Begin Delete(x,1,1); AffHelp:=True; End;
  1061.                          ')' : Begin Delete(x,1,1); Debug:=True;   End;
  1062.                           else Delete(x,1,1);
  1063.                     End;
  1064.                End else
  1065.                Begin
  1066.                     { On fait le FSplit à la main pour avoir des MASK et EXT
  1067.                       ayant des tailles supérieures aux normes DOS. Par
  1068.                       exemple: AF *LIS*MOI*.V*D* }
  1069.                     if x[Length(x)]=':' then x:=x+'.\'; j:=Length(x);
  1070.                     While (j>0) and (x[j]<>'\') and (x[j]<>':') do Dec(j);
  1071.                     if j>0 then
  1072.                     Begin
  1073.                          if (j>1) then Rep:=Copy(x,1,j-1) else
  1074.                          if j=1 then Rep:='\';
  1075.                          if j<>Length(x) then x:=Copy(x,j+1,Length(x)-j)
  1076.                                          else x:='';
  1077.                     End;
  1078.                     j:=Pos('.',x);
  1079.                     if j>0 then
  1080.                     Begin
  1081.                          Msk:=Copy(x,1,j-1); Ext:=Copy(x,j,Length(x)-j+1);
  1082.                     End else
  1083.                     Begin
  1084.                          Msk:=x; Ext:='';
  1085.                     End;
  1086.                     While Pos('**',Msk)<>0 do Delete(Msk,Pos('**',Msk),1);
  1087.                     { on agrandis la recherche dans la limite du raisonnable }
  1088.                     if (Msk[Length(Msk)]<>'*') and (Ext='') then Msk:=Msk+'*';
  1089.                     Msk:=Msk+Ext;
  1090.                     if NbMasques=MaxMask then
  1091.                        {$IfDef English}
  1092.                        WriteLn('WARNING: only ',MaxMask,' will be used !') else
  1093.                        {$Else}
  1094.                        WriteLn('ATTENTION: seulement ',MaxMask,' pris en compte !') else
  1095.                        {$Endif}
  1096.                        Begin
  1097.                             Inc(NbMasques); Mask[NbMasques]:=Msk;
  1098.                        End;
  1099.                End;
  1100.           End;
  1101.      End;
  1102.      if Globale and PasLesArchives and not DefRepSet and (Rep<>'')
  1103.         then DefRep:=Rep;
  1104.      if UniquementTot then
  1105.      Begin
  1106.           if not AffTotaux then
  1107.           Begin
  1108.                AffTotaux:=True; ChercheTailleClust:=True;
  1109.           End;
  1110.           BelleVue:=False;
  1111.      End;
  1112.      if (ArchivesSeules and PasLesArchives) or
  1113.         (not Globale and PasLesArchives) then
  1114.      Begin
  1115.           Stupid:=True;
  1116.           {$IfDef English}
  1117.           WriteLn('What a stupid request ! Try option /)');
  1118.           {$Else}
  1119.           WriteLn('Quelle requête idiote ! Essayez l''option /)');
  1120.           {$Endif}
  1121.      End;
  1122.      if ArchivesSeules then Globale:=False;
  1123.      if NbMasques=0 then
  1124.      Begin
  1125.           Inc(NbMasques); Mask[1]:='*';
  1126.      End;
  1127.      if (SearchMask<>'*.*') and TousReps and SousRepAussi
  1128.        then TousReps:=False;
  1129.      if PasLesArchives and Globale and not TousReps and (NbMasques=1) then
  1130.      Begin
  1131.           i:=Pos('*',Mask[1]);
  1132.           if (i=0) or (i<>Length(Mask[1])) or (Mask[1][Succ(i)]<>'.')
  1133.              then SearchMask:=Mask[1] else TousReps:=True;
  1134.      End;
  1135.      if Pos('.',SearchMask)=0 then
  1136.      Begin
  1137.           if SearchMask[Length(SearchMask)]<>'*' then SearchMask:=SearchMask+'*';
  1138.           SearchMask:=SearchMask+'.*';
  1139.      End;
  1140.      if DefRep[Length(DefRep)]=':' then DefRep:=DefRep+'.\';
  1141.      if AffHelp or Debug then
  1142.      Begin
  1143.           if not Debug then
  1144.           Begin
  1145.                {$IfDef English}
  1146.                WriteLn('Usage: AF [Mask*.*] [*Mask*] [/Parameter(s)] [-Parameter(s)]');
  1147.                {$Else}
  1148.                WriteLn('Usage: AF [Masque*.*] [*Masque*] [/Paramètre(s)] [-Paramètre(s)]');
  1149.                {$Endif}
  1150.                WriteLn;
  1151.           End;
  1152.           {$IfDef English}
  1153.           Write('  /a '+PM[ArchivesSeules]+'  Archive names only        ');
  1154.           Write('  /b '+PM[BelleVue]+'  Beautiful vue');
  1155.           WriteLn;
  1156.           Write('  /c    Current directory only    ');
  1157.           Write('  /d... Date (/d+311291 /d=010191)');
  1158.           WriteLn;
  1159.           Write('  /e '+PM[EcrireToutesA]+'  Every name written        ');
  1160.           Write('  /f '+PM[AffTotaux]+'  Full statistics         ');
  1161.           WriteLn;
  1162.           Write('  /g '+PM[Globale]+'  Global search             ');
  1163.           Write('  /i... sIze (/i+1024 /i-2048)  ');
  1164.           WriteLn;
  1165.           Write('  /l... Look drives: '+Justify(Lecteurs,12)+' ');
  1166.           Write('  /m... Mask for archives: '+Justify(SearchMask,16)+' ');
  1167.           WriteLn;
  1168.           Write('  /n '+PM[NomComplet]+'  Names only');
  1169.           WriteLn;
  1170.           Write('  /p '+PM[PasLesArchives]+'  skiP archives             ');
  1171.           Write('  /r... staRting at directory');
  1172.           WriteLn;
  1173.           Write('  /s '+PM[SousRepAussi]+'  Subdirs also              ');
  1174.           Write('  /t... True size on disk');
  1175.           WriteLn;
  1176.           Write('  /u '+PM[UniquementTot]+'  show only totals          ');
  1177.           Write('  /w '+PM[VueRapide]+'  Wide display       ');
  1178.           WriteLn;
  1179.           Write('  /x '+PM[ProcessExe]+'  handle EXE files          ');
  1180.           Write('  /* '+PM[TousReps]+'  all directories');
  1181.          {$Else}
  1182.           Write('  /a '+PM[ArchivesSeules]+'  noms Archives seulement   ');
  1183.           Write('  /b '+PM[BelleVue]+'  Belle vue');
  1184.           WriteLn;
  1185.           Write('  /c    dans Ce répertoire        ');
  1186.           Write('  /d... date (/d+'+ShowDate(DateMini)+' /d-'+ShowDate(DateMaxi)+')');
  1187.           WriteLn;
  1188.           Write('  /e '+PM[EcrireToutesA]+'  tous les noms             ');
  1189.           Write('  /f '+PM[AffTotaux]+'  aFficher les totaux     ');
  1190.           WriteLn;
  1191.           Write('  /g '+PM[Globale]+'  recherche Globale         ');
  1192.           Write('  /i... taille (/i+1024 /i-2048)');
  1193.           WriteLn;
  1194.           Write('  /l... Lecteurs: '+Justify(Lecteurs,12)+'    ');
  1195.           Write('  /m... Masque: '+Justify(SearchMask,16)+' ');
  1196.           WriteLn;
  1197.           Write('  /n '+PM[NomComplet]+'  Nom complets');
  1198.           WriteLn;
  1199.           Write('  /p '+PM[PasLesArchives]+'  Pas les archives          ');
  1200.           Write('  /r... Répertoire de départ');
  1201.           WriteLn;
  1202.           Write('  /s '+PM[SousRepAussi]+'  Sous-répertoires          ');
  1203.           Write('  /t... Taille réelle');
  1204.           WriteLn;
  1205.           Write('  /u '+PM[UniquementTot]+'  totaux Uniquement         ');
  1206.           Write('  /w '+PM[VueRapide]+'  affichage ''Wide''');
  1207.           WriteLn;
  1208.           Write('  /x '+PM[ProcessExe]+'  examine les EXE           ');
  1209.           Write('  /* '+PM[TousReps]+'  tous les répertoires');
  1210.           {$Endif}
  1211.           WriteLn;
  1212.           if not Debug then
  1213.           Begin
  1214.                WriteLn;
  1215.                {$Ifdef ENGLISH}
  1216.                WriteLn('AF looks all over the disks through archives created by Arj, PkZip, Lha,');
  1217.                WriteLn('LhArc, PkArc/PkPak, Arc, Zoo, StuffIt and Tpz for the specified masks.');
  1218.                WriteLn('Exemples: AF *.DOC >MyFile.lst     Result is in "MYFILE.LST"');
  1219.                WriteLn('          AF *.DOC /gmFREE*.ZIP    Only looks in FREE*.ZIP archives');
  1220.                WriteLn('          AF *.DOC /rC:\UTIL       Start searching in C:\Util');
  1221.                WriteLn('          AF -cgmDOC.ZIP -tC       Shows true size after unpacking on C:');
  1222.                {$ELSE}
  1223.                WriteLn('AF cherche sur tout le disque dans les archives créées par Arj, PkZip, Lha,');
  1224.                WriteLn('LhArc, PkArc/PkPak, Arc, Zoo, StuffIt et Tpz le masque spécifié.');
  1225.                WriteLn('Exemples: AF *.DOC >Fichier.lst    le résultat est dans "FICHIER.LST"');
  1226.                WriteLn('          AF *.DOC /gmFREE*.ZIP    recherche dans les FREE*.ZIP seulement');
  1227.                WriteLn('          AF *.DOC /rC:\UTIL       commencer la recherche à C:\Util');
  1228.                WriteLn('          AF -cgmDOC.ZIP -tC       affiche la taille décompactée sur C:');
  1229.                {$Endif}
  1230.           End else
  1231.           Begin
  1232.                {$IfDef English}
  1233.                Write('Mask(s):            ');
  1234.                {$else}
  1235.                Write('Masque(s):          ');
  1236.                {$Endif}
  1237.                For i:=1 to NbMasques do Write('»'+Justify(Mask[i],16)+'«  ');
  1238.           End;
  1239.           Halt;
  1240.      End;
  1241.      if Stupid then Halt(1);
  1242. End;
  1243.  
  1244.  
  1245. {$F+} Procedure MyExitProc; {$F-}
  1246. Var c:String[1];
  1247.     s:String;
  1248. Begin
  1249.      LowVideo;
  1250.      if Redirige or not EcrireToutesA then
  1251.      Begin
  1252.           Write(CrtS,^M); ClrEol;
  1253.      End;
  1254.      if Redirige then WriteLn(CrtS);
  1255.      if AffTotaux then
  1256.        if ArchivesSeules then Begin
  1257.          if NbArcFound>0 then c:='s' else c:='';
  1258.          {$IfDef English}
  1259.          WriteLn(NbArcFound:4,' archive'+c+' found.');
  1260.          {$Else}
  1261.          WriteLn(NbArcFound:4,' archive'+c+' trouvée'+c+'.');
  1262.          {$Endif}
  1263.        End else Begin
  1264.          if NumD>0 then
  1265.          Begin
  1266.               if NumD>1 then c:='s' else c:='';
  1267.               if TotDskR>0 then Begin Str(TotDskR div 1024,s); s:='('+s+' '+MotKo+')'; End
  1268.                            else s:='';
  1269.               {$IfDef English}
  1270.               WriteLn(NumD:4,' ',Justify('file'+c+' on disk',23),TotDsk:8,' bytes ',s);
  1271.               {$Else}
  1272.               WriteLn(NumD:4,' ',Justify('fichier'+c+' sur le disque',23),TotDsk:8,' oct ',s);
  1273.               {$Endif}
  1274.          End;
  1275.          if NumA>0 then
  1276.          Begin
  1277.               if NumA>1 then c:='s' else c:='';
  1278.               if TotArcR>0 then Begin Str(TotArcR div 1024,s); s:=Justify('('+s+' '+motKo+')',10); End
  1279.                            else s:='          ';
  1280.               {$IfDef English}
  1281.               Write(NumA:4,' ',Justify('archived file'+c,23),TotArc:8,' bytes ',s,'    ');
  1282.               {$Else}
  1283.               Write(NumA:4,' ',Justify('fichier'+c+' archivé'+c,23),TotArc:8,' oct ',s,'    ');
  1284.               {$endif}
  1285.               if NbArch=1 then c:='' else c:='s';
  1286.               Write(NbArch,' archive'+c);
  1287.               WriteLn;
  1288.          End;
  1289.        End;
  1290.      if not ArchivesSeules then if not ((NumD<>0) xor (NumA<>0)) then
  1291.      Begin
  1292.           if TotalFound=0 then {$IfDef English} WriteLn('No file found.') else
  1293.                                {$Else} WriteLn('Aucun fichier trouvé.') else {$Endif}
  1294.           Begin
  1295.                if TotalFound=1 then c:='' else c:='s';
  1296.                {$IfDef English}
  1297.                Write(TotalFound:4,' ',Justify('file'+c+' found'+c,23));
  1298.                {$Else}
  1299.                Write(TotalFound:4,' ',Justify('fichier'+c+' trouvé'+c,23));
  1300.                {$Endif}
  1301.                if AffTotaux then
  1302.                Begin
  1303.                     if TotDskR+TotArcR>0
  1304.                        then Begin Str((TotDskR+TotArcR) div 1024,s); s:='('+s+' '+motKo+')'; End
  1305.                        else s:='';
  1306.                     {$IfDef English}
  1307.                     WriteLn(TotDsk+TotArc:8,' bytes ',s);
  1308.                     {$Else}
  1309.                     WriteLn(TotDsk+TotArc:8,' oct ',s);
  1310.                     {$Endif}
  1311.                End;
  1312.                WriteLn;
  1313.           End;
  1314.      End;
  1315.      ChDir(RepOriginal); Close(CrtS); Dispose(Fichiers);
  1316.      ExitProc:=KeepExit;
  1317.      if PatcherIci='' then; {juste pour être dans le code de l'executable}
  1318. End;
  1319.  
  1320.  
  1321. Var Lec:Byte;
  1322. Begin
  1323.      {$IfDef English}
  1324.      WriteLn('Archive Finder   1.26   Jc Boggio/France   Aug, 14 93   Public domain');
  1325.      {$Else}
  1326.      WriteLn('Archive Finder   1.26   Jc Boggio   14-Aoû-93   Domaine public');
  1327.      {$Endif}
  1328.      Redirige:=Redir;
  1329.      LisParametres; WriteLn; Assign(OutPut,''); ReWrite(OutPut);
  1330.      AssignCrt(CrtS); ReWrite(CrtS); TotalFound:=0; New(Fichiers);
  1331.      TotDsk:=0; TotDskR:=0; TotArc:=0; TotArcR:=0; NumA:=0; NumD:=0; NbArcFound:=0;
  1332.      NbArch:=0; GetDir(0,RepOriginal); KeepExit:=ExitProc; ExitProc:=@MyExitProc;
  1333.      if Pos(':',DefRep)<>0 then Cherche(DefRep)
  1334.                            else For Lec:=1 to Length(Lecteurs) do
  1335.                                 Begin
  1336.                                      Pile:=0; {Normalement inutile}
  1337.                                      Cherche(Lecteurs[Lec]+':'+DefRep);
  1338.                                 End;
  1339. End.
  1340.  
  1341.  
  1342. - 1.00  Première version.
  1343.         Scrute les .LZH, les .ARJ, les .ZIP et les .ARC
  1344. - 1.01  Ajout des paramètres /S et /C
  1345. - 1.02  Ajout des fichiers .PAK
  1346.         Accélération de la recherche (50% plus rapide en moyenne, très efficace
  1347.         sur les grosses archives (utilisation du Seek, merci Etche)).
  1348.         Gère la redirection.
  1349.         Ajout du /E /M /A et /N
  1350.         Amélioration de la recherche par défaut
  1351. - 1.03  Suppression du bug lorsqu'aucun paramètre n'est spécifié
  1352.         Possibilité de remplacer le '/' par un '-'
  1353.         Ajout du /G /P et /R
  1354.         Modification du /S
  1355. - 1.04  Ajout des .ZOO (Merci Mr Burns (l'auteur de PibCat))
  1356.         Ajout du /W (merci Mr Buerg (l'auteur de FV entre autres))
  1357. - 1.05  Correction de l'affichage lors d'un /G seul (sans /P)
  1358. - 1.06  Ajout de totaux sur les archives
  1359.         Ajout de quelques ProcessKey pour mieux gérer <Espace>, <Ctrl-C> et <Esc>
  1360.         Amélioration du /C : si un répertoire par défaut est précisé on
  1361.                              remplace le /C par un /S
  1362.         Amélioration du /M : si le masque d'archives est précédé d'un chemin,
  1363.                              celui-ci est placé dans le /R
  1364.         Suppression des '\' final dans les noms de répertoire (c'est plus beau)
  1365.         possibilité de regrouper les paramètres (af -gp par exemple)
  1366.         possibilité de spécifier la valeur + ou - d'un paramètre (af -G+S-)
  1367.         Ajout de certains .SIT (très incertain !)
  1368. - 1.07  Modification mineure du /M pour raison de commodité
  1369.         Ajout du /T et /F
  1370. - 1.08  Ajout du /U et du /#
  1371.         Modification du /E pour inclure l'écriture des répertoires
  1372.         Réparation du /R si rien n'est précisé.
  1373.         Multiples modifications dans l'affichage en particulier pour la
  1374.         gestion de la redirection.
  1375. - 1.09  Accélération des recherches de 28%. Quand on voit la vitesse de
  1376.         "Supersonic Search Tools" on prend peur...
  1377. - 1.10  Accélération des recherches avec la recherche supersonique. 43% par
  1378.         rapport à la version 1.08
  1379.         Ajout du /B
  1380. - 1.11  La recherche supersonique ne pouvant chercher qu'à partir du
  1381.         répertoire \ et posant un problème avec le dos 4.01, elle est
  1382.         laissée de côté pour le moment.
  1383.         Remis en place l'usage de ProcessKey
  1384. - 1.12  Suppression définitive de la recherche supersonique.
  1385.         Suppression du /B
  1386.         Amélioration de la vitesse de 20%
  1387. - 1.13  Ajout de la recherche ultra rapide utilisée par SST (l'ex référence)
  1388.         qui peut ne chercher que les répertoires *.
  1389.         Ici, cette fonction n'est utile qu'en conjonction avec -g et -p
  1390.         (recherche globale, pas dans les archives). Mais elle est TRES utile.
  1391.         SST est dépassé. Essayez AF -GP* *.ZZZ
  1392.         Ajout du /*
  1393. - 1.14  Ajout des masques étendus de 4DOS ! (AF *A*F*.*)
  1394. - 1.15  Ajout de la recherche sur la date et la taille
  1395.         Ajout du /D et /I
  1396. - 1.16  Correction du bug en cas de tentative d'accès à une archive ReadOnly
  1397.         {Fin de la doc}
  1398. - 1.17  Correction mineure pour l'affichage des archives seules >= 10Mo.
  1399.         Multi masques !!! (AF *.Zip *.doc *.pas ...)
  1400.         Possibilité de lancer : AF \dos\*.com -gp
  1401.         A ce stade, on ne peut plus comparer les performances avec les
  1402.         autres produits (Multi masques + masques étendus)
  1403. - 1.18  Compatibilité avec MsDos 5.0 : modification de "ClusterSize".
  1404.         Gère la nouvelle méthode de compression de PkZip "Extra". Bof...
  1405. - 1.19  Correction mineure pour l'affichage /Wide
  1406.         Ajout du /L
  1407.         Pile économisée pendant la recherche des fichiers du disque
  1408.         Ajout du /B (pas la recherche supersonique mais le "Bel affichage")
  1409.         Modifications diverses d'affichage des totaux.
  1410.         /F détermine à présent si il faut afficher les totaux.
  1411.         /G est désormais par défaut sur + !!!
  1412.         Une seule diffusion
  1413. - 1.20  Encore quelques corrections et large diffusion
  1414. - 1.21  Ajout des fichiers TPZ de Patrick TEIL (merci à lui)
  1415.         Amélioration de ProcessKey
  1416.         Léger changement de look pour le contenu des archives
  1417.         Améliorations de Check. Gains de vitesse.
  1418.         Ajout de l'option /) pour VOIR ce que l'on cherche à faire et
  1419.         trouver une erreur
  1420. - 1.22  Les fichiers .A00 à .A99 sont considérés comme des archives ARJ
  1421.         La recherche de fichier dans une archive ne prend plus en compte
  1422.         le sous-répertoire dans lequel se trouve le fichier (jusque là,
  1423.         pour trouver le fichier UTIL\FICHIER.EXT, AF FICHIER* ne
  1424.         fonctionnait pas. Il fallait faire AF *FICHIER*
  1425.         La recherche accepte désormais les masques terminés par un . utile si
  1426.         l'on cherche les fichiers ne portant pas d'extension.
  1427. - 1.23  Debug du -m qui acceptait mal les -mb:xxx
  1428.         Les options /L /M et /R sont correctement affichées par l'option -)
  1429.         Modifications du /a en combinaison avec un masque de fichiers et
  1430.         combinaison avec /f et /n.
  1431.         TRES UTILE notamment pour :
  1432.           AF -AN TEASER.COM >FIC
  1433.           For %a in (@FIC) do Arj d %a teaser.com
  1434.  
  1435.           Ce petit Alias/Batch pour 4Dos fait chercher à AF toutes les
  1436.           archives contenant le fichier TEASER.COM et range cette liste
  1437.           dans FIC. Il ne reste plus qu'à dire à 4Dos de lire ce fichier
  1438.           FIC et pour chaque nom d'archive de supprimer le fichier en question.
  1439.  
  1440.         Correction sur le -C qui désormais fait un -L0 automatiquement
  1441.  
  1442. - 1.24  Création de la version en langue anglaise (non diffusée)
  1443. - 1.25  Corrections diverses langue anglaise
  1444.         Meilleure gestion des "garbages" à la fin des .LZH
  1445.         Changement de nom de la méthode de compactage "Deflat" pour PkZip
  1446.         (anciennement "Extra compression")
  1447. - 1.26  Suppression de problèmes de mémoire (RunTime Error 201)
  1448.         Support des Auto-extractibles LZH et ARJ
  1449.  
  1450. Pseudo CAT sur 3614/3615 DP
  1451.  
  1452. Compuserve ID:  100117,3213
  1453.  
  1454.         Je cherche les formats de tous les Headers des .SIT (les vieux et les
  1455.         nouveaux !) ainsi que des .CPT
  1456.         Si vous avez des idées d'options à rajouter, je suis ouvert,
  1457.         n'hésitez surtout pas !
  1458.  
  1459.