genaccessfunc.pas

通用Access操作

unit genAccessFunc;

interface

uses
  Windows, SysUtils, Variants, Classes, Graphics, Controls, StdCtrls, ComObj,
  DB, ADODB;

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

//创建Access数据库，DBFileName为数据库文件的完整路径
//                  ForceWrite为是否强制建立
//创建成功返回True，否则返回False
function CreateAccessDB(DBFullName: string; ForceWrite: Boolean): Boolean;
function CreateAccessDBEx(DBFullName: string; ForceWrite: Boolean; PassWord: string = ''): Boolean;

function ChangeAccessPassword(AFileName, AOldPassWord, ANewPassWord: string): boolean;

//////////////////////////////////////////////////////
///////// 根据SQL语句创建表
////////////////////////////////////////////////////////
function CreateAccessTable(AccessFullName: string; //Access数据库完整文件名
  sSQL: string; //表名
  PassWord: string = ''): Boolean; overload;

function CreateAccessTable(AccessCon: TADOConnection; //Access连接
  sSQL: string //表名
  ): Boolean; overload;



//删除Access数据库表
procedure DropAccessTable(AccessFullName: string; //Access数据库完整文件名
  ATable: string; //表名
  PassWord: string = ''); overload; //Access密码

procedure DropAccessTable(AccessCon: TADOConnection; //Access连接
  ATable: string //表名
  ); overload;

//从SQL Server导出表至Access数据库
procedure SQLServer2Access(AccessFullName: string; //Access数据库完整文件名
  ASQLServer: string; //SQL Server服务器名
  AUserID: string; //SQL Server用户名
  APassword: string; //SQL Server用户口令
  ADBName: string; //SQL Server数据库名
  ATable: string; //SQL Server表名
  PassWord: string = ''); overload; //密码

procedure SQLServer2Access(ASQLConn, AAccessCon: TADOConnection; //Access连接
  ATable: string //SQL Server表名
  ); overload;

//从Access导出表至Access数据库       16:15:37
procedure Access2Access(AccessFromName: string; //源Access数据库完整文件名
  AccessToName: string; //目的Access数据库完整文件名
  ATable: string; //Access表名
  sPassWord: string = ''; //Access密码
  dPassWord: string = ''); //Access密码

//取得Access数据库表列表
procedure GetTableList(AccessDBName: string; var TableList: TStringList; PassWord: string = '');overload;
procedure GetTableList(AccessCon: TADOConnection; var TableList: TStringList);overload;

//判断Access数据库中是否存在表
function AccessTableExists(AccessFullName: string; //Access数据库完整文件名
  ATable: string; //表名
  PassWord: string = ''): Boolean; overload; //Access密码

function AccessTableExists(AccessCon: TADOConnection; //Access连接
  ATable: string //表名
  ): Boolean; overload;

function AccessColumnExists(AccessCon: TADOConnection; //Access连接
  ATable: string; //表名
  AColumn: string //列名
  ): Boolean;

//创建Access数据库表索引
procedure CreateAccessIndex(AccessFullName: string; //Access数据库完整文件名
  ATable: string; //表名
  AIndex: string; //索引名
  AFields: string; //字段描述
  IsUnique: Boolean; //是否无重复索引
  IsPrimary: Boolean; //是否主键
  PassWord: string = ''); //Access密码

//压缩与修复数据库,覆盖源文件
function CompactDatabase(AccessFullName: string; PassWord: string = ''): Boolean;

implementation

uses Dialogs, genFunc;
//////////////////////////////////////////////////////////////////////////////////

function GetTempPathFileName: string;
  //取得临时文件名
var
  SPath, SFile: array[0..254] of char;
begin
  GetTempPath(254, SPath);
  GetTempFileName(SPath, '~SM', 0, SFile);
  Result := SFile;
  DeleteFile(Result);
end;

function CreateAccessDB(DBFullName: string; ForceWrite: Boolean): Boolean;
var
  AccessDB: OleVariant;
begin
  Result := True;
  if ForceWrite and FileExists(DBFullName) then
    if not DeleteFile(DBFullName) then
    begin
      Result := False;
      Exit;
    end;
  if not ForceWrite and FileExists(DBFullName) then
  begin
    Result := False;
    Exit;
  end;
  AccessDB := CreateOleObject('ADOX.Catalog');
  AccessDB.Create('Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password="";Data Source=' + DBFullName);
