#INCLUDE COMUN.H

*** ==================== LOG ============================ ***
Define Class Log As Custom
	cLog = ''
	cOutputFile = 'c:\log_' + Dtos(Date()) + '.txt'
	lAdditive = .T.
	*
	Proc Init
		Lparameters tcOutputfile, tlAdditive

		If !Empty(tcOutputfile) And Type('tcOutputFile') = 'C'
			This.cOutputFile = tcOutputfile
		Endi
		If Pcount() = 2 And Type('tlAdditive') = 'L'
			This.lAdditive = tlAdditive
		Endif

		This.Log()
		This.Log()
		This.WRITELOG()

	Endproc
	*
	Proc Log
		Lparameters tcMessage, tcProgram
		Local lcLog
		If Pcount() = 0 Or Type('tcMessage') # 'C' Or Empty(tcMessage)
			lcLog = CRLF
		Else
			lcLog = Ttoc(Datetime()) + ' ' + Sys(0) + CRLF + tcMessage + CRLF
		Endi
		This.cLog = This.cLog + lcLog
	Endproc
	*
	Proc ResetLog
		This.cLog = ''
	Endproc
	*
	Proc WRITELOG
		Lpar tcMessage, tcOutputfile, tlAdditive
		Local lcOutputfile, llAdditive, lcLog, lcLogDirectory
		If !Empty(tcOutputfile) And Type('tcOutputFile') = 'C'
			lcOutputfile = tcOutputfile
		Else
			lcOutputfile = This.cOutputFile
		Endi
		If Pcount() < 3 Or Type('tlAdditive') # 'L'
			llAdditive = This.lAdditive
		Else
			llAdditive = tlAdditive
		Endi
		If Type('tcMessage') = 'C'
			If Empty(tcMessage)
				lcLog = CRLF
			Else
				lcLog = Ttoc(Datetime()) + ' ' + Sys(0) + CRLF + tcMessage + CRLF
			Endi
		Else
			lcLog = This.cLog
		Endi
		If !Empty(lcOutputfile)
			lcLogDirectory = Justpath(lcOutputfile)
			If !Directory(lcLogDirectory)
				Md (lcLogDirectory)
			Endif
			Strtofile(lcLog, lcOutputfile, llAdditive)
		Endi
	Endproc
	*
Enddefine && LOG
*


