DDL STATIC para Harbour

por **rubens** » 17 Jan 2018 12:28

Olá...

Alguém consegue converter/adaptar esse código para Harbour. Usando funções do Harbour.

DLL STATIC FUNCTION DELETEURLCACHEENTRY( cUrl AS LPSTR ) AS BOOL;
PASCAL FROM "DeleteUrlCacheEntryA" LIB "wininet.dll"

Obrigado
Rubens

por **jairfab** » 17 Jan 2018 13:11

Tente colocar isto :


#ifndef _DLL_CH
#define _DLL_CH

#ifndef _C_TYPES
   #define _C_TYPES
   #define VOID      0
   #define BYTE      1
   #define CHAR      2
   #define WORD      3

#ifdef __CLIPPER__
   #define _INT      4         // conflicts with Clipper Int()
#else
   #define _INT      7
#endif

   #define BOOL      5
   #define HDC       6
   #define LONG      7
   #define STRING    8
   #define LPSTR     9
   #define PTR      10
   #define _DOUBLE  11         // conflicts with BORDER DOUBLE
   #define DWORD    12
   
   #define LONGLONG 13
#endif

#translate NOREF([@]<x>) => <x>

#ifndef __HARBOUR__
  #ifndef __XPP__
     #ifndef __CLIPPER__
        #ifndef __C3__
           #define __CLIPPER__
        #endif
     #endif
  #endif
#endif

#ifndef __CLIPPER__
   #translate DLL32 => DLL
#endif

//----------------------------------------------------------------------------//

#xcommand DLL [<static:STATIC>] FUNCTION <FuncName>( [ <uParam1> AS <type1> ] ;
                                                     [, <uParamN> AS <typeN> ] ) ;
             AS <return> [<pascal:PASCAL>] [ FROM <SymName> ] LIB <*DllName*> ;
       => ;
          [<static>] function <FuncName>( [NOREF(<uParam1>)] [,NOREF(<uParamN>)] ) ;;
             local _hDLL := If( ValType( <DllName> ) == "N", <DllName>, LoadLibrary( <(DllName)> ) ) ;;
             local uResult ;;
             local cFarProc ;;
             if Abs( _hDLL ) > 32 ;;
                cFarProc = GetProcAdd( _hDLL,;
                If( [ Empty( <SymName> ) == ] .t., <(FuncName)>, <SymName> ),;
                [<.pascal.>], <return> [,<type1>] [,<typeN>] ) ;;
                uResult = FWCallDLL( cFarProc [,<uParam1>] [,<uParamN>] ) ;;
                If( ValType( <DllName> ) == "N",, FreeLibrary( _hDLL ) ) ;;
             else ;;
                MsgAlert( "Error code: " + LTrim( Str( _hDLL ) ) + " loading " + ;
                If( ValType( <DllName> ) == "C", <DllName>, Str( <DllName> ) ) ) ;;
             end ;;
          return uResult

//----------------------------------------------------------------------------//

#xcommand DLL32 [<static:STATIC>] FUNCTION <FuncName>( [ <uParam1> AS <type1> ] ;
                                                      [, <uParamN> AS <typeN> ] ) ;
             AS <return> [<pascal:PASCAL>] [ FROM <SymName> ] LIB <*DllName*> ;
       => ;
          [<static>] function <FuncName>( [NOREF(<uParam1>)] [,NOREF(<uParamN>)] ) ;;
             local _hDLL := If( ValType( <DllName> ) == "N", <DllName>, LoadLib32( <(DllName)> ) ) ;;
             local uResult ;;
             local cFarProc ;;
             if Abs( _hDLL ) <= 32 ;;
                MsgAlert( "Error code: " + LTrim( Str( _hDLL ) ) + " loading " + <DllName> ) ;;
             else ;;
                cFarProc = GetProc32( _hDLL,;
                If( [ Empty( <SymName> ) == ] .t., <(FuncName)>, <SymName> ),;
                [<.pascal.>], <return> [,<type1>] [,<typeN>] ) ;;
                uResult = FWCallDLL32( cFarProc [,<uParam1>] [,<uParamN>] ) ;;
                If( ValType( <DllName> ) == "N",, FreeLib32( _hDLL ) ) ;;
             end ;;
          return uResult

