execquery » Поиск

Результаты по ключевому слову: execquery

Как очистить кэш 1С? Категория: Администрирование

Скрипт переустанавливает Платформу 1С и прописывает нужные базы, ярлыки!

Круглов Дмитрий дмитриевич:
Скрипт определяет наличие предыдущих платформ и деинсталлирует их..
далее устанавливает последнююю версию, прописывает нужные базы и прямые ярлыки

Код VBS

 Option Explicit

Const Server = "62.76.65.113" ' Здесь мы зададим ip нашего общего ресурса (можно задать через имя компьютера)



If Ping (Server) = True Then ' проверим доступно ли место

Dim ProductCod 'код продукта (Смотри в каталоге каждого дистрибутива платформы в файле setup.ini

Dim DistrFolder 'каталог в которм находится дистрибутив платформы

Dim cmdLine 'Параметры запуска дистрибутива



'Деинсталируем предыдущие платформы

cmdLine = "REMOVE=ALL"



ProductCod = "{375C3BB1-6F1E-4D93-9AF7-6A379133CA81}"

DistrFolder= "\\" & Server & "\1s\8.2.10.73\"

	If Ustanovlena(ProductCod) Then ' Здесь и далее идет проверка на наличие установленной данной версии платформы

	SdelatEto ProductCod, DistrFolder + "1CEnterprise 8.2.msi", cmdLine

	'Иногда папка остается в каталоге installer после удаления - исправим это

	UdalitFolder ProductCod

	End If

	

ProductCod = "{8150646B-4F88-4415-AF2A-F96199E3DA37}"

DistrFolder= "\\" & Server & "\1s\8.2.10.77\"

	If Ustanovlena(ProductCod) Then 

	SdelatEto ProductCod, DistrFolder + "1CEnterprise 8.2.msi", cmdLine

	End If



'Установим текущую платформу

ProductCod = "{3D5173F0-371D-4B5D-B96A-9340D7F30431}"

DistrFolder= "\\" & Server & "\1s\8.2.10.82\"

cmdLine = "TRANSFORMS=adminstallrelogon.mst;1049.mst DESIGNERALLCLIENTS=0 THICKCLIENT=0 THINCLIENTFILE=1 THINCLIENT=1 WEBSERVEREXT=0 SERVER=0 CONFREPOSSERVER=0 CONVERTER77=0 SERVERCLIENT=0 LANGUAGES=RU" 

'В данном случае мне нужны только установленные тонкие клиенты, если надо больше - поменяйте на 1, то что надо установить   

	If Not Ustanovlena(ProductCod) Then ' Если текущая версия не установлена - установим ее

	SdelatEto ProductCod, DistrFolder + "1CEnterprise 8.2.msi", cmdLine

	End If	



ScopirovatSpisokBaz ' В любом случае обновим список ИБ (Вдруг или мы или пользователи, что-то поменяли)



End If  



Sub SdelatEto (ByVal productCode, ByVal msiPackage, ByVal CmdLine)

    On Error Resume Next

    Dim installer

    Set installer = Nothing

    Set installer = Wscript.CreateObject("WindowsInstaller.Installer")

    installer.UILevel = 2 'молчаливая установка (варианты смотрите в Руководстве администратора 8.2 стр.185

    installer.InstallProduct msiPackage,cmdLine

    Set installer = Nothing

End Sub



Sub UdalitFolder (ProductCod)

On Error Resume Next

Dim fso1, WSH1

set WSH1 = WScript.CreateObject("WScript.Shell")

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

fso1.DeleteFolder WSH1.ExpandEnvironmentStrings("%systemroot%") & "\Installer\" & ProductCod, True

End Sub



'Создаем список баз данных (копируем наш фал с сервера на клиент

Sub ScopirovatSpisokBaz

On Error Resume Next

Dim fso1, WSH1

Set WSH1 = WScript.CreateObject("WScript.Shell")

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

fso1.CopyFile "\\" & Server & "\1s\1CEStart\ibases.v8i",WSH1.ExpandEnvironmentStrings("%AppData%") & "\1C\1CEStart\ibases.v8i", True

End Sub



'создание ярлыка

Sub createShurtcut

    Dim WshShell, oShellLink, ServerBD, NameBD

    ServerBD = "IZO-NoteBook"

    NameBD = "1C_Dec_82" 

    Set WshShell = WScript.CreateObject("WScript.Shell")

    Dim strDesktop : strDesktop = WshShell.SpecialFolders("Desktop")

    Set oShellLink = WshShell.CreateShortcut(strDesktop & "\" & shortcutName & ".lnk")

    oShellLink.TargetPath = WSHShell.ExpandEnvironmentStrings("%ProgramFiles%") & "\1cv82\Common\1cestart.exe /S" & ServerBD & "\" & NameBD 'Если не указывать параметры, то будет появлятся стандартное окно выбора ИБ, если укажем, то сразу имя пользователя-пароль 

    oShellLink.WindowStyle = 1

    oShellLink.Description = shortcutName

    oShellLink.Save 

    Set oShellLink = Nothing

    Set WshShell = Nothing

End Sub



Function Ustanovlena(ProductCod)

On Error Resume Next

Dim fso1, oFolders, WSH1

set WSH1 = WScript.CreateObject("WScript.Shell")

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

Set oFolders = Nothing

Set oFolders = fso1.GetFolder(WSH1.ExpandEnvironmentStrings("%systemroot%") & "\Installer\" & ProductCod)

If OFolders  Is Nothing Then

Ustanovlena = False

Else

Ustanovlena = True

End If

End Function



Function Ping(strHost)

' Просто пингуем наш компутер, проверяя включен ли он

        Dim objPing, objRetStatus

        Set objPing = GetObject("winmgmts:\\.\root\CIMV2").ExecQuery _

        ("S_elect * FROM Win32_PingStatus WHERE address = '" & strHost & "'")

        for Each objRetStatus in objPing

          if IsNull(objRetStatus.StatusCode) or objRetStatus.StatusCode<>0 Then

            Ping = False

          Else

            Ping = True

          End If

        Next

End Function

Рябко Михаил Евгеньевич:
При установке файла 1CEnterprise 8.2.msi через GPO платформа ставилась, но потом ее не могли удалить (после выключения из групповых политик установки). Никакой unistaller ee не брал. Потом почистили реестр, вроде победили.
Более того, инсталлер не прописывал ярлыки в каталог %SystemRoot%\Installer\{8150646B-4F88-4415-AF2A-F96199E3DA37},из за этого все ярлыки были без картинок.

Даже если бы все работало, этот способ не очень понравился, т.к. для 8.2 через те же GPO нельзя прописать базы. А смысл тогда?
Далее пробовали через скрипт. Такое же непредсказуемое поведение по деинсталляции платформы. Кроме этого появлялось 2 ярлыка после установки. Один - который прописан в скрипте, другой - после работы инсталлятора. Ну ладно, написал файл трансформации, чтобы лишний ярлык не создавал, но проблема ошибки при выполнения скрипта ("Требуется объект") и деинсталляции осталась.
Точно также проблема деинсталляции и с ярлыками остается при прямой установке 1CEnterprise 8.2.msi (без трансформации, запуском из проводника), разве что из списка программ удаляется, а все файлы остаются.
В итоге пришли к решению в лоб. Раз уж запуск 1cestart.exe на расшаренной папке дает более-менее положительный результат вручную, то нужно и идти по этому пути. Написал скрипт установки. Вроде работает. Правда, чтобы ограничится установкой без запуска, пришлось создать базу-пустышку и намеренно внести ошибку в параметр запуска. Далее по комментариям все должно быть понятно.

А так есть подозрение, что причина в кривом файле 1CEnterprise 8.2.msi (ярлыки то хотя бы он должен создавать нормально?). То ли дело установка через Setip.exe - тут все в шоколаде и работает.

Итак, альтернативный скрипт (сохранить с расширением *.vbs)

Код VBS

 Option Explicit



'Этот скрипт выполняет установку 1С 8.2 с помощью операций типа

'copy \\Server\Adm_1C_8_2\Null-Base\Zero_dblist.v8i %AppData%\1C\1CEStart\ibases.v8i

'\\Server\Adm_1C_8_2\Kadry_Zarplata_Buh\1cestart.exe Enterprise /F \\Server\d$\Adm_1C_8_2\Null-Base



'***** Необходимо изменить на реальный каталог установки,

'***** где лежат папки с дистрибутивами типа 8.2.10.77

Const DistrFolder="\\Server\Adm_1C_8_2\"

'Если тонкого клиента ставить не собираетесь из папки setuptc, то лучше ее удалите, т.к. инсталлер

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

'об этом не просят.



'***** Для каждго набора баз (отдела) свой подкаталог, в котором располагаются 1CESCmn, 1cestart.exe,

'***** common_dblist.v8i и этот скрипт Setup 1C8_2.vbs

Const DistrFolderOtdel="Kadry_Zarplata_Buh\"



'Т.к. отключить запуск 1С при выполнении 1CEStart нельзя (а нам нужна только установка), то кроме этого скрипта должна быть

'создана пустая база в каталоге \\Server\Adm_1C_8_2\Null-Base.

'Для надежности в модуле управляемого приложения базы можно прописать процедуру

'

'Процедура ПередНачаломРаботыСистемы(Отказ)

' // Вставить содержимое обработчика.

' ЗавершитьРаботуСистемы(Ложь);

'КонецПроцедуры



'В эту же папку положить файл-пустышку общих баз Zero_dblist.v8i



Const myBase = "\\Server\Adm_1C_8_2\Null-Base"



Dim shortcutTarget : shortcutTarget = DistrFolder & DistrFolderOtdel & "1cestart.exe"

Dim WshShell

Dim strAppData

Dim objFSO

Dim strFolder1C, strFolder1CEStart, strFullFolderName, strFullFileName



'Сначала получим каталог пользователя

Set WshShell = WScript.CreateObject("WScript.Shell")

strAppData = WSHShell.SpecialFolders("AppData")



Set objFSO = CreateObject("Scripting.FileSystemObject")



'Проверим наличие папок у пользователя и при необходимости создадим

strFolder1C = "1C"

strFolder1CEStart = "1CEStart"

strFullFolderName =  objFSO.BuildPath(strAppData, strFolder1C)



If Not objFSO.FolderExists(strFullFolderName) Then

   objFSO.CreateFolder strFullFolderName

End If



strFullFolderName =  objFSO.BuildPath(strAppData & "\" &strFolder1C, strFolder1CEStart)



If Not objFSO.FolderExists(strFullFolderName) Then

   objFSO.CreateFolder strFullFolderName

End If



'Если файл со списокм баз уже есть, то затирать его не будем

strFullFileName = objFSO.BuildPath(strFullFolderName, "ibases.v8i")

If Not objFSO.FileExists(strFullFileName) Then

'Скопируем пустой список общих баз из папки с пустой базой,

'чтобы при запуске не задавались рядовому пользователю вопросы типа "Скопировать список баз из 8.1?"

objFSO.CopyFile  myBase & "\" & "Zero_dblist.v8i", strAppData & "\1C\1CEStart\ibases.v8i", True

Set objFSO = Nothing

End If



'Теперь установка

'Указан параметр nterprise вместо Enterprise, чтобы подавить запуск самой 1С из-за ошибки параметра

'т.к. нужна только инсталляция. Вот такая хитрость.

WshShell.run(shortcutTarget & " nterprise /F " & myBase)

Set WshShell = Nothing

Категория: Администрирование

Полезные процедуры работы с Active Directory (AD)

Надоели просить меня запостить рабочие модули работы с AD, вот запостил, в качестве бонуса убийца любого процесса в памяти любого компа.
p.s. для работы нужны определенные права.
Автор: vde69

Код 1C v 8.х

 Функция ПолучитьСписокДоменов () Экспорт  

	Результат = Новый Массив(); 

	objNameSpace = "";                   

	Попытка  objNameSpace = ПолучитьCOMОбъект("WinNT:");   

		м = Новый Массив();  м.Добавить("domain"); // Computer User Group GlobalGroup domain  

		м2 = Новый COMSafeArray(м, "VT_VARIANT");  

		objNameSpace.Filter = м2;  

		Для каждого item Из objNameSpace Цикл   

			Результат.Добавить(item.Name);  

		КонецЦикла; 

	Исключение  

		Результат.Очистить(); 

	КонецПопытки;  

	Возврат Результат;

КонецФункции





Функция ПолучитьСписокГруппВДомене (ИмяДомена, ТипГрупп = "GlobalGroup") Экспорт  

	Результат = Новый Массив(); 

	objNameSpace = "";  

	Попытка  objNameSpace = ПолучитьCOMОбъект("WinNT://"+СокрЛП(ИмяДомена));   

		м = Новый Массив();  

		м.Добавить(ТипГрупп); // Computer User Group GlobalGroup domain  

		м2 = Новый COMSafeArray(м, "VT_VARIANT");  

		objNameSpace.Filter = м2;  

		Для каждого item Из objNameSpace Цикл   

			Результат.Добавить(item.Name);  

		КонецЦикла; 

	Исключение  

		Результат.Очистить(); 

	КонецПопытки;  

	

	Возврат Результат;

КонецФункции

	

Функция ПолучитьСписокПользователейВГруппеДомена (ИмяДомена, ИмяГруппы) Экспорт  

	Результат = Новый Массив(); 

	objNameSpace = "";  

	Попытка  

		objNameSpace = ПолучитьCOMОбъект("WinNT://" + СокрЛП(ИмяДомена) + "/" + СокрЛП(ИмяГруппы) + ", Group");   

		Для каждого item Из objNameSpace.Members() Цикл   

			Результат.Добавить(item.Name);  

		КонецЦикла; 

	Исключение  

		Результат.Очистить(); 

	КонецПопытки;  

	

	Возврат Результат;	

КонецФункции



Функция ПользовательВГруппеДомена (ИмяДомена, ИмяГруппы, ИмяПользователя) Экспорт  

	Результат = Ложь;  

	Массив = ПолучитьСписокПользователейВГруппеДомена (СокрЛП(ИмяДомена), ИмяГруппы);

	Для каждого элМассив из Массив Цикл  

		Если ВРег(элМассив) = ВРег(СокрЛП(ИмяПользователя)) Тогда   // пользователь уже в группе   

			Результат = Истина;    

			Прервать;  

		КонецЕсли; 

	КонецЦикла;  

	

	Возврат Результат;

КонецФункции



Функция ДобавитьПользователяВГруппуДомена (ИмяДомена, ИмяГруппы, ИмяПользователя) Экспорт  

	Результат = Ложь; 

	element_user = ""; 

	element_group = "";  

	Попытка  

		element_user = ПолучитьCOMОбъект("WinNT://" + ИмяДомена + "/" + ИмяПользователя + ", user");  

		element_group = ПолучитьCOMОбъект("WinNT://" + ИмяДомена + "/" + ИмяГруппы + ", group");  

		element_group.Add(element_user.ADsPath);  element_group.SetInfo();  

		Результат = Истина; 

	Исключение  

		Результат = Ложь; 

	КонецПопытки;  

	

	Возврат Результат;

КонецФункции



Функция УдалитьПользователяИзГруппыДомена (ИмяДомена, ИмяГруппы, ИмяПользователя) Экспорт  

	Результат = Ложь; 

	element_user = ""; 

	element_group = "";  

	Попытка  element_user = ПолучитьCOMОбъект("WinNT://" + ИмяДомена + "/" + ИмяПользователя + ", user");  

		element_group = ПолучитьCOMОбъект("WinNT://" + ИмяДомена + "/" + ИмяГруппы + ", group");  

		element_group.Remove(element_user.ADsPath);  

		element_group.SetInfo();  

		Результат = Истина; 

	Исключение  

		Результат = Ложь; 

	КонецПопытки;  

	

	Возврат Результат;	

КонецФункции



Процедура ЗаполнитьПочтовыеАдресаИзAD() 

	Попытка      

		conn = ПолучитьCOMОбъект("","ADODB.Connection");  

		conn.Provider = "ADSDSOObject";  

		conn.Open("Active Directory Provider"); 

	Исключение  Предупреждение("Ошибка подключения к Active Directory!");  

		Возврат; 

	КонецПопытки;   

	

	Для Каждого Стр из Таблица Цикл  

		Если НЕ ПустаяСтрока(Стр.Логин) Тогда   

			Попытка        

				query = "SEL ECT ADsPath FR OM 'LDAP://DC="+СокрЛП(Домен.Код)+"' WHERE SAMAccountName='"+Стр.Логин+"'";    

				rs = conn.Execute(query);    

				Пока НЕ rs.EOF() Цикл     

					obj = ПолучитьCOMОбъект(rs.Fields(0).Value);     

					Если obj.Class="user" Тогда      

						Стр.НоваяПочта=СокрЛП(obj.EmailAddress);      

						Если Стр.НоваяПочта<>Стр.СтараяПочта Тогда       

							Стр.Установить=Истина;      

						КонецЕсли;     

					КонецЕсли;     

					rs.MoveNext();    

				КонецЦикла;   

			Исключение

				Сообщить("Ошибка получения почты для логина :"+Стр.Логин);				                                                      

			КонецПопытки;

		КонецЕсли;

	КонецЦикла;

	conn.Close();	

КонецПроцедуры



Функция УдалитьПроцесс (ИмяКомпьютера, НазваниеПроцесса, Логин, Пароль) Экспорт  

	Попытка  COM = Новый COMОбъект ("WbemScripting.SWbemLocator");  

		Серв = COM.ConnectServer(СокрЛп(ИмяКомпьютера), "\root\cimv2", СокрЛП(Логин), СокрЛП(Пароль));  

		СписокПроцессов = Серв.execQuery("Sel ect * fr om Win32_Process Where Name = '"+СокрЛП(НазваниеПроцесса)+"'");  

		Для каждого item Из СписокПроцессов Цикл   

			item.Terminate();  

		КонецЦикла; 

	Исключение  

		Возврат Ложь; 

	КонецПопытки;  

	

	Возврат Истина;

КонецФункции

Код 1C v 8.х

 // coder1cv8 - Мой вариант получения почты 1С-ного пользователя:

Функция ПолучитьMailПоПользователю(СсылкаПользователь)

Адрес="";

ПользовательИБ=ПользователиИнформационнойБазы.НайтиПоИмени(СокрЛП(СсылкаПользователь.Код));

Если ПользовательИБ<>Неопределено Тогда

   Если ПользовательИБ.АутентификацияОС Тогда

     ПользовательОС=СтрЗаменить(ПользовательИБ.ПользовательОС,"\","/");

       Попытка

         ЮзерАД=ПолучитьCOMОбъект("WinNT:"+ПользовательОС+",user");

         LDAP=ПолучитьCOMОбъект("LDAP://CN="+ЮзерАД.FullName+",OU=Common Users,OU=Regular Users,DC="+Домен+",DC=local");

         Адрес=LDAP.Mail;

       Исключение

       КонецПопытки;

  КонецЕсли;

КонецЕсли;

Возврат Адрес;

КонецФункции

Категория: COM-объекты, WMI, WSH

Обновление платформы на клиентских машинах и восстановление списка информационных баз пользователей

Периодически сталкиваюсь с проблемой обновления платформы на клиентских машинах, + периодически пользователи удаляют, изменяют или добавляют какие-то новые информационные БД.
В случае 8.2 новые релизы платформы стали штамповать чуть ли не каждый месяц, что меня повергло в уныние, разбираясь в этом вопросе понял: у кого есть домен могут легко реализовать с помощью доменных политик..Те же кто лишен домена и работает в рабочих группах, может прибегнуть к помощи кривоватого скрипта от 1С (текст скрипта приведен в руководстве администратора 8.2 стр. 185
Но как быть, если нужно одновременно снести старую платформу и поставить новую + что б еще у всех пользователей был одинаковый список информационных БД, Да и лучше, что б по ссылке вообще автоматом выбиралась нужна ИБ!
Для решения нам нужно какое-нибудь общедоступное сетевое пространство, куда мы кладем дистрибутивы платформ и нужный нам список баз (отредактированный файлик ibases.v8i)

Итак, пишем скрипт от меня с любовью и комментариями

Код VBS

 Option Explicit

Const Server = "62.76.65.113" ' Здесь мы зададим ip нашего общего ресурса (можно задать через имя компьютера)



If Ping (Server) = True Then ' проверим доступно ли место

Dim ProductCod 'код продукта (Смотри в каталоге каждого дистрибутива платформы в файле setup.ini

Dim DistrFolder 'каталог в которм находится дистрибутив платформы

Dim cmdLine 'Параметры запуска дистрибутива



'Деинсталируем предыдущие платформы

cmdLine = "REMOVE=ALL"



ProductCod = "{375C3BB1-6F1E-4D93-9AF7-6A379133CA81}"

DistrFolder= "\\" & Server & "\1s\8.2.10.73\"

    If Ustanovlena(ProductCod) Then ' Здесь и далее идет проверка на наличие установленной данной версии платформы

    SdelatEto ProductCod, DistrFolder + "1CEnterprise 8.2.msi", cmdLine

    'Иногда папка остается в каталоге installer после удаления - исправим это

    UdalitFolder ProductCod

    End If

    

ProductCod = "{8150646B-4F88-4415-AF2A-F96199E3DA37}"

DistrFolder= "\\" & Server & "\1s\8.2.10.77\"

    If Ustanovlena(ProductCod) Then 

    SdelatEto ProductCod, DistrFolder + "1CEnterprise 8.2.msi", cmdLine

    End If



'Установим текущую платформу

ProductCod = "{3D5173F0-371D-4B5D-B96A-9340D7F30431}"

DistrFolder= "\\" & Server & "\1s\8.2.10.82\"

cmdLine = "TRANSFORMS=adminstallrelogon.mst;1049.mst DESIGNERALLCLIENTS=0 THICKCLIENT=0 THINCLIENTFILE=1 THINCLIENT=1 WEBSERVEREXT=0 SERVER=0 CONFREPOSSERVER=0 CONVERTER77=0 SERVERCLIENT=0 LANGUAGES=RU" 

'В данном случае мне нужны только установленные тонкие клиенты, если надо больше - поменяйте на 1, то что надо установить   

    If Not Ustanovlena(ProductCod) Then ' Если текущая версия не установлена - установим ее

    SdelatEto ProductCod, DistrFolder + "1CEnterprise 8.2.msi", cmdLine

    End If    



ScopirovatSpisokBaz ' В любом случае обновим список ИБ (Вдруг или мы или пользователи, что-то поменяли)



End If  



Sub SdelatEto (ByVal productCode, ByVal msiPackage, ByVal CmdLine)

    On Error Resume Next

    Dim installer

    Set installer = Nothing

    Set installer = Wscript.CreateObject("WindowsInstaller.Installer")

    installer.UILevel = 2 'молчаливая установка (варианты смотрите в Руководстве администратора 8.2 стр.185

    installer.InstallProduct msiPackage,cmdLine

    Set installer = Nothing

End Sub



Sub UdalitFolder (ProductCod)

On Error Resume Next

Dim fso1, WSH1

set WSH1 = WScript.CreateObject("WScript.Shell")

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

fso1.DeleteFolder WSH1.ExpandEnvironmentStrings("%systemroot%") & "\Installer\" & ProductCod, True

End Sub



'Создаем список баз данных (копируем наш фал с сервера на клиент

Sub ScopirovatSpisokBaz

On Error Resume Next

Dim fso1, WSH1

Set WSH1 = WScript.CreateObject("WScript.Shell")

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

fso1.CopyFile "\\" & Server & "\1s\1CEStart\ibases.v8i",WSH1.ExpandEnvironmentStrings("%AppData%") & "\1C\1CEStart\ibases.v8i", True

End Sub



'создание ярлыка

Sub createShurtcut

    Dim WshShell, oShellLink, ServerBD, NameBD

    ServerBD = "IZO-NoteBook"

    NameBD = "1C_Dec_82" 

    Set WshShell = WScript.CreateObject("WScript.Shell")

    Dim strDesktop : strDesktop = WshShell.SpecialFolders("Desktop")

    Set oShellLink = WshShell.CreateShortcut(strDesktop & "\" & shortcutName & ".lnk")

    oShellLink.TargetPath = WSHShell.ExpandEnvironmentStrings("%ProgramFiles%") & "\1cv82\Common\1cestart.exe /S" & ServerBD & "\" & NameBD 'Если не указывать параметры, то будет появлятся стандартное окно выбора ИБ, если укажем, то сразу имя пользователя-пароль 

    oShellLink.WindowStyle = 1

    oShellLink.Description = shortcutName

    oShellLink.Save 

    Set oShellLink = Nothing

    Set WshShell = Nothing

End Sub



Function Ustanovlena(ProductCod)

On Error Resume Next

Dim fso1, oFolders, WSH1

set WSH1 = WScript.CreateObject("WScript.Shell")

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

Set oFolders = Nothing

Set oFolders = fso1.GetFolder(WSH1.ExpandEnvironmentStrings("%systemroot%") & "\Installer\" & ProductCod)

If OFolders  Is Nothing Then

Ustanovlena = False

Else

Ustanovlena = True

End If

End Function



Function Ping(strHost)

' Просто пингуем наш компутер, проверяя включен ли он

        Dim objPing, objRetStatus

        Set objPing = GetObject("winmgmts:\\.\root\CIMV2").ExecQuery _

        ("S_elect * FROM Win32_PingStatus WHERE address = '" & strHost & "'")

        for Each objRetStatus in objPing

          if IsNull(objRetStatus.StatusCode) or objRetStatus.StatusCode<>0 Then

            Ping = False

          Else

            Ping = True

          End If

        Next

End Function

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

Источник

Категория: Администрирование

Получить имя принтера выбранного по умолчанию Категория: COM-объекты, WMI, WSH

Скрипт принудительного завершения процессов 1С на всех компьютерах

В примере "1cv7s.exe", для 8-ки замениете на "1cv8.exe"

Код VBS

 

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

'на всех компьютерахуказанного домена. Данный код можно применять непосредственно перед пакетным запуском 1С:Предприятия,

'требующим монопольного входа в базу данных (например, при резервном копировании).



'ВНИМАНИЕ! Задайте нужное значение переменной "DomainName"!



'ВНИМАНИЕ! Для успешной работы скрипта его желательно запускать с правами администратора домена.



'ВНИМАНИЕ! Чтобы опробовать скрипт, не производя деструктивных действий, достаточно закомментировать

'оператор "Proc.Terminate".



Option Explicit

On Error Resume Next



Dim DomainName 'Имя домена

DomainName = "MYDOMAIN"



Dim StrResult 'строка результата работы всей программы

StrResult = StrResult & CStr(Now) & " начало работы скрипта" & VbCrLf



Dim ADSI

Set ADSI = GetObject("WinNT://" & DomainName)

ADSI.Filter = Array("computer")



Dim Comp 'компьютер

Dim WMI 'объект WMI

Dim Proc 'процесс



Dim CurrName 'имя текущего компьютера

CurrName = GetNameComp()



'Цикл по компьютерам домена

For Each Comp In ADSI

    If Comp.Name <> CurrName Then

        Set WMI = GetObject("winmgmts:{ImpersonationLevel=Impersonate}!\\" & Trim(Comp.Name) & "\Root\CIMV2")

        If Err.Number=0 Then

            'Цикл по процессам компьютера

            For Each Proc In WMI.ExecQuery("S_elect * FROM Win32_Process WHERE Name = '1cv7s.exe'")

                StrResult = StrResult & _

                            CStr(Now) & " Computer=" & Comp.Name & " PID=" & Proc.ProcessId & _

                            VbCrLf

                'Завершение процесса

                Proc.Terminate

            Next 'Цикл по процессам компьютера

        Else 'Не удалось соединиться с компьютером

            If Err.Number <> 462 Then 'The remote server machine does not exist or is unavailable

                StrResult = StrResult & _

                  	        "    " & CStr(Now) & " Computer=" & Comp.Name & " ERROR " & Err.Number & _

                      	    VbCrLf

            End If

        End If

        Err.Clear

    End If

Next 'Цикл по компьютерам домена



StrResult = StrResult & CStr(Now) & " конец работы скрипта" & VbCrLf



'Отображение результата

ShowInNotepad("Процессы 1cv7s.exe:" & VbCrLf & VbCrLf & StrResult)

'==========================================================================

'Процедура отображает переданную строку в блокноте

Sub ShowInNotepad(StrToFile)

    Dim FSO 'Объект файловой системы Scripting.FileSystemObject

    Dim TempPath 'Путь к временному файлу

    Dim TxtFile 'Поток текстового файла

    

    Set FSO = CreateObject("Scripting.FileSystemObject")

    TempPath = GetTempPath() & "\" & FSO.GetTempName

    Set TxtFile = FSO.CreateTextFile(TempPath)

    TxtFile.WriteLine(StrToFile)

    TxtFile.Close

    CreateObject("WScript.Shell").Run "notepad.exe " & TempPath

    WScript.Sleep 1000

    FSO.DeleteFile TempPath

End Sub 'ShowInNotepad

'==========================================================================

'Функция возвращает путь к каталогу временных файлов текущего пользователя

Function GetTempPath()

    GetTempPath = CreateObject("WScript.Shell").ExpandEnvironmentStrings("%TEMP%")

End Function 'GetTempPath

'==========================================================================

'Функция возвращает имя текущего компьютера

Function GetNameComp()

    GetNameComp = CreateObject("WScript.Network").ComputerName

End Function 'GetNameComp

Категория: Администрирование

Получить статус сетевой карты(устройства), Работает или уже нет

Код 1C v 7.x

 // Глобальная переменная в которой будем хранить

// известные нам типы статусов сетевой карты

перем сзТипСтатуса;

// Глобальная переменая

перем обШелл;



//*******************************************

// стрСтатусАдаптера(стрИмя = "")

//

// Параметры:

//  стрИмя - Строка. Имя сетевой статус которой надо определить.

//           В том виде как показа в сетвых подключениях.

//

// Возвращаемое значение:

//  Строка. Статус заданой сетевой.

//

// Описание:

//  Функция определяет статус сетевой.

//

функция стрСтатусАдаптера(стрИмя = "")

    Ответ = "";

    // Попытаемся получить статус через контрол скриптов

    попытка

        сзСтевые = создатьобъект("списокзначений");

        // Выполняем скрипт. Из полученного значения пытаемся

        // сформировать список значений

        сзСтевые = значениеизстроки(обШелл.Run("strGetAdapterInfo"));

    исключение

        // По каким-то причинам выполнить скрипт не удалось

        Ответ = "Статус установить не удалось";

    конецпопытки;

    // Если в возращаемом значение пустая строка, то скрипт

    // выполнился. Можно смотреть дальше.

    если Ответ = "" тогда

        // Получаем индекс статуса сетевой.

        стрСтатус = строка(сзСтевые.Получить(стрИмя));

        // Проверяем на пустое значение индекса.

        если пустоезначение(стрСтатус) = 1 тогда

            // Если индекс пуст, то сетевая суказанным именем отсуствует

            Ответ = "Сетевая с таким именем отсуствует";

        иначе

            // Ищем индекс статуса в известных нам типов статуса.

            чисПозиция = сзТипСтатуса.НайтиЗначение(стрСтатус);

            если чисПозиция = 0 тогда

                // Не нашли. Смотрим MSDN

                Ответ = "Не известный тип статуса сетевой";

            иначе

                // Получаем строковое представление статуса.

                сзТипСтатуса.ПолучитьЗначение(чисПозиция, Ответ);

            конецесли;

        конецесли;

    конецесли;

    // Возвращаем полученный статус

    возврат Ответ;

конецфункции;



//*******************************************

// Этот блок обязателен.

// Необходимо что бы он отработал до первого вызова

// функции стрСтатусАдаптера

//*******************************************

// Создаем объект для управления скриптами

обШелл = создатьобъект("MSScriptControl.ScriptControl");

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

обШелл.Language = "VBScript";

// Сам срипт который соберет статусы всех сетевых устройств

тхтКод = "

|function strGetAdapterInfo()

|  dim objNetworkAdapter

|  Answer = ""{""""СписокЗначений"""",{""

|  set objWMI = getobject(""WinMgmts:\\.\Root\CIMV2"")

|  set objNetworkAdapters = objWMI.ExecQuery(""S_elect * FROM Win32_NetworkAdapter"", , 48)

|  for each objNetworkAdapter in objNetworkAdapters

|    Answer = Answer & ""{{""""Строка"""","""""" & objNetworkAdapter.NetConnectionStatus &_

|             """"""}, """""" & objNetworkAdapter.NetConnectionID & """""",""""0""""}""

|            

|  next

|  Answer = Answer & ""}}""

|  strGetAdapterInfo = Answer

|  end function";

// Добавим наш скрипт в котрол скриптов

обШелл.AddCode(тхтКод);

// Создадим список значений в который поместим все известные нам

// виды статуса сетевых устройств.

сзТипСтатуса = создатьобъект("списокзначений");

// Поместим в список значений виды статусов их строковое представление

сзТипСтатуса.ДобавитьЗначение("0", "Отключенно");

сзТипСтатуса.ДобавитьЗначение("1", "Подключение");

сзТипСтатуса.ДобавитьЗначение("2", "Подключено");

сзТипСтатуса.ДобавитьЗначение("3", "Отключение");

сзТипСтатуса.ДобавитьЗначение("4", "Устройство не представленно");

сзТипСтатуса.ДобавитьЗначение("5", "Устройство отключено");

сзТипСтатуса.ДобавитьЗначение("6", "Устройство не исправно");

сзТипСтатуса.ДобавитьЗначение("7", "Соединение разорвано");

сзТипСтатуса.ДобавитьЗначение("8", "Аутентификация");

сзТипСтатуса.ДобавитьЗначение("9", "Аутентификация прошла успешно");

сзТипСтатуса.ДобавитьЗначение("10", "Аутентификация не прошла");

сзТипСтатуса.ДобавитьЗначение("11", "Неправильный адресс");

сзТипСтатуса.ДобавитьЗначение("12", "Требуется полномочия");

IUnknown

Категория: COM-объекты, WMI, WSH

Экспорт печатных форм и любых данных из 1С в BMP, JPEG, PCX, PDF, PNG и TIFF.

Оптимальным решением является установка Bullzip PDF Printer . После установки в системе появляется виртуальный принтер, с помощью которого можно "печатать" в файл pdf из любого приложения. Программа бесплатная, работает в терминале и имеет поддержку русского языка.
После установки, можно печатать напрямую используя код:

Код 1C v 8.х

 

//Таб - ТабличныйДокумент

//ИмяФайла – путь для сохранения файла PDF  (например «D:\Torg12.pdf»)

Процедура СоздатьФайлПДФ(Таб, ИмяФайла)



Попытка

ПДФПринтер = Новый ComObject(«Bullzip.PDFPrinterSettings»);

ПДФПринтер.SetValue(«output», ИмяФайла);

ПДФПринтер.SetValue(«ShowSaveAS», «never»);

ПДФПринтер.SetValue(«ShowProgress», «no»);

ПДФПринтер.SetValue(«ShowProgressFinished», «no»);

ПДФПринтер.SetValue(«ShowSettings», «never»);

ПДФПринтер.SetValue(«ShowPDF», «no»);

ПДФПринтер.SetValue(«ConfirmOverwrite»,»no»);

ПДФПринтер.WriteSettings();

Таб.Автомасштаб = Истина;

Таб.ИмяПринтера = «Bullzip PDF Printer»;Таб.Напечатать(Истина);

PDFФайл = Новый Файл(ИмяФайла);



Пока НЕ PDFФайл.Существует() Цикл

ОбработкаПрерыванияПользователя();

КонецЦикла;



Исключение



Сообщить(ОписаниеОшибки());

Сообщить(«Скорее всего необходимо установить или переустановить «»Bullzip PDF Printer»);

КонецПопытки;

//устанавливаем принтер по умолчанию

Таб.ИмяПринтера = ПолучитьПринтерПоУмолчанию();

КонецПроцедуры

Здесь функция ПолучитьПринтерПоУмолчанию() нужна для того чтобы вернуть печатной форме принтер по умолчанию, т.к. если напечатать без предварительного просмотра то печать пойдет на виртуальный PDF принтер BullzipPDFPrinter.

Код 1C v 8.х

 //получаем принтер по умолчанию

Функция ПолучитьПринтерПоУмолчанию()



Скрипт = Новый ComObject(«MSScriptControl.ScriptControl»);

Скрипт.Language = «vbscript»;

Скрипт.AddCode(»

|Function GetDefaultPrinter()

|GetDefaultPrinter=vbNullString

|Set objWMIService=GetObject(«»winmgmts:»" _

|& «»{impersonationLevel=impersonate}!\\.\root\cimv2&#8243;»)

|Set colInstalledPrinters=objWMIService.ExecQuery _

|(«»S_elect * from Win32_Printer»")

|For Each objPrinter in colInstalledPrinters

|If objPrinter.Attributes and 4 Then

|GetDefaultPrinter=objPrinter.Name

|Exit For

|End If

|Next

|End Function»);

Возврат СокрЛП(Скрипт.run(«GetDefaultPrinter»));

КонецФункции

Печать в PDF используя bioPDF

Категория: Администрирование

Получение локальных, сетевых, сменных (флешек) дисков компьютера Категория: COM-объекты, WMI, WSH