Delphi 操作ACCESS - 达人(在海水中游泳)

2007/08/28 | Delphi 操作ACCESS

类别(语言类学习笔记) | 评论(0) | 阅读(516) | 发表于 14:19

unit Access;

interface

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

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

//删除Access数据库表
procedure DropAccessTable( AccessFullName: String;      //Access数据库完整文件名
                           ATable: String               //表名
                           );

//从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表名
                            );

//从Access导出表至Access数据库 16:15:37

procedure Access2Access(AccessFromName: String;      //源Access数据库完整文件名
                        AccessToName: String;        //目的Access数据库完整文件名
                        ATable: String               //Access表名
                        );

//取得Access数据库表列表
procedure GetTableList(AccessDBName: String; var TableList: TStringList);

//判断Access数据库中是否存在表
function TableExists(AccessFullName: String;      //Access数据库完整文件名
                     ATable: String               //表名
                     ): Boolean;

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

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

implementation

//////////////////////////////////////////////////////////////////////////////////
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;Data Source=' + DBFullName);
end;
/////////////////////////////////////////////////////////////////////////////////

/////////////////////////////////////////////////////////////////////////////////
//取得Access数据库表列表
procedure GetTableList(AccessDBName: String; var TableList: TStringList);
var
AccessCont: TADOConnection;
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;Password="";'
      + 'Persist Security Info=True;Data Source=' + AccessDBName;

    AccessCont.Open;
    AccessCont.GetTableNames(TableList);
    AccessCont.Close;
finally
    AccessCont.Free;
end;
end;

/////////////////////////////////////////////////////////////////////////////////

/////////////////////////////////////////////////////////////////////////////////
//判断Access数据库中是否存在表
function TableExists(AccessFullName: String;      //Access数据库完整文件名
                     ATable: 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;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
      if TableList[i] = ATable then
      begin
        Result := True;
        Break;
      end;
    AccessCont.Close;
finally
    AccessCont.Free;
    TableList.Free;
end;
end;
/////////////////////////////////////////////////////////////////////////////////

/////////////////////////////////////////////////////////////////////////////////
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表名
                            );
var
AccessCont: TADOConnection;
sqltmp: String;
begin
AccessCont := TADOConnection.Create(nil);
try
    AccessCont.CommandTimeout := 0;
    AccessCont.Provider := 'Microsoft.Jet.OLEDB.4.0';
    AccessCont.LoginPrompt := False;
    AccessCont.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Password="";'
      + 'Persist Security Info=True;Data Source=' + AccessFullName;
   //目的表存在则删除
    if TableExists(AccessFullName, ATable) then DropAccessTable(AccessFullName, ATable);
    sqltmp := 'SELECT * INTO [' + ATable + '] FROM [' + ATable + '] IN [ODBC] [ODBC;Driver=SQL Server;'
      + 'UID=' + AUserID + ';PWD=' + APassword + ';Server=' + ASQLServer
      + ';DataBase=' + ADBName + ';]';
    AccessCont.Open;
    AccessCont.Execute(sqltmp);
finally
    AccessCont.Free;
end;
end;
/////////////////////////////////////////////////////////////////////////////////

/////////////////////////////////////////////////////////////////////////////////
procedure CreateAccessIndex( AccessFullName: String;      //Access数据库完整文件名
                             ATable: String;              //表名
                             AIndex: String;              //索引名
                             AFields: String;             //字段描述
                             IsUnique: Boolean;           //是否无重复索引
                             IsPrimary: Boolean           //是否主键
                             );
var
sqltmp: String;
AccessCont: TADOConnection;
begin
AccessCont := TADOConnection.Create(nil);
try
    AccessCont.CommandTimeout := 0;
    AccessCont.Provider := 'Microsoft.Jet.OLEDB.4.0';
    AccessCont.LoginPrompt := False;
    AccessCont.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Password="";'
      + 'Persist Security Info=True;Data Source=' + AccessFullName;

    if IsUnique then sqltmp := 'CREATE UNIQUE INDEX '
    else sqltmp := 'CREATE INDEX ';
    sqltmp := sqltmp + AIndex + ' ON [' + ATable + '](' + AFields + ')';
    if IsPrimary then sqltmp := sqltmp + ' WITH PRIMARY';

    AccessCont.Open;
    AccessCont.Execute(sqltmp);
finally
    AccessCont.Free;
end;
end;

/////////////////////////////////////////////////////////////////////////////////

/////////////////////////////////////////////////////////////////////////////////
//删除Access数据库表
procedure DropAccessTable( AccessFullName: String;      //Access数据库完整文件名
                           ATable: String               //表名
                           );
var
sqltmp: String;
AccessCont: TADOConnection;
begin
AccessCont := TADOConnection.Create(nil);
try
    AccessCont.CommandTimeout := 0;
    AccessCont.Provider := 'Microsoft.Jet.OLEDB.4.0';
    AccessCont.LoginPrompt := False;
    AccessCont.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Password="";'
      + 'Persist Security Info=True;Data Source=' + AccessFullName;

sqltmp := 'DROP TABLE [' + ATable + ']';

    AccessCont.Open;
    AccessCont.Execute(sqltmp);
finally
    AccessCont.Free;
end;
end;

/////////////////////////////////////////////////////////////////////////////////

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

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;

var
STempFileName, SConnectionString: String;
vJE: OleVariant;
begin
STempFileName := GetTempPathFileName;
SConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Password="";Data Source=%s';
try
    vJE := CreateOleObject('JRO.JetEngine');
    vJE.CompactDatabase( Format(SConnectionString,[AccessFullName]),
        Format(SConnectionString,[STempFileName]) );
    Result := CopyFile(PChar(STempFileName), PChar(AccessFullName), False);
    DeleteFile(STempFileName);
except
    Result := False;
end;
end;
/////////////////////////////////////////////////////////////////////////////////

/////////////////////////////////////////////////////////////////////////////////
//从Access导出表至Access数据库
procedure Access2Access(AccessFromName: String;      //源Access数据库完整文件名
                        AccessToName: String;        //目的Access数据库完整文件名
                        ATable: String               //Access表名
                        );
var
AccessTo: TADOConnection;
sqltmp: String;
begin
AccessTo   := TADOConnection.Create(nil);
try
    AccessTo.CommandTimeout := 0;
    AccessTo.Provider := 'Microsoft.Jet.OLEDB.4.0';
    AccessTo.LoginPrompt := False;
    AccessTo.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Password="";'
      + 'Persist Security Info=True;Data Source=' + AccessToName;

//目的表存在则删除
if TableExists(AccessToName, ATable) then DropAccessTable(AccessToName, ATable);

sqltmp := 'SELECT * INTO [' + ATable + '] FROM [' + ATable + '] IN ' + QuotedStr(AccessFromName);

    AccessTo.Open;
    AccessTo.Execute(sqltmp);
finally
    AccessTo.Free;
end;
end;
/////////////////////////////////////////////////////////////////////////////////

end.

http://wwle.5d.cn/

我有一对翅膀，不是用来飞翔，而是用来煮汤。

评论Comments