sync SVN r18102

This commit is contained in:
2026-09-11 19:06:57 +03:00
parent 661a3cad22
commit 6d339c932e
4 changed files with 171 additions and 8 deletions

View File

@@ -9482,6 +9482,7 @@ DEFINE CLASS frm_import_efactura AS _frmbase OF "_frm_base.vcx"
*p: cconddif
*p: ccondlipsa
*p: cfiltrubaza
*p: ldoargestiune
*p: llotactiv
*p: lprimite
*p: nforecolorpartener
@@ -9504,6 +9505,7 @@ DEFINE CLASS frm_import_efactura AS _frmbase OF "_frm_base.vcx"
DoCreate = .T.
FontBold = .F.
Height = 600
ldoargestiune = .F.
llotactiv = .F.
lprimite = .T.
Name = "frm_import_efactura"
@@ -12034,7 +12036,7 @@ DEFINE CLASS frm_import_efactura AS _frmbase OF "_frm_base.vcx"
ENDPROC
PROCEDURE actualizeazarandimportat
* reciteste jtotctva/diferenta din Registrul TVA pentru factura, fara sa mute pozitia curenta din crsFacturi
* reciteste jtotctva/diferenta din Registrul TVA si lasa crsFacturi pozitionat pe factura importata
LPARAMETERS tnIdEfactura
LOCAL lcView, lcSql, llSucces, lnSelect
PRIVATE pnIdEfactura
@@ -12045,6 +12047,10 @@ DEFINE CLASS frm_import_efactura AS _frmbase OF "_frm_base.vcx"
RETURN .F.
ENDIF
SELECT crsFacturi
* scrierea documentului lasa cursorul pe alt rand (Update-SQL pe crsFacturi), deci il repozitionez pe factura
IF Nvl(crsFacturi.id,0) <> m.pnIdEfactura
LOCATE FOR Nvl(id,0) = m.pnIdEfactura
ENDIF
IF Nvl(crsFacturi.id,0) <> m.pnIdEfactura
SELECT (m.lnSelect)
RETURN .F.
@@ -13014,7 +13020,8 @@ DEFINE CLASS frm_import_efactura AS _frmbase OF "_frm_base.vcx"
* tnOptiuneCoada: 1=Import contabilitate, 2=Import gestiune, trimis de coada ca sa nu mai intrebe
LPARAMETERS tnOptiuneCoada
LOCAL lnIdEFactura, llSucces
Local lcCont, lcFacturi_dublate, lcMesajFact_dubl, lcSerieAct, lnIdPart, lnNrAct, lnOptiune
Local lcCont, lcFacturi_dublate, lcMesajFact_dubl, lcSerieAct, lnGestImplicita, lnIdPart
Local lnNrAct, lnOptiune, loCoadaGest
lnIdEFactura = Nvl(crsFacturi.Id, 0)
@@ -13056,10 +13063,22 @@ DEFINE CLASS frm_import_efactura AS _frmbase OF "_frm_base.vcx"
RETURN
ENDIF
ENDIF
IF Vartype(m.tnOptiuneCoada) = 'N' And !Empty(m.tnOptiuneCoada)
lnOptiune = m.tnOptiuneCoada
* in aplicatia de gestiune ruta contabila nu e disponibila, deci nu se mai alege
IF Thisform.lDoarGestiune
lnOptiune = 2
IF Vartype(m.tnOptiuneCoada) <> 'N'
lnGestImplicita = IIF(Thisform.lPrimite, m.gnEFACTURA_ID_GESTIUNE_P, m.gnEFACTURA_ID_GESTIUNE_E)
loCoadaGest = Createobject('CoadaContabilizareEF')
IF loCoadaGest.NrRanduriGestiune('crsDetaliiFacturi', m.lnGestImplicita) = 0
AMESSAGEBOX('Nu exista articole gestionabile', 0+64, _screen.Caption)
ENDIF
ENDIF
ELSE
lnOptiune = xmenu('Import contabilitate;Import gestiune')
IF Vartype(m.tnOptiuneCoada) = 'N' And !Empty(m.tnOptiuneCoada)
lnOptiune = m.tnOptiuneCoada
ELSE
lnOptiune = xmenu('Import contabilitate;Import gestiune')
ENDIF
ENDIF
IF EMPTY(m.lnOptiune)
RETURN
@@ -14342,12 +14361,13 @@ DEFINE CLASS frm_import_efactura AS _frmbase OF "_frm_base.vcx"
ENDPROC
PROCEDURE Init
Lparameters tlPrimite
Lparameters tlPrimite, tlDoarGestiune
Local lcFdoc, lcSql, llSucces, lnIdFdoc
Local lcValLot, loCoada
This.lPrimite = m.tlPrimite
This.lDoarGestiune = (Vartype(m.tlDoarGestiune) = [L] And m.tlDoarGestiune)
This.nForeColorPartener = This.txtPartener.ForeColor
* Fel document

