*!* 11.05.2015
*!* marius.mutu
*!* gcArticolBonFiscalCont: numele articolului care se va lista pe bonul fiscal. daca nu este completat se listeaza (Fact. Nr.)

*!*	26.06.2015
*!*	marius.mutu
*!*	goKeepAlive: Tin conexiunea deschisa. La wert??? apare eroarea odbc "timeout occured" daca se lasa peste 1 minut programul fara sa se lucreze

Parameters tparam

Private gcParameters
If !Empty(tparam) And Type('tparam') = 'C'
	gcParameters = tparam
Else
	gcParameters = ""
Endif
&&& cont2003

* messagebox(sys(2019,2)) && locatia config.fpw

Public gnewcryptfll
Public gnewcryptxml
PUBLIC gTransferTotal
STORE -1 TO gTransferTotal
gnewcryptfll=.F.
gnewcryptxml=.F.

Local lchost, lcUserName, lcPassword, lnIdUtil, lnIdProgram, lcUserNameApp,lcPasswordApp
Public gcNumeProgram,gcAntet,gfiltru,gfiltruro
Store '' To lchost, lcUserName, lcPassword, lcUserNameApp,lcPasswordApp, gcAntet
Store 0 To lnIdUtil, lnIdProgram
gcNumeProgram=[ROACONT]
_Screen.Icon=gcNumeProgram+'.ico'
If !Like(gcNumeProgram + '*', Upper(Alltrim(Juststem(Sys(16,0)))))
	Messagebox("Nu puteti porni acest program!",0+16,"Atentie")
	Return
Endif
*!*	_screen.Icon = 'D:\CONTAFIN_ORACLE\COMUN\GRAFICE\ICONITE\CONT2003.ICO'


Set Century On
Set Deleted On
Set Date To Dmy
Set Mark To '/'
Set Exclusive Off
Set Cpdialog Off
Set Talk Off
Set Safety Off
Set Escape Off
Set Exact On
Set Ansi On
Set Console Off
Set Notify Off
Set Seconds Off
*SET NULLDISPLAY TO '*'
Set NullDisplay To ''
Set Decimals To 4
Set Point To '.'

*!* 06.06.2007
*!* mutu.marius
Set SQLBUFFERING On

_Screen.Visible=.T.




*VARIABILE_______
Local lcMainClassLib
Local lcLastSetTalk,lcLastSetPath,lcLastSetClassLib,lcOnShutdown

*VARIABILE__________________________________________________________________________
Declare nror[65000]
Declare RTVA[22,2]
err1=.F.

Public CRLF
Store Chr(13) + Chr(10) To CRLF
Public pcNl,pcAn
Store "" To pcNl,pcAn  && se initializeaza in start00

Public pcTitlu,pl_verificat
Store "" To pcTitlu
Store .F. To pl_verificat

Public BUTON, luna_inchisa, luna_neplatita, PRIMADATA, m.ctva, m.ctvam, m.ctvai, antet, m.nivel
Public OStart,OSETVIZ,OSETTULBAR,OSETINSTRUM,orm,OTEXT,OJUR,osetgest,tlbr_INSTR,tlbr_VIZ,oprinc,DIRGEN
Public pcapsocsub,pcapsocvar
pcapsocsub=0
pcapsocvar=0
Public a4
a4=.T.
m.nrgrup=999

Store .F. To luna_inchisa,tlbr_INSTRum,tlbr_VIZ
Store 1 To BUTON,col_menu
Store .T. To PRIMADATA,luna_neplatita


*-- Save and configure environment.***********************
lcLastSetTalk=Set("TALK")
Set Talk Off
lcLastSetPath=Set("PATH")

*!*	Set Path To ;Date;Include;FERESTRE;GRAFICE;Help;CLASE;MENIURI;PROGRAME;RAPOARTE;PROGS;LIBS

Public gcAppPath,gcAppName, gcTempPath, gcCaleServerDate, gcUserNameApp, gcPasswordApp, gcSettingsFile
Store '' To  gcUserNameApp, gcPasswordApp, gnNivelUtilizator, gnGrupUtilizator, gcAcces
PUBLIC gcBasePath

*!*	PUBLIC gcSchemaPath
*!*	STORE '' TO gcSchemaPath

*!*	gcAppPath=ADDBS(JUSTPATH(SYS(16,0))) && d:\contafin\cont2003\
Set Procedure To "D:\ROA\ROACONT\COMUN\UTILE\web\WWUTILS.PRG" Additive
Set Procedure To "D:\ROA\ROACONT\COMUN\UTILE\web\WWAPI.PRG" Additive

gcAppPath = Addbs(ShortPath(GetAppStartPath()))
If Right(gcAppPath ,9)="PROGRAME\"
	gcAppPath = Substr(gcAppPath ,1,Len(gcAppPath )-9)
Endif
gcAppName=Allt(Uppe(Juststem(Sys(16,0)))) && "cont2003"
*!*Set Path To Addbs(Substr(gcAppPath,1,Rat([\],gcAppPath,2)))+[COMUNROA\] Additive	&&	modificare v 2.0.59


*gcAppDataPath=gcAppPath+"Date_"+gcAppName+"\" && D:\CONTAFIN\TRANS\DATE_TRANS && PT OPTIUNI , FISIERE SPECIFICE PROGRAMULUI SI
gcUtilizatoriPath = gcAppPath + "UTILIZATORI\"

