Parameters tparam


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

Public gnewcryptfll
Public gnewcryptxml
gnewcryptfll=.F.
gnewcryptxml=.F.

Local lchost, lcUserName, lcPassword, lnIdUtil, lnIdProgram, lcUserNameApp,lcPasswordApp
Store '' To lchost, lcUserName, lcPassword, lcUserNameApp,lcPasswordApp
Store 0 To lnIdUtil, lnIdProgram

Public gcNumeProgram
gcNumeProgram = [ROAPRETURI]
_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 Exclusive Off
Set Cpdialog Off
Set Talk Off
Set Safety Off
Set Escape Off
Set Exact On
Set Mark To '/'
Set Ansi On
Set Console Off
Set Notify Off
Set Seconds Off
Set NullDisplay To ''
Set Decimals To 4
* _SCREEN.VISIBLE=.F.
_Screen.AutoCenter=.T.



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


*VARIABILE__________________________________________________________________________
Declare nror[65000]
Declare RTVA[22,2]



Public CRLF,CR,LF,Tab
Store Chr(13) + Chr(10) To CRLF
Public pcNl,pcAn
Store "" To pcNl,pcAn  && se initializeaza in start00
CR=Chr(13)
LF=Chr(10)
Tab=Chr(9)

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


*** DECLARATII DE VARIABILE PUBLICE

*-- 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\ROAPRETURI\COMUN\UTILE\web\WWUTILS.PRG" Additive
Set Procedure To "D:\ROA\ROAPRETURI\COMUN\UTILE\web\WWAPI.PRG" Additive

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

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;' + ;
	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 ooptiuni Additive
Set Classlib To registry Additive
Set Classlib To decabaza Additive
Set Classlib To cauta_alfa_forms Additive
Set Classlib To ferestre_oracle Additive
Set Classlib To ofundal_roapreturi Additive
Set Classlib To onom_preturi Additive
Set Classlib To onote_contabile Additive
Set Classlib To otoolbar Additive
Set Classlib To onom_articole.vcx Additive

Set Classlib To Messagebox Additive
*!*	modificare v 2.0.10
Set Classlib To wwdialogs.vcx Additive
*!*	modificare v 2.0.10	^

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 accessibility.vcx Additive

*PROCEDURI______________________________________________________
Set Procedure To quitapp Additive
Set Procedure To init_program Additive
Set Procedure To oproceduri_comune Additive
Set Procedure To gencursor.prg Additive
Set Procedure To updateserver.prg Additive
Set Procedure To update_nomenclator.prg Additive
Set Procedure To onomenclatoare Additive
Set Procedure To oproceduri_ams Additive
Set Procedure To ocautare Additive
Set Procedure To oinit_optiuni Additive
Set Procedure To osecurity Additive
Set Procedure To omeniu_initializari Additive
Set Procedure To acces_meniu Additive
Set Procedure To oheader Additive
Set Procedure To onom_preturi Additive
Set Procedure To proceduri_excel.prg Additive
Set Procedure To oproceduri_articole.prg Additive
Set Procedure To cauta_alfa.prg Additive

Set Procedure To oserii_numere.prg Additive
*!* 19.06.2006
*!* marius.mutu
Set Procedure To wwxmlhttp.prg Additive
Set Procedure To ini.prg Additive
Set Procedure To wwutils.prg Additive
Set Procedure To wwapi.prg Additive
*!*	modificare v 2.0.10
Set Procedure To filebringer.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 wwcodeupdate.prg Additive
Set Procedure To wwhttp.prg Additive
Set Procedure To xmlaccess.prg Additive
Set Procedure To xmlparser.prg Additive
*!*	modificare v 2.0.10	^
*!*	modificare v 2.0.18
Set Procedure To wwconfig.prg Additive
Set Procedure To oexport.prg Additive
Set Procedure To _libpdf.prg Additive
Set Procedure To frxoutput.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
*!*	modificare v 2.0.18	^
Set Procedure To regex.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
		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



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

*!*	gcAppPath = ADDBS(ShortPath(GetAppStartPath())) && wwutils.prg
*!*	gcAppName=ALLT(UPPE(JUSTSTEM(SYS(16,0))))

*!*	gcAppDataPath=gcAppPath+"Date_"+gcAppName+"\"
gcUtilizatoriPath = gcAppPath + "UTILIZATORI\"

