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

Initial import of ROACONT (Visual FoxPro accounting app) into git

Browse Source 
Migrated from the ROACONT SVN trunk working copy for hosting on gitea.romfast.ro.
This commit is contained in:
Marius Mutu
2026-07-07 13:16:59 +03:00
parent 5f71dfb0de
commit 0acdff9647
2168 changed files with 207399 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

20
Programe/OVARIABILE_GLOBALE.PRG Normal file
View File

@@ -0,0 +1,20 @@
**OVARIABILE_GLOBALE.PRG
*** Citesc setarea pentru ReportBehaviour
IF TYPE('gnReportBehaviour') = 'U'
PUBLIC gnReportBehaviour
gnReportBehaviour = 90
ENDIF
LOCAL lcReportBehaviour
lcReportBehaviour = NVL(getini(m.gcGeneralIniFile,'report','reportbehaviour'), '')
IF EMPTY(m.lcReportBehaviour)
setini(m.gcGeneralIniFile,'report','reportbehaviour', '90')
gnReportBehaviour = 90
ELSE
gnReportBehaviour = VAL(m.lcReportBehaviour)
ENDIF
IF !INLIST(gnReportBehaviour, 80, 90)
setini(m.gcGeneralIniFile,'report','reportbehaviour', '90')
gnReportBehaviour = 90
ENDIF

515
Programe/export_sf_access.prg Normal file
View File

@@ -0,0 +1,515 @@
DEFINE CLASS export_sf_access AS custom
cPathKIT = "c:\bilant\"
cPathTempo = "c:\Temp\"
cBilant = "date1"
cCPP = "date2"
cDateInf = "date3"
cActive = "date4"
cFirma = "Date5"
&& ------------------------------INCEPUT: Init ------------------------------
*!* Procedura: Init
*!* Parametri:
*!* Data/Ora generarii: 17/02/2004 10:56
*!* Autor: MARIUS.MUTU
PROCEDURE INIT
LPARAMETERS tcPathKIT, tcPathTempo
IF TYPE('tcPathKIT')='C'
THIS.cPathKIT = ADDBS(tcPathKIT)
ENDIF
THIS.Init_Directoare(THIS.cPathKIT)
IF TYPE('tcPathTempo')='C'
THIS.cPathTempo = ADDBS(tcPathTempo)
ENDIF
THIS.Init_Directoare(THIS.cPathTempo)
ENDPROC
&& ------------------------------SFARSIT: Init ------------------------------
&& ------------------------------INCEPUT: Error ------------------------------
*!* Functia: Error
*!* Parametri: tnError, tcProcedura, tcMesaj
*!* Data/Ora generarii: 17/02/2004 11:35
*!* Autor: MARIUS.MUTU
FUNCTION ERRORH
LPARAMETERS tnError, tcProcedura, tnLinieMesaj
lcErrorNumber = ALLTRIM(STR(tnError))
lcProcedura = ALLTRIM(tcProcedura)
lcLinieMesaj = ALLTRIM(STR(tnLinieMesaj))
lcMesaj = MESSAGE(1)
lcText = "Eroarea nr. " + lcErrorNumber + CHR(13) + CHR(10) +;
"Procedura: " + lcProcedura + CHR(13) + CHR(10) +;
"Mesaj: " + lcMesaj + CHR(13) + CHR(10) +;
"Linia: " + lcLinieMesaj
= MESSAGEBOX(lcText)
ENDFUNC
&& ------------------------------SFARSIT: Error ------------------------------
&& ------------------------------INCEPUT: Init_Directoare ------------------------------
*!* Procedura: Init_Directoare
*!* Parametri: tcPath
*!* Data/Ora generarii: 17/02/2004 10:47
*!* Autor: MARIUS.MUTU
PROCEDURE Init_Directoare
LPARAMETERS tcPath
lcPath = ADDBS(tcPath)
IF !DIRECTORY(lcPath)
MD (lcPath)
ENDIF
ENDPROC
&& ------------------------------SFARSIT: Init_Directoare ------------------------------
&& ------------------------------INCEPUT: Copie_Fisiere_Vide ------------------------------
*!* Procedura: Copie_Fisiere_Vide
*!* Parametri: tcSPath, tcDPath, tcFileName
*!* Data/Ora generarii: 17/02/2004 11:07
*!* Autor: MARIUS.MUTU
PROCEDURE Copie_Fisiere_Vide
LPARAMETERS tcSPath, tcDPath, tcFileName
IF !DIRECTORY(tcSPath)
RETURN .F.
ENDIF
IF !DIRECTORY(tcDPath)
THIS.Init_Directoare(tcDPath)
ENDIF
IF EMPTY(tcFileName)
lcFileName = "*.*"
ELSE
lcFileName = ALLTRIM(tcFileName)+".*"
ENDIF
lcSFile = ADDBS(tcSPath) + lcFileName
lcDFile = ADDBS(tcDPath) + lcFileName
COPY FILE (lcSFile) TO (lcDFile)
RETURN .T.
ENDPROC
&& ------------------------------SFARSIT: Copie_Fisiere_Vide ------------------------------
&& ------------------------------INCEPUT: Completeaza_Date_Bilant ------------------------------
*!* Procedura: Completeaza_Date_Bilant
*!* Parametri: tcAliasBilant
*!* Data/Ora generarii: 17/02/2004 11:12
*!* Autor: MARIUS.MUTU
PROCEDURE Completeaza_Date_Bilant
LPARAMETERS tcAliasBilant
LOCAL lnNrRanduri, lcBilant, lcFisBilant, loBilant, llUsed
lnNrRanduri = 34
lcBilant = ALLTRIM(THIS.cBilant)
lcFisBilant = ADDBS(THIS.cPathKIT) + lcBilant + ".dbf"
IF !FILE(lcFisBilant)
RETURN .F.
ENDIF
llUsed = .T.
IF !USED(lcBilant)
llUsed = .F.
USE (lcFisBilant) IN 0 ALIAS (lcBilant)
ENDIF
IF USED('tBilant')
USE IN tBilant
ENDIF
SELECT PADL(ALLTRIM(a.nr),2,"0") AS RAND, a.suma2 AS suma1, a.suma AS suma2 ;
FROM (tcAliasBilant) a;
WHERE VAL(a.nr)!=0 ;
INTO CURSOR tBilant
SELECT (lcBilant)
SCATTER NAME loBilant BLANK
lcOldError = ON("error")
ON ERROR * && daca lipsesc coloane din tabelul (lcActive) nu procesez eroarea
SELECT tBilant
SCAN
lcVar1 = "loBilant.F10_"+PADL(ALLTRIM(RAND),3,'0')+'1'
&lcVar1 = suma1
lcVar2 = "loBilant.F10_"+PADL(ALLTRIM(RAND),3,'0')+'2'
&lcVar2 = suma2
ENDSCAN
ON ERROR &lcOldError
SELECT (lcBilant)
GATHER NAME loBilant
USE IN tBilant
IF !llUsed
USE IN (lcBilant)
ENDIF
ENDPROC
&& ------------------------------SFARSIT: Completeaza_Date_Bilant ------------------------------
&& ------------------------------INCEPUT: Completeaza_Date_Cpp ------------------------------
*!* Procedura: Completeaza_Date_Cpp
*!* Parametri:
*!* Data/Ora generarii: 17/02/2004 11:12
*!* Autor: MARIUS.MUTU
PROCEDURE Completeaza_Date_Cpp
LPARAMETERS tcAliasCPP
LOCAL lnNrRanduri, lcCPP, lcFisCPP, loCPP, llUsed
lnNrRanduri = 63
lcCPP = ALLTRIM(THIS.cCPP)
lcFisCPP = ADDBS(THIS.cPathKIT) + lcCPP + ".dbf"
IF !FILE(lcFisCPP)
RETURN .F.
ENDIF
llUsed = .T.
IF !USED(lcCPP)
llUsed = .F.
USE (lcFisCPP) IN 0 SHARED ALIAS (lcCPP)
ENDIF
IF USED('tCPP')
USE IN tCPP
ENDIF
SELECT PADL(ALLTRIM(a.RAND),2,"0") AS RAND, a.sumai AS suma1, a.sumac AS suma2 ;
FROM (tcAliasCPP) a;
WHERE VAL(a.RAND)!=0 ;
INTO CURSOR tCPP
lcOldError = ON("error")
ON ERROR * && daca lipsesc coloane din tabelul (lcActive) nu procesez eroarea
SELECT (lcCPP)
SCATTER NAME loCPP BLANK
SELECT tCPP
SCAN
lcVar1 = "loCPP.F20_"+PADL(ALLTRIM(RAND),3,'0')+'1'
&lcVar1 = suma1
lcVar2 = "loCPP.F20_"+PADL(ALLTRIM(RAND),3,'0')+'2'
&lcVar2 = suma2
ENDSCAN
ON ERROR &lcOldError
SELECT (lcCPP)
GATHER NAME loCPP
USE IN tCPP
IF !llUsed
USE IN (lcCPP)
ENDIF
ENDPROC
&& ------------------------------SFARSIT: Completeaza_Date_Cpp ------------------------------
&& ------------------------------INCEPUT: Completeaza_Date_Date_informative ------------------------------
*!* Procedura: Completeaza_Date_Date_informative
*!* Parametri:
*!* Data/Ora generarii: 17/02/2004 11:13
*!* Autor: MARIUS.MUTU
PROCEDURE Completeaza_Date_Date_informative
LPARAMETERS tcAliasDateInf
LOCAL lnNrRanduri, lcDateInf, lcFisDateInf, loDateInf, llUsed
lnNrRanduri = 22
lcDateInf = ALLTRIM(THIS.cDateInf)
lcFisDateInf = ADDBS(THIS.cPathKIT) + lcDateInf + ".dbf"
IF !FILE(lcFisDateInf)
RETURN .F.
ENDIF
llUsed = .T.
IF !USED(lcDateInf)
llUsed = .F.
USE (lcFisDateInf) IN 0 SHARED ALIAS (lcDateInf)
ENDIF
IF USED('tDateInf1')
USE IN tDateInf1
ENDIF
IF USED('tDateInf2')
USE IN tDateInf2
ENDIF
lcAliasDateInf = ALLTRIM(tcAliasDateInf)
lcAliasDateInf1 = lcAliasDateInf+"1R"
lcAliasDateInf2 = lcAliasDateInf+"2R"
SELECT PADL(ALLTRIM(a.RAND),2,"0") AS RAND, a.unitati AS suma1, a.sume AS suma2 ;
FROM (lcAliasDateInf1) a;
WHERE VAL(a.RAND)!=0 ;
INTO CURSOR tDateInf1
SELECT PADL(ALLTRIM(a.RAND),2,"0") AS RAND, a.sold AS suma1, a.col2 AS suma2, a.col3 AS suma3 ;
FROM (lcAliasDateInf2) a ;
WHERE VAL(a.RAND)!=0 ;
INTO CURSOR tDateInf2
*** DATEINF1
SELECT (lcDateInf)
SCATTER NAME loDateInf BLANK
lcOldError = ON("error")
ON ERROR * && daca lipsesc coloane din tabelul (lcActive) nu procesez eroarea
SELECT tDateInf1
SCAN
lcVar1 = "loDateInf.F30_"+PADL(ALLTRIM(RAND),3,'0')+'1'
&lcVar1 = suma1
lcVar2 = "loDateInf.F30_"+PADL(ALLTRIM(RAND),3,'0')+'2'
&lcVar2 = suma2
ENDSCAN
ON ERROR &lcOldError
SELECT (lcDateInf)
GATHER NAME loDateInf
USE IN tDateInf1
*** DATEINF2
lcOldError = ON("error")
ON ERROR * && daca lipsesc coloane din tabelul (lcActive) nu procesez eroarea
SELECT tDateInf2
SCAN
lcVar1 = "loDateInf.F30_"+PADL(ALLTRIM(RAND),3,'0')+'1'
&lcVar1 = suma1
lcVar2 = "loDateInf.F30_"+PADL(ALLTRIM(RAND),3,'0')+'2'
&lcVar2 = suma2
lcVar3 = "loDateInf.F30_"+PADL(ALLTRIM(RAND),3,'0')+'3'
&lcVar3 = suma3
ENDSCAN
ON ERROR &lcOldError
SELECT (lcDateInf)
GATHER NAME loDateInf
USE IN tDateInf2
IF !llUsed
USE IN (lcDateInf)
ENDIF
ENDPROC
&& ------------------------------SFARSIT: Completeaza_Date_Date_informative ------------------------------
&& ------------------------------INCEPUT: Completeaza_Date_Active_Imobilizate ------------------------------
*!* Procedura: Completeaza_Date_Active_Imobilizate
*!* Parametri:
*!* Data/Ora generarii: 17/02/2004 11:13
*!* Autor: MARIUS.MUTU
PROCEDURE Completeaza_Date_Active_Imobilizate
LPARAMETERS tcAliasActive
LOCAL lnNrRanduri, lcActive, lcFisActive, loActive, llUsed
lnNrRanduri = 33
lcActive = ALLTRIM(THIS.cActive)
lcFisActive = ADDBS(THIS.cPathKIT) + lcActive + ".dbf"
IF !FILE(lcFisActive)
RETURN .F.
ENDIF
llUsed = .T.
IF !USED(lcActive)
llUsed = .F.
USE (lcFisActive) IN 0 SHARED ALIAS (lcActive)
ENDIF
IF USED('tActive')
USE IN tActive
ENDIF
SELECT PADL(ALLTRIM(a.nr),2,"0") AS RAND, a.soldi AS suma1, a.crestere AS suma2, a.reducere AS suma3, a.casare AS suma4, a.soldf AS suma5 ;
FROM (tcAliasActive) a ;
WHERE VAL(a.nr)!=0 ;
INTO CURSOR tActive
lcOldError = ON("error")
ON ERROR * && daca lipsesc coloane din tabelul (lcActive) nu procesez eroarea
SELECT (lcActive)
SCATTER NAME loActive BLANK
SELECT tActive
SCAN
lcVar1 = "loActive.F40_"+PADL(ALLTRIM(RAND),3,'0')+'1'
&lcVar1 = suma1
lcVar2 = "loActive.F40_"+PADL(ALLTRIM(RAND),3,'0')+'2'
&lcVar2 = suma2
lcVar3 = "loActive.F40_"+PADL(ALLTRIM(RAND),3,'0')+'3'
&lcVar3 = suma3
lcVar4 = "loActive.F40_"+PADL(ALLTRIM(RAND),3,'0')+'4'
&lcVar4 = suma4
lcVar5 = "loActive.F40_"+PADL(ALLTRIM(RAND),3,'0')+'5'
&lcVar5 = suma5
ENDSCAN
ON ERROR &lcOldError
SELECT (lcActive)
GATHER NAME loActive
USE IN tActive
IF !llUsed
USE IN (lcActive)
ENDIF
ENDPROC
&& ------------------------------SFARSIT: Completeaza_Date_Active_Imobilizate ------------------------------
&& ------------------------------INCEPUT: Completeaza_Date_Firma ------------------------------
*!* Procedura: Completeaza_Date_Firma
*!* Parametri:
*!* Data/Ora generarii: 17/02/2004 11:14
*!* Autor: MARIUS.MUTU
PROCEDURE Completeaza_Date_Firma
LPARAMETERS tcAliasFirma
LOCAL lnNrRanduri, lcFirma, lcFisFirma, loFirma, llUsed
lcFirma = ALLTRIM(THIS.cFirma)
lcFisFirma = ADDBS(THIS.cPathKIT) + lcFirma + ".dbf"
IF !FILE(lcFisFirma)
RETURN .F.
ENDIF
llUsed = .T.
IF !USED(lcFirma)
llUsed = .F.
USE (lcFisFirma) IN 0 SHARED ALIAS (lcFirma)
ENDIF
SELECT (lcFirma)
SCATTER NAME loFirma BLANK
SELE firma
LOCA FOR ALLT(fscurt)=ALLT(nfscurt)
loFirma.codi=VAL(ALLT(STRTRAN(UPPE(cod_fiscal),'R','')))
SELECT (lcFirma)
GATHER NAME loFirma
IF !llUsed
USE IN (lcFirma)
ENDIF
ENDPROC
&& ------------------------------SFARSIT: Completeaza_Date_Firma ------------------------------
&& ------------------------------INCEPUT: Date_Noi_Bilant------------------------------
*!* Procedura: Date_Noi_Bilant
*!* Parametri:
*!* Data/Ora generarii: 17/02/2004 14:26
*!* Autor: MARIUS.MUTU
PROCEDURE Date_Noi_Bilant
LOCAL lnRaspuns
lnRaspuns = 7
lnFisiere = 5
DECLARE laFisiere[lnFisiere,2]
laFisiere[1,1] = "Bilant"
laFisiere[2,1] = "Cont Profit si Pierdere"
laFisiere[3,1] = "Date Informative"
laFisiere[4,1] = "Active Imobilizate"
laFisiere[5,1] = "Firma"
laFisiere[1,2] = "date1"
laFisiere[2,2] = "date2"
laFisiere[3,2] = "date3"
laFisiere[4,2] = "date4"
laFisiere[5,2] = "date5"
FOR i = 1 TO lnFisiere
lcMesaj = "Doriti sa creati un fisier gol pentru "+laFisiere[i,1]+"?"
lnRaspuns = AMESSAGEBOX(lcMesaj,4+32)
IF lnRaspuns = 7 && buton=2
LOOP
ENDIF
lcSpath = ADDBS(dirgen)+"_alfa\date_bilant\"
lcDPath = this.cPathKIT
lcFileName = laFisiere[i,2]
THIS.Copie_Fisiere_Vide(lcSpath, lcDPath, lcFileName)
IF i=1 && bilant -> copii si bazele de data access
lcFileName = [*.mdb]
lcFileS = lcSPath + lcFileName
lcFileD = lcDPath + lcFileName
COPY FILE (lcFileS) TO (lcFileD)
ENDIF
ENDFOR
ENDPROC
&& ------------------------------SFARSIT: Date_Noi_Bilant------------------------------
ENDDEFINE

