Проблема Как заставить изменять файлы в подпапках

[Andreo Fadio]

Есть такой пример изменения даты файлов:

[Code]
const
  OPEN_EXISTING = 3; 
  FILE_SHARE_WRITE = 2;
  GENERIC_WRITE = $40000000;
  INVALID_HANDLE_VALUE = 4294967295;

function CreateFile(lpFileName: string; dwDesiredAccess, dwShareMode,
  lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes: DWORD;
  hTemplateFile: THandle): THandle;
  external 'CreateFile{#A}@kernel32.dll stdcall';
function CloseHandle(hObject: THandle): BOOL;
  external 'CloseHandle@kernel32.dll stdcall';
function SetFileTime(hFile: THandle; const lpCreationTime, lpLastAccessTime,
  lpLastWriteTime: TFileTime): BOOL;
  external 'SetFileTime@kernel32.dll stdcall';

function FileSetTime(const AFileName: string; const ACreationTime,
  ALastAccessTime, ALastWriteTime: TFileTime): Boolean;
var
  FileHandle: THandle;
begin
  Result := False;
  FileHandle := CreateFile(AFileName, GENERIC_WRITE, FILE_SHARE_WRITE, 0,
    OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  if FileHandle <> INVALID_HANDLE_VALUE then
  try
    Result := SetFileTime(FileHandle, ACreationTime, ALastAccessTime,
      ALastWriteTime);
  finally
    CloseHandle(FileHandle);
  end;
end;

procedure ModifyLastWriteTime(const ASourceFile, ATargetFolder: string);
var
  FindRec: TFindRec;
  LastWriteTime: TFileTime;
begin
  if FindFirst(ASourceFile, FindRec) then
  begin
    LastWriteTime := FindRec.LastWriteTime;
    if FindFirst(ATargetFolder + '*.*', FindRec) then
    try
      repeat
        if (FindRec.Attributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
          FileSetTime(ATargetFolder + FindRec.Name, FindRec.CreationTime,
            FindRec.LastAccessTime, LastWriteTime);
      until
        not FindNext(FindRec);
    finally
      FindClose(FindRec);
    end;
  end;
end;

//--------
// ModifyLastWriteTime('c:\SourceFile.xxx', 'c:\TargetFolder\')
//--------

Подскажите что поменять, чтобы обрабатывать файлы в подпапках

 

[sergey3695]

Спойлер

[Setup]
AppName=My Program
AppVerName=My Program v 1.5
DefaultDirName={pf}\My Program
OutputDir=.

[Languages]
Name: rus; MessagesFile: compiler:Languages\Russian.isl

[Code]
var
  // задаём переменную глобально, для всего скрипта
  Mask: string;

procedure RunMyProg(FileNeme: string);
begin
  // здесь что нибудь делаем с найденым файлом
  MsgBox(FileNeme, mbInformation, MB_OK );
end;

function FindFile(Path: string): Boolean;
var
  FSR, DSR: TFindRec;
  FindResult: Boolean;
begin
  Result:= False;
  if Path[Length(Path)] <> '\' then Path:= Path + '\';
  FindResult:= FindFirst(Path + Mask, FSR);
  try
    while FindResult do
      begin
        if FSR.Attributes and FILE_ATTRIBUTE_DIRECTORY = 0 then
          begin
            RunMyProg(Path + FSR.Name);
            //Result:= True;
            //Exit;
          end;
        FindResult:= FindNext(FSR);
      end;
    FindResult:= FindFirst(Path + '*.*', DSR);
    while FindResult do
      begin
        if ((DSR.Attributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) and
          not ((DSR.Name = '.') or (DSR.Name = '..')) then
         FindFile(Path + DSR.Name);
        FindResult:= FindNext(DSR);
      end;
  finally
    FindClose(FSR);
    FindClose(DSR);
  end;
end;

function InitializeSetup(): Boolean;
var
  i: Integer;
  ArrayOfMask: TArrayOfString;
  StartFolder: string;
begin
  StartFolder:= ExpandConstant('E:\Новая папка (2)'); // задаём папку откуда начинать поиск
  ArrayOfMask:= ['*.*']; // заполняем массив масок для поиска
//  ArrayOfMask:= ['*n*.txt', 'R*.txt', '*m*.txt']; // заполняем массив масок для поиска
  for i:= 0 to GetArrayLength(ArrayOfMask)-1 do // перебираем весь масив масок
    begin
      Mask:= ArrayOfMask[i];
      if FindFile(StartFolder) then Break;
    end;
end;

Andreo Fadio, в RunMyProg вместо MsgBox, добавишь FileSetTime ну или в тело, где вызывается RunMyProg и будет работать. проверять не хочу )

 

[LexBell]

if (FindRec.Attributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
          FileSetTime(ATargetFolder + FindRec.Name, FindRec.CreationTime,
            FindRec.LastAccessTime, LastWriteTime)
else
ModifyLastWriteTime(ASourceFile, FindRec.Name);

так, вроде? Просто добавить рекурсивный вызов, если найдена папка. заодно перед вызовом стоит проверить, что это не папка вверх, и не текущая папка.

 

[Andreo Fadio]

LexBell, нет оно так не сработает, вылетает ошибка установки.
Идеально вписался подправленный пример от sergey3695

 

[LexBell]

LexBell, нет оно так не сработает, вылетает ошибка установки.
Идеально вписался подправленный пример от sergey3695

А я и не проверял, сказал- же, нужно ещё проверку добавлять, чтобы не пыталось в вышестоящие папки лезть. Конечно ошибка будет когда рекурсия поднимется выше диска. Вы пытаетесь вникнуть в код, который вам дают, или просто копируете и пользуетесь, не заморачиваюсь ненужными мелочами? Такими, например, как попытка понять - почему код работает или наоборот, не работает?

if ((DSR.Attributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) and
          not ((DSR.Name = '.') or (DSR.Name = '..')) then

собственною ((DSR.Name = '.') or (DSR.Name = '..'))

 

[Andreo Fadio]

Вы пытаетесь вникнуть в код, который вам дают, или просто копируете и пользуетесь, не заморачиваюсь ненужными мелочами?

Если бы просто копировал и пользовался, то бы и не смог бы использовать по назначению и поменять под то что в итоге нужно.
(Разбираюсь, но недостаточно хорошо).
Так что давай-те не будем говорить и судить про то 'что точно' не знаем.

 

[sergey3695]

Andreo Fadio, а давай-те, я закрою тему.