来自: daocaoren0824, 时间: -- ::, ID:

再给你一份  程序员实用函数

{▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎}

{▎                                                                          ▎}

{▎      大家都是程序员 没有必要重复一些无聊的事情 我的这些函数能给大家带来方便 ▎}

{▎      如果觉得还一般 请关注 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;

{* |<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;

const

 // 公共信息

{$IFDEF GB2312}

 SCnInformation = '提示';

 SCnWarning = '警告';

 SCnError = '错误';

{$ELSE}

 SCnInformation = 'Information';

 SCnWarning = 'Warning';

 SCnError = 'Error';

{$ENDIF}

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

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

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 = ''): string;  {测试通过}

{* 扩展整数转字符串函数  Example:   IntToStrEx(1,5,'0');   返回："00001"}

function IntToStrSp(Value: Integer; SpLen: Integer = ; 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 = ..;

 {* Byte类型位数范围}

 TWordBit = ..;

 {* Word类型位数范围}

 TDWordBit = ..;

 {* 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 = ;

 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[..] 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 = ; const Delay: WORD = );     {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) > ;

end;

// 扩展整数转字符串函数，参数分别为目标数、长度、填充字符（默认为０）

function IntToStrEx(Value: Integer; Len: Integer; FillChar: Char = ''): string;

begin

 Result := IntToStr(Value);

 while Length(Result) < Len do

   Result := FillChar + Result;

end;

// 带分隔符的整数－字符转换

function IntToStrSp(Value: Integer; SpLen: Integer = ; Sp: Char = ','): string;

var

 s: string;

 i, j: Integer;

begin

 s := IntToStr(Value);

 Result := '';

 j := ;

 for i := Length(s) downto  do

 begin

   Result := s[i] + Result;

   Inc(j);

   try

      if ((j mod SpLen) = ) and (i <> ) then

         Result := Sp + Result;

   except

      MessageBox(Application.Handle,' IntToStrSp函数的第二个参数值不能为数字0 ！',SCnError,);

      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 + , Len);

end;

// 返回字符串左边的字符

function StrLeft(Str: string; Len: Integer): string;

begin

 if Len >= Length(Str) then

   Result := Str

 else

   Result := Copy(Str, , Len);

end;

// 字节转二进制串

function ByteToBin(Value: Byte): string;

const

 V: Byte = ;

var

 i: Integer;

begin

 for i :=  downto  do

   if (V shl i) and Value <>  then

     Result := Result + ''

   else

     Result := Result + '';

end;

// 返回空格串

function Spc(Len: Integer): string;

var

 i: Integer;

begin

 Result := '';

 for i :=  to Len -  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> then

           begin

              s:=s+Copy(t,,i-)+s2;

              t:=Copy(t,i+Length(s1),MaxInt);

           end

        else

           s:=s+t;

  until i<=;

  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:=;

  while pos(ShortStr,LongString)> do

     begin

        i:=i+;

        LongString:=Substr(LongString,(FindStr(ShortStr,LongString))+,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= then

     Result:=

  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,,CutLeng)

end;

// 返回从左边第一为开始切取 CutLeng长度的字符串

function RightStr(psInput:String; CutLeng:Integer):String;

begin

Result:=Copy(psInput,Length(psInput)-CutLeng+,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 ;

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:= 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> do

begin

psInput:=Copy(psInput,,liPosition-)

+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,,piBeginPlace-)+

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 = ##;

 csStrCR = '/n';

// 多行文本转单行（换行符转'/n'）

function LinesToStr(const Lines: string): string;

var

 i: Integer;

begin

 Result := Lines;

 i := Pos(csLinesCR, Result);

 while i >  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 >  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 :=  to Length(S) do

     begin

        Result[I] := char(byte(S[I]) xor (Key shr ));

        Key := (byte(Result[I]) + Key) * C1 + C2;

        if Result[I] = Chr() 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 :=  to Length(S1) do

  begin

     if char(byte(S1[I]) xor (Key shr )) = Chr() then

        begin

           Result[I] := S1[I];

           Key := (byte(Chr()) + Key) * C1 + C2; //保证Key的正确性　　

        end

     else

        begin

           Result[I] := char(byte(S1[I]) xor (Key shr ));

           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 =  then

 begin

   result := false;

   exit;

 end;

 for i :=  to j do

 begin

   str := Value[i];

   if not (str in [''..'']) then

   begin

     result := false;

     exit;

   end;

 end;

end;

{随机字符串函数}

function RandomStr(aLength : Longint) : String;

var

 X : Longint;

begin

 if aLength <=  then exit;

 SetLength(Result, aLength);

 for X:= to aLength do

   Result[X] := Chr(Random() + );

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= then

  begin

    V_month:=;

      inc(V_year);

  end

  else

  inc(V_month);

V_date:=EncodeDate(V_year,V_month,);

V_date:=V_date-;

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  = ) and ((nYear mod  <> ) or (nYear mod  = ));

