在线时间:8:00-16:00
迪恩网络APP
随时随地掌握行业动态
扫描二维码
关注迪恩网络微信公众号
{▎ ①: 扩展的字符串操作函数 ▎} {▎ ②: 扩展的日期时间操作函数 ▎} {▎ ③: 扩展的位操作函数 ▎} {▎ ④: 扩展的文件及目录操作函数 ▎} {▎ ⑤: 扩展的对话框函数 ▎} {▎ ⑥: 系统功能函数 ▎} {▎ ⑦: 硬件功能函数 ▎} {▎ ⑧: 网络功能函数 ▎} {▎ ⑨: 汉字拼音函数及过程 ▎} {▎ ⑩: 数据库功能函数 ▎} {▎ ⑾: 进制功能函数 ▎} {▎ ⑿: 其它功能函数 ▎} {▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎▎} 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=52845; //字符串加密算法的公匙 C2=22719; //字符串加密算法的公匙 resourcestring {$IFDEF GB2312} SUnknowError = '未知错误'; SErrorCode = '错误代码:'; {$ELSE} SUnknowError = 'Unknow error'; SErrorCode = 'Error code:'; {$ENDIF} type EDBUpdateErr = class(Exception);//修改表结构时触发的错误句柄 //▎============================================================▎// //▎================① 扩展的字符串操作函数 ===================▎// //▎============================================================▎// //从文件中返回Ado连接字串。 function GetConnectionString(DataBaseName:string):string; //返回服务器的机器名称. function GetRemoteServerName:string; function InStr(const sShort: string; const sLong: string): Boolean; {测试通过} {* 判断s1是否包含在s2中} function IntToStrEx(Value: Integer; Len: Integer; FillChar: Char = '0'): string; {测试通过} {* 扩展整数转字符串函数 Example: IntToStrEx(1,5,'0'); 返回:"00001"} function IntToStrSp(Value: Integer; SpLen: Integer = 3; Sp: Char = ','): string; {测试通过} {* 带分隔符的整数-字符转换} function ByteToBin(Value: Byte): string; {测试通过} {* 字节转二进制串} function StrRight(Str: string; Len: Integer): string; {测试通过} {* 返回字符串右边的字符 Examples: StrRight('ABCEDFG',3); 返回:'DFG' } function StrLeft(Str: string; Len: Integer): string; {测试通过} {* 返回字符串左边的字符} function Spc(Len: Integer): string; {测试通过} {* 返回空格串} function Replace(Str,s1,s2:string;CaseSensitive:Boolean):string; {测试通过} {* 返回将指定字符s1用字符串s2替换后的字符串,可支持大小写敏感由CaseSensitive操作} {example: replace('We know what we want','we','I',false) = 'I Know what I want'} function Replicate(pcChar:Char; piCount:integer):string; {在一个字符串中查找某个字符串的位置} function StrNum(ShortStr:string;LongString:string):Integer; {测试通过} {* 返回某个字符串中某个字符串中出现的次数} function FindStr(ShortStr:String;LongStrIng:String):Integer; {测试通过} {* 返回某个字符串中查找某个字符串的位置} function SubStr(psInput:String; BeginPlace,CutLeng:Integer):String; {测试通过} {* 返回从位置BeginPlace开始切取长度为CatLeng字符串} function LeftStr(psInput:String; CutLeng:Integer):String; {测试通过} {* 返回从左边第一为开始切取 CutLeng长度的字符串} function RightStr(psInput:String; CutLeng:Integer):String; {测试通过} {* 返回从右边第一为开始切取 CutLeng长度的字符串} function PadLStr(psInput:String; piWidth:Integer; pcPadWith:Char):String; {测试通过} {* 返回从psInput字符串左边开始用pcPadWith填充后总长度为PiWidth的字符串} function PadRStr(psInput:String; piWidth:Integer; pcPadWith:Char):String; {测试通过} {* 返回从psInput字符串右边开始用pcPadWith填充后总长度为PiWidth的字符串} function PadCStr(psInput:String; piWidth:Integer; pcPadWith:Char):String; {测试通过} {* 返回从psInput字符串两边开始用pcPadWith填充后总长度为PiWidth的字符串} function ChrTran(psInput:String; pcSearch:Char; pcTranWith:Char):String; {测试通过} {* 返回替换后字符串[替换单个字符] Examples: ChrTran('abCdEgdlkh','d','#'); 返回'abC#Eg#lkh'} function StrTran(psInput:String; psSearch:String; psTranWith:String):String; {测试通过} {* 返回替换后字符串[替换字符串] Examples: StrTran('aruyfbn','ruy','=====');; 返回'a=====fbn'} function Stuff(psInput:String; piBeginPlace,piCount:Integer; psStuffWith:String):String; { *返回替换后字符串[替换字符串] Examples: Stuff('ABCDEFGHI',3,4,'12345');返回'AB12345GHI'} procedure SwapStr(var s1, s2: string); {测试通过} {* 交换字串} function LinesToStr(const Lines: string): string; {测试通过} {* 多行文本转单行(换行符转'\n')} function StrToLines(const Str: string): string; {测试通过} {* 单行文本转多行('\n'转换行符)} function Encrypt(const S: String; Key: Word): String; {* 字符串加密函数} function Decrypt(const S: String; Key: Word): String; {* 字符串解密函数} function varIIF(aTest: Boolean; TrueValue, FalseValue: Variant): Variant; function varToStr(const V: Variant): string; {* VarIIF及VartoStr为变体函数} function IsDigital(Value: string): boolean; {功能说明:判断string是否全是数字} function RandomStr(aLength : Longint) : String; {随机字符串函数} //▎============================================================▎// //▎================② 扩展的日期时间操作函数 =================▎// //▎============================================================▎// function GetYear(Date: TDate): Integer; {测试通过} {* 取日期年份分量} function GetMonth(Date: TDate): Integer; {测试通过} {* 取日期月份分量} function GetDay(Date: TDate): Integer; {测试通过} {* 取日期天数分量} function GetHour(Time: TTime): Integer; {测试通过} {* 取时间小时分量} function GetMinute(Time: TTime): Integer; {测试通过} {* 取时间分钟分量} function GetSecond(Time: TTime): Integer; {测试通过} {* 取时间秒分量} function GetMSecond(Time: TTime): Integer; {测试通过} {* 取时间毫秒分量} function GetMonthLastDay(Cs_Year,Cs_Month:string):string; { *传入年、月,得到该月份最后一天} function IsLeapYear( nYear: Integer ): Boolean; {*/判断某年是否为闰年} function MaxDateTime(const Values: array of TDateTime): TDateTime; {//两个日期取较大的日期} function MinDateTime(const Values: array of TDateTime): TDateTime; {//两个日期取较小的日期} function dateBeginOfMonth(D: TDateTime): TDateTime; {//得到本月的第一天} function DateEndOfMonth(D: TDateTime): TDateTime; {//得到本月的最后一天} function DateEndOfYear(D: TDateTime): TDateTime; {//得到本年的最后一天} function DaysBetween(Date1, Date2: TDateTime): integer; {//得到两个日期相隔的天数} //▎============================================================▎// //▎===================③ 扩展的位操作函数 ====================▎// //▎============================================================▎// type TByteBit = 0..7; {* Byte类型位数范围} TWordBit = 0..15; {* Word类型位数范围} TDWordBit = 0..31; {* DWord类型位数范围} procedure SetBit(var Value: Byte; Bit: TByteBit; IsSet: Boolean); overload; {* 设置二进制位} procedure SetBit(var Value: WORD; Bit: TWordBit; IsSet: Boolean); overload; {* 设置二进制位} procedure SetBit(var Value: DWORD; Bit: TDWordBit; IsSet: Boolean); overload; {* 设置二进制位} function GetBit(Value: Byte; Bit: TByteBit): Boolean; overload; {* 取二进制位} function GetBit(Value: WORD; Bit: TWordBit): Boolean; overload; {* 取二进制位} function GetBit(Value: DWORD; Bit: TDWordBit): Boolean; overload; {* 取二进制位} //▎============================================================▎// //▎=================④扩展的文件及目录操作函数=================▎// //▎============================================================▎// function MoveFile(const sName, dName: string): Boolean; {测试通过} {* 移动文件、目录,参数为源、目标名} procedure FileProperties(const FName: string); {测试通过} {* 打开文件属性窗口} function OpenDialog(var FileName: string; Title: string; Filter: string; Ext: string): Boolean; {* 打开文件框} function FormatPath(APath: string; Width: Integer): string; {测试通过} {* 缩短显示不下的长路径名} function GetRelativePath(Source, Dest: string): string; {测试通过} {* 取两个目录的相对路径,注意串尾不能是'\'字符!} procedure RunFile(const FName: string; Handle: THandle = 0; const Param: string = ''); {测试通过} {* 运行一个文件} function WinExecAndWait32(FileName: string; Visibility: Integer = SW_NORMAL): Integer; {测试通过} {* 运行一个文件并等待其结束} function AppPath: string; {测试通过} {* 应用程序路径} function GetWindowsDir: string; {测试通过} {* 取Windows系统目录} function GetWinTempDir: string; {测试通过} {* 取临时文件目录} function AddDirSuffix(Dir: string): string; {测试通过} {* 目录尾加'\'修正} function MakePath(Dir: string): string; {测试通过} {* 目录尾加'\'修正} function IsFileInUse(FName: string): Boolean; {测试通过} {* 判断文件是否正在使用} function GetFileSize(FileName: string): Integer; {测试通过} {* 取文件长度} function SetFileDate(FileName: string; CreationTime, LastWriteTime, LastAccessTime: TFileTime): Boolean; {测试通过} {* 设置文件时间 Example: FileSetDate('c:\Test\Test1.exe',753160662); } function GetFileDate(FileName: string; var CreationTime, LastWriteTime, LastAccessTime: TFileTime): Boolean; {测试通过} {* 取文件时间} function FileTimeToLocalSystemTime(FTime: TFileTime): TSystemTime; {测试通过} {* 文件时间转本地时间} function LocalSystemTimeToFileTime(STime: TSystemTime): TFileTime; {测试通过} {* 本地时间转文件时间} function GetFileIcon(FileName: string; var Icon: TIcon): Boolean; {测试通过} {* 取得与文件相关的图标,成功则返回True} function CreateBakFile(FileName, Ext: string): Boolean; {测试通过} {* 创建备份文件} function Deltree(Dir: string): Boolean; {测试通过} {* 删除整个目录} function GetDirFiles(Dir: string): Integer; {测试通过} {* 取文件夹文件数} type TFindCallBack = procedure(const FileName: string; const Info: TSearchRec; var Abort: Boolean); {* 查找指定目录下文件的回调函数} procedure FindFile(const Path: string; const FileName: string = '*.*'; Proc: TFindCallBack = nil; bSub: Boolean = True; const bMsg: Boolean = True); {* 查找指定目录下文件} procedure FindFileList(Path,Filter:string;FileList:TStrings;ContainSubDir:Boolean); { 功能说明:查找一个路径下的所有文件。 参数: path:路径,filter:文件扩展名过滤,FileList:文件列表, ContainSubDir:是否包含子目录} function Txtline(const txt: string): integer; {* 返回一文本文件的行数} function Html2Txt(htmlfilename: string): string; {* Html文件转化成文本文件} function OpenWith(const FileName: string): Integer; {测试通过} {* 文件打开方式} //▎============================================================▎// //▎====================⑤扩展的对话框函数======================▎// //▎============================================================▎// procedure InfoDlg(Mess: string; Caption: string = SCnInformation; Flags: Integer = MB_OK + MB_ICONINFORMATION); {测试通过} {* 显示提示窗口} function InfoOk(Mess: string; Caption: string = SCnInformation): Boolean; {测试通过} {* 显示提示确认窗口} procedure ErrorDlg(Mess: string; Caption: string = SCnError); {测试通过} {* 显示错误窗口} procedure WarningDlg(Mess: string; Caption: string = SCnWarning); {测试通过} {* 显示警告窗口} function QueryDlg(Mess: string; Caption: string = SCnInformation): Boolean; {测试通过} {* 显示查询是否窗口} procedure SetWindowAnimate(Sender : TForm; IsSetAni : bool); //▎============================================================▎// //▎=====================⑥系统功能函数=========================▎// //▎============================================================▎// procedure MoveMouseIntoControl(AWinControl: TControl); {测试通过} {* 移动鼠标到控件} function DynamicResolution(x, y: WORD): Boolean; {测试通过} {* 动态设置分辨率} procedure StayOnTop(Handle: HWND; OnTop: Boolean); {测试通过} {* 窗口最上方显示} procedure SetHidden(Hide: Boolean); {测试通过} {* 设置程序是否出现在任务栏} procedure SetTaskBarVisible(Visible: Boolean); {测试通过} {* 设置任务栏是否可见} procedure SetDesktopVisible(Visible: Boolean); {测试通过} {* 设置桌面是否可见} procedure BeginWait; {测试通过} {* 显示等待光标} procedure EndWait; {测试通过} {* 结束等待光标} function CheckWindows9598NT: string; {测试通过} {* 检测是否Win95/98/NT平台} function GetOSInfo : String; {测试通过} {* 取得当前操作平台是 Windows 95/98 还是NT} function GetCurrentUserName : string; {*获取当前Windows登录名的用户} function GetRegistryOrg_User(UserKeyType:string):string; {*获取当前注册的单位及用户名称} function GetSysVersion:string; {*//获取操作系统版本号} function WinBootMode:string; {//Windows启动模式} type PShutType = (UPowerOff, UShutdown, UReboot, ULogOff, USuspend, UHibernate); procedure WinShutDown(ShutWinType:PShutType; PForce:Boolean); {//Windows ShutDown等} //▎============================================================▎// //▎=====================⑦硬件功能函数=========================▎// //▎============================================================▎// function GetClientGUID:string; { 功能描述:在本机上得到一个GUID.去掉两端的大括号和中间的横线 返回值:去掉两端的大括号和中间的横线的一个GUID 适用范围:windows } function SoundCardExist: Boolean; {测试通过} {* 声卡是否存在} function GetDiskSerial(DiskChar: Char): string; {* 获取磁盘序列号} function DiskReady(Root: string) : Boolean; {*检查磁盘准备是否就绪} procedure WritePortB( wPort : Word; bValue : Byte ); {* 写串口} function ReadPortB( wPort : Word ) : Byte; {*读串口} function CPUSpeed: Double; {* 获知当前机器CPU的速率(MHz)} type TCPUID = array[1..4] of Longint; function GetCPUID : TCPUID; assembler; register; {*获取CPU的标识ID号*} function GetMemoryTotalPhys : Dword; {*获取计算机的物理内存} type TDriveState = (DSNODISK, DSUNFORMATTEDDISK, DSEMPTYDISK, DSDISK_WITHFILES); function DriveState (driveletter: Char) : TDriveState; {* 检查驱动器A中磁盘是否有效} //▎============================================================▎// //▎=====================⑧网络功能函数=========================▎// //▎============================================================▎// function GetComputerName:string; {* 获取网络计算机名称} function GetHostIP:string; {* 获取计算机的IP地址} function NetUserChangePassword(Domain:PWideChar; UserName:PWideChar; OldPassword:PWideChar; NewPassword:PWideChar): LongInt; stdcall; external 'netapi32.dll' name 'NetUserChangePassword'; {* // 运行平台:Windows NT/2000/XP {* // Windows 95/98/Me平台:可以用该函数修改用户的Windows登录密码} //▎============================================================▎// //▎=====================⑨汉字拼音功能函数=====================▎// //▎============================================================▎// function GetHzPy(const AHzStr: string): string; {测试通过} {* 取汉字的拼音} function HowManyChineseChar(Const s:String):Integer; {* 判断一个字符串中有多少各汉字} //▎============================================================▎// //▎===================⑩数据库功能函数及过程===================▎// //▎============================================================▎// {function PackDbDbf(Var StatusMsg: String): Boolean;} {* 物理删除数据库(Db,Dbf)中的数据[着了删除标记的记录]} procedure RepairDb(DbName: string); {* 修复Access表} function CreateODBCCfgInRegistry(ODBCSourceName:WideString;ServerName, DataBaseDescription:String):boolean; {* 通过注册表创建ODBC配置[创建在系统DSN页下]} function ADOConnectSysBase(Const Adocon:TadoConnection):boolean; {* 用Ado连接SysBase数据库函数} function ADOConnectLocalDB(Const Adocon:TadoConnection;Const Dbname,DbServerName:string;ValidateMode:Integer):boolean; {* 用Ado连接数据库函数} function ADOODBCConnectLocalDB(Const Adocon:TadoConnection;Const Dbname:string;ValidateMode:Integer):boolean; {* 用Ado与ODBC共同连接数据库函数} function CreatTable(LpDataBaseName,LpTableName,LpSentence:string):Boolean; {* //建立新表} function AddField(LpFieldName:string; LpDataType: TFieldType; LpSize: Word):string; {*//在表中添加字段} function KillField(LpFieldName:string):String; {* //在表中删除字段} function AlterTableExec(LpDataBaseName,LpSentence:string):Boolean; {* //修改表结构} function GetSQLSentence(LpTableName,LpSQLsentence:string): string; {* /修改、添加、删除表结构时的SQL句体} //▎============================================================▎// //▎======================⑾进制函数及过程======================▎// //▎============================================================▎// function StrToHex(AStr: string): string; {* 字符转化成十六进制} function HexToStr(AStr: string): string; {* 十六进制转化成字符} function TransChar(AChar: Char): Integer; //▎============================================================▎// //▎=====================⑿其它函数及过程=======================▎// //▎============================================================▎// function TrimInt(Value, Min, Max: Integer): Integer; overload; {测试通过} {* 输出限制在Min..Max之间} function IntToByte(Value: Integer): Byte; overload; {测试通过} {* 输出限制在0..255之间} function InBound(Value: Integer; Min, Max: Integer): Boolean; {测试通过} {* 判断整数Value是否在Min和Max之间} procedure CnSwap(var A, B: Byte); overload; {* 交换两个数} procedure CnSwap(var A, B: Integer); overload; {* 交换两个数} procedure CnSwap(var A, B: Single); overload; {* 交换两个数} procedure CnSwap(var A, B: Double); overload; {* 交换两个数} function RectEqu(Rect1, Rect2: TRect): Boolean; {* 比较两个Rect是否相等} procedure DeRect(Rect: TRect; var x, y, Width, Height: Integer); {* 分解一个TRect为左上角坐标x, y和宽度Width、高度Height} function EnSize(cx, cy: Integer): TSize; {* 返回一个TSize类型} function RectWidth(Rect: TRect): Integer; {* 计算TRect的宽度} function RectHeight(Rect: TRect): Integer; {* 计算TRect的高度} procedure Delay(const uDelay: DWORD); {测试通过} {* 延时} procedure BeepEx(const Freq: WORD = 1200; const Delay: WORD = 1); {Win9X下测试通过} {* 只能在Win9X下让喇叭发声} procedure ShowLastError; {测试通过} {* 显示Win32 Api运行结果信息} function writeFontStyle(FS: TFontStyles; inifile: string; write: boolean):string; {* 将字体Font.Style写入INI文件} function readFontStyle(inifile: string): TFontStyles; {* 从INI文件中读取字体Font.Style文件} //function ReadCursorPos(SourceMemo: TMemo): TPoint; function ReadCursorPos(SourceMemo: TMemo): string; {* 取得TMemo 控件当前光标的行和列信息到Tpoint中} function CanUndo(AMemo: TMemo): Boolean; {* 检查Tmemo控件能否Undo} procedure Undo(Amemo: Tmemo); {*实现Undo功能} procedure AutoListDisplay(ACombox:TComboBox); {* 实现ComBoBox自动下拉} function UpperMoney(small:real):string; {* 小写金额转换为大写 } function Myrandom(Num: Integer): integer; {*利用系统时间产生随机数)} procedure OpenIME(ImeName: string); {*打开输入法} procedure CloseIME; {*关闭输入法} procedure ToChinese(hWindows: THandle; bChinese: boolean); {*打开中文输入法} //数据备份 procedure BackUpData(LpBackDispMessTitle:String); implementation {▎=======函数及过程体开始==========▎} //▎============================================================▎// //▎==================①扩展的字符串操作函数====================▎// //▎============================================================▎// // 判断s1是否包含在s2中 function InStr(const sShort: string; const sLong: string): Boolean; var s1, s2: string; begin s1 := LowerCase(sShort); s2 := LowerCase(sLong); Result := Pos(s1, s2) > 0; end; // 扩展整数转字符串函数,参数分别为目标数、长度、填充字符(默认为0) function IntToStrEx(Value: Integer; Len: Integer; FillChar: Char = '0'): string; begin Result := IntToStr(Value); while Length(Result) < Len do Result := FillChar + Result; end; // 带分隔符的整数-字符转换 function IntToStrSp(Value: Integer; SpLen: Integer = 3; Sp: Char = ','): string; var s: string; i, j: Integer; begin s := IntToStr(Value); Result := ''; j := 0; for i := Length(s) downto 1 do begin Result := s[i] + Result; Inc(j); try if ((j mod SpLen) = 0) and (i <> 1) then Result := Sp + Result; except MessageBox(Application.Handle,' IntToStrSp函数的第二个参数值不能为数字0 !',SCnError,16); exit; end end; end; // 返回字符串右边的字符 function StrRight(Str: string; Len: Integer): string; begin if Len >= Length(Str) then Result := Str else Result := Copy(Str, Length(Str) - Len + 1, Len); end; // 返回字符串左边的字符 function StrLeft(Str: string; Len: Integer): string; begin if Len >= Length(Str) then Result := Str else Result := Copy(Str, 1, Len); end; // 字节转二进制串 function ByteToBin(Value: Byte): string; const V: Byte = 1; var i: Integer; begin for i := 7 downto 0 do if (V shl i) and Value <> 0 then Result := Result + '1' else Result := Result + '0'; end; // 返回空格串 function Spc(Len: Integer): string; var i: Integer; begin Result := ''; for i := 0 to Len - 1 do Result := Result + ' '; end; // 返回将指定字符s1用字符串s2替换后的字符串,可支持大小写敏感由CaseSensitive操作} function Replace(Str,s1,s2:string;CaseSensitive:Boolean):string; var i:integer; s,t:string; begin s:=''; t:=str; repeat if casesensitive then i:=pos(s1,t) else i:=pos(lowercase(s1),lowercase(t)); if i>0 then begin s:=s+Copy(t,1,i-1)+s2; t:=Copy(t,i+Length(s1),MaxInt); end else s:=s+t; until i<=0; result:=s; end; function Replicate(pcChar:Char; piCount:integer):string; begin Result:=''; SetLength(Result,piCount); fillChar(Pointer(Result)^,piCount,pcChar) end; // 返回某个字符串中某个字符串中出现的次数} function StrNum(ShortStr:string;LongString:string):Integer; {测试通过} var i:Integer; begin i:=0; while pos(ShortStr,LongString)>0 do begin i:=i+1; LongString:=Substr(LongString,(FindStr(ShortStr,LongString))+1,Length(LongString)-FindStr(ShortStr,LongString)) end; Result:=i; end; // 返回某个字符串中查找某个字符串的位置} function FindStr(ShortStr:String;LongStrIng:String):Integer;//在一个字符串中找某个字符的位置 var locality:integer; begin locality:=Pos(ShortStr,LongStrIng); if locality=0 then Result:=0 else Result:=locality; end; // 返回从位置BeginPlace开始切取长度为CatLeng字符串} function SubStr(psInput:String; BeginPlace,CutLeng:Integer):String; begin Result:=Copy(psInput,BeginPlace,CutLeng) end; // 返回从左边第一为开始切取 CutLeng长度的字符串 function LeftStr(psInput:String; CutLeng:Integer):String; begin Result:=Copy(psInput,1,CutLeng) end; // 返回从左边第一为开始切取 CutLeng长度的字符串 function RightStr(psInput:String; CutLeng:Integer):String; begin Result:=Copy(psInput,Length(psInput)-CutLeng+1,CutLeng) end; {* 返回从psInput字符串左边开始用pcPadWith填充后总长度为PiWidth的字符串} function PadLStr(psInput:String; piWidth:Integer; pcPadWith:Char):String; begin Result:=Replicate(pcPadWith,piWidth-Length(psInput))+psInput end; {* 返回从psInput字符串右边开始用pcPadWith填充后总长度为PiWidth的字符串} function PadRStr(psInput:String; piWidth:Integer; pcPadWith:Char):String; begin Result:=psInput+Replicate(pcPadWith,piWidth-Length(psInput)) end; {* 返回从psInput字符串两边开始用pcPadWith填充后总长度为PiWidth的字符串} function PadCStr(psInput:String; piWidth:Integer; pcPadWith:Char):String; var liHalf :integer; begin liHalf:=(piWidth-Length(psInput))div 2; Result:=Replicate(pcPadWith,liHalf)+psInput+Replicate(pcPadWith,piWidth-Length(psInput)-liHalf) end; {* 返回替换后字符串 Examples: ChrTran('abCdEgdlkh','d','#'); 返回'bC#Eg#lkh'} function ChrTran(psInput:String; pcSearch:Char; pcTranWith:Char):String; var i,j:integer; begin j:=Length(psInput); for i:=1 to j do begin if psInput[i]=pcSearch then psInput[i]:=pcTranWith end; Result:=psInput end; {* 返回替换后字符串 Examples: StrTran('aruyfbn','ruy','====='); 返回'a=====fbn'} function StrTran(psInput:String; psSearch:String; psTranWith:String):String; var liPosition,liLenOfSrch,liLenOfIn:integer; begin liPosition:=Pos(psSearch,psInput); liLenOfSrch:=Length(psSearch); liLenOfIn:=Length(psInput); while liPosition>0 do begin psInput:=Copy(psInput,1,liPosition-1) +psTranWith +Copy(psInput,liPosition+liLenOfSrch,liLenOfIn); liPosition:=Pos(psSearch,psInput) end; Result:=psInput end; { *返回替换后字符串[替换字符串] Examples: Stuff('ABCDEFGHI',3,4,'12345');返回'AB12345GHI'} function Stuff(psInput:String; piBeginPlace,piCount:Integer; psStuffWith:String):String; begin Result:=Copy(psInput,1,piBeginPlace-1)+ psStuffWith+ Copy(psInput,piBeginPlace+piCount,Length(psInput)) end; // 交换字串 procedure SwapStr(var s1, s2: string); var tempstr: string; begin tempstr := s1; s1 := s2; s2 := tempstr; end; const csLinesCR = #13#10; csStrCR = '\n'; // 多行文本转单行(换行符转'\n') function LinesToStr(const Lines: string): string; var i: Integer; begin Result := Lines; i := Pos(csLinesCR, Result); while i > 0 do begin system.Delete(Result, i, Length(csLinesCR)); system.insert(csStrCR, Result, i); i := Pos(csLinesCR, Result); end; end; // 单行文本转多行('\n'转换行符) function StrToLines(const Str: string): string; var i: Integer; begin Result := Str; i := Pos(csStrCR, Result); while i > 0 do begin system.Delete(Result, i, Length(csStrCR)); system.insert(csLinesCR, Result, i); i := Pos(csStrCR, Result); end; end; //字符串加密函数 function Encrypt(const S: String; Key: Word): String; var I : Integer; begin Result := S; for I := 1 to Length(S) do begin Result[I] := char(byte(S[I]) xor (Key shr 8)); Key := (byte(Result[I]) + Key) * C1 + C2; if Result[I] = Chr(0) then Result[I] := S[I]; end; Result := StrToHex(Result); end; //字符串解密函数 function Decrypt(const S: String; Key: Word): String; var I: Integer; S1: string; begin S1 := HexToStr(S); Result := S1; for I := 1 to Length(S1) do begin if char(byte(S1[I]) xor (Key shr 8)) = Chr(0) then begin Result[I] := S1[I]; Key := (byte(Chr(0)) + Key) * C1 + C2; //保证Key的正确性 end else begin Result[I] := char(byte(S1[I]) xor (Key shr 8)); Key := (byte(S1[I]) + Key) * C1 + C2; end; end; end; ///VarIIF,VarTostr为变体函数 function varIIF(aTest: Boolean; TrueValue, FalseValue: Variant): Variant; begin if aTest then Result := TrueValue else Result := FalseValue; end; function varToStr(const V: Variant): string; begin case TVarData(v).vType of varSmallInt: Result := IntToStr(TVarData(v).VSmallInt); varInteger: Result := IntToStr(TVarData(v).VInteger); varSingle: Result := FloatToStr(TVarData(v).VSingle); varDouble: Result := FloatToStr(TVarData(v).VDouble); varCurrency: Result := FloatToStr(TVarData(v).VCurrency); varDate: Result := DateToStr(TVarData(v).VDate); varBoolean: Result := varIIf(TVarData(v).VBoolean, 'True', 'False'); varByte: Result := IntToStr(TVarData(v).VByte); varString: Result := StrPas(TVarData(v).VString); varEmpty, varNull, varVariant, varUnknown, varTypeMask, varArray, varByRef, varDispatch, varError: Result := ''; end; end; {功能说明:判断string是否全是数字} function IsDigital(Value: string): boolean; var i, j: integer; str: char; begin result := true; Value := trim(Value); j := Length(Value); if j = 0 then begin result := false; exit; end; for i := 1 to j do begin str := Value[i]; if not (str in ['0'..'9']) then begin result := false; exit; end; end; end; {随机字符串函数} function RandomStr(aLength : Longint) : String; var X : Longint; begin if aLength <= 0 then exit; SetLength(Result, aLength); for X:=1 to aLength do Result[X] := Chr(Random(26) + 65); end; //▎============================================================▎// //▎==================②扩展日期时间操作函数====================▎// //▎============================================================▎// function GetYear(Date: TDate): Integer; var y, m, d: WORD; begin DecodeDate(Date, y, m, d); Result := y; end; function GetMonth(Date: TDate): Integer; var y, m, d: WORD; begin DecodeDate(Date, y, m, d); Result := m; end; function GetDay(Date: TDate): Integer; var y, m, d: WORD; begin DecodeDate(Date, y, m, d); Result := d; end; function GetHour(Time: TTime): Integer; var h, m, s, ms: WORD; begin DecodeTime(Time, h, m, s, ms); Result := h; end; function GetMinute(Time: TTime): Integer; var h, m, s, ms: WORD; begin DecodeTime(Time, h, m, s, ms); Result := m; end; function GetSecond(Time: TTime): Integer; var h, m, s, ms: WORD; begin DecodeTime(Time, h, m, s, ms); Result := s; end; function GetMSecond(Time: TTime): Integer; var h, m, s, ms: WORD; begin DecodeTime(Time, h, m, s, ms); Result := ms; end; //传入年、月,得到该月份最后一天 function GetMonthLastDay(Cs_Year,Cs_Month:string):string; Var V_date:Tdate; V_year,V_month,V_day:word; begin V_year:=strtoint(Cs_year); V_month:=strtoint(Cs_month); if V_month=12 then begin V_month:=1; inc(V_year); end else inc(V_month); V_date:=EncodeDate(V_year,V_month,1); V_date:=V_date-1; DecodeDate(V_date,V_year,V_month,V_day); Result:=DateToStr(EncodeDate(V_year,V_month,V_day)); end; //判断某年是否为闰年 function IsLeapYear( nYear: Integer ): Boolean; begin Result := (nYear mod 4 = 0) and ((nYear mod 100 <> 0) or (nYear mod 400 = 0)); end; //两个日期取较大的日期 function MaxDateTime(const Values: array of TDateTime): TDateTime; var I: Cardinal; begin Result := Values[0]; for I := 0 to Low(Values) do if Values[I] < Result then Result := Values[I]; end; //两个日期取较小的日期 function MinDateTime(const Values: array of TDateTime): TDateTime; var I: Cardinal; begin Result := Values[0]; for I := 0 to High(Values) do if Values[I] < Result then Result := Values[I]; end; //得到本月的第一一天 function dateBeginOfMonth(D: TDateTime): TDateTime; var Year, Month, Day: Word; begin DecodeDate(D, Year, Month, Day); Result := EncodeDate(Year, Month, 1); end; //得到本月的最后一天 function dateEndOfMonth(D: TDateTime): TDateTime; var Year, Month, Day: Word; begin DecodeDate(D, Year, Month, Day); if Month = 12 then begin Inc(Year); Month := 1; end else Inc(Month); Result := EncodeDate(Year, Month, 1) - 1; end; //得到本年的最后一天 function dateEndOfYear(D: TDateTime): TDateTime; var Year, Month, Day: Word; begin DecodeDate(D, Year, Month, Day); Result := EncodeDate(Year, 12, 31); end; //得到两个日期相隔的天数 function DaysBetween(Date1, Date2: TDateTime): integer; begin Result := Trunc(Date2) - Trunc(Date1) + 1; if Result < 0 then Result := 0; end; //▎============================================================▎// //▎=====================③位操作函数===========================▎// //▎============================================================▎// // 设置位 procedure SetBit(var Value: Byte; Bit: TByteBit; IsSet: Boolean); begin if IsSet then Value := Value or (1 shl Bit) else Value := Value and not (1 shl Bit); end; procedure SetBit(var Value: WORD; Bit: TWordBit; IsSet: Boolean); begin if IsSet then Value := Value or (1 shl Bit) else Value := Value and not (1 shl Bit); end; procedure SetBit(var Value: DWORD; Bit: TDWordBit; IsSet: Boolean); begin if IsSet then Value := Value or (1 shl Bit) else Value := Value and not (1 shl Bit); end; // 取位 function GetBit(Value: Byte; Bit: TByteBit): Boolean; begin Result := Value and (1 shl Bit) <> 0; end; function GetBit(Value: WORD; Bit: TWordBit): Boolean; begin Result := Value and (1 shl Bit) <> 0; end; function GetBit(Value: DWORD; Bit: TDWordBit): Boolean; begin Result := Value and (1 shl Bit) <> 0; end; //▎============================================================▎// //▎=================④扩展的文件及目录操作函数=================▎// //▎============================================================▎// // 移动文件、目录 function MoveFile(const sName, dName: string): Boolean; var s1, s2: AnsiString; lpFileOp: TSHFileOpStruct; begin s1 := PChar(sName) + #0#0; s2 := PChar(dName) + #0#0; with lpFileOp do begin Wnd := Application.Handle; wFunc := FO_MOVE; pFrom := PChar(s1); pTo := PChar(s2); fFlags := FOF_ALLOWUNDO; hNameMappings := nil; lpszProgressTitle := nil; fAnyOperationsAborted := True; end; Result := SHFileOperation(lpFileOp) = 0; end; // 打开文件属性窗口 procedure FileProperties(const FName: string); var SEI: SHELLEXECUTEINFO; begin with SEI do begin cbSize := SizeOf(SEI); fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_INVOKEIDLIST or SEE_MASK_FLAG_NO_UI; Wnd := Application.Handle; lpVerb := 'properties'; lpFile := PChar(FName); lpParameters := nil; lpDirectory := nil; nShow := 0; hInstApp := 0; lpIDList := nil; end; ShellExecuteEx(@SEI); end; // 缩短显示不下的长路径名 function FormatPath(APath: string; Width: Integer): string; var SLen: Integer; i, j: Integer; TString: string; begin SLen := Length(APath); if (SLen <= Width) or (Width <= 6) then begin Result := APath; Exit end else begin i := SLen; TString := APath; for j := 1 to 2 do begin while (TString[i] <> '\') and (SLen - i < Width - 8) do i := i - 1; i := i - 1; end; for j := SLen - i - 1 downto 0 do TString[Width - j] := TString[SLen - j]; for j := SLen - i to SLen - i + 2 do TString[Width - j] := '.'; Delete(TString, Width + 1, 255); Result := TString; end; end; // 打开文件框 function OpenDialog(var FileName: string; Title: string; Filter: string; Ext: string): Boolean; var OpenName: TOPENFILENAME; TempFilename, ReturnFile: string; begin with OpenName do begin lStructSize := SizeOf(OpenName); hWndOwner := GetModuleHandle(''); Hinstance := SysInit.Hinstance; lpstrFilter := PChar(Filter + #0 + Ext + #0#0); lpstrCustomFilter := ''; nMaxCustFilter := 0; nFilterIndex := 1; nMaxFile := MAX_PATH; SetLength(TempFilename, nMaxFile + 2); lpstrFile := PChar(TempFilename); FillChar(lpstrFile^, MAX_PATH, 0); SetLength(TempFilename, nMaxFile + 2); nMaxFileTitle := MAX_PATH; SetLength(ReturnFile, MAX_PATH + 2); lpstrFileTitle := PChar(ReturnFile); FillChar(lpstrFile^, MAX_PATH, 0); lpstrInitialDir := '.'; lpstrTitle := PChar(Title); Flags := OFN_HIDEREADONLY + OFN_ENABLESIZING; nFileOffset := 0; nFileExtension := 0; lpstrDefExt := PChar(Ext); lCustData := 0; lpfnHook := nil; lpTemplateName := ''; end; Result := GetOpenFileName(OpenName); if Result then FileName := ReturnFile else FileName := ''; end; // 取两个目录的相对路径,注意串尾不能是'\'字符! function GetRelativePath(Source, Dest: string): string; // 比较两路径字符串头部相同串的函数 function GetPathComp(s1, s2: string): Integer; begin if Length(s1) > Length(s2) then swapStr(s1, s2); Result := Pos(s1, s2); while (Result = 0) and (Length(s1) > 3) do begin if s1 = '' then Exit; s1 := ExtractFileDir(s1); Result := Pos(s1, s2); end; if Result <> 0 then Result := Length(s1); if Result = 3 then Result := 2; // 修正因ExtractFileDir()处理'c:\'时产生的错误. end; // 取Dest的相对根路径的函数 function GetRoot(s: ShortString): string; var i: Integer; begin Result := ''; for i := 1 to Length(s) do if s[i] = '\' then Result := Result + '..\'; if Result = '' then Result := '.\'; // 如果不想处理成".\"的路径格式,可去掉本行 end; var RelativRoot, RelativSub: string; HeadNum: Integer; begin Source := UpperCase(Source); Dest := UpperCase(Dest); // 比较两路径字符串头部相同串 HeadNum := GetPathComp(Source, Dest); // 取Dest的相对根路径 RelativRoot := GetRoot(StrRight(Dest, Length(Dest) - HeadNum)); // 取Source的相对子路径 RelativSub := StrRight(Source, Length(Source) - HeadNum - 1); // 返回 Result := RelativRoot + RelativSub; end; // 运行一个文件 procedure RunFile(const FName: string; Handle: THandle; const Param: string); begin ShellExecute(Handle, nil, PChar(FName), PChar(Param), nil, SW_SHOWNORMAL); end; // 运行一个文件并等待其结束 function WinExecAndWait32(FileName: string; Visibility: Integer): Integer; var zAppName: array[0..512] of Char; zCurDir: array[0..255] of Char; WorkDir: string; StartupInfo: TStartupInfo; ProcessInfo: TProcessInformation; begin StrPCopy(zAppName, FileName); GetDir(0, WorkDir); StrPCopy(zCurDir, WorkDir); FillChar(StartupInfo, SizeOf(StartupInfo), #0); StartupInfo.cb := SizeOf(StartupInfo); StartupInfo.dwFlags := STARTF_USESHOWWINDOW; StartupInfo.wShowWindow := Visibility; if not CreateProcess(nil, zAppName, { pointer to command line string } nil, { pointer to process security attributes } nil, { pointer to thread security attributes } False, { handle inheritance flag } CREATE_NEW_CONSOLE or { creation flags } NORMAL_PRIORITY_CLASS, nil, { pointer to new environment block } nil, { pointer to current directory name } StartupInfo, { pointer to STARTUPINFO } ProcessInfo) then Result := -1 { pointer to PROCESS_INF } else begin WaitforSingleObject(ProcessInfo.hProcess, INFINITE); GetExitCodeProcess(ProcessInfo.hProcess, Cardinal(Result)); end; end; // 应用程序路径 function AppPath: string; begin Result := ExtractFilePath(Application.ExeName); end; // 取Windows系统目录 function GetWindowsDir: string; var Buf: array[0..MAX_PATH] of Char; begin GetWindowsDirectory(Buf, MAX_PATH); Result := AddDirSuffix(Buf); end; // 取临时文件目录 function GetWinTempDir: string; var Buf: array[0..MAX_PATH] of Char; begin GetTempPath(MAX_PATH, Buf); Result := AddDirSuffix(Buf); end; // 目录尾加'\'修正 function AddDirSuffix(Dir: string): string; begin Result := Trim(Dir); if Result = '' then Exit; if Result[Length(Result)] <> '\' then Result := Result + '\'; end; function MakePath(Dir: string): string; begin Result := AddDirSuffix(Dir); end; // 判断文件是否正在使用 function IsFileInUse(FName: string): Boolean; var HFileRes: HFILE; begin Result := False; if not FileExists(FName) then Exit; HFileRes := CreateFile(PChar(FName), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); Result := (HFileRes = INVALID_HANDLE_VALUE); if not Result then CloseHandle(HFileRes); end; // 取文件长度 function GetFileSize(FileName: string): Integer; var FileVar: file of Byte; begin {$I-} try AssignFile(FileVar, FileName); Reset(FileVar); Result := FileSize(FileVar); CloseFile(FileVar); except Result := 0; end; {$I+} end; // 设置文件时间 function SetFileDate(FileName: string; CreationTime, LastWriteTime, LastAccessTime: TFileTime): Boolean; var FileHandle: Integer; begin FileHandle := FileOpen(FileName, fmOpenWrite or fmShareDenyNone); if FileHandle > 0 then begin SetFileTime(FileHandle, @CreationTime, @LastAccessTime, @LastWriteTime); FileClose(FileHandle); Result := True; end else Result := False; end; // 取文件时间 function GetFileDate(FileName: string; var CreationTime, LastWriteTime, LastAccessTime: TFileTime): Boolean; var FileHandle: Integer; begin FileHandle := FileOpen(FileName, fmOpenRead or fmShareDenyNone); if FileHandle > 0 then begin GetFileTime(FileHandle, @CreationTime, @LastAccessTime, @LastWriteTime); FileClose(FileHandle); Result := True; end else Result := False; end; // 取得与文件相关的图标 // FileName: e.g. "e:\hao\a.txt" // 成功则返回True function GetFileIcon(FileName: string; var Icon: TIcon): Boolean; var SHFileInfo: TSHFileInfo; h: HWND; begin if not Assigned(Icon) then Icon := TIcon.Create; h := SHGetFileInfo(PChar(FileName), 0, SHFileInfo, SizeOf(SHFileInfo), SHGFI_ICON or SHGFI_SYSICONINDEX); Icon.Handle := SHFileInfo.hIcon; Result := (h <> 0); end; // 文件时间转本地时间 function FileTimeToLocalSystemTime(FTime: TFileTime): TSystemTime; var STime: TSystemTime; begin FileTimeToLocalFileTime(FTime, FTime); FileTimeToSystemTime(FTime, STime); Result := STime; end; // 本地时间转文件时间 function LocalSystemTimeToFileTime(STime: TSystemTime): TFileTime; var FTime: TFileTime; begin SystemTimeToFileTime(STime, FTime); LocalFileTimeToFileTime(FTime, FTime); Result := FTime; end; // 创建备份文件 function CreateBakFile(FileName, Ext: string): Boolean; var BakFileName: string; begin BakFileName := FileName + '.' + Ext; Result := CopyFile(PChar(FileName), PChar(BakFileName), False); end; // 删除整个目录 function Deltree(Dir: string): Boolean; var sr: TSearchRec; fr: Integer; begin if not DirectoryExists(Dir) then begin Result := True; Exit; end; fr := FindFirst(AddDirSuffix(Dir) + '*.*', faAnyFile, sr); try while fr = 0 do begin if (sr.Name <> '.') and (sr.Name <> '..') then begin if sr.Attr and faDirectory = faDirectory then Result := Deltree(AddDirSuffix(Dir) + sr.Name) else Result := DeleteFile(AddDirSuffix(Dir) + sr.Name); if not Result then Exit; end; fr := FindNext(sr); end; finally FindClose(sr); end; Result := RemoveDir(Dir); end; // 取文件夹文件数 function GetDirFiles(Dir: string): Integer; var sr: TSearchRec; fr: Integer; begin Result := 0; fr := FindFirst(AddDirSuffix(Dir) + '*.*', faAnyFile, sr); while fr = 0 do begin if (sr.Name <> '.') and (sr.Name <> '..') then Inc(Result); fr := FindNext(sr); end; FindClose(sr); end; var FindAbort: Boolean; // 查找指定目录下文件 procedure FindFile(const Path: string; const FileName: string = '*.*'; Proc: TFindCallBack = nil; bSub: Boolean = True; const bMsg: Boolean = True); var APath: string; Info: TSearchRec; Succ: Integer; begin FindAbort := False; APath := MakePath(Path); try Succ := FindFirst(APath + FileName, faAnyFile - faVolumeID, Info); while Succ = 0 do begin if (Info.Name <> '.') and (Info.Name <> '..') then begin if (Info.Attr and faDirectory) <> faDirectory then begin if Assigned(Proc) then Proc(APath + Info.FindData.cFileName, Info, FindAbort); end else if bSub then FindFile(APath + Info.Name, FileName, Proc, bSub, bMsg); end; if bMsg then Application.ProcessMessages; if FindAbort then Exit; Succ := FindNext(Info); end; finally FindClose(Info); end; end; { 功能说明:查找一个路径下的所有文件。 参数:path:路径, filter:文件扩展名过滤, FileList:文件列表, ContainSubDir:是否包含子目录} procedure FindFileList(Path,Filter:string;FileList:TStrings;ContainSubDir:Boolean); var FSearchRec,DSearchRec:TSearchRec; FindResult:shortint; begin FindResult:=FindFirst(path+Filter,sysutils.faAnyFile,FSearchRec); try while FindResult=0 do begin FileList.Add(FSearchRec.Name); FindResult:=FindNext(FSearchRec); end; if ContainSubDir then begin FindResult:=FindFirst(path+Filter,faDirectory,DSearchRec); while FindResult=0 do begin if ((DSearchRec.Attr and faDirectory)=faDirectory) and (DSearchRec.Name<>'.') and (DSearchRec.Name<>'..') then FindFileList(Path,Filter,FileList,ContainSubDir); FindResult:=FindNext(DSearchRec); end; end; finally FindClose(FSearchRec); end; end; //返回一文本文件的行数 function Txtline(const txt: string): integer; var F : TextFile; {设定为文本文件} StrLine : string; {每行字符串} line : Integer; {行数} begin AssignFile(F, txt); {建立文件} Reset(F); Line := 0; while not SeekEof(f) do {文件没到尾} begin if SeekEoln(f) then {判断是否到行尾} Readln; Readln(F, StrLine); if SeekEof(f) then break else inc(Line); end; CloseFile(F); {关闭文件} Result := Line; end; //Html文件转化成文本文件 function Html2Txt(htmlfilename: string): string; var Mystring:TStrings; s,lineS:string; line,Llen,i,j:integer; rloop:boolean; begin rloop:=False; Mystring:=TStringlist.Create; s:=''; Mystring.LoadFromFile(htmlfilename); line:=Mystring.Count; try for i:=0 to line-1 do Begin lineS:=Mystring[i]; Llen:=length(lineS); j:=1; while (j<=Llen)and(lineS[j]=' ')do begin j:=j+1; s:=s+' '; End; while j<=Llen do Begin if lineS[j]='<'then rloop:=True; if lineS[j]='>'then Begin rloop:=False; j:=j+1; continue; End; if rloop then begin j:=j+1; continue; end else s:=s+lineS[j]; j:=j+1; End; s:=s+#13#10; End; finally Mystring.Free; end;{try} result:=s; end; // 文件打开方式 function OpenWith(const FileName: string): Integer; begin Result := ShellExecute(Application.Handle, 'open', 'rundll32.exe', PChar('shell32.dll,OpenAs_RunDLL ' + FileName), '', SW_SHOW); end; //▎============================================================▎// //▎===================⑤扩展的对话框函数=======================▎// //▎============================================================▎// // 显示提示窗口 procedure InfoDlg(Mess: string; Caption: string; Flags: Integer); begin Application.MessageBox(PChar(Mess), PChar(Caption), Flags); end; // 显示提示确认窗口 function InfoOk(Mess: string; Caption: string): Boolean; begin Result := Application.MessageBox(PChar(Mess), PChar(Caption), MB_OK + MB_ICONINFORMATION) = IDOK; end; // 显示错误窗口 procedure ErrorDlg(Mess: string; Caption: string); begin Application.MessageBox(PChar(Mess), PChar(Caption), MB_OK + MB_ICONSTOP); end; // 显示警告窗口 procedure WarningDlg(Mess: string; Caption: string); begin Application.MessageBox(PChar(Mess), PChar(Caption), MB_OK + MB_ICONWARNING); end; // 显示查询是否窗口 function QueryDlg(Mess: string; Caption: string): Boolean; begin Result := Application.MessageBox(PChar(Mess), PChar(Caption), MB_YESNO + MB_ICONQUESTION) = IDYES; end; //窗体渐变 procedure SetWindowAnimate(Sender : TForm; IsSetAni : bool); var pOSVersionInfo : OSVersionInfo; begin pOSVersionInfo.dwOSVersionInfoSize := sizeof(OSVersionInfo); GetVersionEx(pOSVersionInfo); if pOSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then begin if IsSetAni then AnimateWindow(Sender.Handle,444,AW_HIDE or AW_BLEND); end else if IsSetAni then begin AnimateWindow(Sender.Handle,444,AW_HIDE or AW_CENTER); end; end; //▎============================================================▎// //▎====================⑥ 系统功能函数 =======================▎// //▎============================================================▎// // 移动鼠标到控件 procedure MoveMouseIntoControl(AWinControl: TControl); var rtControl: TRect; begin rtControl := AWinControl.BoundsRect; MapWindowPoints(AWinControl.Parent.Handle, 0, rtControl, 2); SetCursorPos(rtControl.Left + (rtControl.Right - rtControl.Left) div 2, rtControl.Top + (rtControl.Bottom - rtControl.Top) div 2); end; // 动态设置分辨率 function DynamicResolution(x, y: WORD): Boolean; var lpDevMode: TDeviceMode; begin Result := EnumDisplaySettings(nil, 0, lpDevMode); if Result then begin lpDevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT; lpDevMode.dmPelsWidth := x; lpDevMode.dmPelsHeight := y; Result := ChangeDisplaySettings(lpDevMode, 0) = DISP_CHANGE_SUCCESSFUL; end; end; // 窗口最上方显示 procedure StayOnTop(Handle: HWND; OnTop: Boolean); const csOnTop: array[Boolean] of HWND = (HWND_NOTOPMOST, HWND_TOPMOST); begin SetWindowPos(Handle, csOnTop[OnTop], 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE); end; var WndLong: Integer; // 设置程序是否出现在任务栏 procedure SetHidden(Hide: Boolean); begin ShowWindow(Application.Handle, SW_HIDE); if Hide then SetWindowLong(Application.Handle, GWL_EXSTYLE, WndLong or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW or WS_EX_TOPMOST) else SetWindowLong(Application.Handle, GWL_EXSTYLE, WndLong); ShowWindow(Application.Handle, SW_SHOW); end; const csWndShowFlag: array[Boolean] of DWORD = (SW_HIDE, SW_RESTORE); // 设置任务栏是否可见 procedure SetTaskBarVisible(Visible: Boolean); var wndHandle: THandle; begin wndHandle := FindWindow('Shell_TrayWnd', nil); ShowWindow(wndHandle, csWndShowFlag[Visible]); end; // 设置桌面是否可见 procedure SetDesktopVisible(Visible: Boolean); var hDesktop: THandle; begin hDesktop := FindWindow('Progman', nil); ShowWindow(hDesktop, csWndShowFlag[Visible]); end; // 显示等待光标 procedure BeginWait; begin Screen.Cursor := crHourGlass; end; // 结束等待光标 procedure EndWait; begin Screen.Cursor := crDefault; end; // 检测是否Win95/98平台 function CheckWindows9598NT: String; var V: TOSVersionInfo; begin V.dwOSVersionInfoSize := SizeOf(V); Result := '未知操作系统'; if not GetVersionEx(V) then Exit; if V.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS then Result := 'Windows 95/98' else begin if V.dwPlatformId = VER_PLATFORM_WIN32_NT then Result := 'Windows NT' else Result :='Windows' end; end; {* 取得当前操作平台是 Windows 95/98 还是NT} function GetOSInfo : String; begin Result := ''; case Win32Platform of VER_PLATFORM_WIN32_WINDOWS: Result := 'Windows 95/98'; VER_PLATFORM_WIN32_NT: Result := 'Windows NT'; else Result := 'Windows32'; end; end; //*获取当前Windows登录名的用户 function GetCurrentUserName : string; const cnMaxUserNameLen = 254; var sUserName : string; dwUserNameLen : Dword; begin dwUserNameLen := cnMaxUserNameLen-1; SetLength( sUserName, cnMaxUserNameLen ); GetUserName(Pchar( sUserName ), dwUserNameLen ); SetLength( sUserName, dwUserNameLen ); Result := sUserName; end; function GetRegistryOrg_User(UserKeyType:string):string; var Myreg:Tregistry; RegString:string; begin MyReg:=Tregistry.Create; MyReg.RootKey:=HKEY_LOCAL_MACHINE; if (Win32Platform = VER_PLATFORM_WIN32_NT) then RegString:='Software\Microsoft\Windows NT\CurrentVersion' else RegString:='Software\Microsoft\Windows\CurrentVersion'; if MyReg.openkey(RegString,False) then begin if UpperCase(UserKeyType)='REGISTEREDORGANIZATION' then Result:= MyReg.readstring('RegisteredOrganization') else begin if UpperCase(UserKeyType)='REGISTEREDOWNER' then Result:= MyReg.readstring('RegisteredOwner') else Result:=''; end; end; MyReg.CloseKey; MyReg.Free; end; //获取操作系统版本号 function GetSysVersion:string; Var OSVI:OSVERSIONINFO; ObjSysVersion:string; begin OSVI.dwOSversioninfoSize:=Sizeof(OSVERSIONINFO); GetVersionEx(OSVI); ObjSysVersion:=IntToStr(OSVI.dwMinorVersion)+','+IntToStr(OSVI.dwMinorV |
2023-10-27
2022-08-15
2022-08-17
2022-09-23
2022-08-13
请发表评论