$R-,S-

Unit MyDos;

Interface

CONST
  IO_CTRL = $4000;
  IO_ISDEV  = $80;
  IO_EOF    = $40;
  IO_BINARY = $20;
  IO_ISCLK  =   8;
  IO_ISNUL  =   4;
  IO_ISCOT  =   2;
  IO_ISCIN  =   1;

  StdIn     =   0;
  StdOut    =   1;
  StdErr    =   2;
  StdLst    =   3;
  StdAux    =   4;

TYPE DiskInfo = RECORD
       Avail_Clu, Total_Clu, BytPrSec, SecPrClu : WORD;
     END;
const
  { Flags bit masks }
  FCarry     = $0001;
  FParity    = $0004;
  FAuxiliary = $0010;
  FZero      = $0040;
  FSign      = $0080;
  FOverflow  = $0800;

  { File attribute constants }
  ReadOnly  = $01;
  Hidden    = $02;
  SysFile   = $04;
  VolumeID  = $08;
  Directory = $10;
  Archive   = $20;
  AnyFile   = $3F;

type
  { Search record used by FindFirst and FindNext }
  SearchRec = record
                Fill: array[1..21] of Byte;
                Attr: Byte;
                Time: Longint;
                Size: Longint;
                Name: string[12];
              end;

  { Date and time record used by PackTime and UnpackTime }
  DateTime = record
               Year,Month,Day,Hour,Min,Sec: Word;
             end;
  String4 = String[4];

VAR DosError : WORD;

procedure GetFAttr(var F; var Attr: Word);
procedure SetFAttr(var F; Attr: Word);
procedure UnpackTime(P: Longint; var T: DateTime);
procedure PackTime(var T: DateTime; var P: Longint);
PROCEDURE ExecEnv(Path,CmdLine: String; environ : Pointer);

PROCEDURE GetTime(VAR hour, min, sec, s100 : WORD);
PROCEDURE GetDate(VAR year, month, day, dow : WORD);
PROCEDURE SetTime(hour, min, sec, s100 : WORD);
PROCEDURE SetDate(year, month, day : WORD);
PROCEDURE GetIntVec(nr : BYTE; VAR p : Pointer);
PROCEDURE SetIntVec(nr : BYTE; p : Pointer);
PROCEDURE FindFirst(path : String; attr : WORD; VAR dta : SearchRec);
PROCEDURE FindNext(VAR dta: SearchRec);
PROCEDURE GetFTime(VAR fil; VAR time : LongInt);
PROCEDURE SetFTime(VAR fil; time : LongInt);
FUNCTION  GetDevStat(handle : WORD) : WORD;
PROCEDURE GetDiskInfo(drive : WORD; VAR dinfo : DiskInfo);

FUNCTION DosVersion: WORD;
PROCEDURE Exec(Path,CmdLine: String);
FUNCTION FindEnv(find : String) : String;

PROCEDURE PutString(st : String);
FUNCTION Hex(w : Word): String4;
PROCEDURE ShrinkHeap;
PROCEDURE Move(VAR fra, til; bytes : WORD);

Implementation

PROCEDURE Move(VAR fra, til; bytes : WORD); {Erstatter SYSTEM:MOVE}
BEGIN
Inline(
  $1E                    {  push ds                ;}
  /$C5/$76/<FRA          {  lds si,<fra[bp]        ;}
  /$C4/$7E/<TIL          {  les di,<til[bp]        ;}
  /$FC                   {  cld                    ;}
  /$8B/$4E/<BYTES        {  mov cx,<bytes[bp]      ;}
  /$E3/$38               {  jcxz done              ;}
  /$39/$FE               {  cmp si,di              ;}
  /$77/$21               {    ja moveup            ;}
  /$FD                   {  std                    ;}
  /$89/$C8               {  mov ax,cx              ;}
  /$48                   {  dec ax                 ;}
  /$01/$C6               {  add si,ax              ;}
  /$01/$C7               {  add di,ax              ;}
  /$F7/$C6/$01/$00       {  test si,1              ;}
  /$75/$02               {    jnz dnw              ;}
  /$A4                   {  movsb                  ;}
  /$49                   {  dec cx                 ;}
                         {dnw:                     ;}
  /$4E                   {  dec si                 ;}
  /$4F                   {  dec di                 ;}
  /$D1/$E9               {  shr cx,1               ;}
  /$9F                   {  lahf                   ;}
  /$E3/$02               {    jcxz dnwd            ;}
  /$F2/$A5               {  rep movsw              ;}
  /$9E                   {dnwd: sahf               ;}
  /$73/$18               {    jnc done             ;}
  /$46                   {  inc si                 ;}
  /$47                   {  inc di                 ;}
  /$A4                   {  movsb                  ;}
  /$EB/$13               {    jmp short done       ;}
  /$F7/$C6/$01/$00       {moveup: test si,1        ;}
  /$74/$02               {    jz upw               ;}
  /$A4                   {  movsb                  ;}
  /$49                   {  dec cx                 ;}
  /$D1/$E9               {upw: shr cx,1            ;}
  /$9F                   {  lahf                   ;}
  /$E3/$02               {    jcxz upwd            ;}
  /$F2/$A5               {  rep movsw              ;}
  /$9E                   {upwd: sahf               ;}
  /$73/$01               {    jnc done             ;}
  /$A4                   {  movsb                  ;}
  /$1F                   {done: pop ds             ;}
);
END;                                   {Move}