end;

//两个日期取较大的日期

function MaxDateTime(const Values: array of TDateTime): TDateTime;

var

 I: Cardinal;

begin

 Result := Values[];

 for I :=  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[];

 for I :=  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, );

end;

//得到本月的最后一天

function dateEndOfMonth(D: TDateTime): TDateTime;

var

 Year, Month, Day: Word;

begin

 DecodeDate(D, Year, Month, Day);

 if Month =  then

 begin

   Inc(Year);

   Month := ;

 end else

   Inc(Month);

 Result := EncodeDate(Year, Month, ) - ;

end;

//得到本年的最后一天

function dateEndOfYear(D: TDateTime): TDateTime;

var

 Year, Month, Day: Word;

begin

 DecodeDate(D, Year, Month, Day);

 Result := EncodeDate(Year, , );

end;

//得到两个日期相隔的天数

function DaysBetween(Date1, Date2: TDateTime): integer;

begin

 Result := Trunc(Date2) - Trunc(Date1) + ;

 if Result <  then Result := ;

end;

//▎============================================================▎//

//▎=====================③位操作函数===========================▎//

//▎============================================================▎//

// 设置位

procedure SetBit(var Value: Byte; Bit: TByteBit; IsSet: Boolean);

begin

 if IsSet then

   Value := Value or ( shl Bit)

 else

   Value := Value and not ( shl Bit);

end;

procedure SetBit(var Value: WORD; Bit: TWordBit; IsSet: Boolean);

begin

 if IsSet then

   Value := Value or ( shl Bit)

 else

   Value := Value and not ( shl Bit);

end;

procedure SetBit(var Value: DWORD; Bit: TDWordBit; IsSet: Boolean);

begin

 if IsSet then

   Value := Value or ( shl Bit)

 else

   Value := Value and not ( shl Bit);

end;

// 取位

function GetBit(Value: Byte; Bit: TByteBit): Boolean;

begin

 Result := Value and ( shl Bit) <> ;

end;

function GetBit(Value: WORD; Bit: TWordBit): Boolean;

begin

 Result := Value and ( shl Bit) <> ;

end;

function GetBit(Value: DWORD; Bit: TDWordBit): Boolean;

begin

 Result := Value and ( shl Bit) <> ;

end;

//▎============================================================▎//

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

//▎============================================================▎//

// 移动文件、目录

function MoveFile(const sName, dName: string): Boolean;

var

 s1, s2: AnsiString;

 lpFileOp: TSHFileOpStruct;

