PC Toledo

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.

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. 

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