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

[binho_fasa]

Amigos,

Devido a uma necessidade especial, preciso exportar algumas funções em (x)Harbour via .DLL para poder utilizar no Delphi e ou Lazarus.
Já tentei de tudo, estou a bastante tempo tentando fazer. Já consegui gerar a Dll usando o Hbmake (Xharbour 1.21) ou hbmk2 (Harbour 3.0), mas na hora de utilizar no Delphi ou Lazarus, informa "não possível localizar o ponto de entrada do procedimento XYZ na biblioteca de vinculo dinâmico LICXYZ.dll".

Já tentei criando um .prg contendo a minha função:

EXTERNAL XYZ

FUNCTION XYZ()

RETURN "123"

hbmake LICXYZ.bc (gera a dll mas da erro na hora de executar)
hbmk2 LICXYZ.prg -shared -lhbmaindllp -nohblib-

Alguém sabe como fazer?

Obrigado,

Fabio Souza

[Cezar]

Boa noite,

Tambem, estou precisando exportar uma rotina escrita em Harbour para C# para atender a uma emergência e estou tendo o mesmo problema.

Gerei a DLL no Harbour, seguindo os exemplos na pasta do \hb30\contrib\hbwin, o C# até reconhece, mas quando a função dentro da DLL é chamada pelo C# dá este mesmo erro que vc esta tendo no Delphi :

Unable to find an entry point named 'MyMethod' in DLL 'Olesrv3.dll'

Já tentei de várias maneiras mas sem sucesso, não sei se ainda falta alguma coisa na DLL, abaixo o exemplo da DLL que gerei no Harbour:

Código: Selecionar todos

/*
 * $Id: olesrv3.prg 14688 2010-06-04 13:32:23Z vszakats $
 */

/*
 * Harbour Project source code:
 *    demonstration/test code for OLE server which works like
 *    xHarbour.com OLE servers described at
 *    http://xharbour.com/index.asp?page=add_ ... 7&show_i=1
 *
 * Copyright 2010 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
 * www - http://harbour-project.org
 *
 */

#define CLS_Name  "MyOleServer"
#define CLS_ID    "{466AC7B2-35D7-4509-B909-C3C2F8FDBD3C}"

EXTERNAL MyMethod

PROCEDURE DllMain()

   PUBLIC Property1

   M->Property1 := "MyProperty"

   /* Initialize OLE server ID and name.
    * WIN_OleServerInit() should be executed from DllMain()
    */
   WIN_OleServerInit( CLS_ID, CLS_Name )

RETURN


FUNCTION MyMethod()

RETURN "Hello from MyOleServer"


ANNOUNCE GT_SYS
REQUEST HB_GT_GUI_DEFAULT

Agradeço se puder me informar se conseguir fazer o Delphi rodar a DLL se o problema é do Harbour ou Delphi, no meu caso seria C# ??

Se o pessoal do forum tambem tiver alguma dica a respeito agradeço.


v_Cez@yahoo.com.br

Nota de Moderação:
por Pablo: Cezar, esta mensagem não tinha sido considerado as tags code, porque deveria ter removido a desativação do BBCode que existe no rodapé da edição de mensagem em Opções. Ou então mude no Painel de Controle do Usuário, Preferências do fórum, Editar padrões de postagem e deixar com "Sim" em Sempre permitir BBCode.

[rochinha]

Amiguinhos,

Obtiveram algum resultado?, desistiram? ou o que fizeram?

Veja meu tópico Criação de DLL com código xBase para uso com Harbour.

[asimoes]

Verificar no tópico do Rochinha o exemplo que eu postei baseado no exemplo do Mestre Rochinha.

[asimoes]

A dll para testar.

[rochinha]

Amiguinho,

Show-de-Bola, :xau , rodou beleza.

[asimoes]

Outro exemplo com passagem de parâmetro para função.

testardll.prg - para usar a dll Demo.dll

Código: Selecionar todos

/*
 * Harbour Project source code:
 *    Dynamic library call demonstration. (on Windows)
 *
 * Copyright 2008 Viktor Szakats (vszakats.net/harbour)
 * www - http://harbour-project.org
 *
 */

#include "simpleio.ch"
#include "wvtwin.ch"
#include "hbcompat.ch"
#include "hbgtinfo.ch"
#include "hbgtwvg.ch"
#include "wvgparts.ch"
#include "dbinfo.ch"
#include "fileio.ch"
#include "hbdyn.ch"
#include "common.ch"
#include "set.ch"
#include "inkey.ch"

PROCEDURE Main()

   LOCAL hLib, hItem
 
   hItem:=itemNew("Nova Janela")
   
   hLib := hb_libLoad( "demo.dll" )
   
   IF ! Empty( hLib )
      hb_DynCall( { "HBDLLENTRY1", hLib, hb_bitOr( HB_DYN_CTYPE_CHAR_PTR , HB_DYN_CALLCONV_STDCALL )  },"Main", hItem )
      hb_libFree( hLib )
   ENDIF
   
   ItemRelease( hItem )
   
    RETURN

INIT FUNCTION AppSetup()
  
   REQUEST HB_LANG_PT
  REQUEST HB_CODEPAGE_PT850
  HB_LANGSELECT("PT")
  HB_CDPSELECT( "PT850" ) //pt850
  
  REQUEST DBFCDX
  
  RddSetDefault("DBFCDX")
  
  SETMODE(25,80)
 
  SetColor("W+/B")
  
  CLS
 
  SetColor("W+/B")
  
  IniciaJanela()
 

RETURN Nil 
 

FUNCTION IniciaJanela(nLi,nCi,nLf,nCf)
 