Set Default To (gcAppPath)
lcPath = gcAppPath + 'Date;' + ;
	gcAppPath + 'Include;' + ;
	gcAppPath + 'FERESTRE;' + ;
	gcAppPath + 'GRAFICE;' + ;
	gcAppPath + 'CLASE;' + ;
	gcAppPath + 'MENIURI;' + ;
	gcAppPath + 'PROGRAME;' + ;
	gcAppPath + 'RAPOARTE;' + ;
	gcAppPath + 'COMUN\CLASE;' + ;
	gcAppPath + 'COMUN\FERESTRE;' + ;	
	gcAppPath + 'COMUN\PROGRAME;' + ;
	gcAppPath + 'COMUN\GRAFICE;' + ;
	gcAppPath + 'COMUN\RAPOARTE;' + ;
    gcAppPath + 'COMUN\UTILE\CALENDAR;' + ;	
    gcAppPath + 'COMUN\UTILE\CTL32;' + ;	
	gcAppPath + 'COMUN\UTILE\HPDF;' + ;		
	gcAppPath + 'COMUN\UTILE\HPDF\REPORTOUTPUT;' + ;			
	gcAppPath + 'COMUN\UTILE\WEB;' + ;
	gcAppPath + 'COMUN\UTILE\NFJSON;' + ;	
	gcAppPath + 'COMUN\UTILE\NFXML;' + ;		
	gcAppPath + 'COMUN\UTILE\EXCEL;' + ;
	gcAppPath + 'COMUN\UTILE\GridExtras	;' + ;
	Addbs(Substr(gcAppPath,1,Rat([\],gcAppPath,2)))+[COMUNROA\]
	
*!*Set Path To Date;Include;FERESTRE;GRAFICE;Help;CLASE;MENIURI;PROGRAME;RAPOARTE;PROGS;LIBS

SET PATH TO &lcPath ADDITIVE 


	PUSH Menu _Msysmenu
lcLastSetClassLib=Set("CLASSLIB")
lcMainClassLib="clase\cont2000"



*CLASE__________________________________________________________
Set Classlib To (lcMainClassLib) Additive
Set Classlib To CAUT Additive
* SET CLASSLIB TO FERESTREBAZA ADDITIVE
Set Classlib To BAZA Additive
Set Classlib To contab Additive
Set Classlib To comun Additive
Set Classlib To registry Additive
Set Classlib To cauta_alfa_forms.vcx Additive
Set Classlib To obalanta Additive
Set Classlib To ocriterii.vcx Additive
Set Classlib To ctl32_statusbar.vcx Additive
Set Classlib To ctl32_common.vcx Additive
Set Classlib To ctl32_structs.vcx Additive
Set Classlib To ctl32_progressbar.vcx Additive
*!*	SET CLASSLIB TO ctl32_scontainer.vcx additive


*PROCEDURI______________________________________________________
Set Procedure To PROCEDURI Additive
Set Procedure To pmenu Additive
Set Procedure To proceduri_comune Additive
Set Procedure To mesaje Additive
Set Procedure To acces_meniu Additive
Set Procedure To quitapp Additive
Set Procedure To init_program Additive
Set Procedure To oproceduri_maintenance.PRG Additive
Set Procedure To gridproc Additive
Set Procedure To proceduri_excel Additive
Set Procedure To oserii_numere.PRG Additive
Set Procedure To cauta_alfa Additive
Set Procedure To oproceduri_parteneri Additive
Set Procedure To oproceduri_incasari Additive
Set Procedure To oserii_numere Additive
Set Procedure To wwconfig Additive
Set Procedure To oexport Additive
SET PROCEDURE TO ocasabanca ADDITIVE 
SET PROCEDURE TO importfromxlsx ADDITIVE 
SET PROCEDURE TO appendfromxlsx.prg ADDITIVE
SET PROCEDURE TO excelxml.prg ADDITIVE 
SET PROCEDURE TO overificari.prg ADDITIVE 
SET PROCEDURE TO onomenclatoare.prg ADDITIVE 

SET PROCEDURE TO saft_d406.prg ADDITIVE 
SET PROCEDURE TO ofacturare.prg ADDITIVE 
SET PROCEDURE TO ofacturare_comun.prg ADDITIVE 
SET PROCEDURE TO ofacturare_editare.prg ADDITIVE 
SET PROCEDURE TO oproceduri_facturare.prg ADDITIVE 
SET PROCEDURE TO anaf_efactura.prg ADDITIVE
SET PROCEDURE TO import_efactura.prg ADDITIVE 
SET PROCEDURE TO xmlefactura.prg ADDITIVE 

SET PROCEDURE TO oscrie_in_fisiere.prg ADDITIVE 
SET PROCEDURE TO chatbot.prg ADDITIVE 

SET PROCEDURE TO oproceduri_listari.prg ADDITIVE && listare NIR gestiune din import eFactuar

&& CLASE ORACLE
Set Classlib To DECABAZA Additive
Set Classlib To onomenclatoare Additive
Set Classlib To oparteneri Additive
Set Classlib To OCASABANCA Additive
Set Classlib To OVANZCUMP Additive
Set Classlib To oCompensari Additive
Set Classlib To oRapoarte_cont Additive
Set Classlib To oSit_Op Additive
Set Classlib To overificari Additive
Set Classlib To oteste Additive
Set Classlib To omodificari Additive
Set Classlib To ooptiuni Additive
Set Classlib To ointroduceri_cont Additive
Set Classlib To onote_contabile Additive
Set Classlib To odebcred Additive
Set Classlib To ferestre_oracle Additive
Set Classlib To caut_ora Additive
Set Classlib To otoolbar Additive
Set Classlib To inchideri_sal Additive
Set Classlib To serii_numere Additive
***19.10.2015
***liana.neagu
Set Classlib To contabilitate_rapoarte Additive
*** 02.08.2006
*** marius.mutu
Set Classlib To oconversii Additive

*!* 16.01.2007
*!* marius.mutu
Set Classlib To oactualizari Additive
SET CLASSLIB TO onom_articole ADDITIVE 

