home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / pub / tpdoskermit / mydos.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2020-01-01  |  16.7 KB  |  546 lines
  1. $R-,S-
  2.  
  3. Unit MyDos;
  4.  
  5. Interface
  6.  
  7. CONST
  8.   IO_CTRL = $4000;
  9.   IO_ISDEV  = $80;
  10.   IO_EOF    = $40;
  11.   IO_BINARY = $20;
  12.   IO_ISCLK  =   8;
  13.   IO_ISNUL  =   4;
  14.   IO_ISCOT  =   2;
  15.   IO_ISCIN  =   1;
  16.  
  17.   StdIn     =   0;
  18.   StdOut    =   1;
  19.   StdErr    =   2;
  20.   StdLst    =   3;
  21.   StdAux    =   4;
  22.  
  23. TYPE DiskInfo = RECORD
  24.        Avail_Clu, Total_Clu, BytPrSec, SecPrClu : WORD;
  25.      END;
  26. const
  27.   { Flags bit masks }
  28.   FCarry     = $0001;
  29.   FParity    = $0004;
  30.   FAuxiliary = $0010;
  31.   FZero      = $0040;
  32.   FSign      = $0080;
  33.   FOverflow  = $0800;
  34.  
  35.   { File attribute constants }
  36.   ReadOnly  = $01;
  37.   Hidden    = $02;
  38.   SysFile   = $04;
  39.   VolumeID  = $08;
  40.   Directory = $10;
  41.   Archive   = $20;
  42.   AnyFile   = $3F;
  43.  
  44. type
  45.   { Search record used by FindFirst and FindNext }
  46.   SearchRec = record
  47.                 Fill: array[1..21] of Byte;
  48.                 Attr: Byte;
  49.                 Time: Longint;
  50.                 Size: Longint;
  51.                 Name: string[12];
  52.               end;
  53.  
  54.   { Date and time record used by PackTime and UnpackTime }
  55.   DateTime = record
  56.                Year,Month,Day,Hour,Min,Sec: Word;
  57.              end;
  58.   String4 = String[4];
  59.  
  60. VAR DosError : WORD;
  61.  
  62. procedure GetFAttr(var F; var Attr: Word);
  63. procedure SetFAttr(var F; Attr: Word);
  64. procedure UnpackTime(P: Longint; var T: DateTime);
  65. procedure PackTime(var T: DateTime; var P: Longint);
  66. PROCEDURE ExecEnv(Path,CmdLine: String; environ : Pointer);
  67.  
  68. PROCEDURE GetTime(VAR hour, min, sec, s100 : WORD);
  69. PROCEDURE GetDate(VAR year, month, day, dow : WORD);
  70. PROCEDURE SetTime(hour, min, sec, s100 : WORD);
  71. PROCEDURE SetDate(year, month, day : WORD);
  72. PROCEDURE GetIntVec(nr : BYTE; VAR p : Pointer);
  73. PROCEDURE SetIntVec(nr : BYTE; p : Pointer);
  74. PROCEDURE FindFirst(path : String; attr : WORD; VAR dta : SearchRec);
  75. PROCEDURE FindNext(VAR dta: SearchRec);
  76. PROCEDURE GetFTime(VAR fil; VAR time : LongInt);
  77. PROCEDURE SetFTime(VAR fil; time : LongInt);
  78. FUNCTION  GetDevStat(handle : WORD) : WORD;
  79. PROCEDURE GetDiskInfo(drive : WORD; VAR dinfo : DiskInfo);
  80.  
  81. FUNCTION DosVersion: WORD;
  82. PROCEDURE Exec(Path,CmdLine: String);
  83. FUNCTION FindEnv(find : String) : String;
  84.  
  85. PROCEDURE PutString(st : String);
  86. FUNCTION Hex(w : Word): String4;
  87. PROCEDURE ShrinkHeap;
  88. PROCEDURE Move(VAR fra, til; bytes : WORD);
  89.  
  90. Implementation
  91.  
  92. PROCEDURE Move(VAR fra, til; bytes : WORD); {Erstatter SYSTEM:MOVE}
  93. BEGIN
  94. Inline(
  95.   $1E                    {  push ds                ;}
  96.   /$C5/$76/<FRA          {  lds si,<fra[bp]        ;}
  97.   /$C4/$7E/<TIL          {  les di,<til[bp]        ;}
  98.   /$FC                   {  cld                    ;}
  99.   /$8B/$4E/<BYTES        {  mov cx,<bytes[bp]      ;}
  100.   /$E3/$38               {  jcxz done              ;}
  101.   /$39/$FE               {  cmp si,di              ;}
  102.   /$77/$21               {    ja moveup            ;}
  103.   /$FD                   {  std                    ;}
  104.   /$89/$C8               {  mov ax,cx              ;}
  105.   /$48                   {  dec ax                 ;}
  106.   /$01/$C6               {  add si,ax              ;}
  107.   /$01/$C7               {  add di,ax              ;}
  108.   /$F7/$C6/$01/$00       {  test si,1              ;}
  109.   /$75/$02               {    jnz dnw              ;}
  110.   /$A4                   {  movsb                  ;}
  111.   /$49                   {  dec cx                 ;}
  112.                          {dnw:                     ;}
  113.   /$4E                   {  dec si                 ;}
  114.   /$4F                   {  dec di                 ;}
  115.   /$D1/$E9               {  shr cx,1               ;}
  116.   /$9F                   {  lahf                   ;}
  117.   /$E3/$02               {    jcxz dnwd            ;}
  118.   /$F2/$A5               {  rep movsw              ;}
  119.   /$9E                   {dnwd: sahf               ;}
  120.   /$73/$18               {    jnc done             ;}
  121.   /$46                   {  inc si                 ;}
  122.   /$47                   {  inc di                 ;}
  123.   /$A4                   {  movsb                  ;}
  124.   /$EB/$13               {    jmp short done       ;}
  125.   /$F7/$C6/$01/$00       {moveup: test si,1        ;}
  126.   /$74/$02               {    jz upw               ;}
  127.   /$A4                   {  movsb                  ;}
  128.   /$49                   {  dec cx                 ;}
  129.   /$D1/$E9               {upw: shr cx,1            ;}
  130.   /$9F                   {  lahf                   ;}
  131.   /$E3/$02               {    jcxz upwd            ;}
  132.   /$F2/$A5               {  rep movsw              ;}
  133.   /$9E                   {upwd: sahf               ;}
  134.   /$73/$01               {    jnc done             ;}
  135.   /$A4                   {  movsb                  ;}
  136.   /$1F                   {done: pop ds             ;}
  137. );
  138. END;                                   {Move}
  139.  
  140. FUNCTION DosVersion: WORD;
  141. BEGIN
  142. Inline(
  143.   $B4/$30                {mov ah,$30}
  144.   /$CD/$21               {int $21}
  145.   /$86/$E0               {xchg al,ah}
  146.   /$89/$46/$FE           {mov [bp-2],ax}
  147. );
  148. END;
  149.  
  150. PROCEDURE ShrinkHeap;
  151. BEGIN
  152. Inline(
  153.   $8B/$1E/>HEAPPTR       {mov bx,[>HeapPtr]}
  154.   /$81/$C3/$0F/$00       {add bx,15}
  155.   /$B1/$04               {mov cl,4}
  156.   /$D3/$EB               {shr bx,cl}
  157.   /$03/$1E/>HEAPPTR+2    {add bx,[>HeapPtr+2]}
  158.   /$89/$D8               {mov ax,bx}
  159.   /$2D/$00/$10           {sub ax,$1000}
  160.   /$A3/>FREEPTR+2        {mov [>FreePtr+2],ax}
  161.   /$31/$C0               {xor ax,ax}
  162.   /$A3/>FREEPTR          {mov [>FreePtr],ax}
  163.   /$B4/$4A               {mov ah,$4A}
  164.   /$8E/$06/>PREFIXSEG    {mov es,[>PrefixSeg]}
  165.   /$2B/$1E/>PREFIXSEG    {sub bx,[>PrefixSeg]}
  166.   /$CD/$21               {int $21}
  167. );
  168. END;
  169.  
  170. FUNCTION Hex(w : Word): String4;
  171. CONST HexCh : ARRAY [0..15] OF CHAR = '0123456789ABCDEF';
  172. VAR   h : String4;
  173. BEGIN
  174.   h[0] := #4;
  175.   h[1] := HexCh[Hi(w) Shr 4];
  176.   h[2] := HexCh[Hi(w) AND 15];
  177.   h[3] := HexCh[Lo(w) Shr 4];
  178.   h[4] := HexCh[Lo(w) AND 15];
  179.   Hex := h;
  180. END;
  181.  
  182. PROCEDURE SetTime(hour, min, sec, s100 : WORD);
  183. BEGIN
  184. Inline(
  185.   $8A/$56/<S100          {mov dl,[bp+<s100]}
  186.   /$8A/$76/<SEC          {mov dh,[bp+<sec]}
  187.   /$8A/$4E/<MIN          {mov cl,[bp+<min]}
  188.   /$8A/$6E/<HOUR         {mov ch,[bp+<hour]}
  189.   /$B4/$2D               {mov ah,$2D}
  190.   /$CD/$21               {int $21}
  191. );
  192. END;
  193.  
  194. PROCEDURE SetDate(year, month, day : WORD);
  195. BEGIN
  196. Inline(
  197.   $8B/$4E/<YEAR          {mov cx,[bp+<year]}
  198.   /$8A/$76/<MONTH        {mov dh,[bp+<month]}
  199.   /$8A/$56/<DAY          {mov dl,[bp+<day]}
  200.   /$B4/$2B               {mov ah,$2B}
  201.   /$CD/$21               {int $21}
  202. );
  203. END;
  204.  
  205. PROCEDURE PutString(st : String);
  206. BEGIN
  207. Inline(
  208.   $B4/$40                {mov ah,$40}
  209.   /$BB/$01/$00           {mov bx,1}
  210.   /$8A/$8E/>ST           {mov cl,[bp+>st]}
  211.   /$30/$ED               {xor ch,ch}
  212.   /$8D/$96/>ST+1         {lea dx,[bp+>st+1]}
  213.   /$1E                   {push ds}
  214.   /$16                   {push ss}
  215.   /$1F                   {pop ds}
  216.   /$CD/$21               {int $21}
  217.   /$1F                   {pop ds}
  218. );
  219. END;
  220.  
  221. PROCEDURE UnpackTime(P: Longint; var T: DateTime);
  222. BEGIN
  223. Inline(
  224.   $8B/$56/<P+2           {mov dx,[bp+<p+2]}
  225.   /$C4/$7E/<T            {les di,[bp+<t]}
  226.   /$FC                   {cld}
  227.   /$B9/$09/$00           {mov cx,9}
  228.   /$89/$D0               {mov ax,dx}
  229.   /$D3/$E8               {shr ax,cl}
  230.   /$05/$BC/$07           {add ax,1980}
  231.   /$AB                   {stosw}
  232.   /$B1/$05               {mov cl,5}
  233.   /$89/$D0               {mov ax,dx}
  234.   /$D3/$E8               {shr ax,cl}
  235.   /$25/$0F/$00           {and ax,15}
  236.   /$AB                   {stosw}
  237.   /$89/$D0               {mov ax,dx}
  238.   /$25/$1F/$00           {and ax,31}
  239.   /$AB                   {stosw}
  240.   /$8B/$56/<P            {mov dx,[bp+<p]}
  241.   /$89/$D0               {mov ax,dx}
  242.   /$B1/$0B               {mov cl,11}
  243.   /$D3/$E8               {shr ax,cl}
  244.   /$AB                   {stosw}
  245.   /$89/$D0               {mov ax,dx}
  246.   /$B1/$05               {mov cl,5}
  247.   /$D3/$E8               {shr ax,cl}
  248.   /$25/$3F/$00           {and ax,63}
  249.   /$AB                   {stosw}
  250.   /$89/$D0               {mov ax,dx}
  251.   /$D1/$E0               {shl ax,1}
  252.   /$25/$3F/$00           {and ax,63}
  253.   /$AB                   {stosw}
  254. );
  255. END;
  256.  
  257. PROCEDURE PackTime(VAR T : DateTime; VAR P: LongInt);
  258. BEGIN
  259. Inline(
  260.   $1E                    {push ds}
  261.   /$C5/$76/<T            {lds si,[bp+<T]}
  262.   /$FC                   {cld}
  263.   /$C4/$7E/<P            {les di,[bp+<P]}
  264.   /$AD                   {lodsw                      ; year}
  265.   /$2D/$BC/$07           {sub ax,1980}
  266.   /$B9/$09/$00           {mov cx,9}
  267.   /$D3/$E0               {shl ax,cl}
  268.   /$89/$C2               {mov dx,ax}
  269.   /$AD                   {lodsw                      ; month}
  270.   /$B1/$05               {mov cl,5}
  271.   /$D3/$E0               {shl ax,cl}
  272.   /$01/$C2               {add dx,ax}
  273.   /$AD                   {lodsw                      ; day}
  274.   /$01/$D0               {add ax,dx}
  275.   /$26/$89/$45/$02       {es: mov [di+2],ax}
  276.   /$AD                   {lodsw                      ; hour}
  277.   /$B1/$0B               {mov cl,11}
  278.   /$D3/$E0               {shl ax,cl}
  279.   /$89/$C2               {mov dx,ax}
  280.   /$AD                   {lodsw                      ; min}
  281.   /$B1/$05               {mov cl,5}
  282.   /$D3/$E0               {shl ax,cl}
  283.   /$01/$C2               {add dx,ax}
  284.   /$AD                   {lodsw                      ; sec}
  285.   /$D1/$E8               {shr ax,1}
  286.   /$01/$D0               {add ax,dx}
  287.   /$AB                   {stosw}
  288. );
  289. END;
  290.  
  291. PROCEDURE ExecEnv(Path,CmdLine: String; environ : Pointer); EXTERNAL;
  292. $L ExecEnv.obj
  293.  
  294. PROCEDURE Exec(Path,CmdLine: String);
  295. BEGIN
  296.   ExecEnv(Path,CmdLine,NIL);
  297. END;
  298.  
  299. PROCEDURE SetFAttr(var F; Attr: Word);
  300. BEGIN
  301. Inline(
  302.   $B8/$01/$43            {mov ax,$4301}
  303.   /$1E                   {push ds}
  304.   /$C5/$56/<F            {lds dx,[bp+<f]}
  305.   /$81/$C2/$30/$00       {add dx,48}
  306.   /$8B/$4F/<ATTR         {mov cx,[bx+<attr]}
  307.   /$CD/$21               {int $21}
  308.   /$1F                   {pop ds}
  309.   /$72/$02               {jc g1}
  310.   /$31/$C0               {xor ax,ax}
  311.                          {g1:}
  312.   /$A3/>DOSERROR         {mov [>DosError],ax}
  313. );
  314. END;                                   {SetFAttr}
  315.  
  316. PROCEDURE GetFAttr(var F; var Attr: Word);
  317. BEGIN
  318. Inline(
  319.   $B8/$00/$43            {mov ax,$4300}
  320.   /$1E                   {push ds}
  321.   /$C5/$56/<F            {lds dx,[bp+<f]}
  322.   /$81/$C2/$30/$00       {add dx,48}
  323.   /$CD/$21               {int $21}
  324.   /$1F                   {pop ds}
  325.   /$72/$02               {jc g1}
  326.   /$31/$C0               {xor ax,ax}
  327.                          {g1:}
  328.   /$A3/>DOSERROR         {mov [>DosError],ax}
  329.   /$C4/$5E/<ATTR         {les bx,[bp+<attr]}
  330.   /$26/$89/$0F           {es: mov [bx],cx}
  331. );
  332. END;                                   {GetFAttr}
  333.  
  334. PROCEDURE GetDiskInfo(drive : WORD; VAR dinfo : DiskInfo);
  335. BEGIN
  336. Inline(
  337.   $B4/$36                {mov ah,$36}
  338.   /$8A/$56/<DRIVE        {mov dl,[bp+<drive]}
  339.   /$CD/$21               {int $21}
  340.   /$C4/$7E/<DINFO        {les di,[bp+<dinfo]}
  341.   /$26/$89/$1D           {es: mov [di],bx}
  342.   /$26/$89/$55/$02       {es: mov [di+2],dx}
  343.   /$26/$89/$4D/$04       {es: mov [di+4],cx}
  344.   /$26/$89/$45/$06       {es: mov [di+6],ax}
  345. );
  346. END;                                   {GetDiskInfo}
  347.  
  348. FUNCTION  GetDevStat(handle : WORD) : WORD;
  349. BEGIN
  350. Inline(
  351.   $B8/$00/$44            {mov ax,$4400}
  352.   /$8B/$5E/<HANDLE       {mov bx,[bp+<handle]}
  353.   /$CD/$21               {int $21}
  354.   /$72/$02               {jc g1}
  355.   /$31/$C0               {xor ax,ax}
  356.                          {g1:}
  357.   /$A3/>DOSERROR         {mov [>DosError],ax}
  358.   /$89/$56/$FE           {mov [bp-2],dx}
  359. );
  360. END;                                   {GetDevStat}
  361.  
  362. PROCEDURE GetTime(VAR hour, min, sec, s100 : WORD);
  363. BEGIN
  364. Inline(
  365.   $B4/$2C                {mov ah,$2C}
  366.   /$CD/$21               {int $21}
  367.   /$31/$C0               {xor ax,ax}
  368.   /$C4/$5E/<HOUR         {les bx,[bp+<hour]}
  369.   /$88/$E8               {mov al,ch}
  370.   /$26/$89/$07           {es: mov [bx],ax}
  371.   /$C4/$5E/<MIN          {les bx,[bp+<min]}
  372.   /$88/$C8               {mov al,cl}
  373.   /$26/$89/$07           {es: mov [bx],ax}
  374.   /$C4/$5E/<SEC          {les bx,[bp+<sec]}
  375.   /$88/$F0               {mov al,dh}
  376.   /$26/$89/$07           {es: mov [bx],ax}
  377.   /$C4/$5E/<S100         {les bx,[bp+<s100]}
  378.   /$88/$D0               {mov al,dl}
  379.   /$26/$89/$07           {es: mov [bx],ax}
  380. );
  381. END;                                   {GetTime}
  382.  
  383. PROCEDURE GetDate(VAR year, month, day, dow : WORD);
  384. BEGIN
  385. Inline(
  386.   $B4/$2A                {mov ah,$2A}
  387.   /$CD/$21               {int $21}
  388.   /$30/$E4               {xor ah,ah}
  389.   /$C4/$5E/<DOW          {les bx,[bp+<dow]}
  390.   /$26/$89/$07           {es: mov [bx],ax}
  391.   /$C4/$5E/<YEAR         {les bx,[bp+<year]}
  392.   /$26/$89/$0F           {es: mov [bx],cx}
  393.   /$C4/$5E/<MONTH        {les bx,[bp+<month]}
  394.   /$88/$F0               {mov al,dh}
  395.   /$26/$89/$07           {es: mov [bx],ax}
  396.   /$C4/$5E/<DAY          {les bx,[bp+<day]}
  397.   /$88/$D0               {mov al,dl}
  398.   /$26/$89/$07           {es: mov [bx],ax}
  399. );
  400. END;                                   {GetDate}
  401.  
  402. VAR IntVectorTable : ARRAY [BYTE] OF Pointer ABSOLUTE 0:0;
  403.  
  404. PROCEDURE GetIntVec(nr : BYTE; VAR p : Pointer);
  405. BEGIN
  406.   p := IntVectorTable[nr];
  407. END;
  408.  
  409. PROCEDURE SetIntVec(nr : BYTE; p : Pointer);
  410. BEGIN
  411.   InLine($FA);
  412.   IntVectorTable[nr] := p;
  413.   InLine($FB);
  414. END;
  415.  
  416. PROCEDURE FindFirst(path : String; attr : WORD; VAR dta : SearchRec);
  417. BEGIN
  418. Inline(
  419.   $1E                    {push ds}
  420.   /$C5/$56/<DTA          {lds dx,[bp+<dta]}
  421.   /$B4/$1A               {mov ah,$1A}
  422.   /$CD/$21               {int $21}
  423.   /$16                   {push ss}
  424.   /$1F                   {pop ds}
  425.   /$8D/$96/>PATH         {lea dx,[bp+>path]}
  426.   /$89/$D3               {mov bx,dx}
  427.   /$42                   {inc dx}
  428.   /$8A/$1F               {mov bl,[bx]}
  429.   /$30/$FF               {xor bh,bh}
  430.   /$01/$D3               {add bx,dx}
  431.   /$C6/$07/$00           {mov byte ptr [bx],0}
  432.   /$8B/$4E/<ATTR         {mov cx,[bp+<attr]}
  433.   /$B4/$4E               {mov ah,$4E}
  434.   /$CD/$21               {int $21}
  435.   /$72/$22               {jc done}
  436.   /$C4/$7E/<DTA          {les di,[bp+<dta]}
  437.   /$8E/$5E/<DTA+2        {mov ds,[bp+<dta+2]}
  438.   /$81/$C7/$1E/$00       {add di,30}
  439.   /$30/$C0               {xor al,al}
  440.   /$FC                   {cld}
  441.   /$B9/$FF/$FF           {mov cx,-1}
  442.   /$F2/$AE               {repne scasb}
  443.   /$F7/$D1               {not cx}
  444.   /$49                   {dec cx}
  445.   /$4F                   {dec di}
  446.   /$8D/$75/$FF           {lea si,[di-1]}
  447.   /$FD                   {std}
  448.   /$88/$C8               {mov al,cl}
  449.   /$F2/$A4               {rep movsb}
  450.   /$88/$05               {mov [di],al}
  451.   /$31/$C0               {xor ax,ax}
  452.                          {done:}
  453.   /$1F                   {pop ds}
  454.   /$A3/>DOSERROR         {mov [>DosError],ax}
  455. );
  456. END;                                   {FindFirst}
  457.  
  458. PROCEDURE FindNext(VAR dta: SearchRec);
  459. BEGIN
  460. Inline(
  461.   $1E                    {push ds}
  462.   /$C5/$56/<DTA          {lds dx,[bp+<dta]}
  463.   /$B4/$1A               {mov ah,$1A}
  464.   /$CD/$21               {int $21}
  465.   /$B4/$4F               {mov ah,$4F}
  466.   /$CD/$21               {int $21}
  467.   /$72/$22               {jc done}
  468.   /$C4/$7E/<DTA          {les di,[bp+<dta]}
  469.   /$8E/$5E/<DTA+2        {mov ds,[bp+<dta+2]}
  470.   /$81/$C7/$1E/$00       {add di,30}
  471.   /$30/$C0               {xor al,al}
  472.   /$FC                   {cld}
  473.   /$B9/$FF/$FF           {mov cx,-1}
  474.   /$F2/$AE               {repne scasb}
  475.   /$F7/$D1               {not cx}
  476.   /$49                   {dec cx}
  477.   /$4F                   {dec di}
  478.   /$8D/$75/$FF           {lea si,[di-1]}
  479.   /$FD                   {std}
  480.   /$88/$C8               {mov al,cl}
  481.   /$F2/$A4               {rep movsb}
  482.   /$88/$05               {mov [di],al}
  483.   /$31/$C0               {xor ax,ax}
  484.                          {done:}
  485.   /$1F                   {pop ds}
  486.   /$A3/>DOSERROR         {mov [>DosError],ax}
  487. );
  488. END;                                   {FindNext}
  489.  
  490. PROCEDURE GetFTime(VAR fil; VAR time : LongInt);
  491. BEGIN
  492. Inline(
  493.   $B8/$00/$57            {mov ax,$5700}
  494.   /$C4/$5E/<FIL          {les bx,[bp+<fil]}
  495.   /$26/$8B/$1F           {es: mov bx,[bx]}
  496.   /$CD/$21               {int $21}
  497.   /$72/$0C               {jc done}
  498.   /$C4/$5E/<TIME         {les bx,[bp+<time]}
  499.   /$26/$89/$0F           {es: mov [bx],cx}
  500.   /$26/$89/$57/$02       {es: mov [bx+2],dx}
  501.   /$31/$C0               {xor ax,ax}
  502.                          {done:}
  503.   /$A3/>DOSERROR         {mov [>DosError],ax}
  504. );
  505. END;                                   {GetFTime}
  506.  
  507. PROCEDURE SetFTime(VAR fil; time : LongInt);
  508. BEGIN
  509. Inline(
  510.   $B8/$01/$57            {mov ax,$5701}
  511.   /$C4/$5E/<FIL          {les bx,[bp+<fil]}
  512.   /$26/$8B/$1F           {es: mov bx,[bx]}
  513.   /$8B/$4E/<TIME         {mov cx,[bp+<time]}
  514.   /$8B/$56/<TIME+2       {mov dx,[bp+<time+2]}
  515.   /$CD/$21               {int $21}
  516.   /$72/$02               {jc done}
  517.   /$31/$C0               {xor ax,ax}
  518.                          {done:}
  519.   /$A3/>DOSERROR         {mov [>DosError],ax}
  520. );
  521. END;                                   {SetFTime}
  522.  
  523. FUNCTION FindEnv(find : String) : String;
  524. VAR st : String;
  525.     cp : ^CHAR;
  526. BEGIN
  527.   cp := Ptr(MemW[PrefixSeg:$2C],0);
  528.   WHILE cp^ <> #0 DO BEGIN
  529.     st := '';
  530.     WHILE cp^ <> #0 DO BEGIN
  531.       Inc(st[0]);
  532.       st[Length(st)] := cp^;
  533.       Inc(WORD(cp));
  534.     END;
  535.     IF Copy(st,1,Length(find)) = find THEN BEGIN
  536.       Delete(st,1,Length(find));
  537.       FindEnv := st;
  538.       Exit;
  539.     END;
  540.     Inc(WORD(cp));
  541.   END;
  542.   FindEnv := '';
  543. END;
  544.  
  545. END.
  546.