PC World Komputer 1998 April A/Pcwk4a98.iso/PROGRAM/DELPHI16/Backup/BACKUP.PAS

Pascal/Delphi Source File | 1996-02-19 | 29.0 KB | 1,102 lines

{
 Designer: Craig Ward, [e-mail]
 Date:     5/2/96
 Version:  3.57


 Function: Backup dialog DLL. Copies files from a source to a target. Will copy the
           contents of a directory, or, a single file. An additional call will uncompress
           the target file if the source was compressed using MS's COMPRESS.EXE

 Update:   The following enhancements have been made since the previous version:

            [1] an additional facility enables users to copy only newer files
                (this is achieved by checking file dates, and only copying those
                which are newer)
            [2] as a consequence to the above I've had to make a change to the DLL
                call "HideBackupDlg". A new parameter (a bool) accomodates this
                feature.
            [3] there was a bug which misreported file size\date info when overwriting
                (it was in fact reported the wrong way round!)


 Space:    The way that the DLL works in checking size\space is the following:

            [1] it sums the size of the files to be copied
            [2] it sums the size of the existing target files
            [3] it finds the size of the target disk, if less than the size
                of the files being copied it aborts
            [4] if the size of the target disk is okay, the next thing to check
                is the free space on the target drive. The DLL finds this figure, and
                adds to it the size of the existing target files (ie: it's expecting the
                user will overwrite these). Again, if this figure is smaller than that
                being copied it aborts.
            [5] During the actual copying process the DLL will again check the free
                space on the target drive (handy for users of the CopyIndivFile call).

            (users of RAM drives beware: when the DLL checks file size, it doesn't bother
            to check the maximum number of file entries allowed)


 Calls:
           procedure ShowBackupDlg(pSource,pDestination,pHelp,pCompat: pChar; bOverwritePrompt: boolean);
            - opens the dialog box. This proc copies the contents of a whole directory that
              conforms to the mask passed over.

           procedure HideBackupDlg(pSource,pDestination,pHelp,pCompat: pChar; bOverwritePrompt, bCopyNew: boolean);
            - loads, but does not open dialog box, and executes the backup automatically, then closes.
              This proc copies the contents of a whole directory that conforms to the mask passed
              over.

           procedure CopyIndivFile(pSourceFile,pDestinationFile: pChar);
            - copies the source file to the target file.

           procedure ExpandIndivFile(pSourceFile,pDestinationFile: pChar);
            - copies the source file to the target file, and expands the file if it was
              compressed (using MS-COMPRESS.EXE).


 Extra:    Big thankyou to Dennis Passmore ([e-mail]), for his additions
           to the unit. These consisted of expanded error checking, creation of a custom type
           (the large buffer) to speed up the whole process and reduce stack usage, plus,
           the neat trick of restoring the file-date of the backed-up files to reflect the
           date of the source file, as opposed to that of when they were backed up.

           Also, a thankyou to Gregory Kraft ([e-mail]) who's enquiry
           precipitated the addition of the HideBackupDlg procedure.

           And, another thank you goes to Shane Mulo (INTERNET:[e-mail]) for
           his kind words and ideas for improvement.

           Finally, I'd like to thank Philip Kapusta ([e-mail]) for his
           diligence and patience in putting the DLL to test. His criticisms have helped
           shape the whole utility.

           All criticisms, help and general advice are greatly welcomed.
*********************************************************************************}
unit Backup;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Buttons, FileCtrl, Gauges, ExtCtrls;

