Clipper On Line • Ver Tópico - Criação de DLL com código xBase para uso com Harbour.

Criação de DLL com código xBase para uso com Harbour.

Discussão sobre a biblioteca Fivewin - O Clipper para Windows.

Moderador: Moderadores

 

Criação de DLL com código xBase para uso com Harbour.

Mensagempor rochinha » 09 Set 2014 06:29

Amiguinhos,

Aquele velho sonho de conseguir executar código xBase contido em uma .DLL compilada com Harbour se concretizou para mim.

Noites sem dormir e muita pesquisa, testes, compilações, chingamentos e sem sapeca-iá-iá, mas consegui.

Meus primeiros testes foram com exemplos existentes em todo lugar, Harbour, xHarbour, Fivewin, etc.

Busquei informações de como o RunDLL32 do Windows trabalhava e fiz minhas tentativas.

Num primeiro momento consegui fazer um EXE executar uma função em uma DLL mas só executava a primeira função que encontrava. Bom já era um começo, mas ao retornar ao EXE paulava.

Tentei com RunDLL32 chamado do EXE e não enfrentava mais este problema, mas tinha uma demora de uns segundos e não era o que eu queria.

Fiz meu próprio RunDLL32 mas ainda tinha de executá-lo indiretamente.

Bom enfim, cheguei onde queria e o primeiro passo para isto foi compilando o código de minha DLL:
rochadll.prg
/*
* Jose Carlos da Rocha
* Trabalho com DLL de codigo xBase para uso com Harbour
* Sao Paulo - 09/09/2014
* Baseados nos exemplos BabuDLL e outros
*/
#include "fivewin.ch"

#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 );
           return 0;
        }   

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

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

/*
* MENUITEM "&Clientes..." ACTION HbDllEntry( "Customer" ) MESSAGE "Manutencao de Clientes"
* Esta funcao foi chamada atraves de parametro da funcao exportavel hbDLLEntry()
* Chamada indireta, pois a funcao abaixo passa por outra funcao para agir
* Aqui o exemplo CUSTOMER foi imputado na DLL para demonstrar que trechos grandes de codigo
* podem residir dentro de uma DLL e serem chamados a partir de um EXE externo.
*/
#include "Customer.ch"

function Customer()
   local oWnd, oBar
   local oClients, oClient
   //local oName, cName

   SET _3DLOOK ON

   USE Customer SHARED NEW ALIAS Clients
   USE Sales    SHARED NEW
   SELECT Clients

   DEFINE WINDOW oWnd TITLE "Reporting tools" MDI ;
      MENU BuildMenu(oClients) COLOR "N/W"

   DEFINE BUTTONBAR oBar OF oWnd SIZE 60, 60 2007

   DEFINE BUTTON OF oBar ACTION MsgInfo( "Click" ) ;
      FILENAME "..\bitmaps\attach.bmp" PROMPT "Attach"

   DEFINE BUTTON OF oBar ACTION MsgInfo( "Click" ) ;
      FILENAME "..\bitmaps\calendar.bmp" PROMPT "Calendar"

   DEFINE BUTTON OF oBar ACTION MsgInfo( "Click" ) ;
      FILENAME "..\bitmaps\people2.bmp" PROMPT "Clients"

   DEFINE BUTTON OF oBar ACTION MsgInfo( "Click" )

   SET MESSAGE OF oWnd TO "Testing the FiveWin Report Class" CENTERED

   ACTIVATE WINDOW oWnd

   CLOSE DATABASES
   
return nil

function BuildMenu(oClients)
   local oMenu
   MENU oMenu
      MENUITEM "&DataBases"
      MENU
         MENUITEM "&Clients..." ACTION  BrwClients(oClients) ;
            MESSAGE "Clients management"
         MENUITEM "&Report..." ACTION GenReport()
         SEPARATOR
         MENUITEM "&End" ACTION oWnd:End() ;
            MESSAGE "End this test"
      ENDMENU
      oMenu:AddMdi()              // Add standard MDI menu options
   ENDMENU
   return oMenu

function BrwClients(oClients)
   local oBrw, oIco, oBarBrw
   if oClients != nil
      return nil
   endif
   DEFINE ICON oIco FILENAME "..\icons\customer.ico"
   DEFINE WINDOW oClients TITLE "Clients management" ;
      MDICHILD ICON oIco
   DEFINE BUTTONBAR oBarBrw OF oClients
   DEFINE BUTTON OF oBarBrw ACTION ShowClient(oClients)
   @ 2, 0 LISTBOX oBrw FIELDS OF oClients ;
      SIZE 500, 500 // ON CHANGE ChangeClient(oClients)
   oClients:SetControl( oBrw )
   ACTIVATE WINDOW oClients ;
      VALID( oClients := nil, .t. )        // We destroy the object
   return nil

function GenReport()
   local oWnd, oIco
   DEFINE ICON oIco FILENAME "..\icons\print.ico"
   DEFINE WINDOW oWnd MDICHILD TITLE "Clients report" ;
      VSCROLL HSCROLL ICON oIco
   ACTIVATE WINDOW oWnd
   return nil

