Marius Mutu
940bb39701
Borderoul tine per factura ce mai are de completat si daca are articole de gestiune (camp gest, coloana si filtru), coada contabilizeaza in serie facturile bifate si incheie cu un rezumat, iar contul de furnizor/client se alege din planul de conturi. Cheia normalizata de articol, rezolvarea automata a partenerului si anularea in bloc intra tot aici. Pozitia in lista se pastreaza peste reaplicarea filtrului. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com> Claude-Session: https://claude.ai/code/session_01Aroafxp4z8bmM5oVECZRXY
8364 lines
270 KiB
Plaintext
8364 lines
270 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)
|
||
|
||
*!* 03.09.2026
|
||
*!* marius.mutu
|
||
*!* GetArticolEFByPartDenumire - invelis peste RecunoastereArticolEF: cascada text exact ->
|
||
*!* cheie normalizata in istoricul furnizorului, plus parametrul de iesire tcSursa (EXACT/APROX)
|
||
|
||
*!* 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
|
||
|
||
*!* 31.07.2026
|
||
*!* marius.mutu
|
||
*!* verifica_partener_show_info: marcaj de provenienta (cache ANAF) langa denumirea firmei, cand disponibil
|
||
|
||
#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
|
||
*!* 22.08.2026 marius.mutu: id_part si data lipseau din cursor, iar Insert Into de mai jos esua tacut (ON ERROR) - lista ramanea goala
|
||
Create Cursor crsXMLParteneriVerificare (cod_fiscal C(30), denumire C(100), atribut_fiscal C(2), ales L, id_part N(16), data 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
|
||
|
||
*!* 01.08.2026 marius.mutu istoricul e comun tuturor firmelor, nu se mai filtreaza pe schema_sursa
|
||
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,
|
||
dataorav_anaf, tvaincasare, splittva, inactiv, data_inceput_scptva, data_sfarsit_scptva, data_anul_imp_scptva, data_inceput_tvainc, data_sfarsit_tvainc, data_inactivare, data_reactivare,
|
||
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, lcSursaPrefix, llAtentie, lcTVA, lcStareFirma, lcIdent, lcMesajAnaf
|
||
|
||
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
|
||
llAtentie = ((m.llPlatitorTVAMfin And !m.llCodRO) Or (!m.llPlatitorTVAMfin And m.llCodRO)) Or m.llInactiv
|
||
|
||
*!* 22.08.2026 marius.mutu: marcaj explicit al sursei (ANAF live / cache), ca prefix pe linia denumirii
|
||
lcSursaPrefix = ''
|
||
If Pemstatus(m.loPartener, 'sursa', 5) And !Empty(Alltrim(Nvl(loPartener.sursa, '')))
|
||
lcSursaPrefix = Iif(Alltrim(Nvl(loPartener.sursa, '')) == 'ANAF', 'ANAF: ', ;
|
||
'CACHE ' + Dtoc(Nvl(loPartener.data_sursa, Date())) + Iif(Alltrim(Nvl(loPartener.sursa, '')) == 'CACHE_INDISP', ' (ANAF indisponibil)', '') + ': ')
|
||
Endif
|
||
|
||
*!* 22.08.2026 marius.mutu: mesaj grupat pe sectiuni TVA/STARE FIRMA/IDENTIFICARE, fara campuri goale
|
||
lcMesajAnaf = Iif(!Empty(Alltrim(Nvl(loPartener.stare, ''))), 'Mesaj ANAF: ' + Alltrim(loPartener.stare) + crlf, '')
|
||
|
||
lcTVA = Iif(m.llPlatitorTVAMfin, "Platitor TVA: DA (la " + Alltrim(loPartener.datatvamfin) + ")", "Platitor TVA: NU") + crlf
|
||
lcStareFirma = 'Inactiv: ' + Iif(m.llInactiv, 'DA', 'NU') + crlf
|
||
If Pemstatus(m.loPartener, 'data_inceput_scptva', 5)
|
||
If !Empty(Nvl(loPartener.data_inceput_scptva, {}))
|
||
lcTVA = m.lcTVA + 'Perioada TVA: ' + Dtoc(loPartener.data_inceput_scptva) + ' - ' + ;
|
||
Iif(Empty(Nvl(loPartener.data_sfarsit_scptva, {})), 'in vigoare', Dtoc(loPartener.data_sfarsit_scptva)) + ;
|
||
Iif(Empty(Nvl(loPartener.data_anul_imp_scptva, {})), '', ' (anulare din oficiu: ' + Dtoc(loPartener.data_anul_imp_scptva) + ')') + crlf
|
||
Endif
|
||
lcTVA = m.lcTVA + m.lcMesajAnaf + 'TVA la incasare: ' + Iif(m.llTvaIncasare, 'DA', 'NU') + crlf
|
||
If !Empty(Nvl(loPartener.data_inceput_tvainc, {}))
|
||
lcTVA = m.lcTVA + 'Perioada TVA la incasare: ' + Dtoc(loPartener.data_inceput_tvainc) + ' - ' + ;
|
||
Iif(Empty(Nvl(loPartener.data_sfarsit_tvainc, {})), 'in vigoare', Dtoc(loPartener.data_sfarsit_tvainc)) + crlf
|
||
Endif
|
||
lcTVA = m.lcTVA + 'Split TVA: ' + Iif(m.llSplitTVA, 'DA', 'NU') + crlf
|
||
If !Empty(Nvl(loPartener.data_inactivare, {}))
|
||
lcStareFirma = m.lcStareFirma + 'Inactivare: ' + Dtoc(loPartener.data_inactivare) + ;
|
||
Iif(Empty(Nvl(loPartener.data_reactivare, {})), '', ' Reactivare: ' + Dtoc(loPartener.data_reactivare)) + crlf
|
||
Endif
|
||
Else
|
||
lcTVA = m.lcTVA + m.lcMesajAnaf + 'TVA la incasare: ' + Iif(m.llTvaIncasare, 'DA', 'NU') + crlf + ;
|
||
'Split TVA: ' + Iif(m.llSplitTVA, 'DA', 'NU') + crlf
|
||
Endif
|
||
|
||
lcIdent = ''
|
||
If !Empty(loPartener.adresa)
|
||
lcIdent = m.lcIdent + 'Adresa: ' + Alltrim(loPartener.adresa) + crlf
|
||
Endif
|
||
If !Empty(loPartener.judet)
|
||
lcIdent = m.lcIdent + 'Judet: ' + loPartener.judet + crlf
|
||
Endif
|
||
If !Empty(loPartener.regcom)
|
||
lcIdent = m.lcIdent + 'Reg. comertului: ' + loPartener.regcom + crlf
|
||
Endif
|
||
If !Empty(loPartener.codpostal)
|
||
lcIdent = m.lcIdent + 'Cod postal: ' + loPartener.codpostal + crlf
|
||
Endif
|
||
If !Empty(loPartener.telefon)
|
||
lcIdent = m.lcIdent + 'Telefon: ' + loPartener.telefon + crlf
|
||
Endif
|
||
If !Empty(loPartener.fax)
|
||
lcIdent = m.lcIdent + 'Fax: ' + loPartener.fax + crlf
|
||
Endif
|
||
|
||
lcText = 'VERIFICARE CIF: ' + m.lcCodFiscal + ' ' + m.lcDenumire + crlf + crlf + ;
|
||
m.lcSursaPrefix + Alltrim(loPartener.firma) + crlf + ;
|
||
Iif(m.llAtentie, ' *** ATENTIE *** ' + crlf, '') + crlf + ;
|
||
'--- TVA ---' + crlf + m.lcTVA + crlf + ;
|
||
Iif(!Empty(m.lcStareFirma), '--- STARE FIRMA ---' + crlf + m.lcStareFirma + crlf, '') + ;
|
||
Iif(!Empty(m.lcIdent), '--- IDENTIFICARE ---' + crlf + m.lcIdent + crlf, '') + ;
|
||
Iif(!Empty(loPartener.eroare), Alltrim(loPartener.eroare) + 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), '')
|
||
|
||
*!* 22.08.2026 marius.mutu: meniu scurtat, un raspuns ANAF acopera toate verificarile separate de mai jos
|
||
lcMenu = lcMeniuOptiuniAnte + ;
|
||
Iif(!m.llVerificareCod, "\", "") + "VERIFICARE ANAF;" + ;
|
||
Iif(!m.llVerificareCod, "\", "") + "VERIFICARE VIES;" + ;
|
||
"ISTORIC VERIFICARI COD FISCAL;" + ;
|
||
"\-;" + ;
|
||
Iif(!m.llVerificareCod, "\", "") + "DESCHIDE FISA PE MFINANTE.RO"
|
||
|
||
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)
|
||
|
||
*!* 22.08.2026 marius.mutu: numerotare pe meniul scurtat (1 ANAF, 2 VIES, 3 ISTORIC, 5 MFINANTE.RO)
|
||
lcTipVerificare = Iif(m.lnOptiune = 1, 'ANAF_SERVICIU_WEB', ;
|
||
Iif(m.lnOptiune = 2, 'VIES_AUTO', ;
|
||
Iif(m.lnOptiune = 3, 'ISTORIC', ;
|
||
Iif(m.lnOptiune = 5, 'MFIN_MANUAL_COD', ''))))
|
||
|
||
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 istoricul furnizorului/clientului cascada RecunoastereArticolEF.PotrivesteArticol
|
||
*** (text exact, apoi cheie normalizata), 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, tcSursa
|
||
* 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
|
||
* tcSursa: parametru de iesire optional (@tcSursa) - 'EXACT'/'APROX' la gasire, '' cand nu s-a gasit nimic
|
||
|
||
Local lcSelect, loArticol, loReturn, loRecunoastere, lcSursa
|
||
lcSelect = SELECT()
|
||
loReturn = Null
|
||
|
||
loRecunoastere = Createobject('RecunoastereArticolEF')
|
||
loArticol = loRecunoastere.PotrivesteArticol(m.tcCodFiscal, m.tlPrimite, m.tcDenumire, m.tnIdEfactura, @lcSursa)
|
||
tcSursa = m.lcSursa
|
||
|
||
IF ISNULL(m.loArticol)
|
||
* obiect cu proprietatile ANAF_VEFACTURA_DETALII la valoarea implicita a tipului, nu NULL, cand cascada nu gaseste nimic
|
||
loArticol = loRecunoastere.oGol
|
||
IF ISNULL(m.loArticol)
|
||
* cascada s-a oprit pe eroare de date, fara sa aduca structura
|
||
goExecutor.oSelecteaza2Object("SELECT * FROM ANAF_VEFACTURA_DETALII WHERE 1 = 0", @loArticol)
|
||
ENDIF
|
||
ENDIF
|
||
|
||
IF m.tlReturnId
|
||
loReturn = loArticol.id_articol
|
||
ELSE
|
||
loReturn = loArticol
|
||
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)) > 10 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 |