Files
vfp_roaauto/COMUN/programe/cauta_alfa.prg

599 lines
18 KiB
Plaintext

*!* 24.07.2009
*!* marius.mutu
*!* cauta_alfa(tcStringCriterii pentru formularul cauta_alfa_form_plus)
*------------------------------------------------------------
* Description: cauta_alfa - cautare generica
* Parameters: tcselect,tcfiltru,tcschema,tcorder,tccoloana,tcTitlu,tcTitluColoana,tcNume_Proc,tl_AllInList,tcFiltruOriginal,tcPrimaColoana, tnPornire, tnTipReturn, tcIdColumn, tlDesktop, tcGroup, tcGridDynamiBackColor
* Return: tnTipReturn = 0 => object (scatter name pe inregistrarea curenta) ; tnTipReturn = 1 => xml (din inregistrarile selectate)
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 23/06/2006 marius.mutu Initial Creation
* 2 23/06/2006 marius.mutu TipReturn - se presupune ca tcSelect contine o coloana <ales>
* 19/05.2021 liana.neagu adaugare tcLocate
*------------------------------------------------------------
Procedure cauta_alfa
Parameters tcselect,tcfiltru,tcschema,tcorder,tccoloana,tcTitlu,tcTitluColoana, ;
tcNume_Proc,tl_AllInList,tcFiltruOriginal,tcPrimaColoana, tnPornire, tnTipReturn, ;
tcIdColumn, tlDesktop, tcGroup, tcGridDynamicBackColor, tcGridToolTip, tlModParam, tcStringCriterii, ;
tcProceduraVerifica, tcProceduraCopiaza,tcLocate
&& tcStringCriterii : pentru butonul de cautare but_Start_criterii (daca este completat parametrul se foloseste cauta_alfa_form_plus)
&& tnPornire: 1-incepe cu..., 2..... 6-toate
Local llModParam, lnRecc, lcCursorXML, lcIdColumn, llDesktop, lcGroup,lorec
llModParam = .F.
If Empty(tnTipReturn)
tnTipReturn = 0
Endif
If !Empty(tcIdColumn)
lcIdColumn = tcIdColumn
Else
lcIdColumn = "id"
Endif
llDesktop = tlDesktop
Private pcAles
pcAles = ""
Local lccoloana,lcTitlu,pnbuton,lcPrimaColoana
Private deca_baza1,oForm_cautare,oReturnScattObj
Store "" To deca_baza1
Local lcCamp,lcCursor,lcCursort
Store "" To lccoloana,lcPrimaColoana,lcCamp,lcCursor,lcCursort
lccoloana = tccoloana
lcTitluColoana = tcTitluColoana
lcTitlu = tcTitlu
lcSelect = Upper(Alltrim(tcselect))
If Empty(tcPrimaColoana)
lcPrimaColoana=""
Else
lcPrimaColoana=Alltrim(tcPrimaColoana)
Endif
If Empty(tl_AllInList) Or Type('tl_AllInList') # 'L'
ll_AllInList = .F.
Else
ll_AllInList = tl_AllInList
Endif
If Empty(tcFiltruOriginal) Or Type('tcFiltruOriginal') # 'C'
lcFiltOriginal = ''
Else
lcFiltOriginal = tcFiltruOriginal
Endif
If Empty(tcNume_Proc)
lcNume_Proc = ""
Else
lcNume_Proc = Upper(Alltrim(tcNume_Proc))
**caut tip partener daca sunt in cazul nom. de parteneri:
lnPosComma = At(';', lcNume_Proc)
If lnPosComma > 0
lcNume_Proc = Left(lcNume_Proc, lnPosComma - 1) + [_nou with ] + ;
ALLTRIM(Substr(lcNume_Proc, lnPosComma + 1))
Else
lcNume_Proc = lcNume_Proc + "_nou"
Endif
If Left(lcNume_Proc,1) = 'V'
lcNume_Proc = Substr(lcNume_Proc,2)
Endif
Endif
lnPos = At('WHERE',lcSelect)
lnpos2 = Max(Rat(['],lcSelect),Rat(["],lcSelect))
If lnpos2 = 0
lnpos2 = Len(lcSelect)+1
Endif
If !Inlist(Left(lcSelect,1),['],["],"[")
llModParam = .T.
Endif
If lnPos = 0
lcFiltru = ""
*!* llModParam = .T.
Else
If llModParam
lcFiltru = ""
Else
lcFiltru = Alltrim(Substr(lcSelect,lnPos + 6,lnpos2-lnPos-6))
*!* llModParam = .F.
Endif
Endif
lcGroup = Iif(Empty(tcGroup) Or Type('tcGroup') <> 'C', '', tcGroup)
*!* 24.07.2009
If Empty(tcStringCriterii)
lcStringCriterii = ""
Else
lcStringCriterii = Alltrim(tcStringCriterii)
ENDIF
*!* 24.07.2009 ^
lcCursor=Sys(2015)
lcCursort = Alltrim(lcCursor) + 't'
If ll_AllInList = .T.
&& sa adauge "<Toate>" in cursor
gencursor('deca_baza1',lcCursort,tcselect,tcfiltru,tcschema,tcorder,.F.,lcGroup, llModParam, lcFiltOriginal)
deca_baza1.ca_baza1.afisare()
Select *, 0 As ales From &lcCursort Where .F. Into Cursor &lcCursor Readwrite
Select (lcCursor)
If Occurs([,],tccoloana) > 0
lcField = Left(tccoloana,At([,],tccoloana)-1)
lcCamp = lcCursort + '.' + lcField
*IF TYPE('cursor_temp.&lcField')# 'C'
If Type(lcCamp) # 'C'
lcField = Field(1)
Endif
Else
lcField = tccoloana
lcCamp = lcCursort + '.' + lcField
Endif
*IF (RECCOUNT(lccursort)>0) AND TYPE('cursor_temp.&lcField')= 'C'
If (Reccount(lcCursort)>0) And Type(lcCamp)= 'C'
Insert Into &lcCursor (&lcField) Values("<TOATE INREGISTRARILE>")
Endif
Select (lcCursor)
*APPEND FROM DBF("cursor_temp")
Append From Dbf(lcCursort)
Go Top
Use In (lcCursort)
Else
gencursor('deca_baza1',lcCursor,tcselect,tcfiltru,tcschema,tcorder,.F.,lcGroup, llModParam ,lcFiltOriginal)
deca_baza1.ca_baza1.afisare()
Endif
*!* modificare 30.11.2006
If Type("poRec") = "O"
lorec = poRec
Endif
*!* modificare 30.11.2006 ^
lnPornire = tnPornire
pnbuton=1
Select (lcCursor)
lnRecc = Reccount()
** v adaugare 19.05.2021 - Liana - Sa se pozitioneze pe o anumita inregistrare
IF !EMPTY(tcLocate)
Select (lcCursor)
LOCATE FOR &tcLocate
ENDIF
*!* 24.07.2009
DO CASE
CASE !EMPTY(lcStringCriterii)
oForm_cautare=Createobject('cauta_alfa_form_plus',lcCursor,lcNume_Proc,lcTitluColoana,;
lccoloana,ll_AllInList,lcPrimaColoana, lnPornire, tcGridDynamicBackColor, tcGridToolTip, lcStringCriterii)
CASE llDesktop
oForm_cautare=Createobject('cauta_alfa_form_desktop',lcCursor,lcNume_Proc,lcTitluColoana,;
lccoloana,ll_AllInList,lcPrimaColoana, lnPornire, tcGridDynamicBackColor, tcGridToolTip, ;
tcProceduraVerifica, tcProceduraCopiaza)
OTHERWISE
oForm_cautare=Createobject('cauta_alfa_form',lcCursor,lcNume_Proc,lcTitluColoana,lccoloana,;
ll_AllInList,lcPrimaColoana, lnPornire, tcGridDynamicBackColor, tcGridToolTip, ;
tcProceduraVerifica, tcProceduraCopiaza)
ENDCASE
*!* IF llDesktop
*!* oForm_cautare=Createobject('cauta_alfa_form_desktop',lcCursor,lcNume_Proc,lcTitluColoana,;
*!* lccoloana,ll_AllInList,lcPrimaColoana, lnPornire, tcGridDynamicBackColor, tcGridToolTip)
*!* ELSE
*!* oForm_cautare=Createobject('cauta_alfa_form',lcCursor,lcNume_Proc,lcTitluColoana,lccoloana,;
*!* ll_AllInList,lcPrimaColoana, lnPornire, tcGridDynamicBackColor, tcGridToolTip)
*!* ENDIF
*!* 24.07.2009 ^
With oForm_cautare
.crs_cursor = lcCursor
.crs_cursort = lcCursort
If !Empty(lcFiltru)
.cfiltru_original = lcFiltru
Endif
.Lb_titlu_alb_b121.Caption=lcTitlu
.lAles = Iif(tnTipReturn = 1, .T., .F.)
If .lAles
.cAles = Replicate(" ",lnRecc)
Endif
.cIdColumn = lcIdColumn
Endwith
oForm_cautare.Show()
*!* modificare 30.11.2006
If Type("lorec") = "O"
poRec = lorec
Endif
*!* modificare 30.11.2006 ^
lcCursorXML = ""
Select (lcCursor)
If gnbuton=1
Do Case
Case tnTipReturn = 0
Scatter Name oReturnScattObj Memo
Otherwise
Select * From (lcCursor) With (Buffering = .T.) Where Substr(pcAles,Recno(),1) = 'X' ;
INTO Cursor crsReturnAlfa
Cursortoxml("crsReturnAlfa", "lcCursorXML", 2, 0+2+8, 0, "1")
Use In crsReturnAlfa
Endcase
Else
Do Case
Case tnTipReturn = 0
Scatter Name oReturnScattObj Blank
Otherwise
lcCursorXML = ""
Endcase
Endif
Release oForm_cautare
Use In (lcCursor)
Do Case
Case tnTipReturn = 0
Return oReturnScattObj
Otherwise
Return lcCursorXML
Endcase
Endproc && cauta_alfa
***********************************************************************************************************************
Procedure cauta_alfa_vfp
Parameters tcselect,tcfiltru,tcschema,tcorder,tccoloana,tcTitlu,tcTitluColoana,tcNume_Proc,tl_AllInList,tcFiltruOriginal,tnCriteriu,tcFiltruAfisat
*!* modificare 04.08.2011 : am adaugat tnCriteriu, tcFiltruAfisat
Local llModParam
llModParam = .F.
Private lccoloana,lcTitlu,pnbuton,lorec
Store "" To lccoloana
lccoloana = tccoloana
lcTitluColoana = tcTitluColoana
lcTitlu = tcTitlu
lcSelect = Upper(Alltrim(tcselect))
If Empty(tl_AllInList) Or Type('tl_AllInList') # 'L'
ll_AllInList = .F.
Else
ll_AllInList = tl_AllInList
Endif
*!* modificare 14.12.2011
*!* If Empty(tcFiltruOriginal) Or Type('tcFiltruOriginal') # 'C'
*!* lcFiltOriginal = ''
*!* Else
*!* lcFiltOriginal = tcFiltruOriginal
*!* Endif
*!* modificare 14.12.2011 ^
If Empty(tcNume_Proc)
lcNume_Proc = ""
Else
lcNume_Proc = Upper(Alltrim(tcNume_Proc))
*!* **caut tip partener daca sunt in cazul nom. de parteneri:
*!* If (Occurs("ID_TIP_PART",lcSelect)>0)
*!* lnId_tip_part_gasit = Val( Substr(lcSelect,At("= ",lcSelect)+1) )
*!* lcNume_Proc = lcNume_Proc + "_nou with " + Alltrim(Str(lnId_tip_part_gasit))
*!* Else
*!* lcNume_Proc = lcNume_Proc + "_nou"
*!* Endif
*!* If Left(lcNume_Proc,1) = 'V'
*!* lcNume_Proc = Substr(lcNume_Proc,2)
*!* Endif
Endif
lnPos = At('WHERE',lcSelect)
lnpos2 = Max(Rat(['],lcSelect),Rat(["],lcSelect))
If lnpos2 = 0
lnpos2 = Len(lcSelect)+1
Endif
&& 11.07.2007
If !Inlist(Left(lcSelect,1),['],["],"[")
llModParam = .T.
Endif
If lnPos = 0
lcFiltru = ""
*!* llModParam = .T.
Else
If llModParam
lcFiltru = ""
Else
lcFiltru = Alltrim(Substr(lcSelect,lnPos + 6,lnpos2-lnPos-6))
*!* llModParam = .F.
Endif
Endif
*!* modificare 14.12.2011
If !Empty(tcFiltruOriginal) And Type('tcFiltruOriginal') = 'C'
lcSelect = lcSelect + [ WHERE ] + tcFiltruOriginal
Endif
*!* modificare 14.12.2011 ^
If ll_AllInList = .T. && sa adauge "<Toate>" in cursor
lcSelectTemp=lcSelect+[ into cursor cursor_temp]
&lcSelectTemp
Select * From cursor_temp Where .F. Into Cursor cursor_curent Readwrite
Select cursor_curent
If Occurs([,],tccoloana) > 0
lcField = Left(tccoloana,At([,],tccoloana)-1)
If Type('cursor_temp.&lcField')# 'C'
lcField = Field(1)
Endif
Else
lcField = tccoloana
Endif
If (Reccount('cursor_temp')>0) And Type('cursor_temp.&lcField')= 'C'
Insert Into cursor_curent(&lcField) Values("<TOATE INREGISTRARILE>")
Endif
Select cursor_curent
Append From Dbf('cursor_temp')
Go Top
Use In cursor_temp
Select cursor_curent
Else
lcSelect=lcSelect+[ into cursor cursor_curent]
&lcSelect
Endif
*!* modificare 30.11.2006
If Type("poRec") = "O"
lorec = poRec
Endif
*!* modificare 30.11.2006 ^
Select cursor_curent
*!* modificare 04.08.2011 : am adaugat tnCriteriu, tcFiltruAfisat
oForm_cautare=Createobject('cauta_alfa_form_vfp',lcNume_Proc,lcTitluColoana,lccoloana,ll_AllInList,tnCriteriu,tcFiltruAfisat)
pnbuton=1
oForm_cautare.Lb_titlu_alb_b121.Caption=lcTitlu
oForm_cautare.Show()
*!* modificare 30.11.2006
If Type("lorec") = "O"
poRec = lorec
Endif
*!* modificare 30.11.2006 ^
Select cursor_curent
If pnbuton=1
Scatter Name oReturnScattObj Memo
Else
Scatter Name oReturnScattObj Blank
Endif
Release oForm_cautare
**release
Use In cursor_curent
**Release deca_baza1
Return oReturnScattObj
Endproc && cauta_alfa_vfp
***********************************************************************************************************************
Procedure cauta_alfa_gs
Parameters tcselect,tcfiltru,tcschema,tcorder,tccoloana,tcTitlu,tcTitluColoana,tcNume_Proc,tl_AllInList,tcFiltruOriginal,tcPrimaColoana, tnPornire, tnTipReturn, tcIdColumn, tlDesktop, toValoarePropusa
&& toValoarePropusa = valoarea cu care se completeaza textboxul de la cautare
&& tnPornire: 1-incepe cu..., 2..... 6-toate
Local llModParam, lnRecc, lcCursorXML, lcIdColumn, llDesktop,lorec
llModParam = .F.
If Empty(tnTipReturn)
tnTipReturn = 0
Endif
If !Empty(tcIdColumn)
lcIdColumn = tcIdColumn
Else
lcIdColumn = "id"
Endif
llDesktop = tlDesktop
Private pcAles
pcAles = ""
Local lccoloana,lcTitlu,pnbuton,lcPrimaColoana
Private oForm_cautare,oReturnScattObj,deca_baza1
Store "" To deca_baza1
Local lcCursor
Store "" To lccoloana,lcPrimaColoana,lcCamp,lcCursor,lcCursort
lcSchema = tcschema
lcNumeColoane = Strtran(tccoloana,[,],[;])
lcTitluColoane = tcTitluColoana
lcTitlu = tcTitlu
lcSelect = Upper(Alltrim(tcselect))
If Empty(tcPrimaColoana)
lcPrimaColoana=""
Else
lcPrimaColoana=Alltrim(tcPrimaColoana)
Endif
If Empty(tl_AllInList) Or Type('tl_AllInList') # 'L'
ll_AllInList = .F.
Else
ll_AllInList = tl_AllInList
Endif
If Empty(tcFiltruOriginal) Or Type('tcFiltruOriginal') # 'C'
lcFiltruOriginal = ''
Else
lcFiltruOriginal = tcFiltruOriginal
Endif
If Empty(tcNume_Proc)
lcNume_Proc = ""
Else
lcNume_Proc = Upper(Alltrim(tcNume_Proc))
**caut tip partener daca sunt in cazul nom. de parteneri:
lnPosComma = At(';', lcNume_Proc)
If lnPosComma > 0
lcNume_Proc = Left(lcNume_Proc, lnPosComma - 1) + [_nou with ] + Alltrim(Substr(lcNume_Proc, lnPosComma + 1))
Else
lcNume_Proc = lcNume_Proc + "_nou"
Endif
If Left(lcNume_Proc,1) = 'V'
lcNume_Proc = Substr(lcNume_Proc,2)
Endif
Endif
lnPos = At('WHERE',lcSelect)
lnpos2 = Max(Rat(['],lcSelect),Rat(["],lcSelect))
If lnpos2 = 0
lnpos2 = Len(lcSelect)+1
Endif
&& 11.07.2007
If !Inlist(Left(lcSelect,1),['],["],"[")
llModParam = .T.
Endif
If lnPos = 0
lcFiltru = ""
*!* llModParam = .T.
Else
If llModParam
lcFiltru = ""
Else
lcFiltru = Alltrim(Substr(lcSelect,lnPos + 6,lnpos2-lnPos-6))
*!* llModParam = .F.
Endif
Endif
*!* modificare 30.11.2006
If Type("poRec") = "O"
lorec = poRec
Endif
*!* modificare 30.11.2006 ^
lcCursor=Sys(2015)
lcCursort = Alltrim(lcCursor) + 't'
lnPornire = tnPornire
pnbuton=1
*!* IF llDesktop
*!* oForm_cautare=Createobject('cauta_alfa_form_desktop', lcCursor, lcNume_Proc, lcTitlu , lcTitluColoane, lcNumeColoane, lcSelect, lcSchema, lcFiltru, lcFiltruOriginal, lcOrder, ll_AllInList, lnPornire)
*!* ELSE
oForm_cautare=Createobject('cauta_alfa_form_gs', lcCursor, lcNume_Proc, lcTitlu , lcTitluColoane, lcNumeColoane, lcSelect, lcSchema, lcFiltru, lcFiltruOriginal, lcOrder, ll_AllInList, lnPornire, toValoarePropusa)
*!* ENDIF
With oForm_cautare
.lAles = Iif(tnTipReturn = 1, .T., .F.)
If .lAles
.cAles = Replicate(" ",lnRecc)
Endif
Endwith
oForm_cautare.Show()
*!* modificare 30.11.2006
If Type("lorec") = "O"
poRec = lorec
Endif
*!* modificare 30.11.2006 ^
lcCursorXML = ""
Select (lcCursor)
If gnbuton=1
Do Case
Case tnTipReturn = 0
Scatter Name oReturnScattObj Memo
Otherwise
Select * From (lcCursor) With (Buffering = .T.) Where Substr(pcAles,Recno(),1) = 'X' Into Cursor crsReturnAlfa
Cursortoxml("crsReturnAlfa", "lcCursorXML", 2, 0+2+8, 0, "1")
Use In crsReturnAlfa
Endcase
Else
Do Case
Case tnTipReturn = 0
Scatter Name oReturnScattObj Blank
Otherwise
lcCursorXML = ""
Endcase
Endif
Release oForm_cautare
Use In (lcCursor)
Do Case
Case tnTipReturn = 0
Return oReturnScattObj
Otherwise
Return lcCursorXML
Endcase
Endproc && cauta_alfa_gs
***********************************************************************************************************************
Procedure cauta_alfa_hash
Parameters toHash
Local lcSelect,lcFiltru, lcSchema, lcOrder, lccoloana,lcTitlu, lcTitluColoana, lcNumeProc, llAllInList,lcFiltruOriginal,lcPrimaColoana, lnPornire, lnTipReturn, lcIdColumn, llDesktop, lcGridToolTip, llModParam
Local loCauta
loCauta = Null
*!* loHash = GetHash()
*!* loHash.SetValue("cSelect", lcSelect)
*!* loHash.SetValue("cFiltru", lcFiltru)
*!* loHash.SetValue("cSchema", lcSchema)
*!* loHash.SetValue("cOrder", lcOrder)
*!* loHash.SetValue("cColoana", lccoloane)
*!* loHash.SetValue("cTitlu", lcTitlu)
*!* loHash.SetValue("cTitluColoana", lcTitluColoane)
*!* loHash.SetValue("cNumeProc", lcNumeProc)
*!* loHash.SetValue("lToateIreg", llToateIreg)
*!* loHash.SetValue("cFiltruOriginal", lcFiltruOriginal)
*!* loHash.SetValue("cPrimaColoana", lcPrimaColoana)
*!* loHash.SetValue("nPornire", lnPornire)
*!* loHash.SetValue("nTipReturn", lnTipReturn)
*!* loHash.SetValue("cIdColumn", lcIdColumn)
*!* loHash.SetValue("cStringCriterii", lcStringCriterii)
*!* toHash.SetValue('lModParam', llModParam)
*!* toHash.SetValue('cProceduraVerifica', lcProceduraVerifica)
*!* toHash.SetValue('cProceduraCopiaza', lcProceduraCopiaza)
lcSelect = toHash.GetValue('cselect')
lcFiltru = toHash.GetValue('cFiltru')
lcSchema = toHash.GetValue('cSchema')
lcOrder = toHash.GetValue('cOrder')
lcGroup = toHash.GetValue('cGroup')
lccoloana = toHash.GetValue('cColoana')
lcTitlu = toHash.GetValue('cTitlu')
lcTitluColoana = toHash.GetValue('cTitluColoana')
lcNumeProc = toHash.GetValue('cNumeProc')
llAllInList = toHash.GetValue('lAllInList')
lcFiltruOriginal = toHash.GetValue('cFiltruOriginal')
lcPrimaColoana = toHash.GetValue('cPrimaColoana')
lnPornire = toHash.GetValue('nPornire')
lnTipReturn = toHash.GetValue('nTipReturn')
lcIdColumn = toHash.GetValue('cIdColumn')
llDesktop = toHash.GetValue('lDesktop')
lcGridDynamicBackColor = toHash.GetValue('cGridDynamicBackColor')
lcGridToolTip = toHash.GetValue('cGridToolTip')
lcStringCriterii = toHash.GetValue('cStringCriterii')
llModParam = toHash.GetValue('lModParam')
If !llModParam And !Inlist(Left(lcSelect,1),['],["],"[")
llModParam = .T.
ENDIF
lcProceduraVerifica = toHash.GetValue('cProceduraVerifica')
lcProceduraCopiaza = toHash.GetValue('cProceduraCopiaza')
loCauta = cauta_alfa(lcSelect,lcFiltru, lcSchema, lcOrder, lccoloana,lcTitlu, lcTitluColoana, lcNumeProc, llAllInList,lcFiltruOriginal,lcPrimaColoana, lnPornire, lnTipReturn, lcIdColumn, llDesktop, lcGroup, lcGridDynamicBackColor, lcGridToolTip, llModParam, lcStringCriterii, lcProceduraVerifica, lcProceduraCopiaza)
Return loCauta
Endproc && cauta_alfa_hash