delphi 常用函数库1

2024-03-30 10:37•php•阅读 2219

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

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

{▎ 系统公用函数及过程 ▎}

{▎ 软件名称：开发包基础库 ▎}

{▎ 单元名称：公共运行时间库单元 ▎}

{▎ 单元版本： V1.0 ▎}

{▎ 备注：该单元定义了组件包的基础类库 ▎}

{▎ 开发平台： PWin98SE + Delphi 6.0 ▎}

{▎ 兼容测试： PWin9X/2000/XP + Delphi 6.0 ▎}

{▎ 本地化：该单元中的字符串均符合本地化处理方式 ▎}

{▎ 更新记录： 2002.07.03 V2.0 ▎}

{▎ 整理单元，重设版本号 ▎}

{▎ 2002.03.17 V0.02 ▎}

{▎ 新增部分函数，并部分修改 ▎}

{▎ 2002.01.30 V0.01 ▎}

{▎ 创建单元（整理而来） ▎}

{▎ ①: 扩展的字符串操作函数 ▎}

{▎ ②: 扩展的日期时间操作函数 ▎}

{▎ ③: 扩展的位操作函数 ▎}

{▎ ④: 扩展的文件及目录操作函数 ▎}

{▎ ⑤: 扩展的对话框函数 ▎}

{▎ ⑥: 系统功能函数 ▎}

{▎ ⑦: 硬件功能函数 ▎}

{▎ ⑧: 网络功能函数 ▎}

{▎ ⑨: 汉字拼音函数及过程 ▎}

{▎ ⑩: 数据库功能函数 ▎}

{▎ ⑾: 进制功能函数 ▎}

{▎ ⑿: 其它功能函数 ▎}

unit Communal;

{* |<PRE>

|</PRE>}

interface

{$I CnPack.inc}

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

FileCtrl, ShellAPI, CommDlg, MMSystem, WinSock, IniFiles, DBTables, BDE,

StdCtrls, ComObj, ADODB, Imm, DbCtrls, Db, Registry;

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

const

// 公共信息

{$IFDEF GB2312}

SCnInformation = '提示';

SCnWarning = '警告';

SCnError = '错误';

SCnInformation = 'Information';

SCnWarning = 'Warning';

SCnError = 'Error';

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

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

resourcestring

{$IFDEF GB2312}

SUnknowError = '未知错误';

SErrorCode = '错误代码：';

SUnknowError = 'Unknow error';

SErrorCode = 'Error code:';

type

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

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

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

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

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

//从文件中返回Ado连接字串。

function GetConnectionString(DataBaseName:string):string;

//返回服务器的机器名称.

function GetRemoteServerName:string;

function InStr(const sShort: string; const sLong: string): Boolean;

{* 判断s1是否包含在s2中}

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

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

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

{* 带分隔符的整数－字符转换}

function ByteToBin(Value: Byte): string;

{* 字节转二进制串}

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

{* 返回字符串右边的字符 Examples: StrRight('ABCEDFG',3); 返回:'DFG' }

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

{* 返回字符串左边的字符}

function Spc(Len: Integer): string;

{* 返回空格串}

function Replace(Str,s1,s2:string;CaseSensitive:Boolean):string;

{* 返回将指定字符s1用字符串s2替换后的字符串，可支持大小写敏感由CaseSensitive操作}

{example: replace('We know what we want','we','I',false) = 'I Know what I want'}

function Replicate(pcChar:Char; piCount:integer):string;

function StrNum(ShortStr:string;LongString:string):Integer;

{* 返回某个字符串中某个字符串中出现的次数}

function FindStr(ShortStr:String;LongStrIng:String):Integer;

{* 返回某个字符串中查找某个字符串的位置}

function SubStr(psInput:String; BeginPlace,CutLeng:Integer):String;

{* 返回从位置BeginPlace开始切取长度为CatLeng字符串}

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

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

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

{* 返回从右边第一为开始切取 CutLeng长度的字符串}

function PadLStr(psInput:String; piWidth:Integer; pcPadWith:Char):String;

{* 返回从psInput字符串左边开始用pcPadWith填充后总长度为PiWidth的字符串}

function PadRStr(psInput:String; piWidth:Integer; pcPadWith:Char):String;

