Формирование адреса из внешнего Кладра (MS SQL Server)

[Ренат]

Доброго всем времени суток.
При формирование отчетности столкнулись с необходимостью ввода адресов контрагентов в соответсвии с КЛАДР.
Вот пример "верного" адреса "643,445354,63,,ЖИГУЛЕВСК Г,,ПРОМЫШЛЕННАЯ УЛ,10,,"
Решение поставленной задачи реализовали в следующем порядке

[Ренат]

1) создали БД на MS SQL Server

Код: Выделить всё

if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[CheckAddress]') and xtype in (N'FN', N'IF', N'TF'))
drop function [dbo].[CheckAddress]
GO

if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[GetAreas]') and xtype in (N'FN', N'IF', N'TF'))
drop function [dbo].[GetAreas]
GO

if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[GetIndexByDom]') and xtype in (N'FN', N'IF', N'TF'))
drop function [dbo].[GetIndexByDom]
GO

if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[GetOrgWithINN]') and xtype in (N'FN', N'IF', N'TF'))
drop function [dbo].[GetOrgWithINN]
GO

if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[GetPlaces]') and xtype in (N'FN', N'IF', N'TF'))
drop function [dbo].[GetPlaces]
GO

if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[GetRegions]') and xtype in (N'FN', N'IF', N'TF'))
drop function [dbo].[GetRegions]
GO

if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[GetStreets]') and xtype in (N'FN', N'IF', N'TF'))
drop function [dbo].[GetStreets]
GO

if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[GetTowns]') and xtype in (N'FN', N'IF', N'TF'))
drop function [dbo].[GetTowns]
GO

if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[Get_only_Number]') and xtype in (N'FN', N'IF', N'TF'))
drop function [dbo].[Get_only_Number]
GO

if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[isAdress]') and xtype in (N'FN', N'IF', N'TF'))
drop function [dbo].[isAdress]
GO

if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[toDat]') and xtype in (N'FN', N'IF', N'TF'))
drop function [dbo].[toDat]
GO

if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[SellFromPeriod]') and OBJECTPROPERTY(id, N'IsProcedure') = 1)
drop procedure [dbo].[SellFromPeriod]
GO

if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[SetOrg]') and OBJECTPROPERTY(id, N'IsProcedure') = 1)
drop procedure [dbo].[SetOrg]
GO

if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[NaklPrih]') and OBJECTPROPERTY(id, N'IsView') = 1)
drop view [dbo].[NaklPrih]
GO

if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[NaklRash]') and OBJECTPROPERTY(id, N'IsView') = 1)
drop view [dbo].[NaklRash]
GO

if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[E_Clients]') and OBJECTPROPERTY(id, N'IsUserTable') = 1)
drop table [dbo].[E_Clients]
GO

if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[Full_Address]') and OBJECTPROPERTY(id, N'IsUserTable') = 1)
drop table [dbo].[Full_Address]
GO

if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[KLADR_Areas]') and OBJECTPROPERTY(id, N'IsUserTable') = 1)
drop table [dbo].[KLADR_Areas]
GO

if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[KLADR_DOMA]') and OBJECTPROPERTY(id, N'IsUserTable') = 1)
drop table [dbo].[KLADR_DOMA]
GO

if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[KLADR_Places]') and OBJECTPROPERTY(id, N'IsUserTable') = 1)
drop table [dbo].[KLADR_Places]
GO

if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[KLADR_Regions]') and OBJECTPROPERTY(id, N'IsUserTable') = 1)
drop table [dbo].[KLADR_Regions]
GO

if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[KLADR_Towns]') and OBJECTPROPERTY(id, N'IsUserTable') = 1)
drop table [dbo].[KLADR_Towns]
GO

if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[SAVEORG]') and OBJECTPROPERTY(id, N'IsUserTable') = 1)
drop table [dbo].[SAVEORG]
GO

if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[STREET]') and OBJECTPROPERTY(id, N'IsUserTable') = 1)
drop table [dbo].[STREET]
GO

if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[kladr]') and OBJECTPROPERTY(id, N'IsUserTable') = 1)
drop table [dbo].[kladr]
GO

SET QUOTED_IDENTIFIER OFF
GO
SET ANSI_NULLS OFF
GO

CREATE FUNCTION dbo.CheckAddress (
@post_index varchar(6),
@Region varchar(2),
@Area varchar(40),
@Town varchar(40),
@Place varchar(40),
@Street varchar(40),
@dom  varchar(40)
)
RETURNS  @ResultTable table (   
        resvalue varchar(80)
)
AS 
begin

--Текущие найденные коды для элементов адреса
declare @post_index_Solved as varchar(6)
Declare @index varchar (6);
Declare @Region_Code varchar(13);
Declare @Area_Code varchar(13);
Declare @Town_Code varchar(13);
Declare @Place_Code varchar(13);
Declare @Street_Code varchar(17);
Set @post_index_Solved='';
--Проверяем наличие такого регона. Описываем курсор для извленчения кодов для следующего элемента
set @region = ltrim(rtrim(isnull(@region,'')))
if len(@region)=1 set @region='0'+@region

declare find_regions cursor for
   SELECT [index],
         code AS Region_Code,
      code AS Area_Code,
      code AS Town_Code,
      code AS Place_Code
     FROM  dbo.KLADR_Regions
     WHERE (@region=Region_Code)
for read only;

open  find_regions;
fetch next from find_regions
into  @index, @Region_Code, @Area_Code, @Town_Code, @Place_Code;

declare @isError as varchar(100);
Set @isError=null;
if (@@fetch_status <> 0) Set @isError='Не найден регион.'
else if @index is not null Set @post_index_Solved=@index;

--select @isError
deallocate find_regions


--Теперь проверяем райончик
if (@isError is null) and  (ltrim(rtrim(@area))<>'')
begin
declare find_areas cursor for    
SELECT   [index],
      Region_Code + '00000000000' AS Region_Code,
      code AS Area_Code,
           code AS Town_Code,
           code AS Place_Code
FROM dbo.kladr_Areas WHERE ((@region =Region_Code) and ((name+' '+socr)=@area) )

open  find_areas;
fetch next from find_areas
into  @index, @Region_Code, @Area_Code, @Town_Code, @Place_Code;

if (@@fetch_status <> 0) Set @isError='Не найден район'
else if @index is not null Set @post_index_Solved=@index;

Deallocate find_areas;

end

--Проверяем город

if (@isError is null) and  (ltrim(rtrim(@Town))<>'')
begin

declare find_towns cursor for    
   select
     [index],
          Region_code + '00000000000' AS Region_code,
     Region_code+Area_Code + '00000000' as Area_Code,
     code as Town_Code,
          code as  Place_Code
FROM  dbo.KLADR_Towns WHERE     (@Region_code=Region_code + '00000000000')
and      ((@Area_Code IS NULL) or (@Area_Code=Region_code+Area_Code+ '00000000'))  and (ltrim(rtrim((name+' '+socr)))=@town)

open  find_towns;
fetch next from find_towns
into  @index, @Region_Code, @Area_Code, @Town_Code, @Place_Code;

if (@@fetch_status <> 0) Set @isError='Не найден город'
else if @index is not null Set @post_index_Solved=@index;
Deallocate find_towns;

end

--теперь проверим населенный пункт
if (@isError is null) and  (ltrim(rtrim(@place))<>'')
begin

declare find_NasPunkt cursor for    
SELECT 
     [index],
     Region_Code + '00000000000' AS Region_code,
     Region_Code+Area_Code   + '00000000' as Area_Code,
          Region_Code+Area_Code+Town_Code + '00000' as Town_Code,
     code as Place_Code
FROM         dbo.KLADR_Places
WHERE        (ltrim(rtrim((name+' '+socr)))=@place) and   
   @Region_Code= Region_Code + '00000000000'
      and @Area_Code = Region_Code+Area_Code + '00000000'
      and ((@Town_Code IS NULL) OR (@Town_Code=Region_Code+Area_Code+Town_Code + '00000'))


open  find_NasPunkt;
fetch next from find_NasPunkt
into  @index, @Region_Code, @Area_Code, @Town_Code, @Place_Code;

if (@@fetch_status <> 0) Set @isError='Не найден населенный пункт'
else if @index is not null Set @post_index_Solved=@index;
Deallocate find_NasPunkt;

end

--Теперь нужно проверить улочку
if (@isError is null) and  (ltrim(rtrim(@street))<>'')
begin

declare find_Street cursor for    
SELECT  [index],
   [code]
from street
where         (ltrim(rtrim((name+' '+socr)))=@street)
   and @Region_Code= SUBSTRING(code, 1, 2) + '00000000000'
   and ((@Area_Code IS NULL) OR (@Area_Code = SUBSTRING(code, 1, 5)+ '00000000'))
   and ((@Town_code IS NULL) OR (@Town_code=SUBSTRING(code, 1, 8)+ '00000'))
   and ((@Place_code IS NULL) OR (@Place_code = SUBSTRING(code, 1, 11)+ '00'))

open  find_Street;
fetch next from find_Street 
into  @index, @Street_Code;

if (@@fetch_status <> 0) Set @isError='Не найдена улица'
else if @index is not null Set @post_index_Solved=@index;

Deallocate find_Street;

end

-- Теперь нужно вычислить индекс по дому
if (@isError is null) and  (ltrim(rtrim(@dom))<>'')
begin
   declare find_Index cursor for    
      select [index] from dbo.GetIndexByDom(@Region_Code,@Area_Code, @Town_Code, @Place_Code, @Street_Code,@dom);

   open find_Index ;

   fetch next from find_Index   
    into  @index;
   Deallocate find_Index;

     if ltrim(rtrim(@index))='' begin --Если не нашли индекс для данного дома, то попробуем найте его для дома в числовом наименовании т.е. на для "10Б", а "10"
         Set @dom=dbo.Get_only_Number(@dom)
         declare find_Index cursor for    
            select [index] from dbo.GetIndexByDom(@Region_Code,@Area_Code, @Town_Code, @Place_Code, @Street_Code,@dom);
         open find_Index ;
         fetch next from find_Index   
                into  @index;
         Deallocate find_Index;
        end

   if (@index is not null) and (rtrim(ltrim(@index))<>'')  and (rtrim(ltrim(@index))<>'NoDom') Set @post_index_Solved=@index;
end;

-- Теперь нужно проверить индекс
if (@isError is null) and (@post_index_Solved<>@post_index )
      set @isError='Индекс '+coalesce(@post_index,'')+' не совпадает с вычесленым из Кладра '+coalesce(@post_index_Solved,'')

insert into @ResultTable (resvalue) Values(@isError);

return

end






GO
SET QUOTED_IDENTIFIER OFF
GO
SET ANSI_NULLS ON
GO

SET QUOTED_IDENTIFIER OFF
GO
SET ANSI_NULLS OFF
GO

CREATE FUNCTION GetAreas (@Region_Code varchar(13)= null)

RETURNS @RegionsTable table (   
        Country_code varchar(3),
        N_Region varchar(2),
        [name] varchar (40),
   [socr] varchar (10),
   [code] varchar (13),
   [index] varchar (6) ,
   [gninmb] varchar (4),
        [Region_Code] varchar(13),
        [Area_Code] varchar(13),
        [Town_Code] varchar(13),
        [Place_Code] varchar(13),
   ShortAreaCode varchar(3)
   )
AS 
begin
  declare @reg_code varchar(2)
  set @reg_code = ltrim(rtrim(isnull(@Region_Code,'')))
  if len(@reg_code)=1 set @reg_code='0'+@reg_code