370
Programe/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 ------------------------------

43
Programe/mesaje.prg Normal file
View File

@@ -0,0 +1,43 @@
*_________________________________________
PROCEDURE anunta_rezultat
LPARAMETERS lcCategorie, lcSursa, lcMesaj, llEroare, llInTabel, lnId_ref
IF llInTabel
scrie_in_mesaje(lcCategorie, lcSursa, lcMesaj, llEroare, lnId_ref)
ELSE
DO mesaj With lcMesaj, ''
ENDIF
ENDPROC
PROCEDURE scrie_in_mesaje
LPARAMETERS lcCategorie, lcSursa, lcMesaj, llEroare, lnId_ref
LOCAL lnOrdine
SELECT mesaje
CALCULATE MAX(ordine) TO m.lnOrdine
m.lnOrdine = m.lnOrdine + 1
APPEND BLANK
replace ordine WITH m.lnOrdine, sursa WITH lcSursa, mesaj WITH lcMesaj, ;
eroare WITH llEroare, categorie WITH lcCategorie, id_ref WITH lnId_ref
ENDPROC
PROCEDURE sterge_mesaje
ZAP IN mesaje
ENDPROC
PROCEDURE raport_mesaje
PARAMETERS tcPerioada
PRIVATE pcTitlu,pcPerioada,pcDataOra
*!* PRIVATE toFirma
*!* SELECT FIRMA
*!* LOCATE FOR NFSCURT=FSCURT
*!* SCATTER NAME m.toFirma
*!* SELECT mesaje
*!* IF RECNO() > 0
*!* SET ORDER TO ordine
*!* REPORT FORM mesaje TO PRINTER PROMPT PREVIEW
*!* ENDIF
pcTitlu=[VERIFICARE GLOBALA]
pcPerioada=[Perioada ]
pcdataora = get_ora(2)
SELECT crsverificari
REPORT FORM rap_mesaje TO PRINTER PROMPT preview
ENDPROC

100
Programe/obj2arr.PRG Normal file
View File

@@ -0,0 +1,100 @@
* Version....: 1.0
* Author.....: Maurice de Beijer
* Date.......: January 29, 1998
* Notice.....: Copyright (c) 1996-1998 ABL, All Rights Reserved.
* Compiler...: Visual FoxPro 05.00.00.0415 for Windows
* Abstract...: Creates a one dimensional array with a pointer
* to all object contained within the object
*
* Returns....: The number of selected objects
*
* Parameters.: taTarget
* Target array (passed by reference)
* taObject
* Container object reference
*
LPARAMETERS taTarget, taObject
LOCAL lnCount
lnCount = 0
DIMENSION taTarget[1, 1]
taTarget = NULL
*
* Make sure an object was passed
*
IF TYPE('taObject') = 'O' AND !ISNULL(taObject)
*
* Object passed into recursive call
*
object2array(@taTarget, taObject)
IF TYPE('taTarget[1]') = 'O'
*
* Retun the number of objects
*
lnCount = ALEN(taTarget, 1)
ENDIF
ENDIF
RETURN lnCount
*-------------------------------------------------------
* Function....: Object2Array
* Called by...: Obj2Arr
*
* Abstract....: Creates a one dimensional array with a pointer
* to all object contained within the object
*
* Returns.....: None
*
* Parameters..: taTarget
* Target array (passed by reference)
* taObject
* Container object reference
*
* Notes.......:
*-------------------------------------------------------
PROCEDURE Object2Array(taTarget, taObject)
LOCAL ARRAY laMembers[1, 1]
LOCAL lnCount, lnI
*
* Make sure the second parameter is an object before adding it to the array
*
IF TYPE('taObject') = 'O' AND !ISNULL(taObject)
IF TYPE('taTarget[1]') = 'O' AND !ISNULL(taTarget[1])
*
* Increase the array size
*
lnCount = ALEN(taTarget, 1) + 1
DIMENSION taTarget[lnCount]
*
* Add the current object to the end
*
taTarget[lnCount] = taObject
ELSE
*
* First object in the array
*
taTarget[1] = taObject
ENDIF
*
* Get all member names
*
lnCount = AMEMBERS(laMembers, taObject, 2)
FOR lnI = 1 TO lnCount
*
* Get all contained objects from the member objects
*
object2array(@taTarget, EVAL('taObject.' + laMembers[lnI]) )
ENDFOR
ENDIF
RETURN

2155
Programe/ocont2003.prg Normal file
View File

File diff suppressed because it is too large Load Diff

203
Programe/oproceduri_actualizari.prg Normal file
View File

@@ -0,0 +1,203 @@
Procedure actualizare_tva2007
Private pnActAct,pnActIregPart,pnActNote,pcAnLuna1,pcAnLuna2,pnLunaI,pnAnI,pnLunaF,pnAnF
Store 0 To pnActAct,pnActIregPart,pnActNote,pnLunaI,pnAnI,pnLunaF,pnAnF
Store "" To pcAnLuna1, pcAnLuna2
IF m.glLunaInchisa
AMESSAGEBOX('Luna este inchisa! Operatia nu este permisa.',0+64,_screen.Caption)
RETURN
ENDIF
IF m.gnAn<>2007
AMESSAGEBOX('Operatia este permisa doar pentru 2007!',0+64,_screen.Caption)
RETURN
ENDIF
loActTva = Createobject("frm_actualizare_tva")
loActTva.Show(1)
If gnButon = 1
pnLunaI = Val(Substr(pcAnLuna1,1,2))
pnAnI = Val(Substr(pcAnLuna1,3))
pnLunaF = Val(Substr(pcAnLuna2,1,2))
pnAnF = Val(Substr(pcAnLuna2,3))
_Screen.MousePointer = 11
lcSql = [begin actualizare_TVA2007(?pnActAct,?pnActIregPart,?pnActNote,?pnLunaI,?pnAnI,?pnLunaF,?pnAnF); end;]
lnSucces = goExecutor.oExecute(lcSql)
_Screen.MousePointer = 0
If lnSucces < 0
amessagebox(goExecutor.cEroare, 0+16, "Eroare")
Else
amessagebox("Inregistrarile au fost actualizate!" + Chr(13) + Chr(10) + ;
"Trebuie sa dati refacere in registrele de vanzari si cumparari incepand cu luna "+Iif(pnAnI<=2006,[01],Substr(pcAnLuna1,1,2)) +"/2007!",0+64,"Info actualizare")
Endif
Endif
Endproc
************************************************************************************************************************
Procedure actualizare_solduri_valuta
IF m.glLunaInchisa
AMESSAGEBOX('Luna este inchisa! Operatia nu este permisa.',0+64,_screen.Caption)
RETURN
ENDIF
Local lnIdSet, llVerificAnalitic, llCompletareParteneri, lcContAles
Local loHash
Local lcSql, lcCursor, lnSucces, lcSelect, lcSchema, lcSql, lcSelect2, lcOrder, lcFiltru, lcFiltruOriginal, loActualizare
lnIdSet = 90501
llVerificAnalitic = .T.
llCompletareParteneri = .T.
&& valute
*!* 08.05.2008
*!* lcSql = "select ID_VALUTA, NUME_VAL, 0000000.0000 as curs from vnom_valute where moneda_nationala = 0 order by nume_val"
&& ultima zi din luna curenta pentru cursul valutar
ldUltimaZi = Gomonth(Date(gnAn, gnLuna, 1),1) - 1
TEXT TO lcSql textmerge noshow
select V.ID_VALUTA, V.NUME_VAL, CAST(NVL(C.CURS, 0) AS NUMBER(18,6)) as curs
from vnom_valute V
LEFT JOIN (SELECT ID_VALUTA, MAX(CURS) AS CURS
FROM CURS
WHERE TO_DATE('<<Dtos(ldUltimaZi)>>', 'YYYYMMDD') BETWEEN DATA AND DATA2
GROUP BY ID_VALUTA) C ON V.ID_VALUTA = C.ID_VALUTA
where V.moneda_nationala = 0
order by V.nume_val
ENDTEXT
*!* 08.05.2008 ^
lcCursor = "crsValute"
lnSucces = goExecutor.oExecute(lcSql, lcCursor)
If lnSucces < 0
amessagebox(goExecutor.cEroare, 0+16, "Eroare")
Endif
*!* SELECT * FROM crsValuteTemp INTO CURSOR crsValute READWRITE
*!* USE IN crsValuteTemp
&& conturi cu inregistrari sau trezorerie
*!* 08.05.2008
*!* selecta sumele din balanta_parteneri si pentru 542 (trebuia doar pentru 5124, 5314)
*!* acum se poate face reevaluarea pentru toate conturile cu balanta de parteneri, nu numai pentru clasa 5
*!* lcSql = "select cont, explicatie, fel_cont,cu_inregistrari from config_cont_ireg where cu_inregistrari = 1 or SUBSTR(cont,1,1) = '5' order by cont"
lcSql = "select cont, explicatie, fel_cont,cu_inregistrari from config_cont_ireg order by cont"
*!* 09.05.2008 ^
lcCursor = "crsConturi"
lnSucces = goExecutor.oExecute(lcSql, lcCursor)
If lnSucces < 0
amessagebox(goExecutor.cEroare, 0+16, "Eroare")
Endif
&& cursor gol cu facturi
Private poireg_parteneri, pobalanta_parteneri
Store '' To poireg_parteneri, pobalanta_parteneri
lcSchema = [an n(4), luna n(2), ales N(1), id_fact n(20), id_part n(20), cont c(4), acont c(4), ID_VALUTA N(5), ] + ;
[PRECDEB N(20,4),PRECCRED N(20,4),PRECVALDEB N(20,4),PRECVALCRED N(20,4), ] + ;
[debit n(20,4),credit n(20,4),valdebit n(20,4), valcredit n(20,4), ] + ;
[nract N(20),DATAACT D,DATAIREG D,DATASCAD D,CURS N(18,6), ] + ;
[NUME C(100), NUME_VAL C(10), ] + ;
[CURSBNR N(18,6), SOLDVAL n(20,4), SOLDLEI n(20,4), DIFERENTA N(20,4), proc_tva n(10,4), id_jtva_coloana i]
lcSelect = [SELECT AN, LUNA, 1 as ales, ID_FACT, ID_PART, CONT, ACONT, ID_VALUTA, ] +;
[PRECDEB, PRECCRED, PRECVALDEB, PRECVALCRED, ] +;
[DEBIT, CREDIT, VALDEBIT, VALCREDIT, ] +;
[NRACT, DATAACT, DATAIREG, DATASCAD, CURS, ] +;
[NUME, NUME_VAL, ] + ;
[000000.000000 as cursbnr, 000000000.0000 as soldval, 000000000.0000 as soldlei, 000000000.0000 as diferenta, proc_tva, id_jtva_coloana ] + ;
[ FROM VIREG_PARTENERI]
lcSelect2 = [SELECT AN, LUNA, 1 as ales, 0 AS ID_FACT, ID_PART, CONT, ACONT, ID_VALUTA, ] +;
[PRECDEB, PRECCRED, PRECVALDEB, PRECVALCRED, ] +;
[DEBIT, CREDIT, VALDEBIT, VALCREDIT, ] +;
[0 AS NRACT, TO_DATE('', 'YYYYMMDD') AS DATAACT, TO_DATE('', 'YYYYMMDD') AS DATAIREG, TO_DATE('', 'YYYYMMDD') AS DATASCAD, 000000.0000 AS CURS, ] +;
[NUME, NUME_VAL, ] + ;
[000000.0000 as cursbnr, 000000000.0000 as soldval, 000000000.0000 as soldlei, 000000000.0000 as diferenta, 0000.0000 as proc_tva, 0000000000 as id_jtva_coloana ] + ;
[ FROM VBALANTA_PARTENERI]
lcOrder = [dataact]
lcFiltru = [1=2]
lcFiltruOriginal = [an = ?gnAn and luna = ?gnLuna and (precvaldeb + valdebit - precvalcred - valcredit <> 0)]
loHash = GetHash()
loHash.SetValue('cNume', 'poireg_parteneri')
loHash.SetValue('cAlias', 'crsFacturi')
loHash.SetValue('cSelect', lcSelect)
loHash.SetValue('cFiltru', lcFiltru)
loHash.SetValue('cSchema', lcSchema)
loHash.SetValue('cOrder', lcOrder)
loHash.SetValue('lAfisare', .F.)
*!* loHash.SetValue('cGroup', '' )
loHash.SetValue('lModParam', .T.)
loHash.SetValue('cFiltruOriginal', lcFiltruOriginal)
&& cursor adapter pentru inregistrari parteneri
gencursor_hash(loHash)
poireg_parteneri.ca_baza1.afisare()
&& cursor adapter pentru balanta parteneri
loHash.SetValue('cNume', 'pobalanta_parteneri')
loHash.SetValue('cSelect', lcSelect2)
gencursor_hash(loHash)
*!* formular calcul diferente - creeaza cursorul crsActTemp
*!* SELECT crsValute
loActualizare = Createobject("frm_actualizare_facturi_valuta")
loActualizare.Show(1)
*!* lcCursor = "crsActTemp"
*!* IF gnButon = 1
*!* SELECT crsFacturi
*!* LOCATE
*!* lcContAles = ALLTRIM(CONT)
*!* SELECT crsConturi
*!* LOCATE FOR ALLTRIM(CONT) == lcContAles
*!* IF FOUND()
*!* lnFelCont = fel_cont
*!* ELSE
*!* lnFelCont = 0
*!* ENDIF
*!*
*!* SELECT an, luna, ID_FACT, ID_PART AS ID_PARTD, NUME AS PARTD, ID_PART AS ID_PARTC, NUME AS PARTC, ;
*!* SPACE(4) as scd, acont AS ascd, SPACE(4) as scc, acont AS ascc, diferenta AS SUMA, ;
*!* nract AS pereched, ID_FACT AS id_factd, ;
*!* nract AS perechec, ID_FACT AS id_factc, ;
*!* cursBNR AS CURS, nume_val, id_valuta, ;
*!* PADR('DIFERENTE REEVALUARE;' + ALLTRIM(TRANSFORM(CURS)) + ';' + ALLTRIM(TRANSFORM(CURSBNR)), 50, ' ') as explicatia, ;
*!* PADR(ALLTRIM(TRANSFORM(CURS)), 50, ' ') AS EXPLICATIA4 ;
*!* FROM crsFacturi ;
*!* WHERE diferenta <> 0 ;
*!* INTO CURSOR crsActTemp ;
*!* READWRITE
*!* IF _TALLY > 0
*!* SELECT crsActTemp
*!* REPLACE ALL SCD WITH lcContAles, SCC WITH "765 ", ascc WITH '', ID_PARTC WITH 0, PARTC WITH '', PERECHEC WITH 0 ;
*!* FOR (SUMA>0 AND lnFelCont = 0) OR (SUMA<0 AND lnFelCont = 0)
*!* REPLACE ALL SCD WITH "665 ", ascd WITH '', SCC WITH lcContAles, ID_PARTD WITH 0, PARTD WITH '', PERECHED WITH 0 ;
*!* FOR (SUMA<0 AND lnFelCont = 0) OR (SUMA>0 AND lnFelCont = 1)
*!*
*!* REPLACE ALL EXPLICATIA WITH STRTRAN(EXPLICATIA, 'REEVALUARE', 'FAVORABILE') FOR SCC = '765'
*!* REPLACE ALL EXPLICATIA WITH STRTRAN(EXPLICATIA, 'REEVALUARE', 'NEFAVORABILE') FOR SCD = '665'
*!* REPLACE ALL SUMA WITH ABS(SUMA)
*!* lnSucces = scrie_nota_import(lnIdSet, llVerificAnalitic, llCompletareParteneri, "crsActTemp")
*!* ENDIF
*!* ENDIF
If Used('crsValute')
Use In crsValute
Endif
If Used('crsConturi')
Use In crsConturi
Endif
If Used('crsFacturi')
Use In crsFacturi
Endif
Endproc && actualizare_solduri_valuta

173
Programe/oproceduri_casademarcat.prg Normal file
View File