Define Class oexecutor As Custom
	nHandle = 0
	cSql = ''
	cSchema = ''
	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.
	lError = .F.
	cErrorMessage = ""
	lApplicationError = .F. && eroare generata de RAISE_APPLICATION_ERROR - afisez doar textul erorii.

	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)
			If Type('gnHandle') = 'N'
				This.nHandle = gnHandle
			Endif
		Else
			This.nHandle = tnHandle
		Endif

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


	* 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(toHash)
		&& tcSql, tcCursor, tnHandle
		Local lnHandle, lcSql, lcSchema, lcCursor, lcTempCursor, lnSucces, laEroare, lcEroare, llReconnect, lnTip, lcTip, lcEroare, lShowError
		Local loEx As Exception

		Declare laEroare[1]
		lcEroare = ''

		Local lnTip
		lnTip = 0

		This.Oreset()

		lcSql = Iif(toHash.HasProperty("cSql"), toHash.GetValue("cSql"), Upper(This.cSql))
		lcSchema = Iif(toHash.HasProperty("cSchema"), toHash.GetValue("cSchema"), Upper(This.cSchema))
		lcCursor = Iif(toHash.HasProperty("cCursor"), toHash.GetValue("cCursor"), Upper(This.cCursor))
		lnHandle = Iif(toHash.HasProperty("nHandle"), toHash.GetValue("nHandle"), goConn.GetHandle())
		lShowError = Iif(toHash.HasProperty("lShowError"), toHash.GetValue("lShowError"), .T.) && daca se afiseaza mesajul de eroare

		* Strtofile(lcSql+Chr(13)+Chr(10),Addbs(Justpath(Sys(16,0)))+"log.txt",.T.)
		&& DACA AM TRANZACTIE MANUALA NU FAC RECONNECT
		If SQLGetprop(lnHandle,"Transactions") = 2 && TRANZACTIE MANUALA
			llReconnect = .F.
		Else
			llReconnect = .T.
		Endif

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

		Do Case
			Case lnTip = 0

				lnSucces = -1
				Do While .T.
					*!* daca exista SCHEMA => folosesc CURSORADAPTER (ar trebui sa folosesc mereu???)
					If !Empty(lcSchema)
						Local loC As CursorAdapter
						loC = Createobject("cursoradapter")
						loC.DataSourceType ="ODBC"
						loC.Datasource = lnHandle
						loC.SelectCmd = lcSql
						loC.CursorSchema = lcSchema
						loC.Alias = lcCursor
						Use In (Select(lcCursor))
						llSucces = loC.CursorFill(!Empty(lcSchema))
						If llSucces
							loC.CursorDetach()
						Endif
						lnSucces = Iif(llSucces, CT_SUCCES, CT_INSUCCES)
					Else
						*!* PENTRU SQLEXEC ASINCRON - DO WHILE PANA SE TERMINA EXECUTIA
						Do While .T.
							Try
								lnSucces = SQLExec(lnHandle, lcSql, lcCursor)
							Catch To loEx
								lnSucces = CT_INSUCCES
							Endtry

							If lnSucces = 0
								*
							Else
								Exit
							Endif
						Enddo

						lnSucces = Iif(lnSucces > 0, CT_SUCCES, CT_INSUCCES)
					Endif

					If lnSucces = CT_SUCCES
						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
					Else
						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]
							This.cEroare = lcTextEroare
							lcTextEroare = This.oPrelucrareEroare()
							lnHandle = laEroare[6]
							llEroare = .T.
						Endif

						goApp.ProcessError(GetHash("lShowError=>" + Iif(lShowError, "1", "0") + "??lApplicationError=>" + Iif(This.lApplicationError, "1", "0") + "??cError=> " + lcTextEroare + "??cUserMessage=>" + lcSql))

						This.lError = goApp.HasError()
						This.cErrorMessage = goApp.GetError()
						This.nSucces = lnSucces
						This.cEroare = This.cErrorMessage
						This.nEroare = Iif(Alen(laEroare)>=5,laEroare[5],0)


						If llReconnect And lnEroare1 = 1526 And Inlist(lnEroare2,12152,3114,12560) && 12512 = TNS: UNABLE TO SEND BREAK MESSAGE; 3114 = NOT CONNECTED TO ORACLE; 12560 = PROTOCOL ADAPTER ERROR
							Do While lnRaspuns = .T. && conectare
								lnRaspuns = AMESSAGEBOX('Eroare de conectare.' + Chr(13) + lcTextEroare + Chr(13) + 'Doriti reconectare?',4+32,'Eroare') && retry = 4; cancel = 2
								If lnRaspuns = 6

									lnSucces = goConn.Connect()

									If lnSucces = CT_INSUCCES

										Release laEroare
										Loop
									Else
										Exit
									Endif
								Else
									&& daca nu doresc conectare atunci ies din program
									Return To Master
								Endif && lnRaspuns = 6
							Enddo && conectare

							Loop && daca am iesit cu un handle valid intru din nou in loop si execut din nou comanda
						Endif && lnEroare1 = 1526 AND INLIST(lnEroare2,12152,3114,12560)

						Exit
					Endif && lnSucces = CT_INSUCCES

				Enddo && .T.

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

				If lnSucces < 0
					goApp.ProcessError()
					This.lError = goApp.HasError()
					This.cErrorMessage = goApp.GetError()
					This.nSucces = lnSucces
					This.cEroare = This.cErrorMessage
					This.nEroare = Iif(Alen(laEroare)>=5,laEroare[5],0)
				Endif
		Endcase

		&& loghez sql
		If lnSucces > 0
			goApp.Log(lcSql)
		ELSE 
			SET STEP ON 	
		Endif
		Return Iif(lnSucces > 0, CT_SUCCES, CT_INSUCCES)

	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 = CT_SUCCES
			tuRetValue = Evaluate(lcField)
			If Used(lcCursor)
				Use In (lcCursor)
			Endif
		Endif

		Return lnSucces

	Endfunc && oFunction2Value
	******************************************* 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 = m.tcSql
		lcCursor = Sys(2015)

		lnSucces = This.oExecute(GetHash('cSql=>' + m.lcSql + '??cCursor=>' + m.lcCursor))

		If m.lnSucces = CT_SUCCES
			If Reccount(lcCursor) > 1
				goApp.ProcessError(GetHash("cUserMessage=>Au rezultat mai multe valori. Se astepta o singura valoare."))
				lnSucces = CT_INSUCES
			Else
				lcField = lcCursor + '.' + Field(1)
				tuRetValue = Evaluate(lcField)
			Endif
			Use In (SELECT(m.lcCursor))
		Endif

		Select (m.lcSelect)
		Return lnSucces
	Endfunc &&oSelect2Value
	******************************************* SFARSIT: oFunction2Value *******************************************

	******************************************* 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)
			This.lApplicationError = .T.

			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 = ''
	cConnectionString = ''
	nHandle = 0
	cEroare = ''
	Declare aEroare[7]
	lShowError = .F.
	lReconnect = .F. && Daca llReconnect = .T. se apeleaza InitSesiune din oInit_Optiuni.prg
	lError = .F.
	cErrorMessage = ''

	*** IsConnected ===========================================================================================
	Function IsConnected
		Local llConnected
		llConnected = This.nHandle > 0
		Return llConnected
	Endfunc && IsConnected

	*** GetHandle ===========================================================================================
	Function GetHandle
		Return This.nHandle
	Endfunc && GetHandle

	*** 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, lcConnectionString
		Local loEx As Exception

		If Pcount() < 3 Or Type('tcHost') # 'C' Or Type('tcUser') # 'C' Or Type('tcPassword') # 'C'
			This.cHost = goApp.oSettings.GetValue("HOST")
			This.cUser = goApp.oSettings.GetValue("USER")
			This.cPassword = goApp.oSettings.GetValue("PASSWORD")
			This.cConnectionString = goApp.oSettings.GetValue("CONNECTIONSTRING")
		Else
			This.cHost = tcHost
			This.cUser = tcUser
			This.cPassword = tcPassword
		Endif

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

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

		SQLSetprop(0,"DispLogin",3)
		If Empty(m.lcConnectionString)
			lcString="dsn="+Alltrim(lcHost)+";Uid="+Alltrim(lcUser)+";Pwd="+Alltrim(lcPassword)+";"
		Else
			lcString = m.lcConnectionString
		Endif
		lcString = Textmerge(m.lcString)

		If !This.IsConnected()
			Try
				This.nHandle = Sqlstringconnect(lcString)
			Catch To loEx
				This.nHandle = -1
				This.ProcessError(loEx.ErrorNo, loEx.Procedure, loEx.Lineno)
			Endtry
			goApp.Log("Conectare, Handle = " + Alltrim(Transform(This.nHandle)))
		Endif

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

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

		If This.IsConnected()
			lnSucces = CT_SUCCES

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

			*!*				IF llReconnect
			*!*					lnSucces = InitSesiune() && IN oInit_Optiuni.prg
			*!*				ENDIF
		Else
			lnSucces = CT_INSUCCES
			This.ProcessError()
		Endif

		Return lnSucces

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

	*** Disconnect ===========================================================================================
	Procedure Disconnect

		Local loEx As Exception, lnSucces, lnHandle, llException
		lnSucces = CT_SUCCES
		llException = .F.

		If This.IsConnected()
			lnHandle = This.GetHandle()
			*!*				TRY
			lnSucces = SQLDisconnect(lnHandle)
			lnSucces = Iif(lnSucces > 0, CT_SUCCES, CT_INSUCCES)
			*!*				CATCH TO loEx
			*!*					lnSucces = CT_INSUCCES
			*!*					llException = .T.
			*!*					THIS.ProcessError(loEx.ERRORNO, loEx.PROCEDURE, loEx.LINENO)
			*!*				ENDTRY

			If lnSucces = CT_INSUCCES
				&& daca am prins exceptia s-a inregistrat deja eroarea
				If !llException
					This.ProcessError()
				Endif
			Else
				This.nHandle = -1

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

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

		If lnSucces > 0
			goApp.Log("Deconectare, Handle = " + Alltrim(Transform(m.lnHandle)))
		Endif

		Return Iif(lnSucces > 0, CT_SUCCES, CT_INSUCCES)

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

	*!*=================================================================
	Procedure Destroy
		This.Disconnect()
	Endproc && DESTROY

	*!*=================================================================
	Procedure Error(nError,cMethod,nLine)
		This.ProcessError(nError,cMethod,nLine)
	Endproc && ERROR

	*** ProcessError ===========================================================================================
	Procedure ProcessError
		Lparameters nError,cMethod,nLine


		Local loHash
		loHash = GetHash()
		If Pcount() = 3
			loHash.SetValue("nError", nError)
			loHash.SetValue("cMethod", cMethod)
			loHash.SetValue("nLine", nLine)
		Endif

		If Type('goApp') = 'O'
			goApp.ProcessError(loHash)

			This.cErrorMessage = goApp.GetError()
			This.lError = goApp.HasError()
		Endif

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

	*** postConn ===========================================================================================
	Procedure postConn
		*** PUNCT ZECIMAL
		Local lcSql, loHash, lnSucces
		lnSucces = CT_SUCCES
		If goApp.oSettings.GetValue("database") = 'ORACLE'
			lcSql=[ALTER SESSION SET NLS_NUMERIC_CHARACTERS = ".,"]
			loHash= GetHash("cSql=>" + lcSql)
			lnSucces = goExecutor.oExecute(loHash)
		Endif
		Return lnSucces

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