insert @RegionsTable
SELECT  643, Region_Code as N_Region,
                name, lower(socr), code, [index], gninmb,
      Region_Code + '00000000000' AS Region_Code,
      code AS Area_Code,
               code AS Town_Code,
                code AS Place_Code,
      Area_Code AS ShortAreaCode
FROM       dbo.kladr_Areas
WHERE     ((@reg_code=Region_Code))

return
end








GO
SET QUOTED_IDENTIFIER OFF
GO
SET ANSI_NULLS ON
GO

SET QUOTED_IDENTIFIER OFF
GO
SET ANSI_NULLS OFF
GO

CREATE FUNCTION dbo.GetIndexByDom (
@Region_Code varchar(13),
@Area_Code varchar(13)=null,
@Town varchar(13)=null,
@Place varchar(13)=null,
@Street varchar(17)=null,
@dom  varchar(10)=null)

RETURNS  @IndexTable table (   
        [Index] varchar(80)
)
AS 

BEGIN

Declare @ReturnIndex varchar(80)
Declare @isInt_nomerDoma int
Declare @Int_nomerDoma int
Declare @Int_nomerDoma_chetn int
Declare @Primern_Int_nomerDoma int --примерный целочисленный номер дома
Set @ReturnIndex=''

--Set @dom='1F'
Set @dom=Ltrim(Rtrim(@dom))

Set @isInt_nomerDoma=1
declare @len_doma int
Set @len_doma =Len(@dom)
Set @Primern_Int_nomerDoma=0

If (@len_doma >=1) begin
    if substring(@dom,1,1) not in ('1','2','3','4','5','6','7','8','9','0') 
         Set @isInt_nomerDoma=0
      else if @isInt_nomerDoma=1 Set @Primern_Int_nomerDoma=cast(substring(@dom,1,1) as int)+@Primern_Int_nomerDoma*10;
end

If (@len_doma >=2) begin
    if substring(@dom,2,1) not in ('1','2','3','4','5','6','7','8','9','0')  Set @isInt_nomerDoma=0
      else if @isInt_nomerDoma=1 Set @Primern_Int_nomerDoma=cast(substring(@dom,2,1) as int)+@Primern_Int_nomerDoma*10;
end

If (@len_doma >=3)   begin
    if substring(@dom,3,1) not in ('1','2','3','4','5','6','7','8','9','0')  Set @isInt_nomerDoma=0
      else if @isInt_nomerDoma=1 Set @Primern_Int_nomerDoma=cast(substring(@dom,3,1) as int)+@Primern_Int_nomerDoma*10;
end
If (@len_doma >=4)   begin
    if substring(@dom,4,1) not in ('1','2','3','4','5','6','7','8','9','0')  Set @isInt_nomerDoma=0
      else if @isInt_nomerDoma=1 Set @Primern_Int_nomerDoma=cast(substring(@dom,4,1) as int)+@Primern_Int_nomerDoma*10;
end
If (@len_doma >=5)   begin
    if substring(@dom,5,1) not in ('1','2','3','4','5','6','7','8','9','0')  Set @isInt_nomerDoma=0
      else if @isInt_nomerDoma=1 Set @Primern_Int_nomerDoma=cast(substring(@dom,5,1) as int)+@Primern_Int_nomerDoma*10;
end
If (@len_doma >=6)   begin
    if substring(@dom,6,1) not in ('1','2','3','4','5','6','7','8','9','0')  Set @isInt_nomerDoma=0
      else if @isInt_nomerDoma=1 Set @Primern_Int_nomerDoma=cast(substring(@dom,6,1) as int)+@Primern_Int_nomerDoma*10;
end
If (@len_doma >=7)   begin
    if substring(@dom,7,1) not in ('1','2','3','4','5','6','7','8','9','0')  Set @isInt_nomerDoma=0
      else if @isInt_nomerDoma=1 Set @Primern_Int_nomerDoma=cast(substring(@dom,7,1) as int)+@Primern_Int_nomerDoma*10;
end
If (@len_doma >=8)   begin
    if substring(@dom,8,1) not in ('1','2','3','4','5','6','7','8','9','0')  Set @isInt_nomerDoma=0
      else if @isInt_nomerDoma=1 Set @Primern_Int_nomerDoma=cast(substring(@dom,8,1) as int)+@Primern_Int_nomerDoma*10;
end
If (@len_doma >=9)   begin
    if substring(@dom,9,1) not in ('1','2','3','4','5','6','7','8','9','0')  Set @isInt_nomerDoma=0
      else if @isInt_nomerDoma=1 Set @Primern_Int_nomerDoma=cast(substring(@dom,9,1) as int)+@Primern_Int_nomerDoma*10;
end
If (@len_doma >=10)  begin
    if substring(@dom,10,1) not in ('1','2','3','4','5','6','7','8','9','0')  Set @isInt_nomerDoma=0
      else if @isInt_nomerDoma=1 Set @Primern_Int_nomerDoma=cast(substring(@dom,10,1) as int)+@Primern_Int_nomerDoma*10;
end

If @isInt_nomerDoma=1 begin
   Set @Int_nomerDoma=cast(@dom as int)
   if (ROUND(cast(@Int_nomerDoma as float)/2,0)) = (cast(@Int_nomerDoma as float)/2)  Set @Int_nomerDoma_chetn=1 else  Set @Int_nomerDoma_chetn=0
end   

declare @Index as varchar (6);
--set @Region_code = '4300000000000'
--set @Area_Code   = '4300000000000'
--set @Town         = '4300000100000'
--set @Place       = '4300000100000'
--Set @Street      = '43000001000048200'

set @Region_code  = SUBSTRING(@Region_Code, 1, 2)
set @Area_Code    = SUBSTRING(@Area_Code, 3, 3)
set @Town          = SUBSTRING(@Town, 6, 3)
set @Place      = SUBSTRING(@Place, 9, 3)
set @Street      = SUBSTRING(@Street, 12, 4)

declare nomera_domov cursor for
   select ltrim(rtrim(name)), [index] from  dbo.Kladr_Doma  where
   @Region_Code = Region_Code and
   @Area_Code   = Area_Code and
   @Town        = Town_Code and 
   @Place         = Place_code  and
   @Street      = Street_Code
   order by [Index]
for read only;

open  nomera_domov;
Declare @Name_diapazonov varchar(40);
fetch next from nomera_domov
into  @Name_diapazonov,@ReturnIndex;

declare @isFindIndex int
Set @isFindIndex =0

if @@fetch_status <>0  --Если ни одного дома не найдено, значит надо взять индекс от улицы
begin
   set @ReturnIndex='NoDom'
end

while @@fetch_status = 0
begin
--Ну попытаемся проанализоровать чего тут есть.  Если не получиться будем использовать первый найденный индекс   
--все лучше чем ничего
--Действуем в соответствии с документацией на кладр. . Длина блока не более 40 символов
--стр № 7
--вариант 1 - в блоке содержится номер одного дома или перечень домов разделеных символом ","
--вариант 2 - в блоке содержится интревалы домов. Буду считать что они не начинаются на символы "Н" и "Ч"
--вариант 3 - в блоке содержится комбинация первого и второго варианта

   Declare @CurNomer as varchar(40)
   Declare @num_zapjat int
   while Len(@Name_diapazonov)>0 begin
      Declare @begin_num int;
      Declare @end_num   int;
--Вычленяем все что до зыпятой
      Set @num_zapjat=CHARINDEX(',',@Name_diapazonov);
      if @num_zapjat=0 Set  @CurNomer=@Name_diapazonov;
      if @num_zapjat>1 Set  @CurNomer=substring(@Name_diapazonov,1,@num_zapjat-1);
--      print @CurNomer
      if @num_zapjat<>len(@Name_diapazonov) begin
              Set @Name_diapazonov=ltrim(rtrim(substring(@Name_diapazonov,@num_zapjat+1,40)));
      end;
--Это вариант номер 1
      if @CurNomer =@dom begin
         Set @isFindIndex =1;
         break;
      end;--if
--Это вариант номер 2. Применим лишь в том случае если у нас числовое значение дома
      if @isInt_nomerDoma=1  begin
         if Len(@CurNomer)>2 begin
            if (substring(@CurNomer,1,2)='Н(' or substring(@CurNomer,1,2)='Ч(') and
               (substring(@CurNomer,Len(@CurNomer),1)=')') and
                   (CHARINDEX('-',@CurNomer)>0)         
              begin
            --Теперь выделяем номер. Должно быть число, затем дефис и опять число
--               '-'
            set @begin_num=cast(substring(@CurNomer,3,CHARINDEX('-',@CurNomer)-2-1) as int)         
            set @end_num  =cast(substring(@CurNomer,  CHARINDEX('-',@CurNomer)+1,
                               (len(@CurNomer)-(CHARINDEX('-',@CurNomer)+1))
                     )                       as int)
            if substring(@CurNomer,1,2)='Н(' and @Int_nomerDoma_chetn=0 begin
               if (@Int_nomerDoma>=@begin_num and @Int_nomerDoma<=@end_num) or
                  (@Int_nomerDoma>=@begin_num and @end_num=999) begin
               Set @isFindIndex =1;
               break;
               end
            end

            if substring(@CurNomer,1,2)='Ч(' and @Int_nomerDoma_chetn=1 begin
               if (@Int_nomerDoma>=@begin_num and @Int_nomerDoma<=@end_num) or
                  (@Int_nomerDoma>=@begin_num and @end_num=999) begin
               Set @isFindIndex =1;
               break;
               end
            end
             end--if Len(@CurNomer)>2 begin
         end;--if      
      end;--   if @isInt_nomerDoma=1  begin

--Это вариант номер 3. Применим лишь в том случае если у нас числовое значение дома
   if @isInt_nomerDoma=1  begin   
      if Len(@CurNomer)>2 begin
         --Если диапазон начался на номер и у ного есть знак тире
         if (substring(@CurNomer,1,1)in ('1','2','3','4','5','6','7','8','9','0')) and
                (CHARINDEX('-',@CurNomer)>0) and CHARINDEX('-',@CurNomer)<>Len(@CurNomer)   and
           (substring(@CurNomer,CHARINDEX('-',@CurNomer)+1,1)in ('1','2','3','4','5','6','7','8','9','0'))
           begin
      --Теперь выделяем номер. Должно быть число, затем дефис и опять число
         set @begin_num=cast(substring(@CurNomer,1,CHARINDEX('-',@CurNomer)-1) as int)         
         set @end_num  =cast(substring(@CurNomer,  CHARINDEX('-',@CurNomer)+1,
                             (len(@CurNomer)-CHARINDEX('-',@CurNomer))
                  )                       as int)
         if ( @Int_nomerDoma>=@begin_num and @Int_nomerDoma<=@end_num) or
               (@Int_nomerDoma>=@begin_num and @end_num=999) begin
            Set @isFindIndex =1;
            break;
         end
            end--if Len(@CurNomer)>2 begin
      end;--if      
   end;--   if @isInt_nomerDoma=1  begin


      if  (@num_zapjat=0) or (@num_zapjat=1 and Len(ltrim(rtrim(@Name_diapazonov)))=1) begin
         break;   
      end;--if
   if @isFindIndex =1 break;
   end;--while

if @isFindIndex =1 break;

fetch next from nomera_domov
into  @Name_diapazonov,@ReturnIndex;

end; --while

deallocate  nomera_domov;

if  @isFindIndex =1 or  @ReturnIndex='NoDom'
insert into  @IndexTable([Index]) values(@ReturnIndex)
else
insert into  @IndexTable([Index]) values('')

return 

END











GO
SET QUOTED_IDENTIFIER OFF
GO
SET ANSI_NULLS ON
GO

