roagest/Programe/roagest.prg

*!* 22.02.2010
*!* marius.mutu
*!* nu se mai face verificarea seriei hdd

*!* 12.10.2016
*!* marius.mutu
*!* excelxml.vcx

PARAMETERS tparam

&&& cont2003

PUBLIC gcNumeProgram, gcAntet
LOCAL lchost, lcUserName, lcPassword, lnIdUtil, lnIdProgram, lcUserNameApp,lcPasswordApp
STORE '' TO lchost, lcUserName, lcPassword, lcUserNameApp,lcPasswordApp,gcAntet
STORE 0 TO lnIdUtil, lnIdProgram
gcNumeProgram = [ROAGEST]
_Screen.Icon = gcNumeProgram+[.ICO]
*_screen.Icon = 'D:\CONTAFIN_ORACLE\COMUN\GRAFICE\ICONITE\GESTIUNI.ICO'


IF !LIKE(gcNumeProgram + '*', UPPER(ALLTRIM(JUSTSTEM(SYS(16,0)))))
	Messagebox("Nu puteti porni acest program!",0+16,"Atentie")
	RETURN 
ENDIF 	

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 HOURS TO 24
*SET NULLDISPLAY TO '*'
SET NULLDISPLAY TO '' 
SET DECIMALS TO 4
SET POINT TO '.'

*!* SET REPORTBEHAVIOR 90 && sa se seteze inainte de raport


_SCREEN.WINDOWSTATE=2
_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,gcDirMare
PUBLIC pcapsocsub,pcapsocvar
pcapsocsub=0
pcapsocvar=0
m.nivel = 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")

*!*	gcAppPath=ADDBS(JUSTPATH(SYS(16,0))) && d:\contafin\cont2003\
Set Procedure To "D:\ROA\ROAGEST\COMUN\UTILE\web\WWUTILS.PRG" Additive
Set Procedure To "D:\ROA\ROAGEST\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;' + ;
	gcAppPath + 'COMUN\CLASE;' + ;
	gcAppPath + 'COMUN\FERESTRE;' + ;	
	gcAppPath + 'COMUN\PROGRAME;' + ;
	gcAppPath + 'COMUN\GRAFICE;' + ;
	gcAppPath + 'COMUN\RAPOARTE;' + ;
	gcAppPath + 'COMUN\MENIURI;' + ;
	gcAppPath + 'COMUN\UTILE\GRIDEXTRAS;' + ;			
    gcAppPath + 'COMUN\UTILE\CTL32;' + ;	
	gcAppPath + 'COMUN\UTILE\HPDF;' + ;		
	gcAppPath + 'COMUN\UTILE\HPDF\REPORTOUTPUT;' + ;			
	gcAppPath + 'COMUN\UTILE\WEB;' + ;
	gcAppPath + 'COMUN\UTILE\EXCEL;' + ;
	gcAppPath + 'COMUN\UTILE\NFJSON;' + ;
	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= gcAppPath + "comun\clase\appwiz"



*CLASE__________________________________________________________
SET CLASSLIB TO (lcMainClassLib) ADDITIVE
SET CLASSLIB TO GESTIUNI ADDITIVE
SET CLASSLIB TO CAUT ADDITIVE
*SET CLASSLIB TO FERESTREBAZA ADDITIVE
*SET CLASSLIB TO CONT2000-1 ADDITIVE
*SET CLASSLIB TO CONT2000-2 ADDITIVE
*SET CLASSLIB TO CONT2000-3 ADDITIVE
SET CLASSLIB TO BAZA ADDITIVE
SET CLASSLIB TO comun ADDITIVE
SET CLASSLIB TO accessibility.vcx ADDITIVE
*!* messagebox in romana - ar trebui bagat intr-o librarie de utilitati
*!* messagebox.vcx, functia amessagebox in oproceduri_comune, imagini mb_*.bmp, messagebox.h
SET CLASSLIB TO messagebox ADDITIVE
SET CLASSLIB TO registry ADDITIVE
SET CLASSLIB TO cauta_alfa_forms.vcx ADDITIVE 

