Hola
Es que estaba tratando de subir un adjunto con todo en .zip pero exede la cuota, a ver de esta forma:
file:///C:/Documents%20and%20Setting...nimientoBD.exe
Aqui está el código.
Un Form, un Opendialog, tres Botones(yo usé Xbutton) y dos Edit
Código Delphi
[-]
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, comobj, ExtCtrls, Mask, DBCtrls, dxCore, dxButton,
jpeg;
type
TForm1 = class(TForm)
Bevel53: TBevel;
Image9: TImage;
Bevel62: TBevel;
Bevel65: TBevel;
Bevel64: TBevel;
Bevel67: TBevel;
Bevel68: TBevel;
Bevel66: TBevel;
Label1: TLabel;
dxButton11: TdxButton;
dxButton14: TdxButton;
dxButton1: TdxButton;
Bevel63: TBevel;
Bevel59: TBevel;
Edit1: TEdit;
OpenDialog1: TOpenDialog;
Bevel1: TBevel;
Edit2: TEdit;
Label2: TLabel;
Bevel35: TBevel;
procedure dxButton1Click(Sender: TObject);
procedure dxButton14Click(Sender: TObject);
procedure dxButton11Click(Sender: TObject);
procedure OpenDialog1CanClose(Sender: TObject; var CanClose: Boolean);
procedure FormCreate(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.dxButton1Click(Sender: TObject);
var DBEngine : OLEVariant;
BaseDeDatos, Contra:string;
Begin
BaseDeDatos:=Edit1.Text;
Contra:=Edit2.Text;
try
DeleteFile(BaseDeDatos + '2');
DbEngine := CreateOleObject('Dao.DbEngine.35');
DbEngine.CompactDataBase(BaseDeDatos, BaseDeDatos + '2', NULL, 0, ';pwd='+Contra);
DeleteFile(BaseDeDatos);
RenameFile(BaseDeDatos + '2', BaseDeDatos);
except
try
DeleteFile(BaseDeDatos + '2');
DbEngine := CreateOleObject('Dao.DbEngine.36');
DbEngine.CompactDataBase(BaseDeDatos, BaseDeDatos + '2', NULL, 0, ';pwd='+Contra);
DeleteFile(BaseDeDatos);
RenameFile(BaseDeDatos + '2', BaseDeDatos);
except
try
DeleteFile(BaseDeDatos + '2');
DbEngine := CreateOleObject('Dao.DbEngine.120');
DbEngine.CompactDataBase(BaseDeDatos, BaseDeDatos + '2', NULL, 0, ';pwd='+Contra);
DeleteFile(BaseDeDatos);
RenameFile(BaseDeDatos + '2', BaseDeDatos);
finally
end;
end
end;
dxButton1.Enabled:=false;
end;
procedure TForm1.dxButton14Click(Sender: TObject);
begin
Form1.Close;
end;
procedure TForm1.dxButton11Click(Sender: TObject);
begin
OpenDialog1.Execute;
end;
procedure TForm1.OpenDialog1CanClose(Sender: TObject; var CanClose: Boolean);
begin
Edit1.Text:=(OpenDialog1.FileName);
dxButton1.Enabled:=true;
end;
procedure TForm1.FormCreate(Sender: TObject);
var hMenuHandle : HMENU; Sem:THandle;
begin
hMenuHandle := GetSystemMenu(Form1.Handle, FALSE);
if (hMenuHandle <> 0) then
DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND);
Sem := CreateSemaphore(nil,0,1,'MantenimientoBD.exe');
if ((Sem <> 0) and (GetLastError = ERROR_ALREADY_EXISTS)) then
begin
CloseHandle( Sem );
ShowMessage('Este programa ya se está ejecutando...');
Halt;
end;
end;
end.