home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 11 / dirlib / dirdemo2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-08-30  |  3.2 KB  |  85 lines
  1. PROGRAM DirDemo2;
  2.  
  3. CONST
  4.   (*$I DIRCONST.PAS *)
  5. TYPE
  6.   (*$I DIRMTTYP.PAS *)                  (* bzw. DIRCPTYP.PAS fuer CP/M 3.0 *)
  7. VAR
  8.   (*$I DIRVAR.PAS *)
  9.   ch   : CHAR;
  10.   path, oldpth  : Dir_Str;
  11.   drive, olddrv : INTEGER;
  12.  
  13. (*$I DIRMT.TUR *)    (* bzw. DIRMT.PSP fuer Atari, DIRCP.TUR fuer CP/M 3.0 *)
  14. (*$I DIRMTDTA.PAS *) (* bzw. DIRCPDTA.PAS fuer CP/M 3.0                    *)
  15. (*$I DIRLIB.PAS *)
  16. (* ----------------------------------------------------------------------- *)
  17. PROCEDURE error;
  18. BEGIN
  19.   WriteLn;  Write('**** ');
  20.   CASE DirResult OF
  21.     DOSfnok  : Write('OK');
  22.     DOSfilnf : Write('Datei nicht gefunden');
  23.     DOSpthnf : Write('Pfad nicht gefunden');
  24.     DOSaccdn : Write('Zugriff abgelehnt');
  25.     DOSedriv : Write('ungueltiges Laufwerk');
  26.     DOSrmcur : Write('aktuelles Verzeichnis kann nicht geloescht werden');
  27.     DOSnmfil : Write('keine weiteren Dateien');
  28.     ELSE       Write('unbekannter Fehler: ',DirResult);
  29.   END;
  30.   Write(' ****');  WriteLn;
  31. END;
  32. (* ----------------------------------------------------------------------- *)
  33. PROCEDURE DoDir;
  34. VAR i: INTEGER;
  35. BEGIN
  36.   WriteLn; WriteLn(DriveChar(GetDrive),':',path); WriteLn;
  37.   Dir('*.*',DirRO+DirDir,Directory);  SortDir(DirName,Directory);
  38.   WITH Directory DO
  39.     FOR i := 1 TO num DO BEGIN
  40.       WITH items[i] DO BEGIN
  41.         IF attr = DirDir THEN Write('<D> ') ELSE Write('    ');
  42.         Write(name, '.', ext,'  ');
  43.       END;
  44.       IF i MOD 4 = 0 THEN WriteLn;
  45.     END;
  46.   WriteLn;
  47. END;
  48. (* ----------------------------------------------------------------------- *)
  49. PROCEDURE DoChDir;
  50. BEGIN  Write('neuer Pfad: ');  ReadLn(path);  ChDir(path);  END;
  51. (* ----------------------------------------------------------------------- *)
  52. PROCEDURE DoMkDir;
  53. BEGIN  Write('neues Verzeichniss (Pfad): '); ReadLn(path); MkDir(path);  END;
  54. (* ----------------------------------------------------------------------- *)
  55. PROCEDURE DoRmDir;
  56. BEGIN
  57.   Write('zu loeschendes Verzeichnis (Pfad): ');  ReadLn(path);  RmDir(path);
  58. END;
  59. (* ----------------------------------------------------------------------- *)
  60. PROCEDURE DoChDrive;
  61. BEGIN  Write('neues Laufwerk: ');  ReadLn(ch);  ChDrive(DriveNum(ch));  END;
  62. (* ----------------------------------------------------------------------- *)
  63. BEGIN
  64.   NewDirDTA;                      (* DTA fuer Directory-Funktionen anlegen *)
  65.   (* Bei Programmende Wechsel auf altes Laufwerk und Verzeichnis ermoegl.: *)
  66.   olddrv := GetDrive;  GetDir(0, oldpth);
  67.   REPEAT
  68.     GetDir(0, path);                               (* Wo sind wir gerade ? *)
  69.     WriteLn; WriteLn('Laufwerk: ', DriveChar(GetDrive));
  70.     WriteLn('Pfad    : ',path);
  71.     WriteLn('Frei    : ',DiskFree(0):0:0,' Bytes');
  72.     WriteLn;
  73.     Write('D)ir  C)hDir  M)kDir  R)mDir  CH)Drive  Q)uit  ? ');
  74.     ReadLn(ch);   ch := UpCase(ch);
  75.     CASE ch OF
  76.       'D' : DoDir;    'C' : DoChDir;   'M' : DoMkDir;   'R' : DoRmDir;
  77.       'H' : DoChDrive;
  78.       ELSE;
  79.     END;
  80.     IF ch <> 'Q' THEN error;
  81.   UNTIL ch = 'Q';
  82.   ChDrive(olddrv);  ChDir(oldpth);
  83.   DispDirDTA;                (* eigene DTA wird nicht mehr gebraucht, kann *)
  84. END.                         (* entfallen, da sowieso Programm zu ende!    *)
  85.