How create DLL With XHARBOUR

[Antonio Linares]

Mauricio,

As far as we know there is no way to perform a Peek() or Poke() on 32 bits mode (unless you develop a low level driver).

[mauricioajordao]

Dear Antonio..

Thanks per Help me OK.

My Dll create With XHARBOUR are End Now...


Thanks Again , i hope help Some Peoples this FORUM also...

Mauricio

[RAMESHBABU]

Mr.Antonio

I tried to create a DLL and test it using FWH 2.5 Feb-2005 + XHARBOUR 0.99.3 (Simplex) with the following code.

The Dll could be created and I believe it is loaded.
But the function in side the DLL is not working.

Please guide me where I went wrong.

Regards

- Ramesh Babu P


**************************** TestDll.prg Source *****************************

#include "FiveWin.ch"

STATIC hLib

FUNCTION Main()

hLib := LoadLib32("MiscFunc.dll")

Make_Index("customer","zip")

FreeLib32(hLib)

RETURN nil

**********

DLL32 FUNCTION Make_Index( cFilec AS LPSTR, cField AS LPSTR ) AS LONG PASCAL FROM "MakeIndex" LIB hLib

**************************** MiscFunc.dll Source ****************************

#include "fivewin.ch"

FUNCTION MakeIndex( cFileName, cField )

LOCAL oDlg, nPercent := 0, oMeter, cTitle := LTRIM(STR(nPercent))+"% is Indexed"
LOCAL oSay

DEFINE DIALOG oDlg FROM 1, 1 TO 7, 44 ;
TITLE "Indexing is in progress..."

@ 1, 2 METER oMeter VAR nPercent TOTAL 100 OF oDlg SIZE 135, 12

ACTIVATE DIALOG oDlg CENTERED ON PAINT IndexFile(cFileName, cField, nPercent, oMeter, oDlg)

RETURN 'The file '+cFileName+' has been indexed'

**********

FUNCTION IndexFile(cFileName, cField, nPercent, oMeter, oDlg)

USE (cFileName) ALIAS cAlias
INDEX ON &(cField) TO (cFileName) EVAL IndexStatus(nPercent, oMeter, oDlg) EVERY LastRec()/10

CLOSE cAlias

RETURN nil

**********

FUNCTION IndexStatus(nPercent, oMeter, oDlg)

LOCAL nSeconds

nPercent := Int((RecNo()/LastRec()) * 100)

oMeter:Set(nPercent)
oMeter:Refresh()

IF nPercent = 100
oDlg:End()
ENDIF

SysWait(.35)

RETURN .T.

*************************** MAKESDLL.BAT Source *****************************

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:\xharbour
SET bcdir=c:\borland\bcc55\bin

%bcdir%\bcc32 -c -D__EXPORT__ -I%hdir%\include -L%bcdir%\..\lib %hdir%\source\vm\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 %1.c > b32.bc

%bcdir%\bcc32 -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.exe, + >> b32.bc
ECHO %1.map, + >> b32.bc
ECHO c:\fwh\lib\Fivehx.lib + >> b32.bc
ECHO c:\fwh\lib\FiveHc.lib + >> b32.bc
ECHO c:\fwh\lib\Tdbf.lib + >> b32.bc
ECHO c:\fwh\lib\btnget.lib + >> b32.bc
ECHO %hdir%\lib\hbole.lib + >> b32.bc
ECHO %hdir%\lib\ole2.lib + >> b32.bc
ECHO %hdir%\lib\rtl.lib + >> b32.bc
ECHO %hdir%\lib\ct.lib + >> b32.bc
ECHO %hdir%\lib\vm.lib + >> b32.bc
ECHO %hdir%\lib\gtwin.lib + >> b32.bc
ECHO %hdir%\lib\lang.lib + >> b32.bc
ECHO %hdir%\lib\macro.lib + >> b32.bc
ECHO %hdir%\lib\rdd.lib + >> b32.bc
ECHO %hdir%\lib\dbfntx.lib + >> b32.bc
ECHO %hdir%\lib\dbfcdx.lib + >> b32.bc
ECHO %hdir%\lib\dbfdbt.lib + >> b32.bc
ECHO %hdir%\lib\debug.lib + >> b32.bc
ECHO %hdir%\lib\common.lib + >> b32.bc
ECHO %hdir%\lib\pp.lib + >> b32.bc
ECHO %hdir%\lib\hbzip.lib + >> b32.bc