type
 {custom type to hold file information}
 TFileInfo = record
  Date: longint;
  Size: longint;
 end;
 {**}
  TBackupDlg = class(TForm)
    DirList: TDirectoryListBox;
    FList: TFileListBox;
    Label1: TLabel;
    lblSource: TLabel;
    Label2: TLabel;
    lblDestination: TLabel;
    btnOK: TBitBtn;
    btnCancel: TBitBtn;
    BitBtn1: TBitBtn;
    driveBox: TDriveComboBox;
    Bevel1: TBevel;
    Bevel2: TBevel;
    SpeedButton1: TSpeedButton;
    Bevel3: TBevel;
    Bevel4: TBevel;
    chkSelect: TCheckBox;
    chkNew: TCheckBox;
    procedure btnCancelClick(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure chkSelectClick(Sender: TObject);
    procedure FListClick(Sender: TObject);
    procedure FListDblClick(Sender: TObject);
    procedure FListKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure chkNewClick(Sender: TObject);
  private
    { Private declarations }
    FDir: string;                                         {stores current directory}
    FOkToAll: boolean;                                    {stores initial value passed to DLL for overwrite prompt}
    FNew: boolean;                                        {stores bool for determining whether to copy only newer files}
    procedure CustInitialise(pSource,pDestination,pHelp,pCompat: pChar; bOverwritePrompt: boolean);
    procedure SetUpFiles;
    procedure CustCopyFiles(sSrce, sDest: string);
    procedure CustExpandFile(pSrce, pDest: pChar);
    function ChangeExt(sSrce: string): string;
    function IsDir(sDrive: string): boolean;
    function DiskInDrive(i: integer): boolean;
    function GetFileInfo(sFile: string): TFileInfo;
    function CheckDir(sDir: string): string;
    function IsSpace(sDestination: string): longint;
  public
    { Public declarations }
    FCancel: boolean;
  end;

var
  BackupDlg: TBackupDlg;
  iErrorMode: word;
  OkToAll: boolean;



const
 iHelp: integer = 105; {help-context for SelectDirectory Dialog}


{exported procedures}
procedure ShowBackupDlg(pSource,pDestination,pHelp,pCompat: pChar; bOverwritePrompt: boolean); export;
procedure HideBackupDlg(pSource,pDestination,pHelp,pCompat: pChar; bOverwritePrompt, bCopyNew: boolean); export;
procedure CopyIndivFile(pSourceFile,pDestinationFile: pChar); export;
procedure ExpandIndivFile(pSourceFile,pDestinationFile: pChar); export;

implementation

{$R *.DFM}

uses
 LZExpand, prog;


{***custom routines*************************************************************}

{return free space, plus size of existing file. This routine is only called
 by CustCopyFiles (which it calls just before it attempts to copy the source
 file)}
function TBackupDlg.IsSpace(sDestination: string): longint;
var
 c: char;
 i: integer;
 li: longint;
 fExists: ^TFileInfo;
begin

 New(fExists);

 try

 {get drive letter}
 c := sDestination[1];

 {check that drive letter is valid}
 if c in ['a'..'z'] then Dec(c,($20));
 if not (c in ['A'..'Z']) then
  begin
   messageDlg('Invalid drive ID',mtWarning,[mbOK],0);
   result := 0;
  end;

 {get alphabet index of character - ie: A is 1. Remember, it's now uppercase}
 i := Ord(c)-$40 ;

 li := 0;
 li := DiskFree(i);

 {if the file exists, then add the existing file's size from value returned by diskFree,
  otherwise we would be misreporting the amount of free-space}
 if FileExists(sDestination) then
   begin
    fExists^ := GetFileInfo(sDestination);
    li := li + fExists^.size;
   end;

 result := li;

 finally
  dispose(fExists);
 end;

end;


{check directory - adds a colon and backslash if they're missing, and then
 calls isDir to check that the directory\drive is valid}
function TBackupDlg.CheckDir(sDir: string): string;
begin

 case length(sDir) of
 {case of sDir being just a drive letter, add ':\'}
  1:
   begin
    if isDir(sDir) then
     result := sDir + ':\'
    else
     result := FDir;
   end;
 else
  begin
    {text is okay, so check if directory exists}
    if isDir(sDir) then
     result := sDir
    else
     result := FDir;
  end;
 end;

end;


{change file extension routine - this routine simply iterates through an
 array, swapping the extension for a "full" extension}
function TBackupDlg.ChangeExt(sSrce: string): string;
type
 {custom type - stores replacment extensions}
 TRepExtensions = record
  CurrExt: string;
  RepExt: string;
end;
var
 FExtensions: array[1..6] of TRepExtensions;
 iInc: integer;
 sExt: string[4];
begin

 {extensions - note: do not include ini files or databases since the user's version will always be newer}
 FExtensions[1].CurrExt := '.EX_';
 FExtensions[1].RepExt := '.EXE';

 FExtensions[2].CurrExt := '.DL_';
 FExtensions[2].RepExt := '.DLL';

 FExtensions[3].CurrExt := '.HL_';
 FExtensions[3].RepExt := '.HLP';

 FExtensions[4].CurrExt := '.BM_';
 FExtensions[4].RepExt := '.BMP';

 FExtensions[5].CurrExt := '.IC_';
 FExtensions[5].RepExt := '.ICO';

 FExtensions[6].CurrExt := '.RP_';
 FExtensions[6].RepExt := '.RPT';

 if sSrce[length(sSrce)] = '_' then
  begin
   sExt := ExtractFileExt(sSrce);
   {iterate through extensions}
   for iInc := 1 to 6 do
    begin
     if CompareText(FExtensions[iInc].CurrExt,sExt) = 0 then sExt := FExtensions[iInc].RepExt;
    end;
   {change extension}
   sSrce := ChangeFileExt(sSrce,sExt);
   result := sSrce;
  end
 else
  result := '';

end;


{routine returns file information - called in the case of overwrites}
function TBackupDlg.GetFileInfo(sFile: string): TFileInfo;
var
 f: file;
 fInfo: ^TFileInfo;
begin

 New(fInfo);

 try

   if not FileExists(sFile) then exit;

   {Set file access mode to readonly in case file is in use.}
   System.FileMode := fmOpenRead;
   {assign and open files}
   AssignFile(f,sFile);
   {$I-}
   Reset(f,1);
   {$I+}
  {Set file access mode back to normal default for other processes}
  System.Filemode := fmOpenReadWrite;
  if IOResult <> 0  then
   begin
    messageDlg('Could not open: '+sFile,mtWarning,[mbOK],0);
    fInfo^.size := 0;
    fInfo^.date := 0;
   end
  else
   begin
    fInfo^.size := FileSize(f);
    fInfo^.date := FileGetDate(TFileRec(f).Handle);
   end;
  result := fInfo^;
  system.closeFile(f);

 finally
  Dispose(fInfo);
 end;

end;


{check for directory, or drive}
function TBackupDlg.IsDir(sDrive: string): boolean;
var
 c: char;
 i: integer;
begin

 {get drive letter}
 c := sDrive[1];

 {check that drive letter is valid}
 if c in ['a'..'z'] then Dec(c,($20));
 if not (c in ['A'..'Z']) then
  begin
   messageDlg('Invalid drive ID',mtWarning,[mbOK],0);
   result := false;
  end;

 {get alphabet index of character - ie: A is 1. Remember, it's now uppercase}
 i := Ord(c)-$40;


 if GetDriveType(i -1) = DRIVE_REMOVABLE then
  {floppy}
  begin

   {ensure floppy in drive - note that the user can cancel, in which
    case the default directory will be returned}
    while not DiskInDrive(i) do
     begin
      DiskInDrive(i);
     end;

   {floppy in drive, now check for directory}
   if (length(sDrive) > 3) then {where 3 would be the size of 'a:\'}
    begin
     {check floppy for sub-dir}
     if DirectoryExists(sDrive) then
      result := true
     else
      result := false;
    end
   else
    {user trying to copy to root of floppy drive}
    result := true
  end
 else
  {hard disk}
  begin
   {first, if sDrive is less than 3 characters then the user is trying to copy to a
    root, in which case DirectoryExists will fail. If the routine has reached this stage
    we should be sure that the drive is legal so return true}
   if length(sDrive) <= 3 then
    result := true
   else
   if DirectoryExists(sDrive) then
    result := true
   else
    begin
     messageDlg('"'+sDrive+'" Directory not found',mtWarning,[mbOK],0);
     result := false;
    end;
  end;

 {finally, check that drive is a legal drive}
 if DiskSize(i) = -1 then Result := False;

end;


{check for floppy disk in drive}
function TBackupDlg.DiskInDrive(i: integer): boolean;
begin
 if DiskSize(i) = -1 then
  begin
   if messageDlg('Please insert a floppy disk into the floppy drive',mtInformation,[mbOK,mbCancel],0)
    = mrCancel then result := true
   else
    result := false
  end
 else
  result := true;
end;


{set environment}
procedure TBackupDlg.CustInitialise(pSource,pDestination,pHelp,pCompat: pChar; bOverwritePrompt: boolean);
var
 s: ^string;
begin

 New(s);

 try

  {store current dir}
  GetDir(0,FDir);

  {turn off DOS error reporting}
  iErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);

  {set source dir}
  if Assigned(pSource) then
   begin
    s^ := CheckDir( StrPAS(pSource) );
    lblSource.Caption := LowerCase(s^);
    FList.Directory := lblSource.caption;
    DirList.Directory := lblSource.Caption;
    DriveBox.Drive := DirList.Drive;
   end;

  {set destination dir}
  if Assigned(pDestination) then
   begin
    s^ := CheckDir( StrPAS(pDestination) );
    lblDestination.Caption := LowerCase(s^);
   end;

  {set help file}
  if Assigned(pHelp) then
   if FileExists(StrPAS(pHelp)) then Application.HelpFile := strPAS(pHelp);

  {set file mask}
  if Assigned(pCompat) then
   FList.Mask := StrPAS(pCompat)
  else
   FList.Mask := '*.*';

  {set bools}
  FCancel := false;
  FOkToAll := bOverwritePrompt; {store value, since OkToAll could be set to false by SetupFiles proc}
  if bOverwritePrompt then
   OkToAll := false
  else
   OkToAll := true;

  {set list box}
  chkSelectClick(self);

 finally
  Dispose(s);
 end;

end;


{***Exported Procedures*********************************************************}

{calls the dialog - invisible - and copies the file}
procedure CopyIndivFile(pSourceFile,pDestinationFile: pChar);
begin
 {create dialog}
 BackupDlg := TBackupDlg.Create(application);
 try
  if (StrPAS(pSourceFile) <> '') and (StrPAS(pDestinationFile) <> '') then
   BackupDlg.CustCopyFiles(StrPAS(pSourceFile),StrPAS(pDestinationFile));
 finally
  BackupDlg.Free;
 end;
end;

{calls the dialog - invisible - and copies the file, expanding it if compressed}
procedure ExpandIndivFile(pSourceFile,pDestinationFile: pChar);
begin
 {create dialog}
 BackupDlg := TBackupDlg.Create(application);
 try
  if (StrPAS(pSourceFile) <> '') and (StrPAS(pDestinationFile) <> '') then
   BackupDlg.CustExpandFile(pSourceFile,pDestinationFile);
 finally
  BackupDlg.Free;
 end;
end;


{calls the dialog - visible}
procedure ShowBackupDlg(pSource,pDestination,pHelp,pCompat: pChar; bOverwritePrompt: boolean);
begin
 {create dialog}
 BackupDlg := TBackupDlg.Create(application);
 ProgressDlg := TProgressDlg.create(application);
 try

  {initialise}
  BackupDlg.CustInitialise(pSource,pDestination,pHelp,pCompat,bOverwritePrompt);

  {show}
  BackupDlg.ShowModal;

 finally
  ProgressDlg.free;
  BackupDlg.Free;
 end;

end;

{calls the dialog - invisible and runs backup automatically}
procedure HideBackupDlg(pSource,pDestination,pHelp,pCompat: pChar; bOverwritePrompt, bCopyNew: boolean);
begin
 {create dialog}
 BackupDlg := TBackupDlg.Create(application);
 ProgressDlg := TProgressDlg.create(application);
 try

  {initialise}
  BackupDlg.FNew := bCopyNew;
  BackupDlg.CustInitialise(pSource,pDestination,pHelp,pCompat,bOverwritePrompt);

  {execute copy proc}
  BackupDlg.SetupFiles;

 finally
  ProgressDlg.free;
  BackupDlg.Free;
 end;

end;


{***Buttons*********************************************************************}

{help}
procedure TBackupDlg.BitBtn1Click(Sender: TObject);
begin
 Application.HelpCommand(HELP_CONTEXT,BackupDlg.HelpContext);
end;

{on double click show file info}
procedure TBackupDlg.FListDblClick(Sender: TObject);
var
 f: ^TFileInfo;
 s: ^string;
begin

 New(s);
 New(f);

 try

  s^ := lblSource.caption;
  if s^[length(s^)] = '\' then
   s^ := s^ + ExtractFileName(Flist.Items[FList.ItemIndex])
  else
   s^ := s^ + '\' + ExtractFileName(Flist.Items[FList.ItemIndex]);
  f^ := GetFileInfo(s^);
  messageDlg(''+ s^ +#13#10+#13#10+
             'Size: '+IntToStr(f^.size)+' bytes  Date:'+
             DateTimeToStr(FileDateToDateTime(f^.date)),
             mtInformation,[mbOK],0);
 finally
  Dispose(s);
  Dispose(f);
 end;

end;

{on ALT + RETURN get info}
procedure TBackupDlg.FListKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if (shift = [ssAlt]) and (key = VK_RETURN) then FListDblClick(sender);
end;


{close}
procedure TBackupDlg.btnCancelClick(Sender: TObject);
begin
 close;
end;

{check-box}
procedure TBackupDlg.chkSelectClick(Sender: TObject);
var
 i: integer;
begin
 {check for select all - if true then select all items in list box}
 screen.cursor := crHourGlass;
 if chkSelect.state = cbChecked then
  begin
   {select all}
   for i:= 0 to (FList.items.count -1) do
    FList.selected[i] := true;
   FList.ItemIndex := 0;
  end;
 screen.cursor := crDefault;


end;

{check state of check-box. Then check if the user has deselected any
 items. If so, and the check-box is checked, then remove check}
procedure TBackupDlg.FListClick(Sender: TObject);
var
 i: integer;
begin
 screen.cursor := crHourGlass;
 if chkSelect.checked = true then
  begin
   for i := 0 to (FList.Items.Count -1) do
    begin
     if FList.selected[i] = false then
      chkSelect.checked := false;
    end;
   FList.ItemIndex := 0;
  end;
 screen.cursor := crDefault;
end;


{copy}
procedure TBackupDlg.btnOKClick(Sender: TObject);
begin
 hide;
 ProgressDlg.show;
  {***}
  SetUpFiles;
  {***}
 ProgressDlg.hide;
 show;

 FCancel := false;
end;

{Select Directory}
procedure TBackupDlg.SpeedButton1Click(Sender: TObject);
var
 sDir: ^string;
begin

 New(sDir);

 try

  {if directory exists, then set that as default in dialog}
  if DirectoryExists(lblDestination.caption) then
   sDir^ := lblDestination.caption
  else
   sDir^ := '';
  if SelectDirectory(sDir^,[sdAllowCreate,sdPerformCreate],iHelp) then
   lblDestination.caption := LowerCase( CheckDir(sDir^) );

  {user could return a blank, in which case use system default dir}
  if lblDestination.caption = '' then
   begin
    GetDir(0,sDir^);
    lblDestination.caption := LowerCase(sDir^);
   end;

 finally
  Dispose(sDir)
 end;


end;


{***Copy procs******************************************************************}


{setup copying}
procedure TBackupDlg.SetUpFiles;
var
 iNum: integer;
 sSrce, sDest: ^string;
 li, liFree, liGauge, liGaugeNew: longint;
 f: File;
 fSrce, fDest: ^TFileInfo;
 i: integer;
 c: char;
begin

 New(sSrce);
 New(sDest);
 New(fSrce);
 New(fDest);

 try

  {initialise}
  iNum := 0;


 {ensure that directories exists - actually, at this stage both labels should be valid}
 if not isDir(lblSource.caption) then
  begin
   exit;
  end;
 if not isDir(lblDestination.caption) then
  begin
   exit;
  end;

 {check that the user is not trying to copy over source files}
 if CompareText(lblSource.Caption,lblDestination.Caption) = 0 then
  begin
   messageDlg('Can not overwrite source files.',mtWarning,[mbOK],0);
   exit;
  end;

 {ensure that there are items in the file-list box}
 if (FList.Items.Count) = 0 then
  begin
   exit;
  end;

 {remove any backslashes from the captions}
 sSrce^ := lblSource.caption;
 if sSrce^[length(lblSource.caption)] = '\' then
  delete(sSrce^,(length(sSrce^)),1);
 lblSource.caption := sSrce^;
 {***}
 sSrce^ := lblDestination.caption;
 if sSrce^[length(lblDestination.caption)] = '\' then
  delete(sSrce^,(length(sSrce^)),1);
 lblDestination.caption := sSrce^;


 {check space on target}
 li := 0;
 liFree := 0;
 liGauge := 0;
 liGaugeNew := 0;
 FList.ItemIndex := 0;
 {increment through file list, adding up file sizes}
 for iNum := 0 to (FList.Items.Count -1) do
  begin
   if FList.Selected[iNum] = true then
    begin
     inc(liGauge); {sum selected items for gauge}
     System.FileMode := fmOpenRead;
     {assign and open files}
     AssignFile(f, lblSource.caption +'\'+ ExtractFileName(FList.Items.Strings[iNum]));
     {$I-}
     Reset(f,1);
     {$I+}
     if IOResult = 0 then
      begin
       {increment var holding the total size of source files}
       li := li + FileSize(f);
       {if target file exists, find its size}
       if FileExists(lblDestination.caption +'\' + ExtractFileName(FList.Items.Strings[iNum])) then
        begin
         fDest^ := GetFileInfo(lblDestination.caption +'\' + ExtractFileName(FList.Items.Strings[iNum]));
         liFree := liFree + fDest^.size;

         {With reference to the FNew bool, compare existing file date to source file
          date. This is performed, so that we can amend the maxValue property of the gauge,
          so it increments only on newer files}
         fSrce^ := GetFileInfo(lblSource.caption +'\'+ ExtractFileName(FList.Items.Strings[iNum]));
         if fDest^.date < fSrce^.date then inc(liGaugeNew);

        end;
       CloseFile(f);
      end;
     System.FileMode := fmOpenReadWrite;
    end;
  end;
 {get drive letter}
 c := lblDestination.caption[1];
 if c in ['a'..'z'] then Dec(c,($20));
 i :=  ord (c) -$40;
 {find target disk size}
 if li > DiskSize(i) then
  begin
   messageDlg('Insufficient space on target for all of the selected files',mtWarning,[mbOK],0);
   exit;
  end;
 {find target free - we add, to free space, the size of the existing files since the user
  is probably going to overwrite them}
 liFree := liFree + DiskFree(i);
 if li > liFree then
  begin
   messageDlg('Insufficient free space on target for selected files',mtWarning,[mbOK],0);
   exit;
  end;


 {now, safe to continue with copy...}
 if isWindowVisible(progressDlg.handle) then
  ProgressDlg.Gauge1.MaxValue := liGauge;

 {init for loop}
 for iNum := 0 to (FList.Items.Count -1) do
  begin
   if FCancel = true then break;
   if FList.Selected[iNum] = true then
    begin

     {get source file name}
     sSrce^ := lblSource.caption +'\'+ ExtractFileName(FList.Items.Strings[iNum]);

     {get destination file name}
     sDest^ := lblDestination.caption + '\' + (ExtractFileName(FList.Items.Strings[iNum]));

   {check to see if file exists}
   if not FNew then
    if not OkToAll then
    begin

     {update labels}
     progressDlg.lblSource.caption := sSrce^;
     progressDlg.lblDestination.caption := sDest^;
     application.processMessages;

     if FileExists(sDest^) then
      begin

       {since file exists, we must get info of both source and target files}
       fSrce^ := GetFileInfo(sSrce^);
       fDest^ := GetFileInfo(sDest^);

       case messageDlg('Overwrite '+sDest^+ #13#10 +
                       'Size: '+IntToStr(fDest^.size)+' bytes  Date:'
                       +dateTimeToStr(FileDateToDateTime(fDest^.date))+ #13#10 + #13#10 +
                       'with: '+sSrce^+ #13#10 +
                       'Size: '+IntToStr(fSrce^.size)+' bytes  Date:'+
                       DateTimeToStr(FileDateToDateTime(fSrce^.date))+ #13#10 + #13#10,
                       mtConfirmation,[mbYes,mbAll,mbNo],0) of

        idYes:
         custCopyFiles(sSrce^,sDest^);

        (idNo+1): {mrAll}
         begin
          OkToAll := true;
          custCopyFiles(sSrce^,sDest^);
         end;

        idNo:
        {do nothing}

       end;
      end
     else
     {file doesn't already exist - so copy}
     custCopyFiles(sSrce^,sDest^);
    end
   else
    {file does already exist, but overwrite is true}
    custCopyFiles(sSrce^,sDest^)
  else
   begin
    {only copy the file if the source is newer than the destination}
    progressDlg.Gauge1.MaxValue := liGaugeNew;
    fSrce^ := GetFileInfo(sSrce^);
    fDest^ := GetFileInfo(sDest^);
    if fDest^.Date < fSrce^.Date then
     begin
      {update labels}
      progressDlg.lblSource.caption := sSrce^;
      progressDlg.lblDestination.caption := sDest^;
      application.processMessages;
      custCopyFiles(sSrce^,sDest^);
     end
    else
     begin
      {update labels}
      progressDlg.lblSource.caption := sSrce^;
      progressDlg.lblDestination.caption := 'skipping...';
      application.processMessages;
     end;
   end;

   {update gauge}
   if isWindowVisible(progressDlg.handle) then
    ProgressDlg.Gauge1.AddProgress(1);
   Application.ProcessMessages;

  end;
 end;

 {cleanup}
 if isWindowVisible(progressDlg.handle) then
  ProgressDlg.Gauge1.Progress := 0;
 if FOkToAll then
  okToAll := false
 else
  okToAll := true;

 finally
  Dispose(sSrce);
  Dispose(sDest);
  Dispose(fDest);
  Dispose(fSrce);
 end;

 {add backslash to labels of two characters}
 if length(lblSource.caption) = 2 then lblSource.caption := lblSource.caption + '\';
 if length(lblDestination.caption) = 2 then lblDestination.caption := lblDestination.caption + '\';

end;


{copy routine}
procedure TBackupDlg.CustCopyFiles(sSrce,sDest: string);
type
  iobufPtr = ^iobufr; {allowate a LARGE buffer to speed up copies}
  iobufr   = array[0..32767] of char; {MAX=65535}
var
 fSrce, fDest: file;
 wRead, wWritten: word;
 p: iobufPtr;
 FDate: Longint;
begin


  {initialise}
  wRead := 0;
  wWritten := 0;

  {Set file access mode to readonly in case file is in use.}
  System.FileMode := fmOpenRead;
   {assign and open files}
   AssignFile(fSrce,sSrce);
   {$I-}
   Reset(fSrce,1);
   {$I+}
  {Set file access mode back to normal default for other processes}
  System.Filemode := fmOpenReadWrite;
  if IOResult <> 0  then
   begin
    messageDlg('Could not open: '+sSrce,mtWarning,[mbOK],0);
    exit;
   end;
  {Store file Date & Time for later use}
  FDate := FileGetDate(TFileRec(fSrce).Handle);

  {before creating new file, check that there is sufficient free space}
  if isSpace(sDest) > FileSize(fSrce) then
   begin
    {Set file access mode to allow Exclusive Creation }
    System.Filemode := fmOpenWrite and fmShareExclusive;
    AssignFile(fDest,sDest);
    {$I-}
    Rewrite(fDest, 1);
    {$I+}
    {Set file access mode back to normal default for other processes}
    System.Filemode := fmOpenReadWrite;

    if IOResult <> 0  then
     begin
      {Close the Source file we already have open.}
      System.CloseFile(fSrce);
      messageDlg('Could not create: '+sDest,mtWarning,[mbOK],0);
      exit;
     end;
   end
  else
   begin
    {this message should only ever be seen if the CopyIndivFile call is used to
     open the DLL}
    if messageDlg('There is insufficient space on the target drive'+#13#10+
                  'for: '+ sSrce +#13#10+#13#10+
                  'Do you wish to cancel the copy process?',mtConfirmation,[mbYes,mbNo],0)
     = mrYes then FCancel := true;
    exit;
   end;


  {allocate a file iobuffer on Heap to avoid stack overflow error}
  new(p);

  {copy loop}
   repeat
    BlockRead(fSrce, p^, SizeOf(p^), wRead);
    BlockWrite(fDest, p^, wRead, wWritten);
   until (wRead = 0) or (wWritten <> wRead);

   {release heap space for iobuffer }
   dispose(p);

   {restore Source file date & time to Destination file }
   Reset(fDest,1);
   FileSetDate(TFileRec(fDest).Handle,FDate);
   System.CloseFile(fDest);

   {clean up}
   System.CloseFile(fSrce);

end;


{expansion routine - uses LZExpand unit to expand the files}
procedure TbackupDlg.CustExpandFile(pSrce, pDest: pChar);
var
 iDest, iSrce: integer;
 tStruct: TOFStruct;
 p: pChar;
begin

 p := StrAlloc(256);

 try

  {change file extension}
  StrPCopy(p, ChangeExt( StrPAS(pDest) ) );

 {open source}
 iSrce := _lopen(pSrce,OF_SHARE_COMPAT);
 if iSrce = 0 then
  begin
   messageDlg('Could not create: '+StrPAS(pSrce),mtWarning,[mbOK],0);
   exit;
  end;

 {open target}
 iDest := LZOpenFile(p,tStruct,OF_CREATE);
 if iDest = 0 then
  begin
   messageDlg('Could not create: '+StrPAS(p),mtWarning,[mbOK],0);
   exit;
  end;

 {expand}
 if LZCopy(iSrce,iDest) < 0 then
  begin
   messageDlg('Could not expand: '+StrPAS(pSrce),mtWarning,[mbOK],0);
   exit;
  end;

 {close}
 if _lclose(iSrce) <> 0 then
  begin
   messageDlg('Could not close: '+StrPAS(pSrce),mtWarning,[mbOK],0);
   exit;
  end;

 {close}
 if _lclose(iDest) <> 0 then
  begin
   messageDlg('Could not close: '+StrPAS(p),mtWarning,[mbOK],0);
   exit;
  end;

 finally
  StrDispose(p);
 end;

end;


{***form's preferences**********************************************************}

{on close}
procedure TBackupDlg.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  {reset system}
  chDir(FDir);
  SetErrorMode(iErrorMode);
end;

{new}
procedure TBackupDlg.chkNewClick(Sender: TObject);
begin
 FNew := chkNew.checked;
end;


{}
end.