Why Use Stored Procedures
Novice programmers or those moving from older versions of Foxpro (or other disciplines) tend to dive straight into programming in VFP, bringing old techniques along with them. Before you know it you have a functioning program that may have benefited from the advances offered by Visual Foxpro.
store a procedure, not a child
(courtesy of russelljsmith)
One of these advances is the ability to store commonly used procedures and functions within the database container, from here they behave like intrinsic VFP functions or procedures and hence are globally accessible from all form methods or programs.
Here are a few useful functions to get you started. These should only require the correct parameters to work ‘out-of-the-box’
Unix Date Number of Seconds since 1970
FUNCTION UnixDate
LPARAMETERS dDate
LOCAL ldUnixStartDate
ldUnixStartDate={1970/01/01} && 1st Jan 1970
RETURN (dDate-ldUnixStartDate)
ENDFUNC
Pseudo random number between two limits
FUNCTION RANDOM
LPARAMETERS nLower,nUpper
RETURN INT((nUpper - nLower + 1) * RAND( ) + nLower)
ENDFUNC
UNC name for a mapped network drive
*********************************************
* Return the UNC name for a mapped network *
* Drive, Return Empty if not mapped drive *
*********************************************
FUNCTION UNCPath
LPARAMETERS cDrive,nOpt
LOCAL lcRemoteName,lnLen,lnStatus
cDrive=STRTRAN(cDrive,":","")+":" && Make Sure ":"
*********************************************************
* Declare the external WNetGetConnection API function *
*********************************************************
DECLARE INTEGER WNetGetConnection IN win32api ;
STRING lpszLocalName,;
STRING lpszRemoteName,;
INTEGER @ lpchBuffer
lcRemoteName = SPACE(254) && Initialize variables
lnLen = LEN(lcRemoteName)
lnStatus = WNetGetConnection(cDrive,@lcRemoteName,@lnLen)
RETURN ALLTRIM(STRTRAN(lcRemoteName,CHR(0),""))
ENDFUNC
Full UNC path of file or Directory
*********************************************
* Return full UNC path for specified file or*
* Directory, Returns unchanged NOT a mapped *
*********************************************
FUNCTION UNCFullpath
LPARAMETERS cFullpath
LOCAL lcReturn
lcReturn=""
DO CASE
CASE LEN(cFullpath)>1 AND SUBSTR(cFullpath,2,1)<>":" && No Drive
lcReturn=cFullpath
OTHERWISE
DO CASE
CASE LEN(cFullpath)=1 && Drive Letter only
lcDrive=cFullpath+":"
lcReturn=UNCPath(lcDrive)
IF EMPTY(lcReturn)
lcReturn=ADDBS(lcDrive)+SUBSTR(cFullpath,3)
ENDIF
OTHERWISE
lcDrive=LEFT(cFullpath,2)
lcReturn=UNCPath(lcDrive)
IF EMPTY(lcReturn)
lcReturn=lcDrive+SUBSTR(cFullpath,3)
ELSE
lcReturn=lcReturn+SUBSTR(cFullpath,3) && Add the remainder
ENDIF
ENDCASE
ENDCASE
RETURN lcReturn
ENDFUNC
Clear Directory Content
*********************************************
* Delete files from specified Directory that*
* match particular File Skeleton * CAUTION!**
*********************************************
FUNCTION ClearDir
LPARAMETERS lcDir,lcSkeleton
LOCAL ARRAY aName(1,1)
LOCAL lnFiles,lnFile,lcFilename,lcErrorHand,lnError
lcErrorHand=ON("Error")
lcDir=ADDBS(ALLTRIM(lcDir))
lcSkeletion=ALLTRIM(lcSkeleton)
lnFiles=ADIR(aName,lcDir+lcSkeleton)
ON ERROR lnError=1
FOR lnFile=1 TO lnFiles
lcFilename=lcDir+aName(lnFile,1)
DELETE FILE (lcFilename)
ENDFOR
ON ERROR
IF NOT EMPTY(lcErrorHand)
ON ERROR &lcErrorHand
ENDIF
ENDFUNC
Create Directory
*********************************************
* If the specified Directory does'nt Exist *
* Tries to create it. Returns true if it *
* Existed already or was Succesfully created*
*********************************************
FUNCTION CreateDirectory
LPARAMETERS lcDirectory
LOCAL lcErrRoutine,llError
DO CASE
CASE DIRECTORY(lcDirectory) && There Already ?
OTHERWISE
llError=.F.
lcErrRoutine=ON("Error") && Save an on error settings
ON ERROR llError=.T. && Stop Error Messages
MD (lcDirectory) && Try to create it (Inc any sub Directories_
ON ERROR && Clear ON ERROR
IF NOT EMPTY(lcErrRoutine)
ON ERROR &lcErrRoutine && Reset to original
ENDIF
ENDCASE
RETURN DIRECTORY(lcDirectory) && If it exists NOW !
ENDFUNC
Format persons name – From Title, Forename, Surname
******************************************
* Format a name in the format title,forename*
* Surname to a single string representation *
*********************************************
*lvOpt = 0 && No Change to case
* = 1 && Proper Case Title Forename Surname
* = 2 && Proper Case
FUNCTION FULLNAME
LPARAMETER lcTitle,lcForename,lcSurname,lvOpt
LOCAL lcReturn
lcTitle=ALLTRIM(lcTitle)
lcForename=ALLTRIM(lcForename)
lcSurname=ALLTRIM(lcSurname)
IF VARTYPE(lvOpt)="L" && Old Calling
lvOpt=IIF(lvOpt,1,2) && Convert to Numeric
ENDIF
DO CASE
CASE lvOpt=0 && No Change to Case
lcReturn=lcTitle+" "+lcForename+" "+lcSurname
CASE lvOpt=1
lcReturn=PROPER(lcTitle)+" "+PROPER(lcForename)+" "+PROPER(lcSurname)
CASE lvOpt=2
lcReturn=PROPER(ALLTRIM(lcTitle))+" "+UPPER(LEFT(ALLTRIM(lcForename),1))+" "+PROPER(lcSurname)
ENDCASE
RETURN ALLTRIM(lcReturn)
ENDFUNC
First date of Month for given date
*********************************************
* Returns Date expression representing the *
* First Date in the month of the date passed*
*********************************************
FUNCTION ThisMonthStart
LPARAMETER ldDate
LOCAL lcSetDate,ldReturnDate
lcSetDate=SET("Date") && Current Setting
SET DATE British && Force format
ldReturnDate=CTOD("01"+SUBSTR(DTOC(ldDate),3))
SET DATE (lcSetDate) && Reset
RETURN ldReturnDate
ENDFUNC
Last Date of Month for given Date – (inc) Leap year
*********************************************
* Returns Date expression representing the *
* last Date in the month of the date passed *
*********************************************
FUNCTION ThisMonthEnd
LPARAMETER ldDate
LOCAL lnMonth,lcMonthYear,ldReturnDate,lcSetDate
lcSetDate=SET("date") && Current Setting
SET DATE British && Force format
lcMonthYear=SUBSTR(DTOC(ldDate),3)
lnMonth=MONTH(ldDate)
DO CASE
CASE lnMonth=2
ldReturnDate=CTOD("29"+lcMonthYear) && Try 29th
IF EMPTY(ldReturnDate) && Failed
ldReturnDate=CTOD("28"+lcMonthYear)
ENDIF
CASE INLIST(lnMonth,9,4,6,11)
ldReturnDate=CTOD("30"+lcMonthYear)
OTHERWISE
ldReturnDate=CTOD("31"+lcMonthYear)
ENDCASE
SET DATE (lcSetDate) && Reset
RETURN ldReturnDate
ENDFUNC
Date of first day of the week for given date
*********************************************
* Returns Date expression representing the *
* Last Date in the week of the date passed *
*********************************************
FUNCTION ThisWeekStart
LPARAMETER ldDate
LOCAL lnThisDay
lnThisDay=DOW(ldDate)
RETURN ldDate-(lnThisDay-1)
ENDFUNC
Date of last day of the week for given date
*******************************************
* Returns Date expression representing the *
* Last Date in the week of the date passed *
*********************************************
FUNCTION ThisWeekEnd
LPARAMETER ldDate
LOCAL lnThisDay
lnThisDay=DOW(ldDate)
RETURN ldDate-lnThisDay+7
ENDFUNC
Full Date format
*************************************************
* Returns a expanded character expression of *
* Date passed. *
*************************************************
FUNCTION Fulldate
LPARAMETER ldDate,nOpt
LOCAL lcDay,lcMonth,lcYear,lnDay
nOpt=IIF(EMPTY(nOpt),0,nOpt)
lnDay=DAY(ldDate) && Get Numeric for case statement
lcDay=ALLTRIM(STR(lnDay)) && convert to char
lcMonth=CMONTH(ldDate) && Charater Month
lcYear=ALLTRIM(STR(YEAR(ldDate))) && character year
DO CASE
CASE nOpt=1
lcDay=CDOW(ldDate)+" "+lcDay
CASE nOpt=2
lcDay=LEFT(CDOW(ldDate),3)+" "+lcDay
ENDCASE
DO CASE
CASE INLIST(lnDay,1,21,31)
lcDay=lcDay+"st"
CASE INLIST(lnDay,2,22)
lcDay=lcDay+"nd"
CASE INLIST(lnDay,3,23)
lcDay=lcDay+"rd"
OTHERWISE
lcDay=lcDay+"th"
ENDCASE
RETURN lcDay+" "+lcMonth+" "+lcYear
ENDFUNC
Remove unwanted characters from a text string
*************************************************
* Remove unwanted characters from a text string *
* lvText Passed by reference or value *
*************************************************
FUNCTION StripChars
LPARAMETER lvText,lcChars,lcReplace
lcReplace=IIF(EMPTY(lcReplace),"",lcReplace)
LOCAL i
FOR i=1 TO LEN(lcChars)
lvText=STRTRAN(lvText,SUBSTR(lcChars,i,1),lcReplace)
ENDFOR
RETURN lvText
ENDFUNC
User Network logon name
*********************************************
* Returns current users network logon name *
* *******************************************
FUNCTION USER
LPARAMETERS lnOpt,lcuserName
LOCAL lcUser
lcUser=IIF(PCOUNT()=2,lcuserName,PROPER(SUBSTR(SYS(0),AT("#",SYS(0))+2)))
IF AT(".",lcUser)>0
lcUser=PROPER(LEFT(lcUser,AT(".",lcUser)))+PROPER(SUBSTR(lcUser,AT(".",lcUser)+1))
ENDIF
DO CASE
CASE EMPTY(lnOpt)
CASE lnOpt=1 AND AT(".",lcUser)>0
lcUser=LEFT(lcUser,AT(".",lcUser)-1)
ENDCASE
RETURN lcUser
ENDFUNC