home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
On Disk Monthly 62
/
odm62.zip
/
GDSOURCE.EXE
/
GD.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-10-14
|
9KB
|
316 lines
{$A-,B-,D+,E+,F-,G-,I+,L+,N-,O-,R-,S+,V-,X-}
{$M 16384,0,655360}
program getdirectory;
USES dos, crt, pasqwik, functs, keyglob, strings;
CONST DataFilename = 'C:\PATHS.DAT';
MaximumPaths = 840;
DisplayAttr = $47;
DisplayAttrBrdr = $4F;
HighlightAttr = $58;
Shadow = 1;
PressAKey = 'Press A Key';
VAR T : text;
DTA : searchrec;
NumPaths : integer;
Paths : array [1..MaximumPaths] of dirstr;
DirGotten,
CurrPath : DirStr;
SrchStr : string;
I : integer;
MaxDisplay,
MaxLength : byte;
OldCurrent,
Current,
OldTop,
Top : integer;
Row, Col,
Rows, Cols : integer;
SaveExit : pointer;
VidBuffer : array [0..4005] of byte;
FUNCTION InRange(N, N1, N2: integer): boolean;
BEGIN
InRange := (N >= N1) AND (N <= N2);
END;
PROCEDURE MoveCurrent;
VAR Direction : integer;
BEGIN
Direction := IntSgn(Current - Rows);
WHILE NOT InRange(Current, 1, Rows) DO
BEGIN
Dec(Current, Direction);
Inc(Top, Direction);
END;
END;
PROCEDURE DisplayPaths;
BEGIN
FOR I := 1 TO IntMin(Rows, NumPaths) DO
BEGIN
QwriteS(Row + I, Succ(Succ(Col)), PadSpaces(Paths[I + Pred(Top)], Cols));
END;
END;
CONST InfoTall = 15;
InfoStringLength = 46;
InfoAttr = $2E;
CONST InfoLines : array [3..InfoTall - 4] of string[InfoStringLength] =
('Get Directory (GD) is part of a four program ',
'set. The second one is Save Directory (SD). ',
'When run, SD reads the current directory and ',
'saves it for later restoration. The third ',
'and fourth are Push Directory (PUSHDIR) and ',
'Pop Directory (POPDIR). PUSHDIR saves the ',
'current directory last and POPDIR restores the',
'last saved directory. These last two are ',
'are especially useful in batch files. ');
PROCEDURE DisplayInfo;
VAR I : integer;
Hcol,
Hcols : integer;
Hrow : integer;
SaveArea : pointer;
ImgSize : word;
B : byte;
BEGIN
Hrow := (CRTrows - InfoTall) shr 1;
B := ByteMax(MaxLength, InfoStringLength);
Hcol := Pred(CRTcolumns - B) shr 1;
Hcols := B;
ImgSize := TextImageSize(InfoTall + Shadow, Hcols + 4 + Shadow);
GetMem(SaveArea, ImgSize);
TextGet(Hrow, Hcol, InfoTall + Shadow, Hcols + 4 + Shadow, SaveArea^);
ShadowedBox(Hrow, Hcol, InfoTall, Hcols + 4, InfoAttr, InfoAttr, DoubleBox, Shadow);
QwriteC(Hrow + 1, Hcol, Hcol + Hcols + 4, SameAttr, 'Get Directory Info');
FOR I := 3 TO InfoTall - 4 DO
QwriteS(Hrow + I, Hcol + 2, InfoLines[I]);
QwriteC(Hrow + InfoTall - 2, Hcol, Hcol + Hcols + 4, SameAttr, PressAKey);
B := GetKey;
TextPut(Hrow, Hcol, SaveArea^);
FreeMem(SaveArea, ImgSize);
END;
CONST HelpTall = 16;
HelpStringLength = 34;
HelpAttr = $1B;
CONST HelpLines : array [3..HelpTall - 4] of string[HelpStringLength] =
('Keypad keys move cursor. ',
'Enter changes to highlighted ',
' subdirectory. ',
'ESC exits without changing. ',
'Del deletes highlighted entry from',
' the list. ',
'F2 displays information. ',
'',
'When run, GD will search the list ',
' for command line parameters.'
);
PROCEDURE DisplayHelp;
VAR I : integer;
Hcol,
Hcols : integer;
Hrow : integer;
SaveArea : pointer;
ImgSize : word;
B : byte;
BEGIN
Hrow := (CRTrows - HelpTall) shr 1;
B := ByteMax(MaxLength, HelpStringLength);
Hcol := Pred(CRTcolumns - B) shr 1;
Hcols := B;
ImgSize := TextImageSize(HelpTall + Shadow, Hcols + 4 + Shadow);
GetMem(SaveArea, ImgSize);
TextGet(Hrow, Hcol, HelpTall + Shadow, Hcols + 4 + Shadow, SaveArea^);
ShadowedBox(Hrow, Hcol, HelpTall, Hcols + 4, HelpAttr, HelpAttr, DoubleBox, Shadow);
QwriteC(Hrow + 1, Hcol, Hcol + Hcols + 4, SameAttr, 'Get Directory Help');
FOR I := 3 TO HelpTall - 4 DO
QwriteS(Hrow + I, Hcol + 2, HelpLines[I]);
QwriteC(Hrow + HelpTall - 2, Hcol, Hcol + Hcols + 4, SameAttr, PressAKey);
B := GetKey;
TextPut(Hrow, Hcol, SaveArea^);
FreeMem(SaveArea, ImgSize);
END;
PROCEDURE WriteSDMessage;
BEGIN
WriteLn('No Paths saved. ');
WriteLn(' Use SD to save paths.');
WriteLn(' Change to the paths you want saved and enter SD.');
WriteLn(' SD will read the current directory and save it in a');
WriteLn(' sorted list. It should be done in the normal course');
WriteLn(' of working on your computer.');
END;
{$F+}
PROCEDURE DoExit;
BEGIN
ExitProc := SaveExit;
IF ExitCode <> 0 THEN
BEGIN
IF VidBuffer[0] <> 0 THEN
TextPut(Row, Col, VidBuffer);
WriteLn('Directory ' + DirGotten + ' invalid.');
ExitCode := 0;
ErrorAddr := NIL;
END;
END;
{$F-}
BEGIN
SaveExit := ExitProc;
ExitProc := @DoExit;
MaxDisplay := CRTrows - 7;
WriteLn('GET DIRECTORY Version 1.00 by George Leritte');
WriteLn('Copyright (c) 1991, Softdisk, Inc.');
CurrPath := Fexpand('');
IF ParamCount > 0 THEN
SrchStr := UpperCase(paramstr(1))
ELSE
SrchStr := '';
WriteLn('Current directory: ', CurrPath);
Write(' ');
FillChar(Paths, SizeOf(Paths), #0);
FillChar(VidBuffer, SizeOf(VidBuffer), #0);
IF CurrPath <> '' THEN
CurrPath := Copy(CurrPath, 1, Length(CurrPath) - 1);
FindFirst(DataFilename, 32, DTA);
IF DosError <> 0 THEN
BEGIN
Assign(T, DataFilename);
Rewrite(T);
Close(T);
WriteSDMessage;
Exit;
END;
Assign(T, DataFilename);
Reset(T);
NumPaths := 0;
MaxLength := 0;
Current := 0;
WHILE NOT Eof(T) AND (NumPaths<MaximumPaths) DO
BEGIN
Inc(NumPaths);
ReadLn(T, Paths[NumPaths]);
IF SrchStr <> '' THEN
IF (Current = 0) AND (Pos(SrchStr, Paths[NumPaths]) > 0) THEN
Current := NumPaths;
MaxLength := ByteMax(MaxLength, Length(Paths[NumPaths]));
END;
Close(T);
IF Current = 0 THEN
BEGIN
I := 0;
WHILE I <= NumPaths DO
BEGIN
IF (CurrPath = Paths[I]) THEN
Current := I;
Inc(I);
END;
END;
MaxLength := ByteMax(MaxLength, 22);
IF NumPaths = 0 THEN
BEGIN
WriteSDMessage;
Exit;
END;
Rows := NumPaths;
Rows := ByteMin(Rows, MaxDisplay);
Col := Pred(CRTcolumns - MaxLength) shr 1;
Cols := MaxLength;
Row := (CRTrows - Rows) shr 1;
TextGet(Row, Col, Rows + 2 + Shadow, Cols + 4 + Shadow, VidBuffer);
ShadowedBox(Row, Col, Rows + 2, Cols + 4, DisplayAttr, DisplayAttrBrdr, SingleBox, Shadow);
QwriteC(Row + Rows + 1, Col, Col + Cols + 3, SameAttr, ' F1-Help ─ F2-Info ');
IF Current = 0 THEN
Current := 1;
Top := 1;
MoveCurrent;
DisplayPaths;
GlobKey := nokey;
WHILE (GlobKey <> ESCky) AND (GlobKey <> CRkey) AND (GlobKey <> DELKY) DO
BEGIN
QxorAttr(Row + Current, Succ(Col), 1, Cols + 2, HighlightAttr);
OldCurrent := Current;
OldTop := Top;
GlobKey := GetKey;
QxorAttr(Row + Current, Succ(Col), 1, Cols + 2, HighlightAttr);
CASE GlobKey of
UPARR : Dec(Current);
DNARR : Inc(Current);
HOMKY : BEGIN
Top := 1;
Current := 1;
END;
ENDKY : BEGIN
Top := NumPaths - Pred(Rows);
Current := Rows;
END;
PGUPK : Top := Top - Rows;
PGDNK : Top := Top + Rows;
DELKY : DirGotten := Paths[Pred(Current + Top)];
CRKEY : BEGIN
DirGotten := Paths[Pred(Current + Top)];
ChDir(DirGotten);
END;
F1 : DisplayHelp;
F2 : DisplayInfo;
END; {CASE}
MoveCurrent;
IF Top <= 0 THEN
BEGIN
IF Current = 1 THEN
BEGIN
Current := Rows;
Top := NumPaths - Pred(Rows);
END
ELSE
BEGIN
Current := 1;
Top := 1;
END;
END;
IF Top > (NumPaths - Pred(Rows)) THEN
BEGIN
IF Current = Rows THEN
BEGIN
Current := 1;
Top := 1;
END
ELSE
BEGIN
Current := Rows;
Top := NumPaths - Pred(Rows);
END;
END;
IF OldTop <> Top THEN
BEGIN
DisplayPaths;
END;
END;
TextPut(Row, Col, VidBuffer);
IF GlobKey = CRkey THEN
WriteLn('Directory ' + DirGotten + ' restored.')
ELSE
IF GlobKey = ESCky THEN
WriteLn('No Change')
ELSE
BEGIN
Assign(T, DataFilename);
Rewrite(T);
FOR I := 1 TO NumPaths DO
BEGIN
IF I <> Pred(Current + Top) THEN
WriteLn(T, Paths[I]);
END;
Close(T);
WriteLn('Directory ' + DirGotten + ' removed');
END;
END.