&& CLASE UTILITARE
Set Classlib To Messagebox Additive
SET CLASSLIB TO wwdialogs ADDITIVE 
*!*	modificare	v 2.0.140
SET CLASSLIB TO orapoarte.vcx additive
SET CLASSLIB TO orapoarte_contabilitate.vcx additive
*!*	modificare	v 2.0.140	^

SET CLASSLIB TO accessibility.vcx ADDITIVE 
SET CLASSLIB TO _calendar.vcx ADDITIVE 

SET CLASSLIB TO orapoarte_comun.vcx ADDITIVE 

SET CLASSLIB TO saft_d406.vcx ADDITIVE 
SET CLASSLIB TO anaf_efactura.vcx ADDITIVE 


&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

&& PROCEDURI ORACLE
Set Procedure To GENCURSOR.PRG Additive
Set Procedure To OPROCEDURI_COMUNE.PRG Additive
Set Procedure To OINIT_OPTIUNI.PRG Additive
Set Procedure To updateserver.PRG Additive
Set Procedure To oCompensari.PRG Additive
Set Procedure To oSituatii_Operative.PRG Additive
Set Procedure To oOperatii_comune.PRG Additive

Set Procedure To OCONT2003.PRG Additive
Set Procedure To OPROCEDURI_aMS.PRG Additive
Set Procedure To oparteneri.PRG Additive
Set Procedure To orapoarte.PRG Additive
Set Procedure To orap_trezorerie Additive
Set Procedure To ocautare Additive
Set Procedure To omeniu_initializari Additive
Set Procedure To osecurity Additive
Set Procedure To oheader Additive
Set Procedure To orefaceri Additive
Set Procedure To oproceduri_casademarcat Additive
*!*	modificare v 2.0.74
*!*	Set Procedure To oproceduri_casa_marcat_e500 Additive
Set Procedure To controllerecr Additive
*!*	modificare v 2.0.74	^
*!* 12.07.2006
*!* marius.mutu
Set Procedure To oproceduri_comune_imob.PRG Additive
*!* 02.08.2006
*!* marius.mutu
Set Procedure To oproceduri_conversie.PRG Additive

*!* 17.08.2006
*!* marius.mutu
Set Procedure To odocumente.PRG Additive

*!* 16.01.2007
*!* marius.mutu
Set Procedure To oproceduri_actualizari.PRG Additive

*!*	modificare	v 2.0.140
SET PROCEDURE TO orapoarte_dinamice.prg additive
*!*	modificare	v 2.0.140	^

SET PROCEDURE TO update_imob.prg ADDITIVE 

SET PROCEDURE TO oproceduri_import.prg ADDITIVE 
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

*!* 21.06.2006
*!* marius.mutu
Set Procedure To wwutils.PRG Additive
Set Procedure To wwxmlhttp.PRG Additive
Set Procedure To ini.PRG Additive

*!* 28.06.2007
Set Procedure To regex.PRG Additive
Set Procedure To validare.PRG Additive && validare cif

&& pt. recalculare randuri la decont TVA
Set Procedure To oproceduri_evolutie Additive
Set Procedure To oproceduri_decont Additive

Set Procedure To proceduri_rapoarte.PRG Additive

*!* modificare v 2.0.95
SET PROCEDURE TO iniacces.prg ADDITIVE 
SET PROCEDURE TO oupdate.prg additive
SET PROCEDURE TO procese.prg additive
SET PROCEDURE TO version.prg additive
SET PROCEDURE TO xmlaccess.prg additive
SET PROCEDURE TO xmlparser.prg additive
SET PROCEDURE TO filebringer.prg additive
SET PROCEDURE TO wwcodeupdate.prg additive
SET PROCEDURE TO wwhttp.prg ADDITIVE 
SET PROCEDURE TO wwapi.prg ADDITIVE 
*!* modificare v 2.0.95^

*!*	modificare	v 2.5.28
Declare Integer GetPrivateProfileString In WIN32API ;
	string, String, String, String @, Integer, String
Declare Integer WritePrivateProfileString In Win32Api ;
	string, String, String, String
Declare Integer CopyFile In WIN32API ;
	STRING  lpExistingFileName,;
	STRING  lpNewFileName,;
	INTEGER bFailIfExists
Declare Integer URLDownloadToFile In urlmon.Dll;
	INTEGER pCaller, String szURL, String szFileName,;
	INTEGER dwReserved, Integer lpfnCB
Declare Integer PathFileExists In shlwapi;
	STRING pszPath
*!*	modificare	v 2.5.28	^	

If Type('goApi') = 'U'
	Public goApi
	goApi = Newobject("wwAPI", "wwAPI.prg")
ENDIF


*!*	modificare v 2.0.74
Private goControllerEcr
goControllerEcr = Createobject('oControllerEcr')
*!*	modificare v 2.0.74	^

If Pcount() = 1 And Type('tparam') = 'C'
	glParametri = .T.
	Private laParametri
	Declare laParametri[1]
	lcParam = Alltrim(tparam)
	lnNr = lista2array(lcParam,@laParametri,";")
	If lnNr < 5
		Messagebox('Numar incorect de parametri',0+16,'Eroare')
		Return
	Endif
	lchost = laParametri[1]
	lcUserName = laParametri[2]
	lcPassword = laParametri[3]
	lnIdUtil = Round(Val(laParametri[4]),0)
	lnIdProgram = Round(Val(laParametri[5]),0)
Else
	glParametri = .F.
	lchost = 'JCSSERVER'
	lcUserName = 'CONTAFIN_ORACLE'
	lcPassword = ''
	lnIdUtil = 0
	lnIdProgram = 0

Endif

Public glVerificTabel && daca se verifica structura tabelelor in totv.prg
glVerificTabel=.T.

Public glQuit
glQuit = .F.

