PROGRAM TreeDuplicate;                                                  {008}

CONST

    VersionIdentification = '2.0A';

(***********************************************************************


    This software has been placed into the public domain by Digital
                         Equipment Corporation.

DISCLAIMER:

The information herein is subject to change without  notice  and  should
not be construed as a commitment by Digital Equipment Corporation.

Digital Equipment Corporation assumes no responsibility for the  use  or
reliability  of  this  software.   This  software  is  provided "as is,"
without any warranty of any kind, express or implied.  Digital Equipment
Corporation  will  not  be liable in any event for any damages including
any loss of data, profit, or savings, claims against  the  user  by  any
other  party,  or  any other incidental or consequential damages arising
out of the use of, or inability to use, this software, even  if  Digital
Equipment Corporation is advised of the possibility of such damage.

DEFECT REPORTING AND SUGGESTIONS:

Please send reports of defects or suggestions for  improvement  directly
to the author:

        Brian Hetrick
        Digital Equipment Corporation
        110 Spit Brook Road  ZKO1-3/J10
        Nashua NH  03062-2698

Do NOT file a Software Performance Report on  this  software,  call  the
Telephone  Support  Center regarding this software, contact your Digital
Field Office  regarding  this  software,  or  use  any  other  mechanism
provided for Digital's supported and warranted software.


FACILITY:

    General user utilities

ABSTRACT:

    Duplicates one directory tree into another, attempting not  to  copy{008}
    data if possible.  Intended for use as a backup utility using a DEC-
    net-DOS virtual disk as the backup medium.

ENVIRONMENT:

    MS-DOS compiled with Borland International's TURBO Pascal

AUTHOR: Brian Hetrick, CREATION DATE: 27 May 1986.

MODIFICATION HISTORY:

        Brian Hetrick, 27-May-86: Version 1.0
  000 - Original creation of module.
        Released to Easynet 28-May-86.

        Brian Hetrick, 30-May-86: Version 1.1
  001 - Attributes on directories were not updated.  Cause was that dir-
        ectory modification date cannot be set, and IDAttrMatch  routine
        was  testing  modification  date  for directories.  Main program
        then attempted to replace the target directory, but  ReplaceFile
        simply  returned.   Fix  is to have IDAttrMatch not look at mod-
        ification dates for directories;  main program now  uses  Match-
        File to update the attributes.
  002 - Included program name and version in banner.
        Released to Easynet 30-May-86

        Brian Hetrick, 31-May-86: Version 1.2
  003 - Introduce hook for having files accumulate on target volume,  to
        match hook for event logging.
  004 - Introduce procedure to check for MS-DOS error, instead of always
        explicitly checking low bit of returned Flags register.
  005 - Introduce function to form name from  root  directory,  relative
        directory,  and  file  in relative directory, rather than always
        building directly from volume letter,  absolute  directory,  and
        file  in absolute directory, as a hook for later permitting root
        to be any directory.
  006 - Avoid exteraneous copy in ExpandDirectory.
  007 - Use only ASCII in message  text--replace  MCS  copyright  symbol
        with (c) as program may run on IBM PCs without MCS.
        Not released to Easynet as no user-visible improvements.

        Brian Hetrick, 03-Jun-86: Version 2.0
  008 - Change name from VOLCOPY to TREEDUPL, as  now  will  copy  trees
        rooted at other than the volume root directory.
  009 - Use Bela Lubkin's public domain CommandLineArgument  routine  to
        parse the command line.
  010 - Deleted copyright notice as program will be submitted  to  DECUS
        program library.
        Released to Easynet on 3 June 1986.
        Submitted to DECUS Program Library in September 1986.

        Brian Hetrick, 03-Dec-86: Version 2.0A
  011 - Discovered error day before verification  master  received  from
        DECUS Program Library.  Error was command qualifiers were parsed
        incorrectly if abbreviated.

***********************************************************************)
{.PA}
(*
 *  INCLUDE FILES:
 *)

{$I CLA.PAS}                                                            {009}

(*
 *  LABEL DECLARATIONS:
 *)

(*
 *  CONSTANT DECLARATIONS:
 *)

CONST

    DOSFunctionChangeAttributes     = $43;
    DOSFunctionCloseFile            = $3E;
    DOSFunctionCreateFile           = $3C;
    DOSFunctionCreateSubDirectory   = $39;
    DOSFunctionDeleteDirectoryEntry = $41;
    DOSFunctionFindMatchFile        = $4E;
    DOSFunctionGetDTA               = $2F;
    DOSFunctionOpenFile             = $3D;
    DOSFunctionReadFromFile         = $3F;
    DOSFunctionRemoveDirectoryEntry = $3A;
    DOSFunctionSetDTA               = $1A;
    DOSFunctionSetFileDateTime      = $57;
    DOSFunctionStepThroughDirectory = $4F;
    DOSFunctionWriteToFile          = $40;

CONST

    DirectoryAttrMask  = $10;   { Attribute bit for directory          }
    DirectoryEntrySize = 5;     { Base length of DirectoryEntry        }
    FileEntrySize      = 20;    { Base length of FileEntry             }
    FileSpecLength     = 12;    { Length of MS-DOS base name           }
    PathSpecLength     = 127;   { Length of MS-DOS path specification  }
    ReadOnlyAttrMask   = $01;   { Attribute bit for read-only          }

(*
 *  TYPE DECLARATIONS:
 *)

TYPE

    FileSpec = STRING [FileSpecLength];

    PathSpec = STRING [PathSpecLength];

    DirectoryEntryPtr = ^ DirectoryEntry;

    DirectoryEntry = RECORD
        Next : DirectoryEntryPtr;
        Name : PathSpec
        END;

    FileEntryPtr = ^ FileEntry;

    FileEntry = RECORD
        Next : FileEntryPtr;
        Prev : FileEntryPtr;
        Size : REAL;
        Time : INTEGER;
        Date : INTEGER;
        Attr : BYTE;
        Name : FileSpec
        END;

    FileEntryQueue = RECORD
        Head : FileEntryPtr;
        Tail : FileEntryPtr
        END;

    RegPack = RECORD
        CASE INTEGER OF
         0: (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : INTEGER);
         1: (AL, AH, BL, BH, CL, CH, DL, DH            : BYTE)
        END;

