Bom dia.
Ressuscitando o tópico, fiz alguns ajustes no código acima para rodar com Harbour e a biblioteca hbwin. Eis o código atualizado:
Código: Selecionar todos
FUNCTION Teste()
mb := GetMBInfo()
bios := GetBiosInfo()
macs := GetMACAddr(.t.)
ips := GetNICs(.t.)
cls
? '1/4 Exibe o modelo e versão da placa-mãe:'
? valtoprg(mb)
wait
cls
? '2/4 Exibe a versão e data da bios:'
? valtoprg(bios)
wait
cls
? '3/4 Exibe os endereços MACs encotrados no sistema:'
? valtoprg(macs)
wait
cls
? '4/4 Mostra todos os endereços IPs disponíveis:'
? valtoprg(ips)
wait
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
oLoc := WIN_OLECREATEOBJECT( "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
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
oLoc := WIN_OLECREATEOBJECT( "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
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
oLoc := WIN_OLECREATEOBJECT( "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
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
oLoc := WIN_OLECREATEOBJECT( "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
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 $ 'CM' ; return Alltrim(Arg1) ; end
if tipo == 'N' ; return Alltrim(Str(Arg1)) ; end
if tipo == 'D' ; return Alltrim(dtoc(Arg1)) ; end
if tipo == 'U' ; return '' ; end
RETURN VALTOPRG(Arg1)
STATIC FUNCTION VALTOPRG( x, lLineFeed, lInherited )
LOCAL s := ''
LOCAL t := VALTYPE( x )
LOCAL i,j
IF lInherited == NIL ; lInherited := FALSE ;endif
IF lLineFeed == NIL ; lLineFeed := TRUE ;endif
DO CASE
CASE ( t == "C" )
s := '"' + x + '"'
CASE ( t == "N" )
s := alltrim(str( x ))
CASE ( t == "D" )
s := "CTOD('"+ DTOC(x) +"')"
CASE ( t == "L" )
s := iif( x, '.T.', '.F.' )
CASE ( t == "M" )
s := '"' + x + '"'
CASE ( t == "B" )
s := '{|| NIL } '
CASE ( t == "U" )
s := 'NIL'
CASE ( t == "A" )
s := "{"
j := LEN(x)
FOR i := 1 TO j
s += ToString( x[i], TRUE )
IF ( i <> j )
s += ","
End
IF lLineFeed
IF ( !lInherited ) .and. VALTYPE( x[i] ) == "A"
s += CHR(13)+CHR(10)
endif
End
End
s += "}"
CASE ( t == "H" )
s := "{"
j := LEN(x)
FOR i := 1 TO j
s += ToString( hb_HKeyAt( x, I ), .T. )
s += ' => '
s += ToString( hb_HValueAt( x, i ), .T. )
IF ( i <> j )
s += ","
End
IF lLineFeed
IF ( !lInherited ) .and. VALTYPE( x[hb_HKeyAt( x, i )] ) $ "AH"
s += CHR(13)+CHR(10)
ENDIF
End
End
s += "}"
CASE ( t == "O" )
s := x:ClassName()+'():New()'
End
RETURN s
Espero que seja útil. Um grande abraço!