&& CLASE ORACLE 
SET CLASSLIB TO DECABAZA ADDITIVE 
SET CLASSLIB TO onomenclatoare ADDITIVE 
SET CLASSLIB TO stocuri.vcx ADDITIVE 
SET CLASSLIB TO rulaje.vcx ADDITIVE 
SET CLASSLIB TO ointroduceri ADDITIVE 
SET CLASSLIB TO ointroduceri_web ADDITIVE 
SET CLASSLIB TO ointroduceri_depozit ADDITIVE
SET CLASSLIB TO overificari ADDITIVE 
SET CLASSLIB TO ferestre_oracle ADDITIVE 
SET CLASSLIB TO ferestre_cere_date.vcx ADDITIVE 
SET CLASSLIB TO configurare.vcx ADDITIVE
SET CLASSLIB TO serii_numere.vcx ADDITIVE 
SET CLASSLIB TO omodificari.vcx ADDITIVE 
SET CLASSLIB TO ocompensari.vcx ADDITIVE 
SET CLASSLIB TO caut_ora ADDITIVE 
SET CLASSLIB TO onote_contabile ADDITIVE 
SET CLASSLIB TO otoolbar ADDITIVE 
SET CLASSLIB TO bon_fisc ADDITIVE &&serii bonuri fiscale
SET CLASSLIB TO onom_articole ADDITIVE 
SET CLASSLIB TO onom_retete ADDITIVE 
Set Classlib To oinventar ADDITIVE 

SET CLASSLIB TO orapoarte ADDITIVE 
SET CLASSLIB TO orapoarte_gestiuni ADDITIVE 
SET CLASSLIB TO orapoarte_parametri ADDITIVE 
SET CLASSLIB TO ONOM_CURS ADDITIVE 

SET CLASSLIB TO ctl32_statusbar_fals.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_balloontip.vcx additive 
SET CLASSLIB TO ocriterii.vcx ADDITIVE
SET CLASSLIB TO oavize.vcx ADDITIVE 
SET CLASSLIB TO onomenclatoare2 ADDITIVE 
*!*	v 2.0.62
Set Classlib To oschimbare_pret.vcx additive
*!*	modificare	v 2.0.118
SET CLASSLIB TO wwdialogs.vcx additive
SET CLASSLIB TO oimportxml.vcx additive
SET CLASSLIB TO excelxml.vcx ADDITIVE 

SET CLASSLIB TO orapoarte_obinv.vcx ADDITIVE 

*!*	modificare	v 2.0.118	^
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

*PROCEDURI______________________________________________________
SET PROCEDURE TO PROCEDURI
SET PROCEDURE TO acces_meniu additive
SET PROCEDURE TO cauta_alfa additive
*SET PROCEDURE TO totPROC ADDITIVE
*SET PROCEDURE TO refverif ADDITIVE
*SET PROCEDURE TO PROCMENIU ADDITIVE
*SET PROCEDURE TO TOTV ADDITIVE
SET PROCEDURE TO pmenu ADDITIVE
SET PROCEDURE TO proceduri_comune ADDITIVE
*SET PROCEDURE TO totv.prg ADDITIVE 
SET PROCEDURE TO quitapp ADDITIVE
SET PROCEDURE TO init_program ADDITIVE
SET PROCEDURE TO oproceduri_listari.prg ADDITIVE 
SET PROCEDURE TO oproceduri_configurare.prg ADDITIVE 
SET PROCEDURE TO oproceduri_articole.prg ADDITIVE 
SET PROCEDURE TO oproceduri_retete.prg ADDITIVE 
SET PROCEDURE TO orapoarte.prg ADDITIVE 
SET PROCEDURE TO mesaje ADDITIVE 
SET PROCEDURE TO oserii_numere.prg ADDITIVE 
SET PROCEDURE TO oexport.prg ADDITIVE
SET PROCEDURE TO wwConfig.prg ADDITIVE
SET PROCEDURE TO proceduri_rapoarte.prg additive
SET PROCEDURE TO OPROCEDURI_CURS.PRG ADDITIVE 
Set procedure to orapoarte_dinamice.prg additive
SET PROCEDURE TO validare.prg 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 oinainte_de.prg ADDITIVE 
SET PROCEDURE TO ooperatii_comune.prg ADDITIVE 