function ShowClient(oClients)
   local oIco, oClient
   local oName, cName
   if oClient != nil
      return nil
   endif
   DEFINE ICON oIco FILENAME "..\icons\Person.ico"
   DEFINE DIALOG oClient RESOURCE "Client" ;
      ICON oIco TITLE "Detalhes"
   REDEFINE SAY ID 3 OF oClient   // To get the proper color
   REDEFINE SAY ID 4 OF oClient
   REDEFINE SAY ID 5 OF oClient
   REDEFINE GET oName VAR cName ID ID_NAME OF oClient
   REDEFINE BUTTON ID ID_NEXT OF oClient ACTION GoNext(oClients,oName)
   SELECT Sales     // We select Sales to properly initialize the Browse
   REDEFINE LISTBOX FIELDS ID ID_SALES OF oClient
   ACTIVATE DIALOG oClient CENTERED NOWAIT ;
      VALID ( oClient := nil, .t. )           // Destroy the object
   SELECT Clients
   return nil

function ChangeClient(oClients,oName)
   if oClients != nil
      cName = AllTrim( Clients->Last ) + ", " + Clients->First
      oName:Refresh()
   endif
   return nil

function GoNext(oClients,oName)
   if oClients != nil
      oClients:oControl:GoDown()
   else
      SKIP
      if EoF()
         GO BOTTOM
      endif
   endif
   ChangeClient(oClients,oName)
   return nil

/*
* MENUITEM "&Browse..."   ACTION HbDllEntry( "CusTeste" ) MESSAGE "Browse de Clientes"
* Esta funcao foi chamada atraves de parametro da funcao exportavel hbDLLEntry()
* Chamada indireta, pois a funcao abaixo passa por outra funcao para agir
*/
function CusTeste()
   USE Customer SHARED NEW ALIAS Clients
   Browse()
   CLOSE DATABASES
   return .t.

/*
* MENUITEM "&Customer..." ACTION CusTstBrw() MESSAGE "Browse de Clientes"
* Esta funcao foi chamada dentro da DLL usando o proprio nome ao inves de
* usar hbDLLEntry(), desta forma ficou mais legal
*/
function CusTstBrw()
   USE Sales SHARED NEW
   Browse()
   CLOSE DATABASES
   return .t.


Dentro do código da DLL existem aplicativos que serão chamados pela aplicação principal, Customer(), CusTeste() e CusTstBrw().

Atentem para o seguinte trecho:
#pragma BEGINDUMP
        ...
        void pascal __export HBDLLENTRY( char * cProcName )
        ...
        void pascal __export CusTstBrw()
        ...
#pragma ENDDUMP


Vejam que HBDLLENTRY e CusTstBrw são exportadas, ou seja, são visíveis as chamadas à DLL.

Então como compilar este .PRG e transformá-lo em uma .DLL?

Eu usei o bom-e-velho BUILDH.BAT com algumas alterações, vejam os trechos que foram modificados:
%hdir%\bin\harbour %1 /n /i%fwh%\include;%hdir%\include /w0 /p %3 /d__HARBOUR__ > comp.log
IF ERRORLEVEL 1 GOTO COMPILEERRORS
@type comp.log

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

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

echo %bcdir%\lib\c0d32.obj + > b32.bc


Quem usa este .BAT dirá, mas não tem nada de diferente neste trecho, mas tem sim e está na última linha, onde se vê echo %bcdir%\lib\c0d32.obj + > b32.bc

Quando compilamos nossos programas para gerar executáveis o arquivo c0w32.obj é o usado, mas neste caso usaremos o c0d32.obj.

Outra linha alterada no nosso BUILDH.BAT é a linha de chamada do iLink32.exe
if %GT% == gtgui %bcdir%\bin\ilink32 -Gn -aa -s -Tpd @b32.bc


No lugar de -Gn -aa -s -Tpe eu alterei para -Gn -aa -s -Tpd, onde e é para EXE e d é para DLL.

Bom, depois de gerada a DLL é possivel testá-la sem precisar do uso do aplicativo principal, bastando usar para isto o RunDLL32.exe do Windows, executando um comando simples:
%windir%\System32\RunDLL32 rochadll.dll,CusTstBrw


Leve em consideração que os testes foram feitos dentro da pasta SAMPLES do Fivewin, portanto as tabelas CUSTOMER.DBF e SALES.DBF serao usadas.

Se a DLL foi bem gerada um browse aparecerá mostrando os registros da tabela.

Agora vamos a parte do aplicativo principal. Este poderá ser compilado normalmente usando o BUILDH.BAT:
rocha.prg
/*
* Jose Carlos da Rocha
* Trabalho com DLL de codigo xBase para uso com Harbour
* Sao Paulo - 09/09/2014
* Baseados nos exemplos BabuDLL e outros
*/
#include "FiveWin.ch"

