Here are some custom dBase 5 functions that emulate FoxPro and Visual FoxPro (VFP) functions such as BETWEEN(), ALLTRIM(), STRTRAN(), OCCURS(), PADL(), PADR(). They may also work in other versions, but verify them first.
Note: Some issues arose which made full exact emulation impossible. I have noted them here so you understand the limitations. For example, dBase memory variable strings are limited to 254 characters, at least up to version 5, but Foxpro allows at least 1000 characters. For that reason, all strings or string manipulations are still limited to 254 characters.
Important notes:
If any of your tables have field names identical to the variables in these routines, the results will be unpredictable since dBase gives field data priority over variable data. There are 2 ways to resolve this. Either add "M->" before all memory variables here or rename any conflicting variable or parameter names.
These routines expect that the default dBase environment is SET EXACT ON where string comparisons expect exact matches while ignoring trailing spaces. If SET EXACT OFF is in effect when these are called, the routines may fail to work as expected. If you do not know the EXACT setting before calling these functions then insert this code into each function:
CODE
PRIVATE c_exact c_exact=SET("EXACT") SET EXACT ON * routine here * SET EXACT &c_exact
Of lesser importance, the only reason PROPER() is not identical to VFP's function is that I added a few enhancements to make it more flexible, such as treating hyphens the same as spaces, ignoring certain small connective words, etc.
CODE
******** FUNCTION BETWEEN PARAMETERS xVal, x_Lo, x_Hi RETURN IIF(xVal>=x_Lo .AND. xVal<=x_Hi,.T.,.F.)
******** FUNCTION ALLTRIM PARAMETERS cVal RETURN LTRIM(RTRIM(cVal))
******** FUNCTION STRTRAN PARAMETERS PSTRNG, PFIND, PREPL, PBEG, PCNT * FIRST 2 PARMS ARE REQUIRED - CHARACTER TYPE * NOTE: DBASE HAS A 254 CHARACTER STRING/FIELD SIZE LIMIT UNLIKE FOXPRO PRIVATE CSTRNG, CFIND, CREPL, NBEG, NCNT CSTRNG=PSTRNG CFIND=PFIND CREPL=IIF(TYPE("PREPL")="C",PREPL,"") && DEFAULT IS EMPTY STRING NBEG=IIF(TYPE("PBEG")="N",PBEG,1) && DEFAULT IS FIRST OCCURRENCE NCNT=IIF(TYPE("PCNT")="N",PCNT,254) && DEFAULT IS ALL OCCURRENCES NSPOT=1 NSKIP=1 NREPL=0 DO WHILE LEN(CSTRNG)>=NSPOT .AND. NREPL < NCNT ; .AND. CFIND $ SUBSTR(CSTRNG,NSPOT) NSPOT=NSPOT+AT(CFIND,SUBSTR(CSTRNG,NSPOT))-1 IF NSKIP<NBEG NSPOT=NSPOT+LEN(CFIND) NSKIP=NSKIP+1 ELSE CSTRNG=STUFF(CSTRNG,NSPOT,LEN(CFIND),CREPL) NSPOT=NSPOT+LEN(CREPL) NREPL=NREPL+1 ENDIF ENDDO RETURN CSTRNG
******** FUNCTION occurs PARAMETERS p_find, p_strng PRIVATE x, c_strng, n_occurs * Determine the number of times a string appears inside another string * This is case-sensitive matching but dBase string is limited to 254 chars n_occurs=0 c_strng=p_strng DO WHILE .T. x=AT(p_find,c_strng) IF x>0 n_occurs=n_occurs+1 c_strng=SUBSTR(c_strng,x+LEN(p_find)) ELSE EXIT ENDIF ENDDO RETURN n_occurs
* FoxPro for numeric input respects SET("DECIMALS") for fractions [23/7] * but if typed as decimal, it uses what is typed in [can't duplicate here] * If whole number then no decimals are shown, otherwise use SET("DECIMALS"). * Also, for both PADL/PADR it always sizes to left first [ PADL(345,2)="34" ] * FoxPro requires 2 parms. Here we don't generate error and default to * "?" if no parms and exact value's size if only one parm.
******** FUNCTION PADL PARAMETERS XV, XL, XR PRIVATE C_TALK, CT, CV, NL, CR IF SET("TALK")="ON" SET TALK OFF C_TALK="ON" ELSE C_TALK="OFF" ENDIF CT=TYPE("XV") IF CT="N" CV=LTRIM(IIF(XV=VAL(STR(XV)),STR(XV),STR(XV,20,SET("DECI")))) ELSE CV=IIF(CT="C",XV,IIF(CT="D",DTOC(XV),"?")) ENDIF NL=IIF(TYPE("XL")="N",MIN(XL,254),LEN(CV)) && DEFAULT VAR LEN CR=IIF(TYPE("XR")="C",LEFT(XR,1)," ") && DEFAULT SPACE IF C_TALK="ON" SET TALK ON ENDIF RETURN RIGHT(REPLICATE(CR,MAX(NL-LEN(CV),0))+LEFT(CV,NL),NL)
******** FUNCTION PADR PARAMETERS XV, XL, XR PRIVATE C_TALK, CT, CV, NL, CR IF SET("TALK")="ON" SET TALK OFF C_TALK="ON" ELSE C_TALK="OFF" ENDIF CT=TYPE("XV") IF CT="N" CV=LTRIM(IIF(XV=VAL(STR(XV)),STR(XV),STR(XV,20,SET("DECI")))) ELSE CV=IIF(CT="C",XV,IIF(CT="D",DTOC(XV),"?")) ENDIF NL=IIF(TYPE("XL")="N",MIN(XL,254),LEN(CV)) && DEFAULT VAR LEN CR=IIF(TYPE("XR")="C",LEFT(XR,1)," ") && DEFAULT SPACE IF C_TALK="ON" SET TALK ON ENDIF RETURN LEFT(LEFT(CV,NL)+REPLICATE(CR,MAX(NL-LEN(CV),0)),NL)
******** FUNCTION PROPER PARAMETERS P_TEXT PRIVATE X, C_TEXT * CONVERT ALPHA STRING INTO PROPER NAMES * DIFFERENCES FROM VFP'S PROPER(): * EXCLUDES SOME SMALL WORDS GENERALLY NOT CAPITALIZED * HANDLES MC BUT NOT MAC * EXPECTS DELIMITERS TO BE EITHER SPACE OR HYPHEN C_TEXT=P_TEXT IF LEN(RTRIM(C_TEXT)) > 1 C_TEXT=LOWER(C_TEXT) FOR X = 0 TO LEN(C_TEXT)-1 * NOTE: ISALPHA() ONLY CHECKS ONE CHARACTER DO CASE CASE X=0 IF ISALPHA(SUBSTR(C_TEXT,X+1,1)) && BEGINNING C_TEXT = STUFF(C_TEXT,X+1,1,UPPER(SUBSTR(C_TEXT,X+1,1))) ENDIF CASE .NOT. SUBSTR(C_TEXT,X,1) $ " -" IF (X > 1 .AND. SUBSTR(C_TEXT,X-1,2) == "Mc") .OR. ; (X > 0 .AND. SUBSTR(C_TEXT,X,1) $ "([{}])") C_TEXT = STUFF(C_TEXT,X+1,1,UPPER(SUBSTR(C_TEXT,X+1,1))) ENDIF CASE ISALPHA(SUBSTR(C_TEXT,X+1,1)) IF .NOT. (SUBSTR(C_TEXT+" " ,X,3) $ " a " .OR. ; SUBSTR(C_TEXT+" " ,X,4) $ " in is of or " .OR. ; SUBSTR(C_TEXT+" ",X,5) $ " and the " ) * OTHER POSSIBLES: at from to for by C_TEXT = STUFF(C_TEXT,X+1,1,UPPER(SUBSTR(C_TEXT,X+1,1))) ENDIF ENDCASE NEXT ENDIF RETURN C_TEXT && THIS IS RETURNED BY FUNCTION
* The following 5 JUST...() routines assume a valid file structure * Testing is only done for appropiate string length and not empty string
******** FUNCTION JUSTDRIVE && X: PARAMETER in_dpse RETURN IIF(LEN(in_dpse)>1.AND.SUBSTR(in_dpse,2,1)=":",LEFT(in_dpse,2),"")
******** FUNCTION JUSTPATH && DRIVE:\FULL\PATH (INCLUDE X:\ BUT NOT "\" AFTER PATH) PARAMETER in_dpse && BLANK IF NO "\" IN STRING RETURN IIF("\"$in_dpse,SUBSTR(in_dpse,1, ; MAX(MAX(AT(":",in_dpse),RAT("\",in_dpse)-1), ; IIF(LEN(in_dpse)>2.AND.SUBSTR(in_dpse,2,2)=":\",3,0))),"")
******** FUNCTION JUSTFNAME && FILE.NAME.EXT (CALLS JUSTPATH()) PARAMETER in_dpse PRIVATE c_talk, n_lenpath IF SET("TALK")="ON" SET TALK OFF c_talk="ON" ELSE c_talk="OFF" ENDIF * JUSTPATH() IS EMPTY DRIVE SPECIFIED BUT NOT PATH SO TEST FOR ":" n_lenpath=MAX(LEN(JUSTPATH(in_dpse)),IIF(":"$in_dpse,2,0)) IF c_talk="ON" SET TALK ON ENDIF RETURN IIF(LEN(in_dpse)>n_lenpath,STRTRAN(SUBSTR(in_dpse,n_lenpath+1),"\"),"")
******** FUNCTION JUSTSTEM && FILE.NAME WITHOUT .EXT (CALLS JUSTFNAME(),JUSTPATH()) PARAMETER in_dpse PRIVATE c_talk, cfname IF SET("TALK")="ON" SET TALK OFF c_talk="ON" ELSE c_talk="OFF" ENDIF cfname=JUSTFNAME(in_dpse) IF c_talk="ON" SET TALK ON ENDIF RETURN IIF("."$cfname,SUBSTR(cfname,1,RAT(".",cfname)-1),cfname)
Talk To Other Members