LOCAL oCrt

PUBLIC nJanelaAplicacao, oDlgHabla

   HB_Default(@nLi,0)
   HB_Default(@nCi,0)
   HB_Default(@nLf,MaxRow())
   HB_Default(@nCf,MaxCol())
  
   cTituloJanela:="Teste com DLL"
 
   HB_gtInfo(HB_GTI_FONTNAME, "Lucida Console")
   HB_gtInfo(HB_GTI_WINTITLE, cTituloJanela)
   HB_gtInfo(HB_GTI_ICONRES, "IPRINTER2" ) 
   HB_gtInfo(HB_GTI_CLOSABLE, .F. )
   HB_gtInfo(HB_GTI_ISGRAPHIC, .T. )
   HB_gtInfo(HB_GTI_STDERRCON, .T. )
   HB_gtInfo(HB_GTI_COMPATBUFFER, .T. ) 
   HB_gtInfo(HB_GTI_SPEC, HB_GTS_WNDSTATE, HB_GTS_WS_MAXIMIZED )
   HB_gtInfo(HB_GTI_SPEC, HB_GTS_SHOWWINDOW, SW_NORMAL )
   
   nJanelaAplicacao:=hwg_FindWindow(,HB_gtInfo(HB_GTI_WINTITLE))
      
RETURN Nil
 
FUNCTION HB_GTSYS()
   REQUEST HB_GT_WVG_DEFAULT
   REQUEST HB_GT_WVT
   REQUEST HB_GT_WGU
   REQUEST HB_GT_WVG
RETURN Nil 

#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    

Demo.prg (que vai gerar a dll Demo.dll)

Código: Selecionar todos

/*
 * MiniGUI DBF Header Info Test
 * (c) 2010 Grigory Filatov <gfilatov@inbox.ru>
*/

#include "minigui.ch"

#include "dbstruct.ch"
#include "fileio.ch"


PROCEDURE Main(cTitulo)
  
  hb_Default(@cTitulo,"DBF Header Infomação") 

	filltable ( 100 )

	DEFINE WINDOW Form_1 ;
		AT 0,0 ;
		WIDTH 450 ;
		HEIGHT 450 ;
		TITLE cTitulo ;
		MAIN

		DEFINE MAIN MENU

			DEFINE POPUP "Test"
				MENUITEM 'Get Header Info' ACTION ( aResult := GetHeaderInfo('test.dbf'),;
					aChoice( ,,,, aResult, "Header Info of TEST.DBF" ) )
				SEPARATOR
                                ITEM 'Exit' ACTION Form_1.Release()
			END POPUP

		END MENU

	END WINDOW 

	Form_1.Center()
	Form_1.Activate()

RETURN


PROCEDURE filltable ( nCount )
   LOCAL aDbf[11][4], i

   if !file('test.dbf')
        aDbf[1][ DBS_NAME ] := "First"
        aDbf[1][ DBS_TYPE ] := "Character"
        aDbf[1][ DBS_LEN ]  := 20
        aDbf[1][ DBS_DEC ]  := 0
        //
        aDbf[2][ DBS_NAME ] := "Last"
        aDbf[2][ DBS_TYPE ] := "Character"
        aDbf[2][ DBS_LEN ]  := 20
        aDbf[2][ DBS_DEC ]  := 0
        //
        aDbf[3][ DBS_NAME ] := "Street"
        aDbf[3][ DBS_TYPE ] := "Character"
        aDbf[3][ DBS_LEN ]  := 30
        aDbf[3][ DBS_DEC ]  := 0
        //
        aDbf[4][ DBS_NAME ] := "City"
        aDbf[4][ DBS_TYPE ] := "Character"
        aDbf[4][ DBS_LEN ]  := 30
        aDbf[4][ DBS_DEC ]  := 0
        //
        aDbf[5][ DBS_NAME ] := "State"
        aDbf[5][ DBS_TYPE ] := "Character"
        aDbf[5][ DBS_LEN ]  := 2
        aDbf[5][ DBS_DEC ]  := 0
        //
        aDbf[6][ DBS_NAME ] := "Zip"
        aDbf[6][ DBS_TYPE ] := "Character"
        aDbf[6][ DBS_LEN ]  := 10
        aDbf[6][ DBS_DEC ]  := 0
        //
        aDbf[7][ DBS_NAME ] := "Hiredate"
        aDbf[7][ DBS_TYPE ] := "Date"
        aDbf[7][ DBS_LEN ]  := 8
        aDbf[7][ DBS_DEC ]  := 0
        //
        aDbf[8][ DBS_NAME ] := "Married"
        aDbf[8][ DBS_TYPE ] := "Logical"
        aDbf[8][ DBS_LEN ]  := 1
        aDbf[8][ DBS_DEC ]  := 0
        //
        aDbf[9][ DBS_NAME ] := "Age"
        aDbf[9][ DBS_TYPE ] := "Numeric"
        aDbf[9][ DBS_LEN ]  := 2
        aDbf[9][ DBS_DEC ]  := 0
        //
        aDbf[10][ DBS_NAME ] := "Salary"
        aDbf[10][ DBS_TYPE ] := "Numeric"
        aDbf[10][ DBS_LEN ]  := 6
        aDbf[10][ DBS_DEC ]  := 0
        //
        aDbf[11][ DBS_NAME ] := "Notes"
        aDbf[11][ DBS_TYPE ] := "Character"
        aDbf[11][ DBS_LEN ]  := 70
        aDbf[11][ DBS_DEC ]  := 0

        DBCREATE("test", aDbf)
   endif

   use test
   zap

   for i := 1 to nCount
      append blank

      replace   first      with   'first'   + str(i)
      replace   last       with   'last'    + str(i)
      replace   street     with   'street'  + str(i)
      replace   city       with   'city'    + str(i)
      replace   state      with   chr( HB_RANDOMINT( 65,90 ) ) + chr( HB_RANDOMINT( 65,90 ) )
      replace   zip        with   alltrim( str( HB_RANDOMINT( 9999 ) ) )
      replace   hiredate   with   date() - 20000 + i
      replace   married    with   ( HB_RANDOMINT() == 1 )
      replace   age        with   HB_RANDOMINT( 99 )
      replace   salary     with   HB_RANDOMINT( 10000 )
      replace   notes      with   'notes' + str(i)
   next i

   use

