Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : SUB_SET.ZIP
Filename : SUB_SET.PRG

 
Output of file : SUB_SET.PRG contained in archive : SUB_SET.ZIP
*:*********************************************************************
*:
*: Program: SUB_SET.PRG
*:
*: Author: David McConnell
*: Last modified: 01/02/90 9:08
*:
*: Procs & Fncts: SUBNTX2()
*: : SUBFUN()
*: : FUNREM()
*:
*: Uses: (F_NAME).DBF
*:
*: Indexes: (N_NAME).NTX
*: : (T_NAME).NTX
*:
*: Syntax: SUB_SET(,,,
*: ,)
*:
*: Example:
*: SUB_SET("keyvals","keyvals","temp","name = [Alt]",300)
*: dbedit()
*:
*: Description: Create a subset index file called "temp.ntx"
*: which contains all values for the condition,
*: "name = [Alt]", that was passed. Then while
*: the datafile is open with the new ntx file you
*: may call dbedit or other code after the function
*: call.
*:
*: Hints: Add a wait message while function is creating index.
*:
*: Acknowledgements: Michael A. Cohen
*: Found subset.zip on kwibble and with minor
*: modifications changed the original "subset.prg"
*: to "sub_set" to allow for a callable procedure.
*: Original thought and code belong to Michael A. Cohen.
*:
*: Documented 01/02/90 at 07:36 SNAP! version 3.12f
*:*********************************************************************

* ððððððððððððððððððððððððððððððð VARIABLES ðððððððððððððððððððððððððððððððð
* existing database name
* existing index file name
* temporary index file name
* filter expression
* value to begin the seek with -
* must be same type as key
* was index creation successful
* existing index file name
* temporary index file name
* value to begin the seek with -
* must be same type as key
* index key expression
* used to check for first time through loop
* was function removal successful
* record pointer to maintain position in the file
* index key expression
* temporary index file name
* index key expression
* file handle number
* position in the open file
* lenght of key expression plus SUBFUN("")
* index key plus ten nulls
* ðððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððð


PARAMETER f_name,n_name,t_name,c_name,beg_seek
USE (f_name)
SET INDEX TO (n_name)
GO TOP
retval=SUBNTX2(n_name,t_name,beg_seek)
IF retval
USE (f_name)
SET INDEX TO (t_name)
SET FILTER TO &c_name
GO TOP
ELSE
* Display an error message.... && ? "Error occured when indexing."
ENDIF
RETURN





*!*********************************************************************
*!
*! Function: SUBNTX2()
*!
*! Called by: SUB_SET.PRG
*!
*! Calls: SUBFUN() (function in SUB_SET.PRG)
*! : FUNREM() (function in SUB_SET.PRG)
*!
*! Indexes: (INDEX1).NTX
*! : (INDEXT).NTX
*!
*!*********************************************************************
FUNCTION SUBNTX2
PARAMETER index1,indext,subset
PRIVATE key1,first,retval,prerec
SET INDEX TO (index1)
key1=INDEXKEY(0)
IF EMPTY(key1)
@ 0,0 SAY 'Error'
RETURN(.F.)
ENDIF
SET INDEX TO
prerec=0
first=.T
GO TOP
INDEX ON SUBFUN("&key1.") TO (indext)
SET INDEX TO
retval=FUNREM(indext,key1)
RETURN(retval)





*!*********************************************************************
*!
*! Function: SUBFUN()
*!
*! Called by: SUBNTX2() (function in SUB_SET.PRG)
*!
*! Indexes: (INDEX1).NTX
*!
*!*********************************************************************
FUNCTION SUBFUN
PARAMETER tkey1

IF .not. EOF() .and. !first
IF first
SET INDEX TO (index1)
SEEK subset
first=.F.
prerec=RECNO()
ELSE
GO prerec
SKIP
prerec=RECNO()
ENDIF
IF !(&c_name)
SET INDEX TO
GO BOTTOM
ENDIF
ENDIF
RETURN (&tkey1)





*!*********************************************************************
*!
*! Function: FUNREM()
*!
*! Called by: SUBNTX2() (function in SUB_SET.PRG)
*!
*!*********************************************************************
FUNCTION FUNREM
PARAMETER ntxname,ntxkey
PRIVATE handle,newpos,tlen,newkey,ntxname,ntxkey,retval
retval=.T.
ntxname=TRIM(ntxname)+".NTX"
handle=FOPEN(ntxname,2)
IF FERROR() # 0
retval=.F.
ENDIF
IF retval
newpos=FSEEK(handle,22,0)
tlen=LEN(ntxkey)+10
newkey=ntxkey+REPLICATE(CHR(0),10)
IF newpos = 22
FWRITE(handle,newkey,tlen)
ENDIF
FCLOSE(handle)
ENDIF
RETURN(retval)


  3 Responses to “Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : SUB_SET.ZIP
Filename : SUB_SET.PRG

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. 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/