Mega Top 1/os2_top1.zip/os2_top1/APPS/PROG/PASCAL/SPEED2/SRC/LIB/DOS.PAS

Pascal/Delphi Source File | 1994-09-29 | 28.1 KB | 1,127 lines

UNIT Dos;

{**************************************************************************
 *                 General Unit for Speed-386                             *
 *                                                                        *
 *                                                                        *
 * Copyright (C) 1993,94 R.Nürnberger, Franz-Mehring-Str.2 09112 Chemnitz *
 *                                                                        *
 *                                                                        *
 **************************************************************************}


interface


const

{ Flags bit masks }

  FCarry     = 1;
  FParity    = 4;
  FAuxiliary = 16;
  FZero      = 64;
  FSign      = 128;
  FOverflow  = 2048;

{ File mode numbers }

  fmClosed = 0;
  fmInput  = $40;   {Read only}
  fmOutput = $41;   {Write only}
  fmInOut  = $42;   {allow both read and write access}

{ File attribute constants }

  ReadOnly  = 1;
  Hidden    = 2;
  SysFile   = 4;
  Directory = 16;
  Archive   = 32;
  AnyFile   = 55;

{Compare File times result codes}
  F_EQUAL          =0;
  F_FIRST_GREATER  =1;
  F_SECOND_GREATER =2;
  F_ERROR          =255;

type
      CmdStr  = string;        { Command line string }
      PathStr = string[79];    { File pathname string }
      DirStr  = string[128];   { Drive and directory string }
      NameStr = string[8];     { File name string }
      ExtStr  = string[4];     { File extension string }


      Registers =
         record
           case of
             0: (EAX,EBX,ECX,EDX,EBP,ESI,EDI,DS_ES,EFlags:LongWord);
             1: (AX,X_AX,BX,X_BX,CX,X_CX,DX,X_DX,BP,X_BP,SI,X_SI,
                 DI,X_DI,DS,ES,Flags,X_FLAGS: Word);
             2: (AL,AH,X_AL,X_AH,BL,BH,X_BL,X_BH,CL,CH,X_CL,X_CH,
                 DL,DH,X_DL,X_DH: Byte);
           end;


      FileRec = record
                      Handle   : LongWord;
                      RecSize  : LongWord;
                      Name     : array[0..79] of Char;
                      Private1 : POINTER;  {extended attributes}
                      Mode     : LONGWORD; {Current file mode}
                      Reserved : POINTER;  {for further extensions}
                end;


      TextRec = record
                      Handle    : LongWord;
                      RecSize  : LongWord; {not used yet}
                      Name      : array[0..79] of Char;
                      Private1 : POINTER;  {extended attributes}
                      Mode     : LONGWORD; {Current file mode}
                      Reserved : POINTER;  {for further extensions}
                end;

{ Search record used by FindFirst and FindNext }

TYPE
  TSearchRec = record
                     oNextEntryOffset:LONGWORD;
                     fdateCreation:WORD;
                     Time:WORD;
                     fdateLastAccess:WORD;
                     ftimeLastAccess:WORD;
                     fdateLastWrite:WORD;
                     ftimeLastWrite:WORD;
                     Size:LONGWORD;
                     cbFileAlloc:LONGWORD;
                     Attr:LONGWORD;
                     cchName:BYTE;
                     Name:STRING;
                     {private}
                     HDir:LONGINT;
               end;

  _PFSALLOCATE=^_FSALLOCATE;
  _FSALLOCATE=RECORD
                    idFileSystem:LONGWORD;
                    cSectorUnit:LONGWORD;
                    cUnit:LONGWORD;
                    cUnitAvail:LONGWORD;
                    cbSector:WORD;
               END;

  _PFILESTATUS3=^_FILESTATUS3;
  _FILESTATUS3=RECORD
                    fdateCreation:WORD;
                    ftimeCreation:WORD;
                    fdateLastAccess:WORD;
                    ftimeLastAccess:WORD;
                    fdateLastWrite:WORD;
                    ftimeLastWrite:WORD;
                    cbFile:LONGWORD;
                    cbFileAlloc:LONGWORD;
                    attrFile:LONGWORD;
                END;

  {Type for GetEnvStr}
  PEnvString=^TEnvString;
  TEnvString=array[0..65500] of Char; {terminated with 0-character}

  ExecResultCode=record
                     codeTerminate:LONGWORD;
                     codeResult:LONGWORD;
                 end;