(*
 *  OWN STORAGE:
 *)

VAR

    Accumulating : BOOLEAN;
    Logging      : BOOLEAN;
    SourceRoot   : PathSpec;
    TargetRoot   : PathSpec;

(*
 *  TABLE OF CONTENTS:
 *)
{.PA}
PROCEDURE ParseCommandLine;                                             {009}

(***********************************************************************{009}

FUNCTIONAL DESCRIPTION:                                                 {009}

    Parses the program command line.                                    {009}

FORMAL PARAMETERS:                                                      {009}

    None.                                                               {009}

RETURN VALUE:                                                           {009}

    None.                                                               {009}

IMPLICIT INPUTS:                                                        {009}

    None.                                                               {009}

IMPLICIT OUTPUTS:                                                       {009}

    Accumulating - The BOOLEAN telling whether files on the  target  are{009}
        to be retained if they are not on the source.                   {009}
    Logging - The BOOLEAN telling whether messages informing the user of{009}
        actions taken are to be written to the standard output.         {009}
    SourceRoot - The root directory of the source directory tree.       {009}
    TargetRoot - The root directory of the target directory tree.       {009}

SIDE EFFECTS:

    Will Halt the program if an error in the command line is discovered.{009}

***********************************************************************){009}

    VAR                                                                 {009}

        CharIndex    : INTEGER;                                         {009}
        CommandValid : BOOLEAN;                                         {009}
        SwitchSense  : BOOLEAN;                                         {009}
        SwitchText   : BigString;                                       {009}

    FUNCTION IsPrefix (Str1 : BigString; Str2 : BigString) : BOOLEAN;   {009}

        VAR                                                             {009}

            CharIndex : INTEGER;                                        {009}

        BEGIN                                                           {009}

        IF Length (Str1) > Length (Str2)                                {009}
        THEN                                                            {009}
            IsPrefix := FALSE                                           {009}
        ELSE                                                            {009}
            IsPrefix := Str1 = Copy (Str2, 1, Length (Str1))            {011}

        END;                                                            {009}

    PROCEDURE UpCaseString (VAR Str : PathSpec);                        {009}

        VAR                                                             {009}

            CharIndex : INTEGER;                                        {009}

        BEGIN                                                           {009}

        FOR CharIndex := 1 TO Length (Str)                              {009}
        DO                                                              {009}
            Str [CharIndex] := UpCase (Str [CharIndex])                 {009}

        END;                                                            {009}

    BEGIN                                                               {009}

    (*                                                                  {009}
     *  Get source and destination roots                                {009}
     *)                                                                 {009}

    SourceRoot := CommandLineArgument                                   {009}
        ('Source directory: ', '/', FALSE);                             {009}
    UpCaseString (SourceRoot);                                          {009}
    TargetRoot := CommandLineArgument                                   {009}
        ('Destination directory: ', '/', FALSE);                        {009}
    UpCaseString (TargetRoot);                                          {009}

    (*                                                                  {009}
     *  Set defaults                                                    {009}
     *)                                                                 {009}

    Accumulating := TRUE;                                               {009}
    Logging      := TRUE;                                               {009}

    (*                                                                  {009}
     *  Process switches                                                {009}
     *)                                                                 {009}

    CommandValid := TRUE;                                               {009}
    SwitchText := CommandLineArgument ('', '', TRUE);                   {009}
    WHILE CommandValid AND (Length (SwitchText) > 0)                    {009}
    DO                                                                  {009}
        BEGIN                                                           {009}

        UpCaseString (SwitchText);                                      {009}

        (*                                                              {009}
         *  Get rid of the leading slash                                {009}
         *)                                                             {009}

        Delete (SwitchText, 1, 1);                                      {009}
        IF Length (SwitchText) = 0                                      {009}
        THEN                                                            {009}
            BEGIN                                                       {009}
            WriteLn ('Invalid switch: "/"');                            {009}
            CommandValid := FALSE;                                      {009}
            END;                                                        {009}

        IF CommandValid                                                 {009}
        THEN                                                            {009}

            (*                                                          {009}
             *  Check for "NO" prefix                                   {009}
             *)                                                         {009}

            IF Copy (SwitchText, 1, 2) = 'NO'                           {009}
            THEN                                                        {009}
                BEGIN                                                   {009}
                SwitchSense := FALSE;                                   {009}
                Delete (SwitchText, 1, 2);                              {009}
                IF Length (SwitchText) = 0                              {009}
                THEN                                                    {009}
                    BEGIN                                               {009}
                    WriteLn ('Invalid switch: "/NO"');                  {009}
                    CommandValid := FALSE                               {009}
                    END                                                 {009}
                END                                                     {009}
            ELSE                                                        {009}
                SwitchSense := TRUE;                                    {009}

        IF CommandValid                                                 {009}
        THEN                                                            {009}
            BEGIN                                                       {009}

            (*                                                          {009}
             *  Check for switch names                                  {009}
             *)                                                         {009}

            IF IsPrefix (SwitchText, 'LOG')                             {009}
            THEN                                                        {009}

                Logging := SwitchSense                                  {009}

            ELSE IF IsPrefix (SwitchText, 'ACCUMULATE')                 {009}
            THEN                                                        {009}

                Accumulating := SwitchSense                             {009}

            ELSE                                                        {009}
                BEGIN                                                   {009}

                Write ('Invalid switch: "/');                           {009}
                IF SwitchSense = FALSE                                  {009}
                THEN                                                    {009}
                    Write ('NO');                                       {009}
                WriteLn (SwitchText, '"');                              {009}
                CommandValid := FALSE                                   {009}

                END                                                     {009}

            END;                                                        {009}

        IF CommandValid                                                 {009}
        THEN                                                            {009}
            SwitchText := CommandLineArgument ('', '', TRUE)            {009}

        END;                                                            {009}

    IF NOT CommandValid                                                 {009}
        THEN                                                            {009}
        Halt                                                            {009}

    END;                                                                {009}
{.PA}
FUNCTION ErrorReturn                                                    {004}
   (    Registers : RegPack) : BOOLEAN;                                 {004}