RETURN

FUNCTION Achoice( t, l, b, r, aInput, cTitle, dummy, nValue )
	LOCAL aItems := {}

	DEFAULT cTitle TO "Please, select", nValue TO 1

	aEval( aInput, {|x| Aadd( aItems, x[2] + ": " + hb_ValToStr( x[1] ) ) } )

	DEFINE WINDOW Win_2 ;
		AT 0,0 ;
		WIDTH 400 HEIGHT 400 + IF(IsXPThemeActive(), 7, 0) ;
		TITLE cTitle ;
		ICON 'sqlite.ico' ;
		TOPMOST ;
		NOMAXIMIZE NOSIZE ;
		ON INIT Win_2.Button_1.SetFocus

		@ 335,190 BUTTON Button_1 ;
		CAPTION 'OK' ;
		ACTION {|| nValue := Win_2.List_1.Value, Win_2.Release } ;
		WIDTH 80

		@ 335,295 BUTTON Button_2 ;
		CAPTION 'Cancel' ;
		ACTION {|| nValue := 0, Win_2.Release } ;
		WIDTH 80

		@ 20,15 LISTBOX List_1 ;
		WIDTH 360 ;
		HEIGHT 300 ;
		ITEMS aItems ;
		VALUE nValue ;
		FONT "Ms Sans Serif" ;
		SIZE 12 ;
		ON DBLCLICK {|| nValue := Win_2.List_1.Value, Win_2.Release }

		ON KEY ESCAPE ACTION Win_2.Button_2.OnClick

	END WINDOW

	CENTER WINDOW Win_2
	ACTIVATE WINDOW Win_2

RETURN nValue


#define FIELD_ENTRY_SIZE 32
#define FIELD_NAME_SIZE  11

Function GetHeaderInfo(database)
Local aRet := {}
Local nHandle
Local dbfhead
Local h1,h2,h3,h4
Local dbftype
Local headrecs
Local headsize
Local recsize
Local nof
Local fieldlist
Local nfield
Local nPos
Local cFieldname
Local cType
Local cWidth,nWidth
Local nDec,cDec

if .not.'.DBF' $ upper(database)
    database+='.DBF'
endif
if ( nHandle := fopen( database, FO_READ ) ) == - 1
  msgstop('Can not open file '+upper(database)+' for reading!')
  return aRet
endif

dbfhead:=space(4)
fread( nHandle, @dbfhead, 4 )

h1:=FT_BYT2HEX(substr(dbfhead,1,1))   //must be 03h or F5h if .fpt exists
dbftype:=h1
h2:=FT_BYT2HEX(substr(dbfhead,2,1))   //yy hex (between 00h and FFh) added to 1900 (decimal)
h3:=FT_BYT2HEX(substr(dbfhead,3,1))   //mm hex (between 01h and 0Ch)
h4:=FT_BYT2HEX(substr(dbfhead,4,1))   //dd hex (between 01h and 1Fh)
if hex2dec(h3) > 12 .or. hex2dec(h4) > 31
   MsgInfo('Date damage in header!')
endif

aadd(aRet, {'0x'+dbftype, 'Type of file'})
aadd(aRet, {strzero(hex2dec(h4),2)+'.'+strzero(hex2dec(h3),2)+'.'+strzero(hex2dec(h2)-if(hex2dec(h2)>100,100,0),2), 'Last update (DD.MM.YY)'})

headrecs:=space(4) //number of records in file
fseek( nHandle, 4, FS_SET )
fread( nHandle, @headrecs, 4 )

h1:=FT_BYT2HEX(substr(headrecs,1,1))
h2:=FT_BYT2HEX(substr(headrecs,2,1))
h3:=FT_BYT2HEX(substr(headrecs,3,1))
h4:=FT_BYT2HEX(substr(headrecs,4,1))
headrecs:=int(hex2dec(h1)+256*hex2dec(h2)+(256**2)*hex2dec(h3)+(256**3)*hex2dec(h4))

aadd(aRet, {headrecs, 'Number of records'})

headsize:=space(2)
fread( nHandle, @headsize, 2 )

h1:=FT_BYT2HEX(substr(headsize,1,1))
h2:=FT_BYT2HEX(substr(headsize,2,1))
headsize:=hex2dec(h1)+256*hex2dec(h2) //header size

aadd(aRet, {headsize, 'Header size'})

recsize:=space(2)
fread( nHandle, @recsize, 2 )

h1:=FT_BYT2HEX(substr(recsize,1,1))
h2:=FT_BYT2HEX(substr(recsize,2,1))
recsize:=hex2dec(h1)+256*hex2dec(h2) //record size

aadd(aRet, {recsize, 'Record size'})

nof:=int(headsize/32)-1   // number of fields

aadd(aRet, {nof, 'Fields count'})