SET QUOTED_IDENTIFIER OFF
GO
SET ANSI_NULLS OFF
GO

CREATE FUNCTION GetOrgWithINN(@INN varchar(15),@KPP varchar(15), @KOD varchar(3))
RETURNS @RetTable table (   
        [Kod] varchar(3),
   [NameOrg] varchar(200),
   [INN] varchar(15),
   [KPP] varchar(15),
   [Region] varchar(2),
   [Adress] varchar(200),
   [Lic] varchar(50),
   [LicBy] varchar(200)
   )
AS 
begin
insert @RetTable
Select Kod,NameOrg,INN,KPP,Region,Adress,Lic,LicBy from saveorg Where inn=@INN and kpp=@KPP and kod=@KOD
insert @RetTable
Select Kod,NameOrg,INN,KPP,Region,Adress,Lic,LicBy  from saveorg Where inn=@INN and kpp=@KPP
return
end

GO
SET QUOTED_IDENTIFIER OFF
GO
SET ANSI_NULLS ON
GO

SET QUOTED_IDENTIFIER OFF
GO
SET ANSI_NULLS OFF
GO

CREATE FUNCTION GetPlaces (@Region_Code varchar(13), @Area_Code varchar(13), @Town_Code varchar(13)=null)
RETURNS @PlacesTable table (   
             Country_code varchar(3),
             N_Region varchar(2),
   [name] varchar (40),
   [socr] varchar (10),
   [code] varchar (13),
   [index] varchar (6) ,
   [gninmb] varchar (4),
        [Region_Code] varchar(13),
        [Area_Code] varchar(13),
        [Town_Code] varchar(13),
        [Place_Code] varchar(13)
   )
AS 
begin
if len(@Region_code) <11 
set @Region_code = (SUBSTRING(@Region_Code, 1, 2) + '00000000000')
set @Region_code = (SUBSTRING(@Region_Code, 1, 11) + '00')
set @Area_Code = ltrim(rtrim(isnull(@Area_Code,@Region_code)))
if len(@Area_Code) <11 
set @Area_Code = (SUBSTRING(@Area_Code, 1, 2) + '00000000000')
set @Area_Code = (SUBSTRING(@Area_Code, 1, 11) + '00')
set @Town_Code = (SUBSTRING(@Town_Code, 1, 11) + '00')

insert @PlacesTable
SELECT  643,
                Region_Code as N_Region,
                name, socr, code, [index], gninmb,
      Region_Code + '00000000000' AS Region_code,
      Region_Code+Area_Code   + '00000000' as Area_Code,
                Region_Code+Area_Code+Town_Code + '00000' as Town_Code,
      code as Place_Code
FROM         dbo.KLADR_Places
WHERE     

@Region_Code= Region_Code + '00000000000'
and @Area_Code = Region_Code+Area_Code + '00000000'
and ((@Town_Code IS NULL) OR (@Town_Code=Region_Code+Area_Code+Town_Code + '00000'))

return
end







GO
SET QUOTED_IDENTIFIER OFF
GO
SET ANSI_NULLS ON
GO

SET QUOTED_IDENTIFIER OFF
GO
SET ANSI_NULLS OFF
GO

CREATE   FUNCTION GetRegions (@Region_Code  varchar(13) = null)
RETURNS @RegionsTable table (   
        Country_code varchar(3),
        N_Region varchar(2),
        [name] varchar (40),
   [socr] varchar (10),
   [code] varchar (13),
   [index] varchar (6) ,
   [gninmb] varchar (4),
             [Region_Code] varchar(13),
             [Area_Code] varchar(13),
             [Town_Code] varchar(13),
             [Place_Code] varchar(13),
   ShortRegionCode varchar(2)
   )
AS 
begin
  declare @reg_code varchar(2)
  set @reg_code = ltrim(rtrim(isnull(@Region_Code,'')))
  if len(@reg_code)=1 set @reg_code='0'+@reg_code

  insert @RegionsTable
   SELECT    643,
   Region_Code as N_Region,
   [name], lower(socr), code, [index], gninmb,
   code AS Region_Code,
   code AS Area_Code,
   code AS Town_Code,
   code AS Place_Code,
   Region_Code AS ShortRegionCode
     FROM         dbo.KLADR_Regions
     WHERE     (@reg_code=Region_Code) or (@reg_code='') or (@reg_code is Null)
return
end








GO
SET QUOTED_IDENTIFIER OFF
GO
SET ANSI_NULLS ON
GO

SET QUOTED_IDENTIFIER OFF
GO
SET ANSI_NULLS OFF
GO

CREATE FUNCTION GetStreets ( @Region_Code varchar(13),
                                    @Area_Code varchar(13)=null,
                                    @Town varchar(13)=null,
                                    @Place varchar(13)=null) 
RETURNS @StreetsTable table
      (
   Country_Code varchar(3),
   N_Region varchar(2),
   [name] varchar (40),
   [socr] varchar (10),
   [code] varchar (17),
   [index] varchar (6) ,
   [gninmb] varchar (4)

      )
AS 
BEGIN

set @Region_code = (SUBSTRING(@Region_Code, 1, 11) + '00')
set @Area_Code = (SUBSTRING(@Area_Code, 1, 11) + '00')
set @Town = (SUBSTRING(@Town, 1, 11) + '00')
set @Place = (SUBSTRING(@Place, 1, 11) + '00')

  insert @StreetsTable
  select
   643,
   Region_code as N_Region,
   [name] ,
   [socr],
   [code],
   [index],
   [gninmb]
  from street

where
@Region_Code= SUBSTRING(code, 1, 2) + '00000000000'
and ((@Area_Code IS NULL) OR (@Area_Code = SUBSTRING(code, 1, 5)+ '00000000'))
and ((@Town IS NULL) OR (@Town=SUBSTRING(code, 1, 8)+ '00000'))
and ((@Place IS NULL) OR (@Place = SUBSTRING(code, 1, 11)+ '00'))

return
END









GO
SET QUOTED_IDENTIFIER OFF
GO
SET ANSI_NULLS ON
GO

SET QUOTED_IDENTIFIER OFF
GO
SET ANSI_NULLS OFF
GO


CREATE FUNCTION GetTowns (@Region_Code varchar(13),@Area_Code varchar(13))
RETURNS @RetTable table (   
             Country_Code varchar(3),
             N_Region varchar(2),   
             [name] varchar (40),
   [socr] varchar (10),
   [code] varchar (13),
   [index] varchar (6) ,
   [gninmb] varchar (4),
        [Region_Code] varchar(13),
        [Area_Code] varchar(13),
        [Town_Code] varchar(13),
        [Place_Code] varchar(13)
   )
AS 
begin

if len(@Region_code) <11 
set @Region_code = (SUBSTRING(@Region_Code, 1, 2) + '00000000000')
set @Region_code = (SUBSTRING(@Region_Code, 1, 11) + '00')
set @Area_Code = ltrim(rtrim(isnull(@Area_Code,@Region_code)))
if len(@Area_Code) <11 
set @Area_Code = (SUBSTRING(@Area_Code, 1, 2) + '00000000000')
set @Area_Code = (SUBSTRING(@Area_Code, 1, 11) + '00')
   
insert @RetTable
SELECT    643,
                Region_code as N_Region,
                name, socr, code, [index], gninmb,
      Region_code + '00000000000' AS Region_code,
      Region_code+Area_Code + '00000000' as Area_Code,
      code as Town_Code,
                code as  Place_Code
FROM         dbo.KLADR_Towns
WHERE     (@Region_code=Region_code + '00000000000')
and      ((@Area_Code IS NULL) or (@Area_Code=Region_code+Area_Code+ '00000000'))

return
end










GO
SET QUOTED_IDENTIFIER OFF
GO
SET ANSI_NULLS ON
GO

SET QUOTED_IDENTIFIER OFF
GO
SET ANSI_NULLS OFF
GO

CREATE FUNCTION Get_only_Number
   (@str_dom varchar(40))
RETURNS varchar(40)

AS
BEGIN
declare @i as integer
Set @i=1
Declare @is_bukva as  integer
Set @is_bukva =0

Declare @num_dom_zifra as  varchar(40)
Set @is_bukva =0
Set @num_dom_zifra=''

while (@i<=len(@str_dom))  and (@is_bukva=0) begin
   if  substring(@str_dom,@i,1) not in ('1','2','3','4','5','6','7','8','9','0') begin
      Set @is_bukva =1   
   end
   else  Set @num_dom_zifra=@num_dom_zifra+substring(@str_dom,@i,1)
set @i=@i+1   
end

RETURN (ltrim(rtrim(@num_dom_zifra)))
END




GO
SET QUOTED_IDENTIFIER OFF
GO
SET ANSI_NULLS ON
GO

SET QUOTED_IDENTIFIER OFF
GO
SET ANSI_NULLS OFF
GO

CREATE FUNCTION isAdress (@Adress varchar(300)) 
RETURNS @RetTable table (   
                  Count_rec int)
AS 
BEGIN
DECLARE @Region varchar(2)
DECLARE @Area   varchar(51)
DECLARE @Town   varchar(51)
DECLARE @Place  varchar(51)
DECLARE @Street varchar(51)
DECLARE @N       int
DECLARE @M       int
Set @Region = ''
Set @Area = ''
Set @Town = ''
Set @Place = ''
Set @Street = ''
Set @Adress = ','+@Adress
Set @N = 1
Set @M = 0
While Len(@Adress)>=@N
  Begin
   if (SubString(@Adress,@N,1) = ',')
    Begin
     Set @M = @M + 1
     End
   Else
    Begin
     If @M = 3 Set @Region  = @Region + cast(SubString(@Adress,@N,1) as char(1))
     If @M = 4 Set @Area      = @Area     + cast(SubString(@Adress,@N,1) as char(1))
     If @M = 5 Set @Town    = @Town    + cast(SubString(@Adress,@N,1) as char(1))
     If @M = 6 Set @Place    = @Place    + cast(SubString(@Adress,@N,1) as char(1))
     If @M = 7 Set @Street    = @Street   + cast(SubString(@Adress,@N,1) as char(1))
    End
  Set @N = @N + 1
end
Insert @RetTable
Select  Count(*) From dbo.Full_Address F Where (F.Region = @Region and F.Area = @Area and F.Town = @Town and F.Place = @Place and F.Street = @Street)
RETURN
end


GO
SET QUOTED_IDENTIFIER OFF
GO
SET ANSI_NULLS ON
GO

SET QUOTED_IDENTIFIER OFF
GO
SET ANSI_NULLS OFF
GO

CREATE   FUNCTION toDat (@dateFrom datetime)
RETURNS datetime AS 
BEGIN
  return convert(datetime,convert(varchar(12),@dateFrom, 112),112)
END


GO
SET QUOTED_IDENTIFIER OFF
GO
SET ANSI_NULLS ON
GO

CREATE TABLE [dbo].[Full_Address] (
   [Country] [varchar] (3) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [Index] [nvarchar] (6) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [Region] [nvarchar] (2) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [Area] [varchar] (51) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [Town] [varchar] (51) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [Place] [varchar] (51) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [Street] [varchar] (51) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [Full_Adress] [nvarchar] (221) COLLATE Cyrillic_General_CI_AS NOT NULL
) ON [PRIMARY]
GO

CREATE TABLE [dbo].[KLADR_Areas] (
   [name] [varchar] (40) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [socr] [varchar] (10) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [code] [varchar] (13) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [index] [varchar] (6) COLLATE Cyrillic_General_CI_AS NULL ,
   [gninmb] [varchar] (4) COLLATE Cyrillic_General_CI_AS NULL ,
   [Country_Code] [int] NULL ,
   [Region_Code] [varchar] (2) COLLATE Cyrillic_General_CI_AS NULL ,
   [Area_Code] [varchar] (3) COLLATE Cyrillic_General_CI_AS NULL
) ON [PRIMARY]
GO

