home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tp_util / selectd4.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-03-24  |  1.6 KB  |  94 lines
  1.  
  2.  
  3. UNIT SELECTD4;
  4. {
  5.   STELLT DAS DIRECTORY EIN, AUF DEM SICH DAS AUFGERUFENE
  6.    PROGRAMM BEFINDET
  7.   BEI  PROGRAMMENDE WIRD DAS URSPRÜNGLICHE DIRECTORY WIEDER SELEKTIERT
  8.  
  9.   PAUL SCHUBERT, ROTTWEILER STR.8, 6000 FRANKFURT 1, 069 / 231145
  10.  
  11.   DIESE VERSION NUR MIT TURBO PASCAL 4.0 BENUTZEN, WEIL UNTER VERSION
  12.   >= 5.0 DAS AUFFINDEN DES ZIELDIRECTORY VIEL EINFACHER IST !
  13. }
  14.  
  15. {$F+}
  16.  
  17. INTERFACE
  18.  
  19.  
  20. VAR   QUELLDIR,ZIELDIR : STRING[64];
  21.  
  22.  
  23. PROCEDURE SELECTDNOEXIT;
  24.  
  25.  
  26. IMPLEMENTATION
  27.  
  28.  
  29. TYPE  SOF    = RECORD O,S : WORD; END;
  30.       CHARR  = ARRAY[0..1] OF CHAR;
  31.  
  32. VAR   EXITSAVE  : POINTER;
  33.       I         : WORD;
  34.  
  35.  
  36. PROCEDURE SELECTDNOEXIT;
  37. BEGIN
  38.   EXITPROC := EXITSAVE;
  39. END;
  40.  
  41.  
  42. PROCEDURE MYEXIT;
  43. BEGIN
  44. {$I-}
  45.   CHDIR(QUELLDIR);
  46.   I := IORESULT;
  47. {$I+}
  48.   EXITPROC := EXITSAVE;
  49. END;
  50.  
  51.  
  52. PROCEDURE SUCHNAME;
  53. VAR   I    : WORD;
  54.       ENV  : ^CHARR;
  55. BEGIN
  56.   ENV := PTR(MEMW[PREFIXSEG:$2C],0);
  57.   ZIELDIR := '';
  58.   I := 0;
  59.   REPEAT
  60.     WHILE ENV^[I] <> #0 DO INC(I);
  61.     INC(I);
  62.   UNTIL (ENV^[I] = #0);
  63.   INC(I);
  64.   IF ENV^[I] <> #1 THEN EXIT;
  65.   INC(I);
  66.   IF ENV^[I] <> #0 THEN EXIT;
  67.   INC(I);
  68.   WHILE ENV^[I] <> #0 DO BEGIN
  69.     ZIELDIR := ZIELDIR + ENV^[I];
  70.     INC(I);
  71.   END;
  72. END; { SUCHNAME }
  73.  
  74.  
  75. BEGIN
  76.   GETDIR(0,QUELLDIR);
  77.   SUCHNAME;
  78.   I := LENGTH(ZIELDIR);
  79.   WHILE (I > 0) AND (ZIELDIR[I] <> '\') DO BEGIN
  80.     DELETE(ZIELDIR,I,1);
  81.     DEC(I);
  82.   END;
  83.   IF (LENGTH(ZIELDIR) <> 3)
  84.     THEN IF (I > 0) AND (ZIELDIR[I] = '\') THEN DELETE(ZIELDIR,I,1);
  85.   IF LENGTH(ZIELDIR) = 0 THEN ZIELDIR := QUELLDIR;
  86. {$I-}
  87.   CHDIR(ZIELDIR);
  88.   I := IORESULT;
  89. {$I+}
  90.   EXITSAVE := EXITPROC;
  91.   EXITPROC := @MYEXIT;
  92. END.
  93.  
  94.