fieldlist:={}
for nField=1 to nof
    nPos := nField * FIELD_ENTRY_SIZE
    fseek( nHandle, nPos, FS_SET ) // Goto File Offset of the nField-th Field
    cFieldName:=space(FIELD_NAME_SIZE)
    fread( nHandle, @cFieldName, FIELD_NAME_SIZE )
    cFieldName:=strtran(cFieldName,chr(0),' ')
    cFieldName:=rtrim(substr(cFieldName,1,at(' ',cFieldName)))

    cType:=space(1)
    fread( nHandle, @cType, 1 )

    fseek( nHandle, 4, FS_RELATIVE )
    if ctype=='C'
       cWidth:=space(2)
       fread( nHandle, @cWidth, 2 )
       h1:=FT_BYT2HEX(substr(cWidth,1,1))
       h2:=FT_BYT2HEX(substr(cWidth,2,1))
       nWidth:=hex2dec(h1)+256*hex2dec(h2) // record size
       nDec:=0
    else
       cWidth:=space(1)
       fread( nHandle, @cWidth, 1 )
       nWidth:=hex2dec(FT_BYT2HEX(cWidth))
       cDec:=space(1)
       fread( nHandle, @cDec, 1 )
       nDec:=hex2dec(FT_BYT2HEX(cDec))
    endif
    aadd(fieldlist,{cFieldName,cType,nWidth,nDec})
next

fclose( nHandle )

aadd(aRet, {'', 'Fields structure'})
aeval(fieldlist,{|x,i| aadd(aRet, {x[1] + " - " + x[2] + "(" + hb_ntos(x[3]) + "," + hb_ntos(x[4]) + ")", hb_ntos(i)})})

RETURN aRet


#define HEXTABLE "0123456789ABCDEF"

FUNCTION HEX2DEC( cHexNum )
   local n, nDec := 0, nHexPower := 1

   for n := len( cHexNum ) to 1 step -1
      nDec += ( at( subs( upper(cHexNum), n, 1 ), HEXTABLE ) - 1 ) * nHexPower
      nHexPower *= 16
   next

RETURN nDec


FUNCTION FT_BYT2HEX(cByte,plusH)
  local xHexString

  default plusH := .f.

  if valtype(cByte) == "C"
     xHexString := substr( HEXTABLE, int(asc(cByte) / 16) + 1, 1 ) ;
                 + substr( HEXTABLE, int(asc(cByte) % 16) + 1, 1 ) ;
                 + iif(plusH, "h", '')
  endif

RETURN xHexString

#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:
         hb_vmInit( FALSE );
         break;
       case DLL_PROCESS_DETACH:
         hb_vmQuit();
         break;
     }   
     return TRUE;
    }

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

    } 

    void pascal __export Main()
    { 
     hb_itemDoC( "Main", 0 );
    }

    void pascal __export HBDLLENTRY1( char * cProcName, PHB_ITEM pParam1)
    {
     hb_itemDoC( cProcName, 1, pParam1);
    }
    
    void pascal __export HBDLLENTRY2( char * cProcName, PHB_ITEM pParam1, PHB_ITEM pParam2 )
    {
     hb_itemDoC( cProcName, 2, pParam1, pParam2 );
    }
    
#pragma ENDDUMP

bat para compilar e gerar a dll Demo.dll

Código: Selecionar todos

@echo off
set bcdir=d:\borland\bcc58
set hbdir=d:\minigui\harbour
set hmgui=d:\minigui
set aplic=Demo

%hbdir%\bin\harbour %aplic%.prg /n /i%hmgui%\include;%hbdir%\include /w0 /p %aplic% /d__HARBOUR__ > comp.log
IF ERRORLEVEL 1 GOTO COMPILEERRORS
rem @type comp.log
echo -O2 -e%aplic%.exe -I%hbdir%\include;%bcdir%\include %aplic%.c > b32.bc
%bcdir%\bin\bcc32 -M -c @b32.bc
copy %bcdir%\lib\uuid.lib
:ENDCOMPILE

if exist bl32.bc del bl32.bc

rem echo  %bcdir%\lib\cw32mt.lib + >> bl32.bc

echo  %hmgui%\lib\tsbrowse.lib + >> bl32.bc
echo  %hmgui%\lib\propgrid.lib + >> bl32.bc
echo  %hmgui%\lib\minigui.lib + >> bl32.bc
echo  %hbdir%\lib\dll.lib + >> bl32.bc
echo  %hbdir%\lib\gtgui.lib + >> bl32.bc

echo  %hbdir%\lib\xhb.lib + >> bl32.bc
echo  %hbdir%\lib\hbvm.lib + >> bl32.bc
echo  %hbdir%\lib\hbcplr.lib + >> bl32.bc
echo  %hbdir%\lib\hbrtl.lib + >> bl32.bc
echo  %hbdir%\lib\hblang.lib + >> bl32.bc
echo  %hbdir%\lib\hbcpage.lib + >> bl32.bc
echo  %hbdir%\lib\hbmacro.lib + >> bl32.bc
echo  %hbdir%\lib\hbrdd.lib + >> bl32.bc
echo  %hbdir%\lib\hbhsx.lib + >> bl32.bc
echo  %hbdir%\lib\rddntx.lib + >> bl32.bc
echo  %hbdir%\lib\rddcdx.lib + >> bl32.bc
echo  %hbdir%\lib\rddfpt.lib + >> bl32.bc
echo  %hbdir%\lib\hbsix.lib + >> bl32.bc
echo  %hbdir%\lib\hbcommon.lib + >> bl32.bc
echo  %hbdir%\lib\hbdebug.lib + >> bl32.bc
echo  %hbdir%\lib\hbpp.lib + >> bl32.bc
echo  %hbdir%\lib\hbpcre.lib + >> bl32.bc
echo  %hbdir%\lib\hbct.lib + >> bl32.bc
echo  %hbdir%\lib\hbmisc.lib + >> bl32.bc
echo  %hbdir%\lib\hbole.lib + >> bl32.bc
echo  %bcdir%\lib\import32.lib + >> bl32.bc
echo  %bcdir%\lib\cw32.lib + >> bl32.bc
echo  %bcdir%\lib\psdk\iphlpapi.lib + >> bl32.bc
echo  %bcdir%\lib\psdk\msimg32.lib >> bl32.bc


