首页 > 代码库 > delphi公用函数

delphi公用函数

{*******************************************************}  {                                                       }  {             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          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.  

  

delphi公用函数