home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 10 / dosfunc / dirmt.tur < prev    next >
Encoding:
Text File  |  1987-08-04  |  3.4 KB  |  69 lines
  1. (* ----------------------------------------------------------------------- *)
  2. (*                               DIRMT.TUR                                 *)
  3. (*              (c) 1987  Michael Ceol & PASCAL INT.                       *)
  4. (*   System und Compiler-spezifischer Teil der Directory-Bibliothek fuer   *)
  5. (*                         MS-DOS in Turbo Pascal                          *)
  6. (*       programmiert und getestet auf einem MS-DOS 3.1-System             *)
  7.  
  8. TYPE                               (* der Registersatz der Intel 80xx-CPU: *)
  9.   Dir_Regs = RECORD CASE INTEGER OF
  10.                1: (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : INTEGER);
  11.                2: (Al, Ah, Bl, Bh, Cl, Ch, Dl, Dh : BYTE);
  12.              END;
  13. VAR
  14.   DirRegs  : Dir_Regs;
  15. (* ----------------------------------------------------------------------- *)
  16. PROCEDURE FSetDTA (DTA: DTA_Ptr);               (* neue DTA-Adresse setzen *)
  17. BEGIN
  18.   DirRegs.AX := $1A00;       DirRegs.DS := Seg(DTA^);
  19.   DirRegs.DX := Ofs(DTA^);   MsDos(DirRegs);
  20. END;
  21.  
  22. FUNCTION FGetDTA: DTA_Ptr;                   (* aktuelle DTA-Adresse holen *)
  23. BEGIN
  24.   DirRegs.AX := $2F00;  MsDos(DirRegs);
  25.   FGetDTA := Ptr(DirRegs.ES, DirRegs.BX);
  26. END;
  27. (* ----------------------------------------------------------------------- *)
  28. (*                    ersten Directory-Eintrag suchen:                     *)
  29. FUNCTION FSFirst (VAR search: Dir_Chr0; attr: INTEGER): INTEGER;
  30. BEGIN
  31.   DirRegs.AX := $4E00;           DirRegs.CX := attr;
  32.   DirRegs.DS := Seg(search);     DirRegs.DX := Ofs(search);
  33.   MsDos(DirRegs);                FSFirst := DirRegs.AX;
  34.   IF DirRegs.AX <> DOSfnok THEN FSFirst := -31 - DirRegs.AX;
  35. END;
  36. (* ----------------------------------------------------------------------- *)
  37. (*                  naechsten Directory-Eintrag suchen:                    *)
  38. FUNCTION FSNext: INTEGER;
  39. BEGIN
  40.   DirRegs.AX := $4F00;   MsDos(DirRegs);   FSNext := DirRegs.AX;
  41.   IF DirRegs.AX <> DOSfnok THEN FSNext := -31 - DirRegs.AX;
  42. END;
  43. (* ----------------------------------------------------------------------- *)
  44. (*             zwei Bit-Funktionen, die Compiler-abhaengig sind:           *)
  45. (* Die Bits von "value" um "n" Stellen nach rechts shiften (verschieben):  *)
  46. FUNCTION ShiftR (value, n: INTEGER): INTEGER;
  47. BEGIN  ShiftR := value SHR n  END;
  48. (*                 Die Bits von "val1" und "val2" undieren:                *)
  49. FUNCTION AndInt (val1, val2: INTEGER): INTEGER;
  50. BEGIN  AndInt := val1 AND val2  END;
  51. (* ----------------------------------------------------------------------- *)
  52. (*    nochmal zwei eventuell anzupassende Routinen, die hier aber fuer     *)
  53. (*                   Turbo Pascal und Pascal ST+ gleich sind:              *)
  54. (* Integer-Wert zu einer 'n'-stelligen Zeichenkette mit fuehrenden Nullen: *)
  55. PROCEDURE IntStr (value, n: INTEGER; VAR s: Dir_Str);
  56. VAR i : INTEGER;  Ch: CHAR;
  57. BEGIN
  58.   s := '';
  59.   FOR i := 1 TO n DO BEGIN
  60.     s := Concat(Chr((value MOD 10)+Ord('0')),s);  value := value DIV 10;
  61.   END;
  62. END;
  63. (* wg. negativen Integer-Werten bei grossen Dateigroessen selbigen Wert zu *)
  64. (*                 einem positiven Real-Wert konvertieren:                 *)
  65. FUNCTION IntCard (i: INTEGER): REAL;
  66. BEGIN IF i < 0 THEN IntCard := 65536.0 + i ELSE IntCard := i; END;
  67. (* ----------------------------------------------------------------------- *)
  68. (*                               DIRMT.TUR                                 *)
  69.