Measure/Units/CompactDB.pas

{ 压缩数据库 }

unit CompactDB;

interface

uses ComObj, Windows, SysUtils, Classes, ZhAPI, Variants, UtilMethods;

  function CompactDatabase(AFileName: string): Boolean;

implementation

// 获得临时文件名
function GetTempFileName(AExt: string): string;
var
  Ext: string;
begin
  if AExt = '' then
    Ext := '.tmp'
  else
    Ext := AExt;
  Result := GetTempFilePath + GetRandomString(6) + Ext;
  while FileExists(Result) do
  begin
    Result := GetTempFilePath + GetRandomString(6) + Ext;
  end;
end;

var
  FileList: TStringList = nil;

function FileListName: string;
begin
  Result := GetTempFilePath + 'spbkt.bak';
end;

function GetFileList: TStringList;
begin
  if FileList = nil then
  begin
    FileList := TStringList.Create;
    if FileExists(FileListName) then
      FileList.LoadFromFile(FileListName);
  end;
  Result := FileList;
end;

procedure UpdateFileList;
begin
  if FileExists(FileListName) then
    DeleteFile(FileListName);
  GetFileList.SaveToFile(FileListName);
end;

procedure AddToFileList(AFileName: string);
begin
  try
    GetFileList.Add(AFileName);
    UpdateFileList;
  except

  end;
end;

// 压缩与修复数据库,覆盖源文件
function CompactDatabase(AFileName: string): Boolean;
var
  strTempFileName: string;
  vJE: OleVariant;
const
  // 注意：此处的连接语句没有“;Persist Security Info=True”
  SConnectStr = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;User ID=%s;Password=%s';
begin
  if not FileExists(AFileName) then Exit;
  strTempFileName := GetTempFileName('');
  try
    AddToFileList(strTempFileName);
    vJE := CreateOleObject('JRO.JetEngine');
    vJE.CompactDatabase(Format(SConnectStr, [AFileName, 'Admin', '']),
        Format(SConnectStr, [strTempFileName, 'Admin', '']));
    vJE := Unassigned;
    Result := CopyFile(PChar(strTempFileName), PChar(AFileName), False);
    DeleteFile(strTempFileName);
  except
    vJE := Unassigned;
    Result := False;
  end;
end;

initialization

finalization
  FileList.Free;

end.