romfast/roaimob
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial: flux text FoxBin2Prg (git urmareste .??2 in-arbore, binarele VFP git-ignored)

Browse Source 
Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
Marius Mutu
2026-07-16 11:37:36 +03:00
commit 34aed0c4d7
236 changed files with 145556 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
Programe/Vechi/DATAPIF.PRG Normal file
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View File

File diff suppressed because it is too large Load Diff

1209
Programe/Vechi/proceduri.prg Normal file
View File

File diff suppressed because it is too large Load Diff

340
Programe/Vechi/quitapp.prg Normal file
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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

53
Programe/ofunctii_imob.prg Normal file
View File

@@ -0,0 +1,53 @@
Function verificare_luna_inchisa
Parameters tcMesaj
lcMesaj=tcMesaj+",deoarece luna este inchisa!"
If glLunaInchisa
aMessagebox(lcMesaj,0+48,"Luna inchisa")
Return .F.
Endif
Return .T.
Endfunc && verificare_luna_inchisa
*************************************************************************************************************
Function get_prima_zi
PARAMETERS tnAn, tnLuna
LOCAL lnAn, lnLuna
STORE 0 TO lnAn, lnLuna
IF EMPTY(tnAn) OR TYPE('tnAn') # 'N'
lnAn = gnAn
ELSE
lnAn = tnAn
ENDIF
IF EMPTY(tnLuna) OR TYPE('tnLuna') # 'N'
lnLuna = gnLuna
ELSE
lnLuna = tnLuna
ENDIF
Return Date(lnAn,lnLuna,1)
Endfunc && get_prima_zi
*************************************************************************************************************
Function get_ultima_zi
PARAMETERS tnAn, tnLuna
LOCAL lnAn, lnLuna
STORE 0 TO lnAn, lnLuna
IF EMPTY(tnAn) OR TYPE('tnAn') # 'N'
lnAn = gnAn
ELSE
lnAn = tnAn
ENDIF
IF EMPTY(tnLuna) OR TYPE('tnLuna') # 'N'
lnLuna = gnLuna
ELSE
lnLuna = tnLuna
ENDIF
Return Gomonth(Date(lnAn,lnLuna,1),1)-1
Endfunc && get_ultima_zi
*************************************************************************************************************

613
Programe/oproceduri_imob.prg Normal file
View File

