Calling external DLL made in Delphi

[robinnixon]

I was trying to find here some example of calling Delphi procedures from VFP and I didn't found anything. That's why I spent last weekend with VFP a Delphi together.

Before I'll show you my solution I want to tell you taht my task was to display 4-byte single data type in VFP. That's why I used it that way. I don't know how usefull it can be for you, but you can see in this example returning integer values, working with pointers and some other stuff...

Jakub
jakub.kasse@seznam.cz

------ Delphi source "dllProject.pas" ------

library dllProject;

uses
  SysUtils, dialogs;

var
 dllShowMessages : integer; // 0 = don't show messageboxes;

procedure dllMessage(strMess:string);
 begin
  if dllShowMessages<>0 then ShowMessage(strMess);
 end;

procedure dllStr(p:pointer); cdecl;
 // p should point to single-type variable and dllStr puts there PChar
 // calling application must prepare enough space before calling dllStr
 var
  pSingle : ^single;
  sNum : single;
  pString : PChar;
  strNum : string;
 begin
  dllMessage('begin dllStr()');
  pSingle := p;
  sNum := pSingle^;
  dllMessage('str in: '+FloatToStr(sNum));
  pString := p;
  str(sNum,strNum);
  dllMessage('str out: '+strNum);
  strcopy(pString,pchar(strNum));
  dllMessage('end dllStr()');
 end;

function dllVal(p:pointer):integer; cdecl;
 // p should point to  and dllVal puts there 4-byte Single
 // dllVal also returns error code
 var
  pString : PChar;
  valCode : integer;
  sNum : single;
  pSingle : ^single;
 begin
  dllMessage('begin dllVal()');
  pString := p;
  dllMessage('val in: '+pString);
  val(pString,sNum,valCode);
  dllVal := valCode;
  if valCode=0 then begin
   dllMessage('val out: '+FloatToStr(sNum));
   pSingle := p;
   pSingle^ := sNum;
  end else dllMessage('chyba pri prevodu '+pString);
  dllMessage('end dllVal()');
 end;

procedure dllShow(p:pointer); cdecl;
 // p should point to 4-byte Single and dllShow shows number in messagebox
 var
  pNum : ^single;
  sNum : single;
 begin
  dllMessage('begin dllShow()');
  pNum := p;
  sNum := pNum^;
  ShowMessage(FloatToStr(sNum));
  dllMessage('end dllShow()');
 end;

procedure dllSetDebug(iSet:integer); cdecl;
 begin
  dllShowMessages := iSet;
 end;

function dllGetDebug:integer; cdecl;
 begin
  dllGetDebug := dllShowMessages;
 end;

exports
 dllStr index 1,
 dllVal index 2,
 dllShow index 3,
 dllSetDebug index 4,
 dllGetDebug index 5;

begin
 dllShowMessages := 0;  // initially don't show debugging messages
end.

------ VFP source "dllFox.prg" ------

** jakub.kasse@seznam.cz
** delphi dll

dllFile = "d:\jakub\delphi\dll\dllProject.dll"
declare dllStr in (dllFile) string
declare integer dllVal in (dllFile) string
declare dllShow in (dllFile) string
declare dllSetDebug in (dllFile) integer
declare integer dllGetDebug in (dllFile)

local cString, nError
cString = "1.256e30" + ; && number we want to store in 4 bytes
        + chr(0) + ;     && zero-end for delphi PChar
        + space(50)      && and some space at the end, because I need it for dllStr
MessageBox(cString,"leaving VFP...")
nError = dllVal(@cString)
if nError#0 then
 MessageBox("error at position: "+ltrim(str(nError)),"...delphi returned error")
else
 && now we have single variable stored in first four bytes of cString
 dllSetDebug(1)
 dllShow(@cString)
 dllSetDebug(0)
 dllStr(@cString)
endif
MessageBox(cString,"...back in VFP")
clear dlls

------ end of example ------

 

[robinnixon]

Sorry, I forgot to say that I'm using VFP 5.0 and Delphi 3.0, maybe it is important to know that.

Jakub