VAR DosError:LongWord;   {DOS unit error status}

{Time/Date functions}
PROCEDURE GetDate(var Year,Month,Day,DayOfWeek: Word);
PROCEDURE SetDate(Year,Month,Day,DayOfWeek: Word);
PROCEDURE GetTime(var Hour,Minute,Second,Sec100: Word);
PROCEDURE SetTime(Hour,Minute,Second,Sec100: Word);
PROCEDURE GetFAttr(var F; var Attr: LongWord);
PROCEDURE SetFAttr(var F; Attr: LongWord);
PROCEDURE GetFTime(var F; var year,month,day,hours,minutes,twosecs:Word);
PROCEDURE SetFTime(var F; year,month,day,hours,minutes,twosecs:Word);
FUNCTION  PackTime(hour,minute,twosec:Word):Word;
FUNCTION  PackDate(year,month,day:Word):Word;
PROCEDURE UnPackTime(pack:Word;var hour,minute,twosec:Word);
PROCEDURE UnPackDate(pack:Word;var year,month,day:Word);

{File find functions}
PROCEDURE FindFirst(Path: PathStr; Attr: LongWord; var F: TSearchRec);
PROCEDURE FindNext(var F: TSearchRec);
FUNCTION FSearch(Path: PathStr; DirList: String): PathStr;


{Common functions}
PROCEDURE Delay(ms:LONGWORD);
{FUNCTION FExpand(Path: PathStr): PathStr;}
PROCEDURE FSplit(Path: PathStr; var Dir: DirStr;
                 var Name: NameStr; var Ext: ExtStr);
FUNCTION CompareFileTimes(First,Second:STRING):BYTE;
FUNCTION  DosVersion:Word;
PROCEDURE GetVerify(var Verify: Boolean);
PROCEDURE SetVerify(Verify: Boolean);
FUNCTION  EnvStr(Env:String): PEnvString;
FUNCTION  DiskFree(Drive: Byte): LongWord;
FUNCTION  DiskSize(Drive: Byte): LongWord;

{Process functions}
PROCEDURE Exec(Path: PathStr; CmdLine: CmdStr;VAR return:ExecResultCode);
FUNCTION ProcessActive(pid:LONGWORD):BOOLEAN;
PROCEDURE KillProcess(pid:LONGWORD);

{Thread functions}
PROCEDURE StartThread(ThreadAddr:POINTER;StackSize:LONGWORD;
                      Params:POINTER;VAR Tid:LONGWORD);
PROCEDURE SuspendThread(Tid:LONGWORD);
PROCEDURE ResumeThread(Tid:LONGWORD);
PROCEDURE KillThread(Tid:LONGWORD);

IMPLEMENTATION

TYPE
 TSearchRecIntern = record
                     oNextEntryOffset:LONGWORD;
                     fdateCreation:WORD;
                     Time:WORD;
                     fdateLastAccess:WORD;
                     ftimeLastAccess:WORD;
                     fdateLastWrite:WORD;
                     ftimeLastWrite:WORD;
                     Size:LONGWORD;
                     cbFileAlloc:LONGWORD;
                     Attr:LONGWORD;
                     cchName:BYTE;
                     Name:ARRAY[0..255] OF CHAR;
                     {private}
                     HDir:LONGINT;
               end;

VAR
   TempCmdLine:STRING;

IMPORTS {private}
       FUNCTION DosWaitChild(pid:LONGWORD;VAR rpid:LONGWORD;
                             VAR res:ExecResultCode;option:LONGWORD;
                             action:LONGWORD):LONGWORD: DOSCALLS index 280;
       PROCEDURE DosKillProcess(pid:LONGWORD;
                                action:LONGWORD):       DOSCALLS index 235;
       FUNCTION DosCreateThread(Stack,Flags:LONGWORD;Para:POINTER;
                                Adr:POINTER;VAR tid:LONGWORD):
                                LONGWORD:               DOSCALLS index 311;
       FUNCTION DosResumeThread(_tid:LONGWORD):LONGWORD:DOSCALLS index 237;

       FUNCTION DosSuspendThread(_tid:LONGWORD):LONGWORD:DOSCALLS index 238;
       FUNCTION DosKillThread(_tid:LONGWORD):LONGWORD:  DOSCALLS index 111;
END;


PROCEDURE KillThread(Tid:LONGWORD);
BEGIN
     DosKillThread(Tid);
END;

PROCEDURE SuspendThread(Tid:LONGWORD);
BEGIN
     DosSuspendThread(Tid);
