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