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
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")

SET PATH TO ;DATE;INCLUDE;FERESTRE;GRAFICE;HELP;CLASE;MENIURI;PROGRAME;RAPOARTE;PROGS;LIBS;
	PUSH MENU _MSYSMENU
lcLastSetClassLib=SET("CLASSLIB")
lcMainClassLib="clase\cont2000"



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

*!*	v 2.0.62
Set Classlib To oschimbare_pret.vcx additive
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

*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

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

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)
DIRGEN=ADDBS(LEFT(gcAppPath,liat-1))

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

CD &DIRGEN

PRIVATE gcGeneralIniFile
gcGeneralIniFile = DIRGEN + "settings.ini"
IF !FILE(gcGeneralIniFile)

	TEXT TO lcSettings NOSHOW
[errors]
host=
	ENDTEXT 

	STRTOFILE(lcSettings, gcGeneralIniFile)
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
gcLocalePath = gcAppPath + "Locale\"
*!*	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





PUBLIC tipar,SER_PERM,SER_PERI,VERSIUNE
STORE .F. TO SER_PERM,SER_PERI


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


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()
		QUIT
	ENDIF
ENDIF

PUBLIC NUMEPROGRAM,MENIUPROGRAM,FUNDALPROGRAM




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


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("cApplication")

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

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

	RETURN .T.

	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