knight_avr 发表于 2010-4-24 10:03:50

Access操作函数库 搞鼓了一晚上 终于把需要的函数整齐 有这些函数基本上自己可以做

{*******************************************************}
{                                                       }
{       Access操作函数库                              }
{                                                       }
{       版权所有 (C) 2010 Knight                        }
{                                                       }
{*******************************************************}

unit uAccess;

interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,DB,ADODB,
ComObj,ActiveX;


type
    TmyField=record
      FieldName:string;
      FieldType:string;
      FieldSize:Integer;
      Valuedef:Variant;
      Value:Variant;
      isKey:Boolean;
    end;

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

    maxFieldsCnt=100;

    //修改表的 命令定义
    acsCMD_ADDColumn      = ' ADD COLUMN ';       //增加字段
    acsCMD_AlterColumn      = ' Alter COLUMN ';   //修改字段数据类型 字段大小
    acsCMD_DropColumn       = ' DROP COLUMN';   //删除字段

    //字段类型定义
    acs_Text_t            = ' Text';            //文本
    acs_Byte_t            = ' Byte';            //整数(0~255)一个字节
    acs_Long_t            = ' Long';            //长整型 四个字节
    acs_Short_t             = ' Short';             //整型   2个字节
    acs_Single_t            = ' Single';            //单精度
    acs_Double_t            = ' Double';            //双精度
    acs_Currency_t          = ' Currency';          //货币
    acs_Char_t            = ' Char';            //字符 一个字节
    acs_Binary_t            = ' Binary';            //二进制流
    acs_Counter_t         = ' Counter';         //自动编号
    acs_Memo_t            = ' Memo';            //备注
    acs_Time_t            = ' Time';            //日期时间
    acs_Boolean_t         = ' Boolean';         //是/否
    acs_Unknown_t         = ' Unknown';         //未知


function CreateAccessDB(FileName:String;PassWord:string='';ForceCreate:boolean=false):boolean;
function GetTableList(FileName:string;var TableList:TStringList; PassWord:string='' ):Boolean;
function TableExists(FileName:string; TableName:String; PassWord:string=''):Boolean;
function CompactDB(AFileName:String; APassWord:string):boolean; //压缩、修复数据库

function AlterAccessPassword(
                const AFileName : string;
                const AOldPassword: string;
                const ANewPassword: string
                ):Boolean;

function CreateTable(
            AFileName:string;
            ATableName:string;
            APassWord:string='';
            ForceCreate:Boolean=False
            ):Boolean;

procedure DeleteTable(
            AFileName:string;
            ATableName:string;
            APassWord:string='');

function AlterTable(
            AFileName:string;
            ATableName:string;
            CMDStr:string;
            AField:TmyField;
            APassWord:string=''
            ):Boolean;

function AlterTableName(
            AFileName:string;
            OldTableName:string;
            NewTableName:string;
            APassWord:string='';
            isOnlyFields:Boolean=False):Boolean;


function GetFieldList(
            AFileName:string;
            ATableName:string;
            var myField:array of TmyField;
            APassWord:string='' ):Integer;

function FieldExists(
            AFileName:string;
            ATableName:string;
            AFieldName:string;
            APassWord:string=''):Boolean;

function AlterFieldName(
            AFileName:string;
            ATableName:string;
            OldFieldName:string;
            NewFieldName:string;
            APassWord:string=''):Boolean;



var
    myFields:array of TField;
    myFieldsCnt:Byte=0;

implementation
uses
    uFindPath,MyData;


{-------------------------------------------------------------------------------
过程名:    CreateAccessDB
说明:             创建一个空的ACCESS数据库
作者:      __knight
日期:      2010.04.23
参数:      FileName:数据库名称
             PassWord:数据库密码
             ForceCreate:如果此数据库已经存在，是否覆盖
返回值:    boolean
-------------------------------------------------------------------------------}
function CreateAccessDB(FileName:String;PassWord:string='';ForceCreate:boolean=false):boolean;
var
    AccessDB:OleVariant;
begin
    result := False;
    if (ForceCreate) and (FileExists(FileName)) then
    begin
      if not DeleteFile(FileName) then
      begin
            exit;
      end;
    end;
    if (not ForceCreate) and (FileExists(FileName)) then
    begin
      exit;
    end;
    AccessDB:=CreateOleObject('ADOX.Catalog');
    AccessDB.Create(format(sConnectionString,));
    AccessDB:= Unassigned;
    Result:=True;
end;


