home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 9 Archive / 09-Archive.zip / lxlt121s.zip / lxLite_src / noEA.pas < prev    next >
Pascal/Delphi Source File  |  1997-08-17  |  8KB  |  284 lines
  1. {&AlignCode-,AlignData-,AlignRec-,G3+,Speed-,Frame-}
  2. {$M 262144}
  3. uses  use32, Crt, Dos, os2base, miscUtil, SysLib, strOp, Collect,
  4.       CmdLine, lxlite_Global;
  5. const
  6.  Recurse   : boolean = FALSE;
  7.  Pause     : boolean = FALSE;
  8.  Verbose   : boolean = FALSE;
  9.  AssumeYes : boolean = FALSE;
  10.  
  11.  cmBreak   = 0;
  12.  cmLower   = 1;
  13.  cmUpper   = 2;
  14.  cmMixed   = 3;
  15.  cmAsIs    = 4;
  16.  
  17. var
  18.  OldExit   : Procedure;
  19.  fNames    : pStringCollection;
  20.  allDone   : boolean;
  21.  EA        : pEAcollection;
  22.  
  23. Procedure Stop(eCode : Byte);
  24. begin
  25.  case eCode of
  26.   1,2 : begin
  27.          if eCode = 2
  28.           then begin
  29.                 TextAttr := $0C;
  30.                 Writeln('├ Invalid switch - see help below for details');
  31.                end;
  32.          TextAttr := $07;
  33.          Writeln('├ Usage: noEA [FileMask( FileMask)] {[/|-]Options}');
  34.          Writeln('├ /R{+|-} [R]ecursive (+) file search through subdirectories');
  35.          Writeln('├ /P{+|-} Enable (+) or disable (-) pause before each file');
  36.          Writeln('├ /V{+|-} Verbose (show EAs instead of removing them)');
  37.          Writeln('├ /Y{+|-} assume (+) on all queries first available responce');
  38.          Writeln('├ /?,/H   Show this help screen');
  39.          Writeln('├┤Default: /P- /R- /V- /Y-');
  40.          TextAttr := $08;
  41.          Writeln('└┤Example: noEA * /r /v');
  42.         end;
  43.  end;
  44.  Halt(eCode);
  45. end;
  46.  
  47. Function ParmHandler(var S : string) : Byte;
  48. var
  49.  I : Longint;
  50.  
  51. Function Enabled : boolean;
  52. begin
  53.  Enabled := TRUE;
  54.  if length(S) = 1
  55.   then exit
  56.   else
  57.  if (S[2] in ['+','-'])
  58.   then ParmHandler := 2
  59.   else
  60.  if (S[2] in [' ','/'])
  61.   then exit
  62.   else Stop(2);
  63.  if S[2] = '-' then Enabled := FALSE;
  64. end;
  65.  
  66. begin
  67.  ParmHandler := 1;
  68.  case upCase(S[1]) of
  69.   '?',
  70.   'H' : Stop(1);
  71.   'P' : Pause := Enabled;
  72.   'R' : Recurse := Enabled;
  73.   'V' : Verbose := Enabled;
  74.   'Y' : AssumeYes := Enabled;
  75.   else Stop(2);
  76.  end;
  77. end;
  78.  
  79. Function NameHandler(var S : string) : Byte;
  80. var
  81.  fN : string;
  82. begin
  83.  NameHandler := ParseName(S, 1, fN);
  84.  if fN <> '' then fNames^.AtInsert(fNames^.Count, NewStr(fN));
  85. end;
  86.  
  87. Procedure MyExitProc;
  88. begin
  89.  Write(#13);
  90.  TextAttr := $07; ClrEOL;
  91.  OldExit;
  92. end;
  93.  
  94. Function Ask(const Q,A : string) : byte;
  95. var
  96.  ch  : char;
  97. begin
  98.  if AssumeYes then begin Ask := 1; exit; end;
  99.  TextAttr := $02;
  100.  Write('└ ', Q, ' ');
  101.  repeat
  102.   ch := upCase(ReadKey);
  103.   if First(ch, A) <> 0
  104.    then begin
  105.          Ask := First(ch, A);
  106.          break;
  107.         end;
  108.  until FALSE;
  109.  Writeln(Ch,#13'├');
  110. end;
  111.  
  112. {Returns: 0 - file is not locked for write}
  113. {         1 - file is locked and cannot be unlocked}
  114. {         2 - file has been unlocked}
  115. Function CheckUseCount(const fName : string) : byte;
  116. var
  117.  F : File;
  118.  I : Longint;
  119. begin
  120.  CheckUseCount := 0;
  121.  I := FileMode; FileMode := open_access_ReadOnly or open_share_DenyReadWrite;
  122.  Assign(F, fName); Reset(F, 1); Close(F); FileMode := I;
  123.  if ioResult = 0 then exit;
  124.  textAttr := $0E;
  125.  Writeln(#13'├ The module ' + Copy(fName, 1, 40) + ' is used by another process');
  126.  CheckUseCount := 1;
  127.  case Ask('[R]eplace, [S]kip or [A]bort?', 'RSA') of
  128.   1 : ;
  129.   2 : exit;
  130.   3 : begin allDone := TRUE; exit; end;
  131.  end;
  132.  if not unlockModule(fName)
  133.   then begin
  134.         textAttr := $0C;
  135.         Writeln('├ Cannot replace module ' + fName);
  136.         exit;
  137.        end;
  138.  CheckUseCount := 2;
  139. end;
  140.  
  141. Procedure ShowEAs;
  142. var
  143.  I : Longint;
  144.  S : String;
  145. begin
  146.  textAttr := $0E; Write(' EA list:');
  147.  textAttr := $0B; Write(#13'├');
  148.  For I := 0 to pred(EA^.Count) do
  149.   with pFea2(EA^.At(I))^ do
  150.    begin
  151.     Move(szName, S[1], cbName);
  152.     S[0] := char(cbName); if length(S) > 60 then S[0] := #60;
  153.     textAttr := $0B; Write(#13#10'├ ');
  154.     textAttr := $02; Write(S, ' (');
  155.     textAttr := $0F; Write(cbValue, ' bytes');
  156.     textAttr := $02; Write(')');
  157.    end
  158. end;
  159.  
  160. Procedure ProcessFile(fName : string; Attr : Word);
  161. var
  162.  _d : DirStr;
  163.  _n : NameStr;
  164.  _e : ExtStr;
  165.  I  : Longint;
  166.  P  : pFea2;
  167.  
  168. Procedure TrackProcess;
  169. begin
  170.  textAttr := $0B; ClrEOL; Write('└ Processing ', Copy(_n, 1, 32), ' ...');
  171. end;
  172.  
  173. begin
  174.  fSplit(fName, _d, _n, _e);
  175.  _n := _n + _e;
  176.  TrackProcess;
  177.  New(EA, Fetch(fName));
  178.  if EA <> nil
  179.   then begin
  180.         if (EA^.Count = 0)
  181.          then begin textAttr := $03; Write(' no EAs'); end
  182.          else if Verbose
  183.                then ShowEAs
  184.                else begin
  185.                      For I := 0 to pred(EA^.Count) do
  186.                       with pFea2(EA^.At(I))^ do
  187.                        begin
  188.                         GetMem(P, sizeOf(Fea2) + cbName);
  189.                         Move(oNextEntryOffset, P^, sizeOf(Fea2) + cbName);
  190.                         P^.cbValue := 0;
  191.                         EA^.AtFree(I);
  192.                         EA^.AtInsert(I, P);
  193.                        end;
  194.                      if Attr and Directory = 0
  195.                       then case CheckUseCount(fName) of
  196.                             1 : Exit;
  197.                             2 : TrackProcess;
  198.                            end;
  199.                      if EA^.Attach(fName)
  200.                       then begin textAttr := $0A; Write(' ok'); end
  201.                       else begin textAttr := $0C; Write(' sharing violation'); end;
  202.                     end;
  203.         textAttr := $0B;
  204.         if (Verbose and (EA^.Count > 0)) then Writeln(#13'├') else Write(#13);
  205.         Dispose(EA, Destroy);
  206.        end
  207.   else begin
  208.         textAttr := $0C; Write(' error');
  209.         textAttr := $0B; Writeln(#13'├');
  210.        end;
  211. end;
  212.  
  213. Procedure ProcessFiles(const fN : string; Level : Longint);
  214. var
  215.  sr : SearchRec;
  216.  nf : Longint;
  217.  _d : DirStr;
  218.  _n : NameStr;
  219. begin
  220.  _d := extractDir(fN);
  221.  _n := extractName(fN);
  222.  FindFirst(fN, Archive or Hidden or SysFile or Directory, sr);
  223.  nf := 0;
  224.  if (Dos.DosError <> 0) and (Level = 0) and (not Recurse)
  225.   then begin
  226.         textAttr := $0C;
  227.         Writeln('├ Cannot find such files: ', fN);
  228.        end
  229.   else
  230.  While (Dos.DosError = 0) and (not allDone) do
  231.   begin
  232.    Inc(nf);
  233.    if (length(_d) + length(sr.Name) <= 255) and (sr.Name[1] <> '.')
  234.     then begin
  235.           if Pause
  236.            then case Ask('File ' + sr.Name + ': [P]rocess, [S]kip or [A]bort?', 'PSA') of
  237.                  2 : sr.Name := '';
  238.                  3 : begin allDone := TRUE; break; end;
  239.                 end;
  240.           if (sr.Name <> '') then ProcessFile(_d + sr.Name, sr.Attr);
  241.          end;
  242.    FindNext(sr);
  243.   end;
  244.  FindClose(sr);
  245.  if allDone or not Recurse then Exit;
  246.  if nf = 0
  247.   then begin
  248.         textAttr := $0B; Write('└ ', Short(_d, 77));
  249.         ClrEOL; Write(#13);
  250.        end;
  251.  FindFirst(_d + '*', Archive or Hidden or SysFile or Directory, sr);
  252.  While (Dos.DosError = 0) and (not allDone) do
  253.   begin
  254.    if (sr.Attr and Directory <> 0) and (sr.Name[1] <> '.') and
  255.       (length(_d) + length(sr.Name) + length(_n) + 1 <= 255)
  256.     then ProcessFiles(_d + sr.Name + '\' + _n, succ(Level));
  257.    FindNext(sr);
  258.   end;
  259.  FindClose(sr);
  260. end;
  261.  
  262. var
  263.  I : Longint;
  264.  
  265. begin
  266.  TextAttr := $0F;
  267.  Writeln('┌[ noEA ]────────────────────────────────[ Version '+Version+']┐');
  268.  Writeln('├ Copyright 1996 by FRIENDS software ─ No rights reserved ┘');
  269.  TextAttr := $07;
  270.  @OldExit := ExitProc; ExitProc := @MyExitProc;
  271.  New(fNames, Create(8, 8));
  272.  ParseCommandLine(#0, ParmHandler, NameHandler);
  273.  if (fNames^.Count = 0) then Stop(1);
  274.  
  275.  For I := 0 to pred(fNames^.Count) do
  276.   begin
  277.    ProcessFiles(pString(fNames^.At(I))^, 0);
  278.    if allDone then break;
  279.   end;
  280.  
  281.  TextAttr := $01; ClrEOL;
  282.  Writeln('└┤Done');
  283. end.
  284.