home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turbo Toolbox
/
Turbo_Toolbox.iso
/
1990
/
07
/
tricks
/
fildir.mod
< prev
next >
Wrap
Text File
|
1990-04-06
|
7KB
|
263 lines
(* ------------------------------------------------------ *)
(* FILDIR.MOD *)
(* ------------------------------------------------------ *)
(* $S-, $R-, $T- *)
IMPLEMENTATION MODULE Fildir;
FROM SYSTEM IMPORT ADDRESS, SEG, OFS, ADR, ASSEMBLER;
FROM System IMPORT XTrap,AX,BX,CX,DX,SI,DI,BP,DS,ES,FLAGS;
TYPE
Regs = RECORD
CASE B : BOOLEAN OF
TRUE : lh : CARDINAL;
| FALSE : l, h : CHAR;
END;
END;
VAR
RegsAX, RegsDX : Regs;
pfadadr : ADDRESS;
PROCEDURE GetDrive(VAR Laufwerk : CARDINAL);
BEGIN
RegsAX.h := CHR(25); (* DOS-Funktion 25 *)
AX := RegsAX.lh;
XTrap(33);
RegsAX.lh := AX;
Laufwerk := ORD(RegsAX.l);
END GetDrive;
PROCEDURE GetDir(Laufwerk : CARDINAL; VAR s : Path);
BEGIN
RegsAX.h := CHR(71); (* DOS-Funktion 71 *)
AX := RegsAX.lh;
RegsDX.l := CHR(Laufwerk);
DX := RegsDX.lh;
pfadadr := ADR(s);
DS := pfadadr.SEG;
SI := pfadadr.OFS;
XTrap(33);
IF (CARDINAL(FLAGS) MOD 2) = 1 THEN
(* Carry Flag gesetzt ? *)
DosError := AX;
ELSE
DosError := 0;
END;
END GetDir;
PROCEDURE ChDir(s : Path);
BEGIN
RegsAX.h := CHR(59); (* DOS-Funktion 59 *)
AX := RegsAX.lh;
pfadadr := ADR(s);
DS := pfadadr.SEG;
DX := pfadadr.OFS;
XTrap(33);
IF (CARDINAL(FLAGS) MOD 2) = 1 THEN
(* Carry Flag gesetzt ? *)
DosError:=AX;
ELSE
DosError:=0;
END;
END ChDir;
PROCEDURE MkDir(s : Path);
BEGIN
RegsAX.h := CHR(57); (* DOS-Funktion 57 *)
AX := RegsAX.lh;
pfadadr := ADR(s);
DS := pfadadr.SEG;
DX := pfadadr.OFS;
XTrap(33);
IF (CARDINAL(FLAGS) MOD 2) = 1 THEN
(* Carry Flag gesetzt ? *)
DosError := AX;
ELSE
DosError := 0;
END;
END MkDir;
PROCEDURE RmDir(s : Path);
BEGIN
RegsAX.h := CHR(58); (* DOS-Funktion 58 *)
AX := RegsAX.lh;
pfadadr := ADR(s);
DS := pfadadr.SEG;
DX := pfadadr.OFS;
XTrap(33);
IF (CARDINAL(FLAGS) MOD 2) = 1 THEN
(* Carry Flag gesetzt ? *)
DosError := AX;
ELSE
DosError := 0;
END;
END RmDir;
PROCEDURE PackTime(VAR zeit : LONGCARD;
VAR DT : DateTime);
VAR
zinfo : LONGCARD;
PROCEDURE einpacken(quelle, anfg : CARDINAL;
VAR ergebnis : LONGCARD);
VAR
i : CARDINAL;
faktor, qu : LONGCARD;
BEGIN
faktor := 1L;
FOR i := 1 TO anfg-1 DO
faktor := 2L * faktor;
END;
qu := LONG(quelle);
qu := qu * faktor;
ergebnis := ergebnis + qu;
END einpacken;
BEGIN
WITH DT DO
zinfo := 0L;
einpacken(Sec, 1, zinfo);
einpacken(Min, 6, zinfo);
einpacken(Hour, 12, zinfo);
einpacken(Day, 17, zinfo);
einpacken(Month, 22, zinfo);
Year := Year - 1980;
einpacken(Year, 26, zinfo);
zeit := zinfo;
END;
END PackTime;
PROCEDURE UnpackTime(VAR zeit : LONGCARD;
VAR DT : DateTime);
TYPE
ZI = RECORD
CASE B : BOOLEAN OF
TRUE : td : LONGCARD;
| FALSE : hms, ymd : CARDINAL;
END;
END;
VAR
zinfo : ZI;
PROCEDURE auspacken(VAR ergebnis : CARDINAL;
anfg, lge, quelle : CARDINAL);
VAR
vglerg, zler, vgl, cut, i : CARDINAL;
BEGIN
cut := 1;
FOR i := 1 TO anfg-1 DO
cut := 2 * cut;
END;
quelle := (quelle DIV cut); (* Binärzahl abteilen *)
ergebnis := 0; (* Dezimales Ergebnis *)
vgl := 1; (* Zweierpotenz für Bitvergleich *)
FOR zler := 1 TO lge DO
ASM
MOV AX,quelle (* Feststellen, ob in der Binär- *)
MOV BX,vgl (* zahl das entsprechende *)
AND AX,BX (* Bit gesetzt ist *)
MOV vglerg,AX (* Wenn gesetzt:
vglerg:=2 hoch (vgl-1) *)
(* Sonst: vglerg:=0 *)
END;
ergebnis := ergebnis + vglerg;
vgl := vgl * 2;
END;
END auspacken;
BEGIN
WITH DT DO
zinfo.td := zeit;
auspacken(Sec, 1, 5, zinfo.hms);
auspacken(Min, 6, 6, zinfo.hms);
auspacken(Hour, 12, 5, zinfo.hms);
auspacken(Day, 1, 5, zinfo.ymd);
auspacken(Month, 6, 4, zinfo.ymd);
auspacken(Year, 10, 7, zinfo.ymd);
Year := 1980 + Year;
END;
END UnpackTime;
PROCEDURE FindFirst(suchpfad : Path; Attr : CARDINAL;
VAR datei : SearchRec);
VAR
addta : ADDRESS;
BEGIN
RegsAX.h := CHR(26); (* DOS Funktion 26 *)
AX := RegsAX.lh;
addta := ADR(datei); (* DTA Adresse setzen *)
DS := addta.SEG;
DX := addta.OFS;
XTrap(33);
RegsAX.h := CHR(78); (* Ersten Eintrag suchen *)
AX := RegsAX.lh;
pfadadr := ADR(suchpfad);
DS := pfadadr.SEG;
DX := pfadadr.OFS;
CX := Attr;
XTrap(33);
IF (CARDINAL(FLAGS) MOD 2) = 1 THEN
(* Carry Flag gesetzt ? *)
DosError := AX;
ELSE
DosError := 0;
END;
END FindFirst;
PROCEDURE FindNext(VAR datei : SearchRec);
BEGIN
RegsAX.h := CHR(79);
AX := RegsAX.lh;
XTrap(33);
IF (CARDINAL(FLAGS) MOD 2) = 1 THEN
(* Carry Flag gesetzt ? *)
DosError := AX;
ELSE
DosError := 0;
END;
END FindNext;
PROCEDURE GetFATTr(VAR datei : Path; VAR Attr : CARDINAL);
BEGIN
RegsAX.h := CHR(67); (* DOS Funktion 67 *)
RegsAX.l := CHR(0); (* Unterfunktion 0 *)
AX := RegsAX.lh;
pfadadr := ADR(datei);
DS := pfadadr.SEG;
DX := pfadadr.OFS;
XTrap(33);
Attr := CX;
IF (CARDINAL(FLAGS) MOD 2) = 1 THEN
(* Carry Flag gesetzt ? *)
DosError := AX;
ELSE
DosError := 0;
END;
END GetFATTr;
PROCEDURE SetFATTr(VAR datei : Path; Attr : CARDINAL);
BEGIN
RegsAX.h := CHR(67); (* DOS Funktion 67 *)
RegsAX.l := CHR(1); (* Unterfunktion 1 *)
AX := RegsAX.lh;
pfadadr := ADR(datei);
DS := pfadadr.SEG;
DX := pfadadr.OFS;
CX := Attr;
XTrap(33);
IF (CARDINAL(FLAGS) MOD 2) = 1 THEN
(* Carry Flag gesetzt ? *)
DosError := AX;
ELSE
DosError := 0;
END;
END SetFATTr;
BEGIN
DosError := 0;
END Fildir.
(* ------------------------------------------------------ *)
(* Ende von FILDIR.MOD *)