Enddefine && oConn
*** END oConn ===========================================================================================

* ===================== 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


Define Class MyHash As Collection

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

		Local i, lnProperties, lcPropertyValue, lcValue, luValue
		Local lnPos
		Declare laLinii[1]

		&& tcPropertyValueList = [cselect =>ala bala portocala??cfiltru=>un filtru - atentie la spatiile din stanga valorii]
		If Type('tcPropertyValueList') = 'C' And !Empty(tcPropertyValueList)

			lnProperties = Alines(laLinii,tcPropertyValueList,4,'??')
			For i = 1 To lnProperties
				lcPropertyValue = Alltrim(laLinii[i])
				lnPos = At('=>', lcPropertyValue)
				If lnPos > 0
					lcProperty = Left(lcPropertyValue,lnPos - 1)
					lcValue =  Substr(lcPropertyValue, lnPos + 2)
					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

		Local loC As Collection
		loC = This

		If Type('loc(tcProperty)') <> 'U'
			loC(tcProperty) = tuValue
		Else
			loC.Add(tuValue, tcProperty)
		Endif

		Return loC(tcProperty)

	Endproc && SetValue

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

		Local luValue
		Local loC As Collection
		loC = This

		If Type('loC(tcProperty)') <> 'U'
			luValue = loC(tcProperty)
		Else
			luValue = loC.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 llReturn
		Local loC As Collection
		loC = This
		llReturn = .F.

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

		Return llReturn

	Endfunc && HasProperty

Enddefine
* ===================== MyHash ====================================
* OBIECT EMULARE HASH
* loHash = GetHash([cselect=>select id, name from test??cwhere=>id=pnId??corder=>name])
* ==================================================================
Define Class MyHashOld 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
		Local lnPos
		Declare laLinii[1]

		&& 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(lcPropertyValue, 1, '=>')
			*!*						lcValue =  GETWORDNUM(lcPropertyValue, 2, '=>')
			*!*						luValue = THIS.GetDefaultValue(lcProperty, lcValue)
			*!*						THIS.SetValue(lcProperty, luValue)
			*!*					ENDIF
			*!*				ENDFOR
			lnProperties = Alines(laLinii,tcPropertyValueList,4,'??')
			For i = 1 To lnProperties
				lcPropertyValue = Alltrim(laLinii[i])
				lnPos = At('=>', lcPropertyValue)
				If lnPos > 0
					lcProperty = Left(lcPropertyValue,lnPos - 1)
					lcValue =  Substr(lcPropertyValue, lnPos + 2)
					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 AMESSAGEBOX
	Lparameters tcMessage, tnDialogBoxType, tcTitle, tcFont, tnTimeOut ,tnTimeoutValue

	Local loMessage, lnReturn, lcMessageboxForm

	*!*		*!* 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('tnDialogBoxType') # 'N'
		tnDialogBoxType = 0
	Endif

	If Type('tcTitle') # 'C'
		tcTitle = ''
	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.Show(1)
		lnReturn = loMessage.IDOpcion
	Endif


	Return lnReturn

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


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



***---------------------------------------------------------------------
Procedure OPEN_DEFAULT_APP
	Parameters tcfilename

	Declare Integer ShellExecute In shell32.Dll ;
		INTEGER hndWin, ;
		STRING cAction, ;
		STRING cFileName, ;
		STRING cParams, ;
		STRING cDir, ;
		INTEGER nShowWin
	cFileName = tcfilename
	cAction = "open"
	ShellExecute(0,cAction,cFileName,"","",1)

Endproc && OPEN_DEFAULT_APP



Procedure BringWindowTop
	Local lnHwnd

	#Define GW_CHILD                5 && 0x00000005
	#Define GW_HWNDNEXT                2 && 0x00000002
	#Define SW_MAXIMIZE                3 && 0x00000003
	#Define SW_NORMAL                1 && 0x00000002
	#Define WAIT_OBJECT_0            0 && 0x00000000

	Declare Integer CloseHandle In Kernel32 Integer hObject
	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

	lnHwnd = GetWindow(GetDesktopWindow(), GW_CHILD)
	BringWindowToTop(lnHwnd)

	CloseHandle(lnHwnd)

	Clear Dlls "BringWindowToTop", "GetDesktopWindow", "GetWindow", "CloseHandle"
