自定义Delphi公用函数单元

博主： samool
发布时间：2015 年 09 月 07 日
25567 次浏览
暂无评论
39310字数
分类：搞软件

{*******************************************************}
{                                                       }
{             Delphi公用函数单元                        }
{                                                       }
{        版权所有 (C) 2008                           }
{                                                       }
{*******************************************************}
unit YzDelphiFunc;

interface

uses
  ComCtrls, Forms, Windows, Classes, SysUtils, ComObj, ActiveX, ShlObj, Messages,
  Graphics, Registry, Dialogs, Controls, uProcess, uCpuUsage, StrUtils, CommCtrl,
  jpeg, WinInet, ShellAPI, SHFolder, ADODB, WinSock;

{ 保存日志文件 }
procedure YzWriteLogFile(Msg: String);

{ 延时函数,单位为毫秒 }
procedure YzDelayTime(MSecs: Longint);

{ 判断字符串是否为数字 }
function YzStrIsNum(Str: string):boolean;

{ 判断文件是否正在使用 }
function YzIsFileInUse(fName: string): boolean;

{ 删除字符串列表中的空字符串 }
procedure YzDelEmptyChar(AList: TStringList);

{ 删除文件列表中的"Thumbs.db"文件 }
procedure YzDelThumbsFile(AList: TStrings);

{ 返回一个整数指定位数的带"0"字符串 }
function YzIntToZeroStr(Value, ALength: Integer): string;

{ 取日期年份分量 }
function YzGetYear(Date: TDate): Integer;


<!--more-->


{ 取日期月份分量 }
function YzGetMonth(Date: TDate): Integer;

{ 取日期天数分量 }
function YzGetDay(Date: TDate): Integer;

{ 取时间小时分量 }
function YzGetHour(Time: TTime): Integer;

{ 取时间分钟分量 }
function YzGetMinute(Time: TTime): Integer;

{ 取时间秒钟分量 }
function YzGetSecond(Time: TTime): Integer;

{ 返回时间分量字符串 }
function YzGetTimeStr(ATime: TTime;AFlag: string): string;

{ 返回日期时间字符串 }
function YzGetDateTimeStr(ATime: TTime;ADate: TDate): string;

{ 获取计算机名称 }
function YzGetComputerName(): string;

{ 通过窗体子串查找窗体 }
procedure YzFindSpecWindow(ASubTitle: string);

{ 判断进程CPU占用率 }
procedure YzJudgeCPU(ProcessName: string;CPUUsage: Single);

{ 分割字符串 }
procedure YzSeparateTerms(Source: string;Separator: Char;Terms: TStringList);

{ 切换页面控件的活动页面 }
procedure YzGotoNewPage(AOwerPage: TPageControl;ANewPage: TTabSheet);

{ 设置页面控件标签的可见性 }
procedure YzSetTableVisible(PageControl: TPageControl;ShowFlag: Boolean);

{ 根据产品名称获取产品编号 }
function YzGetLevelCode(AName:string;ProductList: TStringList): string;

{ 取文件的主文件名 }
function YzGetMainFileName(AFileName: string): string;

{ 按下一个键 }
procedure YzPressOneKey(AByteCode: Byte);overload;

{ 按下一个指定次数的键 }
procedure YzPressOneKey(AByteCode: Byte;ATimes: Integer);overload;

{ 按下二个键 }
procedure YzPressTwoKeys(AFirstByteCode, ASecByteCode: Byte);

{ 按下三个键 }
procedure YzPressThreeKeys(AFirstByteCode, ASecByteCode, AThirdByteCode: Byte);

{ 创建桌面快捷方式 }
procedure YzCreateShortCut(const sPath: string; sShortCutName: WideString);

{ 删除桌面快捷方式 }
procedure YzDeleteShortCut(sShortCutName: WideString);

{ 通过光标位置进行鼠标左键单击 }
procedure YzMouseLeftClick(X, Y: Integer);overload;

{ 鼠标左键双击 }
procedure YzMouseDoubleClick(X, Y: Integer);

{ 通过窗口句柄进行鼠标左键单击 }
procedure YzMouseLeftClick(lpClassName, lpWindowName: PAnsiChar);overload;

{ 通过光标位置查找窗口句柄 }
function YzWindowFromPoint(X, Y: Integer): THandle;

{ 等待窗口在指定时间后出现 }
function YzWaitWindowExist(lpClassName, lpWindowName: PAnsiChar;
  ASecond: Integer = 0): THandle;overload;

{ 通光标位置,窗口类名与标题查找窗口是否存在 }
function YzWaitWindowExist(X, Y: Integer;AClassName, AWinName: string;
  ASecond: Integer = 0):THandle; overload;

{ 等待指定窗口消失 }
procedure YzWaitWindowClose(lpClassName, lpWindowName: PAnsiChar;
  ASecond: Integer = 0);

{ 通过窗口句柄设置文本框控件文本 }
procedure YzSetEditText(lpClassName, lpWindowName: PAnsiChar;
  AText: string);overload;

{ 通过光标位置设置文本框控件文本 }
procedure YzSetEditText(X, Y: Integer;AText: string);overload;

{ 获取Window操作系统语言 }
function YzGetWindowsLanguageStr: String;

{ 清空动态数组 }
procedure YzDynArraySetZero(var A);

{ 动态设置屏幕分辨率 }
function YzDynamicResolution(X, Y: WORD): Boolean;

{ 检测系统屏幕分辨率 }
function YzCheckDisplayInfo(X, Y: Integer): Boolean;

type
  TFontedControl = class(TControl)
  public
    property Font;
  end;
  TFontMapping = record
    SWidth : Integer;
    SHeight: Integer;
    FName: string;
    FSize: Integer;
  end;

  procedure YzFixForm(AForm: TForm);
  procedure YzSetFontMapping;

{---------------------------------------------------
 以下是关于获取系统软件卸载的信息的类型声明和函数
 ----------------------------------------------------}
type
  TUninstallInfo = array of record
    RegProgramName: string;
    ProgramName   : string;
    UninstallPath : string;
    Publisher     : string;
    PublisherURL  : string;
    Version       : string;
    HelpLink      : string;
    UpdateInfoURL : string;
    RegCompany    : string;
    RegOwner      : string;
  end;

{ GetUninstallInfo 返回系统软件卸载的信息 }
function YzGetUninstallInfo : TUninstallInfo;

{ 检测Java安装信息 }
function YzCheckJavaInfo(AUninstallInfo: TUninstallInfo;CheckJava6 : Boolean = False): Boolean;

{ 窗口自适应屏幕大小 }
procedure YzAdjustForm(Form: TForm;const OrgWidth, OrgHeight: integer);

{ 设置窗口为当前窗体 }
procedure YzBringMyAppToFront(AppHandle: THandle);

{ 获取文件夹大小 }
function YzGetDirSize(Dir: string;SubDir: Boolean): LongInt;

{ 获取文件夹文件数量 }
function YzGetDirFiles(Dir: string;SubDir: Boolean): LongInt;

{ 获取文件大小(KB) }
function YzGetFileSize(const FileName: String): LongInt;

{ 获取文件大小(字节) }
function YzGetFileSize_Byte(const FileName: String): LongInt;

{ 算术舍入法的四舍五入取整函数 }
function YzRoundEx (const Value: Real): LongInt;

{ 弹出选择目录对话框 }
function YzSelectDir(const iMode: integer;const sInfo: string): string;

{ 获取指定路径下文件夹的个数 }
procedure YzListFolders(const Path: String; const ShowPath: Boolean;var List: TStrings);

{ 禁用窗器控件的所有子控件 }
procedure YzSetSubCtlState(AOwer: TWinControl;AState: Boolean);

{ 模拟键盘按键操作(处理字节码) }
procedure YzFKeyent(byteCard: byte); overload;