FUNCTION Main()

   local oWndMain, oBarMain
   
   DEFINE WINDOW oWndMain TITLE "Janela dentro do EXE" MDI MENU BuildMenuMain() COLOR "N/W"
   
          DEFINE BUTTONBAR oBarMain OF oWndMain SIZE 60, 60 2007

          DEFINE BUTTON OF oBarMain ACTION WinExec( "RunDLL32.exe rochadll.dll,CusTstBrw" )
          DEFINE BUTTON OF oBarMain ACTION UseDLL( "CusTstBrw", "rochadll.dll" )

          SET MESSAGE OF oWndMain TO "Testing the FiveWin DLLs" CENTERED

   ACTIVATE WINDOW oWndMain MAXIMIZED VALID MsgYesNo( "Quer sair?" )
   
   RETURN nil

FUNCTION BuildMenuMain()
   local oMenu
   MENU oMenu
      MENUITEM "Administracao"
      MENU
         MENUITEM "&Clientes..." ACTION HbDllEntry( "Customer" ) MESSAGE "Manutencao de Clientes"
         MENUITEM "&Browse..."   ACTION HbDllEntry( "CusTeste" ) MESSAGE "Browse de Clientes"
         MENUITEM "&Customer..." ACTION CusTstBrw() MESSAGE "Browse de Clientes"
         SEPARATOR
         MENUITEM "&Sair" ACTION oWnd:End() ;
            MESSAGE "Sair do sistema"
      ENDMENU
      oMenu:AddMdi()              // Add standard MDI menu options
   ENDMENU
   return oMenu

FUNCTION UseDLL( cFuncName, cDllName )
   local hDLL, cFarProc
   hDLL = LoadLibrary( cDllName )
   if hDll > 32
      cFarProc := GetProcAddress( hDLL, "DLLSYMINIT", .T., _INT )
      CallDLL( cFarProc )
      Eval( &( "{||" + cFuncName + "() }" ) )
   endif
   return nil

//-------------------------------------------------------------------------//
#include "dll.ch"

DLL32 FUNCTION CusTstBrw() AS LONG PASCAL LIB "rochadll.dll"

DLL32 FUNCTION HBDLLENTRY( cProc AS LPSTR ) AS LONG PASCAL LIB "rochadll.dll"
DLL32 FUNCTION HBDLLENTRY2( cProc AS LPSTR, pItem1 AS LONG, pItem2 AS LONG ) AS LONG PASCAL LIB "rochadll.dll"
DLL32 FUNCTION HBDLLENTRY3( cProc AS LPSTR, pItem1 AS _INT, pItem2 AS _INT ) AS _INT PASCAL LIB "rochadll.dll"


Vejamos agora algumas caracteristicas:
          ...
          DEFINE BUTTON OF oBarMain ACTION WinExec( "RunDLL32.exe rochadll.dll,CusTstBrw" )
          ...

No trecho acima faço execução de uma função dentro da .DLL usando execução de aplicativo externo.

          ...
          DEFINE BUTTON OF oBarMain ACTION UseDLL( "CusTstBrw", "rochadll.dll" )
          ...

Neste trecho, usando funções do Harbour exemplifico como chamar uma função existente na .DLL. Esta função deve ser EXPORTável e para tal foi necessária a definição de chamada desta função:
...
DLL32 FUNCTION CusTstBrw() AS LONG PASCAL LIB "rochadll.dll"
...


Abaixo vemos as formas de chamar nossas funções usando HbDllEntry, mas particularmente acho feio assim:
...
         MENUITEM "&Clientes..." ACTION HbDllEntry( "Customer" ) MESSAGE "Manutencao de Clientes"
         MENUITEM "&Browse..."   ACTION HbDllEntry( "CusTeste" ) MESSAGE "Browse de Clientes"
...


A função HbDllEntry() enxerga as funções que não são EXPORTáveis.

Vale lembrar que as .DLL não ficaram pequenas, mas o fator levado em consideração é que para a manutenção fica mais produtivo ter várias .DLLs no sistema e ao modificar uma ou outra, podemos atualizar somente elas sem prejuízo ao EXE principal.

Outra coisa importante:

As telas usadas no aplicativo, não importando qual .DLL poderá usá-la, deverão ser compiladas com o .EXE principal.

O Harbour usado foi a versão 3.2-17626.

O download deste trabalho encontra-se no 4shared.com.

Tenho grande certeza, que seria possivel chamar código xBase contido nas .DLLs através de outras linguagens como Delphi ou Visual Basic. Vale a pena testar e retornar.
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para fivolution@hotmail.com. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Avatar de usuário

rochinha
Membro Master

Membro Master
 
Mensagens: 4538
Data de registro: 18 Ago 2003 20:43
Cidade/Estado: São Paulo - Brasil
Curtiu: 800 vezes
Mens.Curtidas: 242 vezes

Criação de DLL com código xBase para uso com Harbour.

Mensagempor Pablo César » 09 Set 2014 08:44

Parabéns Rochinha, excelente trabalho !

Isto vai servir de base a muitos. !

Obrigado por compartilhar ! :)
Um clip-abraço !

Pablo César Arrascaeta
Compartilhe suas dúvidas e soluções com todos os colegas aqui do fórum.
Evite enviar as dúvidas técnicas por MPs ou eMails, assim todos iremos beneficiar-nos.
Avatar de usuário

Pablo César
Usuário Nível 7

Usuário Nível 7
 
Mensagens: 5312
Data de registro: 31 Mai 2006 10:22
Cidade/Estado: Curitiba - Paraná
Curtiu: 142 vezes
Mens.Curtidas: 152 vezes

Criação de DLL com código xBase para uso com Harbour.

Mensagempor rochinha » 09 Set 2014 10:47

Amiguinho,

Obrigado. Tem uma alteração a ser feita no código da rochadll.prg. A linha 33 deve ser retirada pois o RETURN 0; sobrou.
030           void pascal __export HBDLLENTRY( char * cProcName )
031           {
032              hb_itemDoC( cProcName, 0, 0 );
033              return 0; // ----------- Retirar esta linha
034           }   


Isto vai servir de base a muitos. !


Creio que sim, geralmente fazemos integração de .DLLs de fora para dentro e espero fazer testes, logo-logo, de dentro para fora.
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para fivolution@hotmail.com. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Avatar de usuário

rochinha
Membro Master

Membro Master
 
Mensagens: 4538
Data de registro: 18 Ago 2003 20:43
Cidade/Estado: São Paulo - Brasil
Curtiu: 800 vezes
Mens.Curtidas: 242 vezes

Criação de DLL com código xBase para uso com Harbour.

Mensagempor asimoes » 09 Set 2014 21:22

Olá Rochinha

Boa noite,

Estou tentando reproduzir o seu exemplo que é muito interessante usando a minigui, eu não tenho a fivewin para testar
estou tendo este problema na hora da compilação, você poderia verificar?

A minha bat de compilação:

O compilador que eu estou usando é 0 bcc58
@echo off
set bcdir=d:\borland\bcc582
set hdir=d:\minigui\harbour
set mini=d:\minigui

%hdir%\bin\harbour rochadll.prg /n /i%mini%\include;%hdir%\include /w0 /p rochadll /d__HARBOUR__ > comp.log
IF ERRORLEVEL 1 GOTO COMPILEERRORS
@type comp.log
echo -O2 -erochadll.exe -I%hdir%\include;%bcdir%\include rochadll.c > b32.bc
%bcdir%\bin\bcc32 -M -c @b32.bc
copy %bcdir%\lib\uuid.lib
:ENDCOMPILE
echo %bcdir%\lib\c0d32.obj + > b32.bc
%bcdir%\bin\ilink32 -Gn -aa -s -Tpd @b32.bc
pause


Harbour 3.2.0dev (r1409051124)
Copyright (c) 1999-2014, http://harbour-project.org/
Compiling 'rochadll.prg' and generating preprocessed output to 'rochadll.ppo'...
Lines 20834, Functions/Procedures 1
Generating C source output to 'rochadll.c'... Done.
Compiling 'rochadll.prg' and generating preprocessed output to 'rochadll.ppo'...
Lines 20834, Functions/Procedures 1
Generating C source output to 'rochadll.c'... Done.
Borland C++ 5.82 for Win32 Copyright (c) 1993, 2005 Borland
rochadll.c:
        1 arquivo(s) copiado(s).
Turbo Incremental Link 5.69 Copyright (c) 1997-2005 Borland
Error: Unresolved external 'GetVersion' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external '__ErrorMessage' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external '___CRTL_DLL_Lock' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external '___CRTL_VCL_Init' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external '___CRTL_MEM_UseBorMM' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external '___CRTL_VCLLIB_Linkage' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external '__ExceptInit' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external '__pRawDllMain' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external '__startupd' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external '__free_heaps' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external '___CRTL_VCL_Exit' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external '___CRTL_DLL_Unlock' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external '__GetExceptDLLinfoInternal' referenced from D:\BORLAND\BCC582\LIB\C0D32.
OBJ
Error: Unresolved external 'HeapAlloc' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external '___CRTL_TLS_SetValue' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external '___CRTL_TLS_InitThread' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external 'GetProcessHeap' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external 'HeapFree' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external '___CRTL_TLS_ExitThread' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external '___CRTL_TLS_Free' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external '___CRTL_TLS_Alloc' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external 'DllEntryPoint' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external '__argv_expand_ptr' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external '__wargv_expand_ptr' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external '__handle_setargv' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external '__handle_exitargv' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external '__handle_wsetargv' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external '__handle_wexitargv' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external '__fileinfo' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external '___CRTL_TLS_GetValue' referenced from D:\BORLAND\BCC582\LIB\C0D32.OBJ
Error: Unresolved external '__turboFloat' referenced from root
â–ºHarbour 3.x | Minigui xx-x | HwGuiâ—„
Pense nas possibilidades abstraia as dificuldades.
Não corrigir nossas falhas é o mesmo que cometer novos erros.
A imaginação é mais importante que o conhecimento. (Albert Einstein)
Avatar de usuário

asimoes
Colaborador

Colaborador
 
Mensagens: 4919
Data de registro: 26 Abr 2007 16:48
Cidade/Estado: RIO DE JANEIRO-RJ
Curtiu: 341 vezes
Mens.Curtidas: 258 vezes

Criação de DLL com código xBase para uso com Harbour.

Mensagempor Pablo César » 09 Set 2014 21:40

asimoes escreveu:Estou tentando reproduzir o seu exemplo que é muito interessante usando a minigui, eu não tenho a fivewin para testar
estou tendo este problema na hora da compilação, você poderia verificar?
Interessante Alexandre, favor continue e poste o andamento. Eu quando consiga um tempo, também vou querer fazê-lo em MiniGW para HMG.
Um clip-abraço !

Pablo César Arrascaeta
Compartilhe suas dúvidas e soluções com todos os colegas aqui do fórum.
Evite enviar as dúvidas técnicas por MPs ou eMails, assim todos iremos beneficiar-nos.
Avatar de usuário

Pablo César
Usuário Nível 7

Usuário Nível 7
 
Mensagens: 5312
Data de registro: 31 Mai 2006 10:22
Cidade/Estado: Curitiba - Paraná
Curtiu: 142 vezes
Mens.Curtidas: 152 vezes

Criação de DLL com código xBase para uso com Harbour.

Mensagempor asimoes » 10 Set 2014 15:16

Prezados,

Consegui gerar a dll usando a minigui. onde na dll eu faço: MsgInfo("Helo World")
â–ºHarbour 3.x | Minigui xx-x | HwGuiâ—„
Pense nas possibilidades abstraia as dificuldades.
Não corrigir nossas falhas é o mesmo que cometer novos erros.
A imaginação é mais importante que o conhecimento. (Albert Einstein)
Avatar de usuário

asimoes
Colaborador

Colaborador
 
Mensagens: 4919
Data de registro: 26 Abr 2007 16:48
Cidade/Estado: RIO DE JANEIRO-RJ
Curtiu: 341 vezes
Mens.Curtidas: 258 vezes

Criação de DLL com código xBase para uso com Harbour.

Mensagempor asimoes » 10 Set 2014 16:31

Exemplo funcionando:


@echo off
set bcdir=d:\borland\bcc58
set hdir=d:\minigui\harbour
set mini=d:\minigui

%hdir%\bin\harbour PlayDraw.prg /n /i%mini%\include;%hdir%\include /w0 /p PlayDraw /d__HARBOUR__ > comp.log
IF ERRORLEVEL 1 GOTO COMPILEERRORS
@type comp.log
echo -O2 -ePlayDraw.exe -I%hdir%\include;%bcdir%\include PlayDraw.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  %mini%\lib\tsbrowse.lib + >> bl32.bc
echo  %mini%\lib\propgrid.lib + >> bl32.bc
echo  %mini%\lib\minigui.lib + >> bl32.bc
echo  %hdir%\lib\dll.lib + >> bl32.bc
echo  %hdir%\lib\gtgui.lib + >> bl32.bc

echo  %hdir%\lib\xhb.lib + >> bl32.bc
echo  %hdir%\lib\hbvm.lib + >> bl32.bc
echo  %hdir%\lib\hbcplr.lib + >> bl32.bc
echo  %hdir%\lib\hbrtl.lib + >> bl32.bc
echo  %hdir%\lib\hblang.lib + >> bl32.bc
echo  %hdir%\lib\hbcpage.lib + >> bl32.bc
echo  %hdir%\lib\hbmacro.lib + >> bl32.bc
echo  %hdir%\lib\hbrdd.lib + >> bl32.bc
echo  %hdir%\lib\hbhsx.lib + >> bl32.bc
echo  %hdir%\lib\rddntx.lib + >> bl32.bc
echo  %hdir%\lib\rddcdx.lib + >> bl32.bc
echo  %hdir%\lib\rddfpt.lib + >> bl32.bc
echo  %hdir%\lib\hbsix.lib + >> bl32.bc
echo  %hdir%\lib\hbcommon.lib + >> bl32.bc
echo  %hdir%\lib\hbdebug.lib + >> bl32.bc
echo  %hdir%\lib\hbpp.lib + >> bl32.bc
echo  %hdir%\lib\hbpcre.lib + >> bl32.bc
echo  %hdir%\lib\hbct.lib + >> bl32.bc
echo  %hdir%\lib\hbmisc.lib + >> bl32.bc
echo  %hdir%\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 .\PlayDraw.obj,PlayDraw.dll,,  @bl32.bc  ,,

pause


Usei um exemplo da Minigui para testar.

