home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
tpdoskermit.tar.gz
/
tpdoskermit.tar
/
mydos.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-04-18
|
17KB
|
546 lines
$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.