Syntax checking on e-mail addresses

You can use the following code to validate e-mail addresses in your Foxpro applications.

* Procedure validatemail([emailaddress])

PARAMETERS pEmail

LOCAL cDomains, cPiece, cMessage, cNum, lDomain, lemailname

pEmail = LOWER(ALLTRIM(pEmail))
cMessage = ""
lDomain = .t.
lEmailname = .t.

IF !EMPTY(pEmail)

cdomains = '"aero", "asia", "biz", "cat", "com", "coop", ' +;
'"edu", "gov", "info", "int", "jobs", "mil", "mobi", "museum", ' +;
'"name", "net", "org", "pro", "tel", "travel"'

* some extra checks which are not tackled below
IF ".." $ pemail OR "@." $ pemail OR ".@" $ pemail && missing pieces between dots and pigtail
lEmailname = .f.
ENDIF
IF NOT "@" $ pEmail && no pigtail
lEmailname = .f.
ENDIF
IF OCCURS("@", pemail) > 1 && multiple pigtails
lEmailname = .f.
ENDIF

* check the emailname
cPiece = LEFT(pEmail, AT("@", pEmail)-1)
IF EMPTY(cPiece)
lEmailname = .f.
ELSE
FOR i = 1 TO LEN(cPiece)
cNum = ASC(SUBSTR(cPiece,i,1))
* A to Z, 0 to 9, ! to /
IF between(cNum, 97,122) OR;
between(cNum, 48,57) OR;
between(cNum, 33,47)
ELSE
lEmailname = .f.
ENDIF
ENDFOR
ENDIF

* check the domain name
cPiece = SUBSTR(pEmail, RAT("@", pEmail)+1)
IF EMPTY(cPiece) && empty
lDomain = .f.
ELSE
IF LEN(cPiece) < 4 && domain name to short
lDomain = .f.
ENDIF

cPiece = SUBSTR(pEmail, RAT(".", pEmail)+1)
IF LEN(cPiece) < 2 && part after the last dot to short
lDomain = .f.
ENDIF
IF LEFT(pEmail,1) $ "." && begins with a dot
lDomain = .f.
ENDIF

FOR i = 1 TO LEN(cPiece)
cNum = ASC(SUBSTR(cPiece,i,1))
* A to Z, 0 to 9, ! to /
IF between(cNum, 97,122) OR;
between(cNum, 48,57) OR;
between(cNum, 33,47)
ELSE
lDomain = .f.
ENDIF
ENDFOR

IF LEN(cPiece) > 2 && top level domain
IF NOT '"' + cPiece + '"' $ cdomains && no top level domain
lDomain = .f.
ENDIF
ELSE
* If you have a list with all the country codes, you could check them here...
ENDIF
ENDIF
ENDIF

RETURN (lEmailname = .T. AND lDomain = .T.)

An application-wide hourglass

When your users are waiting for your application to complete some task, it's nice to show them the hourglass mousepointer as an indication. You can easily set the mousepointer property of the active form, but when the user moves the mouse outside of it, the mousepointer changes to the arrowhead again and that's not how it should be.
The following code changes the mousepointer for all the forms in your application.
Put the code in a .PRG file and (very important!) name it MAUSER, because that was what Richard and I named it originally.
The reason for that is, that at the moment we were thinking about how to name this function, our friend Maurits walked in the room and 'Maus' is what we call him for short. Also 'maus' is the German word for mouse.

Activating and deactivating the hourglass is as simple as putting =MAUSER(.T.) and =MAUSER(.F.) around the piece of code that takes a while to execute.


PARAMETERS lZetAan

LOCAL nFormTeller

FOR nFormTeller = 1 TO _Screen.FormCount
_Screen.Forms(nFormTeller).SetAll("MousePointer",IIF(lZetAan,11,0))
_Screen.Forms(nFormTeller).MousePointer = IIF(lZetAan,11,0)
NEXT
_Screen.SetAll("MousePointer",IIF(lZetAan,11,0))

_Screen.MousePointer = IIF(lZetAan,11,0)
IF TYPE("_Screen.Activeform.Name") = "C"
_Screen.Activeform.SetAll("MousePointer",IIF(lZetAan,11,0))
ENDIF

Can you put a file in the desired location?

When you want to put a file in a certain location, you may want to check if it is possible to write to that location. You might not have write permission, the location might not exist or a file with the same name allready exists and cannot be overwritten because it is in use. With the code below, you can check this out:

* FUNCTION FILEOVERWRITE()

PARAMETERS cGo

fhandle =FCREATE(cGo)
IF fhandle > -1
=FCLOSE(fhandle)
DELE FILE (cGo)
RETURN .T.
ELSE
RETURN .F.
ENDIF

Function that returns a part of a comma-separated string

Whenever you need to to handle comma-separated string, you might want to check the function below, which makes use of VFP's ALINES() function to return a certain value in the string.


* Parameters: String (character) , which part (numeric), delimiter (character)
PARAMETERS cCsv, nPart, pdelimiter

IF PCOUNT() < 3
pDelimiter = ","
ENDIF

cCsv = STRTRAN(cCsv, pDelimiter, " "+CHR(13) )

ALINES(aCsv, cCsv , .T.)

* When array element 1 = .False. => return ""
* When the number of array elements < nPart => return ""
* Otherwise, return the piece of the string

RETURN IIF( TYPE( "aCsv[1]" ) = "L" , "", IIF( ALEN(aCsv,1) < nPart , "", aCsv[nPart] ) )

Resize or reposition a desktop form to fit the Windows desktop

In your VFP application, you want your users to have the application form re-appear as it was left behind the last time. So, you store the screen coordinates (in your apps mechanism that saves the application settings) and restore the form to the saved coordinates, the next time it is run.
But in the mean time, the user may have altered the screen resolution, changed to a p.c. with a different screen resolution or moved/resized the Windows startbar.

I these scenario's, your application form may not fit in the Windows desktop anymore.
Below, you find the code of SETFORMSIZE.PRG, which repositions the form to fit the desktop again.

To test it:
- create a form with the desktop property to .True.
- Put this code in the load method of the form:
This.Top = -100
This.Left = -100
This.Width = 100000
This.Height = 100000
DO SETFORMSIZE WITH This
- Run the form


************************************************************************
* SETFORMSIZE.PRG *
************************************************************************
PARAMETERS oForm

LOCAL nWinHeight, nWinWidth, nCorrection

* Width en height of screenspace minus space occuped by the startmenu bar
* wherever that is placed or whatever size it is
nWinHeight = SYSMETRIC(22)
nWinWidth = SYSMETRIC(21)
nCorrection = sysmetric(3)*2

* First: check if the form is off screen above and to the left
IF oForm.Left < 0
oForm.Left = 0
ENDIF
IF oForm.Top < 0
oForm.Top = 0
ENDIF

* Next: check if the form is to high or wide to fit in the screen
IF (oForm.Top + oForm.Height) > nWinHeight && Oh Oh, Formheight beyond screen
nHowMuch = (oForm.Top + oForm.Height ) - nWinHeight
IF nHowMuch > oForm.Top && Oh oh, form does not fit in the screen
IF oForm.MinHeight >= (nWinHeight - oForm.Height )
oForm.Height = nWinHeight - nCorrection
ENDIF

nNewTop = 0
ELSE
nNewTop = (oForm.Top - nHowMuch) - nCorrection
ENDIF
ELSE
nNewTop = oForm.Top
ENDIF
IF (oForm.Left + oForm.Width) > nWinWidth && Oh Oh, Formwidth beyond screen
nHowMuch = (oForm.Left + oForm.Width ) - nWinWidth
IF nHowMuch > oForm.Left && Oh oh, form does not fit in the screen
IF oForm.MinWidth >= (nWinWidth - oForm.Width )
oForm.Width = nWinWidth - nCorrection
ENDIF
nNewLeft = 0
ELSE
nNewLeft = (oForm.Left - nHowMuch) - nCorrection
ENDIF
ELSE
nNewLeft = oForm.Left
ENDIF

oForm.Left = nNewLeft
oForm.Top = nNewTop

Is MS Office installed on a computer?

There are more ways to detect if MS Excel, Outlook or Word is installed on a computer. One way is, to look it up in the Window registry.
The following code does exactly that.

* Code that shows if Outlook, Word and Excel are installed:

ckey = "Software\Microsoft\Windows\CurrentVersion\App Paths\outlook.exe"
OutlookExists = readregstring(-2147483646, ckey, "path")

ckey = "Software\Microsoft\Windows\CurrentVersion\App Paths\winword.exe"
WinWordExists = readregstring(-2147483646, ckey, "path")

ckey = "Software\Microsoft\Windows\CurrentVersion\App Paths\excel.exe"
ExcelExists = readregstring(-2147483646, ckey, "path")

? !EMPTY(NVL(OutlookExists,""))
? !EMPTY(NVL(WinWordExists,""))
? !EMPTY(NVL(ExcelExists,""))

The code makes use of a function called 'readregstring' That function is:

***----------------------------------------------------------------------
*** Function: Reads a string value from the registry.
*** Pass: tnHKEY - HKEY value (in CGIServ.h)
*** tcSubkey - The Registry subkey value
*** tcEntry - The actual Key to retrieve
*** Return: Registry String or .NULL. on error
***----------------------------------------------------------------------
LPARAMETERS tnHKey, tcSubkey, tcEntry
LOCAL lnRegHandle, lnResult, lnSize, lcDataBuffer, tnType

tnHKey=IIF(type("tnHKey")="N",tnHKey,This.HKEY_LOCAL_MACHINE)

lnRegHandle=0

DO DeclareInit && Declare WinAPI function. You only have to do this once.

*** Open the registry key
lnResult=RegOpenKey(tnHKey,tcSubKey,@lnRegHandle)
IF lnResult # 0
RETURN .NULL.
ENDIF

*** Need to define here specifically for Return Type
*** for lpdData parameter or VFP will choke.
*** Here it's STRING.
DECLARE INTEGER RegQueryValueEx ;
IN Win32API AS RegQueryString;
INTEGER nHKey,;
STRING lpszValueName,;
INTEGER dwReserved,;
INTEGER @lpdwType,;
STRING @lpbData,;
INTEGER @lpcbData

*** Return buffer to receive value
lcDataBuffer=space(256)
lnSize=LEN(lcDataBuffer)
lnType=0

lnResult=RegQueryString(lnRegHandle,tcEntry,0,@lnType,;
@lcDataBuffer,@lnSize)

=RegCloseKey(lnRegHandle)

IF lnResult # 0
RETURN .NULL.
ENDIF

IF lnSize<2
RETURN ""
ENDIF

*** Return string based on length returned
RETURN SUBSTR(lcDataBuffer,1,lnSize-1)

And the DeclareInit function that is called:

*** Open a registry key
DECLARE INTEGER RegOpenKey ;
IN Win32API ;
INTEGER nHKey,;
STRING cSubKey,;
INTEGER @nHandle

*** Close an open registry key
DECLARE Integer RegCloseKey ;
IN Win32API ;
INTEGER nHKey

Importing an Excel spreadsheet in VFP using Excel

De native IMPORT function of Visual Foxpro doesn't allways do a good yob. For example, sometimes it converts numbers to date values (01-01-1900).
The code below uses office automation to let Excel itself export the spreadsheet to dBase format. Also, you don't have to know in which version of Excel the spreadsheet is created, like you have to with the IMPORT function.

The code does not work with Excel 2007, because Microsoft decided to say bye bye to the dBase export filters.

Run the .PRG file like:

DO XLS2DBF WITH 'MySpreadsheet.xls', 'MyTable.dbf'

* XLS2DBF.PRG
*
* Function accepts 2 parameters
* 1) cSheet is the Excel sheet that is to be exported
* 2) cExportFile is the filename of the exportfile

PARAMETERS cSheet, cExportFile

IF PCOUNT() = 1
* Create a temp export file
cExportFile = SYS(2023) + "\" + SYS(3) + ".tmp"
ENDIF

LOCAL lErrorCatched, oExcelWorkbook, nFileFormat

nFileFormat = 11 && Excel Saveas constant for dBase IV format. Not available in Excel 2007 though...
lErrorCatched = .F.

* Can we get to Excel or what?
TRY
oExcelObject = CREATEOBJECT('Excel.Application')
CATCH
lErrorCatched=.T.
ENDTRY

IF lErrorCatched
RETURN .F.
ELSE

