home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / program / m2posx02 / dosfile.ipp < prev    next >
Encoding:
Modula Implementation  |  1993-10-23  |  16.3 KB  |  641 lines
  1. IMPLEMENTATION MODULE DosFile;
  2. (*__NO_CHECKS__*)
  3. (*****************************************************************************)
  4. (* "UnixToDos()" basiert auf der MiNTLIB von Eric R. Smith                   *)
  5. (* --------------------------------------------------------------------------*)
  6. (* STATUS: IN ARBEIT                                                         *)
  7. (* --------------------------------------------------------------------------*)
  8. (* 11-Feb-93, Holger Kleinschmidt                                            *)
  9. (*****************************************************************************)
  10.  
  11. VAL_INTRINSIC
  12. CAST_IMPORT
  13. OSCALL_IMPORT
  14.  
  15. FROM SYSTEM IMPORT
  16. (* TYPE *) ADDRESS,
  17. (* PROC *) ADR;
  18.  
  19. FROM CTYPE IMPORT
  20. (* PROC *) TOLOWER, TOUPPER, ISALPHA, TODIGIT, TOCARD;
  21.  
  22. FROM pSTRING IMPORT
  23. (* CONST*) EOS,
  24. (* TYPE *) StrPtr, StrRange,
  25. (* PROC *) SLEN, COPY, ASSIGN, APPEND, DELETE, EQUAL, EQUALN, UPPER, TOKEN,
  26.            RPOSCHR;
  27.  
  28. FROM types IMPORT
  29. (* CONST*) PATHMAX, NULL, DDIRSEP, XDIRSEP, DDRVPOSTFIX, XDEVPREFIX, SUFFIXSEP,
  30. (* TYPE *) SIGNEDWORD, SIGNEDLONG, UNSIGNEDLONG, UNSIGNEDWORD, FileName,
  31.            PathName;
  32.  
  33. FROM err IMPORT
  34. (* CONST*) eRANGE, ENAMETOOLONG, ENOENT,
  35. (* VAR  *) errno;
  36.  
  37. FROM cmdline IMPORT
  38. (* PROC *) getenv, GetEnvVar;
  39.  
  40. #if MINT
  41. FROM DosSystem IMPORT MiNTVersion;
  42. #endif
  43.  
  44. #include "oscalls.m2h"
  45.  
  46. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  47.  
  48. CONST
  49.   EOKL    = LIC(0);
  50. #if no_MIN_MAX
  51.   MAXCARD = CAST(CARDINAL,-1);
  52. #else
  53.   MAXCARD = MAX(CARDINAL);
  54. #endif
  55.  
  56. #if MINT
  57. VAR
  58.   MiNT : CARDINAL;
  59. #endif
  60.  
  61. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  62.  
  63. PROCEDURE isexec (VAR path    : ARRAY OF CHAR;
  64.                       default : ARRAY OF CHAR;
  65.                       var     : ARRAY OF CHAR ): BOOLEAN;
  66. (*T*)
  67. CONST
  68.  
  69. VAR  sIdx,dIdx : INTEGER;
  70.      l1, l2    : CARDINAL;
  71.      hasExt    : BOOLEAN;
  72.      tIdx      : CARDINAL;
  73.      ext       : FileName;
  74.      token     : FileName;
  75.      suffices  : PathName;
  76.  
  77. BEGIN
  78.  sIdx := RPOSCHR(MAXCARD, SUFFIXSEP, path);
  79.  dIdx := RPOSCHR(MAXCARD, DDIRSEP, path);
  80.  
  81.  IF sIdx <= dIdx THEN
  82.    RETURN(FALSE);
  83.  ELSE
  84.    COPY(sIdx+1, MAXCARD, path, ext);
  85.  END;
  86.  
  87.  IF NOT GetEnvVar(var, suffices) THEN
  88.    ASSIGN(default, suffices);
  89.  END;
  90.  
  91.  (* moeglicherweise ist die Nichtunterscheidung von Klein/Grossbuchstaben
  92.   * falsch, keine Ahnung...
  93.   *)
  94.  UPPER(suffices);
  95.  UPPER(ext);
  96.  
  97.  tIdx := 0; l1 := 0;
  98.  WHILE TOKEN(suffices, ";,", tIdx, l1, l2, token) DO
  99.    IF EQUAL(ext, token) THEN
  100.      RETURN(TRUE);
  101.    END;
  102.  END;
  103.  RETURN(FALSE);
  104. END isexec;
  105.  
  106. (*---------------------------------------------------------------------------*)
  107.  
  108. PROCEDURE IsExec ((* EIN/ -- *) VAR path : ARRAY OF CHAR ): BOOLEAN;
  109. (*T*)
  110. BEGIN
  111.  RETURN(isexec(path, EXECSUFFIX, "SUFFIX"));
  112. END IsExec;
  113.  
  114. (*---------------------------------------------------------------------------*)
  115.  
  116. PROCEDURE IsGEMExec ((* EIN/ -- *) VAR path : ARRAY OF CHAR ): BOOLEAN;
  117. (*T*)
  118. BEGIN
  119.  RETURN(isexec(path, GEMEXT, "GEMEXT"));
  120. END IsGEMExec;
  121.  
  122. (*---------------------------------------------------------------------------*)
  123. #if GEMDOS
  124. PROCEDURE IsTOSExec ((* EIN/ -- *) VAR path : ARRAY OF CHAR ): BOOLEAN;
  125. (*T*)
  126. BEGIN
  127.  RETURN(isexec(path, TOSEXT, "TOSEXT"));
  128. END IsTOSExec;
  129. #elif PCDOS
  130. PROCEDURE IsDOSExec ((* EIN/ -- *) VAR path : ARRAY OF CHAR ): BOOLEAN;
  131. (*T*)
  132. BEGIN
  133.  RETURN(isexec(path, DOSEXT, "DOSEXT"));
  134. END IsDOSExec;
  135. #endif
  136. (*---------------------------------------------------------------------------*)
  137.  
  138. PROCEDURE PrefixLen (VAR path : ARRAY OF CHAR): CARDINAL;
  139. (*T*)
  140. VAR i : CARDINAL;
  141.     c : CHAR;
  142. BEGIN
  143.  i := 0;
  144.  REPEAT
  145.    c := path[i];
  146.    INC(i);
  147.  UNTIL (i > VAL(CARDINAL,HIGH(path))) OR (c = EOS) OR (c = DDIRSEP)
  148.                                                    OR (c = XDIRSEP)
  149.                                                    OR (c = DDRVPOSTFIX);
  150.  IF c = DDRVPOSTFIX THEN
  151.    RETURN(i);
  152.  ELSE
  153.    RETURN(0);
  154.  END;
  155. END PrefixLen;
  156.  
  157. (*---------------------------------------------------------------------------*)
  158.  
  159. PROCEDURE IsDosDevice ((* EIN/ -- *) VAR path : ARRAY OF CHAR ): BOOLEAN;
  160. (*T*)
  161. VAR i : CARDINAL;
  162. BEGIN
  163.  i := PrefixLen(path);
  164.  RETURN((i > 2) AND ((i > VAL(CARDINAL,HIGH(path))) OR (path[i] = EOS)));
  165. END IsDosDevice;
  166.  
  167. (*---------------------------------------------------------------------------*)
  168.  
  169. PROCEDURE CompletePath ((* EIN/ -- *) VAR path : ARRAY OF CHAR;
  170.                         (* -- /AUS *) VAR full : PathName;
  171.                         (* -- /AUS *) VAR len  : CARDINAL;
  172.                         (* -- /AUS *) VAR err  : INTEGER       ): BOOLEAN;
  173.  
  174. (**)
  175. VAR wres : SIGNEDWORD;
  176.     drv  : UNSIGNEDWORD;
  177.     pIdx : CARDINAL;
  178.     fIdx : CARDINAL;
  179.  
  180. BEGIN
  181.  IF (path[0] = 0C) OR (path[1] <> DDRVPOSTFIX) THEN
  182.    (* Wenn kein Laufwerk angegeben ist, aktuelles Laufwerk ermitteln *)
  183.    Dgetdrv(drv);
  184.    full[0] := TODIGIT(VAL(CARDINAL,drv) + 10);
  185.    pIdx    := 0;
  186.    INC(drv); (* fuer "Dgetpath" *)
  187.  ELSE
  188.    (* sonst angegebenes Laufwerk uebernehmen *)
  189.    full[0] := path[0];
  190.    pIdx    := 2;
  191.    drv     := VAL(UNSIGNEDWORD,TOCARD(path[0]) - 10 + 1);
  192.  END;
  193.  full[1] := DDRVPOSTFIX;
  194.  
  195.  fIdx := 2;
  196.  err  := 0;
  197.  IF path[pIdx] <> DDIRSEP THEN
  198.    (* relativer Pfad angegeben -> aktuellen Pfad ermitteln *)
  199. #if MINT
  200.    IF MiNT >= 96 THEN
  201.      Dgetcwd(ADR(full[2]), drv, PATHMAX+1-2, wres);
  202.    ELSE
  203. #endif
  204.      Dgetpath(ADR(full[2]), drv, wres);
  205. #if MINT
  206.    END;
  207. #endif
  208.    err := INT(wres);
  209.    IF err < 0 THEN
  210.      RETURN(FALSE);
  211.    END;
  212.  
  213.    WHILE (fIdx <= PATHMAX) AND (full[fIdx] <> 0C) DO
  214.      INC(fIdx);
  215.    END;
  216.    IF fIdx > PATHMAX THEN
  217.      (* Ist wahrscheinlich schon zu spaet, da ueber <full> hinaus
  218.       * geschrieben wurde, aber schaden kanns auch nicht.
  219.       *)
  220.      err := eRANGE;
  221.      RETURN(FALSE);
  222.    ELSE
  223.      IF (fIdx = 2) OR (path[pIdx] <> 0C) THEN
  224.        (* Ein Wurzelverzeichnis muss mit einem Backslash gekennzeichnet
  225.         * werden. Wenn ein (relativer) Pfad angegeben war, muss ebenfalls
  226.         * ein Backslash zur Trennung eingefuegt werden.
  227.         *)
  228.        full[fIdx] := DDIRSEP;
  229.        INC(fIdx);
  230.      END;
  231.    END;
  232.  END;
  233.  
  234.  WHILE (pIdx <= VAL(CARDINAL,HIGH(path))) AND (path[pIdx] <> 0C)
  235.    AND (fIdx <= PATHMAX)
  236.  DO
  237.    full[fIdx] := path[pIdx];
  238.    INC(fIdx);
  239.    INC(pIdx);
  240.  END;
  241.  
  242.  IF fIdx > PATHMAX THEN
  243.    err := eRANGE;
  244.    RETURN(FALSE);
  245.  ELSE
  246.    full[fIdx] := 0C;
  247.    len        := fIdx;
  248.    RETURN(TRUE);
  249.  END;
  250. END CompletePath;
  251.  
  252. (*---------------------------------------------------------------------------*)
  253.  
  254. PROCEDURE DosToUnix ((* EIN/ -- *)     dpath : ARRAY OF CHAR;
  255.                      (* -- /AUS *) VAR xpath : ARRAY OF CHAR;
  256.                      (* -- /AUS *) VAR xlen  : CARDINAL      );
  257. (**)
  258. VAR dIdx   : CARDINAL;
  259.     dLen   : CARDINAL;
  260.     pre    : CARDINAL;
  261.     c      : CHAR;
  262.     drv    : CHAR;
  263.     pipe   : BOOLEAN;
  264.     device : BOOLEAN;
  265.     tmp    : ARRAY [0..9] OF CHAR;
  266.     tmpLen : CARDINAL;
  267.  
  268. BEGIN
  269.  dIdx := 0;
  270.  WHILE (dIdx <= VAL(CARDINAL,HIGH(dpath))) AND (dpath[dIdx] <> 0C) DO
  271.    (*  \ --> /  und gegebenenfalls in Kleinbuchstaben wandeln *)
  272.    c := dpath[dIdx];
  273.    IF c = DDIRSEP THEN
  274.      c := XDIRSEP;
  275. #if MINT
  276.    ELSIF MiNT < 7 THEN
  277. #else
  278.    ELSE
  279. #endif
  280.      c := TOLOWER(c);
  281.    END;
  282.    dpath[dIdx] := c;
  283.    INC(dIdx);
  284.  END;
  285.  
  286.  dLen := dIdx;
  287.  pre  := PrefixLen(dpath);
  288.  drv  := TOUPPER(dpath[0]);
  289.  
  290.  IF pre = 2 THEN
  291.    (* Laufwerk, "x:" *)
  292.    pipe   := FALSE;
  293.    device := FALSE;
  294.    dIdx   := 2;
  295. #if MINT
  296.    IF MiNT > 0 THEN
  297.      IF drv = 'Q' THEN
  298.        pipe := TRUE;
  299.      ELSIF drv = 'V' THEN
  300.        device := TRUE;
  301.      ELSIF (MiNT >= 9) AND (drv = 'U') THEN
  302.        c := dpath[0];
  303.        dpath[0] := drv;
  304.        IF EQUALN(7, "U:/pipe", dpath) THEN
  305.          pipe := (dLen = 7) OR (dpath[7] = XDIRSEP);
  306.          IF pipe THEN
  307.            dIdx := 7;
  308.          END;
  309.        ELSIF EQUALN(6, "U:/dev", dpath) THEN
  310.          device := (dLen = 6) OR (dpath[6] = XDIRSEP);
  311.          IF device THEN
  312.            dIdx := 6;
  313.          END;
  314.        END;
  315.        dpath[0] := c;
  316.      END;
  317.    END; (* IF MiNT *)
  318.  
  319.    IF pipe THEN
  320.      tmp    := "/pipe";
  321.      tmpLen := 5;
  322.    ELSIF device THEN
  323.      tmp    := "/dev";
  324.      tmpLen := 4;
  325.    ELSE
  326. #endif
  327.      tmp    := "/dev/@";
  328.      tmp[5] := drv;
  329.      tmpLen := 6;
  330. #if MINT
  331.    END; (* IF pipe *)
  332. #endif
  333.    IF (dIdx < dLen) AND (dpath[dIdx] <> XDIRSEP) THEN
  334.      tmp[tmpLen] := XDIRSEP;
  335.      INC(tmpLen);
  336.    END;
  337.  ELSIF pre = 1 THEN
  338.    (* duerfte nicht auftreten, ":xxx" *)
  339.    tmp[0] := XDIRSEP;
  340.    tmp[1] := EOS;
  341.    tmpLen := 1;
  342.    dIdx   := 1;
  343.  ELSE
  344.    dIdx := 0; (* nichts vom "DOS"-Pfad loeschen *)
  345.    IF pre > 2 THEN
  346.      IF EQUAL("con:", dpath) THEN
  347.        ASSIGN("/dev/tty", xpath);
  348.        xlen := 8;
  349.        RETURN;
  350.      ELSE
  351.        tmp          := "/dev/";
  352.        tmpLen       := 5;
  353.        dpath[pre-1] := EOS; (* den Doppelpunkt loeschen *)
  354.      END;
  355.    END;
  356.  END; (* IF pre *)
  357.  
  358.  DELETE(0, dIdx, dpath);
  359.  ASSIGN(tmp, xpath);
  360.  APPEND(dpath, xpath);
  361.  xlen := dLen - dIdx + tmpLen;
  362. END DosToUnix;
  363.  
  364. (*---------------------------------------------------------------------------*)
  365.  
  366. PROCEDURE UnixToDos ((* EIN/ -- *)     xpath  : ARRAY OF CHAR;
  367.                      (* -- /AUS *) VAR dpath  : PathName;
  368.                      (* -- /AUS *) VAR dot    : BOOLEAN;
  369.                      (* -- /AUS *) VAR done   : BOOLEAN       );
  370.  
  371. (**)
  372. VAR xIdx   : CARDINAL;
  373.     xLen   : CARDINAL;
  374.     dIdx   : CARDINAL;
  375.     wres   : SIGNEDWORD;
  376.     ROOT   : BOOLEAN;
  377.     c      : CHAR;
  378.  
  379. BEGIN
  380.  Dgetpath(ADR(dpath[0]), 0, wres);
  381.  ROOT := dpath[0] = 0C;
  382.  
  383.  dpath[0] := 0C;
  384.  done     := FALSE;
  385.  dot      := FALSE;
  386.  
  387.  xIdx := 0;
  388.  dIdx := 0;
  389.  xLen := SLEN(xpath);
  390.  IF xLen = 0 THEN
  391.    errno := ENOENT;
  392.    RETURN;
  393.  END;
  394.  
  395.  IF EQUALN(5, XDEVPREFIX, xpath) THEN
  396.    (* xpath = /dev/... *)
  397.    IF (xLen > 5) AND ISALPHA(xpath[5]) AND (   (xLen = 6)
  398.                                             OR (xpath[6] = XDIRSEP)
  399.                                             OR (xpath[6] = DDIRSEP))
  400.    THEN
  401.      (* "GEMDOS"-Laufwerksbezeichner: /dev/A, /dev/A/..., /dev/A\... --> A: *)
  402.      dpath[0] := xpath[5];
  403.      dpath[1] := DDRVPOSTFIX;
  404.      dIdx     := 2;
  405.      xIdx     := 6;
  406. #if MINT
  407.    ELSIF MiNT > 0 THEN
  408.      xIdx := 5;
  409.      (* Geraete sind bei MiNT ueber Laufwerk 'V' oder 'U' ansprechbar:
  410.       * /dev/con --> V:\con, bzw. U:\dev\con
  411.       *)
  412.      IF MiNT >= 9 THEN
  413.        ASSIGN("U:\dev\\", dpath); (* \\ wegen Praeprozessor... *)
  414.        dIdx := 7;
  415.      ELSE
  416.        ASSIGN("V:\\", dpath); (* ... *)
  417.        dIdx := 3;
  418.      END;
  419. #endif
  420.    ELSE
  421.      IF EQUAL("/dev/tty", xpath) THEN
  422.        ASSIGN("con:", dpath);
  423.        done := TRUE;
  424.      ELSE
  425.        IF xpath[xLen-1] <> DDRVPOSTFIX THEN
  426.          dIdx := 1; (* Flag: ":" anfuegen *)
  427.        END;
  428.        IF xLen - 5 + dIdx <= PATHMAX THEN
  429.          COPY(5, xLen, xpath, dpath); (* /dev/ ueberspringen *)
  430.          IF dIdx = 1 THEN
  431.            dpath[xLen-5] := DDRVPOSTFIX;
  432.            dpath[xLen-4] := EOS;
  433.          END;
  434.          done := TRUE;
  435.        END;
  436.      END;
  437.      RETURN;
  438.    END;
  439. #if MINT
  440.  ELSIF (MiNT > 0) AND EQUALN(6, "/pipe/", xpath) THEN
  441.    xIdx := 6;
  442.    (* Pipes koenne je nach MiNT-Version ueber Laufwerk Q: oder U:
  443.     * angesprochen werden: /pipe/... --> Q:\..., oder  U:\pipe\...
  444.     *)
  445.    IF MiNT >= 9 THEN
  446.      ASSIGN("U:\pipe\\", dpath);
  447.      dIdx := 8;
  448.    ELSE
  449.      ASSIGN("Q:\\", dpath);
  450.      dIdx := 3;
  451.    END;
  452. #endif
  453.  ELSIF ((xpath[0] = DDIRSEP) OR (xpath[0] = XDIRSEP)) AND (ROOTDIR <> 0C) THEN
  454.    dpath[0] := ROOTDIR;
  455.    dpath[1] := DDRVPOSTFIX;
  456.    dIdx     := 2;
  457.  END;
  458.  
  459.  WHILE (dIdx <= PATHMAX) AND (xIdx < xLen) DO
  460.    c := xpath[xIdx];
  461.    IF c = XDIRSEP THEN (* / --> \ *)
  462.      c := DDIRSEP;
  463.    END;
  464.    dpath[dIdx] := c;
  465.    INC(xIdx);
  466.    INC(dIdx);
  467.  END;
  468.  
  469.  (* Die Zuweisung an CHAR-Variable steht hier nur, weil der nachfolgende
  470.   * Ausdruck moeglicherweise zu komplex fuer den einen oder anderen
  471.   * Compiler ist (-> TDI).
  472.   *)
  473.  IF dIdx > 1 THEN
  474.    c := dpath[dIdx-2];
  475.  ELSE
  476.    c := 0C;
  477.  END;
  478.  dot :=     (dIdx > 0)
  479.         AND (dpath[dIdx-1] = '.')
  480.              AND ((dIdx = 1)
  481.               OR  (c = DDIRSEP)
  482.               OR  (c = DDRVPOSTFIX)
  483.               OR  (c = '.')
  484.                    AND ((dIdx = 2)
  485.                     OR  (dpath[dIdx-3] = DDIRSEP)
  486.                     OR  (dpath[dIdx-3] = DDRVPOSTFIX)));
  487.  
  488.  (* Da bei "GEMDOS" die Eintraege "." und ".." im Hauptverzeichnis nicht
  489.   * existieren, werden sie durch das Hauptverzeichnis ersetzt, falls mit
  490.   * Sicherheit festgestellt werden kann, dass das Hauptverzeichnis gemeint ist.
  491.   * Dies ist auch korrekt, wenn ein Dateisystem benutzt wird, dass diese
  492.   * Eintraege hat, da sie aufs Hauptverzeichnis verweisen.
  493.   *
  494.   * Es gibt folgende Faelle:
  495.   * - "\.", "\..", absoluter Pfad
  496.   *   hier kann sofort korrigiert werden.
  497.   *
  498.   * - ".", "..", relativer Pfad
  499.   *   hier muss zuerst festgestellt werden, ob das aktuelle Verzeichnis
  500.   *   das Hauptverzeichnis ist.
  501.   *
  502.   * - alle anderen Faelle (wenn "." oder ".." als Teil einer Pfadangabe
  503.   *   auftreten, auch wenn nur ein Laufwerk angegeben ist) werden hier
  504.   *   nicht korrigiert, da dies einen grossen Aufwand bedeutet, aber
  505.   *   seltener auftritt.
  506.   *)
  507.  
  508.  c := dpath[0];
  509.  
  510.  IF dot AND (
  511.    (*"."*)      (dIdx = 1) AND ROOT
  512.    (*"\."*)  OR (dIdx = 2) AND (   (c = DDIRSEP)
  513.    (*".."*)                     OR (c = '.') AND ROOT)
  514.    (*"\.."*) OR (dIdx = 3) AND (c = DDIRSEP) AND (dpath[1] = '.'))
  515.  THEN
  516.    dpath[0] := DDIRSEP;
  517.    dIdx     := 1;
  518.    dot      := FALSE; (* wurde durch Wurzelverzeichnis ersetzt *)
  519.  END;
  520.  
  521.  IF dIdx <= PATHMAX THEN
  522.    dpath[dIdx] := 0C;
  523.    done        := TRUE;
  524.  ELSE
  525.    dpath[0] := 0C;
  526.    errno    := ENAMETOOLONG;
  527.  END;
  528. END UnixToDos;
  529.  
  530. (*---------------------------------------------------------------------------*)
  531.  
  532. PROCEDURE FindFirst ((* EIN/ -- *) VAR path : PathName;
  533.                      (* EIN/ -- *)     attr : FileAttribute;
  534.                      (* EIN/AUS *) VAR dta  : DTA;
  535.                      (* -- /AUS *) VAR res  : INTEGER       ): BOOLEAN;
  536. (*T*)
  537. VAR olddta : ADDRESS;
  538.     wres   : SIGNEDWORD;
  539.  
  540. BEGIN
  541.  Fgetdta(olddta);
  542.  Fsetdta(ADR(dta));
  543.  Fsfirst(ADR(path), CAST(UNSIGNEDWORD,attr), wres);
  544.  Fsetdta(olddta);
  545.  res := INT(wres);
  546.  IF wres < 0 THEN
  547.    RETURN(FALSE);
  548.  ELSE
  549.    RETURN(TRUE);
  550.  END;
  551. END FindFirst;
  552.  
  553. (*---------------------------------------------------------------------------*)
  554.  
  555. PROCEDURE FindNext ((* EIN/AUS *) VAR dta : DTA;
  556.                     (* -- /AUS *) VAR res : INTEGER ): BOOLEAN;
  557. (*T*)
  558. VAR olddta : ADDRESS;
  559.     wres   : SIGNEDWORD;
  560.  
  561. BEGIN
  562.  Fgetdta(olddta);
  563.  Fsetdta(ADR(dta));
  564.  Fsnext(wres);
  565.  Fsetdta(olddta);
  566.  res := INT(wres);
  567.  IF wres < 0 THEN
  568.    RETURN(FALSE);
  569.  ELSE
  570.    RETURN(TRUE);
  571.  END;
  572. END FindNext;
  573.  
  574. (*---------------------------------------------------------------------------*)
  575.  
  576. PROCEDURE Seek ((* EIN/ -- *)     hndl : INTEGER;
  577.                 (* EIN/ -- *)     off  : SIGNEDLONG;
  578.                 (* EIN/ -- *)     mode : CARDINAL;
  579.                 (* -- /AUS *) VAR pos  : SIGNEDLONG;
  580.                 (* -- /AUS *) VAR done : BOOLEAN     );
  581. (*T*)
  582. VAR lres : SIGNEDLONG;
  583.  
  584. BEGIN
  585.  Fseek(off, VAL(SIGNEDWORD,hndl), VAL(UNSIGNEDWORD,mode), lres);
  586.  pos  := lres;
  587.  done := lres >= EOKL;
  588. END Seek;
  589.  
  590. (*---------------------------------------------------------------------------*)
  591.  
  592. PROCEDURE IsDevice ((* EIN/ -- *) h : INTEGER ): BOOLEAN;
  593. (*T*)
  594. VAR old  : SIGNEDLONG;
  595.     lres : SIGNEDLONG;
  596.     done : BOOLEAN;
  597.  
  598. BEGIN
  599.  Seek(h, 0, 1, old, done);
  600.  Seek(h, 1, 0, lres, done);
  601.  Seek(h, old, 0, old, done);
  602.  
  603.  RETURN(lres = LIC(0));
  604. END IsDevice;
  605.  
  606. (*===========================================================================*)
  607.  
  608. VAR xmode : StrPtr;
  609.     i     : StrRange;
  610.     wres  : UNSIGNEDWORD;
  611.  
  612. BEGIN (* DosFile *)
  613.  INODE   := 32 (* ?? *);
  614.  ROOTDIR := 0C;
  615.  xmode   := getenv("UNIXMODE");
  616.  IF xmode <> NULL THEN
  617.    i := 0;
  618.    WHILE xmode^[i] <> 0C DO
  619.      IF (xmode^[i] = 'r') AND (xmode^[i+1] <> 0C) THEN
  620.        ROOTDIR := TOLOWER(xmode^[i+1]);
  621.      END;
  622.      INC(i);
  623.    END;
  624.  END;
  625.  
  626.  IF (getenv("STDERR") = NULL) AND IsDevice(2) THEN
  627.    (* siehe Profibuch von 1992 *)
  628.    Fforce(2, -1, wres);
  629.  END;
  630. #if MINT
  631.  MiNT := MiNTVersion();
  632.  
  633.  IF (ROOTDIR = 0C) AND (MiNT >= 9) THEN
  634.    Dgetdrv(wres);
  635.    IF wres = 20(*U*) THEN
  636.      ROOTDIR := 'u';
  637.    END;
  638.  END;
  639. #endif
  640. END DosFile.
  641.