home *** CD-ROM | disk | FTP | other *** search
/ The Pier Shareware 6 / The_Pier_Shareware_Number_6_(The_Pier_Exchange)_(1995).iso / 010 / jump20.zip / JUMP.PAS < prev    next >
Pascal/Delphi Source File  |  1994-10-18  |  3KB  |  114 lines
  1.  
  2. Program Jump20;
  3.  
  4. uses Dos, SetEnvir;
  5.  
  6. var 
  7.     S : PathStr;
  8.     P : PathStr;
  9.     D : DirStr;
  10.     N : NameStr;
  11.     E : ExtStr;
  12.     path  : string;
  13.     drive : string;
  14.     Err   : word;
  15.  
  16.     const
  17.           Note : string[55] =
  18.                 ' Compiled for the BatPower conference by David Adamson';
  19.  
  20. Procedure Error;
  21. Begin
  22.    Writeln(' Error. Out of environment memory?  Errorlevel exit: ',Err);
  23.    Halt(Err);
  24. end;
  25.  
  26. Function ReadUpToFirstColon(s:String): String;
  27.  
  28. Var
  29.     i: Word;
  30.     tempo: String;
  31.  
  32. Begin
  33.     i := Pos(':',s);
  34.     If i <> 0
  35.       Then
  36.          ReadUpToFirstColon := Copy(s,1,i-1)
  37.       Else
  38.          Begin
  39.             ReadUpToFirstColon := ''; {Function should always return something}
  40.          End;
  41. End;
  42.  
  43. Procedure Return;
  44. var
  45.    OLDRV, OLDIR : string;
  46. begin
  47. OLDRV := GetEnv('OLDRV');
  48. If OLDRV = '' then
  49.  begin
  50.   writeln(' Old drive not found in environment.');
  51.   Halt(2);
  52.  end;
  53. OLDIR := GetEnv('OLDIR');
  54. If OLDIR = '' then
  55.  begin
  56.   writeln(' Old directory not found in environment.');
  57.   Halt(2);
  58.  end;
  59. delete(OLDIR, 1, 2);
  60. {$I-}
  61. ChDir(OLDRV + OLDIR);
  62. {$I+}
  63. If IOresult <> 0 then
  64.  begin
  65.   writeln(' Unable to change back to old path.');
  66.   Halt(2);
  67.  end;
  68. Halt(0);
  69. end;
  70.  
  71. (* ================= PROGRAM  START =================================== *)
  72.  
  73. begin
  74.   if (paramStr(1) = 'R') or (paramStr(1) = 'r') then Return;
  75.  
  76.   if (paramcount >1) or (paramStr(1) = '/?') or (paramStr(1) = '-?')
  77.     then
  78.       begin
  79.         writeln;
  80.         writeln(' This is a program to insert the current drive and path into');
  81.         writeln(' the environment. Enter  JUMP  to save the current drive/path.');
  82.         writeln(' Enter  JUMP R  to return to the original drive and path.');
  83.       end;
  84.    S := 'NUL';
  85.    if S = ''
  86.       then
  87.          Halt(1)
  88.       else
  89.          S := FExpand(S);    {Find path for current dir by searching for "NUL"}
  90.     FSplit(S, D, N, E);      {Split drive and path}
  91.     Path  := D;
  92.     Drive := ReadUpToFirstColon(Path);
  93.     drive := drive + ':';
  94.     delete(Path,1,2);                 {Delete drive letter and colon}
  95.     delete(path,Length(path),1);      {Delete trailing back slash}
  96.     if path = ''
  97.       then
  98.          path := '\';
  99.     path := 'CD' + path;
  100.     SetEnv('OLDRV',drive);
  101.     Err := IOresult;
  102.     if Err <> 0
  103.       then
  104.          Error;
  105.     SetEnv('OLDIR',path);
  106.     Err := IOresult;
  107.       if Err <> 0
  108.        then
  109.          Error;
  110.     writeln(' %OLDRV% set to ',drive,' and %OLDIR% set to ',path);
  111.     Halt(Err);
  112. end.
  113.  
  114.