How to SCAN substrings in a dbf - Summer 87
Enviado: 28 Jan 2013 00:48
Hi!
Here goes the entire source code (not compiled and not tested). Hope it helps you.
Here goes the entire source code (not compiled and not tested). Hope it helps you.
Código: Selecionar todos
PROCEDURE REC_FND
PRIVATE REC2FIND, SAV_REC
PRIVATE cOldArea, cOldScreen
PRIVATE cBorder = CHR(218) + CHR(196) + CHR(191) + CHR(179) +;
CHR(217) + CHR(196) + CHR(192) + CHR(179)
* Save current position in database if search fails
*--------------------------------------------------
SAV_REC = recno()
set color to &GET_CLR
read
* Continue if escape wasn't pressed
*----------------------------------
IF LASTKEY()#ESC_KEY
*--------------------------------
REC2FIND = space(40)
do DISP_MSG with 'Client (include punctuation): '
@row(),col() get REC2FIND
read
* Continue if the escape key was not pressed
*-------------------------------------------
IF lastkey() # ESC_KEY
* Remove trailing spaces
*-----------------------
REC2FIND = UPPER(trim(REC2FIND))
*-- AlxSts - Start ---------------------*
* Save current work area
cOldArea = Select()
* iF tmpTable exists, delete it
IF File("tmpTable.dbf")
ERASE tmpTable.dbf
ERASE tmpTable.ntx
ENDIF
* Create tmpTable...
COPY STRUCTURE FIELDS COMPNY_NAM, CASE_LNAME TO tmpTable
USE tmpTable EXCLUSIVE
* tmpTable is now the current selected work area... loop the entire main table...
DO WHILE cases->( ! Eof() )
cString = ""
* search LNAME first because if REC2FIND exists in both fields, LNAME takes precedence
IF (REC2FIND $ UPPER(cases->CASE_LNAME))
* Person's last and first names
cString = Trim( cases->CASE_LNAME ) + ", " + cases->CASE_FNAME && assuming there is a field named CASE_FNAME (first name)
ELSEIF (REC2FIND $ UPPER(cases->COMPNY_NAM))
* Company name
cString = cases->COMPNY_NAM
ENDIF
IF Len( cString) > 0
* something was found. Save it...
APPEND BLANK
IF .Not. NetErr()
tmpTable->COMPNY_NAM = cases->COMPNY_NAM
tmpTable->CASE_LNAME = Upper( cString )
ELSE
* Error. Display some message and Exit
do DISP_MSG with [Error writing temporary file. Press a key to exit.]
SELECT Cases
go SAV_REC
RETURN
ENDIF
ENDIF
cases->( DbSkip() )
ENDDO
* If anything was found...
IF tmpTable->( LastRec() ) > 0
* tmpTable is still the current selected work area. Create an index
INDEX ON CASE_LNAME TO tmpTable
GO TOP
* Save the screen area used by popup window
*---------------------
cOldScreen = SAVESCREEN(5, 14, 20, 63)
* Draw a box with single border
*---------------------
@ 5, 14, 20, 63 BOX cBorder
* Browse records in tmp table until user
* cancels browsing (ESC) or a record is selected (ENTER)
*---------------------
DBEDIT(6, 15, 19, 62, {"tmpTable->CASE_LNAME"} , "_REC_FND_", NIL, {" Select a name "})
* Restore screen region
*---------------------
RESTSCREEN(5, 14, 20, 63, cOldScreen)
* Restore previous work area
*---------------------
Select( cOldArea )
IF LASTKEY() # ESC_KEY
* User selected someone.
* Save company name from tmp table...
*---------------------
REC2FIND = TRIM(tmpTable->COMPNY_NAM)
* Seek for selected company name
* in the original table...
*---------------------
* Get client index
*--------------------
set order to 7
* Search using the key
*---------------------
set exact off
seek REC2FIND
set exact on
* Return to the first index
*--------------------------
set order to 1
* If found, put the highlight bar on the record
*----------------------------------------------
if !eof()
do SCRL_TOS
else
* If not found, tell the user
*----------------------------
do DISP_MSG with [Client, ]+trim(REC2FIND)+[, not found. Press a key.]
inkey(0)
go SAV_REC
endif
ELSE
* user cancelled...
go SAV_REC
ENDIF
ELSE
* no matches found...
Select( cOldArea )
do DISP_MSG with [Client, ]+trim(REC2FIND)+[, not found. Press a key.]
inkey(0)
go SAV_REC
ENDIF
* delete tmpTable...
SELECT( "tmpTable" )
USE
ERASE tmpTable.dbf
ERASE tmpTable.ntx
SELECT( cOldArea )
ENDIF
*-- AlxSts - End ---------------------*
ENDIF
RETURN
*----------------------------
* User function for DbEdit()
*----------------------------
FUNCTION _REC_FND_
PARAMETERS status, fld_ptr
PRIVATE request
*
key_stroke = LASTKEY()
*
*Table: Requests to DBEDIT() from User Function
*----------------------------------------------------------
*Value Description
*----------------------------------------------------------
* 0 Quit DBEDIT()
* 1 Continue DBEDIT()
* 2 Force reread/repaint and continue;
* after repaint, process keys, and go to idle
* 3 Append mode (not recommended)
*----------------------------------------------------------
DO CASE
CASE status = 0
* Idle. Continue
request = 1
CASE status = 1
* Beginning-of-file.
request = 1
CASE status = 2
* End-of-file.
request = 1
CASE status = 3
* Empty database file.
request = 0
CASE status = 4
* Key exception.
IF key_stroke = 27
* Exit
request = 0
ELSEIF key_stroke = 13
* Record selected...
* exit with temp table file pointer over selected record
request = 0
ENDIF
OTHERWISE
request = 1
ENDCASE
*
RETURN request*