FUNCTION DosVersion: WORD;
BEGIN
Inline(
  $B4/$30                {mov ah,$30}
  /$CD/$21               {int $21}
  /$86/$E0               {xchg al,ah}
  /$89/$46/$FE           {mov [bp-2],ax}
);
END;

PROCEDURE ShrinkHeap;
BEGIN
Inline(
  $8B/$1E/>HEAPPTR       {mov bx,[>HeapPtr]}
  /$81/$C3/$0F/$00       {add bx,15}
  /$B1/$04               {mov cl,4}
  /$D3/$EB               {shr bx,cl}
  /$03/$1E/>HEAPPTR+2    {add bx,[>HeapPtr+2]}
  /$89/$D8               {mov ax,bx}
  /$2D/$00/$10           {sub ax,$1000}
  /$A3/>FREEPTR+2        {mov [>FreePtr+2],ax}
  /$31/$C0               {xor ax,ax}
  /$A3/>FREEPTR          {mov [>FreePtr],ax}
  /$B4/$4A               {mov ah,$4A}
  /$8E/$06/>PREFIXSEG    {mov es,[>PrefixSeg]}
  /$2B/$1E/>PREFIXSEG    {sub bx,[>PrefixSeg]}
  /$CD/$21               {int $21}
);
END;

FUNCTION Hex(w : Word): String4;
CONST HexCh : ARRAY [0..15] OF CHAR = '0123456789ABCDEF';
VAR   h : String4;
BEGIN
  h[0] := #4;
  h[1] := HexCh[Hi(w) Shr 4];
  h[2] := HexCh[Hi(w) AND 15];
  h[3] := HexCh[Lo(w) Shr 4];
  h[4] := HexCh[Lo(w) AND 15];
  Hex := h;
END;

PROCEDURE SetTime(hour, min, sec, s100 : WORD);
BEGIN
Inline(
  $8A/$56/<S100          {mov dl,[bp+<s100]}
  /$8A/$76/<SEC          {mov dh,[bp+<sec]}
  /$8A/$4E/<MIN          {mov cl,[bp+<min]}
  /$8A/$6E/<HOUR         {mov ch,[bp+<hour]}
  /$B4/$2D               {mov ah,$2D}
  /$CD/$21               {int $21}
);
END;

PROCEDURE SetDate(year, month, day : WORD);
BEGIN
Inline(
  $8B/$4E/<YEAR          {mov cx,[bp+<year]}
  /$8A/$76/<MONTH        {mov dh,[bp+<month]}
  /$8A/$56/<DAY          {mov dl,[bp+<day]}
  /$B4/$2B               {mov ah,$2B}
  /$CD/$21               {int $21}
);
END;

PROCEDURE PutString(st : String);
BEGIN
Inline(
  $B4/$40                {mov ah,$40}
  /$BB/$01/$00           {mov bx,1}
  /$8A/$8E/>ST           {mov cl,[bp+>st]}
  /$30/$ED               {xor ch,ch}
  /$8D/$96/>ST+1         {lea dx,[bp+>st+1]}
  /$1E                   {push ds}
  /$16                   {push ss}
  /$1F                   {pop ds}
  /$CD/$21               {int $21}
  /$1F                   {pop ds}
);
END;

