Criar Dll (x)Harbour para utilização com Delphi/Lazarus

[asimoes]

Rochinha,

Não funcionou, a função hb_itemDoC espera que cText1, cText2 e cText3 sejam ponteiros.

[jairfab]

Eu conseguir criar a dll no xharbour 1.2.3 + hwgui e estou utilizando no delphi 7

Código: Selecionar todos

 @echo off

set HRB_DIR=c:\xharbour
set HWGUI_INSTALL=c:\xharbour

SET HB_MT=

SET C_DEFINES= 
SET H_DEFINES=

if not exist obj md obj

%HRB_DIR%\bin\harbour FUNCAO00.PRG %H_DEFINES% -n -i%HRB_DIR%\include;%HWGUI_INSTALL%\include %2 %3
bcc32 -v -y -c %C_DEFINES% -O2 -tW -M -I%HRB_DIR%\include;%HWGUI_INSTALL%\include FUNCAO00.c

%HRB_DIR%\bin\harbour FUNCAO04.PRG %H_DEFINES% -n -i%HRB_DIR%\include;%HWGUI_INSTALL%\include %2 %3
bcc32 -v -y -c %C_DEFINES% -O2 -tW -M -I%HRB_DIR%\include;%HWGUI_INSTALL%\include FUNCAO04.c

%HRB_DIR%\bin\harbour LFCODMUN.PRG %H_DEFINES% -n -i%HRB_DIR%\include;%HWGUI_INSTALL%\include %2 %3
bcc32 -v -y -c %C_DEFINES% -O2 -tW -M -I%HRB_DIR%\include;%HWGUI_INSTALL%\include LFCODMUN.c


%HRB_DIR%\bin\harbour LfNotas.PRG %H_DEFINES% -n -i%HRB_DIR%\include;%HWGUI_INSTALL%\include %2 %3
bcc32 -v -y -c %C_DEFINES% -O2 -tW -M -I%HRB_DIR%\include;%HWGUI_INSTALL%\include LfNotas.c

%HRB_DIR%\bin\harbour LFLANISS.PRG %H_DEFINES% -n -i%HRB_DIR%\include;%HWGUI_INSTALL%\include %2 %3
bcc32 -v -y -c %C_DEFINES% -O2 -tW -M -I%HRB_DIR%\include;%HWGUI_INSTALL%\include LFLANISS.c

%HRB_DIR%\bin\harbour LFBRWSER.PRG %H_DEFINES% -n -i%HRB_DIR%\include;%HWGUI_INSTALL%\include %2 %3
bcc32 -v -y -c %C_DEFINES% -O2 -tW -M -I%HRB_DIR%\include;%HWGUI_INSTALL%\include LFBRWSER.c

%HRB_DIR%\bin\harbour LFCADFOR.PRG %H_DEFINES% -n -i%HRB_DIR%\include;%HWGUI_INSTALL%\include %2 %3
bcc32 -v -y -c %C_DEFINES% -O2 -tW -M -I%HRB_DIR%\include;%HWGUI_INSTALL%\include LFCADFOR.c

%HRB_DIR%\bin\harbour %1.prg %H_DEFINES% -n -i%HRB_DIR%\include;%HWGUI_INSTALL%\include %2 %3
bcc32 -v -y -c %C_DEFINES% -O2 -tW -M -I%HRB_DIR%\include;%HWGUI_INSTALL%\include %1.c

