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

Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_015husoVS24ewJZr21ZoVR3v
This commit is contained in:
2026-08-23 18:00:57 +03:00
commit 77e98d73e9
94 changed files with 62872 additions and 0 deletions

107
Programe/1proverb.prg Normal file
View File

@@ -0,0 +1,107 @@
WAIT WIND 'Se genereaza raportul. Asteptati...' nowait
SET SAFETY OFF
COPY FILE &DIRGEN\DEVIZE\DATE\TEMPO\PROVERB.* TO &LOC\&NFSCURT\TEMPO\PROVERB.*
SELE 0
USE &LOC\&NFSCURT\TEMPO\PROVERB EXCL ALIAS PROVERB
sele proverb
zap
public m.g,m.nrinmat,m.tipauto
LOCAL M.DENUMIRE,M.CODMAT,M.CODFURN,M.CANT,M.PRET
STORE '' TO M.DENUMIRE,M.CODMAT,M.CODFURN,m.tipauto
STORE ' ' TO m.nrinmat
STORE 0 TO M.CANT,M.PRET,m.g
sele rul
set filter to subs(nrord,1,1)='G'
SCAN
m.nrord = nrord
M.DENUMIRE = DENUMIRE
M.CODMAT=CODMAT
M.CODFURN=EXP4
M.CANT=CANTE
M.PRET=PRETV
m.fel = 'A'
do nrcirc
SELE PROVERB
APPE BLANK
GATHER MEMVAR
SELE RUL
ENDSCAN
sele OPER
set filter to subs(nrord,1,1)='G'
SCAN
m.nrord = nrord
M.DENUMIRE = DENOP
M.CODMAT=CODOP
M.CODFURN=codfurn
M.CANT=TIMPN
M.PRET=PRET
m.fel = 'B'
do nrcirc
sele oper
SELE PROVERB
APPE BLANK
GATHER MEMVAR
SELE OPER
ENDSCAN
sele proverb
set order to tag codfel
TOTAL ON DENUMIRE+STR(PRET,10) FIELDS CANT TO &LOC\&NFSCURT\TEMPO\PROVERB1
SELE 0
*USE C:\CONTAFIN\AUTOSTAL\TEMPO\PROVERB1
USE &LOC\&NFSCURT\TEMPO\PROVERB1
**************
INDEX ON TIPAUTO+CODFURN+DENUMIRE+STR(PRET,10) to &LOC\&NFSCURT\TEMPO\PROVERB1
***************
report format proverb TO PRINTER PROMPT preview
USE IN PROVERB
USE IN PROVERB1
RETURN
*************
procedure nrcirc
m.g=1
m.tipauto=''
m.nrinmat=''
do case
case subs(nrord,1,1)='/'
m.g=2
case subs(nrord,2,1)='/'
m.g=3
case subs(nrord,3,1)='/'
m.g=4
case subs(nrord,4,1)='/'
m.g=5
case subs(nrord,5,1)='/'
m.g=6
case subs(nrord,6,1)='/'
m.g=7
case subs(nrord,7,1)='/'
m.g=8
case subs(nrord,8,1)='/'
m.g=9
case subs(nrord,9,1)='/'
m.g=10
case subs(nrord,10,1)='/'
m.g=11
case subs(nrord,11,1)='/'
m.g=12
case subs(nrord,12,1)='/'
m.g=13
case subs(nrord,13,1)='/'
m.g=14
case subs(nrord,14,1)='/'
m.g=15
case subs(nrord,15,1)='/'
m.g=16
endcase
m.nrinmat = subs(nrord,m.g,20-m.g)
sele masini
loca for ALLT(m.nrinmat) = ALLT(nrinmat)
if found()
m.tipauto = masina
else
m.tipauto=''
endif
return

270
Programe/actualizari.prg Normal file
View File

@@ -0,0 +1,270 @@
SELE CALENDAR
M=4*RECCOUNT()+4
OP=CREA('PROGRESBAR')
op.titlu.caption='Actualizari'
OP.SHOW()
close database
IF !USED('FISTOTVdev')
do deschidf with '&dirgen\devize\date\datean\','&dirgen\devize\date\datean\','fistotvdev','fistotv','CALE',''
ENDIF
sele 0
use &calefirma\datean\calendar alias calendar
sele calendar
J=0
scan
scatter memvar
date=calefirma+'\AN'+m.an+'\DATE'+M.nl
if file('&date\oper.dbf')
*DO PR WITH J
*do pfactura
DO PR WITH J
do pordl
DO PR WITH J
do poper
DO PR WITH J
do popersal
DO PR WITH J
do psalarii
endif
endscan
***
DO PR WITH J
do pclie
DO PR WITH J
DO PSECTIE
DO PR WITH J
DO PMECANICI
DO PR WITH J
do pmasini
DO PR WITH J
DO PMARCI
OP.RELEASE
RETURN
*____________________________________________
procedure pfactura
dele file &date\facturaa.*
dele file &date\facturav.*
copy file &dirgen\devize\date\date00\factura.* to &date\facturaa.*
sele 0
use &date\facturaa.dbf AGAIN ALIAS facturaa exclusive
sele facturaa
zap
sele facturaa
append from &date\factura
sele facturaa
reindex
use
rename &date\factura.* to &date\facturav.*
rename &date\facturaa.* to &date\factura.*
*do refRULL
return
*____________________________________________
procedure psalarii
dele file &date\salariia.*
dele file &date\salariiv.*
copy file &dirgen\devize\date\date00\salarii.* to &date\salariia.*
sele 0
use &date\salariia.dbf AGAIN ALIAS salariia exclusive
sele salariia
zap
sele salariia
append from &date\salarii
sele salariia
reindex
use
rename &date\salarii.* to &date\salariiv.*
rename &date\salariia.* to &date\salarii.*
*do refRULL
return
*____________________________________________
procedure pordl
dele file &date\ordla.*
dele file &date\ordlv.*
copy file &dirgen\devize\date\date00\ordl.* to &date\ordla.*
sele 0
use &date\ordla.dbf AGAIN ALIAS ordla exclusive
sele ordla
zap
sele ordla
append from &date\ordl
sele ordla
reindex
use
rename &date\ordl.* to &date\ordlv.*
rename &date\ordla.* to &date\ordl.*
&&&&&&do refact
return
*____________________________________________
procedure poper
dele file &date\opera.*
dele file &date\operv.*
copy file &dirgen\devize\date\date00\oper.* to &date\opera.*
sele 0
use &date\opera.dbf AGAIN ALIAS opera exclusive
sele opera
zap
sele opera
append from &date\oper
sele opera
reindex
use
rename &date\oper.* to &date\operv.*
rename &date\opera.* to &date\oper.*
return
*____________________________________________
procedure popersal
dele file &date\opersala.*
dele file &date\opersalv.*
copy file &dirgen\devize\date\date00\opersal.* to &date\opersala.*
sele 0
use &date\opersala.dbf AGAIN ALIAS opersala exclusive
sele opersala
zap
sele opersala
append from &date\opersal
sele opersala
reindex
use
rename &date\opersal.* to &date\opersalv.*
rename &date\opersala.* to &date\opersal.*
return
*______________________________________________________________
procedure pclie
dele file &calefirma\datean\cliea.*
dele file &calefirma\datean\cliev.*
copy file &dirgen\devize\date\datean\clie.* to &calefirma\datean\cliea.*
sele 0
use &calefirma\datean\cliea.dbf AGAIN ALIAS cliea exclusive
sele cliea
zap
sele cliea
append from &calefirma\datean\clie
sele cliea
reindex
use
rename &calefirma\datean\clie.* to &calefirma\datean\cliev.*
rename &calefirma\datean\cliea.* to &calefirma\datean\clie.*
*DO refRUL
return
*______________________________________________________________
procedure pSECTIE
dele file &calefirma\datean\SECTIEa.*
dele file &calefirma\datean\SECTIEv.*
copy file &dirgen\devize\date\datean\SECTIE.* to &calefirma\datean\SECTIEa.*
sele 0
use &calefirma\datean\SECTIEa.dbf AGAIN ALIAS SECTIEa exclusive
sele SECTIEa
zap
sele SECTIEa
append from &calefirma\datean\SECTIE
sele SECTIEa
reindex
use
rename &calefirma\datean\SECTIE.* to &calefirma\datean\SECTIEv.*
rename &calefirma\datean\SECTIEa.* to &calefirma\datean\SECTIE.*
*DO refRUL
return
*______________________________________________________________
procedure pMECANICI
dele file &calefirma\datean\MECANICIa.*
dele file &calefirma\datean\MECANICIv.*
copy file &dirgen\devize\date\datean\MECANICI.* to &calefirma\datean\MECANICIa.*
sele 0
use &calefirma\datean\MECANICIa.dbf AGAIN ALIAS MECANICIa exclusive
sele MECANICIa
zap
sele MECANICIa
append from &calefirma\datean\MECANICI
sele MECANICIa
reindex
use
rename &calefirma\datean\MECANICI.* to &calefirma\datean\MECANICIv.*
rename &calefirma\datean\MECANICIa.* to &calefirma\datean\MECANICI.*
*DO refRUL
return
*______________________________________________________________
procedure pmasini
dele file &calefirma\datean\masinia.*
dele file &calefirma\datean\masiniv.*
copy file &dirgen\devize\date\datean\masini.* to &calefirma\datean\masinia.*
sele 0
use &calefirma\datean\masinia.dbf AGAIN ALIAS masinia exclusive
sele masinia
zap
sele masinia
append from &calefirma\datean\masini
sele masinia
reindex
use
rename &calefirma\datean\masini.* to &calefirma\datean\masiniv.*
rename &calefirma\datean\masinia.* to &calefirma\datean\masini.*
return
*______________________________________________________________
procedure pMARCI
dele file &calefirma\datean\MARCIa.*
dele file &calefirma\datean\MARCIv.*
copy file &dirgen\devize\date\datean\MARCI.* to &calefirma\datean\MARCIa.*
sele 0
use &calefirma\datean\MARCIa.dbf AGAIN ALIAS MARCIa exclusive
sele MARCIa
zap
sele MARCIa
append from &calefirma\datean\MARCI
sele MARCIa
reindex
use
rename &calefirma\datean\MARCI.* to &calefirma\datean\MARCIv.*
rename &calefirma\datean\MARCIa.* to &calefirma\datean\MARCI.*
return
*____________________________________
PROC PR
PARAM J
IF J>M
RETURN
ENDIF
OP.PRBAR.VALUE=J
OP.P=ROUND(100*OP.PRBAR.VALUE/OP.PRBAR.MAX,2)
OP.REFRESH
J=J+1
RETURN

BIN
Programe/genhtml.dbf Normal file

Binary file not shown.

BIN
Programe/genhtml.fpt Normal file

Binary file not shown.

43
Programe/mesaje.prg Normal file
View File

@@ -0,0 +1,43 @@
*_________________________________________
PROCEDURE anunta_rezultat
LPARAMETERS lcCategorie, lcSursa, lcMesaj, llEroare, llInTabel, lnId_ref
IF llInTabel
scrie_in_mesaje(lcCategorie, lcSursa, lcMesaj, llEroare, lnId_ref)
ELSE
DO mesaj With lcMesaj, ''
ENDIF
ENDPROC
PROCEDURE scrie_in_mesaje
LPARAMETERS lcCategorie, lcSursa, lcMesaj, llEroare, lnId_ref
LOCAL lnOrdine
SELECT mesaje
CALCULATE MAX(ordine) TO m.lnOrdine
m.lnOrdine = m.lnOrdine + 1
APPEND BLANK
replace ordine WITH m.lnOrdine, sursa WITH lcSursa, mesaj WITH lcMesaj, ;
eroare WITH llEroare, categorie WITH lcCategorie, id_ref WITH lnId_ref
ENDPROC
PROCEDURE sterge_mesaje
ZAP IN mesaje
ENDPROC
PROCEDURE raport_mesaje
PARAMETERS tcPerioada
PRIVATE pcTitlu,pcPerioada,pcDataOra
*!* PRIVATE toFirma
*!* SELECT FIRMA
*!* LOCATE FOR NFSCURT=FSCURT
*!* SCATTER NAME m.toFirma
*!* SELECT mesaje
*!* IF RECNO() > 0
*!* SET ORDER TO ordine
*!* REPORT FORM mesaje TO PRINTER PROMPT PREVIEW
*!* ENDIF
pcTitlu=[VERIFICARE GLOBALA]
pcPerioada=[Perioada ]
pcdataora = get_ora(2)
SELECT crsverificari
REPORT FORM rap_mesaje TO PRINTER PROMPT preview
ENDPROC

687
Programe/oparteneri.prg Normal file
View File

