こんにちは、Tiny Mouse です。

　FileSetDate() では、フォルダのタイムスタンプは変更できません。フォルダの
タイムスタンプも変更できる関数を用意しました。
　95 系では、PC の時計を一時的に変えてフォルダを作成するという荒技を使って
いますので、乱用すると PC の時計が遅れるかも (^^; 。一時フォルダの名前は横
着しています。GetTempFileName() を使うべきでしょうね。

　NT 系でも動作確認しています。

{------------------------------------------------------------------------}

interface

uses
  Windows, SysUtils, Classes, FileCtrl;

function FileSetAge(Path: String; Age: Integer): Integer;

implementation

{ ファイル/フォルダのタイムスタンプを設定する }

function FileSetAge(Path: String; Age: Integer): Integer;

  function SetFileAge(Path: String; Age: Integer): Integer;
  var
    fh: Integer;
  begin
    try
      fh := FileOpen(Path, fmOpenWrite);
      Result := FileSetDate(fh, Age);
    finally
      FileClose(fh);
    end;
  end;

  function SetFolderAgeForNT(Path: String; Age: Integer): Integer;
  var
    fh: Integer;
  begin
    try
    fh := CreateFile(PChar(ExcludeTrailingBackslash(Path)),
        GENERIC_WRITE,
        FILE_SHARE_WRITE,
        nil,
        OPEN_EXISTING,
        FILE_FLAG_BACKUP_SEMANTICS,
        0);
      Result := FileSetDate(fh, Age);
    finally
       CloseHandle(fh);
    end;
  end;

  function SetFolderAgeFor95(Path: String; Age: Integer): Integer;
  var
    NowTime, SystemTime: TSystemTime;
    LocalFileTime, FileTime: TFileTime;
    TempPath: String;
    SearchRec: TSearchRec;
  begin
    Path := ExcludeTrailingBackslash(Path);
    try
      try
        { PC の時計を一時的に変更 }
        GetSystemTime(NowTime);
        DosDateTimeToFileTime(LongRec(Age).Hi, LongRec(Age).Lo, LocalFileTime);
        LocalFileTimeToFileTime(LocalFileTime, FileTime);
        FileTimeToSystemTime(FileTime, SystemTime);
        SetSystemTime(SystemTime);
        { 一時フォルダを作成 }
        TempPath := Path + '.tmp';
        ForceDirectories(TempPath);
      finally
        { PC の時計を元に戻す }
        SetSystemTime(NowTime);
      end;
      { 指定されたフォルダ内の全てのファイルを一時フォルダへ移動 }
      if FindFirst(Path + '\*.*', faAnyFile, SearchRec) = 0 then
      begin
        repeat
          RenameFile(Path + '\' + SearchRec.Name, 
            TempPath + '\' + SearchRec.Name);
        until FindNext(SearchRec) <> 0;
        FindClose(SearchRec);
      end;
      { 元のフォルダを削除し一時フォルダを元のフォルダにリネーム }
      RemoveDir(Path);
      RenameFile(TempPath, Path);
      Result := 0;
    except
      Result := -1;
    end;
  end;

begin
  if (FileGetAttr(Path) and faDirectory) = 0 then
  begin
    Result := SetFileAge(Path, Age);
  end
  else
  begin
    if SetFolderAgeForNT(Path, Age) = 0 then
      Result := 0
    else
      Result := SetFolderAgeFor95(Path, Age);
  end;
end;

    ◆◆ KHC04052 : http://member.nifty.ne.jp/tinymouse/ : Tiny Mouse ◆◆

 


Original document by Tiny Mouse      氏 ID:(KHC04052)

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