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.