代码拉取完成,页面将自动刷新
unit UDBUpgrade;
interface
uses
Data.DB, Winapi.WinSock, Vcl.StdCtrls, System.SysUtils,
System.Classes,
Uni, UniProvider, MySQLUniProvider,
OracleUniProvider, SQLServerUniProvider
;
const
{DatabaseType Flags}
DBT_ORACLE = 1;
DBT_SQLSERVER = 2;
DBT_ACCESS = 3;
DBT_MYSQL = 4;
{Connection Text}
CT_ORACLE = 'Provider=OraOLEDB.Oracle.1;Password=%s;Persist Security Info=True;User ID=%s;Data Source=(DESCRIPTION = (ADDRESS_LIST = (ADDRESS = (PROTOCOL = TCP) (HOST = %s)(PORT = %s)))(CONNECT_DATA = (SERVICE_NAME = %s)))';
CT_SQLSERVER = 'Provider=SQLOLEDB.1;Data Source=%s;Initial Catalog=%s;User ID=%s;Password=%s;Persist Security Info=False';
CT_ACCESS = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;Persist Security Info=False;User ID=admin';
CT_MYSQL = 'DRIVER={MySQL ODBC 5.1 Driver};SERVER=%s;DATABASE=%s;USER=%s;PASSWORD=%s;PORT=%s;OPTION=3;';
{Query SQL CommandText}
QSC_TABLE_EXIST_ORACLE = 'SELECT 1 FROM USER_TABLES WHERE TABLE_NAME = UPPER(''%s'') ';
QSC_TABLE_DESCRIPTION_EXIST_ORACLE = 'SELECT 1 FROM USER_TAB_COMMENTS WHERE COMMENTS IS NOT NULL AND TABLE_NAME = UPPER(''%s'') ';
QSC_COLUMN_EXIST_ORACLE = 'SELECT 1 FROM COLS WHERE TABLE_NAME = UPPER(''%s'') AND COLUMN_NAME = UPPER(''%s'') ';
QSC_COLUMN_DESCRIPTION_EXIST_ORACLE = 'SELECT 1 FROM USER_COL_COMMENTS WHERE COMMENTS IS NOT NULL AND TABLE_NAME = UPPER(''%s'') AND COLUMN_NAME = UPPER(''%s'') ';
QSC_INDEX_EXIST_ORACLE = 'SELECT 1 FROM USER_INDEXES WHERE INDEX_NAME = ''%s''';
QSC_CONSTRAINT_EXIST_ORACLE = 'SELECT 1 FROM USER_CONSTRAINTS WHERE TABLE_NAME = ''%s'' AND CONSTRAINT_NAME = ''%s''';
QSC_TABLE_EXIST_SQLSERVER = 'SELECT TOP 1 1 FROM SYSOBJECTS WHERE ID = OBJECT_ID(''%s'') ';
QSC_TABLE_DESCRIPTION_EXIST_SQLSERVER = 'SELECT TOP 1 1 FROM SYS.EXTENDED_PROPERTIES WHERE MINOR_ID = 0 AND MAJOR_ID = OBJECT_ID(''%s'') ';
QSC_COLUMN_EXIST_SQLSERVER = 'SELECT TOP 1 1 FROM SYSCOLUMNS WHERE ID = OBJECT_ID(''%s'') AND NAME = ''%s'' ';
QSC_COLUMN_DESCRIPTION_EXIST_SQLSERVER = 'SELECT TOP 1 1 FROM SYS.EXTENDED_PROPERTIES INNER JOIN SYSCOLUMNS ON MINOR_ID = COLID AND MAJOR_ID = ID WHERE ID = OBJECT_ID(''%s'') AND SYSCOLUMNS.NAME = ''%s'' ';
//获取指定表指定列的默认值约束名称(因为Format没有转义符,所以把LIKE中的百分号当做一个参数传递)
QSC_COLUMN_DEFAULT_NAME = 'SELECT TOP 1 SO.NAME FROM SYSCOLUMNS SC INNER JOIN SYSOBJECTS SO ON SO.ID = SC.CDEFAULT '
+ ' AND SC.ID = OBJECT_ID(''%s'') AND SC.NAME = ''%s'' AND SO.NAME LIKE ''DF%s'' ';
QSC_INDEX_EXIST_SQLSERVER = 'SELECT TOP 1 1 FROM SYS.INDEXES WHERE NAME = ''%s''';
QSC_TABLE_EXIST_ACCESS = 'SELECT 1 FROM ''%s''';
QSC_COLUMN_EXIST_ACCESS = 'SELECT ''%s'' FROM ''%s''';
//information_schema.COLUMNS
QSC_TABLE_EXIST_MYSQL = 'SELECT 1 FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_SCHEMA = ''%s'' AND TABLE_NAME = ''%s'' ';
QSC_COLUMN_EXIST_MYSQL = 'SELECT 1 FROM INFORMATION_SCHEMA.COLUMNS WHERE TABLE_SCHEMA = ''%s'' AND TABLE_NAME = ''%s'' AND COLUMN_NAME = ''%s'' ';
//QSC_TABLE_DESCRIPTION_EXIST_MYSQL = 'SELECT 1 FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_SCHEMA = ''DB_COTTON_STORAGE'' AND TABLE_NAME = ''t1'' AND TABLE_COMMENT != ''''';
QSC_TABLE_DESCRIPTION_EXIST_MYSQL = 'SELECT 1 FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_SCHEMA = ''%s'' AND TABLE_NAME = ''%s'' AND TABLE_COMMENT != ''''';
//SHOW FULL COLUMNS FROM B_STORAGE1 WHERE FIELD = 'C_NAME' AND COMMENT != '';
QSC_COLUMN_DESCRIPTION_EXIST_MYSQL = 'SHOW FULL COLUMNS FROM %s WHERE FIELD = ''%s'' AND COMMENT != ''''';
{Update SQL CommandText}
USC_TABLE_DESCRIPTION_ADD_ORACLE = 'COMMENT ON TABLE %s IS ''%s'' ';
USC_COLUMN_DESCRIPTION_ADD_ORACLE = 'COMMENT ON COLUMN %s.%s IS ''%s'' ';
USC_COLUMN_ADD_ORACLE = 'ALTER TABLE %s ADD COLUMN (%s %s %s %s)';
//ALTER TABLE T1 MODIFY (C1 VARCHAR2(20) DEFAULT '1' NOT NULL);
USC_COLUMN_MODIFY_ORACLE = 'ALTER TABLE %s MODIFY (%s %s %s %s)';
USC_COLUMN_TO_PK_ORACLE = 'ALTER TABLE %s ADD CONSTRAINT %s PRIMARY KEY (%s)';
USC_INDEX_ADD_ORACLE = 'CREATE INDEX %s ON %s (%s)';
USC_CONSTRAINT_DROP_ORACLE = 'ALTER TABLE %s DROP CONSTRAINT %s CASCADE';
USC_TABLE_DESCRIPTION_ADD_SQLSERVER = 'EXEC SYS.SP_ADDEXTENDEDPROPERTY @NAME = N''MS_Description'', @VALUE = N''%s'', @LEVEL0TYPE = N''SCHEMA'', @LEVEL0NAME = N''DBO'', @LEVEL1TYPE = N''TABLE'', @LEVEL1NAME = N''%s'' ';
USC_COLUMN_DESCRIPTION_ADD_SQLSERVER = 'EXEC SYS.SP_ADDEXTENDEDPROPERTY @NAME = N''MS_Description'', @VALUE = N''%s'', @LEVEL0TYPE = N''SCHEMA'', @LEVEL0NAME = N''DBO'', @LEVEL1TYPE = N''TABLE'', @LEVEL1NAME = N''%s'', @LEVEL2TYPE = N''COLUMN'', @LEVEL2NAME = N''%s'' ';
USC_COLUMN_ADD_SQLSERVER = 'ALTER TABLE %s ADD %s %s %s %s';
USC_COLUMN_MODIFY_SQLSERVER = 'ALTER TABLE %s ALTER COLUMN %s %s %s';
USC_COLUMN_TO_PK_SQLSERVER = 'ALTER TABLE %s ADD CONSTRAINT %s PRIMARY KEY (%s)';
//删除约束
USC_CONSTRAINT_DROP_SQLSERVER = 'ALTER TABLE %s DROP CONSTRAINT %s';
//增加列的默认值
USC_COLUMN_DEFAULT_ADD_SQLSERVER = 'ALTER TABLE %s ADD CONSTRAINT %s DEFAULT %s FOR %s';
USC_INDEX_ADD_SQLSERVER = 'CREATE INDEX %s ON %s (%s)';
USC_COLUMN_ADD_ACCESS = 'ALTER TABLE %s ADD COLUMN %s %s';
USC_COLUMN_TO_PK_ACCESS = 'ALTER TABLE %s ALTER COLUMN [%s] COUNTER CONSTRAINT %s PRIMARY KEY';
USC_INDEX_ADD_ACCESS = 'CREATE INDEX %s ON %s (%s)';
USC_TABLE_DESCRIPTION_ADD_MYSQL = 'ALTER TABLE %s COMMENT ''%s''';
USC_COLUMN_ADD_MYSQL = 'ALTER TABLE %s ADD %s %s %s %s %s';
//ALTER TABLE B_STORAGE1 MODIFY COLUMN N_CODE INT(11) NULL COMMENT '测试列注释';
USC_COLUMN_MODIFY_MYSQL = 'ALTER TABLE %s MODIFY COLUMN %s %s %s %s %s';
//USC_COLUMN_MODIFY_MYSQL = 'ALTER TABLE %s CHANGE %s %s %s %s %s';
USC_COLUMN_TO_PK_MYSQL = 'ALTER TABLE %s ADD PRIMARY KEY (%s)';
USC_INDEX_ADD_MYSQL = 'ALTER TABLE %s ADD INDEX %s (%s)';
type
TPInAddr = array[0..10] of PInAddr;
PPInAddr = ^TPInAddr;
TDBUpgrade = class
private
//需要升级的数据库连接
FConnDBUpdate: TUniConnection;
//需要升级的数据库类型(必须初始化)
FDBType: Integer;
//需要升级的数据库连接串(必须初始化)
FDBUpdateConnectString: string;
//数据库名称 供MYSQL查询使用
FDBName: string;
//更新主体用的已更新日志列表对象,仅允许databaseUpdate过程使用
FQueryLogList: TUniQuery;
//查询用对象,全单元通用
FQuerySearch: TUniQuery;
//更新用对象,全单元通用
FQueryUpdate: TUniQuery;
//当前计算机名称
FComputerName: string;
//当前计算机IP
FComputerIP: string;
//当前可执行文件路径
FFilePath: string;
//版本号
FVersion: string;
//数据库是否处于连接状态
FDBConnected: Boolean;
//更新进度提示的Label控件
FLabProgressPrompt: TLabel;
//设置数据库类型
procedure setDBType(const ADBType: Integer);
//设置数据库连接串
procedure seTDBUpgradeConnectString(const AConnectString: string);
//设置数据库连接标识
procedure setDBConnected(const AConnected: Boolean);
//设置版本号
procedure setVersion(const AVersion: string);
//设置当前计算机名称
procedure setComputerName(const AComputerName: string);
//设置当前计算机IP
procedure setComputerIP(const AComputerIP: string);
//设置可执行文件路径
procedure setFilePath(const AFilePath: string);
//设置进度提示Label
procedure setLabProgressPrompt(const ALab: TLabel);
//初始化资源
procedure initResource();
//释放资源
procedure destroyResource();
//记录运行日志
procedure writeRunLog(const ALogContent: string);
//记录日志
procedure writeLog(const ALogContent, AFileName: string);
//获取当前计算机名称和IP
procedure getComputerInfo();
//写入更新记录至数据库
procedure writeUpdateLogToDB(const AUpdateFlag, AUpdateFlagAuthor: string);
//更新进度提示
procedure updateProgressPrompt(const AProgressPrompt: string);
//校验当前数据库类型是否在预定规则内
function checkDBTypeInRule(ADBType: Integer): Boolean;
//传入查询语句,返回第一列值
function getColumnValue(const ASql: string; const ADefaultValue: Variant): Variant;
{Data Verification Functions}
//判断表是否存在
function tableExist(const ATableName: string; const ASchemaName: string = ''): Boolean;
//判断列是否存在
function columnExist(const ATableName, AColumnName: string; const ASchemaName: string = ''): Boolean;
//判断表注释是否存在
function tableExistDescription(const ATableName: string; const ASchemaName: string = ''): Boolean;
//判断列注释是否存在
function columnExistDescription(const ATableName, AColumnName: string): Boolean;
//判断索引是否存在
function indexExist(const AIndexName: string): Boolean;
//校验对应标识是否需要更新
function needUpdate(const AUpdateFlag, AUpdateFlagAuthor: string): Boolean;
//判断指定约束是否存在
function checkConstraintExist(const ATableName, AConstraintName: string): Boolean;
{Command Execute Function}
//执行更新语句,返回受影响行数(没有保护) 注意:在执行改变属性语句时有可能返回-1(如SQL SERVER 执行ALTER TABLE语句,成功时返回-1)
function execUpdateCommand(const ASql: string): Integer;
//执行更新语句,返回受影响行数(出错不抛出) 注意:在执行改变属性语句时有可能返回-1(如SQL SERVER 执行ALTER TABLE语句,成功时返回-1)
function execUpdateCommandSafe(const ASql: string): Integer;
{Alter DataBase Functions}
//创建表
function createTable(const ATableName, ASql: string; const ATableDescription: string = ''): Boolean;
//增加表注释
function addTableDescription(const ATableName, ADescription: string): Boolean;
//增加列注释
function addColumnDescription(const ATableName, AColumnName, ADescription: string): Boolean;
//增加列
function addColumn(const ATableName, AColumnName, ADataType: string;
ANullFlag: string = 'NULL'; ADefault: string = ''; AComment: string = '';
const ASchemaName: string = ''): Boolean;
//增加索引
function addIndex(const ATableName, AIndexColName, AIndexName: string): Boolean;
//修改列
function alterColumn(const ATableName, AColumnName, ADataType: string; ANullFlag: string;
ADefault: string = ''; AComment: string = ''; const ASchemaName: string = ''): Boolean;
//修改列为主键
function alterColumnToPK(const ATableName, AColumnName, APKName: string; const ASchemaName: string = ''): Boolean;
//修改列的默认值 (暂时仅 SQL SERVER使用)
function alterColumnDefaultValue(const ATableName, AColumnName, ADefaultValue: string): Boolean;
//删除约束
function delConstraint(const ATableName, AConstraintName: string): Boolean;
{ Private declarations }
public
//开始数据库更新
procedure databaseUpdate();
constructor Create( AOwner: TComponent ); Virtual;
destructor Destroy; Override;
{ Public declarations }
published
property DBUpdateConnectString: string read FDBUpdateConnectString write seTDBUpgradeConnectString;
property DBType: Integer read FDBType write setDBType;
property DBConnected: Boolean read FDBConnected write setDBConnected;
property Version: string read FVersion write setVersion;
property ComputerName: string read FComputerName write setComputerName;
property ComputerIP: string read FComputerIP write setComputerIP;
property FilePath: string read FFilePath write setFilePath;
property LabProgressPrompt: TLabel read FLabProgressPrompt write setLabProgressPrompt;
end;
implementation
//--------------------------函数说明 Begin--------------------------
// Name
// split
//
// Describe
// 根据指定字符,拆分字符串
//
// Parameter
// const (Kind) Delimiter (Name) Char (Type) (Default) 拆分字符串的分隔符
// (Kind) Input (Name) string (Type) (Default) 需要拆分的字符串
// const (Kind) Strings (Name) TStrings (Type) (Default) 拆分后存放的对象
// 注意:
// 1.传入的必须为已经初始化的对象,并且在使用完后自行释放。
// 2.必须为TStringList类的实体。(不直接使用TStringList是因为TStringList默认把空格一起分割了)
//
// Result
// 无
//
// Version
// 1.0 create on 2015-02-01 12:47:01 author by Le Delphi 7
//--------------------------函数说明 End----------------------------
procedure split(const ADelimiter: Char; AInput: string; const AStrings: TStrings);
begin
if not Assigned(AStrings) then
Exit;
if AInput = '' then
Exit;
AStrings.Clear;
AStrings.Delimiter := ADelimiter;
AStrings.DelimitedText := AInput;
end;
{ TDBUpgrade }
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.initResource
//
// Describe
// 初始化资源
//
// Parameter
//
//
// Result
// 无
//
// Version
// 1.0 create on 2015-01-28 22:55:16 author by Le Delphi 7
// Version
// 1.1 Modify on 2015/10/08 11:13:51 Author by Le RAD Studio XE8
// 增加创建时判断组件是否已创建,若已创建不再重复创建,允许重复调用该函数
//--------------------------函数说明 End----------------------------
procedure TDBUpgrade.initResource;
begin
if not Assigned(FConnDBUpdate) then
FConnDBUpdate := TUniConnection.Create(nil);
FConnDBUpdate.ConnectString := FDBUpdateConnectString;
FDBName := FConnDBUpdate.Database;
if not Assigned(FQueryLogList) then
FQueryLogList := TUniQuery.Create(nil);
if not Assigned(FQuerySearch) then
FQuerySearch := TUniQuery.Create(nil);
if not Assigned(FQueryUpdate) then
FQueryUpdate := TUniQuery.Create(nil);
FQueryLogList.Connection := FConnDBUpdate;
FQuerySearch.Connection := FConnDBUpdate;
FQueryUpdate.Connection := FConnDBUpdate;
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.destroyResource
//
// Describe
// 关闭资源
//
// Parameter
//
//
// Result
// 无
//
// Version
// 1.0 create on 2015-01-28 22:55:29 author by Le Delphi 7
//--------------------------函数说明 End----------------------------
procedure TDBUpgrade.destroyResource;
begin
if Assigned(FQueryUpdate) then
FreeAndNil(FQueryUpdate);
if Assigned(FQuerySearch) then
FreeAndNil(FQuerySearch);
if Assigned(FQueryLogList) then
FreeAndNil(FQueryLogList);
if Assigned(FConnDBUpdate) then
FreeAndNil(FConnDBUpdate);
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.seTDBUpgradeConnectString
//
// Describe
// 设置数据库连接串
//
// Parameter
// const (Kind) AConnectString (Name) string (Type) (Default)
//
// Result
// 无
//
// Version
// 1.0 create on 2015-01-28 23:57:14 author by Le Delphi 7
//--------------------------函数说明 End----------------------------
procedure TDBUpgrade.seTDBUpgradeConnectString(
const AConnectString: string);
begin
if Trim(AConnectString) <> '' then
FDBUpdateConnectString := AConnectString;
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.setDBType
//
// Describe
// 设置数据库类型
//
// Parameter
// const (Kind) ADBType (Name) Integer (Type) (Default)
//
// Result
// 无
//
// Version
// 1.0 create on 2015-01-24 22:31:02 author by Le Delphi 7
//--------------------------函数说明 End----------------------------
procedure TDBUpgrade.setDBType(const ADBType: Integer);
begin
//只有参数在符合预定范围内才改变
if checkDBTypeInRule(ADBType) then
FDBType := ADBType
else
writeRunLog('TDBUpgrade.setDBType 数据库类型不在预定范围内,设置数据库类型失败');
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.checkDBTypeInRule
//
// Describe
// 校验当前数据库类型是否在预定规则内
//
// Parameter
// const (Kind) ADBType (Name) Integer (Type) (Default) 数据库类型
//
// Result
// Boolean
// True: 在规则内
// False: 不在规则内
//
// Version
// 1.0 create on 2015-01-25 00:43:07 author by Le Delphi 7
//--------------------------函数说明 End----------------------------
function TDBUpgrade.checkDBTypeInRule(ADBType: Integer): Boolean;
begin
Result := False;
case ADBType of
DBT_ORACLE:
Result := True;
DBT_SQLSERVER:
Result := True;
DBT_ACCESS:
Result := True;
DBT_MYSQL:
Result := True;
end;
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.writeLog
//
// Describe
// 记录日志
//
// Parameter
// const (Kind) ALogContent (Name) string (Type) (Default) 日志内容
// const (Kind) AFileName (Name) string (Type) (Default) 日志文件全路径+文件名
//
// Result
// 无
//
// Version
// 1.0 create on 2015-01-25 18:22:24 author by Le Delphi 7
//--------------------------函数说明 End----------------------------
procedure TDBUpgrade.writeLog(const ALogContent, AFileName: string);
var
logFileObj: TextFile;
//打开日志文件
function TextFileOpen(): Boolean;
begin
Result := False;
try
AssignFile(logFileObj, AFileName);
if not FileExists(AFileName) then
begin
Rewrite(logFileObj);
Append(logFileObj);
Writeln(logFileObj, '//*********************************************************************************//');
Writeln(logFileObj, '// DatabaseUpdateLog Version:' + FVersion + ' ' + FormatDateTime('yyyy-MM-dd HH:nn:ss', Now) + ' //');
Writeln(logFileObj, '//*********************************************************************************//');
end
else
Append(logFileObj);
Result := True;
except
end;
end;
//关闭日志文件
procedure TextFileClose();
begin
try
Flush(logFileObj);
CloseFile(logFileObj);
except
end;
end;
begin
//参数不正确直接退出
if (Trim(ALogContent) = '') or (Trim(AFileName) = '') then
Exit;
try
//打开不成功则退出
if not TextFileOpen then
Exit;
Writeln(logFileObj, '//---------------------------------------------------------------------------------//');
Writeln(logFileObj, FormatDateTime('yyyy-MM-dd HH:nn:ss:zzz', Now) + ' Version:' + FVersion);
Writeln(logFileObj, ALogContent);
Writeln(logFileObj, '');
finally
TextFileClose;
end;
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.writeRunLog
//
// Describe
// 记录运行日志
//
// Parameter
// const (Kind) ALogContent (Name) string (Type) (Default) 日志内容
//
// Result
// 无
//
// Version
// 1.0 create on 2015-01-25 18:25:10 author by Le Delphi 7
//--------------------------函数说明 End----------------------------
procedure TDBUpgrade.writeRunLog(const ALogContent: string);
begin
writeLog(ALogContent, FFilePath + 'DatabaseUpdateLog.log');
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.setVersion
//
// Describe
// 设置版本号
//
// Parameter
// const (Kind) AVersion (Name) string (Type) (Default)
//
// Result
// 无
//
// Version
// 1.0 create on 2015-01-25 18:12:17 author by Le Delphi 7
//--------------------------函数说明 End----------------------------
procedure TDBUpgrade.setVersion(const AVersion: string);
begin
FVersion := AVersion;
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.getComputerInfo
//
// Describe
// 初始化当前计算机名称及IP变量值
//
// Parameter
//
//
// Result
// 无
//
// Version
// 1.0 create on 2015-01-25 20:30:08 author by Le Delphi 7
//--------------------------函数说明 End----------------------------
procedure TDBUpgrade.getComputerInfo;
var
uPHost: PHostEnt;
uBuffer: array[0..63] of AnsiChar;
pstr: PPInAddr;
i: integer;
uData: TWSADATA;
begin
try
WSAStartup($101, uData);
GetHostName(uBuffer, SizeOf(uBuffer));
uPHost := GetHostByName(uBuffer);
if uPHost = nil then
Exit;
setComputerName(uPHost^.h_name); //获得本机的计算机名称
pstr := PPInAddr(uPHost^.h_addr_list);
I := 0;
while pstr^[i] <> nil do
begin
setComputerIP(StrPas(inet_ntoa(pstr^[i]^))); //获得本机的IP地址
Inc(i);
end;
WSACleanup;
except
end;
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.setComputerName
//
// Describe
// 设置当前计算机名称变量值
//
// Parameter
// const (Kind) AComputerName (Name) string (Type) (Default) 计算机名称
//
// Result
// 无
//
// Version
// 1.0 create on 2015-01-25 20:20:15 author by Le Delphi 7
//--------------------------函数说明 End----------------------------
procedure TDBUpgrade.setComputerName(const AComputerName: string);
begin
if Trim(AComputerName) <> '' then
FComputerName := AComputerName;
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.setComputerIP
//
// Describe
// 设置当前计算机IP变量值
//
// Parameter
// const (Kind) AComputerIP (Name) string (Type) (Default) 计算机IP
//
// Result
// 无
//
// Version
// 1.0 create on 2015-01-25 20:21:00 author by Le Delphi 7
//--------------------------函数说明 End----------------------------
procedure TDBUpgrade.setComputerIP(const AComputerIP: string);
begin
if Trim(AComputerIP) <> '' then
FComputerIP := AComputerIP;
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.setDBConnected
//
// Describe
// 设置数据库连接标识
//
// Parameter
// const (Kind) AConnected (Name) Boolean (Type) (Default) 数据库是否连接标识
//
// Result
// 无
//
// Version
// 1.0 create on 2015-01-24 22:34:54 author by Le Delphi 7
//--------------------------函数说明 End----------------------------
procedure TDBUpgrade.setDBConnected(const AConnected: Boolean);
begin
FDBConnected := AConnected;
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.setFilePath
//
// Describe
// 设置可执行文件路径
//
// Parameter
// const (Kind) AFilePath (Name) string (Type) (Default) 默认文件路径
//
// Result
// 无
//
// Version
// 1.0 create on 2015-01-25 21:02:18 author by Le Delphi 7
//--------------------------函数说明 End----------------------------
procedure TDBUpgrade.setFilePath(const AFilePath: string);
begin
if Trim(AFilePath) <> '' then
FFilePath := AFilePath;
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.setLabProgressPrompt
//
// Describe
// 设置进度提示Label对象
//
// Parameter
// const (Kind) ALab (Name) TLabel (Type) (Default) 需要显示进度的Label提示框对象
//
// Result
// 无
//
// Version
// 1.0 create on 2015-01-31 09:04:30 author by Le Delphi 7
//--------------------------函数说明 End----------------------------
procedure TDBUpgrade.setLabProgressPrompt(const ALab: TLabel);
begin
if Assigned(ALab) then
FLabProgressPrompt := ALab;
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.updateProgressPrompt
//
// Describe
// 更新进度提示
//
// Parameter
// const (Kind) ProgressPrompt (Name) string (Type) (Default) 进度提示文本
//
// Result
// 无
//
// Version
// 1.0 create on 2015-01-31 09:36:37 author by Le Delphi 7
//--------------------------函数说明 End----------------------------
procedure TDBUpgrade.updateProgressPrompt(const AProgressPrompt: string);
begin
if not Assigned(FLabProgressPrompt) then
Exit;
if Trim(AProgressPrompt) <> '' then
FLabProgressPrompt.Caption := AProgressPrompt;
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.tableExist
//
// Describe
// 校验指定表是否存在
//
// Parameter
// const (Kind) ATableName (Name) string (Type) (Default) 表名称
// const (Kind) ASchemaName (Name) string (Type) (Default) 所在数据库名称
//
// Result
// Boolean
// True: 存在
// False: 不存在
//
// Version
// 1.0 create on 2015-01-25 00:49:11 author by Le Delphi 7
// 1.1 Modify on 2015/09/24 14:01:34 Author by Le RAD Studio XE8
// 增加ASchemaName参数,用于支持MYSQL的查询
//--------------------------函数说明 End----------------------------
function TDBUpgrade.tableExist(const ATableName: string; const ASchemaName: string = ''): Boolean;
begin
Result := False;
//1.数据库没有连接直接退出
if not FDBConnected then
begin
writeRunLog('TDBUpgrade.tableExist 数据库未连接,判断失败');
Exit;
end;
//2.数据库类型不在预定规则内直接退出
if not checkDBTypeInRule(FDBType) then
begin
writeRunLog('TDBUpgrade.tableExist 当前数据库类型不在预定规则内,判断失败');
Exit;
end;
//3.参数不正确直接退出
if Trim(ATableName) = '' then
begin
writeRunLog('TDBUpgrade.tableExist 参数“TableName”值为空,判断失败');
Exit;
end;
//ACCESS数据库特殊,无法通过系统对象判断,直接查询表,出错代表不存在
if FDBType = DBT_ACCESS then
begin
try
FQuerySearch.Close;
FQuerySearch.SQL.Clear;
FQuerySearch.SQL.Text := Format(QSC_TABLE_EXIST_ACCESS, [ATableName]);
FQuerySearch.Open;
Result := True;
except
end;
end
else
begin
FQuerySearch.Close;
FQuerySearch.SQL.Clear;
case FDBType of
DBT_ORACLE:
FQuerySearch.SQL.Text := Format(QSC_TABLE_EXIST_ORACLE, [ATableName]);
DBT_SQLSERVER:
FQuerySearch.SQL.Text := Format(QSC_TABLE_EXIST_SQLSERVER, [ATableName]);
DBT_MYSQL:
FQuerySearch.SQL.Text := Format(QSC_TABLE_EXIST_MYSQL, [ASchemaName, ATableName]);
end;
FQuerySearch.Open;
if not FQuerySearch.IsEmpty then
Result := True;
end;
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.columnExist
//
// Describe
// 校验指定列是否存在
//
// Parameter
// const (Kind) ATableName (Name) string (Type) (Default) 表名
// const (Kind) AColumnName (Name) string (Type) (Default) 列名,多个用英文逗号,分割(有一列不存在则返回False)
// const (Kind) ASchemaName (Name) string (Type) (Default) 所在数据库名称
//
// Result
// Boolean
// True: 存在
// False: 不存在(传入多列时,有一列不存在则返回False)
//
// Version
// 1.0 create on 2015-01-25 00:52:24 author by Le Delphi 7
// 1.1 Modify on 2015/09/24 14:01:34 Author by Le RAD Studio XE8
// 增加ASchemaName参数,用于支持MYSQL的查询
//--------------------------函数说明 End----------------------------
function TDBUpgrade.columnExist(const ATableName,
AColumnName: string; const ASchemaName: string = ''): Boolean;
var
i: Integer;
columnNames: TStringList;
begin
Result := False;
//1.数据库没有连接直接退出
if not FDBConnected then
begin
writeRunLog('TDBUpgrade.columnExist 数据库未连接,判断失败');
Exit;
end;
//2.数据库类型不在预定规则内直接退出
if not checkDBTypeInRule(FDBType) then
begin
writeRunLog('TDBUpgrade.columnExist 当前数据库类型不在预定规则内,判断失败');
Exit;
end;
//3.参数不正确直接退出
if (Trim(ATableName) = '') or (Trim(AColumnName) = '') then
begin
writeRunLog('TDBUpgrade.columnExist 参数“TableName”、“columnName”值至少一个为空,判断失败');
Exit;
end;
//拆分字符串,兼容多字段一起判断
try
columnNames := TStringList.Create;
split(',', AColumnName, columnNames);
for i := 0 to columnNames.Count - 1 do
begin
//ACCESS数据库特殊,无法通过系统对象判断,直接查询表,出错代表不存在
if FDBType = DBT_ACCESS then
begin
try
FQuerySearch.Close;
FQuerySearch.SQL.Clear;
FQuerySearch.SQL.Text := Format(QSC_COLUMN_EXIST_ACCESS, [columnNames[i], ATableName]);
FQuerySearch.Open;
except
//出错直接退出,返回False
Exit;
end;
end
else
begin
FQuerySearch.Close;
FQuerySearch.SQL.Clear;
case FDBType of
DBT_ORACLE:
FQuerySearch.SQL.Text := Format(QSC_COLUMN_EXIST_ORACLE, [ATableName, columnNames[i]]);
DBT_SQLSERVER:
FQuerySearch.SQL.Text := Format(QSC_COLUMN_EXIST_SQLSERVER, [ATableName, columnNames[i]]);
DBT_MYSQL:
FQuerySearch.SQL.Text := Format(QSC_COLUMN_EXIST_MYSQL, [ASchemaName, ATableName, columnNames[i]]);
end;
FQuerySearch.Open;
//不存在直接退出,返回False
if FQuerySearch.IsEmpty then
Exit;
end;
end;
//执行完毕代表列存在,返回True
Result := True;
finally
if Assigned(columnNames) then
FreeAndNil(columnNames);
end;
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.indexExist
//
// Describe
// 校验索引是否存在
//
// Parameter
// const (Kind) AIndexName (Name) string (Type) (Default) 索引名称
//
// Result
// Boolean
//
// Version
// 1.0 create on 2015-01-29 23:23:33 author by Le Delphi 7
//--------------------------函数说明 End----------------------------
function TDBUpgrade.indexExist(const AIndexName: string): Boolean;
begin
Result := False;
//1.数据库没有连接直接退出
if not FDBConnected then
begin
writeRunLog('TDBUpgrade.indexExist 数据库未连接,判断失败');
Exit;
end;
//2.数据库类型不在预定规则内直接退出
if not checkDBTypeInRule(FDBType) then
begin
writeRunLog('TDBUpgrade.indexExist 当前数据库类型不在预定规则内,判断失败');
Exit;
end;
//3.参数不正确直接退出
if Trim(AIndexName) = '' then
begin
writeRunLog('TDBUpgrade.indexExist 参数AIndexName值为空,判断失败');
Exit;
end;
//ACCESS和MYSQL暂时不处理
if (FDBType = DBT_ACCESS) or (FDBType = DBT_MYSQL) then
begin
try
Exit;
except
end;
end
else
begin
FQuerySearch.Close;
FQuerySearch.SQL.Clear;
case FDBType of
DBT_ORACLE:
FQuerySearch.SQL.Text := Format(QSC_INDEX_EXIST_ORACLE, [AIndexName]);
DBT_SQLSERVER:
FQuerySearch.SQL.Text := Format(QSC_INDEX_EXIST_SQLSERVER, [AIndexName]);
end;
FQuerySearch.Open;
if not FQuerySearch.IsEmpty then
Result := True;
end;
end;
//--------------------------工程说明 Begin--------------------------
// Name
// TDBUpgrade.checkConstraintExist
//
// Describe
// 判断指定约束是否存在
//
// Parameter
// const (Kind) ATableName (Name) string (Type) (Default) 表名
// const (Kind) AConstraintName (Name) string (Type) (Default) 约束名称
//
// Result
// Boolean
//
// Version
// 1.0 create on 2015/09/23 18:18:16 author by Le RAD Studio XE8
//--------------------------工程说明 End----------------------------
function TDBUpgrade.checkConstraintExist(const ATableName,
AConstraintName: string): Boolean;
begin
Result := False;
//1.数据库没有连接直接退出
if not FDBConnected then
begin
writeRunLog('TDBUpgrade.checkConstraintExist 数据库未连接,判断失败');
Exit;
end;
//2.数据库类型不在预定规则内直接退出
if not checkDBTypeInRule(FDBType) then
begin
writeRunLog('TDBUpgrade.checkConstraintExist 当前数据库类型不在预定规则内,判断失败');
Exit;
end;
//3.参数不正确直接退出
if (Trim(ATableName) = '') or (Trim(AConstraintName) = '') then
begin
writeRunLog('TDBUpgrade.checkConstraintExist 参数ATableName与AConstraintName至少一个为空,判断失败');
Exit;
end;
//ACCESS和MYSQL还有SQL SERVER暂时不处理
if (FDBType = DBT_ACCESS) or (FDBType = DBT_MYSQL) or (DBT_SQLSERVER = FDBType) then
begin
try
Exit;
except
end;
end
else
begin
FQuerySearch.Close;
FQuerySearch.SQL.Clear;
case FDBType of
DBT_ORACLE:
FQuerySearch.SQL.Text := Format(QSC_CONSTRAINT_EXIST_ORACLE, [ATableName, AConstraintName]);
end;
FQuerySearch.Open;
if not FQuerySearch.IsEmpty then
Result := True;
end;
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.createTable
//
// Describe
// 创建表
//
// Parameter
// const (Kind) ATableName (Name) string (Type) (Default) 表名
// const (Kind) ASql (Name) string (Type) (Default) 建表语句
// const (Kind) ATableDescription (Name) string (Type) '' (Default) 表注释,可为空
//
// Result
// Boolean
// True: 创建成功
// False: 创建失败
//
// Version
// 1.0 create on 2015-01-25 17:43:23 author by Le Delphi 7
//--------------------------函数说明 End----------------------------
function TDBUpgrade.createTable(const ATableName, ASql: string; const ATableDescription: string = ''): Boolean;
begin
Result := False;
//1.数据库未连接直接退出
if not FDBConnected then
begin
writeRunLog('TDBUpgrade.createTable 数据库未连接,建表失败');
Exit;
end;
//2.数据库类型不在预定规则内直接退出
if not checkDBTypeInRule(FDBType) then
begin
writeRunLog('TDBUpgrade.createTable 当前数据库类型不在预定规则内,建表失败');
Exit;
end;
//如果表已存在则退出
if tableExist(ATableName, FDBName) then
begin
writeRunLog('TDBUpgrade.createTable 表' + ATableName + '已存在,请删除后创建');
Exit;
end;
//创建表
if execUpdateCommandSafe(ASql) <> -9 then
writeRunLog('TDBUpgrade.createTable 表' + ATableName + '创建成功')
else
begin
writeRunLog('TDBUpgrade.createTable 执行建表语句失败:' + ASql);
Exit;
end;
//注释参数不为空则自动增加注释
if Trim(ATableDescription) <> '' then
addTableDescription(ATableName, ATableDescription)
else
writeRunLog('TDBUpgrade.createTable 未传递表注释参数,不自动增加表注释');
Result := True;
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.execUpdateCommand
//
// Describe
// 执行更新语句,返回受影响行数(不加保护)
//
// Parameter
// const (Kind) ASql (Name) string (Type) (Default) 需要执行的SQL脚本
//
// Result
// Integer
// 注意:在执行改变属性语句时有可能返回-1(如SQL SERVER 执行ALTER TABLE语句,成功时返回-1)
//
// Version
// 1.0 create on 2015-01-25 16:31:05 author by Le Delphi 7
//--------------------------函数说明 End----------------------------
function TDBUpgrade.execUpdateCommand(const ASql: string): Integer;
begin
Result := 0;
//1.数据库没有连接直接退出
if not FDBConnected then
begin
writeRunLog('TDBUpgrade.execUpdateCommand 数据库未连接,执行失败');
Exit;
end;
//2.数据库类型不在预定规则内直接退出
if not checkDBTypeInRule(FDBType) then
begin
writeRunLog('TDBUpgrade.execUpdateCommand 当前数据库类型不在预定规则内,执行失败');
Exit;
end;
//3.参数不正确直接退出
if Trim(ASql) = '' then
begin
writeRunLog('TDBUpgrade.execUpdateCommand 参数“ASql”值为空,执行失败');
Exit;
end;
FQueryUpdate.Close;
FQueryUpdate.SQL.Clear;
FQueryUpdate.SQL.Text := ASql;
FQueryUpdate.ExecSQL;
Result := FQueryUpdate.RowsAffected;
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.execUpdateCommandSafe
//
// Describe
// 执行更新语句,返回受影响行数(加保护,报错后不抛出)
//
// Parameter
// const (Kind) ASql (Name) string (Type) (Default) 需要执行的SQL脚本
//
// Result
// Integer
// 注意:在执行改变属性语句时有可能返回-1(如SQL SERVER 执行ALTER TABLE语句,成功时返回-1)
//
// Version
// 1.0 create on 2015-01-25 16:32:21 author by Le Delphi 7
//--------------------------函数说明 End----------------------------
function TDBUpgrade.execUpdateCommandSafe(const ASql: string): Integer;
begin
Result := 0;
try
Result := execUpdateCommand(ASql);
except
on E: Exception do
begin
Result := -9;
writeRunLog('TDBUpgrade.execUpdateCommandSafe 执行更新语句失败,错误信息:' + E.Message);
end;
end;
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.addTableDescription
//
// Describe
// 为表增加注释
//
// Parameter
// const (Kind) ATableName (Name) string (Type) (Default) 需要处理的表名
// const (Kind) ADescription (Name) string (Type) (Default) 注释内容
//
// Result
// Boolean
// True: 增加成功
// False: 增加失败
//
// Version
// 1.0 create on 2015-01-25 17:40:52 author by Le Delphi 7
//--------------------------函数说明 End----------------------------
function TDBUpgrade.addTableDescription(const ATableName,
ADescription: string): Boolean;
var
ASql: string;
begin
Result := False;
//1.数据库没有连接直接退出
if not FDBConnected then
begin
writeRunLog('TDBUpgrade.addTableDescription 数据库未连接,增加失败');
Exit;
end;
//2.数据库类型不在预定规则内直接退出
if not checkDBTypeInRule(FDBType) then
begin
writeRunLog('TDBUpgrade.addTableDescription 当前数据库类型不在预定规则内,增加失败');
Exit;
end;
//3.参数不正确直接退出
if (Trim(ATableName) = '') or (Trim(ADescription) = '') then
begin
writeRunLog('TDBUpgrade.addTableDescription 参数“TableName”、“Description”值至少一个为空,增加失败');
Exit;
end;
//判断注释是否已存在 (MYSQL部分查询需要用到数据库名称)
if tableExistDescription(ATableName, FConnDBUpdate.Database) then
begin
writeRunLog('TDBUpgrade.addTableDescription 注释已存在,增加失败');
Exit;
end;
//ACCESS暂时不处理
if (FDBType = DBT_ACCESS) then
Exit
else
begin
case FDBType of
DBT_ORACLE:
ASql := Format(USC_TABLE_DESCRIPTION_ADD_ORACLE, [ATableName, ADescription]);
DBT_SQLSERVER:
ASql := Format(USC_TABLE_DESCRIPTION_ADD_SQLSERVER, [ADescription, ATableName]);
DBT_MYSQL:
ASql := Format(USC_TABLE_DESCRIPTION_ADD_MYSQL, [ATableName, ADescription]);
end;
end;
if execUpdateCommandSafe(ASql) <> -9 then
writeRunLog('TDBUpgrade.addTableDescription 表' + ATableName + '注释增加成功')
else
writeRunLog('TDBUpgrade.addTableDescription 表' + ATableName + '注释增加失败');
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.addColumnDescription
//
// Describe
// 为列增加注释(此方法不支持MYSQL,若MYSQL想增加注释请使用AlterColumn实现)
//
// Parameter
// const (Kind) ATableName (Name) string (Type) (Default) 需要处理的表名称
// const (Kind) AColumnName (Name) string (Type) (Default) 需要处理的列名称
// const (Kind) ADescription (Name) string (Type) (Default) 注释内容
//
// Result
// Boolean
// True: 增加成功
// False: 增加失败
//
// Version
// 1.0 create on 2015-01-25 17:42:00 author by Le Delphi 7
//--------------------------函数说明 End----------------------------
function TDBUpgrade.addColumnDescription(const ATableName, AColumnName,
ADescription: string): Boolean;
var
ASql: string;
begin
Result := False;
//1.数据库没有连接直接退出
if not FDBConnected then
begin
writeRunLog('TDBUpgrade.addColumnDescription 数据库未连接,增加失败');
Exit;
end;
//2.数据库类型不在预定规则内直接退出
if not checkDBTypeInRule(FDBType) then
begin
writeRunLog('TDBUpgrade.addColumnDescription 当前数据库类型不在预定规则内,增加失败');
Exit;
end;
//3.参数不正确直接退出
if (Trim(ATableName) = '') or (Trim(AColumnName) = '') or (Trim(ADescription) = '') then
begin
writeRunLog('TDBUpgrade.addColumnDescription 参数“TableName”、“ColumnName”、“Description”值至少一个为空,增加失败');
Exit;
end;
//判断注释是否已存在
if columnExistDescription(ATableName, AColumnName) then
begin
writeRunLog('TDBUpgrade.addColumnDescription 表' + ATableName + ' 列' + AColumnName + '注释已存在,增加失败');
Exit;
end;
//ACCESS和MYSQL暂时不处理
if (FDBType = DBT_ACCESS) OR (FDBType = DBT_MYSQL) then
Exit
else
begin
case FDBType of
DBT_ORACLE:
ASql := Format(USC_COLUMN_DESCRIPTION_ADD_ORACLE, [ATableName, AColumnName, ADescription]);
DBT_SQLSERVER:
ASql := Format(USC_COLUMN_DESCRIPTION_ADD_SQLSERVER, [ADescription, ATableName, AColumnName]);
end;
end;
if execUpdateCommandSafe(ASql) <> -9 then
writeRunLog('TDBUpgrade.addColumnDescription 表' + ATableName + ' 列' + AColumnName + '注释增加成功')
else
writeRunLog('TDBUpgrade.addColumnDescription 表' + ATableName + ' 列' + AColumnName + '注释增加失败');
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.addIndex
//
// Describe
// 增加索引
//
// Parameter
// const (Kind) ATableName (Name) string (Type) (Default) 需要处理的表名称
// const (Kind) AIndexColName (Name) string (Type) (Default) 索引包含的列名(多个列之间用英文逗号,分隔)
// const (Kind) AIndexName (Name) string (Type) (Default) 索引名称
//
// Result
// Boolean
//
// Version
// 1.0 create on 2015-01-29 23:24:03 author by Le Delphi 7
//--------------------------函数说明 End----------------------------
function TDBUpgrade.addIndex(const ATableName, AIndexColName,
AIndexName: string): Boolean;
var
sSql: string;
begin
Result := False;
//不在数据库预定规则直接退出
if not checkDBTypeInRule(FDBType) then
begin
writeRunLog('TDBUpgrade.addIndex 数据库类型不在预定范围内,增加失败');
Exit;
end;
//如果索引已存在则退出
if indexExist(AIndexName) then
begin
writeRunLog('TDBUpgrade.addIndex 表' + ATableName + '中已存在' + AIndexName + '索引,不允许重复创建');
Exit;
end;
//创建索引
case FDBType of
DBT_ORACLE:
begin
sSql := Format(USC_INDEX_ADD_ORACLE, [AIndexName, ATableName, AIndexColName]);
end;
DBT_SQLSERVER:
begin
sSql := Format(USC_INDEX_ADD_SQLSERVER, [AIndexName, ATableName, AIndexColName]);
end;
DBT_ACCESS:
begin
sSql := Format(USC_INDEX_ADD_ACCESS, [AIndexName, ATableName, AIndexColName]);
end;
DBT_MYSQL:
begin
sSql := Format(USC_INDEX_ADD_MYSQL, [ATableName, AIndexName, AIndexColName]);
end;
end;
if execUpdateCommandSafe(SSql) <> -9 then
writeRunLog('TDBUpgrade.addIndex 表' + ATableName + '中(' + AIndexColName + ')' + AIndexName + '索引创建成功')
else
begin
writeRunLog('TDBUpgrade.addIndex 执行增加索引语句失败:' + SSql);
Exit;
end;
Result := True;
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.addColumn
//
// Describe
// 增加列
//
// Parameter
// const (Kind) ATableName (Name) string (Type) (Default) 需要操作的表名称
// const (Kind) AColumnName (Name) string (Type) (Default) 需要操作的列名称
// const (Kind) ADataType (Name) string (Type) (Default) 该列的数据类型
// (Kind) ANullFlag (Name) string (Type) 'NULL' (Default) 是否允许为空标识
// (Kind) ADefault (Name) string (Type) '' (Default) 列的默认值
// (Kind) AComment (Name) string (Type) '' (Default) 列的注释
// const (Kind) ASchemaName (Name) string (Type) '' (Default) 所在数据库名称(仅MYSQL使用)
//
// Result
// Boolean
//
// Version
// 1.0 create on 2015-01-29 23:06:03 author by Le Delphi 7
// 1.1 Modify on 2015/09/24 14:27:02 Author by Le RAD Studio XE8
// 增加支持MYSQL需要的参数
//--------------------------函数说明 End----------------------------
function TDBUpgrade.addColumn(const ATableName, AColumnName,
ADataType: string; ANullFlag: string = 'NULL'; ADefault: string = '';
AComment: string = ''; const ASchemaName: string = ''): Boolean;
var
sSql: string;
begin
Result := False;
//不在数据库预定规则直接退出
if not checkDBTypeInRule(FDBType) then
begin
writeRunLog('TDBUpgrade.addColumn 数据库类型不在预定范围内,增加失败');
Exit;
end;
//如果列已存在则退出
if columnExist(ATableName, AColumnName, ASchemaName) then
begin
writeRunLog('TDBUpgrade.addColumn 表' + ATableName + '中已存在' + AColumnName + '列,不允许重复创建');
Exit;
end;
//创建列
case FDBType of
DBT_ORACLE:
begin
sSql := Format(USC_COLUMN_ADD_ORACLE, [ATableName, AColumnName, ADataType, ANullFlag, ADefault]);
end;
DBT_SQLSERVER:
begin
sSql := Format(USC_COLUMN_ADD_SQLSERVER, [ATableName, AColumnName, ADataType, ANullFlag, ADefault]);
end;
DBT_ACCESS:
begin
sSql := Format(USC_COLUMN_ADD_ACCESS, [ATableName, AColumnName, ADataType]);
end;
DBT_MYSQL:
begin
sSql := Format(USC_COLUMN_ADD_MYSQL, [ATableName, AColumnName, ADataType, ANullFlag, ADefault]);
end;
end;
if not execUpdateCommandSafe(SSql) <> -9 then
writeRunLog('TDBUpgrade.addColumn 表' + ATableName + '中' + AColumnName + '列创建成功')
else
begin
writeRunLog('TDBUpgrade.addColumn 执行列增加语句失败:' + SSql);
Exit;
end;
//注释参数不为空则自动增加注释
if Trim(AComment) <> '' then
addColumnDescription(ATableName, AColumnName, AComment)
else
writeRunLog('TDBUpgrade.addColumn 未提供列注释参数,不自动增加列注释');
Result := True;
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.alterColumn
//
// Describe
// 函数说明
//
// Parameter
// const (Kind) ATableName (Name) string (Type) (Default) 需要操作的表名称
// const (Kind) AColumnName (Name) string (Type) (Default) 需要操作的列名称
// const (Kind) ADataType (Name) string (Type) (Default) 该列的数据类型
// (Kind) ANullFlag (Name) string (Type) 'NULL' (Default) 是否允许为空标识
// (Kind) ADefault (Name) string (Type) '' (Default) 列的默认值
// (Kind) AComment (Name) string (Type) '' (Default) 列的注释
// const (Kind) ASchemaName (Name) string (Type) '' (Default) 所在数据库名称(仅MYSQL使用)
//
// Result
// Boolean
//
// Version
// 1.0 create on 2015-01-29 23:34:35 author by Le Delphi 7
// 1.1 Modify on 2015/09/24 14:27:02 Author by Le RAD Studio XE8
// 增加支持MYSQL需要的参数
//--------------------------函数说明 End----------------------------
function TDBUpgrade.alterColumn(const ATableName, AColumnName, ADataType: string; ANullFlag: string;
ADefault: string = ''; AComment: string = ''; const ASchemaName: string = ''): Boolean;
var
sSql: string;
begin
Result := False;
//不在数据库预定规则直接退出
if not checkDBTypeInRule(FDBType) then
begin
writeRunLog('TDBUpgrade.alterColumn 数据库类型不在预定范围内,增加失败');
Exit;
end;
//如果列不存在则退出
if not columnExist(ATableName, AColumnName, ASchemaName) then
begin
writeRunLog('TDBUpgrade.alterColumn 表' + ATableName + '中不存在' + AColumnName + '列,不允许修改');
Exit;
end;
//修改列
case FDBType of
DBT_ORACLE:
begin
//如果默认值不为空,则特殊处理一下
if ADefault <> '' then
ADefault := ' DEFAULT ' + ADefault;
sSql := Format(USC_COLUMN_MODIFY_ORACLE, [ATableName, AColumnName, ADataType, ADefault, ANullFlag]);
end;
DBT_SQLSERVER:
begin
sSql := Format(USC_COLUMN_MODIFY_SQLSERVER, [ATableName, AColumnName, ADataType, ANullFlag, ADefault]);
end;
DBT_ACCESS:
begin
//暂时不处理ACCESS
Exit;
end;
DBT_MYSQL:
begin
if ADefault <> '' then
ADefault := ' DEFAULT ' + ADefault;
if AComment <> '' then
AComment := ' COMMENT ' + QuotedStr(AComment);
sSql := Format(USC_COLUMN_MODIFY_MYSQL, [ATableName, AColumnName, ADataType, ANullFlag, ADefault, AComment]);
end;
end;
if execUpdateCommandSafe(SSql) <> -9 then
writeRunLog('TDBUpgrade.alterColumn 表' + ATableName + '中' + AColumnName + '列修改成功')
else
begin
writeRunLog('TDBUpgrade.alterColumn 执行列修改语句失败:' + SSql);
Exit;
end;
//如果默认值不为空,则更改默认值(只有SQL SERVER特殊)
if (FDBType = DBT_SQLSERVER) and (Trim(ADefault) <> '') then
begin
writeRunLog('TDBUpgrade.alterColumn 默认值不为空,准备增加默认值');
if alterColumnDefaultValue(ATableName, AColumnName, ADefault) then
writeRunLog('TDBUpgrade.alterColumn 默认值增加成功')
else
writeRunLog('TDBUpgrade.alterColumn 默认值增加失败');
end;
Result := True;
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.alterColumnToPK
//
// Describe
// 修改列为主键
//
// Parameter
// const (Kind) ATableName (Name) string (Type) (Default) 表名
// const (Kind) AColumnName (Name) string (Type) (Default) 列名(允许组合主键,用逗号分隔 ID, NAME)
// const (Kind) APKName (Name) string (Type) (Default) 主键名称
// const (Kind) ASchemaName (Name) string (Type) (Default) 数据库名称MYSQL使用
//
// Result
// Boolean
// True: 增加成功
// False: 增加失败
//
// Version
// 1.0 create on 2015-01-29 23:39:55 author by Le Delphi 7
// 1.1 Modify on 2015/09/24 14:27:02 Author by Le RAD Studio XE8
// 增加支持MYSQL需要的参数
//--------------------------函数说明 End----------------------------
function TDBUpgrade.alterColumnToPK(const ATableName, AColumnName,
APKName: string; const ASchemaName: string = ''): Boolean;
var
sSql: string;
begin
Result := False;
//不在数据库预定规则直接退出
if not checkDBTypeInRule(FDBType) then
begin
writeRunLog('TDBUpgrade.alterColumnToPK 数据库类型不在预定范围内,增加失败');
Exit;
end;
//如果列不存在则退出
if not columnExist(ATableName, AColumnName, ASchemaName) then
begin
writeRunLog('TDBUpgrade.alterColumnToPK 表' + ATableName + '中不存在' + AColumnName + '列,不允许创建主键');
Exit;
end;
//改为主键
case FDBType of
DBT_ORACLE:
begin
sSql := Format(USC_COLUMN_TO_PK_ORACLE, [ATableName, APKName, AColumnName]);
end;
DBT_SQLSERVER:
begin
sSql := Format(USC_COLUMN_TO_PK_SQLSERVER, [ATableName, APKName, AColumnName]);
end;
DBT_ACCESS:
begin
sSql := Format(USC_COLUMN_TO_PK_ACCESS, [ATableName, AColumnName, APKName]);
end;
DBT_MYSQL:
begin
sSql := Format(USC_COLUMN_TO_PK_MYSQL, [ATableName, AColumnName]);
end;
end;
if execUpdateCommandSafe(SSql) <> -9 then
writeRunLog('TDBUpgrade.alterColumnToPK 表' + ATableName + '中增加主键(' + AColumnName + ')' + APKName + '成功')
else
begin
writeRunLog('TDBUpgrade.alterColumnToPK 增加主键失败:' + SSql);
Exit;
end;
Result := True;
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.alterColumnDefaultValue
//
// Describe
// 修改列的默认值(本函数仅SQL SERVER使用)
//
// Parameter
// const (Kind) ATableName (Name) string (Type) (Default) 需要操作的表名
// const (Kind) AColumnName (Name) string (Type) (Default) 需要操作的列名
// const (Kind) ADefaultValue (Name) string (Type) (Default) 默认值
//
// Result
// Boolean
//
// Version
// 1.0 create on 2015-02-02 17:16:29 author by Le Delphi 7
//--------------------------函数说明 End----------------------------
function TDBUpgrade.alterColumnDefaultValue(const ATableName, AColumnName,
ADefaultValue: string): Boolean;
var
sSql: string;
strTemp: string;
begin
Result := False;
//不在数据库预定规则直接退出
if not checkDBTypeInRule(FDBType) then
begin
writeRunLog('TDBUpgrade.alterColumnDefaultValue 数据库类型不在预定范围内,增加失败');
Exit;
end;
//如果列不存在则退出
if not columnExist(ATableName, AColumnName) then
begin
writeRunLog('TDBUpgrade.alterColumnDefaultValue 表' + ATableName + '中不存在' + AColumnName + '列,不允许修改');
Exit;
end;
//增加默认值
case FDBType of
DBT_ORACLE:
begin
//sSql := Format(USC_COLUMN_MODIFY_ORACLE, [ATableName, AColumnName, ADataType, NullFlag, Default]);
Exit;
end;
DBT_SQLSERVER:
begin
//先判断默认值是否存在,如果存在则删除
strTemp := (getColumnValue(Format(QSC_COLUMN_DEFAULT_NAME, [ATableName, AColumnName, '%']), ''));
if strTemp <> '' then
delConstraint(ATableName, strTemp);
sSql := Format(USC_COLUMN_DEFAULT_ADD_SQLSERVER, [ATableName, 'DF_' + ATableName + '_' + AColumnName, ADefaultValue, AColumnName]);
end;
DBT_ACCESS:
begin
//暂时不处理ACCESS
Exit;
end;
DBT_MYSQL:
begin
//sSql := Format(USC_COLUMN_MODIFY_MYSQL, [ATableName, AColumnName, AColumnName, ADataType, NullFlag, Default]);
Exit;
end;
end;
if execUpdateCommandSafe(SSql) <> -9 then
writeRunLog('TDBUpgrade.alterColumnDefaultValue 表' + ATableName + '中' + AColumnName + '列增加默认值成功')
else
begin
writeRunLog('TDBUpgrade.alterColumnDefaultValue 执行列修改语句失败:' + SSql);
Exit;
end;
Result := True;
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.tableExistDescription
//
// Describe
// 判断表是否已存在注释
//
// Parameter
// const (Kind) ATableName (Name) string (Type) (Default) 需要判断的表名
// const (Kind) SchemaName (Name) string (Type) (Default) 表所在数据库名称
//
// Result
// Boolean
// True: 已存在
// False: 不存在,或判断出错
//
// Version
// 1.0 create on 2015-01-25 17:36:01 author by Le Delphi 7
// 1.1 Modify on 2015/09/24 14:01:34 Author by Le RAD Studio XE8
// 增加SchemaName参数,用于支持MYSQL的查询
//--------------------------函数说明 End----------------------------
function TDBUpgrade.tableExistDescription(const ATableName: string; const ASchemaName: string = ''): Boolean;
begin
Result := False;
//1.数据库没有连接直接退出
if not FDBConnected then
begin
writeRunLog('TDBUpgrade.tableExistDescription 数据库未连接,判断失败');
Exit;
end;
//2.数据库类型不在预定规则内直接退出
if not checkDBTypeInRule(FDBType) then
begin
writeRunLog('TDBUpgrade.tableExistDescription 当前数据库类型不在预定规则内,判断失败');
Exit;
end;
//3.参数不正确直接退出
if Trim(ATableName) = '' then
begin
writeRunLog('TDBUpgrade.tableExistDescription 参数“TableName”值为空,判断失败');
Exit;
end;
//ACCESS暂时不处理
if (FDBType = DBT_ACCESS) then
Exit
else
begin
FQuerySearch.Close;
FQuerySearch.SQL.Clear;
case FDBType of
DBT_ORACLE:
FQuerySearch.SQL.Text := Format(QSC_TABLE_DESCRIPTION_EXIST_ORACLE, [ATableName]);
DBT_SQLSERVER:
FQuerySearch.SQL.Text := Format(QSC_TABLE_DESCRIPTION_EXIST_SQLSERVER, [ATableName]);
DBT_MYSQL:
FQuerySearch.SQL.Text := Format(QSC_TABLE_DESCRIPTION_EXIST_MYSQL, [ASchemaName, ATableName]);
end;
FQuerySearch.Open;
if not FQuerySearch.IsEmpty then
Result := True;
end;
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.columnExistDescription
//
// Describe
// 判断列是否已存在注释
//
// Parameter
// const (Kind) ATableName (Name) string (Type) (Default) 需要判断的表名
// const (Kind) AColumnName (Name) string (Type) (Default) 需要判断的列名
//
// Result
// Boolean
// True: 已存在
// False: 不存在,或判断出错
//
// Version
// 1.0 create on 2015-01-25 17:37:58 author by Le Delphi 7
//--------------------------函数说明 End----------------------------
function TDBUpgrade.columnExistDescription(const ATableName,
AColumnName: string): Boolean;
begin
Result := False;
//1.数据库没有连接直接退出
if not FDBConnected then
begin
writeRunLog('TDBUpgrade.columnExistDescription 数据库未连接,判断失败');
Exit;
end;
//2.数据库类型不在预定规则内直接退出
if not checkDBTypeInRule(FDBType) then
begin
writeRunLog('TDBUpgrade.columnExistDescription 当前数据库类型不在预定规则内,判断失败');
Exit;
end;
//3.参数不正确直接退出
if (Trim(ATableName) = '') or (Trim(AColumnName) = '') then
begin
writeRunLog('TDBUpgrade.columnExistDescription 参数“TableName”、“ColumnName”值至少一个为空,判断失败');
Exit;
end;
//ACCESS暂时不处理
if (FDBType = DBT_ACCESS) then
Exit
else
begin
FQuerySearch.Close;
FQuerySearch.SQL.Clear;
case FDBType of
DBT_ORACLE:
FQuerySearch.SQL.Text := Format(QSC_COLUMN_DESCRIPTION_EXIST_ORACLE, [ATableName, AColumnName]);
DBT_SQLSERVER:
FQuerySearch.SQL.Text := Format(QSC_COLUMN_DESCRIPTION_EXIST_SQLSERVER, [ATableName, AColumnName]);
DBT_MYSQL:
FQuerySearch.SQL.Text := Format(QSC_COLUMN_DESCRIPTION_EXIST_MYSQL, [ATableName, AColumnName]);
end;
FQuerySearch.Open;
if not FQuerySearch.IsEmpty then
Result := True;
end;
end;
constructor TDBUpgrade.Create(AOwner: TComponent);
begin
//创建时初始化资源为初始状态 Modify on 2015/10/08 11:04:47 Author by Le RAD Studio XE8
FConnDBUpdate := nil;
FDBName := '';
FQueryLogList := nil;
FQuerySearch := nil;
FQueryUpdate := nil;
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.needUpdate
//
// Describe
// 判断是否可以更新对应标识
//
// Parameter
// const (Kind) AUpdateFlag (Name) string (Type) (Default) 将要更新的版本标识
// const (Kind) AUpdateFlagAuthor (Name) string (Type) (Default) 版本标识对应的作者
//
// Result
// Boolean
//
// Version
// 1.0 create on 2015-01-25 20:06:16 author by Le Delphi 7
//--------------------------函数说明 End----------------------------
function TDBUpgrade.needUpdate(const AUpdateFlag,
AUpdateFlagAuthor: string): Boolean;
begin
Result := False;
//1.数据库没有连接直接退出
if not FDBConnected then
begin
writeRunLog('TDBUpgrade.canUpdate 数据库未连接,判断失败');
Exit;
end;
//2.数据库类型不在预定规则内直接退出
if not checkDBTypeInRule(FDBType) then
begin
writeRunLog('TDBUpgrade.canUpdate 当前数据库类型不在预定规则内,判断失败');
Exit;
end;
//3.参数不正确直接退出
if (Trim(AUpdateFlag) = '') or (Trim(AUpdateFlagAuthor) = '') then
begin
writeRunLog('TDBUpgrade.canUpdate 参数“UpdateFlag”、“UpdateFlagAuthor”值至少一个为空,判断失败');
Exit;
end;
//判断数据库是否已有对应更新
FQuerySearch.Close;
FQuerySearch.SQL.Clear;
FQuerySearch.SQL.Text := 'SELECT 1 FROM DB_UPDATE_LOG WHERE FLAG = ' + QuotedStr(AUpdateFlag) + ' AND FLAG_AUTHOR = ' + QuotedStr(AUpdateFlagAuthor);
FQuerySearch.Open;
//为空代表该标识还未更新过,可以更新
if FQuerySearch.IsEmpty then
Result := True;
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.getColumnValue
//
// Describe
// 传入SQL语句,返回第一列的值
//
// Parameter
// const (Kind) ASql (Name) string (Type) (Default) 查询语句的SQL
// const (Kind) DefaultValue (Name) Variant (Type) (Default) 默认返回值
//
// Result
// Variant
//
// Version
// 1.0 create on 2015-02-02 17:29:04 author by Le Delphi 7
//--------------------------函数说明 End----------------------------
function TDBUpgrade.getColumnValue(const ASql: string;
const ADefaultValue: Variant): Variant;
begin
Result := ADefaultValue;
//1.数据库没有连接直接退出
if not FDBConnected then
begin
writeRunLog('TDBUpgrade.getColumnValue 数据库未连接,判断失败');
Exit;
end;
//2.数据库类型不在预定规则内直接退出
if not checkDBTypeInRule(FDBType) then
begin
writeRunLog('TDBUpgrade.getColumnValue 当前数据库类型不在预定规则内,判断失败');
Exit;
end;
//3.参数不正确直接退出
if Trim(ASql) = '' then
begin
writeRunLog('TDBUpgrade.getColumnValue 参数SSql值为空,判断失败');
Exit;
end;
try
FQuerySearch.Close;
FQuerySearch.SQL.Clear;
FQuerySearch.SQL.Text := ASql;
FQuerySearch.Open;
if not FQuerySearch.Eof then
Result := FQuerySearch.Fields[0].AsVariant;
except
end;
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.delConstraint
//
// Describe
// 删除约束
//
// Parameter
// const (Kind) ATableName (Name) string (Type) (Default) 表名称
// const (Kind) ConstraintName (Name) string (Type) (Default) 约束名称
//
// Result
// Boolean
//
// Version
// 1.0 create on 2015-02-02 17:44:23 author by Le Delphi 7
//--------------------------函数说明 End----------------------------
function TDBUpgrade.delConstraint(const ATableName, AConstraintName: string): Boolean;
var
sSql: string;
begin
Result := False;
//1.数据库没有连接直接退出
if not FDBConnected then
begin
writeRunLog('TDBUpgrade.delConstraint 数据库未连接,判断失败');
Exit;
end;
//2.数据库类型不在预定规则内直接退出
if not checkDBTypeInRule(FDBType) then
begin
writeRunLog('TDBUpgrade.delConstraint 当前数据库类型不在预定规则内,判断失败');
Exit;
end;
//3.参数不正确直接退出
if (Trim(ATableName) = '') or (Trim(AConstraintName) = '') then
begin
writeRunLog('TDBUpgrade.delConstraint 参数TableName或ConstraintName参数值至少一个为空,判断失败');
Exit;
end;
//4.判断约束是否存在
if not checkConstraintExist(ATableName, AConstraintName) then
Exit;
//删除约束
case FDBType of
DBT_ORACLE:
begin
sSql := Format(USC_CONSTRAINT_DROP_ORACLE, [ATableName, AConstraintName]);
end;
DBT_SQLSERVER:
begin
sSql := Format(USC_CONSTRAINT_DROP_SQLSERVER, [ATableName, AConstraintName]);
end;
DBT_ACCESS:
begin
Exit;
end;
DBT_MYSQL:
begin
Exit;
end;
end;
if execUpdateCommandSafe(SSql) <> -9 then
writeRunLog('TDBUpgrade.delConstraint 表' + ATableName + '中' + AConstraintName + '约束删除成功')
else
begin
writeRunLog('TDBUpgrade.delConstraint 约束删除失败:' + SSql);
Exit;
end;
Result := True;
end;
destructor TDBUpgrade.Destroy;
begin
end;
//--------------------------函数说明 Begin--------------------------
// Name
// TDBUpgrade.writeUpdateLogToDB
//
// Describe
// 写入更新记录至数据库
//
// Parameter
// const (Kind) AUpdateFlag (Name) string (Type) (Default) 更新标识
// const (Kind) AUpdateFlagAuthor (Name) string (Type) (Default) 更新标识作者
//
// Result
// 无
//
// Version
// 1.0 create on 2015-01-25 23:31:26 author by Le Delphi 7
//--------------------------函数说明 End----------------------------
procedure TDBUpgrade.writeUpdateLogToDB(const AUpdateFlag,
AUpdateFlagAuthor: string);
var
sSql: string;
begin
//1.数据库没有连接直接退出
if not FDBConnected then
begin
writeRunLog('TDBUpgrade.writeUpdateLogToDB 数据库未连接,记录失败');
Exit;
end;
//2.数据库类型不在预定规则内直接退出
if not checkDBTypeInRule(FDBType) then
begin
writeRunLog('TDBUpgrade.writeUpdateLogToDB 当前数据库类型不在预定规则内,记录失败');
Exit;
end;
case FDBType of
DBT_ORACLE:
sSql := 'INSERT INTO DB_UPDATE_LOG VALUES (' + QuotedStr(AUpdateFlag) + ', ' + QuotedStr(AUpdateFlagAuthor) + ', '
+ QuotedStr(FComputerName) + ', ' + QuotedStr(FComputerIP) + ', SYSDATE)';
DBT_SQLSERVER:
sSql := 'INSERT INTO DB_UPDATE_LOG VALUES (' + QuotedStr(AUpdateFlag) + ', ' + QuotedStr(AUpdateFlagAuthor) + ', '
+ QuotedStr(FComputerName) + ', ' + QuotedStr(FComputerIP) + ', GETDATE())';
DBT_ACCESS:
sSql := 'INSERT INTO DB_UPDATE_LOG VALUES (' + QuotedStr(AUpdateFlag) + ', ' + QuotedStr(AUpdateFlagAuthor) + ', '
+ QuotedStr(FComputerName) + ', ' + QuotedStr(FComputerIP) + ', GETDATE())';
DBT_MYSQL:
sSql := 'INSERT INTO DB_UPDATE_LOG VALUES (' + QuotedStr(AUpdateFlag) + ', ' + QuotedStr(AUpdateFlagAuthor) + ', '
+ QuotedStr(FComputerName) + ', ' + QuotedStr(FComputerIP) + ', NOW())';
end;
//更新
if execUpdateCommandSafe(sSql) <> 0 then
writeRunLog('TDBUpgrade.writeUpdateLogToDB 记录更新标识到数据库成功 flag:' + AUpdateFlag + ' flagAuthor:' + AUpdateFlagAuthor)
else
writeRunLog('TDBUpgrade.writeUpdateLogToDB 记录更新标识到数据库失败 flag:' + AUpdateFlag + ' flagAuthor:' + AUpdateFlagAuthor);
end;
//--------------------------工程说明 Begin--------------------------
// Name
// TDBUpgrade.databaseUpdate
//
// Describe
// 数据库更新程序主入口,初始化完资源后调用改过程执行数据库升级(升级内容全部在本过程中书写)。
//
// Parameter
//
//
// Result
// 无
//
// Version
// 1.0 create on 2015/10/10 11:57:06 author by Le RAD Studio XE8
//--------------------------工程说明 End----------------------------
procedure TDBUpgrade.databaseUpdate;
var
sSql: string;
flag, flagAuthor: string;
begin
try
initResource;
try
if Trim(FFilePath) = '' then
FFilePath := ExtractFilePath(ParamStr(0));
writeRunLog('TDBUpgrade.databaseUpdate 进入databaseUpdate,准备开始更新');
//判断计算机名称及IP变量值是否正确
if Trim(FComputerName) = '' then
getComputerInfo;
//打开数据集
FConnDBUpdate.Close;
FConnDBUpdate.Open;
setDBConnected(True);
writeRunLog('TDBUpgrade.databaseUpdate 打开数据库连接成功,准备判断更新日志表(DB_UPDATE_LOG)是否存在');
//判断数据库类型是否在预定规则内
if not checkDBTypeInRule(FDBType) then
begin
writeRunLog('TDBUpgrade.databaseUpdate 数据库类型不在预定规则内,更新失败');
Exit;
end;
//判断数据更新日志表是否存在,不存在则创建
if not tableExist('DB_UPDATE_LOG', FDBName) then
begin
writeRunLog('TDBUpgrade.databaseUpdate 更新日志表(DB_UPDATE_LOG)不存在,准备创建');
case FDBType of
DBT_ORACLE:
sSql := 'CREATE TABLE DB_UPDATE_LOG('
+ ' FLAG VARCHAR2(10) NOT NULL, '
+ ' FLAG_AUTHOR VARCHAR2(30) NOT NULL, '
+ ' COMPUTER VARCHAR2(20), '
+ ' IP VARCHAR2(32), '
+ ' CREATE_DT DATE DEFAULT SYSDATE, '
+ ' CONSTRAINT PK_DB_UPDATE_LOG PRIMARY KEY(FLAG, FLAG_AUTHOR) '
+ ')';
DBT_SQLSERVER:
sSql := 'CREATE TABLE DB_UPDATE_LOG('
+ ' FLAG VARCHAR(10) NOT NULL, '
+ ' FLAG_AUTHOR VARCHAR(30) NOT NULL, '
+ ' COMPUTER VARCHAR(20) NULL, '
+ ' IP VARCHAR(32) NULL, '
+ ' CREATE_DT DATETIME DEFAULT GETDATE(), '
+ ' CONSTRAINT PK_DB_UPDATE_LOG PRIMARY KEY (FLAG, FLAG_AUTHOR) '
+ ')';
DBT_ACCESS:
sSql := 'CREATE TABLE DB_UPDATE_LOG('
+ ' FLAG VARCHAR(10) NOT NULL, '
+ ' FLAG_AUTHOR VARCHAR(30) NOT NULL, '
+ ' COMPUTER VARCHAR(20) NULL, '
+ ' IP VARCHAR(32) NULL, '
+ ' CREATE_DT DATETIME DEFAULT GETDATE(), '
+ ' PRIMARY KEY(FLAG, FLAG_AUTHOR) '
+ ')';
DBT_MYSQL:
sSql := 'CREATE TABLE DB_UPDATE_LOG ('
+ ' FLAG VARCHAR(10) NOT NULL COMMENT ''当前更新标记'', '
+ ' FLAG_AUTHOR VARCHAR(30) NOT NULL COMMENT ''当前标识作者'', '
+ ' COMPUTER VARCHAR(20) NULL COMMENT ''更新时计算机名称'', '
+ ' IP VARCHAR(32) NULL COMMENT ''更新时计算机IP'', '
+ ' CREATE_DT DATETIME COMMENT ''创建时间(更新时间)'', '
+ ' CONSTRAINT PK_DB_UPDATE_LOG PRIMARY KEY (FLAG, FLAG_AUTHOR) '
+ ')'
+ ' COLLATE=''utf8_general_ci'' ';
end;
if createTable('DB_UPDATE_LOG', sSql, '数据库更新日志表') then
begin
addColumnDescription('DB_UPDATE_LOG', 'FLAG', '当前更新标记');
addColumnDescription('DB_UPDATE_LOG', 'FLAG_AUTHOR', '当前标识作者');
addColumnDescription('DB_UPDATE_LOG', 'COMPUTER', '更新时计算机名称');
addColumnDescription('DB_UPDATE_LOG', 'IP', '更新时计算机IP');
addColumnDescription('DB_UPDATE_LOG', 'CREATE_DT', '创建时间(更新时间)');
end
else
begin
writeRunLog('TDBUpgrade.databaseUpdate 创建数据库更新日志表(DB_UPDATE_LOG)失败,不再继续执行更新');
Exit;
end;
end;
flag := '1';
flagAuthor := 'LE';
updateProgressPrompt('准备更新版本(' + flag + ') 版本作者(' + flagAuthor + ')');
if needUpdate(flag, flagAuthor) then
begin
writeRunLog('TDBUpgrade.databaseUpdate 开始更新,版本标识:' + flag + ' 作者:' + flagAuthor);
updateProgressPrompt('开始更新版本(' + flag + ') 版本作者(' + flagAuthor + ')');
if alterColumn('DB_UPDATE_LOG', 'COMPUTER', 'varchar(30)', 'NOT NULL', '', '计算机名称', FDBName) then
begin
writeUpdateLogToDB(flag, flagAuthor);
writeRunLog('TDBUpgrade.databaseUpdate 更新完毕,版本标识:' + flag + ' 作者:' + flagAuthor);
end
else
writeRunLog('TDBUpgrade.databaseUpdate 更新失败,版本标识:' + flag + ' 作者:' + flagAuthor);
updateProgressPrompt('版本(' + flag + ') 版本作者(' + flagAuthor + ')更新完毕');
end
else
writeRunLog('TDBUpgrade.databaseUpdate 更新日志中已有该版本更新记录,跳过此次更新UpdateFlag:' + flag + ' UpdateFlagAuthor:' + flagAuthor);
flag := '2';
flagAuthor := 'LE';
updateProgressPrompt('准备更新版本(' + flag + ') 版本作者(' + flagAuthor + ')');
if needUpdate(flag, flagAuthor) then
begin
writeRunLog('TDBUpgrade.databaseUpdate 开始更新,版本标识:' + flag + ' 作者:' + flagAuthor);
updateProgressPrompt('开始更新版本(' + flag + ') 版本作者(' + flagAuthor + ')');
//测试增加索引
if addIndex('DB_UPDATE_LOG', 'IP', 'IDX_DB_UPDATE_LOG_IP') then
begin
writeUpdateLogToDB(flag, flagAuthor);
writeRunLog('TDBUpgrade.databaseUpdate 更新完毕,版本标识:' + flag + ' 作者:' + flagAuthor);
end
else
writeRunLog('TDBUpgrade.databaseUpdate 更新失败,版本标识:' + flag + ' 作者:' + flagAuthor);
updateProgressPrompt('版本(' + flag + ') 版本作者(' + flagAuthor + ')更新完毕');
end
else
writeRunLog('TDBUpgrade.databaseUpdate 更新日志中已有该版本更新记录,跳过此次更新UpdateFlag:' + flag + ' UpdateFlagAuthor:' + flagAuthor);
// flag := '3';
// flagAuthor := 'LE';
// updateProgressPrompt('准备更新版本(' + flag + ') 版本作者(' + flagAuthor + ')');
// if canUpdate(flag, flagAuthor) then
// begin
// writeRunLog('TDBUpgrade.databaseUpdate 开始更新,版本标识:' + flag + ' 作者:' + flagAuthor);
// updateProgressPrompt('开始更新版本(' + flag + ') 版本作者(' + flagAuthor + ')');
// //测试增加主键
// if alterColumnToPK('DB_UPDATE_LOG', 'FLAG, FLAG_AUTHOR', 'PK_DB_UPDATE_LOG', FDBName) then
// begin
// writeUpdateLogToDB(flag, flagAuthor);
// writeRunLog('TDBUpgrade.databaseUpdate 更新完毕,版本标识:' + flag + ' 作者:' + flagAuthor);
// end
// else
// writeRunLog('TDBUpgrade.databaseUpdate 更新失败,版本标识:' + flag + ' 作者:' + flagAuthor);
// updateProgressPrompt('版本(' + flag + ') 版本作者(' + flagAuthor + ')更新完毕');
// end
// else
// writeRunLog('TDBUpgrade.databaseUpdate 更新日志中已有该版本更新记录,跳过此次更新UpdateFlag:' + flag + ' UpdateFlagAuthor:' + flagAuthor);
writeRunLog('TDBUpgrade.databaseUpdate 更新完成');
updateProgressPrompt('数据库更新完毕');
except
on E: Exception do
begin
writeRunLog('TDBUpgrade.databaseUpdate 更新失败,错误信息:' + E.Message);
updateProgressPrompt('更新失败,错误明细请查看日志');
end;
end;
finally
destroyResource;
end;
end;
end.
此处可能存在不合适展示的内容,页面不予展示。您可通过相关编辑功能自查并修改。
如您确认内容无涉及 不当用语 / 纯广告导流 / 暴力 / 低俗色情 / 侵权 / 盗版 / 虚假 / 无价值内容或违法国家有关法律法规的内容,可点击提交进行申诉,我们将尽快为您处理。