@@ -0,0 +1,173 @@
*!* 30.11.2011
*!* marius.mutu
*!* creare_bon_fiscal
*!* procentul de tva nu se afla corect: str(lnidfact,20)
*!* 25.11.2014
*!* marius.mutu
*!* casademarcat_roacont - functioneaza si pentru incasare cu bon fiscal prin POS (banca) id_set 10576
*!* creare_bon_fiscal - functioneaza si pentru incasare cu bon fiscal prin POS (banca) id_set 10576, cont 5125 sume in curs de decontare
*!* 11.05.2015
*!* marius.mutu
*!* gcArticolBonFiscalCont: numele articolului care se va lista pe bonul fiscal. daca nu este completat se listeaza (Fact. Nr.)
Procedure casademarcat_roacont
Lparameters tnIdSet
Local lnLungime, lnRaspuns, lnIdSet, lnSucces
*:Global glListareBonFiscalCont, taValori[1]
*!* Private poGeneratorNumere
*!* poGeneratorNumere = Createobject('oGeneratorNumere')
If Empty(tnIdSet) Or Type('tnIdSet') <> 'N'
lnIdSet = 10576 && Casa incasari - Clienti ( cu bon fiscal )
Else
lnIdSet = m.tnIdSet && (10617 Banca incasari - Clienti (cu bon fiscal POS))
ENDIF
gcArticolBonFiscalCont = ""
IF INLIST(m.lnIdSet, 10619, 10620) && Bacsis fara TVA; Bacsis cu TVA
gcArticolBonFiscalCont = 'BACSIS'
ENDIF
lnLungime = 2
lnRaspuns = 6
Dimension taValori[lnLungime, 3]
Do While lnRaspuns = 6
glListareBonFiscalCont = .T.
taValori[1, 1] = "poAct.id_fdoc"
taValori[1, 2] = Alltrim(Str(gnid_fdoc_bonfiscal))
taValori[1, 3] = .T.
taValori[2, 1] = "poAct.fdoc"
taValori[2, 2] = [BON FISCAL]
taValori[2, 3] = .T.
*!* Store -1 To lnNumarBon
*!* lnRezultat = poGeneratorNumere.creeaza_cursor_serii_bf()
*!* lnNumarBon = poGeneratorNumere.aloca_numar_bf()
*!* If lnNumarBon = -1
*!* glListareBonFiscalCont=.F.
*!* Return
*!* Endif
*!* taValori[3,1]="poAct.nract"
*!* taValori[3,2]=Alltrim(Str(lnNumarBon))
*!* taValori[3,3]=.T.
lnSucces = lans(m.lnIdSet, .F., .T., @taValori)
*!* lnSucces=lans(10329,.F.,.T.,@taValori)
*!* If lnSucces=2
*!* poGeneratorNumere.dezaloca_numar_bf() && in oserii_numere.prg
*!* Endif
glListareBonFiscalCont = .F.
gcArticolBonFiscalCont = ""
lnRaspuns = AMESSAGEBOX('Doriti sa continuati cu operatii de acest fel?', 4 + 32, "Confirmare")
Enddo
Release poGeneratorNumere
Endproc
******************************************************************************************
Procedure creare_bon_fiscal
Local lnNumarBonFiscal, lnTotalSuma, lnIdCasa, lnTip, lnNrFact, lnSuma, lnProcTva
*!* Local lcSirBonFiscal,lnTip,lnIdCasa,lnTotalSuma,ldDataBonFiscal,lnNumarBonFiscal,lnTotalSuma
lnNumarBonFiscal = 0
lnTotalSuma = 0
lnSumaNumerar = 0
lnSumaCard = 0
*!* modificare v 2.0.74
*!* lcSirBonFiscal=[]
&& lcSirBonFiscal (explicatii) :
&& 5 (incasare);suma achitata;0(numerar);0(moneda);0(numar card credit)
*!* ldDataBonFiscal=get_ora()
*!* Select actactan
*!* Set Filter To scd='5311'
*!* Scan
*!* lnNumarBonFiscal=nract
*!* lnIdCasa=id_partd
*!* Do Case
*!* Case Type('gnId_casa_achit')<>'U' And lnIdCasa=gnId_casa_achit && optiune din Devize
*!* lnTip=1
*!* *!* Case TYPE('gnId_Part_Bufet')<>'U' AND lnIdCasa=gnId_Part_Bufet && optiune din Gestiuni
*!* *!* lnTip=2
*!* Otherwise
*!* lnTip=3
*!* Endcase
*!* lcSirBonFiscal=lcSirBonFiscal+[1;Fact.]+Alltrim(Str(perechec))+[;1;]+Alltrim(Str(lnTip))+[;1;]+Alltrim(Str(suma*100))+[;1000;0]+CRLF
*!* lnTotalSuma=lnTotalSuma+suma
*!* Endscan
*!* Set Filter To
*!* If !Empty(lcSirBonFiscal)
*!* lcSirBonFiscal=lcSirBonFiscal+[5;]+Alltrim(Str(lnTotalSuma*100))+[;0;0;0]+CRLF+CRLF
*!* imprimare_bon_fiscal(lcSirBonFiscal,ldDataBonFiscal,lnNumarBonFiscal)
*!* Else
*!* aMessagebox("Bonul nu contine nici un element!",0+48,"Atentie")
*!* Endif
Local lcCursor
lcCursor = [crsDateBon]
Create Cursor (lcCursor) (DENUMIRE C(100), UM C(10), CANT N(10, 4), Pret N(18, 4), DEPARTAMENT N(2), PROC_TVAV N(5, 2))
Select actactan
Set Filter To Inlist(scd, '5311', '5125')
Scan
lnNumarBonFiscal = nract
lnIdCasa = id_partd
Do Case
Case Type('gnId_casa_achit') <> 'U' And lnIdCasa = gnId_casa_achit && optiune din Devize
lnTip = 1
Otherwise
lnTip = 3
Endcase
lnNrFact = perechec
lnIdFactC = id_Factc
lnProcTva = proc_tva
lnSuma = suma
lnTotalSuma = lnTotalSuma + lnSuma
IF scd = '5311'
lnSumaNumerar = m.lnSumaNumerar + m.lnSuma
ELSE
lnSumaCard = m.lnSumaCard + m.lnSuma
ENDIF
*!* nu am proc_tva completat asa ca trebuie sa-l citesc din inregistrari
If Empty(lnProcTva) And !Empty(lnIdFactC)
lcSql = [select 1 + (cota_tva / 100) as proc_tva from ] + gcS + [.jtva_coloane where id_jtva_coloana in (select id_jtva_coloana ] + ;
[ from ] + gcS + [.act where id_fact = ] + Alltrim(Str(lnIdFactC, 20)) + [ and sters = 0) and afisat <> 0 and id_jtva_coloana>0 and sters = 0]
lnSucces = goExecutor.oExecute(lcSql, [crsbfpt])
If lnSucces < 0
AMESSAGEBOX(goExecutor.cEroare, 16, "Eroare")
Else
If Reccount('crsbfpt') > 0
Select crsbfpt
lnProcTva = proc_tva
Endif
Endif
Use In (Select([crsbfpt]))
Endif
Select (lcCursor)
Append Blank
Replace DENUMIRE With IIF(!EMPTY(m.gcArticolBonFiscalCont), m.gcArticolBonFiscalCont, [Fact.] + Alltrim(Str(lnNrFact))), CANT With 1, Pret With lnSuma, PROC_TVAV With lnProcTva, DEPARTAMENT With lnTip
Select actactan
Endscan
Set Filter To
If Reccount(lcCursor) > 0
Local loHash
loHash = GetHash()
loHash.SetValue("cTip", "1;")
loHash.SetValue("nNumarBon", lnNumarBonFiscal)
loHash.SetValue("nValoareNumerar", m.lnSumaNumerar)
loHash.SetValue("nValoareCard", m.lnSumaCard)
loHash.SetValue("nValoareTotal", lnTotalSuma)
loHash.SetValue("cCursor", lcCursor)
loHash.SetValue("tDataOra", get_ora())
goControllerEcr.imprima(loHash)
Release loHash
Else
AMESSAGEBOX("Bonul nu contine nici un element!", 0 + 48, "Atentie")
Endif
Use In (lcCursor)
*!* modificare v 2.0.74 ^
Endproc
******************************************************************************************

123
Programe/oproceduri_conversie.prg Normal file
View File

@@ -0,0 +1,123 @@
*** OPROCEDURI_ACTUALIZARI
*** SE ALEGE O CONVERSIE EXISTENTA SAU UNA NOUA
FUNCTION GETCONVERSIE
LOCAL lcselect,lcfiltru,lcschema,lcorder,lccoloana,lcTitlu,lcTitluColoana,lcNume_Proc,llAllInList,lcFiltruOriginal,lcPrimaColoana, lnPornire, lnTipReturn, lcIdColumn, llDesktop
LOCAL loCauta, lcConversie
lcConversie = ""
lcselect = "select distinct conversie from conversie_conturi"
lcfiltru = ""
lcschema = ""
lcorder = "conversie"
lccoloana = "conversie"
lcTitlu = "Alegeti conversia"
lcTitluColoana = "Conversie"
lcNumeProc = ""
llAllInList = .F.
lcFiltruOriginal = ""
lcPrimaColoana = "conversie"
lnPornire = 1
lnTipReturn = 0
lcIdColumn = ""
llDesktop = .F.
IF AMESSAGEBOX('Conversie existenta (DA) / Noua (NU)?',4+32,'Conversie') = 6
loCauta = cauta_alfa(lcselect,lcfiltru,lcschema,lcorder,lccoloana,lcTitlu,lcTitluColoana,lcNume_Proc,llAllInList,lcFiltruOriginal,lcPrimaColoana, lnPornire, lnTipReturn, lcIdColumn, llDesktop) && 11.07.2007
lcConversie = UPPER(ALLTRIM(loCauta.conversie))
ELSE
lcConversie = UPPER(ALLTRIM(INPUTBOX("Conversie","Conversie","Ordin ...")))
ENDIF
RETURN UPPER(ALLTRIM(lcConversie))
ENDFUNC && GETCONVERSIE
*** SE EDITEAZA INREGISTRARILE DIN CONVERSIA ALEASA
*** SE APLICA CONVERSIA PLAN/BALANTA/JURNAL
PROCEDURE CONVERSIE_CONTURI
LPARAMETERS tcSubiect, tnAn, tnLuna
&& tcSubiect : PLAN;BALANTA
IF m.glLunaInchisa
AMESSAGEBOX('Luna este inchisa! Operatia nu este permisa.',0+64,_screen.Caption)
RETURN
ENDIF
LOCAL lcnume, lcalias, lcselect, lcfiltru, lcschema, lcorder, llAfisare, lcgroup, llModParam, lcFiltruOriginal
LOCAL lcSql, lnSucces, lcMesaj
PRIVATE pnAn, poConversie, pcConversie
poConversie = NULL
IF EMPTY(tcSubiect) OR TYPE('tcSubiect') # 'C'
RETURN
ENDIF
IF PCOUNT() < 2 OR TYPE('tnAn') # 'N'
pnAn = gnAn
ELSE
pnAn = tnAn
ENDIF
IF PCOUNT() < 3 OR TYPE('tnLuna') # 'N'
pnLuna = gnLuna
ELSE
pnLuna = tnLuna
ENDIF
pcConversie = GETCONVERSIE()
IF EMPTY(ALLTRIM(pcConversie))
RETURN
ENDIF
lcnume = [poConversie]
lcalias = [crsConversieConturi]
lcselect = [SELECT ACONT_NOU, ACONT_VECHI, CONT_NOU, CONT_VECHI, EXPLICATIE, ID, SE_APLICA, TIP_SOLD, CONVERSIE FROM CONVERSIE_CONTURI]
lcschema = [ACONT_NOU C(4), ACONT_VECHI C(4), CONT_NOU C(4), CONT_VECHI C(4), EXPLICATIE C(100), ID N(10), SE_APLICA N(1), TIP_SOLD C(1), CONVERSIE C(100)]
lcfiltru = []
lcorder = [cont_vechi, acont_vechi, cont_nou, acont_nou]
llAfisare = .F.
lcgroup = []
llModParam = .T.
lcFiltruOriginal = [UPPER(TRIM(conversie)) = '] + UPPER(ALLTRIM(pcConversie)) + [']
gencursor(lcnume, lcalias, lcselect, lcfiltru, lcschema, lcorder, llAfisare, lcgroup, llModParam, lcFiltruOriginal)
poConversie.ca_baza1.afisare()
*!* SELECT crsConversieConturi
*!* INDEX on cont_nou + acont_nou + cont_vechi + acont_vechi TAG ordonare
loFrmConversie = CREATEOBJECT("frm_conversie_conturi")
loFrmConversie.cSubiectConversie = UPPER(ALLTRIM(tcSubiect))
loFrmConversie.lb_titlu_alb_b121.CAPTION = "Configurare conturi " + ALLTRIM(pcConversie)
loFrmConversie.cConversie = pcConversie
loFrmConversie.SHOW(1)
lcMesaj = ""
lcSql = ""
IF INLIST(UPPER(ALLTRIM(tcSubiect)), "PLAN", "BALANTA", "JURNAL")
DO CASE
CASE UPPER(ALLTRIM(tcSubiect)) = 'PLAN'
lcMesaj = 'Doriti sa actualizati planul de conturi?'
lcSql = [begin pack_conversie.conversie_plan_cont(?pcConversie, ?pnAn); end;]
CASE UPPER(ALLTRIM(tcSubiect)) = 'BALANTA'
lcMesaj = 'Doriti sa actualizati balanta de verificare?'
lcSql = [begin pack_conversie.conversie_balanta(?pcConversie, ?pnAn,?pnLuna); end;]
CASE UPPER(ALLTRIM(tcSubiect)) = 'JURNAL'
lcMesaj = 'Doriti sa actualizati registrul jurnal?'
lcSql = [begin pack_conversie.conversie_jurnal(?pcConversie, ?pnAn,?pnLuna); end;]
ENDCASE
IF gnButon = 1 AND AMESSAGEBOX(lcMesaj, 4+32, 'Actualizare') = 6
lnSucces = goExecutor.oExecute(lcSql)
IF lnSucces < 0
AMESSAGEBOX(goExecutor.cEroare,0+16,'Eroare')
ELSE
AMESSAGEBOX('Actualizarea s-a terminat cu succes',0+64)
ENDIF
ENDIF
ENDIF
ENDPROC && CONVERSIE_CONTURI

18904
Programe/oproceduri_decont.prg Normal file
View File

File diff suppressed because it is too large Load Diff

4805
Programe/oproceduri_import.prg Normal file
View File

File diff suppressed because it is too large Load Diff

321
Programe/oproceduri_incasari.prg Normal file
View File

