unit ShellFileCtrl;

(*----------------------------------------
シェルファイルコントロールユニット
2011/10/03(月)
・ShellAPIをusesしたくないため
  GetFileTypeName関数をFileUnitから移動した。
//----------------------------------------*)

interface

uses
  SysUtils,
  Classes,
  Windows,
  ShellAPI,

  StringUnit,
end_uses;

function ShellCopyFile(hParent: HWND; FromFilePath, ToFilePath: String):Boolean;
function ShellMoveFile(hParent: HWND; FromFilePath, ToFilePath: String):Boolean;
function ShellDeleteFile(hParent: HWND; FileName: String):Boolean;
function ShellMoveFileToRecycleBin(hParent: HWND; FileName: String):Boolean;

function ShellCopyAllFiles(hParent: HWND; FromFolderPath, ToFolderName: String):Boolean;
function ShellMoveAllFiles(hParent: HWND; FromFolderPath, ToFolderName: String):Boolean;
function ShellDeleteAllFiles(hParent: HWND; FolderPath: String):Boolean;
function ShellMoveAllFilesToRecycleBin(hParent: HWND; FolderPath: String):Boolean;

function ShellCopyFolder(hParent: HWND; FromFolderPath, ToFolderPath: String):Boolean;
function ShellMoveFolder(hParent: HWND; FromFolderPath, ToFolderPath: String):Boolean;
function ShellDeleteFolder(hParent: HWND; FolderPath: String):Boolean;
function ShellMoveFolderToRecycleBin(hParent: HWND; FolderPath: String):Boolean;

function GetFileTypeName(FileName: String): String;

implementation

//SHFileOperationで使える形式の複数ファイル指定を行う関数
function GetOperationFilesName(Files: TStrings): String;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to Files.Count-1 do
  begin
    Result := Result + Files[i] + #0
  end;
  if Result <> '' then
  begin
    Result := Result + #0;
  end;
end;

//文字列の最後を#0#0とする関数
function SetDoubleNullLastChar(s: String): String;
begin
  if 2 <= Length(s) then
  begin
    if s[Length(s)] = #0 then
    begin
      if s[Length(s)-1] = #0 then
      begin
        Result := s;
      end else
      begin
        Result := s + #0;
      end;
    end else
    begin
      Result := s + #0#0;
    end;
  end else
  if 1 = Length(s) then
  begin
    if s[1] = #0 then
    begin
      Result := s + #0;
    end else
    begin
      Result := s + #0#0;
    end;
  end else
  begin
    Result := #0#0;
  end;
end;

function ShellFileOperation(hParent:HWND; FromName, ToName: String;
 Func: UINT; Flags: FILEOP_FLAGS): Boolean;
var
  SFO: TSHFileOpStruct;
begin
  FromName := SetDoubleNullLastChar(FromName);
  ToName := SetDoubleNullLastChar(ToName);
  with SFO do begin
    Wnd := hParent;
    wFunc := Func;
    pFrom := PChar(FromName);
    if Func = FO_DELETE then
      pTo := nil
    else
      pTo := PChar(ToName);
    fFlags := Flags;
    fAnyOperationsAborted := false;
        //処理が終了する前にユーザーが中断させた場合にTRUEが返される
    hNameMappings := nil;
        //fFlagsがFOF_WANTMAPPINGHANDLEを含む時使用され、
        //TSHNameMapping構造体（後述）の配列を含むファイルネームマッピングオブジェクトのハンドル
    lpszProgressTitle := nil;
        //fFlagsがFOF_SIMPLEPROGRESSを含む時使用され、
        //進捗ダイアログボックスのタイトル文字列へのポインタ
  end;
  Result := SHFileOperation(SFO) = 0;
end;
(*----------------------------------------
指定フラグは、ShellAPI.pasに存在する

wFunc に指定する値
  FO_MOVE           = $0001;
  FO_COPY           = $0002;
  FO_DELETE         = $0003;
  FO_RENAME         = $0004;  実際にはRenameは使わないと思う

fFlags に指定する値、orで複数指定可能
  FOF_MULTIDESTFILES         = 0001;
    pTo に複数ファイルを設定するときに指定する

  FOF_CONFIRMMOUSE           = 0002;    
    設定不可|未実装

  FOF_SILENT                 = 0004;  
    プログレス(進捗)ダイアログボックスを表示しない

  FOF_RENAMEONCOLLISION      = 0008;
    既に同じファイル名が存在する場合
    「のコピー」という新しいファイル名を与える

  FOF_NOCONFIRMATION         = 0010;  
    確認なしの設定。
    確認ダイアログに「すべてはい」や「はい」と
    自動的に答えるのと同じ。
  
  FOF_WANTMAPPINGHANDLE      = 0020;
    不明

  FOF_ALLOWUNDO              = 0040;
    UNDO情報を持たせて動作する。
    削除時にこれを指定しておくとゴミ箱に削除される動作になる。

  FOF_FILESONLY              = 0080;  
    ワイルドカード（*.*）が指定された場合にのみ有効。
    ファイルに対してだけ操作を行う。

  FOF_SIMPLEPROGRESS         = 0100;  
    ファイル名表示のない進捗ダイアログボックスを表示する。

  FOF_NOCONFIRMMKDIR         = 0200;  
    新しいディレクトリを作る必要があるときに
    問い合わせ無しに自動的に作成

  FOF_NOERRORUI              = 0400;  
    エラーUIを表示しない

//----------------------------------------*)

//スペースを含むファイル名でもクウォートで囲う必要はない。
function ShellCopyFile(hParent: HWND; FromFilePath, ToFilePath: String):Boolean;
begin
  Result := False;
  if FileExists(FromFilePath) then
  begin
    Result := ShellFileOperation(hParent, FromFilePath, ToFilePath, FO_COPY,
      FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR);
  end;
{----------------------------------------
※or FOF_NOCONFIRMMKDIR or FOF_NOERRORUIとすると
  コピー時にフォルダを作成してくれないので
  FOF_SILENT や
  FOF_NOERRORUIはいれなくてよい
//----------------------------------------}
end;

function ShellMoveFile(hParent: HWND; FromFilePath, ToFilePath: String):Boolean;
begin
  Result := False;
  if FileExists(FromFilePath) then
  begin
    Result := ShellFileOperation(hParent, FromFilePath, ToFilePath, FO_MOVE,
      FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR);
  end;
end;

function ShellDeleteFile(hParent: HWND; FileName: String):Boolean;
begin
  Result := False;
  if FileExists(FileName) then
  begin
    Result := ShellFileOperation(hParent, FileName, '', FO_DELETE,
      FOF_NOCONFIRMATION);
  end;
end;

function ShellMoveFileToRecycleBin(hParent: HWND; FileName: String):Boolean;
begin
  Result := False;
  if FileExists(FileName) then
  begin
    Result := ShellFileOperation(hParent, FileName, '', FO_DELETE,
      FOF_NOCONFIRMATION or FOF_ALLOWUNDO);
  end;
end;

////////////////////////////////////////////////////////////////////////////////

function ShellCopyAllFiles(hParent: HWND; FromFolderPath, ToFolderName: String):Boolean;
begin
  Result := False;
  if DirectoryExists(FromFolderPath) then
  begin
    FromFolderPath := IncludeLastPathDelim(FromFolderPath) + '*.*';
    Result := ShellFileOperation(hParent, FromFolderPath, ToFolderName, FO_COPY,
      FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR);
  end;
{----------------------------------------
※or FOF_NOCONFIRMMKDIR or FOF_NOERRORUIについて
  ShellCopyFileと同じ注意。
//----------------------------------------}
end;

function ShellMoveAllFiles(hParent: HWND; FromFolderPath, ToFolderName: String):Boolean;
begin
  Result := False;
  if DirectoryExists(FromFolderPath) then
  begin
    FromFolderPath := IncludeLastPathDelim(FromFolderPath) + '*.*';
    Result := ShellFileOperation(hParent, FromFolderPath, ToFolderName, FO_MOVE,
      FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR);
  end;
end;

function ShellDeleteAllFiles(hParent: HWND; FolderPath: String):Boolean;
begin
  Result := False;
  if DirectoryExists(FolderPath) then
  begin
    FolderPath := IncludeLastPathDelim(FolderPath) + '*.*';
    Result := ShellFileOperation(hParent, FolderPath, '', FO_DELETE,
      FOF_NOCONFIRMATION);
  end;
end;

function ShellMoveAllFilesToRecycleBin(hParent: HWND; FolderPath: String):Boolean;
begin
  Result := False;
  if DirectoryExists(FolderPath) then
  begin
    FolderPath := IncludeLastPathDelim(FolderPath) + '*.*';
    Result := ShellFileOperation(hParent, FolderPath, '', FO_DELETE,
      FOF_NOCONFIRMATION or FOF_ALLOWUNDO);
  end;
end;

////////////////////////////////////////////////////////////////////////////////

function ShellCopyFolder(hParent: HWND; FromFolderPath, ToFolderPath: String):Boolean;
begin
  Result := False;
  if DirectoryExists(FromFolderPath) then
  begin
    Result := ShellFileOperation(hParent, FromFolderPath, ToFolderPath, FO_COPY,
      FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR);
  end;
end;

function ShellMoveFolder(hParent: HWND; FromFolderPath, ToFolderPath: String):Boolean;
begin
  Result := False;
  if DirectoryExists(FromFolderPath) then
  begin
    Result := ShellFileOperation(hParent, FromFolderPath, ToFolderPath, FO_MOVE,
      FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR);
  end;
{----------------------------------------
ToFilePathフォルダがすでに存在している場合は
...\ToFolderPath\FromFolderPath と中に入ってしまうことになるので注意。
//----------------------------------------}  
end;

function ShellDeleteFolder(hParent: HWND; FolderPath: String):Boolean;
begin
  Result := False;
  if DirectoryExists(FolderPath) then
  begin
    Result := ShellFileOperation(hParent, FolderPath, '', FO_DELETE,
      FOF_NOCONFIRMATION);
  end;
end;

function ShellMoveFolderToRecycleBin(hParent: HWND; FolderPath: String):Boolean;
begin
  Result := False;
  if DirectoryExists(FolderPath) then
  begin
    Result := ShellFileOperation(hParent, FolderPath, '', FO_DELETE,
      FOF_NOCONFIRMATION or FOF_ALLOWUNDO);
  end;
end;


{-------------------------------
//  ファイルの種類を取得する
戻り値:     エクスプローラで表示されるファイルの"種類"
備考:
履歴:       2004/08/18
//--▼----------------------▽--}
function GetFileTypeName(FileName: String): String;
var
  SHFinfo: TSHFileInfo; //uses ShellAPI
begin
  Result := '';

  SHGetFileInfo( PChar(FileName),0,
                 SHFinfo, SizeOf(SHFinfo), SHGFI_TYPENAME);
  Result := SHFinfo.szTypeName;
end;
//--△----------------------▲--

end.