Cara Membuat Aplikasi TuneUp Shredder di Delphi 7

Selamat siang agan-agan.Postingan kali ini akan membahas mengenai Cara Membuat Aplikasi TuneUp Shredder di Delphi 7.Jika di komputer anda terinstall aplikasi Tune Up Utilities , tentu sudah tak asing lagi dengan Tune Up Shredder.Yaitu fitur untuk menghapus file secara permanen dan membersihkan alokasi memori di hardisk.Maksudnya !? Bila kita menghapus file secara konvensional dalam hal ini dengan menekan tombol delete , file tersebut maka akan di pindahkan ke recycle bin.Dan benar-benar hilang ketika kita menghapusnya di recycle bin.Benarkah hilang secara permanen !?

Ternyata tidak.Karena dengan bantuan software tertentu file tersebut bisa di kembalikan lagi.Bahaya dong kalau ternyata file tersebut merupakan privasi kita !? Maka dari itu, kali ini kita akan membuat aplikasi mirip TuneUp Shredder menggunakan Delphi 7 tercinta.Lalu tunggu apa lagi !? Segera buka Delphi 7 anda.Tambahkan komponen-komponen berikut ke form1.1 buah TEdit , 1 buah TOpenDialog dan 2 Buah TButton.Susun komponen tersebut sesuai gambar berikut atau tergantung selera anda

Selanjutnya.Tambahkan dua buah procedure pada program tersebut.Ketikan kode berikut setelah {$R *.dfm}

1. //procedure shredder  
2. procedure ShredderFile(FileName: string);  
3. const  
4.   Buffer       = 1024;  
5.   Counttowrite = 34;  
6.   FillBuffer: array[0..5] of Integer = ($00, $FF, $00, $F0, $0F, $00);  
7. var  
8.   arr: array[1..Buffer] of Byte;  
9.   f: file;  
10.   i, j, n: Integer;  
11. begin  
12.   AssignFile(f, FileName);  
13.   Reset(f, 1);  
14.   n := FileSize(f);  
15.   for j := 0 to Counttowrite do  
16.   begin  
17.     for i := 1 to n div Buffer do  
18.     begin  
19.       BlockWrite(f, FillBuffer[j], Buffer);  
20.     end;  
21.   end;  
22.   CloseFile(f);  
23.   RenameFile(FileName, ExtractFilepath(FileName) + '$000000.tmp');  
24.   DeleteFile(ExtractFilepath(FileName) + '$000000.tmp');  
25. end;  
26. //akhir procedure shredder  
27.   
28. //procedure shredder and delete  
29. procedure ShredderAndDeleteFile(const FileName: string);  
30. var  
31.   newname: string;  
32. begin  
33.   
34.   newname := ExtractFilepath(FileName) + '$000000.tmp';  
35.   
36.   if not RenameFile(FileName, newname) then  
37.     raise  
38.     Exception.CreateFmt('Kesalahan!', [FileName]);  
39.   
40.   ShredderFile(newname);  
41.   
42.   DeleteFile(newname);  
43. end;  

//procedure shredder
procedure ShredderFile(FileName: string);
const
  Buffer       = 1024;
  Counttowrite = 34;
  FillBuffer: array[0..5] of Integer = ($00, $FF, $00, $F0, $0F, $00);
var
  arr: array[1..Buffer] of Byte;
  f: file;
  i, j, n: Integer;
begin
  AssignFile(f, FileName);
  Reset(f, 1);
  n := FileSize(f);
  for j := 0 to Counttowrite do
  begin
    for i := 1 to n div Buffer do
    begin
      BlockWrite(f, FillBuffer[j], Buffer);
    end;
  end;
  CloseFile(f);
  RenameFile(FileName, ExtractFilepath(FileName) + '$000000.tmp');
  DeleteFile(ExtractFilepath(FileName) + '$000000.tmp');
end;
//akhir procedure shredder

//procedure shredder and delete
procedure ShredderAndDeleteFile(const FileName: string);
var
  newname: string;
begin

  newname := ExtractFilepath(FileName) + '$000000.tmp';

  if not RenameFile(FileName, newname) then
    raise
    Exception.CreateFmt('Kesalahan!', [FileName]);

  ShredderFile(newname);

  DeleteFile(newname);
end;

Okay , cukup mudah kan !? Setelah itu double klik TButton browse lalu ketikan kode berikut

1. procedure TForm1.Button1Click(Sender: TObject);  
2. begin  
3.   if OpenDialog1.Execute then  
4.     begin  
5.       Edit1.Text:=OpenDialog1.FileName;  
6.     end;  
7. end;  

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    begin
      Edit1.Text:=OpenDialog1.FileName;
    end;
end;

Lalu , double klik TButton Delete dan ketikan kode berikut

1. procedure TForm1.Button2Click(Sender: TObject);  
2. begin  
3.   if Edit1.Text<>'' then  
4.     begin  
5.       ShredderAndDeleteFile(Edit1.Text);  
6.       ShowMessage('File berhasil di hapus');  
7.       Edit1.Clear;  
8.     end;  
9. end;  

procedure TForm1.Button2Click(Sender: TObject);
begin
  if Edit1.Text<>'' then
    begin
      ShredderAndDeleteFile(Edit1.Text);
      ShowMessage('File berhasil di hapus');
      Edit1.Clear;
    end;
end;

Selesai !! Jalankan program anda.Klik TButton Browse lalu cari file yang akan di hapus.Setelah itu , klik TButton Delete.Maka file tersebut total terhapus.Silahkan cek di recycle bin , anda tidak akan menemukannya.Sekian untuk tutorial kali ini , semoga bermanfaat.