{-------------------------------------------------------------------------------
过程名:    GetTableList
说明:             获取数据表清单
作者:      __knight
日期:      2010.04.23
参数:      FileName:数据库名称
             TableList:输出的数据表清单
             PassWord:数据库密码
返回值:    Boolean
-------------------------------------------------------------------------------}
function GetTableList(FileName:string;var TableList:TStringList; PassWord:string='' ):Boolean;
var
    myADOCon:TADOConnection;
begin
    Result:=False;
    if not FileExists(FileName) then
    begin
      Exit;
    end;

    myADOCon:=TADOConnection.Create(nil);
    myADOCon.ConnectionString:=Format(sConnectionString,);
    try
      myADOCon.Open;
    except
      myADOCon.Close;
      FreeAndNil(myADOCon);
      Exit;
    end;
    myADOCon.GetTableNames(TableList,False);
    myADOCon.Close;
    FreeAndNil(myADOCon);

    Result:=True;
end;


{-------------------------------------------------------------------------------
过程名:    TableExists
说明:             查找数据表是否存在
作者:      __knight
日期:      2010.04.23
参数:      FileName:数据库文件
             TableName:需查找的数据表名称
             PassWord:数据库密码
返回值:    Boolean
-------------------------------------------------------------------------------}
function TableExists(FileName:string; TableName:String; PassWord:string=''):Boolean;
var
    i:Integer;
    TableList:TStringList;
begin
    Result:=False;

    TableList:=TStringList.Create;
    if not GetTableList(FileName,TableList,PassWord) then
    begin
      FreeAndNil(TableList);
      Exit;
    end;

    for i:=0 to TableList.Count-1 do
    begin
      if CompareStr(TableName,TableList)=0 then
      begin
            Result:=True;
            Break;
      end;
    end;
    FreeAndNil(TableList);
end;


{-------------------------------------------------------------------------------
过程名:    CompactDB
说明:             压缩修复数据库
作者:      __knight
日期:      2010.04.23
参数:      AFileName:数据库文件 APassWord:数据库密码
返回值:    boolean
-------------------------------------------------------------------------------}
function CompactDB(AFileName:String; APassWord:string):boolean;
var
    STempFileName:string;
    vJE:OleVariant;
begin
    Result:=False;

    if not FileExists(AFileName) then
    begin
      Exit;
    end;

    STempFileName:=TempDir + 'Temp.~mdb';
    try
      vJE:=CreateOleObject('JRO.JetEngine');
      vJE.CompactDatabase( format(SConnectionString,),
                           format(SConnectionString,) );

      result:=CopyFile(PChar(STempFileName),PChar(AFileName),false);
      DeleteFile(STempFileName);
      vJE:=Unassigned;
    except
      result:=false;
    end;
end;


{-------------------------------------------------------------------------------
过程名:    AlterAccessPassword
说明:             修改ACCESS数据库密码
作者:      __knight
日期:      2010.04.23
参数:      AFileName : 数据库文件
             AOldPassword :旧密码
             ANewPassword : 新密码
返回值:    Boolean
-------------------------------------------------------------------------------}
function AlterAccessPassword(
                const AFileName : string;
                const AOldPassword: string;
                const ANewPassword: string
                ):Boolean;
const
    SAlterDatabasePassword= 'ALTER DATABASE PASSWORD %s %s';
var
    acn   : OleVariant;
    sOld: string;
    sNew: string;
begin
    Result:=False;

    if not FileExists(AFileName) then
    begin
      Exit;
    end;

    if AOldPassword = '' then
      sOld:='Null'
    else
      sOld:='[' + AOldPassword + ']';

    if ANewPassword = '' then
      sNew:='Null'
    else
      sNew:='[' + ANewPassword + ']';

    try
      acn :=CreateOleObject('ADODB.Connection');

      //Delphi中的cmShareExclusive,ADO中的adModeShareExclusive
      //用排它方式打开,直接用数字可以不用引用ADO单元
      acn.Mode:=12;
      acn.Provider := 'Microsoft.Jet.OLEDB.4.0';
      acn.Properties('Jet OLEDB:Database Password') := AOldPassword;
      acn.Open('Data Source=' + AFileName);
      try
            acn.Execute(Format(SAlterDatabasePassword,));
      finally
            acn.Close;
            acn:=Unassigned;
      end;
      Result:=True;
    except
      Result:=False;
    end;
end;


{-------------------------------------------------------------------------------
过程名:    DeleteTable
说明:             删除表
作者:      __knight
日期:      2010.04.23
参数:      AFileName:数据库名
             ATableName:需删除的表名
             APassWord:数据库密码
返回值:    无
-------------------------------------------------------------------------------}
procedure DeleteTable(
            AFileName:string;
            ATableName:string;
            APassWord:string='');
