1 Тема от Francyz (изменено: Francyz, 2011-02-03 11:25:24)

  • Francyz
  • Участник
  • Неактивен

Тема: VBS: Ошибка при запуске скрипта (команда DeleteFile)

Поставил на logon скрипт который чистит кеш в определенных папках. Но у некоторых юзеров выдается ошибка, когда они входят в систему:

http://i069.radikal.ru/1102/7d/0ca66bb9b4ca.png

Option Explicit ': On Error Resume Next
Dim objFSO, FolderX

Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")

RecourseDeleteByMask objFSO.GetFolder("c:\"), Array("*.log","*.tmp","cache.*","LocalCache")

For Each FolderX In objFSO.GetFolder("c:\Documents and Settings\").SubFolders
    if objFSO.FolderExists(FolderX.Path&"\Application Data\1C\1Cv82") then
        RecourseDeleteByMask objFSO.GetFolder(FolderX.Path &"\Application Data\1C\1Cv82\"), Array("*.*")
    end if
Next

Set objFSO = Nothing
WScript.Quit 0

'=============================================================================
Sub RecourseDeleteByMask(objFolder, strMasks)
    Dim objSubFolder, strFullMask, strMask
    On Error Resume Next
    For each strMask in strMasks
        strFullMask = objFSO.BuildPath(objFolder.Path, strMask)
        objFSO.DeleteFile strFullMask, True
    Next

    Err.Clear
    For Each objSubFolder In objFolder.SubFolders
        If Err.Number = 0 Then
            RecourseDeleteByMask objSubFolder, strMasks
        Else
            Err.Clear 
        End If
    Next
End Sub
'=============================================================================

Это часть скрипта и ошибка ругается на строчку 

        objFSO.DeleteFile strFullMask, True

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

2 Ответ от alexii

  • alexii
  • Разработчик
  • Неактивен

Re: VBS: Ошибка при запуске скрипта (команда DeleteFile)

Очевидно, у них нет такого пути, нет доступа и т.п.

Francyz, чтобы мы тоже могли соображать «почему?», — скрипт должен точно соответствовать сообщению об ошибке, т.е., как минимум, должен быть воспроизводим: в приведённом Вами скрипте 35 строк, а сообщение об ошибке указывает на 40-ю строку.

3 Ответ от Francyz (изменено: Francyz, 2011-02-03 12:48:38)

  • Francyz
  • Участник
  • Неактивен

Re: VBS: Ошибка при запуске скрипта (команда DeleteFile)

Я убрал похожие строки с условием, чтобы не "мазолили" глаза. Вот полная версия:

Option Explicit ': On Error Resume Next
Dim objFSO, FolderX

Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")

RecourseDeleteByMask objFSO.GetFolder("c:\"), Array("*.log","*.tmp","cache.*","LocalCache")

For Each FolderX In objFSO.GetFolder("c:\Documents and Settings\").SubFolders
    if objFSO.FolderExists(FolderX.Path&"\Local Settings\Temp") then
        RecourseDeleteByMask objFSO.GetFolder(FolderX.Path &"\Local Settings\Temp\"), Array("*.*")
    end if
Next
For Each FolderX In objFSO.GetFolder("c:\Documents and Settings\").SubFolders
    if objFSO.FolderExists(FolderX.Path&"\Application Data\1C\1Cv82") then
        RecourseDeleteByMask objFSO.GetFolder(FolderX.Path &"\Application Data\1C\1Cv82\"), Array("*.*")
    end if
Next

For Each FolderX In objFSO.GetFolder("c:\Documents and Settings\").SubFolders
    if objFSO.FolderExists(FolderX.Path&"\Local Settings\Application Data\1C\1Cv82") then
        RecourseDeleteByMask objFSO.GetFolder(FolderX.Path &"\Local Settings\Application Data\1C\1Cv82\"), Array("*.*")
    end if
Next

For Each FolderX In objFSO.GetFolder("c:\Documents and Settings\").SubFolders
    if objFSO.FolderExists(FolderX.Path&"\Local Settings\Termorary Internet Files") then
    RecourseDeleteByMask objFSO.GetFolder(FolderX.Path &"\Local Settings\Termorary Internet Files\"), Array("*.*")
    end if
Next

Set objFSO = Nothing
WScript.Quit 0

'=============================================================================
Sub RecourseDeleteByMask(objFolder, strMasks)
    Dim objSubFolder, strFullMask, strMask
    On Error Resume Next
    For each strMask in strMasks
        strFullMask = objFSO.BuildPath(objFolder.Path, strMask)
        objFSO.DeleteFile strFullMask, True
    Next

    Err.Clear
    For Each objSubFolder In objFolder.SubFolders
        If Err.Number = 0 Then
            RecourseDeleteByMask objSubFolder, strMasks
        Else
            Err.Clear 
        End If
    Next
End Sub
'=============================================================================

Ошибка выходит рандомно, если запускать вручную то все работает нормально. Когда ставишь в автозапуск, тоже самое, у некоторых есть у некоторых нету.

4 Ответ от alexii

  • alexii
  • Разработчик
  • Неактивен

Re: VBS: Ошибка при запуске скрипта (команда DeleteFile)

Пишите прохождение каждого вызова «RecourseDeleteByMask()» в файл, отслеживайте, что не проходит, ищите разницу.

5 Ответ от Francyz

  • Francyz
  • Участник
  • Неактивен

Re: VBS: Ошибка при запуске скрипта (команда DeleteFile)

Я правильно понял, что можно добавить 

Sub log(sData)
    Dim ts, ForAppending
    ForAppending = 8
    Set ts = fso.OpenTextFile("log.txt", ForAppending, True)
    ts.Write sData & chr(13) & chr(10)
    ts.Close
End Sub

А в свой цикл после RecourseDeleteByMask  вставить вызов log( folder.Path ) ?

6 Ответ от Francyz (изменено: Francyz, 2011-02-04 15:51:37)

  • Francyz
  • Участник
  • Неактивен

Re: VBS: Ошибка при запуске скрипта (команда DeleteFile)

Я сделал так чтобы записывался путь, который в данный момент обрабатывается, но проблема в том, что в текстовом он заменяется. В принципе я увижу где выходит ошибка, когда она появится в текстовом будет тот путь, где скрипт остановился, но хотелось бы видеть, какие папки он прошел. Помогите подправить скрипт чтобы в текстовом строки плюсовались, а не затирались на новые

Option Explicit ': On Error Resume Next
Dim objFSO, FolderX

Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")

RecourseDeleteByMask objFSO.GetFolder("c:\"), Array("*.log","*.tmp","cache.*","LocalCache")

For Each FolderX In objFSO.GetFolder("c:\Documents and Settings\").SubFolders
    if objFSO.FolderExists(FolderX.Path&"\Local Settings\Temp") then
        RecourseDeleteByMask objFSO.GetFolder(FolderX.Path &"\Local Settings\Temp\"), Array("*.*")
    end if
Next
For Each FolderX In objFSO.GetFolder("c:\Documents and Settings\").SubFolders
    if objFSO.FolderExists(FolderX.Path&"\Application Data\1C\1Cv82") then
        RecourseDeleteByMask objFSO.GetFolder(FolderX.Path &"\Application Data\1C\1Cv82\"), Array("*.*")
    end if
Next

For Each FolderX In objFSO.GetFolder("c:\Documents and Settings\").SubFolders
    if objFSO.FolderExists(FolderX.Path&"\Local Settings\Application Data\1C\1Cv82") then
        RecourseDeleteByMask objFSO.GetFolder(FolderX.Path &"\Local Settings\Application Data\1C\1Cv82\"), Array("*.*")
    end if
Next

For Each FolderX In objFSO.GetFolder("c:\Documents and Settings\").SubFolders
    if objFSO.FolderExists(FolderX.Path&"\Local Settings\Termorary Internet Files") then
    RecourseDeleteByMask objFSO.GetFolder(FolderX.Path &"\Local Settings\Termorary Internet Files\"), Array("*.*")
    end if
Next

Set objFSO = Nothing
WScript.Quit 0

'=============================================================================
Sub RecourseDeleteByMask(objFolder, strMasks)
    Dim objSubFolder, strFullMask, strMask, tf, fso
    On Error Resume Next
    For each strMask in strMasks
        strFullMask = objFSO.BuildPath(objFolder.Path, strMask)

'-----------Запись в файл-----------
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set tf = fso.CreateTextFile("c:\testfile.txt", True)
    tf.WriteLine(objFolder) 
    tf.Close
'----------------------------------------

        objFSO.DeleteFile strFullMask, True
    Next

    Err.Clear
    For Each objSubFolder In objFolder.SubFolders
        If Err.Number = 0 Then
            RecourseDeleteByMask objSubFolder, strMasks
        Else
            Err.Clear 
        End If
    Next
End Sub
'=============================================================================

7 Ответ от Francyz

  • Francyz
  • Участник
  • Неактивен

Re: VBS: Ошибка при запуске скрипта (команда DeleteFile)

Сейчас выдалась опять эта ошибка, в текстовый записался пусть, на котором он остановился
C:\Documents and Settings\All Users\Application Data\Kaspersky Lab\AVP60MP4\Data\Updater\Temporary Files\temporaryFolder\bases\ids\ForDiff

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

8 Ответ от pushok.88

  • pushok.88
  • Участник
  • Неактивен

Re: VBS: Ошибка при запуске скрипта (команда DeleteFile)

А кто нибудь может подсказать, можно ли в приведенном коде удалять файлы с заданным расширением, но только которые старше недели?

9 Ответ от alexii

  • alexii
  • Разработчик
  • Неактивен

Re: VBS: Ошибка при запуске скрипта (команда DeleteFile)

Можно.

10 Ответ от pushok.88 (изменено: alexii, 2011-12-02 14:03:22)

  • pushok.88
  • Участник
  • Неактивен

Re: VBS: Ошибка при запуске скрипта (команда DeleteFile)

Краткость-сестра таланта.))) Но хотелось бы еще понять, каким образом?

Вот допустим код:

Option Explicit ': On Error Resume Next
Dim objFSO, FolderX

Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")

RecourseDeleteByMask objFSO.GetFolder("c:\"), Array("*.log","*.tmp","cache.*","LocalCache")

For Each FolderX In objFSO.GetFolder("c:\Documents and Settings\").SubFolders
    if objFSO.FolderExists(FolderX.Path&"\Local Settings\Temp") then
        RecourseDeleteByMask objFSO.GetFolder(FolderX.Path &"\Local Settings\Temp\"), Array("*.*")
    end if
Next

Set objFSO = Nothing
WScript.Quit 0

'=============================================================================
Sub RecourseDeleteByMask(objFolder, strMasks)
    Dim objSubFolder, strFullMask, strMask, tf, fso
    On Error Resume Next
    For each strMask in strMasks
        strFullMask = objFSO.BuildPath(objFolder.Path, strMask)

   objFSO.DeleteFile strFullMask, True
    Next

    Err.Clear
    For Each objSubFolder In objFolder.SubFolders
        If Err.Number = 0 Then
            RecourseDeleteByMask objSubFolder, strMasks
        Else
            Err.Clear 
        End If
    Next
End Sub
'=============================================================================

Честно, всю голову сломал, но так и не понял каким образом воплотить данную идею.
Я понимаю, что надо использовать DateLastModified, но как это реализовать в данном коде не имею понятия.

11 Ответ от alexii

  • alexii
  • Разработчик
  • Неактивен

Re: VBS: Ошибка при запуске скрипта (команда DeleteFile)

pushok.88 пишет:

Краткость-сестра таланта.)))

Каков вопрос — таков ответ.

Я бы Вам предложил посмотреть в сторону LogParser'а:

LogParser.exe "SELECT LastWriteTime, Path FROM C:\*.log, C:\*.tmp, c:\cache.*, c:\LocalCache* WHERE SUB(TO_LOCALTIME(SYSTEM_TIMESTAMP()), LastWriteTime) > TIMESTAMP('7', 'd')" -i:FS -rtp:-1

Посмотрев, как сие работает, Вам останется только написать что-то наподобие:

for /f "delims=" %%i in ('LogParser.exe "SELECT Path FROM C:\*.log, C:\*.tmp, c:\cache.*, c:\LocalCache* WHERE SUB(TO_LOCALTIME(SYSTEM_TIMESTAMP()), LastWriteTime) > TIMESTAMP('7', 'd')" -i:FS -o:CSV -q:on -oDQuotes:on -oCodepage:866') do del /f /q "%%~i"

12 Ответ от pushok.88

  • pushok.88
  • Участник
  • Неактивен

Re: VBS: Ошибка при запуске скрипта (команда DeleteFile)

Может конечно данный способ и лучше, но меня интересовала возможность подкорректировать код именно стандартными функциями.

13 Ответ от alexii

  • alexii
  • Разработчик
  • Неактивен

Re: VBS: Ошибка при запуске скрипта (команда DeleteFile)

Можно и подкорректировать.

Корректировать придётся следующее:

* убрать удаление по маске;
* сделать перебор всех файлов в папке;
* сверять каждый файл посредством регулярных выражений с маской; при совпадении — сравнивать дату модификации файла с текущей датой и при разнице, большей заданной, удалять файл.

14 Ответ от pushok.88

  • pushok.88
  • Участник
  • Неактивен

Re: VBS: Ошибка при запуске скрипта (команда DeleteFile)

Понятно, но тогда у меня другой вопрос. Как прописать, чтобы скрипт смотрел в папку по пути "C:\Documents and Settings\ТОЛЬКО ЗАЛОГИНЕНЫЙ ПОЛЬЗОВАТЕЛЬ\Local Settings\Application Data\1\2\"???

15 Ответ от alexii

  • alexii
  • Разработчик
  • Неактивен

Re: VBS: Ошибка при запуске скрипта (команда DeleteFile)

Использовать переменную окружения «%UserProfile%\…».

16 Ответ от stir (изменено: stir, 2011-12-05 10:29:30)

  • stir
  • Участник
  • Неактивен

Re: VBS: Ошибка при запуске скрипта (команда DeleteFile)

Лично я предположил сначала, что: 1. теряется связь с удаленной папкой (- пинг всегда между этими ПК постоянен?), 2. Пользователь не имеет нужных прав для осуществления операции (тогда что же делать с непостоянством ошибки??),
но это не так, т.к. прочитал весь скрипт и дошел до строки номер40.

т.к. 1С у меня нет - протестить скрипт наверное не получится у себя...

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

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

Вопрос: а зачем чистить временные файлы анивируса? Очень часто антивирус не дает права на их удаление..
Вопрос2: не проще ли было установить батник каждому на ПК с функией очистки нужных папок, это все делается локально - меньше сбоев при отработке? Батники также можно обновлять в системе и системно, если это предусмотреть заранее...

Любители построили Ковчег, а профессионалы - Титаник.

17 Ответ от BeS Yara (изменено: BeS Yara, 2011-12-08 15:02:27)

  • BeS Yara
  • Разработчик
  • Неактивен

Re: VBS: Ошибка при запуске скрипта (команда DeleteFile)

Добрый день.

Francyz пишет:

Сейчас выдалась опять эта ошибка, в текстовый записался пусть, на котором он остановился
C:\Documents and Settings\All Users\Application Data\Kaspersky Lab\AVP60MP4\Data\Updater\Temporary Files\temporaryFolder\bases\ids\ForDiff

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

Ошибка 800A0035, как и указано в описании, сообщает об отутствии файла. В стр. 40 происходит попытка удаления файла - лучше в лог писать именно полное имя файла(strFullMask) а не папки. У меня уже KES, но пути те же и в данной папке расположен единственный файл ah-0607g.xml.dif. Это имя не подпадает ни под одну из указанных при первом вызове процедуры масок. Что-то мне подсказывает, что ошибка происходит при
strFullMask = "C:\Documents and Settings\All Users\Application Data\Kaspersky Lab\AVP60MP4\Data\Updater\Temporary Files\temporaryFolder\bases\ids\ForDiff\*.log", т.е. ошибка при первом вызове процедуры(когда удаляются не все файлы, а по конкретной маске).
Возникновение ошибки вполне закономерно. Странно что игнорируется "On Error Resume Next"... Похожее поведение описано при использовании обработчика ошибок, но к "On Error Resume Next", как мне кажется, это не подходит. Однако, может быть стоит отключать игнорирование ошибок перед рекурсивным вызовом? Могу ошибаться, в "искусственных" условиях имитировать такое поведение для "On Error Resume Next" я не смог, но вдруг поможет?

Не пойму смысла этого фрагмента:


    Err.Clear
    For Each objSubFolder In objFolder.SubFolders
        If Err.Number = 0 Then
            RecourseDeleteByMask objSubFolder, strMasks
        Else
            Err.Clear
        End If
    Next

Сначала сбросили все ошибки, а потом проверяем "если ошибок нет, то ..." - зачем? objFolder у нас имеется, и даже если подпапок там нет objFolder.SubFolders вернёт Folders а не ошибку.

Может быть заменить этот кусок на такой?


    Err.Clear
    On Error GoTo 0
    For Each objSubFolder In objFolder.SubFolders
            RecourseDeleteByMask objSubFolder, strMasks
    Next
Francyz пишет:

сделал так чтобы записывался путь, который в данный момент обрабатывается, но проблема в том, что в текстовом он заменяется

Чтобы логфайл не перезаписывался, нужно всё-таки использовать fso.OpenTextFile(как Вы изначально и писали), а не CreateTextFile(с учётом второго параметра он естественно создаётся поверх имеющегося). И наверное лучше открыть файл один раз, при старте скрипта, а дальше уже только писать туда. В конце работы скрипта файл закрыть.
Вместо "ts.Write sData & chr(13) & chr(10)" проще будет "ts.WriteLine sData". Также вместо "chr(13) & chr(10)" можно использовать vbCrLf.

pushok.88 пишет:

Честно, всю голову сломал, но так и не понял каким образом воплотить данную идею.
Я понимаю, что надо использовать DateLastModified, но как это реализовать в данном коде не имею понятия.

Пример работы с "возрастом" файла:


Dim fso
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Dim File
For Each File in fso.GetFolder("d:\aScripts\vbs\tmp\").Files
  If DateDiff("d", File.DateLastModified, Now) > 7 then 'если возраст более 7 дней
    'удаляем/копируем/покоряем мир
  End If
Next

Разницу между "d" и "y" не понял - для файла 2009-го года и для файла текущего года оба варианта дают одинаковый результат. Похоже разницы нет:

To calculate the number of days between date1 and date2, you can use either Day of year ("y") or Day ("d").

С предложением alexii я согласен - лучше перебирать файлы в папке и обрабатывать каждый по необходимым критериям.

P.S. Учитывая вызов процедуры для конкретных папок профиля, я не вижу смысла в рекурсивной чистке начиная с корня диска. Лучше натравливать скрипт на известные места скопления временных файлов, чем обрабатывать весь диск, рискуя удалить что-то, что удалять не следует.
P.P.S. Наткнулся на сайт с описанием ошибок - Code 800 Errors in VBScript / WSH, может кому-то будет полезен. Ну и MSDN:Core Visual Basic Language Errors(это VB6, но думаю и для VBS они же будут).