|
{*******************************************************}
{ }
{ 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周年了!感谢大家的支持与爱护!!
曾经有一段真挚的爱情摆在我的面前,我没有珍惜,现在想起来,还好我没有珍惜……
|