@@ -0,0 +1,613 @@
*!* 11.11.2009
*!* marius.mutu
*!* alocare, dezalocare numere inventar
*!* 18.10.2021
*!* marius.mutu
*!* preluare_imob, verificare_balanta se verifica contul 303 in functie de optiunea IMOB_OBI
#Define CRLF Chr(13) + Chr(10)
Procedure viz_jurnal
Local lcFiltru, lcFiltruOriginal, lcGroup, lcOrder, lcSchema, lcSelect, llAfisare, llModParam
PRIVATE poLista
Store '' To poLista
Store '' To ofrmviz
If Used('crsjurnal')
Use In crsjurnal
Endif
lcSchema = []
lcSelect = [select * from imob_vjurnal2]
lcOrder = [denumire,id_mf,id_operatie_mf]
lcFiltru = [1=2]
lcFiltruOriginal = []
llModParam = .T.
lcGroup = []
llAfisare = .F.
gencursor('poLista', 'crsjurnal', lcSelect, lcFiltru, lcSchema, lcOrder, llAfisare, lcGroup, llModParam, lcFiltruOriginal)
poLista.ca_baza1.afisare()
Select crsjurnal
ofrmviz = Createobject('frm_jurnal')
ofrmviz.Show(1)
Release ofrmviz, poLista
If Used('crsjurnal')
Use In crsjurnal
Endif
Endproc && viz_jurnal
*************************************************************************************************************
Procedure introducere_imob_corp
Lparameters toMF
Local lnButon
lnButon = 2
lnButon = introducere_imob(1, toMF)
Return lnButon
Endproc && introducere_imob_corp
*************************************************************************************************************
Procedure introducere_imob_necorp
Lparameters toMF
Local lnButon
lnButon = 2
lnButon = introducere_imob(2, toMF)
Return lnButon
Endproc && introducere_imob_necorp
*************************************************************************************************************
Procedure introducere_imob
Parameters tnTip, toMF
&& tnTip: 1 = corporale; 2 = necorporale
&& toMF - folosit la preluarea din contabilitate - vine completat cu nract, dataact, valoare
Private pnButon
Local lcMesaj, lnRaspuns
Store '' To ofrmintro
lcMesaj = "Nu puteti face introduceri"
If !verificare_luna_inchisa(lcMesaj)
Return
Endif
= cctipuri_amort()
= update_cote_TVA()
lnRaspuns = 6
pnButon = 1
*!* 11.11.2009
Local lnRezultat, lnIdTipDocNrInv
Private poGeneratorNumere
lnIdTipDocNrInv = 18
poGeneratorNumere = Createobject('oGeneratorNumere')
*!* 11.11.2009 ^
Do While lnRaspuns = 6 And pnButon = 1
*!* 11.11.2009
poGeneratorNumere.ResetAll()
lnRezultat = poGeneratorNumere.creeaza_cursor_serii(m.lnIdTipDocNrInv)
*!* 11.11.2009 ^
ofrmintro = Createobject('frm_introducere', tnTip, 1, toMF)
ofrmintro.Show(1)
Release ofrmintro
If pnButon = 1
lnRaspuns = aMESSAGEBOX("Doriti sa continuati introducerile?", 4 + 32, "Confirmare")
Else
*!* 11.11.2009
poGeneratorNumere.dezaloca_numere()
*!* 11.11.2009 ^
Endif
Enddo
If Used('v_tipuri_amort')
Use In v_tipuri_amort
Endif
*!* modificare v 2.0.18
If Used('cote_TVA')
Use In cote_TVA
Endif
*!* modificare v 2.0.18 ^
Return pnButon
Endproc && introducere_imob
*************************************************************************************************************
Procedure introducere_imob_in_curs
Lparameters toMF
&& toMF - folosit la preluarea din contabilitate - vine completat cu nract, dataact, valoare
Private pnButon
Local lcMesaj, lnRaspuns
Store '' To ofrmintroc
lcMesaj = "Nu puteti face introduceri"
If !verificare_luna_inchisa(lcMesaj)
Return
Endif
lnRaspuns = 6
pnButon = 1
*!* 11.11.2009
Local lnRezultat, lnIdTipDocNrInv
Private poGeneratorNumere
lnIdTipDocNrInv = 18
poGeneratorNumere = Createobject('oGeneratorNumere')
*!* 11.11.2009 ^
Do While lnRaspuns = 6 And pnButon = 1
*!* 11.11.2009
poGeneratorNumere.ResetAll()
lnRezultat = poGeneratorNumere.creeaza_cursor_serii(m.lnIdTipDocNrInv)
*!* 11.11.2009 ^
ofrmintroc = Createobject('frm_introducere_curs', .F., toMF)
ofrmintroc.Show(1)
Release ofrmintroc
If pnButon = 1
lnRaspuns = aMESSAGEBOX("Doriti sa continuati introducerile?", 4 + 32, "Confirmare")
Else
*!* 11.11.2009
poGeneratorNumere.dezaloca_numere()
*!* 11.11.2009 ^
Endif
Enddo
Return pnButon
Endproc && introducere_imob_in_curs
*************************************************************************************************************
Procedure preluare_imob
Lparameters tnTip
Local lcSql, lcCondSucursala, lnSucces, llSucces, lcFiltru, llExperimental, llImobObiecteInventar
Private pdDataI, pdDataF, pcCond, pnFiscala
pdDataI = Date(gnAn, gnLuna, 1)
pdDataF = pdDataI
pcCond = []
pnFiscala = 0
llImobObiecteInventar = (TYPE('gnIMOB_OBI') = 'N' and m.gnIMOB_OBI = 1)
lcCondSucursala = Strtran(gcCondSucursala, "id_sucursala", "a.id_sucursala", 1, 1, 1)
&& SELECTIE DIN ACT PENTRU CONTURILE IMOBILIZARI CORPORALE/NECORPORALE/CURS
Text To lcSql Textmerge Noshow
SELECT dataact,
nract,
scd as cont,
max(P.DENUMIRE) as part,
max(explicatia) as explicatia,
sum(suma) as suma_act,
Cast(0 as number(18,4)) as suma_imob
FROM ACT A
JOIN IMOB_CONTURI I ON A.SCD = I.CONT AND I.ID_TIP_IMOBILIZARE = <<tnTip>> <<IIF(!m.llImobObiecteInventar, [ and i.cont <> '303'], [])>>
LEFT JOIN NOM_PARTENERI P ON A.ID_PARTC = P.ID_PART
WHERE A.STERS = 0 AND A.AN = <<m.gnAn>> AND A.LUNA = <<m.gnLuna>> <<m.lcCondSucursala>> <<Iif(m.tnTip <> 3, [ AND A.SCC NOT IN (SELECT CONT FROM IMOB_CONTURI WHERE ID_TIP_IMOBILIZARE = 3)], [])>>
group by dataact, nract, scd
Endtext
lnSucces = goExecutor.oExecute(lcSql, "cListaAct")
If lnSucces < 0
aMESSAGEBOX(goExecutor.cEroare, 0 + 16, "Eroare")
Return
Endif
lcCursor = 'crsImobPreluare'
If tnTip = 3 && IMOBILIZARI IN CURS
lcSel = [select 3 as id_tip_imobilizare, 0 as iesit_din_gest, cont, nract,data_achizitie, valoare ] + ;
[ from imob_vlista_curs WHERE TO_CHAR(DATA_ACHIZITIE,'MM/YYYY') = '] + Padl(gnLuna, 2, '0') + '/' + Padl(gnAn, 4, '0') + ['] + gcCondSucursala
llSucces = goExecutor.oExecuta(lcSel, lcCursor)
ELSE
llExperimental = .T. && 25.11.2021 llExperimental = (goApp.nExperimental = 1)
If m.llExperimental
* EXPERIMENTAL SELECTIE DIN IMOB_VSITUATIE_LUNARA IN LOC DE PACK_IMOB.CALCUL_SITUATIE_LUNARA()
* Setez luna pentru view
lcFiltru = [id_tip_imobilizare = ] + ALLTRIM(STR(m.tnTip)) + m.gcCondSucursala
llSucces = goExecutor.oExecuta('begin pack_imob.setlunacurenta(?pdDataI); end;')
IF m.llSucces
lcSel = [SELECT * FROM ] + IIF(m.pnFiscala = 0, [imob_vsituatie_lunara], [imobf_vsituatie_lunara]) + [ WHERE ] + m.lcFiltru
llSucces = goExecutor.oExecuta(m.lcSel, m.lcCursor)
ENDIF
ELSE
lcSel = [{call pack_imob.CALCUL_SITUATIE_LUNARA(?pdDataI,?pdDataF,?pcCond,?pnFiscala,?gnIdSucursala)}]
llSucces = goExecutor.oExecuta(lcSel, lcCursor)
ENDIF
Endif
If m.llSucces
Select Cont, nract, data_achizitie, Sum(valoare) As valinv ;
From crsImobPreluare ;
Where ID_TIP_IMOBILIZARE = tnTip And iesit_din_gest = 0 And ;
Year(data_achizitie) * 12 + Month(data_achizitie) = m.gnAn * 12 + m.gnLuna ;
Group By Cont, nract, data_achizitie ;
Into Cursor cListaImob
Use In (Select('crsImobPreluare'))
Select tnTip As tip, Ttod(a.dataact) As dataact, a.nract, a.Part, a.Cont, a.explicatia, a.suma_act, Nvl(i.valinv, Cast(0 As N(18, 4))) As suma_imob, (a.suma_act = Nvl(i.valinv, 0)) As introdus ;
From cListaAct a Left Join cListaImob i On a.nract = i.nract And ;
Ttod(a.dataact) = Ttod(i.data_achizitie) And ALLTRIM(a.Cont) == ALLTRIM(i.Cont) ;
Order By 1, 2, 3 ;
Into Cursor crsPreluare Readwrite
Use In (Select('cListaImob'))
Use In (Select('cListaAct'))
loFrmPreluare = Createobject("frm_preluare")
loFrmPreluare.Show(1)
Use In (Select('crsPreluare'))
Endif
Endproc && preluare_imob
*************************************************************************************************************
Procedure vizualizare_lista_imob_corp
Parameters tnFiscala
vizualizare_lista_imob(1, tnFiscala)
Endproc && vizualizare_lista_imob_necorp
*************************************************************************************************************
Procedure vizualizare_lista_imob_necorp
Parameters tnFiscala
vizualizare_lista_imob(2, tnFiscala)
Endproc && vizualizare_lista_imob_necorp
*************************************************************************************************************
Procedure vizualizare_lista_imob
Parameters tnTip, tnFiscala
****
* 1) imob.corporale
* 2) imob.necorporale
****
Private poLista, pcSchema, pcSelect, pcOrder, pdDataI, pdDataF, pcCond, pnFiscala
Local lcFiltru, llSucces, llExperimental
poLista = NUll
llExperimental = .T. && 25.11.2021 llExperimental = (goApp.nExperimental = 1)
Use In (SELECT('crslista'))
pdDataI = Date(gnAn, gnLuna, 1)
pdDataF = pdDataI
*pcCond = [id_tip_imobilizare = ] + ALLTRIM(STR(tnTip)) && merge fffff greu
pcCond = [1=2]
If Empty(tnFiscala)
pnFiscala = 0
Else
pnFiscala = tnFiscala
Endif
lcCursor = 'crsLista'
If m.llExperimental
* EXPERIMENTAL SELECTIE DIN IMOB_VSITUATIE_LUNARA IN LOC DE PACK_IMOB.CALCUL_SITUATIE_LUNARA()
* Setez luna pentru view
llSucces = goExecutor.oExecuta('begin pack_imob.setlunacurenta(?pdDataI); end;')
IF m.llSucces
* se mai face o data selectia din baza de date in frm_lista.show(), asa ca nu iau date acum
lcSel = [SELECT * FROM ] + IIF(m.pnFiscala = 0, [imob_vsituatie_lunara], [imobf_vsituatie_lunara]) + [ WHERE 1=2 order by data_pif, nr_inventar]
llSucces = goExecutor.oExecuta(m.lcSel, m.lcCursor)
ENDIF
ELSE
lcSel = [{call pack_imob.CALCUL_SITUATIE_LUNARA(?pdDataI,?pdDataF,?pcCond,?pnFiscala,?gnIdSucursala)}]
lcSchema = [''] &&['ceck n(1),totdebit n(16,gnPa),totcredit n(16,gnPa),id_fact n(10),id_part n(10),nume c(50),dataact D,dataireg D,nract n(14),datascad D,cont c(4),acont c(4)']
llSucces = goExecutor.oExecuta(lcSel, lcCursor)
IF m.llSucces
Select crslista
Index On Dtos(data_PIF) + Str(nr_inventar) Tag ordine
ENDIF
ENDIF && llExperimental
IF m.llSucces
poLista= Createobject('frm_lista', m.tnTip, m.pnFiscala)
poLista.cnumecursor = m.lcCursor
poLista.Show(1)
Clear Class 'frm_lista'
Use In (SELECT('crslista'))
ENDIF
Release poLista
Endproc && vizualizare_lista_imob
*************************************************************************************************************
Procedure vizualizare_lista_imob_in_curs
Private poLista, pcSchema, pcSelect, pcOrder, pcFiltru
Local llAfiseaza
Store '' To poLista
Store '' To ofrmvizc
Local lcSelect, lcFiltru, lcSchema, lcOrder, llAfisare, lcGroup, llModParam, lcFiltruOriginal
Store '' To lcSelect, lcFiltru, lcSchema, lcOrder, llAfisare, lcGroup, llModParam, lcFiltruOriginal
If Used('crslista')
Use In crslista
Endif
lcSchema = []
lcSelect = [select id_mf,id_lista_mf,nrord,nract,id_lucrare,id_responsabil,id_gestiune,] + ;
[id_sectie,data_achizitie,nr_inventar,denumire,explicatia,] + ;
[valoare,valoare_ramasa,cgest,gestiune,sectie,responsabil,cont, acont, utilizator,dataora,id_operatie_mf, an, luna, an_exp, luna_exp, id_sucursala, sucursala, CAST(0 as Number(16,4)) as valoareretinuta, 0 as ales ] + ;
[from imob_vlista_curs]
lcOrder = [data_achizitie,nr_inventar]
lcFiltru = []
*!* 10.04.2008
*!* din contafin am preluat imobilizari in curs cu valoare < 0 (o factura de stornare) si nu apareau in roa
*!* lcFiltruOriginal = [ valoare>0 ] + gcCondSucursala
lcFiltruOriginal = Iif(!Empty(gcCondSucursala), Substr(gcCondSucursala, 6), '')
*!* 10.04.2008 ^
llAfisare = .F.
llModParam = .T.
lcGroup = []
gencursor('poLista', 'crslista', lcSelect, lcFiltru, lcSchema, lcOrder, llAfisare, lcGroup, llModParam, lcFiltruOriginal)
poLista.ca_baza1.afisare()
Select crslista
ofrmvizc = Createobject('frm_lista_curs')
ofrmvizc.Show(1)
If Used('crslista')
Use In crslista
Endif
Release ofrmvizc
Endproc && introducere_imob_in_curs
*************************************************************************************************************
Procedure MESAJ
Parameters m1
ot = Createobject('frm_mesaj', 'Atentie', 'pericol.ico', 'AVERTIZARE', m1, ' ')
ot.Show(1)
Return
*************************************************************************************************************
Procedure modif_operatii_rate
Parameters tnTipImob, tnFiscala, poMF
If Empty(poMF.id_mf)
Return
Endif
Private pnIdMf, pnTip, pnIdOperatie
Store 0 To pnIdMf, pnTip, pnIdOperatie
pnIdMf = poMF.id_mf
If Empty(tnTipImob)
pnTip = 1 && corporale
Else
pnTip = tnTipImob
Endif
*** pageframe1
lcSqlOperatii = ['select * from ] + Iif(tnFiscala = 0, [imob_voperatii_mf], [imobf_voperatii_mf]) + [ where 1=2']
lcSqlRate = ['select * from ] + Iif(tnFiscala = 0, [imob_vcalcul_rate ], [imobf_vcalcul_rate ]) + [ where 1=2']
If Used('crsOperatii')
Use In crsOperatii
Endif
Private poOperatii
poOperatii = ''
pcFiltru = [id_mf = ?pnIdMF ]
pcSchema = []
pcOrder = [data_operatie, id_operatie_mf]
llAfiseaza = .F.
gencursor('poOperatii', 'crsOperatii', lcSqlOperatii, pcFiltru, pcSchema, pcOrder, llAfiseaza)
poOperatii.ca_baza1.afisare()
Select crsOperatii
Locate
pnIdOperatie = id_operatie_mf
Private poRate
poRate = ''
If Used('crsRate')
Use In crsRate
Endif
pcFiltru2 = [id_mf = ?pnIdMF and id_operatie_mf = ?pnIdOperatie]
pcSchema2 = []
pcOrder2 = [id_calcul_rate]
llAfiseaza = .F.
gencursor('poRate', 'crsRate', lcSqlRate, pcFiltru2, pcSchema2, pcOrder2, llAfiseaza)
poRate.ca_baza1.afisare()
*** vizualizare
Select crsOperatii
omodif = Createobject('frm_operatii_rate')
omodif.omf = poMF
omodif.nFiscala = tnFiscala
omodif.Show()
If Used('crsOperatii')
Use In crsOperatii
Endif
If Used('crsRate')
Use In crsRate
Endif
Endproc && modif_operatii_rate
&& IAU SOLDURILE DIN BALANTA DE VERIFICARE PENTRU CONTURILE DE IMOBLIZARI SI AMORTIZARI
&& SI LE COMPAR CU VALOAREA DE INVENTAR SI AMORTIZAREA TOTALA DIN IMOBILIZARI CORPORALE/NECORPORALE CONTABIL
Procedure verificare_balanta(tnTip, tnAn, tnLuna)
Private pdDataI, pdDataF, pcCond, pnFiscala, pnIdTipImobilizare
Local lcSql, lnSucces, lcMesaj, lnAn, lnLuna, lnTipImobilizare, lcCondSucursala, lcBal, lcImob, lcDif
LOCAL llSucces, llExperimental, llImobObiecteInventar
lcMesaj = ''
llImobObiecteInventar = .F. && daca verific si contul 303 (obiecte de inventar)
lnTipImobilizare = Iif(Type('tnTip') <> 'N', 1, Iif(Inlist(tnTip, 1, 2), tnTip, 1))
If Pcount() < 3
lnAn = gnAn
lnLuna = gnLuna
Else
lnAn = tnAn
lnLuna = tnLuna
Endif
pdDataI = Date(lnAn, lnLuna, 1)
pdDataF = pdDataI
pcCond = []
pnFiscala = 0
llImobObiecteInventar = (TYPE('gnIMOB_OBI') = 'N' and m.gnIMOB_OBI = 1)
lcCondSucursala = Strtran(gcCondSucursala, "id_sucursala", "b.id_sucursala", 1, 1, 1)
Text To lcSql Textmerge Noshow
select 1 as tip, c.cont, c.cont_amortizare,
b.SOLDDEB as sold
from imob_conturi c
left join <<Iif(glEMama,'vbalmama','vbal')>> b on c.cont = b.cont <<lcCondSucursala>> <<Iif(!glEMama, ' and b.an = ' + Alltrim(Str(lnAn)) + ' and b.luna = ' + Alltrim(Str(lnLuna)),'')>>
where c.id_tip_imobilizare = <<lnTipImobilizare>> <<IIF(!m.llImobObiecteInventar, [ and c.cont <> '303'], [])>>
union
select 2 as tip, c.cont, c.cont_amortizare,
b.soldcred as sold
from imob_conturi c
left join <<Iif(glEMama,'vbalmama','vbal')>> b on c.cont_amortizare = b.cont <<lcCondSucursala>> <<Iif(!glEMama, ' and b.an = ' + Alltrim(Str(lnAn)) + ' and b.luna = ' + Alltrim(Str(lnLuna)),'')>>
where c.id_tip_imobilizare = <<lnTipImobilizare>> <<IIF(!m.llImobObiecteInventar, [ and c.cont <> '303'], [])>>
order by 1,2
Endtext
llSucces = goExecutor.oExecuta(lcSql, "crsConturiVerificare")
If !m.llSucces
Return
Endif
lcCursor = 'crslistaVerificare'
llExperimental = .T. && 25.11.2021 llExperimental = (goApp.nExperimental = 1)
If m.llExperimental
* EXPERIMENTAL SELECTIE DIN IMOB_VSITUATIE_LUNARA IN LOC DE PACK_IMOB.CALCUL_SITUATIE_LUNARA()
* Setez luna pentru view
lcFiltru = [id_tip_imobilizare = ] + ALLTRIM(STR(m.lnTipImobilizare)) + m.gcCondSucursala
llSucces = goExecutor.oExecuta('begin pack_imob.setlunacurenta(?pdDataI); end;')
IF m.llSucces
lcSel = [SELECT * FROM ] + IIF(m.pnFiscala = 0, [imob_vsituatie_lunara], [imobf_vsituatie_lunara]) + [ WHERE ] + m.lcFiltru
llSucces = goExecutor.oExecuta(m.lcSel, m.lcCursor)
ENDIF
ELSE
lcSel = [{call pack_imob.CALCUL_SITUATIE_LUNARA(?pdDataI,?pdDataF,?pcCond,?pnFiscala,?gnIdSucursala)}]
llSucces = goExecutor.oExecuta(lcSel, lcCursor)
ENDIF
If m.llSucces
Select Cont, Sum(valoare) As valinv, Sum(amort_prec + rata) As amorttot ;
From crsListaVerificare ;
Where ID_TIP_IMOBILIZARE = lnTipImobilizare And iesit_din_gest = 0;
Group By Cont ;
Into Cursor cImobilizari
Use In (Select('crsListaVerificare'))
&& V.TIP: 1 = CONTURI IMOBILIZARI; 2 = CONTURI AMORTIZARI
Select v.tip, v.Cont, Nvl(v.sold, Cast(0 As N(18, 4))) As bal_valoare, Nvl(i.valinv, Cast(0 As N(18, 4))) As imob_valoare;
From crsConturiVerificare v Full Join cImobilizari i On v.Cont = i.Cont ;
Where v.tip = 1 ;
Union ;
Select v.tip, v.cont_amortizare As Cont, Nvl(v.sold, Cast(0 As N(18, 4))) As bal_valoare, Sum(Nvl(i.amorttot, Cast(0 As N(18, 4)))) As imob_valoare ;
From crsConturiVerificare v Full Join cImobilizari i On v.Cont = i.Cont ;
Where v.tip = 2 ;
Group By v.tip, v.cont_amortizare, v.sold ;
Into Cursor cVerificareImob ;
Order By 1, 2
Use In (Select('crsConturiVerificare'))
Use In (Select('cImobilizari'))
Set Textmerge On To Memvar lcMesaj Noshow
Select cVerificareImob
Scan For Abs(Round(bal_valoare - imob_valoare, gnPA)) > 0.00
lcImob = Padl(Alltrim(Transform(imob_valoare, GET_MASK(16, gnPA))), 20, ' ')
lcBal = Padl(Alltrim(Transform(bal_valoare, GET_MASK(16, gnPA))), 20, ' ')
lcDif = Padl(Alltrim(Transform(imob_valoare - bal_valoare, GET_MASK(16, gnPA))), 20, ' ')
\<<Cont>>: imobilizari: <<m.lcImob>> Balanta: <<m.lcBal>> Diferenta: <<m.lcDif>>
Endscan
Use In (Select('cVerificareImob'))
Set Textmerge To
If !Empty(m.lcMesaj)
lcMesaj = 'Diferente valori imobilizari - balanta verificare' + CRLF + m.lcMesaj
aMESSAGEBOX(lcMesaj, 0 + 48, 'Verificare')
Else
aMESSAGEBOX('Nu sunt diferente!', 0 + 48, 'Verificare')
Endif
Endif
Endproc && verificare_balanta
*----------------------------------------------------------------------------------------
Procedure viz_bunuri_capital
Private poBunCapital
Store [] To poBunCapital
Local lcSchema, lcSelect, lcOrder, lcFiltru, lcFiltruOriginal, llAfisare, llModMaram, lcGroup
lcSchema = []
lcSelect = [select * ] + ;
[from imob_vbunuricapital]
lcOrder = [denumire,datadoc]
lcFiltru = []
*!* lcFiltruOriginal = Iif(!Empty(gcCondSucursala), Substr(gcCondSucursala,6), '')
lcFiltruOriginal = []
llAfisare = .F.
llModParam = .T.
lcGroup = []
gencursor('poBunCapital', 'crsBunCapital', lcSelect, lcFiltru, lcSchema, lcOrder, llAfisare, lcGroup, llModParam, lcFiltruOriginal)
poBunCapital.ca_baza1.afisare()
Select crsBunCapital
frm_buncpital = Createobject('frm_bunuri_capital')
frm_buncpital.Show(1)
Endproc &&viz_bunuri_capital
**************************************
* Intoarce .T. daca numarul de inventar este duplicat
**************************************
function VerificaNumarInventar
LPARAMETERS tnNumarInventar, tnTip
PRIVATE pnNumarInventar, pdData, pnTip, pnRec
LOCAL llDuplicat, lcSql, llSucces
llDuplicat = .F.
pdData = Date(gnAn, gnLuna, 1)
pnNumarInventar = IIF(TYPE('tnNumarInventar') = 'N', m.tnNumarInventar, 0)
pnTip = IIF(TYPE('tnTip') = 'N', m.tnTip, 1)
IF !EMPTY(m.pnNumarInventar)
lcSql = [select pack_imob.verifica_nr_inventar(?pnNumarInventar,?pdData, ?pnTip) as nr from dual]
pnRec = 0
llSucces = goExecutor.oSelecteaza2Value(m.lcSql, @pnRec)
IF m.llSucces
llDuplicat = (m.pnRec > 0)
ENDIF
ENDIF
RETURN m.llDuplicat
ENDfunc

1326
Programe/oproceduri_listari.prg Normal file
View File

File diff suppressed because it is too large Load Diff

565
Programe/oproceduri_operatii.prg Normal file
View File