begin

 s1 := PChar(sName) + ##;

 s2 := PChar(dName) + ##;

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

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 := ;

   hInstApp := ;

   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 <= ) then

 begin

   Result := APath;

   Exit

 end

 else

 begin

   i := SLen;

   TString := APath;

   for j :=  to  do

   begin

     while (TString[i] <> '/') and (SLen - i < Width - ) do

       i := i - ;

     i := i - ;

   end;

   for j := SLen - i -  downto  do

     TString[Width - j] := TString[SLen - j];

   for j := SLen - i to SLen - i +  do

     TString[Width - j] := '.';

   Delete(TString, Width + , );

   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 + # + Ext + ##);

   lpstrCustomFilter := '';

   nMaxCustFilter := ;

   nFilterIndex := ;

   nMaxFile := MAX_PATH;

   SetLength(TempFilename, nMaxFile + );

   lpstrFile := PChar(TempFilename);

   FillChar(lpstrFile^, MAX_PATH, );

   SetLength(TempFilename, nMaxFile + );

   nMaxFileTitle := MAX_PATH;

   SetLength(ReturnFile, MAX_PATH + );

   lpstrFileTitle := PChar(ReturnFile);

   FillChar(lpstrFile^, MAX_PATH, );

   lpstrInitialDir := '.';

   lpstrTitle := PChar(Title);

   Flags := OFN_HIDEREADONLY + OFN_ENABLESIZING;

   nFileOffset := ;

   nFileExtension := ;

   lpstrDefExt := PChar(Ext);

   lCustData := ;

   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 = ) and (Length(s1) > ) do

   begin

     if s1 = '' then Exit;

     s1 := ExtractFileDir(s1);

     Result := Pos(s1, s2);

   end;

   if Result <>  then Result := Length(s1);

   if Result =  then Result := ;

   // 修正因ExtractFileDir()处理'c:/'时产生的错误.

 end;

 // 取Dest的相对根路径的函数

 function GetRoot(s: ShortString): string;

 var

   i: Integer;

 begin

   Result := '';

   for i :=  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 - );

 // 返回

 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[..] of Char;

 zCurDir: array[..] of Char;

 WorkDir: string;

 StartupInfo: TStartupInfo;

 ProcessInfo: TProcessInformation;

begin

 StrPCopy(zAppName, FileName);

 GetDir(, WorkDir);

 StrPCopy(zCurDir, WorkDir);

 FillChar(StartupInfo, SizeOf(StartupInfo), #);

 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 := -                        { 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[..MAX_PATH] of Char;

begin

 GetWindowsDirectory(Buf, MAX_PATH);

 Result := AddDirSuffix(Buf);

end;

// 取临时文件目录

function GetWinTempDir: string;

var

 Buf: array[..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, ,

   nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, );

 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 := ;

 end;

 {$I+}

end;

// 设置文件时间

function SetFileDate(FileName: string; CreationTime, LastWriteTime, LastAccessTime:

 TFileTime): Boolean;

var

 FileHandle: Integer;

begin

 FileHandle := FileOpen(FileName, fmOpenWrite or fmShareDenyNone);

 if FileHandle >  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 >  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),

   ,

   SHFileInfo,

   SizeOf(SHFileInfo),

   SHGFI_ICON or SHGFI_SYSICONINDEX);

 Icon.Handle := SHFileInfo.hIcon;

 Result := (h <> );

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 =  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 := ;

 fr := FindFirst(AddDirSuffix(Dir) + '*.*', faAnyFile, sr);

 while fr =  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 =  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= do

 begin

   FileList.Add(FSearchRec.Name);

   FindResult:=FindNext(FSearchRec);

 end; 

 if ContainSubDir then

 begin

   FindResult:=FindFirst(path+Filter,faDirectory,DSearchRec);

   while FindResult= 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 := ;

 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:= to line- do

        Begin

           lineS:=Mystring[i];

           Llen:=length(lineS);

           j:=;

           while (j<=Llen)and(lineS[j]=' ')do

           begin

              j:=j+;

              s:=s+' ';

           End;

           while j<=Llen do

           Begin

              if lineS[j]='<'then

                 rloop:=True;

                 if lineS[j]='>'then

                    Begin

                       rloop:=False;

                       j:=j+;

                       continue;

                    End;

                 if rloop then

                    begin

                       j:=j+;

                       continue;

                    end

                 else

                   s:=s+lineS[j];

                    j:=j+;

           End;

           s:=s+##;

        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,,AW_HIDE or AW_BLEND);

 end

 else

   if IsSetAni then

   begin

     AnimateWindow(Sender.Handle,,AW_HIDE or AW_CENTER);

   end;

end;

//▎============================================================▎//

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

//▎============================================================▎//

// 移动鼠标到控件

procedure MoveMouseIntoControl(AWinControl: TControl);

var

 rtControl: TRect;

begin

 rtControl := AWinControl.BoundsRect;

 MapWindowPoints(AWinControl.Parent.Handle, , rtControl, );

 SetCursorPos(rtControl.Left + (rtControl.Right - rtControl.Left) div ,

   rtControl.Top + (rtControl.Bottom - rtControl.Top) div );

end;

// 动态设置分辨率