CREATE TABLE [dbo].[KLADR_DOMA] (
   [name] [varchar] (100) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [korp] [varchar] (100) COLLATE Cyrillic_General_CI_AS NULL ,
   [socr] [varchar] (10) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [code] [varchar] (19) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [index] [varchar] (6) COLLATE Cyrillic_General_CI_AS NULL ,
   [gninmb] [varchar] (4) COLLATE Cyrillic_General_CI_AS NULL ,
   [uno] [varchar] (100) COLLATE Cyrillic_General_CI_AS NULL ,
   [ocatd] [varchar] (11) COLLATE Cyrillic_General_CI_AS NULL ,
   [Region_code] [varchar] (2) COLLATE Cyrillic_General_CI_AS NULL ,
   [Area_Code] [varchar] (3) COLLATE Cyrillic_General_CI_AS NULL ,
   [Town_Code] [varchar] (3) COLLATE Cyrillic_General_CI_AS NULL ,
   [Place_Code] [varchar] (3) COLLATE Cyrillic_General_CI_AS NULL ,
   [Street_Code] [varchar] (4) COLLATE Cyrillic_General_CI_AS NULL
) ON [PRIMARY]
GO

CREATE TABLE [dbo].[KLADR_Places] (
   [name] [varchar] (40) COLLATE Cyrillic_General_CI_AS NULL ,
   [socr] [varchar] (10) COLLATE Cyrillic_General_CI_AS NULL ,
   [code] [varchar] (13) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [index] [varchar] (6) COLLATE Cyrillic_General_CI_AS NULL ,
   [gninmb] [varchar] (4) COLLATE Cyrillic_General_CI_AS NULL ,
   [Region_Code] [varchar] (2) COLLATE Cyrillic_General_CI_AS NULL ,
   [Area_Code] [varchar] (3) COLLATE Cyrillic_General_CI_AS NULL ,
   [Town_Code] [varchar] (3) COLLATE Cyrillic_General_CI_AS NULL
) ON [PRIMARY]
GO

CREATE TABLE [dbo].[KLADR_Regions] (
   [name] [varchar] (40) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [socr] [varchar] (10) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [code] [varchar] (13) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [index] [varchar] (6) COLLATE Cyrillic_General_CI_AS NULL ,
   [gninmb] [varchar] (4) COLLATE Cyrillic_General_CI_AS NULL ,
   [Country_Code] [int] NULL ,
   [Region_Code] [varchar] (2) COLLATE Cyrillic_General_CI_AS NULL
) ON [PRIMARY]
GO

CREATE TABLE [dbo].[KLADR_Towns] (
   [name] [varchar] (40) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [socr] [varchar] (10) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [code] [varchar] (13) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [index] [varchar] (6) COLLATE Cyrillic_General_CI_AS NULL ,
   [gninmb] [varchar] (4) COLLATE Cyrillic_General_CI_AS NULL ,
   [Region_code] [varchar] (2) COLLATE Cyrillic_General_CI_AS NULL ,
   [Area_Code] [varchar] (3) COLLATE Cyrillic_General_CI_AS NULL ,
   [Town_Code] [varchar] (3) COLLATE Cyrillic_General_CI_AS NULL
) ON [PRIMARY]
GO

CREATE TABLE [dbo].[SAVEORG] (
   [id] [bigint] IDENTITY (1, 1) NOT NULL ,
   [Kod] [char] (3) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [NameOrg] [char] (200) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [INN] [char] (15) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [KPP] [char] (15) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [Region] [char] (2) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [Adress] [char] (200) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [Lic] [char] (50) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [LicBy] [char] (200) COLLATE Cyrillic_General_CI_AS NOT NULL
) ON [PRIMARY]
GO

CREATE TABLE [dbo].[STREET] (
   [NAME] [nvarchar] (40) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [SOCR] [nvarchar] (10) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [CODE] [nvarchar] (17) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [INDEX] [nvarchar] (6) COLLATE Cyrillic_General_CI_AS NULL ,
   [GNINMB] [nvarchar] (4) COLLATE Cyrillic_General_CI_AS NULL ,
   [UNO] [nvarchar] (4) COLLATE Cyrillic_General_CI_AS NULL ,
   [OCATD] [nvarchar] (11) COLLATE Cyrillic_General_CI_AS NULL ,
   [Region_code] [nvarchar] (2) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [Area_code] [nvarchar] (3) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [Town_code] [nvarchar] (3) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [Place_code] [nvarchar] (3) COLLATE Cyrillic_General_CI_AS NOT NULL
) ON [PRIMARY]
GO

CREATE TABLE [dbo].[kladr] (
   [name] [char] (40) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [socr] [char] (10) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [code] [char] (13) COLLATE Cyrillic_General_CI_AS NOT NULL ,
   [index] [char] (6) COLLATE Cyrillic_General_CI_AS NULL ,
   [gninmb] [char] (4) COLLATE Cyrillic_General_CI_AS NULL ,
   [uno] [char] (4) COLLATE Cyrillic_General_CI_AS NULL ,
   [ocatd] [char] (11) COLLATE Cyrillic_General_CI_AS NULL ,
   [status] [char] (1) COLLATE Cyrillic_General_CI_AS NULL
) ON [PRIMARY]
GO


Часть скрипта я вырезал, она не имеет отношения к теме. Так что полностью скрипт может не выполнятся, но в общем и целом, он содержит все что нужно.

[Ренат]

2. Обращение к базе Кладра на MS SQL Server реализовали через внешную DLL написаную на Delphi 7. Вот ее код

Код: Выделить всё


library GetDataKladr;
//Project2;
{ Important note about DLL memory management: ShareMem must be the
  first unit in your library's USES clause AND your project's (select
  Project-View Source) USES clause if your DLL exports any procedures or
  functions that pass strings as parameters or function results. This
  applies to all strings passed to and from your DLL--even those that
  are nested in records and classes. ShareMem is the interface unit to
  the BORLNDMM.DLL shared memory manager, which must be deployed along
  with your DLL. To avoid using BORLNDMM.DLL, pass string information
  using PChar or ShortString parameters. }

uses
  SysUtils,
  Classes,
  adodb,
  Dialogs,
  DB,
  dbf;

{$R *.res}
//Функция выполняет поиск количества накладных удовлетврояющих заданным параметрам
//   dataId 36009 Приходная (вн. перемещение)
//   dataId 36010 Отгрузка
//  dataId 36046 Ввод начальных остатков
//Возвращает чило накладных удовлетворяющих указанному условию.
//Либо текст ошибки в виде "Eror: "+ТекстОшибки
//Function Get_regions(WhichDate,ServEgais,DBName,Nsopr,DD,MM,YYYY,DataID:shortstring):shortstring;
Function Get_regions(ServKladr,DBName,FileName:shortstring):shortstring;
var  DataSet:TAdoDataSet;
     d:TDbf;
     i:integer;
begin

   d:=TDbf.Create(Nil);
   d.FieldDefs.Add('NAME',ftString);
   d.FieldDefs.Add('Rcode',ftString);
   d.FieldDefs.Add('Acode',ftString);
   d.FieldDefs.Add('Tcode',ftString);
   d.FieldDefs.Add('Pcode',ftString);
   d.FieldDefs.Add('Index',ftString);
   d.FieldDefs.Add('NRegion',ftString);
   d.TableName:=FileName;
   d.CreateTable;
   d.Active:=true;


  try
  DataSet := TADODataSet.Create(nil);
  DataSet.CommandTimeout := 0;
  DataSet.ConnectionString := 'Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;' +
  'User ID=Admin;Initial Catalog='+Trim(DBName)+';Data Source='+trim(ServKladr)+';' +
  'Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;' +
  'Workstation ID=RENAT;Use Encryption for Data=False;Tag with column collation when possible=False';
  DataSet.CursorLocation := clUseServer;
  DataSet.CursorType := ctOpenForwardOnly;
  DataSet.LockType := ltReadOnly;

//    DataSet.CommandText := ' Select name+'' ''+socr as Name, * from GetRegions('''') order by Name ' ;
  DataSet.CommandText := 'Select name+'' ''+socr as Name ,N_region, Region_code,Area_code,Town_code, Place_code, [Index] from GetRegions(''  '') order by Name';
//  ShowMessage(DataSet.CommandText);
  DataSet.Open;
  i:=0;
  While Not DataSet.Eof do begin
   d.Append;
   d.FieldByName('NAME').AsString:=DataSet.Fields[0].AsString;
   d.FieldByName('Rcode').AsString:=DataSet.Fields[2].AsString;
   d.FieldByName('Acode').AsString:=DataSet.Fields[3].AsString;
   d.FieldByName('Tcode').AsString:=DataSet.Fields[4].AsString;
   d.FieldByName('Pcode').AsString:=DataSet.Fields[5].AsString;
   d.FieldByName('Index').AsString:=DataSet.Fields[6].AsString;
   d.FieldByName('Nregion').AsString:=DataSet.Fields[1].AsString;
   d.Post;
   DataSet.Next;
   Inc(i);
  end; // while
  result:=IntToStr(i);
  DataSet.Close;
  d.Close;
  Except
   on E: Exception do begin
     ShowMessage('При выполнении запроса произошла ошибка: '+chr(13)+chr(10)+E.Message);
     result:='Eror: '+ E.Message
     end;
  End;
end; //function

Function Get_Areas(ServKladr,DBName,FileName,Rcode:shortstring):shortstring;
var  DataSet:TAdoDataSet;
     d:TDbf;
     i:integer;
begin

   d:=TDbf.Create(Nil);
   d.FieldDefs.Add('NAME',ftString);
   d.FieldDefs.Add('Rcode',ftString);
   d.FieldDefs.Add('Acode',ftString);
   d.FieldDefs.Add('Tcode',ftString);
   d.FieldDefs.Add('Pcode',ftString);
   d.FieldDefs.Add('Index',ftString);
   d.TableName:=FileName;
   d.CreateTable;
   d.Active:=true;


  try
  DataSet := TADODataSet.Create(nil);
  DataSet.CommandTimeout := 0;
  DataSet.ConnectionString := 'Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;' +
  'User ID=Admin;Initial Catalog='+Trim(DBName)+';Data Source='+trim(ServKladr)+';' +
  'Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;' +
  'Workstation ID=RENAT;Use Encryption for Data=False;Tag with column collation when possible=False';
  DataSet.CursorLocation := clUseServer;
  DataSet.CursorType := ctOpenForwardOnly;
  DataSet.LockType := ltReadOnly;

