• Revista PROGRAMAR: Já está disponível a edição #53 da revista programar. Faz já o download aqui!

markito7

Buscar Serial do Windows

16 mensagens neste tópico

Boas comunidade!

Será que alguem sabe como obter a serial do windows do pc onde estamos a trabalhar por código no vb6?

Estava a precisar mesmo...

Desde ja obrigado  :D

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Amigo tens isto: http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=58445&lngWId=1

Mas segundo o autor só foi testado no Windows 98 Se.

Depois diz algo, espero que dê.

P.s.-> Caso dê, diz qual é o método que usaram para obter a key, fiquei curioso e duvido que esteja no Windows Registry. (Só não testei porque não tenho o VB6 mas sim o VB 2008 .net  e sempre que tento fazer a conversão sai sempre algo mal)

Cumprimentos.

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

ele a mim nao me aparece...

supostamente aparecia numa label...

mas será q é do pc?

é q eu ja tinha um codigo que devolvia,mas está a devolver vazio ("")..

de qualquer das maneiras complilei e fiz o .exe

ve se a ti te aparece alguma coisa...

Saca Aqui

cumprimentos

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Nop, não deu.

Porém encontrei aqui algo que poderá dar, no entanto aqui fica o código:

'**************************************
'Windows API/Global Declarations for :Vi
'     ew Windows XP CD Key
'**************************************
Option Explicit


Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long


Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long


Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long ' Note that If you declare the lpData parameter as String, you must pass it By Value.
    Private Const REG_BINARY = 3
    Private Const HKEY_LOCAL_MACHINE = &H80000002
    Private Const ERROR_SUCCESS = 0&

'**************************************
' Name: View Windows XP CD Key
' Description:Function: sGetXPCDKey() wi
'     ll return the CD Key for Windows XP in t
'     he format XXXXX-XXXXX-XXXXX-XXXXX-XXXXX.
'     
' By: Snytax
'
' Inputs:Nothing.
'
' Returns:Your Windows XP CD Key.
'
'This code is copyrighted and has' limited warranties.Please see http://w
'     ww.Planet-Source-Code.com/vb/scripts/Sho
'     wCode.asp?txtCodeId=57164&lngWId=1'for details.'**************************************

'sGetXPCDKey() -
'Returns the Windows XP CD Key if succes
'     sful.
'Returns nothing upon failure.


Public Function sGetXPCDKey() As String

    'Read the value of:
    'HKLM\SOFTWARE\MICROSOFT\Windows NT\Curr
    '     entVersion\DigitalProductId
    Dim bDigitalProductID() As Byte
    Dim bProductKey() As Byte
    Dim ilByte As Long
    Dim lDataLen As Long
    Dim hKey As Long
    'Open the registry key: HKLM\SOFTWARE\MI
    '     CROSOFT\Windows NT\CurrentVersion


    If RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\MICROSOFT\Windows NT\CurrentVersion", hKey) = ERROR_SUCCESS Then
        lDataLen = 164
        ReDim Preserve bDigitalProductID(lDataLen)
        'Read the value of DigitalProductID


        If RegQueryValueEx(hKey, "DigitalProductId", 0&, REG_BINARY, bDigitalProductID(0), lDataLen) = ERROR_SUCCESS Then
            'Get the Product Key, 15 bytes long, off
            '     set by 52 bytes
            ReDim Preserve bProductKey(14)


            For ilByte = 52 To 66
                bProductKey(ilByte - 52) = bDigitalProductID(ilByte)
            Next ilByte

        Else
            'ERROR: Could not read "DigitalProductID
            '     "
            sGetXPCDKey = ""
            Exit Function
        End If

    Else
        'ERROR: Could not open "HKLM\SOFTWARE\MI
        '     CROSOFT\Windows NT\CurrentVersion"
        sGetXPCDKey = ""
        Exit Function
    End If

    'Now we are going to 'base24' decode the
    '     Product Key
    Dim bKeyChars(0 To 24) As Byte
    'Possible characters in the CD Key:
    bKeyChars(0) = Asc("B")
    bKeyChars(1) = Asc("C")
    bKeyChars(2) = Asc("D")
    bKeyChars(3) = Asc("F")
    bKeyChars(4) = Asc("G")
    bKeyChars(5) = Asc("H")
    bKeyChars(6) = Asc("J")
    bKeyChars(7) = Asc("K")
    bKeyChars(8) = Asc("M")
    bKeyChars(9) = Asc("P")
    bKeyChars(10) = Asc("Q")
    bKeyChars(11) = Asc("R")
    bKeyChars(12) = Asc("T")
    bKeyChars(13) = Asc("V")
    bKeyChars(14) = Asc("W")
    bKeyChars(15) = Asc("X")
    bKeyChars(16) = Asc("Y")
    bKeyChars(17) = Asc("2")
    bKeyChars(18) = Asc("3")
    bKeyChars(19) = Asc("4")
    bKeyChars(20) = Asc("6")
    bKeyChars(21) = Asc("7")
    bKeyChars(22) = Asc("8")
    bKeyChars(23) = Asc("9")
    Dim nCur As Integer
    Dim sCDKey As String
    Dim ilKeyByte As Long
    Dim ilBit As Long


    For ilByte = 24 To 0 Step -1
        'Step through each character in the CD k
        '     ey
        nCur = 0


        For ilKeyByte = 14 To 0 Step -1
            'Step through each byte in the Product K
            '     ey
            nCur = nCur * 256 Xor bProductKey(ilKeyByte)
            bProductKey(ilKeyByte) = Int(nCur / 24)
            nCur = nCur Mod 24
        Next ilKeyByte

        sCDKey = Chr(bKeyChars(nCur)) & sCDKey
        If ilByte Mod 5 = 0 And ilByte <> 0 Then sCDKey = "-" & sCDKey
    Next ilByte

    sGetXPCDKey = sCDKey