echo c0d32.obj + > b32.bc
echo FUNCAO00.obj + >> b32.bc
echo FUNCAO04.obj + >> b32.bc
echo LfNotas.obj + >> b32.bc
echo LFCODMUN.obj + >> b32.bc
echo LFLANISS.obj + >> b32.bc
echo LFBRWSER.obj + >> b32.bc
echo LFCADFOR.obj + >> b32.bc
echo %1.obj, + >> b32.bc
echo %1.dll, + >> b32.bc
echo %1.map, + >> b32.bc
echo %HWGUI_INSTALL%\lib\hwgui.lib + >> b32.bc
echo %HWGUI_INSTALL%\lib\procmisc.lib + >> b32.bc
echo %HWGUI_INSTALL%\lib\hbxml.lib + >> b32.bc
echo %HWGUI_INSTALL%\lib\hwg_qhtm.lib + >> b32.bc
echo %HWGUI_INSTALL%\lib\hbactivex.lib + >> b32.bc
echo %HRB_DIR%\lib\rtl%HB_MT%.lib + >> b32.bc
echo %HRB_DIR%\lib\vm%HB_MT%.lib + >> b32.bc
if exist %HRB_DIR%\lib\gtgui.lib echo %HRB_DIR%\lib\gtgui.lib + >> b32.bc
if not exist %HRB_DIR%\lib\gtgui.lib echo %HRB_DIR%\lib\gtwin.lib + >> b32.bc
echo %HRB_DIR%\lib\lang.lib + >> b32.bc
echo %HRB_DIR%\lib\codepage.lib + >> b32.bc
echo %HRB_DIR%\lib\macro%HB_MT%.lib + >> b32.bc
echo %HRB_DIR%\lib\rdd%HB_MT%.lib + >> b32.bc
echo %HRB_DIR%\lib\dbfntx%HB_MT%.lib + >> b32.bc
echo %HRB_DIR%\lib\dbfcdx%HB_MT%.lib + >> b32.bc
echo %HRB_DIR%\lib\dbffpt%HB_MT%.lib + >> b32.bc
echo %HRB_DIR%\lib\common.lib + >> b32.bc
echo %HRB_DIR%\lib\debug.lib + >> b32.bc
echo %HRB_DIR%\lib\pp.lib + >> b32.bc
echo %HRB_DIR%\lib\hsx.lib + >> b32.bc
echo %HRB_DIR%\lib\hbsix.lib + >> b32.bc
if exist %HRB_DIR%\lib\pcrepos.lib echo %HRB_DIR%\lib\pcrepos.lib + >> b32.bc
if exist %HRB_DIR%\lib\hbole.lib echo %HRB_DIR%\lib\hbole.lib + >> b32.bc

echo cw32.lib + >> b32.bc
echo import32.lib, >> b32.bc
if exist lf.res echo lf.res + >> b32.bc
echo lf.res >> b32.bc
ilink32 -v -Gn -Tpd -aa @b32.bc

del *.tds
del *.c
del *.map
del *.obj
REM del b32.bc

[rochinha]

Amiguinhos,

**** M.A.R.A.V.I.L.H.E.U.S.A ****

[jastoneii]

Hi Everyone,

I have been agonizing over trying to convert a FoxPro .DLL to Harbour. Based on your posts here and elsewhere on the board I have been able to figure out how to do it! So, thank you all. I believe the problem that you were having updating a String field was because the .DLL was trying to increase the String field's length which will cause a memory error. Below is my code showing a string field being updated:

Calling .prg:

Código: Selecionar todos

#require "hbwin"
#require "hbxpp"

#include "simpleio.ch"
#include "dll.ch"
#include "hbdyn.ch"


 FUNCTION Main ()

 Local hDLL, strback
 StrToSet = "This is a test - origval"   //Note: I'm guessing that you have to initialize this field so that
                                         //it's length is >= the length of any string the .DLL may set it to!!
 ? "Before DLL loaded"
 hDLL := hb_libLoad( "DllTest2.dll" )
 IF ! Empty( hDLL )
  ? "DLL has been loaded"
  //hb_DynCall( { "C_TEST@8", hDLL, HB_DYN_CALLCONV_STDCALL }, "msg1", "msg2" )
  hb_DynCall( { "fpimport0@4", hDLL, HB_DYN_CALLCONV_STDCALL }, "TESTHB0" )
  ? "fpimport0@4 to TESTHB0 called"
  //hb_DynCall( { "fpimport1@8", hDLL, HB_DYN_CALLCONV_STDCALL }, "TESTHB1", "msg passed to dll" )
  hb_DynCall( { "fpimport1@8", hDLL, HB_DYN_CALLCONV_STDCALL }, "TESTHB1", @StrToSet )  //@ is needed here or field cannot be updated
  ? "fpimport1@8 to TESTHB1 called with StrToSet changed to", StrToSet

  hb_libFree( hDLL )
 endif
 return nil

