*!* 07.09.2009
*!* marius.mutu
*!* ROA.H

*!* 04.08.2011
*!* marius.mutu
*!* adaugare functia GetDataIreg

*!* 01.04.2013
*!* marius.mutu
*!* GET_SCHEMA_GRID - trateaza cazul 0.00

*!*	05.10.2016
*!*	marius.mutu
*!*	Get_Ora - se intoarce dataora de pe server sau de pe calculatorul local in functie de settings.ini [general]tipdataora=server/local/nimic

*!* 10.01.2018
*!* marius.mutu
*!* VerificaCodFiscal: completare verificare ANAF cu stare TVA Incasare, Split TVA, Inactiv

*!* 11.07.2018
*!* marius.mutu
*!* + GetSemnatura - INTOCMIT/VERIFICAT/DIRECTOR/DIRECTOR ECONOMIC - listare balanta, registre tva, fisa cont, reg. jurnal

*!* 03.10.2019
*!* marius.mutu
*!* + Atasament2File

*!* 10.01.2019
*!* marius.mutu
*!*	+ VerificaFacturaClientiVanzari

*!*	23.01.2020
*!*	marius.mutu
*!*	File2Atasament - Citeste fisierul de pe disk si adauga atasament in baza de date atas_atasamente

*!* 13.11.2020
*!* +xdir((): Get Files in Directory (including subdirectories) 
*!* +UpdatePageTotalGroup(): Functie pentru calculul _PAGETOTAL pentru grupuri care reseteaza pagina la 1 intr-un raport

*!*	09.12.2020
*!*	Atasament2File
*!*	Suprascriu fisierul din baza de date cu fisierul de pe disk doar daca dataora din baza de date > data fisierului de pe disk

*!* 03.02.2021
*!* xdir - declarat variabile locale 
*!* la apelarea recursiva ramanea ultimul director parcurs, in loc sa se revina la directorul din iteratia corespunzatoare

*!*	15.01.2024
*!*	GetSemnatura - + parametru prefix

*!* 03.09.2024
*!*	ProcentTva2IdJtva - tratare procent TVA 0 si taxare inversa (eFactura)

*!*	05.12.2024
*!*	GetArticolEFByPartDenumire - caut si articolele fara id_articol, in caz ca sunt servicii, nu articole gestionabile ROA

*!*	15.01.2025
*!*	GetDocumentByContPartenerAct - se cauta comanda si in IREG_PARTENERI.EXPLICATIA

*!*	17.07.2025
*!*	ProcentTva2IdJtva - cote TVA 21% si 11%

*!*	22.07.2025
*!*	GetNamePermutations - limitare la 4 cuvinte si maxim 10 permutari

*!*	31.07.2026
*!*	marius.mutu
*!*	verifica_partener_show_info: marcaj de provenienta (cache ANAF) langa denumirea firmei, cand disponibil

#Include COMUN\ROA.H
 
Define Class oexecutor As Custom
	nHandle = 0
	cSql = ''
	cCursor = ''
	nSucces = 0
	cEroare = ''
	nEroare = 0
	cTime = ''
	lReconnect = .T. && cred ca trebuie setat pe .F. inainte de o serie de proceduri executate cu tranzactie manuala
	lShowError = .F.
	lQuitOnError = .F.

	Declare aEroare[1]


	* PROCEDURE INIT( tnHandle, tcSql, tcCursor  )
	* Date : 06/10/2004, 12:18:21
	* author : marius.mutu
	* description:

	****** PARAMETER BLOCK **************
	* Parameters : 3
	* Parameter 1:
	* Parameter 2:
	* Parameter 3:
	*
	******************************************* INCEPUT:INIT *******************************************
	Procedure Init
		Lparameters tnHandle, tcSql, tcCursor


		If Empty(tnHandle)
			This.nHandle = gnHandle
		Else
			This.nHandle = tnHandle
		Endif

	Endproc
	******************************************* SFARSIT: INIT *******************************************

	*---------------------------------------
	* Intoarce .T. daca goConn.nHandle > 0
	*---------------------------------------
	FUNCTION IsConnected
		RETURN goConn.IsConnected()
	ENDFUNC && IsConnected

	******************************************* INCEPUT:oExecuta *******************************************
	Function oExecuta ( tcSql, tcCursor, tlProgress, tcTitluProgress, tnHandle, tlShowError, tlQuitOnError, tlReconnect )
		Local lnSucces, llOk
		llOk = .T.

		*!*	modificare	06.09.2012
		*!*		lnSucces = This.oExecute(tcSql, tcCursor, tlProgress, tcTitluProgress, tnHandle, tlShowError, tlQuitOnError, tlReconnect)
		Do Case
			Case Pcount() < 6
				lnSucces = This.oExecute(Iif(Empty(tcSql), This.cSql, tcSql), ;
					  Iif(Empty(tcCursor), This.cCursor, tcCursor), ;
					  tlProgress, tcTitluProgress, ;
					  Iif(Empty(tnHandle), This.nHandle, tnHandle))
			Case Pcount() < 7
				lnSucces = This.oExecute(Iif(Empty(tcSql), This.cSql, tcSql), ;
					  Iif(Empty(tcCursor), This.cCursor, tcCursor), ;
					  tlProgress, tcTitluProgress, ;
					  Iif(Empty(tnHandle), This.nHandle, tnHandle), ;
					  tlShowError)
			Case Pcount() < 8
				lnSucces = This.oExecute(Iif(Empty(tcSql), This.cSql, tcSql), ;
					  Iif(Empty(tcCursor), This.cCursor, tcCursor), ;
					  tlProgress, tcTitluProgress, ;
					  Iif(Empty(tnHandle), This.nHandle, tnHandle), ;
					  tlShowError, tlQuitOnError)
			Otherwise
				lnSucces = This.oExecute(Iif(Empty(tcSql), This.cSql, tcSql), ;
					  Iif(Empty(tcCursor), This.cCursor, tcCursor), ;
					  tlProgress, tcTitluProgress, ;
					  Iif(Empty(tnHandle), This.nHandle, tnHandle), ;
					  tlShowError, tlQuitOnError, tlReconnect)
		Endcase
		*!*	modificare	06.09.2012	^
		If lnSucces < 0
			amessagebox(This.oPrelucrareEroare(), 16, "Eroare")
			llOk = .F.
		Endif
		Return llOk
	Endfunc
	******************************************* SFARSIT:oExecuta *******************************************	

	* PROCEDURE oExecute( tcSql, tcCursor,tlProgress, tnHandle )
	* Date : 06/10/2004, 12:16:11
	* author : marius.mutu
	* description:

	****** PARAMETER BLOCK **************
	* Parameters : 3
	* Parameter 1:
	* Parameter 2:
	* Parameter 3:
	*
	******************************************* INCEPUT:oExecute *******************************************
	Procedure oExecute( tcSql, tcCursor, tlProgress, tcTitluProgress, tnHandle, tlShowError, tlQuitOnError, tlReconnect )
		Local lnHandle, lcSql, lcCursor, llProgress, lnSucces, laEroare, lcEroare, llShowError, llQuitOnError, llReconnect

		&& orice modificare aici trebuie facuta si in oExecuta
		&& tlQuitOnError : Daca face QUIT la eroare (daca vreau QUIT dau .T.) (default .F.)
		&& tlShowError : Daca arata mesajul de eroare (daca vreau sa il tratez in oexecute dau .T.) (default .F.)
		&& tlReconnect : Daca incearca sa se reconecteze (default .T.)
		Local lcSeconds
		lcSeconds = Set("Seconds")
		Set Seconds On

		If .F.
			Local This As oexecutor
		Endif
		This.Oreset()

		If Type('goLog') = 'O'
			goLog.Log(tcSql, Program())
		Endif

		Local lnTip
		lnTip = 0

		*!* 29.06.2007
		*!* marius.mutu
		*!* nu puneti upper(lcSql) - exista unele expresii in oracle care sunt case sensitive
		If Empty(tcSql)
			lcSql = This.cSql
		Else
			lcSql = tcSql
		Endif

		If Empty(tcCursor)
			lcCursor = This.cCursor
		Else
			lcCursor = tcCursor
		Endif

		If Empty(tnHandle)
			lnHandle = This.nHandle
		Else
			lnHandle = tnHandle
		Endif

		IF (m.lnHandle <= 0)
			This.nSucces = CT_INSUCCES
			This.cEroare = 'Neconectat'
			RETURN CT_INSUCCES
		ENDIF 
		
		&& DACA AM TRANZACTIE MANUALA NU FAC RECONNECT
		If SQLGetprop(lnHandle, "Transactions") = 2 && TRANZACTIE MANUALA
			This.lReconnect = .F.
		Else
			This.lReconnect = .T.
		Endif

		Do Case
			Case Pcount() < 6
				llQuitOnError = This.lQuitOnError
				llReconnect = This.lReconnect
				llShowError = This.lShowError
			Case Pcount() < 7
				llQuitOnError = This.lQuitOnError
				llReconnect = This.lReconnect
				*!*	modificare	06.09.2012
			Case Pcount() < 8
				llReconnect = This.lReconnect
				*!*	modificare	06.09.2012	^
			Otherwise
				llShowError = tlShowError
				llReconnect = tlReconnect
				llQuitOnError = tlQuitOnError
		Endcase

		lnSucces = This.nSucces

		llProgress = tlProgress && IIF(tlProgress or 'SELECT'$lcSql,.T.,.F.)
		lcTitluProgress = Iif(Empty(tcTitluProgress), "", Alltrim(tcTitluProgress))

		Declare laEroare[1]
		lcEroare = ''


		lnTip = Iif('ROLLBACK' $ lcSql Or 'COMMIT' $ lcSql, 1, 0) && daca ROLLBACK SAU COMMIT TIP = 1, ALTFEL 0

		Do Case
			Case lnTip = 0
				*!*					If llProgress
				*!*						Local loTherm, lcTask, lnPercent, lnSeconds
				*!*						If !Empty(lcTitluProgress)
				*!*							lcTask =  lcTitluProgress
				*!*						Else
				*!*							lcTask = "Se executa ... "
				*!*						Endif
				*!*						loTherm = Newobject("_thermometer","_therm","",lcTask)

				*!*						lnPercent = 15


				*!*						loTherm.Show()
				*!*					Endif

				*!*					Do While .T.

				*!*						If llProgress
				*!*							lnPercent = lnPercent + 5
				*!*							If lnPercent > 90
				*!*								lnPercent = 15
				*!*							Endif

				*!*							loTherm.Update(lnPercent, lcTask+" "+Trans(lnPercent))
				*!*						Endif


				*!*						lnSucces = SQLExec(lnHandle,lcSql,lcCursor)
				*!*						If lnSucces = 0
				*!*	*
				*!*						Else
				*!*							Exit
				*!*						Endif
				*!*					Enddo

				*!*					If llProgress
				*!*						loTherm.Complete()
				*!*						Release loTherm
				*!*					Endif

				If llProgress
					Local loTherm, lcTask, lnPercent, lnSeconds
					If !Empty(lcTitluProgress)
						lcTask =  lcTitluProgress
					Else
						lcTask = "Se executa ... "
					Endif
					loTherm = Newobject("_thermometer", "_therm", "", lcTask)

					lnPercent = 15


					loTherm.Show()
				Endif

				lnSucces = -1
				Do While .T.
					Do While .T.

						If llProgress
							lnPercent = lnPercent + 5
							If lnPercent > 90
								lnPercent = 15
							Endif

							loTherm.Update(lnPercent, lcTask + " " + Trans(lnPercent))
						Endif


						lnSucces = SQLExec(lnHandle, lcSql, lcCursor)
						If lnSucces = 0
							*
						Else
							Exit
						Endif
					Enddo

					If lnSucces > 0
						If Used(lcCursor)
							lcTempCursor =  Sys(2015)
							Use Dbf(lcCursor) In 0 Again Shared Alias (lcTempCursor)
							Use In (lcCursor)
							Use Dbf(lcTempCursor) In 0 Again Alias (lcCursor)
							Use In (lcTempCursor)
						Endif
						Exit
					Endif

					If lnSucces < 0
						Release laEroare
						Declare laEroare(1)
						lnEroare1 = 0
						lnEroare2 = 0
						lcTextEroare = []
						lnHandle = 0
						llEroare = .F.

						Aerror(laEroare)
						If Alen(laEroare) > 1
							lnEroare1 = laEroare[1]
							lnEroare2 = laEroare[5]
							lcTextEroare = laEroare[3]
							lnHandle = laEroare[6]
							llEroare = .T.

						Endif


						Do Case
							Case lnEroare1 <> 1526 && eroare <> ODBC
								lcTextEroare = Program() + Chr(13) + Alltrim(Str(lnEroare1)) + ' ' + laEroare[2] + crlf + crlf + GETCALLSTACK()
								If Type('goLog') = 'O'
									goLog.Log(lcTextEroare, Program())
								Endif
								If llShowError
									amessagebox(lcTextEroare, 0, "Eroare")
								Endif
								If llQuitOnError
									Quit
									Retry
								Else
									Exit
								Endif

							Case lnEroare1 = 1526 && eroare ODBC
								Do Case
									Case llReconnect And Inlist(lnEroare2, 12152, 3113, 3114, 12560, 4068, 28, 12) && 12512 = TNS: UNABLE TO SEND BREAK MESSAGE; 3114 = NOT CONNECTED TO ORACLE; 12560 = PROTOCOL ADAPTER ERROR
										If Type('goLog') = 'O'
											lcLog = laEroare(3)  + crlf + crlf + GETCALLSTACK()
											goLog.Log(lcLog, Program())
										Endif

										Do While .T.
											lnRaspuns = amessagebox('Eroare de conectare.' + Chr(13) + lcTextEroare + Chr(13) + 'Doriti reconectare?', 4 + 32, 'Eroare') && retry = 4; cancel = 2
											If lnRaspuns = 6

												lnHandle = goConn.Connect(goConn.cHost, goConn.cUser, goConn.cPassword, llReconnect)

												*!*									gnHandle = SQLConnect(gcHost,gcUserName,gcPassword)

												If lnHandle < 0
													Declare laEroare2(1)
													Aerror(laEroare2)
													lcTextEroare = laEroare2(3)
													If Type('goLog') = 'O'
														goLog.Log(lcTextEroare, Program())
													Endif

													Release laEroare2
													Loop
												Else
													*!*										goExecutor.nHandle = gnHandle
													Exit
												Endif
											Else
												Quit
												Retry
											Endif && lnRaspuns = 6
										Enddo && .T.
										Loop && daca am iesit cu un handle valid intru din nou in loop si fac cursorfill
									Otherwise
										lcTextEroare = Program() + crlf + Alltrim(Str(lnEroare1)) + ' ' + crlf + Transform(laEroare[3]) + crlf + lcSql + crlf + crlf + GETCALLSTACK()
										If llShowError
											lnRaspuns = amessagebox('Eroare necunoscuta' + Chr(13) + lcTextEroare, 0, 'Eroare') && ok = 0
										Endif
										If Type('goLog') = 'O'
											goLog.Log(lcTextEroare, Program())
										Endif
										If llQuitOnError
											Quit
											Retry
										Else
											Exit
										Endif
								Endcase && INLIST(lnEroare2,12152,3114)
						Endcase
					Endif && lnSucces < 0

				Enddo && .T.

				If llProgress
					loTherm.Complete()
					Release loTherm
				Endif

			Case lnTip = 1
				If 'ROLLBACK' $ lcSql
					lnSucces = Sqlrollback(lnHandle)
				Else
					lnSucces = Sqlcommit(lnHandle)
				Endif
		Endcase

		If lnSucces < 0
			Aerror(laEroare)

			If laEroare[1] <> 1526
				lcEroare = laEroare[2]
			Else
				lcEroare = Alltrim(Transform(laEroare[1])) + crlf +  + Alltrim(Transform(laEroare[3])) + crlf + lcSql + crlf + crlf + GETCALLSTACK()
				*!* 07.02.2008
				This.cEroare = lcEroare
				lcEroare = This.oPrelucrareEroare()
				*!* 07.02.2008 ^
			Endif

			If Type('goMyXMLHTTP') = 'O'
				lcLunaHTTP = Iif(Type('gnLuna') = 'N', Transform(gnLuna) + "/", "") + Iif(Type('GNAN') = 'N', Transform(gnAn), "")
				lcErrorHTTP =  Sys(0) + ":" + Iif(Type('GCS') = 'C', " " + GCS, "") + ": " + lcLunaHTTP + Chr(13) + Chr(10) + lcEroare + ;
					Chr(13) + Chr(10) + Chr(13) + Chr(10) + GETCALLSTACK()

				lcUserName = gcUserNameApp
				lcProgram = Juststem(Sys(16, 0))
				goMyXMLHTTP.postError(lcErrorHTTP, lcUserName, lcProgram)
			Endif

			If llShowError
				amessagebox(lcEroare, 0, "Eroare")
			Endif
			If llQuitOnError
				Quit
				Retry
			Endif

		Endif



		This.aEroare = laEroare
		This.nSucces = lnSucces
		This.cEroare = lcEroare
		This.nEroare = Iif(Alen(laEroare) >= 5, laEroare[5], 0)

		Set Seconds &lcSeconds

		*!*	modificare	ROAFACTURARE v 2.0.77
		*!*	*!* 07.09.2009
		*!*	*!*		RETURN lnSucces
		*!*		Return IIF(lnSucces = 1, CT_SUCCES, CT_INSUCCES)
		Return Iif(lnSucces >= 1, CT_SUCCES, CT_INSUCCES)
		*!*	*!* 07.09.2009 ^
		*!*	modificare	ROAFACTURARE v 2.0.77	^
	Endproc
	******************************************* SFARSIT: oExecute *******************************************

	*!* salveaza rezultatul unei functii in variabila data ca referinta
	*!* intoarce SUCCES = (1,-1)
	*!* lnSucces = oFunction2Value("MyFunction(MyParam1, MyParam2)", @pnReturnValue)
	Function oFunction2Value
		Lparameters tcFunction, tuRetValue

		lcSql = "select " + tcFunction + " as retvalue from dual"
		lcCursor = Sys(2015)
		lcField = lcCursor + ".retvalue"

		lnSucces = This.oExecute(lcSql, lcCursor)

		If lnSucces > 0
			tuRetValue = Evaluate(lcField)
			If Used(lcCursor)
				Use In (lcCursor)
			Endif
		Endif

		*!* 07.09.2009
		*!*		RETURN lnSucces
		Return Iif(lnSucces = 1, CT_SUCCES, CT_INSUCCES)
		*!* 07.09.2009 ^

	Endfunc && oFunction2Value
	******************************************* SFARSIT: oFunction2Value *******************************************

	*!* salveaza rezultatul unui select in variabila data ca referinta
	*!* daca se intorc mai multe randuri - eroare
	*!* intoarce SUCCES = .T./.F.
	*!* afiseaza mesajul de eroare, daca este cazul
	*!* lnSucces = oSelecteaza2Value("Select sum(cantitate) from tabel where conditie", @pnReturnValue)
	Function oSelecteaza2Value
		Lparameters tcSql, tuRetValue
		* tlShowError, daca afiseaza mesaje de eroare
		Local lnSucces
		lnSucces = This.oSelect2Value(m.tcSql, @m.tuRetValue)

		If m.lnSucces = CT_INSUCCES
			amessagebox(This.oPrelucrareEroare(), 16, "Eroare")
		Endif

		Return (m.lnSucces = CT_SUCCES)

	Endfunc &&oSelect2Value
	******************************************* SFARSIT: oFunction2Value *******************************************

	*!* salveaza rezultatul unui select in variabila data ca referinta
	*!* daca se intorc mai multe randuri - eroare
	*!* intoarce SUCCES = (1,-1)
	*!* lnSucces = oSelect2Value("Select sum(cantitate) from tabel where conditie", @pnReturnValue)
	Function oSelect2Value
		Lparameters tcSql, tuRetValue

		Local lcSelect, lcSql, lcCursor, lcField, lnSucces

		lcSelect = Select()
		lcSql = tcSql
		lcCursor = Sys(2015)

		lnSucces = This.oExecute(lcSql, lcCursor)

		If lnSucces > 0
			If Reccount(lcCursor) > 1
				This.nSucces = -1
				This.cEroare = 'Au rezultat mai multe valori. Se astepta o singura valoare.'
				lnSucces = -1
			Else
				lcField = lcCursor + '.' + Field(1)
				tuRetValue = Evaluate(lcField)
			Endif
			If Used(lcCursor)
				Use In (lcCursor)
			Endif
		Endif

		Select (lcSelect)

		*!* 07.09.2009
		*!*		RETURN lnSucces
		Return Iif(lnSucces = 1, CT_SUCCES, CT_INSUCCES)
		*!* 07.09.2009 ^

	Endfunc &&oSelect2Value
	******************************************* SFARSIT: oFunction2Value *******************************************


	*!* salveaza rezultatul unui select in variabila data ca referinta
	*!* daca se intorc mai multe randuri - eroare
	*!* intoarce SUCCES = T/F
	*!* llSucces = goExecutor.oSelecteaza2Object("Select id, denumire from tabel where conditie", @poObject)
	Function oSelecteaza2Object
		Lparameters tcSql, toRetValue

		Local lcSelect, lcSql, lcCursor, lcField, llSucces
		lcSelect = Select()
		lcSql = tcSql
		lcCursor = Sys(2015)

		llSucces = This.oExecuta(lcSql, lcCursor)

		If m.llSucces
			If Reccount(m.lcCursor) > 1
				This.nSucces = -1
				This.cEroare = 'Au rezultat mai multe valori. Se astepta o singura valoare.'
				llSucces = .F.
			Else
				Select (m.lcCursor)
				Scatter Name toRetValue Memo
			Endif
			Use In (Select(m.lcCursor))
		Endif && llSucces

		Select (m.lcSelect)
		Return m.llSucces
	Endfunc &&oSelecteaza2Object
	******************************************* SFARSIT: oSelecteaza2Object *******************************************

	******************************************* INCEPUT: oPrelucrareEroare *******************************************
	&&	Prelucreaza mesajul de eroare : daca este intre ORA-20000 si ORA-20999 atunci afiseaza doar textul erorii
	Function oPrelucrareEroare
		Local lcTextEroare
		lcTextEroare = This.cEroare

		If Like('*ORA-20???:*', lcTextEroare)
			lnPozi = At("ORA-20", lcTextEroare) + 11
			lnPozf = At("ORA", lcTextEroare, 2)
			lcTextEroare = Substr(lcTextEroare, lnPozi, lnPozf - lnPozi)
			*!*					ELSE
			*!*						lnPozf=At("ORA-",lcTextEroare,3)
			*!*						lcTextEroare=Substr(lcTextEroare,1,lnPozf-1)+[...]
		Endif
		Return lcTextEroare
	Endfunc	&&	oPrelucrareEroare
	******************************************* SFARSIT: oPrelucrareEroare *******************************************
	* PROCEDURE oReset(  )
	* Date : 06/10/2004, 12:21:06
	* author : marius.mutu
	* description:

	****** PARAMETER BLOCK **************
	* Parameters : 0
	*
	******************************************* INCEPUT:oReset *******************************************
	Procedure Oreset(  )
		With This
			.aEroare = .F.
			.nSucces = 0
			.cSql = ''
			.cCursor = ''
		Endwith
	Endproc
	******************************************* SFARSIT: oReset *******************************************

Enddefine && oExecutor




*** oConn ===========================================================================================
Define Class oConn As Custom

	cHost = ''
	cUser = ''
	cPassword = ''
	nHandle = 0
	cEroare = ''
	Declare aEroare[7]
	lShowError = .F.
	lReconnect = .F. && Daca llReconnect = .T. se apeleaza InitSesiune din oInit_Optiuni.prg

	FUNCTION IsConnected
		RETURN (This.nHandle > 0)
	ENDFUNC && IsConnected

	*** Connect ===========================================================================================
	Procedure Connect
		Lparameters tcHost, tcUser, tcPassword, tlReconnect

		*!* tlReconnect = .T. daca se apeleaza connect la reconectare (atunci se apeleaza si  InitSesiune())
		Local lnSucces, laEroare, lcString, lcHost, lcUser, lcPassword, lcSql

		If Pcount() < 3 Or Type('tcHost') # 'C' Or Type('tcUser') # 'C' Or Type('tcPassword') # 'C'
			*
		Else
			This.cHost = tcHost
			This.cUser = tcUser
			This.cPassword = tcPassword
		Endif

		lcHost = This.cHost
		lcUser = This.cUser
		lcPassword = This.cPassword

		If Pcount() < 4 Or Type('tlReconnect') # 'L'
			llReconnect = This.lReconnect
		Else
			llReconnect = tlReconnect
		Endif

		SQLSetprop(0, "DispLogin", 3)
		lcString = "dsn=" + Alltrim(lcHost) + ";Uid=" + Alltrim(lcUser) + ";Pwd=" + Alltrim(lcPassword) + ";"

		This.nHandle = Sqlstringconnect(lcString)

		If Type('gnHandle') = 'N'
			gnHandle = This.nHandle
		Endif

		If Type('goExecutor') = 'O'
			goExecutor.nHandle = This.nHandle
		Endif

		If This.nHandle > 0
			lnSucces = 1

			*** SETARI SESIUNE DUPA CONECTARE
			This.postConn()

			If llReconnect
				lnSucces = InitSesiune() && IN oInit_Optiuni.prg
			Endif
		Else
			lnSucces = -1
			This.ProcessError()
		Endif

		Return This.nHandle

	Endproc && Connect
	*** END Connect ===========================================================================================

	*** Disconnect ===========================================================================================
	Procedure Disconnect
		Lparameters tnHandle

		Local lnSucces, lnHandle

		lnHandle = Iif(Empty(tnHandle) Or Type('tnHandle') # 'N', 0, tnHandle)

		lnSucces = SQLDisconnect(lnHandle)

		If lnSucces < 0
			This.ProcessError()
		Endif

		*!* 07.09.2009
		*!*		RETURN lnSucces
		Return Iif(lnSucces = 1, CT_SUCCES, CT_INSUCCES)
		*!* 07.09.2009 ^

	Endproc &&
	*** END Disconnect ===========================================================================================

	*** ProcessError ===========================================================================================
	Procedure ProcessError

		Local laEroare, lnEroare1, lnEroare2, lcTextEroare, lcEroareConectare
		lcTextEroare = ''
		lcEroareConectare = ''
		Dimension laEroare[1]

		Aerror(laEroare)
		If Alen(laEroare) > 1
			lnEroare1 = laEroare[1]
			lnEroare2 = laEroare[5]
			lcTextEroare = laEroare[3]
			lnHandle = laEroare[6]
			llEroare = .T.

			lcTextEroare = 'Conectarea nu a reusit ' + Chr(13) + Chr(10) + Alltrim(Transform(laEroare[1])) + ' ' + Chr(13) + Transform(laEroare[2]) + Chr(13) + Transform(laEroare[3])
			This.cEroare = lcTextEroare
			This.aEroare = laEroare

			If Type('goLog') = 'O'
				goLog.Log(lcTextEroare, Program())
			Endif

			If laEroare[1] = 1526 And Like('*ORA-20???:*', laEroare[2])
				lnPozi = At("ORA-20", laEroare[2]) + 11
				lnPozf = At("ORA", laEroare[2], 3)
				lcEroareConectare = Substr(laEroare[2], lnPozi, lnPozf - lnPozi)
			Else
				lcEroareConectare = lcTextEroare
			Endif
			If Empty(lcEroareConectare)
				lcEroareConectare = "Conectarea nu a reusit!"
			Endif

			amessagebox(lcEroareConectare, 0 + 48, "Atentie")
		Endif

		Return lcTextEroare

	Endproc && ProcessError
	*** END ProcessError ===========================================================================================

	*** postConn ===========================================================================================
	Procedure postConn
		*** PUNCT ZECIMAL
		lcSql = [ALTER SESSION SET NLS_NUMERIC_CHARACTERS = ".,"]
		lnSucces = goExecutor.oExecute(lcSql)
		If lnSucces < 0
			amessagebox(goExecutor.cEroare, 0 + 16, 'Eroare')
		Endif

	Endproc && postConn
	*** END postConn ===========================================================================================

	Procedure BeginManualTransaction
		Local lnHandle, lnSucces, llSucces

		lnHandle = This.nHandle
		llSucces = .T.

		If SQLGetprop(lnHandle, "Transactions") = 1 && TRANZACTIE AUTOMATA
			lnSucces = SQLSetprop(m.lnHandle, "Transactions", 2) && TRANZACTIE MANUALA
			llSucces = (m.lnSucces = 1)
		Endif
		Return m.llSucces
	Endproc && BeginManualTransaction

	Procedure EndManualTransaction
		Lparameters tcMode
		*** tcMode: optional: COMMIT/ROLLBACK/EMPTY (DEFAULT)

		Local lnHandle, lcMode, lnSucces, llSucces
		lcMode = Iif(!Empty(m.tcMode), Upper(m.tcMode), '')
		lnHandle = This.nHandle
		llSucces = .T.
		If !Empty(m.lcMode)
			llSucces = goExecutor.oExecuta(m.lcMode)
		Endif

		If SQLGetprop(lnHandle, "Transactions") = 2 && TRANZACTIE MANUALA
			lnSucces = SQLSetprop(m.lnHandle, "Transactions", 1) && TRANZACTIE AUTOMATA
			llSucces = (m.lnSucces = 1)
		Endif
		Return m.llSucces
	Endproc && BeginManualTransaction
Enddefine && oConn
*** END oConn ===========================================================================================



* PROCEDURE Get_Ora( tnTip )
* Date : 16/11/2004, 08:58:45
* author : marius.mutu
* description:

****** PARAMETER BLOCK **************
* Parameters : 1
* Parameter 1:
*
******************************************* INCEPUT:Get_Ora *******************************************
Procedure Get_Ora( tnTip )
	* tnTip: 1 sau nimic = DATETIME ; 2 = CHARACTER

	Local lcRetVal, lnSucces
	Local lcCursor, lcSql, lcSelect, lcTipDataOra
	lcSelect = Select()

	If Pcount() = 0 Or Type('tnTip') <> 'N'
		lnTip = 1
	Else
		lnTip = tnTip
	Endif

	lcTipDataOra = Lower(Nvl(goAPI.GetProfileString(m.gcSettingsFile, [general], "tipdataora"), '')) && local/server

	lcTipDataOra = Iif(!Inlist(m.lcTipDataOra, 'local', 'server', 'nimic'), 'server', m.lcTipDataOra)
	Do Case
		Case m.lcTipDataOra = 'server'
			&&preluare ora de pe oracle server:
			Store - 1 To lnSucces
			lcSql = [select to_char(SYSdate,'dd/mm/yyyy hh24:mi:ss') as dataora from dual]
			lcCursor = [dataora_cursor]
			lnSucces = goExecutor.oExecute(lcSql, lcCursor)
			If lnSucces < 0
				amessagebox(goExecutor.cEroare, 0 + 16, , 'Eroare')
				lcRetVal = Ttoc(Datetime())
			Else
				Select dataora_cursor
				lcRetVal = dataora_cursor.dataora
				Use In dataora_cursor
			Endif
			If lnTip = 1
				lcRetVal = Ctot(lcRetVal)
			Endif
		Case m.lcTipDataOra = 'local'
			* local = ora de pe calculator 
			lcRetVal = Iif(lnTip = 1, Datetime(), '* ' + Ttoc(Datetime()))
		Otherwise && nimic
			lcRetVal = Iif(lnTip = 1, Datetime(), '*')
	Endcase

	If !Empty(lcSelect)
		Select (lcSelect)
	Endif

	Return lcRetVal
Endproc
******************************************* SFARSIT: Get_Ora *******************************************
*________________________________________________________

Function ULTIMAZI
	Parameters tcAn, tcLuna

	Local lcAn, lcLuna

	If Empty(tcAn)
		lcAn  = pcAn
	Else
		lcAn = Alltrim(tcAn)
	Endif

	If Empty(tcLuna)
		lcLuna = pcNl
	Else
		lcLuna = Alltrim(tcLuna)
	Endif

	If Val(lcAn) = Year(Date()) And Val(lcLuna) = Month(Date())
		Return Date()
	Endif

	lcData = '01/' + lcLuna + '/' + lcAn
	ldData = Gomonth(Ctod(lcData), 1) - 1

	Return ldData

	****************************************************************

Function get_nivel_upf(tnid_util, tnid_prog, tnid_firma)
	Private pnid_util, pnid_prog, pnid_firma
	pnid_util = tnid_util
	pnid_prog = tnid_prog
	pnid_firma = tnid_firma
	Local lnnivel
	lcSql = [select ud.id_nivel,n.nivel from contafin_oracle.util_drept ud ] + ;
		[join contafin_oracle.nivel n on ud.id_nivel = n.id_nivel ] + ;
		[where ud.id_util = ?pnid_util and ud.id_prog = ?pnid_prog and ] + ;
		[ud.id_firma = ?pnid_firma]
	lcCursor = [crsUtilNivel]
	lnSucces = goExecutor.oExecute(lcSql, lcCursor)
	If lnSucces < 0
		lcTitlu = [Eroare]
		lctip = [Avertizare]
		lcImagine = [exclam.ico]
		lcMesaj = goExecutor.cEroare
		ofrm_eroare = Createobject('frm_mesaj', lcTitlu, lcImagine, lctip, lcMesaj)
		ofrm_eroare.Show(1)
		Release ofrm_eroare
		Return
	Endif
	lnnivel = &lcCursor..nivel
	Return lnnivel
Endfunc &&get_nivel_upf

*******************************************************************************************************

Function enumefis
	Parameters tc_numefis
	Private pn_len, pl_return, pc_numefis, pc_char
	pn_len = 0
	pc_char = ''
	pl_return = .T.
	pc_numefis = Alltrim(tc_numefis)
	pn_len = Len(pc_numefis)
	If pn_len = 0
		pl_return = .F.
	Endif
	Do While pn_len > 0
		pc_char = Substr(pc_numefis, pn_len, 1)
		If !Between(Asc(pc_char), 48, 57) And !Between(Asc(pc_char), 97, 122) And !Between(Asc(pc_char), 65, 90) And Asc(pc_char) <> 95 And Asc(pc_char) <> 46
			pl_return = .F.
			Exit
		Endif
		pn_len = pn_len - 1
	Enddo
	Return pl_return
Endfunc && enumefis
***********************************************************************************************


*******************************************
* PROCEDURE ImportTable
* Date : 08/07/2005, 09:20:54
* author : marius.mutu
* description: intoarce numele unui cursor cu datele importate dintr-un dbf
*******************************************
Procedure ImportTable
	Local lcCursor
	lcCursor = ""
	loimport = Newobject("frm_import", "importdata")
	loimport.Show(1)
	If gnButon = 1
		lcCursor = "crsReturn"
	Endif

	Return lcCursor

Endproc
*----------------------------------sfarsit procedura ImportTable----------------------------------


Function Lista_Campuri
	Lparameters tcAlias

	Local lcSelect, i, lcAlias, lcLista
	lcLista = []
	lcSelect = Select()
	lcAlias = tcAlias

	Select (lcAlias)
	lnFields = Fcount()
	For i = 1 To lnFields
		lcField = Field(i)
		lcLista = lcLista + [,] + lcField
	Endfor
	If !Empty(lcLista)
		lcLista = Substr(lcLista, 2)
	Endif

	Select (lcSelect)
	Return lcLista

Endfunc && Lista_Campuri


***---------------------------------------------------------------------
Procedure OPEN_DEFAULT_APP
	Parameters tcfilename, tcParams
	LOCAL cFileName, cAction, cParams
	
	Declare Integer ShellExecute In shell32.Dll ;
		Integer hndWin, ;
		String cAction, ;
		String cFileName, ;
		String cParams, ;
		String cDir, ;
		Integer nShowWin
	cFileName = tcfilename
	cAction = "open"
	cParams = IIF(!EMPTY(m.tcParams), m.tcParams, "")
	
	ShellExecute(0, cAction, cFileName, cParams, "", 1)

Endproc && OPEN_DEFAULT_APP


***---------------------------------------------------------------------
Procedure GET_SCHEMA_GRID
	Lparameters toGrid, tcColumnList, tcHeaderList, tcSchema, tlSelect, tnType, tcFrom, tcWhere, tcOrder, tcOutputName

	Local lcSelect, llSelect, lcAlias, lcWhere, lcOrder, lcColumn, lcHeader, lnOccurs
	Local lnType, lcInto
	&& tnType : 0 CURSOR, 1 TABLE, 2 ARRAY

	If Type('tnType') # 'N'
		lnType = 0
	Else
		If !Between(tnType, 0, 2)
			lnType = 0
		Else
			lnType = tnType
		Endif
	Endif
	Do Case
		Case lnType = 0
			lcInto = ' INTO CURSOR '
		Case lnType = 1
			lcInto = ' INTO TABLE '
		Other lnType = 1
			lcInto = ' INTO ARRAY '
	Endcase


	tcColumnList = ''
	tcHeaderList = ''
	tcSchema = ''

	lnNrCol = toGrid.ColumnCount
	Dimension myArray[lnNrCol, 3]

	With toGrid
		For lnCol = 1 To .ColumnCount
			lnColumn = .Columns(lnCol).ColumnOrder
			lcColumn = .Columns(lnCol).ControlSource
			llVisible = .Columns(lnCol).Visible
			lnWidth = .Columns(lnCol).Width
			If !llVisible Or lnWidth = 0 Or Empty(Alltrim(lcColumn))
				Adel(myArray, lnCol)
				Loop
			Endif
			lnPos = At('.', lcColumn)
			lnOccurs = Occurs('.', m.lcColumn)
			If m.lnOccurs = 1 And m.lnPos > 0
				lcColumn = Substr(lcColumn, lnPos + 1)
			Endif
			*tcColumnList = tcColumnList + lcColumn + ','
			myArray[lnCol, 1] = lnColumn

			For lnobjcol = 1 To .Columns(lnCol).Objects.Count
				If Upper(.Columns(lnCol).Objects(lnobjcol).BaseClass) = 'HEADER'
					lcHeader = .Columns(lnCol).Objects(lnobjcol).Caption
					lcHeader = Strtran(Strtran(Strtran(Strtran(Strtran(Strtran(Strtran(Strtran(Strtran(lcHeader, Chr(32), '_'), '.', '_'), '/', '_'), '\', '_'), "&", "_"), "%", ""), "(", "_"), ")", "_"), "-", "_")
					lcHeader = Strtran(lcHeader, '=', '_')
					lcHeader = Strtran(lcHeader, ',', '_')
					lcHeader = Strtran(lcHeader, '+', '_')					
					*tcHeaderList = tcHeaderList + lcHeader + ','
					*tcSchema = tcSchema + lcColumn + [ as ] + lcHeader + [,]
					myArray[lnCol, 2] = lcColumn
					myArray[lnCol, 3] = lcHeader
					Exit
				Endif
			Endfor
		Endfor
		*!*		tcColumnList = Substr(tcColumnList, 1, Len(tcColumnList)-1)
		*!*		tcHeaderList = Substr(tcHeaderList , 1, Len(tcHeaderList)-1)
		*!*		tcSchema = Substr(tcSchema , 1, Len(tcSchema)-1)
	Endwith
	For i = 1 To Alen(myArray, 1)
		l1 = myArray[i, 1]
		If Type('l1') # 'N'
			myArray[i, 1] = -1
		Endif
	Endfor

	Asort(myArray)
	For i = 1 To Alen(myArray, 1)
		If myArray[i, 1] <> -1
			tcColumnList = tcColumnList + Alltrim(myArray[i, 2]) + [,]
			tcHeaderList = tcHeaderList + Alltrim(myArray[i, 3]) + [,]
			tcSchema = tcSchema + Alltrim(myArray[i, 2]) + [ as ] + Alltrim(myArray[i, 3]) + [,]
		Endif
	Endfor

	tcColumnList = Substr(tcColumnList, 1, Len(tcColumnList) - 1)
	tcHeaderList = Substr(tcHeaderList, 1, Len(tcHeaderList) - 1)
	tcSchema = Substr(tcSchema, 1, Len(tcSchema) - 1)


	If tlSelect
		tcSchema = 'SELECT ' + tcSchema
	Endif
	If !Empty(tcFrom)
		tcSchema = tcSchema + ' FROM ' + Alltrim(tcFrom)
	Endif
	If !Empty(tcWhere)
		tcSchema = tcSchema + ' WHERE ' + Alltrim(tcWhere)
	Endif

	If !Empty(tcOrder)
		tcSchema = tcSchema + ' ORDER BY ' + Alltrim(tcOrder)
	Endif

	If !Empty(tcOutputName)
		tcSchema = tcSchema + lcInto + tcOutputName
	Endif

Endproc && GET_SCHEMA_GRID

***---------------------------------
Procedure amessage
	Lparameters tcMessage, tnDialogBoxType, tcTitleBarText, tnTimeOut
	Local lnResponse
	lnResponse = 0
	lcMessage = Iif(Empty(tcMessage), [], tcMessage)
	lnDialogBoxType = Iif(Empty(tnDialogBoxType), 0, tnDialogBoxType)
	lcTitleBarText = Iif(Empty(tcTitleBarText), [], tcTitleBarText)
	lnTimeOut = Iif(Empty(tnTimeOut), 0, tnTimeOut)
	If lnTimeOut # 0
		lnResponse = amessagebox(lcMessage, lnDialogBoxType, lcTitleBarText, lnTimeOut)
	Else
		lnResponse = amessagebox(lcMessage, lnDialogBoxType, lcTitleBarText)
	Endif

	Return lnResponse

Endproc && amessage
***---------------------------------

DEFINE CLASS oChatBotLaunch as Custom 
	cMessage = ''
	
	FUNCTION Init
		LPARAMETERS tcMessage
		This.cMessage = m.tcMessage
	ENDFUNC 
	
	FUNCTION Launch
		open_default_app('https://www.romfast.ro/chatbot_maria.html?message=' + ALLTRIM(This.cMessage))	
	ENDFUNC 
ENDDEFINE 

***---------------------------------
Function amessagebox
	Lparameters tcMessage, tnDialogBoxType, tcTitle, tcFont, tnTimeOut, tnTimeoutValue

	Local loMessage, lnReturn, lcMessageboxForm
	PRIVATE oChatbot
	oChatBot = CREATEOBJECT("oChatBotLaunch", m.tcMessage)

	*!*		*!* LOGHEZ ERORILE
	*!*		IF TYPE('goLog') = 'O' AND 'ERROR'$UPPER(tcMessage) OR 'EROARE'$UPPER(tcMessage) OR 'ORA-'$UPPER(tcMessage)
	*!*			goLog.LOG(tcMessage,PROGRAM())
	*!*		ENDIF
	If Type('gcNumeProgram') = 'C' And gcNumeProgram = 'ROASTART'
		lcMessageboxForm = "messagebox_form_desktop" && desktop .T.
	Else
		lcMessageboxForm = "messagebox_form"
	Endif
	If !'MESSAGEBOX' $ Upper(Set("Classlib"))
		If Type('lnTimeOut') = 'N' And lnTimeOut # 0
			lnReturn = Messagebox(tcMessage, tnDialogBoxType, tcTitle, tnTimeOut)
		Else
			lnReturn = Messagebox(tcMessage, tnDialogBoxType, tcTitle)
		Endif
	Else
		loMessage = Newobject(lcMessageboxForm, "MessageBox.vcx", "", tcMessage, tnDialogBoxType, tcTitle, tcFont, tnTimeOut, tnTimeoutValue)
		loMessage.AlwaysOnTop = .T.
		loMessage.Show(1)
		lnReturn = loMessage.IDOpcion
	Endif


	Return lnReturn

Endfunc && amessagebox
***---------------------------------

Procedure export_xls
	Lparameters tcAlias, tcNumeFisier

	If Empty(tcNumeFisier)
		tcNumeFisier = 'Foaie_Excel'
	Endif

	Local lcSelect
	lcSelect = Select()

	If Used(tcAlias)
		lcDir = Addbs(gcTempPath)

		lcFile = Putfile('Nume fisier:', tcNumeFisier, 'XLS')
		If Empty(lcFile)  && Esc pressed
			Return
		Endif


		Select (tcAlias)
		Export To (lcFile) Type Xl5
		Select (lcSelect)

		OPEN_DEFAULT_APP(lcFile)

	Endif
Endproc && export_xls

*__________________________________________________________

&& Folosesc un tabel <ids> (tabel,id) cu cate o linie pt fiecare tabel
&& aflu id-ul urmator si il scriu in tabela <ids>
&& returnez id-ul
&& EX1: LNEW_ID=NEW_ID("GRILA_SAL") --> urmatorul id din <grila_sal> fara cautare in tabela originala
&& EX2: LNEW_ID=NEW_ID("GRILA_SAL","ID") --> urmatorul id din <grila_sal> cu cautare in tabela originala dupa campul<id>
&& ex3: LNEW_ID=NEW_ID("GRILA_SAL","ID",.T.) --> .T. INSEAMNA CA TABELUL ORIGINAL ESTE INDEXAT DUPA <ID> FAC SEEK IN LOC DE LOCATE
Procedure NEW_ID
	Parameters TALIAS, TFIELD, TTAG
	*WAIT WINDOW TALIAS
	*ON error Errorh(ERROR(),PROGRAM(),LINENO())
	LLLOOKUP = Iif(Type("tfield") = "C", .T., .F.)
	LLTAG = Iif(Type("TTAG") = "C", .T., .F.)
	TALIAS = Upper(Alltrim(TALIAS))


	*** Save Stats
	LCOLDALIAS = Alias()			       && keep current work area
	LNOLDRECNO = Iif(!Eof(), Recno(), 0)       && save record number

	LCSETDEL = Set("deleted")
	&& lnmaxval = (10^pcidsize)-1			   && wrap around after this val

	***
	&& PUN ORDINEA PE ID
	If LLLOOKUP And LLTAG
		Sele (TALIAS)
		Set Order To &TTAG
	Endif
	***
	LCNEWID = 0						   && our return result - NULL if failed
	Select IDS
	Locate For Upper(Alltrim(TABEL)) = TALIAS
	If !Found()
		If Flock()
			Append Blank
			Replace TABEL With TALIAS
			Unlock
		Endif

	Endif

	Set Deleted Off
	&& acum sunt pe inregistrarea corecta


	*** lock counter table and update counter
	Select IDS
	If Rlock()
		*** Avoid use of Macros - Convert to mem var & update it
		LNCOUNTERVAL = NEW_ID

		*** VERIFY ID NUMBER - search 'til no match
		Do While .T.
			*** increase the counter - update field and var
			LNCOUNTERVAL = LNCOUNTERVAL + 1

			*!*	      *** check for wraparound
			*!*	      IF lncounterval > lnmaxval
			*!*	         lncounterval = 1
			*!*	      ENDIF

			Select (TALIAS)
			If LLLOOKUP
				If LLTAG
					LCAUT = "SEEK " + Allt(Str(LNCOUNTERVAL))
				Else
					LCAUT = "LOCATE FOR " + Allt(TFIELD) + "=" + Allt(Str(LNCOUNTERVAL))
					*** now see if it exists
					&LCAUT
					*					LOCATE FOR &TFIELD=LNCOUNTERVAL
					If !Found()
						*** No match - DONE
						Exit
					Endif && !found()
				Endif && lltag
			Else
				Exit
			Endif && lllokup

		Enddo								&& done

		Sele IDS
		Replace NEW_ID With LNCOUNTERVAL
		LCNEWID = LNCOUNTERVAL

		Unlock In IDS
	Endif									&& rlock()

	*** Reset record number on original file

	If !Empty(LCOLDALIAS)
		Sele (LCOLDALIAS)
		If LNOLDRECNO # 0
			Goto LNOLDRECNO
		Endif
	Endif
	Set Deleted &LCSETDEL

	Return LCNEWID

Endproc && NEW_ID


***-------------------------------------------------------------------------------------------------------

* Foloseste comment de la coloane si tooltiptext de la grid pt a salva recordsource si controlsource din grid inainte de reconstructie
Procedure SAVE_GRID
	Param toGrid
	*wait wind 'save_grid'
	Private pogrid
	If Param() = 0 Or Type('togrid')!= "O"
		Return .F.
	Endif

	pogrid = toGrid

	* remember control sources in the column's comment field
	With pogrid
		Local nColumnIndex
		For m.nColumnIndex = 1 To .ColumnCount
			.Columns(m.nColumnIndex).Tag = .Columns(m.nColumnIndex).ControlSource
		Endfor
		.ToolTipText = .RecordSource
		.RecordSource = ""
	Endwith

	Return .T.
Endproc && SAVE_GRID
***--------------------------------------------------------------
Procedure RESTORE_GRID
	Param toGrid

	*wait wind 'restore_grid'
	Private pogrid
	If Param() = 0 Or Type('togrid')!= "O"
		Return .F.
	Endif

	pogrid = toGrid


	With pogrid
		* restore record source
		.RecordSource = .ToolTipText
		* restore control sources
		For m.nColumnIndex = 1 To .ColumnCount
			.Columns(m.nColumnIndex).ControlSource = .Columns(m.nColumnIndex).Tag
		Endfor
		.ToolTipText = ""
	Endwith
	Return .T.
Endproc && RESTORE_GRID
*******************************************************************
Procedure snr_grid	&&	switch_and_restore_grid
	Lparameters toGrid, tcRecordSourceNou
	Private pogrid
	If Param() = 0 Or Type('togrid')!= "O"
		Return .F.
	Endif
	pogrid = toGrid
	With pogrid
		.RecordSource = Iif(Empty(tcRecordSourceNou), .ToolTipText, tcRecordSourceNou)
		For m.nColumnIndex = 1 To .ColumnCount
			.Columns(m.nColumnIndex).ControlSource = Iif(!Empty(tcRecordSourceNou) And !Empty(.Columns(m.nColumnIndex).Tag), ;
				  tcRecordSourceNou + [.] + Substr(.Columns(m.nColumnIndex).Tag, At([.], .Columns(m.nColumnIndex).Tag) + 1), ;
				  .Columns(m.nColumnIndex).Tag)
			.Tag = ""
		Endfor
		.ToolTipText = ""
	Endwith
	Return .T.
Endproc	&&	snr_grid
*******************************************************************

* Foloseste comment de la coloane si tooltiptext de la grid pt a salva recordsource si controlsource din grid inainte de reconstructie
Procedure SAVE_GRID_COMMENT
	Param toGrid
	*wait wind 'save_grid'
	Private pogrid
	If Param() = 0 Or Type('togrid')!= "O"
		Return .F.
	Endif

	pogrid = toGrid

	* remember control sources in the column's comment field
	With pogrid
		Local nColumnIndex
		For m.nColumnIndex = 1 To .ColumnCount
			.Columns(m.nColumnIndex).Comment = .Columns(m.nColumnIndex).ControlSource
		Endfor
		.ToolTipText = .RecordSource
		.RecordSource = ""
	Endwith

	Return .T.
Endproc && SAVE_GRID_COMMENT
***--------------------------------------------------------------
Procedure RESTORE_GRID_COMMENT
	Param toGrid

	*wait wind 'restore_grid'
	Private pogrid
	If Param() = 0 Or Type('togrid')!= "O"
		Return .F.
	Endif

	pogrid = toGrid


	With pogrid
		* restore record source
		.RecordSource = .ToolTipText
		* restore control sources
		For m.nColumnIndex = 1 To .ColumnCount
			.Columns(m.nColumnIndex).ControlSource = .Columns(m.nColumnIndex).Comment
		Endfor
		.ToolTipText = ""
	Endwith
	Return .T.
Endproc && RESTORE_GRID_COMMENT


* Foloseste comment de la coloane si tooltiptext de la grid pt a salva recordsource si controlsource din grid inainte de reconstructie
Procedure SAVE_GRID_TAG
	Param toGrid
	*wait wind 'save_grid'
	Private pogrid
	If Param() = 0 Or Type('togrid')!= "O"
		Return .F.
	Endif

	pogrid = toGrid

	* remember control sources in the column's comment field
	With pogrid
		Local nColumnIndex
		For m.nColumnIndex = 1 To .ColumnCount
			.Columns(m.nColumnIndex).Tag = .Columns(m.nColumnIndex).ControlSource
		Endfor
		.ToolTipText = .RecordSource
		.RecordSource = ""
	Endwith

	Return .T.
Endproc && SAVE_GRID_TAG
***--------------------------------------------------------------
Procedure RESTORE_GRID_TAG
	Param toGrid

	*wait wind 'restore_grid'
	Private pogrid
	If Param() = 0 Or Type('togrid')!= "O"
		Return .F.
	Endif

	pogrid = toGrid


	With pogrid
		* restore record source
		.RecordSource = .ToolTipText
		* restore control sources
		For m.nColumnIndex = 1 To .ColumnCount
			.Columns(m.nColumnIndex).ControlSource = .Columns(m.nColumnIndex).Tag
		Endfor
		.ToolTipText = ""
	Endwith
	Return .T.
Endproc && RESTORE_GRID_TAG


*-------------------------------------------
* Function...: Xmenu
* Author.....: MARTIN
* Date.......: 04/06/1997
* Notes......: Based on an idea from Steve Zimmelman for FoxPro 2.x
* Parameters.: tcItems = Semicolon-separated String with the various options
* ...........: tnBar   = Initially selected item (default=1)
* Returns....: Selected item number
* See Also...: PROMPT() [FoxPro Native]
*
Procedure XMENU
	Lparameters TCITEMS, TNBAR

	Local NITEMCOUNT, AITEMS, X, NROW, NCOL, CTITLE, NLASTPOS, CCOLOR, AITEMS

	Private CPOPMENU, NSELECT	&& They flow into the GetChoice internal procedure

	If Pcount() < 2
		TNBAR = 1
	Endif

	Activate Screen

	* Parse every item
	*
	m.NITEMCOUNT = Occurs( ';', TCITEMS ) + 1
	Dimen AITEMS[ m.nItemCount ]
	m.NLASTPOS = 1

	For m.X = 1 To m.NITEMCOUNT

		If m.X < m.NITEMCOUNT

			AITEMS[ m.x ] = Subs( m.TCITEMS, m.NLASTPOS, ;
				  ( At( ';', m.TCITEMS, m.X ) - 1 ) - m.NLASTPOS + 1 )
		Else
			AITEMS[ m.x ] = Subs( m.TCITEMS, m.NLASTPOS, ;
				  ( Len( m.TCITEMS ) - m.NLASTPOS ) + 1 )
		Endif

		If AITEMS[ m.x ] # "\-"

			AITEMS[ m.x ] = Allt( AITEMS[ m.x ] )
		Endif

		m.NLASTPOS = At( ';', m.TCITEMS, m.X ) + 1
	Next

	* Calculates the mouse pointer position
	*
	m.NROW = Iif( Mrow() + m.NITEMCOUNT < Srow(), Mrow() - 1, Srow() - m.NITEMCOUNT )
	m.NCOL = Iif( Mcol() + 10 < Scol(), Mcol() - 3, Mcol() - 13 )

	* Gets an unique name for the pop-up
	*
	m.CPOPMENU = 'M' + Sys(3) + "_"

	Define Popup ( m.CPOPMENU ) SHORTCUT Relative From NROW, NCOL

	For m.X = 1 To m.NITEMCOUNT

		Define Bar m.X Of ( m.CPOPMENU ) Prompt AITEMS[ m.x ]
	Next

	m.CANS = ""
	m.NSELECT = 0
	Clear Type

	On Selection Popup ( m.CPOPMENU ) Do GETCHOICE

	Activate Popup ( m.CPOPMENU ) Bar TNBAR

	Pop Key
	Release Popup ( m.CPOPMENU )

	Return Iif( Lastkey() = 27, 0, m.NSELECT )

Endproc && XMENU



********************
*** MENIU POPUP CREAT DINAMIC
********************
PROCEDURE XMENUP
	LPARAMETERS TCITEMS, TNBAR

	LOCAL NITEMCOUNT, AITEMS, X
	LOCAL loMenu, lnOption
	lnOption = 0
	loMenu = NEWOBJECT("popmenu", "menutool.vcx")

	NITEMCOUNT = OCCURS( ';', TCITEMS ) + 1
	DIMEN AITEMS[ m.nItemCount ]
	NLASTPOS = 1

	FOR X = 1 TO m.NITEMCOUNT

		IF m.X < m.NITEMCOUNT

			AITEMS[ m.x ] = SUBS( m.TCITEMS, m.NLASTPOS, ;
				  ( AT( ';', m.TCITEMS, m.X ) - 1 ) - m.NLASTPOS + 1 )
		ELSE
			AITEMS[ m.x ] = SUBS( m.TCITEMS, m.NLASTPOS, ;
				  ( LEN( m.TCITEMS ) - m.NLASTPOS ) + 1 )
		ENDIF

		IF AITEMS[ m.x ] # "\-"

			AITEMS[ m.x ] = ALLT( AITEMS[ m.x ] )
		ENDIF

		NLASTPOS = AT( ';', m.TCITEMS, m.X ) + 1
		loMenu.ADDITEM(AITEMS[ m.x ], X, 1)
	ENDFOR
	lnOption = loMenu.SHOW()
	RETURN m.lnOption
ENDPROC && XMENUP

*--------------------
Procedure GETCHOICE

	m.NSELECT = Bar()

	Deactivate Popup ( m.CPOPMENU )

	Return
	&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& MENIU &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

Procedure lista2array
	Parameters tcLISTA, taArray, tcSeparator
	&& tcLista este un sir de caractere care contine elementele separate prin <;> default
	&& tarray este vectorul care se completeaza - trebuie dat prin referinta
	&& tcSeparator separatorul de elemente din tcLista - default este ";" - este optional
	&& intoarce numarul de elemente gasite

	&& ex: lnNr = lista2array("ana;are;mere",@alista,";")
	External Array taArray
	Local lcLista, lcSeparator, lnNRF, lcF1, i

	lnNRF = 0

	lcLista = Allt(tcLISTA)
	If Parameters() < 3 Or Empty(tcSeparator)
		lcSeparator = ";"
	Else
		lcSeparator = Alltrim(tcSeparator)
	Endif

	If Right(lcLista, 1)!= lcSeparator
		lcLista = lcLista + lcSeparator
	Endif

	lnNRF = Occurs(lcSeparator, lcLista)

	If lnNRF > 0
		Dimension taArray[lnNrf, 1]

		For i = 1 To lnNRF
			lcF1 = Left(lcLista, At(lcSeparator, lcLista) - 1)

			If i!= lnNRF
				lcLista = Substr(lcLista, At(lcSeparator, lcLista) + 1)
			Endif

			taArray[i] = lcF1
		Endfor
	Else
		lnNRF = 0
	Endif

	Return lnNRF

Endproc && lista2array


***-------------------------------------------------------------------------------------------
Procedure get_mask
	Parameters tnint, tndec

	Local lnint, lndec
	lnint = tnint
	lndec = tndec
	lnrest = Mod(lnint, 3)

	lcString = Replicate("9", lnrest)
	lnint_ramas = lnint - lnrest
	Do While lnint_ramas > 0
		lcString = lcString + " " + Replicate("9", 3)
		lnint_ramas = lnint_ramas - 3
	Enddo
	If lndec > 0
		lcString = lcString + "." + Replicate("9", tndec)
	Endif

	Return lcString

Endproc && get_mask
*******************************************************************
Function formateaza
	Parameters tnValoare, tnNrCaractere, tnNrZecimale
	Local lcValoare
	lcValoare = Strtran(Alltrim(Transform(tnValoare, get_mask(tnNrCaractere, tnNrZecimale))), [.], [,])
	Return lcValoare
Endfunc && formateaza
*******************************************************************
Function tradu
	Lparameters tcText
	Local lcText
	*!*		lcText = CPCONVERT(CPCURRENT(1),1252,tcText)
	lcText = tcText
	If Type('glFontCharSet') <> 'U'
		If !Nvl(glFontCharSet, .F.)
			lcText = Strtran(Strtran(Strtran(Strtran(Strtran(lcText, Chr(227), [a]), Chr(238), [i]), Chr(226), [a]), Chr(186), [s]), Chr(254), [t])
			lcText = Strtran(Strtran(Strtran(Strtran(Strtran(lcText, Chr(195), [A]), Chr(206), [I]), Chr(194), [A]), Chr(170), [S]), Chr(222), [T])
		Endif
	Endif
	Return lcText
Endfunc
*******************************************************************
* PROCEDURE Get_Version(  )
* Date : 17/11/2004, 16:34:20
* author : marius.mutu
* description:

****** PARAMETER BLOCK **************
* Parameters : 0
*
******************************************* INCEPUT:Get_Version *******************************************
Procedure Get_Version(tlNoRevision, tlInfo, tcfilename)
	Local laVersion, lcVersion, lcFileName

	*-- Get Version Information
	*-- Added 4-1-98 BDC
	Local lcVersionText, lcFileName, llNoRevision, llInfo

	Dimension aVersion(12)

	If Empty(tcfilename)
		lcFileName = Sys(16, 0)
	Else
		lcFileName = tcfilename
	Endif
	llNoRevision = tlNoRevision
	llInfo = tlInfo



	*** EGL: 2002.1.2 17:06 -  switched to AGETFILEVERSION().
	If Val(Substr(Version(), 15)) >= 6
		* The AGETFILEVERSION() function was introduced in VFP 6

		*!*			DECLARE STRING GetCommandLine IN Kernel32
		*!*			lcFileName = GetCommandLine()
		lcVersionText = ""

		*!*	IF GetFileVersion(&lcFileName,@aVersion) = 0
		If Agetfileversion(aVersion, lcFileName) > 0
			If !llInfo
				* daca vreau doar numarul versiunii
				lcVersion = Allt(aVersion(4))
				If llNoRevision
					* daca nu vreau si revizia
					lnPos = Rat('.', lcVersion, 1)
				Else
					lnPos = Len(lcVersion)
				Endif
				lcVersionText = Left(lcVersion, lnPos)
			Else
				* vreau toata informatia despre fisier
				If Not Empty(aVersion(1))
					lcVersionText = Allt(aVersion(1))
				Endif

				If Not Empty(aVersion(2))
					lcVersionText = lcVersionText + Chr(10) + "Produs de: " + Allt(aVersion(2))
				Endif

				If Not Empty(aVersion(3))
					lcVersionText = lcVersionText + Chr(10) + "Descriere: " + Allt(aVersion(3))
				Endif

				If Not Empty(aVersion(4))
					lcVersionText = lcVersionText + Chr(10) + "Versiune fisier: " + Allt(aVersion(4))
				Endif

				If Not Empty(aVersion(5))
					lcVersionText = lcVersionText + Chr(10) + "Nume intern: " + Allt(aVersion(5))
				Endif

				If Not Empty(aVersion(6))
					lcVersionText = lcVersionText + Chr(10) + "Copyright: " + Allt(aVersion(6))
				Endif

				If Not Empty(aVersion(7))
					lcVersionText = lcVersionText + Chr(10) + "Marca inregistrata: " + Allt(aVersion(7))
				Endif

				If Not Empty(aVersion(8))
					lcVersionText = lcVersionText + Chr(10) + "Nume fisier: " + Allt(aVersion(8))
				Endif

				If Not Empty(aVersion(9))
					lcVersionText = lcVersionText + Chr(10) + "Private Build: " + Allt(aVersion(9))
				Endif

				If Not Empty(aVersion(10))
					lcVersionText = lcVersionText + Chr(10) + "Nume produs: " + Allt(aVersion(10))
				Endif

				If Not Empty(aVersion(11))
					lcVersionText = lcVersionText + Chr(10) + "Versiune produs: " + Allt(aVersion(11))
				Endif

				If Not Empty(aVersion(12))
					lcVersionText = lcVersionText + Chr(10) + "Special Build: " + Allt(aVersion(12))
				Endif

				If Empty(lcVersionText)
					lcVersionText = ""
				Endif
			Endif
		Else

			lcVersionText = ""

		Endif

	Else
		lcVersionText = ""
	Endif
	Return lcVersionText

Endproc
******************************************* SFARSIT: Get_Version *******************************************


* PROCEDURE Get_Hexa( tnDeca )
* Date : 18/11/2004, 17:56:48
* author : marius.mutu
* description: transforma un Deca in Hexa

****** PARAMETER BLOCK **************
* Parameters : 1
* Parameter 1: Numarul in Deca
*
******************************************* INCEPUT:Get_Hexa *******************************************
Procedure Get_Hexa( tnDeca )
	Local laHexa, lnHexa, lnDeca


	If Empty(tnDeca)
		lnDeca = 0
	Else
		lnDeca = tnDeca
	Endif

	Dimension laHexa[16]
	laHexa[1] = '0'
	laHexa[2] = '1'
	laHexa[3] = '2'
	laHexa[4] = '3'
	laHexa[5] = '4'
	laHexa[6] = '5'
	laHexa[7] = '6'
	laHexa[8] = '7'
	laHexa[9] = '8'
	laHexa[10] = '9'
	laHexa[11] = 'A'
	laHexa[12] = 'B'
	laHexa[13] = 'C'
	laHexa[14] = 'D'
	laHexa[15] = 'E'
	laHexa[16] = 'F'

	lnHexa = ''

	Do While lnDeca > 0
		lnrest = Mod(lnDeca, 16)
		lcHexa = laHexa[lnRest + 1]
		lnDeca = Int(lnDeca / 16)

		lnHexa = lcHexa + lnHexa
		lnrest = Mod(lnDeca, 16)

	Enddo

	Return lnHexa

Endproc
******************************************* SFARSIT: Get_Hexa *******************************************
&& completeaza cu spatii si CRLF un mesaj a.i. pe fiecare linie sa fie lnLength caractere
Function format_msg
	Parameters tcErrMsg, tnLength
	Local lnLength, lcLinie, lcMesaj, lnPoz, lnCate, i, j
	lcMesaj = ""
	If Empty(tnLength)
		lnLength = 50			&& numarul de caractere pe linie
	Else
		lnLength = tnLength
	Endif
	i = 1
	If At(Chr(13) + Chr(10), tcErrMsg, i) > 0
		lnCate = At(Chr(13) + Chr(10), tcErrMsg, i) + 1
		i = i + 1
	Else
		lnCate = Min(lnLength, Rat(' ', Substr(tcErrMsg, 1, lnLength)) - 1)
	Endif
	lnPoz = 1
	*!*	lcLinie=Substr(tcErrMsg,1,lnCate)

	Do While lnPoz < Len(tcErrMsg)
		lcLinie = Substr(tcErrMsg, lnPoz, lnCate)

		If Right(lcLinie, 2) = Chr(13) + Chr(10)
			lcLinie = Alltrim(Substr(lcLinie, 1, Len(lcLinie) - 2))
		Else
			lcLinie = Alltrim(lcLinie)
		Endif

		j = Int((lnLength - Len(lcLinie)) / 2)
		lcLinie = Iif(!Empty(lcLinie), Space(j) + lcLinie + Space(j), "")
		lcMesaj = lcMesaj + lcLinie + Chr(13) + Chr(10)

		lnPoz = lnPoz + lnCate

		If At(Chr(13) + Chr(10), tcErrMsg, i) > 0
			lnCate = At(Chr(13) + Chr(10), tcErrMsg, i) + 2 - lnPoz
			i = i + 1
		Else
			lcNextChar = Substr(tcErrMsg, lnPoz + lnLength, 1)
			lcLinieNoua = Substr(tcErrMsg, lnPoz, lnLength)
			If lcNextChar!= ' ' And Len(lcLinieNoua) >= lnLength
				lnCate = Min(lnLength, Rat(' ', lcLinieNoua) - 1)
			Else
				lnCate = lnLength
			Endif
		Endif
	Enddo
	Return lcMesaj
Endfunc		&& format_msg
***---------------------------------------------------------------------------------------------
Procedure C_LUNA
	Parameters tnnrluna
	Do Case
		Case tnnrluna = 1
			Return "IANUARIE"
		Case tnnrluna = 2
			Return "FEBRUARIE"
		Case tnnrluna = 3
			Return "MARTIE"
		Case tnnrluna = 4
			Return "APRILIE"
		Case tnnrluna = 5
			Return "MAI"
		Case tnnrluna = 6
			Return "IUNIE"
		Case tnnrluna = 7
			Return "IULIE"
		Case tnnrluna = 8
			Return "AUGUST"
		Case tnnrluna = 9
			Return "SEPTEMBRIE"
		Case tnnrluna = 10
			Return "OCTOMBRIE"
		Case tnnrluna = 11
			Return "NOIEMBRIE"
		Case tnnrluna = 12
			Return "DECEMBRIE"
		Otherwise
			Return ""
	Endcase
Endproc &&c_luna
***--------------------------------------------------------------------------------------
***--------------------------------------------------------------------------------------
Procedure CLUNA3
	Parameters tnnrluna
	Do Case
		Case tnnrluna = 1
			Return "Ian"
		Case tnnrluna = 2
			Return "Feb"
		Case tnnrluna = 3
			Return "Mar"
		Case tnnrluna = 4
			Return "Apr"
		Case tnnrluna = 5
			Return "Mai"
		Case tnnrluna = 6
			Return "Iun"
		Case tnnrluna = 7
			Return "Iul"
		Case tnnrluna = 8
			Return "Aug"
		Case tnnrluna = 9
			Return "Sep"
		Case tnnrluna = 10
			Return "Oct"
		Case tnnrluna = 11
			Return "Noi"
		Case tnnrluna = 12
			Return "Dec"
		Otherwise
			Return Space(3)
	Endcase
Endproc &&cluna3
***--------------------------------------------------------------------------------------
***------------------------------------------------------------------------------------
Procedure cluna
	Parameters tcGrup, tcTipCumul, tcAn

	lcTipCumul = Upper(Alltrim(tcTipCumul))
	lcAn = Alltrim(tcAn)
	lcgrup = Alltrim(tcGrup)
	lnGrup = Val(lcgrup)
	Do Case
		Case lcTipCumul = "T"
			lcret = "Trim. " + lcgrup + " " + lcAn
		Case lcTipCumul = "S"
			lcret = "Sem. " + lcgrup + " " + lcAn
		Case lcTipCumul = "A"
			lcret = "Anul " + lcAn
		Otherwise
			Do Case
				Case lnGrup = 1
					lcret = "Ian " + lcAn
				Case lnGrup = 2
					lcret = "Feb " + lcAn
				Case lnGrup = 3
					lcret = "Mar " + lcAn
				Case lnGrup = 4
					lcret = "Apr " + lcAn
				Case lnGrup = 5
					lcret = "Mai " + lcAn
				Case lnGrup = 6
					lcret = "Iun " + lcAn
				Case lnGrup = 7
					lcret = "Iul " + lcAn
				Case lnGrup = 8
					lcret = "Aug " + lcAn
				Case lnGrup = 9
					lcret = "Sep " + lcAn
				Case lnGrup = 10
					lcret = "Oct " + lcAn
				Case lnGrup = 11
					lcret = "Noi " + lcAn
				Case lnGrup = 12
					lcret = "Dec " + lcAn
				Otherwise
					lcret = lcAn
			Endcase
	Endcase
	Return lcret
Endproc &&cluna
***------------------------------------------------------------------------------------
***------------------------------------------------------------------------------------
Procedure get_trimestru
	Parameters tnNrTrim
	Do Case
		Case tnNrTrim = 1
			Return "Trim. I"
		Case tnNrTrim = 2
			Return "Trim. II"
		Case tnNrTrim = 3
			Return "Trim. III"
		Case tnNrTrim = 4
			Return "Trim. IV"
		Otherwise
			Return Space(7)
	Endcase
Endproc && get_trimestru
***--------------------------------------------------------------------------------------
Procedure get_semestru
	Parameters tnNrSem
	Do Case
		Case tnNrSem = 1
			Return "Sem. I"
		Case tnNrSem = 2
			Return "Sem. II"
		Otherwise
			Return Space(7)
	Endcase
Endproc && get_semestru
***--------------------------------------------------------------------------------------
Function Lista_Campuri
	Lparameters tcAlias

	Local lcSelect, i, lcAlias, lcLista
	lcLista = []
	lcSelect = Select()
	lcAlias = tcAlias

	Select (lcAlias)
	lnFields = Fcount()
	For i = 1 To lnFields
		lcField = Field(i)
		lcLista = lcLista + [,] + lcField
	Endfor
	If !Empty(lcLista)
		lcLista = Substr(lcLista, 2)
	Endif

	Select (lcSelect)
	Return lcLista

Endfunc && Lista_Campuri
***----------------------------------------

Procedure NRORD
	Parameters ALI
	Sele &ALI
	A = Reccount()
	If A = 0
		Return
	Endif
	If A > 65000
		Return 0
	Endif
	Declare NROR(A)
	K = 0
	Scan
		K = K + 1
		NROR(K) = Recno()
	Endscan
	Return

	********************
Function NRCRT
	NR = Ascan(NROR, Recno())
	Return NR
	**********************

	***----------------------------------------
Function caps_first
	Lparameters tcMesaj
	Local lcMesaj
	If !Empty(tcMesaj) And Len(tcMesaj) > 1
		lcMesaj = Upper(Substr(tcMesaj, 1, 1)) + Strtran(Lower(Substr(tcMesaj, 2)), [oracle], [Oracle])
	Else
		lcMesaj = Upper(tcMesaj)
	Endif
	Return lcMesaj
Endfunc	&&	caps_first
***----------------------------------------

*!*	FUNCTION ultima_zi_din_luna
*!*	PARAMETERS tcAnul, tcLuna
*!*
*!*	LOCAL ldData
*!*	ldData = DATE(VAL(tcAnul),VAL(tcLuna), 1)
*!*	ldData = GOMONTH(ldData,1)
*!*	ldData = DATE(YEAR(ldData),MONTH(ldData), 1) - 1
*!*	RETURN ldData
*!*	ENDFUNC

Function ultima_zi_din_luna
	Parameters tcAnul, tcLuna

	Local ldData, lcAnul, lcLuna

	If Type('tcAnul') = 'N'
		lcAnul = Transform(tcAnul)
	Else
		lcAnul = tcAnul
	Endif
	If Type('tcLuna') = 'N'
		lcLuna = Transform(tcLuna)
	Else
		lcLuna = tcLuna
	Endif

	ldData = Date(Val(lcAnul), Val(lcLuna), 1)
	ldData = Gomonth(ldData, 1)
	ldData = Date(Year(ldData), Month(ldData), 1) - 1
	Return ldData
Endfunc



******************************************************************************

Procedure viz_prg_instalat
	If Used('v_programe_instalate')
		Use In v_programe_instalate
	Endif
	*!*	lcSql = [select * from vdef_util_programe where id_util=]+Alltrim(Str(gnIdUtil))+;
	*!*		[ order by ordine]
	lcSql = [{call contafin_oracle.pack_drepturi.programe_utilizator(] + Alltrim(Str(gnIdUtil)) + [)}]
	lcCursor = [v_programe_instalate]
	lnSucces = goExecutor.oExecute(lcSql, lcCursor)
	goExecutor.Oreset()

Endproc
******************************************************************************
Procedure lansare_toolbar

	Do viz_prg_instalat In oproceduri_comune.prg

	If Used('v_programe_instalate') And Reccount('v_programe_instalate') > 0


		If Used('v_programe_favorite')
			Use In v_programe_favorite
		Endif
		Select * From v_programe_instalate Where favorit = 1 And Upper(Alltrim(nume)) <> Iif(Type('gcNumeProgram') = 'U', '<>', gcNumeProgram) ;
			Order By ordine_favorit Into Cursor v_programe_favorite
		If Reccount('v_programe_favorite') > 0
			otool = Createobject('toolset')
			With otool.tool1
				Local i
				i = 0
				Select v_programe_favorite
				Scan
					i = i + 1
					*!*	modificare	15.10.2007
					*!*					If Type('gcappname')='C'
					*!*						If gcappname=Upper(Alltrim(nume))
					*!*							Loop
					*!*						Endif
					*!*					Endif
					*!*	modificare	15.10.2007	^

					lnParametru_prog = parametru_prog && pt. programul de Contracte - clienti si furnizori
					lcParametru_prog = Alltrim(Str(Nvl(lnParametru_prog, 0)))

					lnIdProgram = id_program
					lcIdProgram = Alltrim(Str(lnIdProgram))
					lcNumeProgram = Proper(Alltrim(explicatie))

					lcImagine = Upper(Alltrim(nume)) + ".png"				&&nume poza

					lcCaleImagine = gcappPath + 'grafice\' + lcImagine		&&cale imagine
					If !File(lcCaleImagine)
						lcImagine = 'na.png'
						lcCaleImagine = gcappPath + 'grafice\na.png'
					Endif
					lnIdGrupProg = id_grup_prog
					lnIdGrupProgFav = 0
					If Like([*.htm], Lower(Alltrim(nume))) Or Like([*.html], Lower(Alltrim(nume)))
						lcComandaProgram = dirgen + Iif(Empty(Director), Alltrim(nume), Alltrim(Director)) + [\] + ;
							Alltrim(nume)
					Else
						lcCaleProgram = dirgen + Iif(Empty(Director), Juststem(nume), Alltrim(Director)) + [\] + ;   &&cale program
							Juststem(Alltrim(nume)) + [.exe]
						lcParametru = gcHost + [;] + gcuserName + [;] + gcPassword + [;] + Alltrim(Str(gnIdUtil)) + [;] + ;
							lcIdProgram + [;] + lcParametru_prog + [;]  &&parametri
						lcComandaProgram = [run /n ] + lcCaleProgram + [ ] + lcParametru
					Endif


					lcImgNume = "img_" + lcIdProgram + "_" + lcParametru_prog

					If lnIdProgram > 0
						.AddObject(lcImgNume, 'img_program')
						.&lcImgNume..comanda_program = lcComandaProgram			&&adaug poza
						.&lcImgNume..Picture = lcImagine
						.&lcImgNume..ToolTipText = lcNumeProgram
						.&lcImgNume..Visible = .T.
					Endif

				Endscan
				.Dock(0)
				.Show
			Endwith
		Endif
	Endif

	If Used('v_programe_instalate')
		Use In v_programe_instalate
	Endif

	If Used('v_programe_favorite')
		Use In v_programe_favorite
	Endif

Endproc
***---------------------------------------------------------------------------------------------------------------------------------------
***---------------------------------------------------------------------------------------------------------------------------------------
Procedure ceretitlu_rap
	Parameters tcMesaj, tctitlu

	Local lcTitlu
	lcTitlu = tctitlu
	obj1 = Createobject("frm_cere_titlu")
	obj1.clb_tx_simplu1.lb_simplu1.Caption = tcMesaj
	obj1.clb_tx_simplu1.text_simplu1.ControlSource = 'lctitlu'
	obj1.Show(1)
	Return lcTitlu

Endproc
***---------------------------------------------------------------------------------------------------------------------------------------
Procedure cursor2lista
	Lparameters tcCursor, tcColumn, tcSeparator, tcFilter
	&& tcCursor - cursor
	&& tcColumn - coloana din cursor care va constitui lista
	&& tcSeparator separatorul de elemente din tcLista - default este ";" - este optional
	&& tcFilter - optional = filtru pentru tabel
	&& intoarce lista de valori separate prin separatori
	&& ex: lcLista = cursor2lista("cursor","id",";")

	Local lcLista, lcSeparator, lcSelect, lcFilter

	lcLista = ""
	lcSeparator = Iif(!Empty(tcSeparator) And Type('tcSeparator') = 'C', tcSeparator, ";")
	lcFilter = Iif(Empty(m.tcFilter), '.T.', m.tcFilter)
	If Used(tcCursor)
		lcSelect = Select()
		lcColumn = tcCursor + "." + tcColumn
		If Type(lcColumn) # 'U'
			Select * From (tcCursor) Into Cursor crsListaTemp

			Select crsListaTemp
			Scan For &lcFilter
				lcLista = lcLista + Alltrim(Transform(Evaluate(tcColumn))) + lcSeparator
			Endscan
			Use In crsListaTemp

			If !Empty(lcLista)
				lcLista = Left(lcLista, Len(lcLista) - 1)
			Endif
		Endif


		Select (lcSelect)
	Endif

	Return lcLista

Endproc && cursor2lista

***-------------------------------------------------------------------------------------------
***-------------------------------------------------------------------------------------------
Procedure GETCALLSTACK
	Local nPos
	nPos = Program(-1) - 2


	Local cCallStack, i
	cCallStack = ""
	For i = nPos To 1 Step - 1
		cCallStack = cCallStack + Program(i) + Chr(13) + Chr(10)
	Endfor


	Return cCallStack

Endproc && GETCALLSTACK
***-------------------------------------------------------------------------------------------
&& -------------------------- INCEPUT verific_cont ------------------------------
Procedure verific_cont
	Parameters tcCont, tlNoMessage

	Private pcCont
	pcCont = Alltrim(tcCont)

	&& verificare contului cu Planul de Conturi
	lcSel = [SELECT cont from ] + GCS + [.vplcont_sintetic WHERE TRIM(cont) = ?pcCont and an = ?gnAn ]
	lcCursor = 'crs_verific'
	lnSucces = goExecutor.oExecute(lcSel, lcCursor)
	If lnSucces < 0
		amessagebox(goExecutor.cEroare, 0 + 16, "Eroare")
	Endif

	If lnSucces > 0
		If Reccount('crs_verific') = 0
			lnSucces = -1
		Endif
	Endif

	If lnSucces < 0 And !tlNoMessage
		amessagebox('Acest cont nu este definit in planul de conturi!', 0 + 48, 'Atentie')
	Endif

	Return lnSucces

Endproc

&& -------------------------- SFARSIT verific_cont ------------------------------

* ===================== GetHash ====================================
* INTOARCE UN OBIECT DE TIP HASH CREAT DIN tcPropertyValueList
*!*	loHash = GetHash([cselect=>select id, name from test??cwhere=>id=pnId??corder=>name])
*!*	lnMembers = AMEMBERS(laMembers, loHash)
*!*	FOR i = 1 TO lnMembers
*!*		MESSAGEBOX(loHash.&laMembers(i))
*!*	ENDFOR
* ==================================================================
Function GetHash
	Lparameters tcPropertyValueList

	Local loHash

	loHash = Createobject("MyHash", tcPropertyValueList)
	Return loHash

Endfunc


* ===================== MyHash ====================================
* OBIECT EMULARE HASH
* loHash = GetHash([cselect=>select id, name from test??cwhere=>id=pnId??corder=>name])
* ==================================================================
Define Class MyHash As Custom


	Procedure ReadMe
		If .F.
			Local loHash
			loHash = Createobject("MyHash", [cselect=>select id, name from test??cwhere=>id=pnId??corder=>name])
		Endif
	Endproc && readme

	*!* sir "proprietate1=>valoare1??proprietate2=>valoare2"
	*!* genereaza proprietati si valori din sirul initial
	Procedure Init
		Lparameters tcPropertyValueList

		Local i, lnProperties, lcPropertyValue, lcValue, luValue

		&& tcPropertyValueList = [cselect =>ala bala portocala??cfiltru=>un filtru - atentie la spatiile din stanga valorii]
		If Type('tcPropertyValueList') = 'C' And !Empty(tcPropertyValueList)
			lnProperties = Getwordcount(tcPropertyValueList, '??')
			For i = 1 To lnProperties
				lcPropertyValue = Alltrim(Getwordnum(tcPropertyValueList, i, '??'))
				If At('=>', lcPropertyValue) > 0
					lcProperty = Getwordnum(Strtran(lcPropertyValue, '=>', Chr(18)), 1, Chr(18))
					lcValue =  Getwordnum(Strtran(lcPropertyValue, '=>', Chr(18)), 2, Chr(18))
					luValue = This.GetDefaultValue(lcProperty, lcValue)
					This.SetValue(lcProperty, luValue)
				Endif
			Endfor
		Endif
	Endproc && INIT

	*!* Seteaza valoarea unei proprietati daca exista sau adauga proprietatea, si intoarce valoarea
	Procedure SetValue
		Lparameters tcProperty, tuValue

		If Type('THIS.&tcProperty') <> 'U'
			This.&tcProperty = tuValue
		Else
			This.AddProperty(tcProperty, tuValue)
		Endif

		Return This.&tcProperty

	Endproc && SetValue

	*!* Intoarce valoarea unei proprietati daca exista, altfel valoarea empty() corespunzator tipului proprietatii
	Function GetValue
		Lparameters tcProperty

		Local lcProperty, luValue
		lcProperty = 'THIS.' + tcProperty

		If Type('THIS.&tcProperty') <> 'U'
			luValue = This.&tcProperty
		Else
			luValue = This.GetDefaultValue(tcProperty)
		Endif
		Return luValue

	Endfunc && GetValue

	*!* Intoarce valoarea empty() a unei proprietati dupa tip = prima litera din numele proprietatii daca nu primeste decat tcProperty
	*!* Converteste tcValue la tipul variabilei tcProperty  daca tcValue e primit ca parametru
	Function GetDefaultValue
		Lparameters tcProperty, tcValue

		Local lcType, luValue
		luValue = ""
		lcType = Upper(Left(tcProperty, 1))
		llEmptyValue = Iif(Pcount() = 1, .T., .F.)

		Do Case
			Case lcType $ "CM"
				luValue = Iif(llEmptyValue, '', tcValue)
			Case lcType $ "NIF"
				luValue = Iif(llEmptyValue, 0, Val(tcValue))
			Case lcType = "T"
				luValue = Iif(llEmptyValue, Dtot({}), Ctot(tcValue))
			Case lcType = "D"
				luValue = Iif(llEmptyValue, {}, Ctod(tcValue))
			Case lcType = "L"
				luValue = Iif(llEmptyValue, .F., Iif(tcValue = "1" Or Upper(tcValue) = "T" Or Upper(tcValue) = '.T.' Or Upper(tcValue) = 'YES', .T., .F.))
			Otherwise
				luValue = ""
		Endcase

		Return luValue
	Endfunc && GetDefaultValue

	*!* Intoarce .T. daca exista proprietatea
	Function HasProperty
		Lparameters tcProperty

		Local lcProperty, llReturn
		lcProperty = 'THIS.' + tcProperty
		llReturn = .F.

		If Type('THIS.&tcProperty') <> 'U'
			llReturn = .T.
		Endif

		Return llReturn

	Endfunc && HasProperty

Enddefine && Hash

Function  get_zileluc(  )

	lnzileluc = 0
	lcSql = [select zileluc from ] + GCS + [.sal_calendar where an=?gnan and luna=?gnluna]
	lcCursor = [v_zileluc]
	lnSucces = goExecutor.oExecute(lcSql, lcCursor)
	goExecutor.Oreset()
	If lnSucces < 0
		amessagebox(goExecutor.cEroare, 0 + 16, "Eroare")
		Return
	Else
		Select 	v_zileluc
		lnzileluc = zileluc
	Endif
	Return lnzileluc

	*******************************************
	* PROCEDURE param_listari( tcraport, tcTitlu, tcSemnaturi )
	* Date : 07/28/05, 14:04:21
	* author : liana.macinic
	* description:

	****** PARAMETER BLOCK **************
	* Parameters : 3
	* Parameter 1:
	* Parameter 2:
	* Parameter 3:
	*
	*******************************************
Procedure param_listari( tcraport, tctitlu, tcSemnaturi, tlFaraTab)
	Store '' To tctitlu, tcSemnaturi

	Local lnIdRaport
	If Used('v_raport')
		Use In v_raport
	Endif

	lcSql = [select id_raport,titlu from ] + GCS + [.sal_nom_rapoarte where UPPER(raport) = '] + Upper(Alltrim(tcraport)) + [']
	lcCursor = [v_raport]
	lnSucces = goExecutor.oExecute(lcSql, lcCursor)
	goExecutor.Oreset()
	If lnSucces < 0
		amessagebox(goExecutor.cEroare, 0 + 16, "Eroare")
		Return
	Endif
	Select v_raport
	lnIdRaport = v_raport.id_raport
	tctitlu = v_raport.titlu
	Use


	If Used('v_date')
		Use In v_date
	Endif

	lcSql = [select semnatura,NUME from ] + GCS + [.sal_semnaturi_rap where id_raport = ] + Alltrim(Str(lnIdRaport)) + [ and sters = 0  order by ordine]
	lcCursor = [v_date]
	lnSucces = goExecutor.oExecute(lcSql, lcCursor)
	goExecutor.Oreset()
	If lnSucces < 0
		amessagebox(goExecutor.cEroare, 0 + 16, "Eroare")
		Return
	Endif

	Local lcSemn, lcNumeRap, lcListaNumeRap
	Store '' To lcSemn, lcNumeRap, lcListaNumeRap


	Select v_date
	Scan
		Scatter Name lcDateRap Memo
		lcSemn = Alltrim(Nvl(lcDateRap.semnatura, ""))
		lcNumeRap = Alltrim(Nvl(lcDateRap.nume, ''))
		If Len(lcSemn) => Len(lcNumeRap)
			lcNumeRap = Padr(lcNumeRap, Len(lcSemn), " ")
		Else
			lcSemn = Padr(lcSemn, Len(lcNumeRap), " ")
		Endif
		If tlFaraTab
			tcSemnaturi = tcSemnaturi + lcSemn
		Else
			tcSemnaturi = tcSemnaturi + Chr(9) + Chr(9) + lcSemn
		Endif

		If tlFaraTab
			lcListaNumeRap = lcListaNumeRap + lcNumeRap
		Else
			lcListaNumeRap = lcListaNumeRap + + Chr(9) + Chr(9) + lcNumeRap
		Endif
	Endscan

	tcSemnaturi = tcSemnaturi + Chr(13) + lcListaNumeRap
	*!*	SELECT v_date
	*!*	SCAN
	*!*		tcSemnaturi = tcSemnaturi+CHR(9)+CHR(9)+ALLTRIM(v_date.nume)
	*!*	ENDSCAN
	*!*	tcSemnaturi = tcSemnaturi+CHR(9)+CHR(9)+CHR(9)+CHR(9)
	Select v_date
	Use
Endproc
*----------------------------------sfarsit procedura param_listari----------------------------------
** --------------------------------INCEPUT: facturi_duplicate ------------------------------
Procedure facturi_duplicate
	Parameters tcCont, tnId_Part, tcSerieAct, tnNract, tcMesajReturn

	Private pcCont, pnNract, pnId_part, pcSerieAct
	Local lcMesaj, MesajReturn
	lcMesaj = ''
	pcCont = Alltrim(tcCont)
	pnId_part = tnId_Part
	pnNract = tnNract
	pcSerieAct = Nvl(Iif(Empty(Alltrim(tcSerieAct)), Null, Alltrim(tcSerieAct)), '+_')
	lcMesajReturn = tcMesajReturn

	If !(Alltrim(Nvl(Alltrim(tcSerieAct), []) + ' ' + Allt(Str(pnNract))) $ lcMesajReturn)
		*!*	modificare ROAFACTURARE	v 2.0.46
		If Inlist(Allt(pcCont), '4111', '401', '404', '418', '408', '461', '462')
			*!*			If Inlist(Allt(pcCont),'4111','401','404')
			*!*	modificare ROAFACTURARE	v 2.0.46	^
			lnTotctva = 0
			Do Case
					*!*	modificare ROAFACTURARE	v 2.0.46
					*!*					Case Allt(pcCont) = '4111'
					*!*						lcSql = [select count(*) as nr_ireg, sum(debit) as debit from ireg_parteneri ]+;
					*!*							[ where an=?gnAn and luna=?gnLuna and cont = ?pcCont and nract = ?pnNract] + ;
					*!*							[ and NVL(serie_act,'+_') = ?pcSerieAct ]+;
					*!*							[ and extract(year from dataireg)*12+extract(month from dataireg) = ?gnAn*12+?gnLuna ]
					*!*						lcCursor = [crsFactDbl]
					*!*						lnSucces = goExecutor.oExecute(lcSql,lcCursor)
					*!*						goExecutor.Oreset()
					*!*						If lnSucces < 0
					*!*							AMESSAGEBOX(goExecutor.cEroare,0+16,'Eroare')
					*!*							Return
					*!*						Endif
					*!*						Select crsFactDbl
					*!*						If nr_ireg > 0
					*!*							lnTotctva = debit
					*!*							lcMesaj = 'Factura '+Alltrim(Alltrim(Nvl(tcSerieAct,[]))+' '+Allt(Str(pnNract))) + ", "+ Alltrim(Transform(lnTotctva, get_mask(14,GnPA)))+' lei, mai exista inregistrata in luna curenta.'
					*!*						Endif
				Case Inlist(Allt(pcCont), '4111', '418', '461')
					lcSql = [select count(*) as nr_ireg, sum(debit) as debit,] + ;
						[TO_NUMBER(NVL(pack_sesiune.getoptiunefirma('NRLUNIVERIFICARENRDOC'),0)) as nrluni ] + ;
						[from ireg_parteneri ] + ;
						[where an*12+luna between ] + Alltrim(Str(gnAn)) + [*12+] + Alltrim(Str(gnLuna)) + ;
						[-TO_NUMBER(NVL(pack_sesiune.getoptiunefirma('NRLUNIVERIFICARENRDOC'),0)) ] + ;
						[and ] + Alltrim(Str(gnAn)) + [*12+] + Alltrim(Str(gnLuna)) + [ ] + ;
						[and cont = '] + Alltrim(pcCont) + [' and nract = ] + Alltrim(Str(pnNract, 14, 0)) + [ ] + ;
						[and NVL(serie_act,'+_') = '] + pcSerieAct + [' ] + ;
						[and extract(year from dataireg)*12+extract(month from dataireg) between ] + ;
						Alltrim(Str(gnAn)) + [*12+] + Alltrim(Str(gnLuna)) + ;
						[-TO_NUMBER(NVL(pack_sesiune.getoptiunefirma('NRLUNIVERIFICARENRDOC'),0)) ] + ;
						[and ] + Alltrim(Str(gnAn)) + [*12+] + Alltrim(Str(gnLuna)) + [ ] + gcCondSucursala
					lcCursor = [crsFactDbl]
					lnSucces = goExecutor.oExecute(lcSql, lcCursor)
					goExecutor.Oreset()
					If lnSucces < 0
						amessagebox(goExecutor.cEroare, 0 + 16, 'Eroare')
						Return
					Endif

					Select crsFactDbl
					If nr_ireg > 0
						lnTotctva = debit
						lcPerioadaVerificare = Dtoc(Gomonth(Date(gnAn, gnLuna, 1), (-1) * NrLuni)) + [ - ] + ;
							Dtoc(Gomonth(Date(gnAn, gnLuna, 1), 1) - 1)
						lcMesaj = Iif(INLIST(Alltrim(pcCont), '4111', '461'), 'Factura', 'Avizul') + ' ' + Alltrim(Alltrim(Nvl(tcSerieAct, [])) + ' ' + ;
							  Allt(Str(pnNract, 20, 0))) + ", " + Alltrim(Transform(lnTotctva, get_mask(14, GnPc))) + ;
							' lei, mai este inregistrat' + Iif(INLIST(Alltrim(pcCont), '4111', '461'), 'a', '') + ' in perioada ' + lcPerioadaVerificare + '.'
					Endif
					Release pnNrLuni
					*!*	modificare ROAFACTURARE	v 2.0.46	^
				Case Inlist(Allt(pcCont), '401', '404', '408', '462')
					lcSql = [select count(*) as nr_ireg, sum(credit) as credit,] + ;
						[TO_NUMBER(NVL(pack_sesiune.getoptiunefirma('NRLUNIVERIFICARENRDOC'),0)) as nrluni ] + ;
						[ from ireg_parteneri ] + ;
						[ where an*12+luna between ] + Alltrim(Str(gnAn)) + [*12+] + Alltrim(Str(gnLuna)) + ;
						[-TO_NUMBER(NVL(pack_sesiune.getoptiunefirma('NRLUNIVERIFICARENRDOC'),0)) ] + ;
						[ and ] + Alltrim(Str(gnAn)) + [*12+] + Alltrim(Str(gnLuna)) + ;
						[ and cont = '] + Alltrim(pcCont) + [' and nract = ] + Alltrim(Str(pnNract, 14, 0)) + ;
						[ and NVL(serie_act,'+_') = '] + pcSerieAct + [' ] + ;
						[and extract(year from dataireg)*12+extract(month from dataireg) between ] + ;
						Alltrim(Str(gnAn)) + [*12+] + Alltrim(Str(gnLuna)) + ;
						[-TO_NUMBER(NVL(pack_sesiune.getoptiunefirma('NRLUNIVERIFICARENRDOC'),0)) ] + ;
						[and ] + Alltrim(Str(gnAn)) + [*12+] + Alltrim(Str(gnLuna)) + ;
						[ and id_part = ] + Alltrim(Str(m.pnId_part)) + [ ] + gcCondSucursala
					lcCursor = [crsFactDbl]
					lnSucces = goExecutor.oExecute(lcSql, lcCursor)
					goExecutor.Oreset()

					If lnSucces < 0
						amessagebox(goExecutor.cEroare, 0 + 16, 'Eroare')
						Return
					Endif

					Select crsFactDbl
					If nr_ireg > 0
						lnTotctva = credit
						lcPerioadaVerificare = Dtoc(Gomonth(Date(gnAn, gnLuna, 1), (-1) * NrLuni)) + [ - ] + ;
							Dtoc(Gomonth(Date(gnAn, gnLuna, 1), 1) - 1)
						lcMesaj = 'Factura ' + Alltrim(Alltrim(Nvl(tcSerieAct, [])) + ' ' + Allt(Str(pnNract,20,0))) + ", " + Alltrim(Transform(lnTotctva, get_mask(14, GnPc))) + ' lei, mai exista inregistrata in perioada ' + lcPerioadaVerificare + '.'
					Endif
					*!*	modificare	v 2.0.132
					*!*			Case Allt(pcCont) = '404'
					*!*				lcSql = [select count(*) as nr_ireg, sum(credit) as credit from vireg_parteneri ]+;
					*!*					[ where an=?gnAn and luna=?gnLuna and cont = ?pcCont and nract = ?pnNract]+;
					*!*					[ and NVL(serie_act,'+_') = ?pcSerieAct ]+;
					*!*					[ and extract(year from dataireg)*12+extract(month from dataireg) = ?gnAn*12+?gnLuna ]+;
					*!*					[ and id_part = ?pnId_part]
					*!*				lcCursor = [crsFactDbl]
					*!*				lnSucces = goExecutor.oExecute(lcSql,lcCursor)
					*!*				goExecutor.Oreset()

					*!*				If lnSucces < 0
					*!*					AMESSAGEBOX(goExecutor.cEroare,0+16,'Eroare')
					*!*					Return
					*!*				Endif

					*!*				Select crsFactDbl
					*!*				If nr_ireg > 0
					*!*					lnTotctva = credit
					*!*					lcMesaj = 'Factura '+Alltrim(Alltrim(Nvl(tcSerieAct,[]))+' '+Allt(Str(pnNract)))+ ", "+ Alltrim(Transform(lnTotctva, get_mask(14,GnPA)))+' lei, mai exista inregistrata in luna curenta.'
					*!*				Endif
					*!*	modificare	v 2.0.132	^
			Endcase

		Endif
	Endif

	Return lcMesaj

Endproc  && facturi_duplicate
&& ------------------------------SFARSIT: facturi_duplicate ------------------------------

********************************************
*** Verifica un numar si serie (optional) de factura clienti in vanzari in luna curenta
*** Intoarce .T. daca exista numarul de factura in luna curenta
********************************************
Function VerificaFacturaClientiVanzari
	Lparameters tnNrFactura, tcSerieFactura
	* tcSerieFactura (optional)

	Private pnNrFactura, pcSerieFactura, pnCount
	Local lcSql, llSucces, lcSelect, llExista

	lcSelect = Select()
	pnNrFactura = tnNrFactura
	pcSerieFactura = Iif(!Empty(Nvl(m.tcSerieFactura, '')), Alltrim(Transform(m.tcSerieFactura)), '')
	pnCount = 0

	lcSql = [SELECT COUNT(*) as nr FROM vanzari WHERE numar_act = ?pnNrFactura ] + Iif(!Empty(m.pcSerieFactura), [AND serie_act = ?pcSerieFactura ], []) + [AND extract(year FROM data_act) = ?gnAn AND extract(month FROM data_act) = ?gnLuna and sters = 0]
	llSucces = goExecutor.oSelecteaza2Value(m.lcSql, @pnCount)
	llExista = Nvl(m.pnCount, 0) > 0

	Select (m.lcSelect)
	Return m.llExista
Endfunc && VerificaNumarFacturaVanzari

************************************ EncryptDecrypt	****************************************
*!* EncryptDecrypt
*!* EX: EncryptDecrypt("text to encrypt", "encrypt key", "encrypt")
*!* EX: EncryptDecrypt("text to decrypt", "decrypt key", "decrypt")
*!* EX: EncryptDecrypt("text to encrypt", "encrypt key", "encrypt","blowfish")
Function EncryptDecrypt
	Lparameters tcText, tcPassword, tcMode, tcAlgorithm
	&& tcMode : ENCRYPT/DECRYPT
	Local lcAlgorithm, lcReturn, lcString, lcPWD
	Local loException As Exception
	m.lcString = tcText
	m.lcPWD = tcPassword
	m.lcReturn = ""
	lcAlgorithm = ""
	If Type('tcAlgorithm') = 'C'
		lcAlgorithm = tcAlgorithm
	Endif
	If lcAlgorithm = "blowfish"
		If Upper(Alltrim(Transform(tcMode))) = "ENCRYPT"
			lcReturn = Encrypt(m.lcString, m.lcPWD, 4, 0)
		Else
			Try
				lcReturn = decrypt(m.lcString, Alltrim(m.lcPWD), 4, 0)
			Catch To loException
				If loException.ErrorNo = 2028
					polog.Log("S-a incercat decriptarea unui text care nu a fost generat cu algoritmul de criptare selectat.", Program())
				Else
					polog.Log(loException.Message, Program())
				Endif
			Endtry
		Endif
	Endif
	*!* 18.03.2008 : am scos chr(0) de la sfarsitul textului decriptat
	If At(Chr(0), m.lcReturn) > 0 And Upper(Alltrim(Transform(tcMode))) != "ENCRYPT"
		m.lcReturn = Substr(m.lcReturn, 1, At(Chr(0), m.lcReturn) - 1)
	Endif
	*!* 18.03.2008
	Return m.lcReturn
Endfunc && EncryptDecrypt
*!*	Function EncryptDecrypt
*!*	Lparameters tcText, tcPassword, tcMode, tcAlgorithm
*!*	&& tcMode : ENCRYPT/DECRYPT
*!*	*!*		IF 	!'crypto'$LOWER(SET("Classlib"))
*!*	*!*			SET CLASSLIB TO CRYPTO.VCX ADDITIVE
*!*	*!*		ENDIF
*!*	Local loCryptor, llNewCryptFll, lcAlgorithm
*!*	loCryptor = Newobject("MyCrypt","crypto.vcx")
*!*	Local loException As Exception
*!*	Local lcReturn, lcString, lcPWD
*!*	m.lcString = tcText
*!*	m.lcPWD = tcPassword
*!*	m.lcReturn = ""
*!*	llNewCryptFll = .F.
*!*	If Type('gnewcryptfll') <> 'U'
*!*		llNewCryptFll = gnewcryptfll
*!*	Endif
*!*	lcAlgorithm = ""
*!*	If Type('tcAlgorithm') = 'C'
*!*		lcAlgorithm = tcAlgorithm
*!*	Endif
*!*	If !(lcAlgorithm = "blowfish" And llNewCryptFll)
*!*		If Upper(Alltrim(Transform(tcMode))) = "ENCRYPT"
*!*			loCryptor.EncryptSessionStreamString( m.lcString, m.lcPWD, @lcReturn)
*!*		Else
*!*			Try
*!*				loCryptor.EncryptSessionStreamString( m.lcString, m.lcPWD, @lcReturn)
*!*			Catch To loException
*!*				If loException.ErrorNo=2028
*!*					polog.Log("S-a incercat decriptarea unui text care nu a fost generat cu algoritmul de criptare selectat.",Program())
*!*				Else
*!*					polog.Log(loException.Message,Program())
*!*				Endif
*!*			Endtry
*!*		Endif
*!*	Else
*!*		If Upper(Alltrim(Transform(tcMode))) = "ENCRYPT"
*!*			lcReturn=Encrypt(m.lcString, m.lcPWD,4,0)
*!*		Else
*!*			Try
*!*				lcReturn=decrypt(m.lcString, Alltrim(m.lcPWD),4,0)
*!*			Catch To loException
*!*				If loException.ErrorNo=2028
*!*					polog.Log("S-a incercat decriptarea unui text care nu a fost generat cu algoritmul de criptare selectat.",Program())
*!*				Else
*!*					polog.Log(loException.Message,Program())
*!*				Endif
*!*			Endtry
*!*		Endif
*!*	Endif
*!*	Release oCryptor
*!*	*!* 18.03.2008
*!*	*!* am scos chr(0) de la sfarsitul textului decriptat
*!*	If At(Chr(0),m.lcReturn) > 0 And Upper(Alltrim(Transform(tcMode))) != "ENCRYPT"
*!*		m.lcReturn = Substr(m.lcReturn, 1, At(Chr(0),m.lcReturn)-1)
*!*	Endif
*!*	*!* 18.03.2008
*!*	Return m.lcReturn
*!*	Endfunc && EncryptDecrypt
************************************ EncryptDecrypt	****************************************
Procedure lansare_help

	Do viz_prg_instalat In oproceduri_comune.prg

	If Used('v_programe_instalate') And Reccount('v_programe_instalate') > 0
		If Used('v_help')
			Use In v_help
		Endif
		Select * From v_programe_instalate Where !Isnull(gruphelp) And nume == gcappname Into Cursor v_help
		If Used('v_programe_instalate')
			Use In v_programe_instalate
		Endif
		ohelp = Createobject('toolhelp')

		With ohelp.tool_help1
			lcImgNume = 'HELP'
			.AddObject(lcImgNume, 'img_help')
			If Used('v_help') And Reccount('v_help') > 0 And !Empty(gcCaleHelp)

				Select v_help
				Local lcgrup, lcNume, lcIndex
				lcgrup = Nvl(Alltrim(v_help.gruphelp), '')
				lcNume = Nvl(Alltrim(v_help.numehelp), '')
				lcIndex = Nvl(Alltrim(v_help.indexhelp), '')
				lcComanda = dirgen + gcCaleHelp + '\' + lcgrup + '\' + lcNume + '\' + lcIndex
				If File(lcComanda)
					.&lcImgNume..Picture = '_active_help.ico' &&adaug poza
					.&lcImgNume..comanda_program = lcComanda
				Else
					.&lcImgNume..comanda_program = 'INACTIV'
				Endif
			Else
				.&lcImgNume..comanda_program = 'INACTIV'
			Endif
			.&lcImgNume..ToolTipText = 'Ajutor (F1)'
			.&lcImgNume..Visible = .T.

			*!*	modificare	17.11.2011
			.AddObject('stromfast', 'img_program')
			With .stromfast
				.Picture = 'romfast_suport.png'
				.comanda_program = 'romfast_suport.exe'
				.ToolTipText = 'ROMFAST suport tehnic (ALT+R)'
				.Visible = .T.
			Endwith
			*!*	modificare	17.11.2011	^

			*!*	modificare	04.04.2016
			.AddObject('screenshot', 'img_program')
			With .screenshot
				.Picture = 'screenshot.png'
				.comanda_program = 'roascreenshot.exe'
				.ToolTipText = 'Captura ecran si email (ALT+S)'
				.Visible = .T.
			Endwith
			*!*	modificare	17.11.2011

			.AddObject('chatbot', 'img_program')
			With .chatbot
				.Picture = 'chatbot.png'
				.comanda_program = 'chatbot'
				.ToolTipText = 'Chatbot Suport Tehnic (ALT+C)'
				.Visible = .T.
			Endwith

			.Dock(0)
			.Show
		Endwith
	Endif
	If Used('v_help')
		Use In v_help
	Endif

Endproc
*****************************************************

Procedure lansare_help_meniu

	If Type('ohelp.tool_help1') <> 'O'
		Return
	Endif
	If  !Empty(ohelp.tool_help1.Help.comanda_program)
		If ohelp.tool_help1.Help.comanda_program <> 'INACTIV'
			OPEN_DEFAULT_APP(ohelp.tool_help1.Help.comanda_program)
		Else
			amessagebox("Manualul de utilizare nu este configurat corect!", 0 + 48, "Atentie")
		Endif
	Else
		amessagebox("Manualul de utilizare nu este instalat!", 0 + 48, "Atentie")
	Endif

Endproc
*****************************************************
Function getUserDocPath
	Local lcAppPath, lcAppName, liAt, lcDirgen, lcUserDocPath
	lcAppPath = Addbs(shortpath(Justpath(Sys(16, 0))))
	lcAppName = Allt(Uppe(Juststem(Sys(16, 0))))
	liAt = Rat("\", lcAppPath, 2)
	lcDirgen = Addbs(Left(lcAppPath, liAt - 1))
	lcUserDocPath = lcDirgen + 'USERDOCSS\'
	If !Directory(lcUserDocPath)
		Md (lcUserDocPath)
	Endif
	lcUserDocPath = lcUserDocPath + lcAppName + '\'
	If !Directory(lcUserDocPath)
		Md (lcUserDocPath)
	Endif
	lcUserDocPath = lcUserDocPath + GCS + '\'
	If !Directory(lcUserDocPath)
		Md (lcUserDocPath)
	Endif

	Return lcUserDocPath

Endfunc
*****************************************************
Procedure copiaza_structura_cursor
	Lparameters tcSursa, tcDestinatie
	If !Empty(tcSursa) And !Empty(tcDestinatie)
		If Used(tcSursa)
			Dimension laStructura(1, 18)
			If Used(tcDestinatie)
				Use In (tcDestinatie)
			Endif
			Afields(laStructura, tcSursa)
			Create Cursor (tcDestinatie) From Array laStructura
			Release laStructura
		Else
			amessagebox("Eroare interna 2 - copiaza structura cursor", 16, "Eroare")
		Endif
	Else
		amessagebox("Eroare interna 1 - copiaza structura cursor", 16, "Eroare")
	Endif
Endproc	&&	copiaza_structura_cursor
*********************************************************************************************************
Function citeste_optiune_firma
	Lparameters tcOptiune, tlNumeProgram
	Local lcCursor, lcVarType, luReturnValue
	lcCursor = [crsoptiunefirma]
	If Used(lcCursor)
		Use In (lcCursor)
	Endif
	lcSql = [select varvalue,vartype from optiuni where varname = '] + Alltrim(tcOptiune) + ['] + ;
		Iif(tlNumeProgram, [ and program = '] + Alltrim(gcNumeProgram) + ['], [])
	lnSucces = goExecutor.oExecute(lcSql, lcCursor)
	If lnSucces < 0
		amessagebox(goExecutor.cEroare, 16, "Eroare")
		luReturnValue = Null
	Else
		If Reccount(lcCursor) > 0
			Select (lcCursor)
			lcVarType = Upper(Alltrim(&lcCursor..Vartype))
			Do Case
				Case lcVarType = "CHARACTER"
					luReturnValue = Alltrim(&lcCursor..varvalue)
				Case lcVarType = "CURRENCY"
					luReturnValue = Ntom(Val(&lcCursor..varvalue))
				Case lcVarType = "NUMERIC"
					luReturnValue = Val(&lcCursor..varvalue)
				Case lcVarType = "DATETIME"
					luReturnValue = Ctot(&lcCursor..varvalue)
				Case lcVarType = "DATE"
					luReturnValue = Ctod(&lcCursor..varvalue)
				Case lcVarType = "LOGICAL"
					luReturnValue = Iif(Inlist(Upper(Left(&lcCursor..varvalue, 1)), "T", "Y"), .T., .F.)
				Otherwise
					pcmsgbuff = "Tip de variabila globala invalid!"
					pcmsgbuff = pcmsgbuff + Chr(13) + Chr(13) + "Numele variabilei: " + lcvarname
					pcmsgbuff = pcmsgbuff + Chr(13) + "Tipul variabilei: " + lcVarType
					pcmsgbuff = pcmsgbuff + Chr(13) + Chr(13) + "Contactati suportul tehnic."
					= amessagebox(pcmsgbuff, 48)
					pcmsgbuff = ""
					luReturnValue = Null
			Endcase
		Else
			amessagebox("Nu a fost gasita optiunea '" + tcOptiune + "' !", 16, "Eroare")
			luReturnValue = Null
		Endif
		Use In (lcCursor)
	Endif

	Return luReturnValue
Endfunc
*********************************************************************************************************
Procedure debug_dezvoltare
	If Messagebox("Porniti debug?", 32 + 4 + 256, "Confirmare") = 6
		Debug
		Suspend
	Endif
Endproc	&&	debug_dezvoltare
*********************************************************************************************************


****************************	inceput nvl2Default *****************************************************
Procedure nvl2Default
	Lparameters tcTableAlias, tcCampuriNull
	*	updatateaza cursorul si pune o valoare default pe toate coloanele, ;
	cu exceptia celor din tcCampuriNull
	*	tcCampuriNull primeste lista de campuri separate prin ',' care nu vor fi modificate ;
	de ex: "camp1,camp2,"

	Local lnNrCol, i, lcSql, lctip, lcCampuriNull

	lctip = []
	lcSql = [update ] + tcTableAlias + [ set ]
	lcCampuriNull = Iif(Type("tcCampuriNull") = "L", [], tcCampuriNull)
	lcCampuriNull = Upper(Nvl(lcCampuriNull, []))
	If Right(lcCampuriNull, 1) # ","	And Len(lcCampuriNull) > 0
		lcCampuriNull = lcCampuriNull + [,]
	Endif

	Select(tcTableAlias)
	lnNrCol = Afields(laCols)

	For i = 1 To lnNrCol
		If (laCols(i, 1) + [,]) $ lcCampuriNull
			Loop
		Endif		&& daca este in lista, nu il adaugam

		If laCols(i, 2) = "C" Or laCols(i, 2) = "M" Or laCols(i, 2) = "V"
			lctip = ['']		&& character, memo, varchar
		Endif
		If laCols(i, 2) = "B" Or laCols(i, 2) = "F" Or laCols(i, 2) = "I" Or laCols(i, 2) = "N"
			lctip = [0]		&& double, float, integer, numeric
		Endif
		If laCols(i, 2) = "L"
			lctip = [.f.]	&& logic
		Endif
		If laCols(i, 2) = "T" Or laCols(i, 2) = "D"
			lctip = [{}]
		Endif				&& date, datetime

		lcSql = lcSql + laCols(i, 1) + [ = NVL(] + laCols(i, 1) + [,] + lctip + [), ]
	Endfor

	lcSql = Left(lcSql, Rat(',', lcSql) - 1)
	&lcSql
	Go Top		&&	nu facea update in xitems pe coloanele xinputmask, filtru de pe ultima linie

Endproc				&& nvl2Default ^
*************************************************************************************************

Procedure versiune
	Lparameters lcvers

	External Array laVers
	Local lcVersiune, lnNr
	lcVersiune = []

	lnNr = Alines(laVers, Nvl(lcvers, []), .T., ".")
	If lnNr > 0
		For i = 1 To lnNr
			laVers(i) = Replicate("0", 3 - Len(Alltrim(Nvl(laVers(i), [])))) + laVers(i)
			lcVersiune = lcVersiune + laVers(i) + "."
		Endfor
		lcVersiune = Left(lcVersiune, Len(lcVersiune) - 1)
	Else
		lcVersiune = lcvers
	Endif
	Return lcVersiune

Endproc				&& sfarsit versiune ^
*************************************************************************************************
*********************************************************************************************************
Function sir2array
	Lparameters tcSir, taArray, tcSeparator

	Local lcSeparator, lnValues, i, lcValue, luValue, lnPos

	External Array taArray

	If Empty(tcSeparator)
		lcSeparator = ';'
	Else
		lcSeparator = tcSeparator
	Endif

	lnValues = Alines(taArray, tcSir, 4, lcSeparator)

	Return lnValues

Endfunc && sir2array
*********************************************************************************************************
***************************
Function TooManyInstances(lnInstancesAllowed)
	***************************
	#Define GW_CHILD                5 && 0x00000005
	#Define GW_HWNDNEXT                2 && 0x00000002
	#Define SW_MAXIMIZE                3 && 0x00000003
	#Define SW_NORMAL                1 && 0x00000001
	#Define WAIT_OBJECT_0            0 && 0x00000000
	#Define RF_MESAJ				0xA123

	Local lcUniqueProperty, lcUniqueSemaphore, lnhSemaphore, lnHwnd, llReturn
	If Pcount() = 0
		lnInstancesAllowed = 1 && default
	Else
		lnInstancesAllowed = Max(lnInstancesAllowed, 1) &&At least one
	Endif
	Do DeclareAPIs
	lcUniqueSemaphore = Strtran(Justpath(Sys(16, 0)), "\", "")
	*!*	    lcUniqueSemaphore = "968360BF-C7AD-4B62-A045-0A06D597EF18"
	lcUniqueProperty = "E2429959-D873-4733-8182-7A3F14780A27"
	&&&
	*!*	     oTypeLib = CreateObject("scriptlet.typelib")
	*!*	     lcUniqueSemaphore = substr(oTypeLib.GUID, 2, 36)
	*!*	         oTypeLib1 = CreateObject("scriptlet.typelib")
	*!*	      lcUniqueProperty = substr(oTypeLib1.GUID, 2, 36)
	&&&
	lnhSemaphore = CreateSemaphore(0, lnInstancesAllowed, lnInstancesAllowed, lcUniqueSemaphore)
	If lnhSemaphore != 0 And WaitForSingleObject(lnhSemaphore, 0) != WAIT_OBJECT_0
		Do DeclareMoreAPIs
		llReturn = .T.
		lnHwnd = GetWindow(GetDesktopWindow(), GW_CHILD)
		Do While lnHwnd != 0 && loop through all windows
			If GetProp(lnHwnd, lcUniqueProperty) = 1  && does window have our unique property?
				BringWindowToTop(lnHwnd)
				*!*	modificare	v 2.0.23
				If IsIconic(lnHwnd) <> 0
					SendMessage(lnHwnd, RF_MESAJ, 0, 0)
				Else
					*!*	modificare	v 2.0.23	^
					ShowWindow(lnHwnd, SW_NORMAL)
					*!*	modificare	v 2.0.23
				Endif
				*!*	modificare	v 2.0.23	^
				llReturn = .T.
				Exit
			Endif
			lnHwnd = GetWindow(lnHwnd, GW_HWNDNEXT)
		Enddo
		CloseHandle(lnHwnd)
		CloseHandle(lnhSemaphore)
		Clear Dlls "BringWindowToTop", "GetDesktopWindow", ;
			"GetProp", "GetWindow", "ShowWindow", ;
			"CloseHandle", "SendMessage", "IsIconic"
	Else
		= SetProp(_vfp.HWnd, lcUniqueProperty, 1)
		_Screen.AddProperty("SemaphoreHandle", lnhSemaphore)
		llReturn = .F.
	Endif
	Clear Dlls "CreateSemaphore", "GetLastError", ;
		"SetProp"
	Return (llReturn)
Endfunc
*************************************************************************************************************************
***************************
Procedure DeclareAPIs()
	***************************
	Declare Integer CloseHandle In Kernel32 Integer hObject
	Declare Integer CreateSemaphore In Kernel32 Integer lpSemaphoreAttributes, Integer lInitialCount, Integer lMaximumCount, String lpName
	Declare Integer SetProp In User32 Integer HWnd, String lpString, Integer hData
	Declare Integer WaitForSingleObject In Kernel32 Integer hHandle, Integer dwMilliseconds
Endproc
*************************************************************************************************************************
***************************
Procedure DeclareMoreAPIs()
	***************************
	Declare Integer BringWindowToTop In Win32API Integer HWnd
	Declare Integer GetDesktopWindow In User32
	Declare Integer GetProp In User32 Integer HWnd, String  lpString
	Declare Integer GetWindow In User32 Integer HWnd, Integer uCmd
	Declare Integer ShowWindow In Win32API Integer HWnd, Integer nCmdShow
	*!*	modificare	v 2.0.23
	Declare Integer SendMessage In User32 Integer HWnd, Integer Msg, Integer wParam, Integer Lparam
	Declare Integer IsIconic In User32 Integer HWnd
	*!*	modificare	v 2.0.23	^
Endproc
*************************************************************************************************************************

**************************************************************************************************
*!* INTOARCE VALOAREA NOTNULL DACA EXPRESIA NU ESTE NULL SAU VALOAREA NULL DACA EXPRESIA ESTE NULL
**************************************************************************************************
Function nvl2
	Lparameters tcExpression, tuValueIfNotNull, tuValueIfNull
	Local luReturn
	luReturn = tuValueIfNotNull

	If Isnull(tcExpression)
		luReturn = tuValueIfNull
	Endif

	Return luReturn
Endfunc && nvl2
************************************************************************************************************
Procedure alege_vizualizare_raport
	Lparameters tcCursorRaport, tcraport
	Private pnButon, pnOptiune
	If Reccount(tcCursorRaport) > 0
		pnButon = 1
		Do While pnButon = 1
			pnOptiune = 1
			ofrmaleg = Createobject('frm_aleg_vizualizare')
			ofrmaleg.Show(1)
			Do Case
				Case pnButon <> 1
					Loop
				Case pnOptiune = 1
					goExport.export2frx(tcCursorRaport, tcraport)
				Case pnOptiune = 2
					goExport.export2xls(tcCursorRaport)
					&&	tcAlias, tcNumeFisier, tcListaColoane, tcFiltru
			Endcase
			Release ofrmaleg
		Enddo
	Else
		amessagebox("Nu exista inregistrari pentru listare!", 0 + 48, "Atentie")
	Endif
	Use In (tcCursorRaport)
	Release pnButon, pnOptiune
Endproc
************************************************************************************************************
****************************
*!* Demonstrates the callback functionality
****************************
*!*	SET LIBRARY TO LOCFILE("vfpcompression.fll")
*!*	ZipCallback("MyUnzipCallBack()") && Start Event Handling - Any Function/Procedure/Method (in scope of course)
*!*	?ZipOpen("MyZip.zip", "C:\", .F.) && create zip file
*!*	?ZipFile("C:\MyFile.txt", .F.) && compress file into zip
*!*	?ZipClose() && done zipping
*!*	?UnzipQuick("C:\MyZip.zip", "C:\") && unzip contents of Test.zip to C:\
*!*	ZipCallback("") && Stop Event Handling
*!*	SET LIBRARY TO
Function MyUnzipCallBack
	Lparameters tnBytesTotal
	*****************************
	*!* Variables below are created on the fly
	*!* by the FLL when the ZipCallback feature is used

	*!* Depends on the value of nZipEvent
	*!* cZipObjectName && Name of Zip, File, or Folder being processed

	*!* Events that fire MyCallback
	*!* 0 = Open Zip
	*!* 1 = Start Zip/Unzip of File
	*!* 2 = Read/Write File (nZipBytes will contain value of bytes read for event)
	*!* 3 - End Zip/Unzip of File
	*!* 4 - Folder Opened
	*!* 5 - Close Zip
	If nZipEvent = 2
		*!* Number of Bytes read (Event 3)
		If !Empty(m.tnBytesTotal)
			Wait Window cZipObjectName + ' ' + Transform(Int(m.nZipBytes / m.tnBytesTotal * 100)) + '% ...' Nowait
		Else
			Wait Window cZipObjectName + ' ' + Transform(m.nZipBytes) + ' bytes read' Nowait
		Endif
	Endif
Endfunc && MyUnzipCallBack
************************************************************************************************************
*** Callback from the vfpconnection FLL - can be used to track operation progress
Procedure MyProgressHandler
	Lparameters tcFile
	Local lnProgress, lcFile

	lnProgress = 0
	lcFile = Iif(Empty(m.tcFile) Or Type('tcFile') <> 'C', '', m.tcFile)
	If m.nConnectTotalBytes > 0
		m.lnProgress = Int(m.nConnectBytesSoFar / m.nConnectTotalBytes * 100)
	Endif

	Wait Window m.lcFile + ' ' + Transform(m.lnProgress) + '% ...' Nowait
Endproc && MyProgressHandler
************************************************************************************************************
Procedure apeleaza_calc
	Do Case
		Case File('C:\WINDOWS\CALC.EXE')
			Run /N C:\Windows\Calc.Exe
		Case File('C:\WINDOWS\SYSTEM32\CALC.EXE')
			Run /N C:\Windows\SYSTEM32\Calc.Exe
		Case File('C:\WINnt\system32\CALC.EXE')
			Run /N C:\WINnt\SYSTEM32\Calc.Exe
		Otherwise
			lcMesaj = 'Aplicatia "Calculator" nu este instalata pe acest sistem!'
			amessagebox(lcMesaj, 0 + 48, Iif(!Empty(Nvl(gcNumeProgram, [])), gcNumeProgram, "Atentie"))
	Endcase
Endproc
*************************************************************************
Procedure apeleaza_notepad
	Do Case
		Case File('C:\WINDOWS\NOTEPAD.EXE')
			Run /N C:\Windows\NOTEPAD.Exe
		Case File('C:\WINnt\system32\NOTEPAD.EXE')
			Run /N C:\WINnt\SYSTEM32\NOTEPAD.Exe
		Otherwise
			lcMesaj = 'Aplicatia "Notepad" nu este instalata pe acest sistem!'
			amessagebox(lcMesaj, 0 + 48, Iif(!Empty(Nvl(gcNumeProgram, [])), gcNumeProgram, "Atentie"))
	Endcase
Endproc
*************************************************************************
Procedure arata_modificari
	Do Form frm_changelog
Endproc
*************************************************************************
Procedure arata_versiune
	Do Form frm_about
Endproc
*************************************************************************
Procedure arata_manual
	lansare_help_meniu()
Endproc
*************************************************************************


Function aInputBox
	Lparameters tcPrompt, tcTitle, txDefaultValue, tnLeft, tnTop, ;
		tcFormat, tcInputMask, tcPasswordChar
	Private pcReturnValue
	pcReturnValue = txDefaultValue
	Local oInputBox
	oInputBox = Createobject("aInputBox", tcPrompt, tcTitle, ;
		  txDefaultValue, tnLeft, tnTop, ;
		  tcFormat, tcInputMask, tcPasswordChar)
	oInputBox.Show()
	Return pcReturnValue
Endfunc && aInputBox

**************************************************
Define Class aInputBox As Form


	Height = 113
	Width = 318
	DoCreate = .T.
	AutoCenter = .T.
	Caption = "Input Box"
	ControlBox = .F.
	WindowType = 1
	Name = "frmInputBox"

	*-- empty value to return if Cancel is chosen; data type depends on data type of txValueIn
	xemptyvalue = .F.

	*-- the default value (if any)
	xdefaultvalue = .F.

	*-- the return value
	xreturnvalue = .F.


	Add Object lblinputbox As Label With ;
		FontName = "Arial", ;
		FontSize = 10, ;
		FontCharSet = 238, ;
		Alignment = 1, ;
		Caption = "Introduceti valoarea ", ;
		Height = 20, ;
		Left = 6, ;
		Top = 26, ;
		Width = 190, ;
		TabIndex = 1, ;
		Name = "lblInputBox"


	Add Object txtinputbox As TextBox With ;
		FontName = "Arial", ;
		FontSize = 10, ;
		Century = 1, ;
		Height = 24, ;
		Left = 202, ;
		SelectOnEntry = .T., ;
		TabIndex = 2, ;
		Top = 22, ;
		Width = 110, ;
		Name = "txtInputBox"


	Add Object cmdok As CommandButton With ;
		Top = 72, ;
		Left = 84, ;
		Height = 24, ;
		Width = 72, ;
		Caption = "Confirma", ;
		FontCharSet = 238, ;
		Default = .T., ;
		TabIndex = 3, ;
		Name = "cmdOK"


	Add Object cmdcancel As CommandButton With ;
		Top = 72, ;
		Left = 172, ;
		Height = 24, ;
		Width = 72, ;
		Cancel = .T., ;
		Caption = "Renunta", ;
		FontCharSet = 238, ;
		TabIndex = 4, ;
		Name = "cmdCancel"


	Procedure Unload
		With Thisform
			If Type(".xReturnValue") = "C"
				.xreturnvalue = Rtrim( .xreturnvalue)
			Endif
			pcReturnValue = .xreturnvalue
		Endwith
	Endproc


	Procedure Init
		Lparameters tcPrompt, tcTitle, txDefaultValue, tnLeft, tnTop, ;
			tcFormat, tcInputMask, tcPasswordChar
		If Type("tcPrompt") <> "C"
			tcPrompt = "Introduceti valoarea "
		Endif
		If Type("tcTitle") <> "C"
			tcTitle = "Input Box"
		Endif
		If !( Type("txDefaultValue") $ "CDNY")
			*	Valid input data types are C, D, N, and Y
			txDefaultValue = ""	&& default to character data type
		Endif
		If Type("tcFormat") <> "C"
			tcFormat = ""
		Endif
		If Type("tcInputMask") <> "C"
			tcInputMask = ""
		Endif
		If Type("tcPasswordChar") <> "C"
			tcPasswordChar = ""
		Endif
		If Len( Alltrim( tcPasswordChar)) > 1
			tcPasswordChar = Left( tcPasswordChar, 1)
		Endif
		Local llAutoCenter
		If Pcount() < 5	&& Top and Left parameters were not passed
			tnLeft = 0
			tnTop = 0
		Else	&& Top and left parameters were passed but may not be numeric
			If Type("tnTop") = "N" And Type("tnLeft") = "N"		&& both are numeric
				llAutoCenter = .F.
			Else	&& one or both is not numeric, so AutoCenter the form
				tnLeft = 0
				tnTop = 0
				llAutoCenter = .T.
			Endif
		Endif

		With Thisform
			.lblinputbox.Caption = Alltrim( tcPrompt)
			.Caption = Alltrim( tcTitle)
			.xdefaultvalue = txDefaultValue
			.xreturnvalue = .xdefaultvalue
			.txtinputbox.Value = .xdefaultvalue
			.txtinputbox.Format = Alltrim( tcFormat)
			.txtinputbox.InputMask = Alltrim( tcInputMask)
			.txtinputbox.PasswordChar = tcPasswordChar
			.Top = tnTop
			.Left = tnLeft
			.AutoCenter = llAutoCenter		&& Set AutoCenter last so it overrides Top and Left if .T.

			Do Case
				Case Type("txDefaultValue") = "D"
					.xemptyvalue = {}
				Case Type("txDefaultValue") = "N"
					.xemptyvalue = 0
				Case Type("txDefaultValue") = "Y"
					.xemptyvalue = $ 0
				Otherwise
					.xemptyvalue = ""
			Endcase
		Endwith
	Endproc


	Procedure cmdok.Click
		With Thisform
			.xreturnvalue = .txtinputbox.Value
			.Release()
		Endwith
	Endproc


	Procedure cmdcancel.Click
		*
		*	If Cancel was chosen, return the empty value of the correct data type.
		*
		With Thisform
			.xreturnvalue = .xemptyvalue
			.Release()
		Endwith
	Endproc


Enddefine
*
*-- EndDefine: aInputBox
**************************************************

**************************************************
*** intoarce ziua curenta daca luna contabila este egala cu luna calendaristica
*** intoarce ultima zi din luna contabila daca luna contabila nu este egala cu luna calendaristica
**************************************************
Function GetDataIreg
	Local ldData
	ldData = Ttod(Get_Ora())
	If Month(ldData) <> gnLuna Or Year(ldData) <> gnAn
		ldData = ULTIMAZI()
	Endif
	Return m.ldData
Endfunc && GetDataIreg
**************************************************

**************************************************
*** primeste tnNrluni = an*12+luna
*** intoarce anul si luna ca parametri prin referinta
*** ex: NrLuni2AnLuna(lnNrLuni, @lnAn, @lnLuna)
**************************************************
Procedure NrLuni2AnLuna
	Lparameters tnNrLuni, tnAn, tnLuna

	tnLuna = INT(Mod(m.tnNrLuni, 12))
	tnAn = Int(m.tnNrLuni / 12)
	If tnLuna = 0
		tnLuna = 12
		tnAn = m.tnAn - 1
	Endif
Endproc && NrLuni2AnLuna

**************************************************
*** salveaza un cursor intr-un fisier XML in gcTempPath 
*** intoarce calea fisierului xml daca s-a salvat cu succes
**************************************************
Function SaveCursor2XML
	Lparameters tcAlias, tcXMLName
	*** tcAlias: alias-ul cursorului (ex: tact)
	*** tcXMLName: numele fisierului XML fara cale si extensie (ex: notafarapredefinire)
	Local lcAlias, lcXMLFile, lcXMLName, lnBytes

	lcAlias = Iif(Empty(tcAlias), Alias(), m.tcAlias)
	lcXMLName = Iif(Empty(tcXMLName), m.lcAlias, m.tcXMLName)
	lcXMLFile = gcTempPath + Juststem(lcXMLName) + '.xml'
	lnBytes = 0
	If Used(m.lcAlias)
		lnBytes = Cursortoxml(m.lcAlias, m.lcXMLFile, 1, 2 + 512, 0, "1")
	Endif
	Return Iif(m.lnBytes > 0, m.lcXMLFile, '')
Endfunc && SaveCursor2XML

**************************************************
*** transforma un xml salvat anterior in gcTempPath intr-un cursor
*** intoarce numele cursorului creat (alias), daca s-a gasit fisierul XML
**************************************************
Function RestoreXML2Cursor
	Lparameters tcAlias, tcXMLName
	*** tcAlias: alias-ul cursorului (ex: tact)
	*** tcXMLName: numele fisierului XML fara cale si extensie (ex: notafarapredefinire)
	Local lcAlias, lcXMLFile, lcXMLName, lnBytes

	lcAlias = Iif(Empty(tcAlias), Sys(2015), m.tcAlias)
	lcXMLName = Iif(Empty(tcXMLName), m.lcAlias, m.tcXMLName)
	lcXMLFile = gcTempPath + Juststem(lcXMLName) + '.xml'
	If File(m.lcXMLFile)
		Xmltocursor(m.lcXMLFile, m.lcAlias, 512)
	Endif

	Return Iif(Used(m.lcAlias), m.lcAlias, '')
Endfunc && RestoreXML2Cursor

**************************************************
*** verifica daca exista fisierul xml salvat prin SaveCursor2XML
*** intoarce
**************************************************
Function ExistsXML
	Lparameters tcXMLName
	*** tcXMLName: numele fisierului XML fara cale si extensie (ex: notafarapredefinire)
	Local lcXMLFile, lcXMLName

	lcXMLName = Iif(Empty(tcXMLName), m.lcAlias, m.tcXMLName)
	lcXMLFile = gcTempPath + Juststem(lcXMLName) + '.xml'

	Return Iif(File(m.lcXMLFile), m.lcXMLFile, '')
Endfunc && ExistsXML

**************************************************
*** verifica daca exista fisierul xml salvat prin SaveCursor2XML
*** intoarce
**************************************************
Define Class BackupXML As Custom

	cBackupSet = "" && numele backupset-ului (un fisier xml in care se salveaza informatii despre fisierele xml, variabile etc. pentru acel backupset)
	cBackupSetPath = "" && calea unde se salveaza backupset-ul (gcTempPath)
	cBackupSetFile = "" && calea completa a fisierului backupset gcTempPath\backupset.xml
	cBackupSetAlias = ""
	lBackupSetExists = .F. && Se initializeaza in Init-ul clasei si la salvarea backupset-ului
	lBackupSetLoaded = .F.

	Procedure Init
		Lparameters tcBackupSet, tcBackupPath
		Local lcBackupPath, lcBackupSet

		lcBackupSet = m.tcBackupSet
		If Type('tcBackupPath') <> 'C' Or Empty(tcBackupPath)
			lcBackupPath = m.gcTempPath
		Else
			lcBackupPath = m.tcBackupPath
		Endif
		If !(Empty(m.lcBackupSet) Or Empty(m.lcBackupPath))
			This.cBackupSetFile = Addbs(m.lcBackupPath) + Juststem(m.lcBackupSet) + '.xml'
		Endif
	Endproc && Init

	Procedure cBackupSetFile_ASSIGN
		Lparameters tcBackupSetFile

		This.cBackupSetFile = m.tcBackupSetFile
		If !Empty(m.tcBackupSetFile)
			This.cBackupSetPath = Addbs(Justpath(m.tcBackupSetFile))
			This.cBackupSet = Juststem(m.tcBackupSetFile)
			This.lBackupSetExists = File(This.cBackupSetFile)
			This.LoadBackupSet()
		Endif
	Endproc && cBackupSetFile_ASSIGN

	Protected Procedure LoadBackupSet

		Local lcBackupSetAlias, lcBackupSetFile, lcSelect
		lcSelect = Select()
		lcBackupSetFile = This.cBackupSetFile
		lcBackupSetAlias = This.cBackupSet
		If File(m.lcBackupSetFile)
			Xmltocursor(m.lcBackupSetFile, m.lcBackupSetAlias, 512)
			*!*	modificare	ROACONT v 2.2.15 : pentru fisierele care aveau structura type/name/filename
			If Type(lcBackupSetAlias + ".filename") <> "U"
				Alter Table &lcBackupSetAlias Add Column Value M Null
				Alter Table &lcBackupSetAlias Add Column valuetype C
				Replace Value With filename All
				Replace valuetype With "" All
				Alter Table &lcBackupSetAlias Drop Column filename
			Endif
			*!*	modificare	ROACONT v 2.2.15	^
		Else
			Create Cursor &lcBackupSetAlias (Type v(20), Name v(100), Value M Null, valuetype C)
		Endif
		This.lBackupSetLoaded = Used(m.lcBackupSetAlias)
		Select (m.lcSelect)
	Endproc && LoadBackupSet
	**************************************************
	*** 
	**************************************************
	Function ReadValue
		Lparameters tcNumeVariabila
		Local lcSelect, lcValue, lcValueType, luValue
		lcSelect = Select()
		Select (This.cBackupSet)
		Locate For Alltrim(Type) = 'VARIABLE' And Upper(Alltrim(Name)) = Upper(Alltrim(tcNumeVariabila))
		If Found()
			lcValue = Value
			lcValueType = Upper(Alltrim(valuetype))
			Do Case
				Case lcValueType $ "CM"
					luValue = m.lcValue
				Case lcValueType $ "NIF"
					luValue = Val(m.lcValue)
				Case lcValueType = "T"
					luValue = Ctot(m.lcValue)
				Case lcValueType = "D"
					luValue = Ctod(m.lcValue)
				Case lcValueType = "L"
					luValue = Iif(m.lcValue = "1" Or Upper(m.lcValue) = "T" Or Upper(m.lcValue) = '.T.' Or Upper(m.lcValue) = 'YES', .T., .F.)
				Otherwise
					luValue = m.lcValue
			Endcase
		Else
			luValue = Null
		Endif
		Select (lcSelect)
		Return luValue
	Endfunc

	**************************************************
	*** intoarce .T. daca exista fisierul backupset xml
	**************************************************
	Function ExistsBackupSet
		Return This.lBackupSetExists
	Endfunc && ExistsBackupSet


	**************************************************
	*** deschide backupset-ul si creeaza cursoarele si variabilele din definitia lui
	*** intoarce .T. daca exista fisierul backupset
	**************************************************
	Function RestoreBackupSet
		Lparameters tcBackupSetFile

		*** tcBackupSetFile: calea completa a fisierului backupset XML, inclusiv extensie
		Local lcBackupSetFile, llRestored, lcSelect
		Local lcAlias, lcFile, loRec
		Local lcName, lcType, lcValue, lcValueType, lcVariable, luValue
		llRestored = .F.
		lcSelect = Select()

		If !Empty(m.tcBackupSetFile)
			This.cBackupSetFile = tcBackupSetFile
		Endif
		If !This.lBackupSetLoaded
			Return m.llRestored
		Endif
		lcBackupSetFile = This.cBackupSetFile

		Select (This.cBackupSet)
		Scan
			Scatter Name loRec Memo
			lcType = Upper(Alltrim(loRec.Type))
			lcName = loRec.Name
			lcValue = loRec.Value
			lcValueType = Upper(Alltrim(loRec.valuetype))

			Do Case
					*** recreare cursoare din xml-uri
				Case m.lcType = 'TABLE'
					lcFile = Addbs(Justpath(lcBackupSetFile)) + Juststem(Alltrim(m.lcValue)) + '.xml'
					lcAlias = Alltrim(m.lcName)
					If File(m.lcFile)
						Xmltocursor(m.lcFile, m.lcAlias, 512)
					Endif

					*** reinitializare variabile
				Case loRec.Type = 'VARIABLE'
					lcVariable = lcName
					Do Case
						Case lcValueType $ "CM"
							luValue = m.lcValue
						Case lcValueType $ "NIF"
							luValue = Val(m.lcValue)
						Case lcValueType = "T"
							luValue = Ctot(m.lcValue)
						Case lcValueType = "D"
							luValue = Ctod(m.lcValue)
						Case lcValueType = "L"
							luValue = Iif(m.lcValue = "1" Or Upper(m.lcValue) = "T" Or Upper(m.lcValue) = '.T.' Or Upper(m.lcValue) = 'YES', .T., .F.)
						Otherwise
							luValue = m.lcValue
					Endcase
					&lcVariable = luValue && pcText = "abc"
			Endcase
		Endscan && m.lcBackupSetAlias

		llRestored = .T.
		Select(m.lcSelect)
		Return m.llRestored
	Endfunc && RestoreBackupSet

	***********************************
	*** Saves all the private variables in the parameter list in the BackupSet
	***********************************
	Procedure SavePrivateVariables
		Lparameters tcPrivateVariables

		lnVariables = Getwordcount(m.tcPrivateVariables, ",")
		For lnVariable = 1 To m.lnVariables
			lcVariable = Alltrim(Getwordnum(m.tcPrivateVariables, m.lnVariable, ","))
			If !Empty(m.lcVariable)
				This.SaveBackupSet(m.lcVariable, "VARIABLE", &lcVariable)
			Endif
		Endfor
	Endproc && SavePrivateVariables

	**************************************************
	*** salveaza un cursor sau toate cursoarele din definitia backupset-ului in fisiere XML in gcTempPath 
	*** intoarce calea fisierului xml daca s-a salvat cu succes
	**************************************************
	Procedure SaveBackupSet
		Lparameters tcName, tcType, tuValue
		*** tcName: numele cursorului sau variabilei (ex: crsAct, pcText) Daca este gol, se salveaza toate alias-urile
		*** daca este completat, se adauga in definitia backupset-ului
		*** tcType: TABLE/VARIABLE
		*** tuValue: (optional) valoarea variabilei. Valoarea se salveaza direct in xml definitie backupset
		*** tcValueType: (optional) tipul variabilei (C/N/D/T) pentru This.RestoreBackupset

		Local lcFile, lcName, lcType, lcWhere, llSaved, lnBytes, loRec, lnRecno, lcFilter

		lcName = ""
		llSaved = .F.
		If !This.lBackupSetLoaded
			Return m.llSaved
		Endif
		If !Empty(tcName)
			lcName = Alltrim(Transform(m.tcName))
			lcType = Iif(!Empty(m.tcType), m.tcType, "TABLE")
			This.UpdateBackupSet(m.lcName, m.lcType, m.tuValue) && variabilele se salveaza direct in definitia backupset-ului
		Endif

		Select (This.cBackupSet)
		lcWhere = [.T.]
		If !Empty(m.lcName)
			lcWhere = [name = "] + m.lcName + ["]
		Endif

		*** SALVARE CURSOARE IN XML	
		Scan For &lcWhere
			Scatter Name loRec Memo
			lcFile = Addbs(This.cBackupSetPath) + Alltrim(loRec.Value) && (c:\temp\backupsettest_actactan.xml)
			lcName = Alltrim(loRec.Name)

			Do Case
				Case loRec.Type = 'TABLE'
					If Used(m.lcName)
						lnRecno = Iif(Eof(m.lcName), 0, Recno(m.lcName))
						lcFilter = Filter(m.lcName)
						Set Filter To In (m.lcName)
						lnBytes = Cursortoxml(m.lcName, m.lcFile, 1, 2 + 512, 0, "1")
						If !Empty(m.lcFilter)
							lcFilterExpr = "set filter to " + m.lcFilter + " in " + m.lcName
							&lcFilterExpr
						Endif
						If m.lnRecno > 0
							Goto m.lnRecno In (m.lcName)
						Endif
					Endif
				Otherwise
					***
			Endcase
		Endscan && m.lcBackupSetAlias

		llSaved = .T.

		Return m.llSaved
	Endfunc && SaveBackupSet

	Procedure DeleteBackupSet
		Local lcFile, loRec, lcSelect
		lcSelect = Select()

		If !File(This.cBackupSetFile)
			Return
		Endif

		*** sterg fisierele componenta backupset
		Select (This.cBackupSet)
		Scan For Upper(Alltrim(Type)) = 'TABLE'
			Scatter Name loRec Memo
			lcFile = Addbs(This.cBackupSetPath) + Alltrim(loRec.Value) && (c:\temp\backupsettest_actactan.xml)

			If File(m.lcFile)
				Delete File (m.lcFile)
			Endif
		Endscan

		*** sterg inregistrarile din cursorul backupset
		Delete All

		*** sterg fisierul backupset
		Delete File (This.cBackupSetFile)

	Endproc && DeleteBackupSet


	*************************************************************************
	*** actualizeaza definitia backupset-ului cu tabelele sau variabilele noi
	*** UpdateBackupSet("crsAct", "TABLE")
	*** UpdateBackupSet("pcText", "VARIABLE", m.pcText, "C")
	*************************************************************************
	Procedure UpdateBackupSet
		Lparameters tcName, tcType, tuValue
		*** tcName: numele cursorului sau variabilei (ex: crsAct, pcText)
		*** tcType: TABLE/VARIABLE
		*** tuValue: (optional) valoarea variabilei. Valoarea se salveaza direct in xml definitie backupset

		Local lcFileName, lcName, lcType, lnBytes, lcSelect, lcValue, lcValueType

		If !This.lBackupSetLoaded
			Return .F.
		Endif

		lcSelect = Select()

		lcName = Iif(!Empty(m.tcName), Alltrim(Transform(m.tcName)), "")
		lcType = Iif(!Empty(m.tcType), m.tcType, "TABLE")
		lcValue = Transform(m.tuValue)
		lcValueType = Iif(Pcount() >= 3, Type('tuValue'), "")

		Do Case
			Case m.lcType = "TABLE"
				lcValue = This.cBackupSet + "_" + m.lcName + ".xml"
			Otherwise
				*
		Endcase

		If !Empty(m.lcName)
			Select (This.cBackupSet)
			Locate For Name = Alltrim(tcName)
			If !Found()
				Insert Into (This.cBackupSet) (Type, Name, Value, valuetype) Values (m.lcType, m.lcName, m.lcValue, m.lcValueType)
			Else
				Replace Type With m.lcType, Value With m.lcValue, valuetype With m.lcValueType
			Endif
			lnBytes = Cursortoxml(This.cBackupSet, This.cBackupSetFile, 1, 2 + 512, 0, "1")
		Endif
		Select (m.lcSelect)

	Endproc && UpdateBackupSet

	Procedure Destroy
		Local lcSelect

		lcSelect = Select()
		Use In (Select(This.cBackupSet))
		Select (m.lcSelect)
	Endproc && Destroy

Enddefine && BackupXML

Procedure romfast_suport
	Local lcFile, lcPath, llOpen
	lcFile = "romfast_suport.exe"
	lcPath = Addbs(m.gcBasePath)
	llOpen = .T.

	Return DownloadSupportFile(m.lcFile, m.lcPath, m.llOpen)
Endproc && romfast_suport

Procedure DownloadSupportFile
	Lparameters tcFile, tcDownloadPath, tlOpen, tlNewVersion

	*** tlOpen: .T. daca se doreste deschiderea fisierului descarcat
	*** tlNewVersion: OUT - .T. daca exista o versiune noua pe server

	Local loUpdater As "Updater"
	Local lcCheckSum, lcDownloadFile, lcDownloadPath, lcErrorMessage, lcFile, lcProgressProcedure, lcURL
	Local llCheckVersion, llOpen, llReturn, loUpdateRec, llError
	Local lcDownloadFileTemp
	llError = .F.

	Wait Window "Se cauta versiuni noi ale fisierului " + Justfname(m.tcFile) + " pe romfast.ro" Nowait

	lcFile = Alltrim(m.tcFile) && "romfast_suport.exe"
	lcDownloadPath = Addbs(m.tcDownloadPath)
	llOpen = m.tlOpen
	lcDownloadFile = m.lcDownloadPath + m.lcFile && d:\roa\romfast_suport.exe
	llCheckVersion = .F.

	loUpdater = Createobject("Updater", "", m.llCheckVersion)
	If Type("loUpdater") = "O"
		loUpdateRec = loUpdater.CheckNewVersion(m.lcFile, .T.)
		tlNewVersion = loUpdateRec.NewVersion
		If loUpdateRec.NewVersion Or !File(m.lcDownloadFile)
			lcURL = Alltrim(loUpdateRec.fisier)
			lcCheckSum = Alltrim(loUpdateRec.checksum)
			lcProgressProcedure = ""
			lcErrorMessage = ""

			lcDownloadFileTemp = loUpdater.cDownloadPath + m.lcFile && d:\contafin\_update\romfast_suport.exe
			llReturn = loUpdater.DownloadFile(m.lcURL, m.lcDownloadFileTemp, m.lcProgressProcedure, @m.lcErrorMessage, m.lcCheckSum)
			If !loUpdater.lError
				loUpdater.UpdateVersion(m.loUpdateRec)
				If File(m.lcDownloadFileTemp)
					Copy File (m.lcDownloadFileTemp) To (m.lcDownloadFile)
					Delete File (m.lcDownloadFileTemp)
				Endif
			Endif
			If !Empty(m.lcErrorMessage)
				amessagebox(m.lcErrorMessage, 0 + 48, _Screen.Caption)
			Endif
		Endif
	Else
		llReturn = .F.
	Endif

	If m.llOpen And File(m.lcDownloadFile)
		OPEN_DEFAULT_APP(m.lcDownloadFile)
	Endif

	Return m.llReturn
Endproc && DownloadSupportFile



Define Class Updater As Custom
	cLicenta = "" && pentru CONTAFIN
	cErrorMessage = ""
	lError = .F.
	cDownloadPath = ""
	cFileVersionUrl = ""
	cDownloadFileVersion = ""

	Procedure Init
		Lparameters tcFileVersionUrl, tlCheckVersion, tcVersionType

		*** tcFileVersionUrl: URL fisier versiuni.xml (DEFAULT http://...contafin.xml)
		*** tlCheckVersion: .T. = se verifica versiunile programelor din versiuni.xml
		*** tcVersionType: CONTAFIN (DEFAULT); SUPORT

		Local lcCheie, lcConnectTimeout, lcDownloadFileVersion, lcFileLicenta, lcFileVersionUrl
		Local lcLibraryPath, lcLicenta, lcResponseTimeout, lcSettingsFile, lcVersionFileName, lcVersionType
		Local llReturn, loEx
		lcLicenta = ""
		lcFileLicenta = m.gcBasePath + 'licente.cnt'
		If File(m.lcFileLicenta)
			m.lcLicenta = Alltrim(Filetostr(m.lcFileLicenta))
			This.cLicenta = m.lcLicenta
		Endif


		lcLibraryPath = m.gcBasePath + Iif("ROA" $ Upper(gcBasePath), "COMUNROA", "COMUNCONTAFIN") + "\vfpconnection.fll" && CONTAFIN(ROA)\COMUNCONTAFIN(COMUNROA)\vfpconnection.fll
		lcSettingsFile = m.gcBasePath + "settings.ini" && CONTAFIN(ROA)\settings.ini

		If File(m.lcLibraryPath)
			Try
				If !'vfpconnection' $ Set("Library")
					Set Library To (lcLibraryPath) Additive
				Endif
				lcConnectTimeout = goAPI.GetProfileString(m.lcSettingsFile, "update", "ConnectTimeout") && timeout conectare in secunde / default 20
				lcConnectTimeout = Nvl(lcConnectTimeout, '')
				lcResponseTimeout = goAPI.GetProfileString(m.lcSettingsFile, "update", "ResponseTimeout") && timeout raspuns in secunde / default 60
				lcResponseTimeout = Nvl(lcResponseTimeout, '')
				If Empty(m.lcConnectTimeout)
					goAPI.WriteProfileString(m.lcSettingsFile, "update", "ConnectTimeout", "20") && frecventa verificarii
					lcConnectTimeout = "20"
				Endif
				If Empty(m.lcResponseTimeout)
					goAPI.WriteProfileString(m.lcSettingsFile, "update", "ResponseTimeout", "60") && frecventa verificarii
					lcResponseTimeout = "60"
				Endif

				SetConnectTimeout(Val(lcConnectTimeout)) && Default is 10 seconds
				SetResponseTimeout(Val(lcResponseTimeout)) && Default is 10 seconds


				This.cDownloadPath = m.gcBasePath + '_UPDATE\' && D:\CONTAFIN\_UPDATE\

				If !Directory(This.cDownloadPath)
					Md (This.cDownloadPath)
				Endif

				lcDownloadFileVersion = This.cDownloadPath + "versiune.xml"
				This.cDownloadFileVersion = lcDownloadFileVersion

				lcLicenta = ""
				lcFileLicenta = m.gcBasePath + 'licente.cnt'
				If File(m.lcFileLicenta)
					m.lcLicenta = Alltrim(Filetostr(m.lcFileLicenta))
					This.cLicenta = m.lcLicenta
				Endif

				**********************************************************
				*** Citesc fileversionurl din CONTAFIN(ROA)\SETTINGS.INI
				**********************************************************
				*** FileVersionUrl = http://83.103.197.79:3002/contafinupdate/default.aspx/update/download/|licenta|/contafin_local.xml
				*** FileVersionUrl = http://10.0.20.122:81/contafinupdate/default.aspx/update/download/|licenta|/contafin_local.xml
				lcVersionType = Upper(Alltrim(Transform(m.tcVersionType)))
				lcCheie = Iif(lcVersionType = 'CONTAFIN', 'fileversionurl', 'suportversionurl')
				lcVersionFileName = Iif(lcVersionType = 'CONTAFIN', 'contafin', 'suport')

				If !Empty(m.tcFileVersionUrl)
					lcFileVersionUrl = m.tcFileVersionUrl
				Else
					lcFileVersionUrl = goAPI.GetProfileString(m.lcSettingsFile, [update], m.lcCheie)
					lcFileVersionUrl = Nvl(m.lcFileVersionUrl, '')
					If Empty(m.lcFileVersionUrl)
						*!*						13.05.2014 cand s-a introdus taxa la dyndns, am pus ip-ul fix
						*!*							lcFileVersionUrl = [http://] + IIF(_vfp.StartMode = 0, [10.0.20.122:81] , [romfast.dyndns.biz:3002]) + [/contafinupdate/default.aspx/update/download/|licenta|/] + ;
						*!*								m.lcVersionFileName + [.xml]
						lcFileVersionUrl = [http://] + Iif(_vfp.StartMode = 0, [10.0.20.122:81], [83.103.197.79:3002]) + [/contafinupdate/default.aspx/update/download/|licenta|/] + ;
							M.lcVersionFileName + [.xml]
						*!*						13.05.2014 	^						
						goAPI.WriteProfileString(m.lcSettingsFile, [update], m.lcCheie, m.lcFileVersionUrl )
					Else
						*!*						13.05.2014 cand s-a introdus taxa la dyndns, am pus ip-ul fix

						If [romfast.dyndns.biz] $ lcFileVersionUrl
							lcFileVersionUrl = Strtran(lcFileVersionUrl, [romfast.dyndns.biz], [83.103.197.79])
							goAPI.WriteProfileString(m.lcSettingsFile, [update], m.lcCheie, m.lcFileVersionUrl )
						Endif
						*!*						13.05.2014 	^						

					Endif
				Endif
				This.cFileVersionUrl = m.lcFileVersionUrl

				*!* DESCARCARE FISIER VERSIUNE
				If File(m.lcDownloadFileVersion)
					Delete File (m.lcDownloadFileVersion)
				Endif
				llReturn = This.DownloadVersionFile(m.tlCheckVersion)

			Catch To loEx
				This.lError = .T.
				This.cErrorMessage = loEx.Message
				amessagebox(This.cErrorMessage, 0 + 16, _Screen.Caption)
			Endtry
		Else
			This.lError = .T.
			This.cErrorMessage = "Nu exista fisierul " + m.lcLibraryPath + "!"
			amessagebox(This.cErrorMessage, 0 + 16, _Screen.Caption)
		Endif

	Endproc && Init

	*!* verificare versiune diferita
	Procedure CheckNewVersion
		Lparameters tcAppName, tlCheckVersion

		Local lcSelect, lcAppName
		Local loReturn
		lcSelect = Select()
		lcAppName = Upper(Juststem(Alltrim(m.tcAppName)))

		If Used('crsXML')
			If m.tlCheckVersion
				This.CheckVersion(m.lcAppName)
			Endif
			Select crsXMl
			Locate For Upper(Alltrim(Program)) = lcAppName
			If Found()
				Scatter Name loReturn
				AddProperty(loReturn, "newversion", Alltrim(versiune) <> Alltrim(versiuneact))
			Else
				Scatter Name loReturn Blank
				AddProperty(loReturn, "newversion", .F.)
			Endif
		Else
			loReturn = Createobject("custom")
			loReturn.AddProperty("newversion", .F.)
		Endif

		Select (lcSelect)

		Return m.loReturn
	Endproc && CheckNewVersion

	Procedure DownloadVersionFile
		Lparameters tlCheckVersion

		Local llReturn, lcFileVersionUrl, lcDownloadFileVersion, lcTextXML
		Local loEx As Exception

		lcFileVersionUrl = This.cFileVersionUrl
		lcDownloadFileVersion = This.cDownloadFileVersion

		****** DOWNLOAD FISIER CU ULTIMELE VERSIUNI ALE PROGRAMELOR EX:CONTAFIN.XML ******** ^
		llReturn = This.DownloadFile(m.lcFileVersionUrl, m.lcDownloadFileVersion)
		llReturn =  m.llReturn And File(m.lcDownloadFileVersion)
		If This.lError
			Messagebox(This.cErrorMessage, 0 + 64, _Screen.Caption)
		Endif
		****** DOWNLOAD FISIER CU ULTIMELE VERSIUNI ALE PROGRAMELOR EX:CONTAFIN.XML ******** ^
		Create Cursor crsXMl (Program C(200), fisier C(200), Log C(200), checksum C(100), versiune C(200), versiuneact C(100), ales N(1), Terminat N(1))
		If m.llReturn
			lcTextXML = Filetostr(m.lcDownloadFileVersion)
			If Left(m.lcTextXML, 5) <> '<?xml'
				Messagebox('Serverul de actualizari este ocupat. Incercati mai tarziu.' + Chr(13) + Chr(10) + ;
					  'Daca problema persista, apelati suportul tehnic.', 0 + 64, _Screen.Caption)
			Else
				Try
					Xmltocursor(m.lcDownloadFileVersion, "crsXmlTemp", 512)

					Select crsXMl
					Append From Dbf('crsXMLTemp')
					*!*						
					*!*						Select Program, fisier, Log, versiune, checksum, Space(100) As versiuneact, 0 As ales, 0 As Terminat ;
					*!*							FROM crsXmlTemp ;
					*!*							INTO Cursor crsXMl Readwrite
					Use In (Select('crsXmlTemp'))

				Catch To loEx
					goLog.WriteLog("DOWNLOADVERSIONFILE; " + loEx.Message + " " + m.lcDownloadFileVersion, Program())
					Messagebox(loEx.Message + " " + m.lcDownloadFileVersion, 0 + 16, _Screen.Caption)
				Endtry
			Endif
		Endif

		*** completez versiunea programelor in xml
		If m.tlCheckVersion
			This.CheckVersion()
		Endif

		Return m.llReturn

	Endproc && DownloadVersionFile

	Procedure CheckVersion
		Lparameters tcProgram

		Local lcFilter, lcSelect
		lcSelect = Select()

		*!* scanez cursorul cu ultimele versiuni ale programelor
		*!* aflu versiunea actuala a exe-urilor de pe calculatorul client
		lcFilter = Iif(!Empty(m.tcProgram), [upper(ALLTRIM(program)) = UPPER(JUSTSTEM(ALLTRIM(m.tcProgram)))], [.T.])
		Select crsXMl
		Scan For &lcFilter
			lcProgram = Lower(Alltrim(Program)) && CONCONT
			lcFile = gcBasePath + lcProgram + "\"  + Alltrim(lcProgram) + '.EXE' && D:\CONTAFIN\CONCONT\CONCONT.EXE
			lcFileVersiuneText = gcBasePath + lcProgram + "\VERSIUNE.TXT"  && D:\CONTAFIN\_ALFA\VERSIUNE.TXT
			lcSettingsFile = m.gcBasePath + "settings.ini" && D:\CONTAFIN\settings.ini

			If File(lcFile)
				Dimension aFiles[4]
				lnItems = Agetfileversion(aFiles, lcFile)
				lcVersiune = ''
				If lnItems >= 4
					lcVersiune = aFiles(4)
				Endif
				Replace versiuneact With m.lcVersiune
			Else
				&& verific daca exista versiune.txt (in cazul _alfa care nu are executabil)
				If File(lcFileVersiuneText)
					lcVersiune = Alltrim(Filetostr(m.lcFileVersiuneText))
					Replace versiuneact With m.lcVersiune
				Else
					lcVersiune = goAPI.GetProfileString(m.lcSettingsFile, [versiuni], m.lcProgram)
					Replace versiuneact With Nvl(m.lcVersiune, '')
				Endif
			Endif
		Endscan
		*!* scanez cursorul cu ultimele versiuni ale programelor ^
		Select (m.lcSelect)
	Endproc && CheckVersion

	Procedure UpdateVersion
		Lparameters toUpdateRec
		If Type('toUpdateRec') = 'O' And Type('toUpdateRec.versiune') <> 'U'
			lcProgram = Alltrim(toUpdateRec.Program)
			lcVersiune = Alltrim(toUpdateRec.versiune)
			lcSettingsFile = m.gcBasePath + "settings.ini" && D:\CONTAFIN\settings.ini

			goAPI.WriteProfileString(m.lcSettingsFile, [versiuni], m.lcProgram, m.lcVersiune)
		Endif
	Endproc && UpdateVersion


	Procedure DownloadFile
		Lparameters tcUrl, tcDownloadFile, tcProgressProcedure, tcErrorMessage, tcCheckSum
		Local lcURL, llReturn, lcDownloadFile, lcProgressProcedure, lcText, lcCheckSum, llDownload
		Local lcCheckSumFile

		lcText = 'Nu s-a putut actualiza fisierul ' + Justfname(m.tcDownloadFile) + ' de pe serverul ROMFAST. Verificati conexiunea internet si/sau setarile de actualizare!'
		If Empty(tcCheckSum) Or Type('tcCheckSum') <> 'C'
			lcCheckSum = ""
		Else
			lcCheckSum = tcCheckSum
		Endif

		goLog.WriteLog("DOWNLOAD START; " + Alltrim(m.tcUrl) + " | " + Alltrim(m.tcDownloadFile), Program())

		lcURL = Alltrim(m.tcUrl)
		lcURL = This.ReplaceLicentaTag(m.lcURL)
		lcDownloadFile = Alltrim(m.tcDownloadFile)
		lcProgressProcedure = Iif(Type('tcProgressProcedure') <> 'C', '', tcProgressProcedure)

		&& daca am checksumul ca parametru, exista fisierul si checksumurile sunt egale nu mai downloadez
		llDownload = .T.
		If File(m.lcDownloadFile) && verific daca exista fisierul deja downloadat TODO: trebuie verificat hashul
			If !Empty(m.lcCheckSum)
				lcCheckSumFile = This.CalculateCheckSum(m.lcDownloadFile)
				If m.lcCheckSum == m.lcCheckSumFile && checksumurile sunt egale
					llDownload = .F.
					goLog.WriteLog("FISIERUL " + Alltrim(m.tcDownloadFile) + " EXISTA DEJA IN DIRECTORUL DE DOWNLOAD SI ARE ACELASI CHECKSUM CA CEL DE PE SERVER.", Program())
				Else
					goLog.WriteLog("FISIERUL " + Alltrim(m.tcDownloadFile) + " EXISTA DEJA IN DIRECTORUL DE DOWNLOAD, DAR NU ARE ACELASI CHECKSUM CA CEL DE PE SERVER.", Program())
				Endif
			Endif
		Endif

		llReturn = .F.
		Do Case
			Case !llDownload
				llReturn = .T.

			Case Upper(Left(lcURL, 4)) = "FTP:"
				m.llReturn = FTPGet(lcURL, m.lcDownloadFile, lcProgressProcedure)

			Case Upper(Left(lcURL, 5)) = "HTTP:" OR Upper(Left(lcURL, 6)) = "HTTPS:"
				m.llReturn = HTTPDownloadFile(lcURL, m.lcDownloadFile)
						
			Otherwise
				If Upper(Left(lcURL, 7)) != "FILE://"
					lcURL  = "File://" + lcURL
				Endif
				m.llReturn = FileGet(lcURL, m.lcDownloadFile, lcProgressProcedure)

		Endcase

		*!* verific ca exista fisierul
		llReturn = m.llReturn And File(m.lcDownloadFile)

		*!* verific continutul fisierului
		If m.llReturn
			lcText = Filetostr(m.lcDownloadFile)
			llReturn = Left(Lower(m.lcText), 3) <> 'err' And Left(Lower(m.lcText), 6) <> '<html>'
		Endif

		*!* verific checksum daca fisierul a fost downloadat
		If llReturn And llDownload And !Empty(lcCheckSum)
			lcCheckSumFile = This.CalculateCheckSum(m.lcDownloadFile)
			If m.lcCheckSum <> m.lcCheckSumFile
				m.lcText = 'Checksumul fisierului ' + m.lcDownloadFile + ' nu corespunde cu checksumul fisierului de pe server.'
				llReturn = .F.
			Endif
		Endif

		If !llReturn
			tcErrorMessage = Left(m.lcText, 100)
			This.cErrorMessage = tcErrorMessage
			This.lError = .T.
		Else
			This.cErrorMessage = ""
			This.lError = .F.
		Endif


		goLog.WriteLog("DOWNLOAD END; " + + Alltrim(m.tcUrl) + " | " + Alltrim(m.tcDownloadFile) + Iif(m.llReturn, " SUCCES", " " + Left(lcText, 100) + " EROARE"), Program())

		Return m.llReturn

	Endproc && DownloadFile

	*!*
	*!* UPDATE STATUS FORMULAR
	*!* APELAT DIN THIS.UPDATEFILE
	*!*
	Procedure UpdateStatus
		Lparameters tcStatusVariable, tcStatus
		Local lcStatusVariable, lcStatus, lcUpdateStatus

		lcStatusVariable = Iif(!Empty(tcStatusVariable) And Type('tcStatusVariable') = 'C', tcStatusVariable, '')
		lcStatus = Iif(!Empty(tcStatus) And Type('tcStatus') = 'C', tcStatus, '')

		If !Empty(lcStatusVariable)
			lcUpdateStatus = lcStatusVariable + [ = "] + lcStatus + ["]
			&lcUpdateStatus
			If Right(Upper(lcStatusVariable), 8) = '.CAPTION'
				lcStatusObject = Left(lcStatusVariable, Len(lcStatusVariable) - 8)
				loStatusObject = Evaluate(lcStatusObject)
				If Pemstatus(loStatusObject, "refresh", 5)
					loStatusObject.Refresh()
				Endif
			Endif
		Endif

	Endproc && UpdateStatus

	Procedure ProgressHandler
		Lparameters tcFile
		Local lnProgress, lcFile

		lnProgress = 0
		lcFile = Iif(Empty(m.tcFile) Or Type('tcFile') <> 'C', '', m.tcFile)
		If m.nConnectTotalBytes > 0
			m.lnProgress = Int(m.nConnectBytesSoFar / m.nConnectTotalBytes * 100)
		Endif

		Wait Window m.lcFile + ' ' + Transform(m.lnProgress) + '% ...' Nowait
	Endproc && ProgressHandler

	Function CalculateCheckSum
		Lparameters tcFile
		Local lcCheckSum, lcText
		lcCheckSum = ""
		If File(tcFile)
			lcText = Filetostr( m.tcFile)
			lcCheckSum = Sys(2007, m.lcText, 0, 1)
		Endif
		Return m.lcCheckSum

	Endfunc && CalculateCheckSum

	Function ReplaceLicentaTag
		Lparameters tcText
		Local lcText, lcReturn

		lcText = Iif(Empty(tcText) Or Type('tcText') <> 'C', "", tcText)
		lcReturn = Iif(!Empty(This.cLicenta), Strtran(m.lcText, '|licenta|', This.cLicenta, 1, 1, 1), m.lcText) && inlocuiesc |licenta|

		Return m.lcReturn

	Endfunc && ReplaceLicentaTag

	Procedure Destroy

		Local lcSelect
		lcSelect = Select()

		If File(This.cDownloadFileVersion)
			Erase (This.cDownloadFileVersion)
		Endif

		Use In (Select('crsXML'))
		Select (lcSelect)

	Endproc && Destroy

Enddefine && Updater


PROCEDURE verificare_iban
	Lparameters tcXMLIBAN
	*** tcXMLIBAN: un xml cu codurile IBAN care trebuie verificate, 2 sau 3 coloane: "denumire", "cod_fiscal", "iban"

	If Left(Lower(tcXMLIBAN), 5) = "<?xml"
		Xmltocursor(tcXMLIBAN, 'crsXMLIBANVerificare') && denumire, cod_fiscal, iban
	ENDIF
	CREATE CURSOR crsVerificareIBAN (denumire C(100), cod_fiscal C(30) NULL, cont_banca C(30) NULL, valid L)
	Select crsVerificareIBAN
	Append From Dbf('crsXMLIBANVerificare')
	
	lcCoduriValide = ''
	lcCoduriInvalide = ''
	SELECT crsVerificareIBAN
	SCAN FOR !EMPTY(NVL(cont_banca,''))
		lcIBAN = ALLTRIM(NVL(cont_banca,''))
		lcDenumire = ALLTRIM(NVL(denumire,''))
		lcCodFiscal = ALLTRIM(NVL(cod_fiscal,''))
		llValid = verifiban(m.lcIBAN)
		IF !m.llValid
			lcCoduriInvalide = lcCoduriInvalide + m.lcDenumire + IIF(!EMPTY(m.lcCodFiscal), " (" + m.lcCodFiscal + ")", "") + " : " + m.lcIBAN + CHR(13) + CHR(10)
		ELSE 	
			lcCoduriValide = lcCoduriValide + m.lcDenumire + IIF(!EMPTY(m.lcCodFiscal), " (" + m.lcCodFiscal + ")", "") + " : " + m.lcIBAN + CHR(13) + CHR(10)
		ENDIF 	
	ENDSCAN 
	USE IN (SELECT('crsVerificareIBAN'))
	AMESSAGEBOX('CODURI INVALIDE' + CHR(13) + CHR(10) + m.lcCoduriInvalide + CHR(13) + CHR(10) + CHR(13) + CHR(10) + 'CODURI VALIDE' + CHR(13) + CHR(10) + m.lcCoduriValide,0,_screen.caption)
	Use In (Select('crsXMLIBANVerificare'))	 	
ENDPROC 
****************************************************
*** verificare validitate CNP/CIF, TVA VIES, info MFIN
****************************************************
Procedure verificare_parteneri
	Lparameters tcXMLParteneri, tlValidare, tlMFIN, tlVIES, tlAutoVerificare, tlDontCloseCursor, tlExperimental, tlServiciuWebANAF
	*** tcXMLParteneri: un xml cu partenerii care trebuie verificati, 2 sau 3 coloane: "denumire", "cod_fiscal", "atribut_fiscal", "ales", ["dataact"]
	*** tcXMLParteneri: un sir cod_fiscal***denumire|cod_fiscal***denumire sau cod_fiscal***denumire***atribut_fiscal|cod_fiscal***denumire***atribut_fiscal
	*** tlValidare: .T. = se valideaza codurile
	*** tlMFIN: .T. = se verifica info mfinante.ro
	*** tlVIES: .T. = se verifica info VIES
	*** tlAutoVerificare: .T. daca se lanseaza automat verificarea pe activate-ul formularului
	*** tlDontCloseCursor: .F. se inchide cursorul crsVerificareParteneri
	*** tlExperimental: .T. se face verificarea la mfinante.ro fara captcha, fara pauze intre interogari, cu request diferit pentru fiecare cod
	*** tlServiciuWebANAF: .T. se verifica prin serviciul web ANAF, cate 500 de coduri fiscale per interogare

	Local loVerificareParteneri As "frm_verificare_parteneri"
	Local lcAtributFiscal, lcCodFiscal, lcDenumire, lcItem, lnNrParteneri, lnPartener, lnProprietate
	Local lnProprietati, lnIdPart, llAles

	If Left(Lower(tcXMLParteneri), 5) = "<?xml"
		Xmltocursor(tcXMLParteneri, 'crsXMLParteneriVerificare') && denumire, cod_fiscal, [atribut_fiscal], [ales], [data]
	Else
		Create Cursor crsXMLParteneriVerificare (cod_fiscal C(30), denumire C(100), atribut_fiscal C(2), ales L, dataact D)
		lnNrParteneri = Getwordcount(tcXMLParteneri, "|")
		For lnPartener = 1 To lnNrParteneri
			lcItem = Getwordnum(tcXMLParteneri, m.lnPartener, "|")
			If !Empty(m.lcItem)
				lnProprietati = Getwordcount(m.lcItem, "***")
				lcCodFiscal = ""
				lcDenumire = ""
				lcAtributFiscal = ""
				llAles = .F.
				lnIdPart = 0
				ldDataAct = DATE(m.gnAn, m.gnLuna, 1)
				For lnProprietate = 1 To m.lnProprietati
					If lnProprietate = 1
						lcCodFiscal = Alltrim(Getwordnum(m.lcItem, m.lnProprietate, "***"))
					Endif
					If lnProprietate = 2
						lcDenumire = Alltrim(Getwordnum(m.lcItem, m.lnProprietate, "***"))
					Endif
					If lnProprietate = 3
						lcAtributFiscal = Alltrim(Getwordnum(m.lcItem, m.lnProprietate, "***"))
					Endif
					If lnProprietate = 4
						llAles = Inlist(Upper(Alltrim(Getwordnum(m.lcItem, m.lnProprietate, "***"))), '1', 'T', '.T.')
					Endif
					If lnProprietate = 5
						lnIdPart = Int(Val(Upper(Alltrim(Getwordnum(m.lcItem, m.lnProprietate, "***")))))
					Endif
					If lnProprietate = 6
						ldDataAct = CTOD(Getwordnum(m.lcItem, m.lnProprietate, "***"))
					Endif
				Endfor

				lcAtributFiscal = Iif(!Empty(m.lcAtributFiscal), m.lcAtributFiscal, Iif(Left(Upper(lcCodFiscal), 2) = 'RO', 'RO', ''))
				Insert Into crsXMLParteneriVerificare (cod_fiscal, denumire, atribut_fiscal, ales, id_part, data) Values (m.lcCodFiscal, m.lcDenumire, m.lcAtributFiscal, m.llAles, m.lnIdPart, m.ldDataAct)
			Endif
		Endfor
	Endif

	Create Cursor crsVerificareParteneri (ales L, denumire C(100) Null, cod_fiscal C(30) Null, Valid L Null, firma C(100) Null, cod C(100) Null, adresa_roa C(250)  Null, adresa C(250)  Null, ;
		  judet C(100)  Null, regcom C(30)  Null, codpostal C(20)  Null, telefon C(30)  Null, fax C(30)  Null, ;
		  datatvamfin C(30) Null, platitortvamfin L Null, VIES L Null, PlatitorTVA L Null, eroare C(250)  Null, IsCIF L  Null, duplicat L, atribut_fiscal C(2), stare C(100), atentie C(100), cod_fiscalfro C(30) Null, id_part N(16), ;
		  tvaincasare L, splittva L, inactiv L, Data D)

	Select crsVerificareParteneri
	Append From Dbf('crsXMLParteneriVerificare')
	Use In (Select('crsXMLParteneriVerificare'))

	Update crsVerificareParteneri Set IsCIF = .T.

	loVerificareParteneri = Createobject("frm_verificare_parteneri", m.tlValidare, m.tlMFIN, m.tlVIES, m.tlAutoVerificare, m.tlExperimental, m.tlServiciuWebANAF) && parteneri.vcx
	loVerificareParteneri.Show(1)
	If !m.tlDontCloseCursor
		Use In (Select('crsVerificareParteneri'))
	Endif

	Return 'crsVerificareParteneri'

Endproc && verificare_parteneri

*!* 01.08.2026 marius.mutu istoricul e comun tuturor firmelor, nu se mai filtreaza pe schema_sursa
Procedure verificare_parteneri_istoric
	Lparameters tcCodFiscal, tcNume

	Local lcSql, lcSelect, llSucces, loVerificareParteneriIstoric
	Private pcCodFiscal
	lcSelect = Select()

	pcCodFiscal = Alltrim(m.tcCodFiscal)
	If Isalpha(m.pcCodFiscal)
		pcCodFiscal = Alltrim(Substr(m.pcCodFiscal, 2))
		If Isalpha(m.pcCodFiscal)
			pcCodFiscal = Alltrim(Substr(m.pcCodFiscal, 2))
		Endif
	Endif

	Text To lcSql Noshow
	select id, dataora, id_util, dataorav, id_utilv, cod_fiscal, firma, adresa, judet, regcom, codpostal, telefon, fax, datatvamfin, platitortvamfin, stare, platitortvavies, util, utilv
		from vistoric_coduri_fiscale
		where cod_fiscal = ?pcCodFiscal
	Endtext

	llSucces = goExecutor.oExecuta(m.lcSql, "crsVerificareParteneriIstoric")
	If m.llSucces
		loVerificareParteneriIstoric = Createobject("frm_verificare_parteneri_istoric", m.tcCodFiscal, m.tcNume) && parteneri.vcx
		loVerificareParteneriIstoric.Show(1)
	Endif

	Use In (Select('crsVerificareParteneriIstoric'))
	Select (m.lcSelect)

Endproc && verificare_parteneri_istoric

**************************************************************
*** verifica un cod fiscal pe mfinante.ro la adaugare partener (frm_partener_nou), alegere partener (cautalf)
*** intoarce cod valid L
**************************************************************
Procedure verifica_partener
	Lparameters tcTipVerificare, toPartener, toPartenerVerificare
	*** tcTipVerificare: 0/VALIDARE, 1/MFIN_AUTO_FARA_CAPTCHA,2/MFIN_AUTO_CU_CAPTCHA,3/MFIN_MANUAL_COD,4/MFIN_MANUAL_NUME,5/ANAF_MANUAL_COD,6/ANAF_MANUAL_NUME,7/RTVAI_MANUAL_COD
	*** toPartener(cod_fiscal, denumire, cod_judet, cod_auto): IN, obiect cu datele partenerului
	*** toPartenerVerificare: OUT, obiect verificare mfinante.ro pentru MFIN_AUTO_FARA_CAPTCHA, MFIN_AUTO_CU_CAPTCHA

	Local loVerificare As "verificarecod"
	Local lcCodAuto, lcCodFiscal, lcCodJudet, lcDenumire, lcTipVerificare, lcXml, llIsCIF, llValid, lnCIFPart
	Local ldDataAct
	*:Global tcEroare
	lcCodFiscal = ""
	lcCodAuto = ""
	lcCodJudet = ""
	lcDenumire = ""
	lcTipVerificare = "VALIDARE"
	lcXml = ""
	llIsCIF = .F.
	lnCIFPart = 0
	llValid = .F.
	tcEroare = ""

	ldDataAct = DATE()

	If Type('tcTipVerificare') = 'N'
		Do Case
			Case tcTipVerificare = 0
				lcTipVerificare = 'VALIDARE'
			Case tcTipVerificare = 1
				lcTipVerificare = 'MFIN_AUTO_FARA_CAPTCHA'
			Case tcTipVerificare = 2
				lcTipVerificare = 'MFIN_AUTO_CU_CAPTCHA'
			Case tcTipVerificare = 3
				lcTipVerificare = 'MFIN_MANUAL_COD'
			Case tcTipVerificare = 4
				lcTipVerificare = 'MFIN_MANUAL_NUME'
			Case tcTipVerificare = 5
				lcTipVerificare = 'ANAF_MANUAL_COD'
			Case tcTipVerificare = 6
				lcTipVerificare = 'ANAF_MANUAL_NUME'
			Case tcTipVerificare = 7
				lcTipVerificare = 'RTVAI_MANUAL_COD'
			Case tcTipVerificare = 8
				lcTipVerificare = 'RTVAI_AUTO_COD'
			Case tcTipVerificare = 9
				lcTipVerificare = 'VIES_AUTO'
			Case tcTipVerificare = 10
				lcTipVerificare = 'VIES_MANUAL'
		Endcase
	Else
		lcTipVerificare = Iif(!Empty(m.tcTipVerificare), Upper(Alltrim(m.tcTipVerificare)), "VALIDARE")
	Endif


	loVerificare = Createobject("verificarecod") && validare.prg

	If Type('toPartener') = 'O'
		lcCodFiscal = Iif(Pemstatus(toPartener, "cod_fiscal", 5), Alltrim(toPartener.cod_fiscal), '')
		lcDenumire = Iif(Pemstatus(toPartener, "denumire", 5), Alltrim(Upper(toPartener.denumire)), '')
		lcCodJudet = Iif(Pemstatus(toPartener, "cod_judet", 5), Alltrim(Upper(toPartener.cod_judet)), '')
		lcCodAuto = Iif(Pemstatus(toPartener, "cod_auto", 5), Alltrim(Upper(toPartener.cod_auto)), '')
		ldDataAct = Iif(Pemstatus(toPartener, "dataact", 5), toPartener.dataact, {})
		lnCIFPart = Iif(Pemstatus(toPartener, "iscif", 5), Iif(toPartener.IsCIF, 1, 2), 0) && 0 = nu are proprietatea CIF, 1 = CIF pers juridica, 2 = CNP pers fizica
	Else
		lcCodFiscal = Transform(toPartener)
	Endif

	*** DOAR VERIFICARE MANUALA
	Do Case
		Case Inlist(m.lcTipVerificare, "MFIN_MANUAL_COD", "MFIN_MANUAL_NUME")
			Do VERIFICA_MANUAL_MFINANAF With m.lcTipVerificare, m.lcCodFiscal, m.lcDenumire, m.lcCodJudet && in proceduri_comune.prg
		Case Inlist(m.lcTipVerificare, "ANAF_MANUAL_COD", "ANAF_MANUAL_NUME")
			Do VERIFICA_MANUAL_MFINANAF With m.lcTipVerificare, m.lcCodFiscal, m.lcDenumire, m.lcCodAuto && in proceduri_comune.prg
		Case Inlist(m.lcTipVerificare, "RTVAI_MANUAL_COD")
			Do VERIFICA_MANUAL_MFINANAF With m.lcTipVerificare, m.lcCodFiscal, m.lcDenumire, m.lcCodAuto && in proceduri_comune.prg
		Case Inlist(m.lcTipVerificare, "VIES_MANUAL")
			Do VERIFICA_MANUAL_MFINANAF With m.lcTipVerificare, m.lcCodFiscal, m.lcDenumire, m.lcCodAuto && in proceduri_comune.prg
	Endcase

	If Empty(m.lcCodFiscal)
		Return m.llValid
	Endif

	llIsCIF = Iif(lnCIFPart = 0, loVerificare.IsCIF(m.lcCodFiscal), (lnCIFPart = 1))

	*!* VERIFIC VALIDITATEA CODULUI
	If llIsCIF
		llValid = loVerificare.Validare('CIF', m.lcCodFiscal)
	Else
		llValid = loVerificare.Validare('CNP', m.lcCodFiscal)
	Endif


	*** DOAR VERIFICARE VALIDITATE
	If  m.lcTipVerificare = "VALIDARE" Or 'MANUAL' $ lcTipVerificare
		Return m.llValid
	Endif

	*!* DOAR PENTRU CIF-URI VERIFIC DENUMIREA, REG_COMERT, CALITATEA DE PLATITOR TVA
	If m.llIsCIF
		Do Case
			Case m.lcTipVerificare = 'ANAF_SERVICIU_WEB'
				lcXml = loVerificare.Verificare('CIF', m.lcCodFiscal, 'ANAF', m.ldDataAct)
			Otherwise
				If m.lcTipVerificare = 'MFIN_AUTO_FARA_CAPTCHA'
					loVerificare.lOneSession = .F.
					loVerificare.lCaptcha = .F.
				Endif
				lcXml = loVerificare.Verificare('CIF', m.lcCodFiscal, IIF(m.lcTipVerificare = 'VIES_AUTO', 'VIES', 'MFIN'), m.ldDataAct)
		Endcase
		If Type('loVerificare.oEntitate') = 'O'
			toPartenerVerificare = loVerificare.oEntitate
		Endif
	Endif && llIsCIF


	Return m.llValid
Endproc && verifica_partener

********************************************
*** formular cu informatiile verificate la mfinante.ro
*** apelat din verifica_partener (cautalf, frm_partener_nou)
*** intoarce: 1=OK, 6=YES, 7=NO
********************************************
Function verifica_partener_show_info
	Lparameters toPartenerVerificare, tcCodFiscal, tcDenumire, tcMesajIntrebare
	*** toPartenerVerificare: IN, obiect cu informatiile de la mfinante.ro
	*** tcCodFiscal: IN, codul fiscal verificat
	*** tcDenumire: IN, denumire partener verificat
	*** tcMesajIntrebare: IN, optional, daca se intreaba ceva la sfarsitul formularului (ex: Se completeaza datele in formularul partener nou?)

	Local lcCodFiscal, lcDenumire, lcText, llCodRO, llPlatitorTVAMfin, llPlatitorTVAVIES, lnDialogType
	Local lnRaspuns, loPartener, lcProvenienta

	lcCodFiscal = Transform(m.tcCodFiscal)
	lcDenumire = Transform(m.tcDenumire)
	loPartener = toPartenerVerificare
	lnDialogType = Iif(!Empty(m.tcMesajIntrebare), 4 + 32, 0 + 64)
	llPlatitorTVAMfin = loPartener.platitortvamfin
	llCodRO = (Left(m.lcCodFiscal, 2) = 'RO')
	llPlatitorTVAVIES = loPartener.PlatitorTVA
	llTvaIncasare = loPartener.tvaincasare
	llSplitTVA = loPartener.splittva
	llInactiv = loPartener.inactiv
	*!* 01.08.2026 marius.mutu: marcaj explicit al sursei (ANAF live / cache), nu doar pe randurile din cache
	lcProvenienta = ''
	If Pemstatus(m.loPartener, 'sursa', 5) And !Empty(Alltrim(Nvl(loPartener.sursa, '')))
		lcProvenienta = Iif(Alltrim(Nvl(loPartener.sursa, '')) == 'ANAF', '(sursa: ANAF)', ;
			'(sursa: CACHE ' + Dtoc(Nvl(loPartener.data_sursa, Date())) + Iif(Alltrim(Nvl(loPartener.sursa, '')) == 'CACHE_INDISP', ', ANAF indisponibil', '') + ')')
	Endif

	lcText = 'VERIFICARE CIF: ' + m.lcCodFiscal + ' ' + m.lcDenumire + crlf + crlf + ;
		Alltrim(loPartener.firma) + crlf + ;
		Iif(!Empty(m.lcProvenienta), m.lcProvenienta + crlf, '') + ;
		Iif((m.llPlatitorTVAMfin And !m.llCodRO) Or (!m.llPlatitorTVAMfin And m.llCodRO), ' *** ATENTIE *** ', '') + ;
		Iif(m.llPlatitorTVAMfin, "PLATITOR TVA (" + Alltrim(loPartener.datatvamfin) + ")", "NEPLATITOR TVA") +  crlf + ;
		'Stare: ' + Alltrim(loPartener.stare) + crlf + ;
		'TVA Incasare: ' + Iif(m.llTvaIncasare, 'DA', 'NU') + crlf + ;
		'Split TVA: ' + Iif(m.llSplitTVA, 'DA', 'NU') + crlf + ;
		'Inactiv: ' + Iif(m.llInactiv, 'DA *** ATENTIE!', 'NU') + crlf + ;
		'----------------------------------------------------' + crlf + ;		
		'* Adresa: ' + Alltrim(loPartener.adresa) + crlf + ;
		'* Judet: ' + loPartener.judet + crlf + ;
		'* Nr. inregistrare la Registrul Comertului: ' + loPartener.regcom + crlf + ;
		'* Cod Postal: ' + loPartener.codpostal + crlf + ;
		'* Telefon: ' + loPartener.telefon + crlf + ;
		'* Fax: ' + loPartener.fax + crlf + ;
		Iif(!Empty(loPartener.eroare), Alltrim(loPartener.eroare) + crlf, '') + ;
		'----------------------------------------------------' + crlf + crlf + ;
		Iif(!Empty(m.tcMesajIntrebare), m.tcMesajIntrebare + crlf + crlf + crlf, "")

	lnRaspuns = amessagebox(lcText, m.lnDialogType, _Screen.Caption)
	Return m.lnRaspuns
Endfunc && verifica_partener_show_info

Function GetMeniuVerificareCodFiscal
	Lparameters tcCodFiscal, tcOptiuniMeniuAnte

	Local lcMenu, llVerificareCod
	llVerificareCod = Type('tcCodFiscal') = 'C' And !Empty(m.tcCodFiscal)
	lcMeniuOptiuniAnte = Iif(Type('tcOptiuniMeniuAnte') = 'C' And !Empty(m.tcOptiuniMeniuAnte), Alltrim(m.tcOptiuniMeniuAnte), '')

	lcMenu = lcMeniuOptiuniAnte + ;
		Iif(!m.llVerificareCod, "\", "") + "Verificare ANAF (automat);" + ;
		"\-;" + ;
		Iif(!m.llVerificareCod, "\", "") + "Verificare MFINANTE (manual);" + ;
		"\-;" + ;
		Iif(!m.llVerificareCod, "\", "") + "Verificare Registru inactivi ANAF (manual);" + ;
		"\-;" + ;
		Iif(!m.llVerificareCod, "\", "") + "Verificare Registru TVA Incasare (automat);" + ;
		Iif(!m.llVerificareCod, "\", "") + "Verificare Registru TVA Incasare (manual);" + ;
		"\-;" + ;
		Iif(!m.llVerificareCod, "\", "") + "Verificare VIES (automat);" + ;
		Iif(!m.llVerificareCod, "\", "") + "Verificare VIES (manual);" + ;		
		"\-;" + ;
		"Istoric verificari cod fiscal"

	Return m.lcMenu
Endfunc

**************************************
*** Intoarce optiunea aleasa din meniul de verificare cod fiscal
Function GetOptiuneVerificareCodFiscal
	Lparameters tnOptiune
	Local lnOptiune, lcTipVerificare

	lnOptiune = Iif(Type('tnOptiune') = 'N', m.tnOptiune, 0)

	lcTipVerificare = Iif(m.lnOptiune = 1, 'ANAF_SERVICIU_WEB', ;
		  Iif(m.lnOptiune = 3, 'MFIN_MANUAL_COD', ;
			Iif(m.lnOptiune = 5, 'ANAF_MANUAL_COD', ;
			  Iif(m.lnOptiune = 7, 'RTVAI_AUTO_COD', ;
				Iif(m.lnOptiune = 8, 'RTVAI_MANUAL_COD', ;
				  Iif(m.lnOptiune = 10, 'VIES_AUTO', ;
					Iif(m.lnOptiune = 11, 'VIES_MANUAL', ;
				  Iif(m.lnOptiune = 13, 'ISTORIC', ''))))))))

	Return m.lcTipVerificare
Endfunc

**********************************************
*** Arata un meniu cu optiuni de verificare a unui cod fiscal
*** Intoarce raspuns 0 = Ok, 1 = YES, 7 = CANCEL daca se doreste completarea datelor in adaugarea de parteneri
**********************************************
Procedure VerificaCodFiscal
	Lparameters toDate, lnOptiune, loPartener
	* toDate - obiect cu proprietati (cod_fiscal, denumire, data, cod_judet, cod_auto)
	* loOptiune (OUT): optiunea aleasa, daca mai sunt si alte optiuni in afara de cele de verificare cod fiscal
	* loPartener (OUT): obiect cu datele completate in urma verificarii pe mfinante.ro sau serviciu web ANAF

	If .F.
		loPartener = Null
		lnRaspuns = VerificaCodFiscal(loDate, @lnOptiune, @loPartener)
	Endif && .F.


	Local loPartenerX As "empty"
	Local lcAlias, lcCodFiscal, lcDenumire, lcMenu, lcTipVerificare, llValid, lnRaspuns, lcCodJudet, lcCodAuto, lcMesajIntrebare, lcOptiuniMeniuAnte
	Local lnOptiuneVerificare, lcTipVerificare
	Local lcText, ldData, llPlatitorTVAVIES, llVIES

	loPartener = Null
	lnRaspuns = 7 && NO
	lcCodFiscal = ''
	lcDenumire = ''
	ldData = {}
	lcCodJudet = ''
	lcCodAuto = ''
	lcMesajIntrebare = ''
	lcOptiuniMeniuAnte = ''
	lnOptiune = 0
	lnOptiuneVerificare = 0
	lcTipVerificare = ''

	If Type('toDate') <> 'O' Or Isnull(toDate)
		Return m.lnRaspuns
	Endif
	If Pemstatus(toDate, 'cod_fiscal', 5 )
		lcCodFiscal = Alltrim(NVL(toDate.cod_fiscal,''))
	Endif
	If Pemstatus(toDate, 'denumire', 5 )
		lcDenumire = Alltrim(NVL(toDate.denumire,''))
	Endif
	If Pemstatus(toDate, 'data', 5 )
		ldData = NVL(toDate.Data, {})
	Endif

	If Pemstatus(toDate, 'cod_judet', 5 )
		lcCodJudet = Alltrim(NVL(toDate.cod_judet,''))
	Endif

	If Pemstatus(toDate, 'cod_auto', 5 )
		lcCodAuto = Alltrim(NVL(toDate.cod_auto, ''))
	Endif
	If Pemstatus(toDate, 'mesaj_intrebare', 5 )
		lcMesajIntrebare = Alltrim(toDate.mesaj_intrebare)
	Endif

	If Pemstatus(toDate, 'optiuni_meniu_ante', 5 )
		lcOptiuniMeniuAnte = Alltrim(toDate.optiuni_meniu_ante)
	Endif

	If Pemstatus(toDate, 'tip_verificare', 5 )
		lcTipVerificare = Alltrim(toDate.tip_verificare)
	Endif

	If Empty(m.lcCodFiscal)
		Return m.lnRaspuns
	Endif

	If Empty(m.lcTipVerificare)
		lcMenu = GetMeniuVerificareCodFiscal(m.lcCodFiscal, m.lcOptiuniMeniuAnte)
		lnOptiune = XMENU(m.lcMenu)
		lnOptiuneVerificare = m.lnOptiune
		If !Empty(m.lcOptiuniMeniuAnte)
			lnOptiuneVerificare = m.lnOptiuneVerificare - Occurs(';', m.lcOptiuniMeniuAnte)
		Endif
		lcTipVerificare = GetOptiuneVerificareCodFiscal(m.lnOptiuneVerificare)
	Else
		lnOptiune = 1
		lnOptiuneVerificare = 1
	Endif

	If Empty(m.lnOptiune)
		Return m.lnRaspuns
	Endif

	Do Case
		Case m.lcTipVerificare = 'ISTORIC'
			Do verificare_parteneri_istoric With m.lcCodFiscal && In proceduri_comune.prg

		Case m.lcTipVerificare = 'RTVAI_AUTO_COD'
			loPartenerX = Createobject("empty")
			loPartener = Createobject("empty")
			AddProperty(loPartenerX, "cod_fiscal", m.lcCodFiscal)
			AddProperty(loPartenerX, "denumire", m.lcDenumire)
			AddProperty(loPartenerX, "dataact", m.ldData)
			llValid = VERIFICA_RTVAI(loPartenerX, @loPartener)
			If !m.llValid
				amessagebox('Codul ' + m.lcCodFiscal + ' este invalid!', 0 + 48, _Screen.Caption)
			Else
				If Pemstatus(loPartener, "leinRtvai", 5)
					If loPartener.leinRtvai
						amessagebox('Partenerul  ' + m.lcDenumire + ' cu codul fiscal: ' + m.lcCodFiscal + crlf + ' este in sistemul TVA la incasare!', 0 + 48, _Screen.Caption)
					Else
						amessagebox('Partenerul  ' + m.lcDenumire + ' cu codul fiscal: ' + m.lcCodFiscal + crlf + ' NU este in sistemul TVA la incasare!', 0 + 48, _Screen.Caption)
					Endif
				Endif
			ENDIF
			
		Case m.lcTipVerificare = 'VIES_AUTO'
			loPartenerX = Createobject("empty")
			loPartener = Createobject("empty")
			AddProperty(loPartenerX, "cod_fiscal", m.lcCodFiscal)
			AddProperty(loPartenerX, "denumire", m.lcDenumire)
			AddProperty(loPartenerX, "dataact", m.ldData)
			llValid = verifica_partener(m.lcTipVerificare, loPartenerX, @loPartener)

			If !m.llValid
				amessagebox('Codul ' + m.lcCodFiscal + ' este invalid!', 0 + 48, _Screen.Caption)
			ELSE
				llPlatitorTVAVIES = loPartener.PlatitorTVA
				llVIES = loPartener.VIES

				lcText = 'VERIFICARE CIF: ' + m.lcCodFiscal + ' ' + m.lcDenumire + crlf + crlf + ;
					Alltrim(NVL(loPartener.firma,'')) + crlf + ;
					Alltrim(NVL(loPartener.adresa,'')) + crlf + ;
					Iif(m.llVIES, 'S-a interogat baza de date VIES: ' + Iif(m.llPlatitorTVAVIES, 'PLATITOR TVA VIES', 'NEPLATITOR TVA VIES'), 'Nu s-a interogat baza de date VIES!')

				AMESSAGEBOX(m.lcText, 0+64, _Screen.Caption)
			ENDIF 

		Otherwise
			loPartenerX = Createobject("empty")
			loPartener = Createobject("empty")
			AddProperty(loPartenerX, "cod_fiscal", m.lcCodFiscal)
			AddProperty(loPartenerX, "denumire", m.lcDenumire)
			AddProperty(loPartenerX, "dataact", m.ldData)
			llValid = verifica_partener(m.lcTipVerificare, loPartenerX, @loPartener)

			If !m.llValid
				amessagebox('Codul ' + m.lcCodFiscal + ' este invalid!', 0 + 48, _Screen.Caption)
			ELSE
				If Pemstatus(loPartener, "platitortvamfin", 5)
					lnRaspuns = verifica_partener_show_info(loPartener, m.lcCodFiscal, m.lcDenumire, m.lcMesajIntrebare)
				ENDIF
			Endif
	Endcase

	Return m.lnRaspuns && raspunsul la intrebarea 'Doriti sa completati datele partenerului?' in formularul Adaugare partener

Endproc && VerificaCodFiscal

****************************************************************
*** Verificare manuala platitor TVA pe mfinante.ro / registru inactivi anaf.ro / registru tva incasare anaf.ro
*** Lanseaza browserul cu adresa mfinante.ro, anaf.ro
****************************************************************
Procedure VERIFICA_MANUAL_MFINANAF
	Lparameters tcTip, tcCodFiscal, tcDenumire, tcCodJudet
	*** tcTIP: MFIN/MFINCOD/MFINNUME/ANAF
	*** tcCodFiscal: MFIN - se face verificarea dupa cod fiscal daca este completat, altfel verificare dupa nume, judet

	Local lcCodAuto, lcCodFiscal, lcDenumire, lcTipVerificare, lcURL, lcAtributFiscal
	lcCodFiscal = UPPER(Alltrim(Transform(m.tcCodFiscal)))
	lcDenumire = Alltrim(Transform(m.tcDenumire))
	lcCodJudet = Alltrim(Transform(m.tcCodJudet))
	lcURL = ""
	lcAtributFiscal = ''
	
	If Isalpha(m.lcCodFiscal)
		lcAtributFiscal = lcAtributFiscal + LEFT(m.lcCodFiscal,1)
		lcCodFiscal = Alltrim(Substr(m.lcCodFiscal, 2))
		If Isalpha(lcCodFiscal)
			lcAtributFiscal = lcAtributFiscal + LEFT(m.lcCodFiscal,1)
			lcCodFiscal = Alltrim(Substr(m.lcCodFiscal, 2))
		Endif
	Endif

	lctip = Iif(!Empty(m.tcTip), Upper(Alltrim(m.tcTip)), "MFIN")

	Do Case
		Case "MFIN" $ m.lctip
			lcTipVerificare = Iif("NUME" $ m.lctip, "NUME", "COD")

			If m.lcTipVerificare = "COD"
				lcURL = "https://www.mfinante.gov.ro/apps/infocodfiscal.html?cod=" + m.lcCodFiscal
			Else
				lcURL = "https://www.mfinante.gov.ro/apps/numeCod.html?judet=" + m.lcCodJudet + "&name=" + m.lcDenumire + "&submit=VIZUALIZARE"

			Endif
		Case "ANAF" $ m.lctip
			Text To lcURL Noshow Textmerge
https://www.anaf.ro/inactivi?codFiscal=<<m.lcCodFiscal>>&judet=<<m.lcCodJudet>>&inputdenumire=<<m.lcDenumire>>
			Endtext
		Case "RTVAI" $ m.lctip
			Text To lcURL Noshow Textmerge
https://www.anaf.ro/IncasareTva/cautCodTvaIncasare.do?codFiscal=<<m.lcCodFiscal>>
			Endtext
		Case "VIES" $ m.lctip
			Text To lcURL Noshow Textmerge
https://ec.europa.eu/taxation_customs/vies/viesquer.do?iso=<<m.lcAtributFiscal>>&vat=<<m.lcCodFiscal>>&ms=<<m.lcAtributFiscal>>
			ENDTEXT 

	Endcase
	If !Empty(m.lcURL)
		OPEN_DEFAULT_APP(m.lcURL)
	Endif
Endproc && VERIFICA_MANUAL_MFINANAF

************************************************************
*** VERIFICA DACA PARTENERUL ESTE IN REGISTRUL TVA INCASARE
************************************************************
Procedure VERIFICA_RTVAI
	Lparameters  toPartener, toPartenerOut
	* toPartener datele partenerului: cod_fiscal,denumire,dataact
	* toPartenerOut (OUT): denumire,leInRTVAI din AgentiRtvai 

	Local lcCodFiscal, lcDenumire, ldDataAct, llIsCIF, llValid, lcSql, llSucces
	Local loVerificare As "verificarecod"
	Private pcDenumire, pdData, pnCodFiscal, pnRTVAI

	If Type('toPartener') = 'O'
		lcCodFiscal = Iif(Pemstatus(toPartener, "cod_fiscal", 5), Alltrim(toPartener.cod_fiscal), '')
		lcDenumire = Iif(Pemstatus(toPartener, "denumire", 5), Alltrim(Upper(toPartener.denumire)), '')
		ldDataAct = Iif(Pemstatus(toPartener, "dataact", 5), toPartener.dataact, {})
	Else
		lcCodFiscal = Transform(toPartener)
	Endif


	loVerificare = Createobject("verificarecod") && validare.prg
	llIsCIF = loVerificare.IsCIF(m.lcCodFiscal)

	*!* VERIFIC VALIDITATEA CODULUI
	If m.llIsCIF
		llValid = loVerificare.Validare('CIF', m.lcCodFiscal)
*!*		Else
*!*			llValid = loVerificare.Validare('CNP', m.lcCodFiscal)
	Endif
	If !Pemstatus(toPartenerOut, "leinRtvai", 5)
		AddProperty(toPartenerOut, "leinRtvai", .F.)
	Endif
	If !Pemstatus(toPartenerOut, "denumire", 5)
		AddProperty(toPartenerOut, "denumire", "")
	Endif

	If m.llIsCIF AND m.llValid
		If Empty(m.ldDataAct)
			ldDataAct = Date(m.gnAn, m.gnLuna, 1)
		Endif

		If Isalpha(m.lcCodFiscal)
			lcCodFiscal = Alltrim(Substr(m.lcCodFiscal, 2))
			If Isalpha(lcCodFiscal)
				lcCodFiscal = Alltrim(Substr(m.lcCodFiscal, 2))
			Endif
		Endif
		pnCodFiscal = Int(Val(m.lcCodFiscal))
		pdData = ldDataAct
		pcDenumire = ''
		pnRTVAI = 0
		lcSql = [begin pack_roartvai.PartenerInRTVAI(?pnCodFiscal, ?pdData, ?@pcDenumire, ?@pnRTVAI); end;]

		llSucces = goExecutor.oExecuta(m.lcSql)
		If m.llSucces
			toPartenerOut.leinRtvai = (m.pnRTVAI = 1)
			toPartenerOut.denumire = Alltrim(Nvl(pcDenumire, ''))
		Endif

	Endif && m.llValid

	Return m.llValid
Endproc && VERIFICA_RTVAI


************************************************************
*** Intoarce .T. daca codul fiscal exista in REGISTRUL TVA INCASARE la data
************************************************************
Function VERIFICA_RTVAI_DATA
	Lparameters  tcCodFiscal, tdDataAct, tcDenumire
	* tcCodFiscal: codul fiscal de verificat in RTVAI
	* tdDataAct: data documentului (optional) / 1 ale lunii curente, daca nu este dat
	* tcDenumire: OUT denumirea din RTVAI, daca exista

	Private pcDenumire, pdData, pnCodFiscal, pnRTVAI
	Local lcCodFiscal, lcDenumire, lcSql, ldDataAct, leinRtvai, llSucces

	leinRtvai = .F.
	tcDenumire = ''

	lcCodFiscal = Iif(Type('tcCodFiscal') = 'C', Alltrim(Nvl(m.tcCodFiscal, '')), '')
	ldDataAct = Iif(!Empty(m.tdDataAct), m.tdDataAct, Date(m.gnAn, m.gnLuna, 1))

	If Empty(m.lcCodFiscal)
		Return m.leinRtvai
	Endif

	If Isalpha(m.lcCodFiscal)
		lcCodFiscal = Alltrim(Substr(m.lcCodFiscal, 2))
		If Isalpha(lcCodFiscal)
			lcCodFiscal = Alltrim(Substr(m.lcCodFiscal, 2))
		Endif
	Endif

	pnCodFiscal = Int(Val(m.lcCodFiscal))
	pdData = ldDataAct
	pcDenumire = ''
	pnRTVAI = 0
	lcSql = [begin pack_roartvai.PartenerInRTVAI(?pnCodFiscal, ?pdData, ?@pcDenumire, ?@pnRTVAI); end;]

	llSucces = goExecutor.oExecuta(m.lcSql)
	If m.llSucces
		leinRtvai = (m.pnRTVAI = 1)
		tcDenumire = Alltrim(Nvl(m.pcDenumire, ''))
	Endif

	Return m.leinRtvai
Endfunc && VERIFICA_RTVAI_DATA


*********************************************
*** inlocuieste caracterele speciale dintr-un text xml
*** ex: "&" devine "&amp"
Function XmlSpecialCharacters
	Lparameters tcText

	Local lcText
	lcText = tcText
	lcText = Strtran(m.lcText, '&', '&amp;')
	lcText = Strtran(m.lcText, '"', '&quot;')
	lcText = Strtran(m.lcText, ['], '&apos;')
	lcText = Strtran(m.lcText, '<', '&lt;')
	lcText = Strtran(m.lcText, '>', '&gt;')

	Return lcText
Endfunc && XmlSpecialCharacters


*********************************************
*** curata caracterele care nu sunt permise in nume de fisiere Windows
*** inlocuiesc cu tcReplaceCharacter
Function WindowsSpecialCharacters
	Lparameters tcText, tcReplaceCharacter
	* tcReplaceCharacter: caracterul cu care se inlocuiesc caracterele nepermise in numele fisierelor. Optional, default: ''
	
	Local lcText, lcRC
	lcRC= IIF(!EMPTY(m.tcReplaceCharacter) and TYPE('tcReplaceCharacter') = 'C' and AT(m.tcReplaceCharacter, [/\?%*:|"<>.,;=]) = 0, m.tcReplaceCharacter, '')

	lcText = STRTRAN(STRTRAN(STRTRAN(STRTRAN(STRTRAN(STRTRAN(STRTRAN(STRTRAN(Strtran(TRANSFORM(m.tcText), [<], m.lcRC,1,10), [>], m.lcRC,1,10), [:], m.lcRC,1,10), ["], m.lcRC,1,10), ;
		[/], m.lcRC,1,10), [\], m.lcRC,1,10), [|], m.lcRC,1,10), [?], m.lcRC,1,10), [*], m.lcRC,1,10)

	Return lcText
Endfunc && WindowsSpecialCharacters

*********************************************
*** face conversia de la Double Byte la UTF8
*** curata textul de diacritice, spatii, CR/LF, 
*** lcMesaj = RemoveCharactersDB(lcMesaj, .T.)
*********************************************
FUNCTION RemoveCharactersDB
	Lparameters tcText, tlDiacritics, tlSpaces, tlCR
	LOCAL lcText
	
	lcText = STRCONV(tcText, 9)  && conversie la UTF-8
	lcText = RemoveCharacters(tcText, tlDiacritics, tlSpaces, tlCR)
	RETURN m.lcText
ENDFUNC 
*********************************************
*** curata textul de diacritice, spatii, CR/LF
*********************************************
Function RemoveCharacters
	Lparameters tcText, tlDiacritics, tlSpaces, tlCR
	*** tcText: textul initial
	*** tlDiacritics: inlocuieste diacriticele
	*** tlSpaces: sterge spatiile
	*** tlCR: sterge CR si LF

	Local lcText
	lcText = IIF(TYPE('tcText') = 'C', Nvl(m.tcText, ''), '')

	IF EMPTY(m.lcText)
		RETURN ''
	ENDIF 
	
	If m.tlDiacritics
		lcText = STRTRAN(STRTRAN(Strtran(Nvl(m.lcText, ''), Chr(197) + CHR(162), 'T', 1,100,1), Chr(197) + CHR(63), 'S', 1,100,1), Chr(196) + CHR(63), 'A', 1,100,1)
		lcText = Strtran(Nvl(m.lcText, ''), Chr(195) + CHR(63), 'I', 1,100,1)
		lcText = Strtran(Strtran(Strtran(Strtran(Strtran(Nvl(m.lcText, ''), Chr(170), 'S', 1,100,1), Chr(222), 'T', 1,100,1), Chr(226), 'A', 1,100,1), Chr(227), 'A', 1,100,1), Chr(238), 'I', 1,100,1)
		lcText = STRTRAN(Strtran(Strtran(Strtran(Nvl(m.lcText, ''), Chr(206), 'I', 1,100,1), Chr(194), 'A', 1,100,1), Chr(195), 'A', 1,100,1), Chr(196), 'A', 1,100,1)
		lcText = STRTRAN(m.lcText, CHR(2), '',1,100,1) && caracter neprintabil		
		
		* Inlocuiri pentru diacritice - minuscule
		lcText = STRTRAN(lcText, "A„?", "a")    && a
		lcText = STRTRAN(lcText, "Ac??", "a")   && â
		lcText = STRTRAN(lcText, "A^?", "t")    && ?
		lcText = STRTRAN(lcText, "AfA®", "i")   && î
		lcText = STRTRAN(lcText, "A„", "a")     && a (alta varianta)
		lcText = STRTRAN(lcText, "Až", "s")     && ?

		* Inlocuiri pentru diacritice - majuscule
		lcText = STRTRAN(lcText, "A‚", "A")     && A
		lcText = STRTRAN(lcText, "A®", "I")     && I
		lcText = STRTRAN(lcText, "Až", "S")     && ?
		lcText = STRTRAN(lcText, "Ac", "T")     && ?
		lcText = STRTRAN(lcText, "Ä‚", "A")     && A
	ENDIF
		
	If m.tlSpaces
		lcText = Strtran(m.lcText, ' ', '', 1, 100, 1)
	Endif
	If m.tlCR
		lcText = Strtran(Strtran(m.lcText, Chr(13), ''), Chr(10), '')
	Endif

	Return m.lcText
Endfunc


****************************************************
Function OracleSpecialCharacters
	Lparameters tcText
	Local lcText
	lcText = tcText
	lcText = Strtran(m.lcText, "'", "''")

	Return lcText
Endfunc	&& OracleSpecialCharacters
****************************************************
*** Citeste din optiuni utilizator ordinea coloanelor dintr-un grid de tipul ferestre_cere_date.vcx > ct_grid_search
*** ointroduceri.prg > lans_nir_bon > grid nomenclator articole
*** ointroduceri.prg > achizitie_import > fereastra cautare repere pentru adaugare
*** Intoarce obiectul loSelectie(titlu_col M, nume_col M, ordine C(50), width_col M, pornire N(2))
*** Pentru salvarea ordinii coloanelor din grid, criteriului de sortare se apeleaza SCRIE_SELECTII_OPTIUNI_UTILIZATOR()
****************************************************
Procedure CITESTE_SELECTII_OPTIUNI_UTILIZATOR
	Lparameters tcOptiune, tcListaColoaneGrid, tcCursor, tcSearchColumn, tuSearchValue
	*!* CITESTE_SELECTII_OPTIUNI_UTILIZATOR("GEST_SELECTII", ost.nume_col, "crsGestSelectiiUtilizator", "id_sel", oSet.id_selSt)
	*!*	tcOptiune: "GEST_SELECTII"
	*!*	tcListaColoaneGrid: lista coloanelor din grid: "codmat;denumire;um;serie;cantitate;pret;cant_bax;um2;grupa;subgrupa;cgest;cont;acont;datain;codmatf;lot;adata_expirare;nrord_rez;part_rez"
	*!* tcCursor: "crsGestSelectiiUtilizator" (default = "crsSelectiiUtilizator")
	*!*	tcSearchColumn (optional): "ID_SEL" (daca in cursorul xml sunt mai multe inregistrari si doresc o anume inregistrare)
	*!*	tuSearchValue (optional): 1 (valoarea pentru tcSearchColumn)
	*!* RETURN: loSelectie (titlu_col, nume_col, ordine, width_col, pornire)

	Local lcCursor, lcListaColoaneCursor, lcListaColoaneGrid, lcOptiune, lcSchemaCursor, lcSearchColumn
	Local lcSelectii, lcSirOrdonatCursor, lcSirOrdonatGrid, loSelectie, luSearchValue

	lcOptiune = Upper(Alltrim(tcOptiune))
	lcListaColoaneGrid = m.tcListaColoaneGrid
	lcCursor = Iif(!Empty(m.tcCursor), m.tcCursor, "crsSelectiiUtilizator")
	lcSearchColumn = ""
	luSearchValue = ""
	If !Empty(tcSearchColumn) And !Empty(tuSearchValue) And Type('tcSearchColumn') = 'C'
		lcSearchColumn = Upper(Alltrim(tcSearchColumn))
		luSearchValue = tuSearchValue
	Endif

	lcSchemaCursor = "titlu_col M, nume_col M, ordine C(50), width_col M, pornire N(2)"
	If !Empty(m.lcSearchColumn)
		lcSchemaCursor = lcSearchColumn + " " + Type('tuSearchValue') + "(" + Len(tuSearchValue) + ")," + m.lcSchemaCursor
	Endif
	Create Cursor (m.lcCursor) (&lcSchemaCursor)
	Select (m.lcCursor)
	Scatter Name loSelectie Memo Blank

	lcSelectii = citeste_optiune_utilizator(m.lcOptiune)
	If !Empty(m.lcSelectii)
		Xmltocursor(m.lcSelectii, m.lcCursor)

		Select (m.lcCursor)
		If !Empty(m.lcSearchColumn)
			Locate For &lcSearchColumn = luSearchValue
			If Found()
				Scatter Name loSelectie Memo
			Endif
		Else
			Go Top
			Scatter Name loSelectie Memo
		Endif

		**-- compara daca am aceleasi coloane (control source) pe server si in tabelul din proiect (gest_selectii)
		Create Cursor crsListaCursor (element C(100))
		Create Cursor crsListaGrid (element C(100))

		lcListaColoaneCursor = loSelectie.nume_col
		lista2cursor(lcListaColoaneCursor, "crsListaCursor", "element", ";")
		lista2cursor(lcListaColoaneGrid, "crsListaGrid", "element", ";")

		Select * From crsListaCursor ;
			Order By element ;
			Into Cursor crsListaCursorOrd

		Select * From crsListaGrid ;
			Order By element ;
			Into Cursor crsListaGridOrd

		lcSirOrdonatCursor = cursor2lista("crsListaCursorOrd", "element", ";")
		lcSirOrdonatGrid = cursor2lista("crsListaGridOrd", "element", ";")

		Use In (Select('crsListaCursor'))
		Use In (Select('crsListaGrid'))
		Use In (Select('crsListaCursorOrd'))
		Use In (Select('crsListaGridOrd'))

		If lcSirOrdonatCursor <> lcSirOrdonatGrid
			Select (m.lcCursor)
			Scatter Name loSelectie Memo Blank
		Endif

	Endif

	Return loSelectie
Endproc && CITESTE_SELECTII_OPTIUNI_UTILIZATOR

************************************************************************************************
*** NIR.INAINTE_DE_DO_TERMIN
*** SCRIE_SELECTII_OPTIUNI_UTILIZATOR("GEST_SELECTII", toCtGridSearch, ["crsGestSelectiiUtilizator", "id_sel", oSet.id_selSt])
***	tcOptiune: "GEST_SELECTII"
*** toCtGridSearch: referinta la containerul cu grid de tipul ct_grid_search
*** tcDescriere (optional): descriere optiune
*** tcCursor (optional): "crsGestSelectiiUtilizator" (default = "crsSelectiiUtilizator")
***	tcSearchColumn (optional): "ID_SEL" (daca in cursorul xml sunt mai multe inregistrari si doresc sa modific o anume inregistrare)
***	tuSearchValue (optional): 1 (valoarea pentru tcSearchColumn)
************************************************************************************************
Procedure SCRIE_SELECTII_OPTIUNI_UTILIZATOR
	Lparameters tcOptiune, toCtGridSearch, tcDescriere, tcCursor, tcSearchColumn, tuSearchValue

	Local lcDescriere, lcSearchColumn, luSearchValue
	Local loCtGridSearch, lcOptiune, lcCursor, lcSelect
	Local lcColOrd, lcControlSource, lcControlSource2, lcCursorXML, lcHeader, lcHeader2, lcNumeCol
	Local lcOrd, lcOrdine, lcTitluCol, lcWidthCol, lcWidthColumn, lcWidthColumn2, llNrOrd, lnColOrd
	Local lnNrCols, lnPornire, loSelectie, i

	lcSelect  = Select()
	loCtGridSearch = toCtGridSearch
	lcOptiune = Upper(Alltrim(tcOptiune))
	lcCursor = Iif(!Empty(m.tcCursor), m.tcCursor, "crsSelectiiUtilizator")
	lcDescriere = Iif(!Empty(m.tcDescriere), Alltrim(m.tcDescriere), Program(1))
	lcSearchColumn = Iif(!Empty(m.tcSearchColumn), Alltrim(m.tcSearchColumn), "")
	luSearchValue = Iif(!Empty(m.luSearchValue), m.luSearchValue, "")

	Create Cursor crsGrid (ordine N(3), ctrSource C(100), titlu C(100), widthCol C(100))

	lnNrCols = loCtGridSearch._GRID1.ColumnCount
	llNrOrd = loCtGridSearch.lNumerotare
	lnPornire = Val(loCtGridSearch.cb_tx_cautare1.criteriu.Value)

	For i = 1 To lnNrCols
		If llNrOrd And i <> 1 && ce se intampla daca nu e llNrOrd ??????
			lcColOrd = [loCtGridSearch._grID1.column] + Alltrim(Str(i)) + [.columnorder]
			lnColOrd = &lcColOrd

			*!*	modificare	v 2.1.19
			*!*			lcHeader = [this.ct_grid_search1._grid1.column] + Alltrim(Str(I))+ [.grh]+Alltrim(Str(I))+[.]+[Caption]
			lcHeader = [loCtGridSearch._GRID1.column] + Alltrim(Str(i)) + [.grh] + Alltrim(Str(i))
			If Type(lcHeader) = 'O'
				lcHeader = lcHeader + [.Caption]
			Else
				*!*	daca nu se poate ordona dupa coloana respectiva, atunci am Header1 in loc de grhI
				lcHeader = [loCtGridSearch._GRID1.column] + Alltrim(Str(i)) + [.header1.Caption]
			Endif
			*!*	modificare	v 2.1.19	^
			lcHeader2 = &lcHeader

			lcControlSource = [loCtGridSearch._grid1.column] + Alltrim(Str(i)) + [.ControlSource]
			lcControlSource2 = &lcControlSource

			lcWidthColumn = [loCtGridSearch._grid1.column] + Alltrim(Str(i)) + [.width]
			lcWidthColumn2 = Alltrim(Str(&lcWidthColumn))

			Insert Into crsGrid (ordine, titlu, ctrSource, widthCol) Values (lnColOrd, lcHeader2, lcControlSource2, lcWidthColumn2)
		Endif
	Endfor


	Select * From crsGrid Order By ordine Into Cursor crsGridOrd
	Use In (Select('crsGrid'))

	lcTitluCol = ""
	lcNumeCol = ""
	lcWidthCol = ""
	Select crsGridOrd
	Scan
		lcTitluCol = lcTitluCol + Alltrim(titlu) + ","
		lcNumeCol = lcNumeCol + Alltrim(ctrSource) + ";"
		lcWidthCol = lcWidthCol + Alltrim(widthCol) + ";"

		Select crsGridOrd
	Endscan

	lcTitluCol = Substr(lcTitluCol, 1, Len(lcTitluCol) - 1)
	lcNumeCol = Substr(lcNumeCol, 1, Len(lcNumeCol) - 1)
	lcWidthCol = Substr(lcWidthCol, 1, Len(lcWidthCol) - 1)

	lcOrd = [loCtGridSearch.corder]
	lcOrdine = &lcOrd


	Select (m.lcCursor)
	Scatter Name loSelectie Memo Blank
	With loSelectie
		.titlu_Col = m.lcTitluCol
		.nume_col = m.lcNumeCol
		.ordine = m.lcOrdine
		.width_Col = m.lcWidthCol
		.pornire = m.lnPornire
	Endwith

	If !Empty(m.lcSearchColumn)
		loSelectie.&lcSearchColumn = luSearchValue && loSelectii.id_sel = oSet.id_selSt

		Locate For &lcSearchColumn = luSearchValue
		If Found()
			Delete
		Endif
	Else
		Go Top
		Delete
	Endif

	Insert Into (m.lcCursor) From Name loSelectie


	lcCursorXML = ''
	Cursortoxml(m.lcCursor, "lcCursorXML", 2, 0 + 2 + 8, 0, "1")

	scrie_optiune_utilizator(m.lcOptiune, lcCursorXML, "Ordinea coloanelor in tabelul din stanga in formularele de nir, bon, etc.")

	Select (m.lcSelect)
Endproc && SCRIE_SELECTII_OPTIUNI_UTILIZATOR


*----------------------------------------------------------------------
* Function....: ExportToXMLExcel
* Author......: Core concepts presented at SW Fox 2009 by Cristof Wollenhaupt
*             : Enhancements 11/21/2009  by Stein Goering
* Abstract....: Exports the current cursor to Excel (XMLSS format), optionally creates file
* Returns.....: XML string, or number of bytes written if file is specified
* Parameters..: Path and Filename of Excel file (optional)
* Notes.......:
*----------------------------------------------------------------------
#If .F.
	* Example of usage
	Create Cursor Sample (cData C(30), nData N(9, 3), tData D, iData i, lData L)
	Insert Into Sample Values("MadFox Rocks!", 0, {}, 5, .F.)
	Insert Into Sample Values("abcdefghijklmnopqrstuvwxyz123", 34.987, Datetime(), -32760, .T.)
	Insert Into Sample Values("1.23", 56, Datetime(), 6, .F.)
	Browse

	If ExportToXMLExcel("Sample.xls") = 0
		Wait Window [Problem writing file]
	Endif
#Endif

Function ExportToXMLExcel(lcFileName)
	Local lcWorksheet, lcPoint, lcData, lcRow, lnField, luValue, lcFieldName, lcType, lnWidth, lcColDef, lnCols
	Local lcHeading, lnRows, lcStyles
	*--------------------------------------------------------------------------------------
	* Set up environment
	*--------------------------------------------------------------------------------------
	lcPoint = Set("Point")
	Set Point To "."

	*--------------------------------------------------------------------------------------
	* Create the style string
	*--------------------------------------------------------------------------------------
	Set Textmerge Delimiters
	Text To lcStyles Noshow Pretext 3
      <Style ss:ID="numformat">
         <NumberFormat ss:Format="Fixed"/>
      </Style>
      <Style ss:ID="numformat0">
         <NumberFormat ss:Format="0"/>
      </Style>
      <Style ss:ID="numformat1">
         <NumberFormat ss:Format="0.0"/>
      </Style>
       <Style ss:ID="numformat2">
         <NumberFormat ss:Format="0.00"/>
      </Style>
       <Style ss:ID="numformat3">
         <NumberFormat ss:Format="0.000"/>
      </Style>
       <Style ss:ID="numformat4">
         <NumberFormat ss:Format="0.0000"/>
      </Style>
      <Style ss:ID="timeformat">
         <NumberFormat ss:Format="[$-409]m/d/yy\ h:mm\ AM/PM;@"/>
      </Style>
      <Style ss:ID="dateformat">
       <NumberFormat ss:Format="Short Date"/>
      </Style>
     <Style ss:ID="heading">
      <Alignment ss:Horizontal="Center" ss:Vertical="Bottom"/>
      <Font ss:Bold="1" />
     </Style>
	Endtext
	*--------------------------------------------------------------------------------------
	* Assemble the column width and heading strings
	*--------------------------------------------------------------------------------------
	lcHeading = "<Row>"
	lcColDef = []
	Dimension laFields[1]
	lnCols = Afields(laFields)
	For lnField = 1 To lnCols
		lcFieldName = Proper(Strtran(laFields[m.lnField, 1], [_], [ ]))
		lcHeading = m.lcHeading + ;
			[<Cell ss:StyleID="heading"><Data ss:Type="String">] + Strconv(lcFieldName, 9) + [</Data></Cell>]
		lcType = laFields[m.lnField, 2]
		lnWidth = Icase(lcType = [C], laFields[m.lnField, 3] * 4.5, lcType = [N], laFields[m.lnField, 3] * 5, lcType = [I], 40, lcType = [D], 60, lcType = [T], 90, lcType = [L], 25, 50)
		lnWidth = Max(lnWidth, Len(lcFieldName) * 6)  && Make sure col is wide enough to show the heading
		Text To lcColDef Additive Textmerge Noshow Pretext 3
     <Column ss:AutoFitWidth="0" ss:Width="<<TRANSFORM(lnWidth)>>"/>
		Endtext
	Endfor
	lcHeading = m.lcHeading + "</Row>"
	*--------------------------------------------------------------------------------------
	* Assemble the content string
	*--------------------------------------------------------------------------------------
	lcData = ""
	lnRows = 1
	Scan
		lcRow = "<Row>"
		For lnField = 1 To lnCols
			luValue = Evaluate(Field(m.lnField))
			lcType = laFields[m.lnField, 2]
			Do Case
				Case lcType == "C"
					luValue = Alltrim(Nvl(m.luValue, ""))
					lcRow = m.lcRow + ;
						[<Cell><Data ss:Type="String">] + Strconv(m.luValue, 9) + [</Data></Cell>]
				Case lcType == "L"
					luValue = Iif(m.luValue, [True], [False])
					lcRow = m.lcRow + ;
						[<Cell><Data ss:Type="String">] + Strconv(m.luValue, 9) + [</Data></Cell>]
				Case lcType == "N"
					lcRow = m.lcRow + ;
						[<Cell ss:StyleID="numformat] + Transform(laFields[m.lnField, 4]) + ["><Data ss:Type="Number">] + Transform(Nvl(m.luValue, 0)) + ;
						[</Data></Cell>]
				Case lcType == "I"
					lcRow = m.lcRow + ;
						[<Cell ss:StyleID="numformat0"><Data ss:Type="Number">] + Transform(Nvl(m.luValue, 0)) + ;
						[</Data></Cell>]
				Case lcType == "D"
					If Empty(m.luValue)
						lcRow = m.lcRow + ;
							[<Cell ss:StyleID="dateformat"/>]
					Else
						lcRow = m.lcRow + ;
							[<Cell ss:StyleID="dateformat"><Data ss:Type="DateTime">] + Ttoc(Evl(m.luValue, Dtot(Date(1899, 1, 1))), 3) + ;
							[</Data></Cell>]
					Endif
				Case lcType == "T"
					If Empty(m.luValue)
						lcRow = m.lcRow + ;
							[<Cell ss:StyleID="timeformat"/>]
					Else
						lcRow = m.lcRow + ;
							[<Cell ss:StyleID="timeformat"><Data ss:Type="DateTime">] + Ttoc(Evl(m.luValue, Dtot(Date(1899, 1, 1))), 3) + ;
							[</Data></Cell>]
					Endif
				Otherwise
					Assert .F. Message "Type not supported"
			Endcase
			lnRows = lnRows + 1
		Endfor
		lcRow = m.lcRow + "</Row>"
		lcData = m.lcData + m.lcRow
	Endscan

	*--------------------------------------------------------------------------------------
	* Merge the results into the template
	*--------------------------------------------------------------------------------------
	Text To m.lcWorksheet Textmerge Noshow Pretext 3
    <?xml version="1.0"?>
    <Workbook xmlns="urn:schemas-microsoft-com:office:spreadsheet"
     xmlns:x="urn:schemas-microsoft-com:office:excel"
     xmlns:ss="urn:schemas-microsoft-com:office:spreadsheet">
      <Styles>
      <<m.lcStyles>>
      </Styles>
      <Worksheet ss:Name="Sheet1">
      <Table ss:ExpandedColumnCount="<<TRANSFORM(lnCols)>>" ss:ExpandedRowCount="<<TRANSFORM(lnRows)>>"
       x:FullColumns="1" x:FullRows="1">
        <<m.lcColDef>>
        <<m.lcHeading>>
        <<m.lcData>>
        </Table>
      </Worksheet>
    </Workbook>
	Endtext

	*--------------------------------------------------------------------------------------
	* Restore environment
	*--------------------------------------------------------------------------------------
	Set Point To m.lcPoint

	If !Empty(lcFileName)
		Return Strtofile(m.lcWorksheet, lcFileName)
	Else
		Return m.lcWorksheet
	Endif

Endfunc && ExportToXMLExcel


*--------------------------------------------------------------------------------------
* calculeaza procentul de tva din tva/pret
*--------------------------------------------------------------------------------------
Function TVA2PROCTVA
	Lparameters tnTVA, tnPret
	Local lnProcTVA
	lnProcTVA = 1
	If tnPret = 0 Or tnTVA = 0
		lnProcTVA = 1
	Else
		lnProcTVA = Round(tnTVA/tnPret, 2)
		DO CASE 
			CASE gnAn*12+gnLuna >= 2025*12+8
				DO CASE 
					CASE Between(lnProcTVA, 0.10, 0.12)
						lnProcTVA = 1.11
					CASE Between(lnProcTVA, 0.20, 0.22)
						lnProcTVA = 1.21
					OTHERWISE 
						lnProcTVA = 1.21
				ENDCASE 
				
			CASE BETWEEN(gnAn*12+gnLuna, 2024*12+1, 2025*12+7)		
				DO CASE 
					CASE Between(lnProcTVA, 0.08, 0.11)
						lnProcTVA = 1.09
					CASE Between(lnProcTVA, 0.18, 0.20)
						lnProcTVA = 1.19
					CASE Between(lnProcTVA, 0.04, 0.06)
						lnProcTVA = 1.05
					OTHERWISE 
						lnProcTVA = 1.19
				ENDCASE 		
			OTHERWISE
				lnProcTVA = GetCoeficientTvaStandard()
		ENDCASE 
	ENDIF 	
	Return lnProcTVA
Endfunc && TVA2PROCTVA
*!* roagest v 2.0.24 ^

*!* INTOARCE IDJTVA PENTRU COTA STANDARD IN FUNCTIE DE LUNA
*!* 07/2010 S-A MODIFICAT TVA 24%
FUNCTION GetIdJtvaStandard(tcTip, tnProcTVA)
	*!* tcRegistru: JC/JV
	*!* tcTip: VANZARE/VANZARE_TI
	*!* ACHIZITIE/ACHIZITIE_CAPITAL/ACHIZITIE_VANZARE/ACHIZITIE_MATERII/
	*!* ACHIZITIE_TI/ACHIZITIE_TI_CAPITAL/ACHIZITIE_TI_VANZARE/ACHIZITIE_TI_MATERII

	LOCAL lcTip, lnIdJtvaStandard, lnIdVanzareNepl
	Local lnIdVanzare, lnIdVanzareTI, lnIdAchizitieCapital, lnIdAchizitieVanzare, lnIdAchizitieMaterii
	Local lnIdAchizitieTICapital, lnIdAchizitieTIVanzare, lnIdAchizitieTIMaterii, lnIdAchizitie, lnIdAchizitieTI
	
	lcTip = IIF(EMPTY(tcTip) OR TYPE('tcTip') <> 'C', 'VANZARE', UPPER(ALLTRIM(m.tcTip)))
	lnProcTVA = IIF(TYPE('tnProcTVA') = 'N', m.tnProcTVA, GetProcTvaStandard())

	lnIdVanzareNepl = 8
	lnIdAchizitieNepl = 113
	DO CASE 
		CASE m.gnAn * 12 + m.gnLuna >= 2025 * 12 + 8
			* 21%
			lnIdVanzare = IIF(lnProcTVA = 21, 35, IIF(lnProcTVA = 11, 39, 35))
			lnIdVanzareTI = 5		

			lnIdAchizitieCapital = IIF(lnProcTVA = 21, 208, IIF(lnProcTVA = 11, 212, 208)) 
			lnIdAchizitieVanzare = IIF(lnProcTVA = 21, 208, IIF(lnProcTVA = 11, 212, 208)) 
			lnIdAchizitieMaterii = IIF(lnProcTVA = 21, 208, IIF(lnProcTVA = 11, 212, 208)) 
			lnIdAchizitieTICapital = IIF(lnProcTVA = 21, 216, IIF(lnProcTVA = 11, 212, 218)) 
			lnIdAchizitieTIVanzare = IIF(lnProcTVA = 21, 216, IIF(lnProcTVA = 11, 212, 218)) 
			lnIdAchizitieTIMaterii = IIF(lnProcTVA = 21, 216, IIF(lnProcTVA = 11, 212, 218)) 

		CASE m.gnAn * 12 + m.gnLuna <= 2010 * 12 + 6
			* 19%
			lnIdVanzare = 1
			lnIdVanzareTI = 5		
			lnIdAchizitieCapital = 101
			lnIdAchizitieVanzare = 103
			lnIdAchizitieMaterii = 105
			lnIdAchizitieTICapital = 137
			lnIdAchizitieTIVanzare = 139
			lnIdAchizitieTIMaterii = 141				
		OTHERWISE 
			lnIdVanzare = IIF(lnProcTVA = 24, 15, IIF(lnProcTVA = 20, 27, IIF(lnProcTVA = 19, 1, IIF(lnProcTVA = 9, 3, 13))))
			lnIdVanzareTI = 5				
			lnIdAchizitieCapital = IIF(lnProcTVA = 24, 156, IIF(lnProcTVA = 20, 176, IIF(lnProcTVA = 19, 101, IIF(lnProcTVA = 9, 107, 176))))
			lnIdAchizitieVanzare = IIF(lnProcTVA = 24, 156, IIF(lnProcTVA = 20, 176, IIF(lnProcTVA = 19, 103, IIF(lnProcTVA = 9, 109, 176))))
			lnIdAchizitieMaterii = IIF(lnProcTVA = 24, 156, IIF(lnProcTVA = 20, 176, IIF(lnProcTVA = 19, 105, IIF(lnProcTVA = 9, 111, 176))))
			lnIdAchizitieTICapital = IIF(lnProcTVA = 24, 162, IIF(lnProcTVA = 20, 186, IIF(lnProcTVA = 19, 137, IIF(lnProcTVA = 9, 143, 186))))
			lnIdAchizitieTIVanzare = IIF(lnProcTVA = 24, 162, IIF(lnProcTVA = 20, 186, IIF(lnProcTVA = 19, 139, IIF(lnProcTVA = 9, 143, 186))))
			lnIdAchizitieTIMaterii = IIF(lnProcTVA = 24, 162, IIF(lnProcTVA = 20, 186, IIF(lnProcTVA = 29, 141, IIF(lnProcTVA = 9, 145, 186))))
	ENDCASE 
	lnIdAchizitie = lnIdAchizitieMaterii
	lnIdAchizitieTI = lnIdAchizitieTIMaterii	

	lnIdJtvaStandard = lnIdVanzare
	DO CASE 
		CASE 'VANZARE'$lcTip AND m.gnNEPLATITOARE_TVA = 1
			lnIdJtvaStandard = m.lnIdVanzareNepl
		CASE 'ACHZITIE'$lcTip AND m.gnNEPLATITOARE_TVA = 1
			lnIdJtvaStandard = m.lnIdAchizitieNepl
		CASE lcTip = 'VANZARE'
			lnIdJtvaStandard = m.lnIdVanzare
		CASE lcTip = 'VANZARE_TI'
			lnIdJtvaStandard = lnIdVanzareTI
		CASE lcTip = 'ACHIZITIE'
			lnIdJtvaStandard = m.lnIdAchizitie
		CASE lcTip = 'ACHIZITIE_CAPITAL'
			lnIdJtvaStandard = lnIdAchizitieCapital
		CASE lcTip = 'ACHIZITIE_VANZARE'
			lnIdJtvaStandard = lnIdAchizitieVanzare
		CASE lcTip = 'ACHIZITIE_MATERII'
			lnIdJtvaStandard = lnIdAchizitieMaterii
		CASE lcTip = 'ACHIZITIE_TI'
			lnIdJtvaStandard = lnIdAchizitieTI
		CASE lcTip = 'ACHIZITIE_TI_CAPITAL'
			lnIdJtvaStandard = lnIdAchizitieTICapital
		CASE lcTip = 'ACHIZITIE_TI_VANZARE'
			lnIdJtvaStandard = lnIdAchizitieTIVanzare
		CASE lcTip = 'ACHIZITIE_MATERII'
			lnIdJtvaStandard = lnIdAchizitieTIMaterii			
	ENDCASE 		
	RETURN lnIdJtvaStandard
ENDFUNC 


***********************************************************************
*!* INTOARCE PROCENTUL DE TVA STANDARD IN FUNCTIE DE LUNA 24
*!* 07/2010 S-A MODIFICAT TVA 24%
*!* 01/2016 S-A MODIFICAT TVA 20%
*!* 01/2017 S-A MODIFICAT TVA 19%, 9%, 5%
*!* 08/2025 S-A MODIFICAT TVA 21% , 11%
FUNCTION GetProcTvaStandard
	LOCAL lnAn, lnLuna, lnProcTva
	
	lnAn = m.gnAn
	lnLuna = m.gnLuna
	lnProcTva = 21
	
	DO CASE 
		CASE m.lnAn * 12 + m.lnLuna >= 2025 * 12 + 8
			lnProcTva = 21
		CASE BETWEEN(m.lnAn * 12 + m.lnLuna, 2007*12+1, 2010 * 12 + 7)
			lnProcTva = 19
		CASE BETWEEN(m.lnAn * 12 + m.lnLuna, 2010*12+8, 2015 * 12 + 12)
			lnProcTva = 24
		CASE BETWEEN(m.lnAn * 12 + m.lnLuna, 2016*12+1, 2016 * 12 + 12)
			lnProcTva = 20
		CASE BETWEEN(m.lnAn * 12 + m.lnLuna, 2017*12+1, 2025 * 12 + 7)
			lnProcTva = 19
	ENDCASE  
	RETURN m.lnProcTva
ENDFUNC 

***********************************************************************
*!* INTOARCE COEFICIENTUL DE TVA STANDARD IN FUNCTIE DE LUNA 1.24
*!* 07/2010 S-A MODIFICAT TVA 24%
FUNCTION GetCoeficientTvaStandard
	LOCAL lnAn, lnLuna, lnProcTva
	
	lnAn = m.gnAn
	lnLuna = m.gnLuna
	lnProcTva = 1.21
	
	DO CASE 
		CASE m.lnAn * 12 + m.lnLuna >= 2025 * 12 + 8
			lnProcTva = 1.21
		CASE BETWEEN(m.lnAn * 12 + m.lnLuna, 2007*12+1, 2010 * 12 + 7)
			lnProcTva = 1.19
		CASE BETWEEN(m.lnAn * 12 + m.lnLuna, 2010*12+8, 2015 * 12 + 12)
			lnProcTva = 1.24
		CASE BETWEEN(m.lnAn * 12 + m.lnLuna, 2016*12+1, 2016 * 12 + 12)
			lnProcTva = 1.20
		CASE BETWEEN(m.lnAn * 12 + m.lnLuna, 2017*12+1, 2025 * 12 + 7)
			lnProcTva = 1.19
	ENDCASE  
	
	RETURN m.lnProcTva
ENDFUNC 

***********************************************************************************
*** Primeste un procent TVA si intoarce IdJTVA standard
***********************************************************************************
FUNCTION ProcentTva2IdJtva
	LPARAMETERS tnProcentTVA, tcTipJ, tlTaxareInversa, tnTvaIncasare

	* tnProcentTVA : procent TVA 0/5/9/19/11/21
	* tlTaxareInvesa : .T. daca este taxare inversa
	* tnTvaIncasare : 1 daca este TVA incasare
	* tcTipJ : Tip Jurnal JV/JC
	
	Local lcTipJ, lnIdJtva, lnIdJtvaNeex
	lnIdJtva = 0

	lcTipJ = IIF(INLIST(UPPER(m.tcTipJ), 'JV', 'JC'), UPPER(m.tcTipJ), 'JV')
	
	
	DO CASE 
		CASE m.tnProcentTVA = 21 AND tcTipJ = 'JV' 
			lnIdJtva = IIF(!m.tlTaxareInversa, 35, 5)
		CASE m.tnProcentTVA = 11 AND tcTipJ = 'JV'
			lnIdJtva = IIF(!m.tlTaxareInversa, 39, 5)		
		CASE m.tnProcentTVA = 19 AND tcTipJ = 'JV' 
			lnIdJtva = IIF(!m.tlTaxareInversa, 1, 5)
		CASE m.tnProcentTVA = 9 AND tcTipJ = 'JV'
			lnIdJtva = IIF(!m.tlTaxareInversa, 3, 5)		
		CASE m.tnProcentTVA = 5 AND tcTipJ = 'JV'
			lnIdJtva = IIF(!m.tlTaxareInversa, 13, 5)
		CASE m.tnProcentTVA = 0 AND tcTipJ = 'JV'
			lnIdJtva = IIF(!m.tlTaxareInversa, 8, 5) && ALTE LIVR. SCUTITE CU DREPT DE DEDUCERE

		CASE m.tnProcentTVA = 21 AND tcTipJ = 'JC' 
			lnIdJtva = IIF(!m.tlTaxareInversa, 208, 216)
		CASE m.tnProcentTVA = 11 AND tcTipJ = 'JC'
			lnIdJtva = IIF(!m.tlTaxareInversa, 212, 218)
		CASE m.tnProcentTVA = 19 AND tcTipJ = 'JC' 
			lnIdJtva = IIF(!m.tlTaxareInversa, 105, 141)
		CASE m.tnProcentTVA = 9 AND tcTipJ = 'JC'
			lnIdJtva = IIF(!m.tlTaxareInversa, 111, 145)		
		CASE m.tnProcentTVA = 5 AND tcTipJ = 'JC'
			lnIdJtva = IIF(!m.tlTaxareInversa, 154, 154)
		CASE m.tnProcentTVA = 0 AND tcTipJ = 'JC'
			lnIdJtva = IIF(!m.tlTaxareInversa, 113, 216) && ACH. INT. SCUTITE/NEIMPOZABILE
	ENDCASE 
	
	IF m.tnTvaIncasare = 1 AND !EMPTY(m.lnIdJtva)
		lnIdJtvaNeex = getIdJtvaColoana(m.lnIdJtva, m.tnTvaIncasare)
		If m.lnIdJtvaNeex <> 0
			lnIdJtva = m.lnIdJtvaNeex
		Endif	
	ENDIF 	

	RETURN m.lnIdJtva
	
ENDFUNC 

***********************************************************************************
*** Apeleaza getIdJtvaColoana si intoarce un obiect din vjtva_coloane 
***********************************************************************************
Function GeJtvaColoana
	Lparameters tnIdJtva, tnTvaIncasare, tcTipJ

	Local loRec
	getIdJtvaColoana(tnIdJtva, tnTvaIncasare, tcTipJ, @loRec)

	Return loRec
Endfunc

***********************************************************************************
***	baza. id_jtva_coloana exigibil/neexigibil corespunzator id_jtva_coloana selectat
***********************************************************************************
Function getIdJtvaColoana
	Lparameters tnIdJtva, tnTvaIncasare, tcTipJ, toRec

	***	tnTVAIncasare = 0 > tnIdJtva este neexigibil
	*** tcTipJ: JC, JV (default)
	*** toRec (OUT) obiect din vjtva_coloane corespunzator IdJtva

	Local lnIdJtva, lcAlias, lcCursor, llCursorJTvaColoane, lcTipJ
	If !Empty(m.tcTipJ)
		lcTipJ = Upper(m.tcTipJ)
	Else
		lcTipJ = [JV]
	Endif

	llCursorJTvaColoane = .T.
	lcAlias = Select()
	lcCursor = [crsjtvacoltemp]
	lnIdJtva = tnIdJtva
	If !Used('jtva_coloane')
		llCursorJTvaColoane = .F.
		update_jtva_coloane(m.lcTipJ)
	Endif
	*copiaza_structura_cursor([jtva_coloane],lcCursor)
	Select * From jtva_coloane Into Cursor (lcCursor)
	Select (lcCursor)
	Scatter Name toRec Blank Memo
	Locate For id_jtva_coloana = tnIdJtva
	If Found()
		If !Empty(tnTvaIncasare)
			lnIdJtva = Nvl(id_jtva_neex, id_jtva_coloana)
		Else
			lnIdJtva = Nvl(id_jtva_ex, id_jtva_coloana)
		Endif

		Locate For id_jtva_coloana = m.lnIdJtva
		If Found()
			Scatter Name toRec Memo
		Endif
	Endif

	Use In (Select(lcCursor))
	If !llCursorJTvaColoane
		Use In jtva_coloane
	Endif
	Select (lcAlias)
	Return lnIdJtva
Endfunc

***********************************************************************************
*** Apeleaza getIdTva si intoarce un obiect din vjtva_coloane 
***********************************************************************************
Function GeTvaColoana
	Lparameters tnIdJtva, tnTvaIncasare, tcTipJ

	Local loRec
	getIdTva(tnIdJtva, tnTvaIncasare, tcTipJ, @loRec)

	Return loRec
Endfunc

***********************************************************************************
***	tva.id_tva exigibil/neexigibil corespunzator id_tva selectat
***********************************************************************************
Function getIdTva
	Lparameters tnIdTva, tnTvaIncasare, tcTipJ, toRec

	***	tnTVAIncasare = 0 > tnIdTva este neexigibil
	*** tcTipJ: JC, JV
	*** toRec (OUT) obiect din vjtva_coloane corespunzator IdJtva

	Local lnIdTva, lnIdJTvaColoana, lcAlias, lcCursor, llCursorJTvaColoane, lcTipJ

	If !Empty(m.tcTipJ)
		lcTipJ = Upper(m.tcTipJ)
	Else
		lcTipJ = [JV]
	Endif

	llCursorJTvaColoane = .T.
	lcAlias = Select()
	lcCursor = [crsjtvacoltemp]
	lnIdTva = tnIdTva
	If !Used('jtva_coloane')
		llCursorJTvaColoane = .F.
		update_jtva_coloane(m.lcTipJ)
	Endif
	*copiaza_structura_cursor([jtva_coloane],lcCursor)
	Select * From jtva_coloane Into Cursor (lcCursor)
	Select (lcCursor)
	Scatter Name toRec Blank Memo
	Locate For id_tva = tnIdTva
	If Found()
		If !Empty(tnTvaIncasare)
			lnIdJTvaColoana = Nvl(id_jtva_neex, id_jtva_coloana)
		Else
			lnIdJTvaColoana = Nvl(id_jtva_ex, id_jtva_coloana)
		Endif
		Locate For id_jtva_coloana = lnIdJTvaColoana
		If Found()
			lnIdTva = Nvl(id_tva, id_jtva_coloana)

			Locate For id_jtva_coloana = m.lnIdTva
			If Found()
				Scatter Name toRec Memo
			Endif
		Endif
	Endif

	Use In (Select(lcCursor))
	If !llCursorJTvaColoane
		Use In jtva_coloane
	Endif
	Select (lcAlias)
	Return lnIdTva
Endfunc

************************************
*** creeaza cursorul cIsJTVACE la prima apelare a functiei si intoarce .T. daca tnIdJTVA este achizitie CE
************************************
Function IsJCJtvaCE
	Lparameters tnIdJtva

	Local llSucces, llReturn, lcSelect
	llReturn = .F.
	lcSelect = Select()
	If !Used('cIsJTVACE')
		llSucces = goExecutor.oExecuta([SELECT id_jtva_coloana as id_jtva FROM jtva_coloane WHERE denumire like 'TVA%' and denumire like '%CE%'], 'cIsJTVACE')
	Endif
	If Used('cIsJTVACE')
		Select cIsJTVACE
		Locate For id_jtva = m.tnIdJtva
		llReturn = Found()
	Endif

	Select (m.lcSelect)
	Return m.llReturn
Endfunc


***********************
*** Intoarce jtva_coloane.taxcode aferent unui id_jtva_coloana, Partener
FUNCTION GetTaxCodeIdPart
	LPARAMETERS tnAn, tnLuna, tdDataAct, tnIdJTVA, tnIdPart, tlN50, tlN100, tlNeexigibil
	* tnAn = anul curent
	* tnLuna = luna curenta
	* tdDataAct = data documentului, pentru facturi de regularizare inregistrate cu data din alta luna decat luna curenta
	* tnIdJTVA = explicatia TVA
	* tnIdPart = id partener pentru verificare furnizor TVA Incasare
	* tlN50 = operatia are limitare deducere 50% (Taxa SAFT tip: Achizitie deductibil 50%)
	* tlN100 = operatia are limitare deducere 100% (Taxa SAFT tip: Achizitie nedeductibil)
	* tlNeexigibil = factura nesosita/neintocmita 408/418
		
	* tlN50, tlN100 nu se mai folosesc
	* baza facturii cu limitare deducere are codul ach. deductibile 100%, 
	* iar linia 6xx = 4426 limitare deducere are codul "ach. nedeductibile 50% cota TVA 19/9/5%"
	* in loc de baza facturii "ach. nedeductibile 50%"
	
	Local loPartenerRTVAI As "empty"
	Local loPartenerRTVAIX As "empty"
	Local lcCodFiscal, lcNumePart, lcSelect, ldDataAct, llFurnizorRTVAI, llJC, llRegularizare
	Local llUsedJtvaColoane, lnIdPart, lnTaxCode

	lcSelect = SELECT()
	lnTaxCode = CAST(null as N(6))

	IF !(TYPE('gl406') = 'L' AND m.gl406)
		RETURN m.lnTaxCode
	ENDIF 
	
	lnIdPart = NVL(m.tnIdPart,0)
	llFurnizorRTVAI = .F.
	ldDataAct = IIF(!EMPTY(m.tdDataAct), m.tdDataAct, DATE(m.tnAn, m.tnLuna, 1))
	llRegularizare = YEAR(m.ldDataAct) * 12 + MONTH(m.ldDataAct) < m.tnAn*12+m.tnLuna

	llUsedJtvaColoane = Used('jtva_coloane')
	If !m.llUsedJtvaColoane
		update_jtva_coloane()
	ENDIF
		
	llJC = .F.
	IF SEEK(m.tnIdJTVA,'jtva_coloane','id_jtva')
		llJC = (jtva_coloane.jc = 1)
	ENDIF 
	If m.llJC AND !EMPTY(m.lnIdPart)
		lnIdPart = Nvl(m.tnIdPart,0)
		lcNumePart = ""
		lcCodFiscal = GetCodFiscalPartenerById(m.lnIdPart)

		loPartenerRTVAIX = Createobject("empty")
		loPartenerRTVAI = Createobject("empty")
		AddProperty(loPartenerRTVAIX, "cod_fiscal", m.lcCodFiscal)
		AddProperty(loPartenerRTVAIX, "denumire", m.lcNumePart)
		AddProperty(loPartenerRTVAIX, "dataact", m.ldDataAct)
		VERIFICA_RTVAI(loPartenerRTVAIX, @loPartenerRTVAI)

		llFurnizorRTVAI = loPartenerRTVAI.leinRtvai
	Endif

	IF !m.llUsedJtvaColoane
		USE IN (SELECT('jtva_coloane'))
	ENDIF 
		
	lnTaxCode = GetTaxCode(m.tnAn, m.tnLuna, m.tdDataAct, m.tnIdJTVA, m.llFurnizorRTVAI, tlN50, tlN100, tlNeexigibil)

	SELECT (m.lcSelect)

	RETURN m.lnTaxCode
ENDFUNC && GetTaxCodeIdPart


***********************
*** Intoarce jtva_coloane.taxcode aferent unui id_jtva_coloana, furnizor tva incasare
FUNCTION GetTaxCode
	LPARAMETERS tnAn, tnLuna, tdDataAct, tnIdJTVA, tlFurnizorRTVAI, tlN50, tlN100, tlNeexigibil
	* tnAn = anul curent
	* tnLuna = luna curenta
	* tdDataAct = data documentului, pentru facturi de regularizare inregistrate cu data din alta luna decat luna curenta
	* tnIdJTVA = explicatia TVA
	* tlFurnizoriRTVAI = furnizor TVA Incasare
	* tlN50 = inregistrarea corespunde explicatiei TVA Limitare deducere 50% (Taxa SAFT tip: Achizitie nedeductibil 50%)
	* tlN100 = inregistrarea corespunde explicatiei TVA Limitare deducere 100% (Taxa SAFT tip: Achizitie nedeductibil)
	* tlNeexigibil = factura nesosita/neintocmita 408/418
	
	* tlN50, tlN100 se folosesc doar pentru nota contabila cu explicatie TVA Limitare deducere TVA, in pereche cu Explicatie TVA Ach. 19/9/5%, astfel incat sa intoarca codul Ach neded. 50%/100% 19/9/5%
	* baza facturii cu limitare deducere are codul ach. deductibile 100%, 
	* iar linia 6xx = 4426 limitare deducere are codul "ach. nedeductibile 50% cota TVA 19/9/5%"
	* tlN50, tlN100 sunt .T. doar pentru linia 6xx = 4426 limitare deducere TVA
		
	LOCAL lcSelect, llJtvaColoane, loTVA
	Local llFurnizorRTVAI, llRegularizare, llUsedJtvaColoane, lnTaxCode, ldDataAct
	lcSelect = SELECT()
	lnTaxCode = CAST(null as N(6))

	IF !(TYPE('gl406') = 'L' AND m.gl406)
		RETURN m.lnTaxCode
	ENDIF 
	llFurnizorRTVAI = m.tlFurnizorRTVAI
	ldDataAct = IIF(!EMPTY(m.tdDataAct), m.tdDataAct, DATE(m.tnAn, m.tnLuna, 1))
	llRegularizare = YEAR(m.ldDataAct) * 12 + MONTH(m.ldDataAct) < m.tnAn*12+m.tnLuna
	llUsedJtvaColoane = USED("jtva_coloane_taxcode")
	
	* Generez jtva_coloane_taxcode la prima utilizare si il las deschis
	If !m.llUsedJtvaColoane
		update_jtva_coloane("", "jtva_coloane_taxcode", 6)
	ENDIF
		
	IF SEEK(m.tnIdJTVA, "jtva_coloane_taxcode", "id_jtva")
		SELECT jtva_coloane_taxcode
		SCATTER NAME loTVA
		WITH loTVA
			* codul taxa regularizare are prioritate fata de ach. furnizor tva incasare
			lnTaxCode = .taxcode
			DO CASE 
				CASE m.tlNeexigibil AND !EMPTY(NVL(.taxcode_neexigibil,0))
					lnTaxCode = .taxcode_neexigibil
				CASE m.tlN50 AND m.llFurnizorRTVAI AND !EMPTY(NVL(.taxcode_n50_tvai,0))
					lnTaxCode = .taxcode_n50_tvai	
				CASE m.tlN50
					lnTaxCode = .taxcode_n50
				CASE m.tlN100 AND m.llFurnizorRTVAI AND !EMPTY(NVL(.taxcode_n100,0))
					lnTaxCode = .taxcode_n100
				CASE m.tlN100
					lnTaxCode = .taxcode_n100
				CASE m.llRegularizare AND !EMPTY(NVL(.taxcode_regularizare,0))
					lnTaxCode = .taxcode_regularizare
				CASE m.llFurnizorRTVAI AND !EMPTY(NVL(.taxcode_tvai,0))
					lnTaxCode = .taxcode_tvai
			ENDCASE 
		ENDWITH 
	ENDIF 	

	SELECT (m.lcSelect)
	
	RETURN m.lnTaxCode
ENDFUNC && GetTaxCode

***********************
*** Intoarce cod mecanism plata SAFT aferent unui fel document
FUNCTION GetPaymentCode
	LPARAMETERS tnIdFdoc
	LOCAL lcSelect, lnIdFdoc
	Local llUsedFdoc, lnPaymentCode
	lcSelect = SELECT()
	lnPaymentCode = NULL

	lnIdFdoc = NVL(m.tnIdFdoc,0)

	llUsedFdoc = Used('crsFdoc')
	If !m.llUsedFdoc
		update_fdoc()
	ENDIF
		
	select paymentcode FROM crsFdoc WHERE id_fdoc = m.lnIdFdoc INTO CURSOR crsFdocTemp

	SELECT crsFdocTemp
	GO TOP 
	lnPaymentCode = ALLTRIM(NVL(paymentcode,''))

	IF !m.llUsedFdoc 
		USE IN (SELECT('crsFdoc'))
	ENDIF 

	USE IN (SELECT('crsFdocTemp'))
	SELECT (m.lcSelect)
	
	RETURN m.lnPaymentCode
ENDFUNC && GetPaymentCode

********************************************************************************
*** concateneaza valorile dintr-o coloana de pe mai multe randuri
*** tcAlias = cursorul din care se face concatenarea
*** tcAggColumn = coloana care se concateneaza
***	tlDontIgnoreEmptyValues Default .F., .T = concateneaza si valorile empty(tcAggColumn)
*** tcSeparator = separatorul valorilor concatenate. Default = [,]
*** tcFilterColumn1..tcFilterColumn20 = coloana pentru filtrare/grupare
*** tcFilterValue1..tcFilterValue20 = valoarea coloanei pentru filtrare/grupare
*** intoare un sir de caractere
*** ex:
*!*	CREATE CURSOR crsInfo (nract I, dataact D, info c(10), suma n(16,2))
*!*	INSERT INTO crsInfo(nract, dataact, info, suma) values(1, DATE(), 'a',1.00)
*!*	INSERT INTO crsInfo(nract, dataact, info, suma) values(1, DATE(), 'b',1.00)
*!*	INSERT INTO crsInfo(nract, dataact, info, suma) values(1, DATE(), 'c',1.00)
*!*	INSERT INTO crsInfo(nract, dataact, info, suma) values(2, DATE(), 'd',1.00)
*!*	INSERT INTO crsInfo(nract, dataact, info, suma) values(2, DATE(), 'e',1.00)
*!*	INSERT INTO crsInfo(nract, dataact, info, suma) values(2, DATE(), 'f',1.00)
*!*	INSERT INTO crsInfo(nract, dataact, info, suma) values(2, DATE(), 'g',1.00)
*!*	INSERT INTO crsInfo(nract, dataact, info, suma) values(3, DATE(), 'a',1.00)
*!*	INSERT INTO crsInfo(nract, dataact, info, suma) values(3, DATE()-1, 'x',1.00)

*!*	SELECT nract, dataact, SUM(suma) as suma, ;
*!*		StringAgg('crsInfo', 'info', .F., [ ], [nract], nract, [dataact], dataact) as infoagg  ;
*!*		FROM crsinfo ;
*!*		group by nract, dataact ;
*!*		INTO CURSOR crsRezultat
********************************************************************************
Function StringAgg
	Lparameters tcAlias, tcAggColumn, tlDontIgnoreEmptyValues, tcSeparator, ;
		tcFilterColumn1, tcFilterValue1, tcFilterColumn2, tcFilterValue2, tcFilterColumn3, tcFilterValue3, tcFilterColumn4, tcFilterValue4, ;
		tcFilterColumn5, tcFilterValue5, tcFilterColumn6, tcFilterValue6, tcFilterColumn7, tcFilterValue7, tcFilterColumn8, tcFilterValue8, ;
		tcFilterColumn9, tcFilterValue9, tcFilterColumn10, tcFilterValue10, tcFilterColumn11, tcFilterValue11, tcFilterColumn12, tcFilterValue12, ;
		tcFilterColumn13, tcFilterValue13, tcFilterColumn14, tcFilterValue14, tcFilterColumn15, tcFilterValue15, tcFilterColumn16, tcFilterValue16, ;
		tcFilterColumn17, tcFilterValue17, tcFilterColumn18, tcFilterValue18, tcFilterColumn19, tcFilterValue19, tcFilterColumn20, tcFilterValue20


	Local lcCursor, lcRezultat, lcSelect, lcSql, lcSeparator, loEx As Exception
	Local lcFilter, lcFilterColumn, lcFilterColumnEval, lcFilterValue, i

	lcRezultat = ""
	lcSeparator = Iif(Type('tcSeparator') = 'C', tcSeparator, [,])
	lcSelect = Select()
	lcCursor = Sys(2015)
	lcFilter = ""
	For i = 1 To 20
		lcFilterColumn = 'tcFilterColumn' + Alltrim(Str(i)) && tcFilterColumn1
		If Type(lcFilterColumn) <> 'C'
			Exit
		Endif
		lcFilterColumnEval = Evaluate(m.lcFilterColumn) && [nract]

		lcFilterValue = 'tcFilterValue' + Alltrim(Str(i)) && tcFilterValue1

		lcFilter = lcFilter + Iif(Type(m.lcFilterColumn) = 'C' And !Empty(lcFilterColumnEval), m.lcFilterColumnEval + [ = ] + lcFilterValue, "") + [ and ]
	Endfor
	If !Empty(m.lcFilter)
		lcFilter = Left(m.lcFilter, Len(m.lcFilter) - 5)
	Endif
	lcFilter = Iif(!tlDontIgnoreEmptyValues, [!EMPTY(] + m.tcAggColumn + [)], []) + Iif(!Empty(m.lcFilter), [ and ], []) + m.lcFilter

	lcSql = [SELECT distinct ] + tcAggColumn + [ as aggcolumn] + ;
		[ FROM ] + m.tcAlias + ;
		Iif(!Empty(m.lcFilter), [ WHERE ] + m.lcFilter, []) + ;
		[ INTO CURSOR ] + m.lcCursor

	&lcSql

	Select (m.lcCursor)
	Scan
		lcRezultat = m.lcRezultat + Alltrim(Transform(aggcolumn)) + lcSeparator
	Endscan
	Use In (Select(m.lcCursor))
	If !Empty(m.lcRezultat)
		lcRezultat = Left(m.lcRezultat, Len(m.lcRezultat) - Len(m.lcSeparator))
	Endif

	Select (m.lcSelect)
	Return m.lcRezultat
Endfunc && StringAgg


Function GetReportFooter
	Lparameters tnPageTotal

	Local lcReportFooter, llRaportDataOra, lcDataOra
	llRaportDataOra = Iif(Type('glRaportDataOra') = 'L', m.glRaportDataOra, .T.)
	lcDataOra = Iif(Type('pcDataOra') = 'U', Get_Ora(2), m.pcDataOra)

	lcReportFooter = m.gcCopyRight + " - Pagina " + Allt(Str(_Pageno)) + "/" + Allt(Str(m.tnPageTotal)) + Iif(m.llRaportDataOra, " " + m.lcDataOra, "")
	Return m.lcReportFooter
Endfunc
*********************************************************************************************************
Procedure creeaza_backup_cursoare
	Lparameters tcOriginal
	Local lcBackup
	lcBackup = [bckp] + tcOriginal
	sterge_backup_cursoare(tcOriginal)
	copiaza_structura_cursor(tcOriginal, lcBackup)
	Select * From (tcOriginal) Into Cursor (lcBackup)
	Release lcBackup
Endproc &&	creeaza_backup_cursoare
*********************************************************************************************************
Procedure repune_backup_cursoare
	Lparameters tcOriginal
	Local lcBackup
	lcBackup = [bckp] + tcOriginal
	If Used(lcBackup)
		Select (tcOriginal)
		lnRecno = Recno()
		Select * From (lcBackup) Into Cursor (tcOriginal) Readwrite
		Use In (lcBackup)
		Select (tcOriginal)
		If Reccount(tcOriginal) > 0
			Go Min(lnRecno, Reccount(tcOriginal))
		Else
			Go Top
		Endif
	Endif
	Release lcBackup
Endproc	&&	repune_backup_cursoare
*********************************************************************************************************
Procedure sterge_backup_cursoare
	Lparameters tcOriginal
	Local lcBackup
	lcBackup = [bckp] + tcOriginal
	If Used(lcBackup)
		Use In (lcBackup)
	Endif
	Release lcBackup
Endproc	&&	sterge_backup_cursoare
*********************************************************************************************************
Define Class oCursoareProcedura As Custom
	cNumeProcedura = []
	Dimension aCursoareDeschiseI(1, 1)
	Dimension aExceptiiCursoare(1)

	Procedure Init
		Lparameters tcNumeProcedura
		This.cNumeProcedura = tcNumeProcedura
		Aused(This.aCursoareDeschiseI)
	Endproc

	Function getNumeProcedura
		Return This.cNumeProcedura
	Endfunc

	Procedure setListaExceptii
		Lparameters tcListaExceptii
		Local Array laTemp(1)
		lista2array(Upper(tcListaExceptii), @laTemp, [,])
		Acopy(laTemp, This.aExceptiiCursoare)
	Endproc

	Procedure inchideCursoare
		Local Array laCursoareDeschiseF[1, 1]
		Local lnIndex
		*!*	cursoarele de la inceput
		*!*			CREATE CURSOR crs(nume c(200),nr n(10))
		*!*			SELECT crs
		*!*			APPEND FROM array This.aCursoareDeschiseI
		*!*			BROWSE
		*!* cursoarele de la final
		*!*			CREATE CURSOR crs2(nume c(200),nr n(10))
		*!*			SELECT crs2
		*!*			Aused(laCursoareDeschiseF)
		*!*			APPEND FROM array laCursoareDeschiseF
		*!*			BROWSE
		For lnIndex = 1 To Aused(laCursoareDeschiseF)
			If Ascan(This.aCursoareDeschiseI, laCursoareDeschiseF[lnIndex, 1]) = 0 And ;
					Ascan(This.aExceptiiCursoare, laCursoareDeschiseF[lnIndex, 1]) = 0
				Use In (laCursoareDeschiseF[lnIndex, 1])
			Endif
		Endfor
		*!*	exceptii
		*!*			CREATE CURSOR crs3(nume c(200),nr n(10))
		*!*			SELECT crs3
		*!*			APPEND FROM array This.aExceptiiCursoare
		*!*			BROWSE
		*!*	cursoare ramase
		*!*			CREATE CURSOR crs4(nume c(200),nr n(10))
		*!*			SELECT crs4
		*!*			Aused(laCursoareDeschiseF)
		*!*			APPEND FROM array laCursoareDeschiseF
		*!*			BROWSE
	Endproc

Enddefine
*********************************************************************************************************
Define Class oLogCursoare As Custom
	&&	cursor in care tin numele tuturor cursoarelor deschise
	oDetaliiProc = Null
	lGlobal = .F.

	Procedure Init
		Lparameters tlGlobal
		This.oDetaliiProc = Createobject("collection")
		This.lGlobal = tlGlobal
		If !This.lGlobal
			This.salveaza(Program(Program(-1) - 1))
		Endif
	Endproc

	Procedure seteazaExceptii
		Lparameters tcListaExceptii
		*!*	lista exceptii contine numele cursoarelor care nu se inchid la iesirea din procedura
		Local lnIndex
		lnIndex = This.cautaIndex(Iif(This.lGlobal, Program(Program(-1) - 1), ""))
		This.oDetaliiProc.Item[lnIndex].setListaExceptii(tcListaExceptii)
	Endproc

	Function cautaIndex
		Lparameters tcNumeProcedura
		Local lnIndexCautat, lnIndex
		If !Empty(tcNumeProcedura)	&&	sau If This.lGlobal
			For lnIndex = 1 To This.oDetaliiProc.Count
				If This.oDetaliiProc.Item[lnIndex].getNumeProcedura() == tcNumeProcedura
					lnIndexCautat = lnIndex
					Exit
				Endif
			Endfor
		Else
			lnIndexCautat = 1
		Endif
		Return lnIndexCautat
	Endfunc

	Procedure salveaza
		*!*  daca obiectul de tip oLogCursoare a fost definit global, atunci se apeleaza fara parametru, 
		*!* la inceputul fiecarei proceduri pentru care se doreste sa se tina istoricul cursoarelor deschise
		Lparameters tcNumeProcedura
		This.oDetaliiProc.Add(Createobject("oCursoareProcedura", Evl(tcNumeProcedura, Program(Program(-1) - 1))))
	Endproc

	Procedure inchideCursor
		Lparameters tcNumeCursor
		If Used(tcNumeCursor)
			Use In (tcNumeCursor)
		Endif
	Endproc

	Procedure inchideCursoare
		*!*	 daca obiectul de tip oLogCursoare a fost definit global, atunci se apeleaza 
		*!*	inainte de fiecare RETURN din procedura respectiva
		Local lcSelect, lnIndex
		lcSelect = Select()
		lnIndex = This.cautaIndex(Iif(This.lGlobal, Program(Program(-1) - 1), ""))
		With This.oDetaliiProc
			.Item[lnIndex].inchideCursoare()
			.Remove(lnIndex)
		Endwith
		If Used(lcSelect)
			Select (lcSelect)
		Endif
	Endproc

	Procedure Destroy
		If !This.lGlobal
			This.inchideCursoare()
		Endif
	Endproc

Enddefine
*********************************************************************************************************

*******************************************
*** Completare analitice pe baza de grupuri in Gestiune.NIR.inainte_de_do_termin, Contabilitate.actbaza2007.adunadate
*******************************************
Procedure completare_gruputil_analitice
	*!* completez analiticele lipsa din tabelul config_gruputil_analitice
	lnSucces = Update_GrupUtilAnalitice() && in updateserver.prg
	If lnSucces > 0
		Select crsGrupUtilAnalitice
		Scan
			Scatter Name loRec Memo
			Update actactan Set ascd = loRec.acont Where Empty(Nvl(ascd, '')) And Upper(Alltrim(scd)) = Upper(Alltrim(loRec.Cont))
			Update actactan Set ascc = loRec.acont Where Empty(Nvl(ascc, '')) And Upper(Alltrim(scc)) = Upper(Alltrim(loRec.Cont))
		Endscan
		Use In (Select('crsGrupUtilAnalitice'))
	Endif
Endproc && completare_gruputil_analitice

*******************************************
*** Completare analitice pe baza de explicatii tva in Gestiune.NIR.inainte_de_do_termin, Contabilitate.actbaza2007.adunadate, ROAFACTURARE, ROACOMENZI, ROACONTRACTE pack_facturare
*** bun pentru analitice pe baza de cote TVA la 4426, 4428 (vezi AUTOHAUS, ABCVAL)
*******************************************
Procedure completare_tva_analitice
	lnSucces = Update_TVAAnalitice() && in updateserver.prg
	If lnSucces > 0
		Select crsTVAAnalitice
		Scan
			Scatter Name loRec Memo
			Update actactan Set ascd = loRec.acont Where Empty(Nvl(ascd, '')) And Upper(Alltrim(scd)) = Upper(Alltrim(loRec.Cont)) And id_jtva_coloana = loRec.id_jtva_coloana
			Update actactan Set ascc = loRec.acont Where Empty(Nvl(ascc, '')) And Upper(Alltrim(scc)) = Upper(Alltrim(loRec.Cont)) And id_jtva_coloana = loRec.id_jtva_coloana
		Endscan
		Use In (Select('crsTVAAnalitice'))
	Endif
Endproc && completare_tva_analitice

*** Completare taxname in actactan (frm_introd_compact.la_iesire)
PROCEDURE completare_taxname
	LOCAL lcSelect
	lcSelect = SELECT()
	
	IF USED('saft_taxtable')
		UPDATE actactan SET taxname = Iif(Seek(actactan.taxcode,'saft_taxtable','taxcode'),saft_taxtable.taxname,'')
	ENDIF 	
	
	SELECT (m.lcSelect)
ENDPROC && completare_taxname

*** Completare paymentname in actactan (frm_introd_compact.la_iesire)
PROCEDURE completare_paymentname
	LOCAL lcSelect
	lcSelect = SELECT()
	
	IF USED('saft_mecanisme_plati')
		UPDATE actactan SET paymentname = Iif(Seek(actactan.paymentcode,'saft_mecanisme_plati','mcode'),saft_mecanisme_plati.paymentname,'')
	ENDIF 	
	
	SELECT (m.lcSelect)
ENDPROC && completare_taxname


*** Completare explicatie_tva in actactan (frm_introd_compact.la_iesire)
PROCEDURE completare_explicatie_tva
	LOCAL lcSelect, lcCursor
	lcSelect = SELECT()
	
	lcCursor = SYS(2015)
	IF !USED(m.lcCursor)
		update_jtva_coloane("", m.lcCursor,6)
	ENDIF 

	IF USED(m.lcCursor)
		UPDATE actactan SET explicatie_tva = Iif(Seek(actactan.id_jtva_coloana, m.lcCursor,'id_jtva'), &lcCursor..denumire,'')
	ENDIF 	

	USE IN (SELECT(m.lcCursor))
	
	SELECT (m.lcSelect)
ENDPROC && completare_explicatie_tva

**************************************
*** Cauta partenerul dupa cod fiscal si intoarce un obiect sau NULL
**************************************
Procedure GetPartenerByCodFiscal
	Lparameters tcCodFiscal
	Private pcCodFiscal
	Local lcSql, lnSucces, lcSelect, loPartener
	lcSelect = SELECT()
	loPartener = NULL

	pcCodFiscal = Alltrim(Strtran(Strtran(Upper(Alltrim(m.tcCodFiscal)), ' ', ''), 'RO', ''))

	lcSql = [SELECT * from vnom_parteneri where id_part = (select MAX(id_part) as id_part from nom_parteneri where replace(replace(UPPER(cod_fiscal),' ', ''), 'RO', '') = ?pcCodFiscal and sters = 0 and inactiv = 0)]
	llSucces = goExecutor.oExecuta(m.lcSql, "cPartenerTemp")
	If m.llSucces
		SELECT cPartenerTemp
		SCATTER NAME loPartener
	ENDIF
	USE IN (SELECT('cPartenerTemp'))

	SELECT (m.lcSelect)
	Return loPartener
Endproc

**************************************
*** Cauta partenerul dupa denumire si intoarce un obiect sau NULL
**************************************
Procedure GetPartenerByDenumire
	Lparameters tcDenumire
	Private pcDenumire
	Local lcSql, lnSucces, lcSelect, loPartener
	lcSelect = SELECT()
	loPartener = NULL

	pcDenumire = Alltrim(Upper(tcDenumire))

	lcSql = [SELECT * from vnom_parteneri where id_part = (select MAX(id_part) as id_part from nom_parteneri where TRIM(UPPER(denumire)) = ?pcDenumire and sters = 0 and inactiv = 0)]
	llSucces = goExecutor.oExecuta(m.lcSql, "cPartenerTemp")
	If m.llSucces
		SELECT cPartenerTemp
		SCATTER NAME loPartener
	ENDIF
	USE IN (SELECT('cPartenerTemp'))

	SELECT (m.lcSelect)
	Return loPartener
Endproc

**************************************
*** Cauta partenerul dupa codul IBAN si intoarce un obiect sau NULL
**************************************
Procedure GetPartenerByContBanca
	Lparameters tcContBanca
	Private pcContBanca
	Local lcSql, lnSucces, lcSelect, loPartener
	lcSelect = SELECT()
	loPartener = NULL

	pcContBanca = Alltrim(TRANSFORM(m.tcContBanca))

	lcSql = [SELECT * from vnom_parteneri where id_part = (select MAX(id_part) as id_part from nom_parteneri where TRIM(UPPER(cont_banca)) = ?pcContBanca and sters = 0 and inactiv = 0)]
	llSucces = goExecutor.oExecuta(m.lcSql, "cPartenerTemp")
	If m.llSucces
		SELECT cPartenerTemp
		SCATTER NAME loPartener
	ENDIF
	USE IN (SELECT('cPartenerTemp'))

	SELECT (m.lcSelect)
	Return loPartener
ENDPROC

**************************************
*** Intoarce Id Partener din nomenclatorul de parteneri dupa codul fiscal 
**************************************
Procedure GetIdPartenerByCodFiscal
	Lparameters tcCodFiscal, tcDenumire
	* tcCodFiscal: IN
	* tcDenumire: OUT
	Private pnIdPartener, pcCodFiscal
	Local lcSql, lnSucces, lcSelect
	lcSelect = SELECT()
	pnIdPartener = 0
	pcCodFiscal = Alltrim(Strtran(Strtran(Upper(Alltrim(m.tcCodFiscal)), ' ', ''), 'RO', ''))

	lcSql = [select MAX(id_part) as id_part from nom_parteneri where replace(replace(UPPER(cod_fiscal),' ', ''), 'RO', '') = ?pcCodFiscal and sters = 0 and inactiv = 0]
	lnSucces = goExecutor.oSelect2Value(m.lcSql, @pnIdPartener)
	If m.lnSucces < 0
		amessagebox(goExecutor.cEroare, 0 + 48, _Screen.Caption)
	ENDIF

	SELECT (m.lcSelect)
	Return Nvl(m.pnIdPartener, 0)
Endproc

**************************************
*** Intoarce Id Partener din nomenclatorul de parteneri dupa denumire
**************************************
Procedure GetIdPartenerByDenumire
	Lparameters tcDenumire
	Private pnIdPartener, pcDenumire
	Local lcSql, lnSucces, lcSelect
	lcSelect = SELECT()
	pnIdPartener = 0
	pcDenumire = Alltrim(Upper(tcDenumire))

	lcSql = [select MAX(id_part) as id_part from nom_parteneri where TRIM(UPPER(denumire)) = ?pcDenumire and sters = 0 and inactiv = 0]
	lnSucces = goExecutor.oSelect2Value(m.lcSql, @pnIdPartener)
	If m.lnSucces < 0
		amessagebox(goExecutor.cEroare, 0 + 48, _Screen.Caption)
	ENDIF
	SELECT (m.lcSelect)
	Return Nvl(m.pnIdPartener, 0)
Endproc

**************************************
*** Intoarce Id Partener din nomenclatorul de parteneri dupa contul bancar 
**************************************
Procedure GetIdPartenerByContBanca
	Lparameters tcCont
	Private pnIdPartener, pcCont
	Local lcSql, lnSucces
	pnIdPartener = 0
	pcCont = Alltrim(Upper(tcCont))

	lcSql = [select MAX(id_part) as id_part from nom_parteneri where TRIM(UPPER(cont_banca)) = ?pcCont and sters = 0 and inactiv = 0]
	lnSucces = goExecutor.oSelect2Value(m.lcSql, @pnIdPartener)
	If m.lnSucces < 0
		amessagebox(goExecutor.cEroare, 0 + 48, _Screen.Caption)
	Endif
	Return Nvl(m.pnIdPartener, 0)
Endproc

**************************************
*** Intoarce denumire parteneri din nomenclatorul de parteneri dupa Id
**************************************
Procedure GetDenumirePartenerById
	Lparameters tnIdPart
	Private pnIdPartener, pcDenumire
	Local lcSql, lnSucces, lcSelect
	
	lcSelect = SELECT()
	pnIdPartener = tnIdPart
	pcDenumire = ''

	lcSql = [select MAX(denumire) as denumire from nom_parteneri where id_part = ?pnIdPartener]
	lnSucces = goExecutor.oSelect2Value(m.lcSql, @pcDenumire)
	If m.lnSucces < 0
		amessagebox(goExecutor.cEroare, 0 + 48, _Screen.Caption)
	ENDIF
	SELECT (m.lcSelect)
	Return Nvl(m.pcDenumire, '')
Endproc

**************************************
*** Intoarce cod fiscal parteneri din nomenclatorul de parteneri dupa Id
**************************************
Procedure GetCodFiscalPartenerById
	Lparameters tnIdPart
	Private pnIdPartener, pcDenumire
	Local lcSql, lnSucces, lcSelect
	
	lcSelect = SELECT()
	pnIdPartener = tnIdPart
	pcCodFiscal = ''

	lcSql = [select MAX(cod_fiscal) as cod_fiscal from nom_parteneri where id_part = ?pnIdPartener]
	lnSucces = goExecutor.oSelect2Value(m.lcSql, @pcCodFiscal)
	If m.lnSucces < 0
		amessagebox(goExecutor.cEroare, 0 + 48, _Screen.Caption)
	ENDIF
	SELECT (m.lcSelect)
	Return Nvl(m.pcCodFiscal, '')
Endproc


************************************
*** Intoarce un obiect cu (id_util, id_partener, partener) dupa id_util
************************************
Procedure GetPartenerByUtil
	Lparameters tnIdUtil
	Private pnIdUtil
	Local lcSql, llSucces, loPartener
	pnIdUtil = m.tnIdUtil
	loPartener = Createobject("empty")
	AddProperty(loPartener, "id_util", m.pnIdUtil)
	AddProperty(loPartener, "id_partener", 0)
	AddProperty(loPartener, "partener", "")

	lcSql = [select id_util, id_partener, partener from vutilizatori_rol_intern  where id_util = ?pnIdUtil]
	llSucces = goExecutor.oExecuta(m.lcSql, 'cPartenerByUtilTemp')
	If m.llSucces
		Select cPartenerByUtilTemp
		loPartener.id_partener = Nvl(id_partener, 0)
		loPartener.partener = Alltrim(Nvl(partener, ''))
		Use In (Select('cPartenerByUtilTemp'))
	Endif
	Return loPartener
Endproc


**************************************
* Genereaza toate variantele de [nume prenume1 prenume2]
* = GetNamePermutations("Popescu Ion Maria", .T.)  && exclude varianta originala
* = GetNamePermutations("Popescu Ion Maria", .F.)  && include toate variantele
**************************************
Function GetNamePermutations
	Lparameters lcFullName, llExcludeOriginal
	Local lcResult, lnWordCount, i
	Local Array laWords[1]
	PRIVATE pnMaxPerms, pnPermCount
	pnMaxPerms = 10 && numarul maxim de permutari
	pnPermCount = 0

	* Separare cuvinte în array
	lnWordCount = Getwordcount(lcFullName)
	If lnWordCount < 2
		Return ""
	Endif

    * LIMITARE LA MAXIM 4 CUVINTE 24 PERMUTARI
    If lnWordCount > 4
        lnWordCount = 4
        * Reconstruim numele doar cu primele 4 cuvinte
        lcFullName = Getwordnum(lcFullName, 1) + " " + ;
                     Getwordnum(lcFullName, 2) + " " + ;
                     Getwordnum(lcFullName, 3) + " " + ;
                     Getwordnum(lcFullName, 4)
                     
    ENDIF
    
	Dimension laWords[lnWordCount]
	For i = 1 To lnWordCount
		laWords[i] = Getwordnum(lcFullName, i)
	Endfor

	* Cazul special pentru 2 cuvinte
	If lnWordCount = 2
		If llExcludeOriginal
			Return laWords[2] + " " + laWords[1]
		Endif
		Return lcFullName + ";" + laWords[2] + " " + laWords[1]
	Endif

	* Generam toate permutarile posibile în lcResult
	lcResult = ""
	Local Array laUsed[1], laCurrentPerm[1]
	Dimension laUsed[lnWordCount], laCurrentPerm[lnWordCount]
	Store .F. To laUsed

	pnPermCount = 0 && numarul de permutari
	
	* Primul cuvânt poate fi oricare
	For i = 1 To lnWordCount
		laUsed[i] = .T.
		laCurrentPerm[1] = laWords[i]
		GenerateWordPerms(1, @laWords, @laUsed, @laCurrentPerm, lnWordCount, @lcResult)
		laUsed[i] = .F.
	Endfor

	* Filtram rezultatele
	Local lcFirstWord, lcLastWord, lcFiltered
	lcFirstWord = laWords[1]
	lcLastWord = laWords[lnWordCount]
	lcFiltered = ""

	Local lnPos, lcLine
	lnPos = At(";", lcResult)
	Do While lnPos > 0
		lcLine = Left(lcResult, lnPos - 1)
		lcResult = Substr(lcResult, lnPos + 1)

		* Verificam daca primul ?i ultimul cuvânt sunt corecte
		If (Getwordnum(lcLine, 1) = lcFirstWord Or Getwordnum(lcLine, 1) = lcLastWord) And ;
				(Getwordnum(lcLine, lnWordCount) = lcFirstWord Or Getwordnum(lcLine, lnWordCount) = lcLastWord)
			If !llExcludeOriginal Or lcLine != lcFullName
				lcFiltered = lcFiltered + lcLine + ";"
			Endif
		Endif

		lnPos = At(";", lcResult)
	Enddo

	* Verificam ?i ultima linie
	If !Empty(lcResult)
		If (Getwordnum(lcResult, 1) = lcFirstWord Or Getwordnum(lcResult, 1) = lcLastWord) And ;
				(Getwordnum(lcResult, lnWordCount) = lcFirstWord Or Getwordnum(lcResult, lnWordCount) = lcLastWord)
			If !llExcludeOriginal Or lcResult != lcFullName
				lcFiltered = lcFiltered + lcResult + ";"
			Endif
		Endif
	Endif

	* Eliminam ultimul separator daca exista
	If !Empty(lcFiltered)
		lcFiltered = Left(lcFiltered, Len(lcFiltered)-1)
	Endif

	Return lcFiltered
ENDPROC 

* Procedura recursiva pentru generarea permutarilor
Procedure GenerateWordPerms
	Parameters lnLevel, laWords, laUsed, laCurrentPerm, lnWordCount, lcResult

    If m.pnPermCount >= m.pnMaxPerms
        Return
    ENDIF
    
	If lnLevel = lnWordCount
		pnPermCount = m.pnPermCount + 1
		* Am completat toate pozitiile, adaugam permutarea la rezultat
		Local i, lcPerm
		lcPerm = laCurrentPerm[1]
		For i = 2 To lnWordCount
			lcPerm = lcPerm + " " + laCurrentPerm[i]
		Endfor
		lcResult = lcResult + lcPerm + ";"
		Return
	Endif

	* Pentru fiecare cuvânt neutilizat
	Local i
	For i = 1 To lnWordCount
		If !laUsed[i]
			laUsed[i] = .T.
			laCurrentPerm[lnLevel + 1] = laWords[i]
			GenerateWordPerms(lnLevel + 1, @laWords, @laUsed, @laCurrentPerm, lnWordCount, @lcResult)
			laUsed[i] = .F.
		Endif
	Endfor
Endproc



**************************************
*** Intoarce denumire fdoc din nomenclatorul de documente dupa Id
**************************************
Procedure GetFdocById
	Lparameters tnId
	Private pnId, pcDenumire
	Local lcSql, lnSucces
	pnId = tnId
	pcDenumire = ''

	lcSql = [select MAX(fel_document) as fel_document from nom_fdoc where id_fdoc = ?pnId]
	lnSucces = goExecutor.oSelect2Value(m.lcSql, @pcDenumire)
	If m.lnSucces < 0
		amessagebox(goExecutor.cEroare, 0 + 48, _Screen.Caption)
	Endif
	Return Nvl(m.pcDenumire, '')
Endproc && GetFdocById

************************************
*** Intoarce un obiect cu (id_valuta, nume_val, moneda_nationala) dupa nume_val2/iso_valuta
************************************
Procedure GetValutaByISO
	Lparameters tcValutaISO
	Private pcValutaISO
	Local lcSelect, lcSql, llSucces, loValuta
	lcSelect = SELECT()
	pcValutaISO = m.tcValutaISO
	loValuta = Createobject("empty")
	AddProperty(loValuta, "id_valuta", 0)
	AddProperty(loValuta, "nume_val", '')
	AddProperty(loValuta, "moneda_nationala", 1)
	
	lcSql = [select id_valuta, nume_val, moneda_nationala from vnom_valute where nume_val2 = ?pcValutaISO]
	llSucces = goExecutor.oExecuta(m.lcSql, 'cValutaTemp')
	If m.llSucces
		IF RECCOUNT('cValutaTemp') > 0
			Select cValutaTemp
			GO TOP 
			loValuta.id_valuta = Nvl(id_valuta, 0)
			loValuta.nume_val = Alltrim(Nvl(nume_val, ''))
			loValuta.moneda_nationala = Nvl(moneda_nationala, 0)
		ENDIF 
		Use In (Select('cValutaTemp'))
	ENDIF
	SELECT (m.lcSelect)
	Return loValuta
ENDPROC

**************************************
*** Cauta o factura in ireg_parteneri dupa cont, id_part, nr_act / comanda
*** Se foloseste la importul din extrasele bancare, deconturi curieri, procesatori plati
*** Intoarce un obiect (id_fact, cont, acont, nract)
**************************************
Procedure GetDocumentByContPartenerAct
	Lparameters tcContPartener, tnIdPartener, tuDocument, tlComanda
	* loAct id_fact, cont, acont, nract

	Local lcSql, lcSql1, lcSql2, lcWhere, lcWhere1, lcWhere2, llSucces, loAct, lcSelect
	Private pnIdPartener, pcContPartener, pnNract, pnIdFact, pcComanda

	lcSelect = Select()
	pnIdPartener = tnIdPartener
	pcContPartener = Alltrim(Upper(tcContPartener))
	pnNract = IIF(!m.tlComanda and !EMPTY(m.tuDocument), m.tuDocument, 0)
	pcComanda = ALLTRIM(UPPER(TRANSFORM(IIF(m.tlComanda and !EMPTY(m.tuDocument), m.tuDocument, ''))))
*!*		pcComanda = IIF(!EMPTY(m.pcComanda), '%' + m.pcComanda + '%', '')
	pnIdFact = 0

	loAct = Createobject("Empty")
	AddProperty(loAct, "id_fact", 0)
	AddProperty(loAct, "cont", "")
	AddProperty(loAct, "acont", "")
	AddProperty(loAct, "nract", 0)
	AddProperty(loAct, "solddeb", 0)

	* Daca nu am id-ul de partener -- sau nu am nici numarul, nici suma documentului, nu caut nimic
	If Empty(m.pnIdPartener) &&  Or (Empty(m.pnNract) And Empty(m.pcComanda))
		Return loAct
	Endif

	lcWhere2 = "i.an = ?gnAn and i.luna = ?gnLuna and i.id_part = ?pnIdPartener"

	DO CASE 
		CASE !Empty(m.pnNract)
			lcWhere2 = m.lcWhere2 + " and (i.nract = ?pnNrAct)" && cautare fara cont, cu numaract
		CASE !Empty(m.pcComanda)
			lcWhere2 = m.lcWhere2 + " and (UPPER(l.nrord) like '%"+ m.pcComanda + "%'OR UPPER(i.explicatia) like '%" + m.pcComanda + "%' OR UPPER(i.explicatia4) like '%" + m.pcComanda + "%' OR UPPER(i.explicatia5) like '%" + pcComanda + "%')" && cautare fara cont, cu comanda 
	ENDCASE 

	lcWhere1 = m.lcWhere2 + IIF(!Empty(m.pcContPartener), " and i.cont = ?pcContPartener", "")

	lcSql = [select i.id_fact, i.cont, i.acont, i.nract, (i.precdeb+i.debit-i.preccred-i.credit) as solddeb from ireg_parteneri i left join nom_lucrari l on i.id_lucrare = l.id_lucrare where ]
	lcSql1 = m.lcSql  + m.lcWhere1
	lcSql2 = m.lcSql  + m.lcWhere2

	llSucces = goExecutor.oExecuta(m.lcSql1, "cRezultatTemp")
	If m.llSucces
		If Reccount('cRezultatTemp') = 0
			If m.lcWhere2 <> m.lcWhere1
				Use In (Select('cRezultatTemp'))
				llSucces = goExecutor.oExecuta(m.lcSql2, "cRezultatTemp")
			Endif && m.lcWhere2 <> m.lcWhere1
		Endif && RECCOUNT('cRezultatTemp') = 0
	Endif && m.llSucces

	If Used('cRezultatTemp')
		If Reccount('cRezultatTemp') > 1
			polog.Log('Sunt prea multe rezultate care se potrivesc', Program())
		Else
			Select cRezultatTemp
			Go Top
			loAct.id_fact = id_fact
			loAct.Cont = Alltrim(Cont)
			loAct.acont = Nvl(acont, '')
			loAct.nract = nract
			loAct.solddeb = solddeb
		Endif
	Endif

	Use In (Select('cRezultatTemp'))
	Select (m.lcSelect)

	Return loAct
Endproc && GetDocumentByContPartenerActSuma

**************************************
*** Intoarce Id Sectie din nomenclatorul de sectii dupa numele sectiei
**************************************
Procedure GetIdSectie
	Lparameters tcSectie
	Private pnIdSectie, pcSectie
	Local lcSql, lnSucces, lcSelect
	lcSelect = SELECT()
	pnIdSectie = 0
	pcSectie = Upper(Alltrim(Nvl(tcSectie, '')))

	lcSql = [select MAX(id_sectie) as id_sectie from vnom_sectii where UPPER(TRIM(sectie)) = ?pcSectie and inactiv = 0]
	lnSucces = goExecutor.oSelect2Value(m.lcSql, @pnIdSectie)
	If m.lnSucces < 0
		amessagebox(goExecutor.cEroare, 0 + 48, _Screen.Caption)
	ENDIF
	SELECT (m.lcSelect)
	Return Nvl(m.pnIdSectie, 0)
Endproc

**************************************
*** Intoarce obiect(id_sectie, sectie, csectie) din nomenclatorul de sectii dupa indicativ sectie
**************************************
Procedure GetSectieByCsectie
	Lparameters tcCSectie
	Private pnIdSectie, pcCSectie
	Local lcSql, lnSucces, lcSelect
	Local loRec As "empty"
	Local lcCursor, llSucces
	lcSelect = SELECT()
	
	loRec = CREATEOBJECT("empty")
	ADDPROPERTY(loRec, 'id_sectie', 0)
	ADDPROPERTY(loRec, 'sectie', '')
	ADDPROPERTY(loRec, 'csectie', '')

	pcCSectie = Upper(Alltrim(Nvl(tcCSectie, '')))

	lcSql = [select id_sectie, sectie, csectie from vnom_sectii where UPPER(TRIM(csectie)) = ?pcCSectie and inactiv = 0]
	lcCursor = SYS(2015)
	llSucces = goExecutor.oExecuta(m.lcSql, m.lcCursor)
	If m.llSucces
		SELECT (m.lcCursor)
		IF RECCOUNT() >= 1
			GO TOP 
			SCATTER NAME loRec
		ENDIF 
		USE IN (SELECT(m.lcCursor))
	ENDIF

	SELECT (m.lcSelect)
	Return loRec
Endproc

**************************************
*** Intoarce obiect(id_sectie, sectie, csectie) din nomenclatorul de sectii dupa id sectie
**************************************
Procedure GetSectieById
	Parameters tnIdSectie
	
	Local loRec As "empty"
	Local lcSelect, llSucces

	lcSelect = SELECT()
	
	loRec = CREATEOBJECT("empty")
	ADDPROPERTY(loRec, 'id_sectie', 0)
	ADDPROPERTY(loRec, 'sectie', '')
	ADDPROPERTY(loRec, 'csectie', '')

	llSucces = goExecutor.oSelecteaza2Object("select id_sectie, sectie, csectie from vnom_sectii where id_sectie = ?tnIdSectie", @loRec)

	SELECT (m.lcSelect)
	Return loRec
ENDPROC

**************************************
*** Intoarce obiect din nomenclatorul de gestiuni dupa id gestiune
**************************************
Procedure GetGestiuneById
	Parameters tnIdGestiune
	
	Local loRec As "empty"
	Local lcSelect, lcSql, llSucces

	lcSelect = SELECT()
	
	loRec = CREATEOBJECT("empty")
	ADDPROPERTY(loRec, 'id_gestiune', 0)
	ADDPROPERTY(loRec, 'nume_gestiune', '')
	ADDPROPERTY(loRec, 'cgest', '')

	TEXT TO lcSql noshow
select id_gestiune, nume_gestiune, inactiv, cont, acont, nr_pag, cgest, id_sucursala, descriere, nume_tip, sucursala, id_responsabil, denumire, id_sectie, sectie, acont_adaos, acont_cheltuiala, id_lucrare, nrord, gestionar, comisie_receptie1, comisie_receptie2, comisie_receptie3 
	from vnom_gestiuni 
	where id_gestiune = ?tnIdGestiune	
	ENDTEXT 
	
	llSucces = goExecutor.oSelecteaza2Object(m.lcSql, @loRec)

	SELECT (m.lcSelect)
	Return loRec
ENDPROC

**************************************
*** Intoarce Id Lucrare din nomenclatorul de lucrari dupa numele lucrarii
**************************************
Procedure GetIdLucrare
	Lparameters tcLucrare
	Private pnIdLucrare, pcLucrare
	Local lcSql, lnSucces, lcSelect
	lcSelect = SELECT()
	pnIdLucrare = 0
	pcLucrare = Upper(Alltrim(Nvl(tcLucrare, '')))

	lcSql = [select MAX(id_lucrare) as id_lucrare from vnom_lucrari where UPPER(TRIM(nrord)) = ?pcLucrare and inactiv = 0]
	lnSucces = goExecutor.oSelect2Value(m.lcSql, @pnIdLucrare)
	If m.lnSucces < 0
		amessagebox(goExecutor.cEroare, 0 + 48, _Screen.Caption)
	ENDIF
	SELECT (m.lcSelect)	
	Return Nvl(m.pnIdLucrare, 0)
Endproc

**************************************
*** Intoarce Id Venchelt din nomenclatorul de venchelt dupa numele venchelt
**************************************
Procedure GetIdVenchelt
	Lparameters tcVenchelt
	Private pnIdVenchelt, pcVenchelt
	Local lcSql, lnSucces, lcSelect
	lcSelect = SELECT()
	pnIdVenchelt = 0
	pcVenchelt = Upper(Alltrim(Nvl(tcVenchelt, '')))

	lcSql = [select MAX(id_Venchelt) as id_Venchelt from vnom_venchel where UPPER(TRIM(explicatie)) = ?pcVenchelt and inactiv = 0]
	lnSucces = goExecutor.oSelect2Value(m.lcSql, @pnIdVenchelt)
	If m.lnSucces < 0
		amessagebox(goExecutor.cEroare, 0 + 48, _Screen.Caption)
	ENDIF
	SELECT (m.lcSelect)		
	Return Nvl(m.pnIdVenchelt, 0)
Endproc

**************************************
*** Intoarce obiect din nomenclatorul Venit/Cheltuiala dupa id
**************************************
Procedure GetVencheltById
	Parameters tnIdVenChelt
	
	Local loRec As "empty"
	Local lcSelect, llSucces

	lcSelect = SELECT()
	
	loRec = CREATEOBJECT("empty")
	ADDPROPERTY(loRec, 'id_venchelt', 0)
	ADDPROPERTY(loRec, 'tip_venchelt', 1)
	ADDPROPERTY(loRec, 'explicatie', '')
	ADDPROPERTY(loRec, 'explicatie_fiu', '')
	ADDPROPERTY(loRec, 'explicatie_tata', '')

	llSucces = goExecutor.oSelecteaza2Object("select id_venchelt, id_tata, tip_venchelt, explicatie, explicatie_fiu, explicatie_tata, inactiv, id_mod from vnom_venchel where id_venchelt = ?tnIdVenChelt", @loRec)

	SELECT (m.lcSelect)
	Return loRec
ENDPROC

**************************************
*** Intoarce valoarea unei optiuni
**************************************
Procedure GetOptiuneFirma
	Lparameters tcOptiune
	Local lcReturn
	Private pcOptiune
	lcReturn  = ""
	If Empty(m.tcOptiune) Or Type('tcOptiune') <> 'C'
		Return m.lcReturn
	Endif
	pcOptiune = Upper(Alltrim(m.tcOptiune))
	lnSucces = goExecutor.oSelect2Value("select pack_sesiune.getoptiunefirma(?pcOptiune) from dual", @lcReturn)
	If m.lnSucces < 0
		amessagebox(goExecutor.cEroare, 0 + 48, _Screen.Caption)
	Endif

	Return m.lcReturn
Endproc

**************************************
*** Intoarce cod bare din nomenclatorul de articole
**************************************
Procedure GetCodBareByIdArticol
	Lparameters tnIdArticol
	Private pnIdArticol, pcCodBare
	Local lcSql, lnSucces
	pcCodBare = ''
	pnIdArticol = m.tnIdArticol

	lcSql = [select codbare from nom_articole where id_articol = ?pnIdArticol]
	llSucces = goExecutor.oSelecteaza2Value(m.lcSql, @pcCodBare)
	Return NVL(m.pcCodBare, '') 
Endproc


**************************************
*** Intoarce un obiect din vnom_articole/id_articol dupa denumire/codbare/cod client/cod furnizor
*** lnIdArticol = GetArticolByCodDenumire("articol", "cod bare", "cod furnizor", "cod client", IdPart, .T.)
*** loArticol = GetArticolByCodDenumire("articol", "cod bare", "cod furnizor", "cod client", IdPart, .F.)
**************************************
Procedure GetArticolByCodDenumire
	lParameters tcDenumire, tcCodBare, tcCodMat, tcCodMatF, tcCodMatP, tnIdPart, tlReturnId
	* tcDenumire: denumire articol
	* tcCodBare: cod bare articol
	* tcCodMat: primite = efactura.codClient, trimise = efactura.codFurnizor = nom_articole.codmat
	* tcCodMatF: primite = efactura.codFurnizor = nom_articole.codmatf
	* tcCodMatP: trimise = efactura.codClient = parteneri_articole_coduri.cod
	* tnIdPart: id_part client
	* tlReturnId: .T. = intoarce id_articol, .F. = intoarce obiect nom_articole
	
	Private pcDenumire, pcCodBare, pcCodFurnizor, pcCodCLient, pnIdPart
	Local lcSql, lnSucces, lcSelect, loArticol, loReturn
	lcSelect = SELECT()
	loArticol = null 
	loReturn = Null 
	
	pcDenumire = UPPER(Alltrim(NVL(m.tcDenumire, '')))
	pcCodBare = UPPER(ALLTRIM(NVL(m.tcCodBare, '')))
	pcCodMat = UPPER(ALLTRIM(NVL(m.tcCodMat, '')))
	pcCodMatF = UPPER(ALLTRIM(NVL(m.tcCodMatF, '')))
	pcCodMatP = UPPER(ALLTRIM(NVL(m.tcCodMatP, '')))
	pnIdPart = NVL(m.tnIdPart, 0)
	
	TEXT TO lcSql TEXTMERGE NOSHOW 
SELECT * FROM vnom_articole a left join parteneri_articole_coduri c ON (a.id_part = c.id_part and c.id_part = ?pnIdPart and c.sters = 0)
	where a.inactiv = 0 and rownum = 1 and (<<IIF(!EMPTY(m.pcDenumire), " or a.denumire = ?pcDenumire", "")>><<IIF(!EMPTY(m.pcCodBare), " or a.codbare = ?pcCodBare", "")>><<IIF(!EMPTY(m.pcCodMat), " or a.codmat = ?pcCodMat", "")>><<IIF(!EMPTY(m.pcCodMatF), " or a.codmatf = ?pcCodMatF", "")>><<IIF(!EMPTY(m.pcCodMatP), " or c.cod = ?pcCodMatP", "")>>)
	ENDTEXT 

	* Daca nu exista denumire, codbare, codmat, codmatF, codmatP
	lcSql = STRTRAN(m.lcSql, " and ()", " and (1=2)", 1, 1, 1)
	lcSql = STRTRAN(m.lcSql, "( or ", "(", 1, 1, 1)

	llSucces = goExecutor.oSelecteaza2Object(m.lcSql, @loArticol)

	If m.llSucces
		IF m.tlReturnId
			loReturn = loArticol.id_articol
		ELSE
			loReturn = loArticol
		ENDIF 
	ENDIF

	SELECT (m.lcSelect)
	Return loReturn
	
ENDPROC && GetArticolByCodDenumire

**************************************
*** Intoarce un obiect din vnom_articole dupa id_articol
*** loArticol = GetArticolById(lnIdArticol)
**************************************
Procedure GetArticolById
	lParameters tnId
	* tnId: id_articol
	
	
	lcSelect = SELECT()
	loArticol = Null 
	pnId = NVL(m.tnId, 0)
	
	TEXT TO lcSql TEXTMERGE NOSHOW 
SELECT * FROM vnom_articole a where id_articol = ?pnId
	ENDTEXT 

	llSucces = goExecutor.oSelecteaza2Object(m.lcSql, @loArticol)

	SELECT (m.lcSelect)
	Return loArticol
	
ENDPROC && GetArticolById

**************************************
*** Intoarce un obiect din ANAF_VEFACTURA_DETALII/id_articol dupa cod fiscal furnizor/client si denumire
*** Cauta in articolele furnizorului/clientului, ultima aparitie a articolului respectiv
*** lnIdArticol = GetArticolEFByPartDenumire("cod fiscal", "articol", .T.)
*** loArticol = GetArticolByCodDenumire("articol", "cod bare", "cod furnizor", "cod client", IdPart, .F.)
**************************************
Procedure GetArticolEFByPartDenumire
	lParameters tcCodFiscal, tlPrimite, tcDenumire, tlReturnId, tnIdEfactura
	* tcCodFiscal : cod fiscal client/furnizor
	* tlPrimite: facturi primite / emise
	* tcDenumire: denumire articol
	* tlReturnId: .T. = intoarce id_articol, .F. = intoarce obiect 
	* tnIdEfactura: id_efactura curenta. sa nu caut articolul in factura curenta, ci in facturile anterioare
	
	Private pcDenumire, pcCodBare, pcCodFurnizor, pcCodCLient, pnIdPart, pnIdEfactura
	Local lcSql, lnSucces, lcSelect, loArticol, loReturn, lcColoanaCodFiscal
	lcSelect = SELECT()
	loArticol = null 
	loReturn = Null 
	
	pcDenumire = UPPER(Alltrim(NVL(m.tcDenumire, '')))
	pcCodFiscal = UPPER(ALLTRIM(NVL(m.tcCodFiscal, '')))
	pnIdArticol = 0
	pnIdEfactura = IIF(!EMPTY(NVL(tnIdEfactura, 0)), m.tnIdEfactura, 0)
	lcColoanaCodFiscal = IIF(m.tlPrimite, "e.cod_fiscal_emitent", "e.cod_fiscal_beneficiar")
	
	TEXT TO lcSql TEXTMERGE NOSHOW 
SELECT * FROM (SELECT d.* FROM ANAF_VEFACTURA_DETALII d LEFT JOIN ANAF_EFACTURA e ON (e.id = d.id_efactura) 
	WHERE <<m.lcColoanaCodFiscal>> = ?pcCodFiscal AND TRIM(UPPER(d.articol)) = ?pcDenumire and id_articol is not null ORDER BY d.id desc) WHERE rownum = 1
	ENDTEXT 

	llSucces = goExecutor.oSelecteaza2Object(m.lcSql, @loArticol)

	If m.llSucces
		* Daca nu am gasit factura cu articol ROA (este posibil sa fie de servicii, fara articole gestionabile)
		* Caut articolelele anterioare, fara id_articol
		IF EMPTY(NVL(loArticol.id_articol,0)) AND !EMPTY(NVL(m.tnIdEfactura,0))
	TEXT TO lcSql TEXTMERGE NOSHOW 
SELECT * FROM (SELECT d.* FROM ANAF_VEFACTURA_DETALII d LEFT JOIN ANAF_EFACTURA e ON (e.id = d.id_efactura) 
	WHERE <<m.lcColoanaCodFiscal>> = ?pcCodFiscal AND TRIM(UPPER(d.articol)) = ?pcDenumire and e.id <> ?pnIdEFactura ORDER BY d.id desc) WHERE rownum = 1
	ENDTEXT 

			llSucces = goExecutor.oSelecteaza2Object(m.lcSql, @loArticol)		
		ENDIF 
	ENDIF 
	
	IF m.llSucces	
		IF m.tlReturnId
			loReturn = loArticol.id_articol
		ELSE
			loReturn = loArticol
		ENDIF 
	ENDIF

	SELECT (m.lcSelect)
	Return loReturn
	
ENDPROC && GetArticolEFByPartDenumire


**************************************
*** Alege perioada
*** intoarce un obiect cu perioada aleasa
**************************************
Procedure AlegePerioada

	Local loFrmPerioada As 'frm_perioada_luni'
	Local loRet As "empty"
	Local lcPerioada, lnAn1, lnAn2, lnFinal, lnInit, lnLuna1, lnLuna2
	Private pcondper
	pcondper = ''

	loFrmPerioada = Createobject('frm_perioada_luni')
	loFrmPerioada.Show(1)

	If gnButon = 2
		Return
	Endif

	If At('_', pcondper) > 0
		lnAn1 = Val(Substr(pcondper, 3, 4))
		lnLuna1 = Val(Substr(pcondper, 1, 2))
		lnAn2 = Val(Substr(pcondper, 10, 4))
		lnLuna2 = Val(Substr(pcondper, 8, 2))

		lcPerioada = Substr(pcondper, 1, 2) + '/' + Substr(pcondper, 3, 4) + ' - ' + Substr(pcondper, 8, 2) + '/' + Substr(pcondper, 10, 4)
	Else
		lnAn1 = Val(Substr(pcondper, 3, 4))
		lnLuna1 = Val(Substr(pcondper, 1, 2))
		lnAn2 = Val(Substr(pcondper, 3, 4))
		lnLuna2 = Val(Substr(pcondper, 1, 2))

		lcPerioada = Substr(pcondper, 1, 2) + '/' + Substr(pcondper, 3, 4) + ' - ' + Substr(pcondper, 1, 2) + '/' + Substr(pcondper, 3, 4)
	Endif
	lnInit = lnAn1 * 12 + lnLuna1
	lnFinal = lnAn2 * 12 + lnLuna2

	loRet = Createobject("empty")
	AddProperty(loRet, "an1", m.lnAn1)
	AddProperty(loRet, "luna1", m.lnLuna1)
	AddProperty(loRet, "an2", m.lnAn2)
	AddProperty(loRet, "luna2", m.lnLuna2)
	AddProperty(loRet, "perioada", m.lcPerioada)

	Return loRet

Endproc && AlegePerioada

*** Citeste optiunea pentru semnatura rapoarte "SEMN_CONT_INTOCMIT/SEMN_CONT_VERIFICAT/SEMN_CONT_DIRECTOR/SEMN_GEST_INTOCMIT/SEMN_INTOCMIT"
Procedure GetSemnatura
	Lparameters tcModul, tcSemnatura, tcPrefix
	* tcModul: CONTABILITATE/GESTIUNE...
	* tcSemanatura: INTOCMIT/VERIFICAT/DIRECTOR/DIRECTOREC
	* tcPrefix OPTIONAL, default 'SEMN': se poate completa cu SEMN/DEN
	Local lcValue, lcOptiune, lcPrefix
	lcValue = ''

	lcPrefix = IIF(TYPE('tcPrefix') = 'C' and !EMPTY(m.tcPrefix), UPPER(ALLTRIM(m.tcPrefix)), 'SEMN')
	lcOptiune = lcPrefix + Iif(!Empty(m.tcModul), '_' + Upper(m.tcModul), '') + '_' + Upper(m.tcSemnatura) && 'SEMN_CONT_DIRECTOREC' / DEN_CONT_DEPFINCONT
	lcValue = Strtran(Nvl(citeste_optiune(m.lcOptiune), ''), '\r', Chr(13) + Chr(10), 1, 10, 1) && INLOCUIESC /R CU LINIE NOUA
	Return m.lcValue
Endproc


***************************************************
* Citeste atasament din baza de date si scrie fisier pe disk (ex: logo.jpg)
* Se apeleaza fie cu id-ul atasamentului, fie cu numele fisierului
* Intoarce numarul de bytes scrisi pe disk sau 0
***************************************************
Function Atasament2File
	Lparameters tnIdAtasament, tcfilename, tcFilePath
	* tnIdAtasament (optional) : id atasament
	* tcFileName (optional) : nume fisier atasament
	* tcFilePath : calea completa unde se salveaza fisierul, inclusiv numele fisierului
	Local lcFiltru, lcFiltruOriginal, lcFisier, lcOrder, lcSchema, lcSelect, lcgroup, llAfiseaza, lcFilePath
	Local llModParam, lnIdAtas
	Local lcFileName, lcNumeFisier, lnBytesWritten
	Local laFiles[1], lcOraM, ldDataM, lnD, lnFiles, lnH, lnM, lnMin, lnS, lnY, ltDataOraBD, ltDataOraFile
	Private poLink, pcFileName, pnIdAtasament
	poLink = Null
	lnBytesWritten = 0
	pnIdAtasament = Iif(!Empty(m.tnIdAtasament), m.tnIdAtasament, 0)
	pcFileName = Iif(!Empty(m.tcfilename), Justfname(m.tcfilename), '')
	lcFilePath = Iif(!Empty(m.tcFilePath), m.tcFilePath, '')

	If !(Empty(m.pnIdAtasament) And Empty(m.pcFileName))
		lcSchema = [fisier w, nume_fisier C(100), dataora T ]
		lcSelect = [select fisier, nume_fisier, dataora from atas_atasamente where sters = 0 and ] + Iif(!Empty(m.pnIdAtasament), 'id_atas = ?pnIdAtasament', Iif(!Empty(m.pcFileName), 'nume_fisier=?pcFileName', '1=2'))
		lcOrder = []
		lcgroup = []
		lcFiltru = []
		lcFiltruOriginal = []
		llModParam = .T.
		llAfiseaza = .F.

		gencursor('poLink', 'cRegFisierTemp', lcSelect, lcFiltru, lcSchema, lcOrder, llAfiseaza,  lcgroup, llModParam, lcFiltruOriginal)
		poLink.ca_baza1.afisare()
		If Used('cRegFisierTemp')
			Select cRegFisierTemp
			If Reccount('cRegFisierTemp') > 0
				Go Top
				lcFisier = fisier
				ltDataOraBD = dataora
				ltDataOraFile = dataora - 1
				lcNumeFisier = Alltrim(Nvl(nume_fisier, ''))
				lcFileName = Iif(!Empty(m.pcFileName), m.pcFileName, m.lcNumeFisier)
				lcFilePath = Iif(!Empty(m.lcFilePath), m.lcFilePath, m.lcFileName)

				Use In (Select('cRegFisierTemp'))
				If !Directory(Justpath(m.lcFilePath))
					Md (Justpath(m.lcFilePath))
				Endif

				* Verific daca data/ora modificarii din baza de date este mai mare decat cea de pe disk
				* Nu suprascriu daca fisierul de pe disk este mai nou
				polog.Log("Dataora fisier baza date: " + TRANSFORM(m.ltDataOraBD), Program())
				If File(m.lcFilePath)
					lnFiles = Adir(laFiles, m.lcFilePath)
					If m.lnFiles = 1
						ldDataM = laFiles[1, 3]
						lcOraM = laFiles[1, 4]
						lnY = Year(m.ldDataM)
						lnM = Month(m.ldDataM)
						lnD = Day(m.ldDataM)
						lnH = INT(VAL(Substr(m.lcOraM, 1, 2)))
						lnMin = INT(VAL(Substr(m.lcOraM, 4, 2)))
						lnS = INT(VAL(Substr(m.lcOraM, 7, 2)))
						Try
							ltDataOraFile = Datetime(m.lnY, m.lnM, m.lnD, m.lnH, m.lnMin, m.lnS)
						Catch
							ltDataOraFile = m.ltDataOraBD
						Endtry
					ENDIF
					polog.Log("Dataora fisier disk: " + TRANSFORM(m.ltDataOraFile), Program())
				Endif

				If m.ltDataOraBD > ltDataOraFile
					lnBytesWritten = Strtofile(m.lcFisier, m.lcFilePath)
				ELSE 	
					lnBytesWritten = 1
				Endif
			Endif  && reccount
		Endif && used
	Endif && empty

	Return m.lnBytesWritten

Endfunc && Atasament2File

***************************************************
* Citeste fisierul de pe disk si adauga atasament in baza de date atas_atasamente
* Se apeleaza cu calea completa a fisierului
* Intoarce id-ul atasamentului
***************************************************
Function File2Atasament
	Lparameters tcFile, tcDescriere

	Private pcFileName, pnId, pcFile, pcDescriere

	Local lcSql, lcSqlIns, lcSqlUpd, llSucces
	pnId = 0
	If !File(m.tcFile)
		tcFile = Getfile('', 'Alege un fisier', 'Alege', 0, 'Alege un fisier')
		If Empty(m.tcFile)
			Return m.pnId
		Endif
	Endif

	pcFile = Filetostr(m.tcFile)
	pcFileName = Lower(Justfname(m.tcFile))
	pcDescriere = Iif(!Empty(m.tcDescriere), Alltrim(m.tcDescriere), '')
	lcSql = [SELECT id_atas FROM atas_atasamente WHERE nume_fisier = ?pcFileName]
	lcSqlIns = [insert into atas_atasamente (fisier, nume_fisier, descriere, id_util, dataora) values (?pcFile, ?pcFileName, ?pcDescriere, ?gnIdUtil, sysdate) returning id_atas into ?@pnId]
	lcSqlUpd = [UPDATE atas_atasamente SET fisier = ?pcFile, descriere = ?pcDescriere, id_util = ?gnIdUtil, dataora = sysdate WHERE id_atas = ?pnId]

	llSucces = goExecutor.oExecuta(m.lcSql, 'crsAtasamenteTemp')
	If m.llSucces
		Do Case
			Case Reccount('crsAtasamenteTemp') > 1
				amessagebox('Sunt mai multe inregistrari cu acelasi nume de fisier! Nu se salveaza!', 0 + 16, _Screen.Caption)
			Case Reccount('crsAtasamenteTemp') = 1
				pnId = crsAtasamenteTemp.id_atas
		Endcase
		Use In (Select('crsAtasamenteTemp'))

		If Empty(m.pnId)
			llSucces = goExecutor.oExecuta(m.lcSqlIns)
		Else
			llSucces = goExecutor.oExecuta(m.lcSqlUpd)
			pnId = Iif(m.llSucces, m.pnId, 0)
		Endif
	Endif

	Return m.pnId

Endfunc && File2Atasament


* -------------------------------------
* Genereaza o comanda sql pentru totalizarea unui tabel dupa anumite coloane
* Echivalentul comenzii TOTAL TO, doar ca face group by dupa toate coloanele care nu sunt in lista de insumat
* lcSql = Cursor2Total('cAct', 'cActTVA', 'suma,suma_val,valtva,tvaval', .F.)
* &lcSql
* -------------------------------------
Procedure Cursor2Total
	Lparameters tcSource, tcDestination, tcFieldList, tcSumFieldList, tlGenerateCursor
	* tcSource: source cursor name 
	* tcDestination: destination cursor name
	* tcFieldList (optional, default empty = all fields): list of fields for group by
	* tcSumFieldList: list of fields for sum()
	* tlGenerateCursor (optional, default = .F.): execute the sql
	Local lcField, lcFieldList, lcGroupBy, lcSql, lcSumFieldList, llField, lnColCount, lnColumn
	lcSumFieldList = Alltrim(Lower(m.tcSumFieldList))
	lcFieldList = Iif(Empty(m.tcFieldList), '', Lower(m.tcFieldList))

	lnColCount = Fcount(tcSource)
	lcSql = [select ]
	lcGroupBy = []
	For lnColumn = 1 To m.lnColCount
		lcField = Lower(Field(m.lnColumn, m.tcSource))

		If m.lcField $ m.lcSumFieldList
			lcSql = m.lcSql  + Iif(m.lnColumn > 1, [,], []) + [Sum(] + m.lcField + [) as ] + m.lcField
		Else
			llField = Empty(m.lcFieldList) Or m.lcField $ m.lcFieldList
			If m.llField
				lcSql = m.lcSql + Iif(m.lnColumn > 1, [,], []) + m.lcField
				lcGroupBy = m.lcGroupBy + Iif(m.lnColumn > 1, [,], []) + m.lcField
			Endif
		Endif
	Endfor

	lcSql = m.lcSql + [ from ] + m.tcSource + [ with (buffering=.t.) group by ] + m.lcGroupBy + [ into cursor ] + m.tcDestination + [ readwrite]
	If m.tlGenerateCursor
		&lcSql
	Endif
	Return m.lcSql
Endproc

************************************
* Functie pentru calculul _PAGETOTAL pentru grupuri care reseteaza pagina la 1 intr-un raport
* tcCrsAlias este optional, pentru a-l putea inchide la destroy in raport
************************************
Function UpdatePageTotalGroup(tcGroupValue, tcCrsAlias)
	Local lcAlias, lcSelect, lnPgCnt
	lcSelect = Select()
	lcAlias = Iif(!Empty(m.tcCrsAlias), tcCrsAlias, 'crsGrpPageCnt')
	If !Used(m.lcAlias)
		Create Cursor (m.lcAlias) (rptGrp C(100), pgCnt i)
		Select (m.lcAlias)
		Index On rptGrp Tag C_GrpPage
	Endif

	Select (m.lcAlias)
	If !Seek(Transform(m.tcGroupValue), m.lcAlias, 'C_GrpPage')
		Insert Into (m.lcAlias) (rptGrp) Values (Transform(m.tcGroupValue))
	Endif
	Replace pgCnt With Max(pgCnt, _Pageno)
	lnPgCnt = pgCnt

	Select (m.lcSelect)
	Return m.lnPgCnt
Endfunc && UpdatePageTotalGroup

*******************************************
* Delete Directories and Files in Directory (including subdirectories)
* Returns the number of files
*
* lnFiles = xdelete('c:\temp')
*******************************************
FUNCTION xdelete
	LPARAMETERS tcDirectory

	LOCAL laFiles[1], llDelete
	llDelete = .T.
	lnFiles = xdir(@laFiles, m.tcDirectory, '*.*', m.llDelete)
	
	TRY
		RD (m.tcDirectory)
	CATCH TO loEx
		MESSAGEBOX(m.tcDirectory + ' ' + loEx.message)					
	ENDTRY 

	RETURN m.lnFiles
ENDFUNC && xdelete

*******************************************
* Get Files in Directory (including subdirectories) 
* Returns the number of files
* 
* ex: Dimension laFiles(1)
* =xdir(@laFiles, getdir(), '*.*')
* optional, delete the files and directories
* =xdir(@laFiles, getdir(), '*.*', .T.)
*******************************************
Function xdir
	LPARAMETERS taryParam, tcDirectory, tcFileSkeleton, tlDelete
	Local Array aryTemp(1, 5)
	Local lnCount, lnMax, lnLen, lcFile, lcDirectory, lcFileSkeleton, lcDirFileSkeleton

	lcDirectory = Addbs(m.tcDirectory)
	lcFileSkeleton = Iif(!Empty(m.tcFileSkeleton), m.tcFileSkeleton, '*.*')
	lcDirFileSkeleton = Addbs(tcDirectory) + m.lcFileSkeleton
	= Adir(aryTemp, m.lcDirFileSkeleton, "AHRSD", 1)
	lnMax = Alen(aryTemp, 1)

	For lnCount = 1 To lnMax
		lcFile = Alltrim(aryTemp(lnCount, 1))
		If !(m.lcFile == ".") And !(m.lcFile == "..")
			If "D" $ aryTemp(lnCount, 5)
				= xdir(@taryParam, Addbs(m.tcDirectory) + m.lcFile, m.lcFileSkeleton, m.tlDelete)
				IF m.tlDelete
					TRY
						RD (Addbs(m.tcDirectory) + m.lcFile)
					CATCH TO loEx
						MESSAGEBOX(Addbs(m.tcDirectory) + m.lcFile + ' ' + loEx.message)					
					ENDTRY 
				ENDIF 
			Else
				lnLen = Alen(taryParam)
				If !Empty(taryParam(lnLen))
					Dimension taryParam(lnLen + 1)
					lnLen = lnLen + 1
				Endif
				taryParam(lnLen) = m.lcDirectory + m.lcFile
				IF m.tlDelete
					TRY
						DELETE FILE (taryParam(lnLen))
					CATCH TO loEx
						MESSAGEBOX(taryParam(lnLen) + ' ' + loEx.message)
					ENDTRY 
				ENDIF 				
			Endif
		Endif
	ENDFOR
	
	Return Alen(taryParam)
ENDFUNC

*------------------------------------------------------------------------
* syGetWordNum()
*   An alternate version of VFP GetWordNum() that will not skip empty fields.
*   e.g.
*     syGetWordNum([A,,B,C],2,[,]) returns empty string instead of 'B'
*     syGetWordNum([A,,B,C],3,[,]) returns 'B' instead of 'C'
*   Default delimiters are space, tab, carriage return and linefeed.
*   Vertical tab is used as a special token.
*------------------------------------------------------------------------
function syGetWordNum(tcString, tnIndex, tcDelimiters)
   local lcPatch, lcWord, i
   if vartype(tcDelimiters)<>'C'
      tcDelimiters = chr(32) + chr(9) + chr(13) + chr(10)
   endif
   lcPatch = tcString
   for i = 1 to len(tcDelimiters)
      lcPatch = strtran(lcPatch,substr(tcDelimiters,i,1),chr(11)+substr(tcDelimiters,i,1)+chr(11))
   endfor
   lcWord = getwordnum(lcPatch, tnIndex, tcDelimiters)
   lcWord = strtran(lcWord,chr(11))
   return lcWord
endfunc

*------------------------------------------------------------------------
* syGetWordCount()
*   An alternate version of VFP GetWordCount() that will not skip empty fields.
*   e.g.
*     syGetWordCount([A,,B,C],[,]) returns 4 instead of 3
*   Default delimiters are space, tab, carriage return and linefeed.
*   Vertical tab is used as a special token.
*------------------------------------------------------------------------
function syGetWordCount(tcString, tcDelimiters)
   local lcPatch, lnCount, i
   if vartype(tcDelimiters)<>'C'
      tcDelimiters = chr(32) + chr(9) + chr(13) + chr(10)
   endif
   lcPatch = tcString
   for i = 1 to len(tcDelimiters)
      lcPatch = strtran(lcPatch,substr(tcDelimiters,i,1),chr(11)+substr(tcDelimiters,i,1)+chr(11))
   endfor
   lnCount = getwordcount(lcPatch, tcDelimiters)
   return lnCount
ENDFUNC

****************************

FUNCTION ValidCNP
	LPARAMETERS nCnp

	LOCAL cCod
	IF TYPE('nCnp') = 'N'
		cCod=ALLTRIM(STR(m.nCnp,15,0))
	ELSE 	
		cCod = ALLTRIM(m.nCnp)
	ENDIF
	
	IF LEN(cCod)!=13
		RETURN .F.
	ENDIF
	LOCAL _X(13),_rest, j
	FOR j=1 TO 13
		_X(j)=VAL(SUBSTR(cCod,j,1))
	ENDFOR
	_rest=(_X(1)*2+_X(2)*7+_X(3)*9+_X(4)*1+_X(5)*4+_X(6)*6+_X(7)*3+_X(8)*5+_X(9)*8+_X(10)*2+_X(11)*7+_X(12)*9)%11
	RETURN IIF((_rest<10 and _rest=_X(13))or(_rest = 10 and _X(13)=1),.T.,.F.)
ENDFUNC && ValidCNP


FUNCTION cValidCNP
	LPARAMETERS lpcnp
	
	IF TYPE('lpCNP') ='N'
		lpCNP = ALLTRIM(STR(m.lpcnp))
	ENDIF 
		
	IF LEN(ALLTRIM(lpcnp)) <> 13
	     RETURN .F.
	ENDIF
	n1 = VAL(SUBSTR(lpcnp, 1, 1))
	n2 = VAL(SUBSTR(lpcnp, 2, 1))
	n3 = VAL(SUBSTR(lpcnp, 3, 1))
	n4 = VAL(SUBSTR(lpcnp, 4, 1))
	n5 = VAL(SUBSTR(lpcnp, 5, 1))
	n6 = VAL(SUBSTR(lpcnp, 6, 1))
	n7 = VAL(SUBSTR(lpcnp, 7, 1))
	n8 = VAL(SUBSTR(lpcnp, 8, 1))
	n9 = VAL(SUBSTR(lpcnp, 9, 1))
	n10 = VAL(SUBSTR(lpcnp, 10, 1))
	n11 = VAL(SUBSTR(lpcnp, 11, 1))
	n12 = VAL(SUBSTR(lpcnp, 12, 1))
	n13 = VAL(SUBSTR(lpcnp, 13, 1))
	c = MOD((n1 * 2 + n2 * 7 + n3 * 9 +  ;
	    n4 * 1 + n5 * 4 + n6 * 6 + n7 *  ;
	    3 + n8 * 5 + n9 * 8 + n10 * 2 +  ;
	    n11 * 7 + n12 * 9), 11)
	IF c = 10
	     c = 1
	ENDIF
	IF c = n13
	     RETURN .T.
	ELSE
	     RETURN .F.
	ENDIF
ENDFUNC

*
FUNCTION GetDataCNP
	LPARAMETERS plcnp
	LOCAL mlan
	mlan = SUBSTR(plcnp, 2, 2)
	IF VAL(mlan) > 20 AND !INLIST(LEFT(plcnp, 1), "5", "6")
	     mlan = "19" + mlan
	ELSE
	     mlan = "20" + mlan
	ENDIF
	RETURN CTOD(SUBSTR(plcnp, 6, 2) +  "." + SUBSTR(plcnp, 4, 2) +  "." + mlan)
ENDFUNC
*
FUNCTION VerifCF
	LPARAMETERS plcfisc
	LOCAL mlsuma, mlrest
	plcfisc = getnrfromstring(plcfisc)
	IF LEN(ALLTRIM(plcfisc)) = 13
	     IF  .NOT. cvalidcnp(plcfisc)
	          RETURN .F.
	     ELSE
	          RETURN .T.
	     ENDIF
	ELSE
	     IF LEN(ALLTRIM(plcfisc)) < 2 OR LEN(ALLTRIM(plcfisc)) > 10 OR plcfisc = "0"
	          RETURN .F.
	     ENDIF
	ENDIF
	plcfisc = PADL(ALLTRIM(plcfisc), 10, "0")
	mlsuma = 0
	FOR i = 1 TO 10
	     mlsuma = mlsuma + VAL(SUBSTR(plcfisc, i, 1)) * VAL(SUBSTR("753217532", i, 1))
	ENDFOR
	mlrest = MOD((mlsuma * 10), 11)
	IF mlrest = 10
	     mlrest = 0
	ENDIF
	IF VAL(SUBSTR(plcfisc, 10, 1)) <> mlrest
	     RETURN .F.
	ELSE
	     RETURN .T.
	ENDIF
ENDFUNC
*
*verifiban('RO79FNNB000501041759RO01')
FUNCTION VerifIBAN
	LPARAMETERS iban
	iban = STRTRAN(iban, " ", "")

	IF LEN(ALLTRIM(iban)) <> 24
	     RETURN .F.
	ENDIF
	mcontrol = SUBSTR(iban, 3, 2)
	iban = SUBSTR(iban, 5, 20) +  SUBSTR(iban, 1, 2) + "00"
	miban = ""
	FOR i = 1 TO 24
	     IF ISALPHA(SUBSTR(iban, i,  1))
	          miban = miban +  ALLTRIM(STR(ASC(SUBSTR(iban, i, 1)) - 55))
	     ELSE
	          miban = miban +  SUBSTR(iban, i, 1)
	     ENDIF
	ENDFOR
	mibansec = miban
	rest = ""
	FOR i = 0 TO 7
	     mibansec = rest + SUBSTR(miban, i *  5 + 1, 5)
	     dv = MOD(VAL(mibansec), 97)
	     rest = ALLTRIM(STR(dv))
	ENDFOR
	IF PADL(ALLTRIM(STR(98 -  VAL(rest))), 2, "0") <> mcontrol
	     RETURN .F.
	ELSE
	     RETURN .T.
	ENDIF
ENDFUNC
*
FUNCTION GetSumaControlIBAN
LPARAMETERS iban
IF LEN(ALLTRIM(iban)) <> 24
     RETURN "XX"
ENDIF
mcontrol = SUBSTR(iban, 3, 2)
iban = SUBSTR(iban, 5, 20) +  ;
       SUBSTR(iban, 1, 2) + "00"
miban = ""
FOR i = 1 TO 24
     IF ISALPHA(SUBSTR(iban, i,  ;
        1))
          miban = miban +  ;
                  ALLTRIM(STR(ASC(SUBSTR(iban,  ;
                  i, 1)) - 55))
     ELSE
          miban = miban +  ;
                  SUBSTR(iban, i,  ;
                  1)
     ENDIF
ENDFOR
mibansec = miban
rest = ""
FOR i = 0 TO 7
     mibansec = rest +  ;
                SUBSTR(miban, i *  ;
                5 + 1, 5)
     dv = MOD(VAL(mibansec), 97)
     rest = ALLTRIM(STR(dv))
ENDFOR
RETURN PADL(ALLTRIM(STR(98 -  ;
       VAL(rest))), 2, "0")
ENDFUNC
*    
FUNCTION GetNrFromString
	LPARAMETERS plstr
	LOCAL mlenstr
	mlenstr = LEN(ALLTRIM(plstr))

	DO WHILE ISALPHA(plstr) .OR. LEFT(plstr, 1) == " ";
	.OR. LEFT(plstr, 1) == "&" .OR. LEFT(plstr, 1) == "/";
	.OR. LEFT(plstr, 1) == "-" .OR. LEFT(plstr, 1) == "_";
	.OR. LEFT(plstr, 1) == "." .OR. LEFT(plstr, 1) == ":"
		plstr = RTRIM(SUBSTR(plstr, 2, mlenstr))
	ENDDO

	RETURN plstr
ENDFUNC
*
FUNCTION GetDigitsFromString
LPARAMETERS plstr, plnrdigits,  ;
            pltip, plseparator
LOCAL mlenstr, ii,  ;
      mreturnnrintermed,  ;
      mreturnnrfinal
mlenstr = LEN(ALLTRIM(plstr))
mreturnnrintermed = ""
mreturnnrfinal = ""
FOR ii = 1 TO mlenstr
     mcurentchar = SUBSTR(plstr,  ;
                   ii, 1)
     IF ISDIGIT(mcurentchar) .OR.  ;
        (pltip = 3 .AND.  ;
        INLIST(mcurentchar, ".",  ;
        ","))
          mreturnnrintermed = mreturnnrintermed +  ;
                              mcurentchar
     ELSE
          IF pltip = 1 .OR. pltip =  ;
             2
               mreturnnrintermed =  ;
                ""
          ENDIF
     ENDIF
     IF LEN(mreturnnrintermed) >=  ;
        plnrdigits
          DO CASE
               CASE pltip = 1
                    IF LEN(mreturnnrintermed) <=  ;
                       12 .AND.  ;
                       verifcf(mreturnnrintermed)  ;
                       .AND.   ;
                       .NOT.  ;
                       ISDIGIT(SUBSTR(plstr,  ;
                       ii + 1,  ;
                       1))
                         mreturnnrfinal =  ;
                          mreturnnrintermed
                         EXIT
                    ENDIF
               CASE pltip = 2
                    IF cvalidcnp(mreturnnrintermed)
                         mreturnnrfinal =  ;
                          mreturnnrintermed
                         EXIT
                    ENDIF
               CASE pltip = 3
                    mreturnnrintermed =  ;
                     STRTRAN(mreturnnrintermed,  ;
                     plseparator,  ;
                     "")
                    IF VAL(mreturnnrintermed) >  ;
                       0
                         mreturnnrfinal =  ;
                          mreturnnrintermed
                         EXIT
                    ENDIF
          ENDCASE
     ENDIF
ENDFOR
RETURN mreturnnrfinal
ENDFUNC
*
FUNCTION GetIBANFromString
LPARAMETERS plstr, plpoz
LOCAL mlenstr, ii,  ;
      mreturnnrintermed,  ;
      mreturnnrfinal
mlenstr = LEN(ALLTRIM(plstr))
mreturnnrintermed = ""
mreturnnrfinal = ""
misok = .F.
FOR ii = 1 TO mlenstr
     mcurentchar = SUBSTR(plstr,  ;
                   ii, 1)
     IF misok
          IF LEN(mreturnnrintermed) <  ;
             24
               mreturnnrintermed =  ;
                mreturnnrintermed +  ;
                mcurentchar
          ELSE
               EXIT
          ENDIF
     ELSE
          IF mcurentchar == "R"  ;
             .AND.  ;
             mreturnnrintermed =  ;
             "" .AND.  ;
             SUBSTR(plstr, ii + 1,  ;
             1) == "O"
               mreturnnrintermed =  ;
                mreturnnrintermed +  ;
                mcurentchar
          ELSE
               IF mcurentchar ==  ;
                  "O" .AND.  ;
                  mreturnnrintermed =  ;
                  "R"
                    mreturnnrintermed =  ;
                     mreturnnrintermed +  ;
                     mcurentchar
               ELSE
                    IF  .NOT.  ;
                        misok  ;
                        .AND.  ;
                        INLIST(mcurentchar,  ;
                        "1", "2",  ;
                        "3", "4",  ;
                        "5", "6",  ;
                        "7", "8",  ;
                        "9", "0")  ;
                        .AND.  ;
                        mreturnnrintermed =  ;
                        "RO"  ;
                        .AND.  ;
                        LEN(mreturnnrintermed) <=  ;
                        3
                         mreturnnrintermed =  ;
                          mreturnnrintermed +  ;
                          mcurentchar
                         IF plpoz =  ;
                            1
                              misok =  ;
                               .T.
                         ELSE
                              mreturnnrintermed =  ;
                               ""
                              plpoz =  ;
                               plpoz -  ;
                               1
                         ENDIF
                    ELSE
                         mreturnnrintermed =  ;
                          ""
                    ENDIF
               ENDIF
          ENDIF
     ENDIF
ENDFOR
IF verifiban(mreturnnrintermed)
     RETURN mreturnnrintermed
ELSE
     RETURN ""
ENDIF
ENDFUNC
*
FUNCTION ContainChar
LPARAMETERS plstr
DO WHILE  .NOT. (ISALPHA(plstr) .OR. LEFT(plstr, 1);
== "&" .OR. LEFT(plstr, 1) == "/" .OR. LEFT(plstr,;
1) == "-" .OR. LEFT(plstr, 1) == "_")
     IF EMPTY(plstr)
          RETURN .F.
     ENDIF
     plstr = RTRIM(SUBSTR(plstr,  ;
             2, 60))
ENDDO
RETURN .T.
ENDFUNC
*
FUNCTION GetStrFromStr
LPARAMETERS plstr
LOCAL mstr
mstr = ""
DO WHILE ISALPHA(plstr) .OR.  ;
   LEFT(plstr, 1) == " "
     mstr = mstr + LEFT(plstr, 1)
     plstr = SUBSTR(plstr, 2, 20)
ENDDO
RETURN ALLTRIM(mstr)
ENDFUNC
*
FUNCTION CheckDigit
LPARAMETERS tcstring
LOCAL llsuccess
llsuccess = .F.
IF EMPTY(tcstring)
     RETURN .F.
ENDIF
FOR lncharacter = 1 TO  ;
    LENC(tcstring)
     lcchar = SUBSTRC(tcstring,  ;
              lncharacter, 1)
     llsuccess = ISDIGIT(lcchar)
     IF llsuccess
          EXIT
     ENDIF
ENDFOR
RETURN llsuccess
ENDFUNC
*
FUNCTION IsOnlyDigit
LPARAMETERS tcstring
LOCAL llsuccess
llsuccess = .F.
IF EMPTY(tcstring)
     RETURN .F.
ENDIF
FOR lncharacter = 1 TO  ;
    LENC(tcstring)
     lcchar = SUBSTRC(tcstring,  ;
              lncharacter, 1)
     IF  .NOT. ISDIGIT(lcchar)  ;
         .AND.  .NOT.  ;
         INLIST(lcchar, ",", ".",  ;
         " ")
          RETURN .F.
     ENDIF
ENDFOR
RETURN .T.
ENDFUNC

PROCEDURE TestExcesSerialNumber2Date
* Example
? ExcelSerialNumber2Date(39278)			&& 2007-07-15
? ExcelSerialNumber2Datetime(39278.456777)	&& 2007-07-15 10:57:46
? ExcelSerialNumber2Time(.456777)		&& 10:57:46
ENDPROC 
*--------------------------------------------------------------------
 
* Convert Excel serial number to a date 
FUNCTION ExcelSerialNumber2Date(tnExcelSerialNumber)
	RETURN {^1899/12/30} + tnExcelSerialNumber 
ENDFUNC && ExcelSerialNumber2Date 

* Convert Excel serial number to a datetime 
FUNCTION ExcelSerialNumber2Datetime(tnExcelSerialNumber)
	RETURN DTOT({^1899/12/30} + INT(tnExcelSerialNumber)) + ;
		ROUND(24*60*60 * (tnExcelSerialNumber % 1),0)
ENDFUNC && ExcelSerialNumber2Datetime
 
* Convert Excel serial number to a time string
FUNCTION ExcelSerialNumber2Time(tnExcelSerialNumber)
	RETURN SUBSTR(TTOC({^2000/01/10 00:00:00} + ROUND(24*60*60 * (tnExcelSerialNumber % 1),0),3), 12)
ENDFUNC && ExcelSerialNumber2Time 

***************************************************************
* Unzip a zip file
* lcZipFile = 'c:\arhiva.zip'
* lcUnzipDir = ''
* lcErrrMessage = ''
* llSuccs = Unzip(m.lcZipFile, @lcUnzipDir, @lcErrrMessage)
***************************************************************
PROCEDURE MyUnzip
	LPARAMETERS tcFileName, tcUnzipDir, tcErrorMessage, tlSilent
	* tcFileName: IN calea catre fisierul arhiva zip
	* tcUnzipDir: IN/OUT director dezarhivare
	* tcErrorMessage: OUT mesaj eroare daca RETURN = .F.
	* tlSilent: .T. fara wait window la callback
	* RETURN: Logical .T. daca dezarhivare cu succes

	Local lcFileName, lcLibraryPath, llSucces, loErr
	
	llSucces = .F.
	lcFileName = m.tcFileName
	tcErrorMessage = ''
	If Empty(m.lcFileName) OR !FILE(m.lcFileName)
		tcErrorMessage = 'Fisierul de dezarhivat nu exista!'
		RETURN m.llSucces 
	ENDIF
	
	IF EMPTY(m.tcUnzipDir)
		tcUnzipDir = Addbs(Sys(2023)) + Sys(2015)
	ENDIF 

	IF !DIRECTORY(m.tcUnzipDir )	
		Md (m.tcUnzipDir )
	ENDIF 	

	Try
		lcLibraryPath = ADDBS(m.gcBasePath) + Iif("ROA" $ Upper(gcBasePath), "COMUNROA", "COMUNCONTAFIN") + "\vfpcompression.fll" && CONTAFIN(ROA)\COMUNCONTAFIN(COMUNROA)\vfpcompression.fll

		If File(m.lcLibraryPath)
			If !'vfpcompression' $ LOWER(Set("Library"))
				Set Library To (m.lcLibraryPath) Additive
			Endif
			IF !m.tlSilent
				ZipCallback("MyUnzipCallBack()") && Start Event Handling - Any Function/Procedure/Method (in scope of course)
			ENDIF 	
			llSucces = UnzipQuick(m.lcFileName, m.tcUnzipDir )
			ZipCallback("") && Stop Event Handling				
		ELSE 
			llSucces = .F.
			tcErrorMessage = 'Nu exista libraria ' + m.lcLibraryPath
		ENDIF 
	CATCH TO loErr
		llSucces = .F.
		tcErrorMessage = loErr.Message
	ENDTRY 
	
	RETURN m.llSucces 
ENDPROC  


Procedure UnzipQuickShell
	Lparameters tcFileName, tcUnzipDir, tcErrorMessage, tlSilent
	* tcFileName: IN calea catre fisierul arhiva zip
	* tcUnzipDir: IN/OUT director dezarhivare
	* tcErrorMessage: OUT mesaj eroare daca RETURN = .F.
	* tlSilent: .T. fara wait window la callback && nu este implementat la shell
	* RETURN: Logical .T. daca dezarhivare cu succes

	Local loShell As "shell.application", loEx as Exception
	Local lcFileName, lcUnzipDir, llSucces, ofile

	tcErrorMessage = ''
	llSucces = .F.

	Try
		lcFileName = m.tcFileName && "C:\temp\D401001F.ZIP"
		lcUnzipDir = m.tcUnzipDir
		
		IF EMPTY(m.tcUnzipDir) OR TYPE('tcUnzipDir') <> 'C'
			lcUnzipDir = Addbs(Sys(2023)) + Sys(2015)
		ENDIF 		

		If !Directory(m.lcUnzipDir)
			Md (m.lcUnzipDir)
		Endif

		loShell = Createobject("shell.application")
		For Each ofile In loShell.NameSpace(m.lcFileName).items
			loShell.NameSpace(m.lcUnzipDir).copyhere(ofile, 16)
		Endfor
		llSucces = .T.
	Catch To loEx
		tcErrorMessage = loEx.Message 
		llSucces = .F.
	Endtry

	Return m.llSucces
Endproc && UnzipQuickShell

********************************
* Intoarce calea COMUNA pentru pdf-uri declaratii, efactura generate de program
* D:\ROA\[tcTip]\[AAAA_LL]\[FIRMA]\[tcTip2]
* lcFisierPDF = GetPdfPath('EFACTURA', 'PRIMITE')
********************************
FUNCTION GetPdfPath
	LPARAMETERS tcTip, tcTip2
	* tcTip: D300/D394/D390/eFactura
	* tcTip2: (optional) Primite (eFactura)
	
	Local lcCaleFisier, lcMesaj, lcTip, llSucces, loEx, lcFirma
	lcTip = IIF(!EMPTY(m.tcTip), UPPER(ALLTRIM(m.tcTip)), 'ALTE')
	
	*** Creez structura director export (caletemp\D390\aaaa_ll\firma\
	llSucces = .F.
	Try
		lcCaleFisier = Addbs(m.gcBasePath) + m.lcTip + "\" && d:\ROA\D390\
		If !Directory(m.lcCaleFisier)
			Md (m.lcCaleFisier)
		Endif

		lcCaleFisier = m.lcCaleFisier + Alltrim(Str(gnAn)) + "_" + Padl(Alltrim(Str(gnLuna)), 2, "0") + "\"&& d:\ROA\D390\2011_01\
		If !Directory(m.lcCaleFisier)
			Md (m.lcCaleFisier)
		Endif

		lcFirma = WindowsSpecialCharacters(m.gcFirma, "_") && Chrtran(m.gcFirma, [/\?%*:|"<>.,;=], Replicate('_', 14))
		lcFirma = Strtran(Alltrim(m.lcFirma), [ ], [_], 1, 100, 1)
		lcFirma = LEFT(m.lcFirma,70) && daca este prea lunga calea, xml3.save nu poate salva fisiere
		
		lcCaleFisier = m.lcCaleFisier + m.lcFirma + "\" && Strtran(gcFirma, [ ], [_]) + "\" && d:\ROA\D390\2011_01\firma\
		
		If !Directory(m.lcCaleFisier)
			Md (m.lcCaleFisier)
		Endif

		IF !EMPTY(m.tcTip2)
			lcCaleFisier = m.lcCaleFisier + UPPER(ALLTRIM(m.tcTip2)) + '\' && d:\ROA\D390\2011_01\firma\primite\
			If !Directory(m.lcCaleFisier)
				Md (m.lcCaleFisier)
			ENDIF
		ENDIF 
		
		llSucces = .T.
	Catch To loEx
		lcCaleFisier = ''
		lcMesaj = "Creare director " + lcCaleFisier + " " + loEx.Message
		amessagebox(lcMesaj, 0 + 48)
	Endtry
	
	RETURN m.lcCaleFisier
ENDFUNC && GetPdfPath

FUNCTION DeleteFiles
	lcName = SYS(2000, '*.TXT')
	DO WHILE LEN (lcName) > 0
	  DELETE FILE (lcName)
	  lcName = SYS (2000, '*.TXT')
	ENDDO
ENDFUNC    

PROCEDURE HTTPDownloadFile
	LPARAMETERS lcURL, m.lcDownloadFile

	Local loHTTP As "winhttp.winhttprequest.5.1"
	Local lnBytes, lnStatus

	loHTTP = Createobject("winhttp.winhttprequest.5.1")
	loHTTP.Open("GET", m.lcURL, .F.)
	loHTTP.Send()
	lnStatus = loHTTP.Status
	lnBytes = 0
	If m.lnStatus = 200 && OK
	   lnBytes = STRTOFILE(loHTTP.ResponseBody, m.lcDownloadFile)		
	ENDIF 

	RETURN m.lnBytes > 0
ENDPROC     