Выделение всех файлов с той же датой что и файл под курсором

[Bomm]

Вопрос к скриптописателям:
Какой скрипт (если это возможно) надо написать для выделения всех файлов с той же датой, что и файл под курсором

[Вахмурка]

Это возможно.
Если бы оно мне было нужно, я бы взял PowerPro (любая ссылка под постом). Алгоритм:
1. Скрипт запускается с параметрами %Р, %N.
2. Через file.getdate берется его дата.
3. Через file.listfiles составляется список.
4. Затем он просмотривается пофайлово, тем же способом анализируются даты.
5. Через win.sendmessage в QuickSearchWindow осуществляется переход к каждому из этих файлов и посылается команда на выделение.
(Мне скажут, что лучше выделить файлы последовательно - это быстрее. Я соглашусь, если обеспечена сортировка по дате. Можно вначале выдать оную команду - все зависит от задачи).
Желаю успехов.

[Bomm]

Вахмурка
Спасибо, попробую посмотреть...

[Bomm]

Никто не напишет скрипт без PowerPro ?
Я так и не собрался поставить его и разобраться (((

[sa]

Bomm
Вот, набросал что-то на базе скрипта от Volniy.

Код: Выделить всё

'===============================================================
' Описание:   Выделяет файлы с датой/временем файла под курсором
' Параметр:   %P%N
' Требования: Необходима регистрация WSH Helper for TC by Volniy
'===============================================================
Option Explicit
Dim List, TCS, Cnt, Buf, CurDir, FSO, Date, DateLen, TextClip 
'============ Количество символов, учтываемых в дате/времени ===
DateLen = 8
'===============================================================
If WScript.Arguments.Count < 1 Then 
  MsgBox "Не указан параметр %P%N", vbOKOnly + vbCritical, "Внимание!"
  WScript.Quit
End If
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(WScript.Arguments(0)) Then 
  Set TCS = CreateObject("TCScript.Helper")
  With TCS
    .LockTC True
    TextClip = .GetTextFromClip 
    Date = Left(FSO.GetFile(WScript.Arguments(0)).DateLastModified, DateLen)
'    MsgBox "Дата: " & Date, vbInformation, "Информация"
    .SendCommand "cm_ClearAllFolders", True
    .SendCommand "cm_SelectAllFiles", True
    CurDir = .GetSrcPath
    .SendCommand "cm_CopyFullNamesToClip", True
    List = Split(.GetTextFromClip,vbNewLine)
    For Cnt=LBound(List) To UBound(List)
      If Left(FSO.GetFile(List(CNT)).DateLastModified, DateLen) = Date Then
         If Len(CurDir) = 0 Then
            Buf = Buf & List(Cnt) & vbNewLine
         Else
            Buf = Buf & Mid(List(Cnt), Len(CurDir) +2) & vbNewLine
         End If
      End If
    Next
    .SetTextToClip CStr(Buf)
    .SendCommand "cm_LoadSelectionFromClip", True
'    .GetSrcSelectedFiles
'    MsgBox "Выделено файлов с датой файла под курсором: " & _ 
'       (UBound(.GetSrcSelectedFiles) +1) & "." , vbInformation, "Завершено!"
    .SetTextToClip(TextClip)
    .LockTC False
  End With  
  Set TCS = Nothing
Else
  MsgBox "Надо указать файл!", vbOKOnly + vbExclamation,"Внимание!"
End If
Set FSO = Nothing
WScript.Quit

[Flasher]

Bomm
В этом скрипте поменять параметр %N на %V, под

Код: Выделить всё

Set FSO = CreateObject("Scripting.FileSystemObject")

вставить

Код: Выделить всё

DateF = DateValue(FSO.GetFile(N).DateLastModified)

вместо

Код: Выделить всё

    If Len(FSO.GetFileName(F)) = Len(FSO.GetFileName(N)) Then

это:

Код: Выделить всё

    If FSO.FileExists(F) Then Set Fl = FSO.GetFile(F) Else Set Fl = FSO.GetFolder(F)
    If DateF = DateValue(Fl.DateLastModified) Then

[prog_san]

Стоит задача: выделить в папке все файлы одного дня с текущим. Каким путем стоит решать? День не сегодняшний - поиск "не старше чем" не проходит. А как в диалог поиска дату указанного файла подставить - для меня загадка.

[Flasher]

prog_san
Создать шаблон 'Не сегодняшние". Создать команду: em_cd: cd: %A

TCFS2.exe /ef msg($0B,0) tem(`em_cd >Не сегодняшние`) tcm(3302) tcm(530) tcm(312) msg($0B,1) tcm(529)

[prog_san]

Создать шаблон 'Cегодняшние"

Файл имеет дату отличную от сегодняшней

[Flasher]

Поправил название. Есть опция "Старше | 1 | дня".
А подобный пример я приводил когда-то здесь.
Можно ещё всякие переключалки окраски делать.

[prog_san]

Спасибо! Понял

[Flasher]

Блин. Я не понял, в каком месте правда?

выделить в папке все файлы одного дня с текущим

День не сегодняшний

[prog_san]

Одного дня с текущим выделенным файлом

То, что получилось - не выполняет первоначальной задачи. Требовалось выделить файлы которые имеют ту же дату что и текущий файл под курсором

[Flasher]

А. Тогда через скрипт.

Требовалось выделить файлы которые имеют ту же дату что и текущий файл под курсором

Зачем два раза разжёвывать неточное ТЗ? Уже всё ясно.

Вот:

Код: Выделить всё

'============================== VBS ==============================
' Выделение файлов/каталогов по дате файла/каталога под курсором
' Требуется dll-компонент "Script Helper ActiveX for TC by Volniy"
' Параметр: <дата создания/модификации/последнего доступа: 1/2/3>
'=================================================================
Option Explicit: Dim FSO, N, P, L, Item, X, Y, T, D, F
Sub MsgErr
  MsgBox "Укажите 1, 2 или 3 в качестве параметра!",_
  4144, " Выделение элементов" : WScript.Quit
End Sub : If WScript.Arguments.Count = 0 Then MsgErr
Set FSO = CreateObject("Scripting.FileSystemObject")
With CreateObject("TCScript.Helper")
  .Pause = 0   : N = .GetInfo("SN") : If N = ".." Then WScript.Quit
  .Wait = True : P = .GetInfo("SP") : L = Len(P) + 1 : Item = P & N
  Select Case True
    Case FSO.FileExists(Item)   X = 2 : Y = "File"
    Case FSO.FolderExists(Item) X = 3 : Y = "Folder"
    Case Else WScript.Quit
  End Select : T = .GetTextFromClip
  Select Case WScript.Arguments(0)
    Case "1" D = "Created" : Case "2" D = "LastModified"
    Case "3" D = "LastAccessed" : Case Else MsgErr
  End Select
  Execute "DateFl = DateValue(FSO.Get" & Y & "(Item).Date" & D & ")"
  .LockTC True : .SendCommand 524, True : .SendCommand 330 & X, True
  For Each F In .GetSrcSelectedFiles(1)
    Execute "If DateValue(FSO.Get" & Y & "(F).Date" &_
    D & ") = DateFl Then S = S & vbNewLine & Mid(F, L)"
  Next :.SetTextToClip(Mid(S, 3)): .SendCommand 2033, True
  .LockTC False : .SetTextToClip(T)
End With

[sa]

prog_san
Ещё такая тема была.