Programmer 7500/MAX_PROGRAMMERS.iso/CLIPPER/MISC/MODULA2F.ZIP/DOSDISK.MOD

Modula Implementation | 1992-06-22 | 5.3 KB | 253 lines

IMPLEMENTATION MODULE DOSdisk;

FROM SYSTEM IMPORT ASSEMBLER, ADDRESS, ADR, SEG, OFS;

VAR dta:ARRAY[0..42] OF CHAR;
    sg,of:CARDINAL;

PROCEDURE SetDrive(drive:CHAR);
    VAR number:CARDINAL;
    BEGIN
        CASE drive OF
            'A','a':number := 0|
            'B','b':number := 1|
            'C','c':number := 2|
            'D','d':number := 3;
        END; (* case *)
        ASM
            MOV AH,14
            MOV DL,number
            INT 21H
        END;
    END SetDrive;

PROCEDURE GetDrive(VAR drive:CHAR);
    VAR number:CARDINAL;
    BEGIN
        ASM
            MOV AH,25
            INT 21H
            MOV number,AL
        END;
        CASE number OF
            0:drive := 'A'|
            1:drive := 'B'|
            2:drive := 'C'|
            3:drive := 'D';
        END; (* case *)
    END GetDrive;

PROCEDURE Mkdir(directory:ARRAY OF CHAR; VAR error:CARDINAL);
    BEGIN
        error := 0;
        ASM
            LDS DX,directory
            MOV AH,57
            INT 21H
            JNC DONE
            LES DI,error
            MOV ES:[DI],AX
    DONE:   NOP
        END;
    END Mkdir;

PROCEDURE Chdir(directory:ARRAY OF CHAR; VAR error:CARDINAL);
    BEGIN
        error := 0;
        ASM
            LDS DX,directory
            MOV AH,59
            INT 21H
            JNC DONE
            LES DI,error
            MOV ES:[DI],AX
    DONE:   NOP
        END;
    END Chdir;

PROCEDURE Rmdir(directory:ARRAY OF CHAR; VAR error:CARDINAL);
    BEGIN
        error := 0;
        ASM
            LDS DX,directory
            MOV AH,58
            INT 21H
            JNC DONE
            LES DI,error
            MOV ES:[DI],AX
    DONE:   NOP
        END;
    END Rmdir;

PROCEDURE GetDir(VAR directory:ARRAY OF CHAR);
    BEGIN
        ASM
            LDS SI,directory
            XOR DL,DL
            MOV AH,71
            INT 21H
        END;
    END GetDir;

PROCEDURE Delete(file:ARRAY OF CHAR; VAR error:CARDINAL);
    BEGIN
        ASM
            LDS DX,file
            MOV AH,65
            INT 21H
            LES DI,error
            MOV ES:[DI],AX
        END;
    END Delete;

PROCEDURE FindFirst(name:ARRAY OF CHAR; attr:CARDINAL; VAR error:CARDINAL);
    BEGIN
        ASM
            PUSH DS
            MOV AH,47
            INT 21H
            MOV DI,ES
            MOV SI,BX

            PUSH DS
            MOV DS,sg
            MOV DX,of
            MOV AH,26
            INT 21H
            POP DS

            LDS DX,name
            MOV AH,78
            MOV CX,attr
            INT 21H
            LES BX,error
            MOV ES:[BX],AX

            MOV DS,DI
            MOV DX,SI
            MOV AH,26
            INT 21H
            POP DS
        END;
    END FindFirst;

PROCEDURE FindNext(VAR error:CARDINAL);
    BEGIN
        ASM
            PUSH DS
            MOV AH,47
            INT 21H
            MOV DI,ES
            MOV SI,BX

            PUSH DS
            MOV DS,sg
            MOV DX,of
            MOV AH,26
            INT 21H
            POP DS

            MOV AH,79
            INT 21H
            LES BX,error
            MOV ES:[BX],AX

            MOV DS,DI
            MOV DX,SI
            MOV AH,26
            INT 21H
            POP DS
        END;
    END FindNext;

PROCEDURE FindAttr(VAR attr:CARDINAL);
    BEGIN
        attr := ORD(dta[21]);
    END FindAttr;

PROCEDURE FindTime(VAR hour,min,sec:CARDINAL);
    BEGIN
        ASM
            PUSH ES
            MOV ES,sg
            MOV BX,of
            MOV AX,ES:[BX+22]
            POP ES
            XOR DX,DX
            MOV DL,AH
            MOV CL,3
            SHR DL,CL
            LES DI,hour
            MOV ES:[DI],DX
            MOV DL,AL
            AND DL,31
            SHL DL,1
            LES DI,min
            MOV ES:[DI],DX
            MOV CL,5
            SHR AX,CL
            AND AX,63
            LES DI,sec
            MOV ES:[DI],AX
        END;
    END FindTime;

PROCEDURE FindDate(VAR month,day,year:CARDINAL);
    BEGIN
        ASM
            PUSH ES
            MOV ES,sg
            MOV BX,of
            MOV DX,ES:[BX+24]
            POP ES
            XOR CX,CX
            MOV CL,DL
            AND CL,31
            LES DI,day
            MOV ES:[DI],CX
            MOV CL,DH
            SHR CL,1
            ADD CX,1980
            LES DI,year
            MOV ES:[DI],CX
            MOV CL,5
            SHR DX,CL
            AND DX,15
            LES DI,month
            MOV ES:[DI],DX
        END;
    END FindDate;

PROCEDURE FindLength(VAR len:LONGCARD);
    VAR h,l:CARDINAL;

    BEGIN
        ASM
            PUSH ES
            MOV ES,sg
            MOV BX,of
            MOV AX,ES:[BX+26]
            MOV CX,ES:[BX+28]
            MOV l,AX
            MOV h,CX
            POP ES
        END;
        len := LONG(h) * 65536L + LONG(l);
    END FindLength;

PROCEDURE FindName(VAR name:ARRAY OF CHAR);
    VAR i:CARDINAL;

    BEGIN
        FOR i := 30 TO 42 DO
            name[i-30] := dta[i];
        END; (* for *)
    END FindName;

VAR vp:ADDRESS;

BEGIN
    vp := ADR(dta);
    sg := vp.SEG;
    of := vp.OFS;
END DOSdisk.