Speedy Access to FoxPro Data from Delphi
When Borland announced that Delphi 3 was going to have FoxPro DBF/CDX drivers, there was some excitement from FoxPro developers who were attempting to migrate
their applications to Delphi. The excitement was short-lived, however, when they realized that the drivers didn't have the same punch as their native cousin.
The small OLE DLL presented in this article might be the bridge that finally brings the two together.
I recently developed an application for our company in Delphi 3 that reads the tables in our FoxPro DOS legacy system. Everything went fine in beta, so we
started to distribute the application to our clients. There was, however, one oversight. We never tested the system against tables that were highly populated.
When we installed the application at one of our largest client sites, the application fell to its knees and died. The problem: The BDE was attempting some complex
queries using Local SQL against a table that had approximately 2 million records in it. Our client informed us that queries were taking as much as 72 hours to
complete. This of course was not acceptable, so I started to investigate alternate ways of running the queries. The result was a Visual FoxPro (VFP) OLE object in
the form of a DLL that runs the queries (or almost any FoxPro command) from within Delphi, transparently, and with the speed of Rushmore. Using this technology,
the query time dropped from hours to seconds.
For those who are not familiar with Visual FoxPro, it has a feature called Macro Substitution, which is the basis for the OLE DLL. Macro Substitution treats the
contents of a memory variable as a literal character string. When an ampersand (&
precedes a string type memory variable, the contents of the variable is treated
just like a hand-typed command, and is executed.
The code for the VFP OLE DLL is actually very simple, and can contain as little as a single procedure or function. I chose to write a few procedures that were
specific to the application, but also included some generic ones that might be used by any application. For the sake of simplicity, I抳e included only the generic
procedures and functions in the code below.
**************************************
* Program: VFP_OLE.PRG
* Visual FoxPro 5 OLE DLL
**************************************
DEFINE CLASS VFP_OLE_Server AS CONTAINER OLEPUBLIC
Procedure Init
* The Procedure INIT is automatically
* executed when the DLL is loaded.
Set Talk Off
Set Safe Off
On Error Do Ole_Err With Error(),Lineno(),Message(),Program()
Set Exclusive Off
Set Null On
*****************************************
*-- If CPDIALOG is ON and a DBF that was
*-- created without a CodePage is opened,
*-- the CodePage Dialog Box will confront
*-- the user.
*****************************************
SET CPDIALOG OFF
*
Set Reprocess To 1
*
* Move Foxpro main screen way off to the bit-bucket
* so it will not be seen if it is made visible.
Move Window Screen To -1000,-1000
Modify Window Screen Title "VFP OLE"
Hide Window Screen
EndProc
Procedure SetDir
Parameter cDir
Set Default to (m.cDir)
EndProc
Function ExeSql
Parameter cSql
Private nRecs,i,cFile,cFileSrc,cFullPath,;
cDestpath,cAlias,IsVFPFile,;
cDbfFileName,nHandle
lIsVFPFile = .F.
cFullPath = Set('FullPath')
*
* Show Main VFP Window so File
* dialog box will be visible
* if VFP can't find a file that
* is needed for the SQL command.
*
Show Window Screen
*
*-- Execute SQL Statement --*
*
cSql = AllTrim(m.cSql)
&cSql
*
Hide Window Screen
*
nRecs = _Tally
*
Set FullPath On
cFileSrc = DBF()
Use
**************************************
*-- Check TableType.
*-- If Type Is Visual FoxPro Convert
*-- to Fox2x.
*-- The BDE doesn't support VFP tables
**************************************
nHandle = FOpen(m.cFileSrc)
If nHandle <> -1
lIsVFPFile = (FGets(m.nHandle,1)=Chr(48))
=FClose(m.nHandle)
Endif
Use (m.cFileSrc) Exclusive
cDestPath = left(dbf(),rat('/',dbf()))
If m.lIsVFPFile
*-- Convert Result To Fox2x Format --*
cFile = 'T'+right(sys(3),7)
Copy To (m.cDestPath+m.cFile) Type Fox2x
Use
Erase (m.cFileSrc)
If File(Left(m.cFileSrc,;
Len(m.cFileSrc)-4)+'.FTP')
Erase (Left(m.cFileSrc,;
Len(m.cFileSrc)-4)+'.FTP')
Endif
Rename (m.cDestPath+m.cFile+'.DBF') ;
TO (m.cFileSrc)
If File(m.cDestPath+m.cFile+'.FPT')
Rename (m.cDestPath+m.cFile+'.FPT');
TO (Left(m.cFileSrc,;
Len(m.cFileSrc)-4)+'.FTP')
Endif
Use (m.cFileSrc) Exclusive
Endif
*-- Restore FullPath Setting --*
Set FullPath &cFullPath
**-- Return Result Record Count --**
Return (m.nRecs)
EndFunc
Procedure SetPath
Parameter cPath
Set Path To (m.cPath)
EndProc
Procedure FoxCommand
Parameter cCMD
&cCMD
EndProc
Function FoxFunction
Parameter cFunc
Private Rtn
Rtn = &cFunc
Return (m.Rtn)
EndFunc
ENDDEFINE
Procedure Ole_Err
**-- Handle DLL internal Errors --**
Parameter nErr,nLine,cMessage,cPRG
IF (m.nErr=1707)
*-- CDX not present, OK to Retry --*
Retry
Else
MessageBox( m.cMessage+Chr(13)+Chr(13)+;
'Error# '+str(m.nErr,5)+Chr(13)+;
'At Line#'+Str(m.nLine,5)+Chr(13)+;
'In '+m.cPrg+chr(13)+Chr(13)+;
'See File:OLE_ERR.TXT for details.';
,16,'ERROR in VFP_OLE.DLL Module')
*
*-- Dump Memory and File Status To Text File.
*
Create Cursor OleError (ErrText M(10))
List Status NoConsole To File OLE_STAT.TMP
List Memory Like * NoConsole To File OLE_MEM.TMP
Append Blank
Replace ErrText With ;
Replicate('*',80)+Chr(13)+Chr(10)+;
DTOC(Date())+' '+Time()+;
Chr(13)+Chr(10)+;
PadC(' STATUS ',80,'*')+;
Chr(13)+Chr(10)
Append Memo ErrText From OLE_STAT.TMP
Replace ErrText With Chr(13)+Chr(10)+;
PadC(' MEMORY ',80,'*')+;
Chr(13)+Chr(10) Addi
Append Memo ErrText From OLE_MEM.TMP
Replace ErrText With Chr(13)+Chr(10)+;
PadC('-- End Error --',80,'*')+;
Chr(13)+Chr(10) Addi
If File('OLE_ERR.TXT')
Copy Memo ErrText To OLE_ERR.TXT Addi
Else
Copy Memo ErrText To OLE_ERR.TXT
Endif
Erase OLE_STAT.TMP
Erase OLE_MEM.TMP
*
Close Data
Hide Window Screen
*-- The CANCEL command causes Delphi
*-- to be able to trap the error.
Cancel
*
Endif
EndProc
*:EOF(VFP_OLE.PRG)