Код 1C v 7.x // Процедура получает из реестра список зарегистрированных ИБ 7.7
Процедура ПолучитьСписокИБ()
Попытка
ScrptCtrl=Новый COMObject("MSScriptControl.ScriptControl");
ScrptCtrl.Language="vbscript";
ScrptCtrl.AddCode("
|Function Get1CV77Titles()
| const HKEY_CURRENT_USER = &H80000001
| Set oReg=GetObject(""winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv"")
| strKeyPath = ""Software\1C\1Cv7\7.7\Titles""
| oReg.EnumValues HKEY_CURRENT_USER, strKeyPath, arrValues
| strInfo =vbNullString
| Get1CV77Titles = strInfo
| On Error Resume Next
| For i = LBound(arrValues) To UBound(arrValues)
| call oReg.GetStringValue(HKEY_CURRENT_USER,strKeyPath,arrValues(i),Value)
| strInfo =strInfo & arrValues(i) & vbTab & Value & vbCrLf
| Next
| Get1CV77Titles = strInfo
|End Function
|");
Текст=СокрЛП(ScrptCtrl.Run("Get1CV77Titles"));
Исключение
Сообщить(ОписаниеОшибки());
Возврат;
КонецПопытки;
ТаблицаПути.Очистить();
Если НЕ ЗначениеЗаполнено(Текст) Тогда
Возврат;
КонецЕсли;
Для Ном=1 По СтрЧислоСтрок(Текст) Цикл
СтрБазы=СтрПолучитьСтроку(Текст,Ном);
Разд=Найти(СтрБазы,Символы.Таб);
Путь=Лев(СтрБазы,Разд-1);
Название=Прав(СтрБазы,СтрДлина(СтрБазы)-Разд);
НоваяСтрока = ТаблицаПути.Добавить();
НоваяСтрока.Имя = Название;
НоваяСтрока.Путь = Путь;
КонецЦикла;
ТаблицаПути.Сортировать("Имя");
КонецПроцедуры //ПолучитьСписокИБ
Функция возвращает список значений содержащий список баз установленных на данном компьютаре. В котором в качестве значения указывается путь до базы, а в представлении название базы, так как она отображается в окне выбора баз при запуске 1С. Если баз не обнаруженно то возвращает строку "Error"
Код 1C v 7.x
функция сзПолучитьСписокБаз()
попытка
олеСкрипт = создатьобъект( "MSScriptControl.ScriptControl" ) ;
олеСкрипт. Language = "VBScript" ;
стрКод =
"function strGetListBase()
| const RootKey = &H80000001
| set Reg = GetObject("" winmgmts:{impersonationLevel=impersonate}!\\."" &_
| "" \root\default:StdRegProv"" )
| PathKey = "" Software\1C\1Cv7\7.7\Titles""
| Reg.EnumValues RootKey, PathKey, Arr
| Answer = "" {"" "" СписокЗначений"" "" ,{""
| for x = LBound(Arr) to UBound(Arr)
| call Reg.GetStringValue(RootKey, PathKey, Arr(x), Value)
| Answer = Answer & "" {{"" "" Строка"" "" ,"" "" "" &_
| Arr(x) & "" "" "" },"" "" "" & replace(Value, "" "" "" "" , "" "" "" "" "" "" ) &_
| "" "" "" ,"" "" 0"" "" }""
| if x <> UBound(Arr) then Answer = Answer & "" ,""
| next
| Answer = Answer & "" }}""
| strGetListBase = Answer
|end function" ;
олеСкрипт. AddCode( стрКод) ;
Ответ = значениеизстроки( олеСкрипт. Run( "strGetListBase" ) ) ;
Ответ. СортироватьПоПредставлению( ) ;
исключение
Ответ = "Error" ;
конецпопытки ;
возврат Ответ;
конецфункции
Еще примеры! Получение списка баз 1С 7.7 из реестра Ниже приведено несколько способов получения списка баз 1С 7.7 из реестра:
Код получения списка баз 1С 7.7 из 8.х
Код 1C v 8.х функция сзПолучитьСписокБаз()
попытка
олеСкрипт = новый COMОбъект( "MSScriptControl.ScriptControl" ) ;
олеСкрипт. Language = "VBScript" ;
стрКод =
"function strGetListBase()
| const RootKey = &H80000001
| set Reg = GetObject("" winmgmts:{impersonationLevel=impersonate}!\\."" &_
| "" \root\default:StdRegProv"" )
| PathKey = "" Software\1C\1Cv7\7.7\Titles""
| Reg.EnumValues RootKey, PathKey, Arr
| Answer = "" {"" "" #"" "" ,4772b3b4-f4a3-49c0-a1a5-8cb5961511a3,"" & chr(10)
| Answer = Answer & "" {3,1e512aab-1b41-4ef6-9375-f0137be9dd91,0,0,"" & chr(10)
| Answer = Answer & "" {"" & (UBound(Arr) + 1) & "" ,"" & chr(10)
| for x = LBound(Arr) to UBound(Arr)
| call Reg.GetStringValue(RootKey, PathKey, Arr(x), Value)
| Answer = Answer & "" {1e512aab-1b41-4ef6-9375-f0137be9dd91,"" & chr(10) &_
| "" {"" "" "" & replace(Value, "" "" "" "" , "" "" "" "" "" "" ) & "" "" "" ,0,"" &_
| chr(10) & "" {"" "" S"" "" ,"" "" "" & Arr(x)& "" "" "" },"" &_
| chr(10) & "" {3,0,"" & chr(10) & "" {0},"" "" "" "" ,-1,-1,0,0}"" &_
| chr(10) & "" }"" & chr(10) & "" }""
| if x <> UBound(Arr) then Answer = Answer & "" ,""
| Answer = Answer & chr(10)
| next
| Answer = Answer & "" },"" & chr(10) & "" {"" "" Pattern"" "" }"" & chr(10) &_
| "" }"" & chr(10) & "" }""
| strGetListBase = Answer
|end function" ;
олеСкрипт. AddCode( стрКод) ;
стрОтвет = олеСкрипт. Run( "strGetListBase" ) ;
Ответ = ЗначениеИзСтрокиВнутр( стрОтвет) ;
Ответ. СортироватьПоПредставлению( ) ;
исключение
Ответ = новый СписокЗначений;
Ответ. Добавить( "Базы 1С:Передприятия 7.7 не обнаруженны!" ) ;
конецпопытки ;
возврат Ответ;
конецфункции
Код для 1С 7.7
Код 1C v 7.x
Функция ПолучитьСписокБаз1()
Перем Value,arrValues;
Scr = CreateObject("MSScriptControl.ScriptControl");
Scr.Language = "vbscript";
Scr.Timeout=-1;
HKEY_CURRENT_USER = 2147483649;
strKeyPath = "Software\1C\1Cv7\7.7\Titles";
Locator=СоздатьОбъект("WbemScripting.SWbemLocator");
ServiceDef=Locator.ConnectServer(".","root\default");
oReg = ServiceDef.Get("StdRegProv");
Dict=СоздатьОбъект("Scripting.Dictionary");
Scr.AddObject("Dict",Dict);
Scr.AddObject("oReg",oReg);
Scr.ExecuteStatement("dim arrValues,Value:");
Scr.ExecuteStatement("oReg.EnumValues "+HKEY_CURRENT_USER+","""+strKeyPath+""",arrValues:");
Scr.ExecuteStatement("for i=lbound(arrValues) to ubound(arrValues):Dict.add ""pj"" & i, arrValues(i):next");
ТЗБаз=СоздатьОбъект("ТаблицаЗначений");
ТЗБаз.НоваяКолонка("Путь");
ТЗБаз.НоваяКолонка("Описание");
Для к=0 По Dict.count Цикл
Д=Dict.Item("pj"+к);
Scr.ExecuteStatement("oReg.GetStringValue "+HKEY_CURRENT_USER+","""+strKeyPath+""","""+Д+""",Value");
ТЗБаз.НоваяСтрока();
ТЗБаз.Путь = Д;
ТЗБаз.Описание = Scr.eval("Value");
КонецЦикла;
//Посмотрим что в ТЗ
//ТЗБаз.ВыбратьСтроку();
Возврат ТЗБаз;
КонецФункции
Процедура ПолучитьСписокБаз2()
Попытка
scrptCtrl=createobject("MSScriptControl.ScriptControl");
scrptCtrl.language="vbscript";
scrptCtrl.addcode("Function Get1CV77Titles()
|const HKEY_CURRENT_USER = &H80000001
|Set oReg=GetObject(""winmgmts:{impersonationLevel=impersonate}!\\."" &_
|""\root\default:StdRegProv"")
|strKeyPath = ""Software\1C\1Cv7\7.7\Titles""
|oReg.EnumValues HKEY_CURRENT_USER, strKeyPath, arrValues
|strInfo =vbNullString
|For i = LBound(arrValues) To UBound(arrValues)
| call oReg.GetStringValue(HKEY_CURRENT_USER,strKeyPath,arrValues(i),Value)
| strInfo =strInfo & arrValues(i) & ""="" & Value & vbCrLF
|Next
|Get1CV77Titles = strInfo
|End Function");
Сообщить(scrptCtrl.run("Get1CV77Titles"));
Исключение
Сообщить(ОписаниеОшибки());
КонецПопытки;
КонецПроцедуры
<Сообщил Gloom>
Процедура ПолучитьСписокБаз3()
Ключ="HKEY_CURRENT_USER\Software\1C\1Cv7\7.7\Titles";
ИмяКаталога=СокрЛП(КаталогПользователя());
ИмяБазы=СокрЛП(каталогИБ());
Если прав(ИмяКаталога,1)<>"\" Тогда ИмяКаталога=ИмяКаталога+"\" КонецЕсли;
Если прав(ИмяБазы,1)<>"\" Тогда ИмяБазы=ИмяБазы+"\" КонецЕсли;
ИмяБазыСтр=Симв(34)+СтрЗаменить(ИмяБазы,"\","\\")+Симв(34);
ИмяФайла="USER.TXT";
Команда="Regedit /ea "+Симв(34)+ИмяКаталога+ИмяФайла+Симв(34)+" "+Симв(34)+Ключ+Симв(34);
КомандаСистемы(Команда);
Текст=СоздатьОбъект("Текст");
Текст.КодоваяСтраница(0);
Текст.Открыть(ИмяКаталога+ИмяФайла);
Текст.Показать();
Стр=""; Нашли=0;
Для сч=1 по Текст.КоличествоСтрок() Цикл
Стр=СокрЛП(Текст.ПолучитьСтроку(сч));
Сообщить(Стр);
Если Найти(стр,ИмяБазыСтр)<>0 Тогда
Нашли=1;
прервать;
КонецЕсли;
КонецЦикла;
КонецПроцедуры
Код 1C v 7.x
спКомп = СоздатьОбъект("СписокЗначений");
Попытка
ScrptCtrl=СоздатьОбъект("MSScriptControl.ScriptControl");
ScrptCtrl.Language="vbscript";
ScrptCtrl.AddCode("
|Function GetComputers()
| Set WinNT = GetObject(""WinNT:"")
| WinNT.Filter = Array(""domain"")
| For Each Domain In WinNT
| Set ADSI = GetObject(""WinNT://"" & Domain.Name)
| ADSI.Filter = Array(""computer"")
| For Each Comp In ADSI
| strInfo =strInfo & Domain.Name & "";"" & Comp.Name & vbCrLf
| Next
| Next
| GetComputers = strInfo
|End Function
|");
Текст=СокрЛП(ScrptCtrl.Run("GetComputers"));
ScrptCtrl = "";
Исключение
Предупреждение(ОписаниеОшибки());
Возврат;
КонецПопытки;
Для Индекс=1 по СтрКоличествоСтрок(Текст) Цикл
СтрТекста=СтрПолучитьСтроку(Текст,Индекс);
Разделитель=Найти(СтрТекста,";");
Домен=Лев(СтрТекста,Разделитель-1);
Компьютер=Прав(СтрТекста,СтрДлина(СтрТекста)-Разделитель);
спКомп.ДобавитьЗначение(Компьютер,Домен+""+Компьютер);
КонецЦикла;
спКомп.Сортировать();
Код 1C v 8.х
спКомп = Новый СписокЗначений;
Попытка
ScrptCtrl= Новый COMОбъект("MSScriptControl.ScriptControl");
ScrptCtrl.Language="vbscript";
ScrptCtrl.AddCode("
|Function GetComputers()
| Set WinNT = GetObject(""WinNT:"")
| WinNT.Filter = Array(""domain"")
| For Each Domain In WinNT
| Set ADSI = GetObject(""WinNT://"" & Domain.Name)
| ADSI.Filter = Array(""computer"")
| For Each Comp In ADSI
| strInfo =strInfo & Domain.Name & "";"" & Comp.Name & vbCrLf
| Next
| Next
| GetComputers = strInfo
|End Function
|");
Текст=СокрЛП(ScrptCtrl.Run("GetComputers"));
ScrptCtrl = "";
Исключение
Предупреждение(ОписаниеОшибки());
Возврат;
КонецПопытки;
Для Индекс=1 по СтрЧислоСтрок(Текст) Цикл
СтрТекста=СтрПолучитьСтроку(Текст,Индекс);
Разделитель=Найти(СтрТекста,";");
Домен=Лев(СтрТекста,Разделитель-1);
Компьютер=Прав(СтрТекста,СтрДлина(СтрТекста)-Разделитель);
спКомп.Добавить(Компьютер,Домен+""+Компьютер);
КонецЦикла;
спКомп.СортироватьПоПредставлению();
//Выберем комп
спКомп.ВыбратьЭлемент();