REM Uncomment these two lines to use Advantage RDD
ECHO %hdir%\lib\rddads.lib + >> b32.bc
ECHO %hdir%\lib\Ace32.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.rc %bcdir%\bin\brc32 -r %1

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

REM Uncomment this line and comment the next to review the unreleased memory blocks
REM %bcdir%\bin\ilink32 -Gn -Tpe -s -v @b32.bc

IF EXIST %1.res ECHO %1.res >> b32.bc
%bcdir%\ilink32 -Tpd -aa -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

**********

[Antonio Linares]

Ramesh,

Here you have a working sample:

Babu.prg - build it using buildh.bat Babu

Code: Select all  Expand view  RUN

#include "FiveWin.ch"

function Main()

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

   HbDLLEntry2( "TEST", hItem1, hItem2 )
   
   ItemRelease( hItem1 )
   ItemRelease( hItem2 )
   
   MsgInfo( "ok from EXE" )

return nil

DLL FUNCTION HBDLLENTRY2( cProc AS LPSTR, pItem1 AS LONG, pItem2 AS LONG ) AS LONG PASCAL LIB "BabuDLL.dll"

#pragma BEGINDUMP

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

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

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

#pragma ENDDUMP


BabuDLL.prg - build it using buildhd.bat BabuDLL

Code: Select all  Expand view  RUN

function Test( cMsg1, cMsg2 )

   MsgInfo( cMsg1, cMsg2 )

return nil


We have uploaded a modified maindll.c to Harbour CVS, that contains this:

Code: Select all  Expand view  RUN

LONG HB_EXPORT PASCAL HBDLLENTRY1( char * cProcName, LONG pItem )
{
   hb_itemDoC( cProcName, 1, ( PHB_ITEM ) pItem, 0 );

   return 0;
}

LONG HB_EXPORT PASCAL HBDLLENTRY2( char * cProcName, LONG pItem1, LONG pItem2 )
{
   hb_itemDoC( cProcName, 2, ( PHB_ITEM ) pItem1, ( PHB_ITEM ) pItem2, 0 );

   return 0;
}


You have to download Harbour CVS files and build it, or add such code to source\vm\maindll.c and build it.

In case you don't know how to build Harbour, please tell us and we will publish a new Harbour build with these changes.

You may download the working EXE and DLL from here:
http://hyperupload.com/download/2a67bb3 ... e.zip.html

[RAMESHBABU]

Mr. Antonio

Thank you very much for sparing your time on my subject.

I have built babu.exe using buildh.bat. But I could not locate "buildhd.bat" in either FWH or XHARBOUR directories to build Babudll.prg. Where should I get it from ?

>You have to download Harbour CVS files and build it, or add such code to source\vm\maindll.c and build it.

"harbour CVS files" means Xharbour or just Harbour ?


>In case you don't know how to build Harbour, please tell us and we will publish a new Harbour build with these changes

I did not build Harbour so far and I am using the same build which I
got from FIVEWIN. So kindly build it and publish it for all of our members.

Regards,

- Ramesh Babu P

[Antonio Linares]

Ramesh,

You may download buildhd.bat from here:
http://hyperupload.com/download/311c2e9 ... d.zip.html

Please notice it uses harbour to build the DLL, so you need to modify it to use xharbour. Its easy.

The changes we have implemented are in Harbour, not xHarbour. So we are going to implement them in xharbour, here locally, and publish a new build. In a few minutes we will let you know when it is ready to be downloaded.

[Antonio Linares]

Ramesh,

You may already download a new build with those required functions:

harbour: www.fivetechsoft.com/files/harbour.exe

