Delphi公用函數(shù)單元

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); 延時(shí)函數(shù),單位為毫

2、秒 procedure YzDelayTime(MSecs: Longint); 判斷字符串是否為數(shù)字 function YzStrIsNum(Str: string):boolean; 判斷文件是否正在使用 function YzIsFileInUse(fName: string): boolean; 刪除字符串列表中的空字符串 procedure YzDelEmptyChar(AList: TStringList); 刪除文件列表中的"Thumbs.db"文件 procedure YzDelThumbsFile(AList: TStrings); 返回一個(gè)整數(shù)指定位數(shù)的

3、帶"0"字符串 function YzIntToZeroStr(Value, ALength: Integer): string; 取日期年份分量 function YzGetYear(Date: TDate): Integer; 取日期月份分量 function YzGetMonth(Date: TDate): Integer; 取日期天數(shù)分量 function YzGetDay(Date: TDate): Integer; 取時(shí)間小時(shí)分量 function YzGetHour(Time: TTime): Integer; 取時(shí)間分鐘分量 function YzGetMi

4、nute(Time: TTime): Integer; 取時(shí)間秒鐘分量 function YzGetSecond(Time: TTime): Integer; 返回時(shí)間分量字符串 function YzGetTimeStr(ATime: TTime;AFlag: string): string; 返回日期時(shí)間字符串 function YzGetDateTimeStr(ATime: TTime;ADate: TDate): string; 獲取計(jì)算機(jī)名稱 function YzGetComputerName(): string; 通過(guò)窗體子串查找窗體 procedure YzFindSpecWi

5、ndow(ASubTitle: string); 判斷進(jìn)程CPU占用率 procedure YzJudgeCPU(ProcessName: string;CPUUsage: Single); 分割字符串 procedure YzSeparateTerms(Source: string;Separator: Char;Terms: TStringList); 切換頁(yè)面控件的活動(dòng)頁(yè)面 procedure YzGotoNewPage(AOwerPage: TPageControl;ANewPage: TTabSheet); 設(shè)置頁(yè)面控件標(biāo)簽的可見性 procedure YzSetTableVisib

6、le(PageControl: TPageControl;ShowFlag: Boolean); 根據(jù)產(chǎn)品名稱獲取產(chǎn)品編號(hào) function YzGetLevelCode(AName:string;ProductList: TStringList): string; 取文件的主文件名 function YzGetMainFileName(AFileName: string): string; 按下一個(gè)鍵 procedure YzPressOneKey(AByteCode: Byte);overload; 按下一個(gè)指定次數(shù)的鍵 procedure YzPressOneKey(AByteCode:

7、 Byte;ATimes: Integer);overload; 按下二個(gè)鍵 procedure YzPressTwoKeys(AFirstByteCode, ASecByteCode: Byte); 按下三個(gè)鍵 procedure YzPressThreeKeys(AFirstByteCode, ASecByteCode, AThirdByteCode: Byte); 創(chuàng)建桌面快捷方式 procedure YzCreateShortCut(const sPath: string; sShortCutName: WideString); 刪除桌面快捷方式 procedure YzDeleteS

8、hortCut(sShortCutName: WideString); 通過(guò)光標(biāo)位置進(jìn)行鼠標(biāo)左鍵單擊 procedure YzMouseLeftClick(X, Y: Integer);overload; 鼠標(biāo)左鍵雙擊 procedure YzMouseDoubleClick(X, Y: Integer); 通過(guò)窗口句柄進(jìn)行鼠標(biāo)左鍵單擊 procedure YzMouseLeftClick(lpClassName, lpWindowName: PAnsiChar);overload; 通過(guò)光標(biāo)位置查找窗口句柄 function YzWindowFromPoint(X, Y: Integer):

9、 THandle; 等待窗口在指定時(shí)間后出現(xiàn) function YzWaitWindowExist(lpClassName, lpWindowName: PAnsiChar; ASecond: Integer = 0): THandle;overload; 通光標(biāo)位置,窗口類名與標(biāo)題查找窗口是否存在 function YzWaitWindowExist(X, Y: Integer;AClassName, AWinName: string; ASecond: Integer = 0):THandle; overload; 等待指定窗口消失 procedure YzWaitWindowClose(

10、lpClassName, lpWindowName: PAnsiChar; ASecond: Integer = 0); 通過(guò)窗口句柄設(shè)置文本框控件文本 procedure YzSetEditText(lpClassName, lpWindowName: PAnsiChar; AText: string);overload; 通過(guò)光標(biāo)位置設(shè)置文本框控件文本 procedure YzSetEditText(X, Y: Integer;AText: string);overload; 獲取Window操作系統(tǒng)語(yǔ)言 function YzGetWindowsLanguageStr: String;

