Problems Creating DLL in VFP 7.0

[MEGUIA]

Hi,

I've created a a custom dll in VFP 6.0 with procedures and everything, then I upgrade the program to VFP 7.0 but I find a bug and that is it's create the procedure as a method but it doesn't create the parametters. Here is the code just compile a single Dll. Any advice would be great.

Thanks for your support.



Define Class VFP_OLE_Server As Custom OlePublic

Procedure Init
*!* * The Procedure INIT is automatically
*!* * executed when the DLL is loaded.
CTALK = Set("Talk&quot
CSAFE = Set("Safe&quot
CEXCLUSIVE = Set("Exclusive&quot
CSAFETY = Set("SAFETY&quot
CCENTURY = Set("CENTURY&quot
Set Talk Off
Set Safe Off
Set Exclusive Off
Set Safety Off
Set Century On
Set Procedure To Sys(5) + "\TRAY\PROGRAMS\VFP1" Additive
*!* On Error Do Ole_Err With Error(),Lineno(),;
*!* Message(),Program()
On Error Do Ole_Err With Error(),Lineno(),;
Message(),Program()

Endproc

Procedure SetDir
Parameter cDir
Set Default To (m.cDir)
Endproc


Function ExeSql
Parameter cSql
Private nRecs,i,cFile,cFileSrc,cFullPath,;
cDestpath,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
**************************************
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 IndexOn
**-- Create Index Tags --*
Parameter cDBF,cKey,cTag,lDeleteTags
Use (m.cDBF) Exclusive In 0 Alias IndexDBF
Select IndexDBF
If m.lDeleteTags
Delete Tag All
Endif
Index On &cKey Tag &cTag
Use
Endproc

Procedure SetPath
Parameter cPath
Set Path To (m.cPath)
Endproc

Procedure FoxCommand
Parameter cCMD
&cCMD
Endproc

Function FoxFunction
Parameter cFunc
Private Rtn
Rtn = Eval(m.cFunc)
Return (m.Rtn)
Endfunc

Procedure Destroy
If CTALK
Set Talk On
Endif
If CSAFE
Set Safe On
Endif
If CEXCLUSIVE
Set Exclusive On
Endif
If CSAFETY
Set Safety On
Endif
Endproc

Procedure ADDFEEFIX
If Not Used('advrsary')
Use &quot;\\Usbc_pr00\Apps\Courtapps\dbase3\bankdata\advrsary&quot;
Endif
Sele advrsary
Set Filter To Empty(filfeepaid)
Repl filfeepaid With 'N' All
Use
Return(1)
Endproc

Procedure CopyFles
Parameters SrcPath, DstPath
Private FullCmd

FullCmd = &quot;&quot;

FullCmd = &quot;xcopy &quot; + SrcPath + &quot; &quot; + DstPath + &quot; /E /C /Q /H /R /Y &quot;

loWshShell = Createobject(&quot;WScript.Shell&quot

** xcopy is the program to run
** ls_fullname is the variable holding thr filename with fullpath
** ln_rtnval <> 0 means successful run

ln_rtnval=loWshShell.Run(FullCmd, 0, .T.)
Endproc

Procedure CALMAINT
Do SetDir1 With &quot;\\Usbc_pr00\Apps\Courtapps\CALENDAR\PROG40&quot;
Do CALEINIT
Return(1)
Endproc

Procedure caresval
*Set path to SYS(5) & &quot;\newreg&quot;
Set Default To &quot;\\Usbc_pr00\Apps\courtapps\NEWREG&quot;
Use Setup
prefix = Substr(Str(Year(Date()+1),4),3,2)
If Month(Date()) = 12 And Day(Date())= 31
If Substr(casenum,1,2) <> prefix
Replace casenum With prefix+&quot;-00000&quot;
Replace Advnum With prefix+&quot;-00000&quot;
caso = prefix+&quot;-00000&quot;
?caso
Wait
Endif
Endif
Endproc

Procedure open_excl
On Error Store .T. To file_error

If m.again
Select &file_again
Use
Endif

Select &file_name
Use
Use &File In 0 Alias &Alias Exclusive

*!* * ON ERROR DO fatal WITH PROGRAM(),LINENO(),MESSAGE(),;
*!* MESSAGE(1), ERROR()
Endproc

Procedure open_reg
Use &File In 0 Alias &Alias

If m.again
Use &File In 0 Alias &file_again Again
Endif
Endproc

Procedure CALUAPPT
Do SetDir1 With &quot;\\Usbc_pr00\Apps\Courtapps\CALENDAR\PROG40&quot;
Do CALUAPTT
Endproc

Procedure DBFMERGE
Do SetDir1 With &quot;\\Usbc_pr00\Apps\Courtapps\COURTCST&quot;
Do DBFMERGE
Endproc


Procedure UST
Do UST
Endproc


Procedure AUTOPSC
*Parameters startdt, enddt
Do SetDir1 With &quot;\\Usbc_pr00\Apps\Courtapps\SYTOS\PACERFTP&quot;
Do AUTOPSC With &quot;%1&quot;, &quot;%2&quot;
Endproc
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
*-- Cancel causes Delphi or VB to raise an
*-- error.
Hide Window Screen
*-- The CANCEL command causes Delphi
*-- to be able to trap the error.
Cancel
Endif
Endproc

 

[rgbean]

If you mean properties rather than parameters, you probably want to change your code to:

Define Class VFP_OLE_Server As Custom OlePublic
   CTALK = ""
   CSAFE = ""
   CEXCLUSIVE = ""
   CSAFETY = ""
   CCENTURY = ""

Procedure Init
        *!*    * The Procedure INIT is automatically
        *!*    * executed when the DLL is loaded.
        This.CTALK = Set("Talk")
        This.CSAFE = Set("Safe")
        This.CEXCLUSIVE = Set("Exclusive")
        This.CSAFETY = Set("SAFETY")
        This.CCENTURY = Set("CENTURY")
...

    Procedure Destroy
        If This.CTALK = "ON"
            Set Talk On
        Endif
        If This.CSAFE = "ON"
            Set Safe On
        Endif
        If This.CEXCLUSIVE = "ON"
            Set Exclusive On
        Endif
        If This.CSAFETY = "ON"
            Set Safety On
        Endif
        If This.CCENTURY = "ON"
            Set Century On
        Endif
    Endproc

Rick

 

[MEGUIA]

Hi,

Thanks for your answer, but the problem it's this one, I compile the project as a dll so I can call it it VB, it' complie fine but it's leave out the parameters insisde my methods or procedures. You can see it in the object browser after you compile it. Ex

Procedure CopyFles
*--------
Parameters SrcPath, DstPath

Private FullCmd

FullCmd = &quot;&quot;

FullCmd = &quot;xcopy &quot; + SrcPath + &quot; &quot; + DstPath &quot; /E /C /Q /H /R /Y &quot;

loWshShell = Createobject(&quot;WScript.Shell&quot

** xcopy is the program to run
** ls_fullname is the variable holding thr filename with ** Fullpath
ln_rtnval=loWshShell.Run(FullCmd, 0, .T.)
Endproc


Thank you

 

[MEGUIA]

Hi,

THe correct way to create the method with parameters it's this:

Function CopyFles(SrcPath, DstPath)
* Parameters SrcPath, DstPath
Private FullCmd
FullCmd = &quot;&quot;
FullCmd = &quot;xcopy &quot; + SrcPath + &quot; &quot; + DstPath + &quot; /E /C /Q /H /R /Y &quot;

loWshShell = Createobject(&quot;WScript.Shell&quot
** xcopy is the program to run
** ls_fullname is the variable holding thr filename with fullpath
** ln_rtnval <> 0 means successful run
ln_rtnval=loWshShell.Run(FullCmd, 0, .T.)
Endfunc

THe compile your project as Single Dll.

Thanks for your support

 

[craigsboyd]

Meguia,

You just beat me to it, well done! I went and tried it and saw what you were talking about with the parameters, and the first thing I tried was what you outlined above, but I was a little too late. Strange that the builder for building the VFP DLL doesn't see and compile the parameters line correctly as you had it before the correction. I wonder if the source for that builder is in the xsource folder and maybe a person could see what is coded wrong in there or the reason for the exclusion, since they went to all that trouble to put an astericks in front of your parameters line.

Slighthaze = NULL