{ 模拟键盘按键操作(处理字符串 }
procedure YzFKeyent(strCard: string); overload;

{ 锁定窗口位置 }
procedure YzLockWindow(ClassName,WinName: PChar;poX,poY: Integer);

{   注册一个DLL形式或OCX形式的OLE/COM控件
    参数strOleFileName为一个DLL或OCX文件名，
    参数OleAction表示注册操作类型，1表示注册，0表示卸载
    返回值True表示操作执行成功，False表示操作执行失败
}
function YzRegisterOleFile (strOleFileName: STRING;OleAction: Byte): BOOLEAN;

function YzListViewColumnCount(mHandle: THandle): Integer;

function YzGetListViewText(mHandle: THandle; mStrings: TStrings): Boolean;

{ 删除目录树 }
function YzDeleteDirectoryTree(Path: string): boolean;

{ Jpg格式转换为bmp格式 }
function JpgToBmp(Jpg: TJpegImage): TBitmap;

{ 设置程序自启动函数 }
function YzSetAutoRun(AFilePath: string;AFlag: Boolean): boolean;

{ 检测URL地址是否有效 }
function YzCheckUrl(url: string): Boolean;

{ 获取程序可执行文件名 }
function YzGetExeFName: string;

{ 目录浏览对话框函数 }
function YzBrowseFolder(AOwer: TWinControl;ATitle: string):string;

{ 重启计算机 }
function YzShutDownSystem(AFlag: Integer):BOOL;

{ 程序运行后删除自身 }
procedure YzDeleteSelf;

{ 程序重启 }
procedure YzAppRestart;

{ 压缩Access数据库 }
function YzCompactAccessDB(const AFileName, APassWord: string): Boolean;

{ 标题:获取其他进程中TreeView的文本 }
function YzTreeNodeGetNext(mHandle: THandle; mTreeItem: HTreeItem): HTreeItem;
function YzTreeNodeGetLevel(mHandle: THandle; mTreeItem: HTreeItem): Integer;
function YzGetTreeViewText(mHandle: THandle; mStrings: TStrings): Boolean;

{ 获取本地Application Data目录路径 }
function YzLocalAppDataPath : string;

{ 获取Windows当前登录的用户名 }
function YzGetWindwosUserName: String;

{枚举托盘图标 }
function YzEnumTrayNotifyWnd(AFindList: TStringList;ADestStr: string): BOOL;

{ 获取SQL Server用户数据库列表 }
procedure YzGetSQLServerDBList(ADBHostIP, ALoginPwd: string;ADBList: TStringList);

{ 读取据库中所有的表 }
procedure YzGetTableList(ConncetStr: string;ATableList: TStringList);

{ 将域名解释成IP地址 }
function YzDomainToIP(HostName: string): string;

{ 等待进程结束 }
procedure YzWaitProcessExit(AProcessName: string);

{ 移去系统托盘失效图标 }
procedure YzRemoveDeadIcons();

{ 转移程序占用内存至虚拟内存 }
procedure YzClearMemory;

{ 检测允许试用的天数是否已到期 }
function YzCheckTrialDays(AllowDays: Integer): Boolean;

{ 指定长度的随机小写字符串函数 }
function YzRandomStr(aLength: Longint): string;

var
  FontMapping : array of TFontMapping;

implementation

uses
  uMain;

{ 保存日志文件 }
procedure YzWriteLogFile(Msg: String);
var
  FileStream: TFileStream;
  LogFile   : String;
begin
  try
    { 每天一个日志文件 }
    Msg := '[' + DateTimeToStr(Now)+ '] '+ Msg;
    LogFile := ExtractFilePath(Application.ExeName) + '/Logs/' + DateToStr(Now) + '.log';
    if not DirectoryExists(ExtractFilePath(LogFile)) then
      CreateDir(ExtractFilePath(LogFile));
    if FileExists(LogFile) then
      FileStream := TFileStream.Create(LogFile, fmOpenWrite or fmShareDenyNone)
    else
      FileStream:=TFileStream.Create(LogFile,fmCreate or fmShareDenyNone);
    FileStream.Position:=FileStream.Size;
    Msg := Msg + #13#10;
    FileStream.Write(PChar(Msg)^, Length(Msg));
    FileStream.Free;
  except
  end;
end;

{ 延时函数,单位为毫秒 }
procedure YZDelayTime(MSecs: Longint);
var
  FirstTickCount, Now: Longint;
begin
  FirstTickCount := GetTickCount();
  repeat
    Application.ProcessMessages;
    Now := GetTickCount();
  until (Now - FirstTickCount>=MSecs) or (Now < FirstTickCount);
end;

{ 判断字符串是否为数字 }
function YzStrIsNum(Str: string):boolean;
var
  I: integer;
begin
  if Str = '' then
  begin
    Result := False;
    Exit;
  end;
  for I:=1 to length(str) do
    if not (Str[I] in ['0'..'9']) then
    begin
      Result := False;
      Exit;
    end;
  Result := True;
end;

{ 判断文件是否正在使用 }
function YzIsFileInUse(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;

{ 删除字符串列表中的空字符串 }
procedure YzDelEmptyChar(AList: TStringList);
var
  I: Integer;
  TmpList: TStringList;
begin
  TmpList := TStringList.Create;
  for I := 0 to AList.Count - 1 do
    if AList.Strings[I] <> '' then TmpList.Add(AList.Strings[I]);
  AList.Clear;
  AList.Text := TmpList.Text;
  TmpList.Free;
end;

{ 删除文件列表中的"Thumbs.db"文件 }
procedure YzDelThumbsFile(AList: TStrings);
var
  I: Integer;
  TmpList: TStringList;
begin
  TmpList := TStringList.Create;
  for I := 0 to AList.Count - 1 do
    if ExtractFileName(AList.Strings[I]) <> 'Thumbs.db' then
      TmpList.Add(AList.Strings[I]);
  AList.Clear;
  AList.Text := TmpList.Text;
  TmpList.Free;
end;

{-------------------------------------------------------------
  功能:    返回一个整数指定位数的带"0"字符串
  参数:    Value:要转换的整数 ALength:字符串长度
  返回值:  string
--------------------------------------------------------------}
function YzIntToZeroStr(Value, ALength: Integer): string;
var
  I, ACount: Integer;
begin
  Result := '';
  ACount := Length(IntToStr(Value));
  if ACount >= ALength then Result := IntToStr(Value)
  else
  begin
    for I := 1 to ALength-ACount do
      Result := Result + '0';
    Result := Result + IntToStr(Value)
  end;
end;

{ 取日期年份分量 }
function YzGetYear(Date: TDate): Integer;
var
  y, m, d: WORD;
begin
  DecodeDate(Date, y, m, d);
  Result := y;
end;

{ 取日期月份分量 }
function YzGetMonth(Date: TDate): Integer;
var
  y, m, d: WORD;
begin
  DecodeDate(Date, y, m, d);
  Result := m;
end;

{ 取日期天数分量 }
function YzGetDay(Date: TDate): Integer;
var
  y, m, d: WORD;
begin
  DecodeDate(Date, y, m, d);
  Result := d;
end;

{ 取时间小时分量 }
function YzGetHour(Time: TTime): Integer;
var
  h, m, s, ms: WORD;
begin
  DecodeTime(Time, h, m, s, ms);
  Result := h;
end;

{ 取时间分钟分量 }
function YzGetMinute(Time: TTime): Integer;
var
  h, m, s, ms: WORD;
begin
  DecodeTime(Time, h, m, s, ms);
  Result := m;
end;

{ 取时间秒钟分量 }
function YzGetSecond(Time: TTime): Integer;
var
  h, m, s, ms: WORD;
begin
  DecodeTime(Time, h, m, s, ms);
  Result := s;
end;

{ 返回时间分量字符串 }
function YzGetTimeStr(ATime: TTime;AFlag: string): string;
var
  wTimeStr: string;
  FH, FM, FS, FMS: WORD;
const
  HOURTYPE    = 'Hour';
  MINUTETYPE  = 'Minute';
  SECONDTYPE  = 'Second';
  MSECONDTYPE = 'MSecond';
begin
  wTimeStr := TimeToStr(ATime);
  if Pos('上午', wTimeStr) <> 0 then
    wTimeStr := Copy(wTimeStr, Pos('上午', wTimeStr) + 4, 10)
  else if Pos('下午', wTimeStr) <> 0 then
    wTimeStr := Copy(wTimeStr, Pos('下午', wTimeStr) + 4, 10);
  DecodeTime(ATime, FH, FM, FS, FMS);
  if AFlag = HOURTYPE then
  begin
    { 如果是12小时制则下午的小时分量加12 }
    if Pos('下午', wTimeStr) <> 0 then
      Result := YzIntToZeroStr(FH + 12, 2)
    else
      Result := YzIntToZeroStr(FH, 2);
  end;
  if AFlag = MINUTETYPE  then Result := YzIntToZeroStr(FM, 2);
  if AFlag = SECONDTYPE  then Result := YzIntToZeroStr(FS, 2);
  if AFlag = MSECONDTYPE then Result := YzIntToZeroStr(FMS, 2);
end;

{ 返回日期时间字符串 }
function YzGetDateTimeStr(ATime: TTime;ADate: TDate): string;
var
  wYear, wMonth, wDay: string;
  wHour, wMinute, wSecond: string;
begin
  wYear := RightStr(YzIntToZeroStr(YzGetYear(ADate), 4), 2);
  wMonth := YzIntToZeroStr(YzGetMonth(ADate), 2);
  wDay := YzIntToZeroStr(YzGetDay(ADate), 2);

  wHour := YzGetTimeStr(ATime, 'Hour');
  wMinute := YzGetTimeStr(ATime, 'Minute');
  wSecond := YzGetTimeStr(ATime, 'Second');

  Result := wYear + wMonth + wDay + wHour + wMinute + wSecond;
end;

{ 通过窗体子串查找窗体 }
procedure YzFindSpecWindow(ASubTitle: string);

  function EnumWndProc(AWnd: THandle;AWinName: string): Boolean;stdcall;
  var
    WindowText: array[0..255] of Char;
    WindowStr: string;
  begin
    GetWindowText(AWnd, WindowText, 255);
    WindowStr := StrPas(WindowText);
    WindowStr := COPY(WindowStr, 1, StrLen(PChar(AWinName)));
    if CompareText(AWinName, WindowStr) = 0 then
    begin
      SetForegroundWindow(AWnd);
      Result := False; Exit;
    end;
    Result := True;
  end;

begin
  EnumWindows(@EnumWndProc, LongInt(@ASubTitle));
  YzDelayTime(1000);
end;

{ 获取计算机名称 }
function YzGetComputerName(): string;
var
  pcComputer: PChar;
  dwCSize: DWORD;
begin
  dwCSize := MAX_COMPUTERNAME_LENGTH + 1;
  Result := '';
  GetMem(pcComputer, dwCSize);
  try
    if Windows.GetComputerName(pcComputer, dwCSize) then
      Result := pcComputer;
  finally
    FreeMem(pcComputer);
  end;
end;

{ 判断进程CPU占用率 }
procedure YzJudgeCPU(ProcessName: string;CPUUsage: Single);
var
  cnt: PCPUUsageData;
  usage: Single;
begin
  cnt := wsCreateUsageCounter(FindProcess(ProcessName));
  while True do
  begin
    usage := wsGetCpuUsage(cnt);
    if usage <= CPUUsage then
    begin
      wsDestroyUsageCounter(cnt);
      YzDelayTime(2000);
      Break;
    end;
    YzDelayTime(10);
    Application.ProcessMessages;
  end;
end;

{ 分割字符串 }
procedure YzSeparateTerms(Source: string;Separator: Char;Terms: TStringList);
var
  TmpStr: string;
  PO: integer;
begin
  Terms.Clear;
  if Length(Source) = 0 then Exit;   { 长度为0则退出 }
  PO := Pos(Separator, Source);
  if PO = 0 then
  begin
    Terms.Add(Source);
    Exit;
  end;
  while PO <> 0 do
  begin
    TmpStr := Copy(Source, 1, PO - 1);{ 复制字符 }
    Terms.Add(TmpStr);                { 添加到列表 }
    Delete(Source, 1, PO);            { 删除字符和分割符 }
    PO := Pos(Separator, Source);     { 查找分割符 }
  end;
  if Length(Source) > 0 then
    Terms.Add(Source);                { 添加剩下的条目 }
end;

{ 切换页面控件的活动页面 }
procedure YzGotoNewPage(AOwerPage: TPageControl;ANewPage: TTabSheet);
begin
  if AOwerPage.ActivePage <> ANewPage then AOwerPage.ActivePage := ANewPage;
end;

{ 设置页面控件标签的可见性 }
procedure YzSetTableVisible(PageControl: TPageControl;ShowFlag: Boolean);
var
  I: Integer;
begin
  for I := 0 to PageControl.PageCount -1 do
    PageControl.Pages[I].TabVisible := ShowFlag;
end;

{ 根据产品名称获取产品编号 }
function YZGetLevelCode(AName:string;ProductList: TStringList): string;
var
  I: Integer;
  TmpStr: string;
begin
  Result := '';
  if ProductList.Count <= 0 then Exit;
  for I := 0 to ProductList.Count-1 do
  begin
    TmpStr := ProductList.Strings[I];
    if AName = Copy(TmpStr,1, Pos('_', TmpStr)-1) then
    begin
      Result := Copy(TmpStr, Pos('_', TmpStr)+1, 10);
      Break;
    end;
  end;
end;

{ 取文件的主文件名 }
function YzGetMainFileName(AFileName:string): string;
var
  TmpStr: string;
begin
  if AFileName = '' then Exit;
  TmpStr := ExtractFileName(AFileName);
  Result := Copy(TmpStr, 1, Pos('.', TmpStr) - 1);
end;

{ 按下一个键 }
procedure YzPressOneKey(AByteCode: Byte);
begin
  keybd_event(AByteCode, 0, 0, 0);
  YzDelayTime(100);
  keybd_event(AByteCode, 0, KEYEVENTF_KEYUP, 0);
  YzDelayTime(400);
end;

{ 按下一个指定次数的键 }
procedure YzPressOneKey(AByteCode: Byte;ATimes: Integer);overload;
var
  I: Integer;
begin
  for I := 1 to ATimes do
  begin
    keybd_event(AByteCode, 0, 0, 0);
    YzDelayTime(10);
    keybd_event(AByteCode, 0, KEYEVENTF_KEYUP, 0);
    YzDelayTime(150);
  end;
end;

{ 按下二个键 }
procedure YzPressTwoKeys(AFirstByteCode, ASecByteCode: Byte);
begin
  keybd_event(AFirstByteCode, 0, 0, 0);
  keybd_event(ASecByteCode, 0, 0, 0);
  YzDelayTime(100);
  keybd_event(ASecByteCode, 0, KEYEVENTF_KEYUP, 0);
  keybd_event(AFirstByteCode, 0, KEYEVENTF_KEYUP, 0);
  YzDelayTime(400);
end;

{ 按下三个键 }
procedure YzPressThreeKeys(AFirstByteCode, ASecByteCode, AThirdByteCode: Byte);
begin
  keybd_event(AFirstByteCode, 0, 0, 0);
  keybd_event(ASecByteCode, 0, 0, 0);
  keybd_event(AThirdByteCode, 0, 0, 0);
  YzDelayTime(100);
  keybd_event(AThirdByteCode, 0, KEYEVENTF_KEYUP, 0);
  keybd_event(ASecByteCode, 0, KEYEVENTF_KEYUP, 0);
  keybd_event(AFirstByteCode, 0, KEYEVENTF_KEYUP, 0);
  YzDelayTime(400);
end;

{ 创建桌面快捷方式 }
procedure YzCreateShortCut(const sPath: string; sShortCutName: WideString);
var
  tmpObject: IUnknown;
  tmpSLink: IShellLink;
  tmpPFile: IPersistFile;
  PIDL: PItemIDList;
  StartupDirectory: array[0..MAX_PATH] of Char;
  StartupFilename: String;
  LinkFilename: WideString;
begin
  StartupFilename := sPath;
  tmpObject := CreateComObject(CLSID_ShellLink); { 创建建立快捷方式的外壳扩展 }
  tmpSLink := tmpObject as IShellLink;           { 取得接口 }
  tmpPFile := tmpObject as IPersistFile;         { 用来储存*.lnk文件的接口 }
  tmpSLink.SetPath(pChar(StartupFilename));      { 设定notepad.exe所在路径 }
  tmpSLink.SetWorkingDirectory(pChar(ExtractFilePath(StartupFilename))); {设定工作目录 }
  SHGetSpecialFolderLocation(0, CSIDL_DESKTOPDIRECTORY, PIDL); { 获得桌面的Itemidlist }
  SHGetPathFromIDList(PIDL, StartupDirectory);   { 获得桌面路径 }
  sShortCutName := '/' + sShortCutName + '.lnk';
  LinkFilename := StartupDirectory + sShortCutName;
  tmpPFile.Save(pWChar(LinkFilename), FALSE);    { 保存*.lnk文件 }
end;

{ 删除桌面快捷方式 }
procedure YzDeleteShortCut(sShortCutName: WideString);
var
  PIDL : PItemIDList;
  StartupDirectory: array[0..MAX_PATH] of Char;
  LinkFilename: WideString;
begin
  SHGetSpecialFolderLocation(0,CSIDL_DESKTOPDIRECTORY,PIDL);
  SHGetPathFromIDList(PIDL,StartupDirectory);
  LinkFilename := StrPas(StartupDirectory) + '/' + sShortCutName + '.lnk';
  DeleteFile(LinkFilename);
end;

{ 通过光标位置进行鼠标左键单击 }
procedure YzMouseLeftClick(X, Y: Integer);
begin
  SetCursorPos(X, Y);
  YzDelayTime(100);
  mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
  mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
  YzDelayTime(400);
end;

{ 鼠标左键双击 }
procedure YzMouseDoubleClick(X, Y: Integer);
begin
  SetCursorPos(X, Y);
  YzDelayTime(100);
  mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
  mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
  YzDelayTime(100);
  mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
  mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
  YzDelayTime(400);
end;


{ 通过窗口句柄进行鼠标左键单击 }
procedure YzMouseLeftClick(lpClassName, lpWindowName: PAnsiChar);overload;
var
  AHandel: THandle;
begin
  AHandel := FindWindow(lpClassName, lpWindowName);
  SendMessage(AHandel, WM_LBUTTONDOWN, 0, 0);
  SendMessage(AHandel, WM_LBUTTONUP, 0, 0);
  YzDelayTime(500);
end;

{ 等待进程结束 }
procedure YzWaitProcessExit(AProcessName: string);
begin
  while True do
  begin
    KillByPID(FindProcess(AProcessName));
    if FindProcess(AProcessName) = 0 then Break;
    YzDelayTime(10);
    Application.ProcessMessages;
  end;
end;

{-------------------------------------------------------------
  功  能:  等待窗口在指定时间后出现
  参  数:  lpClassName: 窗口类名
           lpWindowName: 窗口标题
           ASecond: 要等待的时间,"0"代表永久等待
  返回值:  无
  备  注:  如果指定的等待时间未到窗口已出现则立即退出
--------------------------------------------------------------}
function YzWaitWindowExist(lpClassName, lpWindowName: PAnsiChar;
  ASecond: Integer = 0): THandle;overload;
var
  StartTickCount, PassTickCount: LongWord;
begin
  Result := 0;
  { 永久等待 }
  if ASecond = 0 then
  begin
    while True do
    begin
      Result := FindWindow(lpClassName, lpWindowName);
      if Result <> 0 then Break;
      YzDelayTime(10);
      Application.ProcessMessages;
    end;
  end
  else { 等待指定时间 }
  begin
    StartTickCount := GetTickCount;
    while True do
    begin
      Result := FindWindow(lpClassName, lpWindowName);
      { 窗口已出现则立即退出 }
      if Result <> 0 then Break
      else
      begin
        PassTickCount := GetTickCount;
        { 等待时间已到则退出 }
        if (PassTickCount - StartTickCount) div 1000 >= ASecond then Break;
      end;
      YzDelayTime(10);
      Application.ProcessMessages;
    end;
  end;
  YzDelayTime(1000);
end;

{ 等待指定窗口消失 }
procedure YzWaitWindowClose(lpClassName, lpWindowName: PAnsiChar;
  ASecond: Integer = 0);
var
  StartTickCount, PassTickCount: LongWord;
begin
  if ASecond = 0 then
  begin
    while True do
    begin
      if FindWindow(lpClassName, lpWindowName) = 0 then Break;
      YzDelayTime(10);
      Application.ProcessMessages;
    end
  end
  else
  begin
    StartTickCount := GetTickCount;
    while True do
    begin
      { 窗口已关闭则立即退出 }
      if FindWindow(lpClassName, lpWindowName)= 0 then Break
      else
      begin
        PassTickCount := GetTickCount;
        { 等待时间已到则退出 }
        if (PassTickCount - StartTickCount) div 1000 >= ASecond then Break;
      end;
      YzDelayTime(10);
      Application.ProcessMessages;
    end;
  end;
  YzDelayTime(500);
end;

{ 通过光标位置查找窗口句柄 }
function YzWindowFromPoint(X, Y: Integer): THandle;
var
  MousePoint: TPoint;
  CurWindow: THandle;
  hRect: TRect;
  Canvas: TCanvas;
begin
  MousePoint.X := X;
  MousePoint.Y := Y;
  CurWindow := WindowFromPoint(MousePoint);
  GetWindowRect(Curwindow, hRect);
  if Curwindow <> 0 then
  begin
    Canvas := TCanvas.Create;
    Canvas.Handle := GetWindowDC(Curwindow);
    Canvas.Pen.Width := 2;
    Canvas.Pen.Color := clRed;
    Canvas.Pen.Mode := pmNotXor;
    Canvas.Brush.Style := bsClear;
    Canvas.Rectangle(0, 0, hRect.Right-hRect.Left, hRect.Bottom-hRect.Top);
    Canvas.Free;
  end;
  Result := CurWindow;
end;

{ 通光标位置,窗口类名与标题查找窗口是否存在 }
function YzWaitWindowExist(X, Y: Integer;AClassName, AWinName: string;
  ASecond: Integer):THandle;overload;
var
  MousePo: TPoint;
  CurWindow: THandle;
  bufClassName: array[0..MAXBYTE-1] of Char;
  bufWinName: array[0..MAXBYTE-1] of Char;
  StartTickCount, PassTickCount: LongWord;
begin
  Result := 0;
  { 永久等待 }
  if ASecond = 0 then
  begin
    while True do
    begin
      MousePo.X := X;
      MousePo.Y := Y;
      CurWindow := WindowFromPoint(MousePo);
      GetClassName(CurWindow, bufClassName, MAXBYTE);
      GetWindowText(CurWindow, bufWinname, MAXBYTE);
      if (CompareText(StrPas(bufClassName), AClassName) = 0 ) and
         (CompareText(StrPas(bufWinName), AWinName) = 0) then
      begin
        Result := CurWindow;
        Break;
      end;
      YzDelayTime(10);
      Application.ProcessMessages;
    end;
  end
  else { 等待指定时间 }
  begin
    StartTickCount := GetTickCount;
    while True do
    begin
      { 窗口已出现则立即退出 }
      MousePo.X := X;
      MousePo.Y := Y;
      CurWindow := WindowFromPoint(MousePo);
      GetClassName(CurWindow, bufClassName, MAXBYTE);
      GetWindowText(CurWindow, bufWinname, MAXBYTE);
      if (CompareText(StrPas(bufClassName), AClassName) = 0 ) and
         (CompareText(StrPas(bufWinName), AWinName) = 0) then
      begin
        Result := CurWindow; Break;
      end
      else
      begin
        PassTickCount := GetTickCount;
        { 等待时间已到则退出 }
        if (PassTickCount - StartTickCount) div 1000 >= ASecond then Break;
      end;
      YzDelayTime(10);
      Application.ProcessMessages;
    end;
  end;
  YzDelayTime(1000);
end;

{ 通过窗口句柄设置文本框控件文本 }
procedure YzSetEditText(lpClassName, lpWindowName: PAnsiChar;
  AText: string);overload;
var
  CurWindow: THandle;
begin
  CurWindow := FindWindow(lpClassName, lpWindowName);
  SendMessage(CurWindow ,WM_SETTEXT, 0, Integer(PChar(AText)));
  YzDelayTime(500);
end;

{ 通过光标位置设置文本框控件文本 }
procedure YzSetEditText(X, Y: Integer;AText: string);overload;
var
  CurWindow: THandle;
begin
  CurWindow := YzWindowFromPoint(X, Y);
  SendMessage(CurWindow, WM_SETTEXT, 0, Integer(PChar(AText)));
  YzMouseLeftClick(X, Y);
end;

{ 获取Window操作系统语言 }
function YzGetWindowsLanguageStr: String;
var
  WinLanguage: array [0..50] of char;
begin
  VerLanguageName(GetSystemDefaultLangID, WinLanguage, 50);
  Result := StrPas(WinLanguage);
end;

procedure YzDynArraySetZero(var A);
var
  P: PLongint;  { 4个字节 }
begin
  P := PLongint(A); { 指向 A 的地址 }
  Dec(P);  { P地址偏移量是 sizeof(A),指向了数组长度 }
  P^ := 0; { 数组长度清空 }
  Dec(P);  { 指向数组引用计数 }
  P^ := 0; { 数组计数清空 }
end;

{ 动态设置分辨率 }
function YzDynamicResolution(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 YzSetFontMapping;
begin
  SetLength(FontMapping, 3);

  { 800 x 600 }
  FontMapping[0].SWidth := 800;
  FontMapping[0].SHeight := 600;
  FontMapping[0].FName := '宋体';
  FontMapping[0].FSize := 7;

  { 1024 x 768 }
  FontMapping[1].SWidth := 1024;
  FontMapping[1].SHeight := 768;
  FontMapping[1].FName := '宋体';
  FontMapping[1].FSize := 9;

  { 1280 x 1024 }
  FontMapping[2].SWidth := 1280;
  FontMapping[2].SHeight := 1024;
  FontMapping[2].FName := '宋体';
  FontMapping[2].FSize := 11;
end;

{ 程序窗体及控件自适应分辨率(有问题) }
procedure YzFixForm(AForm: TForm);
var
  I, J: integer;
  T: TControl;
begin
  with AForm do
  begin
    for I := 0 to ComponentCount - 1 do
    begin
      try
        T := TControl(Components[I]);
        T.left := Trunc(T.left * (Screen.width / 1024));
        T.top := Trunc(T.Top * (Screen.Height / 768));
        T.Width := Trunc(T.Width * (Screen.Width / 1024));
        T.Height := Trunc(T.Height * (Screen.Height / 768));
      except
      end; { try }
    end; { for I }

    for I:= 0 to Length(FontMapping) - 1 do
    begin
      if (Screen.Width = FontMapping[I].SWidth) and (Screen.Height =
        FontMapping[I].SHeight) then
      begin
        for J := 0 to ComponentCount - 1 do
        begin
          try
            TFontedControl(Components[J]).Font.Name := FontMapping[I].FName;
            TFontedControl(Components[J]).FONT.Size := FontMapping[I].FSize;
          except
          end; { try }
        end; { for J }
      end; { if }
    end; { for I }
  end; { with }
end;

{ 检测系统屏幕分辨率 }
function YzCheckDisplayInfo(X, Y: Integer): Boolean;
begin
  Result := True;
  if (Screen.Width <> X) and (Screen.Height <> Y) then
  begin
    if MessageBox(Application.Handle, PChar( '系统检测到您的屏幕分辨率不是 '
      + IntToStr(X) + '×' + IntToStr(Y) + '，这将影响到系统的正常运行，'
      + '是否要自动调整屏幕分辨率？'), '提示', MB_YESNO + MB_ICONQUESTION
      + MB_TOPMOST) = 6 then YzDynamicResolution(1024, 768)
    else Result := False;
  end;
end;

function YzGetUninstallInfo: TUninstallInfo;
const
  Key = '/SOFTWARE/Microsoft/Windows/CurrentVersion/Uninstall/';
var
  S : TStrings;
  I : Integer;
  J : Integer;
begin
  with TRegistry.Create do
  begin
    S := TStringlist.Create;
    J := 0;
    try
      RootKey:= HKEY_LOCAL_MACHINE;
      OpenKeyReadOnly(Key);
      GetKeyNames(S);
      Setlength(Result, S.Count);
      for I:= 0 to S.Count - 1 do
      begin
        If OpenKeyReadOnly(Key + S[I]) then
        If ValueExists('DisplayName') and ValueExists('UninstallString') then
        begin
          Result[J].RegProgramName:= S[I];
          Result[J].ProgramName:= ReadString('DisplayName');
          Result[J].UninstallPath:= ReadString('UninstallString');
          If ValueExists('Publisher') then
            Result[J].Publisher:= ReadString('Publisher');
          If ValueExists('URLInfoAbout') then
            Result[J].PublisherURL:= ReadString('URLInfoAbout');
          If ValueExists('DisplayVersion') then
            Result[J].Version:= ReadString('DisplayVersion');
          If ValueExists('HelpLink') then
            Result[J].HelpLink:= ReadString('HelpLink');
          If ValueExists('URLUpdateInfo') then
            Result[J].UpdateInfoURL:= ReadString('URLUpdateInfo');
          If ValueExists('RegCompany') then
            Result[J].RegCompany:= ReadString('RegCompany');
          If ValueExists('RegOwner') then
            Result[J].RegOwner:= ReadString('RegOwner');
          Inc(J);
        end;
      end;
    finally
      Free;
      S.Free;
      SetLength(Result, J);
    end;
  end;
end;

{ 检测Java安装信息 }
function YzCheckJavaInfo(AUninstallInfo: TUninstallInfo;CheckJava6 : Boolean = False): Boolean;
var
  I: Integer;
  Java6Exist: Boolean;
  AUninstall: TUninstallInfo;
  AProgramList: TStringList;
  AJavaVersion, AFilePath: string;
begin
  Result := True;
  Java6Exist := False;
  AJavaVersion := 'J2SE Runtime Environment 5.0 Update 14';
  AUninstall := YzGetUninstallInfo;
  AProgramList := TStringList.Create;
  for I := Low(AUninstall) to High(AUninstall) do
  begin
    if Pos('J2SE', AUninstall[I].ProgramName) <> 0 then
      AProgramList.Add(AUninstall[I].ProgramName);
    if Pos('Java(TM)', AUninstall[I].ProgramName) <> 0 then
      Java6Exist := True;
  end;
  if Java6Exist then
  begin
    if CheckJava6 then
    begin
      MessageBox(Application.Handle, '系统检测到您机器上安装了Java6以上的版本，'
        + '如果影响到系统的正常运行请先将其卸载再重新启动系统！', '提示',
        MB_OK + MB_ICONINFORMATION + MB_TOPMOST);
      Result := False;
    end;
  end
  else if AProgramList.Count = 0 then
  begin
    MessageBox(Application.Handle, '系统检测到您机器上没有安装Java运行环境，'
      + '请点击 "确定" 安装Java运行环境后再重新运行程序！',
      '提示', MB_OK + MB_ICONINFORMATION + MB_TOPMOST);

    AFilePath := ExtractFilePath(ParamStr(0)) + 'java' + '/'
      + 'jre-1_5_0_14-windows-i586-p.exe';
    if FileExists(AFilePath) then  WinExec(PChar(AFilePath), SW_SHOWNORMAL)
    else
      MessageBox(Application.Handle, '找不到Java安装文件，请您手动安装！',
        '提示', MB_OK + MB_ICONINFORMATION  + MB_TOPMOST);
    Result := False;
  end;
  AProgramList.Free;
end;

{-------------------------------------------------------------
  功能:    窗口自适应屏幕大小
  参数:    Form: 需要调整的Form
           OrgWidth：开发时屏幕的宽度
           OrgHeight：开发时屏幕的高度
--------------------------------------------------------------}
procedure YzAdjustForm(Form: TForm;const OrgWidth, OrgHeight: integer);
begin
  with Form do
  begin
    if (Screen.width <> OrgWidth) then
    begin
      Scaled := True;
      Height := longint(Height) * longint(Screen.height) div OrgHeight;
      Width := longint(Width) * longint(Screen.Width) div OrgWidth;
      ScaleBy(Screen.Width, OrgWidth);
    end;
  end;
end;

{ 设置窗口为当前窗体 }
procedure YzBringMyAppToFront(AppHandle: THandle);
var
  Th1, Th2: Cardinal;
begin
  Th1 := GetCurrentThreadId;
  Th2 := GetWindowThreadProcessId(GetForegroundWindow, NIL);
  AttachThreadInput(Th2, Th1, TRUE);
  try
    SetForegroundWindow(AppHandle);
  finally
    AttachThreadInput(Th2, Th1, TRUE);
  end;
end;

{ 获取文件夹文件数量 }
function YzGetDirFiles(Dir: string;SubDir: Boolean): LongInt;
var
  SearchRec: TSearchRec;
  Founded: integer;
begin
  Result := 0;
  if Dir[length(Dir)] <> '/' then Dir := Dir + '/';
  Founded := FindFirst(Dir + '*.*', faAnyFile, SearchRec);
  while Founded = 0 do
  begin
    Inc(Result);
    if (SearchRec.Attr and faDirectory > 0) and (SearchRec.Name[1] <> '.') and
      (SubDir = True) then
      Inc(Result, YzGetDirFiles(Dir + SearchRec.Name, True));
      Founded := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
end;

{ 算术舍入法的四舍五入取整函数 }
function YzRoundEx (const Value: Real): LongInt;
var
  x: Real;
begin
  x := Value - Trunc(Value);
  if x >= 0.5 then
    Result := Trunc(Value) + 1
  else Result := Trunc(Value);
end;

{ 获取文件大小(KB) }
function YzGetFileSize(const FileName: String): LongInt;
var
  SearchRec: TSearchRec;
begin
  if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
    Result := SearchRec.Size
  else
    Result := -1;
  Result := YzRoundEx(Result / 1024);
end;

{ 获取文件大小(字节) }
function YzGetFileSize_Byte(const FileName: String): LongInt;
var
  SearchRec: TSearchRec;
begin
  if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
    Result := SearchRec.Size
  else
    Result := -1;
end;

{ 获取文件夹大小 }
function YzGetDirSize(Dir: string;SubDir: Boolean): LongInt;
var
  SearchRec: TSearchRec;
  Founded: integer;
begin
  Result := 0;
  if Dir[length(Dir)] <> '/' then Dir := Dir + '/';
  Founded := FindFirst(Dir + '*.*', faAnyFile, SearchRec);
  while Founded = 0 do
  begin
    Inc(Result, SearchRec.size);
    if (SearchRec.Attr and faDirectory > 0) and (SearchRec.Name[1] <> '.') and
      (SubDir = True) then
      Inc(Result, YzGetDirSize(Dir + SearchRec.Name, True));
      Founded := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
  Result := YzRoundEx(Result / 1024);
end;

{-------------------------------------------------------------
  功能:    弹出选择目录对话框
  参数:    const iMode: 选择模式
           const sInfo: 对话框提示信息
  返回值:  如果取消取返回为空，否则返回选中的路径
--------------------------------------------------------------}
function YzSelectDir(const iMode: integer;const sInfo: string): string;
var
  Info: TBrowseInfo;
  IDList: pItemIDList;
  Buffer: PChar;
begin
  Result:='';
  Buffer := StrAlloc(MAX_PATH);
  with Info do
  begin
    hwndOwner := application.mainform.Handle;  { 目录对话框所属的窗口句柄 }
    pidlRoot := nil;                           { 起始位置，缺省为我的电脑 }
    pszDisplayName := Buffer;                  { 用于存放选择目录的指针 }
    lpszTitle := PChar(sInfo);
    { 此处表示显示目录和文件，如果只显示目录则将后一个去掉即可 }
    if iMode = 1 then
      ulFlags := BIF_RETURNONLYFSDIRS or BIF_BROWSEINCLUDEFILES
    else
      ulFlags := BIF_RETURNONLYFSDIRS;
    lpfn := nil;                               { 指定回调函数指针 }
    lParam := 0;                               { 传递给回调函数参数 }
    IDList := SHBrowseForFolder(Info);         { 读取目录信息 }
  end;
  if IDList <> nil then
  begin
    SHGetPathFromIDList(IDList, Buffer);     { 将目录信息转化为路径字符串 }
    Result := strpas(Buffer);
  end;
  StrDispose(buffer);
end;

{ 获取指定路径下文件夹的个数 }
procedure YzListFolders(const Path: String; const ShowPath: Boolean;var List: TStrings);
var
  SRec: TSearchRec;
begin
 if not Assigned(List) then List:= TStringList.Create;
 FindFirst(Path + '*.*', faDirectory, SRec);
 if ShowPath then
    List.Add(Path + SRec.Name)
 else
    List.Add(SRec.Name);
 while FindNext(SRec) = 0 do
    if ShowPath then
       List.Add(Path + SRec.Name)
    else
       List.Add(SRec.Name);
 FindClose(SRec);
end;

{ 禁用窗器控件的所有子控件 }
procedure YzSetSubCtlState(AOwer: TWinControl;AState: Boolean);
var
  I: Integer;
begin
  for I := 0 to AOwer.ControlCount - 1 do
   AOwer.Controls[I].Enabled := AState;
end;

{ 模拟键盘按键操作(处理字节码) }
procedure YzFKeyent(byteCard: byte);
var
  vkkey: integer;
begin
  vkkey := VkKeyScan(chr(byteCard));
  if (chr(byteCard) in ['A'..'Z']) then
  begin
    keybd_event(VK_SHIFT, 0, 0, 0);
    keybd_event(byte(byteCard), 0, 0, 0);
    keybd_event(VK_SHIFT, 0, 2, 0);
  end
  else if chr(byteCard) in ['!', '@', '#', '$', '%', '^', '&', '*', '(', ')',
    '_', '+', '|', '{', '}', ':', '"', '<', '>', '?', '~'] then
  begin
    keybd_event(VK_SHIFT, 0, 0, 0);
    keybd_event(byte(vkkey), 0, 0, 0);
    keybd_event(VK_SHIFT, 0, 2, 0);
  end
  else { if byteCard in [8,13,27,32] }
  begin
    keybd_event(byte(vkkey), 0, 0, 0);
  end;
end;

{ 模拟键盘按键(处理字符) }
procedure YzFKeyent(strCard: string);
var
  str: string;
  strLength: integer;
  I: integer;
  byteSend: byte;
begin
  str := strCard;
  strLength := length(str);
  for I := 1 to strLength do
  begin
    byteSend := byte(str[I]);
    YzFKeyent(byteSend);
  end;
end;

{ 锁定窗口位置 }
procedure YzLockWindow(ClassName,WinName: PChar;poX,poY: Integer);
var
  CurWindow: THandle;
  _wndRect: TRect;
begin
  CurWindow := 0;
  while True do
  begin
    CurWindow := FindWindow(ClassName,WinName);
    if CurWindow <> 0 then Break;
    YzDelayTime(10);
    Application.ProcessMessages;
  end;
  GetWindowRect(CurWindow,_wndRect);
  if ( _wndRect.Left <> poX) or ( _wndRect.Top <> poY) then
  begin
       MoveWindow(CurWindow,
       poX,
       poY,
       (_wndRect.Right-_wndRect.Left),
       (_wndRect.Bottom-_wndRect.Top),
        TRUE);
  end;
  YzDelayTime(1000);
end;

{
  注册一个DLL形式或OCX形式的OLE/COM控件
  参数strOleFileName为一个DLL或OCX文件名，
  参数OleAction表示注册操作类型，1表示注册，0表示卸载
  返回值True表示操作执行成功，False表示操作执行失败
}
function YzRegisterOleFile (strOleFileName: STRING;OleAction: Byte): BOOLEAN;
const
  RegisterOle   =   1; { 注册 }
  UnRegisterOle =   0; { 卸载 }
type
  TOleRegisterFunction = function: HResult; { 注册或卸载函数的原型 }
var
  hLibraryHandle: THandle;    { 由LoadLibrary返回的DLL或OCX句柄 }
  hFunctionAddress: TFarProc; { DLL或OCX中的函数句柄，由GetProcAddress返回 }
  RegFunction: TOleRegisterFunction; { 注册或卸载函数指针 }
begin
  Result := FALSE;
  { 打开OLE/DCOM文件，返回的DLL或OCX句柄 }
  hLibraryHandle := LoadLibrary(PCHAR(strOleFileName));
  if (hLibraryHandle > 0) then        { DLL或OCX句柄正确 }
  try
    { 返回注册或卸载函数的指针 }
    if (OleAction = RegisterOle) then { 返回注册函数的指针 }
      hFunctionAddress := GetProcAddress(hLibraryHandle, pchar('DllRegisterServer'))
    { 返回卸载函数的指针 }
    else
      hFunctionAddress := GetProcAddress(hLibraryHandle, pchar('DllUnregisterServer'));
    if (hFunctionAddress <> NIL) then { 注册或卸载函数存在 }
    begin
      { 获取操作函数的指针 }
      RegFunction := TOleRegisterFunction(hFunctionAddress);
      { 执行注册或卸载操作，返回值>=0表示执行成功 }
      if RegFunction >= 0 then
        Result   :=   true;
    end;
  finally
    { 关闭已打开的OLE/DCOM文件 }
    FreeLibrary(hLibraryHandle);
  end;
end;

function YzListViewColumnCount(mHandle: THandle): Integer;
begin
  Result := Header_GetItemCount(ListView_GetHeader(mHandle));
end; { ListViewColumnCount }

function YzGetListViewText(mHandle: THandle; mStrings: TStrings): Boolean;
var
  vColumnCount: Integer;
  vItemCount: Integer;
  I, J: Integer;
  vBuffer: array[0..255] of Char;
  vProcessId: DWORD;
  vProcess: THandle;
  vPointer: Pointer;
  vNumberOfBytesRead: Cardinal;
  S: string;  vItem: TLVItem;
begin
  Result := False;
  if not Assigned(mStrings) then Exit;
  vColumnCount := YzListViewColumnCount(mHandle);
  if vColumnCount <= 0 then Exit;
  vItemCount := ListView_GetItemCount(mHandle);
  GetWindowThreadProcessId(mHandle, @vProcessId);
  vProcess := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ
    or  PROCESS_VM_WRITE, False, vProcessId);
  vPointer := VirtualAllocEx(vProcess, nil, 4096, MEM_RESERVE or MEM_COMMIT,
    PAGE_READWRITE);
  mStrings.BeginUpdate;
  try
    mStrings.Clear;
    for I := 0 to vItemCount - 1 do
    begin
      S := '';
      for J := 0 to vColumnCount - 1 do
      begin
        with vItem do
        begin
          mask := LVIF_TEXT;
          iItem := I;
          iSubItem := J;
          cchTextMax := SizeOf(vBuffer);
          pszText := Pointer(Cardinal(vPointer) + SizeOf(TLVItem));
        end;
        WriteProcessMemory(vProcess, vPointer, @vItem,
        SizeOf(TLVItem), vNumberOfBytesRead);
        SendMessage(mHandle, LVM_GETITEM, I, lparam(vPointer));
        ReadProcessMemory(vProcess, Pointer(Cardinal(vPointer) + SizeOf(TLVItem)),
          @vBuffer[0], SizeOf(vBuffer), vNumberOfBytesRead);
        S := S + #9 + vBuffer;
      end;
      Delete(S, 1, 1);
      mStrings.Add(S);
    end;
  finally
    VirtualFreeEx(vProcess, vPointer, 0, MEM_RELEASE);
    CloseHandle(vProcess);    mStrings.EndUpdate;
  end;
  Result := True;
end; { GetListViewText }

{ 删除目录树 }
function YzDeleteDirectoryTree(Path: string): boolean;
var
  SearchRec: TSearchRec;
  SFI: string;
begin
  Result := False;
  if (Path = '') or (not DirectoryExists(Path)) then exit;
  if Path[length(Path)] <> '/' then Path := Path + '/';
  SFI := Path + '*.*';
  if FindFirst(SFI, faAnyFile, SearchRec) = 0 then
  begin
    repeat
      begin
        if (SearchRec.Name = '.') or (SearchRec.Name = '..') then
          Continue;
        if (SearchRec.Attr and faDirectory <> 0) then
        begin
          if not YzDeleteDirectoryTree(Path + SearchRec.name) then
            Result := FALSE;
        end
        else
        begin
          FileSetAttr(Path + SearchRec.Name, 128);
          DeleteFile(Path + SearchRec.Name);
        end;
      end
    until FindNext(SearchRec) <> 0;
    FindClose(SearchRec);
  end;
  FileSetAttr(Path, 0);
  if RemoveDir(Path) then
    Result := TRUE
  else
    Result := FALSE;
end;

{ Jpg格式转换为bmp格式 }
function JpgToBmp(Jpg: TJpegImage): TBitmap;
begin
  Result := nil;
  if Assigned(Jpg) then
  begin
    Result := TBitmap.Create;
    Jpg.DIBNeeded;
    Result.Assign(Jpg);
  end;
end;

{ 设置程序自启动函数 }
function YzSetAutoRun(AFilePath: string;AFlag: Boolean): boolean;
var
  AMainFName: string;
  Reg: TRegistry;
begin
  Result := true;
  AMainFName := YzGetMainFileName(AFilePath);
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_LOCAL_MACHINE;
  try
    Reg.OpenKey('SOFTWARE/Microsoft/Windows/CurrentVersion/Run', True);
    if AFlag = False then  { 取消自启动 }
      Reg.DeleteValue(AMainFName)
    else                   { 设置自启动 }
      Reg.WriteString(AMainFName, '"' + AFilePath + '"')
  except
    Result := False;
  end;
  Reg.CloseKey;
  Reg.Free;
end;

{ 检测URL地址是否有效 }
function YzCheckUrl(url: string): Boolean;
var
  hSession, hfile, hRequest: HINTERNET;
  dwindex, dwcodelen: dword;
  dwcode: array[1..20] of Char;
  res: PChar;
begin
  Result := False;
  try
    if Pos('http://',LowerCase(url)) = 0 then url := 'http://' + url;
    { Open an internet session }
    hSession:=InternetOpen('InetURL:/1.0',INTERNET_OPEN_TYPE_PRECONFIG,nil,nil, 0);
    if Assigned(hsession) then
    begin
      hfile := InternetOpenUrl(hsession, PChar(url), nil, 0,INTERNET_FLAG_RELOAD, 0);
      dwIndex := 0;
      dwCodeLen := 10;
      HttpQueryInfo(hfile,HTTP_QUERY_STATUS_CODE,@dwcode,dwcodeLen,dwIndex);
      res := PChar(@dwcode);
      Result := (res = '200') or (res = '302');
      if Assigned(hfile) then InternetCloseHandle(hfile);
      InternetCloseHandle(hsession);
    end;
  except
  end;
end;

{ 获取程序可执行文件名 }
function YzGetExeFName: string;
begin
  Result := ExtractFileName(Application.ExeName);
end;

{ 目录浏览对话框函数 }
function YzBrowseFolder(AOwer: TWinControl;ATitle: string):string;
var
  Info: TBrowseInfo;
  Dir: array[0..260] of char;
  ItemId: PItemIDList;
begin
  with Info do
  begin
    hwndOwner := AOwer.Handle;
    pidlRoot := nil;
    pszDisplayName := nil;
    lpszTitle := PChar(ATitle);
    ulFlags := 0;
    lpfn := nil;
    lParam := 0;
    iImage := 0;
  end;
  ItemId := SHBrowseForFolder(Info);
  SHGetPathFromIDList(ItemId,@Dir);
  Result := string(Dir);
end;

{ 重启计算机 }
function YzShutDownSystem(AFlag: Integer):BOOL;
var
  hProcess,hAccessToken: THandle;
  LUID_AND_ATTRIBUTES: TLUIDAndAttributes;
  TOKEN_PRIVILEGES: TTokenPrivileges;
  BufferIsNull: DWORD;
Const
  SE_SHUTDOWN_NAME='SeShutdownPrivilege';
begin
  hProcess:=GetCurrentProcess();

  OpenProcessToken(hprocess, TOKEN_ADJUST_PRIVILEGES+TOKEN_QUERY, hAccessToken);
  LookupPrivilegeValue(Nil, SE_SHUTDOWN_NAME, LUID_AND_ATTRIBUTES.Luid);
  LUID_AND_ATTRIBUTES.Attributes := SE_PRIVILEGE_ENABLED;
  TOKEN_PRIVILEGES.PrivilegeCount := 1;
  TOKEN_PRIVILEGES.Privileges[0] := LUID_AND_ATTRIBUTES;
  BufferIsNull := 0;

  AdjustTokenPrivileges(hAccessToken, False, TOKEN_PRIVILEGES, sizeof(
    TOKEN_PRIVILEGES) ,Nil, BufferIsNull);
  Result := ExitWindowsEx(AFlag, 0);
end;

{ 程序运行后删除自身 }
procedure YzDeleteSelf;
var
  hModule: THandle;
  buff:    array[0..255] of Char;
  hKernel32: THandle;
  pExitProcess, pDeleteFileA, pUnmapViewOfFile: Pointer;
begin
  hModule := GetModuleHandle(nil);
  GetModuleFileName(hModule, buff, sizeof(buff));

  CloseHandle(THandle(4));

  hKernel32        := GetModuleHandle('KERNEL32');
  pExitProcess     := GetProcAddress(hKernel32, 'ExitProcess');
  pDeleteFileA     := GetProcAddress(hKernel32, 'DeleteFileA');
  pUnmapViewOfFile := GetProcAddress(hKernel32, 'UnmapViewOfFile');

  asm
    LEA         EAX, buff
    PUSH        0
    PUSH        0
    PUSH        EAX
    PUSH        pExitProcess
    PUSH        hModule
    PUSH        pDeleteFileA
    PUSH        pUnmapViewOfFile
    RET
  end;
end;

{ 程序重启 }
procedure YzAppRestart;
var
  AppName : PChar;
begin
  AppName := PChar(Application.ExeName) ;
  ShellExecute(Application.Handle,'open', AppName, nil, nil, SW_SHOWNORMAL);
  KillByPID(GetCurrentProcessId);
end;

{ 压缩Access数据库 }
function YzCompactAccessDB(const AFileName, APassWord: string): Boolean;
var
  SPath, FConStr, TmpConStr: string;
  SFile: array[0..254] of Char;
  STempFileName: string;
  JE: OleVariant;
  function GetTempDir: string;
  var
    Buffer: array[0..MAX_PATH] of Char;
  begin
    ZeroMemory(@Buffer, MAX_PATH);
    GetTempPath(MAX_PATH, Buffer);
    Result := IncludeTrailingBackslash(StrPas(Buffer));
  end;
begin
  Result := False;
  SPath := GetTempDir;  { 取得Windows的Temp路径 }

  { 取得Temp文件名,Windows将自动建立0字节文件 }
  GetTempFileName(PChar(SPath), '~ACP', 0, SFile);
  STempFileName := SFile;

  { 删除Windows建立的0字节文件 }
  if not DeleteFile(STempFileName) then Exit;
  try
    JE := CreateOleObject('JRO.JetEngine');

    { 压缩数据库 }
    FConStr := 'Provider=Microsoft.Jet.OLEDB.4.0;' + 'Data Source=' + AFileName
      + ';Jet OLEDB:DataBase PassWord=' + APassWord;

    TmpConStr := 'Provider=Microsoft.Jet.OLEDB.4.0;' + 'Data Source=' + STempFileName
      + ';Jet OLEDB:DataBase PassWord=' + APassWord;
    JE.CompactDatabase(FConStr, TmpConStr);

    { 覆盖源数据库文件 }
    Result := CopyFile(PChar(STempFileName), PChar(AFileName), False);

    { 删除临时文件 }
    DeleteFile(STempFileName);
  except
    Application.MessageBox('压缩数据库失败！', '提示', MB_OK +
      MB_ICONINFORMATION);
  end;
end;

{ 标题:获取其他进程中TreeView的文本 }
function YzTreeNodeGetNext(mHandle: THandle; mTreeItem: HTreeItem): HTreeItem;
var
  vParentID: HTreeItem;
begin
  Result := nil;
  if (mHandle <> 0) and (mTreeItem <> nil) then
  begin
    Result := TreeView_GetChild(mHandle, mTreeItem);
    if Result = nil then
      Result := TreeView_GetNextSibling(mHandle, mTreeItem);
    vParentID := mTreeItem;
    while (Result = nil) and (vParentID <> nil) do
    begin
      vParentID := TreeView_GetParent(mHandle, vParentID);
      Result := TreeView_GetNextSibling(mHandle, vParentID);
    end;
  end;
end; { TreeNodeGetNext }

function YzTreeNodeGetLevel(mHandle: THandle; mTreeItem: HTreeItem): Integer;
var
  vParentID: HTreeItem;
begin
  Result := -1;
  if (mHandle <> 0) and (mTreeItem <> nil) then
  begin
    vParentID := mTreeItem;
    repeat
      Inc(Result);
      vParentID := TreeView_GetParent(mHandle, vParentID);
    until vParentID = nil;
  end;
end; { TreeNodeGetLevel }

function YzGetTreeViewText(mHandle: THandle; mStrings: TStrings): Boolean;
var
  vItemCount: Integer;
  vBuffer: array[0..255] of Char;
  vProcessId: DWORD;
  vProcess: THandle;
  vPointer: Pointer;
  vNumberOfBytesRead: Cardinal;
  I: Integer;
  vItem: TTVItem;
  vTreeItem: HTreeItem;
begin
  Result := False;
  if not Assigned(mStrings) then Exit;
  GetWindowThreadProcessId(mHandle, @vProcessId);
  vProcess := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or
    PROCESS_VM_WRITE, False, vProcessId);
  vPointer := VirtualAllocEx(vProcess, nil, 4096, MEM_RESERVE or
    MEM_COMMIT, PAGE_READWRITE);
  mStrings.BeginUpdate;
  try
    mStrings.Clear;
    vItemCount := TreeView_GetCount(mHandle);
    vTreeItem := TreeView_GetRoot(mHandle);
    for I := 0 to vItemCount - 1 do
    begin
      with vItem do begin
        mask := TVIF_TEXT; cchTextMax := SizeOf(vBuffer);
        pszText := Pointer(Cardinal(vPointer) + SizeOf(vItem));
        hItem := vTreeItem;
      end;
      WriteProcessMemory(vProcess, vPointer, @vItem, SizeOf(vItem),
        vNumberOfBytesRead);
      SendMessage(mHandle, TVM_GETITEM, 0, lparam(vPointer));
      ReadProcessMemory(vProcess, Pointer(Cardinal(vPointer) + SizeOf(TLVItem)),
      @vBuffer[0], SizeOf(vBuffer), vNumberOfBytesRead);
      mStrings.Add(StringOfChar(#9, YzTreeNodeGetLevel(mHandle, vTreeItem)) + vBuffer);
      vTreeItem := YzTreeNodeGetNext(mHandle, vTreeItem);
    end;
  finally
    VirtualFreeEx(vProcess, vPointer, 0, MEM_RELEASE);
    CloseHandle(vProcess); mStrings.EndUpdate;
  end;
  Result := True;
end; { GetTreeViewText }

{ 获取其他进程中ListBox和ComboBox的内容 }
function YzGetListBoxText(mHandle: THandle; mStrings: TStrings): Boolean;
var
  vItemCount: Integer;
  I: Integer;
  S: string;
begin
  Result := False;
  if not Assigned(mStrings) then Exit;
  mStrings.BeginUpdate;
  try
    mStrings.Clear;
    vItemCount := SendMessage(mHandle, LB_GETCOUNT, 0, 0);
    for I := 0 to vItemCount - 1 do
    begin
      SetLength(S, SendMessage(mHandle, LB_GETTEXTLEN, I, 0));
      SendMessage(mHandle, LB_GETTEXT, I, Integer(@S[1]));
      mStrings.Add(S);
    end;
    SetLength(S, 0);
  finally
    mStrings.EndUpdate;
  end;
  Result := True;
end; { GetListBoxText }

function YzGetComboBoxText(mHandle: THandle; mStrings: TStrings): Boolean;
var
  vItemCount: Integer;
  I: Integer;
  S: string;
begin
  Result := False;
  if not Assigned(mStrings) then Exit;
  mStrings.BeginUpdate;
  try
    mStrings.Clear;
    vItemCount := SendMessage(mHandle, CB_GETCOUNT, 0, 0);
    for I := 0 to vItemCount - 1 do
    begin
      SetLength(S, SendMessage(mHandle, CB_GETLBTEXTLEN, I, 0));
      SendMessage(mHandle, CB_GETLBTEXT, I, Integer(@S[1]));
      mStrings.Add(S);
    end;
    SetLength(S, 0);
  finally
    mStrings.EndUpdate;
  end;
  Result := True;
end; { GetComboBoxText }

{ 获取本地Application Data目录路径 }
function YzLocalAppDataPath : string;
const
   SHGFP_TYPE_CURRENT = 0;
var
   Path: array [0..MAX_PATH] of char;
begin
   SHGetFolderPath(0, CSIDL_LOCAL_APPDATA, 0, SHGFP_TYPE_CURRENT, @path[0]) ;
   Result := Path;
end;

{ 获取Windows当前登录的用户名 }
function YzGetWindwosUserName: String;
var
  pcUser: PChar;
  dwUSize: DWORD;
begin
  dwUSize := 21;
  result  := '';
  GetMem(pcUser, dwUSize);
  try
    if Windows.GetUserName(pcUser, dwUSize) then
      Result := pcUser
  finally
    FreeMem(pcUser);
  end;
end;

{-------------------------------------------------------------
  功  能:  delphi 枚举托盘图标
  参  数:  AFindList: 返回找到的托盘列表信息
  返回值:  成功为True,反之为False
  备  注:  返回的格式为: 位置_名称_窗口句柄_进程ID
--------------------------------------------------------------}
function YzEnumTrayNotifyWnd(AFindList: TStringList;ADestStr: string): BOOL;
var
  wd: HWND;
  wtd: HWND;
  wd1: HWND;
  pid: DWORD;
  hd: THandle;
  num, i: integer;
  n: ULONG;
  p: TTBBUTTON;
  pp: ^TTBBUTTON;
  x: string;
  name: array[0..255] of WCHAR;
  whd, proid: ulong;
  temp: string;
  sp: ^TTBBUTTON;
  _sp: TTBButton;
begin
  Result := False;
  wd := FindWindow('Shell_TrayWnd', nil);
  if (wd = 0) then Exit;

  wtd := FindWindowEx(wd, 0, 'TrayNotifyWnd', nil);
  if (wtd = 0) then Exit;

  wtd := FindWindowEx(wtd, 0, 'SysPager', nil);
  if (wtd = 0) then Exit;

  wd1 := FindWindowEx(wtd, 0, 'ToolbarWindow32', nil);
  if (wd1 = 0) then Exit;

  pid := 0;
  GetWindowThreadProcessId(wd1, @pid);
  if (pid = 0) then Exit;

  hd := OpenProcess(PROCESS_ALL_ACCESS, true, pid);
  if (hd = 0) then Exit;
  num := SendMessage(wd1, TB_BUTTONCOUNT, 0, 0);
  sp := @_sp;
  for i := 0 to num do
  begin
    SendMessage(wd1, TB_GETBUTTON, i, integer(sp));
    pp := @p;
    ReadProcessMemory(hd, sp, pp, sizeof(p), n);
    name[0] := Char(0);
    if (Cardinal(p.iString) <> $FFFFFFFF) then
    begin
      try
        ReadProcessMemory(hd, pointer(p.iString), @name, 255, n);
        name[n] := Char(0);
      except
      end;
      temp := name;
      try
        whd := 0;
        ReadProcessMemory(hd, pointer(p.dwData), @whd, 4, n);
      except
      end;
      proid := 0;
      GetWindowThreadProcessId(whd, @proid);
      AFindList.Add(Format('%d_%s_%x_%x', [i, temp, whd, proid]));
      if CompareStr(temp, ADestStr) = 0 then Result := True;
    end;
  end;
end;

{ 获取SQL Server用户数据库列表 }
procedure YzGetSQLServerDBList(ADBHostIP, ALoginPwd: string;ADBList: TStringList);
var
  PQuery: TADOQuery;
  ConnectStr: string;
begin
  ConnectStr := 'Provider=SQLOLEDB.1;Password=' + ALoginPwd
    + ';Persist Security Info=True;User ID=sa;Initial Catalog=master'
    + ';Data Source=' + ADBHostIP;
  ADBList.Clear;
  PQuery := TADOQuery.Create(nil);
  try
    PQuery.ConnectionString := ConnectStr;
    PQuery.SQL.Text:='select name from sysdatabases where dbid > 6';
    PQuery.Open;
    while not PQuery.Eof do
    begin
      ADBList.add(PQuery.Fields[0].AsString);
      PQuery.Next;
    end;
  finally
    PQuery.Free;
  end;
end;

{ 检测数据库中是否存在给定的表 }
procedure YzGetTableList(ConncetStr: string;ATableList: TStringList);
var
  FConnection: TADOConnection;
begin
  FConnection := TADOConnection.Create(nil);
  try
    FConnection.LoginPrompt := False;
    FConnection.Connected := False;
    FConnection.ConnectionString := ConncetStr;
    FConnection.Connected := True;
    FConnection.GetTableNames(ATableList, False);
  finally
    FConnection.Free;
  end;
end;

{ 将域名解释成IP地址 }
function YzDomainToIP(HostName: string): string;
type
  tAddr = array[0..100] of PInAddr;
  pAddr = ^tAddr;
var
  I: Integer;
  WSA: TWSAData;
  PHE: PHostEnt;
  P: pAddr;
begin
  Result := '';
  WSAStartUp($101, WSA);
  try
    PHE := GetHostByName(pChar(HostName));
    if (PHE <> nil) then
    begin
      P := pAddr(PHE^.h_addr_list);
      I := 0;
      while (P^[I] <> nil) do
      begin
        Result := (inet_nToa(P^[I]^));
        Inc(I);
      end;
    end;
  except
  end;
  WSACleanUp;
end;

{ 移去系统托盘失效图标 }
procedure YzRemoveDeadIcons();
var
  hTrayWindow: HWND;
  rctTrayIcon: TRECT;
  nIconWidth, nIconHeight:integer;
  CursorPos: TPoint;
  nRow, nCol: Integer;
Begin
  //Get tray window handle and bounding rectangle
  hTrayWindow := FindWindowEx(FindWindow('Shell_TrayWnd ', nil), 0, 'TrayNotifyWnd ', nil);
  if Not (GetWindowRect(hTrayWindow, rctTrayIcon)) then Exit;
  //Get small icon metrics
  nIconWidth := GetSystemMetrics(SM_CXSMICON);
  nIconHeight := GetSystemMetrics(SM_CYSMICON);
  //Save current mouse position   }
  GetCursorPos(CursorPos);
  //Sweep the mouse cursor over each icon in the tray in both dimensions
  for nRow := 0 To ((rctTrayIcon.bottom - rctTrayIcon.top) div nIconHeight) Do
  Begin
    for nCol := 0 To ((rctTrayIcon.right - rctTrayIcon.left) div nIconWidth) Do
    Begin
      SetCursorPos(rctTrayIcon.left + nCol * nIconWidth + 5,
        rctTrayIcon.top + nRow * nIconHeight + 5);
      Sleep(0);
    end;
  end;
  //Restore mouse position
  SetCursorPos(CursorPos.x, CursorPos.x);
  //Redraw tray window(to fix bug in multi-line tray area)
  RedrawWindow(hTrayWindow, nil, 0, RDW_INVALIDATE Or RDW_ERASE Or RDW_UPDATENOW);
end;

{ 转移程序占用内存至虚拟内存 }
procedure YzClearMemory;
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    SetProcessWorkingSetSize(GetCurrentProcess, $FFFFFFFF, $FFFFFFFF);
    Application.ProcessMessages;
  end;
end;

{ 检测允许试用的天数是否已到期 }
function YzCheckTrialDays(AllowDays: Integer): Boolean;
var
  Reg_ID, Pre_ID: TDateTime;
  FRegister: TRegistry;
begin
  { 初始化为试用没有到期 }
  Result := True;
  FRegister := TRegistry.Create;
  try
    with FRegister do
    begin
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKey('Software/Microsoft/Windows/CurrentSoftware/'
        + YzGetMainFileName(Application.ExeName), True) then
      begin
        if ValueExists('DateTag') then
        begin
          Reg_ID := ReadDate('DateTag');
          if Reg_ID = 0 then Exit;
          Pre_ID := ReadDate('PreDate');
          { 允许使用的时间到 }
          if ((Reg_ID <> 0) and (Now - Reg_ID > AllowDays)) or
            (Pre_ID <> Reg_ID) or (Reg_ID > Now) then
          begin
            { 防止向前更改日期 }
            WriteDateTime('PreDate', Now + 20000);
            Result := False;
          end;
        end
        else
        begin
          { 首次运行时保存初始化数据 }
          WriteDateTime('PreDate', Now);
          WriteDateTime('DateTag', Now);
        end;
      end;
    end;
  finally
    FRegister.Free;
  end;
end;

{ 指定长度的随机小写字符串函数 }
function YzRandomStr(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);
  Result := LowerCase(Result);
end;

end.

最后修改：2020 年 06 月 17 日

一分也是爱

发表评论取消回复
使用cookie技术保留您的个人信息以便您下次快速评论，继续评论表示您已同意该条款

评论 *

私密评论

名称 *

🎲

邮箱 *

地址 *

自定义Delphi公用函数单元

samool • 2015 年 09 月 07 日

<pre><code>{*******************************************************}
{                                                       }
{             Delphi公用函数单元                        }
{                                                       }
{        版权所有 (C) 2008                           }
{                                                       }
{*******************************************************}
unit YzDelphiFunc;

interface

uses
  ComCtrls, Forms, Windows, Classes, SysUtils, ComObj, ActiveX, ShlObj, Messages,
  Graphics, Registry, Dialogs, Controls, uProcess, uCpuUsage, StrUtils, CommCtrl,
  jpeg, WinInet, ShellAPI, SHFolder, ADODB, WinSock;

{ 保存日志文件 }
procedure YzWriteLogFile(Msg: String);

{ 延时函数,单位为毫秒 }
procedure YzDelayTime(MSecs: Longint);

{ 判断字符串是否为数字 }
function YzStrIsNum(Str: string):boolean;

{ 判断文件是否正在使用 }
function YzIsFileInUse(fName: string): boolean;

{ 删除字符串列表中的空字符串 }
procedure YzDelEmptyChar(AList: TStringList);

{ 删除文件列表中的&quot;Thumbs.db&quot;文件 }
procedure YzDelThumbsFile(AList: TStrings);

{ 返回一个整数指定位数的带&quot;0&quot;字符串 }
function YzIntToZeroStr(Value, ALength: Integer): string;

{ 取日期年份分量 }
function YzGetYear(Date: TDate): Integer;

&lt;!--more--&gt;

{ 取日期月份分量 }
function YzGetMonth(Date: TDate): Integer;

{ 取日期天数分量 }
function YzGetDay(Date: TDate): Integer;

{ 取时间小时分量 }
function YzGetHour(Time: TTime): Integer;

{ 取时间分钟分量 }
function YzGetMinute(Time: TTime): Integer;

{ 取时间秒钟分量 }
function YzGetSecond(Time: TTime): Integer;

{ 返回时间分量字符串 }
function YzGetTimeStr(ATime: TTime;AFlag: string): string;

{ 返回日期时间字符串 }
function YzGetDateTimeStr(ATime: TTime;ADate: TDate): string;

{ 获取计算机名称 }
function YzGetComputerName(): string;

{ 通过窗体子串查找窗体 }
procedure YzFindSpecWindow(ASubTitle: string);

{ 判断进程CPU占用率 }
procedure YzJudgeCPU(ProcessName: string;CPUUsage: Single);

{ 分割字符串 }
procedure YzSeparateTerms(Source: string;Separator: Char;Terms: TStringList);

{ 切换页面控件的活动页面 }
procedure YzGotoNewPage(AOwerPage: TPageControl;ANewPage: TTabSheet);

{ 设置页面控件标签的可见性 }
procedure YzSetTableVisible(PageControl: TPageControl;ShowFlag: Boolean);

{ 根据产品名称获取产品编号 }
function YzGetLevelCode(AName:string;ProductList: TStringList): string;

{ 取文件的主文件名 }
function YzGetMainFileName(AFileName: string): string;

{ 按下一个键 }
procedure YzPressOneKey(AByteCode: Byte);overload;

{ 按下一个指定次数的键 }
procedure YzPressOneKey(AByteCode: Byte;ATimes: Integer);overload;

{ 按下二个键 }
procedure YzPressTwoKeys(AFirstByteCode, ASecByteCode: Byte);

{ 按下三个键 }
procedure YzPressThreeKeys(AFirstByteCode, ASecByteCode, AThirdByteCode: Byte);

{ 创建桌面快捷方式 }
procedure YzCreateShortCut(const sPath: string; sShortCutName: WideString);

{ 删除桌面快捷方式 }
procedure YzDeleteShortCut(sShortCutName: WideString);

{ 通过光标位置进行鼠标左键单击 }
procedure YzMouseLeftClick(X, Y: Integer);overload;

{ 鼠标左键双击 }
procedure YzMouseDoubleClick(X, Y: Integer);

{ 通过窗口句柄进行鼠标左键单击 }
procedure YzMouseLeftClick(lpClassName, lpWindowName: PAnsiChar);overload;

{ 通过光标位置查找窗口句柄 }
function YzWindowFromPoint(X, Y: Integer): THandle;

{ 等待窗口在指定时间后出现 }
function YzWaitWindowExist(lpClassName, lpWindowName: PAnsiChar;
  ASecond: Integer = 0): THandle;overload;

{ 通光标位置,窗口类名与标题查找窗口是否存在 }
function YzWaitWindowExist(X, Y: Integer;AClassName, AWinName: string;
  ASecond: Integer = 0):THandle; overload;

{ 等待指定窗口消失 }
procedure YzWaitWindowClose(lpClassName, lpWindowName: PAnsiChar;
  ASecond: Integer = 0);

{ 通过窗口句柄设置文本框控件文本 }
procedure YzSetEditText(lpClassName, lpWindowName: PAnsiChar;
  AText: string);overload;

{ 通过光标位置设置文本框控件文本 }
procedure YzSetEditText(X, Y: Integer;AText: string);overload;

{ 获取Window操作系统语言 }
function YzGetWindowsLanguageStr: String;

{ 清空动态数组 }
procedure YzDynArraySetZero(var A);

{ 动态设置屏幕分辨率 }
function YzDynamicResolution(X, Y: WORD): Boolean;

{ 检测系统屏幕分辨率 }
function YzCheckDisplayInfo(X, Y: Integer): Boolean;

type
  TFontedControl = class(TControl)
  public
    property Font;
  end;
  TFontMapping = record
    SWidth : Integer;
    SHeight: Integer;
    FName: string;
    FSize: Integer;
  end;

procedure YzFixForm(AForm: TForm);
  procedure YzSetFontMapping;

{---------------------------------------------------
 以下是关于获取系统软件卸载的信息的类型声明和函数
 ----------------------------------------------------}
type
  TUninstallInfo = array of record
    RegProgramName: string;
    ProgramName   : string;
    UninstallPath : string;
    Publisher     : string;
    PublisherURL  : string;
    Version       : string;
    HelpLink      : string;
    UpdateInfoURL : string;
    RegCompany    : string;
    RegOwner      : string;
  end;

{ GetUninstallInfo 返回系统软件卸载的信息 }
function YzGetUninstallInfo : TUninstallInfo;

{ 检测Java安装信息 }
function YzCheckJavaInfo(AUninstallInfo: TUninstallInfo;CheckJava6 : Boolean = False): Boolean;

{ 窗口自适应屏幕大小 }
procedure YzAdjustForm(Form: TForm;const OrgWidth, OrgHeight: integer);

{ 设置窗口为当前窗体 }
procedure YzBringMyAppToFront(AppHandle: THandle);

{ 获取文件夹大小 }
function YzGetDirSize(Dir: string;SubDir: Boolean): LongInt;

{ 获取文件夹文件数量 }
function YzGetDirFiles(Dir: string;SubDir: Boolean): LongInt;

{ 获取文件大小(KB) }
function YzGetFileSize(const FileName: String): LongInt;

{ 获取文件大小(字节) }
function YzGetFileSize_Byte(const FileName: String): LongInt;

{ 算术舍入法的四舍五入取整函数 }
function YzRoundEx (const Value: Real): LongInt;

{ 弹出选择目录对话框 }
function YzSelectDir(const iMode: integer;const sInfo: string): string;

{ 获取指定路径下文件夹的个数 }
procedure YzListFolders(const Path: String; const ShowPath: Boolean;var List: TStrings);

{ 禁用窗器控件的所有子控件 }
procedure YzSetSubCtlState(AOwer: TWinControl;AState: Boolean);

{ 模拟键盘按键操作(处理字节码) }
procedure YzFKeyent(byteCard: byte); overload;

{ 模拟键盘按键操作(处理字符串 }
procedure YzFKeyent(strCard: string); overload;

{ 锁定窗口位置 }
procedure YzLockWindow(ClassName,WinName: PChar;poX,poY: Integer);

function YzListViewColumnCount(mHandle: THandle): Integer;

function YzGetListViewText(mHandle: THandle; mStrings: TStrings): Boolean;

{ 删除目录树 }
function YzDeleteDirectoryTree(Path: string): boolean;

{ Jpg格式转换为bmp格式 }
function JpgToBmp(Jpg: TJpegImage): TBitmap;

{ 设置程序自启动函数 }
function YzSetAutoRun(AFilePath: string;AFlag: Boolean): boolean;

{ 检测URL地址是否有效 }
function YzCheckUrl(url: string): Boolean;

{ 获取程序可执行文件名 }
function YzGetExeFName: string;

{ 目录浏览对话框函数 }
function YzBrowseFolder(AOwer: TWinControl;ATitle: string):string;

{ 重启计算机 }
function YzShutDownSystem(AFlag: Integer):BOOL;

{ 程序运行后删除自身 }
procedure YzDeleteSelf;

{ 程序重启 }
procedure YzAppRestart;

{ 压缩Access数据库 }
function YzCompactAccessDB(const AFileName, APassWord: string): Boolean;

{ 标题:获取其他进程中TreeView的文本 }
function YzTreeNodeGetNext(mHandle: THandle; mTreeItem: HTreeItem): HTreeItem;
function YzTreeNodeGetLevel(mHandle: THandle; mTreeItem: HTreeItem): Integer;
function YzGetTreeViewText(mHandle: THandle; mStrings: TStrings): Boolean;

{ 获取本地Application Data目录路径 }
function YzLocalAppDataPath : string;

{ 获取Windows当前登录的用户名 }
function YzGetWindwosUserName: String;

{枚举托盘图标 }
function YzEnumTrayNotifyWnd(AFindList: TStringList;ADestStr: string): BOOL;

{ 获取SQL Server用户数据库列表 }
procedure YzGetSQLServerDBList(ADBHostIP, ALoginPwd: string;ADBList: TStringList);

{ 读取据库中所有的表 }
procedure YzGetTableList(ConncetStr: string;ATableList: TStringList);

{ 将域名解释成IP地址 }
function YzDomainToIP(HostName: string): string;

{ 等待进程结束 }
procedure YzWaitProcessExit(AProcessName: string);

{ 移去系统托盘失效图标 }
procedure YzRemoveDeadIcons();

{ 转移程序占用内存至虚拟内存 }
procedure YzClearMemory;

{ 检测允许试用的天数是否已到期 }
function YzCheckTrialDays(AllowDays: Integer): Boolean;

{ 指定长度的随机小写字符串函数 }
function YzRandomStr(aLength: Longint): string;

var
  FontMapping : array of TFontMapping;

implementation

uses
  uMain;

{ 保存日志文件 }
procedure YzWriteLogFile(Msg: String);
var
  FileStream: TFileStream;
  LogFile   : String;
begin
  try
    { 每天一个日志文件 }
    Msg := '[' + DateTimeToStr(Now)+ '] '+ Msg;
    LogFile := ExtractFilePath(Application.ExeName) + '/Logs/' + DateToStr(Now) + '.log';
    if not DirectoryExists(ExtractFilePath(LogFile)) then
      CreateDir(ExtractFilePath(LogFile));
    if FileExists(LogFile) then
      FileStream := TFileStream.Create(LogFile, fmOpenWrite or fmShareDenyNone)
    else
      FileStream:=TFileStream.Create(LogFile,fmCreate or fmShareDenyNone);
    FileStream.Position:=FileStream.Size;
    Msg := Msg + #13#10;
    FileStream.Write(PChar(Msg)^, Length(Msg));
    FileStream.Free;
  except
  end;
end;

{ 延时函数,单位为毫秒 }
procedure YZDelayTime(MSecs: Longint);
var
  FirstTickCount, Now: Longint;
begin
  FirstTickCount := GetTickCount();
  repeat
    Application.ProcessMessages;
    Now := GetTickCount();
  until (Now - FirstTickCount&gt;=MSecs) or (Now &lt; FirstTickCount);
end;

{ 判断字符串是否为数字 }
function YzStrIsNum(Str: string):boolean;
var
  I: integer;
begin
  if Str = '' then
  begin
    Result := False;
    Exit;
  end;
  for I:=1 to length(str) do
    if not (Str[I] in ['0'..'9']) then
    begin
      Result := False;
      Exit;
    end;
  Result := True;
end;

{ 判断文件是否正在使用 }
function YzIsFileInUse(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;

{ 删除字符串列表中的空字符串 }
procedure YzDelEmptyChar(AList: TStringList);
var
  I: Integer;
  TmpList: TStringList;
begin
  TmpList := TStringList.Create;
  for I := 0 to AList.Count - 1 do
    if AList.Strings[I] &lt;&gt; '' then TmpList.Add(AList.Strings[I]);
  AList.Clear;
  AList.Text := TmpList.Text;
  TmpList.Free;
end;

{ 删除文件列表中的&quot;Thumbs.db&quot;文件 }
procedure YzDelThumbsFile(AList: TStrings);
var
  I: Integer;
  TmpList: TStringList;
begin
  TmpList := TStringList.Create;
  for I := 0 to AList.Count - 1 do
    if ExtractFileName(AList.Strings[I]) &lt;&gt; 'Thumbs.db' then
      TmpList.Add(AList.Strings[I]);
  AList.Clear;
  AList.Text := TmpList.Text;
  TmpList.Free;
end;

{-------------------------------------------------------------
  功能:    返回一个整数指定位数的带&quot;0&quot;字符串
  参数:    Value:要转换的整数 ALength:字符串长度
  返回值:  string
--------------------------------------------------------------}
function YzIntToZeroStr(Value, ALength: Integer): string;
var
  I, ACount: Integer;
begin
  Result := '';
  ACount := Length(IntToStr(Value));
  if ACount &gt;= ALength then Result := IntToStr(Value)
  else
  begin
    for I := 1 to ALength-ACount do
      Result := Result + '0';
    Result := Result + IntToStr(Value)
  end;
end;

{ 取日期年份分量 }
function YzGetYear(Date: TDate): Integer;
var
  y, m, d: WORD;
begin
  DecodeDate(Date, y, m, d);
  Result := y;
end;

{ 取日期月份分量 }
function YzGetMonth(Date: TDate): Integer;
var
  y, m, d: WORD;
begin
  DecodeDate(Date, y, m, d);
  Result := m;
end;

{ 取日期天数分量 }
function YzGetDay(Date: TDate): Integer;
var
  y, m, d: WORD;
begin
  DecodeDate(Date, y, m, d);
  Result := d;
end;

{ 取时间小时分量 }
function YzGetHour(Time: TTime): Integer;
var
  h, m, s, ms: WORD;
begin
  DecodeTime(Time, h, m, s, ms);
  Result := h;
end;

{ 取时间分钟分量 }
function YzGetMinute(Time: TTime): Integer;
var
  h, m, s, ms: WORD;
begin
  DecodeTime(Time, h, m, s, ms);
  Result := m;
end;

{ 取时间秒钟分量 }
function YzGetSecond(Time: TTime): Integer;
var
  h, m, s, ms: WORD;
begin
  DecodeTime(Time, h, m, s, ms);
  Result := s;
end;

{ 返回时间分量字符串 }
function YzGetTimeStr(ATime: TTime;AFlag: string): string;
var
  wTimeStr: string;
  FH, FM, FS, FMS: WORD;
const
  HOURTYPE    = 'Hour';
  MINUTETYPE  = 'Minute';
  SECONDTYPE  = 'Second';
  MSECONDTYPE = 'MSecond';
begin
  wTimeStr := TimeToStr(ATime);
  if Pos('上午', wTimeStr) &lt;&gt; 0 then
    wTimeStr := Copy(wTimeStr, Pos('上午', wTimeStr) + 4, 10)
  else if Pos('下午', wTimeStr) &lt;&gt; 0 then
    wTimeStr := Copy(wTimeStr, Pos('下午', wTimeStr) + 4, 10);
  DecodeTime(ATime, FH, FM, FS, FMS);
  if AFlag = HOURTYPE then
  begin
    { 如果是12小时制则下午的小时分量加12 }
    if Pos('下午', wTimeStr) &lt;&gt; 0 then
      Result := YzIntToZeroStr(FH + 12, 2)
    else
      Result := YzIntToZeroStr(FH, 2);
  end;
  if AFlag = MINUTETYPE  then Result := YzIntToZeroStr(FM, 2);
  if AFlag = SECONDTYPE  then Result := YzIntToZeroStr(FS, 2);
  if AFlag = MSECONDTYPE then Result := YzIntToZeroStr(FMS, 2);
end;

{ 返回日期时间字符串 }
function YzGetDateTimeStr(ATime: TTime;ADate: TDate): string;
var
  wYear, wMonth, wDay: string;
  wHour, wMinute, wSecond: string;
begin
  wYear := RightStr(YzIntToZeroStr(YzGetYear(ADate), 4), 2);
  wMonth := YzIntToZeroStr(YzGetMonth(ADate), 2);
  wDay := YzIntToZeroStr(YzGetDay(ADate), 2);

wHour := YzGetTimeStr(ATime, 'Hour');
  wMinute := YzGetTimeStr(ATime, 'Minute');
  wSecond := YzGetTimeStr(ATime, 'Second');

Result := wYear + wMonth + wDay + wHour + wMinute + wSecond;
end;

{ 通过窗体子串查找窗体 }
procedure YzFindSpecWindow(ASubTitle: string);

function EnumWndProc(AWnd: THandle;AWinName: string): Boolean;stdcall;
  var
    WindowText: array[0..255] of Char;
    WindowStr: string;
  begin
    GetWindowText(AWnd, WindowText, 255);
    WindowStr := StrPas(WindowText);
    WindowStr := COPY(WindowStr, 1, StrLen(PChar(AWinName)));
    if CompareText(AWinName, WindowStr) = 0 then
    begin
      SetForegroundWindow(AWnd);
      Result := False; Exit;
    end;
    Result := True;
  end;

begin
  EnumWindows(@EnumWndProc, LongInt(@ASubTitle));
  YzDelayTime(1000);
end;

{ 获取计算机名称 }
function YzGetComputerName(): string;
var
  pcComputer: PChar;
  dwCSize: DWORD;
begin
  dwCSize := MAX_COMPUTERNAME_LENGTH + 1;
  Result := '';
  GetMem(pcComputer, dwCSize);
  try
    if Windows.GetComputerName(pcComputer, dwCSize) then
      Result := pcComputer;
  finally
    FreeMem(pcComputer);
  end;
end;

{ 判断进程CPU占用率 }
procedure YzJudgeCPU(ProcessName: string;CPUUsage: Single);
var
  cnt: PCPUUsageData;
  usage: Single;
begin
  cnt := wsCreateUsageCounter(FindProcess(ProcessName));
  while True do
  begin
    usage := wsGetCpuUsage(cnt);
    if usage &lt;= CPUUsage then
    begin
      wsDestroyUsageCounter(cnt);
      YzDelayTime(2000);
      Break;
    end;
    YzDelayTime(10);
    Application.ProcessMessages;
  end;
end;

{ 分割字符串 }
procedure YzSeparateTerms(Source: string;Separator: Char;Terms: TStringList);
var
  TmpStr: string;
  PO: integer;
begin
  Terms.Clear;
  if Length(Source) = 0 then Exit;   { 长度为0则退出 }
  PO := Pos(Separator, Source);
  if PO = 0 then
  begin
    Terms.Add(Source);
    Exit;
  end;
  while PO &lt;&gt; 0 do
  begin
    TmpStr := Copy(Source, 1, PO - 1);{ 复制字符 }
    Terms.Add(TmpStr);                { 添加到列表 }
    Delete(Source, 1, PO);            { 删除字符和分割符 }
    PO := Pos(Separator, Source);     { 查找分割符 }
  end;
  if Length(Source) &gt; 0 then
    Terms.Add(Source);                { 添加剩下的条目 }
end;

{ 切换页面控件的活动页面 }
procedure YzGotoNewPage(AOwerPage: TPageControl;ANewPage: TTabSheet);
begin
  if AOwerPage.ActivePage &lt;&gt; ANewPage then AOwerPage.ActivePage := ANewPage;
end;

{ 设置页面控件标签的可见性 }
procedure YzSetTableVisible(PageControl: TPageControl;ShowFlag: Boolean);
var
  I: Integer;
begin
  for I := 0 to PageControl.PageCount -1 do
    PageControl.Pages[I].TabVisible := ShowFlag;
end;

{ 根据产品名称获取产品编号 }
function YZGetLevelCode(AName:string;ProductList: TStringList): string;
var
  I: Integer;
  TmpStr: string;
begin
  Result := '';
  if ProductList.Count &lt;= 0 then Exit;
  for I := 0 to ProductList.Count-1 do
  begin
    TmpStr := ProductList.Strings[I];
    if AName = Copy(TmpStr,1, Pos('_', TmpStr)-1) then
    begin
      Result := Copy(TmpStr, Pos('_', TmpStr)+1, 10);
      Break;
    end;
  end;
end;

{ 取文件的主文件名 }
function YzGetMainFileName(AFileName:string): string;
var
  TmpStr: string;
begin
  if AFileName = '' then Exit;
  TmpStr := ExtractFileName(AFileName);
  Result := Copy(TmpStr, 1, Pos('.', TmpStr) - 1);
end;

{ 按下一个键 }
procedure YzPressOneKey(AByteCode: Byte);
begin
  keybd_event(AByteCode, 0, 0, 0);
  YzDelayTime(100);
  keybd_event(AByteCode, 0, KEYEVENTF_KEYUP, 0);
  YzDelayTime(400);
end;

{ 按下一个指定次数的键 }
procedure YzPressOneKey(AByteCode: Byte;ATimes: Integer);overload;
var
  I: Integer;
begin
  for I := 1 to ATimes do
  begin
    keybd_event(AByteCode, 0, 0, 0);
    YzDelayTime(10);
    keybd_event(AByteCode, 0, KEYEVENTF_KEYUP, 0);
    YzDelayTime(150);
  end;
end;

{ 按下二个键 }
procedure YzPressTwoKeys(AFirstByteCode, ASecByteCode: Byte);
begin
  keybd_event(AFirstByteCode, 0, 0, 0);
  keybd_event(ASecByteCode, 0, 0, 0);
  YzDelayTime(100);
  keybd_event(ASecByteCode, 0, KEYEVENTF_KEYUP, 0);
  keybd_event(AFirstByteCode, 0, KEYEVENTF_KEYUP, 0);
  YzDelayTime(400);
end;

{ 按下三个键 }
procedure YzPressThreeKeys(AFirstByteCode, ASecByteCode, AThirdByteCode: Byte);
begin
  keybd_event(AFirstByteCode, 0, 0, 0);
  keybd_event(ASecByteCode, 0, 0, 0);
  keybd_event(AThirdByteCode, 0, 0, 0);
  YzDelayTime(100);
  keybd_event(AThirdByteCode, 0, KEYEVENTF_KEYUP, 0);
  keybd_event(ASecByteCode, 0, KEYEVENTF_KEYUP, 0);
  keybd_event(AFirstByteCode, 0, KEYEVENTF_KEYUP, 0);
  YzDelayTime(400);
end;

{ 创建桌面快捷方式 }
procedure YzCreateShortCut(const sPath: string; sShortCutName: WideString);
var
  tmpObject: IUnknown;
  tmpSLink: IShellLink;
  tmpPFile: IPersistFile;
  PIDL: PItemIDList;
  StartupDirectory: array[0..MAX_PATH] of Char;
  StartupFilename: String;
  LinkFilename: WideString;
begin
  StartupFilename := sPath;
  tmpObject := CreateComObject(CLSID_ShellLink); { 创建建立快捷方式的外壳扩展 }
  tmpSLink := tmpObject as IShellLink;           { 取得接口 }
  tmpPFile := tmpObject as IPersistFile;         { 用来储存*.lnk文件的接口 }
  tmpSLink.SetPath(pChar(StartupFilename));      { 设定notepad.exe所在路径 }
  tmpSLink.SetWorkingDirectory(pChar(ExtractFilePath(StartupFilename))); {设定工作目录 }
  SHGetSpecialFolderLocation(0, CSIDL_DESKTOPDIRECTORY, PIDL); { 获得桌面的Itemidlist }
  SHGetPathFromIDList(PIDL, StartupDirectory);   { 获得桌面路径 }
  sShortCutName := '/' + sShortCutName + '.lnk';
  LinkFilename := StartupDirectory + sShortCutName;
  tmpPFile.Save(pWChar(LinkFilename), FALSE);    { 保存*.lnk文件 }
end;

{ 删除桌面快捷方式 }
procedure YzDeleteShortCut(sShortCutName: WideString);
var
  PIDL : PItemIDList;
  StartupDirectory: array[0..MAX_PATH] of Char;
  LinkFilename: WideString;
begin
  SHGetSpecialFolderLocation(0,CSIDL_DESKTOPDIRECTORY,PIDL);
  SHGetPathFromIDList(PIDL,StartupDirectory);
  LinkFilename := StrPas(StartupDirectory) + '/' + sShortCutName + '.lnk';
  DeleteFile(LinkFilename);
end;

{ 通过光标位置进行鼠标左键单击 }
procedure YzMouseLeftClick(X, Y: Integer);
begin
  SetCursorPos(X, Y);
  YzDelayTime(100);
  mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
  mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
  YzDelayTime(400);
end;

{ 鼠标左键双击 }
procedure YzMouseDoubleClick(X, Y: Integer);
begin
  SetCursorPos(X, Y);
  YzDelayTime(100);
  mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
  mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
  YzDelayTime(100);
  mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
  mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
  YzDelayTime(400);
end;

{ 通过窗口句柄进行鼠标左键单击 }
procedure YzMouseLeftClick(lpClassName, lpWindowName: PAnsiChar);overload;
var
  AHandel: THandle;
begin
  AHandel := FindWindow(lpClassName, lpWindowName);
  SendMessage(AHandel, WM_LBUTTONDOWN, 0, 0);
  SendMessage(AHandel, WM_LBUTTONUP, 0, 0);
  YzDelayTime(500);
end;

{ 等待进程结束 }
procedure YzWaitProcessExit(AProcessName: string);
begin
  while True do
  begin
    KillByPID(FindProcess(AProcessName));
    if FindProcess(AProcessName) = 0 then Break;
    YzDelayTime(10);
    Application.ProcessMessages;
  end;
end;

{-------------------------------------------------------------
  功  能:  等待窗口在指定时间后出现
  参  数:  lpClassName: 窗口类名
           lpWindowName: 窗口标题
           ASecond: 要等待的时间,&quot;0&quot;代表永久等待
  返回值:  无
  备  注:  如果指定的等待时间未到窗口已出现则立即退出
--------------------------------------------------------------}
function YzWaitWindowExist(lpClassName, lpWindowName: PAnsiChar;
  ASecond: Integer = 0): THandle;overload;
var
  StartTickCount, PassTickCount: LongWord;
begin
  Result := 0;
  { 永久等待 }
  if ASecond = 0 then
  begin
    while True do
    begin
      Result := FindWindow(lpClassName, lpWindowName);
      if Result &lt;&gt; 0 then Break;
      YzDelayTime(10);
      Application.ProcessMessages;
    end;
  end
  else { 等待指定时间 }
  begin
    StartTickCount := GetTickCount;
    while True do
    begin
      Result := FindWindow(lpClassName, lpWindowName);
      { 窗口已出现则立即退出 }
      if Result &lt;&gt; 0 then Break
      else
      begin
        PassTickCount := GetTickCount;
        { 等待时间已到则退出 }
        if (PassTickCount - StartTickCount) div 1000 &gt;= ASecond then Break;
      end;
      YzDelayTime(10);
      Application.ProcessMessages;
    end;
  end;
  YzDelayTime(1000);
end;

{ 等待指定窗口消失 }
procedure YzWaitWindowClose(lpClassName, lpWindowName: PAnsiChar;
  ASecond: Integer = 0);
var
  StartTickCount, PassTickCount: LongWord;
begin
  if ASecond = 0 then
  begin
    while True do
    begin
      if FindWindow(lpClassName, lpWindowName) = 0 then Break;
      YzDelayTime(10);
      Application.ProcessMessages;
    end
  end
  else
  begin
    StartTickCount := GetTickCount;
    while True do
    begin
      { 窗口已关闭则立即退出 }
      if FindWindow(lpClassName, lpWindowName)= 0 then Break
      else
      begin
        PassTickCount := GetTickCount;
        { 等待时间已到则退出 }
        if (PassTickCount - StartTickCount) div 1000 &gt;= ASecond then Break;
      end;
      YzDelayTime(10);
      Application.ProcessMessages;
    end;
  end;
  YzDelayTime(500);
end;

{ 通过光标位置查找窗口句柄 }
function YzWindowFromPoint(X, Y: Integer): THandle;
var
  MousePoint: TPoint;
  CurWindow: THandle;
  hRect: TRect;
  Canvas: TCanvas;
begin
  MousePoint.X := X;
  MousePoint.Y := Y;
  CurWindow := WindowFromPoint(MousePoint);
  GetWindowRect(Curwindow, hRect);
  if Curwindow &lt;&gt; 0 then
  begin
    Canvas := TCanvas.Create;
    Canvas.Handle := GetWindowDC(Curwindow);
    Canvas.Pen.Width := 2;
    Canvas.Pen.Color := clRed;
    Canvas.Pen.Mode := pmNotXor;
    Canvas.Brush.Style := bsClear;
    Canvas.Rectangle(0, 0, hRect.Right-hRect.Left, hRect.Bottom-hRect.Top);
    Canvas.Free;
  end;
  Result := CurWindow;
end;

{ 通光标位置,窗口类名与标题查找窗口是否存在 }
function YzWaitWindowExist(X, Y: Integer;AClassName, AWinName: string;
  ASecond: Integer):THandle;overload;
var
  MousePo: TPoint;
  CurWindow: THandle;
  bufClassName: array[0..MAXBYTE-1] of Char;
  bufWinName: array[0..MAXBYTE-1] of Char;
  StartTickCount, PassTickCount: LongWord;
begin
  Result := 0;
  { 永久等待 }
  if ASecond = 0 then
  begin
    while True do
    begin
      MousePo.X := X;
      MousePo.Y := Y;
      CurWindow := WindowFromPoint(MousePo);
      GetClassName(CurWindow, bufClassName, MAXBYTE);
      GetWindowText(CurWindow, bufWinname, MAXBYTE);
      if (CompareText(StrPas(bufClassName), AClassName) = 0 ) and
         (CompareText(StrPas(bufWinName), AWinName) = 0) then
      begin
        Result := CurWindow;
        Break;
      end;
      YzDelayTime(10);
      Application.ProcessMessages;
    end;
  end
  else { 等待指定时间 }
  begin
    StartTickCount := GetTickCount;
    while True do
    begin
      { 窗口已出现则立即退出 }
      MousePo.X := X;
      MousePo.Y := Y;
      CurWindow := WindowFromPoint(MousePo);
      GetClassName(CurWindow, bufClassName, MAXBYTE);
      GetWindowText(CurWindow, bufWinname, MAXBYTE);
      if (CompareText(StrPas(bufClassName), AClassName) = 0 ) and
         (CompareText(StrPas(bufWinName), AWinName) = 0) then
      begin
        Result := CurWindow; Break;
      end
      else
      begin
        PassTickCount := GetTickCount;
        { 等待时间已到则退出 }
        if (PassTickCount - StartTickCount) div 1000 &gt;= ASecond then Break;
      end;
      YzDelayTime(10);
      Application.ProcessMessages;
    end;
  end;
  YzDelayTime(1000);
end;

{ 通过窗口句柄设置文本框控件文本 }
procedure YzSetEditText(lpClassName, lpWindowName: PAnsiChar;
  AText: string);overload;
var
  CurWindow: THandle;
begin
  CurWindow := FindWindow(lpClassName, lpWindowName);
  SendMessage(CurWindow ,WM_SETTEXT, 0, Integer(PChar(AText)));
  YzDelayTime(500);
end;

{ 通过光标位置设置文本框控件文本 }
procedure YzSetEditText(X, Y: Integer;AText: string);overload;
var
  CurWindow: THandle;
begin
  CurWindow := YzWindowFromPoint(X, Y);
  SendMessage(CurWindow, WM_SETTEXT, 0, Integer(PChar(AText)));
  YzMouseLeftClick(X, Y);
end;

{ 获取Window操作系统语言 }
function YzGetWindowsLanguageStr: String;
var
  WinLanguage: array [0..50] of char;
begin
  VerLanguageName(GetSystemDefaultLangID, WinLanguage, 50);
  Result := StrPas(WinLanguage);
end;

procedure YzDynArraySetZero(var A);
var
  P: PLongint;  { 4个字节 }
begin
  P := PLongint(A); { 指向 A 的地址 }
  Dec(P);  { P地址偏移量是 sizeof(A),指向了数组长度 }
  P^ := 0; { 数组长度清空 }
  Dec(P);  { 指向数组引用计数 }
  P^ := 0; { 数组计数清空 }
end;

{ 动态设置分辨率 }
function YzDynamicResolution(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 YzSetFontMapping;
begin
  SetLength(FontMapping, 3);

{ 800 x 600 }
  FontMapping[0].SWidth := 800;
  FontMapping[0].SHeight := 600;
  FontMapping[0].FName := '宋体';
  FontMapping[0].FSize := 7;

{ 1024 x 768 }
  FontMapping[1].SWidth := 1024;
  FontMapping[1].SHeight := 768;
  FontMapping[1].FName := '宋体';
  FontMapping[1].FSize := 9;

{ 1280 x 1024 }
  FontMapping[2].SWidth := 1280;
  FontMapping[2].SHeight := 1024;
  FontMapping[2].FName := '宋体';
  FontMapping[2].FSize := 11;
end;

{ 程序窗体及控件自适应分辨率(有问题) }
procedure YzFixForm(AForm: TForm);
var
  I, J: integer;
  T: TControl;
begin
  with AForm do
  begin
    for I := 0 to ComponentCount - 1 do
    begin
      try
        T := TControl(Components[I]);
        T.left := Trunc(T.left * (Screen.width / 1024));
        T.top := Trunc(T.Top * (Screen.Height / 768));
        T.Width := Trunc(T.Width * (Screen.Width / 1024));
        T.Height := Trunc(T.Height * (Screen.Height / 768));
      except
      end; { try }
    end; { for I }

for I:= 0 to Length(FontMapping) - 1 do
    begin
      if (Screen.Width = FontMapping[I].SWidth) and (Screen.Height =
        FontMapping[I].SHeight) then
      begin
        for J := 0 to ComponentCount - 1 do
        begin
          try
            TFontedControl(Components[J]).Font.Name := FontMapping[I].FName;
            TFontedControl(Components[J]).FONT.Size := FontMapping[I].FSize;
          except
          end; { try }
        end; { for J }
      end; { if }
    end; { for I }
  end; { with }
end;

{ 检测系统屏幕分辨率 }
function YzCheckDisplayInfo(X, Y: Integer): Boolean;
begin
  Result := True;
  if (Screen.Width &lt;&gt; X) and (Screen.Height &lt;&gt; Y) then
  begin
    if MessageBox(Application.Handle, PChar( '系统检测到您的屏幕分辨率不是 '
      + IntToStr(X) + '×' + IntToStr(Y) + '，这将影响到系统的正常运行，'
      + '是否要自动调整屏幕分辨率？'), '提示', MB_YESNO + MB_ICONQUESTION
      + MB_TOPMOST) = 6 then YzDynamicResolution(1024, 768)
    else Result := False;
  end;
end;

function YzGetUninstallInfo: TUninstallInfo;
const
  Key = '/SOFTWARE/Microsoft/Windows/CurrentVersion/Uninstall/';
var
  S : TStrings;
  I : Integer;
  J : Integer;
begin
  with TRegistry.Create do
  begin
    S := TStringlist.Create;
    J := 0;
    try
      RootKey:= HKEY_LOCAL_MACHINE;
      OpenKeyReadOnly(Key);
      GetKeyNames(S);
      Setlength(Result, S.Count);
      for I:= 0 to S.Count - 1 do
      begin
        If OpenKeyReadOnly(Key + S[I]) then
        If ValueExists('DisplayName') and ValueExists('UninstallString') then
        begin
          Result[J].RegProgramName:= S[I];
          Result[J].ProgramName:= ReadString('DisplayName');
          Result[J].UninstallPath:= ReadString('UninstallString');
          If ValueExists('Publisher') then
            Result[J].Publisher:= ReadString('Publisher');
          If ValueExists('URLInfoAbout') then
            Result[J].PublisherURL:= ReadString('URLInfoAbout');
          If ValueExists('DisplayVersion') then
            Result[J].Version:= ReadString('DisplayVersion');
          If ValueExists('HelpLink') then
            Result[J].HelpLink:= ReadString('HelpLink');
          If ValueExists('URLUpdateInfo') then
            Result[J].UpdateInfoURL:= ReadString('URLUpdateInfo');
          If ValueExists('RegCompany') then
            Result[J].RegCompany:= ReadString('RegCompany');
          If ValueExists('RegOwner') then
            Result[J].RegOwner:= ReadString('RegOwner');
          Inc(J);
        end;
      end;
    finally
      Free;
      S.Free;
      SetLength(Result, J);
    end;
  end;
end;

{ 检测Java安装信息 }
function YzCheckJavaInfo(AUninstallInfo: TUninstallInfo;CheckJava6 : Boolean = False): Boolean;
var
  I: Integer;
  Java6Exist: Boolean;
  AUninstall: TUninstallInfo;
  AProgramList: TStringList;
  AJavaVersion, AFilePath: string;
begin
  Result := True;
  Java6Exist := False;
  AJavaVersion := 'J2SE Runtime Environment 5.0 Update 14';
  AUninstall := YzGetUninstallInfo;
  AProgramList := TStringList.Create;
  for I := Low(AUninstall) to High(AUninstall) do
  begin
    if Pos('J2SE', AUninstall[I].ProgramName) &lt;&gt; 0 then
      AProgramList.Add(AUninstall[I].ProgramName);
    if Pos('Java(TM)', AUninstall[I].ProgramName) &lt;&gt; 0 then
      Java6Exist := True;
  end;
  if Java6Exist then
  begin
    if CheckJava6 then
    begin
      MessageBox(Application.Handle, '系统检测到您机器上安装了Java6以上的版本，'
        + '如果影响到系统的正常运行请先将其卸载再重新启动系统！', '提示',
        MB_OK + MB_ICONINFORMATION + MB_TOPMOST);
      Result := False;
    end;
  end
  else if AProgramList.Count = 0 then
  begin
    MessageBox(Application.Handle, '系统检测到您机器上没有安装Java运行环境，'
      + '请点击 &quot;确定&quot; 安装Java运行环境后再重新运行程序！',
      '提示', MB_OK + MB_ICONINFORMATION + MB_TOPMOST);

AFilePath := ExtractFilePath(ParamStr(0)) + 'java' + '/'
      + 'jre-1_5_0_14-windows-i586-p.exe';
    if FileExists(AFilePath) then  WinExec(PChar(AFilePath), SW_SHOWNORMAL)
    else
      MessageBox(Application.Handle, '找不到Java安装文件，请您手动安装！',
        '提示', MB_OK + MB_ICONINFORMATION  + MB_TOPMOST);
    Result := False;
  end;
  AProgramList.Free;
end;

{-------------------------------------------------------------
  功能:    窗口自适应屏幕大小
  参数:    Form: 需要调整的Form
           OrgWidth：开发时屏幕的宽度
           OrgHeight：开发时屏幕的高度
--------------------------------------------------------------}
procedure YzAdjustForm(Form: TForm;const OrgWidth, OrgHeight: integer);
begin
  with Form do
  begin
    if (Screen.width &lt;&gt; OrgWidth) then
    begin
      Scaled := True;
      Height := longint(Height) * longint(Screen.height) div OrgHeight;
      Width := longint(Width) * longint(Screen.Width) div OrgWidth;
      ScaleBy(Screen.Width, OrgWidth);
    end;
  end;
end;

{ 设置窗口为当前窗体 }
procedure YzBringMyAppToFront(AppHandle: THandle);
var
  Th1, Th2: Cardinal;
begin
  Th1 := GetCurrentThreadId;
  Th2 := GetWindowThreadProcessId(GetForegroundWindow, NIL);
  AttachThreadInput(Th2, Th1, TRUE);
  try
    SetForegroundWindow(AppHandle);
  finally
    AttachThreadInput(Th2, Th1, TRUE);
  end;
end;

{ 获取文件夹文件数量 }
function YzGetDirFiles(Dir: string;SubDir: Boolean): LongInt;
var
  SearchRec: TSearchRec;
  Founded: integer;
begin
  Result := 0;
  if Dir[length(Dir)] &lt;&gt; '/' then Dir := Dir + '/';
  Founded := FindFirst(Dir + '*.*', faAnyFile, SearchRec);
  while Founded = 0 do
  begin
    Inc(Result);
    if (SearchRec.Attr and faDirectory &gt; 0) and (SearchRec.Name[1] &lt;&gt; '.') and
      (SubDir = True) then
      Inc(Result, YzGetDirFiles(Dir + SearchRec.Name, True));
      Founded := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
end;

{ 算术舍入法的四舍五入取整函数 }
function YzRoundEx (const Value: Real): LongInt;
var
  x: Real;
begin
  x := Value - Trunc(Value);
  if x &gt;= 0.5 then
    Result := Trunc(Value) + 1
  else Result := Trunc(Value);
end;

{ 获取文件大小(KB) }
function YzGetFileSize(const FileName: String): LongInt;
var
  SearchRec: TSearchRec;
begin
  if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
    Result := SearchRec.Size
  else
    Result := -1;
  Result := YzRoundEx(Result / 1024);
end;

{ 获取文件大小(字节) }
function YzGetFileSize_Byte(const FileName: String): LongInt;
var
  SearchRec: TSearchRec;
begin
  if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
    Result := SearchRec.Size
  else
    Result := -1;
end;

{ 获取文件夹大小 }
function YzGetDirSize(Dir: string;SubDir: Boolean): LongInt;
var
  SearchRec: TSearchRec;
  Founded: integer;
begin
  Result := 0;
  if Dir[length(Dir)] &lt;&gt; '/' then Dir := Dir + '/';
  Founded := FindFirst(Dir + '*.*', faAnyFile, SearchRec);
  while Founded = 0 do
  begin
    Inc(Result, SearchRec.size);
    if (SearchRec.Attr and faDirectory &gt; 0) and (SearchRec.Name[1] &lt;&gt; '.') and
      (SubDir = True) then
      Inc(Result, YzGetDirSize(Dir + SearchRec.Name, True));
      Founded := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
  Result := YzRoundEx(Result / 1024);
end;

{-------------------------------------------------------------
  功能:    弹出选择目录对话框
  参数:    const iMode: 选择模式
           const sInfo: 对话框提示信息
  返回值:  如果取消取返回为空，否则返回选中的路径
--------------------------------------------------------------}
function YzSelectDir(const iMode: integer;const sInfo: string): string;
var
  Info: TBrowseInfo;
  IDList: pItemIDList;
  Buffer: PChar;
begin
  Result:='';
  Buffer := StrAlloc(MAX_PATH);
  with Info do
  begin
    hwndOwner := application.mainform.Handle;  { 目录对话框所属的窗口句柄 }
    pidlRoot := nil;                           { 起始位置，缺省为我的电脑 }
    pszDisplayName := Buffer;                  { 用于存放选择目录的指针 }
    lpszTitle := PChar(sInfo);
    { 此处表示显示目录和文件，如果只显示目录则将后一个去掉即可 }
    if iMode = 1 then
      ulFlags := BIF_RETURNONLYFSDIRS or BIF_BROWSEINCLUDEFILES
    else
      ulFlags := BIF_RETURNONLYFSDIRS;
    lpfn := nil;                               { 指定回调函数指针 }
    lParam := 0;                               { 传递给回调函数参数 }
    IDList := SHBrowseForFolder(Info);         { 读取目录信息 }
  end;
  if IDList &lt;&gt; nil then
  begin
    SHGetPathFromIDList(IDList, Buffer);     { 将目录信息转化为路径字符串 }
    Result := strpas(Buffer);
  end;
  StrDispose(buffer);
end;

{ 获取指定路径下文件夹的个数 }
procedure YzListFolders(const Path: String; const ShowPath: Boolean;var List: TStrings);
var
  SRec: TSearchRec;
begin
 if not Assigned(List) then List:= TStringList.Create;
 FindFirst(Path + '*.*', faDirectory, SRec);
 if ShowPath then
    List.Add(Path + SRec.Name)
 else
    List.Add(SRec.Name);
 while FindNext(SRec) = 0 do
    if ShowPath then
       List.Add(Path + SRec.Name)
    else
       List.Add(SRec.Name);
 FindClose(SRec);
end;

{ 禁用窗器控件的所有子控件 }
procedure YzSetSubCtlState(AOwer: TWinControl;AState: Boolean);
var
  I: Integer;
begin
  for I := 0 to AOwer.ControlCount - 1 do
   AOwer.Controls[I].Enabled := AState;
end;

{ 模拟键盘按键操作(处理字节码) }
procedure YzFKeyent(byteCard: byte);
var
  vkkey: integer;
begin
  vkkey := VkKeyScan(chr(byteCard));
  if (chr(byteCard) in ['A'..'Z']) then
  begin
    keybd_event(VK_SHIFT, 0, 0, 0);
    keybd_event(byte(byteCard), 0, 0, 0);
    keybd_event(VK_SHIFT, 0, 2, 0);
  end
  else if chr(byteCard) in ['!', '@', '#', '$', '%', '^', '&amp;', '*', '(', ')',
    '_', '+', '|', '{', '}', ':', '&quot;', '&lt;', '&gt;', '?', '~'] then
  begin
    keybd_event(VK_SHIFT, 0, 0, 0);
    keybd_event(byte(vkkey), 0, 0, 0);
    keybd_event(VK_SHIFT, 0, 2, 0);
  end
  else { if byteCard in [8,13,27,32] }
  begin
    keybd_event(byte(vkkey), 0, 0, 0);
  end;
end;

{ 模拟键盘按键(处理字符) }
procedure YzFKeyent(strCard: string);
var
  str: string;
  strLength: integer;
  I: integer;
  byteSend: byte;
begin
  str := strCard;
  strLength := length(str);
  for I := 1 to strLength do
  begin
    byteSend := byte(str[I]);
    YzFKeyent(byteSend);
  end;
end;

{ 锁定窗口位置 }
procedure YzLockWindow(ClassName,WinName: PChar;poX,poY: Integer);
var
  CurWindow: THandle;
  _wndRect: TRect;
begin
  CurWindow := 0;
  while True do
  begin
    CurWindow := FindWindow(ClassName,WinName);
    if CurWindow &lt;&gt; 0 then Break;
    YzDelayTime(10);
    Application.ProcessMessages;
  end;
  GetWindowRect(CurWindow,_wndRect);
  if ( _wndRect.Left &lt;&gt; poX) or ( _wndRect.Top &lt;&gt; poY) then
  begin
       MoveWindow(CurWindow,
       poX,
       poY,
       (_wndRect.Right-_wndRect.Left),
       (_wndRect.Bottom-_wndRect.Top),
        TRUE);
  end;
  YzDelayTime(1000);
end;

{
  注册一个DLL形式或OCX形式的OLE/COM控件
  参数strOleFileName为一个DLL或OCX文件名，
  参数OleAction表示注册操作类型，1表示注册，0表示卸载
  返回值True表示操作执行成功，False表示操作执行失败
}
function YzRegisterOleFile (strOleFileName: STRING;OleAction: Byte): BOOLEAN;
const
  RegisterOle   =   1; { 注册 }
  UnRegisterOle =   0; { 卸载 }
type
  TOleRegisterFunction = function: HResult; { 注册或卸载函数的原型 }
var
  hLibraryHandle: THandle;    { 由LoadLibrary返回的DLL或OCX句柄 }
  hFunctionAddress: TFarProc; { DLL或OCX中的函数句柄，由GetProcAddress返回 }
  RegFunction: TOleRegisterFunction; { 注册或卸载函数指针 }
begin
  Result := FALSE;
  { 打开OLE/DCOM文件，返回的DLL或OCX句柄 }
  hLibraryHandle := LoadLibrary(PCHAR(strOleFileName));
  if (hLibraryHandle &gt; 0) then        { DLL或OCX句柄正确 }
  try
    { 返回注册或卸载函数的指针 }
    if (OleAction = RegisterOle) then { 返回注册函数的指针 }
      hFunctionAddress := GetProcAddress(hLibraryHandle, pchar('DllRegisterServer'))
    { 返回卸载函数的指针 }
    else
      hFunctionAddress := GetProcAddress(hLibraryHandle, pchar('DllUnregisterServer'));
    if (hFunctionAddress &lt;&gt; NIL) then { 注册或卸载函数存在 }
    begin
      { 获取操作函数的指针 }
      RegFunction := TOleRegisterFunction(hFunctionAddress);
      { 执行注册或卸载操作，返回值&gt;=0表示执行成功 }
      if RegFunction &gt;= 0 then
        Result   :=   true;
    end;
  finally
    { 关闭已打开的OLE/DCOM文件 }
    FreeLibrary(hLibraryHandle);
  end;
end;

function YzListViewColumnCount(mHandle: THandle): Integer;
begin
  Result := Header_GetItemCount(ListView_GetHeader(mHandle));
end; { ListViewColumnCount }

function YzGetListViewText(mHandle: THandle; mStrings: TStrings): Boolean;
var
  vColumnCount: Integer;
  vItemCount: Integer;
  I, J: Integer;
  vBuffer: array[0..255] of Char;
  vProcessId: DWORD;
  vProcess: THandle;
  vPointer: Pointer;
  vNumberOfBytesRead: Cardinal;
  S: string;  vItem: TLVItem;
begin
  Result := False;
  if not Assigned(mStrings) then Exit;
  vColumnCount := YzListViewColumnCount(mHandle);
  if vColumnCount &lt;= 0 then Exit;
  vItemCount := ListView_GetItemCount(mHandle);
  GetWindowThreadProcessId(mHandle, @vProcessId);
  vProcess := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ
    or  PROCESS_VM_WRITE, False, vProcessId);
  vPointer := VirtualAllocEx(vProcess, nil, 4096, MEM_RESERVE or MEM_COMMIT,
    PAGE_READWRITE);
  mStrings.BeginUpdate;
  try
    mStrings.Clear;
    for I := 0 to vItemCount - 1 do
    begin
      S := '';
      for J := 0 to vColumnCount - 1 do
      begin
        with vItem do
        begin
          mask := LVIF_TEXT;
          iItem := I;
          iSubItem := J;
          cchTextMax := SizeOf(vBuffer);
          pszText := Pointer(Cardinal(vPointer) + SizeOf(TLVItem));
        end;
        WriteProcessMemory(vProcess, vPointer, @vItem,
        SizeOf(TLVItem), vNumberOfBytesRead);
        SendMessage(mHandle, LVM_GETITEM, I, lparam(vPointer));
        ReadProcessMemory(vProcess, Pointer(Cardinal(vPointer) + SizeOf(TLVItem)),
          @vBuffer[0], SizeOf(vBuffer), vNumberOfBytesRead);
        S := S + #9 + vBuffer;
      end;
      Delete(S, 1, 1);
      mStrings.Add(S);
    end;
  finally
    VirtualFreeEx(vProcess, vPointer, 0, MEM_RELEASE);
    CloseHandle(vProcess);    mStrings.EndUpdate;
  end;
  Result := True;
end; { GetListViewText }

{ 删除目录树 }
function YzDeleteDirectoryTree(Path: string): boolean;
var
  SearchRec: TSearchRec;
  SFI: string;
begin
  Result := False;
  if (Path = '') or (not DirectoryExists(Path)) then exit;
  if Path[length(Path)] &lt;&gt; '/' then Path := Path + '/';
  SFI := Path + '*.*';
  if FindFirst(SFI, faAnyFile, SearchRec) = 0 then
  begin
    repeat
      begin
        if (SearchRec.Name = '.') or (SearchRec.Name = '..') then
          Continue;
        if (SearchRec.Attr and faDirectory &lt;&gt; 0) then
        begin
          if not YzDeleteDirectoryTree(Path + SearchRec.name) then
            Result := FALSE;
        end
        else
        begin
          FileSetAttr(Path + SearchRec.Name, 128);
          DeleteFile(Path + SearchRec.Name);
        end;
      end
    until FindNext(SearchRec) &lt;&gt; 0;
    FindClose(SearchRec);
  end;
  FileSetAttr(Path, 0);
  if RemoveDir(Path) then
    Result := TRUE
  else
    Result := FALSE;
end;

{ Jpg格式转换为bmp格式 }
function JpgToBmp(Jpg: TJpegImage): TBitmap;
begin
  Result := nil;
  if Assigned(Jpg) then
  begin
    Result := TBitmap.Create;
    Jpg.DIBNeeded;
    Result.Assign(Jpg);
  end;
end;

{ 设置程序自启动函数 }
function YzSetAutoRun(AFilePath: string;AFlag: Boolean): boolean;
var
  AMainFName: string;
  Reg: TRegistry;
begin
  Result := true;
  AMainFName := YzGetMainFileName(AFilePath);
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_LOCAL_MACHINE;
  try
    Reg.OpenKey('SOFTWARE/Microsoft/Windows/CurrentVersion/Run', True);
    if AFlag = False then  { 取消自启动 }
      Reg.DeleteValue(AMainFName)
    else                   { 设置自启动 }
      Reg.WriteString(AMainFName, '&quot;' + AFilePath + '&quot;')
  except
    Result := False;
  end;
  Reg.CloseKey;
  Reg.Free;
end;

{ 检测URL地址是否有效 }
function YzCheckUrl(url: string): Boolean;
var
  hSession, hfile, hRequest: HINTERNET;
  dwindex, dwcodelen: dword;
  dwcode: array[1..20] of Char;
  res: PChar;
begin
  Result := False;
  try
    if Pos('http://',LowerCase(url)) = 0 then url := 'http://' + url;
    { Open an internet session }
    hSession:=InternetOpen('InetURL:/1.0',INTERNET_OPEN_TYPE_PRECONFIG,nil,nil, 0);
    if Assigned(hsession) then
    begin
      hfile := InternetOpenUrl(hsession, PChar(url), nil, 0,INTERNET_FLAG_RELOAD, 0);
      dwIndex := 0;
      dwCodeLen := 10;
      HttpQueryInfo(hfile,HTTP_QUERY_STATUS_CODE,@dwcode,dwcodeLen,dwIndex);
      res := PChar(@dwcode);
      Result := (res = '200') or (res = '302');
      if Assigned(hfile) then InternetCloseHandle(hfile);
      InternetCloseHandle(hsession);
    end;
  except
  end;
end;

{ 获取程序可执行文件名 }
function YzGetExeFName: string;
begin
  Result := ExtractFileName(Application.ExeName);
end;

{ 目录浏览对话框函数 }
function YzBrowseFolder(AOwer: TWinControl;ATitle: string):string;
var
  Info: TBrowseInfo;
  Dir: array[0..260] of char;
  ItemId: PItemIDList;
begin
  with Info do
  begin
    hwndOwner := AOwer.Handle;
    pidlRoot := nil;
    pszDisplayName := nil;
    lpszTitle := PChar(ATitle);
    ulFlags := 0;
    lpfn := nil;
    lParam := 0;
    iImage := 0;
  end;
  ItemId := SHBrowseForFolder(Info);
  SHGetPathFromIDList(ItemId,@Dir);
  Result := string(Dir);
end;

{ 重启计算机 }
function YzShutDownSystem(AFlag: Integer):BOOL;
var
  hProcess,hAccessToken: THandle;
  LUID_AND_ATTRIBUTES: TLUIDAndAttributes;
  TOKEN_PRIVILEGES: TTokenPrivileges;
  BufferIsNull: DWORD;
Const
  SE_SHUTDOWN_NAME='SeShutdownPrivilege';
begin
  hProcess:=GetCurrentProcess();

OpenProcessToken(hprocess, TOKEN_ADJUST_PRIVILEGES+TOKEN_QUERY, hAccessToken);
  LookupPrivilegeValue(Nil, SE_SHUTDOWN_NAME, LUID_AND_ATTRIBUTES.Luid);
  LUID_AND_ATTRIBUTES.Attributes := SE_PRIVILEGE_ENABLED;
  TOKEN_PRIVILEGES.PrivilegeCount := 1;
  TOKEN_PRIVILEGES.Privileges[0] := LUID_AND_ATTRIBUTES;
  BufferIsNull := 0;

AdjustTokenPrivileges(hAccessToken, False, TOKEN_PRIVILEGES, sizeof(
    TOKEN_PRIVILEGES) ,Nil, BufferIsNull);
  Result := ExitWindowsEx(AFlag, 0);
end;

{ 程序运行后删除自身 }
procedure YzDeleteSelf;
var
  hModule: THandle;
  buff:    array[0..255] of Char;
  hKernel32: THandle;
  pExitProcess, pDeleteFileA, pUnmapViewOfFile: Pointer;
begin
  hModule := GetModuleHandle(nil);
  GetModuleFileName(hModule, buff, sizeof(buff));

CloseHandle(THandle(4));

hKernel32        := GetModuleHandle('KERNEL32');
  pExitProcess     := GetProcAddress(hKernel32, 'ExitProcess');
  pDeleteFileA     := GetProcAddress(hKernel32, 'DeleteFileA');
  pUnmapViewOfFile := GetProcAddress(hKernel32, 'UnmapViewOfFile');

asm
    LEA         EAX, buff
    PUSH        0
    PUSH        0
    PUSH        EAX
    PUSH        pExitProcess
    PUSH        hModule
    PUSH        pDeleteFileA
    PUSH        pUnmapViewOfFile
    RET
  end;
end;

{ 程序重启 }
procedure YzAppRestart;
var
  AppName : PChar;
begin
  AppName := PChar(Application.ExeName) ;
  ShellExecute(Application.Handle,'open', AppName, nil, nil, SW_SHOWNORMAL);
  KillByPID(GetCurrentProcessId);
end;

{ 压缩Access数据库 }
function YzCompactAccessDB(const AFileName, APassWord: string): Boolean;
var
  SPath, FConStr, TmpConStr: string;
  SFile: array[0..254] of Char;
  STempFileName: string;
  JE: OleVariant;
  function GetTempDir: string;
  var
    Buffer: array[0..MAX_PATH] of Char;
  begin
    ZeroMemory(@Buffer, MAX_PATH);
    GetTempPath(MAX_PATH, Buffer);
    Result := IncludeTrailingBackslash(StrPas(Buffer));
  end;
begin
  Result := False;
  SPath := GetTempDir;  { 取得Windows的Temp路径 }

{ 取得Temp文件名,Windows将自动建立0字节文件 }
  GetTempFileName(PChar(SPath), '~ACP', 0, SFile);
  STempFileName := SFile;

{ 删除Windows建立的0字节文件 }
  if not DeleteFile(STempFileName) then Exit;
  try
    JE := CreateOleObject('JRO.JetEngine');

{ 压缩数据库 }
    FConStr := 'Provider=Microsoft.Jet.OLEDB.4.0;' + 'Data Source=' + AFileName
      + ';Jet OLEDB:DataBase PassWord=' + APassWord;

TmpConStr := 'Provider=Microsoft.Jet.OLEDB.4.0;' + 'Data Source=' + STempFileName
      + ';Jet OLEDB:DataBase PassWord=' + APassWord;
    JE.CompactDatabase(FConStr, TmpConStr);

{ 覆盖源数据库文件 }
    Result := CopyFile(PChar(STempFileName), PChar(AFileName), False);

{ 删除临时文件 }
    DeleteFile(STempFileName);
  except
    Application.MessageBox('压缩数据库失败！', '提示', MB_OK +
      MB_ICONINFORMATION);
  end;
end;

{ 标题:获取其他进程中TreeView的文本 }
function YzTreeNodeGetNext(mHandle: THandle; mTreeItem: HTreeItem): HTreeItem;
var
  vParentID: HTreeItem;
begin
  Result := nil;
  if (mHandle &lt;&gt; 0) and (mTreeItem &lt;&gt; nil) then
  begin
    Result := TreeView_GetChild(mHandle, mTreeItem);
    if Result = nil then
      Result := TreeView_GetNextSibling(mHandle, mTreeItem);
    vParentID := mTreeItem;
    while (Result = nil) and (vParentID &lt;&gt; nil) do
    begin
      vParentID := TreeView_GetParent(mHandle, vParentID);
      Result := TreeView_GetNextSibling(mHandle, vParentID);
    end;
  end;
end; { TreeNodeGetNext }

function YzTreeNodeGetLevel(mHandle: THandle; mTreeItem: HTreeItem): Integer;
var
  vParentID: HTreeItem;
begin
  Result := -1;
  if (mHandle &lt;&gt; 0) and (mTreeItem &lt;&gt; nil) then
  begin
    vParentID := mTreeItem;
    repeat
      Inc(Result);
      vParentID := TreeView_GetParent(mHandle, vParentID);
    until vParentID = nil;
  end;
end; { TreeNodeGetLevel }

function YzGetTreeViewText(mHandle: THandle; mStrings: TStrings): Boolean;
var
  vItemCount: Integer;
  vBuffer: array[0..255] of Char;
  vProcessId: DWORD;
  vProcess: THandle;
  vPointer: Pointer;
  vNumberOfBytesRead: Cardinal;
  I: Integer;
  vItem: TTVItem;
  vTreeItem: HTreeItem;
begin
  Result := False;
  if not Assigned(mStrings) then Exit;
  GetWindowThreadProcessId(mHandle, @vProcessId);
  vProcess := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or
    PROCESS_VM_WRITE, False, vProcessId);
  vPointer := VirtualAllocEx(vProcess, nil, 4096, MEM_RESERVE or
    MEM_COMMIT, PAGE_READWRITE);
  mStrings.BeginUpdate;
  try
    mStrings.Clear;
    vItemCount := TreeView_GetCount(mHandle);
    vTreeItem := TreeView_GetRoot(mHandle);
    for I := 0 to vItemCount - 1 do
    begin
      with vItem do begin
        mask := TVIF_TEXT; cchTextMax := SizeOf(vBuffer);
        pszText := Pointer(Cardinal(vPointer) + SizeOf(vItem));
        hItem := vTreeItem;
      end;
      WriteProcessMemory(vProcess, vPointer, @vItem, SizeOf(vItem),
        vNumberOfBytesRead);
      SendMessage(mHandle, TVM_GETITEM, 0, lparam(vPointer));
      ReadProcessMemory(vProcess, Pointer(Cardinal(vPointer) + SizeOf(TLVItem)),
      @vBuffer[0], SizeOf(vBuffer), vNumberOfBytesRead);
      mStrings.Add(StringOfChar(#9, YzTreeNodeGetLevel(mHandle, vTreeItem)) + vBuffer);
      vTreeItem := YzTreeNodeGetNext(mHandle, vTreeItem);
    end;
  finally
    VirtualFreeEx(vProcess, vPointer, 0, MEM_RELEASE);
    CloseHandle(vProcess); mStrings.EndUpdate;
  end;
  Result := True;
end; { GetTreeViewText }

{ 获取其他进程中ListBox和ComboBox的内容 }
function YzGetListBoxText(mHandle: THandle; mStrings: TStrings): Boolean;
var
  vItemCount: Integer;
  I: Integer;
  S: string;
begin
  Result := False;
  if not Assigned(mStrings) then Exit;
  mStrings.BeginUpdate;
  try
    mStrings.Clear;
    vItemCount := SendMessage(mHandle, LB_GETCOUNT, 0, 0);
    for I := 0 to vItemCount - 1 do
    begin
      SetLength(S, SendMessage(mHandle, LB_GETTEXTLEN, I, 0));
      SendMessage(mHandle, LB_GETTEXT, I, Integer(@S[1]));
      mStrings.Add(S);
    end;
    SetLength(S, 0);
  finally
    mStrings.EndUpdate;
  end;
  Result := True;
end; { GetListBoxText }

function YzGetComboBoxText(mHandle: THandle; mStrings: TStrings): Boolean;
var
  vItemCount: Integer;
  I: Integer;
  S: string;
begin
  Result := False;
  if not Assigned(mStrings) then Exit;
  mStrings.BeginUpdate;
  try
    mStrings.Clear;
    vItemCount := SendMessage(mHandle, CB_GETCOUNT, 0, 0);
    for I := 0 to vItemCount - 1 do
    begin
      SetLength(S, SendMessage(mHandle, CB_GETLBTEXTLEN, I, 0));
      SendMessage(mHandle, CB_GETLBTEXT, I, Integer(@S[1]));
      mStrings.Add(S);
    end;
    SetLength(S, 0);
  finally
    mStrings.EndUpdate;
  end;
  Result := True;
end; { GetComboBoxText }

{ 获取本地Application Data目录路径 }
function YzLocalAppDataPath : string;
const
   SHGFP_TYPE_CURRENT = 0;
var
   Path: array [0..MAX_PATH] of char;
begin
   SHGetFolderPath(0, CSIDL_LOCAL_APPDATA, 0, SHGFP_TYPE_CURRENT, @path[0]) ;
   Result := Path;
end;

{ 获取Windows当前登录的用户名 }
function YzGetWindwosUserName: String;
var
  pcUser: PChar;
  dwUSize: DWORD;
begin
  dwUSize := 21;
  result  := '';
  GetMem(pcUser, dwUSize);
  try
    if Windows.GetUserName(pcUser, dwUSize) then
      Result := pcUser
  finally
    FreeMem(pcUser);
  end;
end;

{-------------------------------------------------------------
  功  能:  delphi 枚举托盘图标
  参  数:  AFindList: 返回找到的托盘列表信息
  返回值:  成功为True,反之为False
  备  注:  返回的格式为: 位置_名称_窗口句柄_进程ID
--------------------------------------------------------------}
function YzEnumTrayNotifyWnd(AFindList: TStringList;ADestStr: string): BOOL;
var
  wd: HWND;
  wtd: HWND;
  wd1: HWND;
  pid: DWORD;
  hd: THandle;
  num, i: integer;
  n: ULONG;
  p: TTBBUTTON;
  pp: ^TTBBUTTON;
  x: string;
  name: array[0..255] of WCHAR;
  whd, proid: ulong;
  temp: string;
  sp: ^TTBBUTTON;
  _sp: TTBButton;
begin
  Result := False;
  wd := FindWindow('Shell_TrayWnd', nil);
  if (wd = 0) then Exit;

wtd := FindWindowEx(wd, 0, 'TrayNotifyWnd', nil);
  if (wtd = 0) then Exit;

wtd := FindWindowEx(wtd, 0, 'SysPager', nil);
  if (wtd = 0) then Exit;

wd1 := FindWindowEx(wtd, 0, 'ToolbarWindow32', nil);
  if (wd1 = 0) then Exit;

pid := 0;
  GetWindowThreadProcessId(wd1, @pid);
  if (pid = 0) then Exit;

hd := OpenProcess(PROCESS_ALL_ACCESS, true, pid);
  if (hd = 0) then Exit;
  num := SendMessage(wd1, TB_BUTTONCOUNT, 0, 0);
  sp := @_sp;
  for i := 0 to num do
  begin
    SendMessage(wd1, TB_GETBUTTON, i, integer(sp));
    pp := @p;
    ReadProcessMemory(hd, sp, pp, sizeof(p), n);
    name[0] := Char(0);
    if (Cardinal(p.iString) &lt;&gt; $FFFFFFFF) then
    begin
      try
        ReadProcessMemory(hd, pointer(p.iString), @name, 255, n);
        name[n] := Char(0);
      except
      end;
      temp := name;
      try
        whd := 0;
        ReadProcessMemory(hd, pointer(p.dwData), @whd, 4, n);
      except
      end;
      proid := 0;
      GetWindowThreadProcessId(whd, @proid);
      AFindList.Add(Format('%d_%s_%x_%x', [i, temp, whd, proid]));
      if CompareStr(temp, ADestStr) = 0 then Result := True;
    end;
  end;
end;

{ 获取SQL Server用户数据库列表 }
procedure YzGetSQLServerDBList(ADBHostIP, ALoginPwd: string;ADBList: TStringList);
var
  PQuery: TADOQuery;
  ConnectStr: string;
begin
  ConnectStr := 'Provider=SQLOLEDB.1;Password=' + ALoginPwd
    + ';Persist Security Info=True;User ID=sa;Initial Catalog=master'
    + ';Data Source=' + ADBHostIP;
  ADBList.Clear;
  PQuery := TADOQuery.Create(nil);
  try
    PQuery.ConnectionString := ConnectStr;
    PQuery.SQL.Text:='select name from sysdatabases where dbid &gt; 6';
    PQuery.Open;
    while not PQuery.Eof do
    begin
      ADBList.add(PQuery.Fields[0].AsString);
      PQuery.Next;
    end;
  finally
    PQuery.Free;
  end;
end;

{ 检测数据库中是否存在给定的表 }
procedure YzGetTableList(ConncetStr: string;ATableList: TStringList);
var
  FConnection: TADOConnection;
begin
  FConnection := TADOConnection.Create(nil);
  try
    FConnection.LoginPrompt := False;
    FConnection.Connected := False;
    FConnection.ConnectionString := ConncetStr;
    FConnection.Connected := True;
    FConnection.GetTableNames(ATableList, False);
  finally
    FConnection.Free;
  end;
end;

{ 将域名解释成IP地址 }
function YzDomainToIP(HostName: string): string;
type
  tAddr = array[0..100] of PInAddr;
  pAddr = ^tAddr;
var
  I: Integer;
  WSA: TWSAData;
  PHE: PHostEnt;
  P: pAddr;
begin
  Result := '';
  WSAStartUp($101, WSA);
  try
    PHE := GetHostByName(pChar(HostName));
    if (PHE &lt;&gt; nil) then
    begin
      P := pAddr(PHE^.h_addr_list);
      I := 0;
      while (P^[I] &lt;&gt; nil) do
      begin
        Result := (inet_nToa(P^[I]^));
        Inc(I);
      end;
    end;
  except
  end;
  WSACleanUp;
end;

{ 移去系统托盘失效图标 }
procedure YzRemoveDeadIcons();
var
  hTrayWindow: HWND;
  rctTrayIcon: TRECT;
  nIconWidth, nIconHeight:integer;
  CursorPos: TPoint;
  nRow, nCol: Integer;
Begin
  //Get tray window handle and bounding rectangle
  hTrayWindow := FindWindowEx(FindWindow('Shell_TrayWnd ', nil), 0, 'TrayNotifyWnd ', nil);
  if Not (GetWindowRect(hTrayWindow, rctTrayIcon)) then Exit;
  //Get small icon metrics
  nIconWidth := GetSystemMetrics(SM_CXSMICON);
  nIconHeight := GetSystemMetrics(SM_CYSMICON);
  //Save current mouse position   }
  GetCursorPos(CursorPos);
  //Sweep the mouse cursor over each icon in the tray in both dimensions
  for nRow := 0 To ((rctTrayIcon.bottom - rctTrayIcon.top) div nIconHeight) Do
  Begin
    for nCol := 0 To ((rctTrayIcon.right - rctTrayIcon.left) div nIconWidth) Do
    Begin
      SetCursorPos(rctTrayIcon.left + nCol * nIconWidth + 5,
        rctTrayIcon.top + nRow * nIconHeight + 5);
      Sleep(0);
    end;
  end;
  //Restore mouse position
  SetCursorPos(CursorPos.x, CursorPos.x);
  //Redraw tray window(to fix bug in multi-line tray area)
  RedrawWindow(hTrayWindow, nil, 0, RDW_INVALIDATE Or RDW_ERASE Or RDW_UPDATENOW);
end;

{ 转移程序占用内存至虚拟内存 }
procedure YzClearMemory;
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    SetProcessWorkingSetSize(GetCurrentProcess, $FFFFFFFF, $FFFFFFFF);
    Application.ProcessMessages;
  end;
end;

{ 检测允许试用的天数是否已到期 }
function YzCheckTrialDays(AllowDays: Integer): Boolean;
var
  Reg_ID, Pre_ID: TDateTime;
  FRegister: TRegistry;
begin
  { 初始化为试用没有到期 }
  Result := True;
  FRegister := TRegistry.Create;
  try
    with FRegister do
    begin
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKey('Software/Microsoft/Windows/CurrentSoftware/'
        + YzGetMainFileName(Application.ExeName), True) then
      begin
        if ValueExists('DateTag') then
        begin
          Reg_ID := ReadDate('DateTag');
          if Reg_ID = 0 then Exit;
          Pre_ID := ReadDate('PreDate');
          { 允许使用的时间到 }
          if ((Reg_ID &lt;&gt; 0) and (Now - Reg_ID &gt; AllowDays)) or
            (Pre_ID &lt;&gt; Reg_ID) or (Reg_ID &gt; Now) then
          begin
            { 防止向前更改日期 }
            WriteDateTime('PreDate', Now + 20000);
            Result := False;
          end;
        end
        else
        begin
          { 首次运行时保存初始化数据 }
          WriteDateTime('PreDate', Now);
          WriteDateTime('DateTag', Now);
        end;
      end;
    end;
  finally
    FRegister.Free;
  end;
end;

{ 指定长度的随机小写字符串函数 }
function YzRandomStr(aLength: Longint): string;
var
  X: Longint;
begin
  if aLength &lt;= 0 then exit;
  SetLength(Result, aLength);
  for X := 1 to aLength do
    Result[X] := Chr(Random(26) + 65);
  Result := LowerCase(Result);
end;

end.

</code></pre>

自定义Delphi公用函数单元

相关文章

发表评论取消回复
使用cookie技术保留您的个人信息以便您下次快速评论，继续评论表示您已同意该条款

设置WebBrowser的Referrer值

《Stanley博士的家》高智商游戏

TVB经典台庆剧·《寻秦记》OST原声音乐专集下载

开创Web安全新时代趋势进入"云安全"

今天是我的大喜日子

sql判断存储过程是否存在

一个老骡子看VeryCD 电驴(easyMule) 1.0.0 071207Beta测试版

该好好地调整一下心态

【多图】《变形金刚》影片详细资料

常用的几个PHP加密函数

自定义Delphi公用函数单元

相关文章

发表评论 取消回复 使用cookie技术保留您的个人信息以便您下次快速评论，继续评论表示您已同意该条款

自定义Delphi公用函数单元

发表评论取消回复
使用cookie技术保留您的个人信息以便您下次快速评论，继续评论表示您已同意该条款