%bcdir%\bin\ilink32 -Gn -aa -s -Tpd -L%bcdir%\lib %bcdir%\lib\c0d32.obj .\%aplic%.obj,%aplic%.dll,,  @bl32.bc  ,,

pause

[asimoes]

O desafio agora é produzir um exemplo para MinGW e MSVC

[rochinha]

Amiguinho,

Neste caso não posso te ajudar pois não uso nenhum dos dois, mas tem algo que pode ajudar.

Na codificação para o MSVC a função DllEntryPoint deve ter seu nome alterado para DllMain para que na montagem seja reconhecida. Talvez esteja falando besteira, mas vejamos o trecho de código em VB:

Código: Selecionar todos

Option Explicit

Public Const DLL_PROCESS_DETACH = 0
Public Const DLL_PROCESS_ATTACH = 1
Public Const DLL_THREAD_ATTACH = 2
Public Const DLL_THREAD_DETACH = 3

Public Function DllMain(hInst As Long, fdwReason As Long, 
  lpvReserved As Long) As Boolean
   Select Case fdwReason
      Case DLL_PROCESS_DETACH
         ' No per-process cleanup needed
      Case DLL_PROCESS_ATTACH
         DllMain = True
      Case DLL_THREAD_ATTACH
         ' No per-thread initialization needed
      Case DLL_THREAD_DETACH
         ' No per-thread cleanup needed
   End Select
End Function

Public Function Increment(var As Integer) As Integer
   If Not IsNumeric(var) Then Err.Raise 5
   
   Increment = var + 1
End Function

Public Function Decrement(var As Integer) As Integer
   If Not IsNumeric(var) Then Err.Raise 5
   
   Decrement = var - 1
End Function

Public Function Square(var As Long) As Long
   If Not IsNumeric(var) Then Err.Raise 5
   
   Square = var ^ 2
End Function

Muito parecido não acha?

Como deu tempo de editar, neste link, tem umas informações sobre compilação com o GCC.

[asimoes]

Senhores,

Com MSVC não estou conseguindo gerar uma lib funcional, até com os exemplos do próprio harbour na pasta contrib/hbwin/test dá erro na chamada.
Com mingw eu consegui gerar um exemplo utilizando como nome de procedure DllMain e foi só isso também.

Até agora consegui gerar uma dll com funções exportáveis usando o velho borland c++ 5

[rochinha]

Amiguinhos,

Conforme consulta ao MSDN relacionado ao trato com DLL e funções sendo exportadas alguns extras devem ser manipulados.

A exemplo disto devidos aos diferentes tipos de convenções de exportação, seja __cdecl ou __stdcall, cada uma define a maneira que chamamos as funções no momento da exportação.

Para a criação das DLLs em C ainda é necessário usar um arquivo .DEF onde praticamente induzimos os nomes aos quais queremos nos referir as funções contidas nelas.

O trecho abaixo foi compilado ainda com Harbour e Borland, e obtive resultados apenas para ver se funcionava, mas é necessário o teste com MSVC. A redução do código é para facilitar a introdução de código que compatibilize e torne visivel as funções usando este compilador.

Código: Selecionar todos

/*
 * Harbour Project source code:
 *    Forum PC Toledo
 *    Desbravadores xBase
 *    Criando DLLs para uso com Harbour, Borland, MSVC e MingW
 *
 */
#pragma BEGINDUMP
    #include <windows.h>
    #include <hbvm.h>
    #include <hbapiitm.h>
    
    #define DllExport __declspec( dllexport )
    #define DllImport __declspec( dllimport )
    
    BOOL WINAPI DllMain( HINSTANCE hinstDLL, DWORD fdwReason, LPVOID lpvReserved )
    {
     HB_SYMBOL_UNUSED( hinstDLL );
     HB_SYMBOL_UNUSED( fdwReason );
     HB_SYMBOL_UNUSED( lpvReserved );
     switch( fdwReason )
     {
       case DLL_PROCESS_ATTACH:
         hb_vmInit( FALSE );
         break;
       case DLL_PROCESS_DETACH:
         hb_vmQuit();
         break;
     }   
     return TRUE;
    }
    // http://msdn.microsoft.com/pt-br/library/dt232c9t.aspx
    // __declspec(dllexport) void __cdecl Function1(void);
    // DllExport void __cdecl Function1(void);
    // OLESRV4.DEF
    // EXPORTS
    //    Beepar=_Beepar@0
    // A decoração de nome __stdcall prefixa o nome do símbolo com um sublinhado (_) e 
    // acrescenta o símbolo com um caractere da arroba (@) seguido pelo número de bytes 
    // na lista de argumentos (o espaço de pilha necessário). 
    // Como resultado, a função quando declarada como:
    // int __stdcall func (int a, double b)
    // é decorado como:
    // _func@12
    // A convenção de chamada do C (__cdecl) decora o nome como _func.
    // Para obter o nome decorado, use /MAP. O uso de __declspec(dllexport) faz o seguinte:
    // - Se a função for exportada com a convenção de chamada C (_cdecl), ela tira o sublinhado (_) principal quando o nome é exportado.
    // - Se a função que está sendo exportada não usa a convenção de chamada C (por exemplo, __stdcall), ela exporta o nome decorado.
    // Como não há nenhuma maneira de substituir onde a limpeza de pilha ocorre, você deve usar __stdcall. Para os nomes não 
    // decorados com __stdcall, você deve especificá-los usando aliases na seção de EXPORTAÇÕES do arquivo .def. 
    // Isso será mostrado a seguir para a seguinte declaração de função:
    //          int  __stdcall MyFunc (int a, double b);
    //          void __stdcall InitCode (void);
    // No arquivo .DEF:
    //          EXPORTS
    //             MYFUNC=_MyFunc@12
    //             INITCODE=_InitCode@0
    // Substituir __declspec(dllexport) void __cdecl Beepar()
    // por void pascal __export Beepar()
    // __declspec(dllexport) void __cdecl Beepar() ** not work **
    //__declspec(dllexport) void __stdcall Beepar()
    //void pascal __export Beepar()
    DllExport void pascal Beepar()
    { 
     hb_itemDoC( "Beepar", 0 );
    }
