Eu conseguir fazer algumas alterações para que a dll possa receber parametros:
Exemplo de chamada da função no delphi
Código: Selecionar todos
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
type
tyDLLxHarbour = procedure( p1:pChar;p2:pChar;p3:pChar;p4:pChar ); stdcall;
var
funcao: tyDLLxHarbour;
libInstance : hModule;
begin
libInstance := LoadLibrary('RochaDLL.DLL');
{---| Caso o valor seja 0, a biblioteca não foi encontrada |---}
if libInstance <> 0 then
try
Funcao := tyDLLxHarbour(GetProcAddress(LibInstance, 'HBDLLENTRY' ));
funcao('Customer','218|INC|MOTREX|TESTE X SSST','218','219');
finally
{---| Libera a Biblioteca |---}
FreeLibrary(libInstance);
end
else
raise Exception.Create('Erro ao carregar biblioteca.');
end;
end.
fonte para gerar a dll:
Código: Selecionar todos
*----------------------------------------------------------------------------*
#pragma BEGINDUMP
#include <windows.h>
#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 GRAVARNF()
{
hb_itemDoC( "GRAVARNF", 0 );
}
void pascal __export EXCLUIRNF()
{
hb_itemDoC( "EXCLUIRNF", 0 );
}
HB_EXPORT char * PASCAL _export HBDLLENTRY( char * cProcName, char * cText1, char * cText2, char * cText3 )
{
PHB_ITEM pResult;
PHB_ITEM pItem1 = hb_itemPutC( NULL, cText1 );
PHB_ITEM pItem2 = hb_itemPutC( NULL, cText2 );
PHB_ITEM pItem3 = hb_itemPutC( NULL, cText3 );
pResult = hb_itemDoC( cProcName, 3, pItem1, pItem2, pItem3, 0 );
hb_itemRelease( pItem1 );
hb_itemRelease( pItem2 );
hb_itemRelease( pItem3 );
return hb_itemGetC( pResult );
}
HB_EXPORT char * PASCAL _export JAIR( char * cProcName, char * cText1 )
{
PHB_ITEM pResult;
PHB_ITEM pItem1 = hb_itemPutC( NULL, cText1 );
MessageBox( 0, "Entou na DLL e chamou a função Jair( cText1 )", "1", 0 );
pResult = hb_itemDoC( cProcName, 1, pItem1, 0 );
hb_itemRelease( pItem1 );
return hb_itemGetC( pResult );
}
#pragma ENDDUMP
*----------------------------------------------------------------------------*
#include "windows.ch"
#include "guilib.ch"
#include "inkey.ch"
#include "fileio.ch"
#include "hbclass.ch"
#include "common.ch"
*#include "common.ch"
*#include "Fileio.ch"
#define CRLF CHR(13)+CHR(10)
#command DEFAULT <param> := <val> [, <paramn> := <valn> ];
=> ;
<param> := IIF(<param> = NIL, <val>, <param> ) ;
[; <paramn> := IIF(<paramn> = NIL, <valn>, <paramn> ) ]
*----------------------------------------------------------------------------*
* Provisorio para testar com a dll rochadll.dll *
*----------------------------------------------------------------------------*
FUNCTION Customer(cMsg1, cMsg2, cMsg3)
PUBLIC LSISTEMAON := .T.
PRIVATE lSistemaON := .F.
PRIVATE lErro := .F.
GRAVARNF(cMsg1, cMsg2, cMsg3)
RETURN NIL
*----------------------------------------------------------------------------*
*----------------------------------------------------------------------------*
* Programa....: Gravar_NF() *
* Objetivo....: Importar notas fiscais lay-out softlogic *
*----------------------------------------------------------------------------*
FUNCTION GRAVARNF(pParam1, pParam2, pParam3)
cMsg1:="==> "+pParam1+CHR(13)+CHR(10)+pParam2+CHR(13)+CHR(10)+pParam3
MsgInfo( cMsg1,"Acesso via dll." )
cReturn :=cMsg1+" Retoro de processamento da dll."
*
*
RETURN .T.
Bat para compilação da dll em xharbour + hwgui
Código: Selecionar todos
@echo off
set HRB_DIR=c:\xharbour
set HWGUI_INSTALL=c:\xharbour
SET HB_MT=
SET C_DEFINES=
SET H_DEFINES=
%HRB_DIR%\bin\harbour minhadll.prg %H_DEFINES% -n -i%HRB_DIR%\include;%HWGUI_INSTALL%\include %2 %3
bcc32 -v -y -c %C_DEFINES% -O2 -tW -M -I%HRB_DIR%\include;%HWGUI_INSTALL%\include minhadll.c
echo c0d32.obj + > b32.bc
echo minhadll.obj, + >> b32.bc
echo ROCHADLL.dll, + >> b32.bc
echo ROCHADLL.map, + >> b32.bc
echo %HWGUI_INSTALL%\lib\hwgui.lib + >> b32.bc
echo %HWGUI_INSTALL%\lib\procmisc.lib + >> b32.bc
echo %HWGUI_INSTALL%\lib\hbxml.lib + >> b32.bc
echo %HWGUI_INSTALL%\lib\hwg_qhtm.lib + >> b32.bc
echo %HWGUI_INSTALL%\lib\hbactivex.lib + >> b32.bc
echo %HRB_DIR%\lib\rtl%HB_MT%.lib + >> b32.bc
echo %HRB_DIR%\lib\vm%HB_MT%.lib + >> b32.bc
if exist %HRB_DIR%\lib\gtgui.lib echo %HRB_DIR%\lib\gtgui.lib + >> b32.bc
if not exist %HRB_DIR%\lib\gtgui.lib echo %HRB_DIR%\lib\gtwin.lib + >> b32.bc
echo %HRB_DIR%\lib\ct.lib + >> b32.bc
echo %HRB_DIR%\fbclient.lib + >> b32.bc
echo %HRB_DIR%\firebird.lib + >> b32.bc
echo %HRB_DIR%\lib\lang.lib + >> b32.bc
echo %HRB_DIR%\lib\codepage.lib + >> b32.bc
echo %HRB_DIR%\lib\macro%HB_MT%.lib + >> b32.bc
echo %HRB_DIR%\lib\rdd%HB_MT%.lib + >> b32.bc
echo %HRB_DIR%\lib\dbfntx%HB_MT%.lib + >> b32.bc
echo %HRB_DIR%\lib\dbfcdx%HB_MT%.lib + >> b32.bc
echo %HRB_DIR%\lib\dbffpt%HB_MT%.lib + >> b32.bc
echo %HRB_DIR%\lib\common.lib + >> b32.bc
echo %HRB_DIR%\lib\debug.lib + >> b32.bc
echo %HRB_DIR%\lib\pp.lib + >> b32.bc
echo %HRB_DIR%\lib\hsx.lib + >> b32.bc
echo %HRB_DIR%\lib\hbsix.lib + >> b32.bc
if exist %HRB_DIR%\lib\pcrepos.lib echo %HRB_DIR%\lib\pcrepos.lib + >> b32.bc
if exist %HRB_DIR%\lib\hbole.lib echo %HRB_DIR%\lib\hbole.lib + >> b32.bc
echo cw32.lib + >> b32.bc
echo import32.lib, >> b32.bc
if exist lf.res echo lf.res + >> b32.bc
echo lf.res >> b32.bc
ilink32 -v -Gn -Tpd -aa @b32.bc
del *.tds
del *.c
del *.map
del *.obj