Endproc



*!*===============================================================
Procedure newguid
	Local lcPK,lcBuffer,i,lnHex,lnUpper,lnLower
	*!*	DECLARE INTEGER CoCreateGuid IN OLE32.DLL STRING @lcBuffer
	lcBuffer=Space(17)
	lcPK=Space(0)
	If CoCreateGuid(@lcBuffer) = 0
		For i=1 To 16
			lnHex=Asc(Substr(lcBuffer,i,1))
			lnUpper=Int(lnHex/16)
			lnLower=lnHex-(lnUpper*16)
			lcPK=lcPK+Substr('0123456789ABCDEF',lnUpper+1,1)+;
				SUBSTR('0123456789ABCDEF',lnLower+1,1)
		Endfor
	Endif
	Return lcPK
Endproc

*!*===============================================================
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

Function setini
	Parameter pcinifile, pcsection,  ;
		pcvar, pcval
	Private lasect
	Private lavars
	Private All Like j*
	Dimension lasect[1], lavars[ 1,3]
	jlsuccess = .T.
	If  .Not. Empty(pcinifile)
		jcfilename = Iif(At('.',  ;
			pcinifile) > 0,  ;
			pcinifile,  ;
			pcinifile +  ;
			'.INI')
		pcsection = Alltrim(pcsection)
		pcvar = Alltrim(pcvar)
		pcval = Alltrim(pcval)
		If File(jcfilename)
			jnhandle = Fopen(jcfilename,  ;
				2)
			If jnhandle < 0
				jlsuccess = .F.
				= Messagebox( ;
					'Unable to open file: ' +  ;
					jcfilename, ;
					'File Open Error', ;
					0)
				Return jlsuccess
			Endif
		Else
			jnhandle = -1
		Endif
		= buildarray(jnhandle, ;
			@lasect,@lavars)
		If jnhandle > -1
			= Fclose(jnhandle)
		Endif
		jsuccess = buildini(jcfilename, ;
			pcsection,pcvar, ;
			pcval,@lasect, ;
			@lavars)
	Else
		jlsuccess = .F.
	Endif
	Return jlsuccess
Endfunc && setini
*!*
Function buildini
	Parameter pcfilename, pcsection,  ;
		pcvar, pcval, pasect,  ;
		pavars
	Private All Like j*
	jlsuccess = .T.
	jnfhandle = 0
	jlfoundvar = .F.
	jnfound = 0
	If  .Not. Empty(pasect)
		For jncount = 1 To  ;
				ALEN(pasect, 1)
			If Upper(pasect(jncount)) ==  ;
					UPPER(pcsection)
				jnfound = jncount
				Exit
			Endif
		Endfor
	Endif
	If jnfound > 0
		For jncount = 1 To  ;
				ALEN(pavars, 1)
			If pavars(jncount,1) ==  ;
					pcvar .And.  ;
					pavars(jncount,3) ==  ;
					jnfound
				pavars[ jncount,  ;
                     2] = pcval
				jlfoundvar = .T.
				Exit
			Endif
		Endfor
		If  .Not. jlfoundvar
			If  .Not.  ;
					EMPTY(pavars(1))
				jnlen2 = Alen(pavars,  ;
					1) + 1
				Dimension pavars[  ;
                         jnlen2,  ;
                         3]
			Else
				jnlen2 = 1
			Endif
			pavars[ jnlen2, 1] =  ;
				pcvar
			pavars[ jnlen2, 2] =  ;
				pcval
			pavars[ jnlen2, 3] =  ;
				jnfound
		Endif
	Else
		If  .Not. Empty(pasect(1))
			jnlen = Alen(pasect, 1) +  ;
				1
			Dimension pasect[  ;
                    jnlen]
		Else
			jnlen = 1
		Endif
		pasect[ jnlen] = pcsection
		If  .Not. Empty(pavars(1))
			jnlen2 = Alen(pavars,  ;
				1) + 1
			Dimension pavars[  ;
                    jnlen2, 3]
		Else
			jnlen2 = 1
		Endif
		pavars[ jnlen2, 1] = pcvar
		pavars[ jnlen2, 2] = pcval
		pavars[ jnlen2, 3] = jnlen
	Endif
	If File(pcfilename)
		jcoldfile = Substr(pcfilename,  ;
			1, At('.',  ;
			pcfilename) - 1) +  ;
			'.BAK'
		If File(jcoldfile)
			Delete File (jcoldfile)
		Endif
		Rename (pcfilename) To  ;
			(jcoldfile)
	Endif
	jnfhandle = Fcreate(pcfilename)
	If  .Not. jnfhandle == -1 .And.   ;
			.Not. Empty(pasect)
		For ncount = 1 To  ;
				ALEN(pasect, 1)
			If (';' $  ;
					pasect(ncount)) .Or.  ;
					EMPTY(pasect(ncount))
				= Fputs(jnfhandle,  ;
					pasect(ncount))
			Else
				= Fputs(jnfhandle,  ;
					'[' +  ;
					pasect(ncount) +  ;
					']')
			Endif
			For ncount2 = 1 To  ;
					ALEN(pavars, 1)
				If pavars(ncount2, ;
						3) == ncount
					= Fputs(jnfhandle,  ;
						pavars(ncount2, ;
						1) + ' = ' +  ;
						pavars(ncount2, ;
						2))
				Endif
			Endfor
		Endfor
		= Fclose(jnfhandle)
	Else
		= Messagebox( ;
			'Unable to create file: ' +  ;
			jcfilename, ;
			'File create error',0)
		jlsuccess = .F.
	Endif
	Return jlsuccess
