{*******************************************************}
{                                                       }
{       單元名稱: UntCompact                            }
{       創建日期: 2005-08-21                            }
{       摘要說明: ACCESS數據庫壓縮操作函數              }
{                                                       }
{       詳細說明:                                       }
{                                                       }
{       參　　閱:                                       }
{                                                       }
{       已知問題:                                       }
{                                                       }
{       待作事項:                                       }
{                                                       }
{       作　　者: 胡孟杰                                }
{       Copyright (C) 2005 FdAuto                       }
{       當前版本: 1.0                                   }
{       版本歷史:                                       }
{                                                       }
{*******************************************************}
unit UntCompact;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComObj, ActiveX;

  function GetTempPathFileName():ShortString; stdcall;
  function CreateAccessFile(FileName:String;PassWord:string=''):boolean; stdcall;
  //壓縮ACCESS數據庫
  function CompactDatabase(AFileName,APassWord:string):boolean; stdcall;

implementation

Const
  SConnectionString = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;'
                                +'Jet OLEDB:Database Password=%s;';

{==========================================================================
　函數名:    GetTempPathFileName
  功  能:    取得臨時文件名
  參　數:    無
  返回值:    臨時文件名
  作　者:    胡孟杰
  日　期:    2005.08.21
==========================================================================}
function GetTempPathFileName():ShortString;
var
  SPath,SFile:array [0..254] of char;
begin
  GetTempPath(254,SPath);
  GetTempFileName(SPath,'~SM',0,SFile);
  Result:=SFile;
  DeleteFile(Result);
end;
{==========================================================================
　函數名:    CreateAccessFile
  功  能:    建立Access文件，如果文件存在則失敗
  參　數:    FileName:String;PassWord:string='',數據庫文件名，數據庫密碼
  返回值:    true,false
  作　者:    胡孟杰
  日　期:    2005.08.21
==========================================================================}
function CreateAccessFile(FileName:String;PassWord:string=''):boolean;
var
  STempFileName:string;
  vCatalog:OleVariant;
begin
  STempFileName:=GetTempPathFileName;
  //GetTempPathFileName(PChar(STempFileName));
  try
    vCatalog:=CreateOleObject('ADOX.Catalog');
    vCatalog.Create(format(SConnectionString,[STempFileName,PassWord]));
    result:=CopyFile(PChar(STempFileName),PChar(FileName),True);
    DeleteFile(STempFileName);
  except
    result:=false;
  end;
end;
{==========================================================================
　函數名:    CompactDatabase
  功  能:    壓縮與修復數據庫,覆蓋源文件
  參　數:    AFileName,APassWord:string,數據庫文件名，數據庫密碼
  返回值:    true,false
  作　者:    胡孟杰
  日　期:    2005.08.21
==========================================================================}
function CompactDatabase(AFileName,APassWord:string):boolean;
var
  STempFileName:string;
  vJE:OleVariant;
begin
  STempFileName:=GetTempPathFileName;
  //GetTempPathFileName(PChar(STempFileName));
  try
    vJE:=CreateOleObject('JRO.JetEngine');
    vJE.CompactDatabase(format(SConnectionString,[AFileName,APassWord]),
        format(SConnectionString,[STempFileName,APassWord]));
    result:=CopyFile(PChar(STempFileName),PChar(AFileName),false);
    DeleteFile(STempFileName);
  except
    result:=false;
  end;
end;

end.