end;

function CreateAccessDBEx(DBFullName: string; ForceWrite: Boolean; PassWord: string = ''): Boolean;
var
  STempFileName: string;
  vCatalog: OleVariant;
begin
  STempFileName := GetTempPathFileName;
  try
    vCatalog := CreateOleObject('ADOX.Catalog');
    vCatalog.Create(format(SConnectionString, [STempFileName, PassWord]));
    result := CopyFile(PChar(STempFileName), PChar(DBFullName), ForceWrite);
    DeleteFile(STempFileName);
  except
    result := false;
  end;
end;

function ChangeAccessPassword(AFileName, AOldPassWord, ANewPassWord: string): boolean;
var
  STempFileName: string;
  vJE: OleVariant;
begin
  STempFileName := GetTempPathFileName;
  try
    vJE := CreateOleObject('JRO.JetEngine');
    vJE.CompactDatabase(format(SConnectionString, [AFileName, AOldPassWord]),
      format(SConnectionString, [STempFileName, ANewPassWord]));
    result := CopyFile(PChar(STempFileName), PChar(AFileName), false);
    DeleteFile(STempFileName);
  except
    result := false;
  end;
end;

//////////////////////////////////////////////////////
///////// 根据SQL语句创建表
////////////////////////////////////////////////////////

function CreateAccessTable(AccessFullName: string; //Access数据库完整文件名
  sSQL: string; //表名
  PassWord: string = ''): Boolean;
var
  AccessCont: TADOConnection;
begin
  Result := True;
  try
    try
      AccessCont := TADOConnection.Create(nil);
      AccessCont.CommandTimeout := 300;
      AccessCont.Provider := 'Microsoft.Jet.OLEDB.4.0';
      AccessCont.LoginPrompt := False;
      AccessCont.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=' + PassWord + ';'
        + 'Persist Security Info=True;Data Source=' + AccessFullName;
      AccessCont.Open;
      AccessCont.Execute(sSQL);
      AccessCont.Close;
    except
      Result := False;
    end;
  finally
    AccessCont.Free;
  end;
end;

function CreateAccessTable(AccessCon: TADOConnection; //Access数据库完整文件名
  sSQL: string //表名
  ): Boolean;
begin
  try
    Result := True;
    AccessCon.Execute(sSQL);
  except
    Result := False;
  end;
end;

/////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////
//取得Access数据库表列表

procedure GetTableList(AccessDBName: string; var TableList: TStringList; PassWord: string = '');
var
  AccessCont: TADOConnection;
  i: Integer;
begin
  AccessCont := TADOConnection.Create(nil);
  try
    AccessCont.CommandTimeout := 300;
    AccessCont.Provider := 'Microsoft.Jet.OLEDB.4.0';
    AccessCont.LoginPrompt := False;
    AccessCont.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=' + PassWord + ';'
      + 'Persist Security Info=True;Data Source=' + AccessDBName;
    AccessCont.Open;
    AccessCont.GetTableNames(TableList);
    AccessCont.Close;
  finally
    AccessCont.Free;
  end;
end;

procedure GetTableList(AccessCon: TADOConnection; var TableList: TStringList);
begin
  AccessCon.GetTableNames(TableList);
end;


/////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////
//判断Access数据库中是否存在表

function AccessTableExists(AccessFullName: string; //Access数据库完整文件名
  ATable: string; //表名
  PassWord: string = ''): Boolean;
var
  TableList: TStringList;
  AccessCont: TADOConnection;
  i: Integer;
begin
  Result := False;
  AccessCont := TADOConnection.Create(nil);
  TableList := TStringList.Create;
  try
    AccessCont.CommandTimeout := 0;
    AccessCont.Provider := 'Microsoft.Jet.OLEDB.4.0';
    AccessCont.LoginPrompt := False;
    AccessCont.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=' + PassWord + ';'
      + 'Persist Security Info=True;Data Source=' + AccessFullName;
    AccessCont.Open;
    AccessCont.GetTableNames(TableList);
    //Result := TableList.IndexOfName(ATable) <> -1;
    for i := 0 to TableList.Count - 1 do
    begin
      if UpperCase(TableList[i]) = UpperCase(ATable) then
      begin
        Result := True;
        Break;
      end;
    end;
    AccessCont.Close;
  finally
    AccessCont.Free;