{$I-,X+,F+,O+}
unit DiskPrim;

interface

uses Dos, Objects, Views, DiskBase, Tags;

type
  PSearchRec = ^SearchRec;

const
  dsOverwrite = cmYes;
  dsDelete = cmYes;
  dsAll = cmOk;
  dsAppend = cmAppend;
  dsNew = cmNew;
  dsSkip = cmNo;
  dsSkipAll = cmDefault;
  dsCancel = cmCancel;
  dsReadError = cmError;

  DirFilter: String[12] = '*.*';
  NewMask: String[12] = '*.*';

  LastDiskName: FNameStr = '';
  LastRenMovName: FNameStr = '';
  CheckRenMovName: Boolean = False;

var
  CopyStatus, DeleteStatus: Byte;
  Skipped, CopyOk, CopyLeft, TryAll: Boolean;
  FilesTotal, FilesCopied: Longint;
  BytesTotal, BytesCopied: Real;

function FoundInCRCList(const Name: FNameStr; ACRCList: PTagList): Boolean;
procedure FSetAttrPrim(const AName: FNameStr; Attr: Word; Time: Longint);
procedure SetAttrDirFiles(const ADir: FNameStr;
  Attr: Word; Time: Longint; ACRCList: PTagList);
procedure DirSetAttr(const ADir: FNameStr;
  Attr: Word; Time: Longint; ACRCList: PTagList);
procedure FDeletePrim(const AName: FNameStr);
procedure DirRemovePrim(const ADir: FNameStr);
procedure ClearDirFiles(const ADir, AMask: FNameStr;
  ACRCList: PTagList);
procedure ClearDirs(const ADir: FNameStr;
  ACRCList: PTagList; All: Boolean);
procedure DirDeletePrim(const ADir: FNameStr;
  ACRCList: PTagList; All: Boolean);
procedure DeleteFilesByMask(const ADir, AMask: FNameStr;
  ACRCList: PTagList);
function MkDirPrim(const ADir: FNameStr;
  SearchRecPtr: PSearchRec): FNameStr;
function FCopyPrim(const FromName, ToName: FNameStr): FNameStr;
procedure ResetTotals;
procedure DirCountPrim(const ADir, AFilter: FNameStr;
  ACRCList: PTagList);
procedure CopyDirFiles(const FromDir, ToDir, ADir,
  AFilter, AMask: FNameStr; ACRCList: PTagList);
procedure CopyDirs(const FromDir, ToDir, ADir,
  AFilter, AMask: FNameStr; ACRCList: PTagList);
procedure DirCopyPrim(const FromDir, ToDir,
  AFilter, AMask: FNameStr; ACRCList: PTagList);
procedure DirCopyFiles(const FromDir, ToDir,
  AFilter, AMask: FNameStr; ACRCList: PTagList);
procedure CopyFilesByMask(const FromDir, ToDir,
  AFilter, AMask: FNameStr; ACRCList: PTagList);
function FRenMovPrim(const FromName, ToName: FNameStr): FNameStr;
procedure RenMovDirFiles(const FromDir, ToDir, ADir,
  AFilter, AMask: FNameStr; ACRCList: PTagList);
procedure RenMovDirs(const FromDir, ToDir, ADir,
  AFilter, AMask: FNameStr; ACRCList: PTagList);
procedure DirRenameFiles(const ADir,
  AFilter, AMask: FNameStr; ACRCList: PTagList);
procedure RenameFilesByMask(const ADir,
  AFilter, AMask: FNameStr; ACRCList: PTagList);
procedure DirMoveFiles(const FromDir, ToDir,
  AFilter, AMask: FNameStr; ACRCList: PTagList);
procedure MoveFilesByMask(const FromDir, ToDir,
  AFilter, AMask: FNameStr; ACRCList: PTagList);
procedure DirRenMovPrim(const FromDir, ToDir,
  AFilter, AMask: FNameStr; ACRCList: PTagList;
  DoRemove: Boolean);
function GetDirInfo(const ADir: FNameStr;
  var NumFiles, FilesSize, NumBytes,
  NumTagged, TaggedSize, TaggedBytes: Longint;
  CalcTagged, AllowTree, KeyAbort: Boolean): Boolean;

implementation

uses CNCrt, Memory, Drivers, Dialogs, MsgBox, App, Gauges, Spooler, DirPrim,
  PanelRec, BBSStuff, DirTree, Trees, FMAbort, UnixMask, HeapUMB, Keyboard,
  Disks, LFN, DosTools, Timer, TPString, Commands, Consts, Defaults;

var
  MoveCopy: Boolean;

function AbortDiskAction: Boolean;
begin
  AbortDiskAction := ((KbdStatus = 1) or (KbdHead <> KbdTail)) and
    FMAbortAction;
end;

procedure DrawStatus(const AName: FNameStr);
begin
  LogEvent := lcDiskRead;
  DrawStatusLine(Concat('Scanning the directory ',
    TrimmedName(ClearedSlash(AName), 45)));
end;

procedure DrawSkipStatus(const AName: FNameStr);
begin
  DrawStatusLine(Concat('Skipping ', TrimmedName(AName, 58), '.'));
end;

procedure UpdateStatistics;
begin
  if CopyStatWindow <> nil then CopyStatWindow^.UpdateSubViews;
end;

procedure SkipFile(const AName: FNameStr; Size, Copied: Longint);
begin
  DrawSkipStatus(AName);
  if BytesTotal >= Size then BytesTotal := BytesTotal - Size
  else BytesTotal := 0;
  if BytesCopied >= Copied then BytesCopied := BytesCopied - Copied
  else BytesCopied := 0;
  if FilesTotal > 0 then Dec(FilesTotal);
  UpdateStatistics;
end;

procedure AddNameAndSlash(const ADir, AName: FNameStr; DoAddSlash: Boolean;
  var S: FNameStr);
begin
  S := ADir + AName;
  if DoAddSlash then S := S + '\';
end;

function ShortFileName(const Name: String): String;
var
  S: String;
begin
  lGetShortFileName(Name, S);
  ShortFileName := S;
end;

function DirWithin(const FromDir, ToDir: FNameStr;
  var EndSlash: Boolean): Boolean;
var
  FromName, ToName: FNameStr;
