usysfunc.pas

一个小程序

unit uSysFunc;
{***********************************************************************
 名称:uSysFunc
 说明:系统函数定义，例如得到路径、拷贝文件等
 平台:Windows 98/2000/xp/2003, Delphi 7
 编程:张新民，2008.12.11
 Copyright (c) 2009~2015 e-linksoft Computer, e-linksoft.
************************************************************************}
interface

uses
  Windows,Messages,SysUtils,Forms,Registry,ShellApi,FileCtrl,Controls,WinSock,Classes;

{=========================函数原型声明(杂项)==================================}
// 取得程序可执行文件所在目录的路径，包括驱动器信息。
function GetAppPath: string;

// 取得Windows System目录的路径，包括驱动器信息。
function GetWinSysDir: string;

// 取得Windows目录的路径，包括驱动器信息。
function GetWinDir: string;

// 从注册表中读取一个字符串键值。
function GetRegValue(nRoot: HKEY; sKey, sValue: string): string;

// 向注册表中写入一个字符串键值。
procedure PutRegValue(nRoot: HKEY; sKey, sValue, sData: string);

// 取得一个文件的创建时间和日期
function GetFileDate(sFileName: string): TDateTime;

// 屏蔽Ctrl+Alt+Del等系统功能键
procedure MaskSystemKey;

// 取消屏蔽Ctrl+Alt+Del等系统功能键
procedure UnMaskSystemKey;

// 打开Windows已经注册的文件
procedure URLink(url: PChar);

// 关闭外部执行程序
procedure CloseAppProcess(szClassName, szWinName: PChar);

// 隐藏Windows桌面图标
procedure HideDesktop;

// 显示Windows桌面图标
procedure ShowDesktop;

// 隐藏Windows桌面任务栏
procedure HideTaskbar;

// 显示Windows桌面任务栏
procedure ShowTaskbar;

// 取得计算机名称
function GetStationID: string;

// 取得计算机IP地址
function GetStationIp:string;

// 迟指定毫秒数的时间
procedure DelayMSec(iSleepTime: Integer);

// 确认日期字符串是否正确
function IsValidDateStr(sDate: string): Boolean;

// 确认时间字符串是否正确
function IsValidTimeStr(sTime: string): Boolean;

// 判断windows版本信息
function IsWindowsLowVersion: boolean;

//关闭计算机
procedure PcShutDown;
{=========================函数原型声明(目录、文件I/O处理)==================================}
// 联接两个路径字符串
function DirConcat(sPath, sSubDir: TFileName): TFileName;

// 判断给定的目录是否存在
function DirExists(sPath: TFileName): Boolean;

// 判断给定目录的一个子目录是否存在
function SubDirExists(sPath: TFileName; sDirName: TFileName): Boolean;

// 判断给定目录下的一个文件是否存在
function MyFileExists(sPath: TFileName; sFileName: TFileName): Boolean;

// 删除一个目录
function DelDir(sDirName: TFileName): Boolean;

// 删除一个目录树
function DelTree(sDirName: TFileName): Boolean;

// 文件拷贝
function FileCopy(const sSourFileName, sDestFileName: TFileName): Boolean;

// 获得一个文件的大小字节数
function GetFileSizeBytes(const sFileName: TFileName): Integer;

procedure MyDel(const filenames: string); //删除文件
procedure MyCopy(const sour, dest: string); //文件拷贝

{=========================函数原型声明(对话框通用函数)==================================}
// 对话框函数，可以显示标题、文本，选择显示的按钮和图标
function MsgDlg(const sText: string; wFlags: Word): Word;

// 确认对话框，包含Yes and No按钮。
function ConfirmDlg(const sText: string): Boolean;

// 确认对话框，包含Yes and No and Cancel按钮。
function ConfirmDlgWithCancel(const sText: string): Word;

// 重试对话框，包含Retry and Cancel按钮。
function RetryDlg(const sText: string): Boolean;

// 出错信息对话框
procedure ErrorMsgBox(const sErrMsg: string);

// 警告信息对话框
procedure WarningMsgBox(const sWarningMsg: string);

// 提示信息对话框
procedure InforMsgBox(const sInforMsg: string);

{=========================函数原型声明(数值处理)==================================}
// 把字符串转换成浮点数，如果转换失败，则返回缺省值。
function StrToFloatDef(const s: string; eDef: Extended): Extended;

// 取一个浮点数数组中的最小元素的值
function MinExtOfArray(const a: array of Extended): Extended;

// 取一个浮点数数组中的最大元素的值
function MaxExtOfArray(const a: array of Extended): Extended;

// 取一个整数数组中的最小元素的值
function MinIntOfArray(const a: array of Integer): Integer;

// 取一个整数数组中的最大元素的值
function MaxIntOfArray(const a: array of Integer): Integer;

// 实数四舍五入为货币类型
function RoundToCurrency(const rValue: Real; nPrecision: Byte): Currency;

//保留指定位数的小数，舍弃其余小数位
function TruncToCurrency(const rValue: Real; nPrecision: Byte): Currency;

{=========================函数原型声明(字符串处理)==================================}
// 除去一个字符串末尾的任何指定字符Ch。（空格：#32）
function StripEndChars(s: string; ch: Char): string;

// 除去一个字符串中包含的空格。
function CutSpace(str: string): string;

// 除去一个字符串开头的任何指定字符Ch。（空格：#32）
function StripFrontChars(s: string; ch: Char): string;

// 删除一个字符串中的第一个词。
function StripFirstWord(s: string): string;

// 删除一个字符串中的第一个词，修改原字符串。
function RemoveFirstWord(var s: string): string;

// 把句子分解成单词添加到字符串表中。
procedure StrParsing(s: string; lst: TStringList);

// 根据指定子串的位置，把一个字符串分解成两部分。
function SplitStr(const sStr, sSubStr, sFlag: string): string;

// 把一个整数转换成字符串，右对齐，前面补0。
function RightJustifyPadZero(lValue: LongInt; nLen: Integer): string;

// 把字符串扩展到指定长度，尾部补空格
function FillSpaces(const str: string; const nLen: Integer): string;

// 填充制定长度，指定的字符
function FillChar(const vStr,vChar:string;const nLen: Integer;const vType:string): string;

// 把字符串中每个单词的第一个字母大写，其余字母小写。
function CapFirst(str: string): string;

// 把字符串中的一个子串用另外一个字符串代替。
function Replace(str, s1, s2: string; blCaseSensitive: Boolean): string;

// 把字符串中从第一个指定字符开始的指定个数的字符拷贝出来。
function CopyFromChar(s: string; c: Char; l: Integer): string;

// 把一个整数字符串用分隔符隔开
function DivideIntString(s: string; c: Char; l: Integer): string;

// 解密一个字符串
function DecryptStr(const S: string; Key: Word): string;
// 加密一个字符串
function EncryptStr(const S: string; Key: Word): string;

// 把字符串扩展到指定长度，尾部补指定字符
function FillChars(const str: string; const nLen: Integer; const cTail: Char): string;

//把整数转化为指定长度的字符串，前面补零
function IntToStrZero(const AInt: Integer; const nLen: Integer): string;

//==========================商业函数============================================
function Bm12To13(const vCode:string):string;

implementation

//=======================================================================
// 名称:	GetAppPath
// 说明: 	取得程序可执行文件所在目录的路径，包括驱动器信息。
// 参数：	无
// 返回：   String：得到的路径字符串
// 编程: 	张新民，2008.12.11
//=======================================================================
function GetAppPath: string;
begin
  Result := ExtractFileDir(Application.ExeName);
end;

//=======================================================================
// 名称:	GetWinSysDir
// 说明: 	取得Windows System目录的路径，包括驱动器信息。
// 参数：	无
// 返回：   String：得到的路径字符串
// 编程: 	张新民，2008.12.11
//=======================================================================
function GetWinSysDir: string;
var
  p: PChar;
  z: Integer;
begin
  z := 255;
  GetMem(p, z);
  try
    GetSystemDirectory(p, z);
    Result := string(p);
  finally
    FreeMem(p, z);
  end;
end;

//=======================================================================
// 名称:	GetWinDir
// 说明: 	取得Windows目录的路径，包括驱动器信息。
// 参数：	无
// 返回：   String：得到的路径字符串
// 编程: 	张新民，2008.12.11
//=======================================================================
function GetWinDir: string;
var
  p: PChar;
  z: Integer;
begin
  z := 255;
  GetMem(p, z);
  try
    GetWindowsDirectory(p, z);
    Result := string(p);
  finally
    Freemem(p, z);
  end;
end;

//=======================================================================
// 名称:	GetRegValue
// 说明: 	从注册表中读取一个字符串键值。
// 参数：	nRoot: HKEY
//				根键
//			sKey: String
//				子键路径
//			sValue: String
//				键值名称
// 返回：   String：键值字符串
// 编程: 	张新民，2008.12.11
//=======================================================================
function GetRegValue(nRoot: HKEY; sKey, sValue: string): string;
var
  rg: TRegistry;
begin
  rg := TRegistry.Create;
  try
    rg.RootKey := nRoot;
    if rg.OpenKey(sKey, False) then
    try
      Result := rg.ReadString(sValue)
    except
      Result := '';
      rg.WriteString(sValue, Result);
    end
    else
      Result := '';
  finally
    rg.Free;
  end;
end;

//=======================================================================
// 名称:	PutRegValue
// 说明: 	向注册表中写入一个字符串键值。
// 参数：	nRoot: HKEY
//				根键
//			sKey: String
//				子键路径
//			sValue: String
//				键值名称
//			sData：String
//				键值数据
// 返回：   无
// 编程: 	张新民，2008.12.11
//=======================================================================
procedure PutRegValue(nRoot: HKEY; sKey, sValue, sData: string);
var
  rg: TRegistry;
begin
  rg := TRegistry.Create;
  try
    rg.RootKey := nRoot;
    if rg.OpenKey(sKey, False) then
      rg.WriteString(sValue, sData)
  finally
    rg.Free;
  end;
end;

//=======================================================================
// 名称:	GetFileDate
// 说明: 	取得一个文件的创建时间和日期
// 参数：	无
// 返回：   TDateTime：时间日期值
// 编程: 	张新民，2008.12.11
//=======================================================================
function GetFileDate(sFileName: string): TDateTime;
begin
  if FileExists(sFileName) then
    Result := FileDateToDateTime(FileAge(sFileName))
  else
    Result := MaxInt;
end;

//=======================================================================
// 名称:	MaskSystemKey
// 说明: 	屏蔽Ctrl+Alt+Del等系统功能键
//			Windows 95 Only
// 参数：	无
// 返回：   无
// 编程: 	张新民，2008.12.11
//=======================================================================
procedure MaskSystemKey;
var
  temp: Integer;
begin
  SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @temp, 0);
end;

//=======================================================================
// 名称:	UnMaskSystemKey
// 说明: 	取消屏蔽Ctrl+Alt+Del等系统功能键
//			Windows 95 Only
// 参数：	无
// 返回：   无
// 编程: 	张新民，2008.12.11
//=======================================================================
procedure UnMaskSystemKey;
var
  temp: Integer;
begin
  SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, @temp, 0);
end;

//=======================================================================
// 名称:	URLink
// 说明:	打开Windows已经注册的文件
// 参数：  	url: PChar
//				被打开文件的URL路径名
// 返回：   无
// 编程: 	张新民，2008.12.11
//=======================================================================
procedure URLink(url: PChar);
begin
  ShellExecute(0, nil, URL, nil, nil, SW_NORMAL);
end;

//=======================================================================
// 名称:	CloseAppProcess
// 说明:	关闭外部执行程序
// 参数：  	szClassName: PChar
//            	窗口类名称
//			szWinName: PChar
//				窗口名称
// 返回：   无
// 编程: 	张新民，2008.12.11
//=======================================================================
procedure CloseAppProcess(szClassName, szWinName: PChar);
var
  handleWin: HWnd;
begin
  handleWin := Windows.FindWindow(szClassName, szWinName);
  if handleWin <> 0 then
  begin
    if IsIconic(handleWin) = TRUE then // 图标状态
      ShowWindow(handleWin, SW_RESTORE)
    else
      SetForegroundWindow(handleWin);
    SendMessage(handleWin, WM_CLOSE, 214, 0);
  end;
end;

//=======================================================================
// 名称:	HideDesktop
// 说明:	隐藏Windows桌面图标
// 参数：  	无
// 返回：   无
// 编程: 	张新民，2008.12.11
//=======================================================================
procedure HideDesktop;
var
  hDesktop: THandle;
begin
  hDesktop := FindWindow('Progman', nil);
  ShowWindow(hDesktop, SW_HIDE);
end;

//=======================================================================