Initial: flux text FoxBin2Prg (git urmareste .??2 in-arbore, binarele VFP git-ignored)

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
2026-07-16 12:28:41 +03:00
commit 7d786c5d4e
128 changed files with 46775 additions and 0 deletions

View File

@@ -0,0 +1,637 @@
***************************************************************************************************************
**** Clasa:
**** oDateListare
**** Proceduri:
**** rap_avize
**** rap_facturi
**** rap_incasari
**** rap_articole
**** rap_articole_tr
**** rap_avize_transfer
**** rap_centralizator
**** rap_centr_subgrupe
***************************************************************************************************************
Define Class oDateListare As Custom
datai = {}
dataf = {}
data_referinta = {}
csql = []
id_client = Null
nume_client = []
id_agent = Null
nume_agent = []
id_delegat = Null
nume_delegat = []
id_masina = Null
nrinmat = []
categorie = []
id_categorie_entitate = Null
denumire = []
id_articol = Null
grupa = []
id_grupa = Null
subgrupa = []
id_subgrupa = Null
id_gestiune_sursa = Null
gestiune_sursa = []
id_gestiune_dest = Null
gestiune_dest = []
id_util = Null
utilizator = []
id_gestiune = Null
nume_gestiune = []
subgr_art = []
id_furnart = Null
furnizor_art = []
*!* tip_raport = 1
*!* Dimension acoloane(30,4) && 1 - nume_camp
*!* && 2 - ordine la grupare
*!* && 3 - ordine la order by
*!* && 4 - sens la order by ( 1 - ASC, 2 - DESC )
Procedure Init
With This
ldData = Ttod(get_ora())
If Year(ldData)*12+Month(ldData)<>gnAn*12+gnLuna
.datai = Date(gnAn,gnLuna,1)
.dataf = Gomonth(Date(gnAn,gnLuna,1),1)-1
.data_referinta = .dataf
Else
.dataf = ldData
.data_referinta = ldData
.datai = Date(Year(ldData),Month(ldData),1)
Endif
Endwith
Endproc
Enddefine
***************************************************************************************************************
********************************************** INCEPUT: rap_avize *********************************************
Procedure rap_avize
Private poListare
poListare = Createobject("oDateListare")
ofrmdatelistare=Createobject("frm_date_rapoarte_avize")
ofrmdatelistare.Show(1)
Release poListare, ofrmdatelistare
Endproc && rap_avize
********************************************** SFARSIT: rap_avize *********************************************
********************************************* INCEPUT: rap_facturi ********************************************
Procedure rap_facturi
Private poListare
poListare = Createobject("oDateListare")
ofrmdatelistare=Createobject("frm_date_rapoarte_facturi")
ofrmdatelistare.Show(1)
Release poListare, ofrmdatelistare
Endproc && rap_facturi
********************************************** SFARSIT: rap_facturi *******************************************
******************************************** INCEPUT: rap_incasari ********************************************
Procedure rap_incasari
Private poListare
poListare = Createobject("oDateListare")
ofrmdatelistare=Createobject("frm_date_rapoarte_incasari")
ofrmdatelistare.Show(1)
Release poListare, ofrmdatelistare
Endproc && rap_incasari
******************************************** SFARSIT: rap_incasari ********************************************
******************************************** INCEPUT: rap_articole ********************************************
Procedure rap_articole
Private poListare
poListare = Createobject("oDateListare")
ofrmdatelistare=Createobject("frm_date_rapoarte_articole")
ofrmdatelistare.Show(1)
Release poListare, ofrmdatelistare
Endproc && rap_articole
******************************************** SFARSIT: rap_articole ********************************************
******************************************** INCEPUT: rap_articole_tr ********************************************
Procedure rap_articole_tr
Private poListare
poListare = Createobject("oDateListare")
ofrmdatelistare=Createobject("frm_date_rapoarte_articole_tr")
ofrmdatelistare.Show(1)
Release poListare, ofrmdatelistare
Endproc && rap_articole_tr
******************************************** SFARSIT: rap_articole_tr ********************************************
******************************************** INCEPUT: rap_articole_v ********************************************
Procedure rap_articole_v
Private poListare
poListare = Createobject("oDateListare")
ofrmdatelistare=Createobject("frm_date_rapoarte_articole_v")
ofrmdatelistare.Show(1)
Release poListare, ofrmdatelistare
Endproc && rap_articole_tr
******************************************** SFARSIT: rap_articole_v ********************************************
***************************************** INCEPUT: rap_avize_transfer *****************************************
Procedure rap_avize_transfer
Private poListare
poListare = Createobject("oDateListare")
ofrmdatelistare=Createobject("frm_date_rapoarte_avize_tr")
ofrmdatelistare.Show(1)
Release poListare, ofrmdatelistare
Endproc && rap_avize_transfer
***************************************** SFARSIT: rap_avize_transfer *****************************************
***************************************** INCEPUT: rap_centralizator ******************************************
Procedure rap_centralizator
Private pcDataora,pcPerioada,pdDataI,pdDataF,pnTotalFTva1,pnTotalTva1,pnTotalFTva2,pnTotalTva2
Store {} To pdDataI,pdDataF
Store 0 To pnTotalFaraTva1,pnTotalTva1,pnTotalFaraTva2,pnTotalTva2
Local lcOrder,lcSql,lcFiltru,lnSucces,lnNefacturatFTva,lnNefacturatTva
ofrmperioada=Createobject('frm_perioada_zzllaaaa')
ofrmperioada.Show(1)
If gnButon=2
Return
Endif
pcPerioada = [Perioada ]+Dtoc(pdDataI)+[ - ]+Dtoc(pdDataF)
Create Cursor crsCentralizator(tip N(2),categorie c(100),valftva N(20,4),valtva N(20,4))
*!* tip = 1 >> nu afiseaza sumele
pcDataora = get_ora(2)
If Used('crsCentrTot')
Use In crsCentrTot
Endif
lcSql1 = [select 1 as crs,tip,SUM(suma_fara_tva) as valftva,SUM(suma_tva) as valtva from ] + ;
gcS + [.fact_vrap_centralizator_tipuri where data_act between ?pdDataI and ?pdDataF] + gcCondSucursala + ;
[ group by tip]
lcSql2 = [select 2 as crs,null as tip,SUM(suma_fara_tva) as valftva,SUM(suma_tva) as valtva from ] + ;
gcS + [.fact_vrap_centralizator_art where data_act between ?pdDataI and ?pdDataF] + gcCondSucursala
lcSql3 = [select 3 as crs,null as tip,SUM(suma_fara_tva) as valftva,SUM(suma_tva) as valtva from ] + ;
gcS + [.fact_vrap_centralizator_rate where data_act between ?pdDataI and ?pdDataF] + gcCondSucursala
lcSql4 = [select 4 as crs,null as tip,SUM(disc_fara_tva) as valftva,SUM(disc_tva) as valtva from ] + ;
gcS + [.fact_vrap_centralizator_fact where data_act between ?pdDataI and ?pdDataF] + gcCondSucursala
lcSql = lcSql1 + [ union all ] + lcSql2 + [ union all ] + lcSql3 + [ union all ] + lcSql4
lcCursor = [crsCentrTot]
lnSucces = goExecutor.oexecute(lcSql,lcCursor)
If lnSucces < 0
amessagebox(goExecutor.oPrelucrareEroare(),16,"Eroare")
Use In crsCentrTot
Return
Endif
*** prelucrare raport
*!* Facturi
Select crsCentralizator
Append Blank
Replace categorie With "1. FACTURI"
Select Sum(valftva) As valftva,Sum(valtva) As valtva From crsCentrTot Where tip < 20 And crs=1 Into Cursor crsTemp
Select crsTemp
Scatter Name poCentr
Select crsCentralizator
Replace valftva With Nvl(poCentr.valftva,0),valtva With Nvl(poCentr.valtva,0)
pnTotalFTva1 = Nvl(poCentr.valftva,0)
pnTotalTva1 = Nvl(poCentr.valtva,0)
*!* Avize catre clienti
Select crsCentralizator
Append Blank
Replace categorie With "2. AVIZE CATRE CLIENTI",tip With 1
*!* Valoare totala
Append Blank
Replace categorie With Space(5)+"a) Valoare totala"
Select Sum(valftva) As valftva,Sum(valtva) As valtva From crsCentrTot Where Inlist(tip,21,22) And crs=1 Into Cursor crsTemp
Select crsTemp
Scatter Name poCentr
Select crsCentralizator
Replace valftva With Nvl(poCentr.valftva,0),valtva With Nvl(poCentr.valtva,0)
lnNefacturatFTva = Nvl(poCentr.valftva,0)
lnNefacturatTva = Nvl(poCentr.valtva,0)
*!* Valoare facturata
Append Blank
Replace categorie With Space(5)+"b) Valoare facturata"
Select Sum(valftva) As valftva,Sum(valtva) As valtva From crsCentrTot Where tip = 4 And crs=1 Into Cursor crsTemp
Select crsTemp
Scatter Name poCentr
Select crsCentralizator
Replace valftva With Nvl(poCentr.valftva,0),valtva With Nvl(poCentr.valtva,0)
lnNefacturatFTva = lnNefacturatFTva - Nvl(poCentr.valftva,0)
lnNefacturatTva = lnNefacturatTva - Nvl(poCentr.valtva,0)
*!* Valoare retururi
Append Blank
Replace categorie With Space(5)+"c) Valoare retururi"
Select Sum(valftva) As valftva,Sum(valtva) As valtva From crsCentrTot Where tip = 24 And crs=1 Into Cursor crsTemp
Select crsTemp
Scatter Name poCentr
Select crsCentralizator
Replace valftva With Nvl(poCentr.valftva,0),valtva With Nvl(poCentr.valtva,0)
lnNefacturatFTva = lnNefacturatFTva + Nvl(poCentr.valftva,0)
lnNefacturatTva = lnNefacturatTva + Nvl(poCentr.valtva,0)
*!* Valoare nefacturata
Append Blank
Replace categorie With Space(5)+"d) Valoare nefacturata (a-b+c)"
Replace valftva With lnNefacturatFTva,valtva With lnNefacturatTva
pnTotalFTva1 = pnTotalFTva1 + lnNefacturatFTva
pnTotalTva1 = pnTotalTva1 + lnNefacturatTva
*!* Transferuri intre subunitati
Select crsCentralizator
Append Blank
Replace categorie With "3. TRANSFERURI INTRE SUBUNITATI"
Select Sum(valftva) As valftva,Sum(valtva) As valtva From crsCentrTot Where tip = 23 And crs=1 Into Cursor crsTemp
Select crsTemp
Scatter Name poCentr
Select crsCentralizator
Replace valftva With Nvl(poCentr.valftva,0),valtva With Nvl(poCentr.valtva,0)
pnTotalFTva1 = pnTotalFTva1 + Nvl(poCentr.valftva,0)
pnTotalTva1 = pnTotalTva1 + Nvl(poCentr.valtva,0)
*!* Articole
Select crsCentralizator
Append Blank
Replace categorie With "4. TOTAL ARTICOLE VANDUTE"
Select crsCentrTot
Locate For crs=2
Scatter Name poCentr
Select crsCentralizator
Replace valftva With Nvl(poCentr.valftva,0),valtva With Nvl(poCentr.valtva,0)
pnTotalFTva2 = Nvl(poCentr.valftva,0)
pnTotalTva2 = Nvl(poCentr.valtva,0)
*!* Articole
Select crsCentralizator
Append Blank
Replace categorie With "5. TOTAL RATE CONTRACTE"
Select crsCentrTot
Locate For crs=3
Scatter Name poCentr
Select crsCentralizator
Replace valftva With Nvl(poCentr.valftva,0),valtva With Nvl(poCentr.valtva,0)
pnTotalFTva2 = pnTotalFTva2 + Nvl(poCentr.valftva,0)
pnTotalTva2 = pnTotalTva2 + Nvl(poCentr.valtva,0)
*!* Discount-uri globale
Select crsCentralizator
Append Blank
Replace categorie With "6. TOTAL DISCOUNT GLOBAL"
Select crsCentrTot
Locate For crs=4
Scatter Name poCentr
Select crsCentralizator
Replace valftva With Nvl(poCentr.valftva,0),valtva With Nvl(poCentr.valtva,0)
pnTotalFTva2 = pnTotalFTva2 - Nvl(poCentr.valftva,0)
pnTotalTva2 = pnTotalTva2 - Nvl(poCentr.valtva,0)
Release poCentr
Use In crsTemp
If Used('crsCentrTot')
Use In crsCentrTot
Endif
If Reccount('crsCentralizator') > 0
Keyboard "{ctrl+f10}"
Select crsCentralizator
Report Form raport_centralizator To Printer Prompt Preview
Else
amessagebox("Nu exista inregistrari pentru listare!",0+48,"Atentie")
Endif
If Used('crsCentralizator')
Use In crsCentralizator
Endif
Release pcDataora,pcPerioada,pdDataI,pdDataF,pnTotalFTva1,pnTotalTva1,pnTotalFTva2,pnTotalTva2
Endproc && rap_centralizator
***************************************** SFARSIT: rap_centralizator ******************************************
***************************************** INCEPUT: rap_centr_subgrupe *****************************************
Procedure rap_centr_subgrupe
Local lcSql,lnSucces,lcCursor
Private pcDataora,pcPerioada,pdDataI,pdDataF,pcTitlu
Store {} To pdDataI,pdDataF
lcCursor = [crscentrsubgr]
ofrmperioada=Createobject('frm_perioada_zzllaaaa')
ofrmperioada.Show(1)
If gnButon=1
pcPerioada = [Perioada ] + Dtoc(pdDataI) + [ - ] + Dtoc(pdDataF)
Else
Return
Endif
lcXMLGestiune = caut_gestiune_xml(2)
If !Empty(lcXMLGestiune) And gnButon = 1
Xmltocursor(lcXMLGestiune, "crsGestTemp")
If Reccount('crsGestTemp') = 0
amessagebox('Nu ati selectat nici o gestiune!',0+48,'Inventar')
Return
Endif
pcTitlu = [CENTRALIZATOR VALORI PE SUBGRUPE DE ARTICOLE]
lcListaIdGestiuni = cursor2lista("crsGestTemp", "id_gestiune", ",")
Use In crsGestTemp
Else
Return
Endif
If Used(lcCursor)
Use In (lcCursor)
Endif
lcSql = [select subgrupa,nume_gestiune,id_gestiune,Sum(val_ach) as val_ach,Sum(val_vanz) as val_vanz from ] + gcS + [.fact_vcentr_val_subgrupe ] + ;
[where data_act between ?pdDataI and ?pdDataF and id_gestiune in (] + lcListaIdGestiuni + [) ] + ;
[group by id_gestiune,nume_gestiune,subgrupa ] + ;
[order by nume_gestiune,subgrupa]
lnSucces = goExecutor.oexecute(lcSql,lcCursor)
If lnSucces < 0
amessagebox(goExecutor.cEroare,16,"Eroare")
Else
goExport.export2frx(lcCursor,[rap_centr_val_subgrupe])
Endif
If Used(lcCursor)
Use In (lcCursor)
Endif
Release lcSql,lnSucces,pcDataora,pcPerioada,pdDataI,pdDataF,pcTitlu
Endproc && rap_centr_subgrupe
***************************************** SFARSIT: rap_centr_subgrupe *****************************************
Procedure centr_avize_ruta
lcFiltru = [2=2]
lcSchema = [id_lucrare n(10),nrord c(100)]
lcOrder = [nrord]
lccoloane = [nrord]
lcTitlu = [ALEGETI LUCRAREA]
lcTitluColoane = [Lucrare]
*!* llMaiMulteMasini = tlMaiMulteMasini
lcSelect = [select id_lucrare,nrord from vnom_lucrari]
lcFiltruOriginal = [inactiv = 0]
*!* lcNumeProc = [nom_nomrute]
llToateIreg = .F.
lcPrimaColoana = [nrord]
lnPornire = 1
*!* lnTipReturn = Iif(tlMaiMulteMasini, 1, 0)
lcIdColumn = "id_lucrare"
loCauta = cauta_alfa(lcSelect, lcFiltru, lcSchema, lcOrder, lccoloane, lcTitlu, lcTitluColoane, , llToateIreg, lcFiltruOriginal)&&, lcPrimaColoana, lnPornire, , lcIdColumn)
*!* loCauta = cauta_alfa(lcSelect, lcFiltru, lcSchema, lcOrder, lccoloane, lcTitlu, lcTitluColoane, lcNumeProc, tlToateIreg, lcFiltruOriginal) && 11.07.2007
If Empty(loCauta.id_lucrare) Or Isnull(loCauta.id_lucrare)
Return
Endif
lcSql = [ select * from fact_vrap_avize_ruta where id_lucrare = ]+Alltrim(Str(loCauta.id_lucrare))+[ order by ruta,data_act,numar_act]
lcCursor = [crsavizeruta]
lnSucces = goExecutor.oexecute(lcSql,lcCursor)
If lnSucces < 0
amessagebox(goExecutor.oPrelucrareEroare(),16,"Eroare")
Use In crsavizeruta
Return
Endif
Select crsavizeruta
If Reccount() < 1
amessagebox('Nu exista date pentru comanda selectata!',0+64,'Atentie')
Use In crsavizeruta
Return
Endif
Private pcDataora
pcDataora = get_ora(2)
Select crsavizeruta
Report Form rap_avizerute To Printer Prompt Preview
Use In crsavizeruta
Endproc
*-------------------------------------------------------------------------------
Procedure centr_art_ruta
lcFiltru = [2=2]
lcSchema = [id_lucrare n(10),nrord c(100)]
lcOrder = [nrord]
lccoloane = [nrord]
lcTitlu = [ALEGETI LUCRAREA]
lcTitluColoane = [Lucrare]
*!* llMaiMulteMasini = tlMaiMulteMasini
lcSelect = [select id_lucrare,nrord from vnom_lucrari]
lcFiltruOriginal = [inactiv = 0]
*!* lcNumeProc = [nom_nomrute]
llToateIreg = .F.
lcPrimaColoana = [nrord]
lnPornire = 1
*!* lnTipReturn = Iif(tlMaiMulteMasini, 1, 0)
lcIdColumn = "id_lucrare"
loCauta = cauta_alfa(lcSelect, lcFiltru, lcSchema, lcOrder, lccoloane, lcTitlu, lcTitluColoane, , llToateIreg, lcFiltruOriginal)&&, lcPrimaColoana, lnPornire, , lcIdColumn)
*!* loCauta = cauta_alfa(lcSelect, lcFiltru, lcSchema, lcOrder, lccoloane, lcTitlu, lcTitluColoane, lcNumeProc, tlToateIreg, lcFiltruOriginal) && 11.07.2007
If Empty(loCauta.id_lucrare) Or Isnull(loCauta.id_lucrare)
Return
Endif
lcSql = [ select * from fact_vrap_art_ruta where id_lucrare = ]+Alltrim(Str(loCauta.id_lucrare))+[ order by ruta,subgrupa,denumire]
lcCursor = [crsartruta]
lnSucces = goExecutor.oexecute(lcSql,lcCursor)
If lnSucces < 0
amessagebox(goExecutor.oPrelucrareEroare(),16,"Eroare")
Use In crsartruta
Return
Endif
Select crsartruta
If Reccount() < 1
amessagebox('Nu exista date pentru comanda selectata!',0+64,'Atentie')
Use In crsartruta
Return
Endif
Private pcDataora
pcDataora = get_ora(2)
Select crsartruta
Report Form rap_ARTrute To Printer Prompt Preview
Use In crsartruta
Endproc
*---------------------------------------------------------------------------
Procedure rap_factav_doc && lansat din rap_listfactav_centr, lansat la randul lui din frm_facturi (ofacturare.vcx)
Local lnNrIreg,lcFiltruInit,lnRecSel
Store 0 To lnNrIreg,lnRecSel
Store '' To lcFiltruInit
Select crsfacturi
lcFiltruInit = Set("Filter")
lnRecSel = Recno()
Set Filter To ales = 1
Count For ales = 1 To lnNrIreg
*!* modificare v 2.0.40
*!* If Reccount() <1
If lnNrIreg < 1
*!* modificare v 2.0.40 ^
amessagebox('Nu ati selectat vreun document!',0+48,'Atentie')
*!* modificare v 2.0.40
*!* Return
*!* EndIf
Else
*!* modificare v 2.0.40 ^
Private pcDataora
pcDataora = get_ora(2)
Select crsfacturi
Report Form rap_avizedoc To Printer Prompt Preview
*!* modificare v 2.0.40
Endif
*!* modificare v 2.0.40 ^
Select crsfacturi
Set Filter To &lcFiltruInit
If lnRecSel>0
Goto lnRecSel
Endif
Endproc
*---------------------------------------------------------------------------
Procedure rap_factav_art && lansat din rap_listfactav_centr, lansat la randul lui din frm_facturi (ofacturare.vcx)
Local lcidvanzari,lcSql,lnSucces
Store '' To lcidvanzari
Local lnNrIreg,lcFiltruInit,lnRecSel
Store 0 To lnNrIreg,lnRecSel
Store '' To lcFiltruInit
Select crsfacturi
lcFiltruInit = Set("Filter")
lnRecSel = Recno()
Set Filter To ales = 1
Count For ales = 1 To lnNrIreg
*!* modificare v 2.0.40
*!* If Reccount() <1
If lnNrIreg < 1
*!* modificare v 2.0.40 ^
amessagebox('Nu ati selectat vreun document!',0+48,'Atentie')
*!* modificare v 2.0.40
*!* Return
*!* EndIf
Else
*!* modificare v 2.0.40
Select crsfacturi
Scan
lcidvanzari = lcidvanzari + [, ]+Alltrim(Str(crsfacturi .id_vanzare))
Select crsfacturi
Endscan
lcidvanzari = Substr(lcidvanzari,2)
lcSql = [select a.codmat,a.denumire,a.pret_achizitie,a.pret,a.subgrupa,sum(cantitate) as cantitate from fact_vfacturi_detalii a ]+;
[ where a.id_vanzare in (]+Alltrim(lcidvanzari)+[)]+;
[ group by a.codmat,a.denumire,a.pret_achizitie,a.pret,a.subgrupa]+;
[ order by a.codmat, a.denumire ]
lnSucces = goExecutor.oexecute(lcSql,'crsfactdetaliiartrap')
If lnSucces < 0
amessagebox(goExecutor.cEroare,0+16,"Eroare")
*!* modificare v 2.0.40
*!* Return
*!* Endif
Else
*!* modificare v 2.0.40 ^
Private pcDataora
pcDataora = get_ora(2)
Select crsfactdetaliiartrap
Report Form rap_artdoc To Printer Prompt Preview
*!* modificare v 2.0.40
Endif
Endif
*!* modificare v 2.0.40 ^
Select crsfacturi
Set Filter To &lcFiltruInit
If lnRecSel>0
Goto lnRecSel
Endif
Endproc
*---------------------------------------------------------------------------
Procedure rap_factav_docart && lansat din rap_listfactav_centr, lansat la randul lui din frm_facturi (ofacturare.vcx)
Select a.*,1 As g1 From crsfacturi a With (Buffering = .T.) Where ales = 1 Into Cursor crsDocArt NOFILTER Readwrite
Select crsDocArt
If Reccount() <1
amessagebox('Nu ati selectat nici un document!',0+48,'Atentie')
*!* modificare v 2.0.40
*!* Return
*!* EndIf
Else
*!* modificare v 2.0.40 ^
Local lcidvanzari,lcSql,lnSucces
Store '' To lcidvanzari
Select crsDocArt
Scan
lcidvanzari = lcidvanzari + [, ]+Alltrim(Str(crsDocArt.id_vanzare))
Select crsDocArt
Endscan
lcidvanzari = Substr(lcidvanzari,2)
lcSql = [select a.codmat,a.denumire,a.pret_achizitie,a.pret,a.subgrupa,sum(cantitate) as cantitate from fact_vfacturi_detalii a ]+;
[ where a.id_vanzare in (]+Alltrim(lcidvanzari)+[)]+;
[ group by a.codmat,a.denumire,a.pret_achizitie,a.pret,a.subgrupa]+;
[ order by a.codmat, a.denumire ]
lnSucces = goExecutor.oexecute(lcSql,'crsfactdetaliiartrap')
If lnSucces < 0
amessagebox(goExecutor.cEroare,0+16,"Eroare")
*!* modificare v 2.0.40
*!* Return
*!* EndIf
Else
*!* modificare v 2.0.40 ^
Private pcDataora
pcDataora = get_ora(2)
Select crsfactdetaliiartrap
Report Form rap_artdoc To Printer Prompt Preview
*!* modificare v 2.0.40
Endif
Endif
*!* modificare v 2.0.40 ^
Select crsfacturi
Set Filter To &lcFiltruInit
If lnRecSel>0
Goto lnRecSel
Endif
Endproc
*----------------------------------------------------------------------------------------------
Procedure rap_transf_art
Local lcidvanzari,lcSql,lnSucces
Store '' To lcidvanzari
Select * From crsfacturi With (Buffering = .T.) Where ales = 1 Into Cursor crsTmp
If Reccount() <1
amessagebox('Nu ati selectat vreun document!',0+48,'Atentie')
*!* modificare v 2.0.40
*!* Return
*!* EndIf
Else
*!* modificare v 2.0.40 ^
Select crsTmp
Scan
lcidvanzari = lcidvanzari + [, ]+Alltrim(Str(crsTmp.id_vanzare))
Select crsTmp
Endscan
Use In crsTmp
lcidvanzari = Substr(lcidvanzari,2)
lcSql = [select a.codmat,a.denumire,a.pret_achizitie,a.pret,a.subgrupa,sum(cantitate) as cantitate,client from fact_vfacturi_detalii a ]+;
[ where a.id_vanzare in (]+Alltrim(lcidvanzari)+[)]+;
[ group by a.codmat,a.denumire,a.pret_achizitie,a.pret,a.subgrupa,client]+;
[ order by a.codmat, a.denumire ]
lnSucces = goExecutor.oexecute(lcSql,'crssitconsum')
If lnSucces < 0
amessagebox(goExecutor.cEroare,0+16,"Eroare")
*!* modificare v 2.0.40
*!* Return
*!* Endif
Else
*!* modificare v 2.0.40 ^
Private pcDataora
pcDataora = get_ora(2)
Select crssitconsum
Report Form rap_transferart To Printer Prompt Preview
*!* modificare v 2.0.40
Endif
Endif
*!* modificare v 2.0.40 ^
Select crsfacturi
Endproc &&rap_transf_art

