当前位置:   article > 正文

delphi公用函数

deiphi 公用函数
  1. {*******************************************************}
  2. { }
  3. { Delphi公用函数单元 }
  4. { }
  5. { 版权所有 (C) 2008 }
  6. { }
  7. {*******************************************************}
  8. unit YzDelphiFunc;
  9. interface
  10. uses
  11. ComCtrls, Forms, Windows, Classes, SysUtils, ComObj, ActiveX, ShlObj, Messages,
  12. Graphics, Registry, Dialogs, Controls, uProcess, uCpuUsage, StrUtils, CommCtrl,
  13. jpeg, WinInet, ShellAPI, SHFolder, ADODB, WinSock;
  14. { 保存日志文件 }
  15. procedure YzWriteLogFile(Msg: String);
  16. { 延时函数,单位为毫秒 }
  17. procedure YzDelayTime(MSecs: Longint);
  18. { 判断字符串是否为数字 }
  19. function YzStrIsNum(Str: string):boolean;
  20. { 判断文件是否正在使用 }
  21. function YzIsFileInUse(fName: string): boolean;
  22. { 删除字符串列表中的空字符串 }
  23. procedure YzDelEmptyChar(AList: TStringList);
  24. { 删除文件列表中的"Thumbs.db"文件 }
  25. procedure YzDelThumbsFile(AList: TStrings);
  26. { 返回一个整数指定位数的带"0"字符串 }
  27. function YzIntToZeroStr(Value, ALength: Integer): string;
  28. { 取日期年份分量 }
  29. function YzGetYear(Date: TDate): Integer;
  30. { 取日期月份分量 }
  31. function YzGetMonth(Date: TDate): Integer;
  32. { 取日期天数分量 }
  33. function YzGetDay(Date: TDate): Integer;
  34. { 取时间小时分量 }
  35. function YzGetHour(Time: TTime): Integer;
  36. { 取时间分钟分量 }
  37. function YzGetMinute(Time: TTime): Integer;
  38. { 取时间秒钟分量 }
  39. function YzGetSecond(Time: TTime): Integer;
  40. { 返回时间分量字符串 }
  41. function YzGetTimeStr(ATime: TTime;AFlag: string): string;
  42. { 返回日期时间字符串 }
  43. function YzGetDateTimeStr(ATime: TTime;ADate: TDate): string;
  44. { 获取计算机名称 }
  45. function YzGetComputerName(): string;
  46. { 通过窗体子串查找窗体 }
  47. procedure YzFindSpecWindow(ASubTitle: string);
  48. { 判断进程CPU占用率 }
  49. procedure YzJudgeCPU(ProcessName: string;CPUUsage: Single);
  50. { 分割字符串 }
  51. procedure YzSeparateTerms(Source: string;Separator: Char;Terms: TStringList);
  52. { 切换页面控件的活动页面 }
  53. procedure YzGotoNewPage(AOwerPage: TPageControl;ANewPage: TTabSheet);
  54. { 设置页面控件标签的可见性 }
  55. procedure YzSetTableVisible(PageControl: TPageControl;ShowFlag: Boolean);
  56. { 根据产品名称获取产品编号 }
  57. function YzGetLevelCode(AName:string;ProductList: TStringList): string;
  58. { 取文件的主文件名 }
  59. function YzGetMainFileName(AFileName: string): string;
  60. { 按下一个键 }
  61. procedure YzPressOneKey(AByteCode: Byte);overload;
  62. { 按下一个指定次数的键 }
  63. procedure YzPressOneKey(AByteCode: Byte;ATimes: Integer);overload;
  64. { 按下二个键 }
  65. procedure YzPressTwoKeys(AFirstByteCode, ASecByteCode: Byte);
  66. { 按下三个键 }
  67. procedure YzPressThreeKeys(AFirstByteCode, ASecByteCode, AThirdByteCode: Byte);
  68. { 创建桌面快捷方式 }
  69. procedure YzCreateShortCut(const sPath: string; sShortCutName: WideString);
  70. { 删除桌面快捷方式 }
  71. procedure YzDeleteShortCut(sShortCutName: WideString);
  72. { 通过光标位置进行鼠标左键单击 }
  73. procedure YzMouseLeftClick(X, Y: Integer);overload;
  74. { 鼠标左键双击 }
  75. procedure YzMouseDoubleClick(X, Y: Integer);
  76. { 通过窗口句柄进行鼠标左键单击 }
  77. procedure YzMouseLeftClick(lpClassName, lpWindowName: PAnsiChar);overload;
  78. { 通过光标位置查找窗口句柄 }
  79. function YzWindowFromPoint(X, Y: Integer): THandle;
  80. { 等待窗口在指定时间后出现 }
  81. function YzWaitWindowExist(lpClassName, lpWindowName: PAnsiChar;
  82. ASecond: Integer = 0): THandle;overload;
  83. { 通光标位置,窗口类名与标题查找窗口是否存在 }
  84. function YzWaitWindowExist(X, Y: Integer;AClassName, AWinName: string;
  85. ASecond: Integer = 0):THandle; overload;
  86. { 等待指定窗口消失 }
  87. procedure YzWaitWindowClose(lpClassName, lpWindowName: PAnsiChar;
  88. ASecond: Integer = 0);
  89. { 通过窗口句柄设置文本框控件文本 }
  90. procedure YzSetEditText(lpClassName, lpWindowName: PAnsiChar;
  91. AText: string);overload;
  92. { 通过光标位置设置文本框控件文本 }
  93. procedure YzSetEditText(X, Y: Integer;AText: string);overload;
  94. { 获取Window操作系统语言 }
  95. function YzGetWindowsLanguageStr: String;
  96. { 清空动态数组 }
  97. procedure YzDynArraySetZero(var A);
  98. { 动态设置屏幕分辨率 }
  99. function YzDynamicResolution(X, Y: WORD): Boolean;
  100. { 检测系统屏幕分辨率 }
  101. function YzCheckDisplayInfo(X, Y: Integer): Boolean;
  102. type
  103. TFontedControl = class(TControl)
  104. public
  105. property Font;
  106. end;
  107. TFontMapping = record
  108. SWidth : Integer;
  109. SHeight: Integer;
  110. FName: string;
  111. FSize: Integer;
  112. end;
  113. procedure YzFixForm(AForm: TForm);
  114. procedure YzSetFontMapping;
  115. {---------------------------------------------------
  116. 以下是关于获取系统软件卸载的信息的类型声明和函数
  117. ----------------------------------------------------}
  118. type
  119. TUninstallInfo = array of record
  120. RegProgramName: string;
  121. ProgramName : string;
  122. UninstallPath : string;
  123. Publisher : string;
  124. PublisherURL : string;
  125. Version : string;
  126. HelpLink : string;
  127. UpdateInfoURL : string;
  128. RegCompany : string;
  129. RegOwner : string;
  130. end;
  131. { GetUninstallInfo 返回系统软件卸载的信息 }
  132. function YzGetUninstallInfo : TUninstallInfo;
  133. { 检测Java安装信息 }
  134. function YzCheckJavaInfo(AUninstallInfo: TUninstallInfo;CheckJava6 : Boolean = False): Boolean;
  135. { 窗口自适应屏幕大小 }
  136. procedure YzAdjustForm(Form: TForm;const OrgWidth, OrgHeight: integer);
  137. { 设置窗口为当前窗体 }
  138. procedure YzBringMyAppToFront(AppHandle: THandle);
  139. { 获取文件夹大小 }
  140. function YzGetDirSize(Dir: string;SubDir: Boolean): LongInt;
  141. { 获取文件夹文件数量 }
  142. function YzGetDirFiles(Dir: string;SubDir: Boolean): LongInt;
  143. { 获取文件大小(KB) }
  144. function YzGetFileSize(const FileName: String): LongInt;
  145. { 获取文件大小(字节) }
  146. function YzGetFileSize_Byte(const FileName: String): LongInt;
  147. { 算术舍入法的四舍五入取整函数 }
  148. function YzRoundEx (const Value: Real): LongInt;
  149. { 弹出选择目录对话框 }
  150. function YzSelectDir(const iMode: integer;const sInfo: string): string;
  151. { 获取指定路径下文件夹的个数 }
  152. procedure YzListFolders(const Path: String; const ShowPath: Boolean;var List: TStrings);
  153. { 禁用窗器控件的所有子控件 }
  154. procedure YzSetSubCtlState(AOwer: TWinControl;AState: Boolean);
  155. { 模拟键盘按键操作(处理字节码) }
  156. procedure YzFKeyent(byteCard: byte); overload;
  157. { 模拟键盘按键操作(处理字符串 }
  158. procedure YzFKeyent(strCard: string); overload;
  159. { 锁定窗口位置 }
  160. procedure YzLockWindow(ClassName,WinName: PChar;poX,poY: Integer);
  161. { 注册一个DLL形式或OCX形式的OLE/COM控件
  162. 参数strOleFileName为一个DLL或OCX文件名,
  163. 参数OleAction表示注册操作类型,1表示注册,0表示卸载
  164. 返回值True表示操作执行成功,False表示操作执行失败
  165. }
  166. function YzRegisterOleFile (strOleFileName: STRING;OleAction: Byte): BOOLEAN;
  167. function YzListViewColumnCount(mHandle: THandle): Integer;
  168. function YzGetListViewText(mHandle: THandle; mStrings: TStrings): Boolean;
  169. { 删除目录树 }
  170. function YzDeleteDirectoryTree(Path: string): boolean;
  171. { Jpg格式转换为bmp格式 }
  172. function JpgToBmp(Jpg: TJpegImage): TBitmap;
  173. { 设置程序自启动函数 }
  174. function YzSetAutoRun(AFilePath: string;AFlag: Boolean): boolean;
  175. { 检测URL地址是否有效 }
  176. function YzCheckUrl(url: string): Boolean;
  177. { 获取程序可执行文件名 }
  178. function YzGetExeFName: string;
  179. { 目录浏览对话框函数 }
  180. function YzBrowseFolder(AOwer: TWinControl;ATitle: string):string;
  181. { 重启计算机 }
  182. function YzShutDownSystem(AFlag: Integer):BOOL;
  183. { 程序运行后删除自身 }
  184. procedure YzDeleteSelf;
  185. { 程序重启 }
  186. procedure YzAppRestart;
  187. { 压缩Access数据库 }
  188. function YzCompactAccessDB(const AFileName, APassWord: string): Boolean;
  189. { 标题:获取其他进程中TreeView的文本 }
  190. function YzTreeNodeGetNext(mHandle: THandle; mTreeItem: HTreeItem): HTreeItem;
  191. function YzTreeNodeGetLevel(mHandle: THandle; mTreeItem: HTreeItem): Integer;
  192. function YzGetTreeViewText(mHandle: THandle; mStrings: TStrings): Boolean;
  193. { 获取本地Application Data目录路径 }
  194. function YzLocalAppDataPath : string;
  195. { 获取Windows当前登录的用户名 }
  196. function YzGetWindwosUserName: String;
  197. {枚举托盘图标 }
  198. function YzEnumTrayNotifyWnd(AFindList: TStringList;ADestStr: string): BOOL;
  199. { 获取SQL Server用户数据库列表 }
  200. procedure YzGetSQLServerDBList(ADBHostIP, ALoginPwd: string;ADBList: TStringList);
  201. { 读取据库中所有的表 }
  202. procedure YzGetTableList(ConncetStr: string;ATableList: TStringList);
  203. { 将域名解释成IP地址 }
  204. function YzDomainToIP(HostName: string): string;
  205. { 等待进程结束 }
  206. procedure YzWaitProcessExit(AProcessName: string);
  207. { 移去系统托盘失效图标 }
  208. procedure YzRemoveDeadIcons();
  209. { 转移程序占用内存至虚拟内存 }
  210. procedure YzClearMemory;
  211. { 检测允许试用的天数是否已到期 }
  212. function YzCheckTrialDays(AllowDays: Integer): Boolean;
  213. { 指定长度的随机小写字符串函数 }
  214. function YzRandomStr(aLength: Longint): string;
  215. var
  216. FontMapping : array of TFontMapping;
  217. implementation
  218. uses
  219. uMain;
  220. { 保存日志文件 }
  221. procedure YzWriteLogFile(Msg: String);
  222. var
  223. FileStream: TFileStream;
  224. LogFile : String;
  225. begin
  226. try
  227. { 每天一个日志文件 }
  228. Msg := '[' + DateTimeToStr(Now)+ '] '+ Msg;
  229. LogFile := ExtractFilePath(Application.ExeName) + '/Logs/' + DateToStr(Now) + '.log';
  230. if not DirectoryExists(ExtractFilePath(LogFile)) then
  231. CreateDir(ExtractFilePath(LogFile));
  232. if FileExists(LogFile) then
  233. FileStream := TFileStream.Create(LogFile, fmOpenWrite or fmShareDenyNone)
  234. else
  235. FileStream:=TFileStream.Create(LogFile,fmCreate or fmShareDenyNone);
  236. FileStream.Position:=FileStream.Size;
  237. Msg := Msg + #13#10;
  238. FileStream.Write(PChar(Msg)^, Length(Msg));
  239. FileStream.Free;
  240. except
  241. end;
  242. end;
  243. { 延时函数,单位为毫秒 }
  244. procedure YZDelayTime(MSecs: Longint);
  245. var
  246. FirstTickCount, Now: Longint;
  247. begin
  248. FirstTickCount := GetTickCount();
  249. repeat
  250. Application.ProcessMessages;
  251. Now := GetTickCount();
  252. until (Now - FirstTickCount>=MSecs) or (Now < FirstTickCount);
  253. end;
  254. { 判断字符串是否为数字 }
  255. function YzStrIsNum(Str: string):boolean;
  256. var
  257. I: integer;
  258. begin
  259. if Str = '' then
  260. begin
  261. Result := False;
  262. Exit;
  263. end;
  264. for I:=1 to length(str) do
  265. if not (Str[I] in ['0'..'9']) then
  266. begin
  267. Result := False;
  268. Exit;
  269. end;
  270. Result := True;
  271. end;
  272. { 判断文件是否正在使用 }
  273. function YzIsFileInUse(fName: string): boolean;
  274. var
  275. HFileRes: HFILE;
  276. begin
  277. Result := false;
  278. if not FileExists(fName) then exit;
  279. HFileRes := CreateFile(pchar(fName), GENERIC_READ or GENERIC_WRITE, 0, nil,
  280. OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  281. Result := (HFileRes = INVALID_HANDLE_VALUE);
  282. if not Result then CloseHandle(HFileRes);
  283. end;
  284. { 删除字符串列表中的空字符串 }
  285. procedure YzDelEmptyChar(AList: TStringList);
  286. var
  287. I: Integer;
  288. TmpList: TStringList;
  289. begin
  290. TmpList := TStringList.Create;
  291. for I := 0 to AList.Count - 1 do
  292. if AList.Strings[I] <> '' then TmpList.Add(AList.Strings[I]);
  293. AList.Clear;
  294. AList.Text := TmpList.Text;
  295. TmpList.Free;
  296. end;
  297. { 删除文件列表中的"Thumbs.db"文件 }
  298. procedure YzDelThumbsFile(AList: TStrings);
  299. var
  300. I: Integer;
  301. TmpList: TStringList;
  302. begin
  303. TmpList := TStringList.Create;
  304. for I := 0 to AList.Count - 1 do
  305. if ExtractFileName(AList.Strings[I]) <> 'Thumbs.db' then
  306. TmpList.Add(AList.Strings[I]);
  307. AList.Clear;
  308. AList.Text := TmpList.Text;
  309. TmpList.Free;
  310. end;
  311. {-------------------------------------------------------------
  312. 功能: 返回一个整数指定位数的带"0"字符串
  313. 参数: Value:要转换的整数 ALength:字符串长度
  314. 返回值: string
  315. --------------------------------------------------------------}
  316. function YzIntToZeroStr(Value, ALength: Integer): string;
  317. var
  318. I, ACount: Integer;
  319. begin
  320. Result := '';
  321. ACount := Length(IntToStr(Value));
  322. if ACount >= ALength then Result := IntToStr(Value)
  323. else
  324. begin
  325. for I := 1 to ALength-ACount do
  326. Result := Result + '0';
  327. Result := Result + IntToStr(Value)
  328. end;
  329. end;
  330. { 取日期年份分量 }
  331. function YzGetYear(Date: TDate): Integer;
  332. var
  333. y, m, d: WORD;
  334. begin
  335. DecodeDate(Date, y, m, d);
  336. Result := y;
  337. end;
  338. { 取日期月份分量 }
  339. function YzGetMonth(Date: TDate): Integer;
  340. var
  341. y, m, d: WORD;
  342. begin
  343. DecodeDate(Date, y, m, d);
  344. Result := m;
  345. end;
  346. { 取日期天数分量 }
  347. function YzGetDay(Date: TDate): Integer;
  348. var
  349. y, m, d: WORD;
  350. begin
  351. DecodeDate(Date, y, m, d);
  352. Result := d;
  353. end;
  354. { 取时间小时分量 }
  355. function YzGetHour(Time: TTime): Integer;
  356. var
  357. h, m, s, ms: WORD;
  358. begin
  359. DecodeTime(Time, h, m, s, ms);
  360. Result := h;
  361. end;
  362. { 取时间分钟分量 }
  363. function YzGetMinute(Time: TTime): Integer;
  364. var
  365. h, m, s, ms: WORD;
  366. begin
  367. DecodeTime(Time, h, m, s, ms);
  368. Result := m;
  369. end;
  370. { 取时间秒钟分量 }
  371. function YzGetSecond(Time: TTime): Integer;
  372. var
  373. h, m, s, ms: WORD;
  374. begin
  375. DecodeTime(Time, h, m, s, ms);
  376. Result := s;
  377. end;
  378. { 返回时间分量字符串 }
  379. function YzGetTimeStr(ATime: TTime;AFlag: string): string;
  380. var
  381. wTimeStr: string;
  382. FH, FM, FS, FMS: WORD;
  383. const
  384. HOURTYPE = 'Hour';
  385. MINUTETYPE = 'Minute';
  386. SECONDTYPE = 'Second';
  387. MSECONDTYPE = 'MSecond';
  388. begin
  389. wTimeStr := TimeToStr(ATime);
  390. if Pos('上午', wTimeStr) <> 0 then
  391. wTimeStr := Copy(wTimeStr, Pos('上午', wTimeStr) + 4, 10)
  392. else if Pos('下午', wTimeStr) <> 0 then
  393. wTimeStr := Copy(wTimeStr, Pos('下午', wTimeStr) + 4, 10);
  394. DecodeTime(ATime, FH, FM, FS, FMS);
  395. if AFlag = HOURTYPE then
  396. begin
  397. { 如果是12小时制则下午的小时分量加12 }
  398. if Pos('下午', wTimeStr) <> 0 then
  399. Result := YzIntToZeroStr(FH + 12, 2)
  400. else
  401. Result := YzIntToZeroStr(FH, 2);
  402. end;
  403. if AFlag = MINUTETYPE then Result := YzIntToZeroStr(FM, 2);
  404. if AFlag = SECONDTYPE then Result := YzIntToZeroStr(FS, 2);
  405. if AFlag = MSECONDTYPE then Result := YzIntToZeroStr(FMS, 2);
  406. end;
  407. { 返回日期时间字符串 }
  408. function YzGetDateTimeStr(ATime: TTime;ADate: TDate): string;
  409. var
  410. wYear, wMonth, wDay: string;
  411. wHour, wMinute, wSecond: string;
  412. begin
  413. wYear := RightStr(YzIntToZeroStr(YzGetYear(ADate), 4), 2);
  414. wMonth := YzIntToZeroStr(YzGetMonth(ADate), 2);
  415. wDay := YzIntToZeroStr(YzGetDay(ADate), 2);
  416. wHour := YzGetTimeStr(ATime, 'Hour');
  417. wMinute := YzGetTimeStr(ATime, 'Minute');
  418. wSecond := YzGetTimeStr(ATime, 'Second');
  419. Result := wYear + wMonth + wDay + wHour + wMinute + wSecond;
  420. end;
  421. { 通过窗体子串查找窗体 }
  422. procedure YzFindSpecWindow(ASubTitle: string);
  423. function EnumWndProc(AWnd: THandle;AWinName: string): Boolean;stdcall;
  424. var
  425. WindowText: array[0..255] of Char;
  426. WindowStr: string;
  427. begin
  428. GetWindowText(AWnd, WindowText, 255);
  429. WindowStr := StrPas(WindowText);
  430. WindowStr := COPY(WindowStr, 1, StrLen(PChar(AWinName)));
  431. if CompareText(AWinName, WindowStr) = 0 then
  432. begin
  433. SetForegroundWindow(AWnd);
  434. Result := False; Exit;
  435. end;
  436. Result := True;
  437. end;
  438. begin
  439. EnumWindows(@EnumWndProc, LongInt(@ASubTitle));
  440. YzDelayTime(1000);
  441. end;
  442. { 获取计算机名称 }
  443. function YzGetComputerName(): string;
  444. var
  445. pcComputer: PChar;
  446. dwCSize: DWORD;
  447. begin
  448. dwCSize := MAX_COMPUTERNAME_LENGTH + 1;
  449. Result := '';
  450. GetMem(pcComputer, dwCSize);
  451. try
  452. if Windows.GetComputerName(pcComputer, dwCSize) then
  453. Result := pcComputer;
  454. finally
  455. FreeMem(pcComputer);
  456. end;
  457. end;
  458. { 判断进程CPU占用率 }
  459. procedure YzJudgeCPU(ProcessName: string;CPUUsage: Single);
  460. var
  461. cnt: PCPUUsageData;
  462. usage: Single;
  463. begin
  464. cnt := wsCreateUsageCounter(FindProcess(ProcessName));
  465. while True do
  466. begin
  467. usage := wsGetCpuUsage(cnt);
  468. if usage <= CPUUsage then
  469. begin
  470. wsDestroyUsageCounter(cnt);
  471. YzDelayTime(2000);
  472. Break;
  473. end;
  474. YzDelayTime(10);
  475. Application.ProcessMessages;
  476. end;
  477. end;
  478. { 分割字符串 }
  479. procedure YzSeparateTerms(Source: string;Separator: Char;Terms: TStringList);
  480. var
  481. TmpStr: string;
  482. PO: integer;
  483. begin
  484. Terms.Clear;
  485. if Length(Source) = 0 then Exit; { 长度为0则退出 }
  486. PO := Pos(Separator, Source);
  487. if PO = 0 then
  488. begin
  489. Terms.Add(Source);
  490. Exit;
  491. end;
  492. while PO <> 0 do
  493. begin
  494. TmpStr := Copy(Source, 1, PO - 1);{ 复制字符 }
  495. Terms.Add(TmpStr); { 添加到列表 }
  496. Delete(Source, 1, PO); { 删除字符和分割符 }
  497. PO := Pos(Separator, Source); { 查找分割符 }
  498. end;
  499. if Length(Source) > 0 then
  500. Terms.Add(Source); { 添加剩下的条目 }
  501. end;
  502. { 切换页面控件的活动页面 }
  503. procedure YzGotoNewPage(AOwerPage: TPageControl;ANewPage: TTabSheet);
  504. begin
  505. if AOwerPage.ActivePage <> ANewPage then AOwerPage.ActivePage := ANewPage;
  506. end;
  507. { 设置页面控件标签的可见性 }
  508. procedure YzSetTableVisible(PageControl: TPageControl;ShowFlag: Boolean);
  509. var
  510. I: Integer;
  511. begin
  512. for I := 0 to PageControl.PageCount -1 do
  513. PageControl.Pages[I].TabVisible := ShowFlag;
  514. end;
  515. { 根据产品名称获取产品编号 }
  516. function YZGetLevelCode(AName:string;ProductList: TStringList): string;
  517. var
  518. I: Integer;
  519. TmpStr: string;
  520. begin
  521. Result := '';
  522. if ProductList.Count <= 0 then Exit;
  523. for I := 0 to ProductList.Count-1 do
  524. begin
  525. TmpStr := ProductList.Strings[I];
  526. if AName = Copy(TmpStr,1, Pos('_', TmpStr)-1) then
  527. begin
  528. Result := Copy(TmpStr, Pos('_', TmpStr)+1, 10);
  529. Break;
  530. end;
  531. end;
  532. end;
  533. { 取文件的主文件名 }
  534. function YzGetMainFileName(AFileName:string): string;
  535. var
  536. TmpStr: string;
  537. begin
  538. if AFileName = '' then Exit;
  539. TmpStr := ExtractFileName(AFileName);
  540. Result := Copy(TmpStr, 1, Pos('.', TmpStr) - 1);
  541. end;
  542. { 按下一个键 }
  543. procedure YzPressOneKey(AByteCode: Byte);
  544. begin
  545. keybd_event(AByteCode, 0, 0, 0);
  546. YzDelayTime(100);
  547. keybd_event(AByteCode, 0, KEYEVENTF_KEYUP, 0);
  548. YzDelayTime(400);
  549. end;
  550. { 按下一个指定次数的键 }
  551. procedure YzPressOneKey(AByteCode: Byte;ATimes: Integer);overload;
  552. var
  553. I: Integer;
  554. begin
  555. for I := 1 to ATimes do
  556. begin
  557. keybd_event(AByteCode, 0, 0, 0);
  558. YzDelayTime(10);
  559. keybd_event(AByteCode, 0, KEYEVENTF_KEYUP, 0);
  560. YzDelayTime(150);
  561. end;
  562. end;
  563. { 按下二个键 }
  564. procedure YzPressTwoKeys(AFirstByteCode, ASecByteCode: Byte);
  565. begin
  566. keybd_event(AFirstByteCode, 0, 0, 0);
  567. keybd_event(ASecByteCode, 0, 0, 0);
  568. YzDelayTime(100);
  569. keybd_event(ASecByteCode, 0, KEYEVENTF_KEYUP, 0);
  570. keybd_event(AFirstByteCode, 0, KEYEVENTF_KEYUP, 0);
  571. YzDelayTime(400);
  572. end;
  573. { 按下三个键 }
  574. procedure YzPressThreeKeys(AFirstByteCode, ASecByteCode, AThirdByteCode: Byte);
  575. begin
  576. keybd_event(AFirstByteCode, 0, 0, 0);
  577. keybd_event(ASecByteCode, 0, 0, 0);
  578. keybd_event(AThirdByteCode, 0, 0, 0);
  579. YzDelayTime(100);
  580. keybd_event(AThirdByteCode, 0, KEYEVENTF_KEYUP, 0);
  581. keybd_event(ASecByteCode, 0, KEYEVENTF_KEYUP, 0);
  582. keybd_event(AFirstByteCode, 0, KEYEVENTF_KEYUP, 0);
  583. YzDelayTime(400);
  584. end;
  585. { 创建桌面快捷方式 }
  586. procedure YzCreateShortCut(const sPath: string; sShortCutName: WideString);
  587. var
  588. tmpObject: IUnknown;
  589. tmpSLink: IShellLink;
  590. tmpPFile: IPersistFile;
  591. PIDL: PItemIDList;
  592. StartupDirectory: array[0..MAX_PATH] of Char;
  593. StartupFilename: String;
  594. LinkFilename: WideString;
  595. begin
  596. StartupFilename := sPath;
  597. tmpObject := CreateComObject(CLSID_ShellLink); { 创建建立快捷方式的外壳扩展 }
  598. tmpSLink := tmpObject as IShellLink; { 取得接口 }
  599. tmpPFile := tmpObject as IPersistFile; { 用来储存*.lnk文件的接口 }
  600. tmpSLink.SetPath(pChar(StartupFilename)); { 设定notepad.exe所在路径 }
  601. tmpSLink.SetWorkingDirectory(pChar(ExtractFilePath(StartupFilename))); {设定工作目录 }
  602. SHGetSpecialFolderLocation(0, CSIDL_DESKTOPDIRECTORY, PIDL); { 获得桌面的Itemidlist }
  603. SHGetPathFromIDList(PIDL, StartupDirectory); { 获得桌面路径 }
  604. sShortCutName := '/' + sShortCutName + '.lnk';
  605. LinkFilename := StartupDirectory + sShortCutName;
  606. tmpPFile.Save(pWChar(LinkFilename), FALSE); { 保存*.lnk文件 }
  607. end;
  608. { 删除桌面快捷方式 }
  609. procedure YzDeleteShortCut(sShortCutName: WideString);
  610. var
  611. PIDL : PItemIDList;
  612. StartupDirectory: array[0..MAX_PATH] of Char;
  613. LinkFilename: WideString;
  614. begin
  615. SHGetSpecialFolderLocation(0,CSIDL_DESKTOPDIRECTORY,PIDL);
  616. SHGetPathFromIDList(PIDL,StartupDirectory);
  617. LinkFilename := StrPas(StartupDirectory) + '/' + sShortCutName + '.lnk';
  618. DeleteFile(LinkFilename);
  619. end;
  620. { 通过光标位置进行鼠标左键单击 }
  621. procedure YzMouseLeftClick(X, Y: Integer);
  622. begin
  623. SetCursorPos(X, Y);
  624. YzDelayTime(100);
  625. mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
  626. mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
  627. YzDelayTime(400);
  628. end;
  629. { 鼠标左键双击 }
  630. procedure YzMouseDoubleClick(X, Y: Integer);
  631. begin
  632. SetCursorPos(X, Y);
  633. YzDelayTime(100);
  634. mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
  635. mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
  636. YzDelayTime(100);
  637. mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
  638. mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
  639. YzDelayTime(400);
  640. end;
  641. { 通过窗口句柄进行鼠标左键单击 }
  642. procedure YzMouseLeftClick(lpClassName, lpWindowName: PAnsiChar);overload;
  643. var
  644. AHandel: THandle;
  645. begin
  646. AHandel := FindWindow(lpClassName, lpWindowName);
  647. SendMessage(AHandel, WM_LBUTTONDOWN, 0, 0);
  648. SendMessage(AHandel, WM_LBUTTONUP, 0, 0);
  649. YzDelayTime(500);
  650. end;
  651. { 等待进程结束 }
  652. procedure YzWaitProcessExit(AProcessName: string);
  653. begin
  654. while True do
  655. begin
  656. KillByPID(FindProcess(AProcessName));
  657. if FindProcess(AProcessName) = 0 then Break;
  658. YzDelayTime(10);
  659. Application.ProcessMessages;
  660. end;
  661. end;
  662. {-------------------------------------------------------------
  663. 功 能: 等待窗口在指定时间后出现
  664. 参 数: lpClassName: 窗口类名
  665. lpWindowName: 窗口标题
  666. ASecond: 要等待的时间,"0"代表永久等待
  667. 返回值: 无
  668. 备 注: 如果指定的等待时间未到窗口已出现则立即退出
  669. --------------------------------------------------------------}
  670. function YzWaitWindowExist(lpClassName, lpWindowName: PAnsiChar;
  671. ASecond: Integer = 0): THandle;overload;
  672. var
  673. StartTickCount, PassTickCount: LongWord;
  674. begin
  675. Result := 0;
  676. { 永久等待 }
  677. if ASecond = 0 then
  678. begin
  679. while True do
  680. begin
  681. Result := FindWindow(lpClassName, lpWindowName);
  682. if Result <> 0 then Break;
  683. YzDelayTime(10);
  684. Application.ProcessMessages;
  685. end;
  686. end
  687. else { 等待指定时间 }
  688. begin
  689. StartTickCount := GetTickCount;
  690. while True do
  691. begin
  692. Result := FindWindow(lpClassName, lpWindowName);
  693. { 窗口已出现则立即退出 }
  694. if Result <> 0 then Break
  695. else
  696. begin
  697. PassTickCount := GetTickCount;
  698. { 等待时间已到则退出 }
  699. if (PassTickCount - StartTickCount) div 1000 >= ASecond then Break;
  700. end;
  701. YzDelayTime(10);
  702. Application.ProcessMessages;
  703. end;
  704. end;
  705. YzDelayTime(1000);
  706. end;
  707. { 等待指定窗口消失 }
  708. procedure YzWaitWindowClose(lpClassName, lpWindowName: PAnsiChar;
  709. ASecond: Integer = 0);
  710. var
  711. StartTickCount, PassTickCount: LongWord;
  712. begin
  713. if ASecond = 0 then
  714. begin
  715. while True do
  716. begin
  717. if FindWindow(lpClassName, lpWindowName) = 0 then Break;
  718. YzDelayTime(10);
  719. Application.ProcessMessages;
  720. end
  721. end
  722. else
  723. begin
  724. StartTickCount := GetTickCount;
  725. while True do
  726. begin
  727. { 窗口已关闭则立即退出 }
  728. if FindWindow(lpClassName, lpWindowName)= 0 then Break
  729. else
  730. begin
  731. PassTickCount := GetTickCount;
  732. { 等待时间已到则退出 }
  733. if (PassTickCount - StartTickCount) div 1000 >= ASecond then Break;
  734. end;
  735. YzDelayTime(10);
  736. Application.ProcessMessages;
  737. end;
  738. end;
  739. YzDelayTime(500);
  740. end;
  741. { 通过光标位置查找窗口句柄 }
  742. function YzWindowFromPoint(X, Y: Integer): THandle;
  743. var
  744. MousePoint: TPoint;
  745. CurWindow: THandle;
  746. hRect: TRect;
  747. Canvas: TCanvas;
  748. begin
  749. MousePoint.X := X;
  750. MousePoint.Y := Y;
  751. CurWindow := WindowFromPoint(MousePoint);
  752. GetWindowRect(Curwindow, hRect);
  753. if Curwindow <> 0 then
  754. begin
  755. Canvas := TCanvas.Create;
  756. Canvas.Handle := GetWindowDC(Curwindow);
  757. Canvas.Pen.Width := 2;
  758. Canvas.Pen.Color := clRed;
  759. Canvas.Pen.Mode := pmNotXor;
  760. Canvas.Brush.Style := bsClear;
  761. Canvas.Rectangle(0, 0, hRect.Right-hRect.Left, hRect.Bottom-hRect.Top);
  762. Canvas.Free;
  763. end;
  764. Result := CurWindow;
  765. end;
  766. { 通光标位置,窗口类名与标题查找窗口是否存在 }
  767. function YzWaitWindowExist(X, Y: Integer;AClassName, AWinName: string;
  768. ASecond: Integer):THandle;overload;
  769. var
  770. MousePo: TPoint;
  771. CurWindow: THandle;
  772. bufClassName: array[0..MAXBYTE-1] of Char;
  773. bufWinName: array[0..MAXBYTE-1] of Char;
  774. StartTickCount, PassTickCount: LongWord;
  775. begin
  776. Result := 0;
  777. { 永久等待 }
  778. if ASecond = 0 then
  779. begin
  780. while True do
  781. begin
  782. MousePo.X := X;
  783. MousePo.Y := Y;
  784. CurWindow := WindowFromPoint(MousePo);
  785. GetClassName(CurWindow, bufClassName, MAXBYTE);
  786. GetWindowText(CurWindow, bufWinname, MAXBYTE);
  787. if (CompareText(StrPas(bufClassName), AClassName) = 0 ) and
  788. (CompareText(StrPas(bufWinName), AWinName) = 0) then
  789. begin
  790. Result := CurWindow;
  791. Break;
  792. end;
  793. YzDelayTime(10);
  794. Application.ProcessMessages;
  795. end;
  796. end
  797. else { 等待指定时间 }
  798. begin
  799. StartTickCount := GetTickCount;
  800. while True do
  801. begin
  802. { 窗口已出现则立即退出 }
  803. MousePo.X := X;
  804. MousePo.Y := Y;
  805. CurWindow := WindowFromPoint(MousePo);
  806. GetClassName(CurWindow, bufClassName, MAXBYTE);
  807. GetWindowText(CurWindow, bufWinname, MAXBYTE);
  808. if (CompareText(StrPas(bufClassName), AClassName) = 0 ) and
  809. (CompareText(StrPas(bufWinName), AWinName) = 0) then
  810. begin
  811. Result := CurWindow; Break;
  812. end
  813. else
  814. begin
  815. PassTickCount := GetTickCount;
  816. { 等待时间已到则退出 }
  817. if (PassTickCount - StartTickCount) div 1000 >= ASecond then Break;
  818. end;
  819. YzDelayTime(10);
  820. Application.ProcessMessages;
  821. end;
  822. end;
  823. YzDelayTime(1000);
  824. end;
  825. { 通过窗口句柄设置文本框控件文本 }
  826. procedure YzSetEditText(lpClassName, lpWindowName: PAnsiChar;
  827. AText: string);overload;
  828. var
  829. CurWindow: THandle;
  830. begin
  831. CurWindow := FindWindow(lpClassName, lpWindowName);
  832. SendMessage(CurWindow ,WM_SETTEXT, 0, Integer(PChar(AText)));
  833. YzDelayTime(500);
  834. end;
  835. { 通过光标位置设置文本框控件文本 }
  836. procedure YzSetEditText(X, Y: Integer;AText: string);overload;
  837. var
  838. CurWindow: THandle;
  839. begin
  840. CurWindow := YzWindowFromPoint(X, Y);
  841. SendMessage(CurWindow, WM_SETTEXT, 0, Integer(PChar(AText)));
  842. YzMouseLeftClick(X, Y);
  843. end;
  844. { 获取Window操作系统语言 }
  845. function YzGetWindowsLanguageStr: String;
  846. var
  847. WinLanguage: array [0..50] of char;
  848. begin
  849. VerLanguageName(GetSystemDefaultLangID, WinLanguage, 50);
  850. Result := StrPas(WinLanguage);
  851. end;
  852. procedure YzDynArraySetZero(var A);
  853. var
  854. P: PLongint; { 4个字节 }
  855. begin
  856. P := PLongint(A); { 指向 A 的地址 }
  857. Dec(P); { P地址偏移量是 sizeof(A),指向了数组长度 }
  858. P^ := 0; { 数组长度清空 }
  859. Dec(P); { 指向数组引用计数 }
  860. P^ := 0; { 数组计数清空 }
  861. end;
  862. { 动态设置分辨率 }
  863. function YzDynamicResolution(x, y: WORD): Boolean;
  864. var
  865. lpDevMode: TDeviceMode;
  866. begin
  867. Result := EnumDisplaySettings(nil, 0, lpDevMode);
  868. if Result then
  869. begin
  870. lpDevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
  871. lpDevMode.dmPelsWidth := x;
  872. lpDevMode.dmPelsHeight := y;
  873. Result := ChangeDisplaySettings(lpDevMode, 0) = DISP_CHANGE_SUCCESSFUL;
  874. end;
  875. end;
  876. procedure YzSetFontMapping;
  877. begin
  878. SetLength(FontMapping, 3);
  879. { 800 x 600 }
  880. FontMapping[0].SWidth := 800;
  881. FontMapping[0].SHeight := 600;
  882. FontMapping[0].FName := '宋体';
  883. FontMapping[0].FSize := 7;
  884. { 1024 x 768 }
  885. FontMapping[1].SWidth := 1024;
  886. FontMapping[1].SHeight := 768;
  887. FontMapping[1].FName := '宋体';
  888. FontMapping[1].FSize := 9;
  889. { 1280 x 1024 }
  890. FontMapping[2].SWidth := 1280;
  891. FontMapping[2].SHeight := 1024;
  892. FontMapping[2].FName := '宋体';
  893. FontMapping[2].FSize := 11;
  894. end;
  895. { 程序窗体及控件自适应分辨率(有问题) }
  896. procedure YzFixForm(AForm: TForm);
  897. var
  898. I, J: integer;
  899. T: TControl;
  900. begin
  901. with AForm do
  902. begin
  903. for I := 0 to ComponentCount - 1 do
  904. begin
  905. try
  906. T := TControl(Components[I]);
  907. T.left := Trunc(T.left * (Screen.width / 1024));
  908. T.top := Trunc(T.Top * (Screen.Height / 768));
  909. T.Width := Trunc(T.Width * (Screen.Width / 1024));
  910. T.Height := Trunc(T.Height * (Screen.Height / 768));
  911. except
  912. end; { try }
  913. end; { for I }
  914. for I:= 0 to Length(FontMapping) - 1 do
  915. begin
  916. if (Screen.Width = FontMapping[I].SWidth) and (Screen.Height =
  917. FontMapping[I].SHeight) then
  918. begin
  919. for J := 0 to ComponentCount - 1 do
  920. begin
  921. try
  922. TFontedControl(Components[J]).Font.Name := FontMapping[I].FName;
  923. TFontedControl(Components[J]).FONT.Size := FontMapping[I].FSize;
  924. except
  925. end; { try }
  926. end; { for J }
  927. end; { if }
  928. end; { for I }
  929. end; { with }
  930. end;
  931. { 检测系统屏幕分辨率 }
  932. function YzCheckDisplayInfo(X, Y: Integer): Boolean;
  933. begin
  934. Result := True;
  935. if (Screen.Width <> X) and (Screen.Height <> Y) then
  936. begin
  937. if MessageBox(Application.Handle, PChar( '系统检测到您的屏幕分辨率不是 '
  938. + IntToStr(X) + '×' + IntToStr(Y) + ',这将影响到系统的正常运行,'
  939. + '是否要自动调整屏幕分辨率?'), '提示', MB_YESNO + MB_ICONQUESTION
  940. + MB_TOPMOST) = 6 then YzDynamicResolution(1024, 768)
  941. else Result := False;
  942. end;
  943. end;
  944. function YzGetUninstallInfo: TUninstallInfo;
  945. const
  946. Key = '/SOFTWARE/Microsoft/Windows/CurrentVersion/Uninstall/';
  947. var
  948. S : TStrings;
  949. I : Integer;
  950. J : Integer;
  951. begin
  952. with TRegistry.Create do
  953. begin
  954. S := TStringlist.Create;
  955. J := 0;
  956. try
  957. RootKey:= HKEY_LOCAL_MACHINE;
  958. OpenKeyReadOnly(Key);
  959. GetKeyNames(S);
  960. Setlength(Result, S.Count);
  961. for I:= 0 to S.Count - 1 do
  962. begin
  963. If OpenKeyReadOnly(Key + S[I]) then
  964. If ValueExists('DisplayName') and ValueExists('UninstallString') then
  965. begin
  966. Result[J].RegProgramName:= S[I];
  967. Result[J].ProgramName:= ReadString('DisplayName');
  968. Result[J].UninstallPath:= ReadString('UninstallString');
  969. If ValueExists('Publisher') then
  970. Result[J].Publisher:= ReadString('Publisher');
  971. If ValueExists('URLInfoAbout') then
  972. Result[J].PublisherURL:= ReadString('URLInfoAbout');
  973. If ValueExists('DisplayVersion') then
  974. Result[J].Version:= ReadString('DisplayVersion');
  975. If ValueExists('HelpLink') then
  976. Result[J].HelpLink:= ReadString('HelpLink');
  977. If ValueExists('URLUpdateInfo') then
  978. Result[J].UpdateInfoURL:= ReadString('URLUpdateInfo');
  979. If ValueExists('RegCompany') then
  980. Result[J].RegCompany:= ReadString('RegCompany');
  981. If ValueExists('RegOwner') then
  982. Result[J].RegOwner:= ReadString('RegOwner');
  983. Inc(J);
  984. end;
  985. end;
  986. finally
  987. Free;
  988. S.Free;
  989. SetLength(Result, J);
  990. end;
  991. end;
  992. end;
  993. { 检测Java安装信息 }
  994. function YzCheckJavaInfo(AUninstallInfo: TUninstallInfo;CheckJava6 : Boolean = False): Boolean;
  995. var
  996. I: Integer;
  997. Java6Exist: Boolean;
  998. AUninstall: TUninstallInfo;
  999. AProgramList: TStringList;
  1000. AJavaVersion, AFilePath: string;
  1001. begin
  1002. Result := True;
  1003. Java6Exist := False;
  1004. AJavaVersion := 'J2SE Runtime Environment 5.0 Update 14';
  1005. AUninstall := YzGetUninstallInfo;
  1006. AProgramList := TStringList.Create;
  1007. for I := Low(AUninstall) to High(AUninstall) do
  1008. begin
  1009. if Pos('J2SE', AUninstall[I].ProgramName) <> 0 then
  1010. AProgramList.Add(AUninstall[I].ProgramName);
  1011. if Pos('Java(TM)', AUninstall[I].ProgramName) <> 0 then
  1012. Java6Exist := True;
  1013. end;
  1014. if Java6Exist then
  1015. begin
  1016. if CheckJava6 then
  1017. begin
  1018. MessageBox(Application.Handle, '系统检测到您机器上安装了Java6以上的版本,'
  1019. + '如果影响到系统的正常运行请先将其卸载再重新启动系统!', '提示',
  1020. MB_OK + MB_ICONINFORMATION + MB_TOPMOST);
  1021. Result := False;
  1022. end;
  1023. end
  1024. else if AProgramList.Count = 0 then
  1025. begin
  1026. MessageBox(Application.Handle, '系统检测到您机器上没有安装Java运行环境,'
  1027. + '请点击 "确定" 安装Java运行环境后再重新运行程序!',
  1028. '提示', MB_OK + MB_ICONINFORMATION + MB_TOPMOST);
  1029. AFilePath := ExtractFilePath(ParamStr(0)) + 'java' + '/'
  1030. + 'jre-1_5_0_14-windows-i586-p.exe';
  1031. if FileExists(AFilePath) then WinExec(PChar(AFilePath), SW_SHOWNORMAL)
  1032. else
  1033. MessageBox(Application.Handle, '找不到Java安装文件,请您手动安装!',
  1034. '提示', MB_OK + MB_ICONINFORMATION + MB_TOPMOST);
  1035. Result := False;
  1036. end;
  1037. AProgramList.Free;
  1038. end;
  1039. {-------------------------------------------------------------
  1040. 功能: 窗口自适应屏幕大小
  1041. 参数: Form: 需要调整的Form
  1042. OrgWidth:开发时屏幕的宽度
  1043. OrgHeight:开发时屏幕的高度
  1044. --------------------------------------------------------------}
  1045. procedure YzAdjustForm(Form: TForm;const OrgWidth, OrgHeight: integer);
  1046. begin
  1047. with Form do
  1048. begin
  1049. if (Screen.width <> OrgWidth) then
  1050. begin
  1051. Scaled := True;
  1052. Height := longint(Height) * longint(Screen.height) div OrgHeight;
  1053. Width := longint(Width) * longint(Screen.Width) div OrgWidth;
  1054. ScaleBy(Screen.Width, OrgWidth);
  1055. end;
  1056. end;
  1057. end;
  1058. { 设置窗口为当前窗体 }
  1059. procedure YzBringMyAppToFront(AppHandle: THandle);
  1060. var
  1061. Th1, Th2: Cardinal;
  1062. begin
  1063. Th1 := GetCurrentThreadId;
  1064. Th2 := GetWindowThreadProcessId(GetForegroundWindow, NIL);
  1065. AttachThreadInput(Th2, Th1, TRUE);
  1066. try
  1067. SetForegroundWindow(AppHandle);
  1068. finally
  1069. AttachThreadInput(Th2, Th1, TRUE);
  1070. end;
  1071. end;
  1072. { 获取文件夹文件数量 }
  1073. function YzGetDirFiles(Dir: string;SubDir: Boolean): LongInt;
  1074. var
  1075. SearchRec: TSearchRec;
  1076. Founded: integer;
  1077. begin
  1078. Result := 0;
  1079. if Dir[length(Dir)] <> '/' then Dir := Dir + '/';
  1080. Founded := FindFirst(Dir + '*.*', faAnyFile, SearchRec);
  1081. while Founded = 0 do
  1082. begin
  1083. Inc(Result);
  1084. if (SearchRec.Attr and faDirectory > 0) and (SearchRec.Name[1] <> '.') and
  1085. (SubDir = True) then
  1086. Inc(Result, YzGetDirFiles(Dir + SearchRec.Name, True));
  1087. Founded := FindNext(SearchRec);
  1088. end;
  1089. FindClose(SearchRec);
  1090. end;
  1091. { 算术舍入法的四舍五入取整函数 }
  1092. function YzRoundEx (const Value: Real): LongInt;
  1093. var
  1094. x: Real;
  1095. begin
  1096. x := Value - Trunc(Value);
  1097. if x >= 0.5 then
  1098. Result := Trunc(Value) + 1
  1099. else Result := Trunc(Value);
  1100. end;
  1101. { 获取文件大小(KB) }
  1102. function YzGetFileSize(const FileName: String): LongInt;
  1103. var
  1104. SearchRec: TSearchRec;
  1105. begin
  1106. if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
  1107. Result := SearchRec.Size
  1108. else
  1109. Result := -1;
  1110. Result := YzRoundEx(Result / 1024);
  1111. end;
  1112. { 获取文件大小(字节) }
  1113. function YzGetFileSize_Byte(const FileName: String): LongInt;
  1114. var
  1115. SearchRec: TSearchRec;
  1116. begin
  1117. if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
  1118. Result := SearchRec.Size
  1119. else
  1120. Result := -1;
  1121. end;
  1122. { 获取文件夹大小 }
  1123. function YzGetDirSize(Dir: string;SubDir: Boolean): LongInt;
  1124. var
  1125. SearchRec: TSearchRec;
  1126. Founded: integer;
  1127. begin
  1128. Result := 0;
  1129. if Dir[length(Dir)] <> '/' then Dir := Dir + '/';
  1130. Founded := FindFirst(Dir + '*.*', faAnyFile, SearchRec);
  1131. while Founded = 0 do
  1132. begin
  1133. Inc(Result, SearchRec.size);
  1134. if (SearchRec.Attr and faDirectory > 0) and (SearchRec.Name[1] <> '.') and
  1135. (SubDir = True) then
  1136. Inc(Result, YzGetDirSize(Dir + SearchRec.Name, True));
  1137. Founded := FindNext(SearchRec);
  1138. end;
  1139. FindClose(SearchRec);
  1140. Result := YzRoundEx(Result / 1024);
  1141. end;
  1142. {-------------------------------------------------------------
  1143. 功能: 弹出选择目录对话框
  1144. 参数: const iMode: 选择模式
  1145. const sInfo: 对话框提示信息
  1146. 返回值: 如果取消取返回为空,否则返回选中的路径
  1147. --------------------------------------------------------------}
  1148. function YzSelectDir(const iMode: integer;const sInfo: string): string;
  1149. var
  1150. Info: TBrowseInfo;
  1151. IDList: pItemIDList;
  1152. Buffer: PChar;
  1153. begin
  1154. Result:='';
  1155. Buffer := StrAlloc(MAX_PATH);
  1156. with Info do
  1157. begin
  1158. hwndOwner := application.mainform.Handle; { 目录对话框所属的窗口句柄 }
  1159. pidlRoot := nil; { 起始位置,缺省为我的电脑 }
  1160. pszDisplayName := Buffer; { 用于存放选择目录的指针 }
  1161. lpszTitle := PChar(sInfo);
  1162. { 此处表示显示目录和文件,如果只显示目录则将后一个去掉即可 }
  1163. if iMode = 1 then
  1164. ulFlags := BIF_RETURNONLYFSDIRS or BIF_BROWSEINCLUDEFILES
  1165. else
  1166. ulFlags := BIF_RETURNONLYFSDIRS;
  1167. lpfn := nil; { 指定回调函数指针 }
  1168. lParam := 0; { 传递给回调函数参数 }
  1169. IDList := SHBrowseForFolder(Info); { 读取目录信息 }
  1170. end;
  1171. if IDList <> nil then
  1172. begin
  1173. SHGetPathFromIDList(IDList, Buffer); { 将目录信息转化为路径字符串 }
  1174. Result := strpas(Buffer);
  1175. end;
  1176. StrDispose(buffer);
  1177. end;
  1178. { 获取指定路径下文件夹的个数 }
  1179. procedure YzListFolders(const Path: String; const ShowPath: Boolean;var List: TStrings);
  1180. var
  1181. SRec: TSearchRec;
  1182. begin
  1183. if not Assigned(List) then List:= TStringList.Create;
  1184. FindFirst(Path + '*.*', faDirectory, SRec);
  1185. if ShowPath then
  1186. List.Add(Path + SRec.Name)
  1187. else
  1188. List.Add(SRec.Name);
  1189. while FindNext(SRec) = 0 do
  1190. if ShowPath then
  1191. List.Add(Path + SRec.Name)
  1192. else
  1193. List.Add(SRec.Name);
  1194. FindClose(SRec);
  1195. end;
  1196. { 禁用窗器控件的所有子控件 }
  1197. procedure YzSetSubCtlState(AOwer: TWinControl;AState: Boolean);
  1198. var
  1199. I: Integer;
  1200. begin
  1201. for I := 0 to AOwer.ControlCount - 1 do
  1202. AOwer.Controls[I].Enabled := AState;
  1203. end;
  1204. { 模拟键盘按键操作(处理字节码) }
  1205. procedure YzFKeyent(byteCard: byte);
  1206. var
  1207. vkkey: integer;
  1208. begin
  1209. vkkey := VkKeyScan(chr(byteCard));
  1210. if (chr(byteCard) in ['A'..'Z']) then
  1211. begin
  1212. keybd_event(VK_SHIFT, 0, 0, 0);
  1213. keybd_event(byte(byteCard), 0, 0, 0);
  1214. keybd_event(VK_SHIFT, 0, 2, 0);
  1215. end
  1216. else if chr(byteCard) in ['!', '@', '#', '$', '%', '^', '&', '*', '(', ')',
  1217. '_', '+', '|', '{', '}', ':', '"', '<', '>', '?', '~'] then
  1218. begin
  1219. keybd_event(VK_SHIFT, 0, 0, 0);
  1220. keybd_event(byte(vkkey), 0, 0, 0);
  1221. keybd_event(VK_SHIFT, 0, 2, 0);
  1222. end
  1223. else { if byteCard in [8,13,27,32] }
  1224. begin
  1225. keybd_event(byte(vkkey), 0, 0, 0);
  1226. end;
  1227. end;
  1228. { 模拟键盘按键(处理字符) }
  1229. procedure YzFKeyent(strCard: string);
  1230. var
  1231. str: string;
  1232. strLength: integer;
  1233. I: integer;
  1234. byteSend: byte;
  1235. begin
  1236. str := strCard;
  1237. strLength := length(str);
  1238. for I := 1 to strLength do
  1239. begin
  1240. byteSend := byte(str[I]);
  1241. YzFKeyent(byteSend);
  1242. end;
  1243. end;
  1244. { 锁定窗口位置 }
  1245. procedure YzLockWindow(ClassName,WinName: PChar;poX,poY: Integer);
  1246. var
  1247. CurWindow: THandle;
  1248. _wndRect: TRect;
  1249. begin
  1250. CurWindow := 0;
  1251. while True do
  1252. begin
  1253. CurWindow := FindWindow(ClassName,WinName);
  1254. if CurWindow <> 0 then Break;
  1255. YzDelayTime(10);
  1256. Application.ProcessMessages;
  1257. end;
  1258. GetWindowRect(CurWindow,_wndRect);
  1259. if ( _wndRect.Left <> poX) or ( _wndRect.Top <> poY) then
  1260. begin
  1261. MoveWindow(CurWindow,
  1262. poX,
  1263. poY,
  1264. (_wndRect.Right-_wndRect.Left),
  1265. (_wndRect.Bottom-_wndRect.Top),
  1266. TRUE);
  1267. end;
  1268. YzDelayTime(1000);
  1269. end;
  1270. {
  1271. 注册一个DLL形式或OCX形式的OLE/COM控件
  1272. 参数strOleFileName为一个DLL或OCX文件名,
  1273. 参数OleAction表示注册操作类型,1表示注册,0表示卸载
  1274. 返回值True表示操作执行成功,False表示操作执行失败
  1275. }
  1276. function YzRegisterOleFile (strOleFileName: STRING;OleAction: Byte): BOOLEAN;
  1277. const
  1278. RegisterOle = 1; { 注册 }
  1279. UnRegisterOle = 0; { 卸载 }
  1280. type
  1281. TOleRegisterFunction = function: HResult; { 注册或卸载函数的原型 }
  1282. var
  1283. hLibraryHandle: THandle; { 由LoadLibrary返回的DLL或OCX句柄 }
  1284. hFunctionAddress: TFarProc; { DLL或OCX中的函数句柄,由GetProcAddress返回 }
  1285. RegFunction: TOleRegisterFunction; { 注册或卸载函数指针 }
  1286. begin
  1287. Result := FALSE;
  1288. { 打开OLE/DCOM文件,返回的DLL或OCX句柄 }
  1289. hLibraryHandle := LoadLibrary(PCHAR(strOleFileName));
  1290. if (hLibraryHandle > 0) then { DLL或OCX句柄正确 }
  1291. try
  1292. { 返回注册或卸载函数的指针 }
  1293. if (OleAction = RegisterOle) then { 返回注册函数的指针 }
  1294. hFunctionAddress := GetProcAddress(hLibraryHandle, pchar('DllRegisterServer'))
  1295. { 返回卸载函数的指针 }
  1296. else
  1297. hFunctionAddress := GetProcAddress(hLibraryHandle, pchar('DllUnregisterServer'));
  1298. if (hFunctionAddress <> NIL) then { 注册或卸载函数存在 }
  1299. begin
  1300. { 获取操作函数的指针 }
  1301. RegFunction := TOleRegisterFunction(hFunctionAddress);
  1302. { 执行注册或卸载操作,返回值>=0表示执行成功 }
  1303. if RegFunction >= 0 then
  1304. Result := true;
  1305. end;
  1306. finally
  1307. { 关闭已打开的OLE/DCOM文件 }
  1308. FreeLibrary(hLibraryHandle);
  1309. end;
  1310. end;
  1311. function YzListViewColumnCount(mHandle: THandle): Integer;
  1312. begin
  1313. Result := Header_GetItemCount(ListView_GetHeader(mHandle));
  1314. end; { ListViewColumnCount }
  1315. function YzGetListViewText(mHandle: THandle; mStrings: TStrings): Boolean;
  1316. var
  1317. vColumnCount: Integer;
  1318. vItemCount: Integer;
  1319. I, J: Integer;
  1320. vBuffer: array[0..255] of Char;
  1321. vProcessId: DWORD;
  1322. vProcess: THandle;
  1323. vPointer: Pointer;
  1324. vNumberOfBytesRead: Cardinal;
  1325. S: string; vItem: TLVItem;
  1326. begin
  1327. Result := False;
  1328. if not Assigned(mStrings) then Exit;
  1329. vColumnCount := YzListViewColumnCount(mHandle);
  1330. if vColumnCount <= 0 then Exit;
  1331. vItemCount := ListView_GetItemCount(mHandle);
  1332. GetWindowThreadProcessId(mHandle, @vProcessId);
  1333. vProcess := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ
  1334. or PROCESS_VM_WRITE, False, vProcessId);
  1335. vPointer := VirtualAllocEx(vProcess, nil, 4096, MEM_RESERVE or MEM_COMMIT,
  1336. PAGE_READWRITE);
  1337. mStrings.BeginUpdate;
  1338. try
  1339. mStrings.Clear;
  1340. for I := 0 to vItemCount - 1 do
  1341. begin
  1342. S := '';
  1343. for J := 0 to vColumnCount - 1 do
  1344. begin
  1345. with vItem do
  1346. begin
  1347. mask := LVIF_TEXT;
  1348. iItem := I;
  1349. iSubItem := J;
  1350. cchTextMax := SizeOf(vBuffer);
  1351. pszText := Pointer(Cardinal(vPointer) + SizeOf(TLVItem));
  1352. end;
  1353. WriteProcessMemory(vProcess, vPointer, @vItem,
  1354. SizeOf(TLVItem), vNumberOfBytesRead);
  1355. SendMessage(mHandle, LVM_GETITEM, I, lparam(vPointer));
  1356. ReadProcessMemory(vProcess, Pointer(Cardinal(vPointer) + SizeOf(TLVItem)),
  1357. @vBuffer[0], SizeOf(vBuffer), vNumberOfBytesRead);
  1358. S := S + #9 + vBuffer;
  1359. end;
  1360. Delete(S, 1, 1);
  1361. mStrings.Add(S);
  1362. end;
  1363. finally
  1364. VirtualFreeEx(vProcess, vPointer, 0, MEM_RELEASE);
  1365. CloseHandle(vProcess); mStrings.EndUpdate;
  1366. end;
  1367. Result := True;
  1368. end; { GetListViewText }
  1369. { 删除目录树 }
  1370. function YzDeleteDirectoryTree(Path: string): boolean;
  1371. var
  1372. SearchRec: TSearchRec;
  1373. SFI: string;
  1374. begin
  1375. Result := False;
  1376. if (Path = '') or (not DirectoryExists(Path)) then exit;
  1377. if Path[length(Path)] <> '/' then Path := Path + '/';
  1378. SFI := Path + '*.*';
  1379. if FindFirst(SFI, faAnyFile, SearchRec) = 0 then
  1380. begin
  1381. repeat
  1382. begin
  1383. if (SearchRec.Name = '.') or (SearchRec.Name = '..') then
  1384. Continue;
  1385. if (SearchRec.Attr and faDirectory <> 0) then
  1386. begin
  1387. if not YzDeleteDirectoryTree(Path + SearchRec.name) then
  1388. Result := FALSE;
  1389. end
  1390. else
  1391. begin
  1392. FileSetAttr(Path + SearchRec.Name, 128);
  1393. DeleteFile(Path + SearchRec.Name);
  1394. end;
  1395. end
  1396. until FindNext(SearchRec) <> 0;
  1397. FindClose(SearchRec);
  1398. end;
  1399. FileSetAttr(Path, 0);
  1400. if RemoveDir(Path) then
  1401. Result := TRUE
  1402. else
  1403. Result := FALSE;
  1404. end;
  1405. { Jpg格式转换为bmp格式 }
  1406. function JpgToBmp(Jpg: TJpegImage): TBitmap;
  1407. begin
  1408. Result := nil;
  1409. if Assigned(Jpg) then
  1410. begin
  1411. Result := TBitmap.Create;
  1412. Jpg.DIBNeeded;
  1413. Result.Assign(Jpg);
  1414. end;
  1415. end;
  1416. { 设置程序自启动函数 }
  1417. function YzSetAutoRun(AFilePath: string;AFlag: Boolean): boolean;
  1418. var
  1419. AMainFName: string;
  1420. Reg: TRegistry;
  1421. begin
  1422. Result := true;
  1423. AMainFName := YzGetMainFileName(AFilePath);
  1424. Reg := TRegistry.Create;
  1425. Reg.RootKey := HKEY_LOCAL_MACHINE;
  1426. try
  1427. Reg.OpenKey('SOFTWARE/Microsoft/Windows/CurrentVersion/Run', True);
  1428. if AFlag = False then { 取消自启动 }
  1429. Reg.DeleteValue(AMainFName)
  1430. else { 设置自启动 }
  1431. Reg.WriteString(AMainFName, '"' + AFilePath + '"')
  1432. except
  1433. Result := False;
  1434. end;
  1435. Reg.CloseKey;
  1436. Reg.Free;
  1437. end;
  1438. { 检测URL地址是否有效 }
  1439. function YzCheckUrl(url: string): Boolean;
  1440. var
  1441. hSession, hfile, hRequest: HINTERNET;
  1442. dwindex, dwcodelen: dword;
  1443. dwcode: array[1..20] of Char;
  1444. res: PChar;
  1445. begin
  1446. Result := False;
  1447. try
  1448. if Pos('http://',LowerCase(url)) = 0 then url := 'http://' + url;
  1449. { Open an internet session }
  1450. hSession:=InternetOpen('InetURL:/1.0',INTERNET_OPEN_TYPE_PRECONFIG,nil,nil, 0);
  1451. if Assigned(hsession) then
  1452. begin
  1453. hfile := InternetOpenUrl(hsession, PChar(url), nil, 0,INTERNET_FLAG_RELOAD, 0);
  1454. dwIndex := 0;
  1455. dwCodeLen := 10;
  1456. HttpQueryInfo(hfile,HTTP_QUERY_STATUS_CODE,@dwcode,dwcodeLen,dwIndex);
  1457. res := PChar(@dwcode);
  1458. Result := (res = '200') or (res = '302');
  1459. if Assigned(hfile) then InternetCloseHandle(hfile);
  1460. InternetCloseHandle(hsession);
  1461. end;
  1462. except
  1463. end;
  1464. end;
  1465. { 获取程序可执行文件名 }
  1466. function YzGetExeFName: string;
  1467. begin
  1468. Result := ExtractFileName(Application.ExeName);
  1469. end;
  1470. { 目录浏览对话框函数 }
  1471. function YzBrowseFolder(AOwer: TWinControl;ATitle: string):string;
  1472. var
  1473. Info: TBrowseInfo;
  1474. Dir: array[0..260] of char;
  1475. ItemId: PItemIDList;
  1476. begin
  1477. with Info do
  1478. begin
  1479. hwndOwner := AOwer.Handle;
  1480. pidlRoot := nil;
  1481. pszDisplayName := nil;
  1482. lpszTitle := PChar(ATitle);
  1483. ulFlags := 0;
  1484. lpfn := nil;
  1485. lParam := 0;
  1486. iImage := 0;
  1487. end;
  1488. ItemId := SHBrowseForFolder(Info);
  1489. SHGetPathFromIDList(ItemId,@Dir);
  1490. Result := string(Dir);
  1491. end;
  1492. { 重启计算机 }
  1493. function YzShutDownSystem(AFlag: Integer):BOOL;
  1494. var
  1495. hProcess,hAccessToken: THandle;
  1496. LUID_AND_ATTRIBUTES: TLUIDAndAttributes;
  1497. TOKEN_PRIVILEGES: TTokenPrivileges;
  1498. BufferIsNull: DWORD;
  1499. Const
  1500. SE_SHUTDOWN_NAME='SeShutdownPrivilege';
  1501. begin
  1502. hProcess:=GetCurrentProcess();
  1503. OpenProcessToken(hprocess, TOKEN_ADJUST_PRIVILEGES+TOKEN_QUERY, hAccessToken);
  1504. LookupPrivilegeValue(Nil, SE_SHUTDOWN_NAME, LUID_AND_ATTRIBUTES.Luid);
  1505. LUID_AND_ATTRIBUTES.Attributes := SE_PRIVILEGE_ENABLED;
  1506. TOKEN_PRIVILEGES.PrivilegeCount := 1;
  1507. TOKEN_PRIVILEGES.Privileges[0] := LUID_AND_ATTRIBUTES;
  1508. BufferIsNull := 0;
  1509. AdjustTokenPrivileges(hAccessToken, False, TOKEN_PRIVILEGES, sizeof(
  1510. TOKEN_PRIVILEGES) ,Nil, BufferIsNull);
  1511. Result := ExitWindowsEx(AFlag, 0);
  1512. end;
  1513. { 程序运行后删除自身 }
  1514. procedure YzDeleteSelf;
  1515. var
  1516. hModule: THandle;
  1517. buff: array[0..255] of Char;
  1518. hKernel32: THandle;
  1519. pExitProcess, pDeleteFileA, pUnmapViewOfFile: Pointer;
  1520. begin
  1521. hModule := GetModuleHandle(nil);
  1522. GetModuleFileName(hModule, buff, sizeof(buff));
  1523. CloseHandle(THandle(4));
  1524. hKernel32 := GetModuleHandle('KERNEL32');
  1525. pExitProcess := GetProcAddress(hKernel32, 'ExitProcess');
  1526. pDeleteFileA := GetProcAddress(hKernel32, 'DeleteFileA');
  1527. pUnmapViewOfFile := GetProcAddress(hKernel32, 'UnmapViewOfFile');
  1528. asm
  1529. LEA EAX, buff
  1530. PUSH 0
  1531. PUSH 0
  1532. PUSH EAX
  1533. PUSH pExitProcess
  1534. PUSH hModule
  1535. PUSH pDeleteFileA
  1536. PUSH pUnmapViewOfFile
  1537. RET
  1538. end;
  1539. end;
  1540. { 程序重启 }
  1541. procedure YzAppRestart;
  1542. var
  1543. AppName : PChar;
  1544. begin
  1545. AppName := PChar(Application.ExeName) ;
  1546. ShellExecute(Application.Handle,'open', AppName, nil, nil, SW_SHOWNORMAL);
  1547. KillByPID(GetCurrentProcessId);
  1548. end;
  1549. { 压缩Access数据库 }
  1550. function YzCompactAccessDB(const AFileName, APassWord: string): Boolean;
  1551. var
  1552. SPath, FConStr, TmpConStr: string;
  1553. SFile: array[0..254] of Char;
  1554. STempFileName: string;
  1555. JE: OleVariant;
  1556. function GetTempDir: string;
  1557. var
  1558. Buffer: array[0..MAX_PATH] of Char;
  1559. begin
  1560. ZeroMemory(@Buffer, MAX_PATH);
  1561. GetTempPath(MAX_PATH, Buffer);
  1562. Result := IncludeTrailingBackslash(StrPas(Buffer));
  1563. end;
  1564. begin
  1565. Result := False;
  1566. SPath := GetTempDir; { 取得Windows的Temp路径 }
  1567. { 取得Temp文件名,Windows将自动建立0字节文件 }
  1568. GetTempFileName(PChar(SPath), '~ACP', 0, SFile);
  1569. STempFileName := SFile;
  1570. { 删除Windows建立的0字节文件 }
  1571. if not DeleteFile(STempFileName) then Exit;
  1572. try
  1573. JE := CreateOleObject('JRO.JetEngine');
  1574. { 压缩数据库 }
  1575. FConStr := 'Provider=Microsoft.Jet.OLEDB.4.0;' + 'Data Source=' + AFileName
  1576. + ';Jet OLEDB:DataBase PassWord=' + APassWord;
  1577. TmpConStr := 'Provider=Microsoft.Jet.OLEDB.4.0;' + 'Data Source=' + STempFileName
  1578. + ';Jet OLEDB:DataBase PassWord=' + APassWord;
  1579. JE.CompactDatabase(FConStr, TmpConStr);
  1580. { 覆盖源数据库文件 }
  1581. Result := CopyFile(PChar(STempFileName), PChar(AFileName), False);
  1582. { 删除临时文件 }
  1583. DeleteFile(STempFileName);
  1584. except
  1585. Application.MessageBox('压缩数据库失败!', '提示', MB_OK +
  1586. MB_ICONINFORMATION);
  1587. end;
  1588. end;
  1589. { 标题:获取其他进程中TreeView的文本 }
  1590. function YzTreeNodeGetNext(mHandle: THandle; mTreeItem: HTreeItem): HTreeItem;
  1591. var
  1592. vParentID: HTreeItem;
  1593. begin
  1594. Result := nil;
  1595. if (mHandle <> 0) and (mTreeItem <> nil) then
  1596. begin
  1597. Result := TreeView_GetChild(mHandle, mTreeItem);
  1598. if Result = nil then
  1599. Result := TreeView_GetNextSibling(mHandle, mTreeItem);
  1600. vParentID := mTreeItem;
  1601. while (Result = nil) and (vParentID <> nil) do
  1602. begin
  1603. vParentID := TreeView_GetParent(mHandle, vParentID);
  1604. Result := TreeView_GetNextSibling(mHandle, vParentID);
  1605. end;
  1606. end;
  1607. end; { TreeNodeGetNext }
  1608. function YzTreeNodeGetLevel(mHandle: THandle; mTreeItem: HTreeItem): Integer;
  1609. var
  1610. vParentID: HTreeItem;
  1611. begin
  1612. Result := -1;
  1613. if (mHandle <> 0) and (mTreeItem <> nil) then
  1614. begin
  1615. vParentID := mTreeItem;
  1616. repeat
  1617. Inc(Result);
  1618. vParentID := TreeView_GetParent(mHandle, vParentID);
  1619. until vParentID = nil;
  1620. end;
  1621. end; { TreeNodeGetLevel }
  1622. function YzGetTreeViewText(mHandle: THandle; mStrings: TStrings): Boolean;
  1623. var
  1624. vItemCount: Integer;
  1625. vBuffer: array[0..255] of Char;
  1626. vProcessId: DWORD;
  1627. vProcess: THandle;
  1628. vPointer: Pointer;
  1629. vNumberOfBytesRead: Cardinal;
  1630. I: Integer;
  1631. vItem: TTVItem;
  1632. vTreeItem: HTreeItem;
  1633. begin
  1634. Result := False;
  1635. if not Assigned(mStrings) then Exit;
  1636. GetWindowThreadProcessId(mHandle, @vProcessId);
  1637. vProcess := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or
  1638. PROCESS_VM_WRITE, False, vProcessId);
  1639. vPointer := VirtualAllocEx(vProcess, nil, 4096, MEM_RESERVE or
  1640. MEM_COMMIT, PAGE_READWRITE);
  1641. mStrings.BeginUpdate;
  1642. try
  1643. mStrings.Clear;
  1644. vItemCount := TreeView_GetCount(mHandle);
  1645. vTreeItem := TreeView_GetRoot(mHandle);
  1646. for I := 0 to vItemCount - 1 do
  1647. begin
  1648. with vItem do begin
  1649. mask := TVIF_TEXT; cchTextMax := SizeOf(vBuffer);
  1650. pszText := Pointer(Cardinal(vPointer) + SizeOf(vItem));
  1651. hItem := vTreeItem;
  1652. end;
  1653. WriteProcessMemory(vProcess, vPointer, @vItem, SizeOf(vItem),
  1654. vNumberOfBytesRead);
  1655. SendMessage(mHandle, TVM_GETITEM, 0, lparam(vPointer));
  1656. ReadProcessMemory(vProcess, Pointer(Cardinal(vPointer) + SizeOf(TLVItem)),
  1657. @vBuffer[0], SizeOf(vBuffer), vNumberOfBytesRead);
  1658. mStrings.Add(StringOfChar(#9, YzTreeNodeGetLevel(mHandle, vTreeItem)) + vBuffer);
  1659. vTreeItem := YzTreeNodeGetNext(mHandle, vTreeItem);
  1660. end;
  1661. finally
  1662. VirtualFreeEx(vProcess, vPointer, 0, MEM_RELEASE);
  1663. CloseHandle(vProcess); mStrings.EndUpdate;
  1664. end;
  1665. Result := True;
  1666. end; { GetTreeViewText }
  1667. { 获取其他进程中ListBox和ComboBox的内容 }
  1668. function YzGetListBoxText(mHandle: THandle; mStrings: TStrings): Boolean;
  1669. var
  1670. vItemCount: Integer;
  1671. I: Integer;
  1672. S: string;
  1673. begin
  1674. Result := False;
  1675. if not Assigned(mStrings) then Exit;
  1676. mStrings.BeginUpdate;
  1677. try
  1678. mStrings.Clear;
  1679. vItemCount := SendMessage(mHandle, LB_GETCOUNT, 0, 0);
  1680. for I := 0 to vItemCount - 1 do
  1681. begin
  1682. SetLength(S, SendMessage(mHandle, LB_GETTEXTLEN, I, 0));
  1683. SendMessage(mHandle, LB_GETTEXT, I, Integer(@S[1]));
  1684. mStrings.Add(S);
  1685. end;
  1686. SetLength(S, 0);
  1687. finally
  1688. mStrings.EndUpdate;
  1689. end;
  1690. Result := True;
  1691. end; { GetListBoxText }
  1692. function YzGetComboBoxText(mHandle: THandle; mStrings: TStrings): Boolean;
  1693. var
  1694. vItemCount: Integer;
  1695. I: Integer;
  1696. S: string;
  1697. begin
  1698. Result := False;
  1699. if not Assigned(mStrings) then Exit;
  1700. mStrings.BeginUpdate;
  1701. try
  1702. mStrings.Clear;
  1703. vItemCount := SendMessage(mHandle, CB_GETCOUNT, 0, 0);
  1704. for I := 0 to vItemCount - 1 do
  1705. begin
  1706. SetLength(S, SendMessage(mHandle, CB_GETLBTEXTLEN, I, 0));
  1707. SendMessage(mHandle, CB_GETLBTEXT, I, Integer(@S[1]));
  1708. mStrings.Add(S);
  1709. end;
  1710. SetLength(S, 0);
  1711. finally
  1712. mStrings.EndUpdate;
  1713. end;
  1714. Result := True;
  1715. end; { GetComboBoxText }
  1716. { 获取本地Application Data目录路径 }
  1717. function YzLocalAppDataPath : string;
  1718. const
  1719. SHGFP_TYPE_CURRENT = 0;
  1720. var
  1721. Path: array [0..MAX_PATH] of char;
  1722. begin
  1723. SHGetFolderPath(0, CSIDL_LOCAL_APPDATA, 0, SHGFP_TYPE_CURRENT, @path[0]) ;
  1724. Result := Path;
  1725. end;
  1726. { 获取Windows当前登录的用户名 }
  1727. function YzGetWindwosUserName: String;
  1728. var
  1729. pcUser: PChar;
  1730. dwUSize: DWORD;
  1731. begin
  1732. dwUSize := 21;
  1733. result := '';
  1734. GetMem(pcUser, dwUSize);
  1735. try
  1736. if Windows.GetUserName(pcUser, dwUSize) then
  1737. Result := pcUser
  1738. finally
  1739. FreeMem(pcUser);
  1740. end;
  1741. end;
  1742. {-------------------------------------------------------------
  1743. 功 能: delphi 枚举托盘图标
  1744. 参 数: AFindList: 返回找到的托盘列表信息
  1745. 返回值: 成功为True,反之为False
  1746. 备 注: 返回的格式为: 位置_名称_窗口句柄_进程ID
  1747. --------------------------------------------------------------}
  1748. function YzEnumTrayNotifyWnd(AFindList: TStringList;ADestStr: string): BOOL;
  1749. var
  1750. wd: HWND;
  1751. wtd: HWND;
  1752. wd1: HWND;
  1753. pid: DWORD;
  1754. hd: THandle;
  1755. num, i: integer;
  1756. n: ULONG;
  1757. p: TTBBUTTON;
  1758. pp: ^TTBBUTTON;
  1759. x: string;
  1760. name: array[0..255] of WCHAR;
  1761. whd, proid: ulong;
  1762. temp: string;
  1763. sp: ^TTBBUTTON;
  1764. _sp: TTBButton;
  1765. begin
  1766. Result := False;
  1767. wd := FindWindow('Shell_TrayWnd', nil);
  1768. if (wd = 0) then Exit;
  1769. wtd := FindWindowEx(wd, 0, 'TrayNotifyWnd', nil);
  1770. if (wtd = 0) then Exit;
  1771. wtd := FindWindowEx(wtd, 0, 'SysPager', nil);
  1772. if (wtd = 0) then Exit;
  1773. wd1 := FindWindowEx(wtd, 0, 'ToolbarWindow32', nil);
  1774. if (wd1 = 0) then Exit;
  1775. pid := 0;
  1776. GetWindowThreadProcessId(wd1, @pid);
  1777. if (pid = 0) then Exit;
  1778. hd := OpenProcess(PROCESS_ALL_ACCESS, true, pid);
  1779. if (hd = 0) then Exit;
  1780. num := SendMessage(wd1, TB_BUTTONCOUNT, 0, 0);
  1781. sp := @_sp;
  1782. for i := 0 to num do
  1783. begin
  1784. SendMessage(wd1, TB_GETBUTTON, i, integer(sp));
  1785. pp := @p;
  1786. ReadProcessMemory(hd, sp, pp, sizeof(p), n);
  1787. name[0] := Char(0);
  1788. if (Cardinal(p.iString) <> $FFFFFFFF) then
  1789. begin
  1790. try
  1791. ReadProcessMemory(hd, pointer(p.iString), @name, 255, n);
  1792. name[n] := Char(0);
  1793. except
  1794. end;
  1795. temp := name;
  1796. try
  1797. whd := 0;
  1798. ReadProcessMemory(hd, pointer(p.dwData), @whd, 4, n);
  1799. except
  1800. end;
  1801. proid := 0;
  1802. GetWindowThreadProcessId(whd, @proid);
  1803. AFindList.Add(Format('%d_%s_%x_%x', [i, temp, whd, proid]));
  1804. if CompareStr(temp, ADestStr) = 0 then Result := True;
  1805. end;
  1806. end;
  1807. end;
  1808. { 获取SQL Server用户数据库列表 }
  1809. procedure YzGetSQLServerDBList(ADBHostIP, ALoginPwd: string;ADBList: TStringList);
  1810. var
  1811. PQuery: TADOQuery;
  1812. ConnectStr: string;
  1813. begin
  1814. ConnectStr := 'Provider=SQLOLEDB.1;Password=' + ALoginPwd
  1815. + ';Persist Security Info=True;User ID=sa;Initial Catalog=master'
  1816. + ';Data Source=' + ADBHostIP;
  1817. ADBList.Clear;
  1818. PQuery := TADOQuery.Create(nil);
  1819. try
  1820. PQuery.ConnectionString := ConnectStr;
  1821. PQuery.SQL.Text:='select name from sysdatabases where dbid > 6';
  1822. PQuery.Open;
  1823. while not PQuery.Eof do
  1824. begin
  1825. ADBList.add(PQuery.Fields[0].AsString);
  1826. PQuery.Next;
  1827. end;
  1828. finally
  1829. PQuery.Free;
  1830. end;
  1831. end;
  1832. { 检测数据库中是否存在给定的表 }
  1833. procedure YzGetTableList(ConncetStr: string;ATableList: TStringList);
  1834. var
  1835. FConnection: TADOConnection;
  1836. begin
  1837. FConnection := TADOConnection.Create(nil);
  1838. try
  1839. FConnection.LoginPrompt := False;
  1840. FConnection.Connected := False;
  1841. FConnection.ConnectionString := ConncetStr;
  1842. FConnection.Connected := True;
  1843. FConnection.GetTableNames(ATableList, False);
  1844. finally
  1845. FConnection.Free;
  1846. end;
  1847. end;
  1848. { 将域名解释成IP地址 }
  1849. function YzDomainToIP(HostName: string): string;
  1850. type
  1851. tAddr = array[0..100] of PInAddr;
  1852. pAddr = ^tAddr;
  1853. var
  1854. I: Integer;
  1855. WSA: TWSAData;
  1856. PHE: PHostEnt;
  1857. P: pAddr;
  1858. begin
  1859. Result := '';
  1860. WSAStartUp($101, WSA);
  1861. try
  1862. PHE := GetHostByName(pChar(HostName));
  1863. if (PHE <> nil) then
  1864. begin
  1865. P := pAddr(PHE^.h_addr_list);
  1866. I := 0;
  1867. while (P^[I] <> nil) do
  1868. begin
  1869. Result := (inet_nToa(P^[I]^));
  1870. Inc(I);
  1871. end;
  1872. end;
  1873. except
  1874. end;
  1875. WSACleanUp;
  1876. end;
  1877. { 移去系统托盘失效图标 }
  1878. procedure YzRemoveDeadIcons();
  1879. var
  1880. hTrayWindow: HWND;
  1881. rctTrayIcon: TRECT;
  1882. nIconWidth, nIconHeight:integer;
  1883. CursorPos: TPoint;
  1884. nRow, nCol: Integer;
  1885. Begin
  1886. //Get tray window handle and bounding rectangle
  1887. hTrayWindow := FindWindowEx(FindWindow('Shell_TrayWnd ', nil), 0, 'TrayNotifyWnd ', nil);
  1888. if Not (GetWindowRect(hTrayWindow, rctTrayIcon)) then Exit;
  1889. //Get small icon metrics
  1890. nIconWidth := GetSystemMetrics(SM_CXSMICON);
  1891. nIconHeight := GetSystemMetrics(SM_CYSMICON);
  1892. //Save current mouse position }
  1893. GetCursorPos(CursorPos);
  1894. //Sweep the mouse cursor over each icon in the tray in both dimensions
  1895. for nRow := 0 To ((rctTrayIcon.bottom - rctTrayIcon.top) div nIconHeight) Do
  1896. Begin
  1897. for nCol := 0 To ((rctTrayIcon.right - rctTrayIcon.left) div nIconWidth) Do
  1898. Begin
  1899. SetCursorPos(rctTrayIcon.left + nCol * nIconWidth + 5,
  1900. rctTrayIcon.top + nRow * nIconHeight + 5);
  1901. Sleep(0);
  1902. end;
  1903. end;
  1904. //Restore mouse position
  1905. SetCursorPos(CursorPos.x, CursorPos.x);
  1906. //Redraw tray window(to fix bug in multi-line tray area)
  1907. RedrawWindow(hTrayWindow, nil, 0, RDW_INVALIDATE Or RDW_ERASE Or RDW_UPDATENOW);
  1908. end;
  1909. { 转移程序占用内存至虚拟内存 }
  1910. procedure YzClearMemory;
  1911. begin
  1912. if Win32Platform = VER_PLATFORM_WIN32_NT then
  1913. begin
  1914. SetProcessWorkingSetSize(GetCurrentProcess, $FFFFFFFF, $FFFFFFFF);
  1915. Application.ProcessMessages;
  1916. end;
  1917. end;
  1918. { 检测允许试用的天数是否已到期 }
  1919. function YzCheckTrialDays(AllowDays: Integer): Boolean;
  1920. var
  1921. Reg_ID, Pre_ID: TDateTime;
  1922. FRegister: TRegistry;
  1923. begin
  1924. { 初始化为试用没有到期 }
  1925. Result := True;
  1926. FRegister := TRegistry.Create;
  1927. try
  1928. with FRegister do
  1929. begin
  1930. RootKey := HKEY_LOCAL_MACHINE;
  1931. if OpenKey('Software/Microsoft/Windows/CurrentSoftware/'
  1932. + YzGetMainFileName(Application.ExeName), True) then
  1933. begin
  1934. if ValueExists('DateTag') then
  1935. begin
  1936. Reg_ID := ReadDate('DateTag');
  1937. if Reg_ID = 0 then Exit;
  1938. Pre_ID := ReadDate('PreDate');
  1939. { 允许使用的时间到 }
  1940. if ((Reg_ID <> 0) and (Now - Reg_ID > AllowDays)) or
  1941. (Pre_ID <> Reg_ID) or (Reg_ID > Now) then
  1942. begin
  1943. { 防止向前更改日期 }
  1944. WriteDateTime('PreDate', Now + 20000);
  1945. Result := False;
  1946. end;
  1947. end
  1948. else
  1949. begin
  1950. { 首次运行时保存初始化数据 }
  1951. WriteDateTime('PreDate', Now);
  1952. WriteDateTime('DateTag', Now);
  1953. end;
  1954. end;
  1955. end;
  1956. finally
  1957. FRegister.Free;
  1958. end;
  1959. end;
  1960. { 指定长度的随机小写字符串函数 }
  1961. function YzRandomStr(aLength: Longint): string;
  1962. var
  1963. X: Longint;
  1964. begin
  1965. if aLength <= 0 then exit;
  1966. SetLength(Result, aLength);
  1967. for X := 1 to aLength do
  1968. Result[X] := Chr(Random(26) + 65);
  1969. Result := LowerCase(Result);
  1970. end;
  1971. end.

  

转载于:https://www.cnblogs.com/qingsong/p/4033170.html

声明:本文内容由网友自发贡献,不代表【wpsshop博客】立场,版权归原作者所有,本站不承担相应法律责任。如您发现有侵权的内容,请联系我们。转载请注明出处:https://www.wpsshop.cn/w/2023面试高手/article/detail/234331
推荐阅读
  

闽ICP备14008679号