8335 lines
268 KiB
Plaintext
8335 lines
268 KiB
Plaintext
*!* 07.09.2009
|
||
*!* marius.mutu
|
||
*!* ROA.H
|
||
|
||
*!* 04.08.2011
|
||
*!* marius.mutu
|
||
*!* adaugare functia GetDataIreg
|
||
|
||
*!* 01.04.2013
|
||
*!* marius.mutu
|
||
*!* GET_SCHEMA_GRID - trateaza cazul 0.00
|
||
|
||
*!* 05.10.2016
|
||
*!* marius.mutu
|
||
*!* Get_Ora - se intoarce dataora de pe server sau de pe calculatorul local in functie de settings.ini [general]tipdataora=server/local/nimic
|
||
|
||
*!* 10.01.2018
|
||
*!* marius.mutu
|
||
*!* VerificaCodFiscal: completare verificare ANAF cu stare TVA Incasare, Split TVA, Inactiv
|
||
|
||
*!* 11.07.2018
|
||
*!* marius.mutu
|
||
*!* + GetSemnatura - INTOCMIT/VERIFICAT/DIRECTOR/DIRECTOR ECONOMIC - listare balanta, registre tva, fisa cont, reg. jurnal
|
||
|
||
*!* 03.10.2019
|
||
*!* marius.mutu
|
||
*!* + Atasament2File
|
||
|
||
*!* 10.01.2019
|
||
*!* marius.mutu
|
||
*!* + VerificaFacturaClientiVanzari
|
||
|
||
*!* 23.01.2020
|
||
*!* marius.mutu
|
||
*!* File2Atasament - Citeste fisierul de pe disk si adauga atasament in baza de date atas_atasamente
|
||
|
||
*!* 13.11.2020
|
||
*!* +xdir((): Get Files in Directory (including subdirectories)
|
||
*!* +UpdatePageTotalGroup(): Functie pentru calculul _PAGETOTAL pentru grupuri care reseteaza pagina la 1 intr-un raport
|
||
|
||
*!* 09.12.2020
|
||
*!* Atasament2File
|
||
*!* Suprascriu fisierul din baza de date cu fisierul de pe disk doar daca dataora din baza de date > data fisierului de pe disk
|
||
|
||
*!* 03.02.2021
|
||
*!* xdir - declarat variabile locale
|
||
*!* la apelarea recursiva ramanea ultimul director parcurs, in loc sa se revina la directorul din iteratia corespunzatoare
|
||
|
||
*!* 15.01.2024
|
||
*!* GetSemnatura - + parametru prefix
|
||
|
||
*!* 03.09.2024
|
||
*!* ProcentTva2IdJtva - tratare procent TVA 0 si taxare inversa (eFactura)
|
||
|
||
*!* 05.12.2024
|
||
*!* GetArticolEFByPartDenumire - caut si articolele fara id_articol, in caz ca sunt servicii, nu articole gestionabile ROA
|
||
|
||
*!* 15.01.2025
|
||
*!* GetDocumentByContPartenerAct - se cauta comanda si in IREG_PARTENERI.EXPLICATIA
|
||
|
||
*!* 17.07.2025
|
||
*!* ProcentTva2IdJtva - cote TVA 21% si 11%
|
||
|
||
*!* 22.07.2025
|
||
*!* GetNamePermutations - limitare la 4 cuvinte si maxim 10 permutari
|
||
|
||
#Include COMUN\ROA.H
|
||
|
||
Define Class oexecutor As Custom
|
||
nHandle = 0
|
||
cSql = ''
|
||
cCursor = ''
|
||
nSucces = 0
|
||
cEroare = ''
|
||
nEroare = 0
|
||
cTime = ''
|
||
lReconnect = .T. && cred ca trebuie setat pe .F. inainte de o serie de proceduri executate cu tranzactie manuala
|
||
lShowError = .F.
|
||
lQuitOnError = .F.
|
||
|
||
Declare aEroare[1]
|
||
|
||
|
||
* PROCEDURE INIT( tnHandle, tcSql, tcCursor )
|
||
* Date : 06/10/2004, 12:18:21
|
||
* author : marius.mutu
|
||
* description:
|
||
|
||
****** PARAMETER BLOCK **************
|
||
* Parameters : 3
|
||
* Parameter 1:
|
||
* Parameter 2:
|
||
* Parameter 3:
|
||
*
|
||
******************************************* INCEPUT:INIT *******************************************
|
||
Procedure Init
|
||
Lparameters tnHandle, tcSql, tcCursor
|
||
|
||
|
||
If Empty(tnHandle)
|
||
This.nHandle = gnHandle
|
||
Else
|
||
This.nHandle = tnHandle
|
||
Endif
|
||
|
||
Endproc
|
||
******************************************* SFARSIT: INIT *******************************************
|
||
|
||
*---------------------------------------
|
||
* Intoarce .T. daca goConn.nHandle > 0
|
||
*---------------------------------------
|
||
FUNCTION IsConnected
|
||
RETURN goConn.IsConnected()
|
||
ENDFUNC && IsConnected
|
||
|
||
******************************************* INCEPUT:oExecuta *******************************************
|
||
Function oExecuta ( tcSql, tcCursor, tlProgress, tcTitluProgress, tnHandle, tlShowError, tlQuitOnError, tlReconnect )
|
||
Local lnSucces, llOk
|
||
llOk = .T.
|
||
|
||
*!* modificare 06.09.2012
|
||
*!* lnSucces = This.oExecute(tcSql, tcCursor, tlProgress, tcTitluProgress, tnHandle, tlShowError, tlQuitOnError, tlReconnect)
|
||
Do Case
|
||
Case Pcount() < 6
|
||
lnSucces = This.oExecute(Iif(Empty(tcSql), This.cSql, tcSql), ;
|
||
Iif(Empty(tcCursor), This.cCursor, tcCursor), ;
|
||
tlProgress, tcTitluProgress, ;
|
||
Iif(Empty(tnHandle), This.nHandle, tnHandle))
|
||
Case Pcount() < 7
|
||
lnSucces = This.oExecute(Iif(Empty(tcSql), This.cSql, tcSql), ;
|
||
Iif(Empty(tcCursor), This.cCursor, tcCursor), ;
|
||
tlProgress, tcTitluProgress, ;
|
||
Iif(Empty(tnHandle), This.nHandle, tnHandle), ;
|
||
tlShowError)
|
||
Case Pcount() < 8
|
||
lnSucces = This.oExecute(Iif(Empty(tcSql), This.cSql, tcSql), ;
|
||
Iif(Empty(tcCursor), This.cCursor, tcCursor), ;
|
||
tlProgress, tcTitluProgress, ;
|
||
Iif(Empty(tnHandle), This.nHandle, tnHandle), ;
|
||
tlShowError, tlQuitOnError)
|
||
Otherwise
|
||
lnSucces = This.oExecute(Iif(Empty(tcSql), This.cSql, tcSql), ;
|
||
Iif(Empty(tcCursor), This.cCursor, tcCursor), ;
|
||
tlProgress, tcTitluProgress, ;
|
||
Iif(Empty(tnHandle), This.nHandle, tnHandle), ;
|
||
tlShowError, tlQuitOnError, tlReconnect)
|
||
Endcase
|
||
*!* modificare 06.09.2012 ^
|
||
If lnSucces < 0
|
||
amessagebox(This.oPrelucrareEroare(), 16, "Eroare")
|
||
llOk = .F.
|
||
Endif
|
||
Return llOk
|
||
Endfunc
|
||
******************************************* SFARSIT:oExecuta *******************************************
|
||
|
||
* PROCEDURE oExecute( tcSql, tcCursor,tlProgress, tnHandle )
|
||
* Date : 06/10/2004, 12:16:11
|
||
* author : marius.mutu
|
||
* description:
|
||
|
||
****** PARAMETER BLOCK **************
|
||
* Parameters : 3
|
||
* Parameter 1:
|
||
* Parameter 2:
|
||
* Parameter 3:
|
||
*
|
||
******************************************* INCEPUT:oExecute *******************************************
|
||
Procedure oExecute( tcSql, tcCursor, tlProgress, tcTitluProgress, tnHandle, tlShowError, tlQuitOnError, tlReconnect )
|
||
Local lnHandle, lcSql, lcCursor, llProgress, lnSucces, laEroare, lcEroare, llShowError, llQuitOnError, llReconnect
|
||
|
||
&& orice modificare aici trebuie facuta si in oExecuta
|
||
&& tlQuitOnError : Daca face QUIT la eroare (daca vreau QUIT dau .T.) (default .F.)
|
||
&& tlShowError : Daca arata mesajul de eroare (daca vreau sa il tratez in oexecute dau .T.) (default .F.)
|
||
&& tlReconnect : Daca incearca sa se reconecteze (default .T.)
|
||
Local lcSeconds
|
||
lcSeconds = Set("Seconds")
|
||
Set Seconds On
|
||
|
||
If .F.
|
||
Local This As oexecutor
|
||
Endif
|
||
This.Oreset()
|
||
|
||
If Type('goLog') = 'O'
|
||
goLog.Log(tcSql, Program())
|
||
Endif
|
||
|
||
Local lnTip
|
||
lnTip = 0
|
||
|
||
*!* 29.06.2007
|
||
*!* marius.mutu
|
||
*!* nu puneti upper(lcSql) - exista unele expresii in oracle care sunt case sensitive
|
||
If Empty(tcSql)
|
||
lcSql = This.cSql
|
||
Else
|
||
lcSql = tcSql
|
||
Endif
|
||
|
||
If Empty(tcCursor)
|
||
lcCursor = This.cCursor
|
||
Else
|
||
lcCursor = tcCursor
|
||
Endif
|
||
|
||
If Empty(tnHandle)
|
||
lnHandle = This.nHandle
|
||
Else
|
||
lnHandle = tnHandle
|
||
Endif
|
||
|
||
IF (m.lnHandle <= 0)
|
||
This.nSucces = CT_INSUCCES
|
||
This.cEroare = 'Neconectat'
|
||
RETURN CT_INSUCCES
|
||
ENDIF
|
||
|
||
&& DACA AM TRANZACTIE MANUALA NU FAC RECONNECT
|
||
If SQLGetprop(lnHandle, "Transactions") = 2 && TRANZACTIE MANUALA
|
||
This.lReconnect = .F.
|
||
Else
|
||
This.lReconnect = .T.
|
||
Endif
|
||
|
||
Do Case
|
||
Case Pcount() < 6
|
||
llQuitOnError = This.lQuitOnError
|
||
llReconnect = This.lReconnect
|
||
llShowError = This.lShowError
|
||
Case Pcount() < 7
|
||
llQuitOnError = This.lQuitOnError
|
||
llReconnect = This.lReconnect
|
||
*!* modificare 06.09.2012
|
||
Case Pcount() < 8
|
||
llReconnect = This.lReconnect
|
||
*!* modificare 06.09.2012 ^
|
||
Otherwise
|
||
llShowError = tlShowError
|
||
llReconnect = tlReconnect
|
||
llQuitOnError = tlQuitOnError
|
||
Endcase
|
||
|
||
lnSucces = This.nSucces
|
||
|
||
llProgress = tlProgress && IIF(tlProgress or 'SELECT'$lcSql,.T.,.F.)
|
||
lcTitluProgress = Iif(Empty(tcTitluProgress), "", Alltrim(tcTitluProgress))
|
||
|
||
Declare laEroare[1]
|
||
lcEroare = ''
|
||
|
||
|
||
lnTip = Iif('ROLLBACK' $ lcSql Or 'COMMIT' $ lcSql, 1, 0) && daca ROLLBACK SAU COMMIT TIP = 1, ALTFEL 0
|
||
|
||
Do Case
|
||
Case lnTip = 0
|
||
*!* If llProgress
|
||
*!* Local loTherm, lcTask, lnPercent, lnSeconds
|
||
*!* If !Empty(lcTitluProgress)
|
||
*!* lcTask = lcTitluProgress
|
||
*!* Else
|
||
*!* lcTask = "Se executa ... "
|
||
*!* Endif
|
||
*!* loTherm = Newobject("_thermometer","_therm","",lcTask)
|
||
|
||
*!* lnPercent = 15
|
||
|
||
|
||
*!* loTherm.Show()
|
||
*!* Endif
|
||
|
||
*!* Do While .T.
|
||
|
||
*!* If llProgress
|
||
*!* lnPercent = lnPercent + 5
|
||
*!* If lnPercent > 90
|
||
*!* lnPercent = 15
|
||
*!* Endif
|
||
|
||
*!* loTherm.Update(lnPercent, lcTask+" "+Trans(lnPercent))
|
||
*!* Endif
|
||
|
||
|
||
*!* lnSucces = SQLExec(lnHandle,lcSql,lcCursor)
|
||
*!* If lnSucces = 0
|
||
*!* *
|
||
*!* Else
|
||
*!* Exit
|
||
*!* Endif
|
||
*!* Enddo
|
||
|
||
*!* If llProgress
|
||
*!* loTherm.Complete()
|
||
*!* Release loTherm
|
||
*!* Endif
|
||
|
||
If llProgress
|
||
Local loTherm, lcTask, lnPercent, lnSeconds
|
||
If !Empty(lcTitluProgress)
|
||
lcTask = lcTitluProgress
|
||
Else
|
||
lcTask = "Se executa ... "
|
||
Endif
|
||
loTherm = Newobject("_thermometer", "_therm", "", lcTask)
|
||
|
||
lnPercent = 15
|
||
|
||
|
||
loTherm.Show()
|
||
Endif
|
||
|
||
lnSucces = -1
|
||
Do While .T.
|
||
Do While .T.
|
||
|
||
If llProgress
|
||
lnPercent = lnPercent + 5
|
||
If lnPercent > 90
|
||
lnPercent = 15
|
||
Endif
|
||
|
||
loTherm.Update(lnPercent, lcTask + " " + Trans(lnPercent))
|
||
Endif
|
||
|
||
|
||
lnSucces = SQLExec(lnHandle, lcSql, lcCursor)
|
||
If lnSucces = 0
|
||
*
|
||
Else
|
||
Exit
|
||
Endif
|
||
Enddo
|
||
|
||
If lnSucces > 0
|
||
If Used(lcCursor)
|
||
lcTempCursor = Sys(2015)
|
||
Use Dbf(lcCursor) In 0 Again Shared Alias (lcTempCursor)
|
||
Use In (lcCursor)
|
||
Use Dbf(lcTempCursor) In 0 Again Alias (lcCursor)
|
||
Use In (lcTempCursor)
|
||
Endif
|
||
Exit
|
||
Endif
|
||
|
||
If lnSucces < 0
|
||
Release laEroare
|
||
Declare laEroare(1)
|
||
lnEroare1 = 0
|
||
lnEroare2 = 0
|
||
lcTextEroare = []
|
||
lnHandle = 0
|
||
llEroare = .F.
|
||
|
||
Aerror(laEroare)
|
||
If Alen(laEroare) > 1
|
||
lnEroare1 = laEroare[1]
|
||
lnEroare2 = laEroare[5]
|
||
lcTextEroare = laEroare[3]
|
||
lnHandle = laEroare[6]
|
||
llEroare = .T.
|
||
|
||
Endif
|
||
|
||
|
||
Do Case
|
||
Case lnEroare1 <> 1526 && eroare <> ODBC
|
||
lcTextEroare = Program() + Chr(13) + Alltrim(Str(lnEroare1)) + ' ' + laEroare[2] + crlf + crlf + GETCALLSTACK()
|
||
If Type('goLog') = 'O'
|
||
goLog.Log(lcTextEroare, Program())
|
||
Endif
|
||
If llShowError
|
||
amessagebox(lcTextEroare, 0, "Eroare")
|
||
Endif
|
||
If llQuitOnError
|
||
Quit
|
||
Retry
|
||
Else
|
||
Exit
|
||
Endif
|
||
|
||
Case lnEroare1 = 1526 && eroare ODBC
|
||
Do Case
|
||
Case llReconnect And Inlist(lnEroare2, 12152, 3113, 3114, 12560, 4068, 28, 12) && 12512 = TNS: UNABLE TO SEND BREAK MESSAGE; 3114 = NOT CONNECTED TO ORACLE; 12560 = PROTOCOL ADAPTER ERROR
|
||
If Type('goLog') = 'O'
|
||
lcLog = laEroare(3) + crlf + crlf + GETCALLSTACK()
|
||
goLog.Log(lcLog, Program())
|
||
Endif
|
||
|
||
Do While .T.
|
||
lnRaspuns = amessagebox('Eroare de conectare.' + Chr(13) + lcTextEroare + Chr(13) + 'Doriti reconectare?', 4 + 32, 'Eroare') && retry = 4; cancel = 2
|
||
If lnRaspuns = 6
|
||
|
||
lnHandle = goConn.Connect(goConn.cHost, goConn.cUser, goConn.cPassword, llReconnect)
|
||
|
||
*!* gnHandle = SQLConnect(gcHost,gcUserName,gcPassword)
|
||
|
||
If lnHandle < 0
|
||
Declare laEroare2(1)
|
||
Aerror(laEroare2)
|
||
lcTextEroare = laEroare2(3)
|
||
If Type('goLog') = 'O'
|
||
goLog.Log(lcTextEroare, Program())
|
||
Endif
|
||
|
||
Release laEroare2
|
||
Loop
|
||
Else
|
||
*!* goExecutor.nHandle = gnHandle
|
||
Exit
|
||
Endif
|
||
Else
|
||
Quit
|
||
Retry
|
||
Endif && lnRaspuns = 6
|
||
Enddo && .T.
|
||
Loop && daca am iesit cu un handle valid intru din nou in loop si fac cursorfill
|
||
Otherwise
|
||
lcTextEroare = Program() + crlf + Alltrim(Str(lnEroare1)) + ' ' + crlf + Transform(laEroare[3]) + crlf + lcSql + crlf + crlf + GETCALLSTACK()
|
||
If llShowError
|
||
lnRaspuns = amessagebox('Eroare necunoscuta' + Chr(13) + lcTextEroare, 0, 'Eroare') && ok = 0
|
||
Endif
|
||
If Type('goLog') = 'O'
|
||
goLog.Log(lcTextEroare, Program())
|
||
Endif
|
||
If llQuitOnError
|
||
Quit
|
||
Retry
|
||
Else
|
||
Exit
|
||
Endif
|
||
Endcase && INLIST(lnEroare2,12152,3114)
|
||
Endcase
|
||
Endif && lnSucces < 0
|
||
|
||
Enddo && .T.
|
||
|
||
If llProgress
|
||
loTherm.Complete()
|
||
Release loTherm
|
||
Endif
|
||
|
||
Case lnTip = 1
|
||
If 'ROLLBACK' $ lcSql
|
||
lnSucces = Sqlrollback(lnHandle)
|
||
Else
|
||
lnSucces = Sqlcommit(lnHandle)
|
||
Endif
|
||
Endcase
|
||
|
||
If lnSucces < 0
|
||
Aerror(laEroare)
|
||
|
||
If laEroare[1] <> 1526
|
||
lcEroare = laEroare[2]
|
||
Else
|
||
lcEroare = Alltrim(Transform(laEroare[1])) + crlf + + Alltrim(Transform(laEroare[3])) + crlf + lcSql + crlf + crlf + GETCALLSTACK()
|
||
*!* 07.02.2008
|
||
This.cEroare = lcEroare
|
||
lcEroare = This.oPrelucrareEroare()
|
||
*!* 07.02.2008 ^
|
||
Endif
|
||
|
||
If Type('goMyXMLHTTP') = 'O'
|
||
lcLunaHTTP = Iif(Type('gnLuna') = 'N', Transform(gnLuna) + "/", "") + Iif(Type('GNAN') = 'N', Transform(gnAn), "")
|
||
lcErrorHTTP = Sys(0) + ":" + Iif(Type('GCS') = 'C', " " + GCS, "") + ": " + lcLunaHTTP + Chr(13) + Chr(10) + lcEroare + ;
|
||
Chr(13) + Chr(10) + Chr(13) + Chr(10) + GETCALLSTACK()
|
||
|
||
lcUserName = gcUserNameApp
|
||
lcProgram = Juststem(Sys(16, 0))
|
||
goMyXMLHTTP.postError(lcErrorHTTP, lcUserName, lcProgram)
|
||
Endif
|
||
|
||
If llShowError
|
||
amessagebox(lcEroare, 0, "Eroare")
|
||
Endif
|
||
If llQuitOnError
|
||
Quit
|
||
Retry
|
||
Endif
|
||
|
||
Endif
|
||
|
||
|
||
|
||
This.aEroare = laEroare
|
||
This.nSucces = lnSucces
|
||
This.cEroare = lcEroare
|
||
This.nEroare = Iif(Alen(laEroare) >= 5, laEroare[5], 0)
|
||
|
||
Set Seconds &lcSeconds
|
||
|
||
*!* modificare ROAFACTURARE v 2.0.77
|
||
*!* *!* 07.09.2009
|
||
*!* *!* RETURN lnSucces
|
||
*!* Return IIF(lnSucces = 1, CT_SUCCES, CT_INSUCCES)
|
||
Return Iif(lnSucces >= 1, CT_SUCCES, CT_INSUCCES)
|
||
*!* *!* 07.09.2009 ^
|
||
*!* modificare ROAFACTURARE v 2.0.77 ^
|
||
Endproc
|
||
******************************************* SFARSIT: oExecute *******************************************
|
||
|
||
*!* salveaza rezultatul unei functii in variabila data ca referinta
|
||
*!* intoarce SUCCES = (1,-1)
|
||
*!* lnSucces = oFunction2Value("MyFunction(MyParam1, MyParam2)", @pnReturnValue)
|
||
Function oFunction2Value
|
||
Lparameters tcFunction, tuRetValue
|
||
|
||
lcSql = "select " + tcFunction + " as retvalue from dual"
|
||
lcCursor = Sys(2015)
|
||
lcField = lcCursor + ".retvalue"
|
||
|
||
lnSucces = This.oExecute(lcSql, lcCursor)
|
||
|
||
If lnSucces > 0
|
||
tuRetValue = Evaluate(lcField)
|
||
If Used(lcCursor)
|
||
Use In (lcCursor)
|
||
Endif
|
||
Endif
|
||
|
||
*!* 07.09.2009
|
||
*!* RETURN lnSucces
|
||
Return Iif(lnSucces = 1, CT_SUCCES, CT_INSUCCES)
|
||
*!* 07.09.2009 ^
|
||
|
||
Endfunc && oFunction2Value
|
||
******************************************* SFARSIT: oFunction2Value *******************************************
|
||
|
||
*!* salveaza rezultatul unui select in variabila data ca referinta
|
||
*!* daca se intorc mai multe randuri - eroare
|
||
*!* intoarce SUCCES = .T./.F.
|
||
*!* afiseaza mesajul de eroare, daca este cazul
|
||
*!* lnSucces = oSelecteaza2Value("Select sum(cantitate) from tabel where conditie", @pnReturnValue)
|
||
Function oSelecteaza2Value
|
||
Lparameters tcSql, tuRetValue
|
||
* tlShowError, daca afiseaza mesaje de eroare
|
||
Local lnSucces
|
||
lnSucces = This.oSelect2Value(m.tcSql, @m.tuRetValue)
|
||
|
||
If m.lnSucces = CT_INSUCCES
|
||
amessagebox(This.oPrelucrareEroare(), 16, "Eroare")
|
||
Endif
|
||
|
||
Return (m.lnSucces = CT_SUCCES)
|
||
|
||
Endfunc &&oSelect2Value
|
||
******************************************* SFARSIT: oFunction2Value *******************************************
|
||
|
||
*!* salveaza rezultatul unui select in variabila data ca referinta
|
||
*!* daca se intorc mai multe randuri - eroare
|
||
*!* intoarce SUCCES = (1,-1)
|
||
*!* lnSucces = oSelect2Value("Select sum(cantitate) from tabel where conditie", @pnReturnValue)
|
||
Function oSelect2Value
|
||
Lparameters tcSql, tuRetValue
|
||
|
||
Local lcSelect, lcSql, lcCursor, lcField, lnSucces
|
||
|
||
lcSelect = Select()
|
||
lcSql = tcSql
|
||
lcCursor = Sys(2015)
|
||
|
||
lnSucces = This.oExecute(lcSql, lcCursor)
|
||
|
||
If lnSucces > 0
|
||
If Reccount(lcCursor) > 1
|
||
This.nSucces = -1
|
||
This.cEroare = 'Au rezultat mai multe valori. Se astepta o singura valoare.'
|
||
lnSucces = -1
|
||
Else
|
||
lcField = lcCursor + '.' + Field(1)
|
||
tuRetValue = Evaluate(lcField)
|
||
Endif
|
||
If Used(lcCursor)
|
||
Use In (lcCursor)
|
||
Endif
|
||
Endif
|
||
|
||
Select (lcSelect)
|
||
|
||
*!* 07.09.2009
|
||
*!* RETURN lnSucces
|
||
Return Iif(lnSucces = 1, CT_SUCCES, CT_INSUCCES)
|
||
*!* 07.09.2009 ^
|
||
|
||
Endfunc &&oSelect2Value
|
||
******************************************* SFARSIT: oFunction2Value *******************************************
|
||
|
||
|
||
*!* salveaza rezultatul unui select in variabila data ca referinta
|
||
*!* daca se intorc mai multe randuri - eroare
|
||
*!* intoarce SUCCES = T/F
|
||
*!* llSucces = goExecutor.oSelecteaza2Object("Select id, denumire from tabel where conditie", @poObject)
|
||
Function oSelecteaza2Object
|
||
Lparameters tcSql, toRetValue
|
||
|
||
Local lcSelect, lcSql, lcCursor, lcField, llSucces
|
||
lcSelect = Select()
|
||
lcSql = tcSql
|
||
lcCursor = Sys(2015)
|
||
|
||
llSucces = This.oExecuta(lcSql, lcCursor)
|
||
|
||
If m.llSucces
|
||
If Reccount(m.lcCursor) > 1
|
||
This.nSucces = -1
|
||
This.cEroare = 'Au rezultat mai multe valori. Se astepta o singura valoare.'
|
||
llSucces = .F.
|
||
Else
|
||
Select (m.lcCursor)
|
||
Scatter Name toRetValue Memo
|
||
Endif
|
||
Use In (Select(m.lcCursor))
|
||
Endif && llSucces
|
||
|
||
Select (m.lcSelect)
|
||
Return m.llSucces
|
||
Endfunc &&oSelecteaza2Object
|
||
******************************************* SFARSIT: oSelecteaza2Object *******************************************
|
||
|
||
******************************************* INCEPUT: oPrelucrareEroare *******************************************
|
||
&& Prelucreaza mesajul de eroare : daca este intre ORA-20000 si ORA-20999 atunci afiseaza doar textul erorii
|
||
Function oPrelucrareEroare
|
||
Local lcTextEroare
|
||
lcTextEroare = This.cEroare
|
||
|
||
If Like('*ORA-20???:*', lcTextEroare)
|
||
lnPozi = At("ORA-20", lcTextEroare) + 11
|
||
lnPozf = At("ORA", lcTextEroare, 2)
|
||
lcTextEroare = Substr(lcTextEroare, lnPozi, lnPozf - lnPozi)
|
||
*!* ELSE
|
||
*!* lnPozf=At("ORA-",lcTextEroare,3)
|
||
*!* lcTextEroare=Substr(lcTextEroare,1,lnPozf-1)+[...]
|
||
Endif
|
||
Return lcTextEroare
|
||
Endfunc && oPrelucrareEroare
|
||
******************************************* SFARSIT: oPrelucrareEroare *******************************************
|
||
* PROCEDURE oReset( )
|
||
* Date : 06/10/2004, 12:21:06
|
||
* author : marius.mutu
|
||
* description:
|
||
|
||
****** PARAMETER BLOCK **************
|
||
* Parameters : 0
|
||
*
|
||
******************************************* INCEPUT:oReset *******************************************
|
||
Procedure Oreset( )
|
||
With This
|
||
.aEroare = .F.
|
||
.nSucces = 0
|
||
.cSql = ''
|
||
.cCursor = ''
|
||
Endwith
|
||
Endproc
|
||
******************************************* SFARSIT: oReset *******************************************
|
||
|
||
Enddefine && oExecutor
|
||
|
||
|
||
|
||
|
||
*** oConn ===========================================================================================
|
||
Define Class oConn As Custom
|
||
|
||
cHost = ''
|
||
cUser = ''
|
||
cPassword = ''
|
||
nHandle = 0
|
||
cEroare = ''
|
||
Declare aEroare[7]
|
||
lShowError = .F.
|
||
lReconnect = .F. && Daca llReconnect = .T. se apeleaza InitSesiune din oInit_Optiuni.prg
|
||
|
||
FUNCTION IsConnected
|
||
RETURN (This.nHandle > 0)
|
||
ENDFUNC && IsConnected
|
||
|
||
*** Connect ===========================================================================================
|
||
Procedure Connect
|
||
Lparameters tcHost, tcUser, tcPassword, tlReconnect
|
||
|
||
*!* tlReconnect = .T. daca se apeleaza connect la reconectare (atunci se apeleaza si InitSesiune())
|
||
Local lnSucces, laEroare, lcString, lcHost, lcUser, lcPassword, lcSql
|
||
|
||
If Pcount() < 3 Or Type('tcHost') # 'C' Or Type('tcUser') # 'C' Or Type('tcPassword') # 'C'
|
||
*
|
||
Else
|
||
This.cHost = tcHost
|
||
This.cUser = tcUser
|
||
This.cPassword = tcPassword
|
||
Endif
|
||
|
||
lcHost = This.cHost
|
||
lcUser = This.cUser
|
||
lcPassword = This.cPassword
|
||
|
||
If Pcount() < 4 Or Type('tlReconnect') # 'L'
|
||
llReconnect = This.lReconnect
|
||
Else
|
||
llReconnect = tlReconnect
|
||
Endif
|
||
|
||
SQLSetprop(0, "DispLogin", 3)
|
||
lcString = "dsn=" + Alltrim(lcHost) + ";Uid=" + Alltrim(lcUser) + ";Pwd=" + Alltrim(lcPassword) + ";"
|
||
|
||
This.nHandle = Sqlstringconnect(lcString)
|
||
|
||
If Type('gnHandle') = 'N'
|
||
gnHandle = This.nHandle
|
||
Endif
|
||
|
||
If Type('goExecutor') = 'O'
|
||
goExecutor.nHandle = This.nHandle
|
||
Endif
|
||
|
||
If This.nHandle > 0
|
||
lnSucces = 1
|
||
|
||
*** SETARI SESIUNE DUPA CONECTARE
|
||
This.postConn()
|
||
|
||
If llReconnect
|
||
lnSucces = InitSesiune() && IN oInit_Optiuni.prg
|
||
Endif
|
||
Else
|
||
lnSucces = -1
|
||
This.ProcessError()
|
||
Endif
|
||
|
||
Return This.nHandle
|
||
|
||
Endproc && Connect
|
||
*** END Connect ===========================================================================================
|
||
|
||
*** Disconnect ===========================================================================================
|
||
Procedure Disconnect
|
||
Lparameters tnHandle
|
||
|
||
Local lnSucces, lnHandle
|
||
|
||
lnHandle = Iif(Empty(tnHandle) Or Type('tnHandle') # 'N', 0, tnHandle)
|
||
|
||
lnSucces = SQLDisconnect(lnHandle)
|
||
|
||
If lnSucces < 0
|
||
This.ProcessError()
|
||
Endif
|
||
|
||
*!* 07.09.2009
|
||
*!* RETURN lnSucces
|
||
Return Iif(lnSucces = 1, CT_SUCCES, CT_INSUCCES)
|
||
*!* 07.09.2009 ^
|
||
|
||
Endproc &&
|
||
*** END Disconnect ===========================================================================================
|
||
|
||
*** ProcessError ===========================================================================================
|
||
Procedure ProcessError
|
||
|
||
Local laEroare, lnEroare1, lnEroare2, lcTextEroare, lcEroareConectare
|
||
lcTextEroare = ''
|
||
lcEroareConectare = ''
|
||
Dimension laEroare[1]
|
||
|
||
Aerror(laEroare)
|
||
If Alen(laEroare) > 1
|
||
lnEroare1 = laEroare[1]
|
||
lnEroare2 = laEroare[5]
|
||
lcTextEroare = laEroare[3]
|
||
lnHandle = laEroare[6]
|
||
llEroare = .T.
|
||
|
||
lcTextEroare = 'Conectarea nu a reusit ' + Chr(13) + Chr(10) + Alltrim(Transform(laEroare[1])) + ' ' + Chr(13) + Transform(laEroare[2]) + Chr(13) + Transform(laEroare[3])
|
||
This.cEroare = lcTextEroare
|
||
This.aEroare = laEroare
|
||
|
||
If Type('goLog') = 'O'
|
||
goLog.Log(lcTextEroare, Program())
|
||
Endif
|
||
|
||
If laEroare[1] = 1526 And Like('*ORA-20???:*', laEroare[2])
|
||
lnPozi = At("ORA-20", laEroare[2]) + 11
|
||
lnPozf = At("ORA", laEroare[2], 3)
|
||
lcEroareConectare = Substr(laEroare[2], lnPozi, lnPozf - lnPozi)
|
||
Else
|
||
lcEroareConectare = lcTextEroare
|
||
Endif
|
||
If Empty(lcEroareConectare)
|
||
lcEroareConectare = "Conectarea nu a reusit!"
|
||
Endif
|
||
|
||
amessagebox(lcEroareConectare, 0 + 48, "Atentie")
|
||
Endif
|
||
|
||
Return lcTextEroare
|
||
|
||
Endproc && ProcessError
|
||
*** END ProcessError ===========================================================================================
|
||
|
||
*** postConn ===========================================================================================
|
||
Procedure postConn
|
||
*** PUNCT ZECIMAL
|
||
lcSql = [ALTER SESSION SET NLS_NUMERIC_CHARACTERS = ".,"]
|
||
lnSucces = goExecutor.oExecute(lcSql)
|
||
If lnSucces < 0
|
||
amessagebox(goExecutor.cEroare, 0 + 16, 'Eroare')
|
||
Endif
|
||
|
||
Endproc && postConn
|
||
*** END postConn ===========================================================================================
|
||
|
||
Procedure BeginManualTransaction
|
||
Local lnHandle, lnSucces, llSucces
|
||
|
||
lnHandle = This.nHandle
|
||
llSucces = .T.
|
||
|
||
If SQLGetprop(lnHandle, "Transactions") = 1 && TRANZACTIE AUTOMATA
|
||
lnSucces = SQLSetprop(m.lnHandle, "Transactions", 2) && TRANZACTIE MANUALA
|
||
llSucces = (m.lnSucces = 1)
|
||
Endif
|
||
Return m.llSucces
|
||
Endproc && BeginManualTransaction
|
||
|
||
Procedure EndManualTransaction
|
||
Lparameters tcMode
|
||
*** tcMode: optional: COMMIT/ROLLBACK/EMPTY (DEFAULT)
|
||
|
||
Local lnHandle, lcMode, lnSucces, llSucces
|
||
lcMode = Iif(!Empty(m.tcMode), Upper(m.tcMode), '')
|
||
lnHandle = This.nHandle
|
||
llSucces = .T.
|
||
If !Empty(m.lcMode)
|
||
llSucces = goExecutor.oExecuta(m.lcMode)
|
||
Endif
|
||
|
||
If SQLGetprop(lnHandle, "Transactions") = 2 && TRANZACTIE MANUALA
|
||
lnSucces = SQLSetprop(m.lnHandle, "Transactions", 1) && TRANZACTIE AUTOMATA
|
||
llSucces = (m.lnSucces = 1)
|
||
Endif
|
||
Return m.llSucces
|
||
Endproc && BeginManualTransaction
|
||
Enddefine && oConn
|
||
*** END oConn ===========================================================================================
|
||
|
||
|
||
|
||
* PROCEDURE Get_Ora( tnTip )
|
||
* Date : 16/11/2004, 08:58:45
|
||
* author : marius.mutu
|
||
* description:
|
||
|
||
****** PARAMETER BLOCK **************
|
||
* Parameters : 1
|
||
* Parameter 1:
|
||
*
|
||
******************************************* INCEPUT:Get_Ora *******************************************
|
||
Procedure Get_Ora( tnTip )
|
||
* tnTip: 1 sau nimic = DATETIME ; 2 = CHARACTER
|
||
|
||
Local lcRetVal, lnSucces
|
||
Local lcCursor, lcSql, lcSelect, lcTipDataOra
|
||
lcSelect = Select()
|
||
|
||
If Pcount() = 0 Or Type('tnTip') <> 'N'
|
||
lnTip = 1
|
||
Else
|
||
lnTip = tnTip
|
||
Endif
|
||
|
||
lcTipDataOra = Lower(Nvl(goAPI.GetProfileString(m.gcSettingsFile, [general], "tipdataora"), '')) && local/server
|
||
|
||
lcTipDataOra = Iif(!Inlist(m.lcTipDataOra, 'local', 'server', 'nimic'), 'server', m.lcTipDataOra)
|
||
Do Case
|
||
Case m.lcTipDataOra = 'server'
|
||
&&preluare ora de pe oracle server:
|
||
Store - 1 To lnSucces
|
||
lcSql = [select to_char(SYSdate,'dd/mm/yyyy hh24:mi:ss') as dataora from dual]
|
||
lcCursor = [dataora_cursor]
|
||
lnSucces = goExecutor.oExecute(lcSql, lcCursor)
|
||
If lnSucces < 0
|
||
amessagebox(goExecutor.cEroare, 0 + 16, , 'Eroare')
|
||
lcRetVal = Ttoc(Datetime())
|
||
Else
|
||
Select dataora_cursor
|
||
lcRetVal = dataora_cursor.dataora
|
||
Use In dataora_cursor
|
||
Endif
|
||
If lnTip = 1
|
||
lcRetVal = Ctot(lcRetVal)
|
||
Endif
|
||
Case m.lcTipDataOra = 'local'
|
||
* local = ora de pe calculator
|
||
lcRetVal = Iif(lnTip = 1, Datetime(), '* ' + Ttoc(Datetime()))
|
||
Otherwise && nimic
|
||
lcRetVal = Iif(lnTip = 1, Datetime(), '*')
|
||
Endcase
|
||
|
||
If !Empty(lcSelect)
|
||
Select (lcSelect)
|
||
Endif
|
||
|
||
Return lcRetVal
|
||
Endproc
|
||
******************************************* SFARSIT: Get_Ora *******************************************
|
||
*________________________________________________________
|
||
|
||
Function ULTIMAZI
|
||
Parameters tcAn, tcLuna
|
||
|
||
Local lcAn, lcLuna
|
||
|
||
If Empty(tcAn)
|
||
lcAn = pcAn
|
||
Else
|
||
lcAn = Alltrim(tcAn)
|
||
Endif
|
||
|
||
If Empty(tcLuna)
|
||
lcLuna = pcNl
|
||
Else
|
||
lcLuna = Alltrim(tcLuna)
|
||
Endif
|
||
|
||
If Val(lcAn) = Year(Date()) And Val(lcLuna) = Month(Date())
|
||
Return Date()
|
||
Endif
|
||
|
||
lcData = '01/' + lcLuna + '/' + lcAn
|
||
ldData = Gomonth(Ctod(lcData), 1) - 1
|
||
|
||
Return ldData
|
||
|
||
****************************************************************
|
||
|
||
Function get_nivel_upf(tnid_util, tnid_prog, tnid_firma)
|
||
Private pnid_util, pnid_prog, pnid_firma
|
||
pnid_util = tnid_util
|
||
pnid_prog = tnid_prog
|
||
pnid_firma = tnid_firma
|
||
Local lnnivel
|
||
lcSql = [select ud.id_nivel,n.nivel from contafin_oracle.util_drept ud ] + ;
|
||
[join contafin_oracle.nivel n on ud.id_nivel = n.id_nivel ] + ;
|
||
[where ud.id_util = ?pnid_util and ud.id_prog = ?pnid_prog and ] + ;
|
||
[ud.id_firma = ?pnid_firma]
|
||
lcCursor = [crsUtilNivel]
|
||
lnSucces = goExecutor.oExecute(lcSql, lcCursor)
|
||
If lnSucces < 0
|
||
lcTitlu = [Eroare]
|
||
lctip = [Avertizare]
|
||
lcImagine = [exclam.ico]
|
||
lcMesaj = goExecutor.cEroare
|
||
ofrm_eroare = Createobject('frm_mesaj', lcTitlu, lcImagine, lctip, lcMesaj)
|
||
ofrm_eroare.Show(1)
|
||
Release ofrm_eroare
|
||
Return
|
||
Endif
|
||
lnnivel = &lcCursor..nivel
|
||
Return lnnivel
|
||
Endfunc &&get_nivel_upf
|
||
|
||
*******************************************************************************************************
|
||
|
||
Function enumefis
|
||
Parameters tc_numefis
|
||
Private pn_len, pl_return, pc_numefis, pc_char
|
||
pn_len = 0
|
||
pc_char = ''
|
||
pl_return = .T.
|
||
pc_numefis = Alltrim(tc_numefis)
|
||
pn_len = Len(pc_numefis)
|
||
If pn_len = 0
|
||
pl_return = .F.
|
||
Endif
|
||
Do While pn_len > 0
|
||
pc_char = Substr(pc_numefis, pn_len, 1)
|
||
If !Between(Asc(pc_char), 48, 57) And !Between(Asc(pc_char), 97, 122) And !Between(Asc(pc_char), 65, 90) And Asc(pc_char) <> 95 And Asc(pc_char) <> 46
|
||
pl_return = .F.
|
||
Exit
|
||
Endif
|
||
pn_len = pn_len - 1
|
||
Enddo
|
||
Return pl_return
|
||
Endfunc && enumefis
|
||
***********************************************************************************************
|
||
|
||
|
||
*******************************************
|
||
* PROCEDURE ImportTable
|
||
* Date : 08/07/2005, 09:20:54
|
||
* author : marius.mutu
|
||
* description: intoarce numele unui cursor cu datele importate dintr-un dbf
|
||
*******************************************
|
||
Procedure ImportTable
|
||
Local lcCursor
|
||
lcCursor = ""
|
||
loimport = Newobject("frm_import", "importdata")
|
||
loimport.Show(1)
|
||
If gnButon = 1
|
||
lcCursor = "crsReturn"
|
||
Endif
|
||
|
||
Return lcCursor
|
||
|
||
Endproc
|
||
*----------------------------------sfarsit procedura ImportTable----------------------------------
|
||
|
||
|
||
Function Lista_Campuri
|
||
Lparameters tcAlias
|
||
|
||
Local lcSelect, i, lcAlias, lcLista
|
||
lcLista = []
|
||
lcSelect = Select()
|
||
lcAlias = tcAlias
|
||
|
||
Select (lcAlias)
|
||
lnFields = Fcount()
|
||
For i = 1 To lnFields
|
||
lcField = Field(i)
|
||
lcLista = lcLista + [,] + lcField
|
||
Endfor
|
||
If !Empty(lcLista)
|
||
lcLista = Substr(lcLista, 2)
|
||
Endif
|
||
|
||
Select (lcSelect)
|
||
Return lcLista
|
||
|
||
Endfunc && Lista_Campuri
|
||
|
||
|
||
***---------------------------------------------------------------------
|
||
Procedure OPEN_DEFAULT_APP
|
||
Parameters tcfilename, tcParams
|
||
LOCAL cFileName, cAction, cParams
|
||
|
||
Declare Integer ShellExecute In shell32.Dll ;
|
||
Integer hndWin, ;
|
||
String cAction, ;
|
||
String cFileName, ;
|
||
String cParams, ;
|
||
String cDir, ;
|
||
Integer nShowWin
|
||
cFileName = tcfilename
|
||
cAction = "open"
|
||
cParams = IIF(!EMPTY(m.tcParams), m.tcParams, "")
|
||
|
||
ShellExecute(0, cAction, cFileName, cParams, "", 1)
|
||
|
||
Endproc && OPEN_DEFAULT_APP
|
||
|
||
|
||
***---------------------------------------------------------------------
|
||
Procedure GET_SCHEMA_GRID
|
||
Lparameters toGrid, tcColumnList, tcHeaderList, tcSchema, tlSelect, tnType, tcFrom, tcWhere, tcOrder, tcOutputName
|
||
|
||
Local lcSelect, llSelect, lcAlias, lcWhere, lcOrder, lcColumn, lcHeader, lnOccurs
|
||
Local lnType, lcInto
|
||
&& tnType : 0 CURSOR, 1 TABLE, 2 ARRAY
|
||
|
||
If Type('tnType') # 'N'
|
||
lnType = 0
|
||
Else
|
||
If !Between(tnType, 0, 2)
|
||
lnType = 0
|
||
Else
|
||
lnType = tnType
|
||
Endif
|
||
Endif
|
||
Do Case
|
||
Case lnType = 0
|
||
lcInto = ' INTO CURSOR '
|
||
Case lnType = 1
|
||
lcInto = ' INTO TABLE '
|
||
Other lnType = 1
|
||
lcInto = ' INTO ARRAY '
|
||
Endcase
|
||
|
||
|
||
tcColumnList = ''
|
||
tcHeaderList = ''
|
||
tcSchema = ''
|
||
|
||
lnNrCol = toGrid.ColumnCount
|
||
Dimension myArray[lnNrCol, 3]
|
||
|
||
With toGrid
|
||
For lnCol = 1 To .ColumnCount
|
||
lnColumn = .Columns(lnCol).ColumnOrder
|
||
lcColumn = .Columns(lnCol).ControlSource
|
||
llVisible = .Columns(lnCol).Visible
|
||
lnWidth = .Columns(lnCol).Width
|
||
If !llVisible Or lnWidth = 0 Or Empty(Alltrim(lcColumn))
|
||
Adel(myArray, lnCol)
|
||
Loop
|
||
Endif
|
||
lnPos = At('.', lcColumn)
|
||
lnOccurs = Occurs('.', m.lcColumn)
|
||
If m.lnOccurs = 1 And m.lnPos > 0
|
||
lcColumn = Substr(lcColumn, lnPos + 1)
|
||
Endif
|
||
*tcColumnList = tcColumnList + lcColumn + ','
|
||
myArray[lnCol, 1] = lnColumn
|
||
|
||
For lnobjcol = 1 To .Columns(lnCol).Objects.Count
|
||
If Upper(.Columns(lnCol).Objects(lnobjcol).BaseClass) = 'HEADER'
|
||
lcHeader = .Columns(lnCol).Objects(lnobjcol).Caption
|
||
lcHeader = Strtran(Strtran(Strtran(Strtran(Strtran(Strtran(Strtran(Strtran(Strtran(lcHeader, Chr(32), '_'), '.', '_'), '/', '_'), '\', '_'), "&", "_"), "%", ""), "(", "_"), ")", "_"), "-", "_")
|
||
lcHeader = Strtran(lcHeader, '=', '_')
|
||
lcHeader = Strtran(lcHeader, ',', '_')
|
||
lcHeader = Strtran(lcHeader, '+', '_')
|
||
*tcHeaderList = tcHeaderList + lcHeader + ','
|
||
*tcSchema = tcSchema + lcColumn + [ as ] + lcHeader + [,]
|
||
myArray[lnCol, 2] = lcColumn
|
||
myArray[lnCol, 3] = lcHeader
|
||
Exit
|
||
Endif
|
||
Endfor
|
||
Endfor
|
||
*!* tcColumnList = Substr(tcColumnList, 1, Len(tcColumnList)-1)
|
||
*!* tcHeaderList = Substr(tcHeaderList , 1, Len(tcHeaderList)-1)
|
||
*!* tcSchema = Substr(tcSchema , 1, Len(tcSchema)-1)
|
||
Endwith
|
||
For i = 1 To Alen(myArray, 1)
|
||
l1 = myArray[i, 1]
|
||
If Type('l1') # 'N'
|
||
myArray[i, 1] = -1
|
||
Endif
|
||
Endfor
|
||
|
||
Asort(myArray)
|
||
For i = 1 To Alen(myArray, 1)
|
||
If myArray[i, 1] <> -1
|
||
tcColumnList = tcColumnList + Alltrim(myArray[i, 2]) + [,]
|
||
tcHeaderList = tcHeaderList + Alltrim(myArray[i, 3]) + [,]
|
||
tcSchema = tcSchema + Alltrim(myArray[i, 2]) + [ as ] + Alltrim(myArray[i, 3]) + [,]
|
||
Endif
|
||
Endfor
|
||
|
||
tcColumnList = Substr(tcColumnList, 1, Len(tcColumnList) - 1)
|
||
tcHeaderList = Substr(tcHeaderList, 1, Len(tcHeaderList) - 1)
|
||
tcSchema = Substr(tcSchema, 1, Len(tcSchema) - 1)
|
||
|
||
|
||
If tlSelect
|
||
tcSchema = 'SELECT ' + tcSchema
|
||
Endif
|
||
If !Empty(tcFrom)
|
||
tcSchema = tcSchema + ' FROM ' + Alltrim(tcFrom)
|
||
Endif
|
||
If !Empty(tcWhere)
|
||
tcSchema = tcSchema + ' WHERE ' + Alltrim(tcWhere)
|
||
Endif
|
||
|
||
If !Empty(tcOrder)
|
||
tcSchema = tcSchema + ' ORDER BY ' + Alltrim(tcOrder)
|
||
Endif
|
||
|
||
If !Empty(tcOutputName)
|
||
tcSchema = tcSchema + lcInto + tcOutputName
|
||
Endif
|
||
|
||
Endproc && GET_SCHEMA_GRID
|
||
|
||
***---------------------------------
|
||
Procedure amessage
|
||
Lparameters tcMessage, tnDialogBoxType, tcTitleBarText, tnTimeOut
|
||
Local lnResponse
|
||
lnResponse = 0
|
||
lcMessage = Iif(Empty(tcMessage), [], tcMessage)
|
||
lnDialogBoxType = Iif(Empty(tnDialogBoxType), 0, tnDialogBoxType)
|
||
lcTitleBarText = Iif(Empty(tcTitleBarText), [], tcTitleBarText)
|
||
lnTimeOut = Iif(Empty(tnTimeOut), 0, tnTimeOut)
|
||
If lnTimeOut # 0
|
||
lnResponse = amessagebox(lcMessage, lnDialogBoxType, lcTitleBarText, lnTimeOut)
|
||
Else
|
||
lnResponse = amessagebox(lcMessage, lnDialogBoxType, lcTitleBarText)
|
||
Endif
|
||
|
||
Return lnResponse
|
||
|
||
Endproc && amessage
|
||
***---------------------------------
|
||
|
||
DEFINE CLASS oChatBotLaunch as Custom
|
||
cMessage = ''
|
||
|
||
FUNCTION Init
|
||
LPARAMETERS tcMessage
|
||
This.cMessage = m.tcMessage
|
||
ENDFUNC
|
||
|
||
FUNCTION Launch
|
||
open_default_app('https://www.romfast.ro/chatbot_maria.html?message=' + ALLTRIM(This.cMessage))
|
||
ENDFUNC
|
||
ENDDEFINE
|
||
|
||
***---------------------------------
|
||
Function amessagebox
|
||
Lparameters tcMessage, tnDialogBoxType, tcTitle, tcFont, tnTimeOut, tnTimeoutValue
|
||
|
||
Local loMessage, lnReturn, lcMessageboxForm
|
||
PRIVATE oChatbot
|
||
oChatBot = CREATEOBJECT("oChatBotLaunch", m.tcMessage)
|
||
|
||
*!* *!* LOGHEZ ERORILE
|
||
*!* IF TYPE('goLog') = 'O' AND 'ERROR'$UPPER(tcMessage) OR 'EROARE'$UPPER(tcMessage) OR 'ORA-'$UPPER(tcMessage)
|
||
*!* goLog.LOG(tcMessage,PROGRAM())
|
||
*!* ENDIF
|
||
If Type('gcNumeProgram') = 'C' And gcNumeProgram = 'ROASTART'
|
||
lcMessageboxForm = "messagebox_form_desktop" && desktop .T.
|
||
Else
|
||
lcMessageboxForm = "messagebox_form"
|
||
Endif
|
||
If !'MESSAGEBOX' $ Upper(Set("Classlib"))
|
||
If Type('lnTimeOut') = 'N' And lnTimeOut # 0
|
||
lnReturn = Messagebox(tcMessage, tnDialogBoxType, tcTitle, tnTimeOut)
|
||
Else
|
||
lnReturn = Messagebox(tcMessage, tnDialogBoxType, tcTitle)
|
||
Endif
|
||
Else
|
||
loMessage = Newobject(lcMessageboxForm, "MessageBox.vcx", "", tcMessage, tnDialogBoxType, tcTitle, tcFont, tnTimeOut, tnTimeoutValue)
|
||
loMessage.AlwaysOnTop = .T.
|
||
loMessage.Show(1)
|
||
lnReturn = loMessage.IDOpcion
|
||
Endif
|
||
|
||
|
||
Return lnReturn
|
||
|
||
Endfunc && amessagebox
|
||
***---------------------------------
|
||
|
||
Procedure export_xls
|
||
Lparameters tcAlias, tcNumeFisier
|
||
|
||
If Empty(tcNumeFisier)
|
||
tcNumeFisier = 'Foaie_Excel'
|
||
Endif
|
||
|
||
Local lcSelect
|
||
lcSelect = Select()
|
||
|
||
If Used(tcAlias)
|
||
lcDir = Addbs(gcTempPath)
|
||
|
||
lcFile = Putfile('Nume fisier:', tcNumeFisier, 'XLS')
|
||
If Empty(lcFile) && Esc pressed
|
||
Return
|
||
Endif
|
||
|
||
|
||
Select (tcAlias)
|
||
Export To (lcFile) Type Xl5
|
||
Select (lcSelect)
|
||
|
||
OPEN_DEFAULT_APP(lcFile)
|
||
|
||
Endif
|
||
Endproc && export_xls
|
||
|
||
*__________________________________________________________
|
||
|
||
&& Folosesc un tabel <ids> (tabel,id) cu cate o linie pt fiecare tabel
|
||
&& aflu id-ul urmator si il scriu in tabela <ids>
|
||
&& returnez id-ul
|
||
&& EX1: LNEW_ID=NEW_ID("GRILA_SAL") --> urmatorul id din <grila_sal> fara cautare in tabela originala
|
||
&& EX2: LNEW_ID=NEW_ID("GRILA_SAL","ID") --> urmatorul id din <grila_sal> cu cautare in tabela originala dupa campul<id>
|
||
&& ex3: LNEW_ID=NEW_ID("GRILA_SAL","ID",.T.) --> .T. INSEAMNA CA TABELUL ORIGINAL ESTE INDEXAT DUPA <ID> FAC SEEK IN LOC DE LOCATE
|
||
Procedure NEW_ID
|
||
Parameters TALIAS, TFIELD, TTAG
|
||
*WAIT WINDOW TALIAS
|
||
*ON error Errorh(ERROR(),PROGRAM(),LINENO())
|
||
LLLOOKUP = Iif(Type("tfield") = "C", .T., .F.)
|
||
LLTAG = Iif(Type("TTAG") = "C", .T., .F.)
|
||
TALIAS = Upper(Alltrim(TALIAS))
|
||
|
||
|
||
*** Save Stats
|
||
LCOLDALIAS = Alias() && keep current work area
|
||
LNOLDRECNO = Iif(!Eof(), Recno(), 0) && save record number
|
||
|
||
LCSETDEL = Set("deleted")
|
||
&& lnmaxval = (10^pcidsize)-1 && wrap around after this val
|
||
|
||
***
|
||
&& PUN ORDINEA PE ID
|
||
If LLLOOKUP And LLTAG
|
||
Sele (TALIAS)
|
||
Set Order To &TTAG
|
||
Endif
|
||
***
|
||
LCNEWID = 0 && our return result - NULL if failed
|
||
Select IDS
|
||
Locate For Upper(Alltrim(TABEL)) = TALIAS
|
||
If !Found()
|
||
If Flock()
|
||
Append Blank
|
||
Replace TABEL With TALIAS
|
||
Unlock
|
||
Endif
|
||
|
||
Endif
|
||
|
||
Set Deleted Off
|
||
&& acum sunt pe inregistrarea corecta
|
||
|
||
|
||
*** lock counter table and update counter
|
||
Select IDS
|
||
If Rlock()
|
||
*** Avoid use of Macros - Convert to mem var & update it
|
||
LNCOUNTERVAL = NEW_ID
|
||
|
||
*** VERIFY ID NUMBER - search 'til no match
|
||
Do While .T.
|
||
*** increase the counter - update field and var
|
||
LNCOUNTERVAL = LNCOUNTERVAL + 1
|
||
|
||
*!* *** check for wraparound
|
||
*!* IF lncounterval > lnmaxval
|
||
*!* lncounterval = 1
|
||
*!* ENDIF
|
||
|
||
Select (TALIAS)
|
||
If LLLOOKUP
|
||
If LLTAG
|
||
LCAUT = "SEEK " + Allt(Str(LNCOUNTERVAL))
|
||
Else
|
||
LCAUT = "LOCATE FOR " + Allt(TFIELD) + "=" + Allt(Str(LNCOUNTERVAL))
|
||
*** now see if it exists
|
||
&LCAUT
|
||
* LOCATE FOR &TFIELD=LNCOUNTERVAL
|
||
If !Found()
|
||
*** No match - DONE
|
||
Exit
|
||
Endif && !found()
|
||
Endif && lltag
|
||
Else
|
||
Exit
|
||
Endif && lllokup
|
||
|
||
Enddo && done
|
||
|
||
Sele IDS
|
||
Replace NEW_ID With LNCOUNTERVAL
|
||
LCNEWID = LNCOUNTERVAL
|
||
|
||
Unlock In IDS
|
||
Endif && rlock()
|
||
|
||
*** Reset record number on original file
|
||
|
||
If !Empty(LCOLDALIAS)
|
||
Sele (LCOLDALIAS)
|
||
If LNOLDRECNO # 0
|
||
Goto LNOLDRECNO
|
||
Endif
|
||
Endif
|
||
Set Deleted &LCSETDEL
|
||
|
||
Return LCNEWID
|
||
|
||
Endproc && NEW_ID
|
||
|
||
|
||
***-------------------------------------------------------------------------------------------------------
|
||
|
||
* Foloseste comment de la coloane si tooltiptext de la grid pt a salva recordsource si controlsource din grid inainte de reconstructie
|
||
Procedure SAVE_GRID
|
||
Param toGrid
|
||
*wait wind 'save_grid'
|
||
Private pogrid
|
||
If Param() = 0 Or Type('togrid')!= "O"
|
||
Return .F.
|
||
Endif
|
||
|
||
pogrid = toGrid
|
||
|
||
* remember control sources in the column's comment field
|
||
With pogrid
|
||
Local nColumnIndex
|
||
For m.nColumnIndex = 1 To .ColumnCount
|
||
.Columns(m.nColumnIndex).Tag = .Columns(m.nColumnIndex).ControlSource
|
||
Endfor
|
||
.ToolTipText = .RecordSource
|
||
.RecordSource = ""
|
||
Endwith
|
||
|
||
Return .T.
|
||
Endproc && SAVE_GRID
|
||
***--------------------------------------------------------------
|
||
Procedure RESTORE_GRID
|
||
Param toGrid
|
||
|
||
*wait wind 'restore_grid'
|
||
Private pogrid
|
||
If Param() = 0 Or Type('togrid')!= "O"
|
||
Return .F.
|
||
Endif
|
||
|
||
pogrid = toGrid
|
||
|
||
|
||
With pogrid
|
||
* restore record source
|
||
.RecordSource = .ToolTipText
|
||
* restore control sources
|
||
For m.nColumnIndex = 1 To .ColumnCount
|
||
.Columns(m.nColumnIndex).ControlSource = .Columns(m.nColumnIndex).Tag
|
||
Endfor
|
||
.ToolTipText = ""
|
||
Endwith
|
||
Return .T.
|
||
Endproc && RESTORE_GRID
|
||
*******************************************************************
|
||
Procedure snr_grid && switch_and_restore_grid
|
||
Lparameters toGrid, tcRecordSourceNou
|
||
Private pogrid
|
||
If Param() = 0 Or Type('togrid')!= "O"
|
||
Return .F.
|
||
Endif
|
||
pogrid = toGrid
|
||
With pogrid
|
||
.RecordSource = Iif(Empty(tcRecordSourceNou), .ToolTipText, tcRecordSourceNou)
|
||
For m.nColumnIndex = 1 To .ColumnCount
|
||
.Columns(m.nColumnIndex).ControlSource = Iif(!Empty(tcRecordSourceNou) And !Empty(.Columns(m.nColumnIndex).Tag), ;
|
||
tcRecordSourceNou + [.] + Substr(.Columns(m.nColumnIndex).Tag, At([.], .Columns(m.nColumnIndex).Tag) + 1), ;
|
||
.Columns(m.nColumnIndex).Tag)
|
||
.Tag = ""
|
||
Endfor
|
||
.ToolTipText = ""
|
||
Endwith
|
||
Return .T.
|
||
Endproc && snr_grid
|
||
*******************************************************************
|
||
|
||
* Foloseste comment de la coloane si tooltiptext de la grid pt a salva recordsource si controlsource din grid inainte de reconstructie
|
||
Procedure SAVE_GRID_COMMENT
|
||
Param toGrid
|
||
*wait wind 'save_grid'
|
||
Private pogrid
|
||
If Param() = 0 Or Type('togrid')!= "O"
|
||
Return .F.
|
||
Endif
|
||
|
||
pogrid = toGrid
|
||
|
||
* remember control sources in the column's comment field
|
||
With pogrid
|
||
Local nColumnIndex
|
||
For m.nColumnIndex = 1 To .ColumnCount
|
||
.Columns(m.nColumnIndex).Comment = .Columns(m.nColumnIndex).ControlSource
|
||
Endfor
|
||
.ToolTipText = .RecordSource
|
||
.RecordSource = ""
|
||
Endwith
|
||
|
||
Return .T.
|
||
Endproc && SAVE_GRID_COMMENT
|
||
***--------------------------------------------------------------
|
||
Procedure RESTORE_GRID_COMMENT
|
||
Param toGrid
|
||
|
||
*wait wind 'restore_grid'
|
||
Private pogrid
|
||
If Param() = 0 Or Type('togrid')!= "O"
|
||
Return .F.
|
||
Endif
|
||
|
||
pogrid = toGrid
|
||
|
||
|
||
With pogrid
|
||
* restore record source
|
||
.RecordSource = .ToolTipText
|
||
* restore control sources
|
||
For m.nColumnIndex = 1 To .ColumnCount
|
||
.Columns(m.nColumnIndex).ControlSource = .Columns(m.nColumnIndex).Comment
|
||
Endfor
|
||
.ToolTipText = ""
|
||
Endwith
|
||
Return .T.
|
||
Endproc && RESTORE_GRID_COMMENT
|
||
|
||
|
||
* Foloseste comment de la coloane si tooltiptext de la grid pt a salva recordsource si controlsource din grid inainte de reconstructie
|
||
Procedure SAVE_GRID_TAG
|
||
Param toGrid
|
||
*wait wind 'save_grid'
|
||
Private pogrid
|
||
If Param() = 0 Or Type('togrid')!= "O"
|
||
Return .F.
|
||
Endif
|
||
|
||
pogrid = toGrid
|
||
|
||
* remember control sources in the column's comment field
|
||
With pogrid
|
||
Local nColumnIndex
|
||
For m.nColumnIndex = 1 To .ColumnCount
|
||
.Columns(m.nColumnIndex).Tag = .Columns(m.nColumnIndex).ControlSource
|
||
Endfor
|
||
.ToolTipText = .RecordSource
|
||
.RecordSource = ""
|
||
Endwith
|
||
|
||
Return .T.
|
||
Endproc && SAVE_GRID_TAG
|
||
***--------------------------------------------------------------
|
||
Procedure RESTORE_GRID_TAG
|
||
Param toGrid
|
||
|
||
*wait wind 'restore_grid'
|
||
Private pogrid
|
||
If Param() = 0 Or Type('togrid')!= "O"
|
||
Return .F.
|
||
Endif
|
||
|
||
pogrid = toGrid
|
||
|
||
|
||
With pogrid
|
||
* restore record source
|
||
.RecordSource = .ToolTipText
|
||
* restore control sources
|
||
For m.nColumnIndex = 1 To .ColumnCount
|
||
.Columns(m.nColumnIndex).ControlSource = .Columns(m.nColumnIndex).Tag
|
||
Endfor
|
||
.ToolTipText = ""
|
||
Endwith
|
||
Return .T.
|
||
Endproc && RESTORE_GRID_TAG
|
||
|
||
|
||
*-------------------------------------------
|
||
* Function...: Xmenu
|
||
* Author.....: MARTIN
|
||
* Date.......: 04/06/1997
|
||
* Notes......: Based on an idea from Steve Zimmelman for FoxPro 2.x
|
||
* Parameters.: tcItems = Semicolon-separated String with the various options
|
||
* ...........: tnBar = Initially selected item (default=1)
|
||
* Returns....: Selected item number
|
||
* See Also...: PROMPT() [FoxPro Native]
|
||
*
|
||
Procedure XMENU
|
||
Lparameters TCITEMS, TNBAR
|
||
|
||
Local NITEMCOUNT, AITEMS, X, NROW, NCOL, CTITLE, NLASTPOS, CCOLOR, AITEMS
|
||
|
||
Private CPOPMENU, NSELECT && They flow into the GetChoice internal procedure
|
||
|
||
If Pcount() < 2
|
||
TNBAR = 1
|
||
Endif
|
||
|
||
Activate Screen
|
||
|
||
* Parse every item
|
||
*
|
||
m.NITEMCOUNT = Occurs( ';', TCITEMS ) + 1
|
||
Dimen AITEMS[ m.nItemCount ]
|
||
m.NLASTPOS = 1
|
||
|
||
For m.X = 1 To m.NITEMCOUNT
|
||
|
||
If m.X < m.NITEMCOUNT
|
||
|
||
AITEMS[ m.x ] = Subs( m.TCITEMS, m.NLASTPOS, ;
|
||
( At( ';', m.TCITEMS, m.X ) - 1 ) - m.NLASTPOS + 1 )
|
||
Else
|
||
AITEMS[ m.x ] = Subs( m.TCITEMS, m.NLASTPOS, ;
|
||
( Len( m.TCITEMS ) - m.NLASTPOS ) + 1 )
|
||
Endif
|
||
|
||
If AITEMS[ m.x ] # "\-"
|
||
|
||
AITEMS[ m.x ] = Allt( AITEMS[ m.x ] )
|
||
Endif
|
||
|
||
m.NLASTPOS = At( ';', m.TCITEMS, m.X ) + 1
|
||
Next
|
||
|
||
* Calculates the mouse pointer position
|
||
*
|
||
m.NROW = Iif( Mrow() + m.NITEMCOUNT < Srow(), Mrow() - 1, Srow() - m.NITEMCOUNT )
|
||
m.NCOL = Iif( Mcol() + 10 < Scol(), Mcol() - 3, Mcol() - 13 )
|
||
|
||
* Gets an unique name for the pop-up
|
||
*
|
||
m.CPOPMENU = 'M' + Sys(3) + "_"
|
||
|
||
Define Popup ( m.CPOPMENU ) SHORTCUT Relative From NROW, NCOL
|
||
|
||
For m.X = 1 To m.NITEMCOUNT
|
||
|
||
Define Bar m.X Of ( m.CPOPMENU ) Prompt AITEMS[ m.x ]
|
||
Next
|
||
|
||
m.CANS = ""
|
||
m.NSELECT = 0
|
||
Clear Type
|
||
|
||
On Selection Popup ( m.CPOPMENU ) Do GETCHOICE
|
||
|
||
Activate Popup ( m.CPOPMENU ) Bar TNBAR
|
||
|
||
Pop Key
|
||
Release Popup ( m.CPOPMENU )
|
||
|
||
Return Iif( Lastkey() = 27, 0, m.NSELECT )
|
||
|
||
Endproc && XMENU
|
||
|
||
|
||
|
||
********************
|
||
*** MENIU POPUP CREAT DINAMIC
|
||
********************
|
||
PROCEDURE XMENUP
|
||
LPARAMETERS TCITEMS, TNBAR
|
||
|
||
LOCAL NITEMCOUNT, AITEMS, X
|
||
LOCAL loMenu, lnOption
|
||
lnOption = 0
|
||
loMenu = NEWOBJECT("popmenu", "menutool.vcx")
|
||
|
||
NITEMCOUNT = OCCURS( ';', TCITEMS ) + 1
|
||
DIMEN AITEMS[ m.nItemCount ]
|
||
NLASTPOS = 1
|
||
|
||
FOR X = 1 TO m.NITEMCOUNT
|
||
|
||
IF m.X < m.NITEMCOUNT
|
||
|
||
AITEMS[ m.x ] = SUBS( m.TCITEMS, m.NLASTPOS, ;
|
||
( AT( ';', m.TCITEMS, m.X ) - 1 ) - m.NLASTPOS + 1 )
|
||
ELSE
|
||
AITEMS[ m.x ] = SUBS( m.TCITEMS, m.NLASTPOS, ;
|
||
( LEN( m.TCITEMS ) - m.NLASTPOS ) + 1 )
|
||
ENDIF
|
||
|
||
IF AITEMS[ m.x ] # "\-"
|
||
|
||
AITEMS[ m.x ] = ALLT( AITEMS[ m.x ] )
|
||
ENDIF
|
||
|
||
NLASTPOS = AT( ';', m.TCITEMS, m.X ) + 1
|
||
loMenu.ADDITEM(AITEMS[ m.x ], X, 1)
|
||
ENDFOR
|
||
lnOption = loMenu.SHOW()
|
||
RETURN m.lnOption
|
||
ENDPROC && XMENUP
|
||
|
||
*--------------------
|
||
Procedure GETCHOICE
|
||
|
||
m.NSELECT = Bar()
|
||
|
||
Deactivate Popup ( m.CPOPMENU )
|
||
|
||
Return
|
||
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& MENIU &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
|
||
|
||
Procedure lista2array
|
||
Parameters tcLISTA, taArray, tcSeparator
|
||
&& tcLista este un sir de caractere care contine elementele separate prin <;> default
|
||
&& tarray este vectorul care se completeaza - trebuie dat prin referinta
|
||
&& tcSeparator separatorul de elemente din tcLista - default este ";" - este optional
|
||
&& intoarce numarul de elemente gasite
|
||
|
||
&& ex: lnNr = lista2array("ana;are;mere",@alista,";")
|
||
External Array taArray
|
||
Local lcLista, lcSeparator, lnNRF, lcF1, i
|
||
|
||
lnNRF = 0
|
||
|
||
lcLista = Allt(tcLISTA)
|
||
If Parameters() < 3 Or Empty(tcSeparator)
|
||
lcSeparator = ";"
|
||
Else
|
||
lcSeparator = Alltrim(tcSeparator)
|
||
Endif
|
||
|
||
If Right(lcLista, 1)!= lcSeparator
|
||
lcLista = lcLista + lcSeparator
|
||
Endif
|
||
|
||
lnNRF = Occurs(lcSeparator, lcLista)
|
||
|
||
If lnNRF > 0
|
||
Dimension taArray[lnNrf, 1]
|
||
|
||
For i = 1 To lnNRF
|
||
lcF1 = Left(lcLista, At(lcSeparator, lcLista) - 1)
|
||
|
||
If i!= lnNRF
|
||
lcLista = Substr(lcLista, At(lcSeparator, lcLista) + 1)
|
||
Endif
|
||
|
||
taArray[i] = lcF1
|
||
Endfor
|
||
Else
|
||
lnNRF = 0
|
||
Endif
|
||
|
||
Return lnNRF
|
||
|
||
Endproc && lista2array
|
||
|
||
|
||
***-------------------------------------------------------------------------------------------
|
||
Procedure get_mask
|
||
Parameters tnint, tndec
|
||
|
||
Local lnint, lndec
|
||
lnint = tnint
|
||
lndec = tndec
|
||
lnrest = Mod(lnint, 3)
|
||
|
||
lcString = Replicate("9", lnrest)
|
||
lnint_ramas = lnint - lnrest
|
||
Do While lnint_ramas > 0
|
||
lcString = lcString + " " + Replicate("9", 3)
|
||
lnint_ramas = lnint_ramas - 3
|
||
Enddo
|
||
If lndec > 0
|
||
lcString = lcString + "." + Replicate("9", tndec)
|
||
Endif
|
||
|
||
Return lcString
|
||
|
||
Endproc && get_mask
|
||
*******************************************************************
|
||
Function formateaza
|
||
Parameters tnValoare, tnNrCaractere, tnNrZecimale
|
||
Local lcValoare
|
||
lcValoare = Strtran(Alltrim(Transform(tnValoare, get_mask(tnNrCaractere, tnNrZecimale))), [.], [,])
|
||
Return lcValoare
|
||
Endfunc && formateaza
|
||
*******************************************************************
|
||
Function tradu
|
||
Lparameters tcText
|
||
Local lcText
|
||
*!* lcText = CPCONVERT(CPCURRENT(1),1252,tcText)
|
||
lcText = tcText
|
||
If Type('glFontCharSet') <> 'U'
|
||
If !Nvl(glFontCharSet, .F.)
|
||
lcText = Strtran(Strtran(Strtran(Strtran(Strtran(lcText, Chr(227), [a]), Chr(238), [i]), Chr(226), [a]), Chr(186), [s]), Chr(254), [t])
|
||
lcText = Strtran(Strtran(Strtran(Strtran(Strtran(lcText, Chr(195), [A]), Chr(206), [I]), Chr(194), [A]), Chr(170), [S]), Chr(222), [T])
|
||
Endif
|
||
Endif
|
||
Return lcText
|
||
Endfunc
|
||
*******************************************************************
|
||
* PROCEDURE Get_Version( )
|
||
* Date : 17/11/2004, 16:34:20
|
||
* author : marius.mutu
|
||
* description:
|
||
|
||
****** PARAMETER BLOCK **************
|
||
* Parameters : 0
|
||
*
|
||
******************************************* INCEPUT:Get_Version *******************************************
|
||
Procedure Get_Version(tlNoRevision, tlInfo, tcfilename)
|
||
Local laVersion, lcVersion, lcFileName
|
||
|
||
*-- Get Version Information
|
||
*-- Added 4-1-98 BDC
|
||
Local lcVersionText, lcFileName, llNoRevision, llInfo
|
||
|
||
Dimension aVersion(12)
|
||
|
||
If Empty(tcfilename)
|
||
lcFileName = Sys(16, 0)
|
||
Else
|
||
lcFileName = tcfilename
|
||
Endif
|
||
llNoRevision = tlNoRevision
|
||
llInfo = tlInfo
|
||
|
||
|
||
|
||
*** EGL: 2002.1.2 17:06 - switched to AGETFILEVERSION().
|
||
If Val(Substr(Version(), 15)) >= 6
|
||
* The AGETFILEVERSION() function was introduced in VFP 6
|
||
|
||
*!* DECLARE STRING GetCommandLine IN Kernel32
|
||
*!* lcFileName = GetCommandLine()
|
||
lcVersionText = ""
|
||
|
||
*!* IF GetFileVersion(&lcFileName,@aVersion) = 0
|
||
If Agetfileversion(aVersion, lcFileName) > 0
|
||
If !llInfo
|
||
* daca vreau doar numarul versiunii
|
||
lcVersion = Allt(aVersion(4))
|
||
If llNoRevision
|
||
* daca nu vreau si revizia
|
||
lnPos = Rat('.', lcVersion, 1)
|
||
Else
|
||
lnPos = Len(lcVersion)
|
||
Endif
|
||
lcVersionText = Left(lcVersion, lnPos)
|
||
Else
|
||
* vreau toata informatia despre fisier
|
||
If Not Empty(aVersion(1))
|
||
lcVersionText = Allt(aVersion(1))
|
||
Endif
|
||
|
||
If Not Empty(aVersion(2))
|
||
lcVersionText = lcVersionText + Chr(10) + "Produs de: " + Allt(aVersion(2))
|
||
Endif
|
||
|
||
If Not Empty(aVersion(3))
|
||
lcVersionText = lcVersionText + Chr(10) + "Descriere: " + Allt(aVersion(3))
|
||
Endif
|
||
|
||
If Not Empty(aVersion(4))
|
||
lcVersionText = lcVersionText + Chr(10) + "Versiune fisier: " + Allt(aVersion(4))
|
||
Endif
|
||
|
||
If Not Empty(aVersion(5))
|
||
lcVersionText = lcVersionText + Chr(10) + "Nume intern: " + Allt(aVersion(5))
|
||
Endif
|
||
|
||
If Not Empty(aVersion(6))
|
||
lcVersionText = lcVersionText + Chr(10) + "Copyright: " + Allt(aVersion(6))
|
||
Endif
|
||
|
||
If Not Empty(aVersion(7))
|
||
lcVersionText = lcVersionText + Chr(10) + "Marca inregistrata: " + Allt(aVersion(7))
|
||
Endif
|
||
|
||
If Not Empty(aVersion(8))
|
||
lcVersionText = lcVersionText + Chr(10) + "Nume fisier: " + Allt(aVersion(8))
|
||
Endif
|
||
|
||
If Not Empty(aVersion(9))
|
||
lcVersionText = lcVersionText + Chr(10) + "Private Build: " + Allt(aVersion(9))
|
||
Endif
|
||
|
||
If Not Empty(aVersion(10))
|
||
lcVersionText = lcVersionText + Chr(10) + "Nume produs: " + Allt(aVersion(10))
|
||
Endif
|
||
|
||
If Not Empty(aVersion(11))
|
||
lcVersionText = lcVersionText + Chr(10) + "Versiune produs: " + Allt(aVersion(11))
|
||
Endif
|
||
|
||
If Not Empty(aVersion(12))
|
||
lcVersionText = lcVersionText + Chr(10) + "Special Build: " + Allt(aVersion(12))
|
||
Endif
|
||
|
||
If Empty(lcVersionText)
|
||
lcVersionText = ""
|
||
Endif
|
||
Endif
|
||
Else
|
||
|
||
lcVersionText = ""
|
||
|
||
Endif
|
||
|
||
Else
|
||
lcVersionText = ""
|
||
Endif
|
||
Return lcVersionText
|
||
|
||
Endproc
|
||
******************************************* SFARSIT: Get_Version *******************************************
|
||
|
||
|
||
* PROCEDURE Get_Hexa( tnDeca )
|
||
* Date : 18/11/2004, 17:56:48
|
||
* author : marius.mutu
|
||
* description: transforma un Deca in Hexa
|
||
|
||
****** PARAMETER BLOCK **************
|
||
* Parameters : 1
|
||
* Parameter 1: Numarul in Deca
|
||
*
|
||
******************************************* INCEPUT:Get_Hexa *******************************************
|
||
Procedure Get_Hexa( tnDeca )
|
||
Local laHexa, lnHexa, lnDeca
|
||
|
||
|
||
If Empty(tnDeca)
|
||
lnDeca = 0
|
||
Else
|
||
lnDeca = tnDeca
|
||
Endif
|
||
|
||
Dimension laHexa[16]
|
||
laHexa[1] = '0'
|
||
laHexa[2] = '1'
|
||
laHexa[3] = '2'
|
||
laHexa[4] = '3'
|
||
laHexa[5] = '4'
|
||
laHexa[6] = '5'
|
||
laHexa[7] = '6'
|
||
laHexa[8] = '7'
|
||
laHexa[9] = '8'
|
||
laHexa[10] = '9'
|
||
laHexa[11] = 'A'
|
||
laHexa[12] = 'B'
|
||
laHexa[13] = 'C'
|
||
laHexa[14] = 'D'
|
||
laHexa[15] = 'E'
|
||
laHexa[16] = 'F'
|
||
|
||
lnHexa = ''
|
||
|
||
Do While lnDeca > 0
|
||
lnrest = Mod(lnDeca, 16)
|
||
lcHexa = laHexa[lnRest + 1]
|
||
lnDeca = Int(lnDeca / 16)
|
||
|
||
lnHexa = lcHexa + lnHexa
|
||
lnrest = Mod(lnDeca, 16)
|
||
|
||
Enddo
|
||
|
||
Return lnHexa
|
||
|
||
Endproc
|
||
******************************************* SFARSIT: Get_Hexa *******************************************
|
||
&& completeaza cu spatii si CRLF un mesaj a.i. pe fiecare linie sa fie lnLength caractere
|
||
Function format_msg
|
||
Parameters tcErrMsg, tnLength
|
||
Local lnLength, lcLinie, lcMesaj, lnPoz, lnCate, i, j
|
||
lcMesaj = ""
|
||
If Empty(tnLength)
|
||
lnLength = 50 && numarul de caractere pe linie
|
||
Else
|
||
lnLength = tnLength
|
||
Endif
|
||
i = 1
|
||
If At(Chr(13) + Chr(10), tcErrMsg, i) > 0
|
||
lnCate = At(Chr(13) + Chr(10), tcErrMsg, i) + 1
|
||
i = i + 1
|
||
Else
|
||
lnCate = Min(lnLength, Rat(' ', Substr(tcErrMsg, 1, lnLength)) - 1)
|
||
Endif
|
||
lnPoz = 1
|
||
*!* lcLinie=Substr(tcErrMsg,1,lnCate)
|
||
|
||
Do While lnPoz < Len(tcErrMsg)
|
||
lcLinie = Substr(tcErrMsg, lnPoz, lnCate)
|
||
|
||
If Right(lcLinie, 2) = Chr(13) + Chr(10)
|
||
lcLinie = Alltrim(Substr(lcLinie, 1, Len(lcLinie) - 2))
|
||
Else
|
||
lcLinie = Alltrim(lcLinie)
|
||
Endif
|
||
|
||
j = Int((lnLength - Len(lcLinie)) / 2)
|
||
lcLinie = Iif(!Empty(lcLinie), Space(j) + lcLinie + Space(j), "")
|
||
lcMesaj = lcMesaj + lcLinie + Chr(13) + Chr(10)
|
||
|
||
lnPoz = lnPoz + lnCate
|
||
|
||
If At(Chr(13) + Chr(10), tcErrMsg, i) > 0
|
||
lnCate = At(Chr(13) + Chr(10), tcErrMsg, i) + 2 - lnPoz
|
||
i = i + 1
|
||
Else
|
||
lcNextChar = Substr(tcErrMsg, lnPoz + lnLength, 1)
|
||
lcLinieNoua = Substr(tcErrMsg, lnPoz, lnLength)
|
||
If lcNextChar!= ' ' And Len(lcLinieNoua) >= lnLength
|
||
lnCate = Min(lnLength, Rat(' ', lcLinieNoua) - 1)
|
||
Else
|
||
lnCate = lnLength
|
||
Endif
|
||
Endif
|
||
Enddo
|
||
Return lcMesaj
|
||
Endfunc && format_msg
|
||
***---------------------------------------------------------------------------------------------
|
||
Procedure C_LUNA
|
||
Parameters tnnrluna
|
||
Do Case
|
||
Case tnnrluna = 1
|
||
Return "IANUARIE"
|
||
Case tnnrluna = 2
|
||
Return "FEBRUARIE"
|
||
Case tnnrluna = 3
|
||
Return "MARTIE"
|
||
Case tnnrluna = 4
|
||
Return "APRILIE"
|
||
Case tnnrluna = 5
|
||
Return "MAI"
|
||
Case tnnrluna = 6
|
||
Return "IUNIE"
|
||
Case tnnrluna = 7
|
||
Return "IULIE"
|
||
Case tnnrluna = 8
|
||
Return "AUGUST"
|
||
Case tnnrluna = 9
|
||
Return "SEPTEMBRIE"
|
||
Case tnnrluna = 10
|
||
Return "OCTOMBRIE"
|
||
Case tnnrluna = 11
|
||
Return "NOIEMBRIE"
|
||
Case tnnrluna = 12
|
||
Return "DECEMBRIE"
|
||
Otherwise
|
||
Return ""
|
||
Endcase
|
||
Endproc &&c_luna
|
||
***--------------------------------------------------------------------------------------
|
||
***--------------------------------------------------------------------------------------
|
||
Procedure CLUNA3
|
||
Parameters tnnrluna
|
||
Do Case
|
||
Case tnnrluna = 1
|
||
Return "Ian"
|
||
Case tnnrluna = 2
|
||
Return "Feb"
|
||
Case tnnrluna = 3
|
||
Return "Mar"
|
||
Case tnnrluna = 4
|
||
Return "Apr"
|
||
Case tnnrluna = 5
|
||
Return "Mai"
|
||
Case tnnrluna = 6
|
||
Return "Iun"
|
||
Case tnnrluna = 7
|
||
Return "Iul"
|
||
Case tnnrluna = 8
|
||
Return "Aug"
|
||
Case tnnrluna = 9
|
||
Return "Sep"
|
||
Case tnnrluna = 10
|
||
Return "Oct"
|
||
Case tnnrluna = 11
|
||
Return "Noi"
|
||
Case tnnrluna = 12
|
||
Return "Dec"
|
||
Otherwise
|
||
Return Space(3)
|
||
Endcase
|
||
Endproc &&cluna3
|
||
***--------------------------------------------------------------------------------------
|
||
***------------------------------------------------------------------------------------
|
||
Procedure cluna
|
||
Parameters tcGrup, tcTipCumul, tcAn
|
||
|
||
lcTipCumul = Upper(Alltrim(tcTipCumul))
|
||
lcAn = Alltrim(tcAn)
|
||
lcgrup = Alltrim(tcGrup)
|
||
lnGrup = Val(lcgrup)
|
||
Do Case
|
||
Case lcTipCumul = "T"
|
||
lcret = "Trim. " + lcgrup + " " + lcAn
|
||
Case lcTipCumul = "S"
|
||
lcret = "Sem. " + lcgrup + " " + lcAn
|
||
Case lcTipCumul = "A"
|
||
lcret = "Anul " + lcAn
|
||
Otherwise
|
||
Do Case
|
||
Case lnGrup = 1
|
||
lcret = "Ian " + lcAn
|
||
Case lnGrup = 2
|
||
lcret = "Feb " + lcAn
|
||
Case lnGrup = 3
|
||
lcret = "Mar " + lcAn
|
||
Case lnGrup = 4
|
||
lcret = "Apr " + lcAn
|
||
Case lnGrup = 5
|
||
lcret = "Mai " + lcAn
|
||
Case lnGrup = 6
|
||
lcret = "Iun " + lcAn
|
||
Case lnGrup = 7
|
||
lcret = "Iul " + lcAn
|
||
Case lnGrup = 8
|
||
lcret = "Aug " + lcAn
|
||
Case lnGrup = 9
|
||
lcret = "Sep " + lcAn
|
||
Case lnGrup = 10
|
||
lcret = "Oct " + lcAn
|
||
Case lnGrup = 11
|
||
lcret = "Noi " + lcAn
|
||
Case lnGrup = 12
|
||
lcret = "Dec " + lcAn
|
||
Otherwise
|
||
lcret = lcAn
|
||
Endcase
|
||
Endcase
|
||
Return lcret
|
||
Endproc &&cluna
|
||
***------------------------------------------------------------------------------------
|
||
***------------------------------------------------------------------------------------
|
||
Procedure get_trimestru
|
||
Parameters tnNrTrim
|
||
Do Case
|
||
Case tnNrTrim = 1
|
||
Return "Trim. I"
|
||
Case tnNrTrim = 2
|
||
Return "Trim. II"
|
||
Case tnNrTrim = 3
|
||
Return "Trim. III"
|
||
Case tnNrTrim = 4
|
||
Return "Trim. IV"
|
||
Otherwise
|
||
Return Space(7)
|
||
Endcase
|
||
Endproc && get_trimestru
|
||
***--------------------------------------------------------------------------------------
|
||
Procedure get_semestru
|
||
Parameters tnNrSem
|
||
Do Case
|
||
Case tnNrSem = 1
|
||
Return "Sem. I"
|
||
Case tnNrSem = 2
|
||
Return "Sem. II"
|
||
Otherwise
|
||
Return Space(7)
|
||
Endcase
|
||
Endproc && get_semestru
|
||
***--------------------------------------------------------------------------------------
|
||
Function Lista_Campuri
|
||
Lparameters tcAlias
|
||
|
||
Local lcSelect, i, lcAlias, lcLista
|
||
lcLista = []
|
||
lcSelect = Select()
|
||
lcAlias = tcAlias
|
||
|
||
Select (lcAlias)
|
||
lnFields = Fcount()
|
||
For i = 1 To lnFields
|
||
lcField = Field(i)
|
||
lcLista = lcLista + [,] + lcField
|
||
Endfor
|
||
If !Empty(lcLista)
|
||
lcLista = Substr(lcLista, 2)
|
||
Endif
|
||
|
||
Select (lcSelect)
|
||
Return lcLista
|
||
|
||
Endfunc && Lista_Campuri
|
||
***----------------------------------------
|
||
|
||
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
|
||
**********************
|
||
|
||
***----------------------------------------
|
||
Function caps_first
|
||
Lparameters tcMesaj
|
||
Local lcMesaj
|
||
If !Empty(tcMesaj) And Len(tcMesaj) > 1
|
||
lcMesaj = Upper(Substr(tcMesaj, 1, 1)) + Strtran(Lower(Substr(tcMesaj, 2)), [oracle], [Oracle])
|
||
Else
|
||
lcMesaj = Upper(tcMesaj)
|
||
Endif
|
||
Return lcMesaj
|
||
Endfunc && caps_first
|
||
***----------------------------------------
|
||
|
||
*!* FUNCTION ultima_zi_din_luna
|
||
*!* PARAMETERS tcAnul, tcLuna
|
||
*!*
|
||
*!* LOCAL ldData
|
||
*!* ldData = DATE(VAL(tcAnul),VAL(tcLuna), 1)
|
||
*!* ldData = GOMONTH(ldData,1)
|
||
*!* ldData = DATE(YEAR(ldData),MONTH(ldData), 1) - 1
|
||
*!* RETURN ldData
|
||
*!* ENDFUNC
|
||
|
||
Function ultima_zi_din_luna
|
||
Parameters tcAnul, tcLuna
|
||
|
||
Local ldData, lcAnul, lcLuna
|
||
|
||
If Type('tcAnul') = 'N'
|
||
lcAnul = Transform(tcAnul)
|
||
Else
|
||
lcAnul = tcAnul
|
||
Endif
|
||
If Type('tcLuna') = 'N'
|
||
lcLuna = Transform(tcLuna)
|
||
Else
|
||
lcLuna = tcLuna
|
||
Endif
|
||
|
||
ldData = Date(Val(lcAnul), Val(lcLuna), 1)
|
||
ldData = Gomonth(ldData, 1)
|
||
ldData = Date(Year(ldData), Month(ldData), 1) - 1
|
||
Return ldData
|
||
Endfunc
|
||
|
||
|
||
|
||
******************************************************************************
|
||
|
||
Procedure viz_prg_instalat
|
||
If Used('v_programe_instalate')
|
||
Use In v_programe_instalate
|
||
Endif
|
||
*!* lcSql = [select * from vdef_util_programe where id_util=]+Alltrim(Str(gnIdUtil))+;
|
||
*!* [ order by ordine]
|
||
lcSql = [{call contafin_oracle.pack_drepturi.programe_utilizator(] + Alltrim(Str(gnIdUtil)) + [)}]
|
||
lcCursor = [v_programe_instalate]
|
||
lnSucces = goExecutor.oExecute(lcSql, lcCursor)
|
||
goExecutor.Oreset()
|
||
|
||
Endproc
|
||
******************************************************************************
|
||
Procedure lansare_toolbar
|
||
|
||
Do viz_prg_instalat In oproceduri_comune.prg
|
||
|
||
If Used('v_programe_instalate') And Reccount('v_programe_instalate') > 0
|
||
|
||
|
||
If Used('v_programe_favorite')
|
||
Use In v_programe_favorite
|
||
Endif
|
||
Select * From v_programe_instalate Where favorit = 1 And Upper(Alltrim(nume)) <> Iif(Type('gcNumeProgram') = 'U', '<>', gcNumeProgram) ;
|
||
Order By ordine_favorit Into Cursor v_programe_favorite
|
||
If Reccount('v_programe_favorite') > 0
|
||
otool = Createobject('toolset')
|
||
With otool.tool1
|
||
Local i
|
||
i = 0
|
||
Select v_programe_favorite
|
||
Scan
|
||
i = i + 1
|
||
*!* modificare 15.10.2007
|
||
*!* If Type('gcappname')='C'
|
||
*!* If gcappname=Upper(Alltrim(nume))
|
||
*!* Loop
|
||
*!* Endif
|
||
*!* Endif
|
||
*!* modificare 15.10.2007 ^
|
||
|
||
lnParametru_prog = parametru_prog && pt. programul de Contracte - clienti si furnizori
|
||
lcParametru_prog = Alltrim(Str(Nvl(lnParametru_prog, 0)))
|
||
|
||
lnIdProgram = id_program
|
||
lcIdProgram = Alltrim(Str(lnIdProgram))
|
||
lcNumeProgram = Proper(Alltrim(explicatie))
|
||
|
||
lcImagine = Upper(Alltrim(nume)) + ".png" &&nume poza
|
||
|
||
lcCaleImagine = gcappPath + 'grafice\' + lcImagine &&cale imagine
|
||
If !File(lcCaleImagine)
|
||
lcImagine = 'na.png'
|
||
lcCaleImagine = gcappPath + 'grafice\na.png'
|
||
Endif
|
||
lnIdGrupProg = id_grup_prog
|
||
lnIdGrupProgFav = 0
|
||
If Like([*.htm], Lower(Alltrim(nume))) Or Like([*.html], Lower(Alltrim(nume)))
|
||
lcComandaProgram = dirgen + Iif(Empty(Director), Alltrim(nume), Alltrim(Director)) + [\] + ;
|
||
Alltrim(nume)
|
||
Else
|
||
lcCaleProgram = dirgen + Iif(Empty(Director), Juststem(nume), Alltrim(Director)) + [\] + ; &&cale program
|
||
Juststem(Alltrim(nume)) + [.exe]
|
||
lcParametru = gcHost + [;] + gcuserName + [;] + gcPassword + [;] + Alltrim(Str(gnIdUtil)) + [;] + ;
|
||
lcIdProgram + [;] + lcParametru_prog + [;] &¶metri
|
||
lcComandaProgram = [run /n ] + lcCaleProgram + [ ] + lcParametru
|
||
Endif
|
||
|
||
|
||
lcImgNume = "img_" + lcIdProgram + "_" + lcParametru_prog
|
||
|
||
If lnIdProgram > 0
|
||
.AddObject(lcImgNume, 'img_program')
|
||
.&lcImgNume..comanda_program = lcComandaProgram &&adaug poza
|
||
.&lcImgNume..Picture = lcImagine
|
||
.&lcImgNume..ToolTipText = lcNumeProgram
|
||
.&lcImgNume..Visible = .T.
|
||
Endif
|
||
|
||
Endscan
|
||
.Dock(0)
|
||
.Show
|
||
Endwith
|
||
Endif
|
||
Endif
|
||
|
||
If Used('v_programe_instalate')
|
||
Use In v_programe_instalate
|
||
Endif
|
||
|
||
If Used('v_programe_favorite')
|
||
Use In v_programe_favorite
|
||
Endif
|
||
|
||
Endproc
|
||
***---------------------------------------------------------------------------------------------------------------------------------------
|
||
***---------------------------------------------------------------------------------------------------------------------------------------
|
||
Procedure ceretitlu_rap
|
||
Parameters tcMesaj, tctitlu
|
||
|
||
Local lcTitlu
|
||
lcTitlu = tctitlu
|
||
obj1 = Createobject("frm_cere_titlu")
|
||
obj1.clb_tx_simplu1.lb_simplu1.Caption = tcMesaj
|
||
obj1.clb_tx_simplu1.text_simplu1.ControlSource = 'lctitlu'
|
||
obj1.Show(1)
|
||
Return lcTitlu
|
||
|
||
Endproc
|
||
***---------------------------------------------------------------------------------------------------------------------------------------
|
||
Procedure cursor2lista
|
||
Lparameters tcCursor, tcColumn, tcSeparator, tcFilter
|
||
&& tcCursor - cursor
|
||
&& tcColumn - coloana din cursor care va constitui lista
|
||
&& tcSeparator separatorul de elemente din tcLista - default este ";" - este optional
|
||
&& tcFilter - optional = filtru pentru tabel
|
||
&& intoarce lista de valori separate prin separatori
|
||
&& ex: lcLista = cursor2lista("cursor","id",";")
|
||
|
||
Local lcLista, lcSeparator, lcSelect, lcFilter
|
||
|
||
lcLista = ""
|
||
lcSeparator = Iif(!Empty(tcSeparator) And Type('tcSeparator') = 'C', tcSeparator, ";")
|
||
lcFilter = Iif(Empty(m.tcFilter), '.T.', m.tcFilter)
|
||
If Used(tcCursor)
|
||
lcSelect = Select()
|
||
lcColumn = tcCursor + "." + tcColumn
|
||
If Type(lcColumn) # 'U'
|
||
Select * From (tcCursor) Into Cursor crsListaTemp
|
||
|
||
Select crsListaTemp
|
||
Scan For &lcFilter
|
||
lcLista = lcLista + Alltrim(Transform(Evaluate(tcColumn))) + lcSeparator
|
||
Endscan
|
||
Use In crsListaTemp
|
||
|
||
If !Empty(lcLista)
|
||
lcLista = Left(lcLista, Len(lcLista) - 1)
|
||
Endif
|
||
Endif
|
||
|
||
|
||
Select (lcSelect)
|
||
Endif
|
||
|
||
Return lcLista
|
||
|
||
Endproc && cursor2lista
|
||
|
||
***-------------------------------------------------------------------------------------------
|
||
***-------------------------------------------------------------------------------------------
|
||
Procedure GETCALLSTACK
|
||
Local nPos
|
||
nPos = Program(-1) - 2
|
||
|
||
|
||
Local cCallStack, i
|
||
cCallStack = ""
|
||
For i = nPos To 1 Step - 1
|
||
cCallStack = cCallStack + Program(i) + Chr(13) + Chr(10)
|
||
Endfor
|
||
|
||
|
||
Return cCallStack
|
||
|
||
Endproc && GETCALLSTACK
|
||
***-------------------------------------------------------------------------------------------
|
||
&& -------------------------- INCEPUT verific_cont ------------------------------
|
||
Procedure verific_cont
|
||
Parameters tcCont, tlNoMessage
|
||
|
||
Private pcCont
|
||
pcCont = Alltrim(tcCont)
|
||
|
||
&& verificare contului cu Planul de Conturi
|
||
lcSel = [SELECT cont from ] + GCS + [.vplcont_sintetic WHERE TRIM(cont) = ?pcCont and an = ?gnAn ]
|
||
lcCursor = 'crs_verific'
|
||
lnSucces = goExecutor.oExecute(lcSel, lcCursor)
|
||
If lnSucces < 0
|
||
amessagebox(goExecutor.cEroare, 0 + 16, "Eroare")
|
||
Endif
|
||
|
||
If lnSucces > 0
|
||
If Reccount('crs_verific') = 0
|
||
lnSucces = -1
|
||
Endif
|
||
Endif
|
||
|
||
If lnSucces < 0 And !tlNoMessage
|
||
amessagebox('Acest cont nu este definit in planul de conturi!', 0 + 48, 'Atentie')
|
||
Endif
|
||
|
||
Return lnSucces
|
||
|
||
Endproc
|
||
|
||
&& -------------------------- SFARSIT verific_cont ------------------------------
|
||
|
||
* ===================== GetHash ====================================
|
||
* INTOARCE UN OBIECT DE TIP HASH CREAT DIN tcPropertyValueList
|
||
*!* loHash = GetHash([cselect=>select id, name from test??cwhere=>id=pnId??corder=>name])
|
||
*!* lnMembers = AMEMBERS(laMembers, loHash)
|
||
*!* FOR i = 1 TO lnMembers
|
||
*!* MESSAGEBOX(loHash.&laMembers(i))
|
||
*!* ENDFOR
|
||
* ==================================================================
|
||
Function GetHash
|
||
Lparameters tcPropertyValueList
|
||
|
||
Local loHash
|
||
|
||
loHash = Createobject("MyHash", tcPropertyValueList)
|
||
Return loHash
|
||
|
||
Endfunc
|
||
|
||
|
||
* ===================== MyHash ====================================
|
||
* OBIECT EMULARE HASH
|
||
* loHash = GetHash([cselect=>select id, name from test??cwhere=>id=pnId??corder=>name])
|
||
* ==================================================================
|
||
Define Class MyHash As Custom
|
||
|
||
|
||
Procedure ReadMe
|
||
If .F.
|
||
Local loHash
|
||
loHash = Createobject("MyHash", [cselect=>select id, name from test??cwhere=>id=pnId??corder=>name])
|
||
Endif
|
||
Endproc && readme
|
||
|
||
*!* sir "proprietate1=>valoare1??proprietate2=>valoare2"
|
||
*!* genereaza proprietati si valori din sirul initial
|
||
Procedure Init
|
||
Lparameters tcPropertyValueList
|
||
|
||
Local i, lnProperties, lcPropertyValue, lcValue, luValue
|
||
|
||
&& tcPropertyValueList = [cselect =>ala bala portocala??cfiltru=>un filtru - atentie la spatiile din stanga valorii]
|
||
If Type('tcPropertyValueList') = 'C' And !Empty(tcPropertyValueList)
|
||
lnProperties = Getwordcount(tcPropertyValueList, '??')
|
||
For i = 1 To lnProperties
|
||
lcPropertyValue = Alltrim(Getwordnum(tcPropertyValueList, i, '??'))
|
||
If At('=>', lcPropertyValue) > 0
|
||
lcProperty = Getwordnum(Strtran(lcPropertyValue, '=>', Chr(18)), 1, Chr(18))
|
||
lcValue = Getwordnum(Strtran(lcPropertyValue, '=>', Chr(18)), 2, Chr(18))
|
||
luValue = This.GetDefaultValue(lcProperty, lcValue)
|
||
This.SetValue(lcProperty, luValue)
|
||
Endif
|
||
Endfor
|
||
Endif
|
||
Endproc && INIT
|
||
|
||
*!* Seteaza valoarea unei proprietati daca exista sau adauga proprietatea, si intoarce valoarea
|
||
Procedure SetValue
|
||
Lparameters tcProperty, tuValue
|
||
|
||
If Type('THIS.&tcProperty') <> 'U'
|
||
This.&tcProperty = tuValue
|
||
Else
|
||
This.AddProperty(tcProperty, tuValue)
|
||
Endif
|
||
|
||
Return This.&tcProperty
|
||
|
||
Endproc && SetValue
|
||
|
||
*!* Intoarce valoarea unei proprietati daca exista, altfel valoarea empty() corespunzator tipului proprietatii
|
||
Function GetValue
|
||
Lparameters tcProperty
|
||
|
||
Local lcProperty, luValue
|
||
lcProperty = 'THIS.' + tcProperty
|
||
|
||
If Type('THIS.&tcProperty') <> 'U'
|
||
luValue = This.&tcProperty
|
||
Else
|
||
luValue = This.GetDefaultValue(tcProperty)
|
||
Endif
|
||
Return luValue
|
||
|
||
Endfunc && GetValue
|
||
|
||
*!* Intoarce valoarea empty() a unei proprietati dupa tip = prima litera din numele proprietatii daca nu primeste decat tcProperty
|
||
*!* Converteste tcValue la tipul variabilei tcProperty daca tcValue e primit ca parametru
|
||
Function GetDefaultValue
|
||
Lparameters tcProperty, tcValue
|
||
|
||
Local lcType, luValue
|
||
luValue = ""
|
||
lcType = Upper(Left(tcProperty, 1))
|
||
llEmptyValue = Iif(Pcount() = 1, .T., .F.)
|
||
|
||
Do Case
|
||
Case lcType $ "CM"
|
||
luValue = Iif(llEmptyValue, '', tcValue)
|
||
Case lcType $ "NIF"
|
||
luValue = Iif(llEmptyValue, 0, Val(tcValue))
|
||
Case lcType = "T"
|
||
luValue = Iif(llEmptyValue, Dtot({}), Ctot(tcValue))
|
||
Case lcType = "D"
|
||
luValue = Iif(llEmptyValue, {}, Ctod(tcValue))
|
||
Case lcType = "L"
|
||
luValue = Iif(llEmptyValue, .F., Iif(tcValue = "1" Or Upper(tcValue) = "T" Or Upper(tcValue) = '.T.' Or Upper(tcValue) = 'YES', .T., .F.))
|
||
Otherwise
|
||
luValue = ""
|
||
Endcase
|
||
|
||
Return luValue
|
||
Endfunc && GetDefaultValue
|
||
|
||
*!* Intoarce .T. daca exista proprietatea
|
||
Function HasProperty
|
||
Lparameters tcProperty
|
||
|
||
Local lcProperty, llReturn
|
||
lcProperty = 'THIS.' + tcProperty
|
||
llReturn = .F.
|
||
|
||
If Type('THIS.&tcProperty') <> 'U'
|
||
llReturn = .T.
|
||
Endif
|
||
|
||
Return llReturn
|
||
|
||
Endfunc && HasProperty
|
||
|
||
Enddefine && Hash
|
||
|
||
Function get_zileluc( )
|
||
|
||
lnzileluc = 0
|
||
lcSql = [select zileluc from ] + GCS + [.sal_calendar where an=?gnan and luna=?gnluna]
|
||
lcCursor = [v_zileluc]
|
||
lnSucces = goExecutor.oExecute(lcSql, lcCursor)
|
||
goExecutor.Oreset()
|
||
If lnSucces < 0
|
||
amessagebox(goExecutor.cEroare, 0 + 16, "Eroare")
|
||
Return
|
||
Else
|
||
Select v_zileluc
|
||
lnzileluc = zileluc
|
||
Endif
|
||
Return lnzileluc
|
||
|
||
*******************************************
|
||
* PROCEDURE param_listari( tcraport, tcTitlu, tcSemnaturi )
|
||
* Date : 07/28/05, 14:04:21
|
||
* author : liana.macinic
|
||
* description:
|
||
|
||
****** PARAMETER BLOCK **************
|
||
* Parameters : 3
|
||
* Parameter 1:
|
||
* Parameter 2:
|
||
* Parameter 3:
|
||
*
|
||
*******************************************
|
||
Procedure param_listari( tcraport, tctitlu, tcSemnaturi, tlFaraTab)
|
||
Store '' To tctitlu, tcSemnaturi
|
||
|
||
Local lnIdRaport
|
||
If Used('v_raport')
|
||
Use In v_raport
|
||
Endif
|
||
|
||
lcSql = [select id_raport,titlu from ] + GCS + [.sal_nom_rapoarte where UPPER(raport) = '] + Upper(Alltrim(tcraport)) + [']
|
||
lcCursor = [v_raport]
|
||
lnSucces = goExecutor.oExecute(lcSql, lcCursor)
|
||
goExecutor.Oreset()
|
||
If lnSucces < 0
|
||
amessagebox(goExecutor.cEroare, 0 + 16, "Eroare")
|
||
Return
|
||
Endif
|
||
Select v_raport
|
||
lnIdRaport = v_raport.id_raport
|
||
tctitlu = v_raport.titlu
|
||
Use
|
||
|
||
|
||
If Used('v_date')
|
||
Use In v_date
|
||
Endif
|
||
|
||
lcSql = [select semnatura,NUME from ] + GCS + [.sal_semnaturi_rap where id_raport = ] + Alltrim(Str(lnIdRaport)) + [ and sters = 0 order by ordine]
|
||
lcCursor = [v_date]
|
||
lnSucces = goExecutor.oExecute(lcSql, lcCursor)
|
||
goExecutor.Oreset()
|
||
If lnSucces < 0
|
||
amessagebox(goExecutor.cEroare, 0 + 16, "Eroare")
|
||
Return
|
||
Endif
|
||
|
||
Local lcSemn, lcNumeRap, lcListaNumeRap
|
||
Store '' To lcSemn, lcNumeRap, lcListaNumeRap
|
||
|
||
|
||
Select v_date
|
||
Scan
|
||
Scatter Name lcDateRap Memo
|
||
lcSemn = Alltrim(Nvl(lcDateRap.semnatura, ""))
|
||
lcNumeRap = Alltrim(Nvl(lcDateRap.nume, ''))
|
||
If Len(lcSemn) => Len(lcNumeRap)
|
||
lcNumeRap = Padr(lcNumeRap, Len(lcSemn), " ")
|
||
Else
|
||
lcSemn = Padr(lcSemn, Len(lcNumeRap), " ")
|
||
Endif
|
||
If tlFaraTab
|
||
tcSemnaturi = tcSemnaturi + lcSemn
|
||
Else
|
||
tcSemnaturi = tcSemnaturi + Chr(9) + Chr(9) + lcSemn
|
||
Endif
|
||
|
||
If tlFaraTab
|
||
lcListaNumeRap = lcListaNumeRap + lcNumeRap
|
||
Else
|
||
lcListaNumeRap = lcListaNumeRap + + Chr(9) + Chr(9) + lcNumeRap
|
||
Endif
|
||
Endscan
|
||
|
||
tcSemnaturi = tcSemnaturi + Chr(13) + lcListaNumeRap
|
||
*!* SELECT v_date
|
||
*!* SCAN
|
||
*!* tcSemnaturi = tcSemnaturi+CHR(9)+CHR(9)+ALLTRIM(v_date.nume)
|
||
*!* ENDSCAN
|
||
*!* tcSemnaturi = tcSemnaturi+CHR(9)+CHR(9)+CHR(9)+CHR(9)
|
||
Select v_date
|
||
Use
|
||
Endproc
|
||
*----------------------------------sfarsit procedura param_listari----------------------------------
|
||
** --------------------------------INCEPUT: facturi_duplicate ------------------------------
|
||
Procedure facturi_duplicate
|
||
Parameters tcCont, tnId_Part, tcSerieAct, tnNract, tcMesajReturn
|
||
|
||
Private pcCont, pnNract, pnId_part, pcSerieAct
|
||
Local lcMesaj, MesajReturn
|
||
lcMesaj = ''
|
||
pcCont = Alltrim(tcCont)
|
||
pnId_part = tnId_Part
|
||
pnNract = tnNract
|
||
pcSerieAct = Nvl(Iif(Empty(Alltrim(tcSerieAct)), Null, Alltrim(tcSerieAct)), '+_')
|
||
lcMesajReturn = tcMesajReturn
|
||
|
||
If !(Alltrim(Nvl(Alltrim(tcSerieAct), []) + ' ' + Allt(Str(pnNract))) $ lcMesajReturn)
|
||
*!* modificare ROAFACTURARE v 2.0.46
|
||
If Inlist(Allt(pcCont), '4111', '401', '404', '418', '408', '461', '462')
|
||
*!* If Inlist(Allt(pcCont),'4111','401','404')
|
||
*!* modificare ROAFACTURARE v 2.0.46 ^
|
||
lnTotctva = 0
|
||
Do Case
|
||
*!* modificare ROAFACTURARE v 2.0.46
|
||
*!* Case Allt(pcCont) = '4111'
|
||
*!* lcSql = [select count(*) as nr_ireg, sum(debit) as debit from ireg_parteneri ]+;
|
||
*!* [ where an=?gnAn and luna=?gnLuna and cont = ?pcCont and nract = ?pnNract] + ;
|
||
*!* [ and NVL(serie_act,'+_') = ?pcSerieAct ]+;
|
||
*!* [ and extract(year from dataireg)*12+extract(month from dataireg) = ?gnAn*12+?gnLuna ]
|
||
*!* lcCursor = [crsFactDbl]
|
||
*!* lnSucces = goExecutor.oExecute(lcSql,lcCursor)
|
||
*!* goExecutor.Oreset()
|
||
*!* If lnSucces < 0
|
||
*!* AMESSAGEBOX(goExecutor.cEroare,0+16,'Eroare')
|
||
*!* Return
|
||
*!* Endif
|
||
*!* Select crsFactDbl
|
||
*!* If nr_ireg > 0
|
||
*!* lnTotctva = debit
|
||
*!* lcMesaj = 'Factura '+Alltrim(Alltrim(Nvl(tcSerieAct,[]))+' '+Allt(Str(pnNract))) + ", "+ Alltrim(Transform(lnTotctva, get_mask(14,GnPA)))+' lei, mai exista inregistrata in luna curenta.'
|
||
*!* Endif
|
||
Case Inlist(Allt(pcCont), '4111', '418', '461')
|
||
lcSql = [select count(*) as nr_ireg, sum(debit) as debit,] + ;
|
||
[TO_NUMBER(NVL(pack_sesiune.getoptiunefirma('NRLUNIVERIFICARENRDOC'),0)) as nrluni ] + ;
|
||
[from ireg_parteneri ] + ;
|
||
[where an*12+luna between ] + Alltrim(Str(gnAn)) + [*12+] + Alltrim(Str(gnLuna)) + ;
|
||
[-TO_NUMBER(NVL(pack_sesiune.getoptiunefirma('NRLUNIVERIFICARENRDOC'),0)) ] + ;
|
||
[and ] + Alltrim(Str(gnAn)) + [*12+] + Alltrim(Str(gnLuna)) + [ ] + ;
|
||
[and cont = '] + Alltrim(pcCont) + [' and nract = ] + Alltrim(Str(pnNract, 14, 0)) + [ ] + ;
|
||
[and NVL(serie_act,'+_') = '] + pcSerieAct + [' ] + ;
|
||
[and extract(year from dataireg)*12+extract(month from dataireg) between ] + ;
|
||
Alltrim(Str(gnAn)) + [*12+] + Alltrim(Str(gnLuna)) + ;
|
||
[-TO_NUMBER(NVL(pack_sesiune.getoptiunefirma('NRLUNIVERIFICARENRDOC'),0)) ] + ;
|
||
[and ] + Alltrim(Str(gnAn)) + [*12+] + Alltrim(Str(gnLuna)) + [ ] + gcCondSucursala
|
||
lcCursor = [crsFactDbl]
|
||
lnSucces = goExecutor.oExecute(lcSql, lcCursor)
|
||
goExecutor.Oreset()
|
||
If lnSucces < 0
|
||
amessagebox(goExecutor.cEroare, 0 + 16, 'Eroare')
|
||
Return
|
||
Endif
|
||
|
||
Select crsFactDbl
|
||
If nr_ireg > 0
|
||
lnTotctva = debit
|
||
lcPerioadaVerificare = Dtoc(Gomonth(Date(gnAn, gnLuna, 1), (-1) * NrLuni)) + [ - ] + ;
|
||
Dtoc(Gomonth(Date(gnAn, gnLuna, 1), 1) - 1)
|
||
lcMesaj = Iif(INLIST(Alltrim(pcCont), '4111', '461'), 'Factura', 'Avizul') + ' ' + Alltrim(Alltrim(Nvl(tcSerieAct, [])) + ' ' + ;
|
||
Allt(Str(pnNract, 20, 0))) + ", " + Alltrim(Transform(lnTotctva, get_mask(14, GnPc))) + ;
|
||
' lei, mai este inregistrat' + Iif(INLIST(Alltrim(pcCont), '4111', '461'), 'a', '') + ' in perioada ' + lcPerioadaVerificare + '.'
|
||
Endif
|
||
Release pnNrLuni
|
||
*!* modificare ROAFACTURARE v 2.0.46 ^
|
||
Case Inlist(Allt(pcCont), '401', '404', '408', '462')
|
||
lcSql = [select count(*) as nr_ireg, sum(credit) as credit,] + ;
|
||
[TO_NUMBER(NVL(pack_sesiune.getoptiunefirma('NRLUNIVERIFICARENRDOC'),0)) as nrluni ] + ;
|
||
[ from ireg_parteneri ] + ;
|
||
[ where an*12+luna between ] + Alltrim(Str(gnAn)) + [*12+] + Alltrim(Str(gnLuna)) + ;
|
||
[-TO_NUMBER(NVL(pack_sesiune.getoptiunefirma('NRLUNIVERIFICARENRDOC'),0)) ] + ;
|
||
[ and ] + Alltrim(Str(gnAn)) + [*12+] + Alltrim(Str(gnLuna)) + ;
|
||
[ and cont = '] + Alltrim(pcCont) + [' and nract = ] + Alltrim(Str(pnNract, 14, 0)) + ;
|
||
[ and NVL(serie_act,'+_') = '] + pcSerieAct + [' ] + ;
|
||
[and extract(year from dataireg)*12+extract(month from dataireg) between ] + ;
|
||
Alltrim(Str(gnAn)) + [*12+] + Alltrim(Str(gnLuna)) + ;
|
||
[-TO_NUMBER(NVL(pack_sesiune.getoptiunefirma('NRLUNIVERIFICARENRDOC'),0)) ] + ;
|
||
[and ] + Alltrim(Str(gnAn)) + [*12+] + Alltrim(Str(gnLuna)) + ;
|
||
[ and id_part = ] + Alltrim(Str(m.pnId_part)) + [ ] + gcCondSucursala
|
||
lcCursor = [crsFactDbl]
|
||
lnSucces = goExecutor.oExecute(lcSql, lcCursor)
|
||
goExecutor.Oreset()
|
||
|
||
If lnSucces < 0
|
||
amessagebox(goExecutor.cEroare, 0 + 16, 'Eroare')
|
||
Return
|
||
Endif
|
||
|
||
Select crsFactDbl
|
||
If nr_ireg > 0
|
||
lnTotctva = credit
|
||
lcPerioadaVerificare = Dtoc(Gomonth(Date(gnAn, gnLuna, 1), (-1) * NrLuni)) + [ - ] + ;
|
||
Dtoc(Gomonth(Date(gnAn, gnLuna, 1), 1) - 1)
|
||
lcMesaj = 'Factura ' + Alltrim(Alltrim(Nvl(tcSerieAct, [])) + ' ' + Allt(Str(pnNract,20,0))) + ", " + Alltrim(Transform(lnTotctva, get_mask(14, GnPc))) + ' lei, mai exista inregistrata in perioada ' + lcPerioadaVerificare + '.'
|
||
Endif
|
||
*!* modificare v 2.0.132
|
||
*!* Case Allt(pcCont) = '404'
|
||
*!* lcSql = [select count(*) as nr_ireg, sum(credit) as credit from vireg_parteneri ]+;
|
||
*!* [ where an=?gnAn and luna=?gnLuna and cont = ?pcCont and nract = ?pnNract]+;
|
||
*!* [ and NVL(serie_act,'+_') = ?pcSerieAct ]+;
|
||
*!* [ and extract(year from dataireg)*12+extract(month from dataireg) = ?gnAn*12+?gnLuna ]+;
|
||
*!* [ and id_part = ?pnId_part]
|
||
*!* lcCursor = [crsFactDbl]
|
||
*!* lnSucces = goExecutor.oExecute(lcSql,lcCursor)
|
||
*!* goExecutor.Oreset()
|
||
|
||
*!* If lnSucces < 0
|
||
*!* AMESSAGEBOX(goExecutor.cEroare,0+16,'Eroare')
|
||
*!* Return
|
||
*!* Endif
|
||
|
||
*!* Select crsFactDbl
|
||
*!* If nr_ireg > 0
|
||
*!* lnTotctva = credit
|
||
*!* lcMesaj = 'Factura '+Alltrim(Alltrim(Nvl(tcSerieAct,[]))+' '+Allt(Str(pnNract)))+ ", "+ Alltrim(Transform(lnTotctva, get_mask(14,GnPA)))+' lei, mai exista inregistrata in luna curenta.'
|
||
*!* Endif
|
||
*!* modificare v 2.0.132 ^
|
||
Endcase
|
||
|
||
Endif
|
||
Endif
|
||
|
||
Return lcMesaj
|
||
|
||
Endproc && facturi_duplicate
|
||
&& ------------------------------SFARSIT: facturi_duplicate ------------------------------
|
||
|
||
********************************************
|
||
*** Verifica un numar si serie (optional) de factura clienti in vanzari in luna curenta
|
||
*** Intoarce .T. daca exista numarul de factura in luna curenta
|
||
********************************************
|
||
Function VerificaFacturaClientiVanzari
|
||
Lparameters tnNrFactura, tcSerieFactura
|
||
* tcSerieFactura (optional)
|
||
|
||
Private pnNrFactura, pcSerieFactura, pnCount
|
||
Local lcSql, llSucces, lcSelect, llExista
|
||
|
||
lcSelect = Select()
|
||
pnNrFactura = tnNrFactura
|
||
pcSerieFactura = Iif(!Empty(Nvl(m.tcSerieFactura, '')), Alltrim(Transform(m.tcSerieFactura)), '')
|
||
pnCount = 0
|
||
|
||
lcSql = [SELECT COUNT(*) as nr FROM vanzari WHERE numar_act = ?pnNrFactura ] + Iif(!Empty(m.pcSerieFactura), [AND serie_act = ?pcSerieFactura ], []) + [AND extract(year FROM data_act) = ?gnAn AND extract(month FROM data_act) = ?gnLuna and sters = 0]
|
||
llSucces = goExecutor.oSelecteaza2Value(m.lcSql, @pnCount)
|
||
llExista = Nvl(m.pnCount, 0) > 0
|
||
|
||
Select (m.lcSelect)
|
||
Return m.llExista
|
||
Endfunc && VerificaNumarFacturaVanzari
|
||
|
||
************************************ EncryptDecrypt ****************************************
|
||
*!* EncryptDecrypt
|
||
*!* EX: EncryptDecrypt("text to encrypt", "encrypt key", "encrypt")
|
||
*!* EX: EncryptDecrypt("text to decrypt", "decrypt key", "decrypt")
|
||
*!* EX: EncryptDecrypt("text to encrypt", "encrypt key", "encrypt","blowfish")
|
||
Function EncryptDecrypt
|
||
Lparameters tcText, tcPassword, tcMode, tcAlgorithm
|
||
&& tcMode : ENCRYPT/DECRYPT
|
||
Local lcAlgorithm, lcReturn, lcString, lcPWD
|
||
Local loException As Exception
|
||
m.lcString = tcText
|
||
m.lcPWD = tcPassword
|
||
m.lcReturn = ""
|
||
lcAlgorithm = ""
|
||
If Type('tcAlgorithm') = 'C'
|
||
lcAlgorithm = tcAlgorithm
|
||
Endif
|
||
If lcAlgorithm = "blowfish"
|
||
If Upper(Alltrim(Transform(tcMode))) = "ENCRYPT"
|
||
lcReturn = Encrypt(m.lcString, m.lcPWD, 4, 0)
|
||
Else
|
||
Try
|
||
lcReturn = decrypt(m.lcString, Alltrim(m.lcPWD), 4, 0)
|
||
Catch To loException
|
||
If loException.ErrorNo = 2028
|
||
polog.Log("S-a incercat decriptarea unui text care nu a fost generat cu algoritmul de criptare selectat.", Program())
|
||
Else
|
||
polog.Log(loException.Message, Program())
|
||
Endif
|
||
Endtry
|
||
Endif
|
||
Endif
|
||
*!* 18.03.2008 : am scos chr(0) de la sfarsitul textului decriptat
|
||
If At(Chr(0), m.lcReturn) > 0 And Upper(Alltrim(Transform(tcMode))) != "ENCRYPT"
|
||
m.lcReturn = Substr(m.lcReturn, 1, At(Chr(0), m.lcReturn) - 1)
|
||
Endif
|
||
*!* 18.03.2008
|
||
Return m.lcReturn
|
||
Endfunc && EncryptDecrypt
|
||
*!* Function EncryptDecrypt
|
||
*!* Lparameters tcText, tcPassword, tcMode, tcAlgorithm
|
||
*!* && tcMode : ENCRYPT/DECRYPT
|
||
*!* *!* IF !'crypto'$LOWER(SET("Classlib"))
|
||
*!* *!* SET CLASSLIB TO CRYPTO.VCX ADDITIVE
|
||
*!* *!* ENDIF
|
||
*!* Local loCryptor, llNewCryptFll, lcAlgorithm
|
||
*!* loCryptor = Newobject("MyCrypt","crypto.vcx")
|
||
*!* Local loException As Exception
|
||
*!* Local lcReturn, lcString, lcPWD
|
||
*!* m.lcString = tcText
|
||
*!* m.lcPWD = tcPassword
|
||
*!* m.lcReturn = ""
|
||
*!* llNewCryptFll = .F.
|
||
*!* If Type('gnewcryptfll') <> 'U'
|
||
*!* llNewCryptFll = gnewcryptfll
|
||
*!* Endif
|
||
*!* lcAlgorithm = ""
|
||
*!* If Type('tcAlgorithm') = 'C'
|
||
*!* lcAlgorithm = tcAlgorithm
|
||
*!* Endif
|
||
*!* If !(lcAlgorithm = "blowfish" And llNewCryptFll)
|
||
*!* If Upper(Alltrim(Transform(tcMode))) = "ENCRYPT"
|
||
*!* loCryptor.EncryptSessionStreamString( m.lcString, m.lcPWD, @lcReturn)
|
||
*!* Else
|
||
*!* Try
|
||
*!* loCryptor.EncryptSessionStreamString( m.lcString, m.lcPWD, @lcReturn)
|
||
*!* Catch To loException
|
||
*!* If loException.ErrorNo=2028
|
||
*!* polog.Log("S-a incercat decriptarea unui text care nu a fost generat cu algoritmul de criptare selectat.",Program())
|
||
*!* Else
|
||
*!* polog.Log(loException.Message,Program())
|
||
*!* Endif
|
||
*!* Endtry
|
||
*!* Endif
|
||
*!* Else
|
||
*!* If Upper(Alltrim(Transform(tcMode))) = "ENCRYPT"
|
||
*!* lcReturn=Encrypt(m.lcString, m.lcPWD,4,0)
|
||
*!* Else
|
||
*!* Try
|
||
*!* lcReturn=decrypt(m.lcString, Alltrim(m.lcPWD),4,0)
|
||
*!* Catch To loException
|
||
*!* If loException.ErrorNo=2028
|
||
*!* polog.Log("S-a incercat decriptarea unui text care nu a fost generat cu algoritmul de criptare selectat.",Program())
|
||
*!* Else
|
||
*!* polog.Log(loException.Message,Program())
|
||
*!* Endif
|
||
*!* Endtry
|
||
*!* Endif
|
||
*!* Endif
|
||
*!* Release oCryptor
|
||
*!* *!* 18.03.2008
|
||
*!* *!* am scos chr(0) de la sfarsitul textului decriptat
|
||
*!* If At(Chr(0),m.lcReturn) > 0 And Upper(Alltrim(Transform(tcMode))) != "ENCRYPT"
|
||
*!* m.lcReturn = Substr(m.lcReturn, 1, At(Chr(0),m.lcReturn)-1)
|
||
*!* Endif
|
||
*!* *!* 18.03.2008
|
||
*!* Return m.lcReturn
|
||
*!* Endfunc && EncryptDecrypt
|
||
************************************ EncryptDecrypt ****************************************
|
||
Procedure lansare_help
|
||
|
||
Do viz_prg_instalat In oproceduri_comune.prg
|
||
|
||
If Used('v_programe_instalate') And Reccount('v_programe_instalate') > 0
|
||
If Used('v_help')
|
||
Use In v_help
|
||
Endif
|
||
Select * From v_programe_instalate Where !Isnull(gruphelp) And nume == gcappname Into Cursor v_help
|
||
If Used('v_programe_instalate')
|
||
Use In v_programe_instalate
|
||
Endif
|
||
ohelp = Createobject('toolhelp')
|
||
|
||
With ohelp.tool_help1
|
||
lcImgNume = 'HELP'
|
||
.AddObject(lcImgNume, 'img_help')
|
||
If Used('v_help') And Reccount('v_help') > 0 And !Empty(gcCaleHelp)
|
||
|
||
Select v_help
|
||
Local lcgrup, lcNume, lcIndex
|
||
lcgrup = Nvl(Alltrim(v_help.gruphelp), '')
|
||
lcNume = Nvl(Alltrim(v_help.numehelp), '')
|
||
lcIndex = Nvl(Alltrim(v_help.indexhelp), '')
|
||
lcComanda = dirgen + gcCaleHelp + '\' + lcgrup + '\' + lcNume + '\' + lcIndex
|
||
If File(lcComanda)
|
||
.&lcImgNume..Picture = '_active_help.ico' &&adaug poza
|
||
.&lcImgNume..comanda_program = lcComanda
|
||
Else
|
||
.&lcImgNume..comanda_program = 'INACTIV'
|
||
Endif
|
||
Else
|
||
.&lcImgNume..comanda_program = 'INACTIV'
|
||
Endif
|
||
.&lcImgNume..ToolTipText = 'Ajutor (F1)'
|
||
.&lcImgNume..Visible = .T.
|
||
|
||
*!* modificare 17.11.2011
|
||
.AddObject('stromfast', 'img_program')
|
||
With .stromfast
|
||
.Picture = 'romfast_suport.png'
|
||
.comanda_program = 'romfast_suport.exe'
|
||
.ToolTipText = 'ROMFAST suport tehnic (ALT+R)'
|
||
.Visible = .T.
|
||
Endwith
|
||
*!* modificare 17.11.2011 ^
|
||
|
||
*!* modificare 04.04.2016
|
||
.AddObject('screenshot', 'img_program')
|
||
With .screenshot
|
||
.Picture = 'screenshot.png'
|
||
.comanda_program = 'roascreenshot.exe'
|
||
.ToolTipText = 'Captura ecran si email (ALT+S)'
|
||
.Visible = .T.
|
||
Endwith
|
||
*!* modificare 17.11.2011
|
||
|
||
.AddObject('chatbot', 'img_program')
|
||
With .chatbot
|
||
.Picture = 'chatbot.png'
|
||
.comanda_program = 'chatbot'
|
||
.ToolTipText = 'Chatbot Suport Tehnic (ALT+C)'
|
||
.Visible = .T.
|
||
Endwith
|
||
|
||
.Dock(0)
|
||
.Show
|
||
Endwith
|
||
Endif
|
||
If Used('v_help')
|
||
Use In v_help
|
||
Endif
|
||
|
||
Endproc
|
||
*****************************************************
|
||
|
||
Procedure lansare_help_meniu
|
||
|
||
If Type('ohelp.tool_help1') <> 'O'
|
||
Return
|
||
Endif
|
||
If !Empty(ohelp.tool_help1.Help.comanda_program)
|
||
If ohelp.tool_help1.Help.comanda_program <> 'INACTIV'
|
||
OPEN_DEFAULT_APP(ohelp.tool_help1.Help.comanda_program)
|
||
Else
|
||
amessagebox("Manualul de utilizare nu este configurat corect!", 0 + 48, "Atentie")
|
||
Endif
|
||
Else
|
||
amessagebox("Manualul de utilizare nu este instalat!", 0 + 48, "Atentie")
|
||
Endif
|
||
|
||
Endproc
|
||
*****************************************************
|
||
Function getUserDocPath
|
||
Local lcAppPath, lcAppName, liAt, lcDirgen, lcUserDocPath
|
||
lcAppPath = Addbs(shortpath(Justpath(Sys(16, 0))))
|
||
lcAppName = Allt(Uppe(Juststem(Sys(16, 0))))
|
||
liAt = Rat("\", lcAppPath, 2)
|
||
lcDirgen = Addbs(Left(lcAppPath, liAt - 1))
|
||
lcUserDocPath = lcDirgen + 'USERDOCSS\'
|
||
If !Directory(lcUserDocPath)
|
||
Md (lcUserDocPath)
|
||
Endif
|
||
lcUserDocPath = lcUserDocPath + lcAppName + '\'
|
||
If !Directory(lcUserDocPath)
|
||
Md (lcUserDocPath)
|
||
Endif
|
||
lcUserDocPath = lcUserDocPath + GCS + '\'
|
||
If !Directory(lcUserDocPath)
|
||
Md (lcUserDocPath)
|
||
Endif
|
||
|
||
Return lcUserDocPath
|
||
|
||
Endfunc
|
||
*****************************************************
|
||
Procedure copiaza_structura_cursor
|
||
Lparameters tcSursa, tcDestinatie
|
||
If !Empty(tcSursa) And !Empty(tcDestinatie)
|
||
If Used(tcSursa)
|
||
Dimension laStructura(1, 18)
|
||
If Used(tcDestinatie)
|
||
Use In (tcDestinatie)
|
||
Endif
|
||
Afields(laStructura, tcSursa)
|
||
Create Cursor (tcDestinatie) From Array laStructura
|
||
Release laStructura
|
||
Else
|
||
amessagebox("Eroare interna 2 - copiaza structura cursor", 16, "Eroare")
|
||
Endif
|
||
Else
|
||
amessagebox("Eroare interna 1 - copiaza structura cursor", 16, "Eroare")
|
||
Endif
|
||
Endproc && copiaza_structura_cursor
|
||
*********************************************************************************************************
|
||
Function citeste_optiune_firma
|
||
Lparameters tcOptiune, tlNumeProgram
|
||
Local lcCursor, lcVarType, luReturnValue
|
||
lcCursor = [crsoptiunefirma]
|
||
If Used(lcCursor)
|
||
Use In (lcCursor)
|
||
Endif
|
||
lcSql = [select varvalue,vartype from optiuni where varname = '] + Alltrim(tcOptiune) + ['] + ;
|
||
Iif(tlNumeProgram, [ and program = '] + Alltrim(gcNumeProgram) + ['], [])
|
||
lnSucces = goExecutor.oExecute(lcSql, lcCursor)
|
||
If lnSucces < 0
|
||
amessagebox(goExecutor.cEroare, 16, "Eroare")
|
||
luReturnValue = Null
|
||
Else
|
||
If Reccount(lcCursor) > 0
|
||
Select (lcCursor)
|
||
lcVarType = Upper(Alltrim(&lcCursor..Vartype))
|
||
Do Case
|
||
Case lcVarType = "CHARACTER"
|
||
luReturnValue = Alltrim(&lcCursor..varvalue)
|
||
Case lcVarType = "CURRENCY"
|
||
luReturnValue = Ntom(Val(&lcCursor..varvalue))
|
||
Case lcVarType = "NUMERIC"
|
||
luReturnValue = Val(&lcCursor..varvalue)
|
||
Case lcVarType = "DATETIME"
|
||
luReturnValue = Ctot(&lcCursor..varvalue)
|
||
Case lcVarType = "DATE"
|
||
luReturnValue = Ctod(&lcCursor..varvalue)
|
||
Case lcVarType = "LOGICAL"
|
||
luReturnValue = Iif(Inlist(Upper(Left(&lcCursor..varvalue, 1)), "T", "Y"), .T., .F.)
|
||
Otherwise
|
||
pcmsgbuff = "Tip de variabila globala invalid!"
|
||
pcmsgbuff = pcmsgbuff + Chr(13) + Chr(13) + "Numele variabilei: " + lcvarname
|
||
pcmsgbuff = pcmsgbuff + Chr(13) + "Tipul variabilei: " + lcVarType
|
||
pcmsgbuff = pcmsgbuff + Chr(13) + Chr(13) + "Contactati suportul tehnic."
|
||
= amessagebox(pcmsgbuff, 48)
|
||
pcmsgbuff = ""
|
||
luReturnValue = Null
|
||
Endcase
|
||
Else
|
||
amessagebox("Nu a fost gasita optiunea '" + tcOptiune + "' !", 16, "Eroare")
|
||
luReturnValue = Null
|
||
Endif
|
||
Use In (lcCursor)
|
||
Endif
|
||
|
||
Return luReturnValue
|
||
Endfunc
|
||
*********************************************************************************************************
|
||
Procedure debug_dezvoltare
|
||
If Messagebox("Porniti debug?", 32 + 4 + 256, "Confirmare") = 6
|
||
Debug
|
||
Suspend
|
||
Endif
|
||
Endproc && debug_dezvoltare
|
||
*********************************************************************************************************
|
||
|
||
|
||
**************************** inceput nvl2Default *****************************************************
|
||
Procedure nvl2Default
|
||
Lparameters tcTableAlias, tcCampuriNull
|
||
* updatateaza cursorul si pune o valoare default pe toate coloanele, ;
|
||
cu exceptia celor din tcCampuriNull
|
||
* tcCampuriNull primeste lista de campuri separate prin ',' care nu vor fi modificate ;
|
||
de ex: "camp1,camp2,"
|
||
|
||
Local lnNrCol, i, lcSql, lctip, lcCampuriNull
|
||
|
||
lctip = []
|
||
lcSql = [update ] + tcTableAlias + [ set ]
|
||
lcCampuriNull = Iif(Type("tcCampuriNull") = "L", [], tcCampuriNull)
|
||
lcCampuriNull = Upper(Nvl(lcCampuriNull, []))
|
||
If Right(lcCampuriNull, 1) # "," And Len(lcCampuriNull) > 0
|
||
lcCampuriNull = lcCampuriNull + [,]
|
||
Endif
|
||
|
||
Select(tcTableAlias)
|
||
lnNrCol = Afields(laCols)
|
||
|
||
For i = 1 To lnNrCol
|
||
If (laCols(i, 1) + [,]) $ lcCampuriNull
|
||
Loop
|
||
Endif && daca este in lista, nu il adaugam
|
||
|
||
If laCols(i, 2) = "C" Or laCols(i, 2) = "M" Or laCols(i, 2) = "V"
|
||
lctip = [''] && character, memo, varchar
|
||
Endif
|
||
If laCols(i, 2) = "B" Or laCols(i, 2) = "F" Or laCols(i, 2) = "I" Or laCols(i, 2) = "N"
|
||
lctip = [0] && double, float, integer, numeric
|
||
Endif
|
||
If laCols(i, 2) = "L"
|
||
lctip = [.f.] && logic
|
||
Endif
|
||
If laCols(i, 2) = "T" Or laCols(i, 2) = "D"
|
||
lctip = [{}]
|
||
Endif && date, datetime
|
||
|
||
lcSql = lcSql + laCols(i, 1) + [ = NVL(] + laCols(i, 1) + [,] + lctip + [), ]
|
||
Endfor
|
||
|
||
lcSql = Left(lcSql, Rat(',', lcSql) - 1)
|
||
&lcSql
|
||
Go Top && nu facea update in xitems pe coloanele xinputmask, filtru de pe ultima linie
|
||
|
||
Endproc && nvl2Default ^
|
||
*************************************************************************************************
|
||
|
||
Procedure versiune
|
||
Lparameters lcvers
|
||
|
||
External Array laVers
|
||
Local lcVersiune, lnNr
|
||
lcVersiune = []
|
||
|
||
lnNr = Alines(laVers, Nvl(lcvers, []), .T., ".")
|
||
If lnNr > 0
|
||
For i = 1 To lnNr
|
||
laVers(i) = Replicate("0", 3 - Len(Alltrim(Nvl(laVers(i), [])))) + laVers(i)
|
||
lcVersiune = lcVersiune + laVers(i) + "."
|
||
Endfor
|
||
lcVersiune = Left(lcVersiune, Len(lcVersiune) - 1)
|
||
Else
|
||
lcVersiune = lcvers
|
||
Endif
|
||
Return lcVersiune
|
||
|
||
Endproc && sfarsit versiune ^
|
||
*************************************************************************************************
|
||
*********************************************************************************************************
|
||
Function sir2array
|
||
Lparameters tcSir, taArray, tcSeparator
|
||
|
||
Local lcSeparator, lnValues, i, lcValue, luValue, lnPos
|
||
|
||
External Array taArray
|
||
|
||
If Empty(tcSeparator)
|
||
lcSeparator = ';'
|
||
Else
|
||
lcSeparator = tcSeparator
|
||
Endif
|
||
|
||
lnValues = Alines(taArray, tcSir, 4, lcSeparator)
|
||
|
||
Return lnValues
|
||
|
||
Endfunc && sir2array
|
||
*********************************************************************************************************
|
||
***************************
|
||
Function TooManyInstances(lnInstancesAllowed)
|
||
***************************
|
||
#Define GW_CHILD 5 && 0x00000005
|
||
#Define GW_HWNDNEXT 2 && 0x00000002
|
||
#Define SW_MAXIMIZE 3 && 0x00000003
|
||
#Define SW_NORMAL 1 && 0x00000001
|
||
#Define WAIT_OBJECT_0 0 && 0x00000000
|
||
#Define RF_MESAJ 0xA123
|
||
|
||
Local lcUniqueProperty, lcUniqueSemaphore, lnhSemaphore, lnHwnd, llReturn
|
||
If Pcount() = 0
|
||
lnInstancesAllowed = 1 && default
|
||
Else
|
||
lnInstancesAllowed = Max(lnInstancesAllowed, 1) &&At least one
|
||
Endif
|
||
Do DeclareAPIs
|
||
lcUniqueSemaphore = Strtran(Justpath(Sys(16, 0)), "\", "")
|
||
*!* lcUniqueSemaphore = "968360BF-C7AD-4B62-A045-0A06D597EF18"
|
||
lcUniqueProperty = "E2429959-D873-4733-8182-7A3F14780A27"
|
||
&&&
|
||
*!* oTypeLib = CreateObject("scriptlet.typelib")
|
||
*!* lcUniqueSemaphore = substr(oTypeLib.GUID, 2, 36)
|
||
*!* oTypeLib1 = CreateObject("scriptlet.typelib")
|
||
*!* lcUniqueProperty = substr(oTypeLib1.GUID, 2, 36)
|
||
&&&
|
||
lnhSemaphore = CreateSemaphore(0, lnInstancesAllowed, lnInstancesAllowed, lcUniqueSemaphore)
|
||
If lnhSemaphore != 0 And WaitForSingleObject(lnhSemaphore, 0) != WAIT_OBJECT_0
|
||
Do DeclareMoreAPIs
|
||
llReturn = .T.
|
||
lnHwnd = GetWindow(GetDesktopWindow(), GW_CHILD)
|
||
Do While lnHwnd != 0 && loop through all windows
|
||
If GetProp(lnHwnd, lcUniqueProperty) = 1 && does window have our unique property?
|
||
BringWindowToTop(lnHwnd)
|
||
*!* modificare v 2.0.23
|
||
If IsIconic(lnHwnd) <> 0
|
||
SendMessage(lnHwnd, RF_MESAJ, 0, 0)
|
||
Else
|
||
*!* modificare v 2.0.23 ^
|
||
ShowWindow(lnHwnd, SW_NORMAL)
|
||
*!* modificare v 2.0.23
|
||
Endif
|
||
*!* modificare v 2.0.23 ^
|
||
llReturn = .T.
|
||
Exit
|
||
Endif
|
||
lnHwnd = GetWindow(lnHwnd, GW_HWNDNEXT)
|
||
Enddo
|
||
CloseHandle(lnHwnd)
|
||
CloseHandle(lnhSemaphore)
|
||
Clear Dlls "BringWindowToTop", "GetDesktopWindow", ;
|
||
"GetProp", "GetWindow", "ShowWindow", ;
|
||
"CloseHandle", "SendMessage", "IsIconic"
|
||
Else
|
||
= SetProp(_vfp.HWnd, lcUniqueProperty, 1)
|
||
_Screen.AddProperty("SemaphoreHandle", lnhSemaphore)
|
||
llReturn = .F.
|
||
Endif
|
||
Clear Dlls "CreateSemaphore", "GetLastError", ;
|
||
"SetProp"
|
||
Return (llReturn)
|
||
Endfunc
|
||
*************************************************************************************************************************
|
||
***************************
|
||
Procedure DeclareAPIs()
|
||
***************************
|
||
Declare Integer CloseHandle In Kernel32 Integer hObject
|
||
Declare Integer CreateSemaphore In Kernel32 Integer lpSemaphoreAttributes, Integer lInitialCount, Integer lMaximumCount, String lpName
|
||
Declare Integer SetProp In User32 Integer HWnd, String lpString, Integer hData
|
||
Declare Integer WaitForSingleObject In Kernel32 Integer hHandle, Integer dwMilliseconds
|
||
Endproc
|
||
*************************************************************************************************************************
|
||
***************************
|
||
Procedure DeclareMoreAPIs()
|
||
***************************
|
||
Declare Integer BringWindowToTop In Win32API Integer HWnd
|
||
Declare Integer GetDesktopWindow In User32
|
||
Declare Integer GetProp In User32 Integer HWnd, String lpString
|
||
Declare Integer GetWindow In User32 Integer HWnd, Integer uCmd
|
||
Declare Integer ShowWindow In Win32API Integer HWnd, Integer nCmdShow
|
||
*!* modificare v 2.0.23
|
||
Declare Integer SendMessage In User32 Integer HWnd, Integer Msg, Integer wParam, Integer Lparam
|
||
Declare Integer IsIconic In User32 Integer HWnd
|
||
*!* modificare v 2.0.23 ^
|
||
Endproc
|
||
*************************************************************************************************************************
|
||
|
||
**************************************************************************************************
|
||
*!* INTOARCE VALOAREA NOTNULL DACA EXPRESIA NU ESTE NULL SAU VALOAREA NULL DACA EXPRESIA ESTE NULL
|
||
**************************************************************************************************
|
||
Function nvl2
|
||
Lparameters tcExpression, tuValueIfNotNull, tuValueIfNull
|
||
Local luReturn
|
||
luReturn = tuValueIfNotNull
|
||
|
||
If Isnull(tcExpression)
|
||
luReturn = tuValueIfNull
|
||
Endif
|
||
|
||
Return luReturn
|
||
Endfunc && nvl2
|
||
************************************************************************************************************
|
||
Procedure alege_vizualizare_raport
|
||
Lparameters tcCursorRaport, tcraport
|
||
Private pnButon, pnOptiune
|
||
If Reccount(tcCursorRaport) > 0
|
||
pnButon = 1
|
||
Do While pnButon = 1
|
||
pnOptiune = 1
|
||
ofrmaleg = Createobject('frm_aleg_vizualizare')
|
||
ofrmaleg.Show(1)
|
||
Do Case
|
||
Case pnButon <> 1
|
||
Loop
|
||
Case pnOptiune = 1
|
||
goExport.export2frx(tcCursorRaport, tcraport)
|
||
Case pnOptiune = 2
|
||
goExport.export2xls(tcCursorRaport)
|
||
&& tcAlias, tcNumeFisier, tcListaColoane, tcFiltru
|
||
Endcase
|
||
Release ofrmaleg
|
||
Enddo
|
||
Else
|
||
amessagebox("Nu exista inregistrari pentru listare!", 0 + 48, "Atentie")
|
||
Endif
|
||
Use In (tcCursorRaport)
|
||
Release pnButon, pnOptiune
|
||
Endproc
|
||
************************************************************************************************************
|
||
****************************
|
||
*!* Demonstrates the callback functionality
|
||
****************************
|
||
*!* SET LIBRARY TO LOCFILE("vfpcompression.fll")
|
||
*!* ZipCallback("MyUnzipCallBack()") && Start Event Handling - Any Function/Procedure/Method (in scope of course)
|
||
*!* ?ZipOpen("MyZip.zip", "C:\", .F.) && create zip file
|
||
*!* ?ZipFile("C:\MyFile.txt", .F.) && compress file into zip
|
||
*!* ?ZipClose() && done zipping
|
||
*!* ?UnzipQuick("C:\MyZip.zip", "C:\") && unzip contents of Test.zip to C:\
|
||
*!* ZipCallback("") && Stop Event Handling
|
||
*!* SET LIBRARY TO
|
||
Function MyUnzipCallBack
|
||
Lparameters tnBytesTotal
|
||
*****************************
|
||
*!* Variables below are created on the fly
|
||
*!* by the FLL when the ZipCallback feature is used
|
||
|
||
*!* Depends on the value of nZipEvent
|
||
*!* cZipObjectName && Name of Zip, File, or Folder being processed
|
||
|
||
*!* Events that fire MyCallback
|
||
*!* 0 = Open Zip
|
||
*!* 1 = Start Zip/Unzip of File
|
||
*!* 2 = Read/Write File (nZipBytes will contain value of bytes read for event)
|
||
*!* 3 - End Zip/Unzip of File
|
||
*!* 4 - Folder Opened
|
||
*!* 5 - Close Zip
|
||
If nZipEvent = 2
|
||
*!* Number of Bytes read (Event 3)
|
||
If !Empty(m.tnBytesTotal)
|
||
Wait Window cZipObjectName + ' ' + Transform(Int(m.nZipBytes / m.tnBytesTotal * 100)) + '% ...' Nowait
|
||
Else
|
||
Wait Window cZipObjectName + ' ' + Transform(m.nZipBytes) + ' bytes read' Nowait
|
||
Endif
|
||
Endif
|
||
Endfunc && MyUnzipCallBack
|
||
************************************************************************************************************
|
||
*** Callback from the vfpconnection FLL - can be used to track operation progress
|
||
Procedure MyProgressHandler
|
||
Lparameters tcFile
|
||
Local lnProgress, lcFile
|
||
|
||
lnProgress = 0
|
||
lcFile = Iif(Empty(m.tcFile) Or Type('tcFile') <> 'C', '', m.tcFile)
|
||
If m.nConnectTotalBytes > 0
|
||
m.lnProgress = Int(m.nConnectBytesSoFar / m.nConnectTotalBytes * 100)
|
||
Endif
|
||
|
||
Wait Window m.lcFile + ' ' + Transform(m.lnProgress) + '% ...' Nowait
|
||
Endproc && MyProgressHandler
|
||
************************************************************************************************************
|
||
Procedure apeleaza_calc
|
||
Do Case
|
||
Case File('C:\WINDOWS\CALC.EXE')
|
||
Run /N C:\Windows\Calc.Exe
|
||
Case File('C:\WINDOWS\SYSTEM32\CALC.EXE')
|
||
Run /N C:\Windows\SYSTEM32\Calc.Exe
|
||
Case File('C:\WINnt\system32\CALC.EXE')
|
||
Run /N C:\WINnt\SYSTEM32\Calc.Exe
|
||
Otherwise
|
||
lcMesaj = 'Aplicatia "Calculator" nu este instalata pe acest sistem!'
|
||
amessagebox(lcMesaj, 0 + 48, Iif(!Empty(Nvl(gcNumeProgram, [])), gcNumeProgram, "Atentie"))
|
||
Endcase
|
||
Endproc
|
||
*************************************************************************
|
||
Procedure apeleaza_notepad
|
||
Do Case
|
||
Case File('C:\WINDOWS\NOTEPAD.EXE')
|
||
Run /N C:\Windows\NOTEPAD.Exe
|
||
Case File('C:\WINnt\system32\NOTEPAD.EXE')
|
||
Run /N C:\WINnt\SYSTEM32\NOTEPAD.Exe
|
||
Otherwise
|
||
lcMesaj = 'Aplicatia "Notepad" nu este instalata pe acest sistem!'
|
||
amessagebox(lcMesaj, 0 + 48, Iif(!Empty(Nvl(gcNumeProgram, [])), gcNumeProgram, "Atentie"))
|
||
Endcase
|
||
Endproc
|
||
*************************************************************************
|
||
Procedure arata_modificari
|
||
Do Form frm_changelog
|
||
Endproc
|
||
*************************************************************************
|
||
Procedure arata_versiune
|
||
Do Form frm_about
|
||
Endproc
|
||
*************************************************************************
|
||
Procedure arata_manual
|
||
lansare_help_meniu()
|
||
Endproc
|
||
*************************************************************************
|
||
|
||
|
||
Function aInputBox
|
||
Lparameters tcPrompt, tcTitle, txDefaultValue, tnLeft, tnTop, ;
|
||
tcFormat, tcInputMask, tcPasswordChar
|
||
Private pcReturnValue
|
||
pcReturnValue = txDefaultValue
|
||
Local oInputBox
|
||
oInputBox = Createobject("aInputBox", tcPrompt, tcTitle, ;
|
||
txDefaultValue, tnLeft, tnTop, ;
|
||
tcFormat, tcInputMask, tcPasswordChar)
|
||
oInputBox.Show()
|
||
Return pcReturnValue
|
||
Endfunc && aInputBox
|
||
|
||
**************************************************
|
||
Define Class aInputBox As Form
|
||
|
||
|
||
Height = 113
|
||
Width = 318
|
||
DoCreate = .T.
|
||
AutoCenter = .T.
|
||
Caption = "Input Box"
|
||
ControlBox = .F.
|
||
WindowType = 1
|
||
Name = "frmInputBox"
|
||
|
||
*-- empty value to return if Cancel is chosen; data type depends on data type of txValueIn
|
||
xemptyvalue = .F.
|
||
|
||
*-- the default value (if any)
|
||
xdefaultvalue = .F.
|
||
|
||
*-- the return value
|
||
xreturnvalue = .F.
|
||
|
||
|
||
Add Object lblinputbox As Label With ;
|
||
FontName = "Arial", ;
|
||
FontSize = 10, ;
|
||
FontCharSet = 238, ;
|
||
Alignment = 1, ;
|
||
Caption = "Introduceti valoarea ", ;
|
||
Height = 20, ;
|
||
Left = 6, ;
|
||
Top = 26, ;
|
||
Width = 190, ;
|
||
TabIndex = 1, ;
|
||
Name = "lblInputBox"
|
||
|
||
|
||
Add Object txtinputbox As TextBox With ;
|
||
FontName = "Arial", ;
|
||
FontSize = 10, ;
|
||
Century = 1, ;
|
||
Height = 24, ;
|
||
Left = 202, ;
|
||
SelectOnEntry = .T., ;
|
||
TabIndex = 2, ;
|
||
Top = 22, ;
|
||
Width = 110, ;
|
||
Name = "txtInputBox"
|
||
|
||
|
||
Add Object cmdok As CommandButton With ;
|
||
Top = 72, ;
|
||
Left = 84, ;
|
||
Height = 24, ;
|
||
Width = 72, ;
|
||
Caption = "Confirma", ;
|
||
FontCharSet = 238, ;
|
||
Default = .T., ;
|
||
TabIndex = 3, ;
|
||
Name = "cmdOK"
|
||
|
||
|
||
Add Object cmdcancel As CommandButton With ;
|
||
Top = 72, ;
|
||
Left = 172, ;
|
||
Height = 24, ;
|
||
Width = 72, ;
|
||
Cancel = .T., ;
|
||
Caption = "Renunta", ;
|
||
FontCharSet = 238, ;
|
||
TabIndex = 4, ;
|
||
Name = "cmdCancel"
|
||
|
||
|
||
Procedure Unload
|
||
With Thisform
|
||
If Type(".xReturnValue") = "C"
|
||
.xreturnvalue = Rtrim( .xreturnvalue)
|
||
Endif
|
||
pcReturnValue = .xreturnvalue
|
||
Endwith
|
||
Endproc
|
||
|
||
|
||
Procedure Init
|
||
Lparameters tcPrompt, tcTitle, txDefaultValue, tnLeft, tnTop, ;
|
||
tcFormat, tcInputMask, tcPasswordChar
|
||
If Type("tcPrompt") <> "C"
|
||
tcPrompt = "Introduceti valoarea "
|
||
Endif
|
||
If Type("tcTitle") <> "C"
|
||
tcTitle = "Input Box"
|
||
Endif
|
||
If !( Type("txDefaultValue") $ "CDNY")
|
||
* Valid input data types are C, D, N, and Y
|
||
txDefaultValue = "" && default to character data type
|
||
Endif
|
||
If Type("tcFormat") <> "C"
|
||
tcFormat = ""
|
||
Endif
|
||
If Type("tcInputMask") <> "C"
|
||
tcInputMask = ""
|
||
Endif
|
||
If Type("tcPasswordChar") <> "C"
|
||
tcPasswordChar = ""
|
||
Endif
|
||
If Len( Alltrim( tcPasswordChar)) > 1
|
||
tcPasswordChar = Left( tcPasswordChar, 1)
|
||
Endif
|
||
Local llAutoCenter
|
||
If Pcount() < 5 && Top and Left parameters were not passed
|
||
tnLeft = 0
|
||
tnTop = 0
|
||
Else && Top and left parameters were passed but may not be numeric
|
||
If Type("tnTop") = "N" And Type("tnLeft") = "N" && both are numeric
|
||
llAutoCenter = .F.
|
||
Else && one or both is not numeric, so AutoCenter the form
|
||
tnLeft = 0
|
||
tnTop = 0
|
||
llAutoCenter = .T.
|
||
Endif
|
||
Endif
|
||
|
||
With Thisform
|
||
.lblinputbox.Caption = Alltrim( tcPrompt)
|
||
.Caption = Alltrim( tcTitle)
|
||
.xdefaultvalue = txDefaultValue
|
||
.xreturnvalue = .xdefaultvalue
|
||
.txtinputbox.Value = .xdefaultvalue
|
||
.txtinputbox.Format = Alltrim( tcFormat)
|
||
.txtinputbox.InputMask = Alltrim( tcInputMask)
|
||
.txtinputbox.PasswordChar = tcPasswordChar
|
||
.Top = tnTop
|
||
.Left = tnLeft
|
||
.AutoCenter = llAutoCenter && Set AutoCenter last so it overrides Top and Left if .T.
|
||
|
||
Do Case
|
||
Case Type("txDefaultValue") = "D"
|
||
.xemptyvalue = {}
|
||
Case Type("txDefaultValue") = "N"
|
||
.xemptyvalue = 0
|
||
Case Type("txDefaultValue") = "Y"
|
||
.xemptyvalue = $ 0
|
||
Otherwise
|
||
.xemptyvalue = ""
|
||
Endcase
|
||
Endwith
|
||
Endproc
|
||
|
||
|
||
Procedure cmdok.Click
|
||
With Thisform
|
||
.xreturnvalue = .txtinputbox.Value
|
||
.Release()
|
||
Endwith
|
||
Endproc
|
||
|
||
|
||
Procedure cmdcancel.Click
|
||
*
|
||
* If Cancel was chosen, return the empty value of the correct data type.
|
||
*
|
||
With Thisform
|
||
.xreturnvalue = .xemptyvalue
|
||
.Release()
|
||
Endwith
|
||
Endproc
|
||
|
||
|
||
Enddefine
|
||
*
|
||
*-- EndDefine: aInputBox
|
||
**************************************************
|
||
|
||
**************************************************
|
||
*** intoarce ziua curenta daca luna contabila este egala cu luna calendaristica
|
||
*** intoarce ultima zi din luna contabila daca luna contabila nu este egala cu luna calendaristica
|
||
**************************************************
|
||
Function GetDataIreg
|
||
Local ldData
|
||
ldData = Ttod(Get_Ora())
|
||
If Month(ldData) <> gnLuna Or Year(ldData) <> gnAn
|
||
ldData = ULTIMAZI()
|
||
Endif
|
||
Return m.ldData
|
||
Endfunc && GetDataIreg
|
||
**************************************************
|
||
|
||
**************************************************
|
||
*** primeste tnNrluni = an*12+luna
|
||
*** intoarce anul si luna ca parametri prin referinta
|
||
*** ex: NrLuni2AnLuna(lnNrLuni, @lnAn, @lnLuna)
|
||
**************************************************
|
||
Procedure NrLuni2AnLuna
|
||
Lparameters tnNrLuni, tnAn, tnLuna
|
||
|
||
tnLuna = INT(Mod(m.tnNrLuni, 12))
|
||
tnAn = Int(m.tnNrLuni / 12)
|
||
If tnLuna = 0
|
||
tnLuna = 12
|
||
tnAn = m.tnAn - 1
|
||
Endif
|
||
Endproc && NrLuni2AnLuna
|
||
|
||
**************************************************
|
||
*** salveaza un cursor intr-un fisier XML in gcTempPath
|
||
*** intoarce calea fisierului xml daca s-a salvat cu succes
|
||
**************************************************
|
||
Function SaveCursor2XML
|
||
Lparameters tcAlias, tcXMLName
|
||
*** tcAlias: alias-ul cursorului (ex: tact)
|
||
*** tcXMLName: numele fisierului XML fara cale si extensie (ex: notafarapredefinire)
|
||
Local lcAlias, lcXMLFile, lcXMLName, lnBytes
|
||
|
||
lcAlias = Iif(Empty(tcAlias), Alias(), m.tcAlias)
|
||
lcXMLName = Iif(Empty(tcXMLName), m.lcAlias, m.tcXMLName)
|
||
lcXMLFile = gcTempPath + Juststem(lcXMLName) + '.xml'
|
||
lnBytes = 0
|
||
If Used(m.lcAlias)
|
||
lnBytes = Cursortoxml(m.lcAlias, m.lcXMLFile, 1, 2 + 512, 0, "1")
|
||
Endif
|
||
Return Iif(m.lnBytes > 0, m.lcXMLFile, '')
|
||
Endfunc && SaveCursor2XML
|
||
|
||
**************************************************
|
||
*** transforma un xml salvat anterior in gcTempPath intr-un cursor
|
||
*** intoarce numele cursorului creat (alias), daca s-a gasit fisierul XML
|
||
**************************************************
|
||
Function RestoreXML2Cursor
|
||
Lparameters tcAlias, tcXMLName
|
||
*** tcAlias: alias-ul cursorului (ex: tact)
|
||
*** tcXMLName: numele fisierului XML fara cale si extensie (ex: notafarapredefinire)
|
||
Local lcAlias, lcXMLFile, lcXMLName, lnBytes
|
||
|
||
lcAlias = Iif(Empty(tcAlias), Sys(2015), m.tcAlias)
|
||
lcXMLName = Iif(Empty(tcXMLName), m.lcAlias, m.tcXMLName)
|
||
lcXMLFile = gcTempPath + Juststem(lcXMLName) + '.xml'
|
||
If File(m.lcXMLFile)
|
||
Xmltocursor(m.lcXMLFile, m.lcAlias, 512)
|
||
Endif
|
||
|
||
Return Iif(Used(m.lcAlias), m.lcAlias, '')
|
||
Endfunc && RestoreXML2Cursor
|
||
|
||
**************************************************
|
||
*** verifica daca exista fisierul xml salvat prin SaveCursor2XML
|
||
*** intoarce
|
||
**************************************************
|
||
Function ExistsXML
|
||
Lparameters tcXMLName
|
||
*** tcXMLName: numele fisierului XML fara cale si extensie (ex: notafarapredefinire)
|
||
Local lcXMLFile, lcXMLName
|
||
|
||
lcXMLName = Iif(Empty(tcXMLName), m.lcAlias, m.tcXMLName)
|
||
lcXMLFile = gcTempPath + Juststem(lcXMLName) + '.xml'
|
||
|
||
Return Iif(File(m.lcXMLFile), m.lcXMLFile, '')
|
||
Endfunc && ExistsXML
|
||
|
||
**************************************************
|
||
*** verifica daca exista fisierul xml salvat prin SaveCursor2XML
|
||
*** intoarce
|
||
**************************************************
|
||
Define Class BackupXML As Custom
|
||
|
||
cBackupSet = "" && numele backupset-ului (un fisier xml in care se salveaza informatii despre fisierele xml, variabile etc. pentru acel backupset)
|
||
cBackupSetPath = "" && calea unde se salveaza backupset-ul (gcTempPath)
|
||
cBackupSetFile = "" && calea completa a fisierului backupset gcTempPath\backupset.xml
|
||
cBackupSetAlias = ""
|
||
lBackupSetExists = .F. && Se initializeaza in Init-ul clasei si la salvarea backupset-ului
|
||
lBackupSetLoaded = .F.
|
||
|
||
Procedure Init
|
||
Lparameters tcBackupSet, tcBackupPath
|
||
Local lcBackupPath, lcBackupSet
|
||
|
||
lcBackupSet = m.tcBackupSet
|
||
If Type('tcBackupPath') <> 'C' Or Empty(tcBackupPath)
|
||
lcBackupPath = m.gcTempPath
|
||
Else
|
||
lcBackupPath = m.tcBackupPath
|
||
Endif
|
||
If !(Empty(m.lcBackupSet) Or Empty(m.lcBackupPath))
|
||
This.cBackupSetFile = Addbs(m.lcBackupPath) + Juststem(m.lcBackupSet) + '.xml'
|
||
Endif
|
||
Endproc && Init
|
||
|
||
Procedure cBackupSetFile_ASSIGN
|
||
Lparameters tcBackupSetFile
|
||
|
||
This.cBackupSetFile = m.tcBackupSetFile
|
||
If !Empty(m.tcBackupSetFile)
|
||
This.cBackupSetPath = Addbs(Justpath(m.tcBackupSetFile))
|
||
This.cBackupSet = Juststem(m.tcBackupSetFile)
|
||
This.lBackupSetExists = File(This.cBackupSetFile)
|
||
This.LoadBackupSet()
|
||
Endif
|
||
Endproc && cBackupSetFile_ASSIGN
|
||
|
||
Protected Procedure LoadBackupSet
|
||
|
||
Local lcBackupSetAlias, lcBackupSetFile, lcSelect
|
||
lcSelect = Select()
|
||
lcBackupSetFile = This.cBackupSetFile
|
||
lcBackupSetAlias = This.cBackupSet
|
||
If File(m.lcBackupSetFile)
|
||
Xmltocursor(m.lcBackupSetFile, m.lcBackupSetAlias, 512)
|
||
*!* modificare ROACONT v 2.2.15 : pentru fisierele care aveau structura type/name/filename
|
||
If Type(lcBackupSetAlias + ".filename") <> "U"
|
||
Alter Table &lcBackupSetAlias Add Column Value M Null
|
||
Alter Table &lcBackupSetAlias Add Column valuetype C
|
||
Replace Value With filename All
|
||
Replace valuetype With "" All
|
||
Alter Table &lcBackupSetAlias Drop Column filename
|
||
Endif
|
||
*!* modificare ROACONT v 2.2.15 ^
|
||
Else
|
||
Create Cursor &lcBackupSetAlias (Type v(20), Name v(100), Value M Null, valuetype C)
|
||
Endif
|
||
This.lBackupSetLoaded = Used(m.lcBackupSetAlias)
|
||
Select (m.lcSelect)
|
||
Endproc && LoadBackupSet
|
||
**************************************************
|
||
***
|
||
**************************************************
|
||
Function ReadValue
|
||
Lparameters tcNumeVariabila
|
||
Local lcSelect, lcValue, lcValueType, luValue
|
||
lcSelect = Select()
|
||
Select (This.cBackupSet)
|
||
Locate For Alltrim(Type) = 'VARIABLE' And Upper(Alltrim(Name)) = Upper(Alltrim(tcNumeVariabila))
|
||
If Found()
|
||
lcValue = Value
|
||
lcValueType = Upper(Alltrim(valuetype))
|
||
Do Case
|
||
Case lcValueType $ "CM"
|
||
luValue = m.lcValue
|
||
Case lcValueType $ "NIF"
|
||
luValue = Val(m.lcValue)
|
||
Case lcValueType = "T"
|
||
luValue = Ctot(m.lcValue)
|
||
Case lcValueType = "D"
|
||
luValue = Ctod(m.lcValue)
|
||
Case lcValueType = "L"
|
||
luValue = Iif(m.lcValue = "1" Or Upper(m.lcValue) = "T" Or Upper(m.lcValue) = '.T.' Or Upper(m.lcValue) = 'YES', .T., .F.)
|
||
Otherwise
|
||
luValue = m.lcValue
|
||
Endcase
|
||
Else
|
||
luValue = Null
|
||
Endif
|
||
Select (lcSelect)
|
||
Return luValue
|
||
Endfunc
|
||
|
||
**************************************************
|
||
*** intoarce .T. daca exista fisierul backupset xml
|
||
**************************************************
|
||
Function ExistsBackupSet
|
||
Return This.lBackupSetExists
|
||
Endfunc && ExistsBackupSet
|
||
|
||
|
||
**************************************************
|
||
*** deschide backupset-ul si creeaza cursoarele si variabilele din definitia lui
|
||
*** intoarce .T. daca exista fisierul backupset
|
||
**************************************************
|
||
Function RestoreBackupSet
|
||
Lparameters tcBackupSetFile
|
||
|
||
*** tcBackupSetFile: calea completa a fisierului backupset XML, inclusiv extensie
|
||
Local lcBackupSetFile, llRestored, lcSelect
|
||
Local lcAlias, lcFile, loRec
|
||
Local lcName, lcType, lcValue, lcValueType, lcVariable, luValue
|
||
llRestored = .F.
|
||
lcSelect = Select()
|
||
|
||
If !Empty(m.tcBackupSetFile)
|
||
This.cBackupSetFile = tcBackupSetFile
|
||
Endif
|
||
If !This.lBackupSetLoaded
|
||
Return m.llRestored
|
||
Endif
|
||
lcBackupSetFile = This.cBackupSetFile
|
||
|
||
Select (This.cBackupSet)
|
||
Scan
|
||
Scatter Name loRec Memo
|
||
lcType = Upper(Alltrim(loRec.Type))
|
||
lcName = loRec.Name
|
||
lcValue = loRec.Value
|
||
lcValueType = Upper(Alltrim(loRec.valuetype))
|
||
|
||
Do Case
|
||
*** recreare cursoare din xml-uri
|
||
Case m.lcType = 'TABLE'
|
||
lcFile = Addbs(Justpath(lcBackupSetFile)) + Juststem(Alltrim(m.lcValue)) + '.xml'
|
||
lcAlias = Alltrim(m.lcName)
|
||
If File(m.lcFile)
|
||
Xmltocursor(m.lcFile, m.lcAlias, 512)
|
||
Endif
|
||
|
||
*** reinitializare variabile
|
||
Case loRec.Type = 'VARIABLE'
|
||
lcVariable = lcName
|
||
Do Case
|
||
Case lcValueType $ "CM"
|
||
luValue = m.lcValue
|
||
Case lcValueType $ "NIF"
|
||
luValue = Val(m.lcValue)
|
||
Case lcValueType = "T"
|
||
luValue = Ctot(m.lcValue)
|
||
Case lcValueType = "D"
|
||
luValue = Ctod(m.lcValue)
|
||
Case lcValueType = "L"
|
||
luValue = Iif(m.lcValue = "1" Or Upper(m.lcValue) = "T" Or Upper(m.lcValue) = '.T.' Or Upper(m.lcValue) = 'YES', .T., .F.)
|
||
Otherwise
|
||
luValue = m.lcValue
|
||
Endcase
|
||
&lcVariable = luValue && pcText = "abc"
|
||
Endcase
|
||
Endscan && m.lcBackupSetAlias
|
||
|
||
llRestored = .T.
|
||
Select(m.lcSelect)
|
||
Return m.llRestored
|
||
Endfunc && RestoreBackupSet
|
||
|
||
***********************************
|
||
*** Saves all the private variables in the parameter list in the BackupSet
|
||
***********************************
|
||
Procedure SavePrivateVariables
|
||
Lparameters tcPrivateVariables
|
||
|
||
lnVariables = Getwordcount(m.tcPrivateVariables, ",")
|
||
For lnVariable = 1 To m.lnVariables
|
||
lcVariable = Alltrim(Getwordnum(m.tcPrivateVariables, m.lnVariable, ","))
|
||
If !Empty(m.lcVariable)
|
||
This.SaveBackupSet(m.lcVariable, "VARIABLE", &lcVariable)
|
||
Endif
|
||
Endfor
|
||
Endproc && SavePrivateVariables
|
||
|
||
**************************************************
|
||
*** salveaza un cursor sau toate cursoarele din definitia backupset-ului in fisiere XML in gcTempPath
|
||
*** intoarce calea fisierului xml daca s-a salvat cu succes
|
||
**************************************************
|
||
Procedure SaveBackupSet
|
||
Lparameters tcName, tcType, tuValue
|
||
*** tcName: numele cursorului sau variabilei (ex: crsAct, pcText) Daca este gol, se salveaza toate alias-urile
|
||
*** daca este completat, se adauga in definitia backupset-ului
|
||
*** tcType: TABLE/VARIABLE
|
||
*** tuValue: (optional) valoarea variabilei. Valoarea se salveaza direct in xml definitie backupset
|
||
*** tcValueType: (optional) tipul variabilei (C/N/D/T) pentru This.RestoreBackupset
|
||
|
||
Local lcFile, lcName, lcType, lcWhere, llSaved, lnBytes, loRec, lnRecno, lcFilter
|
||
|
||
lcName = ""
|
||
llSaved = .F.
|
||
If !This.lBackupSetLoaded
|
||
Return m.llSaved
|
||
Endif
|
||
If !Empty(tcName)
|
||
lcName = Alltrim(Transform(m.tcName))
|
||
lcType = Iif(!Empty(m.tcType), m.tcType, "TABLE")
|
||
This.UpdateBackupSet(m.lcName, m.lcType, m.tuValue) && variabilele se salveaza direct in definitia backupset-ului
|
||
Endif
|
||
|
||
Select (This.cBackupSet)
|
||
lcWhere = [.T.]
|
||
If !Empty(m.lcName)
|
||
lcWhere = [name = "] + m.lcName + ["]
|
||
Endif
|
||
|
||
*** SALVARE CURSOARE IN XML
|
||
Scan For &lcWhere
|
||
Scatter Name loRec Memo
|
||
lcFile = Addbs(This.cBackupSetPath) + Alltrim(loRec.Value) && (c:\temp\backupsettest_actactan.xml)
|
||
lcName = Alltrim(loRec.Name)
|
||
|
||
Do Case
|
||
Case loRec.Type = 'TABLE'
|
||
If Used(m.lcName)
|
||
lnRecno = Iif(Eof(m.lcName), 0, Recno(m.lcName))
|
||
lcFilter = Filter(m.lcName)
|
||
Set Filter To In (m.lcName)
|
||
lnBytes = Cursortoxml(m.lcName, m.lcFile, 1, 2 + 512, 0, "1")
|
||
If !Empty(m.lcFilter)
|
||
lcFilterExpr = "set filter to " + m.lcFilter + " in " + m.lcName
|
||
&lcFilterExpr
|
||
Endif
|
||
If m.lnRecno > 0
|
||
Goto m.lnRecno In (m.lcName)
|
||
Endif
|
||
Endif
|
||
Otherwise
|
||
***
|
||
Endcase
|
||
Endscan && m.lcBackupSetAlias
|
||
|
||
llSaved = .T.
|
||
|
||
Return m.llSaved
|
||
Endfunc && SaveBackupSet
|
||
|
||
Procedure DeleteBackupSet
|
||
Local lcFile, loRec, lcSelect
|
||
lcSelect = Select()
|
||
|
||
If !File(This.cBackupSetFile)
|
||
Return
|
||
Endif
|
||
|
||
*** sterg fisierele componenta backupset
|
||
Select (This.cBackupSet)
|
||
Scan For Upper(Alltrim(Type)) = 'TABLE'
|
||
Scatter Name loRec Memo
|
||
lcFile = Addbs(This.cBackupSetPath) + Alltrim(loRec.Value) && (c:\temp\backupsettest_actactan.xml)
|
||
|
||
If File(m.lcFile)
|
||
Delete File (m.lcFile)
|
||
Endif
|
||
Endscan
|
||
|
||
*** sterg inregistrarile din cursorul backupset
|
||
Delete All
|
||
|
||
*** sterg fisierul backupset
|
||
Delete File (This.cBackupSetFile)
|
||
|
||
Endproc && DeleteBackupSet
|
||
|
||
|
||
*************************************************************************
|
||
*** actualizeaza definitia backupset-ului cu tabelele sau variabilele noi
|
||
*** UpdateBackupSet("crsAct", "TABLE")
|
||
*** UpdateBackupSet("pcText", "VARIABLE", m.pcText, "C")
|
||
*************************************************************************
|
||
Procedure UpdateBackupSet
|
||
Lparameters tcName, tcType, tuValue
|
||
*** tcName: numele cursorului sau variabilei (ex: crsAct, pcText)
|
||
*** tcType: TABLE/VARIABLE
|
||
*** tuValue: (optional) valoarea variabilei. Valoarea se salveaza direct in xml definitie backupset
|
||
|
||
Local lcFileName, lcName, lcType, lnBytes, lcSelect, lcValue, lcValueType
|
||
|
||
If !This.lBackupSetLoaded
|
||
Return .F.
|
||
Endif
|
||
|
||
lcSelect = Select()
|
||
|
||
lcName = Iif(!Empty(m.tcName), Alltrim(Transform(m.tcName)), "")
|
||
lcType = Iif(!Empty(m.tcType), m.tcType, "TABLE")
|
||
lcValue = Transform(m.tuValue)
|
||
lcValueType = Iif(Pcount() >= 3, Type('tuValue'), "")
|
||
|
||
Do Case
|
||
Case m.lcType = "TABLE"
|
||
lcValue = This.cBackupSet + "_" + m.lcName + ".xml"
|
||
Otherwise
|
||
*
|
||
Endcase
|
||
|
||
If !Empty(m.lcName)
|
||
Select (This.cBackupSet)
|
||
Locate For Name = Alltrim(tcName)
|
||
If !Found()
|
||
Insert Into (This.cBackupSet) (Type, Name, Value, valuetype) Values (m.lcType, m.lcName, m.lcValue, m.lcValueType)
|
||
Else
|
||
Replace Type With m.lcType, Value With m.lcValue, valuetype With m.lcValueType
|
||
Endif
|
||
lnBytes = Cursortoxml(This.cBackupSet, This.cBackupSetFile, 1, 2 + 512, 0, "1")
|
||
Endif
|
||
Select (m.lcSelect)
|
||
|
||
Endproc && UpdateBackupSet
|
||
|
||
Procedure Destroy
|
||
Local lcSelect
|
||
|
||
lcSelect = Select()
|
||
Use In (Select(This.cBackupSet))
|
||
Select (m.lcSelect)
|
||
Endproc && Destroy
|
||
|
||
Enddefine && BackupXML
|
||
|
||
Procedure romfast_suport
|
||
Local lcFile, lcPath, llOpen
|
||
lcFile = "romfast_suport.exe"
|
||
lcPath = Addbs(m.gcBasePath)
|
||
llOpen = .T.
|
||
|
||
Return DownloadSupportFile(m.lcFile, m.lcPath, m.llOpen)
|
||
Endproc && romfast_suport
|
||
|
||
Procedure DownloadSupportFile
|
||
Lparameters tcFile, tcDownloadPath, tlOpen, tlNewVersion
|
||
|
||
*** tlOpen: .T. daca se doreste deschiderea fisierului descarcat
|
||
*** tlNewVersion: OUT - .T. daca exista o versiune noua pe server
|
||
|
||
Local loUpdater As "Updater"
|
||
Local lcCheckSum, lcDownloadFile, lcDownloadPath, lcErrorMessage, lcFile, lcProgressProcedure, lcURL
|
||
Local llCheckVersion, llOpen, llReturn, loUpdateRec, llError
|
||
Local lcDownloadFileTemp
|
||
llError = .F.
|
||
|
||
Wait Window "Se cauta versiuni noi ale fisierului " + Justfname(m.tcFile) + " pe romfast.ro" Nowait
|
||
|
||
lcFile = Alltrim(m.tcFile) && "romfast_suport.exe"
|
||
lcDownloadPath = Addbs(m.tcDownloadPath)
|
||
llOpen = m.tlOpen
|
||
lcDownloadFile = m.lcDownloadPath + m.lcFile && d:\roa\romfast_suport.exe
|
||
llCheckVersion = .F.
|
||
|
||
loUpdater = Createobject("Updater", "", m.llCheckVersion)
|
||
If Type("loUpdater") = "O"
|
||
loUpdateRec = loUpdater.CheckNewVersion(m.lcFile, .T.)
|
||
tlNewVersion = loUpdateRec.NewVersion
|
||
If loUpdateRec.NewVersion Or !File(m.lcDownloadFile)
|
||
lcURL = Alltrim(loUpdateRec.fisier)
|
||
lcCheckSum = Alltrim(loUpdateRec.checksum)
|
||
lcProgressProcedure = ""
|
||
lcErrorMessage = ""
|
||
|
||
lcDownloadFileTemp = loUpdater.cDownloadPath + m.lcFile && d:\contafin\_update\romfast_suport.exe
|
||
llReturn = loUpdater.DownloadFile(m.lcURL, m.lcDownloadFileTemp, m.lcProgressProcedure, @m.lcErrorMessage, m.lcCheckSum)
|
||
If !loUpdater.lError
|
||
loUpdater.UpdateVersion(m.loUpdateRec)
|
||
If File(m.lcDownloadFileTemp)
|
||
Copy File (m.lcDownloadFileTemp) To (m.lcDownloadFile)
|
||
Delete File (m.lcDownloadFileTemp)
|
||
Endif
|
||
Endif
|
||
If !Empty(m.lcErrorMessage)
|
||
amessagebox(m.lcErrorMessage, 0 + 48, _Screen.Caption)
|
||
Endif
|
||
Endif
|
||
Else
|
||
llReturn = .F.
|
||
Endif
|
||
|
||
If m.llOpen And File(m.lcDownloadFile)
|
||
OPEN_DEFAULT_APP(m.lcDownloadFile)
|
||
Endif
|
||
|
||
Return m.llReturn
|
||
Endproc && DownloadSupportFile
|
||
|
||
|
||
|
||
Define Class Updater As Custom
|
||
cLicenta = "" && pentru CONTAFIN
|
||
cErrorMessage = ""
|
||
lError = .F.
|
||
cDownloadPath = ""
|
||
cFileVersionUrl = ""
|
||
cDownloadFileVersion = ""
|
||
|
||
Procedure Init
|
||
Lparameters tcFileVersionUrl, tlCheckVersion, tcVersionType
|
||
|
||
*** tcFileVersionUrl: URL fisier versiuni.xml (DEFAULT http://...contafin.xml)
|
||
*** tlCheckVersion: .T. = se verifica versiunile programelor din versiuni.xml
|
||
*** tcVersionType: CONTAFIN (DEFAULT); SUPORT
|
||
|
||
Local lcCheie, lcConnectTimeout, lcDownloadFileVersion, lcFileLicenta, lcFileVersionUrl
|
||
Local lcLibraryPath, lcLicenta, lcResponseTimeout, lcSettingsFile, lcVersionFileName, lcVersionType
|
||
Local llReturn, loEx
|
||
lcLicenta = ""
|
||
lcFileLicenta = m.gcBasePath + 'licente.cnt'
|
||
If File(m.lcFileLicenta)
|
||
m.lcLicenta = Alltrim(Filetostr(m.lcFileLicenta))
|
||
This.cLicenta = m.lcLicenta
|
||
Endif
|
||
|
||
|
||
lcLibraryPath = m.gcBasePath + Iif("ROA" $ Upper(gcBasePath), "COMUNROA", "COMUNCONTAFIN") + "\vfpconnection.fll" && CONTAFIN(ROA)\COMUNCONTAFIN(COMUNROA)\vfpconnection.fll
|
||
lcSettingsFile = m.gcBasePath + "settings.ini" && CONTAFIN(ROA)\settings.ini
|
||
|
||
If File(m.lcLibraryPath)
|
||
Try
|
||
If !'vfpconnection' $ Set("Library")
|
||
Set Library To (lcLibraryPath) Additive
|
||
Endif
|
||
lcConnectTimeout = goAPI.GetProfileString(m.lcSettingsFile, "update", "ConnectTimeout") && timeout conectare in secunde / default 20
|
||
lcConnectTimeout = Nvl(lcConnectTimeout, '')
|
||
lcResponseTimeout = goAPI.GetProfileString(m.lcSettingsFile, "update", "ResponseTimeout") && timeout raspuns in secunde / default 60
|
||
lcResponseTimeout = Nvl(lcResponseTimeout, '')
|
||
If Empty(m.lcConnectTimeout)
|
||
goAPI.WriteProfileString(m.lcSettingsFile, "update", "ConnectTimeout", "20") && frecventa verificarii
|
||
lcConnectTimeout = "20"
|
||
Endif
|
||
If Empty(m.lcResponseTimeout)
|
||
goAPI.WriteProfileString(m.lcSettingsFile, "update", "ResponseTimeout", "60") && frecventa verificarii
|
||
lcResponseTimeout = "60"
|
||
Endif
|
||
|
||
SetConnectTimeout(Val(lcConnectTimeout)) && Default is 10 seconds
|
||
SetResponseTimeout(Val(lcResponseTimeout)) && Default is 10 seconds
|
||
|
||
|
||
This.cDownloadPath = m.gcBasePath + '_UPDATE\' && D:\CONTAFIN\_UPDATE\
|
||
|
||
If !Directory(This.cDownloadPath)
|
||
Md (This.cDownloadPath)
|
||
Endif
|
||
|
||
lcDownloadFileVersion = This.cDownloadPath + "versiune.xml"
|
||
This.cDownloadFileVersion = lcDownloadFileVersion
|
||
|
||
lcLicenta = ""
|
||
lcFileLicenta = m.gcBasePath + 'licente.cnt'
|
||
If File(m.lcFileLicenta)
|
||
m.lcLicenta = Alltrim(Filetostr(m.lcFileLicenta))
|
||
This.cLicenta = m.lcLicenta
|
||
Endif
|
||
|
||
**********************************************************
|
||
*** Citesc fileversionurl din CONTAFIN(ROA)\SETTINGS.INI
|
||
**********************************************************
|
||
*** FileVersionUrl = http://83.103.197.79:3002/contafinupdate/default.aspx/update/download/|licenta|/contafin_local.xml
|
||
*** FileVersionUrl = http://10.0.20.122:81/contafinupdate/default.aspx/update/download/|licenta|/contafin_local.xml
|
||
lcVersionType = Upper(Alltrim(Transform(m.tcVersionType)))
|
||
lcCheie = Iif(lcVersionType = 'CONTAFIN', 'fileversionurl', 'suportversionurl')
|
||
lcVersionFileName = Iif(lcVersionType = 'CONTAFIN', 'contafin', 'suport')
|
||
|
||
If !Empty(m.tcFileVersionUrl)
|
||
lcFileVersionUrl = m.tcFileVersionUrl
|
||
Else
|
||
lcFileVersionUrl = goAPI.GetProfileString(m.lcSettingsFile, [update], m.lcCheie)
|
||
lcFileVersionUrl = Nvl(m.lcFileVersionUrl, '')
|
||
If Empty(m.lcFileVersionUrl)
|
||
*!* 13.05.2014 cand s-a introdus taxa la dyndns, am pus ip-ul fix
|
||
*!* lcFileVersionUrl = [http://] + IIF(_vfp.StartMode = 0, [10.0.20.122:81] , [romfast.dyndns.biz:3002]) + [/contafinupdate/default.aspx/update/download/|licenta|/] + ;
|
||
*!* m.lcVersionFileName + [.xml]
|
||
lcFileVersionUrl = [http://] + Iif(_vfp.StartMode = 0, [10.0.20.122:81], [83.103.197.79:3002]) + [/contafinupdate/default.aspx/update/download/|licenta|/] + ;
|
||
M.lcVersionFileName + [.xml]
|
||
*!* 13.05.2014 ^
|
||
goAPI.WriteProfileString(m.lcSettingsFile, [update], m.lcCheie, m.lcFileVersionUrl )
|
||
Else
|
||
*!* 13.05.2014 cand s-a introdus taxa la dyndns, am pus ip-ul fix
|
||
|
||
If [romfast.dyndns.biz] $ lcFileVersionUrl
|
||
lcFileVersionUrl = Strtran(lcFileVersionUrl, [romfast.dyndns.biz], [83.103.197.79])
|
||
goAPI.WriteProfileString(m.lcSettingsFile, [update], m.lcCheie, m.lcFileVersionUrl )
|
||
Endif
|
||
*!* 13.05.2014 ^
|
||
|
||
Endif
|
||
Endif
|
||
This.cFileVersionUrl = m.lcFileVersionUrl
|
||
|
||
*!* DESCARCARE FISIER VERSIUNE
|
||
If File(m.lcDownloadFileVersion)
|
||
Delete File (m.lcDownloadFileVersion)
|
||
Endif
|
||
llReturn = This.DownloadVersionFile(m.tlCheckVersion)
|
||
|
||
Catch To loEx
|
||
This.lError = .T.
|
||
This.cErrorMessage = loEx.Message
|
||
amessagebox(This.cErrorMessage, 0 + 16, _Screen.Caption)
|
||
Endtry
|
||
Else
|
||
This.lError = .T.
|
||
This.cErrorMessage = "Nu exista fisierul " + m.lcLibraryPath + "!"
|
||
amessagebox(This.cErrorMessage, 0 + 16, _Screen.Caption)
|
||
Endif
|
||
|
||
Endproc && Init
|
||
|
||
*!* verificare versiune diferita
|
||
Procedure CheckNewVersion
|
||
Lparameters tcAppName, tlCheckVersion
|
||
|
||
Local lcSelect, lcAppName
|
||
Local loReturn
|
||
lcSelect = Select()
|
||
lcAppName = Upper(Juststem(Alltrim(m.tcAppName)))
|
||
|
||
If Used('crsXML')
|
||
If m.tlCheckVersion
|
||
This.CheckVersion(m.lcAppName)
|
||
Endif
|
||
Select crsXMl
|
||
Locate For Upper(Alltrim(Program)) = lcAppName
|
||
If Found()
|
||
Scatter Name loReturn
|
||
AddProperty(loReturn, "newversion", Alltrim(versiune) <> Alltrim(versiuneact))
|
||
Else
|
||
Scatter Name loReturn Blank
|
||
AddProperty(loReturn, "newversion", .F.)
|
||
Endif
|
||
Else
|
||
loReturn = Createobject("custom")
|
||
loReturn.AddProperty("newversion", .F.)
|
||
Endif
|
||
|
||
Select (lcSelect)
|
||
|
||
Return m.loReturn
|
||
Endproc && CheckNewVersion
|
||
|
||
Procedure DownloadVersionFile
|
||
Lparameters tlCheckVersion
|
||
|
||
Local llReturn, lcFileVersionUrl, lcDownloadFileVersion, lcTextXML
|
||
Local loEx As Exception
|
||
|
||
lcFileVersionUrl = This.cFileVersionUrl
|
||
lcDownloadFileVersion = This.cDownloadFileVersion
|
||
|
||
****** DOWNLOAD FISIER CU ULTIMELE VERSIUNI ALE PROGRAMELOR EX:CONTAFIN.XML ******** ^
|
||
llReturn = This.DownloadFile(m.lcFileVersionUrl, m.lcDownloadFileVersion)
|
||
llReturn = m.llReturn And File(m.lcDownloadFileVersion)
|
||
If This.lError
|
||
Messagebox(This.cErrorMessage, 0 + 64, _Screen.Caption)
|
||
Endif
|
||
****** DOWNLOAD FISIER CU ULTIMELE VERSIUNI ALE PROGRAMELOR EX:CONTAFIN.XML ******** ^
|
||
Create Cursor crsXMl (Program C(200), fisier C(200), Log C(200), checksum C(100), versiune C(200), versiuneact C(100), ales N(1), Terminat N(1))
|
||
If m.llReturn
|
||
lcTextXML = Filetostr(m.lcDownloadFileVersion)
|
||
If Left(m.lcTextXML, 5) <> '<?xml'
|
||
Messagebox('Serverul de actualizari este ocupat. Incercati mai tarziu.' + Chr(13) + Chr(10) + ;
|
||
'Daca problema persista, apelati suportul tehnic.', 0 + 64, _Screen.Caption)
|
||
Else
|
||
Try
|
||
Xmltocursor(m.lcDownloadFileVersion, "crsXmlTemp", 512)
|
||
|
||
Select crsXMl
|
||
Append From Dbf('crsXMLTemp')
|
||
*!*
|
||
*!* Select Program, fisier, Log, versiune, checksum, Space(100) As versiuneact, 0 As ales, 0 As Terminat ;
|
||
*!* FROM crsXmlTemp ;
|
||
*!* INTO Cursor crsXMl Readwrite
|
||
Use In (Select('crsXmlTemp'))
|
||
|
||
Catch To loEx
|
||
goLog.WriteLog("DOWNLOADVERSIONFILE; " + loEx.Message + " " + m.lcDownloadFileVersion, Program())
|
||
Messagebox(loEx.Message + " " + m.lcDownloadFileVersion, 0 + 16, _Screen.Caption)
|
||
Endtry
|
||
Endif
|
||
Endif
|
||
|
||
*** completez versiunea programelor in xml
|
||
If m.tlCheckVersion
|
||
This.CheckVersion()
|
||
Endif
|
||
|
||
Return m.llReturn
|
||
|
||
Endproc && DownloadVersionFile
|
||
|
||
Procedure CheckVersion
|
||
Lparameters tcProgram
|
||
|
||
Local lcFilter, lcSelect
|
||
lcSelect = Select()
|
||
|
||
*!* scanez cursorul cu ultimele versiuni ale programelor
|
||
*!* aflu versiunea actuala a exe-urilor de pe calculatorul client
|
||
lcFilter = Iif(!Empty(m.tcProgram), [upper(ALLTRIM(program)) = UPPER(JUSTSTEM(ALLTRIM(m.tcProgram)))], [.T.])
|
||
Select crsXMl
|
||
Scan For &lcFilter
|
||
lcProgram = Lower(Alltrim(Program)) && CONCONT
|
||
lcFile = gcBasePath + lcProgram + "\" + Alltrim(lcProgram) + '.EXE' && D:\CONTAFIN\CONCONT\CONCONT.EXE
|
||
lcFileVersiuneText = gcBasePath + lcProgram + "\VERSIUNE.TXT" && D:\CONTAFIN\_ALFA\VERSIUNE.TXT
|
||
lcSettingsFile = m.gcBasePath + "settings.ini" && D:\CONTAFIN\settings.ini
|
||
|
||
If File(lcFile)
|
||
Dimension aFiles[4]
|
||
lnItems = Agetfileversion(aFiles, lcFile)
|
||
lcVersiune = ''
|
||
If lnItems >= 4
|
||
lcVersiune = aFiles(4)
|
||
Endif
|
||
Replace versiuneact With m.lcVersiune
|
||
Else
|
||
&& verific daca exista versiune.txt (in cazul _alfa care nu are executabil)
|
||
If File(lcFileVersiuneText)
|
||
lcVersiune = Alltrim(Filetostr(m.lcFileVersiuneText))
|
||
Replace versiuneact With m.lcVersiune
|
||
Else
|
||
lcVersiune = goAPI.GetProfileString(m.lcSettingsFile, [versiuni], m.lcProgram)
|
||
Replace versiuneact With Nvl(m.lcVersiune, '')
|
||
Endif
|
||
Endif
|
||
Endscan
|
||
*!* scanez cursorul cu ultimele versiuni ale programelor ^
|
||
Select (m.lcSelect)
|
||
Endproc && CheckVersion
|
||
|
||
Procedure UpdateVersion
|
||
Lparameters toUpdateRec
|
||
If Type('toUpdateRec') = 'O' And Type('toUpdateRec.versiune') <> 'U'
|
||
lcProgram = Alltrim(toUpdateRec.Program)
|
||
lcVersiune = Alltrim(toUpdateRec.versiune)
|
||
lcSettingsFile = m.gcBasePath + "settings.ini" && D:\CONTAFIN\settings.ini
|
||
|
||
goAPI.WriteProfileString(m.lcSettingsFile, [versiuni], m.lcProgram, m.lcVersiune)
|
||
Endif
|
||
Endproc && UpdateVersion
|
||
|
||
|
||
Procedure DownloadFile
|
||
Lparameters tcUrl, tcDownloadFile, tcProgressProcedure, tcErrorMessage, tcCheckSum
|
||
Local lcURL, llReturn, lcDownloadFile, lcProgressProcedure, lcText, lcCheckSum, llDownload
|
||
Local lcCheckSumFile
|
||
|
||
lcText = 'Nu s-a putut actualiza fisierul ' + Justfname(m.tcDownloadFile) + ' de pe serverul ROMFAST. Verificati conexiunea internet si/sau setarile de actualizare!'
|
||
If Empty(tcCheckSum) Or Type('tcCheckSum') <> 'C'
|
||
lcCheckSum = ""
|
||
Else
|
||
lcCheckSum = tcCheckSum
|
||
Endif
|
||
|
||
goLog.WriteLog("DOWNLOAD START; " + Alltrim(m.tcUrl) + " | " + Alltrim(m.tcDownloadFile), Program())
|
||
|
||
lcURL = Alltrim(m.tcUrl)
|
||
lcURL = This.ReplaceLicentaTag(m.lcURL)
|
||
lcDownloadFile = Alltrim(m.tcDownloadFile)
|
||
lcProgressProcedure = Iif(Type('tcProgressProcedure') <> 'C', '', tcProgressProcedure)
|
||
|
||
&& daca am checksumul ca parametru, exista fisierul si checksumurile sunt egale nu mai downloadez
|
||
llDownload = .T.
|
||
If File(m.lcDownloadFile) && verific daca exista fisierul deja downloadat TODO: trebuie verificat hashul
|
||
If !Empty(m.lcCheckSum)
|
||
lcCheckSumFile = This.CalculateCheckSum(m.lcDownloadFile)
|
||
If m.lcCheckSum == m.lcCheckSumFile && checksumurile sunt egale
|
||
llDownload = .F.
|
||
goLog.WriteLog("FISIERUL " + Alltrim(m.tcDownloadFile) + " EXISTA DEJA IN DIRECTORUL DE DOWNLOAD SI ARE ACELASI CHECKSUM CA CEL DE PE SERVER.", Program())
|
||
Else
|
||
goLog.WriteLog("FISIERUL " + Alltrim(m.tcDownloadFile) + " EXISTA DEJA IN DIRECTORUL DE DOWNLOAD, DAR NU ARE ACELASI CHECKSUM CA CEL DE PE SERVER.", Program())
|
||
Endif
|
||
Endif
|
||
Endif
|
||
|
||
llReturn = .F.
|
||
Do Case
|
||
Case !llDownload
|
||
llReturn = .T.
|
||
|
||
Case Upper(Left(lcURL, 4)) = "FTP:"
|
||
m.llReturn = FTPGet(lcURL, m.lcDownloadFile, lcProgressProcedure)
|
||
|
||
Case Upper(Left(lcURL, 5)) = "HTTP:" OR Upper(Left(lcURL, 6)) = "HTTPS:"
|
||
m.llReturn = HTTPDownloadFile(lcURL, m.lcDownloadFile)
|
||
|
||
Otherwise
|
||
If Upper(Left(lcURL, 7)) != "FILE://"
|
||
lcURL = "File://" + lcURL
|
||
Endif
|
||
m.llReturn = FileGet(lcURL, m.lcDownloadFile, lcProgressProcedure)
|
||
|
||
Endcase
|
||
|
||
*!* verific ca exista fisierul
|
||
llReturn = m.llReturn And File(m.lcDownloadFile)
|
||
|
||
*!* verific continutul fisierului
|
||
If m.llReturn
|
||
lcText = Filetostr(m.lcDownloadFile)
|
||
llReturn = Left(Lower(m.lcText), 3) <> 'err' And Left(Lower(m.lcText), 6) <> '<html>'
|
||
Endif
|
||
|
||
*!* verific checksum daca fisierul a fost downloadat
|
||
If llReturn And llDownload And !Empty(lcCheckSum)
|
||
lcCheckSumFile = This.CalculateCheckSum(m.lcDownloadFile)
|
||
If m.lcCheckSum <> m.lcCheckSumFile
|
||
m.lcText = 'Checksumul fisierului ' + m.lcDownloadFile + ' nu corespunde cu checksumul fisierului de pe server.'
|
||
llReturn = .F.
|
||
Endif
|
||
Endif
|
||
|
||
If !llReturn
|
||
tcErrorMessage = Left(m.lcText, 100)
|
||
This.cErrorMessage = tcErrorMessage
|
||
This.lError = .T.
|
||
Else
|
||
This.cErrorMessage = ""
|
||
This.lError = .F.
|
||
Endif
|
||
|
||
|
||
goLog.WriteLog("DOWNLOAD END; " + + Alltrim(m.tcUrl) + " | " + Alltrim(m.tcDownloadFile) + Iif(m.llReturn, " SUCCES", " " + Left(lcText, 100) + " EROARE"), Program())
|
||
|
||
Return m.llReturn
|
||
|
||
Endproc && DownloadFile
|
||
|
||
*!*
|
||
*!* UPDATE STATUS FORMULAR
|
||
*!* APELAT DIN THIS.UPDATEFILE
|
||
*!*
|
||
Procedure UpdateStatus
|
||
Lparameters tcStatusVariable, tcStatus
|
||
Local lcStatusVariable, lcStatus, lcUpdateStatus
|
||
|
||
lcStatusVariable = Iif(!Empty(tcStatusVariable) And Type('tcStatusVariable') = 'C', tcStatusVariable, '')
|
||
lcStatus = Iif(!Empty(tcStatus) And Type('tcStatus') = 'C', tcStatus, '')
|
||
|
||
If !Empty(lcStatusVariable)
|
||
lcUpdateStatus = lcStatusVariable + [ = "] + lcStatus + ["]
|
||
&lcUpdateStatus
|
||
If Right(Upper(lcStatusVariable), 8) = '.CAPTION'
|
||
lcStatusObject = Left(lcStatusVariable, Len(lcStatusVariable) - 8)
|
||
loStatusObject = Evaluate(lcStatusObject)
|
||
If Pemstatus(loStatusObject, "refresh", 5)
|
||
loStatusObject.Refresh()
|
||
Endif
|
||
Endif
|
||
Endif
|
||
|
||
Endproc && UpdateStatus
|
||
|
||
Procedure ProgressHandler
|
||
Lparameters tcFile
|
||
Local lnProgress, lcFile
|
||
|
||
lnProgress = 0
|
||
lcFile = Iif(Empty(m.tcFile) Or Type('tcFile') <> 'C', '', m.tcFile)
|
||
If m.nConnectTotalBytes > 0
|
||
m.lnProgress = Int(m.nConnectBytesSoFar / m.nConnectTotalBytes * 100)
|
||
Endif
|
||
|
||
Wait Window m.lcFile + ' ' + Transform(m.lnProgress) + '% ...' Nowait
|
||
Endproc && ProgressHandler
|
||
|
||
Function CalculateCheckSum
|
||
Lparameters tcFile
|
||
Local lcCheckSum, lcText
|
||
lcCheckSum = ""
|
||
If File(tcFile)
|
||
lcText = Filetostr( m.tcFile)
|
||
lcCheckSum = Sys(2007, m.lcText, 0, 1)
|
||
Endif
|
||
Return m.lcCheckSum
|
||
|
||
Endfunc && CalculateCheckSum
|
||
|
||
Function ReplaceLicentaTag
|
||
Lparameters tcText
|
||
Local lcText, lcReturn
|
||
|
||
lcText = Iif(Empty(tcText) Or Type('tcText') <> 'C', "", tcText)
|
||
lcReturn = Iif(!Empty(This.cLicenta), Strtran(m.lcText, '|licenta|', This.cLicenta, 1, 1, 1), m.lcText) && inlocuiesc |licenta|
|
||
|
||
Return m.lcReturn
|
||
|
||
Endfunc && ReplaceLicentaTag
|
||
|
||
Procedure Destroy
|
||
|
||
Local lcSelect
|
||
lcSelect = Select()
|
||
|
||
If File(This.cDownloadFileVersion)
|
||
Erase (This.cDownloadFileVersion)
|
||
Endif
|
||
|
||
Use In (Select('crsXML'))
|
||
Select (lcSelect)
|
||
|
||
Endproc && Destroy
|
||
|
||
Enddefine && Updater
|
||
|
||
|
||
PROCEDURE verificare_iban
|
||
Lparameters tcXMLIBAN
|
||
*** tcXMLIBAN: un xml cu codurile IBAN care trebuie verificate, 2 sau 3 coloane: "denumire", "cod_fiscal", "iban"
|
||
|
||
If Left(Lower(tcXMLIBAN), 5) = "<?xml"
|
||
Xmltocursor(tcXMLIBAN, 'crsXMLIBANVerificare') && denumire, cod_fiscal, iban
|
||
ENDIF
|
||
CREATE CURSOR crsVerificareIBAN (denumire C(100), cod_fiscal C(30) NULL, cont_banca C(30) NULL, valid L)
|
||
Select crsVerificareIBAN
|
||
Append From Dbf('crsXMLIBANVerificare')
|
||
|
||
lcCoduriValide = ''
|
||
lcCoduriInvalide = ''
|
||
SELECT crsVerificareIBAN
|
||
SCAN FOR !EMPTY(NVL(cont_banca,''))
|
||
lcIBAN = ALLTRIM(NVL(cont_banca,''))
|
||
lcDenumire = ALLTRIM(NVL(denumire,''))
|
||
lcCodFiscal = ALLTRIM(NVL(cod_fiscal,''))
|
||
llValid = verifiban(m.lcIBAN)
|
||
IF !m.llValid
|
||
lcCoduriInvalide = lcCoduriInvalide + m.lcDenumire + IIF(!EMPTY(m.lcCodFiscal), " (" + m.lcCodFiscal + ")", "") + " : " + m.lcIBAN + CHR(13) + CHR(10)
|
||
ELSE
|
||
lcCoduriValide = lcCoduriValide + m.lcDenumire + IIF(!EMPTY(m.lcCodFiscal), " (" + m.lcCodFiscal + ")", "") + " : " + m.lcIBAN + CHR(13) + CHR(10)
|
||
ENDIF
|
||
ENDSCAN
|
||
USE IN (SELECT('crsVerificareIBAN'))
|
||
AMESSAGEBOX('CODURI INVALIDE' + CHR(13) + CHR(10) + m.lcCoduriInvalide + CHR(13) + CHR(10) + CHR(13) + CHR(10) + 'CODURI VALIDE' + CHR(13) + CHR(10) + m.lcCoduriValide,0,_screen.caption)
|
||
Use In (Select('crsXMLIBANVerificare'))
|
||
ENDPROC
|
||
****************************************************
|
||
*** verificare validitate CNP/CIF, TVA VIES, info MFIN
|
||
****************************************************
|
||
Procedure verificare_parteneri
|
||
Lparameters tcXMLParteneri, tlValidare, tlMFIN, tlVIES, tlAutoVerificare, tlDontCloseCursor, tlExperimental, tlServiciuWebANAF
|
||
*** tcXMLParteneri: un xml cu partenerii care trebuie verificati, 2 sau 3 coloane: "denumire", "cod_fiscal", "atribut_fiscal", "ales", ["dataact"]
|
||
*** tcXMLParteneri: un sir cod_fiscal***denumire|cod_fiscal***denumire sau cod_fiscal***denumire***atribut_fiscal|cod_fiscal***denumire***atribut_fiscal
|
||
*** tlValidare: .T. = se valideaza codurile
|
||
*** tlMFIN: .T. = se verifica info mfinante.ro
|
||
*** tlVIES: .T. = se verifica info VIES
|
||
*** tlAutoVerificare: .T. daca se lanseaza automat verificarea pe activate-ul formularului
|
||
*** tlDontCloseCursor: .F. se inchide cursorul crsVerificareParteneri
|
||
*** tlExperimental: .T. se face verificarea la mfinante.ro fara captcha, fara pauze intre interogari, cu request diferit pentru fiecare cod
|
||
*** tlServiciuWebANAF: .T. se verifica prin serviciul web ANAF, cate 500 de coduri fiscale per interogare
|
||
|
||
Local loVerificareParteneri As "frm_verificare_parteneri"
|
||
Local lcAtributFiscal, lcCodFiscal, lcDenumire, lcItem, lnNrParteneri, lnPartener, lnProprietate
|
||
Local lnProprietati, lnIdPart, llAles
|
||
|
||
If Left(Lower(tcXMLParteneri), 5) = "<?xml"
|
||
Xmltocursor(tcXMLParteneri, 'crsXMLParteneriVerificare') && denumire, cod_fiscal, [atribut_fiscal], [ales], [data]
|
||
Else
|
||
Create Cursor crsXMLParteneriVerificare (cod_fiscal C(30), denumire C(100), atribut_fiscal C(2), ales L, dataact D)
|
||
lnNrParteneri = Getwordcount(tcXMLParteneri, "|")
|
||
For lnPartener = 1 To lnNrParteneri
|
||
lcItem = Getwordnum(tcXMLParteneri, m.lnPartener, "|")
|
||
If !Empty(m.lcItem)
|
||
lnProprietati = Getwordcount(m.lcItem, "***")
|
||
lcCodFiscal = ""
|
||
lcDenumire = ""
|
||
lcAtributFiscal = ""
|
||
llAles = .F.
|
||
lnIdPart = 0
|
||
ldDataAct = DATE(m.gnAn, m.gnLuna, 1)
|
||
For lnProprietate = 1 To m.lnProprietati
|
||
If lnProprietate = 1
|
||
lcCodFiscal = Alltrim(Getwordnum(m.lcItem, m.lnProprietate, "***"))
|
||
Endif
|
||
If lnProprietate = 2
|
||
lcDenumire = Alltrim(Getwordnum(m.lcItem, m.lnProprietate, "***"))
|
||
Endif
|
||
If lnProprietate = 3
|
||
lcAtributFiscal = Alltrim(Getwordnum(m.lcItem, m.lnProprietate, "***"))
|
||
Endif
|
||
If lnProprietate = 4
|
||
llAles = Inlist(Upper(Alltrim(Getwordnum(m.lcItem, m.lnProprietate, "***"))), '1', 'T', '.T.')
|
||
Endif
|
||
If lnProprietate = 5
|
||
lnIdPart = Int(Val(Upper(Alltrim(Getwordnum(m.lcItem, m.lnProprietate, "***")))))
|
||
Endif
|
||
If lnProprietate = 6
|
||
ldDataAct = CTOD(Getwordnum(m.lcItem, m.lnProprietate, "***"))
|
||
Endif
|
||
Endfor
|
||
|
||
lcAtributFiscal = Iif(!Empty(m.lcAtributFiscal), m.lcAtributFiscal, Iif(Left(Upper(lcCodFiscal), 2) = 'RO', 'RO', ''))
|
||
Insert Into crsXMLParteneriVerificare (cod_fiscal, denumire, atribut_fiscal, ales, id_part, data) Values (m.lcCodFiscal, m.lcDenumire, m.lcAtributFiscal, m.llAles, m.lnIdPart, m.ldDataAct)
|
||
Endif
|
||
Endfor
|
||
Endif
|
||
|
||
Create Cursor crsVerificareParteneri (ales L, denumire C(100) Null, cod_fiscal C(30) Null, Valid L Null, firma C(100) Null, cod C(100) Null, adresa_roa C(250) Null, adresa C(250) Null, ;
|
||
judet C(100) Null, regcom C(30) Null, codpostal C(20) Null, telefon C(30) Null, fax C(30) Null, ;
|
||
datatvamfin C(30) Null, platitortvamfin L Null, VIES L Null, PlatitorTVA L Null, eroare C(250) Null, IsCIF L Null, duplicat L, atribut_fiscal C(2), stare C(100), atentie C(100), cod_fiscalfro C(30) Null, id_part N(16), ;
|
||
tvaincasare L, splittva L, inactiv L, Data D)
|
||
|
||
Select crsVerificareParteneri
|
||
Append From Dbf('crsXMLParteneriVerificare')
|
||
Use In (Select('crsXMLParteneriVerificare'))
|
||
|
||
Update crsVerificareParteneri Set IsCIF = .T.
|
||
|
||
loVerificareParteneri = Createobject("frm_verificare_parteneri", m.tlValidare, m.tlMFIN, m.tlVIES, m.tlAutoVerificare, m.tlExperimental, m.tlServiciuWebANAF) && parteneri.vcx
|
||
loVerificareParteneri.Show(1)
|
||
If !m.tlDontCloseCursor
|
||
Use In (Select('crsVerificareParteneri'))
|
||
Endif
|
||
|
||
Return 'crsVerificareParteneri'
|
||
|
||
Endproc && verificare_parteneri
|
||
|
||
Procedure verificare_parteneri_istoric
|
||
Lparameters tcCodFiscal, tcNume
|
||
|
||
Local lcSql, lcSelect, llSucces, loVerificareParteneriIstoric
|
||
Private pcCodFiscal
|
||
lcSelect = Select()
|
||
|
||
pcCodFiscal = Alltrim(m.tcCodFiscal)
|
||
If Isalpha(m.pcCodFiscal)
|
||
pcCodFiscal = Alltrim(Substr(m.pcCodFiscal, 2))
|
||
If Isalpha(m.pcCodFiscal)
|
||
pcCodFiscal = Alltrim(Substr(m.pcCodFiscal, 2))
|
||
Endif
|
||
Endif
|
||
|
||
Text To lcSql Noshow
|
||
select id, dataora, id_util, dataorav, id_utilv, cod_fiscal, firma, adresa, judet, regcom, codpostal, telefon, fax, datatvamfin, platitortvamfin, stare, platitortvavies, util, utilv
|
||
from vistoric_coduri_fiscale
|
||
where cod_fiscal = ?pcCodFiscal
|
||
Endtext
|
||
|
||
llSucces = goExecutor.oExecuta(m.lcSql, "crsVerificareParteneriIstoric")
|
||
If m.llSucces
|
||
loVerificareParteneriIstoric = Createobject("frm_verificare_parteneri_istoric", m.tcCodFiscal, m.tcNume) && parteneri.vcx
|
||
loVerificareParteneriIstoric.Show(1)
|
||
Endif
|
||
|
||
Use In (Select('crsVerificareParteneriIstoric'))
|
||
Select (m.lcSelect)
|
||
|
||
Endproc && verificare_parteneri_istoric
|
||
|
||
**************************************************************
|
||
*** verifica un cod fiscal pe mfinante.ro la adaugare partener (frm_partener_nou), alegere partener (cautalf)
|
||
*** intoarce cod valid L
|
||
**************************************************************
|
||
Procedure verifica_partener
|
||
Lparameters tcTipVerificare, toPartener, toPartenerVerificare
|
||
*** tcTipVerificare: 0/VALIDARE, 1/MFIN_AUTO_FARA_CAPTCHA,2/MFIN_AUTO_CU_CAPTCHA,3/MFIN_MANUAL_COD,4/MFIN_MANUAL_NUME,5/ANAF_MANUAL_COD,6/ANAF_MANUAL_NUME,7/RTVAI_MANUAL_COD
|
||
*** toPartener(cod_fiscal, denumire, cod_judet, cod_auto): IN, obiect cu datele partenerului
|
||
*** toPartenerVerificare: OUT, obiect verificare mfinante.ro pentru MFIN_AUTO_FARA_CAPTCHA, MFIN_AUTO_CU_CAPTCHA
|
||
|
||
Local loVerificare As "verificarecod"
|
||
Local lcCodAuto, lcCodFiscal, lcCodJudet, lcDenumire, lcTipVerificare, lcXml, llIsCIF, llValid, lnCIFPart
|
||
Local ldDataAct
|
||
*:Global tcEroare
|
||
lcCodFiscal = ""
|
||
lcCodAuto = ""
|
||
lcCodJudet = ""
|
||
lcDenumire = ""
|
||
lcTipVerificare = "VALIDARE"
|
||
lcXml = ""
|
||
llIsCIF = .F.
|
||
lnCIFPart = 0
|
||
llValid = .F.
|
||
tcEroare = ""
|
||
|
||
ldDataAct = DATE()
|
||
|
||
If Type('tcTipVerificare') = 'N'
|
||
Do Case
|
||
Case tcTipVerificare = 0
|
||
lcTipVerificare = 'VALIDARE'
|
||
Case tcTipVerificare = 1
|
||
lcTipVerificare = 'MFIN_AUTO_FARA_CAPTCHA'
|
||
Case tcTipVerificare = 2
|
||
lcTipVerificare = 'MFIN_AUTO_CU_CAPTCHA'
|
||
Case tcTipVerificare = 3
|
||
lcTipVerificare = 'MFIN_MANUAL_COD'
|
||
Case tcTipVerificare = 4
|
||
lcTipVerificare = 'MFIN_MANUAL_NUME'
|
||
Case tcTipVerificare = 5
|
||
lcTipVerificare = 'ANAF_MANUAL_COD'
|
||
Case tcTipVerificare = 6
|
||
lcTipVerificare = 'ANAF_MANUAL_NUME'
|
||
Case tcTipVerificare = 7
|
||
lcTipVerificare = 'RTVAI_MANUAL_COD'
|
||
Case tcTipVerificare = 8
|
||
lcTipVerificare = 'RTVAI_AUTO_COD'
|
||
Case tcTipVerificare = 9
|
||
lcTipVerificare = 'VIES_AUTO'
|
||
Case tcTipVerificare = 10
|
||
lcTipVerificare = 'VIES_MANUAL'
|
||
Endcase
|
||
Else
|
||
lcTipVerificare = Iif(!Empty(m.tcTipVerificare), Upper(Alltrim(m.tcTipVerificare)), "VALIDARE")
|
||
Endif
|
||
|
||
|
||
loVerificare = Createobject("verificarecod") && validare.prg
|
||
|
||
If Type('toPartener') = 'O'
|
||
lcCodFiscal = Iif(Pemstatus(toPartener, "cod_fiscal", 5), Alltrim(toPartener.cod_fiscal), '')
|
||
lcDenumire = Iif(Pemstatus(toPartener, "denumire", 5), Alltrim(Upper(toPartener.denumire)), '')
|
||
lcCodJudet = Iif(Pemstatus(toPartener, "cod_judet", 5), Alltrim(Upper(toPartener.cod_judet)), '')
|
||
lcCodAuto = Iif(Pemstatus(toPartener, "cod_auto", 5), Alltrim(Upper(toPartener.cod_auto)), '')
|
||
ldDataAct = Iif(Pemstatus(toPartener, "dataact", 5), toPartener.dataact, {})
|
||
lnCIFPart = Iif(Pemstatus(toPartener, "iscif", 5), Iif(toPartener.IsCIF, 1, 2), 0) && 0 = nu are proprietatea CIF, 1 = CIF pers juridica, 2 = CNP pers fizica
|
||
Else
|
||
lcCodFiscal = Transform(toPartener)
|
||
Endif
|
||
|
||
*** DOAR VERIFICARE MANUALA
|
||
Do Case
|
||
Case Inlist(m.lcTipVerificare, "MFIN_MANUAL_COD", "MFIN_MANUAL_NUME")
|
||
Do VERIFICA_MANUAL_MFINANAF With m.lcTipVerificare, m.lcCodFiscal, m.lcDenumire, m.lcCodJudet && in proceduri_comune.prg
|
||
Case Inlist(m.lcTipVerificare, "ANAF_MANUAL_COD", "ANAF_MANUAL_NUME")
|
||
Do VERIFICA_MANUAL_MFINANAF With m.lcTipVerificare, m.lcCodFiscal, m.lcDenumire, m.lcCodAuto && in proceduri_comune.prg
|
||
Case Inlist(m.lcTipVerificare, "RTVAI_MANUAL_COD")
|
||
Do VERIFICA_MANUAL_MFINANAF With m.lcTipVerificare, m.lcCodFiscal, m.lcDenumire, m.lcCodAuto && in proceduri_comune.prg
|
||
Case Inlist(m.lcTipVerificare, "VIES_MANUAL")
|
||
Do VERIFICA_MANUAL_MFINANAF With m.lcTipVerificare, m.lcCodFiscal, m.lcDenumire, m.lcCodAuto && in proceduri_comune.prg
|
||
Endcase
|
||
|
||
If Empty(m.lcCodFiscal)
|
||
Return m.llValid
|
||
Endif
|
||
|
||
llIsCIF = Iif(lnCIFPart = 0, loVerificare.IsCIF(m.lcCodFiscal), (lnCIFPart = 1))
|
||
|
||
*!* VERIFIC VALIDITATEA CODULUI
|
||
If llIsCIF
|
||
llValid = loVerificare.Validare('CIF', m.lcCodFiscal)
|
||
Else
|
||
llValid = loVerificare.Validare('CNP', m.lcCodFiscal)
|
||
Endif
|
||
|
||
|
||
*** DOAR VERIFICARE VALIDITATE
|
||
If m.lcTipVerificare = "VALIDARE" Or 'MANUAL' $ lcTipVerificare
|
||
Return m.llValid
|
||
Endif
|
||
|
||
*!* DOAR PENTRU CIF-URI VERIFIC DENUMIREA, REG_COMERT, CALITATEA DE PLATITOR TVA
|
||
If m.llIsCIF
|
||
Do Case
|
||
Case m.lcTipVerificare = 'ANAF_SERVICIU_WEB'
|
||
lcXml = loVerificare.Verificare('CIF', m.lcCodFiscal, 'ANAF', m.ldDataAct)
|
||
Otherwise
|
||
If m.lcTipVerificare = 'MFIN_AUTO_FARA_CAPTCHA'
|
||
loVerificare.lOneSession = .F.
|
||
loVerificare.lCaptcha = .F.
|
||
Endif
|
||
lcXml = loVerificare.Verificare('CIF', m.lcCodFiscal, IIF(m.lcTipVerificare = 'VIES_AUTO', 'VIES', 'MFIN'), m.ldDataAct)
|
||
Endcase
|
||
If Type('loVerificare.oEntitate') = 'O'
|
||
toPartenerVerificare = loVerificare.oEntitate
|
||
Endif
|
||
Endif && llIsCIF
|
||
|
||
|
||
Return m.llValid
|
||
Endproc && verifica_partener
|
||
|
||
********************************************
|
||
*** formular cu informatiile verificate la mfinante.ro
|
||
*** apelat din verifica_partener (cautalf, frm_partener_nou)
|
||
*** intoarce: 1=OK, 6=YES, 7=NO
|
||
********************************************
|
||
Function verifica_partener_show_info
|
||
Lparameters toPartenerVerificare, tcCodFiscal, tcDenumire, tcMesajIntrebare
|
||
*** toPartenerVerificare: IN, obiect cu informatiile de la mfinante.ro
|
||
*** tcCodFiscal: IN, codul fiscal verificat
|
||
*** tcDenumire: IN, denumire partener verificat
|
||
*** tcMesajIntrebare: IN, optional, daca se intreaba ceva la sfarsitul formularului (ex: Se completeaza datele in formularul partener nou?)
|
||
|
||
Local lcCodFiscal, lcDenumire, lcText, llCodRO, llPlatitorTVAMfin, llPlatitorTVAVIES, lnDialogType
|
||
Local lnRaspuns, loPartener
|
||
|
||
lcCodFiscal = Transform(m.tcCodFiscal)
|
||
lcDenumire = Transform(m.tcDenumire)
|
||
loPartener = toPartenerVerificare
|
||
lnDialogType = Iif(!Empty(m.tcMesajIntrebare), 4 + 32, 0 + 64)
|
||
llPlatitorTVAMfin = loPartener.platitortvamfin
|
||
llCodRO = (Left(m.lcCodFiscal, 2) = 'RO')
|
||
llPlatitorTVAVIES = loPartener.PlatitorTVA
|
||
llTvaIncasare = loPartener.tvaincasare
|
||
llSplitTVA = loPartener.splittva
|
||
llInactiv = loPartener.inactiv
|
||
|
||
lcText = 'VERIFICARE CIF: ' + m.lcCodFiscal + ' ' + m.lcDenumire + crlf + crlf + ;
|
||
Alltrim(loPartener.firma) + crlf + ;
|
||
Iif((m.llPlatitorTVAMfin And !m.llCodRO) Or (!m.llPlatitorTVAMfin And m.llCodRO), ' *** ATENTIE *** ', '') + ;
|
||
Iif(m.llPlatitorTVAMfin, "PLATITOR TVA (" + Alltrim(loPartener.datatvamfin) + ")", "NEPLATITOR TVA") + crlf + ;
|
||
'Stare: ' + Alltrim(loPartener.stare) + crlf + ;
|
||
'TVA Incasare: ' + Iif(m.llTvaIncasare, 'DA', 'NU') + crlf + ;
|
||
'Split TVA: ' + Iif(m.llSplitTVA, 'DA', 'NU') + crlf + ;
|
||
'Inactiv: ' + Iif(m.llInactiv, 'DA *** ATENTIE!', 'NU') + crlf + ;
|
||
'----------------------------------------------------' + crlf + ;
|
||
'* Adresa: ' + Alltrim(loPartener.adresa) + crlf + ;
|
||
'* Judet: ' + loPartener.judet + crlf + ;
|
||
'* Nr. inregistrare la Registrul Comertului: ' + loPartener.regcom + crlf + ;
|
||
'* Cod Postal: ' + loPartener.codpostal + crlf + ;
|
||
'* Telefon: ' + loPartener.telefon + crlf + ;
|
||
'* Fax: ' + loPartener.fax + crlf + ;
|
||
Iif(!Empty(loPartener.eroare), Alltrim(loPartener.eroare) + crlf, '') + ;
|
||
'----------------------------------------------------' + crlf + crlf + ;
|
||
Iif(!Empty(m.tcMesajIntrebare), m.tcMesajIntrebare + crlf + crlf + crlf, "")
|
||
|
||
lnRaspuns = amessagebox(lcText, m.lnDialogType, _Screen.Caption)
|
||
Return m.lnRaspuns
|
||
Endfunc && verifica_partener_show_info
|
||
|
||
Function GetMeniuVerificareCodFiscal
|
||
Lparameters tcCodFiscal, tcOptiuniMeniuAnte
|
||
|
||
Local lcMenu, llVerificareCod
|
||
llVerificareCod = Type('tcCodFiscal') = 'C' And !Empty(m.tcCodFiscal)
|
||
lcMeniuOptiuniAnte = Iif(Type('tcOptiuniMeniuAnte') = 'C' And !Empty(m.tcOptiuniMeniuAnte), Alltrim(m.tcOptiuniMeniuAnte), '')
|
||
|
||
lcMenu = lcMeniuOptiuniAnte + ;
|
||
Iif(!m.llVerificareCod, "\", "") + "Verificare ANAF (automat);" + ;
|
||
"\-;" + ;
|
||
Iif(!m.llVerificareCod, "\", "") + "Verificare MFINANTE (manual);" + ;
|
||
"\-;" + ;
|
||
Iif(!m.llVerificareCod, "\", "") + "Verificare Registru inactivi ANAF (manual);" + ;
|
||
"\-;" + ;
|
||
Iif(!m.llVerificareCod, "\", "") + "Verificare Registru TVA Incasare (automat);" + ;
|
||
Iif(!m.llVerificareCod, "\", "") + "Verificare Registru TVA Incasare (manual);" + ;
|
||
"\-;" + ;
|
||
Iif(!m.llVerificareCod, "\", "") + "Verificare VIES (automat);" + ;
|
||
Iif(!m.llVerificareCod, "\", "") + "Verificare VIES (manual);" + ;
|
||
"\-;" + ;
|
||
"Istoric verificari cod fiscal"
|
||
|
||
Return m.lcMenu
|
||
Endfunc
|
||
|
||
**************************************
|
||
*** Intoarce optiunea aleasa din meniul de verificare cod fiscal
|
||
Function GetOptiuneVerificareCodFiscal
|
||
Lparameters tnOptiune
|
||
Local lnOptiune, lcTipVerificare
|
||
|
||
lnOptiune = Iif(Type('tnOptiune') = 'N', m.tnOptiune, 0)
|
||
|
||
lcTipVerificare = Iif(m.lnOptiune = 1, 'ANAF_SERVICIU_WEB', ;
|
||
Iif(m.lnOptiune = 3, 'MFIN_MANUAL_COD', ;
|
||
Iif(m.lnOptiune = 5, 'ANAF_MANUAL_COD', ;
|
||
Iif(m.lnOptiune = 7, 'RTVAI_AUTO_COD', ;
|
||
Iif(m.lnOptiune = 8, 'RTVAI_MANUAL_COD', ;
|
||
Iif(m.lnOptiune = 10, 'VIES_AUTO', ;
|
||
Iif(m.lnOptiune = 11, 'VIES_MANUAL', ;
|
||
Iif(m.lnOptiune = 13, 'ISTORIC', ''))))))))
|
||
|
||
Return m.lcTipVerificare
|
||
Endfunc
|
||
|
||
**********************************************
|
||
*** Arata un meniu cu optiuni de verificare a unui cod fiscal
|
||
*** Intoarce raspuns 0 = Ok, 1 = YES, 7 = CANCEL daca se doreste completarea datelor in adaugarea de parteneri
|
||
**********************************************
|
||
Procedure VerificaCodFiscal
|
||
Lparameters toDate, lnOptiune, loPartener
|
||
* toDate - obiect cu proprietati (cod_fiscal, denumire, data, cod_judet, cod_auto)
|
||
* loOptiune (OUT): optiunea aleasa, daca mai sunt si alte optiuni in afara de cele de verificare cod fiscal
|
||
* loPartener (OUT): obiect cu datele completate in urma verificarii pe mfinante.ro sau serviciu web ANAF
|
||
|
||
If .F.
|
||
loPartener = Null
|
||
lnRaspuns = VerificaCodFiscal(loDate, @lnOptiune, @loPartener)
|
||
Endif && .F.
|
||
|
||
|
||
Local loPartenerX As "empty"
|
||
Local lcAlias, lcCodFiscal, lcDenumire, lcMenu, lcTipVerificare, llValid, lnRaspuns, lcCodJudet, lcCodAuto, lcMesajIntrebare, lcOptiuniMeniuAnte
|
||
Local lnOptiuneVerificare, lcTipVerificare
|
||
Local lcText, ldData, llPlatitorTVAVIES, llVIES
|
||
|
||
loPartener = Null
|
||
lnRaspuns = 7 && NO
|
||
lcCodFiscal = ''
|
||
lcDenumire = ''
|
||
ldData = {}
|
||
lcCodJudet = ''
|
||
lcCodAuto = ''
|
||
lcMesajIntrebare = ''
|
||
lcOptiuniMeniuAnte = ''
|
||
lnOptiune = 0
|
||
lnOptiuneVerificare = 0
|
||
lcTipVerificare = ''
|
||
|
||
If Type('toDate') <> 'O' Or Isnull(toDate)
|
||
Return m.lnRaspuns
|
||
Endif
|
||
If Pemstatus(toDate, 'cod_fiscal', 5 )
|
||
lcCodFiscal = Alltrim(NVL(toDate.cod_fiscal,''))
|
||
Endif
|
||
If Pemstatus(toDate, 'denumire', 5 )
|
||
lcDenumire = Alltrim(NVL(toDate.denumire,''))
|
||
Endif
|
||
If Pemstatus(toDate, 'data', 5 )
|
||
ldData = NVL(toDate.Data, {})
|
||
Endif
|
||
|
||
If Pemstatus(toDate, 'cod_judet', 5 )
|
||
lcCodJudet = Alltrim(NVL(toDate.cod_judet,''))
|
||
Endif
|
||
|
||
If Pemstatus(toDate, 'cod_auto', 5 )
|
||
lcCodAuto = Alltrim(NVL(toDate.cod_auto, ''))
|
||
Endif
|
||
If Pemstatus(toDate, 'mesaj_intrebare', 5 )
|
||
lcMesajIntrebare = Alltrim(toDate.mesaj_intrebare)
|
||
Endif
|
||
|
||
If Pemstatus(toDate, 'optiuni_meniu_ante', 5 )
|
||
lcOptiuniMeniuAnte = Alltrim(toDate.optiuni_meniu_ante)
|
||
Endif
|
||
|
||
If Pemstatus(toDate, 'tip_verificare', 5 )
|
||
lcTipVerificare = Alltrim(toDate.tip_verificare)
|
||
Endif
|
||
|
||
If Empty(m.lcCodFiscal)
|
||
Return m.lnRaspuns
|
||
Endif
|
||
|
||
If Empty(m.lcTipVerificare)
|
||
lcMenu = GetMeniuVerificareCodFiscal(m.lcCodFiscal, m.lcOptiuniMeniuAnte)
|
||
lnOptiune = XMENU(m.lcMenu)
|
||
lnOptiuneVerificare = m.lnOptiune
|
||
If !Empty(m.lcOptiuniMeniuAnte)
|
||
lnOptiuneVerificare = m.lnOptiuneVerificare - Occurs(';', m.lcOptiuniMeniuAnte)
|
||
Endif
|
||
lcTipVerificare = GetOptiuneVerificareCodFiscal(m.lnOptiuneVerificare)
|
||
Else
|
||
lnOptiune = 1
|
||
lnOptiuneVerificare = 1
|
||
Endif
|
||
|
||
If Empty(m.lnOptiune)
|
||
Return m.lnRaspuns
|
||
Endif
|
||
|
||
Do Case
|
||
Case m.lcTipVerificare = 'ISTORIC'
|
||
Do verificare_parteneri_istoric With m.lcCodFiscal && In proceduri_comune.prg
|
||
|
||
Case m.lcTipVerificare = 'RTVAI_AUTO_COD'
|
||
loPartenerX = Createobject("empty")
|
||
loPartener = Createobject("empty")
|
||
AddProperty(loPartenerX, "cod_fiscal", m.lcCodFiscal)
|
||
AddProperty(loPartenerX, "denumire", m.lcDenumire)
|
||
AddProperty(loPartenerX, "dataact", m.ldData)
|
||
llValid = VERIFICA_RTVAI(loPartenerX, @loPartener)
|
||
If !m.llValid
|
||
amessagebox('Codul ' + m.lcCodFiscal + ' este invalid!', 0 + 48, _Screen.Caption)
|
||
Else
|
||
If Pemstatus(loPartener, "leinRtvai", 5)
|
||
If loPartener.leinRtvai
|
||
amessagebox('Partenerul ' + m.lcDenumire + ' cu codul fiscal: ' + m.lcCodFiscal + crlf + ' este in sistemul TVA la incasare!', 0 + 48, _Screen.Caption)
|
||
Else
|
||
amessagebox('Partenerul ' + m.lcDenumire + ' cu codul fiscal: ' + m.lcCodFiscal + crlf + ' NU este in sistemul TVA la incasare!', 0 + 48, _Screen.Caption)
|
||
Endif
|
||
Endif
|
||
ENDIF
|
||
|
||
Case m.lcTipVerificare = 'VIES_AUTO'
|
||
loPartenerX = Createobject("empty")
|
||
loPartener = Createobject("empty")
|
||
AddProperty(loPartenerX, "cod_fiscal", m.lcCodFiscal)
|
||
AddProperty(loPartenerX, "denumire", m.lcDenumire)
|
||
AddProperty(loPartenerX, "dataact", m.ldData)
|
||
llValid = verifica_partener(m.lcTipVerificare, loPartenerX, @loPartener)
|
||
|
||
If !m.llValid
|
||
amessagebox('Codul ' + m.lcCodFiscal + ' este invalid!', 0 + 48, _Screen.Caption)
|
||
ELSE
|
||
llPlatitorTVAVIES = loPartener.PlatitorTVA
|
||
llVIES = loPartener.VIES
|
||
|
||
lcText = 'VERIFICARE CIF: ' + m.lcCodFiscal + ' ' + m.lcDenumire + crlf + crlf + ;
|
||
Alltrim(NVL(loPartener.firma,'')) + crlf + ;
|
||
Alltrim(NVL(loPartener.adresa,'')) + crlf + ;
|
||
Iif(m.llVIES, 'S-a interogat baza de date VIES: ' + Iif(m.llPlatitorTVAVIES, 'PLATITOR TVA VIES', 'NEPLATITOR TVA VIES'), 'Nu s-a interogat baza de date VIES!')
|
||
|
||
AMESSAGEBOX(m.lcText, 0+64, _Screen.Caption)
|
||
ENDIF
|
||
|
||
Otherwise
|
||
loPartenerX = Createobject("empty")
|
||
loPartener = Createobject("empty")
|
||
AddProperty(loPartenerX, "cod_fiscal", m.lcCodFiscal)
|
||
AddProperty(loPartenerX, "denumire", m.lcDenumire)
|
||
AddProperty(loPartenerX, "dataact", m.ldData)
|
||
llValid = verifica_partener(m.lcTipVerificare, loPartenerX, @loPartener)
|
||
|
||
If !m.llValid
|
||
amessagebox('Codul ' + m.lcCodFiscal + ' este invalid!', 0 + 48, _Screen.Caption)
|
||
ELSE
|
||
If Pemstatus(loPartener, "platitortvamfin", 5)
|
||
lnRaspuns = verifica_partener_show_info(loPartener, m.lcCodFiscal, m.lcDenumire, m.lcMesajIntrebare)
|
||
ENDIF
|
||
Endif
|
||
Endcase
|
||
|
||
Return m.lnRaspuns && raspunsul la intrebarea 'Doriti sa completati datele partenerului?' in formularul Adaugare partener
|
||
|
||
Endproc && VerificaCodFiscal
|
||
|
||
****************************************************************
|
||
*** Verificare manuala platitor TVA pe mfinante.ro / registru inactivi anaf.ro / registru tva incasare anaf.ro
|
||
*** Lanseaza browserul cu adresa mfinante.ro, anaf.ro
|
||
****************************************************************
|
||
Procedure VERIFICA_MANUAL_MFINANAF
|
||
Lparameters tcTip, tcCodFiscal, tcDenumire, tcCodJudet
|
||
*** tcTIP: MFIN/MFINCOD/MFINNUME/ANAF
|
||
*** tcCodFiscal: MFIN - se face verificarea dupa cod fiscal daca este completat, altfel verificare dupa nume, judet
|
||
|
||
Local lcCodAuto, lcCodFiscal, lcDenumire, lcTipVerificare, lcURL, lcAtributFiscal
|
||
lcCodFiscal = UPPER(Alltrim(Transform(m.tcCodFiscal)))
|
||
lcDenumire = Alltrim(Transform(m.tcDenumire))
|
||
lcCodJudet = Alltrim(Transform(m.tcCodJudet))
|
||
lcURL = ""
|
||
lcAtributFiscal = ''
|
||
|
||
If Isalpha(m.lcCodFiscal)
|
||
lcAtributFiscal = lcAtributFiscal + LEFT(m.lcCodFiscal,1)
|
||
lcCodFiscal = Alltrim(Substr(m.lcCodFiscal, 2))
|
||
If Isalpha(lcCodFiscal)
|
||
lcAtributFiscal = lcAtributFiscal + LEFT(m.lcCodFiscal,1)
|
||
lcCodFiscal = Alltrim(Substr(m.lcCodFiscal, 2))
|
||
Endif
|
||
Endif
|
||
|
||
lctip = Iif(!Empty(m.tcTip), Upper(Alltrim(m.tcTip)), "MFIN")
|
||
|
||
Do Case
|
||
Case "MFIN" $ m.lctip
|
||
lcTipVerificare = Iif("NUME" $ m.lctip, "NUME", "COD")
|
||
|
||
If m.lcTipVerificare = "COD"
|
||
lcURL = "https://www.mfinante.gov.ro/apps/infocodfiscal.html?cod=" + m.lcCodFiscal
|
||
Else
|
||
lcURL = "https://www.mfinante.gov.ro/apps/numeCod.html?judet=" + m.lcCodJudet + "&name=" + m.lcDenumire + "&submit=VIZUALIZARE"
|
||
|
||
Endif
|
||
Case "ANAF" $ m.lctip
|
||
Text To lcURL Noshow Textmerge
|
||
https://www.anaf.ro/inactivi?codFiscal=<<m.lcCodFiscal>>&judet=<<m.lcCodJudet>>&inputdenumire=<<m.lcDenumire>>
|
||
Endtext
|
||
Case "RTVAI" $ m.lctip
|
||
Text To lcURL Noshow Textmerge
|
||
https://www.anaf.ro/IncasareTva/cautCodTvaIncasare.do?codFiscal=<<m.lcCodFiscal>>
|
||
Endtext
|
||
Case "VIES" $ m.lctip
|
||
Text To lcURL Noshow Textmerge
|
||
https://ec.europa.eu/taxation_customs/vies/viesquer.do?iso=<<m.lcAtributFiscal>>&vat=<<m.lcCodFiscal>>&ms=<<m.lcAtributFiscal>>
|
||
ENDTEXT
|
||
|
||
Endcase
|
||
If !Empty(m.lcURL)
|
||
OPEN_DEFAULT_APP(m.lcURL)
|
||
Endif
|
||
Endproc && VERIFICA_MANUAL_MFINANAF
|
||
|
||
************************************************************
|
||
*** VERIFICA DACA PARTENERUL ESTE IN REGISTRUL TVA INCASARE
|
||
************************************************************
|
||
Procedure VERIFICA_RTVAI
|
||
Lparameters toPartener, toPartenerOut
|
||
* toPartener datele partenerului: cod_fiscal,denumire,dataact
|
||
* toPartenerOut (OUT): denumire,leInRTVAI din AgentiRtvai
|
||
|
||
Local lcCodFiscal, lcDenumire, ldDataAct, llIsCIF, llValid, lcSql, llSucces
|
||
Local loVerificare As "verificarecod"
|
||
Private pcDenumire, pdData, pnCodFiscal, pnRTVAI
|
||
|
||
If Type('toPartener') = 'O'
|
||
lcCodFiscal = Iif(Pemstatus(toPartener, "cod_fiscal", 5), Alltrim(toPartener.cod_fiscal), '')
|
||
lcDenumire = Iif(Pemstatus(toPartener, "denumire", 5), Alltrim(Upper(toPartener.denumire)), '')
|
||
ldDataAct = Iif(Pemstatus(toPartener, "dataact", 5), toPartener.dataact, {})
|
||
Else
|
||
lcCodFiscal = Transform(toPartener)
|
||
Endif
|
||
|
||
|
||
loVerificare = Createobject("verificarecod") && validare.prg
|
||
llIsCIF = loVerificare.IsCIF(m.lcCodFiscal)
|
||
|
||
*!* VERIFIC VALIDITATEA CODULUI
|
||
If m.llIsCIF
|
||
llValid = loVerificare.Validare('CIF', m.lcCodFiscal)
|
||
*!* Else
|
||
*!* llValid = loVerificare.Validare('CNP', m.lcCodFiscal)
|
||
Endif
|
||
If !Pemstatus(toPartenerOut, "leinRtvai", 5)
|
||
AddProperty(toPartenerOut, "leinRtvai", .F.)
|
||
Endif
|
||
If !Pemstatus(toPartenerOut, "denumire", 5)
|
||
AddProperty(toPartenerOut, "denumire", "")
|
||
Endif
|
||
|
||
If m.llIsCIF AND m.llValid
|
||
If Empty(m.ldDataAct)
|
||
ldDataAct = Date(m.gnAn, m.gnLuna, 1)
|
||
Endif
|
||
|
||
If Isalpha(m.lcCodFiscal)
|
||
lcCodFiscal = Alltrim(Substr(m.lcCodFiscal, 2))
|
||
If Isalpha(lcCodFiscal)
|
||
lcCodFiscal = Alltrim(Substr(m.lcCodFiscal, 2))
|
||
Endif
|
||
Endif
|
||
pnCodFiscal = Int(Val(m.lcCodFiscal))
|
||
pdData = ldDataAct
|
||
pcDenumire = ''
|
||
pnRTVAI = 0
|
||
lcSql = [begin pack_roartvai.PartenerInRTVAI(?pnCodFiscal, ?pdData, ?@pcDenumire, ?@pnRTVAI); end;]
|
||
|
||
llSucces = goExecutor.oExecuta(m.lcSql)
|
||
If m.llSucces
|
||
toPartenerOut.leinRtvai = (m.pnRTVAI = 1)
|
||
toPartenerOut.denumire = Alltrim(Nvl(pcDenumire, ''))
|
||
Endif
|
||
|
||
Endif && m.llValid
|
||
|
||
Return m.llValid
|
||
Endproc && VERIFICA_RTVAI
|
||
|
||
|
||
************************************************************
|
||
*** Intoarce .T. daca codul fiscal exista in REGISTRUL TVA INCASARE la data
|
||
************************************************************
|
||
Function VERIFICA_RTVAI_DATA
|
||
Lparameters tcCodFiscal, tdDataAct, tcDenumire
|
||
* tcCodFiscal: codul fiscal de verificat in RTVAI
|
||
* tdDataAct: data documentului (optional) / 1 ale lunii curente, daca nu este dat
|
||
* tcDenumire: OUT denumirea din RTVAI, daca exista
|
||
|
||
Private pcDenumire, pdData, pnCodFiscal, pnRTVAI
|
||
Local lcCodFiscal, lcDenumire, lcSql, ldDataAct, leinRtvai, llSucces
|
||
|
||
leinRtvai = .F.
|
||
tcDenumire = ''
|
||
|
||
lcCodFiscal = Iif(Type('tcCodFiscal') = 'C', Alltrim(Nvl(m.tcCodFiscal, '')), '')
|
||
ldDataAct = Iif(!Empty(m.tdDataAct), m.tdDataAct, Date(m.gnAn, m.gnLuna, 1))
|
||
|
||
If Empty(m.lcCodFiscal)
|
||
Return m.leinRtvai
|
||
Endif
|
||
|
||
If Isalpha(m.lcCodFiscal)
|
||
lcCodFiscal = Alltrim(Substr(m.lcCodFiscal, 2))
|
||
If Isalpha(lcCodFiscal)
|
||
lcCodFiscal = Alltrim(Substr(m.lcCodFiscal, 2))
|
||
Endif
|
||
Endif
|
||
|
||
pnCodFiscal = Int(Val(m.lcCodFiscal))
|
||
pdData = ldDataAct
|
||
pcDenumire = ''
|
||
pnRTVAI = 0
|
||
lcSql = [begin pack_roartvai.PartenerInRTVAI(?pnCodFiscal, ?pdData, ?@pcDenumire, ?@pnRTVAI); end;]
|
||
|
||
llSucces = goExecutor.oExecuta(m.lcSql)
|
||
If m.llSucces
|
||
leinRtvai = (m.pnRTVAI = 1)
|
||
tcDenumire = Alltrim(Nvl(m.pcDenumire, ''))
|
||
Endif
|
||
|
||
Return m.leinRtvai
|
||
Endfunc && VERIFICA_RTVAI_DATA
|
||
|
||
|
||
*********************************************
|
||
*** inlocuieste caracterele speciale dintr-un text xml
|
||
*** ex: "&" devine "&"
|
||
Function XmlSpecialCharacters
|
||
Lparameters tcText
|
||
|
||
Local lcText
|
||
lcText = tcText
|
||
lcText = Strtran(m.lcText, '&', '&')
|
||
lcText = Strtran(m.lcText, '"', '"')
|
||
lcText = Strtran(m.lcText, ['], ''')
|
||
lcText = Strtran(m.lcText, '<', '<')
|
||
lcText = Strtran(m.lcText, '>', '>')
|
||
|
||
Return lcText
|
||
Endfunc && XmlSpecialCharacters
|
||
|
||
|
||
*********************************************
|
||
*** curata caracterele care nu sunt permise in nume de fisiere Windows
|
||
*** inlocuiesc cu tcReplaceCharacter
|
||
Function WindowsSpecialCharacters
|
||
Lparameters tcText, tcReplaceCharacter
|
||
* tcReplaceCharacter: caracterul cu care se inlocuiesc caracterele nepermise in numele fisierelor. Optional, default: ''
|
||
|
||
Local lcText, lcRC
|
||
lcRC= IIF(!EMPTY(m.tcReplaceCharacter) and TYPE('tcReplaceCharacter') = 'C' and AT(m.tcReplaceCharacter, [/\?%*:|"<>.,;=]) = 0, m.tcReplaceCharacter, '')
|
||
|
||
lcText = STRTRAN(STRTRAN(STRTRAN(STRTRAN(STRTRAN(STRTRAN(STRTRAN(STRTRAN(Strtran(TRANSFORM(m.tcText), [<], m.lcRC,1,10), [>], m.lcRC,1,10), [:], m.lcRC,1,10), ["], m.lcRC,1,10), ;
|
||
[/], m.lcRC,1,10), [\], m.lcRC,1,10), [|], m.lcRC,1,10), [?], m.lcRC,1,10), [*], m.lcRC,1,10)
|
||
|
||
Return lcText
|
||
Endfunc && WindowsSpecialCharacters
|
||
|
||
*********************************************
|
||
*** face conversia de la Double Byte la UTF8
|
||
*** curata textul de diacritice, spatii, CR/LF,
|
||
*** lcMesaj = RemoveCharactersDB(lcMesaj, .T.)
|
||
*********************************************
|
||
FUNCTION RemoveCharactersDB
|
||
Lparameters tcText, tlDiacritics, tlSpaces, tlCR
|
||
LOCAL lcText
|
||
|
||
lcText = STRCONV(tcText, 9) && conversie la UTF-8
|
||
lcText = RemoveCharacters(tcText, tlDiacritics, tlSpaces, tlCR)
|
||
RETURN m.lcText
|
||
ENDFUNC
|
||
*********************************************
|
||
*** curata textul de diacritice, spatii, CR/LF
|
||
*********************************************
|
||
Function RemoveCharacters
|
||
Lparameters tcText, tlDiacritics, tlSpaces, tlCR
|
||
*** tcText: textul initial
|
||
*** tlDiacritics: inlocuieste diacriticele
|
||
*** tlSpaces: sterge spatiile
|
||
*** tlCR: sterge CR si LF
|
||
|
||
Local lcText
|
||
lcText = IIF(TYPE('tcText') = 'C', Nvl(m.tcText, ''), '')
|
||
|
||
IF EMPTY(m.lcText)
|
||
RETURN ''
|
||
ENDIF
|
||
|
||
If m.tlDiacritics
|
||
lcText = STRTRAN(STRTRAN(Strtran(Nvl(m.lcText, ''), Chr(197) + CHR(162), 'T', 1,100,1), Chr(197) + CHR(63), 'S', 1,100,1), Chr(196) + CHR(63), 'A', 1,100,1)
|
||
lcText = Strtran(Nvl(m.lcText, ''), Chr(195) + CHR(63), 'I', 1,100,1)
|
||
lcText = Strtran(Strtran(Strtran(Strtran(Strtran(Nvl(m.lcText, ''), Chr(170), 'S', 1,100,1), Chr(222), 'T', 1,100,1), Chr(226), 'A', 1,100,1), Chr(227), 'A', 1,100,1), Chr(238), 'I', 1,100,1)
|
||
lcText = STRTRAN(Strtran(Strtran(Strtran(Nvl(m.lcText, ''), Chr(206), 'I', 1,100,1), Chr(194), 'A', 1,100,1), Chr(195), 'A', 1,100,1), Chr(196), 'A', 1,100,1)
|
||
lcText = STRTRAN(m.lcText, CHR(2), '',1,100,1) && caracter neprintabil
|
||
|
||
* Inlocuiri pentru diacritice - minuscule
|
||
lcText = STRTRAN(lcText, "A<>?", "a") && a
|
||
lcText = STRTRAN(lcText, "Ac??", "a") && <20>
|
||
lcText = STRTRAN(lcText, "A^?", "t") && ?
|
||
lcText = STRTRAN(lcText, "AfA<66>", "i") && <20>
|
||
lcText = STRTRAN(lcText, "A<>", "a") && a (alta varianta)
|
||
lcText = STRTRAN(lcText, "A<>", "s") && ?
|
||
|
||
* Inlocuiri pentru diacritice - majuscule
|
||
lcText = STRTRAN(lcText, "A<>", "A") && A
|
||
lcText = STRTRAN(lcText, "A<>", "I") && I
|
||
lcText = STRTRAN(lcText, "A<>", "S") && ?
|
||
lcText = STRTRAN(lcText, "Ac", "T") && ?
|
||
lcText = STRTRAN(lcText, "Ă", "A") && A
|
||
ENDIF
|
||
|
||
If m.tlSpaces
|
||
lcText = Strtran(m.lcText, ' ', '', 1, 100, 1)
|
||
Endif
|
||
If m.tlCR
|
||
lcText = Strtran(Strtran(m.lcText, Chr(13), ''), Chr(10), '')
|
||
Endif
|
||
|
||
Return m.lcText
|
||
Endfunc
|
||
|
||
|
||
****************************************************
|
||
Function OracleSpecialCharacters
|
||
Lparameters tcText
|
||
Local lcText
|
||
lcText = tcText
|
||
lcText = Strtran(m.lcText, "'", "''")
|
||
|
||
Return lcText
|
||
Endfunc && OracleSpecialCharacters
|
||
****************************************************
|
||
*** Citeste din optiuni utilizator ordinea coloanelor dintr-un grid de tipul ferestre_cere_date.vcx > ct_grid_search
|
||
*** ointroduceri.prg > lans_nir_bon > grid nomenclator articole
|
||
*** ointroduceri.prg > achizitie_import > fereastra cautare repere pentru adaugare
|
||
*** Intoarce obiectul loSelectie(titlu_col M, nume_col M, ordine C(50), width_col M, pornire N(2))
|
||
*** Pentru salvarea ordinii coloanelor din grid, criteriului de sortare se apeleaza SCRIE_SELECTII_OPTIUNI_UTILIZATOR()
|
||
****************************************************
|
||
Procedure CITESTE_SELECTII_OPTIUNI_UTILIZATOR
|
||
Lparameters tcOptiune, tcListaColoaneGrid, tcCursor, tcSearchColumn, tuSearchValue
|
||
*!* CITESTE_SELECTII_OPTIUNI_UTILIZATOR("GEST_SELECTII", ost.nume_col, "crsGestSelectiiUtilizator", "id_sel", oSet.id_selSt)
|
||
*!* tcOptiune: "GEST_SELECTII"
|
||
*!* tcListaColoaneGrid: lista coloanelor din grid: "codmat;denumire;um;serie;cantitate;pret;cant_bax;um2;grupa;subgrupa;cgest;cont;acont;datain;codmatf;lot;adata_expirare;nrord_rez;part_rez"
|
||
*!* tcCursor: "crsGestSelectiiUtilizator" (default = "crsSelectiiUtilizator")
|
||
*!* tcSearchColumn (optional): "ID_SEL" (daca in cursorul xml sunt mai multe inregistrari si doresc o anume inregistrare)
|
||
*!* tuSearchValue (optional): 1 (valoarea pentru tcSearchColumn)
|
||
*!* RETURN: loSelectie (titlu_col, nume_col, ordine, width_col, pornire)
|
||
|
||
Local lcCursor, lcListaColoaneCursor, lcListaColoaneGrid, lcOptiune, lcSchemaCursor, lcSearchColumn
|
||
Local lcSelectii, lcSirOrdonatCursor, lcSirOrdonatGrid, loSelectie, luSearchValue
|
||
|
||
lcOptiune = Upper(Alltrim(tcOptiune))
|
||
lcListaColoaneGrid = m.tcListaColoaneGrid
|
||
lcCursor = Iif(!Empty(m.tcCursor), m.tcCursor, "crsSelectiiUtilizator")
|
||
lcSearchColumn = ""
|
||
luSearchValue = ""
|
||
If !Empty(tcSearchColumn) And !Empty(tuSearchValue) And Type('tcSearchColumn') = 'C'
|
||
lcSearchColumn = Upper(Alltrim(tcSearchColumn))
|
||
luSearchValue = tuSearchValue
|
||
Endif
|
||
|
||
lcSchemaCursor = "titlu_col M, nume_col M, ordine C(50), width_col M, pornire N(2)"
|
||
If !Empty(m.lcSearchColumn)
|
||
lcSchemaCursor = lcSearchColumn + " " + Type('tuSearchValue') + "(" + Len(tuSearchValue) + ")," + m.lcSchemaCursor
|
||
Endif
|
||
Create Cursor (m.lcCursor) (&lcSchemaCursor)
|
||
Select (m.lcCursor)
|
||
Scatter Name loSelectie Memo Blank
|
||
|
||
lcSelectii = citeste_optiune_utilizator(m.lcOptiune)
|
||
If !Empty(m.lcSelectii)
|
||
Xmltocursor(m.lcSelectii, m.lcCursor)
|
||
|
||
Select (m.lcCursor)
|
||
If !Empty(m.lcSearchColumn)
|
||
Locate For &lcSearchColumn = luSearchValue
|
||
If Found()
|
||
Scatter Name loSelectie Memo
|
||
Endif
|
||
Else
|
||
Go Top
|
||
Scatter Name loSelectie Memo
|
||
Endif
|
||
|
||
**-- compara daca am aceleasi coloane (control source) pe server si in tabelul din proiect (gest_selectii)
|
||
Create Cursor crsListaCursor (element C(100))
|
||
Create Cursor crsListaGrid (element C(100))
|
||
|
||
lcListaColoaneCursor = loSelectie.nume_col
|
||
lista2cursor(lcListaColoaneCursor, "crsListaCursor", "element", ";")
|
||
lista2cursor(lcListaColoaneGrid, "crsListaGrid", "element", ";")
|
||
|
||
Select * From crsListaCursor ;
|
||
Order By element ;
|
||
Into Cursor crsListaCursorOrd
|
||
|
||
Select * From crsListaGrid ;
|
||
Order By element ;
|
||
Into Cursor crsListaGridOrd
|
||
|
||
lcSirOrdonatCursor = cursor2lista("crsListaCursorOrd", "element", ";")
|
||
lcSirOrdonatGrid = cursor2lista("crsListaGridOrd", "element", ";")
|
||
|
||
Use In (Select('crsListaCursor'))
|
||
Use In (Select('crsListaGrid'))
|
||
Use In (Select('crsListaCursorOrd'))
|
||
Use In (Select('crsListaGridOrd'))
|
||
|
||
If lcSirOrdonatCursor <> lcSirOrdonatGrid
|
||
Select (m.lcCursor)
|
||
Scatter Name loSelectie Memo Blank
|
||
Endif
|
||
|
||
Endif
|
||
|
||
Return loSelectie
|
||
Endproc && CITESTE_SELECTII_OPTIUNI_UTILIZATOR
|
||
|
||
************************************************************************************************
|
||
*** NIR.INAINTE_DE_DO_TERMIN
|
||
*** SCRIE_SELECTII_OPTIUNI_UTILIZATOR("GEST_SELECTII", toCtGridSearch, ["crsGestSelectiiUtilizator", "id_sel", oSet.id_selSt])
|
||
*** tcOptiune: "GEST_SELECTII"
|
||
*** toCtGridSearch: referinta la containerul cu grid de tipul ct_grid_search
|
||
*** tcDescriere (optional): descriere optiune
|
||
*** tcCursor (optional): "crsGestSelectiiUtilizator" (default = "crsSelectiiUtilizator")
|
||
*** tcSearchColumn (optional): "ID_SEL" (daca in cursorul xml sunt mai multe inregistrari si doresc sa modific o anume inregistrare)
|
||
*** tuSearchValue (optional): 1 (valoarea pentru tcSearchColumn)
|
||
************************************************************************************************
|
||
Procedure SCRIE_SELECTII_OPTIUNI_UTILIZATOR
|
||
Lparameters tcOptiune, toCtGridSearch, tcDescriere, tcCursor, tcSearchColumn, tuSearchValue
|
||
|
||
Local lcDescriere, lcSearchColumn, luSearchValue
|
||
Local loCtGridSearch, lcOptiune, lcCursor, lcSelect
|
||
Local lcColOrd, lcControlSource, lcControlSource2, lcCursorXML, lcHeader, lcHeader2, lcNumeCol
|
||
Local lcOrd, lcOrdine, lcTitluCol, lcWidthCol, lcWidthColumn, lcWidthColumn2, llNrOrd, lnColOrd
|
||
Local lnNrCols, lnPornire, loSelectie, i
|
||
|
||
lcSelect = Select()
|
||
loCtGridSearch = toCtGridSearch
|
||
lcOptiune = Upper(Alltrim(tcOptiune))
|
||
lcCursor = Iif(!Empty(m.tcCursor), m.tcCursor, "crsSelectiiUtilizator")
|
||
lcDescriere = Iif(!Empty(m.tcDescriere), Alltrim(m.tcDescriere), Program(1))
|
||
lcSearchColumn = Iif(!Empty(m.tcSearchColumn), Alltrim(m.tcSearchColumn), "")
|
||
luSearchValue = Iif(!Empty(m.luSearchValue), m.luSearchValue, "")
|
||
|
||
Create Cursor crsGrid (ordine N(3), ctrSource C(100), titlu C(100), widthCol C(100))
|
||
|
||
lnNrCols = loCtGridSearch._GRID1.ColumnCount
|
||
llNrOrd = loCtGridSearch.lNumerotare
|
||
lnPornire = Val(loCtGridSearch.cb_tx_cautare1.criteriu.Value)
|
||
|
||
For i = 1 To lnNrCols
|
||
If llNrOrd And i <> 1 && ce se intampla daca nu e llNrOrd ??????
|
||
lcColOrd = [loCtGridSearch._grID1.column] + Alltrim(Str(i)) + [.columnorder]
|
||
lnColOrd = &lcColOrd
|
||
|
||
*!* modificare v 2.1.19
|
||
*!* lcHeader = [this.ct_grid_search1._grid1.column] + Alltrim(Str(I))+ [.grh]+Alltrim(Str(I))+[.]+[Caption]
|
||
lcHeader = [loCtGridSearch._GRID1.column] + Alltrim(Str(i)) + [.grh] + Alltrim(Str(i))
|
||
If Type(lcHeader) = 'O'
|
||
lcHeader = lcHeader + [.Caption]
|
||
Else
|
||
*!* daca nu se poate ordona dupa coloana respectiva, atunci am Header1 in loc de grhI
|
||
lcHeader = [loCtGridSearch._GRID1.column] + Alltrim(Str(i)) + [.header1.Caption]
|
||
Endif
|
||
*!* modificare v 2.1.19 ^
|
||
lcHeader2 = &lcHeader
|
||
|
||
lcControlSource = [loCtGridSearch._grid1.column] + Alltrim(Str(i)) + [.ControlSource]
|
||
lcControlSource2 = &lcControlSource
|
||
|
||
lcWidthColumn = [loCtGridSearch._grid1.column] + Alltrim(Str(i)) + [.width]
|
||
lcWidthColumn2 = Alltrim(Str(&lcWidthColumn))
|
||
|
||
Insert Into crsGrid (ordine, titlu, ctrSource, widthCol) Values (lnColOrd, lcHeader2, lcControlSource2, lcWidthColumn2)
|
||
Endif
|
||
Endfor
|
||
|
||
|
||
Select * From crsGrid Order By ordine Into Cursor crsGridOrd
|
||
Use In (Select('crsGrid'))
|
||
|
||
lcTitluCol = ""
|
||
lcNumeCol = ""
|
||
lcWidthCol = ""
|
||
Select crsGridOrd
|
||
Scan
|
||
lcTitluCol = lcTitluCol + Alltrim(titlu) + ","
|
||
lcNumeCol = lcNumeCol + Alltrim(ctrSource) + ";"
|
||
lcWidthCol = lcWidthCol + Alltrim(widthCol) + ";"
|
||
|
||
Select crsGridOrd
|
||
Endscan
|
||
|
||
lcTitluCol = Substr(lcTitluCol, 1, Len(lcTitluCol) - 1)
|
||
lcNumeCol = Substr(lcNumeCol, 1, Len(lcNumeCol) - 1)
|
||
lcWidthCol = Substr(lcWidthCol, 1, Len(lcWidthCol) - 1)
|
||
|
||
lcOrd = [loCtGridSearch.corder]
|
||
lcOrdine = &lcOrd
|
||
|
||
|
||
Select (m.lcCursor)
|
||
Scatter Name loSelectie Memo Blank
|
||
With loSelectie
|
||
.titlu_Col = m.lcTitluCol
|
||
.nume_col = m.lcNumeCol
|
||
.ordine = m.lcOrdine
|
||
.width_Col = m.lcWidthCol
|
||
.pornire = m.lnPornire
|
||
Endwith
|
||
|
||
If !Empty(m.lcSearchColumn)
|
||
loSelectie.&lcSearchColumn = luSearchValue && loSelectii.id_sel = oSet.id_selSt
|
||
|
||
Locate For &lcSearchColumn = luSearchValue
|
||
If Found()
|
||
Delete
|
||
Endif
|
||
Else
|
||
Go Top
|
||
Delete
|
||
Endif
|
||
|
||
Insert Into (m.lcCursor) From Name loSelectie
|
||
|
||
|
||
lcCursorXML = ''
|
||
Cursortoxml(m.lcCursor, "lcCursorXML", 2, 0 + 2 + 8, 0, "1")
|
||
|
||
scrie_optiune_utilizator(m.lcOptiune, lcCursorXML, "Ordinea coloanelor in tabelul din stanga in formularele de nir, bon, etc.")
|
||
|
||
Select (m.lcSelect)
|
||
Endproc && SCRIE_SELECTII_OPTIUNI_UTILIZATOR
|
||
|
||
|
||
*----------------------------------------------------------------------
|
||
* Function....: ExportToXMLExcel
|
||
* Author......: Core concepts presented at SW Fox 2009 by Cristof Wollenhaupt
|
||
* : Enhancements 11/21/2009 by Stein Goering
|
||
* Abstract....: Exports the current cursor to Excel (XMLSS format), optionally creates file
|
||
* Returns.....: XML string, or number of bytes written if file is specified
|
||
* Parameters..: Path and Filename of Excel file (optional)
|
||
* Notes.......:
|
||
*----------------------------------------------------------------------
|
||
#If .F.
|
||
* Example of usage
|
||
Create Cursor Sample (cData C(30), nData N(9, 3), tData D, iData i, lData L)
|
||
Insert Into Sample Values("MadFox Rocks!", 0, {}, 5, .F.)
|
||
Insert Into Sample Values("abcdefghijklmnopqrstuvwxyz123", 34.987, Datetime(), -32760, .T.)
|
||
Insert Into Sample Values("1.23", 56, Datetime(), 6, .F.)
|
||
Browse
|
||
|
||
If ExportToXMLExcel("Sample.xls") = 0
|
||
Wait Window [Problem writing file]
|
||
Endif
|
||
#Endif
|
||
|
||
Function ExportToXMLExcel(lcFileName)
|
||
Local lcWorksheet, lcPoint, lcData, lcRow, lnField, luValue, lcFieldName, lcType, lnWidth, lcColDef, lnCols
|
||
Local lcHeading, lnRows, lcStyles
|
||
*--------------------------------------------------------------------------------------
|
||
* Set up environment
|
||
*--------------------------------------------------------------------------------------
|
||
lcPoint = Set("Point")
|
||
Set Point To "."
|
||
|
||
*--------------------------------------------------------------------------------------
|
||
* Create the style string
|
||
*--------------------------------------------------------------------------------------
|
||
Set Textmerge Delimiters
|
||
Text To lcStyles Noshow Pretext 3
|
||
<Style ss:ID="numformat">
|
||
<NumberFormat ss:Format="Fixed"/>
|
||
</Style>
|
||
<Style ss:ID="numformat0">
|
||
<NumberFormat ss:Format="0"/>
|
||
</Style>
|
||
<Style ss:ID="numformat1">
|
||
<NumberFormat ss:Format="0.0"/>
|
||
</Style>
|
||
<Style ss:ID="numformat2">
|
||
<NumberFormat ss:Format="0.00"/>
|
||
</Style>
|
||
<Style ss:ID="numformat3">
|
||
<NumberFormat ss:Format="0.000"/>
|
||
</Style>
|
||
<Style ss:ID="numformat4">
|
||
<NumberFormat ss:Format="0.0000"/>
|
||
</Style>
|
||
<Style ss:ID="timeformat">
|
||
<NumberFormat ss:Format="[$-409]m/d/yy\ h:mm\ AM/PM;@"/>
|
||
</Style>
|
||
<Style ss:ID="dateformat">
|
||
<NumberFormat ss:Format="Short Date"/>
|
||
</Style>
|
||
<Style ss:ID="heading">
|
||
<Alignment ss:Horizontal="Center" ss:Vertical="Bottom"/>
|
||
<Font ss:Bold="1" />
|
||
</Style>
|
||
Endtext
|
||
*--------------------------------------------------------------------------------------
|
||
* Assemble the column width and heading strings
|
||
*--------------------------------------------------------------------------------------
|
||
lcHeading = "<Row>"
|
||
lcColDef = []
|
||
Dimension laFields[1]
|
||
lnCols = Afields(laFields)
|
||
For lnField = 1 To lnCols
|
||
lcFieldName = Proper(Strtran(laFields[m.lnField, 1], [_], [ ]))
|
||
lcHeading = m.lcHeading + ;
|
||
[<Cell ss:StyleID="heading"><Data ss:Type="String">] + Strconv(lcFieldName, 9) + [</Data></Cell>]
|
||
lcType = laFields[m.lnField, 2]
|
||
lnWidth = Icase(lcType = [C], laFields[m.lnField, 3] * 4.5, lcType = [N], laFields[m.lnField, 3] * 5, lcType = [I], 40, lcType = [D], 60, lcType = [T], 90, lcType = [L], 25, 50)
|
||
lnWidth = Max(lnWidth, Len(lcFieldName) * 6) && Make sure col is wide enough to show the heading
|
||
Text To lcColDef Additive Textmerge Noshow Pretext 3
|
||
<Column ss:AutoFitWidth="0" ss:Width="<<TRANSFORM(lnWidth)>>"/>
|
||
Endtext
|
||
Endfor
|
||
lcHeading = m.lcHeading + "</Row>"
|
||
*--------------------------------------------------------------------------------------
|
||
* Assemble the content string
|
||
*--------------------------------------------------------------------------------------
|
||
lcData = ""
|
||
lnRows = 1
|
||
Scan
|
||
lcRow = "<Row>"
|
||
For lnField = 1 To lnCols
|
||
luValue = Evaluate(Field(m.lnField))
|
||
lcType = laFields[m.lnField, 2]
|
||
Do Case
|
||
Case lcType == "C"
|
||
luValue = Alltrim(Nvl(m.luValue, ""))
|
||
lcRow = m.lcRow + ;
|
||
[<Cell><Data ss:Type="String">] + Strconv(m.luValue, 9) + [</Data></Cell>]
|
||
Case lcType == "L"
|
||
luValue = Iif(m.luValue, [True], [False])
|
||
lcRow = m.lcRow + ;
|
||
[<Cell><Data ss:Type="String">] + Strconv(m.luValue, 9) + [</Data></Cell>]
|
||
Case lcType == "N"
|
||
lcRow = m.lcRow + ;
|
||
[<Cell ss:StyleID="numformat] + Transform(laFields[m.lnField, 4]) + ["><Data ss:Type="Number">] + Transform(Nvl(m.luValue, 0)) + ;
|
||
[</Data></Cell>]
|
||
Case lcType == "I"
|
||
lcRow = m.lcRow + ;
|
||
[<Cell ss:StyleID="numformat0"><Data ss:Type="Number">] + Transform(Nvl(m.luValue, 0)) + ;
|
||
[</Data></Cell>]
|
||
Case lcType == "D"
|
||
If Empty(m.luValue)
|
||
lcRow = m.lcRow + ;
|
||
[<Cell ss:StyleID="dateformat"/>]
|
||
Else
|
||
lcRow = m.lcRow + ;
|
||
[<Cell ss:StyleID="dateformat"><Data ss:Type="DateTime">] + Ttoc(Evl(m.luValue, Dtot(Date(1899, 1, 1))), 3) + ;
|
||
[</Data></Cell>]
|
||
Endif
|
||
Case lcType == "T"
|
||
If Empty(m.luValue)
|
||
lcRow = m.lcRow + ;
|
||
[<Cell ss:StyleID="timeformat"/>]
|
||
Else
|
||
lcRow = m.lcRow + ;
|
||
[<Cell ss:StyleID="timeformat"><Data ss:Type="DateTime">] + Ttoc(Evl(m.luValue, Dtot(Date(1899, 1, 1))), 3) + ;
|
||
[</Data></Cell>]
|
||
Endif
|
||
Otherwise
|
||
Assert .F. Message "Type not supported"
|
||
Endcase
|
||
lnRows = lnRows + 1
|
||
Endfor
|
||
lcRow = m.lcRow + "</Row>"
|
||
lcData = m.lcData + m.lcRow
|
||
Endscan
|
||
|
||
*--------------------------------------------------------------------------------------
|
||
* Merge the results into the template
|
||
*--------------------------------------------------------------------------------------
|
||
Text To m.lcWorksheet Textmerge Noshow Pretext 3
|
||
<?xml version="1.0"?>
|
||
<Workbook xmlns="urn:schemas-microsoft-com:office:spreadsheet"
|
||
xmlns:x="urn:schemas-microsoft-com:office:excel"
|
||
xmlns:ss="urn:schemas-microsoft-com:office:spreadsheet">
|
||
<Styles>
|
||
<<m.lcStyles>>
|
||
</Styles>
|
||
<Worksheet ss:Name="Sheet1">
|
||
<Table ss:ExpandedColumnCount="<<TRANSFORM(lnCols)>>" ss:ExpandedRowCount="<<TRANSFORM(lnRows)>>"
|
||
x:FullColumns="1" x:FullRows="1">
|
||
<<m.lcColDef>>
|
||
<<m.lcHeading>>
|
||
<<m.lcData>>
|
||
</Table>
|
||
</Worksheet>
|
||
</Workbook>
|
||
Endtext
|
||
|
||
*--------------------------------------------------------------------------------------
|
||
* Restore environment
|
||
*--------------------------------------------------------------------------------------
|
||
Set Point To m.lcPoint
|
||
|
||
If !Empty(lcFileName)
|
||
Return Strtofile(m.lcWorksheet, lcFileName)
|
||
Else
|
||
Return m.lcWorksheet
|
||
Endif
|
||
|
||
Endfunc && ExportToXMLExcel
|
||
|
||
|
||
*--------------------------------------------------------------------------------------
|
||
* calculeaza procentul de tva din tva/pret
|
||
*--------------------------------------------------------------------------------------
|
||
Function TVA2PROCTVA
|
||
Lparameters tnTVA, tnPret
|
||
Local lnProcTVA
|
||
lnProcTVA = 1
|
||
If tnPret = 0 Or tnTVA = 0
|
||
lnProcTVA = 1
|
||
Else
|
||
lnProcTVA = Round(tnTVA/tnPret, 2)
|
||
DO CASE
|
||
CASE gnAn*12+gnLuna >= 2025*12+8
|
||
DO CASE
|
||
CASE Between(lnProcTVA, 0.10, 0.12)
|
||
lnProcTVA = 1.11
|
||
CASE Between(lnProcTVA, 0.20, 0.22)
|
||
lnProcTVA = 1.21
|
||
OTHERWISE
|
||
lnProcTVA = 1.21
|
||
ENDCASE
|
||
|
||
CASE BETWEEN(gnAn*12+gnLuna, 2024*12+1, 2025*12+7)
|
||
DO CASE
|
||
CASE Between(lnProcTVA, 0.08, 0.11)
|
||
lnProcTVA = 1.09
|
||
CASE Between(lnProcTVA, 0.18, 0.20)
|
||
lnProcTVA = 1.19
|
||
CASE Between(lnProcTVA, 0.04, 0.06)
|
||
lnProcTVA = 1.05
|
||
OTHERWISE
|
||
lnProcTVA = 1.19
|
||
ENDCASE
|
||
OTHERWISE
|
||
lnProcTVA = GetCoeficientTvaStandard()
|
||
ENDCASE
|
||
ENDIF
|
||
Return lnProcTVA
|
||
Endfunc && TVA2PROCTVA
|
||
*!* roagest v 2.0.24 ^
|
||
|
||
*!* INTOARCE IDJTVA PENTRU COTA STANDARD IN FUNCTIE DE LUNA
|
||
*!* 07/2010 S-A MODIFICAT TVA 24%
|
||
FUNCTION GetIdJtvaStandard(tcTip, tnProcTVA)
|
||
*!* tcRegistru: JC/JV
|
||
*!* tcTip: VANZARE/VANZARE_TI
|
||
*!* ACHIZITIE/ACHIZITIE_CAPITAL/ACHIZITIE_VANZARE/ACHIZITIE_MATERII/
|
||
*!* ACHIZITIE_TI/ACHIZITIE_TI_CAPITAL/ACHIZITIE_TI_VANZARE/ACHIZITIE_TI_MATERII
|
||
|
||
LOCAL lcTip, lnIdJtvaStandard, lnIdVanzareNepl
|
||
Local lnIdVanzare, lnIdVanzareTI, lnIdAchizitieCapital, lnIdAchizitieVanzare, lnIdAchizitieMaterii
|
||
Local lnIdAchizitieTICapital, lnIdAchizitieTIVanzare, lnIdAchizitieTIMaterii, lnIdAchizitie, lnIdAchizitieTI
|
||
|
||
lcTip = IIF(EMPTY(tcTip) OR TYPE('tcTip') <> 'C', 'VANZARE', UPPER(ALLTRIM(m.tcTip)))
|
||
lnProcTVA = IIF(TYPE('tnProcTVA') = 'N', m.tnProcTVA, GetProcTvaStandard())
|
||
|
||
lnIdVanzareNepl = 8
|
||
lnIdAchizitieNepl = 113
|
||
DO CASE
|
||
CASE m.gnAn * 12 + m.gnLuna >= 2025 * 12 + 8
|
||
* 21%
|
||
lnIdVanzare = IIF(lnProcTVA = 21, 35, IIF(lnProcTVA = 11, 39, 35))
|
||
lnIdVanzareTI = 5
|
||
|
||
lnIdAchizitieCapital = IIF(lnProcTVA = 21, 208, IIF(lnProcTVA = 11, 212, 208))
|
||
lnIdAchizitieVanzare = IIF(lnProcTVA = 21, 208, IIF(lnProcTVA = 11, 212, 208))
|
||
lnIdAchizitieMaterii = IIF(lnProcTVA = 21, 208, IIF(lnProcTVA = 11, 212, 208))
|
||
lnIdAchizitieTICapital = IIF(lnProcTVA = 21, 216, IIF(lnProcTVA = 11, 212, 218))
|
||
lnIdAchizitieTIVanzare = IIF(lnProcTVA = 21, 216, IIF(lnProcTVA = 11, 212, 218))
|
||
lnIdAchizitieTIMaterii = IIF(lnProcTVA = 21, 216, IIF(lnProcTVA = 11, 212, 218))
|
||
|
||
CASE m.gnAn * 12 + m.gnLuna <= 2010 * 12 + 6
|
||
* 19%
|
||
lnIdVanzare = 1
|
||
lnIdVanzareTI = 5
|
||
lnIdAchizitieCapital = 101
|
||
lnIdAchizitieVanzare = 103
|
||
lnIdAchizitieMaterii = 105
|
||
lnIdAchizitieTICapital = 137
|
||
lnIdAchizitieTIVanzare = 139
|
||
lnIdAchizitieTIMaterii = 141
|
||
OTHERWISE
|
||
lnIdVanzare = IIF(lnProcTVA = 24, 15, IIF(lnProcTVA = 20, 27, IIF(lnProcTVA = 19, 1, IIF(lnProcTVA = 9, 3, 13))))
|
||
lnIdVanzareTI = 5
|
||
lnIdAchizitieCapital = IIF(lnProcTVA = 24, 156, IIF(lnProcTVA = 20, 176, IIF(lnProcTVA = 19, 101, IIF(lnProcTVA = 9, 107, 176))))
|
||
lnIdAchizitieVanzare = IIF(lnProcTVA = 24, 156, IIF(lnProcTVA = 20, 176, IIF(lnProcTVA = 19, 103, IIF(lnProcTVA = 9, 109, 176))))
|
||
lnIdAchizitieMaterii = IIF(lnProcTVA = 24, 156, IIF(lnProcTVA = 20, 176, IIF(lnProcTVA = 19, 105, IIF(lnProcTVA = 9, 111, 176))))
|
||
lnIdAchizitieTICapital = IIF(lnProcTVA = 24, 162, IIF(lnProcTVA = 20, 186, IIF(lnProcTVA = 19, 137, IIF(lnProcTVA = 9, 143, 186))))
|
||
lnIdAchizitieTIVanzare = IIF(lnProcTVA = 24, 162, IIF(lnProcTVA = 20, 186, IIF(lnProcTVA = 19, 139, IIF(lnProcTVA = 9, 143, 186))))
|
||
lnIdAchizitieTIMaterii = IIF(lnProcTVA = 24, 162, IIF(lnProcTVA = 20, 186, IIF(lnProcTVA = 29, 141, IIF(lnProcTVA = 9, 145, 186))))
|
||
ENDCASE
|
||
lnIdAchizitie = lnIdAchizitieMaterii
|
||
lnIdAchizitieTI = lnIdAchizitieTIMaterii
|
||
|
||
lnIdJtvaStandard = lnIdVanzare
|
||
DO CASE
|
||
CASE 'VANZARE'$lcTip AND m.gnNEPLATITOARE_TVA = 1
|
||
lnIdJtvaStandard = m.lnIdVanzareNepl
|
||
CASE 'ACHZITIE'$lcTip AND m.gnNEPLATITOARE_TVA = 1
|
||
lnIdJtvaStandard = m.lnIdAchizitieNepl
|
||
CASE lcTip = 'VANZARE'
|
||
lnIdJtvaStandard = m.lnIdVanzare
|
||
CASE lcTip = 'VANZARE_TI'
|
||
lnIdJtvaStandard = lnIdVanzareTI
|
||
CASE lcTip = 'ACHIZITIE'
|
||
lnIdJtvaStandard = m.lnIdAchizitie
|
||
CASE lcTip = 'ACHIZITIE_CAPITAL'
|
||
lnIdJtvaStandard = lnIdAchizitieCapital
|
||
CASE lcTip = 'ACHIZITIE_VANZARE'
|
||
lnIdJtvaStandard = lnIdAchizitieVanzare
|
||
CASE lcTip = 'ACHIZITIE_MATERII'
|
||
lnIdJtvaStandard = lnIdAchizitieMaterii
|
||
CASE lcTip = 'ACHIZITIE_TI'
|
||
lnIdJtvaStandard = lnIdAchizitieTI
|
||
CASE lcTip = 'ACHIZITIE_TI_CAPITAL'
|
||
lnIdJtvaStandard = lnIdAchizitieTICapital
|
||
CASE lcTip = 'ACHIZITIE_TI_VANZARE'
|
||
lnIdJtvaStandard = lnIdAchizitieTIVanzare
|
||
CASE lcTip = 'ACHIZITIE_MATERII'
|
||
lnIdJtvaStandard = lnIdAchizitieTIMaterii
|
||
ENDCASE
|
||
RETURN lnIdJtvaStandard
|
||
ENDFUNC
|
||
|
||
|
||
***********************************************************************
|
||
*!* INTOARCE PROCENTUL DE TVA STANDARD IN FUNCTIE DE LUNA 24
|
||
*!* 07/2010 S-A MODIFICAT TVA 24%
|
||
*!* 01/2016 S-A MODIFICAT TVA 20%
|
||
*!* 01/2017 S-A MODIFICAT TVA 19%, 9%, 5%
|
||
*!* 08/2025 S-A MODIFICAT TVA 21% , 11%
|
||
FUNCTION GetProcTvaStandard
|
||
LOCAL lnAn, lnLuna, lnProcTva
|
||
|
||
lnAn = m.gnAn
|
||
lnLuna = m.gnLuna
|
||
lnProcTva = 21
|
||
|
||
DO CASE
|
||
CASE m.lnAn * 12 + m.lnLuna >= 2025 * 12 + 8
|
||
lnProcTva = 21
|
||
CASE BETWEEN(m.lnAn * 12 + m.lnLuna, 2007*12+1, 2010 * 12 + 7)
|
||
lnProcTva = 19
|
||
CASE BETWEEN(m.lnAn * 12 + m.lnLuna, 2010*12+8, 2015 * 12 + 12)
|
||
lnProcTva = 24
|
||
CASE BETWEEN(m.lnAn * 12 + m.lnLuna, 2016*12+1, 2016 * 12 + 12)
|
||
lnProcTva = 20
|
||
CASE BETWEEN(m.lnAn * 12 + m.lnLuna, 2017*12+1, 2025 * 12 + 7)
|
||
lnProcTva = 19
|
||
ENDCASE
|
||
RETURN m.lnProcTva
|
||
ENDFUNC
|
||
|
||
***********************************************************************
|
||
*!* INTOARCE COEFICIENTUL DE TVA STANDARD IN FUNCTIE DE LUNA 1.24
|
||
*!* 07/2010 S-A MODIFICAT TVA 24%
|
||
FUNCTION GetCoeficientTvaStandard
|
||
LOCAL lnAn, lnLuna, lnProcTva
|
||
|
||
lnAn = m.gnAn
|
||
lnLuna = m.gnLuna
|
||
lnProcTva = 1.21
|
||
|
||
DO CASE
|
||
CASE m.lnAn * 12 + m.lnLuna >= 2025 * 12 + 8
|
||
lnProcTva = 1.21
|
||
CASE BETWEEN(m.lnAn * 12 + m.lnLuna, 2007*12+1, 2010 * 12 + 7)
|
||
lnProcTva = 1.19
|
||
CASE BETWEEN(m.lnAn * 12 + m.lnLuna, 2010*12+8, 2015 * 12 + 12)
|
||
lnProcTva = 1.24
|
||
CASE BETWEEN(m.lnAn * 12 + m.lnLuna, 2016*12+1, 2016 * 12 + 12)
|
||
lnProcTva = 1.20
|
||
CASE BETWEEN(m.lnAn * 12 + m.lnLuna, 2017*12+1, 2025 * 12 + 7)
|
||
lnProcTva = 1.19
|
||
ENDCASE
|
||
|
||
RETURN m.lnProcTva
|
||
ENDFUNC
|
||
|
||
***********************************************************************************
|
||
*** Primeste un procent TVA si intoarce IdJTVA standard
|
||
***********************************************************************************
|
||
FUNCTION ProcentTva2IdJtva
|
||
LPARAMETERS tnProcentTVA, tcTipJ, tlTaxareInversa, tnTvaIncasare
|
||
|
||
* tnProcentTVA : procent TVA 0/5/9/19/11/21
|
||
* tlTaxareInvesa : .T. daca este taxare inversa
|
||
* tnTvaIncasare : 1 daca este TVA incasare
|
||
* tcTipJ : Tip Jurnal JV/JC
|
||
|
||
Local lcTipJ, lnIdJtva, lnIdJtvaNeex
|
||
lnIdJtva = 0
|
||
|
||
lcTipJ = IIF(INLIST(UPPER(m.tcTipJ), 'JV', 'JC'), UPPER(m.tcTipJ), 'JV')
|
||
|
||
|
||
DO CASE
|
||
CASE m.tnProcentTVA = 21 AND tcTipJ = 'JV'
|
||
lnIdJtva = IIF(!m.tlTaxareInversa, 35, 5)
|
||
CASE m.tnProcentTVA = 11 AND tcTipJ = 'JV'
|
||
lnIdJtva = IIF(!m.tlTaxareInversa, 39, 5)
|
||
CASE m.tnProcentTVA = 19 AND tcTipJ = 'JV'
|
||
lnIdJtva = IIF(!m.tlTaxareInversa, 1, 5)
|
||
CASE m.tnProcentTVA = 9 AND tcTipJ = 'JV'
|
||
lnIdJtva = IIF(!m.tlTaxareInversa, 3, 5)
|
||
CASE m.tnProcentTVA = 5 AND tcTipJ = 'JV'
|
||
lnIdJtva = IIF(!m.tlTaxareInversa, 13, 5)
|
||
CASE m.tnProcentTVA = 0 AND tcTipJ = 'JV'
|
||
lnIdJtva = IIF(!m.tlTaxareInversa, 8, 5) && ALTE LIVR. SCUTITE CU DREPT DE DEDUCERE
|
||
|
||
CASE m.tnProcentTVA = 21 AND tcTipJ = 'JC'
|
||
lnIdJtva = IIF(!m.tlTaxareInversa, 208, 216)
|
||
CASE m.tnProcentTVA = 11 AND tcTipJ = 'JC'
|
||
lnIdJtva = IIF(!m.tlTaxareInversa, 212, 218)
|
||
CASE m.tnProcentTVA = 19 AND tcTipJ = 'JC'
|
||
lnIdJtva = IIF(!m.tlTaxareInversa, 105, 141)
|
||
CASE m.tnProcentTVA = 9 AND tcTipJ = 'JC'
|
||
lnIdJtva = IIF(!m.tlTaxareInversa, 111, 145)
|
||
CASE m.tnProcentTVA = 5 AND tcTipJ = 'JC'
|
||
lnIdJtva = IIF(!m.tlTaxareInversa, 154, 154)
|
||
CASE m.tnProcentTVA = 0 AND tcTipJ = 'JC'
|
||
lnIdJtva = IIF(!m.tlTaxareInversa, 113, 216) && ACH. INT. SCUTITE/NEIMPOZABILE
|
||
ENDCASE
|
||
|
||
IF m.tnTvaIncasare = 1 AND !EMPTY(m.lnIdJtva)
|
||
lnIdJtvaNeex = getIdJtvaColoana(m.lnIdJtva, m.tnTvaIncasare)
|
||
If m.lnIdJtvaNeex <> 0
|
||
lnIdJtva = m.lnIdJtvaNeex
|
||
Endif
|
||
ENDIF
|
||
|
||
RETURN m.lnIdJtva
|
||
|
||
ENDFUNC
|
||
|
||
***********************************************************************************
|
||
*** Apeleaza getIdJtvaColoana si intoarce un obiect din vjtva_coloane
|
||
***********************************************************************************
|
||
Function GeJtvaColoana
|
||
Lparameters tnIdJtva, tnTvaIncasare, tcTipJ
|
||
|
||
Local loRec
|
||
getIdJtvaColoana(tnIdJtva, tnTvaIncasare, tcTipJ, @loRec)
|
||
|
||
Return loRec
|
||
Endfunc
|
||
|
||
***********************************************************************************
|
||
*** baza. id_jtva_coloana exigibil/neexigibil corespunzator id_jtva_coloana selectat
|
||
***********************************************************************************
|
||
Function getIdJtvaColoana
|
||
Lparameters tnIdJtva, tnTvaIncasare, tcTipJ, toRec
|
||
|
||
*** tnTVAIncasare = 0 > tnIdJtva este neexigibil
|
||
*** tcTipJ: JC, JV (default)
|
||
*** toRec (OUT) obiect din vjtva_coloane corespunzator IdJtva
|
||
|
||
Local lnIdJtva, lcAlias, lcCursor, llCursorJTvaColoane, lcTipJ
|
||
If !Empty(m.tcTipJ)
|
||
lcTipJ = Upper(m.tcTipJ)
|
||
Else
|
||
lcTipJ = [JV]
|
||
Endif
|
||
|
||
llCursorJTvaColoane = .T.
|
||
lcAlias = Select()
|
||
lcCursor = [crsjtvacoltemp]
|
||
lnIdJtva = tnIdJtva
|
||
If !Used('jtva_coloane')
|
||
llCursorJTvaColoane = .F.
|
||
update_jtva_coloane(m.lcTipJ)
|
||
Endif
|
||
*copiaza_structura_cursor([jtva_coloane],lcCursor)
|
||
Select * From jtva_coloane Into Cursor (lcCursor)
|
||
Select (lcCursor)
|
||
Scatter Name toRec Blank Memo
|
||
Locate For id_jtva_coloana = tnIdJtva
|
||
If Found()
|
||
If !Empty(tnTvaIncasare)
|
||
lnIdJtva = Nvl(id_jtva_neex, id_jtva_coloana)
|
||
Else
|
||
lnIdJtva = Nvl(id_jtva_ex, id_jtva_coloana)
|
||
Endif
|
||
|
||
Locate For id_jtva_coloana = m.lnIdJtva
|
||
If Found()
|
||
Scatter Name toRec Memo
|
||
Endif
|
||
Endif
|
||
|
||
Use In (Select(lcCursor))
|
||
If !llCursorJTvaColoane
|
||
Use In jtva_coloane
|
||
Endif
|
||
Select (lcAlias)
|
||
Return lnIdJtva
|
||
Endfunc
|
||
|
||
***********************************************************************************
|
||
*** Apeleaza getIdTva si intoarce un obiect din vjtva_coloane
|
||
***********************************************************************************
|
||
Function GeTvaColoana
|
||
Lparameters tnIdJtva, tnTvaIncasare, tcTipJ
|
||
|
||
Local loRec
|
||
getIdTva(tnIdJtva, tnTvaIncasare, tcTipJ, @loRec)
|
||
|
||
Return loRec
|
||
Endfunc
|
||
|
||
***********************************************************************************
|
||
*** tva.id_tva exigibil/neexigibil corespunzator id_tva selectat
|
||
***********************************************************************************
|
||
Function getIdTva
|
||
Lparameters tnIdTva, tnTvaIncasare, tcTipJ, toRec
|
||
|
||
*** tnTVAIncasare = 0 > tnIdTva este neexigibil
|
||
*** tcTipJ: JC, JV
|
||
*** toRec (OUT) obiect din vjtva_coloane corespunzator IdJtva
|
||
|
||
Local lnIdTva, lnIdJTvaColoana, lcAlias, lcCursor, llCursorJTvaColoane, lcTipJ
|
||
|
||
If !Empty(m.tcTipJ)
|
||
lcTipJ = Upper(m.tcTipJ)
|
||
Else
|
||
lcTipJ = [JV]
|
||
Endif
|
||
|
||
llCursorJTvaColoane = .T.
|
||
lcAlias = Select()
|
||
lcCursor = [crsjtvacoltemp]
|
||
lnIdTva = tnIdTva
|
||
If !Used('jtva_coloane')
|
||
llCursorJTvaColoane = .F.
|
||
update_jtva_coloane(m.lcTipJ)
|
||
Endif
|
||
*copiaza_structura_cursor([jtva_coloane],lcCursor)
|
||
Select * From jtva_coloane Into Cursor (lcCursor)
|
||
Select (lcCursor)
|
||
Scatter Name toRec Blank Memo
|
||
Locate For id_tva = tnIdTva
|
||
If Found()
|
||
If !Empty(tnTvaIncasare)
|
||
lnIdJTvaColoana = Nvl(id_jtva_neex, id_jtva_coloana)
|
||
Else
|
||
lnIdJTvaColoana = Nvl(id_jtva_ex, id_jtva_coloana)
|
||
Endif
|
||
Locate For id_jtva_coloana = lnIdJTvaColoana
|
||
If Found()
|
||
lnIdTva = Nvl(id_tva, id_jtva_coloana)
|
||
|
||
Locate For id_jtva_coloana = m.lnIdTva
|
||
If Found()
|
||
Scatter Name toRec Memo
|
||
Endif
|
||
Endif
|
||
Endif
|
||
|
||
Use In (Select(lcCursor))
|
||
If !llCursorJTvaColoane
|
||
Use In jtva_coloane
|
||
Endif
|
||
Select (lcAlias)
|
||
Return lnIdTva
|
||
Endfunc
|
||
|
||
************************************
|
||
*** creeaza cursorul cIsJTVACE la prima apelare a functiei si intoarce .T. daca tnIdJTVA este achizitie CE
|
||
************************************
|
||
Function IsJCJtvaCE
|
||
Lparameters tnIdJtva
|
||
|
||
Local llSucces, llReturn, lcSelect
|
||
llReturn = .F.
|
||
lcSelect = Select()
|
||
If !Used('cIsJTVACE')
|
||
llSucces = goExecutor.oExecuta([SELECT id_jtva_coloana as id_jtva FROM jtva_coloane WHERE denumire like 'TVA%' and denumire like '%CE%'], 'cIsJTVACE')
|
||
Endif
|
||
If Used('cIsJTVACE')
|
||
Select cIsJTVACE
|
||
Locate For id_jtva = m.tnIdJtva
|
||
llReturn = Found()
|
||
Endif
|
||
|
||
Select (m.lcSelect)
|
||
Return m.llReturn
|
||
Endfunc
|
||
|
||
|
||
***********************
|
||
*** Intoarce jtva_coloane.taxcode aferent unui id_jtva_coloana, Partener
|
||
FUNCTION GetTaxCodeIdPart
|
||
LPARAMETERS tnAn, tnLuna, tdDataAct, tnIdJTVA, tnIdPart, tlN50, tlN100, tlNeexigibil
|
||
* tnAn = anul curent
|
||
* tnLuna = luna curenta
|
||
* tdDataAct = data documentului, pentru facturi de regularizare inregistrate cu data din alta luna decat luna curenta
|
||
* tnIdJTVA = explicatia TVA
|
||
* tnIdPart = id partener pentru verificare furnizor TVA Incasare
|
||
* tlN50 = operatia are limitare deducere 50% (Taxa SAFT tip: Achizitie deductibil 50%)
|
||
* tlN100 = operatia are limitare deducere 100% (Taxa SAFT tip: Achizitie nedeductibil)
|
||
* tlNeexigibil = factura nesosita/neintocmita 408/418
|
||
|
||
* tlN50, tlN100 nu se mai folosesc
|
||
* baza facturii cu limitare deducere are codul ach. deductibile 100%,
|
||
* iar linia 6xx = 4426 limitare deducere are codul "ach. nedeductibile 50% cota TVA 19/9/5%"
|
||
* in loc de baza facturii "ach. nedeductibile 50%"
|
||
|
||
Local loPartenerRTVAI As "empty"
|
||
Local loPartenerRTVAIX As "empty"
|
||
Local lcCodFiscal, lcNumePart, lcSelect, ldDataAct, llFurnizorRTVAI, llJC, llRegularizare
|
||
Local llUsedJtvaColoane, lnIdPart, lnTaxCode
|
||
|
||
lcSelect = SELECT()
|
||
lnTaxCode = CAST(null as N(6))
|
||
|
||
IF !(TYPE('gl406') = 'L' AND m.gl406)
|
||
RETURN m.lnTaxCode
|
||
ENDIF
|
||
|
||
lnIdPart = NVL(m.tnIdPart,0)
|
||
llFurnizorRTVAI = .F.
|
||
ldDataAct = IIF(!EMPTY(m.tdDataAct), m.tdDataAct, DATE(m.tnAn, m.tnLuna, 1))
|
||
llRegularizare = YEAR(m.ldDataAct) * 12 + MONTH(m.ldDataAct) < m.tnAn*12+m.tnLuna
|
||
|
||
llUsedJtvaColoane = Used('jtva_coloane')
|
||
If !m.llUsedJtvaColoane
|
||
update_jtva_coloane()
|
||
ENDIF
|
||
|
||
llJC = .F.
|
||
IF SEEK(m.tnIdJTVA,'jtva_coloane','id_jtva')
|
||
llJC = (jtva_coloane.jc = 1)
|
||
ENDIF
|
||
If m.llJC AND !EMPTY(m.lnIdPart)
|
||
lnIdPart = Nvl(m.tnIdPart,0)
|
||
lcNumePart = ""
|
||
lcCodFiscal = GetCodFiscalPartenerById(m.lnIdPart)
|
||
|
||
loPartenerRTVAIX = Createobject("empty")
|
||
loPartenerRTVAI = Createobject("empty")
|
||
AddProperty(loPartenerRTVAIX, "cod_fiscal", m.lcCodFiscal)
|
||
AddProperty(loPartenerRTVAIX, "denumire", m.lcNumePart)
|
||
AddProperty(loPartenerRTVAIX, "dataact", m.ldDataAct)
|
||
VERIFICA_RTVAI(loPartenerRTVAIX, @loPartenerRTVAI)
|
||
|
||
llFurnizorRTVAI = loPartenerRTVAI.leinRtvai
|
||
Endif
|
||
|
||
IF !m.llUsedJtvaColoane
|
||
USE IN (SELECT('jtva_coloane'))
|
||
ENDIF
|
||
|
||
lnTaxCode = GetTaxCode(m.tnAn, m.tnLuna, m.tdDataAct, m.tnIdJTVA, m.llFurnizorRTVAI, tlN50, tlN100, tlNeexigibil)
|
||
|
||
SELECT (m.lcSelect)
|
||
|
||
RETURN m.lnTaxCode
|
||
ENDFUNC && GetTaxCodeIdPart
|
||
|
||
|
||
***********************
|
||
*** Intoarce jtva_coloane.taxcode aferent unui id_jtva_coloana, furnizor tva incasare
|
||
FUNCTION GetTaxCode
|
||
LPARAMETERS tnAn, tnLuna, tdDataAct, tnIdJTVA, tlFurnizorRTVAI, tlN50, tlN100, tlNeexigibil
|
||
* tnAn = anul curent
|
||
* tnLuna = luna curenta
|
||
* tdDataAct = data documentului, pentru facturi de regularizare inregistrate cu data din alta luna decat luna curenta
|
||
* tnIdJTVA = explicatia TVA
|
||
* tlFurnizoriRTVAI = furnizor TVA Incasare
|
||
* tlN50 = inregistrarea corespunde explicatiei TVA Limitare deducere 50% (Taxa SAFT tip: Achizitie nedeductibil 50%)
|
||
* tlN100 = inregistrarea corespunde explicatiei TVA Limitare deducere 100% (Taxa SAFT tip: Achizitie nedeductibil)
|
||
* tlNeexigibil = factura nesosita/neintocmita 408/418
|
||
|
||
* tlN50, tlN100 se folosesc doar pentru nota contabila cu explicatie TVA Limitare deducere TVA, in pereche cu Explicatie TVA Ach. 19/9/5%, astfel incat sa intoarca codul Ach neded. 50%/100% 19/9/5%
|
||
* baza facturii cu limitare deducere are codul ach. deductibile 100%,
|
||
* iar linia 6xx = 4426 limitare deducere are codul "ach. nedeductibile 50% cota TVA 19/9/5%"
|
||
* tlN50, tlN100 sunt .T. doar pentru linia 6xx = 4426 limitare deducere TVA
|
||
|
||
LOCAL lcSelect, llJtvaColoane, loTVA
|
||
Local llFurnizorRTVAI, llRegularizare, llUsedJtvaColoane, lnTaxCode, ldDataAct
|
||
lcSelect = SELECT()
|
||
lnTaxCode = CAST(null as N(6))
|
||
|
||
IF !(TYPE('gl406') = 'L' AND m.gl406)
|
||
RETURN m.lnTaxCode
|
||
ENDIF
|
||
llFurnizorRTVAI = m.tlFurnizorRTVAI
|
||
ldDataAct = IIF(!EMPTY(m.tdDataAct), m.tdDataAct, DATE(m.tnAn, m.tnLuna, 1))
|
||
llRegularizare = YEAR(m.ldDataAct) * 12 + MONTH(m.ldDataAct) < m.tnAn*12+m.tnLuna
|
||
llUsedJtvaColoane = USED("jtva_coloane_taxcode")
|
||
|
||
* Generez jtva_coloane_taxcode la prima utilizare si il las deschis
|
||
If !m.llUsedJtvaColoane
|
||
update_jtva_coloane("", "jtva_coloane_taxcode", 6)
|
||
ENDIF
|
||
|
||
IF SEEK(m.tnIdJTVA, "jtva_coloane_taxcode", "id_jtva")
|
||
SELECT jtva_coloane_taxcode
|
||
SCATTER NAME loTVA
|
||
WITH loTVA
|
||
* codul taxa regularizare are prioritate fata de ach. furnizor tva incasare
|
||
lnTaxCode = .taxcode
|
||
DO CASE
|
||
CASE m.tlNeexigibil AND !EMPTY(NVL(.taxcode_neexigibil,0))
|
||
lnTaxCode = .taxcode_neexigibil
|
||
CASE m.tlN50 AND m.llFurnizorRTVAI AND !EMPTY(NVL(.taxcode_n50_tvai,0))
|
||
lnTaxCode = .taxcode_n50_tvai
|
||
CASE m.tlN50
|
||
lnTaxCode = .taxcode_n50
|
||
CASE m.tlN100 AND m.llFurnizorRTVAI AND !EMPTY(NVL(.taxcode_n100,0))
|
||
lnTaxCode = .taxcode_n100
|
||
CASE m.tlN100
|
||
lnTaxCode = .taxcode_n100
|
||
CASE m.llRegularizare AND !EMPTY(NVL(.taxcode_regularizare,0))
|
||
lnTaxCode = .taxcode_regularizare
|
||
CASE m.llFurnizorRTVAI AND !EMPTY(NVL(.taxcode_tvai,0))
|
||
lnTaxCode = .taxcode_tvai
|
||
ENDCASE
|
||
ENDWITH
|
||
ENDIF
|
||
|
||
SELECT (m.lcSelect)
|
||
|
||
RETURN m.lnTaxCode
|
||
ENDFUNC && GetTaxCode
|
||
|
||
***********************
|
||
*** Intoarce cod mecanism plata SAFT aferent unui fel document
|
||
FUNCTION GetPaymentCode
|
||
LPARAMETERS tnIdFdoc
|
||
LOCAL lcSelect, lnIdFdoc
|
||
Local llUsedFdoc, lnPaymentCode
|
||
lcSelect = SELECT()
|
||
lnPaymentCode = NULL
|
||
|
||
lnIdFdoc = NVL(m.tnIdFdoc,0)
|
||
|
||
llUsedFdoc = Used('crsFdoc')
|
||
If !m.llUsedFdoc
|
||
update_fdoc()
|
||
ENDIF
|
||
|
||
select paymentcode FROM crsFdoc WHERE id_fdoc = m.lnIdFdoc INTO CURSOR crsFdocTemp
|
||
|
||
SELECT crsFdocTemp
|
||
GO TOP
|
||
lnPaymentCode = ALLTRIM(NVL(paymentcode,''))
|
||
|
||
IF !m.llUsedFdoc
|
||
USE IN (SELECT('crsFdoc'))
|
||
ENDIF
|
||
|
||
USE IN (SELECT('crsFdocTemp'))
|
||
SELECT (m.lcSelect)
|
||
|
||
RETURN m.lnPaymentCode
|
||
ENDFUNC && GetPaymentCode
|
||
|
||
********************************************************************************
|
||
*** concateneaza valorile dintr-o coloana de pe mai multe randuri
|
||
*** tcAlias = cursorul din care se face concatenarea
|
||
*** tcAggColumn = coloana care se concateneaza
|
||
*** tlDontIgnoreEmptyValues Default .F., .T = concateneaza si valorile empty(tcAggColumn)
|
||
*** tcSeparator = separatorul valorilor concatenate. Default = [,]
|
||
*** tcFilterColumn1..tcFilterColumn20 = coloana pentru filtrare/grupare
|
||
*** tcFilterValue1..tcFilterValue20 = valoarea coloanei pentru filtrare/grupare
|
||
*** intoare un sir de caractere
|
||
*** ex:
|
||
*!* CREATE CURSOR crsInfo (nract I, dataact D, info c(10), suma n(16,2))
|
||
*!* INSERT INTO crsInfo(nract, dataact, info, suma) values(1, DATE(), 'a',1.00)
|
||
*!* INSERT INTO crsInfo(nract, dataact, info, suma) values(1, DATE(), 'b',1.00)
|
||
*!* INSERT INTO crsInfo(nract, dataact, info, suma) values(1, DATE(), 'c',1.00)
|
||
*!* INSERT INTO crsInfo(nract, dataact, info, suma) values(2, DATE(), 'd',1.00)
|
||
*!* INSERT INTO crsInfo(nract, dataact, info, suma) values(2, DATE(), 'e',1.00)
|
||
*!* INSERT INTO crsInfo(nract, dataact, info, suma) values(2, DATE(), 'f',1.00)
|
||
*!* INSERT INTO crsInfo(nract, dataact, info, suma) values(2, DATE(), 'g',1.00)
|
||
*!* INSERT INTO crsInfo(nract, dataact, info, suma) values(3, DATE(), 'a',1.00)
|
||
*!* INSERT INTO crsInfo(nract, dataact, info, suma) values(3, DATE()-1, 'x',1.00)
|
||
|
||
*!* SELECT nract, dataact, SUM(suma) as suma, ;
|
||
*!* StringAgg('crsInfo', 'info', .F., [ ], [nract], nract, [dataact], dataact) as infoagg ;
|
||
*!* FROM crsinfo ;
|
||
*!* group by nract, dataact ;
|
||
*!* INTO CURSOR crsRezultat
|
||
********************************************************************************
|
||
Function StringAgg
|
||
Lparameters tcAlias, tcAggColumn, tlDontIgnoreEmptyValues, tcSeparator, ;
|
||
tcFilterColumn1, tcFilterValue1, tcFilterColumn2, tcFilterValue2, tcFilterColumn3, tcFilterValue3, tcFilterColumn4, tcFilterValue4, ;
|
||
tcFilterColumn5, tcFilterValue5, tcFilterColumn6, tcFilterValue6, tcFilterColumn7, tcFilterValue7, tcFilterColumn8, tcFilterValue8, ;
|
||
tcFilterColumn9, tcFilterValue9, tcFilterColumn10, tcFilterValue10, tcFilterColumn11, tcFilterValue11, tcFilterColumn12, tcFilterValue12, ;
|
||
tcFilterColumn13, tcFilterValue13, tcFilterColumn14, tcFilterValue14, tcFilterColumn15, tcFilterValue15, tcFilterColumn16, tcFilterValue16, ;
|
||
tcFilterColumn17, tcFilterValue17, tcFilterColumn18, tcFilterValue18, tcFilterColumn19, tcFilterValue19, tcFilterColumn20, tcFilterValue20
|
||
|
||
|
||
Local lcCursor, lcRezultat, lcSelect, lcSql, lcSeparator, loEx As Exception
|
||
Local lcFilter, lcFilterColumn, lcFilterColumnEval, lcFilterValue, i
|
||
|
||
lcRezultat = ""
|
||
lcSeparator = Iif(Type('tcSeparator') = 'C', tcSeparator, [,])
|
||
lcSelect = Select()
|
||
lcCursor = Sys(2015)
|
||
lcFilter = ""
|
||
For i = 1 To 20
|
||
lcFilterColumn = 'tcFilterColumn' + Alltrim(Str(i)) && tcFilterColumn1
|
||
If Type(lcFilterColumn) <> 'C'
|
||
Exit
|
||
Endif
|
||
lcFilterColumnEval = Evaluate(m.lcFilterColumn) && [nract]
|
||
|
||
lcFilterValue = 'tcFilterValue' + Alltrim(Str(i)) && tcFilterValue1
|
||
|
||
lcFilter = lcFilter + Iif(Type(m.lcFilterColumn) = 'C' And !Empty(lcFilterColumnEval), m.lcFilterColumnEval + [ = ] + lcFilterValue, "") + [ and ]
|
||
Endfor
|
||
If !Empty(m.lcFilter)
|
||
lcFilter = Left(m.lcFilter, Len(m.lcFilter) - 5)
|
||
Endif
|
||
lcFilter = Iif(!tlDontIgnoreEmptyValues, [!EMPTY(] + m.tcAggColumn + [)], []) + Iif(!Empty(m.lcFilter), [ and ], []) + m.lcFilter
|
||
|
||
lcSql = [SELECT distinct ] + tcAggColumn + [ as aggcolumn] + ;
|
||
[ FROM ] + m.tcAlias + ;
|
||
Iif(!Empty(m.lcFilter), [ WHERE ] + m.lcFilter, []) + ;
|
||
[ INTO CURSOR ] + m.lcCursor
|
||
|
||
&lcSql
|
||
|
||
Select (m.lcCursor)
|
||
Scan
|
||
lcRezultat = m.lcRezultat + Alltrim(Transform(aggcolumn)) + lcSeparator
|
||
Endscan
|
||
Use In (Select(m.lcCursor))
|
||
If !Empty(m.lcRezultat)
|
||
lcRezultat = Left(m.lcRezultat, Len(m.lcRezultat) - Len(m.lcSeparator))
|
||
Endif
|
||
|
||
Select (m.lcSelect)
|
||
Return m.lcRezultat
|
||
Endfunc && StringAgg
|
||
|
||
|
||
Function GetReportFooter
|
||
Lparameters tnPageTotal
|
||
|
||
Local lcReportFooter, llRaportDataOra, lcDataOra
|
||
llRaportDataOra = Iif(Type('glRaportDataOra') = 'L', m.glRaportDataOra, .T.)
|
||
lcDataOra = Iif(Type('pcDataOra') = 'U', Get_Ora(2), m.pcDataOra)
|
||
|
||
lcReportFooter = m.gcCopyRight + " - Pagina " + Allt(Str(_Pageno)) + "/" + Allt(Str(m.tnPageTotal)) + Iif(m.llRaportDataOra, " " + m.lcDataOra, "")
|
||
Return m.lcReportFooter
|
||
Endfunc
|
||
*********************************************************************************************************
|
||
Procedure creeaza_backup_cursoare
|
||
Lparameters tcOriginal
|
||
Local lcBackup
|
||
lcBackup = [bckp] + tcOriginal
|
||
sterge_backup_cursoare(tcOriginal)
|
||
copiaza_structura_cursor(tcOriginal, lcBackup)
|
||
Select * From (tcOriginal) Into Cursor (lcBackup)
|
||
Release lcBackup
|
||
Endproc && creeaza_backup_cursoare
|
||
*********************************************************************************************************
|
||
Procedure repune_backup_cursoare
|
||
Lparameters tcOriginal
|
||
Local lcBackup
|
||
lcBackup = [bckp] + tcOriginal
|
||
If Used(lcBackup)
|
||
Select (tcOriginal)
|
||
lnRecno = Recno()
|
||
Select * From (lcBackup) Into Cursor (tcOriginal) Readwrite
|
||
Use In (lcBackup)
|
||
Select (tcOriginal)
|
||
If Reccount(tcOriginal) > 0
|
||
Go Min(lnRecno, Reccount(tcOriginal))
|
||
Else
|
||
Go Top
|
||
Endif
|
||
Endif
|
||
Release lcBackup
|
||
Endproc && repune_backup_cursoare
|
||
*********************************************************************************************************
|
||
Procedure sterge_backup_cursoare
|
||
Lparameters tcOriginal
|
||
Local lcBackup
|
||
lcBackup = [bckp] + tcOriginal
|
||
If Used(lcBackup)
|
||
Use In (lcBackup)
|
||
Endif
|
||
Release lcBackup
|
||
Endproc && sterge_backup_cursoare
|
||
*********************************************************************************************************
|
||
Define Class oCursoareProcedura As Custom
|
||
cNumeProcedura = []
|
||
Dimension aCursoareDeschiseI(1, 1)
|
||
Dimension aExceptiiCursoare(1)
|
||
|
||
Procedure Init
|
||
Lparameters tcNumeProcedura
|
||
This.cNumeProcedura = tcNumeProcedura
|
||
Aused(This.aCursoareDeschiseI)
|
||
Endproc
|
||
|
||
Function getNumeProcedura
|
||
Return This.cNumeProcedura
|
||
Endfunc
|
||
|
||
Procedure setListaExceptii
|
||
Lparameters tcListaExceptii
|
||
Local Array laTemp(1)
|
||
lista2array(Upper(tcListaExceptii), @laTemp, [,])
|
||
Acopy(laTemp, This.aExceptiiCursoare)
|
||
Endproc
|
||
|
||
Procedure inchideCursoare
|
||
Local Array laCursoareDeschiseF[1, 1]
|
||
Local lnIndex
|
||
*!* cursoarele de la inceput
|
||
*!* CREATE CURSOR crs(nume c(200),nr n(10))
|
||
*!* SELECT crs
|
||
*!* APPEND FROM array This.aCursoareDeschiseI
|
||
*!* BROWSE
|
||
*!* cursoarele de la final
|
||
*!* CREATE CURSOR crs2(nume c(200),nr n(10))
|
||
*!* SELECT crs2
|
||
*!* Aused(laCursoareDeschiseF)
|
||
*!* APPEND FROM array laCursoareDeschiseF
|
||
*!* BROWSE
|
||
For lnIndex = 1 To Aused(laCursoareDeschiseF)
|
||
If Ascan(This.aCursoareDeschiseI, laCursoareDeschiseF[lnIndex, 1]) = 0 And ;
|
||
Ascan(This.aExceptiiCursoare, laCursoareDeschiseF[lnIndex, 1]) = 0
|
||
Use In (laCursoareDeschiseF[lnIndex, 1])
|
||
Endif
|
||
Endfor
|
||
*!* exceptii
|
||
*!* CREATE CURSOR crs3(nume c(200),nr n(10))
|
||
*!* SELECT crs3
|
||
*!* APPEND FROM array This.aExceptiiCursoare
|
||
*!* BROWSE
|
||
*!* cursoare ramase
|
||
*!* CREATE CURSOR crs4(nume c(200),nr n(10))
|
||
*!* SELECT crs4
|
||
*!* Aused(laCursoareDeschiseF)
|
||
*!* APPEND FROM array laCursoareDeschiseF
|
||
*!* BROWSE
|
||
Endproc
|
||
|
||
Enddefine
|
||
*********************************************************************************************************
|
||
Define Class oLogCursoare As Custom
|
||
&& cursor in care tin numele tuturor cursoarelor deschise
|
||
oDetaliiProc = Null
|
||
lGlobal = .F.
|
||
|
||
Procedure Init
|
||
Lparameters tlGlobal
|
||
This.oDetaliiProc = Createobject("collection")
|
||
This.lGlobal = tlGlobal
|
||
If !This.lGlobal
|
||
This.salveaza(Program(Program(-1) - 1))
|
||
Endif
|
||
Endproc
|
||
|
||
Procedure seteazaExceptii
|
||
Lparameters tcListaExceptii
|
||
*!* lista exceptii contine numele cursoarelor care nu se inchid la iesirea din procedura
|
||
Local lnIndex
|
||
lnIndex = This.cautaIndex(Iif(This.lGlobal, Program(Program(-1) - 1), ""))
|
||
This.oDetaliiProc.Item[lnIndex].setListaExceptii(tcListaExceptii)
|
||
Endproc
|
||
|
||
Function cautaIndex
|
||
Lparameters tcNumeProcedura
|
||
Local lnIndexCautat, lnIndex
|
||
If !Empty(tcNumeProcedura) && sau If This.lGlobal
|
||
For lnIndex = 1 To This.oDetaliiProc.Count
|
||
If This.oDetaliiProc.Item[lnIndex].getNumeProcedura() == tcNumeProcedura
|
||
lnIndexCautat = lnIndex
|
||
Exit
|
||
Endif
|
||
Endfor
|
||
Else
|
||
lnIndexCautat = 1
|
||
Endif
|
||
Return lnIndexCautat
|
||
Endfunc
|
||
|
||
Procedure salveaza
|
||
*!* daca obiectul de tip oLogCursoare a fost definit global, atunci se apeleaza fara parametru,
|
||
*!* la inceputul fiecarei proceduri pentru care se doreste sa se tina istoricul cursoarelor deschise
|
||
Lparameters tcNumeProcedura
|
||
This.oDetaliiProc.Add(Createobject("oCursoareProcedura", Evl(tcNumeProcedura, Program(Program(-1) - 1))))
|
||
Endproc
|
||
|
||
Procedure inchideCursor
|
||
Lparameters tcNumeCursor
|
||
If Used(tcNumeCursor)
|
||
Use In (tcNumeCursor)
|
||
Endif
|
||
Endproc
|
||
|
||
Procedure inchideCursoare
|
||
*!* daca obiectul de tip oLogCursoare a fost definit global, atunci se apeleaza
|
||
*!* inainte de fiecare RETURN din procedura respectiva
|
||
Local lcSelect, lnIndex
|
||
lcSelect = Select()
|
||
lnIndex = This.cautaIndex(Iif(This.lGlobal, Program(Program(-1) - 1), ""))
|
||
With This.oDetaliiProc
|
||
.Item[lnIndex].inchideCursoare()
|
||
.Remove(lnIndex)
|
||
Endwith
|
||
If Used(lcSelect)
|
||
Select (lcSelect)
|
||
Endif
|
||
Endproc
|
||
|
||
Procedure Destroy
|
||
If !This.lGlobal
|
||
This.inchideCursoare()
|
||
Endif
|
||
Endproc
|
||
|
||
Enddefine
|
||
*********************************************************************************************************
|
||
|
||
*******************************************
|
||
*** Completare analitice pe baza de grupuri in Gestiune.NIR.inainte_de_do_termin, Contabilitate.actbaza2007.adunadate
|
||
*******************************************
|
||
Procedure completare_gruputil_analitice
|
||
*!* completez analiticele lipsa din tabelul config_gruputil_analitice
|
||
lnSucces = Update_GrupUtilAnalitice() && in updateserver.prg
|
||
If lnSucces > 0
|
||
Select crsGrupUtilAnalitice
|
||
Scan
|
||
Scatter Name loRec Memo
|
||
Update actactan Set ascd = loRec.acont Where Empty(Nvl(ascd, '')) And Upper(Alltrim(scd)) = Upper(Alltrim(loRec.Cont))
|
||
Update actactan Set ascc = loRec.acont Where Empty(Nvl(ascc, '')) And Upper(Alltrim(scc)) = Upper(Alltrim(loRec.Cont))
|
||
Endscan
|
||
Use In (Select('crsGrupUtilAnalitice'))
|
||
Endif
|
||
Endproc && completare_gruputil_analitice
|
||
|
||
*******************************************
|
||
*** Completare analitice pe baza de explicatii tva in Gestiune.NIR.inainte_de_do_termin, Contabilitate.actbaza2007.adunadate, ROAFACTURARE, ROACOMENZI, ROACONTRACTE pack_facturare
|
||
*** bun pentru analitice pe baza de cote TVA la 4426, 4428 (vezi AUTOHAUS, ABCVAL)
|
||
*******************************************
|
||
Procedure completare_tva_analitice
|
||
lnSucces = Update_TVAAnalitice() && in updateserver.prg
|
||
If lnSucces > 0
|
||
Select crsTVAAnalitice
|
||
Scan
|
||
Scatter Name loRec Memo
|
||
Update actactan Set ascd = loRec.acont Where Empty(Nvl(ascd, '')) And Upper(Alltrim(scd)) = Upper(Alltrim(loRec.Cont)) And id_jtva_coloana = loRec.id_jtva_coloana
|
||
Update actactan Set ascc = loRec.acont Where Empty(Nvl(ascc, '')) And Upper(Alltrim(scc)) = Upper(Alltrim(loRec.Cont)) And id_jtva_coloana = loRec.id_jtva_coloana
|
||
Endscan
|
||
Use In (Select('crsTVAAnalitice'))
|
||
Endif
|
||
Endproc && completare_tva_analitice
|
||
|
||
*** Completare taxname in actactan (frm_introd_compact.la_iesire)
|
||
PROCEDURE completare_taxname
|
||
LOCAL lcSelect
|
||
lcSelect = SELECT()
|
||
|
||
IF USED('saft_taxtable')
|
||
UPDATE actactan SET taxname = Iif(Seek(actactan.taxcode,'saft_taxtable','taxcode'),saft_taxtable.taxname,'')
|
||
ENDIF
|
||
|
||
SELECT (m.lcSelect)
|
||
ENDPROC && completare_taxname
|
||
|
||
*** Completare paymentname in actactan (frm_introd_compact.la_iesire)
|
||
PROCEDURE completare_paymentname
|
||
LOCAL lcSelect
|
||
lcSelect = SELECT()
|
||
|
||
IF USED('saft_mecanisme_plati')
|
||
UPDATE actactan SET paymentname = Iif(Seek(actactan.paymentcode,'saft_mecanisme_plati','mcode'),saft_mecanisme_plati.paymentname,'')
|
||
ENDIF
|
||
|
||
SELECT (m.lcSelect)
|
||
ENDPROC && completare_taxname
|
||
|
||
|
||
*** Completare explicatie_tva in actactan (frm_introd_compact.la_iesire)
|
||
PROCEDURE completare_explicatie_tva
|
||
LOCAL lcSelect, lcCursor
|
||
lcSelect = SELECT()
|
||
|
||
lcCursor = SYS(2015)
|
||
IF !USED(m.lcCursor)
|
||
update_jtva_coloane("", m.lcCursor,6)
|
||
ENDIF
|
||
|
||
IF USED(m.lcCursor)
|
||
UPDATE actactan SET explicatie_tva = Iif(Seek(actactan.id_jtva_coloana, m.lcCursor,'id_jtva'), &lcCursor..denumire,'')
|
||
ENDIF
|
||
|
||
USE IN (SELECT(m.lcCursor))
|
||
|
||
SELECT (m.lcSelect)
|
||
ENDPROC && completare_explicatie_tva
|
||
|
||
**************************************
|
||
*** Cauta partenerul dupa cod fiscal si intoarce un obiect sau NULL
|
||
**************************************
|
||
Procedure GetPartenerByCodFiscal
|
||
Lparameters tcCodFiscal
|
||
Private pcCodFiscal
|
||
Local lcSql, lnSucces, lcSelect, loPartener
|
||
lcSelect = SELECT()
|
||
loPartener = NULL
|
||
|
||
pcCodFiscal = Alltrim(Strtran(Strtran(Upper(Alltrim(m.tcCodFiscal)), ' ', ''), 'RO', ''))
|
||
|
||
lcSql = [SELECT * from vnom_parteneri where id_part = (select MAX(id_part) as id_part from nom_parteneri where replace(replace(UPPER(cod_fiscal),' ', ''), 'RO', '') = ?pcCodFiscal and sters = 0 and inactiv = 0)]
|
||
llSucces = goExecutor.oExecuta(m.lcSql, "cPartenerTemp")
|
||
If m.llSucces
|
||
SELECT cPartenerTemp
|
||
SCATTER NAME loPartener
|
||
ENDIF
|
||
USE IN (SELECT('cPartenerTemp'))
|
||
|
||
SELECT (m.lcSelect)
|
||
Return loPartener
|
||
Endproc
|
||
|
||
**************************************
|
||
*** Cauta partenerul dupa denumire si intoarce un obiect sau NULL
|
||
**************************************
|
||
Procedure GetPartenerByDenumire
|
||
Lparameters tcDenumire
|
||
Private pcDenumire
|
||
Local lcSql, lnSucces, lcSelect, loPartener
|
||
lcSelect = SELECT()
|
||
loPartener = NULL
|
||
|
||
pcDenumire = Alltrim(Upper(tcDenumire))
|
||
|
||
lcSql = [SELECT * from vnom_parteneri where id_part = (select MAX(id_part) as id_part from nom_parteneri where TRIM(UPPER(denumire)) = ?pcDenumire and sters = 0 and inactiv = 0)]
|
||
llSucces = goExecutor.oExecuta(m.lcSql, "cPartenerTemp")
|
||
If m.llSucces
|
||
SELECT cPartenerTemp
|
||
SCATTER NAME loPartener
|
||
ENDIF
|
||
USE IN (SELECT('cPartenerTemp'))
|
||
|
||
SELECT (m.lcSelect)
|
||
Return loPartener
|
||
Endproc
|
||
|
||
**************************************
|
||
*** Cauta partenerul dupa codul IBAN si intoarce un obiect sau NULL
|
||
**************************************
|
||
Procedure GetPartenerByContBanca
|
||
Lparameters tcContBanca
|
||
Private pcContBanca
|
||
Local lcSql, lnSucces, lcSelect, loPartener
|
||
lcSelect = SELECT()
|
||
loPartener = NULL
|
||
|
||
pcContBanca = Alltrim(TRANSFORM(m.tcContBanca))
|
||
|
||
lcSql = [SELECT * from vnom_parteneri where id_part = (select MAX(id_part) as id_part from nom_parteneri where TRIM(UPPER(cont_banca)) = ?pcContBanca and sters = 0 and inactiv = 0)]
|
||
llSucces = goExecutor.oExecuta(m.lcSql, "cPartenerTemp")
|
||
If m.llSucces
|
||
SELECT cPartenerTemp
|
||
SCATTER NAME loPartener
|
||
ENDIF
|
||
USE IN (SELECT('cPartenerTemp'))
|
||
|
||
SELECT (m.lcSelect)
|
||
Return loPartener
|
||
ENDPROC
|
||
|
||
**************************************
|
||
*** Intoarce Id Partener din nomenclatorul de parteneri dupa codul fiscal
|
||
**************************************
|
||
Procedure GetIdPartenerByCodFiscal
|
||
Lparameters tcCodFiscal, tcDenumire
|
||
* tcCodFiscal: IN
|
||
* tcDenumire: OUT
|
||
Private pnIdPartener, pcCodFiscal
|
||
Local lcSql, lnSucces, lcSelect
|
||
lcSelect = SELECT()
|
||
pnIdPartener = 0
|
||
pcCodFiscal = Alltrim(Strtran(Strtran(Upper(Alltrim(m.tcCodFiscal)), ' ', ''), 'RO', ''))
|
||
|
||
lcSql = [select MAX(id_part) as id_part from nom_parteneri where replace(replace(UPPER(cod_fiscal),' ', ''), 'RO', '') = ?pcCodFiscal and sters = 0 and inactiv = 0]
|
||
lnSucces = goExecutor.oSelect2Value(m.lcSql, @pnIdPartener)
|
||
If m.lnSucces < 0
|
||
amessagebox(goExecutor.cEroare, 0 + 48, _Screen.Caption)
|
||
ENDIF
|
||
|
||
SELECT (m.lcSelect)
|
||
Return Nvl(m.pnIdPartener, 0)
|
||
Endproc
|
||
|
||
**************************************
|
||
*** Intoarce Id Partener din nomenclatorul de parteneri dupa denumire
|
||
**************************************
|
||
Procedure GetIdPartenerByDenumire
|
||
Lparameters tcDenumire
|
||
Private pnIdPartener, pcDenumire
|
||
Local lcSql, lnSucces, lcSelect
|
||
lcSelect = SELECT()
|
||
pnIdPartener = 0
|
||
pcDenumire = Alltrim(Upper(tcDenumire))
|
||
|
||
lcSql = [select MAX(id_part) as id_part from nom_parteneri where TRIM(UPPER(denumire)) = ?pcDenumire and sters = 0 and inactiv = 0]
|
||
lnSucces = goExecutor.oSelect2Value(m.lcSql, @pnIdPartener)
|
||
If m.lnSucces < 0
|
||
amessagebox(goExecutor.cEroare, 0 + 48, _Screen.Caption)
|
||
ENDIF
|
||
SELECT (m.lcSelect)
|
||
Return Nvl(m.pnIdPartener, 0)
|
||
Endproc
|
||
|
||
**************************************
|
||
*** Intoarce Id Partener din nomenclatorul de parteneri dupa contul bancar
|
||
**************************************
|
||
Procedure GetIdPartenerByContBanca
|
||
Lparameters tcCont
|
||
Private pnIdPartener, pcCont
|
||
Local lcSql, lnSucces
|
||
pnIdPartener = 0
|
||
pcCont = Alltrim(Upper(tcCont))
|
||
|
||
lcSql = [select MAX(id_part) as id_part from nom_parteneri where TRIM(UPPER(cont_banca)) = ?pcCont and sters = 0 and inactiv = 0]
|
||
lnSucces = goExecutor.oSelect2Value(m.lcSql, @pnIdPartener)
|
||
If m.lnSucces < 0
|
||
amessagebox(goExecutor.cEroare, 0 + 48, _Screen.Caption)
|
||
Endif
|
||
Return Nvl(m.pnIdPartener, 0)
|
||
Endproc
|
||
|
||
**************************************
|
||
*** Intoarce denumire parteneri din nomenclatorul de parteneri dupa Id
|
||
**************************************
|
||
Procedure GetDenumirePartenerById
|
||
Lparameters tnIdPart
|
||
Private pnIdPartener, pcDenumire
|
||
Local lcSql, lnSucces, lcSelect
|
||
|
||
lcSelect = SELECT()
|
||
pnIdPartener = tnIdPart
|
||
pcDenumire = ''
|
||
|
||
lcSql = [select MAX(denumire) as denumire from nom_parteneri where id_part = ?pnIdPartener]
|
||
lnSucces = goExecutor.oSelect2Value(m.lcSql, @pcDenumire)
|
||
If m.lnSucces < 0
|
||
amessagebox(goExecutor.cEroare, 0 + 48, _Screen.Caption)
|
||
ENDIF
|
||
SELECT (m.lcSelect)
|
||
Return Nvl(m.pcDenumire, '')
|
||
Endproc
|
||
|
||
**************************************
|
||
*** Intoarce cod fiscal parteneri din nomenclatorul de parteneri dupa Id
|
||
**************************************
|
||
Procedure GetCodFiscalPartenerById
|
||
Lparameters tnIdPart
|
||
Private pnIdPartener, pcDenumire
|
||
Local lcSql, lnSucces, lcSelect
|
||
|
||
lcSelect = SELECT()
|
||
pnIdPartener = tnIdPart
|
||
pcCodFiscal = ''
|
||
|
||
lcSql = [select MAX(cod_fiscal) as cod_fiscal from nom_parteneri where id_part = ?pnIdPartener]
|
||
lnSucces = goExecutor.oSelect2Value(m.lcSql, @pcCodFiscal)
|
||
If m.lnSucces < 0
|
||
amessagebox(goExecutor.cEroare, 0 + 48, _Screen.Caption)
|
||
ENDIF
|
||
SELECT (m.lcSelect)
|
||
Return Nvl(m.pcCodFiscal, '')
|
||
Endproc
|
||
|
||
|
||
************************************
|
||
*** Intoarce un obiect cu (id_util, id_partener, partener) dupa id_util
|
||
************************************
|
||
Procedure GetPartenerByUtil
|
||
Lparameters tnIdUtil
|
||
Private pnIdUtil
|
||
Local lcSql, llSucces, loPartener
|
||
pnIdUtil = m.tnIdUtil
|
||
loPartener = Createobject("empty")
|
||
AddProperty(loPartener, "id_util", m.pnIdUtil)
|
||
AddProperty(loPartener, "id_partener", 0)
|
||
AddProperty(loPartener, "partener", "")
|
||
|
||
lcSql = [select id_util, id_partener, partener from vutilizatori_rol_intern where id_util = ?pnIdUtil]
|
||
llSucces = goExecutor.oExecuta(m.lcSql, 'cPartenerByUtilTemp')
|
||
If m.llSucces
|
||
Select cPartenerByUtilTemp
|
||
loPartener.id_partener = Nvl(id_partener, 0)
|
||
loPartener.partener = Alltrim(Nvl(partener, ''))
|
||
Use In (Select('cPartenerByUtilTemp'))
|
||
Endif
|
||
Return loPartener
|
||
Endproc
|
||
|
||
|
||
**************************************
|
||
* Genereaza toate variantele de [nume prenume1 prenume2]
|
||
* = GetNamePermutations("Popescu Ion Maria", .T.) && exclude varianta originala
|
||
* = GetNamePermutations("Popescu Ion Maria", .F.) && include toate variantele
|
||
**************************************
|
||
Function GetNamePermutations
|
||
Lparameters lcFullName, llExcludeOriginal
|
||
Local lcResult, lnWordCount, i
|
||
Local Array laWords[1]
|
||
PRIVATE pnMaxPerms, pnPermCount
|
||
pnMaxPerms = 10 && numarul maxim de permutari
|
||
pnPermCount = 0
|
||
|
||
* Separare cuvinte <20>n array
|
||
lnWordCount = Getwordcount(lcFullName)
|
||
If lnWordCount < 2
|
||
Return ""
|
||
Endif
|
||
|
||
* LIMITARE LA MAXIM 4 CUVINTE 24 PERMUTARI
|
||
If lnWordCount > 4
|
||
lnWordCount = 4
|
||
* Reconstruim numele doar cu primele 4 cuvinte
|
||
lcFullName = Getwordnum(lcFullName, 1) + " " + ;
|
||
Getwordnum(lcFullName, 2) + " " + ;
|
||
Getwordnum(lcFullName, 3) + " " + ;
|
||
Getwordnum(lcFullName, 4)
|
||
|
||
ENDIF
|
||
|
||
Dimension laWords[lnWordCount]
|
||
For i = 1 To lnWordCount
|
||
laWords[i] = Getwordnum(lcFullName, i)
|
||
Endfor
|
||
|
||
* Cazul special pentru 2 cuvinte
|
||
If lnWordCount = 2
|
||
If llExcludeOriginal
|
||
Return laWords[2] + " " + laWords[1]
|
||
Endif
|
||
Return lcFullName + ";" + laWords[2] + " " + laWords[1]
|
||
Endif
|
||
|
||
* Generam toate permutarile posibile <20>n lcResult
|
||
lcResult = ""
|
||
Local Array laUsed[1], laCurrentPerm[1]
|
||
Dimension laUsed[lnWordCount], laCurrentPerm[lnWordCount]
|
||
Store .F. To laUsed
|
||
|
||
pnPermCount = 0 && numarul de permutari
|
||
|
||
* Primul cuv<75>nt poate fi oricare
|
||
For i = 1 To lnWordCount
|
||
laUsed[i] = .T.
|
||
laCurrentPerm[1] = laWords[i]
|
||
GenerateWordPerms(1, @laWords, @laUsed, @laCurrentPerm, lnWordCount, @lcResult)
|
||
laUsed[i] = .F.
|
||
Endfor
|
||
|
||
* Filtram rezultatele
|
||
Local lcFirstWord, lcLastWord, lcFiltered
|
||
lcFirstWord = laWords[1]
|
||
lcLastWord = laWords[lnWordCount]
|
||
lcFiltered = ""
|
||
|
||
Local lnPos, lcLine
|
||
lnPos = At(";", lcResult)
|
||
Do While lnPos > 0
|
||
lcLine = Left(lcResult, lnPos - 1)
|
||
lcResult = Substr(lcResult, lnPos + 1)
|
||
|
||
* Verificam daca primul ?i ultimul cuv<75>nt sunt corecte
|
||
If (Getwordnum(lcLine, 1) = lcFirstWord Or Getwordnum(lcLine, 1) = lcLastWord) And ;
|
||
(Getwordnum(lcLine, lnWordCount) = lcFirstWord Or Getwordnum(lcLine, lnWordCount) = lcLastWord)
|
||
If !llExcludeOriginal Or lcLine != lcFullName
|
||
lcFiltered = lcFiltered + lcLine + ";"
|
||
Endif
|
||
Endif
|
||
|
||
lnPos = At(";", lcResult)
|
||
Enddo
|
||
|
||
* Verificam ?i ultima linie
|
||
If !Empty(lcResult)
|
||
If (Getwordnum(lcResult, 1) = lcFirstWord Or Getwordnum(lcResult, 1) = lcLastWord) And ;
|
||
(Getwordnum(lcResult, lnWordCount) = lcFirstWord Or Getwordnum(lcResult, lnWordCount) = lcLastWord)
|
||
If !llExcludeOriginal Or lcResult != lcFullName
|
||
lcFiltered = lcFiltered + lcResult + ";"
|
||
Endif
|
||
Endif
|
||
Endif
|
||
|
||
* Eliminam ultimul separator daca exista
|
||
If !Empty(lcFiltered)
|
||
lcFiltered = Left(lcFiltered, Len(lcFiltered)-1)
|
||
Endif
|
||
|
||
Return lcFiltered
|
||
ENDPROC
|
||
|
||
* Procedura recursiva pentru generarea permutarilor
|
||
Procedure GenerateWordPerms
|
||
Parameters lnLevel, laWords, laUsed, laCurrentPerm, lnWordCount, lcResult
|
||
|
||
If m.pnPermCount >= m.pnMaxPerms
|
||
Return
|
||
ENDIF
|
||
|
||
If lnLevel = lnWordCount
|
||
pnPermCount = m.pnPermCount + 1
|
||
* Am completat toate pozitiile, adaugam permutarea la rezultat
|
||
Local i, lcPerm
|
||
lcPerm = laCurrentPerm[1]
|
||
For i = 2 To lnWordCount
|
||
lcPerm = lcPerm + " " + laCurrentPerm[i]
|
||
Endfor
|
||
lcResult = lcResult + lcPerm + ";"
|
||
Return
|
||
Endif
|
||
|
||
* Pentru fiecare cuv<75>nt neutilizat
|
||
Local i
|
||
For i = 1 To lnWordCount
|
||
If !laUsed[i]
|
||
laUsed[i] = .T.
|
||
laCurrentPerm[lnLevel + 1] = laWords[i]
|
||
GenerateWordPerms(lnLevel + 1, @laWords, @laUsed, @laCurrentPerm, lnWordCount, @lcResult)
|
||
laUsed[i] = .F.
|
||
Endif
|
||
Endfor
|
||
Endproc
|
||
|
||
|
||
|
||
**************************************
|
||
*** Intoarce denumire fdoc din nomenclatorul de documente dupa Id
|
||
**************************************
|
||
Procedure GetFdocById
|
||
Lparameters tnId
|
||
Private pnId, pcDenumire
|
||
Local lcSql, lnSucces
|
||
pnId = tnId
|
||
pcDenumire = ''
|
||
|
||
lcSql = [select MAX(fel_document) as fel_document from nom_fdoc where id_fdoc = ?pnId]
|
||
lnSucces = goExecutor.oSelect2Value(m.lcSql, @pcDenumire)
|
||
If m.lnSucces < 0
|
||
amessagebox(goExecutor.cEroare, 0 + 48, _Screen.Caption)
|
||
Endif
|
||
Return Nvl(m.pcDenumire, '')
|
||
Endproc && GetFdocById
|
||
|
||
************************************
|
||
*** Intoarce un obiect cu (id_valuta, nume_val, moneda_nationala) dupa nume_val2/iso_valuta
|
||
************************************
|
||
Procedure GetValutaByISO
|
||
Lparameters tcValutaISO
|
||
Private pcValutaISO
|
||
Local lcSelect, lcSql, llSucces, loValuta
|
||
lcSelect = SELECT()
|
||
pcValutaISO = m.tcValutaISO
|
||
loValuta = Createobject("empty")
|
||
AddProperty(loValuta, "id_valuta", 0)
|
||
AddProperty(loValuta, "nume_val", '')
|
||
AddProperty(loValuta, "moneda_nationala", 1)
|
||
|
||
lcSql = [select id_valuta, nume_val, moneda_nationala from vnom_valute where nume_val2 = ?pcValutaISO]
|
||
llSucces = goExecutor.oExecuta(m.lcSql, 'cValutaTemp')
|
||
If m.llSucces
|
||
IF RECCOUNT('cValutaTemp') > 0
|
||
Select cValutaTemp
|
||
GO TOP
|
||
loValuta.id_valuta = Nvl(id_valuta, 0)
|
||
loValuta.nume_val = Alltrim(Nvl(nume_val, ''))
|
||
loValuta.moneda_nationala = Nvl(moneda_nationala, 0)
|
||
ENDIF
|
||
Use In (Select('cValutaTemp'))
|
||
ENDIF
|
||
SELECT (m.lcSelect)
|
||
Return loValuta
|
||
ENDPROC
|
||
|
||
**************************************
|
||
*** Cauta o factura in ireg_parteneri dupa cont, id_part, nr_act / comanda
|
||
*** Se foloseste la importul din extrasele bancare, deconturi curieri, procesatori plati
|
||
*** Intoarce un obiect (id_fact, cont, acont, nract)
|
||
**************************************
|
||
Procedure GetDocumentByContPartenerAct
|
||
Lparameters tcContPartener, tnIdPartener, tuDocument, tlComanda
|
||
* loAct id_fact, cont, acont, nract
|
||
|
||
Local lcSql, lcSql1, lcSql2, lcWhere, lcWhere1, lcWhere2, llSucces, loAct, lcSelect
|
||
Private pnIdPartener, pcContPartener, pnNract, pnIdFact, pcComanda
|
||
|
||
lcSelect = Select()
|
||
pnIdPartener = tnIdPartener
|
||
pcContPartener = Alltrim(Upper(tcContPartener))
|
||
pnNract = IIF(!m.tlComanda and !EMPTY(m.tuDocument), m.tuDocument, 0)
|
||
pcComanda = ALLTRIM(UPPER(TRANSFORM(IIF(m.tlComanda and !EMPTY(m.tuDocument), m.tuDocument, ''))))
|
||
*!* pcComanda = IIF(!EMPTY(m.pcComanda), '%' + m.pcComanda + '%', '')
|
||
pnIdFact = 0
|
||
|
||
loAct = Createobject("Empty")
|
||
AddProperty(loAct, "id_fact", 0)
|
||
AddProperty(loAct, "cont", "")
|
||
AddProperty(loAct, "acont", "")
|
||
AddProperty(loAct, "nract", 0)
|
||
AddProperty(loAct, "solddeb", 0)
|
||
|
||
* Daca nu am id-ul de partener -- sau nu am nici numarul, nici suma documentului, nu caut nimic
|
||
If Empty(m.pnIdPartener) && Or (Empty(m.pnNract) And Empty(m.pcComanda))
|
||
Return loAct
|
||
Endif
|
||
|
||
lcWhere2 = "i.an = ?gnAn and i.luna = ?gnLuna and i.id_part = ?pnIdPartener"
|
||
|
||
DO CASE
|
||
CASE !Empty(m.pnNract)
|
||
lcWhere2 = m.lcWhere2 + " and (i.nract = ?pnNrAct)" && cautare fara cont, cu numaract
|
||
CASE !Empty(m.pcComanda)
|
||
lcWhere2 = m.lcWhere2 + " and (UPPER(l.nrord) like '%"+ m.pcComanda + "%'OR UPPER(i.explicatia) like '%" + m.pcComanda + "%' OR UPPER(i.explicatia4) like '%" + m.pcComanda + "%' OR UPPER(i.explicatia5) like '%" + pcComanda + "%')" && cautare fara cont, cu comanda
|
||
ENDCASE
|
||
|
||
lcWhere1 = m.lcWhere2 + IIF(!Empty(m.pcContPartener), " and i.cont = ?pcContPartener", "")
|
||
|
||
lcSql = [select i.id_fact, i.cont, i.acont, i.nract, (i.precdeb+i.debit-i.preccred-i.credit) as solddeb from ireg_parteneri i left join nom_lucrari l on i.id_lucrare = l.id_lucrare where ]
|
||
lcSql1 = m.lcSql + m.lcWhere1
|
||
lcSql2 = m.lcSql + m.lcWhere2
|
||
|
||
llSucces = goExecutor.oExecuta(m.lcSql1, "cRezultatTemp")
|
||
If m.llSucces
|
||
If Reccount('cRezultatTemp') = 0
|
||
If m.lcWhere2 <> m.lcWhere1
|
||
Use In (Select('cRezultatTemp'))
|
||
llSucces = goExecutor.oExecuta(m.lcSql2, "cRezultatTemp")
|
||
Endif && m.lcWhere2 <> m.lcWhere1
|
||
Endif && RECCOUNT('cRezultatTemp') = 0
|
||
Endif && m.llSucces
|
||
|
||
If Used('cRezultatTemp')
|
||
If Reccount('cRezultatTemp') > 1
|
||
polog.Log('Sunt prea multe rezultate care se potrivesc', Program())
|
||
Else
|
||
Select cRezultatTemp
|
||
Go Top
|
||
loAct.id_fact = id_fact
|
||
loAct.Cont = Alltrim(Cont)
|
||
loAct.acont = Nvl(acont, '')
|
||
loAct.nract = nract
|
||
loAct.solddeb = solddeb
|
||
Endif
|
||
Endif
|
||
|
||
Use In (Select('cRezultatTemp'))
|
||
Select (m.lcSelect)
|
||
|
||
Return loAct
|
||
Endproc && GetDocumentByContPartenerActSuma
|
||
|
||
**************************************
|
||
*** Intoarce Id Sectie din nomenclatorul de sectii dupa numele sectiei
|
||
**************************************
|
||
Procedure GetIdSectie
|
||
Lparameters tcSectie
|
||
Private pnIdSectie, pcSectie
|
||
Local lcSql, lnSucces, lcSelect
|
||
lcSelect = SELECT()
|
||
pnIdSectie = 0
|
||
pcSectie = Upper(Alltrim(Nvl(tcSectie, '')))
|
||
|
||
lcSql = [select MAX(id_sectie) as id_sectie from vnom_sectii where UPPER(TRIM(sectie)) = ?pcSectie and inactiv = 0]
|
||
lnSucces = goExecutor.oSelect2Value(m.lcSql, @pnIdSectie)
|
||
If m.lnSucces < 0
|
||
amessagebox(goExecutor.cEroare, 0 + 48, _Screen.Caption)
|
||
ENDIF
|
||
SELECT (m.lcSelect)
|
||
Return Nvl(m.pnIdSectie, 0)
|
||
Endproc
|
||
|
||
**************************************
|
||
*** Intoarce obiect(id_sectie, sectie, csectie) din nomenclatorul de sectii dupa indicativ sectie
|
||
**************************************
|
||
Procedure GetSectieByCsectie
|
||
Lparameters tcCSectie
|
||
Private pnIdSectie, pcCSectie
|
||
Local lcSql, lnSucces, lcSelect
|
||
Local loRec As "empty"
|
||
Local lcCursor, llSucces
|
||
lcSelect = SELECT()
|
||
|
||
loRec = CREATEOBJECT("empty")
|
||
ADDPROPERTY(loRec, 'id_sectie', 0)
|
||
ADDPROPERTY(loRec, 'sectie', '')
|
||
ADDPROPERTY(loRec, 'csectie', '')
|
||
|
||
pcCSectie = Upper(Alltrim(Nvl(tcCSectie, '')))
|
||
|
||
lcSql = [select id_sectie, sectie, csectie from vnom_sectii where UPPER(TRIM(csectie)) = ?pcCSectie and inactiv = 0]
|
||
lcCursor = SYS(2015)
|
||
llSucces = goExecutor.oExecuta(m.lcSql, m.lcCursor)
|
||
If m.llSucces
|
||
SELECT (m.lcCursor)
|
||
IF RECCOUNT() >= 1
|
||
GO TOP
|
||
SCATTER NAME loRec
|
||
ENDIF
|
||
USE IN (SELECT(m.lcCursor))
|
||
ENDIF
|
||
|
||
SELECT (m.lcSelect)
|
||
Return loRec
|
||
Endproc
|
||
|
||
**************************************
|
||
*** Intoarce obiect(id_sectie, sectie, csectie) din nomenclatorul de sectii dupa id sectie
|
||
**************************************
|
||
Procedure GetSectieById
|
||
Parameters tnIdSectie
|
||
|
||
Local loRec As "empty"
|
||
Local lcSelect, llSucces
|
||
|
||
lcSelect = SELECT()
|
||
|
||
loRec = CREATEOBJECT("empty")
|
||
ADDPROPERTY(loRec, 'id_sectie', 0)
|
||
ADDPROPERTY(loRec, 'sectie', '')
|
||
ADDPROPERTY(loRec, 'csectie', '')
|
||
|
||
llSucces = goExecutor.oSelecteaza2Object("select id_sectie, sectie, csectie from vnom_sectii where id_sectie = ?tnIdSectie", @loRec)
|
||
|
||
SELECT (m.lcSelect)
|
||
Return loRec
|
||
ENDPROC
|
||
|
||
**************************************
|
||
*** Intoarce obiect din nomenclatorul de gestiuni dupa id gestiune
|
||
**************************************
|
||
Procedure GetGestiuneById
|
||
Parameters tnIdGestiune
|
||
|
||
Local loRec As "empty"
|
||
Local lcSelect, lcSql, llSucces
|
||
|
||
lcSelect = SELECT()
|
||
|
||
loRec = CREATEOBJECT("empty")
|
||
ADDPROPERTY(loRec, 'id_gestiune', 0)
|
||
ADDPROPERTY(loRec, 'nume_gestiune', '')
|
||
ADDPROPERTY(loRec, 'cgest', '')
|
||
|
||
TEXT TO lcSql noshow
|
||
select id_gestiune, nume_gestiune, inactiv, cont, acont, nr_pag, cgest, id_sucursala, descriere, nume_tip, sucursala, id_responsabil, denumire, id_sectie, sectie, acont_adaos, acont_cheltuiala, id_lucrare, nrord, gestionar, comisie_receptie1, comisie_receptie2, comisie_receptie3
|
||
from vnom_gestiuni
|
||
where id_gestiune = ?tnIdGestiune
|
||
ENDTEXT
|
||
|
||
llSucces = goExecutor.oSelecteaza2Object(m.lcSql, @loRec)
|
||
|
||
SELECT (m.lcSelect)
|
||
Return loRec
|
||
ENDPROC
|
||
|
||
**************************************
|
||
*** Intoarce Id Lucrare din nomenclatorul de lucrari dupa numele lucrarii
|
||
**************************************
|
||
Procedure GetIdLucrare
|
||
Lparameters tcLucrare
|
||
Private pnIdLucrare, pcLucrare
|
||
Local lcSql, lnSucces, lcSelect
|
||
lcSelect = SELECT()
|
||
pnIdLucrare = 0
|
||
pcLucrare = Upper(Alltrim(Nvl(tcLucrare, '')))
|
||
|
||
lcSql = [select MAX(id_lucrare) as id_lucrare from vnom_lucrari where UPPER(TRIM(nrord)) = ?pcLucrare and inactiv = 0]
|
||
lnSucces = goExecutor.oSelect2Value(m.lcSql, @pnIdLucrare)
|
||
If m.lnSucces < 0
|
||
amessagebox(goExecutor.cEroare, 0 + 48, _Screen.Caption)
|
||
ENDIF
|
||
SELECT (m.lcSelect)
|
||
Return Nvl(m.pnIdLucrare, 0)
|
||
Endproc
|
||
|
||
**************************************
|
||
*** Intoarce Id Venchelt din nomenclatorul de venchelt dupa numele venchelt
|
||
**************************************
|
||
Procedure GetIdVenchelt
|
||
Lparameters tcVenchelt
|
||
Private pnIdVenchelt, pcVenchelt
|
||
Local lcSql, lnSucces, lcSelect
|
||
lcSelect = SELECT()
|
||
pnIdVenchelt = 0
|
||
pcVenchelt = Upper(Alltrim(Nvl(tcVenchelt, '')))
|
||
|
||
lcSql = [select MAX(id_Venchelt) as id_Venchelt from vnom_venchel where UPPER(TRIM(explicatie)) = ?pcVenchelt and inactiv = 0]
|
||
lnSucces = goExecutor.oSelect2Value(m.lcSql, @pnIdVenchelt)
|
||
If m.lnSucces < 0
|
||
amessagebox(goExecutor.cEroare, 0 + 48, _Screen.Caption)
|
||
ENDIF
|
||
SELECT (m.lcSelect)
|
||
Return Nvl(m.pnIdVenchelt, 0)
|
||
Endproc
|
||
|
||
**************************************
|
||
*** Intoarce obiect din nomenclatorul Venit/Cheltuiala dupa id
|
||
**************************************
|
||
Procedure GetVencheltById
|
||
Parameters tnIdVenChelt
|
||
|
||
Local loRec As "empty"
|
||
Local lcSelect, llSucces
|
||
|
||
lcSelect = SELECT()
|
||
|
||
loRec = CREATEOBJECT("empty")
|
||
ADDPROPERTY(loRec, 'id_venchelt', 0)
|
||
ADDPROPERTY(loRec, 'tip_venchelt', 1)
|
||
ADDPROPERTY(loRec, 'explicatie', '')
|
||
ADDPROPERTY(loRec, 'explicatie_fiu', '')
|
||
ADDPROPERTY(loRec, 'explicatie_tata', '')
|
||
|
||
llSucces = goExecutor.oSelecteaza2Object("select id_venchelt, id_tata, tip_venchelt, explicatie, explicatie_fiu, explicatie_tata, inactiv, id_mod from vnom_venchel where id_venchelt = ?tnIdVenChelt", @loRec)
|
||
|
||
SELECT (m.lcSelect)
|
||
Return loRec
|
||
ENDPROC
|
||
|
||
**************************************
|
||
*** Intoarce valoarea unei optiuni
|
||
**************************************
|
||
Procedure GetOptiuneFirma
|
||
Lparameters tcOptiune
|
||
Local lcReturn
|
||
Private pcOptiune
|
||
lcReturn = ""
|
||
If Empty(m.tcOptiune) Or Type('tcOptiune') <> 'C'
|
||
Return m.lcReturn
|
||
Endif
|
||
pcOptiune = Upper(Alltrim(m.tcOptiune))
|
||
lnSucces = goExecutor.oSelect2Value("select pack_sesiune.getoptiunefirma(?pcOptiune) from dual", @lcReturn)
|
||
If m.lnSucces < 0
|
||
amessagebox(goExecutor.cEroare, 0 + 48, _Screen.Caption)
|
||
Endif
|
||
|
||
Return m.lcReturn
|
||
Endproc
|
||
|
||
**************************************
|
||
*** Intoarce cod bare din nomenclatorul de articole
|
||
**************************************
|
||
Procedure GetCodBareByIdArticol
|
||
Lparameters tnIdArticol
|
||
Private pnIdArticol, pcCodBare
|
||
Local lcSql, lnSucces
|
||
pcCodBare = ''
|
||
pnIdArticol = m.tnIdArticol
|
||
|
||
lcSql = [select codbare from nom_articole where id_articol = ?pnIdArticol]
|
||
llSucces = goExecutor.oSelecteaza2Value(m.lcSql, @pcCodBare)
|
||
Return NVL(m.pcCodBare, '')
|
||
Endproc
|
||
|
||
|
||
**************************************
|
||
*** Intoarce un obiect din vnom_articole/id_articol dupa denumire/codbare/cod client/cod furnizor
|
||
*** lnIdArticol = GetArticolByCodDenumire("articol", "cod bare", "cod furnizor", "cod client", IdPart, .T.)
|
||
*** loArticol = GetArticolByCodDenumire("articol", "cod bare", "cod furnizor", "cod client", IdPart, .F.)
|
||
**************************************
|
||
Procedure GetArticolByCodDenumire
|
||
lParameters tcDenumire, tcCodBare, tcCodMat, tcCodMatF, tcCodMatP, tnIdPart, tlReturnId
|
||
* tcDenumire: denumire articol
|
||
* tcCodBare: cod bare articol
|
||
* tcCodMat: primite = efactura.codClient, trimise = efactura.codFurnizor = nom_articole.codmat
|
||
* tcCodMatF: primite = efactura.codFurnizor = nom_articole.codmatf
|
||
* tcCodMatP: trimise = efactura.codClient = parteneri_articole_coduri.cod
|
||
* tnIdPart: id_part client
|
||
* tlReturnId: .T. = intoarce id_articol, .F. = intoarce obiect nom_articole
|
||
|
||
Private pcDenumire, pcCodBare, pcCodFurnizor, pcCodCLient, pnIdPart
|
||
Local lcSql, lnSucces, lcSelect, loArticol, loReturn
|
||
lcSelect = SELECT()
|
||
loArticol = null
|
||
loReturn = Null
|
||
|
||
pcDenumire = UPPER(Alltrim(NVL(m.tcDenumire, '')))
|
||
pcCodBare = UPPER(ALLTRIM(NVL(m.tcCodBare, '')))
|
||
pcCodMat = UPPER(ALLTRIM(NVL(m.tcCodMat, '')))
|
||
pcCodMatF = UPPER(ALLTRIM(NVL(m.tcCodMatF, '')))
|
||
pcCodMatP = UPPER(ALLTRIM(NVL(m.tcCodMatP, '')))
|
||
pnIdPart = NVL(m.tnIdPart, 0)
|
||
|
||
TEXT TO lcSql TEXTMERGE NOSHOW
|
||
SELECT * FROM vnom_articole a left join parteneri_articole_coduri c ON (a.id_part = c.id_part and c.id_part = ?pnIdPart and c.sters = 0)
|
||
where a.inactiv = 0 and rownum = 1 and (<<IIF(!EMPTY(m.pcDenumire), " or a.denumire = ?pcDenumire", "")>><<IIF(!EMPTY(m.pcCodBare), " or a.codbare = ?pcCodBare", "")>><<IIF(!EMPTY(m.pcCodMat), " or a.codmat = ?pcCodMat", "")>><<IIF(!EMPTY(m.pcCodMatF), " or a.codmatf = ?pcCodMatF", "")>><<IIF(!EMPTY(m.pcCodMatP), " or c.cod = ?pcCodMatP", "")>>)
|
||
ENDTEXT
|
||
|
||
* Daca nu exista denumire, codbare, codmat, codmatF, codmatP
|
||
lcSql = STRTRAN(m.lcSql, " and ()", " and (1=2)", 1, 1, 1)
|
||
lcSql = STRTRAN(m.lcSql, "( or ", "(", 1, 1, 1)
|
||
|
||
llSucces = goExecutor.oSelecteaza2Object(m.lcSql, @loArticol)
|
||
|
||
If m.llSucces
|
||
IF m.tlReturnId
|
||
loReturn = loArticol.id_articol
|
||
ELSE
|
||
loReturn = loArticol
|
||
ENDIF
|
||
ENDIF
|
||
|
||
SELECT (m.lcSelect)
|
||
Return loReturn
|
||
|
||
ENDPROC && GetArticolByCodDenumire
|
||
|
||
**************************************
|
||
*** Intoarce un obiect din vnom_articole dupa id_articol
|
||
*** loArticol = GetArticolById(lnIdArticol)
|
||
**************************************
|
||
Procedure GetArticolById
|
||
lParameters tnId
|
||
* tnId: id_articol
|
||
|
||
|
||
lcSelect = SELECT()
|
||
loArticol = Null
|
||
pnId = NVL(m.tnId, 0)
|
||
|
||
TEXT TO lcSql TEXTMERGE NOSHOW
|
||
SELECT * FROM vnom_articole a where id_articol = ?pnId
|
||
ENDTEXT
|
||
|
||
llSucces = goExecutor.oSelecteaza2Object(m.lcSql, @loArticol)
|
||
|
||
SELECT (m.lcSelect)
|
||
Return loArticol
|
||
|
||
ENDPROC && GetArticolById
|
||
|
||
**************************************
|
||
*** Intoarce un obiect din ANAF_VEFACTURA_DETALII/id_articol dupa cod fiscal furnizor/client si denumire
|
||
*** Cauta in articolele furnizorului/clientului, ultima aparitie a articolului respectiv
|
||
*** lnIdArticol = GetArticolEFByPartDenumire("cod fiscal", "articol", .T.)
|
||
*** loArticol = GetArticolByCodDenumire("articol", "cod bare", "cod furnizor", "cod client", IdPart, .F.)
|
||
**************************************
|
||
Procedure GetArticolEFByPartDenumire
|
||
lParameters tcCodFiscal, tlPrimite, tcDenumire, tlReturnId, tnIdEfactura
|
||
* tcCodFiscal : cod fiscal client/furnizor
|
||
* tlPrimite: facturi primite / emise
|
||
* tcDenumire: denumire articol
|
||
* tlReturnId: .T. = intoarce id_articol, .F. = intoarce obiect
|
||
* tnIdEfactura: id_efactura curenta. sa nu caut articolul in factura curenta, ci in facturile anterioare
|
||
|
||
Private pcDenumire, pcCodBare, pcCodFurnizor, pcCodCLient, pnIdPart, pnIdEfactura
|
||
Local lcSql, lnSucces, lcSelect, loArticol, loReturn, lcColoanaCodFiscal
|
||
lcSelect = SELECT()
|
||
loArticol = null
|
||
loReturn = Null
|
||
|
||
pcDenumire = UPPER(Alltrim(NVL(m.tcDenumire, '')))
|
||
pcCodFiscal = UPPER(ALLTRIM(NVL(m.tcCodFiscal, '')))
|
||
pnIdArticol = 0
|
||
pnIdEfactura = IIF(!EMPTY(NVL(tnIdEfactura, 0)), m.tnIdEfactura, 0)
|
||
lcColoanaCodFiscal = IIF(m.tlPrimite, "e.cod_fiscal_emitent", "e.cod_fiscal_beneficiar")
|
||
|
||
TEXT TO lcSql TEXTMERGE NOSHOW
|
||
SELECT * FROM (SELECT d.* FROM ANAF_VEFACTURA_DETALII d LEFT JOIN ANAF_EFACTURA e ON (e.id = d.id_efactura)
|
||
WHERE <<m.lcColoanaCodFiscal>> = ?pcCodFiscal AND TRIM(UPPER(d.articol)) = ?pcDenumire and id_articol is not null ORDER BY d.id desc) WHERE rownum = 1
|
||
ENDTEXT
|
||
|
||
llSucces = goExecutor.oSelecteaza2Object(m.lcSql, @loArticol)
|
||
|
||
If m.llSucces
|
||
* Daca nu am gasit factura cu articol ROA (este posibil sa fie de servicii, fara articole gestionabile)
|
||
* Caut articolelele anterioare, fara id_articol
|
||
IF EMPTY(NVL(loArticol.id_articol,0)) AND !EMPTY(NVL(m.tnIdEfactura,0))
|
||
TEXT TO lcSql TEXTMERGE NOSHOW
|
||
SELECT * FROM (SELECT d.* FROM ANAF_VEFACTURA_DETALII d LEFT JOIN ANAF_EFACTURA e ON (e.id = d.id_efactura)
|
||
WHERE <<m.lcColoanaCodFiscal>> = ?pcCodFiscal AND TRIM(UPPER(d.articol)) = ?pcDenumire and e.id <> ?pnIdEFactura ORDER BY d.id desc) WHERE rownum = 1
|
||
ENDTEXT
|
||
|
||
llSucces = goExecutor.oSelecteaza2Object(m.lcSql, @loArticol)
|
||
ENDIF
|
||
ENDIF
|
||
|
||
IF m.llSucces
|
||
IF m.tlReturnId
|
||
loReturn = loArticol.id_articol
|
||
ELSE
|
||
loReturn = loArticol
|
||
ENDIF
|
||
ENDIF
|
||
|
||
SELECT (m.lcSelect)
|
||
Return loReturn
|
||
|
||
ENDPROC && GetArticolEFByPartDenumire
|
||
|
||
|
||
**************************************
|
||
*** Alege perioada
|
||
*** intoarce un obiect cu perioada aleasa
|
||
**************************************
|
||
Procedure AlegePerioada
|
||
|
||
Local loFrmPerioada As 'frm_perioada_luni'
|
||
Local loRet As "empty"
|
||
Local lcPerioada, lnAn1, lnAn2, lnFinal, lnInit, lnLuna1, lnLuna2
|
||
Private pcondper
|
||
pcondper = ''
|
||
|
||
loFrmPerioada = Createobject('frm_perioada_luni')
|
||
loFrmPerioada.Show(1)
|
||
|
||
If gnButon = 2
|
||
Return
|
||
Endif
|
||
|
||
If At('_', pcondper) > 0
|
||
lnAn1 = Val(Substr(pcondper, 3, 4))
|
||
lnLuna1 = Val(Substr(pcondper, 1, 2))
|
||
lnAn2 = Val(Substr(pcondper, 10, 4))
|
||
lnLuna2 = Val(Substr(pcondper, 8, 2))
|
||
|
||
lcPerioada = Substr(pcondper, 1, 2) + '/' + Substr(pcondper, 3, 4) + ' - ' + Substr(pcondper, 8, 2) + '/' + Substr(pcondper, 10, 4)
|
||
Else
|
||
lnAn1 = Val(Substr(pcondper, 3, 4))
|
||
lnLuna1 = Val(Substr(pcondper, 1, 2))
|
||
lnAn2 = Val(Substr(pcondper, 3, 4))
|
||
lnLuna2 = Val(Substr(pcondper, 1, 2))
|
||
|
||
lcPerioada = Substr(pcondper, 1, 2) + '/' + Substr(pcondper, 3, 4) + ' - ' + Substr(pcondper, 1, 2) + '/' + Substr(pcondper, 3, 4)
|
||
Endif
|
||
lnInit = lnAn1 * 12 + lnLuna1
|
||
lnFinal = lnAn2 * 12 + lnLuna2
|
||
|
||
loRet = Createobject("empty")
|
||
AddProperty(loRet, "an1", m.lnAn1)
|
||
AddProperty(loRet, "luna1", m.lnLuna1)
|
||
AddProperty(loRet, "an2", m.lnAn2)
|
||
AddProperty(loRet, "luna2", m.lnLuna2)
|
||
AddProperty(loRet, "perioada", m.lcPerioada)
|
||
|
||
Return loRet
|
||
|
||
Endproc && AlegePerioada
|
||
|
||
*** Citeste optiunea pentru semnatura rapoarte "SEMN_CONT_INTOCMIT/SEMN_CONT_VERIFICAT/SEMN_CONT_DIRECTOR/SEMN_GEST_INTOCMIT/SEMN_INTOCMIT"
|
||
Procedure GetSemnatura
|
||
Lparameters tcModul, tcSemnatura, tcPrefix
|
||
* tcModul: CONTABILITATE/GESTIUNE...
|
||
* tcSemanatura: INTOCMIT/VERIFICAT/DIRECTOR/DIRECTOREC
|
||
* tcPrefix OPTIONAL, default 'SEMN': se poate completa cu SEMN/DEN
|
||
Local lcValue, lcOptiune, lcPrefix
|
||
lcValue = ''
|
||
|
||
lcPrefix = IIF(TYPE('tcPrefix') = 'C' and !EMPTY(m.tcPrefix), UPPER(ALLTRIM(m.tcPrefix)), 'SEMN')
|
||
lcOptiune = lcPrefix + Iif(!Empty(m.tcModul), '_' + Upper(m.tcModul), '') + '_' + Upper(m.tcSemnatura) && 'SEMN_CONT_DIRECTOREC' / DEN_CONT_DEPFINCONT
|
||
lcValue = Strtran(Nvl(citeste_optiune(m.lcOptiune), ''), '\r', Chr(13) + Chr(10), 1, 10, 1) && INLOCUIESC /R CU LINIE NOUA
|
||
Return m.lcValue
|
||
Endproc
|
||
|
||
|
||
***************************************************
|
||
* Citeste atasament din baza de date si scrie fisier pe disk (ex: logo.jpg)
|
||
* Se apeleaza fie cu id-ul atasamentului, fie cu numele fisierului
|
||
* Intoarce numarul de bytes scrisi pe disk sau 0
|
||
***************************************************
|
||
Function Atasament2File
|
||
Lparameters tnIdAtasament, tcfilename, tcFilePath
|
||
* tnIdAtasament (optional) : id atasament
|
||
* tcFileName (optional) : nume fisier atasament
|
||
* tcFilePath : calea completa unde se salveaza fisierul, inclusiv numele fisierului
|
||
Local lcFiltru, lcFiltruOriginal, lcFisier, lcOrder, lcSchema, lcSelect, lcgroup, llAfiseaza, lcFilePath
|
||
Local llModParam, lnIdAtas
|
||
Local lcFileName, lcNumeFisier, lnBytesWritten
|
||
Local laFiles[1], lcOraM, ldDataM, lnD, lnFiles, lnH, lnM, lnMin, lnS, lnY, ltDataOraBD, ltDataOraFile
|
||
Private poLink, pcFileName, pnIdAtasament
|
||
poLink = Null
|
||
lnBytesWritten = 0
|
||
pnIdAtasament = Iif(!Empty(m.tnIdAtasament), m.tnIdAtasament, 0)
|
||
pcFileName = Iif(!Empty(m.tcfilename), Justfname(m.tcfilename), '')
|
||
lcFilePath = Iif(!Empty(m.tcFilePath), m.tcFilePath, '')
|
||
|
||
If !(Empty(m.pnIdAtasament) And Empty(m.pcFileName))
|
||
lcSchema = [fisier w, nume_fisier C(100), dataora T ]
|
||
lcSelect = [select fisier, nume_fisier, dataora from atas_atasamente where sters = 0 and ] + Iif(!Empty(m.pnIdAtasament), 'id_atas = ?pnIdAtasament', Iif(!Empty(m.pcFileName), 'nume_fisier=?pcFileName', '1=2'))
|
||
lcOrder = []
|
||
lcgroup = []
|
||
lcFiltru = []
|
||
lcFiltruOriginal = []
|
||
llModParam = .T.
|
||
llAfiseaza = .F.
|
||
|
||
gencursor('poLink', 'cRegFisierTemp', lcSelect, lcFiltru, lcSchema, lcOrder, llAfiseaza, lcgroup, llModParam, lcFiltruOriginal)
|
||
poLink.ca_baza1.afisare()
|
||
If Used('cRegFisierTemp')
|
||
Select cRegFisierTemp
|
||
If Reccount('cRegFisierTemp') > 0
|
||
Go Top
|
||
lcFisier = fisier
|
||
ltDataOraBD = dataora
|
||
ltDataOraFile = dataora - 1
|
||
lcNumeFisier = Alltrim(Nvl(nume_fisier, ''))
|
||
lcFileName = Iif(!Empty(m.pcFileName), m.pcFileName, m.lcNumeFisier)
|
||
lcFilePath = Iif(!Empty(m.lcFilePath), m.lcFilePath, m.lcFileName)
|
||
|
||
Use In (Select('cRegFisierTemp'))
|
||
If !Directory(Justpath(m.lcFilePath))
|
||
Md (Justpath(m.lcFilePath))
|
||
Endif
|
||
|
||
* Verific daca data/ora modificarii din baza de date este mai mare decat cea de pe disk
|
||
* Nu suprascriu daca fisierul de pe disk este mai nou
|
||
polog.Log("Dataora fisier baza date: " + TRANSFORM(m.ltDataOraBD), Program())
|
||
If File(m.lcFilePath)
|
||
lnFiles = Adir(laFiles, m.lcFilePath)
|
||
If m.lnFiles = 1
|
||
ldDataM = laFiles[1, 3]
|
||
lcOraM = laFiles[1, 4]
|
||
lnY = Year(m.ldDataM)
|
||
lnM = Month(m.ldDataM)
|
||
lnD = Day(m.ldDataM)
|
||
lnH = INT(VAL(Substr(m.lcOraM, 1, 2)))
|
||
lnMin = INT(VAL(Substr(m.lcOraM, 4, 2)))
|
||
lnS = INT(VAL(Substr(m.lcOraM, 7, 2)))
|
||
Try
|
||
ltDataOraFile = Datetime(m.lnY, m.lnM, m.lnD, m.lnH, m.lnMin, m.lnS)
|
||
Catch
|
||
ltDataOraFile = m.ltDataOraBD
|
||
Endtry
|
||
ENDIF
|
||
polog.Log("Dataora fisier disk: " + TRANSFORM(m.ltDataOraFile), Program())
|
||
Endif
|
||
|
||
If m.ltDataOraBD > ltDataOraFile
|
||
lnBytesWritten = Strtofile(m.lcFisier, m.lcFilePath)
|
||
ELSE
|
||
lnBytesWritten = 1
|
||
Endif
|
||
Endif && reccount
|
||
Endif && used
|
||
Endif && empty
|
||
|
||
Return m.lnBytesWritten
|
||
|
||
Endfunc && Atasament2File
|
||
|
||
***************************************************
|
||
* Citeste fisierul de pe disk si adauga atasament in baza de date atas_atasamente
|
||
* Se apeleaza cu calea completa a fisierului
|
||
* Intoarce id-ul atasamentului
|
||
***************************************************
|
||
Function File2Atasament
|
||
Lparameters tcFile, tcDescriere
|
||
|
||
Private pcFileName, pnId, pcFile, pcDescriere
|
||
|
||
Local lcSql, lcSqlIns, lcSqlUpd, llSucces
|
||
pnId = 0
|
||
If !File(m.tcFile)
|
||
tcFile = Getfile('', 'Alege un fisier', 'Alege', 0, 'Alege un fisier')
|
||
If Empty(m.tcFile)
|
||
Return m.pnId
|
||
Endif
|
||
Endif
|
||
|
||
pcFile = Filetostr(m.tcFile)
|
||
pcFileName = Lower(Justfname(m.tcFile))
|
||
pcDescriere = Iif(!Empty(m.tcDescriere), Alltrim(m.tcDescriere), '')
|
||
lcSql = [SELECT id_atas FROM atas_atasamente WHERE nume_fisier = ?pcFileName]
|
||
lcSqlIns = [insert into atas_atasamente (fisier, nume_fisier, descriere, id_util, dataora) values (?pcFile, ?pcFileName, ?pcDescriere, ?gnIdUtil, sysdate) returning id_atas into ?@pnId]
|
||
lcSqlUpd = [UPDATE atas_atasamente SET fisier = ?pcFile, descriere = ?pcDescriere, id_util = ?gnIdUtil, dataora = sysdate WHERE id_atas = ?pnId]
|
||
|
||
llSucces = goExecutor.oExecuta(m.lcSql, 'crsAtasamenteTemp')
|
||
If m.llSucces
|
||
Do Case
|
||
Case Reccount('crsAtasamenteTemp') > 1
|
||
amessagebox('Sunt mai multe inregistrari cu acelasi nume de fisier! Nu se salveaza!', 0 + 16, _Screen.Caption)
|
||
Case Reccount('crsAtasamenteTemp') = 1
|
||
pnId = crsAtasamenteTemp.id_atas
|
||
Endcase
|
||
Use In (Select('crsAtasamenteTemp'))
|
||
|
||
If Empty(m.pnId)
|
||
llSucces = goExecutor.oExecuta(m.lcSqlIns)
|
||
Else
|
||
llSucces = goExecutor.oExecuta(m.lcSqlUpd)
|
||
pnId = Iif(m.llSucces, m.pnId, 0)
|
||
Endif
|
||
Endif
|
||
|
||
Return m.pnId
|
||
|
||
Endfunc && File2Atasament
|
||
|
||
|
||
* -------------------------------------
|
||
* Genereaza o comanda sql pentru totalizarea unui tabel dupa anumite coloane
|
||
* Echivalentul comenzii TOTAL TO, doar ca face group by dupa toate coloanele care nu sunt in lista de insumat
|
||
* lcSql = Cursor2Total('cAct', 'cActTVA', 'suma,suma_val,valtva,tvaval', .F.)
|
||
* &lcSql
|
||
* -------------------------------------
|
||
Procedure Cursor2Total
|
||
Lparameters tcSource, tcDestination, tcFieldList, tcSumFieldList, tlGenerateCursor
|
||
* tcSource: source cursor name
|
||
* tcDestination: destination cursor name
|
||
* tcFieldList (optional, default empty = all fields): list of fields for group by
|
||
* tcSumFieldList: list of fields for sum()
|
||
* tlGenerateCursor (optional, default = .F.): execute the sql
|
||
Local lcField, lcFieldList, lcGroupBy, lcSql, lcSumFieldList, llField, lnColCount, lnColumn
|
||
lcSumFieldList = Alltrim(Lower(m.tcSumFieldList))
|
||
lcFieldList = Iif(Empty(m.tcFieldList), '', Lower(m.tcFieldList))
|
||
|
||
lnColCount = Fcount(tcSource)
|
||
lcSql = [select ]
|
||
lcGroupBy = []
|
||
For lnColumn = 1 To m.lnColCount
|
||
lcField = Lower(Field(m.lnColumn, m.tcSource))
|
||
|
||
If m.lcField $ m.lcSumFieldList
|
||
lcSql = m.lcSql + Iif(m.lnColumn > 1, [,], []) + [Sum(] + m.lcField + [) as ] + m.lcField
|
||
Else
|
||
llField = Empty(m.lcFieldList) Or m.lcField $ m.lcFieldList
|
||
If m.llField
|
||
lcSql = m.lcSql + Iif(m.lnColumn > 1, [,], []) + m.lcField
|
||
lcGroupBy = m.lcGroupBy + Iif(m.lnColumn > 1, [,], []) + m.lcField
|
||
Endif
|
||
Endif
|
||
Endfor
|
||
|
||
lcSql = m.lcSql + [ from ] + m.tcSource + [ with (buffering=.t.) group by ] + m.lcGroupBy + [ into cursor ] + m.tcDestination + [ readwrite]
|
||
If m.tlGenerateCursor
|
||
&lcSql
|
||
Endif
|
||
Return m.lcSql
|
||
Endproc
|
||
|
||
************************************
|
||
* Functie pentru calculul _PAGETOTAL pentru grupuri care reseteaza pagina la 1 intr-un raport
|
||
* tcCrsAlias este optional, pentru a-l putea inchide la destroy in raport
|
||
************************************
|
||
Function UpdatePageTotalGroup(tcGroupValue, tcCrsAlias)
|
||
Local lcAlias, lcSelect, lnPgCnt
|
||
lcSelect = Select()
|
||
lcAlias = Iif(!Empty(m.tcCrsAlias), tcCrsAlias, 'crsGrpPageCnt')
|
||
If !Used(m.lcAlias)
|
||
Create Cursor (m.lcAlias) (rptGrp C(100), pgCnt i)
|
||
Select (m.lcAlias)
|
||
Index On rptGrp Tag C_GrpPage
|
||
Endif
|
||
|
||
Select (m.lcAlias)
|
||
If !Seek(Transform(m.tcGroupValue), m.lcAlias, 'C_GrpPage')
|
||
Insert Into (m.lcAlias) (rptGrp) Values (Transform(m.tcGroupValue))
|
||
Endif
|
||
Replace pgCnt With Max(pgCnt, _Pageno)
|
||
lnPgCnt = pgCnt
|
||
|
||
Select (m.lcSelect)
|
||
Return m.lnPgCnt
|
||
Endfunc && UpdatePageTotalGroup
|
||
|
||
*******************************************
|
||
* Delete Directories and Files in Directory (including subdirectories)
|
||
* Returns the number of files
|
||
*
|
||
* lnFiles = xdelete('c:\temp')
|
||
*******************************************
|
||
FUNCTION xdelete
|
||
LPARAMETERS tcDirectory
|
||
|
||
LOCAL laFiles[1], llDelete
|
||
llDelete = .T.
|
||
lnFiles = xdir(@laFiles, m.tcDirectory, '*.*', m.llDelete)
|
||
|
||
TRY
|
||
RD (m.tcDirectory)
|
||
CATCH TO loEx
|
||
MESSAGEBOX(m.tcDirectory + ' ' + loEx.message)
|
||
ENDTRY
|
||
|
||
RETURN m.lnFiles
|
||
ENDFUNC && xdelete
|
||
|
||
*******************************************
|
||
* Get Files in Directory (including subdirectories)
|
||
* Returns the number of files
|
||
*
|
||
* ex: Dimension laFiles(1)
|
||
* =xdir(@laFiles, getdir(), '*.*')
|
||
* optional, delete the files and directories
|
||
* =xdir(@laFiles, getdir(), '*.*', .T.)
|
||
*******************************************
|
||
Function xdir
|
||
LPARAMETERS taryParam, tcDirectory, tcFileSkeleton, tlDelete
|
||
Local Array aryTemp(1, 5)
|
||
Local lnCount, lnMax, lnLen, lcFile, lcDirectory, lcFileSkeleton, lcDirFileSkeleton
|
||
|
||
lcDirectory = Addbs(m.tcDirectory)
|
||
lcFileSkeleton = Iif(!Empty(m.tcFileSkeleton), m.tcFileSkeleton, '*.*')
|
||
lcDirFileSkeleton = Addbs(tcDirectory) + m.lcFileSkeleton
|
||
= Adir(aryTemp, m.lcDirFileSkeleton, "AHRSD", 1)
|
||
lnMax = Alen(aryTemp, 1)
|
||
|
||
For lnCount = 1 To lnMax
|
||
lcFile = Alltrim(aryTemp(lnCount, 1))
|
||
If !(m.lcFile == ".") And !(m.lcFile == "..")
|
||
If "D" $ aryTemp(lnCount, 5)
|
||
= xdir(@taryParam, Addbs(m.tcDirectory) + m.lcFile, m.lcFileSkeleton, m.tlDelete)
|
||
IF m.tlDelete
|
||
TRY
|
||
RD (Addbs(m.tcDirectory) + m.lcFile)
|
||
CATCH TO loEx
|
||
MESSAGEBOX(Addbs(m.tcDirectory) + m.lcFile + ' ' + loEx.message)
|
||
ENDTRY
|
||
ENDIF
|
||
Else
|
||
lnLen = Alen(taryParam)
|
||
If !Empty(taryParam(lnLen))
|
||
Dimension taryParam(lnLen + 1)
|
||
lnLen = lnLen + 1
|
||
Endif
|
||
taryParam(lnLen) = m.lcDirectory + m.lcFile
|
||
IF m.tlDelete
|
||
TRY
|
||
DELETE FILE (taryParam(lnLen))
|
||
CATCH TO loEx
|
||
MESSAGEBOX(taryParam(lnLen) + ' ' + loEx.message)
|
||
ENDTRY
|
||
ENDIF
|
||
Endif
|
||
Endif
|
||
ENDFOR
|
||
|
||
Return Alen(taryParam)
|
||
ENDFUNC
|
||
|
||
*------------------------------------------------------------------------
|
||
* syGetWordNum()
|
||
* An alternate version of VFP GetWordNum() that will not skip empty fields.
|
||
* e.g.
|
||
* syGetWordNum([A,,B,C],2,[,]) returns empty string instead of 'B'
|
||
* syGetWordNum([A,,B,C],3,[,]) returns 'B' instead of 'C'
|
||
* Default delimiters are space, tab, carriage return and linefeed.
|
||
* Vertical tab is used as a special token.
|
||
*------------------------------------------------------------------------
|
||
function syGetWordNum(tcString, tnIndex, tcDelimiters)
|
||
local lcPatch, lcWord, i
|
||
if vartype(tcDelimiters)<>'C'
|
||
tcDelimiters = chr(32) + chr(9) + chr(13) + chr(10)
|
||
endif
|
||
lcPatch = tcString
|
||
for i = 1 to len(tcDelimiters)
|
||
lcPatch = strtran(lcPatch,substr(tcDelimiters,i,1),chr(11)+substr(tcDelimiters,i,1)+chr(11))
|
||
endfor
|
||
lcWord = getwordnum(lcPatch, tnIndex, tcDelimiters)
|
||
lcWord = strtran(lcWord,chr(11))
|
||
return lcWord
|
||
endfunc
|
||
|
||
*------------------------------------------------------------------------
|
||
* syGetWordCount()
|
||
* An alternate version of VFP GetWordCount() that will not skip empty fields.
|
||
* e.g.
|
||
* syGetWordCount([A,,B,C],[,]) returns 4 instead of 3
|
||
* Default delimiters are space, tab, carriage return and linefeed.
|
||
* Vertical tab is used as a special token.
|
||
*------------------------------------------------------------------------
|
||
function syGetWordCount(tcString, tcDelimiters)
|
||
local lcPatch, lnCount, i
|
||
if vartype(tcDelimiters)<>'C'
|
||
tcDelimiters = chr(32) + chr(9) + chr(13) + chr(10)
|
||
endif
|
||
lcPatch = tcString
|
||
for i = 1 to len(tcDelimiters)
|
||
lcPatch = strtran(lcPatch,substr(tcDelimiters,i,1),chr(11)+substr(tcDelimiters,i,1)+chr(11))
|
||
endfor
|
||
lnCount = getwordcount(lcPatch, tcDelimiters)
|
||
return lnCount
|
||
ENDFUNC
|
||
|
||
****************************
|
||
|
||
FUNCTION ValidCNP
|
||
LPARAMETERS nCnp
|
||
|
||
LOCAL cCod
|
||
IF TYPE('nCnp') = 'N'
|
||
cCod=ALLTRIM(STR(m.nCnp,15,0))
|
||
ELSE
|
||
cCod = ALLTRIM(m.nCnp)
|
||
ENDIF
|
||
|
||
IF LEN(cCod)!=13
|
||
RETURN .F.
|
||
ENDIF
|
||
LOCAL _X(13),_rest, j
|
||
FOR j=1 TO 13
|
||
_X(j)=VAL(SUBSTR(cCod,j,1))
|
||
ENDFOR
|
||
_rest=(_X(1)*2+_X(2)*7+_X(3)*9+_X(4)*1+_X(5)*4+_X(6)*6+_X(7)*3+_X(8)*5+_X(9)*8+_X(10)*2+_X(11)*7+_X(12)*9)%11
|
||
RETURN IIF((_rest<10 and _rest=_X(13))or(_rest = 10 and _X(13)=1),.T.,.F.)
|
||
ENDFUNC && ValidCNP
|
||
|
||
|
||
FUNCTION cValidCNP
|
||
LPARAMETERS lpcnp
|
||
|
||
IF TYPE('lpCNP') ='N'
|
||
lpCNP = ALLTRIM(STR(m.lpcnp))
|
||
ENDIF
|
||
|
||
IF LEN(ALLTRIM(lpcnp)) <> 13
|
||
RETURN .F.
|
||
ENDIF
|
||
n1 = VAL(SUBSTR(lpcnp, 1, 1))
|
||
n2 = VAL(SUBSTR(lpcnp, 2, 1))
|
||
n3 = VAL(SUBSTR(lpcnp, 3, 1))
|
||
n4 = VAL(SUBSTR(lpcnp, 4, 1))
|
||
n5 = VAL(SUBSTR(lpcnp, 5, 1))
|
||
n6 = VAL(SUBSTR(lpcnp, 6, 1))
|
||
n7 = VAL(SUBSTR(lpcnp, 7, 1))
|
||
n8 = VAL(SUBSTR(lpcnp, 8, 1))
|
||
n9 = VAL(SUBSTR(lpcnp, 9, 1))
|
||
n10 = VAL(SUBSTR(lpcnp, 10, 1))
|
||
n11 = VAL(SUBSTR(lpcnp, 11, 1))
|
||
n12 = VAL(SUBSTR(lpcnp, 12, 1))
|
||
n13 = VAL(SUBSTR(lpcnp, 13, 1))
|
||
c = MOD((n1 * 2 + n2 * 7 + n3 * 9 + ;
|
||
n4 * 1 + n5 * 4 + n6 * 6 + n7 * ;
|
||
3 + n8 * 5 + n9 * 8 + n10 * 2 + ;
|
||
n11 * 7 + n12 * 9), 11)
|
||
IF c = 10
|
||
c = 1
|
||
ENDIF
|
||
IF c = n13
|
||
RETURN .T.
|
||
ELSE
|
||
RETURN .F.
|
||
ENDIF
|
||
ENDFUNC
|
||
|
||
*
|
||
FUNCTION GetDataCNP
|
||
LPARAMETERS plcnp
|
||
LOCAL mlan
|
||
mlan = SUBSTR(plcnp, 2, 2)
|
||
IF VAL(mlan) > 20 AND !INLIST(LEFT(plcnp, 1), "5", "6")
|
||
mlan = "19" + mlan
|
||
ELSE
|
||
mlan = "20" + mlan
|
||
ENDIF
|
||
RETURN CTOD(SUBSTR(plcnp, 6, 2) + "." + SUBSTR(plcnp, 4, 2) + "." + mlan)
|
||
ENDFUNC
|
||
*
|
||
FUNCTION VerifCF
|
||
LPARAMETERS plcfisc
|
||
LOCAL mlsuma, mlrest
|
||
plcfisc = getnrfromstring(plcfisc)
|
||
IF LEN(ALLTRIM(plcfisc)) = 13
|
||
IF .NOT. cvalidcnp(plcfisc)
|
||
RETURN .F.
|
||
ELSE
|
||
RETURN .T.
|
||
ENDIF
|
||
ELSE
|
||
IF LEN(ALLTRIM(plcfisc)) < 2 OR LEN(ALLTRIM(plcfisc)) > 9 OR plcfisc = "0"
|
||
RETURN .F.
|
||
ENDIF
|
||
ENDIF
|
||
plcfisc = PADL(ALLTRIM(plcfisc), 10, "0")
|
||
mlsuma = 0
|
||
FOR i = 1 TO 10
|
||
mlsuma = mlsuma + VAL(SUBSTR(plcfisc, i, 1)) * VAL(SUBSTR("753217532", i, 1))
|
||
ENDFOR
|
||
mlrest = MOD((mlsuma * 10), 11)
|
||
IF mlrest = 10
|
||
mlrest = 0
|
||
ENDIF
|
||
IF VAL(SUBSTR(plcfisc, 10, 1)) <> mlrest
|
||
RETURN .F.
|
||
ELSE
|
||
RETURN .T.
|
||
ENDIF
|
||
ENDFUNC
|
||
*
|
||
*verifiban('RO79FNNB000501041759RO01')
|
||
FUNCTION VerifIBAN
|
||
LPARAMETERS iban
|
||
iban = STRTRAN(iban, " ", "")
|
||
|
||
IF LEN(ALLTRIM(iban)) <> 24
|
||
RETURN .F.
|
||
ENDIF
|
||
mcontrol = SUBSTR(iban, 3, 2)
|
||
iban = SUBSTR(iban, 5, 20) + SUBSTR(iban, 1, 2) + "00"
|
||
miban = ""
|
||
FOR i = 1 TO 24
|
||
IF ISALPHA(SUBSTR(iban, i, 1))
|
||
miban = miban + ALLTRIM(STR(ASC(SUBSTR(iban, i, 1)) - 55))
|
||
ELSE
|
||
miban = miban + SUBSTR(iban, i, 1)
|
||
ENDIF
|
||
ENDFOR
|
||
mibansec = miban
|
||
rest = ""
|
||
FOR i = 0 TO 7
|
||
mibansec = rest + SUBSTR(miban, i * 5 + 1, 5)
|
||
dv = MOD(VAL(mibansec), 97)
|
||
rest = ALLTRIM(STR(dv))
|
||
ENDFOR
|
||
IF PADL(ALLTRIM(STR(98 - VAL(rest))), 2, "0") <> mcontrol
|
||
RETURN .F.
|
||
ELSE
|
||
RETURN .T.
|
||
ENDIF
|
||
ENDFUNC
|
||
*
|
||
FUNCTION GetSumaControlIBAN
|
||
LPARAMETERS iban
|
||
IF LEN(ALLTRIM(iban)) <> 24
|
||
RETURN "XX"
|
||
ENDIF
|
||
mcontrol = SUBSTR(iban, 3, 2)
|
||
iban = SUBSTR(iban, 5, 20) + ;
|
||
SUBSTR(iban, 1, 2) + "00"
|
||
miban = ""
|
||
FOR i = 1 TO 24
|
||
IF ISALPHA(SUBSTR(iban, i, ;
|
||
1))
|
||
miban = miban + ;
|
||
ALLTRIM(STR(ASC(SUBSTR(iban, ;
|
||
i, 1)) - 55))
|
||
ELSE
|
||
miban = miban + ;
|
||
SUBSTR(iban, i, ;
|
||
1)
|
||
ENDIF
|
||
ENDFOR
|
||
mibansec = miban
|
||
rest = ""
|
||
FOR i = 0 TO 7
|
||
mibansec = rest + ;
|
||
SUBSTR(miban, i * ;
|
||
5 + 1, 5)
|
||
dv = MOD(VAL(mibansec), 97)
|
||
rest = ALLTRIM(STR(dv))
|
||
ENDFOR
|
||
RETURN PADL(ALLTRIM(STR(98 - ;
|
||
VAL(rest))), 2, "0")
|
||
ENDFUNC
|
||
*
|
||
FUNCTION GetNrFromString
|
||
LPARAMETERS plstr
|
||
LOCAL mlenstr
|
||
mlenstr = LEN(ALLTRIM(plstr))
|
||
|
||
DO WHILE ISALPHA(plstr) .OR. LEFT(plstr, 1) == " ";
|
||
.OR. LEFT(plstr, 1) == "&" .OR. LEFT(plstr, 1) == "/";
|
||
.OR. LEFT(plstr, 1) == "-" .OR. LEFT(plstr, 1) == "_";
|
||
.OR. LEFT(plstr, 1) == "." .OR. LEFT(plstr, 1) == ":"
|
||
plstr = RTRIM(SUBSTR(plstr, 2, mlenstr))
|
||
ENDDO
|
||
|
||
RETURN plstr
|
||
ENDFUNC
|
||
*
|
||
FUNCTION GetDigitsFromString
|
||
LPARAMETERS plstr, plnrdigits, ;
|
||
pltip, plseparator
|
||
LOCAL mlenstr, ii, ;
|
||
mreturnnrintermed, ;
|
||
mreturnnrfinal
|
||
mlenstr = LEN(ALLTRIM(plstr))
|
||
mreturnnrintermed = ""
|
||
mreturnnrfinal = ""
|
||
FOR ii = 1 TO mlenstr
|
||
mcurentchar = SUBSTR(plstr, ;
|
||
ii, 1)
|
||
IF ISDIGIT(mcurentchar) .OR. ;
|
||
(pltip = 3 .AND. ;
|
||
INLIST(mcurentchar, ".", ;
|
||
","))
|
||
mreturnnrintermed = mreturnnrintermed + ;
|
||
mcurentchar
|
||
ELSE
|
||
IF pltip = 1 .OR. pltip = ;
|
||
2
|
||
mreturnnrintermed = ;
|
||
""
|
||
ENDIF
|
||
ENDIF
|
||
IF LEN(mreturnnrintermed) >= ;
|
||
plnrdigits
|
||
DO CASE
|
||
CASE pltip = 1
|
||
IF LEN(mreturnnrintermed) <= ;
|
||
12 .AND. ;
|
||
verifcf(mreturnnrintermed) ;
|
||
.AND. ;
|
||
.NOT. ;
|
||
ISDIGIT(SUBSTR(plstr, ;
|
||
ii + 1, ;
|
||
1))
|
||
mreturnnrfinal = ;
|
||
mreturnnrintermed
|
||
EXIT
|
||
ENDIF
|
||
CASE pltip = 2
|
||
IF cvalidcnp(mreturnnrintermed)
|
||
mreturnnrfinal = ;
|
||
mreturnnrintermed
|
||
EXIT
|
||
ENDIF
|
||
CASE pltip = 3
|
||
mreturnnrintermed = ;
|
||
STRTRAN(mreturnnrintermed, ;
|
||
plseparator, ;
|
||
"")
|
||
IF VAL(mreturnnrintermed) > ;
|
||
0
|
||
mreturnnrfinal = ;
|
||
mreturnnrintermed
|
||
EXIT
|
||
ENDIF
|
||
ENDCASE
|
||
ENDIF
|
||
ENDFOR
|
||
RETURN mreturnnrfinal
|
||
ENDFUNC
|
||
*
|
||
FUNCTION GetIBANFromString
|
||
LPARAMETERS plstr, plpoz
|
||
LOCAL mlenstr, ii, ;
|
||
mreturnnrintermed, ;
|
||
mreturnnrfinal
|
||
mlenstr = LEN(ALLTRIM(plstr))
|
||
mreturnnrintermed = ""
|
||
mreturnnrfinal = ""
|
||
misok = .F.
|
||
FOR ii = 1 TO mlenstr
|
||
mcurentchar = SUBSTR(plstr, ;
|
||
ii, 1)
|
||
IF misok
|
||
IF LEN(mreturnnrintermed) < ;
|
||
24
|
||
mreturnnrintermed = ;
|
||
mreturnnrintermed + ;
|
||
mcurentchar
|
||
ELSE
|
||
EXIT
|
||
ENDIF
|
||
ELSE
|
||
IF mcurentchar == "R" ;
|
||
.AND. ;
|
||
mreturnnrintermed = ;
|
||
"" .AND. ;
|
||
SUBSTR(plstr, ii + 1, ;
|
||
1) == "O"
|
||
mreturnnrintermed = ;
|
||
mreturnnrintermed + ;
|
||
mcurentchar
|
||
ELSE
|
||
IF mcurentchar == ;
|
||
"O" .AND. ;
|
||
mreturnnrintermed = ;
|
||
"R"
|
||
mreturnnrintermed = ;
|
||
mreturnnrintermed + ;
|
||
mcurentchar
|
||
ELSE
|
||
IF .NOT. ;
|
||
misok ;
|
||
.AND. ;
|
||
INLIST(mcurentchar, ;
|
||
"1", "2", ;
|
||
"3", "4", ;
|
||
"5", "6", ;
|
||
"7", "8", ;
|
||
"9", "0") ;
|
||
.AND. ;
|
||
mreturnnrintermed = ;
|
||
"RO" ;
|
||
.AND. ;
|
||
LEN(mreturnnrintermed) <= ;
|
||
3
|
||
mreturnnrintermed = ;
|
||
mreturnnrintermed + ;
|
||
mcurentchar
|
||
IF plpoz = ;
|
||
1
|
||
misok = ;
|
||
.T.
|
||
ELSE
|
||
mreturnnrintermed = ;
|
||
""
|
||
plpoz = ;
|
||
plpoz - ;
|
||
1
|
||
ENDIF
|
||
ELSE
|
||
mreturnnrintermed = ;
|
||
""
|
||
ENDIF
|
||
ENDIF
|
||
ENDIF
|
||
ENDIF
|
||
ENDFOR
|
||
IF verifiban(mreturnnrintermed)
|
||
RETURN mreturnnrintermed
|
||
ELSE
|
||
RETURN ""
|
||
ENDIF
|
||
ENDFUNC
|
||
*
|
||
FUNCTION ContainChar
|
||
LPARAMETERS plstr
|
||
DO WHILE .NOT. (ISALPHA(plstr) .OR. LEFT(plstr, 1);
|
||
== "&" .OR. LEFT(plstr, 1) == "/" .OR. LEFT(plstr,;
|
||
1) == "-" .OR. LEFT(plstr, 1) == "_")
|
||
IF EMPTY(plstr)
|
||
RETURN .F.
|
||
ENDIF
|
||
plstr = RTRIM(SUBSTR(plstr, ;
|
||
2, 60))
|
||
ENDDO
|
||
RETURN .T.
|
||
ENDFUNC
|
||
*
|
||
FUNCTION GetStrFromStr
|
||
LPARAMETERS plstr
|
||
LOCAL mstr
|
||
mstr = ""
|
||
DO WHILE ISALPHA(plstr) .OR. ;
|
||
LEFT(plstr, 1) == " "
|
||
mstr = mstr + LEFT(plstr, 1)
|
||
plstr = SUBSTR(plstr, 2, 20)
|
||
ENDDO
|
||
RETURN ALLTRIM(mstr)
|
||
ENDFUNC
|
||
*
|
||
FUNCTION CheckDigit
|
||
LPARAMETERS tcstring
|
||
LOCAL llsuccess
|
||
llsuccess = .F.
|
||
IF EMPTY(tcstring)
|
||
RETURN .F.
|
||
ENDIF
|
||
FOR lncharacter = 1 TO ;
|
||
LENC(tcstring)
|
||
lcchar = SUBSTRC(tcstring, ;
|
||
lncharacter, 1)
|
||
llsuccess = ISDIGIT(lcchar)
|
||
IF llsuccess
|
||
EXIT
|
||
ENDIF
|
||
ENDFOR
|
||
RETURN llsuccess
|
||
ENDFUNC
|
||
*
|
||
FUNCTION IsOnlyDigit
|
||
LPARAMETERS tcstring
|
||
LOCAL llsuccess
|
||
llsuccess = .F.
|
||
IF EMPTY(tcstring)
|
||
RETURN .F.
|
||
ENDIF
|
||
FOR lncharacter = 1 TO ;
|
||
LENC(tcstring)
|
||
lcchar = SUBSTRC(tcstring, ;
|
||
lncharacter, 1)
|
||
IF .NOT. ISDIGIT(lcchar) ;
|
||
.AND. .NOT. ;
|
||
INLIST(lcchar, ",", ".", ;
|
||
" ")
|
||
RETURN .F.
|
||
ENDIF
|
||
ENDFOR
|
||
RETURN .T.
|
||
ENDFUNC
|
||
|
||
PROCEDURE TestExcesSerialNumber2Date
|
||
* Example
|
||
? ExcelSerialNumber2Date(39278) && 2007-07-15
|
||
? ExcelSerialNumber2Datetime(39278.456777) && 2007-07-15 10:57:46
|
||
? ExcelSerialNumber2Time(.456777) && 10:57:46
|
||
ENDPROC
|
||
*--------------------------------------------------------------------
|
||
|
||
* Convert Excel serial number to a date
|
||
FUNCTION ExcelSerialNumber2Date(tnExcelSerialNumber)
|
||
RETURN {^1899/12/30} + tnExcelSerialNumber
|
||
ENDFUNC && ExcelSerialNumber2Date
|
||
|
||
* Convert Excel serial number to a datetime
|
||
FUNCTION ExcelSerialNumber2Datetime(tnExcelSerialNumber)
|
||
RETURN DTOT({^1899/12/30} + INT(tnExcelSerialNumber)) + ;
|
||
ROUND(24*60*60 * (tnExcelSerialNumber % 1),0)
|
||
ENDFUNC && ExcelSerialNumber2Datetime
|
||
|
||
* Convert Excel serial number to a time string
|
||
FUNCTION ExcelSerialNumber2Time(tnExcelSerialNumber)
|
||
RETURN SUBSTR(TTOC({^2000/01/10 00:00:00} + ROUND(24*60*60 * (tnExcelSerialNumber % 1),0),3), 12)
|
||
ENDFUNC && ExcelSerialNumber2Time
|
||
|
||
***************************************************************
|
||
* Unzip a zip file
|
||
* lcZipFile = 'c:\arhiva.zip'
|
||
* lcUnzipDir = ''
|
||
* lcErrrMessage = ''
|
||
* llSuccs = Unzip(m.lcZipFile, @lcUnzipDir, @lcErrrMessage)
|
||
***************************************************************
|
||
PROCEDURE MyUnzip
|
||
LPARAMETERS tcFileName, tcUnzipDir, tcErrorMessage, tlSilent
|
||
* tcFileName: IN calea catre fisierul arhiva zip
|
||
* tcUnzipDir: IN/OUT director dezarhivare
|
||
* tcErrorMessage: OUT mesaj eroare daca RETURN = .F.
|
||
* tlSilent: .T. fara wait window la callback
|
||
* RETURN: Logical .T. daca dezarhivare cu succes
|
||
|
||
Local lcFileName, lcLibraryPath, llSucces, loErr
|
||
|
||
llSucces = .F.
|
||
lcFileName = m.tcFileName
|
||
tcErrorMessage = ''
|
||
If Empty(m.lcFileName) OR !FILE(m.lcFileName)
|
||
tcErrorMessage = 'Fisierul de dezarhivat nu exista!'
|
||
RETURN m.llSucces
|
||
ENDIF
|
||
|
||
IF EMPTY(m.tcUnzipDir)
|
||
tcUnzipDir = Addbs(Sys(2023)) + Sys(2015)
|
||
ENDIF
|
||
|
||
IF !DIRECTORY(m.tcUnzipDir )
|
||
Md (m.tcUnzipDir )
|
||
ENDIF
|
||
|
||
Try
|
||
lcLibraryPath = ADDBS(m.gcBasePath) + Iif("ROA" $ Upper(gcBasePath), "COMUNROA", "COMUNCONTAFIN") + "\vfpcompression.fll" && CONTAFIN(ROA)\COMUNCONTAFIN(COMUNROA)\vfpcompression.fll
|
||
|
||
If File(m.lcLibraryPath)
|
||
If !'vfpcompression' $ LOWER(Set("Library"))
|
||
Set Library To (m.lcLibraryPath) Additive
|
||
Endif
|
||
IF !m.tlSilent
|
||
ZipCallback("MyUnzipCallBack()") && Start Event Handling - Any Function/Procedure/Method (in scope of course)
|
||
ENDIF
|
||
llSucces = UnzipQuick(m.lcFileName, m.tcUnzipDir )
|
||
ZipCallback("") && Stop Event Handling
|
||
ELSE
|
||
llSucces = .F.
|
||
tcErrorMessage = 'Nu exista libraria ' + m.lcLibraryPath
|
||
ENDIF
|
||
CATCH TO loErr
|
||
llSucces = .F.
|
||
tcErrorMessage = loErr.Message
|
||
ENDTRY
|
||
|
||
RETURN m.llSucces
|
||
ENDPROC
|
||
|
||
|
||
Procedure UnzipQuickShell
|
||
Lparameters tcFileName, tcUnzipDir, tcErrorMessage, tlSilent
|
||
* tcFileName: IN calea catre fisierul arhiva zip
|
||
* tcUnzipDir: IN/OUT director dezarhivare
|
||
* tcErrorMessage: OUT mesaj eroare daca RETURN = .F.
|
||
* tlSilent: .T. fara wait window la callback && nu este implementat la shell
|
||
* RETURN: Logical .T. daca dezarhivare cu succes
|
||
|
||
Local loShell As "shell.application", loEx as Exception
|
||
Local lcFileName, lcUnzipDir, llSucces, ofile
|
||
|
||
tcErrorMessage = ''
|
||
llSucces = .F.
|
||
|
||
Try
|
||
lcFileName = m.tcFileName && "C:\temp\D401001F.ZIP"
|
||
lcUnzipDir = m.tcUnzipDir
|
||
|
||
IF EMPTY(m.tcUnzipDir) OR TYPE('tcUnzipDir') <> 'C'
|
||
lcUnzipDir = Addbs(Sys(2023)) + Sys(2015)
|
||
ENDIF
|
||
|
||
If !Directory(m.lcUnzipDir)
|
||
Md (m.lcUnzipDir)
|
||
Endif
|
||
|
||
loShell = Createobject("shell.application")
|
||
For Each ofile In loShell.NameSpace(m.lcFileName).items
|
||
loShell.NameSpace(m.lcUnzipDir).copyhere(ofile, 16)
|
||
Endfor
|
||
llSucces = .T.
|
||
Catch To loEx
|
||
tcErrorMessage = loEx.Message
|
||
llSucces = .F.
|
||
Endtry
|
||
|
||
Return m.llSucces
|
||
Endproc && UnzipQuickShell
|
||
|
||
********************************
|
||
* Intoarce calea COMUNA pentru pdf-uri declaratii, efactura generate de program
|
||
* D:\ROA\[tcTip]\[AAAA_LL]\[FIRMA]\[tcTip2]
|
||
* lcFisierPDF = GetPdfPath('EFACTURA', 'PRIMITE')
|
||
********************************
|
||
FUNCTION GetPdfPath
|
||
LPARAMETERS tcTip, tcTip2
|
||
* tcTip: D300/D394/D390/eFactura
|
||
* tcTip2: (optional) Primite (eFactura)
|
||
|
||
Local lcCaleFisier, lcMesaj, lcTip, llSucces, loEx, lcFirma
|
||
lcTip = IIF(!EMPTY(m.tcTip), UPPER(ALLTRIM(m.tcTip)), 'ALTE')
|
||
|
||
*** Creez structura director export (caletemp\D390\aaaa_ll\firma\
|
||
llSucces = .F.
|
||
Try
|
||
lcCaleFisier = Addbs(m.gcBasePath) + m.lcTip + "\" && d:\ROA\D390\
|
||
If !Directory(m.lcCaleFisier)
|
||
Md (m.lcCaleFisier)
|
||
Endif
|
||
|
||
lcCaleFisier = m.lcCaleFisier + Alltrim(Str(gnAn)) + "_" + Padl(Alltrim(Str(gnLuna)), 2, "0") + "\"&& d:\ROA\D390\2011_01\
|
||
If !Directory(m.lcCaleFisier)
|
||
Md (m.lcCaleFisier)
|
||
Endif
|
||
|
||
lcFirma = WindowsSpecialCharacters(m.gcFirma, "_") && Chrtran(m.gcFirma, [/\?%*:|"<>.,;=], Replicate('_', 14))
|
||
lcFirma = Strtran(Alltrim(m.lcFirma), [ ], [_], 1, 100, 1)
|
||
lcFirma = LEFT(m.lcFirma,70) && daca este prea lunga calea, xml3.save nu poate salva fisiere
|
||
|
||
lcCaleFisier = m.lcCaleFisier + m.lcFirma + "\" && Strtran(gcFirma, [ ], [_]) + "\" && d:\ROA\D390\2011_01\firma\
|
||
|
||
If !Directory(m.lcCaleFisier)
|
||
Md (m.lcCaleFisier)
|
||
Endif
|
||
|
||
IF !EMPTY(m.tcTip2)
|
||
lcCaleFisier = m.lcCaleFisier + UPPER(ALLTRIM(m.tcTip2)) + '\' && d:\ROA\D390\2011_01\firma\primite\
|
||
If !Directory(m.lcCaleFisier)
|
||
Md (m.lcCaleFisier)
|
||
ENDIF
|
||
ENDIF
|
||
|
||
llSucces = .T.
|
||
Catch To loEx
|
||
lcCaleFisier = ''
|
||
lcMesaj = "Creare director " + lcCaleFisier + " " + loEx.Message
|
||
amessagebox(lcMesaj, 0 + 48)
|
||
Endtry
|
||
|
||
RETURN m.lcCaleFisier
|
||
ENDFUNC && GetPdfPath
|
||
|
||
FUNCTION DeleteFiles
|
||
lcName = SYS(2000, '*.TXT')
|
||
DO WHILE LEN (lcName) > 0
|
||
DELETE FILE (lcName)
|
||
lcName = SYS (2000, '*.TXT')
|
||
ENDDO
|
||
ENDFUNC
|
||
|
||
PROCEDURE HTTPDownloadFile
|
||
LPARAMETERS lcURL, m.lcDownloadFile
|
||
|
||
Local loHTTP As "winhttp.winhttprequest.5.1"
|
||
Local lnBytes, lnStatus
|
||
|
||
loHTTP = Createobject("winhttp.winhttprequest.5.1")
|
||
loHTTP.Open("GET", m.lcURL, .F.)
|
||
loHTTP.Send()
|
||
lnStatus = loHTTP.Status
|
||
lnBytes = 0
|
||
If m.lnStatus = 200 && OK
|
||
lnBytes = STRTOFILE(loHTTP.ResponseBody, m.lcDownloadFile)
|
||
ENDIF
|
||
|
||
RETURN m.lnBytes > 0
|
||
ENDPROC |