END;

PROCEDURE ResumeThread(Tid:LONGWORD);
BEGIN
     DosResumeThread(Tid);
END;

PROCEDURE StartThread(ThreadAddr:POINTER;StackSize:LONGWORD;
                      Params:POINTER;VAR Tid:LONGWORD);
BEGIN
     DosCreateThread(StackSize,2,Params,@ThreadAddr,Tid);
END;


PROCEDURE KillProcess(pid:LONGWORD);
BEGIN
     DosKillProcess(pid,0);
END;

FUNCTION ProcessActive(pid:LONGWORD):BOOLEAN;
VAR r,rpid:LONGWORD;
    res:Execresultcode;
BEGIN
     r:=DosWaitChild(pid,rpid,res,1{DCWW_NOWAIT},0{DCWA_PROCESS});
     IF r=129 {child not complete} THEN ProcessActive:=TRUE;
     ELSE ProcessActive:=FALSE; {Child complete or illegal pid}
END;

PROCEDURE FSplit(Path: PathStr; var Dir: DirStr;
                 var Name: NameStr; var Ext: ExtStr);
BEGIN
     ASM
        LEA ESI,$Path
        MOV AL,[ESI+0]
        INC ESI
        XOR EDX,EDX
        XOR EBX,EBX
        MOV DL,AL
        XOR DH,DH
        MOV BX,DX
        PUSH ESI
        POP  EDI
        ADD  EDI,EBX
        DEC  EDI
        OR   EBX,EBX  ;String length 0 ?
        JE   !L_2
!L_1:
        CMPB [EDI+0],'\'
        JE   !L_2
        CMPB [EDI+0],':'
        JE   !L_2
        DEC  EDI
        DEC  EBX
        JNE  !L_1   ;until string begin
!L_2:
        MOV  EAX,67
        MOV EDI,$Dir
        CALLN32 System.!CopyString

        XOR EBX,EBX
        PUSH ESI
        POP EDI
        JMP !L_4
!L_3:
        CMPB [EDI+0],46
        JE !L_5
        INC EBX
        INC EDI
!L_4:
        CMP EBX,EDX
        JNE !L_3
!L_5:
        MOV EAX,8
        MOV EDI,$Name
        CALLN32 System.!CopyString

        MOV EAX,4
        PUSH EDX
        POP EBX
        MOV EDI,$Ext
        CALLN32 System.!CopyString
    END;
END;

FUNCTION FSearch(Path: PathStr; DirList: String): PathStr;
var r:PATHSTR;
BEGIN
     ASM
        PUSHL 79  ;result buf len
        LEA EAX,$r
        INC EAX
        PUSH EAX
        LEA EAX,$Path
        INC EAX
        PUSh EAX
        LEA EAX,$DirList
        INC EAX
        PUSH EAX
        PUSHL 0   ;Flags
        MOV AL,5
        CALLDLL DosCalls,228    ;DosSearchPath
        ADD ESP,20
        MOV _DosError,EAX
    END;
    IF DosError=0 THEN
    BEGIN
         ASM
            LEA ESI,$r
            INC ESI
            MOV CL,255
            CLD
!nef:
            INC CL
            LODSB
            CMP AL,0
            JNE !nef

            LEA EDI,$r
            MOV [EDI+0],CL  ;Set string len
        END;
    END
    ELSE r:='';
    FSearch:=r;
END;

FUNCTION PackTime(hour,minute,twosec:Word):Word;
VAR time:Word;
BEGIN
     ASM
        MOV BL,$Hour
        SHL BL,3    ;multiply with 8
        MOV AL,$minute
        SHR AL,3    ;divide by 8
        ADD AL,BL
        SHL AX,8    ;Shift
        MOV $time,AX

        MOV BL,$minute
        AND BL,7
        SHL BL,5    ;multiply with 2 and shift
        ADD BL,$TwoSec
        MOV $time,BL
     END;
     PackTime:=Time;
END;

FUNCTION Packdate(year,month,day:Word):Word;
VAR Date:Word;
BEGIN
     ASM
        MOV AL,$month
        MOV BL,0
        CMP AL,7
        JNA !mo1
        MOV BL,1
        SUB AL,8
!mo1:
        MOV CX,$year
        SUB CX,1980
        SHL CX,1    ;multiply with 2
        MOVZX BX,BL
        ADD CX,BX
        SHL CX,8    ;Shift
        MOV $Date,CX

        SHL AL,5    ;multiply month with 2 and shift
        ADD AL,$Day
        MOV $Date,AL
     END;
     PackDate:=Date;
