Creating a LIB or DLL

[Dave Zowasky]

Hello to all,

I have been working on creating either a linkable LIB or DLL with using Harbour

I have had some success with these examples in creating a DLL

viewtopic.php?f=3&t=863&hilit=macrcall.c&start=15

However I have run into a couple of issues that I would like to run past all my friends here.

1) Can a Harbour Self contained DLL return values to the calling program?

2) When I run my DLL it returns and terminates the harbour application that calls it.

3) Is there a way to create a linkable self contained .LIB using harbour?


Thanks Much.
Dave

[Antonio Linares]

Dave,

> 1) Can a Harbour Self contained DLL return values to the calling program?

Yes. Harbour is built using C code, so we have the freedom to do whatever we may want to do with it

> 2) When I run my DLL it returns and terminates the harbour application that calls it.

That means that the system is crashing. Probably the EXE to DLL stack is unbalanced, so the system protects itself finishing the EXE and the DLL. How are you calling the DLL ? Please post some code so we can provide you some more help.

> 3) Is there a way to create a linkable self contained .LIB using harbour?

Do you mean a LIB to be used from non Harbour EXEs ? Or from Harbour EXEs ?

[Dave Zowasky]

Antonio,

I have cleaned up my examples to post here, and I think I see what you are
saying about the crash.

Regarding the .lib , I would be thinking on non harbour exes if it is practical.

Here is the code I am testing.


Thanks
Dave


First my fivewin code:

Code: Select all  Expand view

****************************************** testdll1.prg
#include "FiveWin.ch"
FUNCTION Main()
local x:=""
local dllhan
**
dllhan := LoadLib32("test1.dll")
?dlla(dllhan,5,2)
freeLib32(dllhan)
**
dllhan := LoadLib32("test2.dll")
?dlla(dllhan,5,2)
freeLib32(dllhan)
**
RETURN nil

************************************************** test dll
function dlla(dllhan,xx,yy)
local xdata
local zzz
      zzz:=getprocaddress(dllhan,"DoAdd",.t.,4,4,4)
      xdata=calldll(zzz,xx,yy)
return (xdata)

My c code for test1.dll

Code: Select all  Expand view

********************************* test1.c
#include <windows.h>

#pragma argsused
BOOL WINAPI DllEntryPoint(HINSTANCE h, DWORD d, LPVOID p)
  {
  return TRUE;
  }

int __declspec(dllexport) WINAPI DoAdd(int i, int j)
  {
  return i + j;
  }

int __declspec(dllexport) WINAPI DoSub(int i, int j)
  {
  return i - j;
  }

 

My batch file to compile test1.c to dll:

Code: Select all  Expand view

REM *********************************************************** ccdll.bat
bcc32 -WDR -Ic:\bcc55\include;c:\harbour\include -Lc:\bcc55\lib test1.c
 

My harbour code to be in the test2.dll

Code: Select all  Expand view

************************************************* test2.prg
FUNCTION DoString( cdata )
local xdata:="test a string "+cdata

RETURN xdata

FUNCTION DoAdd(v1,v2 )
local xdata:=v1+v2

RETURN xdata

FUNCTION DoSub(v1,v2 )
local xdata:=v1-v2

RETURN xdata
 

My batch file to compile the harbour dll

Code: Select all  Expand view

REM **************************************************** chbdll.bat
REM Self contained Harbour DLL, original idea and research Antonio Linares

@ECHO OFF
CLS

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

ECHO Compiling...

SET hdir=c:\harbour
SET bcdir=c:\bcc55\bin

%bcdir%\bcc32 -c -D__EXPORT__ -I%hdir%\include;\harbourdev\a\include;\bcc55\include -L%bcdir%\..\lib maindll.c
%hdir%\bin\harbour %1 /n /i%hdir%\include /w /p %2 %3 > clip.log

@type clip.log
IF ERRORLEVEL 1 PAUSE
IF ERRORLEVEL 1 GOTO EXIT

ECHO -O2 -I%hdir%\include;\harbour\include;\bcc55\include %1.c > b32.bc

%bcdir%\bcc32 -WDR -M -c @b32.bc

:ENDCOMPILE

IF EXIST %1.rc %bcdir%\brc32 -r %1

