{*******************************************************}
{ }
{ 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.
来源：oschina
链接：https://my.oschina.net/u/4361896/blog/4257819