Ниже приведено несколько способов получения списка баз 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;
прервать;
КонецЕсли;
КонецЦикла;
КонецПроцедуры
Ниже привожу пример функции нечеткого сравнения строк. Возвращаемое значение - от 0 (вообще не совпадает) до 1 (совпадает полностью)
По опыту, результат сравнения можно считать достоверным при совпадении больше 0.8 (80%)
Код CREATE FUNCTION fn_FuzzyCompareString(
@Stri1 varchar(250),
@Stri2 varchar(250),
@MaxLen int)
RETURNS float
AS
BEGIN
DECLARE @Str1 varchar(250), @Str2 varchar(250), @SCountVar int,
@SCountEq int, @LenStr int, @Res float
DECLARE @NumSymbStr2 int
DECLARE @Cnt1 int, @Cnt2 int
DECLARE @SubStr varchar(250)
SELECT
@LenStr=1,
@SCountVar=0 ,
@SCountEq=0,
@res=0
Set @Str1 = replace (LTRIM(RTRIM(upper(@Stri1))),'.',' ')
Set @Str2 = replace (LTRIM(RTRIM(upper(@Stri2))),'.',' ')
if ((@MaxLen <= 0) or (Len(@Str1)=0) or (Len(@Str2)=0))
Begin
Set @Res=0
End
else
begin
While (@LenStr<=@MaxLen)
BEGIN
Set @NumSymbStr2=1
Set @Cnt2=0
While ((@Cnt2+@LenStr)<=LEN(@Str2))
BEGIN
Set @SubStr = '%'+SUBSTRING(@Str2,@NumSymbStr2,@LenStr)+'%'
if (PATINDEX(@SubStr, @Str1)<>0)
begin
Set @SCountEq=@SCountEq+1
end
Set @SCountVar=@SCountVar+1
Set @NumSymbStr2=@NumSymbStr2+1
Set @Cnt2 = @Cnt2+1
END
Set @NumSymbStr2=1
Set @Cnt2=0
While ((@Cnt2+@LenStr)<=LEN(@Str1))
BEGIN
Set @SubStr = '%'+SUBSTRING(@Str1,@NumSymbStr2,@LenStr)+'%'
if (PATINDEX(@SubStr, @Str2)<>0)
begin
Set @SCountEq=@SCountEq+1
end
Set @SCountVar=@SCountVar+1
Set @NumSymbStr2=@NumSymbStr2+1
Set @Cnt2 = @Cnt2+1
END
Set @LenStr=@LEnStr+1
END
end
if @SCountVar=0
SET @Res=0
Else
BEGIN
SET @Res=Convert(Numeric (10,5),@SCountEq)/Convert(Numeric (10,5),@SCountVar)
END
RETURN @Res
END
Использование этой функции (на примере прямого запроса к справочнику ФизЛица для 1С:ТиС 7.7): в выборку попадут все физлица, у которых релевантность выше 0.8
Код DECLARE @FIO varchar(250)
Set @FIO = 'Иванов Петр'
SELECT
Спр.Code as [ФизЛицоКод],
Спр.ID as [ФизЛицо],
Спр.DESCR as [ФИО],
dbo.fn_FuzzyCompareString(dbo.fn_FIO(Спр.DESCR),@FIO,3) As [Релевантность]
FROM
SC503 as Спр (nolock)
where
ISMARK = 0
and
ISFOLDER = 2
and
dbo.fn_FuzzyCompareString(dbo.fn_FIO(Спр.DESCR),@FIO,3)>=0.8
GO