home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
xbase
/
library
/
dbase
/
moss
/
find.prg
< prev
next >
Wrap
Text File
|
1986-11-09
|
2KB
|
99 lines
store .t. to retr
do while retr
store .f. to retr
fn=1
fnu=0
public donn,aa,de
clear
e=0
tr=.f.
don=0
do while .t.
cond=".t."
if e=1
return
endif
CLEAR
@ 2,24 say "FIND AN INDIVIDUAL RECORD:"
@ 2,55 say "DATABASE IN USE:"
@ 3,55 SAY DBF()
@ 1,53 TO 4,79
@ 21,1 SAY "Use the arrow keys to move to fields you wish to match, and enter characters"
@ 22,1 SAY " to match. You may search on up to 3 fields. Upper or lower case is fine."
store " " to f1,f2,f3,f4,f5,f6,f7,f8,f9,f10,f11,f12,f13,f14,F15
store "------------------------------" to li
store "<PgDn> or <Ctrl><End> to start search" to b
@ 24,15 say " " get b
clear gets
do while fn<16
fie="f"+ltrim(str(fn,2))
@ fn+3,23 say left(field(fn)+" ",9) get &fie
fn=fn+1
enddo
@ 3,21 to 20,50
@ 1,22 TO 3,49 DOUBLE
read
if len(trim(f1+f2+f3+f4+f5+f6+f7+f8+f9+f10+f11+f12+f13+f14+F15))<1
e=1
donn=1
return
endif
if len(trim(ndx(1)))>1.and.len(trim(f1))>1
seek upper(trim(f1))
else
fa=1
do while fa<16
de=.f.
fie="f"+ltrim(str(fa,2))
fiz=trim(chr(34)+&fie+chr(34))
if len(trim(&fie))>0
fiel=field(fa)
con="con"+ltrim(str(fa,2))
&con=upper(trim(&fiz))
on error do lerror
store &con$upper(&fiel) to tr
if .not. de
cond=cond+".and. &con$upper(&fiel)"
endif
on error
endif
fa=fa+1
enddo
locate for &cond
endif
if .not.found()
?"Sorry, no match was found. Try again."+chr(7)
don=1
store .t. to retr
wait
exit
endif
clear
f1=field(1)
f2=field(2)
f3=field(3)
? &f1,&f2,&f3
? "Press return to use this record, 'C' to continue looking for"
?" next match"
wait to c
do while upper(c)="C"
cont
if eof()
? "Sorry. No more matches. Try again."+chr(7)
don=1
store .t. to retr
wait
store " " to c
loop
endif
? &f1,&f2,&f3
? "Press return to use this record, or `C' to continue looking"
? " for the next match"
wait to c
enddo
return
enddo
enddo
return