{* 返回从psInput字符串右边开始用pcPadWith填充后总长度为PiWidth的字符串}

function PadCStr(psInput:String; piWidth:Integer; pcPadWith:Char):String;

{* 返回从psInput字符串两边开始用pcPadWith填充后总长度为PiWidth的字符串}

function ChrTran(psInput:String; pcSearch:Char; pcTranWith:Char):String;

{* 返回替换后字符串[替换单个字符] Examples: ChrTran('abCdEgdlkh','d','#')；返回'abC#Eg#lkh'}

function StrTran(psInput:String; psSearch:String; psTranWith:String):String;

{* 返回替换后字符串[替换字符串] Examples: StrTran('aruyfbn','ruy','=====');；返回'a=====fbn'}

function Stuff(psInput:String; piBeginPlace,piCount:Integer; psStuffWith:String):String;

{ *返回替换后字符串[替换字符串] Examples: Stuff('ABCDEFGHI',3,4,'12345')；返回'AB12345GHI'}

procedure SwapStr(var s1, s2: string);

{* 交换字串}

function LinesToStr(const Lines: string): string;

{* 多行文本转单行（换行符转'\n'）}

function StrToLines(const Str: string): string;

{* 单行文本转多行（'\n'转换行符）}

function Encrypt(const S: String; Key: Word): String;

{* 字符串加密函数}

function Decrypt(const S: String; Key: Word): String;

{* 字符串解密函数}

function varIIF(aTest: Boolean; TrueValue, FalseValue: Variant): Variant;

function varToStr(const V: Variant): string;

{* VarIIF及VartoStr为变体函数}

function IsDigital(Value: string): boolean;

function RandomStr(aLength : Longint) : String;

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

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

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

function GetYear(Date: TDate): Integer;

{* 取日期年份分量}

function GetMonth(Date: TDate): Integer;

{* 取日期月份分量}

function GetDay(Date: TDate): Integer;

{* 取日期天数分量}

function GetHour(Time: TTime): Integer;

{* 取时间小时分量}

function GetMinute(Time: TTime): Integer;

{* 取时间分钟分量}

function GetSecond(Time: TTime): Integer;

{* 取时间秒分量}

function GetMSecond(Time: TTime): Integer;

{* 取时间毫秒分量}

function GetMonthLastDay(Cs_Year,Cs_Month:string):string;

{ *传入年、月，得到该月份最后一天}

function IsLeapYear( nYear: Integer ): Boolean;

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

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

function dateBeginOfMonth(D: TDateTime): TDateTime;

function DateEndOfMonth(D: TDateTime): TDateTime;

function DateEndOfYear(D: TDateTime): TDateTime;

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

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

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

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

type

TByteBit = 0..7;

{* Byte类型位数范围}

TWordBit = 0..15;

{* Word类型位数范围}

TDWordBit = 0..31;

{* DWord类型位数范围}

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

{* 设置二进制位}

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

{* 设置二进制位}

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

{* 设置二进制位}

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

{* 取二进制位}

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

{* 取二进制位}

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

{* 取二进制位}

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

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

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

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

{* 移动文件、目录，参数为源、目标名}

procedure FileProperties(const FName: string);

{* 打开文件属性窗口}

function OpenDialog(var FileName: string; Title: string; Filter: string;

Ext: string): Boolean;

{* 打开文件框}

function FormatPath(APath: string; Width: Integer): string;

{* 缩短显示不下的长路径名}

function GetRelativePath(Source, Dest: string): string;

