home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 08 / tricks / t_exec.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-06-01  |  2.5 KB  |  86 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    T_EXEC.PAS                          *)
  3. (*         (c) 1989  R.Hoffmann  &  TOOLBOX               *)
  4. (* ------------------------------------------------------ *)
  5. UNIT t_exec;
  6.  
  7. INTERFACE
  8.  
  9. USES Crt, Dos;
  10.  
  11.   PROCEDURE ExecProg(path, cmdline : STRING);
  12.   PROCEDURE ExecDos(command : STRING);
  13.  
  14. IMPLEMENTATION
  15.  
  16.   PROCEDURE Fehlermeldung;
  17.   VAR c : CHAR;
  18.   BEGIN
  19.     WriteLn; WriteLn('Fehler ', DosError);
  20.     CASE DosError OF
  21.        2 : WriteLn('Datei nicht gefunden');
  22.        3 : WriteLn('Suchweg nicht gefunden');
  23.        5 : WriteLn('Zugriff verweigert');
  24.        6 : WriteLn('Handle nicht definiert oder ungültig');
  25.        8 : WriteLn('nicht genügend Platz im Hauptspeicher');
  26.       10 : WriteLn('Umgebungsparameter ungültig');
  27.       11 : WriteLn('ungültiges Befehlsformat');
  28.       18 : WriteLn('keine weiteren Dateieinträge');
  29.     END;
  30.     WriteLn; Write('weiter mit beliebiger Taste ');
  31.     c := ReadKey; IF c = #0 THEN c := ReadKey;
  32.   END;
  33.  
  34.   PROCEDURE ExecProg(path, cmdline : STRING);
  35.   VAR anz   : WORD;
  36.       fp, t : POINTER;
  37.       regs  : Registers;
  38.       c     : CHAR;
  39.   BEGIN
  40.     fp  := Ptr(Seg(freeptr^), Ofs(freeptr^));
  41.     anz := $FFFF - Ofs(freeptr^) + 10;
  42.     GetMem(t, anz);  Move(fp^, t^, anz);
  43.     WITH regs DO BEGIN
  44.       ah := $4A;
  45.       es := PrefixSeg;
  46.       bx := Seg(heapptr^) + 1 - PrefixSeg;
  47.       MsDos(regs);
  48.     END;
  49.     SwapVectors;
  50.     Exec(path, cmdline);
  51.     SwapVectors;
  52.     WITH regs DO BEGIN
  53.       ah := $4A;
  54.       es := PrefixSeg;
  55.       bx := $FFFF;
  56.       MsDos(regs);
  57.       ah := $4A;
  58.       es := PrefixSeg;
  59.       MsDos(regs);
  60.     END;
  61.     IF DosError <> 0 THEN Fehlermeldung;
  62.     Move(t^, fp^, anz); FreeMem(t, anz);
  63.   END;
  64.  
  65.   PROCEDURE ExecDos(command : STRING);
  66.   VAR screen : WORD;
  67.       cx, cy : BYTE;
  68.       p      : POINTER;
  69.       c      : CHAR;
  70.       env    : STRING;
  71.   BEGIN
  72.     IF MemW[$40:$49] = 7 THEN screen := $B000
  73.                          ELSE screen := $B800;
  74.     GetMem(p, 2000); Move(Mem[screen:0], p^, 2000);
  75.     cx := WhereX;  cy := WhereY;  ClrScr;
  76.     Write(' mit beliebiger Taste zurück ');
  77.     Env := Getenv('COMSPEC');
  78.     ExecProg(env, '/C ' + command);
  79.     c := Readkey;  IF c = #0 THEN c := ReadKey;
  80.     Move(p^, Mem[screen:0], 2000); FreeMem(p, 2000);
  81.     GotoXY(cx, cy);
  82.   END;
  83. END.
  84. (* ------------------------------------------------------ *)
  85. (*                 Ende von T_EXEC.PAS                    *)
  86.