Código Delphi [-] function PackMdbFile(_Name, _pass: String; Verbose:Boolean): Boolean; var JE : TJetEngine; //requiere importar la biblioteca de tipos MS Jet & Replications Objects mdbDest,ConStrOri, ConStrDest: WideString; sizei,sizef:Real; begin sizei:=FileSizeByName(_Name)/1024; //la base de datos no se compacta sobre si misma sino creauna nueva, compactada //por lo cual definiremos como se llamará esa base de datos mdbDest:=ExtractFilePath(_name)+'\tmp~'+ExtractFileName(_Name); ConStrOri:= 'Provider=Microsoft.Jet.OLEDB.4.0;Password="";User ID=Admin;Data Source='+ _Name+';Mode=Share Deny None;Extended Properties="";Jet OLEDB:System'+ ' database="";Jet OLEDB:Registry Path="";Jet OLEDBatabase Password='+_pass+ ';Jet OLEDB:Engine Type=5;Jet OLEDBatabase Locking Mode=1;Jet OLEDB:Global'+ ' Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New '+ 'Database Password="";Jet OLEDB:Create System Database=False;Jet OLEDB:'+ 'Encrypt Database=False;Jet OLEDBon''t Copy Locale on Compact=False;Jet'+ ' OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False'; ConStrDest:= 'Provider=Microsoft.Jet.OLEDB.4.0;Password="";User ID=Admin;Data Source='+ mdbDest+';Mode=Share Deny None;Extended Properties="";Jet OLEDB:System'+ ' database="";Jet OLEDB:Registry Path="";Jet OLEDBatabase Password='+_pass+ ';Jet OLEDB:Engine Type=5;Jet OLEDBatabase Locking Mode=1;Jet OLEDB:Global'+ ' Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New '+ 'Database Password="";Jet OLEDB:Create System Database=False;Jet OLEDB:'+ 'Encrypt Database=False;Jet OLEDBon''t Copy Locale on Compact=False;Jet'+ ' OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False'; //verificamos si la base de datos destino existe, si es asi, la eliminamos if FileExists(mdbDest) then DeleteFile(mdbDest); JE:= TJetEngine.Create(Nil); try try //se comprime la base de datos original en la destino, ojo, la base de datos //original no debe estar en uso por nadie mas JE.CompactDatabase(ConStrOri, ConStrDest); sizef:=FileSizeByName(mdbDest)/1024; //eliminamos la base de datos original, o mejor, le cambiamos el nombre DeleteFile(_Name); //renombramos la nueva base de datos compactada como se llamaba la base de datos original RenameFile(mdbDest, _Name); if Verbose then ShowMessage('Hecho, mdb compactada de '+FloatToStr(sizei)+' Kb a '+FloatToStr(sizef)+' Kb'); PackMdbFile:=True; except on E:Exception do begin __Error:=('Excepcion :'+E.Message); PackMdbFile:=False; end; end; finally JE.FreeOnRelease; end; end;
function PackMdbFile(_Name, _pass: String; Verbose:Boolean): Boolean; var JE : TJetEngine; //requiere importar la biblioteca de tipos MS Jet & Replications Objects mdbDest,ConStrOri, ConStrDest: WideString; sizei,sizef:Real; begin sizei:=FileSizeByName(_Name)/1024; //la base de datos no se compacta sobre si misma sino creauna nueva, compactada //por lo cual definiremos como se llamará esa base de datos mdbDest:=ExtractFilePath(_name)+'\tmp~'+ExtractFileName(_Name); ConStrOri:= 'Provider=Microsoft.Jet.OLEDB.4.0;Password="";User ID=Admin;Data Source='+ _Name+';Mode=Share Deny None;Extended Properties="";Jet OLEDB:System'+ ' database="";Jet OLEDB:Registry Path="";Jet OLEDBatabase Password='+_pass+ ';Jet OLEDB:Engine Type=5;Jet OLEDBatabase Locking Mode=1;Jet OLEDB:Global'+ ' Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New '+ 'Database Password="";Jet OLEDB:Create System Database=False;Jet OLEDB:'+ 'Encrypt Database=False;Jet OLEDBon''t Copy Locale on Compact=False;Jet'+ ' OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False'; ConStrDest:= 'Provider=Microsoft.Jet.OLEDB.4.0;Password="";User ID=Admin;Data Source='+ mdbDest+';Mode=Share Deny None;Extended Properties="";Jet OLEDB:System'+ ' database="";Jet OLEDB:Registry Path="";Jet OLEDBatabase Password='+_pass+ ';Jet OLEDB:Engine Type=5;Jet OLEDBatabase Locking Mode=1;Jet OLEDB:Global'+ ' Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New '+ 'Database Password="";Jet OLEDB:Create System Database=False;Jet OLEDB:'+ 'Encrypt Database=False;Jet OLEDBon''t Copy Locale on Compact=False;Jet'+ ' OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False'; //verificamos si la base de datos destino existe, si es asi, la eliminamos if FileExists(mdbDest) then DeleteFile(mdbDest); JE:= TJetEngine.Create(Nil); try try //se comprime la base de datos original en la destino, ojo, la base de datos //original no debe estar en uso por nadie mas JE.CompactDatabase(ConStrOri, ConStrDest); sizef:=FileSizeByName(mdbDest)/1024; //eliminamos la base de datos original, o mejor, le cambiamos el nombre DeleteFile(_Name); //renombramos la nueva base de datos compactada como se llamaba la base de datos original RenameFile(mdbDest, _Name); if Verbose then ShowMessage('Hecho, mdb compactada de '+FloatToStr(sizei)+' Kb a '+FloatToStr(sizef)+' Kb'); PackMdbFile:=True; except on E:Exception do begin __Error:=('Excepcion :'+E.Message); PackMdbFile:=False; end; end; finally JE.FreeOnRelease; end; end;