Delphi 函数大全

名称 类型 说明  
abort 函数 引起放弃的意外处理  
abs 函数 绝对值函数  
addexitproc 函数 将一过程添加到运行时库的结束过程表中  
addr 函数 返回指定对象的地址  
adjustlinebreaks 函数 将给定字符串的行分隔符调整为cr/lf序列  
align 属性 使控件位于窗口某部分  
alignment 属性 控件标签的文字位置  
allocmem 函数 在堆栈上分配给定大小的块  
allowgrayed 属性 允许一个灰度选择  
ansicomparestr 函数 比较字符串（区分大小写）  
ansicomparetext 函数 比较字符串（不区分大小写）  
ansilowercase 函数 将字符转换为小写  
ansiuppercase 函数 将字符转换为大写  
append 函数 以附加的方式打开已有的文件  
arctan 函数 余切函数  
assignfile 函数 给文件变量赋一外部文件名  
assigned 函数 测试函数或过程变量是否为空  
autosize 属性 自动控制标签的大小  
backgrounddi2001.jpg 属性 背景色  
beginthread 函数 以适当的方式建立用于内存管理的线程  
bevelinner 属性 控件方框的内框方式  
bevelouter 属性 控件方框的外框方式  
bevelwidth 属性 控件方框的外框宽度  
blockread 函数 读一个或多个记录到变量中  
blockwrite 函数 从变量中写一个或多个记录  
borderstyle 属性 边界类型  
borderwidth 属性 边界宽度  
break 命令 终止for、while、repeat循环语句  
brush 属性 画刷  
caption 属性 标签文字的内容  
changefileext 函数 改变文件的后缀  
chdir 函数 改变当前目录  
checked 属性 确定复选框选中状态  
chr 函数 返回指定序数的字符  
closefile 命令 关闭打开的文件  
color 属性 标签的颜色  
columns 属性 显示的列数  
comparestr 函数 比较字符串（区分大小写）  
concat 函数 合并字符串  
continue 命令 继续for、while、repeat的下一个循环  
copy 函数 返回一字符串的子串  
cos 函数 余弦函数  
ctl3d 属性 是否具有3d效果  
cursor 属性 鼠标指针移入后的形状  
date 函数 返回当前的日期  
datetimetofiledate 函数 将delphi的日期格式转换为dos的日期格式  
datetimetostr 函数 将日期时间格式转换为字符串  
datetimetostring 函数 将日期时间格式转换为字符串  
datetostr 函数 将日期格式转换为字符串  
dayofweek 函数 返回星期的数值  
dec 函数 递减变量值  
decodedate 函数 将日期格式分解为年月日  
decodetime 函数 将时间格式分解为时、分、秒、毫秒  
delete 函数 从字符串中删除子串  
deletefile 命令 删除文件  
diskfree 函数 返回剩余磁盘空间的大小  
disksize 函数 返回指定磁盘的容量  
dispose 函数 释放动态变量所占的空间  
disposestr 函数 释放字符串在堆栈中的内存空间  
ditherbackgrounddi2001.jpg?使背景色的色彩加重或减少50%  
dragcursor 属性 当鼠标按下时光标的形状  
dragmode 属性 按动的作用方式  
dropdowncount 属性 容许的显示数据项的数目  
editmask 属性 编辑模式  
enabled 属性 是否使标签呈现打开状态  
encodedate 函数 将年月日合成为日期格式  
encodetime 函数 将时、分、秒、毫秒合成为时间格式  
endmargin 属性 末尾边缘  
eof 函数 对有类型或无类型文件测试是否到文件尾  
eoln 函数 返回文本文件的行结束状态  
erase 命令 删除外部文件  
exceptaddr 函数 返回引起当前意外的地址  
exclude 函数 从集合中删除一些元素  
exceptobject 函数 返回当前意外的索引  
exit 命令 立即从当前的语句块中退出  
exp 函数 指数函数  
expandfilename 函数 返回包含绝对路径的字符串  
extendedselect 属性 是否允许存在选择模式，true时，multiselect才有意义  
extractfiledir 函数 返回驱动器和路径  
extractfileext 函数 返回文件的后缀  
extractfilename 函数 返回文件名  
extractfilepath 函数 返回指定文件的路径  
fileage 函数 返回文件已存在的时间  
fileclose 命令 关闭指定的文件  
filecreate 命令 用指定的文件名建立新文件  
filedatetodatetime 函数 将dos的日期格式转换为delphi的日期格式  
fileexists 函数 检查文件是否存在  
filegatattr 函数 返回文件的属性  
filegetdate 函数 返回文件的dos日期时间标记  
fileopen 命令 用指定的存取模式打开指定的文件  
filepos 函数 返回文件的当前指针位置  
fileread 命令 从指定的文件读取  
filesearch 命令 在目录中搜索指定的文件  
fileseek 函数 改变文件的指针  
filesetattr 函数 设置文件属性  
filesetdate 函数 设置文件的dos日期时间标记  
filesize 函数 返回当前文件的大小  
filewrite 函数 对指定的文件做写操作  
fillchar 函数 用指定的值填充连续字节的数  
findclose 命令 终止findfirst/findnext序列  
findfirst 命令 对指定的文件名及属性搜索目录  
findnext 命令 返回与文件名及属性匹配的下一入口  
floattodecimal 函数 将浮点数转换为十进制数  
floattostrf 函数 将浮点数转换为字符串  
floattostr 函数 将浮点数转换为字符串  
floattotext 函数 将给定的浮点数转换为十进制数  
floattotextfmt 函数 将给定的浮点数转换为十进制数  
flush 函数 将缓冲区的内容刷新到输出的文本文件中  
fmtloadstr 函数 从程序的资源字符串表中装载字符串  
fmtstr 函数 格式化一系列的参数，其结果以参数result返回  
font 属性 设置字体  
format 函数 格式化一系列的参数并返回pascal字符串  
formatbuf 函数 格式化一系列的参数  
formatdatetime 函数 用指定的格式来格式化日期和时间  
formatfloat 函数 指定浮点数格式  
frac 函数 返回参数的小数部分  
freemem 函数 按给定大小释放动态变量所占的空间  
getdir 返回指定驱动器的当前目录  
getheapstatus 返回内存管理器的当前状态  
getmem 建立一指定大小的动态变量，并将指针指向该处  
getmemorymanager 返回内存管理器的入口点  
glyph 函数 按钮上的图象  
halt 停止程序的执行并返回到操作系统  
hi 返回参数的高地址位  
high 返回参数的上限值  
hint 属性 提示信息  
int 返回参数的整数部分  
include 添加元素到集合中  
insert 在字符串中插入子串  
inttohex 将整型数转换为十六进制数  
inttostr 将整型数转换为字符串  
ioresult 返回最新的i/o操作完成状态  
isvalidident 测试字符串是否为有效的标识符  
items 属性 默认显示的节点  
kind 属性 摆放样式  
largechange 属性 最大改变值  
layout 属性 图象布局  
length 函数 返回字符串的动态长度  
lines 属性 缺省显示内容  
ln 函数 自然对数函数  
lo 函数 返回参数的低地址位  
loadstr 函数 从应用程序的可执行文件中装载字符资源  
lowercase 函数 将给定的字符串变为小写  
low 函数 返回参数的下限值  
max 属性 最大值  
maxlength 属性 最大长度  
min 属性 最小值  
mkdir 命令 建立一子目录  
move 函数 从源到目标复制字节  
multiselect 属性 允许同时选择几个数据项  
name 属性 控件的名字  
new 函数 建立新的动态变量并设置一指针变量指向他  
newstr 函数 在堆栈上分配新的字符串  
now 函数 返回当前的日期和时间  
odd 测试参数是否为奇数  
onactivate 事件 焦点移到窗体上时触发  
onclick 事件 单击窗体空白区域触发  
ondblclick 事件 双击窗体空白区域触发  
onclosequery 事件 使用者试图关闭窗体触发  
onclose 事件 窗体关闭后才触发  
oncreate 事件 窗体第一次创建时触发  
ondeactivate 事件 用户切换到另一应用程序触发  
ondragdrop 事件 鼠标拖放操作结束时触发  
ondragover 事件 有其他控件从他上面移过触发  
onmousedown 事件 按下鼠标键时触发  
onmouseup 事件 释放鼠标键时触发  
onmousemove 事件 移动鼠标时触发  
onhide 事件 隐藏窗体时触发  
onkeydown 事件 按下键盘某键时触发  
onkeypress 事件 按下键盘上的单个字符键时触发  
onkeyup 事件 释放键盘上的某键时触发  
onpaint 事件 窗体上有新部分暴露出来触发  
onresize 事件 重新调整窗体大小触发  
onshow 事件 在窗体实际显示之前瞬间触发  
ord 返回序数类的序数  
outlinestyle 属性 类型  
outofmemoryerror 引起outofmemory意外  
pageindex 属性 页索引  
pages 属性 页  
paramcount 函数 返回在命令行上传递给程序的参数数量  
paramstr 函数 返回指定的命令行参数  
pen 属性 画刷设置  
pi 函数 返回圆周率pi  
picture 属性 显示图象  
pictureclosed 属性 设置closed位图  
pictureleaf 属性 设置leaf位图  
pictureminus 属性 设置minus位图  
pictureopen 属性 设置open位图  
pictureplus 属性 设置plus位图  
pos 函数 在字符串中搜索子串  
pred 函数 返回先前的参数  
random 函数 返回一随机函数  
randomize 函数 用一随机数初始化内置的随机数生成器  
read 函数 对有格式的文件，读一文件组件到变量中；  
对文本文件，读一个或多个值到一个或多个变量中  
readln 函数 执行read过程，然后跳到文件下一行  
readonly 属性 只读属性  
reallocmem 函数 分配一动态变量  
rename 函数 重命名外部文件  
renamefile 函数 对文件重命名  
reset 函数 打开已有的文件  
rewrite 函数 建立并打开一新的文件  
rmdir 函数 删除空的子目录  
round 函数 将实数值舍入为整型值  
runerror 函数 停止程序的执行  
scrollbars 属性 滚动条状态  
seek 函数 将文件的当前指针移动到指定的组件上  
seekeof 函数 返回文件的文件结束状态  
seekeoln 函数 返回文件的行结束状态  
selectedcolor 属性 选中颜色  
setmemorymanager 函数 设置内存管理器的入口点  
settextbuf 函数 给文本文件指定i/o缓冲区  
shape 属性 显示的形状  
showexception 函数 显示意外消息与地址  
sin 函数 正弦函数  
sizeof 函数 返回参数所占的字节数  
smallchange 属性 最小改变值  
sorted 属性 是否允许排序  
sqr 函数 平方函数  
sqrt 函数 平方根函数  
startmargin 属性 开始边缘  
state 属性 控件当前状态  
str 函数 将数值转换为字符串  
stralloc 函数 给以null结束的字符串分配最大长度-1的缓冲区  
strbufsize 函数 返回存储在由stralloc分配的字符缓冲区的最大字符数  
strcat 函数 将一字符串附加到另一字符串尾并返回合并的字符串  
strcomp 函数 比较两个字符串  
strcopy 函数 将一个字符串复制到另一个字符串中  
strdispose 函数 释放堆栈上的字符串  
strecopy 函数 将一字符串复制到另一个字符串并返回结果字符串尾部的指针
strend 函数 返回指向字符串尾部的指针  
stretch 属性 自动适应控件的大小  
strfmt 函数 格式化一系列的参数  
stricomp 函数 比较两个字符串（不区分大小写）  
stringtowidechar 函数 将ansi字符串转换为unicode字符串  
strlcat 函数 将一字符串中的字符附加到另一字符串尾并返回合并的字符串
strlcomp 函数 以最大长度比较两个字符串  
strlcopy 函数 将一个字符串中的字符复制到另一个字符串中  
strlen 函数 返回字符串中的字符数  
strlfmt 函数 格式化一系列的参数，其结果中包含有指向目标缓冲区的指针
strlicomp 函数 以最大长度比较两个字符串（不区分大小写）  
strlower 函数 将字符串中的字符转换为小写  
strmove 函数 将一个字符串中的字符复制到另一个字符串中  
strnew 函数 在堆栈上分配一个字符串  
strpas 函数 将以null结束的字符串转换为pascal类的字符串  
strpcopy 函数 将pascal类的字符串复制为以null结束的字符串  
strplcopy 函数 从pascal类的最大长度字符串复制为以null结束的字符串  
strpos 函数 返回一个字符串在另一个字符串中首次出现指针  
strrscan 函数 返回字符串中最后出现字符的指针  
strscan 函数 返回字符串中出现首字符的指针  
strtodate 函数 将字符串转换为日期格式  
strtodatetime 函数 将字符串转换为日期/时间格式  
strtofloat 函数 将给定的字符串转换为浮点数  
strtoint 函数 将字符串转换为整型  
strtointdef 函数 将字符串转换为整型或默认值  
strtotime 函数 将字符串转换为时间格式  
strupper 函数 将字符串中的字符转换为大写  
style 属性 类型选择  
suce 函数 返回后继的参数  
swap 函数 交换参数的高低地址位  
tabs 属性 标记每一项的内容  
tabindex 属性 标记索引  
text 属性 显示的文本  
texttofloat 函数 将字符串（以null结束的格式）转换为浮点数  
time 函数 返回当前的时间  
timetostr 函数 将时间格式转换为字符串  
trim 函数 从给定的字符串中删除前导和尾部的空格及控制字符  
trimleft 函数 从给定的字符串中删除首部的空格及控制字符  
trimright 函数 从给定的字符串中删除尾部的空格及控制字符  
trunc 函数 将实型值截取为整型值  
truncate 函数 截去当前文件位置后的内容  
unselectedcolor 属性 未选中颜色  
upcase 将字符转换为大写  
uppercase 将给定的字符串变为大写  
val 函数 将字符串转换为整型值  
vararraycreate 函数 以给定的界限和维数建立变体数组  
vararraydimcount 函数 返回给定变体的维数  
vararrayhighbound 函数 返回给定变体数组维数的上界  
vararraylock 函数 锁定给定的变体数组  
vararraylowbound 函数 返回给定变体数组维数的下界  
vararrayof 函数 返回指定变体的数组元素  
vararrayredim 函数 通过改变上限来调整变体的大小  
vararrayunlock 函数 解锁指定的变体数组  
varastype 函数 将变体转换为指定的类型  
varcase 函数 将变体转换为指定的类型并保存他  
varclear 函数 清除指定的变体  
varcopy 函数 将指定的变体复制为指定的变体  
varformdatetime 函数 返回包含日期时间的变体  
varisarray 函数 测试变体是否为数组  
varisempty 函数 测试变体是否为unassigned  
varisnull 函数 测试变体是否为null  
vartodatetime 函数 将给定的变体转换为日期时间  
vartype 函数 将变体转换为指定的类型并保存他  
visible 属性 控件的可见性  
wantreturns 属性 为true时，按回车键产生一个回车符；  
为false时，按下ctrl+enter才产生回车符  
write 命令 对有格式的文件，写一变量到文件组件中；  
对文本文件，写一个或多个值到文件中  
writeln 命令 执行write过程，然后输出一行结束标志  
widecharlentostring 函数 将ansi字符串转换为unicode字符串  
widecharlentostrwar 函数 将unicode字符串转换为ansi字符串变量  
widechartostring 函数 将unicode字符串转换为ansi字符串  
widechartostrvar 函数 将unicode字符串转换为ansi字符串变量
 
