PC Toledo

Código: Selecionar todos

FUNCTION PegaIP()
   PRIVATE aResult:={}
   aResult:=GetIP()
   cIP:=aResult[1]
   DbUseArea(.T.,"DBFNTX","Conexao","Conexao",.F.)
   If !Empty(cIP)
      lAdiciona:=.T.
      Do While !Eof()
         If cIP In CONEXAO->IP
            lAdiciona:=.F.
         EndIf
         DbSkip()
      EndDo
      If lAdiciona
         DbAppend()
         FIELD->Ativo:="S"
         FIELD->IP:=cIP
      EndIf
      CONEXAO->(DbCloseArea())
   Else
      Alert("NÆo foi possivel atribuir n§ de IP")
   EndIf
RETURN cIp

FUNCTION GetIP()
    local oLoc, oSrv, oJbs, oJob, ip
    local Result := {} 
    Try    
       oLoc := CREATEOBJECT( "wbemScripting.SwbemLocator" )
       oSrv := oLoc:ConnectServer()
       oJbs := oSrv:ExecQuery( "SELECT IPAddress FROM Win32_NetworkAdapterConfiguration" )
       FOR EACH oJob IN oJbs
           ip   := oJob:IPAddress
           if Valtype(ip) == 'A' .and. Len(ip) > 0
              ip := ip[1]
           else
              ip := ToString(ip)
           end
           if Empty(ip) 
              loop
           end
           AADD( Result, ip )
       NEXT
    catch
    end    
RETURN Result

/*
 * Função auxiliar que converter os valores passados para string. Coisa simples
 */    
STATIC FUNCTION ToString(Arg1)
   LOCAL tipo := ValType(Arg1)
   if tipo == 'C' ; return Alltrim(Arg1) ; end
   if tipo == 'N' ; return Alltrim(Str(Arg1)) ; end
   if tipo == 'U' ; return '' ; end        
RETURN VALTOPRG(Arg1)

Código: Selecionar todos

*********************
PROCEDURE Verefica_Ip
*********************
LOCAL aHosts
LOCAL cName
Local cEstacao:=netname(.f.)
InetInit()
aHosts := InetGetHosts( cEstacao )
IF aHosts == NIL
   aHosts := InetGetAlias( cEstacao )
ENDIF
IF Empty(aHosts)
   aHosts := InetGetAlias( cEstacao )
ENDIF
InetCleanup()
RETURN  ahosts[1 ]

Código: Selecionar todos

FUNCTION Teste()
   mb   := GetMBInfo()
   bios := GetBiosInfo()
   macs := GetMACAddr(.t.)
   ips  := GetNICs(.t.)
   
   * Exibe o modelo e versão da placa-mãe:
   ? valtoprg(mb)

* Exibe a versão e data da bios:
? valtoprg(bios)

* Exibe os endereços MACs encotrados no sistema:
? valtoprg(macs)

* Mostra todos os endereços IPs disponíveis:
? valtoprg(ips)
return


Eis o código-fonte das rotinas desenvolvidas, qualquer comentário e sugestões fiquem à vontade para se expressarem pois estou à disposição:


#include 'common.ch'
/*
 * Retorna os nomes, IPs, Mascara de redes e os endereçõs MAC das placas de rede
 * instaladas na CPU atual. O parametro opcional indica se deve-se filtrar apenas 
 * as interfaces de rede válidos!
 * Versão 1.0, 24/2/2007 11:14:23 - Vailton Renato da Silva
 *
 * Requer Windows Vista, Windows XP, Windows 2000 Professional ou Windows NT WK 4.0 SP4 >
 * link: http://msdn2.microsoft.com/en-gb/library/aa394217.aspx
 */   
FUNCTION GetNICs( lOnlyValids )   
    local oLoc, oSrv, oJbs, oJob, nic, mac, ip, msk, gtw
    local Result := {} 
    
    default lOnlyValids to False

Try
oLoc := CREATEOBJECT( "wbemScripting.SwbemLocator" )
oSrv := oLoc:ConnectServer()
oJbs := oSrv:ExecQuery( "SELECT Description, IPAddress, IPSubnet, IPConnectionMetric," +;
"MACAddress, DefaultIPGateway FROM Win32_NetworkAdapterConfiguration" )

FOR EACH oJob IN oJbs
nic := ToString(oJob: Description)
ip := oJob:IPAddress

if Valtype(ip) == 'A' .and. Len(ip) > 0
ip := ip[1]
else
ip := ToString(ip)
end

mac := oJob:MACAddress
if Empty(mac)
if !lOnlyValids
mac := '00:00:00:00:00:00'
else
loop
end
end

