home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 02 / tricks / j.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-11-14  |  1.5 KB  |  58 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      J.PAS                             *)
  3. (*     (c) 1989  Christoph Steindorff & TOOLBOX           *)
  4. (* ------------------------------------------------------ *)
  5. PROGRAM Jump;
  6.  
  7. {$D-,A-,I-,L-,N+,E-,O-,R-,S-}
  8.                    (* wenig CODE und hohe Geschwindigkeit *)
  9. USES Dos;
  10.  
  11. VAR
  12.   Directory : STRING[80];
  13.   Found     : BOOLEAN;
  14.   y         : INTEGER;
  15.   Regs      : Registers;
  16.   d         : CHAR;
  17.  
  18.   PROCEDURE FindDir(Path : STRING);
  19.   VAR
  20.     SDir: SearchRec;
  21.   BEGIN
  22.     FindFirst(Path + '/*.*', $10, SDir);
  23.     WHILE (DosError <> 18) AND (found = FALSE) DO BEGIN
  24.       IF (SDir.Attr = $10) AND
  25.          (SDir.Name[1] <> '.') THEN BEGIN
  26.         IF SDir.Name = Directory THEN BEGIN
  27.           ChDir(d + ':\');
  28.           ChDir(Path + '/' + SDir.Name);
  29.           Found := TRUE;
  30.         END;
  31.         FindDir(Path + '/' + SDir.Name);
  32.       END;
  33.       FindNext(SDir);
  34.     END;
  35.   END;
  36.  
  37. BEGIN
  38.   Regs.ah := $19;
  39.   MsDos(Regs);
  40.   d := Chr(Regs.al + 65);
  41.   found := TRUE;
  42.   Directory := ParamStr(1);
  43.   IF Directory = '' THEN
  44.     ChDir(d + ':\')
  45.   ELSE BEGIN
  46.     found := FALSE;
  47.     FOR y := 1 TO 8 DO Directory[y] := UpCase(Directory[y]);
  48.     FindDir(d + ':');
  49.   END;
  50.   IF NOT found THEN
  51.     WriteLn('Verzeichnis nicht vorhanden...')
  52.   ELSE BEGIN
  53.     GetDir(0, Directory);
  54.     WriteLn('Verzeichnis ', Directory);
  55.   END;
  56. END.
  57. (* ------------------------------------------------------ *)
  58. (*                  Ende von J.PAS                        *)