home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 31 / CDASC_31_1996_juillet_aout.iso / internet / rnr214.zip / TP4EXEC.PAS < prev   
Pascal/Delphi Source File  |  1994-11-20  |  3KB  |  189 lines
  1. { stuff tp4 needs to work with exec }
  2.  
  3. unit tp4exec;
  4.  
  5. interface
  6.  
  7. uses dos;
  8.  
  9. type
  10.   pathstr=string[79];
  11.   dirstr=string[67];
  12.   namestr=string[8];
  13.   extstr=string[4];
  14.  
  15. function envcount: integer;
  16. function envstr(index: integer): string;
  17. function getenv(name: string): string;
  18. procedure fsplit(path: pathstr; var dir: dirstr; var name: namestr; var ext: extstr);
  19. procedure swapvectors;
  20.  
  21. implementation
  22.  
  23. function envcount;
  24.  
  25. var
  26.   result: integer;
  27.  
  28.   i: integer;
  29.   envseg: word;
  30.   envread: integer;
  31.   firstb: byte;
  32.   thisb: byte;
  33.  
  34. begin
  35.   result := 0;
  36.  
  37.   envseg := memw[prefixseg:$2c];
  38.   envread := 0;
  39.   repeat
  40.     firstb := mem[envseg:envread];
  41.     if firstb>0 then
  42.       begin
  43.         inc(result);
  44.  
  45.         repeat
  46.           thisb := mem[envseg:envread];
  47.           inc(envread);
  48.         until thisb=ord('=');
  49.  
  50.         repeat
  51.           thisb := mem[envseg:envread];
  52.           inc(envread);
  53.         until thisb=0;
  54.     end;
  55.   until (firstb=0);
  56.  
  57.   envcount := result;
  58. end;
  59.  
  60. function envstr;
  61.  
  62. var
  63.   result: string;
  64.  
  65.   i: integer;
  66.   envseg: word;
  67.   envread: integer;
  68.   firstb: byte;
  69.   thisb: byte;
  70.   varname: string;
  71.   vardata: string;
  72.   done: boolean;
  73.   seenvars: integer;
  74.  
  75. begin
  76.   result := '';
  77.   envseg := memw[prefixseg:$2c];
  78.   envread := 0;
  79.   seenvars := 0;
  80.  
  81.   repeat
  82.     firstb := mem[envseg:envread];
  83.     if firstb>0 then
  84.       begin
  85.         inc(seenvars);
  86.  
  87.         varname := '';
  88.         repeat
  89.           thisb := mem[envseg:envread];
  90.           inc(envread);
  91.           if thisb<>ord('=') then
  92.             varname := varname+chr(thisb);
  93.         until thisb=ord('=');
  94.  
  95.         vardata := '';
  96.         repeat
  97.           thisb := mem[envseg:envread];
  98.           inc(envread);
  99.           if thisb>0 then
  100.             vardata := vardata+chr(thisb);
  101.         until thisb=0;
  102.  
  103.         done := (seenvars=index);
  104.         if done then
  105.           result := varname+'='+vardata;
  106.     end;
  107.   until (firstb=0) or done;
  108.  
  109.   envstr := result;
  110. end;
  111.  
  112. function getenv;
  113.  
  114. var
  115.   result: string;
  116.  
  117.   i: integer;
  118.   envseg: word;
  119.   envread: integer;
  120.   firstb: byte;
  121.   thisb: byte;
  122.   varname: string;
  123.   vardata: string;
  124.   done: boolean;
  125.  
  126. begin
  127.   result := '';
  128.   envseg := memw[prefixseg:$2c];
  129.   envread := 0;
  130.   repeat
  131.     firstb := mem[envseg:envread];
  132.     if firstb>0 then
  133.       begin
  134.         varname := '';
  135.         repeat
  136.           thisb := mem[envseg:envread];
  137.           inc(envread);
  138.           if thisb<>ord('=') then
  139.             varname := varname+chr(thisb);
  140.         until thisb=ord('=');
  141.         vardata := '';
  142.         repeat
  143.           thisb := mem[envseg:envread];
  144.           inc(envread);
  145.           if thisb>0 then
  146.             vardata := vardata+chr(thisb);
  147.         until thisb=0;
  148.         done := (varname=name);
  149.         if done then
  150.           result := vardata;
  151.     end;
  152.   until (firstb=0) or done;
  153.   getenv := result;
  154. end;
  155.  
  156. procedure fsplit;
  157.  
  158. var
  159.   i: integer;
  160.   done: boolean;
  161.   endofdir: integer;
  162.  
  163. begin
  164.   dir := '';
  165.   name := path;
  166.  
  167.   for i := 1 to length(path) do
  168.     if (path[i]=':') or (path[i]='/') or (path[i]='\') then
  169.       begin
  170.         dir := copy(path,1,i);
  171.         name := copy(path,i+1,255);
  172.       end;
  173.  
  174.   i := pos('.',name);
  175.   if i=0 then
  176.     i := length(name)+1;
  177.  
  178.   ext := copy(name,i,255);
  179.   name := copy(name,1,i-1);
  180. end;
  181.  
  182. procedure swapvectors;
  183.  
  184. begin
  185. end;
  186.  
  187. begin
  188. end.
  189.