home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 3 / goldfish_volume_3.bin / files / util / rexx / rexxdossupport / txt / rexxdossupport.mod next >
Text File  |  1995-04-01  |  39KB  |  1,222 lines
  1. (*(***********************************************************************
  2.  
  3. :Program.    rexxdossupport.mod
  4. :Contents.   access to V37+ Dos.library functions from within ARexx
  5. :Author.     hartmtut Goebel [hG]
  6. :Address.    Aufseßplatz 5, D-90459 Nürnberg
  7. :Address.    UseNet: hartmut@oberon.nbg.sub.org
  8. :Copyright.  Copyright © 1993 by hartmtut Goebel
  9. :Language.   Oberon-2
  10. :Translator. Amiga Oberon 3.11
  11. :Imports.    Printf (Volker Rudolph), RxLibsSupport [hG]
  12. :Version.    $VER: rexxdossupport.mod 2.3 (1.4.95) Copyright © 1994,1995 by hartmtut Goebel
  13.  
  14. (* $StackChk- $NilChk- $RangeChk- $CaseChk- $OvflChk- $ReturnChk- $ClearVars- *)
  15. (****** rexxdossupport.library/--history-- **********************
  16. *
  17. *  2.3  01 Apr 1995
  18. *       · fixed problem with synonyms: foo=bar lead to illegal
  19. *         variable named 'FOO=BAR'. Now allways th first synonym is
  20. *         taken as var-name.
  21. *
  22. *  2.2  18 Jul 1994
  23. *       · Shame on me! library names must be lowercase
  24. *       · Some more notes in documentation
  25. *  2.1  03 Jun 1994
  26. *       · removed curious bug in ReadArgs() (uninitialized var,
  27. *         introduced in V2.0)
  28. *  2.0  07 May 1994 (never released)
  29. *       · stronger check for present args to avoid NIL-Traps
  30. *       · new functions: Delete(), Rename(), MakeDir(),
  31. *                        SetComment(), SetProtection()
  32. *  1.4  01 Feb 1994
  33. *       · only significant part of parsed pattern is copied
  34. *         into the ARexx Argstring
  35. *  1.3  23 Jan 1994
  36. *       · uses module RxLibsSupport [hG]
  37. *  1.2  18 Jan 1994
  38. *       · finished dokumentation
  39. *       · UnsetVar() - like shell commnad - renamed to
  40. *         DeleteVar() - like in dos.library
  41. *       · SetVar() no longer accepts option "Binary"
  42. *  1.1  16 Jan 1994
  43. *       initial release
  44. *
  45. *******
  46. (****** rexxdossupport.library/--Disclaimer-- **********************
  47. *
  48. *Disclaimer
  49. *----------
  50. *
  51. *   Permission is granted to make and distribute verbatim copies  of  this
  52. *manual provided the copyright  notice  and  this  permission  notice  are
  53. *preserved on all copies.
  54. *
  55. *COPYRIGHT
  56. *
  57. *   Copyright (C) 1994 by hartmut Goebel
  58. *
  59. *   No program, document, data file or  source  code  from  this  software
  60. *package, neither in whole nor in part, may be included or used  in  other
  61. *software packages unless it is authorized by a  written  permission  from
  62. *the author.
  63. *
  64. *
  65. *NO WARRANTY
  66. *
  67. *   There is no warranty for this software package.  Although  the  author
  68. *has tried to prevent errors, he can't guarantee that the software package
  69. *described in this document is 100% reliable. You are therefore using this
  70. *material at your own risk. The author cannot be made responsible for  any
  71. *damage which is caused by using this software package.
  72. *
  73. *
  74. *DISTRIBUTION
  75. *
  76. *   This software package is freely distributable. It may be  put  on  any
  77. *media which is used for the distribution of free  software,  like  Public
  78. *Domain disk collections, CDROMs, FTP servers or bulletin board systems.
  79. *
  80. *   In  order  to  ensure  the  integrity  of   this   software   package,
  81. *distributors should use the original archive file  rexxdossupport2_2.lha.
  82. *The author cannot be  made  responsible  if  this software  package   has
  83. *become unusable due to modifications of  the  archive  contents   or   of
  84. *the archive file itself.
  85. *
  86. *   There is no limit on the costs  of  the  distribution,  e.g.  for  the
  87. *media, like floppy disks, streamer tapes or compact disks, or the process
  88. *of duplicating. Such limits have been proven to be harmful to the idea of
  89. *freely distributable software, e.g. instead of reducing the price of  the
  90. *floppy disk below the limit, the software was  simply  removed  from  the
  91. *master disk.
  92. *
  93. *   Although the author does not impose any limit on the  distribution  of
  94. *this software package, he would like to express his personal opinions  on
  95. *this matter:
  96. *
  97. *   * This software package should be made available to everyone  free  of
  98. *     charge whenever it is possible.
  99. *
  100. *   * If you have acquired this software package under  normal  conditions
  101. *     from a Public Domain dealer on a floppy disk at a price higher  than
  102. *     5DM or US $5, then you have definitely paid too much.  Please  don't
  103. *     support this improper profit making  any  longer  and  switch  to  a
  104. *     cheaper source as soon as possible.
  105. *
  106. *
  107. *USAGE RESTRICTIONS
  108. *
  109. *   No program, document, data file or  source  code  from  this  software
  110. *package, neither in whole nor in part, may be used on any  machine  which
  111. *is used
  112. *
  113. *   * for the research, development, construction, testing  or  production
  114. *     of weapons or other military applications. This  also  includes  any
  115. *     machine which is  used  in  the  education  for  any  of  the  above
  116. *     mentioned purposes.
  117. *
  118. *   * by people who accept, support or use violence against other  people,
  119. *     e.g. citizens from foreign countries.
  120. *
  121. *********)*)*)*)
  122. (****** rexxdossupport.library/--background-- *******************
  123. *
  124. *                rexxdossupport.library 2.2
  125. *                ==========================
  126. *
  127. *            Copyright (C) 1994 by hartmut Goebel
  128. *
  129. *
  130. *   After programming ARexx script for quite a while, I missed some
  131. *   function found in dos.library --  especially access to
  132. *   environment variables and the comfortable argument parsing. Since
  133. *   there seamed to be no ARexx function library which implements
  134. *   this functions, I decited to write my own. And here it is.
  135. *
  136. *   This are the functions handled by this library.
  137. *   · ReadArgs()
  138. *   · GetVar(), SetVar(), DeleteVar()
  139. *   · ParsePattern(), MatchPattern() - even case-insensitive
  140. *   · Fault()
  141. *
  142. *   new functions for version 2.1
  143. *   · Delete(), Rename(), MakeDir()
  144. *   · SetComment(), SetProtection()
  145. *
  146. *   Enjoy it!
  147. *   +++hartmut
  148. *
  149. *********)
  150. (****** rexxdossupport.library/--installation-- *******************
  151. *
  152. *   To use rexxdossupport.library, just copy is to yout LIBS:
  153. *   directory. That's all.
  154. *
  155. *   The LVO for the ARexx-Dispatcher is -30.
  156. *       NB: it's the only LVO for this library :-)
  157. *
  158. *   So, in every ARexx-Script you want to use rexxdossupport.library,
  159. *   insert
  160. *
  161. *      call addlib("rexxdossupport.library",0,-30,2)
  162. *
  163. *   somewhere before the first call to one of the routines
  164. *   implemented in this library.
  165. *   Since ARexx does not check whether the lib can be opened but only
  166. *   inserts the name into a list, the result value from addlib() can
  167. *   be ignored in most cases. The value would be interesting to check
  168. *   if the added note will require the same library version, but I
  169. *   don't know how to find this out.
  170. *
  171. *********)
  172.  
  173. MODULE rexxdossupport;
  174. (* $StackChk- $ClearVars- *)
  175.  
  176. IMPORT
  177.   d := Dos,
  178.   e := Exec,
  179.   str := Strings,
  180.   pf := Printf,
  181.   ol := OberonLib,
  182.   rx := Rexx,
  183.   rxs := RexxSysLib,
  184.   rvi := RVI,
  185.   rls := RxLibsSupport,
  186.   y := SYSTEM;
  187.  
  188. CONST
  189.   versionString = "$VER: rexxdossupport 2.3 (1.4.95) Copyright © 1994,1995 by hartmtut Goebel";
  190.  
  191.   progNotFound = rls.progNotFound;
  192.   noMemory     = rls.noMemory;
  193.   badNumArgs   = rls.badNumArgs;
  194.   stringTooLong= rx.err10009;
  195.   funcErr      = rx.err10012;
  196.   invalidArg   = rx.err10018;
  197.   nestingLevel = rx.err10043;
  198.   invalidTemplate = rx.err10037;
  199.   errorReturnFromFunc = rx.err10012;
  200.  
  201.   strTRUE  = rls.strTRUE;
  202.   strFALSE = rls.strFALSE;
  203.  
  204. PROCEDURE ^ GetVar (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  205. PROCEDURE ^ SetVar (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  206. PROCEDURE ^ DeleteVar (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  207. PROCEDURE ^ MatchPattern (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  208. PROCEDURE ^ ParsePattern (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  209. PROCEDURE ^ Fault (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  210. PROCEDURE ^ ReadArgs (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  211. (* new for V2.0 *)
  212. PROCEDURE ^ Delete (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  213. PROCEDURE ^ Rename (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  214. PROCEDURE ^ MakeDir (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  215. PROCEDURE ^ SetComment (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  216. PROCEDURE ^ SetProtection (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  217.  
  218. CONST
  219.   numFunctions = 12;
  220.  
  221. TYPE
  222.   FunctionList = ARRAY numFunctions OF rls.FunctionListEntry;
  223.  
  224. CONST
  225.   functionList = FunctionList(
  226.     y.ADR("GetVar"),1,3,GetVar,
  227.     y.ADR("SetVar"),2,3,SetVar,
  228.     y.ADR("DeleteVar"),1,2,DeleteVar,
  229.     y.ADR("MatchPattern"),2,4,MatchPattern,
  230.     y.ADR("ParsePattern"),1,2,ParsePattern,
  231.     y.ADR("Fault"),1,2,Fault,
  232.     y.ADR("ReadArgs"),2,3,ReadArgs,
  233.     y.ADR("Delete"),1,1,Delete,
  234.     y.ADR("Rename"),2,2,Rename,
  235.     y.ADR("SetComment"),2,2,SetComment,
  236.     y.ADR("SetProtection"),2,2,SetProtection,
  237.     y.ADR("MakeDir"),1,1,MakeDir
  238.   );
  239.  
  240. (* ---------------------------------------------------------------- *)
  241.  
  242. (****** rexxdossupport.library/ReadArgs ***************
  243. *
  244. *   NAME
  245. *       ReadArgs -- Parse argument string using Dos/ReadArgs()
  246. *
  247. *   SYNOPSIS
  248. *       okay = ReadArgs( arguments, template, [stem] )
  249. *
  250. *   FUNCTION
  251. *       Parses an argument string according to a template. See
  252. *       dos.library/ReadArgs() for details and describtion of the
  253. *       template.
  254. *
  255. *       This function supports the following template options:
  256. *
  257. *       /S - Switch.  Resulting variable will be either true (1) or
  258. *            false (0).
  259. *       /N - Number.
  260. *       /M - Multiple strings.  See below for further information.
  261. *
  262. *       /K - Keyword.      }
  263. *       /A - Required.     }  handled by dos
  264. *       /F - Rest of line. }
  265. *
  266. *       /T (toggle) is not supported, since handling this would be a
  267. *       large turnover with small profit.
  268. *
  269. *   INPUTS
  270. *       arguments - the string to be parsed
  271. *       template  - dos.library/ReadArgs()-style like template
  272. *       stem      - stem prefix for resulting variables (optional)
  273. *
  274. *   RESULT
  275. *       okay  - boolean value indicating success.
  276. *
  277. *       RC (rexx variable) - contains the dos error code if the
  278. *               function was not successfull. This can can directly
  279. *               be used as input for Fault().
  280. *
  281. *       For each item in the template which has a corresponding
  282. *       argument, a Rexx variable will be created. The variable's
  283. *       name is the item's name prefixed by the stem name (if given).
  284. *
  285. *       Items with option /M will result in a stem variable with a
  286. *       .COUNT node containing the number of elements. If no fitting
  287. *       arguments is passed, .COUNT will be zero.
  288. *       The entries will be in stem nodes .0 to .n (where n is
  289. *       .COUNT-1).
  290. *
  291. *   EXAMPLE
  292. *       /* ReadArgsExample.rexx */
  293. *       /* AddLib() here */
  294. *
  295. *       parse arg args /* get the arguments w/o ARexx-Parsing */
  296. *
  297. *       template = "Files/M,Method/K,MinSize/K/N,Test/S"
  298. *
  299. *       /* set defaults */
  300. *       Method = "NUKE"; MinSize = 512;
  301. *
  302. *       /* no stem given: results are assigned to simple variables */
  303. *
  304. *       if ReadArgs(args,template) then
  305. *         say 'Method =' method '  MinSize =' MinSize '  Test =' test
  306. *         do i = 0 by 1 for file.count
  307. *           say name.1
  308. *         end
  309. *
  310. *       /* stem given: results are assigned to stem variable */
  311. *       /* since the default values are set as non-stem variables,
  312. *        * they are not overwritten by the following call even if
  313. *        * given
  314. *        */
  315. *
  316. *       if ReadArgs(input,template,"args.") then
  317. *         say 'Method =' args.method '  MinSize =' args.MinSize ' Test =' args.test
  318. *         do i = 0 by 1 for args.file.count
  319. *           say args.name.1
  320. *         end
  321. *
  322. *   SEE ALSO
  323. *      Fault(), dos.library/ReadArgs()
  324. *
  325. ***********************)
  326.  
  327. PROCEDURE ReadArgs (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  328.  
  329.   TYPE ArgsArray = UNTRACED POINTER TO ARRAY d.maxMultiArgs+1 OF LONGINT;
  330.  
  331.   PROCEDURE CreateSTEM (msg: rx.RexxMsgPtr;
  332.                         template: e.LSTRPTR;
  333.                         resarray: ArgsArray;
  334.                         stembase: e.STRPTR): INTEGER;
  335.  
  336.   VAR
  337.     synonym, result, rs, rb, t, wordCnt: INTEGER;
  338.     opts, optn, optm: BOOLEAN;
  339.     longbuff: rls.ConvertLongBuffer;
  340.     resb: ARRAY 512 OF CHAR;
  341.  
  342.     PROCEDURE GetValue (value: LONGINT): INTEGER;
  343.     VAR
  344.       string: e.LSTRPTR;
  345.     BEGIN
  346.       IF opts THEN
  347.         IF value = d.DOSFALSE THEN string := y.ADR(strFALSE);
  348.                               ELSE string := y.ADR(strTRUE);  END;
  349.       ELSIF optn THEN (* numerisch *)
  350.         pf.SPrintf1(longbuff, "%ld", y.VAL(ArgsArray,value)[0]);
  351.         string := y.ADR(longbuff);
  352.       ELSE (* string *)
  353.         string := y.VAL(e.LSTRPTR,value);
  354.       END;                                                                (*$RangeChk-*)
  355.       RETURN SHORT(rvi.SetRexxVar(msg,resb,string^,str.Length(string^))); (*$RangeChk=*)
  356.     END GetValue;
  357.  
  358.     PROCEDURE CreateResultList(value: ArgsArray): INTEGER;
  359.     VAR
  360.       index: INTEGER;
  361.       tt: e.STRPTR;
  362.       result: INTEGER;
  363.     BEGIN
  364.       tt := y.ADR(resb[t]);
  365.       index := 0;
  366.       IF value # NIL THEN
  367.         WHILE value[index] # NIL DO
  368.           pf.SPrintf1( tt^, ".%ld", index); (* Index an den Stem-Namen anhängen *)
  369.           result := GetValue(value[index]);
  370.           IF result # 0 THEN RETURN result; END;
  371.           INC(index);
  372.         END;
  373.       END;
  374.       tt^ := ".COUNT"; (* Die Count-Node ausfüllen *)
  375.       pf.SPrintf1( longbuff, "%ld", index );                                (*$RangeChk-*)
  376.       RETURN SHORT(rvi.SetRexxVar(msg,resb,longbuff,str.Length(longbuff))); (*$RangeChk=*)
  377.     END CreateResultList;
  378.  
  379.   BEGIN
  380.     wordCnt := 0; result := rx.ok;
  381.     IF stembase # NIL THEN (* Präfix einbauen *)
  382.       COPY(stembase^,resb); rb := SHORT(str.Length(resb));
  383.       str.Upper(resb);
  384.     ELSE
  385.       resb := ""; rb := 0;
  386.     END;
  387.     rs := 0;
  388.  
  389.     (* Liste aufbauen *)
  390.     WHILE template[rs] # CHR(0) DO
  391.       t := rb; optn := FALSE; optm := FALSE; opts := FALSE; synonym := -1;
  392.       LOOP
  393.         CASE template[rs] OF
  394.         | CHR(0): EXIT;
  395.         | ",": INC(rs); EXIT;
  396.         | "=": synonym := t;
  397.         | "/":
  398.           INC(rs);
  399.           CASE CAP(template[rs]) OF
  400.           | "N": optn := TRUE;
  401.           | "M": optm := TRUE;
  402.           | "S": opts := TRUE;
  403.           ELSE END;
  404.         ELSE
  405.           resb[t] := CAP(template[rs]); INC(t); (* Resultatnamen kopieren *)
  406.         END;
  407.         INC(rs);
  408.       END;
  409.       IF synonym >= 0 THEN t := synonym; END;
  410.       resb[t] := CHR(0);
  411.       IF opts THEN
  412.         optm := FALSE; optn := FALSE; END;
  413.  
  414.       (* hier ist nun der Basisname der Stem-Variable in resb,
  415.        * und t zeigt in resb auf die Stelle, an der nun ggf. die
  416.        * Stem-Erweiterungen (.COUNT, .0 - .n) angehängt werden
  417.        *)
  418.       IF optm THEN (* /M war im Namen, also Liste *)
  419.         result := CreateResultList(y.VAL(ArgsArray,resarray[wordCnt]));
  420.       ELSE (* keine Liste *)
  421.         IF opts OR (resarray[wordCnt] # NIL) THEN
  422.           result := GetValue(resarray[wordCnt]);
  423.         END;
  424.       END;
  425.       IF result # rx.ok THEN RETURN result; END;
  426.       INC(wordCnt);
  427.     END;
  428.     RETURN result;
  429.   END CreateSTEM;
  430.  
  431. CONST
  432.   rdArgsDefault = d.RDArgs(NIL,0,0, 0, NIL,0,NIL,LONGSET{d.noPrompt});
  433.   argInput = 1; argTemplate = 2; argStem = 3;
  434. VAR
  435.   argv: UNTRACED POINTER TO d.ArgsStruct;
  436.   arguments, rdArgs: d.RDArgsPtr;
  437.   pos, numArgs: LONGINT;
  438.   retval: INTEGER;
  439.   input: e.LSTRPTR;
  440. BEGIN (* ReadArgs *)
  441.   IF ~ rls.ArgsPresent(msg,1,2) THEN RETURN invalidArg; END;
  442.   IF (rx.ActionArg(msg.action) < argStem) THEN msg.args[argStem] := NIL; END;
  443.   retval := noMemory;
  444.   pos := rxs.LengthArgstring(msg.args[argInput]);
  445.   input := rxs.CreateArgstring(msg.args[argInput]^,pos+1);
  446.   IF input # NIL THEN
  447.     input[pos] := CHR(0AH); (* LineFeed, needed for ReadArgs() *)
  448.  
  449.     numArgs := 0; pos := -1;
  450.     REPEAT
  451.       INC(numArgs);
  452.       pos := str.OccursPos(msg.args[argTemplate]^,",",pos+1);
  453.     UNTIL pos < 0;
  454.  
  455.     rdArgs := d.AllocDosObject(d.rdArgs,NIL);
  456.     IF rdArgs # NIL THEN
  457.       ol.Allocate(argv,numArgs*SIZE(e.APTR));
  458.       IF argv # NIL THEN
  459.         rdArgs^ := rdArgsDefault;
  460.         rdArgs.source.buffer := y.ADR(input^);
  461.         rdArgs.source.length := rxs.LengthArgstring(input);
  462.  
  463.         arguments := d.ReadArgs(msg.args[argTemplate]^,argv^,rdArgs);
  464.         IF arguments = NIL THEN
  465.           resultStr := rxs.CreateArgstring(strFALSE,1);
  466.           retval := rls.SetRC(msg,d.IoErr());
  467.         ELSE
  468.           resultStr := rxs.CreateArgstring(strTRUE,1);
  469.           retval := CreateSTEM(msg, msg.args[argTemplate],
  470.                                y.VAL(ArgsArray,argv),
  471.                                y.VAL(e.STRPTR,msg.args[argStem]));
  472.           d.FreeArgs(arguments);
  473.         END;
  474.         IF resultStr = NIL THEN retval := noMemory; END;
  475.         DISPOSE(argv);
  476.       END;
  477.       d.FreeDosObject(d.rdArgs,rdArgs);
  478.     END;
  479.   END;
  480.   RETURN retval;
  481. END ReadArgs;
  482.  
  483. (* ---------------------------------------------------------------- *)
  484.  
  485. PROCEDURE CheckBinaryVar (msg: rx.RexxMsgPtr;
  486.                           argNum: INTEGER;
  487.                           VAR flags: LONGSET): BOOLEAN;
  488. VAR
  489.   isBin: BOOLEAN;
  490. BEGIN
  491.   IF rls.IsValidArg(msg,argNum,"B",isBin) THEN
  492.     IF isBin THEN
  493.       flags := flags + LONGSET{d.binaryVar,d.dontNullTerm};
  494.     END;
  495.     RETURN TRUE;
  496.   ELSE
  497.     RETURN FALSE;
  498.   END;
  499. END CheckBinaryVar;
  500.  
  501. PROCEDURE CheckLocalGlobal (msg: rx.RexxMsgPtr;
  502.                             argNum: INTEGER;
  503.                             VAR flags: LONGSET): BOOLEAN;
  504. BEGIN
  505.   IF (rx.ActionArg(msg.action) >= argNum) & (msg.args[argNum] # NIL) THEN
  506.     CASE CAP(msg.args[argNum][0]) OF
  507.     |"G": INCL(flags,d.globalOnly);
  508.     |"L": INCL(flags,d.localOnly);
  509.     ELSE
  510.       RETURN FALSE;
  511.     END;
  512.   END;
  513.   RETURN TRUE;
  514. END CheckLocalGlobal;
  515.  
  516. (****** rexxdossupport.library/GetVar *******************
  517. *
  518. *   NAME
  519. *       GetVar -- Returns the value of a local or global variable
  520. *
  521. *   SYNOPSIS
  522. *       string = GetVar( name, ["Local" | "Global"], ["Binary"] )
  523. *
  524. *   FUNCTION
  525. *       Gets the value of a local or environment variable.  It is advised to
  526. *       only use ASCII strings inside variables, but not required.  This stops
  527. *       putting characters into the destination when a \n is hit, unless
  528. *       "Binary" is specified.  (The \n is not stored in the buffer.)
  529. *
  530. *   INPUTS
  531. *       name     - variable name.
  532. *       "Global" - tries to get a global env variable.
  533. *       "Local"  - tries to get a local variable (see note below).
  534. *       "Binary" - don't stop at \n
  535. *                  in this mode the string returned is not null terminated
  536. *
  537. *                The default is to try to get a local variable first,
  538. *                then to try to get a global environment variable.
  539. *
  540. *   RESULT
  541. *       string - contents of the variable
  542. *
  543. *       RC (rexx variable) - 5 when variable does not exist,
  544. *                            0 otherwise
  545. *
  546. *   EXAMPLE
  547. *       /* */
  548. *       username = GetVar("username")
  549. *       if RC = 5 then
  550. *         say "Variable 'username' is not set"
  551. *       else
  552. *         say "Variable 'username' is" username
  553. *
  554. *   NOTES
  555. *      contents may be max. 512 char.
  556. *
  557. *      Since ARexx spawn a new process of each script -- even if
  558. *      started from Shell -- option "Local" may not work as supposed.
  559. *
  560. *   BUGS
  561. *       Due to a bug in dos.library, binary global vars will be null
  562. *       terminated in V37, V38.
  563. *
  564. *   SEE ALSO
  565. *     SetVar(), DeleteVar(), dos.library/GetVar()
  566. *
  567. **********************)
  568.  
  569. PROCEDURE GetVar (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  570. VAR
  571.   flags: LONGSET;
  572.   len: LONGINT;
  573.   res: INTEGER;
  574.   buffer: ARRAY 512 OF CHAR;
  575. CONST
  576.   argName = 1; argLocGlob = 2; argBinary = 3;
  577. BEGIN
  578.   flags := LONGSET{};
  579.   IF ~ CheckLocalGlobal(msg,argLocGlob,flags)
  580.   OR ~ CheckBinaryVar(msg,argBinary,flags)
  581.   OR (msg.args[argName] = NIL) THEN
  582.     RETURN invalidArg;
  583.   END;
  584.   len := d.GetVar(msg.args[argName]^,buffer,SIZE(buffer),flags);
  585.   IF len < 0 THEN
  586.     RETURN rls.SetRC5(msg);
  587.   END;
  588.   IF (len > SIZE(buffer)-1) & (len # d.IoErr()) THEN
  589.     RETURN stringTooLong;
  590.   END;
  591.   resultStr := rxs.CreateArgstring(buffer,len);
  592.   IF resultStr = NIL THEN RETURN noMemory; END;
  593.   RETURN rls.SetRC0(msg);
  594. END GetVar;
  595.  
  596.  
  597. (****** rexxdossupport.library/SetVar *******************
  598. *
  599. *   NAME
  600. *       SetVar -- Sets a local or environment variable
  601. *
  602. *   SYNOPSIS@{ub}
  603. *       success = SetVar( name, ["Local" | "Global"] )
  604. *
  605. *   FUNCTION
  606. *       Sets a local or environment variable.  It is advised to only use
  607. *       ASCII strings inside variables, but not required.
  608. *
  609. *   INPUTS
  610. *       name     - variable name.
  611. *       "Global" - tries to get a global env variable.
  612. *       "Local"  - tries to get a local variable (see note below).
  613. *
  614. *               The default is to set a local environment variable.
  615. *
  616. *   RESULT
  617. *       success - If non-zero, the variable was sucessfully set, FALSE
  618. *                 indicates failure.
  619. *
  620. *   NOTES
  621. *      Since ARexx spawn a new process of each script -- even if
  622. *      started from Shell -- option "Local" may not work as supposed.
  623. *
  624. *   SEE ALSO
  625. *     GetVar(), DeleteVar(), dos.library/SetVar()
  626. *
  627. **************************)
  628.  
  629. PROCEDURE SetVar (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  630. VAR
  631.   flags: LONGSET;
  632. CONST
  633.   argName = 1; argContents = 2; argLocGlob = 3;
  634. BEGIN
  635.   flags := LONGSET{};
  636.   IF ~ CheckLocalGlobal(msg,argLocGlob,flags)
  637.   OR (msg.args[argName] = NIL) THEN
  638.     RETURN invalidArg;
  639.   END;
  640.   IF d.SetVar(msg.args[argName]^,msg.args[argContents]^,
  641.               rxs.LengthArgstring(msg.args[argContents]),flags) THEN
  642.     resultStr := rxs.CreateArgstring(strTRUE,1);
  643.   ELSE
  644.     resultStr := rxs.CreateArgstring(strFALSE,1);
  645.   END;
  646.   IF resultStr = NIL THEN RETURN noMemory; END;
  647.   RETURN rx.ok;
  648. END SetVar;
  649.  
  650.  
  651. (****** rexxdossupport.library/DeleteVar *******************
  652. *
  653. *   NAME
  654. *       DeleteVar -- Deletes a local or environment variable
  655. *
  656. *   SYNOPSIS
  657. *       success = DeleteVar( name, [ "Local" | "Global" ] )
  658. *
  659. *   FUNCTION
  660. *       Deletes a local or environment variable.
  661. *
  662. *   INPUTS
  663. *       name     - variable name.  Note variable names follow
  664. *                  filesystem syntax and semantics.
  665. *       "Global" - tries to get a global env variable.
  666. *       "Local"  - tries to get a local variable (see note below).
  667. *
  668. *                The default is to delete a local variable if found, otherwise
  669. *                a global environment variable if found.
  670. *
  671. *   RESULT
  672. *       success - If TRUE, the variable was sucessfully deleted,
  673. *                 FALSE indicates failure.
  674. *
  675. *   NOTES
  676. *      Since ARexx spawn a new process of each script -- even if
  677. *      started from Shell -- option "Local" may not work as supposed.
  678. *
  679. *   SEE ALSO
  680. *       GetVar(), SetVar(), dos.library/DeleteVar()
  681. *
  682. ***********************)
  683.  
  684. PROCEDURE DeleteVar (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  685. VAR
  686.   flags: LONGSET;
  687. CONST
  688.   argName = 1; argLocGlob = 2;
  689. BEGIN
  690.   flags := LONGSET{};
  691.   IF ~ CheckLocalGlobal(msg,argLocGlob,flags)
  692.   OR (msg.args[argName] = NIL) THEN
  693.     RETURN invalidArg;
  694.   END;
  695.   IF d.DeleteVar(msg.args[argName]^,flags) THEN
  696.     resultStr := rxs.CreateArgstring(strTRUE,1);
  697.   ELSE
  698.     resultStr := rxs.CreateArgstring(strFALSE,1);
  699.   END;
  700.   IF resultStr = NIL THEN RETURN noMemory; END;
  701.   RETURN rx.ok;
  702. END DeleteVar;
  703.  
  704. (* ---------------------------------------------------------------- *)
  705.  
  706. (****** rexxdossupport.library/Fault *******************
  707. *
  708. *   NAME
  709. *       Fault -- Returns the text associated with a DOS error code
  710. *
  711. *   SYNOPSIS
  712. *       string = Fault( code, header )
  713. *
  714. *   FUNCTION
  715. *       This routine obtains the error message text for the given
  716. *       error code. The header is prepended to the text of the error
  717. *       message, followed by a colon. By convention, error messages
  718. *       should be no longer than 80 characters, and preferably no
  719. *       more than 60.
  720. *
  721. *       The value returned by IoErr() (not available in this library)
  722. *       is set to the code passed in. If there is no message for the
  723. *       error code, the message will be "Error code <number>\n".
  724. *
  725. *       The string will be empty if the code passed in was 0.
  726. *
  727. *   INPUTS
  728. *       code   - Error code
  729. *       header - header to output before error text
  730. *
  731. *   RESULT
  732. *       string - error massage as described above.
  733. *
  734. *       RC (rexx variable) - 5 when error message is empty
  735. *                            0 otherwise
  736. *
  737. *   BUGS
  738. *      I've been told that this function returns only an empty sting.
  739. *      Since nobody gave me further information, I can't fix it.
  740. *
  741. *   SEE ALSO
  742. *       dos.library/Fault(), dos.library/IoErr()
  743. *
  744. *****************************)
  745.  
  746. PROCEDURE Fault (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  747. CONST
  748.   argNumber = 1; argHeader = 2;
  749. VAR
  750.   errCode, len: LONGINT;
  751.   retval: INTEGER;
  752.   buffer: ARRAY 512 OF CHAR; (* should be enough *)
  753. BEGIN
  754.   IF (msg.args[argNumber] = NIL) THEN RETURN invalidArg; END;
  755.   retval := rx.ok;
  756.   IF (rx.ActionArg(msg.action) < argHeader) THEN
  757.     msg.args[argHeader] := NIL; END;
  758.   len := d.StrToLong(msg.args[argNumber]^, errCode);
  759.   IF len # str.Length(msg.args[argNumber]^) THEN
  760.     RETURN invalidArg; END;
  761.   (* $NilChk-   avoid trapping msg.args[argHeader]^ *)
  762.   len := d.Fault(errCode, msg.args[argHeader]^, buffer, SIZE(buffer));
  763.   (* $NilChk= *)
  764.   IF len = 0 THEN
  765.     retval := rls.SetRC5(msg);
  766.   ELSE
  767.     retval := rls.SetRC0(msg);
  768.     resultStr := rxs.CreateArgstring(buffer,str.Length(buffer));
  769.     IF resultStr = NIL THEN RETURN noMemory; END;
  770.   END;
  771.   RETURN retval
  772. END Fault;
  773.  
  774. (* ---------------------------------------------------------------- *)
  775.  
  776. (****** rexxdossupport.library/MatchPattern *******************
  777. *
  778. *   NAME
  779. *       MatchPattern --  Checks for a pattern match with a string
  780. *
  781. *   SYNOPSIS
  782. *       match = MatchPattern(pattern, string, ["Nocase"], ["Parsed"] )
  783. *
  784. *   FUNCTION
  785. *       Checks for a pattern match with a string.
  786. *       This routine is case-sensitive by default. Use option
  787. *       "NoCase" for case-insensitve matching.
  788. *
  789. *       Use option "Parsed" to indicate that pattern has already been
  790. *       tokenized using ParsePattern(). Make sure to use or use not
  791. *       "NoCase" for both function.
  792. *
  793. *   INPUTS
  794. *       pattern  - pattern string to match
  795. *       string   - string to match against given pattern
  796. *       "Nocase" - match should be case-insensitve
  797. *       "Parsed" - pattern has already been parsed using ParsePattern()
  798. *
  799. *   RESULT
  800. *       match - success or failure of pattern match.
  801. *
  802. *   SEE ALSO
  803. *       ParsePattern(), dos.library/MatchPattern(),
  804. *       dos.library/MatchPatternNoCase()
  805. *
  806. ***********************)
  807.  
  808. PROCEDURE MatchPattern (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  809. VAR
  810.   buffer: e.LSTRPTR;
  811.   res, noCase, isParsed: BOOLEAN;
  812.   bufferLen: LONGINT;
  813. CONST
  814.   argPattern = 1; argInput = 2; argNoCase = 3; argIsParsed = 4;
  815. BEGIN
  816.   IF ~ rls.IsValidArg(msg,argNoCase,"N",noCase)
  817.   OR ~ rls.IsValidArg(msg,argIsParsed,"P",isParsed)
  818.   OR ~ rls.ArgsPresent(msg,argPattern,argInput) THEN
  819.     RETURN invalidArg; END;
  820.  
  821.   IF isParsed THEN
  822.     buffer := msg.args[argPattern];
  823.     res := TRUE;
  824.   ELSE
  825.     bufferLen := 2 * str.Length(msg.args[argPattern]^) +2;
  826.     ol.Allocate(buffer,bufferLen);
  827.     IF buffer = NIL THEN
  828.       RETURN noMemory;
  829.     END;
  830.     IF noCase THEN
  831.       res := (d.ParsePatternNoCase(msg.args[argPattern]^,buffer^,bufferLen) >= 0);
  832.     ELSE
  833.       res := (d.ParsePattern(msg.args[argPattern]^,buffer^,bufferLen) >= 0);
  834.     END;
  835.     IF ~ res THEN
  836.       DISPOSE(buffer);
  837.       RETURN invalidTemplate;
  838.     END;
  839.   END;
  840.  
  841.   IF noCase THEN res := d.MatchPatternNoCase(buffer^,msg.args[argInput]^);
  842.             ELSE res := d.MatchPattern(buffer^,msg.args[argInput]^); END;
  843.  
  844.   IF ~ isParsed THEN DISPOSE(buffer); END;
  845.  
  846.   IF ~ res THEN
  847.     IF d.IoErr() = 0 THEN
  848.       resultStr := rxs.CreateArgstring(strFALSE,1);
  849.       IF resultStr = NIL THEN RETURN noMemory; END;
  850.       RETURN rx.ok;
  851.     ELSE
  852.       RETURN nestingLevel;
  853.     END;
  854.   ELSE
  855.     resultStr := rxs.CreateArgstring(strTRUE,1);
  856.     IF resultStr = NIL THEN RETURN noMemory; END;
  857.     RETURN rx.ok;
  858.   END;
  859. END MatchPattern;
  860.  
  861.  
  862. (****** rexxdossupport.library/ParsePattern *******************
  863. *
  864. *   NAME
  865. *       ParsePattern -- Create a tokenized string for MatchPattern()
  866. *
  867. *   SYNOPSIS
  868. *       token = ParsePattern( pattern, ["NoCase"] )
  869. *
  870. *   FUNCTION
  871. *       Tokenizes a pattern, for use by MatchPattern().  Also indicates
  872. *       if there are any wildcards in the pattern (i.e. whether it might match
  873. *       more than one item).
  874. *
  875. *       For a description of the wildcards, see dos.library/ParsePattern().
  876. *
  877. *   INPUTS
  878. *       pattern  - unparsed wildcard string to search for.
  879. *
  880. *   RESULT
  881. *       token    - output string, tokenized version of input.
  882. *
  883. *       RC (rexx variable) - 5 when does not contain wildcards
  884. *                            0 otherwise
  885. *
  886. *   BUGS
  887. *       Since is't not clear wether the resulting token may contain
  888. *       null charakters, the returned string is always
  889. *       2 * Length(pattern) + 2 bytes long.
  890. *
  891. *   SEE ALSO
  892. *       ParsePattern(), dos.library/ParsePattern(),
  893. *       dos.library/ParsePatternNoCase()
  894. *
  895. *********************)
  896.  
  897. PROCEDURE ParsePattern (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  898. VAR
  899.   result: INTEGER;
  900.   noCase: BOOLEAN;
  901.   buffer: e.LSTRPTR;
  902.   bufferLen: LONGINT;
  903. CONST
  904.   argPattern = 1; argNoCase = 2;
  905. BEGIN
  906.   IF ~ rls.IsValidArg(msg,argNoCase,"N",noCase)
  907.   OR (msg.args[argPattern] = NIL) THEN
  908.     RETURN invalidArg; END;
  909.   bufferLen := 2 * str.Length(msg.args[argPattern]^) +2;
  910.   ol.Allocate(buffer,bufferLen);
  911.   IF buffer = NIL THEN
  912.     RETURN noMemory;
  913.   END;
  914.   IF noCase THEN
  915.     result := d.ParsePatternNoCase(msg.args[argPattern]^,buffer^,bufferLen)
  916.   ELSE
  917.     result := d.ParsePattern(msg.args[argPattern]^,buffer^,bufferLen);
  918.   END;
  919.   IF result < 0 THEN
  920.     result := invalidTemplate;
  921.   ELSE
  922.     resultStr := rxs.CreateArgstring(buffer^,str.Length(buffer^));
  923.     IF resultStr = NIL THEN
  924.       result := noMemory;
  925.     ELSIF result > 0 THEN
  926.       result := rls.SetRC0(msg);
  927.     ELSE
  928.       result := rls.SetRC5(msg);
  929.     END;
  930.   END;
  931.   DISPOSE(buffer);
  932.   RETURN result;
  933. END ParsePattern;
  934.  
  935. (* ---------------------------------------------------------------- *)
  936.  
  937. (****** rexxdossupport.library/Delete *******************
  938. *
  939. *   NAME
  940. *       Delete -- Delete a file or directory (V2)
  941. *
  942. *   SYNOPSIS
  943. *       success = Delete( name )
  944. *
  945. *   FUNCTION
  946. *       This attempts to delete the file or directory specified by
  947. *       'name'. If the deletion fails an error is returned and the
  948. *       rexx variable RC is set. Note that all the files within a
  949. *       directory must be deleted before the directory itself can be
  950. *       deleted.
  951. *
  952. *   INPUTS
  953. *       name     - name of file or directory to delete.
  954. *
  955. *   RESULT
  956. *       success - If TRUE, the file was sucessfully deleted,
  957. *                 FALSE indicates failure.
  958. *
  959. *       RC (rexx variable) - contains the dos error code if the
  960. *               function was not successfull. This can can directly
  961. *               be used as input for Fault().
  962. *
  963. *   SEE ALSO
  964. *       Fault(), dos.library/DeleteFile()
  965. *
  966. ****************************)
  967.  
  968. PROCEDURE Delete (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  969. CONST
  970.   argName = 1;
  971. VAR
  972.   retval: INTEGER;
  973. BEGIN
  974.   IF msg.args[argName] = NIL THEN RETURN invalidArg; END;
  975.   retval := rx.ok;
  976.   IF d.DeleteFile(msg.args[argName]^) THEN
  977.     resultStr := rxs.CreateArgstring(strTRUE,1);
  978.   ELSE
  979.     resultStr := rxs.CreateArgstring(strFALSE,1);
  980.     retval := rls.SetRC(msg,d.IoErr());
  981.   END;
  982.   IF resultStr = NIL THEN retval := noMemory; END;
  983.   RETURN retval;
  984. END Delete;
  985.  
  986. (****** rexxdossupport.library/Rename *******************
  987. *
  988. *   NAME
  989. *       Rename -- Rename a directory or file (V2)
  990. *
  991. *   SYNOPSIS
  992. *       success = Rename( oldName, newName )
  993. *
  994. *   FUNCTION
  995. *       Rename() attempts to rename the file or directory specified
  996. *       as 'oldName' with the name 'newName'. If the file or
  997. *       directory 'newName' exists, Rename() fails and returns an
  998. *       error. Both 'oldName' and the 'newName' can contain a
  999. *       directory specification. In this case, the file will be moved
  1000. *       from one directory to another.
  1001. *
  1002. *       Note: it is impossible to Rename() a file from one volume to
  1003. *       another.
  1004. *
  1005. *   INPUTS
  1006. *       oldName - pointer to a null-terminated string
  1007. *       newName - pointer to a null-terminated string
  1008. *
  1009. *   RESULT
  1010. *       success - If TRUE, the variable was sucessfully deleted,
  1011. *                 FALSE indicates failure.
  1012. *
  1013. *       RC (rexx variable) - contains the dos error code if the
  1014. *               function was not successfull. This can can directly
  1015. *               be used as input for Fault().
  1016. *
  1017. *   SEE ALSO
  1018. *       Fault(), dos.library/Rename()
  1019. *
  1020. ***************************)
  1021.  
  1022. PROCEDURE Rename (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  1023. VAR
  1024.   retval: INTEGER;
  1025. CONST
  1026.   argFrom = 1; argTo = 2;
  1027. BEGIN
  1028.   IF ~ rls.ArgsPresent(msg,argFrom,argTo) THEN RETURN invalidArg; END;
  1029.   retval := rx.ok;
  1030.   IF d.Rename(msg.args[argFrom]^, msg.args[argTo]^) THEN
  1031.     resultStr := rxs.CreateArgstring(strTRUE,1);
  1032.   ELSE
  1033.     resultStr := rxs.CreateArgstring(strFALSE,1);
  1034.     retval := rls.SetRC(msg,d.IoErr());
  1035.   END;
  1036.   IF resultStr = NIL THEN retval := noMemory; END;
  1037.   RETURN retval;
  1038. END Rename;
  1039.  
  1040. (****** rexxdossupport.library/MakeDir *******************
  1041. *
  1042. *   NAME
  1043. *       MakeDir -- Create a new directory (V2)
  1044. *
  1045. *   SYNOPSIS
  1046. *       success = MakeDir( name )
  1047. *
  1048. *   FUNCTION
  1049. *       MakeDir creates a new directory with the specified name. If
  1050. *       it fails an error is returned and the rexx variable RC is
  1051. *       set.  Directories can only be created on devices which
  1052. *       support them, e.g. disks.
  1053. *
  1054. *   INPUTS
  1055. *       name     - name of directory to create
  1056. *
  1057. *   RESULT
  1058. *       success - If TRUE, the variable was sucessfully deleted,
  1059. *                 FALSE indicates failure.
  1060. *
  1061. *       RC (rexx variable) - contains the dos error code if the
  1062. *               function was not successfull. This can can directly
  1063. *               be used as input for Fault().
  1064. *
  1065. *   SEE ALSO
  1066. *       Fault(), dos.library/CreateDir()
  1067. *
  1068. **************************)
  1069.  
  1070. PROCEDURE MakeDir (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  1071. VAR
  1072.   retval: INTEGER;
  1073. CONST
  1074.   argName = 1;
  1075. VAR
  1076.   dir: d.FileLockPtr;
  1077. BEGIN
  1078.   IF msg.args[argName] = NIL THEN RETURN invalidArg; END;
  1079.   retval := rx.ok;
  1080.   dir := d.CreateDir(msg.args[argName]^);
  1081.   IF dir # NIL THEN
  1082.     d.UnLock(dir);
  1083.     resultStr := rxs.CreateArgstring(strTRUE,1);
  1084.   ELSE
  1085.     resultStr := rxs.CreateArgstring(strFALSE,1);
  1086.     retval := rls.SetRC(msg,d.IoErr());
  1087.   END;
  1088.   IF resultStr = NIL THEN retval := noMemory; END;
  1089.   RETURN retval;
  1090. END MakeDir;
  1091.  
  1092. (****** rexxdossupport.library/SetComment *******************
  1093. *
  1094. *   NAME
  1095. *       SetComment -- Change a files' comment string (V2)
  1096. *
  1097. *   SYNOPSIS
  1098. *       success = SetComment( name, comment )
  1099. *
  1100. *   FUNCTION
  1101. *       SetComment() sets a comment on a file or directory. The
  1102. *       comment may be up to 80 characters in the current ROM
  1103. *       filesystem (and RAM:).  Note that not all filesystems will
  1104. *       support comments (for example, NFS usually will not), or the
  1105. *       size of comment supported may vary.
  1106. *
  1107. *   INPUTS
  1108. *       name     - name of file or directory to set comment
  1109. *       comment  - comment to be set
  1110. *
  1111. *   RESULT
  1112. *       success - If TRUE, the variable was sucessfully deleted,
  1113. *                 FALSE indicates failure.
  1114. *
  1115. *       RC (rexx variable) - contains the dos error code if the
  1116. *               function was not successfull. This can can directly
  1117. *               be used as input for Fault().
  1118. *
  1119. *   SEE ALSO
  1120. *       SetProtection(), Fault(), dos.library/SetComment()
  1121. *
  1122. **************************)
  1123.  
  1124. PROCEDURE SetComment (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  1125. VAR
  1126.   retval: INTEGER;
  1127. CONST
  1128.   argFile = 1; argComment = 2;
  1129. BEGIN
  1130.   IF ~ rls.ArgsPresent(msg,argFile,argComment) THEN RETURN invalidArg; END;
  1131.   retval := rx.ok;
  1132.   IF d.SetComment(msg.args[argFile]^, msg.args[argComment]^) THEN
  1133.     resultStr := rxs.CreateArgstring(strTRUE,1);
  1134.   ELSE
  1135.     resultStr := rxs.CreateArgstring(strFALSE,1);
  1136.     retval := rls.SetRC(msg,d.IoErr());
  1137.   END;
  1138.   IF resultStr = NIL THEN retval := noMemory; END;
  1139.   RETURN retval;
  1140. END SetComment;
  1141.  
  1142. (****** rexxdossupport.library/SetProtection *******************
  1143. *
  1144. *   NAME
  1145. *       SetProtection -- Set protection for a file or directory (V2)
  1146. *
  1147. *   SYNOPSIS
  1148. *       success = SetProtection( name, mask )
  1149. *
  1150. *   FUNCTION
  1151. *       SetProtection() sets the protection attributes on a file or
  1152. *       directory.  See <dos/dos.h> for a listing of protection bits.
  1153. *
  1154. *       The archive bit should be cleared by the filesystem whenever
  1155. *       the file is changed.  Backup utilities will generally set the
  1156. *       bit after backing up each file.
  1157. *
  1158. *       The V36 Shell looks at the execute bit, and will refuse to
  1159. *       execute a file if it is set.
  1160. *
  1161. *       Other bits will be defined in the <dos/dos.h>include files.
  1162. *       Rather than referring to bits by number you should use the
  1163. *       definitions in <dos/dos.h>.
  1164. *
  1165. *   INPUTS
  1166. *       name     - name of file or directory to set protection
  1167. *       mask     - the protection mask required
  1168. *
  1169. *   RESULT
  1170. *       success - If TRUE, the variable was sucessfully deleted,
  1171. *                 FALSE indicates failure.
  1172. *
  1173. *       RC (rexx variable) - contains the dos error code if the
  1174. *               function was not successfull. This can can directly
  1175. *               be used as input for Fault().
  1176. *
  1177. *   SEE ALSO
  1178. *       SetComment(), Fault(), dos.library/SetProtection()
  1179. *
  1180. **************************)
  1181.  
  1182. PROCEDURE SetProtection (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  1183. VAR
  1184.   retval: INTEGER;
  1185. CONST
  1186.   argFile = 1; argFlags = 2;
  1187. TYPE
  1188.   LONGSETPtr = UNTRACED POINTER TO LONGSET;
  1189. BEGIN
  1190.   IF ~ rls.ArgsPresent(msg,argFile,argFlags)
  1191.   OR (rxs.LengthArgstring(msg.args[argFlags]) # 4)
  1192.     THEN RETURN invalidArg; END;
  1193.   retval := rx.ok;
  1194.   IF d.SetProtection(msg.args[argFile]^,y.VAL(LONGSETPtr,msg.args[argFile])^) THEN
  1195.     resultStr := rxs.CreateArgstring(strTRUE,1);
  1196.   ELSE
  1197.     resultStr := rxs.CreateArgstring(strFALSE,1);
  1198.     retval := rls.SetRC(msg,d.IoErr());
  1199.   END;
  1200.   IF resultStr = NIL THEN retval := noMemory; END;
  1201.   RETURN retval;
  1202. END SetProtection;
  1203.  
  1204.  
  1205. (* ---------------------------------------------------------------- *)
  1206.  
  1207. PROCEDURE Dispatch * (msg{8}: rx.RexxMsgPtr): LONGINT; (* $SaveRegs+ *)
  1208. VAR
  1209.   resultStr: e.LSTRPTR;
  1210.   retval: LONGINT;
  1211. BEGIN
  1212.   ol.SetA5();
  1213.   retval := rls.Dispatch(msg,resultStr,functionList);
  1214.   y.SETREG(8,resultStr);
  1215.   RETURN retval;
  1216. END Dispatch;
  1217.  
  1218. BEGIN
  1219.   IF (rxs.base = NIL) OR (d.base.lib.version < 37) THEN HALT(20); END;
  1220.  
  1221. END rexxdossupport.
  1222.