sync SVN r18058

2026-08-26 12:49:21 +03:00
commit f0d5151c24
46 changed files with 13195 additions and 0 deletions
--- a/Programe/roapreturi_.prg
+++ b/Programe/roapreturi_.prg
@@ -0,0 +1,569 @@
+Parameters tparam
+&&& roapreturi
+Local lchost, lcUserName, lcPassword, lnIdUtil, lnIdProgram, lcUserNameApp,lcPasswordApp
+Store '' To lchost, lcUserName, lcPassword, lcUserNameApp,lcPasswordApp
+Store 0 To lnIdUtil, lnIdProgram
+_Screen.Icon = ''
+
+Private gcNumeProgram
+Local lcStem
+lcStem = Upper(Juststem(Sys(16,0)))
+gcNumeProgram=[ROAPRETURI]
+If gcNumeProgram != lcStem
+	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 Decimals To 4
+
+_Screen.Visible=.F.
+
+
+*VARIABILE_______
+Local lcMainClassLib
+Local lcLastSetTalk,lcLastSetPath,lcLastSetClassLib,lcOnShutdown
+
+*VARIABILE__________________________________________________________________________
+Public CRLF
+Store Chr(13) + Chr(10) To CRLF
+
+Public pcTitlu,pl_verificat
+Store "" To pcTitlu
+Store .F. To pl_verificat
+
+Public buton,primadata,dirgen,col_menu
+Store 1 To buton,col_menu
+Store .T. To primadata &&,luna_neplatita
+
+*-- Save and configure environment.***********************
+lcLastSetTalk=Set("TALK")
+Set Talk Off
+lcLastSetPath=Set("PATH")
+
+Set Path To ;Date;Include;FERESTRE;GRAFICE;Help;CLASE;MENIURI;PROGRAME;RAPOARTE;PROGS;LIBS;
+	PUSH Menu _Msysmenu
+lcLastSetClassLib=Set("CLASSLIB")
+lcMainClassLib="clase\opreturi"
+*CLASE__________________________________________________________
+Set Classlib To (lcMainClassLib) Additive
+Set Classlib To registry Additive
+Set Classlib To cauta_alfa_forms Additive
+
+*PROCEDURI______________________________________________________
+Set Procedure To proceduri_comune Additive
+Set Procedure To quitapp Additive
+Set Procedure To init_program Additive
+
+&& CLASE ORACLE
+Set Classlib To DECABAZA Additive
+Set Classlib To ferestre_oracle Additive
+Set Classlib To ofundal_preturi Additive
+Set Classlib To onom_preturi ADDITIVE 
+SET CLASSLIB TO onote_contabile ADDITIVE 
+
+************************************************************************************************
+&& PROCEDURI ORACLE
+Set Procedure To GENCURSOR.PRG Additive
+Set Procedure To OPROCEDURI_COMUNE.PRG Additive
+Set Procedure To OPROCEDURI_aMS.PRG Additive
+Set Procedure To osecurity Additive
+Set Procedure To acces_meniu2 Additive
+Set Procedure To onom_preturi Additive
+* Set Procedure To update_preturi Additive
+Set Procedure To ocautare Additive
+Set Procedure To updateserver Additive
+Set Procedure To oheader Additive
+SET PROCEDURE TO omeniu_initializari 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 gcAppPath,gcAppName,gcAppDataPath, gcTempPath, gcCaleServerDate, gcUserNameApp, gcPasswordApp, gnId_Prg_Owner
+Store '' To  gcUserNameApp, gcPasswordApp, gnNivelUtilizator, gnGrupUtilizator, gcAcces
+Public gcSchemaPath
+Store '' To gcSchemaPath
+Store 0 To gnId_Prg_Owner
+
+gcAppPath=Addbs(Justpath(Sys(16,0)))		&& d:\roa\roapreturi\
+gcAppName=Allt(Uppe(Juststem(Sys(16,0))))	&& "roapreturi"
+
+gcAppDataPath=gcAppPath+"Date_"+gcAppName+"\"
+gcUtilizatoriPath = gcAppPath + "UTILIZATORI\"
+
+Store "" To gcTempPath, gcCaleServerDate
+If !Directory(gcAppDataPath)
+	Md (gcAppDataPath)
+Endif
+
+*** DIRGEN
+liat = Rat("\",gcAppPath,2)
+dirgen = Addbs(Left(gcAppPath,liat-1))
+
+gcSecurityPath = dirgen + 'Security\'
+gcSecurityFile = gcSecurityPath + 'ROA_SECURITY.TXT'
+
+Cd &dirgen
+
+Private poLog,goLog && obiect pt logarea mesajelor sistemului
+poLog = Newobject("Log_Mesaje","Log_Mesaje.prg")
+goLog = poLog
+
+If verificari()
+	_Screen.Visible=.T.
+	Messagebox("Se fac verificari programului!"+CRLF+"Va rugam reveniti!",64,"ROA Preturi")
+	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 Preturi")
+		Quit
+	Endif
+Endif
+
+***************************** VARIABILE ORACLE
+Private gnHandle,gnidutil,GCCODFISCAL,GCADRESA,GCNUMEFIRMA,GNDIFZILE, gcUserNameApp, gcPasswordApp
+Private gnButon		&& variabila pentru renunt si terminat
+Store 2 To gnButon
+Store '' To GCCODFISCAL,GCADRESA,GCNUMEFIRMA,GCMONEDA, gcUserNameApp, gcPasswordApp, gcAcces
+gnHandle = -1
+gnidutil = 0
+
+Private gcHost, gcUserName, gcPassword, gofundal, gnIdProgram
+gnIdProgram = 0
+gofundal=''
+
+Private goFirma,gnId_Firma,gnIdFirma,gcFirma,gnAn,gnLuna && ,gnPA,gnPC
+Store Null To goFirma
+Store 0 To gnId_Firma, 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 'CONTAFIN' To gcS
+
+&& obiect global wrap pt sqlexec cu text eroare si succes
+Private goExecutor, goConn
+goExecutor = Createobject("oExecutor")
+goConn = Createobject("oConn")
+
+&& 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
+Public NUMEPROGRAM,FUNDALPROGRAM, antet
+NUMEPROGRAM='ROA Politici de preturi'
+MENIUPROGRAM="MENIU\roapreturi.mpr"
+
+PRIVATE gcCopyRight
+gcCopyRight = '<27> ROA Romfast SRL'
+
+*!*	FUNDALPROGRAM=gcAppPath+"FERESTRE\FUNDAL.scx"
+
+*-- Configure application object.*****************************
+* _Screen.WindowState=2
+_Screen.AutoCenter=.T.
+
+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")
+
+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 = gcAppPath + '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
+If Messagebox(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 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
+************************************************************************************************