我对ACCESS数据操作,加入如下unAccessTools单元.
可是在修复数据库时总是提示"这种对象类型不支持该操作",不知何故???procedure main.ACCESS1Click(Sender: TObject);
var
sFileName: String;
begin sFileName:=ExtractFilePath(ParamStr(0))+'main.mdb';
sBar.Panels.Items[1].Text:='正在恢复数据库，请稍候．．．．．．';
Self.Enabled:=false;
Self.Cursor:=crSqlWait;
try
AdoConnection1.Close;
if DaoRepairDB(sFileName)
then sBar.Panels.Items[1].Text:='恢复数据库完毕'
else sBar.Panels.Items[1].Text:='恢复数据库失败！';
finally
Self.Enabled:=true;
Self.Cursor:=crDefault;
end;
end; {***************************************************************
* 对access数据库维护* Unit Name: unAccessTools* Purpose : Provide tools to compact and repair Access database.*****************************************************************}unit unAccessTools;interfaceuses SysUtils, Variants,ComObj,Dialogs;function DaoActive(var DaoObject:OleVariant):Boolean;function DaoCompactDB(const FileName:string):Boolean;function DaoRepairDB(const FileName:string):Boolean;implementationfunction DaoActive(var DaoObject:OleVariant):Boolean;
beginResult:=False;tryDaoObject:=GetActiveOleObject('DAO.DBEngine.36');Result:=True;excepttryDaoObject:=CreateOleObject('DAO.DBEngine.36');Result:=True;exceptDaoObject:=Null;end;end;end;//压缩Access数据库function DaoCompactDB(const FileName:string):Boolean;vardb:OleVariant;TempFile:string;beginResult:=False;tryif not DaoActive(db) thenExit;tryTempFile:=ExtractFilePath(FileName)+'msaTemp.mdb';db.CompactDatabase(FileName,TempFile);DeleteFile(FileName);RenameFile(TempFile,FileName);Result:=True;excepton E:EOleException doShowMessage(E.Message);endfinallydb:=Unassigned;end;end;//修复Access数据库
function DaoRepairDB(const FileName:string):Boolean;
var
db:OleVariant;
begin
Result:=False;
try
if not DaoActive(db) then
Exit;
try
db.RepairDatabase(FileName);
Result:=True;
except
on E:EOleException do
ShowMessage(E.Message);
end
finally
db:=Unassigned;
end;
end;end.
可是在修复数据库时总是提示"这种对象类型不支持该操作",不知何故???procedure main.ACCESS1Click(Sender: TObject);
var
sFileName: String;
begin sFileName:=ExtractFilePath(ParamStr(0))+'main.mdb';
sBar.Panels.Items[1].Text:='正在恢复数据库，请稍候．．．．．．';
Self.Enabled:=false;
Self.Cursor:=crSqlWait;
try
AdoConnection1.Close;
if DaoRepairDB(sFileName)
then sBar.Panels.Items[1].Text:='恢复数据库完毕'
else sBar.Panels.Items[1].Text:='恢复数据库失败！';
finally
Self.Enabled:=true;
Self.Cursor:=crDefault;
end;
end; {***************************************************************
* 对access数据库维护* Unit Name: unAccessTools* Purpose : Provide tools to compact and repair Access database.*****************************************************************}unit unAccessTools;interfaceuses SysUtils, Variants,ComObj,Dialogs;function DaoActive(var DaoObject:OleVariant):Boolean;function DaoCompactDB(const FileName:string):Boolean;function DaoRepairDB(const FileName:string):Boolean;implementationfunction DaoActive(var DaoObject:OleVariant):Boolean;
beginResult:=False;tryDaoObject:=GetActiveOleObject('DAO.DBEngine.36');Result:=True;excepttryDaoObject:=CreateOleObject('DAO.DBEngine.36');Result:=True;exceptDaoObject:=Null;end;end;end;//压缩Access数据库function DaoCompactDB(const FileName:string):Boolean;vardb:OleVariant;TempFile:string;beginResult:=False;tryif not DaoActive(db) thenExit;tryTempFile:=ExtractFilePath(FileName)+'msaTemp.mdb';db.CompactDatabase(FileName,TempFile);DeleteFile(FileName);RenameFile(TempFile,FileName);Result:=True;excepton E:EOleException doShowMessage(E.Message);endfinallydb:=Unassigned;end;end;//修复Access数据库
function DaoRepairDB(const FileName:string):Boolean;
var
db:OleVariant;
begin
Result:=False;
try
if not DaoActive(db) then
Exit;
try
db.RepairDatabase(FileName);
Result:=True;
except
on E:EOleException do
ShowMessage(E.Message);
end
finally
db:=Unassigned;
end;
end;end.
解决方案 »
免费领取超大流量手机卡，每月29元包185G流量+100分钟通话, 中国电信官方发货