END;

PROCEDURE UnPackTime(pack:Word;var hour,minute,twosec:Word);
VAR h,min,sec:WORD;
BEGIN
    ASM
       MOV DX,$pack

       MOV AL,DH    ;Hour/Minute
       AND AL,248   ;Mask Hour
       SHR AL,3     ;divide by 8
       MOVZX AX,AL
       MOV $h,AX

       MOV AL,DH    ;Hour/Minute
       AND AL,7     ;Mask Minute
       SHL AL,3     ;multiply with 8
       MOV BL,AL

       MOV AL,DL    ;Minute/sec
       AND AL,224   ;Mask minute
       SHR AL,5     ;divide by 2 and shift
       ADD AL,BL
       MOVZX AX,AL
       MOV $min,AX

       MOV AL,DL    ;Minute/sec
       AND AL,31    ;Mask twoseconds
       MOVZX AX,AL
       MOV $sec,AX
     END;
     Hour:=h;
     minute:=min;
     twosec:=sec;
END;

PROCEDURE UnPackDate(pack:Word;var year,month,day:Word);
VAR y,m,d:Word;
BEGIN
     ASM
        MOV DX,$pack

        MOV AL,DH    ;Year/Month
        AND AL,254   ;Clear Bit 1
        SHR AL,1     ;Divide by 2
        MOVZX AX,AL
        ADD AX,1980
        MOV $y,AX    ;Year
        MOV BL,0
        MOV AL,DH    ;Year/Month
        AND AL,1     ;Mask HSB month
        CMP AL,1
        JNE !ml7
        MOV BL,8
!ml7:
        MOV AL,DL    ;month/Day
        AND AL,224   ;mask month (upper 3 bits)
        SHR AL,5     ;divide by 2 and shift
        ADD AL,BL
        MOVZX AX,AL
        MOV $m,AX    ;Month

        MOV AL,DL    ;Month/day
        AND AL,31    ;Mask day
        MOVZX AX,AL
        MOV $d,AX    ;day
     END;
     year:=y;
     month:=m;
     day:=d;
END;

PROCEDURE FindFirst(Path: PathStr; Attr: LongWord; var F: TSearchRec);
VAR hDir:LONGINT;
    count,size:LONGWORD;
    i:TSearchRecIntern;
    t:BYTE;
    s:STRING;
Label l;
BEGIN
     hDir:=-1;  {HDIR_CREATE}
     count:=1;
     size:=sizeof(TSearchRecIntern)-4;
     ASM
        PUSHL 1  ;FIL_STANDARD
        LEA EAX,$count
        PUSH EAX
        PUSHL $size
        LEA EAX,$i
        PUSH EAX
        PUSHL $Attr
        LEA EAX,$hDir
        PUSH EAX
        LEA EAX,$Path
        INC EAX
        PUSH EAX
        MOV AL,7
        CALLDLL DosCalls,264   ;DosFindFirst
        ADD ESP,28
        MOV _DosError,EAX
     END;
     f.HDir:=HDir;
     IF ((DosError<>0)or(Count=0)) THEN
     BEGIN
          IF DosError=0 THEN DosError:=18;
          ASM
             PUSHL $HDir
             MOV AL,1
             CALLDLL DosCalls,263  ;DosFindClose
             ADD ESP,4
          END;
          exit;
     END;
     f.oNextEntryOffset:=i.oNextEntryOffset;
     f.fdateCreation:=i.fdateCreation;
     f.Time:=i.time;
     f.fdateLastAccess:=i.fdateLastAccess;
     f.ftimeLastAccess:=i.fTimeLastAccess;
     f.fdateLastWrite:=i.fdateLastWrite;
     f.ftimeLastWrite:=i.fTimeLastWrite;
     f.Size:=i.size;
     f.cbFileAlloc:=i.cbFileAlloc;
     f.Attr:=i.Attr;
     f.cchName:=i.cchName;
     s:='';
     FOR t:=0 TO 255 DO
     BEGIN
          s[t+1]:=i.Name[t];
          IF s[t+1]=#0 THEN
          BEGIN
               s[0]:=chr(t);
               goto l;
          END;
     END;
l:
     f.Name:=s;
END;