var
    SQL:string;
    myADOCon:TADOConnection;
    myADOQue:TADOQuery;
begin
    if TableExists(AFileName,ATableName,APassWord) then
    begin
      myADOCon:=TADOConnection.Create(nil);
      if not ADOCn(myADOCon,AFileName,APassWord) then
      begin
            myADOCon.Close;
            FreeAndNil(myADOCon);
            Exit;
      end;

      myADOQue:=TADOQuery.Create(nil);
      SQL:='DROP TABLE ' + ATableName + ' ';
      ADORS(myADOCon,myADOQue,SQL,False);

      myADOQue.Close;
      myADOCon.Close;
      FreeAndNil(myADOQue);
      FreeAndNil(myADOCon);
    end;
end;


{-------------------------------------------------------------------------------
过程名:    CreateTable
说明:   创建表
作者:      __knight
日期:      2010.04.23
参数:      AFileName:数据库名
             APassWord:; ATableName:string; ForceCreate:Boolean=False
返回值:    Boolean
-------------------------------------------------------------------------------}
function CreateTable(
            AFileName:string;
            ATableName:string;
            APassWord:string='';
            ForceCreate:Boolean=False
            ):Boolean;
var
    SQL:string;
    myADOCon:TADOConnection;
    myADOQue:TADOQuery;
begin
    Result:=False;
    if not FileExists(AFileName) then
    begin
      Exit;
    end;

    if ForceCreate then
    begin
      DeleteTable(AFileName,ATableName,APassWord);
    end
    else if TableExists(AFileName,ATableName,APassWord) then
    begin
      Exit;
    end;


    myADOCon:=TADOConnection.Create(nil);
    if not ADOCn(myADOCon,AFileName,APassWord) then
    begin
      myADOCon.Close;
      FreeAndNil(myADOCon);
      Exit;
    end;
    myADOQue:=TADOQuery.Create(nil);
    SQL:='Create Table ' + ATableName + '( Counter)';

    if ADORS(myADOCon,myADOQue,SQL,False) then
    begin
      Result:=True;
    end;

    myADOQue.Close;
    myADOCon.Close;
    FreeAndNil(myADOQue);
    FreeAndNil(myADOCon);
end;


{-------------------------------------------------------------------------------
过程名:    AlterTableName
说明:          修改表名
作者:      __knight
日期:      2010.04.23
参数:      AFileName:数据库名称
             ATableName:当前表名
             CMDStr:修改表的命令
             AField:修改的字段
             APassWord:数据库密码
返回值:    Boolean
-------------------------------------------------------------------------------}
function AlterTable(
            AFileName:string;
            ATableName:string;
            CMDStr:string;
            AField:TmyField;
            APassWord:string=''
            ):Boolean;
const
    AlterTableSQL='Alter TABLE%s   %s   %s';
var
    SQL,s:string;
    myADOCon:TADOConnection;
    myADOQue:TADOQuery;
begin
    Result:=False;

    if not TableExists(AFileName,ATableName,APassWord) then
    begin
      Exit;
    end;

    myADOCon:=TADOConnection.Create(nil);
    if not ADOCn(myADOCon,AFileName,APassWord) then
    begin
      myADOCon.Close;
      FreeAndNil(myADOCon);
      Exit;
    end;

    if CMDStr=acsCMD_DropColumn then
    begin
      SQL:=Format(AlterTableSQL,);
    end
    else begin
      s:=AField.FieldName + AField.FieldType ;

      //字节数
      if AField.FieldSize > 0 then
      begin
            s:=s + '(' + IntToStr(AField.FieldSize) + ')';
      end;
      //默认值
      if (AField.Valuedef<>null) then
      begin
            s:=s + ' DEFAULT ' + VarToStr(AField.Valuedef);
      end;

      SQL:=Format(AlterTableSQL,);
    end;


    myADOQue:=TADOQuery.Create(nil);
    if ADORS(myADOCon,myADOQue,SQL,False) then
    begin
      Result:=True;
    end;

    myADOQue.Close;
    myADOCon.Close;
    FreeAndNil(myADOQue);
    FreeAndNil(myADOCon);

end;


{-------------------------------------------------------------------------------
过程名:    AlterTableName
说明:      修改表名
作者:      __knight
日期:      2010.04.23
参数:      AFileName:数据名
             OldTableName:旧数据表名
             NewTableName:新数据表名
             APassWord:数据库密码
             isOnlyFields:属否删除表中的数据
返回值:    Boolean
-------------------------------------------------------------------------------}
function AlterTableName(
            AFileName:string;
            OldTableName:string;
            NewTableName:string;
            APassWord:string='';
            isOnlyFields:Boolean=False):Boolean;