SET PROCEDURE TO Ocompensari.PRG ADDITIVE 
SET PROCEDURE TO OPROCEDURI_aMS.PRG ADDITIVE 
SET PROCEDURE TO oproceduri_rulaje additive
SET PROCEDURE TO oproceduri_stocuri additive
SET PROCEDURE TO OINTRODUCERI ADDITIVE 
SET PROCEDURE TO oHeader.prg ADDITIVE
SET PROCEDURE TO proceduri_excel.PRG ADDITIVE 
SET PROCEDURE TO onomenclatoare.PRG ADDITIVE 
*!*	SET PROCEDURE TO orapoarte.prg ADDITIVE 
*!*	SET PROCEDURE TO orap_trezorerie ADDITIVE 
*!*	SET PROCEDURE TO omeniu_initializari ADDITIVE
SET PROCEDURE TO osecurity ADDITIVE 
SET PROCEDURE TO ocautare ADDITIVE 
SET PROCEDURE TO orefaceri ADDITIVE 
SET PROCEDURE TO ofacturare_comun.PRG ADDITIVE 
SET PROCEDURE TO ofacturare_stoc.PRG ADDITIVE 

&&	modificare 06.03
&&	casa de marcat
SET PROCEDURE TO oproceduri_casademarcat ADDITIVE 
SET PROCEDURE TO oproceduri_casa_marcat_e500 ADDITIVE 

&&	sfarsit modificare 06.03
SET PROCEDURE TO oproceduri_casa_marcat_mp500 ADDITIVE 
*!* 12.05.2006
*!* marius mutu
SET PROCEDURE TO oproceduri_util.prg ADDITIVE 
*!*

*!* 16.06.2006
*!* marius.mutu
SET PROCEDURE TO wwxmlhttp.prg ADDITIVE 
SET PROCEDURE TO ini.prg ADDITIVE 

*!* 25.08.2006
*!* marius.mutu
SET PROCEDURE TO odocumente.prg ADDITIVE 

*!* 28.05.2007 
*!* marius.mutu
SET PROCEDURE TO regex.prg ADDITIVE 
SET PROCEDURE TO wwutils.prg ADDITIVE 
SET PROCEDURE TO inchidere_k ADDITIVE 

*!*	v 2.0.62
Set procedure to oschimbare_pret.prg additive

*!*	modificare	v 2.0.118
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.118	^
SET PROCEDURE TO xdate.prg Additive		&&	modificare v 2.0.120
SET PROCEDURE TO ofacturare.prg ADDITIVE 	&&	modificare	v 2.0.142
SET PROCEDURE TO oproceduri_obinv.prg ADDITIVE && 2.6.0
SET PROCEDURE TO oproceduri_facturare.prg ADDITIVE 
SET PROCEDURE TO email.prg ADDITIVE 

*!*	modificare	v 2.0.188
Declare Integer GetPrivateProfileString In Kernel32 ;
	string, String, String, String @, Integer, String
Declare Integer WritePrivateProfileString In Kernel32 ;
	string, String, String, String
Declare Integer CopyFile In kernel32;
	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.0.188	^
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

