[решено] скрипт ищущий в системе папку Valve и удаляющий её

[T3D]

Помогите сделать скрипт ищущий в системе папку Valve и удаляющий её.

Заранее спасибо)))

[SendMessage]

Осмелюсь предложить бат-файл - при его помощи это сделать гораздо удобнее и проще:
for /f "skip=1" %%a in ('wmic path win32_logicaldisk.drivetype^=3 get name') do (
for /f "tokens=*" %%i in ('dir %%a /ad /s /b ^| findstr /i /e "\<Valve\>"') do (
if /i "%%~ni"=="Valve" rd /s /q "%%i"
)
)

[T3D]

Задание немного изменилось.
Надо найти файл cs.exe, а потом поднявшись на папку выше удалить её. Можно вариант с батником.


SearchFold = "Valve" 'имя искомой папки
RootFold = "D:\" 'корневой каталог для поиска
FindedFolders ="" ' сюда запишутся все найденные папки


call Get_Fold (RootFold) 'вызываем процедуру перебора подкаталогов, их удаления...
call OutputResults() ' ...и показа результатов поиска
sub Get_Fold (strFoldName)

on error resume next
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(strFoldName)
For Each SubFolder In Folder.SubFolders
s_path=SubFolder.shortpath 'короткий путь в формате 8.3
f_name = SubFolder.Name
if LCase(f_name) = LCase(SearchFold) then 'это приводит сравниваемые имена к нижнему регистру. Таким образом при поиске регистр не учитывается...
'if f_name = SearchFold then ' ...а так регистр будет учитываться. Но мы этот варик закомментили :)
'получаем нормально читаемый полный путь к папке
Set objShell = WScript.CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(s_path)
l_path = objFolder.Self.Path 'длинный путь
FSO.DeleteFolder l_path, 0 'прибиваем найденное. 1- удалять объекты с атрибутом "для чтения", 0- нет.
FindedFolders=FindedFolders & vbcrlf & ">>" & l_path ' дописываем в переменную "FindedFolders" найденную папку
'exit sub ' вываливаемся из процедуры
else
call Get_Fold (s_path) '...а теперь саму себя вызываем. Рекурсия, понимаешь :)
end if
Next
end sub


sub OutputResults
if Len(FindedFolders) = 0 then
msgbox("Ничего не нашли...")
else
msgbox("Чего-то было, но не стало:" & vbcrlf & vbcrlf & FindedFolders)
Set FSO = CreateObject("Scripting.FileSystemObject")
end if
end sub


