Доброго всем времени суток.
При формирование отчетности столкнулись с необходимостью ввода адресов контрагентов в соответсвии с КЛАДР.
Вот пример "верного" адреса "643,445354,63,,ЖИГУЛЕВСК Г,,ПРОМЫШЛЕННАЯ УЛ,10,,"
Решение поставленной задачи реализовали в следующем порядке
Формирование адреса из внешнего Кладра (MS SQL Server)
Модераторы: m0p3e, edward_K, Модераторы
-
Ренат
- Постоянный обитатель
- Сообщения: 194
- Зарегистрирован: 12 сен 2007, 16:34
- Откуда: Глазов
- Контактная информация:
Re: Формирование адреса из внешнего Кладра (MS SQL Server)
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
-
Ренат
- Постоянный обитатель
- Сообщения: 194
- Зарегистрирован: 12 сен 2007, 16:34
- Откуда: Глазов
- Контактная информация:
Re: Формирование адреса из внешнего Кладра (MS SQL Server)
2. Обращение к базе Кладра на MS SQL Server реализовали через внешную DLL написаную на Delphi 7. Вот ее код
DLL скомпилировали и добавили в каталог с исполняемыми файлами Галактики.
Код: Выделить всё
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.
-
Ренат
- Постоянный обитатель
- Сообщения: 194
- Зарегистрирован: 12 сен 2007, 16:34
- Откуда: Глазов
- Контактная информация:
Re: Формирование адреса из внешнего Кладра (MS SQL Server)
Скачали последную версию кладра и загрузили его в базу MS SQL Server используя Local Packages.
Вот файл с ней.
http://narod.ru/disk/27394627000/%D0%98 ... r.dts.html
Конечно, нужно будет еще создать подключение с указанием папки, где лежат файлы DBF.
Вот файл с ней.
http://narod.ru/disk/27394627000/%D0%98 ... r.dts.html
Конечно, нужно будет еще создать подключение с указанием папки, где лежат файлы DBF.
-
Ренат
- Постоянный обитатель
- Сообщения: 194
- Зарегистрирован: 12 сен 2007, 16:34
- Откуда: Глазов
- Контактная информация:
Re: Формирование адреса из внешнего Кладра (MS SQL Server)
Обращение к базе происходит из Галактики, путем вызова функции DLL.
Пользователь входит в каталог контрагентов. Открывает карточку. Вызвает контекстное меню. Добавление своего пункта меню подробно описано тут http://www.tyumbit.ru/gal_forum/viewtop ... =2&t=10791.
Запускается интерфейс формирования адреса.
Пользователь входит в каталог контрагентов. Открывает карточку. Вызвает контекстное меню. Добавление своего пункта меню подробно описано тут http://www.tyumbit.ru/gal_forum/viewtop ... =2&t=10791.
Запускается интерфейс формирования адреса.
-
Ренат
- Постоянный обитатель
- Сообщения: 194
- Зарегистрирован: 12 сен 2007, 16:34
- Откуда: Глазов
- Контактная информация:
Re: Формирование адреса из внешнего Кладра (MS SQL Server)
Файлы проекта
Файл fcom.prj
Файл Alter_katorg_getAddr.vip
Файл getaddr_kladr.vip
Файл 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"
Код: Выделить всё
!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.
Код: Выделить всё
!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.
-
Ренат
- Постоянный обитатель
- Сообщения: 194
- Зарегистрирован: 12 сен 2007, 16:34
- Откуда: Глазов
- Контактная информация:
Re: Формирование адреса из внешнего Кладра (MS SQL Server)
Теперь посмотрим как все это выглядит в работе
База Кладра на MS SQL Server
http://narod.ru/disk/27398440000/MS-SQL-Server.wmv.html
Формирование адреса в Галактике
http://narod.ru/disk/27398494000/%D0%93 ... 0.wmv.html
База Кладра на MS SQL Server
http://narod.ru/disk/27398440000/MS-SQL-Server.wmv.html
Формирование адреса в Галактике
http://narod.ru/disk/27398494000/%D0%93 ... 0.wmv.html
-
ilshat
- Местный житель
- Сообщения: 222
- Зарегистрирован: 04 июн 2008, 14:35
- Откуда: Стерлитамак
- Контактная информация:
Re: Формирование адреса из внешнего Кладра (MS SQL Server)
А че не 20 сообщений? 
))
В Галке помнится есть встроенный механизм загрузки КЛАДРа. Велосипедоизобретатели?
))В Галке помнится есть встроенный механизм загрузки КЛАДРа. Велосипедоизобретатели?
-
Ренат
- Постоянный обитатель
- Сообщения: 194
- Зарегистрирован: 12 сен 2007, 16:34
- Откуда: Глазов
- Контактная информация:
Re: Формирование адреса из внешнего Кладра (MS SQL Server)
Постарался называется. Видать зря. В следующий раз обязательно с Вами проконсультируюсь.ilshat писал(а):А че не 20 сообщений?
В Галке помнится есть встроенный механизм загрузки КЛАДРа. Велосипедоизобретатели?