Encriptar / desencriptar ficheros

3861 vistas

Se trata de una función que encripta el contenido de un fichero usando una clave pseudo aleatoria.
La misma función aplicada sobre un fichero previamente encriptado con la misma clave restaura el fichero original.

Mostramos la función y un ejemplo de llamada, todo contenido en el OnClick de un TButton:



delphi
  1. procedure TForm1.Button2Click(Sender: TObject);
  2.  
  3.   procedure EncriptaFichero(Ori, Dest: string; Clave:integer);
  4.   {
  5.     Encripta el ficehro 'Ori', depositandolo en el fichero 'Dest'
  6.     usando como clave 'Clave'.
  7.     Una pasada: encripta, otra pasada sobre el fichero encriptado, con la
  8.     misma clave, lo desencripta.
  9.     Ori: Nombre del fichero original (Source filename)
  10.     Dest: Nombre del fichero encriptado (Destination filename) }
  11.  
  12.   const
  13.     MAXBUFFER        = 4096;  //4k de buffer;
  14.   var
  15.     Buffer: array[1..MAXBUFFER] of byte;
  16.     Origen, Destino: TFileStream;
  17.     n, Leidos: integer;
  18.   begin
  19.     Origen := TFileStream.Create(Ori,fmOpenRead+fmShareDenyWrite);
  20.     Destino := TFileStream.Create(Dest,fmCreate);
  21.     RandSeed := Clave;
  22.     try
  23.       repeat
  24.         Leidos := Origen.Read( Buffer[1],MAXBUFFER );
  25.         for n := 1 to Leidos do begin
  26.           Buffer[n] := Buffer[n] xor Random(256);
  27.         end;
  28.         Destino.Write(Buffer[1], Leidos);
  29.       until (Leidos < MAXBUFFER);
  30.     finally
  31.       Origen.Free;
  32.       Destino.Free;
  33.     end;
  34.   end;
  35.  
  36. begin
  37.   {Ejemplo de llamada:}
  38.   {Encriptar el fichero Test.txt con la clave 666}
  39.   try
  40.     EncriptaFichero('c:\kk\Test.txt', 'c:\kk\Test.dat', 666);
  41.   except
  42.     on E: Exception do
  43.       ShowMessage( 'Error: No se pudo Encriptar el fichero.' + #13 +
  44.                   'Motivo: ' + E.Message);
  45.   end;
  46.  
  47.  
  48.   {Desencripta el fichero Test.dat con la clave 666:}
  49.   try
  50.     EncriptaFichero('c:\kk\Test.dat', 'c:\kk\Test.txt', 666);
  51.   except
  52.     on E:exception do
  53.       ShowMessage( 'Error: No se pudo desencriptar el fichero.' + #13 +
  54.                   'Motivo: ' + E.Message);
  55.   end;
  56. end;