Parameters tparam

Private gcNumeProgram
Local lcStem
lcStem = Upper(Juststem(Sys(16,0)))
gcNumeProgram="ROAAUTO"
IF !LIKE(gcNumeProgram + '*', UPPER(ALLTRIM(JUSTSTEM(SYS(16,0)))))
	Messagebox("Nu puteti porni acest program!",0+16,"Atentie")
	RETURN 
ENDIF 

Local lchost, lcUserName, lcPassword, lnIdUtil, lnIdProgram, lcUserNameApp,lcPasswordApp
Store '' To lchost, lcUserName, lcPassword, lcUserNameApp,lcPasswordApp
Store 0 To lnIdUtil, lnIdProgram
_Screen.Icon = gcNumeProgram+".ico"

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 Hours To 24
Set Decimals To 4
_Screen.Visible=.F.
_Screen.AutoCenter=.T.

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

****************************************************************
*	VARIABILE
Public CRLF,CR,LF,Tab
Store Chr(13) + Chr(10) To CRLF
CR=Chr(13)
LF=Chr(10)
Tab=Chr(9)

Public pcTitlu,pl_verificat
Store "" To pcTitlu
Store .F. To pl_verificat
***********************************************************************************
** Variabile vechi
Declare nror[65000]
Public pcNl,pcAn
PUBLIC buton,primadata,dirgen,m.ctva,m.ctvam,m.ctvai,m.den
Store "" To pcNl,pcAn,m.den  && se initializeaza in start00
Store 1 To BUTON,col_menu
STORE .T. TO primadata
***********************************************************************************
*** DECLARATII DE VARIABILE PUBLICE
***********************************************************************************
*-- Save and configure environment.***********************
lcLastSetTalk=Set("TALK")
Set Talk Off
lcLastSetPath=Set("PATH")

Set Procedure To "d:\ROA\ROAAUTO\COMUN\UTILE\web\WWUTILS.PRG" Additive
Set Procedure To "d:\ROA\ROAAUTO\COMUN\UTILE\web\WWAPI.PRG" Additive

PRIVATE gcAppPath,gcAppName,gcTempPath, gcCaleServerDate, gcUserNameApp, gcPasswordApp,gcDirMare	&&	gcAppDataPath
Store '' To  gcUserNameApp, gcPasswordApp, gcAcces	&& gnNivelUtilizator, gnGrupUtilizator
Public gcSchemaPath, gcAntet
Store '' To gcSchemaPath, gcAntet

gcAppPath = Addbs(ShortPath(GetAppStartPath()))
If Right(gcAppPath ,9)="PROGRAME\"
	gcAppPath = Substr(gcAppPath ,1,Len(gcAppPath )-9)
Endif
gcAppName=Allt(Uppe(Juststem(Sys(16,0))))
gcUtilizatoriPath = gcAppPath + "UTILIZATORI\"

Set Default To (gcAppPath)
lcPath = gcAppPath + 'Date;' + ;
	gcAppPath + 'Include;' + ;
	gcAppPath + 'FERESTRE;' + ;
	gcAppPath + 'GRAFICE;' + ;
	gcAppPath + 'CLASE;' + ;
	gcAppPath + 'MENIURI;' + ;
	gcAppPath + 'PROGRAME;' + ;
	gcAppPath + 'RAPOARTE;' + ;
	gcAppPath + 'COMUN\CLASE;' + ;
	gcAppPath + 'COMUN\FERESTRE;' + ;	
	gcAppPath + 'COMUN\PROGRAME;' + ;
	gcAppPath + 'COMUN\GRAFICE;' + ;
	gcAppPath + 'COMUN\RAPOARTE;' + ;
    gcAppPath + 'COMUN\UTILE\GRIDEXTRAS;' + ;	
    gcAppPath + 'COMUN\UTILE\EXCEL;' + ;	
    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 &lcPath ADDITIVE 

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

PUSH Menu _Msysmenu
lcLastSetClassLib=Set("CLASSLIB")
lcMainClassLib = m.gcAppPath + "COMUN\clase\appwiz.vcx"

