搜索
bottom↓
回复: 6

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

[复制链接]

出0入0汤圆

发表于 2010-4-24 10:03:50 | 显示全部楼层 |阅读模式
{*******************************************************}
{                                                       }
{       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[0..maxFieldsCnt-1] 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,[FileName,PassWord]));
    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,[FileName,PassWord]);
    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,[AFileName,APassWord]),
                             format(SConnectionString,[STempFileName,APassWord]) );

        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,[sNew,sOld]));
        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 + '([ID] 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,[ATableName,CMDStr,AField.FieldName]);
    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,[ATableName,CMDStr,s]);
    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,[NewTableName,OldTableName]);
    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[0..maxFieldsCnt-1] 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[0..maxFieldsCnt-1] 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.

阿莫论坛20周年了!感谢大家的支持与爱护!!

一只鸟敢站在脆弱的枝条上歇脚,它依仗的不是枝条不会断,而是自己有翅膀,会飞。

出0入0汤圆

 楼主| 发表于 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

我就不重复上传了

出0入0汤圆

发表于 2010-4-24 10:18:19 | 显示全部楼层
好东西,能做个嵌入式下面的数据库就好了

出0入264汤圆

发表于 2010-4-24 15:29:30 | 显示全部楼层
学习。

出0入0汤圆

发表于 2010-4-24 17:32:17 | 显示全部楼层
Delphi不是直接支持ado吗?干嘛这样干?不懂

出0入0汤圆

 楼主| 发表于 2010-4-24 19:31:58 | 显示全部楼层
回复【2楼】spaceaky  
好东西,能做个嵌入式下面的数据库就好了
-----------------------------------------------------------------------

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


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

出0入0汤圆

发表于 2010-4-24 21:26:56 | 显示全部楼层
不错
回帖提示: 反政府言论将被立即封锁ID 在按“提交”前,请自问一下:我这样表达会给举报吗,会给自己惹麻烦吗? 另外:尽量不要使用Mark、顶等没有意义的回复。不得大量使用大字体和彩色字。【本论坛不允许直接上传手机拍摄图片,浪费大家下载带宽和论坛服务器空间,请压缩后(图片小于1兆)才上传。压缩方法可以在微信里面发给自己(不要勾选“原图),然后下载,就能得到压缩后的图片】。另外,手机版只能上传图片,要上传附件需要切换到电脑版(不需要使用电脑,手机上切换到电脑版就行,页面底部)。
您需要登录后才可以回帖 登录 | 注册

本版积分规则

手机版|Archiver|amobbs.com 阿莫电子技术论坛 ( 粤ICP备2022115958号, 版权所有:东莞阿莫电子贸易商行 创办于2004年 (公安交互式论坛备案:44190002001997 ) )

GMT+8, 2024-5-20 18:14

© Since 2004 www.amobbs.com, 原www.ourdev.cn, 原www.ouravr.com

快速回复 返回顶部 返回列表