Есть поиск папки.
Если бы как-то использовать метод GetParentFolderName, то я бы мог искать папку "hl", а далее поднимаясь на одну выше удалять её... Но как это сделать, я не знаю :-(

[SendMessage]

Надо найти файл cs.exe, а потом поднявшись на папку выше удалить её. Можно вариант с батником. »
Это, практически, так же, как и поиск папки.
Следующий батник удалит папку, в которой расположен файл cs.exe, на всех дисках.
for /f "skip=1" %%a in ('wmic path win32_logicaldisk.drivetype^=3 get name') do (
for /f "tokens=*" %%i in ('dir %%a\cs.exe /a-d /s /b') do (
rd /s /q "%%~dpi"
)
)
Если нет надобности перебирать диски, а нужен конкретный (например, диск D), то:
for /f "tokens=*" %%i in ('dir d:\cs.exe /a-d /s /b') do (rd /s /q "%%~dpi")
Если бы как-то использовать метод GetParentFolderName, то я бы мог искать папку "hl", а далее поднимаясь на одну выше удалять её... Но как это сделать, я не знаю :-( »
Не совсем понял - что же тебе, в конце концов, надо? Удалять ли папку, в которой находится cs.exe или удалять папку "hl"?
GetParentFolderName здесь можно использовать так:
If LCase(f_name) = "hl" Then FSO.DeleteFolder FSO.GetParentFolderName(s_path)

[T3D]

Просто изначально задание было искать папку "Valve", но потом подумав мы решили, что люди могли переименовать её или же у них стоит CS:S. Так что логичней искать cs.exe и потом поднимаясь на каталог выше удалять его.
Но и в этом варианте появилась загвоздка, ведь у них он может называться не cs.exe, а к примеру: Run_CSS.exe, css.exe. Так что я решил, что лучше искать либо папку hl, либо файл steam.dll и также далее подниматься на папку выше удалять его.

[T3D]

Батник работает, отлично.

А вот добавив метод я получил следующие, папка "hl" находится. Всё в папке выше неё удаляется, но сама эта папка остаётся...

[SendMessage]

А так?
Option Explicit

Const ROOT_FOLDER = "D:\"
Const SEARCH_FOLDER = "hl"

Dim strDelFolder
Dim objFSO
Dim RetVal

Set objFSO = CreateObject("Scripting.FileSystemObject")

GetFolders ROOT_FOLDER
If Len(strDelFolder) Then
RetVal = MsgBox("Вы хотите удалить папку """ & strDelFolder & """," & vbNewLine & _
"в которой находится искомая папка """& SEARCH_FOLDER & """?", 33, "Удаление папки")
If RetVal = 1 Then objFSO.DeleteFolder strDelFolder, True
Else
MsgBox "Папка """ & SEARCH_FOLDER & """ не найдена.", 64, "Удаление папки"
End If

Set objFSO = Nothing

WScript.Quit 0

Sub GetFolders(strFolderName)
Dim objSubFolder
For Each objSubFolder In objFSO.GetFolder(strFolderName).SubFolders
If LCase(objSubFolder.Name) = LCase(SEARCH_FOLDER) Then
strDelFolder = strFolderName
Exit Sub
Else
GetFolders objSubFolder.Path
End If
Next
End Sub

[T3D]

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

Ну, да ладно, дальше сам разберусь как-нибудь...

[SendMessage]

Хм, не думал, что их несколько. Ну тогда так можно:
Option Explicit

Const ROOT_FOLDER = "D:\"
Const SEARCH_FOLDER = "hl"

Dim strDelFolder
Dim objFSO
Dim RetVal
Dim arrDelFolders
Dim i

Set objFSO = CreateObject("Scripting.FileSystemObject")

GetFolders ROOT_FOLDER

If Len(strDelFolder) Then
arrDelFolders = Split(strDelFolder, vbNewline)
For i = 0 To UBound(arrDelFolders) - 1
If objFSO.FolderExists(arrDelFolders(i)) Then
RetVal = MsgBox("Вы хотите удалить папку """ & arrDelFolders(i) & """," & vbNewLine & _
"в которой находится искомая папка """& SEARCH_FOLDER & """?", 33, "Удаление папки")
If RetVal = 1 Then objFSO.DeleteFolder arrDelFolders(i), True
End If
Next
Else
MsgBox "Папка """ & SEARCH_FOLDER & """ не найдена.", 64, "Удаление папки"
End If

Set objFSO = Nothing

WScript.Quit 0

Sub GetFolders(strFolderName)
Dim objSubFolder
For Each objSubFolder In objFSO.GetFolder(strFolderName).SubFolders
If LCase(objSubFolder.Name) = LCase(SEARCH_FOLDER) Then
strDelFolder = strDelFolder & strFolderName & vbNewline
Else
GetFolders objSubFolder.Path
End If
Next
End Sub

[T3D]

вот, теперь идеально))) Спасибо большое :)

[T3D]

Можете подсказать как искать на нескольких дисках?

[SendMessage]

как искать на нескольких дисках? »
Сделал с обработкой ошибок. На случай, если при обращении к папке доступ будет закрыт или еще что:
Option Explicit

Const SEARCH_FOLDER = "hl"

Dim strDelFolder
Dim objFSO
Dim RetVal
Dim arrDelFolders
Dim i
Dim arrDriveItem

Set objFSO = CreateObject("Scripting.FileSystemObject")

For Each arrDriveItem In objFSO.Drives
If arrDriveItem.DriveType = 2 Then GetFolders arrDriveItem.Path & "\"
Next

If Len(strDelFolder) Then
arrDelFolders = Split(strDelFolder, vbNewline)
For i = 0 To UBound(arrDelFolders) - 1
If objFSO.FolderExists(arrDelFolders(i)) Then
RetVal = MsgBox("Вы хотите удалить папку """ & arrDelFolders(i) & """," & vbNewLine & _
"в которой находится искомая папка """& SEARCH_FOLDER & """?", 33, "Удаление папки")
If RetVal = 1 Then objFSO.DeleteFolder arrDelFolders(i), True
End If
Next
Else
MsgBox "Папка """ & SEARCH_FOLDER & """ не найдена.", 64, "Удаление папки"
End If

Set objFSO = Nothing

WScript.Quit 0

Sub GetFolders(strFolderName)
Dim objSubFolder
On Error Resume Next
For Each objSubFolder In objFSO.GetFolder(strFolderName).SubFolders
If LCase(objSubFolder.Name) = LCase(SEARCH_FOLDER) Then
If Err.Number = 0 Then
strDelFolder = strDelFolder & strFolderName & vbNewLine
Else
MsgBox "Ошибка при обращении к """ & strFolderName & """."
Err.Clear
End If
Else
GetFolders objSubFolder.Path
End If
Next
End Sub

Если достаточно перебрать конкретные диски:
For Each arrDriveItem In Array("C:\", "D:\", "F:\")
GetFolders arrDriveItem
Next

[T3D]

SendMessage, и снова вы спасли меня. Я пару часов сидел пытался сделать массив, но не получалась.

Надеюсь, начальство ничего больше не придумает.