自己搜集编写的Delphi 通用函数
{ ********************************************************************** }
{ Currency Common Function Procedure Unit }
{ 通用公共函数过程单元 }
{ Author:Heaven.Ben. Ver:1.01090716a }
{ Last Version: 1.01090716a }
{ Create Date:2009-07-16 }
{ ---------------------------------------------------------------------- }
{ 相关函数、过程约定: }
{ cf_ -----通用函数前缀 }
{ cf_val -----通用变量处理公共函数 }
{ cf_db -----通用数据库处理公共函数 }
{ cf_file -----通用文件处理公共函数 }
{ cf_date -----通用日期处理公共函数 }
{ cf_oper -----通用业务操作公共函数 }
{ cf_reg -----通用注册表公共函数 }
{ cf_xml -----通用xml文件操作公共函数 }
{ cf_gdi -----通用图形操作公共函数 }
{ cf_cls -----通用类控件操作公共函数 }
{ cf_net -----通用网络操作函数 }
{ cf_hrd -----通用硬件操作函数 }
{ cf_othr -----通用其它操作函数 }
{ cf_sys -----通用系统操作函数 }
{ -------------------------------------------------------------- }
{ cp_ -----通用过程前缀 }
{ cp_val -----通用变量处理公共过程 }
{ cp_db -----通用数据库处理公共过程 }
{ cp_file -----通用文件处理公共过程 }
{ cp_date -----通用日期处理公共过程 }
{ cp_oper -----通用业务操作公共过程 }
{ cp_reg -----通用注册表公共过程 }
{ cp_xml -----通用xml文件操作过程 }
{ cp_gdi -----通用图形操作公共过程 }
{ cp_cls -----通用类控件操作公共过程 }
{ cp_net -----通用网络操作过程 }
{ cp_hrd -----通用硬件操作过程 }
{ cp_othr -----通用其它操作过程 }
{ cp_sys -----通用系统操作过程 }
{ ---------------------------------------------------------------------- }
{ 相关变量约定: }
{ 类型 全局: "g" 局部: 数组 }
{ String gs变量名 s变量名 gas/as 变量名 }
{ Integer gi变量名 i变量名 gai/ai 变量名 }
{ DataTime gdt变量名 dt变量名 gadt/adt 变量名 }
{ Dobule gd变量名 d变量名 gad/ad 变量名 }
{ Boolean gb变量名 b变量名 gab/ab 变量名 }
{ Variant gv变量名 v变量名 gav/av 变量名 }
{ Object go变量名 o变量名 gao/ao 变量名 }
{ ---------------------------------------------------------------------- }
{ 相关常量约定: }
{ CONST_ --前缀 }
{ CONST_FILE --文件操作定义 }
{ CONST_REG --注册表操作定义 }
{ CONST_SYS --系统操作定义 }
{ CONST_VAL --变量操作定义 }
{ CONST_HARD --硬件操作定义 }
{ CONST_OPER --业务操作定义 }
{ CONST_DATA --数据操作定义
{---------------------------------------------------------------------- }
unit uCommon;
interface
{ ************************************************************************** }
{ Adduction Unit Files Area }
{ 引用单元文件区域 }
{ SysUtils -系统单元文件 }
{ Variants -变量单元文件 }
{ Math -数学单元文件 }
{ StrUtis -字符串单元文件 }
{ ComCtrls -控件子项单元文件. }
{ Registry -注册表单元文件 }
{ ShellAPI -WINAPI单元文件 }
{ Forms -窗口单元文件 }
{ Windows -windows定义文件 }
{ Message -消息定义文件 }
{ IniFiles -配置信息文件 }
{ StdCtrls -控件定义文件 }
{ Printers -打印定义文件 }
{ Controls -可视控件定义文件 }
{ Graphics -图形控件定义文件 }
{ CommCtrl -通用图形控件定义文件。 }
{ IdSMTP -邮件SMTP定义文件 }
{ IdMessage -邮件消息定义文件 }
{ Jpeg -图形控件定义文件 }
{ MMSystem -多媒体控件定义文件 }
{ ADODB -数据库操作定义文件 }
{ WinSock -网络操作定义文件 }
{ DBClient -数据库客户定义文件。 }
{ TLHelp32 -进程快照操作定义文件 }
{ ComObj -COM操作定义文件。 }
{ Nb30 -NETBIOS定义文件。 }
{ CnMD5 -CnPack的MD5定义操作文件 }
{ Dialogs -对话框定义文件. }
{ ShlObj -接口定义文件. }
{ ActiveX -ActiveX定义文件. }
{ Grids -Grids网格定义文件. }
{ Menus -Menu 定义文件 }
{ WinSkinDlg -皮肤管理定义文件 }
{ WinSkinData -皮肤控制定义文件 }
{ WinSkinStore -皮肤仓库定义文件 }
{ ExtCtrls -扩展控件定义文件。 }
{ ExCombobox -自定义控件文件 }
{ ADOCombobox -自定义控件文件 }
{ DBGridEh -三方Grid定义文件. }
{ DBGridEhImpExp-三方Grid导入导出文件 }
{ DBGrids -系统Grids定义文件。 }
{ DBCtrlsEh -三方日期控件
{ ************************************************************************** }
uses
Windows, Forms, Classes, SysUtils, Variants, Math, StrUtils,
Registry, ShellAPI, Messages, IniFiles, StdCtrls, Printers,
Controls, Graphics, CommCtrl, IdSMTP, IdMessage, Jpeg, MMSystem,
ADODB, WinSock, DBClient, TlHelp32, ComObj, Nb30, CnMD5, ExtCtrls,
ComCtrls, ShlObj, ActiveX, DB, Grids, Dialogs, CnCheckTreeView,
Menus, WinSkinDlg, WinSkinData, WinSkinStore, ExComboBox, ADOCombobox,
mxOutlookBarPro, DBGridEh, DBGridEhImpExp, DBGrids, cxGridDBTableView,
RzTabs, DBCtrlsEh;
{ ********************************************************************** }
{ User Custom Const Area }
{ 用户自定义常量区域 }
{ ********************************************************************** }
const
// 通用接口匙
CONST_VAL_REGCODE = '032AC7E0-E84D-4BE3-A624-E946D1917E91';
// 注册表根目录
CONST_REG_ROOTKEY = HKEY_LOCAL_MACHINE;
// 技术支持公司名
CONST_VAL_POWERBYNAME = 'QingDao HeavenPerson Studio.';
// 系统对话框标题
CONST_SYS_DIALOGTITLE = '系统信息';
// 关闭系统
CONST_SYS_WINCLOSE = 0;
// 系统重启
CONST_SYS_WINRESTART = 1;
// 字符分隔符
CONST_VAL_SPLIT = '■';
// 默认皮肤
CONST_SYS_SKININDEX = 0;
// 系统注销
CONST_SYS_WINLOGOUT = 2;
// 系统关机
CONST_SYS_WINPOWEROFF = 3;
// 文件创建时间
CONST_FILE_CREATEDATE = 0;
// 文件修改时间
CONST_FILE_MODIFYDATE = 1;
// 文件访问时间
CONSI_FILE_ACCESSDATE = 2;
// BASE64定义表
CONST_VAL_BASE64CODE: ShortString =
'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
// 日期时间差单位为天
CONST_DATE_DIFFDAY = 0;
// 日期时间差单位为时
CONST_DATE_DIFFHOUR = 1;
// 日期时间差单位为分
CONST_DATE_DIFFMINUTE = 2;
// 日期时间差单位为秒
CONST_DATE_DIFFSECOND = 3;
// 系统文件配置名称
CONST_SYS_INIFILENAME = 'Kenel.ini';
// ACCSS系统数据库文件
CONST_DATA_ACCESSPATH = 'Data\Data.mdb';
// 业务列表定义
// 结费方式
CONST_OPER_CHARGETYPE: Integer = 0;
// 结费币种
CONST_OPER_CURRENCYCODE: Integer = 1;
// 指定类型
CONST_OPER_ASSIGNTYPE: Integer = 2;
// 指定定点外点
CONST_OPER_ASSIGNINOUT: Integer = 3;
// 场区排列方向
CONST_OPER_HVLOCATION: Integer = 10;
// 箱空重
CONST_OPER_CNTREF: Integer = 20;
// 颜色管理类型
CONST_OPER_COLORTYPE: Integer = 30;
// 任务类型标识
CONST_OPER_CNTRFLAG: Integer = 40;
// 垛位摆箱顺序
CONST_OPER_BAYORDER: Integer = 50;
// 排位摆箱顺序
CONST_OPER_LOCORDER: Integer = 60;
// 任务类型
CONST_OPER_TASKTYPE: Integer = 70;
// 箱状态
CONST_OPER_CNTRSTATUS: Integer = 80;
// 箱状态描述
CONST_OPER_CNTRSTATUSDESC: Integer = 90;
// 通用是与否
CONST_OPER_YESNO: Integer = 15;
// 进出口
CONST_OPER_IE: Integer = 25;
// 空时间
CONST_SYS_NULLDATETIME: Double = 2.0;
{ ********************************************************************** }
{ Custom "Record,Class,Enum" Area }
{ 用户自定义记录结构体,类,枚举区域 }
{ ********************************************************************** }
// 通用数据传递记录结构体
type
TListCommVar = record
// 支持131个通用传递变量
s0: string;
s1: string;
s2: string;
s3: string;
s4: string;
s5: string;
s6: string;
s7: string;
s8: string;
s9: string;
s10: string;
s11: string;
s12: string;
s13: string;
s14: string;
s15: string;
s16: string;
s17: string;
s18: string;
s19: string;
s20: string;
s21: string;
s22: string;
s23: string;
s24: string;
s25: string;
s26: string;
s27: string;
s28: string;
s29: string;
s30: string;
s31: string;
s32: string;
s33: string;
s34: string;
s35: string;
s36: string;
s37: string;
s38: string;
s39: string;
s40: string;
s41: string;
s42: string;
s43: string;
s44: string;
s45: string;
s46: string;
s47: string;
s48: string;
s49: string;
s50: string;
s51: string;
s52: string;
s53: string;
s54: string;
s55: string;
s56: string;
s57: string;
s58: string;
s59: string;
s60: string;
s61: string;
s62: string;
s63: string;
s64: string;
s65: string;
s66: string;
s67: string;
s68: string;
s69: string;
s70: string;
s71: string;
s72: string;
s73: string;
s74: string;
s75: string;
s76: string;
s77: string;
s78: string;
s79: string;
s80: string;
s81: string;
s82: string;
s83: string;
s84: string;
s85: string;
s86: string;
s87: string;
s88: string;
s89: string;
s90: string;
s91: string;
s92: string;
s93: string;
s94: string;
s95: string;
s96: string;
s97: string;
s98: string;
s99: string;
s100: string;
s101: string;
s102: string;
s103: string;
s104: string;
s105: string;
s106: string;
s107: string;
s108: string;
s109: string;
s110: string;
s111: string;
s112: string;
s113: string;
s114: string;
s115: string;
s116: string;
s117: string;
s118: string;
s119: string;
s120: string;
s121: string;
s122: string;
s123: string;
s124: string;
s125: string;
s126: string;
s127: string;
s128: string;
s129: string;
s130: string;
end;
// CnCheckTreeView组件选择结点后调用函数返回的数据类型。
type
TctvResultType = (ctvResultID, ctvResultPID, ctvResultKeyField,
ctvResultDisplayField, ctvResultData);
// 函数处理的数据类型
type
TDealDataType = (ddtString, ddtInteger, ddtUInt, ddtDateTime, ddtFloat,
ddtUFloat, ddtBoolean, ddtDate, ddtTime);
// 业务的进出口类型
type
TBlType = (btInPort, btOutPort);
// 业务的完船状态
type
TBlFinishVessel = (bfvFinished, bfvUnFinished, bfvAll);
// 应用程序调用模块
TLoadDllProc = function(hAppHandle: THandle; hParentHandle: THandle;
oForm: TForm; oADOConnection: TADOConnection; sUserName: string;
sPassWord: string; sFuncName: string): THandle; stdcall;
// 通用串口组建信息记录结构体
type
TRs232ComConfig = record
// 端口
iCommport: Smallint;
// 设置
sSettings: string;
// 比特率
sBaudRate: string;
// 奇偶校验位
sParity: string;
// 数据位
sByteSize: string;
// 停止位
sStopBits: string;
// 周期
iCycle: Integer;
// 当前计数器
iCount: Integer;
end;
// 通用连接数据库配置信息记录结构体
type
TDataBaseConfig = record
// 服务器名称
sServerName: string;
// 数据库名称
sDatabaseName: string;
// 数据库用户明
sUserName: string;
// 数据库用户密码
sPassWord: string;
// 数据库文件路径
sFilePath: string;
// 数据库类型
sDBType: string;
// 数据库连接字符串
sConnectionString: string;
// 是否已经连接
bConnect: Boolean;
end;
// 通用网络设置信息
type
TNetWorkInfo = record
// IP地址
sIP: string;
// 掩码
sMask: string;
// 默认网关
sGateway: string;
// 计算机名称
sComputerName: string end;
// 通用树节点数据结构
type
pTreeNodeData = ^TTreeNodeData;
TTreeNodeData = record
// 节点ID
sID: string;
// 父节点ID
sPID: string;
// 关键字信息
sKeyField: string;
// 显示字信息
sDisplayField: string;
// 数据信息
sData: AnsiString;
end;
// 窗体大小/位置信息结构
TWinRect = record
// Y坐标
iTop: Integer;
// X坐标
iLeft: Integer;
// 窗体宽度
iWidth: Integer;
// 窗体高度
iHeight: Integer;
end;
// 应用程序版本信息结构体
type
TVersionInfo = record
// 应用程序版本
sVersion: string;
// 可用天数
iCanUseDayNum: Integer;
// 应用程序标题
sTitle: string;
// 公司名称
sCompanyName: string;
// 软件类型
sSoftWareType: string;
// 开发设计商
sDesigner: string;
// 技术支持商
sPowerBy: string;
end;
// 系统信息结构体
type
TSystemInfo = record
// 登录用户编号
sLoginUserNameID: string;
// 皮肤编号
iSkinIndex: Integer;
// Splash页面停留时间
iSplashDelay: Integer;
// 登录用户昵称
sLoginUserNameNick: string;
// 登录用户密码
sLoginPassWord: string;
// 登录用户组编号
sLoginGroupID: string;
// 登录用户组名称
sLoginGroupName: string;
// 登录时间
sLoginDateTime: string;
// 是否登录成功
bLoginSuccess: Boolean;
// 是否自动更新系统
bIsAutoUpdate: Boolean;
// 是否自动登录
bIsAutoLogin: Boolean;
// 是否随Window启动
//bIsAutoRun: Boolean;
// 是否超级用户
bIsAdministrator: Boolean;
// 系统标题内容
sAppCaption: string;
// 是否启用菜单模式
bIsMenuEnable: Boolean;
// 是否启用工具栏
bIsToolBarEnanble: Boolean;
// 是否启用导航菜单
bIsOutlookBarEnable: Boolean;
// 是否启用树形菜单
bIsTreeViewEnable: Boolean;
// 是否启用快捷菜单
bIsQuickButtonEnable: Boolean;
// 是否启用快捷按钮
bIsShortButtonEnable: Boolean;
// 是否记录窗体大小位置
bIsSaveFormSizePostion: Boolean;
// 是否启用模块化动态链接库模式
bIsModleDLL: Boolean;
// 是否开启系统日志
bIsSysLogEnable: Boolean;
// 是否启动导航菜单
bIsBeginHideWizardMenu: Boolean;
// 是否开启皮肤
bIsSkinEnable: Boolean;
// 系统版本信息
oVersionInfo: TVersionInfo;
// 网络信息
oNetWorkInfo: TNetWorkInfo;
// 系统相关备注
sRemark: string;
end;
// 动态菜单类
type
// 菜单类继承自object
TDynamicMenu = class
private
// 指定的窗体类实例
FForm: TForm;
// 父窗口句柄
FParentHandle: THandle;
// 保存已经建立的窗口句柄
FHandles: TStringList;
// 指定的菜单类实例
FMainMenu: TMainMenu;
// 指定系统权限表连接数据库字符串
FConStr: string;
// 数据库连接对象
FADOConnection: TADOConnection;
// 指定的Page页面
FPageControl: TRzPageControl;
// 登陆用户编码
FUserCode: string;
// 是否自动更新
FAutoUpdate: Boolean;
// 登录用户密码
FPassWord: string;
// 清除原有项
FFirstClear: Boolean;
// 加载动态库
function LoadDll(hHandle: THandle; hParentHandle: THandle; oForm: TForm;
oADOConnection: TADOConnection; sUserCode: string; sPassWord: string;
sResourceCode: string): THandle;
public
// 动态创建菜单
procedure CreateMenu;
// 释放创建的句柄
procedure Free;
// 动态菜单项的单击事件
procedure MenuItemOnClick(Sender: TObject);
// 清楚菜单子项
procedure Clear;
// 指定窗体实例属性
property Form: TForm read FForm write FForm default nil;
// 指定菜单实例属性
property MainMenu: TMainMenu read FMainMenu write FMainMenu default nil;
// 指定连接字符串属性
property ConnectionString: string read FConStr write FConStr;
// 指定数据库连接字符串
property ADOConnection
: TADOConnection read FADOConnection write FADOConnection default nil;
// 指定用户帐号属性
property UserCode: string read FUserCode write FUserCode;
// 指定用户密码属性
property PassWord: string read FPassWord write FPassWord;
// 是否清除原指定对象原有的内容
property FirstClear
: Boolean read FFirstClear write FFirstClear default true;
// 是否自动更新模块
property AutoUpdate
: Boolean read FAutoUpdate write FAutoUpdate default false;
// 父窗口句柄
property ParentHandle
: THandle read FParentHandle write FParentHandle default 0;
// PageControl页面
property PageControl
: TRzPageControl read FPageControl write FPageControl default nil;
end;
// 动态菜单类
type
// 菜单类继承自object
TDynamicPopMenu = class
private
// 指定的窗体类实例
FForm: TForm;
// 父窗口句柄
FParentHandle: THandle;
// 保存已经建立的窗口句柄
FHandles: TStringList;
// 指定的菜单类实例
FPopupMenu: TPopupMenu;
// 指定系统权限表连接数据库字符串
FConStr: string;
// 数据库连接对象
FADOConnection: TADOConnection;
// 指定的Page页面
FPageControl: TRzPageControl;
// 登陆用户编码
FUserCode: string;
// 是否自动更新
FAutoUpdate: Boolean;
// 登录用户密码
FPassWord: string;
// 清除原有项
FFirstClear: Boolean;
// 加载动态库
function LoadDll(hHandle: THandle; hParentHandle: THandle; oForm: TForm;
oADOConnection: TADOConnection; sUserCode: string; sPassWord: string;
sResourceCode: string): THandle;
public
// 动态创建菜单
procedure CreatePopupMenu;
// 释放创建的句柄
procedure Free;
// 动态菜单项的单击事件
procedure PopupItemOnClick(Sender: TObject);
// 清楚菜单子项
procedure Clear;
// 指定窗体实例属性
property Form: TForm read FForm write FForm default nil;
// 指定菜单实例属性
property PopupMenu
: TPopupMenu read FPopupMenu write FPopupMenu default nil;
// 指定连接字符串属性
property ConnectionString: string read FConStr write FConStr;
// 指定数据库连接字符串
property ADOConnection
: TADOConnection read FADOConnection write FADOConnection default nil;
// 指定用户帐号属性
property UserCode: string read FUserCode write FUserCode;
// 指定用户密码属性
property PassWord: string read FPassWord write FPassWord;
// 是否清除原指定对象原有的内容
property FirstClear
: Boolean read FFirstClear write FFirstClear default true;
// 是否自动更新模块
property AutoUpdate
: Boolean read FAutoUpdate write FAutoUpdate default false;
// 父窗口句柄
property ParentHandle
: THandle read FParentHandle write FParentHandle default 0;
// PageControl页面
property PageControl
: TRzPageControl read FPageControl write FPageControl default nil;
end;
// 动态树形菜单类
type
TDynamicTreeMenu = class
private
// 指定的窗体类实例
FForm: TForm;
// 父窗口句柄
FParentHandle: THandle;
// 父节点图标索引
FParentImageIndex: Integer;
// Page对象
FPageControl: TRzPageControl;
// 选择后图标索引
FSelImageIndex: Integer;
// 子节点图标
FChildImageIndex: Integer;
// 图标列表对象
FImageList: TImageList;
// 保存已经建立的窗口句柄
FHandles: TStringList;
// 树形控件
FTreeView: TTreeView;
// 指定系统权限表连接数据库字符串
FConStr: string;
// 数据库连接对象
FADOConnection: TADOConnection;
// 登陆用户编码
FUserCode: string;
// 登录用户密码
FPassWord: string;
// 清除原有项
FFirstClear: Boolean;
// 是否自动更新
FAutoUpdate: Boolean;
// 加载动态库
function LoadDll(sResourceCode: string): THandle;
public
// 动态创建菜单
procedure CreateTreeMenu;
// 释放创建的句柄
procedure Free;
// 动态菜单项的单击事件
procedure NodeItemOnDblClick(Sender: TObject);
// 清楚菜单子项
procedure Clear;
// 指定窗体实例属性
property Form: TForm read FForm write FForm default nil;
// 指定菜单实例属性
property TreeView: TTreeView read FTreeView write FTreeView default nil;
// 指定连接字符串属性
property ConnectionString: string read FConStr write FConStr;
// 指定数据库连接字符串
property ADOConnection
: TADOConnection read FADOConnection write FADOConnection default nil;
// 指定用户帐号属性
property UserCode: string read FUserCode write FUserCode;
// 指定用户密码属性
property PassWord: string read FPassWord write FPassWord;
// 是否清除原指定对象原有的内容
property FirstClear
: Boolean read FFirstClear write FFirstClear default true;
// 父窗口句柄
property ParentHandle
: THandle read FParentHandle write FParentHandle default 0;
// 父节点图标索引
property ParentImageIndex
: Integer read FParentImageIndex write FParentImageIndex default 1;
// 选择图标索引
property SelImageIndex
: Integer read FSelImageIndex write FSelImageIndex default 2;
// 子节点图标索引
property ChildImageIndex
: Integer read FChildImageIndex write FChildImageIndex default 3;
// 图标列表对象
property ImageList
: TImageList read FImageList write FImageList default nil;
// 是否自动更新模块
property AutoUpdate
: Boolean read FAutoUpdate write FAutoUpdate default false;
// PageControl对象
property PageControl
: TRzPageControl read FPageControl write FPageControl default nil;
end;
// 动态OutLookList菜单类
type
TDynamicOutLookMenu = class
private
// 指定的窗体类实例
FForm: TForm;
// 父窗口句柄
FParentHandle: THandle;
// Page控件
FPageControl: TRzPageControl;
// 父节点图标索引
FParentImageIndex: Integer;
// 选择后图标索引
FSelImageIndex: Integer;
// 子节点图标
FChildImageIndex: Integer;
// 图标列表对象
FImageList: TImageList;
// 保存已经建立的窗口句柄
FHandles: TStringList;
// 导航控件
FOutlookBar: TmxOutlookBarPro;
// 指定系统权限表连接数据库字符串
FConStr: string;
// 数据库连接对象
FADOConnection: TADOConnection;
// 登陆用户编码
FUserCode: string;
// 登录用户密码
FPassWord: string;
// 清除原有项
FFirstClear: Boolean;
// 自动更新
FAutoUpdate: Boolean;
// 加载动态库
function LoadDll(sResourceCode: string): THandle;
public
// 动态创建菜单
procedure CreateBarMenu;
// 释放创建的句柄
procedure Free;
// 动态菜单项的单击事件
procedure ButtonItemOnClick(Sender: TObject);
// 清楚菜单子项
procedure Clear;
// 指定窗体实例属性
property Form: TForm read FForm write FForm default nil;
// 指定菜单实例属性
property OutLookBar
: TmxOutlookBarPro read FOutlookBar write FOutlookBar default nil;
// 指定连接字符串属性
property ConnectionString: string read FConStr write FConStr;
// 指定数据库连接字符串
property ADOConnection
: TADOConnection read FADOConnection write FADOConnection default nil;
// 指定用户帐号属性
property UserCode: string read FUserCode write FUserCode;
// 指定用户密码属性
property PassWord: string read FPassWord write FPassWord;
// 是否清除原指定对象原有的内容
property FirstClear
: Boolean read FFirstClear write FFirstClear default true;
// 父窗口句柄
property ParentHandle
: THandle read FParentHandle write FParentHandle default 0;
// 父节点图标索引
property ParentImageIndex
: Integer read FParentImageIndex write FParentImageIndex default 1;
// 选择图标索引
property SelImageIndex
: Integer read FSelImageIndex write FSelImageIndex default 2;
// 子节点图标索引
property ChildImageIndex
: Integer read FChildImageIndex write FChildImageIndex default 3;
// 图标列表对象
property ImageList
: TImageList read FImageList write FImageList default nil;
// 是否自动更新模块
property AutoUpdate
: Boolean read FAutoUpdate write FAutoUpdate default false;
// PageControl页
property PageControl
: TRzPageControl read FPageControl write FPageControl default nil;
end;
// 动态快捷工具栏类
type
TDynamicToolBar = class
private
// 指定的窗体类实例
FForm: TForm;
// 父窗口句柄
FParentHandle: THandle;
// Page控件
FPageControl: TRzPageControl;
// 图标列表对象
FImageList: TImageList;
// 保存已经建立的窗口句柄
FHandles: TStringList;
// 导航控件
FToolBar: TToolBar;
// 指定系统权限表连接数据库字符串
FConStr: string;
// 数据库连接对象
FADOConnection: TADOConnection;
// 登陆用户编码
FUserCode: string;
// 登录用户密码
FPassWord: string;
// 清除原有项
FFirstClear: Boolean;
// 自动更新
FAutoUpdate: Boolean;
// 加载动态库
function LoadDll(sResourceCode: string): THandle;
public
// 动态快捷键
procedure CreateToolBar;
// 释放创建的句柄
procedure Free;
// 动态ToolBar子项的单击事件
procedure ToolBarItemOnClick(Sender: TObject);
// 指定窗体实例属性
property Form: TForm read FForm write FForm default nil;
// 指定工具组件实例
property ToolBar: TToolBar read FToolBar write FToolBar default nil;
// 指定连接字符串属性
property ConnectionString: string read FConStr write FConStr;
// 指定数据库连接字符串
property ADOConnection
: TADOConnection read FADOConnection write FADOConnection default nil;
// 指定用户帐号属性
property UserCode: string read FUserCode write FUserCode;
// 指定用户密码属性
property PassWord: string read FPassWord write FPassWord;
// 图标列表对象
property ImageList
: TImageList read FImageList write FImageList default nil;
// 是否自动更新模块
property AutoUpdate
: Boolean read FAutoUpdate write FAutoUpdate default false;
// PageControl页
property PageControl
: TRzPageControl read FPageControl write FPageControl default nil;
end;
type
TDynamicBLTree = class(TThread)
private
// 指定的窗体类实例
FForm: TForm;
// 父节点图标索引
FParentImageIndex: Integer;
// 选择后图标索引
FSelImageIndex: Integer;
// 子节点图标
FChildImageIndex: Integer;
// 图标列表对象
FImageList: TImageList;
// 树形控件
FTreeView: TTreeView;
// 数据库连接对象
FADOConnection: TADOConnection;
// 要查找的船名
FFindVessel: string;
// 要查找的航次
FFindVoyage: string;
// 要查找的提单
FFindBlNo: string;
// 选择树的深度
FSelectLevel: Integer;
// 显示进出口标识
FInOutPort: TBlType;
// 显示完船标识
FFinishedVessel: TBlFinishVessel;
// 船名代码
FVesselCode: string;
// 船名名称
FVesselName: string;
// 航次代码
FVoyageID: string;
// 航次编码
FVoyageName: string;
// 是否锁定
FIsLock: string;
// 是否完船
FIsFinishedVessel: string;
// 进出口标识
FIO: string;
// 主单编号
FMBlID: string;
// 主单编码
FMBlNo: string;
// 提单编号
FBlID: string;
// 提单编码
FBlNo: string;
// 是否锁定提单
FIsLockBl: string;
// 清除原有项
FFirstClear: Boolean;
// 同步数据信息
procedure SynchData;
// 异步数据信息
procedure AsynchData;
// 线程执行
procedure Execute; override;
public
// 选择前事件
procedure OnChanging(Sender: TObject; Node: TTreeNode;
var AllowChange: Boolean);
// 查找当前的数据
function FindNodesInfo: Boolean;
// 清楚菜单子项
procedure Clear;
// 指定窗体实例属性
property Form: TForm read FForm write FForm default nil;
// 指定菜单实例属性
property TreeView: TTreeView read FTreeView write FTreeView default nil;
// 指定数据库连接字符串
property ADOConnection
: TADOConnection read FADOConnection write FADOConnection default nil;
// 要查找的船名信息
property FindVessel: string read FFindVessel write FFindVessel;
// 要查找的航次信息
property FindVoyage: string read FFindVoyage write FFindVoyage;
// 要查找的提单信息
property FindBlNo: string read FFindBlNo write FFindBlNo;
// 显示的内容是否为指定的进出口信息
property InOutPort
: TBlType read FInOutPort write FInOutPort default btOutPort;
// 显示的内容是否为完船信息
property FinishedVessel
: TBlFinishVessel read FFinishedVessel write FFinishedVessel default
bfvUnFinished;
// 选择树层度
property SelectLevel
: Integer read FSelectLevel write FSelectLevel default 0;
// 是否清除原指定对象原有的内容
property FirstClear
: Boolean read FFirstClear write FFirstClear default true;
// 父节点图标索引
property ParentImageIndex
: Integer read FParentImageIndex write FParentImageIndex default 1;
// 选择图标索引
property SelImageIndex
: Integer read FSelImageIndex write FSelImageIndex default 2;
// 子节点图标索引
property ChildImageIndex
: Integer read FChildImageIndex write FChildImageIndex default 3;
// 图标列表对象
property ImageList
: TImageList read FImageList write FImageList default nil;
// 当前选择的船名
property SelectedVesselName: string read FVesselName;
// 当前选择的船名编码
property SelectedVesselCode: string read FVesselCode;
// 当前选择的航次编码
property SelectedVoyageID: string read FVoyageID;
// 当前选择的航次名称
property SelectedVoyageName: string read FVoyageName;
// 当前选择的主提单号
property SelectedMBlID: string read FMBlID;
// 当前选择的提单号
property SelectedBlID: string read FBlID;
// 当前选择的主题单编码
property SelectedMBlNo: string read FMBlNo;
// 当前选择的提单编码
property SelectedBlNo: string read FBlNo;
// 当前选择的进出口信息
property SelectedIO: string read FIO;
// 当前选择的提单是否被锁定
property SelectedIsLockBl: string read FIsLockBl;
end;
{ ********************************************************************** }
{ Custom Function Area }
{ 用户自定义函数区域 }
{ ********************************************************************** }
{ 自定义消息对话框 sInfo:信息内容, iTag:图标按钮值, hAppHandle:窗体句柄 返回:对话框对应类型值 }
function cf_sysMsgBox(sInfo: string; iTag: Integer = 0; hAppHandle: HWND = 0)
: Integer;
{ 获取系统能够临时文件目录 返回:系统临时文件夹. }
function cf_sysGetTempPath: string;
{ 加密函数（可逆向解密） }
function cf_valEncryptCodeA(sSource: string): string;
{ 解密函数（可逆向加密） }
function cf_valUnEncryptCodeA(strCode: string): string;
{ 加密函数（可逆向解密） }
function cf_valEncryptCode(sStr: string; sKey: string = CONST_VAL_REGCODE)
: string;
{ 解密函数（可逆向加密） }
function cf_valDecryptCode(sStr: string; sKey: string = CONST_VAL_REGCODE)
: string;
{ 加密函数 MD5加密 }
function cf_valMD5Encrypt(sSourceCode: string): string;
{ Base64 加密 }
function cf_valBase64Encode(const sSource: AnsiString): AnsiString;
{ Base64 解密 }
function cf_valBase64Decode(const sSource: AnsiString): AnsiString;
{ 获取文件的MD5值 }
function cf_fileGetFileMD5(sFileFullName: string): string;
{ 比较文件是否和指定的MD5值是否相同 }
function cf_fileGetFileMD5Math(sFileName, sMD5Value: string): Boolean;
{ 比较两个文件是否相同 }
function cf_fileGetFileMD5Same(sFileName1, sFileName2: string): Boolean;
{ 计算一个字符串的加法算法 }
function cf_valStringAdd(sStr: string): string;
{ 计算一个字符串的减法算法 }
function cf_valStringSub(sStr: string): string;
{ 计算一个字符串的乘法算法 }
function cf_valStringMul(sStr: string): string;
{ 计算一个字符串的除法算法 }
function cf_valStringDiv(sStr: string): string;
{ 获取字符串的第一个数据 }
function cf_valStringGetFirst(sStr: string): string;
{ 获取字符串的最后一个数据 }
function cf_valStringGetLast(sStr: string): string;
{ 计算字符串数学公式(不支持括号优先级) }
function cf_valStringExpression(sStr: string): string;
{ 设置信息到INI文件中 }
function cf_fileSetINIValue(sSection, sIdent, sValue: string): Boolean;
{ 读取INI文件中得信息. }
function cf_fileGetINIValue(sSection, sIdent: string): string;
{ 删除INI文件 }
function cf_fileDeleteINIFile: Boolean;
{ 更换皮肤 }
function cf_sysChangeSkin(var oSkinData: TSkinData;
var oSkinStore: TSkinStore; iSkinFile: Integer = CONST_SYS_SKININDEX)
: Boolean;
{ 设置信息到注册表 }
function cf_regSetRegValue(sSection, sIdent, sValue: string): Boolean;
{ 读取指定的注册表信息值 }
function cf_regGetRegValue(sSection, sIdent: string): string;
{ 删除指定的注册表信息 }
function cf_regDeleteRegValue(sSection, sIdent: string): Boolean;
{ 判断字符串是否为整数（无正负号） }
function cf_valStrIsUInt(sStr: string): Boolean;
{ 判断字符串是否为整数(可带正负号). }
function cf_valStrIsInt(sStr: string): Boolean;
{ 判断字符串是否为浮点型（无正负号） }
function cf_valStrIsUFloat(sStr: string): Boolean;
{ 判断字符串是否为浮点型(可带正负号) }
function cf_valStrIsFloat(sStr: string): Boolean;
{ 判断字符串是否为布尔值 }
function cf_valStrIsBool(sStr: string): Boolean;
{ 判断字符串是否为日期时间 }
function cf_valStrIsDateTime(sStr: string): Boolean;
{ 判断字符串是否为日期 }
function cf_valStrIsDate(sStr: string): Boolean;
{ 获取连接数据库服务器配置信息 }
function cf_fileGetDBConInfo(var oDataBaseConfig: TDataBaseConfig;
iIndex: Integer = 1): Boolean;
{ 设置系统信息 }
function cf_fileSetSystemInfo(oSystemInfo: TSystemInfo; iIndex: Integer = 1)
: Boolean;
{ 获取系统信息 }
function cf_fileGetSystemInfo(var oSystemInfo: TSystemInfo;
iIndex: Integer = 1): Boolean;
{ 设置连接数据库服务器配置信息 }
function cf_fileSetDBConInfo(oDataBaseConfig: TDataBaseConfig;
iIndex: Integer = 1): Boolean;
{ 浮点型数字转换为人民币大写字符串 rValue:浮点型变量 返回:字符串变量 }
function cf_valRealToRMB(rValue: Real): WideString;
{ 设置(RS232)配置相关信息 }
function cf_fileSetRs232ComConfig(oRs232ComConfig: TRs232ComConfig;
iIndex: Integer = 1): Boolean;
{ 读取(RS232)配置相关信息 }
function cf_fileGetRs232ComConfig(var oRs232ComConfig: TRs232ComConfig;
iIndex: Integer = 1): Boolean;
{ 从注册表枚举串口信息装载到Combobox内 }
function cf_sysSetComBoboxPorts(oComboBox: TComboBox;
bAutoClear: Boolean = true): Boolean;
{ 替换字符串函数 }
function cf_valReplaceStr(sSource, sSeparator, sChangeStr: string): string;
{ 检测文件是否正在使用 }
function cf_fileIsFileInUse(sFileName: string): Boolean;
{ 获取汉字拼音简写 }
function cf_valGetPinYin(strHZ: AnsiString): string;
{ 获取操作系统版本信息 }
function cf_sysGetOSVersion: string;
{ 获取操作系统语言字符串 }
function cf_sysGetOSLanguage: string;
{ 获取操作系统内存(KB) }
function cf_hardGetOSMemory: string;
{ 系统是否存在打印机 }
function cf_hardIsExistsPrinter: Boolean;
{ 查找并打开可用的窗体已注册类模块 }
function cf_sysShowFormClass(oParentForm: TForm;
oPageControl: TRzPageControl; sFormName: string; iTag: Integer = 0)
: Boolean;
{ 获取Access2000密码 }
function cf_fileGetAccess2KPwd(sFileName: string): string;
{ 计算两个日期时间的差 }
function cf_dateGetDateTimeDiff(oDate1, oDate2: TDateTime;
iDiffType: Integer = 0): Double;
{ 向IE菜单注册信息 }
function cf_sysRegisryIEMenu(sMenuCaption, sLinkStr: string): Boolean;
{ 注册关联的文件 }
function cf_sysRegFileJoint(sCaption, sFile, sExeFile: string): Boolean;
{ 气泡提示 }
function cf_gdiBallonHits(objCompoent: TWinControl; sCaption: PWideChar;
sText: PWideChar; iIcon: Integer = 1; iDelay: Integer = 30;
tBgColor: TColor = 0; tFgColor: TColor = 0): Boolean;
{ 简体转变为繁体字 }
function cf_valGBToCht(GBStr: string): AnsiString;
{ 繁体转变为简体字 }
function cf_valChtToGB(ChtStr: string): AnsiString;
{ 取得某月的第一天的日期 }
function cf_dateGetMonthFirstDate(oDate: TDate): TDate;
{ 取得某月的最后一天的日期 }
function cf_dateGetMonthLastDate(aDate: TDate): TDate;
{ 发送邮件 }
function cf_netSMTPSendMail(FromAddress, ToAddress, ASubject,
MsgBody: string; sHous, sUsn, sPwd: string): Boolean;
{ 设置窗体关闭按钮状态 }
function cf_sysSetFormCloseBtnStatus(Handle: HWND; bExpires: Boolean = false)
: Boolean;
{ BMP图片文件转换为JPG图片文件 }
function cf_gdiConvertBMPtoJPG(sFileName, sToFileName: string): Boolean;
{ JPG图片文件转换为BMP图片文件 }
function cf_gdiConvertJPGtoBMP(sFileName, sToFileName: string): Boolean;
{ 隐藏桌面图标 }
function cf_sysHideDesktop: Boolean;
{ 显示桌面图标 }
function cf_sysShowDesktop: Boolean;
{ 获取Windows Product ID产品序号 }
function cf_sysGetWindowsProductID: string;
{ 将字节(255数 10)转化为2进制字符串 }
function cf_valByteToBin(Value: Byte): string;
{ 字符串转化为16进制字符串. }
function cf_valStrToHex(AStr: string): string;
{ 创建快捷方式 }
function cf_sysCreateShortCut(sFileName: string; sDisplayName: string)
: Boolean;
{ 16进制字符串转化为字符串. }
function cf_valHexToStr(AStr: string): string;
{ 移动文件 }
function cf_fileMoveFile(sName, dName: string): Boolean;
{ 设置屏幕分辨率 }
function cf_hardSetMonitorResolution(Width, Height: Word): Boolean;
{ 判断声卡是否存在 }
function cf_hardIsSoundCardExist: Boolean;
{ 获取当前CPU频率 }
function cf_hardGetCPUSpeed: Double;
{ 获取CPU的个数 }
function cf_hardGetCPUNum: string;
{ 获取CPU的核心架构 }
function cf_hardGetCPUArchitec: string;
{ 获取CPU的型号 }
function cf_hardGetCPUTypeNo: string;
{ 获取域信息 }
function cf_sysGetDomain: string;
{ 根据应用程序名获取进程ID }
function cf_sysGetAppProcessID(sAppExeName: string): Cardinal;
{ 根据sAppExeName杀死应用程序进程 }
function cf_sysKillProcess(sAppExeName: string): Boolean; overload;
{ 根据进程ID号杀死应用程序进程 }
function cf_sysKillProcess(cProcessID: Cardinal): Boolean; overload;
{ 获取当前系统的Windows目录 }
function cf_sysGetWindowsPath: string;
{ 获取数据库服务器系统时间 返回字符串 }
function cf_dbGetSysTime(oADOConnection: TADOConnection = nil;
sFormat: string = 'YYYY-MM-DD HH:MM:SS'): string; overload;
{ 获取指定磁盘的空间大小以及空闲大小. }
function cf_sysGetDiskSpace(sDriver: string; var TotalBytes,
TotalFree: Double): string;
{ 获取指定日期时间的中文周次 }
function cf_dateGetCHWeek(aDate: TDateTime): string;
{ 获取计算机名 }
function cf_sysGetComputerName: string;
{ 获取IP地址 }
function cf_sysGetIPAddress: string;
{ StringGrid导出Excel }
function cf_dbGridExportExcel(oStringGrid: TStringGrid; sFileName: string;
Handle: HWND): Boolean;
{ ADOQuery导出Excel }
function cf_dbADOQueryExportExcel(oADOQuery: TADOQuery; sFileName: string;
Handle: HWND): Boolean;
{ Excel导入数据ADOQuery }
function cf_dbExcelImportADOQuery(oADOQuery: TADOQuery; sTableName: string;
Handle: HWND; bHasAutoID: Boolean = false): Boolean;
{ 取表字段最大值 }
function cf_dbGetFieldMaxValue(sTable: string; sField: string;
sCondition: string = ''; sDefaultValue: string = '';
oADOConnection: TADOConnection = nil): string; overload;
{ 显示窗体 }
function cf_sysShowForm(aTForm: TFormClass; aPTForm: TForm;
iTag: Integer = 0; tStyle: Integer = 0): TModalResult;
{ 查找指定菜单名的菜单实例 strMenuName:菜单名 oForm:窗体实例 返回：菜单实例 }
function cf_ctrlFindMenuItem(sMenuName: string; oForm: TForm): TMenuItem;
{ 根据给定的值查找树节点信息 }
function cf_ctrlFindTreeNodeItem(oTreeView: TTreeView; sFindValue: string;
oFindType: TctvResultType = ctvResultID): Boolean;
{ 得到所有子目录文件列表 }
function cf_fileGetAllSubDirList(sDirectory: string; tRetList: TComboBox)
: Boolean;
{ SQL查询 }
function cf_dbADOQuerySelectSQL(sSQL: string; oADOQuery: TADOQuery;
oADOConnection: TADOConnection = nil): Boolean; overload;
{ SQL查询 }
function cf_dbSelectSQL(var oClientDataSet: TClientDataSet; sSQL: string;
oADOConnection: TADOConnection = nil): Boolean; overload;
{ SQL查询 }
function cf_dbSelectSQL(var oADOQuery: TADOQuery; sSQL: string): Boolean;
overload;
{ SQL查询 }
function cf_dbSelectSQL(sSQL: string; oADOConnection: TADOConnection = nil)
: TADOQuery; overload;
{ 是否安装SQLServer }
function cf_dbIsInstalledSql: Boolean;
{ 附加数据库 }
function cf_dbAttachDB(sDBName, sMDFFileName, sLOGFileName: string;
oADOConnection: TADOConnection = nil): Boolean;
{ 分离数据库 }
function cf_dbDetachDB(sDBName: string; bIsSkipChecks: Boolean;
oADOConnection: TADOConnection = nil): Boolean;
{ 获取局域网中所有的SQLServer服务器名列表 }
function cf_dbGetSQLServerList: TStringList;
{ 获取表图片字段返回图片类 }
function cf_dbGetJpegFieldValue(oDataSet: TDataSet; FieldName: string)
: TJPEGImage; overload;
{ 打开或关闭光驱 }
function cf_hardCDRomSwitch(bOpen: Boolean): Boolean;
{ 关闭外部应用程序 }
function cf_sysCloseAssignApp(sAppName: string): Boolean;
{ 执行SQL 返回影响记录数 }
function cf_dbExeSQLNum(oADOQuery: TADOQuery; sSQL: string): Integer;
overload;
{ 执行SQL 返回执行记录数 }
function cf_dbExeSQLNum(sSQL: string; oADOConnection: TADOConnection = nil)
: Integer; overload;
{ 执行多个Sql语句 返回执行是否成功 }
function cf_dbExeSQLs(oADOQuery: TADOQuery; oSqls: TStringList): Boolean;
overload;
{ 执行多个Sql语句 返回执行是否成功 }
function cf_dbExeSQLs(oSqls: TStringList;
oADOConnection: TADOConnection = nil): Boolean; overload;
{ 事务执行多个Sql语句 返回执行是否成功 }
function cf_dbExeSQLsTrans(sSqls: String;
oADOConnection: TADOConnection = nil): Boolean; overload;
{ 执行SQL 返回是否执行成功 }
function cf_dbExecSQL(sSQL: string; oADOConnection: TADOConnection = nil)
: Boolean; overload;
{ 执行SQL 返回是否执行成功 }
function cf_dbExecSQL(var oADOQuery: TADOQuery; sSQL: string): Boolean;
overload;
{ 查询SQL 获取指定SQL查询语句和返回字段名的字段值信息默认为空。 }
function cf_dbGetSqlFieldValue(sSQL: string; sFieldName: string;
sResultValue: string = ''; oADOConnection: TADOConnection = nil): string;
{ 查询获取指定表,字段,条件,关键字段名 的字段值信息。 }
function cf_dbGetTableFieldValue(sTableName, sFieldName, sCondition: string;
sDefault: string = ''; oADOConnection: TADOConnection = nil): string;
{ 获取指定目录的大小 }
function cf_sysGetDirectorySize(sDirectory: string): Integer;
{ 执行SQL语句填充 TComBobox组件 }
function cf_dbSQLFillComboBox(oComboBox: TComboBox; sListField: string;
sSQLStr: string; bFirstClear: Boolean = true;
oADOConnection: TADOConnection = nil): Boolean; overload;
{ 获取指定表,字段，前缀的表流水号 如“RKD20070813000000001"的流水号。 定长 }
function cf_dbGetMaxSN(sTable, sField, sQZ: string; aDate: TDateTime;
bInc: Boolean = true; oADOConnection: TADOConnection = nil): string;
{ 自动注册工程窗体模块 sProjectFileName:工程文件名 }
function cf_operAutoRegFormClass(sProjectFileName: string;
oADOConnection: TADOConnection = nil): Boolean;
{ 检测网络状态 }
function cf_netCheckNetStatus(IpAddr: string): Boolean;
{ 获取指定文件的大小 }
function cf_fileGetFileSize(sFileName: string): Double;
{ 设置文件是否只读 }
function cf_fileSetFileReadOnly(sFileName: string; bYes: Boolean = true)
: Boolean;
{ 获取进程列表信息 }
function cf_sysGetProcessList(sItems: TStrings): Boolean;
{ 计算X的Y次方 }
function cf_valXYSqu(X: Double; Y: Integer): Double;
{ 设备系统喇叭控制 }
function cf_hardDoBeep(Freq: Word; Sec: Longint): Boolean;
{ 打开指定的URL 窗口 }
function cf_sysOpenURL(sURL: string): Boolean;
{ 获取唯一的GUID字符串 }
function cf_valGetGUIDString: string;
{ 返回是否安装过BDE组件 }
function cf_sysIsInstalledBDE: Boolean;
{ 在窗体中查找是否有重复出现的子窗体 }
function cf_ctrlFindOwerChildForm(oOwerForm: TForm; sModuleName: string)
: Boolean;
{ 压缩Access数据库 }
function cf_fileCompactAccessDB(sDBFile: string): Boolean;
{ 获取本机MAC地址 }
function cf_netGetMacAddress: string;
{ 返回硬盘编号字符串 }
function cf_hardGetIDESerialID: string;
{ 获取屏幕刷新率 返回：当前刷新率 }
function cf_sysGetScreenFrequency: Integer;
{ 获取屏幕刷新率 }
function cf_sysGetScreenWidthHeight(var iWidth, iHeight: Integer): Boolean;
{ 动态设置分辨率 }
function cf_sysSetScreenWidthHeight(wWidth, wHeight: Word): Boolean;
{ 获取屏幕刷新率 }
function cf_sysSetScreenFrequency(iFrqcy: Integer): Boolean;
{ 将字符串过滤为单字节字符 }
function cf_valGetSingleString(sString: string): string;
{ 播放WAV声音文件 }
function cf_sysPlayWavFile(sFileName: string): Boolean;
{ 获取应用程序目录 }
function cf_sysGetAppPath: string;
{ 查找TStrings中是否存在指的内容. }
function cf_clsStringsExist(oStrings: TStrings; sName, sValue: string)
: Boolean;
{ 判断ListItems中是否存在要查找的内容 }
function cf_clsListExistItem(oListItems: TListItems; sValue: string): Boolean;
{ 判断TreeNodes中是否存在要查找的内容 }
function cf_clsTreeViewExistNode(oTreeNodes: TTreeNodes; sValue: string)
: Boolean;
{ 设置系统是否自动启动应用程序 }
//function cf_sysAppAutoRun(bYes: Boolean): Boolean;
{ 根据连接和表名/字段名返回字段值连接的字符串 }
function cf_dbGetFieldsLinkStr(sConStr: string; sTable: string;
sField: string; sCondition: string = ''; sDefaultval: string = '';
sLinkStr: string = ','): string; overload;
{ 根据连接和表名/字段名返回字段值连接的字符串 }
function cf_dbGetFieldsLinkStr(oADOConnection: TADOConnection;
sTable: string; sField: string; sCondition: string = '';
sDefaultval: string = ''; sLinkStr: string = ','): string; overload;
{ 获得长度为iLen的sStr的字符串，长度不够则依据IsFronted即在前面还是后面补字符sFixStr,默认用'0'补充 }
function cf_valGetFixedLenStr(sStr: string; iLen: Smallint;
sFixStr: string = '0'; bIsFronted: Boolean = true): string;
{ 数据填充无级Cn树 }
function cf_dbFillNoLevelCnCheckTreeView(oCnCheckTreeView: TCnCheckTreeView;
sSQL: string; sDisplayField: string; sKeyFields: string;
bFirstClear: Boolean = true; oADOConnection: TADOConnection = nil)
: Boolean; overload;
{ 获取Cn树点击节点的内容信息 }
function cf_ctrlGetCnCheckTreeViewNodeData
(oCnCheckTreeView: TCnCheckTreeView;
oResultType: TctvResultType = ctvResultData): AnsiString;
{ 获取树点击节点的内容信息 }
function cf_ctrlGetTreeViewNodeData(oTreeView: TTreeView;
oResultType: TctvResultType = ctvResultData): AnsiString;
{ 取字符串中以分隔符为中心的第几个分隔符的前字符串 }
function cf_valGetStrPosStr(sSourceString: string; iPosition: Integer = 1;
sSplintString: string = CONST_VAL_SPLIT): string;
{ 取字符串中分割字符串个数 }
function cf_valGetStrPosNum(sSourceString: string;
sSplintString: string = CONST_VAL_SPLIT): Integer;
{ 数据填充分级Cn树 }
function cf_dbFillLevelCnCheckTreeView(oCnCheckTreeView: TCnCheckTreeView;
sSQL: string; sDisplayField: string; sKeyField: string;
sIDFieldName: string; sPIDFieldName: string; bFirstClear: Boolean = true;
oADOConnection: TADOConnection = nil): Boolean; overload;
{ 数据填充无级树 }
function cf_dbFillNoLevelTreeView(oTreeView: TTreeView; sSQL: string;
sDisplayField: string; sKeyFields: string; bFirstClear: Boolean = true;
oADOConnection: TADOConnection = nil): Boolean; overload;
{ 保存系统操作日志 }
function cf_sysLog(sLogInfo: string; bIsErrLog: Boolean = true): Boolean;
{ 获取Cn树选择CheckBox为“√”的所有项目返回Strings }
function cf_ctrlGetCnTreeViewCheckedItemsData
(oCnCheckTreeView: TCnCheckTreeView;
oResultType: TctvResultType = ctvResultData): TStringList; overload;
{ 获取cn树选择Checked框节点的内存表数据 }
function cf_dbGetCnTreeViewCheckedItems(oCnCheckTreeView: TCnCheckTreeView)
: TClientDataSet; overload;
{ 数据填充分级树 }
function cf_dbFillLevelTreeView(oTreeView: TTreeView; sSQL: string;
sDisplayField: string; sKeyField: string; sIDFieldName: string;
sPIDFieldName: string; bFirstClear: Boolean = true;
oADOConnection: TADOConnection = nil): Boolean; overload;
{ 获取表字段记录数 }
function cf_dbGetTableRecordCount(sTableName: string;
sCondition: string = ''; oADOConnection: TADOConnection = nil): Integer;
overload;
{ 新增用户 }
function cf_operNewUser(sUserCode: string; sUserName: string;
sPassWord: string; oADOConnection: TADOConnection = nil): Boolean; overload;
{ 查询用户是否合法 }
function cf_operCheckUser(sUserCode: string; sPassWord: string;
oADOConnection: TADOConnection = nil; bEncrypt: Boolean = false): Boolean;
overload;
{ 修改用户密码 }
function cf_operModifyUserPassWord(sUserCode: string; sOldPassWord: string;
sNewPassWord: string; oADOConnection: TADOConnection = nil): Boolean;
overload;
{ 服务器端更新文件 }
function cf_operUploadDllFiles(sResourceFileName: string;
oADOConnection: TADOConnection = nil): Boolean;
{ 客户动态库更新 }
function cf_operUpdateDllFiles(sUserCode: string; sPassWord: string;
sFuncName: string; oADOConnection: TADOConnection = nil): Boolean; overload;
{ 固定业务填充列表 }
function cf_operFillCombobox(oComboBox: TComboBox; iOperType: Integer)
: Boolean;
{ 固定业务填充TStrings }
function cf_operFillStrings(oStrings: TStrings; iOperType: Integer): Boolean;
{ 根据指定的费用内容设置列表显示信息 }
function cf_operSetComboboxValue(var oComboBox: TComboBox; sValue: string;
iOperType: Integer): Boolean;
{ 根据给定的业务数据值返回显示的文本信息 }
function cf_operGetValueDisplayText(const sValue: string; iOperType: Integer)
: string;
{ 根据给定的业务显示的文本信息返回数据值 }
function cf_operGetDisplayTextValue(const sDisplayText: string;
iOperType: Integer): string;
{ 根据选择的内容返回选择的内容 }
function cf_operGetComboboxValue(var oComboBox: TComboBox; iOperType: Integer)
: string;
{ 清空指定的控件数组 }
function cf_ctrlSetEmpty(const oControls: array of TObject): Boolean;
{ 检测指定的控件数组 提示则使用控件的Hint属性 }
function cf_ctrlHasEmptyValues(const oControls: array of TObject;
hHandle: HWND = 0): Boolean;
{ 检测指定的控件数组是否为指定的类型。 }
function cf_ctrlValueIsType(const oControls: array of TObject;
oDealType: TDealDataType = ddtUInt; hHandle: HWND = 0): Boolean;
{ ********************************************************************** }
{ Custom Procedure Area }
{ 用户自定义过程区域 }
{ ********************************************************************** }
{ 清空全局数据传输变量记录结构体信息. }
procedure cp_valClearListCommVar;
{ 显示Windows关于对话框 }
procedure cp_sysAppAbout;
{ 检测DEDE反编译器,只对2.5版本以后的起作用. }
procedure cp_sysAntiDeDe();
{ 隐藏应用程序的进程 }
procedure cp_HideApp;
{ 重启WINDOWS 0:关闭 1:重启 2:注销 3:关机 }
procedure cp_sysWindowsClose(iType: Smallint);
{ 打开屏幕保护 }
procedure cp_sysOpenScreenSave;
{ 程序清除自毁 }
procedure cp_sysDeleteMe;
{ 防止应用程序多次运行 }
procedure cp_sysAppMutex;
{ 重启应用程序本身 }
procedure cp_sysAppRestart;
{ 调用系统关于对话框 sTitle:标题 ; sContent:内容信息 }
procedure cp_sysWinAbout(sTitle, sContent: string);
{ 关闭显示器 }
procedure cp_sysCloseMonitor;
{ 关闭窗体时关闭多余的Tab对象实例 }
procedure cp_sysClearTabs(Sender: TObject; var Action: TCloseAction);
{ 应用程序自动启动设置 }
//procedure cp_regAppAutoRun(bYes: Boolean);
{ 保存当前窗体相关控件大小、位置信息 }
procedure cp_sysSaveFormControlInfo(oForm: TForm);
{ 获取当前窗体相关控件大小、位置信息 }
procedure cp_sysGetFormControlInfo(oForm: TForm);
{ ********************************************************************** }
{ Custom Global Variant Area }
{ 用户自定义全局变量区域 }
{ ********************************************************************** }
var
// 全局通用变量
goComVar: TListCommVar;
// 全局串口配置信息
goRs232ComConfig: TRs232ComConfig;
// 全局数据库配置信息
goMainDBConfig, goInterfaceDBConfig: TDataBaseConfig;
// 全局窗口大小、位置信息
goWinRect: TWinRect;
// 全局系统信息
goSysInfo: TSystemInfo;
// 全局数据库默认连接
goADOConDef, goADOConInterface: TADOConnection;
// 全局窗体tag字符串
goFormTag: string;
// 全局菜单对象
goMainMenu: TDynamicMenu;
// 全局Popup菜单对象
goPopupMenu: TDynamicPopMenu;
// 全局树菜单对象
goMainTreeMenu: TDynamicTreeMenu;
// 全局导航菜单对象
goMainOutLookMenu: TDynamicOutLookMenu;
// 全局工具栏对象
goMainTooBar: TDynamicToolBar;
// 全局业务树对象
goBLTree: TDynamicBLTree;
// 全局图标列表资源
goImageList: TImageList;
// 全局皮肤控件
goSkinData: TSkinData;
// 全局空时间
goNullDateTime: Double;
{ 以下是实现部分 }
implementation
// ******************************************************************************
// 函数功能: 通用对话框，与MessageBox类似，简化了一些繁琐的参数。
// 函数名称: cf_sysMsgBox
// 函数参数: sInfo String 要显示的信息
// iTag Integer 图标及按钮的一些标记
// hAppHandle LongWord 所属的窗口句柄。
// 返回值: 返回通用对话框MessageBox所返回的值
// ******************************************************************************
function cf_sysMsgBox(sInfo: string; iTag: Integer = 0; hAppHandle: HWND = 0)
: Integer;
begin
if hAppHandle = 0 then
begin
if iTag = 0 then
Result := MessageBox(Application.Handle, PWideChar(sInfo),
CONST_SYS_DIALOGTITLE, MB_OK + MB_ICONINFORMATION + MB_APPLMODAL)
else
Result := MessageBox(Application.Handle, PWideChar(sInfo),
CONST_SYS_DIALOGTITLE, iTag);
end
else
begin
if iTag = 0 then
Result := MessageBox(hAppHandle, PWideChar(sInfo), CONST_SYS_DIALOGTITLE,
MB_OK + MB_ICONINFORMATION + MB_APPLMODAL)
else
Result := MessageBox(hAppHandle, PWideChar(sInfo), CONST_SYS_DIALOGTITLE,
iTag);
end;
end;
// ******************************************************************************
// 函数功能: 加密函数（可逆向解密）
// 函数名称: gcf_EncryptCodeA
// 函数参数: sSource 预加密的字符串
// 返回值: 返回字符串加密后的内容。
// ******************************************************************************
function cf_valEncryptCodeA(sSource: string): string;
var
lsarrTemp: array of string;
i: Integer;
j: Integer;
liCount: Integer;
liRandom: Integer;
liRandomCode: Integer;
liRemain: Integer;
lsResultStr, lsLeft, lsRight, lsMiddle: string;
begin
try
Randomize;
lsResultStr := '';
if sSource = '' then
begin
Result := lsResultStr;
Exit;
end;
SetLength(lsarrTemp, Length(sSource));
liCount := 0;
liRemain := 0;
j := 0;
while Length(sSource) <> 0 do
begin
lsarrTemp[liCount] := Copy(sSource, 1, 1);
Delete(sSource, 1, 1);
Inc(liCount);
end;
for i := Low(lsarrTemp) to High(lsarrTemp) do
begin
Randomize;
liRandom := 0;
while liRandom = 0 do
liRandom := Random(1000);
liRandomCode := 0;
while liRandomCode = 0 do
begin
liRandomCode := Random(5);
if liRandomCode = 5 then
liRandomCode := 0;
end;
case liRandomCode of
1:
j := Word(lsarrTemp[i][1]) + liRandom;
2:
j := Word(lsarrTemp[i][1]) - liRandom;
3:
j := Word(lsarrTemp[i][1]) * liRandom;
4:
begin
liRandom := 0;
while liRandom = 0 do
begin
Randomize;
liRandom := Random(20);
end;
liRemain := Word(lsarrTemp[i][1]) mod liRandom;
j := Word(lsarrTemp[i][1]) div liRandom;
end;
else
end;
case liRandomCode of
1, 2, 3:
lsResultStr := lsResultStr + (IntToStr(j) + ',' + IntToStr(liRandom)
+ '.' + IntToStr(liRandomCode) + '#');
4:
lsResultStr := lsResultStr + (IntToStr(j) + ',' + IntToStr(liRandom)
+ '.' + IntToStr(liRandomCode) + '.' + IntToStr(liRemain) + '#');
else
end;
end;
lsLeft := Copy(lsResultStr, 1, 1);
lsMiddle := Copy(lsResultStr, 2, Length(lsResultStr) - 2);
lsRight := Copy(lsResultStr, Length(lsResultStr), 1);
// RLRMRA 组合
Randomize;
lsResultStr := '#' + Format('%4d', [Random(9999)])
+ lsLeft + lsRight + lsMiddle + (Format('%4d', [Random(9999)])) + '#';
Result := lsResultStr;
except
Result := '';
cf_sysLog(
'加密函数过程中失败! 错误位置:[function cf_valEncryptCodeA(sSource: string): string;]'
);
end;
end;
// ******************************************************************************
// 函数功能: 加密函数（可逆向解密）
// 函数名称: cf_valEncryptCode
// 函数参数: sStr String 预加密的字符串
// sKey stirng 密匙 （默认定义）
// 返回值: 返回字符串加密后的内容。
// ******************************************************************************
function cf_valEncryptCode(sStr: string; sKey: string = CONST_VAL_REGCODE)
: string;
var
i, j: Integer;
function StringToDisplay(mString: string): string;
var
i: Integer;
S: string;
begin
Result := '';
S := '';
for i := 1 to Length(mString) do
if mString[i] in [#32 .. #127] then
S := S + mString[i]
else
begin
if S <> '' then
begin
Result := Result + QuotedStr(S);
S := '';
end;
Result := Result + Format('#$%x', [Ord(mString[i])]);
end;
if S <> '' then
Result := Result + QuotedStr(S);
end;
begin
try
j := 1;
Result := '';
for i := 1 to Length(sStr) do
begin
Result := Result + Char(Ord(sStr[i]) xor Ord(sKey[j]));
if j + 1 <= Length(sKey) then
Inc(j)
else
j := 1;
end;
Result := StringToDisplay(Result);
except
Result := '';
cf_sysLog(
'加密函数过程中失败! 错误位置:[cf_valEncryptCode(sStr: string;sKey: string = CONST_VAL_REGCODE): string;]');
end;
end;
// ******************************************************************************
// 函数功能: 解密函数（可逆向加密）
// 函数名称: cf_valDecryptCode
// 函数参数: strCode 预解密的字符串
// sKey 密匙 （预定义）
// 返回值: 返回录入字符串解密后的内容。
// ******************************************************************************
function cf_valDecryptCode(sStr: string; sKey: string = CONST_VAL_REGCODE)
: string;
var
i, j: Integer;
function DisplayToString(mDisplay: string): string;
var
i: Integer;
S: string;
B: Boolean;
begin
Result := '';
B := false;
mDisplay := mDisplay;
for i := 1 to Length(mDisplay) do
if B then
case mDisplay[i] of
'''':
begin
if S <> '' then
Result := Result + StringReplace
(S, '''''', '''', [rfReplaceAll]);
if Copy(mDisplay, i + 1, 1) = '''' then
Result := Result + '''';
S := '';
B := false;
end;
else
S := S + mDisplay[i];
end
else
case mDisplay[i] of
'#', '''':
begin
if S <> '' then
Result := Result + Chr(StrToIntDef(S, 0));
S := '';
B := mDisplay[i] = '''';
end;
'$', '0' .. '9', 'a' .. 'f', 'A' .. 'F':
S := S + mDisplay[i];
end;
if (not B) and (S <> '') then
Result := Result + Chr(StrToIntDef(S, 0));
end; { DisplayToString }
begin
j := 1;
Result := '';
try
sStr := DisplayToString(sStr);
for i := 1 to Length(sStr) do
begin
Result := Result + Char(Ord(sStr[i]) xor Ord(sKey[j]));
if j + 1 <= Length(sKey) then
Inc(j)
else
j := 1;
end;
except
Result := '';
cf_sysLog(
'解密函数过程中失败! 错误位置:[cf_valDecryptCode(sStr: string;sKey: string = CONST_VAL_REGCODE): string;]');
end;
end;
// ******************************************************************************
// 函数功能: 解密函数（可逆向加密）
// 函数名称: cf_valUnEncryptCodeA
// 函数参数: strCode 预解密的字符串
// 返回值: 返回录入字符串解密后的内容。
// ******************************************************************************
function cf_valUnEncryptCodeA(strCode: string): string;
var
liCount: Integer;
i: Integer;
sData1: string;
sData2: string;
sData3: string;
sData4: string;
lsTempStr: string;
lsResultStr, lsLeft, lsRight, lsMiddle, lsFullStr: string;
begin
{ 若目标字符串为空字符串，则返回空的解密字符串 }
try
if strCode = '' then
lsResultStr := '';
liCount := 0;
// 字符串长度是否为偶数
strCode := Copy(strCode, 6, Length(strCode) - 10);
lsLeft := Copy(strCode, 1, 1);
lsRight := Copy(strCode, 2, 1);
lsMiddle := Copy(strCode, 3, Length(strCode));
// RLM 组合
lsFullStr := lsLeft + lsMiddle + lsRight;
for i := 1 to Length(lsFullStr) do
if Copy(lsFullStr, i, 1) = '#' then
Inc(liCount);
if liCount = 0 then
begin
Result := lsResultStr;
Exit;
end;
while Length(lsFullStr) <> 0 do
begin
lsTempStr := Copy(lsFullStr, 1, Pos('#', lsFullStr) - 1);
Delete(lsFullStr, 1, Pos('#', lsFullStr));
sData1 := UpperCase(Copy(lsTempStr, 1, Pos(',', lsTempStr) - 1));
Delete(lsTempStr, 1, Pos(',', lsTempStr));
sData2 := Copy(lsTempStr, 1, Pos('.', lsTempStr) - 1);
Delete(lsTempStr, 1, Pos('.', lsTempStr));
if Pos('.', lsTempStr) <> 0 then
begin
sData3 := Copy(lsTempStr, 1, Pos('.', lsTempStr) - 1);
Delete(lsTempStr, 1, Pos('.', lsTempStr));
sData4 := lsTempStr;
end
else
begin
sData3 := lsTempStr;
sData4 := '';
end;
try
case StrToInt(sData3) of
1:
lsResultStr := lsResultStr + Char
(StrToInt(sData1) - StrToInt(sData2));
2:
lsResultStr := lsResultStr + Char
(StrToInt(sData1) + StrToInt(sData2));
3:
lsResultStr := lsResultStr + Char
(StrToInt(sData1) div StrToInt(sData2));
4:
lsResultStr := lsResultStr + Char
(StrToInt(sData1) * StrToInt(sData2) + StrToInt(sData4));
end;
except
Result := '';
end;
end;
Result := lsResultStr;
except
Result := '';
cf_sysLog(
'解密函数过程中失败! 错误位置:[cf_valUnEncryptCodeA(strCode: string): string;]');
end;
end;
// ******************************************************************************
// 函数功能: 字符串MD5加密
// 函数名称: cf_valMD5Encrypt
// 函数参数: sSourceCode String 要加密的字符串
// 返回值: 返回加密后的字符串
// ******************************************************************************
function cf_valMD5Encrypt(sSourceCode: string): string;
begin
try
Result := UpperCase(MD5Print(MD5StringW(sSourceCode)));
except
Result := '';
cf_sysLog(
'MD5加密函数过程中失败! 错误位置:[function cf_valMD5Encrypt(sSourceCode: string): string;]');
end;
end;
// ******************************************************************************
// 函数功能: 字符串Base64加密
// 函数名称: cf_valBase64Encode
// 函数参数: Source String 要加密的字符串
// 返回值: 返回加密后的字符串
// ******************************************************************************
function cf_valBase64Encode(const sSource: AnsiString): AnsiString;
var
NewLength: Integer;
begin
NewLength := ((2 + Length(sSource)) div 3) * 4;
SetLength(Result, NewLength);
try
asm
Push ESI
Push EDI
Push EBX
Lea EBX, CONST_VAL_BASE64CODE
Inc EBX // Move past String Size (ShortString)
Mov EDI, Result
Mov EDI, [EDI]
Mov ESI, sSource
Mov EDX, [ESI-4] // Length of Input String
@WriteFirst2:
CMP EDX, 0
JLE @Done
MOV AL, [ESI]
SHR AL, 2
{$IFDEF VER140}
// Changes to BASM in D6
XLATB
{$ELSE}
XLAT
{$ENDIF}
MOV [EDI], AL
INC EDI
MOV AL, [ESI + 1]
MOV AH, [ESI]
SHR AX, 4
AND AL, 63
{$IFDEF VER140}
// Changes to BASM in D6
XLATB
{$ELSE}
XLAT
{$ENDIF}
MOV [EDI], AL
INC EDI
CMP EDX, 1
JNE @Write3
MOV AL, 61 // Add ==
MOV [EDI], AL
INC EDI
MOV [EDI], AL
INC EDI
JMP @Done
@Write3:
MOV AL, [ESI + 2]
MOV AH, [ESI + 1]
SHR AX, 6
AND AL, 63
{$IFDEF VER140}
// Changes to BASM in D6
XLATB
{$ELSE}
XLAT
{$ENDIF}
MOV [EDI], AL
INC EDI
CMP EDX, 2
JNE @Write4
MOV AL, 61 // Add =
MOV [EDI], AL
INC EDI
JMP @Done
@Write4:
MOV AL, [ESI + 2]
AND AL, 63
{$IFDEF VER140}
// Changes to BASM in D6
XLATB
{$ELSE}
XLAT
{$ENDIF}
MOV [EDI], AL
INC EDI
ADD ESI, 3
SUB EDX, 3
JMP @WriteFirst2
@done:
Pop EBX
Pop EDI
Pop ESI
end
;
except
Result := '';
cf_sysLog(
'Base64加密函数过程中失败! 错误位置:[function cf_valBase64Encode(const sSource: AnsiString): AnsiString;]');
end;
end;
// ******************************************************************************
// 函数功能: 字符串Base64解密
// 函数名称: cf_valBase64Decode
// 函数参数: Source String 要解密的字符串
// 返回值: 返回解密后的字符串
// ******************************************************************************
function cf_valBase64Decode(const sSource: AnsiString): AnsiString;
var
NewLength: Integer;
begin
SetLength(Result, (Length(sSource) div 4) * 3);
NewLength := 0;
try
asm
Push ESI
Push EDI
Push EBX
Mov ESI, sSource
Mov EDI, Result // Result address
Mov EDI, [EDI]
Or ESI,ESI // Nil Strings
Jz @Done
Mov ECX, [ESI-4]
Shr ECX,2 // DWord Count
JeCxZ @Error // Empty String
Cld
jmp @Read4
@Next:
Dec ECX
Jz @Done
@Read4:
lodsd
Xor BL, BL
Xor EDX, EDX
Call @DecodeTo6Bits
Shl EDX, 6
Shr EAX,8
Call @DecodeTo6Bits
Shl EDX, 6
Shr EAX,8
Call @DecodeTo6Bits
Shl EDX, 6
Shr EAX,8
Call @DecodeTo6Bits
Or BL, BL
JZ @Next // No Data
Dec BL
Or BL, BL
JZ @Next // Minimum of 2 decode values to translate to 1 byte
Mov EAX, EDX
Cmp BL, 2
JL @WriteByte
Rol EAX, 8
BSWAP EAX
StoSW
Add NewLength, 2
@WriteByte:
Cmp BL, 2
JE @Next
SHR EAX, 16
StoSB
Inc NewLength
jmp @Next
@Error:
jmp @Done
@DecodeTo6Bits:
@TestLower:
Cmp AL, 'a'
Jl @TestCaps
Cmp AL, 'z'
Jg @Skip
Sub AL, 71
Jmp @Finish
@TestCaps:
Cmp AL, 'A'
Jl @TestEqual
Cmp AL, 'Z'
Jg @Skip
Sub AL, 65
Jmp @Finish
@TestEqual:
Cmp AL, '='
Jne @TestNum
// Skip byte
ret
@TestNum:
Cmp AL, '9'
Jg @Skip
Cmp AL, '0'
JL @TestSlash
Add AL, 4
Jmp @Finish
@TestSlash:
Cmp AL, '/'
Jne @TestPlus
Mov AL, 63
Jmp @Finish
@TestPlus:
Cmp AL, '+'
Jne @Skip
Mov AL, 62
@Finish:
Or DL, AL
Inc BL
@Skip:
Ret
@Done:
Pop EBX
Pop EDI
Pop ESI
end
;
SetLength(Result, NewLength); // Trim off the excess
except
Result := '';
cf_sysLog(
'Base64解密函数过程中失败! 错误位置:[function cf_valBase64Decode(const sSource: AnsiString): AnsiString;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取文件的MD5字符串
// 函数名称: cf_fileGetFileMD5
// 函数参数: sFileFullName String 文件全名.
// 返回值: 返回加密后的字符串
// ******************************************************************************
function cf_fileGetFileMD5(sFileFullName: string): string;
begin
try
Result := MD5Print(MD5File(sFileFullName));
except
Result := '';
cf_sysLog(
'获取文件的MD5函数过程中失败! 错误位置:[function cf_fileGetFileMD5(sFileFullName: string): string;]');
end;
end;
// ******************************************************************************
// 函数功能: 比较文件是否和指定的MD5值是否相同
// 函数名称: cf_fileGetFileMD5Math
// 函数参数: sFileName:String; 文件全名
// sMD5Value:String; 指定的MD5值
// 返回值: 返回文件是否和指定的MD5值相同的Boolean值
// ******************************************************************************
function cf_fileGetFileMD5Math(sFileName, sMD5Value: string): Boolean;
begin
Result := false;
try
if (Trim(sFileName) = '') or (Trim(sMD5Value) = '') then
Exit;
if cf_fileGetFileMD5(sFileName) = sMD5Value then
Result := true
else
Result := false;
except
Result := false;
cf_sysLog(
'比较文件是否和指定的MD5值是否相同函数过程中失败! 错误位置:[function cf_fileGetFileMD5Math(sFileName, sMD5Value: string): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 比较两个文件是否相同
// 函数名称: cf_fileGetFileMD5Same
// 函数参数: sFileName1:String; 文件全名1
// sFileName2:String; 文件全名2
// 返回值: 返回是否相同
// ******************************************************************************
function cf_fileGetFileMD5Same(sFileName1, sFileName2: string): Boolean;
begin
Result := false;
try
if (sFileName1 = '') or (sFileName2 = '') then
Exit;
if cf_fileGetFileMD5(sFileName1) = cf_fileGetFileMD5(sFileName2) then
Result := true
else
Result := false;
except
Result := false;
cf_sysLog(
'比较两个文件是否相同函数过程中失败! 错误位置:[function cf_fileGetFileMD5Same(sFileName1, sFileName2: string): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 处理字符串加法操作
// 函数名称: cf_valStringAdd
// 函数参数: sStr String 带有加法运算的操作.
// 返回值: 返回进行加法操作的字符串.
// ******************************************************************************
function cf_valStringAdd(sStr: string): string;
begin
try
Result := FloatToStr(StrToFloat(Copy(sStr, 0, Pos('+', sStr) - 1))
+ StrToFloat(Copy(sStr, Pos('+', sStr) + 1, Length(sStr) - 1)));
except
Result := '';
cf_sysLog(
'处理字符串加法操作函数过程中失败! 错误位置:[function cf_valStringAdd(sStr: string): string;]');
end;
end;
// ******************************************************************************
// 函数功能: 处理字符串减法操作
// 函数名称: cf_valStringAdd
// 函数参数: sStr String 带有减法运算的操作.
// 返回值: 返回进行减法操作的字符串.
// ******************************************************************************
function cf_valStringSub(sStr: string): string;
begin
try
Result := FloatToStr(StrToFloat(Copy(sStr, 0, Pos('+', sStr) - 1))
- StrToFloat(Copy(sStr, Pos('+', sStr) + 1, Length(sStr) - 1)));
except
Result := '';
cf_sysLog(
'处理字符串减法操作函数过程中失败! 错误位置:[function cf_valStringSub(sStr: string): string;]');
end;
end;
// ******************************************************************************
// 函数功能: 处理字符串乘法操作
// 函数名称: cf_valStringMul
// 函数参数: sStr String 带有乘法运算的操作.
// 返回值: 返回进行乘法操作的字符串.
// ******************************************************************************
function cf_valStringMul(sStr: string): string;
begin
try
Result := FloatToStr(StrToFloat(Copy(sStr, 0, Pos('+', sStr) - 1))
* StrToFloat(Copy(sStr, Pos('+', sStr) + 1, Length(sStr) - 1)));
except
Result := '';
cf_sysLog(
'处理字符串乘法操作函数过程中失败! 错误位置:[function cf_valStringMul(sStr: string): string;]');
end;
end;
// ******************************************************************************
// 函数功能: 处理字符串除法操作
// 函数名称: cf_valStringDiv
// 函数参数: sStr String 带有除法运算的操作.
// 返回值: 返回进行除法操作的字符串.
// ******************************************************************************
function cf_valStringDiv(sStr: string): string;
begin
try
Result := FloatToStr(StrToFloat(Copy(sStr, 0, Pos('+', sStr) - 1))
/ StrToFloat(Copy(sStr, Pos('+', sStr) + 1, Length(sStr) - 1)));
except
Result := '';
cf_sysLog(
'处理字符串除法操作函数过程中失败! 错误位置:[function cf_valStringDiv(sStr: string): string;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取字符串的第一个数据
// 函数名称: cf_valStringGetFirst
// 函数参数: sStr String 带有除法运算的操作.
// 返回值: 返回字符串第一个数据.
// ******************************************************************************
function cf_valStringGetFirst(sStr: string): string;
var
iCount: Integer;
begin
try
iCount := Length(sStr);
while (not(sStr[iCount] in ['*', '/', '-', '+']) and (iCount <> 1)) do
Dec(iCount);
if iCount = 1 then
begin
Result := sStr;
Exit;
end;
if (sStr[iCount - 1] in ['*', '/', '-', '+']) then
Result := Copy(sStr, iCount, Length(sStr) - iCount + 1)
else
Result := Copy(sStr, iCount + 1, Length(sStr) - iCount);
except
Result := '';
cf_sysLog(
'获取字符串的第一个数据函数过程中失败! 错误位置:[function cf_valStringGetFirst(sStr: string): string;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取字符串的最后一个数据
// 函数名称: cf_valStringGetLast
// 函数参数: sStr String 带有除法运算的操作.
// 返回值: 返回字符串最后一个.
// ******************************************************************************
function cf_valStringGetLast(sStr: string): string;
var
iCount: Integer;
begin
try
if sStr = '' then
Exit;
iCount := 1;
if sStr[1] = '-' then
Inc(iCount);
while not(sStr[iCount] in ['/', '*', '+', '-']) do
begin
if iCount = Length(sStr) then
Break;
Inc(iCount);
end;
if iCount = Length(sStr) then
Result := sStr
else
Result := Copy(sStr, 1, iCount - 1);
except
Result := '';
cf_sysLog(
'获取字符串的最后一个数据函数过程中失败! 错误位置:[function cf_valStringGetLast(sStr: string): string;]');
end;
end;
// ******************************************************************************
// 函数功能: 计算字符串数学公式(不支持括号优先级)
// 函数名称: cf_valStringExpression
// 函数参数: sStr String 计算字符串数学公式.
// 返回值: 返回字符串数学公式计算后的结果字符串
// ******************************************************************************
function cf_valStringExpression(sStr: string): string;
var
sStart, sEnd: string;
begin
try
while (Pos('*', sStr) <> 0) or (Pos('/', sStr) <> 0) do
begin
if ((Pos('*', sStr) < Pos('/', sStr)) and (Pos('*', sStr) <> 0)) or
(Pos('/', sStr) = 0) then
begin
sStart := Copy(sStr, 1, Pos('*', sStr) - 1);
sEnd := Copy(sStr, Pos('*', sStr) + 1, Length(sStr) - Pos('*', sStr)
);
if sStart = cf_valStringGetFirst(sStart) then
if cf_valStringGetLast(sEnd) = sEnd then
sStr := FloatToStr(StrToFloat(cf_valStringGetFirst(sStart))
* StrToFloat(cf_valStringGetLast(sEnd)))
else
sStr := FloatToStr(StrToFloat(cf_valStringGetFirst(sStart))
* StrToFloat(cf_valStringGetLast(sEnd))) + Copy
(sEnd, Length(cf_valStringGetLast(sEnd)) + 1, Length(sEnd)
- Length(cf_valStringGetLast(sEnd)))
else if cf_valStringGetLast(sEnd) <> sEnd then
sStr := Copy(sStart, 1, Length(sStart) - Length
(cf_valStringGetFirst(sStart))) + FloatToStr
(StrToFloat(cf_valStringGetFirst(sStart)) * StrToFloat
(cf_valStringGetLast(sEnd))) + Copy
(sEnd, Length(cf_valStringGetLast(sEnd)) + 1, Length(sEnd)
- Length(cf_valStringGetLast(sEnd)))
else
sStr := Copy(sStart, 1, Length(sStart) - Length
(cf_valStringGetFirst(sStart))) + FloatToStr
(StrToFloat(cf_valStringGetFirst(sStart)) * StrToFloat
(cf_valStringGetLast(sEnd)));
end
else
begin
sStart := Copy(sStr, 1, Pos('/', sStr) - 1);
sEnd := Copy(sStr, Pos('/', sStr) + 1, Length(sStr) - Pos('/', sStr)
);
if sStart = cf_valStringGetFirst(sStart) then
if cf_valStringGetLast(sEnd) = sEnd then
sStr := FloatToStr(StrToFloat(cf_valStringGetFirst(sStart))
/ StrToFloat(cf_valStringGetLast(sEnd)))
else
sStr := FloatToStr(StrToFloat(cf_valStringGetFirst(sStart))
/ StrToFloat(cf_valStringGetLast(sEnd))) + Copy
(sEnd, Length(cf_valStringGetLast(sEnd)) + 1, Length(sEnd)
- Length(cf_valStringGetLast(sEnd)))
else if cf_valStringGetLast(sEnd) <> sEnd then
sStr := Copy(sStart, 1, Length(sStart) - Length
(cf_valStringGetFirst(sStart))) + FloatToStr
(StrToFloat(cf_valStringGetFirst(sStart)) / StrToFloat
(cf_valStringGetLast(sEnd))) + Copy
(sEnd, Length(cf_valStringGetLast(sEnd)) + 1, Length(sEnd)
- Length(cf_valStringGetLast(sEnd)))
else
sStr := Copy(sStart, 1, Length(sStart) - Length
(cf_valStringGetFirst(sStart))) + FloatToStr
(StrToFloat(cf_valStringGetFirst(sStart)) / StrToFloat
(cf_valStringGetLast(sEnd)));
end;
end;
while (Pos('+', sStr) <> 0) or ((Pos('-', sStr) <> 0)) do
begin
if (((Pos('+', sStr) < Pos('-', sStr)) or (sStr[1] = '-')) and
(Pos('+', sStr) <> 0)) or (Pos('-', sStr) = 0) then
begin
sStart := Copy(sStr, 1, Pos('+', sStr) - 1);
sEnd := Copy(sStr, Pos('+', sStr) + 1, Length(sStr) - Pos('+', sStr)
);
if sStart = cf_valStringGetFirst(sStart) then
if cf_valStringGetLast(sEnd) = sEnd then
sStr := FloatToStr(StrToFloat(cf_valStringGetFirst(sStart))
+ StrToFloat(cf_valStringGetLast(sEnd)))
else
sStr := FloatToStr(StrToFloat(cf_valStringGetFirst(sStart))
+ StrToFloat(cf_valStringGetLast(sEnd))) + Copy
(sEnd, Length(cf_valStringGetLast(sEnd)) + 1, Length(sEnd)
- Length(cf_valStringGetLast(sEnd)))
else if cf_valStringGetLast(sEnd) <> sEnd then
sStr := Copy(sStart, 1, Length(sStart) - Length
(cf_valStringGetFirst(sStart))) + FloatToStr
(StrToFloat(cf_valStringGetFirst(sStart)) + StrToFloat
(cf_valStringGetLast(sEnd))) + Copy
(sEnd, Length(cf_valStringGetLast(sEnd)) + 1, Length(sEnd)
- Length(cf_valStringGetLast(sEnd)))
else
sStr := Copy(sStart, 1, Length(sStart) - Length
(cf_valStringGetFirst(sStart))) + FloatToStr
(StrToFloat(cf_valStringGetFirst(sStart)) + StrToFloat
(cf_valStringGetLast(sEnd)));
end
else
begin
if sStr[1] = '-' then
begin
if Pos('-', Copy(sStr, 2, Length(sStr) - 1)) = 0 then
begin
Result := sStr;
Exit;
end;
sStart := Copy(sStr, 1, Pos('-', Copy(sStr, 2, Length(sStr) - 1))
);
sEnd := Copy(sStr, Pos('-', Copy(sStr, 2, Length(sStr) - 1)) + 2,
Length(sStr) - Pos('-', Copy(sStr, 2, Length(sStr) - 1)) - 1);
end
else
begin
sStart := Copy(sStr, 1, Pos('-', sStr) - 1);
sEnd := Copy(sStr, Pos('-', sStr) + 1, Length(sStr) - Pos
('-', sStr));
end;
if sStart = cf_valStringGetFirst(sStart) then
if cf_valStringGetLast(sEnd) = sEnd then
sStr := FloatToStr(StrToFloat(cf_valStringGetFirst(sStart))
- StrToFloat(cf_valStringGetLast(sEnd)))
else
sStr := FloatToStr(StrToFloat(cf_valStringGetFirst(sStart))
- StrToFloat(cf_valStringGetLast(sEnd))) + Copy
(sEnd, Length(cf_valStringGetLast(sEnd)) + 1, Length(sEnd)
- Length(cf_valStringGetLast(sEnd)))
else if cf_valStringGetLast(sEnd) <> sEnd then
sStr := Copy(sStart, 1, Length(sStart) - Length
(cf_valStringGetFirst(sStart))) + FloatToStr
(StrToFloat(cf_valStringGetFirst(sStart)) - StrToFloat
(cf_valStringGetLast(sEnd))) + Copy
(sEnd, Length(cf_valStringGetLast(sEnd)) + 1, Length(sEnd)
- Length(cf_valStringGetLast(sEnd)))
else
sStr := Copy(sStart, 1, Length(sStart) - Length
(cf_valStringGetFirst(sStart))) + FloatToStr
(StrToFloat(cf_valStringGetFirst(sStart)) - StrToFloat
(cf_valStringGetLast(sEnd)));
end;
end;
Result := sStr;
except
Result := '';
cf_sysLog(
'计算字符串数学公式(不支持括号优先级)函数过程中失败! 错误位置:[function cf_valStringExpression(sStr: string): string;]');
end;
end;
// ******************************************************************************
// 函数功能: 设置信息到INI文件中
// 函数名称: cf_fileSetINIValue(sSection, sIdent, sValue: string): boolean;
// 函数参数: sSection String 小节
// sIdent String 字段
// sValue String 字段值
// 返回值: 返回是否操作成功
// ******************************************************************************
function cf_fileSetINIValue(sSection, sIdent, sValue: string): Boolean;
var
strPath: string;
oIniF: TIniFile;
begin
try
// 写配置文件
Result := false;
strPath := ExtractFilePath(ParamStr(0)) + CONST_SYS_INIFILENAME;
oIniF := TIniFile.Create(strPath);
if (sSection = '') or (sIdent = '') or (sValue = '') then
begin
Exit;
end;
try
oIniF.WriteString(sSection, sIdent, sValue);
Result := true;
finally
oIniF.Free;
end;
except
Result := false;
cf_sysLog(
'设置信息到INI文件中函数过程中失败! 错误位置:[function cf_fileSetINIValue(sSection, sIdent, sValue: string): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 读取INI文件中得信息.
// 函数名称: cf_fileGetINIValue(sSection,sIdent:String):String;
// 函数参数: sSection String 小节
// sIdent String 字段
// sValue String 字段值
// 返回值: 返回读取对应节,字段的字段值.
// ******************************************************************************
function cf_fileGetINIValue(sSection, sIdent: string): string;
var
strPath: string;
oIniF: TIniFile;
begin
try
// 写配置文件
Result := '';
strPath := ExtractFilePath(ParamStr(0)) + CONST_SYS_INIFILENAME;
oIniF := TIniFile.Create(strPath);
if (sSection = '') or (sIdent = '') then
begin
Exit;
end;
try
Result := oIniF.ReadString(sSection, sIdent, '');
finally
oIniF.Free;
end;
except
Result := '';
cf_sysLog(
'读取INI文件中得信息函数过程中失败! 错误位置:[function cf_fileGetINIValue(sSection, sIdent: string): string;]');
end;
end;
// ******************************************************************************
// 函数功能: 删除INI文件
// 函数名称: function cf_fileDeleteINIFile: Boolean;
// 函数参数: 无
// 返回值: 是否删除成功.
// ******************************************************************************
function cf_fileDeleteINIFile: Boolean;
begin
try
if FileExists(ExtractFilePath(ParamStr(0)) + CONST_SYS_INIFILENAME) then
begin
DeleteFile(ExtractFilePath(ParamStr(0)) + CONST_SYS_INIFILENAME);
Result := true;
end
else
begin
Result := false;
end;
except
Result := false;
cf_sysLog(
'删除INI文件函数过程中失败! 错误位置:function cf_fileDeleteINIFile: Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 更改应用程序皮肤
// 函数名称: cf_sysChangeSkin
// 函数参数: oSkinData:TSkinData 皮肤控制组建
// oSkinStore:TSkinStore 皮肤文件存储控件。
// iSkinFile:Integer 皮肤更换索引
// 返回值: 是否操作成功.
// ******************************************************************************
function cf_sysChangeSkin(var oSkinData: TSkinData;
var oSkinStore: TSkinStore; iSkinFile: Integer = CONST_SYS_SKININDEX)
: Boolean;
begin
Result := false;
if (oSkinData = nil) or (oSkinStore = nil) then
Exit;
if oSkinData.Active then
oSkinData.Active := false;
oSkinData.SkinFormtype := sfMainform;
try
oSkinData.LoadFromCollection(oSkinStore, iSkinFile);
oSkinData.Active := true;
Result := true;
except
Result := false;
cf_sysLog(
'更改应用程序皮肤函数过程中失败! 错误位置:[function cf_sysChangeSkin(var oSkinData: TSkinData;var oSkinStore: TSkinStore; iSkinFile: Integer = CONST_SYS_SKININDEX): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 设置信息到注册表
// 函数名称: cf_regSetRegValue(sSection,sIdent,sValue:String):boolean;
// 函数参数: sSection String 小节
// sIdent String 字段
// sValue String 字段值
// 返回值: 返回是否操作成功
// ******************************************************************************
function cf_regSetRegValue(sSection, sIdent, sValue: string): Boolean;
var
Reg: TRegistry;
begin
Result := false;
Reg := TRegistry.Create;
try
Reg.RootKey := CONST_REG_ROOTKEY;
if Reg.OpenKey(sSection, true) then
begin
try
Reg.WriteString(sIdent, sValue);
Result := true;
except
Result := false;
cf_sysLog(
'设置信息到注册表函数过程中失败! 错误位置:[function cf_regSetRegValue(sSection, sIdent, sValue: string): Boolean;]');
end;
end
else
Result := false;
finally
Reg.CloseKey;
Reg.Free;
end;
end;
// ******************************************************************************
// 函数功能: 读取指定的注册表信息值
// 函数名称: cf_regGetRegValue(sSection,sIdent,sValue:String):String;
// 函数参数: sSection String 小节
// sIdent String 字段
// 返回值: 是否操作成功
// ******************************************************************************
function cf_regGetRegValue(sSection, sIdent: string): string;
var
Reg: TRegistry;
begin
Result := '';
Reg := TRegistry.Create;
try
Reg.RootKey := CONST_REG_ROOTKEY;
if Reg.OpenKey(sSection, false) then
begin
try
Result := Reg.ReadString(sIdent);
except
Result := '';
cf_sysLog(
'读取指定的注册表信息函数过程中失败! 错误位置:[function cf_regGetRegValue(sSection, sIdent: string): string;]');
end;
end
else
Result := '';
finally
Reg.CloseKey;
Reg.Free;
end;
end;
// ******************************************************************************
// 函数功能: 删除指定的注册表信息
// 函数名称: cf_regDeleteRegValue(sSection, sIdent: string): Boolean;
// 函数参数: sSection String 小节
// sIdent String 字段
// 返回值: 是否操作成功
// ******************************************************************************
function cf_regDeleteRegValue(sSection, sIdent: string): Boolean;
var
Reg: TRegistry;
begin
Result := false;
Reg := TRegistry.Create;
try
Reg.RootKey := CONST_REG_ROOTKEY;
if Reg.OpenKey(sSection, true) then
begin
try
Reg.DeleteKey(sIdent);
Result := true;
except
Result := false;
cf_sysLog(
'删除指定的注册表信息函数过程中失败! 错误位置:[function cf_regDeleteRegValue(sSection, sIdent: string): Boolean;]');
end;
end
else
Result := false;
finally
Reg.CloseKey;
Reg.Free;
end;
end;
// ******************************************************************************
// 函数功能: 判断是字符串为整数.
// 函数名称: cf_valStrIsUInt
// 函数参数: sStr String; 被检测字符串
// 返回值: 是否为整数的Boolean值
// ******************************************************************************
function cf_valStrIsUInt(sStr: string): Boolean;
var
i: Integer;
sInfo: string;
begin
Result := false;
try
sInfo := Trim(sStr);
if sInfo = '' then
Exit;
if not(sInfo[1] in ['0' .. '9']) then
Exit;
for i := 2 to Length(sInfo) do
begin
if not(sInfo[i] in ['0' .. '9']) then
begin
Result := false;
Break;
Exit;
end;
end;
Result := true;
except
Result := false;
cf_sysLog(
' 判断是字符串为整数函数过程中失败! 错误位置:[function cf_valStrIsUInt(sStr: string): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 判断字符串是否为整数(可带正负号).
// 函数名称: cf_valStrIsInt
// 函数参数: sStr String; 被检测字符串
// 返回值: 是否为整数的Boolean值
// ******************************************************************************
function cf_valStrIsInt(sStr: string): Boolean;
var
i: Integer;
sInfo: string;
begin
Result := false;
try
sInfo := Trim(sStr);
if sInfo = '' then
Exit;
if not(sInfo[1] in ['+', '-', '0' .. '9']) then
Exit;
for i := 2 to Length(sInfo) do
begin
if not(sInfo[i] in ['0' .. '9']) then
begin
Result := false;
Break;
Exit;
end;
end;
Result := true;
except
Result := false;
cf_sysLog(
'判断字符串是否为整数(可带正负号)函数过程中失败! 错误位置:[function cf_valStrIsInt(sStr: string): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 判断字符串是否为浮点型(无符号）
// 函数名称: cf_ValStrIsUFloat
// 函数参数: sStr String; 被检测字符串
// 返回值: 是否为浮点的Boolean值
// ******************************************************************************
function cf_valStrIsUFloat(sStr: string): Boolean;
var
sInfo: string;
i, j: Integer;
begin
Result := false;
try
sInfo := Trim(sStr);
if sInfo = '' then
Exit;
if not(sInfo[1] in ['.', '0' .. '9']) then
Exit;
j := 0;
if sInfo[1] = '.' then
Inc(j);
for i := 2 to Length(sInfo) do
begin
if not(sInfo[i] in ['.', '0' .. '9']) then
begin
Exit;
end;
if (sInfo[i] = '.') then
Inc(j);
if j > 1 then
Exit;
end;
Result := true;
except
Result := false;
cf_sysLog(
'判断字符串是否为浮点型(无符号)函数过程中失败! 错误位置:[function cf_valStrIsUFloat(sStr: string): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 判断字符串是否为浮点型(带正负号）
// 函数名称: cf_valStrIsFloat
// 函数参数: sStr String; 被检测字符串
// 返回值: 是否为浮点的Boolean值
// ******************************************************************************
function cf_valStrIsFloat(sStr: string): Boolean;
var
sInfo: string;
i, j: Integer;
begin
Result := false;
try
sInfo := Trim(sStr);
if sInfo = '' then
Exit;
j := 0;
if not(sInfo[1] in ['+', '-', '.', '0' .. '9']) then
Exit;
if sInfo[1] = '.' then
Inc(j);
for i := 2 to Length(sInfo) do
begin
if not(sInfo[i] in ['.', '0' .. '9']) then
begin
Exit;
end;
if (sInfo[i] = '.') then
Inc(j);
if j > 1 then
Exit;
end;
Result := true;
except
Result := false;
cf_sysLog(
'判断字符串是否为浮点型(带正负号)函数过程中失败! 错误位置:[function cf_valStrIsFloat(sStr: string): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 判断字符串是否为布尔型
// 函数名称: cf_valStrIsBool
// 函数参数: sStr String; 被检测字符串
// 返回值: 是否为布尔的Boolean值
// ******************************************************************************
function cf_valStrIsBool(sStr: string): Boolean;
var
sInfo: string;
begin
Result := false;
try
sInfo := Trim(sStr);
if sInfo = '' then
Exit;
if StrToBoolDef(sInfo, false) then
begin
Result := true;
end
else
begin
Result := false;
end;
except
Result := false;
cf_sysLog(
'判断字符串是否为布尔型函数过程中失败! 错误位置:[function cf_valStrIsBool(sStr: string): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 判断字符串为日期时间
// 函数名称: cf_valStrIsDateTime
// 函数参数: sStr String; 被检测字符串
// 返回值: 是否为整数的Boolean值
// ******************************************************************************
function cf_valStrIsDateTime(sStr: string): Boolean;
var
sInfo: string;
begin
Result := false;
try
sInfo := Trim(sStr);
if sInfo = '' then
Exit;
if StrToDateTimeDef(sInfo, StrToDateTime('1900-01-01 00:00:00'))
= CONST_SYS_NULLDATETIME then
begin
Result := false;
Exit;
end
else
begin
Result := true;
end;
except
Result := false;
cf_sysLog(
'判断字符串为日期时间函数过程中失败! 错误位置:[function cf_valStrIsDateTime(sStr: string): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 判断字符串为日期型
// 函数名称: cf_valStrIsDate
// 函数参数: sStr String; 被检测字符串
// 返回值: 是否为整数的Boolean值
// ******************************************************************************
function cf_valStrIsDate(sStr: string): Boolean;
var
sInfo: string;
begin
Result := false;
try
sInfo := Trim(sStr);
if sInfo = '' then
Exit;
if StrToDateDef(sInfo, StrToDate('1900-01-01')) = StrToDateTime
('1900-01-01') then
begin
Result := false;
Exit;
end
else
begin
Result := true;
end;
except
Result := false;
cf_sysLog(
'判断字符串为日期型函数过程中失败! 错误位置:[function cf_valStrIsDate(sStr: string): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 判断字符串为时间型
// 函数名称: cf_valStrIsDate
// 函数参数: sStr String; 被检测字符串
// 返回值: 是否为整数的Boolean值
// ******************************************************************************
function cf_valStrIsTime(sStr: string): Boolean;
var
sInfo: string;
begin
Result := false;
sInfo := Trim(sStr);
if sInfo = '' then
Exit;
try
StrToTime(sInfo);
Result := true;
except
Result := false;
cf_sysLog(
'判断字符串为时间型函数过程中异常! 位置:[function cf_valStrIsTime(sStr: string): Boolean;]'
, false);
end;
end;
// ******************************************************************************
// 函数功能: 设置连接数据库服务器配置信息
// 函数名称: cf_fileSetDBConInfo
// 函数参数: oDataBaseConfig :TDataBaseConfig 服务器连接记录结构体变量
// iIndex:Integer 服务器连接信息索引
// 返回值: 是否操作成功
// ******************************************************************************
function cf_fileSetDBConInfo(oDataBaseConfig: TDataBaseConfig;
iIndex: Integer = 1): Boolean;
var
sIndex: string;
sSection: string;
begin
Result := false;
try
sIndex := IntToStr(iIndex);
sSection := 'DATABASE';
cf_fileSetINIValue(sSection, 'SERVERNAME' + sIndex,
oDataBaseConfig.sServerName);
cf_fileSetINIValue(sSection, 'DATABASENAME' + sIndex,
oDataBaseConfig.sDatabaseName);
cf_fileSetINIValue(sSection, 'USERNAME' + sIndex,
oDataBaseConfig.sUserName);
cf_fileSetINIValue(sSection, 'PASSWORD' + sIndex,
oDataBaseConfig.sPassWord);
cf_fileSetINIValue(sSection, 'DBTYPE' + sIndex,
oDataBaseConfig.sDBType);
if UpperCase(oDataBaseConfig.sDBType) = 'ACCESS' then
begin
if Trim(oDataBaseConfig.sFilePath) <> '' then
cf_fileSetINIValue(sSection, 'DBPATH' + sIndex,
oDataBaseConfig.sFilePath)
else
cf_fileSetINIValue(sSection, 'DBPATH' + sIndex, '');
end;
Result := true;
except
Result := false;
cf_sysLog(
'设置连接数据库服务器配置信息函数过程中失败! 错误位置:[function cf_fileSetDBConInfo(oDataBaseConfig: TDataBaseConfig;]');
end;
end;
// ******************************************************************************
// 函数功能: 设置连接数据库服务器配置信息
// 函数名称: cf_fileGetDBConInfo
// 函数参数: oDataBaseConfig :TDataBaseConfig 服务器连接记录结构体变量
// iIndex:Integer 服务器连接信息索引
// 返回值: 是否操作成功
// ******************************************************************************
function cf_fileGetDBConInfo(var oDataBaseConfig: TDataBaseConfig;
iIndex: Integer = 1): Boolean;
var
sSection, sIndex: string;
begin
Result := false;
try
sSection := 'DATABASE';
sIndex := IntToStr(iIndex);
oDataBaseConfig.sServerName := cf_fileGetINIValue
(sSection, 'SERVERNAME' + sIndex);
oDataBaseConfig.sDatabaseName := cf_fileGetINIValue
(sSection, 'DATABASENAME' + sIndex);
oDataBaseConfig.sUserName := cf_fileGetINIValue
(sSection, 'USERNAME' + sIndex);
oDataBaseConfig.sPassWord := cf_fileGetINIValue
(sSection, 'PASSWORD' + sIndex);
oDataBaseConfig.sFilePath := cf_fileGetINIValue
(sSection, 'DBPATH' + sIndex);
oDataBaseConfig.sDBType := cf_fileGetINIValue
(sSection, 'DBTYPE' + sIndex);
if UpperCase(oDataBaseConfig.sDBType) = 'ACCESS' then
begin
if Trim(oDataBaseConfig.sFilePath) = '' then
oDataBaseConfig.sConnectionString :=
'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' +
CONST_DATA_ACCESSPATH +
';Persist Security Info=False;Jet OLEDB:Database Password=' +
oDataBaseConfig.sPassWord
else
oDataBaseConfig.sConnectionString :=
'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' +
oDataBaseConfig.sFilePath +
';Persist Security Info=False;Jet OLEDB:Database Password=' +
oDataBaseConfig.sPassWord;
end
else if UpperCase(oDataBaseConfig.sDBType) = 'SQLSERVER2000' then
begin
oDataBaseConfig.sConnectionString :=
'Provider=SQLOLEDB.1;Password=' + oDataBaseConfig.sPassWord +
';Persist Security Info=True;User ID=' +
oDataBaseConfig.sUserName + ';Initial Catalog=' +
oDataBaseConfig.sDatabaseName + ';Data Source=' +
oDataBaseConfig.sServerName;
end
else if UpperCase(oDataBaseConfig.sDBType) = 'ORACLE' then
begin
oDataBaseConfig.sConnectionString :=
'Provider=OraOLEDB.Oracle.1;Password=' + oDataBaseConfig.sPassWord +
';Persist Security Info=True;User ID=' +
oDataBaseConfig.sUserName + ';Data Source=' +
oDataBaseConfig.sServerName;
end
else if UpperCase(oDataBaseConfig.sDBType) = 'SYBASE' then
begin
oDataBaseConfig.sConnectionString :=
'Provider=SQLOLEDB.1;Password=' + oDataBaseConfig.sPassWord +
';Persist Security Info=True;User ID=' +
oDataBaseConfig.sUserName + ';Initial Catalog=' +
oDataBaseConfig.sDatabaseName + ';Data Source=' +
oDataBaseConfig.sServerName;
end
else if UpperCase(oDataBaseConfig.sDBType) = 'SQLSERVER2005' then
begin
oDataBaseConfig.sConnectionString :=
'Provider=SQLNCLI.1;Password=' + oDataBaseConfig.sPassWord +
';Persist Security Info=True;User ID=' +
oDataBaseConfig.sUserName + ';Initial Catalog=' +
oDataBaseConfig.sDatabaseName + ';Data Source=' +
oDataBaseConfig.sServerName;
end;
Result := true;
except
Result := false;
cf_sysLog(
'设置连接数据库服务器配置信息函数过程中失败! 错误位置:[function cf_fileGetDBConInfo(var oDataBaseConfig: TDataBaseConfig;iIndex: Integer = 1): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 设置系统信息配置信息
// 函数名称: cf_fileSetSystemInfo
// 函数参数: oSystemInfo :TSystemInfo 系统信息结构体变量
// iIndex:Integer 信息索引
// 返回值: 是否操作成功
// ******************************************************************************
function cf_fileSetSystemInfo(oSystemInfo: TSystemInfo; iIndex: Integer = 1)
: Boolean;
var
sIndex: string;
sSection: string;
begin
Result := false;
try
sIndex := IntToStr(iIndex);
sSection := 'SYSTEMINFO';
cf_fileSetINIValue(sSection, 'AppCaption' + sIndex,
oSystemInfo.sAppCaption);
cf_fileSetINIValue(sSection, 'LoginUserNameID' + sIndex,
oSystemInfo.sLoginUserNameID);
cf_fileSetINIValue(sSection, 'SkinIndex' + sIndex, IntToStr
(oSystemInfo.iSkinIndex));
cf_fileSetINIValue(sSection, 'SplashDelay' + sIndex, IntToStr
(oSystemInfo.iSplashDelay));
cf_fileSetINIValue(sSection, 'LoginUserNameNick' + sIndex,
oSystemInfo.sLoginUserNameNick);
cf_fileSetINIValue(sSection, 'LoginPassWord' + sIndex,
oSystemInfo.sLoginPassWord);
cf_fileSetINIValue(sSection, 'LoginDateTime' + sIndex,
oSystemInfo.sLoginDateTime);
cf_fileSetINIValue(sSection, 'IsAutoUpdate' + sIndex, BoolToStr
(oSystemInfo.bIsAutoUpdate));
cf_fileSetINIValue(sSection, 'IsAutoLogin' + sIndex, BoolToStr
(oSystemInfo.bIsAutoLogin));
//cf_fileSetINIValue(sSection, 'IsAutoRun' + sIndex, BoolToStr
// (oSystemInfo.bIsAutoRun));
cf_fileSetINIValue(sSection, 'IsMenuEnable' + sIndex, BoolToStr
(oSystemInfo.bIsMenuEnable));
cf_fileSetINIValue(sSection, 'IsTreeViewEnable' + sIndex, BoolToStr
(oSystemInfo.bIsTreeViewEnable));
cf_fileSetINIValue(sSection, 'IsOutlookBarEnable' + sIndex, BoolToStr
(oSystemInfo.bIsOutlookBarEnable));
cf_fileSetINIValue(sSection, 'IsToolBarEnanble' + sIndex, BoolToStr
(oSystemInfo.bIsToolBarEnanble));
cf_fileSetINIValue(sSection, 'IsShortButtonEnable' + sIndex, BoolToStr
(oSystemInfo.bIsShortButtonEnable));
cf_fileSetINIValue(sSection, 'IsSaveFormSizePostion' + sIndex, BoolToStr
(oSystemInfo.bIsSaveFormSizePostion));
cf_fileSetINIValue(sSection, 'IsModleDLL' + sIndex, BoolToStr
(oSystemInfo.bIsModleDLL));
cf_fileSetINIValue(sSection, 'IsSkinEnable' + sIndex, BoolToStr
(oSystemInfo.bIsSkinEnable));
cf_fileSetINIValue(sSection, 'IsSysLogEnable' + sIndex, BoolToStr
(oSystemInfo.bIsSysLogEnable));
cf_fileSetINIValue(sSection, 'IsBeginHideWizardMenu' + sIndex, BoolToStr
(oSystemInfo.bIsBeginHideWizardMenu));
cf_fileSetINIValue(sSection, 'SoftWareType' + sIndex, '正式版');
cf_fileSetINIValue(sSection, 'Designer' + sIndex, 'HEAVEN');
cf_fileSetINIValue(sSection, 'PowerBy' + sIndex, CONST_VAL_POWERBYNAME);
Result := true;
except
Result := false;
cf_sysLog(
'设置系统信息配置信息函数过程中失败! 错误位置:[function cf_fileSetSystemInfo(oSystemInfo: TSystemInfo;iIndex: Integer = 1): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取系统信息配置信息
// 函数名称: cf_fileGetSystemInfo
// 函数参数: oSystemInfo :TSystemInfo 系统信息结构体变量
// iIndex:Integer 信息索引
// 返回值: 是否操作成功
// ******************************************************************************
function cf_fileGetSystemInfo(var oSystemInfo: TSystemInfo;
iIndex: Integer = 1): Boolean;
var
sIndex: string;
sSection: string;
begin
Result := false;
try
sIndex := IntToStr(iIndex);
sSection := 'SYSTEMINFO';
oSystemInfo.bLoginSuccess := false;
oSystemInfo.sAppCaption := cf_fileGetINIValue
(sSection, 'AppCaption' + sIndex);
oSystemInfo.sLoginUserNameID := cf_fileGetINIValue
(sSection, 'LoginUserNameID' + sIndex);
oSystemInfo.iSkinIndex := StrToIntDef
(cf_fileGetINIValue(sSection, 'SkinIndex' + sIndex), 0);
oSystemInfo.iSplashDelay := StrToIntDef
(cf_fileGetINIValue(sSection, 'SplashDelay' + sIndex), 0);
oSystemInfo.sLoginUserNameNick := cf_fileGetINIValue
(sSection, 'LoginUserNameNick' + sIndex);
oSystemInfo.sLoginPassWord := cf_fileGetINIValue
(sSection, 'LoginPassWord' + sIndex);
oSystemInfo.sLoginDateTime := cf_fileGetINIValue
(sSection, 'LoginDateTime' + sIndex);
oSystemInfo.bIsAutoUpdate := StrToBoolDef
(cf_fileGetINIValue(sSection, 'IsAutoUpdate' + sIndex), false);
oSystemInfo.bIsAutoLogin := StrToBoolDef
(cf_fileGetINIValue(sSection, 'IsAutoLogin' + sIndex), false);
//oSystemInfo.bIsAutoRun := StrToBoolDef
// (cf_fileGetINIValue(sSection, 'IsAutoRun' + sIndex), false);
oSystemInfo.bIsMenuEnable := StrToBoolDef
(cf_fileGetINIValue(sSection, 'IsMenuEnable' + sIndex), false);
oSystemInfo.bIsTreeViewEnable := StrToBoolDef
(cf_fileGetINIValue(sSection, 'IsTreeViewEnable' + sIndex), false);
oSystemInfo.bIsOutlookBarEnable := StrToBoolDef
(cf_fileGetINIValue(sSection, 'IsOutlookBarEnable' + sIndex), false);
oSystemInfo.bIsToolBarEnanble := StrToBoolDef
(cf_fileGetINIValue(sSection, 'IsToolBarEnanble' + sIndex), false);
oSystemInfo.bIsShortButtonEnable := StrToBoolDef
(cf_fileGetINIValue(sSection, 'IsShortButtonEnable' + sIndex), false);
oSystemInfo.bIsSaveFormSizePostion := StrToBoolDef
(cf_fileGetINIValue(sSection, 'IsSaveFormSizePostion' + sIndex),
false);
oSystemInfo.bIsModleDLL := StrToBoolDef
(cf_fileGetINIValue(sSection, 'IsModleDLL' + sIndex), false);
oSystemInfo.bIsSkinEnable := StrToBoolDef
(cf_fileGetINIValue(sSection, 'IsSkinEnable' + sIndex), false);
oSystemInfo.bIsSysLogEnable := StrToBoolDef
(cf_fileGetINIValue(sSection, 'IsSysLogEnable' + sIndex), false);
oSystemInfo.bIsBeginHideWizardMenu := StrToBoolDef
(cf_fileGetINIValue(sSection, 'IsBeginHideWizardMenu' + sIndex),
false);
Result := true;
except
Result := false;
cf_sysLog(
'获取系统信息配置信息函数过程中失败! 错误位置:[function cf_fileGetSystemInfo(var oSystemInfo: TSystemInfo;iIndex: Integer = 1): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 浮点数转换为人民币大写字符串
// 函数名称: cf_valRealToRMB(rValue:Real):WideString;
// 函数参数: rValue Real 浮点型数字
// 返回值: 人民币大写字符串
// ******************************************************************************
function cf_valRealToRMB(rValue: Real): WideString;
var
sSourceMoney, sDestMoney: string;
sCurrWei, sCurrPos: string[2];
iWei, iPosPoint: Integer;
begin
sSourceMoney := FormatFloat('0.000', rValue);
iPosPoint := Pos('.', sSourceMoney);
try
for iWei := Length(sSourceMoney) downto 1 do
begin
case sSourceMoney[iWei] of
'.':
Continue;
'-':
begin
sCurrWei := '负';
sDestMoney := sCurrWei + sDestMoney;
Continue;
end;
'1':
sCurrWei := '壹';
'2':
sCurrWei := '贰';
'3':
sCurrWei := '参';
'4':
sCurrWei := '肆';
'5':
sCurrWei := '伍';
'6':
sCurrWei := '陆';
'7':
sCurrWei := '柒';
'8':
sCurrWei := '捌';
'9':
sCurrWei := '玖';
'0':
sCurrWei := '零';
end;
case iPosPoint - iWei of
- 3:
sCurrPos := '厘';
-2:
sCurrPos := '分';
-1:
sCurrPos := '角';
1:
sCurrPos := '元';
2:
sCurrPos := '拾';
3:
sCurrPos := '佰';
4:
sCurrPos := '千';
5:
sCurrPos := '万';
6:
sCurrPos := '拾';
7:
sCurrPos := '佰';
8:
sCurrPos := '仟';
9:
sCurrPos := '亿';
10:
sCurrPos := '拾';
11:
sCurrPos := '佰';
12:
sCurrPos := '仟';
end;
sDestMoney := sCurrWei + sCurrPos + sDestMoney;
end;
Result := sDestMoney;
except
Result := '';
cf_sysLog(
'转换为人民币大写函数过程中失败! 错误位置:[function cf_valRealToRMB(rValue: Real): WideString;]');
end;
end;
// ******************************************************************************
// 函数功能: 设置(RS232)配置相关信息
// 函数名称: cf_fileSetRs232ComConfig
// 函数参数: oRs232ComConfig TRs232ComConfig 记录结构体变量
// iIndex:Integer MSComm组件记录信息索引
// 返回值: 是否操作成功
// ******************************************************************************
function cf_fileSetRs232ComConfig(oRs232ComConfig: TRs232ComConfig;
iIndex: Integer = 1): Boolean;
var
sIndex, sSection: string;
begin
Result := false;
try
sSection := 'HARDWARE';
sIndex := IntToStr(iIndex);
cf_fileSetINIValue(sSection, 'COMMPORT' + sIndex, IntToStr
(oRs232ComConfig.iCommport));
cf_fileSetINIValue(sSection, 'COMCYCLE' + sIndex, IntToStr
(oRs232ComConfig.iCycle));
cf_fileSetINIValue(sSection, 'COMBAUDRATE' + sIndex,
oRs232ComConfig.sBaudRate);
cf_fileSetINIValue(sSection, 'COMPARITY' + sIndex,
oRs232ComConfig.sParity);
cf_fileSetINIValue(sSection, 'COMBYTESIZE' + sIndex,
oRs232ComConfig.sByteSize);
cf_fileSetINIValue(sSection, 'COMSTOPBITS' + sIndex,
oRs232ComConfig.sStopBits);
Result := true;
except
Result := false;
cf_sysLog(
'设置(RS232)配置相关信息函数过程中失败! 错误位置:[function cf_fileSetRs232ComConfig(oRs232ComConfig: TRs232ComConfig;iIndex: Integer = 1): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 读取(RS232)配置相关信息
// 函数名称: cf_fileGetRs232ComConfig
// 函数参数: oRs232ComConfig:TRs232ComConfig MSComm组件记录结构体变量
// iIndex:Integer MSComm组件记录信息索引
// 返回值: 是否操作成功
// ******************************************************************************
function cf_fileGetRs232ComConfig(var oRs232ComConfig: TRs232ComConfig;
iIndex: Integer = 1): Boolean;
var
sIndex, sSection: string;
begin
Result := false;
try
sSection := 'HARDWARE';
sIndex := IntToStr(iIndex);
oRs232ComConfig.iCount := 0;
oRs232ComConfig.iCommport := StrToIntDef
(cf_fileGetINIValue(sSection, 'COMMPORT' + sIndex), 1);
oRs232ComConfig.iCycle := StrToIntDef
(cf_fileGetINIValue(sSection, 'COMCYCLE' + sIndex), 1);
oRs232ComConfig.sBaudRate := cf_fileGetINIValue
(sSection, 'COMBAUDRATE' + sIndex);
oRs232ComConfig.sParity := cf_fileGetINIValue
(sSection, 'COMPARITY' + sIndex);
oRs232ComConfig.sByteSize := cf_fileGetINIValue
(sSection, 'COMBYTESIZE' + sIndex);
oRs232ComConfig.sStopBits := cf_fileGetINIValue
(sSection, 'COMSTOPBITS' + sIndex);
if (Trim(oRs232ComConfig.sBaudRate) <> '') and
(Trim(oRs232ComConfig.sParity) <> '') and
(Trim(oRs232ComConfig.sByteSize) <> '') and
(Trim(oRs232ComConfig.sStopBits) <> '') then
oRs232ComConfig.sSettings := oRs232ComConfig.sBaudRate + ',' +
oRs232ComConfig.sParity + ',' + oRs232ComConfig.sByteSize + ',' +
oRs232ComConfig.sStopBits
else
oRs232ComConfig.sSettings := '9600,n,8,1';
Result := true;
except
Result := false;
cf_sysLog(
'读取(RS232)配置相关信息函数过程中失败! 错误位置:[function cf_fileGetRs232ComConfig(var oRs232ComConfig: TRs232ComConfig;iIndex: Integer = 1): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 从注册表枚举串口信息装载到Combobox内
// 函数名称: gcf_SetComBoboxPorts(oComboBox:TComboBox;bAutoClear:Boolean):Boolean;
// 函数参数: oComboBox:TCombobox 把枚举的串口信息返回给TCombobox对象
// bAutoClear:Boolean 是否自动清空列表信息
// 返回值: 返回计算机串口数。
// ******************************************************************************
function cf_sysSetComBoboxPorts(oComboBox: TComboBox;
bAutoClear: Boolean = true): Boolean;
var
KeyHandle: HKEY;
ErrCode, Index: Integer;
ValueName, Data: string;
ValueLen, DataLen, ValueType: DWORD;
begin
Result := false;
if (oComboBox = nil) or (not Assigned(oComboBox)) then
begin
Exit;
end;
if bAutoClear then
oComboBox.Items.Clear;
ErrCode := RegOpenKeyEx(HKEY_LOCAL_MACHINE,
'HARDWARE\DEVICEMAP\SERIALCOMM', 0, KEY_READ, KeyHandle);
if ErrCode <> ERROR_SUCCESS then
Exit;
try
try
Index := 0;
repeat
ValueLen := 256;
DataLen := 256;
SetLength(ValueName, ValueLen);
SetLength(Data, DataLen);
ErrCode := RegEnumValue(KeyHandle, Index, PWideChar(ValueName),
Cardinal(ValueLen), nil, @ValueType, PByte(PWideChar(Data)),
@DataLen);
if ErrCode = ERROR_SUCCESS then
begin
SetLength(Data, DataLen);
oComboBox.Items.ADD(Data);
Inc(Index);
end
else if ErrCode <> ERROR_NO_MORE_ITEMS then
Exit;
until (ErrCode <> ERROR_SUCCESS);
oComboBox.Sorted := true;
oComboBox.ItemIndex := 0;
Result := true;
except
Result := false;
cf_sysLog(
'枚举串口函数过程中失败! 错误位置:[function cf_sysSetComBoboxPorts(oComboBox: TComboBox;bAutoClear: Boolean = true): Boolean;]');
end;
finally
RegCloseKey(KeyHandle);
end;
end;
// ******************************************************************************
// 函数功能: 替换字符串函数
// 函数名称: function cf_valReplaceStr(sSource, sChangeStr, sSeparator: string): string;
// 函数参数: sSource String 原字符串
// sSeparator String 要被替换的字符串
// sChangeStr String 更换的字符串
// 返回值: 返回替换后的字符串
// ******************************************************************************
function cf_valReplaceStr(sSource, sSeparator, sChangeStr: string): string;
begin
try
if Pos(sSeparator, sSource) > 0 then
begin
Result := Copy(sSource, 1, Pos(sSeparator, sSource) - 1)
+ sChangeStr + Copy(sSource, Pos(sSeparator, sSource) + Length
(sSeparator), Length(sSource));
end
else
Result := sSource;
except
Result := '';
cf_sysLog(
'替换字符串函数函数过程中失败! 错误位置:[function cf_valReplaceStr(sSource, sChangeStr, sSeparator: string): string;]');
end;
end;
// ******************************************************************************
// 函数功能: 检测文件的使用状态
// 函数名称: cf_fileFileInUse Boolean;
// 函数参数: sFileName String 文件字符串
// 返回值: 返回文件是否在使用中.
// ******************************************************************************
function cf_fileIsFileInUse(sFileName: string): Boolean;
var
HFileRes: HFILE;
begin
Result := false;
try
if not FileExists(sFileName) then
Exit;
HFileRes := CreateFile(PWideChar(sFileName),
GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL, 0);
Result := (HFileRes = INVALID_HANDLE_VALUE);
if not Result then
CloseHandle(HFileRes);
except
Result := false;
cf_sysLog(
' 检测文件的使用状态函数过程中失败! 错误位置:[function cf_fileIsFileInUse(sFileName: string): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取文件的创建或修改或最后访问时间
// 函数名称: gcf_FileDateTime
// 函数参数: sFileName String 文件字符串
// iType Integer 0:创建日期，1:修改日期,2:最后访问日期
// 返回值: 返回文件是否在使用中.
// ******************************************************************************
function cf_fileGetFileDateTime(sFileName: string; iType: Integer = 1)
: TDateTime;
var
lfd: TWin32FindData;
ldft: DWORD;
lft: TFileTime;
lh: THandle;
begin
try
lh := FindFirstFile(PWideChar(sFileName), lfd);
if lh <> INVALID_HANDLE_VALUE then
begin
case iType of
0:
FileTimeToLocalFileTime(lfd.ftCreationTime, lft);
1:
FileTimeToLocalFileTime(lfd.ftLastWriteTime, lft);
2:
FileTimeToLocalFileTime(lfd.ftLastAccessTime, lft);
else
FileTimeToLocalFileTime(lfd.ftLastAccessTime, lft);
end;
FileTimeToDosDateTime(lft, LongRec(ldft).Hi, LongRec(ldft).Lo);
Result := FileDateToDateTime(ldft);
Windows.FindClose(lh);
end
else
Result := StrToDateTime('1900-1-1');
except
Result := StrToDateTime('1900-1-1');
cf_sysLog(
'获取文件的创建或修改或最后访问时间函数过程中失败! 错误位置:[function cf_fileGetFileDateTime(sFileName: string;iType: Integer = 1): TDateTime;]');
end;
end;
// ******************************************************************************
// 函数功能: 汉字助记码函数
// 函数名称: cf_valGetPinYin(strHZ:String):String;
// 函数参数: strHZ String 中文汉字字符串
// 返回值: 拼音首部字符串
// ******************************************************************************
function cf_valGetPinYin(strHZ: AnsiString): string;
const
HZCode: array [0 .. 25, 0 .. 1] of Integer =
((1601, 1636), (1637, 1832), (1833, 2077), (2078, 2273), (2274, 2301),
(2302, 2432), (2433, 2593), (2594, 2786), (9999, 0000), (2787, 3105),
(3106, 3211), (3212, 3471), (3472, 3634), (3635, 3722), (3723, 3729),
(3730, 3857), (3858, 4026), (4027, 4085), (4086, 4389), (4390, 4557),
(9999, 0000), (9999, 0000), (4558, 4683), (4684, 4924), (4925, 5248),
(5249, 5589));
var
i, j, HzOrd: Integer;
begin
i := 1;
try
while i <= Length(strHZ) do
begin
if (strHZ[i] >= #160) and (strHZ[i + 1] >= #160) then
begin
HzOrd := (Ord(strHZ[i]) - 160) * 100 + Ord(strHZ[i + 1]) - 160;
for j := 0 to 25 do
begin
if (HzOrd >= HZCode[j][0]) and (HzOrd <= HZCode[j][1]) then
begin
Result := Result + Char(Byte('A') + j);
Break;
end;
end;
Inc(i);
end
else
Result := Result + strHZ[i];
Inc(i);
end;
except
Result := '';
cf_sysLog(
'汉字助记码函数过程中失败! 错误位置:[function cf_valGetPinYin(strHZ: AnsiString): string;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取操作系统版本信息
// 函数名称: cf_sysGetOSVersion:String;
// 函数参数: 无参数
// 返回值: 返回操作系统信息字符串
// ******************************************************************************
function cf_sysGetOSVersion: string;
var
OS: TOSVersionInfo;
begin
try
OS.dwOSVersionInfoSize := SizeOf(OS);
GetVersionEx(OS);
with OS do
case dwPlatformId of
VER_PLATFORM_WIN32s:
Result := 'Windows 3.1x/32s';
VER_PLATFORM_WIN32_WINDOWS:
begin
if (dwMajorVersion = 4) and (dwMinorVersion > 0) then
Result := 'Windows 98'
else
Result := 'Windows 95';
end;
VER_PLATFORM_WIN32_NT:
if (dwMajorVersion = 5) then
Result := 'Windows 2000 或 Windows XP';
else
Result := '其他操作系统';
end;
except
Result := '';
cf_sysLog(
'获取操作系统版本信息函数过程中失败! 错误位置:[function cf_sysGetOSVersion: string;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取操作系统语言字符串
// 函数名称: cf_sysGetOSLanguage
// 函数参数: 无
// 返回值: 返回操作系统信息字符串
// ******************************************************************************
function cf_sysGetOSLanguage: string;
var
ID: LangID;
Language: array [0 .. 100] of Char;
begin
try
ID := GetSystemDefaultLangID;
VerLanguageName(ID, Language, 100);
Result := StrPas(Language);
except
cf_sysLog(
'获取操作系统语言字符串函数过程中失败! 错误位置:[function cf_sysGetOSLanguage: string;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取操作系统内存(KB)
// 函数名称: cf_hardGetOSMemory
// 函数参数: 无
// 返回值: 返回操作系统内存大小字符串(单位为KB)
// ******************************************************************************
function cf_hardGetOSMemory: string;
var
tMS: TMemoryStatus;
begin
try
tMS.dwLength := SizeOf(TMemoryStatus);
GlobalMemoryStatus(tMS);
Result := FormatFloat('#,###" KB"', tMS.dwTotalPhys div 1024);
except
Result := '';
cf_sysLog
('获取操作系统内存函数过程中失败! 错误位置:[function cf_hardGetOSMemory: string;]');
end;
end;
// ******************************************************************************
// 函数功能: 系统是否存在打印机
// 函数名称: cf_hardIsExistsPrinter
// 函数参数: 无参数
// 返回值: 返回系统是否能打印的布尔值
// ******************************************************************************
function cf_hardIsExistsPrinter: Boolean;
begin
Result := false;
try
Printer.Refresh;
if Printer.Printers.Count = 0 then
begin
Exit;
end;
Result := true;
except
Result := false;
cf_sysLog(
'系统是否存在打印机函数过程中失败! 错误位置:[function cf_hardIsExistsPrinter: Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取Access2000密码
// 函数名称: cf_fileGetAccess2KPwd
// 函数参数: sFileName String; Access文件
// 返回值: 返回该数据库文件的密码；
// ******************************************************************************
function cf_fileGetAccess2KPwd(sFileName: string): string;
const
xorString: array [0 .. 39] of Byte =
(71, 106, 236, 55, $9C, $D5, $9C, $FA, $7, $CF, $28, $E6, $D2, $27,
$8A, $60, $95, $5, $7B, $36, $34, $E3, $DF, $B1, $B6, $65, $13, $43,
$E, $3E, $B1, $33, $F5, $F0, $79, $5B, $53, $24, $7C, $2A);
var
PassBuf: array [0 .. 40] of Byte;
cPass: array [0 .. 40] of AnsiChar;
sResultPass: string;
B: Byte;
F: TFileStream;
iCount: Integer;
begin
F := TFileStream.Create(sFileName, fmShareDenyNone);
try
try
F.Seek($42, soFromBeginning);
F.Read(PassBuf, 40);
for iCount := 0 to 19 do
begin
B := PassBuf[iCount * 2] xor xorString[iCount * 2];
cPass[iCount] := AnsiChar(B);
end;
cPass[SizeOf(cPass) - 1] := #0;
sResultPass := StrPas(cPass);
except
Result := '';
cf_sysLog(
'获取Access2000密码函数过程中失败! 错误位置:[function cf_fileGetAccess2KPwd(sFileName: string): string;]');
end;
finally
F.Free;
end;
Result := sResultPass;
end;
// ******************************************************************************
// 函数功能: 查找并打开可用的窗体已注册类模块
// 函数名称: cf_sysShowFormClass
// 函数参数: sFormName: 要控制打开的窗体字符串
// hParentHandle:THandle; 父控件句柄
// iTag: 窗体初始Tag值
// abIsFronted 是否限制长度
// 返回值: 返回指定定长度充满'0'字符串.
// ******************************************************************************
function cf_sysShowFormClass(oParentForm: TForm;
oPageControl: TRzPageControl; sFormName: string; iTag: Integer = 0)
: Boolean;
var
oFrmClass: TFormClass;
oFrm: TForm;
oTabSheet: TRzTabSheet;
begin
Result := false;
if Trim(sFormName) = '' then
Exit;
if oPageControl = nil then
begin
Exit;
end;
oPageControl.ShowCloseButtonOnActiveTab := true;
try
if GetClass(sFormName) <> nil then
begin
if oPageControl.FindChildControl('Tab' + sFormName) <> nil then
begin
if oPageControl.FindChildControl('Tab' + sFormName)
is TRzTabSheet then
begin
oPageControl.ActivePage :=
(oPageControl.FindChildControl('Tab' + sFormName)
as TRzTabSheet);
end;
end
else
begin
oTabSheet := TRzTabSheet.Create(oPageControl);
oTabSheet.Name := 'Tab' + sFormName;
// oPageControl.ScrollOpposite := true;
oTabSheet.PageControl := oPageControl;
oPageControl.ActivePage := oTabSheet;
oFrmClass := TFormClass(FindClass(sFormName));
oFrm := oFrmClass.Create(Application);
oTabSheet.Caption := oFrm.Caption;
try
oFrm.Align := alClient;
oFrm.Tag := iTag;
oFrm.ManualDock(oTabSheet, nil, alClient);
oFrm.Show;
if (goSkinData <> nil) then
begin
goSkinData.UpdateSkinControl(oParentForm, nil);
end;
except
oFrm.Free;
oTabSheet.Free;
end;
end;
Result := true;
end;
except
cf_sysMsgBox('系统没有找到该系统模块，请与开发商联系。');
cf_sysLog(
'查找并打开可用的窗体已注册类模块函数过程中失败! 错误位置:[function cf_sysShowFormClass(oParentForm: TForm;'
+ 'oPageControl: TRzPageControl; sFormName: string; iTag: Integer = 0): Boolean;]');
Exit;
end;
end;
// ******************************************************************************
// 函数功能: 计算两个日期时间的差
// 函数名称: cf_dateGetDateTimeDiff(oDate1,oDate2:TDateTime;iDiffType:Integer=0):double;
// 函数参数: oDate1 TDateTime; 日期时间1
// oDate2 TDateTime; 日期时间2
// iDiffType Integer; 0:天数差，1:小时差,2:分钟差,3:秒差,4:毫秒差
// 返回值: 是否为浮点型的Boolean值
// ******************************************************************************
function cf_dateGetDateTimeDiff(oDate1, oDate2: TDateTime;
iDiffType: Integer = 0): Double;
var
vReal, vResult: Double;
begin
try
vReal := oDate1 - oDate2;
case iDiffType of
0:
begin
vResult := Round(vReal);
end;
1:
begin
vResult := Round(vReal * 24);
end;
2:
begin
vResult := Round(vReal * 24 * 60);
end;
3:
begin
vResult := Round(vReal * 24 * 60 * 60);
end;
4:
begin
vResult := Round(vReal * 24 * 60 * 60 * 1000);
end;
end;
Result := vResult;
except
Result := 0.00;
cf_sysLog(
'计算两个日期时间的差函数过程中失败! 错误位置:[function cf_dateGetDateTimeDiff(oDate1, oDate2: TDateTime;'
+ 'iDiffType: Integer = 0): Double;]');
end;
end;
// ******************************************************************************
// 函数功能: 向IE菜单注册信息
// 函数名称: cf_sysRegisryIEMenu
// 函数参数: sMenuCaption: string 菜单显示信息
// sLinkStr: string 单击菜单后触发的链接网页
// 返回值: 返回是否创建成功(Boolean);
// ******************************************************************************
function cf_sysRegisryIEMenu(sMenuCaption, sLinkStr: string): Boolean;
var
myReg: TRegistry;
begin
myReg := TRegistry.Create;
try
with myReg do
begin
RootKey := HKEY_CURRENT_USER;
if OpenKey('\Software\Microsoft\Internet Explorer\MenuExt', true) then
begin
CreateKey(sMenuCaption);
CloseKey;
end;
if OpenKey('\Software\Microsoft\Internet Explorer\MenuExt\' +
sMenuCaption, true) then
begin
WriteString('', sLinkStr);
CloseKey;
end;
Free;
end;
Result := true;
except
Result := false;
cf_sysLog(
'向IE菜单注册信息函数过程中失败! 错误位置:[function cf_sysRegisryIEMenu(sMenuCaption, sLinkStr: string): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 注册关联的文件
// 函数名称: cf_sysRegFileJoint
// 函数参数: sCaption string 菜单显示信息
// sFile string 执行的文件
// sExeFile String 关联的执行文件
// 返回值: 返回是否创建成功(Boolean);
// ******************************************************************************
function cf_sysRegFileJoint(sCaption, sFile, sExeFile: string): Boolean;
var
lphKey: HKEY;
sKeyName: string;
sKeyValue: string;
begin
Result := false;
try
sKeyName := sCaption;
sKeyValue := sCaption;
if RegOpenKey(HKEY_CLASSES_ROOT, PWideChar(sKeyName), lphKey)
= ERROR_SUCCESS then
Exit;
RegCreateKey(HKEY_CLASSES_ROOT, PWideChar(sKeyName), lphKey);
RegSetValue(lphKey, '', REG_SZ, PWideChar(sKeyValue), 0);
sKeyName := sFile;
sKeyValue := sCaption;
RegCreateKey(HKEY_CLASSES_ROOT, PWideChar(sKeyName), lphKey);
RegSetValue(lphKey, '', REG_SZ, PWideChar(sKeyValue), 0);
sKeyName := sCaption;
sKeyValue := sExeFile + ',0';
RegCreateKey(HKEY_CLASSES_ROOT, PWideChar(sKeyName), lphKey);
RegSetValue(lphKey, 'DefaultIcon', REG_SZ, PWideChar(sKeyValue),
MAX_PATH);
sKeyName := sCaption;
sKeyValue := sExeFile + ' %1';
RegCreateKey(HKEY_CLASSES_ROOT, PWideChar(sKeyName), lphKey);
RegSetValue(lphKey, 'shell\open\command', REG_SZ, PWideChar(sKeyValue),
MAX_PATH);
Result := true;
except
Result := false;
cf_sysLog(
'注册关联的文件函数过程中失败! 错误位置:[function cf_sysRegFileJoint(sCaption, sFile, sExeFile: string): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 气泡提示
// 函数名称: cf_gdiBallonHits
// 函数参数: objComponent TWinControl 可见的类控件
// sCaption PWideChar 提示标题
// sText pWideChar 提示的内容
// iIcon Integer 提示的图标
// iDelay Integer 提示延迟时间(秒)
// tBgColor TColor 背景颜色
// tFgColor TColor 字体颜色
// 返回值: 返回是否操作成功(Boolean);
// ******************************************************************************
function cf_gdiBallonHits(objCompoent: TWinControl; sCaption: PWideChar;
sText: PWideChar; iIcon: Integer = 1; iDelay: Integer = 30;
tBgColor: TColor = 0; tFgColor: TColor = 0): Boolean;
const
TOOLTIPS_CLASS = 'Tooltips_Class32';
TTS_ALWAYSTIP = $01;
TTS_NOPREFIX = $02;
TTS_BALLOON = $40;
TTF_SUBCLASS = $0010;
TTF_TRANSPARENT = $0100;
TTM_ADDTOOL = $0400 + 50;
TTM_SETTITLE = (WM_USER + 32);
ICC_WIN95_CLASSES = $000000FF;
type
TOOLINFO = packed record
cbSize: Integer;
uFlags: Integer;
HWND: THandle;
uId: Integer;
rect: TRect;
hinst: THandle;
lpszText: PWideChar;
lParam: Integer;
end;
var
hWndTip: THandle;
ti: TOOLINFO;
HWND: THandle;
begin
try
HWND := objCompoent.Handle;
hWndTip := CreateWindowEx(0, TOOLTIPS_CLASS, nil,
TTS_BALLOON or TTS_ALWAYSTIP, Integer(CW_USEDEFAULT), Integer
(CW_USEDEFAULT), Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
HWND, 0, HInstance, nil);
if hWndTip <> 0 then
begin
SetWindowPos(hWndTip, HWND_TOPMOST, 0, 0, 0, 0,
SWP_NOMOVE or SWP_NOACTIVATE or SWP_NOSIZE);
ti.cbSize := SizeOf(ti);
ti.uFlags := TTF_TRANSPARENT or TTF_SUBCLASS;
ti.HWND := HWND;
ti.lpszText := sText;
Windows.GetClientRect(HWND, ti.rect);
if tBgColor <> 0 then
SendMessage(hWndTip, TTM_SETTIPBKCOLOR, tBgColor, 0);
if tFgColor <> 0 then
SendMessage(hWndTip, TTM_SETTIPTEXTCOLOR, tFgColor, 0);
SendMessage(hWndTip, TTM_ADDTOOL, 1, Integer(@ti));
SendMessage(hWndTip, TTM_SETTITLE, iIcon mod 4, Integer(sCaption));
SendMessage(hWndTip, TTM_SETDELAYTIME, TTDT_AUTOPOP, 1000 * iDelay);
Result := true;
end;
except
Result := false;
cf_sysLog(
'气泡提示函数过程中失败! 错误位置:[function cf_gdiBallonHits(objCompoent: TWinControl; sCaption: PWideChar;'
+ 'sText: PWideChar; iIcon: Integer = 1; iDelay: Integer = 30;' +
'tBgColor: TColor = 0; tFgColor: TColor = 0): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 简体转变为繁体字
// 函数名称: cf_valGBToCht(GBStr : String):AnsiString;
// 函数参数: GBStr: 简体字符串
// 返回值: 返回繁体字信息
// ******************************************************************************
function cf_valGBToCht(GBStr: string): AnsiString;
var
Len: Integer;
pGBCHTChar: PWideChar;
pGBCHSChar: PWideChar;
begin
try
pGBCHTChar := PWideChar(GBStr);
Len := MultiByteToWideChar(936, 0, PAnsiChar(pGBCHTChar), -1, nil, 0);
GetMem(pGBCHSChar, Len * 2 + 1);
ZeroMemory(pGBCHSChar, Len * 2 + 1);
// GB CHS -> GB CHT
LCMapString($804, LCMAP_SIMPLIFIED_CHINESE, pGBCHTChar, -1, pGBCHSChar,
Len * 2);
Result := string(pGBCHSChar);
// FreeMem(pGBCHTChar);
FreeMem(pGBCHSChar);
except
Result := '';
cf_sysLog(
'简体转变为繁体字函数过程中失败! 错误位置:[function cf_valGBToCht(GBStr: string): AnsiString;]');
end;
end;
// ******************************************************************************
// 函数功能: 繁体转变为简体字
// 函数名称: cf_valChtToGB(GBStr : String):AnsiString;
// 函数参数: GBStr: 简体字符串
// 返回值: 返回繁体字信息
// ******************************************************************************
function cf_valChtToGB(ChtStr: string): AnsiString;
var
Len: Integer;
pGBCHTChar: PWideChar;
pGBCHSChar: PWideChar;
begin
try
pGBCHSChar := PWideChar(ChtStr);
Len := MultiByteToWideChar(936, 0, PAnsiChar(pGBCHSChar), -1, nil, 0);
GetMem(pGBCHTChar, Len * 2 + 1);
ZeroMemory(pGBCHTChar, Len * 2 + 1);
// GB CHS -> GB CHT
LCMapString($804, LCMAP_TRADITIONAL_CHINESE, pGBCHSChar, -1,
pGBCHTChar, Len * 2);
Result := string(pGBCHTChar);
FreeMem(pGBCHTChar);
// FreeMem(pGBCHSChar);
except
Result := '';
cf_sysLog(
'繁体转变为简体字函数过程中失败! 错误位置:[function cf_valChtToGB(ChtStr: string): AnsiString;]');
end;
end;
// ******************************************************************************
// 函数功能: 取得某月的第一天的日期
// 函数名称: cf_dateGetMonthFirstDate(oDate:TDate):TDate;
// 函数参数: oDate: 录入某天日期
// 返回值: 返回该天所在月的第一天的日期。
// ******************************************************************************
function cf_dateGetMonthFirstDate(oDate: TDate): TDate;
var
AFirstDay: string;
begin
try
AFirstDay := FormatDateTime('yyyy-mm-dd', oDate);
Delete(AFirstDay, 9, 2);
Insert('01', AFirstDay, 9);
Result := StrToDate(AFirstDay);
except
Result := StrToDate('1900-01-01');
cf_sysLog(
'取得某月的第一天的日期函数过程中失败! 错误位置:[function cf_dateGetMonthFirstDate(oDate: TDate): TDate;]');
end;
end;
// ******************************************************************************
// 函数功能: 取得某月的最后一天的日期
// 函数名称: cf_dateGetMonthLastDate(aDate:TDate):TDate;
// 函数参数: aDate: 录入某天日期
// 返回值: 返回该天所在月的最后一天的日期。
// ******************************************************************************
function cf_dateGetMonthLastDate(aDate: TDate): TDate;
var
AFirstDay, ANextFirstDay: string;
begin
try
AFirstDay := FormatDateTime('yyyy-mm-dd', cf_dateGetMonthFirstDate
(aDate));
if StrToInt(Copy(AFirstDay, 6, 2)) < 12 then
begin
// 取当月第一天的日期
ANextFirstDay := IntToStr(StrToInt(Copy(AFirstDay, 6, 2)) + 1);
// 取下月第一天的日期
Delete(AFirstDay, 6, 2); // 删除字串中的月份
Insert(ANextFirstDay, AFirstDay, 6); // 插入当月的月份到字串中
Result := StrToDate(AFirstDay) - 1; // 取得当月最后一天的日期
end
else
begin
Result := StrToDate(Copy(AFirstDay, 1, 4) + '-12-31');
end;
except
Result := StrToDate('1900-01-01');
cf_sysLog(
' 取得某月的最后一天的日期函数过程中失败! 错误位置:[function cf_dateGetMonthLastDate(aDate: TDate): TDate;]');
end;
end;
// ******************************************************************************
// 函数功能: 发送邮件
// 函数名称: gcf_SMTPSendMail
// 函数参数: FromAddress, string //发信人地址
// ToAddress, string //收信人地址
// ASubject, string //信件标题
// MsgBody: string //信件内容
// sHous string //服务器地址
// sUsn string //用户名
// sPwd string //密码
// 返回值: 是否操作成功
// ******************************************************************************
function cf_netSMTPSendMail(FromAddress, ToAddress, ASubject,
MsgBody: string; sHous, sUsn, sPwd: string): Boolean;
var
IdSMTP: TIdSMTP;
IdSendMsg: TIdMessage;
begin
IdSMTP := TIdSMTP.Create(nil);
IdSendMsg := TIdMessage.Create(IdSMTP);
try
Result := false;
try
with IdSendMsg do { 邮件信息 }
begin
Body.Text := MsgBody;
From.Text := FromAddress;
Recipients.EMailAddresses := ToAddress;
Subject := ASubject;
end;
with IdSMTP do
begin
Host := sHous;
Username := sUsn;
PassWord := sPwd;
if PassWord <> '' then
AuthType := satDefault;
Connect;
try
sEnd(IdSendMsg);
Result := true;
finally
Disconnect;
end;
end;
except
Result := false;
cf_sysLog(
'发送邮件函数过程中失败! 错误位置:[function cf_netSMTPSendMail(FromAddress, ToAddress,'
+ ' ASubject, MsgBody: string;sHous, sUsn, sPwd: string): Boolean;]');
end;
finally
IdSendMsg.Free;
IdSMTP.Free;
end;
end;
// ******************************************************************************
// 函数功能: 设置窗体关闭按钮状态
// 函数名称: cf_sysSetFormCloseBtnStatus(Handle:HWND;bExpires:boolean=False):boolean;
// 函数参数: Handle:HWND 要设置的窗体句柄
// bExpires 有效或无效
// 返回值: 是否操作成功
// ******************************************************************************
function cf_sysSetFormCloseBtnStatus
(Handle: HWND; bExpires: Boolean = false): Boolean;
begin
Result := false;
try
if bExpires = false then
EnableMenuItem(GetSystemMenu(Handle, false), SC_CLOSE,
MF_BYCOMMAND or MF_GRAYED)
else
EnableMenuItem(GetSystemMenu(Handle, false), SC_CLOSE,
MF_BYCOMMAND or MF_ENABLED);
Result := true;
except
Result := false;
cf_sysLog(
'设置窗体关闭按钮状态函数过程中失败! 错误位置:[function cf_sysSetFormCloseBtnStatus(Handle: HWND;'
+ 'bExpires: Boolean = false): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: BMP图片文件转换为JPG图片文件
// 函数名称: cf_gdiConvertBMPtoJPG(const sFileName, sToFileName: string):Boolean;
// 函数参数: sFileName :String要转化的文件
// sToFileName :String转化后的文件.
// 返回值: 是否操作成功
// ******************************************************************************
function cf_gdiConvertBMPtoJPG(sFileName, sToFileName: string): Boolean;
var
j: TJPEGImage;
i: TBitmap;
S: string;
begin
Result := false;
S := sFileName;
j := TJPEGImage.Create;
try
try
i := TBitmap.Create;
try
i.LoadFromFile(S);
j.Assign(i);
finally
i.Free;
end;
S := ChangeFileExt(sToFileName, '.jpg');
j.SaveToFile(S);
Application.ProcessMessages;
Result := true;
except
Result := false;
cf_sysLog(
' BMP图片文件转换为JPG图片文件函数过程中失败! 错误位置:[function cf_gdiConvertBMPtoJPG(sFileName,'
+ ' sToFileName: string): Boolean;]');
end;
finally
j.Free;
end;
end;
// ******************************************************************************
// 函数功能: JPG图片文件转换为BMP图片文件
// 函数名称: cf_gdiConvertJPGtoBMP(const sFileName, sToFileName: string):Boolean;
// 函数参数: sFileName :String要转化的文件
// sToFileName :String转化后的文件.
// 返回值: 是否操作成功
// ******************************************************************************
function cf_gdiConvertJPGtoBMP(sFileName, sToFileName: string): Boolean;
var
j: TJPEGImage;
i: TBitmap;
S: string;
begin
Result := false;
S := sFileName;
i := TBitmap.Create;
try
try
j := TJPEGImage.Create;
try
j.LoadFromFile(S);
i.Assign(j);
finally
j.Free;
end;
S := ChangeFileExt(sToFileName, '.bmp');
i.SaveToFile(S);
Application.ProcessMessages;
Result := true;
except
Result := false;
cf_sysLog(
'JPG图片文件转换为BMP图片文件函数过程中失败! 错误位置:[function cf_gdiConvertJPGtoBMP(sFileName, sToFileName: string): Boolean;]');
end;
finally
i.Free;
end;
end;
// ******************************************************************************
// 函数功能: 隐藏桌面图标
// 函数名称: cf_sysHideDesktop;
// 返回值: 是否操作成功
// ******************************************************************************
function cf_sysHideDesktop: Boolean;
var
h, hChild: HWND;
begin
Result := false;
try
h := FindWindow(nil, 'Program Manager');
if h > 0 then
begin
h := GetWindow(h, GW_CHILD);
ShowWindow(h, SW_HIDE);
hChild := GetWindow(h, GW_CHILD);
ShowWindow(hChild, SW_HIDE);
ShowWindow(h, SW_SHOW);
Result := true;
end;
except
Result := false;
cf_sysLog('隐藏桌面图标函数过程中失败! 错误位置:[function cf_sysHideDesktop: Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 显示桌面图标
// 函数名称: cf_sysShowDesktop;
// 返回值: 是否操作成功
// ******************************************************************************
function cf_sysShowDesktop: Boolean;
var
h, hChild: HWND;
begin
Result := false;
try
h := FindWindow(nil, 'Program Manager');
if h > 0 then
begin
h := GetWindow(h, GW_CHILD);
ShowWindow(h, SW_SHOW);
hChild := GetWindow(h, GW_CHILD);
ShowWindow(hChild, SW_SHOW);
Result := true;
end;
except
Result := false;
cf_sysLog('显示桌面图标函数过程中失败! 错误位置:[function cf_sysShowDesktop: Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取Windows Product ID
// 函数名称: cf_sysGetWindowsProductID;
// 返回值: 产品序号ID
// ******************************************************************************
function cf_sysGetWindowsProductID: string;
var
Reg: TRegistry;
begin
Result := '';
try
Reg := TRegistry.Create;
with Reg do
begin
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('Software\Microsoft\Windows\CurrentVersion', false);
Result := ReadString('ProductID');
end;
Reg.Free;
except
Result := '';
cf_sysLog(
'获取Windows Product ID函数过程中失败! 错误位置:[function cf_sysGetWindowsProductID: string;]');
end;
end;
// ******************************************************************************
// 函数功能: 将字节(255数 10)转化为2进制字符串
// 函数名称: cf_valByteToBin
// 函数参数: Value :String要转化的字节(10进制)
// 返回值: 二进制字符串
// ******************************************************************************
function cf_valByteToBin(Value: Byte): string;
const
V: Byte = 1;
var
i: Integer;
begin
try
for i := 7 downto 0 do
if (V shl i) and Value <> 0 then
Result := Result + '1'
else
Result := Result + '0';
except
Result := '';
cf_sysLog(
'将字节(255数 10)转化为2进制字符串函数过程中失败! 错误位置:[function cf_valByteToBin(Value: Byte): string;]');
end;
end;
// ******************************************************************************
// 函数功能: 字符串转化为16进制字符串.
// 函数名称: cf_valStrToHex
// 函数参数: AStr :String 字符串
// 返回值: 16进制字符串
// ******************************************************************************
function cf_valStrToHex(AStr: string): string;
var
i: Integer;
// Tmp: string;
begin
try
Result := '';
for i := 1 to Length(AStr) do
begin
Result := Result + Format('%2x', [Byte(AStr[i])]);
end;
i := Pos(' ', Result);
while i <> 0 do
begin
Result[i] := '0';
i := Pos(' ', Result);
end;
except
Result := '';
cf_sysLog(
'字符串转化为16进制字符串函数过程中失败! 错误位置:[function cf_valStrToHex(AStr: string): string;]');
end;
end;
// ******************************************************************************
// 函数功能: 创建系统快捷方式
// 函数名称: cf_sysCreateShortCut
// 函数参数: sFileName :String 文件路径
// sDisplayName :String 显示的内容.
// 返回值: 是否操作成功.
// ******************************************************************************
function cf_sysCreateShortCut(sFileName: string; sDisplayName: string)
: Boolean;
var
tmpObject: IUnknown;
tmpSLink: IShellLink;
tmpPFile: IPersistFile;
PIDL: PItemIDList;
StartupDirectory: array [0 .. MAX_PATH] of Char;
StartupFilename: string;
LinkFilename: WideString;
begin
Result := false;
try
StartupFilename := sFileName;
tmpObject := CreateComObject(CLSID_ShellLink);
tmpSLink := tmpObject as IShellLink;
tmpPFile := tmpObject as IPersistFile;
tmpSLink.SetPath(PWideChar(StartupFilename));
tmpSLink.SetWorkingDirectory(PWideChar(ExtractFilePath(StartupFilename))
);
SHGetSpecialFolderLocation(0, CSIDL_DESKTOPDIRECTORY, PIDL);
SHGetPathFromIDList(PIDL, StartupDirectory);
LinkFilename := IncludeTrailingPathDelimiter(StartupDirectory)
+ sDisplayName + '.lnk';
tmpPFile.Save(pWChar(LinkFilename), false);
Result := true;
except
Result := false;
cf_sysLog(
'创建系统快捷方式函数过程中失败! 错误位置:[function cf_sysCreateShortCut(sFileName: string;sDisplayName: string): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 16进制字符转化为字符串.
// 函数名称: cf_valHexToStr
// 函数参数: AStr :String 16进制字符串
// 返回值: 16进制字符串
// ******************************************************************************
function cf_valHexToStr(AStr: string): string;
var
i: Integer;
CharValue: Word;
function TransChar(AChar: Char): Integer;
begin
if AChar in ['0' .. '9'] then
Result := Ord(AChar) - Ord('0')
else
Result := 10 + Ord(AChar) - Ord('A');
end;
begin
Result := '';
try
for i := 1 to Trunc(Length(AStr) / 2) do
begin
Result := Result + ' ';
CharValue := TransChar(AStr[2 * i - 1]) * 16 + TransChar(AStr[2 * i]);
Result[i] := Char(CharValue);
end;
except
Result := '';
cf_sysLog(
'16进制字符转化为字符串函数过程中失败! 错误位置:[function cf_valHexToStr(AStr: string): string;]');
end;
end;
// ******************************************************************************
// 函数功能: 移动文件
// 函数名称: cf_fileMoveFile
// 函数参数: sName :String 要移动的文件
// dName :string 移动到指定的文件
// 返回值: 是否成功
// ******************************************************************************
function cf_fileMoveFile(sName, dName: string): Boolean;
var
s1, s2: AnsiString;
lpFileOp: TSHFileOpStruct;
begin
try
s1 := PWideChar(sName) + #0#0;
s2 := PWideChar(dName) + #0#0;
with lpFileOp do
begin
Wnd := Application.Handle;
wFunc := FO_MOVE;
pFrom := PWideChar(s1);
pTo := PWideChar(s2);
fFlags := FOF_ALLOWUNDO;
hNameMappings := nil;
lpszProgressTitle := nil;
fAnyOperationsAborted := true;
end;
Result := SHFileOperation(lpFileOp) = 0;
except
Result := false;
cf_sysLog(
'移动文件函数过程中失败! 错误位置:[function cf_fileMoveFile(sName, dName: string): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 屏幕分辨率设置
// 函数名称: cf_hardSetMonitorResolution
// 函数参数: Width :WORD 屏宽
// Height :WORD 移动到指定的文件
// 返回值: 是否成功
// ******************************************************************************
function cf_hardSetMonitorResolution(Width, Height: Word): Boolean;
var
lpDevMode: TDeviceMode;
begin
try
Result := EnumDisplaySettings(nil, 0, lpDevMode);
if Result then
begin
lpDevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
lpDevMode.dmPelsWidth := Width;
lpDevMode.dmPelsHeight := Height;
Result := ChangeDisplaySettings(lpDevMode, 0)
= DISP_CHANGE_SUCCESSFUL;
end;
except
Result := false;
cf_sysLog(
'屏幕分辨率设置函数过程中失败! 错误位置:[function cf_hardSetMonitorResolution(Width, Height: Word): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 判断声卡是否存在
// 函数名称: cf_hardIsSoundCardExist
// 返回值: 是否存在声卡
// ******************************************************************************
function cf_hardIsSoundCardExist: Boolean;
begin
try
Result := WaveOutGetNumDevs > 0;
except
Result := false;
cf_sysLog(
'判断声卡是否存在函数过程中失败! 错误位置:[function cf_hardIsSoundCardExist: Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取当前CPU频率
// 函数名称: cf_hardGetCPUSpeed
// 返回值: CPU频率值 浮点型
// ******************************************************************************
function cf_hardGetCPUSpeed: Double;
const
DelayTime = 500;
var
TimerHi, TimerLo: DWORD;
PriorityClass, Priority: Integer;
begin
try
PriorityClass := GetPriorityClass(GetCurrentProcess);
Priority := GetThreadPriority(GetCurrentThread);
SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
asm
dw 310Fh
mov TimerLo, eax
mov TimerHi, edx
end
;
Sleep(DelayTime);
asm
dw 310Fh
sub eax, TimerLo
sbb edx, TimerHi
mov TimerLo, eax
mov TimerHi, edx
end
;
SetThreadPriority(GetCurrentThread, Priority);
SetPriorityClass(GetCurrentProcess, PriorityClass);
Result := TimerLo / (1000.0 * DelayTime);
except
Result := 0.00;
cf_sysLog(
'获取当前CPU频率函数过程中失败! 错误位置:[function cf_hardGetCPUSpeed: Double;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取当前CPU的个数
// 函数名称: cf_hardGetCPUNum
// 返回值: 字符串
// ******************************************************************************
function cf_hardGetCPUNum: string;
begin
try
Result := GetEnvironmentVariable('NUMBER_OF_PROCESSORS');
except
Result := '';
cf_sysLog
('获取当前CPU的个数函数过程中失败! 错误位置:[function cf_hardGetCPUNum: string;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取CPU的核心架构
// 函数名称: cf_hardGetCPUArchitec
// 返回值: 字符串
// ******************************************************************************
function cf_hardGetCPUArchitec: string;
begin
try
Result := GetEnvironmentVariable('PROCESSOR_ARCHITECTURE');
except
Result := '';
cf_sysLog(
'获取CPU的核心架构函数过程中失败! 错误位置:[function cf_hardGetCPUArchitec: string;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取CPU的型号
// 函数名称: cf_hardGetCPUTypeNo
// 返回值: 字符串
// ******************************************************************************
function cf_hardGetCPUTypeNo: string;
begin
try
Result := GetEnvironmentVariable('PROCESSOR_LEVEL')
+ GetEnvironmentVariable('PROCESSOR_REVISION');
except
Result := '';
cf_sysLog(
'获取CPU的型号函数过程中失败! 错误位置:[function cf_hardGetCPUTypeNo: string;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取系统域工作组信息
// 函数名称: cf_sysGetDomain
// 返回值: 字符串
// ******************************************************************************
function cf_sysGetDomain: string;
begin
try
Result := GetEnvironmentVariable('USERDOMAIN');
except
Result := '';
cf_sysLog
('获取系统域工作组信息函数过程中失败! 错误位置:[function cf_sysGetDomain: string;]');
end;
end;
// ******************************************************************************
// 函数功能: 根据应用程序名获取进程ID
// 函数名称: cf_sysGetAppProcessID
// 函数参数: sAppExeName :string 应用程序名
// 返回值: 返回进程编号.
// ******************************************************************************
function cf_sysGetAppProcessID(sAppExeName: string): Cardinal;
var
ContinueLoop: BOOL;
SnapshotHandle: THandle;
ProcessEntry32: TProcessEntry32;
begin
Result := 0;
try
SnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
ProcessEntry32.dwSize := SizeOf(ProcessEntry32);
ContinueLoop := Process32First(SnapshotHandle, ProcessEntry32);
while ContinueLoop do
begin
if LowerCase(ExtractFileName(string(ProcessEntry32.szExeFile)))
= LowerCase(sAppExeName) then
begin
Result := ProcessEntry32.th32ProcessID;
Break;
end;
ContinueLoop := Process32Next(SnapshotHandle, ProcessEntry32);
end;
CloseHandle(SnapshotHandle);
except
Result := 0;
cf_sysLog(
'根据应用程序名获取进程ID函数过程中失败! 错误位置:[function cf_sysGetAppProcessID(sAppExeName: string): Cardinal;]');
end;
end;
// ******************************************************************************
// 函数功能: 根据应用程序名终止进程.
// 函数名称: cf_sysKillProcess
// 函数参数: sAppExeName :string 应用程序名
// 返回值: 操作是否成功
// ******************************************************************************
function cf_sysKillProcess(sAppExeName: string): Boolean; overload;
const
PROCESS_TERMINATE = $0001;
var
HProcess: THandle;
ProcessID: Cardinal;
ExitCode: Cardinal;
begin
Result := false;
try
ProcessID := cf_sysGetAppProcessID(sAppExeName);
if ProcessID <> 0 then
begin
HProcess := OpenProcess(PROCESS_TERMINATE, false, ProcessID);
if HProcess <> 0 then
begin
GetExitCodeProcess(HProcess, ExitCode);
Result := TerminateProcess(HProcess, ExitCode);
end;
end;
except
Result := false;
cf_sysLog(
'根据应用程序名终止进程函数过程中失败! 错误位置:[function cf_sysKillProcess(sAppExeName: string): Boolean; overload;]');
end;
end;
// ******************************************************************************
// 函数功能: 根据进程ID号杀死应用程序进程
// 函数名称: cf_sysKillProcess
// 函数参数: cProcessID: Cardinal 进程ID
// 返回值: 操作是否成功
// ******************************************************************************
function cf_sysKillProcess(cProcessID: Cardinal): Boolean; overload;
const
PROCESS_TERMINATE = $0001;
var
HProcess: THandle;
ExitCode: Cardinal;
begin
Result := false;
try
if cProcessID <> 0 then
begin
HProcess := OpenProcess(PROCESS_TERMINATE, false, cProcessID);
if HProcess <> 0 then
begin
GetExitCodeProcess(HProcess, ExitCode);
Result := TerminateProcess(HProcess, ExitCode);
end;
end;
except
Result := false;
cf_sysLog(
'根据进程ID号杀死应用程序进程函数过程中失败! 错误位置:[function cf_sysKillProcess(cProcessID: Cardinal): Boolean; overload;]');
end; ;
end;
// ******************************************************************************
// 函数功能: 获取当前系统的Windows目录
// 函数名称: cf_sysGetWindowsPath
// 返回值: Windows路径
// ******************************************************************************
function cf_sysGetWindowsPath: string;
var
pcWindowsDirectory: PWideChar;
dwWDSize: DWORD;
begin
dwWDSize := MAX_PATH + 1;
Result := '';
GetMem(pcWindowsDirectory, dwWDSize);
try
try
if Windows.GetWindowsDirectory(pcWindowsDirectory, dwWDSize) <> 0 then
Result := pcWindowsDirectory;
except
Result := '';
cf_sysLog(
'获取当前系统的Windows目录函数过程中失败! 错误位置:[function cf_sysGetWindowsPath: string;]');
end;
finally
FreeMem(pcWindowsDirectory);
end;
end;
// ******************************************************************************
// 函数功能: 获取数据库服务器系统时间
// 函数名称: cf_dbGetSysTime
// 函数参数: oADOConnection:TADOConnection 数据库连接对象
// sFormat: string 返回日期格式
// 返回值: 16进制字符串
// ******************************************************************************
function cf_dbGetSysTime(oADOConnection: TADOConnection = nil;
sFormat: string = 'YYYY-MM-DD HH:MM:SS'): string; overload;
var
sSQL: string;
oADOQuery: TADOQuery;
begin
oADOQuery := TADOQuery.Create(nil);
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString) = '')
then
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) <> '')
then
begin
oADOConnection := goADOConDef;
end
else
begin
Result := '';
Exit;
end;
end
else
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) = '')
then
begin
if goADOConDef.Connected then
goADOConDef.Connected := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
goADOConDef.LoginPrompt := false;
if not goADOConDef.Connected then
goADOConDef.Open;
end
else if (goADOConDef = nil) and
(Trim(goADOConDef.ConnectionString) = '') then
begin
goADOConDef := TADOConnection(Application);
goADOConDef.LoginPrompt := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
if not goADOConDef.Connected then
goADOConDef.Open;
end;
end;
if oADOConnection = nil then
begin
Result := '';
Exit;
end;
try
try
if Pos(WideString('Microsoft.Jet.OLEDB.4.0'), WideString
(oADOConnection.ConnectionString)) <> 0 then
begin
sSQL := 'Select now() as SYSDATE';
end
else if Pos(WideString('SQLOLEDB.1'), WideString
(oADOConnection.ConnectionString)) <> 0 then
begin
sSQL := 'Select getDate() as SYSDATE';
end
else if (Pos(WideString('OraOLEDB.Oracle.1'), WideString
(oADOConnection.ConnectionString)) <> 0) or
(Pos(WideString('OraOLEDB.Oracle.1'), WideString
(oADOConnection.ConnectionString)) <> 0) then
begin
sSQL := 'Select sysdate from Dual';
end
else
begin
sSQL := 'Select getDate() as SYSDATE';
end;
oADOQuery.SQL.Clear;
oADOQuery.Connection := oADOConnection;
oADOQuery.SQL.ADD(sSQL);
oADOQuery.Open;
if oADOQuery.IsEmpty then
begin
Result := '1900-01-01 00:00:00';
Exit;
end
else
begin
oADOQuery.First;
Result := FormatDateTime(sFormat, oADOQuery.FieldByName('SYSDATE')
.AsDateTime);
end;
except
Result := '1900-01-01 00:00:00';
cf_sysLog(
'获取数据库服务器系统时间函数过程中失败! 错误位置:[function cf_dbGetSysTime(oADOConnection: TADOConnection = nil;'
+ 'sFormat: string = ''YYYY-MM-DD HH:MM:SS''): string; overload;] 执行Sql:[' + sSQL + ']');
end;
if oADOQuery.Active then
oADOQuery.Close;
finally
oADOQuery.Free;
end;
end;
// ******************************************************************************
// 函数功能: 获取指定磁盘的空间大小以及空闲大小.
// 函数名称: cf_sysGetDiskSpace
// 函数参数: sDriver :String 盘符
// ToTalBytes :double 总大小
// TotalFree :double 空闲大小
// 返回值: 指定磁盘大小的
// ******************************************************************************
function cf_sysGetDiskSpace(sDriver: string; var TotalBytes,
TotalFree: Double): string;
var
sec1, byt1, cl1, cl2: Longword;
begin
try
GetDiskFreeSpace(PWideChar(sDriver), sec1, byt1, cl1, cl2);
TotalFree := cl1 * sec1 * byt1;
TotalBytes := cl2 * sec1 * byt1;
Result := '盘符:' + sDriver + #10#13 + '总空间:' + FloatToStr
(TotalBytes / 1024 / 1024) + 'M 字节' + #10#13 + '可用空间:' + FloatToStr
(TotalFree / 1024 / 1024) + 'M 字节' except Result := '';
cf_sysLog(
'获取指定磁盘的空间大小以及空闲大小函数过程中失败! 错误位置:[function cf_sysGetDiskSpace(sDriver: string;'
+ 'var TotalBytes, TotalFree: Double): string;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取指定日期时间的中文周次
// 函数名称: cf_dateGetCHWeek
// 函数参数: aDate:TDateTime 指定的日期时间
// 返回值: 周次
// ******************************************************************************
function cf_dateGetCHWeek(aDate: TDateTime): string;
const
sWeek: array [1 .. 7] of string = ('星期日', '星期一', '星期二', '星期三', '星期四',
'星期五', '星期六');
var
cWeek: Integer;
begin
try
cWeek := DayOfWeek(aDate);
Result := Trim(sWeek[cWeek]);
except
Result := '';
cf_sysLog(
'获取指定日期时间的中文周次函数过程中失败! 错误位置:[function cf_dateGetCHWeek(aDate: TDateTime): string;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取计算机名
// 函数名称: cf_sysGetComputerName
// 返回值: 计算机名
// ******************************************************************************
function cf_sysGetComputerName: string;
var
CNameBuffer: PWideChar;
fl_loaded: Boolean;
CLen: ^DWORD;
begin
try
GetMem(CNameBuffer, 255);
New(CLen);
CLen^ := 255;
fl_loaded := GetComputerName(CNameBuffer, CLen^);
if fl_loaded then
Result := StrPas(CNameBuffer)
else
Result := 'Unkown';
FreeMem(CNameBuffer, 255);
Dispose(CLen);
except
Result := '';
cf_sysLog(
'获取计算机名函数过程中失败! 错误位置:[function cf_sysGetComputerName: string;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取IP地址
// 函数名称: cf_sysGetIPAddress
// 参数: 无
// 返回值: 计算机名
// ******************************************************************************
function cf_sysGetIPAddress: string;
type
TaPInAddr = array [0 .. 10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
lphe: PHostEnt;
lpptr: PaPInAddr;
lcarrBuffer: array [0 .. 63] of AnsiChar;
i: Integer;
sComputerName, sComputerAddr: string;
lGInitData: TWSADATA;
begin
try
// 初始化数据
WSAStartup($101, lGInitData);
sComputerName := '';
sComputerAddr := '';
// 调用 函数得到本地计算机名称
GetHostName(lcarrBuffer, SizeOf(lcarrBuffer));
sComputerName := PWideChar(StrPas(lcarrBuffer));
lphe := GetHostByName(lcarrBuffer);
if lphe = nil then
Exit;
// 取得本地计算机的IP
lpptr := PaPInAddr(lphe^.h_addr_list);
i := 0;
while lpptr^[i] <> nil do
begin
sComputerAddr := inet_ntoa(lpptr^[i]^);
Inc(i);
end;
// 释放和清空信息
WSACleanup;
Result := sComputerAddr;
except
Result := '';
cf_sysLog('获取IP地址函数过程中失败! 错误位置:[function cf_sysGetIPAddress: string;]');
end;
end;
// ******************************************************************************
// 函数功能: StringGrid导出Excel
// 函数名称: cf_dbGridExportExcel
// 函数参数: oStringGrid TStringGrid 数据集
// sFileName String 导出的文件名（系统会自动追加时间)
// Handle HWND 要使用的窗口句柄。
// 返回值: 返回是否操作成功
// ******************************************************************************
function cf_dbGridExportExcel(oStringGrid: TStringGrid; sFileName: string;
Handle: HWND): Boolean;
var
oSaveDialog: TSaveDialog;
ExcelApp: Variant;
bResult: Boolean;
iCountX, iCountY: Integer;
begin
bResult := false;
if (oStringGrid = nil) or (Trim(sFileName) = '') then
begin
bResult := false;
end
else
begin
oSaveDialog := TSaveDialog.Create(nil);
oSaveDialog.Title := '导出到电子表格';
oSaveDialog.Filter := 'Excel电子表格|*.xls';
oSaveDialog.FileName := sFileName + '.xls';
try
ExcelApp := CreateOleObject('Excel.Application');
ExcelApp.Visible := false;
except
cf_sysMsgBox('您的系统没有安装Excel软件,请确认安装后再进行此项功能!', MB_OK + MB_ICONERROR,
Handle);
bResult := false;
cf_sysLog(
'未安装Excel软件导致ADOQuery导出到Excel函数过程中失败! 错误位置:[function cf_dbGridExportExcel(oStringGrid: TStringGrid;'
+ ' sFileName: string; Handle: HWND): Boolean;]');
end;
if oSaveDialog.Execute then
begin
try
ExcelApp.Visible := false;
ExcelApp.WorkBooks.Open(oSaveDialog.FileName);
ExcelApp.WorkSheets[1].Activate;
if (oStringGrid.ColCount > 0) and (oStringGrid.RowCount > 0) then
begin
for iCountX := 0 to oStringGrid.ColCount - 1 do // 记录
begin
for iCountY := 0 to oStringGrid.RowCount - 1 do
begin
ExcelApp.Cells[1, iCountY + 1].Value := oStringGrid.Cells
[iCountX, iCountY];
end;
end;
ExcelApp.SaveAs(oSaveDialog.FileName);
ExcelApp.ActiveWorkBook.Saved := true;
cf_sysMsgBox('导出电子表格成功!', 0, Handle);
bResult := true;
end;
ExcelApp.WorkBooks.Close;
ExcelApp.Quit;
ExcelApp := Unassigned;
except
try
ExcelApp.Quit;
ExcelApp := Unassigned;
except
bResult := false;
cf_sysLog(
'释放Excel对象失败,导致StringGrid导出Excel函数过程中失败! 错误位置:[function cf_dbGridExportExcel(oStringGrid: TStringGrid;'
+ 'sFileName: string; Handle: HWND): Boolean;]');
end;
bResult := false;
cf_sysMsgBox('导出Excel文件失败!', MB_OK + MB_ICONERROR, Handle);
cf_sysLog(
'StringGrid导出Excel函数过程中失败! 错误位置:[function cf_dbGridExportExcel(oStringGrid: TStringGrid;'
+ 'sFileName: string; Handle: HWND): Boolean;]');
end;
end;
end;
Result := bResult;
end;
// ******************************************************************************
// 函数功能: ADOQuery导出到Excel
// 函数名称: cf_dbADOQueryExportExcel
// 函数参数: oStringGrid TStringGrid 数据集
// sFileName String 导出的文件名（系统会自动追加时间)
// Handle HWND 要使用的窗口句柄。
// 返回值: 返回是否操作成功
// ******************************************************************************
function cf_dbADOQueryExportExcel(oADOQuery: TADOQuery; sFileName: string;
Handle: HWND): Boolean;
var
oSaveDialog: TSaveDialog;
ExcelApp: Variant;
bResult: Boolean;
iCountX, iCountY: Integer;
begin
bResult := false;
if (oADOQuery = nil) or (Trim(sFileName) = '') then
begin
bResult := false;
end
else
begin
try
oSaveDialog := TSaveDialog.Create(nil);
oSaveDialog.Title := '导出到电子表格';
oSaveDialog.Filter := 'Excel电子表格文档|*.xls';
oSaveDialog.FileName := sFileName + FormatDateTime('YYMMDDHHMM', Now)
+ '.xls';
if oSaveDialog.Execute then
begin
try
ExcelApp := CreateOleObject('Excel.Application');
ExcelApp.Visible := false;
except
cf_sysMsgBox('您的系统没有安装Excel软件,请确认安装后再进行此项功能!',
MB_OK + MB_ICONERROR, Handle);
bResult := false;
cf_sysLog(
'未安装Excel软件导致ADOQuery导出到Excel函数过程中失败! 错误位置:[function cf_dbADOQueryExportExcel(oADOQuery: TADOQuery; '
+ ' sFileName: string; Handle: HWND): Boolean;]');
end;
try
ExcelApp.Visible := false;
ExcelApp.WorkBooks.ADD;
// ExcelApp.WorkSheets[1].Activate;
if (oADOQuery.Active) and (oADOQuery.RecordCount > 0) then
begin
for iCountY := 0 to oADOQuery.FieldCount - 1 do
begin
ExcelApp.Cells[1, iCountY + 1].Font.Size := 10;
ExcelApp.Cells[1, iCountY + 1].Font.Color := clCaptionText;
ExcelApp.Cells[1, iCountY + 1].Value := oADOQuery.Fields
[iCountY].DisplayLabel;
end;
oADOQuery.First;
for iCountX := 0 to oADOQuery.RecordCount - 1 do // 记录
begin
for iCountY := 0 to oADOQuery.FieldCount - 1 do
begin
ExcelApp.Cells[iCountX + 1, iCountY + 1].Value :=
oADOQuery.Fields[iCountY].AsString;
end;
oADOQuery.Next;
end;
ExcelApp.ActiveWorkBook.SaveAs(oSaveDialog.FileName);
ExcelApp.ActiveWorkBook.Saved := true;
cf_sysMsgBox('导出电子表格成功!', 0, Handle);
bResult := true;
end;
except
bResult := false;
cf_sysMsgBox('导出Excel文件失败!', MB_OK + MB_ICONERROR, Handle);
cf_sysLog(
'ADOQuery导出到Excel函数过程中失败! 错误位置:[function cf_dbADOQueryExportExcel(oADOQuery: TADOQuery; '
+ ' sFileName: string; Handle: HWND): Boolean;]');
end;
end;
finally
oSaveDialog.Free;
try
ExcelApp.WorkBooks.Close;
ExcelApp.Quit;
ExcelApp := Unassigned;
except
cf_sysLog(
'释放Excel对象时导致ADOQuery导出到Excel函数过程中失败! 错误位置:[function cf_dbADOQueryExportExcel(oADOQuery: TADOQuery; '
+ ' sFileName: string; Handle: HWND): Boolean;]');
end;
end;
end;
Result := bResult;
end;
// ******************************************************************************
// 函数功能: Excel导入到oADOQuery中
// 函数名称: cf_dbADOQueryExportExcel
// 函数参数: oADOQuery: TADOQuery 数据集
// sTableName: string 表名
// Handle HWND 要使用的窗口句柄。
// bHasAutoID: Boolean = False Excel中是否有自增字段
// 返回值: 返回是否操作成功
// ******************************************************************************
function cf_dbExcelImportADOQuery(oADOQuery: TADOQuery; sTableName: string;
Handle: HWND; bHasAutoID: Boolean = false): Boolean;
var
oOpenDialog: TOpenDialog;
ExcelApp: Variant;
iCountX, iCountY, iErrorX, iErrorY, iColumnNum: Integer;
iMsgInfo: Integer;
sSQL: string;
bResult: Boolean;
begin
bResult := false;
oOpenDialog := TOpenDialog.Create(nil);
try
ExcelApp := CreateOleObject('Excel.Application');
ExcelApp.Visible := false;
except
cf_sysMsgBox('您的系统没有安装Excel软件,请确认安装后再进行此项功能!', MB_OK + MB_ICONERROR,
Handle);
bResult := false;
end;
if (oADOQuery = nil) or (not Assigned(oADOQuery)) then
begin
bResult := false;
Exit;
end;
// 打开文件
if oOpenDialog.Execute then
begin
ExcelApp.WorkBooks.Open(oOpenDialog.FileName);
ExcelApp.WorkSheets[1].Activate;
// 询问客户是否要覆盖以前的数据
iMsgInfo := cf_sysMsgBox(
'要覆盖当前维护的所有记录吗？'#10#13'数据将不可恢复，请谨慎使用！'#10#13'是--覆盖，否--追加，取消--取消当前导入操作。'
, MB_YESNOCANCEL + MB_ICONQUESTION, Handle);
// 覆盖数据
if iMsgInfo = ID_YES then
begin
try
// 删除原记录
if cf_sysMsgBox('您确定要删除原数据信息吗？', MB_OKCANCEL + MB_ICONINFORMATION,
Handle) = ID_OK then
begin
try
sSQL := 'Delete from ' + sTableName;
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.SQL.Clear;
oADOQuery.SQL.ADD(sSQL);
oADOQuery.ExecSQL;
except
cf_sysLog(
'删除原有数据失败Excel导入到oADOQuery函数过程中异常，并未退出! 错误位置:[function cf_dbExcelImportADOQuery(oADOQuery: TADOQuery;'
+ 'sTableName: string; Handle: HWND; bHasAutoID: Boolean = false): Boolean;]', false);
end;
end;
oADOQuery.Close;
oADOQuery.SQL.Clear;
oADOQuery.SQL.ADD('Select * from ' + sTableName);
oADOQuery.Open;
if bHasAutoID then
iColumnNum := ExcelApp.ActiveSheet.UsedRange.Columns.Count - 1
else
iColumnNum := ExcelApp.ActiveSheet.UsedRange.Columns.Count;
for iCountY := 2 to ExcelApp.ActiveSheet.UsedRange.Rows.Count do
begin
try
oADOQuery.Append;
for iCountX := 1 to iColumnNum do
begin
try
if not bHasAutoID then
begin
if oADOQuery.Fields[iCountX - 1].DataType in
[ftMemo, ftString, ftWideString] then
oADOQuery.Fields[iCountX - 1].AsString := VarToStr
(ExcelApp.Cells[iCountY, iCountX].Value)
else if oADOQuery.Fields[iCountX - 1].DataType in
[ftSmallint, ftInteger, ftLargeint, ftFloat,
ftCurrency] then
oADOQuery.Fields[iCountX - 1].AsString := vartostrDef
(ExcelApp.Cells[iCountY, iCountX].Value, '0')
else if oADOQuery.Fields[iCountX - 1].DataType in
[ftDate, ftTime, ftDateTime] then
oADOQuery.Fields[iCountX - 1].AsString := vartostrDef
(ExcelApp.Cells[iCountY, iCountX].Value, DateTimeToStr
(Now))
else
oADOQuery.Fields[iCountX - 1].Value := ExcelApp.Cells
[iCountY, iCountX].Value;
end
else
begin
if oADOQuery.Fields[iCountX].DataType in
[ftMemo, ftString, ftWideString] then
oADOQuery.Fields[iCountX].AsString := VarToStr
(ExcelApp.Cells[iCountY, iCountX + 1].Value)
else if oADOQuery.Fields[iCountX].DataType in
[ftSmallint, ftInteger, ftLargeint, ftFloat,
ftCurrency] then
oADOQuery.Fields[iCountX].AsString := vartostrDef
(ExcelApp.Cells[iCountY, iCountX + 1].Value, '0')
else if oADOQuery.Fields[iCountX].DataType in
[ftDate, ftTime, ftDateTime] then
oADOQuery.Fields[iCountX].AsString := vartostrDef
(ExcelApp.Cells[iCountY, iCountX + 1].Value,
DateTimeToStr(Now))
else
oADOQuery.Fields[iCountX].Value := ExcelApp.Cells
[iCountY, iCountX].Value;
end;
// ShowMessage(VarToStr(ExcelApp.cells[iCountY,iCountX].Value));
except
Inc(iErrorX);
cf_sysLog(
'覆盖导入到oADOQuery函数过程中异常，并未退出! 错误位置:[function cf_dbExcelImportADOQuery(oADOQuery: TADOQuery;'
+ 'sTableName: string; Handle: HWND; bHasAutoID: Boolean = false): Boolean;] 错误行:[' + IntToStr(iErrorX) + ']', false);
Continue;
end;
end;
except
Inc(iErrorY);
cf_sysLog(
'覆盖导入到oADOQuery函数过程中异常，并未退出! 错误位置:[function cf_dbExcelImportADOQuery(oADOQuery: TADOQuery;'
+ 'sTableName: string; Handle: HWND; bHasAutoID: Boolean = false): Boolean;] 错误行:[' + IntToStr(iErrorY) + ']', false);
Continue;
oADOQuery.Post;
end;
if (iErrorX = 0) and (iErrorY = 0) then
begin
bResult := true;
cf_sysMsgBox('导入数据成功!', 0, Handle);
end
else
begin
cf_sysMsgBox('导入数据失败行数:' + IntToStr(iErrorY) + ',列数:' + IntToStr
(iErrorX), MB_OK + MB_ICONERROR, Handle);
bResult := false;
end;
end;
except
cf_sysMsgBox('导入数据失败！', MB_OK + MB_ICONERROR, Handle);
bResult := false;
cf_sysLog(
'覆盖导入到oADOQuery函数过程中失败! 错误位置:[function cf_dbExcelImportADOQuery(oADOQuery: TADOQuery;'
+ 'sTableName: string; Handle: HWND; bHasAutoID: Boolean = false): Boolean;]');
end;
end;
// 追加数据
if iMsgInfo = ID_NO then
begin
try
oADOQuery.Close;
oADOQuery.SQL.Clear;
oADOQuery.SQL.ADD('Select * from ' + sTableName);
oADOQuery.Open;
// Rows(字段名称除外,所以iCountY)
for iCountY := 2 to ExcelApp.ActiveSheet.UsedRange.Rows.Count do
begin
try
oADOQuery.Append;
for iCountX :=
1 to ExcelApp.ActiveSheet.UsedRange.Columns.Count do
begin
try
if not bHasAutoID then
// Hasn't AutoID Fields.
oADOQuery.Fields[iCountX - 1].Value := ExcelApp.Cells
[iCountY, iCountX].Value
else
// Has AutoID Fields (Need AutoID Order is First.)
oADOQuery.Fields[iCountX].Value := ExcelApp.Cells
[iCountY, iCountX].Value;
except
Inc(iErrorX);
cf_sysLog(
'追加导入到oADOQuery函数过程中异常，并未退出! 错误位置:[function cf_dbExcelImportADOQuery(oADOQuery: TADOQuery;'
+ 'sTableName: string; Handle: HWND; bHasAutoID: Boolean = false): Boolean;] 错误行:[' + IntToStr(iErrorX) + ']', false);
Continue;
end;
end;
except
Inc(iErrorY);
cf_sysLog(
'追加导入到oADOQuery函数过程中异常，并未退出! 错误位置:[function cf_dbExcelImportADOQuery(oADOQuery: TADOQuery;'
+ 'sTableName: string; Handle: HWND; bHasAutoID: Boolean = false): Boolean;] 错误行:[' + IntToStr(iErrorY) + ']', false);
Continue;
end;
oADOQuery.Post;
end;
if (iErrorX = 0) and (iErrorY = 0) then
begin
bResult := true;
cf_sysMsgBox('导入数据成功!', 0, Handle);
end
else
begin
cf_sysMsgBox('导入数据失败行数:' + IntToStr(iErrorY) + ',列数:' + IntToStr
(iErrorX), MB_OK + MB_ICONERROR, Handle);
bResult := false;
end;
except
cf_sysMsgBox('导入数据失败！', MB_OK + MB_ICONERROR, Handle);
bResult := false;
cf_sysLog(
'追加导入到oADOQuery函数过程失败! 错误位置:[function cf_dbExcelImportADOQuery(oADOQuery: TADOQuery;'
+ 'sTableName: string; Handle: HWND; bHasAutoID: Boolean = false): Boolean;]');
end;
end;
if iMsgInfo = ID_CANCEL then
begin
bResult := false;
cf_sysMsgBox('您取消了当前导入操作!', 0, Handle);
end;
try
ExcelApp.Quit;
ExcelApp := Unassigned;
except
end;
end;
end;
// ******************************************************************************
// 函数功能: 获取表字段最大值
// 函数名称: cf_dbGetFieldMaxValue
// 函数参数: oADOConnection:TADOConnection 连接对象
// sTable:string 表名
// sField:string 字段名
// sDefaultValue:string='' 找不到数据时默认返回字段值
// 返回值: 返回该窗体的返回值。
// ******************************************************************************
function cf_dbGetFieldMaxValue(sTable: string; sField: string;
sCondition: string = ''; sDefaultValue: string = '';
oADOConnection: TADOConnection = nil): string; overload;
var
sSQL: string;
oADOQuery: TADOQuery;
begin
Result := sDefaultValue;
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString) = '')
then
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) <> '')
then
begin
oADOConnection := goADOConDef;
end
else
begin
Result := '';
Exit;
end;
end
else
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) = '')
then
begin
if goADOConDef.Connected then
goADOConDef.Connected := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
goADOConDef.LoginPrompt := false;
if not goADOConDef.Connected then
goADOConDef.Open;
end
else if (goADOConDef = nil) and
(Trim(goADOConDef.ConnectionString) = '') then
begin
goADOConDef := TADOConnection(Application);
goADOConDef.LoginPrompt := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
if not goADOConDef.Connected then
goADOConDef.Open;
end;
end;
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString) = '')
or (Trim(sTable) = '') or (Trim(sField) = '') then
Exit;
sSQL := 'Select Max(' + sField + ') as MaxField from ' + sTable +
' Where 1=1';
if Trim(sCondition) <> '' then
sSQL := sSQL + sCondition;
oADOQuery := TADOQuery.Create(nil);
try
try
oADOQuery.SQL.Clear;
oADOQuery.Connection := oADOConnection;
oADOQuery.SQL.ADD(sSQL);
oADOQuery.Open;
if not oADOQuery.IsEmpty then
begin
oADOQuery.First;
Result := oADOQuery.FieldByName('MaxField').AsString;
end;
except
Result := sDefaultValue;
cf_sysLog(
'获取表字段最大值函数过程失败! 错误位置:[function cf_dbGetFieldMaxValue(sTable: string; sField: string;' + 'sCondition: string = ''''; sDefaultValue: string = '''';oADOConnection: TADOConnection = nil): string; overload;]' + 'SQL:[' + sSQL + ']');
end;
finally
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.Free;
end;
end;
// ******************************************************************************
// 函数功能: 显示窗体
// 函数名称: cf_sysShowForm
// 函数参数: aTForm: TFormClass窗体类
// aPTForm TForm 父窗体
// iTag 给FOrm传递的Tag值
// tStyle 显示窗体样式。
// 返回值: 返回该窗体的返回值。
// ******************************************************************************
function cf_sysShowForm(aTForm: TFormClass; aPTForm: TForm;
iTag: Integer = 0; tStyle: Integer = 0): TModalResult;
var
lfForm: TForm;
begin
Result := mrCancel;
try
lfForm := aTForm.Create(aPTForm);
with lfForm do
begin
Tag := iTag;
if tStyle = 1 then
Show
else if tStyle = 0 then
try
Result := ShowModal finally FreeAndNil(lfForm);
end;
end;
except
Result := mrCancel;
cf_sysLog(
'显示窗体函数过程失败! 错误位置:[function cf_sysShowForm(aTForm: TFormClass; aPTForm: TForm;'
+ 'iTag: Integer = 0; tStyle: Integer = 0): TModalResult;]');
end;
end;
// ******************************************************************************
// 函数功能: 查找指定名称的菜单实例项
// 函数名称: gcf_FindMenuItem;
// 函数参数: sMenuName String 字符串菜单项名称
// oForm: TWinContrl 窗体实例
// 返回值: 返回指定字符串名称的菜单项。
// ******************************************************************************
function cf_ctrlFindMenuItem(sMenuName: string; oForm: TForm): TMenuItem;
var
iCount: Integer;
begin
Result := nil;
if (oForm = nil) then
begin
Exit;
end;
try
with oForm do
for iCount := 0 to ComponentCount - 1 do
begin
if (Components[iCount] is TMenuItem) and
(Components[iCount].Name = sMenuName) then
begin
Result := TMenuItem(Components[iCount]);
Break;
end;
end;
except
Result := nil;
cf_sysLog(
'查找指定名称的菜单实例项函数过程失败! 错误位置:[function cf_ctrlFindMenuItem(sMenuName: string; oForm: TForm): TMenuItem;]');
end;
end;
// ******************************************************************************
// 函数功能: 查找指定内容的树节点
// 函数名称: cf_ctrlFindTreeNodeItem;
// 函数参数: oTreeView:TTreeView 树实例对象
// sFindValue:string; 查找的值
// oFindType:TctvResultType=ctvResultID 查找类型，默认为查找ID号
// 返回值: 返回指定字符串名称的菜单项。
// ******************************************************************************
function cf_ctrlFindTreeNodeItem(oTreeView: TTreeView; sFindValue: string;
oFindType: TctvResultType = ctvResultID): Boolean;
var
iFind: Integer;
begin
Result := false;
try
if (oTreeView = nil) or (Trim(sFindValue) = '') then
begin
Exit;
end;
for iFind := 0 to oTreeView.Items.Count - 1 do
begin
case oFindType of
ctvResultID:
begin
if (pTreeNodeData(oTreeView.Items[iFind].Data)
.sID = sFindValue) then
begin
oTreeView.Items[iFind].Selected := true;
Result := true;
Exit;
end;
end;
ctvResultPID:
begin
if (pTreeNodeData(oTreeView.Items[iFind].Data)
.sPID = sFindValue) then
begin
oTreeView.Items[iFind].Selected := true;
Result := true;
Exit;
end;
end;
ctvResultKeyField:
begin
if (pTreeNodeData(oTreeView.Items[iFind].Data)
.sKeyField = sFindValue) then
begin
oTreeView.Items[iFind].Selected := true;
Result := true;
Exit;
end;
end;
ctvResultDisplayField:
begin
if (pTreeNodeData(oTreeView.Items[iFind].Data)
.sDisplayField = sFindValue) then
begin
oTreeView.Items[iFind].Selected := true;
Result := true;
Exit;
end;
end;
ctvResultData:
begin
if (pTreeNodeData(oTreeView.Items[iFind].Data)
.sData = sFindValue) then
begin
oTreeView.Items[iFind].Selected := true;
Result := true;
Exit;
end;
end;
end;
end;
if not Result then
begin
if oTreeView.Items.Count > 0 then
oTreeView.Items[0].Selected := true;
end;
except
Result := false;
cf_sysLog(
'查找指定内容的树节点函数过程失败! 错误位置:[function cf_ctrlFindTreeNodeItem(oTreeView: TTreeView;'
+ ' sFindValue: string; oFindType: TctvResultType = ctvResultID): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 得到所有子目录文件列表
// 函数名称: cf_fileGetAllSubDirList
// 函数参数: sDirectory string 菜单显示信息
// tRetList TStringList 压缩后生成的文件。
// 返回值: 返回是否操作成功(Boolean);
// ******************************************************************************
function cf_fileGetAllSubDirList(sDirectory: string; tRetList: TComboBox)
: Boolean;
var
SearchRec: TSearchRec;
sTemp: string;
function IsSubDir(SearchRec: TSearchRec): Boolean;
begin
if (SearchRec.Attr = faDirectory) and (SearchRec.Name <> '.') and
(SearchRec.Name <> '..') then
Result := true
else
Result := false;
end;
begin
Result := false;
try
if (tRetList = nil) or (Trim(sDirectory) = '') then
Exit;
if FindFirst(sDirectory + '*.*', faAnyFile, SearchRec) = 0 then
begin
repeat // 循环直到Until为真
if IsSubDir(SearchRec) then
begin
sTemp := sDirectory + SearchRec.Name + '\';
tRetList.Items.ADD(sTemp);
cf_fileGetAllSubDirList(sTemp, tRetList);
// 这是递归部分，查找各子目录。
end;
until (FindNext(SearchRec) <> 0);
end;
tRetList.ItemIndex := 0;
FindClose(SearchRec);
Result := true;
except
Result := false;
cf_sysLog(
'得到所有子目录文件列表函数过程失败! 错误位置:[function cf_fileGetAllSubDirList(sDirectory: string;'
+ 'tRetList: TComboBox): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 执行SQL查询语句
// 函数名称: cf_dbADOQuerySelectSQL
// 函数参数: oADOConnection TADOConnection 数据库连接字符串
// sSQL String SQL结构化语言
// oADOQuery TADOQuery 数据访问组件
// 返回值: 返回是否操作成功(Boolean);
// ******************************************************************************
function cf_dbADOQuerySelectSQL(sSQL: string; oADOQuery: TADOQuery;
oADOConnection: TADOConnection = nil): Boolean; overload;
begin
Result := false;
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString) = '')
then
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) <> '')
then
begin
oADOConnection := goADOConDef;
end
else
begin
Exit;
end;
end
else
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) = '')
then
begin
if goADOConDef.Connected then
goADOConDef.Connected := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
goADOConDef.LoginPrompt := false;
if not goADOConDef.Connected then
goADOConDef.Open;
end
else if (goADOConDef = nil) and
(Trim(goADOConDef.ConnectionString) = '') then
begin
goADOConDef := TADOConnection(Application);
goADOConDef.LoginPrompt := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
if not goADOConDef.Connected then
goADOConDef.Open;
end;
end;
if (oADOConnection = nil) or (Trim(sSQL) = '') or (oADOQuery = nil) then
Exit;
if oADOConnection.ConnectionString = '' then
Exit;
if (not oADOConnection.Connected) then
oADOConnection.Connected := true;
try
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.Connection := oADOConnection;
oADOQuery.SQL.Clear;
oADOQuery.SQL.ADD(sSQL);
oADOQuery.Open;
Result := true;
except
Result := false;
cf_sysLog(
'执行SQL查询语句函数过程失败! 错误位置:[function cf_dbADOQuerySelectSQL(sSQL: string; oADOQuery: TADOQuery;'
+
'oADOConnection: TADOConnection = nil): Boolean; overload;] SQL:['
+ sSQL + ']');
end;
end;
// ******************************************************************************
// 函数功能: 执行SQL语句
// 函数名称: cf_dbSelectSQL
// 函数参数: var oClientDataSet:TClientDataSet; 对象(ClientdataSet)
// sSQL String SQL结构化语言
// sCon String 数据连接字符串
// 返回值: 返回是否操作成功(Integer);
// ******************************************************************************
function cf_dbSelectSQL(var oClientDataSet: TClientDataSet; sSQL: string;
oADOConnection: TADOConnection = nil): Boolean; overload;
var
oADOQuery: TADOQuery;
iField: Integer;
begin
Result := false;
if (oClientDataSet = nil) then
Exit;
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString) = '')
then
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) <> '')
then
begin
oADOConnection := goADOConDef;
end
else
begin
Exit;
end;
end
else
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) = '')
then
begin
if goADOConDef.Connected then
goADOConDef.Connected := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
goADOConDef.LoginPrompt := false;
if not goADOConDef.Connected then
goADOConDef.Open;
end
else if (goADOConDef = nil) and
(Trim(goADOConDef.ConnectionString) = '') then
begin
goADOConDef := TADOConnection(Application);
goADOConDef.LoginPrompt := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
if not goADOConDef.Connected then
goADOConDef.Open;
end;
end;
if (oADOConnection = nil) or (Trim(sSQL) = '') then
Exit;
// 已经被激活，则清空所有字段。
if (oClientDataSet.Active) then
begin
oClientDataSet.Close;
oClientDataSet.FieldDefs.Clear;
end;
try
oADOQuery := TADOQuery.Create(nil);
oClientDataSet.Fields.Clear;
oADOQuery.SQL.Clear;
oADOQuery.SQL.ADD(sSQL);
oADOQuery.Connection := oADOConnection;
oADOQuery.Open;
if oADOQuery.Fields.Count > 0 then
begin
for iField := 0 to oADOQuery.Fields.Count - 1 do
begin
with oClientDataSet.FieldDefs.AddFieldDef do
begin
Name := oADOQuery.Fields[iField].DisplayName;
DataType := oADOQuery.Fields[iField].DataType;
end;
end;
// 建立结构。
oClientDataSet.CreateDataSet;
oClientDataSet.Open;
oClientDataSet.AutoCalcFields := true;
if not oADOQuery.IsEmpty then
begin
// 循环加入列表中
oADOQuery.First;
while not oADOQuery.Eof do
begin
oClientDataSet.Append;
for iField := 0 to oADOQuery.Fields.Count - 1 do
begin
oClientDataSet.FieldByName(oADOQuery.Fields[iField].DisplayName)
.AsString := oADOQuery.FieldByName
(oADOQuery.Fields[iField].DisplayName).AsString;
end;
oClientDataSet.Post;
oADOQuery.Next;
end;
end;
end;
oClientDataSet.Open;
Result := true;
except
on E: Exception do
begin
Result := false;
cf_sysLog(
'执行SQL查询语句函数过程失败! 错误位置:[function cf_dbSelectSQL(var oClientDataSet: TClientDataSet; '
+ 'sSQL: string; oADOConnection: TADOConnection = nil): Boolean; overload;] SQL:[' + sSQL + '],异常[' + E.Message + ']');
end;
end;
end;
// ******************************************************************************
// 函数功能: 执行SQL语句
// 函数名称: cf_dbSelectSQL
// 函数参数: oADOConnection:TADOConnection 数据库连接对象
// sSQL String SQL结构化语言
// 返回值: 返回查询的数据集.
// ******************************************************************************
function cf_dbSelectSQL(sSQL: string; oADOConnection: TADOConnection = nil)
: TADOQuery; overload;
var
oADOQuery: TADOQuery;
begin
Result := nil;
if Trim(sSQL) = '' then
Exit;
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString) = '')
then
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) <> '')
then
begin
oADOConnection := goADOConDef;
end
else
begin
Exit;
end;
end
else
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) = '')
then
begin
if goADOConDef.Connected then
goADOConDef.Connected := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
goADOConDef.LoginPrompt := false;
if not goADOConDef.Connected then
goADOConDef.Open;
end
else if (goADOConDef = nil) and
(Trim(goADOConDef.ConnectionString) = '') then
begin
goADOConDef := TADOConnection(Application);
goADOConDef.LoginPrompt := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
if not goADOConDef.Connected then
goADOConDef.Open;
end;
end;
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString) = '')
then
Exit;
oADOQuery := TADOQuery.Create(nil);
try
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.SQL.Clear;
oADOQuery.Connection := oADOConnection;
oADOQuery.SQL.ADD(sSQL);
oADOQuery.Open;
Result := oADOQuery;
except
on E: Exception do
begin
oADOQuery.Free;
Result := nil;
cf_sysLog(
'执行SQL查询语句函数过程失败! 错误位置:[function cf_dbSelectSQL(sSql: string; ' +
' oADOConnection: TADOConnection = nil): TADOQuery; overload;] SQL:['
+ sSQL + '],异常:[' + E.Message + ']');
end;
end;
end;
// ******************************************************************************
// 函数功能: 是否安装了SQLServer.
// 函数名称: cf_dbIsInstalledSql
// 函数参数: 无
// 返回值: 是否安装了SqlServer.
// ******************************************************************************
function cf_dbIsInstalledSql: Boolean;
var
Registry: TRegistry;
begin
Result := false;
try
Registry := TRegistry.Create;
with Registry do
begin
RootKey := CONST_REG_ROOTKEY;
if OpenKey('Software\Microsoft\MSSQLServer\Setup', true) then
Result := ValueExists('SQLPath');
end;
Registry.CloseKey;
Registry.Free;
except
Result := false;
cf_sysLog(
'是否安装了SQLServer函数过程失败! 错误位置:[function cf_dbIsInstalledSql: Boolean;]'
);
end;
end;
// ******************************************************************************
// 函数功能: 附加数据库到连接数据库
// 函数名称: cf_dbAttachDB
// 函数参数: oADOConnection: TADOConnection 连接实例.
// sDBName: String 数据库名称
// sMDFFileName : String 数据库文件名(全名)
// sLogFileName : String 数据库日志文件名(全名)
// 返回值: 是否附加成功
// ******************************************************************************
function cf_dbAttachDB(sDBName, sMDFFileName, sLOGFileName: string;
oADOConnection: TADOConnection = nil): Boolean;
var
sSQL: string;
oADOQuery: TADOQuery;
begin
Result := false;
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString) = '')
then
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) <> '')
then
begin
oADOConnection := goADOConDef;
end
else
begin
Exit;
end;
end
else
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) = '')
then
begin
if goADOConDef.Connected then
goADOConDef.Connected := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
goADOConDef.LoginPrompt := false;
if not goADOConDef.Connected then
goADOConDef.Open;
end
else if (goADOConDef = nil) and
(Trim(goADOConDef.ConnectionString) = '') then
begin
goADOConDef := TADOConnection(Application);
goADOConDef.LoginPrompt := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
if not goADOConDef.Connected then
goADOConDef.Open;
end;
end;
if (oADOConnection = nil) or (Trim(sDBName) = '') or
(Trim(sMDFFileName) = '') or (Trim(sLOGFileName) = '') then
Exit;
sSQL :=
'if not exists (select name from master.dbo.sysdatabases where name = N'''
+ sDBName + ''') ' + 'EXEC sp_attach_db @dbname = N''' + sDBName +
''', ' + '@filename1 = N''' + sMDFFileName + ''', ' +
'@filename2 = N''' + sLOGFileName + '''';
oADOQuery := TADOQuery.Create(nil);
try
oADOQuery.Connection := oADOConnection;
oADOQuery.Close;
oADOQuery.SQL.Clear;
oADOQuery.SQL.ADD(sSQL);
oADOQuery.ExecSQL;
Result := true;
except
Result := false;
cf_sysLog(
'附加数据库到连接数据库函数过程失败! 错误位置:[function cf_dbAttachDB(sDBName, sMDFFileName, sLOGFileName: string; '
+ 'oADOConnection: TADOConnection = nil): Boolean;] SQL:[' + sSQL +
']');
end;
oADOQuery.Free;
end;
// ******************************************************************************
// 函数功能: 分离数据库文件.
// 函数名称: cf_dbDetachDB
// 函数参数: oADOConnection: TADOConnection 连接实例.
// sDBName: String 数据库名称
// 返回值: 是否分离成功
// ******************************************************************************
function cf_dbDetachDB(sDBName: string; bIsSkipChecks: Boolean;
oADOConnection: TADOConnection = nil): Boolean;
var
sSQL: string;
oADOQuery: TADOQuery;
begin
Result := false;
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString) = '')
then
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) <> '')
then
begin
oADOConnection := goADOConDef;
end
else
begin
Exit;
end;
end
else
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) = '')
then
begin
if goADOConDef.Connected then
goADOConDef.Connected := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
goADOConDef.LoginPrompt := false;
if not goADOConDef.Connected then
goADOConDef.Open;
end
else if (goADOConDef = nil) and
(Trim(goADOConDef.ConnectionString) = '') then
begin
goADOConDef := TADOConnection(Application);
goADOConDef.LoginPrompt := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
if not goADOConDef.Connected then
goADOConDef.Open;
end;
end;
if (oADOConnection = nil) or (Trim(sDBName) = '') then
Exit;
if bIsSkipChecks then
sSQL := 'true'
else
sSQL := 'false';
sSQL :=
'if exists (select name from master.dbo.sysdatabases where name = N'''
+ sDBName + ''') ' + 'EXEC sp_detach_db ''' + sDBName + ''', ''' +
sSQL + '''';
oADOQuery := TADOQuery.Create(nil);
try
oADOQuery.Connection := oADOConnection;
oADOQuery.Close;
oADOQuery.SQL.Clear;
oADOQuery.SQL.ADD(sSQL);
oADOQuery.ExecSQL;
Result := true;
except
Result := false;
cf_sysLog(
'分离数据库文件函数过程失败! 错误位置:[function cf_dbDetachDB(sDBName: string; bIsSkipChecks: Boolean;'
+ 'oADOConnection: TADOConnection = nil): Boolean;] SQL:[' + sSQL +
']');
end;
oADOQuery.Free;
end;
// ******************************************************************************
// 函数功能: 获取局域网中所有的SQLServer服务器名
// 函数名称: cf_dbGetSQLServerList
// 函数参数: 无
// 返回值: SqlServer服务器列表.
// ******************************************************************************
function cf_dbGetSQLServerList: TStringList;
var
iCount: Integer;
vSQLServer: Variant;
vServerList: Variant;
begin
Result := TStringList.Create; // 初始化
Result.Clear;
try
vSQLServer := CreateOleObject('SQLDMO.Application');
vServerList := vSQLServer.ListAvailableSQLServers;
for iCount := 1 to vServerList.Count do
Result.ADD(vServerList.Item(iCount));
vSQLServer := NULL;
vServerList := NULL;
except
Result := nil;
cf_sysLog(
'获取局域网中所有的SQLServer服务器名函数过程失败! 错误位置:[function cf_dbGetSQLServerList: TStringList;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取数据集中图片字段返回图片类.
// 函数名称: cf_dbGetJpegFieldValue
// 函数参数: DataSet: TDataSet 数据集
// FieldName: String 字段名
// 返回值: TJpegImage图片
// 调用法: Image.Picture.Graphic := GetJFieldValue(qryTemp, 'Picture');
// ******************************************************************************
function cf_dbGetJpegFieldValue(oDataSet: TDataSet; FieldName: string)
: TJPEGImage; overload;
var
oMemoryStream: TMemoryStream;
begin // 处理图片载入，该处只支持jpeg的图片
Result := nil;
try
if (oDataSet = nil) or (Trim(FieldName) = '') or (not oDataSet.Active)
then
Exit;
if oDataSet.FieldByName(FieldName).IsNull then
Exit;
oMemoryStream := TMemoryStream.Create;
TBlobField(oDataSet.FieldByName(FieldName)).SaveToStream(oMemoryStream);
oMemoryStream.Position := 0;
Result := TJPEGImage.Create;
Result.LoadFromStream(oMemoryStream);
oMemoryStream.Free;
except
Result := nil;
cf_sysLog(
'获取数据集中图片字段返回图片类函数过程失败! 错误位置:[cf_dbGetJpegFieldValue(oDataSet: TDataSet;'
+ 'FieldName: string): TJPEGImage; overload;]');
end;
end;
// ******************************************************************************
// 函数功能: 控制光驱开关.
// 函数名称: cf_hardCDRomSwitch
// 函数参数: bOpen :Boolean :是否开关
// 返回值: 操作是否成功
// ******************************************************************************
function cf_hardCDRomSwitch(bOpen: Boolean): Boolean;
begin
Result := false;
try
case bOpen of
true:
mciSendstring('Set cdaudio door open wait', nil, 0,
GetActiveWindow);
false:
mciSendstring('Set cdaudio door closed wait', nil, 0,
GetActiveWindow);
end;
Result := true;
except
Result := false;
cf_sysLog(
'控制光驱开关函数过程失败! 错误位置:[function cf_hardCDRomSwitch(bOpen: Boolean): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 关闭外部应用程序
// 函数名称: cf_sysCloseAssignApp
// 函数参数: sAppName:String 要关闭的应用程序进程名
// 返回值: 操作是否成功
// ******************************************************************************
function cf_sysCloseAssignApp(sAppName: string): Boolean;
var
Exehandle: THandle;
begin
Result := false;
try
Exehandle := FindWindow(PWideChar(sAppName), nil);
if Exehandle <> 0 then
begin
PostMessage(Exehandle, WM_Quit, 0, 0);
Result := true;
end
else
Result := false;
except
Result := false;
cf_sysLog(
'关闭外部应用程序函数过程失败! 错误位置:[function cf_sysCloseAssignApp(sAppName: string): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 执行SQL语句
// 函数名称: cf_dbSelectSQL(var oADOQuery:TADOQuery;sSQL: string): Boolean;overload;
// 函数参数: var oADOQuery:TADOQuery; ADOQuery对象
// sSQL String SQL结构化语言
// 返回值: 返回是否操作成功(Boolean);
// ******************************************************************************
function cf_dbSelectSQL(var oADOQuery: TADOQuery; sSQL: string): Boolean;
overload;
begin
Result := false;
if (Trim(sSQL) = '') or (oADOQuery = nil) then
Exit;
if (oADOQuery.Connection = nil) or
(Trim(oADOQuery.Connection.ConnectionString) = '') then
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) <> '')
then
begin
oADOQuery.Connection := goADOConDef;
end
else
begin
Exit;
end;
end
else
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) = '')
then
begin
if goADOConDef.Connected then
goADOConDef.Connected := false;
goADOConDef.ConnectionString := oADOQuery.Connection.ConnectionString;
goADOConDef.LoginPrompt := false;
if not goADOConDef.Connected then
goADOConDef.Open;
end
else if (goADOConDef = nil) and
(Trim(goADOConDef.ConnectionString) = '') then
begin
goADOConDef := TADOConnection(Application);
goADOConDef.LoginPrompt := false;
goADOConDef.ConnectionString := oADOQuery.Connection.ConnectionString;
if not goADOConDef.Connected then
goADOConDef.Open;
end;
end;
if (oADOQuery.Connection = nil) and (oADOQuery.ConnectionString = '') then
Exit;
try
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.SQL.Clear;
oADOQuery.SQL.Text := sSQL;
oADOQuery.Open;
Result := true;
except
on E: Exception do
begin
Result := false;
cf_sysLog(
'执行SQL语句函数过程失败! 错误位置:[function cf_dbSelectSQL(var oADOQuery: TADOQuery; sSQL: string): Boolean;overload;] SQL:[' + sSQL + '],异常:[' + E.Message + ']');
Exit;
end;
end;
Result := true;
end;
// ******************************************************************************
// 函数功能: 执行SQL查询语句
// 函数名称: cf_dbExeSQLNum(var oADOQuery:TADOQuery;sSQL: string): Boolean;overload;
// 函数参数: var oADOQuery:TADOQuery; ADOQuery对象
// sSQL String SQL结构化语言
// 返回值: 返回执行SQL语句影响的记录数
// ******************************************************************************
function cf_dbExeSQLNum(oADOQuery: TADOQuery; sSQL: string): Integer;
overload;
begin
Result := 0;
if (Trim(sSQL) = '') or (oADOQuery = nil) then
Exit;
if (oADOQuery.Connection = nil) and (oADOQuery.ConnectionString = '') then
Exit;
try
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.SQL.Clear;
oADOQuery.SQL.ADD(sSQL);
Result := oADOQuery.ExecSQL;
except
Result := 0;
cf_sysLog(
'执行SQL查询语句函数过程失败! 错误位置:[function cf_dbExeSQLNum(oADOQuery: TADOQuery; sSQL: string): Integer; overload;] SQL:[' + sSQL + ']');
end
end;
// ******************************************************************************
// 函数功能: 执行SQL查询语句
// 函数名称: cf_dbExeSQLNum
// 函数参数: oADOConnection:TADOConnection 数据库连接对象
// sSQL String SQL结构化语言
// 返回值: 返回执行SQL语句影响的记录数
// ******************************************************************************
function cf_dbExeSQLNum(sSQL: string; oADOConnection: TADOConnection = nil)
: Integer; overload;
var
oADOQuery: TADOQuery;
begin
Result := 0;
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString) = '')
then
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) <> '')
then
begin
oADOConnection := goADOConDef;
end
else
begin
Exit;
end;
end
else
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) = '')
then
begin
if goADOConDef.Connected then
goADOConDef.Connected := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
goADOConDef.LoginPrompt := false;
if not goADOConDef.Connected then
goADOConDef.Open;
end
else if (goADOConDef = nil) and
(Trim(goADOConDef.ConnectionString) = '') then
begin
goADOConDef := TADOConnection(Application);
goADOConDef.LoginPrompt := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
if not goADOConDef.Connected then
goADOConDef.Open;
end;
end;
if (Trim(sSQL) = '') then
Exit;
if (oADOConnection = nil) and (oADOConnection.ConnectionString = '') then
Exit;
oADOQuery := TADOQuery.Create(nil);
try
try
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.SQL.Clear;
oADOQuery.Connection := oADOConnection;
oADOQuery.SQL.ADD(sSQL);
Result := oADOQuery.ExecSQL;
except
Result := 0;
oADOQuery.Free;
cf_sysLog(
'执行SQL查询语句函数过程失败! 错误位置:[function cf_dbExeSQLNum(sSQL: string;' +
'oADOConnection: TADOConnection = nil): Integer;overload;] SQL:['
+ sSQL + ']');
end
finally
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.Free;
end;
end;
// ******************************************************************************
// 函数功能: 执行Sql语句
// 函数名称: cf_dbExecSQL
// 函数参数: oADOConnection:TADOConnection 数据库连接对象
// sSQL string SQL语句。
// 返回值: 返回是否操作成功(Boolean);
// ******************************************************************************
function cf_dbExecSQL(sSQL: string; oADOConnection: TADOConnection = nil)
: Boolean; overload;
var
oADOQuery: TADOQuery;
begin
Result := false;
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString) = '')
then
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) <> '')
then
begin
oADOConnection := goADOConDef;
end
else
begin
Exit;
end;
end
else
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) = '')
then
begin
if goADOConDef.Connected then
goADOConDef.Connected := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
goADOConDef.LoginPrompt := false;
if not goADOConDef.Connected then
goADOConDef.Open;
end
else if (goADOConDef = nil) and
(Trim(goADOConDef.ConnectionString) = '') then
begin
goADOConDef := TADOConnection(Application);
goADOConDef.LoginPrompt := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
if not goADOConDef.Connected then
goADOConDef.Open;
end;
end;
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString) = '')
or (Trim(sSQL) = '') then
Exit;
oADOQuery := TADOQuery.Create(nil);
try
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.Connection := oADOConnection;
oADOQuery.SQL.Clear;
oADOQuery.SQL.ADD(sSQL);
try
oADOQuery.ExecSQL;
Result := true;
except
on E: Exception do
begin
Result := false;
cf_sysLog('执行SQL查询语句函数过程失败! 错误位置:[' +
'function cf_dbExecSQL(sSQL: string; oADOConnection: TADOConnection = nil): Boolean;overload;]' + ' SQL:[' + sSQL + ']' + '异常:[' + E.Message + ']');
end;
end;
finally
oADOQuery.Free;
end;
end;
// ******************************************************************************
// 函数功能: 执行SQL查询语句
// 函数名称: gcf_GetDBTableFieldValue
// 函数参数: oADOQuery:TADOQuery 数据集对象
// sSQL string SQL语句。
// 返回值: 返回是否操作成功(Boolean);
// ******************************************************************************
function cf_dbExecSQL(var oADOQuery: TADOQuery; sSQL: string): Boolean;
overload;
begin
Result := false;
if (oADOQuery = nil) or (Trim(sSQL) = '') or (oADOQuery.Connection = nil)
then
Exit;
try
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.SQL.Clear;
oADOQuery.SQL.ADD(sSQL);
try
oADOQuery.ExecSQL;
Result := true;
except
on E: Exception do
begin
Result := false;
cf_sysLog('执行SQL查询语句函数过程失败! 错误位置:[' +
'function cf_dbExecSQL(var oADOQuery: TADOQuery; sSQL: string): Boolean;overload;]]' + ' SQL:[' + sSQL + ']' + '异常:[' + E.Message + ']');
end;
end;
finally
oADOQuery.Free;
end;
end;
// ******************************************************************************
// 函数功能: 执行SQL语句列表。
// 函数名称: cf_dbExeSQLs
// 函数参数: oADOQuery TADOQuery ADOQuery对象。
// oSqls TStringList 数据库连接字符串
// 返回值: 返回是否操作成功(Boolean);
// ******************************************************************************
function cf_dbExeSQLs(oADOQuery: TADOQuery; oSqls: TStringList): Boolean;
overload;
var
iSqls: Integer;
begin
Result := false;
if (oADOQuery = nil) or ((oADOQuery.Connection = nil) and
(oADOQuery.ConnectionString = '')) then
Exit;
if (oSqls = nil) or (oSqls.Count <= 0) then
Exit;
if (oSqls.Count > 0) then
begin
try
for iSqls := 0 to oSqls.Count - 1 do
begin
if not cf_dbExecSQL(oADOQuery, oSqls.Strings[iSqls]) then
begin
cf_sysLog('执行SQL语句列表循环过程出现异常! 错误位置:[' +
'function cf_dbExeSQLs(oADOQuery: TADOQuery; oSqls: TStringList): Boolean; overload;] SQL:[' + oSqls.Strings[iSqls] + ']');
Break;
Exit;
end;
end;
Result := true;
except
Result := false;
cf_sysLog('执行SQL语句列表函数过程失败! 错误位置:[' +
'function cf_dbExeSQLs(oADOQuery: TADOQuery; oSqls: TStringList): Boolean;overload;]');
end;
end;
end;
// ******************************************************************************
// 函数功能: 非事务执行SQL语句列表。
// 函数名称: cf_dbExeSQLs
// 函数参数: oADOConnection TADOConnection 数据库连接对象。
// oSqls TStringList 数据库连接字符串
// 返回值: 返回是否操作成功(Boolean);
// ******************************************************************************
function cf_dbExeSQLs(oSqls: TStringList;
oADOConnection: TADOConnection = nil): Boolean; overload;
var
iSqls: Integer;
begin
Result := false;
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString) = '')
then
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) <> '')
then
begin
oADOConnection := goADOConDef;
end
else
begin
Result := false;
Exit;
end;
end
else
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) = '')
then
begin
if goADOConDef.Connected then
goADOConDef.Connected := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
goADOConDef.LoginPrompt := false;
if not goADOConDef.Connected then
goADOConDef.Open;
end
else if (goADOConDef = nil) and
(Trim(goADOConDef.ConnectionString) = '') then
begin
goADOConDef := TADOConnection(Application);
goADOConDef.LoginPrompt := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
if not goADOConDef.Connected then
goADOConDef.Open;
end;
end;
if oADOConnection = nil then
begin
Result := false;
Exit;
end;
if (oSqls = nil) or (oSqls.Count <= 0) then
Exit;
if (oSqls.Count > 0) then
begin
try
try
try
for iSqls := 0 to oSqls.Count - 1 do
begin
if not cf_dbExecSQL(oSqls[iSqls]) then
begin
cf_sysLog('非事务执行SQL语句列表循环过程出现异常! 错误位置:[' +
'function cf_dbExeSQLs(oSqls: TStringList;oADOConnection: TADOConnection = nil): Boolean; overload;] SQL:[' + oSqls[iSqls] + ']');
Result := false;
Exit;
end;
end;
Result := true;
except
Result := false;
cf_sysLog('非事务执行SQL语句列表。函数过程失败! 错误位置:[' +
'function cf_dbExeSQLs(oSqls: TStringList;oADOConnection: TADOConnection = nil): Boolean; overload;]');
end;
except
cf_sysLog('非事务执行SQL语句列表。函数过程失败! 错误位置:[' +
'function cf_dbExeSQLs(oSqls: TStringList;oADOConnection: TADOConnection = nil): Boolean; overload;]');
end;
finally
end;
end;
end;
// ******************************************************************************
// 函数功能: 事务执行SQL语句列表。
// 函数名称: cf_dbExeSQLsTrans
// 函数参数: oADOConnection TADOConnection 数据库连接对象。
// oSqls TStringList 数据库连接字符串
// 返回值: 返回是否操作成功(Boolean);
// ******************************************************************************
function cf_dbExeSQLsTrans(sSqls: String;
oADOConnection: TADOConnection = nil): Boolean; overload;
var
iSqls, iCount: Integer;
oADOQuery: TADOQuery;
_oADOConnection: TADOConnection;
sSQL, sException: string;
begin
Result := false;
sException := '';
_oADOConnection := TADOConnection.Create(nil);
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString) = '')
then
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) <> '')
then
begin
oADOConnection := goADOConDef;
end
else
begin
Result := false;
Exit;
end;
end
else
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) = '')
then
begin
if goADOConDef.Connected then
goADOConDef.Connected := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
goADOConDef.LoginPrompt := false;
if not goADOConDef.Connected then
goADOConDef.Open;
end
else if (goADOConDef = nil) and
(Trim(goADOConDef.ConnectionString) = '') then
begin
goADOConDef := TADOConnection(Application);
goADOConDef.LoginPrompt := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
if not goADOConDef.Connected then
goADOConDef.Open;
end;
end;
if oADOConnection = nil then
begin
Result := false;
Exit;
end;
if _oADOConnection.Connected then
_oADOConnection.Close;
_oADOConnection.ConnectionString := oADOConnection.ConnectionString;
_oADOConnection.ConnectionTimeout := 2000;
_oADOConnection.LoginPrompt := false;
// 完全隔离级别。
_oADOConnection.IsolationLevel := ilSerializable;
_oADOConnection.Open;
// 数据库查询语句
if (sSqls = '') and (Pos(';', sSqls) <= 0) then
Exit;
//
sSqls := sSqls + ';';
iSqls := cf_valGetStrPosNum(sSqls, ';');
oADOQuery := TADOQuery.Create(nil);
try
try
oADOQuery.Connection := _oADOConnection;
_oADOConnection.BeginTrans;
for iCount := 1 to iSqls do
begin
try
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.SQL.Clear;
sSQL := cf_valGetStrPosStr(sSqls, iCount, ';');
// 不存在Sql语句。
if Trim(sSQL) = '' then
Continue;
oADOQuery.SQL.ADD(sSQL);
oADOQuery.ExecSQL;
except
on E: Exception do
begin
sException := E.Message;
_oADOConnection.RollbackTrans;
cf_sysLog('事务执行SQL语句列表函数过程失败,引起会滚! 错误位置:[' +
'function cf_dbExeSQLsTrans(sSqls: String;oADOConnection: TADOConnection = nil): Boolean; overload;] 执行SQL:[' + sSQL + '] 引发异常:[' + sException + ']');
Exit;
end;
end;
end;
Result := true;
_oADOConnection.CommitTrans;
except
_oADOConnection.RollbackTrans;
cf_sysLog('事务执行SQL语句列表函数过程失败,引起会滚! 错误位置:[' +
'function cf_dbExeSQLsTrans(sSqls: String;oADOConnection: TADOConnection = nil): Boolean; overload;]');
end;
finally
if oADOQuery.Active then
oADOQuery.Close;
if _oADOConnection.Connected then
_oADOConnection.Close;
oADOQuery.Free;
_oADOConnection.Free;
end;
end;
// ******************************************************************************
// 函数功能: 获取指定SQL查询语句和返回字段名的字段值信息默认为空。
// 函数名称: cf_dbGetSqlFieldValue
// 函数参数: sSql string SQL语句
// sFieldName string 查询返回的字段内容。
// sConStr string 数据库连接字符串。 可省略
// sResultValue string 返回默认值， 可省略默认为'';
// 返回值: 返回指定字段名的字段值信息
// ******************************************************************************
function cf_dbGetSqlFieldValue(sSQL: string; sFieldName: string;
sResultValue: string = ''; oADOConnection: TADOConnection = nil): string;
var
oADOQuery: TADOQuery;
iField, iFound: Integer;
begin
Result := sResultValue;
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString) = '')
then
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) <> '')
then
begin
oADOConnection := goADOConDef;
end
else
begin
Exit;
end;
end
else
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) = '')
then
begin
if goADOConDef.Connected then
goADOConDef.Connected := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
goADOConDef.LoginPrompt := false;
if not goADOConDef.Connected then
goADOConDef.Open;
end
else if (goADOConDef = nil) and
(Trim(goADOConDef.ConnectionString) = '') then
begin
goADOConDef := TADOConnection(Application);
goADOConDef.LoginPrompt := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
if not goADOConDef.Connected then
goADOConDef.Open;
end;
end;
if (oADOConnection = nil) or (Trim(sSQL) = '') or (Trim(sFieldName) = '')
then
Exit;
if (Pos('*', sSQL) <= 0) and (Pos(sFieldName, sSQL) <= 0) then
Exit;
oADOQuery := TADOQuery.Create(nil);
try
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.Connection := oADOConnection;
oADOQuery.SQL.Clear;
oADOQuery.SQL.ADD(sSQL);
try
oADOQuery.Open;
iFound := 0;
for iField := 0 to oADOQuery.Fields.Count - 1 do
begin
if (UpperCase(oADOQuery.Fields[iField].DisplayName) = UpperCase
(sFieldName)) then
begin
Inc(iFound);
end;
end;
// 没有找到匹配的字段。
if iFound <= 0 then
Exit;
if not oADOQuery.IsEmpty then
begin
oADOQuery.First;
Result := oADOQuery.FieldByName(sFieldName).AsString;
end;
except
Result := '';
cf_sysLog('获取指定SQL查询语句和返回字段名的字段值函数过程失败! 错误位置:[' +
'function cf_dbGetSqlFieldValue(sSql: string; sFieldName: string; '
+ 'sResultValue: string = ''; oADOConnection: TADOConnection = nil): string;]' + ' SQL:[' + sSQL + ']');
end;
finally
oADOQuery.Free;
end;
end;
// ******************************************************************************
// 函数功能: 获取指定表,字段,条件,关键字段名 的字段值信息。
// 函数名称: gcf_GetDBTableFieldValue
// 函数参数: sConStr string 数据库连接字符串
// sTableName String 表明
// sFieldName String 数据访问组件
// sCondition String 查询条件
// sDefault String 如果没有符合数据,默认返回的数据.
// 返回值: 返回指定字段名的字段值信息
// ******************************************************************************
function cf_dbGetTableFieldValue(sTableName, sFieldName,
sCondition: string; sDefault: string = '';
oADOConnection: TADOConnection = nil): string;
var
sSQL: string;
oADOQuery: TADOQuery;
begin
Result := '';
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString) = '')
then
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) <> '')
then
begin
oADOConnection := goADOConDef;
end
else
begin
Exit;
end;
end
else
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) = '')
then
begin
if goADOConDef.Connected then
goADOConDef.Connected := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
goADOConDef.LoginPrompt := false;
if not goADOConDef.Connected then
goADOConDef.Open;
end
else if (goADOConDef = nil) and
(Trim(goADOConDef.ConnectionString) = '') then
begin
goADOConDef := TADOConnection(Application);
goADOConDef.LoginPrompt := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
if not goADOConDef.Connected then
goADOConDef.Open;
end;
end;
if (Trim(sTableName) = '') or (Trim(sFieldName) = '') or
(oADOConnection = nil) then
Exit;
sSQL := 'Select ' + sFieldName + ' as FieldValues From ' + sTableName +
' Where 1=1 ';
if Trim(sCondition) <> '' then
begin
sSQL := sSQL + ' and ' + sCondition;
end;
oADOQuery := TADOQuery.Create(nil);
try
try
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.Connection := oADOConnection;
oADOQuery.SQL.Clear;
oADOQuery.SQL.ADD(sSQL);
try
oADOQuery.Open;
if not oADOQuery.IsEmpty then
begin
oADOQuery.First;
Result := oADOQuery.FieldByName('FieldValues').AsString;
end
else
Result := sDefault;
except
Result := sDefault;
cf_sysLog('获取指定表,字段,条件,关键字段名 的字段值信息函数过程失败! 错误位置:[' +
'function cf_dbGetTableFieldValue(sTableName, sFieldName, sCondition: string; '
+ 'sDefault: string = ''; oADOConnection: TADOConnection = nil): string;]' + ' SQL:[' + sSQL + ']');
end;
finally
oADOQuery.Free;
end;
except
end;
end;
// ******************************************************************************
// 函数功能: 获取指定目录的大小
// 函数名称: cf_sysGetDirectorySize;
// 函数参数: sDirectory: string 指定的目录
// 返回值: 目录的大小
// ******************************************************************************
function cf_sysGetDirectorySize(sDirectory: string): Integer;
var
lDir: TSearchRec; // 搜索记录临时变量
liRet: Integer; // 搜索结果变量
lsPath: string; // 路径变量
begin
Result := 0;
{ 补全目录字符串 }
if RightStr(sDirectory, 1) <> '\' then
lsPath := sDirectory + '\';
liRet := SysUtils.FindFirst(lsPath + '*.*', faAnyFile, lDir);
if liRet <> NO_ERROR then
Exit;
try
try
while liRet = NO_ERROR do
begin
Inc(Result, lDir.Size);
{ 当找到的是目录，则递归调用 自身 函数得到目录的大小 }
if (lDir.Attr in [faDirectory]) and (lDir.Name[1] <> '.') and
(lDir.Name <> '..') then
Inc(Result, cf_sysGetDirectorySize(lsPath + lDir.Name));
liRet := SysUtils.FindNext(lDir);
end;
except
Result := 0;
cf_sysLog('获取指定目录的大小函数过程失败! 错误位置:[' +
'function cf_sysGetDirectorySize(sDirectory: string): Integer;]');
end;
finally
FindClose(lDir);
end;
end;
// ******************************************************************************
// 函数功能: 给Combobox下拉框加载数据项.
// 函数名称: cf_dbSQLFillComboBox
// 函数参数: oComboBox TCombobox 下拉列表实例
// oADOConnection: TADOConnection 连接对象
// sSQLStr: String SQL语句
// sListField String 要现实的下拉列表
// bFirstClear Boolean 是否先清空Combobox的Item项。
// 返回值: 是否操作成功
// ******************************************************************************
function cf_dbSQLFillComboBox(oComboBox: TComboBox; sListField: string;
sSQLStr: string; bFirstClear: Boolean = true;
oADOConnection: TADOConnection = nil): Boolean; overload;
var
oADOQuery: TADOQuery;
iFieldCount: Integer;
begin
Result := false;
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString) = '')
then
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) <> '')
then
begin
oADOConnection := goADOConDef;
end
else
begin
Exit;
end;
end
else
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) = '')
then
begin
if goADOConDef.Connected then
goADOConDef.Connected := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
goADOConDef.LoginPrompt := false;
if not goADOConDef.Connected then
goADOConDef.Open;
end
else if (goADOConDef = nil) and
(Trim(goADOConDef.ConnectionString) = '') then
begin
goADOConDef := TADOConnection(Application);
goADOConDef.LoginPrompt := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
if not goADOConDef.Connected then
goADOConDef.Open;
end;
end;
if (oComboBox = nil) or (not Assigned(oComboBox)) or
(Trim(sListField) = '') or (Trim(sSQLStr) = '') or
(oADOConnection = nil) then
Exit;
oADOQuery := TADOQuery.Create(nil);
try
try
oADOQuery.Connection := oADOConnection;
oADOQuery.SQL.Clear;
oADOQuery.SQL.ADD(sSQLStr);
oADOQuery.Open;
if not oADOQuery.IsEmpty then
begin
if bFirstClear then
oComboBox.Items.Clear;
oComboBox.Items.Text := '';
oADOQuery.First;
while not oADOQuery.Eof do
begin
oComboBox.Items.ADD(oADOQuery.FieldByName(sListField).AsString);
oADOQuery.Next;
end;
oComboBox.ItemIndex := -1;
Result := true;
end;
except
Result := false;
cf_sysLog('给Combobox下拉框加载数据项函数过程失败! 错误位置:[' +
'function cf_dbSQLFillComboBox(oComboBox: TComboBox; sListField: string;'
+ 'sSQLStr: string; bFirstClear: Boolean = true;' +
'oADOConnection: TADOConnection = nil): Boolean; overload;]' +
' SQL:[' + sSQLStr + ']');
end;
finally
oADOQuery.Free;
end;
end;
// ******************************************************************************
// 函数功能: 获取指定日期的最大流水号 （如:2007031799999999 【16位】)
// 函数名称: cf_dbGetMaxSN;
// 函数参数: ADOConnection:TADOConnection 连接数据库对象
// sTable:String 要查找的表名
// sField:String 要查找的字段名
// aDate :TDateTime 指定的日期
// bInc :Boolean 要排序的字段（以获取最大的流水号)
// 返回值: 返回指定日期的最大流水号
// ******************************************************************************
function cf_dbGetMaxSN(sTable, sField, sQZ: string; aDate: TDateTime;
bInc: Boolean = true; oADOConnection: TADOConnection = nil): string;
var
sDate, sSQL, sValue: string;
objADOQuery: TADOQuery;
iValue: Int64;
sFieldValue: string;
begin
Result := '';
iValue := 0;
sDate := FormatDateTime('YYYYMMDD', aDate);
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString) = '')
then
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) <> '')
then
begin
oADOConnection := goADOConDef;
end
else
begin
Exit;
end;
end
else
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) = '')
then
begin
if goADOConDef.Connected then
goADOConDef.Connected := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
goADOConDef.LoginPrompt := false;
if not goADOConDef.Connected then
goADOConDef.Open;
end
else if (goADOConDef = nil) and
(Trim(goADOConDef.ConnectionString) = '') then
begin
goADOConDef := TADOConnection(Application);
goADOConDef.LoginPrompt := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
if not goADOConDef.Connected then
goADOConDef.Open;
end;
end;
if (Trim(sTable) = '') or (Trim(sField) = '') or (Trim(sQZ) = '') or
(oADOConnection = nil) then
Exit;
objADOQuery := TADOQuery.Create(nil);
try
if objADOQuery.Active then
objADOQuery.Close;
objADOQuery.SQL.Clear;
objADOQuery.Connection := oADOConnection;
// 判断数据库类型.
// Access
if Pos(WideString('Microsoft.Jet.OLEDB.4.0'), WideString
(goADOConDef.ConnectionString)) <> 0 then
begin
if sQZ = '' then
sSQL := 'Select Max(' + sField + ') as ' + sField + ' From ' +
sTable + ' Where Left(Right(' + sField + ',16),8) =' + QuotedStr
(sDate) // + ' Order By ' + sField + ' Desc'
else
sSQL := 'Select Max(' + sField + ') as ' + sField + ' From ' +
sTable + ' Where Left(Right(' + sField + ',' + IntToStr
(16 + Length(sQZ)) + '),' + IntToStr(8 + Length(sQZ))
+ ')=' + QuotedStr(sQZ + sDate);
// + ' Order By ' + sField + ' Desc';
// SQLServer
end
else if Pos(WideString('SQLOLEDB.1'), WideString
(goADOConDef.ConnectionString)) <> 0 then
begin
if sQZ = '' then
sSQL := 'Select Max(' + sField + ') as ' + sField + ' From ' +
sTable + ' Where SubString(' + sField + ',1,8) =' + QuotedStr
(sDate)
else
sSQL := 'Select Max(' + sField + ') as ' + sField + ' From ' +
sTable + ' Where SubString(' + sField + ',1,10)=' + QuotedStr
(sQZ + sDate);
// Oracle
end
else if Pos(WideString('OraOLEDB.Oracle.1'), WideString
(goADOConDef.ConnectionString)) <> 0 then
begin
if sQZ = '' then
sSQL := 'Select Max(' + sField + ') as ' + sField + ' From ' +
sTable + ' Where SubStr(' + sField + ',1,8) =' + QuotedStr
(sQZ + sDate) + ' Order By ' + sField + ' Desc'
else
sSQL := 'Select Max(' + sField + ') as ' + sField + ' From ' +
sTable + ' Where SubStr(' + sField + ',1,10) =' + QuotedStr
(sQZ + sDate) + ' Order By ' + sField + ' Desc';
// 默认使用SQLServer.
end
else
begin
if sQZ = '' then
sSQL := 'Select Max(' + sField + ') as ' + sField + ' From ' +
sTable + ' Where SubString(' + sField + ',1,8) =' + QuotedStr
(sDate)
else
sSQL := 'Select Max(' + sField + ') as ' + sField + ' From ' +
sTable + ' Where SubString(' + sField + ',1,10)=' + QuotedStr
(sQZ + sDate);
end;
objADOQuery.SQL.ADD(sSQL);
try
objADOQuery.Open;
except
Result := '';
cf_sysLog('获取指定日期的最大流水号函数过程失败! 错误位置:[' +
'function cf_dbGetMaxSN(sTable, sField, sQZ: string; aDate: TDateTime;'
+
'bInc: Boolean = true; oADOConnection: TADOConnection = nil): string;]' + ' SQL:[' + sSQL + ']');
end;
// SD2007030200000001
sValue := Trim(objADOQuery.FieldByName(sField).AsString);
if sQZ = '' then
begin
if Length(sValue) > 16 then
begin
sFieldValue := Copy(sValue, 1, Length(sValue) - 16);
end
else
sFieldValue := '';
end
else
begin
if Length(sValue) > 18 then
begin
sFieldValue := Copy(sValue, 1, Length(sValue) - 16);
end
else
sFieldValue := '';
end;
// 00000001
sValue := Copy(sValue, Length(sValue) - 7, 8);
// 转换至整型
TryStrToInt64(sValue, iValue);
if bInc then
iValue := iValue + 1;
if (Length(IntToStr(iValue)) > 8) or (Length(IntToStr(iValue)) <= 0)
then
begin
Exit
end
else
begin
case Length(IntToStr(iValue)) of
0:
Result := sQZ + sDate + '00000000';
1:
Result := sQZ + sDate + '0000000' + IntToStr(iValue);
2:
Result := sQZ + sDate + '000000' + IntToStr(iValue);
3:
Result := sQZ + sDate + '00000' + IntToStr(iValue);
4:
Result := sQZ + sDate + '0000' + IntToStr(iValue);
5:
Result := sQZ + sDate + '000' + IntToStr(iValue);
6:
Result := sQZ + sDate + '00' + IntToStr(iValue);
7:
Result := sQZ + sDate + '0' + IntToStr(iValue);
8:
Result := sQZ + sDate + IntToStr(iValue);
end;
end;
finally
objADOQuery.Free;
end;
end;
// ******************************************************************************
// 函数功能: 自动注册工程窗体模块
// 函数名称: cf_DBAutoRegFormClass
// 函数参数: sProjectFileName: 工程文件名
// oADOConnection:TADOConnection 数据库连接对象
// 返回值: 返回是否操作成功
// ******************************************************************************
function cf_operAutoRegFormClass(sProjectFileName: string;
oADOConnection: TADOConnection = nil): Boolean;
var
Fs: TextFile;
sData, sSQL: string;
bBegin: Boolean;
oADOQuery: TADOQuery;
begin
Result := false;
// 关联文件到Fs;
if not FileExists(sProjectFileName) then
begin
Exit;
Abort;
end;
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString) = '')
then
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) <> '')
then
begin
oADOConnection := goADOConDef;
end
else
begin
Exit;
end;
end
else
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) = '')
then
begin
if goADOConDef.Connected then
goADOConDef.Connected := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
goADOConDef.LoginPrompt := false;
if not goADOConDef.Connected then
goADOConDef.Open;
end
else if (goADOConDef = nil) and
(Trim(goADOConDef.ConnectionString) = '') then
begin
goADOConDef := TADOConnection(Application);
goADOConDef.LoginPrompt := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
if not goADOConDef.Connected then
goADOConDef.Open;
end;
end;
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString) = '')
then
Exit;
AssignFile(Fs, sProjectFileName);
Reset(Fs);
try
try
// 清除模块更新表所有数据
if goSysInfo.bIsModleDLL then
begin
cf_dbExecSQL('call DeleteTFWResourceFile(0)', oADOConnection);
end
else
begin
cf_dbExecSQL('call DeleteTFWResourceFile(1)', oADOConnection);
end;
oADOQuery := TADOQuery.Create(nil);
try
oADOQuery.Connection := oADOConnection;
oADOQuery.SQL.Clear;
sSQL :=
'Select * from TFWResourceFile Where TFWResourceFileName='' '' and FileType=1';
oADOQuery.SQL.ADD(sSQL);
oADOQuery.Open;
if oADOQuery.IsEmpty then
begin
oADOQuery.Append;
oADOQuery.FieldByName('TFWResourceFileName').AsString := ' ';
oADOQuery.FieldByName('RegTime').AsString := cf_dbGetSysTime
(oADOConnection);
oADOQuery.FieldByName('FileType').AsInteger := 1;
oADOQuery.Post;
end;
finally
oADOQuery.Free;
end;
// 遍历整个工程
while not Eof(Fs) do
begin
Readln(Fs, sData);
// 单元文件
if UpperCase(sData) = 'USES' then
bBegin := true;
if bBegin then
begin
if UpperCase(sData) = ';' then
Break;
if (Pos(''' {', UpperCase(sData)) > 0) or
(Pos('},', UpperCase(sData)) > 0) then
begin
sData := Copy(sData, Pos(''' {', UpperCase(sData)) + Length
(''' {'), Length(sData));
if Pos('},', sData) > 0 then
sData := Copy(sData, 1, Length(sData) - 2);
if Pos('};', sData) > 0 then
sData := Copy(sData, 1, Length(sData) - 2);
if (Trim(sData) <> '') and
((Pos('FRM', UpperCase(sData)) > 0) or
(Pos('FORM', UpperCase(sData)) > 0)) then
begin
sData := 'T' + sData;
try
oADOQuery := TADOQuery.Create(nil);
try
oADOQuery.Connection := oADOConnection;
oADOQuery.SQL.Clear;
sSQL :=
'Select * from TFWResourceFile Where TFWResourceFileName='
+ QuotedStr(sData) + ' and FileType=1';
oADOQuery.SQL.ADD(sSQL);
oADOQuery.Open;
if oADOQuery.IsEmpty then
begin
oADOQuery.Append;
oADOQuery.FieldByName('TFWResourceFileName')
.AsString := sData;
oADOQuery.FieldByName('RegTime').AsString :=
cf_dbGetSysTime(oADOConnection);
oADOQuery.FieldByName('FileType').AsInteger := 1;
oADOQuery.Post;
end;
finally
oADOQuery.Free;
end;
except
end;
end
else
Continue;
end;
end;
end;
finally
CloseFile(Fs);
end;
except
cf_sysLog('自动注册工程窗体模块函数过程失败! 错误位置:[' +
'function cf_operAutoRegFormClass(sProjectFileName: string;' +
'oADOConnection: TADOConnection = nil): Boolean;]' + ' SQL:[' +
sSQL + ']');
end;
end;
// ******************************************************************************
// 函数功能: 检测网络状态
// 函数名称: cf_netCheckNetStatus
// 函数参数: IpAddr:IP地址字符串
// 返回值: 是否在线.
// ******************************************************************************
function cf_netCheckNetStatus(IpAddr: string): Boolean;
type
PIPOptionInformation = ^TIPOptionInformation;
TIPOptionInformation = packed record
TTL: Byte; // Time To Live (used for traceroute)
TOS: Byte; // Type Of Service (usually 0)
Flags: Byte; // IP header flags (usually 0)
OptionsSize: Byte; // Size of options data (usually 0, max 40)
OptionsData: PWideChar; // Options data buffer
end;
PIcmpEchoReply = ^TIcmpEchoReply;
TIcmpEchoReply = packed record
Address: DWORD; // replying address
Status: DWORD; // IP status value (see below)
RTT: DWORD; // Round Trip Time in milliseconds
DataSize: Word; // reply data size
Reserved: Word;
Data: Pointer; // pointer to reply data buffer
Options: TIPOptionInformation; // reply options
end;
TIcmpCreateFile = function: THandle; stdcall;
TIcmpCloseHandle = function(IcmpHandle: THandle): Boolean; stdcall;
TIcmpSendEcho = function(IcmpHandle: THandle; DestinationAddress: DWORD;
RequestData: Pointer; RequestSize: Word;
RequestOptions: PIPOptionInformation; ReplyBuffer: Pointer;
ReplySize: DWORD; Timeout: DWORD): DWORD; stdcall;
const
Size = 32;
Timeout = 1000;
var
wsadata: TWSADATA;
Address: DWORD; // Address of host to contact
HostName, HostIP: string; // Name and dotted IP of host to contact
Phe: PHostEnt; // HostEntry buffer for name lookup
BufferSize, nPkts: Integer;
pReqData, pData: Pointer;
pIPE: PIcmpEchoReply; // ICMP Echo reply buffer
IPOpt: TIPOptionInformation; // IP Options for packet to send
const
IcmpDLL = 'icmp.dll';
var
hICMPlib: HModule;
IcmpCreateFile: TIcmpCreateFile;
IcmpCloseHandle: TIcmpCloseHandle;
IcmpSendEcho: TIcmpSendEcho;
hICMP: THandle; // Handle for the ICMP Calls
begin
// initialise winsock
Result := true;
try
if WSAStartup(2, wsadata) <> 0 then
begin
Result := false;
Halt;
end;
// register the icmp.dll stuff
hICMPlib := LoadLibrary(IcmpDLL);
if hICMPlib <> NULL then
begin
@IcmpCreateFile := GetProcAddress(hICMPlib, 'IcmpCreateFile');
@IcmpCloseHandle := GetProcAddress(hICMPlib, 'IcmpCloseHandle');
@IcmpSendEcho := GetProcAddress(hICMPlib, 'IcmpSendEcho');
if (@IcmpCreateFile = nil) or (@IcmpCloseHandle = nil) or
(@IcmpSendEcho = nil) then
begin
Result := false;
Halt;
end;
hICMP := IcmpCreateFile;
if hICMP = INVALID_HANDLE_VALUE then
begin
Result := false;
Halt;
end;
end
else
begin
Result := false;
Halt;
end;
// ------------------------------------------------------------
Address := inet_addr(PAnsiChar(IpAddr));
if (Address = INADDR_NONE) then
begin
Phe := GetHostByName(PAnsiChar(IpAddr));
if Phe = nil then
Result := false
else
begin
Address := Longint(plongint(Phe^.h_addr_list^)^);
HostName := Phe^.h_name;
HostIP := StrPas(inet_ntoa(TInAddr(Address)));
end;
end
else
begin
Phe := GetHostByAddr(@Address, 4, PF_INET);
if Phe = nil then
Result := false;
end;
if Address = INADDR_NONE then
begin
Result := false;
end;
// Get some data buffer space and put something in the packet to send
BufferSize := SizeOf(TIcmpEchoReply) + Size;
GetMem(pReqData, Size);
GetMem(pData, Size);
GetMem(pIPE, BufferSize);
FillChar(pReqData^, Size, $AA);
pIPE^.Data := pData;
// Finally Send the packet
FillChar(IPOpt, SizeOf(IPOpt), 0);
IPOpt.TTL := 64;
nPkts := IcmpSendEcho(hICMP, Address, pReqData, Size, @IPOpt, pIPE,
BufferSize, Timeout);
if nPkts = 0 then
Result := false;
// Free those buffers
FreeMem(pIPE);
FreeMem(pData);
FreeMem(pReqData);
// --------------------------------------------------------------
IcmpCloseHandle(hICMP);
FreeLibrary(hICMPlib);
// free winsock
if WSACleanup <> 0 then
Result := false;
except
Result := false;
cf_sysLog('检测网络状态函数过程失败! 错误位置:[' +
'function cf_netCheckNetStatus(IpAddr: string): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取指定文件的大小
// 函数名称: cf_fileGetFileSize
// 函数参数: sFileName String 文件名
// 返回值: Double 类型的文件大小 (单位:KB)
// ******************************************************************************
function cf_fileGetFileSize(sFileName: string): Double;
var
Fs: TFileStream;
begin
Result := 0;
try
if cf_fileIsFileInUse(sFileName) then
begin
Exit;
end;
Fs := TFileStream.Create(sFileName, fmOpenRead);
try
Result := Fs.Size / 1024;
finally
Fs.Free;
end;
except
Result := 0.00;
cf_sysLog('获取指定文件的大小函数过程失败! 错误位置:[' +
'function cf_fileGetFileSize(sFileName: string): Double;]');
end;
end;
// ******************************************************************************
// 函数功能: 设置文件是否只读
// 函数名称: cf_fileGetFileSize
// 函数参数: sFileName String 文件名
// bYes:Boolean=True 默认为设置为只读。
// 返回值: 返回文件是否操作成功。
// ******************************************************************************
function cf_fileSetFileReadOnly(sFileName: string; bYes: Boolean = true)
: Boolean;
begin
try
Result := FileSetReadOnly(sFileName, bYes);
except
Result := false;
cf_sysLog('设置文件是否只读函数过程失败! 错误位置:[' +
'function cf_fileSetFileReadOnly(sFileName: string;' +
'bYes: Boolean = true): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取进程列表信息
// 函数名称: cf_sysGetProcessList
// 函数参数: sItems:TStrings
// 返回值: 是否操作成功
// ******************************************************************************
function cf_sysGetProcessList(sItems: TStrings): Boolean;
var
lppe: TProcessEntry32;
found: Boolean;
Hand: THandle;
begin
Result := false;
Hand := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
found := Process32First(Hand, lppe);
try
if sItems = nil then
begin
Exit;
end;
sItems.Clear;
while found do
begin
// 加载所有Windows所有进程列表
sItems.ADD(StrPas(lppe.szExeFile));
found := Process32Next(Hand, lppe);
end;
Result := true;
except
Result := false;
cf_sysLog('获取进程列表信息函数过程失败! 错误位置:[' +
'function cf_sysGetProcessList(sItems: TStrings): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 计算X的Y次方
// 函数名称: cf_valXYSqu
// 函数参数: X:浮点或整型数字;
// Y:整型数字;
// 返回值: X的Y次方计算结果.
// ******************************************************************************
function cf_valXYSqu(X: Double; Y: Integer): Double;
var
iCount: Integer;
fSum: Double;
begin
fSum := 1.000;
try
for iCount := 1 to Y do
begin
fSum := fSum * X;
end;
Result := fSum;
except
Result := 1.00;
cf_sysLog('计算X的Y次方函数过程失败! 错误位置:[' +
'function cf_valXYSqu(X: Double; Y: Integer): Double;]');
end;
end;
// ******************************************************************************
// 函数功能: 设备系统喇叭控制
// 函数名称: cf_hardDoBeep
// 函数参数: Freq:Word 喇叭鸣叫频率;
// Sec :LongInt 鸣叫长度;
// 返回值: 返回是否显示成功;
// ******************************************************************************
function cf_hardDoBeep(Freq: Word; Sec: Longint): Boolean;
procedure AsmShutUp;
begin
asm
In AL, $61
And AL, $FC
Out $61, AL
end
;
end;
procedure AsmBeep(Freq: Word);
label Skip;
begin
asm
Push BX
In AL, $61
Mov BL, AL
And AL, 3
Jne skip
Mov AL, BL
Or AL, 3
Out $61, AL
Mov AL, $B6
Out $43, AL
skip: Mov AX, Freq
Out $42, AL
Mov AL, AH
Out $42, AL
Pop BX
end
;
end;
procedure HardBleep(Freq: Word; MSecs: Longint);
const
HiValue = 50000;
var
iCurrTickCount, iFirstTickCount: DWORD;
iElapTime: Longint;
begin
if (Freq >= 20) and (Freq <= 5000) then
begin
AsmBeep(Word(1193181 div Longint(Freq)));
if MSecs >= 0 then
begin
iFirstTickCount := GetTickCount;
repeat
if MSecs > 1000 then
Application.ProcessMessages;
iCurrTickCount := GetTickCount;
if iCurrTickCount < iFirstTickCount then
iElapTime := HiValue - iFirstTickCount + iCurrTickCount
else
iElapTime := iCurrTickCount - iFirstTickCount;
until iElapTime >= MSecs;
AsmShutUp;
end;
end;
end;
begin
// 是Windows系统则用WindowsAPI函数,否则直接控制硬件端口
try
Result := false;
if Sec < -1 then
Sec := 0;
if Pos(Copy(cf_sysGetOSVersion, 1, 3), 'Win') > 0 then
begin
// API函数发声
Windows.Beep(Freq, Sec);
end
else
begin
HardBleep(Freq, Sec);
end;
Result := true;
except
Result := false;
cf_sysLog('设备系统喇叭控制函数过程失败! 错误位置:[' +
'function cf_hardDoBeep(Freq: Word; Sec: Longint): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 打开指定的URL 窗口
// 函数名称: cf_sysOpenURL
// 函数参数: sURL:string URL地址字符串
// 返回值: 返回是否操作成功;
// ******************************************************************************
function cf_sysOpenURL(sURL: string): Boolean;
begin
Result := false;
try
ShellExecute(0, nil, PWideChar(sURL), nil, nil, SW_NORMAL);
Result := true;
except
Result := false;
cf_sysLog('打开指定的URL窗口函数过程失败! 错误位置:[' +
'function cf_sysOpenURL(sURL: string): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取唯一的GUID字符串
// 函数名称: cf_valGetGUIDString
// 函数参数: 无
// 返回值: 返回GUID字符串
// ******************************************************************************
function cf_valGetGUIDString: string;
var
ID: TGUID;
begin
try
if CreateGUID(ID) = 0 then
begin
Result := GUIDToString(ID);
end;
except
Result := '';
cf_sysLog('获取唯一的GUID字符串函数过程失败! 错误位置:[' +
'function cf_valGetGUIDString: string;]');
end;
end;
// ******************************************************************************
// 函数功能: 返回是否安装过BDE组件
// 函数名称: gcf_IsInstalledBDE
// 函数参数: 无
// 返回值: 是否安装过
// ******************************************************************************
function cf_sysIsInstalledBDE: Boolean;
var
Reg: TRegistry;
sBDE: string;
begin
Result := false;
try
sBDE := '';
Reg := TRegistry.Create;
Reg.RootKey := CONST_REG_ROOTKEY;
Reg.OpenKey('SOFTWARE\Borland\Database Engine', false);
try
sBDE := Reg.ReadString('CONFIGFILE01');
// BDE installed
finally
if sBDE <> '' then
Result := true
else
Result := false;
Reg.CloseKey;
Reg.Free;
end;
except
Result := false;
cf_sysLog('返回是否安装过BDE组件函数过程失败! 错误位置:[' +
'function cf_sysIsInstalledBDE: Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 查找父窗口中指定的窗口信息
// 函数名称: cf_ctrlFindOwerChildForm
// 函数参数: oOwerForm: TForm
// 返回值: 是否安装过
// ******************************************************************************
function cf_ctrlFindOwerChildForm(oOwerForm: TForm; sModuleName: string)
: Boolean;
var
iForm: Integer;
begin
Result := false;
try
for iForm := 0 to oOwerForm.ComponentCount - 1 do
begin
if (sModuleName = oOwerForm.Components[iForm].Name) then
begin
Result := true;
TForm(oOwerForm.Components[iForm]).WindowState := wsMaximized;
TForm(oOwerForm.Components[iForm]).Show;
Break;
end;
end;
except
Result := false;
cf_sysLog('查找父窗口中指定的窗口信息函数过程失败! 错误位置:[' +
'function cf_ctrlFindOwerChildForm(oOwerForm: TForm;sModuleName: string): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取MAC地址
// 函数名称: cf_netGetMacAddress
// 函数参数: 无
// 返回值: 返回MAC地址字符串
// ******************************************************************************
function cf_netGetMacAddress: string;
var
oNcb: TNCB;
oAdapterStatus: TAdapterStatus;
oLanEnum: TLanaEnum;
iNum: Integer;
cLanNum: AnsiChar;
TAddress: record lPart: Longint;
wPart: Word;
end
absolute oAdapterStatus;
procedure ResetAdapter(num: Char); // 适配器复位
begin
FillChar(oNcb, SizeOf(oNcb), 0);
oNcb.ncb_command := AnsiChar(NCBRESET);
oNcb.ncb_lana_num := AnsiChar(num);
Netbios(@oNcb);
end;
begin
Result := '';
try
FillChar(oNcb, SizeOf(oNcb), 0);
oNcb.ncb_command := Char(NCBENUM);
oNcb.ncb_buffer := @oLanEnum;
oNcb.ncb_length := SizeOf(oLanEnum);
if oLanEnum.Length = #0 then
Exit;
Netbios(@oNcb);
cLanNum := AnsiChar(oLanEnum.lana[0]);
ResetAdapter(Char(cLanNum));
FillChar(oNcb, SizeOf(oNcb), 0);
oNcb.ncb_command := Char(NCBASTAT);
oNcb.ncb_lana_num := cLanNum;
oNcb.ncb_callname[0] := '*';
oNcb.ncb_buffer := @oAdapterStatus;
Netbios(@oNcb);
ResetAdapter(Char(cLanNum));
for iNum := 0 to 5 do
begin
Result := Result + IntToHex
(Integer(oAdapterStatus.adapter_address[iNum]), 2);
if (iNum < 5) then
begin
Result := Result + '-';
end;
end;
except
Result := '';
cf_sysLog('获取MAC地址窗口信息函数过程失败! 错误位置:[' +
'function cf_netGetMacAddress: string;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取硬盘编号
// 函数名称: cf_hardGetIDESerialID
// 函数参数: 无
// 返回值: 返回硬盘编号字符串
// ******************************************************************************
function cf_hardGetIDESerialID: string;
const
IDENTIFY_BUFFER_SIZE = 512;
type
TIDERegs = packed record
bFeaturesReg: Byte; // Used for specifying SMART "commands".
bSectorCountReg: Byte; // IDE sector count register
bSectorNumberReg: Byte; // IDE sector number register
bCylLowReg: Byte; // IDE low order cylinder value
bCylHighReg: Byte; // IDE high order cylinder value
bDriveHeadReg: Byte; // IDE drive/head register
bCommandReg: Byte; // Actual IDE command.
bReserved: Byte; // reserved for future use. Must be zero.
end;
TSendCmdInParams = packed record
// Buffer size in bytes
cBufferSize: DWORD;
// Structure with drive register values.
irDriveRegs: TIDERegs;
// Physical drive number to send command to (0,1,2,3).
bDriveNumber: Byte;
bReserved: array [0 .. 2] of Byte;
dwReserved: array [0 .. 3] of DWORD;
bBuffer: array [0 .. 0] of Byte; // Input buffer.
end;
TIdSector = packed record
wGenConfig: Word;
wNumCyls: Word;
wReserved: Word;
wNumHeads: Word;
wBytesPerTrack: Word;
wBytesPerSector: Word;
wSectorsPerTrack: Word;
wVendorUnique: array [0 .. 2] of Word;
sSerialNumber: array [0 .. 19] of AnsiChar;
wBufferType: Word;
wBufferSize: Word;
wECCSize: Word;
sFirmwareRev: array [0 .. 7] of AnsiChar;
sModelNumber: array [0 .. 39] of AnsiChar;
wMoreVendorUnique: Word;
wDoubleWordIO: Word;
wCapabilities: Word;
wReserved1: Word;
wPIOTiming: Word;
wDMATiming: Word;
wBS: Word;
wNumCurrentCyls: Word;
wNumCurrentHeads: Word;
wNumCurrentSectorsPerTrack: Word;
ulCurrentSectorCapacity: DWORD;
wMultSectorStuff: Word;
ulTotalAddressableSectors: DWORD;
wSingleWordDMA: Word;
wMultiWordDMA: Word;
bReserved: array [0 .. 127] of Byte;
end;
PIdSector = ^TIdSector;
TDriverStatus = packed record
// 驱动器返回的错误代码，无错则返回0
bDriverError: Byte;
// IDE出错寄存器的内容，只有当bDriverError 为 SMART_IDE_ERROR 时有效
bIDEStatus: Byte;
bReserved: array [0 .. 1] of Byte;
dwReserved: array [0 .. 1] of DWORD;
end;
TSendCmdOutParams = packed record
// bBuffer的大小
cBufferSize: DWORD;
// 驱动器状态
DriverStatus: TDriverStatus;
// 用于保存从驱动器读出的数据的缓冲区，实际长度由cBufferSize决定
bBuffer: array [0 .. 0] of Byte;
end;
var
hDevice: THandle;
cbBytesReturned: DWORD;
SCIP: TSendCmdInParams;
aIdOutCmd: array [0 .. (SizeOf(TSendCmdOutParams)
+ IDENTIFY_BUFFER_SIZE - 1) - 1] of Byte;
IdOutCmd: TSendCmdOutParams absolute aIdOutCmd;
procedure ChangeByteOrder(var Data; Size: Integer);
var
Ptr: PWideChar;
i: Integer;
c: Char;
begin
Ptr := @Data;
for i := 0 to (Size shr 1) - 1 do
begin
c := Ptr^;
Ptr^ := (Ptr + 1)^; (Ptr + 1)
^ := c;
Inc(Ptr, 2);
end;
end;
begin
Result := ''; // 如果出错则返回空串
try
if SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT then
begin // Windows NT, Windows 2000
// 提示! 改变名称可适用于其它驱动器，如第二个驱动器： '\\.\PhysicalDrive1\'
hDevice := CreateFile('\\.\PhysicalDrive0',
GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE,
nil, OPEN_EXISTING, 0, 0);
end
else // Version Windows 95 OSR2, Windows 98
hDevice := CreateFile('\\.\SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0);
if hDevice = INVALID_HANDLE_VALUE then
Exit;
try
FillChar(SCIP, SizeOf(TSendCmdInParams) - 1, #0);
FillChar(aIdOutCmd, SizeOf(aIdOutCmd), #0);
cbBytesReturned := 0;
// Set up data structures for IDENTIFY command.
with SCIP do
begin
cBufferSize := IDENTIFY_BUFFER_SIZE;
// bDriveNumber := 0;
with irDriveRegs do
begin
bSectorCountReg := 1;
bSectorNumberReg := 1;
// if Win32Platform=VER_PLATFORM_WIN32_NT then bDriveHeadReg := $A0
// else bDriveHeadReg := $A0 or ((bDriveNum and 1) shl 4);
bDriveHeadReg := $A0;
bCommandReg := $EC;
end;
end;
if not DeviceIoControl(hDevice, $0007C088, @SCIP, SizeOf
(TSendCmdInParams) - 1, @aIdOutCmd, SizeOf(aIdOutCmd),
cbBytesReturned, nil) then
Exit;
finally
CloseHandle(hDevice);
end;
with PIdSector(@IdOutCmd.bBuffer)^ do
begin
ChangeByteOrder(sSerialNumber, SizeOf(sSerialNumber));
(PWideChar(@sSerialNumber) + SizeOf(sSerialNumber))
^ := #0;
Result := Trim(PAnsiChar(@sSerialNumber));
end;
except
Result := '';
cf_sysLog('获取硬盘编号函数过程失败! 错误位置:[' +
'function cf_hardGetIDESerialID: string;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取屏幕刷新率
// 函数名称: cf_sysGetScreenFrequency
// 返回值: Integer 屏幕刷新率
// ******************************************************************************
function cf_sysGetScreenFrequency: Integer;
var
DeviceMode: TDeviceMode;
begin
try
EnumDisplaySettings(nil, Cardinal(-1), DeviceMode);
Result := DeviceMode.dmDisplayFrequency;
except
cf_sysLog('获取屏幕刷新率函数过程失败! 错误位置:[' +
'function cf_sysGetScreenFrequency: Integer;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取屏幕分辨率
// 函数名称: cf_sysGetScreenWidthHeight
// 函数参数: iWidth,iHeight:返回当前屏幕分辨率
// 返回值: 是否获取成功
// ******************************************************************************
function cf_sysGetScreenWidthHeight(var iWidth, iHeight: Integer): Boolean;
begin
Result := false;
try
iWidth := getSystemMetrics(SM_CXSCREEN);
iHeight := getSystemMetrics(SM_CYSCREEN);
except
Result := false;
cf_sysLog('获取屏幕分辨率函数过程失败! 错误位置:[' +
'function cf_sysGetScreenWidthHeight(var iWidth, iHeight: Integer): Boolean;]');
end;
Result := true;
end;
// ******************************************************************************
// 函数功能: 屏幕分辨率设置
// 函数名称: cf_sysSetScreenWidthHeight
// 函数参数: wWidth :WORD 屏宽
// wHeight :WORD 移动到指定的文件
// 返回值: 是否成功
// ******************************************************************************
function cf_sysSetScreenWidthHeight(wWidth, wHeight: Word): Boolean;
var
lpDevMode: TDeviceMode;
begin
try
Result := EnumDisplaySettings(nil, 0, lpDevMode);
if Result then
begin
lpDevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
lpDevMode.dmPelsWidth := wWidth;
lpDevMode.dmPelsHeight := wHeight;
Result := ChangeDisplaySettings(lpDevMode, 0)
= DISP_CHANGE_SUCCESSFUL;
end;
except
cf_sysLog('获取屏幕分辨率函数过程失败! 错误位置:[' +
'function cf_sysGetScreenWidthHeight(var iWidth, iHeight: Integer): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取屏幕刷新率
// 函数名称: gcf_SetScreenFrequency
// 函数参数: iFrqcy: Integer 要设置的分辨率
// 返回值: 是否获取成功
// ******************************************************************************
function cf_sysSetScreenFrequency(iFrqcy: Integer): Boolean;
var
DeviceMode: TDeviceMode;
begin
try
EnumDisplaySettings(nil, Cardinal(-1), DeviceMode);
DeviceMode.dmDisplayFrequency := Cardinal(iFrqcy);
ChangeDisplaySettings(DeviceMode, CDS_UPDATEREGISTRY);
Result := true;
except
Result := false;
cf_sysLog('获取屏幕刷新率函数过程失败! 错误位置:[' +
'function cf_sysSetScreenFrequency(iFrqcy: Integer): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 将字符串转过滤为非双字节字符
// 函数名称: cf_valGetSingleString
// 函数参数: sString:String 要处理的字符串
// 返回值: 处理后的字符串
// ******************************************************************************
function cf_valGetSingleString(sString: string): string;
var
i: Integer;
sVar: string;
begin
Result := '';
try
for i := 0 to Length(sString) do
begin
if (ByteType(sString, i) = mbSingleByte) and (sString[i] <> #0) then
begin
sVar := sVar + sString[i];
end;
end;
Result := sVar;
except
Result := '';
cf_sysLog('将字符串转过滤为非双字节字符函数过程失败! 错误位置:[' +
'function cf_valGetSingleString(sString: string): string;]');
end;
end;
// ******************************************************************************
// 函数功能: 播放声音文件
// 函数名称: cf_sysPlayWavFile
// 函数参数: sFileName: 播放的目标声音文件
// 返回值: 是否播放成功.
// ******************************************************************************
function cf_sysPlayWavFile(sFileName: string): Boolean;
var
sExtFile: string;
begin
Result := false;
// 先判断是否存在声卡
if not cf_hardIsSoundCardExist then
Exit;
sExtFile := UpperCase(Copy(sFileName, Length(sFileName) - 3, 4));
if (sExtFile <> '.WAV') then
Exit;
try
sndPlaySound(PWideChar(sFileName), SND_ASYNC);
Result := true;
except
Result := false;
cf_sysLog('播放声音文件函数过程失败! 错误位置:[' +
'function cf_sysPlayWavFile(sFileName: string): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取程序路径
// 函数名称: cf_sysGetAppPath
// 函数参数: 无参数
// 返回值: 当前应用程序路径字符串
// ******************************************************************************
function cf_sysGetAppPath: string;
begin
try
Result := ExtractFilePath(ParamStr(0)) + '\';
except
Result := '';
cf_sysLog('获取程序路径函数过程失败! 错误位置:[' +
'function cf_sysGetAppPath: string;]');
end;
end;
// ******************************************************************************
// 函数功能: 查找TStrings中是否存在指定的内容.
// 函数名称: cf_clsStringsExist
// 函数参数: oStrings: TStrings 实例(要操作的对象)
// sName, sValue: 符合列表名和值的信息
// 返回值: 是否找到指定的内容信息.
// ******************************************************************************
function cf_clsStringsExist(oStrings: TStrings; sName, sValue: string)
: Boolean;
var
iVal: Integer;
begin
Result := false;
try
if (oStrings = nil) or (Trim(sName) = '') or (Trim(sValue) = '') then
Exit;
for iVal := 0 to oStrings.Count - 1 do
begin
Result := (oStrings.Names[iVal] = sName) and
(oStrings.ValueFromIndex[iVal] = sValue);
if Result then
Break;
end;
except
Result := false;
cf_sysLog('查找TStrings中是否存在指定的内容函数过程失败! 错误位置:[' +
'function cf_clsStringsExist(oStrings: TStrings;sName, sValue: string): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 判断ListItems中是否存在要查找的内容
// 函数名称: cf_clsListExistItem
// 函数参数: oListItems: TListItems; 实例(要操作的对象)
// sValue: 符合列表的信息
// 返回值: 是否找到指定的内容信息.
// ******************************************************************************
function cf_clsListExistItem(oListItems: TListItems; sValue: string)
: Boolean;
var
iVal: Integer;
begin
Result := false;
try
if (oListItems = nil) or (Trim(sValue) = '') then
Exit;
for iVal := 0 to oListItems.Count - 1 do
begin
if PString(oListItems.Item[iVal].Data)^ = sValue then
begin
Result := true;
Exit;
end;
end;
except
Result := false;
cf_sysLog('判断ListItems中是否存在要查找的内容函数过程失败! 错误位置:[' +
'function cf_clsListExistItem(oListItems: TListItems; sValue: string): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 判断TreeNodes中是否存在要查找的内容
// 函数名称: cf_clsTreeViewExistNode
// 函数参数: oTreeNodes: TTreeNodes; 实例(要操作的对象)
// sValue: 符合列表的信息
// 返回值: 是否找到指定的内容信息.
// ******************************************************************************
function cf_clsTreeViewExistNode(oTreeNodes: TTreeNodes; sValue: string)
: Boolean;
var
iVal: Integer;
begin
Result := false;
try
if (oTreeNodes = nil) or (Trim(sValue) = '') then
Exit;
for iVal := 0 to oTreeNodes.Count - 1 do
begin
if PString(oTreeNodes.Item[iVal].Data)^ = sValue then
begin
Result := true;
Exit;
end;
end;
except
Result := false;
cf_sysLog('判断TreeNodes中是否存在要查找的内容函数过程失败! 错误位置:[' +
'function cf_clsTreeViewExistNode(oTreeNodes: TTreeNodes;sValue: string): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 重启应用程序本身
// 函数名称:cf_sysAppAutoRun
// 函数参数: bYes:Boolean 是否自动启动
// 返回值: 是否操作成功
// ******************************************************************************
{function cf_sysAppAutoRun(bYes: Boolean): Boolean;
var
oStartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
begin
Result := false;
try
FillChar(oStartupInfo, SizeOf(oStartupInfo), #0);
oStartupInfo.cb := SizeOf(oStartupInfo);
CreateProcess(nil, PWideChar(Application.ExeName), nil, nil, false,
NORMAL_PRIORITY_CLASS, nil, nil, oStartupInfo, ProcessInfo);
Result := true;
except
Result := false;
cf_sysLog('重启应用程序本身函数过程失败! 错误位置:[' +
'function cf_sysAppAutoRun(bYes: Boolean): Boolean;]')
end;
end; }
// ******************************************************************************
// 函数功能: 根据指定的数据库表名/字段名返回其字段值信息的连接串.
// 函数名称: cf_dbGetFieldsLinkStr
// 函数参数: sConStr:数据库连接字符串
// sTable:要操作的表
// sField:要查询的字段名
// sCondition:查询条件
// sDefaultval:默认值
// sLinkStr: 连接字符串
// 返回值: 查询到数据将字段值用默认的连接字符串连接起来. 如:'12,''测试'''
// ******************************************************************************
function cf_dbGetFieldsLinkStr(sConStr: string; sTable: string;
sField: string; sCondition: string = ''; sDefaultval: string = '';
sLinkStr: string = ','): string; overload;
var
oADOQuery: TADOQuery; // 临时查询变量
bIsStr: Boolean;
begin
Result := sDefaultval;
try
oADOQuery := TADOQuery.Create(nil); // 创建实例
{ 根据SQL进行查询，并将结果添加到下拉控件中 }
with oADOQuery, SQL do
try
ConnectionString := sConStr;
Close;
Clear;
ADD('Select ' + sField + ' From ' + sTable);
if sCondition <> '' then
ADD('Where ' + sCondition);
Open;
if FieldByName(sField).DataType in [ftSmallint, ftInteger, ftFloat]
then
bIsStr := false
else
bIsStr := true;
while not Eof do
begin
if bIsStr then
Result := Result + sLinkStr + '''' + FieldByName(sField)
.AsString + ''''
else
Result := Result + sLinkStr + FieldByName(sField).AsString;
Next;
end;
finally
Close;
oADOQuery.Free;
end;
if Pos(sLinkStr, Result) = 1 then
Result := Copy(Result, Length(sLinkStr) + 1, Length(Result) - Length
(sLinkStr));
except
Result := sDefaultval;
cf_sysLog('根据指定的数据库表名/字段名返回其字段值信息的连接串.函数过程失败! 错误位置:[' +
'function cf_dbGetFieldsLinkStr(sConStr: string; sTable: string;' +
'sField: string; sCondition: string = ''''; sDefaultval: string = ''''; '
+ 'sLinkStr: string = '',''): string; overload;]');
end;
end;
// ******************************************************************************
// 函数功能: 根据指定的数据库表名/字段名返回其字段值信息的连接串.
// 函数名称: cf_dbGetFieldsLinkStr
// 函数参数: oADOConnection:TADOConnection 连接对象
// sTable:要操作的表
// sField:要查询的字段名
// sCondition:查询条件
// sDefaultval:默认值
// sLinkStr: 连接字符串
// 返回值: 查询到数据将字段值用默认的连接字符串连接起来. 如:'12,''测试'''
// ******************************************************************************
function cf_dbGetFieldsLinkStr(oADOConnection: TADOConnection;
sTable: string; sField: string; sCondition: string = '';
sDefaultval: string = ''; sLinkStr: string = ','): string; overload;
var
oADOQuery: TADOQuery; // 临时查询变量
bIsStr: Boolean;
begin
Result := sDefaultval;
try
oADOQuery := TADOQuery.Create(nil); // 创建实例
{ 根据SQL进行查询，并将结果添加到下拉控件中 }
with oADOQuery, SQL do
try
Connection := oADOConnection;
Close;
Clear;
ADD('Select ' + sField + ' From ' + sTable);
if sCondition <> '' then
ADD('Where ' + sCondition);
Open;
if FieldByName(sField).DataType in [ftSmallint, ftInteger, ftFloat]
then
bIsStr := false
else
bIsStr := true;
while not Eof do
begin
if bIsStr then
Result := Result + sLinkStr + '''' + FieldByName(sField)
.AsString + ''''
else
Result := Result + sLinkStr + FieldByName(sField).AsString;
Next;
end;
finally
Close;
oADOQuery.Free;
end;
if Pos(sLinkStr, Result) = 1 then
Result := Copy(Result, Length(sLinkStr) + 1, Length(Result) - Length
(sLinkStr));
except
Result := sDefaultval;
cf_sysLog('根据指定的数据库表名/字段名返回其字段值信息的连接串函数过程失败! 错误位置:[' +
'function cf_dbGetFieldsLinkStr(oADOConnection: TADOConnection; ' +
'sTable: string; sField: string; sCondition: string = '''';' +
'sDefaultval: string = ''''; sLinkStr: string = '',''): string; overload;]');
end;
end;
// ******************************************************************************
// 函数功能: 获得长度为aiLen的包含asStr的字符串，长度不够则依据abIsFronted补字符asFixStr
// 函数名称: gcf_GetFixedLenStr
// 函数参数: asStr: 要控制的字符串
// aiLen: 要控制的长度，不足则以abIsFronted补充
// abIsFronted 是否限制长度
// 返回值: 返回指定定长度充满'0'字符串.
// ******************************************************************************
function cf_valGetFixedLenStr(sStr: string; iLen: Smallint;
sFixStr: string = '0'; bIsFronted: Boolean = true): string;
begin
Result := sStr;
try
if (Length(Result) < iLen) and (sFixStr <> '') then
while Length(Result) < iLen do
begin
if bIsFronted then
Result := sFixStr + Result
else
Result := Result + sFixStr;
end;
if bIsFronted then // 确保返回定长度的字符串
Result := Copy(Result, Length(Result) - iLen + 1, iLen)
else
Result := Copy(Result, 1, iLen);
except
Result := sStr;
cf_sysLog('获得长度为aiLen的包含asStr的字符串函数过程失败! 错误位置:[' +
'function cf_valGetFixedLenStr(sStr: string; iLen: Smallint; ' +
' sFixStr: string = ''0''; bIsFronted: Boolean = true): string;]');
end;
end;
// ******************************************************************************
// 函数功能: 根据数据库连接/SQL查询语句及指定的显示字段和关键字段填充树
// 函数名称: cf_dbFillNoLevelCnCheckTreeView
// 函数参数: oADOConnection:TADOConnection 连接对象
// oCnCheckTreeView:TCnCheckTreeView; 树形控件
// sSql:SQL查询语句
// sDisplayField:显示的字段名
// sKeyFields: 关键字段名
// bFirstClear 是否
// 返回值: 操作是否成功。
// ******************************************************************************
function cf_dbFillNoLevelCnCheckTreeView
(oCnCheckTreeView: TCnCheckTreeView; sSQL: string; sDisplayField: string;
sKeyFields: string; bFirstClear: Boolean = true;
oADOConnection: TADOConnection = nil): Boolean; overload;
var
pNodeData: pTreeNodeData;
oTreeNode: TTreeNode;
oADOQuery: TADOQuery;
iFieldCount: Integer;
begin
Result := false;
try
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString)
= '') then
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString)
<> '') then
begin
oADOConnection := goADOConDef;
end
else
begin
Exit;
end;
end
else
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) = '')
then
begin
if goADOConDef.Connected then
goADOConDef.Connected := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
goADOConDef.LoginPrompt := false;
if not goADOConDef.Connected then
goADOConDef.Open;
end
else if (goADOConDef = nil) and
(Trim(goADOConDef.ConnectionString) = '') then
begin
goADOConDef := TADOConnection(Application);
goADOConDef.LoginPrompt := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
if not goADOConDef.Connected then
goADOConDef.Open;
end;
end;
if (oADOConnection = nil) or (oCnCheckTreeView = nil) or
(Trim(sSQL) = '') or (Trim(sDisplayField) = '') or
(Trim(sKeyFields) = '') then
Exit;
if Trim(oADOConnection.ConnectionString) = '' then
Exit;
if bFirstClear then
begin
oCnCheckTreeView.Items.Clear;
end;
oCnCheckTreeView.BeginUpdate;
oADOQuery := TADOQuery.Create(nil);
try
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.SQL.Clear;
oADOQuery.Connection := oADOConnection;
oADOQuery.SQL.ADD(sSQL);
oADOQuery.Open;
if not oADOQuery.IsEmpty then
begin
oADOQuery.First;
oTreeNode := TTreeNode.Create(oCnCheckTreeView.Items);
while not oADOQuery.Eof do
begin
pNodeData := New(pTreeNodeData);
pNodeData.sID := oADOQuery.FieldByName(sKeyFields).AsString;
// 无分级
pNodeData.sPID := pNodeData.sID;
for iFieldCount := 0 to oADOQuery.FieldCount - 1 do
begin
pNodeData.sData := pNodeData.sData + Trim
(oADOQuery.Fields[iFieldCount].AsString) + CONST_VAL_SPLIT;
end;
pNodeData.sKeyField := oADOQuery.FieldByName(sKeyFields).AsString;
pNodeData.sDisplayField := oADOQuery.FieldByName(sDisplayField)
.AsString;
oTreeNode.Text := oADOQuery.FieldByName(sDisplayField).AsString;
oTreeNode.Data := pNodeData;
oCnCheckTreeView.Items.AddObject
(oTreeNode, oTreeNode.Text, pNodeData);
oADOQuery.Next;
end;
end;
Result := true;
finally
oADOQuery.Free;
oCnCheckTreeView.EndUpdate;
end;
except
cf_sysLog('根据数据库连接/SQL查询语句及指定的显示字段和关键字段填充树函数过程失败! 错误位置:[' +
'function cf_dbFillNoLevelCnCheckTreeView(oCnCheckTreeView: TCnCheckTreeView;'
+ 'sSql: string; sDisplayField: string; sKeyFields: string;' +
'bFirstClear: Boolean = true; oADOConnection: TADOConnection = nil): Boolean;'
+ 'overload;]' + ' SQL:[' + sSQL + ']');
end;
end;
// ******************************************************************************
// 函数功能: 获取无级树选择节点的数据信息
// 函数名称: cf_ctrlGetCnCheckTreeViewNodeData
// 函数参数: oCnCheckTreeView:TCnCheckTreeView 树控件
// oResultType:TctvResultType 返回操作信息的类型 /默认是所有数据。
// 返回值: 返回操作的信息
// ******************************************************************************
function cf_ctrlGetCnCheckTreeViewNodeData
(oCnCheckTreeView: TCnCheckTreeView;
oResultType: TctvResultType = ctvResultData): AnsiString;
begin
Result := '';
if (oCnCheckTreeView = nil) or (oCnCheckTreeView.Selected = nil) then
Exit;
try
if oCnCheckTreeView.Selected <> nil then
begin
case oResultType of
ctvResultID:
begin
Result := pTreeNodeData(oCnCheckTreeView.Selected.Data).sID;
end;
ctvResultPID:
begin
Result := pTreeNodeData(oCnCheckTreeView.Selected.Data).sPID;
end;
ctvResultKeyField:
begin
Result := pTreeNodeData(oCnCheckTreeView.Selected.Data)
.sKeyField;
end;
ctvResultDisplayField:
begin
Result := pTreeNodeData(oCnCheckTreeView.Selected.Data)
.sDisplayField;
end;
ctvResultData:
begin
Result := pTreeNodeData(oCnCheckTreeView.Selected.Data).sData;
end;
end;
end;
except
Result := '';
cf_sysLog('获取无级树选择节点的数据信息函数过程失败! 错误位置:[' +
'function cf_ctrlGetCnCheckTreeViewNodeData(oCnCheckTreeView: TCnCheckTreeView;'
+ ' oResultType: TctvResultType = ctvResultData): AnsiString;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取无树选择节点的数据信息
// 函数名称: cf_ctrlGetTreeViewNodeData
// 函数参数: oTreeView:TTreeView 树控件
// oResultType:TctvResultType 返回操作信息的类型 /默认是所有数据。
// 返回值: 返回操作的信息
// ******************************************************************************
function cf_ctrlGetTreeViewNodeData(oTreeView: TTreeView;
oResultType: TctvResultType = ctvResultData): AnsiString;
begin
Result := '';
if (oTreeView = nil) or (oTreeView.Selected = nil) then
Exit;
try
if oTreeView.Selected <> nil then
begin
case oResultType of
ctvResultID:
begin
Result := pTreeNodeData(oTreeView.Selected.Data).sID;
end;
ctvResultPID:
begin
Result := pTreeNodeData(oTreeView.Selected.Data).sPID;
end;
ctvResultKeyField:
begin
Result := pTreeNodeData(oTreeView.Selected.Data).sKeyField;
end;
ctvResultDisplayField:
begin
Result := pTreeNodeData(oTreeView.Selected.Data).sDisplayField;
end;
ctvResultData:
begin
Result := pTreeNodeData(oTreeView.Selected.Data).sData;
end;
end;
end;
except
Result := '';
cf_sysLog('获取无树选择节点的数据信息函数过程失败! 错误位置:[' +
'function cf_ctrlGetTreeViewNodeData(oTreeView: TTreeView;' +
'oResultType: TctvResultType = ctvResultData): AnsiString;]');
end;
end;
// ******************************************************************************
// 函数功能: 取字符串中以分隔符为中心的第几个分隔符的前字符串。
// 函数名称: cf_valGetStrPosStr
// 函数参数: sSourceString 原字符串
// 取第几个位置的字符 返回操作信息的类型 /默认是所有数据。
// 返回值: 返回操作的信息
// ******************************************************************************
function cf_valGetStrPosStr(sSourceString: string; iPosition: Integer = 1;
sSplintString: string = CONST_VAL_SPLIT): string;
var
iCount, iFind: Integer;
sFind, sResult: string;
begin
sResult := '';
try
if Trim(sSourceString) = '' then
Exit;
sFind := '';
iFind := 0;
for iCount := 1 to Length(sSourceString) do
begin
sFind := Copy(sSourceString, iCount, 1);
sResult := sResult + sFind;
if sFind = sSplintString then
begin
Inc(iFind);
if (iFind = iPosition) then
begin
sResult := Copy(sResult, 1, Pos(sSplintString, sResult) - 1);
Break;
end;
sResult := '';
end;
end;
Result := sResult;
except
Result := '';
cf_sysLog('取字符串中以分隔符为中心的第几个分隔符的前字符串函数过程失败! 错误位置:[' +
'function cf_valGetStrPosStr(sSourceString: string; iPosition: Integer = 1;'
+ 'sSplintString: string = CONST_VAL_SPLIT): string;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取字符串中含有分割字符的个数
// 函数名称: cf_valGetStrPosNum
// 函数参数: sSourceString 原字符串
// 返回值: 返回字符串中含有分割字符的个数
// ******************************************************************************
function cf_valGetStrPosNum(sSourceString: string;
sSplintString: string = CONST_VAL_SPLIT): Integer;
var
iCount, iFind: Integer;
sFind: string;
begin
Result := 0;
try
if Trim(sSourceString) = '' then
Exit;
iFind := 0;
for iCount := 1 to Length(sSourceString) do
begin
sFind := Copy(sSourceString, iCount, 1);
if sFind = sSplintString then
begin
Inc(iFind);
end;
end;
Result := iFind;
except
cf_sysLog('获取字符串中含有分割字符的个数函数过程失败! 错误位置:[' +
'function cf_valGetStrPosNum(sSourceString: string;' +
'sSplintString: string = CONST_VAL_SPLIT): Integer;]');
end;
end;
// ******************************************************************************
// 函数功能: 根据数据库连接/SQL查询语句及指定的显示的字段
// ID,PID分层填充树。
// 函数名称: cf_dbFillLevelCnCheckTreeView
// 函数参数: oADOConnection:TADOConnection 数据库连接对象。
// oCnCheckTreeView:TCnCheckTreeView; 树形控件
// sSql:SQL查询语句
// sDisplayField:显示的字段名
// sIDFieldName: 唯一编号
// sPIDFieldName: 父编号。
// bFirstClear 是否
// 返回值: 操作是否成功
// ******************************************************************************
function cf_dbFillLevelCnCheckTreeView(oCnCheckTreeView: TCnCheckTreeView;
sSQL: string; sDisplayField: string; sKeyField: string;
sIDFieldName: string; sPIDFieldName: string; bFirstClear: Boolean = true;
oADOConnection: TADOConnection = nil): Boolean; overload;
var
pNodeData: pTreeNodeData;
oTreeNode, oTreeNode1, oPTreeNode, oTreeNode2: TTreeNode;
oADOQuery: TADOQuery;
oStringList: TStringList;
iFieldCount, iIndex: Integer;
begin
Result := false;
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString) = '')
then
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) <> '')
then
begin
oADOConnection := goADOConDef;
end
else
begin
Exit;
end;
end
else
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) = '')
then
begin
if goADOConDef.Connected then
goADOConDef.Connected := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
goADOConDef.LoginPrompt := false;
if not goADOConDef.Connected then
goADOConDef.Open;
end
else if (goADOConDef = nil) and
(Trim(goADOConDef.ConnectionString) = '') then
begin
goADOConDef := TADOConnection(Application);
goADOConDef.LoginPrompt := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
if not goADOConDef.Connected then
goADOConDef.Open;
end;
end;
if (oADOConnection = nil) or (oCnCheckTreeView = nil) or
(Trim(sSQL) = '') or (Trim(oADOConnection.ConnectionString) = '') or
(Trim(sDisplayField) = '') or (Trim(sIDFieldName) = '') or
(Trim(sPIDFieldName) = '') then
Exit;
if bFirstClear then
begin
oCnCheckTreeView.Items.Clear;
end;
oCnCheckTreeView.BeginUpdate;
oADOQuery := TADOQuery.Create(nil);
try
try
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.SQL.Clear;
oADOQuery.Connection := oADOConnection;
oADOQuery.SQL.ADD(sSQL);
oADOQuery.Open;
if not oADOQuery.IsEmpty then
begin
oStringList := TStringList.Create;
oStringList.Clear;
oADOQuery.First;
oTreeNode := nil;
while not oADOQuery.Eof do
begin
pNodeData := New(pTreeNodeData);
pNodeData.sID := oADOQuery.FieldByName(sIDFieldName).AsString;
pNodeData.sPID := oADOQuery.FieldByName(sPIDFieldName).AsString;
pNodeData.sKeyField := oADOQuery.FieldByName(sKeyField).AsString;
pNodeData.sDisplayField := oADOQuery.FieldByName(sDisplayField)
.AsString;
// 所有数据列
for iFieldCount := 0 to oADOQuery.FieldCount - 1 do
begin
pNodeData.sData := pNodeData.sData + Trim
(oADOQuery.Fields[iFieldCount].AsString) + CONST_VAL_SPLIT;
end;
oTreeNode := oCnCheckTreeView.Items.AddObject
(oTreeNode, pNodeData.sDisplayField, pNodeData);
oStringList.AddObject(AnsiString(Trim(pNodeData.sID)), oTreeNode);
oADOQuery.Next;
end;
// 重置
oTreeNode1 := oCnCheckTreeView.Items.GetFirstNode;
while (oTreeNode1 <> nil) do
begin
// 当前节点父ID与查找的节点ID相同。
iIndex := oStringList.IndexOf
(AnsiString(Trim(pTreeNodeData(oTreeNode1.Data).sPID)));
if iIndex <> -1 then
begin
// 保存点
oTreeNode2 := oTreeNode1;
// 父节点。
oPTreeNode := TTreeNode(oStringList.Objects[iIndex]);
// 循环下一个节点。
oTreeNode1 := oTreeNode1.getNextSibling;
// 移动
oTreeNode2.MoveTo(oPTreeNode, naAddChild);
end
else
begin
// 循环下一个节点。
oTreeNode1 := oTreeNode1.getNextSibling;
Continue;
end;
iIndex := -1;
end;
end;
Result := true;
except
Result := false;
cf_sysLog('根据数据库连接/SQL查询语句及指定的显示的字段函数过程失败! 错误位置:[' +
'function cf_dbFillLevelCnCheckTreeView(oCnCheckTreeView: TCnCheckTreeView;'
+ 'sSql: string; sDisPlayField: string; sKeyField: string; ' +
'sIDFieldName: string; sPIDFieldName: string; bFirstClear: Boolean = true;'
+ 'oADOConnection: TADOConnection = nil): Boolean; overload;]' +
' SQL:[' + sSQL + ']');
end;
finally
oADOQuery.Free;
oCnCheckTreeView.EndUpdate;
end;
end;
// ******************************************************************************
// 函数功能: 根据数据库连接/SQL查询语句及指定的显示字段和关键字段填充树
// 函数名称: cf_dbFillNoLevelTreeView
// 函数参数: oADOConnection:TADOConnection 连接对象
// oTreeView:TTreeView 树形控件
// sSql:SQL查询语句
// sDisplayField:显示的字段名
// sKeyFields: 关键字段名
// bFirstClear 是否
// 返回值: 操作是否成功。
// ******************************************************************************
function cf_dbFillNoLevelTreeView(oTreeView: TTreeView; sSQL: string;
sDisplayField: string; sKeyFields: string; bFirstClear: Boolean = true;
oADOConnection: TADOConnection = nil): Boolean; overload;
var
pNodeData: pTreeNodeData;
oTreeNode: TTreeNode;
oADOQuery: TADOQuery;
iFieldCount: Integer;
begin
Result := false;
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString) = '')
then
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) <> '')
then
begin
oADOConnection := goADOConDef;
end
else
begin
Exit;
end;
end
else
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) = '')
then
begin
if goADOConDef.Connected then
goADOConDef.Connected := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
goADOConDef.LoginPrompt := false;
if not goADOConDef.Connected then
goADOConDef.Open;
end
else if (goADOConDef = nil) and
(Trim(goADOConDef.ConnectionString) = '') then
begin
goADOConDef := TADOConnection(Application);
goADOConDef.LoginPrompt := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
if not goADOConDef.Connected then
goADOConDef.Open;
end;
end;
if (oADOConnection = nil) or (oTreeView = nil) or (Trim(sSQL) = '') or
(Trim(sDisplayField) = '') or (Trim(sKeyFields) = '') then
Exit;
if Trim(oADOConnection.ConnectionString) = '' then
Exit;
if bFirstClear then
begin
oTreeView.Items.Clear;
end;
oTreeView.Items.BeginUpdate;
oADOQuery := TADOQuery.Create(nil);
try
try
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.SQL.Clear;
oADOQuery.Connection := oADOConnection;
oADOQuery.SQL.ADD(sSQL);
oADOQuery.Open;
if not oADOQuery.IsEmpty then
begin
oADOQuery.First;
oTreeNode := TTreeNode.Create(oTreeView.Items);
while not oADOQuery.Eof do
begin
pNodeData := New(pTreeNodeData);
pNodeData.sID := oADOQuery.FieldByName(sKeyFields).AsString;
// 无分级
pNodeData.sPID := pNodeData.sID;
for iFieldCount := 0 to oADOQuery.FieldCount - 1 do
begin
pNodeData.sData := pNodeData.sData + Trim
(oADOQuery.Fields[iFieldCount].AsString) + CONST_VAL_SPLIT;
end;
pNodeData.sKeyField := oADOQuery.FieldByName(sKeyFields).AsString;
pNodeData.sDisplayField := oADOQuery.FieldByName(sDisplayField)
.AsString;
oTreeNode.Text := oADOQuery.FieldByName(sDisplayField).AsString;
oTreeNode.Data := pNodeData;
oTreeView.Items.AddObject(oTreeNode, oTreeNode.Text, pNodeData);
oADOQuery.Next;
end;
end;
Result := true;
except
Result := false;
cf_sysLog('根据数据库连接/SQL查询语句及指定的显示字段和关键字段填充树函数过程失败! 错误位置:[' +
'function cf_dbFillNoLevelTreeView(oTreeView: TTreeView; ' +
'sSql: string; sDisplayField: string; sKeyFields: string; ' +
'bFirstClear: Boolean = true; oADOConnection: TADOConnection = nil): Boolean;'
+ 'overload;] SQL:[' + sSQL + ']');
end;
finally
oADOQuery.Free;
oTreeView.Items.EndUpdate;
end;
end;
// ******************************************************************************
// 函数功能: 获取CN树选择的数据
// 函数名称: cf_ctrlGetCnTreeViewCheckedItemsData
// 函数参数: oCnCheckTreeView:TCnCheckTreeView Cn树对象
// oResultType:TctvResultType=ctvResultData 返回数据串信息类别
// 返回值: 选择CheckBox的所有的Data列表。
// ******************************************************************************
function cf_ctrlGetCnTreeViewCheckedItemsData
(oCnCheckTreeView: TCnCheckTreeView;
oResultType: TctvResultType = ctvResultData): TStringList; overload;
var
oStringList: TStringList;
iNode: Integer;
begin
Result := nil;
try
if (oCnCheckTreeView = nil) then
Exit;
oStringList := TStringList.Create;
oStringList.Clear;
for iNode := 0 to oCnCheckTreeView.Items.Count - 1 do
begin
if (oCnCheckTreeView.Checked[oCnCheckTreeView.Items[iNode]] = true)
or (oCnCheckTreeView.CheckBoxState[oCnCheckTreeView.Items[iNode]]
= cbGrayed) then
begin
case oResultType of
ctvResultID:
oStringList.ADD
(pTreeNodeData(oCnCheckTreeView.Items[iNode].Data).sID);
ctvResultPID:
oStringList.ADD
(pTreeNodeData(oCnCheckTreeView.Items[iNode].Data).sPID);
ctvResultKeyField:
oStringList.ADD
(pTreeNodeData(oCnCheckTreeView.Items[iNode].Data).sKeyField);
ctvResultDisplayField:
oStringList.ADD
(pTreeNodeData(oCnCheckTreeView.Items[iNode].Data)
.sDisplayField);
ctvResultData:
oStringList.ADD
(pTreeNodeData(oCnCheckTreeView.Items[iNode].Data).sData);
end;
end;
end;
Result := oStringList;
except
cf_sysLog('获取CN树选择的数据函数过程失败! 错误位置:[' +
'function cf_ctrlGetCnTreeViewCheckedItemsData(oCnCheckTreeView: TCnCheckTreeView; '
+ 'oResultType: TctvResultType = ctvResultData): TStringList; overload;] ');
end;
end;
// ******************************************************************************
// 函数功能: 获取cn树选择Checked框节点的内存表数据
// 函数名称: cf_dbGetCnTreeViewCheckedItems
// 函数参数: oCnCheckTreeView:TCnCheckTreeView Cn树对象
// 返回值: 获取cn树选择Checked框节点的内存表数据
// ******************************************************************************
function cf_dbGetCnTreeViewCheckedItems(oCnCheckTreeView: TCnCheckTreeView)
: TClientDataSet; overload;
var
oClientDataSet: TClientDataSet;
iNode, iFields, iFieldsLength: Integer;
sData: AnsiString;
begin
Result := nil;
try
if (oCnCheckTreeView = nil) then
Exit;
if (oCnCheckTreeView.Items.Count <= 0) then
Exit;
oClientDataSet := TClientDataSet.Create(nil);
sData := pTreeNodeData(oCnCheckTreeView.TopItem.Data).sData;
iFieldsLength := cf_valGetStrPosNum(sData);
for iFields := 1 to iFieldsLength do
begin
with oClientDataSet.FieldDefs.AddFieldDef do
begin
Name := 'Field' + IntToStr(iFields);
DataType := ftString;
end;
end;
oClientDataSet.CreateDataSet;
oClientDataSet.Open;
for iNode := 0 to oCnCheckTreeView.Items.Count - 1 do
begin
if oCnCheckTreeView.Checked[oCnCheckTreeView.Items[iNode]] = true then
begin
// 数据所有列。
sData := pTreeNodeData(oCnCheckTreeView.Items[iNode].Data).sData;
iFieldsLength := cf_valGetStrPosNum(sData);
oClientDataSet.Append;
for iFields := 1 to iFieldsLength do
begin
oClientDataSet.Fields[iFields - 1].AsString := cf_valGetStrPosStr
(sData, iFields);
end;
oClientDataSet.Post;
end;
end;
Result := oClientDataSet;
except
Result := nil;
cf_sysLog('获取cn树选择Checked框节点的内存表数据函数过程失败! 错误位置:[' +
'function cf_dbGetCnTreeViewCheckedItems(oCnCheckTreeView: TCnCheckTreeView): TClientDataSet; overload;]');
end;
end;
// ******************************************************************************
// 函数功能: 创建系统日志函数
// 函数名称: gcf_SysLog
// 函数参数: sLogInfo:string 日志内容
// bIsErrLog:Boolean;错误日志.
// 返回值: 是否操作
// ******************************************************************************
function cf_sysLog(sLogInfo: string; bIsErrLog: Boolean = true): Boolean;
var
oTextFile: TextFile;
sLogFilePath: string;
begin
Result := false;
try
// 开启日志记录。
if goSysInfo.bIsSysLogEnable then
begin
// 判断日志目录,没有则重新创建。
if not DirectoryExists(cf_sysGetAppPath + 'Log\' + FormatDateTime
('YYYY-MM', Now)) then
begin
ForceDirectories(cf_sysGetAppPath + 'Log\' + FormatDateTime
('YYYY-MM', Now));
end;
sLogFilePath := cf_sysGetAppPath + 'Log\' + FormatDateTime
('YYYY-MM', Now) + '\' + FormatDateTime('DD', Now) + 'Day.log';
if not FileExists(sLogFilePath) then
begin
AssignFile(oTextFile, sLogFilePath);
Rewrite(oTextFile);
if bIsErrLog then
begin
Writeln(oTextFile, FormatDateTime('HHMMSS', Now));
Writeln(oTextFile,
'-----------------------错误日志----------------------');
Writeln(oTextFile, '操作者:' + goSysInfo.sLoginUserNameID);
Writeln
(oTextFile, '计算机名:' + goSysInfo.oNetWorkInfo.sComputerName);
Writeln(oTextFile, '网络地址:' + goSysInfo.oNetWorkInfo.sIP);
Writeln(oTextFile, '错误信息:' + sLogInfo);
Writeln(oTextFile, sLogInfo);
end
else
begin
Writeln(oTextFile, FormatDateTime('HHMMSS', Now));
Writeln(oTextFile,
'-----------------------正常日志----------------------');
Writeln(oTextFile, '操作者:' + goSysInfo.sLoginUserNameID);
Writeln
(oTextFile, '计算机名:' + goSysInfo.oNetWorkInfo.sComputerName);
Writeln(oTextFile, '网络地址:' + goSysInfo.oNetWorkInfo.sIP);
Writeln(oTextFile, '操作信息:' + sLogInfo);
Writeln(oTextFile, sLogInfo);
end;
end
else
begin
AssignFile(oTextFile, sLogFilePath);
Append(oTextFile);
if bIsErrLog then
begin
Writeln(oTextFile, FormatDateTime('HHMMSS', Now));
Writeln(oTextFile,
'-----------------------错误日志----------------------');
Writeln(oTextFile, '操作者:' + goSysInfo.sLoginUserNameID);
Writeln
(oTextFile, '计算机名:' + goSysInfo.oNetWorkInfo.sComputerName);
Writeln(oTextFile, '网络地址:' + goSysInfo.oNetWorkInfo.sIP);
Writeln(oTextFile, '错误信息:' + sLogInfo);
Writeln(oTextFile, sLogInfo);
end
else
begin
Writeln(oTextFile, FormatDateTime('HHMMSS', Now));
Writeln(oTextFile,
'-----------------------正常日志----------------------');
Writeln(oTextFile, '操作者:' + goSysInfo.sLoginUserNameID);
Writeln
(oTextFile, '计算机名:' + goSysInfo.oNetWorkInfo.sComputerName);
Writeln(oTextFile, '网络地址:' + goSysInfo.oNetWorkInfo.sIP);
Writeln(oTextFile, '操作信息:' + sLogInfo);
Writeln(oTextFile, sLogInfo);
end;
end;
CloseFile(oTextFile);
end;
except
end;
end;
// ******************************************************************************
// 函数功能: 根据数据库连接/SQL查询语句及指定的显示的字段
// ID,PID分层填充树。
// 函数名称: cf_dbFillLevelTreeView
// 函数参数: oADOConnection:TADOConnection; 数据库连接对象
// oTreeView:TTreeView 普通树形控件。
// sSql:SQL查询语句
// sDisplayField:显示的字段名
// sIDFieldName: 唯一编号
// sPIDFieldName: 父编号。
// bFirstClear 是否
// 返回值: 操作是否成功
// ******************************************************************************
function cf_dbFillLevelTreeView(oTreeView: TTreeView; sSQL: string;
sDisplayField: string; sKeyField: string; sIDFieldName: string;
sPIDFieldName: string; bFirstClear: Boolean = true;
oADOConnection: TADOConnection = nil): Boolean; overload;
var
pNodeData: pTreeNodeData;
oTreeNode, oTreeNode1, oPTreeNode, oTreeNode2: TTreeNode;
oADOQuery: TADOQuery;
oStringList: TStringList;
iFieldCount, iIndex: Integer;
begin
Result := false;
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString) = '')
then
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) <> '')
then
begin
oADOConnection := goADOConDef;
end
else
begin
Exit;
end;
end
else
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) = '')
then
begin
if goADOConDef.Connected then
goADOConDef.Connected := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
goADOConDef.LoginPrompt := false;
if not goADOConDef.Connected then
goADOConDef.Open;
end
else if (goADOConDef = nil) and
(Trim(goADOConDef.ConnectionString) = '') then
begin
goADOConDef := TADOConnection(Application);
goADOConDef.LoginPrompt := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
if not goADOConDef.Connected then
goADOConDef.Open;
end;
end;
if (oADOConnection = nil) or (oTreeView = nil) or (Trim(sSQL) = '') or
(Trim(oADOConnection.ConnectionString) = '') or
(Trim(sDisplayField) = '') or (Trim(sIDFieldName) = '') or
(Trim(sPIDFieldName) = '') then
Exit;
if bFirstClear then
begin
oTreeView.Items.Clear;
end;
oTreeView.Items.BeginUpdate;
oADOQuery := TADOQuery.Create(nil);
try
try
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.SQL.Clear;
oADOQuery.Connection := oADOConnection;
oADOQuery.SQL.ADD(sSQL);
oADOQuery.Open;
if not oADOQuery.IsEmpty then
begin
oStringList := TStringList.Create;
oStringList.Clear;
oADOQuery.First;
oTreeNode := nil;
while not oADOQuery.Eof do
begin
pNodeData := New(pTreeNodeData);
pNodeData.sID := oADOQuery.FieldByName(sIDFieldName).AsString;
pNodeData.sPID := oADOQuery.FieldByName(sPIDFieldName).AsString;
pNodeData.sKeyField := oADOQuery.FieldByName(sKeyField).AsString;
pNodeData.sDisplayField := oADOQuery.FieldByName(sDisplayField)
.AsString;
// 所有数据列
for iFieldCount := 0 to oADOQuery.FieldCount - 1 do
begin
pNodeData.sData := pNodeData.sData + Trim
(oADOQuery.Fields[iFieldCount].AsString) + CONST_VAL_SPLIT;
end;
oTreeNode := oTreeView.Items.AddObject
(oTreeNode, pNodeData.sDisplayField, pNodeData);
oStringList.AddObject(AnsiString(Trim(pNodeData.sID)), oTreeNode);
oADOQuery.Next;
end;
// 重置
oTreeNode1 := oTreeView.Items.GetFirstNode;
while (oTreeNode1 <> nil) do
begin
// 当前节点父ID与查找的节点ID相同。
iIndex := oStringList.IndexOf
(AnsiString(Trim(pTreeNodeData(oTreeNode1.Data).sPID)));
if iIndex <> -1 then
begin
// 保存点
oTreeNode2 := oTreeNode1;
// 父节点。
oPTreeNode := TTreeNode(oStringList.Objects[iIndex]);
// 循环下一个节点。
oTreeNode1 := oTreeNode1.getNextSibling;
// 移动
oTreeNode2.MoveTo(oPTreeNode, naAddChild);
end
else
begin
// 循环下一个节点。
oTreeNode1 := oTreeNode1.getNextSibling;
Continue;
end;
iIndex := -1;
end;
oTreeView.FullExpand;
end;
Result := true;
except
Result := false;
cf_sysLog('根据数据库连接/SQL查询语句及指定的显示的字段函数过程失败! 错误位置:[' +
'function cf_dbFillLevelTreeView(oTreeView: TTreeView; sSql: string;'
+
'sDisPlayField: string; sKeyField: string; sIDFieldName: string; ' +
'sPIDFieldName: string; bFirstClear: Boolean = true; '
+
'oADOConnection: TADOConnection = nil): Boolean; overload;] SQL:['
+ sSQL + ']');
end;
finally
oADOQuery.Free;
oTreeView.Items.EndUpdate;
end;
end;
// ******************************************************************************
// 函数功能: 获取表记录数
// 函数名称: cf_dbGetTableRecordCount
// 函数参数: oADOConnection:TADOConnection 数据库连接对象
// sTableName:string 表名
// sCondition:String 条件
// 返回值: 返回查询表的记录数。
// ******************************************************************************
function cf_dbGetTableRecordCount(sTableName: string;
sCondition: string = ''; oADOConnection: TADOConnection = nil): Integer;
overload;
var
oADOQuery: TADOQuery;
sSQL: string;
begin
Result := 0;
if Trim(sTableName) = '' then
Exit;
sSQL := 'Select Count(*) as CountField from ' + sTableName;
if Trim(sCondition) <> '' then
sSQL := sSQL + ' Where ' + sCondition;
oADOQuery := cf_dbSelectSQL(sSQL, oADOConnection);
try
Result := oADOQuery.FieldByName('CountField').AsInteger;
except
if oADOQuery <> nil then
begin
oADOQuery.Free;
end;
Result := 0;
cf_sysLog('获取表记录数函数过程失败! 错误位置:[' +
'function cf_dbGetTableRecordCount(sTableName: string; ' +
'sCondition: string = ''; oADOConnection: TADOConnection = nil): Integer;overload;] SQL:[' + sSQL + ']');
end;
end;
// ******************************************************************************
// 函数功能: 新增用户
// 函数名称: cf_operNewUser
// 函数参数: oADOConnection:TADOConnection 数据库连接对象
// sUserCode:string 用户编码
// sUserName:String 用户名
// sPassWord:String 用户密码
// 返回值: 操作是否成功
// ******************************************************************************
function cf_operNewUser(sUserCode: string; sUserName: string;
sPassWord: string; oADOConnection: TADOConnection = nil): Boolean;
var
sSQL: string;
begin
Result := false;
try
if (Trim(sUserCode) = '') or (Trim(sUserName) = '') or
(Trim(sPassWord) = '') then
Exit;
if cf_dbGetTableRecordCount('TFWUser', 'TFWUser_Code=' + QuotedStr
(Trim(sUserCode)), oADOConnection) > 0 then
begin
cf_sysMsgBox(sUserCode + '用户已经存在，请使用其它用户重试!', MB_OK + MB_ICONERROR);
Exit;
end;
sSQL :=
'Insert into TFWUser(TFWUser_Code,Name,PassWord,PinYin,RegTime,Remark,Status) values('
+ QuotedStr(Trim(sUserCode)) + ',' + QuotedStr(Trim(sUserName))
+ ',' + QuotedStr(cf_valEncryptCodeA(Trim(sPassWord)))
+ ',' + QuotedStr(cf_valGetPinYin(Trim(sUserName))) + ',' + QuotedStr
(cf_dbGetSysTime(oADOConnection)) + ',' + QuotedStr('') + ',1)';
if cf_dbExeSQLNum(sSQL, oADOConnection) > 0 then
begin
Result := true;
end;
except
Result := false;
cf_sysLog('新增用户函数过程失败! 错误位置:[' +
'function cf_operNewUser(sUserCode: string; sUserName: string;' +
'sPassWord: string; oADOConnection: TADOConnection = nil): Boolean;] SQL:[' + sSQL + ']');
end;
end;
// ******************************************************************************
// 函数功能: 检测用户
// 函数名称: cf_operCheckUser
// 函数参数: oADOConnection:TADOConnection 数据库连接对象
// sUserCode:string 用户编码
// sPassWord:String 用户密码
// 返回值: 是否为合法用户
// ******************************************************************************
function cf_operCheckUser(sUserCode: string; sPassWord: string;
oADOConnection: TADOConnection = nil; bEncrypt: Boolean = false)
: Boolean; overload;
var
sValue: string;
begin
Result := false;
try
if cf_dbGetTableRecordCount('TFWUser', 'TFWUser_Code=' + QuotedStr
(sUserCode), oADOConnection) > 0 then
begin
sValue := (cf_dbGetTableFieldValue('TFWUser', 'PassWord',
'TFWUser_Code=' + QuotedStr(sUserCode)));
if not goSysInfo.bIsAutoLogin then
begin
if not bEncrypt then
begin
if (sValue = cf_valMD5Encrypt(sUserCode + sPassWord)) then
begin
goSysInfo.sLoginUserNameNick := cf_dbGetTableFieldValue
('TFWUser', 'Name', 'TFWUser_Code=' + QuotedStr(sUserCode));
goSysInfo.sLoginGroupID := cf_dbGetTableFieldValue
('TFWUser_tRole', 'TFWRole_Code', 'TFWUser_Code=' + QuotedStr
(sUserCode));
goSysInfo.sLoginGroupName := cf_dbGetTableFieldValue
('TFWRole', 'Name', 'TFWRole_Code=' + QuotedStr
(goSysInfo.sLoginGroupID));
goSysInfo.sLoginPassWord := sValue;
cf_fileSetSystemInfo(goSysInfo, 1);
Result := true;
end
else
begin
Result := false;
end;
end
else
begin
if sValue = sPassWord then
begin
goSysInfo.sLoginUserNameNick := cf_dbGetTableFieldValue
('TFWUser', 'Name', 'TFWUser_Code=' + QuotedStr(sUserCode));
goSysInfo.sLoginGroupID := cf_dbGetTableFieldValue
('TFWUser_tRole', 'TFWRole_Code', 'TFWUser_Code=' + QuotedStr
(sUserCode));
goSysInfo.sLoginGroupName := cf_dbGetTableFieldValue
('TFWRole', 'Name', 'TFWRole_Code=' + QuotedStr
(goSysInfo.sLoginGroupID));
goSysInfo.sLoginPassWord := sValue;
cf_fileSetSystemInfo(goSysInfo, 1);
Result := true;
end
else
begin
Result := false;
end;
end;
end
else
begin
if not bEncrypt then
begin
if (sValue = cf_valMD5Encrypt(sUserCode + sPassWord)) then
begin
goSysInfo.sLoginUserNameNick := cf_dbGetTableFieldValue
('TFWUser', 'Name', 'TFWUser_Code=' + QuotedStr(sUserCode));
goSysInfo.sLoginGroupID := cf_dbGetTableFieldValue
('TFWUser_tRole', 'TFWRole_Code', 'TFWUser_Code=' + QuotedStr
(sUserCode));
goSysInfo.sLoginGroupName := cf_dbGetTableFieldValue
('TFWRole', 'Name', 'TFWRole_Code=' + QuotedStr
(goSysInfo.sLoginGroupID));
goSysInfo.sLoginPassWord := sValue;
cf_fileSetSystemInfo(goSysInfo, 1);
Result := true;
end
else
begin
Result := false;
end;
end
else
begin
if sValue = sPassWord then
begin
goSysInfo.sLoginUserNameNick := cf_dbGetTableFieldValue
('TFWUser', 'Name', 'TFWUser_Code=' + QuotedStr(sUserCode));
goSysInfo.sLoginGroupID := cf_dbGetTableFieldValue
('TFWUser_tRole', 'TFWRole_Code', 'TFWUser_Code=' + QuotedStr
(sUserCode));
goSysInfo.sLoginGroupName := cf_dbGetTableFieldValue
('TFWRole', 'Name', 'TFWRole_Code=' + QuotedStr
(goSysInfo.sLoginGroupID));
goSysInfo.sLoginPassWord := sValue;
cf_fileSetSystemInfo(goSysInfo, 1);
Result := true;
end
else
begin
Result := false;
end;
end;
end;
end
else
begin
Result := false;
end;
except
Result := false;
cf_sysLog('检测用户函数过程失败! 错误位置:[' +
'function cf_operCheckUser(sUserCode: string; sPassWord: string; '
+ 'oADOConnection: TADOConnection = nil): Boolean; overload;]');
end;
end;
// ******************************************************************************
// 函数功能: 修改用户密码
// 函数名称: cf_operModifyUserPassWord
// 函数参数: oADOConnection:TADOConnection 数据库连接对象
// sUserCode:string 用户编码
// sOldPassWord:string; 旧密码
// sNewPassWord:String 用户新密码
// 返回值: 是否为合法用户
// ******************************************************************************
function cf_operModifyUserPassWord(sUserCode: string; sOldPassWord: string;
sNewPassWord: string; oADOConnection: TADOConnection = nil): Boolean;
overload;
var
sSQL: string;
begin
Result := false;
try
if Trim(sOldPassWord) = Trim(sNewPassWord) then
begin
cf_sysMsgBox('新密码与旧密码一致,无需更新!', MB_OK + MB_ICONINFORMATION);
Exit;
end;
// 是合法用户
if cf_operCheckUser(sUserCode, sOldPassWord, oADOConnection) then
begin
sSQL := 'Update TFWUser set PassWord=' + QuotedStr
(Trim(sNewPassWord)) + ' Where TFWUser_Code=' + QuotedStr
(sUserCode);
if cf_dbExeSQLNum(sSQL, oADOConnection) > 0 then
begin
Result := true;
end;
end
else
begin
cf_sysMsgBox('非法用户!', MB_OK + MB_ICONERROR);
end;
except
Result := false;
cf_sysLog('修改用户密码函数过程失败! 错误位置:[' +
'function cf_operModifyUserPassWord(sUserCode: string; sOldPassWord: string;'
+
'sNewPassWord: string; oADOConnection: TADOConnection = nil): Boolean;' + 'overload;] SQL:[' + sSQL + ']');
end;
end;
// ******************************************************************************
// 函数功能: 更新Dll文件
// 函数名称: cf_operUpdateDllFiles
// 函数参数: oADOConnection:TADOConnection 数据库连接对象
// sUserCode:string 用户编码
// sPassWord:String 用户密码
// 返回值: 是否更新成功。
// ******************************************************************************
function cf_operUpdateDllFiles(sUserCode: string; sPassWord: string;
sFuncName: string; oADOConnection: TADOConnection = nil): Boolean;
overload;
var
sSQL, sFileName: string;
iFailed: Integer;
oADOQuery, oADOQueryResource: TADOQuery;
begin
Result := false;
iFailed := 0;
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString) = '')
or (Trim(sUserCode) = '') or (Trim(sPassWord) = '') then
Exit;
sSQL :=
'Select TFWResourceFileName from VFWUserResource where TFWUser_Code=' +
QuotedStr(Trim(sUserCode)) + ' and PassWord=' + QuotedStr
(cf_valEncryptCodeA(Trim(sPassWord))) + ' and FuncName=' + QuotedStr
(Trim(sFuncName));
oADOQuery := cf_dbSelectSQL(sSQL, oADOConnection);
if oADOQuery = nil then
Exit;
oADOQueryResource := TADOQuery.Create(nil);
try
try
if not oADOQuery.IsEmpty then
begin
oADOQuery.First;
while not oADOQuery.Eof do
begin
// 该用户可更新的模块。
sFileName := LowerCase
(Trim(oADOQuery.FieldByName('TFWResourceFileName').AsString));
try
if oADOQueryResource.Active then
oADOQueryResource.Close;
oADOQueryResource.SQL.Clear;
oADOQueryResource.Connection := oADOConnection;
oADOQueryResource.SQL.ADD(
'Select * from TFWResourceFile Where TFWResourceFileName=' +
QuotedStr(sFileName));
oADOQueryResource.Open;
if not oADOQueryResource.IsEmpty then
begin
oADOQueryResource.First;
// 判断文件是否存在
if FileExists(cf_sysGetAppPath + sFileName) then
begin
// MD5相同，无需更新。
if cf_fileGetFileMD5Math(cf_sysGetAppPath + sFileName,
oADOQueryResource.FieldByName('MD5Value').AsString) then
begin
oADOQuery.Next;
Continue;
end
else if cf_fileIsFileInUse(cf_sysGetAppPath + sFileName)
then
begin
iFailed := iFailed + 1;
oADOQuery.Next;
Continue;
end;
// 更新文件到目录中。
TBlobField(oADOQueryResource.FieldByName('FileData'))
.SaveToFile(cf_sysGetAppPath + sFileName);
end
else
begin
// 更新文件到目录中.
TBlobField(oADOQueryResource.FieldByName('FileData'))
.SaveToFile(cf_sysGetAppPath + sFileName);
end;
end;
except
iFailed := iFailed + 1;
oADOQuery.Next;
end;
oADOQuery.Next;
end;
if iFailed = 0 then
Result := true;
end;
except
Result := false;
cf_sysLog('更新Dll文件函数过程失败! 错误位置:[' +
'function cf_operUpdateDllFiles(sUserCode: string; sPassWord: string;' + 'sFuncName: string; oADOConnection: TADOConnection = nil): Boolean; overload;] SQL:[' + sSQL + ']');
end;
finally
if oADOQueryResource.Active then
oADOQueryResource.Close;
oADOQueryResource.Free;
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.Free;
end;
end;
// ******************************************************************************
// 函数功能: 更新资源文件到服务器
// 函数名称: cf_operUploadDllFiles
// 函数参数: oADOConnection:TADOConnection 数据库连接对象
// sResourceFileName:string 文件名
// 返回值: 是否为合法用户
// ******************************************************************************
function cf_operUploadDllFiles(sResourceFileName: string;
oADOConnection: TADOConnection = nil): Boolean;
var
sSQL, sFileSize, sFileMD5: string;
oADOQuery: TADOQuery;
begin
Result := false;
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString) = '')
then
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) <> '')
then
begin
oADOConnection := goADOConDef;
end
else
begin
Exit;
end;
end
else
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) = '')
then
begin
if goADOConDef.Connected then
goADOConDef.Connected := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
goADOConDef.LoginPrompt := false;
if not goADOConDef.Connected then
goADOConDef.Open;
end
else if (goADOConDef = nil) and
(Trim(goADOConDef.ConnectionString) = '') then
begin
goADOConDef := TADOConnection(Application);
goADOConDef.LoginPrompt := false;
goADOConDef.ConnectionString := oADOConnection.ConnectionString;
if not goADOConDef.Connected then
goADOConDef.Open;
end;
end;
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString) = '')
or (Trim(sResourceFileName) = '') then
Exit;
if (not FileExists(sResourceFileName)) then
begin
cf_sysMsgBox('要上传的文件不存在!', MB_OK + MB_ICONERROR);
Exit;
end;
if cf_fileIsFileInUse(sResourceFileName) then
begin
cf_sysMsgBox('文件被使用，无法上传此文件!', MB_OK + MB_ICONERROR);
Exit;
end;
sFileMD5 := cf_fileGetFileMD5(sResourceFileName);
sFileSize := FloatToStr(cf_fileGetFileSize(sResourceFileName));
sResourceFileName := ExtractFileName(sResourceFileName);
oADOQuery := TADOQuery.Create(nil);
sSQL :=
'Select * from TFWResourceFile Where TFWResourceFileName=' + QuotedStr
(Trim(sResourceFileName)) + ' and FileType=0';
try
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.SQL.Clear;
oADOQuery.Connection := oADOConnection;
oADOQuery.SQL.ADD(sSQL);
oADOQuery.Open;
try
if oADOQuery.IsEmpty then
begin
oADOQuery.Append;
oADOQuery.FieldByName('TFWResourceFileName').AsString := LowerCase
(Trim(sResourceFileName));
TBlobField(oADOQuery.FieldByName('FileData')).LoadFromFile
(sResourceFileName);
oADOQuery.FieldByName('FileSize').AsString := sFileSize;
oADOQuery.FieldByName('MD5Value').AsString := sFileMD5;
oADOQuery.FieldByName('RegTime').AsString := cf_dbGetSysTime
(oADOConnection);
oADOQuery.Post;
end
else
begin
// MD5与原来一样。
if cf_fileGetFileMD5Math(sResourceFileName, oADOQuery.FieldByName
('MD5Value').AsString) then
begin
cf_sysMsgBox('要更新的文件与源文件相同,无需更新!', MB_OK + MB_ICONINFORMATION);
Exit;
end;
oADOQuery.Edit;
oADOQuery.FieldByName('TFWResourceFileName').AsString := LowerCase
(Trim(sResourceFileName));
TBlobField(oADOQuery.FieldByName('FileData')).LoadFromFile
(sResourceFileName);
oADOQuery.FieldByName('FileSize').AsString := sFileSize;
oADOQuery.FieldByName('MD5Value').AsString := sFileMD5;
oADOQuery.FieldByName('RegTime').AsString := cf_dbGetSysTime
(oADOConnection);
oADOQuery.FieldByName('FileType').AsString := '0';
oADOQuery.Post;
end;
Result := true;
except
oADOQuery.Close;
Result := false;
cf_sysLog('更新资源文件到服务器函数过程失败! 错误位置:[' +
'function cf_operUploadDllFiles(sResourceFileName: string;' +
'oADOConnection: TADOConnection = nil): Boolean;] SQL:[' + sSQL +
']');
end;
finally
oADOQuery.Free;
end;
end;
// ******************************************************************************
// 函数功能: 压缩Access数据库
// 函数名称: cf_fileCompactAccessDB
// 函数参数: sDBFile: string 数据库文件路径
// 返回值: 是否压缩成功
// ******************************************************************************
function cf_fileCompactAccessDB(sDBFile: string): Boolean;
var
CompactAccess: OleVariant;
sDBFileBack: string;
begin
Result := true;
try
sDBFileBack := sDBFile + '.Back';
// 通过建立JRO(Microsoft Jet and Replication Objects)对象进行访问
CompactAccess := CreateOleObject('JRO.JetEngine');
CompactAccess.CompactDatabase(
'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + sDBFile,
'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + sDBFileBack +
';Jet OLEDB:Encrypt Database=True;Jet OLEDB:Database Password=""');
if FileExists(sDBFileBack) then
begin
DeleteFile(sDBFile);
RenameFile(sDBFileBack, sDBFile);
end
else
Result := false;
except
Result := false;
cf_sysLog('压缩Access数据库函数过程失败! 错误位置:[' +
'function cf_fileCompactAccessDB(sDBFile: string): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 获取当前系统的临时目录
// 函数名称: cf_sysGetTempPath
// 函数参数: 无
// 返回值: Temp路径
// ******************************************************************************
function cf_sysGetTempPath: string;
var
nBufferLength: DWORD;
lpBuffer: PWideChar;
begin
nBufferLength := MAX_PATH + 1;
GetMem(lpBuffer, nBufferLength);
try
try
if GetTempPath(nBufferLength, lpBuffer) <> 0 then
Result := StrPas(lpBuffer)
else
Result := '';
except
cf_sysLog('获取当前系统的临时目录函数过程失败! 错误位置:[' +
'function cf_sysGetTempPath: string;]');
end;
finally
FreeMem(lpBuffer);
end;
end;
// ******************************************************************************
// 函数功能: 设置下拉列表为费用类型。
// 函数名称: cf_operChargeTypeFillCombobox
// 函数参数: 无
// 返回值: 是否设置成功。
// ******************************************************************************
function cf_operFillCombobox(oComboBox: TComboBox; iOperType: Integer)
: Boolean;
begin
Result := false;
try
if oComboBox = nil then
Exit;
oComboBox.Style := csDropDownList;
oComboBox.Items.Clear;
// 结算方式
if iOperType = CONST_OPER_CHARGETYPE then
begin
oComboBox.Items.ADD('现结');
oComboBox.Items.ADD('月结');
end
else if iOperType = CONST_OPER_CURRENCYCODE then
begin
// 币种
oComboBox.Items.ADD('人民币');
oComboBox.Items.ADD('美元');
oComboBox.Items.ADD('欧元');
end
else if iOperType = CONST_OPER_HVLOCATION then
begin
// 排列方式
oComboBox.Items.ADD('东');
oComboBox.Items.ADD('南');
oComboBox.Items.ADD('西');
oComboBox.Items.ADD('北');
end
else if iOperType = CONST_OPER_CNTREF then
begin
// 箱空重
oComboBox.Items.ADD('空');
oComboBox.Items.ADD('重');
end
else if iOperType = CONST_OPER_ASSIGNTYPE then
begin
// 箱空重
oComboBox.Items.ADD('指定');
oComboBox.Items.ADD('商检');
oComboBox.Items.ADD('指定商检');
end
else if iOperType = CONST_OPER_ASSIGNINOUT then
begin
// 箱空重
oComboBox.Items.ADD('理货');
oComboBox.Items.ADD('提箱');
oComboBox.Items.ADD('待定');
end
else if iOperType = CONST_OPER_COLORTYPE then
begin
// 颜色类型
oComboBox.Items.ADD('动态');
oComboBox.Items.ADD('经营人');
oComboBox.Items.ADD('层高');
oComboBox.Items.ADD('航次');
oComboBox.Items.Add('空重');
oComboBox.Items.Add('好坏箱');
oComboBox.Items.Add('箱型');
oComboBox.Items.Add('尺寸');
oComboBox.Items.Add('冻柜');
end
else if iOperType = CONST_OPER_CNTRFLAG then
begin
// 箱标识
oComboBox.Items.ADD('提箱预定-▲');
oComboBox.Items.ADD('理货预定-◆');
oComboBox.Items.ADD('中控移箱-↗');
oComboBox.Items.ADD('禁止用箱-╳');
oComboBox.Items.ADD('特殊用箱-■');
oComboBox.Items.ADD('VIP 用箱-★');
oComboBox.Items.ADD('指定用箱-※');
end
else if iOperType = CONST_OPER_BAYORDER then
begin
// 垛排序
oComboBox.Items.ADD('正序');
oComboBox.Items.ADD('反序');
end
else if iOperType = CONST_OPER_LOCORDER then
begin
// 排排序
oComboBox.Items.ADD('正序');
oComboBox.Items.ADD('反序');
end
else if iOperType = CONST_OPER_TASKTYPE then
begin
// 任务类型
oComboBox.Items.ADD('归垛');
oComboBox.Items.ADD('提箱');
oComboBox.Items.ADD('修箱摆箱');
oComboBox.Items.ADD('按指令垛位间移箱');
oComboBox.Items.ADD('重箱摆箱');
oComboBox.Items.ADD('重箱提箱');
oComboBox.Items.ADD('修箱拾箱');
oComboBox.Items.ADD('理货仓库移箱');
end
else if iOperType = CONST_OPER_CNTRSTATUS then
begin
// 箱状态.
oComboBox.Items.Append('好箱');
oComboBox.Items.Append('法检'); //未做PTI'
oComboBox.Items.Append('坏箱');
oComboBox.Items.Append('已使用');
end
else if iOperType = CONST_OPER_YESNO then
begin
// 是与否
oComboBox.Items.Append('是');
oComboBox.Items.Append('否');
end
else if iOperType = CONST_OPER_IE then
begin
// 是与否
oComboBox.Items.Append('进口');
oComboBox.Items.Append('出口');
end
else if iOperType = CONST_OPER_CNTRSTATUSDESC then
begin
oComboBox.Items.Append('食品箱');
oComboBox.Items.Append('普通新箱');
oComboBox.Items.Append('普通好箱');
oComboBox.Items.Append('机组坏');
oComboBox.Items.Append('冻柜新箱');
oComboBox.Items.Append('待检箱');
oComboBox.Items.Append('水洗及维修');
oComboBox.Items.Append('纯水洗');
oComboBox.Items.Append('可以维修');
oComboBox.Items.Append('待批');
oComboBox.Items.Append('已批');
end;
oComboBox.ItemIndex := -1;
Result := true;
except
Result := false;
cf_sysLog('设置下拉列表为费用类型函数过程失败! 错误位置:[' +
'function cf_operFillCombobox(var oCombobox: TComboBox;iOperType: Integer): Boolean]');
end;
end;
// ******************************************************************************
// 函数功能: 设置下拉列表为费用类型。
// 函数名称: cf_operFillStrings
// 函数参数: iOperType: Integer 业务类型
// 返回值: TStrings; 列表.
// ******************************************************************************
function cf_operFillStrings(oStrings: TStrings; iOperType: Integer)
: Boolean;
begin
Result := false;
if (oStrings = nil) then
begin
Exit;
end;
try
oStrings.Clear;
// 结算方式
if iOperType = CONST_OPER_CHARGETYPE then
begin
oStrings.ADD('现结');
oStrings.ADD('月结');
end
else if iOperType = CONST_OPER_CURRENCYCODE then
begin
// 币种
oStrings.ADD('人民币');
oStrings.ADD('美元');
oStrings.ADD('欧元');
end
else if iOperType = CONST_OPER_HVLOCATION then
begin
// 排列方式
oStrings.ADD('东');
oStrings.ADD('南');
oStrings.ADD('西');
oStrings.ADD('北');
end
else if iOperType = CONST_OPER_CNTREF then
begin
// 箱空重
oStrings.ADD('空');
oStrings.ADD('重');
end
else if iOperType = CONST_OPER_ASSIGNTYPE then
begin
// 箱空重
oStrings.ADD('指定');
oStrings.ADD('商检');
oStrings.ADD('指定商检');
end
else if iOperType = CONST_OPER_ASSIGNINOUT then
begin
// 箱空重
oStrings.ADD('理货');
oStrings.ADD('提箱');
oStrings.ADD('待定');
end
else if iOperType = CONST_OPER_COLORTYPE then
begin
// 颜色类型
oStrings.ADD('动态');
oStrings.ADD('经营人');
oStrings.ADD('层高');
oStrings.ADD('航次');
oStrings.Add('空重');
oStrings.Add('好坏箱');
oStrings.Add('箱型');
oStrings.Add('尺寸');
oStrings.Add('冻柜');
end
else if iOperType = CONST_OPER_CNTRFLAG then
begin
// 箱状态
oStrings.ADD('提箱预定-▲');
oStrings.ADD('理货预定-◆');
oStrings.ADD('中控移箱-↗');
oStrings.ADD('禁止用箱-╳');
oStrings.ADD('特殊用箱-■');
oStrings.ADD('VIP 用箱-★');
oStrings.ADD('指定用箱-※');
end
else if iOperType = CONST_OPER_BAYORDER then
begin
// 垛排序
oStrings.ADD('正序');
oStrings.ADD('反序');
end
else if iOperType = CONST_OPER_LOCORDER then
begin
// 排排序
oStrings.ADD('正序');
oStrings.ADD('反序');
end
else if iOperType = CONST_OPER_TASKTYPE then
begin
// 任务类型
oStrings.ADD('归垛');
oStrings.ADD('提箱');
oStrings.ADD('修箱摆箱');
oStrings.ADD('按指令垛位间移箱');
oStrings.ADD('重箱摆箱');
oStrings.ADD('重箱提箱');
oStrings.ADD('修箱拾箱');
oStrings.ADD('理货仓库移箱');
end
else if iOperType = CONST_OPER_CNTRSTATUS then
begin
// 箱状态.
oStrings.Append('好箱');
oStrings.Append('法检');//未做PTI
oStrings.Append('坏箱');
oStrings.Append('已使用');
end
else if iOperType = CONST_OPER_YESNO then
begin
// 箱状态.
oStrings.Append('是');
oStrings.Append('否');
end
else if iOperType = CONST_OPER_IE then
begin
// 箱状态.
oStrings.Append('进口');
oStrings.Append('出口');
end
else if iOperType = CONST_OPER_CNTRSTATUSDESC then
begin
oStrings.Append('食品箱');
oStrings.Append('普通新箱');
oStrings.Append('普通好箱');
oStrings.Append('机组坏');
oStrings.Append('冻柜新箱');
oStrings.Append('待检箱');
oStrings.Append('水洗及维修');
oStrings.Append('纯水洗');
oStrings.Append('可以维修');
oStrings.Append('待批');
oStrings.Append('已批');
end;
Result := true;
except
Result := false;
cf_sysLog('设置下拉列表函数过程失败! 错误位置:[' +
'function cf_operFillStrings(var oStrings:TStrings;iOperType: Integer): Boolean;]');
end;
end;
// ******************************************************************************
// 函数功能: 根据输入的值设置费用列表显示值。
// 函数名称: cf_operChargeTypeSetComboboxValue
// 函数参数: 无
// 返回值: 是否设置成功。
// ******************************************************************************
function cf_operSetComboboxValue(var oComboBox: TComboBox; sValue: string;
iOperType: Integer): Boolean;
begin
Result := false;
try
if oComboBox = nil then
Exit;
// 结算方式
if iOperType = CONST_OPER_CHARGETYPE then
begin
if sValue = 'C' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('现结');
end
else if sValue = 'M' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('月结');
end;
end
else if iOperType = CONST_OPER_CURRENCYCODE then
begin
// 币种
if sValue = 'RMB' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('人民币');
end
else if sValue = 'USD' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('美元');
end
else if sValue = 'EUR' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('欧元');
end;
end
else if iOperType = CONST_OPER_HVLOCATION then
begin
if sValue = 'E' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('东');
end
else if sValue = 'S' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('南');
end
else if sValue = 'W' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('西');
end
else if sValue = 'N' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('北');
end;
end
else if iOperType = CONST_OPER_CNTREF then
begin
if sValue = 'E' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('空');
end
else if sValue = 'F' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('重');
end;
end
else if iOperType = CONST_OPER_ASSIGNTYPE then
begin
if sValue = 'P' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('指定');
end
else if sValue = 'I' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('商检');
end
else if sValue = 'PI' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('指定商检');
end;
end
else if iOperType = CONST_OPER_ASSIGNINOUT then
begin
if sValue = 'I' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('理货');
end
else if sValue = 'O' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('提箱');
end
else if sValue = 'P' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('待定');
end;
end
else if iOperType = CONST_OPER_COLORTYPE then
begin
if sValue = 'COLORDYNAMIC' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('动态');
end
else if sValue = 'COLOROPTR' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('经营人');
end
else if sValue = 'COLORTIER' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('层高');
end
else if sValue = 'COLORVOYAGE' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('航次');
end
else if sValue = 'COLOREF' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('空重');
end
else if sValue = 'COLORGE' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('好坏箱');
end
else if sValue = 'COLORTYPE' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('箱型');
end
else if sValue = 'COLORSIZE' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('尺寸');
end
else if sValue = 'COLORREF' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('冻柜');
end
end
else if iOperType = CONST_OPER_CNTRFLAG then
begin
if sValue = 'L' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('提箱预定-▲');
end
else if sValue = 'M' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('理货预定-◆');
end
else if sValue = 'P' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('中控移箱-↗');
end
else if sValue = 'H' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('禁止用箱-╳');
end
else if sValue = 'V' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('VIP 用箱-★');
end
else if sValue = 'S' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('特殊用箱-■');
end
else if sValue = 'A' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('指定用箱-※');
end;
end
else if iOperType = CONST_OPER_BAYORDER then
begin
if sValue = 'MIN' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('正序');
end
else if sValue = 'MAX' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('反序');
end;
end
else if iOperType = CONST_OPER_LOCORDER then
begin
if sValue = 'MIN' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('正序');
end
else if sValue = 'MAX' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('反序');
end;
end
else if iOperType = CONST_OPER_TASKTYPE then
begin
if sValue = 'ST' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('归垛');
end
else if sValue = 'LT' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('提箱');
end
else if sValue = 'SR' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('修箱摆箱');
end
else if sValue = 'MV' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('按指令垛位间移箱');
end
else if sValue = 'FT' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('重箱摆箱');
end
else if sValue = 'FL' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('重箱提箱');
end
else if sValue = 'RT' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('修箱拾箱');
end
else if sValue = 'MC' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('理货仓库移箱');
end;
end
else if iOperType = CONST_OPER_CNTRSTATUS then
begin
if sValue = 'AC' then //AV
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('好箱');
end
else if sValue = 'B' then //DE
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('法检'); //未做PTI
end
else if sValue = 'US' then //US
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('已使用');
end
else if sValue = 'D' then //DL
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('坏箱');
end;
end
else if iOperType = CONST_OPER_YESNO then
begin
if sValue = 'Y' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('是');
end
else if sValue = 'N' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('否');
end;
end
else if iOperType = CONST_OPER_IE then
begin
if sValue = 'I' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('进口');
end
else if sValue = 'E' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('出口');
end;
end
else if iOperType = CONST_OPER_CNTRSTATUSDESC then
begin
if sValue = 'FC' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('食品箱');
end
else if sValue = 'NE' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('普通新箱');
end
else if sValue = 'AV' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('普通好箱');
end
else if sValue = 'DC' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('机组坏');
end
else if sValue = 'DN' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('冻柜新箱');
end
else if sValue = 'DE' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('待检箱');
end
else if sValue = 'WR' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('水洗及维修');
end
else if sValue = 'PW' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('纯水洗');
end
else if sValue = 'DL' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('可以维修');
end
else if sValue = 'WA' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('待批');
end
else if sValue = 'CM' then
begin
oComboBox.ItemIndex := oComboBox.Items.IndexOf('已批');
end;
end;
Result := true;
except
Result := false;
cf_sysLog('根据输入的值设置费用列表显示值函数过程失败! 错误位置:[' +
'function cf_operFillCombobox(var oCombobox: TComboBox;iOperType: Integer): Boolean]');
end;
end;
// ******************************************************************************
// 函数功能: 根据输入的值返回显示的文本信息
// 函数名称: cf_operGetValueDisplayText
// 函数参数: sValue:string 要设置返回的值
// iOperType: Integer 要返回文本业务类型.
// 返回值: 返回显示的文本信息.
// ******************************************************************************
function cf_operGetValueDisplayText(const sValue: string;
iOperType: Integer): string;
begin
Result := '';
try
// 结算方式
if iOperType = CONST_OPER_CHARGETYPE then
begin
if sValue = 'C' then
begin
Result := '现结';
end
else if sValue = 'M' then
begin
Result := '月结';
end;
end
else if iOperType = CONST_OPER_CURRENCYCODE then
begin
if sValue = 'RMB' then
begin
Result := '人民币';
end
else if sValue = 'USD' then
begin
Result := '美元';
end
else if sValue = 'EUR' then
begin
Result := '欧元';
end;
end
else if iOperType = CONST_OPER_HVLOCATION then
begin
if sValue = 'E' then
begin
Result := '东';
end
else if sValue = 'S' then
begin
Result := '南';
end
else if sValue = 'W' then
begin
Result := '西';
end
else if sValue = 'N' then
begin
Result := '北';
end;
end
else if iOperType = CONST_OPER_CNTREF then
begin
if sValue = 'E' then
begin
Result := '空';
end
else if sValue = 'F' then
begin
Result := '重';
end;
end
else if iOperType = CONST_OPER_ASSIGNTYPE then
begin
if sValue = 'P' then
begin
Result := '指定';
end
else if sValue = 'I' then
begin
Result := '商检';
end
else if sValue = 'PI' then
begin
Result := '指定商检';
end;
end
else if iOperType = CONST_OPER_ASSIGNINOUT then
begin
if sValue = 'I' then
begin
Result := '理货';
end
else if sValue = 'O' then
begin
Result := '提箱';
end
else if sValue = 'P' then
begin
Result := '待定';
end;
end
else if iOperType = CONST_OPER_COLORTYPE then
begin
if sValue = 'COLORDYNAMIC' then
begin
Result := '动态';
end
else if sValue = 'COLOROPTR' then
begin
Result := '经营人';
end
else if sValue = 'COLORTIER' then
begin
Result := '层高';
end
else if sValue = 'COLOREF' then
begin
Result := '空重';
end
else if sValue = 'COLORGE' then
begin
Result := '好坏箱';
end
else if sValue = 'COLORTYPE' then
begin
Result := '箱型';
end
else if sValue = 'COLORSIZE' then
begin
Result := '尺寸';
end
else if sValue = 'COLORREF' then
begin
Result := '冻柜';
end
else if sValue = 'COLORVOYAGE' then
begin
Result := '航次';
end;
end
else if iOperType = CONST_OPER_CNTRFLAG then
begin
if sValue = 'L' then
begin
Result := '提箱预定-▲';
end
else if sValue = 'M' then
begin
Result := '理货预定-◆';
end
else if sValue = 'P' then
begin
Result := '中控移箱-↗';
end
else if sValue = 'H' then
begin
Result := '禁止用箱-╳';
end
else if sValue = 'S' then
begin
Result := '特殊用箱-■';
end
else if sValue = 'V' then
begin
Result := 'VIP 用箱-★';
end
else if sValue = 'A' then
begin
Result := '指定用箱-※';
end;
end
else if iOperType = CONST_OPER_BAYORDER then
begin
if sValue = 'MIN' then
begin
Result := '正序';
end
else if sValue = 'MAX' then
begin
Result := '反序';
end;
end
else if iOperType = CONST_OPER_LOCORDER then
begin
if sValue = 'MIN' then
begin
Result := '正序';
end
else if sValue = 'MAX' then
begin
Result := '反序';
end;
end
else if iOperType = CONST_OPER_TASKTYPE then
begin
if sValue = 'ST' then
begin
Result := '归垛';
end
else if sValue = 'LT' then
begin
Result := '提箱';
end
else if sValue = 'SR' then
begin
Result := '修箱摆箱';
end
else if sValue = 'MV' then
begin
Result := '按指令垛位间移箱';
end
else if sValue = 'FT' then
begin
Result := '重箱摆箱';
end
else if sValue = 'FL' then
begin
Result := '重箱提箱';
end
else if sValue = 'RT' then
begin
Result := '修箱拾箱';
end
else if sValue = 'MC' then
begin
Result := '理货仓库移箱';
end;
end
else if iOperType = CONST_OPER_CNTRSTATUS then
begin
if sValue = 'AC' then //AV
begin
Result := '好箱';
end
else if sValue = 'B' then // DE
begin
Result := '法检';
end
else if sValue = 'US' then // US
begin
Result := '已使用';
end
else if sValue = 'D' then // DM
begin
Result := '坏箱';
end;
end
else if iOperType = CONST_OPER_YESNO then
begin
if sValue = 'Y' then
begin
Result := '是';
end
else if sValue = 'N' then
begin
Result := '否';
end;
end
else if iOperType = CONST_OPER_IE then
begin
if sValue = 'I' then
begin
Result := '进口';
end
else if sValue = 'E' then
begin
Result := '出口';
end;
end
else if iOperType = CONST_OPER_CNTRSTATUS then
begin
if sValue = 'FC' then
begin
Result := '食品箱';
end
else if sValue = 'NE' then
begin
Result := '普通新箱';
end
else if sValue = 'AV' then
begin
Result := '普通好箱';
end
else if sValue = 'DC' then
begin
Result := '机组坏';
end
else if sValue = 'DN' then
begin
Result := '冻柜新箱';
end
else if sValue = 'DE' then
begin
Result := '待检箱';
end
else if sValue = 'WR' then
begin
Result := '水洗及维修';
end
else if sValue = 'PW' then
begin
Result := '纯水洗';
end
else if sValue = 'DL' then
begin
Result := '可以维修';
end
else if sValue = 'WA' then
begin
Result := '待批';
end
else if sValue = 'CM' then
begin
Result := '已批';
end;
end;
except
Result := '';
cf_sysLog('根据输入的值设置费用列表显示值函数过程失败! 错误位置:[' +
'function cf_operGetValueDisplayText(const sValue:string;iOperType:Integer):string;]');
end;
end;
function cf_operGetDisplayTextValue(const sDisplayText: string;
iOperType: Integer): string;
var
sResult: string;
begin
sResult := '';
if Trim(sDisplayText) = '' then
begin
Result := sResult;
Exit;
end;
// 结算方式
if iOperType = CONST_OPER_CHARGETYPE then
begin
if sDisplayText = '现结' then
begin
sResult := 'C';
end
else if sDisplayText = '月结' then
begin
sResult := 'M';
end;
end
else if iOperType = CONST_OPER_CURRENCYCODE then
begin
if sDisplayText = '人民币' then
begin
sResult := 'RMB';
end
else if sDisplayText = '美元' then
begin
sResult := 'USD';
end
else if sDisplayText = '欧元' then
begin
sResult := 'EUR';
end;
end
else if iOperType = CONST_OPER_HVLOCATION then
begin
if sDisplayText = '东' then
begin
sResult := 'E';
end
else if sDisplayText = '南' then
begin
sResult := 'S';
end
else if sDisplayText = '西' then
begin
sResult := 'W';
end
else if sDisplayText = '北' then
begin
sResult := 'N';
end;
end
else if iOperType = CONST_OPER_CNTREF then
begin
if sDisplayText = '空' then
begin
sResult := 'E';
end
else if sDisplayText = '重' then
begin
sResult := 'F';
end;
end
else if iOperType = CONST_OPER_ASSIGNTYPE then
begin
if sDisplayText = '指定' then
begin
sResult := 'P';
end
else if sDisplayText = '商检' then
begin
sResult := 'I';
end
else if sDisplayText = '指定商检' then
begin
sResult := 'PI';
end;
end
else if iOperType = CONST_OPER_ASSIGNINOUT then
begin
if sDisplayText = '理货' then
begin
sResult := 'I';
end
else if sDisplayText = '提箱' then
begin
sResult := 'O';
end
else if sDisplayText = '待定' then
begin
sResult := 'P';
end;
end
else if iOperType = CONST_OPER_COLORTYPE then
begin
if sDisplayText = '动态' then
begin
sResult := 'COLORDYNAMIC';
end
else if sDisplayText = '经营人' then
begin
sResult := 'COLOROPTR';
end
else if sDisplayText = '层高' then
begin
sResult := 'COLORTIER';
end
else if sDisplayText = '航次' then
begin
sResult := 'COLORVOYAGE';
end;
end
else if iOperType = CONST_OPER_CNTRFLAG then
begin
if sDisplayText = '提箱预定-▲' then
begin
sResult := 'L';
end
else if sDisplayText = '理货预定-◆' then
begin
sResult := 'M';
end
else if sDisplayText = '中控移箱-↗' then
begin
sResult := 'P';
end
else if sDisplayText = '禁止用箱-╳' then
begin
sResult := 'H';
end
else if sDisplayText = '特殊用箱-■' then
begin
sResult := 'S';
end
else if sDisplayText = 'VIP 用箱-★' then
begin
sResult := 'V';
end
else if sDisplayText = '指定用箱-※' then
begin
sResult := 'A';
end;
end
else if iOperType = CONST_OPER_BAYORDER then
begin
if sDisplayText = '正序' then
begin
sResult := 'MIN';
end
else if sDisplayText = '反序' then
begin
sResult := 'MAX';
end;
end
else if iOperType = CONST_OPER_LOCORDER then
begin
if sDisplayText = '正序' then
begin
sResult := 'MIN';
end
else if sDisplayText = '反序' then
begin
sResult := 'MAX';
end;
end
else if iOperType = CONST_OPER_TASKTYPE then
begin
if sDisplayText = '归垛' then
begin
sResult := 'ST';
end
else if sDisplayText = '提箱' then
begin
sResult := 'LT';
end
else if sDisplayText = '修箱摆箱' then
begin
sResult := 'SR';
end
else if sDisplayText = '按指令垛位间移箱' then
begin
sResult := 'MV';
end
else if sDisplayText = '重箱摆箱' then
begin
sResult := 'FT';
end
else if sDisplayText = '重箱提箱' then
begin
sResult := 'FL';
end
else if sDisplayText = '修箱拾箱' then
begin
sResult := 'RT';
end
else if sDisplayText = '理货仓库移箱' then
begin
sResult := 'MC';
end;
end
else if iOperType = CONST_OPER_CNTRSTATUS then
begin
if sDisplayText = '好箱' then
begin
sResult := 'AC'; // AV
end
else if sDisplayText = '商检' then
begin
sResult := 'B'; //DE
end
else if sDisplayText = '已使用' then
begin
sResult := 'US';//US
end
else if sDisplayText = '坏箱' then
begin
sResult := 'D';//DM
end;
end
else if iOperType = CONST_OPER_YESNO then
begin
if sDisplayText = '是' then
begin
sResult := 'Y';
end
else if sDisplayText = '否' then
begin
sResult := 'N';
end;
end
else if iOperType = CONST_OPER_IE then
begin
if sDisplayText = '进口' then
begin
sResult := 'I';
end
else if sDisplayText = '出口' then
begin
sResult := 'E';
end;
end
else if iOperType = CONST_OPER_CNTRSTATUSDESC then
begin
if sDisplayText = '食品箱' then
begin
sResult := 'FC';
end
else if sDisplayText = '普通新箱' then
begin
sResult := 'NE';
end
else if sDisplayText = '普通好箱' then
begin
sResult := 'AV';
end
else if sDisplayText = '机组坏' then
begin
sResult := 'DC';
end
else if sDisplayText = '冻柜新箱' then
begin
sResult := 'DN';
end
else if sDisplayText = '待检箱' then
begin
sResult := 'DE';
end
else if sDisplayText = '水洗及维修' then
begin
sResult := 'WR';
end
else if sDisplayText = '纯水洗' then
begin
sResult := 'PW';
end
else if sDisplayText = '可以维修' then
begin
sResult := 'DL';
end
else if sDisplayText = '待批' then
begin
sResult := 'WA';
end
else if sDisplayText = '已批' then
begin
sResult := 'CM';
end;
end;
Result := sResult;
end;
// ******************************************************************************
// 函数功能: 根据输入的值设置费用列表显示值。
// 函数名称: cf_operChargeTypeSetComboboxValue
// 函数参数: 无
// 返回值: 是否设置成功。
// ******************************************************************************
function cf_operGetComboboxValue(var oComboBox: TComboBox;
iOperType: Integer): string;
var
sResult: string;
begin
sResult := '';
try
if oComboBox = nil then
Exit;
// 结算方式
if iOperType = CONST_OPER_CHARGETYPE then
begin
if oComboBox.Items[oComboBox.ItemIndex] = '现结' then
begin
sResult := 'C';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '月结' then
begin
sResult := 'M';
end;
end
else if iOperType = CONST_OPER_CURRENCYCODE then
begin
if oComboBox.Items[oComboBox.ItemIndex] = '人民币' then
begin
sResult := 'RMB';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '美元' then
begin
sResult := 'USD';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '欧元' then
begin
sResult := 'EUR';
end;
end
else if iOperType = CONST_OPER_HVLOCATION then
begin
if oComboBox.Items[oComboBox.ItemIndex] = '东' then
begin
sResult := 'E';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '南' then
begin
sResult := 'S';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '西' then
begin
sResult := 'W';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '北' then
begin
sResult := 'N';
end;
end
else if iOperType = CONST_OPER_CNTREF then
begin
if oComboBox.Items[oComboBox.ItemIndex] = '空' then
begin
sResult := 'E';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '重' then
begin
sResult := 'F';
end;
end
else if iOperType = CONST_OPER_ASSIGNTYPE then
begin
if oComboBox.Items[oComboBox.ItemIndex] = '指定' then
begin
sResult := 'P';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '商检' then
begin
sResult := 'I';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '指定商检' then
begin
sResult := 'PI';
end;
end
else if iOperType = CONST_OPER_ASSIGNINOUT then
begin
if oComboBox.Items[oComboBox.ItemIndex] = '理货' then
begin
sResult := 'I';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '提箱' then
begin
sResult := 'O';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '待定' then
begin
sResult := 'P';
end;
end
else if iOperType = CONST_OPER_COLORTYPE then
begin
if oComboBox.Items[oComboBox.ItemIndex] = '动态' then
begin
sResult := 'COLORDYNAMIC';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '经营人' then
begin
sResult := 'COLOROPTR';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '层高' then
begin
sResult := 'COLORTIER';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '空重' then
begin
sResult := 'COLOREF';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '好坏箱' then
begin
sResult := 'COLORGE';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '箱型' then
begin
sResult := 'COLORTYPE';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '尺寸' then
begin
sResult := 'COLORSIZE';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '冻柜' then
begin
sResult := 'COLORREF';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '航次' then
begin
sResult := 'COLORVOYAGE';
end;
end
else if iOperType = CONST_OPER_CNTRFLAG then
begin
if oComboBox.Items[oComboBox.ItemIndex] = '提箱预定-▲' then
begin
sResult := 'L';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '理货预定-◆' then
begin
sResult := 'M';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '中控移箱-↗' then
begin
sResult := 'P';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '禁止用箱-╳' then
begin
sResult := 'H';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '特殊用箱-■' then
begin
sResult := 'S';
end
else if oComboBox.Items[oComboBox.ItemIndex] = 'VIP 用箱-★' then
begin
sResult := 'V';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '指定用箱-※' then
begin
sResult := 'A';
end;
end
else if iOperType = CONST_OPER_BAYORDER then
begin
if oComboBox.Items[oComboBox.ItemIndex] = '正序' then
begin
sResult := 'MIN';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '反序' then
begin
sResult := 'MAX';
end;
end
else if iOperType = CONST_OPER_LOCORDER then
begin
if oComboBox.Items[oComboBox.ItemIndex] = '正序' then
begin
sResult := 'MIN';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '反序' then
begin
sResult := 'MAX';
end;
end
else if iOperType = CONST_OPER_TASKTYPE then
begin
if oComboBox.Items[oComboBox.ItemIndex] = '归垛' then
begin
sResult := 'ST';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '提箱' then
begin
sResult := 'LT';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '修箱摆箱' then
begin
sResult := 'SR';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '按指令垛位间移箱' then
begin
sResult := 'MV';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '重箱摆箱' then
begin
sResult := 'FT';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '重箱提箱' then
begin
sResult := 'FL';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '修箱拾箱' then
begin
sResult := 'RT';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '理货仓库移箱' then
begin
sResult := 'MC';
end;
end
else if iOperType = CONST_OPER_CNTRSTATUS then
begin
if oComboBox.Items[oComboBox.ItemIndex] = '好箱' then
begin
sResult := 'AC'; //AV
end
else if oComboBox.Items[oComboBox.ItemIndex] = '法检' then // 未做PTI
begin
sResult := 'B'; //AV
end
else if oComboBox.Items[oComboBox.ItemIndex] = '已使用' then
begin
sResult := 'US'; //AV
end
else if oComboBox.Items[oComboBox.ItemIndex] = '坏箱' then
begin
sResult := 'D'; //AV
end;
end
else if iOperType = CONST_OPER_IE then
begin
if oComboBox.Items[oComboBox.ItemIndex] = '进口' then
begin
sResult := 'I';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '出口' then
begin
sResult := 'E';
end;
end
else if iOperType = CONST_OPER_YESNO then
begin
if oComboBox.Items[oComboBox.ItemIndex] = '是' then
begin
sResult := 'Y';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '否' then
begin
sResult := 'N';
end;
end
else if iOperType = CONST_OPER_CNTRSTATUSDESC then
begin
if oComboBox.Items[oComboBox.ItemIndex] = '食品箱' then
begin
sResult := 'FC';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '普通新箱' then
begin
sResult := 'NE';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '普通好箱' then
begin
sResult := 'AV';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '机组坏' then
begin
sResult := 'DC';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '冻柜新箱' then
begin
sResult := 'DN';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '待检箱' then
begin
sResult := 'DE';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '水洗及维修' then
begin
sResult := 'WR';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '纯水洗' then
begin
sResult := 'PW';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '可以维修' then
begin
sResult := 'DL';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '待批' then
begin
sResult := 'WA';
end
else if oComboBox.Items[oComboBox.ItemIndex] = '已批' then
begin
sResult := 'CM';
end;
end;
Result := sResult;
except
Result := '';
cf_sysLog('根据输入的值设置列表显示值函数过程失败! 错误位置:[' +
'function cf_operGetComboboxValue(var oCombobox: TComboBox;iOperType: Integer): string;]');
end;
end;
// ******************************************************************************
// 函数功能: 清空指定控件的信息。
// 函数名称: cf_ctrlSetEmpty
// 函数参数: 无
// 返回值: 是否设置成功。
// ******************************************************************************
function cf_ctrlSetEmpty(const oControls: array of TObject): Boolean;
var
oControl: TObject;
iCtrl: Integer;
begin
Result := false;
try
for iCtrl := 0 to High(oControls) do
begin
oControl := oControls[iCtrl];
if (oControl is TEdit) then
begin (oControl as TEdit)
.Text := '';
end
else if (oControl is TComboBox) then
begin (oControl as TComboBox)
.Text := ''; (oControl as TComboBox)
.ItemIndex := -1;
end
else if (oControl is TMemo) then
begin (oControl as TMemo)
.Text := '';
end
else if (oControl is TListBox) then
begin (oControl as TListBox)
.ItemIndex := -1;
end
else if (oControl is TADOCombobox) then
begin (oControl as TADOCombobox)
.Text := '';
end
else if (oControl is TExCombobox) then
begin (oControl as TExCombobox)
.Text := '';
end
else if (oControl is TCheckBox) then
begin (oControl as TCheckBox)
.Checked := false;
end
else if (oControl is TDateTimePicker) then
begin (oControl as TDateTimePicker)
.DateTime := CONST_SYS_NULLDATETIME;
end
else if (oControl is TDBDateTimeEditEh) then
begin (oControl as TDBDateTimeEditEh)
.Text := '';
end
end;
except
Result := false;
cf_sysLog('清空指定控件的信息函数过程失败! 错误位置:[' +
'function cf_ctrlSetEmpty(const oControls: array of TObject): Boolean;]');
Exit;
end;
Result := true;
end;
// ******************************************************************************
// 函数功能: 判断指定的控件内容是否为空。
// 函数名称: cf_ctrlCheckEmpty
// 函数参数: 无
// 返回值: 指定的控件集是否其中内容有空的。
// ******************************************************************************
function cf_ctrlHasEmptyValues(const oControls: array of TObject;
hHandle: HWND = 0): Boolean;
var
oControl: TObject;
iCtrl: Integer;
begin
Result := true;
try
for iCtrl := 0 to High(oControls) do
begin
oControl := oControls[iCtrl];
if (oControl is TEdit) then
begin
if Trim((oControl as TEdit).Text) = EmptyStr then
begin
cf_sysMsgBox((oControl as TEdit).Hint + '不能为空!',
MB_OK + MB_ICONERROR, hHandle); (oControl as TEdit)
.SetFocus;
Exit;
end;
end
else if (oControl is TComboBox) then
begin
if (oControl as TComboBox).Style=csDropDownList then
begin
if (oControl as TComboBox).ItemIndex = -1 then
begin
cf_sysMsgBox((oControl as TComboBox).Hint + '不能为空!',
MB_OK + MB_ICONERROR, hHandle); (oControl as TComboBox)
.SetFocus;
Exit;
end;
end else if (oControl as TComboBox).Style=csDropDown then
begin
if Trim((oControl as TComboBox).Text)='' then
begin
cf_sysMsgBox((oControl as TComboBox).Hint + '不能为空!',
MB_OK + MB_ICONERROR, hHandle); (oControl as TComboBox)
.SetFocus;
Exit;
end;
end
end
else if (oControl is TMemo) then
begin
if Trim((oControl as TMemo).Text) = EmptyStr then
begin
cf_sysMsgBox((oControl as TMemo).Hint + '不能为空!',
MB_OK + MB_ICONERROR, hHandle); (oControl as TMemo)
.SetFocus;
Exit;
end;
end
else if (oControl is TListBox) then
begin
if (oControl as TListBox).ItemIndex = -1 then
begin
cf_sysMsgBox((oControl as TListBox).Hint + '不能为空,请选择！',
MB_OK + MB_ICONERROR, hHandle); (oControl as TListBox)
.SetFocus;
Exit;
end;
end
else if (oControl is TADOCombobox) then
begin
if Trim((oControl as TADOCombobox).Text) = EmptyStr then
begin
cf_sysMsgBox((oControl as TADOCombobox).Hint + '不能为空!',
MB_OK + MB_ICONERROR, hHandle); (oControl as TADOCombobox)
.SetFocus;
Exit;
end;
end
else if (oControl is TExCombobox) then
begin
if Trim((oControl as TExCombobox).Text) = EmptyStr then
begin
cf_sysMsgBox((oControl as TExCombobox).Hint + '不能为空!',
MB_OK + MB_ICONERROR, hHandle); (oControl as TExCombobox)
.SetFocus;
Exit;
end;
end
else if (oControl is TDateTimePicker) then
begin
if Double((oControl as TDateTimePicker).DateTime)
= CONST_SYS_NULLDATETIME then
begin
cf_sysMsgBox((oControl as TDateTimePicker).Hint + '不能为空!',
MB_OK + MB_ICONERROR, hHandle); (oControl as TDateTimePicker)
.SetFocus;
Exit;
end;
end
else if (oControl is TDBDateTimeEditEh) then
begin
if vartostrDef((oControl as TDBDateTimeEditEh).Value, '')
= EmptyStr then
begin
cf_sysMsgBox((oControl as TDBDateTimeEditEh).Hint + '不能为空!',
MB_OK + MB_ICONERROR, hHandle); (oControl as TDBDateTimeEditEh)
.SetFocus;
Exit;
end;
end;
end;
Result := false;
except
Result := true;
cf_sysLog('判断指定的控件内容是否为空函数过程失败! 错误位置:[' +
'function cf_ctrlHasEmptyValues(const oControls: array of TObject;hHandle: HWND = 0): Boolean;]');
Exit;
end;
Result := false;
end;
// ******************************************************************************
// 函数功能: 判断指定的控件内容是否为指定的数据类型
// 函数名称: cf_ctrlValueIsType
// 函数参数: 无
// 返回值: 指定的控件集中是否其中有不是指定类型的。
// ******************************************************************************
function cf_ctrlValueIsType(const oControls: array of TObject;
oDealType: TDealDataType = ddtUInt; hHandle: HWND = 0): Boolean;
var
oControl: TObject;
iCtrl: Integer;
begin
Result := false;
try
for iCtrl := 0 to High(oControls) do
begin
oControl := oControls[iCtrl];
if (oControl is TEdit) then
begin
if Trim((oControl as TEdit).Text) <> EmptyStr then
begin
case oDealType of
ddtInteger:
begin
if not cf_valStrIsInt((oControl as TEdit).Text) then
begin
cf_sysMsgBox((oControl as TEdit).Hint + '必须为整数型数字！',
MB_OK + MB_ICONERROR, hHandle); (oControl as TEdit)
.SetFocus;
Exit;
end;
end;
ddtUInt:
begin
if not cf_valStrIsUInt((oControl as TEdit).Text) then
begin
cf_sysMsgBox((oControl as TEdit).Hint + '必须为大于零的整数型数！',
MB_OK + MB_ICONERROR, hHandle); (oControl as TEdit)
.SetFocus;
Exit;
end;
end;
ddtFloat:
begin
if not cf_valStrIsFloat((oControl as TEdit).Text) then
begin
cf_sysMsgBox((oControl as TEdit).Hint + '必须为浮点型数字！',
MB_OK + MB_ICONERROR, hHandle); (oControl as TEdit)
.SetFocus;
Exit;
end;
end;
ddtUFloat:
begin
if not cf_valStrIsUFloat((oControl as TEdit).Text) then
begin
cf_sysMsgBox((oControl as TEdit).Hint + '必须为大于零的浮点型数字！',
MB_OK + MB_ICONERROR, hHandle); (oControl as TEdit)
.SetFocus;
Exit;
end;
end;
ddtDateTime:
begin
if not cf_valStrIsDateTime((oControl as TEdit).Text) then
begin
cf_sysMsgBox((oControl as TEdit).Hint + '必须为日期时间型！',
MB_OK + MB_ICONERROR, hHandle); (oControl as TEdit)
.SetFocus;
Exit;
end;
end;
ddtDate:
begin
if not cf_valStrIsDate((oControl as TEdit).Text) then
begin
cf_sysMsgBox((oControl as TEdit).Hint + '必须为日期型！',
MB_OK + MB_ICONERROR, hHandle); (oControl as TEdit)
.SetFocus;
Exit;
end;
end;
ddtTime:
begin
if not cf_valStrIsTime((oControl as TEdit).Text) then
begin
cf_sysMsgBox((oControl as TEdit).Hint + '必须为时间型！',
MB_OK + MB_ICONERROR, hHandle); (oControl as TEdit)
.SetFocus;
Exit;
end;
end;
ddtBoolean:
begin
if not cf_valStrIsBool((oControl as TEdit).Text) then
begin
cf_sysMsgBox((oControl as TEdit).Hint + '必须为布尔型！',
MB_OK + MB_ICONERROR, hHandle); (oControl as TEdit)
.SetFocus;
Exit;
end;
end;
end;
end;
end
else if (oControl is TComboBox) then
begin
if (oControl as TComboBox).ItemIndex <> -1 then
begin
case oDealType of
ddtInteger:
begin
if not cf_valStrIsInt((oControl as TComboBox).Text) then
begin
cf_sysMsgBox((oControl as TComboBox).Hint + '必须为整数型数字！',
MB_OK + MB_ICONERROR, hHandle); (oControl as TComboBox)
.SetFocus;
Exit;
end;
end;
ddtUInt:
begin
if not cf_valStrIsUInt((oControl as TComboBox).Text) then
begin
cf_sysMsgBox
((oControl as TComboBox).Hint + '必须为大于零的整数型数！',
MB_OK + MB_ICONERROR, hHandle); (oControl as TComboBox)
.SetFocus;
Exit;
end;
end;
ddtFloat:
begin
if not cf_valStrIsFloat((oControl as TComboBox).Text) then
begin
cf_sysMsgBox((oControl as TComboBox).Hint + '必须为浮点型数字！',
MB_OK + MB_ICONERROR, hHandle); (oControl as TComboBox)
.SetFocus;
Exit;
end;
end;
ddtUFloat:
begin
if not cf_valStrIsUFloat((oControl as TComboBox).Text) then
begin
cf_sysMsgBox((oControl as TComboBox)
.Hint + '必须为大于零的浮点型数字！', MB_OK + MB_ICONERROR,
hHandle); (oControl as TComboBox)
.SetFocus;
Exit;
end;
end;
ddtDateTime:
begin
if not cf_valStrIsDateTime((oControl as TComboBox).Text)
then
begin
cf_sysMsgBox((oControl as TComboBox).Hint + '必须为日期时间型！',
MB_OK + MB_ICONERROR, hHandle); (oControl as TComboBox)
.SetFocus;
Exit;
end;
end;
ddtDate:
begin
if not cf_valStrIsDate((oControl as TComboBox).Text) then
begin
cf_sysMsgBox((oControl as TComboBox).Hint + '必须为日期型！',
MB_OK + MB_ICONERROR, hHandle); (oControl as TComboBox)
.SetFocus;
Exit;
end;
end;
ddtTime:
begin
if not cf_valStrIsTime((oControl as TComboBox).Text) then
begin
cf_sysMsgBox((oControl as TComboBox).Hint + '必须为时间型！',
MB_OK + MB_ICONERROR, hHandle); (oControl as TComboBox)
.SetFocus;
Exit;
end;
end;
ddtBoolean:
begin
if not cf_valStrIsBool((oControl as TComboBox).Text) then
begin
cf_sysMsgBox((oControl as TComboBox).Hint + '必须为布尔型！',
MB_OK + MB_ICONERROR, hHandle); (oControl as TComboBox)
.SetFocus;
Exit;
end;
end;
end;
end;
end
else if (oControl is TMemo) then
begin
if Trim((oControl as TMemo).Text) <> EmptyStr then
begin
case oDealType of
ddtInteger:
begin
if not cf_valStrIsInt((oControl as TMemo).Text) then
begin
cf_sysMsgBox((oControl as TMemo).Hint + '必须为整数型数字！',
MB_OK + MB_ICONERROR, hHandle); (oControl as TMemo)
.SetFocus;
Exit;
end;
end;
ddtUInt:
begin
if not cf_valStrIsUInt((oControl as TMemo).Text) then
begin
cf_sysMsgBox((oControl as TMemo).Hint + '必须为大于零的整数型数！',
MB_OK + MB_ICONERROR, hHandle); (oControl as TMemo)
.SetFocus;
Exit;
end;
end;
ddtFloat:
begin
if not cf_valStrIsFloat((oControl as TMemo).Text) then
begin
cf_sysMsgBox((oControl as TMemo).Hint + '必须为浮点型数字！',
MB_OK + MB_ICONERROR, hHandle); (oControl as TMemo)
.SetFocus;
Exit;
end;
end;
ddtUFloat:
begin
if not cf_valStrIsUFloat((oControl as TMemo).Text) then
begin
cf_sysMsgBox((oControl as TMemo).Hint + '必须为大于零的浮点型数字！',
MB_OK + MB_ICONERROR, hHandle); (oControl as TMemo)
.SetFocus;
Exit;
end;
end;
ddtDateTime:
begin
if not cf_valStrIsDateTime((oControl as TMemo).Text) then
begin
cf_sysMsgBox((oControl as TMemo).Hint + '必须为日期时间型！',
MB_OK + MB_ICONERROR, hHandle); (oControl as TMemo)
.SetFocus;
Exit;
end;
end;
ddtDate:
begin
if not cf_valStrIsDate((oControl as TMemo).Text) then
begin
cf_sysMsgBox((oControl as TMemo).Hint + '必须为日期型！',
MB_OK + MB_ICONERROR, hHandle); (oControl as TMemo)
.SetFocus;
Exit;
end;
end;
ddtTime:
begin
if not cf_valStrIsTime((oControl as TMemo).Text) then
begin
cf_sysMsgBox((oControl as TMemo).Hint + '必须为时间型！',
MB_OK + MB_ICONERROR, hHandle); (oControl as TMemo)
.SetFocus;
Exit;
end;
end;
ddtBoolean:
begin
if not cf_valStrIsBool((oControl as TMemo).Text) then
begin
cf_sysMsgBox((oControl as TMemo).Hint + '必须为布尔型！',
MB_OK + MB_ICONERROR, hHandle); (oControl as TMemo)
.SetFocus;
Exit;
end;
end;
end;
end
else if (oControl is TADOCombobox) then
begin
if Trim((oControl as TADOCombobox).Text) <> EmptyStr then
begin
case oDealType of
ddtInteger:
begin
if not cf_valStrIsInt((oControl as TADOCombobox).Text)
then
begin
cf_sysMsgBox((oControl as TADOCombobox)
.Hint + '必须为整数型数字！', MB_OK + MB_ICONERROR,
hHandle); (oControl as TADOCombobox)
.SetFocus;
Exit;
end;
end;
ddtUInt:
begin
if not cf_valStrIsUInt((oControl as TADOCombobox).Text)
then
begin
cf_sysMsgBox((oControl as TADOCombobox)
.Hint + '必须为大于零的整数型数！', MB_OK + MB_ICONERROR,
hHandle); (oControl as TADOCombobox)
.SetFocus;
Exit;
end;
end;
ddtFloat:
begin
if not cf_valStrIsFloat((oControl as TADOCombobox).Text)
then
begin
cf_sysMsgBox((oControl as TADOCombobox)
.Hint + '必须为浮点型数字！', MB_OK + MB_ICONERROR,
hHandle); (oControl as TADOCombobox)
.SetFocus;
Exit;
end;
end;
ddtUFloat:
begin
if not cf_valStrIsUFloat((oControl as TADOCombobox).Text)
then
begin
cf_sysMsgBox((oControl as TADOCombobox)
.Hint + '必须为大于零的浮点型数字！', MB_OK + MB_ICONERROR,
hHandle); (oControl as TADOCombobox)
.SetFocus;
Exit;
end;
end;
ddtDateTime:
begin
if not cf_valStrIsDateTime
((oControl as TADOCombobox).Text) then
begin
cf_sysMsgBox((oControl as TADOCombobox)
.Hint + '必须为日期时间型！', MB_OK + MB_ICONERROR,
hHandle); (oControl as TADOCombobox)
.SetFocus;
Exit;
end;
end;
ddtDate:
begin
if not cf_valStrIsDate((oControl as TADOCombobox).Text)
then
begin
cf_sysMsgBox
((oControl as TADOCombobox).Hint + '必须为日期型！',
MB_OK + MB_ICONERROR, hHandle);
(oControl as TADOCombobox)
.SetFocus;
Exit;
end;
end;
ddtTime:
begin
if not cf_valStrIsTime((oControl as TADOCombobox).Text)
then
begin
cf_sysMsgBox
((oControl as TADOCombobox).Hint + '必须为时间型！',
MB_OK + MB_ICONERROR, hHandle);
(oControl as TADOCombobox)
.SetFocus;
Exit;
end;
end;
ddtBoolean:
begin
if not cf_valStrIsBool((oControl as TADOCombobox).Text)
then
begin
cf_sysMsgBox
((oControl as TADOCombobox).Hint + '必须为布尔型！',
MB_OK + MB_ICONERROR, hHandle);
(oControl as TADOCombobox)
.SetFocus;
Exit;
end;
end;
end;
end;
end
else if (oControl is TExCombobox) then
begin
if Trim((oControl as TExCombobox).Text) <> EmptyStr then
begin
case oDealType of
ddtInteger:
begin
if not cf_valStrIsInt((oControl as TExCombobox).Text) then
begin
cf_sysMsgBox((oControl as TExCombobox)
.Hint + '必须为整数型数字！', MB_OK + MB_ICONERROR,
hHandle); (oControl as TExCombobox)
.SetFocus;
Exit;
end;
end;
ddtUInt:
begin
if not cf_valStrIsUInt((oControl as TExCombobox).Text)
then
begin
cf_sysMsgBox((oControl as TExCombobox)
.Hint + '必须为大于零的整数型数！', MB_OK + MB_ICONERROR,
hHandle); (oControl as TExCombobox)
.SetFocus;
Exit;
end;
end;
ddtFloat:
begin
if not cf_valStrIsFloat((oControl as TExCombobox).Text)
then
begin
cf_sysMsgBox((oControl as TExCombobox)
.Hint + '必须为浮点型数字！', MB_OK + MB_ICONERROR,
hHandle); (oControl as TExCombobox)
.SetFocus;
Exit;
end;
end;
ddtUFloat:
begin
if not cf_valStrIsUFloat((oControl as TExCombobox).Text)
then
begin
cf_sysMsgBox((oControl as TExCombobox)
.Hint + '必须为大于零的浮点型数字！', MB_OK + MB_ICONERROR,
hHandle); (oControl as TExCombobox)
.SetFocus;
Exit;
end;
end;
ddtDateTime:
begin
if not cf_valStrIsDateTime
((oControl as TExCombobox).Text) then
begin
cf_sysMsgBox((oControl as TExCombobox)
.Hint + '必须为日期时间型！', MB_OK + MB_ICONERROR,
hHandle); (oControl as TExCombobox)
.SetFocus;
Exit;
end;
end;
ddtDate:
begin
if not cf_valStrIsDate((oControl as TExCombobox).Text)
then
begin
cf_sysMsgBox
((oControl as TExCombobox).Hint + '必须为日期型！',
MB_OK + MB_ICONERROR, hHandle);
(oControl as TExCombobox)
.SetFocus;
Exit;
end;
end;
ddtTime:
begin
if not cf_valStrIsTime((oControl as TExCombobox).Text)
then
begin
cf_sysMsgBox
((oControl as TExCombobox).Hint + '必须为时间型！',
MB_OK + MB_ICONERROR, hHandle);
(oControl as TExCombobox)
.SetFocus;
Exit;
end;
end;
ddtBoolean:
begin
if not cf_valStrIsBool((oControl as TExCombobox).Text)
then
begin
cf_sysMsgBox
((oControl as TExCombobox).Hint + '必须为布尔型！',
MB_OK + MB_ICONERROR, hHandle);
(oControl as TExCombobox)
.SetFocus;
Exit;
end;
end;
end;
end;
end;
end;
end;
Result := true;
except
Result := false;
cf_sysLog('判断指定的控件内容是否为指定的数据类型函数过程失败! 错误位置:[' +
'function cf_ctrlValueIsType(const oControls: array of TObject; ' +
'oDealType: TDealDataType = ddtUInt; hHandle: HWND = 0): Boolean;]'
);
Exit;
end;
Result := true;
end;
// ******************************************************************************
// 过程功能: 清空全局数据传输变量记录结构体信息.
// 过程名称: cp_valClearListCommVar
// 过程参数: 无
// 返回值: 无
// ******************************************************************************
procedure cp_valClearListCommVar;
begin
try
with goComVar do
begin
s0 := '';
s1 := '';
s2 := '';
s3 := '';
s4 := '';
s5 := '';
s6 := '';
s7 := '';
s8 := '';
s9 := '';
s10 := '';
s11 := '';
s12 := '';
s13 := '';
s14 := '';
s15 := '';
s16 := '';
s17 := '';
s18 := '';
s19 := '';
s20 := '';
s21 := '';
s22 := '';
s23 := '';
s24 := '';
s25 := '';
s26 := '';
s27 := '';
s28 := '';
s29 := '';
s30 := '';
s31 := '';
s32 := '';
s33 := '';
s34 := '';
s35 := '';
s36 := '';
s37 := '';
s38 := '';
s39 := '';
s40 := '';
s41 := '';
s42 := '';
s43 := '';
s44 := '';
s45 := '';
s46 := '';
s47 := '';
s48 := '';
s49 := '';
s50 := '';
s51 := '';
s52 := '';
s53 := '';
s54 := '';
s55 := '';
s56 := '';
s57 := '';
s58 := '';
s59 := '';
s60 := '';
s61 := '';
s62 := '';
s63 := '';
s64 := '';
s65 := '';
s66 := '';
s67 := '';
s68 := '';
s69 := '';
s70 := '';
s71 := '';
s72 := '';
s73 := '';
s74 := '';
s75 := '';
s76 := '';
s77 := '';
s78 := '';
s79 := '';
s80 := '';
s81 := '';
s82 := '';
s83 := '';
s84 := '';
s85 := '';
s86 := '';
s87 := '';
s88 := '';
s89 := '';
s90 := '';
s91 := '';
s92 := '';
s93 := '';
s94 := '';
s95 := '';
s96 := '';
s97 := '';
s98 := '';
s99 := '';
s100 := '';
s101 := '';
s102 := '';
s103 := '';
s104 := '';
s105 := '';
s106 := '';
s107 := '';
s108 := '';
s109 := '';
s110 := '';
s111 := '';
s112 := '';
s113 := '';
s114 := '';
s115 := '';
s116 := '';
s117 := '';
s118 := '';
s119 := '';
s120 := '';
s121 := '';
s122 := '';
s123 := '';
s124 := '';
s125 := '';
s126 := '';
s127 := '';
s128 := '';
s129 := '';
s130 := '';
end;
except
cf_sysLog('清空全局数据传输变量记录结构体信息函数过程失败! 错误位置:[' +
'procedure cp_valClearListCommVar;]');
end;
end;
// ******************************************************************************
// 过程功能: 显示关于对话框
// 过程名称: cp_sysAppAbout
// 过程参数: 无
// 返回值: 无
// ******************************************************************************
procedure cp_sysAppAbout;
begin
try
ShellAbout(Application.Handle, PWideChar(Application.MainForm.Caption),
'', Application.Icon.Handle);
except
cf_sysLog('显示关于对话框函数过程失败! 错误位置:[' + 'procedure cp_sysAppAbout;]');
end;
end;
// ******************************************************************************
// 过程功能: 禁止反编译
// 过程名称: cp_sysAntiDeDe
// 过程参数: 无
// 返回值: 无
// ******************************************************************************
procedure cp_sysAntiDeDe();
var
DeDeHandle: THandle;
i: Integer;
begin
try
DeDeHandle := FindWindow(nil, Chr($64) + Chr($65) + Chr($64) + Chr($65)
);
if DeDeHandle <> 0 then
begin
for i := 1 to 4500 do
SendMessage(DeDeHandle, WM_CLOSE, 0, 0);
end;
except
cf_sysLog('禁止反编译函数过程失败! 错误位置:[' + 'procedure cp_sysAntiDeDe;]');
end;
end;
// ******************************************************************************
// 过程功能: 隐藏应用程序进程.
// 过程名称: cp_HideApp
// 过程参数: 无
// 返回值: 无
// ******************************************************************************
procedure cp_HideApp;
type
TRegisterServiceProcess = function(dwProcessID, dwType: DWORD): DWORD;
stdcall;
var
Hndl: THandle;
RegisterServiceProcess: TRegisterServiceProcess;
begin
try
if Win32Platform <> VER_PLATFORM_WIN32_NT then // 不是NT
begin
Hndl := LoadLibrary('KERNEL32.DLL');
RegisterServiceProcess := GetProcAddress(Hndl,
'RegisterServiceProcess');
RegisterServiceProcess(GetCurrentProcessID, 1);
// 程序不出现在ALT+DEL+CTRL列表中
SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
// 程序不出现在任务栏
Application.ShowMainForm := false;
// 程序不出现主窗口
FreeLibrary(Hndl);
end
else
begin
SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
// 程序不出现在任务栏
Application.ShowMainForm := false; // 程序不出现主窗口
end;
except
cf_sysLog('隐藏应用程序进程函数过程失败! 错误位置:[' + 'procedure cp_HideApp;]');
end;
end;
// ******************************************************************************
// 过程功能: 关闭Windows操作。
// 过程名称: cp_sysWindowsClose
// 过程参数: iType: 0:关闭 1:重启 2:注销 3:关机
// 返回值: 无
// ******************************************************************************
procedure cp_sysWindowsClose(iType: Smallint);
begin
try
case iType of
CONST_SYS_WINCLOSE:
begin
ExitWindowsEx(EWX_LOGOFF, 0);
end;
CONST_SYS_WINRESTART:
begin
ExitWindowsEx(EWX_REBOOT, 0);
end;
CONST_SYS_WINLOGOUT:
begin
ExitWindowsEx(EWX_FORCE, 0);
end;
CONST_SYS_WINPOWEROFF:
begin
ExitWindowsEx(EWX_POWEROFF, 0)
end;
end;
except
cf_sysLog('关闭Windows操作函数过程失败! 错误位置:[' +
'procedure cp_sysWindowsClose(iType: Smallint);]');
end;
end;
// ******************************************************************************
// 过程功能: 打开屏幕保护
// 过程名称: cp_sysOpenScreenSave
// 过程参数: 无
// 返回值: 无
// ******************************************************************************
procedure cp_sysOpenScreenSave;
begin
try
SendMessage(Application.Handle, WM_SYSCOMMAND, SC_SCREENSAVE, 0)
except cf_sysLog('打开屏幕保护函数过程失败! 错误位置:[' +
'procedure cp_sysOpenScreenSave;]');
end;
end;
// ******************************************************************************
// 过程功能: 程序清除自毁
// 过程名称: cp_sysDeleteMe
// 过程参数: 无
// 返回值: 无
// ******************************************************************************
procedure cp_sysDeleteMe;
function GetShortName(sLongName: string): string; // 转换长文件名
var
sShortName: string;
nShortNameLen: Integer;
begin
SetLength(sShortName, MAX_PATH);
nShortNameLen := GetShortPathName(PWideChar(sLongName), PWideChar
(sShortName), MAX_PATH - 1);
if (0 = nShortNameLen) then
begin
// cf_sysMsgBox('生成批处理转换长文件名发生错误!',MB_OK+MB_ICONERROR);
end;
SetLength(sShortName, nShortNameLen);
Result := sShortName;
end;
var
BatchFile: TextFile;
BatchFileName: string;
ProcessInfo: TProcessInformation;
oStartupInfo: TStartupInfo;
begin
try
BatchFileName := ExtractFilePath(ParamStr(0)) + '$$k$$.bat';
AssignFile(BatchFile, BatchFileName);
Rewrite(BatchFile);
Writeln(BatchFile, ':try');
Writeln(BatchFile, 'del "' + GetShortName(ParamStr(0)) + '"');
Writeln(BatchFile, 'if exist "' + GetShortName(ParamStr(0))
+ '"' + ' goto try');
Writeln(BatchFile, 'move ' + cf_sysGetTempPath + ExtractFileName
(Application.ExeName) + ' "' + GetShortName(ParamStr(0)) + '"');
Writeln(BatchFile, 'del %0');
Writeln(BatchFile, 'cls');
Writeln(BatchFile, 'exit');
CloseFile(BatchFile);
FillChar(oStartupInfo, SizeOf(oStartupInfo), $00);
oStartupInfo.dwFlags := STARTF_USESHOWWINDOW;
oStartupInfo.wShowWindow := SW_HIDE;
if CreateProcess(nil, PWideChar(BatchFileName), nil, nil, false,
IDLE_PRIORITY_CLASS, nil, nil, oStartupInfo, ProcessInfo) then
begin
CloseHandle(ProcessInfo.hThread);
CloseHandle(ProcessInfo.HProcess);
end;
Application.Terminate;
except
cf_sysLog('程序清除自毁函数过程失败! 错误位置:[' + 'procedure cp_sysDeleteMe;]');
end;
end;
// ******************************************************************************
// 过程功能: 防止应用程序多次运行
// 过程名称: cp_sysAppMutex
// 过程参数: 无
// 返回值: 无
// ******************************************************************************
procedure cp_sysAppMutex;
var
hMutex: Cardinal;
begin
try
hMutex := CreateMutex(nil, true, PWideChar(Application.Title));
// 存在
if GetLastError = ERROR_ALREADY_EXISTS then
begin
cf_sysMsgBox('当前程序已经打开！请关闭后重试！', MB_OK + MB_ICONERROR);
try
ReleaseMutex(hMutex);
Application.Terminate;
Exit;
except
Abort;
Exit;
end;
end;
except
cf_sysLog('防止应用程序多次运行函数过程失败! 错误位置:[' + 'procedure cp_sysAppMutex;]');
end;
end;
// ******************************************************************************
// 过程功能: 重启应用程序本身
// 过程名称: cp_sysAppRestart
// 过程参数: 无
// 返回值: 无
// ******************************************************************************
procedure cp_sysAppRestart;
var
oStartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
begin
try
FillChar(oStartupInfo, SizeOf(oStartupInfo), #0);
oStartupInfo.cb := SizeOf(oStartupInfo);
CreateProcess(nil, PWideChar(Application.ExeName), nil, nil, false,
NORMAL_PRIORITY_CLASS, nil, nil, oStartupInfo, ProcessInfo);
except
cf_sysLog('重启应用程序本身函数过程失败! 错误位置:[' + 'procedure cp_sysAppRestart;]');
end;
end;
// ******************************************************************************
// 过程功能: 显示Windows关于对话框
// 过程名称: cp_sysWinAbout
// 过程参数: 无
// 返回值: 无
// ******************************************************************************
procedure cp_sysWinAbout(sTitle, sContent: string);
begin
try
ShellAbout(Application.Handle, PWideChar(sTitle), PWideChar(sContent),
Application.Icon.Handle);
except
cf_sysLog('显示Windows关于对话框函数过程失败! 错误位置:[' +
'procedure cp_sysWinAbout(sTitle, sContent: string);]');
end;
end;
// ******************************************************************************
// 过程功能: 关闭显示器
// 过程名称: cp_sysCloseMonitor
// 过程参数: 无
// 返回值: 无
// ******************************************************************************
procedure cp_sysCloseMonitor;
begin
try
SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 2);
except
cf_sysLog('关闭显示器函数过程失败! 错误位置:[' + 'procedure cp_sysCloseMonitor;]');
end;
end;
// ******************************************************************************
// 过程功能: 关闭窗口多余Tab页
// 过程名称: cp_sysCloseMonitor
// 过程参数: 无
// 返回值: 无
// ******************************************************************************
procedure cp_sysClearTabs(Sender: TObject; var Action: TCloseAction);
var
iPageIndex, iControlIndex: Integer;
oTabSheet: TRzTabSheet;
oPageContrl: TRzPageControl;
begin
// 是窗体
if (Sender is TForm) then
begin
if (Sender as TForm).HasParent then
begin
// 父类是TRzTabSheet
if (Sender as TForm).Parent is TRzTabSheet then
begin
try
oTabSheet := ((Sender as TForm).Parent as TRzTabSheet);
oPageContrl := (oTabSheet.Parent as TRzPageControl);
if (oTabSheet <> nil) then
begin
oTabSheet.Free;
end;
if oPageContrl.PageCount > 0 then
begin
oPageContrl.ActivePageIndex := oPageContrl.PageCount - 1;
end
else
begin
oPageContrl.Visible := false;
end;
except
cf_sysLog('关闭窗口多余Tab页函数过程失败! 错误位置:[' +
'procedure cp_sysClearTabs(Sender: TObject; var Action: TCloseAction);]');
end;
end;
end;
end;
end;
// ******************************************************************************
// 过程功能: 应用程序自动启动设置
// 过程名称: cp_AppAutoRun
// 过程参数: bYes:是否自动运行Boolean值
// ******************************************************************************
{ procedure cp_regAppAutoRun(bYes: Boolean);
begin
try
if bYes then
begin
cf_regSetRegValue('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run',
Application.Name, Application.ExeName);
end
else
begin
cf_regDeleteRegValue
('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run',
Application.Name);
end;
except
cf_sysLog('应用程序自动启动设置函数过程失败! 错误位置:[' +
'procedure cp_regAppAutoRun(bYes: Boolean);]');
end;
end; }
// ******************************************************************************
// 过程功能: 保存窗体关闭时的相关状态。
// 过程名称: cp_sysSaveFormControlInfo
// 过程参数: oForm TForm 窗体
// ******************************************************************************
procedure cp_sysSaveFormControlInfo(oForm: TForm);
var
oIniF: TIniFile;
iCount, jCount: Integer;
strPath, sData, lsi: string;
begin
strPath := ExtractFilePath(ParamStr(0)) + CONST_SYS_INIFILENAME;
oIniF := TIniFile.Create(strPath);
try
with oForm do
begin
for iCount := 0 to ComponentCount - 1 do
begin
// 如果是TDBGridEh类
if Components[iCount] is TDBGridEh then
begin
// 设置DBGridEh的RowHeight值
sData := IntToStr(TDBGridEh(Components[iCount]).RowHeight);
oIniF.WriteString('FORMSTATUS', oForm.ClassName + TDBGridEh
(Components[iCount]).Name + 'ROWHEIGHT', sData);
with TDBGridEh(Components[iCount]) do
begin
sData := IntToStr(Columns[0].Width) + CONST_VAL_SPLIT;
for jCount := 1 to Columns.Count - 1 do
begin
sData := sData + IntToStr(Columns[jCount].Width)
+ CONST_VAL_SPLIT;
end;
end;
oIniF.WriteString('FORMSTATUS', oForm.ClassName + TDBGridEh
(Components[iCount]).Name + 'COLUMNSWIDTH', sData);
end
// 如果TDBGrid类
else if Components[iCount] is TDBGrid then
begin
// 设置DBGridEh的ColumnsWidth值
with TDBGrid(Components[iCount]) do
begin
sData := IntToStr(Columns[0].Width) + CONST_VAL_SPLIT;
for jCount := 1 to Columns.Count - 1 do
begin
sData := sData + IntToStr(Columns[jCount].Width)
+ CONST_VAL_SPLIT;
end;
end;
oIniF.WriteString('FORMSTATUS', oForm.ClassName + TDBGrid
(Components[iCount]).Name + 'COLUMNSWIDTH', sData);
end
// TcxGridDBColumn
else if Components[iCount] is TcxGridDBColumn then
begin
sData := IntToStr(TcxGridDBColumn(Components[iCount]).Width);
oIniF.WriteString('FORMSTATUS',
oForm.ClassName + 'CX' + TcxGridDBColumn(Components[iCount])
.Name + 'COLUMNSWIDTH', sData);
end
// 如果Panel类
else if Components[iCount] is TPanel then
begin
sData := TPanel(Components[iCount]).Caption;
oIniF.WriteString('FORMSTATUS', oForm.ClassName + TPanel
(Components[iCount]).Name + 'CAPTION', sData);
end;
end;
{
sData := IntTostr(Top);
oIniF.WriteString('FORMSTATUS', oForm.ClassName + 'FORMTOP', sData);
sData := IntTostr(Left);
oIniF.WriteString('FORMSTATUS', oForm.ClassName + 'FORMLEFT', sData);
sData := IntToStr(Width);
oIniF.WriteString('FORMSTATUS', oForm.ClassName + 'FORMWIDTH', sData);
sData := IntToStr(Height);
oIniF.WriteString('FORMSTATUS', oForm.ClassName + 'FORMHEIGHT', sData);
}
end;
finally
oIniF.Free;
end;
end;
// ******************************************************************************
// 过程功能: 获取窗体关闭时的相关状态。
// 过程名称: cp_sysGetFormControlInfo
// 过程参数: oForm TForm 窗体
// ******************************************************************************
procedure cp_sysGetFormControlInfo(oForm: TForm);
var
oIniF: TIniFile;
iCount, jCount: Integer;
strPath, lsStr, lsi: string;
begin
strPath := ExtractFilePath(ParamStr(0)) + CONST_SYS_INIFILENAME;
oIniF := TIniFile.Create(strPath);
try
with oForm do
begin
for iCount := 0 to ComponentCount - 1 do
begin
// 如果是TDBGridEh类
if Components[iCount] is TDBGridEh then
begin
// 读取DBGridEh的RowHeight值
lsStr := oIniF.ReadString
('FORMSTATUS', oForm.ClassName + TDBGridEh(Components[iCount])
.Name + 'ROWHEIGHT', '');
if Trim(lsStr) <> '' then
TDBGridEh(Components[iCount]).RowHeight := StrToInt(lsStr);
// 读取Column集合Width值 字符串。
lsStr := oIniF.ReadString
('FORMSTATUS', oForm.ClassName + TDBGridEh(Components[iCount])
.Name + 'COLUMNSWIDTH', '');
if lsStr <> '' then
begin
with TDBGridEh(Components[iCount]) do
begin
for jCount := 0 to Columns.Count - 1 do
begin
lsi := cf_valGetStrPosStr(lsStr, jCount + 1);
if lsi <> '' then
begin
Columns[jCount].Width := StrToInt(lsi);
end
else
Break;
end;
end;
end;
end
// 如果TDBGrid类
else if Components[iCount] is TDBGrid then
begin
// 读取Column集合Width值 字符串。
lsStr := oIniF.ReadString('FORMSTATUS', oForm.ClassName + TDBGrid
(Components[iCount]).Name + 'COLUMNSWIDTH', '');
if lsStr <> '' then
begin
with TDBGrid(Components[iCount]) do
begin
for jCount := 0 to Columns.Count - 1 do
begin
lsi := cf_valGetStrPosStr(lsStr, jCount + 1);
if lsi <> '' then
begin
Columns[jCount].Width := StrToInt(lsi);
end
else
Break;
end;
end;
end;
end
else if Components[iCount] is TcxGridDBColumn then
begin
// 读取Column集合Width值 字符串。
lsStr := oIniF.ReadString
('FORMSTATUS', oForm.ClassName + 'CX' + TcxGridDBColumn
(Components[iCount]).Name + 'COLUMNSWIDTH', '');
if lsStr <> '' then
begin
TcxGridDBColumn(Components[iCount]).Width := StrToIntDef
(lsStr, 100);
end;
end
// 如果是TPanel类
else if Components[iCount] is TPanel then
begin
lsStr := oIniF.ReadString('FORMSTATUS', oForm.ClassName + TPanel
(Components[iCount]).Name + 'CAPTION', '');
if lsStr <> '' then
begin
TPanel(Components[iCount]).Caption := lsStr;
end;
end;
end;
{
lsStr := oIniF.ReadString('FORMSTATUS', oForm.ClassName + 'FORMTOP', '');
if lsStr <> '' then Top := StrToInt(lsStr);
lsStr := oIniF.ReadString('FORMSTATUS', oForm.ClassName + 'FORMLEFT', '');
if lsStr <> '' then Left := StrToInt(lsStr);
lsStr := oIniF.ReadString('FORMSTATUS', oForm.ClassName + 'FORMWIDTH', '');
if lsStr <> '' then Width := StrToInt(lsStr);
lsStr := oIniF.ReadString('FORMSTATUS', oForm.ClassName + 'FORMHEIGHT', '');
if lsStr <> '' then Height := StrToInt(lsStr);
}
end;
finally
oIniF.Free;
end;
end;
{ TDynamicMenu }
// ******************************************************************************
// 类模块功能: 清除菜单所有子项
// 类模块名称: TDynamicMenu
// 类模块方法: Clear: 清楚指定 Menu所有子项。
// 类模块属性:
// 返回值: 无
// ******************************************************************************
procedure TDynamicMenu.Clear;
begin
if FMainMenu <> nil then
FMainMenu.Items.Clear;
end;
// ******************************************************************************
// 类模块功能: 建立子菜单
// 类模块名称: TDynamicMenu
// 类模块方法: CreateMenu:
// 类模块属性:
// 返回值: 无
// ******************************************************************************
procedure TDynamicMenu.CreateMenu;
var
sSQL, sTest: string;
oMenuItem, oPMenuItem: TMenuItem;
oADOQuery: TADOQuery;
iResourceType: Integer;
begin
sTest := '';
if (FForm = nil) then
cf_sysMsgBox('设计期错误,没有指定要创建菜单的窗体!', MB_OK + MB_ICONERROR);
if (FMainMenu = nil) then
cf_sysMsgBox('设计期错误,没有指定要创建的菜单!', MB_OK + MB_ICONERROR);
if FConStr = '' then
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) <> '')
then
begin
FConStr := goADOConDef.ConnectionString;
end
else
begin
cf_sysMsgBox('设计期错误,没有指定要创建菜单的窗体!', MB_OK + MB_ICONERROR);
Exit;
end;
end
else
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) = '')
then
begin
if goADOConDef.Connected then
goADOConDef.Connected := false;
goADOConDef.ConnectionString := FConStr;
goADOConDef.LoginPrompt := false;
if not goADOConDef.Connected then
goADOConDef.Open;
end
else if (goADOConDef = nil) and
(Trim(goADOConDef.ConnectionString) = '') then
begin
goADOConDef := TADOConnection(Application);
goADOConDef.LoginPrompt := false;
goADOConDef.ConnectionString := FConStr;
if not goADOConDef.Connected then
goADOConDef.Open;
end;
end;
if (Trim(FConStr) = '') and ((FADOConnection = nil) or
(Trim(FADOConnection.ConnectionString) = '')) then
cf_sysMsgBox('设计期错误,没有指定数据库连接信息!', MB_OK + MB_ICONERROR);
if (Trim(FUserCode) = '') then
cf_sysMsgBox('设计期错误,没有指定创建菜单的权限用户编码!', MB_OK + MB_ICONERROR);
if (Trim(FPassWord) = '') then
cf_sysMsgBox('设计期错误,没有指定创建菜单的权限用户密码!', MB_OK + MB_ICONERROR);
if (FPageControl = nil) then
cf_sysMsgBox('设计期错误,没有指定创建菜单的权限用户密码!', MB_OK + MB_ICONERROR);
if (Trim(FConStr) <> '') and ((FADOConnection = nil) or
(Trim(FADOConnection.ConnectionString) = '')) then
begin
FADOConnection := goADOConDef;
if not FADOConnection.Connected then
FADOConnection.Open;
end
else if (Trim(FConStr) = '') and ((FADOConnection <> nil) and
(Trim(FADOConnection.ConnectionString) <> '')) then
begin
if not FADOConnection.Connected then
begin
FADOConnection.LoginPrompt := false;
FADOConnection.Connected := true;
end;
end;
// 设置样式
FPageControl.ShowCloseButton := true;
FPageControl.ShowCloseButtonOnActiveTab := true;
// 检测用户合法性
if not cf_operCheckUser(FUserCode, FPassWord, FADOConnection, true) then
begin
cf_sysMsgBox('非法用户,不存在此用户或用户密码错误!');
Exit;
end;
// 设置是否清空菜单子项。
if FFirstClear then
FMainMenu.Items.Clear;
// 查询用户所有资源权限信息。
if goSysInfo.bIsModleDLL then
begin
sSQL :=
'Select TFWUser_Code,PassWord,TFWResource_Code,TFWResource_PCode,Name, '
+ 'TFWResourceFileName,FuncName,TFWResourceType_Code from VFWUserResource where TFWUser_Code=' + QuotedStr(Trim(FUserCode)) + ' Order By OrderNo';
end
else
begin
sSQL :=
'Select TFWUser_Code,PassWord,TFWResource_Code,TFWResource_PCode,Name, '
+ 'TFWResourceFileName,FuncName,TFWResourceType_Code from VFWUserResource where TFWUser_Code=' + QuotedStr(Trim(FUserCode)) + ' Order By OrderNo';
end;
oADOQuery := cf_dbSelectSQL(sSQL, FADOConnection);
if oADOQuery = nil then
Exit;
try
try
if not oADOQuery.IsEmpty then
begin
oADOQuery.First;
FHandles := TStringList.Create;
while not oADOQuery.Eof do
begin
oMenuItem := TMenuItem.Create(FForm);
// 菜单名称采用资源编码
oMenuItem.Name := 'mn' + oADOQuery.FieldByName('TFWResource_Code')
.AsString;
// 菜单显示资源类型
iResourceType := oADOQuery.FieldByName('TFWResourceType_Code')
.AsInteger;
// 0:模块; 1:窗体;2:控件;3:分割线;4:其它;5命令
// 菜单内容显示资源名
if iResourceType = 3 then
begin
oMenuItem.Caption := '-';
end
else if ((iResourceType = 0) or (iResourceType = 1) or
(iResourceType = 5)) then
begin
oMenuItem.Caption := oADOQuery.FieldByName('Name').AsString;
end;
// 新增子菜单
oPMenuItem := cf_ctrlFindMenuItem('mn' + oADOQuery.FieldByName
('TFWResource_PCode').AsString, FForm);
if oPMenuItem <> nil then
begin
oPMenuItem.ADD(oMenuItem);
if (iResourceType = 1) or (iResourceType = 5) then
begin
sTest := oMenuItem.Caption;
oMenuItem.OnClick := MenuItemOnClick;
end;
end
else
begin
// 新增父菜单
FMainMenu.Items.ADD(oMenuItem);
sTest := oMenuItem.Caption;
end;
oADOQuery.Next;
end;
end;
except
cf_sysLog('建立动态菜单函数过程失败! 错误位置:[' +
'procedure TDynamicMenu.CreateMenu;]');
end;
finally
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.Free;
end;
end;
// ******************************************************************************
// 类模块功能: 释放相关的模块句柄
// 类模块名称: TDynamicMenu
// 类模块方法: Free:
// 类模块属性:
// 返回值: 无
// ******************************************************************************
procedure TDynamicMenu.Free;
var
iCount: Integer;
begin
if FHandles <> nil then
begin
try
for iCount := 0 to FHandles.Count - 1 do
begin
try
if Longword(FHandles.Strings[iCount]) <> 0 then
FreeLibrary(Longword(FHandles.Strings[iCount]));
except
Continue;
end;
end;
except
cf_sysLog('释放相关的模块句柄函数过程失败! 错误位置:[' +
'procedure TDynamicMenu.Free;]');
end;
end;
end;
// ******************************************************************************
// 类模块功能: 给相应的菜单加载模块
// 类模块名称: TDynamicMenu
// 类模块方法: LoadDll
// 类模块属性: 加载相应的动态模块。
// 参数：hHandle, hParentHandle: THandle; //应用程序句柄和父窗口句柄
// oForm: TForm; //创建窗体
// oADOConnection: TADOConnection; 数据库连接
// iSkinIndex: Integer; 皮肤索引
// sUserCode : String 用户帐号
// sPassWord:String 用户密码
// sResourceCode: string 用户资源编号
// 返回值: 无
// ******************************************************************************
function TDynamicMenu.LoadDll(hHandle, hParentHandle: THandle;
oForm: TForm; oADOConnection: TADOConnection; sUserCode, sPassWord,
sResourceCode: string): THandle;
var
hLibHandle: THandle;
pLoadDllProc: TLoadDllProc;
sDllFileName, sFuncName, sSQL: string;
oADOQuery: TADOQuery;
iCount: Integer;
begin
Result := 0;
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString) = '')
or (Trim(sUserCode) = '') or (Trim(sPassWord) = '') or
(Trim(sResourceCode) = '') then
Exit;
sSQL :=
'Select TFWResourceFileName,FuncName from VFWUserResource where TFWUser_Code='
+ QuotedStr(Trim(sUserCode)) + ' and TFWResource_Code=' + QuotedStr
(sResourceCode) + ' and PassWord=' + QuotedStr
(cf_valEncryptCodeA(Trim(sPassWord))) + ' and TFWResourceType_Code=1';
oADOQuery := TADOQuery.Create(nil);
try
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.Connection := oADOConnection;
oADOQuery.SQL.Clear;
oADOQuery.SQL.ADD(sSQL);
oADOQuery.Open;
if not oADOQuery.IsEmpty then
begin
sDllFileName := oADOQuery.FieldByName('TFWResourceFileName').AsString;
sFuncName := oADOQuery.FieldByName('FuncName').AsString;
end;
finally
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.Free;
end;
// 找不到动态库文件名和函数名。
if (Trim(sDllFileName) = '') or (Trim(sFuncName) = '') then
Exit;
hLibHandle := SafeLoadLibrary(PWideChar(cf_sysGetAppPath + sDllFileName));
if (FHandles <> nil) then
begin
FHandles.ADD(VarToStr(hLibHandle));
end;
try
if hLibHandle = 0 then
begin
cf_sysMsgBox('找不到指定的模块文件,请确认“' + sDllFileName + '”动态文件是否在应用程序目录下!',
MB_OK + MB_ICONERROR, 0);
Exit;
end;
@pLoadDllProc := GetProcAddress(hLibHandle, PWideChar(sFuncName));
if @pLoadDllProc <> nil then
begin
Result := pLoadDllProc(hHandle, hParentHandle, oForm, oADOConnection,
sUserCode, sPassWord, sFuncName);
end
else
begin
cf_sysMsgBox('请确认给定的“' + sDllFileName + '”是否存在“' + sFuncName +
'”函数功能!');
Result := 0;
end;
except
cf_sysLog('给相应的控件加载模块时失败! 错误位置:[' +
'function TDynamicMenu.LoadDll(hHandle, hParentHandle: THandle;' +
'oForm: TForm; oADOConnection: TADOConnection; ' +
'sUserCode, sPassWord, sResourceCode: string): THandle;]');
end;
end;
// ******************************************************************************
// 类模块功能: 给相应的菜单加载事件。
// 类模块名称: TDynamicMenu
// 类模块方法: MenuItemOnClick:
// 类模块属性:
// 返回值: 无
// ******************************************************************************
procedure TDynamicMenu.MenuItemOnClick(Sender: TObject);
var
sSQL, sMenuCode: string;
oADOQuery: TADOQuery;
hHandle: THandle;
sPath: AnsiString;
begin
// 菜单ID号
sMenuCode := Copy(TMenuItem(Sender).Name, Length('mn') + 1, Length
(TMenuItem(Sender).Name));
if sMenuCode = '' then
Exit;
if (Trim(FConStr) <> '') and ((FADOConnection = nil) or
(Trim(FADOConnection.ConnectionString) = '')) then
begin
FADOConnection := TADOConnection.Create(nil);
FADOConnection.LoginPrompt := false;
FADOConnection.ConnectionString := FConStr;
if not FADOConnection.Connected then
FADOConnection.Open;
end
else if (Trim(FConStr) = '') and ((FADOConnection <> nil) and
(Trim(FADOConnection.ConnectionString) <> '')) then
begin
if not FADOConnection.Connected then
begin
FADOConnection.LoginPrompt := false;
FADOConnection.Connected := true;
end;
end;
oADOQuery := TADOQuery.Create(nil);
try
try
oADOQuery.Connection := FADOConnection;
oADOQuery.SQL.Clear;
sSQL :=
'Select TFWUser_Code,PassWord,TFWResource_Code,TFWResource_PCode,Name, '
+ 'TFWResourceFileName,FuncName,TFWResourceType_Code from VFWUserResource Where TFWResource_Code=' + QuotedStr(sMenuCode);
oADOQuery.SQL.ADD(sSQL);
oADOQuery.Open;
if (not oADOQuery.IsEmpty) or (oADOQuery.RecordCount > 0) then
begin
oADOQuery.First;
if goSysInfo.bIsModleDLL then
begin
// 更新模块 测试期间不要打开。否则无法测试DLL进程。
if FAutoUpdate then
cf_operUpdateDllFiles(FUserCode, FPassWord,
oADOQuery.FieldByName('FuncName').AsString, FADOConnection);
if not cf_ctrlFindOwerChildForm(FForm, 'frm' + sMenuCode) then
begin
hHandle := LoadDll(Application.Handle, FParentHandle, FForm,
FADOConnection, FUserCode, FPassWord, sMenuCode);
end;
end
else
begin
if (oADOQuery.FieldByName('TFWResourceType_Code').AsInteger = 1)
then
begin
// 启用完整程序启动模式
cf_sysShowFormClass(FForm, FPageControl, oADOQuery.FieldByName
('TFWResourceFileName').AsString);
end
else if (oADOQuery.FieldByName('TFWResourceType_Code')
.AsInteger = 5) then
begin
sPath := cf_sysGetAppPath + Trim
(oADOQuery.FieldByName('FuncName').AsString);
WinExec(PAnsiChar(sPath), SW_SHOWNORMAL);
end;
end;
end;
except
cf_sysLog('给相应的控件加载事件时失败! 错误位置:[' +
'procedure TDynamicMenu.MenuItemOnClick(Sender: TObject);]');
end;
finally
oADOQuery.Free;
end;
end;
{ TDynamicTreeMenu }
// ******************************************************************************
// 类模块功能: 清除树形菜单所有子项
// 类模块名称: TDynamicTreeMenu
// 类模块方法: Clear: 清除指定TreeView所有子项。
// 返回值: 无
// ******************************************************************************
procedure TDynamicTreeMenu.Clear;
begin
try
if FTreeView <> nil then
FTreeView.Items.Clear;
except
cf_sysLog('清除树形菜单所有子项函数过程中失败! 错误位置:[' +
'procedure TDynamicTreeMenu.Clear;]');
end;
end;
// ******************************************************************************
// 类模块功能: 建立树形菜单所有项。
// 类模块名称: TDynamicTreeMenu
// 类模块方法: CreateTreeMenu;: 建立指定TreeView所有子项。
// 返回值: 无
// ******************************************************************************
procedure TDynamicTreeMenu.CreateTreeMenu;
var
sSQL: string;
pNodeData: pTreeNodeData;
oTreeNode, oTreeNode1, oPTreeNode, oTreeNode2: TTreeNode;
oADOQuery: TADOQuery;
oStringList: TStringList;
iFieldCount, iIndex: Integer;
begin
if FConStr = '' then
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) <> '')
then
begin
FConStr := goADOConDef.ConnectionString;
end
else
begin
Exit;
end;
end
else
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) = '')
then
begin
if goADOConDef.Connected then
goADOConDef.Connected := false;
goADOConDef.ConnectionString := FConStr;
goADOConDef.LoginPrompt := false;
if not goADOConDef.Connected then
goADOConDef.Open;
end
else if (goADOConDef = nil) and
(Trim(goADOConDef.ConnectionString) = '') then
begin
goADOConDef := TADOConnection(Application);
goADOConDef.LoginPrompt := false;
goADOConDef.ConnectionString := FConStr;
if not goADOConDef.Connected then
goADOConDef.Open;
end;
end;
if (FForm = nil) then
cf_sysMsgBox('设计期错误,没有指定要创建菜单的窗体!', MB_OK + MB_ICONERROR);
if (FTreeView = nil) then
cf_sysMsgBox('设计期错误,没有指定要创建的树形控件!', MB_OK + MB_ICONERROR);
if (Trim(FConStr) = '') and ((FADOConnection = nil) or
(Trim(FADOConnection.ConnectionString) = '')) then
cf_sysMsgBox('设计期错误,没有指定数据库连接信息!', MB_OK + MB_ICONERROR);
if (Trim(FUserCode) = '') then
cf_sysMsgBox('设计期错误,没有指定创建菜单的权限用户编码!', MB_OK + MB_ICONERROR);
if (FPageControl = nil) then
cf_sysMsgBox('设计期错误,没有指定创建菜单的权限用户密码!', MB_OK + MB_ICONERROR);
if (Trim(FPassWord) = '') then
cf_sysMsgBox('设计期错误,没有指定创建菜单的权限用户密码!', MB_OK + MB_ICONERROR);
if (Trim(FConStr) <> '') and ((FADOConnection = nil) or
(Trim(FADOConnection.ConnectionString) = '')) then
begin
FADOConnection := TADOConnection.Create(nil);
FADOConnection.LoginPrompt := false;
FADOConnection.ConnectionString := FConStr;
if not FADOConnection.Connected then
FADOConnection.Open;
end
else if (Trim(FConStr) = '') and ((FADOConnection <> nil) and
(Trim(FADOConnection.ConnectionString) <> '')) then
begin
if not FADOConnection.Connected then
begin
FADOConnection.LoginPrompt := false;
FADOConnection.Connected := true;
end;
end;
// 设置样式
FPageControl.ShowCloseButton := true;
FPageControl.ShowCloseButtonOnActiveTab := true;
// 检测用户合法性
if not cf_operCheckUser(FUserCode, FPassWord, FADOConnection, true) then
begin
cf_sysMsgBox('非法用户,不存在此用户或用户密码错误!');
Exit;
end;
// 设置是否清空菜单子项。
if FFirstClear then
FTreeView.Items.Clear;
// 查询用户所有资源权限信息。
if goSysInfo.bIsModleDLL then
begin
sSQL :=
'Select TFWUser_Code,PassWord,TFWResource_Code,TFWResource_PCode,Name, '
+ 'TFWResourceFileName,FuncName,TFWResourceType_Code from VFWUserResource where TFWUser_Code=' + QuotedStr(Trim(FUserCode))
+ ' and TFWResourceType_Code in (0,1,5) Order By OrderNo';
end
else
begin
sSQL :=
'Select TFWUser_Code,PassWord,TFWResource_Code,TFWResource_PCode,Name, '
+ 'TFWResourceFileName,FuncName,TFWResourceType_Code from VFWUserResource where TFWUser_Code=' + QuotedStr
(Trim(FUserCode))
+ 'and TFWResourceType_Code in (0,1,5) Order By OrderNo';
end;
// 画分级树。
oADOQuery := TADOQuery.Create(nil);
FTreeView.Items.BeginUpdate;
// 设置图标列表对象。
FTreeView.Images := FImageList;
try
try
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.SQL.Clear;
oADOQuery.Connection := FADOConnection;
oADOQuery.SQL.ADD(sSQL);
oADOQuery.Open;
if not oADOQuery.IsEmpty then
begin
oStringList := TStringList.Create;
oStringList.Clear;
oADOQuery.First;
oTreeNode := nil;
while not oADOQuery.Eof do
begin
pNodeData := New(pTreeNodeData);
pNodeData.sID := oADOQuery.FieldByName('TFWResource_Code')
.AsString;
pNodeData.sPID := oADOQuery.FieldByName('TFWResource_PCode')
.AsString;
pNodeData.sKeyField := oADOQuery.FieldByName
('TFWResourceType_Code').AsString;
pNodeData.sDisplayField := oADOQuery.FieldByName('Name').AsString;
// 所有数据列
for iFieldCount := 0 to oADOQuery.FieldCount - 1 do
begin
pNodeData.sData := pNodeData.sData + Trim
(oADOQuery.Fields[iFieldCount].AsString) + CONST_VAL_SPLIT;
end;
oTreeNode := FTreeView.Items.AddObject
(oTreeNode, pNodeData.sDisplayField, pNodeData);
oStringList.AddObject(AnsiString(Trim(pNodeData.sID)), oTreeNode);
oADOQuery.Next;
end;
// 重置
oTreeNode1 := FTreeView.Items.GetFirstNode;
while (oTreeNode1 <> nil) do
begin
// 当前节点父ID与查找的节点ID相同。
iIndex := oStringList.IndexOf
(AnsiString(Trim(pTreeNodeData(oTreeNode1.Data).sPID)));
if iIndex <> -1 then
begin
// 保存点
oTreeNode2 := oTreeNode1;
// 父节点。
oPTreeNode := TTreeNode(oStringList.Objects[iIndex]);
// 设置图标索引
oPTreeNode.ImageIndex := FParentImageIndex;
oPTreeNode.SelectedIndex := FSelImageIndex;
// 设置子图标索引
oTreeNode2.ImageIndex := FChildImageIndex;
oTreeNode2.SelectedIndex := FSelImageIndex;
// 循环下一个节点。
oTreeNode1 := oTreeNode1.getNextSibling;
// 移动
oTreeNode2.MoveTo(oPTreeNode, naAddChild);
end
else
begin
// 循环下一个节点。
oTreeNode1 := oTreeNode1.getNextSibling;
Continue;
end;
iIndex := -1;
end;
FTreeView.OnDblClick := NodeItemOnDblClick;
end;
except
cf_sysLog('建立动态树形菜单所有项函数过程中失败! 错误位置:[' +
'procedure TDynamicTreeMenu.CreateTreeMenu;]');
end;
finally
oADOQuery.Free;
FTreeView.Items.EndUpdate;
end;
end;
// ******************************************************************************
// 类模块功能: 释放树形菜单所有关DLL资源。
// 类模块名称: TDynamicTreeMenu
// 类模块方法:清空所有未释放的DLL内存。
// 返回值: 无
// ******************************************************************************
procedure TDynamicTreeMenu.Free;
var
iCount: Integer;
begin
if FHandles <> nil then
begin
try
for iCount := 0 to FHandles.Count - 1 do
begin
try
if Longword(FHandles.Strings[iCount]) <> 0 then
FreeLibrary(Longword(FHandles.Strings[iCount]));
except
Continue;
end;
end;
except
cf_sysLog('释放树形菜单所有关DLL资源函数过程中失败! 错误位置:[' +
'procedure TDynamicTreeMenu.Free;]');
end;
end;
end;
// ******************************************************************************
// 类模块功能: 加载模块文件。
// 类模块名称: TDynamicTreeMenu
// 类模块方法: LoadDll
// 返回值: 无
// ******************************************************************************
function TDynamicTreeMenu.LoadDll(sResourceCode: string): THandle;
var
hLibHandle: THandle;
pLoadDllProc: TLoadDllProc;
sDllFileName, sFuncName, sSQL: string;
oADOQuery: TADOQuery;
iCount: Integer;
begin
Result := 0;
if (FADOConnection = nil) or (Trim(FADOConnection.ConnectionString) = '')
or (Trim(FUserCode) = '') or (Trim(FPassWord) = '') or
(Trim(sResourceCode) = '') then
Exit;
sSQL :=
'Select TFWResourceFileName,FuncName from VFWUserResource where TFWUser_Code='
+ QuotedStr(Trim(FUserCode)) + ' and TFWResource_Code=' + QuotedStr
(sResourceCode) + ' and PassWord=' + QuotedStr
(cf_valEncryptCodeA(Trim(FPassWord))) + ' and TFWResourceType_Code=1';
oADOQuery := TADOQuery.Create(nil);
try
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.Connection := FADOConnection;
oADOQuery.SQL.Clear;
oADOQuery.SQL.ADD(sSQL);
oADOQuery.Open;
if not oADOQuery.IsEmpty then
begin
sDllFileName := oADOQuery.FieldByName('TFWResourceFileName').AsString;
sFuncName := oADOQuery.FieldByName('FuncName').AsString;
end;
finally
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.Free;
end;
// 找不到动态库文件名和函数名。
if (Trim(sDllFileName) = '') or (Trim(sFuncName) = '') then
Exit;
hLibHandle := SafeLoadLibrary(PWideChar(cf_sysGetAppPath + sDllFileName));
if (FHandles <> nil) then
begin
FHandles.ADD(VarToStr(hLibHandle));
end;
try
if hLibHandle = 0 then
begin
cf_sysMsgBox('找不到指定的模块文件,请确认“' + sDllFileName + '”动态文件是否在应用程序目录下!',
MB_OK + MB_ICONERROR, 0);
Exit;
end;
@pLoadDllProc := GetProcAddress(hLibHandle, PWideChar(sFuncName));
if @pLoadDllProc <> nil then
begin
Result := pLoadDllProc(Application.Handle, FParentHandle, FForm,
FADOConnection, FUserCode, FPassWord, sFuncName);
end
else
begin
cf_sysMsgBox('请确认给定的“' + sDllFileName + '”是否存在“' + sFuncName +
'”函数功能!');
Result := 0;
end;
except
cf_sysLog('加载模块文件资源函数过程中失败! 错误位置:[' +
'function TDynamicTreeMenu.LoadDll(sResourceCode: string): THandle;]');
end;
end;
// ******************************************************************************
// 类模块功能: 双击事件
// 类模块名称: TDynamicTreeMenu
// 类模块方法: NodeItemOnDblClick
// 返回值: 无
// ******************************************************************************
procedure TDynamicTreeMenu.NodeItemOnDblClick(Sender: TObject);
var
sSelData: string;
iResourceType: Integer;
sFuncName, sResource_Code, sResourceFileName: string;
sPath: AnsiString;
begin
try
// 判断是否有节点
if (FTreeView.Items.Count > 0) then
begin
// 选择了节点。
if FTreeView.Selected <> nil then
begin
sSelData := cf_ctrlGetTreeViewNodeData(FTreeView, ctvResultData);
iResourceType := StrToIntDef(cf_valGetStrPosStr(sSelData, 8), 0);
sResourceFileName := cf_valGetStrPosStr(sSelData, 6);
sFuncName := cf_valGetStrPosStr(sSelData, 7);
sResource_Code := cf_valGetStrPosStr(sSelData, 3);
// 窗体类型。
if iResourceType = 1 then
begin
if goSysInfo.bIsModleDLL then
begin
// 更新模块 测试期间不要打开。否则无法测试DLL进程。
if FAutoUpdate then
cf_operUpdateDllFiles(FUserCode, FPassWord, sFuncName);
if not cf_ctrlFindOwerChildForm(FForm, 'frm' + sResource_Code)
then
begin
LoadDll(sResource_Code);
end;
end
else
begin
// 启用完整程序启动模式
cf_sysShowFormClass(FForm, FPageControl, sResourceFileName);
end;
end
else if iResourceType = 5 then
begin
sPath := cf_sysGetAppPath + sFuncName;
WinExec(PAnsiChar(sPath), SW_SHOWNORMAL);
end;
end;
end;
except
cf_sysLog('双击事件函数过程中失败! 错误位置:[' +
'procedure TDynamicTreeMenu.NodeItemOnDblClick(Sender: TObject);]');
end;
end;
{ TDynamicOutLookMenu }
// ******************************************************************************
// 类模块功能: 清除所有导航栏按钮。
// 类模块名称: TDynamicOutLookMenu
// 类模块方法: Clear: 清除指定OutLookBar所有子项。
// 返回值: 无
// ******************************************************************************
procedure TDynamicOutLookMenu.Clear;
begin
try
if FOutlookBar <> nil then
begin
FOutlookBar.ClearHeaders;
end;
except
cf_sysLog('清除所有导航栏按钮。函数过程中失败! 错误位置:[' +
'procedure TDynamicOutLookMenu.Clear;]');
end;
end;
// ******************************************************************************
// 类模块功能: 建立导航条所有项。
// 类模块名称: TDynamicOutLookMenu
// 类模块方法: CreateBarMenu;: 建立指定导航条所有子项。
// 返回值: 无
// ******************************************************************************
procedure TDynamicOutLookMenu.CreateBarMenu;
var
oADOQuery: TADOQuery;
oHeader: TmxHeader;
oButton: TmxButton;
oPageData: pTreeNodeData;
iCount: Integer;
sSQL: string;
begin
if FConStr = '' then
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) <> '')
then
begin
FConStr := goADOConDef.ConnectionString;
end
else
begin
cf_sysMsgBox('设计期错误,没有指定要创建菜单的窗体!', MB_OK + MB_ICONERROR);
Exit;
end;
end
else
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) = '')
then
begin
if goADOConDef.Connected then
goADOConDef.Connected := false;
goADOConDef.ConnectionString := FConStr;
goADOConDef.LoginPrompt := false;
if not goADOConDef.Connected then
goADOConDef.Open;
end
else if (goADOConDef = nil) and
(Trim(goADOConDef.ConnectionString) = '') then
begin
goADOConDef := TADOConnection(Application);
goADOConDef.LoginPrompt := false;
goADOConDef.ConnectionString := FConStr;
if not goADOConDef.Connected then
goADOConDef.Open;
end;
end;
if (FForm = nil) then
cf_sysMsgBox('设计期错误,没有指定要创建菜单的窗体!', MB_OK + MB_ICONERROR);
if (FOutlookBar = nil) then
cf_sysMsgBox('设计期错误,没有指定要创建的导航控件!', MB_OK + MB_ICONERROR);
if (Trim(FUserCode) = '') then
cf_sysMsgBox('设计期错误,没有指定创建菜单的权限用户编码!', MB_OK + MB_ICONERROR);
if (Trim(FPassWord) = '') then
cf_sysMsgBox('设计期错误,没有指定创建菜单的权限用户密码!', MB_OK + MB_ICONERROR);
if (FPageControl = nil) then
cf_sysMsgBox('设计期错误,没有指定创建菜单的权限用户密码!', MB_OK + MB_ICONERROR);
if (Trim(FConStr) <> '') and ((FADOConnection = nil) or
(Trim(FADOConnection.ConnectionString) = '')) then
begin
FADOConnection := TADOConnection.Create(nil);
FADOConnection.LoginPrompt := false;
FADOConnection.ConnectionString := FConStr;
if not FADOConnection.Connected then
FADOConnection.Open;
end
else if (Trim(FConStr) = '') and ((FADOConnection <> nil) and
(Trim(FADOConnection.ConnectionString) <> '')) then
begin
if not FADOConnection.Connected then
begin
FADOConnection.LoginPrompt := false;
FADOConnection.Connected := true;
end;
end;
// 设置样式
FPageControl.ShowCloseButton := true;
FPageControl.ShowCloseButtonOnActiveTab := true;
// 检测用户合法性
if not cf_operCheckUser(FUserCode, FPassWord, FADOConnection, true) then
begin
cf_sysMsgBox('非法用户,不存在此用户或用户密码错误!');
Exit;
end;
// 设置是否清空菜单子项。
if FFirstClear then
FOutlookBar.Headers.Clear;
// 查询用户所有资源权限信息。
if goSysInfo.bIsModleDLL then
begin
sSQL :=
'Select TFWUser_Code,PassWord,TFWResource_Code,TFWResource_PCode,Name, '
+ 'TFWResourceFileName,FuncName,TFWResourceType_Code from VFWUserResource where TFWUser_Code=' + QuotedStr
(Trim(FUserCode))
+ ' and TFWResourceType_Code in (0,1,5) Order By OrderNo';
end
else
begin
sSQL :=
'Select TFWUser_Code,PassWord,TFWResource_Code,TFWResource_PCode,Name, '
+ 'TFWResourceFileName,FuncName,TFWResourceType_Code from VFWUserResource where TFWUser_Code=' + QuotedStr
(Trim(FUserCode))
+ ' and TFWResourceType_Code in (0,1,5) Order By OrderNo';
end;
// 画分级导航。
oADOQuery := cf_dbSelectSQL(sSQL, FADOConnection);
if oADOQuery = nil then
Exit;
if not oADOQuery.IsEmpty then
begin
try
oADOQuery.IsEmpty;
if FFirstClear then
FOutlookBar.Headers.Clear;
FOutlookBar.HeaderImages.Hot := goImageList;
FOutlookBar.HeaderImages.Normal := goImageList;
while not oADOQuery.Eof do
begin
oPageData := New(pTreeNodeData);
oPageData.sID := oADOQuery.FieldByName('TFWResource_Code').AsString;
oPageData.sPID := oADOQuery.FieldByName('TFWResource_PCode')
.AsString;
oPageData.sKeyField := oADOQuery.FieldByName('TFWResourceFileName')
.AsString;
oPageData.sDisplayField := oADOQuery.FieldByName('FuncName')
.AsString;
oPageData.sData := oADOQuery.FieldByName('TFWResourceType_Code')
.AsString;
// 模块分类
if oADOQuery.FieldByName('TFWResourceType_Code').AsInteger = 0 then
begin
oHeader := FOutlookBar.Headers.ADD;
oHeader.Caption := oADOQuery.FieldByName('Name').AsString;
oHeader.ImageIndex := FParentImageIndex;
oHeader.SelectedIndex := FSelImageIndex;
oHeader.Data := oPageData;
end
else if oADOQuery.FieldByName('TFWResourceType_Code')
.AsInteger in [1, 5] then
begin
for iCount := 0 to FOutlookBar.Headers.Count - 1 do
begin
if
(LowerCase
(Trim(pTreeNodeData(FOutlookBar.Headers[iCount].Data).sID))
= LowerCase(Trim(oADOQuery.FieldByName('TFWResource_PCode')
.AsString))) then
begin
oButton := FOutlookBar.Headers[iCount].AddButton;
oButton.Data := oPageData;
oButton.ImageIndex := FChildImageIndex;
oButton.Caption := oADOQuery.FieldByName('Name').AsString;
oButton.OnClick := ButtonItemOnClick;
Break;
end;
end;
end;
oADOQuery.Next;
end;
except
cf_sysLog('清除所有导航栏按钮。函数过程中失败! 错误位置:[' +
'procedure TDynamicOutLookMenu.Clear;]');
end;
end;
end;
// ******************************************************************************
// 类模块功能: 建立树形菜单所有项。
// 类模块名称: TDynamicOutLookMenu
// 类模块方法:清空所有未释放的DLL内存。
// 返回值: 无
// ******************************************************************************
procedure TDynamicOutLookMenu.Free;
var
iCount: Integer;
begin
if FHandles <> nil then
begin
try
for iCount := 0 to FHandles.Count - 1 do
begin
try
if Longword(FHandles.Strings[iCount]) <> 0 then
FreeLibrary(Longword(FHandles.Strings[iCount]));
except
Continue;
end;
end;
except
cf_sysLog('建立树形菜单所有项函数过程中失败! 错误位置:[' +
'procedure TDynamicOutLookMenu.Free;]');
end;
end;
end;
// ******************************************************************************
// 类模块功能: 加载模块文件。
// 类模块名称: TDynamicOutLookMenu
// 类模块方法: LoadDll
// 返回值: 无
// ******************************************************************************
function TDynamicOutLookMenu.LoadDll(sResourceCode: string): THandle;
var
hLibHandle: THandle;
pLoadDllProc: TLoadDllProc;
sDllFileName, sFuncName, sSQL: string;
oADOQuery: TADOQuery;
iCount: Integer;
begin
Result := 0;
if (FADOConnection = nil) or (Trim(FADOConnection.ConnectionString) = '')
or (Trim(FUserCode) = '') or (Trim(FPassWord) = '') or
(Trim(sResourceCode) = '') then
Exit;
sSQL :=
'Select TFWResourceFileName,FuncName from VFWUserResource where TFWUser_Code='
+ QuotedStr(Trim(FUserCode)) + ' and TFWResource_Code=' + QuotedStr
(sResourceCode) + ' and PassWord=' + QuotedStr
(cf_valEncryptCodeA(Trim(FPassWord))) + ' and TFWResourceType_Code=1';
oADOQuery := TADOQuery.Create(nil);
try
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.Connection := FADOConnection;
oADOQuery.SQL.Clear;
oADOQuery.SQL.ADD(sSQL);
oADOQuery.Open;
if not oADOQuery.IsEmpty then
begin
sDllFileName := oADOQuery.FieldByName('TFWResourceFileName').AsString;
sFuncName := oADOQuery.FieldByName('FuncName').AsString;
end;
finally
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.Free;
end;
// 找不到动态库文件名和函数名。
if (Trim(sDllFileName) = '') or (Trim(sFuncName) = '') then
Exit;
hLibHandle := SafeLoadLibrary(PWideChar(cf_sysGetAppPath + sDllFileName));
if (FHandles <> nil) then
begin
FHandles.ADD(VarToStr(hLibHandle));
end;
try
if hLibHandle = 0 then
begin
cf_sysMsgBox('找不到指定的模块文件,请确认“' + sDllFileName + '”动态文件是否在应用程序目录下!',
MB_OK + MB_ICONERROR, 0);
Exit;
end;
@pLoadDllProc := GetProcAddress(hLibHandle, PWideChar(sFuncName));
if @pLoadDllProc <> nil then
begin
Result := pLoadDllProc(Application.Handle, FParentHandle, FForm,
FADOConnection, FUserCode, FPassWord, sFuncName);
end
else
begin
cf_sysMsgBox('请确认给定的“' + sDllFileName + '”是否存在“' + sFuncName +
'”函数功能!');
Result := 0;
end;
except
cf_sysLog('加载模块文件函数过程中失败! 错误位置:[' +
'function TDynamicOutLookMenu.LoadDll(sResourceCode: string): THandle;]');
end;
end;
// ******************************************************************************
// 类模块功能: 单击事件
// 类模块名称: TDynamicTreeMenu
// 类模块方法: ButtonItemOnClick
// 返回值: 无
// ******************************************************************************
procedure TDynamicOutLookMenu.ButtonItemOnClick(Sender: TObject);
var
sFuncName: string;
Item: TmxButton;
sResource_Code, sResourceFileName: string;
iResource_Type: Integer;
sPath: AnsiString;
begin
if not(Sender is TmxButton) then
Exit;
Item := (Sender as TmxButton);
sFuncName := pTreeNodeData(Item.Data).sDisplayField;
sResource_Code := pTreeNodeData(Item.Data).sID;
sResourceFileName := pTreeNodeData(Item.Data).sKeyField;
iResource_Type := StrToIntDef(pTreeNodeData(Item.Data).sData, -1);
try
// 更新模块 测试期间不要打开。否则无法测试DLL进程。
if FAutoUpdate then
cf_operUpdateDllFiles(FUserCode, FPassWord, sFuncName,
FADOConnection);
if goSysInfo.bIsModleDLL then
begin
// 更新模块 测试期间不要打开。否则无法测试DLL进程。
if FAutoUpdate then
cf_operUpdateDllFiles(FUserCode, FPassWord, sFuncName,
FADOConnection);
if not cf_ctrlFindOwerChildForm(FForm, 'frm' + sResource_Code) then
begin
LoadDll(sResource_Code);
end;
end
else
begin
if (iResource_Type = 1) then
begin
// 启用完整程序启动模式
cf_sysShowFormClass(FForm, FPageControl, sResourceFileName);
end
else if (iResource_Type = 5) then
begin
sPath := cf_sysGetAppPath + sFuncName;
WinExec(PAnsiChar(sPath), SW_SHOWNORMAL);
end;
end;
except
cf_sysLog('单击事件文件函数过程中失败! 错误位置:[' +
'procedure TDynamicOutLookMenu.ButtonItemOnClick(OutlookList: TfcCustomOutlookList;Item: TfcOutlookListItem);]');
end;
end;
{ TDynamicToolBar }
// ******************************************************************************
// 类模块功能: 建立快捷键
// 类模块名称: TDynamicToolBar
// 类模块方法: CreateToolBar
// 返回值: 无
// ******************************************************************************
procedure TDynamicToolBar.CreateToolBar;
var
oADOQuery: TADOQuery;
iCount: Integer;
oToolButton: TToolButton;
sSQL: string;
sPath: AnsiString;
begin
if FConStr = '' then
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) <> '')
then
begin
FConStr := goADOConDef.ConnectionString;
end
else
begin
cf_sysMsgBox('设计期错误,没有指定要创建菜单的窗体!', MB_OK + MB_ICONERROR);
Exit;
end;
end
else
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) = '')
then
begin
if goADOConDef.Connected then
goADOConDef.Connected := false;
goADOConDef.ConnectionString := FConStr;
goADOConDef.LoginPrompt := false;
if not goADOConDef.Connected then
goADOConDef.Open;
end
else if (goADOConDef = nil) and
(Trim(goADOConDef.ConnectionString) = '') then
begin
goADOConDef := TADOConnection(Application);
goADOConDef.LoginPrompt := false;
goADOConDef.ConnectionString := FConStr;
if not goADOConDef.Connected then
goADOConDef.Open;
end;
end;
if (FForm = nil) then
cf_sysMsgBox('设计期错误,没有指定要创建菜单的窗体!', MB_OK + MB_ICONERROR);
if (FToolBar = nil) then
cf_sysMsgBox('设计期错误,没有指定要创建的导航控件!', MB_OK + MB_ICONERROR);
if (Trim(FUserCode) = '') then
cf_sysMsgBox('设计期错误,没有指定创建菜单的权限用户编码!', MB_OK + MB_ICONERROR);
if (Trim(FPassWord) = '') then
cf_sysMsgBox('设计期错误,没有指定创建菜单的权限用户密码!', MB_OK + MB_ICONERROR);
if (FPageControl = nil) then
cf_sysMsgBox('设计期错误,没有指定创建菜单的权限用户密码!', MB_OK + MB_ICONERROR);
if (Trim(FConStr) <> '') and ((FADOConnection = nil) or
(Trim(FADOConnection.ConnectionString) = '')) then
begin
FADOConnection := TADOConnection.Create(nil);
FADOConnection.LoginPrompt := false;
FADOConnection.ConnectionString := FConStr;
if not FADOConnection.Connected then
FADOConnection.Open;
end
else if (Trim(FConStr) = '') and ((FADOConnection <> nil) and
(Trim(FADOConnection.ConnectionString) <> '')) then
begin
if not FADOConnection.Connected then
begin
FADOConnection.LoginPrompt := false;
FADOConnection.Connected := true;
end;
end;
// 检测用户合法性
if not cf_operCheckUser(FUserCode, FPassWord, FADOConnection, true) then
begin
cf_sysMsgBox('非法用户,不存在此用户或用户密码错误!');
Exit;
end;
// 查询用户所有资源权限信息。
if goSysInfo.bIsModleDLL then
begin
sSQL :=
'Select TFWUser_Code,PassWord,TFWResource_Code,TFWResource_PCode,Name, '
+
'TFWResourceFileName,FuncName,TFWResourceType_Code from VFWUserResource where TFWUser_Code=' + QuotedStr(Trim(FUserCode)) + ' and TFWResourceType_Code in (1,5)';
end
else
begin
sSQL :=
'Select TFWUser_Code,PassWord,TFWResource_Code,TFWResource_PCode,Name, '
+
'TFWResourceFileName,FuncName,TFWResourceType_Code from VFWUserResource where TFWUser_Code=' + QuotedStr(Trim(FUserCode)) + ' and TFWResourceType_Code in (1,5)';
end;
// 画分级导航。
oADOQuery := cf_dbSelectSQL(sSQL, FADOConnection);
if oADOQuery = nil then
Exit;
if not oADOQuery.IsEmpty then
begin
try
oADOQuery.First;
FToolBar.Images := FImageList;
FToolBar.ShowHint := true;
FToolBar.ShowCaptions := true;
FToolBar.Height := 36;
FToolBar.Transparent := false;
iCount := 0;
while not oADOQuery.Eof do
begin
Inc(iCount);
// 窗体模块
if oADOQuery.FieldByName('TFWResourceType_Code').AsInteger = 1 then
begin
oToolButton := TToolButton.Create(FToolBar);
try
oToolButton.Parent := FToolBar;
oToolButton.ImageIndex := iCount;
oToolButton.Name := 'tlbtn' + oADOQuery.FieldByName
('TFWResource_Code').AsString;
oToolButton.Caption := oADOQuery.FieldByName('Name')
.AsString + ' ';
oToolButton.Hint := oADOQuery.FieldByName('Name').AsString;
oToolButton.OnClick := ToolBarItemOnClick;
except
oToolButton.Free;
end;
end
else if oADOQuery.FieldByName('TFWResourceType_Code')
.AsInteger = 5 then
begin
oToolButton.Parent := FToolBar;
oToolButton.ImageIndex := iCount;
oToolButton.Name := 'tlbtn' + oADOQuery.FieldByName
('TFWResource_Code').AsString;
oToolButton.Caption := oADOQuery.FieldByName('Name')
.AsString + ' ';
oToolButton.Hint := oADOQuery.FieldByName('Name').AsString;
oToolButton.OnClick := ToolBarItemOnClick;
end;
oADOQuery.Next;
end;
except
cf_sysLog('建立快捷键函数过程中失败! 错误位置:[' +
'procedure TDynamicToolBar.CreateToolBar;]');
end;
end;
end;
// ******************************************************************************
// 类模块功能: 释放模块文件
// 类模块名称: TDynamicToolBar
// 类模块方法: Free
// 返回值: 无
// ******************************************************************************
procedure TDynamicToolBar.Free;
var
iCount: Integer;
begin
if FHandles <> nil then
begin
try
for iCount := 0 to FHandles.Count - 1 do
begin
try
if Longword(FHandles.Strings[iCount]) <> 0 then
FreeLibrary(Longword(FHandles.Strings[iCount]));
except
Continue;
end;
end;
except
cf_sysLog('释放模块文件函数过程中失败! 错误位置:[' +
'procedure TDynamicToolBar.Free;]');
end;
end;
end;
// ******************************************************************************
// 类模块功能: 加载模块文件
// 类模块名称: TDynamicToolBar
// 类模块方法: LoadDll
// 返回值: 无
// ******************************************************************************
function TDynamicToolBar.LoadDll(sResourceCode: string): THandle;
var
hLibHandle: THandle;
pLoadDllProc: TLoadDllProc;
sDllFileName, sFuncName, sSQL: string;
oADOQuery: TADOQuery;
iCount: Integer;
begin
Result := 0;
if (FADOConnection = nil) or (Trim(FADOConnection.ConnectionString) = '')
or (Trim(FUserCode) = '') or (Trim(FPassWord) = '') or
(Trim(sResourceCode) = '') then
Exit;
sSQL :=
'Select TFWResourceFileName,FuncName from VFWUserResource where TFWUser_Code='
+ QuotedStr(Trim(FUserCode)) + ' and TFWResource_Code=' + QuotedStr
(sResourceCode) + ' and PassWord=' + QuotedStr
(cf_valEncryptCodeA(Trim(FPassWord))) + ' and TFWResourceType_Code=1';
oADOQuery := TADOQuery.Create(nil);
try
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.Connection := FADOConnection;
oADOQuery.SQL.Clear;
oADOQuery.SQL.ADD(sSQL);
oADOQuery.Open;
if not oADOQuery.IsEmpty then
begin
sDllFileName := oADOQuery.FieldByName('TFWResourceFileName').AsString;
sFuncName := oADOQuery.FieldByName('FuncName').AsString;
end;
finally
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.Free;
end;
// 找不到动态库文件名和函数名。
if (Trim(sDllFileName) = '') or (Trim(sFuncName) = '') then
Exit;
hLibHandle := SafeLoadLibrary(PWideChar(cf_sysGetAppPath + sDllFileName));
if (FHandles <> nil) then
begin
FHandles.ADD(VarToStr(hLibHandle));
end;
try
if hLibHandle = 0 then
begin
cf_sysMsgBox('找不到指定的模块文件,请确认“' + sDllFileName + '”动态文件是否在应用程序目录下!',
MB_OK + MB_ICONERROR, 0);
Exit;
end;
@pLoadDllProc := GetProcAddress(hLibHandle, PWideChar(sFuncName));
if @pLoadDllProc <> nil then
begin
Result := pLoadDllProc(Application.Handle, FParentHandle, FForm,
FADOConnection, FUserCode, FPassWord, sFuncName);
end
else
begin
cf_sysMsgBox('请确认给定的“' + sDllFileName + '”是否存在“' + sFuncName +
'”函数功能!');
Result := 0;
end;
except
cf_sysLog('加载模块文件函数过程中失败! 错误位置:[' +
'function TDynamicToolBar.LoadDll(sResourceCode: string): THandle;]'
);
end;
end;
// ******************************************************************************
// 类模块功能: 单击事件
// 类模块名称: TDynamicToolBar
// 类模块方法: ToolBarItemOnClick
// 返回值: 无
// ******************************************************************************
procedure TDynamicToolBar.ToolBarItemOnClick(Sender: TObject);
var
sSQL, sButtonCode: string;
oADOQuery: TADOQuery;
hHandle: THandle;
sPath: AnsiString;
begin
// 按钮ID号
sButtonCode := Copy(TToolButton(Sender).Name, Length('tlbtn') + 1, Length
(TToolButton(Sender).Name));
if sButtonCode = '' then
Exit;
if (Trim(FConStr) <> '') and ((FADOConnection = nil) or
(Trim(FADOConnection.ConnectionString) = '')) then
begin
FADOConnection := TADOConnection.Create(nil);
FADOConnection.LoginPrompt := false;
FADOConnection.ConnectionString := FConStr;
if not FADOConnection.Connected then
FADOConnection.Open;
end
else if (Trim(FConStr) = '') and ((FADOConnection <> nil) and
(Trim(FADOConnection.ConnectionString) <> '')) then
begin
if not FADOConnection.Connected then
begin
FADOConnection.LoginPrompt := false;
FADOConnection.Connected := true;
end;
end;
oADOQuery := TADOQuery.Create(nil);
try
try
oADOQuery.Connection := FADOConnection;
oADOQuery.SQL.Clear;
sSQL :=
'Select TFWUser_Code,PassWord,TFWResource_Code,TFWResource_PCode,Name, '
+ 'TFWResourceFileName,FuncName,TFWResourceType_Code from VFWUserResource Where TFWResource_Code=' + QuotedStr(sButtonCode);
oADOQuery.SQL.ADD(sSQL);
oADOQuery.Open;
if (not oADOQuery.IsEmpty) or (oADOQuery.RecordCount > 0) then
begin
oADOQuery.First;
if goSysInfo.bIsModleDLL then
begin
// 更新模块 测试期间不要打开。否则无法测试DLL进程。
if FAutoUpdate then
cf_operUpdateDllFiles(FUserCode, FPassWord,
oADOQuery.FieldByName('FuncName').AsString, FADOConnection);
if not cf_ctrlFindOwerChildForm(FForm, 'frm' + sButtonCode) then
begin
hHandle := LoadDll(sButtonCode);
end;
end
else
begin
if oADOQuery.FieldByName('TFWResourceType_Code')
.AsInteger = 1 then
begin
// 启用完整程序启动模式
cf_sysShowFormClass(FForm, FPageControl, oADOQuery.FieldByName
('TFWResourceFileName').AsString);
end
else if oADOQuery.FieldByName('TFWResourceType_Code')
.AsInteger = 5 then
begin
sPath := cf_sysGetAppPath + oADOQuery.FieldByName('FuncName')
.AsString;
WinExec(PAnsiChar(sPath), SW_SHOWNORMAL);
end;
end;
end;
except
cf_sysLog('单击事件函数过程中失败! 错误位置:[' +
'procedure TDynamicToolBar.ToolBarItemOnClick(Sender: TObject);]'
);
end;
finally
oADOQuery.Free;
end;
end;
{ TDynamicBLTree }
// ******************************************************************************
// 类模块功能: 异步执行数据。用于循环。
// 类模块名称: TDynamicBLTree
// 类模块方法: Clear
// 返回值: 无
// ******************************************************************************
procedure TDynamicBLTree.AsynchData;
begin
// 暂时无处理操作
end;
// ******************************************************************************
// 类模块功能: 清空子项
// 类模块名称: TDynamicBLTree
// 类模块方法: Clear
// 返回值: 无
// ******************************************************************************
procedure TDynamicBLTree.Clear;
begin
// 清空所有节点。
try
FTreeView.Items.Clear;
except
cf_sysLog('清空子项函数过程中失败! 错误位置:[' + 'procedure TDynamicBLTree.Clear;]');
end;
end;
// ******************************************************************************
// 类模块功能: 线程执行。
// 类模块名称: TDynamicBLTree
// 类模块方法: Execute
// 返回值: 无
// ******************************************************************************
procedure TDynamicBLTree.Execute;
begin
try
// 同步执行
Synchronize(SynchData);
// 异步执行
AsynchData;
except
cf_sysLog('线程执行函数过程中失败! 错误位置:[' + 'procedure TDynamicBLTree.Execute;]');
end;
end;
// ******************************************************************************
// 类模块功能: 查找相关信息，刷新树。
// 类模块名称: TDynamicBLTree
// 类模块方法: FindNodesInfo
// 返回值: 无
// ******************************************************************************
function TDynamicBLTree.FindNodesInfo: Boolean;
var
oTreeNode: TTreeNode;
iFind: Integer;
begin
Result := false;
// 都为空
if (Trim(FFindVessel) = '') and (Trim(FFindVoyage) = '') and
(Trim(FFindBlNo) = '') then
begin
Exit;
end;
try
// 循环遍历
for iFind := 0 to FTreeView.Items.Count - 1 do
begin
// 当前循环的节点。
oTreeNode := FTreeView.Items[iFind];
// PARENT NODE DATA: VESSELCODE,DESCRIPTIONCN,VOYAGEID,VOYAGE,IE,ISCHG,ISFINISHVESSEL,ISLOCKED
// SELF NODE DATA: BillInfoID,MBIllID,CNTRDESC,BLNO,MBLNO,ISLOCKBL
// 分支判断。
if (Trim(FFindVessel) <> '') and (Trim(FFindVoyage) = '') and
(Trim(FFindBlNo) = '') then
begin // 船名-第一层
// 找到此船名信息。
if (Pos(FFindVessel, cf_valGetStrPosStr
(pTreeNodeData(oTreeNode.Data).sData, 1)) > 0) or
(Pos(FFindVessel, cf_valGetStrPosStr(pTreeNodeData(oTreeNode.Data)
.sData, 2)) > 0) then
begin
FTreeView.Items[iFind].Selected := true;
Result := true;
Exit;
end;
end
else if (Trim(FFindVessel) = '') and (Trim(FFindVoyage) <> '') and
(Trim(FFindBlNo) = '') then
begin // 航次-第一层
if (Pos(FFindVoyage, cf_valGetStrPosStr
(pTreeNodeData(oTreeNode.Data).sData, 3)) > 0) or
(Pos(FFindVoyage, cf_valGetStrPosStr(pTreeNodeData(oTreeNode.Data)
.sData, 4)) > 0) then
begin
FTreeView.Items[iFind].Selected := true;
Result := true;
Exit;
end;
end
else if (Trim(FFindVessel) = '') and (Trim(FFindVoyage) = '') and
(Trim(FFindBlNo) <> '') then
begin // 提单-第二层
if (Pos(FFindBlNo, cf_valGetStrPosStr(pTreeNodeData(oTreeNode.Data)
.sData, 4)) > 0) then
begin
FTreeView.Items[iFind].Selected := true;
Result := true;
Exit;
end;
end
else if (Trim(FFindVessel) <> '') and (Trim(FFindVoyage) <> '') and
(Trim(FFindBlNo) = '') then
begin // 船名航次-第一层
if ((Pos(FFindVessel, cf_valGetStrPosStr(pTreeNodeData
(oTreeNode.Data).sData, 1)) > 0) or
(Pos(FFindVessel, cf_valGetStrPosStr(pTreeNodeData
(oTreeNode.Data).sData, 2)) > 0)) and
((Pos(FFindVoyage, cf_valGetStrPosStr(pTreeNodeData
(oTreeNode.Data).sData, 3)) > 0) or
(Pos(FFindVoyage, cf_valGetStrPosStr(pTreeNodeData
(oTreeNode.Data).sData, 4)) > 0)) then
begin
FTreeView.Items[iFind].Selected := true;
Result := true;
Exit;
end;
end
else if (Trim(FFindVessel) = '') and (Trim(FFindVoyage) <> '') and
(Trim(FFindBlNo) <> '') then
begin // 航次提单-第一二层
if (oTreeNode.Level = 1) and
((oTreeNode.Parent as TTreeNode) <> nil) then
begin
if ((Pos(FFindVoyage, cf_valGetStrPosStr(pTreeNodeData
((oTreeNode.Parent as TTreeNode).Data).sData, 3)) > 0)
or (Pos(FFindVoyage, cf_valGetStrPosStr(pTreeNodeData
((oTreeNode.Parent as TTreeNode)).sData, 4)) > 0)) and
(Pos(FFindBlNo, cf_valGetStrPosStr(pTreeNodeData(oTreeNode.Data)
.sData, 4)) > 0) then
begin
FTreeView.Items[iFind].Selected := true;
Result := true;
Exit;
end;
end;
end
else if (Trim(FFindVessel) <> '') and (Trim(FFindVoyage) = '') and
(Trim(FFindBlNo) <> '') then
begin // 船名提单-第一二层
if (oTreeNode.Level = 1) and
((oTreeNode.Parent as TTreeNode) <> nil) then
begin
if ((Pos(FFindVessel, cf_valGetStrPosStr(pTreeNodeData
((oTreeNode.Parent as TTreeNode).Data).sData, 1)) > 0)
or (Pos(FFindVessel, cf_valGetStrPosStr(pTreeNodeData
((oTreeNode.Parent as TTreeNode)).sData, 2)) > 0)) and
(Pos(FFindBlNo, cf_valGetStrPosStr(pTreeNodeData(oTreeNode.Data)
.sData, 4)) > 0) then
begin
FTreeView.Items[iFind].Selected := true;
Result := true;
Exit;
end;
end;
end
else if (Trim(FFindVessel) <> '') and (Trim(FFindVoyage) <> '') and
(Trim(FFindBlNo) <> '') then
begin // 船名航次提单-第一二层
if (oTreeNode.Level = 1) and
((oTreeNode.Parent as TTreeNode) <> nil) then
begin
if ((Pos(FFindVessel, cf_valGetStrPosStr(pTreeNodeData
((oTreeNode.Parent as TTreeNode).Data).sData, 1)) > 0)
or (Pos(FFindVessel, cf_valGetStrPosStr(pTreeNodeData
((oTreeNode.Parent as TTreeNode)).sData, 2)) > 0)) and
((Pos(FFindVoyage, cf_valGetStrPosStr(pTreeNodeData
((oTreeNode.Parent as TTreeNode).Data).sData, 3)) > 0)
or (Pos(FFindVoyage, cf_valGetStrPosStr(pTreeNodeData
((oTreeNode.Parent as TTreeNode)).sData, 4)) > 0)) and
(Pos(FFindBlNo, cf_valGetStrPosStr(pTreeNodeData(oTreeNode.Data)
.sData, 4)) > 0) then
begin
FTreeView.Items[iFind].Selected := true;
Result := true;
Exit;
end;
end;
end;
end;
except
Result := false;
cf_sysLog('查找相关信息函数过程中失败! 错误位置:[' +
'function TDynamicBLTree.FindNodesInfo: Boolean;]');
end;
end;
// ******************************************************************************
// 类模块功能: 选择节点返回数据信息。
// 类模块名称: TDynamicBLTree
// 类模块方法: OnChanging
// 返回值: 无
// ******************************************************************************
procedure TDynamicBLTree.OnChanging(Sender: TObject; Node: TTreeNode;
var AllowChange: Boolean);
var
sParentData, sSelfData: string;
begin
// 清空变量。
FVesselCode := '';
FVesselName := '';
FVoyageID := '';
FVoyageName := '';
FIO := '';
FIsFinishedVessel := '';
FIsLock := '';
FBlID := '';
FBlNo := '';
FMBlID := '';
FMBlNo := '';
FIsLockBl := '';
try
if Node <> nil then
begin
FSelectLevel := Node.Level;
// PARENT NODE DATA: VESSELCODE,DESCRIPTIONCN,VOYAGEID,VOYAGE,IE,ISCHG,ISFINISHVESSEL,ISLOCKED
// SELF NODE DATA: BillInfoID,MBIllID,CNTRDESC,BLNO,MBLNO,ISLOCKBL
// 判断层次. (第一层）
if Node.Level = 0 then
begin
// 数据
sParentData := pTreeNodeData(Node.Data).sData;
FVesselCode := cf_valGetStrPosStr(sParentData, 1);
FVesselName := cf_valGetStrPosStr(sParentData, 2);
FVoyageID := cf_valGetStrPosStr(sParentData, 3);
FVoyageName := cf_valGetStrPosStr(sParentData, 4);
FIO := cf_valGetStrPosStr(sParentData, 5);
FIsFinishedVessel := cf_valGetStrPosStr(sParentData, 7);
FIsLock := cf_valGetStrPosStr(sParentData, 8);
end
else if Node.Level = 1 then
begin
if (Node.Parent <> nil) then
begin
// 数据
sParentData := pTreeNodeData((Node.Parent as TTreeNode).Data)
.sData;
FVesselCode := cf_valGetStrPosStr(sParentData, 1);
FVesselName := cf_valGetStrPosStr(sParentData, 2);
FVoyageID := cf_valGetStrPosStr(sParentData, 3);
FVoyageName := cf_valGetStrPosStr(sParentData, 4);
FIO := cf_valGetStrPosStr(sParentData, 5);
FIsFinishedVessel := cf_valGetStrPosStr(sParentData, 7);
FIsLock := cf_valGetStrPosStr(sParentData, 8);
end;
// 第二层
sSelfData := pTreeNodeData(Node.Data).sData;
FBlID := cf_valGetStrPosStr(sSelfData, 1);
FBlNo := cf_valGetStrPosStr(sSelfData, 4);
FMBlID := cf_valGetStrPosStr(sSelfData, 2);
FMBlNo := cf_valGetStrPosStr(sSelfData, 5);
FIsLockBl := cf_valGetStrPosStr(sSelfData, 6);
end;
end;
except
cf_sysLog('选择节点返回数据信息函数过程中失败! 错误位置:[' +
'procedure TDynamicBLTree.OnChanging(Sender: TObject; Node: TTreeNode;var AllowChange: Boolean);]');
end;
end;
// ******************************************************************************
// 类模块功能: 线程执行同步过程。
// 类模块名称: TDynamicBLTree
// 类模块方法: SynchData
// 返回值: 同步数据过程。
// ******************************************************************************
procedure TDynamicBLTree.SynchData;
var
sSQL, sSqlSec, sCondition: string;
pNodeData, pNodeDataSec: pTreeNodeData;
oTreeNode: TTreeNode;
oADOQuery, oADOQuerySec: TADOQuery;
iFieldCount, iIndex: Integer;
begin
if (FADOConnection = nil) or (Trim(FADOConnection.ConnectionString) = '')
then
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) <> '')
then
begin
FADOConnection := goADOConDef;
end
else
begin
Exit;
end;
end
else
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) = '')
then
begin
if goADOConDef.Connected then
goADOConDef.Connected := false;
goADOConDef.ConnectionString := FADOConnection.ConnectionString;
goADOConDef.LoginPrompt := false;
if not goADOConDef.Connected then
goADOConDef.Open;
end
else if (goADOConDef = nil) and
(Trim(goADOConDef.ConnectionString) = '') then
begin
goADOConDef := TADOConnection(Application);
goADOConDef.LoginPrompt := false;
goADOConDef.ConnectionString := FADOConnection.ConnectionString;
if not goADOConDef.Connected then
goADOConDef.Open;
end;
end;
if (FForm = nil) then
cf_sysMsgBox('设计期错误,没有指定要创建菜单的窗体!', MB_OK + MB_ICONERROR);
if (FTreeView = nil) then
cf_sysMsgBox('设计期错误,没有指定要创建的树形控件!', MB_OK + MB_ICONERROR);
if ((FADOConnection = nil) or (Trim(FADOConnection.ConnectionString) = '')
) then
cf_sysMsgBox('设计期错误,没有指定数据库连接信息!', MB_OK + MB_ICONERROR);
// 设置是否清空菜单子项。
if FFirstClear then
FTreeView.Items.Clear;
{ *
[VCodeVesselVoyage] 视图明细:
SELECT vs.VESSELCODE, vs.DESCRIPTIONCN, vy.VOYAGEID, vy.VOYAGE, vy.IE, vy.ISCHG, vy.ISFINISHVESSEL, vy.ISLOCKED
FROM dbo.TCodeVESSEL AS vs LEFT OUTER JOIN dbo.TCodeVOYAGE AS vy ON vs.VESSELCODE = vy.VESSELCODE
* }
// 出口
if FInOutPort = btOutPort then
begin
sCondition := sCondition + ' and (IE=' + QuotedStr('E') + ')';
end
else if FInOutPort = btInPort then
// 进口。
begin
sCondition := sCondition + ' and (IE=' + QuotedStr('I') + ')';
end;
// 是否完船
if (FFinishedVessel = bfvUnFinished) then
begin // 未完船
sCondition := sCondition + ' and (ISFINISHVESSEL=' + QuotedStr('N')
+ ' OR ISFINISHVESSEL IS NULL)';
end
else if (FFinishedVessel = bfvFinished) then
begin // 完船
sCondition := sCondition + ' and (ISFINISHVESSEL=' + QuotedStr('Y')
+ ')';
end
else if (FFinishedVessel = bfvAll) then
begin // 所有
sCondition := sCondition + '';
end;
sSQL :=
'Select VESSELCODE,DESCRIPTIONCN,VOYAGEID,VOYAGE,IE,ISCHG,ISFINISHVESSEL,'
+ 'ISLOCKED from VCodeVesselVoyage Where 1=1' + sCondition;
// 画分级树。
oADOQuery := TADOQuery.Create(nil);
oADOQuerySec := TADOQuery.Create(nil);
FTreeView.Items.BeginUpdate;
// 设置图标列表对象。
FTreeView.Images := FImageList;
try
try
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.SQL.Clear;
oADOQuery.Connection := FADOConnection;
oADOQuery.SQL.ADD(sSQL);
oADOQuery.Open;
if not oADOQuery.IsEmpty then
begin
oADOQuery.First;
oTreeNode := nil;
while not oADOQuery.Eof do
begin
pNodeData := New(pTreeNodeData);
pNodeData.sID := oADOQuery.FieldByName('VESSELCODE').AsString;
pNodeData.sPID := oADOQuery.FieldByName('VOYAGEID').AsString;
pNodeData.sKeyField := oADOQuery.FieldByName('VESSELCODE')
.AsString;
// 判断是否锁定
if UpperCase((Trim(oADOQuery.FieldByName('ISLOCKED').AsString)))
= 'Y' then
begin
pNodeData.sDisplayField := '(' + oADOQuery.FieldByName
('DESCRIPTIONCN').AsString + '/' + oADOQuery.FieldByName
('VOYAGE').AsString + '|锁定)';
end
else
begin
pNodeData.sDisplayField := oADOQuery.FieldByName
('DESCRIPTIONCN').AsString + '/' + oADOQuery.FieldByName
('VOYAGE').AsString;
end;
// 所有数据列
for iFieldCount := 0 to oADOQuery.FieldCount - 1 do
begin
pNodeData.sData := pNodeData.sData + oADOQuery.Fields
[iFieldCount].AsString + CONST_VAL_SPLIT;
end;
oTreeNode := FTreeView.Items.AddObject
(oTreeNode, pNodeData.sDisplayField, pNodeData);
// 改航次下的提单
sSqlSec :=
'Select BillInfoID,MBIllID,CNTRDESC,BLNO,MBLNO,ISLOCKBL from TBillInfo Where VoyageID=' + QuotedStr(pNodeData.sPID);
if oADOQuerySec.Active then
oADOQuerySec.Close;
oADOQuerySec.SQL.Clear;
oADOQuerySec.Connection := FADOConnection;
oADOQuerySec.SQL.ADD(sSqlSec);
oADOQuerySec.Open;
if not oADOQuerySec.IsEmpty then
begin
oADOQuerySec.First;
while not oADOQuerySec.Eof do
begin
pNodeDataSec := New(pTreeNodeData);
pNodeDataSec.sID := pNodeData.sID;
pNodeDataSec.sPID := pNodeData.sPID;
pNodeDataSec.sKeyField := pNodeData.sKeyField;
// 判断是否锁定
if (Trim(oADOQuerySec.FieldByName('MBLNO').AsString))
<> '' then
begin
pNodeDataSec.sDisplayField := oADOQuerySec.FieldByName
('BLNO').AsString + '[' + oADOQuerySec.FieldByName
('MBLNO').AsString + ']';
end
else
begin
pNodeDataSec.sDisplayField := oADOQuerySec.FieldByName
('BLNO').AsString;
end;
// 所有数据列
for iFieldCount := 0 to oADOQuerySec.FieldCount - 1 do
begin
pNodeDataSec.sData :=
pNodeDataSec.sData + oADOQuerySec.Fields[iFieldCount]
.AsString + CONST_VAL_SPLIT;
end;
FTreeView.Items.AddChildObject
(oTreeNode, pNodeDataSec.sDisplayField, pNodeDataSec);
oADOQuerySec.Next;
end;
end;
oADOQuery.Next;
end;
FTreeView.OnChanging := OnChanging;
end;
except
cf_sysLog('线程执行同步过程函数过程中失败! 错误位置:[' +
'procedure TDynamicBLTree.SynchData;]');
end;
finally
oADOQuery.Free;
oADOQuerySec.Free;
FTreeView.Items.EndUpdate;
end;
end;
{ TDynamicPopMenu }
procedure TDynamicPopMenu.Clear;
begin
if FPopupMenu <> nil then
begin
FPopupMenu.Items.Clear;
end;
end;
procedure TDynamicPopMenu.CreatePopupMenu;
var
sSQL, sTest: string;
oMenuItem, oPMenuItem: TMenuItem;
oADOQuery: TADOQuery;
iResourceType: Integer;
begin
sTest := '';
if (FForm = nil) then
cf_sysMsgBox('设计期错误,没有指定要创建菜单的窗体!', MB_OK + MB_ICONERROR);
if (FPopupMenu = nil) then
cf_sysMsgBox('设计期错误,没有指定要创建的菜单!', MB_OK + MB_ICONERROR);
if FConStr = '' then
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) <> '')
then
begin
FConStr := goADOConDef.ConnectionString;
end
else
begin
cf_sysMsgBox('设计期错误,没有指定要创建菜单的窗体!', MB_OK + MB_ICONERROR);
Exit;
end;
end
else
begin
if (goADOConDef <> nil) and (Trim(goADOConDef.ConnectionString) = '')
then
begin
if goADOConDef.Connected then
goADOConDef.Connected := false;
goADOConDef.ConnectionString := FConStr;
goADOConDef.LoginPrompt := false;
if not goADOConDef.Connected then
goADOConDef.Open;
end
else if (goADOConDef = nil) and
(Trim(goADOConDef.ConnectionString) = '') then
begin
goADOConDef := TADOConnection(Application);
goADOConDef.LoginPrompt := false;
goADOConDef.ConnectionString := FConStr;
if not goADOConDef.Connected then
goADOConDef.Open;
end;
end;
if (Trim(FConStr) = '') and ((FADOConnection = nil) or
(Trim(FADOConnection.ConnectionString) = '')) then
cf_sysMsgBox('设计期错误,没有指定数据库连接信息!', MB_OK + MB_ICONERROR);
if (Trim(FUserCode) = '') then
cf_sysMsgBox('设计期错误,没有指定创建菜单的权限用户编码!', MB_OK + MB_ICONERROR);
if (Trim(FPassWord) = '') then
cf_sysMsgBox('设计期错误,没有指定创建菜单的权限用户密码!', MB_OK + MB_ICONERROR);
if (FPageControl = nil) then
cf_sysMsgBox('设计期错误,没有指定创建菜单的权限用户密码!', MB_OK + MB_ICONERROR);
if (Trim(FConStr) <> '') and ((FADOConnection = nil) or
(Trim(FADOConnection.ConnectionString) = '')) then
begin
FADOConnection := goADOConDef;
if not FADOConnection.Connected then
FADOConnection.Open;
end
else if (Trim(FConStr) = '') and ((FADOConnection <> nil) and
(Trim(FADOConnection.ConnectionString) <> '')) then
begin
if not FADOConnection.Connected then
begin
FADOConnection.LoginPrompt := false;
FADOConnection.Connected := true;
end;
end;
// 设置样式
FPageControl.ShowCloseButton := true;
FPageControl.ShowCloseButtonOnActiveTab := true;
// 检测用户合法性
if not cf_operCheckUser(FUserCode, FPassWord, FADOConnection, true) then
begin
cf_sysMsgBox('非法用户,不存在此用户或用户密码错误!');
Exit;
end;
// 设置是否清空菜单子项。
if FFirstClear then
FPopupMenu.Items.Clear;
// 查询用户所有资源权限信息。
if goSysInfo.bIsModleDLL then
begin
sSQL :=
'Select TFWUser_Code,PassWord,TFWResource_Code,TFWResource_PCode,Name, '
+ 'TFWResourceFileName,FuncName,TFWResourceType_Code from VFWUserResource where TFWUser_Code=' + QuotedStr(Trim(FUserCode)) + ' Order By OrderNo';
end
else
begin
sSQL :=
'Select TFWUser_Code,PassWord,TFWResource_Code,TFWResource_PCode,Name, '
+ 'TFWResourceFileName,FuncName,TFWResourceType_Code from VFWUserResource where TFWUser_Code=' + QuotedStr(Trim(FUserCode)) + ' Order By OrderNo';
end;
oADOQuery := cf_dbSelectSQL(sSQL, FADOConnection);
if oADOQuery = nil then
Exit;
try
try
if not oADOQuery.IsEmpty then
begin
oADOQuery.First;
FHandles := TStringList.Create;
while not oADOQuery.Eof do
begin
oMenuItem := TMenuItem.Create(FForm);
// 菜单名称采用资源编码
oMenuItem.Name := 'pmn' + oADOQuery.FieldByName
('TFWResource_Code').AsString;
// 菜单显示资源类型
iResourceType := oADOQuery.FieldByName('TFWResourceType_Code')
.AsInteger;
// 0:模块; 1:窗体;2:控件;3:分割线;4:其它;5命令
// 菜单内容显示资源名
if iResourceType = 3 then
begin
oMenuItem.Caption := '-';
end
else if ((iResourceType = 0) or (iResourceType = 1) or
(iResourceType = 5)) then
begin
oMenuItem.Caption := oADOQuery.FieldByName('Name').AsString;
end;
// 新增子菜单
oPMenuItem := cf_ctrlFindMenuItem('pmn' + oADOQuery.FieldByName
('TFWResource_PCode').AsString, FForm);
if oPMenuItem <> nil then
begin
oPMenuItem.ADD(oMenuItem);
if (iResourceType = 1) or (iResourceType = 5) then
begin
sTest := oMenuItem.Caption;
oMenuItem.OnClick := PopupItemOnClick;
end;
end
else
begin
// 新增父菜单
FPopupMenu.Items.ADD(oMenuItem);
sTest := oMenuItem.Caption;
end;
oADOQuery.Next;
end;
end;
except
cf_sysLog('建立动态菜单函数过程失败! 错误位置:[' +
'procedure TDynamicPopMenu.CreatePopupMenu;]');
end;
finally
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.Free;
end;
end;
procedure TDynamicPopMenu.Free;
var
iCount: Integer;
begin
if FHandles <> nil then
begin
try
for iCount := 0 to FHandles.Count - 1 do
begin
try
if Longword(FHandles.Strings[iCount]) <> 0 then
FreeLibrary(Longword(FHandles.Strings[iCount]));
except
Continue;
end;
end;
except
cf_sysLog('释放相关的模块句柄函数过程失败! 错误位置:[' +
'procedure TDynamicPopMenu.Free;]');
end;
end;
end;
function TDynamicPopMenu.LoadDll(hHandle, hParentHandle: THandle;
oForm: TForm; oADOConnection: TADOConnection; sUserCode, sPassWord,
sResourceCode: string): THandle;
var
hLibHandle: THandle;
pLoadDllProc: TLoadDllProc;
sDllFileName, sFuncName, sSQL: string;
oADOQuery: TADOQuery;
iCount: Integer;
begin
Result := 0;
if (oADOConnection = nil) or (Trim(oADOConnection.ConnectionString) = '')
or (Trim(sUserCode) = '') or (Trim(sPassWord) = '') or
(Trim(sResourceCode) = '') then
Exit;
sSQL :=
'Select TFWResourceFileName,FuncName from VFWUserResource where TFWUser_Code='
+ QuotedStr(Trim(sUserCode)) + ' and TFWResource_Code=' + QuotedStr
(sResourceCode) + ' and PassWord=' + QuotedStr
(cf_valEncryptCodeA(Trim(sPassWord))) + ' and TFWResourceType_Code=1';
oADOQuery := TADOQuery.Create(nil);
try
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.Connection := oADOConnection;
oADOQuery.SQL.Clear;
oADOQuery.SQL.ADD(sSQL);
oADOQuery.Open;
if not oADOQuery.IsEmpty then
begin
sDllFileName := oADOQuery.FieldByName('TFWResourceFileName').AsString;
sFuncName := oADOQuery.FieldByName('FuncName').AsString;
end;
finally
if oADOQuery.Active then
oADOQuery.Close;
oADOQuery.Free;
end;
// 找不到动态库文件名和函数名。
if (Trim(sDllFileName) = '') or (Trim(sFuncName) = '') then
Exit;
hLibHandle := SafeLoadLibrary(PWideChar(cf_sysGetAppPath + sDllFileName));
if (FHandles <> nil) then
begin
FHandles.ADD(VarToStr(hLibHandle));
end;
try
if hLibHandle = 0 then
begin
cf_sysMsgBox('找不到指定的模块文件,请确认“' + sDllFileName + '”动态文件是否在应用程序目录下!',
MB_OK + MB_ICONERROR, 0);
Exit;
end;
@pLoadDllProc := GetProcAddress(hLibHandle, PWideChar(sFuncName));
if @pLoadDllProc <> nil then
begin
Result := pLoadDllProc(hHandle, hParentHandle, oForm, oADOConnection,
sUserCode, sPassWord, sFuncName);
end
else
begin
cf_sysMsgBox('请确认给定的“' + sDllFileName + '”是否存在“' + sFuncName +
'”函数功能!');
Result := 0;
end;
except
cf_sysLog('给相应的控件加载模块时失败! 错误位置:[' +
'function TDynamicPopMenu.LoadDll(hHandle, hParentHandle: THandle;'
+ 'oForm: TForm; oADOConnection: TADOConnection; ' +
'sUserCode, sPassWord, sResourceCode: string): THandle;]');
end;
end;
procedure TDynamicPopMenu.PopupItemOnClick(Sender: TObject);
var
sSQL, sMenuCode: string;
oADOQuery: TADOQuery;
hHandle: THandle;
sPath: AnsiString;
begin
// 菜单ID号
sMenuCode := Copy(TMenuItem(Sender).Name, Length('pmn') + 1, Length
(TMenuItem(Sender).Name));
if sMenuCode = '' then
Exit;
if (Trim(FConStr) <> '') and ((FADOConnection = nil) or
(Trim(FADOConnection.ConnectionString) = '')) then
begin
FADOConnection := TADOConnection.Create(nil);
FADOConnection.LoginPrompt := false;
FADOConnection.ConnectionString := FConStr;
if not FADOConnection.Connected then
FADOConnection.Open;
end
else if (Trim(FConStr) = '') and ((FADOConnection <> nil) and
(Trim(FADOConnection.ConnectionString) <> '')) then
begin
if not FADOConnection.Connected then
begin
FADOConnection.LoginPrompt := false;
FADOConnection.Connected := true;
end;
end;
oADOQuery := TADOQuery.Create(nil);
try
try
oADOQuery.Connection := FADOConnection;
oADOQuery.SQL.Clear;
sSQL :=
'Select TFWUser_Code,PassWord,TFWResource_Code,TFWResource_PCode,Name, '
+ 'TFWResourceFileName,FuncName,TFWResourceType_Code from VFWUserResource Where TFWResource_Code=' + QuotedStr(sMenuCode);
oADOQuery.SQL.ADD(sSQL);
oADOQuery.Open;
if (not oADOQuery.IsEmpty) or (oADOQuery.RecordCount > 0) then
begin
oADOQuery.First;
if goSysInfo.bIsModleDLL then
begin
// 更新模块 测试期间不要打开。否则无法测试DLL进程。
if FAutoUpdate then
cf_operUpdateDllFiles(FUserCode, FPassWord,
oADOQuery.FieldByName('FuncName').AsString, FADOConnection);
if not cf_ctrlFindOwerChildForm(FForm, 'frm' + sMenuCode) then
begin
hHandle := LoadDll(Application.Handle, FParentHandle, FForm,
FADOConnection, FUserCode, FPassWord, sMenuCode);
end;
end
else
begin
if (oADOQuery.FieldByName('TFWResourceType_Code').AsInteger = 1)
then
begin
// 启用完整程序启动模式
cf_sysShowFormClass(FForm, FPageControl, oADOQuery.FieldByName
('TFWResourceFileName').AsString);
end
else if (oADOQuery.FieldByName('TFWResourceType_Code')
.AsInteger = 5) then
begin
sPath := cf_sysGetAppPath + oADOQuery.FieldByName('FuncName')
.AsString;
WinExec(PAnsiChar(sPath), SW_SHOWNORMAL);
end;
end;
end;
except
cf_sysLog('给相应的控件加载事件时失败! 错误位置:[' +
'procedure TDynamicPopMenu.PopupItemOnClick(Sender: TObject);]');
end;
finally
oADOQuery.Free;
end;
end;
end.
自己搜集编写的Delphi 通用函数相关推荐
- Delphi环境中编写调用DLL的方法和技巧
Delphi环境中编写调用DLL的方法和技巧 第一章 为什么要使用动态链接库(DLL) top 提起DLL您一定不会陌生,在Windows中有着大量的以DLL为后缀的文件,它们是保证Windows正常 ...
- Delphi程序之多语言支持
最近在做一个多语言的项目,感想颇深,写出来与大家分享. 首先抱怨一下,谁让这个程序是Delphi的呢,用C#或者Java写根本不会有那么多问题,唉...... 1.现状 Delphi直到2007才支持 ...
- Delphi中使用SQLite3（一）
SQLite,是一款轻型的数据库,是遵守ACID的关系型数据库管理系统,它的设计目标是嵌入式的,而且目前已经在很多嵌入式产品中使用了它,它占用资源非常的低,在嵌入式设备中,可能只需要几百K的内存就够了 ...
- 在Delphi中调用外部DLL 之External DLL 导入DLL
调用一个DLL比写一个DLL要容易一些.首先给大家介绍的是静态调用方法,稍后将介绍动态调用方法,并就两种方法做一个比较.同样的,我们先举一个静态调用的例子. unit Unit1;interfaceu ...
- 按属性值对对象数组进行排序
我使用AJAX获得了以下对象并将它们存储在数组中: var homes = [{"h_id": "3","city": "Dall ...
- 病毒加壳技术与脱壳杀毒方法解析
壳是什么?脱壳又是什么?这是很多经常感到迷惑和经常提出的问题,其实这个问题一点也不幼稚.当你想听说脱壳这个名词并试着去了解的时候,说明你已经在各个安全站点很有了一段日子了.下面,我们进入"壳 ...
- 2005年10月--至今 开发过的项目
分享一下我老师大神的人工智能教程!零基础,通俗易懂!http://blog.csdn.net/jiangjunshow 也欢迎大家转载本篇文章.分享知识,造福人民,实现我们中华民族伟大复兴! ==== ...
- 2005年10月--至今,开发过的项目
=====武汉智远科技有限公司============================================ 1.2005 年10月 -2006年 2月 << 面向用户的网络性能 ...
- 软件壳的概念和如何脱壳基础
在自然界中,我想大家对壳这东西应该都不会陌生了,由上述故事,我们也可见一斑.自然界中植物用它来保护种子,动物用它来保护身体等等.同样,在一些计算机软件里也有一段专门负责保护软件不被非法修改或反编译的程 ...
最新文章
- 产品打包工具的制作，ant,编译源码，打jar包，打tag，打war包，备份release版本等...
- “计量确认”与“检定”之区别
- 用Go重构WEB请求分析跟踪服务
- SpringBoot_配置-外部配置加载顺序
- PrimeTime指南——概述和基本流程
- wireshark提取流量包中的文件_[技术]Wireshark抓取的数据包提取文件
- 【Kafka】Kafka 使用 Twitter 的 Bijection 类库实现 avro 的序列化与反序列化
- (最完美)小米手机5s的USB调试模式在哪里打开的方法
- python中从键盘输入的代码_python如何从键盘获取输入实例
- mvn install跳过测试
- highchart 曲线图
- Python基础语法知识点汇集
- AM437x——LED裸机
- 初探OAuth2.0第三方认证登录
- 【低代码】云端组态集成与设备管理配置
- 在php中调用接口以及编写接口
- python如何微信公众号刷票_问卷星刷票
- 写论文文章之怎么写引言
- 中国增长最快的机器人市场——IFR《世界机器人报告 2020》(World Robotics 2020 Report)
- python语法错误类型_python常见报错类型和异常处理