romfast/roapreturi
2
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
main
roapreturi/Programe/roapreturi_.prg
Marius Mutu f0d5151c24 sync SVN r18058
2026-08-26 13:01:51 +03:00

569 lines
14 KiB
Plaintext
Raw Permalink Blame History

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
************************************************************************************************
Reference in New Issue View Git Blame Copy Permalink