View File

@@ -0,0 +1 @@
**OVARIABILE_GLOBALE.PRG

827
Programe/roafacturare.prg Normal file
View File

@@ -0,0 +1,827 @@
*!* 12.12.2014
*!* adaugat libraria overificari.vcx pentru frm_verificare_parteneri
Parameters tparam
&&& roafacturare
Public gcNumeProgram
Local lchost, lcUserName, lcPassword, lnIdUtil, lnIdProgram, lcUserNameApp,lcPasswordApp
Store '' To lchost, lcUserName, lcPassword, lcUserNameApp,lcPasswordApp
Store 0 To lnIdUtil, lnIdProgram
gcNumeProgram=[ROAFACTURARE]
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 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 6
SET HOURS TO 24
_Screen.Visible=.F.
*VARIABILE_______
Local lcMainClassLib
Local lcLastSetTalk,lcLastSetPath,lcLastSetClassLib,lcOnShutdown
*VARIABILE__________________________________________________________________________
Public CRLF
Store Chr(13) + Chr(10) To CRLF
*!* ************************
*!* ** variabile pentru pmenu,ointroduceri
Declare nror[65000]
*!* sunt declarate ca private si in ofacturare.vcx > frm_facturi > do_sterge
Public pcNl,pcAn,gnTipGest,gcGestPermis
Store "" To pcNl,pcAn,gcGestPermis
Store 0 To gnTipGest
_program='facturare'
*!* ************************
Public pcTitlu,pl_verificat
Store "" To pcTitlu
Store .F. To pl_verificat
Public buton,primadata,dirgen,gcBasePath,col_menu,gcDirMare
STORE '' TO gcDirMare
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")
*!* modificare v 2.0.71
PUBLIC gcUtilizatoriPath, gcAppPath, gcAppName
Store '' To gcUtilizatoriPath, gcAppPath, gcAppName
Set Procedure To "d:\ROA\ROAFACTURARE\COMUN\UTILE\web\WWUTILS.PRG" Additive
Set Procedure To "d:\ROA\ROAFACTURARE\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))))
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\CALENDAR;' + ;
gcAppPath + 'COMUN\UTILE\CTL32;' + ;
gcAppPath + 'COMUN\UTILE\HPDF;' + ;
gcAppPath + 'COMUN\UTILE\HPDF\REPORTOUTPUT;' + ;
gcAppPath + 'COMUN\UTILE\WEB;' + ;
gcAppPath + 'COMUN\UTILE\EMAIL;' + ;
gcAppPath + 'COMUN\UTILE\NFJSON;' + ;
gcAppPath + 'COMUN\UTILE\NFXML;' + ;
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;PROGS;LIBS
*!* PUSH Menu _Msysmenu
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.71 ^
lcLastSetClassLib=Set("CLASSLIB")
lcMainClassLib = m.gcAppPath + "comun\clase\appwiz.vcx"
*CLASE__________________________________________________________
Set Classlib To (lcMainClassLib) Additive
Set Classlib To registry Additive
Set Classlib To cauta_alfa_forms Additive
SET CLASSLIB TO ofacturare.vcx additive
SET CLASSLIB TO ofacturare_comun.vcx additive
SET CLASSLIB TO accessibility.vcx additive
SET CLASSLIB TO ocriterii.vcx ADDITIVE
Set Classlib To ctl32_statusbar.vcx Additive
Set Classlib To ctl32_common.vcx Additive
Set Classlib To ctl32_structs.vcx Additive
Set Classlib To ctl32_progressbar.vcx Additive
*PROCEDURI______________________________________________________
Set Procedure To proceduri_comune Additive
Set Procedure To quitapp Additive
Set Procedure To init_program Additive
Set Procedure To onomenclatoare.prg Additive
Set Procedure To onomenclatoare2.prg Additive
SET PROCEDURE TO oproceduri_rapoarte_fact.prg ADDITIVE
SET PROCEDURE TO email.prg ADDITIVE
&& CLASE ORACLE
Set Classlib To DECABAZA Additive
Set Classlib To onomenclatoare Additive
Set Classlib To onomenclatoare2 Additive
Set Classlib To ofacturare Additive
Set Classlib To ofacturare_rapoarte Additive
Set Classlib To ferestre_oracle Additive
Set Classlib To Messagebox Additive
Set Classlib To otoolbar Additive
Set Classlib To onom_curs Additive
Set Classlib To comun Additive
Set Classlib To orapoarte Additive
Set Classlib To ferestre_cere_date Additive
***
*!* Set Classlib To wwxml Additive
Set Classlib To baza Additive
Set Classlib To caut Additive
Set Classlib To ointroduceri Additive
Set Classlib To serii_numere Additive
Set Classlib To caut_ora Additive
*!* Set Classlib To ferestrebaza Additive
*!* modificare v 2.0.70
SET CLASSLIB TO wwdialogs.vcx ADDITIVE
*!* modificare v 2.0.70 ^
SET CLASSLIB TO _calendar.vcx Additive && v 2.2.9
Set Classlib To locale Additive && v 2.2.15
SET CLASSLIB TO overificari ADDITIVE
*** COMENZI
SET CLASSLIB TO ocomenzi ADDITIVE
************************************************************************************************
&& PROCEDURI ORACLE
Set Procedure To GENCURSOR.PRG Additive
Set Procedure To OPROCEDURI_COMUNE.PRG Additive
Set Procedure To OINIT_OPTIUNI.PRG Additive
Set Procedure To updateserver.PRG Additive
Set Procedure To OPROCEDURI_aMS.PRG Additive
Set Procedure To ocautare Additive
Set Procedure To odocumente Additive
Set Procedure To osecurity Additive
Set Procedure To acces_meniu Additive
Set Procedure To wwxmlhttp.prg Additive
Set Procedure To wwcodeupdate.prg Additive
Set Procedure To ini.prg Additive
Set Procedure To cauta_alfa.prg Additive
Set Procedure To oHeader.prg Additive
Set Procedure To oproceduri_curs.prg Additive
Set Procedure To proceduri.prg Additive
Set Procedure To oproceduri_facturare.prg Additive
Set Procedure To proceduri_rapoarte.prg Additive
Set Procedure To ofacturare.prg Additive
Set Procedure To oserii_numere.prg Additive
Set Procedure To wwutils.prg Additive
Set Procedure To wwConfig.prg Additive
Set Procedure To wwApi.prg Additive
Set Procedure To oexport.prg Additive
Set Procedure To validare.prg Additive
***
Set Procedure To ofacturare_comun.prg Additive
Set Procedure To ofacturare_stoc.prg Additive
SET PROCEDURE TO pmenu.prg additive
SET PROCEDURE TO ointroduceri.prg additive
SET PROCEDURE TO ovariabile_globale.prg additive
SET PROCEDURE TO ooperatii_comune.prg additive
Set Procedure To oproceduri_util.prg Additive
*!* SET PROCEDURE TO oproceduri_listari.prg additive
*!* modificare v 2.0.70
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 wwhttp.prg ADDITIVE
SET PROCEDURE TO xmlaccess.prg additive
SET PROCEDURE TO xmlparser.prg additive
*!* modificare v 2.0.70 ^
*!* modificare v 2.0.71
SET PROCEDURE TO xdate.prg Additive
*!* modificare v 2.0.71 ^
SET PROCEDURE TO suma_in_vorbe.prg additive
Set Procedure To controllerecr Additive
SET PROCEDURE TO regex.prg ADDITIVE
************************************************************************************************
*** COMENZI
SET PROCEDURE TO orap_comenzi.prg ADDITIVE
SET PROCEDURE TO onom_comenzi.prg ADDITIVE
SET PROCEDURE TO update_comenzi.prg ADDITIVE
SET PROCEDURE TO xmlefactura.prg ADDITIVE
PRIVATE pocomenzi,pocomenzielemente,polucrari,pocomenzi2,polucrarielemente
STORE '' TO pocomenzi,pocomenzielemente,polucrari,pocomenzi2,polucrarielemente
************************************************************************************************
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.
Public glQuit
glQuit = .F.
Public gnIdIstoric
gnIdIstoric = 0
Public gcTempPath, gcCaleServerDate, gcUserNameApp, gcPasswordApp
Store '' To gcUserNameApp, gcPasswordApp, gnNivelUtilizator, gnGrupUtilizator, gcAcces
Public gcAntet,gcCopyRight
Store '' To gcAntet
gcCopyRight = '<27> ROA Romfast SRL'
*!* modificare v 2.0.93 : verific daca suporta diacritice
PUBLIC glFontCharSet
glFontCharSet = AFONT(laFontCharSet,"Arial Narrow",238)
*!* modificare v 2.0.93 ^
*!* gcAppPath=Addbs(Justpath(Sys(16,0))) && d:\roa\roafacturare\
*!* modificare v 2.0.71
*!* Public gcAppPath,gcAppName,gcUtilizatoriPath
*!* gcAppPath = ADDBS(ShortPath(GetAppStartPath())) && wwutils.prg
*!* gcAppName=Allt(Uppe(Juststem(Sys(16,0)))) && "roafacturare"
*!* gcUtilizatoriPath = gcAppPath + "UTILIZATORI\"
*!* modificare v 2.0.71 ^
Set Path To Addbs(Substr(gcAppPath,1,Rat([\],gcAppPath,2)))+[COMUNROA\] Additive
Store "" To gcTempPath, gcCaleServerDate
*** DIRGEN
*!* modificare v 2.0.71 : am inlocuit dirgen cu gcDirMare
liat = Rat("\",gcAppPath,2)
gcDirMare = Addbs(Left(gcAppPath,liat-1))
dirgen = gcDirMare
gcBasePath = gcDirMare
*!* modificare v 2.0.93
PRIVATE gcReportPreviewer, gcReportPreviewerPath
gcReportPreviewer = "FoxyPreview" && oexport.prg
gcReportPreviewerPath = gcDirMare + "COMUNROA\"
*!* modificare v 2.0.93 ^
gcSecurityPath = gcDirMare + 'Security\'
gcSecurityFile = gcSecurityPath + 'ROA_SECURITY.TXT'
Cd &gcDirMare
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
*** 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
*!* modificare v 2.2.15
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.2.15 ^
***************************** 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, gnId_Prg_Owner
gnIdProgram = 0
gnId_Prg_Owner = 0
gofundal=''
Private goFirma,gnIdFirma,gcFirma,gnAn,gnLuna && ,gnPA,gnPC
Store Null To goFirma
Store 0 To gnIdFirma, gnAn, gnLuna
Store '' To gcFirma
***toolbar***
PRIVATE otool,ohelp
STORE '' TO otool,ohelp
***toolbar***
Private glUltimaLuna,glPrimaLuna, glLunaBuna,glLuna_neplatita,glLunaInchisa
Store .F. To glUltimaLuna,glPrimaLuna, glLunaBuna,glLuna_neplatita,glLunaInchisa
Private GcS && schema firmei
Store 'CONTAFIN' 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")
*!* modificare v 2.0.26
Private goExport
goExport = CREATEOBJECT("oExportConfig")
*!* modificare v 2.0.26 ^
Private goMyXMLHTTP
lcHostErrors = getini(gcGeneralIniFile,'errors','host')
goMyXMLHTTP = Createobject("MyXMLHTTP", lcHostErrors)
&& obiect global pt luna aleasa din calendar
Private goCalendar
Store Null To goCalendar
PRIVATE goControllerEcr
goControllerEcr = CreateObject('oControllerEcr')
gcHost = lchost
gcUserName = lcUserName
gcPassword = lcPassword
gcUserNameApp = lcUserNameApp
gcPasswordApp = lcPasswordApp
gnidutil = lnIdUtil
gnIdProgram = lnIdProgram
PRIVATE gnId_sectie,gcNumeSectie
STORE 0 TO gnId_sectie,gcNumeSectie && sectia cu care se lucreaza in program
PRIVATE gnTipUzualComanda, gnOre_inchidere, gnOre_livrare, gnOre_executie, gnCopiereCantitate, gnIdPoliticaPretC, ;
gnIdPoliticaPret, gnId_lista_preturi_PV, gnIdGrupaArtSectie, gnSuprascriePretComanda , gnComenziInitial, gnRF_ORDONARECOMENZI
STORE 0 TO gnTipUzualComanda, gnOre_inchidere, gnOre_livrare, gnOre_executie, gnCopiereCantitate, gnIdPoliticaPretC, ;
gnIdPoliticaPret, gnId_lista_preturi_PV, gnIdGrupaArtSectie, gnSuprascriePretComanda, gnComenziInitial, gnRF_ORDONARECOMENZI
PRIVATE goComanda
goComanda = null
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
*!* NUMEPROGRAM='ROA facturare '
*!* MENIUPROGRAM="MENIU\roafacturare.mpr"
*!* *!* FUNDALPROGRAM=gcAppPath+"FERESTRE\FUNDAL.scx"
*-- Configure application object.*****************************
_Screen.WindowState=2
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("wzApplication")
Local laVersion
Dimension laVersion(12)
If Agetfileversion(laVersion, Sys(16,0)) > 0
NUMEPROGRAM = laVersion(10)
Endif
Release laVersion
goApp.SetCaption(gcNumeProgram)
goApp.cStartupMenu = m.gcAppPath + 'meniu\roafacturare'
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
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
ON SHUTDOWN
Return .F.
Endif
Endfunc
************************************************************************************************
Function Shutdown
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(,,gcDirMare)
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
************************************************************************************************

View File

@@ -0,0 +1,51 @@
**********************************************************
Procedure update_nomenclator
Do update_lunilean
*** tabele meniu deschise din proiect
Local lcCaleDateMenu
lcCaleDateMenu=gcAppPath+[\COMUN\DATEMENU\]
*!* modificare v 2.0.71
*!* If !Used('XREQUEST')
*!* Use &lcCaleDateMenu.XREQUEST In 0 Alias XREQUEST
*!* Endif
*!* If !Used('xitems')
*!* Use &lcCaleDateMenu.xitems In 0 Alias xitems
*!* Endif
*!* If !Used('XSETS')
*!* Use &lcCaleDateMenu.XSETS In 0 Alias XSETS Order Tag ID_SET
*!* Endif
*!* If !Used('xACT')
*!* Use &lcCaleDateMenu.xACT In 0 Alias xACT
*!* Endif
*!* If !Used('xnote')
*!* Use &lcCaleDateMenu.xnote In 0 Alias xnote
*!* Endif
lnSucces = xdate()
*!* modificare v 2.0.71 ^
If !Used('menu1')
Use &lcCaleDateMenu.menu1 In 0 Alias menu1 Excl
Endif
If !Used('INFISIERE')
Use &lcCaleDateMenu.INFISIERE In 0 Alias INFISIERE
Endif
If !Used('selectii')
Use &lcCaleDateMenu.gest_selectii In 0 Alias selectii
Endif
*!* modificare v 2.1.1
If !Used('mila1')
Use &lcCaleDateMenu.mila1 In 0 Alias mila1
endif
*!* modificare v 2.1.1 ^
*!* If !Used('nom_meniu')
*!* Use &lcCaleDateMenu.nom_meniu In 0 Alias nom_meniu
*!* Endif
Endproc && update_nomenclator