home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 07 / tricks / fildir.mod < prev    next >
Encoding:
Modula Implementation  |  1990-04-06  |  7.2 KB  |  263 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     FILDIR.MOD                         *)
  3. (* ------------------------------------------------------ *)
  4. (* $S-, $R-, $T- *)
  5. IMPLEMENTATION MODULE Fildir;
  6.  
  7. FROM SYSTEM IMPORT ADDRESS, SEG, OFS, ADR, ASSEMBLER;
  8. FROM System IMPORT XTrap,AX,BX,CX,DX,SI,DI,BP,DS,ES,FLAGS;
  9.  
  10. TYPE
  11.   Regs = RECORD
  12.            CASE B : BOOLEAN OF
  13.                       TRUE  : lh   : CARDINAL;
  14.                     | FALSE : l, h : CHAR;
  15.            END;
  16.          END;
  17.  
  18. VAR
  19.   RegsAX, RegsDX : Regs;
  20.   pfadadr        : ADDRESS;
  21.  
  22.  
  23.   PROCEDURE GetDrive(VAR Laufwerk : CARDINAL);
  24.   BEGIN
  25.     RegsAX.h  := CHR(25);              (* DOS-Funktion 25 *)
  26.     AX        := RegsAX.lh;
  27.     XTrap(33);
  28.     RegsAX.lh := AX;
  29.     Laufwerk  := ORD(RegsAX.l);
  30.   END GetDrive;
  31.  
  32.   PROCEDURE GetDir(Laufwerk : CARDINAL; VAR s : Path);
  33.   BEGIN
  34.     RegsAX.h  := CHR(71);              (* DOS-Funktion 71 *)
  35.     AX        := RegsAX.lh;
  36.     RegsDX.l  := CHR(Laufwerk);
  37.     DX        := RegsDX.lh;
  38.     pfadadr   := ADR(s);
  39.     DS        := pfadadr.SEG;
  40.     SI        := pfadadr.OFS;
  41.     XTrap(33);
  42.     IF (CARDINAL(FLAGS) MOD 2) = 1 THEN
  43.                                   (* Carry Flag gesetzt ? *)
  44.       DosError := AX;
  45.     ELSE
  46.       DosError := 0;
  47.     END;
  48.   END GetDir;
  49.  
  50.   PROCEDURE ChDir(s : Path);
  51.   BEGIN
  52.     RegsAX.h  := CHR(59);              (* DOS-Funktion 59 *)
  53.     AX        := RegsAX.lh;
  54.     pfadadr   := ADR(s);
  55.     DS        := pfadadr.SEG;
  56.     DX        := pfadadr.OFS;
  57.     XTrap(33);
  58.     IF (CARDINAL(FLAGS) MOD 2) = 1 THEN
  59.                                   (* Carry Flag gesetzt ? *)
  60.         DosError:=AX;
  61.     ELSE
  62.        DosError:=0;
  63.     END;
  64.   END ChDir;
  65.  
  66.   PROCEDURE MkDir(s : Path);
  67.   BEGIN
  68.     RegsAX.h  := CHR(57);              (* DOS-Funktion 57 *)
  69.     AX        := RegsAX.lh;
  70.     pfadadr   := ADR(s);
  71.     DS        := pfadadr.SEG;
  72.     DX        := pfadadr.OFS;
  73.     XTrap(33);
  74.     IF (CARDINAL(FLAGS) MOD 2) = 1 THEN
  75.                                   (* Carry Flag gesetzt ? *)
  76.       DosError := AX;
  77.     ELSE
  78.       DosError := 0;
  79.     END;
  80.   END MkDir;
  81.  
  82.   PROCEDURE RmDir(s : Path);
  83.   BEGIN
  84.     RegsAX.h  := CHR(58);              (* DOS-Funktion 58 *)
  85.     AX        := RegsAX.lh;
  86.     pfadadr   := ADR(s);
  87.     DS        := pfadadr.SEG;
  88.     DX        := pfadadr.OFS;
  89.     XTrap(33);
  90.     IF (CARDINAL(FLAGS) MOD 2) = 1 THEN
  91.                                   (* Carry Flag gesetzt ? *)
  92.       DosError := AX;
  93.     ELSE
  94.       DosError := 0;
  95.     END;
  96.   END RmDir;
  97.  
  98.   PROCEDURE PackTime(VAR zeit : LONGCARD;
  99.                      VAR DT : DateTime);
  100.   VAR
  101.     zinfo : LONGCARD;
  102.  
  103.     PROCEDURE einpacken(quelle, anfg : CARDINAL;
  104.                         VAR ergebnis : LONGCARD);
  105.     VAR
  106.       i          : CARDINAL;
  107.       faktor, qu : LONGCARD;
  108.     BEGIN
  109.       faktor := 1L;
  110.       FOR i := 1 TO anfg-1 DO
  111.           faktor := 2L * faktor;
  112.       END;
  113.       qu := LONG(quelle);
  114.       qu := qu * faktor;
  115.       ergebnis := ergebnis + qu;
  116.     END einpacken;
  117.  
  118.   BEGIN
  119.     WITH DT DO
  120.       zinfo := 0L;
  121.       einpacken(Sec, 1, zinfo);
  122.       einpacken(Min, 6, zinfo);
  123.       einpacken(Hour, 12, zinfo);
  124.       einpacken(Day, 17, zinfo);
  125.       einpacken(Month, 22, zinfo);
  126.       Year := Year - 1980;
  127.       einpacken(Year, 26, zinfo);
  128.       zeit := zinfo;
  129.     END;
  130.   END PackTime;
  131.  
  132.   PROCEDURE UnpackTime(VAR zeit : LONGCARD;
  133.                        VAR DT : DateTime);
  134.   TYPE
  135.     ZI = RECORD
  136.            CASE B : BOOLEAN OF
  137.                       TRUE  : td       : LONGCARD;
  138.                     | FALSE : hms, ymd : CARDINAL;
  139.            END;
  140.          END;
  141.   VAR
  142.     zinfo : ZI;
  143.  
  144.     PROCEDURE auspacken(VAR ergebnis : CARDINAL;
  145.                         anfg, lge, quelle : CARDINAL);
  146.     VAR
  147.       vglerg, zler, vgl, cut, i : CARDINAL;
  148.     BEGIN
  149.       cut := 1;
  150.       FOR i := 1 TO anfg-1 DO
  151.         cut := 2 * cut;
  152.       END;
  153.       quelle := (quelle DIV cut);   (* Binärzahl abteilen *)
  154.       ergebnis := 0;                (* Dezimales Ergebnis *)
  155.       vgl := 1;          (* Zweierpotenz für Bitvergleich *)
  156.       FOR zler := 1 TO lge DO
  157.         ASM
  158.           MOV AX,quelle  (* Feststellen, ob in der Binär- *)
  159.           MOV BX,vgl     (* zahl das entsprechende        *)
  160.           AND AX,BX      (* Bit gesetzt ist               *)
  161.           MOV vglerg,AX  (* Wenn gesetzt:
  162.                                    vglerg:=2 hoch (vgl-1) *)
  163.                          (* Sonst: vglerg:=0              *)
  164.         END;
  165.         ergebnis := ergebnis + vglerg;
  166.         vgl := vgl * 2;
  167.       END;
  168.     END auspacken;
  169.  
  170.   BEGIN
  171.     WITH DT DO
  172.       zinfo.td := zeit;
  173.       auspacken(Sec, 1, 5, zinfo.hms);
  174.       auspacken(Min, 6, 6, zinfo.hms);
  175.       auspacken(Hour, 12, 5, zinfo.hms);
  176.       auspacken(Day, 1, 5, zinfo.ymd);
  177.       auspacken(Month, 6, 4, zinfo.ymd);
  178.       auspacken(Year, 10, 7, zinfo.ymd);
  179.       Year := 1980 + Year;
  180.     END;
  181.   END UnpackTime;
  182.  
  183.   PROCEDURE FindFirst(suchpfad : Path; Attr : CARDINAL;
  184.                       VAR datei : SearchRec);
  185.   VAR
  186.     addta : ADDRESS;
  187.   BEGIN
  188.     RegsAX.h  := CHR(26);              (* DOS Funktion 26 *)
  189.     AX        := RegsAX.lh;
  190.     addta     := ADR(datei);        (* DTA Adresse setzen *)
  191.     DS        := addta.SEG;
  192.     DX        := addta.OFS;
  193.     XTrap(33);
  194.     RegsAX.h  := CHR(78);        (* Ersten Eintrag suchen *)
  195.     AX        := RegsAX.lh;
  196.     pfadadr   := ADR(suchpfad);
  197.     DS        := pfadadr.SEG;
  198.     DX        := pfadadr.OFS;
  199.     CX        := Attr;
  200.     XTrap(33);
  201.     IF (CARDINAL(FLAGS) MOD 2) = 1 THEN
  202.                                   (* Carry Flag gesetzt ? *)
  203.       DosError := AX;
  204.     ELSE
  205.       DosError := 0;
  206.     END;
  207.   END FindFirst;
  208.  
  209.   PROCEDURE FindNext(VAR datei : SearchRec);
  210.   BEGIN
  211.     RegsAX.h  := CHR(79);
  212.     AX        := RegsAX.lh;
  213.     XTrap(33);
  214.     IF (CARDINAL(FLAGS) MOD 2) = 1 THEN
  215.                                   (* Carry Flag gesetzt ? *)
  216.       DosError := AX;
  217.     ELSE
  218.       DosError := 0;
  219.     END;
  220.   END FindNext;
  221.  
  222.   PROCEDURE GetFATTr(VAR datei : Path; VAR Attr : CARDINAL);
  223.   BEGIN
  224.     RegsAX.h  := CHR(67);              (* DOS Funktion 67 *)
  225.     RegsAX.l  := CHR(0);               (* Unterfunktion 0 *)
  226.     AX        := RegsAX.lh;
  227.     pfadadr   := ADR(datei);
  228.     DS        := pfadadr.SEG;
  229.     DX        := pfadadr.OFS;
  230.     XTrap(33);
  231.     Attr      := CX;
  232.     IF (CARDINAL(FLAGS) MOD 2) = 1 THEN
  233.                                   (* Carry Flag gesetzt ? *)
  234.       DosError := AX;
  235.     ELSE
  236.       DosError := 0;
  237.     END;
  238.   END GetFATTr;
  239.  
  240.   PROCEDURE SetFATTr(VAR datei : Path; Attr : CARDINAL);
  241.   BEGIN
  242.     RegsAX.h := CHR(67);               (* DOS Funktion 67 *)
  243.     RegsAX.l := CHR(1);                (* Unterfunktion 1 *)
  244.     AX       := RegsAX.lh;
  245.     pfadadr  := ADR(datei);
  246.     DS       := pfadadr.SEG;
  247.     DX       := pfadadr.OFS;
  248.     CX       := Attr;
  249.     XTrap(33);
  250.     IF (CARDINAL(FLAGS) MOD 2) = 1 THEN
  251.                                   (* Carry Flag gesetzt ? *)
  252.       DosError := AX;
  253.     ELSE
  254.       DosError := 0;
  255.     END;
  256.   END SetFATTr;
  257.  
  258. BEGIN
  259.   DosError := 0;
  260. END Fildir.
  261. (* ------------------------------------------------------ *)
  262. (*                 Ende von FILDIR.MOD                    *)
  263.