home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / PARADIS1 / CHGENV1.PAS < prev    next >
Pascal/Delphi Source File  |  1992-04-08  |  2KB  |  76 lines

  1. (4692)  Sat 4 Apr 92 12:57
  2. By: Joseph Crea
  3. To: Gavin Campbell
  4. Re: Shell/prompt (2 of 3)
  5. St:
  6. ---------------------------------------------------------------------------
  7. @EID:f3b4 18846720
  8. @PID: QE 2.75
  9. {$A+,B-,D+,E+,F-,I+,L+,N-,O-,R-,S+,V+}
  10. {$M 16384,0,65536}
  11. uses dos;
  12.  
  13. PROCEDURE BUILD_ENV_BLOCK(var env_block ;
  14.                               env_var, env_str : string);
  15.  
  16. var
  17.   max_block : array[1..32*1024] of char absolute env_block;
  18.   temp_str : string;
  19.   index, j, k : word;
  20.  
  21. begin
  22.   index := 1;
  23.   for j := 1 to envcount do
  24.     begin
  25.       temp_str := envstr(j);
  26.       if (pos(env_var, temp_str) <> 0) then (*env variable found*)
  27.         temp_str := env_var + '=' + env_str;
  28.       for k := 1 to length(temp_str) do
  29.         begin
  30.           max_block[index] := temp_str[k];
  31.           inc(index);
  32.         end;
  33.       max_block[index] := chr(0);
  34.       inc(index);
  35.     end;
  36.   max_block[index] := chr(0);
  37.   inc(index);
  38.  
  39.   memw[ seg( max_block[index]) : ofs(max_block[index]) ] := 1;
  40.   inc(index, 2);
  41.  
  42.   temp_str := paramstr(0);
  43.   for j := 1 to length(temp_str) do
  44.     begin
  45.       max_block[index] := temp_str[j];
  46.       inc(index);
  47.     end;
  48.   max_block[index] := chr(0);
  49. end; (* of procedure build_env *)
  50.  
  51. PROCEDURE NEW_ENV( var new_env_block );
  52.  
  53. begin
  54.   MEMW[ PrefixSeg : $002C ] := seg(new_env_block);
  55. end; (* of procedure new_env *)
  56.  
  57. PROCEDURE NORMALIZE ( var untyped );
  58. var
  59.   old_pointer : pointer absolute untyped;
  60.   segment, offset : word;
  61.  
  62. begin
  63.   segment := seg(old_pointer^);
  64.   offset := ofs(old_pointer^);
  65.   segment := segment + offset div 16;
  66.   offset := offset mod 16;
  67.   old_pointer := ptr(segment, offset);
  68. end; (* of PROCEDURE normalize *)
  69. .
  70.  
  71. --- QuickBBS 2.76 (Gamma-1)
  72.  * Origin: 221B Baker Street * Panama City FL * 904-871-6536 (1:3608/3)
  73.  
  74. @PATH: 3608/1 123/19 396/1 13/13 1/217 105/27 42 500/1 9 512/0 
  75. @PATH: 512/1007 
  76.