Endfunc && buildini
*!*
Function buildarray
	Parameter pnfhandle, pasect,  ;
		pavars
	Private All Like j*
	jnalen = 1
	jnvarlen = 1
	If pnfhandle > -1
		= Fseek(pnfhandle, 0)
		Do While  .Not.  ;
				FEOF(pnfhandle)
			jcline = Fgets(pnfhandle)
			If ';' $ jcline .Or.  ;
					EMPTY(jcline)
				If Empty(pasect(1))
					pasect[ 1] =  ;
						jcline
				Else
					jnalen = Alen(pasect,  ;
						1) +  ;
						1
					Dimension pasect[  ;
                              jnalen]
					pasect[  ;
                          jnalen] =  ;
						jcline
				Endif
			Else
				jnfound1 = At('[', jcline)
				jnfound2 = At(']', jcline)
				If jnfound1 > 0 .And. jnfound2 > 0
					jcsection = Substr(jcline,  ;
						jnfound1 +  ;
						1,  ;
						jnfound2 -  ;
						2)
					If Empty(pasect(1))
						pasect[  ;
                               1] =  ;
							jcsection
					Else
						jnalen =  ;
							ALEN(pasect,  ;
							1) + 1
						Dimension  ;
							pasect[  ;
                          jnalen]
						pasect[  ;
                               jnalen] =  ;
							jcsection
					Endif
					jnalen = Alen(pasect,  ;
						1)
				Else
					If At('=',  ;
							jcline) >  ;
							0
						If Empty(pavars(1, ;
								1))
							pavars[  ;
                               1,  ;
                               1] =  ;
								ALLTRIM(Substr(jcline,  ;
								1,  ;
								AT( ;
								'=',  ;
								jcline) -  ;
								1))
							pavars[  ;
                               1,  ;
                               2] =  ;
								ALLTRIM(Substr(jcline,  ;
								AT( ;
								'=',  ;
								jcline) +  ;
								1))
							pavars[  ;
                               1,  ;
                               3] =  ;
								jnalen
						Else
							jnvarlen =  ;
								ALEN(pavars,  ;
								1) +  ;
								1
							Dimension  ;
								pavars[  ;
                               jnvarlen,  ;
                               3]
							pavars[  ;
                               jnvarlen,  ;
                               1] =  ;
								ALLTRIM(Substr(jcline,  ;
								1,  ;
								AT( ;
								'=',  ;
								jcline) -  ;
								1))
							pavars[  ;
                               jnvarlen,  ;
                               2] =  ;
								ALLTRIM(Substr(jcline,  ;
								AT( ;
								'=',  ;
								jcline) +  ;
								1))
							pavars[  ;
                               jnvarlen,  ;
                               3] =  ;
								jnalen
						Endif
					Endif
				Endif
			Endif
		Enddo
	Endif
	Return .T.
Endfunc && buildarray
*!*
Function getini
	Parameter pcinifile, pcsection,  ;
		pcvar
	Private All Like j*
	jcretval = ''
	If  .Not. Empty(pcinifile)
		jcfilename = Iif(At('.',  ;
			pcinifile) > 0,  ;
			pcinifile,  ;
			pcinifile +  ;
			'.INI')
		If File(jcfilename)
			jnhandle = Fopen(jcfilename)
			If jnhandle < 0
				jlsuccess = .F.
				= Messagebox( ;
					'Unable to open file: ' +  ;
					jcfilename, ;
					'File Open Error', ;
					0)
			Else
				pcsection = Alltrim(Upper(pcsection))
				pcvar = Alltrim(Upper(pcvar))
				jcretval = readini(@jnhandle, ;
					pcsection, ;
					pcvar)
				= Fclose(jnhandle)
			Endif
		Endif
	Endif
	Return jcretval
Endfunc && getini
*!*
Function readini
	Parameter pnfhandle, pcsection,  ;
		pcvar
	Private All Like j*
	jcline = ''
	jcsection = ''
	jnfound1 = 0
	jnfound2 = 0
	jnfound3 = 0
	jnalen = 0
	jcretval = ''
	If  .Not. Empty(pnfhandle)
		= Fseek(pnfhandle, 0)
		Do While  .Not.  ;
				FEOF(pnfhandle)
			jcline = Fgets(pnfhandle)
			jnfound1 = At('[',  ;
				jcline)
			jnfound2 = At(']',  ;
				jcline)
			If jnfound1 > 0 .And.  ;
					jnfound2 > 0
				jcsection = Upper(Substr(jcline,  ;
					jnfound1 +  ;
					1,  ;
					jnfound2 -  ;
					2))
			Endif
			If jcsection ==  ;
					pcsection
				jnfound3 = At('=',  ;
					jcline)
				If jnfound3 > 0
					If Alltrim(Upper(Substr(jcline,  ;
							1,  ;
							jnfound3 -  ;
							1))) ==  ;
							pcvar
						jcretval =  ;
							ALLTRIM(Substr(jcline,  ;
							jnfound3 +  ;
							1))
						Exit
					Endif
				Endif
			Endif
		Enddo
	Endif
	Return jcretval
Endfunc && readini


* 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

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

	m.NSELECT = Bar()

	Deactivate Popup ( m.CPOPMENU )

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

	*** COPIERE SHALLOW - proprietatile care contin referinte la alte obiecte pastreaza aceleasi referinte
	*** EX1: loDestinationObject = CopyObject(loSourceObject) -> creeaza un obiect nou si copie proprietatile din loSourceObject
	*** EX2: CopyObject(loSourceObject, @loDestinationObject) -> adauga/copiaza proprietatile din loSourceObject in loDestinationObject (obiect nou sau existent)
