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