@@ -0,0 +1,321 @@
*!* 10.12.2015
*!* marius.mutu
*!* listare explicatie din registrul jurnal pe chitanta
*!* #4246
*!* 30.06.2017
*!* marius.mutu
*!* listare_chitanta, relistare_chitanta - suma in vorbe tine cont de valuta
*******************************************************************************************
DEFINE CLASS oDateChitanta AS CUSTOM
id_client = NULL
nume_client = []
nr_incasare = 0
serie_chit = []
dataact = {}
incasat = 0
sumavorbe = []
explicatie_chit = []
nume_valuta = []
lSilent = .F.
* lSilent (default .F.) listare silentioasa, fara previzualizare
PROCEDURE INIT
LPARAMETERS tnIdPartener, tcSirNrFact
WITH THIS
.id_client = tnIdPartener
*!* lcSirFact = Substr(tcSirNrFact,1,LEN(tcSirNrFact)-2) && are [, ] la sfarsit
lcSirFact = IIF(RIGHT(ALLTRIM(tcSirNrFact), 1) = ',', LEFT(ALLTRIM(tcSirNrFact), LEN(ALLTRIM(tcSirNrFact)) - 1), ALLTRIM(tcSirNrFact))
IF [, ] $ lcSirFact
.explicatie_chit = [facturilor ] + lcSirFact
ELSE
.explicatie_chit = [facturii ] + lcSirFact
ENDIF
ENDWITH
ENDPROC
ENDDEFINE
*******************************************************************************************
PROCEDURE clienti_chitanta
LPARAMETERS tnIdSet
LOCAL lnIdSet
lnIdSet = IIF(!EMPTY(m.tnIdSet), m.tnIdSet, 10329) && casa > incasare clienti 4111
PRIVATE glListareChitanta
PRIVATE pcSirFacturi
glListareChitanta = .T.
STORE [] TO pcSirFacturi
lans(m.lnIdSet)
glListareChitanta = .F.
ENDPROC && clienti_chitanta
*******************************************************************************************
PROCEDURE listeaza_chitanta
LPARAMETERS tcSirNrFact
LOCAL lnIdClient, loDate, lcNumeClient
LOCAL laProperties[1], lcProperty, lnProperties, lnProperty
SELECT actactan
LOCATE FOR id_partc <> 0
lnIdClient = id_partc
tcSirNrFact = IIF(RIGHT(ALLTRIM(tcSirNrFact), 1) = ',', LEFT(ALLTRIM(tcSirNrFact), LEN(ALLTRIM(tcSirNrFact)) - 1), ALLTRIM(tcSirNrFact)) + IIF(!EMPTY(NVL(explicatia, '')), ' ' + ALLTRIM(explicatia), '')
lcNumeClient = IIF(TYPE('poAct.v4111') = 'C', poAct.v4111, IIF(TYPE('poAct.v461') = 'C', poAct.v461, ''))
IF EMPTY(m.lcNumeClient)
lnProperties = AMEMBERS(laProperties, poAct, 0)
FOR lnProperty = 1 TO m.lnProperties
lcProperty = LOWER(laProperties(m.lnProperty))
IF LEFT(m.lcProperty, 2) = 'v4'
lcNumeClient = EVALUATE('poAct.' + _m.lcProperty)
EXIT
ENDIF
ENDFOR
ENDIF
loDate = CREATEOBJECT('oDateChitanta', lnIdClient, tcSirNrFact)
WITH loDate
.nume_client = m.lcNumeClient
.serie_chit = poAct.serie_act
.nr_incasare = poAct.nract
.dataact = poAct.dataact
.incasat = poAct.suma
.nume_valuta = IIF(EMPTY(ALLTRIM(NVL(poAct.nume_val, ''))), 'LEI', STRTRAN(ALLTRIM(NVL(poAct.nume_val, '')), 'RON', 'LEI', 1, 1, 1))
.sumavorbe = SUMA_IN_VORBE(.incasat, NVL(poAct.nume_val, ''))
ENDWITH
listare_chitanta(@loDate, [actactan])
RELEASE lnIdClient, loDate
ENDPROC
*******************************************************************************************
PROCEDURE relisteaza_chitanta
LPARAMETERS tnCod, tlSilent
* tnCod act.cod pentru chitanta
* tlSilent (default .F.) se listeaza silentios, fara previzualizare
LOCAL loDate, lcSirFact, loDetalii
*!* am pus conditia scd = '5311' ca sa nu-mi ia si notele de exigibilizare a TVA-ului
*!* am pus conditia id_set = 10329 ca sa nu poata lista decat ce a introdus pe la incasare clienti cu/fara listare chitanta
*!* id_set = 10329 ( incasare clienti cu/fara listare chitanta )
*!* id_set = 10576 ( incasare clienti cu bon fiscal )
lcSql = [select a.id_partc,c.denumire,a.serie_act,a.nract,a.dataact, d.nume_val, sum(a.suma) as suma,] + ;
[stringagg(' '||nvl2(b.serie_act, b.serie_act || ' ', '') || ] + ;
[trim(replace(replace(to_char(b.nract, '999999999999999999'), '.' , ' '), ',' , ' ')) ] + ;
[ || ' din '|| to_char(b.dataact,'DD/MM/YYYY')) as sirfact, max(explicatia) as explicatia ] + ;
[from (select id_partc, serie_act, nract, dataact, suma, id_factc, explicatia, id_valuta from act ] + ;
[where cod = ] + ALLTRIM(STR(tnCod)) + [ and sters = 0 and scd = '5311') a ] + ;
[left join documente b on a.id_factc = b.id_doc ] + ;
[left join nom_parteneri c on a.id_partc = c.id_part ] + ;
[left join vnom_valute d on a.id_valuta = d.id_valuta ] + ;
[group by a.id_partc, c.denumire, a.serie_act, a.nract, a.dataact, d.nume_val]
*!* lcSql = [select a.id_partc,c.denumire,a.serie_act,a.nract,a.dataact,a.suma,] + ;
*!* [nvl2(b.serie_act, b.serie_act || ' ', '') || ] + ;
*!* [trim(replace(replace(to_char(b.nract, '999G999G999G999G999G999'), '.' , ' '), ',' , ' ')) ] + ;
*!* [ || ' din '|| to_char(b.dataact,'DD/MM/YYYY') as sirfact ] + ;
*!* [from (select id_partc, serie_act, nract, dataact, suma, id_factc from act ] + ;
*!* [where cod = ] + Alltrim(Str(tnCod)) + [ and sters = 0 and scd = '5311' and id_set = 10329) a ] + ;
*!* [left join documente b on a.id_factc = b.id_doc ] + ;
*!* [left join nom_parteneri c on a.id_partc = c.id_part ]
lcCursor = [crsdatechitanta]
IF goExecutor.oExecuta(lcSql, lcCursor)
IF RECCOUNT(lcCursor) > 0
*!* lcSirFact = []
*!* Select (lcCursor)
*!* Scan
*!* If Recno() = 1
*!* Scatter Name loDetalii
*!* Else
*!* loDetalii.suma = loDetalii.suma + suma
*!* Endif
*!* lcSirFact = lcSirFact + ALLTRIM(sirfact) + [, ]
*!* Endscan
*!* loDate = Createobject('oDateChitanta',loDetalii.id_partc,SUBSTR(lcSirFact,3))
*!* With loDate
*!* .nume_client = Alltrim(loDetalii.denumire)
*!* .serie_chit = Alltrim(loDetalii.serie_act)
*!* .nr_incasare = loDetalii.nract
*!* .dataact = loDetalii.dataact
*!* .incasat = loDetalii.suma
*!* .sumavorbe = SUMA_IN_VORBE(.incasat)
*!* Endwith
lcSirNrFact = IIF(RIGHT(ALLTRIM(sirfact), 1) = ',', LEFT(ALLTRIM(sirfact), LEN(ALLTRIM(sirfact)) - 1), ALLTRIM(sirfact)) + IIF(!EMPTY(NVL(explicatia, '')), ' ' + ALLTRIM(explicatia), '')
SELECT (lcCursor)
loDate = CREATEOBJECT('oDateChitanta', id_partc, lcSirNrFact) && [, ] este eliminat in oDateChitanta
WITH loDate
.nume_client = ALLTRIM(denumire)
.serie_chit = ALLTRIM(serie_act)
.nr_incasare = nract
.dataact = dataact
.incasat = suma
.nume_valuta = IIF(EMPTY(ALLTRIM(NVL(nume_val, ''))), 'LEI', STRTRAN(ALLTRIM(NVL(nume_val, '')), 'RON', 'LEI', 1, 1, 1))
.sumavorbe = SUMA_IN_VORBE(.incasat, NVL(nume_val, ''))
.lSilent = m.tlSilent
ENDWITH
listare_chitanta(@loDate, lcCursor)
RELEASE lnIdClient, loDate, loDateChit
ELSE
amessagebox("Nu exista date pentru listarea chitantei!", 48, "Atentie")
ENDIF
ENDIF
USE IN (SELECT(lcCursor))
ENDPROC
*******************************************************************************************
PROCEDURE listare_chitanta
LPARAMETERS toDate, tcCursor
PRIVATE poClient, poFirma, poDate
Local lcCursor, lcRaport, lcSql, lnRaspuns
Local loPreviewerConfig As "PreviewerConfig"
poDate = toDate
lcSql = [select 1 as tip,(case when tip_persoana = 1 then prefix||' '||denumire||' '||sufix else denumire end) as denumire,] + ;
[cod_fiscal,adresa,telefon,'' as fax,reg_comert,banca,cont_banca,sysdate as dataora,tip_persoana,0 as capital_soc_var,] + ;
[0 as capital_soc_sub from vnom_parteneri where id_part = ?poDate.id_client ] + ;
[union all ] + ;
[select 3 as tip,antet as denumire,cod_fiscal,adresa,telefon,fax,reg_comert,banca1 as banca,] + ;
[cont_banca1 as cont_banca,null as dataora,0 as tip_persoana,capital_soc_var,capital_soc_sub ] + ;
[from syn_nom_firme where id_firma = ?gnIdFirma ]
IF USED('crsdatefacturare')
USE IN crsdatefacturare
ENDIF
lcCursor = [crsdatefacturare]
IF goExecutor.oExecuta(lcSql, lcCursor)
SELECT crsdatefacturare
SCAN
DO CASE
CASE tip = 1
SCATTER NAME poClient MEMO
*!* ptDataOra = poClient.dataora
OTHERWISE
SCATTER NAME poFirma MEMO
ENDCASE
ENDSCAN
USE IN crsdatefacturare
* Daca nu am gasit clientul (nu exista clientul) (ex: 5311 = 581) - da eroare, creez o structura poClient gol
IF TYPE('poClient.denumire') <> 'C'
poClient = CREATEOBJECT("custom")
poClient.ADDPROPERTY("tip", 1)
poClient.ADDPROPERTY("denumire", "")
poClient.ADDPROPERTY("cod_fiscal", "")
poClient.ADDPROPERTY("adresa", "")
poClient.ADDPROPERTY("telefon", "")
poClient.ADDPROPERTY("fax", "")
poClient.ADDPROPERTY("reg_comert", "")
poClient.ADDPROPERTY("banca", "")
poClient.ADDPROPERTY("cont_banca", "")
poClient.ADDPROPERTY("dataora", {//::})
poClient.ADDPROPERTY("tip_persoana", 0)
poClient.ADDPROPERTY("capital_soc_var", 0)
poClient.ADDPROPERTY("capital_soc_sub", 0)
ENDIF
*!* modificare v 2.0.100
*!* poClient.denumire = Nvl(poClient.denumire,Padl([_],100,[_]))
*!* poClient.adresa = Nvl(poClient.adresa,Padl([_],150,[_]))
*!* poDate.explicatie = Nvl(poDate.explicatie,Padl([_],100,[_]))
poClient.denumire = NVL(poClient.denumire, REPLICATE([. ], 50))
poClient.adresa = NVL(poClient.adresa, REPLICATE([. ], 75))
poDate.explicatie_chit = NVL(poDate.explicatie_chit, REPLICATE([. ], 50))
*!* modificare v 2.0.100 ^
lcRaport = IIF(TYPE('gnRC_RAPORT_CHITANTA') = 'N', IIF(m.gnRC_RAPORT_CHITANTA = 0, [chitanta], [chitanta_landscape]), [chitanta])
loPreviewerConfig = Createobject("PreviewerConfig") && rapoarte.prg
If poDate.lSilent
m.loPreviewerConfig.SetValue("lDirectPrint", .T.)
goExport.export2frx(m.tcCursor, m.lcRaport, .F., , , , , .T., , loPreviewerConfig)
ELSE
*!* lnRaspuns = 6
*!* DO WHILE lnRaspuns = 6
goExport.export2frx(m.tcCursor, m.lcRaport, .F., , , , , .T., , loPreviewerConfig)
*!* lnRaspuns = amessagebox("Doriti sa mai listati chitanta?", 4 + 32 + 256, "Confirmare repetare listare")
*!* ENDDO
ENDIF && lSilent
ENDIF && goExecutor
RELEASE poClient, poFirma, poDate
ENDPROC && listeaza_chitanta
*******************************************************************************************
************************************
*** note incasare facturi 5121 = 4111 prin selectarea facturilor incasate direct din facturi cu sold
*** nu trateaza cazul firmelor cu TVA Incasare
************************************
PROCEDURE incasare_facturi_sold
PARAMETERS tcXMLFacturi
LOCAL loForm AS [frm_modific2007]
lcSCD = '5121'
lcSCC = '4111'
lnRecords = XMLTOCURSOR(m.tcXMLFacturi, "crsFacturiIncasareTemp")
IF lnRecords = 0
USE IN (SELECT("crsFacturiIncasareTemp"))
RETURN
ENDIF
lcMesaj = ''
lnIdSet = 99999 && nota fara predefinire
lnBut = lans(m.lnIdSet)
IF m.lnBut = 1
SELECT actactan
SCATTER NAME loAct
ZAP
INSERT INTO actactan(nr_nota, luna, an, scd, scc, ascc, suma, id_set, id_factc, perechec, id_partc, partc, explicatia) ;
SELECT RECCOUNT('actactan') + RECNO() AS nr_nota, m.gnLuna AS luna, m.gnAn AS an, m.lcSCD AS scd, CONT AS scc, acont AS ascc, ;
(precdeb + debit) - (preccred + credit) AS suma, m.lnIdSet AS id_set, id_fact AS id_factc, nract AS perechec, id_part AS id_partc, nume AS partc, ;
'Incasare prin banca' AS explicatia ;
FROM crsFacturiIncasareTemp
SELECT actactan
SCAN
GATHER NAME loAct FIELDS EXCEPT nr_nota, luna, an, scd, scc, suma, id_set, id_factc, perechec, id_partc, partc
REPLACE id_sucursala WITH m.gnIdSucursala
ENDSCAN
update_jtva_coloane("JV", 'crsExplicatiiTVATemp', 1)
SELECT .F. AS ales, 0 AS Cu_tva, CAST(0 AS N(2)) AS tipnota, a.*, b.denumire AS explicatie_tva_2 ;
FROM actactan a LEFT JOIN crsExplicatiiTVATemp b ON a.id_jtva_coloana = b.id_jtva_coloana ;
INTO CURSOR tact READWRITE
Update tact Set explicatie_tva = explicatie_tva_2
USE IN (SELECT('crsExplicatiiTVATemp'))
SELECT tact
GO TOP
llNotaNoua = .T.
llMaximize = .T.
loForm = CREATEOBJECT([frm_modific2007], m.lnIdSet, m.llNotaNoua)
loForm.lb_titlu_alb_b121.CAPTION = 'Incasare facturi'
SELECT tact
loForm.SHOW(1, m.llMaximize)
IF buton = 1
USE IN (SELECT('actactan'))
SELECT tact
REPLACE id_jtva_coloana WITH NULL, PROC_TVA WITH 0 FOR Cu_tva = 0
SELECT * FROM tact INTO CURSOR actactan READWRITE
SELECT actactan
REPLACE ALL id_util WITH gnIdUtil, id_set WITH m.lnIdSet
lnSucces = OSCRIE_IN_FISIERE(0)
ENDIF && buton = 1
ENDIF && m.lnBut = 1
USE IN (SELECT('actactan'))
USE IN (SELECT('tact'))
ENDPROC && incasare_facturi_sold

1458
Programe/oproceduri_inchidere.prg Normal file
View File

File diff suppressed because it is too large Load Diff

63
Programe/oproceduri_registretva.prg Normal file
View File

@@ -0,0 +1,63 @@
******************************************************************
Procedure listare_registru_tva
Lparameters tcRegistru
pcRegistru = Upper(Alltrim(tcRegistru))
Do Case
Case 'VANZ'$pcRegistru
pcContTVA = [4427]
pcListaContTVA = [411,4111,4112,4113,4114,4115,4116,4117,461,635,5311,5121,428,4281,4282,4426,4428]
pcListaContBaza = [411,4111,4112,4113,4114,4115,4116,4117,461,428,4281,4282]
pcListaContExceptii = [667,419]
Otherwise
pcContTVA = [4426]
pcListaContTVA = [401,404,5121,5124,542,4427,4428]
pcListaContBaza = [401,404]
pcListaContExceptii = [767]
Endcase
lcSql = [{call PACK_REGISTRE_TVA.REGISTRUTVA(?gcS, ?gnAn, ?gnLuna, ] + ;
[?pcRegistru, ?pcContTVA, ?pcListaContTVA, ?pcListaContBaza, ?pcListaContExceptii )}]
lcCursor = 'crsRegistruTemp'
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
If lnSucces < 0
AMESSAGEbox(goExecutor.cEroare,0+16,"Eroare")
Else
Select nract, dataact, Part As nume, cod_fiscal, fdoc, baza, proc_tva, tva, baza + tva As totctva, 00000000000.0000 As Total ;
FROM crsRegistruTemp ;
INTO Cursor crsRegistru ;
READWRITE Order By dataact, nract, nume
Use In crsRegistruTemp
Select nract, dataact, nume,Sum(totctva) As Total ;
from crsRegistru ;
INTO Cursor tgrup ;
GROUP By dataact, nract, nume
Select tgrup
Scan
Scatter Name ot
Select crsRegistru
Locate For nume = ot.nume And nract = ot.nract And dataact = ot.dataact
If Found()
Replace Total With ot.Total
Endif
Select tgrup
Endscan
Use In tgrup
If Reccount('crsRegistru')>0
Private pcDataOra
pcDataOra = get_ora(2)
Select crsRegistru
Report Form registru_tva_simplu To Printer Prompt Preview
Else
AMESSAGEbox("Nu exista inregistrari pentru listare!",48,"Atentie")
Endif
Use In crsRegistru
Endif
Endproc
******************************************************************

2408
Programe/orap_terti.prg Normal file
View File

File diff suppressed because it is too large Load Diff

421
Programe/orap_trezorerie.prg Normal file
View File

@@ -0,0 +1,421 @@
*_____________________________________________________*
* *
* proceduri utilizate pentru generarea rapoartelor: *
* Trezorerie->Casa *
* ->Banca *
* ->Altele *
*_____________________________________________________*
* PROCEDURE listare_reg_casabanca
* Date : 04/11/2004, 11:42:49
* author : lavinia.viziru
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
********************************* INCEPUT:listare_reg_casabanca *****************************
Procedure listare_reg_casabanca
Parameters tcCont && 5311 - casa, 5121 - banca
Local lcTitlu, lcCont, loCasa, lnId_part, lcNume
Store '' To lcTitlu, lcCont, loCasa
Store 0 To lnId_part
Private pnsoldi
Store 0 To pnsoldi
lcCont = Alltrim(tcCont)
lcTitlu = Iif(lcCont = '5311', [Alegeti numele casei], [Alegeti numele bancii])
loCasa = caut_parteneri(lcCont, lcTitlu)
&& rezultatele cautarii: loCasa.nume, loCasa.id_part,loCasa.cod_fiscal
If Empty(loCasa.denumire)
Return
Endif
lnId_part = loCasa.id_part
lcNume = loCasa.denumire
Private pcexec, pcselect, pcschema, pcfiltru, pcorder, pobancasa, pnprecdeb, pnpreccred
Store 0 To pnprecdeb, pnpreccred
Store "" To pobancasa
*pcexec=[begin cbancasaproc(']+ lcCont +[',]+Alltrim(Str(gnluna+gnan*12))+[); end;]
pcexec = [begin pack_sesiune.setcont('] + lcCont + ['); end;]
lnSucces = goExecutor.oExecute(pcexec)
If lnSucces < 0
aMESSAGEBOX(goExecutor.cEroare, 0 + 16, 'Eroare')
Endif
If Used('casban')
Use In casban
Endif
*!* modificare v 2.0.117 : am adaugat id_fdoc,id_nume
pcschema = ['nrcrt n(1),fdoc c(30),dataact d,dataireg d,nract N(20),serie_act c(15),bancasa c(50),nume c(50), cod_fiscal c(50),explicatia c(100),'+] + ;
['incasari n(20,4),plati n(20,4),scd c(4),scc c(4),ascd c(4),ascc c(4),COD N(20),NRORD C(30),nresp c(50),sucursala c(100),id_fdoc n(20),id_nume N(20)']
pcselect = ['select nrcrt, fdoc, dataact, dataireg, nract,serie_act, bancasa, nume, cod_fiscal, explicatia, incasari,] + ;
[plati, scd, scc, ascd, ascc,COD, NRORD, nresp,sucursala,id_fdoc,id_nume from ] + gcS + [.vbancasa_] + Alltrim(tcCont) + [ where 2=2 ']
pcfiltru = [UPPER(TRIM(bancasa)) = '] + Upper(Alltrim(lcNume)) + ['] + gcCondSucursala
pcorder = Iif(lcCont = '5311', [dataireg,dataact,cod], [dataact,cod])
llAfisare = .F.
gencursor('pobancasa', 'casban', pcselect, pcfiltru, pcschema, pcorder, llAfisare)
pobancasa.ca_baza1.afisare()
&&preluare ora de pe oracle server:
*!* STORE 0 to pnsucces
*!* pcexec = [select to_char(SYSdate,'dd/mm/yyyy hh:mi:ss AM') as dataora from dual]
*!* pcCursor = [dataora_cursor]
*!* pnsucces = goExecutor.oExecute(pcexec,pcCursor)
*!* IF (pnsucces != 0)
*!* SELECT dataora_cursor
*!* pcdataora = dataora_cursor.dataora
*!* USE IN dataora_cursor
*!* ENDIF
Select casban
Calculate Sum(incasari), Sum(plati) For nrcrt = 1 To pnprecdeb, pnpreccred
pnsoldi = pnprecdeb - pnpreccred
*!* modificare v 2.0.117
*!* Select * from casban where nrcrt = 2 into cursor casban_ordonat READWRITE
If raport_regcasa_restrans(1, lcCont = [5311], [casban], [casban_ordonat])
*!* modificare v 2.0.117 ^
*!* 29.05.2008
*!* daca nu am rulaje in luna vreau sa listez soldul initial = soldul final fara inregistrari
*!* si trebuie sa pun o linie goala in tabel pt listare
If Reccount('casban_ordonat') = 0
Select bancasa From casban Where nrcrt = 1 Into Cursor cSolduriTemp
Select casban_ordonat
Append From Dbf('cSolduriTemp')
Use In (Select('cSolduriTemp'))
Endif
*!* 29.05.2008 ^
lcRaport = Iif(lcCont = '5311', [registru_casa_rpt1], [registru_banca_rpt1])
goExport.export2frx([casban_ordonat], lcRaport)
*!* modificare v 2.0.117
Endif
*!* modificare v 2.0.117 ^
Use In (Select('casban'))
Use In (Select('casban_ordonat'))
Endproc
********************************* SFARSIT:listare_reg_casabanca *****************************
********************************* INCEPUT: listare_reg_casacum *****************************
Procedure listare_reg_casacum
Local lcTitlu, lcCont, loCasa, lnId_part, lcNume
Store '' To lcTitlu, lcCont, loCasa
Store 0 To lnId_part
Private pnsoldi, pdDataI, pdDataF
Store 0 To pnsoldi
Store {} To pdDataI, pdDataF
*** alegere perioada
ofrm = Createobject("frm_perioada_zzllaaaa")
ofrm.Show(1)
If gnButon = 2 Or Isnull(pdDataI) Or Isnull(pdDataF)
Return
Endif
*** cautare partener
lcCont = [5311]
lcTitlu = [Registrul de Casa]
llToateIreg = .F.
lcXMLParteneri = caut_parteneri_xml(lcCont, lcTitlu, llToateIreg)
If !Empty(lcXMLParteneri) And gnButon = 1
Xmltocursor(lcXMLParteneri, "crsCasaTemp")
If Reccount('crsCasaTemp') = 0
aMESSAGEBOX('Nu ati selectat vreo casa!', 0 + 48, 'Atentie')
Return
Endif
lcSirIdPart = cursor2lista("crsCasaTemp", "id_part", ",")
lcSirNume = cursor2lista("crsCasaTemp", "denumire", ",")
Use In crsCasaTemp
Else
aMESSAGEBOX("Nu ati selectat vreo casa!", 0 + 48, "Atentie")
Return
Endif
Private pcexec, pcselect, pcschema, pcfiltru, pcorder, pobancasa, pnprecdeb, pnpreccred, pcSubtitlu
pcSubtitlu = [Casa :] + Alltrim(lcSirNume) + [; Data inreg. intre ] + Dtoc(pdDataI) + [ si ] + Dtoc(pdDataF)
Store 0 To pnprecdeb, pnpreccred
Store "" To pobancasa
pcexec = [begin pack_sesiune.setcont('] + lcCont + ['); end;]
lnSucces = goExecutor.oExecute(pcexec)
If lnSucces < 0
aMESSAGEBOX(goExecutor.cEroare, 0 + 16, 'Eroare')
Endif
If Used('casban')
Use In casban
Endif
lcSql = [select sum(incasari) as precdeb,sum(plati) as preccred from ] + gcS + [.vbancasa_] + Alltrim(lcCont) + ;
[ where (nrcrt = 1 or NVL(dataireg,to_date('01011900','DDMMYYYY')) < ?pdDataI)] + gcCondSucursala
lnSucces = goExecutor.oExecute(lcSql, [casban])
If lnSucces < 0
aMESSAGEBOX(goExecutor.cEroare, 16, 'Eroare')
Return
Endif
Select casban
pnprecdeb = precdeb
pnpreccred = preccred
pnsoldi = pnprecdeb - pnpreccred
Use In (Select('casban'))
*!* modificare v 2.0.117 : am adaugat id_fdoc, id_nume
pcschema = ['nrcrt n(1),fdoc c(30),dataact d,dataireg d,nract N(20),serie_act c(15),bancasa c(50),nume c(50), cod_fiscal c(50),explicatia c(100),'+] + ;
['incasari n(20,4),plati n(20,4),scd c(4),scc c(4),ascd c(4),ascc c(4),COD N(20),NRORD C(30),nresp c(50),sucursala c(100),id_fdoc N(20),id_nume N(20)']
pcselect = ['select nrcrt, fdoc, dataact, dataireg, nract,serie_act, bancasa, nume, cod_fiscal, explicatia, incasari,] + ;
[plati, scd, scc, ascd, ascc,COD, NRORD, nresp,sucursala,id_fdoc,id_nume from ] + gcS + [.vbancasa_] + Alltrim(lcCont) + [ where 2=2 ']
pcfiltru = [id_bancasa in (] + Alltrim(lcSirIdPart) + [) and ] + ;
[(NVL(dataireg,to_date('01011900','DDMMYYYY')) between ?pdDataI and ?pdDataF or dataireg is null) ] + gcCondSucursala
pcorder = [dataireg,bancasa,dataact,cod]
llAfisare = .F.
gencursor('pobancasa', 'casban', pcselect, pcfiltru, pcschema, pcorder, llAfisare)
pobancasa.ca_baza1.afisare()
*!* modificare v 2.0.117
*!* Select * from casban where nrcrt = 2 into cursor casban_ordonat READWRITE
If raport_regcasa_restrans(2, .T., [casban], [casban_ordonat])
*!* modificare v 2.0.117 ^
If Reccount('casban_ordonat') = 0
Select bancasa From casban Where nrcrt = 1 Into Cursor cSolduriTemp
Select casban_ordonat
Append From Dbf('cSolduriTemp')
Use In (Select('cSolduriTemp'))
Endif
lcRaport = [registru_casa_rpt3]
goExport.export2frx([casban_ordonat], lcRaport)
*!* modificare v 2.0.117
Endif
*!* modificare v 2.0.117 ^
Use In (Select('casban'))
Use In (Select('casban_ordonat'))
Endproc
********************************* SFARSIT: listare_reg_casacum ****************************
* PROCEDURE listare_reg_casabanca_val
* Date : 05/11/2004, 13:03:15
* author : lavinia.viziru
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
***************************** INCEPUT:listare_reg_casabanca_val *****************************
Procedure listare_reg_casabanca_val
Parameters tcCont, tlBancasaCum
* tcCont: 5314 - casa in valuta, 5124 - banca in valuta
* tlBancasaCum: registru cumulat pe documente pereche / defalcat pe documente pereche
Local lcTitlu, lcCont, loCasa, lnId_part, lcNume, llBanCasaCum
Store '' To lcTitlu, lcCont, loCasa
Store 0 To lnId_part
Private pnsoldi, pnsoldival, pcTiltlu, pcBancasa, pcTitlugrup, pcCampgrup, pnprecdebval, pnpreccredval
Store 0 To pnsoldi, pnsoldival, pnprecdebval, pnpreccredval
Store '' To pcTiltlu, pcBancasa, pcTitlugrup, pcCampgrup
lcCont = Alltrim(tcCont)
lcTitlu = Iif(lcCont = '5314', [Alegeti numele casei], [Alegeti numele bancii])
llBanCasaCum = IIF(PCOUNT() = 1, .T., m.tlBancasaCum)
loCasa = caut_parteneri(lcCont, lcTitlu)
&& rezultatele cautarii: loCasa.nume, loCasa.id_part,loCasa.cod_fiscal
If Empty(loCasa.denumire)
Return
Endif
lnId_part = loCasa.id_part
lcNume = loCasa.denumire
Private pcexec, pcselect, pcschema, pcfiltru, pcorder, pobancasaval, pnprecdeb, pnpreccred
Store 0 To pnprecdeb, pnpreccred
Store "" To pobancasaval
*pcexec=[begin cbancasaproc('] + lcCont + [',]+Alltrim(Str(gnluna+gnan*12))+[); end;]
pcexec = [begin pack_sesiune.setcont('] + lcCont + ['); end;]
lnSucces = goExecutor.oExecute(pcexec)
If lnSucces < 0
aMESSAGEBOX(goExecutor.cEroare, 0 + 16, 'Eroare')
Endif
Use In (SELECT('casban'))
*** SELECTIE SOLDURI DIN BALANTA PARTENERI SI INREGISTRARI DIN REGISTRUL JURNAL (VBANCASA SI VBANCASA_VAL)
lcSchema = [nrcrt n(1),fdoc c(30),dataact d,dataireg d,nract N(20),serie_act c(10),bancasa c(50), nume c(50), cod_fiscal c(50), ] + ;
[reg_comert c(50), explicatia c(100), ] + ;
[scd c(4),scc c(4),ascd c(4), ascc c(4),COD N(20),NRORD C(30),NRESP C(30),SUCURSALA C(100),id_nume N(20),id_fdoc N(20),] + ;
[incasari n(19,gnPa),plati n(19,gnPa)] + IIF(Inlist(m.tcCont, '5314','5124'), [,incasval n(19,gnPa),platival n(19,gnPa),numeval C(10),] + IIF(m.tlBancasaCum,[curs C(100)],[curs N(10,4)]), [])
lcSelect = [select nrcrt,fdoc,dataact,dataireg,nract,serie_act,bancasa,nume,cod_fiscal,reg_comert,explicatia,] + ;
[scd,scc,ascd,ascc,COD,NRORD,NRESP,sucursala,id_nume,id_fdoc,] + ;
[incasari,plati] + IIF(Inlist(m.tcCont, '5314','5124'), [,incasval,platival,numeval,curs], []) + ;
[ from vbancasa_] + Alltrim(m.tcCont) + IIF(m.llBancasaCum,[_CUM],[])
lcFiltru = [UPPER(TRIM(bancasa)) = '] + Upper(Alltrim(lcNume)) + ['] + gcCondSucursala
lcOrder = Iif(lcCont = '5314', [dataireg,dataact,cod], [dataact,cod])
llAfisare = .F.
lcGroup = ""
llModParam = .T.
lcFiltruOriginal = ""
gencursor('pobancasaval','casban', lcSelect, lcFiltru, lcSchema, lcOrder, llAfisare, lcGroup, llModParam, lcFiltruOriginal)
pobancasaval.ca_baza1.afisare()
Calculate Sum(incasari), Sum(incasval), Sum(plati), Sum(platival) For nrcrt = 1 To ;
pnprecdeb, pnprecdebval, pnpreccred, pnpreccredval
pnsoldi = pnprecdeb - pnpreccred
pnsoldival = pnprecdebval - pnpreccredval
Select * From casban Where nrcrt = 2 Into Cursor casban_ordonat Readwrite
*!* 29.05.2008
*!* daca nu am rulaje in luna vreau sa listez soldul initial = soldul final fara inregistrari
*!* si trebuie sa pun o linie goala in tabel pt listare
If Reccount('casban_ordonat') = 0
Select bancasa From casban Where nrcrt = 1 Into Cursor cSolduriTemp
Select casban_ordonat
Append From Dbf('cSolduriTemp')
Use In (Select('cSolduriTemp'))
Endif
*!* 29.05.2008 ^
pcTitlu = Iif(lcCont = '5314', 'REGISTRUL DE CASA IN VALUTA', 'REGISTRUL DE BANCA IN VALUTA')
pcBancasa = Iif(lcCont = '5314', 'Casa: ', 'Banca: ')
pcTitlugrup = Iif(lcCont = '5314', [Data inregistrarii: ], [Data actului: ])
pcCampgrup = Iif(lcCont = '5314', [dataireg], [dataact])
goExport.export2frx([casban_ordonat], [registru_casabanca_valuta_rpt1])
Use In (Select('casban'))
Use In (Select('casban_ordonat'))
Endproc
***************************** SFARSIT: listare_registru_casaval *****************************
* PROCEDURE jurnal_plati_incasari
* Date : 10/11/2004, 09:16:01
* author : lavinia.viziru
* description:
****** PARAMETER BLOCK **************
* Parameters : 1
* Parameter 1: tlresp
*
****************************** INCEPUT:jurnal_plati_incasari ********************************
Procedure jurnal_plati_incasari
Parameters tlresp, tlplati
Private pdData1, pdData2, pdinit1, pdinit2
Store {} To pdData1, pdData2, pdinit1, pdinit2
Private pocauta
Store "" To pocauta
pdinit1 = Ctod('01/' + Alltrim(Str(gnLuna)) + '/' + Alltrim(Str(gnAn)))
pdinit2 = Gomonth(pdinit1, 1) - 1
pdData1 = pdinit1
pdData2 = pdinit2
ofrmjur = Createobject("frm_jurnal_plati_incasari") && in orapoarte_cont.vcx
ofrmjur.txtdata1.ControlSource = "pdData1"
ofrmjur.txtdata2.ControlSource = "pdData2"
ofrmjur.opt_afis.Value = Iif(tlplati, 1, 2)
*ofrmjur.opt_recap.enabled = IIF(tlplati,.f.,.t.)
ofrmjur.opt_recap.Value = Iif(tlresp, 2, 1)
ofrmjur.Show(1)
Endproc
****************************** SFARSIT: jurnal_plati_incasari *******************************
Procedure listare_reg_incasariplati
Lparameters llExcel
Local lcCondAct, lcConturi, lnCont
Local lcCuvCurent, lcFile, lcPerioada, lcSql, lncount, loPerioada
PRIVATE pcDataOra, pcTitlu, pcSubtitlu
pcdataora = get_ora(2)
lcCondAct = ".T."
&& citesc din optiuni_firma lista de conturi care nu intra in selectie
lcConturi = ALLTRIM(Upper(Nvl(citeste_optiune('conturi_regincaspl'), '')))
IF EMPTY(m.lcConturi)
lcConturi = '455,591,581'
ENDIF
If Right(lcConturi, 1) = ','
lcConturi = Left(lcConturi, Len(lcConturi) - 1)
Endif
If Left(lcConturi, 1) = ','
lcConturi = Substr(lcConturi, 2)
Endif
&& confirm lista conturi care nu intra in selectie
lcConturi = Inputbox("Conturi", "Conturi care nu intra in selectie", lcConturi)
&& salvez lista de conturi care nu intra in selectie
If !Empty(lcConturi)
scrie_optiune('conturi_regincaspl', m.lcConturi, 'Conturi Reg. Incasari Plati PFA')
Endif
lcCondAct = ""
If !Empty(lcConturi)
lncount = Getwordcount(lcConturi, ",")
For lnCont = 1 To lncount
lcCuvCurent = Getwordnum(lcConturi, m.lnCont, ",")
If At(".", lcCuvCurent) > 0
lcCondAct = lcCondAct + " and NOT(TRIM(scd)+'.'+TRIM(ascd) = '" + lcCuvCurent + "'" + ;
" or TRIM(scc)+'.'+ TRIM(ascc) = '" + TRIM(lcCuvCurent) + "')"
Else
lcCondAct = lcCondAct + " and NOT(TRIM(scd) = '" + lcCuvCurent + "'" + ;
" or TRIM(scc) = '" + lcCuvCurent + "')"
Endif
Endfor
Endif
loPerioada = AlegePerioada() && oproceduri_comune.prg
If loPerioada.an1 * 12 + loPerioada.luna1 = loPerioada.an2 * 12 + loPerioada.luna2
lcPerioada = [ and an = ] + Alltrim(Str(loPerioada.an1)) + [ and luna = ] + Alltrim(Str(loPerioada.luna1))
Else
lcPerioada = [ and an*12+luna between ] + Alltrim(Str(loPerioada.an1 * 12 + loPerioada.luna1)) + [ and ] + Alltrim(Str(loPerioada.an2 * 12 + loPerioada.luna2))
Endif
Text To lcSql Textmerge Noshow
Select an, luna, cod, Max(FDOC) As FDOC,nract,dataact,dataireg, Max(EXPLICATIA) As EXPLICATIA, Max(nrord) As nrord, Max(dst_chlt) As dst_chlt,
SUM(decode(scd, '5311', suma, '5314', suma, 0.00)) As incasaric,
SUM(decode(scc , '5311', suma, '5314', suma, 0.00)) As platic,
SUM(decode(scd,'5121', suma, '5124', suma, 0.00)) As incasarib,
SUM(decode(scc,'5121', suma, '5124', suma, 0.00)) As platib
FROM vact
WHERE (scd In('5311','5121','5124') Or scc In('5311','5121','5124')) And id_set <> 77777 <<m.lcPerioada>> <<m.lcCondAct>>
GROUP By an,luna,cod,nract,dataact,dataireg
ORDER By an, luna, dataact
Endtext
llSucces = goExecutor.oExecuta(m.lcSql, 'crsRegCasaIncasPl')
IF m.llSucces
IF RECCOUNT('crsRegCasaIncasPl') = 0
AMESSAGEBOX('Nu exista inregistrari in perioada aleasa!',0+64,_screen.Caption)
ELSE
If m.llExcel
lcFile = Addbs(gcTempPath) + "TempTrezorerie.Xls"
Copy To (lcFile) Type Xl5
OPEN_DEFAULT_APP(lcFile)
Else
pcTitlu = 'REGISTRU JURNAL DE INCASARI SI PLATI'
pcSubtitlu = loPerioada.perioada
listareuserreport("crsRegCasaIncasPl", "FRX", "rap_reg_incaspl")
ENDIF
ENDIF
ENDIF
Use In (Select('crsRegCasaIncasPl'))
Endproc && listare_reg_incasariplati

2350
Programe/orapoarte.prg Normal file
View File

File diff suppressed because it is too large Load Diff

603
Programe/osituatii_operative.prg Normal file
View File

@@ -0,0 +1,603 @@
*!* 04.08.2011
*!* marius.mutu
*!* PrepareRptSitOp
*!* soldul initial se ia din max(luna de initializare, luna de inceput) in loc de luna de inceput care putea sa nu aiba sume
*!* #3086
*!* 10.11.2011
*!* marius.mutu
*!* PrepareRptSitOp
*!* luna de initializare este (precdeb <> 0 sau preccred <> 0) sau (debit <> 0 sau credit <> 0)
*!* nu detecta corect luna de initializare pentru clienti cu sume in luna
*!* 02.07.2019
*!* marius.mutu
*!* PrepareRptSitOp - corectie grupare la !"defalcare dupa documente pereche"
**********************************************************************************
PROCEDURE PrepareRptBalantaFC
LPARAMETERS tcCont,tcTitlu,tcNumeRaport,tleActiv
** daca nu este precizat contul => va fi cerut
STORE "" TO lctitlu,lcNumeRaport,lcCont
STORE .F. TO eActiv
lcNumeRaport = tcNumeRaport
eActiv = tleActiv
IF EMPTY(tcTitlu)
lctitlu = "Jurnal"
ELSE
lctitlu = tcTitlu
ENDIF
IF EMPTY(tcCont) && cere cont, titlu
DO Alege_Cont_Titlu WITH lcCont,eActiv,lctitlu
ELSE
lcCont = tcCont
** cere & propune [doar] titlu raport:
DO ceretitlu_raport_v2 WITH 'Titlul Raportului','lcTitlu'
ENDIF
**preluare ora de pe oracle server:
*!* STORE 0 TO pnsucces
*!* pcexec = [select to_char(SYSdate,'dd/mm/yyyy hh24:mi:ss') as dataora from dual]
*!* pcCursor = [dataora_cursor]
*!* pnsucces = goExecutor.oExecute(pcexec,pcCursor)
*!* IF (pnsucces != 0)
*!* SELECT dataora_cursor
*!* pcdataora = dataora_cursor.dataora
*!* USE IN dataora_cursor
*!* ENDIF
*!* pcDataOra = get_ora(2)
If glEMama
pcexec = [select sum(precdeb1) as precdeb1,sum(preccred1) as preccred1,] + ;
[sum(precdeb) as precdeb,sum(preccred) as preccred,] + ;
[sum(debit) as debit,sum(credit) as credit,] + ;
[sum(totdeb) as totdeb,sum(totcred) as totcred,] + ;
[sum(solddeb) as solddeb,sum(soldcred) as soldcred,] + ;
[sum(precvaldeb1) as precvaldeb1,sum(precvalcred1) as precvalcred1,] + ;
[sum(precvaldeb) as precvaldeb,sum(precvalcred) as precvalcred,] + ;
[sum(valdebit) as valdebit,sum(valcredit) as valcredit,] + ;
[sum(totvaldeb) as totvaldeb,sum(totvalcred) as totvalcred,] + ;
[sum(soldvaldeb) as soldvaldeb,sum(soldvalcred) as soldvalcred,] + ;
[id_part,nume,cod_fiscal,cont,acont,an,luna,id_valuta,] + ;
[nume_val,moneda_nationala ] + ;
[from ] + gcS + [.vbalanta_parteneri ] + ;
[WHERE cont = ] + Alltrim(lcCont) + [ and luna = ] + Alltrim(Str(gnluna)) + ;
[ and an = ] + Alltrim(Str(gnan)) + ;
[ group by id_part,nume,cod_fiscal,cont,acont,an,luna,] + ;
[id_valuta,nume_val,moneda_nationala order by nume]
Else
pcexec = [SELECT * from ] + gcS + [.vbalanta_parteneri ] + ;
[WHERE cont = ] + Alltrim(lcCont) + [ and luna = ] + Alltrim(Str(gnluna)) + ;
[ and an = ] + Alltrim(Str(gnan)) + gcCondSucursala + [ order by nume]
Endif
pcCursor = [curent_bal_cursor]
pnsucces = goExecutor.oExecute(pcexec,pcCursor)
If (pnsucces != 0)
*!* If reccount(pcCursor) > 0
*!* Select (pcCursor)
*!* Report Format &lcNumeRaport To Printer Prompt Noconsole Preview
*!* Use In (pcCursor)
*!* Else
*!* amessagebox("Nu exista inregistrari pentru listare!",48,"Atentie")
*!* Endif
goExport.export2frx(pcCursor,lcNumeRaport)
Endif
Endproc
****************************************************************************************
********************************************************************************************
PROCEDURE Alege_Cont
LPARAMETERS tcCont,tleActiv
PRIVATE polista,pcschema1,pcselect1,pcfiltru1,pcorder1
STORE "" TO polista
pcschema1=['cont c(4),acont c(4),explicatie c(50)']
pcselect1=['select distinct cont,rpad(CHR(32),4,CHR(32)) as acont,explicatie from ]+gcS+[.vcoresp_tip_cont where 1=2']
pcfiltru1=[2=2]
pcorder1=[cont]
llAfisare=.F.
gencursor('polista','clista',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfisare)
polista.ca_baza1.afisare()
SELECT clista
loCont=myscatter('blank')
PRIVATE eActiv
STORE .T. TO eActiv
Ol=CREATEOBJECT("frm_cere_cont")
WITH Ol
.titlufrumos1.CAPTION= 'Selectati contul'
IF EMPTY(.cboCont.ROWSOURCE)
.cboCont.ROWSOURCE="clista.cont,acont"
ENDIF
.ocont=loCont
IF EMPTY(.cAlias)
.cAlias=LEFT(.cboCont.ROWSOURCE,AT(".",.cboCont.ROWSOURCE)-1)
ENDIF
.HEIGHT = 190
ENDWITH
Ol.SHOW(1)
IF buton = 2
USE IN clista
RETURN
ENDIF
tcCont = loCont.CONT
tleActiv = eActiv
ENDPROC
********************************************************************************************
PROCEDURE ceretitlu_raport_v2
PARAMETERS pc_tit,pc_var
obj1=CREATEOBJECT("frm_cere_titlu")
obj1.clb_tx_simplu1.lb_simplu1.CAPTION = pc_tit
obj1.clb_tx_simplu1.text_simplu1.CONTROLSOURCE = pc_var
obj1.SHOW(1)
********************************************************************************************
PROCEDURE Alege_Cont_Titlu
LPARAMETERS tcCont,tleActiv,tcTitlu
PRIVATE polista,pcschema1,pcselect1,pcfiltru1,pcorder1
STORE "" TO polista
pcschema1=['cont c(4),acont c(4),explicatie c(50)']
pcselect1=['select distinct cont,rpad(CHR(32),4,CHR(32)) as acont,explicatie from ]+gcS+[.vcoresp_tip_cont where 1=2']
pcfiltru1=[2=2]
pcorder1=[cont]
llAfisare=.F.
gencursor('polista','clista',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfisare)
polista.ca_baza1.afisare()
SELECT clista
loCont=myscatter('blank')
PRIVATE eActiv
STORE .T. TO eActiv
Ol=CREATEOBJECT("frm_cere_cont_titlu")
WITH Ol
.titlufrumos1.CAPTION= 'Selectati contul'
IF EMPTY(.cboCont.ROWSOURCE)
.cboCont.ROWSOURCE="clista.cont,acont"
ENDIF
.ocont=loCont
IF EMPTY(.cAlias)
.cAlias=LEFT(.cboCont.ROWSOURCE,AT(".",.cboCont.ROWSOURCE)-1)
ENDIF
.HEIGHT = 190
ENDWITH
Ol.SHOW(1)
IF buton = 2
tcCont = "0"
USE IN clista
RETURN
ELSE
tcCont = loCont.CONT
tleActiv = eActiv
ENDIF
ENDPROC
********************************************************************************************
****************************************************************************************
** daca NU primeste cont si activ => va alege utilizatoru pt. ce cont vrea situatia,
** altfel va fi blocat pe contul primit ca parametru
** daca primeste cont si activ => trebuie sa primeasca si ceilalti parametrii:tlCauta_alfa_Cu_Toti,tlPerioada_Blocata,tcRaport_sau_Vizualizare,tc_NumeForma
**altfel nu este nevoie de ei
PROCEDURE PrepareRptSitOp
LPARAMETERS tcCont,tlActiv,tcTitlu,tlCauta_alfa_Cu_Toti,tlPerioada_Blocata,tcRaport_sau_Vizualizare,tc_NumeForma, tcLuna_sau_Perioada
**rol parametrii:
**___________________
**tcCont : contul
**tlActiv : e true daca contu e activ, false dac e pasiv
**tcTitlu : titlul raportului
**tlCauta_alfa_Cu_Toti: true <=> sa apara "<Toti>" in cauta_alfa, false <=> sa nu apara
**tlPerioada_Blocata : true <=> utilizatorul are blocata perioada, este predefinita, false <=> utilizatorul poate selecta o perioada
**tcRaport_sau_Vizualizare: "Vizualizare" <=> e vizulaizare, lasat gol (sau lipsa) <=>direct raport
**tc_NumeForma : numele clasei dupa care va fi facuta forma de vizualizare (cum e aceeasi in toate cazurile, ar putea lipsi...)
Private plDefalcatDocumentPereche, pnSemn, pnId_part, pcCont, pcPerioada, pcAnalitic, plActiv
Private lctitlu,lcPerioada,lcEntitateAleasa,lnId_part,lnFel_raport, llFormRelease, lcluna1, lcluna2, lclunaAn1, lclunaAn2, lcAn1, lcAn2
PRIVATE lnSold_Final_Total, lnSold_Initial_Total
Local lnNrLuni1, lnNrLuni2, lcConditieAnaliticCredit, lcConditieAnaliticDebit, lcRaport, lcSelect, lcSql
Local lnId_part_curent, lnSoldInit, lnSucces, j
plDefalcatDocumentPereche = .T. && daca documentele de incasare/plata se defalca dupa documentele pereche
STORE "" TO lctitlu,lcPerioada,lcEntitateAleasa, pcAnalitic
STORE 0 TO lnId_part,lnFel_raport
STORE .F. TO plActiv
STORE .F. TO llFormRelease
pcCont = IIF(EMPTY(tcCont),[],tcCont)
DECLARE laId_part(1,1) && stocare id-uri parteneri
laId_part[1,1] = 0
IF EMPTY(tcRaport_sau_Vizualizare)
tcRaport_sau_Vizualizare = "Raport"
ENDIF
IF EMPTY(tcTitlu)
lctitlu = "Situatii Operative "+pcCont && titlu default
ELSE
lctitlu = tcTitlu
ENDIF
** daca primeste parametrii de restrictie => creaza forma de introducere cont si partener cu acesti parametrii:
**daca NU => o creaza cu totul selectabil:
IF !EMPTY(tcCont)
OsitOp = CREATEOBJECT('frm_lans_sit_op',tcCont,tlActiv,tlCauta_alfa_Cu_Toti,tlPerioada_Blocata,tcLuna_sau_Perioada)
ELSE && elsu asta deocamdata nu-l face deloc...
*!* lctitlu = "Situatie Operativa Entitati"
*!* DO ceretitlu_raport_v2 WITH 'Titlul Raportului','lcTitlu'
OsitOp = CREATEOBJECT('frm_lans_sit_op')
ENDIF
OsitOp.SHOW(1)
IF !llFormRelease
RETURN
ENDIF
IF (AT("-",lcPerioada)!=0)
lclunaAn1 = SUBSTR(lcPerioada,1,7)
lclunaAn2 = SUBSTR(lcPerioada,9)
lcluna1=SUBSTR(lclunaAn1,1,2)
lcAn1 = SUBSTR(lclunaAn1,4)
lcluna2=SUBSTR(lclunaAn2,1,2)
lcAn2 = SUBSTR(lclunaAn2,4)
ELSE
lcluna1=SUBSTR(PADL(lcPerioada,7,"0"),1,2)
lcAn1 = SUBSTR(PADL(lcPerioada,7,"0"),4)
lcluna2 = lcluna1
lcAn2 = lcAn1
ENDIF
IF lcEntitateAleasa = "<TOATE INREGISTRARILE>"
lcEntitateAleasa = "Toate Entitatile"
ENDIF
pnSemn = IIF(plActiv = .T., 1, -1)
pnId_part = lnId_part
*!* modificare v 2.0.85
*!* pcCont = tcCont
*!* modificare v 2.0.85 ^
pcPerioada = lcPerioada
pcAnalitic=ALLTRIM(pcAnalitic)
*MESSAGEBOX(pcAnalitic)
** restrictii:
** totzi partenerii => doar luna curenta, (simplu=NEgrupat sau grupat)
** singur partener => raport simplu=NEgrupat (pe o luna sau pe un interval de luni)
*** creare structura cursor:
CREATE CURSOR cursor_raport (nrord c(50) NULL, contract c(30) NULL, fel_document c(30) NULL, PART c(100) NULL, partX c(100) NULL, serie_act C(10) NULL, nract N(20), dataact d NULL,datascad d NULL, ;
debit N(20,4), credit N(20,4), soldi N(20,4), soldf N(20,4), dataireg d NULL, id_lucrare N(10), id_fdoc N(10), an N(4), luna N(2), ;
id_part N(10), id_partX N(10), id_fact N(10), id_factX N(10), perecheX N(14), contX c(4))
*** sold initial:
*** luna pentru soldurile initiale = max(luna de initializare solduri, luna de inceput)
*!* 04.08.2011
LOCAL lnAnLunaInitializare, lnAnInitializare, lnLunaInitializare
lnAnLunaInitializare = 0
lnLunaInitializare = VAL(m.lcLuna1)
lnAnInitializare = VAL(m.lcAn1)
lnNrLuni1 = VAL(m.lcAn1)*12 + VAL(m.lcLuna1)
lnNrLuni2 = VAL(m.lcAn2)*12 + VAL(m.lcLuna2)
lcSql = [SELECT MIN(an*12 + luna) as luna_initializare FROM balanta_parteneri WHERE cont = ?pcCont and (precdeb <> 0 OR preccred <> 0 or debit <> 0 or credit <> 0) and an*12+luna BETWEEN ] + ;
ALLTRIM(STR(lnNrLuni1)) + [ and ] + ALLTRIM(STR(lnNrLuni2)) + IIF(pnId_part <> 0,[ and id_part = ?pnId_part],[])
lnSucces = goExecutor.oSelect2Value(lcSql, @lnAnLunaInitializare)
IF lnSucces < 0
aMESSAGEBOX(goExecutor.cEroare, 0+48, _screen.Caption)
ENDIF
lnAnLunaInitializare = MAX(NVL(m.lnAnLunaInitializare,0), lnAnInitializare * 12 + lnLunaInitializare )
NrLuni2AnLuna(lnAnLunaInitializare, @lnAnInitializare, @lnLunaInitializare)
lcAn1 = ALLTRIM(STR(INT(lnAnInitializare)))
lcLuna1 = PADL(INT(lnLunaInitializare), 2, '0')
*!* 04.08.2011 ^
*!* IF (lnId_part != 0) && simplu=NEgrupat <=> un singur partener
pcexec = [SELECT ?pnSemn*sum(precdeb-preccred) as sold_init from ] + ;
gcS + [.balanta_parteneri WHERE ] + IIF(pnId_part <> 0,[id_part =?pnId_part],[1=1]) + ;
[ and luna=] + ALLTRIM(STR(lnLunaInitializare)) + [ and an=] + ALLTRIM(STR(lnAnInitializare)) + [ and cont = ?pcCont] +IIF(EMPTY(pcAnalitic),[],[ and acont=?pcAnalitic ])+ gcCondSucursala
*!* ELSE
*!* pcexec = [SELECT ?pnSemn*(precdeb-preccred) as sold_init from ] + gcS + [.bal WHERE luna = ] + ALLTRIM(lcluna1) + [ and an=] + ALLTRIM(lcAn1) + [ and cont=] + ALLTRIM(lcCont)
*!* ENDIF
pcCursor = [sold_cursor]
pnsucces = goExecutor.oExecute(pcexec,pcCursor)
SELECT sold_cursor
GO TOP
IF ISNULL(sold_init)
lnSoldInit = 0
ELSE
lnSoldInit = sold_init
ENDIF
USE IN sold_cursor
*** inserare prima linie cu sold initial:
SELECT cursor_raport
IF (pnSemn = 1) && activ
INSERT INTO cursor_raport(nrord,debit,an,luna) VALUES("SOLD INITIAL "+lcluna1+"/"+lcAn1,lnSoldInit,VAL(lcAn1),VAL(lcluna1))
ELSE
INSERT INTO cursor_raport(nrord,credit,an,luna) VALUES("SOLD INITIAL "+lcluna1+"/"+lcAn1,lnSoldInit,VAL(lcAn1),VAL(lcluna1))
ENDIF
*** umplere cursor_raport cu datele din act:
If pcAnalitic #""
lcConditieAnaliticDebit=[ and ascd = ?pcAnalitic]
lcConditieAnaliticCredit=[ and ascc = ?pcAnalitic]
Else
lcConditieAnaliticDebit=[]
lcConditieAnaliticCredit=[]
EndIf
IF (lnId_part != 0) && simplu=NEgrupat <=> un singur partener
pcexec = [select l.nrord, c.contract, f.fel_document, p.nume as part, px.nume as partX,a.serie_act,a.nract,a.dataact,a.datascad, ] +;
[SUM(a.debit) as debit, SUM(a.credit) as credit,a.dataireg,a.id_lucrare,a.id_ctr, a.id_fdoc,a.an,a.luna,a.id_part,a.id_partX, a.id_fact, a.id_factX, a.perecheX, MAX(a.contX) as contX from ] +;
[(select (case when scd = ?pcCont then id_partd when scc = ?pcCont then id_partc else 00000000000000000 end) as id_part,]+;
[(case when scd = ?pcCont then id_partc when scc = ?pcCont then id_partd else 00000000000000000 end) as id_partX,]+;
Iif(!plDefalcatDocumentPereche, ;
[00000000000000000 as perecheX,], ;
[(case when scd = ?pcCont then perecheD when scc = ?pcCont then perecheC else 00000000000000000 end) as perecheX,]) + ;
Iif(!plDefalcatDocumentPereche, ;
[00000000000000000 as id_factX,], ;
[(case when scd = ?pcCont then id_factD when scc = ?pcCont then id_factC else 00000000000000000 end) as id_factX,]) + ;
[(case when scd = ?pcCont and ?pnSemn = -1 then scc when scc = ?pcCont and ?pnSemn = 1 then scd else ' ' end) as contX,]+;
[(case when (scd = ?pcCont and NVL(e.exceptie,0)=0) or (scc = ?pcCont and ?pnSemn=1 and NVL(e.exceptie,0)=1) then CASE WHEN NVL(E.EXCEPTIE,0) = 1 THEN -SUMA ELSE SUMA END else 0.0000 end) as debit,]+;
[(case when (scc = ?pcCont and NVL(e.exceptie,0)=0 ) or (scd = ?pcCont and ?pnSemn=-1 and NVL(e.exceptie,0)=1) then CASE WHEN NVL(E.EXCEPTIE,0) = 1 THEN -SUMA ELSE SUMA END else 0.0000 end) as credit,]+;
[id_fact, serie_act, nract, dataact,datascad, dataireg, id_lucrare, id_ctr, id_fdoc, an, luna ] +;
[ from act ] +;
[LEFT JOIN (SELECT DISTINCT 1 AS EXCEPTIE,]+;
[DECODE(DEBIT, 1, CONT_C, CONT) AS SCDe,]+;
[DECODE(DEBIT, 1, CONT, CONT_C) AS SCCe ]+;
[FROM EXCEPTII_IREG ]+;
[WHERE INVERS = 1 ]+;
[AND CONT = ']+pcCont+[') E ON Act.SCD = E.SCDe ]+;
[AND Act.SCC = E.SCCe ]+;
[where sters = 0 and ((scd = ?pcCont and id_partd = ?pnId_part]+lcConditieAnaliticDebit+[) or (scc = ?pcCont and id_partc = ?pnId_part]+lcConditieAnaliticCredit+[))] + ;
gcCondSucursala + ;
[ and an*12+luna between ] + ALLTRIM(lcAn1) + [*12+] + ALLTRIM(lcluna1) + [ and ] + ALLTRIM(lcAn2) + [*12+] + ALLTRIM(lcluna2) + [) a ] +;
[left join vnom_lucrari l on a.id_lucrare = l.id_lucrare ] +;
[left join vcontracte c on a.id_ctr = c.id_ctr ] +;
[left join nom_fdoc f on a.id_fdoc = f.id_fdoc ] +;
[left join nom_parteneri p on a.id_part = p.id_part ] +;
[left join nom_parteneri px on a.id_partX = px.id_part ] +;
[group by l.nrord, c.contract, f.fel_document, p.nume, px.nume,a.serie_act, a.nract,a.dataact,a.datascad,a.dataireg,a.id_lucrare,a.id_ctr,a.id_fdoc,a.an,a.luna,a.id_part,a.id_partX, a.id_fact ] + ;
[,a.id_factX, a.perecheX ] + ;
[order by a.dataact, a.nract]
ELSE
pcexec = [select l.nrord, c.contract, f.fel_document, p.nume as part, px.nume as partX,a.serie_act,a.nract,a.dataact,a.datascad, ] +;
[SUM(a.debit) as debit, SUM(a.credit) as credit,a.dataireg,a.id_lucrare,a.id_ctr,a.id_fdoc,a.an,a.luna,a.id_part,a.id_partX, a.id_fact, a.id_factX, a.perecheX, MAX(a.contX) from ] +;
[(select (case when scd = ?pcCont then id_partd when scc = ?pcCont then id_partc else 00000000000000000 end) as id_part,]+;
[(case when scd = ?pcCont then id_partc when scc = ?pcCont then id_partd else 00000000000000000 end) as id_partX,]+;
Iif(!plDefalcatDocumentPereche, [00000000000000000 as perecheX,], ;
[(case when scd = ?pcCont then perecheD when scc = ?pcCont then perecheC else 00000000000000000 end) as perecheX,]) + ;
Iif(!plDefalcatDocumentPereche, [00000000000000000 as id_factX,], ;
[(case when scd = ?pcCont then id_factD when scc = ?pcCont then id_factC else 00000000000000000 end) as id_factX,]) + ;
[(case when scd = ?pcCont and ?pnSemn = -1 then scc when scc = ?pcCont and ?pnSemn = 1 then scd else ' ' end) as contX,]+;
[(case when (scd = ?pcCont and NVL(e.exceptie,0)=0) or (scc = ?pcCont and ?pnSemn=1 and NVL(e.exceptie,0)=1) then CASE WHEN NVL(E.EXCEPTIE,0) = 1 THEN -SUMA ELSE SUMA END else 0.0000 end) as debit,]+;
[(case when (scc = ?pcCont and NVL(e.exceptie,0)=0) or (scd = ?pcCont and ?pnSemn=-1 and NVL(e.exceptie,0)=1) then CASE WHEN NVL(E.EXCEPTIE,0) = 1 THEN -SUMA ELSE SUMA END else 0.0000 end) as credit,]+;
[id_fact, serie_act, nract, dataact,datascad, dataireg, id_lucrare, id_ctr,id_fdoc, an, luna ]+;
[ from act ] +;
[LEFT JOIN (SELECT DISTINCT 1 AS EXCEPTIE,]+;
[DECODE(DEBIT, 1, CONT_C, CONT) AS SCDe,]+;
[DECODE(DEBIT, 1, CONT, CONT_C) AS SCCe ]+;
[FROM EXCEPTII_IREG ]+;
[WHERE INVERS = 1 ]+;
[AND CONT = ']+pcCont+[') E ON Act.SCD = E.SCDe ]+;
[AND Act.SCC = E.SCCe ]+;
[where sters = 0 and ((scd = ?pcCont]+lcConditieAnaliticDebit+[) or (scc = ?pcCont ]+lcConditieAnaliticCredit+[))] + ;
gcCondSucursala + ;
[ and an*12+luna between ] + ALLTRIM(lcAn1) + [*12+] + ALLTRIM(lcluna1) + [ and ] + ALLTRIM(lcAn2) + [*12+] + ALLTRIM(lcluna2) + [) a ] +;
[left join vnom_lucrari l on a.id_lucrare = l.id_lucrare ] +;
[left join vcontracte c on a.id_ctr = c.id_ctr ] +;
[left join nom_fdoc f on a.id_fdoc = f.id_fdoc ] +;
[left join nom_parteneri p on a.id_part = p.id_part ] +;
[left join nom_parteneri px on a.id_partX = px.id_part ] +;
[group by l.nrord, c.contract, f.fel_document, p.nume, px.nume,a.serie_act,a.nract,a.dataact,a.datascad,a.dataireg,a.id_lucrare,a.id_ctr,a.id_fdoc,a.an,a.luna,a.id_part,a.id_partX, a.id_fact ] + ;
[,a.id_factX, a.perecheX ] + ;
[order by ] + IIF(lnFel_raport = 1,[p.nume,a.id_part,],[]) + [a.dataact, a.nract]
ENDIF
pcCursor = [cursor_act]
pnsucces = goExecutor.oExecute(pcexec,pcCursor)
IF pnsucces < 0
AMESSAGEBOX('Eroare la cursor_act : ' + goExecutor.cEroare)
RETURN
ENDIF
SELECT cursor_raport
APPEND FROM DBF('cursor_act')
** calculare si inserare sold cumulat:
**[prinde in calcul si soldul initial, acesta fiind trecut pe coloana debit sau credit, pe prima linie]
*---------------- UN FEL DE DENOMINARE daca data in care am intrat este mai mare decat 7/2005
IF (gnan*12 + gnluna >= gnAnRon*12 + gnLunaRon) AND (VAL(lcluna1) + VAL(lcAn1)*12 < gnAnRon*12 + gnLunaRon)
SELECT cursor_raport
REPLACE ALL debit WITH debit/10000 FOR an *12 + luna < gnAnRon*12 + gnLunaRon
REPLACE ALL credit WITH credit/10000 FOR an *12 + luna < gnAnRon*12 + gnLunaRon
ENDIF
*---------------- END UN FEL DE DENOMINARE
IF !(lnFel_raport = 1) && NEgrupat
STORE 0 TO lnSold_Initial_Total
STORE 0 TO lnSold_Final_Total
STORE 0 TO sold_cumulat
SELECT cursor_raport
LOCATE
lnSold_Initial_Total = lnSold_Initial_Total + pnSemn*(debit - credit)
SCAN
sold_cumulat = sold_cumulat + pnSemn*(debit - credit)
REPLACE soldf WITH sold_cumulat
ENDSCAN
lnSold_Final_Total = sold_cumulat
ELSE
** incarcare vector cu solduri initiale pe fiecare partener:
*** sold initial/partener:
pcexec = [SELECT id_part, nume as part, sum(?pnSemn*(precdeb-preccred)) as sold_init, 0 as ales ] + ;
[from vbalanta_parteneri WHERE luna=] + ALLTRIM(STR(lnLunaInitializare)) + [ and an=] + ALLTRIM(STR(lnAnInitializare)) + [ and cont = ?pcCont ] +;
gcCondSucursala + ;
[ group by id_part, nume order by nume ]
*!* 04.08.2011 ^
pcCursor = [sold_cursor]
pnsucces = goExecutor.oExecute(pcexec,pcCursor)
** calculare si inserare sold initial,sold final/fiece partener:
STORE 0 TO lnSold_Initial_Total
STORE 0 TO lnSold_Final_Total
STORE 1 TO j
STORE 0 TO sold_final, sold_ini
STORE 0 TO lnId_part_curent
SELECT sold_cursor
SCAN
SCATTER NAME osold
lnSold_Initial_Total = lnSold_Initial_Total + osold.sold_init
lnSold_Final_Total = lnSold_Final_Total + osold.sold_init
sold_final = osold.sold_init
SELECT cursor_raport
SCAN FOR id_part = osold.id_part
sold_final = sold_final + pnSemn*(debit - credit)
lnSold_Final_Total = lnSold_Final_Total + pnSemn*(debit - credit)
REPLACE soldf WITH sold_final
REPLACE soldi WITH osold.sold_init
osold.ales = 1
SELECT cursor_raport
ENDSCAN
IF osold.ales = 0 AND osold.sold_init <> 0
SELECT cursor_raport
APPEND BLANK
REPLACE id_part WITH osold.id_part, PART WITH osold.PART, soldi WITH osold.sold_init, soldf WITH osold.sold_init
ENDIF
SELECT sold_cursor
ENDSCAN
IF USED('sold_cursor')
USE IN sold_cursor
ENDIF
****** cu array
*!* SELECT DISTINCT id_part, sold_init FROM sold_cursor INTO ARRAY laId_part
*!* SELECT cursor_raport
*!* LOCATE
*!* *sold_final = pnSemn*(debit - credit)&& sa calculeze in functie de soldu init
*!* IF RECCOUNT()>1
*!* GOTO 2 && pe prima e soldu init, nu partener
*!* lnId_part_curent = id_part
*!* lnNrRand = ALEN(laId_part,1)
*!* lnElem = ASCAN(laId_part, lnId_part_curent,1,lnNrRand,1)
*!* lnLinie = ASUBSCRIPT(laId_part, lnElem, 1)
*!* sold_ini = laId_part[lnLinie,2]
*!* sold_final = sold_ini
*!* lnSold_Initial_Total = lnSold_Initial_Total + sold_ini
*!* lnSold_Final_Total = lnSold_Final_Total + sold_ini
*!*
*!* SCAN FOR id_part <> 0 && prima linie = cea cu soldu init total=> are id_part = 0 =>fara ea
*!* *** sold final calculat: e sold final deabia pe ultima linie corespunzatoare fiecarui partener, in rest (pana acolo) e sold_cumulat
*!* IF (id_part != lnId_part_curent)
*!* lnId_part_curent = id_part
*!* lnElem = ASCAN(laId_part, lnId_part_curent,1,lnNrRand,1)
*!* lnLinie = ASUBSCRIPT(laId_part, lnElem, 1)
*!* sold_ini = laId_part[lnLinie,2]
*!* sold_final = sold_ini
*!* lnSold_Initial_Total = lnSold_Initial_Total + sold_ini
*!* lnSold_Final_Total = lnSold_Final_Total + sold_ini
*!* ENDIF
*!* sold_final = sold_final + pnSemn*(debit - credit)
*!* lnSold_Final_Total = lnSold_Final_Total + pnSemn*(debit - credit)
*!* REPLACE soldf WITH sold_final
*!* *REPLACE soldi WITH laId_part[lnLinie,2]
*!* REPLACE soldi WITH sold_ini
*!* ENDSCAN
*!* ENDIF
ENDIF
**afisare raport sau forma de vizualizare:
If tcRaport_sau_Vizualizare == "Vizualizare"
op=Createobject(tc_NumeForma,laId_part)
op.Lb_titlu_alb_b121.Caption = 'SITUATIE OPERATIVA ' + pcCont + ' - ' +lcEntitateAleasa
op.Show(1)
Else
*!* modificare v 2.0.84
*!* If Reccount('cursor_raport')>0
If Reccount('cursor_raport')>1 && are intotdeauna o linie (soldul initial)
Private pnOptiune
Local lnNrOptiuni,loFrmOpt
pnOptiune = 1
lnNrOptiuni=2
Do While gnButon = 1
loFrmOpt=Createobject("frm_optiune",[Vizualizare raport],[Alegeti modalitatea de vizualizare:],lnNrOptiuni,[Listare la imprimanta;Export in Excel;])
loFrmOpt.Show(1)
Release loFrmOpt
If gnButon = 1
If pnOptiune = 1
*!* modificare v 2.0.84 ^
pctitlu = lcTitlu
*!* pcdataora = get_ora(2)
*!* Select cursor_raport
*!* IF (lnId_part != 0)
*!* REPORT FORMAT sit_oper_sing_rpt1 TO PRINTER PROMPT NOCONSOLE PREVIEW
*!* ELSE
Select cursor_raport
Set Filter To ID_PART <> 0
If (lnFel_raport = 1) && grupat
*!* Report Format sit_oper_multi_gr_rpt1 To Printer Prompt Noconsole Preview
lcRaport = [sit_oper_multi_gr_rpt1]
Else && NEgrupat
*!* Report Format sit_oper_multi_NEgr_rpt1 To Printer Prompt Noconsole Preview
lcRaport = [sit_oper_multi_NEgr_rpt1]
Endif
goExport.export2frx([cursor_raport],lcRaport,, , , , , .T.)
*!* ENDIF
*!* modificare v 2.0.84
ELSE
If Used('cursor_excel')
Use In cursor_excel
Endif
lcSelect = [Select Cast(fel_document As c(100)) As fel_document,dataireg as data_inreg,dataact as data_act,] + ;
[CAST((Alltrim(Alltrim(Nvl(serie_act,''))+' '+Alltrim(Str(nract,20)))) As c(100)) As nr_act,] + ;
[CAST(part as c(100)) as partener,CAST(allt(nvl(nrord, ''))+IIF(!EMPTY(NVL(contract,'')),';', '')+allt(nvl(contract,'')) As c(100)) As lucrare_contract,] + ;
[CAST(credit As N(14,gnPa)) As credit,Cast(debit As N(14,gnPa)) As debit,] + ;
[CAST(soldi As N(14,gnPa)) As soldi,Cast(soldf As N(14,gnPa)) As soldf] + ;
IIF(plDefalcatDocumentPereche,[,CAST(ALLTRIM(STR(perechex)) As c(50)) As doc_pereche],[]) + [ From cursor_raport ] + ;
[ORDER BY ] + IIF(lnFel_raport = 1,[5,],[]) + [3,4 Into Cursor cursor_excel]
&lcSelect
goExport.export2xlsx([cursor_excel])
Use In cursor_excel
Endif
Endif
Enddo
*!* modificare v 2.0.84 ^
Else
amessagebox("Nu exista inregistrari pentru listare/export!",48,"Atentie")
Endif
Use In cursor_raport
Endif
ENDPROC
********************************************************************************************

113
Programe/penalitati.prg Normal file
View File

@@ -0,0 +1,113 @@
Procedure penalitati
Lparameters tlEvaluare
*!* 10.03.2010
*** tlEvaluare : .T. daca se doreste un calcul al penalitatilor in functie de o data de referinta
*** tlEvaluare : .F. (default) daca se doreste facturare penalitati la momentul incasarii facturilor restante
*!* 10.03.2010 ^
Private pdDataReferinta
pdDataReferinta = Date()
Private pcNumeFiltru, pcContractFiltru, pcExplicatiaFiltru
Store "" To pcNumeFiltru, pcContractFiltru, pcExplicatiaFiltru
*!* selectez incasarile din registrul jurnal care s-au incasat dupa data scadenta a facturilor corespondente
*!* left join cCurs ci on c.id_tipv = ci.id_tipv AND i.dataact = ci.datacurs ;
*!* LEFT JOIN tipv tv ON c.id_tipv = tv.id ;
If !tlEvaluare
*!* 14.03.2011
SELECT NUME, NRACT, DATAACT, PERECHE2, SUM(SUMA) as suma, SUM(SUMA_2) as suma_2 ;
FROM act ;
WHERE INLIST(SCC,'411','461') AND SCD <> '4118' ;
GROUP BY NUME, NRACT, DATAACT, PERECHE2 ;
INTO CURSOR cAct
Select F.Id As FACT_ID, Cl.Id As clie_id, F.PL_CLIE_ID As ctr_id, F.NRFACT, F.DATAFACT, F.DATASCAD, F.VALCTVA, F.TOTVAL, F.Curs, F.VALUTA, F.INTERN, ;
F.EXPLICATIA, C.contract, ;
I.NUME, I.nract, I.DATAACT, I.SUMA, I.SUMA_2 AS SUMAVAL, I.PERECHE2, C.PPENZI, I.DATAACT - F.DATASCAD As NR_ZILE, ;
round(Round(PPENZI/100*SUMA,GNZ)*(I.DATAACT - F.DATASCAD), GNZ) As penalitati ;
from FACTURARE F Join ACNCONTRACTE C On F.PL_CLIE_ID = C.Id ;
join ACNCLIENTI Cl On C.clie_id = Cl.Id ;
join cAct I On F.NRFACT = I.PERECHE2 And Padr(Cl.NUME,30,' ') = Padr(I.NUME,30,' ') ;
where F.TIP <> 6 AND I.DATAACT > F.DATASCAD ;
order By I.NUME, F.DATAFACT, F.NRFACT, I.DATAACT, I.nract ;
into Cursor cFiordTemp Readwrite
*!* 14.03.2011 ^
Select penalitati
Scan For Year(DATAACT)*12 + Month(DATAACT) = Val(m.gcAn) * 12 + Val(m.gcNl)
Scatter Name loRec
Delete From cFiordTemp Where FACT_ID = loRec.FACT_ID And nract = loRec.nract And DATAACT = loRec.DATAACT
Endscan
&& nu facturez facturile/incasarile pe care utilizatorul le-a sters
Select penalitati_sters
Scan For Year(DATAACT)*12 + Month(DATAACT) = Val(m.gcAn) * 12 + Val(m.gcNl)
Scatter Name loRec
Delete From cFiordTemp Where FACT_ID = loRec.FACT_ID And nract = loRec.nract And DATAACT = loRec.DATAACT And SUMA = loRec.SUMA
Endscan
Select * From cFiordTemp Into Cursor CFIORD NOFILTER Readwrite
Use In (Select('cFiordTemp'))
Else
loPenalitatiInfo = Createobject("frm_penalitati_info")
loPenalitatiInfo.Show(1)
If gnButon = 2
Return
ENDIF
*!* 14.03.2011
*** SELECTEZ FACTURILE DIN FACTURARE (EMISE DE COMERCIAL) DAR CU SOLD IN VANZLUN SI DEBLUN IN LUNA CURENTA
*!* 12.09.2011
Select i.id_fact, i.id_part, c.id_ctr, i.nract as nrfact, i.dataact as datafact, i.datascad, (i.precdeb+i.debit) as valctva, ;
(i.precvaldeb+i.valdebit) as totval, i.Curs, i.id_valuta, i.nume_val as valuta, ;
i.explicatia, c.contract, ;
i.nume, 0 As nract, pdDataReferinta As DATAACT, ;
(i.precdeb+i.debit)-(i.preccred+i.credit) As suma, ;
(i.precvaldeb+i.valdebit)-(i.precvalcred+i.valcredit) AS sumaval, ;
0 As PERECHE2, c.ppenzi, pdDataReferinta - i.datascad As nr_zile, ;
round(Round(c.ppenzi/100*((i.precdeb+i.debit)-(i.preccred+i.credit)), gnPA)*(pdDataReferinta - i.datascad), gnPA) As penalitati ;
from vireg_parteneri i Join contracte C On i.id_part = c.id_part ;
where i.an = gnAn AND i.luna = gnLuna AND F.TIP <> 6 AND pdDataReferinta > F.DATASCAD And ;
V.TOTCTVA - V.ACHITAT > 0 ;
order By Cl.NUME, F.DATAFACT, F.NRFACT ;
into Cursor CFIORD Readwrite
*!* 12.09.2011 ^
*!* 14.03.2011 ^
Endif
*!* 14.03.2011
UPDATE cFiord SET valuta = "", totval = 0, sumaval = 0 WHERE intern
GO TOP IN cFiord
*!* 14.03.2011 ^
Select NUME Where .F. From CFIORD Into Cursor cClientiTemp Readwrite
Select Distinct NUME From CFIORD Order By NUME Into Cursor cClientiTemp2
If _Tally > 1 && daca vreau facturile pentru toti client nu mai adaug <TOTI> pentru filtrarea facturilor
Insert Into cClientiTemp (NUME) Values ('<TOTI>')
Endif
Select cClientiTemp
Append From Dbf('cClientiTemp2')
Use In (Select('cClientiTemp2'))
Select CFIORD
*!*Do Form frm_penalitati Name loPenalitati Noshow
loPenalitati = Createobject("frm_penalitati")
*!* 10.03.2010
loPenalitati.lEvaluare = .T.
loPenalitati.dDataReferinta = pdDataReferinta
If tlEvaluare
loPenalitati.lb_titlu_alb_b121.Caption = 'Penalitati - evaluare la ' + Dtoc(m.pdDataReferinta)
loPenalitati.grdPenalitati.cNrDoc.Visible = .F.
loPenalitati.grdPenalitati.cSuma.Header1.Caption = 'Sold restant'
loPenalitati.grdPenalitati.cDataDoc.Header1.Caption = 'Data referinta'
loPenalitati.cmd_Executa1.Visible = .F.
loPenalitati.cmd_Executa1.Visible = .F.
Endif
*!* 10.03.2010 ^
loPenalitati.Show(1)
Use In (Select('cFiord'))
Endproc && Penalitati

227
Programe/proceduri.prg Normal file
View File

@@ -0,0 +1,227 @@
*!* *_________________________________________________________
PROCEDURE caut_alfa_cursor
PARAMETERS NUMEBAZA,NUMECIMP,CAPTEXT,VARMEM
LOCAL MC0,MC1,MC2, llVizibil
SET SAFETY OFF
llVizibil = .t.
MC0='SELE '+NUMEBAZA
MC1='VARMEM=M.'+NUMECIMP
MC2 = [INDEX ON ] +NUMECIMP+ [ TAG nume OF &loc\&nfscurt\tempo\xindex.idx COMPACT ASCENDING ]
LOCAL lcNumeCol2
STORE '' TO lcNumeCol2
LcCol = ALLTRIM(NUMEBAZA) + '.cod_fiscal'
IF TYPE(LcCol) # 'U'
lcNumeCol2 = 'cod_fiscal'
ENDIF
LcCol = ALLTRIM(NUMEBAZA) + '.gest'
IF TYPE(LcCol) # 'U'
lcNumeCol2 = 'gest'
ENDIF
LcCol = ALLTRIM(NUMEBAZA) + '.id_sectie'
IF TYPE(LcCol) # 'U'
lcNumeCol2 = 'id_sectie'
ENDIF
IF EMPTY(lcNumeCol2)
lcNumeCol2 = 'space(4)'
llVizibil = .f.
ENDIF
LcCol = ALLTRIM(NUMEBAZA) + '.id'
IF TYPE(LcCol) # 'U'
lcNumeCol3 = 'id'
ELSE
lcNumeCol3 = 'space(4)'
ENDIF
SELECT DISTINCT &NUMECIMP, &lcNumeCol2, &lcNumeCol3 FROM (numebaza) INTO CURSOR tnomenclator READWRITE ORDER BY &NUMECIMP
OCA=CREATEOBJECT("CAUTALFa")
OCA.CAPTION=CAPTEXT
OCA.GRID1.RECORDSOURCE='tnomenclator'
OCA.GRID1.COLUMN1.CONTROLSOURCE = NUMECIMP
OCA.GRID1.COLUMN2.CONTROLSOURCE = lcNumeCol2
OCA.GRID1.COLUMN2.visible = llVizibil
OCA.cmdrenunt1.visible=.t.
OCA.command1.visible=.f.
OCA.command2.visible=.f.
OCA.command3.visible=.f.
OCA.SHOW(1)
IF buton=2
USE IN tnomenclator
RETURN
ENDIF
lcFile = ADDBS(gcTempPath) + 'xindex.idx'
IF FILE(lcFile)
SET INDEX TO
DELETE FILE &lcFile
ENDIF
*!* &MC1
SELECT tnomenclator
SCATTER MEMVAR
&MC1
USE IN tnomenclator
RETURN
*!* *___________________________________________
PROCEDURE MESAJ
PARAMETERS m1,m2
ot=create('text')
ot.label2.caption=m1
ot.label3.caption=m2
ot.show(1)
RETURN
*!* *___________________________________________
*!* PROCEDURE mesajmare
*!* PARAMETERS m1
*!* ot=create('textmare')
*!* ot.label2.caption=m1
*!* ot.show(1)
*!* RETURN
*!* *___________________________________________
*!* PROCEDURE mesajval
*!* PARAMETERS m1,m2
*!* ot=create('textval')
*!* ot.label2.caption=m1
*!* ot.valoare=m2
*!* ot.show(1)
*!* RETURN
*!* *___________________________________________
PROCEDURE mesajatent
PARAMETERS m1,m2
ot=create('atentie')
ot.label2.caption=m1
ot.label3.caption=m2
ot.show(1)
RETURN
*!* *___________________________________________
*!* PROCEDURE mesajrosu
*!* PARAMETERS m1,m2
*!* ot=create('atentierosu')
*!* ot.label2.caption=m1
*!* ot.label3.caption=m2
*!* ot.show(1)
*!* RETURN
*!* *_____________________________________-
*!* PROCEDURE mesajm
*!* PARAM txt,i
*!* LOCAL t,p
*!* p=iif(i<10,str(i,1),str(i,2))
*!* T='orm.label'+p+'.caption="'+txt+'"'
*!* &t
*!* IF i<20
*!* i=i+1
*!* ENDIF
*!* p=iif(i<10,str(i,1),str(i,2))
*!* T='orm.IMAGE'+p+'.VISIBLE=.T.'
*!* &t
*!* RETURN
*!* *___________________________________________
PROCEDURE danu
PARAMETERS m1
od=create('danu')
od.label1.caption=m1
od.show(1)
RETURN
*!* *___________________________________________
*!* *____________________________________
*!* PROC PR
*!* PARAM J
*!* IF J>M
*!* op.release
*!* op=crea('progresbar')
*!* J=0
*!* op.show()
*!* ENDIF
*!* op.PRBAR.VALUE=J
*!* op.p=ROUND(100*op.PRBAR.VALUE/op.PRBAR.MAX,2)
*!* op.REFRESH
*!* J=J+1
*!* RETURN
*!* *_________________________
*!* PROC MESAJT
*!* PARAM M.denumire
*!* OTEXT.oleTreeview.NODES.add(,,,M.denumire,)
*!* STARE=STARE+1
*!* RETURN
*!* *!* ***------------------------------------------------------------------------------------
*!* *!* Procedure lanseaza_excel_standard
*!* *!* Parameters tcalias
*!* *!* Private lcTabelSectii
*!* *!* lcTabelSectii = Alltrim(tcalias)
*!* *!* Select (lcTabelSectii)
*!* *!* lcexcel=Addbs(pccaletempo)+"Fisa de calcul a eficientei"+".XLS"
*!* *!* x=Newobject("XL_Sectie_standard","EXCELX") && alternatively you can drop this class on a VFP form
*!* *!* x.SaveAs=lcexcel && PART.XLS to be created in your TEMP folder
*!* *!* Select centre_profit
*!* *!* Set Filter To
*!* *!* Count For ((!virtual And contribuie) Or SOCIETATE) And ales To lnNrSectii
*!* *!* If !lnNrSectii>0
*!* *!* Return
*!* *!* Endif
*!* *!* Dimension x.oWorkSheet[lnNrSectii] && need four pages
*!* *!* I=0
*!* *!* Select centre_profit
*!* *!* Scan For ((!virtual And contribuie) Or SOCIETATE) And ales
*!* *!* lccentru = Alltrim(centru)
*!* *!* I=I+1
*!* *!* x.oWorkSheet[I] = lccentru
*!* *!* Endscan
*!* *!* x.Go() && remember this calls .populate_pages().
*!* *!* Release x
*!* *!* **************************8
*!* *!* OLEAPP = Getobject("","Excel.Application")
*!* *!* If Type('OLEAPP')!='O'
*!* *!* OLEAPP = Createobject("Excel.Application")
*!* *!* Endif
*!* *!* OLEAPP.WorkBooks.Open(lcexcel)
*!* *!* OLEAPP.Visible=1
*!* *!* Return
*!* *!* Endproc &&lanseaza_excel_standard

1217
Programe/roacont.prg Normal file
View File

File diff suppressed because it is too large Load Diff

6051
Programe/saft_d406.prg Normal file
View File

File diff suppressed because it is too large Load Diff

3
Programe/shutdown.prg Normal file
View File

@@ -0,0 +1,3 @@
IF TYPE("goApp")=="O" AND NOT ISNULL(goApp)
RETURN goApp.OnShutDown()
ENDIF

85
Programe/update_nomenclator.prg Normal file
View File

@@ -0,0 +1,85 @@
*!* 01.04.2009
*!* marius.mutu
*!* xsets, xitems... de pe server in loc din executabil
*!* 27.05.2011
*!* marius.mutu
*!* creare cursor cparteneriemail pentru addressbook la trimitere email din listare cu foxypreviewer
**********************************************************
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+[\COMUN\DATEMENU\]
IF !USED('MILA1')
USE &lcCaleDateMenu.MILA1 IN 0 ALIAS MILA1
ENDIF
*!* 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
*!* 06.06.2007
*!* marius.mutu
CREATE CURSOR dual (dummy c(10))
INSERT INTO dual (dummy) VALUES ("")
lnSucces = xdate() && xdate.prg
IF m.lnSucces > 0
*!* 27.05.2011
lnSucces = update_parteneriemail() && updateserver.prg
*!* 27.05.2011 ^
ENDIF
IF m.lnSucces > 0
llSucces = update_saft_taxtable()
lnSucces = IIF(m.llSucces, 1, -1)
ENDIF
IF m.lnSucces > 0
llSucces = update_saft_mecanisme_plati()
lnSucces = IIF(m.llSucces, 1, -1)
ENDIF
RETURN lnSucces
ENDPROC && update_nomenclator

93
Programe/verificare.prg Normal file
View File

@@ -0,0 +1,93 @@
FUNCTION verif_ser_perm
CLEAR
?PORNIRE()
Function pornire
Set Exact On
Private calewin,calesys,checksum1,checksum2,serinreg,serdisk,file1,file2,valret,serdisktemp
Store '' To calewin,serinreg,serdisk,calesys,serdisktemp,catehd
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)
If (VAL(checksum1) != 58755) Or (VAL(checksum2) != 30476)
valret=.F.
Endif
Endif
If valret
Declare Integer GetSerialNumber In diskSerial.Dll Integer ,String
serdisktemp=Space(40)
catehd=0
For i=0 To 3
GetSerialNumber(i,@serdisktemp)
If (Len(Alltrim(serdisktemp))!=0) And catehd=0
serdisk=Substr(Alltrim(serdisktemp),Len(Alltrim(serdisktemp))-8,8)
serdisk=Upper(serdisk)
catehd=catehd+1
Endif
Endfor
Endif
If valret
gnFileHandle = Fopen(calewin+'\comdir.snr')
nSize = Fseek(gnFileHandle, 0, 2) && Move pointer to EOF
If nSize<8
valret=.F.
Else
= Fseek(gnFileHandle, 0, 0) && Move pointer to BOF
cString = Fread(gnFileHandle,8)
serinreg=DECODARE1(Alltrim(Upper(cString)))
If serdisk!=serinreg
valret=.F.
Endif
Endif
= Fclose(gnFileHandle)
Endif
On Error valret=.F.
Return valret
*************
FUNCTION decodare1
PARAMETERS lstring
LOCAL lens,poz1,poz2,lret,lcstring,val1
lret=''
lcstring=ALLTRIM(UPPER(lstring))
lens=LEN(lcstring)
FOR i=1 TO lens
poz1=SUBSTR(lcstring,i,1)
val1=ASC(poz1)
DO CASE
CASE val1>=48 AND val1<=57
poz2=CHR(val1+33)&& din 0-9 in Q-Z
CASE val1>=81 AND val1<=90
poz2=CHR(val1-33)&& din Q-Z in 0-9
CASE val1>=65 AND val1<=72
poz2=CHR(val1+8)&&din K-R in S-Z
CASE val1>=73 AND val1<=80
poz2=CHR(val1-8)&&din S-Z in K-R
ENDCASE
lret=lret+poz2
endfor
RETURN lret