📄 commfun.pas.svn-base
字号:
function GetSysParams(AKeyID:string):string;
//设置系统参数
procedure SetSysParams(AKeyID,AValue:string);
//是否允许修改编号
function GetIsModifyCoding(ACode:string):Boolean;
//是否自动编号
function GetAutoCoding(ACode:string):Boolean;
//取单号
function GetNumber(AKeyID:String):String;
//取得权限
function GetRights(AProgram,AModule:String):string;
//记录在线情况表
procedure SetLogIn(AProgram:string);
//记录在线情况表
procedure SetLogOut(AProgram:string);
//创建Access数据库
procedure CreateAccessDB(AFileName,APass:string);
//创建SQL Server数据库
procedure CreateSQLDB(APath,ADBName,AUser,APass,AServer:string);
function GetGUID:string;
function EncDecStr(const s:string; stype: dword):string;
//function FileInfo( const FileName :String ) : TFixedFileInfo;
//压缩Access数据库(带密码)
function CompactDatabase(AFileName,APassWord:string):boolean;
function DaoActive(var DaoObject:OleVariant):Boolean;
//压缩数据库
function DaoCompactDB(const FileName:string):Boolean;
//模块安装否
function GetSetup(AModule:string):boolean;
function IsExists(ASQL:string):Boolean;
function GetValue(ASQL:string):Variant;
function ExecSQL(ASQL:string):Boolean;
function HtmlHelp(hwndCaller:HWND;strFile:String;uCommand:UINT; dwData:DWORD_PTR ):HWND;
procedure CloseHtmlHelp;
//检查试用版是否过期 Ture:未过期,False:已过期
function IsTry(AProdID,AProdVer,ARunTimes:String):Boolean;
function ReadReg(Key:string;DataType:Integer):Variant; overload;
procedure WriteReg(Key:string;Value:Variant;DataType:Integer); overload;
procedure SaveToExcel(DBGrid:TdxDBGrid);
procedure SetwwIntl(AwwIntl:TwwIntl);
procedure LocateDialog(ADataSource:TDataSource);
procedure FilterDialog(ADataSource:TDataSource;ABoolean:Boolean=True);
//取服务器的当前时间
function GetServerDate:TDateTime;
//是否自动编号
function IsAutoCode(AKey:String):Boolean;
//取得自动编号
//调用 if IsAutoCode(Edit1.Text) then Edit2.Text:=GetAutoCode('ORD500');
function GetAutoCode(AKey:String):String;
//检查自动编号规则
function CheckAutoCode(ARule:String):Boolean;
//连接数据库 0=Access,1=SQL Server
procedure ConnectDB(ADOC:TADOConnection;AType:Integer;AServer,ADBName,AUser,APass:string);
function GetDateString(ADate:TDateTime):String;
function GetLikeMark:String;
//处理逻辑数据类型
function GetBoolean(ABoolean:Boolean):String;
function ReadReg(RegPath,Key:string;DataType:Integer;Value:Variant):Variant; overload;
procedure WriteReg(RegPath,Key:string;Value:Variant;DataType:Integer); overload;
procedure SaveToReg(AFormName:TForm);
procedure LoadFromReg(AFormName:TForm);
//显示程序执行的时间
procedure ShowRunTime;
function GetFileDate(AFileName:string):TDateTime; //取得文件的创建日期
//ASection=小节名
//AKey=关键字
//AType=数据类型，1=String,2=Integer,3=Boolean,4=DateTime
function ReadIniFile(AFileName,ASection,AKey:string;AType:Integer):Variant;
//AFileName=ini文件名
//ASection=小节名
//AKey=关键字
//AType=数据类型，1=String,2=Integer,3=Boolean,4=DateTime
//AValue=数值
procedure WriteIniFile(AFileName,ASection,AKey:string;AType:Integer;AValue:Variant);
procedure ProcessFile(APath,AIniFile:string);
procedure SearchFile(APath,AIniFile: String);
//查找某个目录下的所有子目录（仅处理下一层子目录，不处理子目录下的子目录）
procedure SearchDir(APath:String;var AStringList:TStringList);
function GetOnlineStatus:Boolean;
//关闭浩晖事务服务控制器
procedure CloseHwTSC;
//创建目录
procedure CreateDirectory(APath:string);
//删除目录
function DeleteDirectory(const ASource:string):Boolean;
//复制目录
function CopyDirectory(const Source,Dest:String):Boolean;
//复制多个文件的处理：
function CopyFiles(const Source,Dest: string):Boolean;
//取得所有待拷贝的文件
procedure GetCopyFiles(Source,Dest:String;var ASource,ADest:TStringList);
procedure DeleteMe(ABatchFile:string);
//检查是否存在新版本
//Ture=有升级版本，False=没有升级版本
function CheckUpgrade(AWeb,ALocal:string;var AUpdateFile:TStringList):Boolean;
function GetFileVersionInfomation(const FileName: string; var info: TFileInfo;UserDefine:string=''):Boolean;
function GetFileVersionA(AFileName:string):string;
function GetFileVersionB(AFileName:string):string;
//修改安装程序标识
procedure SetupProgram(AFlag:Boolean;AModule:string);
//取得期段表中的所有年份数据
procedure GetYears(AComboBox:TComboBox);
//取得期段表中的所属年份的月份数据
procedure GetMonths(AYear:Integer;AComboBox:TComboBox);
//取得今日的月份名称
function GetToDayMonth:string;
//取得期段的起始结束日期
//Ayear:年份 1900-9999
//AMonth:月份 一月-十二月
procedure GetPeriodDate(AYear,AMonth:String;var AStartDate,AEndDate:TDateTime;var APeriod:Integer); overload;
//取得期段的起始结束日期
//Ayear:年份 1900-9999
//AMonth:月份 1-12
procedure GetPeriodDate(AYear,AMonth:Integer;var AStartDate,AEndDate:TDateTime;var APeriod:Integer); overload;
//取得日期范围内的期段号
procedure GetPeriod(AStartDate,AEndDate:TDateTime;var AYear,AMonth:Integer);
function GetDatePart(ADatePart,AFieldName:string):String;
//替换字符串
procedure ReplaceString(ASubStr,ARepStr:string; var AString:string);
//取得公式的值
function ExecFormula(AFormulaID,AItemID:string;AItemNo:Integer;AStartDate,AEndDate:TDateTime;AEmpNo,AYear,AMonth,ADays,AHours:Integer):string;
//执行SQL语句
function ExecScriptSQL(ASQL:string;AItemNo:Integer;AStartDate,AEndDate:TDateTime;AEmpNo,AYear,AMonth,ADays,AHours:Integer):string;
//解析公式，即将公式中所有的函数转换成数值
function ParseFormula(AFormulaString,AItemID:string;AItemNo:Integer;AStartDate,AEndDate:TDateTime;AEmpNo,AYear,AMonth,ADays,AHours:Integer):string;
//取得公式的代码并解析公式
function GetFormulaString(AFormulaID,AItemID:string;AItemNo:Integer;AStartDate,AEndDate:TDateTime;AEmpNo,AYear,AMonth,ADays,AHours:Integer):string;
//将公式转换成中文
function GetFunct(AFunction,AItemID,AItemNm,AFlag:string):string;
//将中文转换成公式
function SetFunct(AFunction,AItemID,AItemNm,AFlag:string):string;
procedure CodeColors(RichEdit:TRichEdit;IsSetFocus:Boolean);
procedure InsertText(CustEdit:TRichEdit;Text:String);
procedure SetCursor(CustEdit:TRichEdit;Col,Row:Integer;IsSetFocus:Boolean);
procedure GetEditColRow(CustEdit:TCustomEdit;var Col,Row:Integer);
procedure SetKeyCode(var CodeString1,CodeString2:TStringList);
//交叉表
//ASourceTable --数据来源表,可以为表,视图,或者SQL语句(要用括号以及别名)
//AGroupbyField --被selct GROUP BY 要显示出来的,可以多个字段(记录可以有空值)
//ATransFormCol --交叉表中的合计等函数计算值的字段
//AFunction --' sum', --默认值,交叉表中的函数,也可以是' 2*sum'的计算公式
//APivotCol --要转换成列的字段,唯一列,可以是表达式'Field1+Field2'(记录可以有空值)
//AStrWhere --=null --where 约束条件,可以为空
procedure CrossTableInAccess(AQuery:TADOQuery;ASourceTable,AGroupbyField,ATransFormCol,AFunction,APivotCol,AStrWhere,AOrderBy:string);
procedure CrossTableInSQL(AQuery:TADOQuery;ASourceTable,AGroupbyField,ATransFormCol,AFunction,APivotCol,AStrWhere,AOrderBy:string);
procedure CrossTable(AQuery:TADOQuery;ASourceTable,AGroupbyField,ATransFormCol,AFunction,APivotCol,AStrWhere,AOrderBy:string);
procedure SetDBGridCol(ADBGrid:TdxDBGrid;ADataSet:TDataSet);
procedure SetDefaultProxy;
function GetIdeDiskSerialNumber: string;
procedure SetTimerEnable(ABoolean:Boolean);
function IsWorkBench(AProgram:string):Boolean;
//取得所有查询报表
procedure GetAllReport(ADataSet:TADODataSet;ActionList:TActionList;AModule:string);
//取得备份文件名
function GetBackupFile(ADate:TDateTime;AIsLast:Boolean=False):string;
procedure BackupAccessDB(AFile:string;ADate:TDateTime);
procedure BackupSQLDB(AFile:string;ADate:TDateTime);
procedure RestoreAccessDB(AFile:string);
procedure RestoreSQLDB(AFile:string);
//名称：复制数据集
//参数：
// ASource: 源数据集
// ATarget: 目标数据集
procedure CopyDataSet(ASource:TDataSet; var ATarget:TADODataSet);
//修正vclskin2.71版本不能动态改变窗体的标题
procedure SetCaption(AForm:TForm;ACaption:String);
//将字符串的长度，统一成相同的长度，以萁前面或后加添加指定的字符
function AddSpaces(AString:string;ALength:Integer;AddStr:string=' ';AIsBefore:Boolean=False):string;
//添加指定个数的指定字符到字符串中
function AddSpacesA(AString:string;ALength:Integer;AddStr:string=' ';AIsBefore:Boolean=False):string;
//创建表(用脚本文件)
procedure CreateTableWithSQL(ASQLFile:string;AQuery:TADOQuery);
//创建表(用数据库设计文件)
procedure CreateTableWithDDM(ADDMFile:string;AQuery:TADOQuery;AProgressBar:TProgressBar=nil;ALabel:TLabel=nil;ATableList:TStringList=nil;AIsForeign:Boolean=True);
//生成用户表脚本
//ADrop:是否显示删除对象脚本
//ATitle:是否显示表名
//ADest:是否显示字段说明
function GetTableScript(AObjID:Integer;AQuery:TADOQuery;ADrop:Boolean=False;ATitle:Boolean=True;ADest:Boolean=True;APrimary:Boolean=True):TStrings;
//生成索引脚本
function GetIndexScript(AObjID:Integer;AQuery:TADOQuery;APrimary:Boolean=False):TStrings;
//生成外键脚本
function GetRefScript(AObjID:Integer;AQuery:TADOQuery):TStrings;
//生成数据库脚本
//AFileName:脚本文件
//ADrop:是否显示删除对象脚本
//ATitle:是否显示表名
//ADest:是否显示字段说明
procedure CreateSQLScript(AQuery:TADOQuery;AFileName:string;ADrop,ATitle,ADest:Boolean);
//生成数据库脚本（使用DDM文件）
procedure CreateSQLScriptWithDDM(ADDMFile:string;AStringList:TStringList;ADrop,ATitle,ADest:Boolean;
AProgressBar:TProgressBar=nil;BProgressBar:TProgressBar=nil;ALabel:TLabel=nil;BLabel:TLabel=nil;ATableList:TStringList=nil;AIsForeign:Boolean=True);
//取得数据集最后的行号
function GetLastNo(ADataSet:TDataSet;AFieldName:string):Integer;
//创建数据库（包含表结构及系统数据）
//ADDMFile:数据库设计文件 包含路径及文件名
//APath:数据库文件存放目录
//ADBName:数据库名称 不包含后缀名
//AExt:数据库文件后缀后 包含'.'
//ADBFile:数据库文件 或 数据库名称
//AType:0=Access, 1=SQL Server
//AServer:服务器名称
//AUser:用户名
//APass:密码
//ASystemDataID:系统数据库电脑编号ID，0=使用缺省数据库，-1=不创建系统数据，正整数=系统数据ID号
//IsShow:是否显示创建进度条
//AProgressBar:明细进度条
//BProgressBar:总的进度条
//ALabel:明细进度说明
//BLabel:总的进度说明
//举例：
//Access数据库
// APath:=ExtractFilePath(SaveDialog1.FileName);
// AName:=ExtractFileName(SaveDialog1.FileName);
// AExt:=ExtractFileExt(SaveDialog1.FileName);
// CreateDatabase('.\HwDDM.sys',APath,AName,AExt,0,'.','Admin','');
procedure CreateDatabase(ADDMFile,APath,ADBName,AExt:string;AType:Integer;AServer,AUser,APass:string;
IsShow:Boolean=False;AProgressBar:TProgressBar=nil;BProgressBar:TProgressBar=nil;ALabel:TLabel=nil;BLabel:TLabel=nil;IsShowMsg:Boolean=True);
//建立系统数据
procedure CreateSystemData(ADDMFile:string;ASystemDataID:Integer;AQuery:TADOQuery;AProgressBar:TProgressBar=nil;ALabel:TLabel=nil);
//将文件拆分成：路径，文件名，后缀名
procedure ExtractFile(AFileName:string; var APath,AName,AExt:string);
//建立数据库结构版本信息
procedure CreateSysVersion(ADDMFile:string; AQuery:TADOQuery);
//名称：检查数据是否改变并记录变更历史
//参数：
// AQuery: 原数据集
// ATableName: 数据表名
// AWhere: 条件字符串
// ADataSet: 维护的数据集
//返回值：
// Ture： 数据已变更
// False: 数据未变更
function CheckDataIsChanged(AQuery:TADOQuery;ATableName,AWhere:string;ADataSet:TDataSet):Boolean;
//记录用户表变更历史
procedure SaveChangedData(var AqryHistory:TADOQuery;ADate:TDateTime;ARecNo:Integer;ATable,AField,ABefore,AAfter:string;AIsSave:Boolean);
//数据库对象升级
procedure UpgradeObjects(AObjID:Integer;AMode,ABefore,AAfter:string;AQuery:TADOQuery;var AStringList:TStringList);
//字段升级
procedure UpgradeColumns(AObjID:integer;AMode,ABefore,AAfter:string;AQuery:TADOQuery;var AFieldList,ATableList:TStringList);
//生成删除对象脚本
procedure GetDeleteScript(AUpdQuery:TADOQuery;ADBType:Integer;var AStringList:TStringList);
//执行脚本
procedure ExecScript(AStringList:TStringList;AQuery:TADOQuery;AProgressBar:TProgressBar=nil;ALabel:TLabel=nil);
//设置相关字段的外键属性
procedure SetReferenceProp(AQuery:TADOQuery);
//取得字段原来的值
function GetBeforeValue(AQuery:TADOQuery;ATableName,AWhere,AFieldName:string):string;
//保存新建数据库对象历史记录
procedure SaveNewObjectsHistory(var AqryHistory,AQuery:TADOQuery;AObjID:Integer;ADate:TDateTime);
//保存修改数据库对象历史记录
procedure SaveEditObjectsHistory(var AqryHistory:TADOQuery;ATableName:string;AOldDataSet,ANewDataSet:TDataSet;ADate:TDateTime);
//检查产品是否已注册
procedure CheckRegister;
procedure DeleteTableRecord(ADataSet:TDataSet;ATableName,AWhere:string);
//检查链表中某个节点下是否有下级节点
//ANo: 节点编号
//ATableName: 表名
//AParentField: 上级字段
function HasChild(ANo,ATableName,AParentField:string):Boolean;
//检查链表中某个节点上是否有上级节点
//ANo: 节点编号
//ATableName: 表名
//AParentField: 上级字段
//AKeyField: 主键字段
function HasParent(ANo,ATableName,AParentField,AKeyField:string):Boolean;
//取得链表中的某个节点下的所有子节点
//ANo: 节点编号
//ATableName: 表名
//AParentField: 上级字段
//AKeyField: 主键字段
//AStringList: 所有节点的主键值
procedure GetChild(ANo,ATableName,AParentField,AKeyField:string;var AStringList:TStringList);
//取得链表中的某个节点上的所有父节点
//ANo: 节点编号
//ATableName: 表名
//AParentField: 上级字段名
//AKeyField: 主键字段
//AStringList: 所有节点的主键值
procedure GetAllParent(ANo,ATableName,AParentField,AKeyField:string;var AStringList:TStringList);
// 如果指定的时间没有操作对话框,则自动关闭
procedure ResetDlgAutoClose;
procedure SetDlgAutoClose(nTime: Integer; ADoHint: Boolean = False);
procedure GetIPAddress(var AComputerName,AIPAddress: string);
//时间转分钟，时间格式：hh:mm
function StrToMinute(ATime:String):Integer;
//相隔时间计算
function TimeDiff(AFromTime,AToTime:String):Double;
//返回值是主机AServerName的MAC地址
//AServerName参数的格式为'\\ServerName' 或者 'ServerName'
//参数ServerName为空时返回本机的MAC地址
//MAC地址以'XXXXXXXXXXXX'的格式返回
function GetMacAddress(const AServerName : string) : string;
//统计数据集记录数
function GetDataSetCount(ADataSet:TDataSet):Integer;
//取得客户信息，如：客户名称、客户地址、交货地址、联系人名、电话号码、传真号码等
procedure GetCustomerInfo(ACustNo,AItemNo:Integer;AMacNo:string; var ACustomerInfo:TCustomerInfo);
//取得本位币
procedure GetCurrency;
//字符串转换成数字
function StrToFloatA(AStr:string):Double;
//进行big5转GB内码
function Big52GB(BIG5Str : String): AnsiString;
//进行GB转BIG5内码
function GB2Big5(GBStr : String): AnsiString;
//进行GBK繁体转简体
function GBCht2Chs(GBStr : String): AnsiString;
//进行GBK简体转繁体
function GBChs2Cht(GBStr : String): AnsiString;
//取得报表的名称
function GetRepName(AID:string;AFlag:Integer=1):string;
procedure PreparedReport(ADataSet:TDataSet;AReport:string;AfrReport:TfrReport;AIsFormat:Boolean=True);
//报表打印
procedure ReportPrint(ADataSet:TDataSet;AReport:string;AOnGetValue:TDetailEvent=nil;AIsFormat:Boolean=True);
//設置多語種信息
procedure SetLangs;
//四舍五入取整，如：2.3=2，2.5=3
function RoundA(AValue:Double):Integer;
//非零進位取整，如：2.1=3，2.6=3
function RoundB(AValue:Double):Integer;
//选择报表
procedure SelectReport(ADataSet:TDataSet;AProgramID:string;AReportName:string='';AOnGetValue:TDetailEvent=nil;ACode:string='');
//复制表结构
procedure CopyStructure(ADataSet:TDataSet;var ADODataSet:TADODataSet);
//取得客戶的已购产品信息
procedure GetCustItemInfo(ACustNo,AItemNo:Integer;ASerialNo:string;var ACustItemInfo:TCustItemInfo);
//快速导出EXCEL
procedure ExportExcelFile(AFileName:string; AWriteTitle:Boolean; ADataSet:TDataSet);
//显示在线升级窗口
procedure ShowUpgradeForm;
//浏览选择目录
// 0: iFlag := BIF_RETURNONLYFSDIRS;
// 1: iFlag := BIF_BROWSEINCLUDEFILES;
// 2: iFlag := BIF_BROWSEFORCOMPUTER;
// 3: iFlag := BIF_BROWSEFORPRINTER;
function BrowseDialog(const Title:String; const Flag:Integer): string;
//将时间hh:mm转换成整数
function StringToTime(AStrTime:String):Integer;
//将整数转换成时间字符hh:mm
function TimeToString(AIntTime:Integer):String;
//取得计量单位换算率
function GetUnitRate(ACustNo,AItemNo,AUnitNo:Integer):Double;
//取得汇率
function GetCurrencyRate(ACurrNo:Integer):Double;
function GetFileName(AFileName:String):String;
function GetDislable(AFormName:string):TStringList ;
procedure AddLang(AFormName:string);
procedure ShowWaitForm;
procedure CloseWaitForm;
implementation
uses HwUpgrade;
procedure ShowWaitForm;
begin
{ if WaitForm=nil then WaitForm:=TWaitForm.Create(Application);
WaitForm.Show;
WaitForm.Update; }
end;
procedure CloseWaitForm;
begin
// WaitForm.Close;
end;
//开启窗体函数
procedure OpenForm(InstanceClass: TComponentClass; var Reference);
var
Instance: TComponent;
begin
ShowWaitForm;
Instance := TComponent(InstanceClass.NewInstance);
TComponent(Reference) := Instance;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -