home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CHMOD.ZIP / CHMOD.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1988-03-31  |  6.1 KB  |  306 lines
  1. (*
  2.  *  chmod.pas - UNIX-like chmod utility in Turbo Pascal v4.0 (MsDos)
  3.  *
  4.  *    usage: chmod [-rhsa] [+rhsa] file(s)
  5.  *    where
  6.  *      - turns OFF,  + turns ON
  7.  *      r : Read Only
  8.  *      h : Hidden
  9.  *      s : System
  10.  *      a : Archive
  11.  *
  12.  *  note:  any combination of switches followed by filenames is legal, i.e.
  13.  *    chmod -a +rhs -r file1.pas *.c ???h.h
  14.  *    chmod -ahs +r *.* /*.bak \tmp\*.spl
  15.  *
  16.  *  and either '\' or '/' may be used as a path separator
  17.  *
  18.  *  chmod was originally written to test the wildcard handling routines -
  19.  *  thanks much to Karl Brendel for pointing out that the original
  20.  *  version didn't actually WORK,  except in select cases (not
  21.  *  coincidentally,  the cases i tested).
  22.  *
  23.  *  this program is hereby dedicated to the public domain, etc, etc
  24.  *
  25.  *  Paul Roub
  26.  *  786 Loggerhead Island Dr.
  27.  *  Satellite Beach, FL 32937
  28.  *
  29.  *  Compuserve: 71131, 157
  30.  *
  31.  *)
  32. program ChangeMode;
  33.  
  34. uses
  35.   dos;
  36.  
  37. const
  38.   ro    = $0001;
  39.   hid   = $0002;
  40.   sys   = $0004;
  41.   arc   = $0020;
  42.   carry = $0001;
  43.  
  44. type
  45.   string80 = string[80];
  46.   DtaRec   = record
  47.                garbage  : array[0..20] of byte;
  48.                attr     : byte;
  49.                time     : word;
  50.                date     : word;
  51.                size     : LongInt;
  52.                filename : array[1..13] of char;
  53.              end;
  54.  
  55. var
  56.   dta      : DtaRec;
  57.   Archive,                            (* attribute switches -              *)
  58.   Hidden,                             (*    0 if turning OFF               *)
  59.   SysAtt,                             (*    1 if turning ON                *)
  60.   ReadOnly : integer;                 (*   -1 if no change                 *)
  61.  
  62.  
  63. (*
  64.  *  Name:        StripPath
  65.  *  Description: gets path part of filespec
  66.  *  Parameters:  var
  67.  *                 full, path : string80
  68.  *)
  69. procedure StripPath(var full, path : string80);
  70. var
  71.   slpos : integer;
  72. begin
  73.   for slpos := 1 to length(full) do
  74.     if (full[slpos] = '/') then
  75.       full[slpos] := '\';
  76.  
  77.   slpos := length(full);
  78.  
  79.   while ((slpos > 0) and (full[slpos] <> '\')) do
  80.     slpos := pred(slpos);
  81.  
  82.   if (slpos <> 0) then
  83.     path := copy(full, 1, slpos)
  84.   else
  85.     path := '';
  86. end;
  87.  
  88.  
  89. (*
  90.  *  Name:        chmod
  91.  *  Description: changes attributes of specified file
  92.  *  Parameters:  var
  93.  *                 name : string80
  94.  *               value
  95.  *                 ReadOnly, Hidden, SysAtt, Archive : BOOLEAN
  96.  *)
  97. procedure chmod(var name                              : string80;
  98.                     ReadOnly, Hidden, SysAtt, Archive : integer);
  99. var
  100.   regs : Registers;
  101.   att  : word;
  102.   tn   : string80;
  103. begin
  104.   tn := name + #0;
  105.  
  106.   regs.ax := $4300;
  107.   regs.ds := seg(tn);
  108.   regs.dx := ofs(tn[1]);
  109.  
  110.   MsDos(regs);
  111.  
  112.   att := regs.cx;
  113.  
  114.   if (ReadOnly = 1) then
  115.     att := att OR ro;
  116.   if (Hidden = 1) then
  117.     att := att OR hid;
  118.   if (SysAtt = 1) then
  119.     att := att OR sys;
  120.   if (Archive = 1) then
  121.     att := att OR arc;
  122.  
  123.   if (ReadOnly = 0)  then
  124.     att := att AND not ro;
  125.   if (Hidden = 0) then
  126.     att := att AND not hid;
  127.   if (SysAtt = 0)  then
  128.     att := att AND not sys;
  129.   if (Archive = 0) then
  130.     att := att AND not arc;
  131.  
  132.   regs.ax := $4301;
  133.   regs.cx := att;
  134.   regs.dx := ofs(tn[1]);
  135.   regs.ds := seg(tn);
  136.  
  137.   MsDos(regs);
  138. end;
  139.  
  140.  
  141. (*
  142.  *  Name:        dispatch
  143.  *  Description: calls chmod for each file in wildcard expansion of 'mask'
  144.  *  Parameters:  var
  145.  *                 mask : string80
  146.  *)
  147. procedure dispatch(var mask : string80);
  148. var
  149.   path       : string80;
  150.   regs       : Registers;
  151.   tm, victim : string80;
  152.   ps         : boolean;
  153.   count      : integer;
  154.   any        : boolean;
  155. begin
  156.   StripPath(mask, path);
  157.  
  158.   tm := mask + #0;
  159.  
  160.   regs.ax := $4E00;
  161.   regs.cx := $0027;
  162.   regs.ds := seg(tm);
  163.   regs.dx := ofs(tm[1]);
  164.  
  165.   MsDos(regs);
  166.  
  167.   ps := (path <> '') and (path[length(path)] <> '\');
  168.  
  169.   any := false;
  170.  
  171.   while ((regs.flags and carry) = 0) do
  172.   begin
  173.     any := true;
  174.  
  175.     victim := path;
  176.     if (ps) then
  177.         victim := victim + '\';
  178.  
  179.     count := 1;
  180.  
  181.     while (dta.filename[count] <> #0) do
  182.     begin
  183.       victim := victim + dta.filename[count];
  184.       count := succ(count);
  185.     end;
  186.  
  187.     chmod(victim, ReadOnly, Hidden, SysAtt, Archive);
  188.  
  189.     regs.ah := $4F;
  190.     msdos(regs);
  191.   end;
  192.  
  193.   if (not any) then
  194.     writeln('no files found matching ', mask);
  195. end;
  196.  
  197.  
  198. (*
  199.  *  Name:         initialize
  200.  *  Description:  initialize globals
  201.  *  Parameters:   none
  202.  *)
  203. procedure initialize;
  204. var
  205.   regs : Registers;
  206. begin
  207.   regs.ah := $1A;
  208.   regs.ds := seg(dta);
  209.   regs.dx := ofs(dta);
  210.   MsDos(regs);
  211.   Archive  := -1;
  212.   SysAtt   := -1;
  213.   Hidden   := -1;
  214.   ReadOnly := -1;
  215. end;
  216.  
  217.  
  218. (*
  219.  *  Name:        usage
  220.  *  Description: print syntax message,  exit with error code 1
  221.  *  Parameters:  none
  222.  *)
  223. procedure usage;
  224. begin
  225.   writeln('usage: chmod [-rhsa] [+rhsa] file(s)');
  226.   halt(1);
  227. end;
  228.  
  229.  
  230. (*
  231.  *  Name:         ProcessParms
  232.  *  Description:  processes command-line parameters
  233.  *  Parameters:   none
  234.  *)
  235. procedure ProcessParms;
  236. var
  237.   count    : integer;
  238.   files,
  239.   switches : boolean;
  240.   parm     : string80;
  241.   val,
  242.   len,
  243.   count2   : integer;
  244. begin
  245.   files    := FALSE;
  246.   switches := FALSE;
  247.  
  248.   parm := ParamStr(1);
  249.   count := 1;
  250.  
  251.   while (((parm[1] = '-') or (parm[1] = '+')) and (count <= ParamCount)) do
  252.   begin
  253.     switches := TRUE;
  254.  
  255.     if (parm[1] = '+') then
  256.       val := 1
  257.     else
  258.       val := 0;
  259.  
  260.     count2 := 2;
  261.     len := length(parm);
  262.  
  263.     while (count2 <= len) do
  264.     begin
  265.       case (parm[count2]) of
  266.         'a' : Archive  := val;
  267.         'r' : ReadOnly := val;
  268.         'h' : Hidden   := val;
  269.         's' : SysAtt   := val;
  270.         else
  271.           usage;
  272.        end;
  273.  
  274.        count2 := succ(count2);
  275.     end;
  276.  
  277.     count := succ(count);
  278.     parm := ParamStr(count);
  279.   end;
  280.  
  281.   if (not switches) then
  282.     usage;
  283.  
  284.   while (count <= ParamCount) do
  285.   begin
  286.     files := TRUE;
  287.  
  288.     parm := ParamStr(count);
  289.     dispatch(parm);
  290.  
  291.     count := succ(count);
  292.   end;
  293.  
  294.   if (not files) then
  295.     usage;
  296. end;
  297.  
  298.  
  299. (*
  300.  *  main routine
  301.  *)
  302. begin
  303.   initialize;
  304.   ProcessParms;
  305. end.
  306.