PROCEDURE FindNext(var F: TSearchRec);
VAR HDir:LONGINT;
    Count,size:LONGWORD;
    t:BYTE;
    s:STRING;
    i:TSearchRecIntern;
Label l;
BEGIN
     Count:=1;
     size:=sizeof(TSearchRec)-4;
     HDir:=f.HDir;
     i.oNextEntryOffset:=f.oNextEntryOffset;
     i.fdateCreation:=f.fdateCreation;
     i.Time:=f.time;
     i.fdateLastAccess:=f.fdateLastAccess;
     i.ftimeLastAccess:=f.fTimeLastAccess;
     i.fdateLastWrite:=f.fdateLastWrite;
     i.ftimeLastWrite:=f.fTimeLastWrite;
     i.Size:=f.size;
     i.cbFileAlloc:=f.cbFileAlloc;
     i.Attr:=f.Attr;
     i.cchName:=f.cchName;
     i.HDir:=f.HDir;
     ASM
        LEA EAX,$Count
        PUSH EAX
        PUSHL $size
        LEA EAX,$i
        PUSH EAX
        PUSHL $HDir
        MOV AL,4
        CALLDLL DosCalls,265     ;DosFindNext
        ADD ESP,16
        MOV _DosError,EAX
     END;
     IF ((DosError<>0)or(Count=0)) THEN
     BEGIN
          IF DosError=0 THEN DosError:=18;
          ASM
             PUSHL $HDir
             MOV AL,1
             CALLDLL DosCalls,263  ;DosFindClose
             ADD ESP,4
          END;
          exit;
     END;
     f.oNextEntryOffset:=i.oNextEntryOffset;
     f.fdateCreation:=i.fdateCreation;
     f.Time:=i.time;
     f.fdateLastAccess:=i.fdateLastAccess;
     f.ftimeLastAccess:=i.fTimeLastAccess;
     f.fdateLastWrite:=i.fdateLastWrite;
     f.ftimeLastWrite:=i.fTimeLastWrite;
     f.Size:=i.size;
     f.cbFileAlloc:=i.cbFileAlloc;
     f.Attr:=i.Attr;
     f.cchName:=i.cchName;
     f.HDir:=i.HDir;
     s:='';
     FOR t:=0 TO 255 DO
     BEGIN
          s[t+1]:=i.Name[t];
          IF s[t+1]=#0 THEN
          BEGIN
               s[0]:=chr(t);
               goto l;
          END;
     END;
l:
     f.Name:=s;
END;

PROCEDURE Exec(Path: PathStr; CmdLine: CmdStr;VAR return:ExecResultCode);
VAR
    error:string[128];
BEGIN
     TempCmdLine:=Path+#0+CmdLine+#0;  {Store it cause it may be used later by exec pgm}
     ASM
        LEA EAX,$Path
        INC EAX
        PUSH EAX
        PUSHL $return
        PUSHL 0      ;Environment of parent
        MOV EAX,OFFSET(_TempCmdLine);
        INC EAX
        PUSH EAX    ;Command line parameters
        PUSHL 1     ;EXEC_ASYNC
        PUSHL 127   ;Length of error buffer
        LEA EAX,$error
        INC EAX
        PUSH EAX
        MOV AL,7
        CALLDLL DosCalls,283    ;DosExecPgm
        ADD ESP,28
        MOV _DosError,EAX
     END;
     IF DosError=0 THEN Doserror:=return.CodeResult;
END;


PROCEDURE Delay(ms:LONGWORD);
BEGIN
     ASM
        PUSHL $ms
        MOV AL,1
        CALLDLL DosCalls,229  ;DosSleep
        ADD ESP,4
     END;
END;

PROCEDURE GetFAttr(var F; var Attr: LongWord);
VAR s:_FILESTATUS3;
    size:LONGWORD;
BEGIN
     size:=sizeof(_FILESTATUS3);
     ASM
        PUSHL $size
        LEA EAX,$s
        PUSH EAX
        PUSHL 1   ;File Information level 1 FIL_STANDARD
        MOV EDI,$f
        MOV EAX,[EDI+0]  ;Handle of file
        PUSH EAX
        MOV AL,4
        CALLDLL DosCalls,279    ;DosQueryFileInfo
        ADD ESP,16
        MOV _DosError,EAX
     END;
     IF DosError=0 THEN
     BEGIN
          Attr:=s.attrFile;
     END
     ELSE Attr:=0; {invalid}

END;

PROCEDURE SetFAttr(var F; Attr: LongWord);
VAR s:_FILESTATUS3;
    size:LONGWORD;
