Delphi公用函数单元

1、unit GlobalFunction;interfaceuses 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); 延时函数,单位为毫

2、秒 procedure YzDelayTime(MSecs: Longint); 判断字符串是否为数字 function YzStrIsNum(Str: string):boolean; 判断文件是否正在使用 function YzIsFileInUse(fName: string): boolean; 删除字符串列表中的空字符串 procedure YzDelEmptyChar(AList: TStringList); 删除文件列表中的"Thumbs.db"文件 procedure YzDelThumbsFile(AList: TStrings); 返回一个整数指定位数的

3、带"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 YzGetMi

4、nute(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 YzFindSpecWi

5、ndow(ASubTitle: string); 判断进程CPU占用率 procedure YzJudgeCPU(ProcessName: string;CPUUsage: Single); 分割字符串 procedure YzSeparateTerms(Source: string;Separator: Char;Terms: TStringList); 切换页面控件的活动页面 procedure YzGotoNewPage(AOwerPage: TPageControl;ANewPage: TTabSheet); 设置页面控件标签的可见性 procedure YzSetTableVisib

6、le(PageControl: TPageControl;ShowFlag: Boolean); 根据产品名称获取产品编号 function YzGetLevelCode(AName:string;ProductList: TStringList): string; 取文件的主文件名 function YzGetMainFileName(AFileName: string): string; 按下一个键 procedure YzPressOneKey(AByteCode: Byte);overload; 按下一个指定次数的键 procedure YzPressOneKey(AByteCode:

7、 Byte;ATimes: Integer);overload; 按下二个键 procedure YzPressTwoKeys(AFirstByteCode, ASecByteCode: Byte); 按下三个键 procedure YzPressThreeKeys(AFirstByteCode, ASecByteCode, AThirdByteCode: Byte); 创建桌面快捷方式 procedure YzCreateShortCut(const sPath: string; sShortCutName: WideString); 删除桌面快捷方式 procedure YzDeleteS

8、hortCut(sShortCutName: WideString); 通过光标位置进行鼠标左键单击 procedure YzMouseLeftClick(X, Y: Integer);overload; 鼠标左键双击 procedure YzMouseDoubleClick(X, Y: Integer); 通过窗口句柄进行鼠标左键单击 procedure YzMouseLeftClick(lpClassName, lpWindowName: PAnsiChar);overload; 通过光标位置查找窗口句柄 function YzWindowFromPoint(X, Y: Integer):

9、 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(

10、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;

11、清空动态数组 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: stri

12、ng; 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

13、; UpdateInfoURL : string; RegCompany : string; RegOwner : string; end; GetUninstallInfo 返回系统软件卸载的信息 function YzGetUninstallInfo : TUninstallInfo; 检测Java安装信息 function YzCheckJavaInfo(AUninstallInfo: TUninstallInfo;CheckJava6 : Boolean = False): Boolean; 窗口自适应屏幕大小 procedure YzAdjustForm(Form: TForm;co

14、nst 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): Long

15、Int; 获取文件大小(字节) 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: Bo

16、olean;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: Intege

17、r); 注册一个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; m

18、Strings: 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

19、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

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

21、taPath : string; 获取Windows当前登录的用户名 function YzGetWindwosUserName: String;枚举托盘图标 function YzEnumTrayNotifyWnd(AFindList: TStringList;ADestStr: string): BOOL; 获取SQL Server用户数据库列表 procedure YzGetSQLServerDBList(ADBHostIP, ALoginPwd: string;ADBList: TStringList); 读取据库中所有的表 procedure YzGetTableList(Connc

22、etStr: string;ATableList: TStringList); 将域名解释成IP地址 function YzDomainToIP(HostName: string): string; 等待进程结束 procedure YzWaitProcessExit(AProcessName: string); 移去系统托盘失效图标 procedure YzRemoveDeadIcons(); 转移程序占用内存至虚拟内存 procedure YzClearMemory; 检测允许试用的天数是否已到期 function YzCheckTrialDays(AllowDays: Integer):

23、 Boolean; 指定长度的随机小写字符串函数 function YzRandomStr(aLength: Longint): string;var FontMapping : array of TFontMapping;implementationuses uMain; 保存日志文件 procedure YzWriteLogFile(Msg: String);var FileStream: TFileStream; LogFile : String;begin try 每天一个日志文件 Msg := '' + DateTimeToStr(Now)+ ' '+

24、 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) el

25、se 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 FirstT

26、ickCount := 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

27、 to length(str) do if not (StrI 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

28、_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; fo

29、r I := 0 to AList.Count - 1 do if AList.StringsI <> '' then TmpList.Add(AList.StringsI); AList.Clear; AList.Text := TmpList.Text; TmpList.Free;end; 删除文件列表中的"Thumbs.db"文件 procedure YzDelThumbsFile(AList: TStrings);var I: Integer; TmpList: TStringList;begin TmpList := TStringLi

30、st.Create; for I := 0 to AList.Count - 1 do if ExtractFileName(AList.StringsI) <> 'Thumbs.db' then TmpList.Add(AList.StringsI); AList.Clear; AList.Text := TmpList.Text; TmpList.Free;end;-功能: 返回一个整数指定位数的带"0"字符串参数: Value:要转换的整数 ALength:字符串长度返回值: string-function YzIntToZeroStr(V

31、alue, 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; 取日期年份分量 fun

32、ction 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 Deco

33、deDate(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; 取时间秒钟分量

34、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' SECONDT

35、YPE = '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('下午', wT

36、imeStr) + 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

37、 = 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(YzGetYe

38、ar(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 + w

39、Minute + wSecond;end; 通过窗体子串查找窗体 procedure YzFindSpecWindow(ASubTitle: string); function EnumWndProc(AWnd: THandle;AWinName: string): Boolean;stdcall; var WindowText: array0.255 of Char; WindowStr: string; begin GetWindowText(AWnd, WindowText, 255); WindowStr := StrPas(WindowText); WindowStr := COPY

40、(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:

41、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: Sin

42、gle);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;

43、 分割字符串 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

44、(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 <

45、;> 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.PagesI.TabVisible := ShowFlag;end; 根据产品名称获取产品编号 function YZGetLevelCode(AName:str

46、ing;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.StringsI; if AName = Copy(TmpStr,1, Pos('_', TmpStr)-1) then begin Result := Copy(TmpStr, P

47、os('_', 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 YzPressO

48、neKey(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,

49、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, KEYEV

50、ENTF_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); YzDelay

51、Time(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; tmpS

52、Link: IShellLink; tmpPFile: IPersistFile; PIDL: PItemIDList; StartupDirectory: array0.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(ExtractFilePat