#endif

//----------------------------------------------------------------------------//

por **JoséQuintas** » 17 Jan 2018 13:21

Vai complicar assim lá na casa do carvalho....
Não é mais fácil assim?

CallDll( "wininet.dll", "DeleteUrlCacheEntryA", cUrl )

por **Kapiaba** » 17 Jan 2018 14:02

Rubens, o que você que fazer? baixar algo do google drive? O código para Harbour é esse mesmo.

   DLL STATIC FUNCTION DELETEURLCACHEENTRY( cUrl AS LPSTR ) AS BOOL;
       PASCAL FROM "DeleteUrlCacheEntryA" LIB "wininet.dll"

Abs.

por **JoséQuintas** » 17 Jan 2018 14:09

Não, isso é XHarbour, e obriga o uso de LIB de compatibilidade com XHarbour, o que é péssimo e pode causar outros problemas.

por **Kapiaba** » 17 Jan 2018 14:15

Mister Quintas, Compile este código com Harbour porfa. E reporte se não funciona. harbour 3.2. Não Fork(garfo). kkkkkk, Harbour? No me gusta nada. kkkkkkkkkkkk

http://fivewin.com.br/index.php?/topic/26897-ip-p%C3%BAblico/

Abs

por **JoséQuintas** » 17 Jan 2018 14:44

Como eu disse antes, exige LIB de compatibilidade XHarbour, e tá no CH de compatibilidade.
Isso é bagunçar o Harbour, arriscar a ter problemas.

Fazer o Harbour funcionar igual XHarbour significa ter um Harbour que funciona diferente.
Se funciona diferente.... não funciona igual....

por **jairfab** » 17 Jan 2018 15:15

Mestre JoséQuintas , Rochinha e ou alguém que tem experiencia em consumir dll.

Aproveitando como eu poderia ler uma dll c# no harbour ou no xharbour tenho este exemplo de leitura em delphi

DLL para assinatura do XML do eSocial com Certificado A3 via HASH SHA256.

Como usar
Há duas DLL´s que precisam ser copiadas para a pasta do executável do seu projeto, a eSocialSignature.dll e a Security.Cryptography.dll. Ambas podem ser encontradas na pasta do projeto de exemplo em Delphi;

Há dois métodos, sendo que SignSHA256Ansi é específico para linguagens não-unicode (no caso do Delphi são as versões inferiores a 2009);

Ambas podem ser usadas em linguages com Unicode, desde que seja usado da maneira correta, sendo SignSHA256Unicode a indicada para essas linguages (no caso do Delphi são as versões 2009 e superiores);

Caso deseje usar com Delphi você pode copiar o arquivo eSocialSignature.pas na pasta de exemplo em Delphi;

Caso contrário você pode fazer referência aos métodos diretamente, ou carregar dinamicamente (recomendado):

1- Passar o texto do XML para uma variável do PAnsiChar ou PChar, conforme plataforma utilizada, utilizando o devido cast;
2 - Passar a variável para o devido método de assinatura com os demais parâmetros;
3- Usar a mesma variável com o XML já assinado;
4- Dos métodos de assinatura os parâmetros são:

Referencia Direta:

procedure SignSHA256Ansi(
  var xml: PAnsiChar;
  nodeToSign: PAnsiChar;
  certificateSerialNumber: PAnsiChar;
  certificatePassword: PAnsiChar); stdcall; external 'eSocialSignature.dll'; 

procedure SignSHA256Unicode(
  var xml: PChar;
  nodeToSign: PChar;
  certificateSerialNumber: PChar;
  certificatePassowrd: PChar); stdcall; external 'eSocialSignature.dll';

