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

	cEroare = []		&& de la tasks

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


	* 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


		&& 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.)
		If .F.
			Local This As oexecutor
		Endif
		This.Oreset()

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

		Local lnTip
		lnTip = 0

		If Empty(tcSql)
			lcSql = Upper(This.cSql)
		Else
			lcSql = Upper(tcSql)
		Endif

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

		If Empty(tnHandle)
			lnHandle = This.nHandle
		Else
			lnHandle = tnHandle
		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
			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

				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]
								If Type('goLog')='O'
									goLog.Log(lcTextEroare,Program())
								Endif
								If llShowError
									Messagebox(lcTextEroare,0,"Eroare")
								Endif
								If llQuitOnError
									Quit
									Retry
								Else
									Exit
								Endif

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

										Do While .T.
											lnRaspuns = Messagebox('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() + Chr(13) + Alltrim(Str(lnEroare1)) + ' ' + Chr(13) + Transform(laEroare[2]) + Chr(13) + Transform(laEroare[3]) + Chr(13) + lcSql
										If llShowError
											lnRaspuns = Messagebox('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(Str(lnEroare1)) + ' ' + Chr(13) + Transform(laEroare[2]) + Chr(13) + Transform(laEroare[3]) + Chr(13) + lcSql
			Endif

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

		Endif



		This.aEroare = laEroare
		This.nSucces = lnSucces
		This.cEroare = lcEroare

		Return lnSucces

	Endproc
	******************************************* SFARSIT: oExecute *******************************************



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


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

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

		If Pcount() < 4 Or Type('tcHost') # 'C' Or Type('tcUser') # 'C' ;
				OR Type('tcPassword') # 'C' Or Type('tcIdUtilizator') # 'C'
			*
		Else
			This.cHost = tcHost
			This.cUser = tcUser
			This.cPassword = tcPassword
			This.cIdUtilizator = tcIdUtilizator
		Endif

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

		If Pcount() < 5 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

		Return lnSucces

	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

			goLog.Log(lcTextEroare,Program())

			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

			Messagebox(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
			Messagebox(goExecutor.cEroare, 0 + 16,'Eroare')
		Endif

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


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

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

	&&preluare ora de pe oracle server:
	Store 0 To pnsucces
	pcexec = [select to_char(SYSdate,'dd/mm/yyyy hh:mi:ss AM') as dataora from dual]
	pcCursor = [dataora_cursor]
	pnsucces = goExecutor.oExecute(pcexec,pcCursor)
	If (pnsucces != 0)
		Select dataora_cursor
		lcRetVal = dataora_cursor.dataora
		Use In dataora_cursor
	Endif

	If lnTip = 1
		lcRetVal = Ctot(lcRetVal)
	Endif
	Return lcRetVal
Endproc
******************************************* SFARSIT: Get_Ora *******************************************

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

	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 GET_SCHEMA_GRID
	Lparameters toGrid, tcColumnList, tcHeaderList, tcSchema, tlSelect, tnType, tcFrom, tcWhere, tcOrder, tcOutputName

	Local lcSelect, llSelect, lcAlias, lcWhere, lcOrder, lcColumn, lcHeader
	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
				Adel(myArray,lnCol)
				Loop
			Endif
			lnPos = At('.',lcColumn)
			If 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),'_'),'.','_'),'/','_'),'\','_'),"&","_"),"%",""),"(","_"),")","_"),"-","_")
					*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 = Messagebox(lcMessage,lnDialogBoxType,lcTitleBarText,lnTimeOut)
	Else
		lnResponse = Messagebox(lcMessage,lnDialogBoxType,lcTitleBarText)
	Endif

	Return lnResponse

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

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

	Local loMessage, lnReturn
	loMessage = Newobject("messagebox_form", "MessageBox.vcx", "", tcMessage, tnDialogBoxType, tcTitle, tcFont, tnTimeOut ,tnTimeoutValue)
	loMessage.Show(1)
	lnReturn = loMessage.IDOpcion
	Return lnReturn

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

Procedure export_xls
	Lparameters tcAlias

	If Used(tcAlias)
		lcDir = Addbs(gcTempPath)

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


		Select (tcAlias)
		Export To (lcFile) Type Xl5

		OPEN_DEFAULT_APP(lcFile)

	Endif
Endproc && export_xls

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

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


*******************************************************************
* 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 = "Versiune necunoscuta."
				Endif
			Endif
		Else

			lcVersionText = "Versiune necunoscuta."

		Endif

	Else
		lcVersionText = "Versiune necunoscuta."
	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
***--------------------------------------------------------------------------------------
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
***-------------------------	CLASS oSysTray -------------------------


Define Class oSysTray As Custom
	oobjsystray = Null

	Procedure minimizeaza

		Local lcIcon
		lcIcon = [news1.ico]

		If _Screen.WindowState = 1
			This.oobjsystray= Newobject('systray')
			With This.oobjsystray
				.iconFile 	= lcIcon
				.TipText 	= [Tasks]
				IF WEXIST("frm_luc")
					frm_lucrare_noua.release()
				endif
				.AddIconToSystray()
				.icondblclickevent()
			Endwith
			_Screen.Hide()
		Endif
	Endproc

	Procedure clickDreapta

		Local lcIcon
		lcIcon = [news1.ico]
	
		If _Screen.WindowState = 1
			This.oobjsystray= Newobject('systray')
			With This.oobjsystray
				.iconFile 	= lcIcon
				.TipText 	= [Tasks]
				.iconrightclickevent()
			Endwith
			*			_Screen.Hide()
		Endif
	ENDPROC
	

	Procedure iconrightclickevent

		Local lcIcon
		lcIcon = [news1.ico]

		If _Screen.WindowState = 1
			This.oobjsystray= Newobject('systray')
			With This.oobjsystray
				.iconFile 	= lcIcon
				.TipText 	= [Tasks]
				.AddIconToSystray()
			Endwith
			Do meniu.mpr
			*			_Screen.Hide()
		Endif
	ENDPROC	

Enddefine
**-----------------------	CLASS oSysTray ---------------------------------



FUNCTION HTMLFix(tcString)
	* This code ASSUMES the incoming string is ANSI,
	* CHR(32) to (127) and has not already had the 
	* characters converted - it will make a mess of a 
	* string that already has strings like &#151; in it.
	LOCAL lcString as string
	lcString = STRTRAN(tcString,"&","&amp;")
	lcString = STRTRAN(lcString,"<","&lt;")
	lcString = STRTRAN(lcString,">","&gt;")
	RETURN ALLTRIM(lcString)
ENDFUNC && HTMLFix


FUNCTION RFC822Date(tDateTime AS DATETIME) AS STRING
	* Returns "Thu, 27 Feb 2003 14:11:12 GMT"
	LOCAL lcReturn AS STRING, lcTime AS STRING
	lcReturn = LEFT(PROPER(CDOW(tDateTime)),3) +", "
	lcReturn = lcReturn + PADL(DAY(tDateTime),2,'0') + SPACE(1)
	lcReturn = lcReturn + LEFT(PROPER(CMONTH(tDateTime)),3) + SPACE(1)
	lcReturn = lcReturn + STR(YEAR(tDateTime),4)+SPACE(1)

	lcTime = TTOC(tDateTime,2)  && HH:MM:SS PM
	* Compensate for PM
	IF RIGHT(lcTime,2) = "PM" AND LEFT(lcTime,2) # "12"
	  lcTime = STR(12+VAL(lcTime),2)+SUBSTR(lcTime, 3, 6)
	ELSE
	  lcTime = LEFT(lcTime, 8)
	ENDIF
	* Fake the time zone
	lcTime = lcTime + " EST"

	lcReturn = lcReturn + lcTime

	RETURN lcReturn
ENDFUNC && RFC822Date


*===============================================
Procedure COPYFILEAPI
	Lparameters tcSourceFile, tcDestinationFile

	&& WIN API
	&& Copy file
	&& NOTE: the file name case will not be changed for the existing destination file.
	Declare Long CopyFile In WIN32API ;
		String SourceFileName, String DestFileName, Long bFailIfExists
	Local llSucces
	llSucces = .T.
	If COPYFILE(tcSourceFile, tcDestinationFile, 0) = 0
		llSucces = .F.
	ENDIF

	CLEAR DLLS  "WIN32API"

	Return llSucces
Endproc && COPYFILE

*===============================================
Procedure MOVERENAMEFILEAPI
	Lparameters tcSourceFile, tcDestinationFile
	Local llSucces
	llSucces = .T.
	&& Move/Rename file
	Declare Long MoveFile In WIN32API ;
		String SourceFileName, String DestFileName
	If MOVEFILE(tcSourceFile, tcDestinationFile) = 0
		llSucces = .F.
	Endif
	
	CLEAR DLLS  "WIN32API"
	
	Return llSucces
Endproc && MOVEFILE