みなさん、こんにちは。

NT351ではWindows95やNT4.0で使うことのできる「SHFileOperation」が使えない
のでフォルダ（ディレクトリ）まとめての移動が出来ません。
そこで作ったのが以下の関数です。

皆さんの添削をお待ちしております(^^)



//ディレクトリをディレクトリ配下に移動する
//FromDir=移動元のディレクトリ
//ToDir=移動先のディレクトリ
function MoveDirectory(FromDir,ToDir:TFileName):Boolean;
var
 FDir,TDir,NewDir,SearchPath:TFileName;
 FromFileName,ToFileName:TFileName;
 FAttr:Integer;
 FSearchRec:TSearchRec;
 FHandle:THandle;
begin
 Result := False;
 if FromDir[Length(FromDir)] = '\' then SearchPath := FromDir
 else SearchPath := FromDir + '\';
 FDir := '\'+ExtractFileName(FromDir);
 if ToDir[Length(ToDir)] = '\' then TDir := Copy(ToDir,1,Length(ToDir)-1)
 else TDir := ToDir;
 NewDir := TDir+FDir;
 if NewDir[Length(NewDir)] <> '\' then NewDir := NewDir + '\';
 if not DirectoryExists(NewDir) then
 begin
  Result := CreateDir(NewDir);
  if not Result then Exit;
 end;
 FAttr := faReadOnly or faHidden or faSysFile
       or faDirectory or faArchive or faAnyFile;
 FHandle := FindFirst(PChar(SearchPath+'*.*'),FAttr,FSearchRec);
 try
  if FHandle = 0 then
  begin
   repeat
    if (FSearchRec.Attr and faDirectory) > 0 then
    begin
     if FSearchRec.Name[1] <> '.'then
     begin
      Result := MoveDirectory(SearchPath+FSearchRec.Name,NewDir);
      if not Result then Exit;
     end;
    end else
    begin
     FromFileName := SearchPath+FSearchRec.Name;
     ToFileName := NewDir+FSearchRec.Name;
     Result := MoveFile(PChar(FromFileName),PChar(ToFileName));
     if not Result then Exit;
    end;
    Application.ProcessMessages;
    FHandle := FindNext(FSearchRec);
   until  FHandle <> 0;
   Result := RemoveDir(SearchPath);
   if not Result then Exit;
  end;
 finally
  SysUtils.FindClose(FSearchRec);
 end;
end;

{使用例:選択されたディレクトリをD:\Temp\Temp配下に移動します}
procedure TForm1.Button1Click(Sender: TObject);
var
 FDir:string;
 Ret:Boolean;
begin
 FDir := Copy(Application.ExeName,1,3)+'\Temp';
 if SelectDirectory(FDir,[],-1) then
 begin
  Screen.Cursor := crHourGlass;
  try
   Ret := MoveDirectory(FDir,'D:\Temp\Temp');
  finally
   Screen.Cursor := crDefault;
   if Ret then ShowMessage('成功') else ShowMessage('失敗');
  end;
 end;
end;


                                     98/06/08(月) 00:05 十兵衛(BZT01311)

Original document by 十兵衛          氏 ID:(BZT01311)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。