Разработка реляционной базы данных для оптимизации работы рекламного агентства

Дипломная работа содержит результаты разработки программного комплекса управления базой данных маркетингового агентства на базе системы управления базами данных Delphi. Разработана быстродействующая и надежная модель.
В работе были детально проанализированы существующие аналоги данного продукта такие как: C++,Turbo Delphi Explorer,Turbo Delphi for.NET Explorer, Turbo C++ Explorer/
Разработана документация пользователя и продумана система помощи внутри программного продукта.
Разработанный программный комплекс является коммерческой продуктом и веден в эксплуатацию.

При необходимости, работа может быть оперативно переделана и доработана под нужную область. Имеется 2 варианта работы, на русском и украинском языках. Имеются исходные файлы реализации программы, презентация(за дополнительную пл ...

Введение 6
ПОСТАНОВКА ЗАДАЧИ 9
1 ОБЗОР СОВРЕМЕННЫХ СРЕДСТВ обработки информации 10
В базах данных 10
1.1 Анализ современных систем обработки баз данных 11
2. Программный комплекс для создания базы данных Маркетинговое агентство и дальнейшего ее ОБРАБОТКИ 15
2.1. Требования к программному продукту 15
2.1.1 Требования к функциональным характеристикам 15
2.1.2 Требования к надежности 16
2.1.3 Условия эксплуатации 16
2.1.4 Требования к составу и параметрам технических средств 16
2.2 Исследование структур баз данных и механизма доступа к ним 17
2.2.1 Исследование структуры базы данных 17
2.2.2 Проектирование средств доступа к информации 19
2.3 Обоснование выбора функций обработки информации в базе данных 20
2.4 Выбор модели базы данных 21
2.5 Особенности построения базы данных маркетингового агентства 27
2.6 Выводы 34
3. Реализация ПРОГРАММНОГО КОМПЛЕКСА 35
3.1 Назначение и состав программного комплекса 35
3.2 Принцип работы программного комплекса 35
3.3 Внутренняя структура базы данных 39
4.1 Общие санитарно-гигиенические требования к компьютерным помещений 44
4.1.1 Требования к уровням шума и вибрации 49
4.1.2 Требования к микроклимату компьютерных помещений 50
4.2 Обеспечение электробезопасности в компьютерных помещениях. 51
ПЕРЕЧЕНЬ ССЫЛОК 62
ПРИЛОЖЕНИЕ 6

Основные идеи современной информационной технологии базируются на концепции, согласно которой данные должны быть организованы в базы данных с целью адекватного отражения реального мира, меняется, и удовлетворения информационных потребностей пользователей. Эти базы создаются и функционируют под управлением специальных программных комплексов, названных системами управления базами данных.
Увеличение объема и структурной сложности хранимых данных, расширение круга пользователей информационных систем привели к широкому распространению наиболее удобных и сравнительно простых для понимания реляционных, то есть табличных, СУБД. Для обеспечения одновременно доступа к данным множества пользователей, нередко расположенных достаточно далеко друг от друга и от места хранения баз данных, созданы сетевые много пользователь версии СУБД. В них тем или иным путем решаются специфические проблемы параллельных процессов, целостности и безопасности данных, а также санкционирования доступа.
Совместная работа пользователей в сетях с помощью унифицированных средств общения с базами данных возможна только при наличии стандартного языка манипулирования базами данных, владеет средствами для реализации перечисленных возможностей. Такой язык стал SQL, разработанный в 1974 году фирмой ИBM для экспериментальной реляционной СУБД System R. После появления на рынке двух пионерских СУБД фирмы - SQL / DS (1981 год) и DB2 (1983 год) - он приобрел статус стандарта де-факто для профессиональных реляционных СУБД. В 1987 году SQL стал международным стандартом языка баз данных, а в 1992 году вышла новая версия стандарта.
С появлением этого стандарта широкое распространение получили программные пакеты, поддерживающие принципы SQL, но используют свои программные модули. Это дало возможность разработчикам лишь поверхностно изучить SQL и более детально рассмотреть необходимый программный продукт.
Учитывая перечисленные возможности, рассмотрим современной рынок страны. Он представлен широким спектром товаров, поставляемых различными производителями. Ни один из них не обходится без соответствующей рекламы.
Крупные фирмы и организации, как правило, не ограничиваются территорией одного города, а охватывают всю страну, что обусловливает необходимость создания и обслуживания центральной много массивной базы данных, доступ к которой имеют многочисленные филиалы и представительства фирмы. Такая база данных, в среднем, сохраняет более 10000 записей.
При обработке таких баз данных наиболее часто возникают проблемы вызваны:
- Периодическими сбоями системы при введении информации, вносит изменения в нескольких таблицах, а также при отображении большого объема информации;
- Медленным поиском нужной информации;
- Сложным и медленным процессом сортировки;
- Ошибками операторов при обработке информации в сложном графической среде.
Эти проблемы возникают из-за плохо продуманную структуру и организацию базы данных, использование устаревшего программного обеспечения, вызывает необходимость поиска новых решений в условиях появления новых требований к массивным базам данных.
 Основными внешними факторами, влияющими на структуру базы данных являются:
- Пропускная способность сеть Internet;
- Потребность в интеграции приложений и данных;
- Быстрое развитие компьютерных технологий и аппаратуры.
 С другой стороны были разработаны основные требования к программному обеспечению для обработки баз данных:
- Облегчение управления, сопровождение и настройка систем баз данных;
- Переосмысление традиционных архитектур систем баз данных;
- Интеграция программ и данных;
- Интеграция структурированных и полу структурированных данных.
Однако основной проблемой баз данных остается обработка больших массивов информации, то есть массивнои базы данных и обеспечение достаточного быстродействия для конкретной области применения. Это требует проведения исследований и разработку специализированного программного обеспечения высокого уровня, так как только такие программные продукты позволяют соединить в себе все необходимые возможности для создания и обработки высокоскоростных и надежных систем управления баз данных.
Такие программные продукты имеют свой интерфейс, используют простую внешнюю систему организации настоящее и только после компиляции переводят свой код в SQL запросы. Это экономит время на подготовку специалистов обработки баз данных и упрощает процесс создания готового продукта

sele 'office'
loca all for alltrim(Sname)==UName
if found()
dat=''
for i=1 to len(UPassword)
dat=dat+alltrim(str(asc(substr(UPassword,i,1))+len(UPassword)))+' '
next
if alltrim(dat)==alltrim(pw)
L_pa=pa
L_pb=pb
L_po=po
else
logon=.f.
endif
else
logon=.f.
endif
if .not.Logon
tt11=db(.f.,DbPath,DbMode)
messagebox('Имя пользователя или пароль введены не верно.','Ошибка')
endif
endif

if Logon
GPath=iif(empty(GPath),DbPath+'Img\',GPath)
h11=fcrea(GPath+'___.tmp')
=fclose(h11)
if file(GPath+'___.tmp')
dele file GPath+'___.tmp'
endif
GPath=iif(h11<0,'',GPath)
else
Gpath=''
endif

do InitLogin with logon

proc error1
param er1 er2
do case
case er1=1707 && notCDX
tt82_notIndex=.t.
case er1=1705 &&exclusive opened
tt83_notAccess=.t.
other
&er2
endcase
return
Програмний модуль Dbclose1.prg
if Logon
if messagebox('Выйти из текущей базы данных?',1,'?')#1
return
endif
tt11=db(.f.,DbPath,DbMode)
Logon=.f.
CurrentPub=-1
GPath=''
else
messagebox('База данных не открыта.','!!!')
endif
Програмний модуль dbreind1.prg
if messagebox('Реорганизовать индексы базы '+DbPath+' ?',1,'?')#1
return
endif
if left(upper(DbMode),4)=='EXCL'
tt11=dbreind2()
else
messagebox('База должна быть открыта в МОНОПОЛЬНОМ режиме',0,'Переиндексация невозможна.')
endif
Програмний модуль dbcopy1.prg
scan for xtype=1
tf1=DbPath+alltrim(_db.XName)
use tf1+'.dbf' in 0 alias tt exclu
if t2
exit
endif
sele 'tt'
use
endscan
on error &t1
sele '_db'
use
else
t2=.t.
endif

if .not.t2
tt125=dbcopy2(DbPath,alltrim(ThisForm.Text2.Value),iif(ThisForm.Check1.Value=0,.t.,.f.) )
ThisForm.Release()
else
=db(.t.,DbPath,DbMode)
logon=.t.
=messagebox('База данных занята. Копирование не возможно.',0,'!')
endif
else
=messagebox('Исходная база данных отсутствует или испорчена.',0,'Копирование не возможно.')
endif
thisform.timer1.enabled=.t.
local tf1,t1
if file(DbPath+'_db.dbf')
if Logon
tt11=db(.f.,DbPath,DbMode)
Logon=.f.
endif
t1=on('error')
on error t2=.t.
t2=.f.
use (DbPath+'_db') exclu in 0
if sele('_db')#0
sele '_db'
scan for xtype=1
tf1=DbPath+alltrim(_db.XName)
use tf1+'.dbf' in 0 alias tt exclu
if t2
exit
endif
sele 'tt'
use
endscan
on error &t1
sele '_db'
use
else
t2=.t.
endif

=db(.t.,DbPath,DbMode)
logon=.t.
if .not.t2
*ThisForm.shape1.Backcolor=rgb(0,255,0)
ThisForm.image1.picture='c:\ode\pr\_proj\graf\green.jpg'
else
*ThisForm.shape1.Backcolor=rgb(255,0,0)
ThisForm.image1.picture='c:\ode\pr\_proj\graf\red.jpg'
endif
else
=messagebox('Исходная база данных отсутствует или испорчена.',0,'Копирование не возможно.')
endif
Програмний модуль verstka.prg
*******************************************************************************
*******************************************************************************
*******************************************************************************
proc vrs_main
local t_ml,tt(1),t1,t2,t3,t4,t5,t6,t7,t8,t9,t21,t_rcnt,k
t_ml=set('memo')
set memo to 10000
Spr2=strtran(Spr,'pcode','dog.pcode')
Spr3=strtran(Spr,'pcode','code_pub')
OneFirm=iif(fcode_1#0,'dog.fcode=fcode_1','.t.')
DateCh=iif(type('DatFrom')=='D','between(datc,DatFrom,DatTo)','.t.')
*********************************************************************
&tmp_say='Формирование списка рубрик...'
sele 'rub'
copy stru to OutPath+'_rub.dbf'
alter table OutPath+'_rub.dbf' add column sk1 c(90)
alter table OutPath+'_rub.dbf' add column emp l(1)
sele _rub
index on sk1 tag sk1 additive
index on code tag code additive
sele rub
set order to
scan for code<998
scatter to tt
sele _rub
append blank
gather from tt
UndChar=.f.
repl sk1 with v_sort2(alltrim(rub.name),.f.)
if UndChar
v_err(h1,'# Нестандартный символ в назв. рубрики'+NL+rub.name)
endif
sele rub
&tmp_progress(recno()/reccount()*100)
endscan
sele _rub
set order to sk1
go top
dele rest while code#RFrom
loca all for code=RTo
if found()
skip
dele rest
else
recall all
go top
dele rest while code#RTo
loca all for code=RFrom
skip
dele rest
endif
*********************************************************************
&tmp_progress(0)
&tmp_say='Формирование списка подразделов...'
sele 'pstru'
copy stru to OutPath+'_pstru.dbf'
alter table OutPath+'_pstru.dbf' add column sk1 c(240)
alter table OutPath+'_pstru.dbf' add column num n(10)
alter table OutPath+'_pstru.dbf' add column nnum n(3)
sele _pstru
index on code2 tag code2 additive
index on code3 tag code3 additive
sele pstru
scan for &Spr3
sele _pstru
append blank
UndChar=.f.
NumV=0
NNumV=0
repl name with pstru.name,code1 with pstru.code1,;
code2 with pstru.code2,code3 with pstru.code3,;
sk1 with v_sort2(alltrim(pstru.name),.t.),code_pub with pstru.code_pub,;
atr with pstru.atr,op with pstru.op,;
datw with pstru.datw,datc with pstru.datc
repl num with NumV, nnum with NNumV
if UndChar
v_err(h1,'# Нестандартный символ в назв. раздела'+NL+pstru.name)
endif
&tmp_progress(recno()/reccount()*100)
endscan
*********************************************************************
if PutExclu &&Ссылка на эксклюзив
&tmp_progress(0)
&tmp_say='Обработка "эксклюзива" издания '+Spr_name
&tmp_progress(50)
sele 'dog'
set order to ndog
sele 'info'
set order to rcode
set rela to ndog into 'dog' additive
copy stru to OutPath+'_infoEx.dbf'
alter table OutPath+'_infoEx.dbf' add column mtmp m(4)
sele 'info'
seek 999
if found()
scan rest for rcode=999 .and. &Spr2
scatter to tmpdim memo
sele '_infoEx'
append blank
gather from tmpdim memo
sele 'info'
endscan
set rela to
endif
&tmp_progress(100)
use HomePath+'exkluziv' in 0 alias eks
sele '_infoEx'
index on ndog tag ndog additive
go top
scan
t1=alltrim(ndog)
t2=recno()
t3=''
do while t1==alltrim(ndog)
sele pstru
do case
case _infoEx.code1=18 && Поисковая система
loca all for &Spr3 .and. code2=_infoEx.code2
case _infoEx.code2=5 .and. (_infoEx.code1=0.or._infoEx.code1=15)
loca all for &Spr3 .and. code2=5 && Заставка к разд. "ЗС"
case _infoEx.code2=5.and._infoEx.code1=16
loca all for &Spr3 .and. code2=5 && Заставка к разд. "Мир Internet"
other
loca all for &Spr3 .and. code1=_infoEx.code1
endcase
if found()
sele 'eks'
loca all for recno('pstru')=rn_pstru
if found()
t3=iif( empty(t3),alltrim(eks.text),t3+', '+alltrim(eks.text) )
else
t3=iif( empty(t3),'!Не определен!',t3+', !Не определен!' )
endif
sele '_infoEx'
endif
skip
enddo
go t2
repl mtmp with t3 rest while t1==alltrim(ndog)
skip -1
endscan
sele 'eks'
use
endif
*********************************************************************
&tmp_progress(0)
&tmp_say='Выборка объявлений издания '+Spr_name
sele 'firm'
set order to fcode
sele 'dog'
set order to ndog
set rela to fcode into firm additive
sele 'info'
set order to rcode
set rela to ndog into 'dog' additive
copy stru to OutPath+'_info.dbf'
alter table OutPath+'_info.dbf' add column fcode n(10)
alter table OutPath+'_info.dbf' add column zg c(240)
alter table OutPath+'_info.dbf' add column zg_u c(240)
alter table OutPath+'_info.dbf' add column sk1 c(240)
alter table OutPath+'_info.dbf' add column num n(10)
alter table OutPath+'_info.dbf' add column nnum n(3)
alter table OutPath+'_info.dbf' add column nru n(3)
alter table OutPath+'_info.dbf' add column pd l(1)
alter table OutPath+'_info.dbf' add column fil n(10)
alter table OutPath+'_info.dbf' add column npp n(10)
alter table OutPath+'_info.dbf' add column rbase n(10)
alter table OutPath+'_info.dbf' add column nshort c(90)
alter table OutPath+'_info.dbf' add column nstr n(4)
alter table OutPath+'_info.dbf' add column printed n(2)
sele _info
index on rcode tag rcode additive
sele '_rub'
count all to t_rcnt
set rela to code into 'info' additive
k=1
scan
sele 'info'
if .not.eof()
do while rcode=_rub.code
if &Spr2 .and. &DateCh .and. (code1=0.or.code1=15).and.&OneFirm &&'Золотые стр.'
sele _info
append blank
repl ndog with info.ndog,rcode with info.rcode,;
txt with info.txt,info with info.info,;
typecode with info.typecode,code1 with info.code1,;
code2 with info.code2,code3 with info.code3,;
fcode with firm.fcode,op with info.op,;
datw with info.datw,datc with info.datc,;
corr with info.corr,dcorr with info.dcorr,;
rbase with recno('info'),;
nshort with firm.nshort
NumV=0
NNumV=0
UndChar=.f.
if typecode=1
if .not.eof('firm')
repl zg with firm.nfull, sk1 with v_sort2(alltrim(firm.nfull),.t.)
else
v_err(h1,'# "Висящий" договор, не прикрепленный ни к одной фирме '+;
alltrim(ndog) )
endif
else
if at('>>ZAG',txt)#0
t1=substr(txt,at('>>ZAG',txt))
tzg1=iif( at('>>',t1,2)#0,substr(t1,8,at('>>',t1,2)-10),substr(t1,8) )
repl zg with tzg1, sk1 with v_sort2(alltrim(tzg1),.t.)
endif
if at('>>ZAG2',txt)#0
t1=substr(txt,at('>>ZAG2',txt))
tzg2=iif( at('>>',t1,2)#0,substr(t1,9,at('>>',t1,2)-11),substr(t1,9) )
repl zg_u with tzg2
endif
endif
repl num with NumV, nnum with NNumV
if UndChar
v_err(h1,'# Нестандартный символ в заголовке'+NL+;
firm.nfull+NL+;
' Тел. '+alltrim(str(firm.tel1))+' '+;
alltrim(ndog)+' Руб.'+alltrim(str(rcode)) )
endif
repl pd with GetValue('PD','info',.f.) && Подруб
repl nru with GetValue('NRU','info',0) && N-я в рубрике
repl fil with iif(GetValue('FIL','info',.f.),firm.filof,0) && Под фирму
endif &&'Золотые стр.'
sele 'info'
skip
enddo
else
*Пустая рубрика
endif
sele '_rub'
k=k+1
&tmp_progress(k/t_rcnt*100)
endscan
set rela to
sele 'dog'
set rela to
sele 'info'
set rela to
*********************************************************************
&tmp_progress(0)
&tmp_say='Вывод...'
if apnd
h2=fopen(FAnsi,2)
=fseek(h2,0,2)
else
h2=fcrea(FAnsi)
endif
if h2<0
=messagebox('Ошибка создания файла '+FAnsi)
retu
endif
sele info
set order to rcode
sele rub
set order to code
sele dog
set order to ndog
sele _info
set order to rcode
sele _rub
set order to sk1
set rela to code into _info
k=1
t4=0
scan
&tmp_say='Вывод '+alltrim(name)
crea dbf OutPath+'_infru.dbf' ( name c(240),sk1 c(240),num n(10),nnum n(3),;
nru n(3), pd l(1), code2 n(3),code3 n(3),;
fcode n(10), urn n(10), levrn n(5),;
fil n(10), fil_r n(10), npp n(10), flag n(3),;
printed n(2) )
index on npp tag npp additive
index on sk1 tag sk1 additive
set order to
sele '_info'
do while rcode=_rub.code
sele '_infru'
append blank
repl name with _info.nshort,;
sk1 with _info.sk1, num with _info.num, nnum with _info.nnum,;
nru with _info.nru, pd with _info.pd, fil with _info.fil,;
code2 with _info.code2, code3 with _info.code3,;
fcode with _info.fcode, urn with recno('_info')
if (code2=0 .and. code3=0 .and. fil=0) &&(1-й уровень: Алф + "N-й в руб")
repl flag with 1
if pd
repl pd with .f.
v_err(h1,'Название подрубрики не указано (Подр.- игнор.) '+;
alltrim(_info.ndog)+' Р.'+alltrim(str(_info.rcode)) )
endif
endif
if pd &&(1-й уровень: Подрубрика)
if code2#0.and.code3#0
v_err(h1,'Указаны оба раздела и подрубрика (R2 - игнор.)'+;
alltrim(_info.ndog)+' Р.'+alltrim(str(_info.rcode)) )
repl code3 with 0
else
*repl code2 with iif(code2=0,code3,code2)
*repl code3 with 0
if fil#0
v_err(h1,'Указаны и "под фирму" и подрубр. ("под фирму" - игнор.) '+;
alltrim(_info.ndog)+' Р.'+alltrim(str(_info.rcode)) )
repl fil with 0
endif
endif
endif
sele '_info'
skip
enddo
sele '_infru'
if reccount()=0 &&Пустая рубрика
repl _rub.emp with .t.
else
sele '_pstru'
set order to code2
sele code2 from '_infru' distinct into cursor 'cr2' &&***R1 Заголовок***
scan for code2#0
sele '_pstru'
seek cr2.code2
sele '_infru'
append blank
if found('_pstru')
repl name with _pstru.name,;
sk1 with _pstru.sk1, num with _pstru.num, nnum with _pstru.nnum,;
code2 with cr2.code2, urn with recno('_pstru'),fcode with -2
else
t1='<несущ. раздел R1> №'+alltrim(str(cr2.code2))
repl name with t1,sk1 with v_sort2(t1,.f.),;
code2 with cr2.code2,fcode with -2
v_err(h1,'#Ссылка на несущ. раздел: R1='+alltrim(str(cr2.code2))+;
' Р.'+alltrim(str(_rub.code))+' Фирма '+alltrim(str(fcode)) )
endif
sele 'cr2'
endscan
sele '_pstru'
set order to code3
sele code3 from '_infru' distinct into cursor 'cr3' &&***R2 Заголовок****
scan for code3#0
sele '_pstru'
seek cr3.code3
sele '_infru'
append blank
if found('_pstru')
repl name with _pstru.name,;
sk1 with _pstru.sk1, num with _pstru.num, nnum with _pstru.nnum,;
code3 with cr3.code3, urn with recno('_pstru'),fcode with -3
else
t1='<несущ. раздел R2> №'+alltrim(str(cr3.code3))
repl name with t1,sk1 with v_sort2(t1,.f.),;
code3 with cr3.code3,fcode with -3
v_err(h1,'#Ссылка на несущ. раздел: R2='+alltrim(str(cr3.code3))+;
' Р.'+alltrim(str(_rub.code))+' Фирма '+alltrim(str(fcode)) )
endif
sele 'cr3'
endscan
sele 'firm'
set order to fcode
sele '_infru'
count all for flag=0 to t1
for i2=1 to 97 &&Компоновка филиалов....
scan all for flag=0.and.fil#0.and.fcode>0
t3=recno()
t7=fil
loca all for fcode=t7
t21=found()
if .not.t21
sele 'firm'
seek t7
t21=found()
sele '_info'
append blank
repl ndog with '<Нет в этой рубрике>',;
txt with '>>ZAG'+NL+iif(t21,alltrim(firm.nshort)+NL+'Фирмы нет в рубрике!!!',;
'!Фирмы нет в базе!!!'),;
sk1 with v_sort2(alltrim(iif(t21,firm.nshort,'!Фирмы нет в базе!!!')),.f.),;
typecode with 2,fcode with t7,;
zg with iif(t21,'!!!Фирмы нет в рубрике!!!'+NL+alltrim(firm.nshort),;
'!Фирмы нет в базе!!!'),;
nshort with iif(t21,firm.nshort,'!Фирмы нет в базе!!!')
sele '_infru'
append blank
repl flag with 1,name with _info.nshort,sk1 with _info.sk1,;
pd with .f.,fcode with t7, urn with recno('_info')
t21=.t.
endif
if t21
t4=iif( flag#0,flag+1,iif(fil#0,0,;
iif(code2#0,1,0)+iif(code3#0,1,0)+2 ) )
go t3
if t4>1
if code2#0
t4=t4+1
t5=code2
loca all for code2=t5.and.fcode=-2.and.;
( flag=0.or.(flag=t4-1.and.fil=t7) )
if .not.found()
loca all for code2=t5.and.fcode=-2
if found()
scatter to tt
append blank
gather from tt
else
v_err(h1,'#0001 Не может быть. Руб.'+alltrim(str(_rub.rcode)) )
append blank
endif
endif
repl flag with t4-1,fil with t7,fil_r with t7
go t3
endif
if code3#0
t4=t4+1
t5=code3
t6=code2
loca all for code3=t5.and.fcode=-3.and.( flag=0.or.(flag=t4-1.and.;
t7=iif(t6=0,fil,fil_r).and.fil=iif(t6=0,t7,t6*(-1)) ) )
if .not.found()
loca all for code3=t5.and.fcode=-3
if found()
scatter to tt
append blank
gather from tt
else
v_err(h1,'#0002 Не может быть Руб.'+alltrim(str(_rub.rcode)) )
append blank
endif
endif
repl flag with t4-1,fil with iif( t6=0,t7,t6*(-1) ),;
fil_r with t7,code2 with t6
go t3
endif
repl flag with t4
endif
else
go t3
v_err(h1,'#Основная фирма в рубрике не найдена'+;
' Р.'+alltrim(str(_rub.code))+' Фирма '+alltrim(str(fcode))+;
' Осн. фирма '+alltrim(str(fil)) )
repl fil with fil-fil-fil,flag with 1,code2 with 0,code3 with 0
endif
endscan
count all for flag=0 to t2
if t1>t2
t1=t2
else
exit
endif
next
sele '_infru'
scan for flag=0.and.fcode>0 &&Оставшееся + мусор
t3=recno()
do case
case code2#0.or.code3#0.and.fil=0 &&******************R2 под R1
repl flag with 1+iif(code2#0,1,0)+iif(code3#0,1,0)
t5=code3
t7=code2
t9=pd
repl pd with .f.
if code2#0
loca all for code2=t7.and.fcode=-2.and.;
( flag=0.or.(flag=1.and.fil=0) )
if .not.found()
loca all for code2=t7.and.fcode=-2
if found()
scatter to tt
append blank
gather from tt
else
v_err(h1,'#0003 Не может быть. Руб.'+alltrim(str(_rub.rcode)) )
append blank
endif
endif
repl flag with 1,fil with 0,fil_r with 0,pd with t9
endif
if t5#0
t8=iif(code2#0,2,1)
loca all for code3=t5.and.fcode=-3 .and. ( flag=0.or.;
(flag=t8.and.fil=t7*(-1).and.fil_r=0.and.code2=t7) )
if .not.found()
loca all for code3=t5.and.fcode=-3
if found()
scatter to tt
append blank
gather from tt
else
v_err(h1,'#0004 Не может быть. Руб.'+alltrim(str(_rub.rcode)) )
append blank
endif
endif
repl flag with t8,fil with t7*(-1),fil_r with 0,code2 with t7,pd with t9
endif
other &&*************************Мусор
repl flag with 1,num with 1
endcase
go t3
endscan
sele 'cr2' &&********Удаление заголовков пустых R1, R2
scan for code2#0
sele '_infru'
loca all for fcode>0.and.code2=cr2.code2
if .not.found()
dele all for fcode=-2.and.code2=cr2.code2
endif
sele 'cr2'
endscan
use
sele 'cr3'
scan for code3#0
sele '_infru'
loca all for fcode>0.and.code3=cr3.code3
if .not.found()
dele all for fcode=-3.and.code3=cr3.code3
endif
sele 'cr3'
endscan
use
&&************************* Компоновка и вывод
do v_prn_rub with _rub.code
sele '_infru'
afields(tt)
crea cursor 'tmp' from array tt
sele '_infru'
loca all for flag>1
t4=found()
do v_sort3 with 'sk1','num','nnum','nru','pd','npp','flag=1','lv1'
scan
if tmp.fcode<0.and._infru.fcode>0
do v_prn with 'tgLN','-'
endif
do v_prn
if t4
RecTo('tmp')
i=1
do while .t.
t8=order()
set order to &&.and. printed=0
repl levrn with tmp.urn all for ;
flag=i+1 .and. ( ;
(tmp.fcode>0 .and. fil=tmp.fcode) .or. ;
(tmp.fcode=-2 .and. tmp.code2=code2.and.;
tmp.fil=iif(fcode>0,fil,fil_r) ).or.;
(tmp.fcode=-3 .and. tmp.code2=code2.and.;
tmp.code3=code3.and.;
fil=iif(tmp.fil>0,tmp.fil,tmp.fil_r) ) )
set order to &t8
if _TALLY>0
do LevDn
do v_prn
else
if i=1
exit
endif
go tmp.urn
skip
if .not.eof()
sele 'tmp'
dele
sele '_infru'
RecTo('tmp')
else
do while eof().and.i>1
do LevUp
enddo
if i=1
exit
else
if tmp.fcode<0.and._infru.fcode>0
do v_prn with 'tgLN','-'
endif
sele 'tmp'
dele
sele '_infru'
RecTo('tmp')
endif
t9=0
endif
do v_prn
endif
enddo
sele '_infru'
set order to lv1
go tmp.urn
endif
endscan
sele 'tmp'
use
endif &&Пустая рубрика
sele _rub
k=k+1
&tmp_progress(k/t_rcnt*100)
endscan
set rela to
=fclose(h2)
set memo to t_ml
return
******************
proc LevDn
do v_sort3 with 'sk1','num','nnum','nru','pd','npp',;
'levrn='+alltrim(str(tmp.urn)) , 'levrn'+alltrim(str(tmp.urn))
go top
RecTo('tmp')
i=i+1
retu
******************
proc LevUp
local t1
sele 'tmp'
dele
skip -1
i=i-1
if i>1
skip -1