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

Moderador: Moderadores
DLL STATIC FUNCTION DELETEURLCACHEENTRY( cUrl AS LPSTR ) AS BOOL;
PASCAL FROM "DeleteUrlCacheEntryA" LIB "wininet.dll"
#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
//----------------------------------------------------------------------------//
CallDll( "wininet.dll", "DeleteUrlCacheEntryA", cUrl )
DLL STATIC FUNCTION DELETEURLCACHEENTRY( cUrl AS LPSTR ) AS BOOL;
PASCAL FROM "DeleteUrlCacheEntryA" LIB "wininet.dll"
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';
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;
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;
#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"
//----------------------------------------------------------------------------------------------------------------------//
test2.prg:27: error E0030 Syntax error "syntax error at 'FUNCTION'"
1 error
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
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
FUNCTION Main()
? DownloadTexto( "http://www.josequintas.com.br/meuip.asp" )
Inkey(0)
RETURN NIL
FUNCTION AppVersaoExe(); RETURN NIL
Usuários vendo este fórum: Google [Bot] e 14 visitantes