• 炒股的前前后后

    • 今年年初的时候,其实我就有点想买点股票的,之前老婆一直吵着想入市去捞点油水,周围的朋友都通过股市如何如何赚钱了,07年大牛的时候身边有一些朋友也捞了不少,可怜当时没有多余的资金,炒股不如自己搞点实业来得踏实。于是也就错过了一波大好行情,去年6,7月份的时候我们公司的股票600804才15块,年初的时候涨到20左右,本来计划买点的,结果年初去夏威夷土豪了一把,第一次出国买了不少东西,于是把积蓄都用了,年初那几个月还过的紧巴巴的,花了两三个月才恢复元气。后来公司的股票涨到30块,就在想啊,如果去年年中的时候买个20万股票,这一下就翻一倍了,再后来涨到50块钱,就更后悔当时没有买了。。。。

      当大盘一路冲高,冲到4000点以上以后,我知道风险太大,要亏。。。所以一直观望着,5月底开始,大盘一直暴跌,到4000点的时候,我决定入市了,准备抄底了,6月底开户,第一天投了10万,结果第二天就赚了1万多,爽啊,于是再投10万,结果就开始每天跌停的日子,跌停了继续接盘买。。。再买。。再买,直到打光所有子弹。。。。。。后来国家救市,公司的股停牌了两星期,复盘后连续3个涨停,回本了不少,再涨了几天,基本上就回本了,其实人的心里啊,当亏本的时候就想回本,回本之后就想赚点再走。。。于是见证了为国护盘,千股涨停,千股跌停这些只有在A股才有的奇葩事情。。

      阅读剩余部分...

    • Delphi中Hook API进行进程保护(不允许进程结束的方法)

    • const
      PRG_NAME = 'HA.exe';
      var
      TerminateProcessNext : function (processHandle, exitCode: dword) : bool; stdcall;
      NtTerminateProcessNext : function (processHandle, exitCode: dword) : dword; stdcall;

      {$R *.res}
      function ThisIsOurProcess(processHandle: dword): boolean;
      var
      pid: dword;
      arrCh: array [0 .. MAX_PATH] of char;
      begin
      pid := ProcessHandleToId(processHandle);
      result := (pid <> 0) and ProcessIdToFileName(pid, arrCh) and

      (PosText(PRG_NAME, arrCh) > 0);

      end;

      阅读剩余部分...

    • SQL Server 2008 Management Studio 过期无法使用解决办法

    • SQL Server 2008 评估期已过解决方法?
      SQL Server Management Studio 过期无法使用解决办法?

      解决办法:

      安装SQL Server 2008的时候没有输入序列号,后来才发现是Express版的,今天到期了,升级SQL后,SQL服务可以用了,但SQL Server Management Studio缺无法使用。SQL Server 2008有180天的试用期,过期后会提示“评估期已过”的提示。
      在网上找了许久找到了一个解决方法:

      1、修改注册表(Regedit): 路径:计算机\HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Microsoft SQL Server\100\ConfigurationState下的CommonFiles文件,将值从1改为3。

      2、进入SQL Server安装中心:
      201105062325308450.png

      3、选择“维护”-“版本升级”
      201105062325323825.png

      4、输入密钥,其他的根据提示操作,升级完成后就可以了。

    • 自定义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;
      
      
      <!--more-->
      
      
      { 取日期月份分量 }
      function YzGetMonth(Date: TDate): Integer;
      
      { 取日期天数分量 }
      function YzGetDay(Date: TDate): Integer;
      
      { 取时间小时分量 }
      function YzGetHour(Time: TTime): Integer;
      
      { 取时间分钟分量 }
      function YzGetMinute(Time: TTime): Integer;
      
      { 取时间秒钟分量 }
      function YzGetSecond(Time: TTime): Integer;
      
      { 返回时间分量字符串 }
      function YzGetTimeStr(ATime: TTime;AFlag: string): string;
      
      { 返回日期时间字符串 }
      function YzGetDateTimeStr(ATime: TTime;ADate: TDate): string;
      
      { 获取计算机名称 }
      function YzGetComputerName(): string;
      
      { 通过窗体子串查找窗体 }
      procedure YzFindSpecWindow(ASubTitle: string);
      
      { 判断进程CPU占用率 }
      procedure YzJudgeCPU(ProcessName: string;CPUUsage: Single);
      
      { 分割字符串 }
      procedure YzSeparateTerms(Source: string;Separator: Char;Terms: TStringList);
      
      { 切换页面控件的活动页面 }
      procedure YzGotoNewPage(AOwerPage: TPageControl;ANewPage: TTabSheet);
      
      { 设置页面控件标签的可见性 }
      procedure YzSetTableVisible(PageControl: TPageControl;ShowFlag: Boolean);
      
      { 根据产品名称获取产品编号 }
      function YzGetLevelCode(AName:string;ProductList: TStringList): string;
      
      { 取文件的主文件名 }
      function YzGetMainFileName(AFileName: string): string;
      
      { 按下一个键 }
      procedure YzPressOneKey(AByteCode: Byte);overload;
      
      { 按下一个指定次数的键 }
      procedure YzPressOneKey(AByteCode: Byte;ATimes: Integer);overload;
      
      { 按下二个键 }
      procedure YzPressTwoKeys(AFirstByteCode, ASecByteCode: Byte);
      
      { 按下三个键 }
      procedure YzPressThreeKeys(AFirstByteCode, ASecByteCode, AThirdByteCode: Byte);
      
      { 创建桌面快捷方式 }
      procedure YzCreateShortCut(const sPath: string; sShortCutName: WideString);
      
      { 删除桌面快捷方式 }
      procedure YzDeleteShortCut(sShortCutName: WideString);
      
      { 通过光标位置进行鼠标左键单击 }
      procedure YzMouseLeftClick(X, Y: Integer);overload;
      
      { 鼠标左键双击 }
      procedure YzMouseDoubleClick(X, Y: Integer);
      
      { 通过窗口句柄进行鼠标左键单击 }
      procedure YzMouseLeftClick(lpClassName, lpWindowName: PAnsiChar);overload;
      
      { 通过光标位置查找窗口句柄 }
      function YzWindowFromPoint(X, Y: Integer): THandle;
      
      { 等待窗口在指定时间后出现 }
      function YzWaitWindowExist(lpClassName, lpWindowName: PAnsiChar;
        ASecond: Integer = 0): THandle;overload;
      
      { 通光标位置,窗口类名与标题查找窗口是否存在 }
      function YzWaitWindowExist(X, Y: Integer;AClassName, AWinName: string;
        ASecond: Integer = 0):THandle; overload;
      
      { 等待指定窗口消失 }
      procedure YzWaitWindowClose(lpClassName, lpWindowName: PAnsiChar;
        ASecond: Integer = 0);
      
      { 通过窗口句柄设置文本框控件文本 }
      procedure YzSetEditText(lpClassName, lpWindowName: PAnsiChar;
        AText: string);overload;
      
      { 通过光标位置设置文本框控件文本 }
      procedure YzSetEditText(X, Y: Integer;AText: string);overload;
      
      { 获取Window操作系统语言 }
      function YzGetWindowsLanguageStr: String;
      
      { 清空动态数组 }
      procedure YzDynArraySetZero(var A);
      
      { 动态设置屏幕分辨率 }
      function YzDynamicResolution(X, Y: WORD): Boolean;
      
      { 检测系统屏幕分辨率 }
      function YzCheckDisplayInfo(X, Y: Integer): Boolean;
      
      type
        TFontedControl = class(TControl)
        public
          property Font;
        end;
        TFontMapping = record
          SWidth : Integer;
          SHeight: Integer;
          FName: string;
          FSize: Integer;
        end;
      
        procedure YzFixForm(AForm: TForm);
        procedure YzSetFontMapping;
      
      {---------------------------------------------------
       以下是关于获取系统软件卸载的信息的类型声明和函数
       ----------------------------------------------------}
      type
        TUninstallInfo = array of record
          RegProgramName: string;
          ProgramName   : string;
          UninstallPath : string;
          Publisher     : string;
          PublisherURL  : string;
          Version       : string;
          HelpLink      : string;
          UpdateInfoURL : string;
          RegCompany    : string;
          RegOwner      : string;
        end;
      
      { GetUninstallInfo 返回系统软件卸载的信息 }
      function YzGetUninstallInfo : TUninstallInfo;
      
      { 检测Java安装信息 }
      function YzCheckJavaInfo(AUninstallInfo: TUninstallInfo;CheckJava6 : Boolean = False): Boolean;
      
      { 窗口自适应屏幕大小 }
      procedure YzAdjustForm(Form: TForm;const OrgWidth, OrgHeight: integer);
      
      { 设置窗口为当前窗体 }
      procedure YzBringMyAppToFront(AppHandle: THandle);
      
      { 获取文件夹大小 }
      function YzGetDirSize(Dir: string;SubDir: Boolean): LongInt;
      
      { 获取文件夹文件数量 }
      function YzGetDirFiles(Dir: string;SubDir: Boolean): LongInt;
      
      { 获取文件大小(KB) }
      function YzGetFileSize(const FileName: String): LongInt;
      
      { 获取文件大小(字节) }
      function YzGetFileSize_Byte(const FileName: String): LongInt;
      
      { 算术舍入法的四舍五入取整函数 }
      function YzRoundEx (const Value: Real): LongInt;
      
      { 弹出选择目录对话框 }
      function YzSelectDir(const iMode: integer;const sInfo: string): string;
      
      { 获取指定路径下文件夹的个数 }
      procedure YzListFolders(const Path: String; const ShowPath: Boolean;var List: TStrings);
      
      { 禁用窗器控件的所有子控件 }
      procedure YzSetSubCtlState(AOwer: TWinControl;AState: Boolean);
      
      { 模拟键盘按键操作(处理字节码) }
      procedure YzFKeyent(byteCard: byte); overload;
      
      { 模拟键盘按键操作(处理字符串 }
      procedure YzFKeyent(strCard: string); overload;
      
      { 锁定窗口位置 }
      procedure YzLockWindow(ClassName,WinName: PChar;poX,poY: Integer);
      
      {   注册一个DLL形式或OCX形式的OLE/COM控件
          参数strOleFileName为一个DLL或OCX文件名,
          参数OleAction表示注册操作类型,1表示注册,0表示卸载
          返回值True表示操作执行成功,False表示操作执行失败
      }
      function YzRegisterOleFile (strOleFileName: STRING;OleAction: Byte): BOOLEAN;
      
      function YzListViewColumnCount(mHandle: THandle): Integer;
      
      function YzGetListViewText(mHandle: THandle; mStrings: TStrings): Boolean;
      
      { 删除目录树 }
      function YzDeleteDirectoryTree(Path: string): boolean;
      
      { Jpg格式转换为bmp格式 }
      function JpgToBmp(Jpg: TJpegImage): TBitmap;
      
      { 设置程序自启动函数 }
      function YzSetAutoRun(AFilePath: string;AFlag: Boolean): boolean;
      
      { 检测URL地址是否有效 }
      function YzCheckUrl(url: string): Boolean;
      
      { 获取程序可执行文件名 }
      function YzGetExeFName: string;
      
      { 目录浏览对话框函数 }
      function YzBrowseFolder(AOwer: TWinControl;ATitle: string):string;
      
      { 重启计算机 }
      function YzShutDownSystem(AFlag: Integer):BOOL;
      
      { 程序运行后删除自身 }
      procedure YzDeleteSelf;
      
      { 程序重启 }
      procedure YzAppRestart;
      
      { 压缩Access数据库 }
      function YzCompactAccessDB(const AFileName, APassWord: string): Boolean;
      
      { 标题:获取其他进程中TreeView的文本 }
      function YzTreeNodeGetNext(mHandle: THandle; mTreeItem: HTreeItem): HTreeItem;
      function YzTreeNodeGetLevel(mHandle: THandle; mTreeItem: HTreeItem): Integer;
      function YzGetTreeViewText(mHandle: THandle; mStrings: TStrings): Boolean;
      
      { 获取本地Application Data目录路径 }
      function YzLocalAppDataPath : string;
      
      { 获取Windows当前登录的用户名 }
      function YzGetWindwosUserName: String;
      
      {枚举托盘图标 }
      function YzEnumTrayNotifyWnd(AFindList: TStringList;ADestStr: string): BOOL;
      
      { 获取SQL Server用户数据库列表 }
      procedure YzGetSQLServerDBList(ADBHostIP, ALoginPwd: string;ADBList: TStringList);
      
      { 读取据库中所有的表 }
      procedure YzGetTableList(ConncetStr: string;ATableList: TStringList);
      
      { 将域名解释成IP地址 }
      function YzDomainToIP(HostName: string): string;
      
      { 等待进程结束 }
      procedure YzWaitProcessExit(AProcessName: string);
      
      { 移去系统托盘失效图标 }
      procedure YzRemoveDeadIcons();
      
      { 转移程序占用内存至虚拟内存 }
      procedure YzClearMemory;
      
      { 检测允许试用的天数是否已到期 }
      function YzCheckTrialDays(AllowDays: Integer): Boolean;
      
      { 指定长度的随机小写字符串函数 }
      function YzRandomStr(aLength: Longint): string;
      
      var
        FontMapping : array of TFontMapping;
      
      implementation
      
      uses
        uMain;
      
      { 保存日志文件 }
      procedure YzWriteLogFile(Msg: String);
      var
        FileStream: TFileStream;
        LogFile   : String;
      begin
        try
          { 每天一个日志文件 }
          Msg := '[' + DateTimeToStr(Now)+ '] '+ Msg;
          LogFile := ExtractFilePath(Application.ExeName) + '/Logs/' + DateToStr(Now) + '.log';
          if not DirectoryExists(ExtractFilePath(LogFile)) then
            CreateDir(ExtractFilePath(LogFile));
          if FileExists(LogFile) then
            FileStream := TFileStream.Create(LogFile, fmOpenWrite or fmShareDenyNone)
          else
            FileStream:=TFileStream.Create(LogFile,fmCreate or fmShareDenyNone);
          FileStream.Position:=FileStream.Size;
          Msg := Msg + #13#10;
          FileStream.Write(PChar(Msg)^, Length(Msg));
          FileStream.Free;
        except
        end;
      end;
      
      { 延时函数,单位为毫秒 }
      procedure YZDelayTime(MSecs: Longint);
      var
        FirstTickCount, Now: Longint;
      begin
        FirstTickCount := GetTickCount();
        repeat
          Application.ProcessMessages;
          Now := GetTickCount();
        until (Now - FirstTickCount>=MSecs) or (Now < FirstTickCount);
      end;
      
      { 判断字符串是否为数字 }
      function YzStrIsNum(Str: string):boolean;
      var
        I: integer;
      begin
        if Str = '' then
        begin
          Result := False;
          Exit;
        end;
        for I:=1 to length(str) do
          if not (Str[I] in ['0'..'9']) then
          begin
            Result := False;
            Exit;
          end;
        Result := True;
      end;
      
      { 判断文件是否正在使用 }
      function YzIsFileInUse(fName: string): boolean;
      var
        HFileRes: HFILE;
      begin
        Result := false;
        if not FileExists(fName) then exit;
        HFileRes := CreateFile(pchar(fName), GENERIC_READ or GENERIC_WRITE, 0, nil,
          OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
        Result := (HFileRes = INVALID_HANDLE_VALUE);
        if not Result then CloseHandle(HFileRes);
      end;
      
      { 删除字符串列表中的空字符串 }
      procedure YzDelEmptyChar(AList: TStringList);
      var
        I: Integer;
        TmpList: TStringList;
      begin
        TmpList := TStringList.Create;
        for I := 0 to AList.Count - 1 do
          if AList.Strings[I] <> '' then TmpList.Add(AList.Strings[I]);
        AList.Clear;
        AList.Text := TmpList.Text;
        TmpList.Free;
      end;
      
      { 删除文件列表中的"Thumbs.db"文件 }
      procedure YzDelThumbsFile(AList: TStrings);
      var
        I: Integer;
        TmpList: TStringList;
      begin
        TmpList := TStringList.Create;
        for I := 0 to AList.Count - 1 do
          if ExtractFileName(AList.Strings[I]) <> 'Thumbs.db' then
            TmpList.Add(AList.Strings[I]);
        AList.Clear;
        AList.Text := TmpList.Text;
        TmpList.Free;
      end;
      
      {-------------------------------------------------------------
        功能:    返回一个整数指定位数的带"0"字符串
        参数:    Value:要转换的整数 ALength:字符串长度
        返回值:  string
      --------------------------------------------------------------}
      function YzIntToZeroStr(Value, ALength: Integer): string;
      var
        I, ACount: Integer;
      begin
        Result := '';
        ACount := Length(IntToStr(Value));
        if ACount >= ALength then Result := IntToStr(Value)
        else
        begin
          for I := 1 to ALength-ACount do
            Result := Result + '0';
          Result := Result + IntToStr(Value)
        end;
      end;
      
      { 取日期年份分量 }
      function YzGetYear(Date: TDate): Integer;
      var
        y, m, d: WORD;
      begin
        DecodeDate(Date, y, m, d);
        Result := y;
      end;
      
      { 取日期月份分量 }
      function YzGetMonth(Date: TDate): Integer;
      var
        y, m, d: WORD;
      begin
        DecodeDate(Date, y, m, d);
        Result := m;
      end;
      
      { 取日期天数分量 }
      function YzGetDay(Date: TDate): Integer;
      var
        y, m, d: WORD;
      begin
        DecodeDate(Date, y, m, d);
        Result := d;
      end;
      
      { 取时间小时分量 }
      function YzGetHour(Time: TTime): Integer;
      var
        h, m, s, ms: WORD;
      begin
        DecodeTime(Time, h, m, s, ms);
        Result := h;
      end;
      
      { 取时间分钟分量 }
      function YzGetMinute(Time: TTime): Integer;
      var
        h, m, s, ms: WORD;
      begin
        DecodeTime(Time, h, m, s, ms);
        Result := m;
      end;
      
      { 取时间秒钟分量 }
      function YzGetSecond(Time: TTime): Integer;
      var
        h, m, s, ms: WORD;
      begin
        DecodeTime(Time, h, m, s, ms);
        Result := s;
      end;
      
      { 返回时间分量字符串 }
      function YzGetTimeStr(ATime: TTime;AFlag: string): string;
      var
        wTimeStr: string;
        FH, FM, FS, FMS: WORD;
      const
        HOURTYPE    = 'Hour';
        MINUTETYPE  = 'Minute';
        SECONDTYPE  = 'Second';
        MSECONDTYPE = 'MSecond';
      begin
        wTimeStr := TimeToStr(ATime);
        if Pos('上午', wTimeStr) <> 0 then
          wTimeStr := Copy(wTimeStr, Pos('上午', wTimeStr) + 4, 10)
        else if Pos('下午', wTimeStr) <> 0 then
          wTimeStr := Copy(wTimeStr, Pos('下午', wTimeStr) + 4, 10);
        DecodeTime(ATime, FH, FM, FS, FMS);
        if AFlag = HOURTYPE then
        begin
          { 如果是12小时制则下午的小时分量加12 }
          if Pos('下午', wTimeStr) <> 0 then
            Result := YzIntToZeroStr(FH + 12, 2)
          else
            Result := YzIntToZeroStr(FH, 2);
        end;
        if AFlag = MINUTETYPE  then Result := YzIntToZeroStr(FM, 2);
        if AFlag = SECONDTYPE  then Result := YzIntToZeroStr(FS, 2);
        if AFlag = MSECONDTYPE then Result := YzIntToZeroStr(FMS, 2);
      end;
      
      { 返回日期时间字符串 }
      function YzGetDateTimeStr(ATime: TTime;ADate: TDate): string;
      var
        wYear, wMonth, wDay: string;
        wHour, wMinute, wSecond: string;
      begin
        wYear := RightStr(YzIntToZeroStr(YzGetYear(ADate), 4), 2);
        wMonth := YzIntToZeroStr(YzGetMonth(ADate), 2);
        wDay := YzIntToZeroStr(YzGetDay(ADate), 2);
      
        wHour := YzGetTimeStr(ATime, 'Hour');
        wMinute := YzGetTimeStr(ATime, 'Minute');
        wSecond := YzGetTimeStr(ATime, 'Second');
      
        Result := wYear + wMonth + wDay + wHour + wMinute + wSecond;
      end;
      
      { 通过窗体子串查找窗体 }
      procedure YzFindSpecWindow(ASubTitle: string);
      
        function EnumWndProc(AWnd: THandle;AWinName: string): Boolean;stdcall;
        var
          WindowText: array[0..255] of Char;
          WindowStr: string;
        begin
          GetWindowText(AWnd, WindowText, 255);
          WindowStr := StrPas(WindowText);
          WindowStr := COPY(WindowStr, 1, StrLen(PChar(AWinName)));
          if CompareText(AWinName, WindowStr) = 0 then
          begin
            SetForegroundWindow(AWnd);
            Result := False; Exit;
          end;
          Result := True;
        end;
      
      begin
        EnumWindows(@EnumWndProc, LongInt(@ASubTitle));
        YzDelayTime(1000);
      end;
      
      { 获取计算机名称 }
      function YzGetComputerName(): string;
      var
        pcComputer: PChar;
        dwCSize: DWORD;
      begin
        dwCSize := MAX_COMPUTERNAME_LENGTH + 1;
        Result := '';
        GetMem(pcComputer, dwCSize);
        try
          if Windows.GetComputerName(pcComputer, dwCSize) then
            Result := pcComputer;
        finally
          FreeMem(pcComputer);
        end;
      end;
      
      { 判断进程CPU占用率 }
      procedure YzJudgeCPU(ProcessName: string;CPUUsage: Single);
      var
        cnt: PCPUUsageData;
        usage: Single;
      begin
        cnt := wsCreateUsageCounter(FindProcess(ProcessName));
        while True do
        begin
          usage := wsGetCpuUsage(cnt);
          if usage <= CPUUsage then
          begin
            wsDestroyUsageCounter(cnt);
            YzDelayTime(2000);
            Break;
          end;
          YzDelayTime(10);
          Application.ProcessMessages;
        end;
      end;
      
      { 分割字符串 }
      procedure YzSeparateTerms(Source: string;Separator: Char;Terms: TStringList);
      var
        TmpStr: string;
        PO: integer;
      begin
        Terms.Clear;
        if Length(Source) = 0 then Exit;   { 长度为0则退出 }
        PO := Pos(Separator, Source);
        if PO = 0 then
        begin
          Terms.Add(Source);
          Exit;
        end;
        while PO <> 0 do
        begin
          TmpStr := Copy(Source, 1, PO - 1);{ 复制字符 }
          Terms.Add(TmpStr);                { 添加到列表 }
          Delete(Source, 1, PO);            { 删除字符和分割符 }
          PO := Pos(Separator, Source);     { 查找分割符 }
        end;
        if Length(Source) > 0 then
          Terms.Add(Source);                { 添加剩下的条目 }
      end;
      
      { 切换页面控件的活动页面 }
      procedure YzGotoNewPage(AOwerPage: TPageControl;ANewPage: TTabSheet);
      begin
        if AOwerPage.ActivePage <> ANewPage then AOwerPage.ActivePage := ANewPage;
      end;
      
      { 设置页面控件标签的可见性 }
      procedure YzSetTableVisible(PageControl: TPageControl;ShowFlag: Boolean);
      var
        I: Integer;
      begin
        for I := 0 to PageControl.PageCount -1 do
          PageControl.Pages[I].TabVisible := ShowFlag;
      end;
      
      { 根据产品名称获取产品编号 }
      function YZGetLevelCode(AName:string;ProductList: TStringList): string;
      var
        I: Integer;
        TmpStr: string;
      begin
        Result := '';
        if ProductList.Count <= 0 then Exit;
        for I := 0 to ProductList.Count-1 do
        begin
          TmpStr := ProductList.Strings[I];
          if AName = Copy(TmpStr,1, Pos('_', TmpStr)-1) then
          begin
            Result := Copy(TmpStr, Pos('_', TmpStr)+1, 10);
            Break;
          end;
        end;
      end;
      
      { 取文件的主文件名 }
      function YzGetMainFileName(AFileName:string): string;
      var
        TmpStr: string;
      begin
        if AFileName = '' then Exit;
        TmpStr := ExtractFileName(AFileName);
        Result := Copy(TmpStr, 1, Pos('.', TmpStr) - 1);
      end;
      
      { 按下一个键 }
      procedure YzPressOneKey(AByteCode: Byte);
      begin
        keybd_event(AByteCode, 0, 0, 0);
        YzDelayTime(100);
        keybd_event(AByteCode, 0, KEYEVENTF_KEYUP, 0);
        YzDelayTime(400);
      end;
      
      { 按下一个指定次数的键 }
      procedure YzPressOneKey(AByteCode: Byte;ATimes: Integer);overload;
      var
        I: Integer;
      begin
        for I := 1 to ATimes do
        begin
          keybd_event(AByteCode, 0, 0, 0);
          YzDelayTime(10);
          keybd_event(AByteCode, 0, KEYEVENTF_KEYUP, 0);
          YzDelayTime(150);
        end;
      end;
      
      { 按下二个键 }
      procedure YzPressTwoKeys(AFirstByteCode, ASecByteCode: Byte);
      begin
        keybd_event(AFirstByteCode, 0, 0, 0);
        keybd_event(ASecByteCode, 0, 0, 0);
        YzDelayTime(100);
        keybd_event(ASecByteCode, 0, KEYEVENTF_KEYUP, 0);
        keybd_event(AFirstByteCode, 0, KEYEVENTF_KEYUP, 0);
        YzDelayTime(400);
      end;
      
      { 按下三个键 }
      procedure YzPressThreeKeys(AFirstByteCode, ASecByteCode, AThirdByteCode: Byte);
      begin
        keybd_event(AFirstByteCode, 0, 0, 0);
        keybd_event(ASecByteCode, 0, 0, 0);
        keybd_event(AThirdByteCode, 0, 0, 0);
        YzDelayTime(100);
        keybd_event(AThirdByteCode, 0, KEYEVENTF_KEYUP, 0);
        keybd_event(ASecByteCode, 0, KEYEVENTF_KEYUP, 0);
        keybd_event(AFirstByteCode, 0, KEYEVENTF_KEYUP, 0);
        YzDelayTime(400);
      end;
      
      { 创建桌面快捷方式 }
      procedure YzCreateShortCut(const sPath: string; sShortCutName: WideString);
      var
        tmpObject: IUnknown;
        tmpSLink: IShellLink;
        tmpPFile: IPersistFile;
        PIDL: PItemIDList;
        StartupDirectory: array[0..MAX_PATH] of Char;
        StartupFilename: String;
        LinkFilename: WideString;
      begin
        StartupFilename := sPath;
        tmpObject := CreateComObject(CLSID_ShellLink); { 创建建立快捷方式的外壳扩展 }
        tmpSLink := tmpObject as IShellLink;           { 取得接口 }
        tmpPFile := tmpObject as IPersistFile;         { 用来储存*.lnk文件的接口 }
        tmpSLink.SetPath(pChar(StartupFilename));      { 设定notepad.exe所在路径 }
        tmpSLink.SetWorkingDirectory(pChar(ExtractFilePath(StartupFilename))); {设定工作目录 }
        SHGetSpecialFolderLocation(0, CSIDL_DESKTOPDIRECTORY, PIDL); { 获得桌面的Itemidlist }
        SHGetPathFromIDList(PIDL, StartupDirectory);   { 获得桌面路径 }
        sShortCutName := '/' + sShortCutName + '.lnk';
        LinkFilename := StartupDirectory + sShortCutName;
        tmpPFile.Save(pWChar(LinkFilename), FALSE);    { 保存*.lnk文件 }
      end;
      
      { 删除桌面快捷方式 }
      procedure YzDeleteShortCut(sShortCutName: WideString);
      var
        PIDL : PItemIDList;
        StartupDirectory: array[0..MAX_PATH] of Char;
        LinkFilename: WideString;
      begin
        SHGetSpecialFolderLocation(0,CSIDL_DESKTOPDIRECTORY,PIDL);
        SHGetPathFromIDList(PIDL,StartupDirectory);
        LinkFilename := StrPas(StartupDirectory) + '/' + sShortCutName + '.lnk';
        DeleteFile(LinkFilename);
      end;
      
      { 通过光标位置进行鼠标左键单击 }
      procedure YzMouseLeftClick(X, Y: Integer);
      begin
        SetCursorPos(X, Y);
        YzDelayTime(100);
        mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
        mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
        YzDelayTime(400);
      end;
      
      { 鼠标左键双击 }
      procedure YzMouseDoubleClick(X, Y: Integer);
      begin
        SetCursorPos(X, Y);
        YzDelayTime(100);
        mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
        mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
        YzDelayTime(100);
        mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
        mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
        YzDelayTime(400);
      end;
      
      
      { 通过窗口句柄进行鼠标左键单击 }
      procedure YzMouseLeftClick(lpClassName, lpWindowName: PAnsiChar);overload;
      var
        AHandel: THandle;
      begin
        AHandel := FindWindow(lpClassName, lpWindowName);
        SendMessage(AHandel, WM_LBUTTONDOWN, 0, 0);
        SendMessage(AHandel, WM_LBUTTONUP, 0, 0);
        YzDelayTime(500);
      end;
      
      { 等待进程结束 }
      procedure YzWaitProcessExit(AProcessName: string);
      begin
        while True do
        begin
          KillByPID(FindProcess(AProcessName));
          if FindProcess(AProcessName) = 0 then Break;
          YzDelayTime(10);
          Application.ProcessMessages;
        end;
      end;
      
      {-------------------------------------------------------------
        功  能:  等待窗口在指定时间后出现
        参  数:  lpClassName: 窗口类名
                 lpWindowName: 窗口标题
                 ASecond: 要等待的时间,"0"代表永久等待
        返回值:  无
        备  注:  如果指定的等待时间未到窗口已出现则立即退出
      --------------------------------------------------------------}
      function YzWaitWindowExist(lpClassName, lpWindowName: PAnsiChar;
        ASecond: Integer = 0): THandle;overload;
      var
        StartTickCount, PassTickCount: LongWord;
      begin
        Result := 0;
        { 永久等待 }
        if ASecond = 0 then
        begin
          while True do
          begin
            Result := FindWindow(lpClassName, lpWindowName);
            if Result <> 0 then Break;
            YzDelayTime(10);
            Application.ProcessMessages;
          end;
        end
        else { 等待指定时间 }
        begin
          StartTickCount := GetTickCount;
          while True do
          begin
            Result := FindWindow(lpClassName, lpWindowName);
            { 窗口已出现则立即退出 }
            if Result <> 0 then Break
            else
            begin
              PassTickCount := GetTickCount;
              { 等待时间已到则退出 }
              if (PassTickCount - StartTickCount) div 1000 >= ASecond then Break;
            end;
            YzDelayTime(10);
            Application.ProcessMessages;
          end;
        end;
        YzDelayTime(1000);
      end;
      
      { 等待指定窗口消失 }
      procedure YzWaitWindowClose(lpClassName, lpWindowName: PAnsiChar;
        ASecond: Integer = 0);
      var
        StartTickCount, PassTickCount: LongWord;
      begin
        if ASecond = 0 then
        begin
          while True do
          begin
            if FindWindow(lpClassName, lpWindowName) = 0 then Break;
            YzDelayTime(10);
            Application.ProcessMessages;
          end
        end
        else
        begin
          StartTickCount := GetTickCount;
          while True do
          begin
            { 窗口已关闭则立即退出 }
            if FindWindow(lpClassName, lpWindowName)= 0 then Break
            else
            begin
              PassTickCount := GetTickCount;
              { 等待时间已到则退出 }
              if (PassTickCount - StartTickCount) div 1000 >= ASecond then Break;
            end;
            YzDelayTime(10);
            Application.ProcessMessages;
          end;
        end;
        YzDelayTime(500);
      end;
      
      { 通过光标位置查找窗口句柄 }
      function YzWindowFromPoint(X, Y: Integer): THandle;
      var
        MousePoint: TPoint;
        CurWindow: THandle;
        hRect: TRect;
        Canvas: TCanvas;
      begin
        MousePoint.X := X;
        MousePoint.Y := Y;
        CurWindow := WindowFromPoint(MousePoint);
        GetWindowRect(Curwindow, hRect);
        if Curwindow <> 0 then
        begin
          Canvas := TCanvas.Create;
          Canvas.Handle := GetWindowDC(Curwindow);
          Canvas.Pen.Width := 2;
          Canvas.Pen.Color := clRed;
          Canvas.Pen.Mode := pmNotXor;
          Canvas.Brush.Style := bsClear;
          Canvas.Rectangle(0, 0, hRect.Right-hRect.Left, hRect.Bottom-hRect.Top);
          Canvas.Free;
        end;
        Result := CurWindow;
      end;
      
      { 通光标位置,窗口类名与标题查找窗口是否存在 }
      function YzWaitWindowExist(X, Y: Integer;AClassName, AWinName: string;
        ASecond: Integer):THandle;overload;
      var
        MousePo: TPoint;
        CurWindow: THandle;
        bufClassName: array[0..MAXBYTE-1] of Char;
        bufWinName: array[0..MAXBYTE-1] of Char;
        StartTickCount, PassTickCount: LongWord;
      begin
        Result := 0;
        { 永久等待 }
        if ASecond = 0 then
        begin
          while True do
          begin
            MousePo.X := X;
            MousePo.Y := Y;
            CurWindow := WindowFromPoint(MousePo);
            GetClassName(CurWindow, bufClassName, MAXBYTE);
            GetWindowText(CurWindow, bufWinname, MAXBYTE);
            if (CompareText(StrPas(bufClassName), AClassName) = 0 ) and
               (CompareText(StrPas(bufWinName), AWinName) = 0) then
            begin
              Result := CurWindow;
              Break;
            end;
            YzDelayTime(10);
            Application.ProcessMessages;
          end;
        end
        else { 等待指定时间 }
        begin
          StartTickCount := GetTickCount;
          while True do
          begin
            { 窗口已出现则立即退出 }
            MousePo.X := X;
            MousePo.Y := Y;
            CurWindow := WindowFromPoint(MousePo);
            GetClassName(CurWindow, bufClassName, MAXBYTE);
            GetWindowText(CurWindow, bufWinname, MAXBYTE);
            if (CompareText(StrPas(bufClassName), AClassName) = 0 ) and
               (CompareText(StrPas(bufWinName), AWinName) = 0) then
            begin
              Result := CurWindow; Break;
            end
            else
            begin
              PassTickCount := GetTickCount;
              { 等待时间已到则退出 }
              if (PassTickCount - StartTickCount) div 1000 >= ASecond then Break;
            end;
            YzDelayTime(10);
            Application.ProcessMessages;
          end;
        end;
        YzDelayTime(1000);
      end;
      
      { 通过窗口句柄设置文本框控件文本 }
      procedure YzSetEditText(lpClassName, lpWindowName: PAnsiChar;
        AText: string);overload;
      var
        CurWindow: THandle;
      begin
        CurWindow := FindWindow(lpClassName, lpWindowName);
        SendMessage(CurWindow ,WM_SETTEXT, 0, Integer(PChar(AText)));
        YzDelayTime(500);
      end;
      
      { 通过光标位置设置文本框控件文本 }
      procedure YzSetEditText(X, Y: Integer;AText: string);overload;
      var
        CurWindow: THandle;
      begin
        CurWindow := YzWindowFromPoint(X, Y);
        SendMessage(CurWindow, WM_SETTEXT, 0, Integer(PChar(AText)));
        YzMouseLeftClick(X, Y);
      end;
      
      { 获取Window操作系统语言 }
      function YzGetWindowsLanguageStr: String;
      var
        WinLanguage: array [0..50] of char;
      begin
        VerLanguageName(GetSystemDefaultLangID, WinLanguage, 50);
        Result := StrPas(WinLanguage);
      end;
      
      procedure YzDynArraySetZero(var A);
      var
        P: PLongint;  { 4个字节 }
      begin
        P := PLongint(A); { 指向 A 的地址 }
        Dec(P);  { P地址偏移量是 sizeof(A),指向了数组长度 }
        P^ := 0; { 数组长度清空 }
        Dec(P);  { 指向数组引用计数 }
        P^ := 0; { 数组计数清空 }
      end;
      
      { 动态设置分辨率 }
      function YzDynamicResolution(x, y: WORD): Boolean;
      var
        lpDevMode: TDeviceMode;
      begin
        Result := EnumDisplaySettings(nil, 0, lpDevMode);
        if Result then
        begin
          lpDevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
          lpDevMode.dmPelsWidth := x;
          lpDevMode.dmPelsHeight := y;
          Result := ChangeDisplaySettings(lpDevMode, 0) = DISP_CHANGE_SUCCESSFUL;
        end;
      end;
      
      procedure YzSetFontMapping;
      begin
        SetLength(FontMapping, 3);
      
        { 800 x 600 }
        FontMapping[0].SWidth := 800;
        FontMapping[0].SHeight := 600;
        FontMapping[0].FName := '宋体';
        FontMapping[0].FSize := 7;
      
        { 1024 x 768 }
        FontMapping[1].SWidth := 1024;
        FontMapping[1].SHeight := 768;
        FontMapping[1].FName := '宋体';
        FontMapping[1].FSize := 9;
      
        { 1280 x 1024 }
        FontMapping[2].SWidth := 1280;
        FontMapping[2].SHeight := 1024;
        FontMapping[2].FName := '宋体';
        FontMapping[2].FSize := 11;
      end;
      
      { 程序窗体及控件自适应分辨率(有问题) }
      procedure YzFixForm(AForm: TForm);
      var
        I, J: integer;
        T: TControl;
      begin
        with AForm do
        begin
          for I := 0 to ComponentCount - 1 do
          begin
            try
              T := TControl(Components[I]);
              T.left := Trunc(T.left * (Screen.width / 1024));
              T.top := Trunc(T.Top * (Screen.Height / 768));
              T.Width := Trunc(T.Width * (Screen.Width / 1024));
              T.Height := Trunc(T.Height * (Screen.Height / 768));
            except
            end; { try }
          end; { for I }
      
          for I:= 0 to Length(FontMapping) - 1 do
          begin
            if (Screen.Width = FontMapping[I].SWidth) and (Screen.Height =
              FontMapping[I].SHeight) then
            begin
              for J := 0 to ComponentCount - 1 do
              begin
                try
                  TFontedControl(Components[J]).Font.Name := FontMapping[I].FName;
                  TFontedControl(Components[J]).FONT.Size := FontMapping[I].FSize;
                except
                end; { try }
              end; { for J }
            end; { if }
          end; { for I }
        end; { with }
      end;
      
      { 检测系统屏幕分辨率 }
      function YzCheckDisplayInfo(X, Y: Integer): Boolean;
      begin
        Result := True;
        if (Screen.Width <> X) and (Screen.Height <> Y) then
        begin
          if MessageBox(Application.Handle, PChar( '系统检测到您的屏幕分辨率不是 '
            + IntToStr(X) + '×' + IntToStr(Y) + ',这将影响到系统的正常运行,'
            + '是否要自动调整屏幕分辨率?'), '提示', MB_YESNO + MB_ICONQUESTION
            + MB_TOPMOST) = 6 then YzDynamicResolution(1024, 768)
          else Result := False;
        end;
      end;
      
      function YzGetUninstallInfo: TUninstallInfo;
      const
        Key = '/SOFTWARE/Microsoft/Windows/CurrentVersion/Uninstall/';
      var
        S : TStrings;
        I : Integer;
        J : Integer;
      begin
        with TRegistry.Create do
        begin
          S := TStringlist.Create;
          J := 0;
          try
            RootKey:= HKEY_LOCAL_MACHINE;
            OpenKeyReadOnly(Key);
            GetKeyNames(S);
            Setlength(Result, S.Count);
            for I:= 0 to S.Count - 1 do
            begin
              If OpenKeyReadOnly(Key + S[I]) then
              If ValueExists('DisplayName') and ValueExists('UninstallString') then
              begin
                Result[J].RegProgramName:= S[I];
                Result[J].ProgramName:= ReadString('DisplayName');
                Result[J].UninstallPath:= ReadString('UninstallString');
                If ValueExists('Publisher') then
                  Result[J].Publisher:= ReadString('Publisher');
                If ValueExists('URLInfoAbout') then
                  Result[J].PublisherURL:= ReadString('URLInfoAbout');
                If ValueExists('DisplayVersion') then
                  Result[J].Version:= ReadString('DisplayVersion');
                If ValueExists('HelpLink') then
                  Result[J].HelpLink:= ReadString('HelpLink');
                If ValueExists('URLUpdateInfo') then
                  Result[J].UpdateInfoURL:= ReadString('URLUpdateInfo');
                If ValueExists('RegCompany') then
                  Result[J].RegCompany:= ReadString('RegCompany');
                If ValueExists('RegOwner') then
                  Result[J].RegOwner:= ReadString('RegOwner');
                Inc(J);
              end;
            end;
          finally
            Free;
            S.Free;
            SetLength(Result, J);
          end;
        end;
      end;
      
      { 检测Java安装信息 }
      function YzCheckJavaInfo(AUninstallInfo: TUninstallInfo;CheckJava6 : Boolean = False): Boolean;
      var
        I: Integer;
        Java6Exist: Boolean;
        AUninstall: TUninstallInfo;
        AProgramList: TStringList;
        AJavaVersion, AFilePath: string;
      begin
        Result := True;
        Java6Exist := False;
        AJavaVersion := 'J2SE Runtime Environment 5.0 Update 14';
        AUninstall := YzGetUninstallInfo;
        AProgramList := TStringList.Create;
        for I := Low(AUninstall) to High(AUninstall) do
        begin
          if Pos('J2SE', AUninstall[I].ProgramName) <> 0 then
            AProgramList.Add(AUninstall[I].ProgramName);
          if Pos('Java(TM)', AUninstall[I].ProgramName) <> 0 then
            Java6Exist := True;
        end;
        if Java6Exist then
        begin
          if CheckJava6 then
          begin
            MessageBox(Application.Handle, '系统检测到您机器上安装了Java6以上的版本,'
              + '如果影响到系统的正常运行请先将其卸载再重新启动系统!', '提示',
              MB_OK + MB_ICONINFORMATION + MB_TOPMOST);
            Result := False;
          end;
        end
        else if AProgramList.Count = 0 then
        begin
          MessageBox(Application.Handle, '系统检测到您机器上没有安装Java运行环境,'
            + '请点击 "确定" 安装Java运行环境后再重新运行程序!',
            '提示', MB_OK + MB_ICONINFORMATION + MB_TOPMOST);
      
          AFilePath := ExtractFilePath(ParamStr(0)) + 'java' + '/'
            + 'jre-1_5_0_14-windows-i586-p.exe';
          if FileExists(AFilePath) then  WinExec(PChar(AFilePath), SW_SHOWNORMAL)
          else
            MessageBox(Application.Handle, '找不到Java安装文件,请您手动安装!',
              '提示', MB_OK + MB_ICONINFORMATION  + MB_TOPMOST);
          Result := False;
        end;
        AProgramList.Free;
      end;
      
      {-------------------------------------------------------------
        功能:    窗口自适应屏幕大小
        参数:    Form: 需要调整的Form
                 OrgWidth:开发时屏幕的宽度
                 OrgHeight:开发时屏幕的高度
      --------------------------------------------------------------}
      procedure YzAdjustForm(Form: TForm;const OrgWidth, OrgHeight: integer);
      begin
        with Form do
        begin
          if (Screen.width <> OrgWidth) then
          begin
            Scaled := True;
            Height := longint(Height) * longint(Screen.height) div OrgHeight;
            Width := longint(Width) * longint(Screen.Width) div OrgWidth;
            ScaleBy(Screen.Width, OrgWidth);
          end;
        end;
      end;
      
      { 设置窗口为当前窗体 }
      procedure YzBringMyAppToFront(AppHandle: THandle);
      var
        Th1, Th2: Cardinal;
      begin
        Th1 := GetCurrentThreadId;
        Th2 := GetWindowThreadProcessId(GetForegroundWindow, NIL);
        AttachThreadInput(Th2, Th1, TRUE);
        try
          SetForegroundWindow(AppHandle);
        finally
          AttachThreadInput(Th2, Th1, TRUE);
        end;
      end;
      
      { 获取文件夹文件数量 }
      function YzGetDirFiles(Dir: string;SubDir: Boolean): LongInt;
      var
        SearchRec: TSearchRec;
        Founded: integer;
      begin
        Result := 0;
        if Dir[length(Dir)] <> '/' then Dir := Dir + '/';
        Founded := FindFirst(Dir + '*.*', faAnyFile, SearchRec);
        while Founded = 0 do
        begin
          Inc(Result);
          if (SearchRec.Attr and faDirectory > 0) and (SearchRec.Name[1] <> '.') and
            (SubDir = True) then
            Inc(Result, YzGetDirFiles(Dir + SearchRec.Name, True));
            Founded := FindNext(SearchRec);
        end;
        FindClose(SearchRec);
      end;
      
      { 算术舍入法的四舍五入取整函数 }
      function YzRoundEx (const Value: Real): LongInt;
      var
        x: Real;
      begin
        x := Value - Trunc(Value);
        if x >= 0.5 then
          Result := Trunc(Value) + 1
        else Result := Trunc(Value);
      end;
      
      { 获取文件大小(KB) }
      function YzGetFileSize(const FileName: String): LongInt;
      var
        SearchRec: TSearchRec;
      begin
        if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
          Result := SearchRec.Size
        else
          Result := -1;
        Result := YzRoundEx(Result / 1024);
      end;
      
      { 获取文件大小(字节) }
      function YzGetFileSize_Byte(const FileName: String): LongInt;
      var
        SearchRec: TSearchRec;
      begin
        if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
          Result := SearchRec.Size
        else
          Result := -1;
      end;
      
      { 获取文件夹大小 }
      function YzGetDirSize(Dir: string;SubDir: Boolean): LongInt;
      var
        SearchRec: TSearchRec;
        Founded: integer;
      begin
        Result := 0;
        if Dir[length(Dir)] <> '/' then Dir := Dir + '/';
        Founded := FindFirst(Dir + '*.*', faAnyFile, SearchRec);
        while Founded = 0 do
        begin
          Inc(Result, SearchRec.size);
          if (SearchRec.Attr and faDirectory > 0) and (SearchRec.Name[1] <> '.') and
            (SubDir = True) then
            Inc(Result, YzGetDirSize(Dir + SearchRec.Name, True));
            Founded := FindNext(SearchRec);
        end;
        FindClose(SearchRec);
        Result := YzRoundEx(Result / 1024);
      end;
      
      {-------------------------------------------------------------
        功能:    弹出选择目录对话框
        参数:    const iMode: 选择模式
                 const sInfo: 对话框提示信息
        返回值:  如果取消取返回为空,否则返回选中的路径
      --------------------------------------------------------------}
      function YzSelectDir(const iMode: integer;const sInfo: string): string;
      var
        Info: TBrowseInfo;
        IDList: pItemIDList;
        Buffer: PChar;
      begin
        Result:='';
        Buffer := StrAlloc(MAX_PATH);
        with Info do
        begin
          hwndOwner := application.mainform.Handle;  { 目录对话框所属的窗口句柄 }
          pidlRoot := nil;                           { 起始位置,缺省为我的电脑 }
          pszDisplayName := Buffer;                  { 用于存放选择目录的指针 }
          lpszTitle := PChar(sInfo);
          { 此处表示显示目录和文件,如果只显示目录则将后一个去掉即可 }
          if iMode = 1 then
            ulFlags := BIF_RETURNONLYFSDIRS or BIF_BROWSEINCLUDEFILES
          else
            ulFlags := BIF_RETURNONLYFSDIRS;
          lpfn := nil;                               { 指定回调函数指针 }
          lParam := 0;                               { 传递给回调函数参数 }
          IDList := SHBrowseForFolder(Info);         { 读取目录信息 }
        end;
        if IDList <> nil then
        begin
          SHGetPathFromIDList(IDList, Buffer);     { 将目录信息转化为路径字符串 }
          Result := strpas(Buffer);
        end;
        StrDispose(buffer);
      end;
      
      { 获取指定路径下文件夹的个数 }
      procedure YzListFolders(const Path: String; const ShowPath: Boolean;var List: TStrings);
      var
        SRec: TSearchRec;
      begin
       if not Assigned(List) then List:= TStringList.Create;
       FindFirst(Path + '*.*', faDirectory, SRec);
       if ShowPath then
          List.Add(Path + SRec.Name)
       else
          List.Add(SRec.Name);
       while FindNext(SRec) = 0 do
          if ShowPath then
             List.Add(Path + SRec.Name)
          else
             List.Add(SRec.Name);
       FindClose(SRec);
      end;
      
      { 禁用窗器控件的所有子控件 }
      procedure YzSetSubCtlState(AOwer: TWinControl;AState: Boolean);
      var
        I: Integer;
      begin
        for I := 0 to AOwer.ControlCount - 1 do
         AOwer.Controls[I].Enabled := AState;
      end;
      
      { 模拟键盘按键操作(处理字节码) }
      procedure YzFKeyent(byteCard: byte);
      var
        vkkey: integer;
      begin
        vkkey := VkKeyScan(chr(byteCard));
        if (chr(byteCard) in ['A'..'Z']) then
        begin
          keybd_event(VK_SHIFT, 0, 0, 0);
          keybd_event(byte(byteCard), 0, 0, 0);
          keybd_event(VK_SHIFT, 0, 2, 0);
        end
        else if chr(byteCard) in ['!', '@', '#', '$', '%', '^', '&', '*', '(', ')',
          '_', '+', '|', '{', '}', ':', '"', '<', '>', '?', '~'] then
        begin
          keybd_event(VK_SHIFT, 0, 0, 0);
          keybd_event(byte(vkkey), 0, 0, 0);
          keybd_event(VK_SHIFT, 0, 2, 0);
        end
        else { if byteCard in [8,13,27,32] }
        begin
          keybd_event(byte(vkkey), 0, 0, 0);
        end;
      end;
      
      { 模拟键盘按键(处理字符) }
      procedure YzFKeyent(strCard: string);
      var
        str: string;
        strLength: integer;
        I: integer;
        byteSend: byte;
      begin
        str := strCard;
        strLength := length(str);
        for I := 1 to strLength do
        begin
          byteSend := byte(str[I]);
          YzFKeyent(byteSend);
        end;
      end;
      
      { 锁定窗口位置 }
      procedure YzLockWindow(ClassName,WinName: PChar;poX,poY: Integer);
      var
        CurWindow: THandle;
        _wndRect: TRect;
      begin
        CurWindow := 0;
        while True do
        begin
          CurWindow := FindWindow(ClassName,WinName);
          if CurWindow <> 0 then Break;
          YzDelayTime(10);
          Application.ProcessMessages;
        end;
        GetWindowRect(CurWindow,_wndRect);
        if ( _wndRect.Left <> poX) or ( _wndRect.Top <> poY) then
        begin
             MoveWindow(CurWindow,
             poX,
             poY,
             (_wndRect.Right-_wndRect.Left),
             (_wndRect.Bottom-_wndRect.Top),
              TRUE);
        end;
        YzDelayTime(1000);
      end;
      
      {
        注册一个DLL形式或OCX形式的OLE/COM控件
        参数strOleFileName为一个DLL或OCX文件名,
        参数OleAction表示注册操作类型,1表示注册,0表示卸载
        返回值True表示操作执行成功,False表示操作执行失败
      }
      function YzRegisterOleFile (strOleFileName: STRING;OleAction: Byte): BOOLEAN;
      const
        RegisterOle   =   1; { 注册 }
        UnRegisterOle =   0; { 卸载 }
      type
        TOleRegisterFunction = function: HResult; { 注册或卸载函数的原型 }
      var
        hLibraryHandle: THandle;    { 由LoadLibrary返回的DLL或OCX句柄 }
        hFunctionAddress: TFarProc; { DLL或OCX中的函数句柄,由GetProcAddress返回 }
        RegFunction: TOleRegisterFunction; { 注册或卸载函数指针 }
      begin
        Result := FALSE;
        { 打开OLE/DCOM文件,返回的DLL或OCX句柄 }
        hLibraryHandle := LoadLibrary(PCHAR(strOleFileName));
        if (hLibraryHandle > 0) then        { DLL或OCX句柄正确 }
        try
          { 返回注册或卸载函数的指针 }
          if (OleAction = RegisterOle) then { 返回注册函数的指针 }
            hFunctionAddress := GetProcAddress(hLibraryHandle, pchar('DllRegisterServer'))
          { 返回卸载函数的指针 }
          else
            hFunctionAddress := GetProcAddress(hLibraryHandle, pchar('DllUnregisterServer'));
          if (hFunctionAddress <> NIL) then { 注册或卸载函数存在 }
          begin
            { 获取操作函数的指针 }
            RegFunction := TOleRegisterFunction(hFunctionAddress);
            { 执行注册或卸载操作,返回值>=0表示执行成功 }
            if RegFunction >= 0 then
              Result   :=   true;
          end;
        finally
          { 关闭已打开的OLE/DCOM文件 }
          FreeLibrary(hLibraryHandle);
        end;
      end;
      
      function YzListViewColumnCount(mHandle: THandle): Integer;
      begin
        Result := Header_GetItemCount(ListView_GetHeader(mHandle));
      end; { ListViewColumnCount }
      
      function YzGetListViewText(mHandle: THandle; mStrings: TStrings): Boolean;
      var
        vColumnCount: Integer;
        vItemCount: Integer;
        I, J: Integer;
        vBuffer: array[0..255] of Char;
        vProcessId: DWORD;
        vProcess: THandle;
        vPointer: Pointer;
        vNumberOfBytesRead: Cardinal;
        S: string;  vItem: TLVItem;
      begin
        Result := False;
        if not Assigned(mStrings) then Exit;
        vColumnCount := YzListViewColumnCount(mHandle);
        if vColumnCount <= 0 then Exit;
        vItemCount := ListView_GetItemCount(mHandle);
        GetWindowThreadProcessId(mHandle, @vProcessId);
        vProcess := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ
          or  PROCESS_VM_WRITE, False, vProcessId);
        vPointer := VirtualAllocEx(vProcess, nil, 4096, MEM_RESERVE or MEM_COMMIT,
          PAGE_READWRITE);
        mStrings.BeginUpdate;
        try
          mStrings.Clear;
          for I := 0 to vItemCount - 1 do
          begin
            S := '';
            for J := 0 to vColumnCount - 1 do
            begin
              with vItem do
              begin
                mask := LVIF_TEXT;
                iItem := I;
                iSubItem := J;
                cchTextMax := SizeOf(vBuffer);
                pszText := Pointer(Cardinal(vPointer) + SizeOf(TLVItem));
              end;
              WriteProcessMemory(vProcess, vPointer, @vItem,
              SizeOf(TLVItem), vNumberOfBytesRead);
              SendMessage(mHandle, LVM_GETITEM, I, lparam(vPointer));
              ReadProcessMemory(vProcess, Pointer(Cardinal(vPointer) + SizeOf(TLVItem)),
                @vBuffer[0], SizeOf(vBuffer), vNumberOfBytesRead);
              S := S + #9 + vBuffer;
            end;
            Delete(S, 1, 1);
            mStrings.Add(S);
          end;
        finally
          VirtualFreeEx(vProcess, vPointer, 0, MEM_RELEASE);
          CloseHandle(vProcess);    mStrings.EndUpdate;
        end;
        Result := True;
      end; { GetListViewText }
      
      { 删除目录树 }
      function YzDeleteDirectoryTree(Path: string): boolean;
      var
        SearchRec: TSearchRec;
        SFI: string;
      begin
        Result := False;
        if (Path = '') or (not DirectoryExists(Path)) then exit;
        if Path[length(Path)] <> '/' then Path := Path + '/';
        SFI := Path + '*.*';
        if FindFirst(SFI, faAnyFile, SearchRec) = 0 then
        begin
          repeat
            begin
              if (SearchRec.Name = '.') or (SearchRec.Name = '..') then
                Continue;
              if (SearchRec.Attr and faDirectory <> 0) then
              begin
                if not YzDeleteDirectoryTree(Path + SearchRec.name) then
                  Result := FALSE;
              end
              else
              begin
                FileSetAttr(Path + SearchRec.Name, 128);
                DeleteFile(Path + SearchRec.Name);
              end;
            end
          until FindNext(SearchRec) <> 0;
          FindClose(SearchRec);
        end;
        FileSetAttr(Path, 0);
        if RemoveDir(Path) then
          Result := TRUE
        else
          Result := FALSE;
      end;
      
      { Jpg格式转换为bmp格式 }
      function JpgToBmp(Jpg: TJpegImage): TBitmap;
      begin
        Result := nil;
        if Assigned(Jpg) then
        begin
          Result := TBitmap.Create;
          Jpg.DIBNeeded;
          Result.Assign(Jpg);
        end;
      end;
      
      { 设置程序自启动函数 }
      function YzSetAutoRun(AFilePath: string;AFlag: Boolean): boolean;
      var
        AMainFName: string;
        Reg: TRegistry;
      begin
        Result := true;
        AMainFName := YzGetMainFileName(AFilePath);
        Reg := TRegistry.Create;
        Reg.RootKey := HKEY_LOCAL_MACHINE;
        try
          Reg.OpenKey('SOFTWARE/Microsoft/Windows/CurrentVersion/Run', True);
          if AFlag = False then  { 取消自启动 }
            Reg.DeleteValue(AMainFName)
          else                   { 设置自启动 }
            Reg.WriteString(AMainFName, '"' + AFilePath + '"')
        except
          Result := False;
        end;
        Reg.CloseKey;
        Reg.Free;
      end;
      
      { 检测URL地址是否有效 }
      function YzCheckUrl(url: string): Boolean;
      var
        hSession, hfile, hRequest: HINTERNET;
        dwindex, dwcodelen: dword;
        dwcode: array[1..20] of Char;
        res: PChar;
      begin
        Result := False;
        try
          if Pos('http://',LowerCase(url)) = 0 then url := 'http://' + url;
          { Open an internet session }
          hSession:=InternetOpen('InetURL:/1.0',INTERNET_OPEN_TYPE_PRECONFIG,nil,nil, 0);
          if Assigned(hsession) then
          begin
            hfile := InternetOpenUrl(hsession, PChar(url), nil, 0,INTERNET_FLAG_RELOAD, 0);
            dwIndex := 0;
            dwCodeLen := 10;
            HttpQueryInfo(hfile,HTTP_QUERY_STATUS_CODE,@dwcode,dwcodeLen,dwIndex);
            res := PChar(@dwcode);
            Result := (res = '200') or (res = '302');
            if Assigned(hfile) then InternetCloseHandle(hfile);
            InternetCloseHandle(hsession);
          end;
        except
        end;
      end;
      
      { 获取程序可执行文件名 }
      function YzGetExeFName: string;
      begin
        Result := ExtractFileName(Application.ExeName);
      end;
      
      { 目录浏览对话框函数 }
      function YzBrowseFolder(AOwer: TWinControl;ATitle: string):string;
      var
        Info: TBrowseInfo;
        Dir: array[0..260] of char;
        ItemId: PItemIDList;
      begin
        with Info do
        begin
          hwndOwner := AOwer.Handle;
          pidlRoot := nil;
          pszDisplayName := nil;
          lpszTitle := PChar(ATitle);
          ulFlags := 0;
          lpfn := nil;
          lParam := 0;
          iImage := 0;
        end;
        ItemId := SHBrowseForFolder(Info);
        SHGetPathFromIDList(ItemId,@Dir);
        Result := string(Dir);
      end;
      
      { 重启计算机 }
      function YzShutDownSystem(AFlag: Integer):BOOL;
      var
        hProcess,hAccessToken: THandle;
        LUID_AND_ATTRIBUTES: TLUIDAndAttributes;
        TOKEN_PRIVILEGES: TTokenPrivileges;
        BufferIsNull: DWORD;
      Const
        SE_SHUTDOWN_NAME='SeShutdownPrivilege';
      begin
        hProcess:=GetCurrentProcess();
      
        OpenProcessToken(hprocess, TOKEN_ADJUST_PRIVILEGES+TOKEN_QUERY, hAccessToken);
        LookupPrivilegeValue(Nil, SE_SHUTDOWN_NAME, LUID_AND_ATTRIBUTES.Luid);
        LUID_AND_ATTRIBUTES.Attributes := SE_PRIVILEGE_ENABLED;
        TOKEN_PRIVILEGES.PrivilegeCount := 1;
        TOKEN_PRIVILEGES.Privileges[0] := LUID_AND_ATTRIBUTES;
        BufferIsNull := 0;
      
        AdjustTokenPrivileges(hAccessToken, False, TOKEN_PRIVILEGES, sizeof(
          TOKEN_PRIVILEGES) ,Nil, BufferIsNull);
        Result := ExitWindowsEx(AFlag, 0);
      end;
      
      { 程序运行后删除自身 }
      procedure YzDeleteSelf;
      var
        hModule: THandle;
        buff:    array[0..255] of Char;
        hKernel32: THandle;
        pExitProcess, pDeleteFileA, pUnmapViewOfFile: Pointer;
      begin
        hModule := GetModuleHandle(nil);
        GetModuleFileName(hModule, buff, sizeof(buff));
      
        CloseHandle(THandle(4));
      
        hKernel32        := GetModuleHandle('KERNEL32');
        pExitProcess     := GetProcAddress(hKernel32, 'ExitProcess');
        pDeleteFileA     := GetProcAddress(hKernel32, 'DeleteFileA');
        pUnmapViewOfFile := GetProcAddress(hKernel32, 'UnmapViewOfFile');
      
        asm
          LEA         EAX, buff
          PUSH        0
          PUSH        0
          PUSH        EAX
          PUSH        pExitProcess
          PUSH        hModule
          PUSH        pDeleteFileA
          PUSH        pUnmapViewOfFile
          RET
        end;
      end;
      
      { 程序重启 }
      procedure YzAppRestart;
      var
        AppName : PChar;
      begin
        AppName := PChar(Application.ExeName) ;
        ShellExecute(Application.Handle,'open', AppName, nil, nil, SW_SHOWNORMAL);
        KillByPID(GetCurrentProcessId);
      end;
      
      { 压缩Access数据库 }
      function YzCompactAccessDB(const AFileName, APassWord: string): Boolean;
      var
        SPath, FConStr, TmpConStr: string;
        SFile: array[0..254] of Char;
        STempFileName: string;
        JE: OleVariant;
        function GetTempDir: string;
        var
          Buffer: array[0..MAX_PATH] of Char;
        begin
          ZeroMemory(@Buffer, MAX_PATH);
          GetTempPath(MAX_PATH, Buffer);
          Result := IncludeTrailingBackslash(StrPas(Buffer));
        end;
      begin
        Result := False;
        SPath := GetTempDir;  { 取得Windows的Temp路径 }
      
        { 取得Temp文件名,Windows将自动建立0字节文件 }
        GetTempFileName(PChar(SPath), '~ACP', 0, SFile);
        STempFileName := SFile;
      
        { 删除Windows建立的0字节文件 }
        if not DeleteFile(STempFileName) then Exit;
        try
          JE := CreateOleObject('JRO.JetEngine');
      
          { 压缩数据库 }
          FConStr := 'Provider=Microsoft.Jet.OLEDB.4.0;' + 'Data Source=' + AFileName
            + ';Jet OLEDB:DataBase PassWord=' + APassWord;
      
          TmpConStr := 'Provider=Microsoft.Jet.OLEDB.4.0;' + 'Data Source=' + STempFileName
            + ';Jet OLEDB:DataBase PassWord=' + APassWord;
          JE.CompactDatabase(FConStr, TmpConStr);
      
          { 覆盖源数据库文件 }
          Result := CopyFile(PChar(STempFileName), PChar(AFileName), False);
      
          { 删除临时文件 }
          DeleteFile(STempFileName);
        except
          Application.MessageBox('压缩数据库失败!', '提示', MB_OK +
            MB_ICONINFORMATION);
        end;
      end;
      
      { 标题:获取其他进程中TreeView的文本 }
      function YzTreeNodeGetNext(mHandle: THandle; mTreeItem: HTreeItem): HTreeItem;
      var
        vParentID: HTreeItem;
      begin
        Result := nil;
        if (mHandle <> 0) and (mTreeItem <> nil) then
        begin
          Result := TreeView_GetChild(mHandle, mTreeItem);
          if Result = nil then
            Result := TreeView_GetNextSibling(mHandle, mTreeItem);
          vParentID := mTreeItem;
          while (Result = nil) and (vParentID <> nil) do
          begin
            vParentID := TreeView_GetParent(mHandle, vParentID);
            Result := TreeView_GetNextSibling(mHandle, vParentID);
          end;
        end;
      end; { TreeNodeGetNext }
      
      function YzTreeNodeGetLevel(mHandle: THandle; mTreeItem: HTreeItem): Integer;
      var
        vParentID: HTreeItem;
      begin
        Result := -1;
        if (mHandle <> 0) and (mTreeItem <> nil) then
        begin
          vParentID := mTreeItem;
          repeat
            Inc(Result);
            vParentID := TreeView_GetParent(mHandle, vParentID);
          until vParentID = nil;
        end;
      end; { TreeNodeGetLevel }
      
      function YzGetTreeViewText(mHandle: THandle; mStrings: TStrings): Boolean;
      var
        vItemCount: Integer;
        vBuffer: array[0..255] of Char;
        vProcessId: DWORD;
        vProcess: THandle;
        vPointer: Pointer;
        vNumberOfBytesRead: Cardinal;
        I: Integer;
        vItem: TTVItem;
        vTreeItem: HTreeItem;
      begin
        Result := False;
        if not Assigned(mStrings) then Exit;
        GetWindowThreadProcessId(mHandle, @vProcessId);
        vProcess := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or
          PROCESS_VM_WRITE, False, vProcessId);
        vPointer := VirtualAllocEx(vProcess, nil, 4096, MEM_RESERVE or
          MEM_COMMIT, PAGE_READWRITE);
        mStrings.BeginUpdate;
        try
          mStrings.Clear;
          vItemCount := TreeView_GetCount(mHandle);
          vTreeItem := TreeView_GetRoot(mHandle);
          for I := 0 to vItemCount - 1 do
          begin
            with vItem do begin
              mask := TVIF_TEXT; cchTextMax := SizeOf(vBuffer);
              pszText := Pointer(Cardinal(vPointer) + SizeOf(vItem));
              hItem := vTreeItem;
            end;
            WriteProcessMemory(vProcess, vPointer, @vItem, SizeOf(vItem),
              vNumberOfBytesRead);
            SendMessage(mHandle, TVM_GETITEM, 0, lparam(vPointer));
            ReadProcessMemory(vProcess, Pointer(Cardinal(vPointer) + SizeOf(TLVItem)),
            @vBuffer[0], SizeOf(vBuffer), vNumberOfBytesRead);
            mStrings.Add(StringOfChar(#9, YzTreeNodeGetLevel(mHandle, vTreeItem)) + vBuffer);
            vTreeItem := YzTreeNodeGetNext(mHandle, vTreeItem);
          end;
        finally
          VirtualFreeEx(vProcess, vPointer, 0, MEM_RELEASE);
          CloseHandle(vProcess); mStrings.EndUpdate;
        end;
        Result := True;
      end; { GetTreeViewText }
      
      { 获取其他进程中ListBox和ComboBox的内容 }
      function YzGetListBoxText(mHandle: THandle; mStrings: TStrings): Boolean;
      var
        vItemCount: Integer;
        I: Integer;
        S: string;
      begin
        Result := False;
        if not Assigned(mStrings) then Exit;
        mStrings.BeginUpdate;
        try
          mStrings.Clear;
          vItemCount := SendMessage(mHandle, LB_GETCOUNT, 0, 0);
          for I := 0 to vItemCount - 1 do
          begin
            SetLength(S, SendMessage(mHandle, LB_GETTEXTLEN, I, 0));
            SendMessage(mHandle, LB_GETTEXT, I, Integer(@S[1]));
            mStrings.Add(S);
          end;
          SetLength(S, 0);
        finally
          mStrings.EndUpdate;
        end;
        Result := True;
      end; { GetListBoxText }
      
      function YzGetComboBoxText(mHandle: THandle; mStrings: TStrings): Boolean;
      var
        vItemCount: Integer;
        I: Integer;
        S: string;
      begin
        Result := False;
        if not Assigned(mStrings) then Exit;
        mStrings.BeginUpdate;
        try
          mStrings.Clear;
          vItemCount := SendMessage(mHandle, CB_GETCOUNT, 0, 0);
          for I := 0 to vItemCount - 1 do
          begin
            SetLength(S, SendMessage(mHandle, CB_GETLBTEXTLEN, I, 0));
            SendMessage(mHandle, CB_GETLBTEXT, I, Integer(@S[1]));
            mStrings.Add(S);
          end;
          SetLength(S, 0);
        finally
          mStrings.EndUpdate;
        end;
        Result := True;
      end; { GetComboBoxText }
      
      { 获取本地Application Data目录路径 }
      function YzLocalAppDataPath : string;
      const
         SHGFP_TYPE_CURRENT = 0;
      var
         Path: array [0..MAX_PATH] of char;
      begin
         SHGetFolderPath(0, CSIDL_LOCAL_APPDATA, 0, SHGFP_TYPE_CURRENT, @path[0]) ;
         Result := Path;
      end;
      
      { 获取Windows当前登录的用户名 }
      function YzGetWindwosUserName: String;
      var
        pcUser: PChar;
        dwUSize: DWORD;
      begin
        dwUSize := 21;
        result  := '';
        GetMem(pcUser, dwUSize);
        try
          if Windows.GetUserName(pcUser, dwUSize) then
            Result := pcUser
        finally
          FreeMem(pcUser);
        end;
      end;
      
      {-------------------------------------------------------------
        功  能:  delphi 枚举托盘图标
        参  数:  AFindList: 返回找到的托盘列表信息
        返回值:  成功为True,反之为False
        备  注:  返回的格式为: 位置_名称_窗口句柄_进程ID
      --------------------------------------------------------------}
      function YzEnumTrayNotifyWnd(AFindList: TStringList;ADestStr: string): BOOL;
      var
        wd: HWND;
        wtd: HWND;
        wd1: HWND;
        pid: DWORD;
        hd: THandle;
        num, i: integer;
        n: ULONG;
        p: TTBBUTTON;
        pp: ^TTBBUTTON;
        x: string;
        name: array[0..255] of WCHAR;
        whd, proid: ulong;
        temp: string;
        sp: ^TTBBUTTON;
        _sp: TTBButton;
      begin
        Result := False;
        wd := FindWindow('Shell_TrayWnd', nil);
        if (wd = 0) then Exit;
      
        wtd := FindWindowEx(wd, 0, 'TrayNotifyWnd', nil);
        if (wtd = 0) then Exit;
      
        wtd := FindWindowEx(wtd, 0, 'SysPager', nil);
        if (wtd = 0) then Exit;
      
        wd1 := FindWindowEx(wtd, 0, 'ToolbarWindow32', nil);
        if (wd1 = 0) then Exit;
      
        pid := 0;
        GetWindowThreadProcessId(wd1, @pid);
        if (pid = 0) then Exit;
      
        hd := OpenProcess(PROCESS_ALL_ACCESS, true, pid);
        if (hd = 0) then Exit;
        num := SendMessage(wd1, TB_BUTTONCOUNT, 0, 0);
        sp := @_sp;
        for i := 0 to num do
        begin
          SendMessage(wd1, TB_GETBUTTON, i, integer(sp));
          pp := @p;
          ReadProcessMemory(hd, sp, pp, sizeof(p), n);
          name[0] := Char(0);
          if (Cardinal(p.iString) <> $FFFFFFFF) then
          begin
            try
              ReadProcessMemory(hd, pointer(p.iString), @name, 255, n);
              name[n] := Char(0);
            except
            end;
            temp := name;
            try
              whd := 0;
              ReadProcessMemory(hd, pointer(p.dwData), @whd, 4, n);
            except
            end;
            proid := 0;
            GetWindowThreadProcessId(whd, @proid);
            AFindList.Add(Format('%d_%s_%x_%x', [i, temp, whd, proid]));
            if CompareStr(temp, ADestStr) = 0 then Result := True;
          end;
        end;
      end;
      
      { 获取SQL Server用户数据库列表 }
      procedure YzGetSQLServerDBList(ADBHostIP, ALoginPwd: string;ADBList: TStringList);
      var
        PQuery: TADOQuery;
        ConnectStr: string;
      begin
        ConnectStr := 'Provider=SQLOLEDB.1;Password=' + ALoginPwd
          + ';Persist Security Info=True;User ID=sa;Initial Catalog=master'
          + ';Data Source=' + ADBHostIP;
        ADBList.Clear;
        PQuery := TADOQuery.Create(nil);
        try
          PQuery.ConnectionString := ConnectStr;
          PQuery.SQL.Text:='select name from sysdatabases where dbid > 6';
          PQuery.Open;
          while not PQuery.Eof do
          begin
            ADBList.add(PQuery.Fields[0].AsString);
            PQuery.Next;
          end;
        finally
          PQuery.Free;
        end;
      end;
      
      { 检测数据库中是否存在给定的表 }
      procedure YzGetTableList(ConncetStr: string;ATableList: TStringList);
      var
        FConnection: TADOConnection;
      begin
        FConnection := TADOConnection.Create(nil);
        try
          FConnection.LoginPrompt := False;
          FConnection.Connected := False;
          FConnection.ConnectionString := ConncetStr;
          FConnection.Connected := True;
          FConnection.GetTableNames(ATableList, False);
        finally
          FConnection.Free;
        end;
      end;
      
      { 将域名解释成IP地址 }
      function YzDomainToIP(HostName: string): string;
      type
        tAddr = array[0..100] of PInAddr;
        pAddr = ^tAddr;
      var
        I: Integer;
        WSA: TWSAData;
        PHE: PHostEnt;
        P: pAddr;
      begin
        Result := '';
        WSAStartUp($101, WSA);
        try
          PHE := GetHostByName(pChar(HostName));
          if (PHE <> nil) then
          begin
            P := pAddr(PHE^.h_addr_list);
            I := 0;
            while (P^[I] <> nil) do
            begin
              Result := (inet_nToa(P^[I]^));
              Inc(I);
            end;
          end;
        except
        end;
        WSACleanUp;
      end;
      
      { 移去系统托盘失效图标 }
      procedure YzRemoveDeadIcons();
      var
        hTrayWindow: HWND;
        rctTrayIcon: TRECT;
        nIconWidth, nIconHeight:integer;
        CursorPos: TPoint;
        nRow, nCol: Integer;
      Begin
        //Get tray window handle and bounding rectangle
        hTrayWindow := FindWindowEx(FindWindow('Shell_TrayWnd ', nil), 0, 'TrayNotifyWnd ', nil);
        if Not (GetWindowRect(hTrayWindow, rctTrayIcon)) then Exit;
        //Get small icon metrics
        nIconWidth := GetSystemMetrics(SM_CXSMICON);
        nIconHeight := GetSystemMetrics(SM_CYSMICON);
        //Save current mouse position   }
        GetCursorPos(CursorPos);
        //Sweep the mouse cursor over each icon in the tray in both dimensions
        for nRow := 0 To ((rctTrayIcon.bottom - rctTrayIcon.top) div nIconHeight) Do
        Begin
          for nCol := 0 To ((rctTrayIcon.right - rctTrayIcon.left) div nIconWidth) Do
          Begin
            SetCursorPos(rctTrayIcon.left + nCol * nIconWidth + 5,
              rctTrayIcon.top + nRow * nIconHeight + 5);
            Sleep(0);
          end;
        end;
        //Restore mouse position
        SetCursorPos(CursorPos.x, CursorPos.x);
        //Redraw tray window(to fix bug in multi-line tray area)
        RedrawWindow(hTrayWindow, nil, 0, RDW_INVALIDATE Or RDW_ERASE Or RDW_UPDATENOW);
      end;
      
      { 转移程序占用内存至虚拟内存 }
      procedure YzClearMemory;
      begin
        if Win32Platform = VER_PLATFORM_WIN32_NT then
        begin
          SetProcessWorkingSetSize(GetCurrentProcess, $FFFFFFFF, $FFFFFFFF);
          Application.ProcessMessages;
        end;
      end;
      
      { 检测允许试用的天数是否已到期 }
      function YzCheckTrialDays(AllowDays: Integer): Boolean;
      var
        Reg_ID, Pre_ID: TDateTime;
        FRegister: TRegistry;
      begin
        { 初始化为试用没有到期 }
        Result := True;
        FRegister := TRegistry.Create;
        try
          with FRegister do
          begin
            RootKey := HKEY_LOCAL_MACHINE;
            if OpenKey('Software/Microsoft/Windows/CurrentSoftware/'
              + YzGetMainFileName(Application.ExeName), True) then
            begin
              if ValueExists('DateTag') then
              begin
                Reg_ID := ReadDate('DateTag');
                if Reg_ID = 0 then Exit;
                Pre_ID := ReadDate('PreDate');
                { 允许使用的时间到 }
                if ((Reg_ID <> 0) and (Now - Reg_ID > AllowDays)) or
                  (Pre_ID <> Reg_ID) or (Reg_ID > Now) then
                begin
                  { 防止向前更改日期 }
                  WriteDateTime('PreDate', Now + 20000);
                  Result := False;
                end;
              end
              else
              begin
                { 首次运行时保存初始化数据 }
                WriteDateTime('PreDate', Now);
                WriteDateTime('DateTag', Now);
              end;
            end;
          end;
        finally
          FRegister.Free;
        end;
      end;
      
      { 指定长度的随机小写字符串函数 }
      function YzRandomStr(aLength: Longint): string;
      var
        X: Longint;
      begin
        if aLength <= 0 then exit;
        SetLength(Result, aLength);
        for X := 1 to aLength do
          Result[X] := Chr(Random(26) + 65);
        Result := LowerCase(Result);
      end;
      
      end.
      
      
      

      阅读剩余部分...

    • DELPHI实现关机,兼容全部WINDOWS系统

    • {=======================================================================================================================
      关闭Windows函数ExitWindowsEx(UINT uFlag,DWORD:dwReserved)说明:

      控制WINDOWS的开关:如关闭WINDOWS,重新启动WINDOWS等, ExitWindowsEx(UINT uFlags,DWORD dwReserved);是实现这一功能的API函数。如果Complile时提示EWX_XXXX未定义,那么请手动定义这几个常数,默认情况下是无需我们手动定义的。
      const
      EWX_FORCE=4; //关闭所有程序并以其他用户身份登录?(!!应为“强制执行否”吧!!)
      EWX_LOGOFF=0; //重新启动计算机并切换到MS-DOS方式
      EWX_REBOOT=2; //重新启动计算机
      EWX_SHUTDOWN=1;//关闭计算机
      EWX_POWEROFF=8;//切断电源
      EWX_FORCEIFHUNG=$10;//不记得了,有谁好心查下MSDN
      调用方法:
      ExitWindowsEx(EWX_REBOOT,0); //重启计算机
      ExitWindowsEx(EWX_FORCE+EWX_SHUTDOWN,0); //强行关机
      不过博主经常听到有人说这一API只在Windows 95/98/98SE/Me下有效,而在Windows NT/2000/XP下无效。
      其实这是不正确的,这一API在上述平台下均是有效的,只是我们在Windows NT/2000/XP平台下执行此函数之前,必须要获取得关机特权罢了,其实就算是Windows NT/2000/XP系统自身关机也必须要走这一流程的。
      view plainprint?
      获取关机特权函数如下:
      procedure Get_Shutdown_Privilege; //获得用户关机特权,仅对Windows NT/2000/XP
      var
      rl: Cardinal;
      hToken: Cardinal;
      tkp: TOKEN_PRIVILEGES;
      begin
      OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken);
      if LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid) then
      begin

      tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;  
      tkp.PrivilegeCount := 1;  
      AdjustTokenPrivileges(hToken, False, tkp, 0, nil, rl);  

      end;
      end;

      另一个关机API,InitiateSystemShutdown(PChar(Computer_Name),PChar(Hint_Msg),Time,Force,Reboot);在Windows NT/2000/XP平台下还会自动调用系统本身的关机提示窗口。
      InitiateSystemShutdown(PChar(Computer_Name), PChar(Hint_Msg),Time,Force,Reboot);

                        //关机计算机名,关机提示信息,停留时长,是否强行关机,是否要重启

      当我们把Computer_Name设为nil时,默认为本机,如 InitiateSystemshutdown(nil,nil,0,True,False);//强行关机

      由于我们需要制作一个通用的关机程序,故要对当前的操作系统进行判断,这个比较简单,函数如下:
      function GetOperatingSystem: string;//获取操作系统信息
      var osVerInfo: TOSVersionInfo;
      begin

      Result :='';  
      osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);  
      if GetVersionEx(osVerInfo) then  
        case osVerInfo.dwPlatformId of  
        VER_PLATFORM_WIN32_NT:  
        begin  
          Result := 'Windows NT/2000/XP'  
        end;  
        VER_PLATFORM_WIN32_WINDOWS:  
        begin  
          Result := 'Windows 95/98/98SE/Me';  
        end;  
      end;  

      end;

      执行关机的主函数:
      procedure ShutDownComputer;
      begin

      if GetOperatingSystem='Windows NT/2000/XP' then   
      begin   
        Get_Shutdown_Privilege;  
        //调用此函数会出现系统关机提示窗口,并允许用户取消关机动作  
        //InitiateSystemShutDown(nil,'关机提示:讨厌你所以关了你!',0,True,False);  
        ExitWindowsEx(EWX_SHUTDOWN+EWX_FORCE+EWX_POWEROFF+EWX_FORCEIFHUNG,0);  
      end else  
      begin  
        ExitWindowsEx(EWX_SHUTDOWN+EWX_FORCE+EWX_POWEROFF+EWX_FORCEIFHUNG,0);  
      end;  

      end;
      =========================================================================================================================}

      使用:

      procedure TShutDownForm.btn_PowerOffClick(Sender:Object);
      begin
      ShutDownComputer;
      end;

    • 19种防调试检测方法

    • unit Unit1;

      interface

      uses
      JwaNative, Debug,
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls, ExtCtrls;

      type
      TForm1 = class(TForm)

        Button1: TButton;
        Timer1: TTimer;
        Button2: TButton;
        Label1: TLabel;
        Label2: TLabel;
        Label3: TLabel;
        Label4: TLabel;
        procedure Timer1Timer(Sender: TObject);
        procedure Button2Click(Sender: TObject);

      private

        { Private declarations }

      public

        { Public declarations }

      end;

      var
      Form1: TForm1;

      function FD_IsDebuggerPresent(): Boolean;
      function PD_PEB_BeingDebuggedFlag(): Boolean;
      function FD_PEB_NtGlobalFlags(): Boolean;
      function FD_Heap_HeapFlags(): Boolean;
      function FD_Heap_ForceFlags(): Boolean;
      function FD_CheckRemoteDebuggerPresent(): Boolean;
      function FD_NtQueryInfoProc_DbgPort(): Boolean;
      function FD_NtQueryInfoProc_DbgObjHandle(): Boolean;
      function FD_NtQueryInfoProc_DbgFlags(): Boolean;
      function FD_SeDebugPrivilege(csrssPid: THandle): Boolean;
      function FD_Find_Debugger_Window(): Boolean;
      function FD_Exception_Closehandle(): Boolean;
      function FD_Exception_Int3(): Boolean;
      function FD_OutputDebugString(): boolean;
      function FD_Check_StartupInfo(): Boolean;
      function FD_INT_2d(): Boolean;
      function FS_OD_Int3_Pushfd(): Boolean;
      function FS_SI_Exception_Int1(): Boolean;
      function FB_HWBP_Exception(): Boolean;

      代码下载:20095641408249.rar

      阅读剩余部分...

    • 反编译Delphi软件DEDE的使用

    • elphi/C++ Builder采用控件拖放的方式来完成界面的设计,并和事件联系起来。而这些信息以资源(RCDATA)的方式存放于可执行文件中。DeDe便利用这个原理进行反编译,获取相关信息,将界面与事件联系关系还原,但事件的汇编代码不能还原。DeDe公开了源代码,感兴趣的读者可以研究一下。

      1.主要功能
      用DeDe可以查看Delphi程序窗体的属性,可以查看按钮对应的事件,并将事件代码反汇编出来,其能识别出Delphi库函数,具有良好的可读性。另外,还可以把事件输出到map文件中供其他工具使用。

      2.配置
      (1)DSF文件

      ①DSF文件的含义

      DSF文件内容来自不同版本BPL库文件的输出符号表。DeDe反汇编引擎使用这些符号表对生成的ASM代码文件添加类成员方法调用的注释,这非常类似于IDA Pro的FLIRT技术。如果没有加载任何BPL符号表文件,对BPL类的调用就无法以注释的格式说明。

      ②加载DSF文件

      经由“File/Load Symbol File”菜单,就可加载所需要的DSF文件。程序若能正确识别出相应版本的Delphi程序,会自动加载DSF文件。若希望每次启动DeDe的同时自动加载若干DSF文件,选中“Options/Configuration”菜单,在Symbols选项卡中就可完成本项工作。如果想查看包含在某个特定DSF文件中的输出符号表,选择“Options/Symbols”。

      ③为何需要创建DSF文件

      处理使用自定义构件(即不是Delphi安装的构件)的程序时,如果有这些自定义构件的BPL,并且为它们创建了DSF文件,那么DeDe将会注释所有对这些自定义构件的调用。创建DSF的速度也是很快的。

      阅读剩余部分...

    • Delphi 5 种反调试技术

    • 1.程序窗口句柄检测
      原理:用FindWindow函数查找具有相同窗口类名和标题的窗口,如果找到就说明有OD在运行
      //**
      //通过查找窗口类名来实现检测OllyDBG
      //**
      function AntiLoader():Boolean;
      const
      OllyName='OLLYDBG';
      var
      Hwnd:Thandle;
      begin
      Hwnd:=FindWindow(OllyName,nil);
      if Hwnd<>0 then
      Result:=True
      else
      Result:=False;
      end;
      procedure TForm1.FormCreate(Sender: TObject);
      begin
      if AntiLoader then
      MessageBox(Handle,'找到调试器!','提示',MB_OK+MB_ICONINFORMATION)
      else
      MessageBox(Handle,'未找到调试器!','提示',MB_OK+MB_ICONINFORMATION)
      end;

      阅读剩余部分...

    • Delphi使用资源文件全攻略

    • 在通常情况下使用delphi设计程序,都是将字符串、图像等资源直接使用delphi提供的vcl控件加到*.dfm中,这样做会合修改这些资源时带来 不便,如果资源被多次引用,这些资源在程序启动时都被加载到内存中,非常耗费系统资源。因此,这就需要一种新的引用资源的文件:资源文件。资源文件就是将 一些资源,如字符串、图像等信息进行编译,然后在程序中引用编译后的资源文件,最后和源程序一起编译生成可执行文件。由于在资源文件中的资源是在需要时加 载,因此,比较节省系统资源,而且,如果要做国际化版本的系统,只需要将资源文件一换,重新编译即可。下面就详细介绍delphi中资源文件的建立和使用。

      阅读剩余部分...

    • ClientDataSet调用存储过程方法

    • ClientDataSet调用方法(实际上就是三层中的远端执行):

      procedure TMain.btn_ClientDataSetExecClick(Sender: TObject); begin DataSource1.DataSet := ClientDataSet1; ClientDataSet1.ProviderName := 'DataSetProvider1'; DataSetProvider1.DataSet.Close; //即执行了 Adoquery1.Close; ClientDataSet1.Close; ClientDataSet1.CommandText := 'Execute up_TestAdoExec :@inVar,:@outVar output'; ClientDataSet1.Params.Clear; //调用存储过程时,必须把此语句放在对CommandText的赋值操作之后 ClientDataSet1.Params.CreateParam(ftString,'@inVar',ptInput); ClientDataSet1.Params.CreateParam(ftString,'@outVar',ptOutput); ClientDataSet1.Params.ParamByName('@inVar').Size := 100; ClientDataSet1.Params.ParamByName('@inVar').Value := Edit1.Text; ClientDataSet1.Params.ParamByName('@outVar').Size := 100; //ClientDataSet1.Params.ParamByName('@outVar').Value := Edit2.Text; //ClientDataSet1.Execute;//如果不返回结果集,执行此语句 ClientDataSet1.Open; Edit2.Text := ClientDataSet1.Params.ParamByName('@outVar').Value; end;

Powered by Typecho)))   ICP:蜀ICP备05009250号