Página 1 de 1

Harbour/MinGW & rotinas para ID de hardware

Enviado: 19 Set 2011 17:05
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.

Harbour/MinGW & rotinas para ID de hardware

Enviado: 19 Set 2011 19:47
por asimoes
Qual versão do harbour você está usando?

Harbour/MinGW & rotinas para ID de hardware

Enviado: 19 Set 2011 20:11
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/MinGW & rotinas para ID de hardware

Enviado: 19 Set 2011 21:07
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...