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