Marius Mutu
77e98d73e9
Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com> Claude-Session: https://claude.ai/code/session_015husoVS24ewJZr21ZoVR3v
982 lines
25 KiB
Plaintext
982 lines
25 KiB
Plaintext
*!* 17.03.2011
|
|
*!* marius.mutu
|
|
*!* nu se mai verifica seria hdd
|
|
|
|
Parameters tparam
|
|
|
|
Local lchost, lcUserName, lcPassword, lnIdUtil, lnIdProgram, lcUserNameApp,lcPasswordApp
|
|
Store '' To lchost, lcUserName, lcPassword, lcUserNameApp,lcPasswordApp
|
|
Store 0 To lnIdUtil, lnIdProgram
|
|
Private gcNumeProgram
|
|
gcNumeProgram=[ROADEF]
|
|
If !Like(gcNumeProgram + '*', Upper(Alltrim(Juststem(Sys(16,0)))))
|
|
Messagebox("Nu puteti porni acest program!",0+16,"Atentie")
|
|
Return
|
|
Endif
|
|
_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 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,gnid_prg_owner
|
|
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")
|
|
|
|
Public gcAppPath,gcAppName,gcTempPath, gcCaleServerDate, gcUserNameApp, gcPasswordApp,gcDirMare
|
|
Store '' To gcUserNameApp, gcPasswordApp, gnNivelUtilizator, gnGrupUtilizator, gcAcces,gcDirMare
|
|
*!* PUBLIC gcSchemaPath
|
|
*!* STORE '' TO gcSchemaPath
|
|
|
|
Set Procedure To "D:\ROA\ROADEF\COMUN\UTILE\web\WWUTILS.PRG" Additive
|
|
Set Procedure To "D:\ROA\ROADEF\COMUN\UTILE\web\WWAPI.PRG" Additive
|
|
|
|
gcAppPath = Addbs(ShortPath(GetAppStartPath()))
|
|
If Right(gcAppPath ,9)="PROGRAME\"
|
|
gcAppPath = Substr(gcAppPath ,1,Len(gcAppPath )-9)
|
|
Endif
|
|
gcAppName=Allt(Uppe(Juststem(Sys(16,0))))
|
|
|
|
*!* gcAppDataPath=gcAppPath+"Date_"+gcAppName+"\" && D:\CONTAFIN\TRANS\DATE_TRANS && PT OPTIUNI , FISIERE SPECIFICE PROGRAMULUI SI
|
|
gcUtilizatoriPath = gcAppPath + "UTILIZATORI\"
|
|
liat=Rat("\",gcAppPath,2)
|
|
gcDirMare=Addbs(Left(gcAppPath,liat-1))
|
|
dirgen = gcDirMare
|
|
|
|
Store "" To gcTempPath, gcCaleServerDate
|
|
|
|
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\CTL32;' + ;
|
|
gcAppPath + 'COMUN\UTILE\HPDF;' + ;
|
|
gcAppPath + 'COMUN\UTILE\HPDF\REPORTOUTPUT;' + ;
|
|
gcAppPath + 'COMUN\UTILE\WEB;' + ;
|
|
gcAppPath + 'COMUN\UTILE\NFJSON;' + ;
|
|
Addbs(Substr(gcAppPath,1,Rat([\],gcAppPath,2)))+[COMUNROA\]
|
|
|
|
*!*Set Path To Date;Include;FERESTRE;GRAFICE;Help;CLASE;MENIURI;PROGRAME;RAPOARTE;PROGS;LIBS
|
|
|
|
Set Path To &lcPath Additive
|
|
|
|
Push Menu _Msysmenu
|
|
lcLastSetClassLib=Set("CLASSLIB")
|
|
lcMainClassLib = gcAppPath + "clase\ofundal_sal"
|
|
|
|
*CLASE__________________________________________________________
|
|
Set Classlib To (lcMainClassLib) Additive
|
|
*!* SET CLASSLIB TO baza ADDITIVE
|
|
*!* SET CLASSLIB TO ferestrebaza ADDITIVE
|
|
Set Classlib To CAUT Additive
|
|
Set Classlib To ooptiuni Additive
|
|
*!* SET CLASSLIB TO oteste ADDITIVE
|
|
*!* SET CLASSLIB TO ovanzcump ADDITIVE
|
|
*!* SET CLASSLIB TO oparteneri ADDITIVE
|
|
Set Classlib To ferestre_cere_date Additive
|
|
Set Classlib To oblocare Additive
|
|
*!* SET CLASSLIB TO overificari ADDITIVE
|
|
*!* SET CLASSLIB TO FERESTREBAZA ADDITIVE
|
|
*!* SET CLASSLIB TO CONT 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 onom_sal 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 otoolbar Additive
|
|
*!* 19.07.2006
|
|
*!* MARIUS MUTU
|
|
Set Classlib To Messagebox Additive
|
|
Set Classlib To opersonal Additive
|
|
Set Classlib To oasociere Additive
|
|
Set Classlib To ofirma Additive
|
|
Set Classlib To ferestre_roadef Additive
|
|
*!* 21.04.2009
|
|
*!* alex.lepadatu
|
|
Set Classlib To oconfigurare_seturi.vcx ADDITIVE
|
|
*!* v 2.0.16
|
|
SET CLASSLIB TO wwdialogs.vcx additive
|
|
*!* v 2.0.16 ^
|
|
SET CLASSLIB TO overificari.vcx additive && v 2.0.25
|
|
set classlib to comun.vcx additive && v 2.1.0
|
|
SET CLASSLIB TO appwiz.vcx additive && v 2.1.2
|
|
SET CLASSLIB TO accessibility.vcx additive && v 2.1.2
|
|
*PROCEDURI______________________________________________________
|
|
*Set Procedure To acces_meniu2 Additive
|
|
Set Procedure To acces_meniu Additive
|
|
Set Procedure To ooperatii_comune Additive
|
|
Set Procedure To quitapp Additive
|
|
Set Procedure To init_program Additive
|
|
Set Procedure To proceduri_comune Additive
|
|
Set Procedure To oproceduri_comune Additive
|
|
Set Procedure To gencursor.prg Additive
|
|
Set Procedure To updateserver.prg Additive
|
|
Set Procedure To oproceduri_maintenance.prg Additive
|
|
Set Procedure To onomenclatoare Additive
|
|
Set Procedure To oproceduri_ams Additive
|
|
Set Procedure To ocautare Additive
|
|
Set Procedure To oproceduri_roadef_sal Additive
|
|
Set Procedure To oinit_optiuni Additive
|
|
Set Procedure To osecurity Additive
|
|
Set Procedure To oproceduri_roadef Additive
|
|
*!* 16.06.2006
|
|
*!* marius.mutu
|
|
Set Procedure To wwcodeupdate.prg Additive
|
|
Set Procedure To wwxmlhttp.prg Additive
|
|
Set Procedure To ini.prg Additive
|
|
Set Procedure To osalarii_comun.prg Additive
|
|
|
|
Set Procedure To wwutils.prg Additive
|
|
|
|
Set Procedure To proceduri_Excel.prg Additive
|
|
Set Procedure To cauta_alfa.prg Additive
|
|
*!* 21.04.2009
|
|
*!* alex.lepadatu
|
|
Set Procedure To oproceduri_app.prg Additive
|
|
*!* v 2.0.16
|
|
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 validare.prg Additive
|
|
SET PROCEDURE TO nfjsonread.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.16 ^
|
|
*----------------------------------------------------------------------------
|
|
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
|
|
|
|
|
|
|
|
|
|
|
|
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
|
|
|
|
|
|
gcSecurityPath = DIRGEN + 'Security\'
|
|
gcSecurityFile = gcSecurityPath + 'ROA_SECURITY.TXT'
|
|
|
|
*** Tin conexiunea deschisa. La wert??? apare eroarea odbc "timeout occured" daca se lasa peste 1 minut programul fara sa se lucreze
|
|
LOCAL lcKeepAlive, lnKeepAlive
|
|
PRIVATE goKeepAlive
|
|
lcKeepAlive = NVL(getini(m.gcGeneralIniFile,'update','keepalive_seconds'), '')
|
|
lnKeepAlive = 0
|
|
IF EMPTY(m.lcKeepAlive)
|
|
setini(m.gcGeneralIniFile,'update','keepalive_seconds', '0')
|
|
lnKeepAlive = 0
|
|
ELSE
|
|
lnKeepAlive = VAL(m.lcKeepAlive)
|
|
ENDIF
|
|
IF m.lnKeepAlive >= 5 && minim 5 secunde
|
|
goKeepAlive = NEWOBJECT("keepalive","utility.vcx")
|
|
goKeepAlive.interval = m.lnKeepAlive * 1000
|
|
goKeepAlive.enabled = .T.
|
|
ENDIF
|
|
|
|
|
|
Private poLog,goLog && obiect pt logarea mesajelor sistemului
|
|
poLog = Newobject("Log_Mesaje","Log_Mesaje.prg")
|
|
goLog = poLog
|
|
|
|
*!* public poLog && obiect pt logarea mesajelor sistemului
|
|
*!* poLog = NEWOBJECT("Log_Mesaje","Log_Mesaje.prg")
|
|
|
|
|
|
Public glQuit
|
|
glQuit = .F.
|
|
|
|
*!* modificare v 2.1.2
|
|
*!* Public gnIdIstoric
|
|
*!* gnIdIstoric = 0
|
|
*!* If verificari()
|
|
*!* _Screen.Visible=.T.
|
|
*!* Do mesaj With "Se fac verificari programului","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",""
|
|
*!* Quit
|
|
*!* Endif
|
|
*!* Endif
|
|
*!* modificare v 2.1.2 ^
|
|
*** 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,GCMONEDA, gcUserNameApp, gcPasswordApp, gcNivelUtilizator, gcGrupUtilizator, gcAcces
|
|
gnHandle = -1
|
|
gnidutil = 0
|
|
|
|
Private gcHost, gcUserName, gcPassword,gofundal, gnIdProgram
|
|
gnIdProgram = 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
|
|
|
|
|
|
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
|
|
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 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
|
|
|
|
|
|
*!* 17.03.2011
|
|
*!* 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
|
|
*!* 17.03.2011 ^
|
|
|
|
Public cales,eserver,loc,numestatie
|
|
eserver=.F.
|
|
Store '' To cales,loc,numestatie
|
|
|
|
Public NUMEPROGRAM,FUNDALPROGRAM
|
|
|
|
NUMEPROGRAM='ROADEF'
|
|
*!* MENIUPROGRAM=gcAppPath+"meniuri\cont2000.mpr"
|
|
*!* FUNDALPROGRAM=gcAppPath+"FERESTRE\FUNDAL.scx"
|
|
_program='roadef'
|
|
|
|
|
|
|
|
|
|
lcOnShutdown="ShutDown()"
|
|
On Shutdown &lcOnShutdown
|
|
On Error ErrorHandler(Error(),Program(),Lineno())
|
|
*!* _Shell="DO Cleanup IN progs\ROADEF"
|
|
|
|
*-- Instantiate application object.***************************
|
|
Release goApp
|
|
Public goApp
|
|
goApp=Createobject("cApplication")
|
|
|
|
*-- Configure application object.*****************************
|
|
NUMEPROGRAM = 'ROA - Definirea Companiei'
|
|
Local laVersion
|
|
Dimension laVersion(12)
|
|
If Agetfileversion(laVersion, Sys(16,0)) > 0
|
|
NUMEPROGRAM = laVersion(10)
|
|
Endif
|
|
Release laVersion
|
|
|
|
goApp.SetCaption(NUMEPROGRAM)
|
|
goApp.cStartupMenu = gcAppPath + "meniuri\Roadef"
|
|
goApp.cStartupForm = 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
|
|
|
|
cleanup()
|
|
|
|
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
|
|
If _vfp.StartMode = 0
|
|
Set Step On
|
|
Else
|
|
Quit
|
|
Endif
|
|
Endif
|
|
Endfunc
|
|
|
|
|
|
|
|
Function Shutdown
|
|
*!* =End_Istoric(gnIdIstoric, Addbs(DIRGEN)+"DATERETEA\", "START_ISTORIC")
|
|
If Type("goApp")=="O" And Not Isnull(goApp)
|
|
Return goApp.OnShutDown()
|
|
Endif
|
|
*!* modificare v 2.1.2
|
|
*!* ON SHUTDOWN
|
|
*!* ON ERROR
|
|
*!* CLEAR EVENTS
|
|
Cleanup()
|
|
Quit
|
|
*!* modificare v 2.1.2 ^
|
|
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
|
|
**********************************************************
|