begin
  EndSlash := (Length(ToDir) > Length(FromDir)) and
    (ToDir[Length(FromDir) + 1] = '\');
  if DeviceDest(ToDir) <> '' then
    DirWithin := False
  else if UCPos(AddedSlash(FromDir), AddedSlash(ToDir)) <> 0 then
    DirWithin := True
  else
  begin
    lTrueName(FromDir, FromName);
    lTrueName(ToDir, ToName);
    EndSlash := (Length(ToName) > Length(FromName)) and
      (ToName[Length(FromName) + 1] = '\');
    DirWithin := UCPos(AddedSlash(FromName), AddedSlash(ToName)) <> 0;
  end;
end;

function SameDrives(const Name1, Name2: FNameStr): Boolean;
var
  B, C: Byte;
begin
  if TPString.Upcase(Name1[1]) <> TPString.Upcase(Name2[1]) then
    SameDrives := False
  else if Name1[1] = '\' then
  begin
    C := 0;
    B := 1;
    while (B < Length(Name1)) and (B < Length(Name2)) do
    begin
      if TPString.Upcase(Name1[B]) <> TPString.Upcase(Name2[B]) then Break;
      if Name1[B] = '\' then Inc(C);
      if C = 4 then
      begin
	SameDrives := True;
	Exit;
      end;
      Inc(B);
    end;
    SameDrives := False;
  end
  else SameDrives := True;
end;

procedure SendChangeMsg(const Name: FNameStr);
var
  S1, S2: FNameStr;
begin
  if FMAutoRereadOptions <> faModifiedOnly then Exit;
  S1 := Name;
  while (S1 <> '') and (S1[Length(S1)] <> '\') do Dec(S1[0]);
  if S1 <> '' then Dec(S1[0]);
  if CheckRenMovName then S2 := LastRenMovName
  else S2 := LastDiskName;
  while (S2 <> '') and (S2[Length(S2)] <> '\') do Dec(S2[0]);
  if S2 <> '' then Dec(S2[0]);
  if CompUCString(S1, S2) = Equal then Exit;
  Message(Desktop, evBroadcast, cmDiskChanged, @Name);
  if CheckRenMovName then LastRenMovName := Name
  else LastDiskName := Name;
end;

function FoundInCRCList(const Name: FNameStr; ACRCList: PTagList): Boolean;
begin
  if ACRCList = nil then FoundInCRCList := True
  else FoundInCRCList := ACRCList^.NameFound(Name);
end;

function CopyRenameFilterPassed(var SR: SearchRec;
  const ALongName: FNameStr): Boolean;
begin
  if CopyRenameFilter.Text = nil then CopyRenameFilterPassed := True
  else
  begin
    if CopyRenameFilter.Unix and (CopyRenameStates = nil) then
    begin
{      GetMem(CopyRenameStates, SizeOf(TState));}
      GetMemUMB(CopyRenameStates, SizeOf(TState));
      MakeAutomaton(CopyRenameFilter.Text^, PState(CopyRenameStates)^);
    end;
    CopyRenameFilterPassed := AdvancedFilterPassed(
      @CopyRenameFilter, CopyRenameStates, SR, ALongName);
  end;
end;

function OptUpcaseDir(const FromDir, ToDir: FNameStr): FNameStr;
begin
  if CompUCString(JustFileName(FromDir), JustFileName(ToDir)) = Equal then
    OptUpcaseDir := StUpcase(AddedSlash(JustPathName(ToDir))) +
      JustFileName(ToDir)
  else OptUpcaseDir := StUpcase(ToDir);
end;

procedure Find1st(const AName: FNameStr;
  var Attr: Word; var Size, Time: Longint);
var
  SR: ^lSearchRec;
begin
  GetMem(SR, SizeOf(lSearchRec));
  lFindFirst(AName, AnyFile and not (VolumeID + Directory), SR^);
  lFindClose(SR^);
  Attr := SR^.SR.Attr;
  Size := SR^.SR.Size;
  Time := SR^.SR.Time;
  FreeMem(SR, SizeOf(lSearchRec));
end;

procedure FSetAttrPrim(const AName: FNameStr; Attr: Word; Time: Longint);
var
  T: Longint;
  F: ^lFile;
begin
  LogEvent := lcDiskWrite;
  DrawStatusLine('Setting new attributes for ' +
    TrimmedName(AName, 43) + '.');
  GetMem(F, SizeOf(lFile));
  lAssignFile(F^, AName);
  if Time <> -1 then
  begin
    lResetFile(F^, 1);
    if IOResult = 0 then
    begin
      if (LongRec(Time).Lo = $FFFF) or (LongRec(Time).Hi = $FFFF) then
      begin
	GetFTime(F^.F, T);
	if LongRec(Time).Lo = $FFFF then LongRec(Time).Lo := LongRec(T).Lo;
	if LongRec(Time).Hi = $FFFF then LongRec(Time).Hi := LongRec(T).Hi;
      end;
      SetFTime(F^.F, Time);
      Close(F^.F);
    end;
  end;
  lSetFAttr(F^, Attr and not Directory);
  FreeMem(F, SizeOf(lFile));
  SendChangeMsg(AName);
  if DosError <> 0 then
  begin
    CopyStatus := dsCancel;
    MessageBox(^C'Could not set the attributes for'#13^C +
      TrimmedName(AName, 33) + '.', nil, mfError + mfOkButton);
  end;
end;

procedure SetAttrDirFiles(const ADir: FNameStr;
  Attr: Word; Time: Longint; ACRCList: PTagList);
var
  SR: ^lSearchRec;
  S: PString;
begin
  CancelSysErrors := False;
  GetMem(S, SizeOf(String));
  GetMem(SR, SizeOf(lSearchRec));
  lFindFirst(ADir + '*.*', AnyFile and not VolumeID, SR^);
  if CancelSysErrors then CopyStatus := dsCancel;
  while (DosError = 0) and (CopyStatus <> dsCancel) do
  begin
    if SR^.SR.Attr and (VolumeID + Directory) = 0 then
    begin
      if SR^.FullName <> '' then
	AddNameAndSlash(ADir, SR^.FullName, False, S^)
      else AddNameAndSlash(ADir, SR^.SR.Name, False, S^);
      if FoundInCRCList(S^, ACRCList) then
	FSetAttrPrim(S^, Attr, Time);
    end;
    if (KbdStatus = 1) and FMAbortAction then CopyStatus := dsCancel
    else lFindNext(SR^);
  end;
  lFindClose(SR^);
  FreeMem(SR, SizeOf(lSearchRec));
  FreeMem(S, SizeOf(String));
end;

procedure DirSetAttr(const ADir: FNameStr;
  Attr: Word; Time: Longint; ACRCList: PTagList);
var
  S: PString;

procedure DoSetAttr(ADir: PString);
var
  SR: ^lSearchRec;
  Dir: PString;
begin
  if StackOverflow then
  begin
    CopyStatus := dsCancel;
    Exit;
  end;
  Dir := NewStr(ADir^);
  GetMem(SR, SizeOf(lSearchRec));
  SetAttrDirFiles(Dir^, Attr, Time, ACRCList);
  if CopyStatus = dsCancel then Exit;
  AddNameAndSlash(Dir^, '*.*', False, S^);
  CancelSysErrors := False;
  lFindFirst(S^, $17, SR^);
  if CancelSysErrors then CopyStatus := dsCancel;
  while (DosError = 0) and (CopyStatus <> dsCancel) do
  begin
    if (SR^.SR.Attr and Directory <> 0) and
       (SR^.SR.Name[1] <> '.') then
    begin
      if SR^.FullName <> '' then
	AddNameAndSlash(Dir^, SR^.FullName, True, S^)
      else AddNameAndSlash(Dir^, SR^.SR.Name, True, S^);
      DoSetAttr(S);
    end;
    lFindNext(SR^);
  end;
  lFindClose(SR^);
  FreeMem(SR, SizeOf(lSearchRec));
  DisposeStr(Dir);
end;

begin
  GetMem(S, SizeOf(String));
  DoSetAttr(@ADir);
  FreeMem(S, SizeOf(String));
end;

procedure FDeletePrim(const AName: FNameStr);
var
  Attr: Word;
  ShortName: PString;
  F: ^lFile;
label
  Quit;
begin
  GetMem(ShortName, SizeOf(String));
  GetMem(F, SizeOf(lFile));
  if DeleteStatus = dsSkip then DeleteStatus := dsDelete;
  lAssignFile(F^, AName);
  lGetFAttr(F^, Attr);
  if DosError <> 0 then
  begin
    if MessageBox(^C'Could not find the file'#13^C +
      TrimmedName(AName, 33) + '.'#13^C'Continue ?',
      nil, mfError + mfOkCancel) <> cmOk then DeleteStatus := dsCancel;
    Goto Quit;
  end;
  if FMOptions and foCopyDescriptions <> 0 then
    lGetShortFileName(AName, ShortName^);
  if Attr and (ReadOnly + Hidden + SysFile) <> 0 then
  begin
    if DeleteStatus <> dsAll then
    begin
      if DeleteStatus <> dsSkipAll then
	DeleteStatus := DelSkipDialog(AName);
      if DeleteStatus in [dsSkip, dsSkipAll, dsCancel] then
      begin
	DrawSkipStatus(AName);
	Goto Quit;
      end;
    end;
    lSetFAttr(F^, Archive);
    InOutRes := 0;
  end;
  LogEvent := lcDiskWrite;
  DrawStatusLine('Deleting the file ' + TrimmedName(AName, 45) + '.');
  lEraseFile(F^);
  SendChangeMsg(AName);
  if IOResult <> 0 then
    if MessageBox(^C'Could not delete the file'#13^C +
      TrimmedName(AName, 33) + '.'#13^C'Continue ?',
      nil, mfError + mfOkCancel) <> cmOk then DeleteStatus := dsCancel else
  else if FMOptions and foCopyDescriptions <> 0 then
    DeleteDescription(AName, ShortName^);
  if AbortDiskAction then DeleteStatus := dsCancel;
  GiveTicks;
  if Clock <> nil then Clock^.Update;
  if TheSpooler <> nil then TheSpooler^.ProcessItems;
Quit:
  FreeMem(F, SizeOf(lFile));
  FreeMem(ShortName, SizeOf(String));
end;

procedure DirRemovePrim(const ADir: FNameStr);
var
  S: PString;
begin
  if ADir[0] < #4 then Exit;
  GetMem(S, SizeOf(String));
  GetCurDir(0, S^);
  if CompUCString(S^, ADir) = Equal then
  begin
    FreeMem(S, SizeOf(String));
    if MessageBox(^C'Can''t delete the current directory'#13^C +
      TrimmedName(ADir, 33) + '.'#13^C'Continue ?',
      nil, mfError + mfOkCancel) <> cmOk then DeleteStatus := dsCancel;
    Exit;
  end;
  FreeMem(S, SizeOf(String));
  LogEvent := lcDiskWrite;
  DrawStatusLine('Deleting the directory ' + TrimmedName(ADir, 45) + '.');
  lRmDir(ADir);
  if IOResult = 0 then
  begin
    SendChangeMsg(ADir);
    SendChangeMsg(ADir + '\1');
  end
  else if MessageBox(^C'Could not delete the directory'#13^C +
    TrimmedName(ADir, 33) + '.'#13^C'Continue ?',
    nil, mfError + mfOkCancel) <> cmOk then DeleteStatus := dsCancel;
  GiveTicks;
  if Clock <> nil then Clock^.Update;
  if TheSpooler <> nil then TheSpooler^.ProcessItems;
end;

procedure ClearDirFiles(const ADir, AMask: FNameStr;
  ACRCList: PTagList);
var
  SR: ^lSearchRec;
  S: PString;
begin
  CancelSysErrors := False;
  GetMem(S, SizeOf(String));
  GetMem(SR, SizeOf(lSearchRec));
  lFindFirst(ADir + AMask, AnyFile and not VolumeID, SR^);
  if CancelSysErrors then DeleteStatus := dsCancel;
  while (DosError = 0) and (DeleteStatus <> dsCancel) do
  begin
    if SR^.SR.Attr and (VolumeID + Directory) = 0 then
    begin
      if SR^.FullName <> '' then
	AddNameAndSlash(ADir, SR^.FullName, False, S^)
      else AddNameAndSlash(ADir, SR^.SR.Name, False, S^);
      if FoundInCRCList(S^, ACRCList) then FDeletePrim(S^);
    end;
    lFindNext(SR^);
  end;
  lFindClose(SR^);
  FreeMem(SR, SizeOf(lSearchRec));
  FreeMem(S, SizeOf(String));
end;

procedure ClearDirs(const ADir: FNameStr;
  ACRCList: PTagList; All: Boolean);
var
  SaveOpt: Longint;
  S: PString;

procedure DoClearDirs(ADir: PString);
var
  SR: ^lSearchRec;
  Dir: PString;
begin
  if StackOverflow then
  begin
    DeleteStatus := dsCancel;
    Exit;
  end;
  Dir := NewStr(ADir^);
  GetMem(SR, SizeOf(lSearchRec));
  if All then ClearDirFiles(Dir^, '*.*', ACRCList);
  if DeleteStatus = dsCancel then Exit;
  AddNameAndSlash(Dir^, '*.*', False, S^);
  CancelSysErrors := False;
  lFindFirst(S^, $17, SR^);
  if CancelSysErrors then DeleteStatus := dsCancel;
  while (DosError = 0) and (DeleteStatus <> dsCancel) do
  begin
    if (SR^.SR.Attr and Directory <> 0) and (SR^.SR.Name[1] <> '.') then
    begin
      if SR^.FullName <> '' then
	AddNameAndSlash(Dir^, SR^.FullName, True, S^)
      else AddNameAndSlash(Dir^, SR^.SR.Name, True, S^);
      DoClearDirs(S);
    end;
    if (DeleteStatus <> dsCancel) and
       (SR^.SR.Attr and Directory <> 0) and
       (SR^.SR.Name[1] <> '.') then
    begin
      if SR^.FullName <> '' then
	AddNameAndSlash(Dir^, SR^.FullName, False, S^)
      else AddNameAndSlash(Dir^, SR^.SR.Name, False, S^);
      DirRemovePrim(S^);
    end;
    lFindNext(SR^);
  end;
  lFindClose(SR^);
  FreeMem(SR, SizeOf(lSearchRec));
  DisposeStr(Dir);
end;

begin
  GetMem(S, SizeOf(String));
  SaveOpt := FMOptions;
  FMOptions := FMOptions and not foCopyDescriptions;
  DoClearDirs(@ADir);
  FMOptions := SaveOpt;
  FreeMem(S, SizeOf(String));
end;

procedure DirDeletePrim(const ADir: FNameStr;
  ACRCList: PTagList; All: Boolean);
var
  C: Word;
  R: TRect;
  SR: ^lSearchRec;
begin
  if (DeleteStatus <> dsAll) and (FMOptions and foDirDelPrompt <> 0) and
    not ((Length(ADir) <= 3) and (ADir[2] = ':')) then
  begin
    CancelSysErrors := False;
    GetMem(SR, SizeOf(lSearchRec));
    lFindFirst(AddedSlash(ADir) + '*.*', AnyFile and not VolumeID, SR^);
    if CancelSysErrors then DeleteStatus := dsCancel;
    while (DosError = 0) and (SR^.SR.Name[1] = '.') do lFindNext(SR^);
    lFindClose(SR^);
    FreeMem(SR, SizeOf(lSearchRec));
    if DosError = 0 then
    begin
      R.Assign(19, ScreenHeight div 2 - 5, 61, ScreenHeight div 2 + 4);
      C := MessageBoxRect(R, ^C'The directory ' + TrimmedName(ADir, 22) +
	#13^C'is not empty.'#13^C'Do you still wish to delete it ?',
	nil, mfConfirmation + mfYesAllNoCancel);
      if C = cmCancel then DeleteStatus := dsCancel
      else if C = cmOk then
      begin
	C := cmYes;
	DeleteStatus := dsAll;
      end;
      if C <> cmYes then Exit;
    end;
  end;
  ClearDirs(AddedSlash(ADir), ACRCList, All);
  if DeleteStatus <> dsCancel then
  begin
    DirRemovePrim(ADir);
    if not DirPresent(ADir) then DelDirFromTree(ADir);
  end;
end;

procedure DeleteFilesByMask(const ADir, AMask: FNameStr;
  ACRCList: PTagList);
var
  S: PString;

procedure DoDeleteByMask(ADir: PString; const AMask: FNameStr);
var
  SR: ^lSearchRec;
  Dir: PString;
label
  Quit;
begin
  if StackOverflow then
  begin
    DeleteStatus := dsCancel;
    Exit;
  end;
  Dir := NewStr(ADir^);
  GetMem(SR, SizeOf(lSearchRec));
  DrawStatus(Dir^);
  GiveTicks;
  if Clock <> nil then Clock^.Update;
  if TheSpooler <> nil then TheSpooler^.ProcessItems;
  ClearDirFiles(Dir^, AMask, ACRCList);
  if DeleteStatus = dsCancel then Exit;
  AddNameAndSlash(Dir^, '*.*', False, S^);
  CancelSysErrors := False;
  lFindFirst(S^, $17, SR^);
  if CancelSysErrors then DeleteStatus := dsCancel;
  while (DosError = 0) and (DeleteStatus <> dsCancel) do
  begin
    if AbortDiskAction then
    begin
      DeleteStatus := dsCancel;
      Goto Quit;
    end;
    if (SR^.SR.Attr and Directory <> 0) and (SR^.SR.Name[1] <> '.') then
    begin
      if SR^.FullName <> '' then
	AddNameAndSlash(Dir^, SR^.FullName, True, S^)
      else AddNameAndSlash(Dir^, SR^.SR.Name, True, S^);
      DoDeleteByMask(S, AMask);
    end;
    lFindNext(SR^);
  end;
Quit:
  lFindClose(SR^);
  FreeMem(SR, SizeOf(lSearchRec));
  DisposeStr(Dir);
end;

begin
  GetMem(S, SizeOf(String));
  DoDeleteByMask(@ADir, AMask);
  FreeMem(S, SizeOf(String));
end;

function MkDirPrim(const ADir: FNameStr;
  SearchRecPtr: PSearchRec): FNameStr;
var
  P: Byte;
  Exists, Created: Boolean;
  S: PString;
  F: ^lFile;
label
  Scan;
begin
  MkDirPrim := '';
  if DeviceDest(ADir) <> '' then Exit;
  GetMem(S, SizeOf(String));
  P := 4;
  Created := False;
  repeat
Scan:
    while (P <= Length(ADir)) and (ADir[P] <> '\') do Inc(P);
    if (P < Length(ADir)) and (ADir[P + 1] = '\') then
    begin
      while (P <= Length(ADir)) and (ADir[P] = '\') do Inc(P);
      Goto Scan;
    end;
    S^ := Copy(ADir, 1, P - 1);
    if FMOptions and foForceUpperDirs <> 0 then UpcaseSt(S^);
    while (P <= Length(ADir)) and (ADir[P] = '\') do Inc(P);
    CancelSysErrors := False;
    Exists := DirPresent(S^);
    if CancelSysErrors then
    begin
      CopyStatus := dsCancel;
      Break;
    end;
    if not Exists then
    begin
      LogEvent := lcDiskWrite;
      DrawStatusLine('Creating the directory ' +
	TrimmedName(S^, 45) + '.');
      lMkDir(S^);
      if IOResult <> 0 then
      begin
	if MessageBox(^C'Could not create the directory'#13^C +
	  TrimmedName(S^, 33) + '.'#13^C'Continue ?', nil,
	  mfError + mfOkCancel) = cmCancel then CopyStatus := dsCancel;
	Break;
      end;
      SendChangeMsg(S^);
      Created := True;
    end;
  until P > Length(ADir);
  if (CopyStatus <> dsCancel) and (SearchRecPtr <> nil) and Created then
  begin
    GetMem(F, SizeOf(lFile));
    lAssignFile(F^, S^);
    lSetFAttr(F^, SearchRecPtr^.Attr and not Directory);
    FreeMem(F, SizeOf(lFile));
  end;
  FreeMem(S, SizeOf(String));
  if Created then AddDirToTree(ShortFileName(ADir), ADir);
end;

function FCopyPrim(const FromName, ToName: FNameStr): FNameStr;
var
  ToSpecial, ShowBar, NewDest, NewName,
  Flushed, SpaceChecked, Appending, ToNul: Boolean;
  FromTrimLen, ToTrimLen, B: Byte;
  BufSize, BufPos, FromAttr, ToAttr, NumRead, NumWritten, C: Word;
  Buffer: PByteArray;
  FTime, FSize, TTime, TSize,
  L, BytesWritten, BytesLeft, CurCopied: Longint;
  CurToName: FNameStr;
  SS: String;
  FromF, ToF: lFile;

procedure GetBarCount;
begin
  L := BytesLeft div BufSize;
  if (L = 0) or (BytesLeft mod BufSize <> 0) then Inc(L);
  L := L shl 1;
end;

procedure AllocateBuffer;
var
  Diff: Boolean;
begin
  Diff := False;
  repeat
    Buffer := MemAlloc(BufSize);
    if Buffer <> nil then Break;
    BufSize := BufSize shr 1;
    if BufSize < $400 then Exit;
    Diff := True;
  until False;
  if Heap <> nil then Heap^.Update;
  if not Diff then Exit;
  GetBarCount;
  Message(CopyBarWindow, evBroadcast, cmBarVolume, Pointer(L));
end;

procedure DoneBuffer;
begin
  FreeMem(Buffer, BufSize);
end;

procedure ShowBarWindow;
var
  W: Integer;
begin
  if FileCopyOptions and fsDisableCopyBar = 0 then
  begin
    GetBarCount;
    W := Length(CurToName) - Length(SS);
    if W < 32 - Length(SS) then W := 32 - Length(SS)
    else if W > ScreenWidth - 6 - Length(SS) then
      W := ScreenWidth - 6 - Length(SS);
    OpenCopyBarWindow(Concat(TrimmedName(FromName, W), SS),
      CurToName, L, MoveCopy, CopyLeft);
  end;
  if FileCopyOptions and fsDisableCopyStat = 0 then
    OpenCopyStatWindow(CopyLeft);
  if not RollerInUse then InitRoller;
  RollerBack := CopyLeft;
end;

function TryToCopy: Word;
begin
  TryToCopy := MessageBox(
    ^C'There is not enough free space'#13^C +
    'on drive ' + CurToName[1] + ': to copy "' +
    TrimmedName(FromName, 12) +
    '".'#13^C'Copy and continue on new disk ?',
    nil, mfWarning + mfYesAllNoCancel);
end;

function GetNewToName(TheRest: Boolean): Boolean;
var
  C: Word;
  D: PDialog;
  R: TRect;
  RS, BS, FN: FNameStr;
begin
  if TheRest then
  begin
    RS := 'Copy the rest of ';
    FormatStr(BS, ' (%d bytes) ', BytesLeft);
    if BytesLeft = 1 then System.Delete(BS, Length(BS) - 2, 1);
  end
  else
  begin
    RS := 'Copy ';
    BS := ' ';
  end;
  R.Assign(0, 0, 58, 8);
  D := InitCopyDialog(R, Concat(
    RS, '"', TrimmedName(FromName, 45 - Length(RS) - Length(BS)),
    '"', BS, 'to'), False, False);
  C := Application^.ExecuteDialog(D, @CurToName, True);
  TrimSt(CurToName);
  if (C <> cmCancel) and (CurToName <> '') then
  begin
    FN := FromName;
    CancelSysErrors := False;
    ValidNames(FN, CurToName);
    GetNewToName := not CancelSysErrors;
  end
  else GetNewToName := False;
end;

procedure DoneFromF;
begin
  Close(FromF.F);
  InOutRes := 0;
end;

procedure DoneToF;
begin
  if not ToSpecial and not Appending and not NewDest then
    SetFTime(ToF.F, FTime);
  Close(ToF.F);
  if not ToSpecial then
  begin
    if (IOResult = 0) and not Appending and (FromAttr <> Archive) then
      lSetFAttr(ToF, FromAttr);
    SendChangeMsg(CurToName);
  end;
end;

procedure NameLengthsToFit(var L1, L2: Byte; Len: Byte);
begin
  repeat
    if L1 + L2 <= Len then Exit;
    if L1 >= L2 then Dec(L1);
    if L2 >= L1 then Dec(L2);
  until False;
end;

procedure UpdateStatusLine;
var
  R: Real;
  Params: Array[0..2] of Longint;
  CS: String[15];
  PS: String;
begin
  if NumWritten = 0 then Exit;
  Params[0] := BytesWritten;
  if BytesWritten = 1 then CS := '' else CS := 's';
  Params[1] := Longint(@CS);
  if FSize = 0 then Params[2] := 100
  else
  begin
    R := BytesWritten;
    R := R * 100 / FSize;
    Params[2] := Trunc(R);
  end;
  FormatStr(PS, ': %d byte%s, %d%%', Params);
  if Appending then CS := 'Append' else CS := 'Copy';
  FromTrimLen := Length(FromName);
  ToTrimLen := Length(CurToName);
  NameLengthsToFit(FromTrimLen, ToTrimLen, 60 - Length(CS) - Length(PS));
  LogEvent := 0;
  DrawStatusLine(
    Concat(CS, 'ing ', TrimmedName(FromName, FromTrimLen),
      ' to ', TrimmedName(CurToName, ToTrimLen), PS));
end;

procedure FixNumWritten;
begin
  Close(ToF.F);
  lResetFile(ToF, 1);
  L := FileSize(ToF.F);
  Seek(ToF.F, L);
  InOutRes := 0;
  NumWritten := L - CurCopied;
end;

label
  ANew, Skip, OpenDest, DoneFrom;
begin
  FCopyPrim := '';
  if AbortDiskAction then
  begin
    CopyStatus := dsCancel;
    Exit;
  end;
  if (CopyStatus = dsSkip) or (CopyStatus = dsReadError) then
    CopyStatus := dsOverwrite;
  Skipped := True;
  CopyOk := False;
  Flushed := True;
  NewDest := False;
  NewName := False;
  BytesWritten := 0;
  CurToName := ToName;
ANew:
  if CompUCString(FromName, CurToName) = Equal then
  begin
    if MessageBox(^C'Can''t copy a file to itself.'#13^C'Continue ?',
      nil, mfError + mfOkCancel) <> cmOk then CopyStatus := dsCancel;
    if NewDest then
    begin
      DoneBuffer;
      DoneFromF;
    end;
    Exit;
  end;

  SS := DeviceDest(CurToName);
  if SS <> '' then CurToName := SS;
  ToSpecial := SS <> '';
  ToNul := SS = 'NUL';

  if not NewDest then
  begin
    Find1st(FromName, FromAttr, FSize, FTime);
    if DosError <> 0 then
    begin
      if MessageBox(^C'Could not find the file'#13^C +
	TrimmedName(FromName, 33) + '.'#13^C'Continue ?', nil,
	mfError + mfOkCancel) <> cmOk then CopyStatus := dsCancel;
      Exit;
    end;
    if FileCopyOptions and fsClearReadOnly <> 0 then
      FromAttr := FromAttr and not ReadOnly;
    BytesLeft := FSize;
    if ToSpecial and not ToNul then BufSize := $1000
    else if FSize > $FFF0 then BufSize := $FFF0
    else if FSize > $8000 then BufSize := $8000
    else if FSize > $4000 then BufSize := $4000
    else if FSize > $2000 then BufSize := $2000
    else BufSize := $1000;
  end;

  FormatStr(SS, ' (%d bytes)', BytesLeft);
  if BytesLeft = 1 then System.Delete(SS, Length(SS) - 1, 1);
  ShowBar := CopyStatus in [dsAppend, dsSkipAll];
  if not ShowBar then ShowBarWindow;

  if not ToSpecial then
  begin
    CancelSysErrors := False;
    Find1st(CurToName, ToAttr, TSize, TTime);
    if CancelSysErrors then
    begin
      CopyStatus := dsCancel;
      Goto Skip;
    end;
    if DosError <> 0 then ToAttr := 0;
    if (DosError = 0) and (CopyStatus <> dsAppend) then
    begin
      if ((CopyStatus = dsAll) and (FileExistsAction <> feCompare)) or
	 (CopyStatus = dsSkipAll) then {}
      else
      begin
	B := CopySkipDialog(
	  FromName, CurToName, FSize, FTime, TSize, TTime);
	if (CopyStatus = dsAll) and (FileExistsAction = feCompare) then
	  if B = dsSkip then Goto Skip else
	else CopyStatus := B;
      end;
      if CopyStatus in [dsSkip, dsSkipAll, dsCancel] then
      begin
Skip:
	if NewDest then
	begin
	  DoneBuffer;
	  DoneFromF;
	end;
	SkipFile(FromName, FSize, BytesWritten);
	Exit;
      end;
      if CopyStatus = dsNew then
      begin
	if not GetNewToName(False) then Goto Skip;
	NewName := True;
	Goto ANew;
      end;
    end;
  end;
  if ShowBar or (CopyStatus = dsAppend) then ShowBarWindow;

  if not NewDest then
  begin
    lAssignFile(FromF, FromName);
    lResetReadOnly(FromF, 1);
    if IOResult <> 0 then
    begin
      if MessageBox(^C'Could not open the file'#13^C +
	TrimmedName(FromName, 33) + '.'#13^C'Continue ?', nil,
	mfError + mfOkCancel) <> cmOk then CopyStatus := dsCancel;
      Exit;
    end;
    if IsDevice(FileRec(FromF.F).Handle) then
    begin
      if MessageBox(
	^C'File ' + TrimmedName(FromName, 16) +
	' is a device.'#13^C'Continue ?',
	nil, mfError + mfOkCancel) <> cmOk then CopyStatus := dsCancel;
      Close(FromF.F);
      InOutRes := 0;
      Exit;
    end;
  end;

  SpaceChecked := False;
  Appending := False;

OpenDest:
  CurCopied := 0;
  lAssignFile(ToF, CurToName);
  if ToSpecial then
  begin
    lRewriteFile(ToF, 1);
    DeviceBinaryMode(FileRec(ToF.F).Handle);
  end
  else
  begin
    if ToAttr and (ReadOnly + Hidden + SysFile) <> 0 then
      lSetFAttr(ToF, Archive);
    CancelSysErrors := False;
    if Appending or (CopyStatus = dsAppend) then
    begin
      lResetFile(ToF, 1);
      if InOutRes = 0 then
      begin
	CurCopied := FileSize(ToF.F);
	Seek(ToF.F, CurCopied);
	Appending := True;
      end;
      CopyStatus := dsOverwrite;
    end
    else lRewriteFile(ToF, 1);
    if CancelSysErrors then
    begin
      CopyStatus := dsCancel;
      if NewDest then DoneBuffer;
      DoneFromF;
      Exit;
    end;
    if IOResult <> 0 then
    begin
      MkDirPrim(PrevDir(CurToName), nil);
      lRewriteFile(ToF, 1);
      if IOResult <> 0 then
      begin
	if CopyStatus <> dsCancel then
	  if MessageBox(^C'Could not create the file'#13^C +
	    TrimmedName(CurToName, 33) + '.'#13^C'Continue ?', nil,
	    mfError + mfOkCancel) <> cmOk then CopyStatus := dsCancel;
	if NewDest then DoneBuffer;
	DoneFromF;
	Exit;
      end;
    end;
    if NotAccessible(FileRec(ToF.F).Handle) then
    begin
      if MessageBox(^C'File ' + TrimmedName(CurToName, 29) +
	' is a device.'#13^C'Continue ?',
	nil, mfError + mfOkCancel) <> cmOk then CopyStatus := dsCancel;
      if NewDest then DoneBuffer;
      Close(ToF.F);
      InOutRes := 0;
      DoneFromF;
      Exit;
    end;
    if not SpaceChecked and not TryAll and
      (FMOptions and foCheckFreeSpace <> 0) and
      (CurToName[1] <> '\') and
      (BytesLeft > FreeDiskSpace(Byte(CurToName[1]) - $40)) then
    begin
      SpaceChecked := True;
      Close(ToF.F);
      if not Appending then lEraseFile(ToF);
      InOutRes := 0;
      C := TryToCopy;
      if C = cmOk then TryAll := True;
      if TryAll or (C = cmYes) then Goto OpenDest;
      if NewDest then DoneBuffer;
      DoneFromF;
      if C = cmCancel then CopyStatus := dsCancel;
      Exit;
    end;
  end;

  if NewDest then SS := 'Copying the rest of'
  else if Appending then SS := 'Appending'
  else SS := 'Copying';
  FromTrimLen := Length(FromName);
  ToTrimLen := Length(CurToName);
  NameLengthsToFit(FromTrimLen, ToTrimLen, 62 - Length(SS));
  LogEvent := lcDiskWrite;
  DrawStatusLine(
    Concat(SS, ' ', TrimmedName(FromName, FromTrimLen),
      ' to ', TrimmedName(CurToName, ToTrimLen), '.'));

  if not NewDest then AllocateBuffer;
  if Buffer = nil then
  begin
    CopyStatus := dsCancel;
    Application^.OutOfMemory;
  end
  else
  begin
    repeat
      CancelSysErrors := False;
      if Flushed then
      begin
	BlockRead(FromF.F, Buffer^, BufSize, NumRead);
	if CancelSysErrors then
	begin
	  SkipFile(FromName, FSize, BytesWritten);
	  CopyStatus := dsReadError;
	  Break;
	end;
	if AbortDiskAction then
	begin
	  CopyStatus := dsCancel;
	  Break;
	end;
	if NumRead = 0 then Break;
	Message(CopyBarWindow, evBroadcast, cmUpdateBar, nil);
	GiveTicks;
	if Clock <> nil then Clock^.Update;
	UpdateRoller;
	BufPos := 0;
      end;
      if ToNul then NumWritten := NumRead
      else BlockWrite(ToF.F, Buffer^[BufPos], NumRead, NumWritten);
      if CancelSysErrors or AbortDiskAction then
      begin
	CopyStatus := dsCancel;
	Break;
      end;
      Flushed := True;
      Message(CopyBarWindow, evBroadcast, cmUpdateBar, nil);
      if not ToSpecial and
	((IOResult <> 0) or (NumRead <> NumWritten)) then FixNumWritten;
      Inc(BytesWritten, NumWritten);
      Inc(CurCopied, NumWritten);
      Dec(BytesLeft, NumWritten);
      BytesCopied := BytesCopied + NumWritten;
      UpdateStatusLine;
      UpdateStatistics;
      GiveTicks;
      if Clock <> nil then Clock^.Update;
      if TheSpooler <> nil then TheSpooler^.ProcessItems;
      UpdateRoller;
      if not ToSpecial and (NumRead <> NumWritten) then
      begin
	Inc(BufPos, NumWritten);
	Dec(NumRead, NumWritten);
	L := FreeDiskSpace(Byte(CurToName[1]) - $40);
	if (L > 0) and (L <= NumRead) then
	begin
	  BlockWrite(ToF.F, Buffer^[BufPos], L, NumWritten);
	  if CancelSysErrors or AbortDiskAction then
	  begin
	    CopyStatus := dsCancel;
	    Break;
	  end;
	  if (IOResult <> 0) or (Word(L) <> NumWritten) then
	    FixNumWritten;
	  Inc(BytesWritten, NumWritten);
	  Inc(CurCopied, NumWritten);
	  Dec(BytesLeft, NumWritten);
	  BytesCopied := BytesCopied + NumWritten;
	  UpdateStatusLine;
	  UpdateStatistics;
	  Inc(BufPos, NumWritten);
	  Dec(NumRead, NumWritten);
	end;
	L := FileSize(ToF.F);
	DoneToF;
	if L = 0 then
	begin
	  lEraseFile(ToF);
	  InOutRes := 0;
	end;
	if not GetNewToName(True) then
	begin
	  DoneBuffer;
	  Goto DoneFrom;
	end;
	Flushed := False;
	NewDest := True;
	NewName := False;
	Goto ANew;
      end;
    until False;
    DoneBuffer;
    InOutRes := 0;
  end;
  if (CopyStatus = dsCancel) or (CopyStatus = dsReadError) then
  begin
    Close(ToF.F);
    if not ToSpecial and not Appending then lEraseFile(ToF);
    InOutRes := 0;
  end
  else
  begin
    DoneToF;
    Skipped := False;
    CopyOk := True;
    if FMOptions and foCopyDescriptions <> 0 then
    begin
      lGetShortFileName(FromName, SS);
      CopyDescription(FromName, SS, CurToName);
    end;
    Inc(FilesCopied);
    UpdateStatistics;
  end;
DoneFrom:
  DoneFromF;
  FCopyPrim := CurToName;
end;

function NewName(const ADest, AName, AMask: FNameStr): FNameStr;
var
  C: String[1];
  NameExt, MaskExt, Name, MaskName, NameDir, MaskDir, N: String;
begin
  lFSplit(AName, NameDir, Name, NameExt);
  lFSplit(AMask, MaskDir, MaskName, MaskExt);

  if (DriveListOptions and (dlGetFromUser + dlUserResources) <> 0) and
    LFNDisabled(ADest) and ((AMask = '') or IsWild(AMask)) then
  begin
    lGetShortFileName(AName, N);
    lFSplit(N, NameDir, Name, NameExt);
  end;

  if MaskExt = '' then
    if MaskName = '' then MaskExt := '*' else
  else Delete(MaskExt, 1, 1);
  if MaskName = '' then MaskName := '*';
  if NameExt <> '' then System.Delete(NameExt, 1, 1);
  ExpandWildCards(MaskName, MaskExt, Name, NameExt);
  if MaskExt = '' then C := '' else C := '.';
  NewName := Concat(MaskName, C, MaskExt);
end;

procedure ResetTotals;
begin
  BytesTotal := 0;
  BytesCopied := 0;
  FilesTotal := 0;
  FilesCopied := 0;
end;

procedure CountDirFiles(const ADir, AFilter: FNameStr; ACRCList: PTagList);
var
  SR: ^lSearchRec;
  S: PString;
begin
  DrawStatus(ADir);
  GiveTicks;
  if Clock <> nil then Clock^.Update;
  if TheSpooler <> nil then TheSpooler^.ProcessItems;
  CancelSysErrors := False;
  GetMem(S, SizeOf(String));
  GetMem(SR, SizeOf(lSearchRec));
  lFindFirst(ADir + AFilter, AnyFile and not VolumeID, SR^);
  if CancelSysErrors then CopyStatus := dsCancel;
  while (DosError = 0) and (CopyStatus <> dsCancel) do
  begin
    if SR^.SR.Attr and (VolumeID + Directory) = 0 then
    begin
      if SR^.FullName <> '' then
	AddNameAndSlash(ADir, SR^.FullName, False, S^)
      else AddNameAndSlash(ADir, SR^.SR.Name, False, S^);
      if FoundInCRCList(S^, ACRCList) and
	CopyRenameFilterPassed(SR^.SR, SR^.FullName) then
      begin
	BytesTotal := BytesTotal + SR^.SR.Size;
	Inc(FilesTotal);
      end;
    end;
    lFindNext(SR^);
  end;
  lFindClose(SR^);
  FreeMem(SR, SizeOf(lSearchRec));
  FreeMem(S, SizeOf(String));
end;

procedure CountDirs(const ADir, AFilter: FNameStr; ACRCList: PTagList);
var
  S: PString;

procedure DoCountDirs(ADir: PString; const AFilter: FNameStr);
var
  SR: ^lSearchRec;
  Dir: PString;
begin
  if StackOverflow or AbortDiskAction then
  begin
    CopyStatus := dsCancel;
    Exit;
  end;
  Dir := NewStr(ADir^);
  GetMem(SR, SizeOf(lSearchRec));
  AddNameAndSlash(Dir^, '*.*', False, S^);
  CancelSysErrors := False;
  lFindFirst(S^, $17, SR^);
  if CancelSysErrors then CopyStatus := dsCancel;
  while (DosError = 0) and (CopyStatus <> dsCancel) do
  begin
    if (SR^.SR.Attr and Directory <> 0) and (SR^.SR.Name[1] <> '.') then
    begin
      if SR^.FullName <> '' then
	AddNameAndSlash(Dir^, SR^.FullName, True, S^)
      else AddNameAndSlash(Dir^, SR^.SR.Name, True, S^);
      CountDirFiles(S^, AFilter, ACRCList);
      if CopyStatus <> dsCancel then DoCountDirs(S, AFilter);
    end;
    lFindNext(SR^);
  end;
  lFindClose(SR^);
  FreeMem(SR, SizeOf(lSearchRec));
  DisposeStr(Dir);
end;

begin
  GetMem(S, SizeOf(String));
  DoCountDirs(@ADir, AFilter);
  FreeMem(S, SizeOf(String));
end;

procedure DirCountPrim(const ADir, AFilter: FNameStr; ACRCList: PTagList);
begin
  CountDirFiles(AddedSlash(ADir), AFilter, ACRCList);
  if CopyStatus <> dsCancel then
    CountDirs(AddedSlash(ADir), AFilter, ACRCList);
end;

procedure CopyDirFiles(const FromDir, ToDir, ADir,
  AFilter, AMask: FNameStr; ACRCList: PTagList);
var
  SaveOpt: Longint;
  PSR: PSearchRec;
  SR: ^lSearchRec;
  ToDirName, S: PString;
label
  Quit;
begin
  GetMem(ToDirName, SizeOf(String));
  GetMem(S, SizeOf(String));
  GetMem(SR, SizeOf(lSearchRec));
  ToDirName^ := AddedSlash(
    ClearedSlash(ToDir) + System.Copy(ADir, Length(FromDir) + 1, 255));
  CancelSysErrors := False;
  lFindFirst(ClearedSlash(ADir), AnyFile and not VolumeID, SR^);
  lFindClose(SR^);
  if CancelSysErrors then
  begin
    CopyStatus := dsCancel;
    Goto Quit;
  end;
  if (DosError = 0) and (SR^.SR.Attr and Directory <> 0) then
    PSR := @SR^.SR else PSR := nil;
  if FoundInCRCList(ClearedSlash(ToDirName^), ACRCList) then
    MkDirPrim(ToDirName^, PSR);
  if CopyStatus = dsCancel then Goto Quit;
  SaveOpt := FMOptions;
  if AFilter = '*.*' then FMOptions := FMOptions and not foCopyDescriptions;
  CancelSysErrors := False;
  lFindFirst(ADir + AFilter, AnyFile and not VolumeID, SR^);
  if CancelSysErrors then CopyStatus := dsCancel;
  while (DosError = 0) and (CopyStatus <> dsCancel) do
  begin
    if (SR^.SR.Attr and (VolumeID + Directory) = 0) and
       (UCPos(FromDir, ADir) <> 0) then
    begin
      if SR^.FullName <> '' then
	AddNameAndSlash(ADir, SR^.FullName, False, S^)
      else AddNameAndSlash(ADir, SR^.SR.Name, False, S^);
      if FoundInCRCList(S^, ACRCList) and
	 CopyRenameFilterPassed(SR^.SR, SR^.FullName) then
	if SR^.FullName <> '' then
	  FCopyPrim(S^, ToDirName^ +
	    NewName(ToDirName^, SR^.FullName, AMask))
	else FCopyPrim(S^, ToDirName^ +
	  NewName(ToDirName^, SR^.SR.Name, AMask));
    end;
    lFindNext(SR^);
  end;
  lFindClose(SR^);
  FMOptions := SaveOpt;
Quit:
  FreeMem(SR, SizeOf(lSearchRec));
  FreeMem(S, SizeOf(String));
  FreeMem(ToDirName, SizeOf(String));
end;

procedure CopyDirs(const FromDir, ToDir, ADir,
  AFilter, AMask: FNameStr; ACRCList: PTagList);
var
  SaveOpt: Longint;
  S: PString;

procedure DoCopyDirs(const FromDir, ToDir: FNameStr;
  ADir: PString; const AFilter, AMask: FNameStr);
var
  SR: ^lSearchRec;
  Dir: PString;
begin
  if StackOverflow then
  begin
    CopyStatus := dsCancel;
    Exit;
  end;
  Dir := NewStr(ADir^);
  GetMem(SR, SizeOf(lSearchRec));
  AddNameAndSlash(Dir^, '*.*', False, S^);
  CancelSysErrors := False;
  lFindFirst(S^, $17, SR^);
  if CancelSysErrors then CopyStatus := dsCancel;
  while (DosError = 0) and (CopyStatus <> dsCancel) do
  begin
    if (SR^.SR.Attr and Directory <> 0) and (SR^.SR.Name[1] <> '.') then
    begin
      if SR^.FullName <> '' then
	AddNameAndSlash(Dir^, SR^.FullName, True, S^)
      else AddNameAndSlash(Dir^, SR^.SR.Name, True, S^);
      CopyDirFiles(FromDir, ToDir, S^, AFilter, AMask, ACRCList);
      if CopyStatus <> dsCancel then
	DoCopyDirs(FromDir, ToDir, S, AFilter, AMask);
    end;
    lFindNext(SR^);
  end;
  lFindClose(SR^);
  FreeMem(SR, SizeOf(lSearchRec));
  DisposeStr(Dir);
end;

begin
  GetMem(S, SizeOf(String));
  SaveOpt := FMOptions;
  FMOptions := FMOptions and not foForceUpperDirs;
  if SaveOpt and foForceUpperDirs <> 0 then
    DoCopyDirs(FromDir, ToDir, @ADir, AFilter, AMask)
  else DoCopyDirs(FromDir, ToDir, @ADir, AFilter, AMask);
  FMOptions := SaveOpt;
  FreeMem(S, SizeOf(String));
end;

procedure DirCopyPrim(const FromDir, ToDir,
  AFilter, AMask: FNameStr; ACRCList: PTagList);
var
  EndSlash: Boolean;
  SaveOpt: Longint;
begin
  if DirWithin(FromDir, ToDir, EndSlash) then
  begin
    if MessageBox(^C'Can''t copy a directory to itself.'#13^C'Continue ?',
      nil, mfError + mfOkCancel) <> cmOk then CopyStatus := dsCancel;
    Exit;
  end;
  SaveOpt := FMOptions;
  FMOptions := FMOptions and not foForceUpperDirs;
  if SaveOpt and foForceUpperDirs <> 0 then
    CopyDirFiles(FromDir, OptUpcaseDir(FromDir, ToDir),
      AddedSlash(FromDir), AFilter, AMask, ACRCList)
  else CopyDirFiles(FromDir, ToDir, AddedSlash(FromDir),
    AFilter, AMask, ACRCList);
  FMOptions := SaveOpt;
  if CopyStatus <> dsCancel then
    CopyDirs(FromDir, ToDir, AddedSlash(FromDir),
      AFilter, AMask, ACRCList);
end;

procedure DirCopyFiles(const FromDir, ToDir,
  AFilter, AMask: FNameStr; ACRCList: PTagList);
var
  SaveOpt: Longint;
  SR: ^lSearchRec;
  S: PString;
begin
  SaveOpt := FMOptions;
  if AFilter = '*.*' then FMOptions := FMOptions and not foCopyDescriptions;
  CancelSysErrors := False;
  GetMem(S, SizeOf(String));
  GetMem(SR, SizeOf(lSearchRec));
  lFindFirst(FromDir + AFilter, AnyFile and not VolumeID, SR^);
  if CancelSysErrors then CopyStatus := dsCancel;
  while (DosError = 0) and (CopyStatus <> dsCancel) do
  begin
    if SR^.SR.Attr and (VolumeID + Directory) = 0 then
    begin
      if SR^.FullName <> '' then
	AddNameAndSlash(FromDir, SR^.FullName, False, S^)
      else AddNameAndSlash(FromDir, SR^.SR.Name, False, S^);
      if FoundInCRCList(S^, ACRCList) and
	 CopyRenameFilterPassed(SR^.SR, SR^.FullName) then
	if SR^.FullName <> '' then
	  FCopyPrim(S^, AddedSlash(ToDir) +
	    NewName(ToDir, SR^.FullName, AMask))
	else FCopyPrim(S^, AddedSlash(ToDir) +
	  NewName(ToDir, SR^.SR.Name, AMask));
    end;
    lFindNext(SR^);
  end;
  lFindClose(SR^);
  FreeMem(SR, SizeOf(lSearchRec));
  FreeMem(S, SizeOf(String));
  FMOptions := SaveOpt;
end;

procedure CopyFilesByMask(const FromDir, ToDir,
  AFilter, AMask: FNameStr; ACRCList: PTagList);
var
  SaveOpt: Longint;
  S: PString;

procedure DoCopyByMask(FromDir: PString;
  const ToDir, AFilter, AMask: FNameStr);
var
  SR: ^lSearchRec;
  Dir: PString;
label
  Quit;
begin
  if StackOverflow then
  begin
    CopyStatus := dsCancel;
    Exit;
  end;
  Dir := NewStr(FromDir^);
  GetMem(SR, SizeOf(lSearchRec));
  DrawStatus(Dir^);
  GiveTicks;
  if Clock <> nil then Clock^.Update;
  if TheSpooler <> nil then TheSpooler^.ProcessItems;
  if CopyStatus = dsCancel then Exit;
  DirCopyFiles(Dir^, ToDir, AFilter, AMask, ACRCList);
  if CopyStatus = dsCancel then Exit;
  AddNameAndSlash(Dir^, '*.*', False, S^);
  CancelSysErrors := False;
  lFindFirst(S^, $17, SR^);
  if CancelSysErrors then CopyStatus := dsCancel;
  while (DosError = 0) and (CopyStatus <> dsCancel) do
  begin
    if AbortDiskAction then
    begin
      CopyStatus := dsCancel;
      GoTo Quit;
    end;
    if (SR^.SR.Attr and Directory <> 0) and (SR^.SR.Name[1] <> '.') then
    begin
      if SR^.FullName <> '' then
	AddNameAndSlash(Dir^, SR^.FullName, True, S^)
      else AddNameAndSlash(Dir^, SR^.SR.Name, True, S^);
      DoCopyByMask(S, ToDir, AFilter, AMask);
    end;
    lFindNext(SR^);
  end;
Quit:
  lFindClose(SR^);
  FreeMem(SR, SizeOf(lSearchRec));
  DisposeStr(Dir);
end;

begin
  GetMem(S, SizeOf(String));
  MkDirPrim(ToDir, nil);
  SaveOpt := FMOptions;
  FMOptions := FMOptions and not foForceUpperDirs;
  DoCopyByMask(@FromDir, ToDir, AFilter, AMask);
  FMOptions := SaveOpt;
  FreeMem(S, SizeOf(String));
end;

function FRenMovPrim(const FromName, ToName: FNameStr): FNameStr;
var
  B: Byte;
  SD: Char;
  Attr: Word;
  SaveOpt, RenSize, FromSize, FromTime, ToSize, ToTime: Longint;
  F: ^lFile;
  DiskFromName, DiskToName, CurToName, ShortName: FNameStr;

function GetNewToName: Boolean;
var
  C: Word;
  D: PDialog;
  R: TRect;
  FN: FNameStr;
begin
  R.Assign(0, 0, 58, 8);
  D := InitRenMovDialog(
    R, 'Rename or move "' + JustFileName(FromName) + '" to',
    False, False);
  C := Application^.ExecuteDialog(D, @CurToName, True);
  TrimSt(CurToName);
  if (C <> cmCancel) and (CurToName <> '') then
  begin
    FN := FromName;
    CancelSysErrors := False;
    ValidNames(FN, CurToName);
    GetNewToName := not CancelSysErrors;
  end
  else GetNewToName := False;
end;

label
  ANew, Copy, Skip;
begin
  FRenMovPrim := '';
  Skipped := True;
  if AbortDiskAction then
  begin
    CopyStatus := dsCancel;
    DeleteStatus := dsCancel;
    Exit;
  end;
  lTrueName(FromName, DiskFromName);
  CurToName := ToName;
ANew:
  lTrueName(CurToName, DiskToName);
  if CompUCString(DiskFromName, DiskToName) = Equal then Exit;
  if not SameDrives(DiskFromName, DiskToName) then
  begin
Copy:
    MoveCopy := True;
    FCopyPrim(FromName, CurToName);
    MoveCopy := False;
    if CopyOk then FDeletePrim(FromName)
    else Exit;
  end
  else
  begin
    RenSize := 0;
    if CopyStatWindow <> nil then
    begin
      Find1st(FromName, Attr, FromSize, FromTime);
      if DosError = 0 then RenSize := FromSize;
    end;
    CancelSysErrors := False;
    Find1st(CurToName, Attr, ToSize, ToTime);
    if CancelSysErrors then
    begin
      CopyStatus := dsCancel;
      DeleteStatus := dsCancel;
      Exit;
    end;
    if (DosError = 0) and (DeviceDest(CurToName) = '') then
    begin
      if CopyStatus <> dsSkipAll then
      begin
	Find1st(FromName, Attr, FromSize, FromTime);
	if DosError <> 0 then CopyStatus := dsSkip
	else if ((CopyStatus = dsAll) and (FileExistsAction <> feCompare)) or
	  (CopyStatus in [dsAppend, dsSkipAll]) then {}
	else
	begin
	  B := CopySkipDialog(FromName, CurToName,
	    FromSize, FromTime, ToSize, ToTime);
	  if (CopyStatus = dsAll) and (FileExistsAction = feCompare) then
	    if B = dsSkip then Goto Skip else
	  else CopyStatus := B;
	end;
      end;
      if CopyStatus in [dsSkip, dsSkipAll, dsCancel] then
      begin
Skip:
	SkipFile(FromName, RenSize, 0);
	Exit;
      end;
      if CopyStatus = dsAppend then Goto Copy;
      if CopyStatus = dsNew then
      begin
	if not GetNewToName then Goto Skip;
	Goto ANew;
      end;
      CheckRenMovName := True;
      SaveOpt := FMOptions;
      FMOptions := FMOptions and not foCopyDescriptions;
      FDeletePrim(CurToName);
      FMOptions := SaveOpt;
      CheckRenMovName := False;
    end;
    SkipFile(FromName, RenSize, 0);
    if FMOptions and foCopyDescriptions <> 0 then
      lGetShortFileName(FromName, ShortName);
    LogEvent := lcDiskWrite;
    DrawStatusLine('Renaming the file ' +
      JustFileName(FromName) + ' to ' +
      TrimmedName(CurToName, 40) + '.');
    GetMem(F, SizeOf(lFile));
    lAssignFile(F^, DiskFromName);
    CancelSysErrors := False;
    lRenameFile(F^, DiskToName);
    if CancelSysErrors then
    begin
      FreeMem(F, SizeOf(lFile));
      CopyStatus := dsCancel;
      DeleteStatus := dsCancel;
      Exit;
    end;
    if IOResult <> 0 then
    begin
      MkDirPrim(PrevDir(CurToName), nil);
      lRenameFile(F^, DiskToName);
      if IOResult <> 0 then
      begin
	FreeMem(F, SizeOf(lFile));
	if MessageBox(^C'Could not rename the file'#13^C +
	  TrimmedName(FromName, 33) + '.'#13^C'Continue ?', nil,
	  mfError + mfOkCancel) <> cmOk then
	begin
	  CopyStatus := dsCancel;
	  DeleteStatus := dsCancel;
	end;
	Exit;
      end;
    end;
    FreeMem(F, SizeOf(lFile));
    SendChangeMsg(FromName);
    CheckRenMovName := True;
    SendChangeMsg(CurToName);
    CheckRenMovName := False;
    if FMOptions and foCopyDescriptions <> 0 then
      if CompUCString(PrevDir(FromName), PrevDir(CurToName)) = Equal then
	RenameDescription(FromName, ShortName, CurToName)
      else
      begin
	CopyDescription(FromName, ShortName, CurToName);
	DeleteDescription(FromName, ShortName);
      end;
  end;
  Skipped := False;
  GiveTicks;
  if Clock <> nil then Clock^.Update;
  if TheSpooler <> nil then TheSpooler^.ProcessItems;
  FRenMovPrim := CurToName;
end;

procedure RenMovDirFiles(const FromDir, ToDir, ADir,
  AFilter, AMask: FNameStr; ACRCList: PTagList);
var
  SaveOpt: Longint;
  PSR: PSearchRec;
  SR: ^lSearchRec;
  ToDirName, S: PString;
label
  Quit;
begin
  GetMem(ToDirName, SizeOf(String));
  GetMem(S, SizeOf(String));
  GetMem(SR, SizeOf(lSearchRec));
  ToDirName^ := AddedSlash(
    ClearedSlash(ToDir) + System.Copy(ADir, Length(FromDir) + 1, 255));
  CancelSysErrors := False;
  lFindFirst(ClearedSlash(ADir), AnyFile and not VolumeID, SR^);
  lFindClose(SR^);
  if CancelSysErrors then
  begin
    CopyStatus := dsCancel;
    DeleteStatus := dsCancel;
    Goto Quit;
  end;
  if (DosError = 0) and (SR^.SR.Attr and Directory <> 0) then
    PSR := @SR^.SR else PSR := nil;
  if FoundInCRCList(ClearedSlash(ToDirName^), ACRCList) then
    MkDirPrim(ToDirName^, PSR);
  if CopyStatus = dsCancel then Goto Quit;
  SaveOpt := FMOptions;
  if AFilter = '*.*' then FMOptions := FMOptions and not foCopyDescriptions;
  CancelSysErrors := False;
  lFindFirst(ADir + AFilter, AnyFile and not VolumeID, SR^);
  if CancelSysErrors then
  begin
    CopyStatus := dsCancel;
    DeleteStatus := dsCancel;
  end;
  while (DosError = 0) and (CopyStatus <> dsCancel) and
    (DeleteStatus <> dsCancel) do
  begin
    if (SR^.SR.Attr and (VolumeID + Directory) = 0) and
       (UCPos(FromDir, ADir) <> 0) then
    begin
      if SR^.FullName <> '' then
	AddNameAndSlash(ADir, SR^.FullName, False, S^)
      else AddNameAndSlash(ADir, SR^.SR.Name, False, S^);
      if FoundInCRCList(S^, ACRCList) and
	 CopyRenameFilterPassed(SR^.SR, SR^.FullName) then
	if SR^.FullName <> '' then
	  FRenMovPrim(S^, ToDirName^ +
	    NewName(ToDirName^, SR^.FullName, AMask))
	else FRenMovPrim(S^, ToDirName^ +
	  NewName(ToDirName^, SR^.SR.Name, AMask));
    end;
    lFindNext(SR^);
  end;
  lFindClose(SR^);
  FMOptions := SaveOpt;
Quit:
  FreeMem(SR, SizeOf(lSearchRec));
  FreeMem(S, SizeOf(String));
  FreeMem(ToDirName, SizeOf(String));
end;

procedure RenMovDirs(const FromDir, ToDir, ADir,
  AFilter, AMask: FNameStr; ACRCList: PTagList);
var
  SaveOpt: Longint;
  S: PString;

procedure DoRenMovDirs(const FromDir, ToDir: FNameStr;
  ADir: PString; const AFilter, AMask: FNameStr);
var
  SR: ^lSearchRec;
  Dir: PString;
begin
  if StackOverflow then
  begin
    CopyStatus := dsCancel;
    DeleteStatus := dsCancel;
    Exit;
  end;
  Dir := NewStr(ADir^);
  GetMem(SR, SizeOf(lSearchRec));
  AddNameAndSlash(Dir^, '*.*', False, S^);
  CancelSysErrors := False;
  lFindFirst(S^, $17, SR^);
  if CancelSysErrors then
  begin
    CopyStatus := dsCancel;
    DeleteStatus := dsCancel;
  end;
  while (DosError = 0) and (CopyStatus <> dsCancel) and
    (DeleteStatus <> dsCancel) do
  begin
    if (SR^.SR.Attr and Directory <> 0) and (SR^.SR.Name[1] <> '.') then
    begin
      if SR^.FullName <> '' then
	AddNameAndSlash(Dir^, SR^.FullName, True, S^)
      else AddNameAndSlash(Dir^, SR^.SR.Name, True, S^);
      RenMovDirFiles(FromDir, ToDir, S^, AFilter, AMask, ACRCList);
      if (CopyStatus <> dsCancel) and (DeleteStatus <> dsCancel) then
	DoRenMovDirs(FromDir, ToDir, S, AFilter, AMask);
    end;
    lFindNext(SR^);
  end;
  lFindClose(SR^);
  FreeMem(SR, SizeOf(lSearchRec));
  DisposeStr(Dir);
end;

begin
  GetMem(S, SizeOf(String));
  SaveOpt := FMOptions;
  FMOptions := FMOptions and not foForceUpperDirs;
  if SaveOpt and foForceUpperDirs <> 0 then
    DoRenMovDirs(FromDir, ToDir, @ADir, AFilter, AMask)
  else DoRenMovDirs(FromDir, ToDir, @ADir, AFilter, AMask);
  FMOptions := SaveOpt;
  FreeMem(S, SizeOf(String));
end;

procedure DirRenameFiles(const ADir, AFilter, AMask: FNameStr;
  ACRCList: PTagList);
var
  SaveOpt: Longint;
  SR: ^lSearchRec;
  S: PString;
begin
  SaveOpt := FMOptions;
  if AFilter = '*.*' then FMOptions := FMOptions and not foCopyDescriptions;
  CancelSysErrors := False;
  GetMem(S, SizeOf(String));
  GetMem(SR, SizeOf(lSearchRec));
  lFindFirst(ADir + AFilter, AnyFile and not VolumeID, SR^);
  if CancelSysErrors then
  begin
    CopyStatus := dsCancel;
    DeleteStatus := dsCancel;
  end;
  while (DosError = 0) and (CopyStatus <> dsCancel) and
    (DeleteStatus <> dsCancel) do
  begin
    if SR^.SR.Attr and (VolumeID + Directory) = 0 then
    begin
      if SR^.FullName <> '' then
	AddNameAndSlash(ADir, SR^.FullName, False, S^)
      else AddNameAndSlash(ADir, SR^.SR.Name, False, S^);
      if FoundInCRCList(S^, ACRCList) and
	 CopyRenameFilterPassed(SR^.SR, SR^.FullName) then
	if SR^.FullName <> '' then
	  FRenMovPrim(S^, ADir +
	    NewName(ADir, SR^.FullName, AMask))
	else FRenMovPrim(S^, ADir +
	  NewName(ADir, SR^.SR.Name, AMask));
    end;
    lFindNext(SR^);
  end;
  lFindClose(SR^);
  FreeMem(SR, SizeOf(lSearchRec));
  FreeMem(S, SizeOf(String));
  FMOptions := SaveOpt;
end;

procedure RenameFilesByMask(const ADir,
  AFilter, AMask: FNameStr; ACRCList: PTagList);
var
  SaveOpt: Longint;
  S: PString;

procedure DoRenameByMask(ADir: PString; const AFilter, AMask: FNameStr);
var
  SR: ^lSearchRec;
  Dir: PString;
label
  Quit;
begin
  if StackOverflow then
  begin
    CopyStatus := dsCancel;
    DeleteStatus := dsCancel;
    Exit;
  end;
  DrawStatus(ADir^);
  GiveTicks;
  if Clock <> nil then Clock^.Update;
  if TheSpooler <> nil then TheSpooler^.ProcessItems;
  if (CopyStatus = dsCancel) or (DeleteStatus = dsCancel) then Exit;
  DirRenameFiles(ADir^, AFilter, AMask, ACRCList);
  if (CopyStatus = dsCancel) or (DeleteStatus = dsCancel) then Exit;
  Dir := NewStr(ADir^);
  GetMem(SR, SizeOf(lSearchRec));
  AddNameAndSlash(Dir^, '*.*', False, S^);
  CancelSysErrors := False;
  lFindFirst(S^, $17, SR^);
  if CancelSysErrors then
  begin
    CopyStatus := dsCancel;
    DeleteStatus := dsCancel;
  end;
  while (DosError = 0) and (CopyStatus <> dsCancel) and
    (DeleteStatus <> dsCancel) do
  begin
    if AbortDiskAction then
    begin
      CopyStatus := dsCancel;
      DeleteStatus := dsCancel;
      GoTo Quit;
    end;
    if (SR^.SR.Attr and Directory <> 0) and (SR^.SR.Name[1] <> '.') then
    begin
      if SR^.FullName <> '' then
	AddNameAndSlash(Dir^, SR^.FullName, True, S^)
      else AddNameAndSlash(Dir^, SR^.SR.Name, True, S^);
      DoRenameByMask(S, AFilter, AMask);
    end;
    lFindNext(SR^);
  end;
Quit:
  lFindClose(SR^);
  FreeMem(SR, SizeOf(lSearchRec));
  DisposeStr(Dir);
end;

begin
  GetMem(S, SizeOf(String));
  SaveOpt := FMOptions;
  FMOptions := FMOptions and not foForceUpperDirs;
  DoRenameByMask(@ADir, AFilter, AMask);
  FMOptions := SaveOpt;
  FreeMem(S, SizeOf(String));
end;

procedure DirMoveFiles(const FromDir, ToDir,
  AFilter, AMask: FNameStr; ACRCList: PTagList);
var
  SaveOpt: Longint;
  SR: ^lSearchRec;
  S: PString;
begin
  SaveOpt := FMOptions;
  if AFilter = '*.*' then FMOptions := FMOptions and not foCopyDescriptions;
  CancelSysErrors := False;
  GetMem(S, SizeOf(String));
  GetMem(SR, SizeOf(lSearchRec));
  lFindFirst(FromDir + AFilter, AnyFile and not VolumeID, SR^);
  if CancelSysErrors then
  begin
    CopyStatus := dsCancel;
    DeleteStatus := dsCancel;
  end;
  while (DosError = 0) and (CopyStatus <> dsCancel) and
    (DeleteStatus <> dsCancel) do
  begin
    if SR^.SR.Attr and (VolumeID + Directory) = 0 then
    begin
      if SR^.FullName <> '' then
	AddNameAndSlash(FromDir, SR^.FullName, False, S^)
      else AddNameAndSlash(FromDir, SR^.SR.Name, False, S^);
      if FoundInCRCList(S^, ACRCList) and
	 CopyRenameFilterPassed(SR^.SR, SR^.FullName) then
	if SR^.FullName <> '' then
	  FRenMovPrim(S^, AddedSlash(ToDir) +
	    NewName(ToDir, SR^.FullName, AMask))
	else FRenMovPrim(S^, AddedSlash(ToDir) +
	  NewName(ToDir, SR^.SR.Name, AMask));
    end;
    lFindNext(SR^);
  end;
  lFindClose(SR^);
  FreeMem(SR, SizeOf(lSearchRec));
  FreeMem(S, SizeOf(String));
  FMOptions := SaveOpt;
end;

procedure MoveFilesByMask(const FromDir, ToDir,
  AFilter, AMask: FNameStr; ACRCList: PTagList);
var
  SaveOpt: Longint;
  S: PString;

procedure DoMoveByMask(FromDir: PString;
  const ToDir, AFilter, AMask: FNameStr);
var
  SR: ^lSearchRec;
  Dir: PString;
label
  Quit;
begin
  if StackOverflow then
  begin
    CopyStatus := dsCancel;
    DeleteStatus := dsCancel;
    Exit;
  end;
  DrawStatus(FromDir^);
  GiveTicks;
  if Clock <> nil then Clock^.Update;
  if TheSpooler <> nil then TheSpooler^.ProcessItems;
  if (CopyStatus = dsCancel) or (DeleteStatus = dsCancel) then Exit;
  DirMoveFiles(FromDir^, ToDir, AFilter, AMask, ACRCList);
  if (CopyStatus = dsCancel) or (DeleteStatus = dsCancel) then Exit;
  Dir := NewStr(FromDir^);
  GetMem(SR, SizeOf(lSearchRec));
  AddNameAndSlash(Dir^, '*.*', False, S^);
  CancelSysErrors := False;
  lFindFirst(S^, $17, SR^);
  if CancelSysErrors then
  begin
    CopyStatus := dsCancel;
    DeleteStatus := dsCancel;
  end;
  while (DosError = 0) and (CopyStatus <> dsCancel) and
    (DeleteStatus <> dsCancel) do
  begin
    if AbortDiskAction then
    begin
      CopyStatus := dsCancel;
      DeleteStatus := dsCancel;
      GoTo Quit;
    end;
    if (SR^.SR.Attr and Directory <> 0) and (SR^.SR.Name[1] <> '.') then
    begin
      if SR^.FullName <> '' then
	AddNameAndSlash(Dir^, SR^.FullName, True, S^)
      else AddNameAndSlash(Dir^, SR^.SR.Name, True, S^);
      DoMoveByMask(S, ToDir, AFilter, AMask);
    end;
    lFindNext(SR^);
  end;
Quit:
  lFindClose(SR^);
  FreeMem(SR, SizeOf(lSearchRec));
  DisposeStr(Dir);
end;

begin
  GetMem(S, SizeOf(String));
  MkDirPrim(ToDir, nil);
  SaveOpt := FMOptions;
  FMOptions := FMOptions and not foForceUpperDirs;
  DoMoveByMask(@FromDir, ToDir, AFilter, AMask);
  FMOptions := SaveOpt;
  FreeMem(S, SizeOf(String));
end;

procedure DirRenMovPrim(const FromDir, ToDir,
  AFilter, AMask: FNameStr; ACRCList: PTagList;
  DoRemove: Boolean);
var
  EndSlash: Boolean;
  SaveOpt: Longint;
  F: ^lFile;
begin
  Skipped := True;
  if (CompUCString(FromDir, ToDir) = Equal) and
     (CompUCString(AFilter, AMask) <> Equal) then
    RenameFilesByMask(AddedSlash(FromDir), AFilter, AMask, ACRCList)
  else if DirWithin(FromDir, ToDir, EndSlash) and EndSlash then
  begin
    if MessageBox(^C'Can''t move a directory to itself.'#13^C'Continue ?',
      nil, mfError + mfOkCancel) <> cmOk then
    begin
      CopyStatus := dsCancel;
      DeleteStatus := dsCancel;
    end;
    Exit;
  end
  else if DoRemove and
    (CompUCString(PrevDir(FromDir), PrevDir(ToDir)) = Equal) and
    (Length(ToDir) > 3) and (ToDir[1] <> '\') then
  begin
    if DirPresent(ToDir) and (CompUCString(FromDir, ToDir) <> Equal) then
    begin
      if (MessageBox(^C'Replace the existing directory'#13^C +
	  TrimmedName(ToDir, 32) + ' ?',
	  nil, mfConfirmation + mfOkCancel) <> cmOk) or
	 (MessageBox(^C'The contents of the old directory'#13^C +
	  TrimmedName(ToDir, 34) +
	  #13^C'will be erased. Continue ?',
	  nil, mfConfirmation + mfOkCancel) <> cmOk) then
      begin
	CopyStatus := dsCancel;
	DeleteStatus := dsCancel;
	Exit;
      end;
      DirDeletePrim(ToDir, nil, True);
    end;
    LogEvent := lcDiskWrite;
    DrawStatusLine('Renaming the directory ' +
      TrimmedName(FromDir, 25) + ' to ' + TrimmedName(ToDir, 25) + '.');
    GetMem(F, SizeOf(lFile));
    lAssignFile(F^, FromDir);
    if FMOptions and foForceUpperDirs <> 0 then
      lRenameFile(F^, StUpcase(ToDir))
    else lRenameFile(F^, ToDir);
    if IOResult <> 0 then
    begin
      MkDirPrim(PrevDir(ToDir), nil);
      if FMOptions and foForceUpperDirs <> 0 then
	lRenameFile(F^, StUpcase(ToDir))
      else lRenameFile(F^, ToDir);
      if IOResult <> 0 then
      begin
	FreeMem(F, SizeOf(lFile));
	if MessageBox(^C'Could not rename the directory'#13^C +
	  TrimmedName(FromDir, 33) + '.'#13^C'Continue ?', nil,
	  mfError + mfOkCancel) <> cmOk then
	begin
	  CopyStatus := dsCancel;
	  DeleteStatus := dsCancel;
	end;
	Exit;
      end;
    end;
    FreeMem(F, SizeOf(lFile));
    SendChangeMsg(FromDir);
    SendChangeMsg(FromDir + '\1');
    RenameDirInTree(FromDir, ToDir);
  end
  else
  begin
    SaveOpt := FMOptions;
    FMOptions := FMOptions and not foForceUpperDirs;
    if SaveOpt and foForceUpperDirs <> 0 then
      RenMovDirFiles(FromDir, OptUpcaseDir(FromDir, ToDir),
	AddedSlash(FromDir), AFilter, AMask, ACRCList)
    else RenMovDirFiles(FromDir, ToDir, AddedSlash(FromDir),
      AFilter, AMask, ACRCList);
    FMOptions := SaveOpt;
    if (CopyStatus <> dsCancel) and
       (DeleteStatus <> dsCancel) then
      RenMovDirs(FromDir, ToDir, AddedSlash(FromDir),
	AFilter, AMask, ACRCList)
    else Exit;
    if (CopyStatus = dsCancel) or (DeleteStatus = dsCancel) then Exit;
    SaveOpt := FMOptions;
    FMOptions := FMOptions and not foDirDelPrompt;
    if DoRemove then DirDeletePrim(FromDir, ACRCList, False)
    else ClearDirs(AddedSlash(FromDir), ACRCList, False);
    FMOptions := SaveOpt;
  end;
  Skipped := False;
end;

function GetDirInfo(const ADir: FNameStr;
  var NumFiles, FilesSize, NumBytes,
  NumTagged, TaggedSize, TaggedBytes: Longint;
  CalcTagged, AllowTree, KeyAbort: Boolean): Boolean;
var
  Abort, Store, OutOfMem: Boolean;
  I, DirIndex: Integer;
  ClusterSize, L, II: Longint;
  T: PTreeCollection;
  S, StartDir: FNameStr;

procedure UpdateTree(const ADir: FNameStr; ASize: Longint);
var
  AD: FNameStr;
begin
  AD := ClearedSlash(ADir);
  I := T^.GetDirNum(AD, DirIndex, MaxInt);
  if (I >= T^.Count) and AllowTree then
  begin
    if not AddDirToTreePrim(ShortFileName(AD), AD, T, OutOfMem) then Exit;
    I := T^.GetDirNum(AD, DirIndex, MaxInt);
  end;
  if I < T^.Count then
  begin
    PTreeRec(T^.At(I))^.Size := ASize;
    Store := True;
  end;
end;

procedure SetTaggedName(const DirS, NameS: FNameStr);
begin
  AddNameAndSlash(DirS, NameS, False, S);
end;

procedure ScanDirs(ADir: PString);
var
  SaveSize: Longint;
  SR: ^lSearchRec;
  Dir: PString;
begin
  if StackOverflow then
  begin
    Abort := True;
    Exit;
  end;
  Dir := NewStr(ADir^);
  GetMem(SR, SizeOf(lSearchRec));
  DrawStatus(Dir^);
  GiveTicks;
  if Clock <> nil then Clock^.Update;
  if TheSpooler <> nil then TheSpooler^.ProcessItems;
  UpdateRoller;
  SaveSize := FilesSize;
  AddNameAndSlash(Dir^, '*.*', False, S);
  lFindFirst(S, AnyFile and not VolumeID, SR^);
  while (DosError = 0) and not Abort do
  begin
    if SR^.SR.Attr and Directory = 0 then
    begin
      II := SR^.SR.Size div ClusterSize;
      L := II * ClusterSize;
      if L < SR^.SR.Size then Inc(L, ClusterSize);
      Inc(NumBytes, L);
      Inc(NumFiles);
      Inc(FilesSize, SR^.SR.Size);
      if CalcTagged then
      begin
	if SR^.FullName <> '' then
	  SetTaggedName(Dir^, SR^.FullName)
	else SetTaggedName(Dir^, SR^.SR.Name);
	repeat
	  if TagList^.NameFound(S) then
	  begin
	    Inc(TaggedBytes, L);
	    Inc(NumTagged);
	    Inc(TaggedSize, SR^.SR.Size);
	    Break;
	  end;
	  S := PrevDir(S);
	until Length(S) <= 2;
      end;
    end
    else if SR^.SR.Name[1] <> '.' then
    begin
      if SR^.FullName <> '' then
	AddNameAndSlash(Dir^, SR^.FullName, True, S)
      else AddNameAndSlash(Dir^, SR^.SR.Name, True, S);
      ScanDirs(@S);
    end;
    lFindNext(SR^);
    if ((KbdStatus = 1) and FMAbortAction) or
       (KeyAbort and KeyPressed) then Abort := True;
  end;
  lFindClose(SR^);
  if not Abort and (T <> nil) then UpdateTree(Dir^, FilesSize - SaveSize);
  FreeMem(SR, SizeOf(lSearchRec));
  DisposeStr(Dir);
end;

begin
  NumFiles := 0;
  FilesSize := 0;
  NumBytes := 0;
  NumTagged := 0;
  TaggedSize := 0;
  TaggedBytes := 0;
  CancelSysErrors := False;
  ClusterSize := GetClusterSize(Byte(ADir[1]) - $40);
  Abort := CancelSysErrors;
  if not Abort then
  begin
    Store := False;
    LoadTree(RootName(ADir), T);
    if T <> nil then DirIndex := T^.GetDirNum(ADir, 0, 0);
    StartDir := AddedSlash(ADir);
    InitRoller;
    ScanDirs(@StartDir);
    DoneRoller;
    if T <> nil then
    begin
      if not Abort and Store then StoreTree(RootName(ADir), T);
      Dispose(T, Done);
    end;
  end;
  GetDirInfo := not Abort;
end;

end.