#pragma ENDDUMP

FUNCTION Beepar()
   return Tone( 500 ) 

Será necessário, talvez, a criação do arquivo NomeDaDLL.DEF e sua chamada no momento da geração da mesma.

Pelo que entendi, pensando em posicionamento de memória, as funções serão reconhecidas por nome + @ + numero de bytes de parâmetros, ou seja:

Código: Selecionar todos

MinhaFuncao@0

Quer dizer que esta função não recebe nenhum parâmetro.

Código: Selecionar todos

MinhaFuncao@12

Quer dizer que esta função esta sendo passado 2 parametro.

Código: Selecionar todos

MinhaFuncao@1

Quer dizer que esta função recebe um unico parametro.

Preciso estudar um pouco mais de C para entender estas maravilhas, porquanto, aqueles que tem know-how mais avantajado, que nos auxiliem com seus conhecimentos.

Por enquanto vou dando meus pitacos.

Facam as devidas modificações para compilação com MSVC.

Eu CREIO que conseguiremos resultados.

[asimoes]

Mestre Rochinha,

As suas dicas iluminarão a minha mente: :-Y

Bat de compilação

Código: Selecionar todos

@echo off

if exist msvc32.vc del msvc32.vc

set path=d:\harbour32_msvc\bin;d:\harbour32_msvc\comp\msvc\bin
set msvcdir=d:\hbmsvcfork32\comp\MSVC
set hbdir=d:\hbmsvcfork32
set hdirlib=d:\hbmsvcfork32\lib\win\msvc
set hwgui=d:\hbmsvcfork32\hwgui
set include=d:\hbmsvcfork32\comp\msvc\include;d:\hbmsvcfork32\include
set lib=d:\hbmsvcfork32\comp\msvc\lib;d:\hbmsvcfork32\lib\win\msvc

set aplic=ViewReportMSVC

%hbdir%\bin\harbour %aplic%.prg  /n /i%msvcdir%\include;%hbdir%\include;%hwgui%\include  /d__cplusplus /w0 /d__HARBOUR__ > comp.log
rem pause
IF ERRORLEVEL 1 GOTO COMPILEERRORS
echo -O2 -I%hdir%\include;%msvcdir%\include %aplic%.c > msvc32.vc
%msvcdir%\bin\cl -c @msvc32.vc
copy %msvcdir%\lib\uuid.lib
REM pause
:ENDCOMPILE


%msvcdir%\bin\link -nologo  -dll -out:%aplic%.dll -libpath:%hdirlib% -libpath:%hwgui%\lib %aplic%.obj hwgui.lib procmisc.lib hbwin.lib hbnf.lib xhb.lib hbtip.lib hbblink.lib hbct.lib hbextern.lib hbdebug.lib hbvm.lib hbrtl.lib hblang.lib hbcpage.lib gtcgi.lib gtstd.lib gtpca.lib gtwin.lib gtwvt.lib gtgui.lib hbrdd.lib hbuddall.lib hbusrrdd.lib rddntx.lib rddcdx.lib rddnsx.lib rddfpt.lib hbrdd.lib hbhsx.lib hbsix.lib hbmacro.lib hbcplr.lib hbpp.lib hbcommon.lib kernel32.lib user32.lib gdi32.lib advapi32.lib ws2_32.lib iphlpapi.lib winspool.lib comctl32.lib comdlg32.lib shell32.lib uuid.lib ole32.lib oleaut32.lib mpr.lib winmm.lib mapi32.lib imm32.lib msimg32.lib wininet.lib hbpcre.lib hbzlib.lib   

del %aplic%.c
del %aplic%.obj
del %aplic%.lib
del %aplic%.exp
del msvc32.vc
del comp.log
pause

Fonte da DLL

Código: Selecionar todos

**
* Fonte da DLL
**

#include "windows.ch"
#include "hwgui.ch"
#include "common.ch"
#include "guilib.ch"

PROCEDURE MyMethod
   MsgInfo("FUNÇÃO MyMethod")
RETURN 

FUNCTION Beepar()
RETURN Tone( 500 ) 

