home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 12 / tricks / execneu.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-09-12  |  6.2 KB  |  198 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    EXECNEU.PAS                         *)
  3. (*         (c) 1990 Christian Büchel & TOOLBOX            *)
  4. (* ------------------------------------------------------ *)
  5. USES Dos;
  6.  
  7. VAR
  8.   Error : INTEGER;
  9.  
  10. {$IFDEF VER40}
  11.   FUNCTION GetEnv(EnvVar : STRING) : STRING;
  12.               (* Ersetzt die Funktion GetEnv in Turbo 5.0 *)
  13.   LABEL
  14.     ex1, ex2;
  15.   VAR
  16.     envadr         : WORD;
  17.     super_dummy    : STRING;
  18.     i, lang, start : BYTE;
  19.   BEGIN
  20.     FOR i := 1 TO Length(EnvVar) DO
  21.       EnvVar[i] := UpCase(EnvVar[i]);
  22.     envadr         := MemW[PrefixSeg:$2C];
  23.     super_dummy[0] := #255;
  24.                  (* Explizit Stringlänge auf 255 setzen   *)
  25.     Move(Mem[envadr:0], super_dummy[1], 255);
  26.                  (* Environment nach super_dummy kopieren
  27.                         und als normalen String behandeln *)
  28.     FOR i := Pos(EnvVar, super_dummy) +
  29.              Length(EnvVar) + 1 TO 255 DO
  30.       IF (super_dummy[i] <> '=') AND
  31.          (super_dummy[i] <> ' ') THEN BEGIN
  32.         start := i;
  33.         GOTO ex1;
  34.       END;
  35.   ex1:
  36.     FOR i := start TO 255 DO
  37.       IF Ord(super_dummy[i]) = 00 THEN BEGIN
  38.         lang := i-start;
  39.         GOTO ex2;
  40.       END;
  41.   ex2:
  42.     GetEnv := Copy(super_dummy, start, lang);
  43.     IF Pos(EnvVar, super_dummy) = 0 THEN GetEnv := '';
  44.                 (* Gesuchte Variable nicht in Environment *)
  45.   END;
  46. {$ENDIF}
  47.  
  48.   FUNCTION ExecNeu(Path, Command : STRING) : INTEGER;
  49.   LABEL
  50.     ExitPoint;
  51.   CONST
  52.     MindStack      : WORD = 1000;
  53.     MindRAMforExec : WORD = 20000;
  54.   TYPE
  55.     SegOfs = RECORD
  56.                O, S : WORD;
  57.              END;
  58.   VAR
  59.     AltStartFragList,
  60.     NeuStartFragList,
  61.     RAM_Ende           : POINTER;
  62.     Allocated,
  63.     SizeOfFragList,
  64.     ParasToKeep,
  65.     ParasKomplett,
  66.     ParasForExec       : WORD;
  67.     Regs               : Registers;
  68.  
  69.     FUNCTION PtrDiff(Hi, Lo : POINTER) : LONGINT;
  70.     VAR
  71.       High : SegOfs ABSOLUTE Hi;
  72.       Low  : SegOfs ABSOLUTE Lo;
  73.     BEGIN
  74.       PtrDiff := (LONGINT(High.S) SHL 4 + High.O) -
  75.                  (LONGINT(Low.S)  SHL 4 + Low.O);
  76.     END;
  77.  
  78.     FUNCTION StartFragList : POINTER;
  79.       { FreePtr zeigt nicht direkt auf Fragmentliste }
  80.     VAR
  81.       FreeSegOfs : SegOfs ABSOLUTE FreePtr;
  82.       help       : POINTER;
  83.     BEGIN
  84.       IF FreeSegOfs.O = 0 THEN
  85.           { Fragmentliste ist leer =>
  86.                      Segment + $1000= Beginn Fragmentliste }
  87.         help := Ptr(FreeSegOfs.S + $1000, 0)
  88.       ELSE
  89.         help := Ptr(FreeSegOfs.S + (FreeSegOfs.O SHR 4), 0);
  90.           { Pointer normieren, d.h. Offset 0 }
  91.       StartFragList := help;
  92.     END;
  93.  
  94.     FUNCTION SetBlock(VAR Paragraphs : WORD) : BOOLEAN;
  95.         { Den einem Programm zugeteilten Speicher verändern }
  96.     BEGIN
  97.       WITH Regs DO BEGIN
  98.         AH := $4A;
  99.         ES := PrefixSeg;
  100.         BX := Paragraphs;
  101.         MsDos(Regs);
  102.         Paragraphs := BX;
  103.         SetBlock   := NOT Odd(Flags);     { Test auf Carry }
  104.       END;
  105.     END;
  106.  
  107.   BEGIN
  108.                        { Größe der Fragmentliste berechnen }
  109.     RAM_Ende       := Ptr(SegOfs(FreePtr).S + $1000, 0);
  110.     SizeOfFragList := PtrDiff(RAM_Ende, StartFragList);
  111.  
  112.   { Entweder Fragmentliste auf den Stack oder auf den Heap }
  113.   { Zuerst Stack probieren... }
  114.     IF LONGINT(SizeOfFragList) +
  115.                         MindStack < LONGINT(SPtr) THEN BEGIN
  116.       NeuStartFragList := Ptr(SSeg, 0);
  117.       Allocated := 0;
  118.     END ELSE BEGIN
  119.              { Stack zu klein!  Genug Platz auf dem Heap ? }
  120.       IF MaxAvail < LONGINT(SizeOfFragList) THEN BEGIN
  121.                                 { Heap zu klein, abbrechen }
  122.         ExecNeu := 1;
  123.         Exit;
  124.       END;
  125.     { Heap groß genug, RAM für Fragmentliste reservieren ! }
  126.       Allocated := SizeOfFragList;
  127.       IF Allocated > 0 THEN
  128.         GetMem(NeuStartFragList, Allocated);
  129.       SizeOfFragList := WORD(PtrDiff(RAM_Ende,
  130.                                             StartFragList));
  131.                              { Fragmentliste neu berechnen }
  132.     END;
  133.         { Sichern des aktuellen Pointers auf Fragmentliste }
  134.     AltStartFragList := StartFragList;
  135.         { Gesamtmenge Speicher (in Paragraphen (=16 Byte)),
  136.           die dem Programm zur Verfügung stehen. [MCB : 3] }
  137.     ParasKomplett := MemW[Pred(PrefixSeg):3];
  138.         { Wieviel Speicher kann man wieder freigeben ?     }
  139.     ParasForExec := Pred(PtrDiff(RAM_Ende, HeapPtr) SHR 4);
  140.         { Wieviel Speicher muß stehen bleiben ?            }
  141.     ParasToKeep := ParasKomplett - ParasForExec;
  142.         { Reicht freigemachter Speicher für Exec ?         }
  143.     IF (ParasForExec > 0) AND
  144.        (ParasForExec < (MindRAMforExec SHR 4)) THEN BEGIN
  145.       ExecNeu := 4;
  146.       GOTO ExitPoint;
  147.     END;
  148.                    { Mit DOS-Funktion Speicher verkleinern }
  149.     IF NOT SetBlock(ParasToKeep) THEN BEGIN
  150.       ExecNeu := 2;
  151.       GOTO ExitPoint;
  152.     END;
  153.        { Fragmentliste wird kopiert (Stack oder Heap) s.o. }
  154.     Move(AltStartFragList^, NeuStartFragList^,
  155.          SizeOfFragList);
  156.  
  157.   {$IFDEF VER40}
  158.     GetIntVec($23, TurboInt23);
  159.     GetIntVec($24, TurboInt24);
  160.     SetIntVec($23, SaveInt23);
  161.     SetIntVec($24, SaveInt24);
  162.   {$ELSE}
  163.     SwapVectors;
  164.   {$ENDIF}
  165.  
  166.     Exec(Path, Command);
  167.  
  168.   {$IFDEF VER40}
  169.     SetIntVec($23,TurboInt23);
  170.     SetIntVec($24,TurboInt24);
  171.   {$ELSE}
  172.     SwapVectors;
  173.   {$ENDIF}
  174.              { Mit DOS-Funktion Speicher wieder vergrößern }
  175.     IF NOT SetBlock(ParasKomplett) THEN BEGIN
  176.       ExecNeu := 3;
  177.       GOTO ExitPoint;
  178.               { Sollte dieser Fehler je auftreten => CRASH }
  179.     END;
  180.                             { Fragmentliste zurückkopieren }
  181.     Move(NeuStartFragList^, AltStartFragList^,
  182.          SizeOfFragList);
  183.     ExecNeu := DosError;
  184.  
  185.   ExitPoint:
  186.    { Eventuell belegten Heap freigeben, auch im Fehlerfall }
  187.     IF Allocated <> 0 THEN
  188.       FreeMem(NeuStartFragList, Allocated);
  189.   END;
  190.  
  191. BEGIN    { Kleiner Test }
  192.   WriteLn(GetEnv('COMSPEC'),' /C DIR');
  193.   Error := ExecNeu(GetEnv('COMSPEC'),' /C DIR');
  194.   WriteLn(Error);
  195. END.
  196. (* ------------------------------------------------------ *)
  197. (*                 Ende von EXECNEU.PAS                   *)
  198.