Thanks Antonio ..

only ASK , remember PEEK and POKE Basic Comands ..

What command this Xharbour ?

My DLL are Nice..

thanks again

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).

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

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

---

Ramesh,

Here you have a working sample:

Babu.prg - build it using buildh.bat Babu


BabuDLL.prg - build it using buildhd.bat BabuDLL


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


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

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

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.

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

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

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...

Mauricio,

Please email me XHB.DLL as a zip file

thanks again , antonio..

i send my e-mail , yet

mauricio

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"