{* 取两个目录的相对路径,注意串尾不能是'\'字符！}

procedure RunFile(const FName: string; Handle: THandle = 0;

const Param: string = '');

{* 运行一个文件}

function WinExecAndWait32(FileName: string; Visibility: Integer = SW_NORMAL):

Integer;

{* 运行一个文件并等待其结束}

function AppPath: string;

{* 应用程序路径}

function GetWindowsDir: string;

{* 取Windows系统目录}

function GetWinTempDir: string;

{* 取临时文件目录}

function AddDirSuffix(Dir: string): string;

{* 目录尾加'\'修正}

function MakePath(Dir: string): string;

{* 目录尾加'\'修正}

function IsFileInUse(FName: string): Boolean;

{* 判断文件是否正在使用}

function GetFileSize(FileName: string): Integer;

{* 取文件长度}

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

TFileTime): Boolean;

{* 设置文件时间 Example: FileSetDate('c:\Test\Test1.exe',753160662); }

function GetFileDate(FileName: string; var CreationTime, LastWriteTime, LastAccessTime:

TFileTime): Boolean;

{* 取文件时间}

function FileTimeToLocalSystemTime(FTime: TFileTime): TSystemTime;

{* 文件时间转本地时间}

function LocalSystemTimeToFileTime(STime: TSystemTime): TFileTime;

{* 本地时间转文件时间}

function GetFileIcon(FileName: string; var Icon: TIcon): Boolean;

{* 取得与文件相关的图标，成功则返回True}

function CreateBakFile(FileName, Ext: string): Boolean;

{* 创建备份文件}

function Deltree(Dir: string): Boolean;

{* 删除整个目录}

function GetDirFiles(Dir: string): Integer;

{* 取文件夹文件数}

type

TFindCallBack = procedure(const FileName: string; const Info: TSearchRec;

var Abort: Boolean);

{* 查找指定目录下文件的回调函数}

procedure FindFile(const Path: string; const FileName: string = '*.*';

Proc: TFindCallBack = nil; bSub: Boolean = True; const bMsg: Boolean = True);

{* 查找指定目录下文件}

procedure FindFileList(Path,Filter:string;FileList:TStrings;ContainSubDir:Boolean);

{ 功能说明：查找一个路径下的所有文件。

参数： path:路径,filter:文件扩展名过滤,FileList:文件列表, ContainSubDir:是否包含子目录}

function Txtline(const txt: string): integer;

{* 返回一文本文件的行数}

function Html2Txt(htmlfilename: string): string;

{* Html文件转化成文本文件}

function OpenWith(const FileName: string): Integer;

{* 文件打开方式}

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

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

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

procedure InfoDlg(Mess: string; Caption: string = SCnInformation; Flags: Integer

= MB_OK + MB_ICONINFORMATION);

{* 显示提示窗口}

function InfoOk(Mess: string; Caption: string = SCnInformation): Boolean;

{* 显示提示确认窗口}

procedure ErrorDlg(Mess: string; Caption: string = SCnError);

{* 显示错误窗口}

procedure WarningDlg(Mess: string; Caption: string = SCnWarning);

{* 显示警告窗口}

function QueryDlg(Mess: string; Caption: string = SCnInformation): Boolean;

{* 显示查询是否窗口}

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

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

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

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

procedure MoveMouseIntoControl(AWinControl: TControl);

{* 移动鼠标到控件}

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

{* 动态设置分辨率}

procedure StayOnTop(Handle: HWND; OnTop: Boolean);

{* 窗口最上方显示}

procedure SetHidden(Hide: Boolean);

{* 设置程序是否出现在任务栏}

procedure SetTaskBarVisible(Visible: Boolean);

{* 设置任务栏是否可见}

procedure SetDesktopVisible(Visible: Boolean);

{* 设置桌面是否可见}

procedure BeginWait;

{* 显示等待光标}

procedure EndWait;

{* 结束等待光标}

function CheckWindows9598NT: string;

{* 检测是否Win95/98/NT平台}

function GetOSInfo : String;

{* 取得当前操作平台是 Windows 95/98 还是NT}

function GetCurrentUserName : string;

function GetRegistryOrg_User(UserKeyType:string):string;

function GetSysVersion:string;

function WinBootMode:string;

type

PShutType = (UPowerOff, UShutdown, UReboot, ULogOff, USuspend, UHibernate);

procedure WinShutDown(ShutWinType:PShutType; PForce:Boolean);

{//Windows ShutDown等}

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

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

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

function GetClientGUID:string;

{ 功能描述：在本机上得到一个GUID.去掉两端的大括号和中间的横线

返回值：去掉两端的大括号和中间的横线的一个GUID

适用范围：windows

}

function SoundCardExist: Boolean;

{* 声卡是否存在}

function GetDiskSerial(DiskChar: Char): string;

{* 获取磁盘序列号}

function DiskReady(Root: string) : Boolean;

procedure WritePortB( wPort : Word; bValue : Byte );

{* 写串口}

function ReadPortB( wPort : Word ) : Byte;

function CPUSpeed: Double;

{* 获知当前机器CPU的速率（MHz）}

type

TCPUID = array[1..4] of Longint;

function GetCPUID : TCPUID; assembler; register;

function GetMemoryTotalPhys : Dword;

type

TDriveState = (DSNODISK, DSUNFORMATTEDDISK, DSEMPTYDISK, DSDISK_WITHFILES);

function DriveState (driveletter: Char) : TDriveState;

{* 检查驱动器A中磁盘是否有效}

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

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

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

function GetComputerName:string;

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

function GetHostIP:string;

{* 获取计算机的IP地址}

function NetUserChangePassword(Domain:PWideChar; UserName:PWideChar; OldPassword:PWideChar; NewPassword:PWideChar): LongInt; stdcall; external 'netapi32.dll' name 'NetUserChangePassword';

{* // 运行平台：Windows NT/2000/XP

{* // Windows 95/98/Me平台：可以用该函数修改用户的Windows登录密码}

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

//▎=====================⑨汉字拼音功能函数=====================▎//

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

function GetHzPy(const AHzStr: string): string;

{* 取汉字的拼音}

function HowManyChineseChar(Const s:String):Integer;

{* 判断一个字符串中有多少各汉字}

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

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

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

{function PackDbDbf(Var StatusMsg: String): Boolean;}

{* 物理删除数据库(Db，Dbf)中的数据[着了删除标记的记录]}

procedure RepairDb(DbName: string);

{* 修复Access表}

function CreateODBCCfgInRegistry(ODBCSourceName:WideString;ServerName, DataBaseDescription:String):boolean;

{* 通过注册表创建ODBC配置[创建在系统DSN页下]}

function ADOConnectSysBase(Const Adocon:TadoConnection):boolean;

{* 用Ado连接SysBase数据库函数}

function ADOConnectLocalDB(Const Adocon:TadoConnection;Const Dbname,DbServerName:string;ValidateMode:Integer):boolean;

{* 用Ado连接数据库函数}

function ADOODBCConnectLocalDB(Const Adocon:TadoConnection;Const Dbname:string;ValidateMode:Integer):boolean;

{* 用Ado与ODBC共同连接数据库函数}

function CreatTable(LpDataBaseName,LpTableName,LpSentence:string):Boolean;

{* //建立新表}

function AddField(LpFieldName:string; LpDataType: TFieldType; LpSize: Word):string;

function KillField(LpFieldName:string):String;

{* //在表中删除字段}

function AlterTableExec(LpDataBaseName,LpSentence:string):Boolean;

{* //修改表结构}

function GetSQLSentence(LpTableName,LpSQLsentence:string): string;

{* /修改、添加、删除表结构时的SQL句体}

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

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

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

function StrToHex(AStr: string): string;

{* 字符转化成十六进制}

function HexToStr(AStr: string): string;

{* 十六进制转化成字符}

function TransChar(AChar: Char): Integer;

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

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

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

function TrimInt(Value, Min, Max: Integer): Integer; overload;

{* 输出限制在Min..Max之间}

function IntToByte(Value: Integer): Byte; overload;

{* 输出限制在0..255之间}

function InBound(Value: Integer; Min, Max: Integer): Boolean;

{* 判断整数Value是否在Min和Max之间}

procedure CnSwap(var A, B: Byte); overload;

{* 交换两个数}

procedure CnSwap(var A, B: Integer); overload;

{* 交换两个数}

procedure CnSwap(var A, B: Single); overload;

{* 交换两个数}

procedure CnSwap(var A, B: Double); overload;

{* 交换两个数}

function RectEqu(Rect1, Rect2: TRect): Boolean;

{* 比较两个Rect是否相等}

procedure DeRect(Rect: TRect; var x, y, Width, Height: Integer);

{* 分解一个TRect为左上角坐标x, y和宽度Width、高度Height}

function EnSize(cx, cy: Integer): TSize;

{* 返回一个TSize类型}

function RectWidth(Rect: TRect): Integer;

{* 计算TRect的宽度}

function RectHeight(Rect: TRect): Integer;

{* 计算TRect的高度}

procedure Delay(const uDelay: DWORD);

{* 延时}

procedure BeepEx(const Freq: WORD = 1200; const Delay: WORD = 1);

{* 只能在Win9X下让喇叭发声}

procedure ShowLastError;

{* 显示Win32 Api运行结果信息}

function writeFontStyle(FS: TFontStyles; inifile: string; write: boolean):string;

{* 将字体Font.Style写入INI文件}

function readFontStyle(inifile: string): TFontStyles;

{* 从INI文件中读取字体Font.Style文件}

//function ReadCursorPos(SourceMemo: TMemo): TPoint;

function ReadCursorPos(SourceMemo: TMemo): string;

{* 取得TMemo 控件当前光标的行和列信息到Tpoint中}

function CanUndo(AMemo: TMemo): Boolean;

{* 检查Tmemo控件能否Undo}

procedure Undo(Amemo: Tmemo);

procedure AutoListDisplay(ACombox:TComboBox);

{* 实现ComBoBox自动下拉}

function UpperMoney(small:real):string;

{* 小写金额转换为大写 }

function Myrandom(Num: Integer): integer;

procedure OpenIME(ImeName: string);

procedure CloseIME;

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

//数据备份

procedure BackUpData(LpBackDispMessTitle:String);

implementation

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

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

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

// 判断s1是否包含在s2中

function InStr(const sShort: string; const sLong: string): Boolean;

var

s1, s2: string;

begin

s1 := LowerCase(sShort);

s2 := LowerCase(sLong);

Result := Pos(s1, s2) > 0;

end;

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

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

begin

Result := IntToStr(Value);

while Length(Result) < Len do

Result := FillChar + Result;

end;

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

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

var

s: string;

i, j: Integer;

begin

s := IntToStr(Value);

Result := '';

j := 0;

for i := Length(s) downto 1 do

begin

Result := s[i] + Result;

Inc(j);

try

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

Result := Sp + Result;

except

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

exit;

end

end;

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

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;

// 单行文本转多行（'\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;

//字符串加密函数

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;

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

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;

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;

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;

// 打开文件框

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;

// 应用程序路径

function AppPath: string;

begin

Result := ExtractFilePath(Application.ExeName);

end;

// 取Windows系统目录

function GetWindowsDir: string;

var

Buf: array[0..MAX_PATH] of Char;

begin

GetWindowsDirectory(Buf, MAX_PATH);

Result := AddDirSuffix(Buf);

end;

// 取临时文件目录

function GetWinTempDir: string;

var

Buf: array[0..MAX_PATH] of Char;

begin

GetTempPath(MAX_PATH, Buf);

Result := AddDirSuffix(Buf);

end;

// 目录尾加'\'修正

function AddDirSuffix(Dir: string): string;

begin

Result := Trim(Dir);

if Result = '' then Exit;

if Result[Length(Result)] <> '\' then Result := Result + '\';

end;

function MakePath(Dir: string): string;

begin

Result := AddDirSuffix(Dir);

end;

// 判断文件是否正在使用

function IsFileInUse(FName: string): Boolean;

var

HFileRes: HFILE;

begin

Result := False;

if not FileExists(FName) then

Exit;

HFileRes := CreateFile(PChar(FName), GENERIC_READ or GENERIC_WRITE, 0,

nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);

Result := (HFileRes = INVALID_HANDLE_VALUE);

if not Result then

CloseHandle(HFileRes);

end;

// 取文件长度

function GetFileSize(FileName: string): Integer;

var

FileVar: file of Byte;

begin

try

AssignFile(FileVar, FileName);

Reset(FileVar);

Result := FileSize(FileVar);

CloseFile(FileVar);

except

Result := 0;

end;

// 设置文件时间

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

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;

{ 功能说明：查找一个路径下的所有文件。

参数：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;

finally

FindClose(FSearchRec);

end;

//返回一文本文件的行数

function Txtline(const txt: string): integer;

var

F : TextFile;

StrLine : string;

line : Integer;

begin

AssignFile(F, txt);

Reset(F);

Line := 0;

while not SeekEof(f) do

begin

if SeekEoln(f) then

Readln;

Readln(F, StrLine);

if SeekEof(f) then

break

else

inc(Line);

end;

CloseFile(F);

Result := Line;

end;

//Html文件转化成文本文件

function Html2Txt(htmlfilename: string): string;

var Mystring:TStrings;

s,lineS:string;

line,Llen,i,j:integer;

rloop:boolean;

begin

rloop:=False;

Mystring:=TStringlist.Create;

s:='';

Mystring.LoadFromFile(htmlfilename);

line:=Mystring.Count;

try

for i:=0 to line-1 do

Begin

lineS:=Mystring[i];

Llen:=length(lineS);

j:=1;

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

begin

j:=j+1;

s:=s+' ';

End;

while j<=Llen do

Begin

if lineS[j]='<'then

rloop:=True;

if lineS[j]='>'then

Begin

rloop:=False;

j:=j+1;

continue;

End;

if rloop then

begin

j:=j+1;

continue;

end

else

s:=s+lineS[j];

j:=j+1;

End;

s:=s+#13#10;

End;

finally

Mystring.Free;

end;

result:=s;

end;

// 文件打开方式

function OpenWith(const FileName: string): Integer;

begin

Result := ShellExecute(Application.Handle, 'open', 'rundll32.exe',

PChar('shell32.dll,OpenAs_RunDLL ' + FileName), '', SW_SHOW);

end;

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

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

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

// 显示提示窗口

procedure InfoDlg(Mess: string; Caption: string; Flags: Integer);

begin

Application.MessageBox(PChar(Mess), PChar(Caption), Flags);

end;

// 显示提示确认窗口

function InfoOk(Mess: string; Caption: string): Boolean;

begin

Result := Application.MessageBox(PChar(Mess), PChar(Caption),

MB_OK + MB_ICONINFORMATION) = IDOK;

end;

// 显示错误窗口

procedure ErrorDlg(Mess: string; Caption: string);

begin

Application.MessageBox(PChar(Mess), PChar(Caption), MB_OK + MB_ICONSTOP);

end;

// 显示警告窗口

procedure WarningDlg(Mess: string; Caption: string);

begin

Application.MessageBox(PChar(Mess), PChar(Caption), MB_OK + MB_ICONWARNING);

end;

// 显示查询是否窗口

function QueryDlg(Mess: string; Caption: string): Boolean;

begin

Result := Application.MessageBox(PChar(Mess), PChar(Caption),

MB_YESNO + MB_ICONQUESTION) = IDYES;

end;

//窗体渐变

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

var

pOSVersionInfo : OSVersionInfo;

begin

pOSVersionInfo.dwOSVersionInfoSize := sizeof(OSVersionInfo);

GetVersionEx(pOSVersionInfo);

if pOSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then

begin

if IsSetAni then

AnimateWindow(Sender.Handle,444,AW_HIDE or AW_BLEND);

end

else

if IsSetAni then

begin

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

end;

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

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

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

// 移动鼠标到控件

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;

// 窗口最上方显示

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;

{* 取得当前操作平台是 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;

//*获取当前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;

MyReg.CloseKey;

MyReg.Free;

end;

//获取操作系统版本号

function GetSysVersion:string;

Var

OSVI:OSVERSIONINFO;

ObjSysVersion:string;

begin

OSVI.dwOSversioninfoSize:=Sizeof(OSVERSIONINFO);

GetVersionEx(OSVI);

ObjSysVersion:=IntToStr(OSVI.dwMinorVersion)+','+IntToStr(OSVI.dwMinorVersion)+','

+IntToStr(OSVI.dwBuildNumber)+','+IntToStr(OSVI.dwPlatformId)+','

+OSVI.szCSDVersion;

if rightstr(ObjSysVersion,1)=',' then

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

Result:=ObjSysVersion;

end;

//Windows启动模式

function WinBootMode:string;

begin

case(GetSystemMetrics(SM_CLEANBOOT)) of

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

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

2:Result:='安全模式启动，但附带网络功能';

else

Result:='错误：系统启动有问题。';

end;

////Windows ShutDown等

procedure WinShutDown(ShutWinType:PShutType; PForce:Boolean);

var

hToken, hProcess: THandle;

tp, prev_tp: TTokenPrivileges;

Len, Flags: DWORD;

CanShutdown: Boolean;

begin

if Win32Platform = VER_PLATFORM_WIN32_NT then

begin

hProcess := OpenProcess(PROCESS_ALL_ACCESS, True, GetCurrentProcessID);

try

if not OpenProcessToken(hProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then

Exit;

finally

CloseHandle(hProcess);

end;

try

if not LookupPrivilegeValue('', 'SeShutdownPrivilege',

tp.Privileges[0].Luid) then Exit;

tp.PrivilegeCount := 1;

tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;

if not AdjustTokenPrivileges(hToken, False, tp, SizeOf(prev_tp),

prev_tp, Len) then Exit;

finally

CloseHandle(hToken);

end;

CanShutdown := True;

// DoQueryShutdown(CanShutdown);

if not CanShutdown then Exit;

if PForce then Flags := EWX_FORCE else Flags := 0;

case ShutWinType of

UPowerOff: ExitWindowsEx(Flags or EWX_POWEROFF, 0);

UShutdown: ExitWindowsEx(Flags or EWX_SHUTDOWN, 0);

UReboot: ExitWindowsEx(Flags or EWX_REBOOT, 0);

ULogoff: ExitWindowsEx(Flags or EWX_LOGOFF, 0);

USuspend: SetSystemPowerState(True, PForce);

UHibernate: SetSystemPowerState(False, PForce);

end;

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

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

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

function GetClientGUID:string;

var

myGuid:TGUID;

ResultStr:string;

begin

CreateGuid(myGuid);

ResultStr:=GUIDToString(myGuid);

ResultStr:=Communal.Replace(ResultStr,'-','',False);

ResultStr:=Communal.Replace(ResultStr,'{','',False);

ResultStr:=Communal.Replace(ResultStr,'}','',False);

Result:=Substr(ResultStr,1,30);

end;

// 声卡是否存在

function SoundCardExist: Boolean;

begin

Result := WaveOutGetNumDevs > 0;

end;

//* 获取磁盘序列号

function GetDiskSerial(DiskChar: Char): string;

var

SerialNum : pdword;

a, b : dword;

Buffer : array [0..255] of char;

begin

result := '';

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

Result := IntToStr(SerialNum^);

end;

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

function DiskReady(Root: string) : Boolean;

var

Oem : CARDINAL ;

Dw1,Dw2 : DWORD ;

begin

Oem := SetErrorMode( SEM_FAILCRITICALERRORS ) ;

if LENGTH(Root) = 1 then Root := Root + ':\';

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

SetErrorMode( Oem ) ;

end;

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

function DriveState (driveletter: Char) : TDriveState;

var

mask: String[6];

sRec: TSearchRec;

oldMode: Cardinal;

retcode: Integer;

begin

oldMode := SetErrorMode(SEM_FAILCRITICALERRORS);

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

mask[1] := driveletter;

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

FindClose(Srec);

case retcode of

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

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

-21, -3: Result := DSNODISK; //NT,Win31的错误代号

else

Result := DSUNFORMATTEDDISK;

end;

SetErrorMode(oldMode);

end;

//写串口

procedure WritePortB( wPort : Word; bValue : Byte );

begin

asm

mov dx, wPort

mov al, bValue

out dx, al

end;

//读串口

function ReadPortB( wPort : Word ):Byte;

begin

asm

mov dx, wPort

in al, dx

mov result, al

end;

//获知当前机器CPU的速率（MHz）

function CPUSpeed: Double;

const

DelayTime = 500;

var

TimerHi, TimerLo: DWORD;

PriorityClass, Priority: Integer;

begin

PriorityClass := GetPriorityClass(GetCurrentProcess);

Priority := GetThreadPriority(GetCurrentThread);

SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);

SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);

Sleep(10);

asm

dw 310Fh

mov TimerLo, eax

mov TimerHi, edx

end;

Sleep(DelayTime);

asm

dw 310Fh

sub eax, TimerLo

sbb edx, TimerHi

mov TimerLo, eax

mov TimerHi, edx

end;

SetThreadPriority(GetCurrentThread, Priority);

SetPriorityClass(GetCurrentProcess, PriorityClass);

Result := TimerLo / (1000.0 * DelayTime);

end;

//获取CPU的标识ID号

function GetCPUID : TCPUID; assembler; register;

asm

PUSH EBX {Save affected register}

PUSH EDI

MOV EDI,EAX

MOV EAX,1

DW $A20F {CPUID Command}

STOSD

MOV EAX,EBX

STOSD

MOV EAX,ECX

STOSD

MOV EAX,EDX

STOSD

POP EDI {Restore registers}

POP EBX

end;

//获取计算机的物理内存

function GetMemoryTotalPhys : Dword;

var

memStatus: TMemoryStatus;

begin

memStatus.dwLength := sizeOf ( memStatus );

GlobalMemoryStatus ( memStatus );

Result := memStatus.dwTotalPhys div 1024;

end;

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

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

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

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

function GetComputerName:string;

var

wVersionRequested : WORD;

wsaData : TWSAData;

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

begin

try

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

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

GetHostName(@s,128);

p:=GetHostByName(@s);

Result:=p^.h_Name;

finally

WSACleanup; //释放 WinSock

end;

{* 获取计算机的IP地址}

function GetHostIP:string;

var

wVersionRequested : WORD;

wsaData : TWSAData;

p : PHostEnt; s : array[0..128] of char; p2 : pchar;

begin

try

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

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

GetHostName(@s,128);

p:=GetHostByName(@s);

p2 := iNet_ntoa(PInAddr(p^.h_addr_list^)^);

Result:= P2;

finally

WSACleanup; //释放 WinSock

end;

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

//▎=====================⑨汉字拼音功能函数=====================▎//

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

// 取汉字的拼音

function GetHzPy(const AHzStr: string): string;

const

ChinaCode: array[0..25, 0..1] of Integer = ((1601, 1636), (1637, 1832), (1833, 2077),

(2078, 2273), (2274, 2301), (2302, 2432), (2433, 2593), (2594, 2786), (9999, 0000),

(2787, 3105), (3106, 3211), (3212, 3471), (3472, 3634), (3635, 3722), (3723, 3729),

(3730, 3857), (3858, 4026), (4027, 4085), (4086, 4389), (4390, 4557), (9999, 0000),

(9999, 0000), (4558, 4683), (4684, 4924), (4925, 5248), (5249, 5589));

var

i, j, HzOrd: Integer;

begin

Result:='';

i := 1;

while i <= Length(AHzStr) do

begin

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

begin

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

for j := 0 to 25 do

begin

if (HzOrd >= ChinaCode[j][0]) and (HzOrd <= ChinaCode[j][1]) then

begin

Result := Result + Char(Byte('A') + j);

Break;

end;

Inc(i);

end else Result := Result + AHzStr[i];

Inc(i);

end;

{* 判断一个字符串中有多少各汉字}

function HowManyChineseChar(Const s:String):Integer;

var

SW:WideString;

C:String;

i, WCount:Integer;

begin

SW:=s;

WCount:=0;

For i:=1 to Length(SW) do

begin

c:=SW[i];

if Length(c)>1 then

Inc(WCount);

end;

Result:=WCount;

end;

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

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

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

//* 物理删除数据库(Db，Dbf)中的数据[着了删除标记的记录]}

{function PackDbDbf(Var StatusMsg: String): Boolean;

var

rslt:DBIResult;

szErrMsg:DBIMSG;

pTblDesc:pCRTblDesc;

bExclusive:Boolean;

bActive:Boolean;

isParadox,isDbase:Boolean;

tempTableName:string;

Props:CurProps;//保护口令

begin

Result:=False;

StatusMsg:='';

if TableType=ttDefault then

begin

tempTableName:=TableName;

tempTableName:=Lowercase(tempTableName);

上一篇 »Javascript 常用函数库
下一篇 »php GD库常用画图型函数

delphi 常用函数库1

相关推荐

php 常用函数手册[doc版]

总结归纳python os库常用方法

Python math库常用函数

Python常用标准库函数

Delphi常用取整函数

Delphi常用系统函数总结

Delphi常用时间函数列表

Delphi常用字符串函数