• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    公众号
登陆 注册

delphi公用函数

原作者: [db:作者] 来自: [db:来源] 收藏 邀请 
{*******************************************************}  
{                                                       }  
{             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;  
  
{ 取日期月份分量 }  
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

鲜花
握手
雷人
路过
鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
More+
上一篇：
Delphi中ARC内存管理的方向发布时间：2022-07-18
下一篇：
[DIY]Delphi下开发问题集锦发布时间：2022-07-18
热门推荐
More+
热门话题
More+
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服（服务时间 9:00～18:00）

在线QQ客服
地址：深圳市南山区西丽大学城创智工业园
电邮：jeky_zhao#qq.com
移动电话：139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap