Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : QUERY.ZIP
Filename : QUERY.PRG
Output of file : QUERY.PRG contained in archive : QUERY.ZIP
* To all:
*
* This is a query-by-example program for Clipper, in Clipper, that can
* be integrated into an application or left as a standalone. It was
* originally written with the intention of porting it over to dBASE III+,
* however I am not sure that is a possibility at this point. I would like
* to know if anyone does port it.
*
* It is unusual because it uses a technique (with arrays for speed) that
* makes it completely independent of the structure of the database it is
* querying. For example, To list all of the people in your accounts
* receivable dBASE III/III+ or Clipper (RECV.DBF) database who has a zip
* code of 45231, a tax rate less than 4%, a balance greater than $500,
* and (or) a credit limit less than $500 would be a simple matter of entering:
*
* C>QUERY RECV
*
* and then typing in the match information. Query would generate the query,
* and then print the report. It doesn't care about the structure, only that
* the database and report are III compatible.
*
* I think this is a very powerful technique. Please understand that this is
* a rough draft and could be greatly refined. I'll leave that up to you.
*
* This program, in it's present form, is placed in the public domain. Please
* feel free to use it, modify it, or delete it; however please do not
* distribute it modified with my name on it. I don't need the hassles.
* I am always interested in hearing from anyone who finds my software useful
* or improves upon it. I can be contacted during business hours (8-5 M-F) at:
*
*
* PRISM SOFTWARE
* 8284 Shadybrook
* West Chester, OH 45069
* (513) 777-3223
*
* AAK876 Source
* JON.LAWRENCE GEnie
****************************************************************************
PARAMETER db && command line parameter
public query,last_key
set deli to '{}'
set deli on
set inte off
query = [.T.=.T.] && avoids empty query
conjunction = [ .and. ] && match all criteria
valid_operators = [<=>!] && not implemented yet
compress = chr(27)+chr(15) && printer setup string for report
CLEAR
*
* Thanks to Alan Mulquinn (INDEX.PRG) for this command line routine.
* |
* /-----------/
* \/
* \/
IF "" <> db
dbf=UPPER(db)
file= "&dbf"+".DBF"
IF .NOT. FILE("&file")
? "&file does not exist"
? "Returning to DOS"
RETURN
ENDIF
else
clear
do while .T.
mfile=space(8)
dir *.dbf
@ 24,0 say 'File to query ' get mfile
read
if escape() && UDF (see below)
clear
return
endif
file = trim( upper(mfile) ) + '.DBF'
if file='.DBF'
clear
return
endif
if ! file(file)
@ 24,50 say 'File does not exist'
?? chr(7)
loop
else
@ 24,0
@ 24,0 say 'Working ...'
exit
endif
enddo
ENDIF
*
* para FILE,INDEX1,INDEX2,INDEX3,INDEX4,INDEX5,INDEX6
* (can be integrated into a DBMS, thus the parameters)
*
sele A
use &file
t = 1
do while type( fieldname(t) ) <> [U] && set up the input vars [Mname, etc.]
field = fieldname(t)
inputvar = [M] + field
type_of_field = type( field )
do case &&
case type_of_field = [C] && && character field
&inputvar = substr( space( len(&field) ),1,70 )
case type_of_field = [N] && numeric field
&inputvar = 0.0000
case type_of_field = [D] && date field
&inputvar = ctod( space(8) )
case type_of_field = [L] && logical field
&inputvar = [ ]
case type_of_field = [M] && memo field
&inputvar = space(57)
endcase
t = t + 1
enddo
declare operator[ t+1 ] && ARRAY to handle the operators ( <=>! )
no_fields = t - 1 && number of fields in the database
for t = 1 to no_fields
operator[T] = [=] && initialize all operators to the = sign
next t
clear
do mask && generates the input screen
if escape()
clear all
close data
clear
return
endif
*************************
* *
* QBE *
* (Query By Example) *
* *
*************************
*
* A string is being built (query) here
* with the operators necessary to generate a condition that matches the
* the users request. When this for...next loop is finished, the variable
* [query] will contain a string like this (depending on input):
*
* ".T.=.T. .and. KEY=MKEY .and. HRLY_RATE>15"
*
* This is assuming I entered something for MKEY and entered ">15" for
* hourly rate.
* Logical fields get kind of hairy (use T or F).
*
*
* Compile it and try it. That should make things more clear
*
*
for t = 1 to no_fields
inputvar = [M] + fieldname(t)
if ! empty(&inputvar) && (not) ! empty() means the user put something in
do case
case type( fieldname(t) ) = 'L' && logical field
valid = .T.
do case
case &inputvar = 'T'
&inputvar = .T.
case &inputvar = 'F'
&inputvar = .F.
otherwise
valid = .F.
endcase
if valid
if operator[t] = [!]
query = query + conjunction + fieldname(t) + [!=] + inputvar
else
query = query + conjunction + fieldname(t) + operator[t] + inputvar
endif
endif
case type( fieldname(t) ) = 'C' && character field
if operator[t] = [!]
query = query + conjunction + fieldname(t) + operator[t] + [=] + [trim(]+inputvar+[)]
else
query = query + conjunction + fieldname(t) + operator[t] + [trim(]+inputvar+[)]
endif
otherwise
if operator[t] = [!]
query = query + conjunction + fieldname(t) + operator[t] + [=] + inputvar
else
query = query + conjunction + fieldname(t) + operator[t] + inputvar
endif
endcase
endif
next t
clear
do while .T.
mrpt=space(8)
dir *.frm
@ 24,0 say 'Report to use ' get mrpt && crashes if report doesn't match
read
if escape()
clear
return
endif
rpt = trim( upper(mrpt) ) + '.FRM'
if rpt=[.FRM]
exit
endif
if ! file(rpt)
@ 24,50 say 'File does not exist'
?? chr(7)
loop
else
exit
endif
enddo
@ 24,0
sp=[ ]
@ 24,0 say 'Send to screen or printer (s/p)? ' get sp valid sp$'Ss' .or. sp$'Pp'
read
if escape()
clear
return
endif
if sp$'Pp'
@ 24,0
comp=[ ]
@ 24,0 say 'Compressed print (y/n)? ' get comp valid comp$'Yy' .or. comp$'Nn'
read
if escape()
clear
return
endif
if comp$'Yy'
set prin on
?? compress && setup string to compress print (see top of program)
set print off
endif
endif
go top
clear
if rpt=[.FRM] && if no report name is specified, just display the
field1=fieldname(1) && first three fields of the database.
field2=fieldname(2)
field3=fieldname(3)
IF sp$'Pp'
set print on
endif
list &field1,&field2,&field3 for &query
else
if sp$'Ss'
repo form &rpt for &query
else
repo form &rpt for &query to prin noej
endif
endif
return
function escape
para null
last_key=lastkey()
if last_key=27
return(.T.)
endif
return(.F.)
proc MASK
*
* This routine is used in place of a FMT file.
*
* All that I'm doing is throwing the database structure
* up on the screen (using 'M' + fieldname variables) one screen at
* a time (row() < 23). The name of the field becomes
* the description.
*
* Could very easily be replaced by a conventional FMT file, etc.
*
t=1
do while .T.
clear
row=0
col=0
do while t <= no_fields .and. row() < 23
col=0
@ row,col say ltrim(str(t))
col=col+4
inputvar = [M] + fieldname(t)
@ row,col say fieldname(t)
col = col + 14
@ row,col get operator[t] && valid at(operator[t],valid_operators) > 0
col = col + 4 && doesn't work yet (validates operator)
@ row,col get &inputvar
row = row + 1
t = t + 1
enddo
@ 6,50 say 'codes: = equal to' && user instructions
@ 7,50 say ' > greater then'
@ 8,50 say ' < less then'
@ 9,50 say ' ! not equal to'
@ 11,50 say 'PgDn to continue'
@ 12,50 say '[Esc] to cancel'
read
if escape()
return
endif
if t >= no_fields
exit
endif
enddo
return
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/