BEGIN
     size:=sizeof(_FILESTATUS3);
     ASM
        PUSHL $size
        LEA EAX,$s
        PUSH EAX
        PUSHL 1   ;File Information level 1 FIL_STANDARD
        MOV EDI,$f
        MOV EAX,[EDI+0]  ;Handle of file
        PUSH EAX
        MOV AL,4
        CALLDLL DosCalls,279    ;DosQueryFileInfo
        ADD ESP,16
        MOV _DosError,EAX
     END;
     IF DosError=0 THEN
     BEGIN
          s.attrFile:=Attr;
          ASM
             PUSHL $size
             LEA EAX,$s
             PUSH EAX
             PUSHL 1   ;File Information level 1 FIL_STANDARD
             MOV EDI,$f
             MOV EAX,[EDI+0]  ;Handle of file
             PUSH EAX
             MOV AL,4
             CALLDLL DosCalls,218    ;DosSetFileInfo
             ADD ESP,16
             MOV _DosError,EAX
          END;
     END;
END;


PROCEDURE GetFTime(var F; var year,month,day,Hours,Minutes,TwoSecs:WORD);
VAR s:_FILESTATUS3;
    size:LONGWORD;
    y,m,d,h,min,sec:Word;
    date,time:WORD;
BEGIN
     size:=sizeof(_FILESTATUS3);
     ASM
        PUSHL $size
        LEA EAX,$s
        PUSH EAX
        PUSHL 1   ;File Information level 1 FIL_STANDARD
        MOV EDI,$f
        MOV EAX,[EDI+0]  ;Handle of file
        PUSH EAX
        MOV AL,4
        CALLDLL DosCalls,279    ;DosQueryFileInfo
        ADD ESP,16
        MOV _DosError,EAX
     END;
     IF DosError=0 THEN
     BEGIN
          date:=s.fdateLastWrite;
          time:=s.ftimelastwrite;
          ASM
             PUSHL $date
             PUSHL $year
             PUSHL $month
             PUSHL $day
             CALLN32 _UnPackDate

             PUSHL $time
             PUSHL $hours
             PUSHL $minutes
             PUSHL $TwoSecs
             CALLN32 _UnPackTime
          END;
     END
     ELSE
     BEGIN
          day:=0;
          month:=0;
          year:=0;
          Hours:=0;
          Minutes:=0;
          TwoSecs:=0;
     END;
END;


PROCEDURE SetFTime(var F; year,month,day,Hours,Minutes,TwoSecs:Word);
VAR s:_FILESTATUS3;
    size:LONGWORD;
    time,date:Word;
label l;
BEGIN
     IF ((Month>12)or(Month=0)) THEN
     BEGIN
l:
          DosError:=1;
          exit;
     END;
     IF ((Day>32)or(day=0)) THEN goto l;
     IF Hours>24 THEN goto l;
     IF Minutes>60 THEN goto l;
     IF TwoSecs>30 THEN goto l;
     size:=sizeof(_FILESTATUS3);
     ASM
        PUSHL $size
        LEA EAX,$s
        PUSH EAX
        PUSHL 1   ;File Information level 1 FIL_STANDARD
        MOV EDI,$f
        MOV EAX,[EDI+0]  ;Handle of file
        PUSH EAX
        MOV AL,4
        CALLDLL DosCalls,279    ;DosQueryFileInfo
        ADD ESP,16
        MOV _DosError,EAX
     END;
     IF DosError=0 THEN
     BEGIN
          ASM
             PUSHL $year
             PUSHL $month
             PUSHL $day
             CALLN32 _PackDate
             MOV $Date,AX

             PUSHL $Hours
             PUSHL $Minutes
             PUSHL $twosecs
             CALLN32 _PackTime
             MOV $Time,AX
          END;
          s.fdatelastwrite:=date;
          s.ftimeLastWrite:=time;
          ASM
             PUSHL $size
             LEA EAX,$s
             PUSH EAX
             PUSHL 1   ;File Information level 1 FIL_STANDARD
             MOV EDI,$f
             MOV EAX,[EDI+0]  ;Handle of file
             PUSH EAX
             MOV AL,4
             CALLDLL DosCalls,218    ;DosSetFileInfo
             ADD ESP,16
             MOV _DosError,EAX
          END;
     END;
END;

FUNCTION DiskFree(Drive: Byte): LongWord;
VAR a:_FSALLOCATE;
    s,d:LONGWORD;
    sec:LONGWORD;