ECHO c0w32.obj + > b32.bc
ECHO %1.obj, + >> b32.bc
ECHO %1.dll, + >> b32.bc
ECHO %1.map, + >> b32.bc
ECHO %hdir%\lib\hbrtl.lib + >> b32.bc
ECHO %hdir%\lib\hbvm.lib + >> b32.bc
ECHO %hdir%\lib\gtwin.lib + >> b32.bc
ECHO %hdir%\lib\hblang.lib + >> b32.bc
ECHO %hdir%\lib\hbmacro.lib + >> b32.bc
ECHO %hdir%\lib\hbrdd.lib + >> b32.bc
ECHO %hdir%\lib\rddntx.lib + >> b32.bc
ECHO %hdir%\lib\rddcdx.lib + >> b32.bc
ECHO %hdir%\lib\hbdebug.lib + >> b32.bc
ECHO %hdir%\lib\hbcommon.lib + >> b32.bc
ECHO %hdir%\lib\hbpp.lib + >> b32.bc
ECHO %hdir%\lib\hbmzip.lib + >> b32.bc
ECHO %hdir%\lib\hbsix.lib + >> b32.bc
ECHO %hdir%\lib\rddfpt.lib + >> b32.bc
ECHO %bcdir%\lib\cw32.lib + >> b32.bc
ECHO %bcdir%\lib\import32.lib + >> b32.bc
ECHO %bcdir%\lib\psdk\odbc32.lib + >> b32.bc
ECHO %bcdir%\lib\psdk\rasapi32.lib, >> b32.bc


IF EXIST %1.res ECHO %1.res >> b32.bc
%bcdir%\ilink32 -Tpd -aa -s -L%bcdir%\..\lib -L%bcdir%\..\lib\PSDK @b32.bc

REM delete temporary files
@del %1.c
@del %1.il?

IF ERRORLEVEL 1 GOTO LINKERROR
ECHO * Self contained DLL successfully built
GOTO EXIT
ECHO

:LINKERROR
REM if exist meminfo.txt notepad meminfo.txt
REM PAUSE * 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

[Dave Zowasky]

What happens when I run the test2.dll I get a DOS window with a crash
in it that says argument error.

Any Ideas what I am doing wrong?

Thanks
Dave

[Antonio Linares]

Dave,

Do you get a log file ? Please check it

[Dave Zowasky]

Antonio,

I should have been thinking of my error handler, I'm not awake.

Here is the Error I get:

Error BASE/1081 Argument error: + Called from DOSTRING(4)

Not quite sure what to think. Any ideas?

Thanks
Dave

I modified my chbdll.bat and added the errorsys to it
here is the new chbdll.bat file

Code: Select all  Expand view

******************************************************************************************
REM Self contained Harbour DLL, original idea and research Antonio Linares
@ECHO OFF
CLS
IF A%1 == A GOTO :SINTAX
IF NOT EXIST %1.prg GOTO :NOEXIST
ECHO Compiling...
SET hdir=c:\harbour
SET bcdir=c:\bcc55
%hdir%\bin\harbour -n -w errorsys /i%hdir%\include
%bcdir%\bin\bcc32 -c -D__EXPORT__ -I%hdir%\include;%bcdir%\include errorsys.c
%hdir%\bin\harbour %1 /n /i%hdir%\include /w /p %2 %3 > clip.log
@type clip.log
IF ERRORLEVEL 1 PAUSE
IF ERRORLEVEL 1 GOTO EXIT
ECHO -O2 -I%hdir%\include;\harbour\include;%bcdir%\include;%bcdir%\lib %1.c > b32.bc
%bcdir%\bin\bcc32 -WDR -M -c @b32.bc
:ENDCOMPILE
IF EXIST %1.rc %bcdir%\bin\brc32 -r %1
ECHO %bcdir%\lib\c0w32.obj + > b32.bc
echo %1.obj+errorsys.obj+maindll.obj, + >> b32.bc
ECHO %1.dll, + >> b32.bc
ECHO %1.map, + >> b32.bc
ECHO %hdir%\lib\hbrtl.lib + >> b32.bc
ECHO %hdir%\lib\hbvm.lib + >> b32.bc
ECHO %hdir%\lib\gtwin.lib + >> b32.bc
ECHO %hdir%\lib\hblang.lib + >> b32.bc
ECHO %hdir%\lib\hbmacro.lib + >> b32.bc
ECHO %hdir%\lib\hbrdd.lib + >> b32.bc
ECHO %hdir%\lib\rddntx.lib + >> b32.bc
ECHO %hdir%\lib\rddcdx.lib + >> b32.bc
ECHO %hdir%\lib\hbdebug.lib + >> b32.bc
ECHO %hdir%\lib\hbcommon.lib + >> b32.bc
ECHO %hdir%\lib\hbpp.lib + >> b32.bc
ECHO %hdir%\lib\hbmzip.lib + >> b32.bc
ECHO %hdir%\lib\hbsix.lib + >> b32.bc
ECHO %hdir%\lib\rddfpt.lib + >> b32.bc
ECHO %bcdir%\lib\cw32.lib + >> b32.bc
ECHO %bcdir%\lib\import32.lib + >> b32.bc
ECHO %bcdir%\lib\psdk\odbc32.lib + >> b32.bc
ECHO %bcdir%\lib\uuid.lib + >> b32.bc
ECHO %bcdir%\lib\psdk\rasapi32.lib, >> b32.bc
IF EXIST %1.res ECHO %1.res >> b32.bc
%bcdir%\bin\ilink32 -Tpd -aa -s -L%bcdir%\lib -L%bcdir%\lib\PSDK @b32.bc
REM delete temporary files
@del %1.c
@del %1.il?
IF ERRORLEVEL 1 GOTO LINKERROR
ECHO * Self contained DLL successfully built
GOTO EXIT
ECHO
:LINKERROR
REM if exist meminfo.txt notepad meminfo.txt
REM PAUSE * 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