来自: daocaoren0824, 时间: 2005-10-21 11:48:42, ID: 3240062 
再给你一份  程序员实用函数
{▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎}
{▎                                                                          ▎}
{▎      大家都是程序员 没有必要重复一些无聊的事情 我的这些函数能给大家带来方便 ▎}
{▎      如果觉得还一般 请关注 WWW.cdsunco.com/www.ccemove.com  QQ:35013354   ▎}
{▎                             系统公用函数及过程                            ▎}
{▎                                                                          ▎}
{▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎}
{▎ 软件名称：  开发包基础库                                                 ▎}
{▎ 单元名称：  公共运行时间库单元                                           ▎}
{▎ 单元版本：  V1.0                                                         ▎}
{▎ 备    注：  该单元定义了组件包的基础类库                                 ▎}
{▎ 开发平台：  PWin98SE + Delphi 6.0                                        ▎}
{▎ 兼容测试：  PWin9X/2000/XP + Delphi  6.0                                 ▎}
{▎ 本 地 化：  该单元中的字符串均符合本地化处理方式                         ▎}
{▎ 更新记录：  2002.07.03 V2.0                                              ▎}
{▎                 整理单元，重设版本号                                     ▎}
{▎             2002.03.17 V0.02                                             ▎}
{▎                 新增部分函数，并部分修改                                 ▎}
{▎             2002.01.30 V0.01                                             ▎}
{▎                 创建单元（整理而来）                                     ▎}
{▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎}
{▎       ①:  扩展的字符串操作函数                                          ▎}
{▎       ②:  扩展的日期时间操作函数                                        ▎}
{▎       ③:  扩展的位操作函数                                              ▎}
{▎       ④:  扩展的文件及目录操作函数                                      ▎}
{▎       ⑤:  扩展的对话框函数                                              ▎}
{▎       ⑥:  系统功能函数                                                  ▎}
{▎       ⑦:  硬件功能函数                                                  ▎}
{▎       ⑧:  网络功能函数                                                  ▎}
{▎       ⑨:  汉字拼音函数及过程                                            ▎}
{▎       ⑩:  数据库功能函数                                                ▎}
{▎       ⑾:  进制功能函数                                                  ▎}
{▎       ⑿:  其它功能函数                                                  ▎}
{▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎}

unit Communal;
{* |

 
|

}

interface

{$I CnPack.inc}

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 FileCtrl, ShellAPI, CommDlg, MMSystem, WinSock, IniFiles, DBTables, BDE,
 StdCtrls, ComObj, ADODB, Imm, DbCtrls, Db, Registry;

const

 // 公共信息
{$IFDEF GB2312}
 SCnInformation = '提示';
 SCnWarning = '警告';
 SCnError = '错误';
{$ELSE}
 SCnInformation = 'Information';
 SCnWarning = 'Warning';
 SCnError = 'Error';
{$ENDIF}

 C1=52845; //字符串加密算法的公匙
 C2=22719; //字符串加密算法的公匙

resourcestring

{$IFDEF GB2312}
 SUnknowError = '未知错误';
 SErrorCode = '错误代码：';
{$ELSE}
 SUnknowError = 'Unknow error';
 SErrorCode = 'Error code:';
{$ENDIF}

type
  EDBUpdateErr = class(Exception);//修改表结构时触发的错误句柄

 

//▎============================================================▎//
//▎================① 扩展的字符串操作函数  ===================▎//
//▎============================================================▎//

//从文件中返回Ado连接字串。
function GetConnectionString(DataBaseName:string):string;
//返回服务器的机器名称.
function GetRemoteServerName:string;

function InStr(const sShort: string; const sLong: string): Boolean;     {测试通过}
{* 判断s1是否包含在s2中}

function IntToStrEx(Value: Integer; Len: Integer; FillChar: Char = '0'): string;  {测试通过}
{* 扩展整数转字符串函数  Example:   IntToStrEx(1,5,'0');   返回："00001"}

function IntToStrSp(Value: Integer; SpLen: Integer = 3; Sp: Char = ','): string;  {测试通过}
{* 带分隔符的整数－字符转换}

function ByteToBin(Value: Byte): string; {测试通过}
{* 字节转二进制串}

function StrRight(Str: string; Len: Integer): string;  {测试通过}
{* 返回字符串右边的字符   Examples: StrRight('ABCEDFG',3);   返回:'DFG' }

function StrLeft(Str: string; Len: Integer): string; {测试通过}
{* 返回字符串左边的字符}

function Spc(Len: Integer): string;  {测试通过}
{* 返回空格串}

function Replace(Str,s1,s2:string;CaseSensitive:Boolean):string;  {测试通过}
{* 返回将指定字符s1用字符串s2替换后的字符串，可支持大小写敏感由CaseSensitive操作}
{example: replace('We know what we want','we','I',false) = 'I Know what I want'}

function Replicate(pcChar:Char; piCount:integer):string;
{在一个字符串中查找某个字符串的位置}

function StrNum(ShortStr:string;LongString:string):Integer;     {测试通过}
{* 返回某个字符串中某个字符串中出现的次数}

function FindStr(ShortStr:String;LongStrIng:String):Integer;     {测试通过}
{* 返回某个字符串中查找某个字符串的位置}

function SubStr(psInput:String; BeginPlace,CutLeng:Integer):String;     {测试通过}
{* 返回从位置BeginPlace开始切取长度为CatLeng字符串}

function LeftStr(psInput:String; CutLeng:Integer):String;     {测试通过}
{* 返回从左边第一为开始切取 CutLeng长度的字符串}

function RightStr(psInput:String; CutLeng:Integer):String;       {测试通过}
{* 返回从右边第一为开始切取 CutLeng长度的字符串}

function PadLStr(psInput:String; piWidth:Integer; pcPadWith:Char):String;        {测试通过}
{* 返回从psInput字符串左边开始用pcPadWith填充后总长度为PiWidth的字符串}

function PadRStr(psInput:String; piWidth:Integer; pcPadWith:Char):String;       {测试通过}
{* 返回从psInput字符串右边开始用pcPadWith填充后总长度为PiWidth的字符串}

function PadCStr(psInput:String; piWidth:Integer; pcPadWith:Char):String;        {测试通过}
{* 返回从psInput字符串两边开始用pcPadWith填充后总长度为PiWidth的字符串}

function ChrTran(psInput:String; pcSearch:Char; pcTranWith:Char):String;        {测试通过}
{* 返回替换后字符串[替换单个字符] Examples: ChrTran('abCdEgdlkh','d','#')； 返回'abC#Eg#lkh'}

function StrTran(psInput:String; psSearch:String; psTranWith:String):String;        {测试通过}
{* 返回替换后字符串[替换字符串] Examples: StrTran('aruyfbn','ruy','=====');； 返回'a=====fbn'}

function Stuff(psInput:String; piBeginPlace,piCount:Integer; psStuffWith:String):String;
{ *返回替换后字符串[替换字符串] Examples: Stuff('ABCDEFGHI',3,4,'12345')；返回'AB12345GHI'}

procedure SwapStr(var s1, s2: string);  {测试通过}
{* 交换字串}

function LinesToStr(const Lines: string): string;   {测试通过}
{* 多行文本转单行（换行符转'/n'）}

function StrToLines(const Str: string): string;    {测试通过}
{* 单行文本转多行（'/n'转换行符）}

function Encrypt(const S: String; Key: Word): String;
{* 字符串加密函数}

function Decrypt(const S: String; Key: Word): String;
{* 字符串解密函数}

function varIIF(aTest: Boolean; TrueValue, FalseValue: Variant): Variant;
function varToStr(const V: Variant): string;
{* VarIIF及VartoStr为变体函数}

function IsDigital(Value: string): boolean;
{功能说明：判断string是否全是数字}

function RandomStr(aLength : Longint) : String;
{随机字符串函数}

//▎============================================================▎//
//▎================② 扩展的日期时间操作函数  =================▎//
//▎============================================================▎//

