home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / visionix / vcopyu.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-12-29  |  82.8 KB  |  3,135 lines
  1. {
  2.  ════════════════════════════════════════════════════════════════════════════
  3.  
  4.  Visionix File Copy Unit (VCOPY)
  5.    Version 0.17
  6.  Copyright 1991,92,93 Visionix
  7.  ALL RIGHTS RESERVED
  8.  
  9.  ────────────────────────────────────────────────────────────────────────────
  10.  
  11.  Revision history in reverse chronological order:
  12.  
  13.  Initials  Date      Comment
  14.  ────────  ────────  ────────────────────────────────────────────────────────
  15.  
  16.  jrt       12/23/93  Cleaned up and added documentation
  17.  
  18.  jrt       10/27/93  Renamed from VCOPY to VCOPYu for BETA 0.30
  19.  
  20.  jrt       10/13/93  Put a call to VMultiDo in various parts of the
  21.                      code.
  22.  
  23.  jrt       05/15/93  Merged with beta 0.20b code.
  24.  
  25.  mep       04/30/93  Finished callback procedures and documentation.
  26.                      Optimized some code.
  27.  
  28.  mep       03/26/93  Fixed bug with "Append" command.  Also added use of
  29.                      VType.maxArrSize variable.
  30.  
  31.  mep       03/23/93  Updated show parameter and added to "CallBack" stuff.
  32.  
  33.  mep       03/12/93  Added External "CallBack" Procedure for user interface.
  34.  
  35.  mep       02/12/93  Fixed bug with ListFile (EOF).
  36.  
  37.  mep       02/11/93  Cleaned up code for beta release
  38.  
  39.  jrt       02/08/93  Sync with beta 0.12 release
  40.  
  41.  mep       01/24/93  Few minor bug fixes.
  42.  
  43.  mep       12/22/92  General cleanup of code.
  44.  
  45.  mep       12/18/92  Deleted: SHOWFILES, SHOWATTR.
  46.                      Added: SHOW=FADTPS
  47.  
  48.  mep       12/16/92  Now allowed to place wildcards, target paths, and
  49.                        additional parameters per line in a list file
  50.                        (see below for usage).
  51.                      Ranged dates are now allowed by using multiple
  52.                        DATE/TIME parameter fields.
  53.                      Added new parameters: DATEOA, DATEOB, TIMEOA, and TIMEOB.
  54.  
  55.  mep       12/09/92  New functionality throughout unit.
  56.                      Fixed VCopySetFlag and VCopyClearFlag to work with
  57.                        the LongInt flag.  Also fixed some bugs.
  58.                      Added new parameters: TESTMODE, TARGETDIRONLY,
  59.                        and SHOWATTR.
  60.                      Added @ListFile for selected file copies.
  61.                      Changed MAKEDIR command to MAKETARGETDIR.
  62.  
  63.  mep       12/06/92  Moved some functions to VGen
  64.  
  65.  jrt       11/21/92  Sync with beta 0.08
  66.  
  67.  mep       11/19/92  Added most of the planned functionality.
  68.  
  69.  mep       11/04/92  First logged revision.
  70.  
  71.  ────────────────────────────────────────────────────────────────────────────
  72. }
  73.  
  74. (*-
  75.  
  76. [TEXT]
  77.  
  78. <Overview>
  79.  
  80.   VCOPYu contains two functions, VCopyFile and VCopyFileEx.
  81.  
  82.   The VCopyFile function allows you
  83.   to copy files from one place to another.  It supports wildcards,
  84.   copy from/to date ranges; copy files with specified attributes,
  85.   the ability to copy sub-directories, and more.
  86.  
  87.   The VCopyFileEx function does everything that VCopyFile does,
  88.   with the added capability to have VCopyFileEx call a "call-back"
  89.   procedure that you can specify when different VCopyFile events
  90.   occur.  (Such as: starting a new file, read error, write error, etc)
  91.  
  92. <Interface>
  93.  
  94. -*)
  95.  
  96.  
  97. Unit VCopyu;
  98.  
  99. INTERFACE
  100.  
  101. Uses
  102.  
  103.   DOS,
  104.   VTypesu,
  105.   VStringu,
  106.   VGenu,
  107.   VMultiu,
  108.   VDOSHu,
  109.   VDatesu;
  110.  
  111. Const
  112.  
  113.   {-------------------}
  114.   { VCopy Error Codes }
  115.   {-------------------}
  116.  
  117.   erVCopy_None             = 0;  { No error occurred }
  118.   erVCopy_SamePath         = 1;  { Source and target paths are the same }
  119.   erVCopy_NoExistFileFrom  = 2;  { Source file path does not exist }
  120.   erVCopy_NoExistFileTo    = 3;  { Target file path does not exist }
  121.   erVCopy_NoExistDirFrom   = 4;  { Source directory path does not exist }
  122.   erVCopy_NoExistDirTo     = 5;  { Target directory path does not exist }
  123.   erVCopy_NoRoom           = 6;  { No room left in target path }
  124.   erVCopy_Timeout          = 7;  { Timeout has been exceeded }
  125.   erVCopy_ListFileNotFound = 9;  { List file was not found }
  126.   erVCopy_TargetPathIsFile = 10; { Target path is actually a file }
  127.   erVCopy_Fail             = 11; { Failed copying of file(s) }
  128.  
  129.   {------------------------}
  130.   { Global Callback Events }
  131.   {------------------------}
  132.  
  133.   cbeSourceOpen  = $00000001;  { Opening the source file }
  134.   cbeTargetOpen  = $00000002;  { Opening the target file }
  135.   cbeReadBlock   = $00000004;  { Reading a block from the source file }
  136.   cbeWriteBlock  = $00000008;  { Writing a block to the target file }
  137.   cbeSourceClose = $00000010;  { Closing the source file }
  138.   cbeTargetClose = $00000020;  { Closing the target file }
  139.   cbeIOErr       = $00000040;  { Some I/O error has occured }
  140.   cbeVCopyErr    = $00000080;  { Some VCopy error has occured }
  141.   cbeAll         = $0000FFFF;  { Report all global events }
  142.  
  143.   {---------------------------}
  144.   { Selective Callback Events }
  145.   {---------------------------}
  146.  
  147.   cbeExternReadBlock  = $00010000;  { Calling an external procedure to read  }
  148.                                     { a block.  Buffer and amount given.     }
  149.   cbeExternWriteBlock = $00020000;  { Calling an external procedure to write }
  150.                                     { a block.  Buffer and amount given.     }
  151.  
  152.  
  153.   cbsRead             = $00000001;
  154.   cbsWrite            = $00000002;
  155.  
  156.   ccOK                = 0;
  157.   ccAbort             = 1000;
  158.   ccRetry             = 2000;
  159.   ccFail              = 3000;
  160.  
  161.   {---------------------------------------}
  162.   { Date and Time output for Show command }
  163.   { following VDates rules.               }
  164.   {---------------------------------------}
  165.  
  166.   vcDateStr           : STRING = '$M+ $D+, Y+';
  167.   vcTimeStr           : STRING = 'HH:II';
  168.   vcPackDateStr       : STRING = 'MM-DD-YY';
  169.  
  170. Type
  171.  
  172.   TCopyCallBackInfo = RECORD
  173.  
  174.     Event     : LONGINT;
  175.     StrParam  : STRING;
  176.     NumParam1 : LONGINT;
  177.     NumParam2 : LONGINT;
  178.     PtrParam1 : POINTER;
  179.     RetCode   : LONGINT
  180.  
  181.   END;
  182.   PCopyCallBackInfo = ^TCopyCallBackInfo;
  183.  
  184.   TCopyCallBackProc = Procedure( CBI : PCopyCallBackInfo );
  185.   PCopyCallBackProc = ^TCopyCallBackProc;
  186.  
  187.  
  188. {────────────────────────────────────────────────────────────────────────────}
  189.  
  190. Function VCopyFile(     stPathFrom  : PathStr;
  191.                         stPathTo    : PathStr;
  192.                         Params      : STRING     ) : INTEGER;
  193.  
  194. (*-
  195.  
  196. [FUNCTION]
  197.  
  198. Function VCopyFile(     stPathFrom  : PathStr;
  199.                         stPathTo    : PathStr;
  200.                         Params      : STRING     ) : INTEGER;
  201.  
  202.  
  203. [PARAMETERS]
  204.  
  205.   stPathFrom ... [d:][path]filespec(s) for source of copy.  Wildcards allowed.
  206.  
  207.                         or
  208.  
  209.              ... @[d:][path]listfile - get filespec(s) from this text file.
  210.                  (see notes below).
  211.  
  212.   stPathTo   ... [d:][path]filespec(s) for target.  Wildcard-mask allowed.
  213.  
  214.   Params     ... the 23 defined parameters:
  215.  
  216.     MOVE             Move instead of copy.
  217.  
  218.     NOOVERWRITE      Do not overwrite duplicate target file.
  219.  
  220.     SUBDIR           Copy source directory and all subdirectories.
  221.  
  222.     SHOW=FADTPS      Show each file's general info:
  223.                        Filename, Attributes, Date, Time, Packed-date, or Size.
  224.  
  225.     ATTR=ASHR        Search mask for source attributes types:
  226.                        Archive, System, Hidden, and Readonly
  227.  
  228.     EXACTATTR        Each found source file needs to be exactly the above
  229.                        attribute mask in order to be copied.
  230.  
  231.     NEWER            Copy only if target doesn't exist or source is newer.
  232.  
  233.     SHARE            Use file-sharing/locking for copy.
  234.  
  235.     TIMEOUT=SSS      Timeout for events (like SHARE).
  236.  
  237.     APPEND           Append source file(s) to single target file.
  238.  
  239.     DATE=MM-DD-YY    Copy file(s) ON this date.
  240.  
  241.     DATEB=MM-DD-YY   Copy file(s) BEFORE this date.
  242.  
  243.     DATEA=MM-DD-YY   Copy file(s) AFTER this date.
  244.  
  245.     DATEOB=MM-DD-YY  Copy file(s) ON or BEFORE this date.
  246.  
  247.     DATEOA=MM-DD-YY  Copy file(s) ON or AFTER this date.
  248.  
  249.     TIME=HH:MM       Copy file(s) AT this time.
  250.  
  251.     TIMEB=HH:MM      Copy file(s) BEFORE this time.
  252.  
  253.     TIMEA=HH:MM      Copy file(s) AFTER this time.
  254.  
  255.     TIMEOB=HH:MM     Copy file(s) ON or BEFORE this time.
  256.  
  257.     TIMEOA=HH:MM     Copy file(s) ON or AFTER this time.
  258.  
  259.     MAKETARGETDIR    Create the target directory if it does not exist.
  260.                        Otherwise, stPathTo will be thought as the target
  261.                        filename (wildcard) mask.
  262.  
  263.     TARGETDIRONLY    Do not create target subdirectories to match source
  264.                        subdirectories; instead, copy all source filespecs
  265.                        only to the main target directory.
  266.  
  267.     TESTMODE         Do everything as usual except the actual copying.
  268.  
  269. [RETURNS]
  270.  
  271.   VCopyFile returns a VCopy Error.
  272.  
  273.     {-------------------}
  274.     { VCopy Error Codes }
  275.     {-------------------}
  276.  
  277.     erVCopy_None             = 0;  { No error occurred }
  278.     erVCopy_SamePath         = 1;  { Source and target paths are the same }
  279.     erVCopy_NoExistFileFrom  = 2;  { Source file path does not exist }
  280.     erVCopy_NoExistFileTo    = 3;  { Target file path does not exist }
  281.     erVCopy_NoExistDirFrom   = 4;  { Source directory path does not exist }
  282.     erVCopy_NoExistDirTo     = 5;  { Target directory path does not exist }
  283.     erVCopy_NoRoom           = 6;  { No room left in target path }
  284.     erVCopy_Timeout          = 7;  { Timeout has been exceeded }
  285.     erVCopy_ListFileNotFound = 9;  { List file was not found }
  286.     erVCopy_TargetPathIsFile = 10; { Target path is actually a file }
  287.     erVCopy_Fail             = 11; { Failed copying of file(s) }
  288.  
  289.  
  290. [DESCRIPTION]
  291.  
  292.   ■ There are no set order for parameters to be passed in - only that
  293.       there be no spaces in the string and that commas are used between
  294.       all parameters.
  295.  
  296.   ■ Share parameter is for network environments, where a source/target file
  297.       might be opened by someone else.  In order to insure system integrity,
  298.       VCopy will keep polling on the file until it becomes available or a
  299.       timeout occurs.
  300.  
  301.   ■ Timeout for events defaults to 30 seconds.
  302.  
  303.   ■ VCopy is fully compliant with VMulti.  (It calls VMultiDO to keep
  304.     multi-procedures running)
  305.  
  306.   ■ When using a listfile, it is a valid ASCII file containing line-by-line
  307.       valid filenames (including exact path if not in default directory)
  308.       with three parameters per line (the second two are optional) -
  309.       (1) Source filespec, (2) target filespec, and (3) additional parameters.
  310.       Spacing between these three parameters is not significant.
  311.  
  312.       Usage: SourcePath [TargetPath] [/AdditionalParams]
  313.  
  314.       Although the TargetPath is optional (defaults to stPathTo if
  315.       not present), the SourcePath must be present for a copy to occur.
  316.  
  317.       If additional parameters are needed for a specific line, just
  318.       add them the same way the parameters are originally passed in,
  319.       except remember to add a "/" BEFORE the additional parameter list.
  320.  
  321.   ■ In TestMode, the SubDir (actual directory creation/removal), NoOverwrite
  322.       and Newer flags do not function.
  323.  
  324.  
  325. [SEE-ALSO]
  326.  
  327. VCopyFileEx
  328.  
  329. [EXAMPLE]
  330.  
  331.   #1  Copy COMMAND.COM to drive E root directory.
  332.  
  333.       VCopyFile('C:\COMMAND.COM','E:\','');
  334.  
  335.   #2  Move all of drive D to drive E's TEST directory and show files.
  336.         It will create directory TEST if not there.  In addition, this
  337.         will create all of the target directories under the main source
  338.         directory and place the target files accordingly.
  339.  
  340.       VCopyFile('D:\', 'E:\TEST', 'MOVE,SUBDIR,MAKETARGETDIR,SHOW=F');
  341.  
  342.   #3  Copy all files with ONLY the Hidden and System attributes set
  343.         from drive C to drive A.
  344.  
  345.       VCopyFile('C:\', 'A:\', 'SUBDIR,SHOW=F,ATTR=HS,EXACTATTR');
  346.  
  347.   #4  Copy all files in subdirectory DOS that match the wildcard pattern
  348.         to subdirectory B (create if not exist) with a different mask.
  349.  
  350.       VCopyFile('\DOS\*.COM', '\B\*.BIN', 'SHOW=F,MAKETARGETDIR');
  351.  
  352.   #5  Copy all files from subdirectory TEST1 to subdirectory TEST2
  353.         in week of 01-03-93 to 01-09-93.  Note that these directories
  354.         are considered in the "current/default" directory; if not, make
  355.         sure the full path for each is supplied.
  356.  
  357.       VCopyFile('TEST1', 'TEST2', 'DATEOA=01-03-93,DATEOB=01-09-93');
  358.  
  359.   #6  Copy all of drive D to drive E's TEST directory and show files.
  360.         (see example #2).  The difference is that the target directories
  361.         will not be created; rather, all of the matching source files
  362.         will only go into the TEST directory.
  363.  
  364.       VCopyFile('D:\', 'E:\TEST', 'SUBDIR,MAKETARGETDIR,TARGETDIRONLY,SHOW=F');
  365.  
  366.   #7  Copy all the files inside listfile C:\DIR.LST into subdirectory
  367.         D:\TEST with default parameters - each line will add to this set.
  368.  
  369.       VCopyFile('@C:\FILE.LST', 'D:\TEST', 'SHOW=F,TARGETDIRONLY' );
  370.  
  371.       The listfile 'C:\FILE.LST' looks like this:
  372.       ---
  373.       C:\WINDOWS\HIMEM.SYS
  374.       F:\WP51\*.*   C:\WP51         /MAKETARGETDIR,SUBDIR,SHOW=A
  375.       C:\DOS\C*.*  D:\SHIP\*.BAT
  376.       ---
  377.  
  378.       The first pathspec "C:\WINDOWS\HIMEM.SYS" will be copied to
  379.         directory D:\TEST.
  380.  
  381.       The second pathspec "F:\WP51\*.*" will copy all files in and under
  382.         that subdirectory to drive C subdirectory WP51 (and create it if
  383.         it doesn't exist), while showing each file's attribute set.
  384.  
  385.       The third pathspec "C:\DOS\C*.*" will copy all files that match
  386.         the wildcards to D:\SHIP while renaming all files to *.BAT.  Note
  387.         that the additional parameters toggled on the second line did not
  388.         occur on this line.
  389.  
  390.   ══════════════════════════════════════════════════════════════════════════
  391.  
  392. -*)
  393.  
  394. Function VCopyFileEx(   stPathFrom  : PathStr;
  395.                         stPathTo    : PathStr;
  396.                         Params      : STRING;
  397.                         CBEvents    : LONGINT;
  398.                         CBProc      : PCopyCallBackProc   ) : INTEGER;
  399.  
  400. (*-
  401.  
  402. [FUNCTION]
  403.  
  404. Function VCopyFileEx(   stPathFrom  : PathStr;
  405.                         stPathTo    : PathStr;
  406.                         Params      : STRING;
  407.                         CBEvents    : LONGINT;
  408.                         CBProc      : PCopyCallBackProc   ) : INTEGER;
  409.  
  410. [PARAMETERS]
  411.  
  412.   VCopyFileEx returns a VCopy Error (see above constants).
  413.  
  414.   stPathFrom, stPathTo, and Params are same as VCopyFile (see above).
  415.  
  416.   CBProc     ... A pointer to a user-defined procedure.
  417.  
  418.   CBEvents   ... Selected callback events:
  419.  
  420.     Global Events
  421.     -------------
  422.  
  423.     cbeSourceOpen       = Opening the source file.
  424.     cbeTargetOpen       = Opening the target file.
  425.     cbeReadBlock        = Reading a block from the source file.
  426.     cbeWriteBlock       = Writing a block to the target file.
  427.     cbeSourceClose      = Closing the source file.
  428.     cbeTargetClose      = Closing the target file.
  429.     cbeIOErr            = Some I/O error has occured.
  430.     cbeVCopyErr         = Some VCopy error has occured.
  431.     cbeAll              = All of the above.
  432.  
  433.     Selective Events
  434.     ----------------
  435.  
  436.     cbeExternReadBlock  = Calling an external procedure to read a block.
  437.     cbeExternWriteBlock = Calling an external procedure to write a block.
  438.  
  439. [RETURNS]
  440.  
  441.   VCopyFile returns a VCopy Error.
  442.  
  443.     {-------------------}
  444.     { VCopy Error Codes }
  445.     {-------------------}
  446.  
  447.     erVCopy_None             = 0;  { No error occurred }
  448.     erVCopy_SamePath         = 1;  { Source and target paths are the same }
  449.     erVCopy_NoExistFileFrom  = 2;  { Source file path does not exist }
  450.     erVCopy_NoExistFileTo    = 3;  { Target file path does not exist }
  451.     erVCopy_NoExistDirFrom   = 4;  { Source directory path does not exist }
  452.     erVCopy_NoExistDirTo     = 5;  { Target directory path does not exist }
  453.     erVCopy_NoRoom           = 6;  { No room left in target path }
  454.     erVCopy_Timeout          = 7;  { Timeout has been exceeded }
  455.     erVCopy_ListFileNotFound = 9;  { List file was not found }
  456.     erVCopy_TargetPathIsFile = 10; { Target path is actually a file }
  457.     erVCopy_Fail             = 11; { Failed copying of file(s) }
  458.  
  459. [DESCRIPTION]
  460.  
  461.   NOTES:
  462.  
  463.   ■ The main use of the callback procedure is for a program to keep an
  464.       update status of what has been occuring during the copying process
  465.       (ie. updating "Copy Percentage Complete" view-bars).
  466.  
  467.   ■ Note that the callback procedure is always called BEFORE the actual
  468.       event is going to occur (useful for traps).
  469.  
  470.   ■ CBEvents are the conditions when the callback procedure will be called.
  471.       When the cbeAll event is issued, all Global Events will be reported
  472.       to the callback procedure - no Selective Events are included with the
  473.       cbeAll.
  474.  
  475.   ■ CBProc is a far-called procedure of type TCopyCallBackProc defined as:
  476.       Procedure(CBI : PCopyCallBackInfo).  Make sure you type cast your
  477.       user-defined callback procedure to work as such.  VCopy will be the
  478.       only one calling this procedure.  Also, the event packets are defined
  479.       below for each event.
  480.  
  481.   ■ External reading/writing routines during a file copy are allowed by
  482.       supplying the cbeExtern events within the CBEvents, and including the
  483.       appropriate routines within your callback procedure.  This is useful
  484.       if VCopy's internal methods do not work properly (some proprietary
  485.       devices do not work with standard BlockRead/BlockWrite commands).
  486.  
  487.       VCopy will give you buffers to use, so unless you need you own for
  488.       some reason, use the buffers at the defined PtrParam (PtrParam points
  489.       to the first byte in the buffer).  Also, a request will be sent to
  490.       your external read/write routines with the number of bytes to
  491.       read/write.  This might vary with the actual amount, which always
  492.       needs to get returned from your procedure.
  493.  
  494.  
  495.   CALLBACK EVENT PACKETS:
  496.  
  497.  
  498.   Global Events
  499.   -------------
  500.  
  501.     cbeSourceOpen
  502.     -------------
  503.       ENTRY :
  504.         StrParam  := Source file
  505.  
  506.       EXIT  : none
  507.  
  508.     cbeTargetOpen
  509.     -------------
  510.       ENTRY :
  511.         StrParam  := Target file
  512.         NumParam1 := File mode:
  513.                        0   = Rewrite
  514.                        100 = Append
  515.  
  516.       EXIT  : none
  517.  
  518.     cbeReadBlock
  519.     ------------
  520.       ENTRY :
  521.         StrParam  := Source file
  522.         NumParam1 := Number of bytes wanting to read
  523.         PtrParam  := VCopy's internal buffer.  The length here equals the
  524.                        NumParam1 entry parameter
  525.         RetCode   := 0
  526.  
  527.       EXIT  :
  528.         RetCode   := Result of read operation report:
  529.                        0    = OK/Continue
  530.                        1000 = Abort current copy
  531.                        3000 = Fail all copies
  532.  
  533.     cbeWriteBlock
  534.     -------------
  535.       ENTRY :
  536.         StrParam  := Target file
  537.         NumParam1 := Number of bytes wanting to write (actual read bytes)
  538.                        0 = if end of source (copy complete)
  539.         PtrParam  := VCopy's internal buffer.  The length here equals
  540.                        the NumParam1 Entry parameter in the previously called
  541.                        cbeExternReadBlock or cbeReadBlock event (they are
  542.                        treated here the same)
  543.         RetCode   := 0
  544.  
  545.       EXIT  :
  546.         RetCode   := Result of write operation report:
  547.                        0    = OK/Continue
  548.                        1000 = Abort current copy
  549.                        3000 = Fail all copies
  550.  
  551.     cbeSourceClose
  552.     --------------
  553.       ENTRY :
  554.         StrParam  := Source file
  555.  
  556.       EXIT  : none
  557.  
  558.     cbeTargetClose
  559.     --------------
  560.       ENTRY :
  561.         StrParam  := Target file
  562.  
  563.       EXIT  : none
  564.  
  565.     cbeIOErr
  566.     --------
  567.       ENTRY :
  568.         NumParam1 := IO error of last operation
  569.  
  570.       EXIT  :
  571.         RetCode   := Result of user-defined IO error report operation:
  572.                        0    = OK/Fixed
  573.                        1000 = Abort
  574.                        2000 = Retry last operation
  575.                        3000 = Fail all copies
  576.  
  577.     cbeVCopyErr
  578.     -----------
  579.       ENTRY :
  580.         NumParam1 := VCopy errorcode
  581.  
  582.       EXIT  : none
  583.  
  584.  
  585.   Selective Events
  586.   ----------------
  587.  
  588.     cbeExternReadBlock
  589.     ------------------
  590.       ENTRY :
  591.         StrParam  := Source file
  592.         NumParam1 := Number of bytes wanting to read
  593.         PtrParam  := VCopy's internal buffer.  The length here equals the
  594.                        NumParam1 entry parameter
  595.         RetCode   := 0
  596.  
  597.       EXIT  :
  598.         NumParam1 := Number of bytes actually read
  599.                        0 = End of copy
  600.         PtrParam  := Filled buffer
  601.         RetCode   := Result of user-defined read operation:
  602.                        0    = OK/Continue
  603.                        1000 = Abort current copy
  604.                        3000 = Fail all copies
  605.  
  606.     cbeExternWriteBlock
  607.     -------------------
  608.       ENTRY :
  609.         StrParam  := Target file
  610.         NumParam1 := Number of bytes wanting to write (actual read bytes)
  611.                        0 = if end of source (copy complete)
  612.         PtrParam  := VCopy's internal buffer.  The length here equals
  613.                        the NumParam1 Entry parameter in the previously called
  614.                        cbeExternReadBlock or cbeReadBlock event (they are
  615.                        treated here the same)
  616.         RetCode   := 0
  617.  
  618.       EXIT  :
  619.         NumParam1 := Number of bytes actually wrote
  620.         RetCode   := Result of user-defined write operation:
  621.                        0    = OK/Continue
  622.                        1000 = Abort current copy
  623.                        3000 = Fail all copies
  624.  
  625.  
  626.  
  627. [EXAMPLE]
  628.  
  629.   #1  Copy COMMAND.COM to drive D root directory allowing reports of all
  630.       global events into MyCopyProc.
  631.  
  632.       VCopyFileEx('C:\COMMAND.COM','D:\','',cbeAll,@MyCopyProc);
  633.  
  634.       ..where an example MyCopyProc could be..
  635.  
  636.       Procedure MyCopyProc( CBI : PCopyCallBackInfo ); Far;
  637.       Var Ch : Char;
  638.       BEGIN
  639.         With TCopyCallBackInfo( CBI^ ) Do
  640.         BEGIN
  641.           Case Event of
  642.             cbeSourceOpen : WriteLn('Opening source file ', StrParam);
  643.             cbeTargetOpen :
  644.               case NumParam1 of
  645.                 0 : WriteLn('Opening target file ', StrParam);
  646.                 100 : WriteLn('Appending target file ', StrParam);
  647.               end;
  648.             cbeReadBlock  : WriteLn('Reading ', NumParam1, ' bytes.');
  649.             cbeWriteBlock :
  650.               If (NumParam1 = 0) Then
  651.                 WriteLn('Copy complete.')
  652.               Else
  653.                 WriteLn('Writing ', NumParam1, ' bytes.');
  654.             cbeSourceClose: WriteLn('Closing source file ', StrParam);
  655.             cbeTargetClose: WriteLn('Closing target file ', StrParam);
  656.             cbeIOErr :
  657.               BEGIN
  658.                 WriteLn('IO Error ', NumParam1, '. Abort, Retry, Fail?');
  659.                 Ch := Readkey;
  660.                 Case UpCase(Ch) of
  661.                   'A' : RetCode := 1000;
  662.                   'R' : RetCode := 2000;
  663.                   'F' : RetCode := 3000;
  664.                 End;
  665.               END;
  666.           End;
  667.         END;
  668.       END;
  669.  
  670.   #2  Copy all of drive C root directory to D:\TEMP (and create if not exist)
  671.       without a callback event procedure.  Note that this is what the regular
  672.       VCopyFile function does.
  673.  
  674.       VCopyFileEx('C:\', 'D:\TEMP', 'MAKETARGETDIR', cbeAll, NIL);
  675.  
  676.   #3  Copy all of drive C root directory to drive Y using no reports, but
  677.       will use external read/write block routines.
  678.  
  679.       VCopyFileEx('C:\', 'Y:\', '',
  680.                   cbeExternReadBlock + cbeExternWriteBlock,
  681.                   @MyCopyRoutine);
  682.  
  683.       ..where an example MyCopyRoutine would read/write the buffer.
  684.  
  685.   #4  Copy all of drive C root directory to D:\TEMP with all global events
  686.       reported except cbeIOErr to MyCopyProc.
  687.  
  688.       VCopyFileEx('C:\', 'D:\TEMP', '', cbeAll - cbeIOErr, @MyCopyProc);
  689.  
  690.       ..where MyCopyProc could be as example #1.
  691.  
  692.  
  693. -*)
  694.  
  695. {────────────────────────────────────────────────────────────────────────────}
  696. {────────────────────────────────────────────────────────────────────────────}
  697.  
  698. IMPLEMENTATION
  699.  
  700. Const
  701.  
  702.   coMove          = 0;
  703.   coNoOverwrite   = 1;
  704.   coSubDir        = 2;
  705.   coExactAttr     = 3;
  706.   coNewer         = 4;
  707.   coShare         = 5;
  708.   coAppend        = 6;
  709.   coMakeTargetDir = 7;
  710.   coTargetDirOnly = 8;
  711.   coTestMode      = 9;
  712.   coListFile      = 10;
  713.   coShow          = 11;
  714.  
  715.   {---------------------}
  716.   { Internal file flags }
  717.   {---------------------}
  718.  
  719.   iffReadOnly   = $01;
  720.  
  721.   iffFilename   = 0;
  722.   iffAttrib     = 1;
  723.   iffDate       = 2;
  724.   iffTime       = 3;
  725.   iffPackedDate = 4;
  726.   iffSize       = 5;
  727.  
  728.   iffSource     = 0;
  729.   iffTarget     = 1;
  730.  
  731.   iffAppend     = 100;
  732.  
  733.   iffOk         = 0;
  734.   iffAbort      = 1000;
  735.   iffRetry      = 2000;
  736.   iffFail       = 3000;
  737.  
  738.   showDelim : STRING = '·';
  739.  
  740. Type
  741.  
  742.   TFile = RECORD
  743.  
  744.     OrgPath   : PathStr;    { Original Path (unexpanded)                  }
  745.     Path      : PathStr;    { Main expanded Path as a passed-in parameter }
  746.     WildCard  : DirStr;     { Wildcards of Path (or InPath)               }
  747.     Drive     : CHAR;       { Drive of Path                               }
  748.     OrgDir    : DirStr;     { Original Directory of Path                  }
  749.     Dir       : DirStr;     { Directory of Path                           }
  750.     fi        : FILE;       { FILE type for Path                          }
  751.  
  752.     FName     : PathStr;    { Final name to use for copy                  }
  753.     Time      : LONGINT;    { Date and Time of FName                      }
  754.     Attr      : WORD;       { Attributes of FName                         }
  755.     Size      : LONGINT;    { File size of FName                          }
  756.  
  757.     fiFlag    : BYTE;       { Bitfield flags for events:                  }
  758.                             { [0] = did file have ReadOnly flag?          }
  759.  
  760.   END;
  761.  
  762.   PFile = ^TFile;
  763.  
  764.   {---}
  765.  
  766.   TDTClass = ( Date, DateB, DateA, DateOB, DateOA,
  767.                Time, TimeB, TimeA, TimeOB, TimeOA,
  768.                MarkPos );
  769.  
  770.   PFileDT = ^TFileDT;
  771.   TFileDT = RECORD
  772.  
  773.     Class : TDTClass;
  774.     Data  : WORD;
  775.  
  776.     Pred  : PFileDT;
  777.     Next  : PFileDT;
  778.  
  779.   END;
  780.  
  781.   {---}
  782.  
  783.   TCopyIData = RECORD
  784.  
  785.     orgFlag   : LONGINT;    { Original Options flag                          }
  786.     orgTimeout: WORD;       { Original Timeout for events seconds)           }
  787.     orgSeAttr : BYTE;       { Original Source searching attribute mask       }
  788.  
  789.     opFlag    : LONGINT;    { Current Options flag                           }
  790.     ShowFlag  : BYTE;       { Current SHOW parameter features active         }
  791.     Timeout   : WORD;       { Current Timeout for events (in seconds)        }
  792.     seAttr    : BYTE;       { Current Source searching attribute mask        }
  793.     seDT      : PFileDT;    { Search Date/Time link list to comp with file   }
  794.  
  795.     ListF     : TEXT;       { List file instead of searching drive           }
  796.     ListFName : PathStr;    { Assigned list filename                         }
  797.  
  798.     stFrom    : TFile;      { Source file information                        }
  799.     stTo      : TFile;      { Target file information                        }
  800.  
  801.     rcSearch  : SearchRec;  { FindFirst/FindNext search record               }
  802.     Abort     : LONGINT;    { Error/Abort code                               }
  803.  
  804.     CBI       : TCopyCallBackInfo;
  805.     CBIEvents : LONGINT;
  806.     CBIProc   : TCopyCallBackProc;
  807.  
  808.   END;
  809.  
  810.   PCopyIData = ^TCopyIData;
  811.  
  812. {────────────────────────────────────────────────────────────────────────────}
  813.  
  814. Procedure MyCallBackProc(              CBI       : PCopyCallBackInfo ); Far;
  815. BEGIN
  816. END;
  817.  
  818. {────────────────────────────────────────────────────────────────────────────}
  819.  
  820. Function VCopyChkFlag(                 IData     : PCopyIData;
  821.                                        Bit       : BYTE         ) : BOOLEAN;
  822.  
  823. BEGIN
  824.  
  825.   VCopyChkFlag := ( IData^.OpFlag AND CBitMapL[Bit] ) <> 0;
  826.  
  827. END;
  828.  
  829. {────────────────────────────────────────────────────────────────────────────}
  830.  
  831. Procedure VCopySetFlag(                IData     : PCopyIData;
  832.                                        Bit       : BYTE         );
  833.  
  834. BEGIN
  835.  
  836.   IData^.OpFlag := ( IData^.OpFlag OR CBitMapL[Bit] );
  837.  
  838. END;
  839.  
  840. {────────────────────────────────────────────────────────────────────────────}
  841.  
  842. Procedure VCopyClearFlag(              IData     : PCopyIData;
  843.                                        Bit       : BYTE         );
  844.  
  845. BEGIN
  846.  
  847.   IData^.OpFlag := ( IData^.OpFlag AND NOT CBitMapL[Bit] );
  848.  
  849. END;
  850.  
  851. {────────────────────────────────────────────────────────────────────────────}
  852.  
  853. Function VCopyChkShowFlag(             IData     : PCopyIData;
  854.                                        Bit       : BYTE         ) : BOOLEAN;
  855.  
  856. BEGIN
  857.  
  858.   VCopyChkShowFlag := ( IData^.ShowFlag AND CBitMapB[Bit] ) <> 0;
  859.  
  860. END;
  861.  
  862. {────────────────────────────────────────────────────────────────────────────}
  863.  
  864. Procedure VCopySetShowFlag(            IData     : PCopyIData;
  865.                                        Bit       : BYTE         );
  866.  
  867. BEGIN
  868.  
  869.   IData^.ShowFlag := ( IData^.ShowFlag OR CBitMapB[Bit] );
  870.  
  871. END;
  872.  
  873. {────────────────────────────────────────────────────────────────────────────}
  874.  
  875. Procedure VCopyClearShowFlag(          IData     : PCopyIData;
  876.                                        Bit       : BYTE         );
  877.  
  878. BEGIN
  879.  
  880.   IData^.ShowFlag := ( IData^.ShowFlag AND NOT CBitMapB[Bit] );
  881.  
  882. END;
  883.  
  884. {───────────────────────────────────────────────────────────────────────────}
  885.  
  886. Function CheckCBI(                     IData     : PCopyIData;
  887.                                        Flag      : LONGINT      ) : BOOLEAN;
  888.  
  889. BEGIN
  890.  
  891.   If ( IData^.CBIEvents AND Flag <> 0 ) AND
  892.      ( @IData^.CBIProc <> NIL ) Then
  893.     CheckCBI := TRUE
  894.   Else
  895.     CheckCBI := FALSE;
  896.  
  897. END;
  898.  
  899. {───────────────────────────────────────────────────────────────────────────}
  900.  
  901. Procedure VCopyWrite(                  S         : STRING       );
  902.  
  903. BEGIN
  904.  
  905.   Write( S );
  906.  
  907. END;
  908.  
  909. {───────────────────────────────────────────────────────────────────────────}
  910.  
  911. Procedure VCopyWriteLn(                S         : STRING       );
  912.  
  913. BEGIN
  914.  
  915.   VCopyWrite( S );
  916.   WriteLn;
  917.  
  918. END;
  919.  
  920. {───────────────────────────────────────────────────────────────────────────}
  921.  
  922. Procedure VCopyMarkIData(              IData     : PCopyIData   );
  923.  
  924. Var
  925.  
  926.   mkP : PFileDT;
  927.   teP : PFileDT;
  928.  
  929. BEGIN
  930.  
  931.   With IData^ Do
  932.   BEGIN
  933.  
  934.     OrgFlag    := OpFlag;
  935.     OrgTimeout := Timeout;
  936.     OrgseAttr  := seAttr;
  937.  
  938.     New( teP );
  939.     FillChar( teP^, SizeOf(TFileDT), 0 );
  940.  
  941.     {--------------------}
  942.     { Find mark position }
  943.     {--------------------}
  944.  
  945.     mkP := IData^.seDT;
  946.  
  947.     If (mkP <> NIL) Then
  948.     BEGIN
  949.  
  950.       While (mkP^.Next <> NIL) Do
  951.         mkP := mkP^.Next;
  952.  
  953.       teP^.Next := mkP^.Next;
  954.       teP^.Pred := mkP;
  955.       mkP^.Next := teP;
  956.  
  957.     END
  958.     Else
  959.     BEGIN
  960.  
  961.       mkP         := teP;
  962.       mkP^.Pred   := NIL;
  963.       mkP^.Next   := NIL;
  964.       IData^.seDT := mkP;
  965.  
  966.     END;
  967.  
  968.     teP^.Class := MarkPos;
  969.     teP^.Data  := 0;
  970.  
  971.   END;
  972.  
  973. END;
  974.  
  975. {───────────────────────────────────────────────────────────────────────────}
  976.  
  977. Procedure VCopyReleaseIData(           IData     : PCopyIData   );
  978.  
  979. Var
  980.  
  981.   mkP : PFileDT;
  982.   teP : PFileDT;
  983.  
  984. BEGIN
  985.  
  986.   With IData^ Do
  987.   BEGIN
  988.  
  989.     OpFlag  := OrgFlag;
  990.     Timeout := OrgTimeout;
  991.     seAttr  := OrgSeAttr;
  992.  
  993.     If (seDT <> NIL) Then
  994.     BEGIN
  995.  
  996.       {--------------------}
  997.       { Find mark position }
  998.       {--------------------}
  999.  
  1000.       mkP := seDT;
  1001.  
  1002.       While (mkP^.Class <> MarkPos) AND
  1003.             (mkP <> NIL) Do
  1004.         mkP := mkP^.Next;
  1005.  
  1006.       {------------------------------}
  1007.       { Dispose afterwards inclusive }
  1008.       {------------------------------}
  1009.  
  1010.       If (mkP <> NIL) Then
  1011.       BEGIN
  1012.  
  1013.         teP := mkP;
  1014.  
  1015.         While (teP^.Next <> NIL) Do
  1016.         BEGIN
  1017.  
  1018.           teP := mkP^.Next;
  1019.  
  1020.           If teP <> NIL Then
  1021.           BEGIN
  1022.  
  1023.             mkP^.Next := teP^.Next;
  1024.             Dispose( teP );
  1025.  
  1026.           END;
  1027.  
  1028.         END;
  1029.  
  1030.         If mkP^.Pred <> NIL Then
  1031.           mkP^.Pred^.Next := mkP^.Next
  1032.         Else
  1033.           seDT := NIL;
  1034.  
  1035.         Dispose( mkP );
  1036.  
  1037.       END;
  1038.  
  1039.     END;
  1040.  
  1041.   END;
  1042.  
  1043. END;
  1044.  
  1045. {───────────────────────────────────────────────────────────────────────────}
  1046.  
  1047. Function VCopySetupDir(               IData     : PCopyIData;
  1048.                                       stPathFrom: PathStr;
  1049.                                       stPathTo  : PathStr      ) : INTEGER;
  1050.  
  1051. Var
  1052.  
  1053.   teName      : NameStr;
  1054.   teExt       : ExtStr;
  1055.   teDir       : PathStr;
  1056.  
  1057. BEGIN
  1058.  
  1059.   VCopySetupDir := erVCopy_None;
  1060.  
  1061.   IData^.stFrom.Path := FExpand(stPathFrom);
  1062.   IData^.stTo.Path   := FExpand(stPathTo);
  1063.  
  1064.   If DirExist(IData^.stFrom.Path) Then
  1065.     IData^.stFrom.Path := PutSlash(IData^.stFrom.Path) + '*.*';
  1066.  
  1067.   {----------------------------------}
  1068.   { If MakePathTo flag and indicated }
  1069.   { dir doesn't exist, create OrgDir }
  1070.   {----------------------------------}
  1071.  
  1072.   If (Pos('*', IData^.stTo.Path) = 0) AND
  1073.      (Pos('?', IData^.stTo.Path) = 0) Then
  1074.     teDir := IData^.stTo.Path
  1075.   Else
  1076.   BEGIN
  1077.  
  1078.     teDir := PredDir(IData^.stTo.Path);
  1079.     Delete(teDir, Length(teDir), 1);
  1080.  
  1081.   END;
  1082.  
  1083.   If (VCopyChkFlag(IData, coMakeTargetDir)) AND
  1084.      (NOT VCopyChkFlag(IData, coTestMode)) AND
  1085.      (NOT DirExist(teDir)) Then
  1086.   BEGIN
  1087.  
  1088.     {------------------------------------------------}
  1089.     { Check if target directory is an existing file. }
  1090.     {------------------------------------------------}
  1091.  
  1092.     If FileExist(teDir) Then
  1093.     BEGIN
  1094.  
  1095.       VCopySetupDir := erVCopy_TargetPathIsFile;
  1096.       Exit;
  1097.  
  1098.     END;
  1099.  
  1100.     MkSubDir( teDir );
  1101.  
  1102.   END;
  1103.  
  1104.   {----------------------------------}
  1105.  
  1106.   If (DirExist(IData^.stTo.Path)) OR
  1107.      ( (NOT DirExist(IData^.stTo.Path)) AND
  1108.        (VCopyChkFlag(IData, coTestMode)) ) Then
  1109.     IData^.stTo.Path := PutSlash(IData^.stTo.Path) + '*.*';
  1110.  
  1111.   IData^.stFrom.WildCard := InDir(IData^.stFrom.Path);
  1112.   IData^.stTo.WildCard   := InDir(IData^.stTo.Path);
  1113.  
  1114.   FSplit(IData^.stFrom.Path, IData^.stFrom.Dir, teName, teExt);
  1115.   FSplit(IData^.stTo.Path,   IData^.stTo.Dir,   teName, teExt);
  1116.  
  1117.   IData^.stFrom.Drive := IData^.stFrom.Dir[1];
  1118.   IData^.stTo.Drive   := IData^.stTo.Dir[1];
  1119.  
  1120.   IData^.stFrom.OrgDir := IData^.stFrom.Dir;
  1121.   IData^.stTo.OrgDir   := IData^.stTo.Dir;
  1122.  
  1123. END;
  1124.  
  1125. {───────────────────────────────────────────────────────────────────────────}
  1126.  
  1127. Procedure VCopySetupParams(            IData     : PCopyIData;
  1128.                                        Params    : STRING       );
  1129.  
  1130. Var
  1131.  
  1132.   Param      : STRING;
  1133.   ParamField : STRING;
  1134.   ParamData  : STRING;
  1135.   mkP        : PFileDT;
  1136.   teP        : PFileDT;   { First search Date/Time in link list. STATIC  }
  1137.   DT         : DateTime;
  1138.   PDT        : LONGINT;
  1139.   Class      : TDTClass;
  1140.   L1         : WORD;
  1141.   Pos1       : BYTE;
  1142.   Pos2       : BYTE;
  1143.  
  1144. BEGIN
  1145.  
  1146.   Params := UpperString(Params);
  1147.   Param := '';
  1148.   REPEAT
  1149.  
  1150.     Param := GetNextParam(Param, Params);
  1151.  
  1152.     If Param <> '' Then
  1153.     BEGIN
  1154.  
  1155.       ParamField := GetParamName(Param);
  1156.  
  1157.       If ParamField = 'MOVE' Then
  1158.         VCopySetFlag(IData, coMove)
  1159.       Else
  1160.       If ParamField = 'NOOVERWRITE' Then
  1161.         VCopySetFlag(IData, coNoOverwrite)
  1162.       Else
  1163.       If ParamField = 'SUBDIR' Then
  1164.       BEGIN
  1165.         VCopySetFlag(IData, coSubDir);
  1166.         IData^.seAttr := IData^.seAttr or Directory;
  1167.       END
  1168.       Else
  1169.       If ParamField = 'EXACTATTR' Then
  1170.         VCopySetFlag(IData, coExactAttr)
  1171.       Else
  1172.       If ParamField = 'NEWER' Then
  1173.         VCopySetFlag(IData, coNewer)
  1174.       Else
  1175.       If ParamField = 'SHARE' Then
  1176.         VCopySetFlag(IData, coShare)
  1177.       Else
  1178.       If ParamField = 'APPEND' Then
  1179.         VCopySetFlag(IData, coAppend)
  1180.       Else
  1181.       If ParamField = 'DATE' Then
  1182.         Class := Date
  1183.       Else
  1184.       If ParamField = 'DATEB' Then
  1185.         Class := DateB
  1186.       Else
  1187.       If ParamField = 'DATEA' Then
  1188.         Class := DateA
  1189.       Else
  1190.       If ParamField = 'DATEOB' Then
  1191.         Class := DateOB
  1192.       Else
  1193.       If ParamField = 'DATEOA' Then
  1194.         Class := DateOA
  1195.       Else
  1196.       If ParamField = 'TIME' Then
  1197.         Class := Time
  1198.       Else
  1199.       If ParamField = 'TIMEB' Then
  1200.         Class := TimeB
  1201.       Else
  1202.       If ParamField = 'TIMEA' Then
  1203.         Class := TimeA
  1204.       Else
  1205.       If ParamField = 'TIMEOB' Then
  1206.         Class := TimeOB
  1207.       Else
  1208.       If ParamField = 'TIMEOA' Then
  1209.         Class := TimeOA
  1210.       Else
  1211.       If ParamField = 'MAKETARGETDIR' Then
  1212.         VCopySetFlag(IData, coMakeTargetDir)
  1213.       Else
  1214.       If ParamField = 'TARGETDIRONLY' Then
  1215.         VCopySetFlag(IData, coTargetDirOnly)
  1216.       Else
  1217.       If ParamField = 'TESTMODE' Then
  1218.         VCopySetFlag(IData, coTestMode)
  1219.       Else
  1220.       If ParamField = 'ATTR' Then
  1221.       BEGIN
  1222.  
  1223.         ParamData := GetParamData(Param);
  1224.  
  1225.         For L1 := 1 to Length(ParamData) Do
  1226.         BEGIN
  1227.  
  1228.           Case ParamData[L1] of
  1229.  
  1230.             'A' : IData^.seAttr := IData^.seAttr or Archive;
  1231.             'S' : IData^.seAttr := IData^.seAttr or SysFile;
  1232.             'H' : IData^.seAttr := IData^.seAttr or Hidden;
  1233.             'R' : IData^.seAttr := IData^.seAttr or ReadOnly;
  1234.  
  1235.           End;
  1236.  
  1237.         END;
  1238.  
  1239.       END
  1240.       Else
  1241.       If ParamField = 'TIMEOUT' Then
  1242.       BEGIN
  1243.  
  1244.         ParamData := GetParamData(Param);
  1245.  
  1246.         IData^.Timeout := StrToInt(ParamData);
  1247.  
  1248.       END
  1249.       Else
  1250.       If ParamField = 'SHOW' Then
  1251.       BEGIN
  1252.  
  1253.         VCopySetFlag(IData, coShow);
  1254.  
  1255.         ParamData := GetParamData(Param);
  1256.  
  1257.         For L1 := 1 to Length(ParamData) Do
  1258.         BEGIN
  1259.  
  1260.           Case ParamData[L1] of
  1261.  
  1262.             'F' : VCopySetShowFlag(IData, iffFilename);
  1263.             'A' : VCopySetShowFlag(IData, iffAttrib);
  1264.             'D' : VCopySetShowFlag(IData, iffDate);
  1265.             'T' : VCopySetShowFlag(IData, iffTime);
  1266.             'P' : VCopySetShowFlag(IData, iffPackedDate);
  1267.             'S' : VCopySetShowFlag(IData, iffSize);
  1268.  
  1269.           End;
  1270.  
  1271.         END;
  1272.  
  1273.       END;
  1274.  
  1275.       {-----}
  1276.  
  1277.       If (Pos('DATE', ParamField) <> 0) OR
  1278.          (Pos('TIME', ParamField) <> 0) Then
  1279.       BEGIN
  1280.  
  1281.         ParamData := GetParamData(Param);
  1282.  
  1283.         New( teP );
  1284.  
  1285.         {--------------------}
  1286.         { Find mark position }
  1287.         {--------------------}
  1288.  
  1289.         mkP := IData^.seDT;
  1290.  
  1291.         If mkP <> NIL Then
  1292.         BEGIN
  1293.  
  1294.           While (mkP^.Next <> NIL) Do
  1295.             mkP := mkP^.Next;
  1296.  
  1297.           teP^.Next := mkP^.Next;
  1298.           teP^.Pred := mkP;
  1299.           mkP^.Next := teP;
  1300.  
  1301.         END
  1302.         Else
  1303.         BEGIN
  1304.  
  1305.           mkP         := teP;
  1306.           mkP^.Pred   := NIL;
  1307.           mkP^.Next   := NIL;
  1308.           IData^.seDT := mkP;
  1309.  
  1310.         END;
  1311.  
  1312.         teP^.Class := Class;
  1313.  
  1314.         If Class in [Date..DateOA] Then
  1315.         BEGIN
  1316.  
  1317.           FillChar( DT, SizeOf(DateTime), 0 );
  1318.  
  1319.           Pos1 := Pos('-', ParamData);
  1320.           If (Pos1 = 0) Then
  1321.             Pos1 := Pos('/', ParamData);
  1322.  
  1323.           Pos2 := PosAfter('-', ParamData, Succ(Pos1));
  1324.           If (Pos2 = 0) Then
  1325.             Pos2 := PosAfter('/', ParamData, Succ(Pos1));
  1326.  
  1327.           DT.Month := Word(StrToInt(Copy(
  1328.                         ParamData, 1, Pred(Pos1))));
  1329.  
  1330.           DT.Day   := Word(StrToInt(Copy(
  1331.                         ParamData, Succ(Pos1), Pos2 - Succ(Pos1))));
  1332.  
  1333.           DT.Year  := Word(StrToInt(Copy(
  1334.                         ParamData, Succ(Pos2), Byte(ParamData[0]) - Pos2)));
  1335.  
  1336.           If (DT.Year < 1900) Then
  1337.             DT.Year := DT.Year + 1900;
  1338.  
  1339.           If (DT.Year < 1980) Then
  1340.             DT.Year := DT.Year + 100;
  1341.  
  1342.           PackTime(DT, PDT);
  1343.           teP^.Data := Word( PDT SHR $10 );
  1344.  
  1345.         END
  1346.         Else
  1347.         If Class in [Time..TimeOA] Then
  1348.         BEGIN
  1349.  
  1350.           FillChar( DT, SizeOf(DateTime), 0 );
  1351.  
  1352.           Pos1 := Pos(':', ParamData);
  1353.  
  1354.           DT.Hour := Word(StrToInt(Copy(
  1355.                        ParamData, 1, Pred(Pos1)) ));
  1356.  
  1357.           DT.Min  := Word(StrToInt(Copy(
  1358.                        ParamData, Succ(Pos1), Byte(ParamData[0]) - Pos2)));
  1359.  
  1360.           teP^.Data := (DT.Hour * 60) + DT.Min;
  1361.  
  1362.         END;
  1363.  
  1364.       END;
  1365.  
  1366.     END;
  1367.  
  1368.   UNTIL Param = '';
  1369.  
  1370. END;
  1371.  
  1372. {───────────────────────────────────────────────────────────────────────────}
  1373.  
  1374. Procedure VCopyFindFile(               IData     : PCopyIData   );
  1375.  
  1376.   {───────────────────────────────────────────────────────────────────────}
  1377.  
  1378.   Function  HourMin( Time : LONGINT ) : WORD;
  1379.  
  1380.   Var
  1381.  
  1382.     DT : DateTime;
  1383.  
  1384.   BEGIN
  1385.  
  1386.     UnpackTime( Time, DT );
  1387.     HourMin := ( DT.Hour * 60 ) + DT.Min;
  1388.  
  1389.   END;
  1390.  
  1391.   {───────────────────────────────────────────────────────────────────────}
  1392.  
  1393.   Function GetDOSFile : BOOLEAN;
  1394.  
  1395.   Var
  1396.  
  1397.     stFirst   : BOOLEAN;
  1398.     OK        : BOOLEAN;
  1399.     stDir     : DirStr;
  1400.     P         : PFileDT;
  1401.  
  1402.   BEGIN
  1403.  
  1404.     {----------------------------}
  1405.     { Setup first directory read }
  1406.     {----------------------------}
  1407.  
  1408.     stFirst := FALSE;
  1409.  
  1410.     If (IData^.rcSearch.Name = '') Then
  1411.     BEGIN
  1412.  
  1413.       {---------------------------------------}
  1414.       { Search for *.* to find subdirectories }
  1415.       {---------------------------------------}
  1416.  
  1417.       FindFirst( IData^.stFrom.Dir + '*.*',
  1418.                  IData^.seAttr,
  1419.                  IData^.rcSearch );
  1420.  
  1421.       stFirst := TRUE;
  1422.  
  1423.     END;
  1424.  
  1425.     REPEAT
  1426.  
  1427.       If NOT stFirst Then
  1428.         FindNext( IData^.rcSearch );
  1429.  
  1430.       IData^.stFrom.Time := IData^.rcSearch.Time;
  1431.       IData^.stFrom.Attr := IData^.rcSearch.Attr;
  1432.       IData^.stFrom.Size := IData^.rcSearch.Size;
  1433.  
  1434.       {================================}
  1435.       {      CHECK SEARCH OPTIONS      }
  1436.       {================================}
  1437.  
  1438.       OK := TRUE;
  1439.  
  1440.       {-------------------------------------------}
  1441.       { Check filters - attribute, filetime, etc. }
  1442.       {-------------------------------------------}
  1443.  
  1444.       {-----------------------------------------}
  1445.       { Bypass if current or previous directory }
  1446.       {-----------------------------------------}
  1447.  
  1448.       If ( IData^.rcSearch.Name = '.' ) OR
  1449.          ( IData^.rcSearch.Name = '..' ) Then
  1450.         OK := FALSE;
  1451.  
  1452.       {--------------------------------}
  1453.       { Test if found file masked with }
  1454.       { source wildcard is still valid }
  1455.       {--------------------------------}
  1456.  
  1457.       If (OK) AND
  1458.          ( MaskWildCards(
  1459.             PutDot( IData^.rcSearch.Name ),
  1460.             IData^.stFrom.WildCard ) <> PutDot( IData^.rcSearch.Name ) ) AND
  1461.          ( IData^.rcSearch.Attr AND Directory <> Directory ) Then
  1462.         OK := FALSE;
  1463.  
  1464.       {------------------}
  1465.       { Check attributes }
  1466.       {------------------}
  1467.  
  1468.       { 1. Has ATTR=ASHR occured?                  }
  1469.       { 2. All directories are exempt from check   }
  1470.       { 3. Is ExactAttr flag set?                  }
  1471.       { 4. Does found file's attr and ATTR= match? }
  1472.  
  1473.       If (OK) AND
  1474.          (IData^.seAttr <> 0) AND
  1475.          (IData^.seAttr <> Directory) AND
  1476.          (IData^.rcSearch.Attr AND Directory <> Directory) AND
  1477.          (VCopyChkFlag(IData, coExactAttr)) AND
  1478.          (IData^.rcSearch.Attr <> IData^.seAttr AND NOT Directory) Then
  1479.         OK := FALSE;
  1480.  
  1481.       {-----------------------}
  1482.       { Check Date/Time flags }
  1483.       {-----------------------}
  1484.  
  1485.       If (OK) AND
  1486.          (IData^.seDT <> NIL) Then
  1487.       BEGIN
  1488.  
  1489.         P := IData^.seDT;
  1490.  
  1491.         REPEAT
  1492.  
  1493.           Case P^.Class Of
  1494.  
  1495.             MarkPos : ;
  1496.  
  1497.             {---}
  1498.  
  1499.             Date :
  1500.  
  1501.               If (IData^.stFrom.Time SHR $10) <>
  1502.                  (P^.Data) Then
  1503.                 OK := FALSE;
  1504.  
  1505.             {---}
  1506.  
  1507.             DateB :
  1508.  
  1509.               If (IData^.stFrom.Time SHR $10) >=
  1510.                  (P^.Data) Then
  1511.                 OK := FALSE;
  1512.  
  1513.             {---}
  1514.  
  1515.             DateA :
  1516.  
  1517.               If (IData^.stFrom.Time SHR $10) <=
  1518.                  (P^.Data) Then
  1519.                 OK := FALSE;
  1520.  
  1521.             {---}
  1522.  
  1523.             DateOB :
  1524.  
  1525.              If (IData^.stFrom.Time SHR $10) >
  1526.                  (P^.Data) Then
  1527.                 OK := FALSE;
  1528.  
  1529.             {---}
  1530.  
  1531.             DateOA :
  1532.  
  1533.               If (IData^.stFrom.Time SHR $10) <
  1534.                  (P^.Data) Then
  1535.                 OK := FALSE;
  1536.  
  1537.             {---}
  1538.  
  1539.             Time :
  1540.  
  1541.               If HourMin(IData^.stFrom.Time) <>
  1542.                  HourMin(P^.Data) Then
  1543.                 OK := FALSE;
  1544.  
  1545.             {---}
  1546.  
  1547.             TimeB :
  1548.  
  1549.               If HourMin(IData^.stFrom.Time) >=
  1550.                  HourMin(P^.Data) Then
  1551.                 OK := FALSE;
  1552.  
  1553.             {---}
  1554.  
  1555.             TimeA :
  1556.  
  1557.               If HourMin(IData^.stFrom.Time) <=
  1558.                  HourMin(P^.Data) Then
  1559.                 OK := FALSE;
  1560.  
  1561.             {---}
  1562.  
  1563.             TimeOB :
  1564.  
  1565.               If HourMin(IData^.stFrom.Time) >
  1566.                  HourMin(P^.Data) Then
  1567.                 OK := FALSE;
  1568.  
  1569.             {---}
  1570.  
  1571.             TimeOA :
  1572.  
  1573.               If HourMin(IData^.stFrom.Time) <
  1574.                  HourMin(P^.Data) Then
  1575.                 OK := FALSE;
  1576.  
  1577.           End;
  1578.  
  1579.           P := P^.Next;
  1580.  
  1581.         UNTIL (NOT OK) OR (P = NIL);
  1582.  
  1583.       END;
  1584.  
  1585.       {-----------------------}
  1586.       { Enter if subdirectory }
  1587.       {-----------------------}
  1588.  
  1589.       If ( (OK) AND
  1590.            (IData^.rcSearch.Attr AND Directory = Directory) AND
  1591.            (VCopyChkFlag(IData, coSubDir)) AND
  1592.            (DosError = 0) ) Then
  1593.  
  1594.       BEGIN
  1595.  
  1596.         OK := FALSE;
  1597.  
  1598.         stDir := PutSlash( IData^.stFrom.Dir + IData^.rcSearch.Name );
  1599.  
  1600.         If (stDir <> IData^.stTo.OrgDir) Then
  1601.         BEGIN
  1602.  
  1603.           If (NOT DirExist( IData^.stTo.Dir + IData^.rcSearch.Name )) AND
  1604.              (NOT VCopyChkFlag(IData, coTargetDirOnly)) AND
  1605.              (NOT VCopyChkFlag(IData, coTestMode)) Then
  1606.           BEGIN
  1607.  
  1608.             MkDir( IData^.stTo.Dir + IData^.rcSearch.Name );
  1609.  
  1610.             {-------------------------------------}
  1611.             { Preserve source directory attribute }
  1612.             { list into the new target directory  }
  1613.             {-------------------------------------}
  1614.  
  1615.             Assign( IData^.stTo.fi,
  1616.                     IData^.stTo.Dir + IData^.rcSearch.Name );
  1617.  
  1618.             If ( NOT VCopyChkFlag(IData, coTestMode) ) Then
  1619.               SetFAttr( IData^.stTo.fi, IData^.stFrom.Attr );
  1620.  
  1621.           END;
  1622.  
  1623.           IData^.stFrom.Dir :=
  1624.             PutSlash( IData^.stFrom.Dir + IData^.rcSearch.Name );
  1625.  
  1626.           If (NOT VCopyChkFlag(IData, coTargetDirOnly)) Then
  1627.             IData^.stTo.Dir :=
  1628.               PutSlash( IData^.stTo.Dir + IData^.rcSearch.Name );
  1629.  
  1630.           FillChar( IData^.rcSearch, SizeOf(SearchRec), 0 );
  1631.           FindFirst( IData^.stFrom.Dir + '*.*',
  1632.                      IData^.seAttr,
  1633.                      IData^.rcSearch );
  1634.  
  1635.         END;
  1636.  
  1637.       END;
  1638.  
  1639.       {-----------------------------}
  1640.       { Exit subdirectory if at end }
  1641.       {-----------------------------}
  1642.  
  1643.       If ( (DosError = 18) AND
  1644.            (VCopyChkFlag(IData, coSubDir)) AND
  1645.            (IData^.stFrom.Dir <> IData^.stFrom.OrgDir)) Then
  1646.  
  1647.       BEGIN
  1648.  
  1649.         OK      := FALSE;
  1650.         stDir   := InDir( IData^.stFrom.Dir );
  1651.  
  1652.         IData^.stFrom.Dir := PredDir( IData^.stFrom.Dir );
  1653.  
  1654.         If (NOT VCopyChkFlag(IData, coTargetDirOnly)) Then
  1655.           IData^.stTo.Dir   := PredDir( IData^.stTo.Dir );
  1656.  
  1657.         FillChar( IData^.rcSearch, SizeOf(SearchRec), 0 );
  1658.         FindFirst( IData^.stFrom.Dir + '*.*',
  1659.                    IData^.seAttr,
  1660.                    IData^.rcSearch );
  1661.  
  1662.         While ( (IData^.rcSearch.Name <> stDir) AND (DosError = 0) ) Do
  1663.           FindNext( IData^.rcSearch );
  1664.  
  1665.         stDir := IData^.stFrom.Dir + stDir;
  1666.  
  1667.         If ( VCopyChkFlag( IData, coMove ) ) AND
  1668.            ( DirEmpty( stDir ) ) Then
  1669.         BEGIN
  1670.  
  1671.           If ( NOT VCopyChkFlag( IData, coTestMode ) ) Then
  1672.             RmDir( stDir );
  1673.  
  1674.         END;
  1675.  
  1676.       END;
  1677.  
  1678.       stFirst := FALSE;
  1679.  
  1680.     UNTIL OK or (DosError <> 0);
  1681.  
  1682.     If (DosError = 18) AND (IData^.stFrom.Dir = IData^.stFrom.OrgDir) Then
  1683.       OK := FALSE;
  1684.  
  1685.     GetDOSFile := OK;
  1686.  
  1687.   END;
  1688.  
  1689.   {───────────────────────────────────────────────────────────────────────}
  1690.  
  1691.   Function GetListFile : BOOLEAN;
  1692.  
  1693.   Var
  1694.  
  1695.     stDir      : DirStr;
  1696.     S          : STRING;
  1697.     SourceName : STRING;
  1698.     TargetName : STRING;
  1699.     Params     : STRING;
  1700.     OK         : BOOLEAN;
  1701.  
  1702.   BEGIN
  1703.  
  1704.     OK := TRUE;
  1705.  
  1706.     {-----------------------------}
  1707.     { Open file if not opened yet }
  1708.     {-----------------------------}
  1709.  
  1710.     If Byte(TextRec( IData^.ListF ).Name[0]) = 0 Then
  1711.     BEGIN
  1712.  
  1713.       Assign( IData^.ListF, IData^.ListFName );
  1714.       Reset( IData^.ListF );
  1715.  
  1716.     END;
  1717.  
  1718.     {-----------------------}
  1719.     { Check for end of file }
  1720.     {-----------------------}
  1721.  
  1722.     If ( Eof(IData^.ListF) ) AND
  1723.        ( IData^.rcSearch.Name = '' ) Then
  1724.     BEGIN
  1725.  
  1726.       Close( IData^.ListF );
  1727.       FillChar( IData^.ListF, SizeOf(IData^.ListF), 0 );
  1728.  
  1729.       {--------------------}
  1730.       { Release IData Mark }
  1731.       {--------------------}
  1732.  
  1733.       VCopyReleaseIData( IData );
  1734.  
  1735.       OK := FALSE;
  1736.  
  1737.     END;
  1738.  
  1739.     {-----------------------------------------}
  1740.     { If more information available, continue }
  1741.     {-----------------------------------------}
  1742.  
  1743.     If OK Then
  1744.     REPEAT
  1745.  
  1746.       OK := TRUE;
  1747.  
  1748.       If IData^.rcSearch.Name = '' Then
  1749.       BEGIN
  1750.  
  1751.         {--------------------}
  1752.         { Release IData Mark }
  1753.         {--------------------}
  1754.  
  1755.         VCopyReleaseIData( IData );
  1756.  
  1757.         ReadLn(IData^.ListF, S);
  1758.  
  1759.         SourceName := TakeWords( S, 1 );
  1760.         TargetName := TakeWords( S, 1 );
  1761.         Params     := TakeWords( S, 1 );
  1762.  
  1763.         If SourceName <> '' Then
  1764.         BEGIN
  1765.  
  1766.           SourceName := FExpand( SourceName );
  1767.  
  1768.           {------------------------------------------}
  1769.           { Set parameters if no target is specified }
  1770.           {------------------------------------------}
  1771.  
  1772.           If (TargetName[1] = '/') Then
  1773.           BEGIN
  1774.  
  1775.             Params := CopyStr( TargetName, 2, Pred(Byte(TargetName[0])) );
  1776.             TargetName := '';
  1777.  
  1778.           END;
  1779.  
  1780.           If (TargetName = '') Then
  1781.             TargetName := FExpand( IData^.stTo.OrgPath );
  1782.  
  1783.           If (Byte(Params[0]) > 0) AND
  1784.              (Params[1] = '/') Then
  1785.             Delete(Params, 1, 1);
  1786.  
  1787.           {------------}
  1788.           { Mark IData }
  1789.           {------------}
  1790.  
  1791.           VCopyMarkIData( IData );
  1792.  
  1793.           {---------------------------------}
  1794.           { Check for additional parameters }
  1795.           {---------------------------------}
  1796.  
  1797.           If (Params <> '') Then
  1798.             VCopySetupParams( IData, Params );
  1799.  
  1800.           {------------------------------------}
  1801.           { Setup source/target directory info }
  1802.           {------------------------------------}
  1803.  
  1804.           IData^.Abort := VCopySetupDir( IData, SourceName, TargetName );
  1805.  
  1806.           If (IData^.Abort <> erVCopy_None) Then
  1807.             SourceName := '';
  1808.  
  1809.         END;
  1810.  
  1811.       END;
  1812.  
  1813.       If (Byte(SourceName[0]) = 0) Then
  1814.         OK := FALSE
  1815.       Else
  1816.       BEGIN
  1817.  
  1818.         If (NOT GetDOSFile) Then
  1819.         BEGIN
  1820.  
  1821.           IData^.rcSearch.Name := '';
  1822.           OK := FALSE;
  1823.  
  1824.         END
  1825.         Else
  1826.         BEGIN
  1827.  
  1828.           {================================}
  1829.           {      CHECK SEARCH OPTIONS      }
  1830.           {================================}
  1831.  
  1832.           {---------------------------------------------}
  1833.           { Check for TargetDirOnly - otherwise, create }
  1834.           { subdirectory of source file for target file }
  1835.           {---------------------------------------------}
  1836.  
  1837.           If (NOT VCopyChkFlag(IData, coTargetDirOnly)) Then
  1838.           BEGIN
  1839.  
  1840.             stDir := IData^.stTo.OrgDir +
  1841.                      Copy( IData^.stFrom.Dir, 4, Byte( IData^.stFrom.Dir[0] ) - 3 );
  1842.             IData^.stTo.Dir := stDir;
  1843.  
  1844.             If (NOT DirExist( IData^.stTo.Dir )) AND
  1845.                (NOT VCopyChkFlag(IData, coTestMode)) Then
  1846.               MkSubDir( UnPutSlash( IData^.stTo.Dir ) );
  1847.  
  1848.           END;
  1849.  
  1850.         END;
  1851.  
  1852.       END;
  1853.  
  1854.     UNTIL OK or ( Eof( IData^.ListF ) );
  1855.  
  1856.     GetListFile := OK;
  1857.  
  1858.   END;
  1859.  
  1860.   {───────────────────────────────────────────────────────────────────────}
  1861.  
  1862.   Procedure SetupToFile;
  1863.   BEGIN
  1864.  
  1865.     IData^.stFrom.FName := IData^.stFrom.Dir + IData^.rcSearch.Name;
  1866.  
  1867.     IData^.stTo.FName := IData^.stTo.Dir + UnPutDot(
  1868.       MaskWildcards( IData^.rcSearch.Name, IData^.stTo.Wildcard ) );
  1869.  
  1870.     IData^.stTo.Time := GetFileTime( IData^.stTo.FName );
  1871.     IData^.stTo.Attr := GetFileAttr( IData^.stTo.FName );
  1872.     IData^.stTo.Size := GetFileSize( IData^.stTo.FName );
  1873.  
  1874.   END;
  1875.  
  1876.   {───────────────────────────────────────────────────────────────────────}
  1877.  
  1878. BEGIN
  1879.  
  1880.   If (VCopyChkFlag(IData, coListFile)) Then
  1881.   BEGIN
  1882.  
  1883.     If GetListFile Then
  1884.     BEGIN
  1885.  
  1886.       SetupToFile;
  1887.       Exit;
  1888.  
  1889.     END;
  1890.  
  1891.   END
  1892.   Else
  1893.   If GetDOSFile Then
  1894.   BEGIN
  1895.  
  1896.     SetupToFile;
  1897.     Exit;
  1898.  
  1899.   END;
  1900.  
  1901.   {-------------------------------------}
  1902.   { If still here, assume no more files }
  1903.   {-------------------------------------}
  1904.  
  1905.   IData^.stFrom.FName := '';
  1906.   IData^.stTo.FName   := '';
  1907.  
  1908. END;
  1909.  
  1910. {────────────────────────────────────────────────────────────────────────────}
  1911.  
  1912. Function VCopyFileLow(                 IData     : PCopyIData   ) : INTEGER;
  1913.  
  1914. Type
  1915.  
  1916.   TBuffer = Array[0..0] of BYTE;
  1917.   PBuffer = ^TBuffer;
  1918.  
  1919. Var
  1920.  
  1921.   Buf        : PBuffer;
  1922.   Count      : WORD;
  1923.   NumRead    : WORD;
  1924.   NumWritten : WORD;
  1925.   IOErr      : Integer;
  1926.  
  1927. Label
  1928.   ReRead,
  1929.   ReWrite,
  1930.   AbortCopy;
  1931.  
  1932. BEGIN
  1933.  
  1934.   Count := VTypesu.maxArrSize;
  1935.   If (MaxAvail < Count) Then
  1936.     Count := MaxAvail;
  1937.  
  1938.   GetMem( Buf, Count );
  1939.  
  1940.   REPEAT
  1941.  
  1942.     VMultiDO( 0 );
  1943.  
  1944.     {============}
  1945.     { READ BLOCK }
  1946.     {============}
  1947.  
  1948.     REREAD:
  1949.  
  1950.     {------------------------------------}
  1951.     { Source file external read callback }
  1952.     {------------------------------------}
  1953.  
  1954.     If CheckCBI(IData, cbeExternReadBlock) Then
  1955.     BEGIN
  1956.  
  1957.       IData^.CBI.Event     := cbeExternReadBlock;
  1958.       IData^.CBI.StrParam  := IData^.stFrom.FName;
  1959.       IData^.CBI.NumParam1 := Count;
  1960.       IData^.CBI.PtrParam1 := Buf;
  1961.       IData^.CBI.RetCode   := 0;
  1962.  
  1963.       IData^.CBIProc( @IData^.CBI );
  1964.  
  1965.       If (IData^.CBI.RetCode = iffAbort) OR
  1966.          (IData^.CBI.RetCode = iffFail) Then
  1967.         Goto AbortCopy;
  1968.  
  1969.       IOErr   := IData^.CBI.RetCode;
  1970.       NumRead := IData^.CBI.NumParam1;
  1971.  
  1972.     END
  1973.     Else
  1974.     BEGIN
  1975.  
  1976.       {---------------------------}
  1977.       { Source file read callback }
  1978.       {---------------------------}
  1979.  
  1980.       If CheckCBI(IData, cbeReadBlock) Then
  1981.       BEGIN
  1982.  
  1983.         IData^.CBI.Event     := cbeReadBlock;
  1984.         IData^.CBI.StrParam  := IData^.stFrom.FName;
  1985.         IData^.CBI.NumParam1 := Count;
  1986.         IData^.CBI.PtrParam1 := Buf;
  1987.         IData^.CBI.RetCode   := 0;
  1988.  
  1989.         IData^.CBIProc( @IData^.CBI );
  1990.  
  1991.         If (IData^.CBI.RetCode = iffAbort) OR
  1992.            (IData^.CBI.RetCode = iffFail) Then
  1993.           Goto AbortCopy;
  1994.  
  1995.       END;
  1996.  
  1997.       {------------}
  1998.       { Read block }
  1999.       {------------}
  2000.  
  2001.       {$I-}
  2002.  
  2003.       BlockRead( IData^.stFrom.fi, Buf^, Count, NumRead );
  2004.       IOErr := IOResult;
  2005.  
  2006.       {$I+}
  2007.  
  2008.     END;
  2009.  
  2010.     {-----------------}
  2011.     { Check for error }
  2012.     {-----------------}
  2013.  
  2014.     If (IOErr <> 0) AND CheckCBI(IData, cbeIOErr) Then
  2015.     BEGIN
  2016.  
  2017.       IData^.CBI.Event     := cbeIOErr;
  2018.       IData^.CBI.NumParam1 := IOErr;
  2019.       IData^.CBI.NumParam2 := cbsRead;
  2020.       IData^.CBI.RetCode   := 0;
  2021.  
  2022.       IData^.CBIProc( @IData^.CBI );
  2023.  
  2024.       If (IData^.CBI.RetCode = iffAbort) OR
  2025.          (IData^.CBI.RetCode = iffFail) Then
  2026.         Goto AbortCopy;
  2027.  
  2028.       If (IData^.CBI.RetCode = iffRetry) Then
  2029.         Goto ReRead;
  2030.  
  2031.     END;
  2032.  
  2033.     {=============}
  2034.     { WRITE BLOCK }
  2035.     {=============}
  2036.  
  2037.     REWRITE:
  2038.  
  2039.     {-------------------------------------}
  2040.     { Target file external write callback }
  2041.     {-------------------------------------}
  2042.  
  2043.     If CheckCBI(IData, cbeExternWriteBlock) Then
  2044.     BEGIN
  2045.  
  2046.       IData^.CBI.Event     := cbeExternWriteBlock;
  2047.       IData^.CBI.StrParam  := IData^.stTo.FName;
  2048.       IData^.CBI.NumParam1 := NumRead;
  2049.       IData^.CBI.PtrParam1 := Buf;
  2050.       IData^.CBI.RetCode   := 0;
  2051.  
  2052.       IData^.CBIProc( @IData^.CBI );
  2053.  
  2054.       If (IData^.CBI.RetCode = iffAbort) OR
  2055.          (IData^.CBI.RetCode = iffFail) Then
  2056.         Goto AbortCopy;
  2057.  
  2058.       IOErr      := IData^.CBI.RetCode;
  2059.       NumWritten := IData^.CBI.NumParam1;
  2060.  
  2061.     END
  2062.     Else
  2063.     BEGIN
  2064.  
  2065.       {----------------------------}
  2066.       { Target file write callback }
  2067.       {----------------------------}
  2068.  
  2069.       If CheckCBI(IData, cbeWriteBlock) Then
  2070.       BEGIN
  2071.  
  2072.         IData^.CBI.Event     := cbeWriteBlock;
  2073.         IData^.CBI.StrParam  := IData^.stTo.FName;
  2074.         IData^.CBI.NumParam1 := NumRead;
  2075.         IData^.CBI.PtrParam1 := Buf;
  2076.         IData^.CBI.RetCode   := 0;
  2077.  
  2078.         IData^.CBIProc( @IData^.CBI );
  2079.  
  2080.         If (IData^.CBI.RetCode = iffAbort) OR
  2081.           (IData^.CBI.RetCode = iffFail) Then
  2082.          Goto AbortCopy;
  2083.  
  2084.       END;
  2085.  
  2086.       {-------------}
  2087.       { Write block }
  2088.       {-------------}
  2089.  
  2090.       {$I-}
  2091.  
  2092.       BlockWrite( IData^.stTo.fi, Buf^, NumRead, NumWritten );
  2093.       IOErr := IOResult;
  2094.  
  2095.       {$I+}
  2096.  
  2097.     END;
  2098.  
  2099.     {-----------------}
  2100.     { Check for error }
  2101.     {-----------------}
  2102.  
  2103.     If (IOErr <> 0) AND CheckCBI(IData, cbeIOErr) Then
  2104.     BEGIN
  2105.  
  2106.       IData^.CBI.Event     := cbeIOErr;
  2107.       IData^.CBI.NumParam1 := IOErr;
  2108.       IData^.CBI.NumParam2 := cbsWrite;
  2109.       IData^.CBI.RetCode   := 0;
  2110.  
  2111.  
  2112.       IData^.CBIProc( @IData^.CBI );
  2113.  
  2114.       If (IData^.CBI.RetCode = iffAbort) OR
  2115.          (IData^.CBI.RetCode = iffFail) Then
  2116.         Goto AbortCopy;
  2117.  
  2118.       If (IData^.CBI.RetCode = iffRetry) Then
  2119.         Goto ReWrite;
  2120.  
  2121.     END;
  2122.  
  2123.   UNTIL ( ( NumRead = 0 ) AND ( IOErr = 0 ) ) OR
  2124.         ( NumWritten <> NumRead );
  2125.  
  2126.   ABORTCOPY:
  2127.  
  2128.   {$I+}
  2129.  
  2130.   FreeMem( Buf, Count );
  2131.  
  2132.   If (IData^.CBI.RetCode = iffFail) Then
  2133.     VCopyFileLow := erVCopy_Fail
  2134.   Else
  2135.   If (IData^.CBI.RetCode = iffAbort) Then
  2136.     VCopyFileLow := erVCopy_None
  2137.   Else
  2138.   If ( (NumWritten <> NumRead) AND (NumRead <> 0) ) Then
  2139.     VCopyFileLow := erVCopy_NoRoom
  2140.   Else
  2141.     VCopyFileLow := erVCopy_None;
  2142.  
  2143. END;
  2144.  
  2145. {────────────────────────────────────────────────────────────────────────────}
  2146.  
  2147. Function ShareFile(                Var fi        : FILE;
  2148.                                    Var Timeout   : WORD         ) : INTEGER;
  2149.  
  2150. Var
  2151.  
  2152.   Clock1 : TSwatch;
  2153.   Clock2 : TSwatch;
  2154.  
  2155. BEGIN
  2156.  
  2157.   Clock1 := 0;
  2158.   Clock2 := 0;
  2159.  
  2160.   {$I-}
  2161.   Reset( fi, 1 );
  2162.   {$I+}
  2163.  
  2164.   If ( IOResult in [0, 162] ) Then
  2165.   BEGIN
  2166.  
  2167.     Clock1 := CurrSwatch;
  2168.  
  2169.     Repeat
  2170.  
  2171.       Clock2 := CurrSwatch;
  2172.  
  2173.       {$I-}
  2174.       Reset( fi, 1 );
  2175.       {$I+}
  2176.  
  2177.     Until ( IOResult <> 162 ) OR
  2178.           ( Clock2 - Clock1 > Timeout );
  2179.  
  2180.   END;
  2181.  
  2182.   If ( Clock2 - Clock1 > Timeout ) Then
  2183.     ShareFile := erVCopy_Timeout
  2184.   Else
  2185.     ShareFile := erVCopy_None;
  2186.  
  2187. END;
  2188.  
  2189. {────────────────────────────────────────────────────────────────────────────}
  2190.  
  2191. Procedure VCopyShowError(              ErrNo     : WORD;
  2192.                                        IData     : PCopyIData   );
  2193.  
  2194. Var
  2195.  
  2196.   S : STRING;
  2197.  
  2198. BEGIN
  2199.  
  2200.   Case ErrNo of
  2201.  
  2202.     erVCopy_None :
  2203.       S := '';
  2204.  
  2205.     erVCopy_SamePath :
  2206.  
  2207.       BEGIN
  2208.  
  2209.         S := 'Can''t ';
  2210.  
  2211.         If VCopyChkFlag(IData, coMove) Then
  2212.           S := S + 'move'
  2213.         Else
  2214.           S := S + 'copy';
  2215.  
  2216.         S := S + ' file to itself "' + LowerString(IData^.stTo.FName) + '"';
  2217.  
  2218.       END;
  2219.  
  2220.     erVCopy_NoExistFileFrom :
  2221.       S := 'Source file(s) does not exist';
  2222.  
  2223.     erVCopy_NoExistFileTo :
  2224.       S := 'Target file(s) does not exist';
  2225.  
  2226.     erVCopy_NoExistDirFrom :
  2227.       S := 'Source path does not exist';
  2228.  
  2229.     erVCopy_NoExistDirTo :
  2230.       S := 'Target path does not exist';
  2231.  
  2232.     erVCopy_Timeout :
  2233.       S := 'Timeout occured during operation';
  2234.  
  2235.     erVCopy_NoRoom :
  2236.       S := 'Insufficient disk space for "' +
  2237.            LowerString(IData^.stTo.FName) + '"';
  2238.  
  2239.     erVCopy_ListFileNotFound :
  2240.       S := 'List file "' + LowerString(IData^.ListFName) + '" not found';
  2241.  
  2242.     erVCopy_TargetPathIsFile :
  2243.       S := 'Target directory "' + LowerString(IData^.stTo.Path) + '" is an existing file';
  2244.  
  2245.     erVCopy_Fail :
  2246.       S := 'Failed copying of file(s)';
  2247.  
  2248.   End;
  2249.  
  2250.   VCopyWriteLn(S + '.');
  2251.  
  2252. END;
  2253.  
  2254. {────────────────────────────────────────────────────────────────────────────}
  2255.  
  2256. Procedure VCopyDoErrorReport(          IData     : PCopyIData;
  2257.                                    Var Error     : LONGINT    );
  2258.  
  2259. BEGIN
  2260.  
  2261.   {-----------------------------}
  2262.   { If show flag, display error }
  2263.   {-----------------------------}
  2264.  
  2265.   If (VCopyChkFlag(IData, coShow)) Then
  2266.     VCopyShowError( Error, IData );
  2267.  
  2268.   {----------------------------------------------------}
  2269.   { If callback procedure active, do an error callback }
  2270.   {----------------------------------------------------}
  2271.  
  2272.   If CheckCBI(IData, cbeVCopyErr) Then
  2273.   BEGIN
  2274.  
  2275.     IData^.CBI.Event     := cbeVCopyErr;
  2276.     IData^.CBI.NumParam1 := Error;
  2277.     IData^.CBI.RetCode   := 0;
  2278.  
  2279.     IData^.CBIProc( @IData^.CBI );
  2280.  
  2281.   END
  2282. END;
  2283.  
  2284. {────────────────────────────────────────────────────────────────────────────}
  2285.  
  2286. Function ShowFileStr(                  IData     : PCopyIData;
  2287.                                        WhichFile : BYTE       ) : STRING;
  2288.  
  2289. Var
  2290.  
  2291.   ShowF : STRING;
  2292.   L1    : LONGINT;
  2293.   L2    : LONGINT;
  2294.   DT    : TDateTime;
  2295.   DTEx  : TDateTimeEx;
  2296.   S1    : STRING;
  2297.   stFil : PFile;  { used as TFile(stFil^) }
  2298.  
  2299. BEGIN
  2300.  
  2301.   Case WhichFile of
  2302.  
  2303.     iffSource : stFil := PFile( @IData^.stFrom );  { Source file }
  2304.     iffTarget : stFil := PFile( @IData^.stTo );    { Target file }
  2305.  
  2306.   End;
  2307.  
  2308.   With IData^ Do
  2309.   BEGIN
  2310.  
  2311.     ShowF := '';
  2312.  
  2313.     If VCopyChkShowFlag(IData, iffFilename) Then
  2314.       ShowF := LowerString(TFile(stFil^).FName) + ' ';
  2315.  
  2316.     ShowF := ShowF + '(';
  2317.  
  2318.     For L1 := iffAttrib to iffSize Do
  2319.     BEGIN
  2320.  
  2321.       If VCopyChkShowFlag(IData, L1) Then
  2322.       Case L1 of
  2323.  
  2324.         {---}
  2325.  
  2326.         iffAttrib :
  2327.  
  2328.           If TFile(stFil^).Attr <> 0 Then
  2329.           BEGIN
  2330.  
  2331.             L2 := Byte(ShowF[0]);
  2332.  
  2333.             If (TFile(stFil^).Attr AND Archive = Archive) Then
  2334.               ShowF := ShowF + 'A';
  2335.             If (TFile(stFil^).Attr AND SysFile = SysFile) Then
  2336.               ShowF := ShowF + 'S';
  2337.             If (TFile(stFil^).Attr AND Hidden = Hidden) Then
  2338.               ShowF := ShowF + 'H';
  2339.             If (TFile(stFil^).Attr AND ReadOnly = ReadOnly) Then
  2340.               ShowF := ShowF + 'R';
  2341.  
  2342.             If L2 < Byte(ShowF[0]) Then
  2343.               ShowF := ShowF + ShowDelim;
  2344.  
  2345.           END;
  2346.  
  2347.         {---}
  2348.  
  2349.         iffDate :
  2350.  
  2351.           If TFile(stFil^).Time <> 0 Then
  2352.           BEGIN
  2353.  
  2354.             UnpackTime( TFile(stFil^).Time, DT );
  2355.  
  2356.             DateTimeToEx( DT, DTEx );
  2357.  
  2358.             ShowF := ShowF +
  2359.               VDatesMaskStr( DTEx, vcDateStr ) + ShowDelim;
  2360.  
  2361.           END;
  2362.  
  2363.         {---}
  2364.  
  2365.         iffTime :
  2366.  
  2367.           If TFile(stFil^).Time <> 0 Then
  2368.           BEGIN
  2369.  
  2370.             UnpackTime( TFile(stFil^).Time, DT );
  2371.  
  2372.             DateTimeToEx( DT, DTEx );
  2373.  
  2374.             ShowF := ShowF +
  2375.               VDatesMaskStr( DTEx, vcTimeStr ) + ShowDelim;
  2376.  
  2377.           END;
  2378.  
  2379.         {---}
  2380.  
  2381.         iffPackedDate :
  2382.  
  2383.           If TFile(stFil^).Time <> 0 Then
  2384.           BEGIN
  2385.  
  2386.             UnpackTime( TFile(stFil^).Time, DT );
  2387.  
  2388.             DateTimeToEx( DT, DTEx );
  2389.  
  2390.             S1 := VDatesMaskStr( DTEx, vcPackDateStr );
  2391.  
  2392.             If (S1[1] = ' ') Then
  2393.               Delete(S1, 1, 1);
  2394.  
  2395.             ShowF := ShowF + S1 + ShowDelim;
  2396.  
  2397.           END;
  2398.  
  2399.         {---}
  2400.  
  2401.         iffSize :
  2402.  
  2403.           If TFile(stFil^).Size <> 0 Then
  2404.             ShowF := ShowF + AddCommas( IntToStr( TFile(stFil^).Size ) ) +
  2405.                      ShowDelim;
  2406.  
  2407.       End;
  2408.  
  2409.     END;
  2410.  
  2411.     If (ShowF[Byte(ShowF[0])] <> '(') Then
  2412.     BEGIN
  2413.  
  2414.       Delete( ShowF,
  2415.                Byte(ShowF[0]) - Pred(Byte(ShowDelim[0])),
  2416.                Byte(ShowDelim[0]) );
  2417.  
  2418.       ShowF := ShowF + ') ';
  2419.  
  2420.     END
  2421.     Else
  2422.       Delete(ShowF, Byte(ShowF[0]), 1);
  2423.  
  2424.   END;
  2425.  
  2426.   ShowFileStr := ShowF;
  2427.  
  2428. END;
  2429.  
  2430. {────────────────────────────────────────────────────────────────────────────}
  2431.  
  2432. Function ShowTypeStr(                  IData     : PCopyIData ) : STRING;
  2433.  
  2434. Var
  2435.  
  2436.   ShowType : STRING;     { Show parameter delimiter }
  2437.  
  2438. BEGIN
  2439.  
  2440.   With IData^ Do
  2441.   BEGIN
  2442.  
  2443.     If VCopyChkFlag(IData, coMove) Then
  2444.       ShowType := '->'
  2445.     Else
  2446.       ShowType := '=>';
  2447.  
  2448.     If (VCopyChkFlag(IData, coAppend)) AND
  2449.        (FileExist(stTo.FName)) Then
  2450.       ShowType := ShowType + '>';
  2451.  
  2452.   END;
  2453.  
  2454.   ShowTypeStr := ShowType;
  2455.  
  2456. END;
  2457.  
  2458. {────────────────────────────────────────────────────────────────────────────}
  2459.  
  2460. Function VCopyFileEx(             stPathFrom  : PathStr;
  2461.                                   stPathTo    : PathStr;
  2462.                                   Params      : STRING;
  2463.                                   CBEvents    : LONGINT;
  2464.                                   CBProc      : PCopyCallBackProc ) : INTEGER;
  2465.  
  2466. Var
  2467.   L1,
  2468.   L2       : WORD;
  2469.   IData    : PCopyIData; { semi-"global" data within this structure }
  2470.   nfCount  : WORD;
  2471.   Err      : INTEGER;
  2472.   teDT     : PFileDT;    { Temporary Date/Time Link-list pointer }
  2473.  
  2474. Label
  2475.   DeInit;
  2476.  
  2477. BEGIN
  2478.  
  2479.   {--------------------}
  2480.   { Init instance data }
  2481.   {--------------------}
  2482.  
  2483.   New( IData );
  2484.   FillChar( IData^, SizeOf( TCopyIData ), 0 );
  2485.  
  2486.   With IData^ Do
  2487.   BEGIN
  2488.  
  2489.     {--------------}
  2490.     { Set up flags }
  2491.     {--------------}
  2492.  
  2493.     CBIEvents:= CBEvents;
  2494.     CBIProc  := TCopyCallBackProc(CBProc);
  2495.  
  2496.     seAttr   := 0;
  2497.     Timeout  := 30;
  2498.  
  2499.     VCopySetupParams( IData, Params );
  2500.  
  2501.     VCopyFileEx := erVCopy_None;
  2502.  
  2503.     {------------------------------}
  2504.     { Save original (default) path }
  2505.     {------------------------------}
  2506.  
  2507.     stFrom.OrgPath := stPathFrom;
  2508.     stTo.OrgPath   := stPathTo;
  2509.  
  2510.     {---------------}
  2511.     { Get list file }
  2512.     {---------------}
  2513.  
  2514.     If stPathFrom[1] = '@' Then
  2515.     BEGIN
  2516.  
  2517.       ListFName := FExpand(
  2518.         Copy( stPathFrom, 2, Byte(stPathFrom[0]) - 1 ) );
  2519.       stPathFrom := '';
  2520.  
  2521.       If (NOT FileExist(ListFName)) Then
  2522.       BEGIN
  2523.  
  2524.         Abort := erVCopy_ListFileNotFound;
  2525.         Goto DeInit;
  2526.  
  2527.       END;
  2528.  
  2529.       VCopySetFlag(IData, coListFile);
  2530.  
  2531.     END;
  2532.  
  2533.     OrgFlag    := OpFlag;
  2534.     OrgTimeout := Timeout;
  2535.     OrgseAttr  := seAttr;
  2536.  
  2537.     {---------------------------------}
  2538.     { Set up directory and file paths }
  2539.     {---------------------------------}
  2540.  
  2541.     Abort := VCopySetupDir( IData, stPathFrom, stPathTo );
  2542.  
  2543.     If (Abort <> erVCopy_None) Then
  2544.       Goto DeInit;
  2545.  
  2546.     {---------------------------------}
  2547.     { Trap for invalid directory info }
  2548.     {---------------------------------}
  2549.  
  2550.     If (stFrom.Dir + stFrom.Wildcard) =
  2551.        (stTo.Dir + stTo.Wildcard) Then
  2552.     BEGIN
  2553.  
  2554.       Abort := erVCopy_SamePath;
  2555.       Goto DeInit;
  2556.  
  2557.     END;
  2558.  
  2559.     If NOT DirExist(stFrom.Dir) Then
  2560.     BEGIN
  2561.  
  2562.       Abort := erVCopy_NoExistDirFrom;
  2563.       Goto DeInit;
  2564.  
  2565.     END;
  2566.  
  2567.     If (NOT DirExist(stTo.Dir)) AND
  2568.        (NOT VCopyChkFlag(IData, coTestMode)) Then
  2569.     BEGIN
  2570.  
  2571.       Abort := erVCopy_NoExistDirTo;
  2572.       Goto DeInit;
  2573.  
  2574.     END;
  2575.  
  2576.     {═══════════════}
  2577.     {═ BEGIN VCOPY ═}
  2578.     {═══════════════}
  2579.  
  2580.     nfCount  := 0;
  2581.     Abort    := erVCopy_None;
  2582.  
  2583.     REPEAT
  2584.  
  2585.       {---------------}
  2586.       { Get next file }
  2587.       {---------------}
  2588.  
  2589.       VCopyFindFile( IData );
  2590.  
  2591.       If (stFrom.FName <> '') Then
  2592.       BEGIN
  2593.  
  2594.         {--------------------------------------------}
  2595.         { Check if target file exists.  If not,      }
  2596.         { continue.  If so and overwrite flag, then  }
  2597.         { continue.                                  }
  2598.         {--------------------------------------------}
  2599.  
  2600.         If ( (NOT FileExist(stTo.FName)) OR
  2601.              ( (FileExist(stTo.FName) AND
  2602.                (NOT VCopyChkFlag(IData, coNoOverwrite))) ) ) Then
  2603.         BEGIN
  2604.  
  2605.           {-----------------------------------}
  2606.           { If newer flag and source file is  }
  2607.           { newer than target file, continue. }
  2608.           {-----------------------------------}
  2609.  
  2610.           If ( (NOT VCopyChkFlag(IData, coNewer)) OR
  2611.                ( (VCopyChkFlag(IData, coNewer)) AND
  2612.                  (stFrom.Time > stTo.Time) ) ) Then
  2613.           BEGIN
  2614.  
  2615.             {------------------------------}
  2616.             { If show flag, display source }
  2617.             { and type information         }
  2618.             {------------------------------}
  2619.  
  2620.             If VCopyChkFlag(IData, coShow) Then
  2621.               VCopyWrite(ShowFileStr(IData, iffSource) +
  2622.                          ShowTypeStr(IData) + ' ');
  2623.  
  2624.             {---------------------------}
  2625.             { If not append flag and    }
  2626.             { target file exists, erase }
  2627.             {---------------------------}
  2628.  
  2629.             If (NOT VCopyChkFlag(IData, coAppend)) AND
  2630.                (FileExist(stTo.FName)) Then
  2631.             BEGIN
  2632.  
  2633.               Assign(stTo.fi, stTo.FName);
  2634.  
  2635.               If VCopyChkFlag(IData, coShare) Then
  2636.                 Abort := ShareFile( stTo.fi, Timeout );
  2637.  
  2638.               If (Abort = erVCopy_None) AND
  2639.                  (NOT VCopyChkFlag(IData, coTestMode))  Then
  2640.               BEGIN
  2641.  
  2642.                 {-----------------------------}
  2643.                 { If target has ReadOnly      }
  2644.                 { flag, then clear flag first }
  2645.                 {-----------------------------}
  2646.  
  2647.                 If ((stTo.Attr AND ReadOnly) = ReadOnly) Then
  2648.                   SetFAttr( stTo.fi,
  2649.                             stTo.Attr AND NOT ReadOnly );
  2650.  
  2651.                 Erase(stTo.fi);
  2652.  
  2653.               END;
  2654.  
  2655.             END;
  2656.  
  2657.             {-----------------------}
  2658.             { Check for a fast move }
  2659.             {-----------------------}
  2660.  
  2661.             If (VCopyChkFlag(IData, coMove)) AND
  2662.                (stFrom.Drive = stTo.Drive) AND
  2663.                (NOT VCopyChkFlag(IData, coAppend)) Then
  2664.             BEGIN
  2665.  
  2666.               {-----------------------------------}
  2667.               { fast move - same drive, no append }
  2668.               {-----------------------------------}
  2669.  
  2670.               Assign(stTo.fi, stFrom.FName);
  2671.  
  2672.               If VCopyChkFlag(IData, coShare) Then
  2673.                 Abort := ShareFile( stTo.fi, Timeout );
  2674.  
  2675.               If (Abort = erVCopy_None) AND
  2676.                  (NOT VCopyChkFlag(IData, coTestMode)) Then
  2677.                 Rename(stTo.fi, stTo.FName);
  2678.  
  2679.               stTo.Attr := stFrom.Attr;
  2680.               stTo.Time := stFrom.Time;
  2681.               stTo.Size := stTo.Size;
  2682.  
  2683.             END
  2684.             Else
  2685.             BEGIN
  2686.  
  2687.               {-----------}
  2688.               { Copy file }
  2689.               {-----------}
  2690.  
  2691.               Assign(stFrom.fi, stFrom.FName);
  2692.               Assign(stTo.fi, stTo.FName);
  2693.  
  2694.               {------------------------------}
  2695.               { If source has readonly flag, }
  2696.               { set internal flag and clear. }
  2697.               {------------------------------}
  2698.  
  2699.               If ((stFrom.Attr AND ReadOnly) = ReadOnly) Then
  2700.               BEGIN
  2701.  
  2702.                 stFrom.fiFlag := stFrom.fiFlag OR iffReadOnly;
  2703.                 stFrom.Attr := stFrom.Attr AND NOT ReadOnly;
  2704.  
  2705.                 If (NOT VCopyChkFlag(IData, coTestMode)) Then
  2706.                   SetFAttr(stFrom.fi, stFrom.Attr);
  2707.  
  2708.               END;
  2709.  
  2710.               {------------------------------}
  2711.               { If target had readonly flag, }
  2712.               { set internal flag and clear. }
  2713.               {------------------------------}
  2714.  
  2715.               If ((stTo.Attr AND ReadOnly) = ReadOnly) Then
  2716.               BEGIN
  2717.  
  2718.                 stTo.fiFlag := stTo.fiFlag OR iffReadOnly;
  2719.                 stTo.Attr := stTo.Attr AND NOT ReadOnly;
  2720.  
  2721.                 If (NOT VCopyChkFlag(IData, coTestMode)) Then
  2722.                   SetFAttr(stTo.fi, stTo.Attr);
  2723.  
  2724.               END;
  2725.  
  2726.               If VCopyChkFlag(IData, coShare) Then
  2727.                 Abort := ShareFile( stFrom.fi, Timeout );
  2728.  
  2729.               {------------------}
  2730.               { Open source file }
  2731.               {------------------}
  2732.  
  2733.               If (Abort = erVCopy_None) AND
  2734.                  (NOT VCopyChkFlag(IData, coTestMode)) Then
  2735.               BEGIN
  2736.  
  2737.                 {---------------------------------}
  2738.                 { Source file reset open callback }
  2739.                 {---------------------------------}
  2740.  
  2741.                 If CheckCBI(IData, cbeSourceOpen) Then
  2742.                 BEGIN
  2743.  
  2744.                   IData^.CBI.Event     := cbeSourceOpen;
  2745.                   IData^.CBI.StrParam  := stFrom.FName;
  2746.                   IData^.CBI.PtrParam1 := NIL;
  2747.                   IData^.CBI.RetCode   := 0;
  2748.  
  2749.                   IData^.CBIProc( @IData^.CBI );
  2750.  
  2751.                 END;
  2752.  
  2753.                 Reset(stFrom.fi, 1);
  2754.  
  2755.               END;
  2756.  
  2757.               {------------------}
  2758.               { Open target file }
  2759.               {------------------}
  2760.  
  2761.               {------------------------------------}
  2762.               { If append flag, goto EOF of target }
  2763.               {------------------------------------}
  2764.  
  2765.               If (VCopyChkFlag(IData, coAppend)) AND
  2766.                  (FileExist(stTo.FName)) Then
  2767.  
  2768.               BEGIN
  2769.  
  2770.                 If VCopyChkFlag(IData, coShare) Then
  2771.                   Abort := ShareFile( stTo.fi, Timeout );
  2772.  
  2773.                 If (Abort = erVCopy_None) AND
  2774.                    (NOT VCopyChkFlag(IData, coTestMode)) Then
  2775.                 BEGIN
  2776.  
  2777.                   {----------------------------------}
  2778.                   { Target file append open callback }
  2779.                   {----------------------------------}
  2780.  
  2781.                   If CheckCBI(IData, cbeTargetOpen) Then
  2782.                   BEGIN
  2783.  
  2784.                     IData^.CBI.Event     := cbeTargetOpen;
  2785.                     IData^.CBI.StrParam  := stTo.FName;
  2786.                     IData^.CBI.NumParam1 := iffAppend;
  2787.                     IData^.CBI.PtrParam1 := NIL;
  2788.                     IData^.CBI.RetCode   := 0;
  2789.  
  2790.                     IData^.CBIProc( @IData^.CBI );
  2791.  
  2792.                   END;
  2793.  
  2794.                   Reset(stTo.fi, 1);
  2795.                   Seek(stTo.fi, stTo.Size);
  2796.  
  2797.                 END;
  2798.  
  2799.               END
  2800.               Else
  2801.               BEGIN
  2802.  
  2803.                 If VCopyChkFlag(IData, coShare) Then
  2804.                   Abort := ShareFile( stTo.fi, Timeout );
  2805.  
  2806.                 If (Abort = erVCopy_None) AND
  2807.                    (NOT VCopyChkFlag(IData, coTestMode)) Then
  2808.                 BEGIN
  2809.  
  2810.                   {-----------------------------------}
  2811.                   { Target file rewrite open callback }
  2812.                   {-----------------------------------}
  2813.  
  2814.                   If CheckCBI(IData, cbeTargetOpen) Then
  2815.                   BEGIN
  2816.  
  2817.                     IData^.CBI.Event     := cbeTargetOpen;
  2818.                     IData^.CBI.StrParam  := stTo.FName;
  2819.                     IData^.CBI.NumParam1 := 0;
  2820.                     IData^.CBI.PtrParam1 := NIL;
  2821.                     IData^.CBI.RetCode   := 0;
  2822.  
  2823.                     IData^.CBIProc( @IData^.CBI );
  2824.  
  2825.                   END;
  2826.  
  2827.                   ReWrite(stTo.fi, 1);
  2828.  
  2829.                 END;
  2830.  
  2831.               END;
  2832.  
  2833.               {------------------}
  2834.               { Do physical copy }
  2835.               {------------------}
  2836.  
  2837.               If (NOT VCopyChkFlag(IData, coTestMode)) Then
  2838.                 Abort := VCopyFileLow( IData )
  2839.               Else
  2840.                 Abort := erVCopy_None;
  2841.  
  2842.               {----------------------}
  2843.               { If all ok, continue. }
  2844.               {----------------------}
  2845.  
  2846.               If Abort = erVCopy_None Then
  2847.               BEGIN
  2848.  
  2849.                 {-----------------------------}
  2850.                 { Preserve attribute and time }
  2851.                 {-----------------------------}
  2852.  
  2853.                 If (NOT VCopyChkFlag(IData, coTestMode)) Then
  2854.                 BEGIN
  2855.  
  2856.                   {----------------------------}
  2857.                   { Source file close callback }
  2858.                   {----------------------------}
  2859.  
  2860.                   If CheckCBI(IData, cbeSourceClose) Then
  2861.                   BEGIN
  2862.  
  2863.                     IData^.CBI.Event     := cbeSourceClose;
  2864.                     IData^.CBI.StrParam  := stFrom.FName;
  2865.                     IData^.CBI.PtrParam1 := NIL;
  2866.                     IData^.CBI.RetCode   := 0;
  2867.  
  2868.                     IData^.CBIProc( @IData^.CBI );
  2869.  
  2870.                   END;
  2871.  
  2872.                   Close(stFrom.fi);
  2873.  
  2874.                   {----------------------------}
  2875.                   { Target file close callback }
  2876.                   {----------------------------}
  2877.  
  2878.                   If CheckCBI(IData, cbeTargetClose) Then
  2879.                   BEGIN
  2880.  
  2881.                     IData^.CBI.Event     := cbeTargetClose;
  2882.                     IData^.CBI.StrParam  := stTo.FName;
  2883.                     IData^.CBI.PtrParam1 := NIL;
  2884.                     IData^.CBI.RetCode   := 0;
  2885.  
  2886.                     IData^.CBIProc( @IData^.CBI );
  2887.  
  2888.                   END;
  2889.  
  2890.                   {-------------------------}
  2891.                   { Preserve time in target }
  2892.                   {-------------------------}
  2893.  
  2894.                   SetFTime( stTo.fi, stFrom.Time );
  2895.                   Close(stTo.fi);
  2896.  
  2897.                 END;
  2898.  
  2899.                 {------------------------------}
  2900.                 { Preserve attributes in files }
  2901.                 {------------------------------}
  2902.  
  2903.                 {------------------------------}
  2904.                 { If source had readonly flag, }
  2905.                 { reset internal flag and set. }
  2906.                 {------------------------------}
  2907.  
  2908.                 If ((stFrom.fiFlag AND iffReadOnly) = iffReadOnly) Then
  2909.                 BEGIN
  2910.  
  2911.                   stFrom.fiFlag := stFrom.fiFlag AND NOT iffReadOnly;
  2912.                   stFrom.Attr := stFrom.Attr OR ReadOnly;
  2913.  
  2914.                   If (NOT VCopyChkFlag(IData, coTestMode)) Then
  2915.                     SetFAttr( stFrom.fi, stFrom.Attr );
  2916.  
  2917.                 END;
  2918.  
  2919.                 {------------------------------}
  2920.                 { If target had readonly flag, }
  2921.                 { reset internal flag and set. }
  2922.                 {------------------------------}
  2923.  
  2924.                 If ((stTo.fiFlag AND iffReadOnly) = iffReadOnly) Then
  2925.                 BEGIN
  2926.  
  2927.                   stTo.fiFlag := stTo.fiFlag AND NOT iffReadOnly;
  2928.                   stTo.Attr := stTo.Attr OR ReadOnly;
  2929.  
  2930.                   If (NOT VCopyChkFlag(IData, coTestMode)) Then
  2931.                     SetFAttr( stTo.fi, stTo.Attr );
  2932.  
  2933.                 END;
  2934.  
  2935.                 {---------------------------------}
  2936.                 { If internal attr flag = 0, make }
  2937.                 { target attr same as source attr }
  2938.                 {---------------------------------}
  2939.  
  2940.                 If (stTo.Attr = 0) Then
  2941.                   stTo.Attr := stFrom.Attr;
  2942.  
  2943.                 {----------------------}
  2944.                 { Set target attribute }
  2945.                 {----------------------}
  2946.  
  2947.                 If (NOT VCopyChkFlag(IData, coTestMode)) Then
  2948.                   SetFAttr( stTo.fi, stFrom.Attr );
  2949.  
  2950.                 {---------------------------------}
  2951.                 { If move flag, then erase source }
  2952.                 {---------------------------------}
  2953.  
  2954.                 If VCopyChkFlag(IData, coMove) Then
  2955.                 BEGIN
  2956.  
  2957.                   If VCopyChkFlag(IData, coShare) Then
  2958.                     Abort := ShareFile( stFrom.fi, Timeout );
  2959.  
  2960.                   If (Abort = erVCopy_None) AND
  2961.                      (NOT VCopyChkFlag(IData, coTestMode)) Then
  2962.                   BEGIN
  2963.  
  2964.                     ReWrite(stFrom.fi, 1);
  2965.                     Close(stFrom.fi);
  2966.                     Erase(stFrom.fi);
  2967.  
  2968.                   END;
  2969.  
  2970.                 END;
  2971.  
  2972.               END;
  2973.  
  2974.             END;
  2975.  
  2976.             If Abort = erVCopy_None Then
  2977.               Inc(nfCount);
  2978.  
  2979.             If VCopyChkFlag(IData, coShow) Then
  2980.             BEGIN
  2981.  
  2982.               stTo.Attr := GetFileAttr( stTo.FName );
  2983.               stTo.Time := GetFileTime( stTo.FName );
  2984.               stTo.Size := GetFileSize( stTo.FName );
  2985.  
  2986.               {-----------------------------------}
  2987.               { If show flag, display target info }
  2988.               {-----------------------------------}
  2989.  
  2990.               VCopyWriteLn(ShowFileStr(IData, iffTarget));
  2991.  
  2992.             END;
  2993.  
  2994.           END;
  2995.  
  2996.         END
  2997.         Else
  2998.         BEGIN
  2999.  
  3000.           {-----------------------------------}
  3001.           { Since target file exists and      }
  3002.           { nooverwrite flag, check for move  }
  3003.           { flag.  If so, delete source file. }
  3004.           {-----------------------------------}
  3005.  
  3006.           If (VCopyChkFlag(IData, coMove)) Then
  3007.           BEGIN
  3008.  
  3009.              Assign(stFrom.fi, stFrom.FName);
  3010.  
  3011.              If VCopyChkFlag(IData, coShare) Then
  3012.                Abort := ShareFile( stFrom.fi, Timeout );
  3013.  
  3014.              If (Abort = erVCopy_None) AND
  3015.                 (NOT VCopyChkFlag(IData, coTestMode)) Then
  3016.              BEGIN
  3017.  
  3018.                ReWrite(stFrom.fi, 1);
  3019.                Close(stFrom.fi);
  3020.                Erase(stFrom.fi);
  3021.  
  3022.              END;
  3023.  
  3024.           END;
  3025.  
  3026.         END;
  3027.  
  3028.       END;
  3029.  
  3030.     UNTIL (stFrom.FName = '') or (Abort <> erVCopy_None);
  3031.  
  3032.     {------------------------------}
  3033.     { If show flag, display number }
  3034.     { of files transferred.        }
  3035.     {------------------------------}
  3036.  
  3037.     If VCopyChkFlag(IData, coShow) Then
  3038.     BEGIN
  3039.  
  3040.       VCopyWrite('     ' + IntToStr(nfCount) + ' file(s) ');
  3041.       If VCopyChkFlag(IData, coMove) Then
  3042.         VCopyWriteLn('moved')
  3043.       Else
  3044.         VCopyWriteLn('copied');
  3045.  
  3046.     END;
  3047.  
  3048.     {-------------------------------}
  3049.     { Remove source-first directory }
  3050.     { upon a subdirectory move.     }
  3051.     {-------------------------------}
  3052.  
  3053.     If ( (VCopyChkFlag(IData, coSubDir)) AND
  3054.          (VCopyChkFlag(IData, coMove)) AND
  3055.          (Abort = erVCopy_None) ) Then
  3056.     BEGIN
  3057.  
  3058.       If (DirEmpty(stFrom.OrgDir)) AND
  3059.          (NOT VCopyChkFlag(IData, coTestMode)) Then
  3060.  
  3061.         RmDir( Copy( PutSlash(stFrom.OrgDir),
  3062.                      1,
  3063.                      Pred(Length(stFrom.OrgDir)) ) );
  3064.  
  3065.     END;
  3066.  
  3067.  
  3068.    {-------}
  3069.     DEINIT:
  3070.    {-------}
  3071.  
  3072.     {----------------------------}
  3073.     { Delete date/time link list }
  3074.     {----------------------------}
  3075.  
  3076.     If seDT <> NIL Then
  3077.     BEGIN
  3078.  
  3079.       While (seDT^.Next <> NIL) Do
  3080.       BEGIN
  3081.  
  3082.         teDT := seDT^.Next;
  3083.         seDT^.Next := teDT^.Next;
  3084.  
  3085.         Dispose( teDT );
  3086.  
  3087.       END;
  3088.  
  3089.       Dispose( seDT );
  3090.  
  3091.     END;
  3092.  
  3093.     {---------------------------------}
  3094.     { If error occured then call the  }
  3095.     { error report procedure.         }
  3096.     {---------------------------------}
  3097.  
  3098.     If (Abort <> erVCopy_None) Then
  3099.       VCopyDoErrorReport( IData, Abort );
  3100.  
  3101.     VCopyFileEx := Abort;
  3102.  
  3103.   END;
  3104.  
  3105.   {----------------------}
  3106.   { DeInit instance data }
  3107.   {----------------------}
  3108.  
  3109.   Dispose( IData );
  3110.  
  3111. END;
  3112.  
  3113. {────────────────────────────────────────────────────────────────────────────}
  3114.  
  3115. Function VCopyFile(                    stPathFrom : PathStr;
  3116.                                        stPathTo   : PathStr;
  3117.                                        Params     : STRING      ) : INTEGER;
  3118.  
  3119. BEGIN
  3120.  
  3121.   VCopyFile := VCopyFileEx( stPathFrom,
  3122.                             stPathTo,
  3123.                             Params,
  3124.                             cbeAll,
  3125.                             @MyCallBackProc );
  3126.  
  3127. END;
  3128.  
  3129. {────────────────────────────────────────────────────────────────────────────}
  3130. {────────────────────────────────────────────────────────────────────────────}
  3131. {────────────────────────────────────────────────────────────────────────────}
  3132.  
  3133. BEGIN
  3134. END.
  3135.