********************************************************************************


Here is the errorsys.prg I am using:

Code: Select all  Expand view

********************************************************************************

/*
 * $Id: errorsys.prg,v 1.2 2002/02/21 23:08:28 jgiraldo Exp $
 */

/*
 * Harbour Project source code:
 * The default error handler
 *
 * Copyright 1999 Antonio Linares <alinares@fivetech.com>
 * www - http://www.harbour-project.org
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2, or (at your option)
 * any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this software; see the file COPYING.  If not, write to
 * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
 * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
 *
 * As a special exception, the Harbour Project gives permission for
 * additional uses of the text contained in its release of Harbour.
 *
 * The exception is that, if you link the Harbour libraries with other
 * files to produce an executable, this does not by itself cause the
 * resulting executable to be covered by the GNU General Public License.
 * Your use of that executable is in no way restricted on account of
 * linking the Harbour library code into it.
 *
 * This exception does not however invalidate any other reasons why
 * the executable file might be covered by the GNU General Public License.
 *
 * This exception applies only to the code released by the Harbour
 * Project under the name Harbour.  If you copy code from other
 * Harbour Project or Free Software Foundation releases into a copy of
 * Harbour, as the General Public License permits, the exception does
 * not apply to the code that you add in this way.  To avoid misleading
 * anyone as to the status of such modified files, you must delete
 * this exception notice from them.
 *
 * If you write modifications of your own for Harbour, it is your choice
 * whether to permit this exception to apply to your modifications.
 * If you do not wish that, delete this exception notice.
 *
 */

#include "common.ch"
#include "error.ch"

PROCEDURE ErrorSys

   ErrorBlock( { | oError | DefError( oError ) } )

   RETURN

STATIC FUNCTION DefError( oError )
   LOCAL cMessage
   LOCAL cDOSError

   LOCAL aOptions
   LOCAL nChoice

   LOCAL n

   // By default, division by zero results in zero
   IF oError:genCode == EG_ZERODIV
      RETURN 0
   ENDIF

   // Set NetErr() of there was a database open error
   IF oError:genCode == EG_OPEN .AND. ;
      oError:osCode == 32 .AND. ;
      oError:canDefault
      NetErr( .T. )
      RETURN .F.
   ENDIF

   // Set NetErr() if there was a lock error on dbAppend()
   IF oError:genCode == EG_APPENDLOCK .AND. ;
      oError:canDefault
      NetErr( .T. )
      RETURN .F.
   ENDIF

   cMessage := ErrorMessage( oError )+Chr(13)
   IF ! Empty( oError:osCode )
      cDOSError := "(DOS Error " + LTrim( Str( oError:osCode ) ) + ")"
   ENDIF

   /* RETRY OPTIONS NOT AVAILABLE RIGHT NOW
      COMMENTED OUT ONLY FOR DELPHI INTEGRATION

   // Build buttons

   aOptions := {}

// AAdd( aOptions, "Break" )
   AAdd( aOptions, "Quit" )

   IF oError:canRetry
      AAdd( aOptions, "Retry" )
   ENDIF

   IF oError:canDefault
      AAdd( aOptions, "Default" )
   ENDIF

   // Show alert box

   nChoice := 0
   WHILE nChoice == 0

      IF Empty( oError:osCode )

         nChoice := Alert( cMessage, aOptions )
      ELSE
         nChoice := Alert( cMessage + ";" + cDOSError, aOptions)
      ENDIF

   ENDDO

   IF ! Empty( nChoice )
      DO CASE
      CASE aOptions[ nChoice ] == "Break"
         Break( oError )
      CASE aOptions[ nChoice ] == "Retry"
         RETURN .T.
      CASE aOptions[ nChoice ] == "Default"
         RETURN .F.
      ENDCASE
   ENDIF

   */

   // "Quit" selected

   IF ! Empty( oError:osCode )
      cMessage += " " + cDOSError+Chr(13)
   ENDIF

   n := 2
   WHILE ! Empty( ProcName( n ) )
      /* CHANGED */
      cMessage += "Called from " + ProcName( n ) + ;
               "(" + AllTrim( Str( ProcLine( n ) ) ) + ")"+Chr(13)

      // QUESTION: from a DLL point of view, there is not main procedure,
      //           instead of that, something that is not a valid string is
      //           given, causing this errorsys routine to be re-entrant.
      //           This next line is a temporal workaround to this problem,
      //           and a specific code to this Harbour to Delphi integration.
      If Upper(ProcName(n)) = 'MACROCALL'
         Exit
      EndIf
      n++
   ENDDO

   memowrit("error.log",cmessage )

