Functions and Procedures
"We can forgive a man for making a useful thing as long as he does not admire it. The only excuse for making a useless thing is that one admires it intensely." ("The Picture of Dorian Gray" by Oscar Wilde)
How many times have you inherited an application from another developer who used twenty lines of code when one or two would have been sufficient? How often have you plowed through miles of code and wondered why it wasn't broken up into separate methods to handle discrete functionality? A well-stocked library of re-usable functions reduces the number of lines of code required to accomplish a given task. In addition to reducing method code at the instance level, descriptive function and procedure names make your code more self-documenting. In this chapter we will share some of the cool functions we have discovered over the years as well as some gotchas to watch out for. All of the code in this chapter is contained in the CH02.PRG procedure file in the subdirectory of the same name.
How shall we proceed?
In prior versions of FoxPro, applications were limited to a single active procedure file at any time. This meant that all user-defined functions and commonly used procedures were kept in a single file. With Visual FoxPro, the ability to have multiple procedure files active at any given time provides much more flexibility. Such procedures can now be grouped logically, by functionality, into different procedure files that can be loaded incrementally as needed. The downside, of course, is that procedure files are loaded into memory by Visual FoxPro and held until explicitly released. This may not be the best use of that precious resource.
Fortunately, it is also possible to define procedure classes. The individual functions that would previously have been kept in a procedure file can now become methods of a class. This approach has the benefit that, when defined visually in the Class Designer, all the functions in the procedure can be neatly viewed under the methods tab of the property sheet. Procedure classes containing specific functionality can be dropped onto forms that require this functionality. A second major benefit is that a procedure class can be sub-classed - for those special situations when standard functionality must be augmented.
The approach that we like is a combination of these two approaches. We recommend using a procedure file for truly generic functions (i.e. those that are used, unchanged, by many different applications). For example, our procedure file contains a NewID function for generating surrogate primary keys, a SetPath function to set the path for the application and a few key functions that Visual FoxPro should have, but doesn't. Two examples of such functions are the Str2Exp and Exp2Str functions (used later in this chapter These functions, as the names imply, are used to convert character strings into the values of another specified data type and vice versa.
Separate Procedure Classes contain application specific functionality. For example, an accounting application might require several functions to calculate tax and invoice totals. The Accounting Procedures Class can be dropped onto any form that requires these functions - or can be instantiated as an Application Level object. Clearly, such functions are not generic, nor are they even required by the entire application. By grouping them into a single procedure class, we can make this functionality available at the specific parts of the application that require it without compromising the rest of the application.
Parameters (an aside)
We have all used parameters extensively in FoxPro but in Visual FoxPro's object oriented environment, parameters have taken on a new importance as the principle means of implementing messaging - the very lifeblood of an OO application! (We have more to say on this subject later!)
By reference, by value?
Parameters are passed either by reference or by value. When a parameter is passed to a function or procedure by reference, any changes made to its value in the called code are reflected in the original value in the calling program. Conversely when a parameter is passed by value, the called code can change that value but the value in the calling program remains unchanged.
Visual FoxPro interprets the code being called by the mechanism by which parameters are passed. So when the calling syntax looks like this:
luRetVal = CallMyFunction( param1, param2 )
Visual FoxPro treats this as a Function Call and passes the parameters by value. However if the same code is called like this:
DO CallMyFunction WITH param1, param2
then Visual FoxPro treats this as a Procedure Call and passes the parameters by reference. The old coding rule that a "Function must always return a value" is not really true in Visual FoxPro, but it does make sense when the calling syntax is considered.
You can change this default behavior in two ways. One way is to:
SET UDFPARMS TO REFERENCE or SET UDFPARMS TO VALUE
However, we do not consider this a good idea because it affects the way all functions in your entire application handle the parameters they are passed. (It is never a good idea to use a global solution to solve a local problem). In this case there is a simple solution because parameters can be passed by value explicitly just by enclosing them in parentheses. Thus:
DO CallMyFunction WITH (param1), (param2)
passes the parameters by value, even though the syntax used would normally cause them to be passed by reference. To pass parameters explicitly by reference, simply preface the parameter with the "@" symbol. (This is, by the way, the only way to pass an entire array to a procedure, function or method). So we could also make our function call and pass its parameters by reference like this:
luRetVal = CallMyFunction( @param1, @param2 )
How do I know what was passed?
There are two ways for a function to determine how many parameters were passed to it. The PARAMETERS() function returns the number of parameters that were passed to the most recently called function or procedure. This can give unexpected results since it is reset each time a function or procedure is called. Most importantly, it is also reset by functions that are not called explicitly, such as ON KEY LABEL routines.
A better way of determining how many parameters were passed to a function is to use the PCOUNT() function. This always returns the number of parameters that were passed to the currently executing code. Save yourself a lot of grief and unnecessary hair pulling by always using PCOUNT() for determining the number of parameters passed.
How should I position my parameters?
The best advice is that if a function takes optional parameters, you should place these at the end of the parameter list. PCOUNT() can then be used in the function to determine whether or not the optional parameters were passed allowing the function to take the appropriate action.
You can take advantage of the fact that Visual FoxPro always initializes parameters as logical false. By setting up your function to expect a logical false as its default, you can invoke the function without passing it any parameters. Then, in those cases where you want an alternative behavior, just invoke the function by passing it a logical true.
How can I return multiple values from a function?
Of course, returning values is simply the reverse of passing parameters - with one gotcha!. While you can easily pass multiple parameters to a function, there is no obvious mechanism for returning multiple values! The RETURN command only allows a single value to be passed back to the calling program.
One solution is to pass multiple values as a comma-delimited string. This is a little messy, however, as you will need to convert your values into character format to build the return string and then parse out the individual values again in the receiving code.
Another possibility is to define all the values you want populated by the function as Private variables in the calling program. As such, they will be available to any function or procedure that is called subsequently and they can be populated directly. However, this is neither specific nor easy to maintain and is not really a good solution.
A better possibility is to create an array in the calling code for the return values and then pass that array by reference. The called function can then simply populate the array and the values will also be available in the calling program. This is workable, at the very least, and was probably the most common method of handling the issue prior to the introduction of Visual FoxPro.
Once again Visual FoxPro has made life a lot easier. Returning multiple values from a UDF is easy if you create, and use, a parameter class. Ours is based on the Line baseclass and is named xParameters. You can find it in the CH02.VCX class library. All it needs is one custom array property, aParameters, to hold the return values and this line of code in its INIT():
LPARAMETERS taArray
ACOPY(taArray, This.aParameters)
The user-defined function can then simply populate its own local array with the values it needs to return and create the parameter object on the fly - and populate the object's array property with a single line of code:
RETURN CREATOBJECT( 'xParameters', @laArray )
What about using named parameters?
The parameter object discussed above passes parameters by position, in much the same way as Visual FoxPro. Although Visual FoxPro does not actually support the concept of named parameters, you can, in Version 6.0, use the AddProperty() method to add named parameters to your object by creating a property for each parameter or value that you want to transfer
Even when using this approach, there is no need to create a special class for the parameter object. It can be created on the fly using a lightweight baseclass such as Line or Separator as the following code snippet shows:
LOCAL oParam
oParam = CREATEOBJECT( 'line' )
WITH oParam
.AddProperty( "Name", "Christine Johannson" )
.AddProperty( "Age", 34 )
.AddProperty( "Sex", "Female" )
ENDWITH
RETURN oParam
To retrieve values in this fashion your calling code would simply assign the return value of the called function to an object reference and read off its properties locally:
LOCAL oRetVal
oRetVal = CallMyFunction()
lcName = oRetVal.Name
lnAge = oRetVal.Age
lcSex = oRetVal.Sex
Of all the possibilities discussed so far, we like this the best!
Passing parameters optionally
There is an important side benefit to the ability to use named parameters. This becomes especially important when a function accepts a large number of parameters, many of which are optional. For example, a function to set fonts might have many parameters (name, size, bold, italic, underline, strikethrough and so on). A simple check for:
PEMSTATUS( toParameterObject, 'FontName', 5 )
determines unambiguously whether or not a specific parameter was passed. This approach removes the tedious task of counting commas in the calling program (as well as the necessity to remember the specific order in which parameters are expected by the called function). The elapsed time function below shows how an object employing named parameters can be used to return multiple values.
Date and time functions
Visual FoxPro has several handy dandy, built in functions for manipulating dates. The functions below illustrate how they can be used to perform a few of the most common tasks required when dealing with dates in your applications.
Elapsed time
Simply subtracting one DateTime expression from another gives you the elapsed time - this is good. Unfortunately Visual FoxPro gives you this result as the number of seconds between the two - this is bad. This value is seldom directly useful! You can use this little set of functions, which rely on the Modulus operator (%), to calculate the components of elapsed time in days, hours, minutes and seconds.
FUNCTION GetDays( tnElapsedSeconds )
RETURN INT(tnElapsedSeconds / 86400)
FUNCTION GetHours( tnElapsedSeconds )
RETURN INT(( tnElapsedSeconds % 86400 ) / 3600 )
FUNCTION GetMinutes( tnElapsedSeconds )
RETURN INT(( tnElapsedSeconds % 3600 ) / 60 )
FUNCTION GetSeconds( tnElapsedSeconds )
RETURN INT( tnElapsedSeconds % 60 )
Of course, there is more than one way to skin the fox. You can also use a single function to return an array containing the elapsed time positionally, with days as its first element through to seconds as its fourth like so:
FUNCTION GetElapsedTime( tnElapsedSeconds )
LOCAL laTime[4]
laTime[1] = INT( tnElapsedSeconds / 86400 )
laTime[2] = INT(( tnElapsedSeconds % 86400 ) / 3600 )
laTime[3] = INT(( tnElapsedSeconds % 3600 ) / 60 )
laTime[4] = INT( tnElapsedSeconds % 60 )
RETURN CREATEOBJECT( 'xParameters', @laTime )
If you prefer named parameters to the positional variety, the following code accomplishes the task:
FUNCTION GetElapsedTime( tnElapsedSeconds )
LOCAL loObject
loObject = CREATEOBJECT( 'Line' )
WITH loObject
.AddProperty( 'nDays', INT( tnElapsedSeconds / 86400 ) )
.AddProperty( 'nHours', INT(( tnElapsedSeconds % 86400 ) / 3600 ) )
.AddProperty( 'nMins', INT(( tnElapsedSeconds % 3600 ) / 60 ) )
.AddProperty( 'nSecs', INT( tnElapsedSeconds % 60 ) )
ENDWITH
RETURN loObject
Alternatively, if you merely require a string that contains the elapsed time in words, you can just reduce it to a single line of code!
FUNCTION GetElapsedTime( tnElapsedSeconds )
RETURN PADL( INT( tnElapsedSeconds / 86400 ), 3 )+' Days ';
+ PADL( INT(( tnElapsedSeconds % 86400 ) / 3600 ), 2, '0' )+' Hrs ' ;
+ PADL( INT(( tnElapsedSeconds % 3600 ) / 60 ), 2, '0')+' Min ' ;
+ PADL( INT( tnElapsedSeconds % 60 ), 2, '0' )+' Sec '
Date in words
Converting a value from date format into text can be a tricky business, especially when you are writing international applications. Visual FoxPro makes this task a lot easier with its native MDY(), CMONTH(), CDOW(), MONTH(), DAY() and YEAR() functions, to name but a few. Version 6.0, with its ability to use strict dates, makes this task even easier. The following function provides one example of how to use these functions.
FUNCTION DateInWords( tdDate )
RETURN CDOW( tdDate ) + ', ' + MDY( tdDate )
However, the function listed above will not attach the ordinal suffix to the day portion of the date. If your application requires these suffixes when formatting the date in words, use the longer form of the function listed below. You could even extract the portion that calculates the suffix and place it in a function called MakeOrdinal. It can then be invoked any time you need to format a given number n as nth.
FUNCTION DateInWords( tdDate )
LOCAL lnDay, lnNdx, lcSuffix[31]
*** Initialize suffix for day
lnDay = DAY( tdDate )
lnNdx = lnDay % 10
IF NOT BETWEEN( lnNdx, 1, 3 )
lcSuffix = 'th'
ELSE
IF INT( lnDay / 10 ) = 1
lcSuffix = 'th'
ELSE
lcSuffix = SUBSTR( 'stndrd', ( 2 * lnNdx ) - 1, 2 )
ENDIF
ENDIF
RETURN CDOW( tdDate ) + ', ' + CMONTH( tdDate ) + ;
' ' + ALLTRIM( STR( lnDay )) + lcSuffix + ;
', ' + ALLTRIM( STR( YEAR( tdDate )))
Calculating Age
Calculating age is even trickier than calculating elapsed time. This is because months do not contain the same number of days and every fourth year is a leap year. The function below calculates age on a given date and returns the value as a formatted string containing the number of years and months. It can easily be modified to return the values in a parameters object like the ElapsedTime() function listed above.
FUNCTION CalcAge( tdDob, tdBaseDate )
*** Default Base Date to Today if empty
IF TYPE( "tdBaseDate" ) # "D" OR EMPTY(tdBaseDate)
tdBaseDate = DATE()
ENDIF
LOCAL lnYrs, lnMth, lcRetVal, lnBaseYear, lnBaseMnth
lnYrs = YEAR( tdBaseDate ) - YEAR( tdDob )
*** Calculate this year's Birthday
ldCurBdy = CTOD('^' + STR( YEAR( tdBaseDate )) + '-' + ;
PADL( MONTH( tdDob ), 2, '0' ) + '-' + ;
PADL( DAY( tdDob ), 2, '0'))
*** Calculate Age
IF ldCurBdy > tdBaseDate
lnYrs = lnYrs - 1
lnMth = 12 - (MONTH( tdBaseDate ) - MONTH( tdDob )) - 1
ELSE
lnMth = MONTH( tdBaseDate ) - MONTH( tdDob )
ENDIF
*** Format Output String
lcRetVal = PADL( lnYrs, 4 ) + " Years, " + PADL( lnMth, 2, '0' ) + " Month" + ;
IIF( lnMth = 1, "", "s" )
RETURN ALLTRIM( lcRetVal )
What date is the second Tuesday in October of 2000?
This is a handy little function that can be
used to calculate the exact date of holidays in a given year. For example, in
the
* Program....: nthSomeDayOfMonth
* Compiler...: Visual FoxPro 06.00.8492.00 for Windows
* Abstract...: Returns the date of a specific type of day; e.g., the
* ...........: second Tuesday in November of the year 2001
* ...........: nthSomedayOfMonth( 4, 3, 7, 2000 ) returns the date of
* ...........: the 3rd Wednesday in July of the year 2000
* Parameters.: tnDayNum: Day number 1=Sunday 7=Saturday
* ...........: tnWhich : Which one to find; 1st, 2nd, etc.
* ...........: If tnwhich > the number of this kind of day
* ...........: in the month, the last one is returned
* ...........: tnMonth : Month Number in which to find the day
* ...........: tnYear : Year in which to find the day
FUNCTION nthSomedayOfMonth( tnDayNum, tnWhich, tnMonth, tnYear )
LOCAL ldDate, lnCnt
*** Start at the first day of the specified month
ldDate = DATE( tnYear, tnMonth, 01 )
*** Find the first one of the specified day of the week
DO WHILE DOW( ldDate ) # tnDayNum
ldDate = ldDate + 1
ENDDO
*** Find the specified one of these...e.g, 2nd, 3rd, or last
IF tnWhich > 1
lnCnt = 1
DO WHILE lnCnt < tnWhich
lnCnt = lnCnt + 1
*** Move forward one week to get the next one of these in the month
ldDate = ldDate + 7
*** Are we are still in the correct month?
IF MONTH( ldDate ) # tnMonth
*** If not, jump back to the last one of these we found and exit
ldDate = ldDate - 7
EXIT
ENDIF
ENDDO
ENDIF
RETURN ldDate
Setting up a payment schedule
Another interesting problem is that of setting up a monthly schedule. Take, for example, a schedule of monthly payments to be collected via direct debit of a debtor's checking account. Obviously these payments cannot be collected on Sundays or holidays. They also cannot be collected earlier than the day specified when the schedule is first set up. This poses some interesting problems if the initial seed date for the schedule is between the 28th and the 31st of the month. So, in this case, simply using the GOMONTH() function may return an unacceptable date.
This function handles weekends, holidays, and GOMONTH() and assumes that you have created your holiday table with two columns: one for the date and one for the name of the holiday. An index on the holiday date is also desirable. Also keep in mind that to be useful, this holiday table must contain, at the very least, the holidays for both this year and next year.
FUNCTION MonthlySchedule ( tdStartDate, tnNumberOfMonths )
LOCAL laDates[1], lnCnt, ldDate, llOK, llUsed
*** Make sure we have the class library loaded
IF 'CH02' $ SET( 'CLASSLIB' )
*** Do nothing...class library is loaded
ELSE
SET CLASSLIB TO CH02 ADDITIVE
ENDIF
*** Make sure we have the Holidays table available
IF !USED( 'Holidays' )
USE Holidays In 0
llUsed = .F.
ELSE
llUsed = .T.
ENDIF
SELECT Holidays
SET ORDER TO dHoliday
FOR lnCnt = 1 TO tnNumberOfMonths
*** we want to return the passed date as date[1]
IF lnCnt > 1
ldDate = GOMONTH( tdStartDate, lnCnt-1 )
ELSE
ldDate = tdStartDate
ENDIF
*** Now we have to check to be sure that GoMonth didn't give us back a day
*** that is earlier than the seed date...can't do a direct debit BEFORE the
*** specified date i.e., the 28th of the month
IF DAY(tdStartDate) > 28
IF BETWEEN( DAY( ldDate ), 28, DAY( tdStartDate ) - 1 )
ldDate = ldDate + 1
ENDIF
ENDIF
llOK = .F.
DO WHILE !llOK
*** If current date is a Saturday, go to Monday
IF DOW( ldDate ) = 7
ldDate = ldDate + 2
ELSE
*** If current date is a Sunday, go to Monday
IF DOW( ldDate ) = 1
ldDate = ldDate + 1
ENDIF
ENDIF
*** OK, now check for Holidays
IF !SEEK( ldDate, 'Holidays', 'dHoliday' )
llOK = .T.
ELSE
ldDate = ldDate + 1
ENDIF
ENDDO
DIMENSION laDates[lnCnt]
laDates[lnCnt] = ldDate
ENDFOR
IF !llUsed
USE IN Holidays
ENDIF
RETURN CREATEOBJECT( 'xParameters', @laDates )
What date is ten business days from today?
A somewhat similar problem is how to calculate a date that is a specified number of business days from a given date. As with the previous example, this assumes the existence of a holiday table that is both region and application specific.
FUNCTION BusinessDays ( tdStartDate, tnNumberOfDays )
LOCAL lnCnt, ldDate, llOK, llUsed
*** Make sure we have the Holidays table available
IF !USED( 'Holidays' )
USE Holidays In 0
llUsed = .F.
ELSE
llUsed = .T.
ENDIF
SELECT Holidays
SET ORDER TO dHoliday
ldDate = tdStartDate
FOR lnCnt = 1 TO tnNumberOfDays
ldDate = ldDate + 1
llOK = .F.
DO WHILE !llOK
*** If current date is a Saturday, go to Monday
IF DOW( ldDate ) = 7
ldDate = ldDate + 2
ELSE
*** If current date is a Sunday, go to Monday
IF DOW( ldDate ) = 1
ldDate = ldDate + 1
ENDIF
ENDIF
*** OK, now check for Holidays
IF !SEEK( ldDate, 'Holidays', 'dHoliday' )
llOK = .T.
ELSE
ldDate = ldDate + 1
ENDIF
ENDDO
ENDFOR
IF !llUsed
USE IN Holidays
ENDIF
RETURN ldDate
Gotcha! Strict date format and parameterized views
Visual FoxPro's StrictDate format is especially comforting with the specter of the millennium bug looming large in front of us. At least it is as we are writing this. There, is however, one small bug that you should be aware of. If you have SET STRICTDATE TO 2 and try to open a parameterized view that takes a date as its parameter, you will be in for trouble. If the view parameter is not defined or is not in scope when you open or re-query the view, the friendly little dialog box prompting for the view parameter will not accept anything you enter. It will keep saying you have entered an ambiguous date/datetime constant.
The workaround is to ensure your view parameter is defined and in scope before trying to open or re-query the view. This means that, if your view is part of a form's data environment, its NoDataOnLoad property must be set to avoid getting the dialog as the form loads.
The other workaround, setting StrictDate to 0 and then back to 2, is not recommended. As we have already mentioned, using a global solution for a local problem is a little bit like swatting flies with a sledgehammer.
Working with numbers
Mathematical calculations have been handled fairly well since the days of Eniac and Maniac, except for the notable bug in the Pentium math co-processor. The most common problems arise because many calculations produce irrational results such as numbers that carry on for an infinite number of decimal places. Rounding errors are impossible to avoid because computing demands these numbers be represented in a finite form. The study of numerical analysis deals with how to minimize these errors by changing the order in which mathematical operations are performed as well as providing methods such as the trapezoidal method for calculating the area under the curve. A discussion of this topic is beyond the scope of this book, but we can give you some tips and gotchas to watch out for when working with numbers in your application.
Converting numbers to strings
Converting integers to strings is fairly straightforward. ALLTRIM( STR( lnSomeNumber ) ) will handle the conversion if the integer contains ten digits or less. If the integer contains more than ten digits, this function will produce a string in scientific notation format unless you specify the length of the string result as the second parameter. When converting numeric values containing decimal points or currency values, it is probably better to use another function. Although it can be accomplished using the STR() function, it is difficult to write a generic conversion routine. In order to convert the entire number you must specify both the total length of the number (including the decimal point) and the number of digits to the right of the decimal point. Thus STR(1234.5678) will produce '1235' as its result, and to get the correct conversion you must specify STR(1234.5678, 9, 4)
In Visual FoxPro 6.0, the Transform() function has been extended so that when called without any formatting parameters, it simply returns the passed value as its equivalent character string. Thus TRANSFORM(1234.5678) will correctly return '1234.5678'.
In all versions of Visual FoxPro you can use ALLTRIM( PADL ( lnSomeNumber, 32 ) ) to get the same result (providing that the total length of lnSomeNumber is less than thirty-two digits).
Gotcha! calculations that involve money
This one can bite if you are not careful. Try this in the command window and you will see what we mean.
returns the expected result of 333.3333 since currency values are always calculated to a precision of four decimal places. However,
returns 333.3000, which is not a very accurate result! Especially when you consider the result of the equivalent numeric calculation:
SET DECIMALS TO 4
returns 333.3333. The actual precision of the displayed result depends on the setting of SET DECIMALS, although the result is actually calculated to 8 places by default.
The moral of this story is that currency values should always be converted to numeric prior to using them in arithmetic operations. The functions MTON() and NTOM() are essential in this scenario, although watch out for unexpected results if you do not convert both ways!
? ( MTON( $1000 ) * ( 1/3 ) )
displays 333.333333 even with decimals set to 2. While
? NTOM( ( MTON( $1000 ) * ( 1/3 ) ) )
finally gets the expected result of 333.3333.
String functions
Visual FoxPro has several native string manipulation functions to handle almost everything you could ever need. ALLTRIM() to remove leading and trailing spaces, PADL() and PADR() to left and right pad, and STRTRAN() and CHRTRAN() to replace individual characters within a string. But did you know that you can use this line of code:
cString1 - cString2 - cString3
to accomplish the same thing as this one?
RTRIM( cString1 ) + RTRIM( cString2 ) + RTRIM( cString3 )
Gotcha! string concatenation
Even if the tables in your application do not allow null values, you may still need to deal with them. Very often, SQL statements using outer joins result in one or more columns that contain null values. This can be troublesome in cases where you may want to display a concatenated value from a result set, for example, in a drop down list. Try this in the command window:
c1 = 'Yada Yada Yada'
c2 = .NULL.
? c1 + c2
As you might expect, Visual FoxPro complains about an operator/operand type mismatch. If, however, you do this instead:
? c1 + ALLTRIM( c2 )
you will see .NULL. displayed on the Visual FoxPro screen.
No error, just .NULL. If you do not cater for null values by using NVL() to trap for them, you may find this behavior a little difficult to debug when it occurs in your application. We sure did the first time we encountered this behavior!
Converting between strings and data
The following are examples of functions that Visual FoxPro doesn't have, but in our opinion definitely should have. We keep these in our general all-purpose procedure file because we use them so frequently.
Combo and List boxes store their internal lists as string values. So when you need to use these to update or seek values of other data types, you need to convert these strings to the appropriate data type before you are able to use them. The first of these functions is used to do just that:
FUNCTION Str2Exp( tcExp, tcType )
*** Convert the passed string to the passed data type
LOCAL luRetVal, lcType
*** Remove double quotes (if any)
tcExp = STRTRAN( ALLTRIM( tcExp ), CHR( 34 ), "" )
*** If no type passed -- map to expression type
lcType = IIF( TYPE( 'tcType' ) = 'C', UPPER(ALLTRIM( tcType )), TYPE( tcExp ) )
*** Convert from Character to the correct type
DO CASE
CASE INLIST( lcType, 'I', 'N' ) AND ;
INT( VAL( tcExp ) ) == VAL( tcExp ) && Integer
luRetVal = INT( VAL( tcExp ) )
CASE INLIST( lcType, 'N', 'Y', 'B' ) && Numeric or Currency
luRetVal = VAL( tcExp )
CASE INLIST( lcType, 'C', 'M' ) && Character or memo
luRetVal = tcExp
CASE lcType = 'L' && Logical
luRetVal = IIF( !EMPTY( tcExp ), .T., .F.)
CASE lcType = 'D' && Date
luRetVal = CTOD( tcExp )
CASE lcType = 'T' && DateTime
luRetVal = CTOT( tcExp )
OTHERWISE
*** There is no otherwise unless, of course, Visual FoxPro adds
*** a new data type. In this case, the function must be modified
ENDCASE
*** Return value as Data Type
RETURN luRetVal
If you write client/server applications, you already know that you must convert all expressions to strings before using them within a SQLEXEC(). Even if you are not doing client/server development, you will require this functionality in order to build any kind of SQL on the fly.
The following function not only converts the passed parameter to a character value, it also wraps the result in quotation marks where appropriate. This is especially useful when invoking the function from an onthefly SQL generator. It is even easier in Visual FoxPro 6.0 because you can use the TRANSFORM function without a format string to convert the first argument to character. TRANSFORM( 1234.56 ) produces the same result as ALLTRIM( PADL( 1234.56, 32 ) ).
FUNCTION Exp2Str( tuExp, tcType )
*** Convert the passed expression to string
LOCAL lcRetVal, lcType
*** If no type passed -- map to expression type
lcType=IIF( TYPE('tcType' )='C', UPPER( ALLTRIM( tcType ) ), TYPE( 'tuExp' ) )
*** Convert from type to char
DO CASE
CASE INLIST( lcType, 'I', 'N' ) AND INT( tuExp ) = tuExp && Integer
lcRetVal = ALLTRIM( STR( tuExp, 16, 0 ) )
CASE INLIST( lcType, 'N', 'Y', 'B' ) && Numeric or Currency
lcRetVal = ALLTRIM( PADL( tuExp, 32 ) )
CASE lcType = 'C' && Character
lcRetVal = '"' + ALLTRIM( tuExp ) + '"'
CASE lcType = 'L' && Logical
lcRetVal = IIF( !EMPTY( tuExp ), '.T.', '.F.')
CASE lcType = 'D' && Date
lcRetVal = '"' + ALLTRIM( DTOC( tuExp ) ) + '"'
CASE lcType = 'T' && DateTime
lcRetVal = '"' + ALLTRIM( TTOC( tuExp ) ) + '"'
OTHERWISE
*** There is no otherwise unless, of course, Visual FoxPro adds
*** a new data type. In this case, the function must be modified
ENDCASE
*** Return value as character
RETURN lcRetVal
Other useful functions
There are several other generic functions that can live in your general procedure file or base procedure class. One obvious example is the SetPath() function (presented in Chapter One). We find the following functions particularly useful and hope you will too.
How do I determine if a tag exists?
Wouldn't it be nice if Visual FoxPro had a native function that returned true if a tag existed? This would be especially useful, for example, when creating a custom grid class that allows the user to click on a column header to sort the grid by the tag on that column. It would also be useful to test for the existence of an index if it must be created programmatically. This code provides that functionality.
FUNCTION ISTAG( tcTagName, tcTable )
LOCAL lnCnt, llRetVal, lnSelect
IF TYPE( 'tcTagName' ) # 'C'
*** Error - must pass a Tag Name
ERROR '9000:
RETURN .F.
ENDIF
*** Save Work Area Number
lnSelect = SELECT()
IF TYPE( 'tcTable' ) = 'C' AND ! EMPTY( tcTable )
*** If a table specified, select it
SELECT lcTable
ENDIF
*** Check Tags
FOR lnCnt = 1 TO TAGCOUNT()
IF UPPER(ALLTRIM( tcTagName ) ) == UPPER( ALLTRIM( TAG( lnCnt ) ) )
llRetVal = .T.
EXIT
ENDIF
NEXT
*** Restore Work Area
SELECT (lnSelect)
*** Return Whether Tag Found
RETURN llRetVal
By the way, notice the use of the ERROR command in this function. Rather than simply displaying a message when a parameter fails validation, this function raises an application error that can be trapped by an error handler, just like a normal Visual FoxPro error.
How do I determine if a string contains at least one alphabetic character?
The Visual FoxPro ISALPHA() returns .T. if the string passed to it begins with a letter. Similarly, ISDIGIT() will do the same if the string begins with a number. But what if you need to know if the string contains any alphabetic characters? Code like this would work, but it is slow and bulky:
FUNCTION ContainsAlpha( tcString )
LOCAL lnChar, llRetVal
llRetVal = .F.
*** Loop through the string and test each character
FOR lnChar = 1 TO LEN( tcString )
IF ISALPHA( SUBSTR( tcString, lnChar, 1 )
llRetVal = .T.
EXIT
ENDIF
ENDFOR
RETURN llRetVal
However, why write ten lines of code when two will do the same job?
FUNCTION ContainsAlpha( tcString )
RETURN LEN( CHRTRAN( UPPER( tcString ), "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "" ) );
# LEN( tcString )
Obviously, a similar methodology can be used to determine if a string contains any digits. However, we refuse to insult our readers' intelligence by listing it here. After all, you were all smart enough to buy this book, weren't you?
How to convert numbers to words
One common problem is that of converting numbers into character strings, for printing checks, or as confirmation of an invoice or order total. There have been many solutions proposed for this over the years, but we still like this one the best because it handles large numbers, negative numbers and adopts an innovative approach to decimals too.
* Program....: NumToStr
* Compiler...: Visual FoxPro 06.00.8492.00 for Windows
* Abstract...: Convert number into a text string
* Notes......: Handles Numbers up to 99,999,999 and will accommodate
* ...........: negative numbers. Decimals are rounded to Two Places
* ...........: And returned as 'and xxxx hundredths'
FUNCTION NumToStr
LPARAMETERS tnvalue
LOCAL lnHund, lnThou, lnHTho, lnMill, lnInt, lnDec
LOCAL llDecFlag, llHFlag, llTFlag, llMFlag, llNegFlag
LOCAL lcRetVal
*** Evaluate Parameters
DO CASE
CASE TYPE('tnValue') # 'N'
RETURN('')
CASE tnvalue = 0
RETURN 'Zero'
CASE tnvalue < 0
*** Set the Negative Flag and convert value to positive
llNegFlag = .T.
tnvalue = ABS(tnvalue)
OTHERWISE
llNegFlag = .F.
ENDCASE
*** Initialise Variables
STORE .F. TO llHFlag,llTFlag,llMFlag
STORE 0 TO lnHund, lnThou, lnMill
STORE "" TO lcRetVal
*** Get the Integer portion
lnInt = INT(tnvalue)
*** Check for Decimals
IF MOD( tnValue, 1) # 0
lnDec = ROUND(MOD(tnvalue,1),2)
llDecFlag = .T.
ELSE
llDecFlag = .F.
ENDIF
*** Do the Integer Portion first
DO WHILE .T.
DO CASE
CASE lnInt < 100 && TENS
IF EMPTY(lcRetVal)
lcRetVal = lcRetVal + ALLTRIM(con_tens(lnInt))
ELSE
IF RIGHT(lcRetVal,5)#" and "
lcRetVal = lcRetVal+' and '
ENDIF
lcRetVal = lcRetVal + ALLTRIM(con_tens(lnInt))
ENDIF
CASE lnInt < 1000 && HUNDREDS
lnHund = INT(lnInt/100)
lnInt = lnInt - (lnHund*100)
lcRetVal = lcRetVal + ALLTRIM(con_tens(lnHund)) + " Hundred"
IF lnInt # 0
lcRetVal = lcRetVal+" and "
ENDIF
CASE lnInt < 100000 && THOUSANDS
lnThou = INT(lnInt/1000)
lnInt = lnInt - (lnThou*1000)
lcRetVal = lcRetVal + ALLTRIM(con_tens(lnThou)) + " Thousand"
IF lnInt # 0
lcRetVal = lcRetVal + " "
ENDIF
CASE lnInt < 1000000 && Hundred Thousands
lnHTho = INT(lnInt/100000)
lnInt = lnInt - (lnHTho * 100000)
lcRetVal = lcRetVal + ALLTRIM(con_tens(lnHTho)) + " Hundred"
IF lnInt # 0
lcRetVal = lcRetVal + " and "
ELSE
lcRetVal = lcRetVal + " Thousand"
ENDIF
CASE lnInt < 100000000 && Millions
lnMill = INT(lnInt/1000000)
lnInt = lnInt - (lnMill * 1000000)
lcRetVal = lcRetVal + ALLTRIM(con_tens(lnMill)) + " Million"
IF lnInt # 0
lcRetVal = lcRetVal + ", "
ENDIF
ENDCASE
EXIT
ENDDO
*** Now Handle any Decimals
IF llDecFlag
lnDec = lnDec * 100
lcRetVal = lcRetVal + " and " + ALLTRIM(con_tens(lnDec)) + ' Hundredths'
ENDIF
*** Finally Handle the Negative Flag
IF llNegFlag
lcRetVal = "[MINUS " + ALLTRIM(lcRetVal) + "]"
ENDIF
*** Return the finished string
RETURN lcRetVal
*** Handle the TENS conversion
FUNCTION con_tens
LPARAMETERS tndvalue
LOCAL lcStrVal, lcStrTeen
STORE '' TO lcStrVal,lcStrTeen
DO CASE
CASE tnDValue < 20
RETURN(con_teens(tnDValue))
CASE tnDValue < 30
lcStrVal = 'Twenty'
tnDValue = tnDValue - 20
CASE tnDValue < 40
lcStrVal = 'Thirty'
tnDValue = tnDValue - 30
CASE tnDValue < 50
lcStrVal = 'Forty'
tnDValue = tnDValue - 40
CASE tnDValue < 60
lcStrVal = 'Fifty'
tnDValue = tnDValue - 50
CASE tnDValue < 70
lcStrVal = 'Sixty'
tnDValue = tnDValue - 60
CASE tnDValue < 80
lcStrVal = 'Seventy'
tnDValue = tnDValue - 70
CASE tnDValue < 90
lcStrVal = 'Eighty'
tnDValue = tnDValue - 80
CASE tnDValue < 100
lcStrVal = 'Ninety'
tnDValue = tnDValue - 90
ENDCASE
*** Now convert any remaining portion
lcStrTeen = con_teens(tnDValue)
IF LEN(lcStrTeen) # 0
*** Add on the relevant text
lcStrVal = lcStrVal + '-' + lcStrTeen
ENDIF
RETURN TRIM(lcStrVal)
*** Handle the Units/Teens Conversion
FUNCTION con_teens
LPARAMETERS tntvalue
DO CASE
CASE tntvalue = 0
RETURN('')
CASE tntvalue = 1
RETURN('One ')
CASE tntvalue = 2
RETURN('Two ')
CASE tntvalue = 3
RETURN('Three ')
CASE tntvalue = 4
RETURN('Four ')
CASE tntvalue = 5
RETURN('Five ')
CASE tntvalue = 6
RETURN('Six ')
CASE tntvalue = 7
RETURN('Seven ')
CASE tntvalue = 8
RETURN('Eight ')
CASE tntvalue = 9
RETURN('Nine ')
CASE tntvalue = 10
RETURN('Ten ')
CASE tntvalue = 11
RETURN('Eleven ')
CASE tntvalue = 12
RETURN('Twelve ')
CASE tntvalue = 13
RETURN('Thirteen ')
CASE tntvalue = 14
RETURN('Fourteen ')
CASE tntvalue = 15
RETURN('Fifteen ')
CASE tntvalue = 16
RETURN('Sixteen ')
CASE tntvalue = 17
RETURN('Seventeen ')
CASE tntvalue = 18
RETURN('Eighteen ')
CASE tntvalue = 19
RETURN('Nineteen ')
ENDCASE
The design here is interesting in itself. The problem has been tackled by reducing the various components of a number to a minimum, and the result is a useful function that can be used as a single line call as follows:
lcOutStr = NumToStr(1372.23) + " Dollars"
Returns: "One Thousand Three Hundred and Seventy-Two and Twenty-Three Hundredths Dollars"
How to extract a specified item from a list
More and more often we need to be able to accept and interpret data that is supplied in a separated list format. This may be a simple, comma-delimited file or possibly the result of a more complex data transfer mechanism or just some data we need to pass around internally. The construction of a string that contains data in a separated format is simple enough. Retrieving the data from such a string, however, can be a little more problematic. Enter the GetItem() function.
This function parses the string it is given, looking for the specified occurrence of the separator and extracting the item it finds. It assumes that, unless specified otherwise, you want the first item and the separator is a comma. However, both elements can be specified. Here it is:
* Program....: GetItem.PRG
* Compiler...: Visual FoxPro 06.00.8492.00 for Windows
* Abstract...: Extracts the specified element from a list
FUNCTION GetItem( tcList, tnItem, tcSepBy )
LOCAL lcRetVal, lnStPos, lnEnPos, lcSepBy
lcRetVal = ""
*** Default to Comma Separator if none specified
lcSep = IIF( VARTYPE(tcSepBy) # 'C' OR EMPTY( tcSepBy ), ',', tcSepBy )
*** Default to First Item if nothing specified
tnItem = IIF( TYPE( 'tnItem' ) # "N" OR EMPTY( tnItem ), 1, tnItem)
*** Add terminal separator to list to simplify search
tcList = ALLTRIM( tcList ) + lcSep
*** Determine the length of the required string
IF tnItem = 1
lnStPos = 1
ELSE
lnStPos = AT( lcSep, tcList, tnItem - 1 ) + 1
ENDIF
*** Find next separator
lnEnPos = AT( lcSep, tcList, tnItem )
IF lnEnPos = 0 OR (lnEnPos - lnStPos) = 0
*** End of String
lcRetVal = NULL
ELSE
*** Extract the relevant item
lcRetVal = SUBSTR( tcList, lnStPos, lnEnPos - lnStPos )
ENDIF
*** Return result
RETURN ALLTRIM(lcRetVal)
Typically we use this function inside a loop to retrieve the items from a separated list in the order in which it was constructed, as follows:
lcStr = "David|Jones|12 The Street|Someplace|"
lnCnt = 0
DO WHILE .T.
lnCnt = lnCnt + 1
lcItem = GetItem( lcStr, lnCnt, "|" )
IF ! ISNULL(lcItem)
*** Do whatever with it
ELSE
*** End of the string - exit
EXIT
ENDIF
ENDDO
Is there a simple way of encrypting passwords?
The answer (and since we asked the question, you would expect nothing less) is Yes! The next pair of functions provide an easy way to add a reasonable level of password security. The encryption process is based on converting each character in the plain string to its ASCII number and then adding a constant. We have used 17 in this example but suggest that if you adopt these functions you use a different number, plus a random seed number, plus the position of the letter in the string to that value. The character represented by this new number is then returned as the encrypted version. The returned string includes the seed number used in its generation as the first character so it can always be decoded. This methodology has several benefits:
Anyway, here are both the Encode and Decode functions:
* Program....: AEnCode.PRG
* Compiler...: Visual FoxPro 06.00.8492.00 for Windows
* Abstract...: Encrypt a Password
FUNCTION aencode(tcKeyWord)
LOCAL lcRaw, lnVar, lcEnc
IF TYPE('tcKeyWord') # "C" OR EMPTY(tcKeyWord)
*** Must pass a character key to this process
ERROR( "9000: A Character string is the required parameter for AEnCode" )
RETURN ""
ENDIF
lcRaw = UPPER(ALLTRIM(tcKeyWord)) && Keyword
lnVar = INT(
lcEnc = ALLTRIM(STR(lnVar)) && Encrypted string starts with key #
*** Parse the Keyword and encrypt each character
*** Using its ASCII code + 17 + Random Key + Position in Keyword
FOR lnCnt = 1 TO LEN(lcRaw)
lcChar = SUBSTR(lcRaw, lnCnt,1)
lcEnc = lcEnc + CHR( ASC(lcChar) + 17 + lnVar + lnCnt + 1)
NEXT
RETURN lcEnc
* Program....: ADeCode.PRG
* Compiler...: Visual FoxPro 06.00.8492.00 for Windows
* Abstract...: Decodes a password encrypted with AEnCode()
FUNCTION adecode(tcKeyWord)
LOCAL lcRaw, lnVar, lcEnc
IF TYPE('tcKeyWord') # "C" OR EMPTY(tcKeyWord)
*** Must pass a character key to this process
ERROR( "9000: An Encrypted string is the required parameter for ADeCode" )
RETURN ""
ENDIF
lcEnc = ALLTRIM(tcKeyWord) && Keyword
lnVar = VAL(LEFT(lcEnc,1)) && Encryption Key
lcRaw = "" && Decoded Password
*** Parse the Keyword and decrypt each character
*** Using its ASCII code + 17 + Random Key + Position in Keyword
FOR lnCnt = 2 TO LEN(lcEnc)
lcChar = SUBSTR(lcEnc, lnCnt, 1)
lcRaw = lcRaw + CHR( ASC(lcChar) - (17 + lnVar + lnCnt) )
NEXT
RETURN lcRaw
And here are some samples of the encrypted output:
Pass 1 ? AEnCode( 'Andy%Kr#02' ) 8\jawDksESV
Pass 2 ? AEnCode( 'Andy%Kr#02' ) 6Zh_uBiqCQT
Pass 3 ? AEnCode( 'Andy%Kr#02' ) 3We\r?fn@NQ
Each of which decodes back to the same original string:
Pass 1 ? ADeCode( '8\jawDksESV' ) ANDY%KR#02
Pass 2 ? ADeCode( '6Zh_uBiqCQT' ) ANDY%KR#02
Pass 3 ? ADeCode( '3We\r?fn@NQ' ) ANDY%KR#02
We are sure you will find ways of improving or adapting these functions, but they have served us well for several years now and we hope you like them.
Where do you want to GOTO?
We all use the GOTO <nn> command from time to time, but one of a Visual FoxPro programmer's little annoyances is that GOTO does not do any error checking of its own. If you tell Visual FoxPro to GOTO a specific record number it just tries to go there. Of course if the record number you have specified is not in the table, or if you inadvertently have the wrong work area selected you get an ugly error.
The problem of the work area selection has been largely resolved with the introduction of the IN clause for many commands - including GOTO. However that does not resolve the problem of other errors. We got tired of putting checks around every GOTO statement in our code so we devised a little function to wrap the GOTO command and make it safer and friendlier. We named it GOSAFE() and here it is:
* Program....: GoSafe.PRG
* Compiler...: Visual FoxPro 06.00.8492.00 for Windows
* Abstract...: Wrapper around the GOTO command
FUNCTION GoSafe( tnRecNum, tcAlias )
LOCAL ARRAY laErrs[1]
LOCAL lcAlias, lnCount, lnCurRec, lnErrCnt, lLRetVal
*** Check parameter is numeric and valid
IF VARTYPE( tnRecNum ) # "N" OR EMPTY( tnRecNum )
ERROR "9000: A valid numeric parameter must be passed to GoSafe()"
RETURN .F.
ENDIF
*** Default alias to current alias if not specified
IF VARTYPE( tcAlias) #"C" OR EMPTY( tcAlias )
lcAlias = ALIAS()
ELSE
lcAlias = UPPER( ALLTRIM( tcAlias ))
ENDIF
*** Check that we have got the specified Alias
IF EMPTY( lcAlias ) OR ! USED( lcAlias )
ERROR "9000: No table was specified or the specified table is not open"
RETURN .F.
ENDIF
*** Get Max No records and the currently selected
*** record number in the specified alias
lnCount = RECCOUNT( lcAlias )
lnCurRec = RECNO( lcAlias )
*** Save Error handling and turn off error trapping for now
lcOldError = ON("ERROR")
ON ERROR *
*** Now try and GO to the required record
GOTO tnRecNum IN (lcAlias)
*** Did we succeed?
IF RECNO( lcAlias ) # tnRecNum
*** Check for Errors
lnErrCnt = AERROR( laErrs )
IF lnErrCnt > 0
DO CASE
CASE laErrs[1,1] = 5
*** Record Out of Range
lcErrTxt = 'Record Number ' + ALLTRIM(PADL(tnRecNum, 32)) ;
+ ' Is not available in Alias: ' + lcAlias
CASE laErrs[1,1] = 20
*** Record Not in Index
lcErrTxt = 'Record Number ' + ALLTRIM(PADL(tnRecNum, 32)) ;
+ ' Is not in the Index for Alias: ' + lcAlias ;
+ CHR(13) + 'Table needs to be Re-Indexed'
OTHERWISE
*** An unexpected error
lcErrTxt = 'An unexpected error prevented the GOTO succeeding'
ENDCASE
MESSAGEBOX( lcErrTxt, 16, 'Command Failed' )
ENDIF
*** Restore the original record
GOTO lnCurRec IN (lcAlias)
llRetVal = .F.
ELSE
llRetVal = .T.
ENDIF
*** Restore Error Handler
ON ERROR &lcOldError
RETURN lLRetVal
One thing to notice in this program is the use of the ON("ERROR") function to save off the current error handler so that we can safely suppress the normal error handling with ON ERROR * and restore things at the end of the function.
This is a very important point and is all too easily forgotten in the heat of battle. Any procedure or function should save environmental settings before changing any of them (well, maybe we should state that it is best to validate parameters first. After all, if they are incorrect, the function is not going to do anything anyway.) On completion, your procedure or function absolutely must reset everything exactly as it was before the function was called.
|