/*

   PlayDraw.prg

   Needless affairs !

   Some 2 dimension drawing efforts on a totally 3 dimensioned world !

   Experimentations on some HMG's DRAW commands.

   Copyrigth : Everybody can play with any way like :)

   Author : Bicahi Esgici

   History :
            July 2012 : First release

*/

#include <hmg.ch>

#define  n2Pi ( 44 / 7 )
#define  nStylCount  4

Static nSkipLevel := 0
Static aColorS    := { YELLOW, RED, WHITE, BLUE, FUCHSIA, GREEN,  PURPLE, GRAY, PINK, BROWN, ORANGE }
Static lFrmRSized := .F.  // Form ReSized

PROCEDURE PlayDraw()

   DEFINE WINDOW frmPlayDraw ;
      AT 0, 0 ;
      WIDTH  600 ;
      HEIGHT 600 ;
      TITLE "Playing by Drawing" ;
      MAIN ;
      BACKCOLOR { 0, 0, 0 }  ;
      ON INIT GoDraw() ;
      ON SIZE ( lFrmRSized := .T. ) ;
      ON MAXIMIZE ( lFrmRSized := .T. )

      ON KEY ESCAPE    ACTION frmPlayDraw.Release

      ON KEY HOME      ACTION ( nSkipLevel := 4 )   // Go BOF   
      ON KEY NEXT      ACTION ( nSkipLevel := 3 )   // Next Style
      ON KEY DOWN      ACTION ( nSkipLevel := 2 )   // Next Color
      ON KEY RIGHT     ACTION ( nSkipLevel := 1 )   // Next Shape

      @ 20, 20 BUTTON btnHelp CAPTION "?" BOLD WIDTH 20 HEIGHT 20 ;
               TOOLTIP "Keys" ;
               ACTION MsgInfo( "HOME : Restart"    + CRLF +;
                               "NEXT : Next Style" + CRLF +;
                               "DOWN : Next Color" + CRLF +;
                               "RIGHT : Next Shape" )

   END WINDOW // frmPlayDraw

   frmPlayDraw.Center
   frmPlayDraw.Activate

RETURN // Main()

*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._

