access 压缩 (200分)

环境 D6 +ACCESS
在程序中压缩ACCESS
数据库有密码的，

你搜索一下，这里很多的呀
http://www.delphibbs.com/delphibbs/dispq.asp?lid=424637
http://www.delphibbs.com/delphibbs/dispq.asp?lid=581177
还有好多，搜索"压缩Access",就可以找到

以下代码，测试通过：
--------------------------------------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,ComObj;
type
TForm1 = class(TForm)
Button1: TButton;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
implementation
{$R *.dfm}
//压缩Access数据库
function DaoActive(var DaoObject:OleVariant):Boolean;
begin
Result:=False;
try
DaoObject:=GetActiveOleObject('DAO.DBEngine.36');
Result:=True;
except
try
DaoObject:=CreateOleObject('DAO.DBEngine.36');
Result:=True;
except
DaoObject:=Null;
end;
end;
end;

function DaoCompactDB(const FileName:string):Boolean;
var
db:OleVariant;
TempFile:string;
begin
Result:=False;
try
if not DaoActive(db) then
Exit;
try
TempFile:=ExtractFilePath(FileName)+'msaTemp.mdb';
db.CompactDatabase(FileName,TempFile);
DeleteFile(FileName);
RenameFile(TempFile,FileName);
Result:=True;
except
on E:EOleException do
ShowMessage(E.Message);
end
finally
db:=Unassigned;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if opendialog1.Execute then
begin
DaoCompactDB(opendialog1.FileName);
ShowMessage('OK');
end;
end;
end.
------------------------------------------------------
你还可以看看这片文章：
http://surpass.swpi.edu.cn/_script/show.asp?Board=delphi&Id=105&Tabname=tools

use comobj

procedure TFMMain.data_compress;
var
dao: OLEVariant;
tmp: String;
begin
if MessageDlg('真的要压缩修复数据库吗？',mtWarning,[mbYes,mbNo],0) = mrNo then
Exit;


tmp:= RepairConn.DefaultDatabase;
RepairConn.Connected:= False;
if POS('/',tmp)=0 then
begin
MessageDlg('对不起，只有Access数据库才能进行压缩操作！',mtWarning,[mbok],0);
Exit;
end;
try
dao := CreateOleObject('DAO.DBEngine.36');
except
MessageDlg('压缩失败！',mtError,[mbok],0);
Exit;
end;

try
if FileExists(tmp+'.mdb') then
dao.CompactDatabase(tmp+'.mdb',tmp+'_new.mdb')
else
Exit;
DeleteFile(tmp+'.mdb');
RenameFile(tmp+'_new.mdb',tmp+'.mdb');

RepairConn.Connected := True;
MainTable.Open ;
StatusBar.Panels[1].Text:= '数据库压缩成功！';
dao.free;
Except
StatusBar.Panels[1].Text:= '数据库压缩失败，请重试！';
end;

end;

Microsoft Jet 4.0是ADO 2.x的一部分，使用它可以实现Access数据库的压缩与修复
program AccessCompact;

// ***************************************************************************
//
// AccessCompact compacts and repairs Access 97 and Access 2000 databases.
//
// Author: David Simpson (drs@ihug.com.au), 19 Feb 2000
//
// Minor changes: Bob Wasaff (bwasaff@suscom.net), 29 Sep 00 2000
// David Simpson, 30 Sep 2000
//
// ***************************************************************************

{$APPTYPE CONSOLE}

uses
SysUtils,
ActiveX,
JRO_TLB; // 'Microsoft Jet and Replication Objects 2.5 Library' or later
// C:/Program Files/Common Files/System/ADO/msjro.dll

procedure CompactDB(const DBname, DBtype: string);
var
MyJetEngine: JetEngine;
strDataSource,
strDataDest,
strDataDestName: string;

