Compactador para database firebird

[José Luis Garcí]

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 (http://terawiki.clubdelphi.com/Firebird/Herramientas/)).

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/trucos-y-consejos-16/copiar-archivos-con-copyfileex-y-barra-de-progreso-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

http://s2.subirimagenes.com/otros/previo/thump_8883683compactador.jpg (http://www.subirimagenes.com/otros-compactador-8883683.html)

[Casimiro Notevi]

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í (https://db.tt/Af7zJYgp) 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.

[ElKurgan]

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

qP:-)qP:-)

[José Luis Garcí]

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.

[José Luis Garcí]

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.

[Casimiro Notevi]

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.
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)

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.
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.

[José Luis Garcí]

gracias por las aclaraciones maestro

[Neftali [Germán.Estévez]]

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.

[Neftali [Germán.Estévez]]

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.

[José Luis Garcí]

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á.

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

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.

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.

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.

La culpa de eso es la siguiente linea

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.