Наполнение файла мусором (перед удалением) Delphi

[Lime]

Доброго времени суток !

Написал вот такую функцию ...

Идея : для "безвозвратного" удаления файлов записать в файл всякий бред изменить размер , а уже потом удалять его с диска любым способом.

С небьольшим логом :

function Erase(FileName:string;{BytesCount,}Cycles:integer=1):TStringList;
var
  f:TFileStream;
  rub:array[1..1024] of Byte;
  i,j,cc:integer;
  res:TStringList;
  chas,min,sec,msec:Word;
  begin
  cc:=0;
  res :=TStringList.Create;
  DecodeTime(GetTime,chas,min,sec,msec);
  res.Add(IntToStr(chas)+':'+IntToStr(min)+':'+IntToStr(sec)+':'+IntToStr(msec));// 0 - начало
  res.Add(IntToStr(Cycles));// 1 - колво проходов

  if FileExists(FileName)
  then f:=TFileStream.Create(FileName,fmOpenWrite+fmshareexclusive)
  else begin res.Add('0');   res.Add(IntToStr(chas)+':'+IntToStr(min)+':'+IntToStr(sec)+':'+IntToStr(msec)); result:=res; Exit; end;
  for  j := 1 to Cycles do
  begin
   f.Position := 0;
   while f.Position < f.Size do
   begin
   for i:=1 to Length(rub) do rub[i] := Random(256);//тут какбы сам мусор генерируется ... :)
   Inc(cc);
   f.Write(rub,SizeOf(rub));
   end;
  end;
  res.Add(IntToStr(cc));// 2 - циклов
  DecodeTime(GetTime,chas,min,sec,msec);
  res.Add(IntToStr(chas)+':'+IntToStr(min)+':'+IntToStr(sec)+':'+IntToStr(msec));// 3 - окончание
  result:=res;
  f.Free;
end;

//Убрал связь с внешним миром исключая result
Добавить строчку deletefile не проблема)

+off
В кабинете шефа компьютерщик подготавливает комп к форматированию. В это время в кабинет влетает секретарша:
- Шеф спрашивает, не встречалась ли вам папка "Мусор"?
Компьютерщик с ужасом вспоминает, что минуту тому назад снес эту папку. Немедленно запускаются всевозможные "анерейзы", и через полчаса он гордо докладывает вешедшему в кабинет шефу:
- Шеф, я нашел ее!
- Кого?
- Ту папку, "Мусор". Вы полчаса назад звонили...
- Ах да! Я хотел сказать - сотри ее нафиг...

[Arigato]

Тут есть вопрос или это типа демо примера?
Немного мудрёно написано. Проще в исходный файл записать нули, количество = размеру файла, т.е. полностью затереть, а, затем, удалить.
Т.е. совсем не обязательно туда писать мусор. А несколько проходов вообще не ясно, для чего? После первого же прохода там ничего не останется от исходных данных. А так только тормозить процесс это будет.

[Stilet]

Не сильно понял что тее надо, но предложу свой любимый способ какаь в файл мусора:

  var f:file of byte;
  s:string;i:integer;
begin
 assignFile(f,'C:\temp\i');
 reset(f);
 i:=FileSize(f);
 SetLength(s,i);
 for i:=1 to length(s) do s[i]:=char(random(255));
 BlockWrite(f,s[1],length(s));
 CloseFile(f);
  { TODO -oUser -cConsole Main : Insert code here }
end.

Способ не идеальный но работает хорошо и быстро.

[Lime]

Сообщение от Arigato

Тут есть вопрос или это типа демо примера?
Немного мудрёно написано. Проще в исходный файл записать нули, количество = размеру файла, т.е. полностью затереть, а, затем, удалить.
Т.е. совсем не обязательно туда писать мусор. А несколько проходов вообще не ясно, для чего? После первого же прохода там ничего не останется от исходных данных. А так только тормозить процесс это будет.

Да это чтото вроде демо. Ну я так подумал не нужно особенно умудрятся чтобы этот самый мусор придумать)

Посоветовали сделать 2-3 прохода , по причине "на винчестере остаётся намагничивание" , я не особеннно вникал в возможность этого , как я понимаю действительно после 1вого прохода намагничивание старого сожержания должно заменится на новое.

Ещё советовали записать рандомные значения , авось файлик восстановят после протстого deletefile файл должен быть к этому моменту обезличен ) не восстановим.

Сообщение от Stilet

Не сильно понял что тее надо, но предложу свой любимый способ какаь в файл мусора:

  var f:file of byte;
  s:string;i:integer;
begin
 assignFile(f,'C:\temp\i');
 reset(f);
 i:=FileSize(f);
 SetLength(s,i);
 for i:=1 to length(s) do s[i]:=char(random(255));
 BlockWrite(f,s[1],length(s));
 CloseFile(f);
  { TODO -oUser -cConsole Main : Insert code here }
end.

Способ не идеальный но работает хорошо и быстро.

Файл может быть любого типа ( но изначально предполагается - программа под windows).

Хотелось сделать быстродействие - пробовал 2мя способами.
Делал лог примерно таково содержания :

array[1..1024*1] - 7,6 кб/сек на тестовом файлике //140msec цикл
array[1..1024*2] - 11,2 // 170msec
array[1..1024*4] - 24 // 175msec
array[1..1024*8] - 38 // 207msec
array[1..1024*16] - 59 // 275msec

Решил сделать х4 х8 ...

Так-же пробовал задавать длинну массива в аргументах
{BytesCount,}Cycles:integer
Но SetLength(rub,BytesCount); както неверно работало ... Length(rub) =4..

Лучшим способом было бы автоопределение какими блоками писать , в зависмости от размера файла ) загвоздка только в переопределении размера массива ...

add:
тест

var
  a:array of Byte;
  i:Integer;
begin
SetLength(a,1000);

ShowMessage(IntToStr(Length(a)));
 for i:=1 to Length(a) do a[i] := Random(256);
ShowMessage(IntToStr(Length(a)));

Показал обратное ... странно )

[Stilet]

както неверно работало

А че у меня все работает? Что я не так делаю?

[Lime]

Сообщение от Stilet

А че у меня все работает? Что я не так делаю?

У меня делфи волшебная) особенно Code Gear

Код аналогичный тому что был выше в тесте вчера(на ночь глядя) отказывался работать ... задавал длинну массива стабильно - 4 и процедура даже для маленьково файла длилась очень долго) записывалось блоками по 4 байта)

Сейчас на свежую тыкву напишу заново)

add:

function EraseFile(Filename:string):Integer;
var
fs:TFileStream;
i:Integer;
m:array of Byte;
begin
if not FileExists(Filename) then begin Result := 2; Exit; end;
fs := TFileStream.Create(Filename,fmOpenWrite);
case fs.Size of
0..1024*16 : SetLength(m,1024);
1024*16+1..1024*500 : SetLength(m,1024*8);
1024*500+1..1024*1024*32 : SetLength(m,1024*16);
else
SetLength(m,1024*16);
fs.Position := 0;
while fs.Position < fs.Size do
 begin
 for i := 0 to Length(m) do m[i] := Random(256);
 fs.Write(m,SizeOf(m));
 end;
fs.Free;
end;
if DeleteFile(Filename) then result := 1 else  result := 0;
end;

Возвращает 0 ...( наверно окрываю/закрываю неверно ...