home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 06 / leser / shell.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-04-11  |  5.1 KB  |  158 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     SHELL.PAS                          *)
  3. (*           Selbstdefinierte Prompts für Shells          *)
  4. (*                 Turbo Pascal ab 5.0                    *)
  5. (*           (c) 1991 Gunnar Blumert & TOOLBOX            *)
  6. (* ------------------------------------------------------ *)
  7. {$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
  8. UNIT Shell;
  9.  
  10. INTERFACE
  11. PROCEDURE DosShell;
  12. IMPLEMENTATION
  13.  
  14. USES Dos;
  15.  
  16. FUNCTION ExecShell: BYTE;
  17. CONST
  18.   PromptBytes = 7;
  19.   Prompt: ARRAY[1..PromptBytes] OF CHAR =
  20.   ('P', 'R', 'O', 'M', 'P', 'T', '=');
  21.   OwnPromptBytes = 32;    { Definition des eigenen Prompts }
  22.   MyOwnPrompt: ARRAY[1..OwnPromptBytes] OF CHAR =
  23.   ('R','ü','c','k','k','e', 'h','r',' ','z','u',' ','S','H',
  24.   'E','L','L','T','S','T', ' ','m','i','t',' ','E','X','I',
  25.   'T','!','$','_');
  26.   { erzeugt Systemprompt C>, falls kein Prompt gesetzt war }
  27.   NoPromptBytes = 4;
  28.   NoPrompt: ARRAY[1..NoPromptBytes] OF CHAR =
  29.             ('$','n','$','g');
  30.                                            { Kommandozeile }
  31.   CommandLine: ARRAY[1..2] OF BYTE = (0, 0);
  32.  
  33. VAR CPU                               : Registers;
  34.     NewEnv, FillEnvPtr                : Pointer;
  35.     EnvBytes, EnvSeg                  : WORD;
  36.     EnvString                         : STRING;
  37.     CommandPath                       : PathStr;
  38.     ExecParameter                     : ARRAY[0..6] OF WORD;
  39.     ExecError                         : BYTE;
  40.  
  41. FUNCTION Make_New_Environment : BOOLEAN;
  42. VAR PromptBegin, i : BYTE;
  43.     PromptFound    : BOOLEAN;
  44.  
  45. PROCEDURE FillEnviron(SourcePtr : Pointer; Count : WORD);
  46. BEGIN
  47.   Move(SourcePtr^, FillEnvPtr^, Count);
  48.   Inc(LONGINT(FillEnvPtr), Count)
  49. END;
  50.  
  51. PROCEDURE AddZero;
  52. BEGIN
  53.   BYTE(FillEnvPtr^) := 0;
  54.   Inc(LONGINT(FillEnvPtr))
  55. END;
  56.  
  57. BEGIN
  58.   Make_New_Environment := FALSE; PromptFound := FALSE;
  59.   EnvBytes := 0;  { Summe der Länge der Strings + Nullbyte }
  60.   FOR i := 1 TO EnvCount DO
  61.     Inc(EnvBytes, Succ(Length(EnvStr(i))));
  62.                     { abschließendes zusätzliches Nullbyte }
  63.   Inc(EnvBytes, Succ(OwnPromptBytes));
  64.             { + 1 Paragraph: falls Offset nach GetMem <> 0 }
  65.   Inc(EnvBytes, 16);
  66.   GetMem(NewEnv, EnvBytes);
  67.   EnvSeg := Succ(Seg(NewEnv^));
  68.                  { deshalb hier die Segmentadresse erhöhen }
  69.   FillEnvPtr := Ptr(EnvSeg,0);
  70.                 { Zeiger auf Beginn des neuen Environments }
  71.          { nun die einzelnen Environmentstrings übertragen }
  72.                         { dabei das eigene Prompt einfügen }
  73.   FOR i := 1 TO EnvCount DO BEGIN
  74.     EnvString := EnvStr(i);
  75.     IF Pos('PROMPT', EnvString) = 1 THEN BEGIN
  76.       PromptFound := TRUE;
  77.       PromptBegin := Pos('=', EnvString);
  78.       FillEnviron(@EnvString[1], PromptBegin);
  79.       FillEnviron(@MyOwnPrompt, OwnPromptBytes);
  80.       FillEnviron(@EnvString[Succ(PromptBegin)],
  81.                   Length(EnvString) - PromptBegin);
  82.     END ELSE
  83.       FillEnviron(@EnvString[1], Length(EnvString));
  84.     AddZero;            { Nullbyte zum Trennen der Strings }
  85.   END;    { falls kein Prompt definiert war, dann anhängen }
  86.   IF NOT PromptFound THEN BEGIN
  87.     FillEnviron(@Prompt, PromptBytes);
  88.     FillEnviron(@MyOwnPrompt, OwnPromptBytes);
  89.     FillEnviron(@NoPrompt, NoPromptBytes);
  90.     AddZero;
  91.   END;
  92.   AddZero;
  93.   Make_New_Environment := TRUE;
  94. END;
  95.  
  96. BEGIN                                          { von SHELL }
  97.   ExecError := 8;
  98.   IF NOT Make_New_Environment THEN Exit;
  99.   WITH CPU DO BEGIN
  100.     AH := $4A;                        { Speicher freigeben }
  101.     ES := PrefixSeg;
  102.     BX := Succ(Seg(HeapPtr^)-PrefixSeg)
  103.   END;
  104.   MsDos(CPU);
  105.   CommandPath := GetEnv('COMSPEC') + #0;
  106.   FillChar(ExecParameter, SizeOf(ExecParameter), #0);
  107.   ExecParameter[0] := EnvSeg;
  108.   ExecParameter[1] := Ofs(CommandLine);
  109.   ExecParameter[2] := Seg(CommandLine);
  110.   WITH CPU DO BEGIN
  111.     AX := $4B00;
  112.     DS := Seg(CommandPath[1]);
  113.     DX := Ofs(CommandPath[1]);
  114.     ES := Seg(ExecParameter);
  115.     BX := Ofs(ExecParameter)
  116.   END;
  117.   SwapVectors;
  118.   MsDos(CPU);                        { evtl. Fehlermeldung }
  119.   SwapVectors;
  120.   IF (CPU.Flags AND 1) <> 0 THEN
  121.     ExecError := CPU.AL
  122.   ELSE
  123.     ExecError := 0;
  124.   WITH CPU DO BEGIN              { Speicher wieder belegen }
  125.     AH := $4A;
  126.     ES := PrefixSeg;
  127.     BX := $FFFF;               { ermittelt maximal         }
  128.     MsDos(CPU);                { verfügbaren Speicherplatz }
  129.     AH := $4A;                 { diesen dann anfordern     }
  130.     ES := PrefixSeg;
  131.     MsDos(CPU);
  132.   END;
  133.   FreeMem(NewEnv, EnvBytes);
  134.   ExecShell := ExecError;
  135. END;
  136.  
  137. PROCEDURE DosShell;
  138. VAR s : STRING;
  139.     e : BYTE;
  140. BEGIN
  141.   e := ExecShell;
  142.   IF e <> 0 THEN BEGIN
  143.     s := '';
  144.     CASE e OF
  145.        1: s := 'Falsche Funktionsnummer übergeben!';
  146.        2: s := 'COMMAND.COM nicht gefunden!';
  147.        8: s := 'Zuwenig Speicherplatz!';
  148.       10: s := 'Environment ungültig!';
  149.       11: s := 'Parameterblock ungültig!';
  150.     ELSE  s := 'Erstaunlicher Fehler!';
  151.     END;
  152.     WriteLn('Fehler: ',s)
  153.   END
  154. END;
  155. END.
  156. (* ------------------------------------------------------ *)
  157. (*                  Ende von SHELL.PAS                    *)
  158.