function DynamicResolution(x, y: WORD): Boolean;

var

 lpDevMode: TDeviceMode;

begin

 Result := EnumDisplaySettings(nil, , lpDevMode);

 if Result then

 begin

   lpDevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;

   lpDevMode.dmPelsWidth := x;

   lpDevMode.dmPelsHeight := y;

   Result := ChangeDisplaySettings(lpDevMode, ) = 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], , , , , 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 = ;

var

  sUserName : string;

  dwUserNameLen : Dword;

begin

  dwUserNameLen := cnMaxUserNameLen-;

  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,)=',' then

     ObjSysVersion:=Substr(ObjSysVersion,,length(ObjSysVersion)-);

  Result:=ObjSysVersion;

end;

//Windows启动模式

function WinBootMode:string;

begin

  case(GetSystemMetrics(SM_CLEANBOOT)) of

     :Result:='正常模式启动';

     :Result:='安全模式启动';

     :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[].Luid) then Exit;

     tp.PrivilegeCount := ;

     tp.Privileges[].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 := ;

 case ShutWinType of

   UPowerOff:  ExitWindowsEx(Flags or EWX_POWEROFF, );

   UShutdown:  ExitWindowsEx(Flags or EWX_SHUTDOWN, );

   UReboot:    ExitWindowsEx(Flags or EWX_REBOOT, );

   ULogoff:    ExitWindowsEx(Flags or EWX_LOGOFF, );

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

end;

// 声卡是否存在

function SoundCardExist: Boolean;

begin

 Result := WaveOutGetNumDevs > ;

end;

//* 获取磁盘序列号

function GetDiskSerial(DiskChar: Char): string;

var

  SerialNum : pdword;

  a, b : dword;

  Buffer : array [..] of char;

begin

  result := '';

  if GetVolumeInformation(PChar(diskchar+':/'), Buffer, SizeOf(Buffer), SerialNum,a, b, nil, ) then

     Result := IntToStr(SerialNum^);

end;

//*检查磁盘准备是否就绪

function DiskReady(Root: string) : Boolean;

var

  Oem : CARDINAL ;

  Dw1,Dw2 : DWORD ;

begin

  Oem := SetErrorMode( SEM_FAILCRITICALERRORS ) ;

  if LENGTH(Root) =  then Root := Root + '://';

     Result := GetVolumeInformation( PCHAR( Root ), NIL,,NIL, Dw1,Dw2, NIL, ) ;

  SetErrorMode( Oem ) ;

end;

//*检查驱动器A中磁盘的是否有文件及文件状态

function DriveState (driveletter: Char) : TDriveState;

var

  mask: String[];

  sRec: TSearchRec;

  oldMode: Cardinal;

  retcode: Integer;

begin

  oldMode := SetErrorMode(SEM_FAILCRITICALERRORS);

  mask:= '?:/*.*';

  mask[] := driveletter;

  {$I-}

  retcode := FindFirst (mask, faAnyfile, Srec);

  FindClose(Srec);

  {$I+}

  case retcode of

   : Result := DSDISK_WITHFILES; //磁盘有文件

  - : Result := DSEMPTYDISK; //好的空磁盘

  -, -: 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 = ;

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

  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,

 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 ;

end;

//▎============================================================▎//

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

//▎============================================================▎//

{* 获取网络计算机名称}

function GetComputerName:string;

var

  wVersionRequested : WORD;

  wsaData : TWSAData;

  p : PHostEnt; s : array[..] of char;

begin

  try

     wVersionRequested := MAKEWORD(, ); //创建 WinSock

     WSAStartup(wVersionRequested, wsaData); //创建 WinSock

     GetHostName(@s,);

     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[..] of char; p2 : pchar;

begin

  try

     wVersionRequested := MAKEWORD(, ); //创建 WinSock

     WSAStartup(wVersionRequested, wsaData); //创建 WinSock

     GetHostName(@s,);

     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[.., ..] of Integer = ((, ), (, ), (, ),

   (, ), (, ), (, ), (, ), (, ), (, ),

   (, ), (, ), (, ), (, ), (, ), (, ),

   (, ), (, ), (, ), (, ), (, ), (, ),

   (, ), (, ), (, ), (, ), (, ));

