Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/LCU.ZIP/LCU.PAS

Pascal/Delphi Source File | 1993-01-04 | 27.8 KB | 1,038 lines

{$R-}    {Range checking off}
{$B-}    {Boolean complete evaluation off}
{$S-}    {Stack checking off}
{$N-}    {No numeric coprocessor}
{$I-}    {IO Checking Off}
{$D-}    {no debug information}
{$T-}    {no TPM File}

{$M 65500, 16384, 655360} {Heap used for copying/comparing; 16K min arbitrary}

Program LCU;
{Modified 7/3/88}

Uses
  Crt, Dos, FileFcns, DrvParms, ErrProcs, Colors;

const
   PathLength            = 67;

Type
   FileSpecification    = record
      DriveNum     : Integer;   {0=Current, A=1, B=2, etc}
      Drive        : String[2]; {Drive Name, ended with ':'}
      Path         : String[PathLength]; {Name of Path, ended with '\'}
      Name         : String[8];  {Name of File}
      Ext          : String[4];  {Extension, preceded by '.' if not empty}
      end;

   FullPathName        = String[PathLength];
   FindType        = (PathOnly, FileAndPath, Nothing);

Var
   SearchRecord : SearchRec;

   SourceDriveSpec,
   DestDriveSpec : DriveSpecification;

   CurrentPathFullName,
   DefaultPathFullName,
   SearchFullName,
   ListFullName,
   DestFullName         : FullPathName;

   CurrentPathSpecification,
   DefaultPathSpecification,
   SearchPathSpecification,
   ListFileSpecification,
   DestFileSpecification    : FileSpecification;

   Choice               : Char;

   FileAttribute        : word;
   SetMask              : Integer;
   ResetMask            : Integer;
   OK                   : Boolean;

{***}

Procedure AnyKey2Continue;
var
   Answer : Char;
begin
TextColor(Emphasized);
Writeln(#7, 'Press Any Key to Continue');
Answer := ReadKey;
TextColor(Foreground);
end;

{***}

Procedure StringUpCase(var S:FullPathName);
var
   I : Integer;
begin
for I := 1 to length(S) do
   S[I] := upcase(S[I]);
end;

{***}

Procedure SplitLine(var LineEnd, LineStart: FullPathName; Position: Integer);
begin
LineStart   :=   copy(LineEnd, 1, position);
Delete(LineEnd, 1, position);
end;

{***}

Procedure ParseFileName(FullName: FullPathName;
                  var ParsedName: FileSpecification);
var
   S : FullPathName;

begin
with ParsedName do
begin
DriveNum := 0;
Drive := '';
Path  := '';
Name  := '';
Ext   := '';

if pos(':', FullName)>0 then
   begin {Name contains drive specifier}
      SplitLine(FullName, S, Pos(':', FullName) );
      if pos('\',FullName) <> 1 then   {since drive specified, next character}
         FullName := '\' + FullName;  {should be path separator             }
      Drive := S;
   end;

While pos('\', FullName)>0 do
   begin
      SplitLine(FullName, S, Pos('\', FullName) );
      Path := Path + S;
   end;

If pos('.', FullName)>0 then
   begin
      SplitLine(FullName, S, Pos('.', FullName)-1 );
      Name := S;
      Ext  := FullName;
   end
else
   Name := FullName;

if ( (Drive='') and (Path='') ) then begin
   Drive := DefaultPathSpecification.Drive;
   Path  := DefaultPathSpecification.Path ;
   end;

if (Drive='') then Drive := DefaultPathSpecification.Drive;

if Path[1]<>'\' then Path := DefaultPathSpecification.Path+ '\' + Path;

DriveNum := ord(Drive[1])-64;
end; {With}
end; {ParseFileName}

{***}

Procedure ConstructFileFullName(var FN: FullPathName; FS:FileSpecification);
begin
With FS do FN := Drive + Path + Name + Ext;
end; {ConstructFileFullName}

{***}

Function DirExist(ND:FullPathName):Boolean;
{Determines if Path Exists}
Var
   NDir : FileSpecification;
Begin
ParseFileName(ND, NDir);
NDir.Name := '*';
NDir.Ext  := '.*';
ConstructFileFullName(ND, NDir);
FindFirst(ND, ReadOnly+Archive, SearchRecord);
ErrorNumber := IOResult;
DirExist := (DosError<>3);
end;

{***}

Function Exist(FileNameExt: FullPathName; var ErrorNumber:Integer):Boolean;
{Determines if File Exists}

Begin
FindFirst(FileNameExt, ReadOnly+Archive, SearchRecord);
ErrorNumber := IOResult;
Exist := (DosError=0);
end;

{***}

Procedure ResetDefaultParms;
begin
DefaultPathSpecification.DriveNum := ListFileSpecification.DriveNum;
DefaultPathSpecification.DRIVE    := ListFileSpecification.DRIVE;
DefaultPathSpecification.PATH     := ListFileSpecification.PATH ;
ConstructFileFullName(DefaultPathFullName, DefaultPathSpecification);
end;

{***}

Procedure GetFileListName(var OK:Boolean; MustFind: FindType);
begin
OK := FALSE;

repeat
TextColor(Foreground);
Write('Please Enter Name of File List: '); ReadLn(ListFullName);
StringUpCase(ListFullName);
ParseFileName(ListFullName, ListFileSpecification);

with ListFileSpecification do begin
   if (Name ='') then Name  := 'TEMPFILE';
   if (Ext  ='') then Ext   := '.FFF';
   end; {with}

ConstructFileFullName(ListFullName, ListFileSpecification);

if (MustFind=PathOnly) then
   if DirExist(ListFullName) then begin
      OK := TRUE;
      ResetDefaultParms;
      end;

if (MustFind=FileAndPath) then
   if Exist(ListFullName, ErrorNumber) then begin
      OK := TRUE;
      ResetDefaultParms;
      end;

TextColor(Warning);
Case DosError of
     2, 18 : if (MustFind=FileAndPath) then
                WriteLn('File Not Found: ', ListFullName);
     3     : WriteLn('Path Not Found: ', ListFileSpecification.Drive +
                                         ListFileSpecification.Path);
     0     : begin
             end;
     else DisplayErrorMessages(DosError, [1..255]);
     end; {Case}

until OK=TRUE;
TextColor(Foreground);
end; {GetFileListName}

{***}

Procedure GetSearchSpecification(var OK:Boolean; MustFind:FindType);
begin
OK := FALSE;
repeat
TextColor(ForeGround);
Write('Please Enter Search Specification: ');
ReadLn(SearchFullName);
StringUpCase(SearchFullName);
ParseFileName(SearchFullName, SearchPathSpecification);
with SearchPathSpecification do begin
   if (Name ='') then Name  := '*';
   if (Ext  ='') then Ext   := '.*';
   end; {with}

ConstructFileFullName(SearchFullName, SearchPathSpecification);

if (MustFind=PathOnly) then
   if DirExist(SearchFullName) then begin
      OK := TRUE;
      ListFileSpecification.DriveNum := SearchPathSpecification.DriveNum;
      ListFileSpecification.Drive    := SearchPathSpecification.Drive;
      ListFileSpecification.Path     := SearchPathSpecification.Path ;
      ConstructFileFullName(ListFullName, ListFileSpecification);
      ResetDefaultParms;
      end;

TextColor(Warning);
Case DosError of
     2, 18 : begin
             end;
     3     : WriteLn('Path Not Found: ', SearchPathSpecification.Drive +
                                         SearchPathSpecification.Path);
     0     : begin
             end;
     else DisplayErrorMessages(DosError, [1..255]);
     end; {Case}

until (OK=TRUE);
TextColor(Foreground);
end; {GetSearchSpecification}

{***}

Procedure GetDestSpecification(var OK:Boolean; MustFind:FindType);
begin
OK := FALSE;
repeat

TextColor(ForeGround);
Write('Please Enter Destination Path : ');
ReadLn(DestFullName);
if DestFullName[length(DestFullName)] <> '\' then
   DestFullName := DestFullName + '\';
StringUpCase(DestFullName);
ParseFileName(DestFullName, DestFileSpecification);
with DestFileSpecification do begin
   Name := '';
   Ext  := '';
   end; {with}

ConstructFileFullName(DestFullName, DestFileSpecification);

if (MustFind=PathOnly) then
   if DirExist(DestFullName) then OK := TRUE;

TextColor(Warning);
Case DosError of
     2, 18 : begin
             end;
     3     : WriteLn('Path Not Found: ', DestFileSpecification.Drive +
                                         DestFileSpecification.Path);
     0     :
     else DisplayErrorMessages(DosError, [1..255]);
     end; {Case}

until (OK=TRUE);
TextColor(Foreground);
end; {GetDestSpecification}

{***}

Procedure StripListEntry(var ListEntry: FullPathName);
begin
if pos(' ', ListEntry)>0 then
    ListEntry := copy(ListEntry, 1, pos(' ', ListEntry) -1);
end;

{***}

Function Smart_FileExists(var S:FullPathName; Fixed:Boolean): Boolean;
begin
if (Exist(S, ErrorNumber)) then
   begin
   Smart_FileExists := TRUE;
   exit;
   end
else
   begin
   TextColor(Warning);
   WriteLn('File Not Found: ', S);
   if Fixed=FALSE then
      begin
      WriteLn('Please Place Correct Disk in Drive ',
               S[1],':');
      AnyKey2Continue;
      end;
   end;

Smart_FileExists := Exist(S, ErrorNumber);
TextColor(Foreground);
end;

{***}

Procedure ListFile_Make;
var
   ListFile  : Text;

begin
GetFileListName(OK, PathOnly);
GetSearchSpecification(OK, PathOnly);
Assign(ListFile,ListFullName);
IOCheck(ErrorNumber, [1..255]-[2,18]);
if (IOErr=TRUE) then Exit;

Rewrite(ListFile);
IOCheck(ErrorNumber, [1..255]-[2,18]);
if (IOErr=TRUE) then Exit;

TextColor(Emphasized);
SourceDriveSpec.DriveNum := DefaultPathSpecification.Drivenum;
DosGetDriveParms(SourceDriveSpec, ErrorNumber);
WriteLn('Creating File: ', ListFullName, ' on ', SourceDriveSpec.DriveName);
WriteLn;
TextColor(ForeGround);

FindFirst(SearchFullName, ReadOnly+Archive, SearchRecord);
While (DosError in ([0..255]-[2,18]) ) do begin
   While (length(SearchRecord.Name)<12) do
       SearchRecord.Name := SearchRecord.Name+' ';

   writeln(          SearchRecord.Name, '  (',SearchRecord.Size:8, ')');
   writeln(ListFile, SearchRecord.Name, '  (',SearchRecord.Size:8, ')');
   FindNext(SearchRecord);
   end;

Writeln;
close(ListFile);
IOCheck(ErrorNumber, [1..255]);
if ErrorNumber=0 then Writeln('List File Successfully Created: ',ListFullName);
end;

{***}

Procedure ListFile_Attribute;
var
   InFile    : Text;
   Choice    : String[8];
   ListFile  : File;
   ListEntry : FullPathName;

begin
OK := FALSE;
GetFileListName(OK, FileAndPath);

Assign(InFile,ListFullName);
IOCheck(ErrorNumber, [1..255]);
Reset(InFile);
IOCheck(ErrorNumber, [1..255]);
Writeln;

WriteLn('String Sets/Clears Attributes (Archive, System, Hidden, Read Only');
WriteLn('  Upper Case SETs   Attribute ("ASHR")');
WriteLn('  Lower Case CLEARs Attribute ("ashr")');
Write  ('Please Enter Attribute List ("AaSsHhRr"): ');
ReadLn(Choice);
WriteLn;
SetMask := 0;
ResetMask := 0;

while Length(Choice) > 0 do begin
   case Choice[1] of
      'A':    SetMask :=   SetMask or Archive;
      'a':  ResetMask := ResetMask or Archive;
      'S':    SetMask :=   SetMask or SysFile;
      's':  ResetMask := ResetMask or SysFile;
      'H':    SetMask :=   SetMask or Hidden;
      'h':  ResetMask := ResetMask or Hidden;
      'R':    SetMask :=   SetMask or ReadOnly;
      'r':  ResetMask := ResetMask or ReadOnly;
   end; {case}
   delete(Choice,1,1);
end;

ResetMask := not ResetMask;

TextColor(Emphasized);
SourceDriveSpec.DriveNum := DefaultPathSpecification.Drivenum;
DosGetDriveParms(SourceDriveSpec, ErrorNumber);
WriteLn('Changing Attributes on ', SourceDriveSpec.DriveName);
WriteLn;
TextColor(ForeGround);

While Not EOF(InFile) do
   begin
      ReadLn(InFile,ListEntry);
      StripListEntry(ListEntry);
      if ListEntry[1]='\' then ListEntry := DefaultPathSpecification.Drive + ListEntry
      else
         ListEntry := DefaultPathSpecification.Drive +
                      DefaultPathSpecification.Path  +
                      ListEntry;
      if Smart_FileExists(ListEntry, SourceDriveSpec.Fixed) then
         begin
         Assign(ListFile, ListEntry);
         IOCheck(ErrorNumber, [1..255]);
         GetFAttr(ListFile, FileAttribute);
         Write('Changing Attribute From ',FileAttribute:3);
         FileAttribute := FileAttribute and ResetMask;
         FileAttribute := FileAttribute  or   SetMask;
         Writeln(' To ',FileAttribute:3,'     File: ',ListEntry);
         SetFAttr(ListFile, FileAttribute);
         end
      else
         begin
         TextColor(Warning);
         WriteLn('File Not Found: ',ListEntry);
         TextColor(Foreground);
         end;
   end; {while}

Close( InFile);
AnyKey2Continue;
TextColor(ForeGround);
end; {ListFile_Attribute}

{***}

Procedure ListFile_Copy;

var
   ListEntry    : FullPathName;
   SourceFile   : FullPathName;
   DestFile     : FullPathName;
   InFile       : Text;
   ListFile     : File;

{**}

Procedure ProcessListEntry;
begin
      if ListEntry[1]='\' then begin
         SourceFile := DefaultPathSpecification.Drive + ListEntry;
         DestFile   := DestFileSpecification.Drive + ListEntry;
         end
      else
         begin
         SourceFile := DefaultPathSpecification.Drive +
                       DefaultPathSpecification.Path  +
                       ListEntry;
         DestFile   := DestFileSpecification.Drive +
                       DestFileSpecification.Path  +
                       ListEntry;
         end;

      if (Smart_FileExists(SourceFile, SourceDriveSpec.Fixed)=FALSE) then
         begin
         TextColor(Warning);
         WriteLn('File Not Copied: ', SourceFile);
         WriteLn;
         TextColor(Foreground);
         exit;
         end;

      FileCopy(SourceFile, DestFile, DosError);

      if DosError=200 then
         begin
         TextColor(Warning);
         WriteLn('Not enough space on Destination Drive for: ', SourceFile);
            if DestDriveSpec.Fixed=FALSE then
               begin
                  WriteLn('Please Place a new disk in Drive ',
                  DestFileSpecification.Drive);
                  AnyKey2Continue;
                  FileCopy(SourceFile, DestFile, DosError);
               end;
         end
      else DisplayErrorMessages(DosError, [1..255]);

         {If Still not enough space, then exit}
      if (DosError in [200, 210]) then begin
         TextColor(Warning);
         WriteLn('File Not Copied: ', SourceFile);
         WriteLn;
         TextColor(Foreground);
         exit;
         end
      else DisplayErrorMessages(DosError, [1..255]);

      Assign(ListFile, SourceFile);
      GetFAttr(ListFile, FileAttribute);
      Assign(ListFile, DestFile);

      TextColor(Foreground);
      if (FileAttribute and (Hidden+SysFile+ReadOnly) > 0) then
         WriteLn(' [',FileAttribute,' --> ', FileAttribute, ']')
      else
         begin
            GetFAttr(ListFile, FileAttribute);
            Write(' [',FileAttribute,' --> ');
            FileAttribute := FileAttribute and ResetMask;
            Writeln(FileAttribute,']');
         end;

      if FileComp(SourceFile,DestFile, DosError)=True then
         Writeln('  *** Files are Identical ***') else
         begin
            TextColor(Emphasized);
            Writeln('  *** Files are DIFFERENT ***');
            TextColor(Foreground);
         end;

Writeln;
SetFAttr(ListFile, FileAttribute);

end;

{**}

begin
GetFileListName(OK, FileAndPath);
Assign(InFile,ListFullName);
Reset(InFile);
IOCheck(ErrorNumber, [1..255]);

GetDestSpecification(OK, PathOnly);
WriteLn;

ResetMask := Archive;
ResetMask := not ResetMask;

SourceDriveSpec.DriveNum := DefaultPathSpecification.Drivenum;
DosGetDriveParms(SourceDriveSpec, ErrorNumber);
DestDriveSpec.DriveNum := DestFileSpecification.DriveNum;
DosGetDriveParms(DestDriveSpec, ErrorNumber);

TextColor(Emphasized);
WriteLn('Copying From ', SourceDriveSpec.DriveName,
        ' To ',          DestDriveSpec.DriveName);
WriteLn('Available Memory =', MaxAvail:8, ' Bytes');
WriteLn('Copy    Buffer   =', GetCopyBufferSize:8,    ' Bytes');
WriteLn('Compare Buffer   =', GetCompareBufferSize:8, ' Bytes');
WriteLn;
TextColor(Foreground);

ListEntry := ListFileSpecification.Name + ListFileSpecification.Ext;
ProcessListEntry;
if (DestDriveSpec.fixed=TRUE) then begin
{If Dest is a hard drive, use list on hard drive}
    ListFileSpecification.Drive := DestFileSpecification.Drive;
    ListFileSpecification.Path  := DestFileSpecification.Path;
    ListFileSpecification.DriveNum := DestFileSpecification.DriveNum;
    ConstructFileFullName(ListFullName, ListFileSpecification);
    Close(InFile);
    Assign(InFile, ListFullName);
    Reset(InFile);
    IOCheck(ErrorNumber, [1..255]);
    end;

TextColor(Emphasized);
WriteLn('Using List: ', ListFullName);
TextColor(Foreground);

WriteLn;

While Not EOF(InFile) do
   begin
      ReadLn(InFile,ListEntry);
      StripListEntry(ListEntry);
      if (ListEntry<>(ListFileSpecification.Name+ListFileSpecification.Ext) )
         then ProcessListEntry;
   end;

Close(InFile);
AnyKey2Continue;
end; {ListFile_Copy}

{***}

Procedure ListFile_Verify;
var
   ListEntry    : FullPathName;
   SourceFile   : FullPathName;
   DestFile     : FullPathName;
   InFile       : Text;

{**}
   Procedure ProcessListEntry;
      begin
      TextColor(Foreground);

      if ListEntry[1]='\' then begin
         SourceFile := DefaultPathSpecification.Drive + ListEntry;
         DestFile   := DestFileSpecification.Drive + ListEntry;
         end
      else
         begin
         SourceFile := DefaultPathSpecification.Drive +
                       DefaultPathSpecification.Path  +
                       ListEntry;
         DestFile   := DestFileSpecification.Drive +
                       DestFileSpecification.Path  +
                       ListEntry;
         end;

      if (Smart_FileExists(SourceFile, SourceDriveSpec.Fixed)=FALSE) then
         begin
         TextColor(Warning);
         WriteLn('File Not Verified: ', SourceFile);
         WriteLn;
         TextColor(Foreground);
      exit;
         end;

      if (Smart_FileExists(DestFile, DestDriveSpec.Fixed)=FALSE) then
         begin
         TextColor(Warning);
         WriteLn('File Not Verified: ', DestFile);
         WriteLn;
         TextColor(Foreground);
         exit;
         end;

      if FileComp(SourceFile,DestFile, DosError)=True then
         Writeln('  *** Files are Identical ***') else
         begin
            TextColor(Emphasized);
            Writeln('  *** Files are DIFFERENT ***');
            TextColor(Foreground);
         end;
      WriteLn;
      end;
{**}

begin
GetFileListName(OK, FileAndPath);
Assign(InFile,ListFullName);
Reset(InFile);
IOCheck(ErrorNumber, [1..255]);

GetDestSpecification(OK, PathOnly);
Writeln;

SourceDriveSpec.DriveNum := DefaultPathSpecification.Drivenum;
DosGetDriveParms(SourceDriveSpec, ErrorNumber);
DestDriveSpec.DriveNum := DestFileSpecification.DriveNum;
DosGetDriveParms(DestDriveSpec, ErrorNumber);

TextColor(Emphasized);
WriteLn('Verifying From ', SourceDriveSpec.DriveName,
        ' To ',          DestDriveSpec.DriveName);
WriteLn('Available Memory =', MaxAvail:8, ' Bytes');
WriteLn('Compare Buffer   =', GetCompareBufferSize:8, ' Bytes');
WriteLn;
TextColor(ForeGround);

While Not EOF(InFile) do begin
   ReadLn(InFile,ListEntry);
   StripListEntry(ListEntry);
   ProcessListEntry;
   end;

Close( InFile);
AnyKey2Continue;
end; {ListFile_Verify}

{***}

Procedure ListFile_Delete(FN:FullPathName);
var
   InFile       : Text;
   FileToDelete : Text;
   ListEntry    : FullPathName;
   FS           : FileSpecification;
   Attribute    : word;
   C            : Char;

{**}
   Procedure ProcessListEntry;
   begin
      if ListEntry[1]='\' then ListEntry := FS.Drive + ListEntry
      else
         ListEntry := FS.Drive + FS.Path + ListEntry;

      if (Smart_FileExists(ListEntry, SourceDriveSpec.Fixed)=FALSE) then
         begin
            TextColor(Warning);
            WriteLn('File Not Deleted: ', ListEntry);
            WriteLn;
            TextColor(ForeGround);
            exit;
         end;

      Assign(FileToDelete, ListEntry);
      GetFAttr(FileToDelete, Attribute);
      if ( (Attribute and ReadOnly) > 0 ) then
         begin
           TextColor(Warning);
           WriteLn('File is Read Only : ', ListEntry);
           Write(#7, 'Would You Like to Delete it Anyway? ');
           C := ReadKey;
           C := upcase(C);
           WriteLn(C);
           If C = 'Y' then SetFAttr(FileToDelete,0)
           else
              begin
                 WriteLn('File Not Deleted: ', ListEntry);
                 TextColor(ForeGround);
                 Close(FileToDelete);
                 exit;
              end;
           TextColor(Foreground);
      end;

      Erase(FileToDelete);
      WriteLn('File Deleted: ', ListEntry);
      WriteLn;
   end;
{**}

begin
ParseFileName(FN, FS);

Assign(InFile,FN);
Reset(InFile);
IOCheck(ErrorNumber, [1..255]);

TextColor(Emphasized);
SourceDriveSpec.DriveNum := DefaultPathSpecification.Drivenum;
DosGetDriveParms(SourceDriveSpec, ErrorNumber);
WriteLn('Deleting Files from ', SourceDriveSpec.DriveName);
WriteLn;
TextColor(ForeGround);

While Not EOF(InFile) do
   begin
      ReadLn(InFile,ListEntry);
      StripListEntry(ListEntry);
      if (ListEntry<>(FS.Name + FS.Ext) )
         then ProcessListEntry;
   end;

close(InFile);
AnyKey2Continue;
end; {ListFile_Delete}

{***}

Procedure ListFile_Merge;

var
   InFile, OKMerge, NOMerge : Text;
   ListFile       : File;
   Answer         : String[3];
   SourceFile     : FullPathName;
   DestFile       : FullPathName;
   ListEntry      : FullPathName;
   FN_FFY         : FullPathName;
   FN_FFN         : FullPathName;

{**}

   Procedure MergeCompare(SourceFile, DestFile, ListEntry : FullPathName);
   Begin
      if FileComp(SourceFile,DestFile, DosError)=True then
         begin
            Writeln('  *** Files are Identical ***');
            WriteLn;
            Writeln(OKMerge, ListEntry);
            end
     else
         Begin
            TextColor(Emphasized);
            Writeln('  *** Files are DIFFERENT ***');
            WriteLn;
            Writeln(NOMerge, ListEntry);
            TextColor(ForeGround);
            end;
   end; {MergeCompare}

{**}

   Procedure ProcessListEntry;
   begin
      if ListEntry[1]='\' then begin
         SourceFile := DefaultPathSpecification.Drive + ListEntry;
         DestFile   := DestFileSpecification.Drive + ListEntry;
         end
      else
         begin
         SourceFile := DefaultPathSpecification.Drive +
                       DefaultPathSpecification.Path  +
                       ListEntry;
         DestFile   := DestFileSpecification.Drive +
                       DestFileSpecification.Path  +
                       ListEntry;
         end;

      {If Source File Exists, then merge; Otherwise, skip}
      if Exist(SourceFile, ErrorNumber)=FALSE then
         begin
            TextColor(Warning);
            WriteLn('Source File Not Found/Not Merged: ', Sourcefile);
            WriteLn;
            TextColor(Foreground);
            exit;
         end;

      {if Destination File does not exist, copy source to target}
      if not exist(DestFile, ErrorNumber) then
         begin
         FileCopy(SourceFile, DestFile, DosError);
         if DosError=200 then
            begin
            TextColor(Warning);
            WriteLn('Not enough space on Destination Drive for: ',
                     SourceFile);
            end;

         if DosError in [200, 210] then
            begin
            TextColor(Warning);
            WriteLn('File Not Copied: ', SourceFile);
            WriteLn;
            TextColor(Foreground);
            exit;
            end;

            Assign(ListFile, SourceFile);
            GetFAttr(ListFile, FileAttribute);
            Assign(ListFile, DestFile);

            TextColor(Foreground);
            if (FileAttribute and (Hidden+SysFile+ReadOnly) > 0) then
               WriteLn(' [',FileAttribute,' --> ', FileAttribute, ']')
            else
               begin
                  GetFAttr(ListFile, FileAttribute);
                  Write(' [',FileAttribute,' --> ');
                  FileAttribute := FileAttribute and ResetMask;
                  Writeln(FileAttribute,']');
               end;

         MergeCompare(SourceFile, DestFile, ListEntry);
         SetFAttr(DestFile, FileAttribute);
         end
      else
          {if it exists, compare source and target}
          MergeCompare(SourceFile, DestFile, ListEntry);
   end;
{**}

begin
GetFileListName(OK, FileAndPath);
Assign(InFile,ListFullName);
Reset(InFile);
IOCheck(ErrorNumber, [1..255]-[2,18]);

OK := FALSE;
GetDestSpecification(OK, PathOnly);

With ListFileSpecification do
   FN_FFN := Drive + Path + Name + '.FFN';
Assign(NOMerge, FN_FFN);
ReWrite(NOMerge);
IOCheck(ErrorNumber, [1..255]-[2,18]);

With ListFileSpecification do
   FN_FFY := Drive + Path + Name + '.FFY';
Assign(OKMerge, FN_FFY);
ReWrite(OKMerge);
IOCheck(ErrorNumber, [1..255]-[2,18]);

Writeln;
ResetMask := Archive;
ResetMask := not ResetMask;

SourceDriveSpec.DriveNum := DefaultPathSpecification.Drivenum;
DosGetDriveParms(SourceDriveSpec, ErrorNumber);
DestDriveSpec.DriveNum := DestFileSpecification.DriveNum;
DosGetDriveParms(DestDriveSpec, ErrorNumber);

TextColor(Emphasized);
WriteLn('Merging From ', SourceDriveSpec.DriveName,
        ' To ',          DestDriveSpec.DriveName);
WriteLn('Available Memory =', MaxAvail:8, ' Bytes');
WriteLn('Copy    Buffer   =', GetCopyBufferSize:8,    ' Bytes');
WriteLn('Compare Buffer   =', GetCompareBufferSize:8, ' Bytes');
WriteLn;
TextColor(ForeGround);

While Not EOF(InFile) do
   begin
      ReadLn(InFile,ListEntry);
      StripListEntry(ListEntry);
      ProcessListEntry;
   end; {while}

Close( InFile);
Close(OKMerge);
Close(NoMerge);
TextColor(Warning);
Write(#7, 'Would you like to delete those files successfully merged? ');
ReadLn(Answer);
TextColor(Foreground);
if upcase(Answer[1])='Y' then ListFile_Delete(FN_FFY);

end; {ListFile_Merge}

{**********************************}

{*** Beginning of Main Program *** }

begin
   TextBackground(Background);
   TextColor(Foreground);

   GetDir(0,CurrentPathFullName);
   if CurrentPathFullName[length(CurrentPathFullName)] <> '\' then
      CurrentPathFullName := CurrentPathFullName + '\';
   ParseFileName(CurrentPathFullName, CurrentPathSpecification);
   ConstructFileFullName(CurrentPathFullName, CurrentPathSpecification);

   DefaultPathFullName      := CurrentPathFullName;
   DefaultPathSpecification := CurrentPathSpecification;

repeat
   Choice := ' ';
   ClrScr;
   WriteLn('Original  DOS   Path: ', CurrentPathFullName);
   WriteLn('Program Default Path: ', DefaultPathFullName);
   WriteLn;
   WriteLn('Do You Want To:');
   WriteLn('   L : MAKE a List');
   WriteLn('   A : Alter ATTRIBUTE of Files on a list');
   WriteLn('   C : COPY List of Files to another directory, with verify');
   WriteLn('   V : VERIFY a list of files to those in another directory');
   WriteLn('   M : MERGE files in current directory into another directory');
   WriteLn('   D : DELETE a list of files in the current directory');
   WriteLn;
   WriteLn('   X : EXIT program');
   WriteLn;
   Write  ('Please Enter Letter of Your Choice: ');
   Choice := ReadKey;
   Choice := upcase(Choice);

   Case Choice of
      'L' : begin
          WriteLn('L -> Make a List of Files');
          ListFile_Make;
          AnyKey2Continue;
          end;

      'A' : begin
          WriteLn('A -> Alter Attributes of a List of Files');
          ListFile_Attribute;
          end;

      'C' : begin
          WriteLn('C -> Copy a List of Files');
          ListFile_Copy;
          end;

      'V' : begin
          WriteLn('V -> Verify a List of Files');
          ListFile_Verify;
          end;

      'M' : begin
          WriteLn('M -> Merge a List of Files');
          ListFile_Merge;
          end;

      'D' : begin
          WriteLn('D -> Delete a List of Files');
          GetFileListName(OK, FileAndPath);
          ListFile_Delete(ListFullName);
          end;

      'T' : Begin
          WriteLn('T -> Test a Procedure');
          AnyKey2Continue;
          end;

     'X' : Writeln('X -> EXIT PROGRAM');

     else

   end; {Case}

until choice = 'X';

NormVideo;
ClrScr;
ChDir(CurrentPathFullName);
end.