PROCEDURE UnpackTime(P: Longint; var T: DateTime);
BEGIN
Inline(
  $8B/$56/<P+2           {mov dx,[bp+<p+2]}
  /$C4/$7E/<T            {les di,[bp+<t]}
  /$FC                   {cld}
  /$B9/$09/$00           {mov cx,9}
  /$89/$D0               {mov ax,dx}
  /$D3/$E8               {shr ax,cl}
  /$05/$BC/$07           {add ax,1980}
  /$AB                   {stosw}
  /$B1/$05               {mov cl,5}
  /$89/$D0               {mov ax,dx}
  /$D3/$E8               {shr ax,cl}
  /$25/$0F/$00           {and ax,15}
  /$AB                   {stosw}
  /$89/$D0               {mov ax,dx}
  /$25/$1F/$00           {and ax,31}
  /$AB                   {stosw}
  /$8B/$56/<P            {mov dx,[bp+<p]}
  /$89/$D0               {mov ax,dx}
  /$B1/$0B               {mov cl,11}
  /$D3/$E8               {shr ax,cl}
  /$AB                   {stosw}
  /$89/$D0               {mov ax,dx}
  /$B1/$05               {mov cl,5}
  /$D3/$E8               {shr ax,cl}
  /$25/$3F/$00           {and ax,63}
  /$AB                   {stosw}
  /$89/$D0               {mov ax,dx}
  /$D1/$E0               {shl ax,1}
  /$25/$3F/$00           {and ax,63}
  /$AB                   {stosw}
);
END;

PROCEDURE PackTime(VAR T : DateTime; VAR P: LongInt);
BEGIN
Inline(
  $1E                    {push ds}
  /$C5/$76/<T            {lds si,[bp+<T]}
  /$FC                   {cld}
  /$C4/$7E/<P            {les di,[bp+<P]}
  /$AD                   {lodsw                      ; year}
  /$2D/$BC/$07           {sub ax,1980}
  /$B9/$09/$00           {mov cx,9}
  /$D3/$E0               {shl ax,cl}
  /$89/$C2               {mov dx,ax}
  /$AD                   {lodsw                      ; month}
  /$B1/$05               {mov cl,5}
  /$D3/$E0               {shl ax,cl}
  /$01/$C2               {add dx,ax}
  /$AD                   {lodsw                      ; day}
  /$01/$D0               {add ax,dx}
  /$26/$89/$45/$02       {es: mov [di+2],ax}
  /$AD                   {lodsw                      ; hour}
  /$B1/$0B               {mov cl,11}
  /$D3/$E0               {shl ax,cl}
  /$89/$C2               {mov dx,ax}
  /$AD                   {lodsw                      ; min}
  /$B1/$05               {mov cl,5}
  /$D3/$E0               {shl ax,cl}
  /$01/$C2               {add dx,ax}
  /$AD                   {lodsw                      ; sec}
  /$D1/$E8               {shr ax,1}
  /$01/$D0               {add ax,dx}
  /$AB                   {stosw}
);
END;

PROCEDURE ExecEnv(Path,CmdLine: String; environ : Pointer); EXTERNAL;
$L ExecEnv.obj

PROCEDURE Exec(Path,CmdLine: String);
BEGIN
  ExecEnv(Path,CmdLine,NIL);
END;

PROCEDURE SetFAttr(var F; Attr: Word);
BEGIN
Inline(
  $B8/$01/$43            {mov ax,$4301}
  /$1E                   {push ds}
  /$C5/$56/<F            {lds dx,[bp+<f]}
  /$81/$C2/$30/$00       {add dx,48}
  /$8B/$4F/<ATTR         {mov cx,[bx+<attr]}
  /$CD/$21               {int $21}
  /$1F                   {pop ds}
  /$72/$02               {jc g1}
  /$31/$C0               {xor ax,ax}
                         {g1:}
  /$A3/>DOSERROR         {mov [>DosError],ax}
);
END;                                   {SetFAttr}

PROCEDURE GetFAttr(var F; var Attr: Word);
BEGIN
Inline(
  $B8/$00/$43            {mov ax,$4300}
  /$1E                   {push ds}
  /$C5/$56/<F            {lds dx,[bp+<f]}
  /$81/$C2/$30/$00       {add dx,48}
  /$CD/$21               {int $21}
  /$1F                   {pop ds}
  /$72/$02               {jc g1}
  /$31/$C0               {xor ax,ax}
                         {g1:}
  /$A3/>DOSERROR         {mov [>DosError],ax}
  /$C4/$5E/<ATTR         {les bx,[bp+<attr]}
  /$26/$89/$0F           {es: mov [bx],cx}
);
END;                                   {GetFAttr}

