home *** CD-ROM | disk | FTP | other *** search
/ On Disk Monthly 62 / odm62.zip / GDSOURCE.EXE / SD.PAS < prev    next >
Pascal/Delphi Source File  |  1991-10-14  |  3KB  |  120 lines
  1. {$A-,B-,D+,E+,F-,G-,I+,L+,N-,O-,R-,S+,V-,X-}
  2. {$M 16384,0,655360}
  3. program savedirectory;
  4.  
  5. USES dos, crt;
  6.  
  7. CONST DataFilename    = 'C:\PATHS.DAT';
  8.       MaximumPaths    = 840;
  9.       LastPath = 'ZZZZ\ZZZZ\ZZZZ\ZZZZ\ZZZZ\ZZZZ\ZZZZ';
  10.  
  11. VAR T        : text;
  12.     DTA      : searchrec;
  13.     NumPaths : integer;
  14.     Paths    : array [1..MaximumPaths] of DirStr;
  15.     DirGotten,
  16.     CurrPath,
  17.     SaveStr  : DirStr;
  18.     I        : integer;
  19.  
  20. FUNCTION ComparePaths(Path1, Path2: string): boolean;
  21. VAR PartialPath1,
  22.     PartialPath2: string;
  23.  
  24.   FUNCTION SlashPos(PathCheck:string):byte;
  25.   VAR Count: byte;
  26.   BEGIN
  27.     Count := Pos('\', PathCheck);
  28.     IF Count = 0 THEN
  29.       Count := Length(PathCheck)+1;
  30.     SlashPos := Count;
  31.   END;
  32.  
  33.   FUNCTION ParsePath(PathCheck:string): string;
  34.   VAR TempStr: string;
  35.   BEGIN
  36.     TempStr := copy(PathCheck, 1, SlashPos(PathCheck));
  37.     IF TempStr[Length(TempStr)] = '\' THEN
  38.       Dec(TempStr[0]);
  39.     ParsePath := TempStr;
  40.   END;
  41.  
  42. BEGIN
  43.   PartialPath1 := ParsePath(Path1);
  44.   PartialPath2 := ParsePath(Path2);
  45.   WHILE (PartialPath1 = PartialPath2) AND (PartialPath1<>'') DO
  46.   BEGIN
  47.     Delete(Path1, 1, SlashPos(Path1));
  48.     Delete(Path2, 1, SlashPos(Path2));
  49.     PartialPath1 := ParsePath(Path1);
  50.     PartialPath2 := ParsePath(Path2);
  51.   END;
  52.   ComparePaths := (PartialPath1 >= PartialPath2);
  53. END;
  54.  
  55. BEGIN
  56.   WriteLn('SAVE DIRECTORY Version 1.00 by George Leritte');
  57.   WriteLn('Copyright (c) 1991, Softdisk, Inc.');
  58.   Write(' ');
  59.   CurrPath := Fexpand('');
  60.   IF Length(CurrPath) > 3 THEN
  61.     Dec(CurrPath[0]);
  62.   SaveStr := CurrPath;
  63.   FindFirst(DataFilename, 32, DTA);
  64.   IF DosError <> 0 THEN
  65.   BEGIN
  66.     Assign(T, DataFilename);
  67.     Rewrite(T);
  68.     Close(T);
  69.   END;
  70.   DirGotten := CurrPath;
  71.   Assign(T, DataFilename);
  72.   Reset(T);
  73.   NumPaths := 0;
  74.   WHILE NOT Eof(T) AND (NumPaths<MaximumPaths) DO
  75.   BEGIN
  76.     Inc(NumPaths);
  77.     ReadLn(T, Paths[NumPaths]);
  78.     IF ComparePaths(CurrPath, Paths[NumPaths]) THEN
  79.     BEGIN
  80.       IF CurrPath = Paths[NumPaths] THEN
  81.       BEGIN
  82.         CurrPath := LastPath;
  83.       END;
  84.     END
  85.     ELSE
  86.     BEGIN
  87.       IF CurrPath <> '' THEN
  88.       BEGIN
  89.         Paths[NumPaths+1] := Paths[NumPaths];
  90.         Paths[NumPaths] := CurrPath;
  91.         Inc(NumPaths);
  92.         SaveStr := '';
  93.         CurrPath := '';
  94.       END;
  95.     END;
  96.   END;
  97.   Close(T);
  98.   IF CurrPath <> LastPath THEN
  99.   BEGIN
  100.     IF NumPaths >= MaximumPaths THEN
  101.       WriteLn('Too many paths in file.')
  102.     ELSE
  103.     BEGIN
  104.       IF SaveStr <> '' THEN
  105.       BEGIN
  106.         Inc(NumPaths);
  107.         Paths[NumPaths] := CurrPath;
  108.       END;
  109.       Assign(T, DataFilename);
  110.       Rewrite(T);
  111.       FOR I := 1 TO NumPaths DO
  112.         WriteLn(T, Paths[I]);
  113.       Close(T);
  114.       WriteLn('Directory '+DirGotten+' saved.');
  115.     END;
  116.   END
  117.   ELSE
  118.     WriteLn('Directory '+DirGotten+' already saved.');
  119. END.
  120.