@@ -0,0 +1,565 @@
*!* 11.11.2009
*!* marius.mutu
*!* alocare, dezalocare numere inventar
*!* 04.07.2018
*!* marius.mutu
*!* op_transformare_mf - transformare imobilizare curs in imobilizare corporala/necorporala
*!* 03.06.2021
*!* marius.mutu
*!* + op_schimbaredns_reevaluare - adaugare operatie schimbare dns si reevaluare
*!* 27.08.2024
*!* marius.mutu
*!* op_adaugare_la_mf - transformare imobilizare in curs in majorare imobilizare corporala/necorporala
************************************
*** Cod operatie
************************************
*** 1 - introducere
*** 2 - preluare
*** 3 - transformare in MF
*** 4 - iesire din gestiune
*** 5 - intrare in gestiune
*** 6 - majorare
*** 7 - reevaluare
*** 8 - schimbarea DNS
*** 9 - recalculare cota
*** 10 - conservare
*** 11 - scoatere din conservare
*** 12 - modificare cu istoric
*** 13 - inchidere
*** 14 - schimbare DNS + reevaluare
************************************
* Intoarce un obiect cu lSucces = .T. daca succes, .F. daca eroare sau renunt
Procedure op_majorare
Parameters tnTip, tnValoareMajorare
Private pnvaloaremaj, pddatareeval, pnNrDoc, pdDataDoc, pnBunCapital, pnBazaTva, pnIdCotaTva, pnTva, pnProrataTva
Store '' To ofrmmajorare
Local llBunCapital
gnButon = 2
pnValoareMaj = IIF(EMPTY(m.tnValoareMajorare), 0, m.tnValoareMajorare)
pdDataReeval = {}
pcExplicatie = []
pnFiscala = 0
pnNrDoc = 0
pdDataDoc = {}
pnBunCapital = 0
pnBazaTva = 0
pnIdCotaTva = 0
pnTva = 0
pnProrataTva = 0
lcSql = [select * from imob_vbunuricapital where id_tip_operatie in (1,2) and id_mf = ?poDetaliiMf.id_mf]
lnSucces = goExecutor.oExecute(lcSql, [crsNrbuncapital])
If lnSucces < 0
aMessagebox(goExecutor.cEroare, 0 + 16, _screen.Caption)
Return
Endif
Select crsNrbuncapital
If Reccount() > 0
llBunCapital = .T.
Endif
Use In crsNrbuncapital
= update_cote_TVA()
ofrmmajorare = Createobject('frm_op_majorare', tnTip, llBunCapital)
ofrmmajorare.Show(1)
Release ofrmmajorare
m.llSucces = .F.
If gnButon = 1
lcSql = [begin pack_imob.inreg_majorare(?gcS,?poDetaliiMf.id_sucursala,?poDetaliiMf.id_mf,] + ;
[?pnvaloaremaj,?pddatareeval,?pcExplicatie,?gnIdUtil,?pnFiscala,?pdDatadoc,?pnNrDoc,?pnBunCapital ,?pnBazaTva,?pnIdCotaTva,?pnTva,?pnProrataTva ); end;]
llSucces = goExecutor.oExecuta(lcSql)
If !m.llSucces
aMessagebox('Eroare la inregistrarea majorarii! ' + CRLF + goExecutor.cEroare, 0 + 16, _screen.Caption)
ENDIF
ENDIF
loReturn = CREATEOBJECT("empty")
ADDPROPERTY(loReturn, "lSucces", m.llSucces)
ADDPROPERTY(loReturn, "valoaremaj", m.pnvaloaremaj)
ADDPROPERTY(loReturn, "datareeval", m.pddatareeval)
ADDPROPERTY(loReturn, "Explicatie", m.pcExplicatie)
ADDPROPERTY(loReturn, "Fiscala", m.pnFiscala)
ADDPROPERTY(loReturn, "Datadoc", m.pdDatadoc)
ADDPROPERTY(loReturn, "NrDoc", m.pnNrDoc)
ADDPROPERTY(loReturn, "BunCapital", m.pnBunCapital )
ADDPROPERTY(loReturn, "BazaTva", m.pnBazaTva)
ADDPROPERTY(loReturn, "IdCotaTva", m.pnIdCotaTva)
ADDPROPERTY(loReturn, "Tva", m.pnTva)
ADDPROPERTY(loReturn, "ProrataTva", m.pnProrataTva)
RETURN loReturn
Endproc && op_majorare
*************************************************************************************************************
Procedure op_reevaluare
Parameters tnTip
Private pnvaloarenoua, pddatareeval, pnamortnoua, pnNrDoc, pdDataDoc, pnBunCapital, pnValreev
Local llBunCapital
Store '' To ofrmreeval
pnvaloarenoua = poDetaliiMf.valoare
pnamortnoua = poDetaliiMf.amort_prec + poDetaliiMf.rata
pddatareeval = {}
pcExplicatie = []
pnFiscala = 0
pnNrDoc = 0
pdDataDoc = {}
pnBunCapital = 0
pnValreev = 0
lcSql = [select * from imob_vbunuricapital where id_tip_operatie in (1,2) and id_mf = ?poDetaliiMf.id_mf]
lnSucces = goExecutor.oExecute(lcSql, [crsNrbuncapital])
If lnSucces < 0
aMessagebox(goExecutor.cEroare, 0 + 16, "ROA IMOB")
Return
Endif
Select crsNrbuncapital
If Reccount() > 0
llBunCapital = .T.
Endif
Use In crsNrbuncapital
ofrmreeval = Createobject('frm_op_reevaluare', tnTip, llBunCapital )
ofrmreeval.Show(1)
*!* WAIT WINDOW STR(pnFiscala)
Release ofrmreeval
If pnButon = 1
lcSql = [begin pack_imob.inreg_reevaluare(?gcS,?poDetaliiMf.id_sucursala,?poDetaliiMf.id_mf,] + ;
[?pnvaloarenoua,?pnamortnoua,?pddatareeval,?pcExplicatie,?gnIdUtil,?pnFiscala,?pdDataDoc,?pnNrDoc,?pnBunCapital,?pnValreev ); end;]
lnSucces = goExecutor.oExecute(lcSql)
If lnSucces < 0
aMessagebox('Eroare la inregistrarea reevaluarii! ' + CRLF + goExecutor.cEroare, 0 + 16, "ROA IMOB")
Return
Endif
Endif
Endproc && op_reevaluare
*************************************************************************************************************
Procedure op_schimbaredns_reevaluare
Parameters tnTip
Local ofrmreeval, lcSql, lnSucces, llBunCapital
Private pnvaloarenoua, pddatareeval, pnAmortizareNoua, pnNrDoc, pdDataDoc, pnBunCapital, pnValreev
PRIVATE pcExplicatie, pnDNSNou, pnDurataRamasaNoua, pnFiscala, pnUzuraNoua, pcCodNou
private pnValoareRamasaNoua, pnValoareRezidualaNoua, pnValoareRamasa, pnAmortizare
Store '' To ofrmreeval
pnValoareNoua = poDetaliiMf.valoare
pnAmortizare = poDetaliiMf.amort_prec + poDetaliiMf.rata
pnAmortizareNoua = m.pnAmortizare
pnValoareRamasa = poDetaliiMf.valoare - poDetaliiMf.amort_prec - poDetaliiMf.rata - poDetaliiMf.valoare_reziduala
pnValoareRamasaNoua = m.pnValoareRamasa
pnValoareRezidualaNoua = poDetaliiMf.valoare_reziduala
pnDNSNou = poDetaliiMf.dns_luni
pnUzuraNoua = poDetaliiMf.uzura
pnDurataRamasaNoua = poDetaliiMf.durata_ramasa
pcCodNou = poDetaliiMf.cod_mf
pcExplicatie = []
pnFiscala = 0
pnNrDoc = 0
pnBunCapital = 0
pnValReev = 0
pdDatadoc = get_ultima_zi()
pddatareeval = m.pdDataDoc
lcSql = [select * from imob_vbunuricapital where id_tip_operatie in (1,2) and id_mf = ?poDetaliiMf.id_mf]
lnSucces = goExecutor.oExecute(lcSql, [crsNrbuncapital])
If lnSucces < 0
aMessagebox(goExecutor.cEroare, 0 + 16, "ROA IMOB")
Return
Endif
Select crsNrbuncapital
If Reccount() > 0
llBunCapital = .T.
Endif
Use In crsNrbuncapital
ofrmreeval = Createobject('frm_op_schimbdns_reevaluare', m.tnTip, m.llBunCapital)
ofrmreeval.Show(1)
*!* WAIT WINDOW STR(pnFiscala)
Release ofrmreeval
If pnButon = 1
lcSql = [begin pack_imob.inreg_schimbdns_reevaluare(?gcS,?poDetaliiMf.id_sucursala,?poDetaliiMf.id_mf,] + ;
[?pcCodNou,?pnDnsNou,?pnValoareNoua,?pnAmortizareNoua,?pnUzuraNoua,?pnValoareRezidualaNoua,] + ;
[?pdDataReeval,?pcExplicatie,?gnIdUtil,?pnFiscala,?pdDataDoc,?pnNrDoc,?pnBunCapital,?pnValreev ); end;]
lnSucces = goExecutor.oExecute(lcSql)
If lnSucces < 0
aMessagebox('Eroare la inregistrarea schimbare DNS si reevaluare! ' + CRLF + goExecutor.cEroare, 0 + 16, _Screen.Caption)
Return
Endif
Endif
Endproc && op_schimbaredns_reevaluare
*************************************************************************************************************
Procedure op_conservare
Parameters tnTip, tlConservat
Private pddataconservare, pccauza, pnNrDoc, pdDataDoc, pnBunCapital, pnBazaTva, pnId_cota_tva, pnTva, pnProrataTva
Local llBunCapital
Store '' To ofrmgest
pddataconservare = {}
pccauza = []
pnFiscala = 0
pnNrDoc = 0
pdDataDoc = {}
pnBunCapital = 0
pnBazaTva = 0
pnId_cota_tva = 0
pnTva = 0
pnProrataTva = 0
lcSql = [select * from imob_vbunuricapital where id_tip_operatie in (1,2) and id_mf = ?poDetaliiMf.id_mf]
lnSucces = goExecutor.oExecute(lcSql, [crsNrbuncapital])
If lnSucces < 0
aMessagebox(goExecutor.cEroare, 0 + 16, "ROA IMOB")
Return
Endif
Select crsNrbuncapital
If Reccount() > 0
llBunCapital = .T.
Endif
Use In crsNrbuncapital
= update_cote_TVA()
ofrmgest = Createobject('frm_op_conservare', tlConservat, tnTip, llBunCapital)
ofrmgest.Show(1)
Release ofrmgest
If pnButon = 1
lcSql = [begin pack_imob.inreg_conservare(?gcS,?poDetaliiMf.id_sucursala,?poDetaliiMf.id_mf,] + Iif(!tlConservat, '1', '0') + [,] + ;
[?pccauza,?pddataconservare,?gnIdUtil,?pnFiscala,?pdDataDoc,?pnNrDoc,?pnBunCapital,?pnBazaTva,?pnId_cota_tva,?pnTva,?pnProrataTva); end;]
lnSucces = goExecutor.oExecute(lcSql)
If lnSucces < 0
aMessagebox('Eroare la inregistrarea ' + Iif(!tlConservat, 'intrarii in conservare', 'iesirii din conservare') + ;
'!' + CRLF + goExecutor.cEroare, 0 + 16, "ROA IMOB")
Return
Endif
Endif
Endproc && op_conservare
*************************************************************************************************************
Procedure op_schimbaredns
Parameters tnTip
Private pddataschimbare, pndns, pccodnou, pnNrDoc, pdDataDoc
Store '' To ofrmschdns
pddataschimbare = {}
pndns = 0
pccodnou = []
pnUzura = 0
pcExplicatie = []
pnFiscala = 0
pnNrDoc = 0
pdDataDoc = {}
ofrmschdns = Createobject('frm_op_schimb_dns')
ofrmschdns.Show(1)
Release ofrmschdns
If pnButon = 1
lcSql = [begin pack_imob.inreg_schimbdns(?gcS,?poDetaliiMf.id_sucursala,?poDetaliiMf.id_mf,?pccodnou,] + ;
[?pndns,?pddataschimbare,?pcExplicatie,?gnIdUtil,?pnFiscala,?pdDataDoc,?pnNrDoc); end;]
lnSucces = goExecutor.oExecute(lcSql)
If lnSucces < 0
aMessagebox('Eroare la inregistrarea schimbarii DNS-ului !' + CRLF + goExecutor.cEroare, 0 + 16, "ROA IMOB")
Return
Endif
Endif
Endproc && op_schimbaredns
*************************************************************************************************************
Procedure op_gest
Parameters tnTip, tlCasat
Private pddataschimbare, pccauza, pnNrDoc, pdDataDoc, pnProrataTva, pnIdTipIesire
Local llBunCapital
Store '' To ofrmgest
pddataschimbare = {}
pccauza = []
pnFiscala = 0
pnNrDoc = 0
pdDataDoc = {}
pnBunCapital = 0
pnBazaTva = 0
pnId_cota_tva = 0
pnTva = 0
pnProrataTva = 0
pnIdTipIesire = 1 && vanzare
lcSql = [select * from imob_vbunuricapital where id_tip_operatie in (1,2) and id_mf = ?poDetaliiMf.id_mf]
lnSucces = goExecutor.oExecute(lcSql, [crsNrbuncapital])
If lnSucces < 0
aMessagebox(goExecutor.cEroare, 0 + 16, "ROA IMOB")
Return
Endif
Select crsNrbuncapital
If Reccount() > 0
llBunCapital = .T.
Endif
Use In crsNrbuncapital
= update_cote_TVA()
lcSql = [select id, tip from imob_tipuri_iesire order by ordine]
llSucces = goExecutor.oExecuta(m.lcSql, [crsTipuriIesire])
If !m.llSucces
Create Cursor crsTipuriIesire(Id I, tip C(100))
Insert Into crsTipuriIesire(Id, tip) Values (1, 'VANZARE')
Endif
Go Top In crsTipuriIesire
ofrmgest = Createobject('frm_op_gest', tlCasat, tnTip, llBunCapital )
ofrmgest.Show(1)
Release ofrmgest
Use In (Select('crsTipIesire'))
If tlCasat && la intrarea in gestiune nu mai am "tip iesire din gestiune"
pnIdTipIesire = Null
Endif
If pnButon = 1
*!* am pus valori pentru ca dadea la plevnei C00005
*!* MARIUS.MUTU
*!* 21.11.2006
*!* lcsql=[ begin pack_imob.inreg_gest(?gcs,?poDetaliiMf.id_mf, ] + Iif(!tlCasat, '1', '0') + [, ?pccauza, ?pddataschimbare, ?gnIdUtil, ?pnFiscala); end;]
lcSql = [ begin pack_imob.inreg_gest('] + gcs + [',] + Iif(Nvl(poDetaliiMf.id_sucursala, 0) = 0, 'NULL', Alltrim(Str(poDetaliiMf.id_sucursala))) + [, ] + Alltrim(Str(poDetaliiMf.id_mf)) + [, ] + Iif(!tlCasat, '1', '0') + [, '] + pccauza + ;
[' , TO_DATE('] + Dtos(pddataschimbare) + [', 'YYYYMMDD') , ] + ;
Alltrim(Str(gnIdUtil)) + [, ] + Alltrim(Str(pnFiscala)) + [, TO_DATE('] + Dtos(pdDataDoc) + [', 'YYYYMMDD') , ] + Alltrim(Str(pnNrDoc)) + [,] + ;
Alltrim(Str(pnBunCapital )) + [,] + Alltrim(Transform(pnBazaTva)) + [,] + Alltrim(Transform(pnId_cota_tva)) + [,] + Alltrim(Transform(pnTva )) + [,] + Alltrim(Transform(pnProrataTva )) + [,] + Iif(Isnull(m.pnIdTipIesire), 'NULL', Alltrim(Transform(m.pnIdTipIesire))) + [); end;]
*STRTOFILE(lcsql,'c:\inreg_gest.txt')
lnSucces = goExecutor.oExecute(lcSql)
If lnSucces < 0
aMessagebox('Eroare la inregistrarea ' + Iif(!tlCasat, 'iesirii din gestiune', 'intrarii in gestiune') + ;
'!' + CRLF + goExecutor.cEroare, 0 + 16, "ROA IMOB")
Return
Endif
Endif
Endproc && op_iesiregest
*************************************************************************************************************
Procedure op_modificare
Parameters tnTip
Store '' To ofrmmodificare
= cctipuri_amort()
= update_cote_TVA() && modificare v 2.0.18
ofrmmodificare = Createobject('frm_introducere', tnTip, 2)
ofrmmodificare.Show(1)
If Used('v_tipuri_amort')
Use In v_tipuri_amort
Endif
*!* modificare v 2.0.18
If Used('cote_TVA')
Use In cote_TVA
Endif
*!* modificare v 2.0.18 ^
Release ofrmmodificare
Endproc && op_modificare
************************************************************************************************************
Procedure op_transformare_mf
Parameters tnTip
******************************
** tnTip:
** 1) imob.corporale
** 2) imob.necorporale
Local lnTip
Private ofrmintro
= cctipuri_amort()
= update_cote_TVA()
Local lnRezultat, lnIdTipDocNrInv
Private poGeneratorNumere
lnIdTipDocNrInv = 18
poGeneratorNumere = Createobject('oGeneratorNumere')
lnRezultat = poGeneratorNumere.creeaza_cursor_serii(m.lnIdTipDocNrInv)
lnTip = Iif(!Empty(m.tnTip), m.tnTip, 1)
gnButon = 2
ofrmintro = Createobject('frm_introducere', m.lnTip, 4)
ofrmintro.clb_valoare.Enabled = .F.
ofrmintro.Show(1)
Release ofrmintro
If gnButon = 2
poGeneratorNumere.dezaloca_numere()
Endif
Use In (Select('v_tipuri_amort'))
Use In (Select('cote_TVA'))
Return (gnButon = 1)
Endproc && op_transformare_mf
*************************************************************************************************************
*** adaugare valoare imobilizare in curs la o imobilizare corporala/necorporala deja existenta, prin operatia majorare valoare
*************************************
Procedure op_adaugare_la_mf
Parameters tnTip
******************************
** tnTip:
** 1) imob.corporale
** 2) imob.necorporale
Private pdDataI, poDetaliiMf, poMF, pnIdMf
Local lcSql, llSucces, lnFiscala, lnValoareMajorare, ldDataReevaluare
Local llBlank, llReturn, llSucces2, lnIdMf, loImobBlank, loRec
ldDataReevaluare = {}
**************************************
* Aleg imobilizarea pe care doresc sa o majorez
**************************************
CALCULATE SUM(valoareretinuta) TO lnValoareMajorare IN crsLista3
poDetaliiMf = caut_imobilizare(m.tnTip)
pnIdMf = poDetaliiMf.id_mf
llSucces = .T.
llSucces2 = .T.
llSucces = goConn.BeginManualTransaction()
loMajorare = op_majorare(m.tnTip, m.lnValoareMajorare)
llSucces = loMajorare.lSucces
IF m.llSucces
=cctipuri_amort()
* ADAUG OPERATIE TRANSFORMARE MIJLOC FIX PE FIECARE IMOBILIZARE IN CURS
TEXT TO lcSql NOSHOW
begin
pack_imob.inreg_transformare_in_mf(v_schema => ?gcS,
v_id_mf => ?poMF.id_mf,
v_id_mf_nou => ?pnIdMf,
v_datamodificare => ?poMF.datamodificare,
v_nract => ?poMF.nract,
v_dataact => ?poMF.dataact,
v_denumire => ?poMF.denumire,
v_explicatia => ?poMF.explicatia,
v_valoare => ?poMF.valoare,
v_data_pif => ?poMF.data_pif,
v_nr_pif => ?poMF.nr_pif,
v_nr_inventar => ?poMF.nr_inventar,
v_cod => ?poMF.cod,
v_dns => ?poMF.dns,
v_uzura => ?poMF.uzura,
v_dns_ramas => ?poMF.dns_ramas,
v_valoare_ramasa => ?poMF.valoare_ramasa,
v_valoare_retinuta => ?poMF.valoare_retinuta,
v_id_gestiune => ?poMF.id_gestiune,
v_id_responsabil => ?poMF.id_responsabil,
v_id_sectie => ?poMF.id_sectie,
v_id_lucrare => ?poMF.id_lucrare,
v_id_sucursala => ?poMF.id_sucursala,
v_id_tip_amortizare => ?poMF.id_tip_amortizare,
v_procent => ?poMF.procent,
v_coeficient => ?poMF.coeficient,
v_id_tip_imobilizare => ?poMF.id_tip_imobilizare,
v_cont => ?poMF.cont,
v_acont => ?poMF.acont,
v_id_util => ?gnIdUtil,
v_amort_max_deductibil => ?poMF.amort_max_deductibil,
v_fiscala => ?poMF.fiscala,
v_datadoc => ?poMF.datadoc,
v_nrdoc => ?poMF.nrdoc,
v_id_tip_operatie => ?poMF.id_tip_operatie);
end;
ENDTEXT
Select crslista3
SCAN
SCATTER NAME poMF MEMO
poMF.valoare_ramasa = poMF.valoare_ramasa - poMF.valoareretinuta
ADDPROPERTY(poMF, "dataact", poMf.data_achizitie)
ADDPROPERTY(poMF, "valoare_retinuta", poMF.valoareretinuta)
ADDPROPERTY(poMF, "datamodificare", loMajorare.datareeval)
ADDPROPERTY(poMF, "datadoc", loMajorare.datadoc)
ADDPROPERTY(poMF, "nrdoc", loMajorare.nrdoc)
ADDPROPERTY(poMF, "data_pif", poMf.data_achizitie)
ADDPROPERTY(poMF, "nr_pif", poMf.nr_inventar)
ADDPROPERTY(poMF, "id_tip_amortizare", 1) && liniar
ADDPROPERTY(poMF, "id_tip_imobilizare", 3) && in curs
ADDPROPERTY(poMF, "fiscala", 0)
ADDPROPERTY(poMF, "cod", NULL)
ADDPROPERTY(poMF, "dns", 0)
ADDPROPERTY(poMF, "uzura", 0)
ADDPROPERTY(poMF, "dns_ramas", 0)
ADDPROPERTY(poMF, "procent", 0)
ADDPROPERTY(poMF, "coeficient", 0)
ADDPROPERTY(poMF, "amort_max_deductibil", 0)
ADDPROPERTY(poMF, "id_tip_operatie", 3) && transformare in imobilizare
WITH poMF
.explicatia = ALLTRIM(.explicatia)
ENDWITH
llSucces = goExecutor.oExecuta(lcSql)
If !m.llSucces
Exit
Endif
Select crslista3
Endscan
Use In (SELECT('v_tipuri_amort'))
ENDIF && llSucces
USE IN (SELECT('cImobBlank'))
llSucces2 = goConn.EndManualTransaction(Iif(m.llSucces, 'COMMIT', 'ROLLBACK'))
llReturn = m.llSucces And m.llSucces2
RETURN m.llReturn
Endproc && op_transformare_mf
*!* *************************************************************************************************************
Define class oImobFrm as form
width=650
height=480
showWindow=2
Autocenter=.T.
caption="Alegeti imobilizarea"
name="form1"
Add object grid1 as grid with ;
Anchor=15,;
left=5,;
top=100,;
width=600,;
height=300,;
gridlines=0,;
deletemark=.t.,;
name="grid1"
procedure grid1.init
with this
.recordsource="crsListaTemp"
.recordsourcetype=1
endwith
endproc
ENDDEFINE

