cncommon.pas

delphi常用过程

{******************************************************************************}
{                       CnPack For Delphi/C++Builder                           }
{                     中国人自己的开放源码第三方开发包                         }
{                   (C)Copyright 2001-2007 CnPack 开发组                       }
{                   ------------------------------------                       }
{                                                                              }
{            本开发包是开源的自由软件，您可以遵照 CnPack 的发布协议来修        }
{        改和重新发布这一程序。                                                }
{                                                                              }
{            发布这一开发包的目的是希望它有用，但没有任何担保。甚至没有        }
{        适合特定目的而隐含的担保。更详细的情况请参阅 CnPack 发布协议。        }
{                                                                              }
{            您应该已经和开发包一起收到一份 CnPack 发布协议的副本。如果        }
{        还没有，可访问我们的网站：                                            }
{                                                                              }
{            网站地址：http://www.cnpack.org                                   }
{            电子邮件：[e-mail]                                       }
{                                                                              }
{******************************************************************************}

unit CnCommon;
{* |<PRE>
================================================================================
* 软件名称：开发包基础库
* 单元名称：公共运行基础库单元
* 单元作者：CnPack开发组
* 备    注：该单元定义了组件包的基础类库
* 开发平台：PWin98SE + Delphi 5.0
* 兼容测试：PWin9X/2000/XP + Delphi 5/6
* 本 地 化：该单元中的字符串均符合本地化处理方式
* 单元标识：$Id: CnCommon.pas,v 1.49 2007/01/31 03:15:44 liuxiao Exp $
* 修改记录：2007.01.31 by LiuXiao
*               增加获取一对象所有属性列表的函数
*           2006.11.29 by shenloqi
*               修改了ShortNameToLongName函数，使其支持Win95/NT（不支持Linux）
*           2005.08.02 by shenloqi
*               增加了SameCharCounts，CharCounts ，RelativePath函数，重写了
*               GetRelativePath函数
*           2005.07.08 by shenloqi
*               修改了GetRelativePath函数，修改了FileMatchesExts函数，增加了
*             一系列通配符支持的函数：FileNameMatch，MatchExt，MatchFileName，
*             FileExtsToStrings，FileMasksToStrings，FileMatchesMasks
*           2005.05.03 by hubdog
*               增加ExploreFile函数
*           2004.09.18 by Shenloqi
*               为Delphi5增加了BoolToStr函数
*           2004.05.21 by Icebird
*               修改了函数GetLine, IsInt, IsFloat, CnDateToStr, MyDateToStr
*           2003.10.29 by Shenloqi
*               新增四个函数CheckWinXP,DllGetVersion,GetSelText,UnQuotedStr
*           2002.08.12 V1.1
*               新增一个函数 CheckAppRunning by 周劲羽
*           2002.04.09 V1.0
*               整理单元，重设版本号
*           2002.03.17 V0.02
*               新增部分函数，并部分修改
*           2002.01.30 V0.01
*               创建单元（整理而来）
================================================================================
|</PRE>}

interface

{$I CnPack.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, Math, 
{$IFDEF COMPILER6_UP}
  StrUtils, Variants, Types,
{$ENDIF}
  FileCtrl, ShellAPI, CommDlg, MMSystem, StdCtrls, TLHelp32, ActiveX, ShlObj,
  CnConsts, CnIni, CnIniStrUtils, CheckLst, IniFiles, MultiMon, TypInfo;

//------------------------------------------------------------------------------
// 公共类型定义
//------------------------------------------------------------------------------

type

  PRGBColor = ^TRGBColor;
  TRGBColor = packed record
    b, g, r: Byte;
  end;

  PRGBArray = ^TRGBArray;
  TRGBArray = array[0..65535] of TRGBColor;

const
{$IFNDEF COMPILER6_UP}
  sLineBreak = {$IFDEF LINUX} #10 {$ENDIF} {$IFDEF MSWINDOWS} #13#10 {$ENDIF};
{$ENDIF}

  Alpha = ['A'..'Z', 'a'..'z', '_'];
  AlphaNumeric = Alpha + ['0'..'9'];

//------------------------------------------------------------------------------
// 扩展的文件目录操作函数
//------------------------------------------------------------------------------

procedure ExploreDir(APath: string);
{* 在资源管理器中打开指定目录 }

procedure ExploreFile(AFile: string);
{* 在资源管理器中打开指定文件 }

function ForceDirectories(Dir: string): Boolean;
{* 递归创建多级子目录}

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

function DeleteToRecycleBin(const FileName: string): Boolean;
{* 删除文件到回收站}

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

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

function GetDirectory(const Caption: string; var Dir: string;
  ShowNewButton: Boolean = True): Boolean;
{* 显示选择文件夹对话框，支持设置默认文件夹}

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

procedure DrawCompactPath(Hdc: HDC; Rect: TRect; Str: string);
{* 通过 DrawText 来画缩略路径}

function SameCharCounts(s1, s2: string): Integer;
{* 两个字符串的前面的相同字符数}
function CharCounts(Str: PChar; Chr: Char): Integer;
{* 在字符串中某字符出现的次数}
function GetRelativePath(ATo, AFrom: string;
  const PathStr: string = '\'; const ParentStr: string = '..';
  const CurrentStr: string = '.'; const UseCurrentDir: Boolean = False): string;
{* 取两个目录的相对路径}

{$IFNDEF BCB}
function PathRelativePathToA(pszPath: PAnsiChar; pszFrom: PAnsiChar; dwAttrFrom: DWORD;
  pszTo: PAnsiChar; dwAttrTo: DWORD): BOOL; stdcall;
function PathRelativePathToW(pszPath: PWideChar; pszFrom: PWideChar; dwAttrFrom: DWORD;
  pszTo: PWideChar; dwAttrTo: DWORD): BOOL; stdcall;
function PathRelativePathTo(pszPath: PChar; pszFrom: PChar; dwAttrFrom: DWORD;
  pszTo: PChar; dwAttrTo: DWORD): BOOL; stdcall;

function RelativePath(const AFrom, ATo: string; FromIsDir, ToIsDir: Boolean): string;
{* 使用Windows API取两个目录的相对路径}
{$ENDIF}

function LinkPath(const Head, Tail: string): string;
{* 连接两个路径，
   Head - 首路径，可以是 C:\Test、\\Test\C\Abc、http://www.abc.com/dir/ 等格式
   Tail - 尾路径，可以是 ..\Test、Abc\Temp、\Test、/web/lib 等格式或绝对地址格式 }

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

procedure OpenUrl(const Url: string);
{* 打开一个链接}

procedure MailTo(const Addr: string; const Subject: string = '');
{* 发送邮件}

function WinExecute(FileName: string; Visibility: Integer = SW_NORMAL): Boolean;
{* 运行一个文件并立即返回 }

function WinExecAndWait32(FileName: string; Visibility: Integer = SW_NORMAL;
  ProcessMsg: Boolean = False): Integer;
{* 运行一个文件并等待其结束}

function WinExecWithPipe(const CmdLine, Dir: string; slOutput: TStrings;
  var dwExitCode: Cardinal): Boolean; overload;
function WinExecWithPipe(const CmdLine, Dir: string; var Output: string;
  var dwExitCode: Cardinal): Boolean; overload;
{* 用管道方式在 Dir 目录执行 CmdLine，Output 返回输出信息，
   dwExitCode 返回退出码。如果成功返回 True }

function AppPath: string;
{* 应用程序路径}

function ModulePath: string;
{* 当前执行模块所在的路径 }

function GetProgramFilesDir: string;
{* 取Program Files目录}

function GetWindowsDir: string;
{* 取Windows目录}

function GetWindowsTempPath: string;
{* 取临时文件路径}

function CnGetTempFileName(const Ext: string): string;
{* 返回一个临时文件名 }

function GetSystemDir: string;
{* 取系统目录}

function ShortNameToLongName(const FileName: string): string;
{* 短文件名转长文件名}

function LongNameToShortName(const FileName: string): string;
{* 长文件名转短文件名}

function GetTrueFileName(const FileName: string): string;
{* 取得真实长文件名，包含大小写}

function FindExecFile(const AName: string; var AFullName: string): Boolean;
{* 查找可执行文件的完整路径 }

function GetSpecialFolderLocation(const Folder: Integer): string;
{* 取得系统特殊文件夹位置，Folder 使用在 ShlObj 中定义的标识，如 CSIDL_DESKTOP }

function AddDirSuffix(const Dir: string): string;
{* 目录尾加'\'修正}

function MakePath(const Dir: string): string;
{* 目录尾加'\'修正}

function MakeDir(const Path: string): string;
{* 路径尾去掉 '\'}

function GetUnixPath(const Path: string): string;
{* 路径中的 '\' 转成 '/'}

function GetWinPath(const Path: string): string;
{* 路径中的 '/' 转成 '\'}

function FileNameMatch(Pattern, FileName: PChar): Integer;
{* 文件名是否与通配符匹配，返回值为0表示匹配，其他为不匹配}

function MatchExt(const S, Ext: string): Boolean;
{* 文件名是否与扩展名通配符匹配}

function MatchFileName(const S, FN: string): Boolean;
{* 文件名是否与通配符匹配}

procedure FileExtsToStrings(const FileExts: string; ExtList: TStrings; CaseSensitive: Boolean);
{* 转换扩展名通配符字符串为通配符列表}

function FileMatchesExts(const FileName, FileExts: string; CaseSensitive: Boolean): Boolean; overload;
function FileMatchesExts(const FileName: string; ExtList: TStrings): Boolean; overload;
{* 文件名是否匹配扩展名通配符}

procedure FileMasksToStrings(const FileMasks: string; MaskList: TStrings; CaseSensitive: Boolean);
{* 转换文件通配符字符串为通配符列表}

function FileMatchesMasks(const FileName, FileMasks: string; CaseSensitive: Boolean): Boolean; overload;
function FileMatchesMasks(const FileName: string; MaskList: TStrings): Boolean; overload;
{* 文件名是否匹配通配符}

function FileMatchesExts(const FileName, FileExts: string): Boolean; overload;
{* 文件名与扩展名列表比较。FileExts是如'.pas;.dfm;.inc'这样的字符串}

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

function IsAscii(FileName: string): Boolean;
{* 判断文件是否为 Ascii 文件}

function IsValidFileName(const Name: string): Boolean;
{* 判断文件是否是有效的文件名}

function GetValidFileName(const Name: string): string;
{* 返回有效的文件名 }

function SetFileDate(const FileName: string; CreationTime, LastWriteTime, LastAccessTime:
  TFileTime): Boolean;
{* 设置文件时间}

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

function FileTimeToDateTime(const FileTime: TFileTime): TDateTime;
{* 文件时间转本地日期时间}

function DateTimeToFileTime(const DateTime: TDateTime): TFileTime;
{* 本地日期时间转文件时间}

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

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

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

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

function DateTimeToLocalDateTime(DateTime: TDateTime): TDateTime;
{* UTC 时间转本地时间}
function LocalDateTimeToDateTime(DateTime: TDateTime): TDateTime;
{* 本地时间转 UTC 时间}

{$IFDEF COMPILER5}
type
  TValueRelationship = -1..1;

function CompareValue(const A, B: Int64): TValueRelationship;

function AnsiStartsText(const ASubText, AText: string): Boolean;
{* AText 是否以 ASubText 开头 }

function AnsiReplaceText(const AText, AFromText, AToText: string): string;
{$ENDIF}

{$IFNDEF COMPILER7_UP}
function AnsiContainsText(const AText, ASubText: string): Boolean;
{* AText 是否包含 ASubText }
{$ENDIF}

function AnsiCompareTextPos(const ASubText, AText1, AText2: string): TValueRelationship;
function CompareTextPos(const ASubText, AText1, AText2: string): TValueRelationship;
{* 比较 SubText 在两个字符串中出现的位置的大小，如果相等则比较字符串本身，忽略大小写 }

function Deltree(Dir: string; DelRoot: Boolean = True;
  DelEmptyDirOnly: Boolean = False): Boolean;
{* 删除整个目录, DelRoot 表示是否删除目录本身}

procedure DelEmptyTree(Dir: string; DelRoot: Boolean = True);
{* 删除整个目录中的空目录, DelRoot 表示是否删除目录本身}

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

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

  TDirCallBack = procedure(const SubDir: string) of object;
{* 查找指定目录时进入子目录回调函数}

function FindFile(const Path: string; const FileName: string = '*.*';
  Proc: TFindCallBack = nil; DirProc: TDirCallBack = nil; bSub: Boolean = True;
  bMsg: Boolean = True): Boolean;
{* 查找指定目录下文件，返回是否被中断 }

function OpenWith(const FileName: string): Integer;
{* 显示文件打开方式对话框}

function CheckAppRunning(const FileName: string; var Running: Boolean): Boolean;
{* 检查指定的应用程序是否正在运行
 |<PRE>
   const FileName: string   - 应用程序文件名，不带路径，如果不带扩展名，
                              默认为".EXE"，大小写无所谓。
                              如 Notepad.EXE
   var Running: Boolean     - 返回该应用程序是否运行，运行为 True
   Result: Boolean          - 如果查找成功返回为 True，否则为 False
 |</PRE>}

type
  TVersionNumber = packed record
  {* 文件版本号}
    Minor: Word;
    Major: Word;
    Build: Word;
    Release: Word;
  end;

function GetFileVersionNumber(const FileName: string): TVersionNumber;
{* 取文件版本号}

function GetFileVersionStr(const FileName: string): string;
{* 取文件版本字符串}

function GetFileInfo(const FileName: string; var FileSize: Int64;
  var FileTime: TDateTime): Boolean;
{* 取文件信息}

function GetFileSize(const FileName: string): Int64;
{* 取文件长度}

function GetFileDateTime(const FileName: string): TDateTime;
{* 取文件Delphi格式日期时间}

function LoadStringFromFile(const FileName: string): string;
{* 将文件读为字符串}

function SaveStringToFile(const S, FileName: string): Boolean;
{* 保存字符串到为文件}

//------------------------------------------------------------------------------
// 环境变量相关
//------------------------------------------------------------------------------

function DelEnvironmentVar(const Name: string): Boolean;
{* 删除当前进程中的环境变量 }

function ExpandEnvironmentVar(var Value: string): Boolean;
{* 扩展当前进程中的环境变量 }

function GetEnvironmentVar(const Name: string; var Value: string;
  Expand: Boolean): Boolean;
{* 返回当前进程中的环境变量 }

function GetEnvironmentVars(const Vars: TStrings; Expand: Boolean): Boolean;
{* 返回当前进程中的环境变量列表 }

function SetEnvironmentVar(const Name, Value: string): Boolean;
{* 设置当前进程中的环境变量 }

//------------------------------------------------------------------------------
// 扩展的字符串操作函数
//------------------------------------------------------------------------------

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

function IntToStrEx(Value: Integer; Len: Integer; FillChar: Char = '0'): string;
{* 扩展整数转字符串函数}

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

function IsFloat(const s: String): Boolean;
{* 判断字符串是否可转换成浮点型}

function IsInt(const s: String): Boolean;
{* 判断字符串是否可转换成整型}

function IsDateTime(const s: string): Boolean;
{* 判断字符串是否可转换成 DateTime }

function IsValidEmail(const s: string): Boolean;
{* 判断是否有效的邮件地址 }

function StrSpToInt(Value: String; Sp: Char = ','): Int64;
{* 去掉字符串中的分隔符－字符转换}

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

function StrRight(Str: string; Len: Integer): string;
{* 返回字符串右边的字符}

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

function GetLine(C: Char; Len: Integer): string;
{* 返回字符串行}