View File

@@ -295,6 +295,28 @@ DEFINE CLASS CoadaContabilizareEF AS Custom
RETURN IIF(m.lnGestionabile > 0, 2, 1)
ENDPROC
*!* Cate randuri ajung efectiv in rulaje: articol ROA, gestiune (proprie sau implicita) si cont completate
PROCEDURE NrRanduriGestiune
LPARAMETERS tcAliasDetalii, tnGestiuneImplicita
LOCAL lcSelect, llGestImplicita, lnRanduri, lnRecno
lcSelect = SELECT()
lnRanduri = 0
llGestImplicita = !EMPTY(NVL(m.tnGestiuneImplicita, 0))
SELECT (m.tcAliasDetalii)
lnRecno = RECNO()
COUNT FOR NVL(in_stoc, 0) = 1 AND !EMPTY(NVL(id_articol, 0)) AND ;
(m.llGestImplicita OR !EMPTY(NVL(id_gestiune, 0))) AND ;
!EMPTY(ALLTRIM(NVL(cont, ''))) TO lnRanduri
TRY
GO m.lnRecno
CATCH
GO TOP
ENDTRY
SELECT (m.lcSelect)
RETURN m.lnRanduri
ENDPROC
*!* Textul antetului permanent afisat cat ruleaza coada
PROCEDURE AntetProgres
LPARAMETERS tnCurent, tnTotal, tcFurnizor, tcNrAct, tnSuma

View File

@@ -18,8 +18,9 @@ PROCEDURE importEfacturaTrimise
ENDPROC
PROCEDURE vizImportEFactura
LPARAMETERS tcTip
LPARAMETERS tcTip, tlDoarGestiune
* tcTIP: PRIMITE/TRIMISE
* tlDoarGestiune: import doar in gestiune, fara alegerea rutei (apel din aplicatia de gestiune)
Private poFacturi, poFacturiDetalii
Local loFrmFacturi As "frm_efactura_import", lcTip, llPrimite
@@ -164,7 +165,7 @@ select 0 as distribuie, CAST(0 as number(10)) as id_tip, id_articol, id_gestiune
INDEX on id TAG id
Select crsFacturi
loFrmFacturi = Createobject("frm_import_efactura", m.llPrimite)
loFrmFacturi = Createobject("frm_import_efactura", m.llPrimite, m.tlDoarGestiune)
* Do Form frm_import_efactura Name loFrmFacturi Linked With m.llPrimite Noshow
loFrmFacturi.Show(1)

View File