Referencia dinâmica:

procedure SignSHA256Ansi(var AXml: PAnsiChar; ANodeToSign: PAnsiChar; 
  ASerialNumber: PAnsiChar; APassword: PAnsiChar);
type
  TProc = procedure(var AXml: PAnsiChar; ANodeToSign: PAnsiChar; 
      ASerialNumber: PAnsiChar; APassword: PAnsiChar); stdcall;
var
  dllHandle: THandle;
  proc: TProc;
begin
  dllHandle := LoadLibrary('eSocialSignature.dll');
  if dllHandle < HINSTANCE_ERROR then
  begin
    raise Exception.Create('Não foi possível encontrar a DLL ' + DLLNAME + '.' +#13+ 
        SysErrorMessage(GetLastError));
  end;
  try
    @proc := GetProcAddress(dllHandle, 'SignSHA256Ansi');
    if Assigned(@proc) then
    begin
      proc(AXml, ANodeToSign, ASerialNumber, APassword);
    end;
  finally
    FreeLibrary(dllHandle);
  end;
end;

procedure SignSHA256Unicode(var AXml: PChar; ANodeToSign: PChar; ASerialNumber: PChar; APassword: PChar);
type
  TProc = procedure(var AXml: PChar; ANodeToSign: PChar; ASerialNumber: PChar; APassword: PChar); stdcall;
var
  dllHandle: THandle;
  proc: TProc;
begin
  dllHandle := LoadLibrary('eSocialSignature.dll');
  if dllHandle < HINSTANCE_ERROR then
  begin
    raise Exception.Create('Não foi possível encontrar a DLL ' + DLLNAME + '.' +#13+ 
        SysErrorMessage(GetLastError));
  end;
  try
    @proc := GetProcAddress(dllHandle, 'SignSHA256Unicode');
    if Assigned(@proc) then
    begin
      proc(AXml, ANodeToSign, ASerialNumber, APassword);
    end;
  finally
    FreeLibrary(dllHandle);
  end;
end;

Exemplo Delphi

var
  xml: PAnsiChar;
begin
  xml := PAnsiChar(AnsiString(xmlDoc.XML.Text));
  TESocialSignature.SignSHA256Unicode(xml, 'evtInfoEmpregador', 'eaee2da6eabd4e0aa211e2a18e7c749c', '1234');
  xmlDoc.LoadXml(xml);
end;

var
  xml: PChar;
begin
  xml := PChar(xmlDoc.XML.Text);
  TESocialSignature.SignSHA256Unicode(xml, 'evtInfoEmpregador', 'eaee2da6eabd4e0aa211e2a18e7c749c', '1234');
  xmlDoc.LoadXml(xml);
end;

Exemplo em delphi esta aqui [*]https://www.4shared.com/zip/TGm279OYei/DelphiTest.html

por **Kapiaba** » 17 Jan 2018 15:32

Mister Quintas, please compile com Harbour modo console.
Ou do jeito que achar melhor. Nao precisa de biblioteca grafica.

#include "tip.ch"  // em Harbour seria: hbtip.ch ? i dont no. kkkk

FUNCTION RetPublicIP()

   LOCAL cPubIP := "", cxHtml := "", url, oUrl, oHttp, oErr

   url := "http://checkip.dyndns.org"

   try
      oUrl:=TUrl():New( url ) // From tip.lib
      oHttp := TipClientHttp():New( oUrl , .f. ) // From tip.lib
   catch oErr
      ? "Erro: "+oErr:Description
   end try
      Try
      oHttp:Open()
      cxHtml := oHttp:ReadAll() // Baixa todo o conteúdo do site.
      cPubIP := allTrim( substr( substr( cxHtml, rat( "<body>", cxHtml ) + 26 ), 1, At( "<", substr( cxHtml, rat( "<body>", cxHtml ) + 26 ) ) - 1 ) )
   catch oErr
      ? "Erro: "+oErr:Description
   End

   oHttp:Close()

   DeleteUrlCacheEntry(url) // Lipar Cache

   ? cPubIP // o que aparece aqui em Harbour modo console mister Quintas?

