Ver Mensaje Individual
  #16  
Antiguo 11-08-2011
Avatar de ecfisa
ecfisa ecfisa is offline
Moderador
 
Registrado: dic 2005
Ubicación: Tres Arroyos, Argentina
Posts: 10.508
Reputación: 36
ecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to behold
Hola.

Por si fuera de utilidad, hice un ejemplo simple que guarda cifrado el numero de serie lógico del disco en el registro y luego lo recupera:
Código Delphi [-]
...

uses Registry;

(* Escribe serial en registro *)
procedure WriteRegKey(const ARootKey: HKEY; const AKey, Valor, NSer: string);
begin
  with TRegistry.Create(KEY_WRITE) do
  try
    RootKey := ARootKey;
    if not OpenKey(AKey, True) then
      raise Exception.Create('Error escribiendo el registro')
    else
    begin
      WriteString(Valor, NSer);
      CloseKey;
    end
  finally
    Free
  end
end;

(* Devuelve serial almacenado en registro *)
function ReadRegKey(const ARootKey: HKEY; const AKey, Valor: string): string;
begin
  with TRegistry.Create do
  try
    RootKey := ARootKey;
    if not OpenKey(AKey, False) then
      raise Exception.Create('Error leyendo el registro')
    else
    begin
      ReadString(Result);
      CloseKey
    end
  finally
    Free
  end
end;

(* Obtiene el número serial del disco *)
function HDSerial(const lpRootPathName: PChar): string;
var
  lpMaximumComponentLength: DWORD;
  lpFileSystemFlags: DWORD;
  lpVolumeSerialNumber: DWORD;
  lpVolumeNameBuffer:  array[0..MAX_PATH] of Char;
begin
  GetVolumeInformation(PChar(lpRootPathName),
                       @lpVolumeNameBuffer,
                       SizeOf(lpVolumeNameBuffer),
                       @lpVolumeSerialNumber,
                       lpMaximumComponentLength,
                       lpFileSystemFlags, nil, 0);
  Result := IntToHex(HiWord(lpVolumeSerialNumber),4) +
            IntToHex(LoWord(lpVolumeSerialNumber),4);
end;

(* rutina trivial de cifrado *)
procedure Cifrar(var Valor: string);
var
  i: integer;
begin
  for i:= 1 to Length(Valor) do
    Valor[i]:= Chr(((Ord(Valor[i]) xor 172)xor 15));
end;

(* Ejemplo de uso *)
procedure TForm1.Button1Click(Sender: TObject);
const
  VALOR_KEY = '\Software\Microsoft\Windows\CurrentVersion';
var
  NSer: string;
begin
  NSer:= HDSerial('C:\');                     // Obtener serial
  Label1.Caption:='Serial Original: ' + NSer; // Mostrar
  Cifrar(NSer);                               // Cifrarlo
  // Escribir serial cifrado en el registro
  //'NombreConfuso' es cualquiera que no se vislumbre como protección.
  WriteRegKey(HKEY_LOCAL_MACHINE,VALOR_KEY,'NombreConfuso',NSer);
  // Leer el serial almacenado en el registro
  NSer:= ReadRegKey(HKEY_LOCAL_MACHINE,VALOR_KEY,'NombreConfuso');
  Label2.Caption:='Serial Cifrado: ' + NSer;  // Lo que se ve en el registro
  Cifrar(NSer);                               // Descifrarlo
  Label3.Caption:= 'Serial Restaurado: '+Nser;// Mostrarlo
end;
Como es sólo un ejemplo la rutina de cifrado no es ninguna maravilla , pero se puede cambiar por la que sea.

Espero que sirva como base para mejorarlo a gusto

Un saludo.
__________________
Daniel Didriksen

Guía de estilo - Uso de las etiquetas - La otra guía de estilo ....

Última edición por ecfisa fecha: 11-08-2011 a las 21:38:12. Razón: Acomodar identación
Responder Con Cita