Ниже приведено несколько способов получения списка баз 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