'••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
' Изменение дат и времени выбранных файлов и папок одной панели на дату и время
' элемента другой панели с возможностью рекурсивной обработки содержимого папок
' Условие: необходим компонент TCScript.dll
' Параметры: %d <актив./пассив. панель: A/P> <индекс замены> <флаг рекурсии: 1>
' Выбор панели определяет, где будет находиться текущий объект-источник.
' Соответственно, в другой панели должны быть выбраны изменяемые объекты.
' Индекс замены принимает следующие значения:
' 1 - даты создания
' 2 - даты модификации
' 3 - даты последнего открытия
' 4 - даты создания и модификации
' 5 - даты создания и последнего открытия
' 6 - даты модификации и последнего открытия
' 7 - даты модификации, создания и последнего открытия
' Примеры параметров: %d P 2 | %d A 7 | %d P 4 1
'••••••••••••••••••••••••••••••••••••••••••••••••••••••••• Автор: Flasher © •••
Option Explicit
Dim Title, C, Panel, Count, Rec, FSO, TCH, F, List, DC, DM, DA, D, T
With WSH.Arguments
Title = " Изменение атрибутов": C = .Count: If C = 0 Then WSH.Quit
Panel = .Item(1) : Count = .Item(2) : If C = 4 Then Rec = .Item(3)
End With : If Not IsNumeric(Count) Or (Count < 1 Or Count > 7) Then _
MsgBox "Недопустимый индекс замены!"&vbCr&vbCr&"Смотрите описание.",_
4144, Space(30) & "Ошибка", Title : WSH.Quit
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TCH = CreateObject("TCScript.Helper") : TCH.Pause = 0
Select Case Panel
Case "A" F = TCH.GetSrcPath & TCH.GetInfo("SN") : List = TCH.GetTrgSelectedFiles(1)
Case "P" F = TCH.GetInfo("TP") & TCH.GetInfo("TN") : List = TCH.GetSrcSelectedFiles(1)
End Select : If F = "" Or Right(F, 1) = "\" Then WSH.Quit
If FSO.FileExists(F) Then Set F = FSO.GetFile(F) Else Set F = FSO.GetFolder(F)
If InStr("1457", Count) Then DC = "CDate(""" & F.DateCreated & """)"
If InStr("2467", Count) Then DM = ",""" & F.DateLastModified & """"
If InStr("3567", Count) Then DA = ",""" & F.DateLastAccessed & """"
If IsEmpty(DM) And Len(DA) Then DA = "," & DA
D = DC & DM & DA : Set F = Nothing
For Each F In List
If FSO.FolderExists(F) Then
FFile F : If Rec = 1 Then T = 1 : Set F = FSO.GetFolder(F) : FFolder F
ElseIf FSO.FileExists(F) Then FFile F End If
Next
With CreateObject("WScript.Shell")
If T Then .Popup " Выполнено!", 2, Title & " ", 4160 Else .SendKeys "^r"
End With
Sub FFolder(Fd)
For Each Fl In Fd.Files : FFile Fl : Next
Dim Fl : For Each Fl In Fd.SubFolders : FFile Fl : FFolder Fl : Next
End Sub : Sub FFile(I) : Execute "TCH.SetFileDateAtr CStr(I)," & D End Sub |
