Navegando por este foro el dia de hoy, encontré a dos usuarios que buscaban solución a como encontrar y mostrar un dato en todos los registros de una o más DBFs. (incluso en todos los SubDir que se deseen, con una minima modificación)
Picado por la curiosidad y las ganas de ejercitarme un poco, procedí a crear las siguientes funciones que espero les sean de mucha utilidad para integrar sus propias busquedas.
Cualquier mejora es bienvenida.
Saludos.
Francisco J. Alegría P.
Chinandega, Nicaragua.
/ Ejemplo de busqueda en todos los campos de las DBFs deseadas o en un subdirectorio
segun el tipo de dato requerido. (caracter,numerico o fecha)
Se muestran los resultados con la funcion MsgList(), pero bien pueden re-dirigirse
a una dbf u otro tipo de destino.
Muestra, en MsgList(), el nombre de la DBF, el nombre del campo, el No. de registro y el valor buscado.
Se puede mejorar agregando la busqueda en un campo específico.
Si se utiliza un array con las DBFs definidas y no encuentra alguna, informa al respecto.
/
//Francisco J. Alegría P. :Me gustaría recibir sus mejoras. Saludos. ( falegria230349@yahoo.es )
//Chinandega, Nicaragua.
//Agosto 17/2008
include "FiveWin.ch"
**#include "directry.ch" //por si se usa aDirectory()
static aEncont:={}
//-------------------------------------------//
function Main()
local oDlg, xBuscar, oBuscar, oRadio, nVar:=1
SET DATE BRITISH
SET EPOCH TO 1995
SET CENTURY ON
SET DELETED ON
set resources to "busqueda.dll"
DEFINE DIALOG oDlg RESOURCE "BUSCADOR1" TITLE "Prueba de busqueda de un valor en DBFs"
REDEFINE RADIO oRadio VAR nVar ID 103,104,105 OF oDlg ON CHANGE Refresque(@xBuscar,oBuscar,nVar)
REDEFINE GET oBuscar VAR xBuscar ID 102 OF oDlg
REDEFINE BUTTON ID 201 OF oDlg Action ( if(!empty(xBuscar),MsgRun("Aguarde...",,{||Busque(xBuscar)}), msgStop("Valor omitido")),oBuscar:SetFocus() )
REDEFINE BUTTON ID 202 OF oDlg Action ( oDlg:end() ) CANCEL
ACTIVATE DIALOG oDlg CENTERED
return nil
//------------------------
Function Refresque(xBuscar,oBuscar,nVar)
if nVar=1
xBuscar:=space(20)
elseif nVar=2
xBuscar:=0.0000
elseif nVar=3
xBuscar:=date()
endif
oBuscar:Refresh()
Return nil
//---------------------------
//debe usarse aDirectory() si se desea busqueda en todas las DBFs del subdir.
//---------------------------
Function Busque(xBuscar)
local cTipoDato:=ValType(xBuscar)
local aDBFS:={"test","wmdata"}
local n:=0, cAlias
local TpoIn:=Seconds(), TpoFi:=0, nRegist:=0, nDbfs:=0, nReg:=0
For n:=1 to len(aDBFS)
if !file(aDBFS[n]+".dbf")
aadd(aEncont,"NO SE ENCONTRO "+aDBFS[n]+".dbf")
else
dbUseArea(.t.,,aDBFS[n],aDBFS[n],.t.)
nRegist+=(aDBFS[n])->(Reccount())
nDbfs+=1
Buscando(aDBFS[n],xBuscar,cTipoDato,@nReg)
(aDBFS[n])->(dbCloseArea())
endif
Next
MsgInfo("Total Segundos "+transform(Seconds()-TpoIn,"999,999.99")+chr(13)+;
"Bases de datos escaneadas "+alltrim(str(nDbfs))+chr(13)+;
"Registros encontrados "+transform(nReg,"9,999,999"), transform(nRegist,"9,999,999")+" reg. escaneados")
SysRefresh()
if !empty(aEncont)
MsgList(aEncont, "Registros encontrados",1,1,30,80,"Salir")
else
MsgInfo("No se encontraron coincidencias")
endif
aEncont:={}
Return nil
//------------------------
Function Buscando(cAlias,xBuscar,cTipoDato,nReg)
local n:=0
(cAlias)->(dbgotop())
WHILE (cAlias)->(!eof())
for n:=1 to (cAlias)->(fCount())
if ValType( (cAlias)->(FieldGet(n)) ) == cTipoDato
if cTipoDato = "C"
xBuscar:=Upper(alltrim(xBuscar)) //convertimos a mayusc para asegurar resultado
if At( xBuscar, Upper((cAlias)->(FieldGet(n))) ) != 0 //si encuentra coincidencia
aadd( aEncont, (cAlias)+"->"+(cAlias)->(FieldName(n)) +" (Reg "+Alltrim(str((cAlias)->(Recno()))) +") "+(cAlias)->(FieldGet(n)) ) //lo agregamos a un array
nReg+=1
endif
elseif cTipoDato = "N"
if (cAlias)->(FieldGet(n)) = xBuscar
aadd( aEncont, (cAlias)+"->"+(cAlias)->(FieldName(n)) +" (Reg "+Alltrim(str((cAlias)->(Recno()))) +") "+Transform((cAlias)->(FieldGet(n)),"999,999,999.9999") )
nReg+=1
endif
elseif cTipoDato = "D"
if (cAlias)->(FieldGet(n)) = xBuscar
aadd( aEncont, (cAlias)+"->"+(cAlias)->(FieldName(n)) +" (Reg "+Alltrim(str((cAlias)->(Recno()))) +") "+Dtoc((cAlias)->(FieldGet(n))) )
nReg+=1
endif
endif
endif
next
SysRefresh()
(cAlias)->(dbSkip())
ENDDO
Return nil
Chinandega, Nicaragua.
Fwxh-MySql-TMySql
