Compactador para database firebird
 

Hola compañeros acabo de hacer una pequeña herramienta y me gustaría compartirla, para como siempre pretendo, si es útil, pues que sea usada, en caso contrario, pues omitirla, sobre todo me gustaría si descubren como mejorarla o si veis que esta mal, lo aportarais al club, dejo el ejecutable y los fuentes, tanto en código, como en archivos (en el FTP).

Código Delphi [-]
unit Ucompactar;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DateUtils, ExtCtrls,  ShellAPI, ComCtrls;

type
  TFcompacta = class(TForm)
    OpenDialog1: TOpenDialog;
    Button1: TButton;
    Edit1: TEdit;
    Button3: TButton;
    Edit3: TEdit;
    ProgressBar1: TProgressBar;
    CheckBox1: TCheckBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Fcompacta: TFcompacta;
  cancel: Boolean;
  Fuente,Fuente2,Fuente3, Destino,Destino2,Destino3:PChar;
implementation

{$R *.dfm}

procedure TFcompacta.Button1Click(Sender: TObject);

var varscad1, Nombre:string;
    VarIcad1:Integer;
begin
   if OpenDialog1.Execute then
     begin
       Edit1.Text:=OpenDialog1.FileName;
       varscad1:=ExtractFileName(OpenDialog1.FileName);
       varicad1:=Length(ExtractFileExt(OpenDialog1.FileName));
       Destino:=PChar(ExtractFilePath(OpenDialog1.FileName)+Copy(varscad1,0,Length(varscad1)-VarIcad1)+Nombre+'SEG.FDB');
       Destino2:=PChar(ExtractFilePath(OpenDialog1.FileName)+'Gbak.exe');
       Destino3:=PChar(ExtractFilePath(OpenDialog1.FileName));
       Fuente2:=PChar(ExtractFilePath(Application.ExeName)+'Gbak.exe');
       Nombre:= StringOfChar('0',2-Length(IntToStr(DayOf(Now))))+IntToStr(DayOf(Now))+
                StringOfChar('0',2-Length(IntToStr(MonthOf(Now))))+IntToStr(MonthOf(Now))+
                StringOfChar('0',4-Length(IntToStr(YearOf(Now))))+IntToStr(YearOf(Now));
       Edit3.Text:=Copy(varscad1,0,Length(varscad1)-VarIcad1)+Nombre+'.FBK';
       Label3.Caption:=ExtractFilePath(OpenDialog1.FileName);
       Fuente:=PChar(Edit1.Text);
     end;
end;

procedure TFcompacta.Button2Click(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TFcompacta.Button3Click(Sender: TObject);
function ProgressRoutine(TotalFileSize, TotalBytesTransferred, StreamSize, StreamBytesTransferred: LARGE_INTEGER; 
                    dwStreamNumber, dwCallbackReason: DWORD; hSourceFile, hDestinationFile: THandle; lpData: Pointer): DWORD; stdcall;
//------------------------------------------------------------------------------
//  Funcion del compañero escafandra bajado de
//  http://www.delphiaccess.com/forum/tr...eso-en-delphi/
//------------------------------------------------------------------------------
var
   Value: integer;
begin
   Application.ProcessMessages();
   if(dwCallbackReason = CALLBACK_CHUNK_FINISHED) then
      Fcompacta.ProgressBar1.Position:= (int64(TotalBytesTransferred) * 100) div int64(TotalFileSize);
   Result:= PROGRESS_CONTINUE;
end;
var
  lpOperation, lpFile, lpParameters, lpDirectory: PChar;
  varbPasado:Boolean;
begin
   varbPasado:=False;
  if not FileExists(Edit3.Text) then
  with TPanel.Create(nil) do
  try
      Caption:= 'Realizando copia de seguridad, aguarde un momento por favor...';
      Font.Size:= 14;
      Font.Name:= 'Arial';
      Width:= 600;
      Height:= 70;
      Left:= (Self.ClientWidth - Width) div 2;
      Top:= (Self.ClientHeight - Height) div 2;
      BevelInner:= bvNone;
      BevelOuter:= bvNone;
      BevelWidth:= 1;
      BorderStyle:= bsSingle;
      Ctl3D:= False;
      Parent:= Self;
      lpOperation:= 'open';
      lpFile:= 'gbak.exe';
      lpParameters:= PChar('-b -v -t -user SYSDBA -password "masterkey" "'+ Edit1.Text +'" "'+label3.Caption+Edit3.text+'"');
       lpDirectory:=PChar(ExtractFilePath(Application.Name));
      ShellExecute(Handle, lpOperation, lpFile, lpParameters, lpDirectory, SW_HIDE);
      varbPasado:=true
  finally
      if varbPasado=true then ShowMessage('Proceso terminado')
                         else ShowMessage('El fichero ya existe');
      Free;
  end;             //hasta aqui ok
  varbPasado:=False;
  if (Edit3.Text<>'') and (Edit1.Text<>'') then
  begin
    if CheckBox1.Checked then  //Si deseamos hacer una copia del original
    begin
      Cancel:= false;
      Label1.Caption:='Copiando fichero';
      CopyFileEx(PWideChar(Edit1.Text), Destino, @ProgressRoutine, nil, @Cancel, 0);
      ShowMessage(SysErrorMessage(GetLastError()));
    end;
    with TPanel.Create(nil) do
    try
        cancel:=False;
        Caption:= 'Restaurando copia de seguridad, aguarde un momento por favor...';
        Font.Size:= 14;
        Font.Name:= 'Arial';
        Width:= 600;
        Height:= 70;
        Left:= (Self.ClientWidth - Width) div 2;
        Top:= (Self.ClientHeight - Height) div 2;
        BevelInner:= bvNone;
        BevelOuter:= bvNone;
        BevelWidth:= 1;
        BorderStyle:= bsSingle;
        Ctl3D:= False;
        Parent:= Self;
        lpOperation:= 'open';
        lpFile:= 'gbak.exe';
        lpParameters:= PChar('-REP -v -p 8192 -user SYSDBA -password "masterkey" "'+ (Label3.Caption+Edit3.Text)+'" "'+Edit1.Text+'"');
        lpDirectory:=PChar(ExtractFilePath(Application.Name));
        ShellExecute(Handle, lpOperation, lpFile, lpParameters, lpDirectory, SW_HIDE);
        varbPasado:=true
    finally
        if varbPasado=true then ShowMessage('Proceso terminado')
                           else ShowMessage('El fichero ya existe');
        Free;
    end;
  end;
end;

end.

y una imagen

Gracia por compartirlo ^\||/

Aclarar que no es un "compactador", sino que hace un backup y luego un restore.
Si la BD está "limpia", entonces no compactará nada.

Además hay que usarlo con cuidado, ya que has incluido un gbak de una versión que puede no ser la que esté usando el usuario... y dañarle su base de datos, o directamente, no funcionar.
Deberías de usar el gbak de la versión que tenga instalada.
Aquí pongo un enlace a un programita sencillo de backup que hice hace años, que implementa cómo usar el firebird instalado en el sistema.
Está bastante obsoleto y hecho "en un rato", pero es para que te hagas una idea.

Gracias por el aporte (Jose Luis) y por la aclaración (Casimiro)

qP:-)qP:-)