const
    CopyTableSQL='Select * into %s from %s ';
var
    SQL:string;
    myADOCon:TADOConnection;
    myADOQue:TADOQuery;
begin
    Result:=False;

    if not TableExists(AFileName,OldTableName,APassWord) then
    begin
      Exit;
    end;

    if TableExists(AFileName,NewTableName,APassWord) then
    begin
      Exit;
    end;

    myADOCon:=TADOConnection.Create(nil);
    if not ADOCn(myADOCon,AFileName,APassWord) then
    begin
      myADOCon.Close;
      FreeAndNil(myADOCon);
      Exit;
    end;

    SQL:=Format(CopyTableSQL,);
    if isOnlyFields then
    begin
      SQL:=SQL + ' where 1<>1 ';
    end
    else begin
      SQL:=SQL + ' where 1=1 ';
    end;

    myADOQue:=TADOQuery.Create(nil);
    if ADORS(myADOCon,myADOQue,SQL,False) then
    begin
      DeleteTable(AFileName,OldTableName,APassWord);
      Result:=True;
    end;
    myADOQue.Close;
    myADOCon.Close;
    FreeAndNil(myADOQue);
    FreeAndNil(myADOCon);

end;



{-------------------------------------------------------------------------------
过程名:    GetFieldList
说明:      获取字段清单
作者:      __knight
日期:      2010.04.24
参数:      AFileName:数据库
             ATableName:表名
             myField:输出字段列表
             APassWord:数据库密码
返回值:    Integer
-------------------------------------------------------------------------------}
function GetFieldList(
            AFileName:string;
            ATableName:string;
            var myField:array of TmyField;
            APassWord:string='' ):Integer;
var
    i:Integer;
    SQL:string;
    myADOCon:TADOConnection;
    myADOQue:TADOQuery;
begin
    Result:=0;

    if not TableExists(AFileName,ATableName,APassWord) then
    begin
      Exit;
    end;

    myADOCon:=TADOConnection.Create(nil);
    if not ADOCn(myADOCon,AFileName,APassWord) then
    begin
      myADOCon.Close;
      FreeAndNil(myADOCon);
      Exit;
    end;

    SQL:='select * from ' + ATableName + ' where 1<>1';
    myADOQue:=TADOQuery.Create(nil);
    if not ADORS(myADOCon,myADOQue,SQL,True) then
    begin
      myADOQue.Close;
      myADOCon.Close;
      FreeAndNil(myADOQue);
      FreeAndNil(myADOCon);
      Exit;
    end;

    for i:=0 to myADOQue.FieldCount-1 do
    begin
      myField.FieldName:=myADOQue.Fields.FieldName;

      case myADOQue.Fields.DataType of
            ftString:       myField.FieldType:=acs_Text_t;
            ftWideString:   myField.FieldType:=acs_Text_t;
            ftBytes:      myField.FieldType:=acs_Byte_t;
            ftVarBytes:   myField.FieldType:=acs_Byte_t;
            ftSmallint:   myField.FieldType:=acs_Short_t;
            ftInteger:      myField.FieldType:=acs_Long_t;
            ftLargeint:   myField.FieldType:=acs_Long_t;
            ftFloat:      myField.FieldType:=acs_Double_t;
            ftBoolean:      myField.FieldType:=acs_Boolean_t;
            ftTime:         myField.FieldType:=acs_Time_t;
            ftDateTime:   myField.FieldType:=acs_Time_t;
            ftDate:         myField.FieldType:=acs_Time_t;
            ftMemo:         myField.FieldType:=acs_Memo_t;
            ftCurrency:   myField.FieldType:=acs_Currency_t;
            ftAutoInc:      myField.FieldType:=acs_Counter_t;
            ftUnknown:      myField.FieldType:=acs_Unknown_t;
            ftTypedBinary:myField.FieldType:=acs_Binary_t;
            else
                myField.FieldType:=acs_Unknown_t;
      end;

    end;
   
    Result:=myADOQue.FieldCount;

    myADOQue.Close;
    myADOCon.Close;
    FreeAndNil(myADOQue);
    FreeAndNil(myADOCon);

end;
{-------------------------------------------------------------------------------
过程名:    FieldExists
说明:      查询字段是否存在
作者:      __knight
日期:      2010.04.23
参数:      AFileName:数据库
             ATableName:表名
             AFieldName:需查询的字段名
             APassWord:数据库密码
返回值:    Boolean
-------------------------------------------------------------------------------}
function FieldExists(
            AFileName:string;
            ATableName:string;
            AFieldName:string;
            APassWord:string=''):Boolean;