Function CopyObject
	Lparameters toObject, toNewObject
	Local  laProps[1], lnI, lcPropName, loEx As Exception
	* For Empty class only
	If Type("toObject") <> "O"
		toNewObject = Null
		Return Null
	Endif

	If Type('toNewObject') <> 'O'
		If Type('toObject.Class')='C' And Type('toObject.ClassLibrary')='C'
			toNewObject = Newobject(toObject.Class,toObject.ClassLibrary)
		Else
			toNewObject = Createobject("Empty")
		Endif
	Endif


	For lnI=1 To Amembers(laProps, toObject, 0)
		lcPropName = Lower(laProps[lnI])
		* Pre VFP9
		*IF TYPE([ALEN( toObject.&lcPropName)]) = "N"
		If Type([toObject.] + lcPropName,1) = "A"
			* Array
			If !Pemstatus(toNewObject, lcPropName, 5) && If the property does not exist
				AddProperty(toNewObject, lcPropName + "[1]", Null )
			Endif
			= Acopy(toObject.&lcPropName, toNewObject.&lcPropName)
		Else
			If !Pemstatus(toNewObject, lcPropName, 5) && If the property does not exist
				AddProperty(toNewObject, lcPropName, Evaluate("toObject." + lcPropName) )
			Else
				Try
					toNewObject.&lcPropName = Evaluate("toObject." + lcPropName)
				Catch && TO loEx WHEN loEx.ErrorNo = 1743 && PROPERTY IS READONLY - NU FAC NIMIC
					*
				Endtry
			Endif
		Endif
	Endfor

	Return toNewObject
Endfunc && CopyObject