@@ -0,0 +1,120 @@
* test_ruta_gestiune.prg
* Import eFactura lansat din gestiune (lDoarGestiune):
* T1 - proprietatea lDoarGestiune exista in binarul frm_import_efactura
* T2 - do_executa forteaza ruta 2 si atentioneaza cand nu sunt articole gestionabile
* T3 - CoadaContabilizareEF.NrRanduriGestiune numara doar randurile care ajung in rulaje
* Nu are nevoie de Oracle.
*
* Rulare: vfp9.exe -A -T test_ruta_gestiune.prg
SET SAFETY OFF
SET TALK OFF
SET EXACT ON
PUBLIC lcLog, lnPass, lnFail
LOCAL lcDirTest, lcDirComun, lcProps, lcCod, lnRanduri, lcErrCompil, lcErrRau, lcVcxRau, lcVcxTest
lcDirTest = ADDBS(JUSTPATH(SYS(16)))
lcDirComun = ADDBS(JUSTPATH(JUSTPATH(JUSTPATH(JUSTPATH(SYS(16))))))
lcLog = m.lcDirTest + 'test_ruta_gestiune_log.txt'
lnPass = 0
lnFail = 0
STRTOFILE('START ' + TTOC(DATETIME()) + CHR(13) + CHR(10), m.lcLog)
ON ERROR DO TErr WITH ERROR(), MESSAGE(), PROGRAM(), LINENO()
* T1/T2: citesc direct clasa din binar, ca sa prind si lipsa proprietatii din lista de membri
USE (m.lcDirComun + 'clase\anaf_efactura.vcx') IN 0 SHARED ALIAS cls
SELECT cls
LOCATE FOR UPPER(ALLTRIM(NVL(objname, ''))) == 'FRM_IMPORT_EFACTURA' AND EMPTY(NVL(parent, ''))
lcProps = IIF(FOUND(), LOWER(NVL(properties, '')), '')
lcCod = IIF(FOUND(), LOWER(NVL(methods, '')), '')
USE IN cls
DO TVerdict WITH 'ldoargestiune' $ m.lcProps, 'T1 proprietate in binar', LEFT(m.lcProps, 0)
DO TVerdict WITH 'thisform.ldoargestiune' $ m.lcCod AND 'nrrandurigestiune' $ m.lcCod, ;
'T2 do_executa foloseste ruta de gestiune', ''
* T3: numaratoarea, pe cursor sintetic
SET PROCEDURE TO (m.lcDirComun + 'programe\coada_contabilizare_ef.prg') ADDITIVE
CREATE CURSOR crsTest (in_stoc N(1), id_articol N(10), id_gestiune N(10), cont C(4))
INSERT INTO crsTest VALUES (1, 100, 5, '371')
INSERT INTO crsTest VALUES (1, 101, 0, '371')
INSERT INTO crsTest VALUES (1, 102, 5, '')
INSERT INTO crsTest VALUES (1, 0, 5, '371')
INSERT INTO crsTest VALUES (0, 103, 5, '371')
loCoada = CREATEOBJECT('CoadaContabilizareEF')
lnRanduri = loCoada.NrRanduriGestiune('crsTest', 0)
DO TVerdict WITH m.lnRanduri = 1, 'T3a fara gestiune implicita', TRANSFORM(m.lnRanduri)
lnRanduri = loCoada.NrRanduriGestiune('crsTest', 7)
DO TVerdict WITH m.lnRanduri = 2, 'T3b cu gestiune implicita', TRANSFORM(m.lnRanduri)
CREATE CURSOR crsFaraGest (in_stoc N(1), id_articol N(10), id_gestiune N(10), cont C(4))
INSERT INTO crsFaraGest VALUES (0, 103, 5, '371')
INSERT INTO crsFaraGest VALUES (1, 0, 5, '371')
lnRanduri = loCoada.NrRanduriGestiune('crsFaraGest', 7)
DO TVerdict WITH m.lnRanduri = 0, 'T3c factura fara articole gestionabile', TRANSFORM(m.lnRanduri)
* T4: compilarea clasei, ca sa prinda erorile de sintaxa din metodele scrise in text
lcVcxTest = m.lcDirTest + 'anaf_efactura_compil.vcx'
IF FILE(m.lcVcxTest)
ERASE (m.lcVcxTest)
ERASE (m.lcDirTest + 'anaf_efactura_compil.vct')
ENDIF
IF FILE(m.lcDirTest + 'anaf_efactura_compil.err')
ERASE (m.lcDirTest + 'anaf_efactura_compil.err')
ENDIF
COPY FILE (m.lcDirComun + 'clase\anaf_efactura.vcx') TO (m.lcVcxTest)
COPY FILE (m.lcDirComun + 'clase\anaf_efactura.vct') TO (m.lcDirTest + 'anaf_efactura_compil.vct')
COMPILE CLASSLIB (m.lcVcxTest)
lcErrCompil = IIF(FILE(m.lcDirTest + 'anaf_efactura_compil.err'), FILETOSTR(m.lcDirTest + 'anaf_efactura_compil.err'), '')
DO TVerdict WITH EMPTY(ALLTRIM(m.lcErrCompil)), 'T4 clasa compileaza fara erori', LEFT(STRTRAN(STRTRAN(m.lcErrCompil, CHR(13), ' '), CHR(10), ' '), 150)
ERASE (m.lcVcxTest)
ERASE (m.lcDirTest + 'anaf_efactura_compil.vct')
IF FILE(m.lcDirTest + 'anaf_efactura_compil.err')
ERASE (m.lcDirTest + 'anaf_efactura_compil.err')
ENDIF
* T5: proba ca T4 chiar prinde o eroare - aceeasi compilare pe o copie stricata intentionat
lcVcxRau = m.lcDirTest + 'anaf_efactura_rau.vcx'
IF FILE(m.lcVcxRau)
ERASE (m.lcVcxRau)
ERASE (m.lcDirTest + 'anaf_efactura_rau.vct')
ENDIF
IF FILE(m.lcDirTest + 'anaf_efactura_rau.err')
ERASE (m.lcDirTest + 'anaf_efactura_rau.err')
ENDIF
COPY FILE (m.lcDirComun + 'clase\anaf_efactura.vcx') TO (m.lcVcxRau)
COPY FILE (m.lcDirComun + 'clase\anaf_efactura.vct') TO (m.lcDirTest + 'anaf_efactura_rau.vct')
USE (m.lcVcxRau) IN 0 EXCLUSIVE ALIAS clsRau
SELECT clsRau
LOCATE FOR UPPER(ALLTRIM(NVL(objname, ''))) == 'FRM_IMPORT_EFACTURA' AND EMPTY(NVL(parent, ''))
REPLACE methods WITH ALLTRIM(NVL(methods, '')) + CHR(13) + CHR(10) + 'PROCEDURE proba_rea' + CHR(13) + CHR(10) + 'IF Createobject("Custom").NuExista() = 0' + CHR(13) + CHR(10) + 'ENDIF' + CHR(13) + CHR(10) + 'ENDPROC' + CHR(13) + CHR(10)
USE IN clsRau
COMPILE CLASSLIB (m.lcVcxRau)
lcErrRau = IIF(FILE(m.lcDirTest + 'anaf_efactura_rau.err'), FILETOSTR(m.lcDirTest + 'anaf_efactura_rau.err'), '')
DO TVerdict WITH !EMPTY(ALLTRIM(m.lcErrRau)), 'T5 compilarea semnaleaza sintaxa gresita', LEFT(STRTRAN(STRTRAN(m.lcErrRau, CHR(13), ' '), CHR(10), ' '), 100)
ERASE (m.lcVcxRau)
ERASE (m.lcDirTest + 'anaf_efactura_rau.vct')
IF FILE(m.lcDirTest + 'anaf_efactura_rau.err')
ERASE (m.lcDirTest + 'anaf_efactura_rau.err')
ENDIF
STRTOFILE('REZULTAT pass=' + TRANSFORM(m.lnPass) + ' fail=' + TRANSFORM(m.lnFail) + CHR(13) + CHR(10), m.lcLog, 1)
QUIT
PROCEDURE TVerdict
LPARAMETERS tlOk, tcNume, tcDetaliu
IF m.tlOk
lnPass = m.lnPass + 1
ELSE
lnFail = m.lnFail + 1
ENDIF
STRTOFILE(IIF(m.tlOk, 'PASS ', 'FAIL ') + m.tcNume + IIF(EMPTY(m.tcDetaliu), '', ' [' + m.tcDetaliu + ']') + CHR(13) + CHR(10), m.lcLog, 1)
ENDPROC
PROCEDURE TErr
LPARAMETERS tnErr, tcMsg, tcProg, tnLine
STRTOFILE('EROARE ' + TRANSFORM(m.tnErr) + ' ' + m.tcMsg + ' in ' + m.tcProg + ' linia ' + TRANSFORM(m.tnLine) + CHR(13) + CHR(10), lcLog, 1)
QUIT
ENDPROC