xharbour: www.fivetechsoft.com/files/xharbour.exe

[RAMESHBABU]

Mr. Antonio

Thank you very much for the "BuildHd.bat" and the new xHarbour build.

When I try to build any application with the new xHarbour version, I am gettng the following errors!.

Turbo Incremental Link 5.00 Copyright (c) 1997, 2000 Borland
Error: Unresolved external '_hb_stack' referenced from C:\FWH\LIB\FIVEHC.LIB|FFWNDRUN
Error: Unresolved external '_hb_sxDeCrypt' referenced from C:\XHARBOUR\LIB\RDD.LIB|dbf1
Error: Unresolved external '_hb_sxPtoD' referenced from C:\XHARBOUR\LIB\RDD.LIB|dbf1
Error: Unresolved external '_hb_sxDtoP' referenced from C:\XHARBOUR\LIB\RDD.LIB|dbf1
Error: Unresolved external '_hb_sxEnCrypt' referenced from C:\XHARBOUR\LIB\RDD.LIB|dbf1

Am I missing any thing in the "BuildHd.bat"

I give below the copy of "BuildHd.bat" for your reference.


@ECHO OFF
CLS
ECHO ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
ECHO ³ FiveWin for Harbour 2.7 - January 2006 Harbour development power ³Ü
ECHO ³ (c) FiveTech, 1993-2005 for Microsoft Windows 95/98/NT/2000/ME and XP ³Û
ECHO ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙÛ
ECHO ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß

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

ECHO Compiling...

set hdir=c:\xharbour
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 %1.c > b32.bc
%bcdir%\bin\bcc32 -M -c @b32.bc
:ENDCOMPILE

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

echo c0d32.obj + > b32.bc
echo %1.obj, + >> b32.bc
echo %1.dll, + >> b32.bc
echo %1.map, + >> b32.bc
echo c:\fwh\lib\FiveH.lib c:\fwh\lib\FiveHC.lib + >> b32.bc
echo %hdir%\lib\rtl.lib + >> b32.bc
echo %hdir%\lib\vm.lib + >> b32.bc
echo %hdir%\lib\gtwin.lib + >> b32.bc
echo %hdir%\lib\lang.lib + >> b32.bc
echo %hdir%\lib\macro.lib + >> b32.bc
echo %hdir%\lib\rdd.lib + >> b32.bc
echo %hdir%\lib\dbfntx.lib + >> b32.bc
echo %hdir%\lib\dbfcdx.lib + >> b32.bc
echo %hdir%\lib\dbfdbt.lib + >> b32.bc
echo %hdir%\lib\dbffpt.lib + >> b32.bc
echo %hdir%\lib\debug.lib + >> b32.bc
echo %hdir%\lib\common.lib + >> b32.bc
echo %hdir%\lib\pp.lib + >> b32.bc
echo %hdir%\lib\codepage.lib + >> b32.bc

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

echo %bcdir%\lib\import32.lib + >> b32.bc
echo %bcdir%\lib\cw32.lib + >> b32.bc
echo %bcdir%\lib\psdk\odbc32.lib, >> b32.bc
IF EXIST %1.res echo %1.res >> b32.bc
%bcdir%\bin\ilink32 -Tpd -aa @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


Please correct me where I am going wrong.

Please also note that "maindll.obj" is not included in the above file.
Is it still required to be included in the above "BuildHd.bat" file, to build the DLL ?


Regards,

- Ramesh Babu P

[Antonio Linares]

Ramesh,

Please add these two lines to buildhd.bat:

...
echo %hdir%\lib\b32\dbfcdx.lib + >> b32.bc
echo %hdir%\lib\b32\dbffpt.lib + >> b32.bc NEW !!!
echo %hdir%\lib\b32\hbsix.lib + >> b32.bc NEW !!!
echo %hdir%\lib\b32\debug.lib + >> b32.bc
...

regarding _hb_stack you need an upgraded FWH version. You may order it from www.fivetechsoft.com

[mauricioajordao]

Dear Antonio,


Thanks per Help make My DLL to Xharbour, But Now i Have Other Problem..

My Dll its OK TO , Cobol , DELPHI , VB , But to Using Xharbour Calling Don´t RUN.


Do You Know Why?


i make My DLL With


macrocall.c
*************************************************
#define HB_OS_WIN_32_USED

#include "hbvm.h"
#include "hbapiitm.h"
#include "hbstack.h"

#if defined(HB_OS_WIN_32)

// Function pointer type
typedef long (__stdcall *CallBackFuncType)(const char* message);


// Setter function
HB_EXPORT __stdcall void SetCallBack(CallBackFuncType fun);


// funcao Macrocall
void * HB_EXPORT __stdcall MacroCall( char * sfunc, char *schar)

{
char *szFunc = "MacroCall";

PHB_DYNS pDynSym = hb_dynsymFindName( szFunc ); /* The PRG function to use */

if( pDynSym )
{
hb_vmPushSymbol( pDynSym->pSymbol );
hb_vmPushNil();
hb_vmPushString( sfunc, strlen( sfunc ) );
hb_vmPushString( schar, strlen(schar) );
hb_vmFunction( 2 ); /* as we receive one parameter */
strcpy( schar , hb_stack.Return.item.asString.value ) ;
return "0" ;
}
else
return "0" ;

}


static CallBackFuncType cbfun = 0;
void __stdcall SetCallBack(CallBackFuncType fun)
{
CallBackFuncType oldfun = cbfun;
cbfun = fun;
return oldfun;
}

HB_FUNC( CALLBACK )
{
long result = 0;

if (cbfun != 0)
{

result = cbfun( hb_parc( 1 ) );
}
else
{
MessageBox( NULL, //HWINDOW of the window that owns the message box
"CallBack failed under MacrCall.c" , //Text
"Warning" ,//Title
MB_OK | MB_ICONINFORMATION );//Bit mask flags
}

hb_retl( result ); // QUESTION: If you can make this to return a char pointer
// being interpreted correctly by Delphi,
// please inform me, I'm all ears, thank you.
}

HB_FUNC( MSGBOX )
{
MessageBox( 0, hb_parc( 1 ), "Warning", 0 );
}

#endif

*****************************
maindll

#define HB_OS_WIN_32_USED

#include "hbvm.h"
#include "hbapiitm.h"

#if defined(HB_OS_WIN_32)

BOOL HB_EXPORT WINAPI DllEntryPoint( HINSTANCE hInstance, DWORD fdwReason, PVOID pvReserved )
{
HB_TRACE( HB_TR_DEBUG, ("DllEntryPoint(%p, %p, %d)", hInstance, fdwReason,
pvReserved ) );

HB_SYMBOL_UNUSED( hInstance );
HB_SYMBOL_UNUSED( fdwReason );
HB_SYMBOL_UNUSED( pvReserved );

switch( fdwReason )
{
case DLL_PROCESS_ATTACH:
hb_vmInit( FALSE ); /* Don't execute first linked symbol */
break;
case DLL_PROCESS_DETACH:
/* hb_vmQuit(); */
break;
}

return TRUE;
}

LONG HB_EXPORT PASCAL HBDLLENTRY( char * cProcName )
{

hb_itemDoC( cProcName, 0, 0 );

return 0;
}

#endif



**************************
My Call in xharbour


DLL32 FUNCTION chamada(parm1 AS LPSTR , parm2 AS LPSTR) AS LONG PASCAL FROM "macrocall" LIB "XHB.DLL"



Thanks For help...

[Antonio Linares]

Mauricio,

Please email me XHB.DLL as a zip file

[mauricioajordao]

thanks again , antonio..



i send my e-mail , yet



mauricio

[Antonio Linares]

Mauricio,

I meant just the DLL not the whole thing

Try to change the DLL function name in this line: "MacroCall"

DLL32 FUNCTION chamada(parm1 AS LPSTR , parm2 AS LPSTR) AS LONG PASCAL FROM "MacroCall" LIB "XHB.DLL"