DirMerge

DirMerge is a Windows tool that can be used to copy one folder to another with a number of extra options that you don’t have in Windows explorer or in most other programs that can copy files.

Features include:

Copies directories with or without entire subdirectory structure
Optional source file deletion after copying (only if it was copied OR even if the file was skipped)
Overwrites file never, always OR only if a file is (that much) larger, smaller, older or newer than the existing file.
Or just ask the user what to do when a file already exists.

I’ve published this under the GPL license.

Download the executable: DirMerge.exe (for Windows 95/98/2000/XP/Vista)

And view the source code here:

unit DirMergeMainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, FileCtrl, ExtCtrls, ComCtrls, IniFiles, DateUtils;

type
  TfrmDirMerge = class(TForm)
    GroupBox1: TGroupBox;
    edSource: TEdit;
    edTarget: TEdit;
    btnSource: TSpeedButton;
    btnTarget: TSpeedButton;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    btnStart: TSpeedButton;
    rgOverwrite: TRadioGroup;
    cbCondition: TComboBox;
    edAtLeast: TEdit;
    cbSize: TComboBox;
    cbTime: TComboBox;
    StaticText3: TStaticText;
    edFilter: TEdit;
    cbSubdirs: TCheckBox;
    ProgressBar1: TProgressBar;
    RichEdit1: TRichEdit;
    rgDelete: TRadioGroup;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure cbConditionSelect(Sender: TObject);
    procedure btnTargetClick(Sender: TObject);
    procedure btnSourceClick(Sender: TObject);
  private
    function CopyFiles(const sourcePath, targetPath, filter: String;
                    IncludeSubDir:boolean; atLeast:Integer): boolean;
    function CopyWithProgress(sSource, sDest: string): Boolean;
    procedure ColorLastLine(AColor: TColor);
    procedure AddLineWithColor(aText:String; AColor: TColor);
    procedure AppendWithColor(aText:String; AColor: TColor);
  public
    { Public declarations }
  end;

var
  frmDirMerge: TfrmDirMerge;
  FCancelled: boolean;

implementation

{$R *.dfm}

procedure TfrmDirMerge.btnSourceClick(Sender: TObject);
var
  dir : string;
begin
  dir := edSource.Text;
  if SelectDirectory('Select source directory', '', dir) then
    edSource.Text := dir;
end;

function CopyFileWithProgressBar2(TotalFileSize,
  TotalBytesTransferred,
  StreamSize,
  StreamBytesTransferred: LARGE_INTEGER;
  dwStreamNumber,
  dwCallbackReason: DWORD;
  hSourceFile,
  hDestinationFile: THandle;
  lpData: Pointer): DWORD; stdcall;
begin
  // just set size at the beginning
  if dwCallbackReason = CALLBACK_STREAM_SWITCH then
    TProgressBar(lpData).Max := TotalFileSize.QuadPart;

  TProgressBar(lpData).Position := TotalBytesTransferred.QuadPart;
  Application.ProcessMessages;
  Result := PROGRESS_CONTINUE;
end;

procedure TfrmDirMerge.ColorLastLine(AColor: TColor);
begin
  with RichEdit1 do
  begin
    SelStart := SendMessage(Handle, EM_LINEINDEX, Lines.Count - 1, 0);
    SelLength := Length(Lines[Lines.Count - 1]);
    SelAttributes.Color := AColor;
    SelLength := 0;
  end;
end;

procedure TfrmDirMerge.AddLineWithColor(aText:String; AColor: TColor);
begin
  RichEdit1.Lines.Append(aText);
  ColorLastLine(AColor);
end;

procedure TfrmDirMerge.AppendWithColor(aText:String; AColor: TColor);
begin
  with RichEdit1 do
  begin
    Lines[Lines.Count-1] := Lines[Lines.Count-1]+aText;
    ColorLastLine(AColor);
  end;
end;


function TfrmDirMerge.CopyWithProgress(sSource, sDest: string): Boolean;
begin
  // set this FCancelled to true, if you want to cancel the copy operation
  FCancelled := False;
  Result     := CopyFileEx(PChar(sSource), PChar(sDest), @CopyFileWithProgressBar2,
    ProgressBar1, @FCancelled, 0);
end;

