Utilizar DLL do Delphi no Harbour com GTWVW

[Wanderlei]

Olá Pessoal,

Estou precisando utilizar um DLL feita no Delphi 7, Tem algumas Funções que foram desenvolvidas no Delphi que preciso utilizar no Harbour.

Como faço isso???

Wanderlei Cardoso de Oliveira
Analista / Programador
MINIGUI / DBFCDX
GTWVW / DBFCDX

[Itamar M. Lins Jr.]

Ola!
Este exemplo consta na pasta tests da hbwin.

Código: Selecionar todos

/*
 * $Id: testdll.prg 11201 2009-06-03 10:26:40Z vszakats $
 */

/*
 * Harbour Project source code:
 *    DLL call demonstration.
 *
 * Copyright 2008 Viktor Szakats (harbour.01 syenar.hu)
 * www - http://www.harbour-project.org
 *
 */

#define MB_OK                       0x00000000
#define MB_OKCANCEL                 0x00000001
#define MB_ABORTRETRYIGNORE         0x00000002
#define MB_YESNOCANCEL              0x00000003
#define MB_YESNO                    0x00000004
#define MB_RETRYCANCEL              0x00000005
#define MB_CANCELTRYCONTINUE        0x00000006
#define MB_ICONHAND                 0x00000010
#define MB_ICONQUESTION             0x00000020
#define MB_ICONEXCLAMATION          0x00000030
#define MB_ICONASTERISK             0x00000040
#define MB_USERICON                 0x00000080
#define MB_DEFBUTTON2               0x00000100
#define MB_DEFBUTTON3               0x00000200
#define MB_DEFBUTTON4               0x00000300
#define MB_SYSTEMMODAL              0x00001000
#define MB_TASKMODAL                0x00002000
#define MB_HELP                     0x00004000
#define MB_NOFOCUS                  0x00008000
#define MB_SETFOREGROUND            0x00010000
#define MB_DEFAULT_DESKTOP_ONLY     0x00020000
#define MB_TOPMOST                  0x00040000
#define MB_RIGHT                    0x00080000
#define MB_RTLREADING               0x00100000

#define CSIDL_APPDATA               0x001a /* <username>\Application Data */
#define CSIDL_ADMINTOOLS            0x0030 /* <username>\Start Menu\Programs\Administrative Tools */

#define MAX_PATH 260

PROCEDURE Main()
   LOCAL hDLL
   LOCAL cData

   IF File( "pscript.dll" )
      hDLL := DllLoad( "pscript.dll" )
      cData := Space( 24 )
      DllCall( hDll, NIL, "PSGetVersion", @cData )
      ? ">" + cData + "<"
      DllUnload( hDLL )

      // ; Testing failure 1
      hDLL := DllLoad( "pscript.dll" )
      cData := Space( 24 )
      DllCall( hDll, NIL, "PSGet__Version", @cData )
      ? ">" + cData + "<"
      DllUnload( hDLL )
   ENDIF

   // ; Testing failure 2
   hDLL := DllLoad( "nothere.dll" )
   cData := Space( 24 )
   DllCall( hDll, NIL, "PSGetVersion", @cData )
   ? cData
   DllUnload( hDLL )

   ? "MsgBox:", DllCall( "user32.dll", NIL, "MessageBoxA", 0, "Hello world!", "Harbour sez", hb_bitOr( MB_OKCANCEL, MB_ICONEXCLAMATION, MB_HELP ) )

   IF File( "libcurl.dll" )
      hDLL := DllLoad( "libcurl.dll" )
      ? GetProcAddress( hDLL, "curl_version" )
      // ; This one doesn't work.
      ? CallDllTyped( 10 /* return string */, GetProcAddress( hDLL, "CURL_VERSION" ) )
      DllUnload( hDLL )
   ENDIF

   /* Force Windows not to show dragged windows contents */

   #define SPI_SETDRAGFULLWINDOWS 37

   ? "Full content drag: OFF"
   ? DllCall( "user32.dll", NIL, "SystemParametersInfo", SPI_SETDRAGFULLWINDOWS, 0, 0, 0 )
   Inkey( 0 )

   ? "Full content drag: ON"
   ? DllCall( "user32.dll", NIL, "SystemParametersInfo", SPI_SETDRAGFULLWINDOWS, 1, 0, 0 )
   Inkey( 0 )

   /* Get some standard Windows folders */

   hDLL := DllLoad( "shell32.dll" )
   ? ValType( hDLL )
   cData := Space( MAX_PATH )
   ? CallDllBool( GetProcAddress( hDLL, "SHGetSpecialFolderPath" ), 0, @cData, CSIDL_APPDATA, 0 )
   ? cData
   ? CallDll( GetProcAddress( hDLL, "SHGetFolderPath" ), 0, CSIDL_ADMINTOOLS, 0, 0, @cData )
   ? cData
   DllUnload( hDLL )

   RETURN