var

 i, j, HzOrd: Integer;

begin

 Result:='';

 i := ;

 while i <= Length(AHzStr) do

 begin

   if (AHzStr[i] >= #) and (AHzStr[i + ] >= #) then

   begin

     HzOrd := (Ord(AHzStr[i]) - ) *  + Ord(AHzStr[i + ]) - ;

     for j :=  to  do

     begin

       if (HzOrd >= ChinaCode[j][]) and (HzOrd <= ChinaCode[j][]) 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:=;

  For i:= to Length(SW) do

  begin

     c:=SW[i];

     if Length(c)> 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 [..] 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,) ;

              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= 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= 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= then//使用Windows NT验证模式

            ConnectionString:='Provider=MSDASQL.1;'+

                              'Password="";'+

                              'Persist Security Info=False;'+

                              'User ID=sa;Data Source='+''''+DBName+''''+';'+

                              'Initial Catalog='+''''+DBname+'''';

         if ValidateMode= 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)+' 表出错，建立未能成功 ！'),'建立失败',+);

        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) <>  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) <>  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 :=  to Length(AStr) do

     begin

        Result := Result + Format('%2x', [Byte(AStr[I])]);

     end;

     I := Pos(' ', Result);

     While I <>  do

     begin

        Result[I] := '';

        I := Pos(' ', Result);

     end;

end;

//十六进制转化成字符

function HexToStr(AStr: string): string;

var

  I : Integer;

  CharValue: Word;

  begin

  Result := '';

  for I :=  to Trunc(Length(Astr)/) do

  begin

     Result := Result + ' ';

     CharValue := TransChar(AStr[*I-])* + TransChar(AStr[*I]);

     Result[I] := Char(CharValue);

  end;

end;

function TransChar(AChar: Char): Integer;

begin

  if AChar in [''..''] then

     Result := Ord(AChar) - Ord('')

  else

     Result :=  + 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,

       JBE    @@OK

       MOV    EAX,

@@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 = ; const Delay: WORD = );

const

 FREQ_SCALE = $;

var

 Temp: WORD;

begin

 Temp := FREQ_SCALE div Freq;

 asm

   in al,61h;

   or al,;

   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,$;

   and al,$fc;

   out $,al;

 end;

end;

// 显示Win32 Api运行结果信息

procedure ShowLastError;

var

 ErrNo: Integer;

 Buf: array[..] of Char;

begin

 ErrNo := GetLastError;

 FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, ErrNo, $, Buf, , nil);

 if Buf = '' then StrCopy(@Buf, PChar(SUnknowError));

 MessageBox(Application.Handle, PChar(string(Buf) + ## +

   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) >  then MyFontStyle := MyFontStyle +   [fsBold];

 if Pos('fsItalic', MyStyle) >  then MyFontStyle := MyFontStyle + [fsItalic];

 if Pos('fsUnderline', MyStyle) >  then

   MyFontStyle := MyFontStyle + [fsUnderline];

 if Pos('fsStrikeOut', MyStyle) >  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,);

  x := SourceMemo.SelStart- SendMessage(SourceMemo.Handle,EM_LINEINDEX,y,);

  Result := '行:'+inttostr(y+)+' '+'列:'+inttostr(x+);

end;

//*检查Tmemo控件能否Undo功能

function CanUndo(AMemo: TMemo): Boolean;

begin

  Result :=AMemo.Perform(EM_CANUNDO, , )<>;

end;

//* 实现Undo功能

procedure Undo(Amemo: Tmemo);

begin

  Amemo.Perform(EM_UNDO, , );

end;

//* 实现ComBoBox自动下拉

procedure AutoListDisplay(ACombox:TComboBox);

begin

  SendMessage(ACombox.handle, CB_SHOWDROPDOWN, Integer(True), );

end;

//* 小写金额转换为大写

function UpperMoney(small:real):string;

var

  SmallMonth,BigMonth:string;

  wei1,qianwei1:string[];

  qianwei,dianweizhi,qian:integer;

  ObjSmall:real;