//    DataSet.CommandText := ' Select name+'' ''+socr as Name, * from GetRegions('''') order by Name ' ;
//  DataSet.CommandText := 'Select name+'' ''+socr as Name ,N_region, Region_code,Area_code,Town_code, Place_code, [Index] from GetRegions(''  '') order by Name';
  DataSet.CommandText := 'Select name+'' ''+socr as Name, Region_code,Area_code,Town_code, Place_code, [Index] from GetAreas('''+Rcode+''') order by Name';
//  ShowMessage(DataSet.CommandText);
  DataSet.Open;
  i:=0;
  While Not DataSet.Eof do begin
   d.Append;
   d.FieldByName('NAME').AsString:=DataSet.Fields[0].AsString;
   d.FieldByName('Rcode').AsString:=DataSet.Fields[1].AsString;
   d.FieldByName('Acode').AsString:=DataSet.Fields[2].AsString;
   d.FieldByName('Tcode').AsString:=DataSet.Fields[3].AsString;
   d.FieldByName('Pcode').AsString:=DataSet.Fields[4].AsString;
   d.FieldByName('Index').AsString:=DataSet.Fields[5].AsString;
   d.Post;
   DataSet.Next;
   Inc(i);
  end; // while
  result:=IntToStr(i);
  DataSet.Close;
  d.Close;
  Except
   on E: Exception do begin
     ShowMessage('При выполнении запроса произошла ошибка: '+chr(13)+chr(10)+E.Message);
     result:='Eror: '+ E.Message
     end;
  End;
end; //function

Function Get_Gorod(ServKladr,DBName,FileName,Rcode,ACode:shortstring):shortstring;
var  DataSet:TAdoDataSet;
     d:TDbf;
     i:integer;
begin

   d:=TDbf.Create(Nil);
   d.FieldDefs.Add('NAME',ftString);
   d.FieldDefs.Add('Rcode',ftString);
   d.FieldDefs.Add('Acode',ftString);
   d.FieldDefs.Add('Tcode',ftString);
   d.FieldDefs.Add('Pcode',ftString);
   d.FieldDefs.Add('Index',ftString);
   d.TableName:=FileName;
   d.CreateTable;
   d.Active:=true;


  try
  DataSet := TADODataSet.Create(nil);
  DataSet.CommandTimeout := 0;
  DataSet.ConnectionString := 'Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;' +
  'User ID=Admin;Initial Catalog='+Trim(DBName)+';Data Source='+trim(ServKladr)+';' +
  'Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;' +
  'Workstation ID=RENAT;Use Encryption for Data=False;Tag with column collation when possible=False';
  DataSet.CursorLocation := clUseServer;
  DataSet.CursorType := ctOpenForwardOnly;
  DataSet.LockType := ltReadOnly;

  if trim(ACode)<>''
    then
      DataSet.CommandText :='Select name+'' ''+socr as Name, Region_code,Area_code,Town_code, Place_code, [Index]  from GetTowns('''+RCode+''','''+ACode+''')  order by Name'
    else
      DataSet.CommandText :='Select name+'' ''+socr as Name, Region_code,Area_code,Town_code, Place_code, [Index]  from GetTowns('''+RCode+''',Null)  order by Name';
//  ShowMessage(DataSet.CommandText);
  DataSet.Open;
  i:=0;
  While Not DataSet.Eof do begin
   d.Append;
   d.FieldByName('NAME').AsString:=DataSet.Fields[0].AsString;
   d.FieldByName('Rcode').AsString:=DataSet.Fields[1].AsString;
   d.FieldByName('Acode').AsString:=DataSet.Fields[2].AsString;
   d.FieldByName('Tcode').AsString:=DataSet.Fields[3].AsString;
   d.FieldByName('Pcode').AsString:=DataSet.Fields[4].AsString;
   d.FieldByName('Index').AsString:=DataSet.Fields[5].AsString;
   d.Post;
   DataSet.Next;
   Inc(i);
  end; // while
  result:=IntToStr(i);
  DataSet.Close;
  d.Close;
  Except
   on E: Exception do begin
     ShowMessage('При выполнении запроса произошла ошибка: '+chr(13)+chr(10)+E.Message);
     result:='Eror: '+ E.Message
     end;
  End;
end; //function

Function Get_NasPunkt(ServKladr,DBName,FileName,Rcode,ACode,TCode:shortstring):shortstring;
var  DataSet:TAdoDataSet;
     d:TDbf;
     i:integer;
begin

   d:=TDbf.Create(Nil);
   d.FieldDefs.Add('NAME',ftString);
   d.FieldDefs.Add('Rcode',ftString);
   d.FieldDefs.Add('Acode',ftString);
   d.FieldDefs.Add('Tcode',ftString);
   d.FieldDefs.Add('Pcode',ftString);
   d.FieldDefs.Add('Index',ftString);
   d.TableName:=FileName;
   d.CreateTable;
   d.Active:=true;


  try
  DataSet := TADODataSet.Create(nil);
  DataSet.CommandTimeout := 0;
  DataSet.ConnectionString := 'Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;' +
  'User ID=Admin;Initial Catalog='+Trim(DBName)+';Data Source='+trim(ServKladr)+';' +
  'Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;' +
  'Workstation ID=RENAT;Use Encryption for Data=False;Tag with column collation when possible=False';
  DataSet.CursorLocation := clUseServer;
  DataSet.CursorType := ctOpenForwardOnly;
  DataSet.LockType := ltReadOnly;

  if trim(ACode)<>''
    then
      DataSet.CommandText :='Select name+'' ''+socr as Name, Region_code,Area_code,Town_code, Place_code, [Index]  from GetPlaces('''+RCode+''','''+ACode+''', '
    else
      DataSet.CommandText :='Select name+'' ''+socr as Name, Region_code,Area_code,Town_code, Place_code, [Index]  from GetPlaces('''+RCode+''', Null, ';

  if trim(TCode)<>''
    then
      DataSet.CommandText :=DataSet.CommandText  + ''''+TCode+''' )  order by Name'
    else
      DataSet.CommandText :=DataSet.CommandText  + 'Null)  order by Name';

//  ShowMessage(DataSet.CommandText);
  DataSet.Open;
  i:=0;
  While Not DataSet.Eof do begin
   d.Append;
   d.FieldByName('NAME').AsString:=DataSet.Fields[0].AsString;
   d.FieldByName('Rcode').AsString:=DataSet.Fields[1].AsString;
   d.FieldByName('Acode').AsString:=DataSet.Fields[2].AsString;
   d.FieldByName('Tcode').AsString:=DataSet.Fields[3].AsString;
   d.FieldByName('Pcode').AsString:=DataSet.Fields[4].AsString;
   d.FieldByName('Index').AsString:=DataSet.Fields[5].AsString;
   d.Post;
   DataSet.Next;
   Inc(i);
  end; // while
  result:=IntToStr(i);
  DataSet.Close;
  d.Close;
  Except
   on E: Exception do begin
     ShowMessage('При выполнении запроса произошла ошибка: '+chr(13)+chr(10)+E.Message);
     result:='Eror: '+ E.Message
     end;
  End;
end; //function


Function Get_Ulica(ServKladr,DBName,FileName,Rcode,ACode,TCode,Pcode:shortstring):shortstring;
var  DataSet:TAdoDataSet;
     d:TDbf;
     i:integer;
begin
ShowMessage('Создаю файл'+FileName);
   d:=TDbf.Create(Nil);

   d.FieldDefs.Add('CounCode',ftInteger);
   d.FieldDefs.Add('NRegion',ftString);
   d.FieldDefs.Add('name',ftString);
   d.FieldDefs.Add('socr',ftString);
   d.FieldDefs.Add('code',ftString);
   d.FieldDefs.Add('Index',ftString);
   d.FieldDefs.Add('gninmb',ftString);

   d.TableName:=FileName;
   d.CreateTable;
   d.Active:=true;

  ShowMessage('Файл создан'+FileName);

  try
  DataSet := TADODataSet.Create(nil);
  DataSet.CommandTimeout := 0;
  DataSet.ConnectionString := 'Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;' +
  'User ID=Admin;Initial Catalog='+Trim(DBName)+';Data Source='+trim(ServKladr)+';' +
  'Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;' +
  'Workstation ID=RENAT;Use Encryption for Data=False;Tag with column collation when possible=False';
  DataSet.CursorLocation := clUseServer;
  DataSet.CursorType := ctOpenForwardOnly;
  DataSet.LockType := ltReadOnly;

  if trim(ACode)<>''
    then
      DataSet.CommandText :='Select name+'' ''+socr as Name, Country_Code, N_Region, socr , code, [Index], gninmb   from GetStreets('''+RCode+''','''+ACode+''', '
    else
      DataSet.CommandText :='Select name+'' ''+socr as Name, Country_Code, N_Region, socr , code, [Index], gninmb  from GetStreets('''+RCode+''', Null, ';

  if trim(TCode)<>''
    then
      DataSet.CommandText :=DataSet.CommandText  + ''''+TCode+''', '
    else
      DataSet.CommandText :=DataSet.CommandText  + 'Null, ';

  if trim(PCode)<>''
    then
      DataSet.CommandText :=DataSet.CommandText  + ''''+PCode+''' )  order by Name'
    else
      DataSet.CommandText :=DataSet.CommandText  + 'Null)  order by Name';
  ShowMessage(DataSet.CommandText);
  DataSet.Open;

  i:=0;
  While Not DataSet.Eof do begin
   d.Append;
   d.FieldByName('name').AsString:=DataSet.Fields[0].AsString;
   d.FieldByName('CounCode').AsInteger:=DataSet.Fields[1].AsInteger;
   d.FieldByName('NRegion').AsString:=DataSet.Fields[2].AsString;
   d.FieldByName('socr').AsString:=DataSet.Fields[3].AsString;
   d.FieldByName('code').AsString:=DataSet.Fields[4].AsString;
   d.FieldByName('Index').AsString:=DataSet.Fields[5].AsString;
   d.FieldByName('gninmb').AsString:=DataSet.Fields[5].AsString;

   d.Post;
   DataSet.Next;
   Inc(i);
  end; // while
  result:=IntToStr(i);
  DataSet.Close;
  d.Close;
  Except
   on E: Exception do begin
     ShowMessage('При выполнении запроса произошла ошибка: '+chr(13)+chr(10)+E.Message);
     result:='Eror: '+ E.Message
     end;
  End;
end; //function

Function Get_IndexByDom(ServKladr,DBName,Rcode,ACode,TCode,Pcode,Scode,Dom:shortstring):shortstring;
var  DataSet:TAdoDataSet;
begin
  try
  DataSet := TADODataSet.Create(nil);
  DataSet.CommandTimeout := 0;
  DataSet.ConnectionString := 'Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;' +
  'User ID=Admin;Initial Catalog='+Trim(DBName)+';Data Source='+trim(ServKladr)+';' +
  'Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;' +
  'Workstation ID=RENAT;Use Encryption for Data=False;Tag with column collation when possible=False';
  DataSet.CursorLocation := clUseServer;
  DataSet.CursorType := ctOpenForwardOnly;
  DataSet.LockType := ltReadOnly;

  if trim(ACode)<>''
    then
      DataSet.CommandText :='Select [index] from GetIndexByDom('''+RCode+''','''+ACode+''', '
    else
      DataSet.CommandText :='Select [index] from GetIndexByDom('''+RCode+''', Null, ';

  if trim(TCode)<>''
    then
      DataSet.CommandText :=DataSet.CommandText  + ''''+TCode+''', '
    else
      DataSet.CommandText :=DataSet.CommandText  + 'Null, ';

  if trim(PCode)<>''
    then
      DataSet.CommandText :=DataSet.CommandText  + ''''+PCode+''', '
    else
      DataSet.CommandText :=DataSet.CommandText  + 'Null, ';

//  Будем считать что улица и дом есть всегда
  DataSet.CommandText :=DataSet.CommandText  + ''''+SCode+''', ';
  DataSet.CommandText :=DataSet.CommandText  + ''''+Dom+''' )';

  DataSet.Open;
  if Not DataSet.Eof  then result:=DataSet.Fields[0].AsString
                      else result:='';
  DataSet.Close;
  Except
   on E: Exception do begin
     ShowMessage('При выполнении запроса произошла ошибка: '+chr(13)+chr(10)+E.Message);
     result:='Eror: '+ E.Message
     end;
  End;
end; //function


exports Get_regions;
exports Get_Areas;
exports Get_Gorod;
exports Get_NasPunkt;
exports Get_Ulica;
exports Get_IndexByDom;

