1812 lines
48 KiB
Plaintext
1812 lines
48 KiB
Plaintext
#INCLUDE COMUN.H
|
|
|
|
*** ==================== LOG ============================ ***
|
|
Define Class Log As Custom
|
|
cLog = ''
|
|
cOutputFile = 'c:\log_' + Dtos(Date()) + '.txt'
|
|
lAdditive = .T.
|
|
*
|
|
Proc Init
|
|
Lparameters tcOutputfile, tlAdditive
|
|
|
|
If !Empty(tcOutputfile) And Type('tcOutputFile') = 'C'
|
|
This.cOutputFile = tcOutputfile
|
|
Endi
|
|
If Pcount() = 2 And Type('tlAdditive') = 'L'
|
|
This.lAdditive = tlAdditive
|
|
Endif
|
|
|
|
This.Log()
|
|
This.Log()
|
|
This.WRITELOG()
|
|
|
|
Endproc
|
|
*
|
|
Proc Log
|
|
Lparameters tcMessage, tcProgram
|
|
Local lcLog
|
|
If Pcount() = 0 Or Type('tcMessage') # 'C' Or Empty(tcMessage)
|
|
lcLog = CRLF
|
|
Else
|
|
lcLog = Ttoc(Datetime()) + ' ' + Sys(0) + CRLF + tcMessage + CRLF
|
|
Endi
|
|
This.cLog = This.cLog + lcLog
|
|
Endproc
|
|
*
|
|
Proc ResetLog
|
|
This.cLog = ''
|
|
Endproc
|
|
*
|
|
Proc WRITELOG
|
|
Lpar tcMessage, tcOutputfile, tlAdditive
|
|
Local lcOutputfile, llAdditive, lcLog, lcLogDirectory
|
|
If !Empty(tcOutputfile) And Type('tcOutputFile') = 'C'
|
|
lcOutputfile = tcOutputfile
|
|
Else
|
|
lcOutputfile = This.cOutputFile
|
|
Endi
|
|
If Pcount() < 3 Or Type('tlAdditive') # 'L'
|
|
llAdditive = This.lAdditive
|
|
Else
|
|
llAdditive = tlAdditive
|
|
Endi
|
|
If Type('tcMessage') = 'C'
|
|
If Empty(tcMessage)
|
|
lcLog = CRLF
|
|
Else
|
|
lcLog = Ttoc(Datetime()) + ' ' + Sys(0) + CRLF + tcMessage + CRLF
|
|
Endi
|
|
Else
|
|
lcLog = This.cLog
|
|
Endi
|
|
If !Empty(lcOutputfile)
|
|
lcLogDirectory = Justpath(lcOutputfile)
|
|
If !Directory(lcLogDirectory)
|
|
Md (lcLogDirectory)
|
|
Endif
|
|
Strtofile(lcLog, lcOutputfile, llAdditive)
|
|
Endi
|
|
Endproc
|
|
*
|
|
Enddefine && LOG
|
|
*
|
|
|
|
|
|
Define Class oexecutor As Custom
|
|
nHandle = 0
|
|
cSql = ''
|
|
cSchema = ''
|
|
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.
|
|
lError = .F.
|
|
cErrorMessage = ""
|
|
lApplicationError = .F. && eroare generata de RAISE_APPLICATION_ERROR - afisez doar textul erorii.
|
|
|
|
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)
|
|
If Type('gnHandle') = 'N'
|
|
This.nHandle = gnHandle
|
|
Endif
|
|
Else
|
|
This.nHandle = tnHandle
|
|
Endif
|
|
|
|
Endproc
|
|
******************************************* SFARSIT: INIT *******************************************
|
|
|
|
|
|
* 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(toHash)
|
|
&& tcSql, tcCursor, tnHandle
|
|
Local lnHandle, lcSql, lcSchema, lcCursor, lcTempCursor, lnSucces, laEroare, lcEroare, llReconnect, lnTip, lcTip, lcEroare, lShowError
|
|
Local loEx As Exception
|
|
|
|
Declare laEroare[1]
|
|
lcEroare = ''
|
|
|
|
Local lnTip
|
|
lnTip = 0
|
|
|
|
This.Oreset()
|
|
|
|
lcSql = Iif(toHash.HasProperty("cSql"), toHash.GetValue("cSql"), Upper(This.cSql))
|
|
lcSchema = Iif(toHash.HasProperty("cSchema"), toHash.GetValue("cSchema"), Upper(This.cSchema))
|
|
lcCursor = Iif(toHash.HasProperty("cCursor"), toHash.GetValue("cCursor"), Upper(This.cCursor))
|
|
lnHandle = Iif(toHash.HasProperty("nHandle"), toHash.GetValue("nHandle"), goConn.GetHandle())
|
|
lShowError = Iif(toHash.HasProperty("lShowError"), toHash.GetValue("lShowError"), .T.) && daca se afiseaza mesajul de eroare
|
|
|
|
* Strtofile(lcSql+Chr(13)+Chr(10),Addbs(Justpath(Sys(16,0)))+"log.txt",.T.)
|
|
&& DACA AM TRANZACTIE MANUALA NU FAC RECONNECT
|
|
If SQLGetprop(lnHandle,"Transactions") = 2 && TRANZACTIE MANUALA
|
|
llReconnect = .F.
|
|
Else
|
|
llReconnect = .T.
|
|
Endif
|
|
|
|
lnTip = Iif('ROLLBACK'$lcSql Or 'COMMIT'$lcSql,1,0) && daca ROLLBACK SAU COMMIT TIP = 1, ALTFEL 0
|
|
|
|
Do Case
|
|
Case lnTip = 0
|
|
|
|
lnSucces = -1
|
|
Do While .T.
|
|
*!* daca exista SCHEMA => folosesc CURSORADAPTER (ar trebui sa folosesc mereu???)
|
|
If !Empty(lcSchema)
|
|
Local loC As CursorAdapter
|
|
loC = Createobject("cursoradapter")
|
|
loC.DataSourceType ="ODBC"
|
|
loC.Datasource = lnHandle
|
|
loC.SelectCmd = lcSql
|
|
loC.CursorSchema = lcSchema
|
|
loC.Alias = lcCursor
|
|
Use In (Select(lcCursor))
|
|
llSucces = loC.CursorFill(!Empty(lcSchema))
|
|
If llSucces
|
|
loC.CursorDetach()
|
|
Endif
|
|
lnSucces = Iif(llSucces, CT_SUCCES, CT_INSUCCES)
|
|
Else
|
|
*!* PENTRU SQLEXEC ASINCRON - DO WHILE PANA SE TERMINA EXECUTIA
|
|
Do While .T.
|
|
Try
|
|
lnSucces = SQLExec(lnHandle, lcSql, lcCursor)
|
|
Catch To loEx
|
|
lnSucces = CT_INSUCCES
|
|
Endtry
|
|
|
|
If lnSucces = 0
|
|
*
|
|
Else
|
|
Exit
|
|
Endif
|
|
Enddo
|
|
|
|
lnSucces = Iif(lnSucces > 0, CT_SUCCES, CT_INSUCCES)
|
|
Endif
|
|
|
|
If lnSucces = CT_SUCCES
|
|
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
|
|
Else
|
|
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]
|
|
This.cEroare = lcTextEroare
|
|
lcTextEroare = This.oPrelucrareEroare()
|
|
lnHandle = laEroare[6]
|
|
llEroare = .T.
|
|
Endif
|
|
|
|
goApp.ProcessError(GetHash("lShowError=>" + Iif(lShowError, "1", "0") + "??lApplicationError=>" + Iif(This.lApplicationError, "1", "0") + "??cError=> " + lcTextEroare + "??cUserMessage=>" + lcSql))
|
|
|
|
This.lError = goApp.HasError()
|
|
This.cErrorMessage = goApp.GetError()
|
|
This.nSucces = lnSucces
|
|
This.cEroare = This.cErrorMessage
|
|
This.nEroare = Iif(Alen(laEroare)>=5,laEroare[5],0)
|
|
|
|
|
|
If llReconnect And lnEroare1 = 1526 And Inlist(lnEroare2,12152,3114,12560) && 12512 = TNS: UNABLE TO SEND BREAK MESSAGE; 3114 = NOT CONNECTED TO ORACLE; 12560 = PROTOCOL ADAPTER ERROR
|
|
Do While lnRaspuns = .T. && conectare
|
|
lnRaspuns = AMESSAGEBOX('Eroare de conectare.' + Chr(13) + lcTextEroare + Chr(13) + 'Doriti reconectare?',4+32,'Eroare') && retry = 4; cancel = 2
|
|
If lnRaspuns = 6
|
|
|
|
lnSucces = goConn.Connect()
|
|
|
|
If lnSucces = CT_INSUCCES
|
|
|
|
Release laEroare
|
|
Loop
|
|
Else
|
|
Exit
|
|
Endif
|
|
Else
|
|
&& daca nu doresc conectare atunci ies din program
|
|
Return To Master
|
|
Endif && lnRaspuns = 6
|
|
Enddo && conectare
|
|
|
|
Loop && daca am iesit cu un handle valid intru din nou in loop si execut din nou comanda
|
|
Endif && lnEroare1 = 1526 AND INLIST(lnEroare2,12152,3114,12560)
|
|
|
|
Exit
|
|
Endif && lnSucces = CT_INSUCCES
|
|
|
|
Enddo && .T.
|
|
|
|
Case lnTip = 1
|
|
If 'ROLLBACK'$lcSql
|
|
lnSucces = Sqlrollback(lnHandle)
|
|
Else
|
|
lnSucces = Sqlcommit(lnHandle)
|
|
Endif
|
|
|
|
If lnSucces < 0
|
|
goApp.ProcessError()
|
|
This.lError = goApp.HasError()
|
|
This.cErrorMessage = goApp.GetError()
|
|
This.nSucces = lnSucces
|
|
This.cEroare = This.cErrorMessage
|
|
This.nEroare = Iif(Alen(laEroare)>=5,laEroare[5],0)
|
|
Endif
|
|
Endcase
|
|
|
|
&& loghez sql
|
|
If lnSucces > 0
|
|
goApp.Log(lcSql)
|
|
ELSE
|
|
SET STEP ON
|
|
Endif
|
|
Return Iif(lnSucces > 0, CT_SUCCES, CT_INSUCCES)
|
|
|
|
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 = CT_SUCCES
|
|
tuRetValue = Evaluate(lcField)
|
|
If Used(lcCursor)
|
|
Use In (lcCursor)
|
|
Endif
|
|
Endif
|
|
|
|
Return lnSucces
|
|
|
|
Endfunc && oFunction2Value
|
|
******************************************* 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 = m.tcSql
|
|
lcCursor = Sys(2015)
|
|
|
|
lnSucces = This.oExecute(GetHash('cSql=>' + m.lcSql + '??cCursor=>' + m.lcCursor))
|
|
|
|
If m.lnSucces = CT_SUCCES
|
|
If Reccount(lcCursor) > 1
|
|
goApp.ProcessError(GetHash("cUserMessage=>Au rezultat mai multe valori. Se astepta o singura valoare."))
|
|
lnSucces = CT_INSUCES
|
|
Else
|
|
lcField = lcCursor + '.' + Field(1)
|
|
tuRetValue = Evaluate(lcField)
|
|
Endif
|
|
Use In (SELECT(m.lcCursor))
|
|
Endif
|
|
|
|
Select (m.lcSelect)
|
|
Return lnSucces
|
|
Endfunc &&oSelect2Value
|
|
******************************************* SFARSIT: oFunction2Value *******************************************
|
|
|
|
******************************************* 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)
|
|
This.lApplicationError = .T.
|
|
|
|
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 = ''
|
|
cConnectionString = ''
|
|
nHandle = 0
|
|
cEroare = ''
|
|
Declare aEroare[7]
|
|
lShowError = .F.
|
|
lReconnect = .F. && Daca llReconnect = .T. se apeleaza InitSesiune din oInit_Optiuni.prg
|
|
lError = .F.
|
|
cErrorMessage = ''
|
|
|
|
*** IsConnected ===========================================================================================
|
|
Function IsConnected
|
|
Local llConnected
|
|
llConnected = This.nHandle > 0
|
|
Return llConnected
|
|
Endfunc && IsConnected
|
|
|
|
*** GetHandle ===========================================================================================
|
|
Function GetHandle
|
|
Return This.nHandle
|
|
Endfunc && GetHandle
|
|
|
|
*** 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, lcConnectionString
|
|
Local loEx As Exception
|
|
|
|
If Pcount() < 3 Or Type('tcHost') # 'C' Or Type('tcUser') # 'C' Or Type('tcPassword') # 'C'
|
|
This.cHost = goApp.oSettings.GetValue("HOST")
|
|
This.cUser = goApp.oSettings.GetValue("USER")
|
|
This.cPassword = goApp.oSettings.GetValue("PASSWORD")
|
|
This.cConnectionString = goApp.oSettings.GetValue("CONNECTIONSTRING")
|
|
Else
|
|
This.cHost = tcHost
|
|
This.cUser = tcUser
|
|
This.cPassword = tcPassword
|
|
Endif
|
|
|
|
lcHost = This.cHost
|
|
lcUser = This.cUser
|
|
lcPassword = This.cPassword
|
|
lcConnectionString = This.cConnectionString
|
|
|
|
If Pcount() < 4 Or Type('tlReconnect') # 'L'
|
|
llReconnect = This.lReconnect
|
|
Else
|
|
llReconnect = tlReconnect
|
|
Endif
|
|
|
|
SQLSetprop(0,"DispLogin",3)
|
|
If Empty(m.lcConnectionString)
|
|
lcString="dsn="+Alltrim(lcHost)+";Uid="+Alltrim(lcUser)+";Pwd="+Alltrim(lcPassword)+";"
|
|
Else
|
|
lcString = m.lcConnectionString
|
|
Endif
|
|
lcString = Textmerge(m.lcString)
|
|
|
|
If !This.IsConnected()
|
|
Try
|
|
This.nHandle = Sqlstringconnect(lcString)
|
|
Catch To loEx
|
|
This.nHandle = -1
|
|
This.ProcessError(loEx.ErrorNo, loEx.Procedure, loEx.Lineno)
|
|
Endtry
|
|
goApp.Log("Conectare, Handle = " + Alltrim(Transform(This.nHandle)))
|
|
Endif
|
|
|
|
If Type('gnHandle') = 'N'
|
|
gnHandle = This.nHandle
|
|
Endif
|
|
|
|
If Type('goExecutor') = 'O'
|
|
goExecutor.nHandle = This.nHandle
|
|
Endif
|
|
|
|
If This.IsConnected()
|
|
lnSucces = CT_SUCCES
|
|
|
|
*** SETARI SESIUNE DUPA CONECTARE
|
|
This.postConn()
|
|
|
|
*!* IF llReconnect
|
|
*!* lnSucces = InitSesiune() && IN oInit_Optiuni.prg
|
|
*!* ENDIF
|
|
Else
|
|
lnSucces = CT_INSUCCES
|
|
This.ProcessError()
|
|
Endif
|
|
|
|
Return lnSucces
|
|
|
|
Endproc && Connect
|
|
*** END Connect ===========================================================================================
|
|
|
|
*** Disconnect ===========================================================================================
|
|
Procedure Disconnect
|
|
|
|
Local loEx As Exception, lnSucces, lnHandle, llException
|
|
lnSucces = CT_SUCCES
|
|
llException = .F.
|
|
|
|
If This.IsConnected()
|
|
lnHandle = This.GetHandle()
|
|
*!* TRY
|
|
lnSucces = SQLDisconnect(lnHandle)
|
|
lnSucces = Iif(lnSucces > 0, CT_SUCCES, CT_INSUCCES)
|
|
*!* CATCH TO loEx
|
|
*!* lnSucces = CT_INSUCCES
|
|
*!* llException = .T.
|
|
*!* THIS.ProcessError(loEx.ERRORNO, loEx.PROCEDURE, loEx.LINENO)
|
|
*!* ENDTRY
|
|
|
|
If lnSucces = CT_INSUCCES
|
|
&& daca am prins exceptia s-a inregistrat deja eroarea
|
|
If !llException
|
|
This.ProcessError()
|
|
Endif
|
|
Else
|
|
This.nHandle = -1
|
|
|
|
If Type('gnHandle') = 'N'
|
|
gnHandle = This.nHandle
|
|
Endif
|
|
|
|
If Type('goExecutor') = 'O'
|
|
goExecutor.nHandle = This.nHandle
|
|
Endif
|
|
|
|
Endif
|
|
Endif
|
|
|
|
If lnSucces > 0
|
|
goApp.Log("Deconectare, Handle = " + Alltrim(Transform(m.lnHandle)))
|
|
Endif
|
|
|
|
Return Iif(lnSucces > 0, CT_SUCCES, CT_INSUCCES)
|
|
|
|
Endproc &&
|
|
*** END Disconnect ===========================================================================================
|
|
|
|
*!*=================================================================
|
|
Procedure Destroy
|
|
This.Disconnect()
|
|
Endproc && DESTROY
|
|
|
|
*!*=================================================================
|
|
Procedure Error(nError,cMethod,nLine)
|
|
This.ProcessError(nError,cMethod,nLine)
|
|
Endproc && ERROR
|
|
|
|
*** ProcessError ===========================================================================================
|
|
Procedure ProcessError
|
|
Lparameters nError,cMethod,nLine
|
|
|
|
|
|
Local loHash
|
|
loHash = GetHash()
|
|
If Pcount() = 3
|
|
loHash.SetValue("nError", nError)
|
|
loHash.SetValue("cMethod", cMethod)
|
|
loHash.SetValue("nLine", nLine)
|
|
Endif
|
|
|
|
If Type('goApp') = 'O'
|
|
goApp.ProcessError(loHash)
|
|
|
|
This.cErrorMessage = goApp.GetError()
|
|
This.lError = goApp.HasError()
|
|
Endif
|
|
|
|
Endproc && ProcessError
|
|
*** END ProcessError ===========================================================================================
|
|
|
|
*** postConn ===========================================================================================
|
|
Procedure postConn
|
|
*** PUNCT ZECIMAL
|
|
Local lcSql, loHash, lnSucces
|
|
lnSucces = CT_SUCCES
|
|
If goApp.oSettings.GetValue("database") = 'ORACLE'
|
|
lcSql=[ALTER SESSION SET NLS_NUMERIC_CHARACTERS = ".,"]
|
|
loHash= GetHash("cSql=>" + lcSql)
|
|
lnSucces = goExecutor.oExecute(loHash)
|
|
Endif
|
|
Return lnSucces
|
|
|
|
Endproc && postConn
|
|
*** END postConn ===========================================================================================
|
|
|
|
|
|
Enddefine && oConn
|
|
*** END oConn ===========================================================================================
|
|
|
|
* ===================== 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
|
|
|
|
|
|
Define Class MyHash As Collection
|
|
|
|
*!* sir "proprietate1=>valoare1??proprietate2=>valoare2"
|
|
*!* genereaza proprietati si valori din sirul initial
|
|
Procedure Init
|
|
Lparameters tcPropertyValueList
|
|
|
|
Local i, lnProperties, lcPropertyValue, lcValue, luValue
|
|
Local lnPos
|
|
Declare laLinii[1]
|
|
|
|
&& tcPropertyValueList = [cselect =>ala bala portocala??cfiltru=>un filtru - atentie la spatiile din stanga valorii]
|
|
If Type('tcPropertyValueList') = 'C' And !Empty(tcPropertyValueList)
|
|
|
|
lnProperties = Alines(laLinii,tcPropertyValueList,4,'??')
|
|
For i = 1 To lnProperties
|
|
lcPropertyValue = Alltrim(laLinii[i])
|
|
lnPos = At('=>', lcPropertyValue)
|
|
If lnPos > 0
|
|
lcProperty = Left(lcPropertyValue,lnPos - 1)
|
|
lcValue = Substr(lcPropertyValue, lnPos + 2)
|
|
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
|
|
|
|
Local loC As Collection
|
|
loC = This
|
|
|
|
If Type('loc(tcProperty)') <> 'U'
|
|
loC(tcProperty) = tuValue
|
|
Else
|
|
loC.Add(tuValue, tcProperty)
|
|
Endif
|
|
|
|
Return loC(tcProperty)
|
|
|
|
Endproc && SetValue
|
|
|
|
*!* Intoarce valoarea unei proprietati daca exista, altfel valoarea empty() corespunzator tipului proprietatii
|
|
Function GetValue
|
|
Lparameters tcProperty
|
|
|
|
Local luValue
|
|
Local loC As Collection
|
|
loC = This
|
|
|
|
If Type('loC(tcProperty)') <> 'U'
|
|
luValue = loC(tcProperty)
|
|
Else
|
|
luValue = loC.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 llReturn
|
|
Local loC As Collection
|
|
loC = This
|
|
llReturn = .F.
|
|
|
|
If Type('loC(tcProperty)') <> 'U'
|
|
llReturn = .T.
|
|
Endif
|
|
|
|
Return llReturn
|
|
|
|
Endfunc && HasProperty
|
|
|
|
Enddefine
|
|
* ===================== MyHash ====================================
|
|
* OBIECT EMULARE HASH
|
|
* loHash = GetHash([cselect=>select id, name from test??cwhere=>id=pnId??corder=>name])
|
|
* ==================================================================
|
|
Define Class MyHashOld 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
|
|
Local lnPos
|
|
Declare laLinii[1]
|
|
|
|
&& 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(lcPropertyValue, 1, '=>')
|
|
*!* lcValue = GETWORDNUM(lcPropertyValue, 2, '=>')
|
|
*!* luValue = THIS.GetDefaultValue(lcProperty, lcValue)
|
|
*!* THIS.SetValue(lcProperty, luValue)
|
|
*!* ENDIF
|
|
*!* ENDFOR
|
|
lnProperties = Alines(laLinii,tcPropertyValueList,4,'??')
|
|
For i = 1 To lnProperties
|
|
lcPropertyValue = Alltrim(laLinii[i])
|
|
lnPos = At('=>', lcPropertyValue)
|
|
If lnPos > 0
|
|
lcProperty = Left(lcPropertyValue,lnPos - 1)
|
|
lcValue = Substr(lcPropertyValue, lnPos + 2)
|
|
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 AMESSAGEBOX
|
|
Lparameters tcMessage, tnDialogBoxType, tcTitle, tcFont, tnTimeOut ,tnTimeoutValue
|
|
|
|
Local loMessage, lnReturn, lcMessageboxForm
|
|
|
|
*!* *!* 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('tnDialogBoxType') # 'N'
|
|
tnDialogBoxType = 0
|
|
Endif
|
|
|
|
If Type('tcTitle') # 'C'
|
|
tcTitle = ''
|
|
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.Show(1)
|
|
lnReturn = loMessage.IDOpcion
|
|
Endif
|
|
|
|
|
|
Return lnReturn
|
|
|
|
Endfunc && amessagebox
|
|
***---------------------------------
|
|
|
|
|
|
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
|
|
|
|
|
|
|
|
***---------------------------------------------------------------------
|
|
Procedure OPEN_DEFAULT_APP
|
|
Parameters tcfilename
|
|
|
|
Declare Integer ShellExecute In shell32.Dll ;
|
|
INTEGER hndWin, ;
|
|
STRING cAction, ;
|
|
STRING cFileName, ;
|
|
STRING cParams, ;
|
|
STRING cDir, ;
|
|
INTEGER nShowWin
|
|
cFileName = tcfilename
|
|
cAction = "open"
|
|
ShellExecute(0,cAction,cFileName,"","",1)
|
|
|
|
Endproc && OPEN_DEFAULT_APP
|
|
|
|
|
|
|
|
Procedure BringWindowTop
|
|
Local lnHwnd
|
|
|
|
#Define GW_CHILD 5 && 0x00000005
|
|
#Define GW_HWNDNEXT 2 && 0x00000002
|
|
#Define SW_MAXIMIZE 3 && 0x00000003
|
|
#Define SW_NORMAL 1 && 0x00000002
|
|
#Define WAIT_OBJECT_0 0 && 0x00000000
|
|
|
|
Declare Integer CloseHandle In Kernel32 Integer hObject
|
|
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
|
|
|
|
lnHwnd = GetWindow(GetDesktopWindow(), GW_CHILD)
|
|
BringWindowToTop(lnHwnd)
|
|
|
|
CloseHandle(lnHwnd)
|
|
|
|
Clear Dlls "BringWindowToTop", "GetDesktopWindow", "GetWindow", "CloseHandle"
|
|
Endproc
|
|
|
|
|
|
|
|
*!*===============================================================
|
|
Procedure newguid
|
|
Local lcPK,lcBuffer,i,lnHex,lnUpper,lnLower
|
|
*!* DECLARE INTEGER CoCreateGuid IN OLE32.DLL STRING @lcBuffer
|
|
lcBuffer=Space(17)
|
|
lcPK=Space(0)
|
|
If CoCreateGuid(@lcBuffer) = 0
|
|
For i=1 To 16
|
|
lnHex=Asc(Substr(lcBuffer,i,1))
|
|
lnUpper=Int(lnHex/16)
|
|
lnLower=lnHex-(lnUpper*16)
|
|
lcPK=lcPK+Substr('0123456789ABCDEF',lnUpper+1,1)+;
|
|
SUBSTR('0123456789ABCDEF',lnLower+1,1)
|
|
Endfor
|
|
Endif
|
|
Return lcPK
|
|
Endproc
|
|
|
|
*!*===============================================================
|
|
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
|
|
|
|
Function setini
|
|
Parameter pcinifile, pcsection, ;
|
|
pcvar, pcval
|
|
Private lasect
|
|
Private lavars
|
|
Private All Like j*
|
|
Dimension lasect[1], lavars[ 1,3]
|
|
jlsuccess = .T.
|
|
If .Not. Empty(pcinifile)
|
|
jcfilename = Iif(At('.', ;
|
|
pcinifile) > 0, ;
|
|
pcinifile, ;
|
|
pcinifile + ;
|
|
'.INI')
|
|
pcsection = Alltrim(pcsection)
|
|
pcvar = Alltrim(pcvar)
|
|
pcval = Alltrim(pcval)
|
|
If File(jcfilename)
|
|
jnhandle = Fopen(jcfilename, ;
|
|
2)
|
|
If jnhandle < 0
|
|
jlsuccess = .F.
|
|
= Messagebox( ;
|
|
'Unable to open file: ' + ;
|
|
jcfilename, ;
|
|
'File Open Error', ;
|
|
0)
|
|
Return jlsuccess
|
|
Endif
|
|
Else
|
|
jnhandle = -1
|
|
Endif
|
|
= buildarray(jnhandle, ;
|
|
@lasect,@lavars)
|
|
If jnhandle > -1
|
|
= Fclose(jnhandle)
|
|
Endif
|
|
jsuccess = buildini(jcfilename, ;
|
|
pcsection,pcvar, ;
|
|
pcval,@lasect, ;
|
|
@lavars)
|
|
Else
|
|
jlsuccess = .F.
|
|
Endif
|
|
Return jlsuccess
|
|
Endfunc && setini
|
|
*!*
|
|
Function buildini
|
|
Parameter pcfilename, pcsection, ;
|
|
pcvar, pcval, pasect, ;
|
|
pavars
|
|
Private All Like j*
|
|
jlsuccess = .T.
|
|
jnfhandle = 0
|
|
jlfoundvar = .F.
|
|
jnfound = 0
|
|
If .Not. Empty(pasect)
|
|
For jncount = 1 To ;
|
|
ALEN(pasect, 1)
|
|
If Upper(pasect(jncount)) == ;
|
|
UPPER(pcsection)
|
|
jnfound = jncount
|
|
Exit
|
|
Endif
|
|
Endfor
|
|
Endif
|
|
If jnfound > 0
|
|
For jncount = 1 To ;
|
|
ALEN(pavars, 1)
|
|
If pavars(jncount,1) == ;
|
|
pcvar .And. ;
|
|
pavars(jncount,3) == ;
|
|
jnfound
|
|
pavars[ jncount, ;
|
|
2] = pcval
|
|
jlfoundvar = .T.
|
|
Exit
|
|
Endif
|
|
Endfor
|
|
If .Not. jlfoundvar
|
|
If .Not. ;
|
|
EMPTY(pavars(1))
|
|
jnlen2 = Alen(pavars, ;
|
|
1) + 1
|
|
Dimension pavars[ ;
|
|
jnlen2, ;
|
|
3]
|
|
Else
|
|
jnlen2 = 1
|
|
Endif
|
|
pavars[ jnlen2, 1] = ;
|
|
pcvar
|
|
pavars[ jnlen2, 2] = ;
|
|
pcval
|
|
pavars[ jnlen2, 3] = ;
|
|
jnfound
|
|
Endif
|
|
Else
|
|
If .Not. Empty(pasect(1))
|
|
jnlen = Alen(pasect, 1) + ;
|
|
1
|
|
Dimension pasect[ ;
|
|
jnlen]
|
|
Else
|
|
jnlen = 1
|
|
Endif
|
|
pasect[ jnlen] = pcsection
|
|
If .Not. Empty(pavars(1))
|
|
jnlen2 = Alen(pavars, ;
|
|
1) + 1
|
|
Dimension pavars[ ;
|
|
jnlen2, 3]
|
|
Else
|
|
jnlen2 = 1
|
|
Endif
|
|
pavars[ jnlen2, 1] = pcvar
|
|
pavars[ jnlen2, 2] = pcval
|
|
pavars[ jnlen2, 3] = jnlen
|
|
Endif
|
|
If File(pcfilename)
|
|
jcoldfile = Substr(pcfilename, ;
|
|
1, At('.', ;
|
|
pcfilename) - 1) + ;
|
|
'.BAK'
|
|
If File(jcoldfile)
|
|
Delete File (jcoldfile)
|
|
Endif
|
|
Rename (pcfilename) To ;
|
|
(jcoldfile)
|
|
Endif
|
|
jnfhandle = Fcreate(pcfilename)
|
|
If .Not. jnfhandle == -1 .And. ;
|
|
.Not. Empty(pasect)
|
|
For ncount = 1 To ;
|
|
ALEN(pasect, 1)
|
|
If (';' $ ;
|
|
pasect(ncount)) .Or. ;
|
|
EMPTY(pasect(ncount))
|
|
= Fputs(jnfhandle, ;
|
|
pasect(ncount))
|
|
Else
|
|
= Fputs(jnfhandle, ;
|
|
'[' + ;
|
|
pasect(ncount) + ;
|
|
']')
|
|
Endif
|
|
For ncount2 = 1 To ;
|
|
ALEN(pavars, 1)
|
|
If pavars(ncount2, ;
|
|
3) == ncount
|
|
= Fputs(jnfhandle, ;
|
|
pavars(ncount2, ;
|
|
1) + ' = ' + ;
|
|
pavars(ncount2, ;
|
|
2))
|
|
Endif
|
|
Endfor
|
|
Endfor
|
|
= Fclose(jnfhandle)
|
|
Else
|
|
= Messagebox( ;
|
|
'Unable to create file: ' + ;
|
|
jcfilename, ;
|
|
'File create error',0)
|
|
jlsuccess = .F.
|
|
Endif
|
|
Return jlsuccess
|
|
Endfunc && buildini
|
|
*!*
|
|
Function buildarray
|
|
Parameter pnfhandle, pasect, ;
|
|
pavars
|
|
Private All Like j*
|
|
jnalen = 1
|
|
jnvarlen = 1
|
|
If pnfhandle > -1
|
|
= Fseek(pnfhandle, 0)
|
|
Do While .Not. ;
|
|
FEOF(pnfhandle)
|
|
jcline = Fgets(pnfhandle)
|
|
If ';' $ jcline .Or. ;
|
|
EMPTY(jcline)
|
|
If Empty(pasect(1))
|
|
pasect[ 1] = ;
|
|
jcline
|
|
Else
|
|
jnalen = Alen(pasect, ;
|
|
1) + ;
|
|
1
|
|
Dimension pasect[ ;
|
|
jnalen]
|
|
pasect[ ;
|
|
jnalen] = ;
|
|
jcline
|
|
Endif
|
|
Else
|
|
jnfound1 = At('[', jcline)
|
|
jnfound2 = At(']', jcline)
|
|
If jnfound1 > 0 .And. jnfound2 > 0
|
|
jcsection = Substr(jcline, ;
|
|
jnfound1 + ;
|
|
1, ;
|
|
jnfound2 - ;
|
|
2)
|
|
If Empty(pasect(1))
|
|
pasect[ ;
|
|
1] = ;
|
|
jcsection
|
|
Else
|
|
jnalen = ;
|
|
ALEN(pasect, ;
|
|
1) + 1
|
|
Dimension ;
|
|
pasect[ ;
|
|
jnalen]
|
|
pasect[ ;
|
|
jnalen] = ;
|
|
jcsection
|
|
Endif
|
|
jnalen = Alen(pasect, ;
|
|
1)
|
|
Else
|
|
If At('=', ;
|
|
jcline) > ;
|
|
0
|
|
If Empty(pavars(1, ;
|
|
1))
|
|
pavars[ ;
|
|
1, ;
|
|
1] = ;
|
|
ALLTRIM(Substr(jcline, ;
|
|
1, ;
|
|
AT( ;
|
|
'=', ;
|
|
jcline) - ;
|
|
1))
|
|
pavars[ ;
|
|
1, ;
|
|
2] = ;
|
|
ALLTRIM(Substr(jcline, ;
|
|
AT( ;
|
|
'=', ;
|
|
jcline) + ;
|
|
1))
|
|
pavars[ ;
|
|
1, ;
|
|
3] = ;
|
|
jnalen
|
|
Else
|
|
jnvarlen = ;
|
|
ALEN(pavars, ;
|
|
1) + ;
|
|
1
|
|
Dimension ;
|
|
pavars[ ;
|
|
jnvarlen, ;
|
|
3]
|
|
pavars[ ;
|
|
jnvarlen, ;
|
|
1] = ;
|
|
ALLTRIM(Substr(jcline, ;
|
|
1, ;
|
|
AT( ;
|
|
'=', ;
|
|
jcline) - ;
|
|
1))
|
|
pavars[ ;
|
|
jnvarlen, ;
|
|
2] = ;
|
|
ALLTRIM(Substr(jcline, ;
|
|
AT( ;
|
|
'=', ;
|
|
jcline) + ;
|
|
1))
|
|
pavars[ ;
|
|
jnvarlen, ;
|
|
3] = ;
|
|
jnalen
|
|
Endif
|
|
Endif
|
|
Endif
|
|
Endif
|
|
Enddo
|
|
Endif
|
|
Return .T.
|
|
Endfunc && buildarray
|
|
*!*
|
|
Function getini
|
|
Parameter pcinifile, pcsection, ;
|
|
pcvar
|
|
Private All Like j*
|
|
jcretval = ''
|
|
If .Not. Empty(pcinifile)
|
|
jcfilename = Iif(At('.', ;
|
|
pcinifile) > 0, ;
|
|
pcinifile, ;
|
|
pcinifile + ;
|
|
'.INI')
|
|
If File(jcfilename)
|
|
jnhandle = Fopen(jcfilename)
|
|
If jnhandle < 0
|
|
jlsuccess = .F.
|
|
= Messagebox( ;
|
|
'Unable to open file: ' + ;
|
|
jcfilename, ;
|
|
'File Open Error', ;
|
|
0)
|
|
Else
|
|
pcsection = Alltrim(Upper(pcsection))
|
|
pcvar = Alltrim(Upper(pcvar))
|
|
jcretval = readini(@jnhandle, ;
|
|
pcsection, ;
|
|
pcvar)
|
|
= Fclose(jnhandle)
|
|
Endif
|
|
Endif
|
|
Endif
|
|
Return jcretval
|
|
Endfunc && getini
|
|
*!*
|
|
Function readini
|
|
Parameter pnfhandle, pcsection, ;
|
|
pcvar
|
|
Private All Like j*
|
|
jcline = ''
|
|
jcsection = ''
|
|
jnfound1 = 0
|
|
jnfound2 = 0
|
|
jnfound3 = 0
|
|
jnalen = 0
|
|
jcretval = ''
|
|
If .Not. Empty(pnfhandle)
|
|
= Fseek(pnfhandle, 0)
|
|
Do While .Not. ;
|
|
FEOF(pnfhandle)
|
|
jcline = Fgets(pnfhandle)
|
|
jnfound1 = At('[', ;
|
|
jcline)
|
|
jnfound2 = At(']', ;
|
|
jcline)
|
|
If jnfound1 > 0 .And. ;
|
|
jnfound2 > 0
|
|
jcsection = Upper(Substr(jcline, ;
|
|
jnfound1 + ;
|
|
1, ;
|
|
jnfound2 - ;
|
|
2))
|
|
Endif
|
|
If jcsection == ;
|
|
pcsection
|
|
jnfound3 = At('=', ;
|
|
jcline)
|
|
If jnfound3 > 0
|
|
If Alltrim(Upper(Substr(jcline, ;
|
|
1, ;
|
|
jnfound3 - ;
|
|
1))) == ;
|
|
pcvar
|
|
jcretval = ;
|
|
ALLTRIM(Substr(jcline, ;
|
|
jnfound3 + ;
|
|
1))
|
|
Exit
|
|
Endif
|
|
Endif
|
|
Endif
|
|
Enddo
|
|
Endif
|
|
Return jcretval
|
|
Endfunc && readini
|
|
|
|
|
|
* 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
|
|
|
|
*--------------------
|
|
Procedure GETCHOICE
|
|
|
|
m.NSELECT = Bar()
|
|
|
|
Deactivate Popup ( m.CPOPMENU )
|
|
|
|
Return
|
|
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& MENIU &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
|
|
|
|
*** COPIERE SHALLOW - proprietatile care contin referinte la alte obiecte pastreaza aceleasi referinte
|
|
*** EX1: loDestinationObject = CopyObject(loSourceObject) -> creeaza un obiect nou si copie proprietatile din loSourceObject
|
|
*** EX2: CopyObject(loSourceObject, @loDestinationObject) -> adauga/copiaza proprietatile din loSourceObject in loDestinationObject (obiect nou sau existent)
|
|
Function CopyObject
|
|
Lparameters toObject, toNewObject
|
|
Local laProps[1], lnI, lcPropName, loEx As Exception
|
|
* For Empty class only
|
|
If Type("toObject") <> "O"
|
|
toNewObject = Null
|
|
Return Null
|
|
Endif
|
|
|
|
If Type('toNewObject') <> 'O'
|
|
If Type('toObject.Class')='C' And Type('toObject.ClassLibrary')='C'
|
|
toNewObject = Newobject(toObject.Class,toObject.ClassLibrary)
|
|
Else
|
|
toNewObject = Createobject("Empty")
|
|
Endif
|
|
Endif
|
|
|
|
|
|
For lnI=1 To Amembers(laProps, toObject, 0)
|
|
lcPropName = Lower(laProps[lnI])
|
|
* Pre VFP9
|
|
*IF TYPE([ALEN( toObject.&lcPropName)]) = "N"
|
|
If Type([toObject.] + lcPropName,1) = "A"
|
|
* Array
|
|
If !Pemstatus(toNewObject, lcPropName, 5) && If the property does not exist
|
|
AddProperty(toNewObject, lcPropName + "[1]", Null )
|
|
Endif
|
|
= Acopy(toObject.&lcPropName, toNewObject.&lcPropName)
|
|
Else
|
|
If !Pemstatus(toNewObject, lcPropName, 5) && If the property does not exist
|
|
AddProperty(toNewObject, lcPropName, Evaluate("toObject." + lcPropName) )
|
|
Else
|
|
Try
|
|
toNewObject.&lcPropName = Evaluate("toObject." + lcPropName)
|
|
Catch && TO loEx WHEN loEx.ErrorNo = 1743 && PROPERTY IS READONLY - NU FAC NIMIC
|
|
*
|
|
Endtry
|
|
Endif
|
|
Endif
|
|
Endfor
|
|
|
|
Return toNewObject
|
|
Endfunc && CopyObject
|
|
|
|
|
|
Procedure MakeDirectoryStructure
|
|
Lparameters tcDirector
|
|
|
|
Local lnDirectoare, lcSubDirector, lcSubdirectorLocal, i
|
|
|
|
lnDirectoare = Getwordcount(Justpath(m.tcDirector), "\")
|
|
lcSubdirectorLocal = ""
|
|
For i = 1 To lnDirectoare
|
|
lcSubDirector = Getwordnum(Justpath(m.tcDirector), i, "\")
|
|
lcSubdirectorLocal = m.lcSubdirectorLocal + m.lcSubDirector + "\"
|
|
If !Directory(m.lcSubdirectorLocal)
|
|
Md(m.lcSubdirectorLocal)
|
|
Endif
|
|
Endfor
|
|
|
|
Endproc && MakeDirectoryStructure
|
|
*
|
|
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
|
|
*
|
|
*
|
|
* Copiata din D:\ROA\ROACONT\COMUN\programe\oproceduri_comune.prg (GetNrFromString),
|
|
* ca sa nu duplic logica: taie de la inceputul sirului literele si separatorii,
|
|
* pana la prima cifra. Ex. 'RO 15613488' -> '15613488', 'CUI 14770212' -> '14770212'.
|
|
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 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
|
|
*
|
|
* Intoarce un cod fiscal fara atributul de tara. sterge literele si alte caractere nonnumerice
|
|
* RO 1879855 -> 1879855
|
|
FUNCTION GetCodFiscalFRO
|
|
LPARAMETERS tcCF
|
|
|
|
lcCodFiscalFRO = ALLTRIM(CHRTRAN(ALLTRIM(UPPER(TRANSFORM(m.tcCF))), "ABCDEFGHIJKLMNOPQRSTUVWXYZ -./()", ""))
|
|
|
|
RETURN m.lcCodFiscalFRO
|
|
ENDFUNC
|
|
*
|
|
* Normalizeaza codul fiscal / CNP primit din import (Fidelio hotel, BIZ restaurant).
|
|
* Intoarce codul curatat daca este valid, altfel SIR GOL, ca sa nu dea erori la D394/D406.
|
|
*
|
|
* ATENTIE: algoritmul de validare (CNP si CUI) este DOAR pentru Romania. Partenerii straini
|
|
* au coduri care nu respecta regulile romanesti (BE0325777171, DICA9712015/99KS, NN9J17714),
|
|
* deci NU se valideaza si NU se sterg: se pastreaza asa cum vin, ca persoana juridica.
|
|
*
|
|
* Cod considerat ROMANESC:
|
|
* - numai cifre (eventual cu spatii, puncte, liniute), SAU
|
|
* - prefix 'RO' / 'CUI' / 'CF' urmat de cifre
|
|
* Pentru codurile romanesti:
|
|
* - 13 cifre => CNP, validat cu cifra de control (cValidCNP); invalid => ''
|
|
* - 2-10 cifre => CUI persoana juridica, validat cu VerifCF; invalid => ''
|
|
* - alta lungime (12, 14, 15 cifre etc.) => invalid => ''
|
|
* Pentru orice alt cod cu litere (partener strain, pasaport) => se intoarce codul curatat de
|
|
* spatii duble, fara validare.
|
|
*
|
|
* Parametri:
|
|
* tcCod - codul brut din import
|
|
* tnTipPersoana - optional, prin referinta: 1 = juridica, 2 = fizica, 0 = necunoscut
|
|
* tcCodTara - optional, codul de tara al partenerului ('RO', 'BE', ...). Daca este
|
|
* completat si nu este 'RO', codul NU se valideaza cu regulile romanesti.
|
|
FUNCTION GetCodFiscalValid
|
|
LPARAMETERS tcCod, tnTipPersoana, tcCodTara
|
|
|
|
LOCAL lcCod, lcCifre, lcPrefix, lcTara, llRO, llRomanesc, lnParam
|
|
lnParam = PCOUNT()
|
|
IF m.lnParam > 1
|
|
tnTipPersoana = 0
|
|
ENDIF
|
|
|
|
lcCod = ALLTRIM(UPPER(TRANSFORM(NVL(m.tcCod, ''))))
|
|
lcCod = ALLTRIM(CHRTRAN(m.lcCod, CHR(9) + CHR(13) + CHR(10), ' '))
|
|
IF EMPTY(m.lcCod)
|
|
RETURN ''
|
|
ENDIF
|
|
|
|
lcTara = IIF(m.lnParam > 2 AND VARTYPE(m.tcCodTara) = 'C', ALLTRIM(UPPER(m.tcCodTara)), '')
|
|
|
|
* partea numerica: GetNrFromString taie prefixul de litere/separatori ('RO 15613488' -> '15613488')
|
|
lcCifre = ALLTRIM(GetNrFromString(m.lcCod))
|
|
lcCifre = CHRTRAN(m.lcCifre, CHRTRAN(m.lcCifre, '0123456789', ''), '')
|
|
|
|
* prefixul de litere ramas in fata cifrelor (RO, CUI, CF, BE, DICA...)
|
|
lcPrefix = ALLTRIM(CHRTRAN(m.lcCod, CHRTRAN(m.lcCod, 'ABCDEFGHIJKLMNOPQRSTUVWXYZ', ''), ''))
|
|
llRO = INLIST(m.lcPrefix, 'RO', 'CUI', 'CF', 'CIF')
|
|
|
|
* romanesc = fara litere deloc, sau cu prefix romanesc, si fara tara straina declarata
|
|
llRomanesc = (EMPTY(m.lcPrefix) OR m.llRO) AND ;
|
|
(EMPTY(m.lcTara) OR m.lcTara == 'RO' OR m.lcTara == 'ROMANIA')
|
|
|
|
IF !m.llRomanesc
|
|
* partener strain: nu pot valida cu algoritmul romanesc, pastrez codul asa cum vine
|
|
IF m.lnParam > 1
|
|
tnTipPersoana = 1
|
|
ENDIF
|
|
RETURN ALLTRIM(STRTRAN(m.lcCod, ' ', ' '))
|
|
ENDIF
|
|
|
|
IF EMPTY(m.lcCifre)
|
|
RETURN ''
|
|
ENDIF
|
|
|
|
DO CASE
|
|
CASE LEN(m.lcCifre) = 13 AND !m.llRO
|
|
IF cValidCNP(m.lcCifre)
|
|
IF m.lnParam > 1
|
|
tnTipPersoana = 2
|
|
ENDIF
|
|
RETURN m.lcCifre
|
|
ENDIF
|
|
RETURN ''
|
|
CASE BETWEEN(LEN(m.lcCifre), 2, 10)
|
|
IF VerifCF(m.lcCifre)
|
|
IF m.lnParam > 1
|
|
tnTipPersoana = 1
|
|
ENDIF
|
|
RETURN IIF(m.llRO, 'RO' + m.lcCifre, m.lcCifre)
|
|
ENDIF
|
|
RETURN ''
|
|
OTHERWISE
|
|
RETURN ''
|
|
ENDCASE
|
|
ENDFUNC
|
|
*
|