Saudações,
Itamar M. Lins Jr.

[viniciuspc]

Pessoal,

Me desculpem por ressuscitar um topico bem antigo...

Estou utilizando o Harbour 3.0.0 (Rev. 16951) + Microsoft Visual C++ 16.0.40219 (32-bit) em tela DOS mesmo! (A)

fiz uma pequena DLL em Delphi 7 :

Código: Selecionar todos

library testando;

uses
  SysUtils,
  Classes;

  Function TESTE(cteste : CHAR) : CHAR ; cdecl;
   begin
     if cteste = 'A' Then
        Result := 'A'
     Else
        Result := 'X';
   End;

{$R *.res}

begin
end.
 

gerou uma DLL chamada testando.dll

no Harbour estou tentando utilizar assim :

Código: Selecionar todos

@ 7,31 say 'Verificando teste '
hDLL := hb_LibLoad("testando.dll")
retorno := hb_dynCall( { "TESTE", hDLL , hb_bitOr( HB_DYN_CTYPE_CHAR , HB_DYN_CALLCONV_CDECL) } , 'T')
hb_LibFree(hDLL)
@ 7,65 say retorno

Mas retorna NIL

já utilizei HB_DYN_CTYPE_DEFAULT , HB_DYN_CTYPE_CHAR_UNSIGNED , HB_DYN_CTYPE_CHAR_PTR , HB_DYN_CTYPE_CHAR_UNSIGNED_PTR ! mas continua retornando NIL

se alguem puder me ajudar, agradeço bastante! :)Pos

[]´s

[sygecom]

Olá,
Veja se o exemplo em anexo lhe ajuda em algo, fiz com Harbour do SVN.

[asimoes]

Algum tempo atrás fiz um teste com delphi e obtive resultado.

//Retorna a string
//cStatus:=hb_dynCall( { "TrimAllChar", "Project2.dll",hb_bitOr( HB_DYN_CTYPE_CHAR_PTR , HB_DYN_CALLCONV_CDECL )},'TESTE COM DELPHI',' ')
//info(cStatus)

[viniciuspc]

Salve sygecom,

Compilei o programa que vc passou e ficou legal!

Fiz a mudança na minha função, mas continua errado...

ficou assim

Código: Selecionar todos

      @ 7,31 say 'Verificando teste '
      hDLL := hb_LibLoad("testando.dll")
      cRetorno := '.'
      retorno := hb_dynCall( { "TESTE", hDLL , HB_DYN_CALLCONV_CDECL } , 'T' , @cRetorno )
      hb_LibFree(hDLL)
      @ 7,65 say retorno
      ?? " " + cRetorno

a variavel retorno esta como NIL e a variavel cRetorno ficou com '.', sem alteração da DLL

a sua DLL foi escrita em D7 ?

Salve asimoes,

Estava utilizando esta tecnica (tinha lido um outro topico seu!) mas não funcionou...

Estou Utilizando o D7 para criar a DLL, Harbour versao 3.0 e MSVC para linkeditar!

[]´s

[asimoes]

Uso:
Testanndo a função DiaSemana

Código: Selecionar todos

cStatus:=hb_dynCall( { "DiaSemana", "Project2.dll",hb_bitOr( HB_DYN_CTYPE_CHAR_PTR , HB_DYN_CALLCONV_STDCALL )},'11/06/2012')

Para gerar a dll (delphi)

Código: Selecionar todos

library Project2;

{ Important note about DLL memory management: ShareMem must be the
  first unit in your library's USES clause AND your project's (select
  Project-View Source) USES clause if your DLL exports any procedures or
  functions that pass strings as parameters or function results. This
  applies to all strings passed to and from your DLL--even those that
  are nested in records and classes. ShareMem is the interface unit to
  the BORLNDMM.DLL shared memory manager, which must be deployed along
  with your DLL. To avoid using BORLNDMM.DLL, pass string information
  using PChar or ShortString parameters. }

uses
  SysUtils,
  Classes,
  WinTypes,
  WinProcs,
  Dialogs;

{declaração de uma função MaiorValor}

{$R *.res}
function Triple(N: Integer): Integer; stdcall;
begin
Result := N * 3;
end;

function Double (N: Integer): Integer; stdcall;
begin
Result := N * 2;
end;

function DiaSemana(Data: pchar): pAnsiChar; stdcall;
{Retorna o dia da semana em Extenso de uma determinada data}
var
var1:string;
const
  Dias : Array[1..7] of String[07] = ('DOMINGO', 'SEGUNDA', 'TERCA','QUARTA','QUINTA', 'SEXTA','SABADO');
begin
  //showmessage(Data);
  var1   := Dias[DayOfWeek(strtodate(Data))];
  Result := pchar(var1);
end;

function TrimAllChar(const S:PChar; const ch : PChar) : pAnsiChar; stdcall;
var
  buf : String;
  var1: String;
  var2: String;
begin
  buf := S;
  Result := '';
  Var1   := '';
  {while Pos finds a blank}
  //showmessage(s);
  //showmessage(ch);
  while (Pos(ch, buf) > 0) do begin
    {copy the substrings before the blank in to Result}
    Var1   := Var1   + Copy(buf, 1, Pos(ch, buf) - 1);
    buf := Copy(buf, Pos(ch, buf) + 1, Length(buf) - Pos(ch, buf));
  end;
  var2:=var1;
  //showmessage(var2);
  {There will still be a remainder in buf, so copy remainder into Result}
  Result := pchar(Var2+ buf);
end;

function Nada(_s:pchar):PAnsiChar;stdcall;
var
teste: string;
teste2: string;
   begin
   teste:=_s;
   teste2:=_s;
   showmessage(teste);
   showmessage(inttostr(Length (_s)));
   showmessage('ESTOU NO DELPHI');
   Result:=pchar(teste);
end;

function pcDLLVersion:pchar;stdcall;
begin
showmessage('teste');
result:='1.0.0';
end;

exports
Triple, Double, TrimAllChar, DiaSemana, Nada, pcDLLVersion;
end.

[viniciuspc]

Valeu asimoes! :-Y

O problema estava na rotina em Delphi mesmo!

era assim :

Código: Selecionar todos

library testando;

uses
 SysUtils,
 Classes;

 Function TESTE(cteste : CHAR) : CHAR ; cdecl;
 begin
  if cteste = 'A' Then
    Result := 'A'
  Else
    Result := 'X';
 End;

{$R *.res}

begin
end.
 

e ficou assim :

Código: Selecionar todos

library testando;

uses
 SysUtils,
 Classes;

{$R *.res}


Function TESTE( cTeste : pchar): pAnsiChar; stdcall;
Begin
  Result := pchar('X');
  if cTeste = 'A' then
     Result := pchar('A');

End;

exports TESTE;
end.

Em outras palavras : Faltou o exports TESTE no final e trabalhar a variavel como pchar e pansichar e não como char!

bom, fica ai a dica!

Obrigado a todos!

[]´s