@@ -0,0 +1,687 @@
*!* APEL DE PROCEDURA
*!* DO lans_ireg_parteneri WITH tlTest,tcCont,tlActiv
*-----------------------------------------------------------
PROCEDURE lans_ireg_parteneri
PARAMETERS tlTest,tcCont,tlactiv,tlTitluTot,tcDenumire,tcDenDebit,tcDenCredit
*!* tlTitluTot = daca denumirea titlului este totala i.e.: Nu trebuie sa mai adaug Balanta parteneri
*!* tcDenumire = titlul balantei
*!* tcDenDebit = peste tot pe unde apare debit se va inlocui cu aceasta denumire
*!* tcDenCredit = peste tot pe unde apare credit se va inlocui cu aceasta denumire
LOCAL lcCont, llActiv, llParametri,llTitluTot,lcDenumire,lcDenDebit,lcDenCredit
llParametri = .F.
IF EMPTY(tlTitluTot)
llTitluTot = .F.
ELSE
llTitluTot = tlTitluTot
ENDIF
IF EMPTY(tcDenumire)
lcDenumire = ""
ELSE
lcDenumire= tcDenumire
ENDIF
IF EMPTY(tcDenDebit)
lcDenDebit = "Debit"
ELSE
lcDenDebit = tcDenDebit
ENDIF
IF EMPTY(tcDenCredit)
lcDenCredit = "Credit"
ELSE
lcDenCredit = tcDenCredit
ENDIF
IF !EMPTY(tcCont)
lcCont = ALLTRIM(tcCont)
ELSE
lcCont = ''
ENDIF
IF !EMPTY(tlactiv)
llActiv = tlactiv
ELSE
llActiv = .F.
ENDIF
llParametri = .F.
*If PCOUNT() = 3
*!* IF !EMPTY(tlActiv) AND !EMPTY(tcCont) AND !EMPTY(tlActiv)
*!* llParametri = .T.
*!* Endif
IF !EMPTY(tcCont)
llParametri = .T.
ENDIF
LOCAL NOU, lnTdeb, lnTcred, lnSold, lcContPart, lclista
STORE 0 TO lnTdeb, lnTcred, lnSold
NOU=.T.
IF glPrimaLuna
NOU = .F.
ENDIF
PRIVATE plActiv
STORE .T. TO plActiv
PRIVATE eActiv
STORE .T. TO eActiv
IF !llParametri
PRIVATE polista,pcschema1,pcselect1,pcfiltru1,pcorder1
STORE "" TO polista
IF USED('clista')
USE IN clista
ENDIF
pcschema1=['cont c(4),acont c(4),explicatie c(50)']
pcselect1=['select distinct cont,rpad(CHR(32),4,CHR(32)) as acont,explicatie from ]+gcS+[.vcoresp_tip_cont where 1=2']
pcfiltru1=[2=2]
pcorder1=[cont]
llAfisare=.F.
gencursor('polista','clista',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfisare)
polista.ca_baza1.afisare()
SELECT clista
loCont=myscatter('blank')
Ol=CREATEOBJECT("frm_sel_cont")
WITH Ol
.Lb_titlu_alb_b121.CAPTION= 'Selectati contul'
IF EMPTY(.cboCont.ROWSOURCE)
.cboCont.ROWSOURCE="clista.cont,acont"
ENDIF
.ocont=loCont
IF EMPTY(.cAlias)
.cAlias=LEFT(.cboCont.ROWSOURCE,AT(".",.cboCont.ROWSOURCE)-1)
ENDIF
.HEIGHT = 190
ENDWITH
Ol.SHOW(1)
IF buton = 2
USE IN clista
RETURN
ENDIF
lcContPart = loCont.CONT
IF !llTitluTot AND EMPTY(lcDenumire)
lcDenumire = "Inregistrari " + ALLTRIM(clista.explicatie) + "( " + lcContPart + " )"
ELSE
IF !EMPTY(lcDenumire) AND !llTitluTot
lcDenumire = "Inregistrari " + lcDenumire + "( " + lcContPart + " )"
ENDIF
ENDIF
USE IN clista
plActiv = eActiv
ELSE
eActiv = llActiv
plActiv = llActiv
lcContPart = lcCont
IF !llTitluTot AND EMPTY(lcDenumire)
lcDenumire = "Inregistrari " + "( " + lcContPart + " )"
ELSE
IF !EMPTY(lcDenumire) AND !llTitluTot
lcDenumire = "Inregistrari " + lcDenumire + "( " + lcContPart + " )"
ENDIF
ENDIF
ENDIF
*** verificare INAINTE_DE
DO inainte WITH "IREG_PARTENERI",lcContPart IN oinainte_de.prg
IF tlTest
DO test_ireg WITH lcContPart,llActiv
ENDIF
pcCont = lcContPart
PRIVATE poireg_parteneri,pcschema1,pcselect1
STORE '' TO poireg_parteneri
pcschema1 = ['id_ireg_part n(20),an n(4), luna n(2),ID_FACT N(20),id_part n(20),cont c(4),acont c(4), ID_VALUTA N(5), ID_VENCHELT N(5), PROC_TVA N(8,2),' +] + ;
['PRECDEB N(20,4),PRECCRED N(20,4),PRECVALDEB N(20,4),PRECVALCRED N(20,4),' +] + ;
['debit n(20,4),credit n(20,4),valdebit n(20,4), valcredit n(20,4),' +] + ;
['NRACT N(14),DATAACT D,DATAIREG D,DATASCAD D,CURS N(9,3),' +] + ;
['COD N(20),EXPLICATIA C(100),EXPLICATIA4 C(100),EXPLICATIA5 C(100), ' +] + ;
['ID_RESPONSABIL N(5),ID_FDOC N(5),ID_LUCRARE N(5),ID_SET N(20),ID_ACT N(20),' +] + ;
['NUME C(100),COD_FISCAL C(30),FDOC C(50),NRESP C(50),NRORD C(50),NUME_VAL C(10),VENCHELT C(50)' ]
pcselect1=['SELECT I.ID_IREG_PART, I.AN, I.LUNA, ID_FACT, I.ID_PART, I.CONT, I.ACONT, I.ID_VALUTA, I.ID_VENCHELT, I.PROC_TVA,' + ] +;
['I.PRECDEB, I.PRECCRED, I.PRECVALDEB, I.PRECVALCRED, ' + ] +;
['I.DEBIT, I.CREDIT, I.VALDEBIT, I.VALCREDIT, ' + ] +;
['I.NRACT, I.DATAACT, I.DATAIREG, I.DATASCAD, I.CURS,' + ] +;
['I.COD, I.EXPLICATIA, I.EXPLICATIA4, I.EXPLICATIA5,' + ] +;
['I.ID_RESPONSABIL, I.ID_FDOC, I.ID_LUCRARE, I.ID_SET, I.ID_ACT,' + ] +;
['I.NUME,I.COD_FISCAL,I.FDOC,I.NRESP,I.NRORD,I.NUME_VAL,I.VENCHELT' + ] + ;
[' FROM ] + GCS + [.VIREG_PARTENERI I WHERE 1=2']
*!* pcselect1=['select i.*,p.cod_fiscal from ] + gcS + [.vireg_parteneri i join ] + gcS + ;
*!* [.vnom_parteneri p on p.id_part = i.id_part where 1=2']
pcorder1=[dataact]
pcfiltru1 = [1=2]
*!* pcfiltru1 = [cont = '] + Alltrim(pcCont) + [' and luna = ] + Alltrim(Str(gnLuna)) + [ and an = ] + Alltrim(Str(gnAn))
gencursor('poireg_parteneri','actcv',pcselect1,pcfiltru1,pcschema1,pcorder1)
poireg_parteneri.ca_baza1.afisare()
SELECT actcv
tcFis2 = "ActCv"
tlVisible = .T.
LOCAL c
c="nume+ALLTRIM(STR(YEAR(dataact)))+RIGHT('0'+ALLTRIM(STR(MONTH(dataact))),2)+RIGHT('0'+ALLTRIM(STR(DAY(dataact))),2)"
buton=1
IF tlTest AND .F.
PRIVATE pcCampVerif
pcCampVerif = ofis.camp_verif
SELECT (tcFis2)
SET FILTER TO
lcProc='inainte_'+ALLTRIM(tcFis2)
DO &lcProc IN inaintede.prg
IF buton=2
RETURN
ENDIF
ENDIF
SELE actcv
PRIVATE pcAnalitic,pcLucrare
STORE '' TO pcAnalitic,pcLucrare
Oreg=CREATEOBJECT("FRM_IREG_PARTENERI")
WITH Oreg
.lActiv = llActiv
.cCont = lcContPart
*!* .LABEL10.Caption=Proper(tctitlu)&&& trebuie facut
.LABEL10.CAPTION= PROPER(lcDenumire)
.grid1.column12.VISIBLE=.T.
.CONT=ALLT(pcCont)
.fisier=ALLTRIM(tcFis2)
.Ck_valuta.VISIBLE=tlVisible
.CK_explicatia.VISIBLE=tlVisible
.CHECK7.VISIBLE=tlVisible
.CHECK9.VISIBLE=tlVisible
.grid1.column2.VISIBLE=tlVisible
.grid1.column11.VISIBLE=tlVisible
.grid1.column13.VISIBLE=tlVisible
.grid1.column14.VISIBLE=tlVisible
.grid1.column7.VISIBLE=tlVisible
.grid1.column8.VISIBLE=tlVisible
.grid1.column10.VISIBLE=tlVisible
IF !tlVisible
.CHECK3.CAPTION='Regularizate'
.CHECK4.CAPTION='Neregularizate'
.check10.CAPTION='Regularizat'
.grid1.column12.header1.CAPTION='Regularizat'
.grid1.column2.WIDTH=0
ENDIF
IF !plActiv
.grid1.column9.CONTROLSOURCE = "(preccred+credit)-(precdeb+debit)"
.grid1.column14.CONTROLSOURCE ="(precvalcred+valcredit)-(precvaldeb+valdebit)"
.ck_sold.camp_nume = "credit+preccred-precdeb-debit"
.grid1.column1.CONTROLSOURCE = "preccred+credit"
.grid1.column12.CONTROLSOURCE = "precdeb+debit"
.grid1.column11.CONTROLSOURCE = "precvalcred+valcredit"
.grid1.column13.CONTROLSOURCE = "precvaldeb+valdebit"
.grid1.column20.CONTROLSOURCE = "credit"
.grid1.column21.CONTROLSOURCE = "debit"
.grid1.column22.CONTROLSOURCE = "valcredit"
.grid1.column23.CONTROLSOURCE = "valdebit"
.grid1.column18.CONTROLSOURCE = "preccred"
.grid1.column19.CONTROLSOURCE = "precdeb"
.grid1.column1.header1.CAPTION = "Total " + lcDenCredit
.grid1.column12.header1.CAPTION = "Total " + lcDenDebit
.grid1.column11.header11.CAPTION = "Total " + lcDenCredit + " valuta"
.grid1.column13.header1.CAPTION = "Total " + lcDenDebit + " valuta"
.grid1.column20.header1.CAPTION = lcDenCredit
.grid1.column21.header1.CAPTION = lcDenDebit
.grid1.column22.header1.CAPTION = lcDenCredit + " valuta"
.grid1.column23.header1.CAPTION = lcDenDebit + " valuta"
.grid1.column18.header1.CAPTION = "Prec " + lcDenCredit
.grid1.column19.header1.CAPTION = "Prec " + lcDenDebit
ELSE
.grid1.column9.CONTROLSOURCE = "(precdeb+debit)-(preccred+credit)"
.grid1.column14.CONTROLSOURCE ="(precvaldeb+valdebit)-(precvalcred+valcredit)"
.ck_sold.camp_nume = "precdeb+debit-credit-preccred"
.grid1.column1.header1.CAPTION = "Total " + lcDenDebit
.grid1.column12.header1.CAPTION = "Total " + lcDenCredit
.grid1.column11.header11.CAPTION = "Total " + lcDenDebit + " valuta"
.grid1.column13.header1.CAPTION = "Total " + lcDenCredit + " valuta"
.grid1.column20.header1.CAPTION = lcDenDebit
.grid1.column21.header1.CAPTION = lcDenCredit
.grid1.column22.header1.CAPTION = lcDenDebit + " valuta"
.grid1.column23.header1.CAPTION = lcDenCredit + " valuta"
.grid1.column18.header1.CAPTION = "Prec " + lcDenDebit
.grid1.column19.header1.CAPTION = "Prec " + lcDenCredit
ENDIF
IF TYPE('pcTotctva')#'U' AND TYPE('pcAchitat')#'U'
.grid1.column12.header1.CAPTION=pcAchitat
.grid1.column1.header1.CAPTION=pcTotctva
ENDIF
IF TYPE('pcSumaTotal')#'U' AND TYPE('pcSumaAchi')#'U'
.CHECK13.CAPTION=pcSumaTotal
.check10.CAPTION=pcSumaAchi
ENDIF
IF TYPE('actcv.nresp') # 'U'
.grid1.column17.VISIBLE= .T.
.grid1.column17.CONTROLSOURCE = 'nresp'
.Ck_responsabil.VISIBLE = .T.
ENDIF
ENDWITH
Oreg.SHOW(1)
*!* Select actcv
*!* If Used('actcv')
*!* Use In actcv
*!* Endif
*!* Release ofis
RELEASE Oreg
USE IN actcv
ENDPROC && lans_ireg_parteneri
*---------------------------------------------------------------------------------
PROCEDURE lans_balanta_parteneri
LPARAMETERS tcCont,tlactiv,tlTitluTot,tcDenumire,tcDenDebit,tcDenCredit &&initital cu 2 parametrii
*!* tlTitluTot = daca denumirea titlului este totala i.e.: Nu trebuie sa mai adaug Balanta parteneri
*!* tcDenumire = titlul balantei
*!* tcDenDebit = peste tot pe unde apare debit se va inlocui cu aceasta denumire
*!* tcDenCredit = peste tot pe unde apare credit se va inlocui cu aceasta denumire
LOCAL llParametri, lcCont, llActiv,llTitluTot,lcDenumire,lcDenDebit,lcDenCredit
llParametri = .F.
lcCont = ''
llActiv = .F.
IF EMPTY(tlTitluTot)
llTitluTot = .F.
ELSE
llTitluTot = tlTitluTot
ENDIF
IF EMPTY(tcDenumire)
lcDenumire = ""
ELSE
lcDenumire= tcDenumire
ENDIF
IF EMPTY(tcDenDebit)
lcDenDebit = "Debit"
ELSE
lcDenDebit = tcDenDebit
ENDIF
IF EMPTY(tcDenCredit)
lcDenCredit = "Credit"
ELSE
lcDenCredit = tcDenCredit
ENDIF
*!* IF PCOUNT() < 2
IF EMPTY(tcCont) AND EMPTY(tlactiv)
llParametri = .F.
ELSE
llParametri = .T.
lcCont = ALLTRIM(tcCont)
llActiv = tlactiv
ENDIF
LOCAL NOU, lnTdeb, lnTcred, lnSold, lcContPart, lclista
STORE 0 TO lnTdeb, lnTcred, lnSold
NOU=.T.
IF .F.
SELECT calendar
GO TOP
IF an=pcAn AND NL=pcNl
NOU=.F.
ENDIF
ENDIF
*!* IF glPrimaLuna
*!* nou = .F.
*!* ENDIF
PRIVATE polista,pcschema1,pcselect1,pcfiltru1,pcorder1
STORE "" TO polista
IF !llParametri
IF USED('clista')
USE IN clista
ENDIF
pcschema1=['cont c(4),acont c(4),explicatie c(50)']
pcselect1=['select distinct cont,rpad(CHR(32),4,CHR(32)) as acont,explicatie from ]+gcS+[.vcoresp_tip_cont where 1=2']
pcfiltru1=[2=2]
pcorder1=[cont]
llAfisare=.F.
gencursor('polista','clista',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfisare)
polista.ca_baza1.afisare()
*!* SELECT DISTINCT cont, '' as acont FROM coresp_tip_cont INTO CURSOR clista
SELECT clista
loCont=myscatter('blank')
PRIVATE eActiv
STORE .T. TO eActiv
Ol=CREATEOBJECT("frm_sel_cont")
WITH Ol
.Lb_titlu_alb_b121.CAPTION= 'Selectati contul'
IF EMPTY(.cboCont.ROWSOURCE)
.cboCont.ROWSOURCE="clista.cont,acont"
ENDIF
.ocont=loCont
IF EMPTY(.cAlias)
.cAlias=LEFT(.cboCont.ROWSOURCE,AT(".",.cboCont.ROWSOURCE)-1)
ENDIF
.HEIGHT = 190
ENDWITH
Ol.SHOW(1)
IF buton = 2
USE IN clista
RETURN
ENDIF
lcContPart = loCont.CONT
IF !llTitluTot AND EMPTY(lcDenumire)
lcDenumire = "Balanta " + ALLTRIM(clista.explicatie) + "( " + lcContPart + " )"
ELSE
IF !EMPTY(lcDenumire) AND !llTitluTot
lcDenumire = "Balanta " + lcDenumire + "( " + lcContPart + " )"
ENDIF
ENDIF
USE IN clista
ELSE
lcContPart = lcCont
eActiv = llActiv
IF !llTitluTot AND EMPTY(lcDenumire)
lcDenumire = "Balanta " + "( " + lcContPart + " )"
ELSE
IF !EMPTY(lcDenumire) AND !llTitluTot
lcDenumire = "Balanta " + lcDenumire + "( " + lcContPart + " )"
ENDIF
ENDIF
ENDIF
IF eActiv
lnSemn = -1
ELSE
lnSemn = 1
ENDIF
*** verificare INAINTE_DE
DO inainte WITH "BALANTA_parteneri",lcContPart IN oinainte_de.prg
PRIVATE pobalpartext,pcschema2,pcselect2,pcfiltru2,pcorder2,pobalpartint,pcschema3,pcselect3,pcfiltru3,pcorder3,pcgroup3
STORE "" TO pobalpartext,pobalpartint
pcschema2=['PRECDEB1 N(19,2),PRECCRED1 N(19,2),PRECDEB N(19,2),PRECCRED N(19,2),'+]+;
['DEB N(19,2),CRED N(19,2),PRECVALDEB1 N(19,2),PRECVALCRED1 N(19,2),PRECVALDEB N(19,2),'+]+;
['PRECVALCRED N(19,2),VALDEBIT N(19,2),VALCREDIT N(19,2),NUME_VAL C(5),ID_PART N(10),'+]+;
['NUME C(50),COD_FISCAL C(30),CONT C(4),ACONT C(4),AN N(4),LUNA N(2),TOTCRED N(19,2),TOTDEB N(19,2),'+]+;
['TOTVALCRED N(19,2),TOTVALDEB N(19,2),ID_VALUTA N(5)']
pcselect2=['select PRECDEB1,PRECCRED1,PRECDEB,PRECCRED,'+]+;
['DEBIT as DEB,CREDIT as CRED,PRECVALDEB1,PRECVALCRED1,PRECVALDEB,'+]+;
['PRECVALCRED,VALDEBIT,VALCREDIT,NUME_VAL,ID_PART,'+]+;
['NUME,COD_FISCAL,CONT,ACONT,AN,LUNA,'+]+;
['PRECCRED+CREDIT as TOTCRED,PRECDEB+DEBIT as TOTDEB,'+]+;
['PRECVALCRED+VALCREDIT as TOTVALCRED,PRECVALDEB+VALDEBIT as TOTVALDEB,ID_VALUTA '+]+;
['from ]+gcS+[.vbalanta_parteneri where 1=2']
pcfiltru2=[1=2]
pcorder2=[nume,acont]
llAfisare=.F.
gencursor('pobalpartext','xtemp',pcselect2,pcfiltru2,[''],pcorder2,llAfisare)
pobalpartext.ca_baza1.afisare()
pcschema3=['PRECDEB1 N(19,2),PRECCRED1 N(19,2),PRECDEB N(19,2),PRECCRED N(19,2),'+]+;
['DEB N(19,2),CRED N(19,2),PRECVALDEB1 N(19,2),PRECVALCRED1 N(19,2),PRECVALDEB N(19,2),'+]+;
['PRECVALCRED N(19,2),VALDEBIT N(19,2),VALCREDIT N(19,2),NUME_VAL C(5),ID_PART N(10),'+]+;
['NUME C(50),COD_FISCAL C(30),CONT C(4),ACONT C(4),AN N(4),LUNA N(2),TOTCRED N(19,2),TOTDEB N(19,2),'+]+;
['TOTVALCRED N(19,2),TOTVALDEB N(19,2),ID_VALUTA N(5)']
pcselect3=['select SUM(PRECDEB1) AS PRECDEB1,SUM(PRECCRED1) AS PRECCRED1,SUM(PRECDEB) AS PRECDEB,SUM(PRECCRED) AS PRECCRED,'+]+;
['SUM(DEBIT) as DEB,SUM(CREDIT) as CRED,0 AS PRECVALDEB1,0 AS PRECVALCRED1,0 AS PRECVALDEB,'+]+;
["0 AS PRECVALCRED,0 AS VALDEBIT,0 AS VALCREDIT,'LEI' AS NUME_VAL,ID_PART,"+]+;
['NUME,COD_FISCAL,CONT,ACONT,AN,LUNA,'+]+;
['SUM(PRECCRED+CREDIT) as TOTCRED,SUM(PRECDEB+DEBIT) as TOTDEB,'+]+;
['SUM(PRECVALCRED+VALCREDIT) as TOTVALCRED,SUM(PRECVALDEB+VALDEBIT) as TOTVALDEB,0 AS ID_VALUTA '+]+;
['from ]+gcS+[.vbalanta_parteneri where 1=2']
pcfiltru3=[1=2]
pcorder3=[nume,acont]
pcgroup3=[CONT,ACONT,AN,LUNA,ID_PART,NUME,COD_FISCAL]
llAfisare=.F.
gencursor('pobalpartint','xtemp',pcselect3,pcfiltru3,[''],pcorder3,llAfisare,pcgroup3)
pobalpartint.ca_baza1.afisare()
OVIZ=CREATEOBJECT("frm_bal_parteneri")
WITH OVIZ
*!* .LABEL10.Caption='SITUATIA ANALITICA - BALANTA PARTENERI (' + Alltrim(lcContPart) + ')'
.LABEL10.CAPTION = PROPER(lcDenumire)
IF eActiv
.grid1.column6.CONTROLSOURCE='- cred + deb'
.grid1.column10.CONTROLSOURCE='- totcred + totdeb'
.grid1.column9.CONTROLSOURCE='- preccred + precdeb'
.grid1.column21.CONTROLSOURCE='- totvalcred + totvaldeb'
.grid1.column18.CONTROLSOURCE='- precvalcred + precvaldeb'
*!* .grid1.column6.header1.Caption='Sold (deb-cred)'
*!* .grid1.COLUMN4.header1.Caption='Debit'
*!* .grid1.COLUMN5.header1.Caption='Credit'
.grid1.column6.header1.CAPTION= "Sold("+ALLTRIM(lcDenDebit)+"-"+ALLTRIM(lcDenCredit)+")"&&'Sold (cred-deb)'
.grid1.COLUMN4.header1.CAPTION= lcDenDebit&&Debit'
.grid1.COLUMN5.header1.CAPTION= lcDenCredit&&'Credit'
.grid1.column11.header1.CAPTION= "Prec." + lcDenDebit&&Debit'
.grid1.column12.header1.CAPTION= "Prec." + lcDenCredit&&'Credit'
.grid1.COLUMN15.header1.CAPTION= "Total" + lcDenDebit&&Debit'
.grid1.COLUMN16.header1.CAPTION= "Total" + lcDenCredit&&'Credit'
.pcfel='A'
ELSE
.grid1.column6.CONTROLSOURCE='cred - deb'
.grid1.column10.CONTROLSOURCE='totcred - totdeb'
.grid1.column9.CONTROLSOURCE='preccred - precdeb'
.grid1.column21.CONTROLSOURCE='totvalcred - totvaldeb'
.grid1.column18.CONTROLSOURCE='precvalcred - precvaldeb'
.grid1.column6.header1.CAPTION= "Sold("+ALLTRIM(lcDenCredit)+"-"+ALLTRIM(lcDenDebit)+")"&&'Sold (cred-deb)'
.grid1.COLUMN4.header1.CAPTION= lcDenDebit&&Debit'
.grid1.COLUMN5.header1.CAPTION= lcDenCredit&&'Credit'
.grid1.column12.header1.CAPTION= "Prec." + lcDenCredit&&'Credit'
.grid1.column11.header1.CAPTION= "Prec." + lcDenDebit&&'Debit'
*!* .grid1.column11.controlsource = "preccred"
*!* .grid1.column12.controlsource = "precdeb"
.grid1.COLUMN16.header1.CAPTION= "Total" + lcDenCredit&&'Credit'
.grid1.COLUMN17.header1.CAPTION= "Total" + lcDenDebit&&'Debit'
*!* .grid1.COLUMN15.controlsource= "totCred" &&Credit'
*!* .grid1.COLUMN16.controlsource= "TotDeb" &&'Debit'
.pcfel='P'
ENDIF
.grid1.column18.VISIBLE=.F.
.grid1.column19.VISIBLE=.F.
.grid1.column20.VISIBLE=.F.
.grid1.column21.VISIBLE=.F.
.grid1.column22.VISIBLE=.F.
.TABEL = 'BALANTA_PARTENER'
.pcCont = ALLTRIM(lcContPart)
.grid1.column8.WIDTH=0
.grid1.column13.WIDTH=0
.grid1.column14.WIDTH=0
.grid1.column8.VISIBLE=.F.
.grid1.column13.VISIBLE=.F.
.grid1.column14.VISIBLE=.F.
.label7.VISIBLE=.F.
.text4.VISIBLE=.F.
.TEXT5.VISIBLE=.F.
.text9.VISIBLE=.F.
ENDWITH
IF !NOU
WITH OVIZ.grid1
.column2.COLUMNORDER=2
FOR I=9 TO 16
lcViz='.column'+ALLTRIM(STR(I))+'.visible=.f.'
*lcWidth='.column'+ALLTRIM(STR(i))+'.width=0'
&lcViz
*&lcWidth
ENDFOR
ENDWITH
ENDIF
OVIZ.SHOW(1)
USE IN xtemp
*!* ENDIF
ENDPROC && lans_balanta_parteneri
*----------------------------------------------------------------------------------------------
*---------------------------------- Inceput lans_balanta_cumulata ----------------------------------
PROCEDURE lans_balanta_cumulata
pcselect = [select explicatie, id_coloana from ] + gcs + [.coloane where 2=2]
pcfiltru = [2=2]
pcschema = ['']
pcorder = [explicatie]
pccoloane = [explicatie]
pcTitlu = [Alegeti Balanta]
pcFiltruOriginal = [camp is null and tabel is null and id_prg_owner = 2 and configurabil = 1]
locauta = cauta_alfa(pcselect,pcfiltru,pcschema,pcorder,pccoloane,pcTitlu,pcTitlu,"",.f.,pcFiltruOriginal)
IF EMPTY(locauta.id_coloana) OR ISNULL(locauta.id_coloana)
RETURN
ENDIF
pnIdBal = locauta.id_coloana
pcTitluCol = []
pcNumeCol = []
lcSel = [{call pack_balante_cumulate.balante_cumulate(?@pcNumeCol,?@pcTitluCol,?gcS,?pnIdBal,?gnAn,?gnLuna)}]
lcSchema = []
lcCursor = 'crs_bal'
lnSucces = goExecutor.oExecute(lcSel,lcCursor)
IF lnSucces < 0
MESSAGEBOX(goExecutor.cEroare,0+16,"Eroare")
RETURN
ENDIF
pcNumeCol = [nume;cod_fiscal;acont;] + pcNumeCol
pcTitluCol = [Partener,Cod Fiscal,Analitic,] + pcTitluCol
SELECT (lcCursor)
SCATTER NAME loto BLANK
obalp = CREATEOBJECT('frm_bal_parteneri_cumulata')
obalp.ototal = loto
WITH obalp.ct_grid_order1
.cselect = lcSel
.cschema = lcSchema
.cTitlu_coloane = pcTitluCol
.cNume_coloane = pcNumeCol
.cFiltruOriginal = []
.cFiltru = []
.cOrder = []
.cTitlu = []
.cnumeCursor = lcCursor
.lmodparam = .T.
ENDWITH
obalp.ctitlu = locauta.explicatie
obalp.show()
IF USED(lcCursor)
USE IN (lcCursor)
ENDIF
ENDPROC && lans_balanta_cumulata
*---------------------------------- Sfarsit lans_balanta_cumulata ----------------------------------
*---------------------------------- Inceput configurare_balanta_cumulata ----------------------------------
PROCEDURE configurare_balanta_cumulata
PRIVATE pnIdBalanta, pnIdColoana
STORE 0 TO pnIdBalanta, pnIdColoana
pcselect1 = [select explicatie,explicatie2, id_coloana from ] + gcs + [.coloane ]
pcfiltru1 = [camp is null and tabel is null and id_prg_owner = 2 and configurabil = 1]
pcschema1 = ['']
pcorder1 = [explicatie]
pccoloane1 = [explicatie; explicatie2]
pcTitluCol1 = [Titlu Balanta,Conturi]
pcTitlu1 = [Lista Balante Configurate]
pcselect2 = [select f.id_calcul, f.id_op_col , f.ordine, f.id_coloana, c.camp, c.explicatie from ] + gcs + [.sal_calcul f left join ] + ;
gcs +[.coloane c on f.id_op_col = c.id_coloana and f.coloana = 1]
pcfiltru2 = [f.id_coloana =?pnIdBalanta]
pcschema2 = ['']
pcorder2 = [f.ordine]
pccoloane2 = [explicatie; ordine]
pcMask2 = '[1]=;[2]=REPLICATE("9",3)'
pcTitluCol2 = [Titlu coloana, Ordine]
pcTitlu2 = [Coloane Balanta]
pcselect3 = [select id_calcul, id_coloana, id_op_col, explicatie, camp, coloana, ordine from ] + gcs + [.cont_vformule_balante ]
pcfiltru3 = [id_coloana =?pnIdColoana]
pcschema3 = ['']
pcorder3 = [ordine]
pccoloane3 = [camp;explicatie;ordine]
pcMask3 = '[1]=;[2]=;[3]=REPLICATE("9",3)'
pcTitluCol3 = [Camp,Explicatie,Ordine]
pcTitlu3 = [Formula Coloane]
obalp = CREATEOBJECT('config_balante_parteneri')
WITH obalp.Ct_grid_search1
.cselect = pcselect1
.cschema = pcschema1
.cTitlu_coloane = pcTitluCol1
.cNume_coloane = pccoloane1
.cFiltruOriginal = pcfiltru1
.cFiltru = [2=2]
.cOrder = pcorder1
.cTitlu = pcTitlu1
.cnumeCursor = 'crs_NumeBal'
.lmodparam = .T.
ENDWITH
WITH obalp.Ct_grid_search2
.cselect = pcselect2
.cschema = pcschema2
.cTitlu_coloane = pcTitluCol2
.cNume_coloane = pccoloane2
.cFiltruOriginal = pcfiltru2
.cFiltru = [2=2]
.cOrder = pcorder2
.cTitlu = pcTitlu2
.cMask = pcMask2
.cnumeCursor = 'crs_ColoaneBal'
.lmodparam = .t.
ENDWITH
WITH obalp.Ct_grid_search3
.cselect = pcselect3
.cschema = pcschema3
.cTitlu_coloane = pcTitluCol3
.cNume_coloane = pccoloane3
.cFiltruOriginal = pcfiltru3
.cFiltru = [2=2]
.cOrder = pcorder3
.cTitlu = pcTitlu3
.cMask = pcMask3
.cnumeCursor = 'crs_FormulaBal'
.lmodparam = .t.
ENDWITH
obalp.show()
ENDPROC && configurare_balanta_cumulata
*---------------------------------- Sfarsit configurare_balanta_cumulata ----------------------------------

196
Programe/oproceduri_app.prg Normal file
View File

@@ -0,0 +1,196 @@
Define Class gridDinamic As Grid
Visible = .T.
DeleteMark = .F.
RecordMark = .F.
HighlightStyle = 2
SplitBar = .F.
Enddefine
Define Class pornesteLans As Session
Procedure text1DblClick
This.lans(crsSets_categorii.id_set)
Endproc
Procedure text1KeyPress
Parameters nKeyCode, nShiftAltCtrl
If nKeyCode = 13
This.lans(crsSets_categorii.id_set)
Endif
Endproc
Procedure lans
Parameters tnId_set
Set DataSession To 1
Private pl_verificat
pl_verificat = .F.
Private _program
_program = 'cont'
Local lcSql, lnSucces, lnLinii, lnLiniiReq
lcSql = [select r.valoare_default,r.id_item,i.camp_lista, i.id_fisier,pack_util.GetText(i.fis_lista,] + ;
[i.id_fisier, to_number(r.valoare_default), replace(i.camp_lista, ',' , ' || '' '' || ')) ] + ;
[as valoare_default_text, i.var_item ] + ;
[from xrequest r ] + ;
[join xitems i on i.id_item = r.id_item ] + ;
[where r.id_set = ?tnId_set and r.valoare_default is not null ]
lnSucces = goExecutor.oExecute(lcSql, [crsRequest])
If lnSucces < 0
Messagebox([Eroare])
Return
Endif
lnLiniiReq = Reccount("crsRequest") * 2
If lnLiniiReq = 0
Messagebox([Nu exista note predefinite pentru aceasta categorie])
Return
Endif
lcSql = [select n.cont,n.id_part,n.id_set, p.nume, n.tip ] + ;
[ from (select n1.xscd as cont, n1.id_partd as id_part, n1.id_set, 'D' as tip ] + ;
[ from xnote n1 ] + ;
[ where nvl(n1.id_partd, 0) <> 0 and n1.id_set = ?tnId_Set ] + ;
[ union ] + ;
[ select n2.xscc as cont, n2.id_partc as id_part, n2.id_set, 'C' as tip ] + ;
[ from xnote n2 ] + ;
[ where nvl(n2.id_partc, 0) <> 0 and n2.id_set = ?tnId_Set ) n ] + ;
[ join nom_parteneri p on n.id_part = p.id_part]
lnSucces = goExecutor.oExecute(lcSql,[crsNumePartener])
If lnSucces<0
amessagebox(goExecutor.ceroare,0+16,[Eroare])
Return
Endif
lnLinii = Reccount("crsNumePartener") * 2
Dimension laValori(lnLiniiReq + lnLinii,4)
Select crsRequest
i = 1
Scan
laValori(i,1) = "poAct." + Allt(Nvl(crsRequest.id_fisier,[]))
laValori(i,2) = Allt(Nvl(crsRequest.valoare_default,[]))
laValori(i,3) = .F.
laValori(i,4) = .T.
laValori(i+1,1) = "poAct." + Allt(Nvl(crsRequest.var_item,[]))
laValori(i+1,2) = Alltrim(Nvl(crsRequest.valoare_default_text,[]))
laValori(i+1,3) = .F.
laValori(i+1,4) = .T.
i = i + 2
Endscan
Select crsNumePartener
Scan
laValori(i,1) = "poact.id_vv" + Alltrim(Nvl(crsNumePartener.Cont,[])) + ;
IIF(INLIST(LEFT(cont,2),'51','53'),IIF(tip = 'D' ,'0','1'),'')
laValori(i,2) = Alltrim(Str(Nvl(crsNumePartener.id_part,0)))
laValori(i,3) = !Empty(Nvl(crsNumePartener.id_part,0))
laValori(i,4) = .T.
laValori(i+1,1) = "poact.v" + Alltrim(crsNumePartener.Cont)+ ;
IIF(INLIST(LEFT(cont,2),'51','53'),IIF(tip = 'D' ,'0','1'),'')
laValori(i+1,2) = Alltrim(Nvl(crsNumePartener.nume,[]))
laValori(i+1,3) = !Empty(Nvl(crsNumePartener.id_part,0))
laValori(i+1,4) = .T.
i = i + 2
Endscan
Select xsets
If Seek(tnId_set,"xsets")
Scatter Name loxset
If loxset.aleg_cont
Private pcACN, cn, cn2, pcACN2
Store '' To pcACN, cn, cn2, pcACN2
Endif
Endif
lans(tnId_set,.T.,.T.,@laValori)
Use In (Select("crsNumePart"))
Use In (Select("crsRequest"))
Endproc
Enddefine
*********************************** incaseaza_monetar_50505 ***************************
Procedure incaseaza_monetar_50505
Private pl_verificat
pl_verificat = .F.
Local lnRaspuns, loIm
Private pcCont1, pcAcont1, pcCont2, pcAcont2
Private pcACN, cn, cn2, pcACN2, loCont, loCont2, _program
_program = 'cont'
lnRaspuns = 6
Do While lnRaspuns = 6
Store '' To pcACN, cn, cn2, pcACN2
loCont = ret_cont("Selectati contul",'704,707')
If gnButon = 2
lnRaspuns = 7
Else
pcCont1=loCont.Cont
pcAcont1=loCont.Acont
loCont2=ret_cont("Selectati contul",'4111')
If gnButon = 2
lnRaspuns = 7
Else
pcCont2=loCont2.Cont
pcAcont2=loCont2.Acont
Do update_jtva_coloane With [JV]
Create Cursor crsIncasare_monetar (serie c(15),id_part N(10),nr_factura N(14), ;
nr_incasare N(14), numeclient c(60), valctva N(17,gnPa), valftva N(17,gnPa), ;
valtva N(17,gnPa), id_jtva_coloana i(4),cota_tva N(2))
Select crsIncasare_monetar
loIm = Createobject('frm_incasare_monetar_50505')
loIm.Show(1)
If Used('crsIncasare_monetar')
Use In crsIncasare_monetar
Endif
If Used('actactan_o')
Use In actactan_o
Endif
Endif
Endif
If lnRaspuns <> 7
lnRaspuns = amessagebox('Doriti sa continuati cu operatii de acest fel?',4+32,"Confirmare")
Endif
Enddo
* Release lnRaspuns,pcCont1,pcAcont1,pcCont2,pcAcont2
Endproc && incaseaza_monetar_50505 ***************************
************* incaseaza_monetar *********************************
Procedure incaseaza_monetar
Local loIm, lnRaspuns
Private pl_verificat
pl_verificat = .F.
Private pcCont1, pcAcont1, pcCont2, pcAcont2
Private pcACN, cn, cn2, pcACN2, loCont, loCont2, _program
lnRaspuns = 6
Do While lnRaspuns = 6
Do update_jtva_coloane With [JV]
Create Cursor crsIncasare_monetar (serie c(15),id_part N(10),nr_factura N(14), ;
nr_incasare N(14), numeclient c(60), valctva N(17,gnPa), valftva N(17,gnPa), ;
valtva N(17,gnPa), id_jtva_coloana i(4),cota_tva N(2))
Select crsIncasare_monetar
loIm = Createobject('frm_incasare_monetar')
loIm.Show(1)
If Used('crsIncasare_monetar')
Use In crsIncasare_monetar
Endif
If lnRaspuns <> 7
lnRaspuns = amessagebox('Doriti sa continuati cu operatii de acest fel?',4+32,"Confirmare")
Endif
Enddo
Endproc && incaseaza_monetar ^^ *********************************

View File

@@ -0,0 +1,57 @@
******************************************************************
PROCEDURE listare_registru_tva
LPARAMETERS tcRegistru
pcRegistru = UPPER(ALLTRIM(tcRegistru))
DO CASE
CASE 'VANZ'$pcRegistru
pcContTVA = [4427]
pcListaContTVA = [411,4111,4112,4113,4114,4115,4116,4117,461,635,5311,5121,428,4281,4282,4426,4428]
pcListaContBaza = [411,4111,4112,4113,4114,4115,4116,4117,461,428,4281,4282]
pcListaContExceptii = [667,419]
OTHERWISE
pcContTVA = [4426]
pcListaContTVA = [401,404,5121,5124,542,4427,4428]
pcListaContBaza = [401,404]
pcListaContExceptii = [767]
ENDCASE
lcSql = [{call PACK_REGISTRE_TVA.REGISTRUTVA(?gcS, ?gnAn, ?gnLuna, ] + ;
[?pcRegistru, ?pcContTVA, ?pcListaContTVA, ?pcListaContBaza, ?pcListaContExceptii )}]
lcCursor = 'crsRegistruTemp'
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
IF lnSucces < 0
AMESSAGE(goExecutor.cEroare,0+16,"Eroare")
ELSE
SELECT nract, dataact, PART AS nume, cod_fiscal, fdoc, baza, proc_tva, tva, baza + tva as totctva, 00000000000.0000 as total ;
FROM crsRegistruTemp ;
INTO CURSOR crsRegistru ;
READWRITE ORDER BY nract, dataact, nume
USE IN crsRegistruTemp
SELECT nract, dataact, nume,sum(totctva) as total ;
from crsRegistru ;
INTO CURSOR tgrup ;
GROUP BY nract, dataact, nume
SELECT tgrup
SCAN
SCATTER NAME ot
SELECT crsRegistru
LOCATE FOR nume = ot.nume AND nract = ot.nract AND dataact = ot.dataact
IF FOUND()
REPLACE total WITH ot.total
ENDIF
SELECT tgrup
ENDSCAN
USE IN tgrup
SELECT crsRegistru
REPORT FORM registru_tva_simplu TO PRINTER PROMPT PREVIEW
USE IN crsRegistru
ENDIF
ENDPROC
******************************************************************

View File

@@ -0,0 +1,978 @@
*******************************************
* PROCEDURE inchidprog( )
* Date : 05/23/05, 11:32:30
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE inchidprog( )
RETURN
ENDPROC
*----------------------------------sfarsit procedura inchidprog----------------------------------
*___________________________________________
Procedure nrord
Parameters ALI
Sele &ALI
A=Reccount()
If A=0
Return
Endif
If A>65000
Return 0
Endif
Declare NROR(A)
K=0
Scan
K=K+1
NROR(K)=Recno()
Endscan
Return
Function NRCRT
NR=Ascan(NROR,Recno())
Return NR
**********************
*_____________________________________-
PROCEDURE IESIRE
QUIT
RETURN
*___________________________________________
Procedure mesaj
Parameters m1,m2
ot=Create('text')
ot.label2.Caption=m1
ot.label3.Caption=m2
ot.Show(1)
Return
*___________________________________________
Procedure danu
Parameters m1
od=Create('danu')
od.label1.Caption=m1
od.Show(1)
RETURN
*_________________________________________________________
PROCEDURE caut_alfa_cursor
PARAMETERS NUMEBAZA,NUMECIMP,CAPTEXT,VARMEM
LOCAL MC0,MC1,MC2, llVizibil
SET SAFETY OFF
llVizibil = .t.
MC0='SELE '+NUMEBAZA
MC1='VARMEM=M.'+NUMECIMP
*MC2='SET order TO TAG '+NUMECIMP
MC2 = [INDEX ON ] +NUMECIMP+ [ TAG nume OF &loc\&nfscurt\tempo\xindex.idx COMPACT ASCENDING ]
*!* &MC0
*!* &MC2
*!* GO TOP
LOCAL lcNumeCol2
STORE '' TO lcNumeCol2
LcCol = ALLTRIM(NUMEBAZA) + '.cod_fiscal'
IF TYPE(LcCol) # 'U'
lcNumeCol2 = 'cod_fiscal'
ENDIF
LcCol = ALLTRIM(NUMEBAZA) + '.gest'
IF TYPE(LcCol) # 'U'
lcNumeCol2 = 'gest'
ENDIF
LcCol = ALLTRIM(NUMEBAZA) + '.id_sectie'
IF TYPE(LcCol) # 'U'
lcNumeCol2 = 'id_sectie'
ENDIF
IF EMPTY(lcNumeCol2)
lcNumeCol2 = 'space(4)'
llVizibil = .f.
ENDIF
LcCol = ALLTRIM(NUMEBAZA) + '.id'
IF TYPE(LcCol) # 'U'
lcNumeCol3 = 'id'
ELSE
lcNumeCol3 = 'space(4)'
ENDIF
SELECT DISTINCT &NUMECIMP, &lcNumeCol2, &lcNumeCol3 FROM (numebaza) INTO CURSOR tnomenclator READWRITE ORDER BY &NUMECIMP
OCA=CREATEOBJECT("CAUTALFa")
OCA.CAPTION=CAPTEXT
OCA.GRID1.RECORDSOURCE='tnomenclator'
OCA.GRID1.COLUMN1.CONTROLSOURCE = NUMECIMP
OCA.GRID1.COLUMN2.CONTROLSOURCE = lcNumeCol2
OCA.GRID1.COLUMN2.visible = llVizibil
OCA.cmdrenunt1.visible=.t.
OCA.command1.visible=.f.
OCA.command2.visible=.f.
OCA.command3.visible=.f.
OCA.SHOW(1)
*!* &MC0
*!* SCATTER MEMVAR
*!* SET FILTER TO
IF buton=2
USE IN tnomenclator
RETURN
ENDIF
lcFile = ADDBS(gcTempPath) + 'xindex.idx'
IF FILE(lcFile)
SET INDEX TO
DELETE FILE &lcFile
ENDIF
*!* &MC1
SELECT tnomenclator
SCATTER MEMVAR
&MC1
USE IN tnomenclator
RETURN
*_________________________________________________________
Procedure CAUT_ALF
Parameters NUMEBAZA,NUMECIMP,CAPTEXT,VARMEM
Local MC0,MC1,MC2
Set Safety Off
MC0='SELE '+NUMEBAZA
MC1='VARMEM=M.'+NUMECIMP
MC2='SET order TO TAG '+NUMECIMP
&MC0
Go Top
If Eof()
Appe Blank
Endif
&MC2
OCA=Createobject("CAUTALF")
OCA.Caption=CAPTEXT
OCA.GRID1.RecordSource=NUMEBAZA
OCA.GRID1.COLUMN1.ControlSource=NUMECIMP
OCA.Show(1)
Scatter Memvar
&MC1
Return
*_________________________________________________________
*******************************************
* PROCEDURE introd_respsal( )
* Date : 05/23/05, 12:27:24
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE introd_respsal( )
Private poresp,pcschema1,pcselect1
Store '' To poresp
If Used('v_resp')
Use In v_resp
Endif
pcschema1=['']
pcselect1=['select * from ] + gcS + [.sal_responsabil where 1=2']
pcorder1=[nume,prenume]
pcfiltru1 = [sters = 0]
llAfiseaza = .F.
gencursor('poresp','v_resp',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfiseaza)
poresp.ca_baza1.afisare()
ofrmresp=Createobject('frm_resp_sal')
ofrmresp.Show(1)
Release poresp
ENDPROC
*----------------------------------sfarsit procedura introd_respsal----------------------------------
*******************************************
* PROCEDURE zile_lucr( )
* Date : 05/23/05, 15:30:38
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE zile_lucr( )
*----------- sarbatori
Private posarbat,pcschema1,pcselect1
Store '' To posarbat
If Used('v_sarbat')
Use In v_sarbat
Endif
pcschema1=['data d,sarbatoare c(16),id_sarbat n(10)']
pcselect1=[select data,sarbatoare,id_sarbat from ] + gcS + [.sal_nom_sarbatori where sters = 0]
pcorder1=[data]
pcfiltru1 = [extract(year from data) = ] + ALLTRIM(STR(gnAN)) + [ and sters = 0]
llAfiseaza = .F.
gencursor('posarbat','v_sarbat',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfiseaza)
posarbat.ca_baza1.afisare()
SELECT v_sarbat
*----------- zile lucratoare
Private pozile,pcschema2,pcselect2
Store '' To pozile
If Used('v_zile')
Use In v_zile
Endif
pcschema2=['']
pcselect2=[select * from ] + gcS + [.sal_calendar where 1=2]
pcorder2=[luna,an]
*!* pcfiltru2 = [ 2 = 2 ]
pcfiltru2 = [ luna = ] + ALLTRIM(STR(gnLuna)) + [ and an = ]+ALLTRIM(STR(gnAn))
llAfiseaza = .F.
gencursor('pozile','v_zile',pcselect2,pcfiltru2,pcschema2,pcorder2,llAfiseaza)
pozile.ca_baza1.afisare()
SELECT v_sarbat
*--------------
PRIVATE pnIdSal,pnZileluc,pnOreluc,pnOrestas
STORE 0 TO pnIdSal,pnZileluc,pnOreluc,pnOrestas
pnIdSal = v_zile.id_Calendar
pnZileluc = v_zile.zileluc
pnOreluc = v_zile.oreluc
pnOrestas = v_zile.orestas
ofrmform=Createobject('frm_zileluc')
ofrmform.Show(1)
IF gnButon == 1
lcSql = [update ] + gcS +[.sal_calendar set zileluc = ] + ALLTRIM(STR(NVL(pnZileluc,0))) + [,] +;
[ oreluc = ] + ALLTRIM(STR(NVL(pnOreluc,0))) +;
[,orestas = ] + ALLTRIM(STR(NVL(pnOrestas,0))) + [where id_calendar = ] + ALLTRIM(STR(NVL(pnIdSal,0)))
lnSucces = goExecutor.oExecute(lcSql)
IF lnSucces < 0
MESSAGEBOX(goExecutor.cEroare,0 +16,'Eroare')
ENDIF
goExecutor.oReset()
RETURN lnSucces
ENDIF
Release posarbat,ofrmform
ENDPROC
*----------------------------------sfarsit procedura zile_lucr----------------------------------
*******************************************
* PROCEDURE nom_formatii( )
* Date : 05/26/05, 16:37:20
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE nom_formatii( )
Private poformatii,pcschema1,pcselect1
Store '' To poformatii
If Used('v_formatii')
Use In v_formatii
Endif
*!* DEBUG
*!* SUSPEND
pcschema1=['']
*!* pcselect1=[select f.*,s.SECTIE,t.TRANSA from ] + gcS +;
*!* [.sal_nom_formatii f left join ]+gcS;
*!* +[.vnom_sectii s on f.id_sectie = s.ID_SECTIE ]+;
*!* [ left join ]+gcS+[.sal_vnom_transe t on f.id_sectie = t.ID_TRANSA where 1=2]
pcselect1=[select f.*,S.SECTIE,T.TRANSA from ] + gcS + [.sal_nom_formatii f ] + ;
[ LEFT JOIN ] + GCS + [.VNOM_SECTII S ON F.ID_SECTIE = S.ID_SECTIE ] +;
[ LEFT JOIN ] + GCS + [.SAL_VNOM_TRANSE T ON F.ID_TRANSA = T.ID_TRANSA ]+;
[ where 1=2]
pcorder1=[ordine]
pcfiltru1 = [f.sters = 0]
llAfiseaza = .F.
gencursor('poformatii','v_formatii',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfiseaza)
poformatii.ca_baza1.afisare()
SELECT V_FORMATII
ofrmform=Createobject('frm_formatii')
ofrmform.Show(1)
Release poformatii
ENDPROC
*----------------------------------sfarsit procedura nom_formatii----------------------------------
*******************************************
* PROCEDURE nom_meserii( )
* Date : 05/23/05, 12:27:24
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE nom_meserii( )
Private poresp,pcschema1,pcselect1
Store '' To poresp
If Used('v_meserii')
Use In v_meserii
Endif
pcschema1=['']
pcselect1=['select * from ] + gcS + [.sal_nom_mes where 1=2']
pcorder1=[meserie]
pcfiltru1 = [sters = 0]
llAfiseaza = .F.
gencursor('poresp','v_meserii',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfiseaza)
poresp.ca_baza1.afisare()
ofrmresp=Createobject('frm_meserii')
ofrmresp.Show(1)
Release poresp
ENDPROC
*----------------------------------sfarsit procedura nom_meserii----------------------------------
*******************************************
* PROCEDURE nom_transe( )
* Date : 05/23/05, 12:27:24
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE nom_transe( )
Private potransa,pcschema1,pcselect1
Store '' To potransa
If Used('v_transe')
Use In v_transe
Endif
pcschema1=['']
pcselect1=['select * from ] + gcS + [.sal_nom_transe where 1=2']
pcorder1=[transa]
pcfiltru1 = [sters = 0]
llAfiseaza = .F.
gencursor('potransa','v_transe',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfiseaza)
potransa.ca_baza1.afisare()
ofrmresp=Createobject('frm_transe')
ofrmresp.Show(1)
Release potransa
ENDPROC
*----------------------------------sfarsit procedura nom_transe----------------------------------
*******************************************
* PROCEDURE nom_clasesal( )
* Date : 05/23/05, 12:27:24
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE nom_clasesal( )
Private poclasesal,pcschema1,pcselect1
Store '' To poclasesal
If Used('v_clasesal')
Use In v_clasesal
Endif
pcschema1=['']
pcselect1=['select * from ] + gcS + [.sal_nom_clasesal where 1=2']
pcorder1=[tarifar]
pcfiltru1 = [sters = 0]
llAfiseaza = .F.
gencursor('poclasesal','v_clasesal',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfiseaza)
poclasesal.ca_baza1.afisare()
ofrmresp=Createobject('frm_clasesal')
ofrmresp.Show(1)
Release poclasesal
ENDPROC
*----------------------------------sfarsit procedura nom_clasesal----------------------------------
*******************************************
* PROCEDURE nom_tipctr( )
* Date : 05/23/05, 12:27:24
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE nom_tipctr
Private potipctr,pcschema1,pcselect1
Store '' To potipctr
If Used('v_tipctr')
Use In v_tipctr
Endif
pcschema1=['']
pcselect1=['select * from ] + gcS + [.sal_vnom_tipctr where 1=2']
pcorder1=[]
pcfiltru1 = [sters = 0]
llAfiseaza = .F.
gencursor('potipctr','v_tipctr',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfiseaza)
potipctr.ca_baza1.afisare()
ofrmresp=Createobject('frm_tipctr')
ofrmresp.Show(1)
Release poclasesal
ENDPROC
*******************************************
* PROCEDURE nom_sporuri( )
* Date : 06/17/05, 09:04:27
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE nom_sporuri( )
Private ponomspor,pcschema1,pcselect1
Store '' To ponomspor
If Used('v_nomspor')
Use In v_nomspor
Endif
pcschema1=['']
pcselect1=['select * from ] + gcS + [.sal_vnom_sporuri where 1=2']
pcorder1=[]
pcfiltru1 = [sters = 0]
llAfiseaza = .F.
gencursor('ponomspor','v_nomspor',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfiseaza)
ponomspor.ca_baza1.afisare()
ofrmresp=Createobject('frm_nomspor')
ofrmresp.Show(1)
Release poclasesal
ENDPROC
*----------------------------------sfarsit procedura nom_sporuri----------------------------------
*******************************************
* PROCEDURE nom_popriri( )
* Date : 06/17/05, 13:52:11
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE nom_popriri( )
Private ponompop,pcschema1,pcselect1
Store '' To ponompop
If Used('v_nompop')
Use In v_nompop
Endif
pcschema1=['']
pcselect1=['select * from ] + gcS + [.sal_vnom_popriri where 2=2']
pcorder1=[]
pcfiltru1 = [sters = 0]
llAfiseaza = .F.
gencursor('ponompop','v_nompop',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfiseaza)
ponompop.ca_baza1.afisare()
SELECT v_nompop
ofrmpop=Createobject('frm_nompopriri')
ofrmpop.Show(1)
Release ponompop
ENDPROC
*----------------------------------sfarsit procedura nom_popriri----------------------------------
*******************************************
* PROCEDURE nom_grpmun( )
* Date : 06/17/05, 15:03:04
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE nom_grpmun( )
Private ponomgrp,pcschema1,pcselect1
Store '' To ponomgrp
If Used('v_nomgrp')
Use In v_nomgrp
Endif
pcschema1=['']
pcselect1=['select * from ] + gcS + [.sal_coef_cas where 2=2']
pcorder1=[]
pcfiltru1 = [sters = 0]
llAfiseaza = .F.
gencursor('ponomgrp','v_nomgrp',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfiseaza)
ponomgrp.ca_baza1.afisare()
SELECT v_nomgrp
ofrmpop=Createobject('frm_grpmun')
ofrmpop.Show(1)
Release ponomgrp
*!* SELECT v_nomgrp
*!* USE
ENDPROC
*----------------------------------sfarsit procedura nom_grpmun----------------------------------
*******************************************
* PROCEDURE nom_grdhand( )
* Date : 06/17/05, 15:10:33
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE nom_grdhand( )
Private ponomgrp,pcschema1,pcselect1
Store '' To ponomgrp
If Used('v_nomhand')
Use In v_nomgrd
Endif
pcschema1=['']
pcselect1=['select * from ] + gcS + [.sal_nom_handicap where 2=2']
pcorder1=[]
pcfiltru1 = [sters = 0]
llAfiseaza = .F.
gencursor('ponomgrp','v_nomhand',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfiseaza)
ponomgrp.ca_baza1.afisare()
SELECT v_nomhand
ofrmpop=Createobject('frm_grdhand')
ofrmpop.Show(1)
Release ponompop
*!* SELECT v_nomhand
*!* USE
ENDPROC
*----------------------------------sfarsit procedura nom_grdhand----------------------------------
*******************************************
* PROCEDURE nom_tipintret( )
* Date : 06/17/05, 15:13:34
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE nom_tipintret( )
Private ponomgrp,pcschema1,pcselect1
Store '' To ponomgrp
If Used('v_nomintret')
Use In v_nomintret
Endif
pcschema1=['']
pcselect1=['select * from ] + gcS + [.sal_nom_dedsupl where 2=2']
pcorder1=[]
pcfiltru1 = [sters = 0]
llAfiseaza = .F.
gencursor('ponomgrp','v_nomintret',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfiseaza)
ponomgrp.ca_baza1.afisare()
SELECT v_nomintret
ofrmpop=Createobject('frm_tipintret')
ofrmpop.Show(1)
Release ponompop
ENDPROC
*----------------------------------sfarsit procedura nom_tipintret----------------------------------
*******************************************
* PROCEDURE caseasig( )
* Date : 06/17/05, 15:20:20
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE caseasig( )
Private ponomgrp,pcschema1,pcselect1
Store '' To ponomgrp
If Used('v_caseasig')
Use In v_caseasig
Endif
pcschema1=['']
pcselect1=['select * from ] + gcS + [.sal_vcaseasig where 2=2']
pcorder1=[]
pcfiltru1 = [sters = 0]
llAfiseaza = .F.
gencursor('ponomgrp','v_caseasig',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfiseaza)
ponomgrp.ca_baza1.afisare()
SELECT v_caseasig
ofrmpop=Createobject('frm_caseasig')
ofrmpop.Show(1)
Release ponompop
ENDPROC
*----------------------------------sfarsit procedura caseasig----------------------------------
*******************************************
* PROCEDURE nom_tabvechimi( )
* Date : 06/21/05, 09:54:04
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE nom_tabvechimi( )
Private ponomgrp,pcschema1,pcselect1
Store '' To ponomgrp
If Used('v_tabvechimi')
Use In v_tabvechimi
Endif
pcschema1=['']
pcselect1=['select * from ] + gcS + [.sal_vtab_vechimi where 2=2']
pcorder1=[]
pcfiltru1 = [sters = 0]
llAfiseaza = .F.
gencursor('ponomgrp','v_tabvechimi',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfiseaza)
ponomgrp.ca_baza1.afisare()
SELECT v_tabvechimi
ofrmpop=Createobject('frm_tabvechimi')
ofrmpop.Show(1)
Release ponompop
ENDPROC
*----------------------------------sfarsit procedura nom_tabvechimi----------------------------------
*******************************************
* PROCEDURE nom_grilaco( )
* Date : 06/21/05, 10:54:08
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE nom_grilaco( )
Private ponomgrp,pcschema1,pcselect1
Store '' To ponomgrp
If Used('v_grilaco')
Use In v_grilaco
Endif
pcschema1=['']
pcselect1=['select * from ] + gcS + [.sal_vnom_zileco where 2=2']
pcorder1=[]
pcfiltru1 = [sters = 0]
llAfiseaza = .F.
gencursor('ponomgrp','v_grilaco',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfiseaza)
ponomgrp.ca_baza1.afisare()
SELECT v_grilaco
ofrmpop=Createobject('frm_grilaco')
ofrmpop.Show(1)
Release ponompop
ENDPROC
*----------------------------------sfarsit procedura nom_grilaco----------------------------------
*******************************************
* PROCEDURE nom_ore( )
* Date : 06/21/05, 11:41:51
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE nom_ore( )
Private ponomgrp,pcschema1,pcselect1
Store '' To ponomgrp
If Used('v_nomore')
Use In v_nomore
Endif
pcschema1=['']
pcselect1=['select * from ] + gcS + [.sal_vnomore where 2=2']
pcorder1=[]
pcfiltru1 = [sters = 0]
llAfiseaza = .F.
pcorder1 = [ ordine ]
gencursor('ponomgrp','v_nomore',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfiseaza)
ponomgrp.ca_baza1.afisare()
SELECT v_nomore
ofrmpop=Createobject('frm_nomore')
ofrmpop.Show(1)
Release ponompop
ENDPROC
*----------------------------------sfarsit procedura nom_ore----------------------------------
*******************************************
* PROCEDURE nom_tipcm( )
* Date : 06/22/05, 09:34:42
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE nom_tipcm( )
Private ponomgrp,pcschema1,pcselect1
Store '' To ponomgrp
If Used('v_nomtipcm')
Use In v_nomtipcm
Endif
pcschema1=['']
pcselect1=['select * from ] + gcS + [.sal_vnom_cm where 2=2']
pcorder1=[]
pcfiltru1 = [sters = 0]
llAfiseaza = .F.
pcorder1 = [ ordine ]
gencursor('ponomgrp','v_nomtipcm',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfiseaza)
ponomgrp.ca_baza1.afisare()
SELECT v_nomtipcm
ofrmpop=Createobject('frm_nomcm')
ofrmpop.Show(1)
Release ponompop
ENDPROC
*----------------------------------sfarsit procedura nom_tipcm----------------------------------
*******************************************
* PROCEDURE impozit_luna( )
* Date : 06/22/05, 11:36:42
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE impozit_luna(tlImpAn)
Private ponomgrp,pcschema1,pcselect1,plImpAn
Store '' To ponomgrp
IF EMPTY(tlImpAn)
STORE .f. TO plImpAn
ELSE
STORE tlImpAn TO plImpAn
ENDIF
If Used('v_imp')
Use In v_imp
Endif
pcschema1=['']
pcselect1=['select * from ] + gcS + [.sal_impozitar where 2=2']
pcorder1=[]
IF plImpAn
pcfiltru1 = [sters = 0 and luna = 0 and an = ]+ALLTRIM(STR(gnAn))
ELSE
pcfiltru1 = [sters = 0 and luna = ]+ALLTRIM(STR(gnLuna))+[ and an = ]+ALLTRIM(STR(gnAn))
ENDIF
llAfiseaza = .F.
pcorder1 = [ inf ]
gencursor('ponomgrp','v_imp',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfiseaza)
ponomgrp.ca_baza1.afisare()
SELECT v_imp
ofrmpop=Createobject('frm_imp')
ofrmpop.Show(1)
Release ponompop
ENDPROC
*----------------------------------sfarsit procedura impozit_luna----------------------------------
*******************************************
* PROCEDURE nom_limded( )
* Date : 06/22/05, 13:23:29
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE nom_limded( )
Private ponomgrp,pcschema1,pcselect1
Store '' To ponomgrp
If Used('v_deduceri')
Use In v_deduceri
ENDIF
lcsql=[select NVL(id_calendar,0) as id_calendar,an,luna from ]+gcs+[.sal_calendar where an = ]+str(gnan)+[ and luna = ]+str(gnluna)
lnSucces = goExecutor.oExecute(lcSql,'crsCalendar')
IF lnSucces < 0
MESSAGEBOX(goExecutor.cEroare,0 +16,'Eroare')
ENDIF
pcschema1=['']
pcselect1=['select * from ] + gcS + [.sal_vdeduceri where 2=2']
pcorder1=[]
pcfiltru1 = [sters = 0]
llAfiseaza = .F.
pcorder1 = [ nrpers ]
gencursor('ponomgrp','v_deduceri',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfiseaza)
ponomgrp.ca_baza1.afisare()
SELECT v_deduceri
ofrmpop=Createobject('frm_limded')
ofrmpop.Show(1)
Release ponompop
IF USED('crsCalendar')
USE IN crsCalendar
ENDIF
ENDPROC
*----------------------------------sfarsit procedura nom_limded----------------------------------
*******************************************
* PROCEDURE nom_curscal( )
* Date : 06/22/05, 14:01:51
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE nom_curscal( )
Private ponomgrp,pcschema1,pcselect1
Store '' To ponomgrp
If Used('v_curscal')
Use In v_curscal
Endif
pcschema1=['']
pcselect1=['select * from ] + gcS + [.sal_vnom_curs where 2=2']
pcorder1=[]
pcfiltru1 = [sters = 0]
llAfiseaza = .F.
pcorder1 = [ denumire ]
gencursor('ponomgrp','v_curscal',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfiseaza)
ponomgrp.ca_baza1.afisare()
SELECT v_curscal
ofrmpop=Createobject('frm_curscal')
ofrmpop.Show(1)
Release ponompop
ENDPROC
*----------------------------------sfarsit procedura nom_curscal----------------------------------
*******************************************
* PROCEDURE sal_coef( )
* Date : 06/22/05, 15:27:17
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE sal_coef( )
*----------- zile lucratoare
Private pozile,pcschema2,pcselect2
Store '' To pozile
If Used('v_coef')
Use In v_coef
Endif
pcschema2=['']
pcselect2=[select * from ] + gcS + [.sal_calendar where 1=2]
pcorder2=[luna,an]
pcfiltru2 = [ luna = ] + ALLTRIM(STR(gnLuna)) + [ and an = ]+ALLTRIM(STR(gnAn))
llAfiseaza = .F.
*!* WAIT WINDOW ' Luna:'+STR(gnLuna) + ' an:'+STR(gnAn)
gencursor('pozile','v_coef',pcselect2,pcfiltru2,pcschema2,pcorder2,llAfiseaza)
pozile.ca_baza1.afisare()
SELECT v_coef
*--------------
PRIVATE pnIdSal
STORE 0 TO pnIdSal
pnIdSal = v_coef.id_Calendar
SELECT v_coef
SCATTER NAME pocoef
ofrmform=Createobject('frm_salcoef')
ofrmform.Show(1)
IF gnButon == 1
lcSql = [update ] + gcS +[.sal_calendar set c_meds = ] + ALLTRIM(STR(NVL(pocoef.c_meds,0),5,3)) + [,] +;
[ c_medp = ] + ALLTRIM(STR(NVL(pocoef.c_medp,0),5,3)) +;
[,c_soms = ] + ALLTRIM(STR(NVL(pocoef.c_soms,0),5,3)) +;
[,c_somp = ] + ALLTRIM(STR(NVL(pocoef.c_somp,0),5,3)) +;
[,c_casp = ] + ALLTRIM(STR(NVL(pocoef.c_casp,0),5,3)) +;
[,salmin = ] + ALLTRIM(STR(NVL(pocoef.salmin,0),16,gnPa)) +;
[,salmed = ] + ALLTRIM(STR(NVL(pocoef.salmed,0),16,gnPa)) +;
[,c_munca = ] + ALLTRIM(STR(NVL(pocoef.c_munca,0),8,6)) +;
[,dedl1 = ] + ALLTRIM(STR(NVL(pocoef.dedl1,0),16,gnPa)) +;
[,dedl2 = ] + ALLTRIM(STR(NVL(pocoef.dedl2,0),16,gnPa)) +;
[,c_faambp = ] + ALLTRIM(STR(NVL(pocoef.c_faambp,0),8,6)) +;
[,zilecmplang = ] + ALLTRIM(STR(NVL(pocoef.zilecmplang,0))) +;
[,BAZA_INGR = ] + ALLTRIM(STR(NVL(pocoef.BAZA_INGR,0))) +;
[,c_cas1 = ] + ALLTRIM(STR(NVL(pocoef.c_cas1,0),6,4)) +;
[,c_cas2 = ] + ALLTRIM(STR(NVL(pocoef.c_cas2,0),6,4)) +;
[,c_cas3 = ] + ALLTRIM(STR(NVL(pocoef.c_cas3,0),6,4)) +;
[,FD_FNUASS = ] + ALLTRIM(STR(NVL(pocoef.FD_FNUASS,0),6,4)) +;
[where id_calendar = ] + ALLTRIM(STR(NVL(pnIdSal,0)))
lnSucces = goExecutor.oExecute(lcSql)
IF lnSucces < 0
MESSAGEBOX(goExecutor.cEroare,0 +16,'Eroare')
ENDIF
goExecutor.oReset()
RETURN lnSucces
ENDIF
Release posarbat,ofrmform
ENDPROC
*----------------------------------sfarsit procedura sal_coef----------------------------------

View File

@@ -0,0 +1,12 @@
PUBLIC gcCondLuna
*!* gcCondLuna = [((((extract(month from datafact) =]+Alltrim(Str(gnLuna))+;
*!* [ and extract(year from datafact) =]+Alltrim(Str(gnAn))+[) or (datafact is null ));
*!* and ]+;
*!* [ (extract (month from datai)<=]+Alltrim(Str(gnLuna)) + [ and extract(year from datai)<= ]+Alltrim(Str(gnAn))+[))]+;
*!* [ or ((extract (month from dataoravalid)>= ]+Alltrim(Str(gnLuna))+[ and extract(year from dataoravalid)>=]+Alltrim(Str(gnAn)) +[)]+;
*!* [ and id_tip > 1)]+ [)]
*!* lcDataFact= [ (a.facturat=1 and (extract(month from a.datafact) =]+Alltrim(Str(gnLuna))+[ and extract(year from a.datafact) =]+Alltrim(Str(gnAn))+[))]
*!* lcDataValid = [ (a.validat=1 and (extract (month from a.dataoravalid)>= ]+Alltrim(Str(gnLuna))+[ and extract(year from a.dataoravalid)>=]+Alltrim(Str(gnAn)) +[)) ]
*!* gcCondLuna = [ ((extract (month from a.datai)=]+Alltrim(Str(gnLuna)) + [ and extract(year from a.datai)= ]+Alltrim(Str(gnAn))+[) or ]+;
*!* [ (a.id_tip=1 and (a.facturat=0 or ] + lcDataFact + [) ) or (a.id_tip>1 and (a.validat=0 or ] + lcDataValid + [))) ]

4578
Programe/pmenu.prg Normal file

File diff suppressed because it is too large Load Diff

340
Programe/quitapp.prg Normal file
View File

@@ -0,0 +1,340 @@
* Program: QUITAPP.PRG
* Description: Client-side of remote termination of applications.
* Created: 07/11/2003
* Developer: Gregory L Reichert
* Copyright: Copyright (c) 2003 GLR software
*------------------------------------------------------------
* Id Date By Description
* 1 07/11/2003 Gregory L Reichert Initial Creation
*
*------------------------------------------------------------
*!* Overview
*!* The component is the client-side portion of a Remote Application Killer.
*!* With the use of a shared table, an network administrator can determine
*!* what workstation has what application running, and instruct that application
*!* to quit.
*!* An administrator can monitor which applications are running, and instruct them
*!* termination themselves.
*!* Instructions
*!* This component is based on a Timer class with a one minute interval. Each minute
*!* the application check to see if the administrator wishs the application to
*!* quit. If discovered so, the countdown begins (default 10 minutes). During the
*!* Countdown, a message is displayed notifing the user that the automatic termination of
*!* the application is underway. They can manual exit the application, or wait for the
*!* automatic. Either way, it is intended for the user to complete their current task.
*!* At the end of the countdown, the application issues a QUIT command.
*!* Call this routine, and a object reference is returned. This object should
*!* remain active throughout the life of the application.
*!* PRIVATE oQuitApp
*!* oQuitApp = QuitApp( "\\MyServer\MyDrive\CommonFiles\" )
*!*
*!* When the administrator wish to terminate one or more application, they place
*!* a True (.T.) in the "lQuit" field of the QuitApp.dbf table. As the Application continues
*!* countdown to automated termination, the "Remain" field indicates the number of minutes
*!* remaining. If the Admin changes the value of "Remain", the countdown continues from
*!* that new value. If a value less then zero (0) is entered, the application terminates
*!* the next time the QuitApp timer is fired.
*!* Two exposed method are provided to inform the routine that the application
*!* is performing critical operations and can not be interupted. These are called
*!* EnterCritical() and LeaveCritical(). The EnterCritical() should be called when the
*!* critical section begins, and the LeaveCritical() should be called when the section
*!* ends.
*!* The administrator can check to see a application is running, or if it crashed before hand,
*!* by set the "aLiveTest" field of the QuitApp.dbf to False (.F.). After a couple of minutes,
*!* if the application is still alive, the field will revert to True (.T.).
*!* The form called Admin_QuitApp.scx is used by the administrator to monitor and control the
*!* remote applications.
*!* =====================================================================================
LPARAMETERS tcPath, tcQuitName
RETURN CREATEOBJECT("QuitApp", tcPath, tcQuitName)
#DEFINE kQuitMax 10 && Wait 10 minutes before auto-quit
*------------------------------------------------------------
* Description: QuitApp class
*------------------------------------------------------------
* Id Date By Description
* 1 07/11/2003 Gregory L Reichert Initial Creation
*
*------------------------------------------------------------
DEFINE CLASS QuitApp AS TIMER
INTERVAL = (60*1000) && check once a minute.
ENABLE = .T.
cPath = tcPath
cQuitName ="QuitApp"
cQFile ="QuitApp"
cAlias = "QuitApp"
&& Full URN to QuitApp.dbf. Must be at a shared network location for all running application to gain access.
*------------------------------------------------------------
* Description: Error Trap
* Parameters: internal
* Return: n/a
* Use: internal
*------------------------------------------------------------
* Id Date By Description
* 1 07/11/2003 Gregory L Reichert Initial Creation
*
*------------------------------------------------------------
PROCEDURE ERROR( a,b,c )
*-- ignore all error from this class
RETURN
ENDPROC
*------------------------------------------------------------
* Description: Initializes the timer
* Parameters: cPath: path to the shared QuitApp.dbf - path only
* Return: N/A
* Use: ox = CreateObject( "QuitApp","\\myserver\shared\CommonFiles\" )
*------------------------------------------------------------
* Id Date By Description
* 1 07/11/2003 Gregory L Reichert Initial Creation
*
*------------------------------------------------------------
PROCEDURE INIT( cPath, cQuitName )
LOCAL lc
lc = SELECT()
cPath = ADDBS(IIF(EMPTY(cPath),"", cPath))
cQuitName = IIF(EMPTY(cQuitName),"QuitApp",JUSTSTEM(cQuitName))
cQFile = cPath+cQuitName+".dbf"
cAlias = "QuitApp"
this.cPath = cPath
this.cQuitName = cQuitName
this.cQFile = cQFile
this.cAlias = cAlias
*-------------------------------------
* create QuitApp table if missing.
*-------------------------------------
IF NOT FILE(this.cQFile)
SELECT 0
CREATE TABLE (this.cQFile) (ws c(40),ID N(10,0), cCaption c(100),lQuit L, remain N(3), Critical L, aLiveTest L)
USE
ENDIF
SELECT(lc)
ENDPROC
*------------------------------------------------------------
* Description: Timer routine
* Parameters: n/a
* Return: n/a
* Use: internal
*------------------------------------------------------------
* Id Date By Description
* 1 07/11/2003 Gregory L Reichert Initial Creation
*
*------------------------------------------------------------
PROCEDURE TIMER
LOCAL lc
lc = SELECT()
USE (this.cQFile) IN 0 SHARED ALIAS (this.cAlias)
SELECT (this.cAlias)
LOCATE FOR ID=_VFP.HWND AND cCaption=_VFP.CAPTION AND NOT DELETED()
IF NOT FOUND()
*-------------------------------------
* Add an instence for this workstation / application
INSERT INTO (this.cQFile) (ws,ID,cCaption,lQuit,remain, Critical, aLiveTest) ;
VALUES ( UPPER(SYS(0)),_VFP.HWND, _VFP.CAPTION, .F., kQuitMax, .F., .T.)
ENDIF
*- Each time, reset the aLiveTest field.
REPLACE aLiveTest WITH .T.
IF NOT Critical AND TXNLEVEL()=0
*- do only if not in Critical Section of the code,
* and not in a Transaction block
IF lQuit
*-------------------------------------
* if still timing out, display remaining time.
*-------------------------------------
IF remain>0
IF remain=kQuitMax
* - if first time displaying the warning, force application on top.
_SCREEN.ALWAYSONTOP=.T.
_SCREEN.ALWAYSONTOP=.F.
ENDIF
*- decrement the counter, and display warning.
REPLACE remain WITH remain -1
osh=CREATEOBJECT('shell.application')
osh.minimazeall
_screen.windowstate=2
WAIT WINDOW NOCLEAR NOWAIT "Programul se va inchide automat in " +ALLTRIM(STR(remain,10))+" minute."
?? CHR(7)
osh.undominimazeall
RELEASE osh
ELSE
*-------------------------------------
* otherwise, quit the application.
*-------------------------------------
USE IN (this.cAlias)
CLEAR EVENTS
glQuit = .T.
QUIT
ENDIF
ELSE
*-------------------------------------
* if nolonger quiing, reset counter.
*-------------------------------------
REPLACE remain WITH kQuitMax
WAIT CLEAR
ENDIF
ENDIF
USE IN (this.cAlias)
THIS.RESET
SELECT(lc)
ENDPROC
*------------------------------------------------------------
* Description: Called when entering a Critical Section of the code.
* Parameters: n/a
* Return: True
* Use: <object>.EnterCritical
*------------------------------------------------------------
* Id Date By Description
* 1 07/11/2003 Gregory L Reichert Initial Creation
*
*------------------------------------------------------------
PROCEDURE EnterCritical()
LOCAL lc
lc = SELECT()
USE (this.cQFile) IN 0 SHARED ALIAS (this.cAlias)
SELECT (this.cAlias)
UPDATE (this.cQFile) SET Critical=.T. WHERE ID=_VFP.HWND AND cCaption=_VFP.CAPTION
USE IN (this.cAlias)
SELECT(lc)
ENDPROC
*------------------------------------------------------------
* Description: Called when exitting a Critical Section of the code.
* Parameters: n/a
* Return: True
* Use: <object>.LeaveCritical
*------------------------------------------------------------
* Id Date By Description
* 1 07/11/2003 Gregory L Reichert Initial Creation
*
*------------------------------------------------------------
PROCEDURE LeaveCritical()
LOCAL lc
lc = SELECT()
USE (this.cQFile) IN 0 SHARED ALIAS (this.cAlias)
SELECT (this.cAlias)
UPDATE (this.cQFile) SET Critical=.F. WHERE ID=_VFP.HWND AND cCaption=_VFP.CAPTION
USE IN (this.cAlias)
SELECT(lc)
ENDPROC
*------------------------------------------------------------
* Description: Destroy this object
* Parameters: n/a
* Return: n/a
* Use: internal
*------------------------------------------------------------
* Id Date By Description
* 1 07/11/2003 Gregory L Reichert Initial Creation
*
*------------------------------------------------------------
PROCEDURE DESTROY
*-----------------------------------------------
* On destroy, remove the application reference from the QuitApp table.
*-----------------------------------------------
LOCAL lc
lc = SELECT()
USE (this.cQFile) IN 0 SHARED ALIAS (this.cAlias)
SELECT (this.cAlias)
DELETE FROM (this.cQFile) WHERE ID=_VFP.HWND AND cCaption=_VFP.CAPTION
USE IN (this.cAlias)
SELECT(lc)
ENDPROC
ENDDEFINE
&& ------------------------------INCEPUT: Quit_Automat ------------------------------
*!* Procedura: Quit_Automat
*!* Parametri: tlQuit
*!* Data/Ora generarii: 19/02/2004 12:48
*!* Autor: MARIUS.MUTU
PROCEDURE Quit_Automat
LPARAMETERS tlQuit
IF tlQuit
QUIT
ENDIF
ENDPROC
&& ------------------------------SFARSIT: Quit_Automat ------------------------------
* Eof QUITAPP.PRG
***************************
*!* FUNCTION AppInstance
*!* PARAMETERS WindowName
*!* #DEFINE GW_OWNER 4
*!* #DEFINE GW_HWNDFIRST 0
*!* #DEFINE GW_HWNDNEXT 2
*!* #DEFINE SW_MAXIMIZE 3
*!* #DEFINE SW_NORMAL 1
*!* DECLARE integer SetForegroundWindow in win32api long lnhWnd
*!* DECLARE integer GetWindowText in win32api integer, string, integer
*!* DECLARE integer GetWindow in win32api integer,INTEGER
*!* DECLARE integer IsWindowVisible in win32api integer
*!* DECLARE integer GetActiveWindow in win32api
*!* DECLARE integer ShowWindow in user32 INTEGER lnhWnd, INTEGER lnCmdShow
*!* IsWindEx = .F.
*!* if len(WindowName) < 1
*!* return .t.
*!* endif
*!* foxhwnd = GetActiveWindow()
*!* hwndNext = GetWindow(foxhwnd,GW_HWNDFIRST)
*!* DO WHILE hwndNext <> 0
*!* IF (hwndnext <> foxhwnd .AND. GetWindow(hwndnext,GW_OWNER) = 0)
*!* Stuffer = SPACE(64)
*!* x = GetWindowText(hwndnext,@Stuffer,64)
*!* IF WindowName $ Stuffer
*!* IsWindEx = .T.
*!* =SetForegroundWindow(hwndnext)
*!* =ShowWindow(hwndNext,SW_MAXIMIZE)
*!* EXIT
*!* ENDIF
*!* ENDIF
*!* hwndNext = GetWindow(hwndnext,GW_HWNDNEXT)
*!* ENDDO
*!* RETURN IsWindEx
*!* ENDFUNC

104
Programe/rapbal97.prg Normal file
View File

@@ -0,0 +1,104 @@
public wbal
dirfirm=loc+'\'+nfscurt
WBAL=0
sele bal
set filter to SUBS(CONT,1,1)='7'
TOTAL ON subs(cont,5,1) TO &dirfirm\tempo\TOTTOT7
SELE BAL
set filter to SUBS(CONT,1,1)='6'
TOTAL ON SUBS(CONT,5,1) TO &dirfirm\tempo\TOTTOT6
SELE 0
USE &dirfirm\tempo\TOTTOT7
REPL DENUMIRE WITH 'TOTAL VENITURI';
CONT WITH '7998'
SELE 0
USE &dirfirm\tempo\TOTTOT6
REPL DENUMIRE WITH 'TOTAL CHELTUIELI';
CONT WITH '6998'
SELE BAL
SET FILTER TO
SELE BAL
TOTAL ON SUBSTR(CONT,1,3) TO &dirfirm\tempo\TOTBAL
SELE 0
*USE DATEAN\TOTBAL
USE &dirfirm\tempo\totbal.dbf exclusive
SELE BAL
COPY TO &dirfirm\tempo\RAPBAL
SELE 0
USE &dirfirm\tempo\RAPBAL
TOTAL ON SUBS(CONT,5,1) TO &dirfirm\tempo\TOTTOT
SELE TOTBAL
REPL ALL DENUMIRE WITH 'TOTAL '+SUBSTR(CONT,1,3);
cont WITH substr(cont,1,3)+'A'
SELE 190
USE &dirfirm\tempo\TOTTOT
REPL DENUMIRE WITH 'TOTAL GENERAL';
CONT WITH '9999'
SELE TOTBAL
USE
SELE TOTTOT
USE
SELE TOTTOT7
USE
SELE TOTTOT6
USE
SELE RAPBAL
APPE FROM &dirfirm\tempo\TOTBAL
APPE FROM &dirfirm\tempo\TOTTOT
APPE FROM &dirfirm\tempo\TOTTOT7
APPE FROM &dirfirm\tempo\TOTTOT6
INDEX ON CONT TO &dirfirm\tempo\BALRAP.CDX
GO TOP
GCONT=CONT
kg=0
SCAN
SCATTER MEMVAR
if subs(m.cont,1,3)=subs(gcont,1,3)
kg=kg+1
else
kg=1
endif
IF SUBS(M.CONT,4,1)='A' and kg=2
DELETE
kg=0
ENDIF
GCONT=M.CONT
ENDSCAN
m.titlu=''
if a4
REPORT FORMAT RAPBALa4.FRX TO PRINTER PROMPT preview
else
REPORT FORMAT RAPBALa3.FRX TO PRINTER PROMPT preview
endif
SELE RAPBAL
USE
ERASE &dirfirm\tempo\RAPBAL.DBF
ERASE &dirfirm\tempo\BALrap.cdx
ERASE &dirfirm\tempo\TOTTOT.DBF
ERASE &dirfirm\tempo\TOTTOT7.DBF
ERASE &dirfirm\tempo\TOTTOT6.DBF
ERASE &dirfirm\tempo\totBAL.DBF
RETURN

7489
Programe/refverif.prg Normal file

File diff suppressed because it is too large Load Diff

981
Programe/roadef.prg Normal file
View File

@@ -0,0 +1,981 @@
*!* 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
**********************************************************

3
Programe/shutdown.prg Normal file
View File

@@ -0,0 +1,3 @@
IF TYPE("goApp")=="O" AND NOT ISNULL(goApp)
RETURN goApp.OnShutDown()
ENDIF

View File

@@ -0,0 +1,20 @@
**********************************************************
PROCEDURE update_nomenclator
*** tabele meniu deschise din proiect
LOCAL lcCaleDateMenu
lcCaleDateMenu=gcAppPath+[DATEMENU\]
IF !USED('INFISIERE')
USE &lcCaleDateMenu.INFISIERE IN 0 ALIAS INFISIERE
ENDIF
IF !USED('refaceri')
USE &lcCaleDateMenu.refaceri IN 0 ALIAS refaceri
ENDIF
CREATE CURSOR dual (dummy c(10))
INSERT INTO dual (dummy) VALUES ("")
ENDPROC && update_nomenclator

View File

@@ -0,0 +1,119 @@
*******************************************
* PROCEDURE update_responsabil( )
* Date : 05/23/05, 12:25:08
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE update_responsabil( )
If Used('v_resp')
Use In v_resp
Endif
lcSql = [select * from ] + gcS + [.sal_responsabil where ales = 1 and sters = 0]
lcCursor = [v_resp]
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
goExecutor.oReset()
ENDPROC
*----------------------------------sfarsit procedura update_responsabil----------------------------------
*******************************************
* PROCEDURE update_sectie( )
* Data/ora : 12/16/04, 14:26:22
* autor : liana.macinic
* descriere:
****** PARAMETER BLOCK **************
* Parametri : 0
*
*******************************************
Procedure update_sectie( )
If Used('v_sectie')
Use In v_sectie
Endif
lcSql = [select * from ] + gcS + [.vnom_sectii order by sectie]&& where inactiv = 0]
lcCursor = [v_sectie]
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
goExecutor.oReset()
Return lnSucces
Endproc
*******************************************
* PROCEDURE update_transe( )
* Date : 05/26/05, 16:25:42
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE update_transe( )
If Used('v_transe')
Use In v_sectie
Endif
lcSql = [select * from ] + gcS + [.SAL_NOM_TRANSE where inactiv = 0 and sters = 0]
lcCursor = [v_transe]
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
goExecutor.oReset()
Return lnSucces
ENDPROC
*----------------------------------sfarsit procedura update_transa----------------------------------
*******************************************
* PROCEDURE update_ore( )
* Date : 05/26/05, 16:25:42
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE update_ore( )
If Used('v_nomore')
Use In v_nomore
Endif
lcSql = [select * from ] + gcS + [.SAL_NOMORE where inactiv = 0 and sters = 0]
lcCursor = [v_nomore]
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
goExecutor.oReset()
Return lnSucces
ENDPROC
*----------------------------------sfarsit procedura update_ore----------------------------------
*******************************************
* PROCEDURE update_calcdin( )
* Date : 06/17/05, 12:52:29
* author : liana.macinic
* description:
****** PARAMETER BLOCK **************
* Parameters : 0
*
*******************************************
PROCEDURE update_calcdin( )
If Used('v_calcdin')
Use In v_calcdin
Endif
lcSql = [select id_calcdin,camp,denumire as nume_camp,tabel from ] + gcS + [.sal_nom_calcdin where 2=2]
lcCursor = [v_calcdin]
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
goExecutor.oReset()
Return lnSucces
ENDPROC
*----------------------------------sfarsit procedura update_calcdin----------------------------------

1486
Programe/verifica.prg Normal file

File diff suppressed because it is too large Load Diff