Procedure MakeDirectoryStructure
	Lparameters tcDirector

	Local lnDirectoare, lcSubDirector, lcSubdirectorLocal, i

	lnDirectoare = Getwordcount(Justpath(m.tcDirector), "\")
	lcSubdirectorLocal = ""
	For i = 1 To lnDirectoare
		lcSubDirector = Getwordnum(Justpath(m.tcDirector), i, "\")
		lcSubdirectorLocal = m.lcSubdirectorLocal + m.lcSubDirector + "\"
		If !Directory(m.lcSubdirectorLocal)
			Md(m.lcSubdirectorLocal)
		Endif
	Endfor

Endproc && MakeDirectoryStructure
*
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
*
*
* Copiata din D:\ROA\ROACONT\COMUN\programe\oproceduri_comune.prg (GetNrFromString),
* ca sa nu duplic logica: taie de la inceputul sirului literele si separatorii,
* pana la prima cifra. Ex. 'RO 15613488' -> '15613488', 'CUI 14770212' -> '14770212'.
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 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
* 
* Intoarce un cod fiscal fara atributul de tara. sterge literele si alte caractere nonnumerice
* RO 1879855 -> 1879855
FUNCTION GetCodFiscalFRO
	LPARAMETERS tcCF
	
	lcCodFiscalFRO = ALLTRIM(CHRTRAN(ALLTRIM(UPPER(TRANSFORM(m.tcCF))), "ABCDEFGHIJKLMNOPQRSTUVWXYZ -./()", ""))
	
	RETURN m.lcCodFiscalFRO
ENDFUNC 
*
* Clasifica partenerul importat (Fidelio hotel, BIZ restaurant) in persoana fizica / juridica
* si curata DOAR CNP-urile invalide.
*
* De ce asa:
*   - la declaratii (D394/D406) o PERSOANA FIZICA poate fi raportata FARA CNP, deci un CNP
*     invalid se poate goli fara sa pierdem nimic si fara sa dea eroare de validare;
*   - o PERSOANA JURIDICA trebuie sa aiba cod fiscal, deci codul ei NU se sterge niciodata:
*     daca e gresit, ramane asa ca sa fie semnalat la validarea declaratiei si sa fie corectat
*     la sursa (in Fidelio), nu ascuns aici.
*
* De ce NU ne putem baza pe validarea romaneasca ca sa decidem tipul:
*   codurile straine pot fi si numai cifre (fara prefix de tara), deci un cod numeric care nu
*   trece algoritmul romanesc NU inseamna automat "gresit". Tipul se decide din alte semnale,
*   in ordinea increderii:
*     1. tcTipCunoscut - tip venit din import, daca sistemul sursa il stie (cel mai sigur)
*     2. prefix de tara pe cod (RO/BE/DE...) sau litere in cod   => persoana juridica
*     3. denumire cu forma juridica (SRL, SA, PFA, ASOCIATIA...) => persoana juridica
*     4. numar de registrul comertului in tcRegCom (J40/1234/2018, L2019...) => juridica
*        serie+numar de CI (2 litere + 6 cifre) => fizica
*     5. CNP valid pe 13 cifre => fizica; CUI romanesc valid => juridica
*     6. altfel => fizica (majoritatea covarsitoare a clientilor de hotel)
*
* Parametri:
*   tcCod          - codul brut din import (CODFISCAL_CNP)
*   tnTipPersoana  - IESIRE prin referinta: 1 = juridica, 2 = fizica
*   tcDenumire     - optional, denumirea partenerului (pentru forma juridica)
*   tcRegCom       - optional, REGCOMERT_CI_PASS (nr. registrul comertului sau serie CI)
*   tcCodTara      - optional, codul/denumirea tarii daca importul o stie
*   tcTipCunoscut  - optional, tipul deja stiut din import: '1'/'PJ' sau '2'/'PF'
*
* Intoarce: codul de pastrat in ROA. Sir GOL doar cand este persoana fizica cu CNP invalid.
FUNCTION GetCodFiscalValid
	LPARAMETERS tcCod, tnTipPersoana, tcDenumire, tcRegCom, tcCodTara, tcTipCunoscut

	LOCAL lcCod, lcBrut, lcCifre, lcCifreReg, lcPrefix, lcPrefixBrut, lcTara, lcTip
	LOCAL llLitere, llPrefixFiscal, lnParam
	lnParam = PCOUNT()

	lcCod = GetCodFiscalCurat(m.tcCod)
	lcCifre = CHRTRAN(m.lcCod, CHRTRAN(m.lcCod, '0123456789', ''), '')
	lcPrefix = ALLTRIM(CHRTRAN(m.lcCod, CHRTRAN(m.lcCod, 'ABCDEFGHIJKLMNOPQRSTUVWXYZ', ''), ''))
	llLitere = !EMPTY(m.lcPrefix)

	* Eticheta din codul BRUT ('CUI 14770212') e semnal de persoana juridica, chiar daca
	* GetCodFiscalCurat o scoate din codul salvat. 'RO' se pastreaza in cod pentru ca inseamna
	* platitor de TVA, iar in ROA acela e alt partener decat neplatitorul cu acelasi numar.
	lcBrut = ALLTRIM(UPPER(TRANSFORM(NVL(m.tcCod, ''))))
	lcPrefixBrut = ALLTRIM(CHRTRAN(m.lcBrut, CHRTRAN(m.lcBrut, 'ABCDEFGHIJKLMNOPQRSTUVWXYZ', ''), ''))
	llPrefixFiscal = INLIST(m.lcPrefixBrut, 'RO', 'CUI', 'CF', 'CIF')

	lcTara = IIF(m.lnParam > 4 AND VARTYPE(m.tcCodTara) = 'C', ALLTRIM(UPPER(m.tcCodTara)), '')
	lcTip = IIF(m.lnParam > 5 AND VARTYPE(m.tcTipCunoscut) = 'C', ALLTRIM(UPPER(m.tcTipCunoscut)), '')

	DO CASE
		CASE INLIST(m.lcTip, '1', 'PJ', 'J')
			tnTipPersoana = 1
		CASE INLIST(m.lcTip, '2', 'PF', 'F')
			tnTipPersoana = 2
		CASE m.llPrefixFiscal
			* eticheta romaneasca de cod fiscal (RO/CUI/CF/CIF) => persoana juridica
			tnTipPersoana = 1
		CASE !EMPTY(m.lcTara) AND !INLIST(m.lcTara, 'RO', 'ROU', 'ROMANIA')
			* tara straina declarata: nu putem valida romaneste, tratam ca juridica
			tnTipPersoana = 1
		CASE EstePersoanaJuridica(m.tcDenumire)
			tnTipPersoana = 1
		CASE EsteNrRegComert(m.tcRegCom)
			tnTipPersoana = 1
		CASE LEN(m.lcCifre) = 13 AND cValidCNP(m.lcCifre)
			tnTipPersoana = 2
		CASE EsteSerieCI(m.tcRegCom)
			tnTipPersoana = 2
		CASE m.llLitere
			* cod cu litere fara alt semnal: TVA intracomunitar (BE0325777171) daca incepe cu
			* un cod de tara UE, altfel e cel mai probabil pasaport de persoana fizica
			tnTipPersoana = IIF(EsteCodTVAStrain(m.lcCod), 1, 2)
		CASE BETWEEN(LEN(m.lcCifre), 2, 10) AND VerifCF(m.lcCifre)
			tnTipPersoana = 1
		OTHERWISE
			* clientii de hotel sunt in marea lor majoritate persoane fizice
			tnTipPersoana = 2
	ENDCASE

	IF m.tnTipPersoana = 1
		* persoana juridica: codul NU se sterge niciodata, chiar daca nu trece validarea.
		* Vrem sa fim atentionati la declaratie, nu sa ascundem problema.
		RETURN m.lcCod
	ENDIF

	* persoana fizica: pastram CNP-ul doar daca este valid, altfel gol (permis la declaratii).
	* Pasapoartele si seriile de CI nu sunt CNP-uri, deci nu se salveaza pe cod fiscal.
	IF LEN(m.lcCifre) = 13 AND cValidCNP(m.lcCifre)
		RETURN m.lcCifre
	ENDIF

	* recuperare: in Fidelio se intampla ca operatorul sa inverseze campurile si sa scrie CNP-ul
	* in 'serie CI / pasaport'. Daca acolo gasim un CNP valid, il folosim pe acela.
	lcCifreReg = GetCodFiscalCurat(m.tcRegCom)
	lcCifreReg = CHRTRAN(m.lcCifreReg, CHRTRAN(m.lcCifreReg, '0123456789', ''), '')
	IF LEN(m.lcCifreReg) = 13 AND cValidCNP(m.lcCifreReg)
		RETURN m.lcCifreReg
	ENDIF

	RETURN ''
ENDFUNC
*
* .T. daca sirul arata a cod de TVA intracomunitar: 2 litere = cod de tara UE, urmate de cifre.
* Ex: 'BE0325777171', 'DE811234567', 'HU12345678'. NU include 'RO' (tratat separat).
FUNCTION EsteCodTVAStrain
	LPARAMETERS tcCod

	LOCAL lcCod, lcTari, lcTara, lcRest
	lcCod = ALLTRIM(UPPER(TRANSFORM(NVL(m.tcCod, ''))))
	lcCod = CHRTRAN(m.lcCod, ' .-', '')
	IF LEN(m.lcCod) < 6
		RETURN .F.
	ENDIF

	* coduri de tara UE + cateva uzuale in turism
	lcTari = ' AT BE BG CY CZ DE DK EE EL ES FI FR GR HR HU IE IT LT LU LV MT NL PL PT SE SI SK ' + ;
		' GB CH NO MD UA RS TR US '

	lcTara = LEFT(m.lcCod, 2)
	IF !(' ' + m.lcTara + ' ' $ m.lcTari)
		RETURN .F.
	ENDIF

	* dupa codul de tara trebuie sa urmeze numai cifre
	lcRest = SUBSTR(m.lcCod, 3)
	RETURN LEN(CHRTRAN(m.lcRest, CHRTRAN(m.lcRest, '0123456789', ''), '')) = LEN(m.lcRest)
ENDFUNC
*
* Curata un cod fiscal / CNP de spatii, puncte si separatori redundanti, pastrand literele
* semnificative.
*   'RO 23565004'    -> 'RO23565004'
*   'CUI 14770212'   -> '14770212'
*   '2920121295914.' -> '2920121295914'
*
* ATENTIE: prefixul 'RO' NU se adauga niciodata de la noi. In ROA, 'RO12345678' (platitor de
* TVA) si '12345678' (neplatitor) sunt DOI parteneri diferiti, deci prefixul se pastreaza
* exact cum a venit din import. Etichetele 'CUI'/'CF'/'CIF' sunt doar text descriptiv, nu
* atribut fiscal, deci se sterg fara sa fie inlocuite cu 'RO'.
FUNCTION GetCodFiscalCurat
	LPARAMETERS tcCod

	LOCAL lcCod, lcCifre, lcPrefix
	lcCod = ALLTRIM(UPPER(TRANSFORM(NVL(m.tcCod, ''))))
	lcCod = CHRTRAN(m.lcCod, CHR(9) + CHR(13) + CHR(10), '   ')
	* scot spatiile si punctele; liniuta si slash-ul pot face parte din coduri straine
	lcCod = ALLTRIM(CHRTRAN(m.lcCod, ' .', ''))

	* 'CUI 14770212' -> '14770212': eticheta nu spune nimic despre calitatea de platitor de TVA
	lcPrefix = ALLTRIM(CHRTRAN(m.lcCod, CHRTRAN(m.lcCod, 'ABCDEFGHIJKLMNOPQRSTUVWXYZ', ''), ''))
	IF INLIST(m.lcPrefix, 'CUI', 'CF', 'CIF')
		lcCifre = CHRTRAN(m.lcCod, CHRTRAN(m.lcCod, '0123456789', ''), '')
		IF !EMPTY(m.lcCifre)
			lcCod = m.lcCifre
		ENDIF
	ENDIF

	RETURN m.lcCod
ENDFUNC
*
* .T. daca denumirea contine o forma juridica (SRL, SA, PFA, ASOCIATIA, LTD, GMBH...).
* Compara pe cuvinte intregi, ca sa nu ia 'SA' din 'SAVU' sau 'II' din 'MIHAII'.
FUNCTION EstePersoanaJuridica
	LPARAMETERS tcDenumire

	LOCAL lcDen, lcForme, lcCuv, lnI, lnCuvinte
	lcDen = ALLTRIM(UPPER(TRANSFORM(NVL(m.tcDenumire, ''))))
	IF EMPTY(m.lcDen)
		RETURN .F.
	ENDIF

	* separatorii devin spatii, ca sa pot compara cuvant cu cuvant
	lcDen = CHRTRAN(m.lcDen, '.,-/()"' + CHR(9), '        ')

	lcForme = ' SRL SA SC SNC SCS SCA PFA II IF SRLD RA RL ' + ;
		' ASOCIATIA ASOCIATIE FUNDATIA FUNDATIE SOCIETATEA COOPERATIVA CABINET ' + ;
		' PRIMARIA MINISTERUL AGENTIA INSTITUTUL SPITALUL SCOALA LICEUL COLEGIUL ' + ;
		' UNIVERSITATEA UNIVERSITE UNIVERSITY UNIVERSITAT INSPECTORATUL DIRECTIA ' + ;
		' LTD LIMITED GMBH AG BV NV INC LLC PLC CORP CORPORATION COMPANY HOLDING KFT SPZOO OOD '

	lnCuvinte = GETWORDCOUNT(m.lcDen, ' ')
	FOR lnI = 1 TO m.lnCuvinte
		lcCuv = ALLTRIM(GETWORDNUM(m.lcDen, m.lnI, ' '))
		IF !EMPTY(m.lcCuv) AND (' ' + m.lcCuv + ' ') $ m.lcForme
			RETURN .T.
		ENDIF
	ENDFOR

	RETURN .F.
ENDFUNC
*
* .T. daca sirul arata a numar de inregistrare la Registrul Comertului.
* Forme acceptate: 'J40/1234/2018', 'F13/45/2005', 'C23/9/2019', 'L2019000159348', '54/1997'
FUNCTION EsteNrRegComert
	LPARAMETERS tcRegCom

	LOCAL lcReg, lcRest
	lcReg = ALLTRIM(UPPER(TRANSFORM(NVL(m.tcRegCom, ''))))
	lcReg = CHRTRAN(m.lcReg, ' ', '')
	IF EMPTY(m.lcReg)
		RETURN .F.
	ENDIF

	* J40/1234/2018 - litera + cifre + doua slash-uri
	IF INLIST(LEFT(m.lcReg, 1), 'J', 'F', 'C') AND OCCURS('/', m.lcReg) = 2 AND ;
			ISDIGIT(SUBSTR(m.lcReg, 2, 1))
		RETURN .T.
	ENDIF

	* L2019000159348 / J2018000211289 - litera urmata de minim 10 cifre
	IF INLIST(LEFT(m.lcReg, 1), 'J', 'L') AND LEN(m.lcReg) >= 11
		lcRest = SUBSTR(m.lcReg, 2)
		IF ISDIGIT(m.lcRest) AND LEN(CHRTRAN(m.lcRest, CHRTRAN(m.lcRest, '0123456789', ''), '')) = LEN(m.lcRest)
			RETURN .T.
		ENDIF
	ENDIF

	* 54/1997 - numar/an, tipic institutiilor publice
	IF OCCURS('/', m.lcReg) = 1 AND LEN(m.lcReg) <= 8 AND ;
			ISDIGIT(m.lcReg) AND LEN(GETWORDNUM(m.lcReg, 2, '/')) = 4
		RETURN .T.
	ENDIF

	RETURN .F.
ENDFUNC
*
* .T. daca sirul arata a serie + numar de carte de identitate: 2 litere urmate de 6 cifre.
* Ex: 'ZV 093375', 'IF834409', 'RK 340434'
FUNCTION EsteSerieCI
	LPARAMETERS tcRegCom

	LOCAL lcReg
	lcReg = ALLTRIM(UPPER(TRANSFORM(NVL(m.tcRegCom, ''))))
	lcReg = CHRTRAN(m.lcReg, ' -.', '')
	IF LEN(m.lcReg) <> 8
		RETURN .F.
	ENDIF

	RETURN ISALPHA(LEFT(m.lcReg, 1)) AND ISALPHA(SUBSTR(m.lcReg, 2, 1)) AND ;
		ISDIGIT(SUBSTR(m.lcReg, 3, 1)) AND ;
		LEN(CHRTRAN(SUBSTR(m.lcReg, 3), CHRTRAN(SUBSTR(m.lcReg, 3), '0123456789', ''), '')) = 6
ENDFUNC
*