home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / extra18 / pastrick / freeenv / free_env.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1991-12-06  |  2.2 KB  |  80 lines
  1. (* ------------------------------------------------- *)
  2. (*                    FREE_ENV.PAS                   *)
  3. (*            (c) Bengt Konrad & DMV-Verlag          *)
  4. (* ------------------------------------------------- *)
  5. (*           Sprache : Turbo Pascal ab 4.0           *)
  6. (* ------------------------------------------------- *)
  7. PROGRAM Free_Environment;
  8.  
  9. {.$A-,B-,R-,I-}
  10.  
  11. USES Dos;
  12.  
  13. VAR
  14.   Regs                       : Registers;
  15.   EnvSeg, Owner, Offset, MCB : WORD;
  16.   x                          : INTEGER;
  17.   Prog                       : STRING;
  18.  
  19. BEGIN
  20.   IF ParamCount = 0 THEN BEGIN
  21.     Writeln(ParamStr(0) + ': Programmname fehlt');
  22.     Exit;
  23.   END;
  24.   Prog := '\' + ParamStr(1);
  25.  
  26.   (* ersten MCB finden *)
  27.   Regs.AH := $52;
  28.   MsDos(Regs);
  29.   MCB := MemW[Regs.ES-1 : Regs.BX+14] +
  30.          MemW[Regs.ES-1 : Regs.BX+12] SHR 4;
  31.  
  32.   REPEAT
  33.     Owner  := MemW[MCB:1];
  34.     EnvSeg := MCB + 1;
  35.  
  36.           (* Environment gefunden ? *)
  37.     IF (Owner > 8) AND (Owner <> EnvSeg) AND
  38.        (MemW[Owner:0]   = $20CD) AND
  39.        (MemW[Owner:$2c] = EnvSeg) THEN BEGIN
  40.           (* Environmentende suchen *)
  41.       Offset := 0;
  42.       WHILE MemW[EnvSeg:Offset] <> $0000 DO
  43.         Inc(Offset);
  44.  
  45.           (* Programmname vorhanden ? *)
  46.       IF MemW[EnvSeg:Offset+2] = $0001 THEN BEGIN
  47.         Inc(Offset, 4);
  48.  
  49.           (* Namensende suchen ... *)
  50.         WHILE Mem[EnvSeg:Offset] <> $00 DO
  51.           Inc(Offset);
  52.  
  53.           (* ... und rückwärts vergleichen *)
  54.           x := Length(Prog) + 1;
  55.           REPEAT
  56.             Dec(x);  Dec(Offset);
  57.           UNTIL (x = 0) OR
  58.                 (CHAR(Mem[EnvSeg:Offset]) <>
  59.                       UpCase(Prog[x]));
  60.  
  61.           (* Namensgleichheit ? *)
  62.           IF x = 0 THEN BEGIN
  63.                (* Environment freigeben *)
  64.             Regs.AH := $49;
  65.             Regs.ES := EnvSeg;
  66.             MsDos(Regs);
  67.           END;
  68.         END;
  69.       END;
  70.  
  71.           (* letzter MCB ? *)
  72.     IF CHAR(Mem[MCB:0]) = 'Z' THEN Exit;
  73.  
  74.           (* nächster MCB ... *)
  75.     Inc(MCB, MemW[MCB:3] + 1);
  76.   UNTIL FALSE;
  77. END.
  78. (* ------------------------------------------------- *)
  79. (*               Ende von FREE_ENV.PAS               *)
  80.