****************************************************************
*	CLASE
Set Classlib To (lcMainClassLib) Additive
Set Classlib To baza Additive
Set Classlib To CAUT Additive
*!*	Set Classlib To FERESTREBAZA Additive
****************************************************************
Set Classlib To registry Additive
Set Classlib To odevize Additive
Set Classlib To decabaza Additive
Set Classlib To onomenclatoare Additive
Set Classlib To onom_devize Additive
Set Classlib To oviz_devize Additive
Set Classlib To cauta_alfa_forms Additive
*!*	Set Classlib To ointroduceri Additive
Set Classlib To ferestre_oracle Additive
Set Classlib To caut_ora Additive
Set Classlib To Messagebox Additive
SET CLASSLIB TO otoolbar ADDITIVE 
SET CLASSLIB TO serii_numere ADDITIVE 
SET CLASSLIB TO stocuri additive
SET CLASSLIB TO ctl32_statusbar_fals.vcx additive
SET CLASSLIB TO ocriterii.vcx additive
*!*	modificare v 2.0.6
SET CLASSLIB TO wwdialogs.vcx additive
*!*	modificare v 2.0.6	^
SET CLASSLIB TO comun.vcx additive
SET CLASSLIB TO gridextras.vcx additive
SET CLASSLIB TO ferestre_cere_date.vcx ADDITIVE		&&	modificare	v 2.0.28
SET CLASSLIB TO onom_articole.vcx ADDITIVE			&&	modificare	v 2.0.41
SET CLASSLIB TO overificari.vcx ADDITIVE			&&	modificare	v 2.1.2
SET CLASSLIB TO accessibility.vcx additive
****************************************************************
*	PROCEDURI
Set Procedure To ooperatii_comune Additive
Set Procedure To quitapp Additive
Set Procedure To init_program Additive
Set Procedure To proceduri_comune Additive
*!*	modificare	v 2.0.1
*!*	Set Procedure To oproceduri_casa_marcat_e500 Additive
Set Procedure To controllerecr Additive
*!*	modificare	v 2.0.1	^
Set Procedure To oproceduri_comune Additive
Set Procedure To gencursor.prg Additive
Set Procedure To updateserver.prg Additive
Set Procedure To update_devize.prg Additive
Set Procedure To update_nomenclator.prg Additive
Set Procedure To onom_devize.prg Additive
Set Procedure To onomenclatoare Additive
Set Procedure To proceduri Additive
Set Procedure To oproceduri_ams Additive
Set Procedure To oproceduri_vizualizare Additive
Set Procedure To ocautare Additive
Set Procedure To oproceduri_devize Additive
Set Procedure To oproceduri_listari Additive
Set Procedure To oproceduri_facturare ADDITIVE 
SET PROCEDURE TO email ADDITIVE 
Set Procedure To oinit_optiuni Additive
Set Procedure To osecurity Additive
Set Procedure To pmenu Additive
Set Procedure To acces_meniu Additive
Set Procedure To wwxmlhttp.prg Additive
Set Procedure To ini.prg Additive
Set Procedure To oserii_numere.prg Additive
Set Procedure To oheader.prg Additive
Set Procedure To cauta_alfa.prg Additive
Set Procedure To suma_in_vorbe Additive
Set Procedure To wwutils.prg Additive
SET PROCEDURE TO oserii_numere.prg additive
SET PROCEDURE TO oexport.prg additive
SET PROCEDURE TO wwconfig.prg additive
*!*	modificare v 2.0.6
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
SET PROCEDURE TO xdate.prg Additive
SET PROCEDURE TO validare.prg Additive
SET PROCEDURE TO regex.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
*!*	modificare v 2.0.6	^
*!*	modificare v 2.0.8
Set Procedure To ofacturare.prg Additive
Set Procedure To ofacturare_comun.prg Additive
*!*	modificare v 2.0.8	^
***********************************************************************************
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.



Store "" To gcTempPath, gcCaleServerDate

*!*	modificare v 2.0.6
*!*	If !Directory(gcAppDataPath)
*!*		Md (gcAppDataPath)
*!*	Endif
*!*	modificare v 2.0.6	^
***********************************************************************************
*** DIRGEN

