VPF::Очистить свободное пространство на винчестере

Yuran

Дата 12.4.2006, 11:26 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 20
Регистрация: 25.3.2006

Репутация: нет
Всего: нет

Наро подскажите как можно очищать свободное пространство на винчестере! Тоисть что бы из него ничего нельзя было восстановить! Только свободное. Желательно что бы применялись разные методы! Универсальная функция!

Alexeis

Дата 12.4.2006, 11:28 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

только что обсуждалось smile

http://forum.vingrad.ru/index.php?showtopic=91166
Добавлено @ 11:29
только надо будет создать файл размером в ссвободное пространство

Это сообщение отредактировал(а) alexeis1 - 12.4.2006, 11:29

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

Alexeis

Дата 12.4.2006, 12:36 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

а вот и пример кода, ТОЛЬКО ЭТО РАБОТАЕТ НЕ БЫСТРО smile

на дисках со свободным местом порядка 10Гб - эта операция займет
не меньше часа smile

Код


function GetDiskFree(disk : AnsiString) : Int64;
var
  FreeBytesAvailableToCaller: TLargeInteger;
  FreeSize: TLargeInteger;
  TotalSize: TLargeInteger;
begin
  GetDiskFreeSpaceEx(PChar(disk),
    FreeBytesAvailableToCaller,
    Totalsize,
    @FreeSize);
  Result := FreeSize;
end;

procedure ZeroFillDelete(FileName: string);
var
  fs: TFileStream;    
  i:  integer;
    
  procedure RandomWrite;    
  var b:  byte;    
  begin
    Form1.progressbar1.Position := 0;
    repeat    
      b := Random(256);
      fs.Write(b, 1);
      
      if (fs.Position mod 2000000) = 0
      then
        Form1.progressbar1.Position := Form1.progressbar1.Position + 1;

      application.ProcessMessages;
    until fs.Position + 1 >= fs.Size;
  end;

  procedure WritePattern(pattern: byte);    
  const patt: array[5..31] of dword = ($555555, $AAAAAA, $924924, $492492,    
        $249249, 0, $111111, $222222, $333333, $444444, $555555, $666666,    
        $777777, $888888, $999999, $AAAAAA, $BBBBBB, $CCCCCC, $DDDDDD,    
        $EEEEEE, $FFFFFF, $924924, $492492, $249249, $6DB6DB, $B6DB6D, $DB6DB6);    
  var
    d: dword;
    s : integer;
  begin    
    d := patt[pattern] shl 8;
    s := 2000000 div 3;
    repeat
      fs.Write(d, 3);

      if ((fs.Position mod s)) = 0
      then
        Form1.progressbar1.Position := Form1.progressbar1.Position + 1;

      application.ProcessMessages;
    until (fs.Position + 3) >= fs.Size;
  end;

begin    
  if not FileExists(FileName)
  then
    Exit;

  for i := 1 to 35
  do
    try
      fs := TFileStream.Create(FileName, fmOpenWrite);
      try
        Form1.progressbar2.Position := Form1.progressbar2.Position + 1;

        if (i < 5) or (i > 31)
        then
          RandomWrite
        else
          WritePattern(i);

      finally    
        fs.Free;
      end;

    except
      Exit;
    end;
  
  DeleteFile(FileName);
end;


procedure TForm1.Button1Click(Sender: TObject);
var
 s : int64;
 f : TFileStream;
 m : array of byte;

begin
  s := 0;
  s := GetDiskFree('d:');
  f := TFileStream.Create('d:\1.txt', fmCreate);

  progressbar1.Max := s div 2000000;
  setlength(m, 2000000);
  try
    While (f.Size + 2000000) < s
    do
      Begin
        f.WriteBuffer(m[0], 2000000);
        application.ProcessMessages;
        progressbar1.Position := progressbar1.Position + 1;
      end;

    f.Size := s;
  Finally
    f.Free;
  end;

  ZeroFillDelete('d:\1.txt');
end;

--------------------

Yuran

Дата 12.4.2006, 19:21 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 20
Регистрация: 25.3.2006

Репутация: нет
Всего: нет

Отлично большое спасибо!

Snowy

Дата 12.4.2006, 21:26 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 192
Всего: 484

Вот так будет побыстрее:

Код

procedure ZeroFillDelete(FileName: string);
var
  fs: TFileStream;
  ms: TMemoryStream;
  i:  integer;
  procedure RandomBuf;
  var b:  byte;
  begin
    repeat
      b := Random(256);
      ms.Write(b, 1);
    until ms.Size = 3000000;
  end;
  procedure PatternBuf(pattern: byte);
  const patt: array[5..31] of dword = ($555555, $AAAAAA, $924924, $492492,
        $249249, 0, $111111, $222222, $333333, $444444, $555555, $666666,
        $777777, $888888, $999999, $AAAAAA, $BBBBBB, $CCCCCC, $DDDDDD,
        $EEEEEE, $FFFFFF, $924924, $492492, $249249, $6DB6DB, $B6DB6D, $DB6DB6);
  var
    d: dword;
  begin
    d := patt[pattern] shl 8;
    repeat
      ms.Write(d, 3);
    until ms.Size = 3000000;
  end;
begin
  Form1.progressbar2.Max := 35;
  Form1.progressbar1.Max := 100;
  for i := 1 to 35 do
  try
    fs := TFileStream.Create(FileName, fmOpenReadWrite);
    ms := TMemoryStream.Create;
    try
      if (i < 5) or (i > 31) then RandomBuf
      else PatternBuf(i);
      repeat
        ms.Position := 0;
        Form1.progressbar1.Position := fs.Position * 100 div fs.Size;
        Application.ProcessMessages;
        if fs.Size - fs.Position > ms.Size then fs.CopyFrom(ms, ms.Size)
        else fs.CopyFrom(ms, fs.Size - fs.Position);
      until fs.Position + 1 >= fs.Size;
      Form1.progressbar2.Position := i;
    finally
      fs.Free;
    end;
  except
    Exit;
  end;
  DeleteFile(FileName);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 f: TFileStream;
 b: byte;
begin
  Button1.Enabled := false;
  f := TFileStream.Create('d:\1.txt', fmCreate);
  f.Position := DiskFree(4) - 1; // 4 - диск D
  f.Write(b, SizeOf(b));
  f.Free;
  ZeroFillDelete('d:\1.txt');
  Button1.Enabled := true;
end;

Alexeis

Дата 13.4.2006, 09:38 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

Snowy, но этот приведет к тому что программа перестанет перерисовываться на время очистки очередной палитрой smile

кроме того я бы ускорил записью блоков порядка 2Мб - это лучше для винчестера.

--------------------

Snowy

Дата 13.4.2006, 09:57 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 192
Всего: 484

Цитата(alexeis1 @ 13.4.2006, 09:38

)

но этот приведет к тому что программа перестанет перерисовываться на время очистки очередной палитрой

Отчегож. Все отлично рисуется.

Цитата(alexeis1 @ 13.4.2006, 09:38

)

кроме того я бы ускорил записью блоков порядка 2Мб - это лучше для винчестера.

В данном примере - 3Мб.

Alexeis

Дата 13.4.2006, 10:03 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

Snowy, Невниманельность главный враг мой smile

Спасибо за разъяснения

--------------------

Yuran

Дата 14.4.2006, 11:45 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 20
Регистрация: 25.3.2006

Репутация: нет
Всего: нет

ОК спасибо!

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »