Olá pessoal,
o Harbour tem alguma função que me retorne o ip real, também conhecido como ip público ou externo?
Obrigado.
MarceloG
Moderador: Moderadores
#include "FiveWin.ch"
#include "dll.ch"
static xdll // Need to TdWebService Class
Function Main(_ping_)
if empty( _ping_ )
? "Digite um destino, exemplo: pinga 192.168.0.1"
else
Pinga( _ping_ )
endif
return nil
//-------------------------------------
Function Pinga(DestinationAddress)
//-------------------------------------
local IcmpHandle,Replicas
local RequestData:="Testando ping",;
RequestSize:=15,;
RequestOptions:="",;
ReplyBuffer:=space(278),;
ReplySize:=278,;
Timeout:=500 && Milisegundos de espera
default DestinationAddress := "0.0.0.0"
DestinationAddress:=left(alltrim(DestinationAddress)+space(15),15)
IcmpHandle:=IcmpCreateFile()
Replicas:=IcmpSendEcho(IcmpHandle,;
inet_addr(DestinationAddress),;
RequestData,;
RequestSize,0,;
ReplyBuffer,;
ReplySize,;
Timeout)
IcmpCloseHandle(IcmpHandle)
CursorWait()
// Resultados
nInetAddr := inet_addr(DestinationAddress)
cNetName := NETNAME()
cgetHostName := getHostName() //, Valtype( getHostName() )
cgetNetCardID := getNetCardID()
cIPExtern := getIPExtern( "http://www.5volution.com.br/meuip.asp" ) // http://localhost/5volution/meuip.asp" ) // "http://www.dnsstuff.com/docs/ipall" )
WsaStartUp() // Very Important
cgetHostByName_NetName:= getHostByName( NETNAME() )
cgetHostByAddress_IP := getHostByAddress( DestinationAddress )
cgetHostByName_Google := getHostByName( "www.google.com" )
WsaCleanUp() // Very Important
? "function inet_addr: " + str(inet_addr(DestinationAddress)),;
"function NetName: " + cNetName,;
"function getHostName: " + cgetHostName,;
"function getNetCardID: " + cgetNetCardID,;
"function getHostByName with NetName: " + cgetHostByName_NetName,;
"function getHostByAddress with IP: " + cgetHostByAddress_IP,;
"function getHostByName with Google site: " + cgetHostByName_Google,;
"function getPIExtern in my website: " + cIPExtern,;
"function getComputerName: " + getComputerName(),;
"function getUserDomain: " + getUserDomain(),;
"function getUserName: " + getUserName(),;
"function getEnvironmentString: " + getEnvironmentString( "%windir%" ),;
"function CreateShortcut" + CreateShortcut( "c:\5volution", "nfwh29.exe", "c:\5volution\5volution.lnk" )
if Replicas > 0
msginfo("Machine "+alltrim(DestinationAddress)+" exist")
else
msginfo("Machine "+alltrim(DestinationAddress)+" not existe")
endif
DEFINE WINDOW oWnd TITLE "Servidor: " + cNetName
DEFINE BUTTONBAR oBar OF oWnd _3D
//DEFINE BUTTON OF oBar ACTION Server() TOOLTIP "Listen"
ACTIVATE WINDOW oWnd ON INIT ProcessPage( "http://www.5volution.com.br/app01.asp" )
CleanHTML( "http://www.5volution.com.br/app01.asp" )
//ProcessPage( "http://www.dnsstuff.com/docs/ipall" )
//CleanHTML( "http://www.dnsstuff.com/docs/ipall" )
DEFINE WINDOW oWnd TITLE "Local IP"
ACTIVATE WINDOW oWnd ;
ON INIT MsgInfo( getHostByName( NETNAME() ) ) // GetIP() )
return nil
//----------------------------------------------------
//DLL32 FUNCTION SndPlaySound( cFile AS LPSTR, nType AS WORD ) AS BOOL PASCAL LIB "MMSYSTEM.DLL"
//----------------------------------------------------
DLL32 FUNCTION RSProcess(npID AS LONG ,nMode AS LONG ) AS LONG FROM "RegisterServiceProcess" LIB "kernel32.DLL"
DLL32 FUNCTION GCP() AS LONG FROM "GetCurrentProcessId" LIB "kernel32.dll"
DLL32 STATIC FUNCTION FISAVE( nFormat AS LONG, hDib AS LONG, cFileName AS LPSTR, nFlags AS LONG ) AS BOOL PASCAL FROM "_FreeImage_Save@16" LIB hLib
//----------------------------------------------------
DLL32 FUNCTION WSAGetLastError() AS _INT PASCAL FROM "WSAGetLastError" LIB "wsock32.dll"
DLL32 FUNCTION inet_addr(cIP AS STRING) AS LONG PASCAL FROM "inet_addr" LIB "wsock32.dll"
DLL32 FUNCTION IcmpCreateFile() AS LONG PASCAL FROM "IcmpCreateFile" LIB "icmp.dll"
DLL32 FUNCTION IcmpCloseHandle(IcmpHandle AS LONG) AS LONG PASCAL FROM "IcmpCloseHandle" LIB "icmp.dll"
DLL32 FUNCTION IcmpSendEcho(IcmpHandle AS LONG,;
DestinationAddress AS LONG,;
RequestData AS STRING,;
RequestSize AS LONG,;
RequestOptions AS LONG,;
ReplyBuffer AS LPSTR,;
ReplySize AS LONG,;
Timeout AS LONG) AS LONG PASCAL FROM "IcmpSendEcho" LIB "icmp.dll"
function getIPExtern( _site_ )
local _IPExtern_
ws:=TdWebService():new()
_IPExtern_ := ws:OpenWS( _site_ )
ws:end()
return _IPExtern_
function getUserDomain()
LOCAL reg
oNetwork := TOleAuto():New("wscript.Network")
return oNetwork:UserDomain()
function getUserName()
LOCAL reg
oNetwork := TOleAuto():New("wscript.Network")
return oNetwork:UserName()
function getComputerName()
LOCAL reg
oNetwork := TOleAuto():New("wscript.Network")
return oNetwork:ComputerName()
function getEnvironmentString( _string_ )
LOCAL reg
oWSHShell := TOleAuto():New("wscript.Shell")
return oWSHShell:ExpandEnvironmentStrings( _string_ )
function CreateShortcut( _sPath_, _sFile_, _sTitle_ )
LOCAL reg
//oWSHShell := TOleAuto():New("wscript.Shell")
//oMyShortcut := oWSHShell:CreateShortcut( _sTitle_ )
//// Definir as propriedades do objeto atalho e salvá-las
//oMyShortcut:TargetPath := oWSHShell:ExpandEnvironmentStrings( _sPath_ + "\" + _sTitle_ )
//oMyShortcut:WorkingDirectory := oWSHShell:ExpandEnvironmentStrings( _sPath_ )
//oMyShortcut:WindowStyle := 4
////oMyShortcut:IconLocation := oWSHShell:ExpandEnvironmentStrings( [_sPath_] + [\] + _sTitle_+ [, 0] )
//oMyShortcut:Save()
return ""
//----------------------------------------------------
#include "fivewin.ch"
#include "dll.ch"
//static xdll
CLASS TdWebService
DATA hOpen
DATA sbuffer HIDDEN
DATA xDLL HIDDEN
METHOD New(buffersize) CONSTRUCTOR
METHOD OpenWS(url)
METHOD End()
ENDCLASS
METHOD New(conexion,buffersize) CLASS TdWebService
DEFAULT buffersize:=64000
::sbuffer:=buffersize
xDll:=LoadLib32("wininet.dll")
::hOpen = InternetOpen("TdWebService", 1,,, 0)
RETURN Self
METHOD OpenWS(url) CLASS TdWebService
local hFile,ret,xml
hFile = InternetOpenUrl(::hOpen, url,"",0,,0)
xml:=space(::sbuffer)
InternetReadFile(hFile, @xml, ::sbuffer, @Ret)
return alltrim(xml)
//return subst(alltrim(xml),1,len(alltrim(xml))-5)
METHOD End() CLASS TdWebService
FreeLib32(xDll)
return nil
FUNCTION ProcessPage( cURL )
local oWeb
local cHTML:="" // contains HTML code
local cSite:=""
local cPage:=""
if left(upper(cURL),7) = "HTTP://"
cURL:= right(cURL,len(cURL)-7)
endif
cSite:= left(cURL, at("/",cURL)-1 )
cPage:= right(cURL,len(cURL)-at("/",cURL))
oWeb := TWebClient():New()
oWeb:oSocket:Cargo := .f. // FALSE
oWeb:bOnConnect := {|oWClient| oWClient:oSocket:Cargo := .t.}
oWeb:bOnRead := {|cData| if(valtype(cData) == "C", cHTML += cData, )}
oWeb:Connect(cSite)
do while ! oWeb:oSocket:Cargo
WaitMessage()
SysRefresh()
enddo
oWeb:GetPage( cPage )
// Assign function to process code
oWeb:oSocket:bClose = {|self| ::end(), self:=Nil, Process(cHTML) }
//oWeb:oSocket:close()
sysrefresh()
return nil
FUNCTION Process( cHTML )
memowrit( "temp.txt", cHTML )
return nil
FUNCTION CleanHTML( cfile )
LOCAL oExplorer := TOLEAuto():New( "InternetExplorer.Application" )
oExplorer:Navigate2( cfile )
DO WHILE oExplorer:ReadyState <> 4
HB_IDLESLEEP( 1 )
ENDDO
cINNText := oExplorer:Document:Body:InnerText
MemoWrit( "t.txt", cINNText )
MemoEdit( MemoRead( "t.txt" ) )
MemoEdit( cINNText )
//? MemoRead( "t.txt" )
oExplorer:Quit()
RETURN NIL
DLL32 FUNCTION InternetOpen( cApp as LPSTR, n1 AS DWORD, n2 AS LPSTR, n3 AS LPSTR,;
n4 AS DWORD ) AS LONG PASCAL ;
FROM "InternetOpenA" LIB xDll
Dll32 FUNCTION InternetReadFile(hFile As 7, @sBuffer As 8, lNumBytesToRead As 7, @lNumberOfBytesRead As 7) As 7 PASCAL Lib xDll
Dll32 FUNCTION InternetOpenUrl(hInternetSession As 7, lpszUrl As 8, lpszHeaders As 8, dwHeadersLength As 7, dwFlags As 7, dwContext As 7) As 7 FROM "InternetOpenUrlA" PASCAL Lib xDll
DLL32 FUNCTION InternetCloseHandle( hSession AS LONG ) AS BOOL PASCAL LIB xDll
DLL32 FUNCTION InternetConnect( hInternet AS LONG, cServerName AS LPSTR, nServerPort AS LONG, cUserName AS LPSTR, cPassword AS LPSTR, nService AS DWORD, nFlags AS DWORD, @nContext AS PTR ) AS LONG PASCAL FROM "InternetConnectA" LIB xDll
DLL32 FUNCTION FTPGETFILE( hConnect AS LONG, cRemoteFile AS LPSTR, cNewFile AS LPSTR, nFailIfExists AS LONG, nFlagsAndAttribs AS DWORD, nFlags AS DWORD, @nContext AS PTR ) AS BOOL PASCAL FROM "FtpGetFileA" LIB xDll
DLL32 FUNCTION FTPPUTFILE( hConnect AS LONG, cLocalFile AS LPSTR, cNewRemoteFile AS LPSTR, nFlags AS DWORD, @nContext AS PTR ) AS BOOL PASCAL FROM "FtpPutFileA" LIB xDll
DLL32 FUNCTION InternetWriteFile( hFile AS LONG, cBuffer AS LPSTR, lSize AS LONG, @nSize AS PTR ) AS BOOL PASCAL LIB xDll
DLL32 FUNCTION FtpOpenFile( hFTP AS LONG, cRemoteFile AS LPSTR, n1 AS LONG, n2 AS LONG, n3 AS LONG ) AS LONG PASCAL FROM "FtpOpenFileA" LIB xDll
DLL32 FUNCTION InternetSetFilePointer( hFile AS LONG, nDistanceToMove AS LONG, nReserved AS LPSTR, nSeekMethod AS LONG, @nContext AS PTR ) AS BOOL PASCAL LIB xDll
DLL32 FUNCTION FtpFindFirstFile( hFTP AS LONG, cMask AS LPSTR, @cWin32DataInfo AS LPSTR, n1 AS LONG, n2 AS LONG ) AS LONG PASCAL FROM "FtpFindFirstFileA" LIB xDll
DLL32 FUNCTION InternetFindNextFile( hFTPDir AS LONG, @cWin32DataInfo AS LPSTR ) AS BOOL PASCAL FROM "InternetFindNextFileA" LIB xDll
// Copyright FiveTech 1993-03
#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
#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 = GetProcAddress( hDLL,;
If( [ Empty( <SymName> ) == ] .t., <(FuncName)>, <SymName> ),;
[<.pascal.>], <return> [,<type1>] [,<typeN>] ) ;;
uResult = CallDLL( 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 = CallDLL32( cFarProc [,<uParam1>] [,<uParamN>] ) ;;
If( ValType( <DllName> ) == "N",, FreeLib32( hDLL ) ) ;;
end ;;
return uResult
#define CTYPE_UNSIGNED_CHAR -1 // TCHAR, char, BCHAR, UCHAR
#define CTYPE_UNSIGNED_SHORT -2 // USHORT, WCHAR, WORD
#define CTYPE_UNSIGNED_INT -3 // UINT
#define CTYPE_UNSIGNED_LONG -4 // ULONG, DWORD, HANDLE, HICON, HBITMAP, HCURSOR, HBRUSH, COLORREF, HINSTANCE, HWND, HGLOBAL, HKEY
#define CTYPE_CHAR 1 // BYTE
#define CTYPE_SHORT 2 // SHORT
#define CTYPE_INT 3 // INT
#define CTYPE_LONG 4 // LONG
#define CTYPE_FLOAT 5 // FLOAT
#define CTYPE_DOUBLE 6 // DOUBLE
#define CTYPE_VOID 7 // VOID
#define CTYPE_BOOL 8 // BOOL
#define CTYPE_CHAR_POINTER 10 // LPTSTR, LPSTR, LPCSTR, LPCTSTR
#xcommand VDLL32 [<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 = CallDLL32( cFarProc [,<uParam1>] [,<uParamN>] ) ;;
If( ValType( <DllName> ) == "N",, FreeLib32( hDLL ) ) ;;
end ;;
return uResult
#endif
//----------------------------------------------------------------------------//
Usuários vendo este fórum: RamonXHB e 11 visitantes