procedure TfrmDirMerge.FormCreate(Sender: TObject);
begin
  with TIniFile.Create(ExtractFilePath(Application.ExeName)+'DirMerge.ini') do
  begin
     edSource.Text := ReadString('LastSettings','SourceDir', '');
     edFilter.Text := ReadString('LastSettings','Filter', '*.*');
     cbSubdirs.Checked := ReadBool('LastSettings','Subdirs', False);
     edTarget.Text := ReadString('LastSettings','TargetDir','');
     rgDelete.ItemIndex := ReadInteger('LastSettings','DeleteOption', 0);
     rgOverwrite.ItemIndex := ReadInteger('LastSettings','OverwriteOption', 3);
     cbCondition.ItemIndex := ReadInteger('LastSettings','ConditionOption', 0);
     edAtLeast.Text:= ReadString('LastSettings','AtLeast', '0');
     cbSize.ItemIndex := ReadInteger('LastSettings','SizeOption', 0);
     cbTime.ItemIndex := ReadInteger('LastSettings','TimeOption', 0);
     Free;
  end;
end;

procedure TfrmDirMerge.FormDestroy(Sender: TObject);
begin
  with TIniFile.Create(ExtractFilePath(Application.ExeName)+'DirMerge.ini') do
  begin
     WriteString('LastSettings','SourceDir', edSource.Text);
     WriteString('LastSettings','Filter', edFilter.Text);
     WriteBool('LastSettings','Subdirs', cbSubdirs.Checked);
     WriteString('LastSettings','TargetDir', edTarget.Text);
     WriteInteger('LastSettings','DeleteOption', rgDelete.ItemIndex);
     WriteInteger('LastSettings','OverwriteOption', rgOverwrite.ItemIndex);
     WriteInteger('LastSettings','ConditionOption', cbCondition.ItemIndex);
     WriteString('LastSettings','AtLeast', edAtLeast.Text);
     WriteInteger('LastSettings','SizeOption', cbSize.ItemIndex);
     WriteInteger('LastSettings','TimeOption', cbTime.ItemIndex);
     Free;
  end;
end;

function TfrmDirMerge.CopyFiles(const sourcePath, targetPath, filter: String;
                    IncludeSubDir:boolean; atLeast:Integer): boolean;
var
  searchResult, targetResult : TSearchRec;
  overwrite, delete, yesToAll, noToAll: Boolean;
  choiceResult: integer;
  timeDif: double;
  sourceDate, targetDate: TDateTime;
  sn, tn: String;
begin
  yesToAll := false;
  noToAll := false;
  if not DirectoryExists(targetPath) then CreateDir(targetPath);
  if not DirectoryExists(targetPath) then begin
    AddLineWithColor('Could not create directory '+targetPath, clRed);
    Result := false;
    exit;
  end;
  if FindFirst(sourcePath+'\'+filter, faAnyFile-faDirectory, searchResult) = 0 then
  begin
    repeat
      sn := sourcePath+'\'+searchResult.Name;
      tn := targetPath+'\'+searchResult.Name;
      overwrite := true;
      delete := true;
      if FindFirst(tn, faAnyFile-faDirectory, targetResult) = 0
      then begin
        sourceDate :=FileDateToDateTime(searchResult.Time);
        targetDate :=FileDateToDateTime(targetResult.Time);
        //File exists -> overwrite?
        case rgOverwrite.ItemIndex of
          0: ; // overwrite = true
          1: begin
               case cbCondition.ItemIndex of
                 0: if searchResult.Size+atleast>targetResult.Size then
                      overwrite := false;
                 1: if searchResult.Size-atleast<targetResult.Size then
                      overwrite := false;
                 2,3: begin
                   case cbTime.ItemIndex of
                      0: timeDif := SecondSpan(sourceDate,targetDate);
                      1: timeDif := MinuteSpan(sourceDate,targetDate);
                      2: timeDif := HourSpan(sourceDate,targetDate);
                      3: timeDif := DaySpan(sourceDate,targetDate);
                      4: timeDif := MonthSpan(sourceDate,targetDate);
                      5: timeDif := WeekSpan(sourceDate,targetDate);
                      6: timeDif := YearSpan(sourceDate,targetDate);
                   end;
                   if ((cbTime.ItemIndex=2) and (timeDif<atLeast)) or
                      ((cbTime.ItemIndex=3) and (timeDif>atLeast)) then
                     overwrite := false;
                 end;
               end;
             end;
          2: overwrite := false;
          3: begin
               if not (noToAll or yesToAll) then begin
                 choiceResult := MessageDlgPos(
                                  'Do you want to overwrite '#13#13'   '+tn+#13+
                                  '   '+IntToStr(targetResult.Size)+' bytes'#13+
                                  '   Last modified '+DateToStr(targetDate)+#13+
                                  #13+' with '+#13#13'   '+sn+#13+
                                  '   '+IntToStr(searchResult.Size)+' bytes'#13+
                                  '   Last modified '+DateToStr(sourceDate),
                               mtConfirmation, mbYesAllNoAllCancel, 0, 20, 100);
                 if choiceResult = mrYesToAll then yesToAll := true
                 else if choiceResult = mrNoToAll then noToAll := true
                 else if choiceResult = mrCancel then begin
                   addLineWithColor('Canceled',clRed);
                   result := true;
                   exit;
                 end;
               end;
               if noToAll then choiceResult := mrNo;
               if yesToAll then choiceResult := mrYes;
               if choiceResult = mrNo then overwrite := false;
             end; //ask
        end;
        FindClose(targetResult);
        if overwrite then begin
          AddLineWithColor('Overwriting '+sn+'...', clBlue);
          if CopyWithProgress(sn, tn) then AppendWithColor('done',clBlue)
          else begin //if failed, we don't want to delete the source in any case
            AppendWithColor('failed',clRed);
            delete := false;
          end;
        end
        else begin
          AddLineWithColor('Skipped '+sn, clBlack);
        end;
      end
      else begin
        //File doesn't exists in target -> regular copy
        AddLineWithColor('Copying '+sn+'...',clGreen);
        if CopyWithProgress(sn, tn) then AppendWithColor('done',clGreen)
        else begin //if failed, we don't want to delete the source in any case
          AppendWithColor('failed',clRed);
          delete := false;
        end;
      end;
      //If selected, delete the source file
      if delete and
         (((rgDelete.ItemIndex=1) and overwrite) or (rgDelete.ItemIndex=2))
      then
        if DeleteFile(sn)
        then AppendWithColor('Deleted '+sn, clPurple)
        else AppendWithColor('Failed deleting '+sn, clRed);
    until FindNext(searchResult) <> 0;
    FindClose(searchResult);
  end
  else showMessage('No files found ('+sourcePath+'\'+filter+')');

  if not IncludeSubDir then begin
    Result := true;
    Exit;
  end;

  if FindFirst(SourcePath+'\'+filter, faDirectory, searchResult) = 0 then
  begin
    repeat
      if (SearchResult.Name <> '.') and (SearchResult.Name <> '..') then begin
        if not CopyFiles (SourcePath + '\' + SearchResult.Name,
                   TargetPath + '\' + SearchResult.Name, Filter, TRUE, atLeast)
        then begin
          Result := false;
          FindClose(searchResult);
          Exit;
        end;
      end;
    until FindNext(searchResult) <> 0;
     FindClose(searchResult);
  end;
  Result := True;
end;

procedure TfrmDirMerge.btnStartClick(Sender: TObject);
var
  sourcepath, targetpath: String;
  atLeast: Integer;
begin
  atLeast:=0;
  //Determine the at least value (only if option 1 is selected)
  if rgOverwrite.ItemIndex=1 then begin
    try
      atLeast := StrToInt(edAtLeast.Text);
    except on EConvertError do
      begin
        showMessage('Invalid value in the ''at least'' box');
        exit;
      end;
    end;
    case cbCondition.ItemIndex of
      0,1: case cbSize.ItemIndex of
             1: atLeast := atLeast*1024; //kB
             2: atLeast := atLeast*1024*1024; //MB
             3: atLeast := atLeast*1024*1024*1024 //GB
           end;
    end;
  end;
  sourcePath := edSource.Text;
  if Copy(sourcePath,Length(sourcePath),1)='\' then
    sourcePath := Copy(sourcePath,1,Length(sourcePath)-1);
  targetPath := edTarget.Text;
  if Copy(targetPath,Length(targetPath),1)='\' then
    targetPath := Copy(targetPath,1,Length(targetPath)-1);
  if UpperCase(sourcePath)=UpperCase(targetPath) then begin
    AddLineWithColor('Directories are the same', clRed);
    exit;
  end;
  if CopyFiles(sourcePath, targetPath, edFilter.Text, cbSubdirs.Checked, atLeast)
  then AddLineWithColor('Finished', clGreen)
  else AddLineWithColor('Finished - with errors', clRed);
end;

procedure TfrmDirMerge.btnTargetClick(Sender: TObject);
var
  dir : string;
begin
  dir := edTarget.Text;
  if SelectDirectory('Select target directory', '', dir) then
    edTarget.Text := dir;
end;

procedure TfrmDirMerge.cbConditionSelect(Sender: TObject);
begin
  if (cbCondition.ItemIndex=0) or (cbCondition.ItemIndex=1) then begin
    cbSize.Visible := true;
    cbTime.Visible := false;
  end
  else begin
    cbSize.Visible := false;
    cbTime.Visible := true;
  end;
end;

end.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

318

319

320

321

322

323

324

325

326

327

328

329

330

331

332

333

334

335

336

337

338

339

340

341

342

343

344

345

346

347

348

349

unit DirMergeMainForm;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Buttons, FileCtrl, ExtCtrls, ComCtrls, IniFiles, DateUtils;

type

TfrmDirMerge = class(TForm)

GroupBox1: TGroupBox;

edSource: TEdit;

edTarget: TEdit;

btnSource: TSpeedButton;

btnTarget: TSpeedButton;

StaticText1: TStaticText;

StaticText2: TStaticText;

btnStart: TSpeedButton;

rgOverwrite: TRadioGroup;

cbCondition: TComboBox;

edAtLeast: TEdit;

cbSize: TComboBox;

cbTime: TComboBox;

StaticText3: TStaticText;

edFilter: TEdit;

cbSubdirs: TCheckBox;

ProgressBar1: TProgressBar;

RichEdit1: TRichEdit;

rgDelete: TRadioGroup;

procedure FormDestroy(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure btnStartClick(Sender: TObject);

procedure cbConditionSelect(Sender: TObject);

procedure btnTargetClick(Sender: TObject);

procedure btnSourceClick(Sender: TObject);

private

function CopyFiles(const sourcePath, targetPath, filter: String;

IncludeSubDir:boolean; atLeast:Integer): boolean;

function CopyWithProgress(sSource, sDest: string): Boolean;

procedure ColorLastLine(AColor: TColor);

procedure AddLineWithColor(aText:String; AColor: TColor);

procedure AppendWithColor(aText:String; AColor: TColor);

public

{ Public declarations }

end;

var

frmDirMerge: TfrmDirMerge;

FCancelled: boolean;

implementation

{$R *.dfm}

procedure TfrmDirMerge.btnSourceClick(Sender: TObject);

var

dir : string;

begin

dir := edSource.Text;

if SelectDirectory('Select source directory', '', dir) then

edSource.Text := dir;

end;

function CopyFileWithProgressBar2(TotalFileSize,

TotalBytesTransferred,

StreamSize,

StreamBytesTransferred: LARGE_INTEGER;

dwStreamNumber,

dwCallbackReason: DWORD;

hSourceFile,

hDestinationFile: THandle;

lpData: Pointer): DWORD; stdcall;

begin

// just set size at the beginning

if dwCallbackReason = CALLBACK_STREAM_SWITCH then

TProgressBar(lpData).Max := TotalFileSize.QuadPart;

TProgressBar(lpData).Position := TotalBytesTransferred.QuadPart;

Application.ProcessMessages;

Result := PROGRESS_CONTINUE;

end;

procedure TfrmDirMerge.ColorLastLine(AColor: TColor);

begin

with RichEdit1 do

begin

SelStart := SendMessage(Handle, EM_LINEINDEX, Lines.Count - 1, 0);

SelLength := Length(Lines[Lines.Count - 1]);

SelAttributes.Color := AColor;

SelLength := 0;

end;

procedure TfrmDirMerge.AddLineWithColor(aText:String; AColor: TColor);

begin

RichEdit1.Lines.Append(aText);

ColorLastLine(AColor);

end;

procedure TfrmDirMerge.AppendWithColor(aText:String; AColor: TColor);

begin

with RichEdit1 do

begin

Lines[Lines.Count-1] := Lines[Lines.Count-1]+aText;

ColorLastLine(AColor);

end;

function TfrmDirMerge.CopyWithProgress(sSource, sDest: string): Boolean;

begin

// set this FCancelled to true, if you want to cancel the copy operation

FCancelled := False;

Result := CopyFileEx(PChar(sSource), PChar(sDest), @CopyFileWithProgressBar2,

ProgressBar1, @FCancelled, 0);

end;

procedure TfrmDirMerge.FormCreate(Sender: TObject);

begin

with TIniFile.Create(ExtractFilePath(Application.ExeName)+'DirMerge.ini') do

begin

edSource.Text := ReadString('LastSettings','SourceDir', '');

edFilter.Text := ReadString('LastSettings','Filter', '*.*');

cbSubdirs.Checked := ReadBool('LastSettings','Subdirs', False);

edTarget.Text := ReadString('LastSettings','TargetDir','');

rgDelete.ItemIndex := ReadInteger('LastSettings','DeleteOption', 0);

rgOverwrite.ItemIndex := ReadInteger('LastSettings','OverwriteOption', 3);

cbCondition.ItemIndex := ReadInteger('LastSettings','ConditionOption', 0);

edAtLeast.Text:= ReadString('LastSettings','AtLeast', '0');

cbSize.ItemIndex := ReadInteger('LastSettings','SizeOption', 0);

cbTime.ItemIndex := ReadInteger('LastSettings','TimeOption', 0);

Free;

end;

procedure TfrmDirMerge.FormDestroy(Sender: TObject);

begin

with TIniFile.Create(ExtractFilePath(Application.ExeName)+'DirMerge.ini') do

begin

WriteString('LastSettings','SourceDir', edSource.Text);

WriteString('LastSettings','Filter', edFilter.Text);

WriteBool('LastSettings','Subdirs', cbSubdirs.Checked);

WriteString('LastSettings','TargetDir', edTarget.Text);

WriteInteger('LastSettings','DeleteOption', rgDelete.ItemIndex);

WriteInteger('LastSettings','OverwriteOption', rgOverwrite.ItemIndex);

WriteInteger('LastSettings','ConditionOption', cbCondition.ItemIndex);

WriteString('LastSettings','AtLeast', edAtLeast.Text);

WriteInteger('LastSettings','SizeOption', cbSize.ItemIndex);

WriteInteger('LastSettings','TimeOption', cbTime.ItemIndex);

Free;

end;

function TfrmDirMerge.CopyFiles(const sourcePath, targetPath, filter: String;

IncludeSubDir:boolean; atLeast:Integer): boolean;

var

searchResult, targetResult : TSearchRec;

overwrite, delete, yesToAll, noToAll: Boolean;

choiceResult: integer;

timeDif: double;

sourceDate, targetDate: TDateTime;

sn, tn: String;

begin

yesToAll := false;

noToAll := false;

if not DirectoryExists(targetPath) then CreateDir(targetPath);

if not DirectoryExists(targetPath) then begin

AddLineWithColor('Could not create directory '+targetPath, clRed);

Result := false;

exit;

end;

if FindFirst(sourcePath+'\'+filter, faAnyFile-faDirectory, searchResult) = 0 then

begin

repeat

sn := sourcePath+'\'+searchResult.Name;

tn := targetPath+'\'+searchResult.Name;

overwrite := true;

delete := true;

if FindFirst(tn, faAnyFile-faDirectory, targetResult) = 0

then begin

sourceDate :=FileDateToDateTime(searchResult.Time);

targetDate :=FileDateToDateTime(targetResult.Time);

//File exists -> overwrite?

case rgOverwrite.ItemIndex of

0: ; // overwrite = true

1: begin

case cbCondition.ItemIndex of

0: if searchResult.Size+atleast>targetResult.Size then

overwrite := false;

1: if searchResult.Size-atleast<targetResult.Size then

overwrite := false;

2,3: begin

case cbTime.ItemIndex of

0: timeDif := SecondSpan(sourceDate,targetDate);

1: timeDif := MinuteSpan(sourceDate,targetDate);

2: timeDif := HourSpan(sourceDate,targetDate);

3: timeDif := DaySpan(sourceDate,targetDate);

4: timeDif := MonthSpan(sourceDate,targetDate);

5: timeDif := WeekSpan(sourceDate,targetDate);

6: timeDif := YearSpan(sourceDate,targetDate);

end;

if ((cbTime.ItemIndex=2) and (timeDif<atLeast)) or

((cbTime.ItemIndex=3) and (timeDif>atLeast)) then

overwrite := false;

end;

2: overwrite := false;

3: begin

if not (noToAll or yesToAll) then begin

choiceResult := MessageDlgPos(

'Do you want to overwrite '#13#13' '+tn+#13+

' '+IntToStr(targetResult.Size)+' bytes'#13+

' Last modified '+DateToStr(targetDate)+#13+

#13+' with '+#13#13' '+sn+#13+

' '+IntToStr(searchResult.Size)+' bytes'#13+

' Last modified '+DateToStr(sourceDate),

mtConfirmation, mbYesAllNoAllCancel, 0, 20, 100);

if choiceResult = mrYesToAll then yesToAll := true

else if choiceResult = mrNoToAll then noToAll := true

else if choiceResult = mrCancel then begin

addLineWithColor('Canceled',clRed);

result := true;

exit;

end;

if noToAll then choiceResult := mrNo;

if yesToAll then choiceResult := mrYes;

if choiceResult = mrNo then overwrite := false;

end; //ask

end;

FindClose(targetResult);

if overwrite then begin

AddLineWithColor('Overwriting '+sn+'...', clBlue);

if CopyWithProgress(sn, tn) then AppendWithColor('done',clBlue)

else begin //if failed, we don't want to delete the source in any case

AppendWithColor('failed',clRed);

delete := false;

end;

end

else begin

AddLineWithColor('Skipped '+sn, clBlack);

end;

end

else begin

//File doesn't exists in target -> regular copy

AddLineWithColor('Copying '+sn+'...',clGreen);

if CopyWithProgress(sn, tn) then AppendWithColor('done',clGreen)

else begin //if failed, we don't want to delete the source in any case

AppendWithColor('failed',clRed);

delete := false;

end;

//If selected, delete the source file

if delete and

(((rgDelete.ItemIndex=1) and overwrite) or (rgDelete.ItemIndex=2))

then

if DeleteFile(sn)

then AppendWithColor('Deleted '+sn, clPurple)

else AppendWithColor('Failed deleting '+sn, clRed);

until FindNext(searchResult) <> 0;

FindClose(searchResult);

end

else showMessage('No files found ('+sourcePath+'\'+filter+')');

if not IncludeSubDir then begin

Result := true;

Exit;

end;

if FindFirst(SourcePath+'\'+filter, faDirectory, searchResult) = 0 then

begin

repeat

if (SearchResult.Name <> '.') and (SearchResult.Name <> '..') then begin

if not CopyFiles (SourcePath + '\' + SearchResult.Name,

TargetPath + '\' + SearchResult.Name, Filter, TRUE, atLeast)

then begin

Result := false;

FindClose(searchResult);

Exit;

end;

until FindNext(searchResult) <> 0;

FindClose(searchResult);

end;

Result := True;

end;

procedure TfrmDirMerge.btnStartClick(Sender: TObject);

var

sourcepath, targetpath: String;

atLeast: Integer;

begin

atLeast:=0;

//Determine the at least value (only if option 1 is selected)

if rgOverwrite.ItemIndex=1 then begin

try

atLeast := StrToInt(edAtLeast.Text);

except on EConvertError do

begin

showMessage('Invalid value in the ''at least'' box');

exit;

end;

case cbCondition.ItemIndex of

0,1: case cbSize.ItemIndex of

1: atLeast := atLeast*1024; //kB

2: atLeast := atLeast*1024*1024; //MB

3: atLeast := atLeast*1024*1024*1024 //GB

end;

sourcePath := edSource.Text;

if Copy(sourcePath,Length(sourcePath),1)='\' then

sourcePath := Copy(sourcePath,1,Length(sourcePath)-1);

targetPath := edTarget.Text;

if Copy(targetPath,Length(targetPath),1)='\' then

targetPath := Copy(targetPath,1,Length(targetPath)-1);

if UpperCase(sourcePath)=UpperCase(targetPath) then begin

AddLineWithColor('Directories are the same', clRed);

exit;

end;

if CopyFiles(sourcePath, targetPath, edFilter.Text, cbSubdirs.Checked, atLeast)

then AddLineWithColor('Finished', clGreen)

else AddLineWithColor('Finished - with errors', clRed);

end;

procedure TfrmDirMerge.btnTargetClick(Sender: TObject);

var

dir : string;

begin

dir := edTarget.Text;

if SelectDirectory('Select target directory', '', dir) then

edTarget.Text := dir;

end;

procedure TfrmDirMerge.cbConditionSelect(Sender: TObject);

begin

if (cbCondition.ItemIndex=0) or (cbCondition.ItemIndex=1) then begin

cbSize.Visible := true;

cbTime.Visible := false;

end

else begin

cbSize.Visible := false;

cbTime.Visible := true;

end;

end.

object frmDirMerge: TfrmDirMerge
  Left = 0
  Top = 0
  Caption = 'DirMerge (Beta) by Bart Groot'
  ClientHeight = 494
  ClientWidth = 529
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object GroupBox1: TGroupBox
    AlignWithMargins = True
    Left = 5
    Top = 5
    Width = 519
    Height = 289
    Margins.Left = 5
    Margins.Top = 5
    Margins.Right = 5
    Margins.Bottom = 5
    Align = alTop
    Constraints.MinHeight = 289
    Constraints.MinWidth = 519
    TabOrder = 0
    DesignSize = (
      519
      289)
    object btnSource: TSpeedButton
      Left = 239
      Top = 15
      Width = 23
      Height = 22
      Caption = '...'
      OnClick = btnSourceClick
    end
    object btnTarget: TSpeedButton
      Left = 240
      Top = 80
      Width = 23
      Height = 22
      Caption = '...'
      OnClick = btnTargetClick
    end
    object btnStart: TSpeedButton
      Left = 430
      Top = 229
      Width = 78
      Height = 42
      Caption = '&Start copying'
      OnClick = btnStartClick
    end
    object edSource: TEdit
      Left = 72
      Top = 16
      Width = 161
      Height = 21
      TabOrder = 0
    end
    object edTarget: TEdit
      Left = 73
      Top = 80
      Width = 161
      Height = 21
      TabOrder = 3
    end
    object StaticText1: TStaticText
      Left = 10
      Top = 20
      Width = 56
      Height = 17
      Caption = 'Source dir:'
      TabOrder = 10
    end
    object StaticText2: TStaticText
      Left = 11
      Top = 84
      Width = 55
      Height = 17
      Caption = 'Target dir:'
      TabOrder = 11
    end
    object rgOverwrite: TRadioGroup
      Left = 11
      Top = 118
      Width = 497
      Height = 105
      Caption = 
        'If a file already exists in the target dir with the same name as' +
        ' a source file, then'
      ItemIndex = 3
      Items.Strings = (
        'Always overwrite'
        
          'Only overwrite if source file is                         than ta' +
          'rget file by at least'
        'Never overwrite'
        'Ask me what to do')
      TabOrder = 5
    end
    object cbCondition: TComboBox
      Left = 184
      Top = 153
      Width = 63
      Height = 21
      Style = csDropDownList
      ItemHeight = 13
      ItemIndex = 0
      TabOrder = 6
      Text = 'larger'
      OnSelect = cbConditionSelect
      Items.Strings = (
        'larger'
        'smaller'
        'newer'
        'older')
    end
    object edAtLeast: TEdit
      Left = 384
      Top = 153
      Width = 42
      Height = 21
      TabOrder = 7
      Text = '0'
    end
    object cbTime: TComboBox
      Left = 432
      Top = 153
      Width = 63
      Height = 21
      Style = csDropDownList
      ItemHeight = 13
      ItemIndex = 0
      TabOrder = 9
      Text = 'seconds'
      Items.Strings = (
        'seconds'
        'minutes'
        'hours'
        'days'
        'weeks'
        'months'
        'years')
    end
    object cbSize: TComboBox
      Left = 432
      Top = 153
      Width = 63
      Height = 21
      Style = csDropDownList
      ItemHeight = 13
      ItemIndex = 0
      TabOrder = 8
      Text = 'bytes'
      Items.Strings = (
        'bytes'
        'KBytes'
        'MBytes'
        'GBytes')
    end
    object StaticText3: TStaticText
      Left = 17
      Top = 47
      Width = 49
      Height = 17
      Caption = 'File filter:'
      TabOrder = 12
    end
    object edFilter: TEdit
      Left = 72
      Top = 43
      Width = 64
      Height = 21
      Anchors = [akLeft, akTop, akRight]
      TabOrder = 1
      Text = '*.*'
    end
    object cbSubdirs: TCheckBox
      Left = 142
      Top = 45
      Width = 147
      Height = 17
      Caption = 'Include subdirectories'
      TabOrder = 2
    end
    object ProgressBar1: TProgressBar
      Left = 19
      Top = 248
      Width = 405
      Height = 23
      TabOrder = 13
    end
    object rgDelete: TRadioGroup
      Left = 280
      Top = 15
      Width = 228
      Height = 87
      Caption = 'When done with source file'
      ItemIndex = 0
      Items.Strings = (
        'Do nothing (regular copy)'
        'Delete it if it was copied'
        'Delete it')
      TabOrder = 4
    end
  end
  object RichEdit1: TRichEdit
    Left = 0
    Top = 299
    Width = 529
    Height = 195
    Align = alClient
    ReadOnly = True
    ScrollBars = ssBoth
    TabOrder = 1
  end
end

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

object frmDirMerge: TfrmDirMerge

Left = 0

Top = 0

Caption = 'DirMerge (Beta) by Bart Groot'

ClientHeight = 494

ClientWidth = 529

Color = clBtnFace

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'Tahoma'

Font.Style = []

OldCreateOrder = False

OnCreate = FormCreate

OnDestroy = FormDestroy

PixelsPerInch = 96

TextHeight = 13

object GroupBox1: TGroupBox

AlignWithMargins = True

Left = 5

Top = 5

Width = 519

Height = 289

Margins.Left = 5

Margins.Top = 5

Margins.Right = 5

Margins.Bottom = 5

Align = alTop

Constraints.MinHeight = 289

Constraints.MinWidth = 519

TabOrder = 0

DesignSize = (

519

289)

object btnSource: TSpeedButton

Left = 239

Top = 15

Width = 23

Height = 22

Caption = '...'

OnClick = btnSourceClick

end

object btnTarget: TSpeedButton

Left = 240

Top = 80

Width = 23

Height = 22

Caption = '...'

OnClick = btnTargetClick

end

object btnStart: TSpeedButton

Left = 430

Top = 229

Width = 78

Height = 42

Caption = '&Start copying'

OnClick = btnStartClick

end

object edSource: TEdit

Left = 72

Top = 16

Width = 161

Height = 21

TabOrder = 0

end

object edTarget: TEdit

Left = 73

Top = 80

Width = 161

Height = 21

TabOrder = 3

end

object StaticText1: TStaticText

Left = 10

Top = 20

Width = 56

Height = 17

Caption = 'Source dir:'

TabOrder = 10

end

object StaticText2: TStaticText

Left = 11

Top = 84

Width = 55

Height = 17

Caption = 'Target dir:'

TabOrder = 11

end

object rgOverwrite: TRadioGroup

Left = 11

Top = 118

Width = 497

Height = 105

Caption =

'If a file already exists in the target dir with the same name as' +

' a source file, then'

ItemIndex = 3

Items.Strings = (

'Always overwrite'

'Only overwrite if source file is than ta' +

'rget file by at least'

'Never overwrite'

'Ask me what to do')

TabOrder = 5

end

object cbCondition: TComboBox

Left = 184

Top = 153

Width = 63

Height = 21

Style = csDropDownList

ItemHeight = 13

ItemIndex = 0

TabOrder = 6

Text = 'larger'

OnSelect = cbConditionSelect

Items.Strings = (

'larger'

'smaller'

'newer'

'older')

end

object edAtLeast: TEdit

Left = 384

Top = 153

Width = 42

Height = 21

TabOrder = 7

Text = '0'

end

object cbTime: TComboBox

Left = 432

Top = 153

Width = 63

Height = 21

Style = csDropDownList

ItemHeight = 13

ItemIndex = 0

TabOrder = 9

Text = 'seconds'

Items.Strings = (

'seconds'

'minutes'

'hours'

'days'

'weeks'

'months'

'years')

end

object cbSize: TComboBox

Left = 432

Top = 153

Width = 63

Height = 21

Style = csDropDownList

ItemHeight = 13

ItemIndex = 0

TabOrder = 8

Text = 'bytes'

Items.Strings = (

'bytes'

'KBytes'

'MBytes'

'GBytes')

end

object StaticText3: TStaticText

Left = 17

Top = 47

Width = 49

Height = 17

Caption = 'File filter:'

TabOrder = 12

end

object edFilter: TEdit

Left = 72

Top = 43

Width = 64

Height = 21

Anchors = [akLeft, akTop, akRight]

TabOrder = 1

Text = '*.*'

end

object cbSubdirs: TCheckBox

Left = 142

Top = 45

Width = 147

Height = 17

Caption = 'Include subdirectories'

TabOrder = 2

end

object ProgressBar1: TProgressBar

Left = 19

Top = 248

Width = 405

Height = 23

TabOrder = 13

end

object rgDelete: TRadioGroup

Left = 280

Top = 15

Width = 228

Height = 87

Caption = 'When done with source file'

ItemIndex = 0

Items.Strings = (

'Do nothing (regular copy)'

'Delete it if it was copied'

'Delete it')

TabOrder = 4

end

object RichEdit1: TRichEdit

Left = 0

Top = 299

Width = 529

Height = 195

Align = alClient

ReadOnly = True

ScrollBars = ssBoth

TabOrder = 1

end

Categories

Recent Posts

Links