begin


end.


DLL скомпилировали и добавили в каталог с исполняемыми файлами Галактики.

[Ренат]

Скачали последную версию кладра и загрузили его в базу MS SQL Server используя Local Packages.
Вот файл с ней.
http://narod.ru/disk/27394627000/%D0%98%D0%BC%D0%BF%D0%BE%D1%80%D1%82%20%D0%BA%D0%BB%D0%B0%D0%B4%D1%80%D0%B0%20%D0%B8%D0%B7%20DBF%20%D0%B2%20%D0%B1%D0%B0%D0%B7%D1%83%20Kladr.dts.html
Конечно, нужно будет еще создать подключение с указанием папки, где лежат файлы DBF.

[Ренат]

Обращение к базе происходит из Галактики, путем вызова функции DLL.
Пользователь входит в каталог контрагентов. Открывает карточку. Вызвает контекстное меню. Добавление своего пункта меню подробно описано тут http://www.tyumbit.ru/gal_forum/viewtopic.php?f=2&t=10791.
Запускается интерфейс формирования адреса.

[Ренат]

Файлы проекта

Файл fcom.prj

Код: Выделить всё

table Struct local tbl_Data_Kladr
(
   Nrec   :comp,
   NAME   :string,
   Rcode  :string,
   Acode  :string,
   Tcode  :string,
   Pcode  :string,
   PIndex :string,
   NRegion:string,
   Socr   :string,
   Ucode  :string
)
with index
(
  cnRec=nRec(unique, Surrogate),
  cAll=Name
);

#make "Alter_katorg_getAddr.vip"
#make "getaddr_kladr.vip"


Файл Alter_katorg_getAddr.vip

Код: Выделить всё

!http://www.tyumbit.ru/gal_forum/viewtopic.php?f=2&t=10791
#define ComponentVersion
#Component "L_KATORG"

const
  MENU_PREFFIX : string[5] = 'MENU ';
end;

alter interface KATORG;

create view
var menuID:longint;
as select * from X$Resources(ReadOnly) ;

Window WKATORG
HandleEvent
cmValue41:
{
  RunInterface('L_KATORG::getaddr_kladr',Katorg.Nrec, Katorg.Name);
!RunInterface('test2',Katorg.Nrec, Katorg.Name);
};
end
end;

HandleEvent
cmInit :
{
  if (Inherited::HandleEvent(cmInit) != heOk)
  {
    Abort;
    Exit;
  }
  var m_MenuName : string;
  var m_Menu : longint;
  m_MenuName := MENU_PREFFIX +'L_KATORG::mnuKatOrgEdit'
!  m_MenuName := 'L_KATORG::mnuKatOrgEdit'

  if (RecordExists X$Resources where (( 3 == X$Resources.XR$Type and m_MenuName == X$Resources.XR$Name))
       != tsOk)
  {
   DeleteMenuHowDynamics (m_MenuName);
   m_Menu := LoadMenuEx (m_MenuName, true, false);
   AddMenuItem(m_Menu, 'Сформировать адрес из внешнего Кладра',cmValue41);
   StoreMenuHowDynamics (m_Menu, m_MenuName);
   DisposeLoadMenu (m_Menu);
   ReinitHeaderMenu;
  }
};//cmInit

end;
end.


Файл getaddr_kladr.vip

Код: Выделить всё

!http://www.tyumbit.ru/gal_forum/viewtopic.php?f=2&t=10791
#define ComponentVersion

Function Get_regions   (string,string,string):string;  external 'GetDataKladr.dll#Get_regions';
Function Get_Areas     (string,string,string,string):string;  external 'GetDataKladr.dll#Get_Areas';
Function Get_Gorod     (string,string,string,string,string):string;  external 'GetDataKladr.dll#Get_Gorod';
Function Get_NasPunkt  (string,string,string,string,string,string):string;  external 'GetDataKladr.dll#Get_NasPunkt';
Function Get_Ulica     (string,string,string,string,string,string,string):string;  external 'GetDataKladr.dll#Get_Ulica';
Function Get_IndexByDom(string,string,       string,string,string,string,string,string):string;  external 'GetDataKladr.dll#Get_IndexByDom';

#Component "L_KATORG"
Interface getaddr_kladr 'Формирование адреса из "внешнего" Кладра' , cyan;
show at (1,4,60,25);
create view
var         Nrec_katorg  :comp
       Name_org     :string
       s_Region     :String
       s_Rajon      :String
       S_Gorod      :String
       s_NasPunkt   :String
       s_Ulica      :String
       FieldIndex   :Longint   
       FieldIndexDom:Longint   
       FieldDom     :string[10]
       FieldKorpus  :string
       FieldKvartira:string
            Address_value:string
!Текущие коды
         Region_code:string
         Area_code  :string
         Town_code  :string
         Place_code :string
         Ulica_code :string
         Index_code :string
!Текущие коды Выбранного региона              
         R_Region_code:string
         R_Area_code  :string
         R_Town_code  :string
         R_Place_code :string
         R_Ulica_code :string
         R_Index_code :string
!Текущие коды Выбранного района             
         A_Region_code:string
         A_Area_code  :string
         A_Town_code  :string
         A_Place_code :string
         A_Ulica_code :string
         A_Index_code :string
!Текущие коды Выбранного Города
         G_Region_code:string
         G_Area_code  :string
         G_Town_code  :string
         G_Place_code :string
         G_Ulica_code :string
         G_Index_code :string
!Текущие коды Выбранного нас пункта
         P_Region_code:string
         P_Area_code  :string
         P_Town_code  :string
         P_Place_code :string
         P_Ulica_code :string
         P_Index_code :string
!Текущие коды Выбранной улицы
         U_Region_code:string
         U_Area_code  :string
         U_Town_code  :string
         U_Place_code :string
         U_Ulica_code :string
         U_Index_code :string

as select * from katorg
where (( Nrec_katorg==katorg.Nrec));

parameters Nrec_katorg, Name_org;

var MSSQL_ServerName:String;
var MSSQL_DBName:String;

screen for_button;
fields
  Name_org      :protect,skip, {font = {bold = true}};
  s_Region      :quickChoice                         ;
  s_Rajon       :quickChoice                         ;
  s_Gorod       :quickChoice                         ;
  s_NasPunkt    :quickChoice                         ;
  s_Ulica       :quickChoice                         ;
  FieldIndex    :noprotect                           ;
  FieldDom      :noprotect                           ;
  FieldKorpus   :noprotect                           ;
  FieldKvartira :noprotect                           ;
  Address_value :noprotect              ;
buttons
  cmButton1;
<<
Выбрана организация .@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

`Регион`     .@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

`Район`      .@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

`Город`      .@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

`Нас. пункт` .@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

`Улица`      .@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

`Индекс`      `Дом`           `Корпус`       `Квартира`
  .@@@@@@@      .@@@@@@@@       .@@@@@@@       .@@@@@@@

            `Сформированный адрес`
  .@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
                   <.Сохранить адрес.>

>>
end; //screen
procedure    clear_region();
begin
  s_Region  :='';
  R_Region_code:='';
  R_Area_code  :='';
  R_Town_code  :='';
  R_Place_code :='';
  R_Ulica_code :='';
  R_Index_code :='';
end;

procedure clear_rajon();
begin
  s_Rajon  :='';
  A_Region_code:='';
  A_Area_code  :='';
  A_Town_code  :='';
  A_Place_code :='';
  A_Ulica_code :='';
  A_Index_code :='';
end;

procedure clear_gorod();
begin
  s_Gorod:='';
  G_Region_code:='';
  G_Area_code  :='';
  G_Town_code  :='';
  G_Place_code :='';
  G_Ulica_code :='';
  G_Index_code :='';
end;

procedure clear_nasPunkt();
begin
  s_NasPunkt:='';
  P_Region_code:='';
  P_Area_code  :='';
  P_Town_code  :='';
  P_Place_code :='';
  P_Ulica_code :='';
  P_Index_code :='';
end;

procedure clear_Ulica();
begin
  s_Ulica:='';
  U_Region_code:='';
  U_Area_code  :='';
  U_Town_code  :='';
  U_Place_code :='';
  U_Ulica_code :='';
  U_Index_code :='';
end;

procedure clear_Index();
begin
  FieldIndex   =0;
  FieldIndexDom=0;
end;

Procedure GetCode;
begin
  Region_code := '';
  Area_code   := '';
  Town_code   := '';
  Place_code  := '';
  Index_code  := '';

if trim(s_region)<>'' then  begin
    Region_code := R_Region_code;
    Area_code   := R_Area_code;
    Town_code   := R_Town_code;
    Place_code  := R_Place_code;
    Index_code  := R_Index_code;
!   Message('s_region'+Region_code);
end;


if trim(s_Rajon)<>'' Then
begin
   Region_code := A_Region_code;
   Area_code   := A_Area_code;
   Town_code   := A_Town_code;
   Place_code  := A_Place_code;
   Index_code  := A_Index_code;
!   Message('s_Rajon'+Region_code);
end;

if trim(s_Gorod)<>'' Then
begin
   Region_code := G_Region_code;
   Area_code   := G_Area_code;
   Town_code   := G_Town_code;
   Place_code  := G_Place_code;
   Index_code  := G_Index_code;
!   Message('s_Gorod'+Region_code);
end;


if trim(s_NasPunkt)<>'' Then
begin
   Region_code := P_Region_code;
   Area_code   := P_Area_code;
   Town_code   := P_Town_code;
   Place_code  := P_Place_code;
   Index_code  := P_Index_code;
!   Message('s_NasPunkt'+Region_code);
end;

if trim(s_Ulica)>'' Then
begin
   Index_code  :=  U_Index_code;
//   Message('s_Ulica'+r_Region_code);
   Ulica_code  :=  U_Ulica_code;
end;

  Set FieldIndex:=Index_code;

end;
//*********************************************************************************************************
//                             Формируем адрес
Procedure Get_Adress();
begin
// Message('Начинаем формировать адрес');
Var Result:string;

Result := '643,' + Trim(FieldIndex) +','+SubStr(R_Region_code,1,2)+',';
Result := Result + Trim(s_Rajon)    + ','                ;      
Result := Result + Trim(s_gorod)    + ','                             ;
Result := Result + Trim(s_nasPunkt) + ','                 ;
Result := Result + Trim(s_ulica)    + ','                             ;
Result := Result + Trim(FieldDom)+ ','                 ;
Result := Result + Trim(FieldKorpus)+ ','                             ;                             
Result := Result + Trim(FieldKvartira)                                ;

Set Address_value:= UpCase(Result);

end;

Function getIndNomerDoma(dom:string):String;
begin

  var len_doma:integer;
  len_doma:=Length(dom);

  var isInt_nomerDoma:integer;
  isInt_nomerDoma:=1;

  var Primern_Int_nomerDoma:String;
  Primern_Int_nomerDoma:='';

  var i:integer;   
  for (i:=1; i<=length(dom); i:=i+1) {
//   message(substr(dom,i,1)+' integer(substr(dom,i,1))='+string(integer(substr(dom,i,1))));
     If (len_doma>=i) begin
       if Pos(substr(dom,i,1),'1234567890')=0
     then isInt_nomerDoma:=0
        else begin
      if isInt_nomerDoma=1 then
         Primern_Int_nomerDoma:=Primern_Int_nomerDoma+substr(dom,i,1);
    end;//else
     end;//if   
//     Message(string(Primern_Int_nomerDoma));   
  };//for
  getIndNomerDoma:=Primern_Int_nomerDoma;
end;//Function