function GetYear(Date: TDate): Integer;   {测试通过}
{* 取日期年份分量}
function GetMonth(Date: TDate): Integer;   {测试通过}
{* 取日期月份分量}
function GetDay(Date: TDate): Integer;   {测试通过}
{* 取日期天数分量}
function GetHour(Time: TTime): Integer;   {测试通过}
{* 取时间小时分量}
function GetMinute(Time: TTime): Integer;   {测试通过}
{* 取时间分钟分量}
function GetSecond(Time: TTime): Integer;   {测试通过}
{* 取时间秒分量}
function GetMSecond(Time: TTime): Integer;   {测试通过}
{* 取时间毫秒分量}
function GetMonthLastDay(Cs_Year,Cs_Month:string):string;
{ *传入年、月，得到该月份最后一天}
function IsLeapYear( nYear: Integer ): Boolean;
{*/判断某年是否为闰年}
function MaxDateTime(const Values: array of TDateTime): TDateTime;
{//两个日期取较大的日期}
function MinDateTime(const Values: array of TDateTime): TDateTime;
{//两个日期取较小的日期}
function dateBeginOfMonth(D: TDateTime): TDateTime;
{//得到本月的第一天}
function DateEndOfMonth(D: TDateTime): TDateTime;
{//得到本月的最后一天}
function DateEndOfYear(D: TDateTime): TDateTime;
{//得到本年的最后一天}
function DaysBetween(Date1, Date2: TDateTime): integer;
{//得到两个日期相隔的天数}

//▎============================================================▎//
//▎===================③ 扩展的位操作函数  ====================▎//
//▎============================================================▎//

type
 TByteBit = 0..7;
 {* Byte类型位数范围}
 TWordBit = 0..15;
 {* Word类型位数范围}
 TDWordBit = 0..31;
 {* DWord类型位数范围}

procedure SetBit(var Value: Byte; Bit: TByteBit; IsSet: Boolean); overload;
{* 设置二进制位}
procedure SetBit(var Value: WORD; Bit: TWordBit; IsSet: Boolean); overload;
{* 设置二进制位}
procedure SetBit(var Value: DWORD; Bit: TDWordBit; IsSet: Boolean); overload;
{* 设置二进制位}

function GetBit(Value: Byte; Bit: TByteBit): Boolean; overload;
{* 取二进制位}
function GetBit(Value: WORD; Bit: TWordBit): Boolean; overload;
{* 取二进制位}
function GetBit(Value: DWORD; Bit: TDWordBit): Boolean; overload;
{* 取二进制位}

//▎============================================================▎//
//▎=================④扩展的文件及目录操作函数=================▎//
//▎============================================================▎//

function MoveFile(const sName, dName: string): Boolean;  {测试通过}
{* 移动文件、目录，参数为源、目标名}

procedure FileProperties(const FName: string); {测试通过}
{* 打开文件属性窗口}

function OpenDialog(var FileName: string; Title: string; Filter: string;
 Ext: string): Boolean;
{* 打开文件框}

function FormatPath(APath: string; Width: Integer): string; {测试通过}
{* 缩短显示不下的长路径名}

function GetRelativePath(Source, Dest: string): string;  {测试通过}
{* 取两个目录的相对路径,注意串尾不能是'/'字符！}

procedure RunFile(const FName: string; Handle: THandle = 0;
 const Param: string = '');   {测试通过}
{* 运行一个文件}

function WinExecAndWait32(FileName: string; Visibility: Integer = SW_NORMAL):
 Integer; {测试通过}
{* 运行一个文件并等待其结束}

function AppPath: string; {测试通过}
{* 应用程序路径}

function GetWindowsDir: string; {测试通过}
{* 取Windows系统目录}

function GetWinTempDir: string;  {测试通过}
{* 取临时文件目录}

function AddDirSuffix(Dir: string): string;  {测试通过}
{* 目录尾加'/'修正}

function MakePath(Dir: string): string;  {测试通过}
{* 目录尾加'/'修正}

function IsFileInUse(FName: string): Boolean;   {测试通过}
{* 判断文件是否正在使用}

function GetFileSize(FileName: string): Integer;   {测试通过}
{* 取文件长度}

function SetFileDate(FileName: string; CreationTime, LastWriteTime, LastAccessTime:
 TFileTime): Boolean;     {测试通过}
{* 设置文件时间 Example:    FileSetDate('c:/Test/Test1.exe',753160662);    }

function GetFileDate(FileName: string; var CreationTime, LastWriteTime, LastAccessTime:
 TFileTime): Boolean;     {测试通过}
{* 取文件时间}

function FileTimeToLocalSystemTime(FTime: TFileTime): TSystemTime;  {测试通过}
{* 文件时间转本地时间}

function LocalSystemTimeToFileTime(STime: TSystemTime): TFileTime;  {测试通过}
{* 本地时间转文件时间}

function GetFileIcon(FileName: string; var Icon: TIcon): Boolean;   {测试通过}
{* 取得与文件相关的图标，成功则返回True}

function CreateBakFile(FileName, Ext: string): Boolean;   {测试通过}
{* 创建备份文件}

function Deltree(Dir: string): Boolean;    {测试通过}
{* 删除整个目录}

function GetDirFiles(Dir: string): Integer;    {测试通过}
{* 取文件夹文件数}

type
 TFindCallBack = procedure(const FileName: string; const Info: TSearchRec;
   var Abort: Boolean);
{* 查找指定目录下文件的回调函数}

procedure FindFile(const Path: string; const FileName: string = '*.*';
 Proc: TFindCallBack = nil; bSub: Boolean = True; const bMsg: Boolean = True);
{* 查找指定目录下文件}

procedure FindFileList(Path,Filter:string;FileList:TStrings;ContainSubDir:Boolean);
{ 功能说明：查找一个路径下的所有文件。
 参数： path:路径,filter:文件扩展名过滤,FileList:文件列表, ContainSubDir:是否包含子目录}

function Txtline(const txt: string): integer;
{* 返回一文本文件的行数}

function Html2Txt(htmlfilename: string): string;
{* Html文件转化成文本文件}

function OpenWith(const FileName: string): Integer;     {测试通过}
{* 文件打开方式}

//▎============================================================▎//
//▎====================⑤扩展的对话框函数======================▎//
//▎============================================================▎//

procedure InfoDlg(Mess: string; Caption: string = SCnInformation; Flags: Integer
 = MB_OK + MB_ICONINFORMATION);  {测试通过}
{* 显示提示窗口}

function InfoOk(Mess: string; Caption: string = SCnInformation): Boolean;   {测试通过}
{* 显示提示确认窗口}

procedure ErrorDlg(Mess: string; Caption: string = SCnError);    {测试通过}
{* 显示错误窗口}

procedure WarningDlg(Mess: string; Caption: string = SCnWarning);  {测试通过}
{* 显示警告窗口}

function QueryDlg(Mess: string; Caption: string = SCnInformation): Boolean;   {测试通过}
{* 显示查询是否窗口}

procedure SetWindowAnimate(Sender : TForm; IsSetAni : bool);

//▎============================================================▎//
//▎=====================⑥系统功能函数=========================▎//
//▎============================================================▎//

procedure MoveMouseIntoControl(AWinControl: TControl);   {测试通过}
{* 移动鼠标到控件}

function DynamicResolution(x, y: WORD): Boolean;    {测试通过}
{* 动态设置分辨率}

procedure StayOnTop(Handle: HWND; OnTop: Boolean);   {测试通过}
{* 窗口最上方显示}

procedure SetHidden(Hide: Boolean);    {测试通过}
{* 设置程序是否出现在任务栏}

procedure SetTaskBarVisible(Visible: Boolean);    {测试通过}
{* 设置任务栏是否可见}

procedure SetDesktopVisible(Visible: Boolean);    {测试通过}
{* 设置桌面是否可见}

procedure BeginWait;    {测试通过}
{* 显示等待光标}

procedure EndWait;    {测试通过}
{* 结束等待光标}

function CheckWindows9598NT: string;  {测试通过}
{* 检测是否Win95/98/NT平台}

function GetOSInfo : String;   {测试通过}
{* 取得当前操作平台是 Windows 95/98 还是NT}

function GetCurrentUserName : string;
{*获取当前Windows登录名的用户}

function GetRegistryOrg_User(UserKeyType:string):string;
{*获取当前注册的单位及用户名称}

function GetSysVersion:string;
{*//获取操作系统版本号}

function WinBootMode:string;
{//Windows启动模式}

type
  PShutType = (UPowerOff, UShutdown, UReboot, ULogOff, USuspend, UHibernate);
procedure WinShutDown(ShutWinType:PShutType; PForce:Boolean);
{//Windows ShutDown等}

//▎============================================================▎//
//▎=====================⑦硬件功能函数=========================▎//
//▎============================================================▎//

function GetClientGUID:string;
{ 功能描述：在本机上得到一个GUID.去掉两端的大括号和中间的横线
 返回值：去掉两端的大括号和中间的横线的一个GUID
 适用范围：windows
}

function SoundCardExist: Boolean;       {测试通过}
{* 声卡是否存在}

function GetDiskSerial(DiskChar: Char): string;
{* 获取磁盘序列号}

function DiskReady(Root: string) : Boolean;
{*检查磁盘准备是否就绪}

procedure WritePortB( wPort : Word; bValue : Byte );
{* 写串口}

function ReadPortB( wPort : Word ) : Byte;
{*读串口}

function CPUSpeed: Double;
{* 获知当前机器CPU的速率（MHz）}

type
TCPUID = array[1..4] of Longint;
function GetCPUID : TCPUID; assembler; register;
{*获取CPU的标识ID号*}

function GetMemoryTotalPhys : Dword;
{*获取计算机的物理内存}

type
  TDriveState = (DSNODISK, DSUNFORMATTEDDISK, DSEMPTYDISK, DSDISK_WITHFILES);
function DriveState (driveletter: Char) : TDriveState;
{* 检查驱动器A中磁盘是否有效}

//▎============================================================▎//
//▎=====================⑧网络功能函数=========================▎//
//▎============================================================▎//
function GetComputerName:string;
{* 获取网络计算机名称}
function GetHostIP:string;
{* 获取计算机的IP地址}
function NetUserChangePassword(Domain:PWideChar; UserName:PWideChar; OldPassword:PWideChar; NewPassword:PWideChar): LongInt; stdcall; external 'netapi32.dll' name 'NetUserChangePassword';
{* // 运行平台：Windows NT/2000/XP
{* // Windows 95/98/Me平台：可以用该函数修改用户的Windows登录密码}

//▎============================================================▎//
//▎=====================⑨汉字拼音功能函数=====================▎//
//▎============================================================▎//
function GetHzPy(const AHzStr: string): string;       {测试通过}
{* 取汉字的拼音}

function HowManyChineseChar(Const s:String):Integer;
{* 判断一个字符串中有多少各汉字}

//▎============================================================▎//
//▎===================⑩数据库功能函数及过程===================▎//
//▎============================================================▎//
{function PackDbDbf(Var StatusMsg: String): Boolean;}
{* 物理删除数据库(Db，Dbf)中的数据[着了删除标记的记录]}

procedure RepairDb(DbName: string);
{* 修复Access表}

function CreateODBCCfgInRegistry(ODBCSourceName:WideString;ServerName, DataBaseDescription:String):boolean;
{* 通过注册表创建ODBC配置[创建在系统DSN页下]}

function ADOConnectSysBase(Const Adocon:TadoConnection):boolean;
{* 用Ado连接SysBase数据库函数}

function ADOConnectLocalDB(Const Adocon:TadoConnection;Const Dbname,DbServerName:string;ValidateMode:Integer):boolean;
{* 用Ado连接数据库函数}

function ADOODBCConnectLocalDB(Const Adocon:TadoConnection;Const Dbname:string;ValidateMode:Integer):boolean;
{* 用Ado与ODBC共同连接数据库函数}

function CreatTable(LpDataBaseName,LpTableName,LpSentence:string):Boolean;
{* //建立新表}

function AddField(LpFieldName:string; LpDataType: TFieldType; LpSize: Word):string;
{*//在表中添加字段}

function KillField(LpFieldName:string):String;
{* //在表中删除字段}

function AlterTableExec(LpDataBaseName,LpSentence:string):Boolean;
{* //修改表结构}

function GetSQLSentence(LpTableName,LpSQLsentence:string): string;
{* /修改、添加、删除表结构时的SQL句体}

//▎============================================================▎//
//▎======================⑾进制函数及过程======================▎//
//▎============================================================▎//

function StrToHex(AStr: string): string;
{* 字符转化成十六进制}

function HexToStr(AStr: string): string;
{* 十六进制转化成字符}

function TransChar(AChar: Char): Integer;

//▎============================================================▎//
//▎=====================⑿其它函数及过程=======================▎//
//▎============================================================▎//

function TrimInt(Value, Min, Max: Integer): Integer; overload;    {测试通过}
{* 输出限制在Min..Max之间}

function IntToByte(Value: Integer): Byte; overload;   {测试通过}
{* 输出限制在0..255之间}

function InBound(Value: Integer; Min, Max: Integer): Boolean;    {测试通过}
{* 判断整数Value是否在Min和Max之间}

procedure CnSwap(var A, B: Byte); overload;
{* 交换两个数}
procedure CnSwap(var A, B: Integer); overload;
{* 交换两个数}
procedure CnSwap(var A, B: Single); overload;
{* 交换两个数}
procedure CnSwap(var A, B: Double); overload;
{* 交换两个数}

function RectEqu(Rect1, Rect2: TRect): Boolean;
{* 比较两个Rect是否相等}

procedure DeRect(Rect: TRect; var x, y, Width, Height: Integer);
{* 分解一个TRect为左上角坐标x, y和宽度Width、高度Height}

function EnSize(cx, cy: Integer): TSize;
{* 返回一个TSize类型}

function RectWidth(Rect: TRect): Integer;
{* 计算TRect的宽度}

function RectHeight(Rect: TRect): Integer;
{* 计算TRect的高度}

procedure Delay(const uDelay: DWORD);     {测试通过}
{* 延时}

procedure BeepEx(const Freq: WORD = 1200; const Delay: WORD = 1);     {Win9X下测试通过}
{* 只能在Win9X下让喇叭发声}

procedure ShowLastError;       {测试通过}
{* 显示Win32 Api运行结果信息}

function writeFontStyle(FS: TFontStyles; inifile: string; write: boolean):string;
{* 将字体Font.Style写入INI文件}

function readFontStyle(inifile: string): TFontStyles;
{* 从INI文件中读取字体Font.Style文件}

//function ReadCursorPos(SourceMemo: TMemo): TPoint;
function ReadCursorPos(SourceMemo: TMemo): string;
{* 取得TMemo 控件当前光标的行和列信息到Tpoint中}

function CanUndo(AMemo: TMemo): Boolean;
{* 检查Tmemo控件能否Undo}

procedure Undo(Amemo: Tmemo);
{*实现Undo功能}

procedure AutoListDisplay(ACombox:TComboBox);
{* 实现ComBoBox自动下拉}

function UpperMoney(small:real):string;
{* 小写金额转换为大写 }

function Myrandom(Num: Integer): integer;
{*利用系统时间产生随机数)}

procedure OpenIME(ImeName: string);
{*打开输入法}

procedure CloseIME;
{*关闭输入法}

procedure ToChinese(hWindows: THandle; bChinese: boolean);
{*打开中文输入法}

//数据备份
procedure BackUpData(LpBackDispMessTitle:String);

implementation  {▎=======函数及过程体开始==========▎}

//▎============================================================▎//
//▎==================①扩展的字符串操作函数====================▎//
//▎============================================================▎//

// 判断s1是否包含在s2中
function InStr(const sShort: string; const sLong: string): Boolean;
var
 s1, s2: string;
begin
 s1 := LowerCase(sShort);
 s2 := LowerCase(sLong);
 Result := Pos(s1, s2) > 0;
end;

// 扩展整数转字符串函数，参数分别为目标数、长度、填充字符（默认为０）
function IntToStrEx(Value: Integer; Len: Integer; FillChar: Char = '0'): string;
begin
 Result := IntToStr(Value);
 while Length(Result) < Len do
   Result := FillChar + Result;
end;

// 带分隔符的整数－字符转换
function IntToStrSp(Value: Integer; SpLen: Integer = 3; Sp: Char = ','): string;
var
 s: string;
 i, j: Integer;
begin
 s := IntToStr(Value);
 Result := '';
 j := 0;
 for i := Length(s) downto 1 do
 begin
   Result := s[i] + Result;
   Inc(j);
   try
      if ((j mod SpLen) = 0) and (i <> 1) then
         Result := Sp + Result;
   except
      MessageBox(Application.Handle,' IntToStrSp函数的第二个参数值不能为数字0 ！',SCnError,16);
      exit;
   end
 end;
end;

// 返回字符串右边的字符
function StrRight(Str: string; Len: Integer): string;
begin
 if Len >= Length(Str) then
   Result := Str
 else
   Result := Copy(Str, Length(Str) - Len + 1, Len);
end;

// 返回字符串左边的字符
function StrLeft(Str: string; Len: Integer): string;
begin
 if Len >= Length(Str) then
   Result := Str
 else
   Result := Copy(Str, 1, Len);
end;

// 字节转二进制串
function ByteToBin(Value: Byte): string;
const
 V: Byte = 1;
var
 i: Integer;
begin
 for i := 7 downto 0 do
   if (V shl i) and Value <> 0 then
     Result := Result + '1'
   else
     Result := Result + '0';
end;

// 返回空格串
function Spc(Len: Integer): string;
var
 i: Integer;
begin
 Result := '';
 for i := 0 to Len - 1 do
   Result := Result + ' ';
end;

// 返回将指定字符s1用字符串s2替换后的字符串，可支持大小写敏感由CaseSensitive操作}
function Replace(Str,s1,s2:string;CaseSensitive:Boolean):string;
var
  i:integer;
  s,t:string;
begin
  s:='';
  t:=str;
  repeat
     if casesensitive then
        i:=pos(s1,t)
     else
        i:=pos(lowercase(s1),lowercase(t));
        if i>0 then
           begin
              s:=s+Copy(t,1,i-1)+s2;
              t:=Copy(t,i+Length(s1),MaxInt);
           end
        else
           s:=s+t;
  until i<=0;
  result:=s;
end;

function Replicate(pcChar:Char; piCount:integer):string;
begin
Result:='';
SetLength(Result,piCount);
fillChar(Pointer(Result)^,piCount,pcChar)
end;

// 返回某个字符串中某个字符串中出现的次数}
function StrNum(ShortStr:string;LongString:string):Integer;     {测试通过}
var
  i:Integer;
begin
  i:=0;
  while pos(ShortStr,LongString)>0 do
     begin
        i:=i+1;
        LongString:=Substr(LongString,(FindStr(ShortStr,LongString))+1,Length(LongString)-FindStr(ShortStr,LongString))
     end;
  Result:=i;
end;

// 返回某个字符串中查找某个字符串的位置}
function FindStr(ShortStr:String;LongStrIng:String):Integer;//在一个字符串中找某个字符的位置
var
  locality:integer;
begin
  locality:=Pos(ShortStr,LongStrIng);
  if locality=0 then
     Result:=0
  else
     Result:=locality;
end;

// 返回从位置BeginPlace开始切取长度为CatLeng字符串}
function SubStr(psInput:String; BeginPlace,CutLeng:Integer):String;
begin
Result:=Copy(psInput,BeginPlace,CutLeng)
end;

// 返回从左边第一为开始切取 CutLeng长度的字符串
function LeftStr(psInput:String; CutLeng:Integer):String;
begin
Result:=Copy(psInput,1,CutLeng)
end;

// 返回从左边第一为开始切取 CutLeng长度的字符串
function RightStr(psInput:String; CutLeng:Integer):String;
begin
Result:=Copy(psInput,Length(psInput)-CutLeng+1,CutLeng)
end;

{* 返回从psInput字符串左边开始用pcPadWith填充后总长度为PiWidth的字符串}
function PadLStr(psInput:String; piWidth:Integer; pcPadWith:Char):String;
begin
Result:=Replicate(pcPadWith,piWidth-Length(psInput))+psInput
end;

{* 返回从psInput字符串右边开始用pcPadWith填充后总长度为PiWidth的字符串}
function PadRStr(psInput:String; piWidth:Integer; pcPadWith:Char):String;
begin
Result:=psInput+Replicate(pcPadWith,piWidth-Length(psInput))
end;

{* 返回从psInput字符串两边开始用pcPadWith填充后总长度为PiWidth的字符串}
function PadCStr(psInput:String; piWidth:Integer; pcPadWith:Char):String;
var
liHalf :integer;
begin
liHalf:=(piWidth-Length(psInput))div 2;
Result:=Replicate(pcPadWith,liHalf)+psInput+Replicate(pcPadWith,piWidth-Length(psInput)-liHalf)
end;

{* 返回替换后字符串 Examples: ChrTran('abCdEgdlkh','d','#')； 返回'bC#Eg#lkh'}
function ChrTran(psInput:String; pcSearch:Char; pcTranWith:Char):String;
var
i,j:integer;
begin
j:=Length(psInput);
for i:=1 to j do
 begin
if psInput[i]=pcSearch then
psInput[i]:=pcTranWith
 end;
Result:=psInput
end;

{* 返回替换后字符串 Examples: StrTran('aruyfbn','ruy','====='); 返回'a=====fbn'}
function StrTran(psInput:String; psSearch:String; psTranWith:String):String;
var
liPosition,liLenOfSrch,liLenOfIn:integer;
begin
liPosition:=Pos(psSearch,psInput);
liLenOfSrch:=Length(psSearch);
liLenOfIn:=Length(psInput);
while liPosition>0 do
begin
psInput:=Copy(psInput,1,liPosition-1)
+psTranWith
     +Copy(psInput,liPosition+liLenOfSrch,liLenOfIn);
liPosition:=Pos(psSearch,psInput)
end;
Result:=psInput
end;

{ *返回替换后字符串[替换字符串] Examples: Stuff('ABCDEFGHI',3,4,'12345')；返回'AB12345GHI'}
function Stuff(psInput:String; piBeginPlace,piCount:Integer; psStuffWith:String):String;
begin
Result:=Copy(psInput,1,piBeginPlace-1)+
psStuffWith+
   Copy(psInput,piBeginPlace+piCount,Length(psInput))
end;

// 交换字串
procedure SwapStr(var s1, s2: string);
var
 tempstr: string;
begin
 tempstr := s1;
 s1 := s2;
 s2 := tempstr;
end;

const
 csLinesCR = #13#10;
 csStrCR = '/n';

// 多行文本转单行（换行符转'/n'）
function LinesToStr(const Lines: string): string;
var
 i: Integer;
begin
 Result := Lines;
 i := Pos(csLinesCR, Result);
 while i > 0 do
 begin
   system.Delete(Result, i, Length(csLinesCR));
   system.insert(csStrCR, Result, i);
   i := Pos(csLinesCR, Result);
 end;
end;

// 单行文本转多行（'/n'转换行符）
function StrToLines(const Str: string): string;
var
 i: Integer;
begin
 Result := Str;
 i := Pos(csStrCR, Result);
 while i > 0 do
 begin
   system.Delete(Result, i, Length(csStrCR));
   system.insert(csLinesCR, Result, i);
   i := Pos(csStrCR, Result);
 end;
end;

//字符串加密函数
function Encrypt(const S: String; Key: Word): String;
var
  I : Integer;
begin
     Result := S;
     for I := 1 to Length(S) do
     begin
        Result[I] := char(byte(S[I]) xor (Key shr 8));
        Key := (byte(Result[I]) + Key) * C1 + C2;
        if Result[I] = Chr(0) then
           Result[I] := S[I];
     end;
     Result := StrToHex(Result);
end;

//字符串解密函数
function Decrypt(const S: String; Key: Word): String;
var
  I: Integer;
  S1: string;
begin
  S1 := HexToStr(S);
  Result := S1;
  for I := 1 to Length(S1) do
  begin
     if char(byte(S1[I]) xor (Key shr 8)) = Chr(0) then
        begin
           Result[I] := S1[I];
           Key := (byte(Chr(0)) + Key) * C1 + C2; //保证Key的正确性　　
        end
     else
        begin
           Result[I] := char(byte(S1[I]) xor (Key shr 8));
           Key := (byte(S1[I]) + Key) * C1 + C2;
        end;
  end;
end;

///VarIIF,VarTostr为变体函数
function varIIF(aTest: Boolean; TrueValue, FalseValue: Variant): Variant;
begin
 if aTest then Result := TrueValue else Result := FalseValue;
end;

function varToStr(const V: Variant): string;
begin
 case TVarData(v).vType of
   varSmallInt: Result := IntToStr(TVarData(v).VSmallInt);
   varInteger: Result := IntToStr(TVarData(v).VInteger);
   varSingle: Result := FloatToStr(TVarData(v).VSingle);
   varDouble: Result := FloatToStr(TVarData(v).VDouble);
   varCurrency: Result := FloatToStr(TVarData(v).VCurrency);
   varDate: Result := DateToStr(TVarData(v).VDate);
   varBoolean: Result := varIIf(TVarData(v).VBoolean, 'True', 'False');
   varByte: Result := IntToStr(TVarData(v).VByte);
   varString: Result := StrPas(TVarData(v).VString);
   varEmpty,
     varNull,
     varVariant,
     varUnknown,
     varTypeMask,
     varArray,
     varByRef,
     varDispatch,
     varError: Result := '';
 end;
end;

{功能说明：判断string是否全是数字}
function IsDigital(Value: string): boolean;
var
 i, j: integer;
 str: char;
begin
 result := true;
 Value := trim(Value);
 j := Length(Value);
 if j = 0 then
 begin
   result := false;
   exit;
 end;
 for i := 1 to j do
 begin
   str := Value[i];
   if not (str in ['0'..'9']) then
   begin
     result := false;
     exit;
   end;
 end;
end;

{随机字符串函数}
function RandomStr(aLength : Longint) : String;
var
 X : Longint;
begin
 if aLength <= 0 then exit;
 SetLength(Result, aLength);
 for X:=1 to aLength do
   Result[X] := Chr(Random(26) + 65);
end;

//▎============================================================▎//
//▎==================②扩展日期时间操作函数====================▎//
//▎============================================================▎//

function GetYear(Date: TDate): Integer;
var
 y, m, d: WORD;
begin
 DecodeDate(Date, y, m, d);
 Result := y;
end;

function GetMonth(Date: TDate): Integer;
var
 y, m, d: WORD;
begin
 DecodeDate(Date, y, m, d);
 Result := m;
end;

function GetDay(Date: TDate): Integer;
var
 y, m, d: WORD;
begin
 DecodeDate(Date, y, m, d);
 Result := d;
end;

function GetHour(Time: TTime): Integer;
var
 h, m, s, ms: WORD;
begin
 DecodeTime(Time, h, m, s, ms);
 Result := h;
end;

function GetMinute(Time: TTime): Integer;
var
 h, m, s, ms: WORD;
begin
 DecodeTime(Time, h, m, s, ms);
 Result := m;
end;

function GetSecond(Time: TTime): Integer;
var
 h, m, s, ms: WORD;
begin
 DecodeTime(Time, h, m, s, ms);
 Result := s;
end;

function GetMSecond(Time: TTime): Integer;
var
 h, m, s, ms: WORD;
begin
 DecodeTime(Time, h, m, s, ms);
 Result := ms;
end;

//传入年、月，得到该月份最后一天
function GetMonthLastDay(Cs_Year,Cs_Month:string):string;
Var
  V_date:Tdate;
  V_year,V_month,V_day:word;
begin
  V_year:=strtoint(Cs_year);
  V_month:=strtoint(Cs_month);
  if V_month=12 then
  begin
    V_month:=1;
      inc(V_year);
  end
  else
  inc(V_month);
V_date:=EncodeDate(V_year,V_month,1);
V_date:=V_date-1;
DecodeDate(V_date,V_year,V_month,V_day);
Result:=DateToStr(EncodeDate(V_year,V_month,V_day));
end;

//判断某年是否为闰年
function IsLeapYear( nYear: Integer ): Boolean;
begin
 Result := (nYear mod 4 = 0) and ((nYear mod 100 <> 0) or (nYear mod 400 = 0));
end;

//两个日期取较大的日期
function MaxDateTime(const Values: array of TDateTime): TDateTime;
var
 I: Cardinal;
begin
 Result := Values[0];
 for I := 0 to Low(Values) do
   if Values[I] < Result then Result := Values[I];
end;

//两个日期取较小的日期
function MinDateTime(const Values: array of TDateTime): TDateTime;
var
 I: Cardinal;
begin
 Result := Values[0];
 for I := 0 to High(Values) do
   if Values[I] < Result then Result := Values[I];
end;

//得到本月的第一一天
function dateBeginOfMonth(D: TDateTime): TDateTime;
var
 Year, Month, Day: Word;
begin
 DecodeDate(D, Year, Month, Day);
 Result := EncodeDate(Year, Month, 1);
end;

//得到本月的最后一天
function dateEndOfMonth(D: TDateTime): TDateTime;
var
 Year, Month, Day: Word;
begin
 DecodeDate(D, Year, Month, Day);
 if Month = 12 then
 begin
   Inc(Year);
   Month := 1;
 end else
   Inc(Month);
 Result := EncodeDate(Year, Month, 1) - 1;
end;

//得到本年的最后一天
function dateEndOfYear(D: TDateTime): TDateTime;
var
 Year, Month, Day: Word;
begin
 DecodeDate(D, Year, Month, Day);
 Result := EncodeDate(Year, 12, 31);
end;

//得到两个日期相隔的天数
function DaysBetween(Date1, Date2: TDateTime): integer;
begin
 Result := Trunc(Date2) - Trunc(Date1) + 1;
 if Result < 0 then Result := 0;
end;
//▎============================================================▎//
//▎=====================③位操作函数===========================▎//
//▎============================================================▎//

// 设置位
procedure SetBit(var Value: Byte; Bit: TByteBit; IsSet: Boolean);
begin
 if IsSet then
   Value := Value or (1 shl Bit)
 else
   Value := Value and not (1 shl Bit);
end;

procedure SetBit(var Value: WORD; Bit: TWordBit; IsSet: Boolean);
begin
 if IsSet then
   Value := Value or (1 shl Bit)
 else
   Value := Value and not (1 shl Bit);
end;

procedure SetBit(var Value: DWORD; Bit: TDWordBit; IsSet: Boolean);
begin
 if IsSet then
   Value := Value or (1 shl Bit)
 else
   Value := Value and not (1 shl Bit);
end;

// 取位
function GetBit(Value: Byte; Bit: TByteBit): Boolean;
begin
 Result := Value and (1 shl Bit) <> 0;
end;

function GetBit(Value: WORD; Bit: TWordBit): Boolean;
begin
 Result := Value and (1 shl Bit) <> 0;
end;

function GetBit(Value: DWORD; Bit: TDWordBit): Boolean;
begin
 Result := Value and (1 shl Bit) <> 0;
end;

//▎============================================================▎//
//▎=================④扩展的文件及目录操作函数=================▎//
//▎============================================================▎//

// 移动文件、目录
function MoveFile(const sName, dName: string): Boolean;
var
 s1, s2: AnsiString;
 lpFileOp: TSHFileOpStruct;
begin
 s1 := PChar(sName) + #0#0;
 s2 := PChar(dName) + #0#0;
 with lpFileOp do
 begin
   Wnd := Application.Handle;
   wFunc := FO_MOVE;
   pFrom := PChar(s1);
   pTo := PChar(s2);
   fFlags := FOF_ALLOWUNDO;
   hNameMappings := nil;
   lpszProgressTitle := nil;
   fAnyOperationsAborted := True;
 end;
 Result := SHFileOperation(lpFileOp) = 0;
end;

// 打开文件属性窗口
procedure FileProperties(const FName: string);
var
 SEI: SHELLEXECUTEINFO;
begin
 with SEI do
 begin
   cbSize := SizeOf(SEI);
   fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_INVOKEIDLIST or
     SEE_MASK_FLAG_NO_UI;
   Wnd := Application.Handle;
   lpVerb := 'properties';
   lpFile := PChar(FName);
   lpParameters := nil;
   lpDirectory := nil;
   nShow := 0;
   hInstApp := 0;
   lpIDList := nil;
 end;
 ShellExecuteEx(@SEI);
end;

// 缩短显示不下的长路径名
function FormatPath(APath: string; Width: Integer): string;
var
 SLen: Integer;
 i, j: Integer;
 TString: string;
begin
 SLen := Length(APath);
 if (SLen <= Width) or (Width <= 6) then
 begin
   Result := APath;
   Exit
 end
 else
 begin
   i := SLen;
   TString := APath;
   for j := 1 to 2 do
   begin
     while (TString[i] <> '/') and (SLen - i < Width - 8) do
       i := i - 1;
     i := i - 1;
   end;
   for j := SLen - i - 1 downto 0 do
     TString[Width - j] := TString[SLen - j];
   for j := SLen - i to SLen - i + 2 do
     TString[Width - j] := '.';
   Delete(TString, Width + 1, 255);
   Result := TString;
 end;
end;

// 打开文件框
function OpenDialog(var FileName: string; Title: string; Filter: string;
 Ext: string): Boolean;
var
 OpenName: TOPENFILENAME;
 TempFilename, ReturnFile: string;
begin
 with OpenName do
 begin
   lStructSize := SizeOf(OpenName);
   hWndOwner := GetModuleHandle('');
   Hinstance := SysInit.Hinstance;
   lpstrFilter := PChar(Filter + #0 + Ext + #0#0);
   lpstrCustomFilter := '';
   nMaxCustFilter := 0;
   nFilterIndex := 1;
   nMaxFile := MAX_PATH;
   SetLength(TempFilename, nMaxFile + 2);
   lpstrFile := PChar(TempFilename);
   FillChar(lpstrFile^, MAX_PATH, 0);
   SetLength(TempFilename, nMaxFile + 2);
   nMaxFileTitle := MAX_PATH;
   SetLength(ReturnFile, MAX_PATH + 2);
   lpstrFileTitle := PChar(ReturnFile);
   FillChar(lpstrFile^, MAX_PATH, 0);
   lpstrInitialDir := '.';
   lpstrTitle := PChar(Title);
   Flags := OFN_HIDEREADONLY + OFN_ENABLESIZING;
   nFileOffset := 0;
   nFileExtension := 0;
   lpstrDefExt := PChar(Ext);
   lCustData := 0;
   lpfnHook := nil;
   lpTemplateName := '';
 end;
 Result := GetOpenFileName(OpenName);
 if Result then
   FileName := ReturnFile
 else
   FileName := '';
end;

// 取两个目录的相对路径,注意串尾不能是'/'字符!
function GetRelativePath(Source, Dest: string): string;
 // 比较两路径字符串头部相同串的函数
 function GetPathComp(s1, s2: string): Integer;
 begin
   if Length(s1) > Length(s2) then swapStr(s1, s2);
   Result := Pos(s1, s2);
   while (Result = 0) and (Length(s1) > 3) do
   begin
     if s1 = '' then Exit;
     s1 := ExtractFileDir(s1);
     Result := Pos(s1, s2);
   end;
   if Result <> 0 then Result := Length(s1);
   if Result = 3 then Result := 2;
   // 修正因ExtractFileDir()处理'c:/'时产生的错误.
 end;
 // 取Dest的相对根路径的函数
 function GetRoot(s: ShortString): string;
 var
   i: Integer;
 begin
   Result := '';
   for i := 1 to Length(s) do
     if s[i] = '/' then Result := Result + '../';
   if Result = '' then Result := './';
   // 如果不想处理成"./"的路径格式，可去掉本行
 end;

var
 RelativRoot, RelativSub: string;
 HeadNum: Integer;
begin
 Source := UpperCase(Source);
 Dest := UpperCase(Dest);              // 比较两路径字符串头部相同串
 HeadNum := GetPathComp(Source, Dest); // 取Dest的相对根路径
 RelativRoot := GetRoot(StrRight(Dest, Length(Dest) - HeadNum));
 // 取Source的相对子路径
 RelativSub := StrRight(Source, Length(Source) - HeadNum - 1);
 // 返回
 Result := RelativRoot + RelativSub;
end;

// 运行一个文件
procedure RunFile(const FName: string; Handle: THandle;
 const Param: string);
begin
 ShellExecute(Handle, nil, PChar(FName), PChar(Param), nil, SW_SHOWNORMAL);
end;

// 运行一个文件并等待其结束
function WinExecAndWait32(FileName: string; Visibility: Integer): Integer;
var
 zAppName: array[0..512] of Char;
 zCurDir: array[0..255] of Char;
 WorkDir: string;
 StartupInfo: TStartupInfo;
 ProcessInfo: TProcessInformation;
begin
 StrPCopy(zAppName, FileName);
 GetDir(0, WorkDir);
 StrPCopy(zCurDir, WorkDir);
 FillChar(StartupInfo, SizeOf(StartupInfo), #0);
 StartupInfo.cb := SizeOf(StartupInfo);

 StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
 StartupInfo.wShowWindow := Visibility;
 if not CreateProcess(nil,
   zAppName,                           { pointer to command line string }
   nil,                                { pointer to process security attributes }
   nil,                                { pointer to thread security attributes }
   False,                              { handle inheritance flag }
   CREATE_NEW_CONSOLE or               { creation flags }
   NORMAL_PRIORITY_CLASS,
   nil,                                { pointer to new environment block }
   nil,                                { pointer to current directory name }
   StartupInfo,                        { pointer to STARTUPINFO }
   ProcessInfo) then
   Result := -1                        { pointer to PROCESS_INF }

 else
 begin
   WaitforSingleObject(ProcessInfo.hProcess, INFINITE);
   GetExitCodeProcess(ProcessInfo.hProcess, Cardinal(Result));
 end;
end;

// 应用程序路径
function AppPath: string;
begin
 Result := ExtractFilePath(Application.ExeName);
end;

// 取Windows系统目录
function GetWindowsDir: string;
var
 Buf: array[0..MAX_PATH] of Char;
begin
 GetWindowsDirectory(Buf, MAX_PATH);
 Result := AddDirSuffix(Buf);
end;

// 取临时文件目录
function GetWinTempDir: string;
var
 Buf: array[0..MAX_PATH] of Char;
begin
 GetTempPath(MAX_PATH, Buf);
 Result := AddDirSuffix(Buf);
end;

// 目录尾加'/'修正
function AddDirSuffix(Dir: string): string;
begin
 Result := Trim(Dir);
 if Result = '' then Exit;
 if Result[Length(Result)] <> '/' then Result := Result + '/';
end;

function MakePath(Dir: string): string;
begin
 Result := AddDirSuffix(Dir);
end;

// 判断文件是否正在使用
function IsFileInUse(FName: string): Boolean;
var
 HFileRes: HFILE;
begin
 Result := False;
 if not FileExists(FName) then
   Exit;
 HFileRes := CreateFile(PChar(FName), GENERIC_READ or GENERIC_WRITE, 0,
   nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
 Result := (HFileRes = INVALID_HANDLE_VALUE);
 if not Result then
   CloseHandle(HFileRes);
end;

// 取文件长度
function GetFileSize(FileName: string): Integer;
var
 FileVar: file of Byte;
begin
 {$I-}
 try
   AssignFile(FileVar, FileName);
   Reset(FileVar);
   Result := FileSize(FileVar);
   CloseFile(FileVar);
 except
   Result := 0;
 end;
 {$I+}
end;

// 设置文件时间
function SetFileDate(FileName: string; CreationTime, LastWriteTime, LastAccessTime:
 TFileTime): Boolean;
var
 FileHandle: Integer;
begin
 FileHandle := FileOpen(FileName, fmOpenWrite or fmShareDenyNone);
 if FileHandle > 0 then
 begin
   SetFileTime(FileHandle, @CreationTime, @LastAccessTime, @LastWriteTime);
   FileClose(FileHandle);
   Result := True;
 end
 else
   Result := False;
end;

// 取文件时间
function GetFileDate(FileName: string; var CreationTime, LastWriteTime, LastAccessTime:
 TFileTime): Boolean;
var
 FileHandle: Integer;
begin
 FileHandle := FileOpen(FileName, fmOpenRead or fmShareDenyNone);
 if FileHandle > 0 then
 begin
   GetFileTime(FileHandle, @CreationTime, @LastAccessTime, @LastWriteTime);
   FileClose(FileHandle);
   Result := True;
 end
 else
   Result := False;
end;

// 取得与文件相关的图标
// FileName: e.g. "e:/hao/a.txt"
// 成功则返回True
function GetFileIcon(FileName: string; var Icon: TIcon): Boolean;
var
 SHFileInfo: TSHFileInfo;
 h: HWND;
begin
 if not Assigned(Icon) then
   Icon := TIcon.Create;
 h := SHGetFileInfo(PChar(FileName),
   0,
   SHFileInfo,
   SizeOf(SHFileInfo),
   SHGFI_ICON or SHGFI_SYSICONINDEX);
 Icon.Handle := SHFileInfo.hIcon;
 Result := (h <> 0);
end;

// 文件时间转本地时间
function FileTimeToLocalSystemTime(FTime: TFileTime): TSystemTime;
var
 STime: TSystemTime;
begin
 FileTimeToLocalFileTime(FTime, FTime);
 FileTimeToSystemTime(FTime, STime);
 Result := STime;
end;

// 本地时间转文件时间
function LocalSystemTimeToFileTime(STime: TSystemTime): TFileTime;
var
 FTime: TFileTime;
begin
 SystemTimeToFileTime(STime, FTime);
 LocalFileTimeToFileTime(FTime, FTime);
 Result := FTime;
end;

// 创建备份文件
function CreateBakFile(FileName, Ext: string): Boolean;
var
 BakFileName: string;
begin
 BakFileName := FileName + '.' + Ext;
 Result := CopyFile(PChar(FileName), PChar(BakFileName), False);
end;

// 删除整个目录
function Deltree(Dir: string): Boolean;
var
 sr: TSearchRec;
 fr: Integer;
begin
 if not DirectoryExists(Dir) then
 begin
   Result := True;
   Exit;
 end;
 fr := FindFirst(AddDirSuffix(Dir) + '*.*', faAnyFile, sr);
 try
   while fr = 0 do
   begin
     if (sr.Name <> '.') and (sr.Name <> '..') then
     begin
       if sr.Attr and faDirectory = faDirectory then
         Result := Deltree(AddDirSuffix(Dir) + sr.Name)
       else
         Result := DeleteFile(AddDirSuffix(Dir) + sr.Name);
       if not Result then
         Exit;
     end;
     fr := FindNext(sr);
   end;
 finally
   FindClose(sr);
 end;
 Result := RemoveDir(Dir);
end;

// 取文件夹文件数
function GetDirFiles(Dir: string): Integer;
var
 sr: TSearchRec;
 fr: Integer;
begin
 Result := 0;
 fr := FindFirst(AddDirSuffix(Dir) + '*.*', faAnyFile, sr);
 while fr = 0 do
 begin
   if (sr.Name <> '.') and (sr.Name <> '..') then
     Inc(Result);
   fr := FindNext(sr);
 end;
 FindClose(sr);
end;

var
 FindAbort: Boolean;

// 查找指定目录下文件
procedure FindFile(const Path: string; const FileName: string = '*.*';
 Proc: TFindCallBack = nil; bSub: Boolean = True; const bMsg: Boolean = True);
var
 APath: string;
 Info: TSearchRec;
 Succ: Integer;
begin
 FindAbort := False;
 APath := MakePath(Path);
 try
   Succ := FindFirst(APath + FileName, faAnyFile - faVolumeID, Info);
   while Succ = 0 do
   begin
     if (Info.Name <> '.') and (Info.Name <> '..') then
     begin
       if (Info.Attr and faDirectory) <> faDirectory then
       begin
         if Assigned(Proc) then
           Proc(APath + Info.FindData.cFileName, Info, FindAbort);
       end
       else if bSub then
         FindFile(APath + Info.Name, FileName, Proc, bSub, bMsg);
     end;
     if bMsg then Application.ProcessMessages;
     if FindAbort then Exit;
     Succ := FindNext(Info);
   end;
 finally
   FindClose(Info);
 end;
end;

{ 功能说明：查找一个路径下的所有文件。
 参数：path:路径, filter:文件扩展名过滤, FileList:文件列表, ContainSubDir:是否包含子目录}
procedure FindFileList(Path,Filter:string;FileList:TStrings;ContainSubDir:Boolean);
var
 FSearchRec,DSearchRec:TSearchRec;
 FindResult:shortint;
begin
 FindResult:=FindFirst(path+Filter,sysutils.faAnyFile,FSearchRec);

 try
 while FindResult=0 do
 begin
   FileList.Add(FSearchRec.Name);
   FindResult:=FindNext(FSearchRec);
 end;
 
 if ContainSubDir then
 begin
   FindResult:=FindFirst(path+Filter,faDirectory,DSearchRec);
   while FindResult=0 do
   begin
     if ((DSearchRec.Attr and faDirectory)=faDirectory)
       and (DSearchRec.Name<>'.') and (DSearchRec.Name<>'..') then
       FindFileList(Path,Filter,FileList,ContainSubDir);
       FindResult:=FindNext(DSearchRec);
   end;
 end;
 finally
   FindClose(FSearchRec);
 end;
end;
 
//返回一文本文件的行数
function Txtline(const txt: string): integer;
var
 F : TextFile; {设定为文本文件}
 StrLine : string; {每行字符串}
 line : Integer; {行数}
begin
 AssignFile(F, txt); {建立文件}
 Reset(F);
 Line := 0;
 while not SeekEof(f) do {文件没到尾}
 begin
   if SeekEoln(f) then {判断是否到行尾}
     Readln;
   Readln(F, StrLine);
   if SeekEof(f) then
     break
   else
     inc(Line);
 end;
 CloseFile(F); {关闭文件}
 Result := Line;
end;

//Html文件转化成文本文件
function Html2Txt(htmlfilename: string): string;
var Mystring:TStrings;
   s,lineS:string;
   line,Llen,i,j:integer;
   rloop:boolean;
begin
  rloop:=False;
  Mystring:=TStringlist.Create;
  s:='';
  Mystring.LoadFromFile(htmlfilename);
  line:=Mystring.Count;
  try
     for i:=0 to line-1 do
        Begin
           lineS:=Mystring[i];
           Llen:=length(lineS);
           j:=1;
           while (j<=Llen)and(lineS[j]=' ')do
           begin
              j:=j+1;
              s:=s+' ';
           End;
           while j<=Llen do
           Begin
              if lineS[j]='<'then
                 rloop:=True;
                 if lineS[j]='>'then
                    Begin
                       rloop:=False;
                       j:=j+1;
                       continue;
                    End;
                 if rloop then
                    begin
                       j:=j+1;
                       continue;
                    end
                 else
                   s:=s+lineS[j];
                    j:=j+1;
           End;
           s:=s+#13#10;
        End;
  finally
     Mystring.Free;
  end;{try}
  result:=s;
end;

// 文件打开方式
function OpenWith(const FileName: string): Integer;
begin
 Result := ShellExecute(Application.Handle, 'open', 'rundll32.exe',
   PChar('shell32.dll,OpenAs_RunDLL ' + FileName), '', SW_SHOW);
end;

//▎============================================================▎//
//▎===================⑤扩展的对话框函数=======================▎//
//▎============================================================▎//

// 显示提示窗口
procedure InfoDlg(Mess: string; Caption: string; Flags: Integer);
begin
 Application.MessageBox(PChar(Mess), PChar(Caption), Flags);
end;

// 显示提示确认窗口
function InfoOk(Mess: string; Caption: string): Boolean;
begin
 Result := Application.MessageBox(PChar(Mess), PChar(Caption),
   MB_OK + MB_ICONINFORMATION) = IDOK;
end;

// 显示错误窗口
procedure ErrorDlg(Mess: string; Caption: string);
begin
 Application.MessageBox(PChar(Mess), PChar(Caption), MB_OK + MB_ICONSTOP);
end;

// 显示警告窗口
procedure WarningDlg(Mess: string; Caption: string);
begin
 Application.MessageBox(PChar(Mess), PChar(Caption), MB_OK + MB_ICONWARNING);
end;

// 显示查询是否窗口
function QueryDlg(Mess: string; Caption: string): Boolean;
begin
 Result := Application.MessageBox(PChar(Mess), PChar(Caption),
   MB_YESNO + MB_ICONQUESTION) = IDYES;
end;

//窗体渐变
procedure SetWindowAnimate(Sender : TForm; IsSetAni : bool);
var
 pOSVersionInfo : OSVersionInfo;
begin
 pOSVersionInfo.dwOSVersionInfoSize := sizeof(OSVersionInfo);
 GetVersionEx(pOSVersionInfo);
 if pOSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then
 begin
   if IsSetAni then
     AnimateWindow(Sender.Handle,444,AW_HIDE or AW_BLEND);
 end
 else
   if IsSetAni then
   begin
     AnimateWindow(Sender.Handle,444,AW_HIDE or AW_CENTER);
   end;
end;

//▎============================================================▎//
//▎====================⑥ 系统功能函数  =======================▎//
//▎============================================================▎//

// 移动鼠标到控件
procedure MoveMouseIntoControl(AWinControl: TControl);
var
 rtControl: TRect;
begin
 rtControl := AWinControl.BoundsRect;
 MapWindowPoints(AWinControl.Parent.Handle, 0, rtControl, 2);
 SetCursorPos(rtControl.Left + (rtControl.Right - rtControl.Left) div 2,
   rtControl.Top + (rtControl.Bottom - rtControl.Top) div 2);
end;

// 动态设置分辨率
function DynamicResolution(x, y: WORD): Boolean;
var
 lpDevMode: TDeviceMode;
begin
 Result := EnumDisplaySettings(nil, 0, lpDevMode);
 if Result then
 begin
   lpDevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
   lpDevMode.dmPelsWidth := x;
   lpDevMode.dmPelsHeight := y;
   Result := ChangeDisplaySettings(lpDevMode, 0) = DISP_CHANGE_SUCCESSFUL;
 end;
end;

// 窗口最上方显示
procedure StayOnTop(Handle: HWND; OnTop: Boolean);
const
 csOnTop: array[Boolean] of HWND = (HWND_NOTOPMOST, HWND_TOPMOST);
begin
 SetWindowPos(Handle, csOnTop[OnTop], 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
end;

var
 WndLong: Integer;

// 设置程序是否出现在任务栏
procedure SetHidden(Hide: Boolean);
begin
 ShowWindow(Application.Handle, SW_HIDE);
 if Hide then
   SetWindowLong(Application.Handle, GWL_EXSTYLE,
     WndLong or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW or WS_EX_TOPMOST)
 else
   SetWindowLong(Application.Handle, GWL_EXSTYLE, WndLong);
 ShowWindow(Application.Handle, SW_SHOW);
end;

const
 csWndShowFlag: array[Boolean] of DWORD = (SW_HIDE, SW_RESTORE);

// 设置任务栏是否可见
procedure SetTaskBarVisible(Visible: Boolean);
var
 wndHandle: THandle;
begin
 wndHandle := FindWindow('Shell_TrayWnd', nil);
 ShowWindow(wndHandle, csWndShowFlag[Visible]);
end;

// 设置桌面是否可见
procedure SetDesktopVisible(Visible: Boolean);
var
 hDesktop: THandle;
begin
 hDesktop := FindWindow('Progman', nil);
 ShowWindow(hDesktop, csWndShowFlag[Visible]);
end;

// 显示等待光标
procedure BeginWait;
begin
 Screen.Cursor := crHourGlass;
end;  

// 结束等待光标
procedure EndWait;
begin
 Screen.Cursor := crDefault;
end;

// 检测是否Win95/98平台
function CheckWindows9598NT: String;
var
  V: TOSVersionInfo;
begin
  V.dwOSVersionInfoSize := SizeOf(V);
  Result := '未知操作系统';
  if not GetVersionEx(V) then Exit;
  if V.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS then
     Result := 'Windows 95/98'
  else
     begin
        if V.dwPlatformId = VER_PLATFORM_WIN32_NT then
           Result := 'Windows NT'
        else
           Result :='Windows'
     end;
end;

{* 取得当前操作平台是 Windows 95/98 还是NT}
function GetOSInfo : String;
begin
  Result := '';
  case Win32Platform of
     VER_PLATFORM_WIN32_WINDOWS: Result := 'Windows 95/98';
     VER_PLATFORM_WIN32_NT: Result := 'Windows NT';
  else
     Result := 'Windows32';
  end;
end;

//*获取当前Windows登录名的用户
function GetCurrentUserName : string;
const
  cnMaxUserNameLen = 254;
var
  sUserName : string;
  dwUserNameLen : Dword;
begin
  dwUserNameLen := cnMaxUserNameLen-1;
  SetLength( sUserName, cnMaxUserNameLen );
  GetUserName(Pchar( sUserName ), dwUserNameLen );
  SetLength( sUserName, dwUserNameLen );
  Result := sUserName;
end;

function GetRegistryOrg_User(UserKeyType:string):string;
var
  Myreg:Tregistry;
  RegString:string;
begin
  MyReg:=Tregistry.Create;
  MyReg.RootKey:=HKEY_LOCAL_MACHINE;
  if (Win32Platform = VER_PLATFORM_WIN32_NT) then
     RegString:='Software/Microsoft/Windows NT/CurrentVersion'
  else
     RegString:='Software/Microsoft/Windows/CurrentVersion';

  if MyReg.openkey(RegString,False) then
  begin
     if UpperCase(UserKeyType)='REGISTEREDORGANIZATION' then
        Result:= MyReg.readstring('RegisteredOrganization')
     else
        begin
           if UpperCase(UserKeyType)='REGISTEREDOWNER' then
              Result:= MyReg.readstring('RegisteredOwner')
           else
              Result:='';
        end;
  end;
  MyReg.CloseKey;
  MyReg.Free;
end;

//获取操作系统版本号
function GetSysVersion:string;
Var
  OSVI:OSVERSIONINFO;
  ObjSysVersion:string;
begin
  OSVI.dwOSversioninfoSize:=Sizeof(OSVERSIONINFO);
  GetVersionEx(OSVI);
  ObjSysVersion:=IntToStr(OSVI.dwMinorVersion)+','+IntToStr(OSVI.dwMinorVersion)+','
           +IntToStr(OSVI.dwBuildNumber)+','+IntToStr(OSVI.dwPlatformId)+','
           +OSVI.szCSDVersion;
  if rightstr(ObjSysVersion,1)=',' then
     ObjSysVersion:=Substr(ObjSysVersion,1,length(ObjSysVersion)-1);
  Result:=ObjSysVersion;
end;

//Windows启动模式
function WinBootMode:string;
begin
  case(GetSystemMetrics(SM_CLEANBOOT)) of
     0:Result:='正常模式启动';
     1:Result:='安全模式启动';
     2:Result:='安全模式启动，但附带网络功能';
  else
     Result:='错误：系统启动有问题。';
  end;
end;

Windows ShutDown等
procedure WinShutDown(ShutWinType:PShutType; PForce:Boolean);
var
 hToken, hProcess: THandle;
 tp, prev_tp: TTokenPrivileges;
 Len, Flags: DWORD;
 CanShutdown: Boolean;
begin
 if Win32Platform = VER_PLATFORM_WIN32_NT then
 begin
   hProcess := OpenProcess(PROCESS_ALL_ACCESS, True, GetCurrentProcessID);
   try
     if not OpenProcessToken(hProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
        Exit;
   finally
     CloseHandle(hProcess);
   end;
   try
     if not LookupPrivilegeValue('', 'SeShutdownPrivilege',
       tp.Privileges[0].Luid) then Exit;
     tp.PrivilegeCount := 1;
     tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
     if not AdjustTokenPrivileges(hToken, False, tp, SizeOf(prev_tp),
       prev_tp, Len) then Exit;
   finally
     CloseHandle(hToken);
   end;
 end;
 CanShutdown := True;
//  DoQueryShutdown(CanShutdown);
 if not CanShutdown then Exit;
 if PForce then Flags := EWX_FORCE else Flags := 0;
 case ShutWinType of
   UPowerOff:  ExitWindowsEx(Flags or EWX_POWEROFF, 0);
   UShutdown:  ExitWindowsEx(Flags or EWX_SHUTDOWN, 0);
   UReboot:    ExitWindowsEx(Flags or EWX_REBOOT, 0);
   ULogoff:    ExitWindowsEx(Flags or EWX_LOGOFF, 0);
   USuspend:   SetSystemPowerState(True, PForce);
   UHibernate: SetSystemPowerState(False, PForce);
 end;
end;

//▎============================================================▎//
//▎=====================⑦硬件功能函数=========================▎//
//▎============================================================▎//

function GetClientGUID:string;
var
 myGuid:TGUID;
 ResultStr:string;
begin
 CreateGuid(myGuid);
 ResultStr:=GUIDToString(myGuid);
 ResultStr:=Communal.Replace(ResultStr,'-','',False);
 ResultStr:=Communal.Replace(ResultStr,'{','',False);
 ResultStr:=Communal.Replace(ResultStr,'}','',False);
 Result:=Substr(ResultStr,1,30);
end;

// 声卡是否存在
function SoundCardExist: Boolean;
begin
 Result := WaveOutGetNumDevs > 0;
end;

//* 获取磁盘序列号
function GetDiskSerial(DiskChar: Char): string;
var
  SerialNum : pdword;
  a, b : dword;
  Buffer : array [0..255] of char;
begin
  result := '';
  if GetVolumeInformation(PChar(diskchar+':/'), Buffer, SizeOf(Buffer), SerialNum,a, b, nil, 0) then
     Result := IntToStr(SerialNum^);
end;

//*检查磁盘准备是否就绪
function DiskReady(Root: string) : Boolean;
var
  Oem : CARDINAL ;
  Dw1,Dw2 : DWORD ;
begin
  Oem := SetErrorMode( SEM_FAILCRITICALERRORS ) ;
  if LENGTH(Root) = 1 then Root := Root + '://';
     Result := GetVolumeInformation( PCHAR( Root ), NIL,0,NIL, Dw1,Dw2, NIL,0 ) ;
  SetErrorMode( Oem ) ;
end;

//*检查驱动器A中磁盘的是否有文件及文件状态
function DriveState (driveletter: Char) : TDriveState;
var
  mask: String[6];
  sRec: TSearchRec;
  oldMode: Cardinal;
  retcode: Integer;
begin
  oldMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  mask:= '?:/*.*';
  mask[1] := driveletter;
  {$I-}
  retcode := FindFirst (mask, faAnyfile, Srec);
  FindClose(Srec);
  {$I+}
  case retcode of
  0 : Result := DSDISK_WITHFILES; //磁盘有文件
  -18 : Result := DSEMPTYDISK; //好的空磁盘
  -21, -3: Result := DSNODISK; //NT,Win31的错误代号
  else
     Result := DSUNFORMATTEDDISK;
  end;
  SetErrorMode(oldMode);
end;

//写串口
procedure WritePortB( wPort : Word; bValue : Byte );
begin
  asm
  mov dx, wPort
  mov al, bValue
  out dx, al
  end;
end;

//读串口
function ReadPortB( wPort : Word ):Byte;
begin
  asm
  mov dx, wPort
  in al, dx
  mov result, al
  end;
end;

//获知当前机器CPU的速率（MHz）
function CPUSpeed: Double;
const
  DelayTime = 500;
  var
  TimerHi, TimerLo: DWORD;
  PriorityClass, Priority: Integer;
begin
  PriorityClass := GetPriorityClass(GetCurrentProcess);
  Priority := GetThreadPriority(GetCurrentThread);
  SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
  SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
  Sleep(10);
  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);
end;

//获取CPU的标识ID号
function GetCPUID : TCPUID; assembler; register;
asm
 PUSH    EBX         {Save affected register}
 PUSH    EDI
 MOV     EDI,EAX     {@Resukt}
 MOV     EAX,1
 DW      $A20F       {CPUID Command}
 STOSD          {CPUID[1]}
 MOV     EAX,EBX
 STOSD               {CPUID[2]}
 MOV     EAX,ECX
 STOSD               {CPUID[3]}
 MOV     EAX,EDX
 STOSD               {CPUID[4]}
 POP     EDI {Restore registers}
 POP     EBX
end;

//获取计算机的物理内存
function GetMemoryTotalPhys : Dword;
var
  memStatus: TMemoryStatus;
begin
  memStatus.dwLength := sizeOf ( memStatus );
  GlobalMemoryStatus ( memStatus );
  Result := memStatus.dwTotalPhys div 1024;
end;

//▎============================================================▎//
//▎=====================⑧网络功能函数=========================▎//
//▎============================================================▎//

{* 获取网络计算机名称}
function GetComputerName:string;
var
  wVersionRequested : WORD;
  wsaData : TWSAData;
  p : PHostEnt; s : array[0..128] of char;
begin
  try
     wVersionRequested := MAKEWORD(1, 1); //创建 WinSock
     WSAStartup(wVersionRequested, wsaData); //创建 WinSock
     GetHostName(@s,128);
     p:=GetHostByName(@s);
     Result:=p^.h_Name;
  finally
     WSACleanup; //释放 WinSock
  end;
end;

{* 获取计算机的IP地址}
function GetHostIP:string;
var
  wVersionRequested : WORD;
  wsaData : TWSAData;
  p : PHostEnt; s : array[0..128] of char; p2 : pchar;
begin
  try
     wVersionRequested := MAKEWORD(1, 1); //创建 WinSock
     WSAStartup(wVersionRequested, wsaData); //创建 WinSock
     GetHostName(@s,128);
     p:=GetHostByName(@s);
     p2 := iNet_ntoa(PInAddr(p^.h_addr_list^)^);
     Result:= P2;
  finally
     WSACleanup; //释放 WinSock
  end;
end;

//▎============================================================▎//
//▎=====================⑨汉字拼音功能函数=====================▎//
//▎============================================================▎//
// 取汉字的拼音
function GetHzPy(const AHzStr: string): string;
const
 ChinaCode: 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
 Result:='';
 i := 1;
 while i <= Length(AHzStr) do
 begin
   if (AHzStr[i] >= #160) and (AHzStr[i + 1] >= #160) then
   begin
     HzOrd := (Ord(AHzStr[i]) - 160) * 100 + Ord(AHzStr[i + 1]) - 160;
     for j := 0 to 25 do
     begin
       if (HzOrd >= ChinaCode[j][0]) and (HzOrd <= ChinaCode[j][1]) then
       begin
         Result := Result + Char(Byte('A') + j);
         Break;
       end;
     end;
     Inc(i);
   end else Result := Result + AHzStr[i];
   Inc(i);
 end;
end;

{* 判断一个字符串中有多少各汉字}
function HowManyChineseChar(Const s:String):Integer;
var
  SW:WideString;
  C:String;
  i, WCount:Integer;
begin
  SW:=s;
  WCount:=0;
  For i:=1 to Length(SW) do
  begin
     c:=SW[i];
     if Length(c)>1 then
        Inc(WCount);
  end;
  Result:=WCount;
end;

//▎============================================================▎//
//▎==================⑩数据库功能函数及过程====================▎//
//▎============================================================▎//

//* 物理删除数据库(Db，Dbf)中的数据[着了删除标记的记录]}
{function PackDbDbf(Var StatusMsg: String): Boolean;
var
  rslt:DBIResult;
  szErrMsg:DBIMSG;
  pTblDesc:pCRTblDesc;
  bExclusive:Boolean;
  bActive:Boolean;
  isParadox,isDbase:Boolean;
  tempTableName:string;
  Props:CurProps;//保护口令
begin
  Result:=False;
  StatusMsg:='';
  if TableType=ttDefault then
     begin
        tempTableName:=TableName;
        tempTableName:=Lowercase(tempTableName);
        isParadox:=(pos('.db',tempTableName)>0) and (tempTableName[length(tempTableName)]='b');
        isDbase:=pos('.dbf',tempTableName)>0;
     end
  else
     begin
        isParadox:=TableType=ttParadox;
        isDbase:=TableType=ttDbase;
     end;
  if isparadox or isDbase then
     begin
        bExclusive:=Exclusive;
        bActive:=Active;
        DisableControls;
//         Close;
        Exculsive:=true;
     end
  else
     begin
        StatusMsg:='无效的数据表类型。';
        Exit;
     end;
  if isParadox then
     begin
        if wwMemAvail(Sizeof(CRTblDesc)) then
           begin
              StatusMsg:='内存不足，压缩表失败。';
           end
        else
           begin
              GetMem(pTblDesc,Sizeof(CRTblDesc));
              fillchar(pTblDesc^,Sizeof(CRTblDesc),0);
              with pTblDesc^ do
              begin
                 strCopy(szTblName,Tablename);
                 strCopy(szTblType,szParadox);
                 Active:=True;
                 Check(DbiGetCursorProps(handle,Props));//检测是否右口令保护
                 bProtected:=props.bProtected;
                 Active:=False;
                 bPack:=True;
              end;
              Screen.Cursor:=crHourGlass;
              SetDBFlag(dbfOpened,True);
              rslt:=DBIdoRestructure(DBHandle,1,pTblDesc,nil,nil,nil,False);
              if rslt<>DBIERR_NONE then
                 begin
                    DBiGetErrorString(rslt,SzErrMsg);
                    StatusMsg:=SzErrMsg;
                 end
              else
                 Result:=True;
              SetDBFlag(dbfOpened,False);
              FreeMem(pTblDesc,Sizeof(CRTlDesc));
              Screen.Cursor:=crDefault;
           end;
     end
  else
     if isDbase then
        begin
           Screen.Cursor:=crHourGlass;
           OPen;
           rslt:=dbiPacktable(DBHandle,Handle,nil,nil,True);
           Screen.Cursor:=crDefault;
           if rslt<>DBIERR_NONE then
              begin
                 DBiGetERRorString(rslt,szErrMsg);
                 StatusMSg:=SzErrMsg;
              end
           else
              Result:=True;
        end;
     Close;
     Exculsive:=bExclusive;
     Active:=bActive;
     EnableControls;
end;}

{procedure CompactDb(DbName, NewDbName: string);
var
  dao: OLEVariant;
begin
  dao := CreateOleObject('DAO.DBEngine.35');
  dao.CompactDatabase(DbName, NewDbName);
end;}

//修复Access表
procedure RepairDb(DbName: string);
var
  Dao: OLEVariant;
begin
  Dao := CreateOleObject('DAO.DBEngine.35');
  Dao.RepairDatabase(DbName);
end;

//通过注册表创建ODBC配置[创建在系统DSN页下]
function CreateODBCCfgInRegistry(ODBCSourceName:WideString; ServerName, DataBaseDescription:String):boolean;
var
 Reg: TRegistry;
 LPT_systemDir:array [1..255] of char;
 P:Pchar;
 DriverString:String;
begin
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_LOCAL_MACHINE;
  try
     try
        if not Reg.KeyExists('/Software/ODBC/ODBC.INI/'+trim(ODBCSourceName)) then
        begin
           //创建并打开主键。
           if Reg.OpenKey('/Software/ODBC/ODBC.INI/'+trim(ODBCSourceName),True) then
           begin
              //写入键值
              Reg.WriteString('DataBase', ODBCSourceName);
              Reg.WriteString('Description',Trim(DataBaseDescription));

              GetSystemDirectory(@LPT_systemDir,255) ;
              P:=@LPT_systemDir;
              DriverString:=StrCat(P,Pchar('/SQLSRV32.DLL')) ;
              Reg.WriteString('Driver', DriverString);

              Reg.WriteString('LastUser', 'Administrator');
              Reg.WriteString('Server', trim(ServerName));
              Reg.WriteString('Trusted_Connection', 'Yes');
              reg.CloseKey;
           end;

           //加入ODBCDataSource
           if Reg.OpenKey('/Software/ODBC/ODBC.INI/ODBC Data Sources/',True) then
           begin
              Reg.DeleteValue(ODBCSourceName);
              Reg.WriteString(ODBCSourceName, 'SQL Server');
              Reg.CloseKey;
           end;
        end;
        Result:=True;
     except
        Result:=False;
     end;
  finally
     Reg.Free;
  end;
end;

function ADOConnectSysBase(Const Adocon:TadoConnection):boolean;
{* 用Ado连接SysBase数据库函数}
begin
  with Adocon do
    begin
         Close;
         LoginPrompt:=False;    //若数据库不存在时，进行判断。。。。。。
         ConnectionString:='Provider=MSDASQL.1;'+
                           'Password="";'+
                           'Persist Security Info=True;'+
                           'Data Source=Sy_Finalact';
         try
             KeepConnection:=True;
             Screen.Cursor:=crHourGlass;
             Connected:=True;
             Open;
             Screen.Cursor:=crDefault;
             ADOConnectSysBase:=True;
         except
             ADOConnectSysBase:=False;
         end;
    end;
end;

//Ado连接数据库函数
function ADOConnectLocalDB(Const Adocon:TAdoConnection;Const Dbname,DBServerName:String;ValidateMode:Integer):boolean;
begin
  with Adocon do
    begin
         Close;
         LoginPrompt:=False;    //若数据库不存在时，进行判断。。。。。。
         if ValidateMode=0 then//使用Windows NT验证模式
            ConnectionString:='Provider=SQLOLEDB.1;'+
                              'Password="";'+
                              'Integrated Security=SSPI;'+  //集成安全
                              'Persist Security Info=False;'+
                              'User ID=sa;Initial Catalog='+''''+dbname+''''+';'+
                              'Data Source='+''''+DBServerName+'''';

         if ValidateMode=1 then//使用SQL SERVER验证模式
            ConnectionString:='Provider=SQLOLEDB.1;'+
                              'Password="";'+
                              'Persist Security Info=True;'+
                              'User ID=sa;Initial Catalog='+''''+Dbname+''''+';'+
                              'Data Source='+''''+DBServerName+'''';
         try
             KeepConnection:=True;
             Screen.Cursor:=crHourGlass;
             Connected:=True;
             Open;
             Screen.Cursor:=crDefault;
             ADOConnectLocalDB:=True;
         except
             ADOConnectLocalDB:=False;
         end;
    end;
end;

//Ado与ODBC共同连接数据库函数
function ADOODBCConnectLocalDB(Const Adocon:TAdoConnection;Const Dbname:String;ValidateMode:Integer):boolean;
begin
  with Adocon do
    begin
         Close;
         LoginPrompt:=False;    //若数据库不存在时，进行判断。。。。。。
         if ValidateMode=0 then//使用Windows NT验证模式
            ConnectionString:='Provider=MSDASQL.1;'+
                              'Password="";'+
                              'Persist Security Info=False;'+
                              'User ID=sa;Data Source='+''''+DBName+''''+';'+
                              'Initial Catalog='+''''+DBname+'''';

         if ValidateMode=1 then//使用SQL SERVER验证模式
            ConnectionString:='Provider=MSDASQL.1;'+
                              'Password="";'+
                              'Persist Security Info=True;'+
                              'User ID=sa;Data Source='+''''+DBName+''''+';'+
                              'Initial Catalog='+''''+DBname+'''';
         try
             KeepConnection:=True;
             Screen.Cursor:=crHourGlass;
             Connected:=True;
             Open;
             Screen.Cursor:=crDefault;
             ADOODBCConnectLocalDB:=True;
         except
             ADOODBCConnectLocalDB:=False;
         end;
    end;
end;

///在指定的数据库中建立表
function CreatTable(LpDataBaseName,LpTableName,LpSentence:string):Boolean;//建立新表
Var
  CreatTableQuery:TQuery;
  SQLsentence:string;
  Successed:Boolean;//成功否
begin
  Successed:=False;
  SQLsentence:='CREATE TABLE "'+ LpTableName +'" ' + LpSentence;
  CreatTableQuery:=TQuery.Create(nil);
  try
     try
        with CreatTableQuery do
        begin
           UniDirectional:=True;
           Active:=False;
           Sql.Clear;
           DataBaseName := LpDataBaseName; //数据库名
           Sql.Add(SQLsentence);
           ExecSQL;
           Successed:=True;
        end;
     except
        MessageBox(Application.Handle,Pchar(' 在建立数据库 '+Trim(LpDataBaseName)+' 中的 '+Trim(LpTableName)+' 表出错，建立未能成功 ！'),'建立失败',0+16);
        Successed:=False;
     end;
  finally
     CreatTableQuery.Free;//释放建立的Query
     if Successed then
        Result:=True//建立成功
     else
        Result:=False;//建立失败
  end;
end;

//在指定的表中新填字段
function AddField(LpFieldName:string; LpDataType: TFieldType; LpSize: Word):string;//建立新表
var
  Sentence,SQLsentence : string;
begin
  Sentence:= '';
  SQLsentence:='';
  if LpFieldName = '' then
     raise EDBUpdateErr.Create('字段名不能为空');
  if Pos(' ', LpFieldName) <> 0 then
     raise EDBUpdateErr.Create('字段名中不能含有空格字符');
  if LpDataType = ftString then
     sentence := 'ADD '+LpFieldName+' Char('+ IntToStr( LpSize ) + ')';
  if LpDataType = ftInteger then
     sentence := 'ADD '+LpFieldName+' Integer';
  if LpDataType = ftSmallInt then
     sentence := 'ADD '+LpFieldName+' SmallInt';
  if LpDataType = ftFloat then
     sentence := 'ADD '+LpFieldName+' Float('+ IntToStr( LpSize ) +',0)';
  if LpDataType = ftDate then
     sentence := 'ADD '+LpFieldName+' Date';
  if LpDataType = ftTime then
     sentence := 'ADD '+LpFieldName+' Time';
  if LpDataType = ftDateTime then
     sentence := 'ADD '+LpFieldName+' TimeStamp';
  if sentence = '' then
     raise EDBUpdateErr.Create('无效的字段类型');
  if SQLSentence = '' then
     SQLSentence := sentence
  else
     SQLSentence := SQLSentence + ', ' + sentence;
  Result:=SQLSentence;//返回SQL句体
end;

//在指定的表中删除字段
function KillField(LpFieldName:string):String;//删除表中的字段
var
  SQLsentence : string;
begin
  if LpFieldName = '' then
     raise EDBUpdateErr.Create('字段名不能为空');
  if Pos(' ', LpFieldName) <> 0 then
     raise EDBUpdateErr.Create('字段名中不能含有空格字符');
  if SQLSentence = '' then
     SQLSentence := 'DROP COLUMN ' + LpFieldName
  else
     SQLSentence := SQLSentence + ', DROP ' + LpFieldName;
  Result:=SQLSentence;
end;

//修改表结构的SQL语句执行体
function AlterTableExec(LpDataBaseName,LpSentence:string):Boolean;//修改表结构
var
  AlterQueryTable:TQuery;
  Successed:Boolean;//成功否
begin
  Successed:=False;
  AlterQueryTable:= TQuery.Create(nil);
  try
     try
        with AlterQueryTable do
        begin
           DataBaseName:=LpDataBaseName;//数据库名
           UniDirectional:=True;
           Active:=False;
           Sql.Clear;
           Sql.Add(LpSentence);
           ExecSQL;
           Successed:=True;
        end;
     except
        Successed:=False;
     end;
  finally
     AlterQueryTable.Free;
     if successed then
        Result:=True
     else
        Result:=False;
  end;
end;

//修改、添加、删除表结构时的SQL句体
function GetSQLSentence(LpTableName,LpSQLsentence:string): string;
begin
 Result := 'ALTER TABLE "'+ LpTableName +'" ' + LpSQLSentence + ';';
end;

//▎============================================================▎//
//▎======================⑾进制函数及过程======================▎//
//▎============================================================▎//

//字符转化成十六进制
function StrToHex(AStr: string): string;
var
  I : Integer;
//   Tmp: string;
  begin
     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;
end;

//十六进制转化成字符
function HexToStr(AStr: string): string;
var
  I : Integer;
  CharValue: Word;
  begin
  Result := '';
  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;
end;

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;

//▎============================================================▎//
//▎=====================⑿其它函数及过程=======================▎//
//▎============================================================▎//

// 输出限制在Min..Max之间
function TrimInt(Value, Min, Max: Integer): Integer; overload;
begin
 if Value > Max then
   Result := Max
 else if Value < Min then
   Result := Min
 else
   Result := Value;
end;

// 输出限制在0..255之间
function IntToByte(Value: Integer): Byte; overload;
asm
       OR     EAX, EAX
       JNS    @@Positive
       XOR    EAX, EAX
       RET

@@Positive:
       CMP    EAX, 255
       JBE    @@OK
       MOV    EAX, 255
@@OK:
end;

// 由TRect分离出坐标、宽高
procedure DeRect(Rect: TRect; var x, y, Width, Height: Integer);
begin
 x := Rect.Left;
 y := Rect.Top;
 Width := Rect.Right - Rect.Left;
 Height := Rect.Bottom - Rect.Top;
end;

// 比较两个Rect
function RectEqu(Rect1, Rect2: TRect): Boolean;
begin
 Result := (Rect1.Left = Rect2.Left) and (Rect1.Top = Rect2.Top) and
   (Rect1.Right = Rect2.Right) and (Rect1.Bottom = Rect2.Bottom);
end;

// 产生TSize类型
function EnSize(cx, cy: Integer): TSize;
begin
 Result.cx := cx;
 Result.cy := cy;
end;

// 计算Rect的宽度
function RectWidth(Rect: TRect): Integer;
begin
 Result := Rect.Right - Rect.Left;
end;

// 计算Rect的高度
function RectHeight(Rect: TRect): Integer;
begin
 Result := Rect.Bottom - Rect.Top;
end;

// 判断范围
function InBound(Value: Integer; Min, Max: Integer): Boolean;
begin
 Result := (Value >= Min) and (Value <= Max);
end;

// 交换两个数
procedure CnSwap(var A, B: Byte); overload;
var
 Tmp: Byte;
begin
 Tmp := A;
 A := B;
 B := Tmp;
end;

procedure CnSwap(var A, B: Integer); overload;
var
 Tmp: Integer;
begin
 Tmp := A;
 A := B;
 B := Tmp;
end;

procedure CnSwap(var A, B: Single); overload;
var
 Tmp: Single;
begin
 Tmp := A;
 A := B;
 B := Tmp;
end;

procedure CnSwap(var A, B: Double); overload;
var
 Tmp: Double;
begin
 Tmp := A;
 A := B;
 B := Tmp;
end;

// 延时
procedure Delay(const uDelay: DWORD);
var
 n: DWORD;
begin
 n := GetTickCount;
 while ((GetTickCount - n) <= uDelay) do
   Application.ProcessMessages;
end;

// 在Win9X下让喇叭发声
procedure BeepEx(const Freq: WORD = 1200; const Delay: WORD = 1);
const
 FREQ_SCALE = $1193180;
var
 Temp: WORD;
begin
 Temp := FREQ_SCALE div Freq;
 asm
   in al,61h;
   or al,3;
   out 61h,al;
   mov al,$b6;
   out 43h,al;
   mov ax,temp;
   out 42h,al;
   mov al,ah;
   out 42h,al;
 end;
 Sleep(Delay);
 asm
   in al,$61;
   and al,$fc;
   out $61,al;
 end;
end;

// 显示Win32 Api运行结果信息
procedure ShowLastError;
var
 ErrNo: Integer;
 Buf: array[0..255] of Char;
begin
 ErrNo := GetLastError;
 FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, ErrNo, $400, Buf, 255, nil);
 if Buf = '' then StrCopy(@Buf, PChar(SUnknowError));
 MessageBox(Application.Handle, PChar(string(Buf) + #10#13 +
   SErrorCode + IntToStr(ErrNo)),
   SCnInformation, MB_OK + MB_ICONINFORMATION);
end;

//将字体Font.Style写入INI文件
function writeFontStyle(FS: TFontStyles; inifile: string; write: boolean):string;
var
 Mystyle : string;
 Myini : Tinifile;
begin
 Mystyle := '[';
 if fsBold in FS then MyStyle := MyStyle + 'fsBold';
 if fsItalic in FS then
 if MyStyle = '[' then
   MyStyle := MyStyle + 'fsItalic'
 else
   MyStyle := MyStyle + ',fsItalic';
 if fsUnderline in FS then
   if MyStyle = '[' then
      MyStyle := MyStyle + 'fsUnderline'
   else
      MyStyle := MyStyle + ',fsUnderline';
 if fsStrikeOut in FS then
   if MyStyle = '[' then
     MyStyle := MyStyle + 'fsStrikeOut'
   else
     MyStyle := MyStyle + ',fsStrikeOut';
 MyStyle := MyStyle + ']';
 if write then
 begin
   Myini := TInifile.Create(inifile);
   Myini.WriteString('FontStyle', 'style', MyStyle);
   Myini.free;
 end;
 Result := MyStyle;
end;

//从INI文件中读取字体Font.Style文件
function readFontStyle(inifile: string): TFontStyles;
var
 MyFontStyle : TFontStyles;
 MyStyle : string;
 Myini : Tinifile;
begin
 MyFontStyle := [];
 Myini := TInifile.Create(inifile);
 Mystyle := Myini.ReadString('Fontstyle', 'style', '[]');
 if pos('fsBold', Mystyle) > 0 then MyFontStyle := MyFontStyle +   [fsBold];
 if Pos('fsItalic', MyStyle) > 0 then MyFontStyle := MyFontStyle + [fsItalic];
 if Pos('fsUnderline', MyStyle) > 0 then
   MyFontStyle := MyFontStyle + [fsUnderline];
 if Pos('fsStrikeOut', MyStyle) > 0 then
   MyFontStyle := MyFontStyle + [fsStrikeOut];
 MyIni.free;
 Result := MyFontStyle;
end;

//*取得TMemo 控件当前光标的行和列信息到Tpoint中
//function ReadCursorPos(SourceMemo: TMemo): TPoint;
function ReadCursorPos(SourceMemo: TMemo): string;
var
  //   Point: TPoint;
  X,Y:integer;
begin
//   point.y := SendMessage(SourceMemo.Handle, EM_LINEFROMCHAR,SourceMemo.SelStart,0);
//   point.x := SourceMemo.SelStart- SendMessage(SourceMemo.Handle,EM_LINEINDEX,point.y,0);
  y := SendMessage(SourceMemo.Handle, EM_LINEFROMCHAR,SourceMemo.SelStart,0);
  x := SourceMemo.SelStart- SendMessage(SourceMemo.Handle,EM_LINEINDEX,y,0);
  Result := '行:'+inttostr(y+1)+' '+'列:'+inttostr(x+1);
end;

//*检查Tmemo控件能否Undo功能
function CanUndo(AMemo: TMemo): Boolean;
begin
  Result :=AMemo.Perform(EM_CANUNDO, 0, 0)<>0;
end;

//* 实现Undo功能
procedure Undo(Amemo: Tmemo);
begin
  Amemo.Perform(EM_UNDO, 0, 0);
end;

//* 实现ComBoBox自动下拉
procedure AutoListDisplay(ACombox:TComboBox);
begin
  SendMessage(ACombox.handle, CB_SHOWDROPDOWN, Integer(True), 0);
end;

//* 小写金额转换为大写
function UpperMoney(small:real):string;
var
  SmallMonth,BigMonth:string;
  wei1,qianwei1:string[2];
  qianwei,dianweizhi,qian:integer;
  ObjSmall:real;
begin
  {------- 修改参数令值更精确 -------}
  ObjSmall:=Abs(small);
  qianwei:=-2;{小数点后的位置，需要的话也可以改动-2值}
  Smallmonth:=formatfloat('0.00',ObjSmall);{转换成货币形式，需要的话小数点后加多几个零}
  {---------------------------------}
  dianweizhi :=pos('.',Smallmonth);{小数点的位置}
  for qian:=length(Smallmonth) downto 1 do{循环小写货币的每一位，从小写的右边位置到左边}
  begin
     if qian<>dianweizhi then{如果读到的不是小数点就继续}
        begin
           case strtoint(copy(Smallmonth,qian,1)) of{位置上的数转换成大写}
           1:wei1:='壹';
           2:wei1:='贰';
           3:wei1:='叁';
           4:wei1:='肆';
           5:wei1:='伍';
           6:wei1:='陆';
           7:wei1:='柒';
           8:wei1:='捌';
           9:wei1:='玖';
           0:wei1:='零';
           end;
           case qianwei of{判断大写位置，可以继续增大到real类型的最大值}
           -3:qianwei1:='厘';
           -2:qianwei1:='分';
           -1:qianwei1:='角';
           0 :qianwei1:='元';
           1 :qianwei1:='拾';
           2 :qianwei1:='佰';
           3 :qianwei1:='千';
           4 :qianwei1:='万';
           5 :qianwei1:='拾';
           6 :qianwei1:='佰';
           7 :qianwei1:='千';
           8 :qianwei1:='亿';
           9 :qianwei1:='十';
           10:qianwei1:='佰';
           11:qianwei1:='千';
           end;
           inc(qianwei);
           if Small<0 then
              BigMonth :='负'+wei1+qianwei1+BigMonth {组合成大写金额}
           else
              BigMonth :=wei1+qianwei1+BigMonth {组合成大写金额}
        end;
  end;
  Result:=BigMonth;
end;

//利用系统时间产生随机数
function Myrandom(Num: Integer): integer;
var
  T: _SystemTime;
  X: integer;
  I: integer;
begin
  Result := 0;
  If Num = 0 then Exit;;
     GetSystemTime(T);
     X := Trunc(T.wMilliseconds/10) * T.wSecond * 1231;
     X := X + random(1);
     if X<>0 then
        X := -X;
     X := Random(X);
     X := X mod num;
     for I := 0 to X do
        X := Random(Num);
     Result := X;
end;

//打开输入法
procedure OpenIME(ImeName: string);
var
 i: integer;
 MyHKL: hkl;
begin
 if ImeName <> '' then begin
   if Screen.Imes.Count <> 0 then begin
     i := Screen.Imes.IndexOf(ImeName);
     if i >= 0 then MyHKL := hkl(Screen.Imes.Objects[i]);
     ActivateKeyboardLayout(MyHKL, KLF_ACTIVATE);
   end;
 end;
end;

//关闭输入法
procedure CloseIME;
var
 MyHKL: hkl;
begin
 MyHKL := GetKeyboardLayout(0);
 if ImmIsIme(MyHKL) then
   ImmSimulateHotKey(Application.Handle, IME_CHOTKEY_IME_NONIME_TOGGLE);
end;

//打开中文输入法
procedure ToChinese(hWindows: THandle; bChinese: boolean);
begin
 if ImmIsIME(GetKeyboardLayOut(0)) <> bChinese then
   ImmSimulateHotKey(hWindows, IME_THotKey_IME_NonIME_Toggle);
end;

//数据备份
procedure BackUpData(LpBackDispMessTitle:String);
var
  i,j:integer;
  Source,Dest:array[0..200]of char;
  s1:string;
  Lp:_SHFILEOPSTRUCTA;
  Success:Integer;
begin
  if MessageBox(Application.Handle,' 您确认要备份数据吗？','询问窗口',4+32+256)=6 then
  begin
     with LP do
     begin
    Lp.wnd:=Application.Handle;
        wFunc:=FO_COPY;
        s1:='DATA/*.*';
        i:=Length(s1);
        StrCopy(Source,PChar(s1));
        Source[i]:=#0;
        Source[i+1]:=#0;
        Source[i+2]:=#0;
        pFrom:=Source;
        s1:='BACKUP';
        j:=Length(s1);
        StrCopy(Dest,PChar(s1));
        Dest[j]:='/';
        Dest[j+1]:=#0;
        Dest[j+2]:=#0;
        Dest[j+3]:=#0;
        pTo:=Dest;
        fFlags:=FOF_ALLOWUNDO;
        fAnyOperationsAborted:=False;
        lpszProgressTitle:=PChar(LpBackDispMessTitle);
     end;
    Success:=SHFileOperation(LP);
     case Success of
        0:
           MessageBox(Application.Handle,' 所有数据已备份完成 ！','提示窗口',0+48);
        117:
           MessageBox(Application.Handle,Pchar(' 您未创建“'+ExtractFilePath(Application.ExeName)+'BACKUP”目录所以不能完成数据备份 ！'),'提示窗口',0+16)
        else
           MessageBox(Application.Handle,' 在备份数据的过程中被用户中途中断 ！','提示窗口',0+16);
     end;
  end;
end;

 

//                                                                            //
//                          从文件中读取Ado连接字串                           //
//                                                                            //

function GetConnectionString(DataBaseName:string):string;
var FileStringList:Tstringlist;
   TempString: ansistring;
   TheReg:TRegistry;KeyName,fAppPath:string;
   i:Integer;
begin

 TheReg:=TRegistry.Create;

 try
   TheReg.RootKey:=HKEY_LOCAL_MACHINE;
   KeyName:='Software/政府采购管理系统';
   if TheReg.OpenKey(KeyName,False) then
     fAppPath:=TheReg.ReadString('ApplicationPath');
 finally
   TheReg.Free;
 end;

 FileStringList:=Tstringlist.Create;
 //先判断connection.txt是否存在,存在就调入
 if FileExists(fAppPath+'/connection.txt') then
    FileStringList.LoadFromFile(fAppPath+'/connection.txt')
 else
 begin

     application.MessageBox('在系统所在目录中没有检测到连接文件(connection.txt)，无法启动系统。','提示',MB_IconError+mb_ok);

     Result:='';
     FileStringList.Free;
     Exit;
 end;
 //组成一个符串，好进行处理。
 TempString:='';
 for i:=0 to FileStringList.Count-1 do
 begin
   TempString:=TempString+FileStringList.strings[i];
 end;

 {连接指定名称的数据库}
 TempString:=Replace(TempString,'DataBaseName',DataBaseName,False);

 Result:=TempString;

end;

{------------------------------------------------------------------------------}
{function GetRemoteServerName：返回远程服务器的机器名称}
function GetRemoteServerName:string;
var iniServer:TIniFile;
   TheReg:TRegistry;KeyName,fAppPath,RServerName:string;
begin

 TheReg:=TRegistry.Create;

 try
   TheReg.RootKey:=HKEY_LOCAL_MACHINE;
   KeyName:='Software/政府采购管理系统';

   if TheReg.OpenKey(KeyName,False) then
     fAppPath:=TheReg.ReadString('ApplicationPath');
 finally
   TheReg.Free;
 end;

 {创建远程服务器名称}
 try
   iniServer:=TIniFile.Create(fAppPath+'/RemoteServerName.ini');
   with iniServer do
     RServerName:=ReadString('Option','RServerName','');
   iniServer.Free;
 except
   raise exception.Create('致命错误：未找到包含Com服务器配置的信息文件，初始化失败。');
 end;
 Result:=RServerName;

end;

 

initialization
 WndLong := GetWindowLong(Application.Handle, GWL_EXSTYLE);
end.