Return Nil
   //----------------------------------------------------------------------------------------------------------------------//
DLL Function DeleteUrlCacheEntry(lpszUrlName AS STRING) AS LONG PASCAL FROM "DeleteUrlCacheEntryA" LIB "wininet.dll"
//----------------------------------------------------------------------------------------------------------------------//

Abs

por **rubens** » 17 Jan 2018 15:46

Boa tarde..

Jair -> Já havia tentado dessa forma mas tava dando um monte de erro na compilação...
Kapiaba -> Com DLL STATIC FUNCTION... não achava função CallDll() mesmo colocando xhb.ch e hbcompat.ch
Quintas -> Muito mais prático desse jeito mesmo né.. mas tive que mudar CallDll() para CallDll32() e inserir #require "hbmisc" e a lib hbmisc.lib. Acho que por que uso hb32.
Função quase pronta... pelo menos a parte da dll tá resolvida...

Obrigado a todos..

Rubens

por **JoséQuintas** » 17 Jan 2018 18:43

Ok, 3.2 é CallDll32() e no 3.4 é CallDll().

Sobre a compilação, é elementar, se não acrescentar compatibilidade com XHarbour:

test2.prg:27: error E0030 Syntax error "syntax error at 'FUNCTION'"
1 error

por **JoséQuintas** » 17 Jan 2018 18:47

Assim ok, retorna meu ip


FUNCTION RetPublicIP()

   LOCAL cPubIP, cxHtml, url, oUrl, oHttp

   url := "http://checkip.dyndns.org"

   oUrl:=TUrl():New( url ) 
   oHttp := TipClientHttp():New( oUrl , .f. ) 
   oHttp:Open()
   cxHtml := oHttp:ReadAll() 
   cPubIP := allTrim( substr( substr( cxHtml, rat( "<body>", cxHtml ) + 26 ), 1, At( "<", substr( cxHtml, rat( "<body>", cxHtml ) + 26 ) ) - 1 ) )

   oHttp:Close()

   ? cPubIP 

   RETURN NIL

por **JoséQuintas** » 17 Jan 2018 18:52

Mas prefiro assim, já que é Windows.


FUNCTION RetPublicIP()

   LOCAL oSoap, cText, cUrl := "http://checkip.dyndns.org"

   oSoap := Win_OleCreateObject( "MSXML2.ServerXMLHTTP" )
   oSoap:Open( "GET", cUrl, .F.)
   oSoap:Send()
   cText := oSoap:ResponseBody()
   ? cText

   RETURN NIL

No primeiro caso, HBTIP.HBC
Neste caso, HBWIN.HBC

por **JoséQuintas** » 17 Jan 2018 19:11

Na verdade, verdade mesmo.... uso assim:
Inclusive usando dyndns fica lento demais, chegou a me obrigar a fechar o usuário pra destravar o EXE, sério isso....

Exatamente como tive que fazer:

FUNCTION Main()

   ? DownloadTexto( "http://www.josequintas.com.br/meuip.asp" )
   Inkey(0)

   RETURN NIL

FUNCTION AppVersaoExe(); RETURN NIL

Compilei usando josequintas.hbc
Por causa de outras coisas, obriga a existir essa função AppVersaoExe().

O fonte da função está dentro deste fonte, mas é praticamente o que já postei:
https://github.com/JoseQuintas/JoseQuintas/blob/master/source/ze_webservice.prg

Pode testar a checagem de IP, vai ver que no dyndns.org é mais demorado, além de precisar de conversão.

por **rubens** » 17 Jan 2018 22:49

Gente algum moderador pode mudar o título..??
DDL é comando Sql... o correto é DLL...
:% :% :%

Obrigado

Quem está online