delphi公用函数

{*******************************************************}{                                                       }{             Delphi公用函数单元                        }{                                                       }{        版权所有 (C) 2008                           }{                                                       }{*******************************************************}unit YzDelphiFunc;interfaceuses  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;{ 取日期月份分量 }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;implementationuses  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.