HandleEvent
cmInit:{
   
   MSSQL_ServerName:='Olapserver';
!   MSSQL_ServerName:='Localhost';
   MSSQL_DBName    :='Kladr';

   clear_region();
   clear_rajon();
   clear_gorod();
   clear_naspunkt();
   clear_ulica();
   clear_Index();
  };


  cmCheckField :{
! Очищаем и заполняем
  if curField=#FieldDom then begin    //Пытаемся найти индекс
//   message('FieldDom='+FieldDom+' getIndNomerDoma(FieldDom)='+string(getIndNomerDoma(FieldDom)));
   if trim(s_Ulica)<>'' and trim(FieldDom)<>'' then begin
    var new_index:string;   
         new_index:=Get_IndexByDom(MSSQL_ServerName,MSSQL_DBName,Region_code,Area_code,Town_code,Place_code,Ulica_code,FieldDom);
// Вариант 1  - нет индексов домой для указанной улицы
    if new_index='NoDom' then begin
         Message('В кладре нет индексов домов выбранной улицы!'+char(13)+char(10)+
                 'Будет использован индекс для выбранного адреса без учета дома');
         Set FieldIndex=0;
         GetCode();
                 end; //if
// Вариант 2  - нет индекса для данного дома.Попытаемся найти для этого же номера дома но преобразованногого в целое число
       if new_index='' then begin
          if Message('Для дома номер "'+FieldDom +'" не найден индекс'+char(13)+char(10)+
         'Попытаться найти наиболее подходящий индекс ?', YesNo)=cmYes
       then begin
                      new_index:=Get_IndexByDom(MSSQL_ServerName,MSSQL_DBName,Region_code,Area_code,Town_code,Place_code,Ulica_code,getIndNomerDoma(FieldDom));
               if new_index='' then begin //НЕ найден индекс. Попытаемся найти для этого же номера дома но преобразованногого в целое число
              Message('Для дома номер "'+FieldDom +'" не найден индекс.' +char(13)+char(10)+
                        'Будет использован индекс для выбранного адреса без учета дома');               
            Set FieldIndex=0;
          end

      end;       
       end;

       if new_index<>'' and new_index<>'NoDom'  then Set FieldIndex=new_index;

      end;
     end;
  Get_Adress();
};
  cmButton1:{
   if Message('Сохранить адрес для "'+Name_org+'" ?', yesNo)=cmYes then begin
      update katorg where ((Nrec_katorg==katorg.Nrec))
                    set katorg.CONTAKTS:=Address_value;
      Message('Обновленна '+string(RowCount)+' запись');
      PutCommand(cmClose);
   end;
  };
  cmClose:{
!     DeleteFile(FileName_region   );
!     DeleteFile(FileName_Rajon    );
!     DeleteFile(FileName_Gorod    );
!     DeleteFile(FileName_NasPunkt );
!     DeleteFile(FileName_Ulica    );
   };
  cmOpenSearch :
    {
      case curField     of
      #s_Region: {
   quickChoiceName:='s_Region';
        RunInterface (getaddr_kladr_Region,MSSQL_ServerName,MSSQL_DBName,
                      s_Region     ,
                 R_Region_code,
              R_Area_code  ,
            R_Town_code  ,
                   R_Place_code ,
                   R_Ulica_code ,
                   R_Index_code);
//   Message('R_Index_code='+ R_Index_code);
   clear_rajon();
   clear_Gorod();
   clear_nasPunkt();
   clear_Ulica();
//   Message('Region_code='+ Region_code);
   Abort; } // if
   
      #s_Rajon: {
!   Message('Перед  GetCode(); Region_code='+ Region_code);
   GetCode();
!   Message('После GetCode(); Region_code='+ Region_code);
   quickChoiceName:='s_Rajon';
        RunInterface (getaddr_kladr_Rajon ,MSSQL_ServerName,MSSQL_DBName,
                      s_Rajon      ,
                 Region_code  ,
                 A_Region_code,
              A_Area_code  ,
            A_Town_code  ,
                   A_Place_code ,
                   A_Ulica_code ,
                   A_Index_code);
!        message('После поиска'+R_Region_code);
!   Message('A_Index_code='+ A_Index_code);
   clear_Gorod();
   clear_nasPunkt();
   clear_Ulica();
   GetCode();
   Abort; } // if
      #s_Gorod: {
!   Message('Перед  GetCode(); Region_code='+ Region_code);
   GetCode();
!   Message('После GetCode(); Region_code='+ Region_code);
   quickChoiceName:='s_Gorod';
        RunInterface (getaddr_kladr_Gorod ,MSSQL_ServerName,MSSQL_DBName,
                      s_Gorod      ,
                 Region_code  ,
                 Area_code    ,
                 G_Region_code,
              G_Area_code  ,
            G_Town_code  ,
                   G_Place_code ,
                   G_Ulica_code ,
                   G_Index_code);
!        message('После поиска'+R_Region_code);
//   Message('G_Index_code='+ G_Index_code);
   clear_nasPunkt();
   clear_Ulica();
   Abort; } // if
      #s_nasPunkt: {
!   Message('Перед  GetCode(); Region_code='+ Region_code);
   GetCode();
!   Message('После GetCode(); Region_code='+ Region_code);
   quickChoiceName:='s_nasPunkt';
        RunInterface (getaddr_kladr_NasPunkt,MSSQL_ServerName,MSSQL_DBName,
                      s_nasPunkt   ,
                 Region_code  ,
                 Area_code    ,
            Town_code    ,
                 P_Region_code,
              P_Area_code  ,
            P_Town_code  ,
                   P_Place_code ,
                   P_Ulica_code ,
                   P_Index_code);
!        message('После поиска'+R_Region_code);
//   Message('A_Index_code='+ A_Index_code);
   clear_Ulica();
   Abort; } // if
      #s_Ulica: {
!   Message('Перед  GetCode(); Region_code='+ Region_code);
   GetCode();
!   Message('После GetCode(); Region_code='+ Region_code);
   quickChoiceName:='s_Ulica';
        RunInterface (getaddr_kladr_Ulica,MSSQL_ServerName,MSSQL_DBName,
                      s_Ulica      ,
                 Region_code  ,
                 Area_code    ,
            Town_code    ,
            Place_code   ,
                 U_Region_code,
              U_Area_code  ,
            U_Town_code  ,
                   U_Place_code ,
                   U_Ulica_code ,
                   U_Index_code);
//        message('U_Ulica_code ='+U_Ulica_code);
   Abort; } // if

   end; // case
   GetCode();
   Get_Adress();
    }//end cmOpenSears
   cmDelete:{
   if curField=#s_region then {
                      Set s_Region     ='';
                 Set R_Region_code='';
              Set R_Area_code  ='';
            Set R_Town_code  ='';
                   Set R_Place_code ='';
                   Set R_Ulica_code ='';
                   Set R_Index_code ='';
   }; //if s_region
}

end; //handleEvent

end.

Interface getaddr_kladr_Region 'Выбор региона', cyan;
//******************************* Описываем объект быстрого выбора для Регионов ***********************
create view
var 
   MSSQL_ServerName,MSSQL_DBName,
      s_Region     ,
           R_Region_code,
      R_Area_code  ,
        R_Town_code  ,
      R_Place_code ,
        R_Ulica_code ,
      R_Index_code :string
           FileName_region:String;
as select * from  tbl_Data_Kladr;
parameters MSSQL_ServerName,MSSQL_DBName,
      s_Region     ,
           R_Region_code,
        R_Area_code  ,
        R_Town_code  ,
        R_Place_code ,
        R_Ulica_code ,
        R_Index_code ;

quickChoice s_Region
{
   acceptField = tbl_Data_Kladr.Name;
        viewField   = tbl_Data_Kladr.Name;
        viewField   = tbl_Data_Kladr.Nregion;
   searchField = tbl_Data_Kladr.Name;
   onOpen:{
      delete ALL tbl_Data_Kladr;   
      Var s:string;
      FileName_region:=CreateTmpFileName(); 
      //Message(FileName_region);
      s:=Get_regions(MSSQL_ServerName,MSSQL_DBName,FileName_region);
      var dbf_region:LongInt;
   
             dbf_region:=DBFOpen (FileName_region, stOpen);

      if  dbf_region =0 then begin
      message('Ошибка открытия файла с регионами "'+FileName_region+'"');
      exit;
      end;
      if DBFGetFirst (dbf_region)<> 0 then begin
      message('В файле с регионами "'+FileName_region+'" не найдено ни одной записи');
      exit;
      end
      else begin
         var i:LongInt;   
             i:=1;   
         do {
      insert into tbl_Data_Kladr
         set NAME   :=DBFGetFieldValue(dbf_region,'Name'   ),
             Rcode  :=DBFGetFieldValue(dbf_region,'RCODE'  ), 
                       Acode  :=DBFGetFieldValue(dbf_region,'ACODE'  ),
                       Tcode  :=DBFGetFieldValue(dbf_region,'TCODE'  ),
                       Pcode  :=DBFGetFieldValue(dbf_region,'PCODE'  ),
                       PIndex :=DBFGetFieldValue(dbf_region,'Index'  ),
                       NRegion:=DBFGetFieldValue(dbf_region,'Nregion');
             Socr   :=DBFGetFieldValue(dbf_region,'Socr');
           i:=i+1;   
         }
         while DBFGetNext (dbf_region)=0;   
      end;
     DBFClose(dbf_region);
   };//onOPen
   onClose:{
      DeleteFile(FileName_region);
        s_Region         := tbl_Data_Kladr.Name +'  ('+tbl_Data_Kladr.NRegion +')';
      Set R_Region_code:= tbl_Data_Kladr.RCode ;
        Set R_Area_code  := tbl_Data_Kladr.ACode ;
        Set R_Town_code  := tbl_Data_Kladr.TCode ;
        Set R_Place_code := tbl_Data_Kladr.PCode ;
        Set R_Index_code := tbl_Data_Kladr.PIndex;
   } ;
};

end.

Interface getaddr_kladr_Rajon 'Выбор района', cyan;
//******************************* Описываем объект быстрого выбора для Районов ***********************
create view
var 
   MSSQL_ServerName,MSSQL_DBName,
      s_Rajon      ,
      Region_code  ,
           A_Region_code,
      A_Area_code  ,
        A_Town_code  ,
      A_Place_code ,
        A_Ulica_code ,
      A_Index_code :string
           FileName_rajon:String;
as select * from  tbl_Data_Kladr;
parameters MSSQL_ServerName,MSSQL_DBName,
      s_Rajon      ,
      Region_code  ,
           A_Region_code,
        A_Area_code  ,
        A_Town_code  ,
        A_Place_code ,
        A_Ulica_code ,
        A_Index_code ;