IF PCOUNT() = 1 AND TYPE('tparam') = 'C'
	glParametri = .T.
	PRIVATE laParametri
	DECLARE LAPARAMETRI[1]
	lcParam = ALLTRIM(tParam)
	lnNr = lista2array(lcParam,@laParametri,";")
	IF lnNr < 5
		aMESSAGEBOX('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


*!*	PUBLIC gcAppPath,gcAppName, gcTempPath, gcCaleServerDate, gcUserNameApp, gcPasswordApp
*!*	STORE '' TO  gcUserNameApp, gcPasswordApp, gnNivelUtilizator, gnGrupUtilizator, gcAcces
*!*	PUBLIC gcSchemaPath
*!*	STORE '' TO gcSchemaPath 
*!*	*!* 10.09.2007
*!*	*!* marius.mutu
*!*	*!* folosesc shortpath ca sa pot instala in "c:\program files\..."
*!*	*!* gcAppPath = UPPER(ADDBS(JUSTPATH(SYS(16,0)))) && d:\contafin\cont2003\
*!*	gcAppPath = ADDBS(ShortPath(GetAppStartPath())) && wwutils.prg
*!*	gcAppName = ALLT(UPPE(JUSTSTEM(SYS(16,0)))) && "cont2003"
*!*	Set Path To Addbs(Substr(gcAppPath,1,Rat([\],gcAppPath,2)))+[COMUNROA\] Additive	&&	modificare	v 2.0.80

*!*	gcAppPath = STRTRAN(gcAppPath, "\PROGRAME", "")

*!*	gcUtilizatoriPath = gcAppPath + "UTILIZATORI\"

_reportpreview = gcAppPath + "reportpreview.app"

STORE "" TO gcTempPath, gcCaleServerDate





*** DIRGEN
liat=RAT("\",gcAppPath,2)
*!*	modificare 	v 2.0.141 : am adaugat gcDirMare
gcDirMare=ADDBS(LEFT(gcAppPath,liat-1))
dirgen = gcDirMare
*!*	modificare	v 2.0.141

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

CD &gcDirMare

Private gcGeneralIniFile, gcSettingsFile
gcGeneralIniFile = m.gcDirMare + "settings.ini"
gcSettingsFile = m.gcGeneralIniFile

IF !FILE(gcGeneralIniFile)

	TEXT TO lcSettings NOSHOW
[errors]
host=
	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  


PRIVATE 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	ROAGEST v 2.0.107
*!*	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	ROAGEST v 2.0.107	^
If Empty(m.lcLanguage)
	gcLocale = 'Romana'
Else
	gcLocale = m.lcLanguage
Endif
*!*	modificare	ROAGEST v 2.0.107
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	ROAGEST v 2.0.107	^
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
*!*		WAIT WINDOW 'lcParam ' +lcParam
*!*		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.1.1
*!*	PUBLIC tipar,SER_PERM,SER_PERI,VERSIUNE
*!*	STORE .F. TO SER_PERM,SER_PERI
*!*	modificare	v 2.1.1	^

***************************** VARIABILE ORACLE
PRIVATE goUtilizator
private gnHandle,gnidutil,GCCODFISCAL,GCADRESA,GCNUMEFIRMA,GCMONEDA,GNDIFZILE, gcUserNameApp, gcPasswordApp
PRIVATE gnButon		&& variabila pentru renunt si terminat
STORE 2 TO gnButon
STORE '' TO GCCODFISCAL,GCADRESA,GCNUMEFIRMA,GCMONEDA, gcUserNameApp, gcPasswordApp, gcNivelUtilizator, gcGrupUtilizator, 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

PRIVATE glUltimaLuna,glPrimaLuna, glLunaBuna,glLuna_neplatita,glLunaInchisa

STORE .F. to glUltimaLuna,glPrimaLuna, glLunaBuna,glLuna_neplatita,glLunaInchisa

***toolbar***
PRIVATE otool,ohelp 
STORE '' TO otool,ohelp 
***toolbar***

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 	

PRIVATE gcCopyRight
gcCopyRight = '<27> ROA Romfast SRL'

&&	modificare 06.03
&&	casa de marcat
PRIVATE glListareBonFiscal
STORE .F. TO glListareBonFiscal
&&	sfarsit modificare 06.03

&& obiect global wrap pt sqlexec cu text eroare si succes
PRIVATE goExecutor,goConn,goExport
goExecutor = CREATEOBJECT("oExecutor")
goConn = CREATEOBJECT("oConn")
goExport = Createobject("oExportConfig")

PRIVATE goMyXMLHTTP
lcHostErrors = getini(gcGeneralIniFile,'errors','host')
goMyXMLHTTP = CREATEOBJECT("MyXMLHTTP", lcHostErrors)

&& obiect global pt luna aleasa din calendar
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.1.1
*!*	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())))

*!*	*!* 22.02.2010
*!*	IF .F.
*!*		IF !_DEBUG()
*!*			IF SER_PERM AND !verif_ser_perm()
*!*				QUIT
*!*			ENDIF
*!*		ENDIF
*!*	ENDIF 
*!*	*!* 22.02.2010 ^
*!*	modificare	v 2.1.1	^

