home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 02 / texe.pas < prev   
Pascal/Delphi Source File  |  1987-11-22  |  4KB  |  89 lines
  1. (* ----------------------------------------------------- *)
  2. (*                        TEXE.PAS                       *)
  3. (* Das Programm ruft ein weiteres Turbo Pascal-Programm  *)
  4. (* auf, welches auch mit der Chain-Option kompiliert     *)
  5. (* worden sein kann. Durch diese Compiler-Option wer-    *)
  6. (* den die Programmdateien wesentlich kuerzer, da das    *)
  7. (* Laufzeitsystem nur einmal im Programm TEXE.COM vor-   *)
  8. (* handen ist. Das auszufuehrende Programm kann beim     *)
  9. (* Aufruf von TEXE in der Kommandozeile angegeben wer-   *)
  10. (* den (Bsp.: TEXE turboprog). Ebenso koennen dem auszu- *)
  11. (* fuehrenden Programm Kommandozeilen-Parameter ueber-   *)
  12. (* geben werden (Bsp.: TEXE turboprog parameter).        *)
  13. (* Achtung:                                              *)
  14. (*  Beim compilieren dieses Programms ist darauf zu      *)
  15. (*  achten, dass die Groesse des Code- und Datensegments *)
  16. (*  auf den maximalen Wert gesetzt wird. Fuer beide      *)
  17. (*  Betriebssystem wurde Turbo Pascal 3.0 verwendet.     *)
  18. PROGRAM TurboExe;
  19. (*$I ENVIRON.INC *)          (* faellt bei CP/M weg !!!! *)
  20. TYPE strng    = STRING[255];
  21. VAR ProgName,
  22.     Param,
  23.     Path,
  24.     SearchPath: strng;
  25.     ProgFile  : FILE;
  26.     i         : INTEGER;
  27.     ComLine   : STRING[128] ABSOLUTE cseg:$80;
  28.             (* fuer CP/M-80: dies da ^^^^^ entfernen !!  *)
  29.  
  30. (*    entfernt fuehrende Leerzeichen aus Zeichenkette:   *)
  31. FUNCTION LTrimStr (s: strng): strng;
  32. BEGIN
  33.   WHILE (Length(s) > 0) AND (s[1] = ' ') DO
  34.     s := Copy(s,2,Length(s));
  35.   LTrimStr := s;
  36. END;
  37.  
  38. BEGIN
  39.   WriteLn;  WriteLn;
  40.   WriteLn('TurboEXE',
  41.           '         (C)1987 B.Born, M.Ceol & PASCAL INT.');
  42.   WriteLn;  ProgName := '';  Param := '';  Path := '';
  43.   IF ParamCount = 0 THEN BEGIN (* nichts in Kommandoz. ! *)
  44.     WriteLn('Programm-Name [Parameter]: ');
  45.     Write('>');  ReadLn(Param);
  46.   END
  47.   ELSE                  (* aus Kommandozeile uebernehmen *)
  48.     FOR i := 1 TO ParamCount DO
  49.       Param := Param + ' ' + ParamStr(i);
  50.   Param := LTrimStr(Param);
  51.       (* Name des auszufuehrenden Turbo-Programms von    *)
  52.       (* den diesem zu uebergebenden Parametern trennen: *)
  53.   ProgName := Copy(Param,1,Pred(Pos(' ',Param)));
  54.   (* keine Parameter zu uebergeben, also nur Prog.-Name: *)
  55.   IF ProgName = '' THEN ProgName := Param;
  56.       (* akt. Parameter wieder in Kommandozeile ablegen: *)
  57.   comline := Copy(Param,Length(ProgName)+2,Length(Param));
  58.   i := Pred(Pos('.',ProgName));   (* Extension abspalten *)
  59.   IF i < 0 THEN i := Length(ProgName);
  60.   ProgName := Copy(ProgName,1,i);
  61.   Path := EnvironStr('PATH'); (* faellt bei CP/M weg !!! *)
  62.   SearchPath := ProgName;
  63.   REPEAT                    (* zuerst wird versucht, ein *)
  64.     (*$I-*)                 (* CHAIN-File zu starten:    *)
  65.     Assign(ProgFile,SearchPath+'.CHN');
  66.     Chain(ProgFile);
  67.      (* ging nicht, versuchen wir es mit einem COM-File: *)
  68.     IF IOResult <> 0 THEN BEGIN
  69.       Assign(ProgFile,SearchPath+'.COM');
  70.       Execute(ProgFile);
  71.     END; (* konnte im aktuellen Verzeichnis nicht ge-    *)
  72.          (* funden werden, also Suchpfade durchklappern: *)
  73.     IF IOResult <> 0 THEN BEGIN
  74.               (* naechsten Pfad aus Suchpfade abspalten: *)
  75.       i := Pred(Pos(';',Path));
  76.       IF i < 0 THEN i := Length(Path);   (* der letzte ! *)
  77.       SearchPath := Copy(Path,1,i);
  78.       Delete(Path,1,Succ(i));
  79.       IF Length(SearchPath) > 0 THEN BEGIN
  80.         IF SearchPath[Length(SearchPath)] <> '\' THEN
  81.           SearchPath := SearchPath + '\';
  82.         SearchPath := SearchPath + ProgName;
  83.       END;
  84.     END;
  85.   UNTIL SearchPath = ''; (* alle Pfade durchsucht, also: *)
  86.   WriteLn('*** Fehler: "',ProgName,
  87.           '" konnte nicht gestartet werden !');
  88. END.
  89.