msk := oJob:IPSubnet
if Valtype(msk) == 'A' .and. Len(msk) > 0
msk := msk[1]
else
msk := ToString(msk)
end

gtw := oJob: DefaultIPGateway

if Valtype(gtw) == 'A' .and. Len(gtw) > 0
gtw := gtw[1]
else
gtw := ToString(gtw)
end

if Empty(ip) .and. lOnlyValids
loop
end
AADD( Result, nic + ', (' + ip + ', ' +msk + ', ' + gtw + ') ['+mac+']' )
NEXT

catch
*
end
RETURN Result


/*
* Retorna os nomes e os endereços MAC das placas de rede instaladas na
* CPU atual. O parametro opcional indica se deve-se filtrar apenas NIC válidos!
* Versão 1.0, 24/2/2007 10:23:49 - Vailton Renato da Silva
*
* Requer Windows Vista, Windows XP, Windows 2000 Professional ou Windows NT WK 4.0 SP4 >
* link: http://msdn2.microsoft.com/en-gb/library/aa394216.aspx
*/
FUNCTION GetMACAddr( lOnlyValids )
local oLoc, oSrv, oJbs, oJob, mb, mac, typ
local Result := {}

default lOnlyValids to False

Try
oLoc := CREATEOBJECT( "wbemScripting.SwbemLocator" )
oSrv := oLoc:ConnectServer()
oJbs := oSrv:ExecQuery( "SELECT * FROM Win32_NetworkAdapter "+;
"WHERE ConfigManagerErrorCode = 0" )

FOR EACH oJob IN oJbs
mb := ToString(oJob: Description)
mac := ToString(oJob:MACAddress)
typ := ToString(oJob:AdapterType)

if Empty(mac)
if !lOnlyValids
mac := '00:00:00:00:00:00'
else
loop
end
end

if Empty(typ) .and. lOnlyValids
loop
end

AADD( Result, mb + ', ' + mac + ' ['+typ+']' )
NEXT

catch
*
end
RETURN Result

/*
* Puxa as informações da BIOS do micro atual e retorna string formatada.
* Versão 1.0, 24/2/2007 10:06:51 - Vailton Renato da Silva
*
* Requer Windows Vista, Windows XP, Windows 2000 Professional ou Windows NT WK 4.0 SP4 >
* link: http://msdn2.microsoft.com/en-gb/library/aa394077.aspx
*/
FUNCTION GetBiosInfo()
local oLoc, oSrv, oJbs, oJob, mb, bd

Try
oLoc := CREATEOBJECT( "wbemScripting.SwbemLocator" )
oSrv := oLoc:ConnectServer()
oJbs := oSrv:ExecQuery( "SELECT * FROM Win32_BIOS" )
mb := ''

FOR EACH oJob IN oJbs
MB += ToString(oJob:Manufacturer) + ', '
bd := ToString(oJob:ReleaseDate)

if Empty( bd )
bd := '00/00/0000'
else
bd := Subst( bd, 7, 2 ) + '/' + Subst( bd, 5, 2 ) + '/' + Subst( bd, 1, 4 )
end

MB += bd + ' #'
MB += ToString(oJob:SerialNumber) + ' ('
MB += ToString(oJob:Version) + ')'
NEXT

catch
mb := ''
end
RETURN mb

/*
* Puxa as informações da MotherBoard instalada no PC e retorna string formatada
* Versão 1.0,24/2/2007 09:45:32 - Vailton Renato da Silva
*
* Requer Windows Vista, Windows XP, Windows 2000 Professional ou Windows NT WK 4.0 SP4 >
* link: http://msdn2.microsoft.com/en-gb/library/aa394072.aspx
*/
FUNCTION GetMBInfo()
local oLoc, oSrv, oJbs, oJob, mb

Try
oLoc := CREATEOBJECT( "wbemScripting.SwbemLocator" )
oSrv := oLoc:ConnectServer()
oJbs := oSrv:ExecQuery( "SELECT * FROM Win32_BaseBoard" )
mb := ''

FOR EACH oJob IN oJbs
MB += ToString(oJob:Manufacturer) + ', ' + ;
ToString(oJob: Product) + ' #' +;
ToString(oJob:SerialNumber)
NEXT

catch
mb := ''
end
RETURN mb

/*
* Função auxiliar que converter os valores passados para string. Coisa simples
* 24/2/2007 09:20:32
*/
STATIC;
FUNCTION ToString(Arg1)
LOCAL tipo := ValType(Arg1)

if tipo == 'C' ; return Alltrim(Arg1) ; end
if tipo == 'N' ; return Alltrim(Str(Arg1)) ; end
if tipo == 'U' ; return '' ; end
RETURN VALTOPRG(Arg1)

Código: Selecionar todos

Local cEstacao:=netname(.t.)