.DLL code:

Código: Selecionar todos

//DLLTEST2.PRG
#pragma BEGINDUMP
        #include <stdio.h>
        #include <windows.h>
        #include <hbvm.h>
        #include <hbapi.h>
        #include <hbapiitm.h>

 //BOOL WINAPI DllEntryPoint( HINSTANCE hinstDLL, DWORD fdwReason, LPVOID lpvReserved )  !!THIS DOESN'T WORK
 BOOL WINAPI DllMain( HINSTANCE hinstDLL, DWORD fdwReason, LPVOID lpvReserved )       //This Works!
        {
         FILE *fileptr;
          HB_SYMBOL_UNUSED( hinstDLL );
          HB_SYMBOL_UNUSED( lpvReserved );
          switch( fdwReason )
           {
              case DLL_PROCESS_ATTACH:
                   MessageBox( 0, "We're in DLLMain", "1", 0 );
                   hb_vmInit( FALSE );
                   break;
              case DLL_PROCESS_DETACH:
                   hb_vmQuit();
                   break;
           }
           return TRUE;
        }

 HB_EXPORT void PASCAL _export fpimport0(char * cProcName)
 {
  hb_itemDoC (cProcName, 0, 0);
 }

 //Note that the second arg is char * const as we are being passed a pointer that
 //we DON'T want to change but we DO want to allow the value being pointed at the be changed
 HB_EXPORT char * PASCAL _export fpimport1( const char * cProcName, char * const cText1 )
        {
           char * stringoutptr;
           const char testc = "string back";
           PHB_ITEM pResult;
           PHB_ITEM pItem1;
           //hb_dynsymList();  //function I added to dynsym.c to list all callable functions
           pItem1 = hb_itemPutC( NULL, cText1 );
           pResult = hb_itemDoC( cProcName, 1, pItem1);
           MessageBox( 0, "We returned from Call to TESTHB1", "2", 0 );
           stringoutptr = hb_itemGetC( pResult );
           MessageBox( 0, stringoutptr, "3", 0 );
           strcpy(cText1, stringoutptr); //Here is where we a updating the original string field passed to the .dll
                                         //I'm guessing that we cannot increase the string length beyond what it was
                                         //originally

           hb_itemRelease( pItem1 );
           hb_itemRelease( pResult );
           MessageBox( 0, "We returned from Call to TESTHB1 3", "4", 0 );
           hb_retc(stringoutptr);
        }

#pragma ENDDUMP

#include "inkey.ch"
#include "fileio.ch"
#include "hbclass.ch"
#include "common.ch"

function TESTHB0
//creating a txt file to prove we entered Harbour function
set alternate to E:\EY\597harbour\dlltest\test0.dat
set alternate on
?
? "Inside testhb0()"
?
close alternate
return NIL

function TESTHB1(stringin)
//creating a txt file to prove we entered Harbour function
//this time we include the passed string in the txt file
//to prove we received it correctly
set alternate to E:\EY\597harbour\dlltest\test1.dat
set alternate on
?
? "Inside testhb1() with arg ",stringin
?
close alternate
return "Returned Value from TESTHB1"

I hope this is helpful for someone.

Regards,

Jeff

[rochinha]

Amiguinhos,

Thanks jastoneii,

This is very important to community.

Best Regards.

[jastoneii]

Someone pointed out a few errors that could cause a memory leak in fpimport1() in the .DLL. The function was previously declared as returning a char *. Also, I had left in the line:
hb_retc(stringoutptr);
from when I was playing around. So, here is cleaned up code for the .DLL that should not cause any memory leaks:

Código: Selecionar todos

//DLLTEST2.PRG
#pragma BEGINDUMP
        #include <stdio.h>
        #include <windows.h>
        #include <hbvm.h>
        #include <hbapi.h>
        #include <hbapiitm.h>

 //BOOL WINAPI DllEntryPoint( HINSTANCE hinstDLL, DWORD fdwReason, LPVOID lpvReserved )  !!THIS DOESN'T WORK
 BOOL WINAPI DllMain( HINSTANCE hinstDLL, DWORD fdwReason, LPVOID lpvReserved )       //This Works!
        {
         FILE *fileptr;
          HB_SYMBOL_UNUSED( hinstDLL );
          HB_SYMBOL_UNUSED( lpvReserved );
          switch( fdwReason )
           {
              case DLL_PROCESS_ATTACH:
                   MessageBox( 0, "We're in DLLMain", "1", 0 );
                   hb_vmInit( FALSE );
                   break;
              case DLL_PROCESS_DETACH:
                   hb_vmQuit();
                   break;
           }
           return TRUE;
        }

 HB_EXPORT void fpimport0(char * cProcName)
 {
  hb_itemDoC (cProcName, 0, 0);
 }

 //Note that the second arg is char * const as we are being passed a pointer that
 //we DON'T want to change but we DO want to allow the value being pointed at the be changed
 HB_EXPORT void fpimport1( const char * cProcName, char * const cText1 )
        {
           char * stringoutptr;
           const char testc = "string back";
           PHB_ITEM pResult;
           PHB_ITEM pItem1;
           //hb_dynsymList();  //function I added to dynsym.c to list all callable functions
           pItem1 = hb_itemPutC( NULL, cText1 );
           pResult = hb_itemDoC( cProcName, 1, pItem1);
           MessageBox( 0, "We returned from Call to TESTHB1", "2", 0 );
           stringoutptr = hb_itemGetC( pResult );
           MessageBox( 0, stringoutptr, "3", 0 );
           strcpy(cText1, stringoutptr); //Here is where we a updating the original string field passed to the .dll
                                         //I'm guessing that we cannot increase the string length beyond what it was
                                         //originally

           hb_itemRelease( pItem1 );
           hb_itemRelease( pResult );
           MessageBox( 0, "We returned from Call to TESTHB1 3", "4", 0 );
        }

#pragma ENDDUMP

#include "inkey.ch"
#include "fileio.ch"
#include "hbclass.ch"
#include "common.ch"

function TESTHB0
//creating a txt file to prove we entered Harbour function
//set alternate to E:\EY\597harbour\dlltest\test0.dat
set alternate to test0.dat
set alternate on
?
? "Inside testhb0()"
?
close alternate
return NIL

function TESTHB1(stringin)
//creating a txt file to prove we entered Harbour function
//this time we include the passed string in the txt file
//to prove we received it correctly
//set alternate to E:\EY\597harbour\dlltest\test1.dat
set alternate to test1.dat
set alternate on
?
? "Inside testhb1() with arg ",stringin
?
close alternate
return "Returned Value from TESTHB1"

Please note that I'm using MinGW to compile the .DLL and not BCC. The compilation command for the .DLL is:

Código: Selecionar todos

C:\hb32\bin\hbmk2.exe -workdir=E:\EY\597harbour\dlltest\temp -hbdynvm -trace -comp=mingw -map dlltest2

The compilation code for the calling program to test the .DLL is:

Código: Selecionar todos

C:\hb32\bin\hbmk2.exe -incpath=C:\hb32\contrib\hbxpp -debug -b -std calldlltest2 hbxpp.hbc 

I'm sorry for posting in English but I've noticed that sometimes Google translate and Bing translate alter code and comments in strange ways.

Regards,

Jeff

[asimoes]

Este exemplo de dll do jastoneii não consegui rodar a dll nem abre.