Category : Pascal Source Code
Archive   : TPDDIR.ZIP
Filename : TPDIR.CH2

 
Output of file : TPDIR.CH2 contained in archive : TPDDIR.ZIP


{ This file contains the changes to make to allow the TpDir unit to show
(and allow the user to chose among) the disk drives if the current dir
is the root. I have included a number of lines before and after each
change, to make it easy to find and insert the changes. All changes
are surrounded by $IFDEF .. $ENDIF pairs, so you can easily turn the change
on or off. The first changes are near the top of the file, which I show
intact. Note that this version contains a number of additional changes
provided by Duane Fahey of LookOut Inc, which I am happy to include. If
someone has a better way to distribute changes like these (neither this
format nor the output of DIFF are entirely satisfactory), I would like
to hear it! }

{$S-,R-,V-,I-,B-,F+}

{$IFNDEF Ver40}
{$I OPLUS.INC}
{$ENDIF}

{Conditional defines that may affect this unit}
{$I TPDEFINE.INC}

{$DEFINE ShowDrives} { disable this conditional compilation directive to not
allow drive changes. }

{$IFDEF AllowDateTime} { can only show volume names and file attributes if
we are showing file date and time as well. }

{$IFDEF ShowDrives} {$DEFINE ShowVolumes} {$ENDIF}
{ only show volumes if showing drives and this $DEFINE directive enabled }

{$DEFINE ShowAttrs} { disable this directive to not show file attributes }
{$ENDIF}

{*********************************************************}
{* TPDIR.PAS 5.08 *}
{* Copyright (c) TurboPower Software 1987. *}
{* Portions copyright (c) Sunny Hill Software 1985, 1986 *}
{* and used under license to TurboPower Software *}
{* All rights reserved. *}
{*********************************************************}

unit TpDir;
{-Use a pick window to select a filename}

{ Modified to allow a user to change drives if looking at the root of the
current drive. This may be enabled/disabled both in compilation (by
defining or not the conditional compilation symbol ShowDrives) and at
run-time (by setting the boolean variable ShowDrives - the default is False,
so that the modified TpDir routines work exactly as before). These changes
made by David Doty, FM Software 2 Dec 89. In addition, the programmer can
specify which drives are assumed by default to be available (e.g., A and B)
- this prevents the code from testing the existence of such drives (which
will prevent DOS from trying to access a possibly-empty floppy drive). This
is set by changing the variable DrivesNotToCheck.

I would like to acknowledge Duane Fahey of LookOut Inc. for the following
additional changes which he graciously provided. These changes may be
used or not as desired using the additional conditional compilation
symbols ShowVolumes to show drive volume labels and ShowAttrs to put
System, Hidden, and Read-only files in a special high-light color (the
same as for directories).

1: Since you can not change to the current drive, it will not be
displayed in the list of drives to change to.

2: At programmer option, the user could change drives from any directory.
Set new variables ShowDrivesAny and ShowDrives to TRUE. This is turned
off by default.

3: MS Windows shows drive names as [C] or [D]. To conform with GUI
standards, set BracketDrives to true (this is the default - the other
convention I made up arbitrarily).

4: When ShowSizeDateTime is true and ShowVolumes is true, the volume label of
the hard drives will be displayed. Floppy drive labels will be
. This may be excluded from the code by using the
ShowVolumes directive. If included, it is on by default.

5: When ShowFileAttr is true, the letters ASHR will be displayed at the
far right of the file listing to indicate the Attribute, System, Hidden,
or ReadOnly attributes. This is turned off by default, and may be
excluded from the code using the ShowAttrs directive.

6: When AltColorFileAttr is true, any file which is a Hidden, System, or
ReadOnly will be colored the same as directories to enhance that
they are minority files. This is turned off by default.

Modifications copyright (c) TurboPower Software 1990 - all rights reserved }

interface

...

DatePicture : string[12] = 'Mm/dd/yy'; {Format for file date}
TimePicture : string[12] = 'Hh:mmt'; {Format for file time}
{$ENDIF}

{$IFDEF ShowDrives}
ShowDrives : BOOLEAN = FALSE; { true to allow changing drives in root }
ShowDrivesAny : BOOLEAN = FALSE; { true to allow changing drives anywhere }
BracketDrives : BOOLEAN = TRUE; { true to show drive as [C] like other UI's }
{$ENDIF} {ShowDrives}

{$IFDEF ShowVolumes}
ShowVolumes : BOOLEAN = FALSE; { true to show volume label on hard drives}
{$ENDIF} {ShowVolumes}

{$IFDEF ShowAttrs}
ShowFileAttr : BOOLEAN = FALSE; {True to display files Attributes}
AltColorFileAttr : BOOLEAN = FALSE; {True to display RHS files in Alt Attr}
{$ENDIF}

{--------------------------------------------------------------------}

...

function CompleteFileName(Name : string) : string;
{-Convert a potentially relative file name into a complete one}

{$IFDEF ShowDrives} {-------------------------------------------}

TYPE
DriveLetterType = 'A' .. 'Z';
DriveLetterSet = SET OF DriveLetterType;
CONST
DrivesNotToCheck : DriveLetterSet = [ 'A', 'B' ];
DriveAttr = Directory + VolumeID; { only drives will have VolumeID set }

FUNCTION GetDiskClassNet( Drive, SubstDriveChar : CHAR ) : DiskClass;
{ This is a cover function for the TPdos.GetDiskClass function. It assumes
that the drives listed in DrivesNotToCheck (A and B by default) are always
valid floppies and doesn't test for which kind (to prevent 'Insert disk in
drive B: and press any key' messages from popping up at random in a program).
It assumes that a network drive may be identified as InvalidDrive. To see
if there is a network drive linked to a letter, it attempts to make that
letter the current drive. If it can, the drive letter is valid (but the
type is unknown); if not, the letter really is invalid. }

{$ENDIF}

{====================================================================}

implementation

...

if Length(TimePicture) <> 0 then begin
TS := TimeToTimeString(TimePicture, HMStoTime(Hour, Min, Sec));
Move(TS[1], dOther[NextPos], Length(TS));

{$IFDEF ShowAttrs}
IF ShowFileAttr
THEN Inc( NextPos, 2 + Length( TS ) );
{$ENDIF}
end;
end;
{$IFDEF ShowAttrs}
IF ShowFileAttr
THEN BEGIN
IF ( dAttr AND Archive = Archive )
THEN BEGIN
dOther[ NextPos ] := 'A';
Inc( NextPos )
END;
IF ( dAttr AND SysFile = SysFile )
THEN BEGIN
dOther[ NextPos ] := 'S';
Inc( NextPos )
END;
IF ( dAttr AND Hidden = Hidden )
THEN BEGIN
dOther[ NextPos ] := 'H';
Inc( NextPos )
END;
IF ( dAttr AND ReadOnly = ReadOnly )
THEN BEGIN
dOther[ NextPos ] := 'R';
Inc( NextPos )
END;
Inc( NextPos, 2 );
END;
{$ENDIF} {ShowAttrs}

end else
{$ENDIF} {AllowDateTime}
begin
dName := Name;

...

case DosError of
3, 18 : FindFiles := 0;
else
FindFiles := DosError;
end;
end;

{$IFDEF ShowDrives}

FUNCTION GetDiskClassNet( Drive, SubstDriveChar : CHAR ) : DiskClass;
{ This is a cover function for the TPdos.GetDiskClass function. It assumes
that the drives listed in DrivesNotToCheck (A and B by default) are always
valid floppies and doesn't test for which (to prevent 'Insert disk in drive
B: and press any key' messages from popping up at random in a program). It
assumes that a network drive may be identified as InvalidDrive. To see if
there is a network drive linked to a letter, it attempts to make that letter
the current drive. If it can, the drive letter is valid (but of type
unknown); if not, the letter really is invalid. }
VAR
TempClass : DiskClass;
TempDrive : CHAR;
BEGIN { FUNCTION GetDiskClassNet }
IF Drive IN DrivesNotToCheck
THEN TempClass := OtherFloppy
ELSE TempClass := GetDiskClass( Drive, SubstDriveChar );

IF TempClass = InvalidDrive
THEN BEGIN { test to see if is valid network drive }
TempDrive := DefaultDrive;
SelectDrive( Drive );
IF ( TempDrive = DefaultDrive ) { the drive letter didn't change } AND
( TempDrive <> Drive ) { the asked for drive isn't the current }
THEN { do nothing - the drive really is invalid }
ELSE BEGIN { found a network drive }
SelectDrive( TempDrive );
TempClass := UnknownDisk
END { network drive }
END { invalid drive };

GetDiskClassNet := TempClass
END { FUNCTION GetDiskClassNet };


PROCEDURE FindDrives( CurrentDrive : CHAR );
{ This procedure adds the valid drive letters to the list of files and
subdirectories. }
VAR
DriveCount : BYTE;{ drive currently being investigated }
ThisDrive,
ThisDriveSubst : CHAR;
ThisClass : DiskClass;
{$IFDEF ShowVolumes}
VolRec : SearchRec;
First, Second, VolumeName : STRING[ 13 ];
{$ENDIF} {ShowVolumes}
BEGIN { PROCEDURE FindDrives }
FOR DriveCount := 1 TO NumberOfDrives DO BEGIN
ThisDrive := Chr( DriveCount + Ord( 'A' ) - 1 );
ThisClass := GetDiskClassNet( ThisDrive, ThisDriveSubst );
IF ( ThisClass <> InvalidDrive ) AND
( ThisDrive <> CurrentDrive )
THEN BEGIN { add a file entry for this drive letter }
Inc( NumFiles );
WITH DirPtr( NumFiles )^ DO BEGIN
dAttr := Directory + VolumeId; { only drives will have VolId set}
IF BracketDrives
THEN dName := Pad( ' [' + ThisDrive + ']', NameWidth )
ELSE dName := Pad( #16' ' + ThisDrive + ':\', NameWidth );
dOther := CharStr( ' ', ItemWidth - NameWidth );
{$IFDEF ShowVolumes}
IF ShowSizeDateTime AND ShowVolumes
THEN BEGIN
IF ( ThisClass = OtherFloppy ) OR { test this first, since
drives not checked are this}
( ThisClass = Floppy360 ) OR
( ThisClass = Floppy720 ) OR
( ThisClass = Floppy12 ) OR
( ThisClass = Floppy144 )
THEN VolumeName := ''
ELSE BEGIN { get the volume name }
FindFirst( ThisDrive + ':\*.*', VolumeID, VolRec );
IF DosError = 0
THEN BEGIN
First := ForceExtension( VolRec.Name, '' );
Dec( First[ 0 ] );
First := Pad( First, 8 );
Second := JustExtension( VolRec.Name );
Second := Pad( Second, 3 );
VolumeName := '<' + First + Second + '>'
END { no DOS error }
ELSE VolumeName := '< >'
END { get volume name };
dOther := VolumeName +
CharStr( ' ', ItemWidth - NameWidth -
Length( VolumeName ) );
END
{$ENDIF} {ShowVolumes}
END { WITH .. BEGIN }
END { IF .. THEN BEGIN }
END { FOR DriveCount BEGIN }
END { PROCEDURE FindDrives };
{$ENDIF} {ShowDrives}

function Less(var X, Y : DirRec) : Boolean;
{-Return true if X < Y}
var
Xdir : Boolean;

...

SendFileName := ' '+F+dOther;
if dAttr and Directory = Directory then
AltPickAttr := True;
{$IFDEF ShowAttrs}
IF AltColorFileAttr
THEN IF ( dAttr AND SysFile = SysFile ) OR
( dAttr AND Hidden = Hidden ) OR
( dAttr AND ReadOnly = ReadOnly )
THEN AltPickAttr := True;
{$ENDIF}
end;
end;

...

if Status = 0 then begin
{Reinitialize relative pathname}
GetDir(0, RelPathName);
{$IFDEF ShowDrives} { find drives if looking in root or always show}
IF ShowDrives AND ( ( Length( Pathname ) = 3 ) OR ShowDrivesAny )
THEN FindDrives( PathName[ 1 ] );
{$ENDIF}
{Find only directories}
Status := FindFiles(SearchMask, Directory);
end;
end else begin
{$IFDEF ShowDrives} { find drives if looking in root }
IF ShowDrives AND ( ( Length( Pathname ) = 3 ) OR ShowDrivesAny )
THEN FindDrives( PathName[ 1 ] );
{$ENDIF}
{Find non-subdirectories}
Status := FindFiles(SearchMask, FileAttr and not Directory);
{Find subdirectories}

...

PKSSelect : {Enter}
with DirPtr(Choice)^ do begin
Selected := TrimTrail(dName);
{$IFDEF ShowDrives} { if chose a drive, change to that drive}
IF ( dAttr AND DriveAttr ) = DriveAttr {i.e., VolumeID set}
THEN BEGIN
IF BracketDrives then
Mask := Copy( Selected, 5, 1 )+':\'
ELSE
Mask := Copy( Selected, 3, 3 ); { i.e., remove > marker }
SearchMask := AddFilePath( Mask, WildCard )
END ELSE {$ENDIF}
if dAttr and Directory = Directory then begin
{Selected a subdirectory}
{!! 5.08 - use PathName rather than RelPathName}