Creation of xHarbour PCODE DLL succeeded

[Antonio Linares]

Babu,

I have just used xHarbour build 1.2.1 (SimpLex) (Rev. 9411) from buildxd.bat to build the DLL and buildx.bat to build the EXE and worked fine here

buildxd.bat

Code: Select all  Expand view

@ECHO OFF
CLS
ECHO ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
ECHO ³ FiveWin for xHarbour 11.09 - Sep. 2011          xHarbour development power ³Ü
ECHO ³ (c) FiveTech, 1993-2011     for Microsoft Windows 9X/NT/200X/ME/XP/Vista/7 ³Û
ECHO ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙÛ
ECHO ÿ ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß

if A%1 == A GOTO :SINTAX
if NOT EXIST %1.prg GOTO :NOEXIST

ECHO Building self contained DLL
ECHO Compiling...

if "%FWDIR%" == "" set FWDIR=.\..\
if "%XHDIR%" == "" set XHDIR=c:\xharbour
rem if "%2" == "/b" set GT=gtwin
rem if not "%2" == "/b" set GT=gtgui
set GT=gtgui

set hdir=%XHDIR%
set hdirl=%hdir%\lib
set bcdir=c:\bcc582
set fwh=%FWDIR%

%hdir%\bin\harbour %1 /n /i%fwh%\include;%hdir%\include /w /p %2 %3 > comp.log
IF ERRORLEVEL 1 GOTO COMPILEERRORS
@type comp.log

echo -O2 -e%1.exe -I%hdir%\include -I%bcdir%\include %1.c > b32.bc
%bcdir%\bin\bcc32 -M -c -v @b32.bc
:ENDCOMPILE

IF EXIST %1.rc %bcdir%\bin\brc32 -r -I%bcdir%\include %1

echo %bcdir%\lib\c0d32.obj + > b32.bc
echo %1.obj, + >> b32.bc
echo %1.dll, + >> b32.bc
echo %1.map, + >> b32.bc
echo %fwh%\lib\Fivehx.lib %fwh%\lib\FiveHC.lib + >> b32.bc
echo %hdirl%\rtl.lib + >> b32.bc
echo %hdirl%\vm.lib + >> b32.bc
echo %hdirl%\%GT%.lib + >> b32.bc
echo %hdirl%\lang.lib + >> b32.bc
echo %hdirl%\macro.lib + >> b32.bc
echo %hdirl%\rdd.lib + >> b32.bc
echo %hdirl%\dbfntx.lib + >> b32.bc
echo %hdirl%\dbfcdx.lib + >> b32.bc
echo %hdirl%\dbffpt.lib + >> b32.bc
echo %hdirl%\hbsix.lib + >> b32.bc
echo %hdirl%\debug.lib + >> b32.bc
echo %hdirl%\common.lib + >> b32.bc
echo %hdirl%\pp.lib + >> b32.bc
echo %hdirl%\pcrepos.lib + >> b32.bc
echo %hdirl%\ct.lib + >> b32.bc
echo %hdirl%\zlib.lib + >> b32.bc
echo %hdirl%\hbzip.lib + >> b32.bc

rem Uncomment these two lines to use Advantage RDD
rem echo %hdir%\lib\rddads.lib + >> b32.bc
rem echo %hdir%\lib\Ace32.lib + >> b32.bc

echo %bcdir%\lib\cw32.lib + >> b32.bc
echo %bcdir%\lib\import32.lib + >> b32.bc
echo %bcdir%\lib\uuid.lib + >> b32.bc
echo %bcdir%\lib\psdk\odbc32.lib + >> b32.bc
echo %bcdir%\lib\psdk\rasapi32.lib + >> b32.bc
echo %bcdir%\lib\psdk\nddeapi.lib + >> b32.bc
echo %bcdir%\lib\psdk\msimg32.lib + >> b32.bc
echo %bcdir%\lib\psdk\psapi.lib + >> b32.bc
echo %bcdir%\lib\psdk\gdiplus.lib + >> b32.bc
echo %bcdir%\lib\psdk\iphlpapi.lib, >> b32.bc