1
Programe/ovariabile_globale.prg Normal file
View File

@@ -0,0 +1 @@
**OVARIABILE_GLOBALE.PRG

746
Programe/proceduri_meniu.prg Normal file
View File

@@ -0,0 +1,746 @@
*!* PROCEDURE list_corp_general
*!* list_general(1)
*!* ENDPROC
*!* *------------------------------------------------------------------------
*!* PROCEDURE list_necorp_general
*!* list_general(2)
*!* ENDPROC
*!* *------------------------------------------------------------------------
*!* procedure list_general && CORPORALE/NECORPORALE 'cu totaluri generale'
*!* PARAMETERS tnTip
*!* * tnTip 1) Corp. 2) Necorp
*!* PRIVATE poLista,locauta
*!* Store '' To poLista
*!* Store "" To locauta
*!* private nid_gestiune
*!* nid_gestiune=1
*!* pcselect = ['select nume_gestiune,id_gestiune FROM ] + gcs + [.vnom_gestiuni where inactiv=0']
*!* pcfiltru = [1=2]
*!* pcschema = ['']
*!* pcorder = [nume_gestiune]
*!* pccoloane = [nume_gestiune]
*!* pcTitlu = [Alegeti gestiunea]
*!* pcTitluColoane = [Gestiune]
*!* locauta = cauta_alfa(pcselect,pcfiltru,pcschema,pcorder,pccoloane,pcTitlu,pcTitluColoane,"")
*!* If !Empty(locauta.nume_gestiune)
*!* nid_gestiune=locauta.id_gestiune
*!* pcgestiune=ALLTRIM(locauta.nume_gestiune)
*!* Endif
*!* pcSchema=['']
*!* pcSelect=['select * from ]+gcS+[.imob_vjurnal where 1=2']
*!* pcOrder=[gestiune,data_achizitie]
*!* *pcFiltru = [id_tip_imobilizare=?tnTip and iesit_din_gest=0 and id_gestiune=?nid_gestiune]
*!* pcFiltru = [id_tip_imobilizare=?tnTip and iesit_din_gest=0]+IIF(pcgestiune="TOATE GESTIUNILE",[],[and id_gestiune=?nid_gestiune])
*!* llAfiseaza = .F.
*!* gencursor('poLista','crslista',pcSelect,pcFiltru,pcSchema,pcOrder,llAfiseaza)
*!* poLista.ca_baza1.afisare()
*!* pctitlu="LISTA IMOBILIZARILOR "+IIF(tnTip=1,"CORPORALE","NECORPORALE")+" IN LUNA"
*!* SELECT crslista
*!* REPORT FORM listmfcota TO PRINTER PROMPT PREVIEW
*!* Release poLista
*!* ENDPROC
*!* *---------------------------------------------------------------------------
*!* PROCEDURE list_corp_peluni
*!* list_peluni(1)
*!* ENDPROC
*!* *------------------------------------------------------------------------
*!* PROCEDURE list_necorp_peluni
*!* list_peluni(2)
*!* ENDPROC
*!* *------------------------------------------------------------------------
*!* PROCEDURE list_peluni && CORPORALE/NECORPORALE 'cu totaluri pe luni'
*!* PARAMETERS tnTip
*!* * tnTip 1) Corp. 2) Necorp
*!* PRIVATE poLista,locauta
*!* Store '' To poLista
*!* Store "" To locauta
*!* private nid_gestiune
*!* nid_gestiune=1
*!* pcselect = ['select nume_gestiune,id_gestiune FROM ] + gcs + [.vnom_gestiuni where inactiv=0']
*!* pcfiltru = [1=2]
*!* pcschema = ['']
*!* pcorder = [nume_gestiune]
*!* pccoloane = [nume_gestiune]
*!* pcTitlu = [Alegeti gestiunea]
*!* pcTitluColoane = [Gestiune]
*!* locauta = cauta_alfa(pcselect,pcfiltru,pcschema,pcorder,pccoloane,pcTitlu,pcTitluColoane,"")
*!* If !Empty(locauta.nume_gestiune)
*!* nid_gestiune=locauta.id_gestiune
*!* pcgestiune=ALLTRIM(locauta.nume_gestiune)
*!* Endif
*!* pcSchema=['']
*!* pcSelect=['select * from ]+gcS+[.imob_vamortizarilunare_mf where 1=2']
*!* pcOrder=[gestiune,cont,data_pif]
*!* *pcFiltru = [id_tip_imobilizare=?tnTip and iesit_din_gest=0 and id_gestiune=?nid_gestiune]
*!* pcFiltru = [id_tip_imobilizare=?tnTip and iesit_din_gest=0]+IIF(pcgestiune="TOATE GESTIUNILE",[],[and id_gestiune=?nid_gestiune])
*!* llAfiseaza = .F.
*!* gencursor('poLista','crslista',pcSelect,pcFiltru,pcSchema,pcOrder,llAfiseaza)
*!* poLista.ca_baza1.afisare()
*!* pctitlu="LISTA IMOBILIZARILOR "+IIF(tnTip=1,"CORPORALE","NECORPORALE")+" IN LUNA"
*!* SELECT crslista
*!* * thisform.AlwaysOnTop = .F.
*!* REPORT FORM listmflunicota TO PRINTER PROMPT PREVIEW
*!* * thisform.AlwaysOnTop = .T.
*!* Release poLista
*!* ENDPROC
*!* *---------------------------------------------------------------------------
*!* PROCEDURE list_corp_pegrup
*!* list_pegrup(1)
*!* ENDPROC
*!* *------------------------------------------------------------------------
*!* PROCEDURE list_necorp_pegrup
*!* list_pegrup(2)
*!* ENDPROC
*!* *------------------------------------------------------------------------
*!* PROCEDURE list_pegrup && CORPORALE/NECORPORALE 'cu totaluri pe grupe'
*!* PARAMETERS tnTip
*!* * tnTip 1) Corp. 2) Necorp
*!* PRIVATE poLista,locauta
*!* Store '' To poLista
*!* Store "" To locauta
*!* private nid_gestiune
*!* nid_gestiune=1
*!* pcselect = ['select nume_gestiune,id_gestiune FROM ] + gcs + [.vnom_gestiuni where inactiv=0']
*!* pcfiltru = [1=2]
*!* pcschema = ['']
*!* pcorder = [nume_gestiune]
*!* pccoloane = [nume_gestiune]
*!* pcTitlu = [Alegeti gestiunea]
*!* pcTitluColoane = [Gestiune]
*!* locauta = cauta_alfa(pcselect,pcfiltru,pcschema,pcorder,pccoloane,pcTitlu,pcTitluColoane,"")
*!* If !Empty(locauta.nume_gestiune)
*!* nid_gestiune=locauta.id_gestiune
*!* pcgestiune=ALLTRIM(locauta.nume_gestiune)
*!* Endif
*!* pcSchema=['']
*!* pcSelect=['select * from ]+gcS+[.imob_vjurnal where 1=2']
*!* pcOrder=[gestiune,cont]
*!* *pcFiltru = [id_tip_imobilizare=?tnTip and iesit_din_gest=0 and id_gestiune=?nid_gestiune]
*!* pcFiltru = [id_tip_imobilizare=?tnTip and iesit_din_gest=0]+IIF(nid_gestiune=11071,[],[and id_gestiune=?nid_gestiune])
*!* llAfiseaza = .F.
*!* gencursor('poLista','crslista',pcSelect,pcFiltru,pcSchema,pcOrder,llAfiseaza)
*!* poLista.ca_baza1.afisare()
*!* pctitlu="LISTA IMOBILIZARILOR "+IIF(tnTip=1,"CORPORALE","NECORPORALE")+" IN LUNA"
*!* SELECT crslista
*!* * thisform.AlwaysOnTop = .F.
*!* REPORT FORM listmfscdcota TO PRINTER PROMPT PREVIEW
*!* * thisform.AlwaysOnTop = .T.
*!* Release poLista
*!* ENDPROC
*!* *---------------------------------------------------------------------------
*!* PROCEDURE list_corp_pesectii
*!* list_pesectii(1)
*!* ENDPROC
*!* *------------------------------------------------------------------------
*!* PROCEDURE list_necorp_pesectii
*!* list_pesectii(2)
*!* ENDPROC
*!* *------------------------------------------------------------------------
*!* PROCEDURE list_peSECTII && CORPORALE/NECORPORALE 'cu totaluri pe sectii'
*!* PARAMETERS tnTip
*!* * tnTip 1) Corp. 2) Necorp
*!* PRIVATE poLista,locauta
*!* Store '' To poLista
*!* Store "" To locauta
*!* private nid_gestiune
*!* nid_gestiune=1
*!* pcselect = ['select sectie, id_sectie FROM ] + gcs + [.vnom_sectii where inactiv=0']
*!* pcfiltru = [1=2]
*!* pcschema = ['']
*!* pcorder = [sectie]
*!* pccoloane = [sectie]
*!* pcTitlu = [Alegeti sectie]
*!* pcTitluColoane = [Sectii]
*!* locauta = cauta_alfa(pcselect,pcfiltru,pcschema,pcorder,pccoloane,pcTitlu,pcTitluColoane,"")
*!* If !Empty(locauta.sectie)
*!* nid_gestiune=locauta.id_sectie
*!* pcgestiune=ALLTRIM(locauta.sectie)
*!* Endif
*!* pcSchema=['']
*!* pcSelect=['select * from ]+gcS+[.imob_vjurnal where 1=2']
*!* pcOrder=[gestiune,cont,data_pif]
*!* *pcFiltru = [id_tip_imobilizare=?tnTip and iesit_din_gest=0 and id_sectie=?nid_gestiune]
*!* pcFiltru = [id_tip_imobilizare=?tnTip and iesit_din_gest=0]+IIF(pcgestiune="TOATE SECTIILE",[],[and id_sectie=?nid_gestiune])
*!* llAfiseaza = .F.
*!* gencursor('poLista','crslista',pcSelect,pcFiltru,pcSchema,pcOrder,llAfiseaza)
*!* poLista.ca_baza1.afisare()
*!* pctitlu="LISTA IMOBILIZARILOR "+IIF(tnTip=1,"CORPORALE","NECORPORALE")+" IN LUNA"
*!* SELECT crslista
*!* *thisform.AlwaysOnTop = .F.
*!* REPORT FORM listmf_grup TO PRINTER PROMPT PREVIEW
*!* * thisform.AlwaysOnTop = .T.
*!* Release poLista
*!* ENDPROC
*!* *---------------------------------------------------------------------------
*!* PROCEDURE lista_fiselor_corp_istoric && CORPORALE 'lista fiselor'
*!* lista_fiselor(1)
*!* ENDPROC
*!* *---------------------------------------------------------------------------
*!* PROCEDURE lista_fiselor_necorp && NECORPORALE 'lista fiselor'
*!* lista_fiselor(2)
*!* ENDPROC
*!* *---------------------------------------------------------------------------
*!* PROCEDURE lista_fiselor
*!* PARAMETERS tnTip
*!* ****
*!* * 1) imob.corporale
*!* * 2) imob.necorporale
*!* ****
*!* If Used('crslista')
*!* Use In crslista
*!* Endif
*!* lcsql=[SELECT * from ]+gcS+[.imob_vjurnal where id_tip_imobilizare=]+ALLTRIM(STR(tnTip))+[ and iesit_din_gest=0]
*!*
*!* lnSucces=goExecutor.oExecute(lcsql,'crsLista')
*!* IF lnSucces<0
*!* MESSAGEBOX("Nu a mers SQL-ul actcs")
*!* return
*!* ENDIF
*!*
*!* SELECT crsLista
*!* IF tntip=1
*!* REPORT FORM fisa_mf_istoric TO PRINTER PROMPT PREVIEW
*!* ELSE
*!* REPORT FORM fisa_mf2 TO PRINTER PROMPT PREVIEW
*!* ENDIF
*!* If Used('crslista')
*!* Use In crslista
*!* Endif
*!* ENDPROC
*!* *---------------------------------------------------------------------------
*!* PROCEDURE lista_inv_m1_c
*!* lista_inv_m1(1)
*!* ENDPROC
*!* *---------------------------------------------------------------------------
*!* PROCEDURE lista_inv_m1_n
*!* lista_inv_m1(2)
*!* ENDPROC
*!* *---------------------------------------------------------------------------
*!* PROCEDURE lista_inv_m1
*!* PARAMETERS tnTip
*!* * tnTip 1) Corp. 2) Necorp
*!* PRIVATE poLista,locauta
*!* Store '' To poLista
*!* Store "" To locauta
*!* private nid_gestiune
*!* nid_gestiune=1
*!* pcselect = ['select nume_gestiune,id_gestiune FROM ] + gcs + [.vnom_gestiuni where inactiv=0']
*!* pcfiltru = [1=2]
*!* pcschema = ['']
*!* pcorder = [nume_gestiune]
*!* pccoloane = [nume_gestiune]
*!* pcTitlu = [Alegeti gestiunea]
*!* pcTitluColoane = [Gestiune]
*!* locauta = cauta_alfa(pcselect,pcfiltru,pcschema,pcorder,pccoloane,pcTitlu,pcTitluColoane,"")
*!* If !Empty(locauta.nume_gestiune)
*!* nid_gestiune=locauta.id_gestiune
*!* pcgestiune=ALLTRIM(locauta.nume_gestiune)
*!* Endif
*!* pcSchema=['']
*!* pcSelect=['select * from ]+gcS+[.imob_vjurnal where 1=2']
*!* pcOrder=[gestiune,cont]
*!* *pcFiltru = [id_tip_imobilizare=?tnTip and iesit_din_gest=0 and id_gestiune=?nid_gestiune]
*!* pcFiltru = [id_tip_imobilizare=?tnTip and iesit_din_gest=0]+IIF(pcgestiune="TOATE GESTIUNILE",[],[and id_gestiune=?nid_gestiune])
*!* llAfiseaza = .F.
*!* gencursor('poLista','crslista',pcSelect,pcFiltru,pcSchema,pcOrder,llAfiseaza)
*!* poLista.ca_baza1.afisare()
*!* pctitlu="LISTA IMOBILIZARILOR "+IIF(tnTip=1,"CORPORALE","NECORPORALE")+" IN LUNA"
*!* SELECT crslista
*!* * thisform.AlwaysOnTop = .F.
*!* REPORT FORM listmf_inv TO PRINTER PROMPT PREVIEW
*!* *thisform.AlwaysOnTop = .T.
*!* Release poLista
*!* ENDPROC
*!* *---------------------------------------------------------------------------
*!* PROCEDURE lista_inv_m2_c
*!* lista_inv_m2(1)
*!* ENDPROC
*!* *---------------------------------------------------------------------------
*!* PROCEDURE lista_inv_m2_n
*!* lista_inv_m2(2)
*!* ENDPROC
*!* *---------------------------------------------------------------------------
*!* PROCEDURE lista_inv_m2
*!* PARAMETERS tnTip
*!* * tnTip 1) Corp. 2) Necorp
*!* PRIVATE poLista,locauta
*!* Store '' To poLista
*!* Store "" To locauta
*!* private nid_gestiune
*!* nid_gestiune=1
*!* pcselect = ['select nume_gestiune,id_gestiune FROM ] + gcs + [.vnom_gestiuni where inactiv=0']
*!* pcfiltru = [1=2]
*!* pcschema = ['']
*!* pcorder = [nume_gestiune]
*!* pccoloane = [nume_gestiune]
*!* pcTitlu = [Alegeti gestiunea]
*!* pcTitluColoane = [Gestiune]
*!* locauta = cauta_alfa(pcselect,pcfiltru,pcschema,pcorder,pccoloane,pcTitlu,pcTitluColoane,"")
*!* If !Empty(locauta.nume_gestiune)
*!* nid_gestiune=locauta.id_gestiune
*!* pcgestiune=ALLTRIM(locauta.nume_gestiune)
*!* Endif
*!* pcSchema=['']
*!* pcSelect=['select * from ]+gcS+[.imob_vjurnal where 1=2']
*!* pcOrder=[gestiune,denumire]
*!* *pcFiltru = [id_tip_imobilizare=?tnTip and iesit_din_gest=0 and id_gestiune=?nid_gestiune]
*!* pcFiltru = [id_tip_imobilizare=?tnTip and iesit_din_gest=0]+IIF(pcgestiune="TOATE GESTIUNILE",[],[and id_gestiune=?nid_gestiune])
*!* llAfiseaza = .F.
*!* gencursor('poLista','crslista',pcSelect,pcFiltru,pcSchema,pcOrder,llAfiseaza)
*!* poLista.ca_baza1.afisare()
*!* pctitlu="LISTA IMOBILIZARILOR "+IIF(tnTip=1,"CORPORALE","NECORPORALE")+" IN LUNA"
*!* SELECT crslista
*!* *thisform.AlwaysOnTop = .F.
*!* REPORT FORM nota_inv2005 TO PRINTER PROMPT PREVIEW
*!* *thisform.AlwaysOnTop = .T.
*!* Release poLista
*!* ENDPROC
*!* *---------------------------------------------------------------------------
*!* PROCEDURE evidenta_mf && CORPORALE 'Evidenta MF'
*!* lcsql= " SELECT cont ,sum(valoare) as valoare,sum(amort_prec+rata) as amortizare_totala,"+;
*!* " sum(valoare_ramasa-amort_prec-rata) as valoare_ramasa,sum(valoare_ramasa-amort_prec_rata) as ramas_bilant, "+;
*!* " sum(rata) as rata,count(*) as numar "+;
*!* " FROM "+gcs+".imob_vjurnal where id_tip_imobilizare=1 and iesit_din_gest=0 GROUP BY cont ORDER BY cont"
*!* lnSucces=goExecutor.oExecute(lcSql,'crsevidentamf')
*!* IF lnSucces<0
*!* MESSAGEBOX("Nu a mers SQL-ul")
*!* return
*!* ENDIF
*!* STRTOFILE(lcsql,'c:\t.txt')
*!* SELECT crsevidentamf
*!* *thisform.AlwaysOnTop = .F.
*!* REPORT FORM evidenta_mf TO PRINTER PROMPT PREVIEW
*!* *thisform.AlwaysOnTop = .T.
*!* USE IN crsevidentamf
*!* ENDPROC
*!* *---------------------------------------------------------------------------
*!* PROCEDURE list_inchid_amortizari
*!* PRIVATE buton
*!* *ldDATAACT=GOMONTH(CTOD('01/'+m.nl+'/'+m.AN),1)-1
*!* LOCAL plcampsectie
*!* buton=1
*!* losterge=CREATEOBJECT('frm_mesaj','','info_c.ico','INTREBARE','Se calculeaza inchiderea dupa sectie ?',' ')
*!* losterge.show(1)
*!* If buton = 2
*!* plCampSectie = .F.
*!* Else
*!* plCampSectie = .T.
*!* ENDIF
*!* IF plCampSectie
*!*
*!* lcsql="select a.id_tip_imobilizare,a.data_achizitie,a.nract,b.cont, b.cont as ccont ,d.rata , "+;
*!* " e.sectie, c.explicatie "+;
*!* " from "+gcs+".imob_nom_mf a "+;
*!* " left join "+gcs+".imob_lista_mf b on a.id_mf=b.id_mf "+;
*!* " left join "+gcs+".imob_vultima_rata d on a.id_mf=d.id_mf "+;
*!* " left join "+gcs+".plcont c on b.cont=c.cont "+;
*!* " left join "+gcs+".nom_sectii e on b.id_sectie=e.id_sectie "+;
*!* " where a.inactiv=0 and a.sters=0 and a.id_tip_imobilizare=1 order by ccont"
*!* ELSE
*!* lcsql="select a.id_tip_imobilizare,a.data_achizitie,a.nract, c.explicatie,'.' as sectie , b.cont,b.cont as ccont,d.rata"+;
*!* " from "+gcs+".imob_nom_mf a "+;
*!* " left join "+gcs+".imob_lista_mf b on a.id_mf=b.id_mf "+;
*!* " left join "+gcs+".imob_vultima_rata d on a.id_mf=d.id_mf "+;
*!* " left join "+gcs+".plcont c on b.cont=c.cont "+;
*!* " where a.inactiv=0 and a.sters=0 and a.id_tip_imobilizare=1 order by ccont"
*!* ENDIF
*!* pcTitlu = [INCHIDERE AMORTIZARE - IMOBILIZARI CORPORALE]
*!* lnSucces=goExecutor.oExecute(lcSql,'tinchid')
*!* IF lnSucces<0
*!* MESSAGEBOX("Nu a mers SQL-ul")
*!* return
*!* ENDIF
*!* SELECT tinchid
*!* REPLACE ALL cont WITH [6811]
*!* SELECT distinct * FROM tinchid INTO CURSOR tinchid2
*!* SELECT tinchid2
*!* REPORT FORM act TO PRINTER PROMPT PREVIEW
*!* IF USED('tinchid2')
*!* USE IN tinchid2
*!* ENDIF
*!* IF USED('tinchid')
*!* USE IN tinchid
*!* ENDIF
*!* ENDPROC && list_inchid_amortizari
*!* *----------------------------------------------------
*!* PROCEDURE list_inchid_amortizari_nec
*!* PRIVATE buton
*!* *ldDATAACT=GOMONTH(CTOD('01/'+m.nl+'/'+m.AN),1)-1
*!* LOCAL plcampsectie
*!* buton=1
*!* losterge=CREATEOBJECT('frm_mesaj','','info_c.ico','INTREBARE','Se calculeaza inchiderea dupa sectie ?',' ')
*!* losterge.show(1)
*!* If buton = 2
*!* plCampSectie = .F.
*!* Else
*!* plCampSectie = .T.
*!* ENDIF
*!* IF plCampSectie
*!* lcsql="select a.id_tip_imobilizare,a.data_achizitie,a.nract,b.cont, b.cont as ccont ,d.rata , "+;
*!* " e.sectie, c.explicatie "+;
*!* " from "+gcs+".imob_nom_mf a "+;
*!* " left join "+gcs+".imob_lista_mf b on a.id_mf=b.id_mf "+;
*!* " left join "+gcs+".imob_vultima_rata d on a.id_mf=d.id_mf "+;
*!* " left join "+gcs+".plcont c on b.cont=c.cont "+;
*!* " left join "+gcs+".nom_sectii e on b.id_sectie=e.id_sectie "+;
*!* " where a.inactiv=0 and a.sters=0 and a.id_tip_imobilizare=2 order by ccont "
*!* ELSE
*!* lcsql="select a.id_tip_imobilizare,a.data_achizitie,a.nract,c.explicatie,'.' as sectie , b.cont,b.cont as ccont,d.rata"+;
*!* " from "+gcs+".imob_nom_mf a "+;
*!* " left join "+gcs+".imob_lista_mf b on a.id_mf=b.id_mf "+;
*!* " left join "+gcs+".imob_vultima_rata d on a.id_mf=d.id_mf "+;
*!* " left join "+gcs+".plcont c on b.cont=c.cont "+;
*!* " where a.inactiv=0 and a.sters=0 and a.id_tip_imobilizare=2 order by ccont"
*!* ENDIF
*!* pcTitlu = [INCHIDERE AMORTIZARE - IMOBILIZARI NECORPORALE]
*!* lnSucces=goExecutor.oExecute(lcSql,'tinchid')
*!* IF lnSucces<0
*!* MESSAGEBOX("Nu a mers SQL-ul")
*!* return
*!* ENDIF
*!* SELECT tinchid
*!* REPLACE ALL cont WITH [6811]
*!* SELECT distinct * FROM tinchid INTO CURSOR tinchid2
*!* SELECT tinchid2
*!* REPORT FORM act TO PRINTER PROMPT PREVIEW
*!* IF USED('tinchid2')
*!* USE IN tinchid2
*!* ENDIF
*!* IF USED('tinchid')
*!* USE IN tinchid
*!* ENDIF
*!* ENDPROC && list_inchid_amortizari_nec
*!* *-----------------------------------------------------------------------------------
*!* PROCEDURE rulaj_amortizment
*!* PRIVATE pcfelul
*!*
*!* lcAlias = sitan() && sitan.prg
*!* rulaje('amortizare_lunara',lcAlias) && IN sitan.prg
*!*
*!* SELECT rulaje
*!* GO top
*!* ov=CREATE('frm_analitice1')
*!* ov.lb_titlu_alb_b121.CAPTION='SITUATIE ANALITICA - RULAJ AMORTIZMENTE (In anul curent pana in luna curenta)'
*!* ov.SHOW(1)
*!* USE IN rulaje
*!* ENDPROC && rulaj_amortizment
*!* *-----------------------------------------------------------------------------------
*!* PROCEDURE total_amortizment
*!* PRIVATE pcfelul
*!*
*!* lcAlias = sitan() && sitan.prg
*!* rulaje('amortizare_totala',lcAlias) && IN sitan.prg
*!*
*!* SELECT rulaje
*!* GO top
*!* ov=CREATE('frm_analitice1')
*!* ov.lb_titlu_alb_b121.CAPTION='SITUATIE ANALITICA - TOTAL AMORTIZMENTE (In anul curent pana in luna curenta)'
*!* ov.SHOW(1)
*!* USE IN rulaje
*!* ENDPROC && total_amortizment
*!* *----------------------------------------------------------------------------------------------
*!* PROCEDURE preluare_corporale
*!* datain=CTOD('01/'+ALLTRIM(STR(v_luni.nrluna))+'/'+ALLTRIM(v_luni.an))
*!* lcsql="SELECT DISTINCT cod,id_fdoc,dataact,nract,partd as nume,explicatia,scd,SUMA, 0 as intr,id_fact,id_util "+;
*!* "FROM "+gcs+".vact WHERE substr(scd,1,2)=21 AND substr(scc,1,3)!=231"+;
*!* " AND nract!=0 and an="+ALLTRIM(v_luni.an)+" and luna="+ALLTRIM(STR(v_luni.nrluna))+""
*!*
*!* lnSucces=goExecutor.oExecute(lcsql,'actcs')
*!* IF lnSucces<0
*!* MESSAGEBOX("Nu a mers SQL-ul actcs")
*!* return
*!* ENDIF
*!* lcsql="SELECT * FROM "+gcs+".imob_vjurnal where id_tip_imobilizare=1"
*!* lnSucces=goExecutor.oExecute(lcSql,'mf')
*!* *STRTOFILE(lcsql,'c:\t.txt')
*!* IF lnSucces<0
*!* MESSAGEBOX("Nu a mers SQL-ul mf")
*!* return
*!* ENDIF
*!* SELECT actcs
*!*
*!* IF _tally # 0
*!* SELECT actcs
*!* SCAN
*!* SCATTER NAME oact
*!* lnVal = 0
*!* SELECT mf
*!* SUM valoare FOR nract = oact.nract AND data_achizitie = oact.dataact AND cont = oact.scd AND inactiv=0 TO lnVal
*!* DO CASE
*!* CASE lnVal = 0
*!* lnIntr = 0
*!* CASE lnVal = oact.suma
*!* lnIntr = 1
*!* CASE lnVal # oact.suma
*!* lnIntr = 2
*!* ENDCASE
*!* SELECT actcs
*!* REPLACE intr WITH lnIntr
*!* ENDSCAN
*!* else
*!* SELECT mf
*!* SCATTER NAME omf
*!* ENDIF
*!* SELECT actcs
*!* GO top
*!* SCATTER NAME oact
*!*
*!* *!* SELECT mf
*!* *!* LOCATE FOR nract = oact.nract AND data_achizitie = oact.dataact AND cont = oact.scd AND inactiv=0
*!* *!* IF !FOUND()
*!* *!* SCATTER MEMVAR blank
*!* *!* * MESSAGEBOX('Nu e OK')
*!* *!* ELSE
*!* *!* SCATTER MEMVAR
*!* *!* *MESSAGEBOX('OK')
*!* *!* ENDIF
*!* SELECT actcs
*!* SCATTER MEMVAR
*!* IF _tally#0
*!* SCATTER NAME oact
*!* SELECT mf
*!* LOCATE FOR nract = oact.nract AND data_achizitie = oact.dataact AND cont = oact.scd AND inactiv=0
*!* IF FOUND()
*!* SCATTER NAME omf
*!* ELSE
*!* SCATTER NAME omf blank
*!* endi
*!* endi
*!* STORE 1 TO m.tipcalcul
*!* PRIVATE INTRODUSTOT
*!* INTRODUSTOT=.F.
*!* =cctipuri_amort()
*!* SELECT actcs
*!* OI=CREATE('frm_preluare_contab1',1)
*!* OI.FEL_IMOB=1
*!* oi._lbbase3.caption=IIF(oact.intr=0,'Acest element nu este introdus!',IIF(oact.intr=1,'Acest element este introdus!','Introdus partial!'))
*!* oi.lb_titlu_alb_b121.CAPTION="LISTA IMOBILIZARILOR CORPORALE IN LUNA "+DTOC(datain)
*!* OI.SHOW(1)
*!* ENDPROC
*!* *----------------------------------------------------------------------------------------------
*!* PROCEDURE preluare_necorporale
*!* datain=CTOD('01/'+ALLTRIM(STR(v_luni.nrluna))+'/'+ALLTRIM(v_luni.an))
*!* lcsql="SELECT DISTINCT cod,id_fdoc,dataact,nract,partd as nume,explicatia,scd,SUMA, 0 as intr,id_fact,id_util "+;
*!* "FROM "+gcs+".vact WHERE substr(scd,1,2)=20 AND substr(scc,1,3)!=233"+;
*!* " AND nract!=0 and an="+ALLTRIM(v_luni.an)+" and luna="+ALLTRIM(STR(v_luni.nrluna))+""
*!*
*!* lnSucces=goExecutor.oExecute(lcsql,'actcs')
*!* IF lnSucces<0
*!* MESSAGEBOX("Nu a mers SQL-ul actcs")
*!* return
*!* ENDIF
*!* lcsql="SELECT * FROM "+gcs+".imob_vjurnal where id_tip_imobilizare=2"
*!* lnSucces=goExecutor.oExecute(lcSql,'mf')
*!* *STRTOFILE(lcsql,'c:\t.txt')
*!* IF lnSucces<0
*!* MESSAGEBOX("Nu a mers SQL-ul mf")
*!* return
*!* ENDIF
*!* SELECT actcs
*!*
*!* IF _tally # 0
*!* SELECT actcs
*!* SCAN
*!* SCATTER NAME oact
*!* lnVal = 0
*!* SELECT mf
*!* SUM valoare FOR nract = oact.nract AND data_achizitie = oact.dataact AND cont = oact.scd AND inactiv=0 TO lnVal
*!* DO CASE
*!* CASE lnVal = 0
*!* lnIntr = 0
*!* CASE lnVal = oact.suma
*!* lnIntr = 1
*!* CASE lnVal # oact.suma
*!* lnIntr = 2
*!* ENDCASE
*!* SELECT actcs
*!* REPLACE intr WITH lnIntr
*!* ENDSCAN
*!* ELSE
*!* SELECT mf
*!* SCATTER NAME omf
*!* ENDIF
*!* SELECT actcs
*!* GO TOP
*!* IF _tally#0
*!* SCATTER NAME oact
*!* SELECT mf
*!* LOCATE FOR nract = oact.nract AND data_achizitie = oact.dataact AND cont = oact.scd AND inactiv=0
*!* IF FOUND()
*!* SCATTER NAME omf
*!* ELSE
*!* SCATTER NAME omf blank
*!* ENDIF
*!* endi
*!* * STORE 1 TO m.tipcalcul
*!* PRIVATE INTRODUSTOT
*!* INTRODUSTOT=.F.
*!* =cctipuri_amort()
*!* SELECT actcs
*!*
*!* OI=CREATE('frm_preluare_contab1',2)
*!* OI.FEL_IMOB=2
*!* oi.lb_titlu_alb_b121.CAPTION="LISTA IMOBILIZARILOR NECORPORALE IN LUNA "+DTOC(datain)
*!* oi._lbbase3.caption=IIF(oact.intr=0,'Acest element nu este introdus!',IIF(oact.intr=1,'Acest element este introdus!','Introdus partial!'))
*!* OI.SHOW(1)
*!* ENDPROC
*!* *----------------------------------------------------------------------------------------------
*!* PROCEDURE preluare_incurs
*!* *!* SELECT DISTINCT cod, fdoc, dataact, nract, nume, explicatia, scd, ascd, SUMA ;
*!* *!* FROM act WHERE INLIST(LEFT(scd,3),'231','233') INTO CURSOR actcs
*!* * SELECT mf
*!* * SCATTER MEMVAR BLANK
*!* * SELECT DISTINCT act.cod,act.fdoc,act.dataact,act.nract,act.nume,act.explicatia,act.scd,act.SUMA, 0 as intr ;
*!* FROM act WHERE INLIST(LEFT(act.scd,3),'231','233') AND act.nract#0 INTO CURSOR actcs READWRITE
*!* datain=CTOD('01/'+ALLTRIM(STR(v_luni.nrluna))+'/'+ALLTRIM(v_luni.an))
*!* lcsql="SELECT DISTINCT cod,id_fdoc,dataact,nract,partd as nume,explicatia,scd,SUMA, 0 as intr,id_fact,id_util "+;
*!* "FROM "+gcs+".vact WHERE (substr(scd,1,3)=231 or SUBSTR(scd,1,3)=233) AND nract!=0"+;
*!* " AND nract!=0 and an="+ALLTRIM(v_luni.an)+" and luna="+ALLTRIM(STR(v_luni.nrluna))+""
*!*
*!* lnSucces=goExecutor.oExecute(lcsql,'actcs')
*!* IF lnSucces<0
*!* MESSAGEBOX("Nu a mers SQL-ul actcs")
*!* return
*!* ENDIF
*!* lcsql="SELECT * FROM "+gcs+".imob_vjurnal where id_tip_imobilizare=3"
*!* lnSucces=goExecutor.oExecute(lcSql,'mf')
*!* *STRTOFILE(lcsql,'c:\t.txt')
*!* IF lnSucces<0
*!* MESSAGEBOX("Nu a mers SQL-ul mf")
*!* return
*!* ENDIF
*!* SELECT actcs
*!* IF _tally # 0
*!* SELECT actcs
*!* SCAN
*!* SCATTER NAME oact
*!* lnVal = 0
*!* SELECT mf
*!* SUM valoare FOR nract = oact.nract AND data_achizitie = oact.dataact AND cont = oact.scd TO lnVal
*!* DO CASE
*!* CASE lnVal = 0
*!* lnIntr = 0
*!* CASE lnVal = oact.suma
*!* lnIntr = 1
*!* CASE lnVal # oact.suma
*!* lnIntr = 2
*!* ENDCASE
*!* SELECT actcs
*!* REPLACE intr WITH lnIntr
*!* ENDSCAN
*!* ELSE
*!* SELECT mf
*!* SCATTER NAME omf blank
*!* ENDIF
*!* SELECT actcs
*!* GO TOP
*!* IF _tally#0
*!* SCATTER NAME oact
*!* SELECT mf
*!* LOCATE FOR nract = oact.nract AND data_achizitie = oact.dataact AND cont = oact.scd AND inactiv=0
*!* IF FOUND()
*!* SCATTER NAME omf
*!* ELSE
*!* SCATTER NAME omf blank
*!* ENDIF
*!* ENDIF
*!* M.ID_SECTIE=0
*!* PRIVATE INTRODUSTOT
*!* INTRODUSTOT=.F.
*!* OI=CREATE('frm_preluare_contab_curs')
*!* OI.FEL_IMOB=3
*!* oi.lb_titlu_alb_b121.CAPTION="LISTA IMOBILIZARILOR NECORPORALE IN LUNA "+DTOC(datain)
*!* oi._lbbase3.caption=IIF(oact.intr=0,'Acest element nu este introdus!',IIF(oact.intr=1,'Acest element este introdus!','Introdus partial!'))
*!* OI.SHOW(1)
*!* ENDPROC && preluare_incurs
*!* *-------------------------------------------------------------------------------------------------------------------------