PROCEDURE GetDiskInfo(drive : WORD; VAR dinfo : DiskInfo);
BEGIN
Inline(
  $B4/$36                {mov ah,$36}
  /$8A/$56/<DRIVE        {mov dl,[bp+<drive]}
  /$CD/$21               {int $21}
  /$C4/$7E/<DINFO        {les di,[bp+<dinfo]}
  /$26/$89/$1D           {es: mov [di],bx}
  /$26/$89/$55/$02       {es: mov [di+2],dx}
  /$26/$89/$4D/$04       {es: mov [di+4],cx}
  /$26/$89/$45/$06       {es: mov [di+6],ax}
);
END;                                   {GetDiskInfo}

FUNCTION  GetDevStat(handle : WORD) : WORD;
BEGIN
Inline(
  $B8/$00/$44            {mov ax,$4400}
  /$8B/$5E/<HANDLE       {mov bx,[bp+<handle]}
  /$CD/$21               {int $21}
  /$72/$02               {jc g1}
  /$31/$C0               {xor ax,ax}
                         {g1:}
  /$A3/>DOSERROR         {mov [>DosError],ax}
  /$89/$56/$FE           {mov [bp-2],dx}
);
END;                                   {GetDevStat}

PROCEDURE GetTime(VAR hour, min, sec, s100 : WORD);
BEGIN
Inline(
  $B4/$2C                {mov ah,$2C}
  /$CD/$21               {int $21}
  /$31/$C0               {xor ax,ax}
  /$C4/$5E/<HOUR         {les bx,[bp+<hour]}
  /$88/$E8               {mov al,ch}
  /$26/$89/$07           {es: mov [bx],ax}
  /$C4/$5E/<MIN          {les bx,[bp+<min]}
  /$88/$C8               {mov al,cl}
  /$26/$89/$07           {es: mov [bx],ax}
  /$C4/$5E/<SEC          {les bx,[bp+<sec]}
  /$88/$F0               {mov al,dh}
  /$26/$89/$07           {es: mov [bx],ax}
  /$C4/$5E/<S100         {les bx,[bp+<s100]}
  /$88/$D0               {mov al,dl}
  /$26/$89/$07           {es: mov [bx],ax}
);
END;                                   {GetTime}

PROCEDURE GetDate(VAR year, month, day, dow : WORD);
BEGIN
Inline(
  $B4/$2A                {mov ah,$2A}
  /$CD/$21               {int $21}
  /$30/$E4               {xor ah,ah}
  /$C4/$5E/<DOW          {les bx,[bp+<dow]}
  /$26/$89/$07           {es: mov [bx],ax}
  /$C4/$5E/<YEAR         {les bx,[bp+<year]}
  /$26/$89/$0F           {es: mov [bx],cx}
  /$C4/$5E/<MONTH        {les bx,[bp+<month]}
  /$88/$F0               {mov al,dh}
  /$26/$89/$07           {es: mov [bx],ax}
  /$C4/$5E/<DAY          {les bx,[bp+<day]}
  /$88/$D0               {mov al,dl}
  /$26/$89/$07           {es: mov [bx],ax}
);
END;                                   {GetDate}

VAR IntVectorTable : ARRAY [BYTE] OF Pointer ABSOLUTE 0:0;

PROCEDURE GetIntVec(nr : BYTE; VAR p : Pointer);
BEGIN
  p := IntVectorTable[nr];
END;

PROCEDURE SetIntVec(nr : BYTE; p : Pointer);
BEGIN
  InLine($FA);
  IntVectorTable[nr] := p;
  InLine($FB);
END;