liat = Rat("\",gcAppPath,2)
gcDirMare = Addbs(Left(gcAppPath,liat-1))
dirgen = gcDirMare

*!*	modificare	v 2.1.9
PRIVATE gcReportPreviewer, gcReportPreviewerPath
gcReportPreviewer = "FoxyPreview" && oexport.prg
gcReportPreviewerPath = gcDirMare + "COMUNROA\"
*!*	modificare	v 2.1.9	^

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

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

*!*	modificare 21.06
PRIVATE gcGeneralIniFile,gcSettingsFile
gcGeneralIniFile = m.gcDirMare + "settings.ini"
gcSettingsFile = m.gcGeneralIniFile
IF !FILE(gcGeneralIniFile)
	TEXT TO lcSettings NOSHOW
	[errors]
	host=http://83.103.197.79:3000/errors/create_xml
	ENDTEXT 
	STRTOFILE(lcSettings, gcGeneralIniFile)
ENDIF 
*!*	^

Public glQuit
glQuit = .F.
Public gnIdIstoric
gnIdIstoric = 0

*!*	modificare	v 2.1.9
Private gcLocalePath, goLocale, gcLocale
gcLocalePath = gcAppPath + "Locale\"
lcLanguage = getini(gcGeneralIniFile,"locale","lang")
llLocale= getini(gcGeneralIniFile,"locale","llocale")
If Empty(m.lcLanguage)
	gcLocale = 'Romana'
Else
	gcLocale = m.lcLanguage
Endif
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
goLocale.locale = gcLocale
*!*	If verificari()
*!*		_Screen.Visible=.T.
*!*		aMessagebox("Se fac verificari programului!"+CRLF+"Va rugam reveniti!",64,"ROA FACTURARE")
*!*		glQuit= .T.
*!*		Quit
*!*	Endif
*!*	If !Debug_Start()
*!*		lcParam=tparam
*!*		If Empty(tparam) Or (Type('tParam')='C' And !verific_start(tparam,gcDirMare,gcAppName))
*!*			_Screen.Visible=.T.
*!*			aMessagebox("Programul trebuie pornit doar din START!",64,"ROA FACTURARE")
*!*			Quit
*!*		Endif
*!*	Endif
*!*	modificare	v 2.1.9	^

*** verificare serie permanenta
*!*	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, gcUserNameApp, gcPasswordApp,  gcAcces
gnHandle = -1
gnidutil = 0
Private gcHost, gcUserName, gcPassword, gofundal, gnIdProgram, gnId_prg_owner
gnId_prg_owner = 0
gnIdProgram = 0
gofundal=''

PRIVATE gcCopyRight
gcCopyRight = '© ROA Romfast SRL'

Private goFirma,gnIdFirma,gcFirma,gnAn,gnLuna && ,gnPA,gnPC,gnId_Firma
&& STORE 0 TO gnPA,gnPC && nr. de zecimale afisare, calcul
Store Null To goFirma
Store 0 To gnAn,gnLuna,gnIdFirma	&&	,gnId_Firma
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 '' To gcS

*!*	modificare	v 2.0.28
PUBLIC glFontCharSet
glFontCharSet = AFONT(laFontCharSet,"Arial Narrow",238)
*!*	modificare	v 2.0.28	^

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])			&&	modificare	v 2.0.29
	ENDIF 	
ENDIF 	

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

Private goConn
goConn = Createobject("oConn")
*!*	modificare	v 2.0.2
Private goExport
goExport = CREATEOBJECT("oExportConfig")
*!*	modificare	v 2.0.2	^

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

*!*	modificare	v 2.0.1
PRIVATE goControllerEcr
goControllerEcr = CreateObject('oControllerEcr')
*!*	modificare	v 2.0.1	^

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

*!*	If !_DEBUG()
*!*		If SER_PERM And !verif_ser_perm()
*!*			Quit
*!*		Endif
*!*	Endif

*!*	Public cales,eserver,loc,numestatie
*!*	eserver=.F.
*!*	Store '' To cales,loc,numestatie

Public NUMEPROGRAM,MENIUPROGRAM,FUNDALPROGRAM
NUMEPROGRAM='ROAAUTO'
*!*			MENIUPROGRAM=gcAppPath+"meniuri\cont2000.mpr"
*!*			FUNDALPROGRAM=gcAppPath+"FERESTRE\FUNDAL.scx"
_program='roaauto'

*!*	*** 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 roaauto.prg"

*-- 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\roaauto"
goApp.cStartupForm = m.gcAppPath + 'COMUN\ferestre\frm_login.scx'

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

*-- Restore default menu.
Pop Menu _Msysmenu

*-- Restore environment.
On Error
On Shutdown
If Not lcLastSetClassLib==Set("classlib")
	Release Classlib (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

*!*	modificare 21.06
If Type('goMyXMLHTTP') = 'O'
	lcErrorMsg =  Sys(0) + ":" + Iif(Type('GCS')='C'," " + GCS,"") + Chr(13) +Chr(10) + lcErrorMsg
	lcUserName = gcUserNameApp
	lcProgram = Juststem(Sys(16,0))
	goMyXMLHTTP.postError(lcErrorMsg, lcUserName, lcProgram)
Endif
*!*	^

If AMessagebox(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()
************************************************************************************
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
************************************************************************************