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