Prezados, saudações!
Já há algum tempo, o nobre colega Vailton criou algumas rotinas que podem evitar a cópia não-autorizada de aplicativo, quando este se baseia na identificação de componentes da máquina onde está instalado.
Obtendo informações do Hardware atual com FWH
Estou encontrando dificuldades para tornar funcional estes códigos em Harbour/minGW.
A compilação me retorna erros com relação a funções não reconhecidas (createObject(), por exemplo).
Agradeço antecipadamente por qualquer luz.
Harbour/MinGW & rotinas para ID de hardware
Moderador: Moderadores
- Dr.Microso
- Usuário Nível 3

- Mensagens: 173
- Registrado em: 12 Jan 2009 21:26
- Localização: Belo Horizonte, MG
Harbour/MinGW & rotinas para ID de hardware
"O que domina aos outros é forte; o que domina a si mesmo é poderoso." [ Lao-Tsé - séc VII AC]
"É tipo uma Alquimia... Porções de código viram soluções que mutam-se fisicamente em sorrisos e outros, como o notebook que uso para escrever estas linhas..." dr.microso@hotmail.com
"É tipo uma Alquimia... Porções de código viram soluções que mutam-se fisicamente em sorrisos e outros, como o notebook que uso para escrever estas linhas..." dr.microso@hotmail.com
Harbour/MinGW & rotinas para ID de hardware
Qual versão do harbour você está usando?
►Harbour 3.x | Minigui xx-x | HwGui◄
Pense nas possibilidades abstraia as dificuldades.
Não corrigir nossas falhas é o mesmo que cometer novos erros.
A imaginação é mais importante que o conhecimento. (Albert Einstein)
Pense nas possibilidades abstraia as dificuldades.
Não corrigir nossas falhas é o mesmo que cometer novos erros.
A imaginação é mais importante que o conhecimento. (Albert Einstein)
Harbour/MinGW & rotinas para ID de hardware
O exemplo do Vailton você pode testar com as pequenas adaptações que eu fiz.
xap.bat
teste.hbp
teste.prg (do exemplo do Vailton) http://sqllib.com.br/blog/index.php?blog=7
xap.bat
Código: Selecionar todos
@echo off
set path=%path%;d:\hb30\bin
SET HB_COMPILER=mingw
hbmk2 teste.hbp
pause
Código: Selecionar todos
#---------------------------
# Nome do Executável
# ---------------------------
-oteste
# ---------------------------
# Bibliotecas
# ---------------------------
-lhbwin
-lhbtip
-lxhb
# ---------------------------
# Caminhos dos Includes
# ---------------------------
# ---------------------------
# Caminho das Libs da HwGui
# ---------------------------
# ---------------------------
# Outros Parƒmetros
# ---------------------------
-workdir=.\OBJ\
-head=full
-n
-nowarn
-inc
-b
# ---------------------------
# Prg(s) e Rc(s)
# ---------------------------
TESTE
Código: Selecionar todos
#include 'common.ch'
#include 'hbcompat.ch' // para aceitar try catch end, for each next
FUNCTION MAIN
CLS
mb := GetMBInfo()
bios := GetBiosInfo()
macs := GetMACAddr(.t.)
ips := GetNICs(.t.)
* Exibe o modelo e versão da placa-mãe:
? valtoprg(mb)
inkey(0)
* Exibe a versão e data da bios:
? valtoprg(bios)
inkey(0)
* Exibe os endereços MACs encotrados no sistema:
? valtoprg(macs)
inkey(0)
* Mostra todos os endereços IPs disponíveis:
? valtoprg(ips)
INKEY(0)
RETURN NIL
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)
►Harbour 3.x | Minigui xx-x | HwGui◄
Pense nas possibilidades abstraia as dificuldades.
Não corrigir nossas falhas é o mesmo que cometer novos erros.
A imaginação é mais importante que o conhecimento. (Albert Einstein)
Pense nas possibilidades abstraia as dificuldades.
Não corrigir nossas falhas é o mesmo que cometer novos erros.
A imaginação é mais importante que o conhecimento. (Albert Einstein)
- Dr.Microso
- Usuário Nível 3

- Mensagens: 173
- Registrado em: 12 Jan 2009 21:26
- Localização: Belo Horizonte, MG
Harbour/MinGW & rotinas para ID de hardware
Asimoes, perfeito!
Errei por omitir o #include "hbcompat.ch" e a declaração das LIBs.
Parabéns, muito grato.
Um forte e fraterno abraço.
PS. não sei se é algo pertinente ao meu Windows, mas ao utilizar a opção do Fórum Copiar código para clipboard e colar nos futuros arquivos, deu erro na compilação, embora visualmente não aparecesse nada de anormal (aconteceu nos 3), o que não sucedeu na opção Ver código e usar o CTRL+C e CTRL+V...
Errei por omitir o #include "hbcompat.ch" e a declaração das LIBs.
Parabéns, muito grato.
Um forte e fraterno abraço.
PS. não sei se é algo pertinente ao meu Windows, mas ao utilizar a opção do Fórum Copiar código para clipboard e colar nos futuros arquivos, deu erro na compilação, embora visualmente não aparecesse nada de anormal (aconteceu nos 3), o que não sucedeu na opção Ver código e usar o CTRL+C e CTRL+V...
"O que domina aos outros é forte; o que domina a si mesmo é poderoso." [ Lao-Tsé - séc VII AC]
"É tipo uma Alquimia... Porções de código viram soluções que mutam-se fisicamente em sorrisos e outros, como o notebook que uso para escrever estas linhas..." dr.microso@hotmail.com
"É tipo uma Alquimia... Porções de código viram soluções que mutam-se fisicamente em sorrisos e outros, como o notebook que uso para escrever estas linhas..." dr.microso@hotmail.com
