[Resolvido]Descobrir serial ativação windows

Boa noite

Se colocarmos essa rotina num bloco de notas e mudarmos para vbs irá aparecer quando executado o serial de ativação do windows.

Código:

Set WshShell = CreateObject("WScript.Shell")

MsgBox ConvertToKey(WshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId"))

Function ConvertToKey(Key)

Const KeyOffset = 52

I = 28

Chars = "BCDFGHJKMPQRTVWXY2346789"

Do

Cur = 0

x = 14

Do

Cur = Cur * 256

Cur = Key(x + KeyOffset) + Cur

Key(x + KeyOffset) = (Cur \ 24) And 255

Cur = Cur Mod 24

x = x - 1

Loop While x >= 0

I = I - 1

KeyOutput = Mid(Chars, Cur + 1, 1) & KeyOutput

If (((29 - I) Mod 6) = 0) And (I <> -1) Then

I = I - 1

KeyOutput = "-" & KeyOutput

End If

Loop While I >= 0

ConvertToKey = KeyOutput

End Function

Existe alguma forma de obtermos isso usando o VBA...
Objetivo seria adaptar uma proteção anti cópia.

Obrigado.

Olá Mylton,

Pode colar esse código num modulo e adaptar numa função para obter o serial do SO.
Talvez seja necessario ativar referência.

Depois será usar a imaginação no seu aplicativo para verificar e ter a proteção.

Abraço

Por curiosidade resolvi tentar, mas a chave a ser lida está em binary e não consegui fazer o Access ler.

Tentei manter o VBS que geraria um TXT com o serial e depois o Access leria o TXT com o resultado, mas ao chamar o VBS pelo Access dá erro informando que a chave não pode ser lida na rotina do VBS. O intrigante é que se o usuário clicar duas vezes no VBS criado pelo código ele gera o TXT sem erro.

Mesmo chamando o VBS de outras formas acontece o erro. Desisti. Se alguém quiser prosseguir dessa forma, eis até onde fui

Código:

Private strArqVBS As String
Private strArqTXT As String

Public Function fncNumeroSerialWindows() As String

    Dim k As String
    
    strArqVBS = CurrentProject.Path & "\TempVBS.vbs"
    strArqTXT = CurrentProject.Path & "\TempTXT.txt"

    Call fncCriaExecVBS
    Call fncLerDelArqsGerado(k)
    
    'MsgBox k
    fncNumeroSerialWindows = k
    Call Kill(strArqVBS)
    Call Kill(strArqTXT)

End Function

Private Sub fncLerDelArqsGerado(k As String)
On Error Resume Next

    Dim strLinhas As String
    
    Open strArqTXT For Input As #1
          Line Input #1, k
    Close #1
    
    If Err.Number <> 0 Then
        k = Err.Description
        Err.Clear
    End If
    
End Sub

Private Sub fncCriaExecVBS()

    Open strArqVBS For Append As #1
        Print #1, "Set k = CreateObject(""Scripting.FileSystemObject"").CreateTextFile(""" & strArqTXT & """, True)"
        Print #1, "k.WriteLine(ConvertToKey(CreateObject(""WScript.Shell"").RegRead(""HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId"")))"
        Print #1, "k.Close"
        Print #1, "Function ConvertToKey(Key)"
        Print #1, "Const KeyOffset = 52"
        Print #1, "I = 28"
        Print #1, "Chars = ""BCDFGHJKMPQRTVWXY2346789"""
        Print #1, "Do"
        Print #1, "Cur = 0"
        Print #1, "x = 14"
        Print #1, "Do"
        Print #1, "Cur = Cur * 256"
        Print #1, "Cur = Key(x + KeyOffset) + Cur"
        Print #1, "Key(x + KeyOffset) = (Cur \ 24) And 255"
        Print #1, "Cur = Cur Mod 24"
        Print #1, "x = x - 1"
        Print #1, "Loop While x >= 0"
        Print #1, "I = I - 1"
        Print #1, "KeyOutput = Mid(Chars, Cur + 1, 1) & KeyOutput"
        Print #1, "If (((29 - I) Mod 6) = 0) And (I <> -1) Then"
        Print #1, "I = I - 1"
        Print #1, "KeyOutput = ""-"" & KeyOutput"
        Print #1, "End If"
        Print #1, "Loop While I >= 0"
        Print #1, "ConvertToKey = KeyOutput"
        Print #1, "End Function"
    Close #1
    
    'Call Shell("cmd /c """ & strArqVBS & """", vbHide)
    'Call Shell("cmd /c """ & "d:\Users\ivan.junior\Documents\exec.cmd" & """", vbHide)
    Call CreateObject("WScript.Shell").Run("""" & strArqVBS & """", 0, 0)

End Sub

Penso que seja o caminho para a proteção dos nossos sistemas.
Eu como medico não.tenho nesse campo nada a fazer.
Não possuo o conhecimento básico para esse.desenvolvimento.
Mas, creio que com esse serial e alguma rotina simples chegaremos a um bingo.
Aguardo os Mestre.
Gde Abs a todos.

Bom dia

Por quantos caracteres é composto o dito Serial ?

É a chamada Key do Windows tipo 25DF - DGT6 - GHY5 - KJU - ????'etc

Obrigado

25DF - DGT6 - GHY5 - KJU - ?????

Exatamente assim. 25.

Bom dia.
Exemplo de chave ativação do Windows
NKJFK-GPHP7-G8C3J-P6JXR-HQRJR

Olá a todos,

Assis é a chave de ativação do produto, neste caso do SO, veja exemplo:


Ivan, a partir do MS Access tembém não consegui. Mesmo criando o TXT diretamente através do "script"
Veja o código do meu teste:

Código:

'Adaptado por ahteixeira 2018 para maximoaccess
Set WshShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")

Dim sFicheiro, sChave

sChave = ConvertToKey(WshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId"))
sFicheiro = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".") & "\tmpSerial.txt"

Set objFile = objFSO.CreateTextFile(sFicheiro, True)
objFile.Write sChave
objFile.Close

Function ConvertToKey(Key)
Const KeyOffset = 52
    
    i = 28
    Chars = "BCDFGHJKMPQRTVWXY2346789"
        
        Do
            Cur = 0
            x = 14
            Do
                Cur = Cur * 256
                Cur = Key(x + KeyOffset) + Cur
                Key(x + KeyOffset) = (Cur \ 24) And 255
                Cur = Cur Mod 24
                x = x - 1
            Loop While x >= 0
            
            i = i - 1
            KeyOutput = Mid(Chars, Cur + 1, 1) & KeyOutput
            
            If (((29 - i) Mod 6) = 0) And (i <> -1) Then
                i = i - 1
                KeyOutput = "-" & KeyOutput
            End If
        Loop While i >= 0
    
    ConvertToKey = KeyOutput
End Function

Mylton, não falta exemplos de proteção, mas se a ideia era comparar a Chave do windows para verificar se é uma máquina autorizada, pode verificar através de outros componentes, veja tópico abaixo:
https://www.maximoaccess.com/t33280-ip-local-publico-mac-address-id-processador-serie-motherboard

Abraço a todos

Ah Teixeira.
Obrigado pelo exemplo.
Na 1 msg obtemos com a escrita descrita.
Existe alguma forma de torná-la oculta e buscar na caixa de mensagem com a chave para compararmos?

Pois é, mestre Alvaro, ainda estou intrigado com isso.

Mylton, estou desenvolvendo um exemplo aos moldes do artigo oferecido no link abaixo. Mas somente com algumas das técnicas de proteção e usando o MySQL, logo postarei no repositório.

usandoaccess.com.br/tutoriais/video-sistema-shareware-com-libercao-online.asp

Olá a todos,

Ivan, ficamos aguardar.
Mylton, não compreendi a pergunta.

Abraço

Ah Teixeira
Em minha 1 msg disponibilizei um código. Se colocarmos esse código num bloco de notas e trocarmos a extensão p VBS ao rodarmos aparece a chave numa caixa de msg.
Pergunto
Existe possibilidade de rodarmos isso de forma oculta e capturarmos essa msg afim de guardarmos numa tabela qualquer?

Boas festas para todos;

Veja se é isto que pretende.
Não necessita de criar VBScript nem txt, ele faz tudo sozinho.

Download

Boa tarde JPaulo.
Estou no celular. Em 3 horas em casa. Baixo, vejo e respondo.
Obrigado.

A bendita chamada kkkkk
Obrigado por essa alternativa de chamada mestre JPaulo... coloquei no meu código e deu certinho também. Cada dia aprendo mais aqui.

Código:

Shell "Explorer.exe ""C:\temp\vbskey.vbs""", 1

Para quem já fez o download, é favor fazer de novo.

Exemplo retificado, para criar a pasta "temp" em "C:" se não existir.

Funciona em todas as versão do windows e office.

Agora sim

Exemplo adicionado ao repositorio de exemplos.

Mestre, ainda não baixei... estou no celular. O nova versão faz a exclusão do VBS e TXT criado em tempo de execução?

No final do código para quem quiser excluir é só inserir o
'Kill "c:\tem\vbskey.vbs"
'Kill "c:\tem\key.txt"

Não vejo necessidade.

JPaulo
Se Deus criasse uma mesa de programadores ao seu redor...
Pessoas como Vc, AH Teixeira, Ivan, Assis e muitos outros estariam presentes nessa mesa.
Parabéns aos mestres.

Grato mestre JPaulo.

Valeu Mylton.

Então e para o office?

Tópico resolvido.
Fico feliz.
Boas festas

A todos um excelente Natal e 2019.
Obrigado.

Olá a todos,

Grande JPaulo, matou a charada, nunca é demais "Obrigado por tanta dedicação e partilha do conhecimento".

Com disse o colega Ivan "Cada dia aprendo mais aqui.".
Isto é Maximoaccess, sempre aprender

Aproveiro para desejar Boas Festas

Bom dia Amigos

O Toyebom ficou sem resposta na mensagem Nº 23.

Pergunto o mesmo

Obrigado

Olá a todos,

Respondendo à questão anterior e á nº 23, em VBA para o Office eu desconheço.
Se pretendem apenas obter o serial do Office instalado, fazer uma pesquisa no google "Nirsoft Product Key".

Lembro que este fórum é de Access.

Abraço

E o Access não é Office???
Só coloquei a duvida e é outra coisa que se pode aprender em vba.

Meninos....
O post foi encerrado pelo M. João Paulo, e iniciado por mim.
Que tal abrirem outro?