Gracias Antonio, creía que el gbak se podía usar para todas las versiones de Firebird, me refiero a que no cambiaba de versión.

Creo que entonces también debería cambiarse la DLL que lo acompaña, ya que imagino también cambiará según la versión.

De todas maneras por la pruebas que he hecho funciona bien, pero lo termine hace un ratito, así que como dices deberá manejarse con cuidado de momento.

Gracias por la aclaración maestro.

Por cierto tienes razón en cuanto a que no es propiamente dicho un compactador, pero creo que es el único sistema con el que reducir nuestra DB después de un tiempo de uso, corrígeme si estoy equivocado, por favor.

En teoría, normalmente, funcionan. Pero si alguien usa FB 3.0 y tiene una funcionalidad que no tiene los firebird anteriores y usa el gbak de una versión anterior con ese FB 3.0 entonces no funcionará.
(He dicho FB 3, pero da igual, el que sea)

Si no hay ningún problema y todo funciona bien, entonces no es necesario hacer un backup/restore. No importa que el espacio ocupado sea mayor o menor.
Es más, normalmente será más rápido insertando registros cuando ocupa más que cuando está "compactada", el motivo es que si está "compactada", cada vez que va a insertar un registro, debe solicitar más espacio al sistema (una nueva página), ampliar el fichero de la BD en disco, y luego insertar el registro.
Si la BD no está compactada y hay espacio libre, entonces inserta sin más.

gracias por las aclaraciones maestro

Antes de nada, gracias por compartir la aplicación y el código.

Sólo un par de comentarios...
En algunos casos me está dando error de que la Base de Datos está bloqueada cuando realmente no lo está. Puedo modificar l nombre desde el explorador sin problemas (cosa que me indica que no lo está).
También me pasa que si está realmente bloqueada (por delphi, por ejemplo) al cerrar el Delphi sigue diciendo que lo está.
Tal vez habría que utilizar Anchors en el form principal, ya que se se intenta hacer la ventana más pequeña se "pierden" los controles en lugar de ajustarse al nuevo tamaño.

Un saludo.

Por otro lado, me está pasando que no me coje el nombre de la copia de seguridad correcta (imagino que es el que aparece a la derecha del nombre de la Base de Datos), sino que siempre acaba llamándola nombreoriginalSEG.FDB.

Un saludo.

A mi me ha pasado al estar en uso, lo que hago es cerrarla y cargar nuevamente la base de datos

Lo tendré en cuanta Neftali, pero fue echa ala carrera y sabes que suelo dejar cosas para luego mejorarlas, es una fea costumbre, que no he logrado terminar de quitarme.

La culpa de eso es la siguiente linea

Código Delphi [-]
Destino:=PChar(ExtractFilePath(OpenDialog1.FileName)+Copy(varscad1,0,Length(varscad1)-VarIcad1)+Nombre+'SEG.FDB');

Creí que mejor no dejar opción a que cambiara el nombre, con modificar esa linea y añadir un campo para dárselo listo.

De hecho hoy lo he usado a través del Teamviewer, lo he bajado al otro ordenador y aunque esta marcado la copia de seguridad no me la hace, es extraño, pero como digo me pareció útil, para estar echa en un rato y la compartí, seguro que hay 1001 cambios y mejoras que hacerla, si la aséis y las comparten, todos aprenderemos, esa es la idea (por lo menos la mía), como siempre, partir de la base y terminar con una herramienta diseñada por miembros del club, para todos los aficionados a este gran lenguaje.