unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ShellFileCtrl, XPtest, uses_end; type TForm1 = class(TForm) CreateTestFile: TButton; Edit1: TEdit; CopyFile: TButton; MoveFile: TButton; DeleteFile: TButton; CopyFolder: TButton; MoveFolder: TButton; DeleteFolder: TButton; DeleteOutputFolder: TButton; procedure DeleteOutputFolderClick(Sender: TObject); procedure DeleteFolderClick(Sender: TObject); procedure MoveFolderClick(Sender: TObject); procedure CopyFolderClick(Sender: TObject); procedure DeleteFileClick(Sender: TObject); procedure MoveFileClick(Sender: TObject); procedure CopyFileClick(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormCreate(Sender: TObject); procedure CreateTestFileClick(Sender: TObject); private { Private 宣言 } public { Public 宣言 } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); begin// Edit1.Text := ExtractFileDir(Application.ExeName); end; procedure TForm1.FormDestroy(Sender: TObject); begin// end; procedure TForm1.CreateTestFileClick(Sender: TObject); procedure CreateTextFile(FullPath: String); var SL: TStringList; begin ForceDirectories(ExtractFileDir(FullPath)); SL := TStringList.Create; try SL.Text := 'test'; SL.SaveToFile(FullPath); finally SL.Free; end; end; begin ForceDirectories( Edit1.Text + '\test' ); CreateTextFile( Edit1.Text+'\test\aaa.txt' ); CreateTextFile( Edit1.Text+'\test\bbb.txt' ); CreateTextFile( Edit1.Text+'\test\folder1\ccc.txt' ); CreateTextFile( Edit1.Text+'\test\folder1\ddd.txt' ); CreateTextFile( Edit1.Text+'\test\folder2\eee.txt' ); Check(True, FileExists(Edit1.Text+'\test\aaa.txt')); Check(True, FileExists(Edit1.Text+'\test\bbb.txt')); Check(True, FileExists(Edit1.Text+'\test\folder1\ccc.txt' )); Check(True, FileExists(Edit1.Text+'\test\folder1\ddd.txt' )); Check(True, FileExists(Edit1.Text+'\test\folder2\eee.txt' )); ForceDirectories(Edit1.Text+'\test\folder2'); ForceDirectories(Edit1.Text+'\test\folder2\folder3'); ForceDirectories(Edit1.Text+'\test\folder2\folder4'); ForceDirectories(Edit1.Text+'\test\folder2\folder3\folder5'); CreateTextFile( Edit1.Text+'\test\folder2\folder4\fff.txt' ); //a〜fの6ファイルを作成 //folder1〜5の5ファイルを作成 Check(True, DirectoryExists(Edit1.Text+'\test\folder2\folder4')); Check(True, DirectoryExists(Edit1.Text+'\test\folder2\folder3\folder5')); Check(True, FileExists(Edit1.Text+'\test\folder2\folder4\fff.txt' )); end; procedure TForm1.CopyFileClick(Sender: TObject); var Source, Target: String; begin// CreateTestFile.Click; DeleteOutputFolder.Click; //Dirに対して動作しないことの確認  Source := Edit1.Text+'\test'; Target := Edit1.Text+'\dest'; ShellCopyFile( Self.Handle, Source, Target); Check(False, DirectoryExists(Target)); //同名ファイルでのコピー Source := Edit1.Text+'\test\aaa.txt'; Target := Edit1.Text+'\dest\aaa.txt'; ShellCopyFile( Self.Handle, Source, Target); Check(True, FileExists(Source)); Check(True, FileExists(Target)); //異なる名前のファイルでのコピー Source := Edit1.Text+'\test\aaa.txt'; Target := Edit1.Text+'\dest\bbb.txt'; ShellCopyFile( Self.Handle, Source, Target); Check(True, FileExists(Source)); Check(True, FileExists(Target)); //新たにディレクトリを作成してコピー Source := Edit1.Text+'\test\aaa.txt'; Target := Edit1.Text+'\dest\aaa\bbb.txt'; ShellCopyFile( Self.Handle, Source, Target); Check(True, FileExists(Source)); Check(True, FileExists(Target)); end; procedure TForm1.MoveFileClick(Sender: TObject); var Source, Target: String; begin// CreateTestFile.Click; DeleteOutputFolder.Click;  //Dirに対して動作しないことの確認  Source := Edit1.Text+'\test'; Target := Edit1.Text+'\dest'; ShellMoveFile( Self.Handle, Source, Target); if DirectoryExists(Target) then begin ShowMessage('テスト失敗'); end; if not DirectoryExists(Source) then begin ShowMessage('テスト失敗'); end; //同名ファイルでの移動 Source := Edit1.Text+'\test\aaa.txt'; Target := Edit1.Text+'\dest\aaa.txt'; ShellMoveFile( Self.Handle, Source, Target); if (not FileExists(Source)) and FileExists(Target) then begin ShowMessage('テスト成功'); end else begin ShowMessage('テスト失敗'); end; //異なる名前のファイルでのコピー Source := Edit1.Text+'\test\bbb.txt'; Target := Edit1.Text+'\dest\ccc.txt'; ShellMoveFile( Self.Handle, Source, Target); if (not FileExists(Source)) and FileExists(Target) then begin ShowMessage('テスト成功'); end else begin ShowMessage('テスト失敗'); end; end; procedure TForm1.DeleteFileClick(Sender: TObject); var Source, Target: String; begin// CreateTestFile.Click; DeleteOutputFolder.Click;  //Dirに対して動作しないことの確認  Source := Edit1.Text+'\test'; ShellDeleteFile( Self.Handle, Source); if not DirectoryExists(Source) then begin ShowMessage('テスト失敗'); end; //ファイル削除 Source := Edit1.Text+'\test\aaa.txt'; ShellDeleteFile( Self.Handle, Source); if (not FileExists(Source)) then begin ShowMessage('テスト成功'); end else begin ShowMessage('テスト失敗'); end; end; procedure TForm1.CopyFolderClick(Sender: TObject); var Source, Target: String; begin// CreateTestFile.Click; DeleteOutputFolder.Click;  //Fileに対して動作しないことの確認  Source := Edit1.Text+'\test\aaa.txt'; Target := Edit1.Text+'\dest'; ShellCopyFolder( Self.Handle, Source, Target); if FileExists(Target) or DirectoryExists(Target) then begin ShowMessage('テスト失敗'); end;  //Fileに対して動作しないことの確認  Source := Edit1.Text+'\test\aaa.txt'; Target := Edit1.Text+'\dest\aaa.txt'; ShellCopyFolder( Self.Handle, Source, Target); if FileExists(Target) or DirectoryExists(Target) then begin ShowMessage('テスト失敗'); end; //同名フォルダでのコピー Source := Edit1.Text+'\test\folder2'; Target := Edit1.Text+'\dest\folder2'; ShellCopyFolder( Self.Handle, Source, Target); if DirectoryExists(Source) and DirectoryExists(Target) then begin if (FileExists(Source + '\eee.txt') and FileExists(Target + '\eee.txt')) and (DirectoryExists(Source + '\folder3\folder5') and DirectoryExists(Target + '\folder3\folder5')) and (FileExists(Source + '\folder4\fff.txt') and FileExists(Target + '\folder4\fff.txt')) then begin ShowMessage('テスト成功'); end else begin ShowMessage('テスト失敗'); end; end else begin ShowMessage('テスト失敗'); end; //異なる名前のフォルダでのコピー Source := Edit1.Text+'\test\folder2'; Target := Edit1.Text+'\dest\folder0'; ShellCopyFolder( Self.Handle, Source, Target); if DirectoryExists(Source) and DirectoryExists(Target) then begin if (FileExists(Source + '\eee.txt') and FileExists(Target + '\eee.txt')) and (DirectoryExists(Source + '\folder3\folder5') and DirectoryExists(Target + '\folder3\folder5')) and (FileExists(Source + '\folder4\fff.txt') and FileExists(Target + '\folder4\fff.txt')) then begin ShowMessage('テスト成功'); end else begin ShowMessage('テスト失敗'); end; end else begin ShowMessage('テスト失敗'); end; end; procedure TForm1.MoveFolderClick(Sender: TObject); var Source, Target: String; begin// CreateTestFile.Click; DeleteOutputFolder.Click;  //Fileに対して動作しないことの確認  Source := Edit1.Text+'\test\aaa.txt'; Target := Edit1.Text+'\dest'; ShellMoveFolder( Self.Handle, Source, Target); if FileExists(Target) or DirectoryExists(Target) then begin ShowMessage('テスト失敗'); end;  //Fileに対して動作しないことの確認  Source := Edit1.Text+'\test\aaa.txt'; Target := Edit1.Text+'\dest\aaa.txt'; ShellMoveFolder( Self.Handle, Source, Target); if FileExists(Target) or DirectoryExists(Target) then begin ShowMessage('テスト失敗'); end; //同名フォルダでの移動 Source := Edit1.Text+'\test\folder2'; Target := Edit1.Text+'\test\folder2copy'; ShellCopyFolder( Self.Handle, Source, Target); Source := Edit1.Text+'\test\folder2'; Target := Edit1.Text+'\dest\folder2'; ShellMoveFolder( Self.Handle, Source, Target); if (not DirectoryExists(Source)) and DirectoryExists(Target) then begin if ((not FileExists(Source + '\eee.txt')) and FileExists(Target + '\eee.txt')) and ((not DirectoryExists(Source + '\folder3\folder5')) and DirectoryExists(Target + '\folder3\folder5')) and ((not FileExists(Source + '\folder4\fff.txt')) and FileExists(Target + '\folder4\fff.txt')) then begin ShowMessage('テスト成功'); end else begin ShowMessage('テスト失敗'); end; end else begin ShowMessage('テスト失敗'); end; //異なる名前のフォルダでの移動 Source := Edit1.Text+'\test\folder2copy'; Target := Edit1.Text+'\dest\folder0'; ShellMoveFolder( Self.Handle, Source, Target); if (not DirectoryExists(Source)) and DirectoryExists(Target) then begin if ((not FileExists(Source + '\eee.txt')) and FileExists(Target + '\eee.txt')) and ((not DirectoryExists(Source + '\folder3\folder5')) and DirectoryExists(Target + '\folder3\folder5')) and ((not FileExists(Source + '\folder4\fff.txt')) and FileExists(Target + '\folder4\fff.txt')) then begin ShowMessage('テスト成功'); end else begin ShowMessage('テスト失敗'); end; end else begin ShowMessage('テスト失敗'); end; //階層を深くするテスト Source := Edit1.Text+'\dest\folder0'; Target := Edit1.Text+'\dest\folder0\folder0'; //同一フォルダ内でフォルダを深くさせる場合は //以下のように一度別名でフォルダを移動させてもう一度移動する Source := Edit1.Text+'\dest\folder0'; Target := Edit1.Text+'\dest\folder3\folder0'; ShellMoveFolder( Self.Handle, Source, Target); Source := Edit1.Text+'\dest\folder3'; Target := Edit1.Text+'\dest\folder0'; ShellMoveFolder( Self.Handle, Source, Target); Source := Edit1.Text+'\dest\folder0'; Target := Edit1.Text+'\dest\folder0\folder0'; if (DirectoryExists(Target)) and DirectoryExists(Target) then begin if ((not FileExists(Source + '\eee.txt')) and FileExists(Target + '\eee.txt')) and ((not DirectoryExists(Source + '\folder3\folder5')) and DirectoryExists(Target + '\folder3\folder5')) and ((not FileExists(Source + '\folder4\fff.txt')) and FileExists(Target + '\folder4\fff.txt')) then begin ShowMessage('テスト成功'); end else begin ShowMessage('テスト失敗'); end; end else begin ShowMessage('テスト失敗'); end; //階層を浅くするテスト Source := Edit1.Text+'\dest\folder0\folder0'; Target := Edit1.Text+'\dest\folder0'; //同一フォルダ内でフォルダを浅くさせる場合は //以下のように一度別名でフォルダを移動させてもう一度移動する Source := Edit1.Text+'\dest\folder0\folder0'; Target := Edit1.Text+'\dest\folder1'; ShellMoveFolder(Application.Handle, Source, Target); ShellDeleteFolder(Application.Handle, Edit1.Text+'\dest\folder0'); Source := Edit1.Text+'\dest\folder1'; Target := Edit1.Text+'\dest\folder0'; ShellMoveFolder(Application.Handle, Source, Target); end; procedure TForm1.DeleteFolderClick(Sender: TObject); var Source, Target: String; begin// CreateTestFile.Click; DeleteOutputFolder.Click;  //Fileに対して動作しないことの確認  Source := Edit1.Text+'\test\aaa.txt'; ShellDeleteFolder( Self.Handle, Source); if FileExists(Target) or DirectoryExists(Target) then begin ShowMessage('テスト失敗'); end; Check(False, FileExists(Source)); // Check(False, DirectoryExists(Source)); //フォルダ削除 Source := Edit1.Text+'\test\folder2'; ShellDeleteFolder( Self.Handle, Source); if (not DirectoryExists(Source)) then begin ShowMessage('テスト成功'); end else begin ShowMessage('テスト失敗'); end; end; procedure TForm1.DeleteOutputFolderClick(Sender: TObject); var TargetFolder: String; begin TargetFolder := Edit1.Text + '\dest'; if DirectoryExists(TargetFolder) then begin ShellDeleteFolder(Self.Handle, TargetFolder); if DirectoryExists(TargetFolder) then begin ShowMessage('テスト失敗'); end else begin ShowMessage('テスト成功'); end; end; end; end.