Store "" To gcTempPath, gcCaleServerDate

*!*	IF !DIRECTORY(gcAppDataPath)
*!*		MD (gcAppDataPath)
*!*	ENDIF
*---------------------------------------
*** DIRGEN
Public gcDirMare
liat=Rat("\",gcAppPath,2)
gcDirMare = Addbs(Left(gcAppPath,liat-1))
DIRGEN = gcDirMare
Cd &DIRGEN
gcSecurityPath = DIRGEN + 'Security\'
gcSecurityFile = gcSecurityPath + 'ROA_SECURITY.TXT'

Private gcGeneralIniFile, gcSettingsFile
gcGeneralIniFile = 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

*!*	public poLog && obiect pt logarea mesajelor sistemului
*!*	poLog = NEWOBJECT("Log_Mesaje","Log_Mesaje.prg")


Public glQuit
glQuit = .F.

Public gnIdIstoric
gnIdIstoric = 0

If verificari()
	_Screen.Visible=.T.
* DO mesaj WITH "Se fac verificari programului","Va rugam reveniti"
	AMESSAGEBOX("Se fac verificari programului",0+48,"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",""
		AMESSAGEBOX("Programul trebuie pornit doar din START",0+48,"")
		Quit
	Endif
Endif

*!*	modificare	v 2.0.18
*!*	*** verificare serie permanenta
*!*	PUBLIC tipar,SER_PERM,SER_PERI,VERSIUNE
*!*	STORE .F. TO SER_PERM,SER_PERI
*!*	modificare	v 2.0.18	^

***************************** 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
Store 0 To gnIdProgram, gnId_prg_owner
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

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

Private gcCopyRight, gcAntet,goExport
gcCopyRight = '© ROA Romfast SRL'
gcAntet = []
goExport = Createobject("oExportConfig")		&&	modificare	v 2.0.18
***toolbar***
Private otool,ohelp
Store '' To otool,ohelp
***toolbar***

Private gcS  && schema firmei
Store 'DEMO' 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

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

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

*!*	IF glParametri
*!*		gcHost = lcHost
*!*		gcUserName = lcUserName
*!*		gcPassword = lcPassword
*!*		gcUserNameApp = lcUserNameApp
*!*		gcPasswordApp = lcPasswordApp
*!*		gnIdUtil = lnIdUtil
*!*		gnIdProgram = lnIdProgram
*!*	ELSE
*!*		gcHost = "jcsserver"
*!*		gcUserName = "contafin_ORACLE"
*!*		gcPassword = "123"
*!*		gcUserNameApp = ''
*!*		gcPasswordApp = ''
*!*		gnIdUtil = 1
*!*		gnIdProgram = 8
*!*	ENDIF
***************************** VARIABILE ORACLE



*!*	USE &gcAppPath\SER 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())))
*!*	modificare	v 2.0.18
*!*	IF !_DEBUG()
*!*		IF SER_PERM AND !verif_ser_perm()
*!*			QUIT
*!*		ENDIF
*!*	ENDIF
*!*	PUBLIC cales,eserver,loc,numestatie
*!*	eserver=.F.
*!*	STORE '' TO cales,loc,numestatie
*!*	modificare	v 2.0.18	^
Public NUMEPROGRAM,MENIUPROGRAM,FUNDALPROGRAM

NUMEPROGRAM='ROAPRETURI'
*!*			MENIUPROGRAM=gcAppPath+"meniuri\cont2000.mpr"
*!*			FUNDALPROGRAM=gcAppPath+"FERESTRE\FUNDAL.scx"
_program='roapreturi'

*** INITIALIZEZ CAI DATE
If .F.
	If !Start_Nou()
		_Screen.WindowState=2
		Cd \
		If !Directory('c:\contafin')
			Md contafin
		Endif
		Cd c:\contafin\
		If !Directory('temp')
			Md temp
		Endif


		Sele 0
		Use c:\contafin\temp\ceprogram Alias ceprogram
		Scat Memv
