*!* 24.04.2012
*!* nu se mai verifica seria HDD

PARAMETERS tparam
&&& roaimob
LOCAL lchost, lcUserName, lcPassword, lnIdUtil, lnIdProgram, lcUserNameApp,lcPasswordApp
STORE '' TO lchost, lcUserName, lcPassword, lcUserNameApp,lcPasswordApp
STORE 0 TO lnIdUtil, lnIdProgram
PRIVATE gcNumeProgram
gcNumeProgram = [ROAIMOB]
_SCREEN.ICON = gcNumeProgram + [.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 NULLDISPLAY TO '*'
SET NULLDISPLAY TO ''
SET DECIMALS TO 4
SET POINT TO '.'

_SCREEN.VISIBLE=.F.

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

*VARIABILE__________________________________________________________________________
DECLARE nror[65000]
PUBLIC CRLF
STORE CHR(13) + CHR(10) TO CRLF
*!*	PUBLIC pcNl,pcAn
*!*	STORE "" TO pcNl,pcAn  && se initializeaza in start00

PUBLIC pcTitlu,pl_verificat,pcdurata
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 buton,primadata,dirgen,col_menu,gestiune,gcAntet, m.antet
*!*	Public OStart,OSETVIZ,OSETTULBAR,OSETINSTRUM,orm,OTEXT,OJUR,osetgest,tlbr_INSTR,tlbr_VIZ,oprinc,DIRGEN,buton
*!*	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")

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

Set Procedure To "D:\ROA\ROAIMOB\COMUN\UTILE\web\WWUTILS.PRG" Additive
Set Procedure To "D:\ROA\ROAIMOB\COMUN\UTILE\web\WWAPI.PRG" Additive

gcAppPath = ADDBS(ShortPath(GetAppStartPath())) && wwutils.prg
If Right(gcAppPath ,9)="PROGRAME\"
	gcAppPath = Substr(gcAppPath ,1,Len(gcAppPath )-9)
Endif
gcAppName=ALLT(UPPE(JUSTSTEM(SYS(16,0))))	&& "roaimob"

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;' + ;	
	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 + "clase\oimobilizari.vcx"

STORE "" TO gcTempPath, gcCaleServerDate

*** DIRGEN
liat = RAT("\",gcAppPath,2)
dirgen = ADDBS(LEFT(gcAppPath,liat-1))
*!*	v 2.0.17
PUBLIC gcDirMare
gcDirMare = dirgen
*!*	v 2.0.17	^

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


*CLASE__________________________________________________________
SET CLASSLIB TO (lcMainClassLib) ADDITIVE
SET CLASSLIB TO registry ADDITIVE
SET CLASSLIB TO cauta_alfa_forms ADDITIVE
SET CLASSLIB TO caut_ora ADDITIVE
SET CLASSLIB TO ofundal_imob ADDITIVE

SET CLASSLIB TO serii_numere ADDITIVE 
*PROCEDURI______________________________________________________
*!*	Set Procedure To proceduri Additive
*!*	Set Procedure To pmenu Additive
SET PROCEDURE TO proceduri_comune ADDITIVE
SET PROCEDURE TO sitan ADDITIVE
SET PROCEDURE TO quitapp ADDITIVE
SET PROCEDURE TO init_program ADDITIVE
SET PROCEDURE TO oproceduri_listari ADDITIVE
SET PROCEDURE TO proceduri_meniu ADDITIVE
*!* 11.11.2009
SET PROCEDURE TO oserii_numere ADDITIVE 
*!* 11.11.2009 ^

SET PROCEDURE TO regex ADDITIVE 

&& CLASE ORACLE
SET CLASSLIB TO DECABAZA ADDITIVE
SET CLASSLIB TO onomenclatoare ADDITIVE
SET CLASSLIB TO ferestre_oracle ADDITIVE
SET CLASSLIB TO onom_imob ADDITIVE
SET CLASSLIB TO otoolbar ADDITIVE
SET CLASSLIB TO ocriterii ADDITIVE

SET CLASSLIB TO MESSAGEBOX ADDITIVE
*!*	v 2.0.17
SET CLASSLIB TO wwdialogs.vcx additive
*!*	v 2.0.17	^

*!* 11.11.2009
SET CLASSLIB TO serii_numere.vcx ADDITIVE 
*!* 11.11.2009 ^

SET CLASSLIB TO accessibility.vcx ADDITIVE 

************************************************************************************************
&& PROCEDURI ORACLE
SET PROCEDURE TO gencursor.prg ADDITIVE
SET PROCEDURE TO oproceduri_comune.prg ADDITIVE
SET PROCEDURE TO oproceduri_imob.prg ADDITIVE
SET PROCEDURE TO oproceduri_operatii.prg ADDITIVE
SET PROCEDURE TO ofunctii_imob.prg ADDITIVE
SET PROCEDURE TO oinit_optiuni.prg ADDITIVE
SET PROCEDURE TO update_imob.prg ADDITIVE
SET PROCEDURE TO updateserver.prg ADDITIVE
SET PROCEDURE TO oproceduri_ams.prg ADDITIVE
SET PROCEDURE TO ocautare.prg ADDITIVE
SET PROCEDURE TO osecurity.prg ADDITIVE
SET PROCEDURE TO acces_meniu.prg ADDITIVE
SET PROCEDURE TO oheader.prg ADDITIVE
*!* 12.07.2006
*!* marius.mutu
SET PROCEDURE TO oproceduri_comune_imob.prg ADDITIVE
*!*	19feb2009
*!*	liana.neagu
Set Procedure To cauta_alfa.prg ADDITIVE 

SET PROCEDURE TO oexport.prg ADDITIVE 

*!*	v 2.0.17
Set Procedure To validare.prg ADDITIVE 
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 

*!* 19.06.2006
*!* marius.mutu
SET PROCEDURE TO wwxmlhttp.prg ADDITIVE
SET PROCEDURE TO ini.prg ADDITIVE
SET PROCEDURE TO wwconfig.prg ADDITIVE
*!*	SET PROCEDURE TO wwutils.prg ADDITIVE
*!*	SET PROCEDURE TO wwapi.prg ADDITIVE
SET PROCEDURE TO excelxml.prg ADDITIVE 

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
*!*	v 2.0.17	^
*******************************************************************************************

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


PRIVATE gcGeneralIniFile, gcSettingsFile
gcGeneralIniFile = ADDBS(m.dirgen) + "settings.ini"
gcSettingsFile = m.gcGeneralIniFile
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, glTraducere
glTraducere = .F.
gcLocalePath = gcAppPath + "Locale\"
*!*	lcLocaleDb = gcLocalePath + "locale.dbc"
*!*	Open Database (m.lcLocaleDb)
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 
If Empty(m.lcLanguage)
	gcLocale = 'Romana'
Else
	gcLocale = m.lcLanguage
Endif
goLocale.locale = gcLocale
*!* Locale ^
IF verificari()
	_SCREEN.VISIBLE=.T.
	MESSAGEBOX("Se fac verificari programului!"+CRLF+"Va rugam reveniti!",64,"ROA Imobilizari")
	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.
		MESSAGEBOX("Programul trebuie pornit doar din START!",64,"ROA Imobilizari")
		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'

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

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


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


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

PUBLIC NUMEPROGRAM,MENIUPROGRAM,FUNDALPROGRAM
MODEL_PROGRAM = 'M'
NUMEPROGRAM='ROA Imobilizari '+MODEL_PROGRAM
MENIUPROGRAM=gcAppPath+"meniuri\roaimob.mpr"
FUNDALPROGRAM=gcAppPath+"FERESTRE\FUNDAL.scx"
_program='cont'

*-- Configure application object.*****************************
_SCREEN.WINDOWSTATE=2

*!* 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("cApplication")
* 10.06.2020 mod experimental se citeste din optiuni utilizator
ADDPROPERTY(goApp, 'nExperimental', 0)

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
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 = gcUserNameApp
		lcProgram = JUSTSTEM(SYS(16,0))
		goMyXMLHTTP.postError(lcErrorMsgHTTP, lcUserName, lcProgram)
	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 .T.
*!*	*!*		RETURN 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
************************************************************************************************
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