home *** CD-ROM | disk | FTP | other *** search
/ On Disk Monthly 62 / odm62.zip / GDSOURCE.EXE / GD.PAS < prev    next >
Pascal/Delphi Source File  |  1991-10-14  |  9KB  |  316 lines
  1. {$A-,B-,D+,E+,F-,G-,I+,L+,N-,O-,R-,S+,V-,X-}
  2. {$M 16384,0,655360}
  3. program getdirectory;
  4.  
  5. USES  dos, crt, pasqwik, functs, keyglob, strings;
  6.  
  7. CONST DataFilename    = 'C:\PATHS.DAT';
  8.       MaximumPaths    = 840;
  9.       DisplayAttr     = $47;
  10.       DisplayAttrBrdr = $4F;
  11.       HighlightAttr   = $58;
  12.       Shadow          = 1;
  13.       PressAKey       = 'Press A Key';
  14.  
  15. VAR  T          : text;
  16.      DTA        : searchrec;
  17.      NumPaths   : integer;
  18.      Paths      : array [1..MaximumPaths] of dirstr;
  19.      DirGotten,
  20.      CurrPath   : DirStr;
  21.      SrchStr    : string;
  22.      I          : integer;
  23.      MaxDisplay,
  24.      MaxLength  : byte;
  25.      OldCurrent,
  26.      Current,
  27.      OldTop,
  28.      Top        : integer;
  29.      Row, Col,
  30.      Rows, Cols : integer;
  31.      SaveExit   : pointer;
  32.      VidBuffer  : array [0..4005] of byte;
  33.  
  34. FUNCTION InRange(N, N1, N2: integer): boolean;
  35. BEGIN
  36.   InRange := (N >= N1) AND (N <= N2);
  37. END;
  38.  
  39. PROCEDURE MoveCurrent;
  40. VAR  Direction : integer;
  41. BEGIN
  42.   Direction := IntSgn(Current - Rows);
  43.   WHILE NOT InRange(Current, 1, Rows) DO
  44.   BEGIN
  45.     Dec(Current, Direction);
  46.     Inc(Top, Direction);
  47.   END;
  48. END;
  49.  
  50. PROCEDURE DisplayPaths;
  51. BEGIN
  52.   FOR I := 1 TO IntMin(Rows, NumPaths) DO
  53.   BEGIN
  54.     QwriteS(Row + I, Succ(Succ(Col)), PadSpaces(Paths[I + Pred(Top)], Cols));
  55.   END;
  56. END;
  57.  
  58. CONST InfoTall = 15;
  59.       InfoStringLength = 46;
  60.       InfoAttr = $2E;
  61. CONST InfoLines : array [3..InfoTall - 4] of string[InfoStringLength] =
  62.                 ('Get Directory (GD) is part of a four program  ',
  63.                  'set.  The second one is Save Directory (SD).  ',
  64.                  'When run, SD reads the current directory and  ',
  65.                  'saves it for later restoration.  The third    ',
  66.                  'and fourth are Push Directory (PUSHDIR) and   ',
  67.                  'Pop Directory (POPDIR).  PUSHDIR saves the    ',
  68.                  'current directory last and POPDIR restores the',
  69.                  'last saved directory.  These last two are     ',
  70.                  'are especially useful in batch files.         ');
  71.  
  72. PROCEDURE DisplayInfo;
  73. VAR  I        : integer;
  74.      Hcol,
  75.      Hcols    : integer;
  76.      Hrow     : integer;
  77.      SaveArea : pointer;
  78.      ImgSize  : word;
  79.      B        : byte;
  80. BEGIN
  81.   Hrow := (CRTrows - InfoTall) shr 1;
  82.   B := ByteMax(MaxLength, InfoStringLength);
  83.   Hcol := Pred(CRTcolumns - B) shr 1;
  84.   Hcols := B;
  85.   ImgSize := TextImageSize(InfoTall + Shadow, Hcols + 4 + Shadow);
  86.   GetMem(SaveArea, ImgSize);
  87.   TextGet(Hrow, Hcol, InfoTall + Shadow, Hcols + 4 + Shadow, SaveArea^);
  88.   ShadowedBox(Hrow, Hcol, InfoTall, Hcols + 4, InfoAttr, InfoAttr, DoubleBox, Shadow);
  89.   QwriteC(Hrow + 1, Hcol, Hcol + Hcols + 4, SameAttr, 'Get Directory Info');
  90.   FOR I := 3 TO InfoTall - 4 DO
  91.     QwriteS(Hrow + I, Hcol + 2, InfoLines[I]);
  92.   QwriteC(Hrow + InfoTall - 2, Hcol, Hcol + Hcols + 4, SameAttr, PressAKey);
  93.   B := GetKey;
  94.   TextPut(Hrow, Hcol, SaveArea^);
  95.   FreeMem(SaveArea, ImgSize);
  96. END;
  97.  
  98. CONST HelpTall         = 16;
  99.       HelpStringLength = 34;
  100.       HelpAttr         = $1B;
  101. CONST HelpLines : array [3..HelpTall - 4] of string[HelpStringLength] =
  102.                 ('Keypad keys move cursor.          ',
  103.                  'Enter changes to highlighted      ',
  104.                  '   subdirectory.                  ',
  105.                  'ESC exits without changing.       ',
  106.                  'Del deletes highlighted entry from',
  107.                  '   the list.                      ',
  108.                  'F2 displays information.          ',
  109.                  '',
  110.                  'When run, GD will search the list ',
  111.                  '   for command line parameters.'
  112.                  );
  113.  
  114. PROCEDURE DisplayHelp;
  115. VAR  I        : integer;
  116.      Hcol,
  117.      Hcols    : integer;
  118.      Hrow     : integer;
  119.      SaveArea : pointer;
  120.      ImgSize  : word;
  121.      B        : byte;
  122. BEGIN
  123.   Hrow := (CRTrows - HelpTall) shr 1;
  124.   B := ByteMax(MaxLength, HelpStringLength);
  125.   Hcol := Pred(CRTcolumns - B) shr 1;
  126.   Hcols := B;
  127.   ImgSize := TextImageSize(HelpTall + Shadow, Hcols + 4 + Shadow);
  128.   GetMem(SaveArea, ImgSize);
  129.   TextGet(Hrow, Hcol, HelpTall + Shadow, Hcols + 4 + Shadow, SaveArea^);
  130.   ShadowedBox(Hrow, Hcol, HelpTall, Hcols + 4, HelpAttr, HelpAttr, DoubleBox, Shadow);
  131.   QwriteC(Hrow + 1, Hcol, Hcol + Hcols + 4, SameAttr, 'Get Directory Help');
  132.   FOR I := 3 TO HelpTall - 4 DO
  133.     QwriteS(Hrow + I, Hcol + 2, HelpLines[I]);
  134.   QwriteC(Hrow + HelpTall - 2, Hcol, Hcol + Hcols + 4, SameAttr, PressAKey);
  135.   B := GetKey;
  136.   TextPut(Hrow, Hcol, SaveArea^);
  137.   FreeMem(SaveArea, ImgSize);
  138. END;
  139.  
  140. PROCEDURE WriteSDMessage;
  141. BEGIN
  142.   WriteLn('No Paths saved.  ');
  143.   WriteLn('  Use SD to save paths.');
  144.   WriteLn('  Change to the paths you want saved and enter SD.');
  145.   WriteLn('  SD will read the current directory and save it in a');
  146.   WriteLn('  sorted list.  It should be done in the normal course');
  147.   WriteLn('  of working on your computer.');
  148. END;
  149.  
  150. {$F+}
  151. PROCEDURE DoExit;
  152. BEGIN
  153.   ExitProc := SaveExit;
  154.   IF ExitCode <> 0 THEN
  155.   BEGIN
  156.     IF VidBuffer[0] <> 0 THEN
  157.       TextPut(Row, Col, VidBuffer);
  158.     WriteLn('Directory ' + DirGotten + ' invalid.');
  159.     ExitCode := 0;
  160.     ErrorAddr := NIL;
  161.   END;
  162. END;
  163. {$F-}
  164.  
  165. BEGIN
  166.   SaveExit := ExitProc;
  167.   ExitProc := @DoExit;
  168.   MaxDisplay := CRTrows - 7;
  169.   WriteLn('GET DIRECTORY Version 1.00 by George Leritte');
  170.   WriteLn('Copyright (c) 1991, Softdisk, Inc.');
  171.   CurrPath := Fexpand('');
  172.   IF ParamCount > 0 THEN
  173.     SrchStr := UpperCase(paramstr(1))
  174.   ELSE
  175.     SrchStr := '';
  176.   WriteLn('Current directory:  ', CurrPath);
  177.   Write(' ');
  178.   FillChar(Paths, SizeOf(Paths), #0);
  179.   FillChar(VidBuffer, SizeOf(VidBuffer), #0);
  180.   IF CurrPath <> '' THEN
  181.     CurrPath := Copy(CurrPath, 1, Length(CurrPath) - 1);
  182.   FindFirst(DataFilename, 32, DTA);
  183.   IF DosError <> 0 THEN
  184.   BEGIN
  185.     Assign(T, DataFilename);
  186.     Rewrite(T);
  187.     Close(T);
  188.     WriteSDMessage;
  189.     Exit;
  190.   END;
  191.   Assign(T, DataFilename);
  192.   Reset(T);
  193.   NumPaths := 0;
  194.   MaxLength := 0;
  195.   Current := 0;
  196.   WHILE NOT Eof(T) AND (NumPaths<MaximumPaths) DO
  197.   BEGIN
  198.     Inc(NumPaths);
  199.     ReadLn(T, Paths[NumPaths]);
  200.     IF SrchStr <> '' THEN
  201.       IF (Current = 0) AND (Pos(SrchStr, Paths[NumPaths]) > 0) THEN
  202.         Current := NumPaths;
  203.     MaxLength := ByteMax(MaxLength, Length(Paths[NumPaths]));
  204.   END;
  205.   Close(T);
  206.   IF Current = 0 THEN
  207.   BEGIN
  208.     I := 0;
  209.     WHILE I <= NumPaths DO
  210.     BEGIN
  211.       IF (CurrPath = Paths[I]) THEN
  212.         Current := I;
  213.       Inc(I);
  214.     END;
  215.   END;
  216.   MaxLength := ByteMax(MaxLength, 22);
  217.   IF NumPaths = 0 THEN
  218.   BEGIN
  219.     WriteSDMessage;
  220.     Exit;
  221.   END;
  222.   Rows := NumPaths;
  223.   Rows := ByteMin(Rows, MaxDisplay);
  224.   Col := Pred(CRTcolumns - MaxLength) shr 1;
  225.   Cols := MaxLength;
  226.   Row := (CRTrows - Rows) shr 1;
  227.   TextGet(Row, Col, Rows + 2 + Shadow, Cols + 4 + Shadow, VidBuffer);
  228.   ShadowedBox(Row, Col, Rows + 2, Cols + 4, DisplayAttr, DisplayAttrBrdr, SingleBox, Shadow);
  229.   QwriteC(Row + Rows + 1, Col, Col + Cols + 3, SameAttr, ' F1-Help ─ F2-Info ');
  230.   IF Current = 0 THEN
  231.     Current := 1;
  232.   Top := 1;
  233.   MoveCurrent;
  234.   DisplayPaths;
  235.   GlobKey := nokey;
  236.   WHILE (GlobKey <> ESCky) AND (GlobKey <> CRkey) AND (GlobKey <> DELKY) DO
  237.   BEGIN
  238.     QxorAttr(Row + Current, Succ(Col), 1, Cols + 2, HighlightAttr);
  239.     OldCurrent := Current;
  240.     OldTop := Top;
  241.     GlobKey := GetKey;
  242.     QxorAttr(Row + Current, Succ(Col), 1, Cols + 2, HighlightAttr);
  243.     CASE GlobKey of
  244.          UPARR : Dec(Current);
  245.          DNARR : Inc(Current);
  246.          HOMKY : BEGIN
  247.                   Top := 1;
  248.                   Current := 1;
  249.                 END;
  250.          ENDKY : BEGIN
  251.                   Top := NumPaths - Pred(Rows);
  252.                   Current := Rows;
  253.                 END;
  254.          PGUPK : Top := Top - Rows;
  255.          PGDNK : Top := Top + Rows;
  256.          DELKY : DirGotten := Paths[Pred(Current + Top)];
  257.          CRKEY : BEGIN
  258.                   DirGotten := Paths[Pred(Current + Top)];
  259.                   ChDir(DirGotten);
  260.                 END;
  261.          F1    : DisplayHelp;
  262.          F2    : DisplayInfo;
  263.     END; {CASE}
  264.     MoveCurrent;
  265.     IF Top <= 0 THEN
  266.     BEGIN
  267.       IF Current = 1 THEN
  268.       BEGIN
  269.         Current := Rows;
  270.         Top := NumPaths - Pred(Rows);
  271.       END
  272.       ELSE
  273.       BEGIN
  274.         Current := 1;
  275.         Top := 1;
  276.       END;
  277.     END;
  278.     IF Top > (NumPaths - Pred(Rows)) THEN
  279.     BEGIN
  280.       IF Current = Rows THEN
  281.       BEGIN
  282.         Current := 1;
  283.         Top := 1;
  284.       END
  285.       ELSE
  286.       BEGIN
  287.         Current := Rows;
  288.         Top := NumPaths - Pred(Rows);
  289.       END;
  290.     END;
  291.     IF OldTop <> Top THEN
  292.     BEGIN
  293.       DisplayPaths;
  294.     END;
  295.   END;
  296.  
  297.   TextPut(Row, Col, VidBuffer);
  298.   IF GlobKey = CRkey THEN
  299.     WriteLn('Directory ' + DirGotten + ' restored.')
  300.   ELSE
  301.     IF GlobKey = ESCky THEN
  302.       WriteLn('No Change')
  303.     ELSE
  304.     BEGIN
  305.       Assign(T, DataFilename);
  306.       Rewrite(T);
  307.       FOR I := 1 TO NumPaths DO
  308.       BEGIN
  309.         IF I <> Pred(Current + Top) THEN
  310.           WriteLn(T, Paths[I]);
  311.       END;
  312.       Close(T);
  313.       WriteLn('Directory ' + DirGotten + ' removed');
  314.     END;
  315. END.
  316.