delphi公用函数

{*******************************************************}

{ }

{ Delphi公用函数单元 }

{ }

{*******************************************************}

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;

{ 延时函数,单位为毫秒 }

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;

{ 取日期年份分量 }

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;

{ 判断进程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;

{ 分割字符串 }

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;

{ 取文件的主文件名 }

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;

{ 按下二个键 }

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;

{-------------------------------------------------------------

功能: 等待窗口在指定时间后出现

参数: 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;

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

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;

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;

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;

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;

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;

finally

Free;

S.Free;

SetLength(Result, J);

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;

{ 设置窗口为当前窗体 }

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;

{ 获取文件夹文件数量 }

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;

{ 模拟键盘按键(处理字符) }

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;

{ 锁定窗口位置 }

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;

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;

{ 设置程序自启动函数 }

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;

{ 获取程序可执行文件名 }

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 EAX

PUSH pExitProcess

PUSH hModule

PUSH pDeleteFileA

PUSH pUnmapViewOfFile

RET

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;

{ 标题:获取其他进程中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; { 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;

{-------------------------------------------------------------

功能: 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;

{ 获取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;

{ 检测数据库中是否存在给定的表 }

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;

{ 将域名解释成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;

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;

//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;

{ 检测允许试用的天数是否已到期 }

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;

finally

FRegister.Free;

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.

本站仅提供存储服务，所有内容均由用户发布，如发现有害或侵权内容，请点击举报。