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;';

//創(chuàng)建Access數(shù)據(jù)庫(kù)，DBFileName為數(shù)據(jù)庫(kù)文件的完整路徑
//                  ForceWrite為是否強(qiáng)制建立
//創(chuàng)建成功返回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;

//////////////////////////////////////////////////////
///////// 根據(jù)SQL語(yǔ)句創(chuàng)建表
////////////////////////////////////////////////////////
function CreateAccessTable(AccessFullName: string; //Access數(shù)據(jù)庫(kù)完整文件名
  sSQL: string; //表名
  PassWord: string = ''): Boolean; overload;

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



//刪除Access數(shù)據(jù)庫(kù)表
procedure DropAccessTable(AccessFullName: string; //Access數(shù)據(jù)庫(kù)完整文件名
  ATable: string; //表名
  PassWord: string = ''); overload; //Access密碼

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

//從SQL Server導(dǎo)出表至Access數(shù)據(jù)庫(kù)
procedure SQLServer2Access(AccessFullName: string; //Access數(shù)據(jù)庫(kù)完整文件名
  ASQLServer: string; //SQL Server服務(wù)器名
  AUserID: string; //SQL Server用戶名
  APassword: string; //SQL Server用戶口令
  ADBName: string; //SQL Server數(shù)據(jù)庫(kù)名
  ATable: string; //SQL Server表名
  PassWord: string = ''); overload; //密碼

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

//從Access導(dǎo)出表至Access數(shù)據(jù)庫(kù)       16:15:37
procedure Access2Access(AccessFromName: string; //源Access數(shù)據(jù)庫(kù)完整文件名
  AccessToName: string; //目的Access數(shù)據(jù)庫(kù)完整文件名
  ATable: string; //Access表名
  sPassWord: string = ''; //Access密碼
  dPassWord: string = ''); //Access密碼

//取得Access數(shù)據(jù)庫(kù)表列表
procedure GetTableList(AccessDBName: string; var TableList: TStringList; PassWord: string = '');overload;
procedure GetTableList(AccessCon: TADOConnection; var TableList: TStringList);overload;

//判斷Access數(shù)據(jù)庫(kù)中是否存在表
function AccessTableExists(AccessFullName: string; //Access數(shù)據(jù)庫(kù)完整文件名
  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;

//創(chuàng)建Access數(shù)據(jù)庫(kù)表索引
procedure CreateAccessIndex(AccessFullName: string; //Access數(shù)據(jù)庫(kù)完整文件名
  ATable: string; //表名
  AIndex: string; //索引名
  AFields: string; //字段描述
  IsUnique: Boolean; //是否無(wú)重復(fù)索引
  IsPrimary: Boolean; //是否主鍵
  PassWord: string = ''); //Access密碼

//壓縮與修復(fù)數(shù)據(jù)庫(kù),覆蓋源文件
function CompactDatabase(AccessFullName: string; PassWord: string = ''): Boolean;

implementation

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

function GetTempPathFileName: string;
  //取得臨時(shí)文件名
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;

//////////////////////////////////////////////////////
///////// 根據(jù)SQL語(yǔ)句創(chuàng)建表
////////////////////////////////////////////////////////

function CreateAccessTable(AccessFullName: string; //Access數(shù)據(jù)庫(kù)完整文件名
  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數(shù)據(jù)庫(kù)完整文件名
  sSQL: string //表名
  ): Boolean;
begin
  try
    Result := True;
    AccessCon.Execute(sSQL);
  except
    Result := False;
  end;
end;

/////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////
//取得Access數(shù)據(jù)庫(kù)表列表

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數(shù)據(jù)庫(kù)中是否存在表

function AccessTableExists(AccessFullName: string; //Access數(shù)據(jù)庫(kù)完整文件名
  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;