911
Programe/roaimob.prg Normal file
View File

@@ -0,0 +1,911 @@
*!* 24.04.2012
*!* nu se mai verifica seria HDD
PARAMETERS tparam
&&& roaimob
LOCAL lchost, lcUserName, lcPassword, lnIdUtil, lnIdProgram, lcUserNameApp,lcPasswordApp
STORE '' TO lchost, lcUserName, lcPassword, lcUserNameApp,lcPasswordApp
STORE 0 TO lnIdUtil, lnIdProgram
PRIVATE gcNumeProgram
gcNumeProgram = [ROAIMOB]
_SCREEN.ICON = gcNumeProgram + [.ICO]
IF !LIKE(gcNumeProgram + '*', UPPER(ALLTRIM(JUSTSTEM(SYS(16,0)))))
Messagebox("Nu puteti porni acest program!",0+16,"Atentie")
RETURN
ENDIF
SET CENTURY ON
SET DELETED ON
SET DATE TO DMY
SET MARK TO '/'
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
*SET NULLDISPLAY TO '*'
SET NULLDISPLAY TO ''
SET DECIMALS TO 4
SET POINT TO '.'
_SCREEN.VISIBLE=.F.
*VARIABILE_______
LOCAL lcMainClassLib
LOCAL lcLastSetTalk,lcLastSetPath,lcLastSetClassLib,lcOnShutdown
*VARIABILE__________________________________________________________________________
DECLARE nror[65000]
PUBLIC CRLF
STORE CHR(13) + CHR(10) TO CRLF
*!* PUBLIC pcNl,pcAn
*!* STORE "" TO pcNl,pcAn && se initializeaza in start00
PUBLIC pcTitlu,pl_verificat,pcdurata
STORE "" TO pcTitlu
STORE .F. TO pl_verificat
*!* PUBLIC BUTON, luna_inchisa, luna_neplatita, PRIMADATA, m.ctva, m.ctvam, m.ctvai, antet, m.nivel
PUBLIC buton,primadata,dirgen,col_menu,gestiune,gcAntet, m.antet
*!* Public OStart,OSETVIZ,OSETTULBAR,OSETINSTRUM,orm,OTEXT,OJUR,osetgest,tlbr_INSTR,tlbr_VIZ,oprinc,DIRGEN,buton
*!* PUBLIC pcapsocsub,pcapsocvar
*!* pcapsocsub=0
*!* pcapsocvar=0
*!* PUBLIC a4
*!* a4=.T.
*!* m.nrgrup=999
*!* Store .F. To luna_inchisa,tlbr_INSTRum,tlbr_VIZ
STORE 1 TO buton,col_menu
STORE .T. TO primadata &&,luna_neplatita
*-- Save and configure environment.***********************
lcLastSetTalk=SET("TALK")
SET TALK OFF
lcLastSetPath=SET("PATH")
PUBLIC glVerificTabel && daca se verifica structura tabelelor in totv.prg
glVerificTabel=.T.
PUBLIC glQuit
glQuit = .F.
PUBLIC gnIdIstoric
gnIdIstoric = 0
PUBLIC gcAppPath,gcAppName, gcTempPath, gcCaleServerDate, gcUserNameApp, gcPasswordApp
STORE '' TO gcUserNameApp, gcPasswordApp, gnNivelUtilizator, gnGrupUtilizator, gcAcces
*!* PUBLIC gcSchemaPath
*!* STORE '' TO gcSchemaPath
Set Procedure To "D:\ROA\ROAIMOB\COMUN\UTILE\web\WWUTILS.PRG" Additive
Set Procedure To "D:\ROA\ROAIMOB\COMUN\UTILE\web\WWAPI.PRG" Additive
gcAppPath = ADDBS(ShortPath(GetAppStartPath())) && wwutils.prg
If Right(gcAppPath ,9)="PROGRAME\"
gcAppPath = Substr(gcAppPath ,1,Len(gcAppPath )-9)
Endif
gcAppName=ALLT(UPPE(JUSTSTEM(SYS(16,0)))) && "roaimob"
gcUtilizatoriPath = gcAppPath + "UTILIZATORI\"
Set Default To (gcAppPath)
lcPath = gcAppPath + 'Date;' + ;
gcAppPath + 'Include;' + ;
gcAppPath + 'FERESTRE;' + ;
gcAppPath + 'GRAFICE;' + ;
gcAppPath + 'CLASE;' + ;
gcAppPath + 'MENIURI;' + ;
gcAppPath + 'PROGRAME;' + ;
gcAppPath + 'RAPOARTE;' + ;
gcAppPath + 'COMUN;' + ;
gcAppPath + 'COMUN\CLASE;' + ;
gcAppPath + 'COMUN\FERESTRE;' + ;
gcAppPath + 'COMUN\PROGRAME;' + ;
gcAppPath + 'COMUN\GRAFICE;' + ;
gcAppPath + 'COMUN\RAPOARTE;' + ;
gcAppPath + 'COMUN\MENIURI;' + ;
gcAppPath + 'COMUN\UTILE\GRIDEXTRAS;' + ;
gcAppPath + 'COMUN\UTILE\CTL32;' + ;
gcAppPath + 'COMUN\UTILE\HPDF;' + ;
gcAppPath + 'COMUN\UTILE\HPDF\REPORTOUTPUT;' + ;
gcAppPath + 'COMUN\UTILE\WEB;' + ;
gcAppPath + 'COMUN\UTILE\Excel;' + ;
Addbs(Substr(gcAppPath,1,Rat([\],gcAppPath,2)))+[COMUNROA\]
*!*Set Path To Date;Include;FERESTRE;GRAFICE;Help;CLASE;MENIURI;PROGRAME;RAPOARTE;PROGS;LIBS
SET PATH TO &lcPath ADDITIVE
PUSH MENU _MSYSMENU
lcLastSetClassLib=SET("CLASSLIB")
lcMainClassLib= gcAppPath + "clase\oimobilizari.vcx"
STORE "" TO gcTempPath, gcCaleServerDate
*** DIRGEN
liat = RAT("\",gcAppPath,2)
dirgen = ADDBS(LEFT(gcAppPath,liat-1))
*!* v 2.0.17
PUBLIC gcDirMare
gcDirMare = dirgen
*!* v 2.0.17 ^
gcSecurityPath = dirgen + 'Security\'
gcSecurityFile = gcSecurityPath + 'ROA_SECURITY.TXT'
*CLASE__________________________________________________________
SET CLASSLIB TO (lcMainClassLib) ADDITIVE
SET CLASSLIB TO registry ADDITIVE
SET CLASSLIB TO cauta_alfa_forms ADDITIVE
SET CLASSLIB TO caut_ora ADDITIVE
SET CLASSLIB TO ofundal_imob ADDITIVE
SET CLASSLIB TO serii_numere ADDITIVE
*PROCEDURI______________________________________________________
*!* Set Procedure To proceduri Additive
*!* Set Procedure To pmenu Additive
SET PROCEDURE TO proceduri_comune ADDITIVE
SET PROCEDURE TO sitan ADDITIVE
SET PROCEDURE TO quitapp ADDITIVE
SET PROCEDURE TO init_program ADDITIVE
SET PROCEDURE TO oproceduri_listari ADDITIVE
SET PROCEDURE TO proceduri_meniu ADDITIVE
*!* 11.11.2009
SET PROCEDURE TO oserii_numere ADDITIVE
*!* 11.11.2009 ^
SET PROCEDURE TO regex ADDITIVE
&& CLASE ORACLE
SET CLASSLIB TO DECABAZA ADDITIVE
SET CLASSLIB TO onomenclatoare ADDITIVE
SET CLASSLIB TO ferestre_oracle ADDITIVE
SET CLASSLIB TO onom_imob ADDITIVE
SET CLASSLIB TO otoolbar ADDITIVE
SET CLASSLIB TO ocriterii ADDITIVE
SET CLASSLIB TO MESSAGEBOX ADDITIVE
*!* v 2.0.17
SET CLASSLIB TO wwdialogs.vcx additive
*!* v 2.0.17 ^
*!* 11.11.2009
SET CLASSLIB TO serii_numere.vcx ADDITIVE
*!* 11.11.2009 ^
SET CLASSLIB TO accessibility.vcx ADDITIVE
************************************************************************************************
&& PROCEDURI ORACLE
SET PROCEDURE TO gencursor.prg ADDITIVE
SET PROCEDURE TO oproceduri_comune.prg ADDITIVE
SET PROCEDURE TO oproceduri_imob.prg ADDITIVE
SET PROCEDURE TO oproceduri_operatii.prg ADDITIVE
SET PROCEDURE TO ofunctii_imob.prg ADDITIVE
SET PROCEDURE TO oinit_optiuni.prg ADDITIVE
SET PROCEDURE TO update_imob.prg ADDITIVE
SET PROCEDURE TO updateserver.prg ADDITIVE
SET PROCEDURE TO oproceduri_ams.prg ADDITIVE
SET PROCEDURE TO ocautare.prg ADDITIVE
SET PROCEDURE TO osecurity.prg ADDITIVE
SET PROCEDURE TO acces_meniu.prg ADDITIVE
SET PROCEDURE TO oheader.prg ADDITIVE
*!* 12.07.2006
*!* marius.mutu
SET PROCEDURE TO oproceduri_comune_imob.prg ADDITIVE
*!* 19feb2009
*!* liana.neagu
Set Procedure To cauta_alfa.prg ADDITIVE
SET PROCEDURE TO oexport.prg ADDITIVE
*!* v 2.0.17
Set Procedure To validare.prg ADDITIVE
SET PROCEDURE TO iniacces.prg ADDITIVE
SET PROCEDURE TO oupdate.prg additive
SET PROCEDURE TO procese.prg additive
SET PROCEDURE TO version.prg additive
SET PROCEDURE TO xmlaccess.prg additive
SET PROCEDURE TO xmlparser.prg additive
SET PROCEDURE TO filebringer.prg additive
SET PROCEDURE TO wwcodeupdate.prg additive
SET PROCEDURE TO wwhttp.prg ADDITIVE
*!* 19.06.2006
*!* marius.mutu
SET PROCEDURE TO wwxmlhttp.prg ADDITIVE
SET PROCEDURE TO ini.prg ADDITIVE
SET PROCEDURE TO wwconfig.prg ADDITIVE
*!* SET PROCEDURE TO wwutils.prg ADDITIVE
*!* SET PROCEDURE TO wwapi.prg ADDITIVE
SET PROCEDURE TO excelxml.prg ADDITIVE
Declare Integer GetPrivateProfileString In Kernel32 ;
string, String, String, String @, Integer, String
Declare Integer WritePrivateProfileString In Kernel32 ;
string, String, String, String
Declare Integer CopyFile In kernel32;
STRING lpExistingFileName,;
STRING lpNewFileName,;
INTEGER bFailIfExists
Declare Integer URLDownloadToFile In urlmon.Dll;
INTEGER pCaller, String szURL, String szFileName,;
INTEGER dwReserved, Integer lpfnCB
Declare Integer PathFileExists In shlwapi;
STRING pszPath
*!* v 2.0.17 ^
*******************************************************************************************
IF PCOUNT() = 1 AND TYPE('tparam') = 'C'
glParametri = .T.
PRIVATE laParametri
DECLARE laParametri[1]
lcParam = ALLTRIM(tparam)
lnNr = lista2array(lcParam,@laParametri,";")
IF lnNr < 5
MESSAGEBOX('Numar incorect de parametri',0+16,'Eroare')
RETURN
ENDIF
lchost = laParametri[1]
lcUserName = laParametri[2]
lcPassword = laParametri[3]
lnIdUtil = ROUND(VAL(laParametri[4]),0)
lnIdProgram = ROUND(VAL(laParametri[5]),0)
ELSE
glParametri = .F.
lchost = 'JCSSERVER'
lcUserName = 'CONTAFIN_ORACLE'
lcPassword = ''
lnIdUtil = 0
lnIdProgram = 0
ENDIF
PRIVATE gcGeneralIniFile, gcSettingsFile
gcGeneralIniFile = ADDBS(m.dirgen) + "settings.ini"
gcSettingsFile = m.gcGeneralIniFile
IF !FILE(gcGeneralIniFile)
TEXT TO lcSettings NOSHOW
[errors]
host=
ENDTEXT
STRTOFILE(lcSettings, gcGeneralIniFile)
ENDIF
PRIVATE poLog,goLog && obiect pt logarea mesajelor sistemului
poLog = NEWOBJECT("Log_Mesaje","Log_Mesaje.prg")
goLog = poLog
*!* Locale
Set Classlib To locale Additive
Private gcLocalePath, goLocale, gcLocale, glTraducere
glTraducere = .F.
gcLocalePath = gcAppPath + "Locale\"
*!* lcLocaleDb = gcLocalePath + "locale.dbc"
*!* Open Database (m.lcLocaleDb)
goLocale=Newobject("Locale","Locale.vcx")
lcLanguage = getini(gcGeneralIniFile,"locale","lang")
llLocale= getini(gcGeneralIniFile,"locale","llocale")
IF !EMPTY(m.llLocale) AND m.llLocale<>'0'
goLocale.llocale=.T.
ENDIF
If Empty(m.lcLanguage)
gcLocale = 'Romana'
Else
gcLocale = m.lcLanguage
Endif
goLocale.locale = gcLocale
*!* Locale ^
IF verificari()
_SCREEN.VISIBLE=.T.
MESSAGEBOX("Se fac verificari programului!"+CRLF+"Va rugam reveniti!",64,"ROA Imobilizari")
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.
MESSAGEBOX("Programul trebuie pornit doar din START!",64,"ROA Imobilizari")
QUIT
ENDIF
ENDIF
*!* PUBLIC tipar,SER_PERM,SER_PERI,VERSIUNE
*!* STORE .F. TO SER_PERM,SER_PERI
***************************** VARIABILE ORACLE
PRIVATE goUtilizator
PRIVATE gnHandle,gnidutil,GCCODFISCAL,GCADRESA,GCNUMEFIRMA,GCMONEDA,GNDIFZILE, gcUserNameApp, gcPasswordApp
PRIVATE gnButon && variabila pentru renunt si terminat
STORE 2 TO gnButon
STORE '' TO GCCODFISCAL,GCADRESA,GCNUMEFIRMA,GCMONEDA, gcUserNameApp, gcPasswordApp, gcNivelUtilizator, gcGrupUtilizator, gcAcces
gnHandle = -1
gnidutil = 0
PRIVATE gcHost, gcUserName, gcPassword,gofundal, gnIdProgram, gnId_Prg_Owner
gnIdProgram = 0
gnId_Prg_Owner = 0
gofundal=''
PRIVATE goFirma,gnIdFirma,gcFirma,gnAn,gnLuna && ,gnPA,gnPC
&& STORE 0 TO gnPA,gnPC && nr. de zecimale afisare, calcul
STORE NULL TO goFirma
STORE 0 TO gnIdFirma, gnAn, gnLuna
STORE '' TO gcFirma
PRIVATE glUltimaLuna,glPrimaLuna, glLunaBuna,glLuna_neplatita,glLunaInchisa
STORE .F. TO glUltimaLuna,glPrimaLuna, glLunaBuna,glLuna_neplatita,glLunaInchisa
***toolbar***
PRIVATE otool,ohelp
STORE '' TO otool,ohelp
***toolbar***
PRIVATE gcS && schema firmei
STORE 'CONTAFIN' TO gcS
IF TYPE('laparametri',1)="A"
IF ALEN(laParametri,1)=10
gnAn = VAL(laParametri[7])
gnLuna = VAL(laParametri[8]) &&lansare noua
gcS = laParametri[9]
gnIdFirma = Val(laParametri[10])
ENDIF
ENDIF
PRIVATE gcCopyRight
gcCopyRight = '<27> ROA Romfast SRL'
&& obiect global wrap pentru sqlexec cu text eroare si succes
PRIVATE goExecutor
goExecutor = CREATEOBJECT("oExecutor")
&& obiect global wrap pentru sqlconnect, sqldisconnect; apeleaza proceduri postconectare pentru setare variabile sesiune
PRIVATE goConn
goConn = CREATEOBJECT("oConn")
PRIVATE goMyXMLHTTP
lcHostErrors = getini(gcGeneralIniFile,'errors','host')
goMyXMLHTTP = CREATEOBJECT("MyXMLHTTP", lcHostErrors)
&& obiect global pentru export : frx, xls
Private goExport
goExport = Createobject("oExportConfig")
&& obiect global pt luna aleasa din calendar
PRIVATE goCalendar
STORE NULL TO goCalendar
gcHost = lchost
gcUserName = lcUserName
gcPassword = lcPassword
gcUserNameApp = lcUserNameApp
gcPasswordApp = lcPasswordApp
gnidutil = lnIdUtil
gnIdProgram = lnIdProgram
IF !glParametri
lnValid = getcrsSecurity(gcSecurityFile)
IF lnValid > 0
IF USED('crsHost')
SELECT crsHost
GO TOP
gcHost = ALLTRIM(HOST)
gcUserName = ALLTRIM(schema)
gcPassword = ALLTRIM(pwd)
USE IN crsHost
ENDIF
ENDIF
ENDIF
***************************** VARIABILE ORACLE
&& DECLARARE VARIABILE GLOBALE SPECIFICE APLICATIEI CARE NU SE AFLA IN OPTIUNI_FIRMA
&& (SE AFLA IN DIRECTORUL PROIECTULUI, NU IN COMUN)
*!* Do OVARIABILE_GLOBALE.PRG
*!* USE &gcAppPath\SERIMOB 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()
*!* * daca exista comdir.snr - trec mai departe :) presupun ca s-a instalat kitul de client chiar daca nu s-a verificat seria
*!* IF !FILE(getCaleWin() + 'comdir.snr')
*!* QUIT
*!* ENDIF
*!* ENDIF
*!* ENDIF
PUBLIC NUMEPROGRAM,MENIUPROGRAM,FUNDALPROGRAM
MODEL_PROGRAM = 'M'
NUMEPROGRAM='ROA Imobilizari '+MODEL_PROGRAM
MENIUPROGRAM=gcAppPath+"meniuri\roaimob.mpr"
FUNDALPROGRAM=gcAppPath+"FERESTRE\FUNDAL.scx"
_program='cont'
*-- Configure application object.*****************************
_SCREEN.WINDOWSTATE=2
*!* 20.04.2012
PRIVATE gcReportPreviewer, gcReportPreviewerPath
gcReportPreviewer = "FoxyPreview" && oexport.prg
gcReportPreviewerPath = dirgen + "COMUNROA\"
*!* 20.04.2012 ^
lcOnShutdown="ShutDown()"
ON SHUTDOWN &lcOnShutdown
ON ERROR ErrorHandler(ERROR(),PROGRAM(),LINENO())
*_SHELL="DO Cleanup IN progs\cont2003"
*-- Instantiate application object.***************************
RELEASE goApp
PUBLIC goApp
goApp = CREATEOBJECT("cApplication")
* 10.06.2020 mod experimental se citeste din optiuni utilizator
ADDPROPERTY(goApp, 'nExperimental', 0)
LOCAL laVersion
DIMENSION laVersion(12)
IF AGETFILEVERSION(laVersion, SYS(16,0)) > 0
NUMEPROGRAM = laVersion(10)
ENDIF
RELEASE laVersion
goApp.SetCaption(NUMEPROGRAM)
goApp.cStartupMenu=MENIUPROGRAM
*goApp.cStartupForm=FUNDALPROGRAM
goApp.cStartupForm = gcAppPath + "COMUN\ferestre\frm_login.scx"
_SCREEN.WINDOWSTATE=2
*-- Show application.
goApp.SHOW
*-- Release application.
RELEASE goApp
cleanup()
*-- 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
************************************************************************************************
* FUNCTII______________________________________________________________________
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 TYPE('goMyXMLHTTP') = 'O'
lcLunaHTTP = IIF(TYPE('gnLuna') = 'N', TRANSFORM(gnLuna) + "/","") + IIF(TYPE('GNAN') = 'N', TRANSFORM(gnAn),"")
lcErrorMsgHTTP = SYS(0) + ":" + IIF(TYPE('GCS')='C'," " + gcS,"") + ": " + lcLunaHTTP + CHR(13) +CHR(10) + lcErrorMsg + ;
CHR(13) +CHR(10) + CHR(13) + CHR(10) + GETCALLSTACK()
lcUserName = gcUserNameApp
lcProgram = JUSTSTEM(SYS(16,0))
goMyXMLHTTP.postError(lcErrorMsgHTTP, lcUserName, lcProgram)
ENDIF
IF AMESSAGEBOX(lcErrorMsg,17,_SCREEN.CAPTION)#1
ON ERROR
RETURN .F.
ENDIF
ENDFUNC
************************************************************************************************
FUNCTION SHUTDOWN
*!* IF Start_Nou()
*!* =End_Istoric(gnIdIstoric, ADDBS(dirgen)+"DATERETEA\", "START_ISTORIC")
*!* ENDIF
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 .T.
*!* *!* RETURN 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
************************************************************************************************
FUNCTION getCaleWin
LOCAL lcPath, lcCaleWin
lcPath = ""
lcCaleWin = "c:\windows\"
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)
lcCaleWin = ADDBS(lcCaleWin)
RETURN lcCaleWin
ENDFUNC