***   D('QUIT')  // NOTE: A QUIT in a DLL is something not very smart, better to
   //  QUIT   //       let Delphi to end properly.

   RETURN .F.

// [vszakats]

STATIC FUNCTION ErrorMessage( oError )
   LOCAL cMessage

   // start error message
   cMessage := iif( oError:severity > ES_WARNING, "Error", "Warning" ) + " "

   // add subsystem name if available
   IF ISCHARACTER( oError:subsystem )
      cMessage += oError:subsystem()
   ELSE
      cMessage += "???"
   ENDIF

   // add subsystem's error code if available
   IF ISNUMBER( oError:subCode )
      cMessage += "/" + LTrim( Str( oError:subCode ) )
   ELSE
      cMessage += "/???"
   ENDIF

   // add error description if available
   IF ISCHARACTER( oError:description )
      cMessage += "  " + oError:description
   ENDIF

   // add either filename or operation
   DO CASE
   CASE !Empty( oError:filename )
      cMessage += ": " + oError:filename
   CASE !Empty( oError:operation )
      cMessage += ": " + oError:operation
   ENDCASE

   RETURN cMessage


[Antonio Linares]

Dave,

It seems as cData is not a string:

FUNCTION DoString( cdata )
local xdata:="test a string "+cdata

How do you call DoString() ?

[Dave Zowasky]

Antonio,

Since I had not got that far yet, I took the Dostring function
out did a rebuild and got this

Error BASE/1081 Argument error: + Called from DOADD(5)

Thanks
Dave

[Dave Zowasky]

Antonio,

You mentioned :

Probably the EXE to DLL stack is unbalanced, so the system protects itself finishing the EXE and the DLL

I have been taking a closer look at that issue, and in looking at examples:

viewtopic.php?f=3&t=863&hilit=ilink32+dll+stack&start=15

It seems that the switches in the compiler and linker are not an issue.

My call to the Harbour TEST2.DLL from my Fivewin program is the same as the one I do in C TEST1.DLL.

I am using the latest build of harbour and maindll.c

It looks like my parameters are not getting to the DoAdd function on the dll.

Any thoughts?

Thanks
Dave

[Antonio Linares]

Dave,

How are you calling DoAdd() ?

How do you provide it the parameters ?

[Dave Zowasky]

Antonio,

Like this:

Code: Select all  Expand view

#include "FiveWin.ch"
FUNCTION Main()
local x:=""
local dllhan
**
dllhan := LoadLib32("test2.dll")
?dlla(dllhan,5,2)
freeLib32(dllhan)
**
RETURN nil
**
function dlla(dllhan,xx,yy)
local xdata
local zzz
zzz:=getprocaddress(dllhan,"DoAdd",.t.,4,4,4)
xdata=calldll(zzz,xx,yy)
return (xdata)

[Antonio Linares]

Dave,

You can not directly call from PRG level to C level and viceversa, as Harbour uses a "virtual machine" that has its own parameters "stack" and those parameters have to be properly placed and retrieved from the stack.

Windows GetProcAddress() returns the address of a C function. Also, remember that a Harbour function uses the prefix "_HB_FUN_" before the name.

I suggest you to do some training calling C functions from PRG level, and viceversa, in your own EXE. In example:

Calling a C function from PRG: Please notice how hb_par...() is used to supply parameters from PRG level to C level, and how hb_ret...() is used to return values from C to PRG. Those functions are named the "extend system":

Code: Select all  Expand view

#include "FiveWin.ch"

function Main()

   MsgInfo( DoSum( 2, 3 ) )

return nil

#pragma BEGINDUMP

#include <hbapi.h>