End Function

Não sei se dá e não tenho como testar.

Cumprimentos.

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

brigado PJM

esse código funciona, devolve a SerialKey do Windows...

mas "infelizmente" ja nao é a Key que quero, mas sim o ID =/

encontra-se na mesma localização que a Key, mas eu nao estou a conseguir ir busca-lo.. =/

se alguem com mais experiencia em vb me conseguisse (mais uma vez) ajudar...

cumprimentos,

P.S.: Ja nao queo a Key porque 2 pc's podem ter a mesma key, mas nenhum tem o mesmo ID...

questões de segurança...

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Adicionas um referência ao "Windows Script Host Object Model". Depois podes utilizar este código:

Function GetWindowsID() As String
    Dim oShell As IWshShell
    Set oShell = New IWshShell_Class
    GetWindowsID = oShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\ProductId")
End Function

Private Sub Command1_Click()
    MsgBox GetWindowsID
End Sub

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

jpaulino

funcionou

mto obrigado mesmo =)

código simples e eficaz

obrigado mais uma vez,

cumprimentos  a todos

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

O Código é simples porque o componente  Windows Script Host Object Model faz a leitura do registo do windows, estarei correcto jpaulino?

Já agora sabes se esse componente existe para o VB 2008 .net?

Cumprimentos.

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Olá,

O Windows Script Host Object Model  é constituido por 14 objectos que ajudam e simplificam algums processos, com é o caso de acesso ao Registry, através do WshShell. Se quiseres mais informação podes consultar no site da MSDN http://msdn.microsoft.com/en-us/library/a74hyyw0(VS.85).aspx

Para o .NET (2005/2008) podes utilizar outros métodos, mais simples, como por exemplo utilizar o namespace My

        Dim strKey As String = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\"
        Dim strValue As String = "ProductId"
        Debug.WriteLine(My.Computer.Registry.GetValue(strKey, strValue, String.Empty))

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Hmmm parece ser bastante mais simples, tenho de testar.

Muito Obrigado  :P

Já agora para que serve o Debug.WriteLine? É uma especie de msgbox?

Como estou no Windows Vista isso não dá, visto terem mudado a localização do ProductID, porém gostaria de saber(se possível) o que o Debug.Writeline faz  :hmm:

Muito obrigado.

Cumprimentos.

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

O Debug.WriteLine serve para escrever um valor/resultado na janela immediate (debug - windows - immediate). A msgbox obriga a parar o programa e quando clicas em OK ele continua. Através da janela de immediate fazes o output de algo, sem parar a aplicação, e podes analisar o resultado durante e depois.

Ex:

For X As Byte = 0 To 50

  Debug.WriteLine(x.ToString())

Next x

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Já estou a ver, muito útil pois quando estamos a programar podemos verificar os valores de forma rápida e eficiente, sempre é melhor que usar msgbox's e carregar sempre no enter  :P

Cumprimentos e obrigado pela dica

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Crie uma conta ou ligue-se para comentar

Só membros podem comentar

Criar nova conta

Registe para ter uma conta na nossa comunidade. É fácil!


Registar nova conta

Entra

Já tem conta? Inicie sessão aqui.


Entrar Agora