Copy Tabel atau Back up Tabel Pada Deplhi

Program ini berfungsi untuk mengcopi atau membackup database(Tabel) yang sudah ada sebelumnya..

Diatas  adalah contoh  Form untuk mengkopi atau membackup database(tabel) pada delphi....

Pada contoh ini saya menggunakan delphi 5..

Dan dibawah ini adalah Listing Program Form tersebut..

procedure TFBackUp.SalinFile(Sender: TObject);
var
  FileAsal, FileTujuan: File;
  BacaByte, TulisByte, TotalBaca: Integer;
  Buffer: array[1..500] of byte;
  FSize: Integer;
begin
  prbCopy.Position:=0;
  AssignFile(FileAsal, Edit1.Text);
  AssignFile(FileTujuan, Edit2.Text);
  Reset(FileAsal, 1);
  try
    Rewrite(FileTujuan, 1);
    try
      try
        try
          TotalBaca := 0;
          FSize := FileSize(FileAsal);
          repeat
            BlockRead(FileAsal, Buffer, SizeOf(Buffer), BacaByte);
            if BacaByte > 0 then
            begin
              BlockWrite(FileTujuan, Buffer, BacaByte, TulisByte);
              if BacaByte <> TulisByte then
                raise Exception.Create('Proses backup file error !!')
              else begin
                TotalBaca := TotalBaca + BacaByte;
                prbCopy.Position := Trunc(TotalBaca / Fsize) * 100;
                prbCopy.Update;
              end;
            end
          until BacaByte = 0;
        except
          Erase(FileTujuan);
          raise;
        end;
      finally
        CloseFile(FileTujuan);
      end;
    finally
      CloseFile(FileAsal);
    end;
    prbCopy.Position:=0;
    except
      Edit2.Text:=ExtractFileName(FileListBox2.Directory+'\'+DateToStr(Date())+ExtractFileName(Edit1.Text));
      showmessage('Error Penulisan, Perhatikan' +Chr(10)+'1. Nama File Asal'+Chr(10)+'2. Nama File Tujuan');
      Edit1.Text:=FileListBox1.FileName;

    end;

end;

procedure TFBackUp.DirectoryListBox1Change(Sender: TObject);
begin
FileListBox1.SetFocus;
Edit1.Text:=FileListBox1.FileName;
Edit2.Text:=ExtractFileName(FileListBox2.Directory+'\'+DateToStr(Date())+ExtractFileName(Edit1.Text));
end;

procedure TFBackUp.DirectoryListBox1DblClick(Sender: TObject);
begin
  FileListBox1.SetFocus;
  Edit1.Text:=FileListBox1.FileName;
  Edit2.Text:=ExtractFileName(FileListBox2.Directory+'\'+DateToStr(Date())+ExtractFileName(Edit1.Text));
end;

procedure TFBackUp.DirectoryListBox2DblClick(Sender: TObject);
begin
  Edit1.Text:=FileListBox1.FileName;
end;

procedure TFBackUp.DirectoryListBox2Change(Sender: TObject);
begin
  Edit2.Text:=DirectoryListBox2.Directory;
  Edit2.Text:=ExtractFileName(FileListBox2.Directory+'\'+DateToStr(Date())+ExtractFileName(Edit1.Text));

end;

procedure TFBackUp.FormActivate(Sender: TObject);
begin
Edit1.Text:=DirectoryListBox1.Directory;
  Edit2.text:=DirectoryListBox2.Directory;
  Edit2.Text:=ExtractFileName(FileListBox2.Directory+'\'+DateToStr(Date())+ExtractFileName(Edit1.Text));
end;

procedure TFBackUp.Button2Click(Sender: TObject);
var namafile:string;
begin
  namafile:=InputBox('Folder Name','Isikan Nama Folder','New Folder');
  if not CreateDir(DirectoryListBox2.Directory+'\'+namafile) then
    showMessage('Tidak Berhasil Donk')
  else
    showMessage('Hore Berhasil Donk');
  DirectoryListBox1.Refresh;
  DirectoryListBox2.Refresh;
  FileListBox1.Refresh;
  FileListBox2.Refresh;

end;
procedure TFBackUp.FormShow(Sender: TObject);
begin
DateSeparator := '_';
TimeSeparator:='_';
end;


procedure TFBackUp.FormClose(Sender: TObject; var Action: TCloseAction);
begin
DateSeparator := '/';
TimeSeparator:=':';

end;


procedure TFBackUp.Button1Click(Sender: TObject);
var
  FSearchRec: TSearchRec;
  FindResult: Integer;
  nambah:byte;

begin
FileListBox1Change(Sender);
FileListBox1.SetFocus;
FileListBox1.ItemIndex:=0;
  repeat
  FindResult := FindFirst(Edit2.Text,faAnyFile+faHidden+
                          faSysFile+faReadOnly,FSearchRec);
  if FindResult=0 then
    begin
      if FileListBox1.ItemIndex
      begin
        FileListBox1.ItemIndex:=FileListBox1.ItemIndex+1;
        Edit1.Text:=FileListBox1.FileName;
        Edit2.Text:=ExtractFileName(FileListBox2.Directory+'\'+DateToStr(Date())+ExtractFileName(Edit1.Text));
        FindClose(FSearchRec);
        SalinFile(Sender);
      end;
    end
  else
    begin
      FindClose(FSearchRec);
      SalinFile(Sender);
    end;
    until FileListBox1.ItemIndex = FileListBox1.Items.Count-1;
    if FileListBox1.ItemIndex=FileListBox1.Items.Count-1 then
    begin
      ShowMessage('Pengcopyan Selesai');
    end
    else
    begin
      ShowMessage('Pengcopyan Tidak Sempurna');
    end;

end;
procedure TFBackUp.FileListBox1Change(Sender: TObject);
begin
Edit1.Text:=FileListBox1.FileName;
end;

end.

Selamat mencoba....!!!semoga berhasil ya....