home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / cmplangm / 1989_4 / env / env.pas next >
Pascal/Delphi Source File  |  1989-02-01  |  11KB  |  416 lines
  1. {bt
  2. (* Turbo Pascal version 4 *)
  3.  
  4. UNIT Env;
  5.  
  6. INTERFACE
  7.  
  8. USES Dos;
  9.  
  10. VAR
  11.   UseCurrentEnv : boolean;  { true if current environment  is accessed }
  12.   SecondCommand : boolean;  { true if secondary COMMAND.COM is loaded }
  13.  
  14. PROCEDURE ReadEnvVar(EnvParam  : string; VAR EnvVar : string;
  15.                      VAR EnvError : integer);
  16.  
  17. PROCEDURE WriteEnvVar(EnvParam : string; EnvVar : string;
  18.                       VAR EnvError : integer);
  19.  
  20.       { EnvError #0 = successful operation }
  21.       { EnvError #1 = end of environment not found }
  22.       { EnvError #2 = environment full }
  23.  
  24. IMPLEMENTATION
  25.  
  26. VAR
  27.   EnvAddr     : word;     { environment address }
  28.   EnvSize     : integer;  { environment size }
  29.   EnvTyp      : byte;     { environment type }
  30.   RootEnvAddr : word;     { root environment address }
  31.   RootEnvSize : integer;  { root environment size }
  32.   Regs        : Registers;
  33.  
  34. PROCEDURE GetEnvTyp(VAR EnvTyp : byte);
  35.  
  36. VAR
  37.   Major : byte;  { major DOS version number }
  38.   Minor : byte;  { minor DOS version number }
  39.  
  40. begin
  41.  
  42.       { get DOS version }
  43.   with Regs do
  44.     begin
  45.       AX := $3000;
  46.       MSDos(Regs);
  47.       Major := Lo(AX);
  48.       Minor := Hi(AX);
  49.     end;
  50.  
  51.       { assign environment type according to DOS version }
  52.   case Major of
  53.     2 : EnvTyp := 1;
  54.     3 : case Minor of
  55.           0, 10 : EnvTyp := 1;
  56.           20    : EnvTyp := 2;
  57.           30    : EnvTyp := 3;
  58.         end;
  59.     4 : EnvTyp := 3;
  60.     else
  61.       Halt(222);
  62.   end;  { case }
  63. end;  { GetEnvTyp }
  64.  
  65. PROCEDURE SearchMemory(VAR RootEnvaddr : word; VAR RootEnvSize : integer);
  66.  
  67.       { search memory for root environment }
  68. VAR
  69.   ComMCB  : word;     { COMMAND.COM MCB }
  70.   EnvMCB  : word;     { environment MCB }
  71.   MCBsize : word;     { memory block size in paragraphs }
  72.   Found   : boolean;  { root COMMAND.COM found }
  73.  
  74. PROCEDURE CheckMCBchain(ComMCB : word; VAR EnvMCB : word;
  75.                         VAR Found : boolean);
  76.  
  77.       { check for Memory Control Block chain }
  78. begin
  79.   Found := false;
  80.   MCBsize := MemW[ComMCB : 3];
  81.   EnvMCB := Succ(ComMCB + MCBsize);
  82.   if (Mem[EnvMCB : 0] = $4D) then
  83.     Found := true;
  84. end;  { CheckMCBchain }
  85.  
  86. begin  { SearchMemory }
  87.  
  88.       { begin search for COMMAND.COM in low memory }
  89.   ComMCB := $500;
  90.   Found := false;
  91.   while not Found do
  92.     begin
  93.  
  94.       { MCB begins with $4D }
  95.       if Mem[ComMCB:0] = $4D then
  96.         begin
  97.  
  98.       { check for matching PSP address }
  99.           if MemW[ComMCB : 1] = Succ(ComMCB) then
  100.             CheckMCBchain(ComMCB,EnvMCB,Found);
  101.         end;
  102.  
  103.       { if not Found then continue search at next paragraph boundary }
  104.       Inc(ComMCB);
  105.     end;  { while }
  106.  
  107.       { check for environment type }
  108.   if MemW[ComMCB : $2C] = 0 then
  109.  
  110.       { root environment of DOS 2.0 - 3.2 }
  111.     begin
  112.       RootEnvAddr := Succ(EnvMCB);
  113.       MCBsize := MemW[EnvMCB : 3];
  114.       RootEnvSize := MCBsize * $10;
  115.     end
  116.   else
  117.  
  118.       { root environment of DOS 3.3 - 4.0 }
  119.     begin
  120.       RootEnvAddr := MemW[ComMCB : $2C];
  121.       EnvMCB := Pred(RootEnvaddr);
  122.       MCBsize := MemW[EnvMCB : 3];
  123.       RootEnvSize := MCBsize * $10;
  124.     end;  { if }
  125. end;  { SearchMemory }
  126.  
  127. PROCEDURE GetEnv(VAR EnvAddr : word; VAR EnvSize : integer;
  128.                  VAR RootEnvAddr : word; VAR RootEnvSize : integer;
  129.                  EnvTyp : byte);
  130. VAR
  131.   PSPaddr : word;  { COMMAND.COM PSP address }
  132.   ComMCB  : word;  { COMMAND.COM MCB }
  133.   EnvMCB  : word;  { environment MCB }
  134.   MCBsize : word;  { memory block size in paragraphs }
  135.  
  136. begin
  137.   RootEnvAddr := 0;
  138.  
  139.       { COMMAND.COM PSP address at offset $16 in program PSP }
  140.   PSPaddr := MemW[PrefixSeg : $16];
  141.  
  142.       { check for child process }
  143.   while (PSPaddr <> MemW[PSPaddr : $16]) do
  144.     PSPaddr := MemW[PSPaddr : $16];
  145.  
  146.       { COMMAND.COM MCB address }
  147.   ComMCB := Pred(PSPaddr);
  148.  
  149.       { size of COMMAND.COM }
  150.   MCBsize := MemW[ComMCB : 3];
  151.  
  152.       { environment MCB address }
  153.   EnvMCB := PSPaddr + MCBsize;
  154.  
  155.       { assign environment address }
  156.   EnvAddr := Succ(EnvMCB);
  157.  
  158.       { size of environment }
  159.   MCBsize := MemW[EnvMCB : 3];
  160.   EnvSize := MCBsize * $10;
  161.  
  162.       { check for secondary COMMAND.COM }
  163.   case EnvTyp of
  164.  
  165.       { $2C points to DOS environment in DOS 2.0 - 3.1 }
  166.     1 : if (MemW[PSPaddr : $2C] <> 0) then
  167.           begin
  168.             SearchMemory(RootEnvAddr,RootEnvSize);
  169.  
  170.       { re-assign environment address }
  171.             EnvAddr := MemW[PSPaddr : $2C];
  172.             EnvMCB := Pred(Envaddr);
  173.             MCBsize := MemW[EnvMCB : 3];
  174.             EnvSize := MCBsize * $10;
  175.           end;
  176.  
  177.       { $2C points to program environment in DOS 3.2 }
  178.     2 : if (MemW[PSPaddr : $2C] <> 0) then
  179.           SearchMemory(RootEnvAddr,RootEnvSize);
  180.  
  181.       { $2C points to DOS environment in DOS 3.3 - 4.0 }
  182.     3 : if (MemW[PSPaddr : $2C] = EnvAddr) then
  183.           SearchMemory(RootEnvAddr,RootEnvSize)
  184.         else
  185.  
  186.       { re-assign environment address }
  187.           begin
  188.             EnvAddr := MemW[PSPaddr : $2C];
  189.             EnvMCB := Pred(Envaddr);
  190.             MCBsize := MemW[EnvMCB : 3];
  191.             EnvSize := MCBsize * $10;
  192.           end;
  193.   end;  { case }
  194. end;  { GetEnv }
  195.  
  196. FUNCTION UpStr(St : string) : string;
  197.  
  198.       { convert a string to upper case }
  199. VAR
  200.   i : byte;
  201.  
  202. begin
  203.   for i := 1 to Length(St) do
  204.     St[i] := UpCase(St[i]);
  205.   UpStr := St;
  206. end;  { UpStr }
  207.  
  208. FUNCTION Position(St : string; EnvAddr : word; ArrayLen : integer) : integer;
  209.  
  210.       { find the position of a string in the environment array }
  211. VAR
  212.   Found : boolean;
  213.   Match : boolean;
  214.   StLen : integer;
  215.   i     : integer;
  216.   p     : integer;
  217.  
  218. begin
  219.   Found := false;
  220.   StLen := Length(St);
  221.   p := 0;
  222.   while (not Found) and ((ArrayLen - p+1) >= StLen) do
  223.  
  224.       { find first match }
  225.     begin
  226.       if St[1] = Chr(Mem[EnvAddr : p]) then
  227.  
  228.       { find next match }
  229.       begin
  230.         Match := true;
  231.         i := 1;
  232.         while Match and (i < StLen) do
  233.           if St[1+i] = Chr(Mem[EnvAddr : p+i]) then
  234.             Inc(i)
  235.           else
  236.             Match := false;
  237.         Found := Match;
  238.         end;
  239.       if not Found then
  240.         Inc(p);
  241.     end;
  242.   if found then
  243.     Position := p
  244.   else
  245.     Position := -1;
  246. end;  {  Position  }
  247.  
  248. PROCEDURE ReadEnvVar(EnvParam : string; VAR EnvVar : string;
  249.                      Var EnvError : integer);
  250.  
  251. VAR
  252.   ArrayLen : integer;  { environment array length }
  253.   ParamPos : integer;  { parameter position }
  254.   VarPos   : integer;  { variable position }
  255.   i        : integer;
  256.  
  257. begin
  258.   EnvError := 0;
  259.   if EnvParam = '' then
  260.     Exit;
  261.   if not UseCurrentEnv then
  262.     begin
  263.       EnvAddr := RootEnvAddr;
  264.       EnvSize := RootEnvSize;
  265.     end;
  266.  
  267.       { check if environment is empty }
  268.   if Mem[EnvAddr : 0] = 0 then
  269.     Exit
  270.    else
  271.      begin
  272.  
  273.       { get the length of the environment string }
  274.         ArrayLen := Position(#0#0,EnvAddr,EnvSize);
  275.         if ArrayLen = -1 then
  276.           begin
  277.             EnvError := 1;
  278.             Exit;
  279.           end;
  280.      end;  { else }
  281.  
  282.       { initialize variables }
  283.   EnvParam := UpStr(EnvParam) + '=';
  284.   EnvVar := '';
  285.  
  286.       { search for variable in environment }
  287.   ParamPos := Position(EnvParam,EnvAddr,ArrayLen);
  288.   if ParamPos = -1 then
  289.     Exit
  290.  
  291.       { environment parameter found }
  292.       { get variable string }
  293.    else
  294.      begin
  295.        ParamPos := ParamPos + Length(EnvParam);
  296.        VarPos := ParamPos;
  297.        while Mem[EnvAddr : VarPos] <> 0 do
  298.          Inc(VarPos);
  299.  
  300.       { assign environment variable }
  301.        Move(Mem[EnvAddr:ParamPos], EnvVar[1], VarPos-ParamPos);
  302.        EnvVar[0] := Chr(VarPos-ParamPos);
  303.      end;  { else }
  304. end;  { ReadEnvVar }
  305.  
  306. PROCEDURE WriteEnvVar(EnvParam, EnvVar : string;
  307.                       VAR EnvError : integer);
  308.  
  309. VAR
  310.   ArrayLen : integer;  { environment array length }
  311.   EnvStr   : string;   { environment string }
  312.   StLen    : integer;  { environment string length }
  313.   ParamPos : integer;  { parameter position }
  314.   i        : integer;
  315.  
  316. begin
  317.   EnvError := 0;
  318.   if EnvParam = '' then
  319.     Exit;
  320.   if not UseCurrentEnv then
  321.     begin
  322.       EnvAddr := RootEnvAddr;
  323.       EnvSize := RootEnvSize;
  324.     end;
  325.  
  326.       { check if environment is empty }
  327.   if Mem[EnvAddr : 0] = 0 then
  328.     ArrayLen := 0
  329.    else
  330.      begin
  331.  
  332.       { get the length of the environment string }
  333.         ArrayLen := Position(#0#0,EnvAddr,EnvSize);
  334.         if ArrayLen = -1 then
  335.           begin
  336.             EnvError := 1;
  337.             Exit;
  338.           end;
  339.      end;  { else }
  340.  
  341.       { initialize variables }
  342.   EnvParam := UpStr(EnvParam) + '=';
  343.   EnvStr := EnvParam + EnvVar + #0#0;
  344.   StLen := Length(EnvStr);
  345.  
  346.       { search for variable in environment }
  347.   ParamPos := Position(EnvParam,EnvAddr,ArrayLen);
  348.   if ParamPos = -1 then
  349.     begin
  350.  
  351.       { check for empty variable }
  352.         if EnvVar = '' then
  353.           Exit;
  354.  
  355.       { environment parameter not found }
  356.       { compare environment with string }
  357.         if (ArrayLen + StLen + 1) > EnvSize then
  358.           EnvError := 2
  359.         else
  360.  
  361.       { add new variable string to end of array }
  362.           begin
  363.             if ArrayLen = 0 then
  364.               Move(EnvStr[1], Mem[EnvAddr : 0], StLen)
  365.             else
  366.               Move(EnvStr[1], Mem[EnvAddr : ArrayLen+1], StLen);
  367.           end;
  368.     end  { if }
  369.  
  370.       { environment parameter found }
  371.       { get length of variable string }
  372.   else
  373.     begin
  374.  
  375.       { skip three characters in array }
  376.       i := ParamPos + 3;
  377.       while Mem[EnvAddr : i] <> 0 do
  378.         Inc(i);
  379.  
  380.       { get beginning of next variable string }
  381.         Inc(i);
  382.  
  383.       { delete variable from current position in array }
  384.         Move(Mem[EnvAddr: i], Mem[EnvAddr: ParamPos], (ArrayLen+2)-i);
  385.         ArrayLen := ArrayLen - (i-ParamPos);
  386.  
  387.       { check for empty variable }
  388.        if EnvVar = '' then
  389.          Exit;
  390.  
  391.       { compare environment array length with environment size }
  392.        if (ArrayLen + StLen + 1) > EnvSize then
  393.          EnvError := 2
  394.        else
  395.  
  396.       { add variable to end of array }
  397.          Move(EnvStr[1], Mem[EnvAddr : ArrayLen+1], StLen);
  398.      end;  { else }
  399. end;  { WriteEnvVar }
  400.  
  401. begin  { Env }
  402.  
  403.       { initialize environment address }
  404.   UseCurrentEnv := true;
  405.   SecondCommand := true;
  406.   GetEnvTyp(EnvTyp);
  407.   GetEnv(EnvAddr,EnvSize,RootEnvAddr,RootEnvSize,EnvTyp);
  408.   if RootEnvAddr = 0 then
  409.     begin
  410.       RootEnvAddr := EnvAddr;
  411.       RootEnvSize := EnvSize;
  412.       SecondCommand := false;
  413.     end;
  414. end.  { Env }
  415. {et
  416.