home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TOOL_INC.ZIP / LOCFILE.INC < prev    next >
Encoding:
Text File  |  1988-01-29  |  2.3 KB  |  112 lines
  1.  
  2.  
  3. (*
  4.  * get the value of an environment variable
  5.  *
  6.  *)
  7. type
  8.    gestring = string[255];
  9.  
  10.  
  11. function get_environment_var(id: gestring): gestring;
  12. var
  13.    envseg:  integer;
  14.    i:       integer;
  15.    env:     gestring;
  16.  
  17. begin
  18.    envseg := memw[PrefixSeg:$2c];
  19.  
  20.    i := 0;
  21.    repeat
  22.       env := '';
  23.       while mem[envseg:i] <> 0 do
  24.       begin
  25.          env := env + chr(mem[envseg:i]);
  26.          i := i + 1;
  27.       end;
  28.  
  29.       if copy(env,1,length(id)) = id then
  30.       begin
  31.          get_environment_var := copy(env,length(id)+1,255);
  32.          exit;
  33.       end;
  34.  
  35.       i := i + 1;
  36.    until mem[envseg:i] = 0;
  37.  
  38. (* not found *)
  39.    get_environment_var := '';
  40. end;
  41.  
  42.  
  43. (*
  44.  * locate a file with search rules from specified environment variable.
  45.  * returns the full pathname of the located file.
  46.  * returns only the original name if not found.
  47.  *
  48.  *)
  49.  
  50. function locate_file_env(name:    gestring;
  51.                          environ: gestring): gestring;
  52. var
  53.    paths:  gestring;
  54.    dir:    gestring;
  55.    i:      integer;
  56.    fd:     file;
  57.  
  58. begin
  59.  
  60. (* get the paths and start searching them.  arrange for current directory
  61.    to be scanned first.  add trailing ; to handle special case for last path *)
  62.  
  63.    paths := environ + ';';
  64.    dir := '';
  65.  
  66.    for i := 1 to length(paths) do
  67.    begin
  68.  
  69. (* if a full directory has been collected, then try this path *)
  70.       if (paths[i] = ';') or (i = length(paths)) then
  71.       begin
  72.          if (length(dir) > 1) and (dir[length(dir)] <> '\') then
  73.             dir := dir + '\';
  74.  
  75. {$I-}
  76.          assign(fd,dir + name);
  77.          reset(fd);
  78. {$I+}
  79.          if ioresult = 0 then
  80. {! 7. IOResu^lt now returns different values corresponding to DOS error codes.}
  81.          begin
  82.            close(fd);
  83.            locate_file_env := dir + name;
  84.            exit;
  85.          end;
  86.  
  87.          dir := '';
  88.       end
  89.       else
  90.          dir := dir + paths[i];
  91.    end;
  92.  
  93. (* couldn't find it.  return the original name *)
  94.    locate_file_env := name;
  95. end;
  96.  
  97.  
  98. (*
  99.  * locate a file.  search PATH= paths if needed.  returns
  100.  * the full pathname of the located file.
  101.  * returns only the original name if not found.
  102.  *
  103.  *)
  104.  
  105. function locate_file(name: gestring): gestring;
  106. begin
  107.  
  108.    locate_file := locate_file_env(name,';' + get_environment_var('PATH='));
  109.  
  110. end;
  111.  
  112.