Harbour/MinGW & rotinas para ID de hardware

Projeto [x]Harbour - Compilador de código aberto compatível com o Clipper.

Moderador: Moderadores

Avatar do usuário
Dr.Microso
Usuário Nível 3
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

Mensagem por Dr.Microso »

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.
"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
Avatar do usuário
asimoes
Colaborador
Colaborador
Mensagens: 4919
Registrado em: 26 Abr 2007 16:48
Localização: RIO DE JANEIRO-RJ

Harbour/MinGW & rotinas para ID de hardware

Mensagem por asimoes »

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)
Avatar do usuário
asimoes
Colaborador
Colaborador
Mensagens: 4919
Registrado em: 26 Abr 2007 16:48
Localização: RIO DE JANEIRO-RJ

Harbour/MinGW & rotinas para ID de hardware

Mensagem por asimoes »

O exemplo do Vailton você pode testar com as pequenas adaptações que eu fiz.

xap.bat

Código: Selecionar todos

@echo off
set path=%path%;d:\hb30\bin
SET HB_COMPILER=mingw
hbmk2 teste.hbp
pause
teste.hbp

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
teste.prg (do exemplo do Vailton) http://sqllib.com.br/blog/index.php?blog=7

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)
Avatar do usuário
Dr.Microso
Usuário Nível 3
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

Mensagem por Dr.Microso »

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...
"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
Responder