home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 10 / tricks / pdir.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-07-12  |  2.4 KB  |  76 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     PDIR.PAS                           *)
  3. (*       ermittelt das Startverzeichnis Programms         *)
  4. (*         (c) 1989  Beat Knoblauch  &  TOOLBOX           *)
  5. (* ------------------------------------------------------ *)
  6. UNIT PDir;
  7.  
  8. INTERFACE
  9.  
  10. USES Dos;  { wegen Import der PathStr-, DirStr- usw. TYPES }
  11.  
  12. PROCEDURE GetProgDir(VAR ProgDir : Dos.DirStr);
  13.      { für Turbo-Pascal 4.0 muss DOS.DirStr durch den TYPE }
  14.      { "String" ersetzt werden                             }
  15.  
  16. IMPLEMENTATION
  17.  
  18. PROCEDURE GetProgDir(VAR ProgDir : Dos.DirStr);
  19.  
  20. CONST
  21.   MaxEnv  = $8000;                           { = 32 KBytes }
  22.  
  23. TYPE
  24.   EnvArray = ARRAY[0..MaxEnv] OF Char;
  25.  
  26. VAR
  27.   PDlen    : BYTE ABSOLUTE ProgDir;
  28.   p        : ^EnvArray;
  29.   ProgPath : Dos.PathStr;
  30.   Name     : Dos.NameStr;
  31.   Ext      : Dos.ExtStr;
  32.   i        : WORD;
  33.  
  34. BEGIN
  35.   ProgPath := '';
  36.   p := Ptr(Word(Ptr(System.PrefixSeg, $2C)^), 0);
  37.            { p auf den Anfang der Env-Tabelle. Die Adresse }
  38.            { lässt sich aus der typisierten Konstanten der }
  39.            { Unit System, PrefixSeg, gewinnen. }
  40.   i := 0;
  41.   REPEAT
  42.     Inc(i);
  43.   UNTIL ((p^[i-1] = #0) AND (p^[i] = #0)) OR (i >= MaxEnv);
  44.   Inc(i);
  45.              { Einträge bis zu einem "0-Word" überspringen }
  46.   ProgDir := '';
  47.   IF i >= MaxEnv THEN Exit;
  48.   REPEAT
  49.     Inc(i);
  50.   UNTIL p^[i] = #0;
  51.   Inc(i);
  52.      { Byte im Environment überlesen, das angibt, wieviele }
  53.      { Parameter noch folgen. Danach folgt ein ASCIIZ-     }
  54.      { String, der Laufwerk, Pfad und Filename[.Ext]       }
  55.      { des laufenden Programmes enthält.                   }
  56.   ProgPath := '';
  57.   WHILE p^[i] <> #0 DO BEGIN
  58.     ProgPath := ProgPath + p^[i];
  59.     Inc(i);
  60.   END;
  61.         { ASCIIZ-String in die Variable  ProgPath einlesen }
  62.   FSplit(ProgPath, ProgDir, Name, Ext);
  63.      { Turbo Pascal 5.0 Prozedur zum Aufsplitten von       }
  64.      { Pfad-Angaben. Für Turbo-Pascal 4.0 muß der Name.Ext }
  65.      { eigenhändig abgetrennt werden, um das Directory zu  }
  66.      { extrahieren.                                        }
  67.  
  68.   IF PDlen > 3 THEN Dec(PDlen);
  69.      { Damit hat die Ausgabe dieselbe Form wie die Pascal- }
  70.      { Prozedur GetDir                                     }
  71. END;
  72.  
  73. BEGIN
  74. END.
  75. (* ------------------------------------------------------ *)
  76. (*                Ende von PDIR.PAS                       *)