PROCEDURE GoDraw()                       // Drawing lines by predefined styles

   LOCAL nStyleNum    := 1,;
         nFormWidth,;
         nFormHeigth,;
         nFormCenterX,;
         nFormCenterY,;
         nHorRadius,;
         nVerRadius,;
         nLinePenW

   LOCAL aPCCounts := { ;                       // Point & Corner Counts per Style
                        { 12, 48, 48, 32 },;       // Point Counts
                        { 12, 48,  3,  1 } }       // Corner Counts

   LOCAL nPCount,;
         nCCount,;
         nRatio

   LOCAL nHDecrement,;
         nVDecrement,;
         nZStep       := 0

   LOCAL aParams

   LOCAL nFactor,;
         nLineBeg,;
         nLineEnd

   LOCAL nFactBeg,;
         nFactEnd,;     
         nFactStp,;         
         nLBegBeg,;
         nLBegEnd,;
         nLBegStp,;
         nLCrmBeg,;
         nLCrmEnd,;
         nLCrmStp

   LOCAL a1Color, aColorNo, nDelay, nCornCremnt, nHRadius, nVRadius,;
         nLineBegY, nLineBegX, nLineEndY, nLineEndX, nBaseCrm

   WHILE .T.
   
      nPCount     := aPCCounts[ 1, nStyleNum ]
      nCCount     := aPCCounts[ 2, nStyleNum ]
      nRatio      := nPCOunt / nCCOunt
      aParams     := { ;
                        { ;                                       // Style 1
                          { 1,        2,       .1 },;             // nFactor
                          { 1,        nPCount,  1 },;             // nLineBeg
                          { 1,        nPCount,  1 };              // nCornCremnt
                        },;                                          // EOF Style 1
                        { ;                                       // Style 2
                          { 0,        3,       .5 },;             // nFactor
                          { 1,        nPCount,  1 },;             // nLineBeg
                          { 0,        nPCount,  nPCOunt / 4 };    // nCornCremnt
                        },;                                          // EOF Style 2
                        { ;                                       // Style 3
                          { 0,        8,        1 },;             // nFactor
                          { 1,        nRatio,   1 },;             // nLineBeg
                          { nRatio,   nPCount,  nRatio };         // nCornCremnt
                        },;                                          // EOF Style 3
                        { ;                                       // Style 4
                          { 2,        8,        1 },;             // nFactor
                          { 1,        nPCount,  1 },;             // nLineBeg
                          { nZStep-1, nPCount,  nZStep };         // nCornCremnt
                        };                                           // EOF Style 4
                     }                                            // EOF aParams
                         
      nFactBeg := aParams[ nStyleNum, 1, 1 ]
      nFactEnd := aParams[ nStyleNum, 1, 2 ]
      nFactStp := aParams[ nStyleNum, 1, 3 ]
      nLBegBeg := aParams[ nStyleNum, 2, 1 ]
      nLBegEnd := aParams[ nStyleNum, 2, 2 ]
      nLBegStp := aParams[ nStyleNum, 2, 3 ]
      nLCrmBeg := aParams[ nStyleNum, 3, 1 ]
      nLCrmEnd := aParams[ nStyleNum, 3, 2 ]
      nLCrmStp := aParams[ nStyleNum, 3, 3 ]
     
      WHILE .T.     
     
         ERASE WINDOW frmPlayDraw
         
         nFormWidth   := frmPlayDraw.WIDTH
         nFormHeigth  := frmPlayDraw.HEIGHT - 20
         nFormCenterX := nFormWidth / 2
         nFormCenterY := nFormHeigth / 2
         nHorRadius   := nFormCenterX * .75
         nVerRadius   := nFormCenterY * .75
         nLinePenW    := 1
         
         nHDecrement  := nHorRadius / nPCOunt
         nVDecrement  := nVerRadius / nPCOunt
     
         FOR aColorNo := 1 TO LEN( aColorS )
         
            a1Color := aColorS[ aColorNo ]
               
            IF nStyleNum = 1               
               nHRadius := nHorRadius
               nVRadius := nVerRadius
            ENDIF nStyleNum = 1               
         
            FOR nFactor := nFactBeg TO nFactEnd STEP nFactStp     
           
               ERASE WINDOW frmPlayDraw
               
               IF nStyleNum = 1
               
                  IF nFactor < nFactBeg + ( nFactEnd - nFactBeg ) / 2
                     nHRadius := nHorRadius / nFactor
                  ELSE
                     nVRadius := nVerRadius / ( nFactBeg + ( nFactEnd - nFactor ) )
                     nHRadius := nHorRadius
                  ENDIF nFactor < 6
                 
               ENDIF nStyleNum = 1
               
               IF nStyleNum = 4               
                  nHRadius := nHorRadius
                  nVRadius := nVerRadius
               
                  nLineBegX := nHRadius * COS( n2Pi / nPCOunt ) + nFormCenterX
                  nLineBegY := nVRadius * SIN( n2Pi / nPCOunt ) + nFormCenterY
     
                  nZStep    := ( nPCOunt + 1 ) / nFactor
                 
                  nLCrmBeg  := nZStep - 1
                  nLCrmStp  := nZStep
                 
               ENDIF nStyleNum = 4               
               
               FOR nLineBeg := nLBegBeg TO nLBegEnd STEP nLBegstp
               
                  IF nStyleNum > 1 .AND. nStyleNum < 4
                     nVRadius := nVerRadius - nFactor * nLineBeg
                     nHRadius := nHorRadius - nFactor * nLineBeg
                  ENDIF nStyleNum > 1 .AND. nStyleNum < 4
               
                  IF nStyleNum < 3 .OR. nLineBeg < 2
                     nLineBegY := nVRadius * COS( n2Pi / nPCOunt * nLineBeg ) + nFormCenterY
                     nLineBegX := nHRadius * SIN( n2Pi / nPCOunt * nLineBeg ) + nFormCenterX
                  ENDIF
                 
                  IF nStyleNum = 1   
                     nLCrmBeg := nLineBeg
                  ENDIF nStyleNum = 1               
                 
                  IF nStyleNum = 4               
                     nHRadius := nHRadius - nHDecrement
                     nVRadius := nVRadius - nVDecrement
                  ENDIF nStyleNum = 4               
     
                  FOR nCornCremnt := nLCrmBeg TO nLCrmEnd STEP nLCrmStp
                 
                     IF nStyleNum = 1               
                        nBaseCrm := 0                         
                     ELSE
                        nBaseCrm := nLineBeg
                     ENDIF   
                     
                     nLineEnd := nBaseCrm + nCornCremnt
                     
                     IF nStyleNum < 4               
                        IF nLineEnd > nPCOunt
                           nLineEnd := nLineEnd - nCornCremnt
                        ENDIF
                     ENDIF nStyleNum < 4               
                     
                     IF nStyleNum > 1 .AND. nStyleNum < 4             
                        nVRadius := nVerRadius - nFactor * nLineEnd
                        nHRadius := nHorRadius - nFactor * nLineEnd
                     ENDIF nStyleNum > 1 .AND. nStyleNum < 4             
         
                     nLineEndY := nFormCenterY + ( nVRadius * COS( n2Pi / nPCount * nLineEnd ) )
                     nLineEndX := nFormCenterX + ( nHRadius * SIN( n2Pi / nPCount * nLineEnd ) )
                           
                     DRAW LINE IN WINDOW frmPlayDraw  AT nLineBegY, nLineBegX ;
                                                      TO nLineEndY, nLineEndX ;
                                                      PENCOLOR a1Color ;
                                                      PENWIDTH nLinePenW
                                                     
                     IF nStyleNum > 2               
                        nLineBegY := nLineEndY
                        nLineBegX := nLineEndX
                     ENDIF nStyleNum > 2               
                     
                     nDelay := SECONDS()
                           
                     WHILE ( SECONDS() - nDelay ) < .01
                        DO EVENTS
                     ENDDO
                     
                     IF lFrmRSized
                        EXIT
                     ENDIF
   
                     IF nSkipLevel > 0
                        EXIT
                     ENDIF
                     
                  NEXT nCornCremnt
                 
                  IF lFrmRSized
                     EXIT
                  ENDIF
                 
                  IF nSkipLevel > 0
                     --nSkipLevel
                     EXIT
                  ENDIF
                       
               NEXT nLineBeg
   
               IF lFrmRSized
                  EXIT
               ENDIF
               
               IF nSkipLevel > 0
                  --nSkipLevel
                  EXIT
               ENDIF

            NEXT nFactor
           
            IF nSkipLevel > 0
               --nSkipLevel
               EXIT
            ENDIF
           
            IF lFrmRSized
               EXIT
            ENDIF
                 
         NEXT a1Color   
         
         IF lFrmRSized
            lFrmRSized := .F.
            LOOP
         ENDIF
         
         IF nSkipLevel > 0
            nSkipLevel := 0
            nStyleNum  := 0
         ENDIF
         
         EXIT
         
      ENDDO
     
      ++nStyleNum
     
      IF nStyleNum > nStylCount
         nStyleNum := 1
      ENDIF
     
   ENDDO
   