156
Programe/sitan.prg Normal file
View File

@@ -0,0 +1,156 @@
********
Procedure sitan
LPARAMETERS tnFiscala
Local lcCursor, lcCursorTemp, lcFiltru, lcSchema, lcSel, llExperimental, llSucces, lnLuna
PRIVATE pcCond, pdDataF, pdDataI, pdData, pnFiscala
pdDataI = Date(gnAn, 1, 1)
pdDataF = Date(gnAn, gnLuna, 1)
pcCond = [1=1]
IF EMPTY(m.tnFiscala) OR TYPE('tnFiscala') <> 'N'
pnFiscala = 0
ELSE
pnFiscala = m.tnFiscala
ENDIF
lcSchema = [''] &&['ceck n(1),totdebit n(16,gnPa),totcredit n(16,gnPa),id_fact n(10),id_part n(10),nume c(50),dataact D,dataireg D,nract n(14),datascad D,cont c(4),acont c(4)']
lcCursor = 'crslista'
llExperimental = .T. && 25.11.2021 llExperimental = (goApp.nExperimental = 1)
If m.llExperimental
* EXPERIMENTAL SELECTIE DIN IMOB_VSITUATIE_LUNARA IN LOC DE PACK_IMOB.CALCUL_SITUATIE_LUNARA()
* Setez luna pentru view
lcFiltru = [id_tip_imobilizare in (1,2)] + m.gcCondSucursala
For lnLuna = 1 To m.gnLuna
pdData = DATE(m.gnAn, m.lnLuna, 1)
WAIT WINDOW 'Luna ' + PADL(m.lnLuna,2,'0') + '/' + ALLTRIM(STR(m.gnAn)) NOWAIT
llSucces = goExecutor.oExecuta('begin pack_imob.setlunacurenta(?pdData); end;')
If m.llSucces
lcSel = [SELECT * FROM ] + Iif(m.pnFiscala = 0, [imob_vsituatie_lunara], [imobf_vsituatie_lunara]) + [ WHERE ] + m.lcFiltru
lcCursorTemp = Sys(2015)
llSucces = goExecutor.oExecuta(m.lcSel, m.lcCursorTemp)
If !Used(m.lcCursor)
Select * From (m.lcCursorTemp) Into Cursor (m.lcCursor) Readwrite
Else
Select (m.lcCursor)
Append From Dbf(m.lcCursorTemp)
Endif
Use In (Select(m.lcCursorTemp))
Endif
Endfor
Else
lcSel = [{call pack_imob.CALCUL_SITUATIE_LUNARA(?pdDataI,?pdDataF,?pcCond,?pnFiscala,?gnIdSucursala)}]
llSucces = goExecutor.oExecuta(lcSel, lcCursor)
Endif
If !m.llSucces
Return
Endif
Select Sum(rata) As amortizare_lunara, Sum(rata + amort_prec) As amortizare_totala, data_test As ddata, Cont ;
FROM &lcCursor ;
WITH (Buffering = .T.) ;
WHERE Inlist(id_tip_imobilizare, 1, 2) ;
INTO Cursor sitmf ;
GROUP By ddata, Cont
Use In (SELECT(m.lcCursor))
Return [sitmf]
Endproc && sitan
*---------------------------------------------------------------------------
Procedure rulaje
Parameters tcCamp, tcAlias
datain = Ctod('01/' + Alltrim(Str(v_luni.nrluna)) + '/' + Alltrim(v_luni.an))
lcCamp = Alltrim(tcCamp)
If Empty(tcAlias)
lcAlias = [sitmf]
Else
lcAlias = Alltrim(tcAlias)
Endif
Select Distinct Cont From (lcAlias) Into Cursor conturi
*!* SELECT distinct ddata as luna FROM (lcAlias) INTO CURSOR luni
Select Distinct ddata As luna From (lcAlias) Into Cursor crsluni
Create Cursor luni (luna c(8))
Select crsluni
Scan
Scatter Name aaa
Select luni
Append Blank
Replace luna With Alltrim(Str(Month(aaa.luna))) + "/" + Alltrim(Str(Year(aaa.luna)))
Select crsluni
Endscan
*!* tt='create cursor rulaje (total c(6),luna d(8)'
tt = 'create cursor rulaje ( _ c(6),luna c(8)'
Select conturi
Scan
* SCAT MEMV
tt = tt + ',c' + Alltrim(Nvl(Cont, '')) + ' n(14,gnpa)'
* 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 Alltrim(luna) = Alltrim(Str(Month(m.ddata))) + "/" + Alltrim(Str(Year(m.ddata)))
*!* LOCATE FOR luna=m.ddata
tt = 'REPLACE c' + Alltrim(Nvl(m.cont, '')) + ' with ' + lcCamp
&tt
Select (lcAlias)
Endscan
*totaluri---
If Lower(Alltrim(tcCamp)) = [amortizare_lunara]
Local m.c
m.c = 0
Select rulaje
Append Blank
Replace _ With 'TOTAL'
Select conturi
Scan
Scatter Memv
Select rulaje
tt = 'sum c' + Alltrim(Nvl(m.cont, '')) + ' to m.c FOR ddata<=datain'
&tt
Select rulaje
Go Bott
tt = 'REPLACE c' + Alltrim(Nvl(Cont, '')) + ' with m.c'
&tt
Select conturi
Endscan
Endif
If Used('conturi')
Use In conturi
Endif
If Used('luni')
Use In conturi
Endif
If Used(lcAlias)
Use In (lcAlias)
Endif
*------------------------------------------------------------------------------------------------