11、清空動(dòng)態(tài)數(shù)組 procedure YzDynArraySetZero(var A); 動(dòng)態(tài)設(shè)置屏幕分辨率 function YzDynamicResolution(X, Y: WORD): Boolean; 檢測(cè)系統(tǒng)屏幕分辨率 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;-以下是關(guān)于獲取系統(tǒng)軟件卸載的信息的類型聲明和函數(shù) -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 返回系統(tǒng)軟件卸載的信息 function YzGetUninstallInfo : TUninstallInfo; 檢測(cè)Java安裝信息 function YzCheckJavaInfo(AUninstallInfo: TUninstallInfo;CheckJava6 : Boolean = False): Boolean; 窗口自適應(yīng)屏幕大小 procedure YzAdjustForm(Form: TForm;co

14、nst OrgWidth, OrgHeight: integer); 設(shè)置窗口為當(dāng)前窗體 procedure YzBringMyAppToFront(AppHandle: THandle); 獲取文件夾大小 function YzGetDirSize(Dir: string;SubDir: Boolean): LongInt; 獲取文件夾文件數(shù)量 function YzGetDirFiles(Dir: string;SubDir: Boolean): LongInt; 獲取文件大小(KB) function YzGetFileSize(const FileName: String): Long

15、Int; 獲取文件大小(字節(jié)) function YzGetFileSize_Byte(const FileName: String): LongInt; 算術(shù)舍入法的四舍五入取整函數(shù) function YzRoundEx (const Value: Real): LongInt; 彈出選擇目錄對(duì)話框 function YzSelectDir(const iMode: integer;const sInfo: string): string; 獲取指定路徑下文件夾的個(gè)數(shù) procedure YzListFolders(const Path: String; const ShowPath: Bo

16、olean;var List: TStrings); 禁用窗器控件的所有子控件 procedure YzSetSubCtlState(AOwer: TWinControl;AState: Boolean); 模擬鍵盤按鍵操作(處理字節(jié)碼) procedure YzFKeyent(byteCard: byte); overload; 模擬鍵盤按鍵操作(處理字符串 procedure YzFKeyent(strCard: string); overload; 鎖定窗口位置 procedure YzLockWindow(ClassName,WinName: PChar;poX,poY: Intege

17、r); 注冊(cè)一個(gè)DLL形式或OCX形式的OLE/COM控件參數(shù)strOleFileName為一個(gè)DLL或OCX文件名，參數(shù)OleAction表示注冊(cè)操作類型，1表示注冊(cè)，0表示卸載返回值True表示操作執(zhí)行成功，F(xiàn)alse表示操作執(zhí)行失敗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格式轉(zhuǎn)換為bmp格式 function JpgToBmp(Jpg: TJpegImage): TBitmap; 設(shè)置程序自啟動(dòng)函數(shù) function YzSetAutoRun(AFilePath: string;AFlag: Boolean): boolean; 檢測(cè)URL地址是否有效 function YzCheckUrl(url: string): Boolean; 獲取程序可執(zhí)行文件名 function

19、YzGetExeFName: string; 目錄瀏覽對(duì)話框函數(shù) function YzBrowseFolder(AOwer: TWinControl;ATitle: string):string; 重啟計(jì)算機(jī) function YzShutDownSystem(AFlag: Integer):BOOL; 程序運(yùn)行后刪除自身 procedure YzDeleteSelf; 程序重啟 procedure YzAppRestart; 壓縮Access數(shù)據(jù)庫(kù) function YzCompactAccessDB(const AFileName, APassWord: string): Boolean

20、; 標(biāo)題:獲取其他進(jìn)程中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當(dāng)前登錄的用戶名 function YzGetWindwosUserName: String;枚舉托盤圖標(biāo) function YzEnumTrayNotifyWnd(AFindList: TStringList;ADestStr: string): BOOL; 獲取SQL Server用戶數(shù)據(jù)庫(kù)列表 procedure YzGetSQLServerDBList(ADBHostIP, ALoginPwd: string;ADBList: TStringList); 讀取據(jù)庫(kù)中所有的表 procedure YzGetTableList(Connc

22、etStr: string;ATableList: TStringList); 將域名解釋成IP地址 function YzDomainToIP(HostName: string): string; 等待進(jìn)程結(jié)束 procedure YzWaitProcessExit(AProcessName: string); 移去系統(tǒng)托盤失效圖標(biāo) procedure YzRemoveDeadIcons(); 轉(zhuǎn)移程序占用內(nèi)存至虛擬內(nèi)存 procedure YzClearMemory; 檢測(cè)允許試用的天數(shù)是否已到期 function YzCheckTrialDays(AllowDays: Integer):

23、 Boolean; 指定長(zhǎng)度的隨機(jī)小寫字符串函數(shù) function YzRandomStr(aLength: Longint): string;var FontMapping : array of TFontMapping;implementationuses uMain; 保存日志文件 procedure YzWriteLogFile(Msg: String);var FileStream: TFileStream; LogFile : String;begin try 每天一個(gè)日志文件 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; 延時(shí)函數(shù),單位為毫秒 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; 判斷字符串是否為數(shù)字 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;-功能: 返回一個(gè)整數(shù)指定位數(shù)的帶"0"字符串參數(shù): Value:要轉(zhuǎn)換的整數(shù) ALength:字符串長(zhǎng)度返回值: 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; 取日期天數(shù)分量 function YzGetDay(Date: TDate): Integer;var y, m, d: WORD;begin Deco

33、deDate(Date, y, m, d); Result := d;end; 取時(shí)間小時(shí)分量 function YzGetHour(Time: TTime): Integer;var h, m, s, ms: WORD;begin DecodeTime(Time, h, m, s, ms); Result := h;end; 取時(shí)間分鐘分量 function YzGetMinute(Time: TTime): Integer;var h, m, s, ms: WORD;begin DecodeTime(Time, h, m, s, ms); Result := m;end; 取時(shí)間秒鐘分量

34、function YzGetSecond(Time: TTime): Integer;var h, m, s, ms: WORD;begin DecodeTime(Time, h, m, s, ms); Result := s;end; 返回時(shí)間分量字符串 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小時(shí)制則下午的小時(shí)分量加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; 返回日期時(shí)間字符串 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; 通過(guò)窗體子串查找窗體 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; 獲取計(jì)算機(jī)名稱 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; 判斷進(jìn)程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; 長(zhǎng)度為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); 復(fù)制字符 Terms.Add(TmpStr); 添加到列表 Delete(Source, 1, PO); 刪除字符和分割符 PO := Pos(Separator, Source); 查找分割符 end; if Length(Source) > 0 then Terms.Add(Source); 添加剩下的條目 end; 切換頁(yè)面控件的活動(dòng)頁(yè)面 procedure YzGotoNewPage(AOwerPage: TPageControl;ANewPage: TTabSheet);begin if AOwerPage.ActivePage <

45、;> ANewPage then AOwerPage.ActivePage := ANewPage;end; 設(shè)置頁(yè)面控件標(biāo)簽的可見性 procedure YzSetTableVisible(PageControl: TPageControl;ShowFlag: Boolean);var I: Integer;begin for I := 0 to PageControl.PageCount -1 do PageControl.PagesI.TabVisible := ShowFlag;end; 根據(jù)產(chǎn)品名稱獲取產(chǎn)品編號(hào) 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; 按下一個(gè)鍵 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; 按下一個(gè)指定次數(shù)的鍵 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; 按下二個(gè)鍵 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; 按下三個(gè)鍵 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; 創(chuàng)建桌面快捷方式 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); 創(chuàng)建建立快捷方式的外殼擴(kuò)展 tmpSLink := tmpObject as IShellLink; 取得接口 tmpPFile := tmpObject as IPersistFile; 用來(lái)儲(chǔ)存*.lnk文件的接口 tmpSLink.SetPath(pChar(StartupFilename); 設(shè)定notepad.exe所在路徑 tmpSLink.SetWorkingDirectory(pChar(ExtractFilePat