Initial: flux text FoxBin2Prg (git urmareste .??2 in-arbore, binarele VFP git-ignored)
Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
19
Programe/Vechi/DATAPIF.PRG
Normal file
19
Programe/Vechi/DATAPIF.PRG
Normal file
@@ -0,0 +1,19 @@
|
||||
|
||||
local d,l,a,t
|
||||
public m.dat
|
||||
|
||||
sele mf
|
||||
d=day(datapif)
|
||||
|
||||
l=month(datapif)+mod(normat,12)
|
||||
a=year(datapif)+int(normat/12)
|
||||
if l>12
|
||||
l=l-12
|
||||
a=a+1
|
||||
endif
|
||||
|
||||
|
||||
t=str(d,2)+'/'+str(l,2)+'/'+str(a,4)
|
||||
|
||||
m.dat=ctod(t)
|
||||
|
||||
39
Programe/Vechi/SITAN1.PRG
Normal file
39
Programe/Vechi/SITAN1.PRG
Normal file
@@ -0,0 +1,39 @@
|
||||
SET SAFETY OFF
|
||||
|
||||
|
||||
local i,t,k
|
||||
public m.an m.nl m.t_2121 m.t_2122 m.t_2123 m.t_2124 m.t_2125 m.t_2126 an nl
|
||||
*store ' ' to m.an, m.nl
|
||||
store 0 to i, k, m.t_2121, m.t_2122, m.t_2123, m.t_2124, m.t_2125, m.t_2126
|
||||
|
||||
sele 0
|
||||
use &DIRGEN\MFIX2000\datE\sitmf.dbf EXCLUSIVE ALIAS SITMF
|
||||
ZAP
|
||||
|
||||
sele mf
|
||||
use
|
||||
|
||||
SELE CALENDAR
|
||||
scan
|
||||
scatter memvar
|
||||
|
||||
*cale = 'c:\delta\data\an'+m.an+'\date'+m.nl
|
||||
SELECT 0
|
||||
use &DATE\mf.dbf again alias mf
|
||||
|
||||
for i=1 to 6
|
||||
t='sum ceiling(valoare/normat) to m.t_212' +str(i,1)+' for scd = "212'+str(i,1)+'" '
|
||||
&t
|
||||
next
|
||||
sele sitmf
|
||||
appe blank
|
||||
gather memvar
|
||||
SELE MF
|
||||
USE
|
||||
endscan
|
||||
|
||||
SELE SITMF
|
||||
report form sitmf1 TO PRINTER PROMPT PREVIEW
|
||||
USE
|
||||
|
||||
do totv
|
||||
85
Programe/Vechi/actualizari.prg
Normal file
85
Programe/Vechi/actualizari.prg
Normal file
@@ -0,0 +1,85 @@
|
||||
CLOSE DATABASE
|
||||
SELE 0
|
||||
USE &calefirma\datean\calendar ALIAS calendar
|
||||
SELE calendar
|
||||
SCAN
|
||||
SCATTER MEMVAR
|
||||
DATE=calefirma+'\AN'+m.an+'\DATE'+M.nl
|
||||
DO pmf1
|
||||
ENDSCAN
|
||||
***
|
||||
|
||||
DO totv
|
||||
|
||||
|
||||
|
||||
|
||||
*____________________________________________
|
||||
PROCEDURE pmf1
|
||||
IF !FILE('&date\mf.DBF')
|
||||
RETURN
|
||||
ENDIF
|
||||
DELE FILE &DATE\mfa.*
|
||||
DELE FILE &DATE\mfv.*
|
||||
COPY FILE &dirgen\mfix2000\DATE\mf.* TO &DATE\mfa.*
|
||||
SELE 0
|
||||
USE &DATE\mfa.DBF AGAIN ALIAS mfa EXCLUSIVE
|
||||
SELE mfa
|
||||
ZAP
|
||||
SELE mfa
|
||||
APPEND FROM &DATE\mf
|
||||
SELE mfa
|
||||
REINDEX
|
||||
USE
|
||||
RENAME &DATE\mf.* TO &DATE\mfv.*
|
||||
RENAME &DATE\mfa.* TO &DATE\mf.*
|
||||
RETURN
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
*__________________________________
|
||||
PROC pmf2
|
||||
SELE 0
|
||||
USE &DATE\mf.DBF EXCL ALIAS mf
|
||||
IF !existacimp('mf','amorttot')
|
||||
ALTER TABLE mf ADD COLUMN amorttot N(14)
|
||||
ENDIF
|
||||
IF !existacimp('mf','amortlun')
|
||||
ALTER TABLE mf ADD COLUMN amortlun N(14)
|
||||
ENDIF
|
||||
IF !existacimp('mf','amortprec')
|
||||
ALTER TABLE mf ADD COLUMN amortprec N(14)
|
||||
ENDIF
|
||||
IF !existacimp('mf','uzuraprec')
|
||||
ALTER TABLE mf ADD COLUMN uzuraprec N(5)
|
||||
ENDIF
|
||||
USE
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
|
||||
|
||||
*_____________________________
|
||||
FUNCTION existacimp
|
||||
PARAM numet,numec
|
||||
FOR i=1 TO FCOUNT()
|
||||
IF UPPER(ALLT(FIELD(i)))=UPPER(ALLT(numec))
|
||||
RETURN .T.
|
||||
ENDIF
|
||||
NEXT
|
||||
RETURN .F.
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
28
Programe/Vechi/calcamort.prg
Normal file
28
Programe/Vechi/calcamort.prg
Normal file
@@ -0,0 +1,28 @@
|
||||
local cond,c,t,i,a,m.amortlun
|
||||
cond='month(datapif)=val(m.nl) and year(datapif)=val(m.an) and uzuraprec=0'
|
||||
sele mf
|
||||
scan
|
||||
do case
|
||||
case UPPER(left(tipamort,1))='L'&&LINIARA
|
||||
repl amortlun with IIF(UZURA>NORMAT or &cond ,0,iif(uzura=normat,valoare-AMORTprec,ROUND((valoare-AMORTprec)/(normat-UZURA+1),0)))
|
||||
repl amortan with amortlun*12
|
||||
case UPPER(left(tipamort,1))='A'&&ACCELERATA
|
||||
IF (P>0 AND P<=0.5) AND UZURA<=12
|
||||
repl amortlun with IIF(UZURA>NORMAT or &cond ,0,iif(uzura=normat,valoare-AMORTprec,ROUND(valoare*P/12,0)))
|
||||
ELSE
|
||||
repl amortlun with IIF(UZURA>NORMAT or &cond ,0,iif(uzura=normat,valoare-AMORTprec,ROUND((valoare*(1-p))/(normat-12),0)))
|
||||
ENDIF
|
||||
repl amortan with amortlun*12
|
||||
case UPPER(left(tipamort,1))='D'&&DEGRESIVA
|
||||
if mod(uzura,12)=1
|
||||
c=12*k/normat
|
||||
repl amortan with iif(uzura>normat,0,round((valoare-amortprec)*c,0))
|
||||
if amortan<12*valoare/normat
|
||||
repl amortan with iif(uzura>normat,0,(valoare-amortprec)/(normat/12-round(uzura/12,0)))
|
||||
endif
|
||||
endif
|
||||
|
||||
REPL AMORTLUN WITH IIF(UZURA>NORMAT or &cond ,0,iif(uzura=normat,valoare-AMORTprec,round(amortan/12,0)))
|
||||
ENDCASE
|
||||
repl amorttot with amortprec+amortlun
|
||||
endscan
|
||||
82
Programe/Vechi/calcamortm.prg
Normal file
82
Programe/Vechi/calcamortm.prg
Normal file
@@ -0,0 +1,82 @@
|
||||
LOCAL cond,c
|
||||
|
||||
lnValRez = m.valrez
|
||||
IF VAL(m.an) >= 2004
|
||||
m.valrez = 0 && din 2004 trece ca si valoare amortizata
|
||||
ENDIF
|
||||
|
||||
cond='month(m.datapif)=val(m.nl) and year(m.datapif)=val(m.an) and m.uzuraprec=0'
|
||||
m.normaan=ROUND(m.normat/12,3)
|
||||
|
||||
IF m.valramasa = 0 AND m.dataeval = m.datapif
|
||||
m.valramasa = m.valin - m.valrez
|
||||
ENDIF
|
||||
|
||||
IF m.normat2=0
|
||||
m.normat2=m.normaan
|
||||
ENDIF
|
||||
|
||||
IF m.normat2lun=0
|
||||
m.normat2lun=m.normat
|
||||
ENDIF
|
||||
|
||||
DO CASE
|
||||
CASE UPPER(LEFT(m.tipamort,1))='L' &&LINIARA
|
||||
DO amortlin
|
||||
m.amortan=ROUND(m.amortlun*12,gnZ)
|
||||
CASE UPPER(LEFT(m.tipamort,1))='A' &&ACCELERATA
|
||||
IF (m.P>0 AND m.P<=0.5) AND m.UZURA<=12
|
||||
m.amortlun = IIF(m.UZURA>m.normat OR &cond ,0,IIF(M.UZURA=M.normat,M.valin-m.valrez-M.AMORTprec,ROUND((m.valin-m.valrez)*m.P/12,gnZ)))
|
||||
ELSE
|
||||
m.amortlun = IIF(m.UZURA>m.normat OR &cond ,0,IIF(M.UZURA=M.normat,M.valin-m.valrez-M.AMORTprec,ROUND(((m.valin-m.valrez)*(1-m.P))/(m.normat-12),gnZ)))
|
||||
ENDIF
|
||||
m.amortan=ROUND(m.amortlun*12,gnZ)
|
||||
CASE UPPER(LEFT(m.tipamort,1))='D' &&DEGRESIVA
|
||||
IF MOD(m.UZURA,12)=1
|
||||
c=12*m.k/m.normat
|
||||
m.amortan = IIF(m.UZURA>m.normat,0,ROUND((m.valin-m.valrez-m.AMORTprec)*c,gnZ))
|
||||
IF m.amortan<ROUND(12*(m.valin-m.valrez)/m.normat,gnZ)
|
||||
m.amortan = ROUND((m.valin-m.valrez-m.AMORTprec)/(ROUND(m.normat2lun/12,3)-ROUND(m.UZURA/12,3)),gnZ)
|
||||
ENDIF
|
||||
ENDIF
|
||||
m.amortlun = IIF(m.UZURA>m.normat OR &cond ,0,IIF(m.UZURA=m.normat,M.valin-m.valrez-M.AMORTprec,ROUND(m.amortan/12,gnZ)))
|
||||
ENDCASE
|
||||
|
||||
m.amorttot=m.amortlun+m.AMORTprec
|
||||
m.valrez = lnValRez
|
||||
|
||||
RETURN
|
||||
***------------------------------------------------------------------------------------------
|
||||
|
||||
PROCEDURE amortlin
|
||||
LOCAL cond,c,cond2
|
||||
cond='(month(m.datapif)=val(m.nl) and year(m.datapif)=val(m.an) and m.uzuraprec=0)' && in luna punerii in functiune
|
||||
|
||||
IF ROUND(12*VAL(m.an)+VAL(m.nl),0)>12*YEAR(m.dataeval)+MONTH(m.dataeval)+m.normat2lun
|
||||
cond2='(M.AMORTPREC>=M.valin-m.valrez)' && total amortizare din luna precedenta a ajuns la valoare-valoarea reziduala
|
||||
ELSE
|
||||
cond2 = '.f.'
|
||||
ENDIF
|
||||
|
||||
IF &cond OR &cond2
|
||||
m.amortlun =0
|
||||
ELSE
|
||||
IF ROUND(12*VAL(m.an)+VAL(m.nl),0)=12*YEAR(m.dataeval)+MONTH(m.dataeval)+m.normat2lun AND m.cota <> 0
|
||||
m.amortlun = M.valin - m.valrez - M.AMORTprec
|
||||
IF m.amortlun<0
|
||||
m.amortlun=0
|
||||
ENDIF
|
||||
ELSE
|
||||
m.amortlun = ROUND(m.valramasa*m.cota/12/100,gnZ)
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
IF M.AMORTprec+M.amortlun>m.valin-m.valrez AND m.valin = m.valoare && cele care nu au fost reevaluate
|
||||
m.amortlun=M.valin-m.valrez-M.AMORTprec
|
||||
IF M.amortlun<0
|
||||
m.amortlun=0
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
***------------------------------------------------------------------------------------------------
|
||||
|
||||
88
Programe/Vechi/calcamortmv.prg
Normal file
88
Programe/Vechi/calcamortmv.prg
Normal file
@@ -0,0 +1,88 @@
|
||||
Local cond,c
|
||||
cond='month(m.datapif)=val(m.nl) and year(m.datapif)=val(m.an) and m.uzuraprec=0'
|
||||
m.normaan=Round(m.normat/12,0)
|
||||
*!* If m.normat2<0
|
||||
*!* m.normat2=0
|
||||
*!* Endif
|
||||
|
||||
*WAIT WINDOW STR(m.tipcalcul)
|
||||
|
||||
Do Case
|
||||
Case Upper(Left(m.tipamort,1))='L' &&LINIARA
|
||||
*m.amortlun = IIF(m.UZURA>m.NORMAT or &cond ,0,iif(M.uzura=M.normat,M.valoare-M.AMORTprec,ROUND((m.valoare-m.AMORTprec)/(m.normat-m.UZURA+1),0)))
|
||||
Do amortlin
|
||||
m.amortan=m.amortlun*12
|
||||
Case Upper(Left(m.tipamort,1))='A' &&ACCELERATA
|
||||
If (m.P>0 And m.P<=0.5) And m.UZURA<=12
|
||||
m.amortlun = Iif(m.UZURA>m.normat Or &cond ,0,Iif(M.UZURA=M.normat,M.valramasa-M.AMORTprec,Round(m.valramasa*m.P/12,0)))
|
||||
Else
|
||||
m.amortlun = Iif(m.UZURA>m.normat Or &cond ,0,Iif(M.UZURA=M.normat,M.valramasa-M.AMORTprec,Round((m.valramasa*(1-m.P))/(m.normat-12),0)))
|
||||
Endif
|
||||
m.amortan=m.amortlun*12
|
||||
Case Upper(Left(m.tipamort,1))='D' &&DEGRESIVA
|
||||
If Mod(m.UZURA,12)=1
|
||||
c=12*m.k/m.normat
|
||||
m.amortan = Iif(m.UZURA>m.normat,0,Round((m.valramasa-m.AMORTprec)*c,0))
|
||||
If m.amortan<12*m.valramasa/m.normat
|
||||
m.amortan = (m.valramasa-m.AMORTprec)/(m.normat/12-Round(m.UZURA/12,0))
|
||||
Endif
|
||||
Endif
|
||||
m.amortlun = Iif(m.UZURA>m.normat Or &cond ,0,Iif(m.UZURA=m.normat,M.valramasa-M.AMORTprec,Round(m.amortan/12,0)))
|
||||
Endcase
|
||||
|
||||
|
||||
|
||||
m.amorttot=m.amortlun+m.AMORTprec
|
||||
*wait wind m.denumire
|
||||
Return
|
||||
|
||||
|
||||
|
||||
|
||||
*__________________________________________________________
|
||||
Proc amortlin
|
||||
Local cond,c,cond2
|
||||
cond='(month(m.datapif)=val(m.nl) and year(m.datapif)=val(m.an) and m.uzuraprec=0)' && in luna punerii in functiune
|
||||
*cond2='((M.AMORTPREC>=M.VALRAMASA AND m.normat2#0) OR (M.AMORTPREC>=M.VALOARE AND m.normat2=0))'
|
||||
cond2='(M.AMORTPREC>=M.valramasa-m.valrez)' && total amortizare din luna precedenta a ajuns la valoare-valoarea reziduala
|
||||
|
||||
|
||||
IF m.normat2=0
|
||||
m.normat2=m.normaan
|
||||
ENDIF
|
||||
IF m.normat2lun=0
|
||||
m.normat2lun=m.normat2*12
|
||||
ENDIF
|
||||
|
||||
*!* If m.normat2=0
|
||||
*!* m.valramasa=m.valoare
|
||||
*m.cota=Round(1/m.normaan*100,1)
|
||||
*!* Else
|
||||
m.cota=Round(1/m.normat2*100,1)
|
||||
*!* Endif
|
||||
|
||||
|
||||
If &cond Or &cond2
|
||||
m.amortlun =0
|
||||
Else
|
||||
If M.UZURA=M.normat
|
||||
m.amortlun =M.valramasa-M.AMORTprec
|
||||
*!* IF m.amortlun<0
|
||||
*!* m.amortlun=0
|
||||
*!* endif
|
||||
Else
|
||||
*If m.tipcalcul=0
|
||||
m.amortlun = Round(m.valramasa*m.cota/12/100,0)
|
||||
*Else
|
||||
* m.amortlun = Round((m.valramasa-m.AMORTprec)/(m.normat-m.UZURA+1),0)
|
||||
*Endif
|
||||
Endif
|
||||
Endif
|
||||
|
||||
If M.AMORTprec+M.amortlun>M.valramasa
|
||||
m.amortlun=M.valramasa-M.AMORTprec
|
||||
If M.amortlun<0
|
||||
m.amortlun=0
|
||||
Endif
|
||||
Endif
|
||||
return
|
||||
11
Programe/Vechi/calcul_cota.prg
Normal file
11
Programe/Vechi/calcul_cota.prg
Normal file
@@ -0,0 +1,11 @@
|
||||
PARAMETERS tnDurataRamasa
|
||||
|
||||
&& tnDurataRamasa este exprimata in luni
|
||||
|
||||
*!* IF EMPTY(tnDurataRamasa) OR TYPE('tnDurataRamasa') # 'N'
|
||||
*!* RETURN 0
|
||||
*!* ENDIF
|
||||
|
||||
lnCota = ROUND((1/tnDurataRamasa)*100*12,2) && cota pe an
|
||||
|
||||
RETURN lnCota
|
||||
22
Programe/Vechi/calcuzura.prg
Normal file
22
Programe/Vechi/calcuzura.prg
Normal file
@@ -0,0 +1,22 @@
|
||||
PARAMETERS toXmf
|
||||
|
||||
IF TYPE('toXmf') # 'O'
|
||||
RETURN .f.
|
||||
ENDIF
|
||||
|
||||
lnLunaCrt = VAL(M.NL)
|
||||
lnAnCrt = VAL(M.AN)
|
||||
lnUzura = toXmf.uzura
|
||||
IF toXmf.cota # 0 AND toXmf.codop <> 12 && conservare
|
||||
&& toXmf.codop <> 12 conditie necesara pt ca, deocamdata la calculul amortizarii tine cont de uzura si nu doar de cota
|
||||
lnUzPrec = toXmf.uzuraprec
|
||||
lnLunaPif=MONTH(toXmf.DATAPIF)
|
||||
lnAnPif=YEAR(toXmf.DATAPIF)
|
||||
UZ=IIF(lnAnCrt < lnAnPif, 0, 12*(lnAnCrt-lnAnPif)+lnLunaCrt-lnLunaPif) && 12*(an crt - an pif) + luna crt - luna pif
|
||||
|
||||
if UZ=0 and lnUzPrec#0
|
||||
UZ=1
|
||||
ENDIF
|
||||
lnUzura = UZ+lnUzPrec
|
||||
ENDIF
|
||||
RETURN lnUzura
|
||||
22
Programe/Vechi/calcuzurav.prg
Normal file
22
Programe/Vechi/calcuzurav.prg
Normal file
@@ -0,0 +1,22 @@
|
||||
LOCAL NRL,NRA,L,A,UZ,lnUzPrec
|
||||
STORE 0 TO L,A,UZ,lnUzPrec
|
||||
NRL=VAL(M.NL)
|
||||
NRA=VAL(M.AN)
|
||||
|
||||
SELE XMF
|
||||
SCAN FOR !casat AND codop <> 12 && necasate si neconservate
|
||||
lnUzPrec = uzuraprec
|
||||
if empty(datapif)
|
||||
do mesaj with 'Trebuie introdusa data punerii in functiune','la '+allt(denumire)
|
||||
*return
|
||||
ENDIF
|
||||
L=MONTH(DATAPIF)
|
||||
A=YEAR(DATAPIF)
|
||||
UZ=IIF(NRA<A,0,12*(NRA-A)+NRL-L) && 12*(an crt - an pif) + luna crt - luna pif
|
||||
|
||||
if UZ=0 and lnUzPrec#0
|
||||
UZ=1
|
||||
ENDIF
|
||||
|
||||
REPL UZURA WITH UZ+lnUzPrec
|
||||
ENDSCAN
|
||||
78
Programe/Vechi/compar_calendare.prg
Normal file
78
Programe/Vechi/compar_calendare.prg
Normal file
@@ -0,0 +1,78 @@
|
||||
PARAMETERS tcFisImob, tcFisCont
|
||||
|
||||
LOCAL lcFisImob,lcAliasImob,lcFisCont,lnSucces,lcCaleFisier
|
||||
STORE '' TO lcFisImob,lcAliasImob,lcFisCont,lcCaleFisier
|
||||
lnSucces = 1
|
||||
lcAliasImob = [calendar]
|
||||
|
||||
glImobIndependent = .F.
|
||||
|
||||
IF EMPTY(tcFisImob) OR TYPE('tcFisImob') # 'C'
|
||||
lcFisImob = 'calendarmf'
|
||||
ELSE
|
||||
lcFisImob = ALLTRIM(tcFisImob)
|
||||
ENDIF
|
||||
|
||||
IF EMPTY(tcFisCont) OR TYPE('tcFisCont') # 'C'
|
||||
lcFisCont = 'calendar'
|
||||
ELSE
|
||||
lcFisCont = ALLTRIM(tcFisCont)
|
||||
ENDIF
|
||||
|
||||
*** verific daca in DATERETEA in tabelul start_programe.dbf am independ = .T.
|
||||
*!* IF TYPE('gcCaleDateRetea') = 'U' && in prg principal. dc am start nou
|
||||
*!* lcDateRetea = ADDBS(ALLTRIM(dirgen)) + 'DATERETEA'
|
||||
*!* ELSE
|
||||
*!* lcDateRetea = ALLTRIM(gcCaleDateRetea)
|
||||
*!* ENDIF
|
||||
|
||||
*!* lcCaleFisier = ADDBS(lcDateRetea) + 'start_programe.dbf'
|
||||
*!* IF FILE(lcCaleFisier)
|
||||
*!* USE &lcCaleFisier IN 0 SHARED ALIAS start_prg
|
||||
*!* IF TYPE('start_prg.independ') # 'U'
|
||||
*!* SELECT start_prg
|
||||
*!* LOCATE FOR INLIST(UPPER(ALLTRIM(gcAppName)),UPPER(ALLTRIM(nume)),UPPER(ALLTRIM(director)))
|
||||
*!* IF FOUND() AND independ
|
||||
*!* gleIndependent = .T.
|
||||
*!* ENDIF
|
||||
*!* ENDIF
|
||||
*!* ENDIF
|
||||
***
|
||||
|
||||
IF glImobIndependent && dc programul ruleaza independent de contabilitate
|
||||
lcCaleFisierImob = ADDBS(CALEFIRMA) + [datean\] + lcFisImob + [.dbf]
|
||||
lcCaleFisierCont = ADDBS(CALEFIRMA) + [datean\] + lcFisCont + [.dbf]
|
||||
IF !FILE(lcCaleFisierImob)
|
||||
DO des WITH lcAliasImob && se creaza structura vida
|
||||
IF FILE(lcCaleFisierCont)
|
||||
* USE &lcCaleFisierCont IN 0 shared ALIAS calendar_cont
|
||||
SELECT (lcAliasImob)
|
||||
APPEND FROM &lcCaleFisierCont FOR !DELETED() AND (!EMPTY(an) OR !EMPTY(nl))
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
IF !glImobIndependent && dc programul e legat de contabilitate
|
||||
lcCaleFisierImob = ADDBS(CALEFIRMA) + [datean\] + lcFisImob + [.dbf]
|
||||
lcCaleFisierCont = ADDBS(CALEFIRMA) + [datean\] + lcFisCont + [.dbf]
|
||||
DO des WITH lcAliasImob
|
||||
IF !FILE(lcCaleFisierCont)
|
||||
DO mesaj WITH 'Nu exista fisierul calendar.dbf!','Deschideti programul de contabilitate.'
|
||||
lnSucces = -1
|
||||
ENDIF
|
||||
IF lnSucces > 0 && compar calendarele, update calendarmf
|
||||
* USE &lcCaleFisierCont IN 0 shared ALIAS calendar_cont
|
||||
SELECT (lcAliasImob)
|
||||
CALCULATE MAX(12*VAL(an)+VAL(nl)) TO lnMaxData
|
||||
APPEND FROM &lcCaleFisierCont FOR (12*VAL(an)+VAL(nl))>lnMaxData AND !DELETED() AND (12*VAL(an)+VAL(nl))# 0 && IN CAZUL UNUI CALENDAR CU LINII GOALE
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
IF USED(lcAliasImob)
|
||||
USE IN &lcAliasImob
|
||||
ENDIF
|
||||
IF USED('start_prg')
|
||||
USE IN start_prg
|
||||
ENDIF
|
||||
|
||||
RETURN lnSucces
|
||||
14
Programe/Vechi/danu_ingest.prg
Normal file
14
Programe/Vechi/danu_ingest.prg
Normal file
@@ -0,0 +1,14 @@
|
||||
*________________________________________
|
||||
PROCEDURE danu_ingest
|
||||
PARAMETERS cas,txt1,txt2
|
||||
SELECT mf
|
||||
oi=CREATEOBJECT('ingest')
|
||||
oi.label1.caption=txt1
|
||||
oi.label2.caption=txt2
|
||||
IF cas
|
||||
oi.label2.visible=.f.
|
||||
oi.text1.visible=.f.
|
||||
ENDIF
|
||||
oi.show(1)
|
||||
RETURN
|
||||
*________________________________________
|
||||
42
Programe/Vechi/deschidV.prg
Normal file
42
Programe/Vechi/deschidV.prg
Normal file
@@ -0,0 +1,42 @@
|
||||
local lunatrec,antrec,lunacrt,ancrt,dattrec,datcrt
|
||||
set safety off
|
||||
|
||||
lunacrt=m.nl
|
||||
ancrt=m.an
|
||||
|
||||
sele calendar
|
||||
locate for m.an=an and m.nl=nl
|
||||
skip -1
|
||||
if bof()
|
||||
*este prima luna deschisa__________
|
||||
|
||||
copy file &dirgen\mfix2000\date\*.* to &date\*.*
|
||||
|
||||
else
|
||||
*nu este prima luna deschisa__________
|
||||
lunatrec=nl
|
||||
antrec=an
|
||||
dattrec=calefirma+'\AN'+antrec+'\DATE'+lunatrec+'\'+'mf.*'
|
||||
LOCAL DATTREC1
|
||||
dattrec1=calefirma+'\AN'+antrec+'\DATE'+lunatrec+'\'+'mf.DBF'
|
||||
|
||||
|
||||
*dar daca nici luna precedenta nu a fost dechisa__________
|
||||
if !file('&dattrec1')
|
||||
|
||||
copy file &dirgen\mfix2000\date\*.* to &date\*.*
|
||||
|
||||
else
|
||||
|
||||
copy file &dattrec to &date\*.*
|
||||
|
||||
endif
|
||||
SELECT 0
|
||||
USE &date\mf.dbf;
|
||||
AGAIN ALIAS mf
|
||||
repl all cod with 0
|
||||
sele mf
|
||||
use
|
||||
endif
|
||||
|
||||
return
|
||||
70
Programe/Vechi/deschidl.prg
Normal file
70
Programe/Vechi/deschidl.prg
Normal file
@@ -0,0 +1,70 @@
|
||||
Local valan,a,b,datea,dateb,nfrm
|
||||
DIRFIRM=loc+'\'+NFSCURT
|
||||
|
||||
Set Safety Off
|
||||
Set Exclusive On
|
||||
|
||||
b=Iif(M.NNLMAX<10,'0'+Str(M.NNLMAX,1),Str(M.NNLMAX,2))
|
||||
dateb='an'+m.an+'\'+'DATE'+b
|
||||
m.NNLMAX=M.NNLMAX+1
|
||||
a=Iif(M.NNLMAX<10,'0'+Str(M.NNLMAX,1),Str(M.NNLMAX,2))
|
||||
m.nl=a
|
||||
|
||||
If m.NNLMAX=13
|
||||
m.NNLMAX=1
|
||||
a='01'
|
||||
valan=m.anmax+1
|
||||
m.an=Alltrim(Str(valan))
|
||||
m.anmax=m.an
|
||||
m.nl=a
|
||||
Endif
|
||||
datea='an'+m.an+'\'+'DATE'+a
|
||||
Date=datea
|
||||
|
||||
Set Defa To &calefirma
|
||||
If !Directory('&datea')
|
||||
Md &datea
|
||||
Endif
|
||||
Close Database
|
||||
*DO DES WITH 'CALENDAR'
|
||||
|
||||
*Do DESCHID.PRG
|
||||
**************
|
||||
|
||||
Set Defa To ..
|
||||
Set Defa To ..
|
||||
Set Defa To ..
|
||||
Set Defa To ..
|
||||
|
||||
m.anmax=m.an
|
||||
m.nlmax=m.nl
|
||||
m.NNL=M.NNLMAX
|
||||
Show Gets
|
||||
Set Exclusive Off
|
||||
|
||||
Do totv.PRG
|
||||
Sele CALENDAR
|
||||
*loca for SCONT=.f.
|
||||
*
|
||||
*if eof() then
|
||||
Appe Blank
|
||||
*endif
|
||||
*
|
||||
Repl nl With a
|
||||
Repl an With m.an
|
||||
*REPL SCONT WITH .T.
|
||||
Goto Recno()-1
|
||||
Scatter Fiel CTVAI,CTVAM,plafoncasa,plafonplat Memvar
|
||||
Goto Recno()+1
|
||||
*repl ctvai with m.ctvai
|
||||
*repl ctvam with m.ctvam
|
||||
Gath Fiel CTVAI,CTVAM,plafoncasa,plafonplat Memvar
|
||||
|
||||
Return
|
||||
**********************************
|
||||
* sfarsit procedura deschid luna *
|
||||
**********************************
|
||||
|
||||
|
||||
|
||||
|
||||
60
Programe/Vechi/exportare.prg
Normal file
60
Programe/Vechi/exportare.prg
Normal file
@@ -0,0 +1,60 @@
|
||||
LPARAMETERS tabel, initial, final
|
||||
LOCAL nrc, i, c
|
||||
STORE 0 TO nrc, i
|
||||
STORE '' TO c
|
||||
curentdir=SYS(5)+SYS(2003)
|
||||
A='C:\MY DOCUMENTS'
|
||||
B='C:\DOCUMENTS AND SETTINGS'
|
||||
DO CASE
|
||||
CASE DIRECTORY('&A')
|
||||
SET DEFAULT TO '&A'
|
||||
CASE DIRECTORY('&B')
|
||||
SET DEFAULT TO '&B'
|
||||
OTHERWISE
|
||||
MD &A
|
||||
SET DEFAULT TO '&A'
|
||||
ENDCASE
|
||||
|
||||
|
||||
exista_excel=.F.
|
||||
|
||||
initial = ','+initial+',' &&Pentru a recunoste coloanele'
|
||||
final = ','+final+',' &&---||---
|
||||
|
||||
nrc = OCCURS(',', '&initial')
|
||||
nrc=nrc-1 && scade virgula din fata
|
||||
|
||||
LOCAL ARRAY c_initial(nrc)
|
||||
LOCAL ARRAY c_final(nrc)
|
||||
|
||||
FOR i = 1 TO nrc
|
||||
n = AT(',', '&initial', i)
|
||||
n2 =AT(',', '&initial', i+1)
|
||||
c_Initial[i] = SUBSTR('&initial', n+1, n2-n-1)
|
||||
*MESSAGEBOX(c_initial[i])
|
||||
n = AT(',', '&final', i)
|
||||
n2 =AT(',', '&final', i+1)
|
||||
c_final[i] = SUBSTR('&final', n+1, n2-n-1)
|
||||
*MESSAGEBOX(c_final[i])
|
||||
ENDFOR
|
||||
|
||||
FOR i=1 TO nrc
|
||||
IF i=nrc
|
||||
c=c+c_initial[i]+' as '+c_final[i]
|
||||
ELSE
|
||||
c=c+c_initial[i]+' as '+c_final[i]+','
|
||||
ENDIF
|
||||
ENDFOR
|
||||
|
||||
calea_fis = PUTFILE('Nume fisier:', 'Foaie_Excel', 'XLS')
|
||||
IF EMPTY(calea_fis) && Esc pressed
|
||||
SET DEFAULT TO &curentdir
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
SELECT &c FROM &tabel INTO CURSOR cur
|
||||
SELECT cur
|
||||
EXPORT TO (calea_fis) TYPE XL5
|
||||
|
||||
*SET DEFAULT TO &DIRGEN
|
||||
SET DEFAULT TO &curentdir
|
||||
664
Programe/Vechi/imob2003.prg
Normal file
664
Programe/Vechi/imob2003.prg
Normal file
@@ -0,0 +1,664 @@
|
||||
PARAMETERS tparam
|
||||
|
||||
&&& imob2003
|
||||
|
||||
|
||||
SET CENTURY ON
|
||||
SET DELETED ON
|
||||
SET DATE TO DMY
|
||||
SET EXCLUSIVE OFF
|
||||
SET CPDIALOG OFF
|
||||
SET TALK OFF
|
||||
SET SAFETY OFF
|
||||
SET ESCAPE OFF
|
||||
SET EXACT ON
|
||||
SET ANSI ON
|
||||
SET CONSOLE OFF
|
||||
SET NOTIFY OFF
|
||||
SET SECONDS OFF
|
||||
_SCREEN.AUTOCENTER=.T.
|
||||
_SCREEN.VISIBLE=.F.
|
||||
|
||||
LOCAL lcMainClassLib
|
||||
LOCAL lcLastSetTalk,lcLastSetPath,lcLastSetClassLib,lcOnShutdown
|
||||
PUBLIC pofirma,poCalendar
|
||||
|
||||
PUBLIC dirgen,dirfirm,DATE,datean,calet,nfscurt,m.an,m.nl,M.NUME_2,M.NUMEGEST,m.suma,buton,pc_nume,M.FLUNG,m.id_sectie
|
||||
PUBLIC m.cod,m.nract,m.dataact,m.datapif,m.nrpif,m.denumire,m.nrinv,m.codmf,m.normat,titlu
|
||||
PUBLIC m.valoare,m.uzura,m.tipamort,m.gest,m.respons,m.caract,m.scd,m.fdoc,M.EXPLICATIA
|
||||
PUBLIC totval,PRIMADATA,m.text,m.nr1,m.nr2,_nract,_dataact,_cod,m.sumat,pamort1,pamort2,pnrinv1,pnrinv2,pdata1,pdata2
|
||||
PUBLIC Tden,Tsuma,Tgest,tscd,m.suma1,m.suma2,m.data1,m.data2,m.suma,bden,bsuma,bgest,bscd,bnrinv,bresp,bcasat
|
||||
PUBLIC m.an, m.nl, m.t_2121, m.t_2122, m.t_2123, m.t_2124, m.t_2125, m.t_2126, an, nl
|
||||
PUBLIC s,s1,s2,s3,s4,s5,s6,CALEFIRMA,M.CALEFIRM,parolaactiva,parola,corect
|
||||
PUBLIC M.R_2121,M.R_2122,M.R_2123,M.R_2124,M.R_2125,M.R_2126
|
||||
PUBLIC M.V_2121,M.V_2122,M.V_2123,M.V_2124,M.V_2125,M.V_2126
|
||||
PUBLIC M.Vr_2121,M.Vr_2122,M.Vr_2123,M.Vr_2124,M.Vr_2125,M.Vr_2126
|
||||
PUBLIC m.uzuraprec,m.amorttot,m.amortlun,m.amortprec,M.P,M.K,m.amortan,anul,luna,m.valin,m.dataeval
|
||||
PUBLIC OSTART,uz,STARE,m.cota,m.valramasa,m.normat2,m.normaan,m.normat2lun
|
||||
PUBLIC TVALOARE,ultima_luna,M.NUMELUNA,M.luna,M.ANTET,felul,M.NIVEL,m.tipcalcul
|
||||
PUBLIC E_INDEPENDENT,LUNA_NEPLATITA,PRIMADATA1,NUMEPROGRAM,op_imob,gnZ
|
||||
STORE 0 TO gnZ
|
||||
*E_INDEPENDENT=.T.
|
||||
PUBLIC luna_inchisa
|
||||
|
||||
STORE '' TO dirgen,dirfirm,DATE,datean,calet,nfscurt,m.an,m.nl
|
||||
STORE 0 TO m.nract,m.valoare,m.normat,m.gest,m.cod,m.uzura,m.suma,buton,totval,_nract,_cod,m.normaan
|
||||
STORE 0 TO s,s1,s2,s3,s4,s5,s6,M.R_2121,M.R_2122,M.R_2123,M.R_2124,M.R_2125,M.R_2126,M.V_2121,M.V_2122,M.V_2123,M.V_2124,M.V_2125,M.V_2126
|
||||
STORE 0 TO M.Vr_2121,M.Vr_2122,M.Vr_2123,M.Vr_2124,M.Vr_2125,M.Vr_2126,STARE,m.cota,m.valramasa,m.normat2,m.normat2lun,m.valin
|
||||
STORE 0 TO m.uzuraprec,m.amorttot,m.amortlun,m.amortprec,uz,M.P,M.K,m.amortan,TVALOARE
|
||||
STORE '' TO m.denumire,m.nrpif,m.codmf,m.nrinv,m.tipamort,m.respons,m.scd,m.caract,m.fdoc,DATE,pc_nume,M.FLUNG,M.NUMELUNA,M.luna,M.ANTET
|
||||
STORE '' TO nfscurt,M.NUME_2,M.NUMEGEST,M.EXPLICATIA,m.text,CALEFIRMA,M.CALEFIRM,parolaactiva,parola,anul,luna,titlu,felul,m.id_sectie
|
||||
STORE DATE() TO m.dataact,m.datapif,_dataact,m.data1,m.data2,pdata1,pdata2
|
||||
STORE .T. TO PRIMADATA,LUNA_NEPLATITA,PRIMADATA1
|
||||
STORE .F. TO ultima_luna,corect
|
||||
STORE 0 TO m.tipcalcul
|
||||
STORE .F. to luna_inchisa
|
||||
|
||||
|
||||
|
||||
*-- Save and configure environment.
|
||||
lcLastSetTalk=SET("TALK")
|
||||
SET TALK OFF
|
||||
lcLastSetPath=SET("PATH")
|
||||
|
||||
SET PATH TO ;DATE;INCLUDE;FERESTRE;GRAFICE;HELP;CLASE;MENIURI;PROGRAME;RAPOARTE;
|
||||
PUSH MENU _MSYSMENU
|
||||
|
||||
***
|
||||
lcLastSetClassLib=SET("CLASSLIB")
|
||||
lcMainClassLib="clase\mfix2000"
|
||||
SET CLASSLIB TO (lcMainClassLib) ADDITIVE
|
||||
SET CLASSLIB TO appwiz ADDITIVE
|
||||
SET CLASSLIB TO FERESTREBAZA ADDITIVE
|
||||
SET CLASSLIB TO CAUT ADDITIVE
|
||||
SET CLASSLIB TO CAUTmf ADDITIVE
|
||||
SET CLASSLIB TO cont2000-2 ADDITIVE
|
||||
SET CLASSLIB TO cont2000-3 ADDITIVE
|
||||
SET CLASSLIB TO registry ADDITIVE
|
||||
SET CLASSLIB TO imob_2005 ADDITIVE
|
||||
***
|
||||
SET PROCEDURE TO PROCEDURI ADDITIVE
|
||||
SET PROCEDURE TO PROC_menu ADDITIVE
|
||||
SET PROCEDURE TO TOTV ADDI
|
||||
SET PROCEDURE TO proceduri_comune ADDITIVE
|
||||
|
||||
SET PROCEDURE TO quitapp ADDITIVE
|
||||
SET PROCEDURE TO init_program ADDITIVE
|
||||
SET PROCEDURE TO proceduri_verificare_luna.prg ADDITIVE
|
||||
|
||||
|
||||
PUBLIC glVerificTabel && daca se verifica structura tabelelor in totv.prg
|
||||
glVerificTabel=.T.
|
||||
|
||||
PUBLIC glQuit
|
||||
glQuit = .F.
|
||||
|
||||
PUBLIC gnIdIstoric
|
||||
STORE 0 TO gnIdIstoric
|
||||
|
||||
PUBLIC gcAppPath,gcAppName,gcAppDataPath, gcTempPath, gcCaleServerDate,gcAppCaption
|
||||
|
||||
gcAppPath = ADDBS(JUSTPATH(SYS(16,0)))
|
||||
gcAppName = JUSTSTEM(SYS(16,0))
|
||||
gcAppDataPath=gcAppPath+"Date_"+gcAppName+"\" && D:\CONTAFIN\TRANS\DATE_TRANS && PT OPTIUNI , FISIERE SPECIFICE PROGRAMULUI SI
|
||||
gcAppCaption = 'CONTAFIN IMOBILIZARI'
|
||||
STORE "" TO gcTempPath, gcCaleServerDate
|
||||
|
||||
IF !DIRECTORY(gcAppDataPath)
|
||||
MD (gcAppDataPath)
|
||||
ENDIF
|
||||
|
||||
liat=RAT("\",gcAppPath,2)
|
||||
dirgen=ADDBS(LEFT(gcAppPath,liat-1))
|
||||
CD &dirgen
|
||||
|
||||
|
||||
IF verificari()
|
||||
_SCREEN.VISIBLE=.T.
|
||||
DO mesaj WITH "Se fac verificari programului","Va rugam reveniti"
|
||||
glQuit= .T.
|
||||
QUIT
|
||||
ENDIF
|
||||
|
||||
|
||||
IF !Debug_Start()
|
||||
lcParam=tparam
|
||||
IF EMPTY(tparam) OR (TYPE('tParam')='C' AND !verific_start(tparam,dirgen,gcAppName))
|
||||
_SCREEN.VISIBLE=.T.
|
||||
DO mesaj WITH "Programul trebuie pornit doar din START",""
|
||||
QUIT
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
*** verificare serie permanenta
|
||||
PUBLIC tipar,exista_excel,SER_PERM,SER_PERI,VERSIUNE
|
||||
STORE .F. TO SER_PERM,SER_PERI
|
||||
|
||||
USE &gcAppPath\SER IN 0 ALIAS SER SHARED
|
||||
SELECT SER
|
||||
GO TOP
|
||||
tipar=TIP
|
||||
SER_PERM=SER_PERMAN
|
||||
SER_PERI=SER_PERIOD
|
||||
VERSIUNE=VERcont
|
||||
MODEL_PROGRAM=MODEL
|
||||
USE IN SER
|
||||
PAROLAMEA=SUBSTR(tipar,MONTH(DATE()),1)
|
||||
PAROLAMEA=PAROLAMEA+ALLT(STR(DAY(DATE())))+ALLT(STR(MONTH(DATE())))
|
||||
|
||||
IF !_DEBUG()
|
||||
IF SER_PERM AND !verif_ser_perm()
|
||||
QUIT
|
||||
ENDIF
|
||||
ENDIF
|
||||
***********************************************************************
|
||||
*** INITIALIZEZ CAI DATE
|
||||
PUBLIC cales,eserver,loc,utilizator
|
||||
IF !Start_Nou()
|
||||
|
||||
CD C:\
|
||||
IF !DIRECTORY('contafin')
|
||||
MD contafin
|
||||
ENDIF
|
||||
CD contafin
|
||||
IF !DIRECTORY('temp')
|
||||
MD temp
|
||||
ENDIF
|
||||
|
||||
eserver=.F.
|
||||
STORE '' TO cales,loc
|
||||
IF !FILE('c:\contafin\temp\ceprogram.dbf')
|
||||
COPY FILE &DIRGEN\_ALFA\TEMPO\CEPROGRAM.* TO c:\contafin\temp\CEPROGRAM.*
|
||||
ENDIF
|
||||
|
||||
IF FILE('&DIRGEN\START2000\DATA\RETEA.DBF')
|
||||
IF !FILE('c:\contafin\temp\RETEA.dbf')
|
||||
COPY FILE &dirgen\START2000\DATA\RETEA.* TO C:\contafin\temp\RETEA.*
|
||||
ENDIF
|
||||
SELE 0
|
||||
USE C:\contafin\temp\RETEA
|
||||
eserver=SERVER
|
||||
cales=ALLT(CALESERVER)
|
||||
USE IN RETEA
|
||||
ENDIF
|
||||
|
||||
|
||||
UTILIZATOR=''
|
||||
IF FILE('c:\contafin\temp\CEPROGRAM.dbf')
|
||||
|
||||
SELE 0
|
||||
USE C:\contafin\temp\CEPROGRAM ALIAS CEPROGRAM
|
||||
GO TOP
|
||||
SCAT MEMV
|
||||
UTILIZATOR=m.util
|
||||
USE IN CEPROGRAM
|
||||
ENDIF
|
||||
CD &dirgen
|
||||
ELSE
|
||||
gcTempPath = Init_Cale_Temp(dirgen)
|
||||
IF !DIRECTORY(gcTempPath)
|
||||
MD (gcTempPath)
|
||||
ENDIF
|
||||
|
||||
CALES = Init_Cale_Server_Date(dirgen)
|
||||
ESERVER = .T.
|
||||
NUMESTATIE = Init_Nume_Statie(dirgen)
|
||||
utilizator = Init_Nume_Utilizator(dirgen)
|
||||
M.nivel = ROUND(VAL(Init_Nivel_Utilizator(dirgen)),0)
|
||||
M.CONTAB = UPPER(ALLTRIM(Init_NumeAlternativ(dirgen)))
|
||||
|
||||
lcQuitData = ADDBS(ALLTRIM(DIRGEN))+"dateretea"
|
||||
lcQuitName = "start_quitapp"
|
||||
PRIVATE goQuitApp && I'm making it private so it will die with the application.
|
||||
goQuitApp = quitapp(lcQuitData,lcQuitName)
|
||||
gnIdIstoric = Start_Istoric(m.utilizator, gcAppName, NUMESTATIE, ADDBS(ALLTRIM(DIRGEN))+"DATERETEA\", "START_ISTORIC","start_ids")
|
||||
|
||||
ENDIF
|
||||
**************************************************************************************
|
||||
|
||||
|
||||
|
||||
_SCREEN.AUTOCENTER=.T.
|
||||
_SCREEN.WINDOWSTATE=2
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
lcOnShutdown="ShutDown()"
|
||||
ON SHUTDOWN &lcOnShutdown
|
||||
ON ERROR ErrorHandler(ERROR(),PROGRAM(),LINENO())
|
||||
_SHELL="DO Cleanup IN progs\Imob2003"
|
||||
|
||||
*-- Instantiate application object.
|
||||
RELEASE goApp
|
||||
PUBLIC goApp
|
||||
goApp=CREATEOBJECT("cApplication")
|
||||
|
||||
|
||||
*-- Configure application object.
|
||||
goApp.SetCaption("CONTAFIN IMOBILIZARI")
|
||||
goApp.cStartupMenu=ADDBS(gcAppPath) + "meniuri\mfix2000"
|
||||
goApp.cStartupForm=ADDBS(gcAppPath) + "ferestre\fundal"
|
||||
|
||||
|
||||
*-- Show application.
|
||||
goApp.SHOW
|
||||
|
||||
*-- Release application.
|
||||
RELEASE goApp
|
||||
|
||||
*-- Restore default menu.
|
||||
POP MENU _MSYSMENU
|
||||
|
||||
*-- Restore environment.
|
||||
ON ERROR
|
||||
ON SHUTDOWN
|
||||
IF NOT lcLastSetClassLib==SET("classlib")
|
||||
RELEASE CLASSLIB (lcMainClassLib)
|
||||
ENDIF
|
||||
IF EMPTY(lcLastSetPath)
|
||||
SET PATH TO
|
||||
ELSE
|
||||
SET PATH TO &lcLastSetPath
|
||||
ENDIF
|
||||
IF lcLastSetTalk=="ON"
|
||||
SET TALK ON
|
||||
ELSE
|
||||
SET TALK OFF
|
||||
ENDIF
|
||||
RETURN
|
||||
|
||||
|
||||
|
||||
FUNCTION ErrorHandler(nError,cMethod,nLine)
|
||||
LOCAL lcErrorMsg,lcCodeLineMsg
|
||||
|
||||
WAIT CLEAR
|
||||
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)
|
||||
lcErrorMsg=lcErrorMsg+"Method: "+cMethod
|
||||
lcCodeLineMsg=MESSAGE(1)
|
||||
IF BETWEEN(nLine,1,10000) AND NOT lcCodeLineMsg="..."
|
||||
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
|
||||
IF NOT EMPTY(lcCodeLineMsg)
|
||||
lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF MESSAGEBOX(lcErrorMsg,17,_SCREEN.CAPTION)#1
|
||||
ON ERROR
|
||||
RETURN .F.
|
||||
ENDIF
|
||||
ENDFUNC
|
||||
|
||||
|
||||
|
||||
FUNCTION SHUTDOWN
|
||||
|
||||
=End_Istoric(gnIdIstoric, ADDBS(DIRGEN)+"DATERETEA\", "START_ISTORIC")
|
||||
IF TYPE("goApp")=="O" AND NOT ISNULL(goApp)
|
||||
RETURN goApp.OnShutDown()
|
||||
ENDIF
|
||||
Cleanup()
|
||||
QUIT
|
||||
ENDFUNC
|
||||
|
||||
|
||||
FUNCTION Cleanup
|
||||
|
||||
IF CNTBAR("_msysmenu")=7
|
||||
RETURN
|
||||
ENDIF
|
||||
ON ERROR
|
||||
ON SHUTDOWN
|
||||
SET CLASSLIB TO
|
||||
SET PATH TO
|
||||
CLEAR ALL
|
||||
CLOSE ALL
|
||||
POP MENU _MSYSMENU
|
||||
RETURN
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
*-----------------------------------------------------
|
||||
|
||||
FUNCTION verif_ser_perm
|
||||
CLEAR
|
||||
|
||||
RETURN PORNIRE()
|
||||
********
|
||||
*?pornire()
|
||||
|
||||
FUNCTION PORNIRE
|
||||
SET EXACT ON
|
||||
PRIVATE calewin,calesys,checksum1,checksum2,serinreg,serdisk,file1,file2,valret,serdisktemp,ser1,ser2,key1,KEY2
|
||||
STORE '' TO calewin,serinreg,serdisk,calesys,serdisktemp,catehd,ser1,ser2,key1,KEY2
|
||||
STORE 0 TO checksum1,checksum2
|
||||
STORE .T. TO valret
|
||||
DECLARE INTEGER SHGetFolderPath IN SHFOLDER.DLL ;
|
||||
INTEGER hwndOwner, ;
|
||||
INTEGER nFolder, ;
|
||||
INTEGER hToken, ;
|
||||
INTEGER dwFlags, ;
|
||||
STRING @ pszPath
|
||||
DECLARE INTEGER GetActiveWindow IN WIN32API
|
||||
#DEFINE CSIDL_WINDOWS 36
|
||||
#DEFINE CSIDL_SYSTEM 37
|
||||
#DEFINE CSIDL_PROGRAMS 38
|
||||
lcPath = REPL(CHR(0),261)
|
||||
=SHGetFolderPath(GetActiveWindow(),CSIDL_WINDOWS,0,0,@lcPath)
|
||||
calewin=LEFT(lcPath,AT(CHR(0),lcPath)-1)
|
||||
lcPath = REPL(CHR(0),261)
|
||||
=SHGetFolderPath(GetActiveWindow(),CSIDL_SYSTEM,0,0,@lcPath)
|
||||
calesys=LEFT(lcPath,AT(CHR(0),lcPath)-1)
|
||||
&&se verifica existenta celor trei fisiere
|
||||
IF (NOT FILE(calesys+'\diskserial.dll')) OR (NOT FILE(calesys+'\getmacip.dll')) OR (NOT FILE(calewin+'\comdir.snr'))
|
||||
valret=.F.
|
||||
ENDIF
|
||||
IF valret
|
||||
file1=FILETOSTR(calesys+'\diskserial.dll')
|
||||
checksum1=SYS(2007,file1)
|
||||
file2=FILETOSTR(calesys+'\getmacip.dll')
|
||||
checksum2=SYS(2007,file2)
|
||||
&&severifica daca dll-urile nu au fost modificate
|
||||
IF (VAL(checksum1) != 58755) OR (VAL(checksum2) != 30476)
|
||||
valret=.F.
|
||||
ENDIF
|
||||
ENDIF
|
||||
&&se citesc seriile tutturor celor patru hard disk-uri posibile(pe IDE primary master,primary slave...)
|
||||
&&se tine minte primul cu seria nenula-daca nu s-a putut citi seria de la nici unul se pune o serie default
|
||||
&&seria default este "NUAREHAR"
|
||||
IF valret
|
||||
DECLARE INTEGER GetSerialNumber IN diskSerial.DLL INTEGER ,STRING
|
||||
catehd=0
|
||||
FOR i=0 TO 3
|
||||
serdisktemp=SPACE(40)
|
||||
GetSerialNumber(i,@serdisktemp)
|
||||
IF (LEN(ALLTRIM(serdisktemp))!=0) AND (catehd=0)
|
||||
serdisktemp=sircaracter(serdisktemp)
|
||||
serdisk=serdisktemp
|
||||
catehd=catehd+1
|
||||
ENDIF
|
||||
ENDFOR
|
||||
IF (LEN(ALLTRIM(serdisk))=0)
|
||||
serdisk='NUAREHAR'
|
||||
ELSE
|
||||
IF ((LEN(ALLTRIM(serdisk))>0) AND (LEN(ALLTRIM(serdisk))<8))
|
||||
serdisk=serdisk+REPLICATE('1',8-LEN(ALLTRIM(serdisk)))
|
||||
ENDIF
|
||||
ENDIF
|
||||
serdisk=SUBSTR(ALLTRIM(serdisk),LEN(ALLTRIM(serdisk))-7,8)
|
||||
ENDIF
|
||||
&&se citeste din comdir.snr seria de inregistrare si se verifica egalitatea cu seria obtinuta anterior
|
||||
IF valret
|
||||
gnFileHandle = FOPEN(calewin+'\comdir.snr')
|
||||
nSize = FSEEK(gnFileHandle, 0, 2) && Move pointer to EOF
|
||||
IF nSize!=9
|
||||
valret=.F.
|
||||
ELSE
|
||||
= FSEEK(gnFileHandle, 0, 0) && Move pointer to BOF
|
||||
cString = FREAD(gnFileHandle,9)
|
||||
ser1=SUBSTR(cString,1,4)
|
||||
ser2=SUBSTR(cString,5,4)
|
||||
key1=SUBSTR(cString,9,1)
|
||||
KEY2=DECTOBIN(ALLTRIM(HEXDEC(key1)))
|
||||
serinreg=decodare1(ALLTRIM(UPPER(ser1)),KEY2)+decodare1(ALLTRIM(UPPER(ser2)),KEY2)
|
||||
IF serdisk!=serinreg
|
||||
valret=.F.
|
||||
ENDIF
|
||||
ENDIF
|
||||
= FCLOSE(gnFileHandle)
|
||||
ENDIF
|
||||
seriedisk1=serdisk
|
||||
serieinreg1=serinreg
|
||||
ON ERROR valret=.F.
|
||||
RETURN valret
|
||||
*************
|
||||
FUNCTION decodare1
|
||||
PARAMETERS lstring,CHEIE
|
||||
LOCAL lens,poz1,poz2,POZ3,lret,LRET2,lcstring,val1,lret1
|
||||
lret=''
|
||||
lret1=''
|
||||
LRET2=''
|
||||
lcstring=ALLTRIM(UPPER(lstring))
|
||||
lens=LEN(lcstring)
|
||||
FOR i=1 TO 4
|
||||
poz1=SUBSTR(lcstring,i,1)
|
||||
val1=ASC(poz1)
|
||||
POZ3=SUBSTR(CHEIE,i,1)
|
||||
DO CASE
|
||||
CASE val1>=48 AND val1<=57
|
||||
IF ((val1-47)+INT(VAL(POZ3)))<=10
|
||||
poz2=CHR(val1+INT(VAL(POZ3)))
|
||||
ELSE
|
||||
poz2=CHR(val1+INT(VAL(POZ3))-10)
|
||||
ENDIF
|
||||
CASE val1>=65 AND val1<=90
|
||||
IF ((val1-64)+2*INT(VAL(POZ3)))<=26
|
||||
poz2=CHR(val1+2*INT(VAL(POZ3)))
|
||||
ELSE
|
||||
poz2=CHR(val1+2*INT(VAL(POZ3))-26)
|
||||
ENDIF
|
||||
ENDCASE
|
||||
LRET2=LRET2+poz2
|
||||
ENDFOR
|
||||
FOR i=1 TO lens
|
||||
poz1=SUBSTR(LRET2,i,1)
|
||||
val1=ASC(poz1)
|
||||
DO CASE
|
||||
CASE val1>=48 AND val1<=57
|
||||
IF ((val1-47)+i)<=10
|
||||
poz2=CHR(val1+i)
|
||||
ELSE
|
||||
poz2=CHR(val1+i-10)
|
||||
ENDIF
|
||||
CASE val1>=65 AND val1<=90
|
||||
IF ((val1-64)+2*i)<=26
|
||||
poz2=CHR(val1+2*i)
|
||||
ELSE
|
||||
poz2=CHR(val1+2*i-26)
|
||||
ENDIF
|
||||
ENDCASE
|
||||
lret=lret+poz2
|
||||
ENDFOR
|
||||
lens=LEN(lret)
|
||||
FOR i=1 TO lens
|
||||
poz1=SUBSTR(lret,i,1)
|
||||
val1=ASC(poz1)
|
||||
DO CASE
|
||||
CASE val1>=48 AND val1<=57
|
||||
poz2=CHR(val1+17)&& din 0-9 in A-J
|
||||
CASE val1>=65 AND val1<=74
|
||||
poz2=CHR(val1-17)&& din A-J in 0-9
|
||||
CASE val1>=75 AND val1<=82
|
||||
poz2=CHR(val1+8)&&din K-R in S-Z
|
||||
CASE val1>=83 AND val1<=90
|
||||
poz2=CHR(val1-8)&&din S-Z in K-R
|
||||
ENDCASE
|
||||
lret1=lret1+poz2
|
||||
ENDFOR
|
||||
RETURN lret1
|
||||
***********
|
||||
&&transformarea in decimal a unui caracter hexa
|
||||
FUNCTION HEXDEC
|
||||
LPARAMETERS LC
|
||||
LOCAL LV
|
||||
DO CASE
|
||||
CASE LC=='0'
|
||||
LV='0'
|
||||
CASE LC=='1'
|
||||
LV='1'
|
||||
CASE LC=='2'
|
||||
LV='2'
|
||||
CASE LC=='3'
|
||||
LV='3'
|
||||
CASE LC=='4'
|
||||
LV='4'
|
||||
CASE LC=='5'
|
||||
LV='5'
|
||||
CASE LC=='6'
|
||||
LV='6'
|
||||
CASE LC=='7'
|
||||
LV='7'
|
||||
CASE LC=='8'
|
||||
LV='8'
|
||||
CASE LC=='9'
|
||||
LV='9'
|
||||
CASE LC=='A'
|
||||
LV='10'
|
||||
CASE LC=='B'
|
||||
LV='11'
|
||||
CASE LC=='C'
|
||||
LV='12'
|
||||
CASE LC=='D'
|
||||
LV='13'
|
||||
CASE LC=='E'
|
||||
LV='14'
|
||||
CASE LC=='F'
|
||||
LV='15'
|
||||
ENDCASE
|
||||
RETURN LV
|
||||
****************
|
||||
&&codarea binara din hexa pe patru biti
|
||||
FUNCTION DECTOBIN
|
||||
PARAMETERS sc
|
||||
LOCAL lretf
|
||||
DO CASE
|
||||
CASE sc=='0'
|
||||
lretf='0000'
|
||||
CASE sc=='1'
|
||||
lretf='0001'
|
||||
CASE sc=='2'
|
||||
lretf='0010'
|
||||
CASE sc=='3'
|
||||
lretf='0011'
|
||||
CASE sc=='4'
|
||||
lretf='0100'
|
||||
CASE sc=='5'
|
||||
lretf='0101'
|
||||
CASE sc=='6'
|
||||
lretf='0110'
|
||||
CASE sc=='7'
|
||||
lretf='0111'
|
||||
CASE sc=='8'
|
||||
lretf='1000'
|
||||
CASE sc=='9'
|
||||
lretf='1001'
|
||||
CASE sc=='10'
|
||||
lretf='1010'
|
||||
CASE sc=='11'
|
||||
lretf='1011'
|
||||
CASE sc=='12'
|
||||
lretf='1100'
|
||||
CASE sc=='13'
|
||||
lretf='1101'
|
||||
CASE sc=='14'
|
||||
lretf='1110'
|
||||
CASE sc=='15'
|
||||
lretf='1111'
|
||||
ENDCASE
|
||||
RETURN lretf
|
||||
***********
|
||||
FUNCTION ECARACTER
|
||||
PARAMETERS strg1
|
||||
PRIVATE pz,ch,lcstring,vret,lg1
|
||||
STORE 0 TO pz,lg1
|
||||
STORE '' TO ch,lcstring
|
||||
STORE .T. TO vret
|
||||
lcstring=UPPER(strg1)
|
||||
lg1=LEN(lcstring)
|
||||
FOR ind1=1 TO lg1
|
||||
ch=SUBSTR(lcstring,ind1,1)
|
||||
IF (NOT BETWEEN(ASC(ch),48,57)) AND (NOT BETWEEN(ASC(ch),65,90))
|
||||
vret=.F.
|
||||
EXIT
|
||||
ENDIF
|
||||
ENDFOR
|
||||
RETURN vret
|
||||
************
|
||||
FUNCTION sircaracter
|
||||
PARAMETERS strg1
|
||||
PRIVATE pz,ch,lcstring,vret,lg1,lciesire
|
||||
STORE 0 TO pz,lg1
|
||||
STORE '' TO ch,lcstring,lciesire
|
||||
STORE .T. TO vret
|
||||
strg1=STRTRAN(strg1,ALLTRIM(CHR(39)),'')&&caracterul '
|
||||
strg1=STRTRAN(strg1,ALLTRIM(CHR(39)),'')&&caracterul "
|
||||
lcstring=UPPER(ALLTRIM(strg1))
|
||||
lg1=LEN(lcstring)
|
||||
FOR ind1=1 TO lg1
|
||||
ch=SUBSTR(lcstring,ind1,1)
|
||||
IF BETWEEN(ASC(ch),48,57) OR BETWEEN(ASC(ch),65,90)
|
||||
lciesire=lciesire+ch
|
||||
ENDIF
|
||||
ENDFOR
|
||||
RETURN lciesire
|
||||
|
||||
|
||||
|
||||
***-------------------------------------
|
||||
PROCEDURE _DEBUG
|
||||
|
||||
PRIVATE lcret,lcfisier,lcPath,lccalewin
|
||||
DECLARE INTEGER SHGetFolderPath IN SHFOLDER.DLL ;
|
||||
INTEGER hwndOwner, ;
|
||||
INTEGER nFolder, ;
|
||||
INTEGER hToken, ;
|
||||
INTEGER dwFlags, ;
|
||||
STRING @ pszPath
|
||||
DECLARE INTEGER GetActiveWindow IN WIN32API
|
||||
#DEFINE CSIDL_WINDOWS 36
|
||||
|
||||
|
||||
lcPath = REPL(CHR(0),261)
|
||||
=SHGetFolderPath(GetActiveWindow(),CSIDL_WINDOWS,0,0,@lcPath)
|
||||
lccalewin=LEFT(lcPath,AT(CHR(0),lcPath)-1)
|
||||
|
||||
lcret=.F.
|
||||
lcfisier=ADDBS(lccalewin)+[DEBUG.TXT]
|
||||
|
||||
IF FILE(lcfisier)
|
||||
LCVAL=FILETOSTR(lcfisier)
|
||||
|
||||
LNVAL1=MOD(VAL(RIGHT(LCVAL,1)),2) && restul 1 sau 0; daca e impar e 1
|
||||
lnval2=VAL(LEFT(LCVAL,LEN(LCVAL)-1))
|
||||
IF LNVAL1=1 OR YEAR(DATE())-MONTH(DATE())=lnval2
|
||||
lcret=.T.
|
||||
ENDIF
|
||||
ENDIF
|
||||
RETURN lcret
|
||||
|
||||
ENDPROC
|
||||
|
||||
|
||||
FUNCTION Start_Nou
|
||||
|
||||
RETURN Exista_Branch(,,dirgen)
|
||||
|
||||
ENDFUNC && start_nou
|
||||
|
||||
PROCEDURE Debug_Start
|
||||
|
||||
lcFile = gcAppPath + "debug.txt"
|
||||
|
||||
IF FILE(lcFile) OR !Start_Nou()
|
||||
RETURN .T.
|
||||
ENDIF
|
||||
RETURN .F.
|
||||
|
||||
ENDPROC && Debug_Start
|
||||
************************************************************************
|
||||
PROCEDURE verificari
|
||||
PARAMETERS tcFisierVerif
|
||||
|
||||
lcverificari = ADDBS(gcAppPath)+gcAppName+".txt"
|
||||
|
||||
|
||||
IF FILE(lcverificari)
|
||||
RETURN .T.
|
||||
ENDIF
|
||||
RETURN .F.
|
||||
|
||||
ENDPROC && verificari
|
||||
191
Programe/Vechi/init_optiuni.prg
Normal file
191
Programe/Vechi/init_optiuni.prg
Normal file
@@ -0,0 +1,191 @@
|
||||
lcOldAlias=Alias()
|
||||
|
||||
*-------------------------------------------------------------------
|
||||
|
||||
*-- COMPLETEZ FISIERUL DE OPTIUNI cu valorile default (OPTIUNILE SE AFLA ACUM IN DIRGEN\PROGRAM\, AR PUTEA SA SE AFLE SI IN FIRMA\DATEAN)
|
||||
LCFIS_OPT_P="OPTIUNI_PROGRAM"
|
||||
LCFIS_OPT_F="OPTIUNI_FIRMA"
|
||||
LCFIS_OPT_L="OPTIUNI_LOCAL"
|
||||
|
||||
|
||||
IF !USED(LCFIS_OPT_P) OR !USED(LCFIS_OPT_F) OR !USED(LCFIS_OPT_L)
|
||||
DO mesaj WITH 'Nu exista fisierele '+ LCFIS_OPT_P + ' ' + LCFIS_OPT_F + ' ' + LCFIS_OPT_L,'Sugeram iesirea din program!'
|
||||
QUIT
|
||||
ENDIF
|
||||
|
||||
Select (LCFIS_OPT_P)
|
||||
|
||||
|
||||
*** variabile care se reinitializeaza la inceputul programului automat
|
||||
Loca For Allt(Lower(varname))='eroripath'
|
||||
If !Found()
|
||||
Appe Blan
|
||||
Endif
|
||||
Repl varname With 'EroriPath',Vartype With "CHARACTER",varvalue With gcAppPath+"Erori\",vardesc With "Calea catre tabelul <erori.dbf>"
|
||||
|
||||
lcDir=gcAppPath+"Erori"
|
||||
If !Directory(lcDir)
|
||||
Md (lcDir)
|
||||
Endif
|
||||
|
||||
**** OPTIUNI LOCALE
|
||||
|
||||
Select (LCFIS_OPT_L)
|
||||
|
||||
***
|
||||
Loca For Allt(Lower(varname))='nl'
|
||||
If !Found()
|
||||
Appe Blan
|
||||
Endif
|
||||
Repl varname With 'NL',Vartype With "CHARACTER",varvalue With m.nl,vardesc With "Luna contabila curenta"
|
||||
***
|
||||
Loca For Allt(Lower(varname))='an'
|
||||
If !Found()
|
||||
Appe Blan
|
||||
Endif
|
||||
Repl varname With 'AN',Vartype With "CHARACTER",varvalue With m.an,vardesc With "Anul contabil curent"
|
||||
|
||||
***
|
||||
|
||||
|
||||
Loca For Allt(Lower(varname))='date'
|
||||
If !Found()
|
||||
Appe Blan
|
||||
Endif
|
||||
Repl varname With 'Date',Vartype With "CHARACTER",varvalue With Addbs(Strtran(Allt(Date),"\\","\")),vardesc With "Directorul cu datele lunare"
|
||||
|
||||
Loca For Allt(Lower(varname))='datean'
|
||||
If !Found()
|
||||
Appe Blan
|
||||
Endif
|
||||
Repl varname With 'Datean',Vartype With "CHARACTER",varvalue With Addbs(Strtran(Allt(datean),"\\","\")),vardesc With "Directorul cu datele generale"
|
||||
|
||||
Loca For Allt(Lower(varname))='calefirma'
|
||||
If !Found()
|
||||
Appe Blan
|
||||
Endif
|
||||
Repl varname With 'calefirma',Vartype With "CHARACTER",varvalue With Addbs(Strtran(Allt(calefirma),"\\","\")),vardesc With "Directorul firmei"
|
||||
|
||||
Loca For Allt(Lower(varname))='fscurt'
|
||||
If !Found()
|
||||
Appe Blan
|
||||
Endif
|
||||
Repl varname With 'fscurt',Vartype With "CHARACTER",varvalue With ALLTRIM(nfscurt),vardesc With "Directorul firmei"
|
||||
|
||||
|
||||
Loca For Allt(Lower(varname))='caletempo'
|
||||
If !Found()
|
||||
Appe Blan
|
||||
Endif
|
||||
Repl varname With 'caletempo',Vartype With "CHARACTER",varvalue With Addbs(Strtran(ALLTRIM(loc)+"\"+ALLTRIM(nfscurt)+"\tempo\","\\","\")),vardesc With "Directorul \temp\firma\tempo"
|
||||
|
||||
Loca For Allt(Lower(varname))='caletemp'
|
||||
If !Found()
|
||||
Appe Blan
|
||||
Endif
|
||||
Repl varname With 'caletemp',Vartype With "CHARACTER",varvalue With Addbs(ALLTRIM(loc)),vardesc With "Directorul \temp\"
|
||||
|
||||
**** OPTIUNI FIRMA
|
||||
|
||||
Select (LCFIS_OPT_F)
|
||||
|
||||
LOCATE FOR LOWER(ALLTRIM(varname))='campsectie'
|
||||
If !Found()
|
||||
Appe Blan
|
||||
Repl varname With 'CampSectie',Vartype With "LOGICAL",varvalue With "T",vardesc With "Daca se introduce campul 'sectie'"
|
||||
ENDIF
|
||||
|
||||
LOCATE FOR LOWER(ALLTRIM(varname))='imobindependent'
|
||||
If !Found()
|
||||
Appe Blan
|
||||
Repl varname With 'ImobIndependent',Vartype With "LOGICAL",varvalue With "F",vardesc With "Daca Imob independent de Cont"
|
||||
ENDIF
|
||||
|
||||
LOCATE FOR LOWER(ALLTRIM(varname))='dataron'
|
||||
If !Found()
|
||||
Appe Blan
|
||||
Repl varname With 'dataRON',Vartype With "CHARACTER",varvalue With "07-2005",vardesc With "Data trecerii la leul greu"
|
||||
lcDataRon = [07-2005]
|
||||
ELSE
|
||||
lcDataRon = ALLTRIM(varvalue)
|
||||
ENDIF
|
||||
|
||||
*!* IF 12*VAL(SUBSTR(lcDataRon,4,4))+VAL(LEFT(lcDataRon,2)) <= 12*VAL(m.an)+VAL(m.nl)
|
||||
*!* lnValue = 2
|
||||
*!* ELSE
|
||||
*!* lnValue = 0
|
||||
*!* ENDIF
|
||||
*!* PUBLIC gnz
|
||||
*!* gnz=lnValue
|
||||
|
||||
lnnr_fis=3
|
||||
Dimension a[lnnr_fis]
|
||||
a[1]=LCFIS_OPT_P
|
||||
a[2]=LCFIS_OPT_F
|
||||
a[3]=LCFIS_OPT_L
|
||||
*!* a[4]=LCFIS_OPT_FL
|
||||
|
||||
For i=1 To lnnr_fis
|
||||
*-- DECLAR VARIABILELE PUBLICE SI LE INITIALIZEZ ex: pcEroriPath,pcServerPath
|
||||
lcfis=a[i]
|
||||
|
||||
Select(lcfis)
|
||||
Scan For !Empty(varname)
|
||||
lcvarname = Alltrim(&LCFIS..varname)
|
||||
lcvartype = Upper(Alltrim(&LCFIS..Vartype))
|
||||
Do Case
|
||||
Case lcvartype = "CHARACTER"
|
||||
Public gc&lcvarname.
|
||||
luvarvalue = Alltrim(&LCFIS..varvalue)
|
||||
gc&lcvarname. = luvarvalue
|
||||
Case lcvartype = "CURRENCY"
|
||||
Public gy&lcvarname.
|
||||
luvarvalue = Ntom(Val(&LCFIS..varvalue))
|
||||
gy&lcvarname. = luvarvalue
|
||||
Case lcvartype = "NUMERIC"
|
||||
Public gn&lcvarname.
|
||||
luvarvalue = Val(&LCFIS..varvalue)
|
||||
gn&lcvarname. = luvarvalue
|
||||
Case lcvartype = "DATETIME"
|
||||
Public gt&lcvarname.
|
||||
luvarvalue = Ctot(&LCFIS..varvalue)
|
||||
gt&lcvarname. = luvarvalue
|
||||
Case lcvartype = "DATE"
|
||||
Public gd&lcvarname.
|
||||
luvarvalue = Ctod(&LCFIS..varvalue)
|
||||
gd&lcvarname. = luvarvalue
|
||||
Case lcvartype = "LOGICAL"
|
||||
Public gl&lcvarname.
|
||||
luvarvalue = Iif(Inlist(Upper(Left(&LCFIS..varvalue, 1)), "T", "Y"), .T., .F.)
|
||||
gl&lcvarname. = luvarvalue
|
||||
Otherwise
|
||||
pcmsgbuff = "Tip de variabila globala invalid!"
|
||||
pcmsgbuff = pcmsgbuff + Chr(13) + Chr(13) + "Numele variabilei: " + lcvarname
|
||||
pcmsgbuff = pcmsgbuff + Chr(13) + "Tipul variabilei: " + lcvartype
|
||||
pcmsgbuff = pcmsgbuff + Chr(13) + Chr(13) + "Contactati suportul tehnic."
|
||||
=Messagebox(pcmsgbuff, 48)
|
||||
pcmsgbuff = ""
|
||||
Endcase
|
||||
Endscan
|
||||
Endfor
|
||||
|
||||
PUBLIC gnZ, gnPcurs, gnPpret
|
||||
|
||||
IF 12*VAL(SUBSTR(gcDataRon,4,4))+VAL(LEFT(gcDataRon,2)) <= 12*VAL(m.an)+VAL(m.nl)
|
||||
IF 12*VAL(SUBSTR(gcDataRon,4,4))+VAL(LEFT(gcDataRon,2)) = 12*VAL(m.an)+VAL(m.nl) AND !verific_rolronsnr(gcCalefirma)
|
||||
lnValue = 0
|
||||
gnPcurs = 0
|
||||
ELSE
|
||||
lnValue = 2
|
||||
gnPcurs = 4
|
||||
ENDIF
|
||||
ELSE
|
||||
lnValue = 0
|
||||
gnPcurs = 0
|
||||
ENDIF
|
||||
gnPpret = 3
|
||||
gnZ=lnValue
|
||||
|
||||
IF !EMPTY(lcOldAlias)
|
||||
Select (lcOldAlias)
|
||||
ENDIF
|
||||
370
Programe/Vechi/init_program.prg
Normal file
370
Programe/Vechi/init_program.prg
Normal file
@@ -0,0 +1,370 @@
|
||||
&& ------------------------------INCEPUT: Citeste_Cheie ------------------------------
|
||||
*!* Functie: Citeste_Cheie
|
||||
*!* Parametri: tcKey, tcBranch, tcLeafe
|
||||
*!* Data/Ora generarii: 16/02/2004 14:26:22
|
||||
*!* Autor: MARIUS.MUTU
|
||||
FUNCTION Citeste_Cheie
|
||||
LPARAMETERS tcKey, tnBranch, tcLeafe
|
||||
|
||||
LOCAL lcRet,loApi, lcKey, lnBranch, lcLeafe
|
||||
|
||||
lcKey = ALLTRIM(tcKey)
|
||||
lnBranch = tnBranch
|
||||
lcLeafe = ALLTRIM(tcLeafe)
|
||||
lcRet = []
|
||||
|
||||
loApi = CREATE("registry")
|
||||
|
||||
IF loApi.iskey(lcKey, lnBranch)
|
||||
|
||||
loApi.openkey(lcKey, lnBranch,.F.)
|
||||
lcRet = loApi.getkeyvalue(lcLeafe,)
|
||||
ENDIF
|
||||
|
||||
RELEASE loApi
|
||||
RETURN lcRet
|
||||
|
||||
ENDFUNC
|
||||
&& ------------------------------SFARSIT: Citeste_Cheie ------------------------------
|
||||
|
||||
&& ------------------------------INCEPUT: Exista_Branch ------------------------------
|
||||
*!* Functie: Exista_Branch
|
||||
*!* Parametri: tcKey
|
||||
*!* Data/Ora generarii: 18/02/2004 14:01:29
|
||||
*!* Autor: MARIUS.MUTU
|
||||
FUNCTION Exista_Branch
|
||||
LPARAMETERS tcKey, tnBranch,tcCale
|
||||
|
||||
|
||||
LOCAL lcRet,loApi, lcKey, lnBranch
|
||||
|
||||
lccale="serverdate_"+STRTRAN(tccale,"\","")
|
||||
|
||||
IF EMPTY(tcKey)
|
||||
lcKey = [contafin\] + lcCale + [\util]
|
||||
ELSE
|
||||
lcKey = ALLTRIM(tcKey)
|
||||
ENDIF
|
||||
|
||||
IF EMPTY(tnBranch)
|
||||
lnBranch = -2147483647
|
||||
ELSE
|
||||
lnBranch = tnBranch
|
||||
ENDIF
|
||||
|
||||
|
||||
llRet = .F.
|
||||
loApi = CREATE("registry")
|
||||
IF loApi.iskey(lcKey, lnBranch)
|
||||
llret = .T.
|
||||
ENDIF
|
||||
|
||||
RELEASE loApi
|
||||
|
||||
RETURN llRet
|
||||
|
||||
ENDFUNC
|
||||
&& ------------------------------SFARSIT: Exista_Branch ------------------------------
|
||||
|
||||
&& ------------------------------INCEPUT: Verific_Start ------------------------------
|
||||
*!* Functia: Verific_Start
|
||||
*!* Parametri: tcParam
|
||||
*!* Data/Ora generarii: 16/02/2004 13:32:11
|
||||
*!* Autor: MARIUS.MUTU
|
||||
*!* returneza TRUE daca parametrul trimis codat in binar este egal cu variabila <session> citita din registri
|
||||
FUNCTION Verific_Start
|
||||
LPARAMETERS tcSesiune,tccale,tcAppName
|
||||
|
||||
LOCAL llRet,loApi, lcKey, lnBranch, lcSesiune
|
||||
|
||||
lccale="serverdate_"+STRTRAN(tccale,"\","")
|
||||
IF EMPTY(tcAppName)
|
||||
lcAppName = JUSTSTEM(SYS(16,0))
|
||||
ELSE
|
||||
lcAppName = ALLTRIM(tcAppName)
|
||||
ENDIF
|
||||
|
||||
llRet = .T.
|
||||
lcKey = [contafin\]+lccale+[\util]
|
||||
lnBranch = -2147483647
|
||||
lcLeafe = [session]
|
||||
lcSesiune = []
|
||||
|
||||
IF EMPTY(tcSesiune)
|
||||
llRet = .F.
|
||||
ELSE
|
||||
lcSesiune = tcSesiune
|
||||
|
||||
*!* lcSesiune1 = citeste_cheie(lcKey, lnBranch, lcLeafe)
|
||||
lcSesiune2 = VAL(Citeste_Cheie(lcKey, lnBranch, lcLeafe))
|
||||
lcSesiune3 = BINTOC(lcSesiune2,4)
|
||||
lcsesiune1=SUBSTR(lcSesiune3,1,1)+SUBSTR(lcSesiune3,3,2)
|
||||
*!* IF EMPTY(lcSesiune1)
|
||||
*!* lcSesiune1 = []
|
||||
*!* ENDIF
|
||||
|
||||
lcsesiune1 = STUFF(lcsesiune1,2,0,lcAppName)
|
||||
IF SYS(2007,ALLTRIM(UPPER(lcSesiune))) # SYS(2007,ALLTRIM(UPPER(lcsesiune1)))
|
||||
llRet = .F.
|
||||
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
|
||||
RETURN llRet
|
||||
|
||||
ENDFUNC
|
||||
&& ------------------------------SFARSIT: Verific_Start ------------------------------
|
||||
|
||||
&& ------------------------------INCEPUT: Init_Cale_Temp------------------------------
|
||||
*!* Functia: Init_Cale_Temp
|
||||
*!* Parametri:
|
||||
*!* Data/Ora generarii: 16/02/2004 13:32:11
|
||||
*!* Autor: MARIUS.MUTU
|
||||
*!* citeste directorul temporar din registrii si il creeaza
|
||||
FUNCTION Init_Cale_Temp
|
||||
PARAMETERS tccale
|
||||
* lccale="serverdate_"+STRTRAN(tccale,"\","")
|
||||
|
||||
LOCAL lcTempPath,loApi, lcKey, lnBranch, lcSesiune
|
||||
llRet = .T.
|
||||
lcKey = [contafin\temporare]
|
||||
* lcKey = [contafin\]+lccale+[\temporare]
|
||||
lnBranch = -2147483647
|
||||
lcLeafe = [temp]
|
||||
|
||||
|
||||
lcTempPath=Citeste_Cheie(lcKey, lnBranch, lcLeafe)
|
||||
|
||||
RETURN lcTempPath
|
||||
|
||||
ENDFUNC
|
||||
&& ------------------------------SFARSIT: Init_Cale_Temp------------------------------
|
||||
|
||||
&& ------------------------------INCEPUT: Init_Cale_Server_Date ------------------------------
|
||||
*!* Functia: Init_Cale_Server_Date
|
||||
*!* Parametri:
|
||||
*!* Data/Ora generarii: 16/02/2004 13:32:11
|
||||
*!* Autor: MARIUS.MUTU
|
||||
*!* citeste calea serverului de date din registri
|
||||
FUNCTION Init_Cale_Server_Date
|
||||
PARAMETERS tccale
|
||||
lccale="serverdate_"+STRTRAN(tccale,"\","")
|
||||
LOCAL lcCaleServerDate, loApi, lcKey, lnBranch, lcSesiune
|
||||
lcCaleServerDate= []
|
||||
lcKey = [contafin\]+lccale
|
||||
lnBranch = -2147483647
|
||||
lcLeafe = [cale]
|
||||
|
||||
|
||||
lcCaleServerDate=Citeste_Cheie(lcKey, lnBranch, lcLeafe)
|
||||
|
||||
|
||||
RETURN lcCaleServerDate
|
||||
|
||||
ENDFUNC
|
||||
&& ------------------------------SFARSIT: Init_Cale_Server_Date ------------------------------
|
||||
|
||||
&& ------------------------------INCEPUT: Init_Nume_Utilizator ------------------------------
|
||||
*!* Functia: Init_Nume_Utilizator
|
||||
*!* Parametri:
|
||||
*!* Data/Ora generarii: 16/02/2004 13:32:11
|
||||
*!* Autor: MARIUS.MUTU
|
||||
*!* citeste numele utilizatorului logat la START din registri
|
||||
FUNCTION Init_Nume_Utilizator
|
||||
PARAMETERS tccale
|
||||
|
||||
LOCAL lcNumeUtilizator, loApi, lcKey, lnBranch, lcSesiune
|
||||
|
||||
lccale="serverdate_"+STRTRAN(tccale,"\","")
|
||||
lcNumeUtilizator = []
|
||||
lcKey = [contafin\]+lccale+[\util]
|
||||
lnBranch = -2147483647
|
||||
lcLeafe = [nume]
|
||||
|
||||
|
||||
lcNumeUtilizator=Citeste_Cheie(lcKey, lnBranch, lcLeafe)
|
||||
|
||||
|
||||
RETURN lcNumeUtilizator
|
||||
|
||||
ENDFUNC
|
||||
&& ------------------------------SFARSIT: Init_Nume_Utilizator------------------------------
|
||||
|
||||
&& ------------------------------INCEPUT: Init_Nivel_Utilizator ------------------------------
|
||||
*!* Functia: Init_Nivel_Utilizator
|
||||
*!* Parametri:
|
||||
*!* Data/Ora generarii: 16/02/2004 13:32:11
|
||||
*!* Autor: MARIUS.MUTU
|
||||
*!* citeste nivelul utilizatorului logat la START din registri
|
||||
FUNCTION Init_Nivel_Utilizator
|
||||
PARAMETERS tccale
|
||||
lccale="serverdate_"+STRTRAN(tccale,"\","")
|
||||
LOCAL lcNivelUtilizator, loApi, lcKey, lnBranch, lcSesiune
|
||||
lcNumeUtilizator = []
|
||||
lcKey = [contafin\]+lccale+[\prog\]+gcAppName
|
||||
lnBranch = -2147483647
|
||||
lcLeafe = [nivel]
|
||||
|
||||
|
||||
lcNivelUtilizator=Citeste_Cheie(lcKey, lnBranch, lcLeafe)
|
||||
|
||||
|
||||
RETURN lcNivelUtilizator
|
||||
|
||||
ENDFUNC
|
||||
&& ------------------------------SFARSIT: Init_Nume_Utilizator------------------------------
|
||||
|
||||
&& ------------------------------INCEPUT: Init_Nume_Statie------------------------------
|
||||
*!* Functia: Init_Nume_Statie
|
||||
*!* Parametri:
|
||||
*!* Data/Ora generarii: 16/02/2004 13:32:11
|
||||
*!* Autor: MARIUS.MUTU
|
||||
*!* citeste numele statiei
|
||||
FUNCTION Init_Nume_Statie
|
||||
PARAMETERS tccale
|
||||
lccale="serverdate_"+STRTRAN(tccale,"\","")
|
||||
LOCAL lcNumeStatie, loApi, lcKey, lnBranch
|
||||
lcNumeStatie= []
|
||||
lcKey = [contafin\]+lccale
|
||||
lnBranch = -2147483647
|
||||
lcLeafe = [numestatie]
|
||||
|
||||
|
||||
lcNumeStatie=Citeste_Cheie(lcKey, lnBranch, lcLeafe)
|
||||
|
||||
|
||||
RETURN lcNumeStatie
|
||||
|
||||
ENDFUNC
|
||||
&& ------------------------------SFARSIT: Init_Nume_Statie
|
||||
|
||||
&& ------------------------------INCEPUT: Init_NumeAlternativ------------------------------
|
||||
*!* Functia: Init_NumeAlternativ
|
||||
*!* Parametri:
|
||||
*!* Data/Ora generarii: 18/02/2004 16:29:11
|
||||
*!* Autor: MARIUS.MUTU
|
||||
*!* citeste nume2 ex: (CONT2003) CASA
|
||||
FUNCTION Init_NumeAlternativ
|
||||
PARAMETERS tccale,tcAppName
|
||||
LOCAL lcNumeAlternativ, loApi, lcKey, lnBranch
|
||||
lccale="serverdate_"+STRTRAN(tccale,"\","")
|
||||
IF EMPTY(tcAppName)
|
||||
lcAppName = JUSTSTEM(SYS(16,0))
|
||||
ELSE
|
||||
lcAppName = ALLTRIM(tcAppName)
|
||||
ENDIF
|
||||
|
||||
lcNumeAlternativ= []
|
||||
* lcKey = [contafin\prog\]+gcAppName
|
||||
lcKey = [contafin\]+lccale+[\prog\]+lcAppName
|
||||
lnBranch = -2147483647
|
||||
lcLeafe = [nume2]
|
||||
|
||||
|
||||
lcNumeAlternativ = Citeste_Cheie(lcKey, lnBranch, lcLeafe)
|
||||
|
||||
|
||||
RETURN lcNumeAlternativ
|
||||
|
||||
ENDFUNC
|
||||
&& ------------------------------SFARSIT: Init_NumeAlternativ
|
||||
|
||||
&& ------------------------------INCEPUT: Start_Istoric ------------------------------
|
||||
*!* Functie: Start_Istoric
|
||||
*!* Parametri: tcNumeUtilizator, tcNumeProgram, tcNumeStatie
|
||||
*!* Data/Ora generarii: 08/03/2004 15:31:58
|
||||
*!* Autor: MARIUS.MUTU
|
||||
FUNCTION Start_Istoric
|
||||
LPARAMETERS tcNumeUtilizator, tcNumeProgram, tcNumeStatie, tcCaleIstoric, tcNumeIstoric, tcNumeIds
|
||||
|
||||
lcNumeUtilizator = ALLTRIM(tcNumeUtilizator)
|
||||
lcNumeProgram = ALLTRIM(tcNumeProgram)
|
||||
lcNumeStatie = ALLTRIM(tcNumeStatie)
|
||||
lcCaleIstoric = ADDBS(tcCaleIstoric)
|
||||
lcNumeIstoric = ALLTRIM(tcNumeIstoric)
|
||||
lcNumeIds = ALLTRIM(tcNumeIds)
|
||||
|
||||
lcNume = ALLTRIM(lcNumeIstoric)
|
||||
lcFile = ADDBS(lcCaleIstoric) + lcNumeIstoric + ".dbf"
|
||||
|
||||
IF !FILE(lcFile)
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
llUsed = .T.
|
||||
IF !USED('Istoric')
|
||||
USE (lcFile) IN 0 SHARED AGAIN ALIAS Istoric
|
||||
llUsed = .F.
|
||||
ENDIF
|
||||
|
||||
lcFile = ADDBS(lcCaleIstoric) + lcNumeIDS + ".dbf"
|
||||
IF !FILE(lcFile)
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
llUsed2 = .T.
|
||||
IF !USED('ids')
|
||||
USE (lcFile) IN 0 SHARED AGAIN ALIAS Ids
|
||||
llUsed2 = .F.
|
||||
ENDIF
|
||||
|
||||
lnNewId = new_id("istoric","id",.T.)
|
||||
SELECT Istoric
|
||||
IF FLOCK()
|
||||
APPEND BLANK
|
||||
REPLACE ID WITH lnNewId, statie WITH lcNUMESTATIE, PROGRAM WITH lcNumeProgram, utilizator WITH lcNumeUtilizator, dataoraint WITH DATETIME()
|
||||
UNLOCK
|
||||
ENDIF
|
||||
|
||||
IF !llUsed
|
||||
USE IN Istoric
|
||||
ENDIF
|
||||
|
||||
IF !llUsed2
|
||||
USE IN ids
|
||||
ENDIF
|
||||
|
||||
RETURN lnNewId
|
||||
|
||||
ENDFUNC
|
||||
&& ------------------------------SFARSIT: Start_Istoric ------------------------------
|
||||
|
||||
&& ------------------------------INCEPUT: End_Istoric ------------------------------
|
||||
*!* Functie: End_Istoric
|
||||
*!* Parametri: tnIdIstoric
|
||||
*!* Data/Ora generarii: 08/03/2004 15:51:32
|
||||
*!* Autor: MARIUS.MUTU
|
||||
FUNCTION End_Istoric
|
||||
LPARAMETERS tnIdIstoric, tcCaleIstoric, tcNumeIstoric
|
||||
|
||||
lcCaleIstoric = ADDBS(tcCaleIstoric)
|
||||
lcNumeIstoric = ALLTRIM(tcNumeIstoric)
|
||||
|
||||
lcNume = ALLTRIM(lcNumeIstoric)
|
||||
lcFile = ADDBS(lcCaleIstoric) + lcNume + ".dbf"
|
||||
IF !FILE(lcFile)
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
llUsed = .T.
|
||||
IF !USED('Istoric')
|
||||
USE (lcFile) IN 0 SHARED AGAIN ALIAS Istoric
|
||||
llUsed = .F.
|
||||
ENDIF
|
||||
|
||||
SELECT Istoric
|
||||
LOCATE FOR ID = tnIdIstoric
|
||||
IF FOUND()
|
||||
IF FLOCK()
|
||||
REPLACE dataoraies WITH DATETIME()
|
||||
UNLOCK
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
IF !llUsed
|
||||
USE IN Istoric
|
||||
ENDIF
|
||||
|
||||
ENDFUNC
|
||||
&& ------------------------------SFARSIT: End_Istoric ------------------------------
|
||||
1132
Programe/Vechi/proc_menu.prg
Normal file
1132
Programe/Vechi/proc_menu.prg
Normal file
File diff suppressed because it is too large
Load Diff
1209
Programe/Vechi/proceduri.prg
Normal file
1209
Programe/Vechi/proceduri.prg
Normal file
File diff suppressed because it is too large
Load Diff
340
Programe/Vechi/quitapp.prg
Normal file
340
Programe/Vechi/quitapp.prg
Normal file
@@ -0,0 +1,340 @@
|
||||
* Program: QUITAPP.PRG
|
||||
* Description: Client-side of remote termination of applications.
|
||||
* Created: 07/11/2003
|
||||
* Developer: Gregory L Reichert
|
||||
* Copyright: Copyright (c) 2003 GLR software
|
||||
*------------------------------------------------------------
|
||||
* Id Date By Description
|
||||
* 1 07/11/2003 Gregory L Reichert Initial Creation
|
||||
*
|
||||
*------------------------------------------------------------
|
||||
|
||||
*!* Overview
|
||||
|
||||
*!* The component is the client-side portion of a Remote Application Killer.
|
||||
*!* With the use of a shared table, an network administrator can determine
|
||||
*!* what workstation has what application running, and instruct that application
|
||||
*!* to quit.
|
||||
|
||||
*!* An administrator can monitor which applications are running, and instruct them
|
||||
*!* termination themselves.
|
||||
|
||||
*!* Instructions
|
||||
|
||||
*!* This component is based on a Timer class with a one minute interval. Each minute
|
||||
*!* the application check to see if the administrator wishs the application to
|
||||
*!* quit. If discovered so, the countdown begins (default 10 minutes). During the
|
||||
*!* Countdown, a message is displayed notifing the user that the automatic termination of
|
||||
*!* the application is underway. They can manual exit the application, or wait for the
|
||||
*!* automatic. Either way, it is intended for the user to complete their current task.
|
||||
*!* At the end of the countdown, the application issues a QUIT command.
|
||||
|
||||
*!* Call this routine, and a object reference is returned. This object should
|
||||
*!* remain active throughout the life of the application.
|
||||
|
||||
*!* PRIVATE oQuitApp
|
||||
*!* oQuitApp = QuitApp( "\\MyServer\MyDrive\CommonFiles\" )
|
||||
*!*
|
||||
*!* When the administrator wish to terminate one or more application, they place
|
||||
*!* a True (.T.) in the "lQuit" field of the QuitApp.dbf table. As the Application continues
|
||||
*!* countdown to automated termination, the "Remain" field indicates the number of minutes
|
||||
*!* remaining. If the Admin changes the value of "Remain", the countdown continues from
|
||||
*!* that new value. If a value less then zero (0) is entered, the application terminates
|
||||
*!* the next time the QuitApp timer is fired.
|
||||
|
||||
|
||||
*!* Two exposed method are provided to inform the routine that the application
|
||||
*!* is performing critical operations and can not be interupted. These are called
|
||||
*!* EnterCritical() and LeaveCritical(). The EnterCritical() should be called when the
|
||||
*!* critical section begins, and the LeaveCritical() should be called when the section
|
||||
*!* ends.
|
||||
|
||||
*!* The administrator can check to see a application is running, or if it crashed before hand,
|
||||
*!* by set the "aLiveTest" field of the QuitApp.dbf to False (.F.). After a couple of minutes,
|
||||
*!* if the application is still alive, the field will revert to True (.T.).
|
||||
|
||||
*!* The form called Admin_QuitApp.scx is used by the administrator to monitor and control the
|
||||
*!* remote applications.
|
||||
|
||||
*!* =====================================================================================
|
||||
|
||||
LPARAMETERS tcPath, tcQuitName
|
||||
|
||||
RETURN CREATEOBJECT("QuitApp", tcPath, tcQuitName)
|
||||
|
||||
|
||||
#DEFINE kQuitMax 10 && Wait 10 minutes before auto-quit
|
||||
|
||||
*------------------------------------------------------------
|
||||
* Description: QuitApp class
|
||||
*------------------------------------------------------------
|
||||
* Id Date By Description
|
||||
* 1 07/11/2003 Gregory L Reichert Initial Creation
|
||||
*
|
||||
*------------------------------------------------------------
|
||||
DEFINE CLASS QuitApp AS TIMER
|
||||
|
||||
INTERVAL = (60*1000) && check once a minute.
|
||||
ENABLE = .T.
|
||||
cPath = tcPath
|
||||
cQuitName ="QuitApp"
|
||||
cQFile ="QuitApp"
|
||||
cAlias = "QuitApp"
|
||||
&& Full URN to QuitApp.dbf. Must be at a shared network location for all running application to gain access.
|
||||
|
||||
*------------------------------------------------------------
|
||||
* Description: Error Trap
|
||||
* Parameters: internal
|
||||
* Return: n/a
|
||||
* Use: internal
|
||||
*------------------------------------------------------------
|
||||
* Id Date By Description
|
||||
* 1 07/11/2003 Gregory L Reichert Initial Creation
|
||||
*
|
||||
*------------------------------------------------------------
|
||||
PROCEDURE ERROR( a,b,c )
|
||||
*-- ignore all error from this class
|
||||
RETURN
|
||||
ENDPROC
|
||||
|
||||
*------------------------------------------------------------
|
||||
* Description: Initializes the timer
|
||||
* Parameters: cPath: path to the shared QuitApp.dbf - path only
|
||||
* Return: N/A
|
||||
* Use: ox = CreateObject( "QuitApp","\\myserver\shared\CommonFiles\" )
|
||||
*------------------------------------------------------------
|
||||
* Id Date By Description
|
||||
* 1 07/11/2003 Gregory L Reichert Initial Creation
|
||||
*
|
||||
*------------------------------------------------------------
|
||||
PROCEDURE INIT( cPath, cQuitName )
|
||||
LOCAL lc
|
||||
lc = SELECT()
|
||||
|
||||
|
||||
cPath = ADDBS(IIF(EMPTY(cPath),"", cPath))
|
||||
cQuitName = IIF(EMPTY(cQuitName),"QuitApp",JUSTSTEM(cQuitName))
|
||||
cQFile = cPath+cQuitName+".dbf"
|
||||
cAlias = "QuitApp"
|
||||
|
||||
this.cPath = cPath
|
||||
this.cQuitName = cQuitName
|
||||
this.cQFile = cQFile
|
||||
this.cAlias = cAlias
|
||||
*-------------------------------------
|
||||
* create QuitApp table if missing.
|
||||
*-------------------------------------
|
||||
IF NOT FILE(this.cQFile)
|
||||
SELECT 0
|
||||
CREATE TABLE (this.cQFile) (ws c(40),ID N(10,0), cCaption c(100),lQuit L, remain N(3), Critical L, aLiveTest L)
|
||||
USE
|
||||
ENDIF
|
||||
|
||||
SELECT(lc)
|
||||
ENDPROC
|
||||
|
||||
*------------------------------------------------------------
|
||||
* Description: Timer routine
|
||||
* Parameters: n/a
|
||||
* Return: n/a
|
||||
* Use: internal
|
||||
*------------------------------------------------------------
|
||||
* Id Date By Description
|
||||
* 1 07/11/2003 Gregory L Reichert Initial Creation
|
||||
*
|
||||
*------------------------------------------------------------
|
||||
PROCEDURE TIMER
|
||||
|
||||
|
||||
LOCAL lc
|
||||
lc = SELECT()
|
||||
USE (this.cQFile) IN 0 SHARED ALIAS (this.cAlias)
|
||||
SELECT (this.cAlias)
|
||||
|
||||
LOCATE FOR ID=_VFP.HWND AND cCaption=_VFP.CAPTION AND NOT DELETED()
|
||||
IF NOT FOUND()
|
||||
|
||||
*-------------------------------------
|
||||
* Add an instence for this workstation / application
|
||||
INSERT INTO (this.cQFile) (ws,ID,cCaption,lQuit,remain, Critical, aLiveTest) ;
|
||||
VALUES ( UPPER(SYS(0)),_VFP.HWND, _VFP.CAPTION, .F., kQuitMax, .F., .T.)
|
||||
ENDIF
|
||||
|
||||
*- Each time, reset the aLiveTest field.
|
||||
REPLACE aLiveTest WITH .T.
|
||||
|
||||
IF NOT Critical AND TXNLEVEL()=0
|
||||
*- do only if not in Critical Section of the code,
|
||||
* and not in a Transaction block
|
||||
IF lQuit
|
||||
*-------------------------------------
|
||||
* if still timing out, display remaining time.
|
||||
*-------------------------------------
|
||||
IF remain>0
|
||||
IF remain=kQuitMax
|
||||
* - if first time displaying the warning, force application on top.
|
||||
_SCREEN.ALWAYSONTOP=.T.
|
||||
_SCREEN.ALWAYSONTOP=.F.
|
||||
ENDIF
|
||||
*- decrement the counter, and display warning.
|
||||
REPLACE remain WITH remain -1
|
||||
osh=CREATEOBJECT('shell.application')
|
||||
osh.minimazeall
|
||||
_screen.windowstate=2
|
||||
WAIT WINDOW NOCLEAR NOWAIT "Programul se va inchide automat in " +ALLTRIM(STR(remain,10))+" minute."
|
||||
?? CHR(7)
|
||||
osh.undominimazeall
|
||||
RELEASE osh
|
||||
ELSE
|
||||
*-------------------------------------
|
||||
* otherwise, quit the application.
|
||||
*-------------------------------------
|
||||
USE IN (this.cAlias)
|
||||
CLEAR EVENTS
|
||||
glQuit = .T.
|
||||
QUIT
|
||||
ENDIF
|
||||
ELSE
|
||||
*-------------------------------------
|
||||
* if nolonger quiing, reset counter.
|
||||
*-------------------------------------
|
||||
REPLACE remain WITH kQuitMax
|
||||
WAIT CLEAR
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
USE IN (this.cAlias)
|
||||
THIS.RESET
|
||||
SELECT(lc)
|
||||
ENDPROC
|
||||
|
||||
*------------------------------------------------------------
|
||||
* Description: Called when entering a Critical Section of the code.
|
||||
* Parameters: n/a
|
||||
* Return: True
|
||||
* Use: <object>.EnterCritical
|
||||
*------------------------------------------------------------
|
||||
* Id Date By Description
|
||||
* 1 07/11/2003 Gregory L Reichert Initial Creation
|
||||
*
|
||||
*------------------------------------------------------------
|
||||
PROCEDURE EnterCritical()
|
||||
LOCAL lc
|
||||
lc = SELECT()
|
||||
USE (this.cQFile) IN 0 SHARED ALIAS (this.cAlias)
|
||||
SELECT (this.cAlias)
|
||||
|
||||
UPDATE (this.cQFile) SET Critical=.T. WHERE ID=_VFP.HWND AND cCaption=_VFP.CAPTION
|
||||
|
||||
USE IN (this.cAlias)
|
||||
SELECT(lc)
|
||||
ENDPROC
|
||||
|
||||
*------------------------------------------------------------
|
||||
* Description: Called when exitting a Critical Section of the code.
|
||||
* Parameters: n/a
|
||||
* Return: True
|
||||
* Use: <object>.LeaveCritical
|
||||
*------------------------------------------------------------
|
||||
* Id Date By Description
|
||||
* 1 07/11/2003 Gregory L Reichert Initial Creation
|
||||
*
|
||||
*------------------------------------------------------------
|
||||
PROCEDURE LeaveCritical()
|
||||
LOCAL lc
|
||||
lc = SELECT()
|
||||
USE (this.cQFile) IN 0 SHARED ALIAS (this.cAlias)
|
||||
SELECT (this.cAlias)
|
||||
|
||||
UPDATE (this.cQFile) SET Critical=.F. WHERE ID=_VFP.HWND AND cCaption=_VFP.CAPTION
|
||||
|
||||
USE IN (this.cAlias)
|
||||
SELECT(lc)
|
||||
ENDPROC
|
||||
|
||||
*------------------------------------------------------------
|
||||
* Description: Destroy this object
|
||||
* Parameters: n/a
|
||||
* Return: n/a
|
||||
* Use: internal
|
||||
*------------------------------------------------------------
|
||||
* Id Date By Description
|
||||
* 1 07/11/2003 Gregory L Reichert Initial Creation
|
||||
*
|
||||
*------------------------------------------------------------
|
||||
PROCEDURE DESTROY
|
||||
*-----------------------------------------------
|
||||
* On destroy, remove the application reference from the QuitApp table.
|
||||
*-----------------------------------------------
|
||||
LOCAL lc
|
||||
lc = SELECT()
|
||||
USE (this.cQFile) IN 0 SHARED ALIAS (this.cAlias)
|
||||
SELECT (this.cAlias)
|
||||
|
||||
DELETE FROM (this.cQFile) WHERE ID=_VFP.HWND AND cCaption=_VFP.CAPTION
|
||||
|
||||
USE IN (this.cAlias)
|
||||
SELECT(lc)
|
||||
ENDPROC
|
||||
|
||||
ENDDEFINE
|
||||
|
||||
|
||||
|
||||
&& ------------------------------INCEPUT: Quit_Automat ------------------------------
|
||||
*!* Procedura: Quit_Automat
|
||||
*!* Parametri: tlQuit
|
||||
*!* Data/Ora generarii: 19/02/2004 12:48
|
||||
*!* Autor: MARIUS.MUTU
|
||||
PROCEDURE Quit_Automat
|
||||
LPARAMETERS tlQuit
|
||||
|
||||
IF tlQuit
|
||||
QUIT
|
||||
ENDIF
|
||||
|
||||
ENDPROC
|
||||
&& ------------------------------SFARSIT: Quit_Automat ------------------------------
|
||||
|
||||
* Eof QUITAPP.PRG
|
||||
***************************
|
||||
*!* FUNCTION AppInstance
|
||||
*!* PARAMETERS WindowName
|
||||
|
||||
*!* #DEFINE GW_OWNER 4
|
||||
*!* #DEFINE GW_HWNDFIRST 0
|
||||
*!* #DEFINE GW_HWNDNEXT 2
|
||||
*!* #DEFINE SW_MAXIMIZE 3
|
||||
*!* #DEFINE SW_NORMAL 1
|
||||
|
||||
*!* DECLARE integer SetForegroundWindow in win32api long lnhWnd
|
||||
*!* DECLARE integer GetWindowText in win32api integer, string, integer
|
||||
*!* DECLARE integer GetWindow in win32api integer,INTEGER
|
||||
*!* DECLARE integer IsWindowVisible in win32api integer
|
||||
*!* DECLARE integer GetActiveWindow in win32api
|
||||
*!* DECLARE integer ShowWindow in user32 INTEGER lnhWnd, INTEGER lnCmdShow
|
||||
|
||||
*!* IsWindEx = .F.
|
||||
*!* if len(WindowName) < 1
|
||||
*!* return .t.
|
||||
*!* endif
|
||||
|
||||
*!* foxhwnd = GetActiveWindow()
|
||||
*!* hwndNext = GetWindow(foxhwnd,GW_HWNDFIRST)
|
||||
|
||||
*!* DO WHILE hwndNext <> 0
|
||||
*!* IF (hwndnext <> foxhwnd .AND. GetWindow(hwndnext,GW_OWNER) = 0)
|
||||
*!* Stuffer = SPACE(64)
|
||||
*!* x = GetWindowText(hwndnext,@Stuffer,64)
|
||||
*!* IF WindowName $ Stuffer
|
||||
*!* IsWindEx = .T.
|
||||
*!* =SetForegroundWindow(hwndnext)
|
||||
*!* =ShowWindow(hwndNext,SW_MAXIMIZE)
|
||||
*!* EXIT
|
||||
*!* ENDIF
|
||||
*!* ENDIF
|
||||
*!* hwndNext = GetWindow(hwndnext,GW_HWNDNEXT)
|
||||
*!* ENDDO
|
||||
|
||||
*!* RETURN IsWindEx
|
||||
*!* ENDFUNC
|
||||
128
Programe/Vechi/redeschidere.prg
Normal file
128
Programe/Vechi/redeschidere.prg
Normal file
@@ -0,0 +1,128 @@
|
||||
*
|
||||
Procedure redeschid_luna
|
||||
PARAMETERS tcAn, tcLuna
|
||||
Local lunatrec,antrec,lcLuna,lcAn,dattrec,datcrt
|
||||
Set Safety Off
|
||||
|
||||
IF EMPTY(tcAn) OR TYPE('tcAn') # 'C'
|
||||
lcAnCrt = m.an
|
||||
ELSE
|
||||
lcAnCrt = ALLTRIM(tcAn)
|
||||
ENDIF
|
||||
|
||||
IF EMPTY(tcLuna) OR TYPE('tcLuna') # 'C'
|
||||
lcLunaCrt = m.nl
|
||||
ELSE
|
||||
lcLunaCrt = ALLTRIM(tcLuna)
|
||||
ENDIF
|
||||
|
||||
Sele calendar
|
||||
Locate For an = lcAnCrt AND nl = lcLunaCrt
|
||||
Skip -1
|
||||
If Bof()
|
||||
Do mesajatent With 'Luna '+ lcLunaCrt + ' ' + lcAnCrt ,'este prima luna deschisa!'
|
||||
Return
|
||||
ENDIF
|
||||
|
||||
lunatrec=nl
|
||||
antrec=an
|
||||
|
||||
lcDatePrec = ADDBS(calefirma) + 'AN' + ADDBS(antrec) + 'DATE' + ADDBS(lunatrec) + 'mf.dbf'
|
||||
|
||||
IF FILE(lcDatePrec)
|
||||
USE &lcDatePrec IN 0 SHARED ALIAS mfPrec
|
||||
SELECT * from mfPrec WHERE !DELETED() INTO CURSOR crs_mfPrec READWRITE
|
||||
USE IN mfPrec
|
||||
ELSE
|
||||
Do MESAJ With 'Nu exista date in luna precedenta! ',''
|
||||
SELECT * from mf WHERE 1=2 INTO CURSOR crs_mfPrec READWRITE
|
||||
ENDIF
|
||||
|
||||
SELECT crs_mfPrec
|
||||
REPLACE ALL cod WITH 0
|
||||
REPLACE ALL amortprec WITH amorttot
|
||||
|
||||
|
||||
SELECT mf
|
||||
DELETE ALL FOR cod = 0
|
||||
|
||||
SELECT mflun
|
||||
DELETE ALL FOR cod = 0
|
||||
|
||||
SELECT mf
|
||||
APPEND FROM DBF('crs_mfPrec')
|
||||
|
||||
*** stabilesc care sunt inregistrarile inactive
|
||||
SELECT * from mf WHERE cod = -1 INTO CURSOR crs_mfNoi
|
||||
SELECT crs_mfNoi
|
||||
SCAN
|
||||
SCATTER NAME omf
|
||||
SELECT mf
|
||||
REPLACE ALL inactiv WITH .t. For cod = 0 AND fel = omf.fel AND UPPER(ALLTRIM(denumire))=UPPER(ALLTRIM(omf.denumire)) AND datapif=omf.datapif AND nrpif=omf.nrpif AND nrinv=omf.nrinv
|
||||
SELECT crs_mfNoi
|
||||
ENDSCAN
|
||||
|
||||
IF 12*VAL(SUBSTR(gcDataRon,4,4))+VAL(LEFT(gcDataRon,2)) = 12*VAL(lcAnCrt)+VAL(lcLunaCrt) AND verific_rolronsnr(gcCalefirma)
|
||||
lnDim = 10000
|
||||
SELECT mf
|
||||
REPLACE ALL valoare WITH ROUND(valoare/lnDim,gnZ) FOR cod # -1
|
||||
REPLACE ALL valin WITH ROUND(valin/lnDim,gnZ) FOR cod # -1
|
||||
REPLACE ALL valramasa WITH ROUND(valramasa/lnDim,gnZ) FOR cod # -1
|
||||
REPLACE ALL valrez WITH ROUND(valrez/lnDim,gnZ) FOR cod # -1
|
||||
REPLACE ALL amortprec WITH ROUND(amortprec/lnDim,gnZ) FOR cod # -1
|
||||
REPLACE ALL amortlun WITH ROUND(amortlun/lnDim,gnZ) FOR cod # -1
|
||||
REPLACE ALL amorttot WITH ROUND(amorttot/lnDim,gnZ) FOR cod # -1
|
||||
REPLACE ALL amortan WITH ROUND(amortan/lnDim,gnZ) FOR cod # -1
|
||||
ENDIF
|
||||
|
||||
IF USED('crs_mfNoi')
|
||||
USE IN crs_mfNoi
|
||||
ENDIF
|
||||
IF USED('crs_mfPrec')
|
||||
USE IN crs_mfPrec
|
||||
ENDIF
|
||||
|
||||
Do MESAJ With 'Lista mijloacelor fixe din luna ',lcLunaCrt + ' ' + lcAnCrt + ' a fost actualizata!'
|
||||
|
||||
RETURN
|
||||
|
||||
***------------------------------------------------***
|
||||
|
||||
PROCEDURE deschid_luna_noua
|
||||
PARAMETERS tcAn, tcLuna
|
||||
|
||||
Set Safety Off
|
||||
IF EMPTY(tcAn) OR TYPE('tcAn') # 'C'
|
||||
lcAn = m.an
|
||||
ELSE
|
||||
lcAn = ALLTRIM(tcAn)
|
||||
ENDIF
|
||||
|
||||
IF EMPTY(tcLuna) OR TYPE('tcLuna') # 'C'
|
||||
lcLuna = m.nl
|
||||
ELSE
|
||||
lcLuna = ALLTRIM(tcLuna)
|
||||
ENDIF
|
||||
|
||||
|
||||
Set Exclusive On
|
||||
lcDateNew = ADDBS(gcCalefirma) + 'An' + lcAn + '\' + 'DATE' + lcLuna
|
||||
|
||||
If !Directory(lcDateNew)
|
||||
Md &lcDateNew
|
||||
Endif
|
||||
Set Exclusive Off
|
||||
|
||||
Sele CALENDAR
|
||||
LOCATE FOR an = lcAn AND luna = lcLuna
|
||||
IF !FOUND()
|
||||
APPEND BLANK
|
||||
Repl nl With lcLuna
|
||||
Repl an With lcAn
|
||||
ENDIF
|
||||
SCATTER MEMVAR && pt celebrele variabile globale
|
||||
|
||||
Do totv.PRG
|
||||
DO init_optiuni.prg
|
||||
|
||||
ENDPROC && deschid_luna_noua
|
||||
707
Programe/Vechi/reindexare.prg
Normal file
707
Programe/Vechi/reindexare.prg
Normal file
@@ -0,0 +1,707 @@
|
||||
Parameters tcConditie
|
||||
&& conditia suplimentara && ex: gcAppPath$calealfa
|
||||
|
||||
If !Empty(tcConditie)
|
||||
lcConditie=Alltrim(tcConditie)
|
||||
Else
|
||||
lcConditie = []
|
||||
Endif
|
||||
*!* DIRFIRM=loc+'\'+NFSCURT
|
||||
*!* *CALEFIRMA=ALLTRIM(M.CALEFIRM)
|
||||
*!* SET DELETED OFF
|
||||
|
||||
|
||||
*!* IF !DIRECTORY('&CALEFIRMA')
|
||||
*!* DO MESAJrosu WITH 'Calea '+CALEFIRMA+' este incorecta!','Sugeram iesirea din program.'
|
||||
*!* QUIT
|
||||
*!* RETRY
|
||||
*!* ENDIF
|
||||
|
||||
*!* DATE=CALEFIRMA+'\AN'+m.an+'\DATE'+M.nl
|
||||
*!* DATEAN=CALEFIRMA+'\DATEAN'
|
||||
*!* CALET=DIRFIRM+'\TEMPO'
|
||||
*!* m.ANTET='S.C. '+M.FLUNG
|
||||
*!* WAIT ' ' TIMEOUT 0.01
|
||||
*!* CLOSE DATABASE
|
||||
*!* LOCAL ll,aa
|
||||
*!* ll=m.nl
|
||||
*!* aa=m.an
|
||||
|
||||
*!* DO deschidf WITH '&dirgen\Imob2003\date\','&dirgen\Imob2003\date\','fistotvmf','fistotv','CALE',''
|
||||
|
||||
*!* *do deschidprog in totv.prg
|
||||
*!* *-----------------
|
||||
*!* BUTON=2
|
||||
*!* DO dasaunu WITH 'Se reindexeaza fisierele lunare?'
|
||||
*!* IF BUTON=1
|
||||
*!* SET DELETED ON
|
||||
*!* SELE 0
|
||||
*!* USE &CALEFIRMA\DATEAN\calendar ALIAS calendar &&?????????????????????????????????
|
||||
*!* SELECT DISTINCT an AS anan FroM calendar INTO CURSOR TANCAL
|
||||
*!* SELECT TANCAL
|
||||
*!* SCAN
|
||||
*!* DO dasaunu WITH 'Se reindexeaza fisierele din anul '+anan+' ?'
|
||||
*!* IF BUTON=1
|
||||
*!* lc_an=anan
|
||||
*!* SELE calendar
|
||||
*!* SCAN FOR !DELETED() AND an=lc_an
|
||||
*!* SCATTER MEMVAR
|
||||
*!* DATE=CALEFIRMA+'\AN'+m.an+'\DATE'+M.nl
|
||||
*!* BUTON=2
|
||||
*!* DO dasaunu WITH 'Se reindexeaza fisierele din luna '+m.nl+' '+m.an+' ?'
|
||||
*!* IF BUTON=1
|
||||
*!* SELE fistotv
|
||||
*!* Maxs=RECCOUNT()
|
||||
*!* j=0
|
||||
*!* OP=CREA('PROGRESBAR')
|
||||
*!* OP.titlu.CAPTION='Se reindexeaza fisierele lunii '+m.nl+' '+m.an
|
||||
*!* OP.SHOW()
|
||||
*!* SELE fistotv
|
||||
*!* SET FILTER TO
|
||||
*!* *scan for inlist(allt(lower(cale)),'&date','&date\')
|
||||
*!* SCAN FOR 'DATE'$UPPER(cale) AND !('DATEAN'$UPPER(cale)) AND 'IMOB2003'$allt(UPPER(calealfa))
|
||||
*!* SCAT MEMV
|
||||
*!* WAIT WIND m.numef NOWAIT
|
||||
*!* DO reindf WITH m.calealfa,m.cale,m.numef,m.alias,m.ordine,m.exc
|
||||
*!* DO PR WITH j
|
||||
*!* ENDSCAN
|
||||
*!* OP.RELEASE
|
||||
*!* WAIT CLEAR
|
||||
*!* ENDIF
|
||||
*!* ENDSCAN
|
||||
*!* ENDIF
|
||||
*!* SELECT TANCAL
|
||||
*!* ENDSCAN
|
||||
*!* USE IN calendar
|
||||
*!* ENDIF
|
||||
|
||||
*!* BUTON=2
|
||||
*!* DO dasaunu WITH 'Se reindexeaza fisierele generale din DATEAN?'
|
||||
*!* IF BUTON=1
|
||||
*!* SELE fistotv
|
||||
*!* Maxs=RECCOUNT()
|
||||
*!* j=0
|
||||
*!* OP=CREA('PROGRESBAR')
|
||||
*!* OP.titlu.CAPTION='Se reindexeaza fisierele generale. Asteptati...'
|
||||
*!* OP.SHOW()
|
||||
*!* SELE fistotv
|
||||
*!* SET FILTER TO !DELETED()
|
||||
*!* *scan for inlist(allt(lower(cale)),'&calefirma\datean','&calefirma\datean\')
|
||||
*!* SCAN FOR 'DATEAN'$ALLT(UPPER(cale)) AND 'IMOB2003'$allt(UPPER(calealfa))
|
||||
*!* SCAT MEMV
|
||||
*!* WAIT WIND m.numef NOWAIT
|
||||
*!* DO reindf WITH m.calealfa,m.cale,m.numef,m.alias,m.ordine,m.exc
|
||||
*!* DO PR WITH j
|
||||
*!* ENDSCAN
|
||||
*!* OP.RELEASE
|
||||
*!* WAIT CLEAR
|
||||
*!* ENDIF
|
||||
|
||||
*!* BUTON=2
|
||||
*!* DO dasaunu WITH 'Se reindexeaza fisierele locale?'
|
||||
*!* IF BUTON=1
|
||||
*!* SELE fistotv
|
||||
*!* Maxs=RECCOUNT()
|
||||
*!* j=0
|
||||
*!* OP=CREA('PROGRESBAR')
|
||||
*!* OP.titlu.CAPTION='Se reindexeaza fisierele locale'
|
||||
*!* OP.SHOW()
|
||||
*!* SELE fistotv
|
||||
*!* *set filter to inlist(allt(UPPER(cale)),'&LOC\&NFSCURT\TEMPO','&LOC\&NFSCURT\TEMPO\')
|
||||
*!* SET FILTER TO 'LOC'$ALLT(UPPER(cale))
|
||||
*!* *brow
|
||||
*!* SCAN
|
||||
*!* SCAT MEMV
|
||||
*!* WAIT WIND m.numef NOWAIT
|
||||
*!* DO reindf WITH m.calealfa,m.cale,m.numef,m.alias,m.ordine,m.exc
|
||||
*!* DO PR WITH j
|
||||
*!* ENDSCAN
|
||||
*!* OP.RELEASE
|
||||
*!* WAIT CLEAR
|
||||
*!* ENDIF
|
||||
|
||||
*!* SET DELETED ON
|
||||
|
||||
*!* *---------------
|
||||
*!* m.nl=ll
|
||||
*!* m.an=aa
|
||||
*!* DO totv
|
||||
*!* RETURN
|
||||
|
||||
|
||||
|
||||
|
||||
*!* *__________________________________________
|
||||
*!* PROCEDURE reindf
|
||||
*!* PARAM calealfa,cale,numef,ALIAS,ordine,exc
|
||||
*!* LOCAL calea,calea1,CALEAL,CALEAL1,T,fisa,fisv,fisa1,fisv1,aliasa
|
||||
|
||||
*!* calea=ALLT(cale)+'\'+ALLT(numef)+'.dbf'
|
||||
*!* calea1=ALLT(cale)+'\'+ALLT(numef)+'.*'
|
||||
*!* CALEAL=ALLT(calealfa)+'\'+ALLT(numef)+'.dbf'
|
||||
*!* CALEAL1=ALLT(calealfa)+'\'+ALLT(numef)+'.*'
|
||||
*!* fisa=ALLT(cale)+'\'+ALLT(numef)+'a.dbf'
|
||||
*!* fisa1=ALLT(cale)+'\'+ALLT(numef)+'a.*'
|
||||
*!* fisv=ALLT(cale)+'\_%'+ALLT(numef)+'.dbf'
|
||||
*!* fisv1=ALLT(cale)+'\_%'+ALLT(numef)+'.*'
|
||||
*!* aliasa=ALLT(ALIAS)+'a'
|
||||
|
||||
*!* IF FILE('&calea')
|
||||
*!* *wait wind calea
|
||||
*!* DELE FILE &fisa1
|
||||
*!* DELE FILE &fisv1
|
||||
*!* COPY FILE &CALEAL1 TO &fisa1
|
||||
*!* SELE 0
|
||||
*!* T='use '+fisa+' AGAIN ALIAS '+aliasa+' exclusive '
|
||||
*!* &T
|
||||
*!* *wait wind t
|
||||
*!* SELE &aliasa
|
||||
*!* ZAP
|
||||
*!* SELE &aliasa
|
||||
*!* APPEND FROM &calea
|
||||
*!* SELE &aliasa
|
||||
*!* *!* WAIT WINDOW "reindex"
|
||||
*!* *!* SELECT &aliasa
|
||||
*!* REINDEX
|
||||
*!* USE
|
||||
*!* RENAME &calea1 TO &fisv1
|
||||
*!* RENAME &fisa1 TO &calea1
|
||||
*!* ENDIF
|
||||
|
||||
*!* RETURN
|
||||
|
||||
|
||||
|
||||
*!* *______________________
|
||||
*!* PROC errdeschid
|
||||
*!* PARAM calealfa,cale,numef,ALIAS,ordine
|
||||
*!* LOCAL calea,calea2,CALEAL,CALEAL2
|
||||
*!* calea=ALLT(cale)+'\'+ALLT(numef)+'.dbf'
|
||||
*!* calea2=ALLT(cale)+'\'+ALLT(numef)+'.cdx'
|
||||
*!* CALEAL=ALLT(calealfa)+'\'+ALLT(numef)+'.dbf'
|
||||
*!* CALEAL2=ALLT(calealfa)+'\'+ALLT(numef)+'.cdx'
|
||||
*!* DO CASE
|
||||
*!* CASE ERROR()=24 &&Alias name is already in use
|
||||
*!* RETURN
|
||||
*!* CASE ERROR()=19 OR ERROR()=26 OR ERROR()=114 &&Index file does not match table. sau Table has no index order set.
|
||||
*!* DO mesajatent WITH 'Se reindexeaza fisierul "'+ALLT(numef)+'"',''
|
||||
*!* IF FILE('&caleal2') AND cale#calealfa
|
||||
*!* COPY FILE &CALEAL2 TO &calea2
|
||||
*!* USE &calea AGAIN ALIAS &ALIAS
|
||||
*!* SET INDEX TO &calea2
|
||||
*!* REINDEX
|
||||
*!* ELSE
|
||||
*!* DO MESAJrosu WITH 'Nu se poate reindexa fisierul "'+ALLT(numef)+'".','Sugeram iesirea din program.'
|
||||
*!* QUIT
|
||||
*!* RETRY
|
||||
*!* ENDIF
|
||||
|
||||
*!* CASE ERROR()=15 &&Not a table.
|
||||
*!* DO danuquit WITH 'Fisierul "'+ALLT(numef)+'" este defect. Il inlocuim cu o structura vida?'
|
||||
*!* IF FILE('&caleal')
|
||||
*!* COPY FILE &CALEAL1 TO &calea1
|
||||
*!* RETRY
|
||||
*!* ELSE
|
||||
*!* DO MESAJrosu WITH 'Nu se poate inlocui fisierul "'+ALLT(numef)+'".','Sugeram iesirea din program.'
|
||||
*!* QUIT
|
||||
*!* RETRY
|
||||
*!* ENDIF
|
||||
|
||||
*!* CASE ERROR()=3 OR ERROR()=1705 &&File is in use. or File access is denied.
|
||||
*!* DO MESAJrosu WITH 'Fisierul "'+ALLT(numef)+'" este deschis de alt program.','Inchideti fisierul si apoi redeschideti programul.'
|
||||
*!* QUIT
|
||||
*!* RETRY
|
||||
*!* OTHERWISE
|
||||
*!* DO MESAJrosu WITH 'Eroare necunoscuta (Nr.'+ALLT(STR(ERROR()))+')', 'Sugeram iesirea din program.'
|
||||
*!* QUIT
|
||||
*!* RETRY
|
||||
*!* ENDCASE
|
||||
|
||||
*!* RETURN
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
*!* *____________________
|
||||
*!* PROC errgen
|
||||
*!* DO MESAJrosu WITH 'Eroare necunoscuta (Nr.'+ALLT(STR(ERROR()))+')', 'Sugeram iesirea din program.'
|
||||
*!* QUIT
|
||||
*!* RETRY
|
||||
*!* RETURN
|
||||
|
||||
|
||||
|
||||
*!* *___ PROCEDURA DE DESCHIDERE DIN AFARA LUI TOTV_________________________________________________
|
||||
*!* PROC DES
|
||||
*!* PARAM ALIASF
|
||||
*!* IF !DIRECTORY('&CALEFIRMA')
|
||||
*!* DO MESAJrosu WITH 'Calea '+CALEFIRMA+' este incorecta!','Sugeram iesirea din program.'
|
||||
*!* QUIT
|
||||
*!* RETRY
|
||||
*!* ENDIF
|
||||
*!* DATE=CALEFIRMA+'\AN'+M.an+'\DATE'+M.nl
|
||||
*!* IF !USED('FISTOTV')
|
||||
*!* DO deschidf WITH '&dirgen\Imob2003\date\','&dirgen\Imob2003\date\','fistotvmf','fistotv','CALE',''
|
||||
*!* ENDIF
|
||||
*!* SELE fistotv
|
||||
*!* LOCA FOR ALLT(UPPER(ALIAS))=ALLT(UPPER(ALIASF))
|
||||
*!* IF !FOUND()
|
||||
*!* DO MESAJrosu WITH 'Alias '+ALIASF+' inexistent!','Sugeram iesirea din program.'
|
||||
*!* QUIT
|
||||
*!* RETRY
|
||||
*!* ELSE
|
||||
*!* SCAT MEMV
|
||||
*!* DO deschidf WITH m.calealfa,m.cale,m.numef,m.alias,m.ordine,m.exc
|
||||
*!* ENDIF
|
||||
*!* RETURN
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
*!* *______________________________
|
||||
*!* PROCEDURE reindexaretempo
|
||||
*!* DIRFIRM=loc+'\'+NFSCURT
|
||||
*!* *CALEFIRMA=ALLTRIM(M.CALEFIRM)
|
||||
|
||||
*!* IF !DIRECTORY('&CALEFIRMA')
|
||||
*!* DO MESAJrosu WITH 'Calea '+CALEFIRMA+' este incorecta!','Sugeram iesirea din program.'
|
||||
*!* QUIT
|
||||
*!* RETRY
|
||||
*!* ENDIF
|
||||
|
||||
*!* DATE=CALEFIRMA+'\AN'+m.an+'\DATE'+M.nl
|
||||
*!* DATEAN=CALEFIRMA+'\DATEAN'
|
||||
*!* CALET=DIRFIRM+'\TEMPO'
|
||||
*!* m.ANTET='S.C. '+M.FLUNG
|
||||
*!* WAIT ' ' TIMEOUT 0.01
|
||||
*!* CLOSE DATABASE
|
||||
*!* LOCAL ll,aa
|
||||
*!* ll=m.nl
|
||||
*!* aa=m.an
|
||||
|
||||
*!* DO deschidf WITH '&dirgen\Imob2003\date\','&dirgen\Imob2003\date\','fistotvmf','fistotv','CALE',''
|
||||
|
||||
|
||||
*!* SELE fistotv
|
||||
*!* Maxs=RECCOUNT()
|
||||
*!* j=0
|
||||
*!* OP=CREA('PROGRESBAR')
|
||||
*!* OP.titlu.CAPTION='Se reindexeaza fisierele locale'
|
||||
*!* OP.SHOW()
|
||||
*!* SELE fistotv
|
||||
*!* *set filter to inlist(allt(UPPER(cale)),'&LOC\&NFSCURT\TEMPO','&LOC\&NFSCURT\TEMPO\')
|
||||
*!* SET FILTER TO 'LOC'$ALLT(UPPER(cale))
|
||||
*!* *brow
|
||||
*!* SCAN
|
||||
*!* SCAT MEMV
|
||||
*!* WAIT WIND m.numef NOWAIT
|
||||
*!* DO reindf WITH m.calealfa,m.cale,m.numef,m.alias,m.ordine,m.exc
|
||||
*!* DO PR WITH j
|
||||
*!* ENDSCAN
|
||||
*!* OP.RELEASE
|
||||
*!* WAIT CLEAR
|
||||
*!* m.nl=ll
|
||||
*!* m.an=aa
|
||||
*!* DO totv
|
||||
*!* RETURN
|
||||
|
||||
**** sfarsit reindexare imobilizari
|
||||
|
||||
Wait ' ' Timeout 0.01
|
||||
Close Database
|
||||
Local ll,aa
|
||||
ll=m.nl
|
||||
aa=m.an
|
||||
|
||||
|
||||
Do deschidprog In totv.prg
|
||||
|
||||
*-----------------
|
||||
Local man
|
||||
man=''
|
||||
BUTON=2
|
||||
*Do DANU With 'Se reindexeaza fisierele lunare?'
|
||||
*If BUTON=1
|
||||
Sele 0
|
||||
Use &CALEFIRMA\DATEAN\calendar Alias calendar
|
||||
Select Distinct an From calendar Into Cursor jan Order By an
|
||||
Select jan
|
||||
Scan
|
||||
man=an
|
||||
Do dasaunu With 'Se reindexeaza fisierele lunare din anul '+man+'?'
|
||||
If BUTON=1
|
||||
Set Deleted Off && pentru mf
|
||||
Sele calendar
|
||||
Scan For !Deleted() And an=man
|
||||
Scatter Memvar
|
||||
Date=CALEFIRMA+'\AN'+m.an+'\DATE'+M.nl
|
||||
BUTON=2
|
||||
Do dasaunu With 'Se reindexeaza fisierele din luna '+m.nl+' '+m.an+' ?'
|
||||
If BUTON=1
|
||||
Sele fistotv
|
||||
MAXS=Reccount()
|
||||
j=0
|
||||
OP=Crea('PROGRESBAR')
|
||||
OP.titlu.Caption='Se reindexeaza fisierele lunii '+m.nl+' '+m.an
|
||||
OP.Show()
|
||||
|
||||
|
||||
Sele fistotv
|
||||
Set Filter To
|
||||
*scan for inlist(allt(lower(cale)),'&date','&date\')
|
||||
lcFiltru = ['DATE'$UPPER(cale) AND !('DATEAN'$UPPER(cale)) AND !('_ALFA'$ALLT(UPPER(cale)))]
|
||||
lcFiltru = lcFiltru + Iif(!Empty(lcConditie),[ and ]+lcConditie,"")
|
||||
|
||||
Scan For &lcFiltru
|
||||
Scat Name loFis
|
||||
Wait Wind loFis.numef Nowait
|
||||
Do reindf With loFis.calealfa,loFis.cale,loFis.numef,loFis.Alias,loFis.ordine,loFis.exc
|
||||
Do PR With j
|
||||
Endscan
|
||||
OP.Release
|
||||
Release loFis
|
||||
Wait Clear
|
||||
Endif
|
||||
Endscan
|
||||
Set Deleted On
|
||||
Endif
|
||||
Select jan
|
||||
Endscan
|
||||
Use In calendar
|
||||
*Endif
|
||||
|
||||
BUTON=2
|
||||
Do dasaunu With 'Se reindexeaza fisierele generale din DATEAN?'
|
||||
If BUTON=1
|
||||
Sele fistotv
|
||||
MAXS=Reccount()
|
||||
j=0
|
||||
OP=Crea('PROGRESBAR')
|
||||
OP.titlu.Caption='Se reindexeaza fisierele generale. Asteptati...'
|
||||
OP.Show()
|
||||
Sele fistotv
|
||||
Set Filter To
|
||||
*scan for inlist(allt(lower(cale)),'&calefirma\datean','&calefirma\datean\')
|
||||
lcFiltru = ['DATEAN'$ALLT(UPPER(cale)) AND !('_ALFA'$ALLT(UPPER(cale)))]
|
||||
lcFiltru = lcFiltru + Iif(!Empty(lcConditie),[ and ]+lcConditie,"")
|
||||
Scan For &lcFiltru
|
||||
Scat Name loFis
|
||||
Wait Wind loFis.numef Nowait
|
||||
Do reindf With loFis.calealfa,loFis.cale,loFis.numef,loFis.Alias,loFis.ordine,loFis.exc
|
||||
Do PR With j
|
||||
Endscan
|
||||
OP.Release
|
||||
Wait Clear
|
||||
Endif
|
||||
|
||||
BUTON=2
|
||||
Do dasaunu With 'Se reindexeaza fisierele locale?'
|
||||
If BUTON=1
|
||||
Sele fistotv
|
||||
MAXS=Reccount()
|
||||
j=0
|
||||
OP=Crea('PROGRESBAR')
|
||||
OP.titlu.Caption='Se reindexeaza fisierele locale'
|
||||
OP.Show()
|
||||
Sele fistotv
|
||||
*set filter to inlist(allt(UPPER(cale)),'&LOC\&NFSCURT\TEMPO','&LOC\&NFSCURT\TEMPO\')
|
||||
Set Filter To 'LOC'$Allt(Upper(cale))
|
||||
*brow
|
||||
Scan
|
||||
Scat Name loFis
|
||||
Wait Wind loFis.numef Nowait
|
||||
Do reindf With loFis.calealfa,loFis.cale,loFis.numef,loFis.Alias,loFis.ordine,loFis.exc
|
||||
Do PR With j
|
||||
Endscan
|
||||
OP.Release
|
||||
Release loFis
|
||||
Wait Clear
|
||||
Endif
|
||||
|
||||
*---------------
|
||||
m.nl=ll
|
||||
m.an=aa
|
||||
Do totv
|
||||
|
||||
Return
|
||||
|
||||
*__________________________________________
|
||||
Procedure reindf
|
||||
Param calealfa,cale,numef,Alias,ordine,exc
|
||||
Local calea,calea1,CALEAL,CALEAL1,T,fisa,fisv,fisa1,fisv1,aliasa
|
||||
|
||||
calea=Allt(cale)+'\'+Allt(numef)+'.dbf'
|
||||
calea1=Allt(cale)+'\'+Allt(numef)+'.*'
|
||||
CALEAL=Allt(calealfa)+'\'+Allt(numef)+'.dbf'
|
||||
CALEAL1=Allt(calealfa)+'\'+Allt(numef)+'.*'
|
||||
fisa=Allt(cale)+'\'+Allt(numef)+'_a.dbf'
|
||||
fisa1=Allt(cale)+'\'+Allt(numef)+'_a.*'
|
||||
fisv=Allt(cale)+'\_%'+Allt(numef)+'.dbf'
|
||||
fisv1=Allt(cale)+'\_%'+Allt(numef)+'.*'
|
||||
aliasa=Allt(numef)+'_a'
|
||||
|
||||
lcFisierFirma=calea
|
||||
lcAlias=Alltrim(Alias)
|
||||
llUsed=.F.
|
||||
If Used(lcAlias)
|
||||
llUsed=.T.
|
||||
lcFis=Juststem(Dbf(lcAlias))
|
||||
Use In (lcAlias)
|
||||
Endif
|
||||
|
||||
x=Fopen('&lcFisierFirma',12)
|
||||
If x < 0
|
||||
Do mesaj With "Fisierul "+lcFisierFirma," Este deschis de alt program. Nu se poate reindexa"
|
||||
If llUsed
|
||||
Do des With lcAlias
|
||||
Endif
|
||||
Return
|
||||
Endif
|
||||
Fclose(x)
|
||||
|
||||
|
||||
|
||||
If File('&calea')
|
||||
Wait Window lcAlias+[ ]+"Se sterg fisierele temporare..." Nowait
|
||||
|
||||
Dele File &fisa1
|
||||
Dele File &fisv1
|
||||
|
||||
Wait Window lcAlias+[ ]+"Se copiaza structurile vide..." Nowait
|
||||
Copy File &CALEAL1 To &fisa1
|
||||
Sele 0
|
||||
T='use '+fisa+' AGAIN ALIAS '+aliasa+' exclusive '
|
||||
&T
|
||||
*wait wind t
|
||||
Sele &aliasa
|
||||
Zap
|
||||
|
||||
Wait Window lcAlias+[ ]+"Se copiaza datele originale..." Nowait
|
||||
*!* SELE &aliasa
|
||||
*!* APPEND FROM &calea
|
||||
reindf_append(lcAlias,aliasa,calea)
|
||||
|
||||
Wait Window lcAlias+[ ]+"Se reindexeaza fisierul..." Nowait
|
||||
Sele &aliasa
|
||||
Reindex
|
||||
Use
|
||||
|
||||
Rename &calea1 To &fisv1
|
||||
Rename &fisa1 To &calea1
|
||||
|
||||
Wait Window lcAlias+[ ]+"Operatiune incheiata cu succes..." Nowait
|
||||
Endif
|
||||
|
||||
Endproc && reindf
|
||||
|
||||
***----------------------------------------------------------------------------------
|
||||
*** copie indexul din structurile vide, deschide exclusiv fisierul si da reindex
|
||||
*** fisierul trebuie sa fie inchis
|
||||
Procedure REINDFCDX
|
||||
Parameters tcCaleAlfa,tcCale,tcNumef
|
||||
*** calea structurii vide, calea fisierului, numele fisierului
|
||||
|
||||
Private lcCDXd,lcDBF,lcCDXs
|
||||
|
||||
lcCDXd=Allt(tcCale)+'\'+Allt(tcNumef)+'.cdx'
|
||||
lcDBF=Allt(tcCale)+'\'+Allt(tcNumef)+'.dbf'
|
||||
lcCDXs=Allt(tcCaleAlfa)+'\'+Allt(tcNumef)+'.cdx'
|
||||
|
||||
Wait Window "Se copiaza structurile vide..." Nowait
|
||||
|
||||
Copy File('&lcCDXs') To ('&lcCDXd')
|
||||
Use ('&lcDBF') In 0 Excl Alias FisierR
|
||||
Set Index To ('&lcCDXd')
|
||||
|
||||
Wait Window "Se reindexeaza fisierul..." Nowait
|
||||
Select FisierR
|
||||
Reindex
|
||||
Use In FisierR
|
||||
|
||||
Wait Window "Operatiune incheiata cu succes..." Nowait
|
||||
|
||||
Endproc && REINDFCDX
|
||||
|
||||
|
||||
*______________________
|
||||
Proc errdeschid_r
|
||||
Param calealfa,cale,numef,Alias,ordine
|
||||
Local calea,calea2,CALEAL,CALEAL2
|
||||
calea=Allt(cale)+'\'+Allt(numef)+'.dbf'
|
||||
calea2=Allt(cale)+'\'+Allt(numef)+'.cdx'
|
||||
CALEAL=Allt(calealfa)+'\'+Allt(numef)+'.dbf'
|
||||
CALEAL2=Allt(calealfa)+'\'+Allt(numef)+'.cdx'
|
||||
Do Case
|
||||
Case Error()=24 &&Alias name is already in use
|
||||
Return
|
||||
Case Error()=19 Or Error()=26 Or Error()=114 &&Index file does not match table. sau Table has no index order set.
|
||||
Do mesajatent With 'Se reindexeaza fisierul "'+Allt(numef)+'"',''
|
||||
If File('&caleal2') And cale#calealfa
|
||||
Copy File &CALEAL2 To &calea2
|
||||
Use &calea Again Alias &Alias
|
||||
Set Index To &calea2
|
||||
Reindex
|
||||
Else
|
||||
Do MESAJrosu With 'Nu se poate reindexa fisierul "'+Allt(numef)+'".','Sugeram iesirea din program.'
|
||||
Quit
|
||||
Retry
|
||||
Endif
|
||||
|
||||
Case Error()=15 &&Not a table.
|
||||
Do danuquit With 'Fisierul "'+Allt(numef)+'" este defect. Il inlocuim cu o structura vida?'
|
||||
If File('&caleal')
|
||||
Copy File &CALEAL1 To &calea1
|
||||
Retry
|
||||
Else
|
||||
Do MESAJrosu With 'Nu se poate inlocui fisierul "'+Allt(numef)+'".','Sugeram iesirea din program.'
|
||||
Quit
|
||||
Retry
|
||||
Endif
|
||||
|
||||
Case Error()=1683 &&index tag is not found
|
||||
Do MESAJrosu With "Structura vida a fisierului "+Alltrim(numef)+" este stricata!",""
|
||||
*!* Do MESAJrosu With 'Fisierul "'+Allt(numef)+'" este deschis de alt program.','Inchideti fisierul si apoi redeschideti programul.'
|
||||
Quit
|
||||
Retry
|
||||
Case Error()=3 Or Error()=1705 &&File is in use. or File access is denied.
|
||||
Do MESAJrosu With 'Fisierul "'+Allt(numef)+'" este deschis de alt program.','Inchideti fisierul si apoi redeschideti programul.'
|
||||
Quit
|
||||
Retry
|
||||
Otherwise
|
||||
Do MESAJrosu With 'Eroare necunoscuta (Nr.'+Allt(Str(Error()))+')', 'Sugeram iesirea din program.'
|
||||
Quit
|
||||
Retry
|
||||
Endcase
|
||||
|
||||
Endproc && errdeschid_r
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
*____________________
|
||||
Proc errgen
|
||||
Do MESAJrosu With 'Eroare necunoscuta (Nr.'+Allt(Str(Error()))+')', 'Sugeram iesirea din program.'
|
||||
Quit
|
||||
Retry
|
||||
Return
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
*______________________________
|
||||
Procedure reindexaretempo
|
||||
DIRFIRM=loc+'\'+NFSCURT
|
||||
*CALEFIRMA=ALLTRIM(M.CALEFIRM)
|
||||
|
||||
If !Directory('&CALEFIRMA')
|
||||
Do MESAJrosu With 'Calea '+CALEFIRMA+' este incorecta!','Sugeram iesirea din program.'
|
||||
Quit
|
||||
Retry
|
||||
Endif
|
||||
Date=CALEFIRMA+'\AN'+m.an+'\DATE'+M.nl
|
||||
DATEAN=CALEFIRMA+'\DATEAN'
|
||||
CALET=DIRFIRM+'\TEMPO'
|
||||
m.ANTET='S.C. '+M.FLUNG
|
||||
Wait ' ' Timeout 0.01
|
||||
Close Database
|
||||
Local ll,aa
|
||||
ll=m.nl
|
||||
aa=m.an
|
||||
|
||||
*!* DO deschidf WITH '&dirgen\gestiuni\date\datean\','&dirgen\gestiuni\date\datean\','fistotvgest','fistotv','CALE',''
|
||||
Do deschidprog In totv.prg
|
||||
|
||||
Sele fistotv
|
||||
M=Reccount()
|
||||
j=0
|
||||
OP=Crea('PROGRESBAR')
|
||||
OP.titlu.Caption='Se reindexeaza fisierele locale'
|
||||
OP.Show()
|
||||
Sele fistotv
|
||||
*set filter to inlist(allt(UPPER(cale)),'&LOC\&NFSCURT\TEMPO','&LOC\&NFSCURT\TEMPO\')
|
||||
Set Filter To 'LOC'$Allt(Upper(cale))
|
||||
*brow
|
||||
Scan
|
||||
Scat Name loFis
|
||||
Wait Wind loFis.numef Nowait
|
||||
Do reindf With loFis.calealfa,loFis.cale,loFis.numef,loFis.Alias,loFis.ordine,loFis.exc
|
||||
Do PR With j
|
||||
Endscan
|
||||
OP.Release
|
||||
|
||||
Release loFis
|
||||
|
||||
Wait Clear
|
||||
m.nl=ll
|
||||
m.an=aa
|
||||
Do totv
|
||||
|
||||
|
||||
Endproc && reindexaretempo
|
||||
|
||||
|
||||
|
||||
*** INCEPUT PROCEDURA reindf_append
|
||||
Procedure reindf_append
|
||||
Parameters tcAlias,tcAlias_A,tcFisOriginal
|
||||
|
||||
&& tcAlias: aliasul tabelului
|
||||
&& tcAlias_A: aliasul tabelului vid+"_A"
|
||||
&& tcFisOriginal: calea catre fisierul care se reindexeaza cu datE
|
||||
|
||||
Private lcAlias,lcAlias_A,lcFisOriginal,llUsed
|
||||
|
||||
|
||||
lcAlias=Alltrim(Upper(tcAlias))
|
||||
lcAlias_A=Alltrim(Upper(tcAlias_A))
|
||||
lcFisOriginal=Alltrim(Upper(tcFisOriginal))
|
||||
|
||||
Do Case
|
||||
Case Inlist(lcAlias,"DEBITOR","CREDITOR","ACHIT542")
|
||||
|
||||
|
||||
If !EXISTACAMP(lcAlias_A,"LUAT") && daca in fisierul structura vida nu am campul <luat>
|
||||
lcFisTemp=Alltrim(loc)+"\"+Alltrim(NFSCURT)+"\tempo\T"+lcAlias+".dbf"
|
||||
lcFisTemp=Strtran(lcFisTemp,"\\","\")
|
||||
|
||||
&& deschid fisierul original
|
||||
llUsed=.T.
|
||||
If !Used(lcAlias)
|
||||
llUsed=.F.
|
||||
Use ('&lcFisOriginal') In 0 Shared Alias &lcAlias
|
||||
Endif
|
||||
|
||||
Select(lcAlias)
|
||||
If !EXISTACAMP(lcAlias,"LUAT") && DACA IN FISIERUL ORIGINAL NU EXISTA CAMPUL <LUAT> NU FAC NIMIC
|
||||
If !llUsed
|
||||
Use In (lcAlias)
|
||||
Endif
|
||||
Else
|
||||
If Inlist(lcAlias,"DEBITOR","ACHIT542")
|
||||
Select *,luat As debit,dat As credit From &lcAlias Into Cursor tt
|
||||
Else
|
||||
Select *,dat As debit,luat As credit From &lcAlias Into Cursor tt
|
||||
Endif
|
||||
If !llUsed
|
||||
Use In (lcAlias)
|
||||
Endif
|
||||
Select (lcAlias_A)
|
||||
Append From Dbf('tt')
|
||||
Use In tt
|
||||
Endif
|
||||
Endif
|
||||
Otherwise
|
||||
Select (lcAlias_A)
|
||||
Append From &lcFisOriginal
|
||||
|
||||
Endcase
|
||||
|
||||
|
||||
Endproc
|
||||
*** SFARSIT PROCEDURA reindf_append
|
||||
5
Programe/Vechi/shutdown.prg
Normal file
5
Programe/Vechi/shutdown.prg
Normal file
@@ -0,0 +1,5 @@
|
||||
IF TYPE("goApp")=="O" AND NOT ISNULL(goApp)
|
||||
RETURN goApp.OnShutDown()
|
||||
ENDIF
|
||||
*Cleanup()
|
||||
*QUIT
|
||||
126
Programe/Vechi/sitan.prg
Normal file
126
Programe/Vechi/sitan.prg
Normal file
@@ -0,0 +1,126 @@
|
||||
********
|
||||
PROCEDURE sitan
|
||||
|
||||
pcNl=m.nl
|
||||
pcAn=m.an
|
||||
|
||||
SELECT *, SPACE(4) AS an, SPACE(2) AS nl FROM mf WHERE 1=2 INTO CURSOR mfsel READWRITE
|
||||
|
||||
SELECT an,nl FROM calendar WHERE VAL(an)=VAL(pcAn) AND VAL(nl)<=VAL(pcNl) INTO CURSOR tcalendar
|
||||
|
||||
SELECT tcalendar
|
||||
SCAN
|
||||
lcnl=nl
|
||||
lcAn=an
|
||||
lcdate='&calefirma\an'+lcAn+'\date'+lcnl+'\mf.dbf'
|
||||
IF FILE(lcdate)
|
||||
SELECT mfsel
|
||||
|
||||
IF TYPE("&lcDate..inactiv")!="U"
|
||||
APPEND FROM (lcdate) FOR INLIST(UPPER(fel),&pcfelul) AND !casat AND !inactiv
|
||||
ELSE
|
||||
APPEND FROM (lcdate) FOR INLIST(UPPER(fel),&pcfelul) AND !casat
|
||||
ENDIF
|
||||
REPLACE ALL nl WITH lcnl FOR EMPTY(nl)
|
||||
REPLACE ALL an WITH lcAn FOR EMPTY(an)
|
||||
ENDIF
|
||||
SELECT tcalendar
|
||||
ENDSCAN
|
||||
|
||||
lcCursor = [sitmf]
|
||||
SELECT SUM(amortlun) AS amortlun, SUM(amorttot) AS amorttot, SUM(valoare) AS valoare, an, nl, ALLTRIM(scd) AS scd ;
|
||||
FROM mfsel ;
|
||||
INTO CURSOR (lcCursor) ;
|
||||
GROUP BY an, nl, scd
|
||||
|
||||
|
||||
IF USED('mfsel')
|
||||
USE IN mfsel
|
||||
ENDIF
|
||||
IF USED('tcalendar')
|
||||
USE IN tcalendar
|
||||
ENDIF
|
||||
|
||||
RETURN lcCursor
|
||||
|
||||
*---------------------------------------------------------------------------
|
||||
PROCEDURE rulaje
|
||||
PARAMETERS tcCamp, tcAlias
|
||||
|
||||
ancrt=m.an
|
||||
luncrt=m.nl
|
||||
firmcrt=nfscurt
|
||||
lcRet = []
|
||||
lcCamp = ALLTRIM(tcCamp)
|
||||
|
||||
IF EMPTY(tcAlias) OR TYPE('tcAlias') # 'C'
|
||||
lcAlias = [sitmf]
|
||||
ELSE
|
||||
lcAlias = ALLTRIM(tcAlias)
|
||||
ENDIF
|
||||
|
||||
SELECT DISTINCT scd FROM (lcAlias) INTO CURSOR conturi
|
||||
SELECT DISTINCT an,nl FROM (lcAlias) INTO CURSOR luni
|
||||
|
||||
tt='create table &loc\&nfscurt\tempo\rulaje.DBF (an c(4),nl c(2)'
|
||||
SELECT conturi
|
||||
SCAN
|
||||
SCAT MEMV
|
||||
tt=tt+',c'+ALLTRIM(m.scd)+' n(14,gnZ)'
|
||||
SELECT conturi
|
||||
ENDSCAN
|
||||
|
||||
|
||||
tt=tt+')'
|
||||
&tt
|
||||
SELECT rulaje
|
||||
APPEND FROM DBF('luni')
|
||||
USE IN luni
|
||||
|
||||
*sume---
|
||||
SELECT (lcAlias)
|
||||
SCAN
|
||||
SCATTER MEMV
|
||||
SELECT rulaje
|
||||
LOCATE FOR nl=m.nl AND an=m.an
|
||||
tt='REPLACE c'+ALLTRIM(m.scd)+' with '+ lcCamp
|
||||
&tt
|
||||
SELECT (lcAlias)
|
||||
ENDSCAN
|
||||
|
||||
*totaluri---
|
||||
LOCAL m.c
|
||||
m.c=0
|
||||
SELECT rulaje
|
||||
APPEND BLANK
|
||||
REPLACE an WITH 'TOT'
|
||||
SELECT conturi
|
||||
SCAN
|
||||
SCATTER MEMV
|
||||
SELECT rulaje
|
||||
tt='sum c'+ALLTRIM(m.scd)+' to m.c FOR NL<=LUNCRT'
|
||||
&tt
|
||||
|
||||
SELECT rulaje
|
||||
GO BOTT
|
||||
tt='REPLACE c'+ALLTRIM(m.scd)+' with m.c'
|
||||
&tt
|
||||
SELECT conturi
|
||||
ENDSCAN
|
||||
|
||||
m.an=ancrt
|
||||
m.nl=luncrt
|
||||
nfscurt=firmcrt
|
||||
|
||||
IF USED('conturi')
|
||||
USE IN conturi
|
||||
ENDIF
|
||||
IF USED('rulaje')
|
||||
USE IN rulaje
|
||||
lcRet = [&loc\&nfscurt\tempo\rulaje.DBF]
|
||||
ENDIF
|
||||
IF USED(lcAlias)
|
||||
USE IN (lcAlias)
|
||||
ENDIF
|
||||
|
||||
RETURN lcRet
|
||||
80
Programe/Vechi/sitanvechi.prg
Normal file
80
Programe/Vechi/sitanvechi.prg
Normal file
@@ -0,0 +1,80 @@
|
||||
local cond
|
||||
cond='month(datapif)=val(m.nl) and year(datapif)=val(m.an) and uzuraprec=0'
|
||||
|
||||
SET SAFETY Off
|
||||
close database
|
||||
|
||||
LOCAL NRL,NRA,L,A,UZ
|
||||
local i,t,k,ancrt,luncrt,firmcrt
|
||||
public m.an, m.nl, m.t_2121, m.t_2122, m.t_2123, m.t_2124, m.t_2125, m.t_2126, an, nl
|
||||
store 0 to i, k, m.t_2121, m.t_2122, m.t_2123, m.t_2124, m.t_2125, m.t_2126
|
||||
|
||||
ancrt=m.an
|
||||
luncrt=m.nl
|
||||
firmcrt=nfscurt
|
||||
|
||||
|
||||
select 0
|
||||
use &calefirma\datean\calendar.dbf again alias calendar
|
||||
SELE CALENDAR
|
||||
scan for !deleted()
|
||||
date = calefirma+'\an'+an+'\date'+nl
|
||||
*SELECT 0
|
||||
*if !file('&DATE\mf.dbf')
|
||||
* copy file &dirgen\mfix2000\date\*.* to &date\*.*
|
||||
*endif
|
||||
*wait wind date
|
||||
endscan
|
||||
|
||||
sele 0
|
||||
use &DIRGEN\imob2003\datE\sitmf.dbf EXCLUSIVE ALIAS SITMF
|
||||
ZAP
|
||||
|
||||
|
||||
SELE CALENDAR
|
||||
scan for !deleted() &&____________
|
||||
|
||||
scatter memvar
|
||||
date = calefirma+'\an'+m.an+'\date'+m.nl
|
||||
*wait wind date
|
||||
if file('&DATE\mf.dbf')
|
||||
select 0
|
||||
use &DATE\mf.dbf again alias mf
|
||||
set filter to !casat
|
||||
*_calc uzura______________________________
|
||||
STORE 0 TO L,A,UZ
|
||||
NRL=VAL(M.NL)
|
||||
NRA=VAL(M.AN)
|
||||
SELE MF
|
||||
SCAN
|
||||
L=MONTH(DATAPIF)
|
||||
A=YEAR(DATAPIF)
|
||||
UZ=IIF(NRA<A,0,12*(NRA-A)+NRL-L)
|
||||
REPL UZURA WITH UZ+uzuraprec
|
||||
ENDSCAN
|
||||
*_scriu in sitmf______________________________
|
||||
for i=1 to 6
|
||||
t='sum amortlun to m.r_212' +str(i,1)+' for left(scd,4) = "212'+str(i,1)+'" '
|
||||
&t
|
||||
t='sum amorttot to m.t_212' +str(i,1)+' for left(scd,4) = "212'+str(i,1)+'" '
|
||||
&t
|
||||
t='sum VALOARE to m.V_212' +str(i,1)+' for left(scd,4) = "212'+str(i,1)+'" '
|
||||
&t
|
||||
t='sum VALOARE to m.Vr_212' +str(i,1)+' for month(dataact)=val(m.nl) and left(scd,4) = "212'+str(i,1)+'" '
|
||||
&t
|
||||
next
|
||||
sele sitmf
|
||||
appe blank
|
||||
gather memvar
|
||||
SELE MF
|
||||
USE
|
||||
endif
|
||||
endscan &&___________
|
||||
|
||||
|
||||
m.an=ancrt
|
||||
m.nl=luncrt
|
||||
nfscurt=firmcrt
|
||||
|
||||
|
||||
do totv
|
||||
422
Programe/Vechi/totv.prg
Normal file
422
Programe/Vechi/totv.prg
Normal file
@@ -0,0 +1,422 @@
|
||||
|
||||
DIRFIRM=LOC+'\'+NFSCURT
|
||||
If !Directory('&dirfirm\tempo')
|
||||
Md &DIRFIRM\tempo
|
||||
Endif
|
||||
|
||||
If !Directory('&CALEFIRMA')
|
||||
Do MESAJrosu With 'Calea '+CALEFIRMA+' este incorecta!','Sugeram iesirea din program.'
|
||||
Quit
|
||||
Retry
|
||||
Endif
|
||||
|
||||
Date=CALEFIRMA+'\AN'+m.an+'\DATE'+M.nl
|
||||
DATEAN=CALEFIRMA+'\DATEAN'
|
||||
CALET=DIRFIRM+'\TEMPO'
|
||||
m.ANTET='S.C. '+M.FLUNG
|
||||
Wait ' ' Timeout 0.01
|
||||
Close Database all
|
||||
|
||||
|
||||
|
||||
|
||||
***------------------------------------------------------------------
|
||||
DO DESCHIDPROG && DESCHID FISTOTV
|
||||
|
||||
***------------------------------------------------------------------
|
||||
DO scanez_fistotv IN totv.prg
|
||||
|
||||
***------------------------------------------------------------------
|
||||
|
||||
Return
|
||||
***---------------------------------------------------------------------------------------------------
|
||||
PROCEDURE scanez_fistotv
|
||||
|
||||
LOCAL loFis
|
||||
|
||||
glVerificTabel=.T.
|
||||
|
||||
DO des WITH "OPTIUNIS"
|
||||
SELECT OPTIUNIS
|
||||
LOCATE FOR UPPER(OPTIUNE)="VERIFIC TABELE"
|
||||
IF !FOUND()
|
||||
IF FLOCK()
|
||||
APPEND BLANK
|
||||
REPLACE optiune WITH "VERIFIC TABELE"
|
||||
REPLACE da WITH glVerificTabel
|
||||
UNLOCK
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
glVerificTabel=da
|
||||
|
||||
IF USED('optiuniS')
|
||||
USE IN optiuniS
|
||||
ENDIF
|
||||
|
||||
******************************** verific daca exista nomenclatorul propriu de gestiuni
|
||||
LOCAL lcsepar
|
||||
STORE .f. to lcsepar
|
||||
lcFisGest = ADDBS(datean) + 'numegestmf.dbf'
|
||||
IF !FILE(lcfisgest)
|
||||
lcsepar = .t.
|
||||
ENDIF
|
||||
********************************
|
||||
|
||||
SELE fistotv
|
||||
MAXS=RECCOUNT()
|
||||
OP=CREA('PROGRESBAR')
|
||||
OP.titlu.CAPTION='Se pregatesc datele lunii '+m.nl+' '+m.an
|
||||
OP.SHOW()
|
||||
j=0
|
||||
SCAN FOR !EMPTY(numeF)
|
||||
SCAT NAME loFis
|
||||
*** deschid tabelul si tratez erorile la deschidere
|
||||
DO deschidf WITH loFis.calealfa,loFis.cale,loFis.numeF,loFis.ALIAS,loFis.ordine,loFis.exc
|
||||
|
||||
*** compar tabelul cu structura sa vida
|
||||
IF glVerificTabel
|
||||
DO verific_tabel WITH loFis.calealfa,loFis.cale,loFis.numeF,loFis.ALIAS IN totv.prg
|
||||
ENDIF
|
||||
|
||||
DO PR WITH j
|
||||
ENDSCAN
|
||||
IF TYPE('op')='O'
|
||||
OP.RELEASE
|
||||
ENDIF
|
||||
|
||||
RELEASE loFis
|
||||
|
||||
IF lcsepar
|
||||
lcFisVechi = ADDBS(datean)+ 'numegest.dbf'
|
||||
SELECT numegest
|
||||
APPEND FROM (lcFisVechi)
|
||||
DELETE from numegest WHERE gest # -1 AND gest NOT in (sele distinct gest FROM mf)
|
||||
ENDIF
|
||||
|
||||
ENDPROC && scanez_fistotv
|
||||
|
||||
|
||||
***---------------------------------------------------------------------------------------------------
|
||||
PROCEDURE deschidf
|
||||
PARAM tcCalealfa,tcCale,tcNumeF,tcAlias,tcOrdine,tcExc
|
||||
|
||||
LOCAL lcCaleAlfa,lcCale,LCALIAS,lcNumef,lcDBFc,lcDBFs,lcCDXc,lcCDXs,lcTablec,lcTables
|
||||
|
||||
lcCaleAlfa=ALLTRIM(tcCalealfa) && calea catre structura vida a tabelului
|
||||
lcCale=ALLTRIM(tcCale) && calea catre tabel
|
||||
LCALIAS=UPPER(ALLTRIM(tcAlias)) && alias-ul din <FISTOTV>
|
||||
lcNumef=UPPER(ALLTRIM(tcNumeF)) && numele fisierului din <FISTOTV>
|
||||
lcOrdine=ALLTRIM(tcOrdine)
|
||||
lcExc=ALLTRIM(tcExc)
|
||||
|
||||
lcDBFc=lcCale+'\'+lcNumef+'.dbf'
|
||||
lcDBFs=lcCaleAlfa+'\'+lcNumef+'.dbf'
|
||||
|
||||
lcTablec=lcCale+'\'+lcNumef+'.*'
|
||||
lcTables=lcCaleAlfa+'\'+lcNumef+'.*'
|
||||
|
||||
|
||||
|
||||
PRIVATE lcOldError
|
||||
lcOldError=ON("error")
|
||||
|
||||
IF !FILE('&lcDBFc')
|
||||
IF INLIST(lcNumef,'ACT','RULL')
|
||||
DO danuquit WITH 'Nu exista fisierul "'+ALLT(lcDBFc)+'". Il inlocuim cu o structura vida?'
|
||||
ENDIF
|
||||
IF FILE('&lcDBFs')
|
||||
COPY FILE ('&lcTables') TO ('&lcTablec')
|
||||
ELSE
|
||||
DO MESAJrosu WITH 'Nu exista structura vida a fisierului "'+lcNumef+'".','Sugeram iesirea din program.'
|
||||
QUIT
|
||||
RETRY
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
|
||||
|
||||
|
||||
*!* *** AFLU DACA FISIERUL ARE REFERINTA CATRE UN CDX
|
||||
llcdx=.F.
|
||||
IF !EMPTY(lcOrdine)
|
||||
llcdx=.T.
|
||||
ENDIF
|
||||
|
||||
llUsed=.F.
|
||||
IF USED(LCALIAS)
|
||||
llUsed=.T.
|
||||
USE IN (LCALIAS)
|
||||
ENDIF
|
||||
filehandle=FOPEN('&lcDBFc',10) && Open the file
|
||||
IF filehandle > 0
|
||||
*!* WAIT WINDOW 'Fopen '+LCALIAS NOWA
|
||||
=FSEEK(filehandle, 28,0) && Move pointer before 29th byte
|
||||
cdxbyte = ASC(FGETS(filehandle,1)) && read byte 29
|
||||
IF cdxbyte % 2 = 1 && test if it has a cdx
|
||||
llcdx=.T.
|
||||
ENDIF
|
||||
|
||||
FCLOSE(filehandle)
|
||||
IF llUsed
|
||||
DO des WITH LCALIAS
|
||||
ENDIF
|
||||
ENDIF
|
||||
*!* ***--------------------------------
|
||||
|
||||
SELECT 0
|
||||
lccommand=[USE "]+lcDBFc+[" ]+ALLTRIM(lcExc)+[ AGAIN ALIAS ]+LCALIAS+IIF(llcdx," order 1","")
|
||||
|
||||
ON ERROR DO errdeschid WITH lcCaleAlfa,lcCale,lcNumef,LCALIAS,ERROR(),MESSAGE(),PROGRAM()
|
||||
|
||||
&lccommand
|
||||
|
||||
|
||||
|
||||
|
||||
IF !EMPTY(lcOrdine)
|
||||
IF USED(LCALIAS)
|
||||
SELECT (LCALIAS)
|
||||
SET ORDER TO TAG &lcOrdine && "VAL(NRCRT)"
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
ON ERROR &lcOldError
|
||||
|
||||
ENDPROC && deschidf
|
||||
|
||||
|
||||
|
||||
*______________________
|
||||
PROC errdeschid
|
||||
PARAM tcCalealfa,tcCale,tcNumeF,tcAlias,tnError,tcmessage,tcprogram
|
||||
|
||||
PRIVATE lcCaleAlfa,lcCale,LCALIAS,lcNumef,lcDBFc,lcDBFs,lcCDXc,lcCDXs,lcTablec,lcTables
|
||||
|
||||
lcCaleAlfa=ALLTRIM(tcCalealfa) && calea catre structura vida a tabelului
|
||||
lcCale=ALLTRIM(tcCale) && calea catre tabel
|
||||
LCALIAS=UPPER(ALLTRIM(tcAlias)) && alias-ul din <FISTOTV>
|
||||
lcNumef=UPPER(ALLTRIM(tcNumeF)) && numele fisierului din <FISTOTV>
|
||||
|
||||
lcDBFc=lcCale+'\'+lcNumef+'.dbf'
|
||||
lcCDXc=lcCale+'\'+lcNumef+'.cdx'
|
||||
lcDBFs=lcCaleAlfa+'\'+lcNumef+'.dbf'
|
||||
lcCDXs=lcCaleAlfa+'\'+lcNumef+'.cdx'
|
||||
|
||||
lcTablec=lcCale+'\'+lcNumef+'.*'
|
||||
lcTables=lcCaleAlfa+'\'+lcNumef+'.*'
|
||||
|
||||
|
||||
|
||||
DO MESAJ WITH 'Fisier: '+ALLTRIM(lcNumef)+" Eroarea nr. "+ALLTRIM(STR(tnError)),tcmessage+" "+tcprogram
|
||||
|
||||
|
||||
&& de aici nu mai procesez erorile
|
||||
PRIVATE lcOldError
|
||||
lcOldError=ON("error")
|
||||
ON ERROR *
|
||||
&&
|
||||
|
||||
DO CASE
|
||||
|
||||
CASE INLIST(tnError,5,19,26,114,1707,1683)&&Index file does not match table. sau Table has no index order set
|
||||
DO mesajatent WITH 'Se reindexeaza fisierul "'+lcNumef+'"',''
|
||||
|
||||
IF FILE('&lcCDXs') AND lcCale#lcCaleAlfa
|
||||
&& inchid tabelul
|
||||
IF USED(LCALIAS) && fisierul trebuie sa fie inchis ca sa pot sa fac append din el in structura vida si sa-l redenumesc
|
||||
USE IN (LCALIAS)
|
||||
ENDIF
|
||||
|
||||
&& reindexez
|
||||
DO REINDFCDX WITH lcCaleAlfa,lcCale,lcNumef IN reindexare.prg
|
||||
|
||||
&& deschid din nou tabelul reindexat
|
||||
DO des WITH LCALIAS
|
||||
|
||||
|
||||
ELSE && nu exista indexul (.cdx) in structurile vide sau e un fisier din alfa
|
||||
DO MESAJrosu WITH 'Nu se poate reindexa fisierul "'+ALLT(lcNumef)+'".','Sugeram iesirea din program.'
|
||||
QUIT
|
||||
RETRY
|
||||
ENDIF
|
||||
|
||||
CASE INLIST(tnError,15,41) &&Not a table, memo file missing or invalid
|
||||
DO danuquit WITH 'Fisierul "'+lcNumef+'" este defect. Il inlocuim cu o structura vida/standard?'
|
||||
|
||||
&& inchid tabelul
|
||||
llUsed=.F.
|
||||
|
||||
IF USED(LCALIAS) && fisierul trebuie sa fie inchis ca sa pot sa fac append din el in structura vida si sa-l redenumesc
|
||||
llUsed=.T.
|
||||
USE IN (LCALIAS)
|
||||
ENDIF
|
||||
|
||||
&& fac backup
|
||||
lcFisS=lcTablec
|
||||
lcFisD=lcCale+'\'+"bk_"+STRTRAN(DTOC(DATE()),"/","")+"_%"+lcNumef+'.*'
|
||||
COPY FILE ('&lcFisS') TO ('&lcFisD')
|
||||
|
||||
&& copiez structura vida
|
||||
IF FILE('&lcDBFs')
|
||||
COPY FILE ('&lcTables') TO ('&lcTablec')
|
||||
RETRY
|
||||
ELSE
|
||||
DO MESAJrosu WITH 'Nu exista structura vida a fisierului <'+lcNumef+'>.','Sugeram iesirea din program.'
|
||||
QUIT
|
||||
RETRY
|
||||
ENDIF
|
||||
|
||||
&& deschid fisierul
|
||||
|
||||
DO des WITH LCALIAS
|
||||
|
||||
|
||||
CASE INLIST(tnError,3,1705) &&File is in use. or File access is denied.
|
||||
|
||||
DO MESAJrosu WITH 'Fisierul "'+lcNumef+'" este deschis de alt program.','Inchideti fisierul si apoi redeschideti programul.'
|
||||
QUIT
|
||||
RETRY
|
||||
|
||||
OTHERWISE
|
||||
|
||||
DO MESAJrosu WITH 'Eroare necunoscuta (Nr.'+ALLT(STR(tnError))+')', 'Sugeram iesirea din program.'
|
||||
QUIT
|
||||
RETRY
|
||||
ENDCASE
|
||||
|
||||
ENDPROC && ErrDeschid
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
*____________________
|
||||
PROCEDURE errgen
|
||||
DO MESAJrosu WITH 'Eroare necunoscuta (Nr.'+ALLT(STR(ERROR()))+')', 'Sugeram iesirea din program.'
|
||||
QUIT
|
||||
RETRY
|
||||
ENDPROC && errgen
|
||||
|
||||
|
||||
|
||||
*___ PROCEDURA DE DESCHIDERE DIN AFARA LUI TOTV_________________________________________________
|
||||
PROCEDURE des
|
||||
PARAM tcAlias
|
||||
|
||||
PRIVATE lcAlias
|
||||
|
||||
|
||||
LCALIAS=UPPER(ALLTRIM(tcAlias))
|
||||
|
||||
IF !DIRECTORY('&CALEFIRMA')
|
||||
DO MESAJrosu WITH 'Calea '+CALEFIRMA+' este incorecta!','Sugeram iesirea din program.'
|
||||
QUIT
|
||||
RETRY
|
||||
ENDIF
|
||||
*DATE=CALEFIRMA+'\AN'+M.an+'\DATE'+M.nl
|
||||
|
||||
IF !USED('FISTOTV')
|
||||
DO DESCHIDPROG && DESCHID FISTOTV
|
||||
ENDIF
|
||||
|
||||
|
||||
|
||||
SELE fistotv
|
||||
LOCA FOR ALLT(UPPER(ALIAS))==LCALIAS
|
||||
IF !FOUND()
|
||||
DO MESAJrosu WITH 'Alias '+LCALIAS+' inexistent!','Sugeram iesirea din program.'
|
||||
QUIT
|
||||
RETRY
|
||||
ELSE
|
||||
SCAT NAME loFis
|
||||
DO deschidf WITH loFis.calealfa,loFis.cale,loFis.numeF,loFis.ALIAS,loFis.ordine,loFis.exc
|
||||
RELEASE loFis
|
||||
|
||||
ENDIF
|
||||
|
||||
ENDPROC && DES
|
||||
|
||||
|
||||
|
||||
*------------------------------------------------
|
||||
PROCEDURE orori
|
||||
DO MESAJ WITH "Contactati firma Romfast",""
|
||||
QUIT
|
||||
RETRY
|
||||
ENDPROC && orori
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
***---------------------------------------------------------------------------------------------------
|
||||
PROCEDURE verific_tabel
|
||||
PARAMETERS tcCalealfa,tcCale,tcNumeF,tcAlias
|
||||
|
||||
PRIVATE lcCaleAlfa,lcCale,LCALIAS,lcNumef,lcFisierAlfa,lcFisierFirma
|
||||
|
||||
lcCaleAlfa=ALLTRIM(tcCalealfa) && calea catre structura vida a tabelului
|
||||
lcCale=ALLTRIM(tcCale) && calea catre tabel
|
||||
LCALIAS=UPPER(ALLTRIM(tcAlias)) && alias-ul din <FISTOTV>
|
||||
lcNumef=UPPER(ALLTRIM(tcNumeF)) && numele fisierului din <FISTOTV>
|
||||
|
||||
lcFisierAlfa=ALLTRIM(tcCalealfa)+"\"+ALLTRIM(tcNumeF)+".dbf"
|
||||
lcFisierFirma=DBF(LCALIAS)
|
||||
|
||||
|
||||
IF UPPER(ALLTRIM(lcCale))=UPPER(ALLTRIM(lcCalealfa)) && nu verific tabelele care nu au structura vida
|
||||
RETURN
|
||||
ENDIF
|
||||
* WAIT WINDOW "Se verifica "+lcAlias NOWAIT
|
||||
lnCompar=compara_tabele(LCALIAS,lcFisierAlfa)
|
||||
|
||||
DO CASE
|
||||
CASE lnCompar=0 && OK
|
||||
*
|
||||
CASE lnCompar = 1 && structura vida nu exista
|
||||
*
|
||||
CASE INLIST(lnCompar, 2, 3, 4) && coloane diferite, taguri diferite
|
||||
|
||||
llUsed=.F.
|
||||
IF USED(LCALIAS)
|
||||
llUsed=.T.
|
||||
USE IN (LCALIAS)
|
||||
ENDIF
|
||||
|
||||
x=FOPEN(lcFisierFirma,12)
|
||||
|
||||
IF x<0 && daca nu pot sa il deschid exclusiv
|
||||
DO MESAJ WITH "Fisierul "+lcFisierFirma+" ("+ALLTRIM(STR(lnCompar))+")"," Trebuie reindexat."
|
||||
ELSE
|
||||
FCLOSE(x)
|
||||
DO DASAUNU WITH "Se reindexeaza fisierul "+lcFisierFirma+" ("+ALLTRIM(STR(lnCompar))+")?"
|
||||
IF buton=1
|
||||
IF INLIST(lnCompar, 2, 4) && coloane diferite
|
||||
DO REINDF WITH lcCalealfa,lcCale,lcNumeF,lcAlias IN reindexare.prg
|
||||
ELSE && taguri diferite
|
||||
DO REINDFCDX WITH lcCalealfa,lcCale,lcNumeF IN reindexare.prg
|
||||
ENDIF
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
|
||||
DO des WITH tcAlias
|
||||
|
||||
ENDCASE
|
||||
|
||||
ENDPROC && verific_tabel
|
||||
|
||||
***--------------------------------------------------------------------------
|
||||
PROCEDURE DESCHIDPROG
|
||||
|
||||
local lcAlias, lcFis, lcDir
|
||||
lcDir = ADDBS(gcAppPath)+[date\datean]
|
||||
lcFis = [fistotvmf]
|
||||
lcAlias = [fistotv]
|
||||
|
||||
Do deschidf With lcDir,lcDir,lcFis,lcAlias,'CALE',''
|
||||
|
||||
ENDPROC && deschidprog
|
||||
44
Programe/Vechi/totvMF.prg
Normal file
44
Programe/Vechi/totvMF.prg
Normal file
@@ -0,0 +1,44 @@
|
||||
CLOSE DATABASE
|
||||
|
||||
SELECT 0
|
||||
USE &dirgen\lunilean.dbf;
|
||||
AGAIN ALIAS lunilean ;
|
||||
ORDER TAG "nl"
|
||||
|
||||
SELECT 0
|
||||
USE &dirgen\firma.dbf;
|
||||
AGAIN ALIAS firma ;
|
||||
ORDER TAG "firma"
|
||||
|
||||
DIRFIRM=DIRGEN+NFSCURT
|
||||
DATEAN=DIRFIRM+'\DATEAN'
|
||||
CALET=DIRFIRM+'\TEMPO'
|
||||
|
||||
SELECT 0
|
||||
USE &datEAN\CALENDAR.dbf;
|
||||
AGAIN ALIAS CALENDAR
|
||||
|
||||
date=DIRFIRM+'\AN'+m.an+'\DATE'+M.nl
|
||||
|
||||
|
||||
SELECT 0
|
||||
USE &date\act.dbf;
|
||||
AGAIN ALIAS act ;
|
||||
ORDER TAG "dataireg"
|
||||
|
||||
SELECT 0
|
||||
USE &dateAN\actAN.dbf;
|
||||
AGAIN ALIAS actAN ;
|
||||
ORDER TAG "COD"
|
||||
|
||||
SELECT 0
|
||||
USE &dateAN\NUMEGEST.dbf;
|
||||
AGAIN ALIAS NUMEGEST ;
|
||||
ORDER TAG "NUMEGEST"
|
||||
|
||||
SELECT 0
|
||||
USE &date\respons.dbf;
|
||||
AGAIN ALIAS respons ;
|
||||
ORDER TAG "nume_2"
|
||||
|
||||
return
|
||||
69
Programe/Vechi/totvV.prg
Normal file
69
Programe/Vechi/totvV.prg
Normal file
@@ -0,0 +1,69 @@
|
||||
CLOSE DATABASE
|
||||
|
||||
SELECT 0
|
||||
USE &dirgen\_ALFA\DATEAN\lunilean.dbf;
|
||||
AGAIN ALIAS lunilean ;
|
||||
ORDER TAG "nl"
|
||||
|
||||
SELECT 0
|
||||
USE &dirgen\firma.dbf;
|
||||
AGAIN ALIAS firma ;
|
||||
ORDER TAG "firma"
|
||||
|
||||
DIRFIRM=DIRGEN+NFSCURT
|
||||
DATEAN=calefirma+'\DATEAN'
|
||||
CALET=DIRFIRM+'\TEMPO'
|
||||
|
||||
SELECT 0
|
||||
USE &datEAN\CALENDAR.dbf;
|
||||
AGAIN ALIAS CALENDAR
|
||||
|
||||
date=calefirma+'\AN'+m.an+'\DATE'+M.nl
|
||||
|
||||
|
||||
*daca fisierele specifice nu sunt in baza de date?_____
|
||||
set defa to &date
|
||||
if !file('mf.dbf')
|
||||
do deschid
|
||||
* do redeschid
|
||||
endif
|
||||
|
||||
SELECT 0
|
||||
USE &date\mf.dbf;
|
||||
AGAIN ALIAS mf
|
||||
|
||||
SELECT 0
|
||||
USE &dirgen\mfix2000\date\NORMA.dbf;
|
||||
AGAIN ALIAS NORMA
|
||||
|
||||
*_______________________________________________________
|
||||
|
||||
SELECT 0
|
||||
USE &date\act.dbf;
|
||||
AGAIN ALIAS act ;
|
||||
ORDER TAG "dataireg"
|
||||
|
||||
SELECT 0
|
||||
USE &dateAN\actAN.dbf;
|
||||
AGAIN ALIAS actAN ;
|
||||
ORDER TAG "COD"
|
||||
|
||||
SELECT 0
|
||||
USE &dateAN\NUMEGEST.dbf;
|
||||
AGAIN ALIAS NUMEGEST ;
|
||||
ORDER TAG "NUMEGEST"
|
||||
|
||||
SELECT 0
|
||||
USE &date\respons.dbf;
|
||||
AGAIN ALIAS respons ;
|
||||
ORDER TAG "nume_2"
|
||||
|
||||
SELECT 0
|
||||
USE &dirgen\mfix2000\help\helpmenu.dbf;
|
||||
AGAIN ALIAS helpmenu
|
||||
|
||||
SELECT 0
|
||||
USE &dirgen\mfix2000\help\helpleg.dbf;
|
||||
AGAIN ALIAS helpleg
|
||||
|
||||
return
|
||||
Reference in New Issue
Block a user