IF EXIST %1.res echo %1.res >> b32.bc

rem uncomment this line to use the debugger and comment the following one
rem if %GT% == gtwin %bcdir%\bin\ilink32 -Gn -Tpe -s -v @b32.bc
rem IF ERRORLEVEL 1 GOTO LINKERROR
if %GT% == gtgui %bcdir%\bin\ilink32 -Gn -Tpd -s -v @b32.bc
IF ERRORLEVEL 1 GOTO LINKERROR
ECHO * DLL successfully built *
GOTO EXIT
ECHO

rem delete temporary files
@del %1.c

:COMPILEERRORS
@type comp.log
ECHO * Compile errors *
GOTO EXIT

:LINKERROR
ECHO * Linking errors *
GOTO EXIT

:SINTAX
ECHO    SYNTAX: Build [Program]     {-- No especifiques la extensi¢n PRG
ECHO                                {-- Don't specify .PRG extension
GOTO EXIT

:NOEXIST
ECHO The specified PRG %1 does not exist

:EXIT

buildx.bat

Code: Select all  Expand view

@ECHO OFF
CLS
ECHO ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
ECHO ³ FiveWin for xHarbour 11.10 - Oct. 2011          xHarbour development power ³Ü
ECHO ³ (c) FiveTech, 1993-2011     for Microsoft Windows 9X/NT/200X/ME/XP/Vista/7 ³Û
ECHO ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙÛ
ECHO ÿ ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß

if A%1 == A GOTO :SINTAX
if NOT EXIST %1.prg GOTO :NOEXIST

ECHO Compiling...

if "%FWDIR%" == "" set FWDIR=.\..\
if "%XHDIR%" == "" set XHDIR=c:\xharbour
rem if "%2" == "/b" set GT=gtwin
rem if not "%2" == "/b" set GT=gtgui
set GT=gtgui

set hdir=%XHDIR%
set hdirl=%hdir%\lib
set bcdir=c:\bcc582
set fwh=%FWDIR%

%hdir%\bin\harbour %1 /n /i%fwh%\include;%hdir%\include /w /p %2 %3 > comp.log
IF ERRORLEVEL 1 GOTO COMPILEERRORS
@type comp.log

echo -O2 -e%1.exe -I%hdir%\include -I%bcdir%\include %1.c > b32.bc
%bcdir%\bin\bcc32 -M -c -v @b32.bc
:ENDCOMPILE

IF EXIST %1.rc %bcdir%\bin\brc32 -r -I%bcdir%\include %1

echo %bcdir%\lib\c0w32.obj + > b32.bc
echo %1.obj, + >> b32.bc
echo %1.exe, + >> b32.bc
echo %1.map, + >> b32.bc
echo %fwh%\lib\Fivehx.lib %fwh%\lib\FiveHC.lib + >> b32.bc
echo %hdirl%\rtl.lib + >> b32.bc
echo %hdirl%\vm.lib + >> b32.bc
echo %hdirl%\%GT%.lib + >> b32.bc
echo %hdirl%\lang.lib + >> b32.bc
echo %hdirl%\macro.lib + >> b32.bc
echo %hdirl%\rdd.lib + >> b32.bc
echo %hdirl%\dbfntx.lib + >> b32.bc
echo %hdirl%\dbfcdx.lib + >> b32.bc
echo %hdirl%\dbffpt.lib + >> b32.bc
echo %hdirl%\hbsix.lib + >> b32.bc
echo %hdirl%\debug.lib + >> b32.bc
echo %hdirl%\common.lib + >> b32.bc
echo %hdirl%\pp.lib + >> b32.bc
echo %hdirl%\pcrepos.lib + >> b32.bc
echo %hdirl%\ct.lib + >> b32.bc
echo %hdirl%\zlib.lib + >> b32.bc
echo %hdirl%\hbzip.lib + >> b32.bc

rem Uncomment these two lines to use Advantage RDD
rem echo %hdir%\lib\rddads.lib + >> b32.bc
rem echo %hdir%\lib\Ace32.lib + >> b32.bc

echo %bcdir%\lib\cw32.lib + >> b32.bc
echo %bcdir%\lib\import32.lib + >> b32.bc
echo %bcdir%\lib\uuid.lib + >> b32.bc
echo %bcdir%\lib\psdk\odbc32.lib + >> b32.bc
echo %bcdir%\lib\psdk\rasapi32.lib + >> b32.bc
echo %bcdir%\lib\psdk\nddeapi.lib + >> b32.bc
echo %bcdir%\lib\psdk\msimg32.lib + >> b32.bc
echo %bcdir%\lib\psdk\psapi.lib + >> b32.bc
echo %bcdir%\lib\psdk\gdiplus.lib + >> b32.bc
echo %bcdir%\lib\psdk\iphlpapi.lib, >> b32.bc

IF EXIST %1.res echo %1.res >> b32.bc

rem uncomment this line to use the debugger and comment the following one
if %GT% == gtwin %bcdir%\bin\ilink32 -Gn -Tpe -s -v @b32.bc
IF ERRORLEVEL 1 GOTO LINKERROR
if %GT% == gtgui %bcdir%\bin\ilink32 -Gn -aa -Tpe -s -v @b32.bc
IF ERRORLEVEL 1 GOTO LINKERROR
ECHO * Application successfully built *
%1
GOTO EXIT
ECHO

rem delete temporary files
@del %1.c

:COMPILEERRORS
@type comp.log
ECHO * Compile errors *
GOTO EXIT

:LINKERROR
ECHO * Linking errors *
GOTO EXIT

:SINTAX
ECHO    SYNTAX: Build [Program]     {-- No especifiques la extensi¢n PRG
ECHO                                {-- Don't specify .PRG extension
GOTO EXIT

:NOEXIST
ECHO The specified PRG %1 does not exist

:EXIT

babu.prg

Code: Select all  Expand view

// Using Harbour DLLs
// To build BabuDLL.dll do: buildhd.bat babuDLL

#include "FiveWin.ch"

static hDLL

function Main()

   local hItem1 := ItemNew( "Hello world!" )
   local hItem2 := ItemNew( "From a Harbour DLL" )

   hDLL = LoadLibrary( "babudll.dll" )

   HbDllEntry( "TEST" )

   HbDLLEntry2( "TEST2", hItem1, hItem2 )
   
   ItemRelease( hItem1 )
   ItemRelease( hItem2 )
   
   MsgInfo( "back from EXE" )
   
   FreeLibrary( hDLL )

return nil

DLL FUNCTION HBDLLENTRY( cProc AS LPSTR ) AS LONG PASCAL LIB hDLL

DLL FUNCTION HBDLLENTRY2( cProc AS LPSTR, pItem1 AS LONG, pItem2 AS LONG ) AS LONG PASCAL LIB hDLL

#pragma BEGINDUMP

#include <hbapi.h>
#include <hbapiitm.h>

HB_FUNC( ITEMNEW )
{
   hb_retnl( ( unsigned long ) hb_itemNew( hb_param( 1, HB_IT_ANY ) ) );
}

HB_FUNC( ITEMRELEASE )
{
   hb_retl( hb_itemRelease( ( PHB_ITEM ) hb_parnl( 1 ) ) );
}

#pragma ENDDUMP    

babudll.prg

Code: Select all  Expand view

// To build BabuDLL.dll do: buildhd.bat babuDLL

// To run this DLL, do buidh.bat Babu.prg

function Test()

   MsgInfo( "Hello from inside the DLL!" )
   
return nil  

function Test2( cMsg1, cMsg2 )

   MsgInfo( cMsg1, cMsg2 )

return nil

#pragma BEGINDUMP

#include <windows.h>
#include <hbvm.h>
#include <hbapiitm.h>

BOOL WINAPI DllEntryPoint( HINSTANCE hinstDLL, DWORD fdwReason,
                           LPVOID lpvReserved )
{
   HB_SYMBOL_UNUSED( hinstDLL );
   HB_SYMBOL_UNUSED( fdwReason );
   HB_SYMBOL_UNUSED( lpvReserved );

   switch( fdwReason )
   {
      case DLL_PROCESS_ATTACH:
           MessageBox( 0, "DLL properly loaded", "DLL entry", 0 );
           hb_vmInit( 0 );
           break;

      case DLL_PROCESS_DETACH:
           MessageBox( 0, "DLL unloaded", "DLL exit", 0 );
           break;
   }      
   
   return TRUE;
}

void pascal __export HBDLLENTRY( char * cProcName )
{
   hb_itemDoC( cProcName, 0 );
}  

void pascal __export HBDLLENTRY2( char * cProcName, PHB_ITEM pParam1, PHB_ITEM pParam2 )
{
   hb_itemDoC( cProcName, 2, pParam1, pParam2 );
}  

#pragma ENDDUMP

All the xHarbour files, EXE and DLL are available from here:
http://code.google.com/p/fivewin-contributions/downloads/detail?name=babudllx.zop&can=2&q=

[RAMESHBABU]

Mr.Antonio,

Finally you have gifted us the solution to create xHarbour PCODE Dll Creation.
I could create sucessfully the BABUDLL.DLL and BABU.EXE with the sources,
you have just released.

Now the Subject of this thread got its real meaning

Many many thanks and Regards,

- Ramesh Babu P

[Marco Turco]

It works fine. Great work Antonio !!

Just a small problem:
I need to add into babudll a function named "ExecuteAll" that is automatically called from a c++ DLL for security purpose.
I should return from the "ExecuteAll" function .t. or .f. Any ideas how declare this function in babudll ? I made some tests but unsuccesfully.

These are a sample of how to declare this function with other languages:

Delphi:
function ExecuteAll() : Boolean; export;

C++:
BOOL __declspec(dllexport) ExecuteAll();

Any help ? Thanks in advance.

[Antonio Linares]

Marco,

In babudll.prg add this code:

Code: Select all  Expand view

BOOL __stdcall __export ExecuteAll( void )
{
   MessageBox( 0, "ExecuteAll()", "ok", 0 );
   
   return TRUE;
}

And in babu.prg add this:

Code: Select all  Expand view

  hDLL = LoadLibrary( "babudll.dll" )
   
   
   ExecuteAll()

   ...

DLL FUNCTION ExecuteAll() AS BOOL PASCAL LIB hDLL

To check that everything is fine, we do: c:\bcc582\bin\impdef.exe babudll.def babudll.dll
and we get an ascii babudll.def with:

Code: Select all  Expand view

LIBRARY     BABUDLL.DLL

EXPORTS
    ExecuteAll                     @3   ; ExecuteAll
    HBDLLENTRY                     @1   ; HBDLLENTRY
    HBDLLENTRY2                    @2   ; HBDLLENTRY2
    __DbgWndProc                   @5   ; __DbgWndProc
    __WndProc                      @4   ; __WndProc
    ___CPPdebugHook                @6   ; ___CPPdebugHook

So ExecuteAll() has been properly exported in sensitive case with no underscore in front thanks to the __stdcall clause

[Marco Turco]

Hi Antonio,
the function is correctly called from the external c++ application. Great !
The only problem still remain is that I need ExecuteAll return .t. or .f. based on some fwh code I have directly in the dll.
To be clear in this sample ExecuteAll should call CheckPassword that return true or false if the password condition is verified or not
but the error "Checkpassword" has not prototipe in function ExecuteAll appears.


-------

// To build BabuDLL.dll do: buildhd.bat babuDLL

// To run this DLL, do buidh.bat Babu.prg

function CheckPassword()
local cVar

cVar:=space(10)
if .not. MsgGet("Password",,@cVar)
return(.f.)
endif
if alltrim(upper(cVar))<>"LONDON"
msginfo("Wrong password")
return(.f.)
endif
return(.t.)

#pragma BEGINDUMP

#include <windows.h>
#include <hbvm.h>
#include <hbapiitm.h>

BOOL WINAPI DllEntryPoint( HINSTANCE hinstDLL, DWORD fdwReason,
LPVOID lpvReserved )
{
HB_SYMBOL_UNUSED( hinstDLL );
HB_SYMBOL_UNUSED( fdwReason );
HB_SYMBOL_UNUSED( lpvReserved );

switch( fdwReason )
{
case DLL_PROCESS_ATTACH:
MessageBox( 0, "DLL properly loaded", "DLL entry", 0 );
hb_vmInit( 0 );
break;

case DLL_PROCESS_DETACH:
MessageBox( 0, "DLL unloaded", "DLL exit", 0 );
break;
}

return FALSE;
}

void pascal __export HBDLLENTRY( char * cProcName )
{
hb_itemDoC( cProcName, 0 );
}

void pascal __export HBDLLENTRY2( char * cProcName, PHB_ITEM pParam1, PHB_ITEM pParam2 )
{
hb_itemDoC( cProcName, 2, pParam1, pParam2 );
}


BOOL __stdcall __export ExecuteAll( void )
{
return(CheckPassword())
}


#pragma ENDDUMP

[Antonio Linares]

Marco,

Do it this way:

Code: Select all  Expand view

BOOL __stdcall __export ExecuteAll( void )
{
   hb_itemDoC( "CHECKPASSWORD", 0 );
   return hb_parl( -1 );
}
 

[Marco Turco]

Hi,
the checkpassword function is correctly called. Thank you.
The only problem is that instead of return hb_parl( -1 ) ExecuteAll should return the logic value from checkpassword. Do you think it could be possible ?
Thanks in advance.

[Antonio Linares]

Marco,

hb_parl( -1 ) is retrieving the logical value returned by CheckPassword()

[Marco Turco]

Hi Antonio,
I tried but it seems hb_parl(-1) doesn't return a logic value or anyway the value is not TRUE.

The external application that call babudll recognize TRUE only if I use "return TRUE" instead of "returnhb_parl(-1)" into ExecAll.

This is a semplified self-contained sample that should return always true but isn't it.

Any ideas ? It seems a very strange issue.

Thanks in advance.

-------------------

// To build BabuDLL.dll do: buildhd.bat babuDLL
// To run this DLL, do buidh.bat Babu.prg

function CheckPassword()
local cVar,lReturn

RETURN(.T.)

#pragma BEGINDUMP

#include <windows.h>
#include <hbvm.h>
#include <hbapiitm.h>

BOOL WINAPI DllEntryPoint( HINSTANCE hinstDLL, DWORD fdwReason,
LPVOID lpvReserved )
{
HB_SYMBOL_UNUSED( hinstDLL );
HB_SYMBOL_UNUSED( fdwReason );
HB_SYMBOL_UNUSED( lpvReserved );

switch( fdwReason )
{
case DLL_PROCESS_ATTACH:
MessageBox( 0, "DLL properly loaded", "DLL entry", 0 );
hb_vmInit( 0 );
break;

case DLL_PROCESS_DETACH:
MessageBox( 0, "DLL unloaded", "DLL exit", 0 );
break;
}

return FALSE;
}

void pascal __export HBDLLENTRY( char * cProcName )
{
hb_itemDoC( cProcName, 0 );
}

void pascal __export HBDLLENTRY2( char * cProcName, PHB_ITEM pParam1, PHB_ITEM pParam2 )
{
hb_itemDoC( cProcName, 2, pParam1, pParam2 );
}

BOOL __stdcall __export ExecuteAll( void )
{
hb_itemDoC( "CHECKPASSWORD", 0 );
return hb_parl(-1);
}

#pragma ENDDUMP

[Antonio Linares]

Marco,

This is working fine

Code: Select all  Expand view

BOOL __stdcall __export ExecuteAll( void )
{
   PHB_ITEM pResult = hb_itemDoC( "CHECKPASSWORD", 0 );
   
   return pResult->item.asLogical.value;
}
 

or simpler:

Code: Select all  Expand view

BOOL __stdcall __export ExecuteAll( void )
{
   return hb_itemGetL( hb_itemDoC( "CHECKPASSWORD", 0 ) );
}

[Marco Turco]

Yes, it's fine
Thank you very much for your quick and professional support.