PUBLIC NUMEPROGRAM,FUNDALPROGRAM && MENIUPROGRAM




m.contab = 'GESIUNI'
NUMEPROGRAM = 'ROA - Gestiuni'
*!*	MENIUPROGRAM = gcAppPath + "meniuri\contGEST.mpr"
FUNDALPROGRAM = gcAppPath + "FERESTRE\FUNDAL.scx"
_program='gest'

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

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


*!* 20.04.2012
PRIVATE gcReportPreviewer, gcReportPreviewerPath
gcReportPreviewer = "FoxyPreview" && oexport.prg
gcReportPreviewerPath = dirgen + "COMUNROA\"
*!* 20.04.2012 ^


lcOnShutdown="ShutDown()"
ON SHUTDOWN &lcOnShutdown
ON ERROR ErrorHandler(ERROR(),PROGRAM(),LINENO())
*!*	_SHELL="DO Cleanup IN progs\cont2003"

*-- Instantiate application object.***************************
RELEASE goApp
PUBLIC goApp
goApp=CREATEOBJECT("wzApplication")

goApp.SetCaption(NUMEPROGRAM)
goApp.cStartupMenu = m.gcAppPath + "\meniuri\roagest.mpr"
*goApp.cStartupForm=FUNDALPROGRAM
goApp.cStartupForm = gcAppPath + "COMUN\ferestre\frm_login.scx"

*-- Show application.
goApp.SHOW



*-- Release application.
RELEASE goApp
cleanup()

*-- Restore default menu.
POP MENU _MSYSMENU


*-- Restore environment.
ON ERROR
ON SHUTDOWN
*!*	IF NOT lcLastSetClassLib==SET("classlib")
*!*		RELEASE CLASSLIB (lcMainClassLib)
*!*	ENDIF
*!*	IF EMPTY(lcLastSetPath)
*!*		SET PATH TO
*!*	ELSE
*!*		SET PATH TO &lcLastSetPath
*!*	ENDIF
*!*	IF lcLastSetTalk=="ON"
*!*		SET TALK ON
*!*	ELSE
*!*		SET TALK OFF
*!*	ENDIF

RETURN




* FUNCTII______________________________________________________________________
FUNCTION ErrorHandler(nError,cMethod,nLine)
	LOCAL lcErrorMsg,lcCodeLineMsg

	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

	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 + ;
		CHR(13) +CHR(10) + CHR(13) + CHR(10) + GETCALLSTACK()
		lcUserName = IIF(TYPE('gcUserNameApp') = 'C', gcUserNameApp, '')
		lcProgram = JUSTSTEM(SYS(16,0))
		goMyXMLHTTP.postError(lcErrorMsgHTTP, lcUserName, lcProgram)
	ENDIF 	
						
	IF _vfp.StartMode = 0
		DEBUG
		SUSPEND 
	ENDIF 	
	IF AMESSAGEBOX(lcErrorMsg,17,_SCREEN.CAPTION)#1
		ON ERROR
		RETURN .F.
	ENDIF
ENDFUNC



FUNCTION SHUTDOWN
*!*		IF start_nou()
*!*			=End_Istoric(gnIdIstoric, ADDBS(DIRGEN)+"DATERETEA\", "START_ISTORIC")
*!*		ENDIF 
	IF TYPE("goApp")=="O" AND NOT ISNULL(goApp)
		RETURN goApp.OnShutDown()
	ENDIF
	Cleanup()
	QUIT
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
*!*		IF (NOT FILE(calesys+'\diskserial.dll')) OR (NOT FILE(calesys+'\getmacip.dll')) OR (NOT FILE(calewin+'\comdir.snr'))
*!*			valret=.F.
*!*		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.
*!*			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.
*!*			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.
*!*				ENDIF
*!*			ENDIF
*!*			= FCLOSE(gnFileHandle)
*!*		ENDIF
*!*		seriedisk1=serdisk
*!*		serieinreg1=serinreg
*!*		ON ERROR valret=.F.
*!*		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