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.