*wait wind m.util
		Sele ceprogram
		Use
		utilizator=m.UTIL
		GRUPUL=M.nrgrup
		If M.nrgrup=0
			E_UN_SUPERVIZOR=.T.
		Else
			E_UN_SUPERVIZOR=.F.
		Endif

		If File('&DIRGEN\START2000\DATA\RETEA.DBF')
			If !File('c:\contafin\temp\RETEA.dbf')
				Copy File &DIRGEN\START2000\Data\RETEA.* To c:\contafin\temp\RETEA.*
			Endif
			Sele 0
			Use c:\contafin\temp\RETEA
			eserver=Server
			cales=Allt(CALESERVER)
			Use In RETEA
		Endif
	Else

		gcTempPath = Init_Cale_Temp(DIRGEN)
		If !Directory(gcTempPath)
			Md (gcTempPath)
		Endif

		cales = Init_Cale_Server_Date(DIRGEN)
		eserver = .T.
		numestatie = Init_Nume_Statie(DIRGEN)
		utilizator = Init_Nume_Utilizator(DIRGEN)
		m.nivel = Round(Val(Init_Nivel_Utilizator(DIRGEN)),0)
		m.CONTAB = Upper(Alltrim(Init_NumeAlternativ(DIRGEN)))

		lcQuitData = Alltrim(DIRGEN)+"\dateretea"
		lcQuitName = "start_quitapp"
		Private goQuitApp				&& I'm making it private so it will die with the application.
		goQuitApp = quitapp(lcQuitData,lcQuitName)

		gnIdIstoric = Start_Istoric(m.utilizator, gcAppName, numestatie, Addbs(DIRGEN)+"DATERETEA\", "START_ISTORIC","start_ids")


	Endif
Endif

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

*-- Instantiate application object.***************************
Release goApp
Public goApp
goApp=Createobject("wzapplication")

*-- Configure application object.*****************************
*!*	goApp.SetCaption("DEVIZE")
Local laVersion
Dimension laVersion(12)
If Agetfileversion(laVersion, Sys(16,0)) > 0
	NUMEPROGRAM = laVersion(10)
Endif
Release laVersion

goApp.SetCaption(NUMEPROGRAM)
goApp.cStartupMenu= m.gcAppPath + "meniuri\RoaPreturi"
*!*	goApp.cStartupForm=DIRGEN+"\devize\FERESTRE\FUNDAL"

goApp.cStartupForm = gcAppPath + 'comun\ferestre\frm_login.scx'

_Screen.WindowState = 2
*!*	_SCREEN.MaxButton = .F.
*!*	_SCREEN.BorderStyle = 1

*-- 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 Messagebox(lcErrorMsg,17,_Screen.Caption)#1
		On Error
		Return .F.
	Endif
Endfunc



Function Shutdown

	=End_Istoric(gnIdIstoric, Addbs(DIRGEN)+"DATERETEA\", "START_ISTORIC")
	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]

	lcLog = '1 ' + lcfisier
	poLog.Log(lcLog,Program())

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

		lcLog = Transform(LNVAL1) + ' ' + Transform(lnval2)
		poLog.Log(lcLog,Program())

		If LNVAL1=1 Or Year(Date())-Month(Date())=lnval2
			lcret=.T.
		Endif
	Endif

	lcLog = Transform(lcret)
	poLog.Log(lcLog,Program())

	Return lcret

Endproc


Function Start_Nou
*!*		llExista_Branch = Exista_Branch(,,dirgen)

*!*		lcLog = TRANSFORM(llExista_Branch)
*!*		poLog.log(lcLog,PROGRAM())
	Return Exista_Branch(,,DIRGEN)
	Return llExista_Branch

Endfunc && start_nou

Procedure Debug_Start

	lcFile = gcAppPath + "debug.txt"
	If File(lcFile)
		lcLog = 'debug_start'
		poLog.Log(lcLog,Program())
	Else
		lcLog = '!debug_start'
		poLog.Log(lcLog,Program())
	Endif

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

Procedure myinstance
	Parameters myApp
	=Ddesetoption("SAFETY",.F.)
	ichannel = Ddeinitiate(myApp,"ZOOM")
	If ichannel =>0
		=Ddeterminate(ichannel)
		Quit
	Endif
	=Ddesetservice(myApp,"define")
	=Ddesetservice(myApp,"execute")
	=Ddesettopic(myApp,"","ddezoom")
	Return
******************************************
Procedure ddezoom
	Parameter  ichannel,saction,sitem,sdata,sformat,istatus
	Zoom Window Screen Norm
	Return
**********************************************************
** EOF
**********************************************************