ActiveDelphi - Índice do Fórum ActiveDelphi
.: O site do programador Delphi! :.
 
 FAQFAQ   PesquisarPesquisar   MembrosMembros   GruposGrupos   RegistrarRegistrar 
 PerfilPerfil   Entrar e ver Mensagens ParticularesEntrar e ver Mensagens Particulares   EntrarEntrar 

Recuperar a Product Key do Office

 
Novo Tópico   Responder Mensagem    ActiveDelphi - Índice do Fórum -> Delphi
Exibir mensagem anterior :: Exibir próxima mensagem  
Autor Mensagem
savoine
Novato
Novato


Registrado: Segunda-Feira, 12 de Dezembro de 2005
Mensagens: 85

MensagemEnviada: Sex Ago 16, 2013 11:36 am    Assunto: Recuperar a Product Key do Office Responder com Citação

Bom dia a todos eu encontrei esse função que utiliza o RegOpenKeyEx/RegQueryValueEx para recuperar a key do Windows/Office o windows funciona normalmente, porem ele não captura o key do office. (Não é problema no endereço do PATH!!!).

Código:

{*******************************************************}
{ }
{ Windows 2000/XP/2003 Product Key retrieval }
{ Copyright (c) 2004, BC software }
{ }
{*******************************************************}
unit ProductKey;
{$DEFINE SeparateByMinus}
{ Define this variable to return the key as
AAAAA-BBBBB-CCCCC-DDDDD-EEEEE
otherwise
AAAAABBBBBCCCCCDDDDDEEEEE
}
{$DEFINE ReturnErrors}
{
Return registry opening/reading errors as a result of the function
otherwise return nothing
}
interface
function GetProductKey: string;
implementation
uses Windows;
function GetProductKey: string;
const
// In case you need MS Office 2003 product key use
// 'SOFTWARE\Microsoft\Office\11.0\Registration\{90110419-6000-11D3-8CFE-0150048383C9}';
KeyPath = 'SOFTWARE\Microsoft\Windows NT\CurrentVersion';
KeyValue = 'DigitalProductId';
// The array of symbols allowed in Product Key:
KeyChars: array [0..23] of Char =
('B','C','D','F','G','H','J','K','M','P','Q','R',
'T','V','W','X','Y','2','3','4','6','7','8','9');
var
// Registry access variables
InfoKey: HKEY;
InfoType: DWORD;
// Decoding variables
Data: array [1..$A8] of Byte; // Raw data from registry key placed here
BinaryKey: array [0..14] of Byte; // Part of raw data contains the binary Product Key
DecodedKey: array [0..24] of Char; // Decoded Product Key is placed here
DataSize: DWORD;
A: Cardinal;
// iterators
i, j: Integer;
begin
// Opening registry key
if RegOpenKeyEx(HKEY_LOCAL_MACHINE, KeyPath, 0, KEY_READ, InfoKey) = ERROR_SUCCESS then
begin
DataSize := SizeOf(Data);
// Reading the key value
if RegQueryValueEx(InfoKey, KeyValue, nil, @InfoType, @Data, @DataSize) = ERROR_SUCCESS then
begin
// We need 15 bytes from $35 in BinaryKey
CopyMemory(@BinaryKey, @Data[$35], SizeOf(BinaryKey));
// Let's decode it as a kind of "Base24" encoding
// Note, the symbols are decoded from last to first!
for i := High(DecodedKey) downto Low(DecodedKey) do
begin
A := 0;
// decoding the current symbol
for j := High(BinaryKey) downto Low(BinaryKey) do
begin
A := (A shl 8) + BinaryKey[j];
BinaryKey[j] := A div 24;
A := A mod 24;
end;
DecodedKey[i] := KeyChars[A];
end;
{$IFDEF SeparateByMinus}
for i := Low(DecodedKey) to High(DecodedKey) do
begin
Result := Result + DecodedKey[i];
if ((i + 1) mod 5 = 0) and (i < High(DecodedKey)) then
Result := Result + '-';
end;
{$ELSE}
Result := Result + DecodedKey;
{$ENDIF}
RegCloseKey(InfoKey);
end
{$IFDEF ReturnErrors}
else
Result := 'Error reading registry key value!';
{$ENDIF}
end
{$IFDEF ReturnErrors}
else
Result := 'Error opening registry key!';
{$ENDIF}
end;
end.



Eu precisava que a key fosse recuperada através do RegOpenKeyEx/RegQueryValueEx
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular MSN Messenger
cyberdisk
Colaborador
Colaborador


Registrado: Domingo, 4 de Julho de 2010
Mensagens: 2391
Localização: São José dos Campos - SP

MensagemEnviada: Sex Ago 16, 2013 7:35 pm    Assunto: Responder com Citação

acho que o caminho não é só isso

KeyPath = 'SOFTWARE\Microsoft\Windows NT\CurrentVersion';

verifique no seu micro pelo RegEdit sé é realmente isso

abraço
_________________
O conhecimento abre muitas portas
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail
savoine
Novato
Novato


Registrado: Segunda-Feira, 12 de Dezembro de 2005
Mensagens: 85

MensagemEnviada: Seg Ago 19, 2013 8:22 am    Assunto: Responder com Citação

Sim o endereço no regedit esta correto.
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular MSN Messenger
Mostrar os tópicos anteriores:   
Novo Tópico   Responder Mensagem    ActiveDelphi - Índice do Fórum -> Delphi Todos os horários são GMT - 3 Horas
Página 1 de 1

 
Ir para:  
Enviar Mensagens Novas: Proibido.
Responder Tópicos Proibido
Editar Mensagens: Proibido.
Excluir Mensagens: Proibido.
Votar em Enquetes: Proibido.


Powered by phpBB © 2001, 2005 phpBB Group
Traduzido por: Suporte phpBB