BEGIN
     s:=sizeof(_FSALLOCATE);
     d:=Drive;
     ASM
        PUSHL $s
        LEA EAX,$a
        PUSH EAX
        PUSHL 1    ;FSIL_ALLOC -->Query allocation status
        PUSHL $d
        MOV AL,4
        CALLDLL DosCalls,278 ;DosQueryFSInfo
        ADD ESP,16
        MOV _DosError,EAX
     END;
     IF DosError=0 THEN
     BEGIN
          s:=a.cSectorUnit*a.cUnitAvail*a.cbSector;
     END
     ELSE s:=0;
     DiskFree:=s;
END;

FUNCTION DiskSize(Drive: Byte): LongWord;
VAR a:_FSALLOCATE;
    s,d:LONGWORD;
BEGIN
     s:=sizeof(_FSALLOCATE);
     d:=Drive;
     ASM
        PUSHL $s
        LEA EAX,$a
        PUSH EAX
        PUSHL 1    ;FSIL_ALLOC -->Query allocation status
        PUSHL $d
        MOV AL,4
        CALLDLL DosCalls,278 ;DosQueryFSInfo
        ADD ESP,16
        MOV _DosError,EAX
     END;
     IF DosError=0 THEN
     BEGIN
          s:=a.cSectorUnit*a.cUnit*a.cbSector;
     END
     ELSE s:=0;
     DiskSize:=s;
END;

FUNCTION EnvStr(Env:String): PEnvString;
VAR
   e:POINTER;
BEGIN
     ASM
        LEA EAX,$e
        PUSH EAX
        LEA EAX,$Env
        INC EAX
        PUSH EAX
        MOV AL,2
        CALLDLL DosCalls,227    ;DosScanEnv
        ADD ESP,8
        MOV ECX,0
        MOV _DosError,EAX
        CMP EAX,0
        JNE !scloope             ;EnvVar not found
        MOV ECX,$e
!scloope:
        MOV $e,ECX  ;Set string length
     END;
     EnvStr:=e;
END;

PROCEDURE GetVerify(var Verify: Boolean);ASM;
BEGIN
     ASM
        PUSH EBP
        MOV EBP,ESP
        SUB ESP,4   ;Return value
        LEA EAX,[EBP-4]
        PUSH EAX
        MOV AL,1
        CALLDLL DosCalls,225    ;DosQueryverify
        ADD ESP,4
        MOV AL,[EBP-4]
        MOV EDI,$Verify
        MOV [EDI+0],AL
        LEAVE
        RETN32
     END;
END;

PROCEDURE SetVerify(Verify: Boolean);ASM;
BEGIN
     ASM
        PUSH EBP
        MOV EBP,ESP
        MOV AL,$verify
        MOVZX EAX,AL
        PUSH EAX
        MOV AL,1
        CALLDLL DosCalls,210   ;DosSetVerify
        ADD ESP,4
        LEAVE
        RETN32
     END;
END;

FUNCTION DosVersion:Word;ASM;
BEGIN
     ASM
        PUSH EBP
        MOV EBP,ESP
        SUB ESP,8               ;for result values
        PUSHL 4                 ;size of buffer
        LEA EAX,[EBP-8]
        PUSH EAX                ;Buffer
        PUSHL 11                ;last:QSV_VERSION_MAJOR
        PUSHL 11                ;first:QSV_VERSION_MAJOR
        MOV AL,4
        CALLDLL DosCalls,348    ;DosQuerySysInfo
        ADD ESP,16
        PUSHL 4                 ;size of buffer
        LEA EAX,[EBP-4]
        PUSH EAX                ;Buffer
        PUSHL 12                ;last:QSV_VERSION_MINOR
        PUSHL 12                ;first:QSV_VERSION_MINOR
        MOV AL,4
        CALLDLL DosCalls,348    ;DosQuerySysInfo
        ADD ESP,16
        MOV AL,[EBP-8]          ;Major version number
        MOV AH,[EBP-4]          ;Minor version number
        LEAVE
        RETN32
     END;
END;

PROCEDURE GetDate(var Year,Month,Day,DayOfWeek: Word);
VAR d:_DateTime;
BEGIN
     ASM
        LEA EAX,$d
        PUSH EAX
        MOV AL,1
        CALLDLL DosCalls,230  ;DosGetDateTime
        ADD ESP,4
     END;
     Year:=d.year;
     Month:=d.month;
     Day:=d.Day;
     DayofWeek:=d.Weekday;
