obter o ip real

[MARCELOG]

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

[rochinha]

Amiguinhos,

Veja se ajuda

Outro exemplo:

Código: Selecionar todos

#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

[alxsts]

Olá!

Quais libs são necessárias para gerar o executável do código acima, (trocando-se a parte FW por comandos de console)?

[rochinha]

Amiguinhos,

alxsts
Na verdade o código postado não era para ser compilado, mas sim analisado para que se pudesse retirar dele os códigos necessários.

Em suma, a maioria das funções utilizar as DLLs do Windows então não tem nada de tão diferente no uso com FW ou Harbour console.

Atente para o TOLEAuto() e troque por sua função de acesso OLE preferida.

A DLL.CH tem somente wrapper para acesso as funções de DLLs.

DLL.CH

Código: Selecionar todos

// 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

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

[alxsts]

Olá!

Obrigado Rochinha.

[MARCELOG]

Olá pessoal,
resolvi o "problema" com comandos de linha do windows.

nslookup myip.opendns.com resolver1.opendns.com > ip.txt

for /f "skip=4 tokens=2" %ip in (ip.txt) do (echo %ip) > ip.txt

Isso gera o arquivo ip.txt que é modificado para conter somente o ip real.

Obrigado.

MarceloG

[MARCELOG]

Também dá pra fazer assim...

FUNCTION PEGAIP()

LOCAL oHttp, cHtml

oHttp:=TIPCLIENTHTTP():NEW('http://www.icanhazip.com')

IF !oHttp:OPEN()

ALERT(oHttp:LASTERRORMESSAGE())

RETURN 'NIHIL'

ENDIF

cHtml:=oHttp:READALL()

oHttp:CLOSE()

RETURN cHtml