untcompact.pas

delphi7,源代码 主要的是进行DELPHI7的源代码进行管理和维护

{*******************************************************}
{                                                       }
{       单元名称: 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.