1 (изменено: madjahed, 2012-11-18 17:22:43)

Тема: HTA: Копирование новых файлов

Есть скрипт vbs, который копирует измененные с определенной даты и более новые файлы из одной папки в другую. вот он:

' каталог, откуда копируем
InitialFolder = "C:\Documents and Settings\User\Рабочий стол\ActiveX desktop" 
' каталог, куда копируем
TargetFolder = "C:\Documents and Settings\User\Рабочий стол\1" 
' контрольная дата (копируем файлы с датой создания/изменения позже этой)
ControlDate = CDate("17.11.2012") 

On Error Resume Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShellApp = CreateObject("Shell.Application")
LogPath = objFSO.GetParentFolderName(WScript.ScriptFullName)
Set LogStream = objFSO.OpenTextFile(LogPath & "\CopyLog.log", 8, True)
LogStream.WriteLine "Начало копирования " & Now()
CopyFiles InitialFolder
LogStream.WriteLine "Конец копирования: " & Now()
LogStream.Close
' процедура рекурсивно перебирает файлы в каталоге
Sub CopyFiles(FolderPath)
    On Error Resume Next
    Set objFolderItems = objShellApp.NameSpace(FolderPath).Items()
    For Each objFolderItem In objFolderItems
        If objFolderItem.IsFolder And LCase(Right(objFolderItem.Name, 4)) <> ".zip" Then
            CopyFiles objFolderItem.Path
        Else
            Set objFile = objFSO.GetFile(objFolderItem.Path)
          ' If objFile.DateCreated > ControlDate Then
            If objFile.DateLastModified > ControlDate Then
                CopyFile objFolderItem.Path
            End If
        End If
    Next
End Sub
' процедура копирует файл
Sub CopyFile(FilePath)
    On Error Resume Next
    SubPath = Mid(FilePath, Len(InitialFolder) + 1)
    TargetPath = TargetFolder & SubPath
    FolderPath = objFSO.GetParentFolderName(TargetPath)
    If Not objFSO.FolderExists(FolderPath) Then
        CreateFolder FolderPath
    End If
    ' если у файла назначения есть атрибут ReadOnly, снимаем его
    If objFSO.FileExists(TargetPath) Then
        Set objFile = objFSO.GetFile(TargetPath)
        If objFile.Attributes And 1 Then
            objFile.Attributes = objFile.Attributes - 1
        End If
    End If
    objFSO.CopyFile FilePath, TargetPath, True
    If Err.Number <> 0 Then
        LogStream.WriteLine
        LogStream.WriteLine FilePath
        LogStream.WriteLine Err.Description
        LogStream.WriteLine
        Err.Clear
    Else
        LogStream.WriteLine TargetPath
    End If
End Sub
' процедура создаёт каталог
Sub CreateFolder (FolderPath)
    On Error Resume Next
    ParentFolder = objFSO.GetParentFolderName(FolderPath)
    If Not objFSO.FolderExists(ParentFolder) Then
        CreateFolder ParentFolder
    End If
    objFSO.CreateFolder FolderPath
End Sub

Но этот скрипт нужно постоянно редактировать чтобы указать другие папки или дату.
По этому захотел переделать его в hta - что бы пути к папкам и дату можно было бы указывать при запуске
Вот что вышло:

<html>
<head>
<meta charset="windows-1251">
<title>Удаление файлов по расширениям</title>
<hta:application id="oHTA"
  applicationname="myApp"
  border="thin"
  borderstyle="normal"
  caption="yes"
  contextmenu="yes"
  icon="webpage.ico"
  innerborder="yes"
  maximizebutton="no"
  minimizebutton="yes"
  navigable="no"
  scroll="no"
  scrollflat="no"
  selection="no"
  showintaskbar="yes"
  singleinstance="yes"
  sysmenu="yes"
  version="1.0"
  windowstate="normal"
