VBNet - Форум - Помогите разобратся в скрипте!

Вопрос: Помогите разобратся в скрипте! Добавлено: 02.09.08 10:05

Автор вопроса: barbos_82

'Скрипт архивирует и удаляет указанные DBF-базы 1С:Предпприятия v7.7. Требует наличия WinRAR (тестировался с версией 3.41)
'и библиотеки svcsvc.dll (http://www.script-coding.info/svcsvc.html). Скрипт выводит окно со списком зарегистрированных у Вас баз,
'в котором необходимо отметить нужные базы для архивирования и/или удаления и нажать "ОК". При удалении базы удаляются
'как с жёсткого диска Вашего компьютера, так и из диалога запуска 1С:Предпприятия. По умолчанию архивы помещаются в тот же
'каталог, где находится сам скрипт. Для имени архива используется имя информационной базы, как оно задано в диалоге запуска
'1С:Предпприятия. Просмотрите раздел "НАСТРОЙКИ" в тексте скрипта и исправьте его при необходимости. Если Вы хотите
'использовать другой архиватор, работающий из командной строки (не WinRAR), скрипт довольно легко исправить.

'ОСТОРОЖНО! Будьте внимательны при расстановке флажков при использовании скрипта, т.к. скрипт может безвозвратно удалить Ваши
'данные.
'=================================================================================================
On Error Resume Next
Set oFSO = CreateObject("Scripting.FileSystemObject")

' >> НАСТРОЙКИ ====================================================================================

'путь к исполняемому файлу WinRAR:
strWinRAR = """C:\Program Files\WinRAR\WinRAR.exe"""
'путь к папке, в которую помещаются архивы (сейчас это папка, в которой расположен этот скрипт в момент своего запуска):
strArchPath = oFSO.GetParentFolderName(WScript.ScriptFullName) & "\"

' << НАСТРОЙКИ ====================================================================================

Const HKEY_CURRENT_USER = &H80000001
'Запуск Internet Explorer для вывода сообщений
Set objExplorer = WScript.CreateObject("InternetExplorer.Application")
objExplorer.Navigate "about:blank"
objExplorer.ToolBar = 0
objExplorer.StatusBar = 0
objExplorer.Width = 700
objExplorer.Height = 300
objExplorer.Left = 0
objExplorer.Top = 0
Do While (objExplorer.Busy)
Wscript.Sleep 200
Loop
objExplorer.Visible = 1
'Подключение к реестру и получение списка доступных DBF-баз
objExplorer.Document.Write "Подключение к реестру ... "
Set oDict = CreateObject("Scripting.Dictionary")
Set oRegProv = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
If Err.Number <> 0 Then
objExplorer.Document.Write "Error " & Err.Number & ": " & Err.Description
WScript.Quit
End If
strKeyPath = "Software\1C\1Cv7\7.7\Titles"
iRes = oRegProv.EnumValues(HKEY_CURRENT_USER, strKeyPath, arrValues) 'получение баз
If iRes <> 0 Then
objExplorer.Document.Write "Call StdRegProv.EnumValues: error code " & iRes
WScript.Quit
End If
For i = LBound(arrValues) To UBound(arrValues) 'перебор баз
iRes = oRegProv.GetStringValue(HKEY_CURRENT_USER, strKeyPath, arrValues(i), Value)
If iRes <> 0 Then
objExplorer.Document.Write "Call StdRegProv.GetStringValue: error code " & iRes
WScript.Quit
End If
strBasePath = arrValues(i) 'каталог базы
strBaseName = Value 'название базы
If oFSO.FileExists(strBasePath & "1Cv7.DD") Then 'проверка существования и формата базы (DBF)
If InStr(Value, "|") = 0 Then
oDict.Add strBasePath, Value 'добавление базы в список
Else
MsgBox "Невозможна корректная работа с базой """ & Value & """, т.к. в её названии " & _
"есть символы вертикальной черты ""|"". Если Вы хотите работать с этой базой, " & _
"переименуйте её в диалоге запуска 1С:Предприятия и перезапустите скрипт.", _
vbOKOnly + vbExclamation, "Внимание!"
End If
End If
Next
'>>сортировка =====================================================================================
Set oDictSort = CreateObject("Scripting.Dictionary")
While oDict.Count > 0
strMin = ""
strKeyMin = ""
oKeys = oDict.Keys
oItems = oDict.Items
For i = 0 To oDict.Count - 1
strBasePath = oKeys(i) 'каталог базы
strBaseName = oItems(i) 'название базы
If strMin = "" Or StrComp(strBaseName, strMin, vbTextCompare) = -1 Then
strMin = strBaseName
strKeyMin = strBasePath
End If
Next
oDictSort.Add strKeyMin, strMin
oDict.Remove strKeyMin
Wend
Set oDict = oDictSort
'<<сортировка =====================================================================================
'Выбор баз пользователем для архивации и удаления
Set oSvcService = CreateObject("Svcsvc.Service")
strTree = ""
oKeys = oDict.Keys
oItems = oDict.Items
For i = 0 To oDict.Count - 1 'перебор списка баз
strBasePath = oKeys(i) 'каталог базы
strBaseName = oItems(i) 'название базы
strBase = strBaseName & " (" & strBasePath & ")"
strTree = strTree & strBase & vbCrLf & vbTab & "Удалить базу" & vbCrLf
Next
strTree = Trim(strTree)
strSel = oSvcService.SelectInTree(strTree, "Выберите базы 1С:Предприятия для архивации и/или удаления:", _
True, False)
If strSel = "" Then
objExplorer.Quit
WScript.Quit
End If
strSel = strSel & vbCrLf
'Выполнение
strForbidden = "/\:*?""<>|" 'символы, которые нельзя использовать в именах файлов
Set oWshShell = CreateObject("WScript.Shell")
For i = 0 To oDict.Count - 1 'перебор списка баз
strBasePath = oKeys(i) 'каталог базы
strBaseName = oItems(i) 'название базы
strBase = strBaseName & " (" & strBasePath & ")"
'Архивация
If InStr(strSel, strBase & vbCrLf) <> 0 Then
objExplorer.Document.Write "Архивация " & strBasePath & " " & _
"" & strBaseName & " ... "
'формирование имени архива
strArchName = ""
For j = 1 To Len(strBaseName)
Ch = Mid(strBaseName, j, 1)
If InStr(strForbidden, Ch) = 0 Then
strArchName = strArchName & Ch
Else
strArchName = strArchName & "_"
End If
Next
If oFSO.FileExists(strArchPath & strArchName & ".rar") Then
strArchName = strArchName & "1"
End If
j = 2
While oFSO.FileExists(strArchPath & strArchName & ".rar")
strArchName = Left(strArchName, Len(strArchName)-1) & j
j = j + 1
Wend
'командная строка WinRAR
strCommand = strWinRAR & " a -r -x*.cdx """ & strArchPath & strArchName & ".rar"" """ & _
strBasePath & """"
'запуск архивации (синхронно)
oWshShell.Run strCommand, 2, True
If Err.Number <> 0 Then
objExplorer.Document.Write "Error " & Err.Number & ": " & Err.Description
WScript.Quit
End If
objExplorer.Document.Write "Записан файл " & strArchPath & strArchName & ".rar. "
End If
'Удаление
If InStr(strSel, strBase & "\Удалить базу") <> 0 Then
objExplorer.Document.Write "Удаление базы " & strBasePath & " " & _
"" & strBaseName & " ... "
'физическое удаление базы
oFSO.DeleteFolder Left(strBasePath, Len(strBasePath)-1), True
If Err.Number <> 0 Then
objExplorer.Document.Write "Error " & Err.Number & ": " & Err.Description
WScript.Quit
End If
'удаление базы из реестра
iRes = oRegProv.DeleteValue(HKEY_CURRENT_USER, strKeyPath, strBasePath)
If iRes <> 0 Then
objExplorer.Document.Write "Call StdRegProv.DeleteValue: error code " & iRes
WScript.Quit
End If
End If
Next
objExplorer.Document.Write "Обработка завершена!"
Ответить

Ответы Всего ответов: 4

Номер ответа: 1 Автор ответа: User Unknown Вечный Юзер! ICQ: uu@jabber.cz Вопросов: 120 Ответов: 3302	Профиль \| \| #1	Добавлено: 02.09.08 10:12
	Помогите разобраться в программе Visual Studio! Может всё-таки напишешь что тебе не понятно или тебе первые семь строчек зацитировать? Ответить

Номер ответа: 2 Автор ответа: barbos_82 Вопросов: 2 Ответов: 2	Профиль \| \| #2	Добавлено: 02.09.08 10:16
	Как сделать чтобы в секции, где идет получение списка баз из реестра и когда они выводятся на экран глочки на базах ставились автоматом а не чтобы их нужно было выбирать! Нужно чтобы этот скрипт запускался в планировщике задач в определенное время,получал список баз из реестра, сам проставил галочки напротив полученных баз и начал архивацию! Помогите, я сам ламер в VBS просто нужно очень! 1C баз очень много есть которые на SQL (для них я уже нашел скрипт)есть просто обычные,вот для них то и нужен этот скрипт! Ответить

Номер ответа: 3 Автор ответа: barbos_82 Вопросов: 2 Ответов: 2	Профиль \| \| #3	Добавлено: 02.09.08 10:19
	Тоесть я имею ввиду нужно чтобы когда реестр просканируется на наличие 1С баз, скрипт сам проставил галочки на всех 1С базах автоматом! Ответить

Номер ответа: 4 Автор ответа: alroy Вопросов: 3 Ответов: 28	Профиль \| \| #4	Добавлено: 08.09.08 09:41
	Как я понимаю этот скрипт был написан изначально на то чтоб пользователь сам ставил галочки если все нужно автоматом то это мне кажеться сделать даже проще чем с в твоем варианте но это надо практически с нуля писать (или сильно переделывать этот код ) ... может я и неправ Ответить

Страница: 1 |