begin

  {------- 修改参数令值更精确 -------}

  ObjSmall:=Abs(small);

  qianwei:=-;{小数点后的位置，需要的话也可以改动-2值}

  Smallmonth:=formatfloat('0.00',ObjSmall);{转换成货币形式，需要的话小数点后加多几个零}

  {---------------------------------}

  dianweizhi :=pos('.',Smallmonth);{小数点的位置}

  for qian:=length(Smallmonth) downto  do{循环小写货币的每一位，从小写的右边位置到左边}

  begin

     if qian<>dianweizhi then{如果读到的不是小数点就继续}

        begin

           case strtoint(copy(Smallmonth,qian,)) of{位置上的数转换成大写}

           :wei1:='壹';

           :wei1:='贰';

           :wei1:='叁';

           :wei1:='肆';

           :wei1:='伍';

           :wei1:='陆';

           :wei1:='柒';

           :wei1:='捌';

           :wei1:='玖';

           :wei1:='零';

           end;

           case qianwei of{判断大写位置，可以继续增大到real类型的最大值}

           -:qianwei1:='厘';

           -:qianwei1:='分';

           -:qianwei1:='角';

            :qianwei1:='元';

            :qianwei1:='拾';

            :qianwei1:='佰';

            :qianwei1:='千';

            :qianwei1:='万';

            :qianwei1:='拾';

            :qianwei1:='佰';

            :qianwei1:='千';

            :qianwei1:='亿';

            :qianwei1:='十';

           :qianwei1:='佰';

           :qianwei1:='千';

           end;

           inc(qianwei);

           if Small< 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 := ;

  If Num =  then Exit;;

     GetSystemTime(T);

     X := Trunc(T.wMilliseconds/) * T.wSecond * ;

     X := X + random();

     if X<> then

        X := -X;

     X := Random(X);

     X := X mod num;

     for I :=  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 <>  then begin

     i := Screen.Imes.IndexOf(ImeName);

     if i >=  then MyHKL := hkl(Screen.Imes.Objects[i]);

     ActivateKeyboardLayout(MyHKL, KLF_ACTIVATE);

   end;

 end;

end;

//关闭输入法

procedure CloseIME;

var

 MyHKL: hkl;

begin

 MyHKL := GetKeyboardLayout();

 if ImmIsIme(MyHKL) then

   ImmSimulateHotKey(Application.Handle, IME_CHOTKEY_IME_NONIME_TOGGLE);

end;

//打开中文输入法

procedure ToChinese(hWindows: THandle; bChinese: boolean);

begin

 if ImmIsIME(GetKeyboardLayOut()) <> bChinese then

   ImmSimulateHotKey(hWindows, IME_THotKey_IME_NonIME_Toggle);

end;

//数据备份

procedure BackUpData(LpBackDispMessTitle:String);

var

  i,j:integer;

  Source,Dest:array[..]of char;

  s1:string;

  Lp:_SHFILEOPSTRUCTA;

  Success:Integer;

begin

  if MessageBox(Application.Handle,' 您确认要备份数据吗？','询问窗口',++)= then

  begin

     with LP do

     begin

    Lp.wnd:=Application.Handle;

        wFunc:=FO_COPY;

        s1:='DATA/*.*';

        i:=Length(s1);

        StrCopy(Source,PChar(s1));

        Source[i]:=#;

        Source[i+]:=#;

        Source[i+]:=#;

        pFrom:=Source;

        s1:='BACKUP';

        j:=Length(s1);

        StrCopy(Dest,PChar(s1));

        Dest[j]:='/';

        Dest[j+]:=#;

        Dest[j+]:=#;

        Dest[j+]:=#;

        pTo:=Dest;

        fFlags:=FOF_ALLOWUNDO;

        fAnyOperationsAborted:=False;

        lpszProgressTitle:=PChar(LpBackDispMessTitle);

     end;

    Success:=SHFileOperation(LP);

     case Success of

        :

           MessageBox(Application.Handle,' 所有数据已备份完成 ！','提示窗口',+);

        :

           MessageBox(Application.Handle,Pchar(' 您未创建“'+ExtractFilePath(Application.ExeName)+'BACKUP”目录所以不能完成数据备份 ！'),'提示窗口',+)

        else

           MessageBox(Application.Handle,' 在备份数据的过程中被用户中途中断 ！','提示窗口',+);

     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:= to FileStringList.Count- 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.