delphi 常用函数库1

{▎   大家都是程序员 没有必要重复一些无聊的事情 我的这些函数能给大家带来方便 ▎}
{▎ 觉得还一般 请关注 http://www.cdsunco.com/down.htm  还有更多的好东西   ▎}
{▎               系统公用函数及过程              ▎}


{▎ 软件名称： 开发包基础库                         ▎}
{▎ 单元名称： 公共运行时间库单元                      ▎}
{▎ 单元版本： 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;
{* |<PRE>
|</PRE>}

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;
{▎ 觉得还一般 请关注 http://www.cdsunco.com/down.htm  还有更多的好东西   ▎}
const

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

 SCnInformation = 'Information';
 SCnWarning = 'Warning';
 SCnError = 'Error';


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

resourcestring

{$IFDEF GB2312}
 SUnknowError = '未知错误';
 SErrorCode = '错误代码：';

 SUnknowError = 'Unknow error';
 SErrorCode = 'Error code:';


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

{▎ 觉得还一般 请关注 http://www.cdsunco.com/down.htm  还有更多的好东西   ▎}

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

//从文件中返回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;


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;


function GetRegistryOrg_User(UserKeyType:string):string;


function GetSysVersion:string;


function WinBootMode:string;


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;


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下让喇叭发声}

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);


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;


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
 
 try
  AssignFile(FileVar, FileName);
  Reset(FileVar);
  Result := FileSize(FileVar);
  CloseFile(FileVar);
 except
  Result := 0;
 end;
 
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;
  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;
 
  retcode := FindFirst (mask, faAnyfile, Srec);
  FindClose(Srec);
 
  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  
 MOV   EAX,1
 DW   $A20F    {CPUID Command}
 STOSD      
 MOV   EAX,EBX
 STOSD       
 MOV   EAX,ECX
 STOSD       
 MOV   EAX,EDX
 STOSD       
 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);