oExcelWorkbook = oExcelObject.Application.Workbooks.Open(cSheet)

* When columns in Excel are to small to show all the data, Excel also cuts them off when exporting!
* The code below formats the columns to be wide enough...
oExcelObject.Cells.Select
oExcelObject.Selection.Font.Size = 11 && dBase IV
oExcelObject.Selection.Columns.AutoFit
oExcelObject.Selection.Font.Size = 8

oExcelObject.cells(1).select && makes sure the whole sheet is exported and not some selected range (or whatever goes wrong with that from time to time...)
oExcelObject.DisplayAlerts = .F. && prevents overwrite message
oExcelWorkbook.SaveAs(cExportFile, nFileFormat)
oExcelWorkbook.close

* When opening a .DBF file created by Excel, there is no codepage
* VFP opens up the codepage dialog in order to choose a codepage, but we don't want that
* SET CPDIALOG OFF won;t help, because then there stil is no codepage for the .DBF file
* Luckily, VFP provides CPZERO.PRG, with can update a .DBF with a codepage
* You could do: DO CPZERO WITH cExportFile, 850
* But instead, the code below is a little piece of the CPZERO code that does the job, so we don't
* have to include CPZERO.PRG itself.
LOCAL varcpbyte, varfp_in, varbuf
varcpbyte = 2
varfp_in = FOPEN(cExportFile,2)
IF varfp_in > 0
* First check that we have a FoxPro table...
varbuf=FREAD(varfp_in,32)
IF (SUBSTR(varbuf,1,1) = CHR(139) OR SUBSTR(varbuf,1,1) = CHR(203);
OR SUBSTR(varbuf,31,1) != CHR(0) OR SUBSTR(varbuf,32,1) != CHR(0))
=fclose(varfp_in)
RETURN .F.
ELSE
* now poke the codepage id into byte 29
=FSEEK(varfp_in,29)
=FWRITE(varfp_in,CHR(varcpbyte))
=FCLOSE(varfp_in)
ENDIF
ELSE
RETURN .F.
ENDIF

* If no exportfile is specified, open the data as a temporary table to undertake further action
IF PCOUNT() = 1
cAlias = "C"+SYS(3)
USE (cExportFile) IN 0 ALIAS (cAlias)
* BROWSE NORMAL NOWAIT && if you want
ENDIF

* clean up Excel object
oExcelObject = .NULL.
RELEASE oExcelObject

Listgrid - update 3

In this third update of the listgrid control, it is possible to change the grid's record source at run time. There is a new 'Open file' button in the example form that shows how.

Further, to solve the second issue in the post of july 30th, the width of the rightmost column in the grid is now changed to span the gap that normally appears when the total with of the visible columns are smaller than the grid's width. There is a new method Setrightmostcolumnwidth that takes care of this.

An updated download is available here (ZIP compressed file, 45 kb).

For more info about the Listgrid control, see the original post of July 16.

A resize grip on a Foxpro form

As a visual clue that a form can be resized, many forms have a 'resize grip' in the lower right corner. Visual Foxpro does not have native support for showing a resize grip on a form. But that won't stop us, we can make our own!

Over here you can download a zip file containing a resizer class. It's based on a container class and constructs it's own grip shape (Windows XP style). Just drop the class on a form and add This.resizer1.resize to the forms resize method. An example form is also included, which looks like this:

Images in a VFP grid class

In the listgrid class in this blog, it is possible to have different images in the cells of the same column in a grid. This is done using the DynamicCurrentControl feature and works great if there are only a few images.
When you have a lot of images to show, it seems like a bad idea to add even so much image controls to the grid column.
Luckily, there is another way to do the same. I found out about this here while working on the listgrid class. It works by creating a container class which is used as the control for the column. In the container class itself, you create an access method for the backstyle property of the container (open the class, go to the Class pad in the Foxpro menu, select Edit property/method and check the Access Method for the backstyle.
Then, in the access_method itself, you put code like This.picture = Mytable.Image, where Image is a text field in Mytable used as the grid recordsource. The text field contains the names of the images to use, which can be found on disk along the VFP path.

You can download an example here as a zip compressed file (9.6 Kb). Run the example form and look at the code in the example class. This is how it looks: