вообще-то, он достаточно громоздкий. и вряд ли, в нем можно быстро разобраться... запустить его уж точно не получиться. если только по виду можно будет что-то сказать...
я думала, может, что-то принципиальное мешает ему выполняться. Может, то, что таблицы в Базу данных не собраны.. а может, VFP память, как-то иначе использует, не так, как FoxPro 2.6...
вот он, код:
Parameters NK_Un, NK_SUN, NK_SDate, NK_EDate
NK_SD = NK_SDate
NK_ED = NK_EDate
SNK_Un = NK_Un
SNK_SUN = NK_SUn
select NKart
SD = NK_SD - day(NK_SD) + 1
ED = gomonth(NK_ED - day(NK_ED) + 1, 1) - 1
do while SD <= ED
append blank
replace Uniqnum with NK_UN,;
RMonth with SD
SD = gomonth(SD,1)
enddo
select Romoney
go top
if seek(NK_UN, 'RB866', 4)
UNArrSize = 1
do while .T.
if RB866->SeekDn > 0
if seek(RB866->SeekDn, 'RB866', 4)
UNArrSize = UNArrSize + 1
loop
endif
endif
exit
enddo
dimension UNArr[UNArrSize]
UNArr = 0
for UnCount = 1 to UNArrSize
UNArr[UNCount] = RB866->UniqNum
SUp = RB866->SeekUp
if SUp > 0 .and. seek(SUp, 'RB866', 4)
loop
endif
exit
endfor
else
return
endif
select NKart
go top
scan
N_RMonth = NKart.RMonth
for UnCount = 1 to UNArrSize
NK_UN = UNArr[UNCount]
NK_SUN = padl(alltrim(str(UNArr[UNCount])), 7, '0')
if !seek(NK_SUN, 'RoMoney')
loop
endif
select RoMoney
set order to 2
if seek(NK_SUN + str(99999999 - val(dtos(N_RMonth)), 8), 'RoMoney') && RoMoney.PMonth
select RoMoney
scan rest;
for RoMoney.RC > 0 .and. !empty(DocNo) .and. !empty(DocDate);
.and. RoMoney.PMonth = N_RMonth;
while RoMoney.Uniqnum = NK_UN .and. RoMoney.PMonth = N_RMonth
=This.AddRecs()
endscan
endif
endfor &&for UnCount = 1 to UNArrSize
select TMoney
replace all TMoney.Summa with round(Summa, _MRound)
go top
TOTAL TO (_TotFile) ON NUCode FIELDS Summa
select 0
use (_TotFile) alias TFile exclusive
select KLNKrt
go top
FList = ''
scan for KLNKrt.F_User .and. !eof('KLNKrtS') .and. !empty(KLNKrt.F_Func) .and. eof('KLNKrtD1')
VarName = alltrim(Field_Name)
VarSumma = 0
FList = FList + iif(!empty(FList), ",", "") + alltrim(Field_Name)
select KLNKrtS
scan rest for KLxCode == KLNKrt.F_klx .and. at(Scode, alltrim(KLNKrt.F_Func)) > 0
SNU = 0
if !empty(KLCodeNU)
select TFile
sum Summa to SNU for at(NUCode, alltrim(KLNKrtS.KLCodeNU)) > 0
select KLNKrtS
endif
VarSumma = VarSumma + SNU
endscan
&VarName = VarSumma
select NKart
gather memvar fields &VarName
if !empty(KLNKrt.F_expr)
ErrOk = .F.
on error ErrOk = .T.
Expr = alltrim(KLNKrt.F_expr)
S = evaluate(Expr)
on error &_lcOldError
if ErrOk
VarSumma = 0
else
VarSumma = S
endif
&VarName = VarSumma
select NKart
gather memvar fields &VarName
endif
select KLNKrt
endscan
* Кусок, который особенно тормозит в VFP и выполняется мгновенно в 2.6
select TMoney
set order to 2
go top
m.RMonth = N_RMonth
select KLNKrtD
go top
scan for !eof('KLNKrtS')
select TMoney
go top
SNU = 0
sum Summa to SNU for at(NUCode, alltrim(KLNKrtS.KLCodeNU)) > 0 ;
and at(T_Work,alltrim(KLNKrtS.SCat)) > 0 ;
and at(Zvan,upper(KLNKrtS.SZvan)) > 0
select NKartD
SNU_All = 0
go top
sum Summa to SNU_All for NKartD.Str_ind = KLNKrtD.Str_ind ;
while NKartD.RMonth < N_RMonth
select NKartD
if !seek(strtran(str(NK_UN,7), ' ', '0') + dtos(N_RMonth) ;
+ strtran(str(KLNKrtD.Str_Ind, 2), ' ', '0'))
append blank
replace UniqNum with NK_UN, ;
RMonth with N_RMonth, ;
Str_ind with KLNKrtD.Str_ind
endif
SMnth = 'SM_' + alltrim(str(Str_ind, 2))
&SMnth = SNU
SYear = 'SG_' + alltrim(str(Str_ind, 2))
&SYear = SNU_All + SNU
if !empty(alltrim(KLNKrtD.Expr))
VarList = ''
select Prochie
set relation off into Docum
select Docum
set relation to upper(NUProc) into KLNKrtP
go top
scan for at(Docum.NuCode,alltrim(KLNKrtS.KLCodeNU)) > 0 and !eof('KLNKrtP')
if seek(NK_SUN + Docum.Doc, 'Prochie')
select Prochie
locate rest for Doc = Docum.Doc ;
.and. S_Date <= gomonth(m.RMonth - day(m.RMonth) + 1, 1) - 1 ;
.and. year(S_Date)=year(N_RMonth);
while UniqNum = NK_UN
if found()
scatter memvar
select KLNKrtP
scan rest while upper(NUproc) = upper(Docum.Nuproc)
PVar = alltrim(KLNKrtP.P_varN)
MVar = alltrim(KLNKrtP.P_pfield)
&PVar = &MVar
VarList = VarList + iif(empty(VarList), "", ",") + PVar
endscan
endif
endif
select Docum
endscan
select Docum
set relation off into KLNKrtP
select Prochie
set relation to Doc into Docum additive
=seek(NK_SUN, 'Prochie')
StrExpr = alltrim(KLNKrtD.Expr)
ErrOk = .F.
on error ErrOk = .T.
SumExpr = eval(StrExpr)
on error &_lcOldError
if ErrOk
SumExpr = 0
endif
SNU = SumExpr
if !empty(VarList)
release &VarList
endif
select NKartD
replace Summa with Summa + SNU, ;
Summa_All with SNU_All + SNU &&Summa
else
select NKartD
replace Summa with Summa + SNU, ;
Summa_All with SNU_All + SNU &&Summa
endif
&SMnth = NKartD.Summa
&SYear = NKartD.Summa_All
select KLNKrtD
endscan &&®ЇаҐ¤Ґ«ҐЁҐ ¤®Ї.Ёд.
* <end> Кусок ...
select KLNKrt
go top
scan for KLNKrt.F_User .and. !eof('KLNKrtS') .and. !empty(KLNKrt.F_Func);
.and. !eof('KLNKrtD1')
VarName = alltrim(Field_Name)
VarSumma = 0
select KLNKrtS
scan rest for KLxCode == KLNKrt.F_klx .and. at(Scode,alltrim(KLNKrt.F_Func))>0
SeekC = SNK_SUN + dtos(N_RMonth) + STRTRAN(STR(KLNKrtD1.STR_IND, 2), " ", "0")
SNU = iif(seek(SeekC, 'NKartD'), NKartD.Summa, 0)
VarSumma = VarSumma + SNU
endscan
&VarName = VarSumma
select NKart
gather memvar fields &VarName
if !empty(KLNKrt.F_expr)
ErrOk = .F.
on error ErrOk = .T.
Expr = alltrim(KLNKrt.F_expr)
S = evaluate(Expr)
on error &_lcOldError
if ErrOk
VarSumma = 0
else
VarSumma = S
endif
&VarName = VarSumma
select NKart
gather memvar fields &VarName
endif
select KLNKrt
endscan
select TMoney
set order to 1
zap
select TFile
zap
use in TFile
select NKart
endscan
if set('debug') == 'ON'
on key label F12
endif
return && FillNKrt