La siguiente utilidad la publique hace tiempo en
Trucomanía pero la pongo aquí por si a alguién le interesa.
La unit
SecureDel contiene la función
BorrarFichero, que permite el borrado "seguro" de archivos. Es sabido que existe software que es capaz de recuperar archivos aún cuando estos han sido borrados. La función implementa el estándar DOD 5220.22-M del Depto. de defensa de EEUU para la limpieza y saneado de datos. La rútina realiza lo siguiente:
- Machaca el contenido del archivo 3 veces con un patrón distinto: todo a ceros, todo a unos y contenido aleatorio
- Renombra el archivo 26 veces
- Finalmente, borra el archivo
unit SecureDel;
interface
function BorrarFichero(const NombreFichero: String): Boolean;
implementation
uses
Windows, SysUtils;
const
TAMANIO_BUFFER = 65536;
NRO_BUFFERS = 3;
var
FBuffers: array [0..NRO_BUFFERS-1] of ^byte;
procedure CrearBuffers;
var
i, j: Integer;
p: ^byte;
begin
// obtenemos la memoria para los buffers (64Kb cada uno)
// y los rellenamos con info aleatoria
Randomize;
for i:=0 to Pred( NRO_BUFFERS ) do begin
GetMem( FBuffers[i], TAMANIO_BUFFER );
case i of
0: ; // relleno con ceros (lo hace el sistema)
1: FillChar( FBuffers[i]^, TAMANIO_BUFFER, $FF );
2: begin
p := @(FBuffers[i]^);
for j := TAMANIO_BUFFER downto 1 do begin
p^ := byte( Random( $FF ) );
Inc(p);
end;
end;
end;
end;
end;
procedure DestruirBuffers;
var i: Integer;
begin
for i:=0 to Pred( NRO_BUFFERS ) do FreeMem( FBuffers[i] )
end;
function RenombrarFichero(const NombreFichero: String; var NuevoNombreFichero: String): Boolean;
const
NRO_VECES_RENOMBRA = 26;
var
i, j : Integer;
TmpNombreFichero, Ruta: String;
begin
Ruta := ExtractFilePath( NombreFichero );
TmpNombreFichero := ExtractFileName( NombreFichero );
NuevoNombreFichero := TmpNombreFichero;
for i:= 0 to Pred( NRO_VECES_RENOMBRA ) do begin
for j := 1 to Length( NuevoNombreFichero ) do
if NuevoNombreFichero[j] <> '.'
then NuevoNombreFichero[j] := Char( Ord('A') + i );
if FileExists( Ruta + NuevoNombreFichero )
then Continue;
Result := RenameFile( Ruta + TmpNombreFichero, Ruta + NuevoNombreFichero );
if not Result
then Exit;
TmpNombreFichero := NuevoNombreFichero;
end;
NuevoNombreFichero := Ruta + NuevoNombreFichero;
end;
procedure MachacarFichero(const h: THandle; Longitud: Cardinal);
var
i: Integer;
Posicion, TotalBytes, BytesEscritos, BytesAEscribir: Cardinal;
begin
Posicion := Longitud;
for i:=0 to NRO_BUFFERS-1 do begin
if i <> 0
then SetFilePointer( h, -Posicion, nil, FILE_CURRENT );
TotalBytes := 0;
while TotalBytes < Longitud do begin
if Longitud - TotalBytes > TAMANIO_BUFFER
then BytesAEscribir := TAMANIO_BUFFER
else BytesAEscribir := Longitud - TotalBytes;
BytesEscritos := FileWrite( h, (FBuffers[i])^, BytesAEscribir );
if BytesEscritos = $FFFFFFFF
then RaiseLastWin32Error;
Inc( TotalBytes, BytesEscritos );
end;
end;
end;
function BorrarFichero(const NombreFichero: String): Boolean;
var
h: THandle;
UltNomFich: String;
TamanioFileHi, TamanioFileLo, BytesAEscribir: Cardinal;
TamanioFile, BytesEscritos: Int64;
begin
Result := False;
// cambiamos atributos del archivo por si tuviera atributos de solo lectura
Result := FileSetAttr( NombreFichero, faArchive ) = 0;
if not Result then begin
RaiseLastWin32Error;
Exit;
end;
// abrimos el archivo para escritura
h := FileOpen( NombreFichero, fmOpenWrite );
Result := h <> -1;
if not Result then begin
RaiseLastWin32Error;
Exit;
end;
// creamos los buffers de escritura de archivo
CrearBuffers;
try
// obtenemos tamaño del archivo
TamanioFileLo := GetFileSize( h, @TamanioFileHi );
// si el archivo no tiene tamaño 0, lo machacamos
if ( TamanioFileLo > 0 ) or ( TamanioFileHi > 0 ) then begin
// ponemos el puntero del archivo al final
Dec( TamanioFileLo );
if ( TamanioFileLo = $FFFFFFFF ) and ( TamanioFileHi > 0 )
then Dec( TamanioFileHi );
SetFilePointer( h, TamanioFileLo, @TamanioFileHi, FILE_BEGIN );
// escribimos un cero byte al final del archivo, lo q hace
// q el SO rellene con ceros todo el espacio ocupado por el archivo
MachacarFichero(h, 1);
// volvemos al principio del archivo y sobreescribimos
SetFilePointer( h, 0, nil, FILE_BEGIN );
BytesEscritos := 0;
TamanioFile := TamanioFileLo or (TamanioFileHi shl 32);
while BytesEscritos < TamanioFile do
begin
if TamanioFile - BytesEscritos < TAMANIO_BUFFER
then BytesAEscribir := TamanioFile - BytesEscritos
else BytesAEscribir := TAMANIO_BUFFER;
MachacarFichero( h, BytesAEscribir );
Inc( BytesEscritos, BytesAEscribir );
end;
end;
finally
// cerramos el archivo y liberamos memoria
FileClose( h );
DestruirBuffers;
end;
// cambiamos el archivo de nombre repetidas veces
Result := RenombrarFichero( NombreFichero, UltNomFich );
// finalmente, borramos el archivo
if Result then Result := DeleteFile( UltNomFich );
end;
end.
|