var
    myField:array of TmyField;
    i,FieldCnt:Integer;
begin
    Result:=False;

    if not TableExists(AFileName,ATableName,APassWord) then
    begin
      Exit;
    end;

    FieldCnt:=GetFieldList(AFileName,ATableName,myField,APassWord);

    if FieldCnt > 0 then
    begin
      for i:=0 to FieldCnt-1 do
      begin
            if CompareStr(AFieldName,myField.FieldName)=0 then
            begin
                Result:=True;
                Break;
            end;
      end;
    end;

end;


{-------------------------------------------------------------------------------
过程名:    AlterFieldName
说明:             修改表名
作者:      __knight
日期:      2010.04.23
参数:      AFileName:数据库
             ATableName:表名
             OldFieldName:旧字段名
             NewFieldName:新字段名
             APassWord:数据库密码
返回值:    Boolean
-------------------------------------------------------------------------------}
function AlterFieldName(
            AFileName:string;
            ATableName:string;
            OldFieldName:string;
            NewFieldName:string;
            APassWord:string=''):Boolean;
const
    tempTable='hjff78sdfjadqd3accv';
var
    SQL:string;
    myADOCon:TADOConnection;
    myADOQue:TADOQuery;
    arr_myField:array of TmyField;
    myField:TmyField;
    i,FieldCnt:Integer;
    s:string;
begin
    Result:=False;
    if not FieldExists(AFileName,ATableName,OldFieldName,APassWord) then
    begin
      Exit;
    end;

    if FieldExists(AFileName,ATableName,NewFieldName,APassWord) then
    begin
      Exit;
    end;

    myADOCon:=TADOConnection.Create(nil);
    if not ADOCn(myADOCon,AFileName,APassWord) then
    begin
      myADOCon.Close;
      FreeAndNil(myADOCon);
      Exit;
    end;

    DeleteTable(AFileName,tempTable,APassWord);

    FieldCnt:=GetFieldList(AFileName,ATableName,arr_myField,APassWord);
    s:='';
    for i:=0 to FieldCnt-1 do
    begin
      if arr_myField.FieldName = OldFieldName then
      begin
            Continue;
      end;
      s:= s + arr_myField.FieldName + ' as ' + arr_myField.FieldName + ',';
    end;
    s:=s + OldFieldName + ' as ' + NewFieldName + ' ';
    SQL:= 'select' + s + ' into ' + tempTable + ' from ' + ATableName + ' where 1=1 ';

    myADOQue:=TADOQuery.Create(nil);
    if ADORS(myADOCon,myADOQue,SQL,False) then
    begin
      DeleteTable(AFileName,ATableName,APassWord);
      if AlterTableName(AFileName,tempTable,ATableName,APassWord)then
      begin
            Result:=True;
      end;
    end;

    myADOQue.Close;
    myADOCon.Close;
    FreeAndNil(myADOQue);
    FreeAndNil(myADOCon);
end;



end.

knight_avr 发表于 2010-4-24 10:10:55

哦 还有两个 引用的 单元 uses uFindPath,MyData;
其中用到的函数见 ：
http://www.ourdev.cn/bbs/bbs_content.jsp?bbs_sn=3213998&bbs_page_no=1&search_mode=3&search_text=knight_avr&bbs_id=9999

我就不重复上传了

spaceaky 发表于 2010-4-24 10:18:19

好东西，能做个嵌入式下面的数据库就好了

mcu_lover 发表于 2010-4-24 15:29:30

学习。

kangar0065 发表于 2010-4-24 17:32:17

Delphi不是直接支持ado吗?干嘛这样干?不懂

knight_avr 发表于 2010-4-24 19:31:58

回复【2楼】spaceaky
好东西，能做个嵌入式下面的数据库就好了
-----------------------------------------------------------------------

这个只能在WinXP或Win2000（可能Win98也可以 没有试过）操作系统下支持ACCESS数据库才行的，
在嵌入式下面，如果不支持ACCESS数据库，就还需要开发编写ACCESS数据库驱动程序，估计很难做到 还不如自己写个简单的数据库


回复【4楼】kangar0065冒牌袋鼠
Delphi不是直接支持ado吗?干嘛这样干?不懂
-----------------------------------------------------------------------
我也不懂你的意思，你可能把操作ACCESS操作 和 使用ADO进行数据库查询 混淆了，其实这些函数也都是在ADO的基础上的一些应用操作而已

hisun 发表于 2010-4-24 21:26:56

不错
页: [1]
查看完整版本: Access操作函数库 搞鼓了一晚上 终于把需要的函数整齐 有这些函数基本上自己可以做