/>
<style type="text/css">
  body {background:#ddd}
  body {font:8pt/10pt Verdana; color:#000}
  div.prompt {margin: 5 18}
  div.input {text-align:center}
  </style>
</head>
<body>
  <div class="prompt">
    Укажите папку-источник. <br>
    Например, C:\Windows
  </div>
  <div class="input">
    <input id="InitialFolder" type="text" size=70>
  </div>
  <div class="prompt">
    Укажите папку для сохранения копии. <br>
    Например, D:\Backup
  </div>
  <div class="input">
    <input id="TargetFolder" type="text" size=70>
  </div>
  <div class="prompt">
    Укажите дату изменения файлов. <br>
    Например, 15.10.2012
  </div>
  <div class="input">
    <input id="ControlDate" type="text" size=10>
  </div>
<br><br>
  <div class="input">
    <input type="button" value="Синхронизировать" onclick="CopyFiles()"> &nbsp; &nbsp;
    <input type="button" value="Отмена" onclick="window.close()">
  </div>
  <script language="VBScript">

'InitialFolder каталог, откуда копируем 
'TargetFolder каталог, куда копируем
'ControlDate контрольная дата (копируем файлы с датой изменения позже этой)

On Error Resume Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShellApp = CreateObject("Shell.Application")
LogPath = objFSO.GetParentFolderName(WScript.ScriptFullName)
Set LogStream = objFSO.OpenTextFile(LogPath & "\CopyLog.log", 8, True)
LogStream.WriteLine "Начало копирования " & Now()
CopyFiles InitialFolder
LogStream.WriteLine "Конец копирования: " & Now()
LogStream.Close
' процедура рекурсивно перебирает файлы в каталоге
Sub CopyFiles(FolderPath)
    On Error Resume Next
    Set objFolderItems = objShellApp.NameSpace(FolderPath).Items()
    For Each objFolderItem In objFolderItems
        If objFolderItem.IsFolder And LCase(Right(objFolderItem.Name, 4)) <> ".zip" Then
            CopyFiles objFolderItem.Path
        Else
            Set objFile = objFSO.GetFile(objFolderItem.Path)
          ' If objFile.DateCreated > ControlDate Then
            If objFile.DateLastModified > ControlDate Then
                CopyFile objFolderItem.Path
            End If
        End If
    Next
End Sub
' процедура копирует файл
Sub CopyFile(FilePath)
    On Error Resume Next
    SubPath = Mid(FilePath, Len(InitialFolder) + 1)
    TargetPath = TargetFolder & SubPath
    FolderPath = objFSO.GetParentFolderName(TargetPath)
    If Not objFSO.FolderExists(FolderPath) Then
        CreateFolder FolderPath
    End If
    ' если у файла назначения есть атрибут ReadOnly, снимаем его
    If objFSO.FileExists(TargetPath) Then
        Set objFile = objFSO.GetFile(TargetPath)
        If objFile.Attributes And 1 Then
            objFile.Attributes = objFile.Attributes - 1
        End If
    End If
    objFSO.CopyFile FilePath, TargetPath, True
    If Err.Number <> 0 Then
        LogStream.WriteLine
        LogStream.WriteLine FilePath
        LogStream.WriteLine Err.Description
        LogStream.WriteLine
        Err.Clear
    Else
        LogStream.WriteLine TargetPath
    End If
End Sub
' процедура создаёт каталог
Sub CreateFolder (FolderPath)
    On Error Resume Next
    ParentFolder = objFSO.GetParentFolderName(FolderPath)
    If Not objFSO.FolderExists(ParentFolder) Then
        CreateFolder ParentFolder
    End If
    objFSO.CreateFolder FolderPath
End Sub
  </script>
</body>
</html>

Никаких ошибок при запуске не выдает, но и не работает
Подскажите, где ошибка.

2 (изменено: Rom5, 2012-11-18 19:35:40)

Re: HTA: Копирование новых файлов

madjahed пишет:

Есть скрипт vbs, который копирует измененные с определенной даты и более новые файлы из одной папки в другую.
[...]
Но этот скрипт нужно постоянно редактировать чтобы указать другие папки или дату.

По поводу "правки" vbs-скрипта для смены исходных данных - лучше сразу добавляйте в начало скрипта обработку полученных параметров, т.е., например, если параметров не было - работаете со своими значениями по-умолчанию, а, если были, то заносите эти параметры в свои переменные. При желании в начале скрипта установленные переменные подтверждаете/корректируете и можете даже прервать дальнейшее выполнение скрипта:

Dim gsParamFolder 'путь'
gsParamFolder = ""

Dim gsParamDate 'дата'
gsParamDate = ""

Dim A : Set A=Wscript.Arguments
If A.Count>=1 Then  ' имеется переданный параметр
	Dim i
	For i = 0 To A.Count - 1
		' msgbox A(i),,CStr(i) '''''debug'
		If i=0 Then gsParamFolder = A(i) ' первым параметром ожидаем указание пути'
		If i=1 Then gsParamDate = A(i)   ' вторым - даты'
	Next
End IF

' Если переменные все еще пустые - заносим значения по-умолчанию'
If Len(gsParamFolder)=0 Then gsParamFolder = "C:\test"
If Len(gsParamDate)=0 Then gsParamDate = date()

' Подтверждаем/корректируем переменные'
gsParamFolder = InputBox("Подтвердите обрабатываемый путь", "Путь", gsParamFolder)
gsParamDate = InputBox("Подтвердите обрабатываемую дату", "Дата", gsParamDate)

If Len(gsParamFolder)=0 Then
	msgbox "Отмена обработки пользователем", vbCritical, "Cancel"
	WScript.Quit
End IF
madjahed пишет:

[.... строка из hta]

<input type="button" value="Синхронизировать" onclick="CopyFiles()">

Никаких ошибок при запуске не выдает, но и не работает
Подскажите, где ошибка.

В код не вникал, но сходу насторожило, что основная функция обработки "CopyFiles()" вызывается "с лету" при загрузке приложения (т.е. сразу после тега <script> и когда пользователь еще ничего в окне и не успел ввести) и она же является функцией обработки события клика кнопки.
Что предлагаю:
- код объявления объектов оставить там, где он и есть (сразу после тега <script>);
- дальнейший код записи в лог и вызыва своей основной функции определить отдельной функцией и ее же назначить на событие клика кнопки вместо "CopyFiles()" ;
- т.к. "InitialFolder" - это айди контрола, то обращение к его значению из процедур делайте так "InitialFolder.value"


Function ue_btSyncFolderds()
LogPath = objFSO.GetParentFolderName(WScript.ScriptFullName)
Set LogStream = objFSO.OpenTextFile(LogPath & "\CopyLog.log", 8, True)
LogStream.WriteLine "Начало копирования " & Now()
CopyFiles InitialFolder.value
LogStream.WriteLine "Конец копирования: " & Now()
LogStream.Close
End FUNCTION

<input type="button" value="Синхронизировать" onclick="ue_btSyncFolderds()">
WBR. Roman

3 (изменено: madjahed, 2012-11-18 19:40:09)

Re: HTA: Копирование новых файлов

сделал отдельной функцией
теперь при нажатии на кнопку ошибка "Требуется объект WScript" в строке LogPath = objFSO.GetParentFolderName(WScript.ScriptFullName)

4

Re: HTA: Копирование новых файлов

madjahed пишет:

теперь при нажатии на кнопку ошибка "Требуется объект WScript"

В HTA объект WScript отсутствует.

5

Re: HTA: Копирование новых файлов

а что тогда правильно будет вписать

6

Re: HTA: Копирование новых файлов

Попробуйте так:


''''LogPath = objFSO.GetParentFolderName(WScript.ScriptFullName)
LogPath = objFSO.GetAbsolutePathName(".")
WBR. Roman

7

Re: HTA: Копирование новых файлов

поменял на LogPath = objFSO.GetAbsolutePathName(".")
теперь создается файл CopyLog.log со строчками начала и конца копирования, но ни одного файла не скопировано

8 (изменено: madjahed, 2012-11-18 21:41:26)

Re: HTA: Копирование новых файлов

после правок скрипт выглядит так

<html>
<head>
<meta charset="windows-1251">
<title>Удаление файлов по расширениям</title>
<hta:application id="oHTA"
  applicationname="myApp"
  border="thin"
  borderstyle="normal"
  caption="yes"
  contextmenu="yes"
  icon="webpage.ico"
  innerborder="yes"
  maximizebutton="no"
  minimizebutton="yes"
  navigable="no"
  scroll="no"
  scrollflat="no"
  selection="no"
  showintaskbar="yes"
  singleinstance="yes"
  sysmenu="yes"
  version="1.0"
  windowstate="normal"
/>
<style type="text/css">
  body {background:#ddd}
  body {font:8pt/10pt Verdana; color:#000}
  div.prompt {margin: 5 18}
  div.input {text-align:center}
  </style>
</head>
<body>
  <div class="prompt">
    Укажите папку-источник. <br>
    Например, C:\Windows
  </div>
  <div class="input">
    <input id="InitialFolder" type="text" size=70>
  </div>
  <div class="prompt">
    Укажите папку для сохранения копии. <br>
    Например, D:\Backup
  </div>
  <div class="input">
    <input id="TargetFolder" type="text" size=70>
  </div>
  <div class="prompt">
    Укажите дату изменения файлов. <br>
    Например, 15.10.2012
  </div>
  <div class="input">
    <input id="ControlDate" type="text" size=10>
  </div>
<br><br>
  <div class="input">
    <input type="button" value="Синхронизировать" onclick="ue_btSyncFolderds()"> &nbsp; &nbsp;
    <input type="button" value="Отмена" onclick="window.close()">
  </div>
  <script language="VBScript">

'InitialFolder каталог, откуда копируем 
'TargetFolder каталог, куда копируем
'ControlDate контрольная дата (копируем файлы с датой изменения позже этой)

On Error Resume Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShellApp = CreateObject("Shell.Application")
Function ue_btSyncFolderds()
'LogPath = objFSO.GetParentFolderName(WScript.ScriptFullName)
LogPath = objFSO.GetAbsolutePathName(".")
Set LogStream = objFSO.OpenTextFile(LogPath & "\CopyLog.log", 8, True)
LogStream.WriteLine "Начало копирования " & Now()
CopyFiles InitialFolder.value
LogStream.WriteLine "Конец копирования: " & Now()
LogStream.Close
End FUNCTION
' процедура рекурсивно перебирает файлы в каталоге
Sub CopyFiles(FolderPath)
    On Error Resume Next
    Set objFolderItems = objShellApp.NameSpace(FolderPath).Items()
    For Each objFolderItem In objFolderItems
        If objFolderItem.IsFolder And LCase(Right(objFolderItem.Name, 4)) <> ".zip" Then
            CopyFiles objFolderItem.Path
        Else
            Set objFile = objFSO.GetFile(objFolderItem.Path)
          ' If objFile.DateCreated > ControlDate Then
            If objFile.DateLastModified > ControlDate.value Then
                CopyFile objFolderItem.Path
            End If
        End If
    Next
End Sub
' процедура копирует файл
Sub CopyFile(FilePath)
    On Error Resume Next
    SubPath = Mid(FilePath, Len(InitialFolder) + 1)
    TargetPath = TargetFolder.value & SubPath
    FolderPath = objFSO.GetParentFolderName(TargetPath)
    If Not objFSO.FolderExists(FolderPath) Then
        CreateFolder FolderPath
    End If
    ' если у файла назначения есть атрибут ReadOnly, снимаем его
    If objFSO.FileExists(TargetPath) Then
        Set objFile = objFSO.GetFile(TargetPath)
        If objFile.Attributes And 1 Then
            objFile.Attributes = objFile.Attributes - 1
        End If
    End If
    objFSO.CopyFile FilePath, TargetPath, True
    If Err.Number <> 0 Then
        LogStream.WriteLine
        LogStream.WriteLine FilePath
        LogStream.WriteLine Err.Description
        LogStream.WriteLine
        Err.Clear
    Else
        LogStream.WriteLine TargetPath
    End If
End Sub
' процедура создаёт каталог
Sub CreateFolder (FolderPath)
    On Error Resume Next
    ParentFolder = objFSO.GetParentFolderName(FolderPath)
    If Not objFSO.FolderExists(ParentFolder) Then
        CreateFolder ParentFolder
    End If
    objFSO.CreateFolder FolderPath
End Sub
  </script>
</body>
</html>

Файл лога создается, файлы не копируются

помощь еще актуальна

9

Re: HTA: Копирование новых файлов

madjahed пишет:

после правок скрипт выглядит так

[....]
            If objFile.DateLastModified > ControlDate.value Then
                CopyFile objFolderItem.Path
            End If
[...]
' процедура копирует файл
Sub CopyFile(FilePath)
    On Error Resume Next
    SubPath = Mid(FilePath, Len(InitialFolder) + 1)
    TargetPath = TargetFolder.value & SubPath

Файл лога создается, файлы не копируются

помощь еще актуальна

madjahed, в представленном Вами коде hta-шки у меня сразу закралось сомнение по поводу корректности сравнения дат, см.приведеную выше строку. У меня это сравнение всегда давало "Ложь", в качестве проверки предположения я вставлял команду показа результата такого сранения "msgbox (objFile.DateLastModified > ControlDate.value)", см.мой скрипт. В общем, привел переменные к типу данных даты функцией CDate() и этот участок заработал.

Еще в форме в примере значения каталога назначения Вы указывали "Например, D:\Backup", а потом к этому пути сразу добавляли подкаталог без разделяющего слеша. В общем, добавил в код, что если слеш в конце значения не был указан, то он автоматом добавляется.

Еще чуть переделал вывод в файл, т.к. открывать файл еще до решения пользователя (кнопкой старта "синхронизации") как-то не красиво, ведь его еще и закрывать надо при закрытии окна, поэтому формирование пути к файлу я вынес из процедур в "головной" скрипт и сделал отдельную процедуру дозаписи строки в этот файл.

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


<html>
<head>
<meta charset="windows-1251">
<title>Удаление файлов по расширениям</title>
<hta:application id="oHTA"
  applicationname="myApp"
  border="thin"
  borderstyle="normal"
  caption="yes"
  contextmenu="yes"
  icon="webpage.ico"
  innerborder="yes"
  maximizebutton="no"
  minimizebutton="yes"
  navigable="no"
  scroll="no"
  scrollflat="no"
  selection="no"
  showintaskbar="yes"
  singleinstance="yes"
  sysmenu="yes"
  version="1.0"
  windowstate="normal"
/>
<style type="text/css">
  body {background:#ddd}
  body {font:8pt/10pt Verdana; color:#000}
  div.prompt {margin: 5 18}
  div.input {text-align:center}
  </style>
</head>
<body>
  <div class="prompt">
    Укажите папку-источник. <br>
    Например, C:\Windows
  </div>
  <div class="input">
    <input id="InitialFolder" type="text" size=70 value="c:\1111">
  </div>
  <div class="prompt">
    Укажите папку для сохранения копии. <br>
    Например, D:\Backup
  </div>
  <div class="input">
    <input id="TargetFolder" type="text" size=70 value="c:\_temp">
  </div>
  <div class="prompt">
    Укажите дату изменения файлов. <br>
    Например, 15.10.2012
  </div>
  <div class="input">
    <input id="ControlDate" type="text" size=10 value="17.11.2012">
  </div>
<br><br>
  <div class="input">
    <input type="submit" value="Синхронизировать" onclick="ue_btSyncFolderds()"> &nbsp; &nbsp;
    <input type="button" value="Отмена" onclick="window.close()">
  </div>
  <script language="VBScript">

' InitialFolder.value каталог, откуда копируем 
' TargetFolder.value каталог, куда копируем
' ControlDate.value контрольная дата (копируем файлы с датой изменения позже этой)

On Error Resume Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShellApp = CreateObject("Shell.Application")

Dim sFileLog 'Полный путь к файлу протокола'
sFileLog = objFSO.GetAbsolutePathName(".") & "\CopyLog.log"

Function ue_btSyncFolderds()
	us_writeLog "Начало копирования " & Now()
	CopyFiles InitialFolder.value
	us_writeLog "Конец копирования: " & Now()
End FUNCTION

' Запись переданной параметром строки в файл протокола'
Sub us_writeLog(pLine)
	Set LogStream = objFSO.OpenTextFile(sFileLog, 8, True)
	LogStream.WriteLine pLine
	LogStream.Close
	Set LogStream = Nothing
End SUB


' процедура рекурсивно перебирает файлы в каталоге
Sub CopyFiles(FolderPath)
    Set objFolderItems = objShellApp.NameSpace(FolderPath).Items()
    For Each objFolderItem In objFolderItems
        If objFolderItem.IsFolder And LCase(Right(objFolderItem.Name, 4)) <> ".zip" Then
            CopyFiles objFolderItem.Path
        Else
            Set objFile = objFSO.GetFile(objFolderItem.Path)
            '''' debug -- можете раскомментарить msgbox-ы, чтобы понять - проходят ли сравнения
			' msgbox objFile.DateLastModified & vbCrLf & (objFile.DateLastModified > ControlDate.value),,objFolderItem.Path
			' msgbox objFile.DateLastModified & vbCrLf & (CDate(objFile.DateLastModified) > CDate(ControlDate.value)),,objFolderItem.Path
            '''' debug
          ' If objFile.DateCreated > ControlDate Then
            ' If objFile.DateLastModified > ControlDate.value Then
            If CDate(objFile.DateLastModified) > CDate(ControlDate.value) Then ' приводим значения переменных к типу даты'
                CopyFile objFolderItem.Path
            End If
        End If
    Next
End Sub

' процедура копирует файл
Sub CopyFile(FilePath)
    On Error Resume Next
    SubPath = Mid(FilePath, Len(InitialFolder) + 1)
    If Right(TargetFolder.value,1)<>"\" Then TargetFolder.value = TargetFolder.value & "\" 'добавляем недостающий слеш'
    TargetPath = TargetFolder.value & SubPath
    FolderPath = objFSO.GetParentFolderName(TargetPath)
	'''' debug - контроль сформированных значений
	' msgbox SubPath,, "SubPath"
	' msgbox TargetPath,, "TargetPath"
	' msgbox FolderPath,, "FolderPath"
	' Exit SUB
	'''' debug
    If Not objFSO.FolderExists(FolderPath) Then
        CreateFolder FolderPath
    End If
    ' если у файла назначения есть атрибут ReadOnly, снимаем его
    If objFSO.FileExists(TargetPath) Then
        Set objFile = objFSO.GetFile(TargetPath)
        If objFile.Attributes And 1 Then
            objFile.Attributes = objFile.Attributes - 1
        End If
    End If
    objFSO.CopyFile FilePath, TargetPath, True
    If Err.Number <> 0 Then
        us_writeLog "" &vbCrLf& FilePath &vbCrLf& Err.Description &vbCrLf& ""
        Err.Clear
    Else
        us_writeLog TargetPath
    End If
End Sub

' процедура создаёт каталог
Sub CreateFolder (FolderPath)
    ParentFolder = objFSO.GetParentFolderName(FolderPath)
    If Not objFSO.FolderExists(ParentFolder) Then
        CreateFolder ParentFolder
    End If
    objFSO.CreateFolder FolderPath
End Sub
  </script>
</body>
</html>
WBR. Roman

10 (изменено: madjahed, 2012-11-19 21:31:37)

Re: HTA: Копирование новых файлов

спасибо. скрипт работает. файлы копируются.
есть только маленькое неудобство

можно ли сделать так что бы в указаной мною при запуске скрипта папке для создания копии
(C:\Documents and Settings\user\Рабочий стол\Новая папка)
создавалась папка которая мною указана для копирования
(C:\Documents and Settings\user\Мои документы\РАБОТА\Текущее),
и уже в ней были копируемые папки и файлы.
Например должно быть так -
C:\Documents and Settings\user\Рабочий стол\Новая папка\Текущее;
а сейчас выходит так -
C:\Documents and Settings\user\Рабочий стол\Новая папка\ents and Settings\user\Мои документы\РАБОТА\Текущее;

можно избавится от "ents and Settings\user\Мои документы\РАБОТА" ?

в скрипте vbs из первого поста - получается именно как я описал и надо

11 (изменено: Rom5, 2012-11-19 21:52:28)

Re: HTA: Копирование новых файлов

А озвучте смысл, вкладываемый в строку:

SubPath = Mid(FilePath, Len(InitialFolder) + 1)

зы. "InitialFolder" - это к тому же объект управления с формы, а не текстовое значение


---
а заодно попробуйте обдумать и применить такую конструкцию:

SubPath = Right( FilePath, Len(FilePath) - Len(InitialFolder.value) - 1 ) '''' Mid(FilePath, Len(InitialFolder) + 1)
WBR. Roman

12

Re: HTA: Копирование новых файлов

SubPath = Right( FilePath, Len(FilePath) - Len(InitialFolder.value) - 1 )

То что нужно.
Rom5, спасибо за помощь,
тему можно закрывать

13

Re: HTA: Копирование новых файлов

Вопрос по VBS-скрипту из первого сообщения: каждый ли раз им производится перезапись всех файлов, или он сравнивает даты? Возможен ли скрипт, который бы в точности воспроизводил состояние исходной папки, без повторной полной перезаписи всех файлов в приёмную?

14 (изменено: DD, 2016-05-08 02:50:42)

Re: HTA: Копирование новых файлов

Приводимый скрипт из одной из старых удаленных тем. Запускаю его как есть, но по поводу "Next" ошибка —


'Синхронизация содержимого двух каталогов

'**********************************************
'Исходный каталог
fromDir = "C:\4444444"

'Приемный каталог
'toDir = "\\TargetServer\d$\UserData"
toDir = "C:\5555"

'Сравнивать время изменения файлов с точностью до
' 2 секунд - при переносе файлов с NTFS на FAT
' 0 секунд - в остальных случаях
TimeDifference = 0

Set fso = CreateObject("Scripting.FileSystemObject")

'Подкаталоги ИСХОДНОГО каталога исключаемые из обработки
Dim ExclusionList(2)
With fso
    ExclusionList(0)= .BuildPath(fromDir, "_gsdata_")
    ExclusionList(1)= .BuildPath(fromDir, "index")
    ExclusionList(2)= .BuildPath(fromDir, "Temp\temporaryFolder")
End With
'**********************************************

replaceSize = 0
copySize = 0
deleteSize = 0
noChangeSize = 0

replaceCount = 0
deleteCount = 0
noChangeCount = 0
copyCount = 0

ExclusionListCount = 0

Call CheckFolder(fromDir)

Start = Timer

Call FoldersSynch(fromDir, toDir)

Finish = Timer

delim = vbTab & "...   :   "

Dim message(11)
message(0) = " Файлов без изменений" & delim & noChangeCount & vbTab & "[" & Conversion(noChangeSize) & "]"
message(1) = String(33, "-")
message(2) = " Удалено лишних" & vbTab & delim & deleteCount & vbTab & "[" & Conversion(deleteSize) & "]"
message(3) = " Заменено существующих" & delim & replaceCount & vbTab & "[" & Conversion(replaceSize) & "]"
message(4) = " Добавлено новых" & vbTab & delim & copyCount & vbTab & "[" & Conversion(copySize) & "]"
message(5) = String(33, "-")
message(6) = " Исключено каталогов" & delim & ExclusionListCount
message(7) = ""
message(8) = String(33, "-")
message(9) = " РАЗМЕР ОБНОВЛЕНИЙ" & delim & Conversion(replaceSize + copySize)
message(10) = ""
message(11) = " Время выполнения" & delim & (Finish - Start) & "   сек."

MsgBox Join(message, vbCrLf), vbInformation, "Сообщение синхронизатора"

Sub CheckFolder(FolderName)
If Not fso.FolderExists(FolderName) Then
    MsgBox "Нет доступа к ресурсу ''" & FolderName & "''", vbCritical, "Сообщение синхронизатора"
    WScript.Quit()
End If
End Sub

Sub FoldersSynch(source, target)
Dim sourceDir, sourceFile, targetDir, targetFile, sourceSubDir, targetSubDir
    Set sourceDir = fso.GetFolder(source)
    If Not FolderExcluded(source, ExclusionList) Then
        SmartCreateFolder target
        Set targetDir = fso.GetFolder(target)
        If targetDir.Attributes <> sourceDir.Attributes Then
            targetDir.Attributes = sourceDir.Attributes
        End If
        For Each targetFile in targetDir.Files
            If Not fso.FileExists(fso.BuildPath(source, targetFile.Name)) Then
                deleteSize = deleteSize + targetFile.Size
                targetFile.Delete(True)
                deleteCount = deleteCount + 1
            End If
        For Each sourceFile in sourceDir.Files
            If Not fso.FileExists(fso.BuildPath(target, sourceFile.Name)) Then
                sourceFile.Copy fso.BuildPath(target, sourceFile.Name)
                copySize = copySize + sourceFile.Size
                copyCount = copyCount + 1
            Else
                Set targetFile = fso.GetFile(fso.BuildPath(target, sourceFile.Name))
                If Abs(DateDiff("s", sourceFile.DateLastModified, targetFile.DateLastModified)) > TimeDifference Then
                    If targetFile.Attributes And 1 Then
                        targetFile.Attributes = targetFile.Attributes - 1
                    End If
                    sourceFile.Copy targetFile, True
                    replaceSize = replaceSize + sourceFile.Size
                    replaceCount = replaceCount + 1
                Else
                    If targetFile.Attributes <> sourceFile.Attributes Then
                        targetFile.Attributes = sourceFile.Attributes
                    End If
                    noChangeSize = noChangeSize + sourceFile.Size
                    noChangeCount = noChangeCount + 1
                End If
            End If
        Next 'sourceFile
        For Each sourceSubDir in sourceDir.SubFolders
            FoldersSynch sourceSubDir.Path, fso.BuildPath(target, sourceSubDir.Name)
        For Each targetSubDir in targetDir.SubFolders
            If Not fso.FolderExists(fso.BuildPath(source, targetSubDir.Name)) Then
                ExtraCount targetSubDir.Path, deleteCount
                deleteSize = deleteSize + targetSubDir.Size
                targetSubDir.Delete(True)
            End If
        Next 'targetSubDir
    Else
        ExclusionListCount = ExclusionListCount + 1
    End If
End Sub

Sub SmartCreateFolder(strFolder)
    If fso.FolderExists(strFolder) Then
        Exit Sub
    Else
        SmartCreateFolder(fso.GetParentFolderName(strFolder))
    End If
    fso.CreateFolder(strFolder)
End Sub

Function FolderExcluded(qFolder, qArray)
Dim q, LenFolder, LenArray, tmpStr
For q = 0 To UBound(qArray)
    If LCase(qArray(q)) = LCase(qFolder) Then
        FolderExcluded = True
        Exit Function
    Else
        LenFolder = Len(qFolder)
        LenArray = Len(qArray(q))
        If LenFolder > LenArray Then
            tmpStr = Mid(qFolder, 1, LenArray)
            If LCase(qArray(q)) = LCase(tmpStr) _
            And Mid(qFolder, Len(tmpStr)+1, 1) = "\" Then
                FolderExcluded = True
                Exit Function
            End If
        End if
    End If
Next 'q
    FolderExcluded = False
End Function

Function ExtraCount(ExtraFolderName, Counter)
Dim ExtraFolder, ExtraSubFolder, ExtraFile
    Set ExtraFolder = fso.GetFolder(ExtraFolderName)
'Подсчет числа файлов в корневом каталоге
    Counter = Counter + ExtraFolder.Files.Count
'Подсчет числа файлов в подкаталогах
    For Each ExtraSubFolder in ExtraFolder.SubFolders
        ExtraCount ExtraSubFolder.Path, Counter
    Next 'ExtraSubFolder
End Function

Function Conversion(ByteSize)
    if FormatNumber(ByteSize, 0) < 1024 Then
        Conversion = FormatNumber(ByteSize, 0) & "   байт"
    ElseIf FormatNumber(ByteSize/1024, 2) < 1024 Then
        Conversion = FormatNumber(ByteSize/1024, 2) & "   Кбайт"
    Else
        Conversion = FormatNumber(ByteSize/1024/1024, 2) & "   Мбайт"
    End If
End Function

15 (изменено: Flasher, 2016-05-09 00:14:06)

Re: HTA: Копирование новых файлов

87 строкой добавьте.

16

Re: HTA: Копирование новых файлов

Добавляю — и в другом месте возникает та же ошибка)) Наугад и туда добавляю — так и снова ошибка, об отсутствующем объекте)) Неужели под VBS старые скрипты как и в AHK не работают))

17 (изменено: Flasher, 2016-05-09 00:13:59)

Re: HTA: Копирование новых файлов

И 113-ой ещё.  Это не проблема языка, это проблема кода (уж не знаю, насколько исходного).

P.S.: У нас точки принято ставить.

18 (изменено: DD, 2016-05-08 20:42:12)

Re: HTA: Копирование новых файлов

Все равно пишет, что требуется объект. Прикрепил тему, откуда брал скрипт.

Post's attachments

VBS_ Копирование папки backup.chm 27.87 kb, 3 downloads since 2016-05-08 

You don't have the permssions to download the attachments of this post.

19 (изменено: Flasher, 2016-05-09 01:18:04)

Re: HTA: Копирование новых файлов

Лишнюю первую строку посчитал. Ошибся. Исправил номера.
А вообще при ошибках принято писать дословные данные: описание и номер строки.

+ DD

20

Re: HTA: Копирование новых файлов

Вот спасибо! Ещё по коду вопрос, если позволите: дано ли настроить его на удаление "лишних файлов" в корзину, а не мимо неё?

21 (изменено: Flasher, 2016-05-09 04:36:18)

Re: HTA: Копирование новых файлов

Можно. Где-нибудь выше Call FoldersSynch(fromDir, toDir) вставьте:

Set RecycleBin = CreateObject("Shell.Application").Namespace(&Ha)

А вместо

                targetFile.Delete(True)

>>

                RecycleBin.MoveHere(targetFile)

22

Re: HTA: Копирование новых файлов

Большое спасибо!

23

Re: HTA: Копирование новых файлов

А всё-таки, перемещения в Корзину не происходит, хотя файлы на перемещение фиксируются. Просьба взглянуть, всё ли верно подставил:

Post's attachments

Синхронизация содержимого двух каталогов (с удалением «лишних файлов» в корзину).vbs 6.32 kb, 4 downloads since 2016-05-09 

You don't have the permssions to download the attachments of this post.

24

Re: HTA: Копирование новых файлов

Есть вероятность, что они там не сразу появляются после отработки скрипта. Дождитесь.
И, разумеется, для диска (в данном случае C:) в настройках корзины должен быть установлен годный максимальный размер.

25

Re: HTA: Копирование новых файлов

Для корзины на C: зарезервировано 700 MB, а файлы на удаление весят много меньше и их незначительное количество, так что процесс wscript.exe практически сразу завершается.

26

Re: HTA: Копирование новых файлов

DD
Можно попробовать ещё один метод, но для этого придётся отключать в свойствах корзины подтверждение на удаление.
Действуем по той же схеме.

Set Desc = CreateObject("Shell.Application").Namespace(0)

+

                Desc.ParseName(targetFile).InvokeVerb("delete")
+ DD

27

Re: HTA: Копирование новых файлов

По поводу скрипта синхронизирующего содержимое двух каталогов. По какой причине исключение каталога из обработки не происходит, если в именах присутствует кириллица?

ExclusionList(2)= .BuildPath(fromDir, "Избранное")