Public gnIdIstoric
gnIdIstoric = 0



Store "" To gcTempPath, gcCaleServerDate
liat=Rat("\",gcAppPath,2)
gcDirMare=Left(gcAppPath,liat)




*!*	IF !DIRECTORY(gcAppDataPath)
*!*		MD (gcAppDataPath)
*!*	ENDIF



*** DIRGEN
liat = Rat("\",gcAppPath,2)
DIRGEN = Addbs(Left(gcAppPath,liat-1))


gcSecurityPath = DIRGEN + 'Security\'
gcSecurityFile = gcSecurityPath + 'ROA_SECURITY.TXT'

Cd &DIRGEN
gcBasePath = DIRGEN

*!* 21.06.2006
*!* marius.mutu
Private gcGeneralIniFile
gcGeneralIniFile = DIRGEN + "settings.ini"
gcSettingsFile = m.gcGeneralIniFile
If !File(gcGeneralIniFile)

	TEXT TO lcSettings NOSHOW
[errors]
host=http://romfast.dnsalias.com:3000/errors/create_xml
	ENDTEXT

	Strtofile(lcSettings, gcGeneralIniFile)
Endif


*** Tin conexiunea deschisa. La wert??? apare eroarea odbc "timeout occured" daca se lasa peste 1 minut programul fara sa se lucreze
LOCAL lcKeepAlive, lnKeepAlive
PRIVATE goKeepAlive
lcKeepAlive = NVL(getini(m.gcGeneralIniFile,'update','keepalive_seconds'), '')
lnKeepAlive = 0
IF EMPTY(m.lcKeepAlive)
	setini(m.gcGeneralIniFile,'update','keepalive_seconds', '0')
	lnKeepAlive = 0
ELSE
	lnKeepAlive = VAL(m.lcKeepAlive)	
ENDIF
IF m.lnKeepAlive >= 5 && minim 5 secunde
	goKeepAlive = NEWOBJECT("keepalive","utility.vcx")
	goKeepAlive.interval = m.lnKeepAlive * 1000
	goKeepAlive.enabled = .T.
ENDIF  

PUBLIC poLog,goLog && obiect pt logarea mesajelor sistemului
poLog = Newobject("Log_Mesaje","Log_Mesaje.prg")
goLog = poLog


*!* Locale
Set Classlib To locale Additive
Private gcLocalePath, goLocale, gcLocale, glTraducere
gcLocalePath = gcAppPath + "Locale\"
glTraducere = .F.
*!*	lcLocaleDb = gcLocalePath + "locale.dbc"
*!*	Open Database (m.lcLocaleDb)
*!*	modificare v 2.0.85
*!*	goLocale=Newobject("Locale","Locale.vcx")
lcLanguage = getini(gcGeneralIniFile,"locale","lang")
llLocale= getini(gcGeneralIniFile,"locale","llocale")
*!*	IF  !EMPTY(m.llLocale) AND m.llLocale<>'0'
*!*	goLocale.llocale=.T.
*!*	ENDIF 
*!*	modificare v 2.0.85	^
If Empty(m.lcLanguage)
	gcLocale = 'Romana'
Else
	gcLocale = m.lcLanguage
ENDIF
*!*	modificare v 2.0.85
Local lcObjLocale
If gcLocale = 'Romana'
	lcObjLocale = [Locale_dummy]
Else
	lcObjLocale = [Locale]
Endif
goLocale=Newobject(lcObjLocale,"Locale.vcx")
If  !Empty(m.llLocale) And m.llLocale<>'0'
	goLocale.llocale=.T.
Endif
Release lcObjLocale
*!*	modificare v 2.0.85	^
goLocale.locale = gcLocale
*!* Locale ^

If verificari()
	_Screen.Visible=.T.
	Do mesaj With "Se fac verificari programului","Va rugam reveniti"
	glQuit= .T.
	Quit
Endif

If !Debug_Start()
	lcParam=tparam
	If Empty(tparam) Or (Type('tParam')='C' And !verific_start(tparam,DIRGEN,gcAppName))
		_Screen.Visible=.T.
		Do mesaj With "Programul trebuie pornit doar din START",""
		Quit
	Endif
Endif




*!*	modificare	v 2.0.140
*!*	Public tipar,SER_PERM,SER_PERI,VERSIUNE
*!*	Store .F. To SER_PERM,SER_PERI
*!*	modificare	v 2.0.140	^
***************************** VARIABILE ORACLE
Private goUtilizator
Private gnHandle,gnidutil,GCCODFISCAL,GCADRESA,GCNUMEFIRMA,GCMONEDA,GNDIFZILE, gcUserNameApp, gcPasswordApp, gcAcces
Private gnButon		&& variabila pentru renunt si terminat
Store 2 To gnButon
Store '' To GCCODFISCAL,GCADRESA,GCNUMEFIRMA,GCMONEDA, gcUserNameApp, gcPasswordApp, gcNivelUtilizator, gcGrupUtilizator, gcAcces
gcAcces = []
gnHandle = -1
gnidutil = 0

Private gcHost, gcUserName, gcPassword,gofundal, gnIdProgram, gnId_Prg_Owner
gnIdProgram = 0
gnId_Prg_Owner = 0
gofundal=''

Private goFirma,gnIdFirma,gcFirma,gnAn,gnLuna && ,gnPA,gnPC
&& STORE 0 TO gnPA,gnPC && nr. de zecimale afisare, calcul
Store Null To goFirma

Store 0 To gnIdFirma, gnAn, gnLuna
Store '' To gcFirma

***toolbar***
Private otool,ohelp
Store '' To otool,ohelp
***toolbar***

Private glUltimaLuna,glPrimaLuna, glLunaBuna,glLuna_neplatita,glLunaInchisa,glListareBonFiscalCont, gcArticolBonFiscalCont

Store .F. To glUltimaLuna,glPrimaLuna, glLunaBuna,glLuna_neplatita,glLunaInchisa,glListareBonFiscalCont
gcArticolBonFiscalCont = "" && numele articolului care se va lista pe bonul fiscal. daca nu este completat se listeaza (Fact. Nr.)

Private gcS  && schema firmei
Store 'CONTAFIN' To gcS

If Type('laparametri',1)="A"
	If Alen(laParametri,1)=10
		gnAn = Val(laParametri[7])
		gnLuna = Val(laParametri[8])					&&lansare noua
		gcS = laParametri[9]
		gnIdFirma = Val(laParametri[10])
	Endif
Endif

If Type('goCacheANAF_Sesiune') = 'O'
	Release goCacheANAF_Sesiune
Endif

Private gcCopyRight
gcCopyRight = '© ROA Romfast SRL'

&& obiect global wrap pentru sqlexec cu text eroare si succes
Private goExecutor
goExecutor = Createobject("oExecutor")

&& obiect global wrap pentru sqlconnect, sqldisconnect; apeleaza proceduri postconectare pentru setare variabile sesiune
Private goConn
goConn = Createobject("oConn")

&& obiect global pentru export : frx, xls
Private goExport
goExport = Createobject("oExportConfig")

*!* 21.06.2006
*!* marius.mutu
Private goMyXMLHTTP
lcHostErrors = getini(gcGeneralIniFile,'errors','host')
goMyXMLHTTP = Createobject("MyXMLHTTP", lcHostErrors)

Private goCalendar
Store Null To goCalendar



gcHost = lchost
gcUserName = lcUserName
gcPassword = lcPassword
gcUserNameApp = lcUserNameApp
gcPasswordApp = lcPasswordApp
gnidutil = lnIdUtil
gnIdProgram = lnIdProgram


If !glParametri
	lnValid = getcrsSecurity(gcSecurityFile)
	If lnValid > 0
		If Used('crsHost')
			Select crsHost
			Go Top
			gcHost = Alltrim(Host)
			gcUserName = Alltrim(schema)
			gcPassword = Alltrim(pwd)
			Use In crsHost
		Endif
	Endif
Endif
***************************** VARIABILE ORACLE

&& DECLARARE VARIABILE GLOBALE SPECIFICE APLICATIEI CARE NU SE AFLA IN OPTIUNI_FIRMA
&& (SE AFLA IN DIRECTORUL PROIECTULUI, NU IN COMUN)
Do OVARIABILE_GLOBALE.PRG

*!*	modificare	v 2.0.140
MODEL_PROGRAM = [M]
*!*	Use &gcAppPath\SERCONT In 0 Alias SER Shared
*!*	Select SER
*!*	Go Top
*!*	tipar=TIP
*!*	SER_PERM=SER_PERMAN
*!*	SER_PERI=SER_PERIOD
*!*	VERSIUNE=VERcont
*!*	MODEL_PROGRAM=MODEL
*!*	Use In SER
*!*	parolamea=Substr(tipar,Month(Date()),1)
*!*	parolamea=parolamea+Allt(Str(Day(Date())))+Allt(Str(Month(Date())))

*!*	If !_DEBUG()
*!*		If SER_PERM And !verif_ser_perm()
*!*			* daca exista comdir.snr - trec mai departe :) presupun ca s-a instalat kitul de client chiar daca nu s-a verificat seria
*!*			If !File(getCaleWin() + 'comdir.snr')
*!*				Quit
*!*			Endif
*!*		Endif
*!*	Endif
*!*	modificare	v 2.0.140	^
Public NUMEPROGRAM,MENIUPROGRAM,FUNDALPROGRAM



m.contab = 'TOTAL'
Do Case
	Case M.contab='CASA'
		NUMEPROGRAM='CONTAFIN CASA'
		MENIUPROGRAM=gcAppPath+"meniuri\contORICEcasa.mpr"
		FUNDALPROGRAM=gcAppPath+"FERESTRE\FUNDALORICE.scx"
		_program='cont'
	Case M.contab='COMERT'
		NUMEPROGRAM='CONTAFIN COMERCIAL'
		MENIUPROGRAM=gcAppPath+"meniuri\contCOMERT.mpr"
		FUNDALPROGRAM=gcAppPath+"FERESTRE\FUNDALORICE.scx"
		_program='cont'
	Otherwise
		NUMEPROGRAM='ROA Financiar Contabilitate '+MODEL_PROGRAM
		MENIUPROGRAM=gcAppPath+"meniuri\cont2000.mpr"
		FUNDALPROGRAM=gcAppPath+"FERESTRE\FUNDAL.scx"
		_program='cont'

Endcase

*-- Configure application object.*****************************


*!* 08.12.2010
PRIVATE gcReportPreviewer, gcReportPreviewerPath
gcReportPreviewer = "FoxyPreview" && oexport.prg && "FoxyPreview" && foloseste apelarea simpla a comunroa\foxypreviewer.app
gcReportPreviewerPath = dirgen + "COMUNROA\"
*!* 08.12.2010 ^


_Screen.WindowState=2


lcOnShutdown="ShutDown()"
On Shutdown &lcOnShutdown
On Error ErrorHandler(Error(),Program(),Lineno())
*_Shell="DO Cleanup IN progs\cont2003"

*-- Instantiate application object.***************************
Release goApp
private goApp
goApp=Createobject("cApplication")

Local laVersion
Dimension laVersion(12)
If Agetfileversion(laVersion, Sys(16,0)) > 0
	NUMEPROGRAM = laVersion(10)
Endif
Release laVersion

goApp.SetCaption(NUMEPROGRAM)
goApp.cStartupMenu=MENIUPROGRAM
*goApp.cStartupForm=FUNDALPROGRAM
goApp.cStartupForm = gcAppPath + 'COMUN\ferestre\frm_login.scx'


_Screen.WindowState=2
*-- Show application.
goApp.Show



*-- Release application.
Release goApp

*-- Restore default menu.
*!*	Pop Menu _Msysmenu

*-- Restore environment.
On Error
On Shutdown
If Not lcLastSetClassLib==Set("classlib")
	Release Classlib gcAppPath + 'clase\cont2000.vcx'
Endif
If Empty(lcLastSetPath)
	Set Path To
Else
	Set Path To &lcLastSetPath
Endif
If lcLastSetTalk=="ON"
	Set Talk On
Else
	Set Talk Off
Endif
cleanup()

Return




* FUNCTII______________________________________________________________________
Function ErrorHandler(nError,cMethod,nLine)
	Local lcErrorMsg,lcCodeLineMsg
	local loEx as Exception 

	goLog.Log('1','ErrorHandler')
	Wait Clear
	lcErrorMsg = 'nErrror: ' + transform(m.nError) + ' cMethod: ' + transform(m.cMethod) + ' line: ' + transform(m.nLine) + chr(13) +  GETCALLSTACK()
	goLog.Log(m.lcErrorMsg,'ErrorHandler')

	lcErrorMsg = ""
	lcCodeLineMsg = ""

	try 
		goLog.Log('2','ErrorHandler')
		lcErrorMsg=Message()+Chr(13)+Chr(13)
		lcErrorMsg=lcErrorMsg+"Method:    "+cMethod
		lcCodeLineMsg=Message(1)
		goLog.Log('3','ErrorHandler')
		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
		goLog.Log('4','ErrorHandler')
		lcErrorMsg = lcErrorMsg + Chr(13) + Chr(10) + Chr(13) + Chr(10) + GETCALLSTACK()
		goLog.Log('5','ErrorHandler')
	catch to loEx
		lcErrorMsg = 'Error ' + loEx.Message + Chr(13)+"Line:         " + loEx.LineNo + Chr(13) + Chr(13) + loEx.Procedure 
		goLog.Log('6','ErrorHandler')		
	endtry 	

	goLog.Log(lcErrorMsg,'ErrorHandler')
	try 
		If Type('goMyXMLHTTP') = 'O'
			lcLunaHTTP = Iif(Type('gnLuna') = 'N', Transform(gnLuna) + "/","") + Iif(Type('GNAN') = 'N', Transform(gnAn),"")
			lcErrorMsgHTTP =  Sys(0) + ":" + Iif(Type('GCS')='C'," " + gcS,"")  + ": " + lcLunaHTTP + Chr(13) +Chr(10) + lcErrorMsg
			lcUserName = gcUserNameApp
			lcProgram = Juststem(Sys(16,0))
			goMyXMLHTTP.postError(lcErrorMsgHTTP, lcUserName, lcProgram)
		endif
	catch to loEx
		*
	endtry 
	goLog.Log('7','ErrorHandler')
	
	If AMESSAGEBOX(lcErrorMsg,17,_Screen.Caption)#1
		On Error
		On Shutdown
		If _vfp.StartMode = 0
			Debug
			Suspend
		Else
			Quit
		Endif
		*!*			RETURN .F.
	endif
	goLog.Log('8','ErrorHandler')
Endfunc



Function Shutdown
	If Type("goApp")=="O" And Not Isnull(goApp)
		RETURN goApp.OnShutDown()
	Endif
	On Shutdown
	ON ERROR 
	CLEAR events 
Endfunc


Function Cleanup

	If Cntbar("_msysmenu")=7
		Return
	Endif
	On Error
	On Shutdown
	Set Classlib To
	Set Path To
	Clear All
*	Close All
	Pop Menu _Msysmenu
	Return





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

Function verif_ser_perm
	Clear

	Return PORNIRE()
	********
	*?pornire()

Function PORNIRE
	Set Exact On
	Private calewin,calesys,checksum1,checksum2,serinreg,serdisk,file1,file2,valret,serdisktemp,ser1,ser2,key1,KEY2
	Store '' To calewin,serinreg,serdisk,calesys,serdisktemp,catehd,ser1,ser2,key1,KEY2
	Store 0 To checksum1,checksum2
	Store .T. To valret
	Declare Integer SHGetFolderPath In SHFOLDER.Dll ;
		INTEGER hwndOwner, ;
		INTEGER nFolder, ;
		INTEGER hToken, ;
		INTEGER dwFlags, ;
		STRING @ pszPath
	Declare Integer GetActiveWindow In WIN32API
	#Define CSIDL_WINDOWS  36
	#Define CSIDL_SYSTEM   37
	#Define CSIDL_PROGRAMS 38
	lcPath = Repl(Chr(0),261)
	=SHGetFolderPath(GetActiveWindow(),CSIDL_WINDOWS,0,0,@lcPath)
	calewin=Left(lcPath,At(Chr(0),lcPath)-1)
	lcPath = Repl(Chr(0),261)
	=SHGetFolderPath(GetActiveWindow(),CSIDL_SYSTEM,0,0,@lcPath)
	calesys=Left(lcPath,At(Chr(0),lcPath)-1)
	&&se verifica existenta celor trei fisiere
	lcTextEroare = ""
	If (Not File(calesys+'\diskserial.dll')) Or (Not File(calesys+'\getmacip.dll')) Or (Not File(calewin+'\comdir.snr'))
		valret=.F.
		lcTextEroare = lcTextEroare  + calesys + '\diskserial.dll ' + Transform(File(calesys+'\diskserial.dll')) + ;
			' ' + calesys+'\getmacip.dll' + Transform(File(calesys+'\getmacip.dll')) + ' ' + calewin+'\comdir.snr' + Transform(File(calewin+'\comdir.snr')) + Chr(13) + Chr(10)
	Endif
	If valret
		file1=Filetostr(calesys+'\diskserial.dll')
		checksum1=Sys(2007,file1)
		file2=Filetostr(calesys+'\getmacip.dll')
		checksum2=Sys(2007,file2)
		&&severifica daca dll-urile nu au fost modificate
		If (Val(checksum1) != 58755) Or (Val(checksum2) != 30476)
			valret=.F.
			lcTextEroare = lcTextEroare + 'checksum1 ' + checksum1 + ' checksum2 ' + checksum2 + Chr(13) + Chr(10)
		Endif
	Endif
	&&se citesc seriile tutturor celor patru hard disk-uri posibile(pe IDE primary master,primary slave...)
	&&se tine minte primul cu seria nenula-daca nu s-a putut citi seria de la nici unul se pune o serie default
	&&seria default este "NUAREHAR"
	If valret
		Declare Integer GetSerialNumber In diskSerial.Dll Integer ,String
		catehd=0
		For i=0 To 3
			serdisktemp=Space(40)
			GetSerialNumber(i,@serdisktemp)
			If (Len(Alltrim(serdisktemp))!=0) And (catehd=0)
				serdisktemp=sircaracter(serdisktemp)
				serdisk=serdisktemp
				catehd=catehd+1
			Endif
		Endfor
		If (Len(Alltrim(serdisk))=0)
			serdisk='NUAREHAR'
		Else
			If ((Len(Alltrim(serdisk))>0) And (Len(Alltrim(serdisk))<8))
				serdisk=serdisk+Replicate('1',8-Len(Alltrim(serdisk)))
			Endif
		Endif
		serdisk=Substr(Alltrim(serdisk),Len(Alltrim(serdisk))-7,8)
	Endif
	&&se citeste din comdir.snr seria de inregistrare si se verifica egalitatea cu seria obtinuta anterior
	If valret
		gnFileHandle = Fopen(calewin+'\comdir.snr')
		nSize =  Fseek(gnFileHandle, 0, 2)     && Move pointer to EOF
		If nSize!=9
			valret=.F.
			lcTextEroare = lcTextEroare + 'nSize ' + Transform(nSize) + Chr(13) + Chr(10)
		Else
			= Fseek(gnFileHandle, 0, 0)      && Move pointer to BOF
			cString = Fread(gnFileHandle,9)
			ser1=Substr(cString,1,4)
			ser2=Substr(cString,5,4)
			key1=Substr(cString,9,1)
			KEY2=DECTOBIN(Alltrim(HEXDEC(key1)))
			serinreg=decodare1(Alltrim(Upper(ser1)),KEY2)+decodare1(Alltrim(Upper(ser2)),KEY2)
			If serdisk!=serinreg
				valret=.F.
				lcTextEroare = lcTextEroare + 'serdisk ' + serdisk  + ' serinreg ' + serinreg + Chr(13) + Chr(10)
			Endif
		Endif
		= Fclose(gnFileHandle)
	Endif
	seriedisk1=serdisk
	serieinreg1=serinreg
	On Error valret=.F.
	poLog.Log('Eroare verificare serie ' + Chr(13) + Chr(10) + lcTextEroare, Program())
	If Type('goMyXMLHTTP') = 'O'
		If !Empty(lcTextEroare)
			goMyXMLHTTP.postError('Eroare verificare serie ' + Chr(13) + Chr(10) + lcTextEroare, gcUserNameApp, Juststem(Sys(16,0)))
		Endif
	Endif
	Return valret
	*************
Function decodare1
	Parameters lstring,CHEIE
	Local lens,poz1,poz2,POZ3,lret,LRET2,lcstring,val1,lret1
	lret=''
	lret1=''
	LRET2=''
	lcstring=Alltrim(Upper(lstring))
	lens=Len(lcstring)
	For i=1 To 4
		poz1=Substr(lcstring,i,1)
		val1=Asc(poz1)
		POZ3=Substr(CHEIE,i,1)
		Do Case
			Case val1>=48 And val1<=57
				If ((val1-47)+Int(Val(POZ3)))<=10
					poz2=Chr(val1+Int(Val(POZ3)))
				Else
					poz2=Chr(val1+Int(Val(POZ3))-10)
				Endif
			Case val1>=65 And val1<=90
				If ((val1-64)+2*Int(Val(POZ3)))<=26
					poz2=Chr(val1+2*Int(Val(POZ3)))
				Else
					poz2=Chr(val1+2*Int(Val(POZ3))-26)
				Endif
		Endcase
		LRET2=LRET2+poz2
	Endfor
	For i=1 To lens
		poz1=Substr(LRET2,i,1)
		val1=Asc(poz1)
		Do Case
			Case val1>=48 And val1<=57
				If ((val1-47)+i)<=10
					poz2=Chr(val1+i)
				Else
					poz2=Chr(val1+i-10)
				Endif
			Case val1>=65 And val1<=90
				If ((val1-64)+2*i)<=26
					poz2=Chr(val1+2*i)
				Else
					poz2=Chr(val1+2*i-26)
				Endif
		Endcase
		lret=lret+poz2
	Endfor
	lens=Len(lret)
	For i=1 To lens
		poz1=Substr(lret,i,1)
		val1=Asc(poz1)
		Do Case
			Case val1>=48 And val1<=57
				poz2=Chr(val1+17)&& din 0-9 in A-J
			Case val1>=65 And val1<=74
				poz2=Chr(val1-17)&& din A-J in 0-9
			Case val1>=75 And val1<=82
				poz2=Chr(val1+8)&&din K-R in S-Z
			Case val1>=83 And val1<=90
				poz2=Chr(val1-8)&&din S-Z in K-R
		Endcase
		lret1=lret1+poz2
	Endfor
	Return lret1
	***********
	&&transformarea in decimal a unui caracter hexa
Function HEXDEC
	Lparameters LC
	Local LV
	Do Case
		Case LC=='0'
			LV='0'
		Case LC=='1'
			LV='1'
		Case LC=='2'
			LV='2'
		Case LC=='3'
			LV='3'
		Case LC=='4'
			LV='4'
		Case LC=='5'
			LV='5'
		Case LC=='6'
			LV='6'
		Case LC=='7'
			LV='7'
		Case LC=='8'
			LV='8'
		Case LC=='9'
			LV='9'
		Case LC=='A'
			LV='10'
		Case LC=='B'
			LV='11'
		Case LC=='C'
			LV='12'
		Case LC=='D'
			LV='13'
		Case LC=='E'
			LV='14'
		Case LC=='F'
			LV='15'
	Endcase
	Return LV
	****************
	&&codarea binara din hexa pe patru biti
Function DECTOBIN
	Parameters sc
	Local lretf
	Do Case
		Case sc=='0'
			lretf='0000'
		Case sc=='1'
			lretf='0001'
		Case sc=='2'
			lretf='0010'
		Case sc=='3'
			lretf='0011'
		Case sc=='4'
			lretf='0100'
		Case sc=='5'
			lretf='0101'
		Case sc=='6'
			lretf='0110'
		Case sc=='7'
			lretf='0111'
		Case sc=='8'
			lretf='1000'
		Case sc=='9'
			lretf='1001'
		Case sc=='10'
			lretf='1010'
		Case sc=='11'
			lretf='1011'
		Case sc=='12'
			lretf='1100'
		Case sc=='13'
			lretf='1101'
		Case sc=='14'
			lretf='1110'
		Case sc=='15'
			lretf='1111'
	Endcase
	Return lretf
	***********
Function ECARACTER
	Parameters strg1
	Private pz,ch,lcstring,vret,lg1
	Store 0 To pz,lg1
	Store '' To ch,lcstring
	Store .T. To vret
	lcstring=Upper(strg1)
	lg1=Len(lcstring)
	For ind1=1 To lg1
		ch=Substr(lcstring,ind1,1)
		If (Not Between(Asc(ch),48,57)) And (Not Between(Asc(ch),65,90))
			vret=.F.
			Exit
		Endif
	Endfor
	Return vret
	************
Function sircaracter
	Parameters strg1
	Private pz,ch,lcstring,vret,lg1,lciesire
	Store 0 To pz,lg1
	Store '' To ch,lcstring,lciesire
	Store .T. To vret
	strg1=Strtran(strg1,Alltrim(Chr(39)),'')&&caracterul '
	strg1=Strtran(strg1,Alltrim(Chr(39)),'')&&caracterul "
	lcstring=Upper(Alltrim(strg1))
	lg1=Len(lcstring)
	For ind1=1 To lg1
		ch=Substr(lcstring,ind1,1)
		If Between(Asc(ch),48,57) Or Between(Asc(ch),65,90)
			lciesire=lciesire+ch
		Endif
	Endfor
	Return lciesire



	***-------------------------------------
Procedure _DEBUG

	Private lcret,lcfisier,lcPath,lccalewin
	Declare Integer SHGetFolderPath In SHFOLDER.Dll ;
		INTEGER hwndOwner, ;
		INTEGER nFolder, ;
		INTEGER hToken, ;
		INTEGER dwFlags, ;
		STRING @ pszPath
	Declare Integer GetActiveWindow In WIN32API
	#Define CSIDL_WINDOWS  36


	lcPath = Repl(Chr(0),261)
	=SHGetFolderPath(GetActiveWindow(),CSIDL_WINDOWS,0,0,@lcPath)
	lccalewin=Left(lcPath,At(Chr(0),lcPath)-1)

	lcret=.F.
	lcfisier=Addbs(lccalewin)+[DEBUG.TXT]

	If File(lcfisier)
		LCVAL=Filetostr(lcfisier)

		LNVAL1=Mod(Val(Right(LCVAL,1)),2) && restul 1 sau 0; daca e impar e 1
		lnval2=Val(Left(LCVAL,Len(LCVAL)-1))
		If LNVAL1=1 Or Year(Date())-Month(Date())=lnval2
			lcret=.T.
		Endif
	Endif
	Return lcret

Endproc


Function Start_Nou

	Return Exista_Branch(,,DIRGEN)

Endfunc && start_nou

Procedure Debug_Start

	lcFile = gcAppPath + "debug.txt"

	If File(lcFile) Or !Start_Nou()
		Return .T.
	Endif
	Return .F.

Endproc && Debug_Start
************************************************************************
Procedure verificari
	Parameters tcFisierVerif

	lcverificari = Addbs(gcAppPath)+gcAppName+".txt"


	If File(lcverificari)
		Return .T.
	Endif
	Return .F.

Endproc && verificari

Function getCaleWin
	Local lcPath, lccalewin
	lcPath = ""
	lccalewin = "c:\windows\"

	Declare Integer SHGetFolderPath In SHFOLDER.Dll ;
		INTEGER hwndOwner, ;
		INTEGER nFolder, ;
		INTEGER hToken, ;
		INTEGER dwFlags, ;
		STRING @ pszPath
	Declare Integer GetActiveWindow In WIN32API
	#Define CSIDL_WINDOWS  36


	lcPath = Repl(Chr(0),261)
	=SHGetFolderPath(GetActiveWindow(),CSIDL_WINDOWS,0,0,@lcPath)
	lccalewin=Left(lcPath,At(Chr(0),lcPath)-1)
	lccalewin = Addbs(lccalewin)

	Return lccalewin

Endfunc