PROCEDURE FindFirst(path : String; attr : WORD; VAR dta : SearchRec);
BEGIN
Inline(
  $1E                    {push ds}
  /$C5/$56/<DTA          {lds dx,[bp+<dta]}
  /$B4/$1A               {mov ah,$1A}
  /$CD/$21               {int $21}
  /$16                   {push ss}
  /$1F                   {pop ds}
  /$8D/$96/>PATH         {lea dx,[bp+>path]}
  /$89/$D3               {mov bx,dx}
  /$42                   {inc dx}
  /$8A/$1F               {mov bl,[bx]}
  /$30/$FF               {xor bh,bh}
  /$01/$D3               {add bx,dx}
  /$C6/$07/$00           {mov byte ptr [bx],0}
  /$8B/$4E/<ATTR         {mov cx,[bp+<attr]}
  /$B4/$4E               {mov ah,$4E}
  /$CD/$21               {int $21}
  /$72/$22               {jc done}
  /$C4/$7E/<DTA          {les di,[bp+<dta]}
  /$8E/$5E/<DTA+2        {mov ds,[bp+<dta+2]}
  /$81/$C7/$1E/$00       {add di,30}
  /$30/$C0               {xor al,al}
  /$FC                   {cld}
  /$B9/$FF/$FF           {mov cx,-1}
  /$F2/$AE               {repne scasb}
  /$F7/$D1               {not cx}
  /$49                   {dec cx}
  /$4F                   {dec di}
  /$8D/$75/$FF           {lea si,[di-1]}
  /$FD                   {std}
  /$88/$C8               {mov al,cl}
  /$F2/$A4               {rep movsb}
  /$88/$05               {mov [di],al}
  /$31/$C0               {xor ax,ax}
                         {done:}
  /$1F                   {pop ds}
  /$A3/>DOSERROR         {mov [>DosError],ax}
);
END;                                   {FindFirst}

PROCEDURE FindNext(VAR dta: SearchRec);
BEGIN
Inline(
  $1E                    {push ds}
  /$C5/$56/<DTA          {lds dx,[bp+<dta]}
  /$B4/$1A               {mov ah,$1A}
  /$CD/$21               {int $21}
  /$B4/$4F               {mov ah,$4F}
  /$CD/$21               {int $21}
  /$72/$22               {jc done}
  /$C4/$7E/<DTA          {les di,[bp+<dta]}
  /$8E/$5E/<DTA+2        {mov ds,[bp+<dta+2]}
  /$81/$C7/$1E/$00       {add di,30}
  /$30/$C0               {xor al,al}
  /$FC                   {cld}
  /$B9/$FF/$FF           {mov cx,-1}
  /$F2/$AE               {repne scasb}
  /$F7/$D1               {not cx}
  /$49                   {dec cx}
  /$4F                   {dec di}
  /$8D/$75/$FF           {lea si,[di-1]}
  /$FD                   {std}
  /$88/$C8               {mov al,cl}
  /$F2/$A4               {rep movsb}
  /$88/$05               {mov [di],al}
  /$31/$C0               {xor ax,ax}
                         {done:}
  /$1F                   {pop ds}
  /$A3/>DOSERROR         {mov [>DosError],ax}
);
END;                                   {FindNext}

PROCEDURE GetFTime(VAR fil; VAR time : LongInt);
BEGIN
Inline(
  $B8/$00/$57            {mov ax,$5700}
  /$C4/$5E/<FIL          {les bx,[bp+<fil]}
  /$26/$8B/$1F           {es: mov bx,[bx]}
  /$CD/$21               {int $21}
  /$72/$0C               {jc done}
  /$C4/$5E/<TIME         {les bx,[bp+<time]}
  /$26/$89/$0F           {es: mov [bx],cx}
  /$26/$89/$57/$02       {es: mov [bx+2],dx}
  /$31/$C0               {xor ax,ax}
                         {done:}
  /$A3/>DOSERROR         {mov [>DosError],ax}
);
END;                                   {GetFTime}

PROCEDURE SetFTime(VAR fil; time : LongInt);
BEGIN
Inline(
  $B8/$01/$57            {mov ax,$5701}
  /$C4/$5E/<FIL          {les bx,[bp+<fil]}
  /$26/$8B/$1F           {es: mov bx,[bx]}
  /$8B/$4E/<TIME         {mov cx,[bp+<time]}
  /$8B/$56/<TIME+2       {mov dx,[bp+<time+2]}
  /$CD/$21               {int $21}
  /$72/$02               {jc done}
  /$31/$C0               {xor ax,ax}
                         {done:}
  /$A3/>DOSERROR         {mov [>DosError],ax}
);
END;                                   {SetFTime}

FUNCTION FindEnv(find : String) : String;
VAR st : String;
    cp : ^CHAR;
BEGIN
  cp := Ptr(MemW[PrefixSeg:$2C],0);
  WHILE cp^ <> #0 DO BEGIN
    st := '';
    WHILE cp^ <> #0 DO BEGIN
      Inc(st[0]);
      st[Length(st)] := cp^;
      Inc(WORD(cp));
    END;
    IF Copy(st,1,Length(find)) = find THEN BEGIN
      Delete(st,1,Length(find));
      FindEnv := st;
      Exit;
    END;
    Inc(WORD(cp));
  END;
  FindEnv := '';
END;

END.