vfp_roaauto/COMUN/programe/controllere/roabaseapplication.prg

Define Class ROABaseApplication As Custom
	cLastSetClassLib = Null
	cLastSetTalk = Null
	cLastSetPath = Null

	cNumeProgram = [ROA]
	cCopyRight = [© ROA Romfast SRL]
	cUserNameApp = Null
	cExplicatieProgram = Null

	cROAPath = Null
	cAppPath = Null
	cSecurityPath = Null
	cGeneralIniFile = Null

	oLog = Null
	oExecutor = Null
	oConn = Null
	oExport = Null
	oMyXmlHttp = Null

	Procedure Init
		Lparameters tcNumeProgram
		This.cNumeProgram = Upper(Alltrim(tcNumeProgram))
		_Screen.Icon = tcNumeProgram + [.ico]
		_Screen.Visible=.F.
		This.definesteConstante()
		This.setMediu()
		This.setClase()
		This.setProceduri()
		This.declaraDLL()
		This.setVariabile()
		This.setAlteProceduri()
		This.initializeazaControllere()
		This.setExplicatieProgram()
	Endproc

	PROCEDURE setVariabile
		This.cAppPath = Addbs(ShortPath(GetAppStartPath()))
		This.cROAPath = Addbs(Left(This.cAppPath,Rat("\",This.cAppPath,2)-1))
		This.cSecurityPath = This.cROAPath + 'Security\'
		This.cGeneralIniFile = This.cROAPath + "settings.ini"
	ENDPROC

	PROCEDURE setAlteProceduri
		Set Path To Addbs(Substr(This.cAppPath,1,Rat([\],This.cAppPath,2)))+[COMUNROA\] Additive
	ENDPROC

	PROCEDURE setExplicatieProgram
		Local laVersion
		Dimension laVersion(12)
		If Agetfileversion(laVersion, Sys(16,0)) > 0
			This.cExplicatieProgram = laVersion(10)
			IF TYPE('gcExplicatieProgram') = 'C'
				gcExplicatieProgram = This.cExplicatieProgram
			ENDIF
		Endif
		Release laVersion
	ENDPROC

	Procedure definesteConstante
		Public LF,CR,CRLF,CTAB,CT_INSUCCES,CT_SUCCES
		Store Chr(10) To LF
		Store Chr(13) To CR
		Store Chr(13) + Chr(10) To CRLF
		Store Chr(9) To CTAB
		Store -1 To CT_INSUCCES
		Store 1 To CT_SUCCES
	Endproc

	Procedure initializeazaControllere
		This.oLog = Createobject("logBaseController",This.cAppPath + "log_" + This.cNumeProgram + "_" + DTOS(DATE()) + ".txt")
		This.oExecutor = Createobject("oExecutor")
		This.oConn = Createobject("oConn")
		This.oExport = Createobject("oExportConfig")
		This.oMyXmlHttp = Createobject("MyXMLHTTP", getini(gcGeneralIniFile,'errors','host'))
	Endproc

	Procedure declaraDLL
		Declare Integer Beep In kernel32;
			INTEGER dwFreq,;
			INTEGER dwDuration
		Declare Integer CoCreateGuid In OLE32.Dll String @lcBuffer
	Endproc

	Procedure setClase
		Set Classlib To registry Additive
		Set Classlib To Messagebox Additive
	Endproc

	Procedure setProceduri
		Set Procedure To wwxmlhttp.prg Additive
		Set Procedure To wwutils.prg Additive
		Set Procedure To wwApi.prg Additive
		SET PROCEDURE TO oproceduri_comune.prg additive
		SET PROCEDURE TO ini.prg additive
	Endproc

	Procedure setMediu
		This.backupMediu()

		Set Path To ;Date;Include;FERESTRE;GRAFICE;Help;CLASE;MENIURI;PROGRAME;RAPOARTE;PROGS;LIBS
		Push Menu _Msysmenu
		Set Century On
		Set Date Dmy
		Set Ansi On
		Set Exact On
		Set Talk Off
		Set Console Off
		Set Safety Off
		Close Databases All
		Set Deleted On
		Set Point To '.'
		Set Hours To 24
		Set NullDisplay To "*"
		Set Mark To '/'
		Set Exclusive Off
		Set Cpdialog Off
		Set Escape Off
		Set Notify Off
		Set Seconds Off
		Set Decimals To 4
	Endproc

	Procedure backupMediu
		This.cLastSetClassLib=Set("CLASSLIB")
		This.cLastSetTalk=Set("TALK")
		This.cLastSetPath=Set("PATH")
	Endproc

	Procedure ResetMediu
		If Cntbar("_msysmenu")<>7
			Pop Menu _Msysmenu
		Endif

		On Error
		On Shutdown
		Set Classlib To
		Set Path To
		Close All
		Clear Events

		If Inlist(Application.StartMode,4) && EXE
			Quit
		Endif

		This.restoreMediu()
	Endproc

	Procedure restoreMediu
		If Empty(Nvl(This.cLastSetPath,[]))
			Set Path To
		Else
			Set Path To &(This.cLastSetPath)
		Endif
		If This.cLastSetTalk=="ON"
			Set Talk On
		Else
			Set Talk Off
		Endif
	Endproc

	Function Shutdown
		If Type("goApp")=="O" And Not Isnull(goApp)
			If Pemstatus(goApp,"OnShutdown",5)
				Return goApp.OnShutDown()
			Endif
		Endif
		This.ResetMediu()
	Endfunc

	Function ErrorHandler(nError,cMethod,nLine)
		Local lcErrorMsg,lcCodeLineMsg,lcUserName
		Wait Clear
		lcErrorMsg=Message()+Chr(13)+Chr(13)
		lcErrorMsg=lcErrorMsg+"Method:    "+cMethod
		lcCodeLineMsg=Message(1)
		If Between(nLine,1,10000) And Not lcCodeLineMsg="..."
			lcErrorMsg=lcErrorMsg+Chr(13)+"Line:         "+Alltrim(Str(nLine))
			If Not Empty(lcCodeLineMsg)
				lcErrorMsg=lcErrorMsg+Chr(13)+Chr(13)+lcCodeLineMsg
			Endif
		Endif
		lcErrorMsg =  Sys(0) + ":" + Iif(Type('GCS')='C'," " + gcS,"") + Chr(13) +Chr(10) + lcErrorMsg
		lcUserName = This.cUserNameApp
		lcProgram = Juststem(Sys(16,0))
		This.oMyXMLHTTP.postError(lcErrorMsg, lcUserName, lcProgram)

		If aMessagebox(lcErrorMsg,17,_Screen.Caption)#1
			On Error
			Return .F.
		Endif
	Endfunc

	Function verificaAplicatie
		If !Like(This.cNumeProgram + '*', Upper(Alltrim(Juststem(Sys(16,0)))))
			aMessagebox("Nu puteti porni acest program!",0+16,"Atentie")
			Return .F.
		Endif
	Endfunc

Enddefine