END;

PROCEDURE SetDate(Year,Month,Day,DayOfWeek: Word);
VAR d:_DateTime;
BEGIN
     ASM
        LEA EAX,$d
        PUSH EAX
        MOV AL,1
        CALLDLL DosCalls,230  ;DosGetDateTime
        ADD ESP,4
     END;
     d.year:=Year;
     d.month:=Month;
     d.day:=day;
     d.Weekday:=DayOfWeek;
     ASM
        LEA EAX,$d
        PUSH EAX
        MOV AL,1
        CALLDLL DosCalls,292 ;DosSetDateTime
        ADD ESP,4
     END;
END;

PROCEDURE GetTime(var Hour,Minute,Second,Sec100: Word);
VAR d:_DateTime;
BEGIN
     ASM
        LEA EAX,$d
        PUSH EAX
        MOV AL,1
        CALLDLL DosCalls,230  ;DosGetDateTime
        ADD ESP,4
     END;
     Hour:=d.hours;
     Minute:=d.minutes;
     Second:=d.Seconds;
     Sec100:=d.Hundredths;
END;

PROCEDURE SetTime(Hour,Minute,Second,Sec100: Word);ASM;
VAR d:_DateTime;
BEGIN
     ASM
        LEA EAX,$d
        PUSH EAX
        MOV AL,1
        CALLDLL DosCalls,230  ;DosGetDateTime
        ADD ESP,4
     END;
     d.Hours:=Hour;
     d.Minutes:=Minute;
     d.Seconds:=Second;
     d.Hundredths:=Sec100;
     ASM
        LEA EAX,$d
        PUSH EAX
        MOV AL,1
        CALLDLL DosCalls,292 ;DosSetDateTime
        ADD ESP,4
     END;
END;

FUNCTION CompareFileTimes(First,Second:STRING):BYTE;
VAR f1,f2:FILE;
    result:BYTE;
    year1,month1,day1,Hours1,Minutes1,TwoSecs1:WORD;
    year2,month2,day2,Hours2,Minutes2,TwoSecs2:WORD;
Label l;
BEGIN
     result:=F_ERROR;
     assign(f1,first);
     reset(f1,1);
     IF ioresult<>0 THEN goto l;
     GetFTime(f1,year1,month1,day1,Hours1,Minutes1,TwoSecs1);
     IF DosError<>0 THEN
     BEGIN
          Close(f1);
          goto l;
     END;
     Close(f1);

     assign(f2,second);
     reset(f2,1);
     IF ioresult<>0 THEN goto l;
     GetFTime(f2,year2,month2,day2,Hours2,Minutes2,TwoSecs2);
     IF DosError<>0 THEN
     BEGIN
          Close(f2);
          goto l;
     END;
     Close(f2);

     IF year1=year2 THEN
     BEGIN
          IF month1=month2 THEN
          BEGIN
               IF Day1=Day2 THEN
               BEGIN
                    IF Hours1=Hours2 THEN
                    BEGIN
                         IF Minutes1=Minutes2 THEN
                         BEGIN
                              IF TwoSecs1=TwoSecs2 THEN result:=F_EQUAL
                              ELSE
                              BEGIN
                                   IF TwoSecs1>TwoSecs2 THEN Result:=F_FIRST_GREATER
                                   ELSE Result:=F_SECOND_GREATER;
                              END;
                         END
                         ELSE
                         BEGIN
                              IF Minutes1>Minutes2 THEN Result:=F_FIRST_GREATER
                              ELSE Result:=F_SECOND_GREATER;
                         END;
                    END
                    ELSE
                    BEGIN
                         IF Hours1>Hours2 THEN Result:=F_FIRST_GREATER
                         ELSE Result:=F_SECOND_GREATER;
                    END;
               END
               ELSE
               BEGIN
                    IF day1>day2 THEN Result:=F_FIRST_GREATER
                    ELSE Result:=F_SECOND_GREATER;
               END;
          END
          ELSE
          BEGIN
               IF month1>month2 THEN Result:=F_FIRST_GREATER
               ELSE Result:=F_SECOND_GREATER;
          END;
     END
     ELSE
     BEGIN
          IF year1>year2 THEN Result:=F_FIRST_GREATER
          ELSE Result:=F_SECOND_GREATER;
     END;

l:
     CompareFileTimes:=Result;
END;

BEGIN
END.