begin
if not FileExists(DBname) then
begin
writeln('Error: ''', DBName, ''' not found.');
exit;
end;

// delete any previous temporary mdb file
strDataDestName := ExtractFilePath(DBname) + 'temp.mdb';
if FileExists(StrDataDestName) then
begin
DeleteFile(strDataDestName);
writeln('Previous temporary file ', strDataDestName, ' deleted.');
end;

strDataSource := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + DBname + ';';
strDataDest := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + strDataDestName + ';';

// default to Access 2000 format unless 97 format is specified
{ default changed 30 Sep 2000 DRS }
if DBtype = '97' then
// Use Engine Type 4 for Access 97 db
strDataDest := strDataDest + 'Jet OLEDB:Engine Type=4'
else
// Use Engine Type 5 for Access 2000 db
strDataDest := strDataDest + 'Jet OLEDB:Engine Type=5';

MyJetEngine := CoJetEngine.Create();
try
MyJetEngine.CompactDatabase(strDataSource, strDataDest);
writeln(DBname, ' compacted into ', strDataDestName + '.');
MyJetEngine := nil;
if DeleteFile(DBname) then
begin
writeln(DBname, ' deleted.');
if RenameFile(strDataDestName, DBName) then
writeln(strDataDestName, ' renamed ', DBname + '.')
else
writeln('Error: ', strDataDestName, ' could not be renamed ', DBname, '.');
end
else
writeln('Error: ', DBname, ' could not be deleted.');
except
on E: Exception do writeln('Error: ', E.Message);
end
end;

begin
if ParamCount = 0 then
begin
writeln('Error: Enter "ACCESSCOMPACT [/]?" for help.'); {Changed 29 Sep 2000 RVW}
halt;
end;
if (ParamStr(1) = '/?') or {Changed 29 Sep 2000 RVW}
(ParamStr(1) = '?') then
begin
write('AccessCompact compacts and repairs Access 97 and Access 2000 databases.');
writeln(' Compacting also rebuilds the database indexes.');
writeln;
writeln('ACCESSCOMPACT [drive:][path]filename [[/,-]97|2000]'); {Changed 29 Sep 2000 RVW}
writeln;
writeln(' [drive:][path]filename Mandatory. Specifies database to fix.');
writeln(' [97|2000] Database type of 97 or 2000. Default 2000.');
writeln;
write('This utility can be automated by using it from a command (.CMD)');
writeln(' file which is then scheduled with the AT command, or directly');
writeln(' using the NT Control Panel''s scheduler.');
end
else
begin
CoInitialize(nil);
if (ParamCount = 2) then
// default to Access 2000 format unless 97 format selected
if (Paramstr(2) = '-97') or {Changed 29 Sep 2000 RVW}
(Paramstr(2) = '/97') or
(Paramstr(2) = '97') then
CompactDB(ParamStr(1), '97')
else
CompactDB(ParamStr(1), '2000')
else
CompactDB(ParamStr(1), '2000');
end
end.

该篇文章从其他网上转贴而来，好东西大家分享吧，希望对大家有帮助

to gonghh
数据库有密码不行，有方发搞定吗？？
急用

数据库有密码没试过，你看看楼上其他兄弟的方法行不行。

CompactDatabase Method


Copies and compacts a closed database, and gives you the option of changing its version, collating order, and encryption. (Microsoft Jet workspaces only).

Syntax

DBEngine.CompactDatabase olddb, newdb, locale, options, password

The CompactDatabase method syntax has these parts.

Part Description
olddb A String that identifies an existing, closed database. It can be a full path and file name, such as "C:/db1.mdb". If the file name has an extension, you must specify it. If your network supports it, you can also specify a network path, such as "//server1/share1/dir1/db1.mdb".
newdb A String that is the file name (and path) of the compacted database that you're creating. You can also specify a network path. You can't use the newdb argument to specify the same database file as olddb.
locale Optional. A Variant that is a string expression that specifies a collating order for creating newdb, as specified in Settings. If you omit this argument, the locale of newdb is the same as olddb.
You can also create a password for newdb by concatenating the password string (starting with ";pwd=") with a constant in the locale argument, like this:
dbLangSpanish & ";pwd=NewPassword"
If you want to use the same locale as olddb (the default value), but specify a new password, simply enter a password string for locale:
";pwd=NewPassword"
options Optional. A constant or combination of constants that indicates one or more options, as specified in Settings. You can combine options by summing the corresponding constants.
password Optional. A Variant that is a string expression containing a password, if the database is password protected. The string ";pwd=" must precede the actual password. If you include a password setting in locale, this setting is ignored.



Settings

You can use one of the following constants for the locale argument to specify the CollatingOrder property for string comparisons of text.

Constant Collating order
dbLangGeneral English, German, French, Portuguese, Italian, and Modern Spanish
dbLangArabic Arabic
dbLangChineseSimplified Simplified Chinese
dbLangChineseTraditional Traditional Chinese
dbLangCyrillic Russian
dbLangCzech Czech
dbLangDutch Dutch
dbLangGreek Greek
dbLangHebrew Hebrew
dbLangHungarian Hungarian
dbLangIcelandic Icelandic
dbLangJapanese Japanese
dbLangKorean Korean
dbLangNordic Nordic languages (Microsoft Jet database engine version 1.0 only)
dbLangNorwDan Norwegian and Danish
dbLangPolish Polish
dbLangSlovenian Slovenian
dbLangSpanish Traditional Spanish
dbLangSwedFin Swedish and Finnish
dbLangThai Thai
dbLangTurkish Turkish



You can use one of the following constants in the options argument to specify whether to encrypt or to decrypt the database while it's compacted.

Constant Description
dbEncrypt Encrypt the database while compacting.
dbDecrypt Decrypt the database while compacting.



If you omit an encryption constant or if you include both dbDecrypt and dbEncrypt, newdb will have the same encryption as olddb.

You can use one of the following constants in the options argument to specify the version of the data format for the compacted database. This constant affects only the version of the data format of newdb and doesn't affect the version of any Microsoft Access-defined objects, such as forms and reports.

Constant Description
dbVersion10 Creates a database that uses the Microsoft Jet database engine version 1.0 file format while compacting.
dbVersion11 Creates a database that uses the Microsoft Jet database engine version 1.1 file format while compacting.
dbVersion20 Creates a database that uses the Microsoft Jet database engine version 2.0 file format while compacting.
dbVersion30 Creates a database that uses the Microsoft Jet database engine version 3.0 file format (compatible with version 3.5) while compacting.



You can specify only one version constant. If you omit a version constant, newdb will have the same version as olddb. You can compact newdb only to a version that is the same or later than that of olddb.

Remarks

As you change data in a database, the database file can become fragmented and use more disk space than is necessary. Periodically, you can use the CompactDatabase method to compact your database to defragment the database file. The compacted database is usually smaller and often runs faster. You can also change the collating order, the encryption, or the version of the data format while you copy and compact the database.

You must close olddb before you compact it. In a multiuser environment, other users can't have olddb open while you're compacting it. If olddb isn't closed or isn't available for exclusive use, an error occurs.

Because CompactDatabase creates a copy of the database, you must have enough disk space for both the original and the duplicate databases. The compact operation fails if there isn't enough disk space available. The newdb duplicate database doesn't have to be on the same disk as olddb. After successfully compacting a database, you can delete the olddb file and rename the compacted newdb file to the original file name.

The CompactDatabase method copies all the data and the security permission settings from the database specified by olddb to the database specified by newdb.

If you use CompactDatabase to convert a version 1.x database to version 2.5 or 3.x, only applications using version Microsoft Jet 2.5 or 3.x can open the converted database.

Note In an ODBCDirect workspace, using the CompactDatabase method doesn't return an error, but instead loads the Microsoft Jet database engine into memory.

Caution Because the CompactDatabase method doesn't convert Microsoft Access objects, you shouldn't use CompactDatabase to convert a database containing such objects. To convert a database containing Microsoft Access objects, on the Tools menu, point to Database Utilities, and then click Convert Database.

答得好全呵　

简简单单，给你一个函数

procedure CompressAccess(const FileFrom, FileTo: TFileName);
var
Dao: Variant;
begin
Dao := CreateOleObject('DAO.DBEngine.36');//access2000要用dao3.6,在access97上用35和36都可以
Dao.CompactDatabase(FileFrom, FileTo);
end;

http://www.delphibbs.com/delphibbs/dispq.asp?lid=1268352

var
dao: OLEVariant;
begin
dao := CreateOleObject('DAO.DBEngine.35');
dao.CompactDatabase('d:/yourDatabaseName.mdb',
'd:/yourNewCompactedDatabaseName.mdb');
end;

to ysai
中 SConnectionString 是什么，错误？？？
to fontain,
可不可以来一个例子
谢谢

const
SConnectionString = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;'
+'Jet OLEDBatabase Password=%s;';

多人接受答案了。

多人接受答案了