#pragma BEGINDUMP
  #include <windows.h>
  #include <hbvm.h>
  #include <hbapiitm.h>
  
  #define DllExport __declspec( dllexport )
  #define DllImport __declspec( dllimport )
  
  BOOL WINAPI DllMain( HINSTANCE hinstDLL, DWORD fdwReason, LPVOID lpvReserved )
  {
  HB_SYMBOL_UNUSED( hinstDLL );
  HB_SYMBOL_UNUSED( fdwReason );
  HB_SYMBOL_UNUSED( lpvReserved );
  switch( fdwReason )
  {
   case DLL_PROCESS_ATTACH:
    hb_vmInit( FALSE );
    break;
   case DLL_PROCESS_DETACH:
    hb_vmQuit();
    break;
  } 
  return TRUE;
  }
  // http://msdn.microsoft.com/pt-br/library/dt232c9t.aspx
  // __declspec(dllexport) void __cdecl Function1(void);
  // DllExport void __cdecl Function1(void);
  // OLESRV4.DEF
  // EXPORTS
  //  Beepar=_Beepar@0
  // A decoração de nome __stdcall prefixa o nome do símbolo com um sublinhado (_) e 
  // acrescenta o símbolo com um caractere da arroba (@) seguido pelo número de bytes 
  // na lista de argumentos (o espaço de pilha necessário). 
  // Como resultado, a função quando declarada como:
  // int __stdcall func (int a, double b)
  // é decorado como:
  // _func@12
  // A convenção de chamada do C (__cdecl) decora o nome como _func.
  // Para obter o nome decorado, use /MAP. O uso de __declspec(dllexport) faz o seguinte:
  // - Se a função for exportada com a convenção de chamada C (_cdecl), ela tira o sublinhado (_) principal quando o nome é exportado.
  // - Se a função que está sendo exportada não usa a convenção de chamada C (por exemplo, __stdcall), ela exporta o nome decorado.
  // Como não há nenhuma maneira de substituir onde a limpeza de pilha ocorre, você deve usar __stdcall. Para os nomes não 
  // decorados com __stdcall, você deve especificá-los usando aliases na seção de EXPORTAÇÕES do arquivo .def. 
  // Isso será mostrado a seguir para a seguinte declaração de função:
  //     int __stdcall MyFunc (int a, double b);
  //     void __stdcall InitCode (void);
  // No arquivo .DEF:
  //     EXPORTS
  //      MYFUNC=_MyFunc@12
  //      INITCODE=_InitCode@0
  // Substituir __declspec(dllexport) void __cdecl Beepar()
  // por void pascal __export Beepar()
  // __declspec(dllexport) void __cdecl Beepar() ** not work **
  //__declspec(dllexport) void __stdcall Beepar()
  //void pascal __export Beepar()
  //DllExport void pascal Beepar()
  DllExport void _cdecl  Beepar()
  { 
  hb_itemDoC( "Beepar", 0 );
  }
  
  DllExport void _cdecl  MyMethod()
  { 
  hb_itemDoC( "MyMethod", 0 );
  }
  
#pragma ENDDUMP

Para testar a DLL

Código: Selecionar todos

/*
 * Harbour Project source code:
 *    Dynamic library call demonstration. (on Windows)
 *
 * Copyright 2008 Viktor Szakats (vszakats.net/harbour)
 * www - http://harbour-project.org
 *
 */

#include "simpleio.ch"
#include "wvtwin.ch"
#include "hbcompat.ch"
#include "hbgtinfo.ch"
#include "hbgtwvg.ch"
#include "wvgparts.ch"
#include "dbinfo.ch"
#include "fileio.ch"
#include "hbdyn.ch"
#include "common.ch"
#include "set.ch"
#include "inkey.ch"

PROCEDURE Main()

   hLib := hb_libLoad( "ViewReportmsvc.dll" )
   
   IF ! Empty( hLib )
      n:=hb_DynCall( { "MyMethod", hLib, hb_bitOr( HB_DYN_CTYPE_CHAR_PTR , HB_DYN_CALLCONV_STDCALL )  })
      n:=hb_DynCall( { "Beepar", hLib, hb_bitOr( HB_DYN_CTYPE_CHAR_PTR , HB_DYN_CALLCONV_STDCALL )  })
      hb_libFree( hLib )
   ENDIF

   RETURN

INIT FUNCTION AppSetup()
  
  REQUEST HB_LANG_PT
  REQUEST HB_CODEPAGE_PT850
  HB_LANGSELECT("PT")
  HB_CDPSELECT( "PT850" ) //pt850
  
  REQUEST DBFCDX
  
  RddSetDefault("DBFCDX")
  
  SETMODE(25,80)
 
  SetColor("W+/B")
  
  CLS
 
  SetColor("W+/B")
  
  IniciaJanela()
 

RETURN Nil 
 

FUNCTION IniciaJanela(nLi,nCi,nLf,nCf)
 
LOCAL oCrt

PUBLIC nJanelaAplicacao, oDlgHabla

   HB_Default(@nLi,0)
   HB_Default(@nCi,0)
   HB_Default(@nLf,MaxRow())
   HB_Default(@nCf,MaxCol())
  
   cTituloJanela:="Teste com DLL"
 
   HB_gtInfo(HB_GTI_FONTNAME, "Lucida Console")
   HB_gtInfo(HB_GTI_WINTITLE, cTituloJanela)

   HB_gtInfo(HB_GTI_ICONRES, "IPRINTER2" ) 
   HB_gtInfo(HB_GTI_CLOSABLE, .F. )
   HB_gtInfo(HB_GTI_ISGRAPHIC, .T. )
   HB_gtInfo(HB_GTI_STDERRCON, .T. )
   HB_gtInfo(HB_GTI_COMPATBUFFER, .T. ) 
   HB_gtInfo(HB_GTI_SPEC, HB_GTS_WNDSTATE, HB_GTS_WS_MAXIMIZED )
   HB_gtInfo(HB_GTI_SPEC, HB_GTS_SHOWWINDOW, SW_NORMAL )
   
   nJanelaAplicacao:=hwg_FindWindow(,HB_gtInfo(HB_GTI_WINTITLE))
      