RETURN // GoDraw()   

*-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._

#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 PlayDraw()
    {
     hb_itemDoC( "PlayDraw", 0 );
    }

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


Já testei no delphi e funcionou

Para testar:

rundll32 playdraw.dll,PlayDraw
â–ºHarbour 3.x | Minigui xx-x | HwGuiâ—„
Pense nas possibilidades abstraia as dificuldades.
Não corrigir nossas falhas é o mesmo que cometer novos erros.
A imaginação é mais importante que o conhecimento. (Albert Einstein)
Avatar de usuário

asimoes
Colaborador

Colaborador
 
Mensagens: 4919
Data de registro: 26 Abr 2007 16:48
Cidade/Estado: RIO DE JANEIRO-RJ
Curtiu: 341 vezes
Mens.Curtidas: 258 vezes

Criação de DLL com código xBase para uso com Harbour.

Mensagempor janio » 10 Set 2014 18:41

Sem sapeca-iá-iá

kkkkkkkkkkk
fui...
e-mail:janioaguiar@yahoo.com.br
msn: janio_aguiar@hotmail.com
xHarbour1.2.1/Harbour3.2 + wvg + hwgui + Mediator + MySql
Avatar de usuário

janio
Colaborador

Colaborador
 
Mensagens: 1835
Data de registro: 06 Jul 2004 07:43
Cidade/Estado: UBAJARA - CE
Curtiu: 8 vezes
Mens.Curtidas: 68 vezes

Criação de DLL com código xBase para uso com Harbour.

Mensagempor rochinha » 10 Set 2014 20:22

Amiguinhos,

Bom ver que estão conseguindo resultados. Apesar do meu exemplo ter chamada da Fivewin.ch os recursos utilizados foram todos do Harbour.

Sem sapeca-iá-iá

kkkkkkkkkkk


Pois amigo Janio, minha esposa perguntava: "...Amor voce vem dormir cedo?..." eu respondia: "...sim meu amor, cedo, bem cedo..."
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para fivolution@hotmail.com. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Avatar de usuário

rochinha
Membro Master

Membro Master
 
Mensagens: 4538
Data de registro: 18 Ago 2003 20:43
Cidade/Estado: São Paulo - Brasil
Curtiu: 800 vezes
Mens.Curtidas: 242 vezes

Criação de DLL com código xBase para uso com Harbour.

Mensagempor Ariovaldo » 16 Mar 2015 13:51

Ola Grupo, minha primeira mensagem.. Gostaria de saber como eu faço para chamar uma classe dentro de uma DLL, tudo que foi falado acima funcionou.

MInha Classe: TVRLis210():New() onde em algumas classes eu passo para metros no method New()

Obrigado por qualquer ajuda.

Ari
São Paulo

Uso o FiveWin com xHarbour
Ariovaldo
Usuário Nível 1

Usuário Nível 1
 
Mensagens: 3
Data de registro: 16 Mar 2015 13:25
Cidade/Estado: São Paulo/SP
Curtiu: 0 vez
Mens.Curtidas: 1 vez




Retornar para FiveWin

Quem está online

Usuários vendo este fórum: Nenhum usuário registrado online e 7 visitantes


Ola Amigo, espero que meu site e forum tem lhe beneficiado, com exemplos e dicas de programacao.
Entao divulgue o link da Doacao abaixo para seus amigos e redes sociais ou faça uma doacao para o site forum...
MUITO OBRIGADO PELA SUA DOACAO!
Faça uma doação para o forum
cron
v
Olá visitante, seja bem-vindo ao Fórum Clipper On Line!
Efetue o seu login ou faça o seu Registro