quickChoice s_Rajon
{
   acceptField = tbl_data_Kladr.Name;
        viewField   = tbl_data_Kladr.Name;
   searchField = tbl_data_Kladr.Name;
   onOpen:{
      delete ALL tbl_Data_Kladr;   
//      message('в быстром выборе Region_code='+Region_code);
      Var s:string;
      FileName_rajon:=CreateTmpFileName(); 

      s:= Get_Areas(MSSQL_ServerName,MSSQL_DBName ,FileName_Rajon,Region_code);
      var dbf_curent:LongInt;
   
          dbf_curent:=DBFOpen (FileName_rajon, stOpen);
      if  dbf_curent =0 then begin
      message('Ошибка открытия файла с районами "'+FileName_rajon+'"');
      exit;
      end;
      if DBFGetFirst (dbf_curent)<> 0 then begin
      message('В файле с районами "'+FileName_rajon+'" не найдено ни одной записи');
      exit;
      end
      else begin
      insert into tbl_Data_Kladr
         set NAME   :='',
             Rcode  :='',
                       Acode  :='',
                       Tcode  :='',
                       Pcode  :='',
                       PIndex :='';
         do {
      insert into tbl_Data_Kladr
         set NAME   :=DBFGetFieldValue(dbf_curent,'Name'   ),
             Rcode  :=DBFGetFieldValue(dbf_curent,'RCODE'  ), 
                       Acode  :=DBFGetFieldValue(dbf_curent,'ACODE'  ),
                       Tcode  :=DBFGetFieldValue(dbf_curent,'TCODE'  ),
                       Pcode  :=DBFGetFieldValue(dbf_curent,'PCODE'  ),
                       PIndex :=DBFGetFieldValue(dbf_curent,'Index'  );
         }
         while DBFGetNext (dbf_curent)=0;   
      end;
     DBFClose(dbf_curent);
   };//onOPen
   onClose:{
      DeleteFile(FileName_rajon);
        s_Rajon          := tbl_Data_Kladr.Name +' '+tbl_Data_Kladr.socr;
      Set A_Region_code:= tbl_Data_Kladr.RCode ;
        Set A_Area_code  := tbl_Data_Kladr.ACode ;
        Set A_Town_code  := tbl_Data_Kladr.TCode ;
        Set A_Place_code := tbl_Data_Kladr.PCode ;
        Set A_Index_code := tbl_Data_Kladr.PIndex;
   } ;
};

end.

Interface getaddr_kladr_Gorod 'Выбор города', cyan;
//******************************* Описываем объект быстрого выбора для Районов ***********************
create view
var 
   MSSQL_ServerName,MSSQL_DBName,
      s_Gorod      ,
      Region_code  ,
      Area_code    ,
           G_Region_code,
      G_Area_code  ,
        G_Town_code  ,
      G_Place_code ,
        G_Ulica_code ,
      G_Index_code :string
           FileName_gorod:String;
as select * from  tbl_Data_Kladr;
parameters MSSQL_ServerName,MSSQL_DBName,
      s_Gorod      ,
      Region_code  ,
      Area_code    ,
           G_Region_code,
        G_Area_code  ,
        G_Town_code  ,
        G_Place_code ,
        G_Ulica_code ,
        G_Index_code ;


quickChoice s_Gorod
{
   acceptField = tbl_data_Kladr.Name;
        viewField   = tbl_data_Kladr.Name;
   searchField = tbl_data_Kladr.Name;
   onOpen:{
      delete ALL tbl_Data_Kladr;   
//      message('в быстром выборе Region_code='+Region_code);
      Var s:string;
      FileName_gorod:=CreateTmpFileName(); 

      s:= Get_Gorod(MSSQL_ServerName,MSSQL_DBName ,FileName_Gorod,Region_code,Area_code); 
      var dbf_curent:LongInt;
   
          dbf_curent:=DBFOpen (FileName_gorod, stOpen);
      if  dbf_curent =0 then begin
      message('Ошибка открытия файла с городами "'+FileName_gorod+'"');
      exit;
      end;
      if DBFGetFirst (dbf_curent)<> 0 then begin
//      message('В файле с городами "'+FileName_ajon+'" не найдено ни одной записи');
      exit;
      end
      else begin
      insert into tbl_Data_Kladr
         set NAME   :='',
             Rcode  :='',
                       Acode  :='',
                       Tcode  :='',
                       Pcode  :='',
                       PIndex :='';
         do {
      insert into tbl_Data_Kladr
         set NAME   :=DBFGetFieldValue(dbf_curent,'Name'   ),
             Rcode  :=DBFGetFieldValue(dbf_curent,'RCODE'  ), 
                       Acode  :=DBFGetFieldValue(dbf_curent,'ACODE'  ),
                       Tcode  :=DBFGetFieldValue(dbf_curent,'TCODE'  ),
                       Pcode  :=DBFGetFieldValue(dbf_curent,'PCODE'  ),
                       PIndex :=DBFGetFieldValue(dbf_curent,'Index'  );
         }
         while DBFGetNext (dbf_curent)=0;   
      end;
     DBFClose(dbf_curent);
   };//onOPen
   onClose:{
      DeleteFile(FileName_gorod);
        s_Gorod          := tbl_Data_Kladr.Name +' '+tbl_Data_Kladr.socr;
      Set G_Region_code:= tbl_Data_Kladr.RCode ;
        Set G_Area_code  := tbl_Data_Kladr.ACode ;
        Set G_Town_code  := tbl_Data_Kladr.TCode ;
        Set G_Place_code := tbl_Data_Kladr.PCode ;
        Set G_Index_code := tbl_Data_Kladr.PIndex;
   } ;
};

end.

Interface getaddr_kladr_nasPunkt 'Выбор населенного пункта', cyan;
//******************************* Описываем объект быстрого выбора для нас пункта ***********************
create view
var 
   MSSQL_ServerName,MSSQL_DBName,
      s_NasPunkt   ,
      Region_code  ,
      Area_code    ,
      Town_code    ,
           P_Region_code,
      P_Area_code  ,
        P_Town_code  ,
      P_Place_code ,
        P_Ulica_code ,
      P_Index_code :string
           FileName_nasPunkt:String;
as select * from  tbl_Data_Kladr;
parameters MSSQL_ServerName,MSSQL_DBName,
      s_NasPunkt   ,
      Region_code  ,
      Area_code    ,
      Town_code    ,
           P_Region_code,
        P_Area_code  ,
        P_Town_code  ,
        P_Place_code ,
        P_Ulica_code ,
        P_Index_code ;

quickChoice s_nasPunkt
{
   acceptField = tbl_data_Kladr.Name;
        viewField   = tbl_data_Kladr.Name;
   searchField = tbl_data_Kladr.Name;
   onOpen:{
      delete ALL tbl_Data_Kladr;   
//      message('в быстром выборе Region_code='+Region_code);
      Var s:string;
      FileName_nasPunkt:=CreateTmpFileName(); 

           s:=Get_NasPunkt(MSSQL_ServerName,MSSQL_DBName ,FileName_NasPunkt,Region_code,Area_code,Town_code);

      var dbf_curent:LongInt;
   
          dbf_curent:=DBFOpen (FileName_nasPunkt, stOpen);
      if  dbf_curent =0 then begin
      message('Ошибка открытия файла с городами "'+FileName_nasPunkt+'"');
      exit;
      end;
      if DBFGetFirst (dbf_curent)<> 0 then begin
//      message('В файле с городами "'+FileName_ajon+'" не найдено ни одной записи');
      exit;
      end
      else begin
      insert into tbl_Data_Kladr
         set NAME   :='',
             Rcode  :='',
                       Acode  :='',
                       Tcode  :='',
                       Pcode  :='',
                       PIndex :='';
         do {
      insert into tbl_Data_Kladr
         set NAME   :=DBFGetFieldValue(dbf_curent,'Name'   ),
             Rcode  :=DBFGetFieldValue(dbf_curent,'RCODE'  ), 
                       Acode  :=DBFGetFieldValue(dbf_curent,'ACODE'  ),
                       Tcode  :=DBFGetFieldValue(dbf_curent,'TCODE'  ),
                       Pcode  :=DBFGetFieldValue(dbf_curent,'PCODE'  ),
                       PIndex :=DBFGetFieldValue(dbf_curent,'Index'  );
         }
         while DBFGetNext (dbf_curent)=0;   
      end;
     DBFClose(dbf_curent);
   };//onOPen
   onClose:{
      DeleteFile(FileName_nasPunkt);   
        s_NasPunkt       := tbl_Data_Kladr.Name +' '+tbl_Data_Kladr.socr;
      Set P_Region_code:= tbl_Data_Kladr.RCode ;
        Set P_Area_code  := tbl_Data_Kladr.ACode ;
        Set P_Town_code  := tbl_Data_Kladr.TCode ;
        Set P_Place_code := tbl_Data_Kladr.PCode ;
        Set P_Index_code := tbl_Data_Kladr.PIndex;
   } ;
};

end.

Interface getaddr_kladr_Ulica 'Выбор улицы', cyan;
//******************************* Описываем объект быстрого выбора для нас пункта ***********************
create view
var 
   MSSQL_ServerName,MSSQL_DBName,
      s_Ulica      ,
      Region_code  ,
      Area_code    ,
      Town_code    ,
      Place_code   ,
           U_Region_code,
      U_Area_code  ,
        U_Town_code  ,
      U_Place_code ,
        U_Ulica_code ,
      U_Index_code :string
           FileName_ulica:String;
as select * from  tbl_Data_Kladr;
parameters MSSQL_ServerName,MSSQL_DBName,
      s_Ulica      ,
      Region_code  ,
      Area_code    ,
      Town_code    ,
      Place_code   ,
           U_Region_code,
        U_Area_code  ,
        U_Town_code  ,
        U_Place_code ,
        U_Ulica_code ,
        U_Index_code ;

quickChoice s_Ulica
{
   acceptField = tbl_data_Kladr.Name;
        viewField   = tbl_data_Kladr.Name;
   searchField = tbl_data_Kladr.Name;
   onOpen:{
      delete ALL tbl_Data_Kladr;   
//      message('в быстром выборе Region_code='+Region_code);
      Var s:string;
//      FileName_ulica:='c:\temp\ulic.dbf';//CreateTmpFileName(); 
      FileName_ulica:=CreateTmpFileName(); 

      s:=Get_Ulica(MSSQL_ServerName,MSSQL_DBName ,FileName_Ulica,Region_code,Area_code,Town_code,Place_code);
      var dbf_curent:LongInt;
   
          dbf_curent:=DBFOpen (FileName_ulica, stOpen);
      if  dbf_curent =0 then begin
      message('Ошибка открытия файла с улицами "'+FileName_ulica+'"');
      exit;
      end;
      if DBFGetFirst (dbf_curent)<> 0 then begin
//      message('В файле с городами "'+FileName_ajon+'" не найдено ни одной записи');
      exit;
      end
      else begin
      insert into tbl_Data_Kladr
         set NAME   :='',
                       PIndex :='';
         do {
      insert into tbl_Data_Kladr
         set NAME   :=DBFGetFieldValue(dbf_curent,'Name'   ),
                       PIndex :=DBFGetFieldValue(dbf_curent,'Index'  ),
             UCode  :=DBFGetFieldValue(dbf_curent,'CODE'  );
//Еще надо бы код улицы но пока я не сделал поиск индекса по номеру дома
         }
         while DBFGetNext (dbf_curent)=0;   
      end;
     DBFClose(dbf_curent);
   };//onOPen
   onClose:{
      DeleteFile(FileName_ulica);   
        s_Ulica          := tbl_Data_Kladr.Name +' '+tbl_Data_Kladr.socr;
        Set U_Index_code := tbl_Data_Kladr.PIndex;
           Set U_Ulica_code := tbl_Data_Kladr.UCode;
   } ;
};

end.


[Ренат]

Теперь посмотрим как все это выглядит в работе
База Кладра на MS SQL Server
http://narod.ru/disk/27398440000/MS-SQL-Server.wmv.html
Формирование адреса в Галактике
http://narod.ru/disk/27398494000/%D0%93 ... 0.wmv.html

[ilshat]

А че не 20 сообщений? ))
В Галке помнится есть встроенный механизм загрузки КЛАДРа. Велосипедоизобретатели?

[Ренат]

А че не 20 сообщений? ))
В Галке помнится есть встроенный механизм загрузки КЛАДРа. Велосипедоизобретатели?

Постарался называется. Видать зря. В следующий раз обязательно с Вами проконсультируюсь.