RETURN Nil
 
FUNCTION HB_GTSYS()
   REQUEST HB_GT_WVG_DEFAULT
   REQUEST HB_GT_WVT
   REQUEST HB_GT_WGU
   REQUEST HB_GT_WVG
RETURN Nil 

[asimoes]

Organizando a bat

Código: Selecionar todos

@echo off

if exist msvc32.vc del msvc32.vc
if exist msvcl32.vc del msvcl32.vc

set path=d:\hbmsvcfork32\bin;d:\hbmsvcfork32\comp\msvc\bin
set msvcdir=d:\hbmsvcfork32\comp\MSVC
set hbdir=d:\hbmsvcfork32
set hdirlib=d:\hbmsvcfork32\lib\win\msvc
set hwgui=d:\hbmsvcfork32\hwgui
set include=d:\hbmsvcfork32\comp\msvc\include;d:\hbmsvcfork32\include
set lib=d:\hbmsvcfork32\comp\msvc\lib;d:\hbmsvcfork32\lib\win\msvc

set aplic=DbView

%hbdir%\bin\harbour %aplic%.prg  /n /i%msvcdir%\include;%hbdir%\include;%hwgui%\include  /d__cplusplus /w0 /d__HARBOUR__ > comp.log
rem pause
IF ERRORLEVEL 1 GOTO COMPILEERRORS
echo -O2 -I%hdir%\include;%msvcdir%\include %aplic%.c > msvc32.vc
%msvcdir%\bin\cl -c /TC @msvc32.vc
copy %msvcdir%\lib\uuid.lib
REM pause
:ENDCOMPILE

echo -nologo  -dll -out:%aplic%.dll -subsystem:windows -libpath:%hdirlib% -libpath:%hwgui%\lib %aplic%.obj >> msvcl32.vc
echo hwgui.lib  >> msvcl32.vc
echo procmisc.lib >> msvcl32.vc
echo hbwin.lib >> msvcl32.vc
echo hbnf.lib >> msvcl32.vc
echo xhb.lib >> msvcl32.vc
echo hbtip.lib >> msvcl32.vc
echo hbblink.lib >> msvcl32.vc
echo hbct.lib >> msvcl32.vc
echo hbextern.lib >> msvcl32.vc
echo hbdebug.lib >> msvcl32.vc
echo hbvm.lib  >> msvcl32.vc
echo hbrtl.lib >> msvcl32.vc
echo hblang.lib >> msvcl32.vc
echo hbcpage.lib >> msvcl32.vc
echo gtcgi.lib >> msvcl32.vc
echo gtstd.lib >> msvcl32.vc 
echo gtpca.lib >> msvcl32.vc
echo gtwin.lib >> msvcl32.vc
echo gtwvt.lib >> msvcl32.vc
echo gtgui.lib >> msvcl32.vc
echo hbrdd.lib >> msvcl32.vc
echo hbuddall.lib >> msvcl32.vc
echo hbusrrdd.lib >> msvcl32.vc
echo rddntx.lib >> msvcl32.vc
echo rddcdx.lib >> msvcl32.vc
echo rddnsx.lib >> msvcl32.vc
echo rddfpt.lib >> msvcl32.vc
echo hbrdd.lib >> msvcl32.vc
echo hbhsx.lib >> msvcl32.vc
echo hbsix.lib >> msvcl32.vc
echo hbmacro.lib >> msvcl32.vc
echo hbcplr.lib >> msvcl32.vc
echo hbpp.lib >> msvcl32.vc
echo hbcommon.lib >> msvcl32.vc
echo kernel32.lib >> msvcl32.vc
echo user32.lib >> msvcl32.vc
echo gdi32.lib >> msvcl32.vc
echo advapi32.lib >> msvcl32.vc
echo ws2_32.lib >> msvcl32.vc
echo iphlpapi.lib >> msvcl32.vc
echo winspool.lib >> msvcl32.vc
echo comctl32.lib >> msvcl32.vc 
echo comdlg32.lib >> msvcl32.vc
echo shell32.lib >> msvcl32.vc 
echo uuid.lib >> msvcl32.vc
echo ole32.lib >> msvcl32.vc
echo oleaut32.lib >> msvcl32.vc
echo mpr.lib >> msvcl32.vc
echo winmm.lib >> msvcl32.vc
echo mapi32.lib >> msvcl32.vc
echo imm32.lib >> msvcl32.vc
echo msimg32.lib >> msvcl32.vc
echo wininet.lib >> msvcl32.vc
echo hbpcre.lib >> msvcl32.vc
echo hbzlib.lib   >> msvcl32.vc

%msvcdir%\bin\link @msvcl32.vc

del %aplic%.c
del %aplic%.obj
del %aplic%.lib
del %aplic%.exp
del msvc32.vc
del msvcl32.vc
del comp.log
pause

[rochinha]

Amiguinho,

1 - Usando o MSVC funcionou?
2 - Voce esta usou somente o Harbour?
3 - Voce esta usando a mesma versão de Harbour com cada um dos 3 compiladores?

[asimoes]

Rochinha,

1 - Usando o MSVC funcionou?
Sim, perfeitamente.
2 - Voce esta usou somente o Harbour?
Não, usei também o rundll32.
3 - Voce esta usando a mesma versão de Harbour com cada um dos 3 compiladores?
A versão para criar as DLL´s a primeira foi com Borland C++, esta última foi com MSVC conforme o post.

Só falta agora gerar uma DLL exportável em harbour com Mingw.