(***********************************************************************{004}

FUNCTIONAL DESCRIPTION:                                                 {004}

    Checks a set of registers returned from the MsDos procedure and  de-{004}
    termines whether the function completed successfully.               {004}

FORMAL PARAMETERS:                                                      {004}

    Registers - A RegPack expression giving the register values returned{004}
        by the MsDos procedure.                                         {004}

RETURN VALUE:                                                           {004}

    TRUE - The MsDos function failed.                                   {004}
    FALSE - The MsDos function succeeded.                               {004}

IMPLICIT INPUTS:                                                        {004}

    None.                                                               {004}

IMPLICIT OUTPUTS:                                                       {004}

    None.                                                               {004}

SIDE EFFECTS:                                                           {004}

    None.                                                               {004}

***********************************************************************){004}

    BEGIN                                                               {004}

    ErrorReturn := (Registers . Flags AND 1) <> 0                       {004}

    END;                                                                {004}
{.PA}
FUNCTION ConstructFileName                                              {005}
   (    RootDirectory     : PathSpec;                                   {005}
        RelativeDirectory : PathSpec;                                   {005}
        FileName          : FileSpec) : PathSpec;                       {005}

(***********************************************************************{005}

FUNCTIONAL DESCRIPTION:                                                 {005}

    Constructs a path specification from a root  directory,  a  relative{005}
    directory, and file name by concatenating these elements, separating{005}
    them by backslash if there is not already a separator.              {005}

FORMAL PARAMETERS:                                                      {005}

    RootDirectory - A PathSpec expression giving the root  directory  of{005}
        the eventual path specification.                                {005}
    RelativeDirectory -  A  PathSpec  expression  giving  the  directory{005}
        relative to RootDirectory of the eventual path specification.   {005}
    FileName - A FileSpec expression giving the file name of  the  even-{005}
        tual path specification.                                        {005}

RETURN VALUE:                                                           {005}

    The resultant path specification.                                   {005}

IMPLICIT INPUTS:                                                        {005}

    None.                                                               {005}

IMPLICIT OUTPUTS:                                                       {005}

    None.                                                               {005}

SIDE EFFECTS:                                                           {005}

    None.                                                               {005}

***********************************************************************){005}

    CONST                                                               {005}
        Separator : SET OF CHAR = [':', '\', '/'];                      {005}

    VAR                                                                 {005}
        TempName : PathSpec;                                            {005}

    BEGIN                                                               {005}

    TempName := RootDirectory;                                          {005}

    IF (Length (TempName) > 0) AND (Length (RelativeDirectory) > 0)     {005}
    THEN                                                                {005}
        IF NOT (TempName [Length (TempName)] IN Separator)              {005}
        THEN                                                            {005}
            Insert ('\', TempName, Length (TempName) + 1);              {005}

    Insert (RelativeDirectory, TempName, Length (TempName) + 1);        {005}

    IF (Length (TempName) > 0) AND (Length (FileName) > 0)              {005}
    THEN                                                                {005}
        IF NOT (TempName [Length (TempName)] IN Separator)              {005}
        THEN                                                            {005}
            Insert ('\', TempName, Length (TempName) + 1);              {005}

    Insert (FileName, TempName, Length (TempName) + 1);                 {005}

    ConstructFileName := TempName                                       {005}

    END;                                                                {005}
{.PA}
PROCEDURE ExpandDirectory
   (    RootDirectory     : PathSpec;                                   {005}
        DirectoryToExpand : DirectoryEntryPtr;
    VAR FileQueue         : FileEntryQueue);

(***********************************************************************

FUNCTIONAL DESCRIPTION:

    Finds and lexicographically sorts the names of all files  in  a  di-
    rectory

FORMAL PARAMETERS:

    RootDirectory - A PathSpec expression giving the root  directory  to{005}
        which DirectoryName is a relative directory.                    {005}
    DirectoryName - A DirectoryEntryPtr expression pointing to  the  Di-
        recoryEntry describing the directory to be examined
    FileQueue - A FileEntryQueue object which is modified to point to  a
        newly created queue of the names of files in the directory

RETURN VALUE:

    None.

IMPLICIT INPUTS:

    None.

IMPLICIT OUTPUTS:

    None.

SIDE EFFECTS:

    Modifies and resets the DTA.  This should be observable only by  in-
    terrupt routines.

    Dynamically allocates storage with GetMem.

***********************************************************************)

    VAR

        FoundPos       : BOOLEAN;
        FileNameLength : INTEGER;
        FileName       : FileSpec;
        MSDOSBlock     : RECORD
            Reserved   : ARRAY [1..21] OF BYTE;
            Attribute  : BYTE;
            Time       : INTEGER;
            Date       : INTEGER;
            SizeLow    : INTEGER;
            SizeHigh   : INTEGER;
            Name       : ARRAY [1..13] OF CHAR
            END;
        NextFile       : FileEntryPtr;
        OldDTA         : ^ CHAR;
        PrevFile       : FileEntryPtr;
        Registers      : RegPack;
        SearchSpec     : PathSpec;
        ThisFile       : FileEntryPtr;

    BEGIN

    (*
     *  Initialize the file queue
     *)

    FileQueue . Head := NIL;
    FileQueue . Tail := NIL;

    (*
     *  Save the old DTA
     *)

    Registers.AH := DOSFunctionGetDTA;
    MsDos (Registers);
    OldDTA := Ptr (Registers.ES, Registers.BX);

    (*
     *  Set the DTA to be the MS-DOS information block
     *)

    Registers.AH := DOSFunctionSetDTA;
    Registers.DS := Seg (MSDOSBlock);
    Registers.DX := Ofs (MSDOSBlock);
    MsDos (Registers);

    (*
     *  Find the contents of the directory
     *)

    SearchSpec := ConstructFileName (RootDirectory,                     {005}
        DirectoryToExpand ^. Name, '*.*');                              {005}
    SearchSpec [Length (SearchSpec) + 1] := #$00;                       {005}

    Registers.AH := DOSFunctionFindMatchFile;
    Registers.DS := Seg (SearchSpec [1]);
    Registers.DX := Ofs (SearchSpec [1]);
    Registers.CX := $37;
    MsDos (Registers);

    WHILE NOT ErrorReturn (Registers)                                   {004}
    DO
        BEGIN

        (*
         *  Extract the file name
         *)

        FileNameLength := 1;
        WHILE MSDOSBlock . Name [FileNameLength] <> #$00
        DO
            FileNameLength := FileNameLength + 1;
        FileNameLength := FileNameLength - 1;
        FileName := Copy (MSDOSBlock . Name, 1, FileNameLength);

        (*
         *  Ignore relative directories
         *)

        IF (FileName <> '.') AND (FileName <> '..')
        THEN
            BEGIN

            (*
             *  Create a file entry for this file
             *)

            GetMem (ThisFile, FileEntrySize + FileNameLength);

            ThisFile ^. Attr := MSDOSBlock . Attribute;
            ThisFile ^. Time := MSDOSBlock . Time;
            ThisFile ^. Date := MSDOSBlock . Date;
            IF MSDOSBlock . SizeHigh < 0
            THEN
                ThisFile ^. Size := MSDOSBlock . SizeHigh + 65536.0
            ELSE
                ThisFile ^. Size := MSDOSBlock . SizeHigh;
            ThisFile ^. Size := ThisFile ^. Size * 65536.0;
            IF MSDOSBlock . SizeLow < 0
            THEN
                ThisFile ^. Size := ThisFile ^. Size +
                    MSDOSBlock . SizeLow + 65536.0
            ELSE
                ThisFile ^. Size := ThisFile ^. Size +
                    MSDOSBlock . SizeLow;

            ThisFile ^. Name := FileName;                               {006}

            (*
             *  Insert the newly allocated entry into the sorted queue
             *)

            NextFile := FileQueue . Head;
            PrevFile := NIL;
            FoundPos := FALSE;
            WHILE NOT FoundPos
            DO
                BEGIN
                IF NextFile = NIL
                THEN
                    FoundPos := TRUE
                ELSE
                    IF NextFile ^. Name > ThisFile ^. Name
                    THEN
                        FoundPos := TRUE
                    ELSE
                        BEGIN
                        PrevFile := NextFile;
                        NextFile := NextFile ^. Next
                        END
                END;

            ThisFile ^. Prev := PrevFile;
            IF PrevFile = NIL
            THEN
                FileQueue . Head := ThisFile
            ELSE
                PrevFile ^. Next := ThisFile;
            ThisFile ^. Next := NextFile;
            IF NextFile = NIL
            THEN
                FileQueue . Tail := ThisFile
            ELSE
                NextFile ^. Prev := ThisFile

            END;

        (*
         *  Get the next file in the directory
         *)

        Registers.AH := DOSFunctionStepThroughDirectory;
        MsDos (Registers)

        END;

    (*
     *  The directory has been expanded.  Reset the DTA
     *)

    Registers.AH := DOSFunctionSetDTA;
    Registers.DS := Seg (OldDTA ^);
    Registers.DX := Ofs (OldDTA ^);
    MsDos (Registers)

    END;
{.PA}
PROCEDURE ExtractDirectories
   (    CurrentDirectory : DirectoryEntryPtr;
        FileQueue        : FileEntryQueue;
    VAR DirectoryList    : DirectoryEntryPtr);

(***********************************************************************

FUNCTIONAL DESCRIPTION:

    Examines the contents of the current directory,  extracts  the  full
    path  names  of  all  subdirectories,  and places these subdirectory
    names on a queue of pending directories.

FORMAL PARAMETERS:

    CurrentDirectory - A DirectoryEntryPtr pointing to a  DirectoryEntry
        describing the directory whose contents are given by FileQueue.
    FileQueue - A FileEntryQueue pointing to a list of FileEntry objects
        describing  the  files  in  the  directory described by Current-
        Directory.
    DirectoryList - A DirectoryEntryPtr pointing to a list of Directory-
        Entry objects.  New DirectoryEntry objects are created  for  the
        subdirectories found on the list of FileEntry objects pointed to
        by FileQueue, and are placed onto this list.

RETURN VALUE:

    None.

IMPLICIT INPUTS:

    None.

IMPLICIT OUTPUTS:

    None.

SIDE EFFECTS:

    Dynamically allocates storage with GetMem.

***********************************************************************)

    VAR

        DirectoryText : PathSpec;
        ThisDirectory : DirectoryEntryPtr;
        ThisEntry     : FileEntryPtr;

    BEGIN

    (*
     *  Scan list backwards, looking for directories
     *)

    ThisEntry := FileQueue . Tail;

    WHILE ThisEntry <> NIL
    DO
        BEGIN

        IF (ThisEntry ^. Attr AND DirectoryAttrMask) <> 0
        THEN
            BEGIN

            (*
             *  This entry is a directory.
             *)

            DirectoryText :=                                            {005}
                ConstructFileName (CurrentDirectory ^. Name,            {005}
                    ThisEntry ^. Name, '');                             {005}
            GetMem (ThisDirectory, DirectoryEntrySize +
                Length (DirectoryText));
            ThisDirectory ^. Next := DirectoryList;
            ThisDirectory ^. Name := DirectoryText;
            DirectoryList := ThisDirectory

            END;

        ThisEntry := ThisEntry ^. Prev

        END

    END;
{.PA}
PROCEDURE AdvanceFile
   (VAR FileQueue : FileEntryQueue);

(***********************************************************************

FUNCTIONAL DESCRIPTION:

    Deletes the first item on a file entry queue.

FORMAL PARAMETERS:

    FileQueue - A FileEntryQueue object pointing to a queue of FileEntry
        objects.  The item pointed at by the Head  pointer  is  deleted,
        and the queue is adjusted for this deletion.

RETURN VALUE:

    None.

IMPLICIT INPUTS:

    None.

IMPLICIT OUTPUTS:

    None.

SIDE EFFECTS:

    Dynamically frees storage with FreeMem.

***********************************************************************)

    VAR
        ThisEntry : FileEntryPtr;

    BEGIN

    (*
     *  Ensure that there is an item to delete
     *)

    ThisEntry := FileQueue . Head;
    IF ThisEntry <> NIL
    THEN
        BEGIN

        (*
         *  There is.  First, relink the queue around the item
         *)

        FileQueue . Head := ThisEntry ^. Next;
        IF FileQueue . Head = NIL
        THEN
            FileQueue . Tail := NIL
        ELSE
            FileQueue . Head ^. Prev := NIL;

        (*
         *  Now free the item's storage
         *)

        FreeMem (ThisEntry, FileEntrySize + Length (ThisEntry ^. Name))

        END

    END;
{.PA}
FUNCTION IDAttrMatch
   (    FileEntry1 : FileEntryPtr;
        FileEntry2 : FileEntryPtr) : BOOLEAN;

(***********************************************************************

FUNCTIONAL DESCRIPTION:

    Determine whether two files are putatively identical.

    Two files are considered to be identical if they have the same name,
    same directory attribute, and, in the case of  non-directory  files,{001}
    the  same  creation/modification  date  and  time and size.  NO COM-{001}
    PARISON OF THE FILE CONTENTS IS MADE.

FORMAL PARAMETERS:

    File1Desc - A FileEntryPtr pointing to a FileEntry object describing
        the first of the two files.
    File2Desc - A FileEntryPtr pointing to a FileEntry object describing
        the second of the two files.

RETURN VALUE:

    TRUE - The files are considered to be identical.
    FALSE - The files are not considered to be identical.

IMPLICIT INPUTS:

    None.

IMPLICIT OUTPUTS:

    None.

SIDE EFFECTS:

    None.

***********************************************************************)

    VAR

        Difference : BOOLEAN;

    BEGIN

    Difference := FALSE;

    IF FileEntry1 ^. Name <> FileEntry2 ^. Name
    THEN
        Difference := TRUE;

    IF (FileEntry1 ^. Attr AND DirectoryAttrMask) <>
       (FileEntry2 ^. Attr AND DirectoryAttrMask)
    THEN
        Difference := TRUE;

    IF (FileEntry1 ^. Attr AND DirectoryAttrMask) = 0                   {001}
    THEN                                                                {001}
        BEGIN                                                           {001}

        IF FileEntry1 ^. Time <> FileEntry2 ^. Time
        THEN
            Difference := TRUE;

        IF FileEntry1 ^. Date <> FileEntry2 ^. Date
        THEN
            Difference := TRUE;

        IF FileEntry1 ^. Size <> FileEntry2 ^. Size
        THEN
            Difference := TRUE                                          {001}

        END;                                                            {001}

    IDAttrMatch := NOT Difference

    END;
{.PA}
PROCEDURE DeleteFile
   (    RootDirectory    : PathSpec;                                    {005}
        CurrentDirectory : DirectoryEntryPtr;
        FileInfo         : FileEntryPtr);

(***********************************************************************

FUNCTIONAL DESCRIPTION:

    Deletes a single file or an entire subdirectory tree.  When deleting
    an entire subdirectory tree, recurses to the depth of the subdirect-
    ory tree.

FORMAL PARAMETERS:

    RootDirectory - A PathSpec expression giving the root  directory  to{005}
        which DirectoryName is a relative directory.                    {005}
    CurrentDirectory - A DirectoryEntryPtr expression pointing to a  Di-
        rectoryEntry  object  describing the directory in which the file
        resides.
    FileInformation - A FileEntryPtr expression pointing to a  FileEntry
        object describing the file to be deleted.

RETURN VALUE:

    None.

IMPLICIT INPUTS:

    Logging - The BOOLEAN telling whether event logging is currently on.

IMPLICIT OUTPUTS:

    None.

SIDE EFFECTS:

    None.

***********************************************************************)

    VAR

        NewDirEntry : DirectoryEntry;
        Registers   : RegPack;
        SubDirQueue : FileEntryQueue;

    (*
     *  A DirectoryEntry is used in place of a PathSpec for the name  of
     *  the  single file to be deleted, in order to minimize local stor-
     *  age requirements.  This is important only  as  this  routine  is
     *  recursive.
     *)

    BEGIN

    (*
     *  If the "file" to be deleted is a directory,  delete  the  entire
     *  tree rooted there
     *)

    IF (FileInfo ^. Attr AND DirectoryAttrMask) <> 0
    THEN
        BEGIN

        (*
         *  Construct a directory entry for the directory
         *)

        NewDirEntry . Name :=                                           {005}
            ConstructFileName (CurrentDirectory ^. Name,                {005}
                FileInfo ^. Name, '');                                  {005}

        (*
         *  Get contents of directory
         *)

        ExpandDirectory (RootDirectory, Addr (NewDirEntry),             {005}
            SubDirQueue);

        (*
         *  Recursively delete the contents of the directory
         *)

        WHILE SubDirQueue . Head <> NIL
        DO
            BEGIN

            DeleteFile (RootDirectory, Addr (NewDirEntry),              {005}
                SubDirQueue . Head);
            AdvanceFile (SubDirQueue)

            END

        END;

    (*
     *  Generate the file specification
     *)

    NewDirEntry . Name := ConstructFileName (RootDirectory,             {005}
        CurrentDirectory ^. Name, FileInfo ^. Name);                    {005}

    (*
     *  Put on the trailing NUL for MS-DOS calls
     *)

    NewDirEntry . Name [Length (NewDirEntry . Name) + 1] := #$00;

    (*
     *  The Read-Only attribute implies  that  the  file  cannot  be
     *  deleted.  If the Read-Only attribute is on, turn it off.
     *)

    IF (FileInfo ^. Attr AND ReadOnlyAttrMask) <> 0
    THEN
        BEGIN

        Registers . AH := DOSFunctionChangeAttributes;
        Registers . DS := Seg (NewDirEntry . Name [1]);
        Registers . DX := Ofs (NewDirEntry . Name [1]);
        Registers . CX := FileInfo ^. Attr AND NOT                      {001}
            (ReadOnlyAttrMask OR DirectoryAttrMask);                    {001}
        Registers . AL := 1;
        MsDos (Registers);
        IF ErrorReturn (Registers)                                      {004}
        THEN
            BEGIN

            WriteLn ('Cannot change attributes on ', NewDirEntry . Name);
            Halt

            END

        END;

    (*
     *  Actually delete the file
     *)

    IF (FileInfo ^. Attr AND DirectoryAttrMask) <> 0
    THEN
        Registers . AH := DOSFunctionRemoveDirectoryEntry
    ELSE
        Registers . AH := DOSFunctionDeleteDirectoryEntry;

    Registers . DS := Seg (NewDirEntry . Name [1]);
    Registers . DX := Ofs (NewDirEntry . Name [1]);
    MsDos (Registers);
    IF ErrorReturn (Registers)                                          {004}
    THEN
        BEGIN

        Write ('Cannot delete ');
        IF (FileInfo ^. Attr AND DirectoryAttrMask) <> 0
        THEN
            Write ('directory ');
        WriteLn (NewDirEntry . Name);
        Halt

        END;

    (*
     *  If logging is on, note the deletion
     *)

    IF Logging
    THEN
        WriteLn ('Deleted ', NewDirEntry . Name)

    END;
{.PA}
PROCEDURE CopyFile
   (    SourceRootDir    : PathSpec;                                    {005}
        CurrentDirectory : DirectoryEntryPtr;
        FileInfo         : FileEntryPtr;
        DestinRootDir    : PathSpec);                                   {005}

(***********************************************************************

FUNCTIONAL DESCRIPTION:

    Duplicates the source file on the destination.  This duplication al-{005}
    ways includes relative directory and file name, and file attributes.{005}
    In the case of non-directory files, this also includes  modification{005}
    date and time, and contents.                                        {005}

FORMAL PARAMETERS:

    SourceRootDirectory - A PathSpec expression giving the root  direct-{005}
        ory  to  which  DirectoryName  is  a  relative directory for the{005}
        source file.                                                    {005}
    CurrentDirectory - A DirectoryEntryPtr pointing to a  DirectoryEntry
        object describing the directory in which the source file resides
        and in which the target file is to reside.
    FileInfo - A FileEntryPtr pointing to a FileEntry object  describing
        the source file, and which is to describe the target file.
    TargetRootDirectory - A PathSpec expression giving the root  direct-{005}
        ory  to which DirectoryName is a relative directory for the tar-{005}
        get file.                                                       {005}

RETURN VALUE:

    None.

IMPLICIT INPUTS:

    Logging - The BOOLEAN telling whether event logging is currently on.

IMPLICIT OUTPUTS:

    None.

SIDE EFFECTS:

    None.

***********************************************************************)

    CONST

        BufferSize = 1024;

    VAR

        CopyBuffer     : ARRAY [1..BufferSize] OF CHAR;
        DestinHandle   : INTEGER;
        DestinName     : PathSpec;
        Registers      : RegPack;
        SourceHandle   : INTEGER;
        SourceName     : PathSpec;
        TransferSize   : INTEGER;

    BEGIN

    (*
     *  Construct the source and destination file names
     *)

    SourceName := ConstructFileName (SourceRootDir,                     {005}
        CurrentDirectory ^. Name, FileInfo ^. Name);                    {005}
    DestinName := ConstructFileName (DestinRootDir,                     {005}
        CurrentDirectory ^. Name, FileInfo ^. Name);                    {005}
    SourceName [Length (SourceName) + 1] := #$00;
    DestinName [Length (DestinName) + 1] := #$00;

    (*
     *  Now copy the files
     *)

    IF (FileInfo ^. Attr AND DirectoryAttrMask) <> 0
    THEN
        BEGIN

        (*
         *  For a directory, simply create the target directory
         *)

        Registers . AH := DOSFunctionCreateSubDirectory;
        Registers . DS := Seg (DestinName [1]);
        Registers . DX := Ofs (DestinName [1]);
        MsDos (Registers);
        IF ErrorReturn (Registers)                                      {004}
        THEN
            BEGIN

            WriteLn ('Cannot create directory ', DestinName);
            Halt

            END

        END
    ELSE
        BEGIN

        (*
         *  For a file, copy the data and set the creation date and time
         *)

        Registers . AH := DOSFunctionOpenFile;
        Registers . AL := 0;
        Registers . DS := Seg (SourceName [1]);
        Registers . DX := Ofs (SourceName [1]);
        MsDos (Registers);
        IF ErrorReturn (Registers)                                      {004}
        THEN
            BEGIN

            WriteLn ('Cannot open ', SourceName);
            Halt

            END;

        SourceHandle := Registers . AX;

        Registers . AH := DOSFunctionCreateFile;
        Registers . CX := 0;
        Registers . DS := Seg (DestinName [1]);
        Registers . DX := Ofs (DestinName [1]);
        MsDos (Registers);
        IF ErrorReturn (Registers)                                      {004}
        THEN
            BEGIN

            WriteLn ('Cannot create ', DestinName);
            Halt

            END;

        DestinHandle := Registers . AX;

        Registers . AH := DOSFunctionReadFromFile;
        Registers . BX := SourceHandle;
        Registers . CX := BufferSize;
        Registers . DS := Seg (CopyBuffer);
        Registers . DX := Ofs (CopyBuffer);
        MsDos (Registers);
        IF ErrorReturn (Registers)                                      {004}
        THEN
            BEGIN

            WriteLn ('Cannot read ', SourceName);
            Halt

            END;

        TransferSize := Registers . AX;

        WHILE TransferSize > 0
        DO
            BEGIN

            Registers . AH := DOSFunctionWriteToFile;
            Registers . BX := DestinHandle;
            Registers . CX := TransferSize;
            Registers . DS := Seg (CopyBuffer);
            Registers . DX := Ofs (CopyBuffer);
            MsDos (Registers);
            IF ErrorReturn (Registers) OR                               {004}
               (TransferSize <> Registers . AX)
            THEN
                BEGIN

                WriteLn ('Cannot write ', DestinName);
                Halt

                END;

            Registers . AH := DOSFunctionReadFromFile;
            Registers . BX := SourceHandle;
            Registers . CX := BufferSize;
            Registers . DS := Seg (CopyBuffer);
            Registers . DX := Ofs (CopyBuffer);
            MsDos (Registers);
            IF ErrorReturn (Registers)                                  {004}
            THEN
                BEGIN

                WriteLn ('Cannot read ', SourceName);
                Halt

                END;

            TransferSize := Registers . AX

            END;

        (*
         *  The data have been copied.  Set the creation date  and  time
         *  to be that of the source file.
         *)

        Registers . AH := DOSFunctionSetFileDateTime;
        Registers . AL := 1;
        Registers . BX := DestinHandle;
        Registers . CX := FileInfo ^. Time;
        Registers . DX := FileInfo ^. Date;
        MsDos (Registers);
        IF ErrorReturn (Registers)                                      {004}
        THEN
            BEGIN

            WriteLn ('Cannot set date and time on ', DestinName);
            Halt

            END;

        (*
         *  Close the source and destination files
         *)

        Registers . AH := DOSFunctionCloseFile;
        Registers . BX := SourceHandle;
        MsDos (Registers);
        IF ErrorReturn (Registers)                                      {004}
        THEN
            BEGIN

            WriteLn ('Cannot close ', SourceName);
            Halt

            END;

        Registers . AH := DOSFunctionCloseFile;
        Registers . BX := DestinHandle;
        MsDos (Registers);
        IF ErrorReturn (Registers)                                      {004}
        THEN
            BEGIN

            WriteLn ('Cannot close ', DestinName);
            Halt

            END

        END;

    (*
     *  Ensure that the source and target attributes match
     *)

    IF (FileInfo ^. Attr AND NOT DirectoryAttrMask) <> 0
    THEN
        BEGIN

        Registers . AH := DOSFunctionChangeAttributes;
        Registers . AL := 1;
        Registers . DS := Seg (DestinName [1]);
        Registers . DX := Ofs (DestinName [1]);
        Registers . CX := FileInfo ^. Attr;
        MsDos (Registers);
        IF ErrorReturn (Registers)                                      {004}
        THEN
            BEGIN

            WriteLn ('Cannot set attributes for ', DestinName);
            Halt

            END

        END;

    (*
     *  If necessary, log the copying
     *)

    IF Logging
    THEN
        IF (FileInfo ^. Attr AND DirectoryAttrMask) <> 0
        THEN
            WriteLn ('Created directory ', DestinName)
        ELSE
            WriteLn ('Copied ', SourceName, ' to ', DestinName)

    END;
{.PA}
PROCEDURE ReplaceFile
   (    SourceRootDir    : PathSpec;                                    {005}
        CurrentDirectory : DirectoryEntryPtr;
        SourceFile       : FileEntryPtr;
        DestinRootDir    : PathSpec;                                    {005}
        DestinFile       : FileEntryPtr);

(***********************************************************************

FUNCTIONAL DESCRIPTION:

    Replaces a file on the destination drive with one of the  same  path
    specification from the source drive.

FORMAL PARAMETERS:

    SourceRootDirectory - A PathSpec expression giving the root  direct-{005}
        ory  to  which  DirectoryName  is  a  relative directory for the{005}
        source file.                                                    {005}
    CurrentDirectory - A  DirectoryEntryPtr  expression  pointing  to  a
        DirectoryEntry  object  describing  the  directory  in which the
        source and destination files are found.
    SourceFile - A  FileEntryPtr  expression  pointing  to  a  FileEntry
        object describing the source file.
    TargetRootDirectory - A PathSpec expression giving the root  direct-{005}
        ory  to which DirectoryName is a relative directory for the tar-{005}
        get file.                                                       {005}
    DestinationFile - A FileEntryPtr expression pointing to a  FileEntry
        object describing the destination file.

RETURN VALUE:

    None.

IMPLICIT INPUTS:

    None.

IMPLICIT OUTPUTS:

    None.

SIDE EFFECTS:

    None.

***********************************************************************)

    BEGIN

    (*
     *  For directories, nothing need be done
     *)

    IF ((SourceFile ^. Attr AND DirectoryAttrMask) = 0) OR
       ((DestinFile ^. Attr AND DirectoryAttrMask) = 0)
    THEN
        BEGIN

        (*
         *  At least one is a file.  Delete the existing thing, and copy
         *  the new thing
         *)

        DeleteFile (DestinRootDir, CurrentDirectory, DestinFile);       {005}

        CopyFile (SourceRootDir, CurrentDirectory, SourceFile,          {005}
            DestinRootDir)                                              {005}

        END

    END;
{.PA}
PROCEDURE MatchFile
   (    SourceRootDir    : PathSpec;                                    {005}
        CurrentDirectory : DirectoryEntryPtr;
        SourceFile       : FileEntryPtr;
        DestinRootDir    : PathSpec;                                    {005}
        DestinFile       : FileEntryPtr);

(***********************************************************************

FUNCTIONAL DESCRIPTION:

    Modifies the non-directory attributes of a destination file to  dup-
    licate those of a source file.

FORMAL PARAMETERS:

    SourceRootDirectory - A PathSpec expression giving the root  direct-{005}
        ory  to  which  DirectoryName  is  a  relative directory for the{005}
        source file.                                                    {005}
    CurrentDirectory - A DirectoryEntryPtr expression pointing to a Dir-
        ectoryEntry object describing the directory in which the destin-
        ation file is to be found.
    SourceFile - A FileEntryPtr expression pointing to a  FileEntry  ob-
        ject describing the source file.
    TargetRootDirectory - A PathSpec expression giving the root  direct-{005}
        ory  to which DirectoryName is a relative directory for the tar-{005}
        get file.                                                       {005}
    DestinationFile - A FileEntryPtr expression pointing to a  FileEntry
        object describing the destination file.

RETURN VALUE:

    None.

IMPLICIT INPUTS:

    Logging - The BOOLEAN telling whether event logging is currently on.

IMPLICIT OUTPUTS:

    None.

SIDE EFFECTS:

    None.

***********************************************************************)

    VAR

        DestinName : PathSpec;
        Registers  : RegPack;

    BEGIN

    (*
     *  Ensure the attributes match
     *)

    IF SourceFile ^. Attr <> DestinFile ^. Attr
    THEN
        BEGIN

        (*
         *  Copy attributes from the source to the destination
         *)

        DestinName := ConstructFileName (TargetRoot,                    {005}
            CurrentDirectory ^. Name, DestinFile ^. Name);              {005}

        DestinName [Length (DestinName) + 1] := #$00;

        Registers . AH := DOSFunctionChangeAttributes;
        Registers . AL := 1;
        Registers . DS := Seg (DestinName [1]);
        Registers . DX := Ofs (DestinName [1]);
        Registers . CX := SourceFile ^. Attr AND NOT DirectoryAttrMask; {001}
        MsDos (Registers);
        IF ErrorReturn (Registers)                                      {004}
        THEN
            BEGIN

            WriteLn ('Cannot change attributes on ', DestinName);
            Halt

            END;

        (*
         *  If logging, note the change
         *)

        IF Logging
        THEN
            WriteLn ('Modified attributes of ', DestinName)

        END

    END;
{.PA}
(***********************************************************************

FUNCTIONAL DESCRIPTION:

    Modifies a target volume to  duplicate  as  closely  as  possible  a
    source volume.

COMMAND LINE:

    <SourceRoot> <TargetRoot> [/[NO]LOG] [/[NO]ACCUMULATE]              {009}

RETURN VALUE:

    None.

IMPLICIT INPUTS:

    SourceRoot - The root directory of the source directory tree.       {009}
    TargetRoot - The root directory of the target directory tree.       {009}
    Accumulating - The BOOLEAN telling whether files on the  target  are{009}
        to be retained if they are not on the source.                   {009}

IMPLICIT OUTPUTS:

    None.

SIDE EFFECTS:

    None.

***********************************************************************)

VAR

    CurrentDirectory   : DirectoryEntryPtr;
    DestinDirectory    : FileEntryQueue;
    PendingDirectories : DirectoryEntryPtr;
    SourceDirectory    : FileEntryQueue;

BEGIN

(*
 *  Print the copyright notice
 *)

WriteLn ('TREEDUPL version ', VersionIdentification);                   {008,002}
WriteLn;

(*                                                                      {009}
 *  Parse the command line                                              {009}
 *)                                                                     {009}

ParseCommandLine;                                                       {009}

(*
 *  Initialize the directory needing duplication to be the root
 *)

GetMem (PendingDirectories, DirectoryEntrySize);                        {005}
PendingDirectories ^. Next := NIL;
PendingDirectories ^. Name := '';                                       {005}

(*
 *  Copy the directories on the pending directory list
 *)

WHILE PendingDirectories <> NIL
DO
    BEGIN

    CurrentDirectory := PendingDirectories;
    PendingDirectories := PendingDirectories ^. Next;

    (*
     *  Expand directories on the two volumes
     *)

    ExpandDirectory (SourceRoot, CurrentDirectory, SourceDirectory);    {005}
    ExpandDirectory (TargetRoot, CurrentDirectory, DestinDirectory);    {005}

    (*
     *  Extract the directories from the source listing
     *)

    ExtractDirectories (CurrentDirectory, SourceDirectory,
        PendingDirectories);

    (*
     *  Ensure that the contents of the source and  destination  direct-
     *  ories match
     *)

    WHILE (SourceDirectory . Head <> NIL) OR
          (DestinDirectory . Head <> NIL)
    DO
        BEGIN

        IF SourceDirectory . Head = NIL
        THEN
            BEGIN

            (*
             *  The  source  directory  has  been  exhausted  before the
             *  destination directory.  Delete the destination directory
             *  file if not accumulating files.                         {003}
             *)

            IF NOT Accumulating                                         {003}
            THEN                                                        {003}
                DeleteFile (TargetRoot, CurrentDirectory,               {005}
                    DestinDirectory . Head);
            AdvanceFile (DestinDirectory)

            END
        ELSE IF DestinDirectory . Head = NIL
        THEN
            BEGIN

            (*
             *  The destination directory has been exhausted before  the
             *  source directory.  Copy the file.
             *)

            CopyFile (SourceRoot, CurrentDirectory,                     {005}
                SourceDirectory . Head, TargetRoot);                    {005}
            AdvanceFile (SourceDirectory)

            END
        ELSE IF SourceDirectory . Head ^. Name <
                DestinDirectory . Head ^. Name
        THEN
            BEGIN

            (*
             *  The destination directory does not have a  file  of  the
             *  same name as the file in the source directory.  Copy the
             *  file.
             *)

            CopyFile (SourceRoot, CurrentDirectory,                     {005}
                SourceDirectory . Head, TargetRoot);                    {005}
            AdvanceFile (SourceDirectory)

            END
        ELSE IF SourceDirectory . Head ^. Name >
                DestinDirectory . Head ^. Name
        THEN
            BEGIN

            (*
             *  The destination directory has a file whose name  is  not
             *  in  the source directory.  Delete the destinatin file if{003}
             *  not accumulating files.                                 {003}
             *)

            IF NOT Accumulating
            THEN
                DeleteFile (TargetRoot, CurrentDirectory,               {005}
                    DestinDirectory . Head);
            AdvanceFile (DestinDirectory)

            END
        ELSE IF NOT IDAttrMatch (SourceDirectory . Head,
                                 DestinDirectory . Head)
        THEN
            BEGIN

            (*
             *  The source and destination directories have files of the
             *  same  name,  but  the  identity attributes do not match.
             *  Delete the file in the destination directory,  and  copy
             *  the file from the source directory.
             *)

            ReplaceFile (SourceRoot, CurrentDirectory,                  {005}
                SourceDirectory . Head, TargetRoot,                     {005}
                DestinDirectory . Head);
            AdvanceFile (SourceDirectory);
            AdvanceFile (DestinDirectory)
            END
        ELSE
            BEGIN

            (*
             *  The source and destination directories have files of the
             *  same name and the identity attributes match.   Make  the
             *  MS-DOS file attributes match.
             *)

            MatchFile (SourceRoot, CurrentDirectory,                    {005}
                SourceDirectory . Head, TargetRoot,                     {005}
                DestinDirectory . Head);
            AdvanceFile (SourceDirectory);
            AdvanceFile (DestinDirectory)

            END

        END;

    (*
     *  The current directory has been handled.
     *)

    FreeMem (CurrentDirectory, DirectoryEntrySize +
        Length (CurrentDirectory ^. Name));

    END

 END.