53
Programe/update_nomenclator.prg Normal file
View File

@@ -0,0 +1,53 @@
**********************************************************
PROCEDURE update_nomenclator
*!* *!* DO update_coresp_tip_part
*!* *!* DO update_coresp_tip_cont
*!* DO update_lunilean
*!* *** tabele meniu deschise din proiect
*!* LOCAL lcCaleDateMenu
*!* lcCaleDateMenu=gcAppPath+[DATEMENU\]
*!* IF !USED('XREQUEST')
*!* USE &lcCaleDateMenu.XREQUEST IN 0 ALIAS XREQUEST
*!* ENDIF
*!* IF !USED('xitems')
*!* USE &lcCaleDateMenu.xitems IN 0 ALIAS xitems
*!* ENDIF
*!* IF !USED('YACT')
*!* USE &lcCaleDateMenu.YACT IN 0 ALIAS YACT
*!* ENDIF
*!* IF !USED('XSETS')
*!* USE &lcCaleDateMenu.XSETS IN 0 ALIAS XSETS ORDER TAG ID_SET
*!* ENDIF
*!* IF !USED('xACT')
*!* USE &lcCaleDateMenu.xACT IN 0 ALIAS xACT
*!* ENDIF
*!* IF !USED('xnote')
*!* USE &lcCaleDateMenu.xnote IN 0 ALIAS xnote
*!* ENDIF
*!* IF !USED('menu1')
*!* USE &lcCaleDateMenu.menu1 IN 0 ALIAS menu1 EXCL
*!* ENDIF
*!* IF !USED('INFISIERE')
*!* USE &lcCaleDateMenu.INFISIERE IN 0 ALIAS INFISIERE
*!* ENDIF
*!* IF !USED('nom_meniu')
*!* USE &lcCaleDateMenu.nom_meniu IN 0 ALIAS nom_meniu
*!* ENDIF
*!* IF !USED('refaceri')
*!* USE &lcCaleDateMenu.refaceri IN 0 ALIAS refaceri
*!* ENDIF
*!* IF !USED('tabela_fisa_cont')
*!* USE &lcCaleDateMenu.tabela_fisa_cont IN 0 ALIAS tabela_fisa_cont
*!* ENDIF
ENDPROC && update_nomenclator