HB_FUNC( DOSUM )
{
   hb_retnl( hb_parnl( 1 ) + hb_parnl( 2 ) );
}

#pragma ENDDUMP
 

[Antonio Linares]

Now, calling PRG from C level:

Code: Select all  Expand view

function Main()

   MsgInfo( Test() )

return nil

function Another( cValue )

   MsgInfo( cValue )

return "returned from high level"

#pragma BEGINDUMP

#include <hbapi.h>
#include <hbvm.h>

HB_FUNC( TEST )
{
   // We build the virtual machine stack frame

   hb_vmPushSymbol( hb_dynsymGetSymbol( "ANOTHER" ) ); // we push the symbol of the function to call
   hb_vmPushNil(); // we push nil for a function, a codeblock for Eval, an object for a method
   hb_vmPushString( "High level access from low level", strlen( "High level access from low level" ) );
   hb_vmFunction( 1 ); // 1 --> number of supplied parameters
   
   // the returned value can be accessed using hb_stackReturnItem() --> PHB_ITEM
   // or simply calling hb_par...( -1 );
}

#pragma ENDDUMP
 

[Dave Zowasky]

Antonio,

I have been able to get the MacroCall example to read a value I pass it and
return a numeric value.

Its a start

Thanks for the help.

[Dave Zowasky]

Antonio,

I have my update installed on my c: drive and have started to test.

I have a lot of potential customers who want integrate the functions
of of our software applications into their own .NET VB C++ ect.

It seems that a Harbour Self contained DLL would be the best answer.

I presume I should use the buildhd.bat to compile my code.

I tried to compile babudll.prg and have run into some issues.
I modified the bat file to run on my system, and I get these link errors:

HB_FUN_LOADLIBRARY
HB_FUN_FREELIBRARY
AlphaBlend
HB_FUN_ANSITOWIDE
HB_FUN_HB_GT_GUI_DEFAULT


Here is my code:

Code: Select all  Expand view

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

ECHO Compiling...

set hdir=c:\harbour
set bcdir=c:\bcc55

%hdir%\bin\harbour %1 /n /i..\include;%hdir%\include /w /p %2 %3 > clip.log
@type clip.log
IF ERRORLEVEL 1 PAUSE
IF ERRORLEVEL 1 GOTO EXIT

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

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

echo c0d32.obj + %hdir%\obj\b32\maindll.obj + > b32.bc
echo %1.obj, + >> b32.bc
echo %1.dll, + >> b32.bc
echo %1.map, + >> b32.bc
echo ..\lib\FiveH.lib ..\lib\FiveHC.lib + >> b32.bc
ECHO %hdir%\lib\hbrtl.lib + >> b32.bc
ECHO %hdir%\lib\hbvm.lib + >> b32.bc
ECHO %hdir%\lib\gtwin.lib + >> b32.bc
ECHO %hdir%\lib\hblang.lib + >> b32.bc
ECHO %hdir%\lib\hbmacro.lib + >> b32.bc
ECHO %hdir%\lib\hbrdd.lib + >> b32.bc
ECHO %hdir%\lib\rddntx.lib + >> b32.bc
ECHO %hdir%\lib\rddcdx.lib + >> b32.bc
ECHO %hdir%\lib\hbdebug.lib + >> b32.bc
ECHO %hdir%\lib\hbcommon.lib + >> b32.bc
ECHO %hdir%\lib\hbpp.lib + >> b32.bc
ECHO %hdir%\lib\hbmzip.lib + >> b32.bc
ECHO %hdir%\lib\hbsix.lib + >> b32.bc
ECHO %hdir%\lib\rddfpt.lib + >> b32.bc
ECHO %bcdir%\lib\cw32.lib + >> b32.bc
ECHO %bcdir%\lib\import32.lib + >> b32.bc
ECHO %bcdir%\lib\psdk\odbc32.lib + >> b32.bc
ECHO %bcdir%\lib\uuid.lib + >> b32.bc
ECHO %bcdir%\lib\psdk\rasapi32.lib, >> b32.bc
IF EXIST %1.res echo %1.res >> b32.bc
%bcdir%\bin\ilink32 -Tpd -aa -L%bcdir%\lib @b32.bc

IF ERRORLEVEL 1 GOTO LINKERROR
ECHO * self contained DLL successfully built
GOTO EXIT
ECHO

rem delete temporary files
@del %1.c
@del %1.il?

:LINKERROR
ECHO * There are 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


I really like the Code button you have on here:

I also really like the RSS feed as well...

http://com1software.com/c1019.htm

Let what you think I may need to add, and or if I am
in a wrong direction.

Thanks