home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
workdb.zip
/
SEARCH1.PRG
< prev
next >
Wrap
Text File
|
1988-08-15
|
19KB
|
525 lines
*!!* dBASE CONVERT - dBASE III File Conversion Aid v2.01 1/10/86
*
SET HEADING OFF
SET SAFETY OFF
NOTE - SEARCH1.SIG - COMPREHENSIVE ORDERS SEARCH COMMAND FILE
NOTE -
NOTE - THIS COMMAND FILE WAS CREATED USING - fastBASE (TM) (VERSION 1.3)
NOTE - "THE dBASE II COMMAND FILE GENERATOR" DEVELOPED BY:
NOTE - FOURCOLOR DATA SYSTEMS INC.
NOTE - 7011 MALABAR STREET
NOTE - DAYTON, OHIO 45459
NOTE - PHONE: (513) 433-3780
NOTE -
NOTE - SEARCH BY INDEX - OPERATOR CAN SEARCH DATABASE IN ORDER
NOTE - OF ANY INDEX FILE.
NOTE -
NOTE - INDEX FILES - INDICES ARE OF THE FOLLOWING FORM:
NOTE - A. CHARACTER FIELDS ARE MADE UPPERCASE.
NOTE - (THIS WILL ALLOW THE FIND COMMAND TO
NOTE - IGNORE UPPER AND LOWER CASE
NOTE - DISTINCTIONS.)
NOTE - B. ALL NUMERIC FIELDS ARE CONVERTED TO
NOTE - CHARACTER STRINGS.
NOTE - C. EXAMPLE:
NOTE - IF AN INDEX CONSISTS OF A NUMERIC
NOTE - FIELD - FIELDNUM (N,8,2) AND A
NOTE - CHARACTER FIELD - FIELDCHAR, THEN
NOTE - FASTBASE WILL DEFINE THE INDEX AS
NOTE - STR(FIELDNUM,8,2) + !(FIELDCHAR).
NOTE -
NOTE - SEARCH BY PART OF FIELD - OPERATOR CAN SELECT ANY CHARACTER
NOTE - FIELD IN THE DATABASE. THEN OPERATOR
NOTE - CAN ENTER ANY POSSIBLE SUB-STRING.
NOTE - SEARCH WILL THEN DISPLAY EVERY
NOTE - RECORD WITH THIS SUB-STRING IN ANY
NOTE - PART OF THE SELECTED FIELD.
NOTE -
NOTE - IF ANY RECORD IS SELECTED BY OPERATOR, THEN THIS SEARCH ROUTINE
NOTE - WILL RETURN TO THE CALLING COMMAND FILE THE DBASE II RECORD
NOTE - NUMBER IN THE MEMORY VARIABLE 'RECNO' OTHERWISE 'RECNO'
NOTE - WILL HAVE THE VALUE ZERO.
NOTE -
NOTE - WHEN CALLING THIS SEARCH ROUTINE, A MEMORY VARIABLE WITH THE
NOTE - NAME 'DR' MUST EXIST. FURTHER THIS MEMORY VARIABLE MUST EITHER
NOTE - HAVE THE VALUE ' ' OR 'X:' WHERE X IS ANY ALPHABETIC
NOTE - CHARACTER CORRESPONDING TO A VALID DISK DRIVE (EG. A:).
NOTE -
STORE 'DETAILED SEARCH' TO MODE
STORE CHR(PEEK(063))TO dr
CLEAR
@ 1,20 SAY '*** SEARCH FOR ORDERS ***'
@ 3,20 SAY 'SEARCH METHOD:'
@ 5,25 SAY '1. SEARCH BY INDEX'
@ 6,25 SAY '2. SEARCH PART OF FIELD'
STORE ' ' TO EMETH
DO WHILE EMETH <> '1' .AND. EMETH <> '2'
@ 8,25 SAY ' METHOD? (1,2) ' GET EMETH
READ
ENDDO
IF EMETH = '1'
STORE ' ' TO KEYVAR1
@ 10,20 SAY 'ENTER LASTNAME ' GET KEYVAR1
READ
STORE KEYVAR1 TO FINDSTRING
RELEASE KEYVAR1
USE &DR.:SIG/M.DBF INDEX &DR.:ORDERS.NDX
NOTE -
NOTE - DETERMINE RECORD NUMBER OF FIRST AND LAST RECORD IN DATABASE
NOTE -
IF RECNO() > 0
STORE RECNO() TO FIRSTREC
GOTO BOTTOM
STORE RECNO() TO LASTREC
NOTE -
NOTE - TRIM RIGHT HAND SPACES AND ZEROES FROM FINDSTRING
NOTE - ALSO SET FINDSTRING TO UPPER CASE
NOTE -
STORE TRIM(UPPER(FINDSTRING)) TO FINDSTRING
STORE .T. TO SHRINK
DO WHILE SHRINK
STORE .F. TO SHRINK
STORE .T. TO TRIMZERO
DO WHILE TRIMZERO .AND. LEN(FINDSTRING) > 1
STORE SUBSTR(FINDSTRING,LEN(FINDSTRING),1) TO LASTCHAR
IF LASTCHAR = '0' .OR. LASTCHAR = ' '
STORE SUBSTR(FINDSTRING,1,LEN(FINDSTRING)-1) TO FINDSTRING
LOOP
ENDIF
STORE .F. TO TRIMZERO
ENDDO
*!! EOF() will be true if NO FIND, and RECNO() will equal BOTTOM, not 0.
FIND '&FINDSTRING'
IF .NOT. (EOF() .OR. BOF())
STORE RECNO() TO FINDRECNO
LOOP
ENDIF
STORE FINDSTRING + ' ' TO FINDSTRING
NOTE -
NOTE - USE FIRST 3 CHARACTERS OF FINDSTRING FOR 'FIND' COMMAND
NOTE -
STORE SUBSTR(FINDSTRING,1,3) TO FINDSTRING
*!! EOF() will be true if NO FIND, and RECNO() will equal BOTTOM, not 0.
FIND '&FINDSTRING'
IF .NOT. (EOF() .OR. BOF())
STORE RECNO() TO FINDRECNO
LOOP
ENDIF
STORE FINDSTRING + ' ' TO FINDSTRING
STORE SUBSTR(FINDSTRING,1,1) TO FINDSTRING
*!! EOF() will be true if NO FIND, and RECNO() will equal BOTTOM, not 0.
FIND '&FINDSTRING'
IF .NOT. (EOF() .OR. BOF())
STORE RECNO() TO FINDRECNO
LOOP
ENDIF
GOTO TOP
STORE RECNO() TO FINDRECNO
ENDDO
STORE FINDRECNO TO STARTREC
RELEASE FINDRECNO, FINDSTRING, SHRINK, LASTCHAR, TRIMZERO
STORE .T. TO FILESRCH
STORE 'F' TO EOPTION
DO WHILE FILESRCH
NOTE -
NOTE - IF DATABASE HAS AT LEAST 10 RECORDS THEN SEARCH CAN OPERATE
NOTE - IN 'FAST' MODE. IN THIS MODE, 10 RECORDS AT A TIME ARE
NOTE - DISPLAYED ON THE CRT.
NOTE -
IF EOPTION = 'F'
STORE 'FAST' TO SRCHMODE
GOTO TOP
SKIP 9
IF RECNO() = LASTREC
STORE 'D' TO EOPTION
ENDIF
GOTO STARTREC
ENDIF
IF EOPTION = 'D'
STORE 'DETAIL' TO SRCHMODE
ENDIF
IF EOPTION = 'R'
STORE 0 TO RECNO
*!! Logical constant converted.
STORE .F. TO FILESRCH
LOOP
ENDIF
IF SRCHMODE = 'FAST'
STORE ' ' TO EOPTION
STORE .T. TO FASTSRCH
DO WHILE FASTSRCH
CLEAR
STORE 1 TO SEARCHLINE
STORE RECNO() TO RECNO
STORE .T. TO CHECKPOS1
DO WHILE CHECKPOS1
IF RECNO = LASTREC
STORE 10 TO SEARCHLINE
SKIP - 9
STORE .F. TO CHECKPOS1
LOOP
ENDIF
SKIP 8
IF RECNO() <> LASTREC
SKIP - 8
STORE .F. TO CHECKPOS1
LOOP
ENDIF
IF RECNO() = LASTREC
DO WHILE RECNO <> RECNO()
SKIP - 1
ENDDO
STORE 10 TO SEARCHLINE
STORE .T. TO CHECKPOS2
DO WHILE CHECKPOS2
STORE SEARCHLINE - 1 TO SEARCHLINE
SKIP 1
IF RECNO() = LASTREC
STORE .F. TO CHECKPOS2
LOOP
ENDIF
IF SEARCHLINE < 0
STORE .F. TO CHECKPOS2
LOOP
ENDIF
ENDDO
SKIP - 9
STORE .F. TO CHECKPOS1
ENDIF
ENDDO
STORE RECNO() TO STARTREC
NOTE -
NOTE - USE THE SEARCH AND LIST REPORT CREATED BY FASTBASE, TO DISPLAY
NOTE - 10 RECORDS ON THE CRT AT ONE TIME.
NOTE -
REPORT NEXT 10 FORM &DR.:SIG/M.FRM PLAIN
@ 23,0 SAY 'N (NEXT), P (PREVIOUS), J (JUMP), D (DISPLAY), R (RETURN).'
GOTO STARTREC
IF EOPTION = 'P'
STORE 10 TO SEARCHLINE
SKIP 9
DO WHILE RECNO() <> PREVREC .AND. SEARCHLINE > 1
STORE SEARCHLINE - 1 TO SEARCHLINE
SKIP - 1
ENDDO
ENDIF
IF EOPTION <> 'P'
IF SEARCHLINE <> 1
STORE SEARCHLINE - 1 TO SEARCHLINE
SKIP SEARCHLINE
STORE SEARCHLINE + 1 TO SEARCHLINE
ENDIF
ENDIF
SET DELIMITER OFF
DO WHILE SEARCHLINE > 0 .AND. SEARCHLINE < 11
STORE ' ' TO EOPTION
DO WHILE EOPTION <> 'N' .AND. EOPTION <> 'P' .AND. EOPTION <> 'J' .AND. EOPT
@ (2 * SEARCHLINE) + 1, 0 GET EOPTION
READ
STORE UPPER(EOPTION) TO EOPTION
IF EOPTION = 'N' .AND. RECNO() = LASTREC
STORE ' ' TO EOPTION
ENDIF
IF EOPTION = 'P' .AND. RECNO() = FIRSTREC
STORE ' ' TO EOPTION
ENDIF
ENDDO
@ (2 * SEARCHLINE) + 1, 0 SAY ' '
IF EOPTION = 'N'
STORE SEARCHLINE + 1 TO SEARCHLINE
SKIP 1
LOOP
ENDIF
IF EOPTION = 'P'
STORE SEARCHLINE - 1 TO SEARCHLINE
SKIP - 1
STORE RECNO() TO PREVREC
LOOP
ENDIF
STORE 0 TO SEARCHLINE
ENDDO
IF EOPTION = 'P'
SKIP - 9
ENDIF
IF EOPTION = 'J'
SET DELIMITER ON
STORE 0 TO INCREMENT
@ 23,0 SAY ' ENTER JUMP INCREMENT (+ OR -)
@ 23,45 GET INCREMENT
READ
SET DELIMITER OFF
IF INCREMENT > 0
SKIP INCREMENT
ENDIF
IF INCREMENT < 0
STORE 0 - INCREMENT TO INCREMENT
SKIP - INCREMENT
ENDIF
ENDIF
IF EOPTION = 'D' .OR. EOPTION = 'R'
STORE .F. TO FASTSRCH
ENDIF
ENDDO
RELEASE FASTSRCH, SEARCHLINE, PREVREC, CHECKPOS1, CHECKPOS2
SET DELIMITER ON
ENDIF
IF SRCHMODE = 'DETAIL'
STORE .T. TO DETLSRCH
DO WHILE DETLSRCH
CLEAR
@ 1,25 SAY MODE
@ 2,0 SAY '+---------------------------------------'
@ 2,39 SAY '--------------------------------------+'
@ 4,5 SAY 'ORDER NUMBER COMPLETE'
@ 5,8 SAY 'LAST NAME FIRST'
@ 6,10 SAY 'ADDRESS'
@ 7,9 SAY '(line 2)'
@ 8,9 SAY '(line 3)'
@ 9,13 SAY 'CITY STATE ZIP'
@ 11,2 SAY 'VOLUMES'
@ 13,3 SAY 'AMOUNT ENTER SHIP'
@ 14,2 SAY 'REMARKS'
@ 15,2 SAY 'REMARKS'
@ 17,0 SAY 'BACKORDER'
@ 18,44 SAY 'CATALOG'
@ 19,2 SAY 'SHIPPED SHIPPED UPDATE'
@ 20,0 SAY '+--------------------------------------'
@ 20,39 SAY '--------------------------------------+'
@ 4,18 GET ORDER
@ 5,18 GET LNAME
@ 5,52 GET FNAME
@ 6,18 GET ADDR1
@ 7,18 GET ADDR2
@ 8,18 GET ADDR3
@ 9,18 GET CITY
@ 9,52 GET STATE
@ 9,70 GET ZIP
@ 11,10 GET VOL1
@ 13,10 GET AMT
@ 13,52 GET ENTERED
@ 13,69 GET SHIPPED
@ 14,10 GET REM1
@ 15,10 GET REM2
@ 17,10 GET BO
@ 18,53 GET CATALOG
@ 19,10 GET BO_SHIP
@ 19,34 GET BO2_SHIP
@ 19,69 GET DAYU
@ 4,52 GET COMP
CLEAR GETS
@ 23,0 SAY 'N (NEXT), P (PREVIOUS), J (JUMP), F (FAST SEARCH), R (RETURN)'
STORE ' ' TO EOPTION
DO WHILE EOPTION <> 'N' .AND. EOPTION <> 'P' .AND. EOPTION <> 'J' .AND. EOPTION
@ 23,74 GET EOPTION
READ
STORE UPPER(EOPTION) TO EOPTION
IF EOPTION = 'N' .AND. RECNO() = LASTREC
STORE ' ' TO EOPTION
ENDIF
IF EOPTION = 'P' .AND. RECNO() = FIRSTREC
STORE ' ' TO EOPTION
ENDIF
ENDDO
IF EOPTION = 'N'
IF RECNO() = LASTREC
LOOP
ENDIF
SKIP 1
ENDIF
IF EOPTION = 'P'
SKIP - 1
ENDIF
IF EOPTION = 'J'
STORE 0 TO INCREMENT
@ 23,0 SAY ' ENTER JUMP INCREMENT (+ OR -)
@ 23,45 GET INCREMENT
READ
IF ((EOF() .OR. BOF())) .OR. (INCREMENT = 0)
LOOP
ENDIF
IF INCREMENT > 0
SKIP INCREMENT
ENDIF
IF INCREMENT < 0
STORE 0 - INCREMENT TO INCREMENT
SKIP - INCREMENT
ENDIF
ENDIF
IF EOPTION = 'F' .OR. EOPTION = 'R'
STORE .F. TO DETLSRCH
STORE RECNO() TO STARTREC
ENDIF
ENDDO
RELEASE DETLSRCH
ENDIF
RELEASE SRCHMODE
ENDDO
ENDIF
ENDIF
NOTE -
NOTE - SEARCH FOR SUB-STRING THAT IS PART OF A SELECTED FIELD.
NOTE -
IF EMETH = '2'
CLOSE INDEX
CLEAR
STORE 'DETAILED SEARCH' TO MODE
@ 10,20 SAY 'SELECT FIELD NUMBER '
@ 12,20 SAY 'ENTER SEARCH DATA '
@ 14,0 SAY ' 1. ORDER NO. 2. COMPLETED 3. LASTNAME 4. FIRST NAME 5.ADDRESS'
@ 15,0 SAY ' 6. ADDR-LINE2 7. ADDR-LINE3 8. CITY 9. STATE 10. ZIP'
@ 16,0 SAY '11. VOLUMES 12. ENTERED 13. SHIPPED 14. REMARKS 15. REMARKS-2'
@ 17,0 SAY '16. BACKORDER 17. SHIPPED 18. SHIPPED 19. UPDATE '
STORE ' ' TO EVAR
DO WHILE VAL(EVAR) < 1 .OR. VAL(EVAR) > 23
@ 10,20 SAY 'SELECT FIELD NUMBER ' GET EVAR PICTURE '99'
READ
ENDDO
STORE ' ' TO EPART
@ 12,20 SAY 'ENTER SEARCH DATA ' GET EPART
READ
IF VAL(EVAR) = 1
STORE 'ORDER' TO PARTFIELD
ENDIF
IF VAL(EVAR) = 2
STORE 'COMP' TO PARTFIELD
ENDIF
IF VAL(EVAR) = 3
STORE 'LNAME' TO PARTFIELD
ENDIF
IF VAL(EVAR) = 4
STORE 'FNAME' TO PARTFIELD
ENDIF
IF VAL(EVAR) = 5
STORE 'ADDR1' TO PARTFIELD
ENDIF
IF VAL(EVAR) = 6
STORE 'ADDR2' TO PARTFIELD
ENDIF
IF VAL(EVAR) = 7
STORE 'ADDR3' TO PARTFIELD
ENDIF
IF VAL(EVAR) = 8
STORE 'CITY' TO PARTFIELD
ENDIF
IF VAL(EVAR) = 9
STORE 'STATE' TO PARTFIELD
ENDIF
IF VAL(EVAR) = 10
STORE 'ZIP' TO PARTFIELD
ENDIF
IF VAL(EVAR) = 11
STORE 'VOL1' TO PARTFIELD
ENDIF
IF VAL(EVAR) = 12
STORE 'ENTERED' TO PARTFIELD
ENDIF
IF VAL(EVAR) = 13
STORE 'SHIPPED' TO PARTFIELD
ENDIF
IF VAL(EVAR) = 14
STORE 'REM1' TO PARTFIELD
ENDIF
IF VAL(EVAR) = 15
STORE 'REM2' TO PARTFIELD
ENDIF
IF VAL(EVAR) = 16
STORE 'BO' TO PARTFIELD
ENDIF
IF VAL(EVAR) = 17
STORE 'BO:SHIP' TO PARTFIELD
ENDIF
IF VAL(EVAR) = 18
STORE 'BO2:SHIP' TO PARTFIELD
ENDIF
IF VAL(EVAR) = 19
STORE 'DAYU' TO PARTFIELD
ENDIF
USE &DR.:SIG/M.DBF
STORE TRIM(EPART) TO EPART
RELEASE EVAR
GOTO BOTTOM
STORE RECNO() TO LASTREC
GOTO TOP
STORE 0 TO RECNO
STORE .T. TO PARTSRCH
STORE ' ' TO EOPTION
STORE .T. TO FIRSTLOOP
DO WHILE PARTSRCH
IF EOPTION = 'R'
STORE 0 TO RECNO
STORE .F. TO PARTSRCH
LOOP
ENDIF
IF RECNO = LASTREC
STORE 'R' TO EOPTION
LOOP
ENDIF
IF FIRSTLOOP
LOCATE FOR UPPER(EPART) $ UPPER(&PARTFIELD)
ENDIF
IF .NOT.FIRSTLOOP
CONTINUE
ENDIF
STORE .F. TO FIRSTLOOP
STORE RECNO() TO RECNO
IF RECNO() = LASTREC .AND.(.NOT. EPART $ &PARTFIELD)
STORE 'R' TO EOPTION
LOOP
ENDIF
CLEAR
@ 1,25 SAY MODE
@ 2,0 SAY '+---------------------------------------'
@ 2,39 SAY '--------------------------------------+'
@ 4,5 SAY 'ORDER NUMBER COMPLETE'
@ 5,8 SAY 'LAST NAME FIRST'
@ 6,10 SAY 'ADDRESS'
@ 7,9 SAY '(line 2)'
@ 8,9 SAY '(line 3)'
@ 9,13 SAY 'CITY STATE ZIP'
@ 11,2 SAY 'VOLUMES'
@ 13,3 SAY 'AMOUNT ENTER SHIP'
@ 14,2 SAY 'REMARKS'
@ 15,2 SAY 'REMARKS'
@ 17,0 SAY 'BACKORDER'
@ 18,44 SAY 'CATALOG'
@ 19,2 SAY 'SHIPPED SHIPPED UPDATE'
@ 20,0 SAY '+--------------------------------------'
@ 20,39 SAY '--------------------------------------+'
@ 4,18 GET ORDER
@ 5,18 GET LNAME
@ 5,52 GET FNAME
@ 6,18 GET ADDR1
@ 7,18 GET ADDR2
@ 8,18 GET ADDR3
@ 9,18 GET CITY
@ 9,52 GET STATE
@ 9,70 GET ZIP
@ 11,10 GET VOL1
@ 13,10 GET AMT
@ 13,52 GET ENTERED
@ 13,69 GET SHIPPED
@ 14,10 GET REM1
@ 15,10 GET REM2
@ 17,10 GET BO
@ 18,53 GET CATALOG
@ 19,10 GET BO_SHIP
@ 19,34 GET BO2_SHIP
@ 19,69 GET DAYU
@ 4,52 GET COMP
CLEAR GETS
STORE ' ' TO EOPTION
@ 22,12 SAY 'N (NEXT), R (RETURN)'
DO WHILE EOPTION <> 'N' .AND. EOPTION <> 'R'
@ 22,37 GET EOPTION PICTURE '!'
READ
ENDDO
ENDDO
RELEASE PARTSRCH
ENDIF
RELEASE EMETH, EOPTION, EPART, FILESRCH, LASTREC, FIRSTREC, STARTREC
RELEASE PARTFIELD, NUMREC, FIRSTLOOP, EKEYOPT, INCREMENT, MODE
SET INDEX TO &DR.:ORDERS
STORE .T. TO FIRST
RETURN