Delphi公用函数单元

最新推荐文章于 2019-01-07 23:15:19 发布
最新推荐文章于 2019-01-07 23:15:19 发布
阅读量315 收藏 1
点赞数 1
文章标签： 操作系统 数据库 java
原文链接：http://www.cnblogs.com/leonkin/p/3534057.html
版权 
{*******************************************************}
{                                                       }
{             Delphi公用函数单元                        }
{                                                       }
{        版权所有 (C) 2008                           }
{                                                       }
{*******************************************************}
unit YzDelphiFunc;

interface

uses
  ComCtrls, Forms, Windows, Classes, SysUtils, ComObj, ActiveX, ShlObj, Messages,
  Graphics, Registry, Dialogs, Controls, uProcess, uCpuUsage, StrUtils, CommCtrl,
  jpeg, WinInet, ShellAPI, SHFolder, ADODB, WinSock;

{ 保存日志文件 }
procedure YzWriteLogFile(Msg: String);

{ 延时函数,单位为毫秒 }
procedure YzDelayTime(MSecs: Longint);

{ 判断字符串是否为数字 }
function YzStrIsNum(Str: string):boolean;

{ 判断文件是否正在使用 }
function YzIsFileInUse(fName: string): boolean;

{ 删除字符串列表中的空字符串 }
procedure YzDelEmptyChar(AList: TStringList);

{ 删除文件列表中的"Thumbs.db"文件 }
procedure YzDelThumbsFile(AList: TStrings);

{ 返回一个整数指定位数的带"0"字符串 }
function YzIntToZeroStr(Value, ALength: Integer): string;

{ 取日期年份分量 }
function YzGetYear(Date: TDate): Integer;

{ 取日期月份分量 }
function YzGetMonth(Date: TDate): Integer;

{ 取日期天数分量 }
function YzGetDay(Date: TDate): Integer;

{ 取时间小时分量 }
function YzGetHour(Time: TTime): Integer;

{ 取时间分钟分量 }
function YzGetMinute(Time: TTime): Integer;

{ 取时间秒钟分量 }
function YzGetSecond(Time: TTime): Integer;

{ 返回时间分量字符串 }
function YzGetTimeStr(ATime: TTime;AFlag: string): string;

{ 返回日期时间字符串 }
function YzGetDateTimeStr(ATime: TTime;ADate: TDate): string;

{ 获取计算机名称 }
function YzGetComputerName(): string;

{ 通过窗体子串查找窗体 }
procedure YzFindSpecWindow(ASubTitle: string);

{ 判断进程CPU占用率 }
procedure YzJudgeCPU(ProcessName: string;CPUUsage: Single);

{ 分割字符串 }
procedure YzSeparateTerms(Source: string;Separator: Char;Terms: TStringList);

{ 切换页面控件的活动页面 }
procedure YzGotoNewPage(AOwerPage: TPageControl;ANewPage: TTabSheet);

{ 设置页面控件标签的可见性 }
procedure YzSetTableVisible(PageControl: TPageControl;ShowFlag: Boolean);

{ 根据产品名称获取产品编号 }
function YzGetLevelCode(AName:string;ProductList: TStringList): string;

{ 取文件的主文件名 }
function YzGetMainFileName(AFileName: string): string;

{ 按下一个键 }
procedure YzPressOneKey(AByteCode: Byte);overload;

{ 按下一个指定次数的键 }
procedure YzPressOneKey(AByteCode: Byte;ATimes: Integer);overload;

{ 按下二个键 }
procedure YzPressTwoKeys(AFirstByteCode, ASecByteCode: Byte);

{ 按下三个键 }
procedure YzPressThreeKeys(AFirstByteCode, ASecByteCode, AThirdByteCode: Byte);

{ 创建桌面快捷方式 }
procedure YzCreateShortCut(const sPath: string; sShortCutName: WideString);

{ 删除桌面快捷方式 }
procedure YzDeleteShortCut(sShortCutName: WideString);

{ 通过光标位置进行鼠标左键单击 }
procedure YzMouseLeftClick(X, Y: Integer);overload;

{ 鼠标左键双击 }
procedure YzMouseDoubleClick(X, Y: Integer);

{ 通过窗口句柄进行鼠标左键单击 }
procedure YzMouseLeftClick(lpClassName, lpWindowName: PAnsiChar);overload;

{ 通过光标位置查找窗口句柄 }
function YzWindowFromPoint(X, Y: Integer): THandle;

{ 等待窗口在指定时间后出现 }
function YzWaitWindowExist(lpClassName, lpWindowName: PAnsiChar;
  ASecond: Integer = 0): THandle;overload;

{ 通光标位置,窗口类名与标题查找窗口是否存在 }
function YzWaitWindowExist(X, Y: Integer;AClassName, AWinName: string;
  ASecond: Integer = 0):THandle; overload;

{ 等待指定窗口消失 }
procedure YzWaitWindowClose(lpClassName, lpWindowName: PAnsiChar;
  ASecond: Integer = 0);

{ 通过窗口句柄设置文本框控件文本 }
procedure YzSetEditText(lpClassName, lpWindowName: PAnsiChar;
  AText: string);overload;

{ 通过光标位置设置文本框控件文本 }
procedure YzSetEditText(X, Y: Integer;AText: string);overload;

{ 获取Window操作系统语言 }
function YzGetWindowsLanguageStr: String;

{ 清空动态数组 }
procedure YzDynArraySetZero(var A);

{ 动态设置屏幕分辨率 }
function YzDynamicResolution(X, Y: WORD): Boolean;

{ 检测系统屏幕分辨率 }
function YzCheckDisplayInfo(X, Y: Integer): Boolean;

type
  TFontedControl = class(TControl)
  public
    property Font;
  end;
  TFontMapping = record
    SWidth : Integer;
    SHeight: Integer;
    FName: string;
    FSize: Integer;
  end;

  procedure YzFixForm(AForm: TForm);
  procedure YzSetFontMapping;

{---------------------------------------------------
 以下是关于获取系统软件卸载的信息的类型声明和函数
 ----------------------------------------------------}
type
  TUninstallInfo = array of record
    RegProgramName: string;
    ProgramName   : string;
    UninstallPath : string;
    Publisher     : string;
    PublisherURL  : string;
    Version       : string;
    HelpLink      : string;
    UpdateInfoURL : string;
    RegCompany    : string;
    RegOwner      : string;
  end;

{ GetUninstallInfo 返回系统软件卸载的信息 }
function YzGetUninstallInfo : TUninstallInfo;

{ 检测Java安装信息 }
function YzCheckJavaInfo(AUninstallInfo: TUninstallInfo;CheckJava6 : Boolean = False): Boolean;

{ 窗口自适应屏幕大小 }
procedure YzAdjustForm(Form: TForm;const OrgWidth, OrgHeight: integer);

{ 设置窗口为当前窗体 }
procedure YzBringMyAppToFront(AppHandle: THandle);

{ 获取文件夹大小 }
function YzGetDirSize(Dir: string;SubDir: Boolean): LongInt;

{ 获取文件夹文件数量 }
function YzGetDirFiles(Dir: string;SubDir: Boolean): LongInt;

{ 获取文件大小(KB) }
function YzGetFileSize(const FileName: String): LongInt;

{ 获取文件大小(字节) }
function YzGetFileSize_Byte(const FileName: String): LongInt;

{ 算术舍入法的四舍五入取整函数 }
function YzRoundEx (const Value: Real): LongInt;

{ 弹出选择目录对话框 }
function YzSelectDir(const iMode: integer;const sInfo: string): string;

{ 获取指定路径下文件夹的个数 }
procedure YzListFolders(const Path: String; const ShowPath: Boolean;var List: TStrings);

{ 禁用窗器控件的所有子控件 }
procedure YzSetSubCtlState(AOwer: TWinControl;AState: Boolean);

{ 模拟键盘按键操作(处理字节码) }
procedure YzFKeyent(byteCard: byte); overload;

{ 模拟键盘按键操作(处理字符串 }
procedure YzFKeyent(strCard: string); overload;

{ 锁定窗口位置 }
procedure YzLockWindow(ClassName,WinName: PChar;poX,poY: Integer);

{   注册一个DLL形式或OCX形式的OLE/COM控件
    参数strOleFileName为一个DLL或OCX文件名，
    参数OleAction表示注册操作类型，1表示注册，0表示卸载
    返回值True表示操作执行成功，False表示操作执行失败
}
function YzRegisterOleFile (strOleFileName: STRING;OleAction: Byte): BOOLEAN;

function YzListViewColumnCount(mHandle: THandle): Integer;

function YzGetListViewText(mHandle: THandle; mStrings: TStrings): Boolean;

{ 删除目录树 }
function YzDeleteDirectoryTree(Path: string): boolean;

{ Jpg格式转换为bmp格式 }
function JpgToBmp(Jpg: TJpegImage): TBitmap;

{ 设置程序自启动函数 }
function YzSetAutoRun(AFilePath: string;AFlag: Boolean): boolean;

{ 检测URL地址是否有效 }
function YzCheckUrl(url: string): Boolean;

{ 获取程序可执行文件名 }
function YzGetExeFName: string;

{ 目录浏览对话框函数 }
function YzBrowseFolder(AOwer: TWinControl;ATitle: string):string;

{ 重启计算机 }
function YzShutDownSystem(AFlag: Integer):BOOL;

{ 程序运行后删除自身 }
procedure YzDeleteSelf;

{ 程序重启 }
procedure YzAppRestart;

{ 压缩Access数据库 }
function YzCompactAccessDB(const AFileName, APassWord: string): Boolean;

{ 标题:获取其他进程中TreeView的文本 }
function YzTreeNodeGetNext(mHandle: THandle; mTreeItem: HTreeItem): HTreeItem;
function YzTreeNodeGetLevel(mHandle: THandle; mTreeItem: HTreeItem): Integer;
function YzGetTreeViewText(mHandle: THandle; mStrings: TStrings): Boolean;

{ 获取本地Application Data目录路径 }
function YzLocalAppDataPath : string;

{ 获取Windows当前登录的用户名 }
function YzGetWindwosUserName: String;

{枚举托盘图标 }
function YzEnumTrayNotifyWnd(AFindList: TStringList;ADestStr: string): BOOL;

{ 获取SQL Server用户数据库列表 }
procedure YzGetSQLServerDBList(ADBHostIP, ALoginPwd: string;ADBList: TStringList);

{ 读取据库中所有的表 }
procedure YzGetTableList(ConncetStr: string;ATableList: TStringList);

{ 将域名解释成IP地址 }
function YzDomainToIP(HostName: string): string;

{ 等待进程结束 }
procedure YzWaitProcessExit(AProcessName: string);

{ 移去系统托盘失效图标 }
procedure YzRemoveDeadIcons();

{ 转移程序占用内存至虚拟内存 }
procedure YzClearMemory;

{ 检测允许试用的天数是否已到期 }
function YzCheckTrialDays(AllowDays: Integer): Boolean;

{ 指定长度的随机小写字符串函数 }
function YzRandomStr(aLength: Longint): string;

var
  FontMapping : array of TFontMapping;

implementation

uses
  uMain;

{ 保存日志文件 }
procedure YzWriteLogFile(Msg: String);
var
  FileStream: TFileStream;
  LogFile   : String;
begin
  try
    { 每天一个日志文件 }
    Msg := '[' + DateTimeToStr(Now)+ '] '+ Msg;
    LogFile := ExtractFilePath(Application.ExeName) + '/Logs/' + DateToStr(Now) + '.log';
    if not DirectoryExists(ExtractFilePath(LogFile)) then
      CreateDir(ExtractFilePath(LogFile));
    if FileExists(LogFile) then
      FileStream := TFileStream.Create(LogFile, fmOpenWrite or fmShareDenyNone)
    else
      FileStream:=TFileStream.Create(LogFile,fmCreate or fmShareDenyNone);
    FileStream.Position:=FileStream.Size;
    Msg := Msg + #13#10;
    FileStream.Write(PChar(Msg)^, Length(Msg));
    FileStream.Free;
  except
  end;
end;

{ 延时函数,单位为毫秒 }
procedure YZDelayTime(MSecs: Longint);
var
  FirstTickCount, Now: Longint;
begin
  FirstTickCount := GetTickCount();
  repeat
    Application.ProcessMessages;
    Now := GetTickCount();
  until (Now - FirstTickCount>=MSecs) or (Now < FirstTickCount);
end;

{ 判断字符串是否为数字 }
function YzStrIsNum(Str: string):boolean;
var
  I: integer;
begin
  if Str = '' then
  begin
    Result := False;
    Exit;
  end;
  for I:=1 to length(str) do
    if not (Str[I] in ['0'..'9']) then
    begin
      Result := False;
      Exit;
    end;
  Result := True;
end;

{ 判断文件是否正在使用 }
function YzIsFileInUse(fName: string): boolean;
var
  HFileRes: HFILE;
begin
  Result := false;
  if not FileExists(fName) then exit;
  HFileRes := CreateFile(pchar(fName), GENERIC_READ or GENERIC_WRITE, 0, nil,
    OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  Result := (HFileRes = INVALID_HANDLE_VALUE);
  if not Result then CloseHandle(HFileRes);
end;

{ 删除字符串列表中的空字符串 }
procedure YzDelEmptyChar(AList: TStringList);
var
  I: Integer;
  TmpList: TStringList;
begin
  TmpList := TStringList.Create;
  for I := 0 to AList.Count - 1 do
    if AList.Strings[I] <> '' then TmpList.Add(AList.Strings[I]);
  AList.Clear;
  AList.Text := TmpList.Text;
  TmpList.Free;
end;

{ 删除文件列表中的"Thumbs.db"文件 }
procedure YzDelThumbsFile(AList: TStrings);
var
  I: Integer;
  TmpList: TStringList;
begin
  TmpList := TStringList.Create;
  for I := 0 to AList.Count - 1 do
    if ExtractFileName(AList.Strings[I]) <> 'Thumbs.db' then
      TmpList.Add(AList.Strings[I]);
  AList.Clear;
  AList.Text := TmpList.Text;
  TmpList.Free;
end;

{-------------------------------------------------------------
  功能:    返回一个整数指定位数的带"0"字符串
  参数:    Value:要转换的整数 ALength:字符串长度
  返回值:  string
--------------------------------------------------------------}
function YzIntToZeroStr(Value, ALength: Integer): string;
var
  I, ACount: Integer;
begin
  Result := '';
  ACount := Length(IntToStr(Value));
  if ACount >= ALength then Result := IntToStr(Value)
  else
  begin
    for I := 1 to ALength-ACount do
      Result := Result + '0';
    Result := Result + IntToStr(Value)
  end;
end;

{ 取日期年份分量 }
function YzGetYear(Date: TDate): Integer;
var
  y, m, d: WORD;
begin
  DecodeDate(Date, y, m, d);
  Result := y;
end;

{ 取日期月份分量 }
function YzGetMonth(Date: TDate): Integer;
var
  y, m, d: WORD;
begin
  DecodeDate(Date, y, m, d);
  Result := m;
end;

{ 取日期天数分量 }
function YzGetDay(Date: TDate): Integer;
var
  y, m, d: WORD;
begin
  DecodeDate(Date, y, m, d);
  Result := d;
end;

{ 取时间小时分量 }
function YzGetHour(Time: TTime): Integer;
var
  h, m, s, ms: WORD;
begin
  DecodeTime(Time, h, m, s, ms);
  Result := h;
end;

{ 取时间分钟分量 }
function YzGetMinute(Time: TTime): Integer;
var
  h, m, s, ms: WORD;
begin
  DecodeTime(Time, h, m, s, ms);
  Result := m;
end;

{ 取时间秒钟分量 }
function YzGetSecond(Time: TTime): Integer;
var
  h, m, s, ms: WORD;
begin
  DecodeTime(Time, h, m, s, ms);
  Result := s;
end;

{ 返回时间分量字符串 }
function YzGetTimeStr(ATime: TTime;AFlag: string): string;
var
  wTimeStr: string;
  FH, FM, FS, FMS: WORD;
const
  HOURTYPE    = 'Hour';
  MINUTETYPE  = 'Minute';
  SECONDTYPE  = 'Second';
  MSECONDTYPE = 'MSecond';
begin
  wTimeStr := TimeToStr(ATime);
  if Pos('上午', wTimeStr) <> 0 then
    wTimeStr := Copy(wTimeStr, Pos('上午', wTimeStr) + 4, 10)
  else if Pos('下午', wTimeStr) <> 0 then
    wTimeStr := Copy(wTimeStr, Pos('下午', wTimeStr) + 4, 10);
  DecodeTime(ATime, FH, FM, FS, FMS);
  if AFlag = HOURTYPE then
  begin
    { 如果是12小时制则下午的小时分量加12 }
    if Pos('下午', wTimeStr) <> 0 then
      Result := YzIntToZeroStr(FH + 12, 2)
    else
      Result := YzIntToZeroStr(FH, 2);
  end;
  if AFlag = MINUTETYPE  then Result := YzIntToZeroStr(FM, 2);
  if AFlag = SECONDTYPE  then Result := YzIntToZeroStr(FS, 2);
  if AFlag = MSECONDTYPE then Result := YzIntToZeroStr(FMS, 2);
end;

{ 返回日期时间字符串 }
function YzGetDateTimeStr(ATime: TTime;ADate: TDate): string;
var
  wYear, wMonth, wDay: string;
  wHour, wMinute, wSecond: string;
begin
  wYear := RightStr(YzIntToZeroStr(YzGetYear(ADate), 4), 2);
  wMonth := YzIntToZeroStr(YzGetMonth(ADate), 2);
  wDay := YzIntToZeroStr(YzGetDay(ADate), 2);

  wHour := YzGetTimeStr(ATime, 'Hour');
  wMinute := YzGetTimeStr(ATime, 'Minute');
  wSecond := YzGetTimeStr(ATime, 'Second');

  Result := wYear + wMonth + wDay + wHour + wMinute + wSecond;
end;

{ 通过窗体子串查找窗体 }
procedure YzFindSpecWindow(ASubTitle: string);

  function EnumWndProc(AWnd: THandle;AWinName: string): Boolean;stdcall;
  var
    WindowText: array[0..255] of Char;
    WindowStr: string;
  begin
    GetWindowText(AWnd, WindowText, 255);
    WindowStr := StrPas(WindowText);
    WindowStr := COPY(WindowStr, 1, StrLen(PChar(AWinName)));
    if CompareText(AWinName, WindowStr) = 0 then
    begin
      SetForegroundWindow(AWnd);
      Result := False; Exit;
    end;
    Result := True;
  end;

begin
  EnumWindows(@EnumWndProc, LongInt(@ASubTitle));
  YzDelayTime(1000);
end;

{ 获取计算机名称 }
function YzGetComputerName(): string;
var
  pcComputer: PChar;
  dwCSize: DWORD;
begin
  dwCSize := MAX_COMPUTERNAME_LENGTH + 1;
  Result := '';
  GetMem(pcComputer, dwCSize);
  try
    if Windows.GetComputerName(pcComputer, dwCSize) then
      Result := pcComputer;
  finally
    FreeMem(pcComputer);
  end;
end;

{ 判断进程CPU占用率 }
procedure YzJudgeCPU(ProcessName: string;CPUUsage: Single);
var
  cnt: PCPUUsageData;
  usage: Single;
begin
  cnt := wsCreateUsageCounter(FindProcess(ProcessName));
  while True do
  begin
    usage := wsGetCpuUsage(cnt);
    if usage <= CPUUsage then
    begin
      wsDestroyUsageCounter(cnt);
      YzDelayTime(2000);
      Break;
    end;
    YzDelayTime(10);
    Application.ProcessMessages;
  end;
end;

{ 分割字符串 }
procedure YzSeparateTerms(Source: string;Separator: Char;Terms: TStringList);
var
  TmpStr: string;
  PO: integer;
begin
  Terms.Clear;
  if Length(Source) = 0 then Exit;   { 长度为0则退出 }
  PO := Pos(Separator, Source);
  if PO = 0 then
  begin
    Terms.Add(Source);
    Exit;
  end;
  while PO <> 0 do
  begin
    TmpStr := Copy(Source, 1, PO - 1);{ 复制字符 }
    Terms.Add(TmpStr);                { 添加到列表 }
    Delete(Source, 1, PO);            { 删除字符和分割符 }
    PO := Pos(Separator, Source);     { 查找分割符 }
  end;
  if Length(Source) > 0 then
    Terms.Add(Source);                { 添加剩下的条目 }
end;

{ 切换页面控件的活动页面 }
procedure YzGotoNewPage(AOwerPage: TPageControl;ANewPage: TTabSheet);
begin
  if AOwerPage.ActivePage <> ANewPage then AOwerPage.ActivePage := ANewPage;
end;

{ 设置页面控件标签的可见性 }
procedure YzSetTableVisible(PageControl: TPageControl;ShowFlag: Boolean);
var
  I: Integer;
begin
  for I := 0 to PageControl.PageCount -1 do
    PageControl.Pages[I].TabVisible := ShowFlag;
end;

{ 根据产品名称获取产品编号 }
function YZGetLevelCode(AName:string;ProductList: TStringList): string;
var
  I: Integer;
  TmpStr: string;
begin
  Result := '';
  if ProductList.Count <= 0 then Exit;
  for I := 0 to ProductList.Count-1 do
  begin
    TmpStr := ProductList.Strings[I];
    if AName = Copy(TmpStr,1, Pos('_', TmpStr)-1) then
    begin
      Result := Copy(TmpStr, Pos('_', TmpStr)+1, 10);
      Break;
    end;
  end;
end;

{ 取文件的主文件名 }
function YzGetMainFileName(AFileName:string): string;
var
  TmpStr: string;
begin
  if AFileName = '' then Exit;
  TmpStr := ExtractFileName(AFileName);
  Result := Copy(TmpStr, 1, Pos('.', TmpStr) - 1);
end;

{ 按下一个键 }
procedure YzPressOneKey(AByteCode: Byte);
begin
  keybd_event(AByteCode, 0, 0, 0);
  YzDelayTime(100);
  keybd_event(AByteCode, 0, KEYEVENTF_KEYUP, 0);
  YzDelayTime(400);
end;

{ 按下一个指定次数的键 }
procedure YzPressOneKey(AByteCode: Byte;ATimes: Integer);overload;
var
  I: Integer;
begin
  for I := 1 to ATimes do
  begin
    keybd_event(AByteCode, 0, 0, 0);
    YzDelayTime(10);
    keybd_event(AByteCode, 0, KEYEVENTF_KEYUP, 0);
    YzDelayTime(150);
  end;
end;

{ 按下二个键 }
procedure YzPressTwoKeys(AFirstByteCode, ASecByteCode: Byte);
begin
  keybd_event(AFirstByteCode, 0, 0, 0);
  keybd_event(ASecByteCode, 0, 0, 0);
  YzDelayTime(100);
  keybd_event(ASecByteCode, 0, KEYEVENTF_KEYUP, 0);
  keybd_event(AFirstByteCode, 0, KEYEVENTF_KEYUP, 0);
  YzDelayTime(400);
end;

{ 按下三个键 }
procedure YzPressThreeKeys(AFirstByteCode, ASecByteCode, AThirdByteCode: Byte);
begin
  keybd_event(AFirstByteCode, 0, 0, 0);
  keybd_event(ASecByteCode, 0, 0, 0);
  keybd_event(AThirdByteCode, 0, 0, 0);
  YzDelayTime(100);
  keybd_event(AThirdByteCode, 0, KEYEVENTF_KEYUP, 0);
  keybd_event(ASecByteCode, 0, KEYEVENTF_KEYUP, 0);
  keybd_event(AFirstByteCode, 0, KEYEVENTF_KEYUP, 0);
  YzDelayTime(400);
end;

{ 创建桌面快捷方式 }
procedure YzCreateShortCut(const sPath: string; sShortCutName: WideString);
var
  tmpObject: IUnknown;
  tmpSLink: IShellLink;
  tmpPFile: IPersistFile;
  PIDL: PItemIDList;
  StartupDirectory: array[0..MAX_PATH] of Char;
  StartupFilename: String;
  LinkFilename: WideString;
begin
  StartupFilename := sPath;
  tmpObject := CreateComObject(CLSID_ShellLink); { 创建建立快捷方式的外壳扩展 }
  tmpSLink := tmpObject as IShellLink;           { 取得接口 }
  tmpPFile := tmpObject as IPersistFile;         { 用来储存*.lnk文件的接口 }
  tmpSLink.SetPath(pChar(StartupFilename));      { 设定notepad.exe所在路径 }
  tmpSLink.SetWorkingDirectory(pChar(ExtractFilePath(StartupFilename))); {设定工作目录 }
  SHGetSpecialFolderLocation(0, CSIDL_DESKTOPDIRECTORY, PIDL); { 获得桌面的Itemidlist }
  SHGetPathFromIDList(PIDL, StartupDirectory);   { 获得桌面路径 }
  sShortCutName := '/' + sShortCutName + '.lnk';
  LinkFilename := StartupDirectory + sShortCutName;
  tmpPFile.Save(pWChar(LinkFilename), FALSE);    { 保存*.lnk文件 }
end;

{ 删除桌面快捷方式 }
procedure YzDeleteShortCut(sShortCutName: WideString);
var
  PIDL : PItemIDList;
  StartupDirectory: array[0..MAX_PATH] of Char;
  LinkFilename: WideString;
begin
  SHGetSpecialFolderLocation(0,CSIDL_DESKTOPDIRECTORY,PIDL);
  SHGetPathFromIDList(PIDL,StartupDirectory);
  LinkFilename := StrPas(StartupDirectory) + '/' + sShortCutName + '.lnk';
  DeleteFile(LinkFilename);
end;

{ 通过光标位置进行鼠标左键单击 }
procedure YzMouseLeftClick(X, Y: Integer);
begin
  SetCursorPos(X, Y);
  YzDelayTime(100);
  mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
  mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
  YzDelayTime(400);
end;

{ 鼠标左键双击 }
procedure YzMouseDoubleClick(X, Y: Integer);
begin
  SetCursorPos(X, Y);
  YzDelayTime(100);
  mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
  mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
  YzDelayTime(100);
  mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
  mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
  YzDelayTime(400);
end;


{ 通过窗口句柄进行鼠标左键单击 }
procedure YzMouseLeftClick(lpClassName, lpWindowName: PAnsiChar);overload;
var
  AHandel: THandle;
begin
  AHandel := FindWindow(lpClassName, lpWindowName);
  SendMessage(AHandel, WM_LBUTTONDOWN, 0, 0);
  SendMessage(AHandel, WM_LBUTTONUP, 0, 0);
  YzDelayTime(500);
end;

{ 等待进程结束 }
procedure YzWaitProcessExit(AProcessName: string);
begin
  while True do
  begin
    KillByPID(FindProcess(AProcessName));
    if FindProcess(AProcessName) = 0 then Break;
    YzDelayTime(10);
    Application.ProcessMessages;
  end;
end;

{-------------------------------------------------------------
  功  能:  等待窗口在指定时间后出现
  参  数:  lpClassName: 窗口类名
           lpWindowName: 窗口标题
           ASecond: 要等待的时间,"0"代表永久等待
  返回值:  无
  备  注:  如果指定的等待时间未到窗口已出现则立即退出
--------------------------------------------------------------}
function YzWaitWindowExist(lpClassName, lpWindowName: PAnsiChar;
  ASecond: Integer = 0): THandle;overload;
var
  StartTickCount, PassTickCount: LongWord;
begin
  Result := 0;
  { 永久等待 }
  if ASecond = 0 then
  begin
    while True do
    begin
      Result := FindWindow(lpClassName, lpWindowName);
      if Result <> 0 then Break;
      YzDelayTime(10);
      Application.ProcessMessages;
    end;
  end
  else { 等待指定时间 }
  begin
    StartTickCount := GetTickCount;
    while True do
    begin
      Result := FindWindow(lpClassName, lpWindowName);
      { 窗口已出现则立即退出 }
      if Result <> 0 then Break
      else
      begin
        PassTickCount := GetTickCount;
        { 等待时间已到则退出 }
        if (PassTickCount - StartTickCount) div 1000 >= ASecond then Break;
      end;
      YzDelayTime(10);
      Application.ProcessMessages;
    end;
  end;
  YzDelayTime(1000);
end;

{ 等待指定窗口消失 }
procedure YzWaitWindowClose(lpClassName, lpWindowName: PAnsiChar;
  ASecond: Integer = 0);
var
  StartTickCount, PassTickCount: LongWord;
begin
  if ASecond = 0 then
  begin
    while True do
    begin
      if FindWindow(lpClassName, lpWindowName) = 0 then Break;
      YzDelayTime(10);
      Application.ProcessMessages;
    end
  end
  else
  begin
    StartTickCount := GetTickCount;
    while True do
    begin
      { 窗口已关闭则立即退出 }
      if FindWindow(lpClassName, lpWindowName)= 0 then Break
      else
      begin
        PassTickCount := GetTickCount;
        { 等待时间已到则退出 }
        if (PassTickCount - StartTickCount) div 1000 >= ASecond then Break;
      end;
      YzDelayTime(10);
      Application.ProcessMessages;
    end;
  end;
  YzDelayTime(500);
end;

{ 通过光标位置查找窗口句柄 }
function YzWindowFromPoint(X, Y: Integer): THandle;
var
  MousePoint: TPoint;
  CurWindow: THandle;
  hRect: TRect;
  Canvas: TCanvas;
begin
  MousePoint.X := X;
  MousePoint.Y := Y;
  CurWindow := WindowFromPoint(MousePoint);
  GetWindowRect(Curwindow, hRect);
  if Curwindow <> 0 then
  begin
    Canvas := TCanvas.Create;
    Canvas.Handle := GetWindowDC(Curwindow);
    Canvas.Pen.Width := 2;
    Canvas.Pen.Color := clRed;
    Canvas.Pen.Mode := pmNotXor;
    Canvas.Brush.Style := bsClear;
    Canvas.Rectangle(0, 0, hRect.Right-hRect.Left, hRect.Bottom-hRect.Top);
    Canvas.Free;
  end;
  Result := CurWindow;
end;

{ 通光标位置,窗口类名与标题查找窗口是否存在 }
function YzWaitWindowExist(X, Y: Integer;AClassName, AWinName: string;
  ASecond: Integer):THandle;overload;
var
  MousePo: TPoint;
  CurWindow: THandle;
  bufClassName: array[0..MAXBYTE-1] of Char;
  bufWinName: array[0..MAXBYTE-1] of Char;
  StartTickCount, PassTickCount: LongWord;
begin
  Result := 0;
  { 永久等待 }
  if ASecond = 0 then
  begin
    while True do
    begin
      MousePo.X := X;
      MousePo.Y := Y;
      CurWindow := WindowFromPoint(MousePo);
      GetClassName(CurWindow, bufClassName, MAXBYTE);
      GetWindowText(CurWindow, bufWinname, MAXBYTE);
      if (CompareText(StrPas(bufClassName), AClassName) = 0 ) and
         (CompareText(StrPas(bufWinName), AWinName) = 0) then
      begin
        Result := CurWindow;
        Break;
      end;
      YzDelayTime(10);
      Application.ProcessMessages;
    end;
  end
  else { 等待指定时间 }
  begin
    StartTickCount := GetTickCount;
    while True do
    begin
      { 窗口已出现则立即退出 }
      MousePo.X := X;
      MousePo.Y := Y;
      CurWindow := WindowFromPoint(MousePo);
      GetClassName(CurWindow, bufClassName, MAXBYTE);
      GetWindowText(CurWindow, bufWinname, MAXBYTE);
      if (CompareText(StrPas(bufClassName), AClassName) = 0 ) and
         (CompareText(StrPas(bufWinName), AWinName) = 0) then
      begin
        Result := CurWindow; Break;
      end
      else
      begin
        PassTickCount := GetTickCount;
        { 等待时间已到则退出 }
        if (PassTickCount - StartTickCount) div 1000 >= ASecond then Break;
      end;
      YzDelayTime(10);
      Application.ProcessMessages;
    end;
  end;
  YzDelayTime(1000);
end;

{ 通过窗口句柄设置文本框控件文本 }
procedure YzSetEditText(lpClassName, lpWindowName: PAnsiChar;
  AText: string);overload;
var
  CurWindow: THandle;
begin
  CurWindow := FindWindow(lpClassName, lpWindowName);
  SendMessage(CurWindow ,WM_SETTEXT, 0, Integer(PChar(AText)));
  YzDelayTime(500);
end;

{ 通过光标位置设置文本框控件文本 }
procedure YzSetEditText(X, Y: Integer;AText: string);overload;
var
  CurWindow: THandle;
begin
  CurWindow := YzWindowFromPoint(X, Y);
  SendMessage(CurWindow, WM_SETTEXT, 0, Integer(PChar(AText)));
  YzMouseLeftClick(X, Y);
end;

{ 获取Window操作系统语言 }
function YzGetWindowsLanguageStr: String;
var
  WinLanguage: array [0..50] of char;
begin
  VerLanguageName(GetSystemDefaultLangID, WinLanguage, 50);
  Result := StrPas(WinLanguage);
end;

procedure YzDynArraySetZero(var A);
var
  P: PLongint;  { 4个字节 }
begin
  P := PLongint(A); { 指向 A 的地址 }
  Dec(P);  { P地址偏移量是 sizeof(A),指向了数组长度 }
  P^ := 0; { 数组长度清空 }
  Dec(P);  { 指向数组引用计数 }
  P^ := 0; { 数组计数清空 }
end;

{ 动态设置分辨率 }
function YzDynamicResolution(x, y: WORD): Boolean;
var
  lpDevMode: TDeviceMode;
begin
  Result := EnumDisplaySettings(nil, 0, lpDevMode);
  if Result then
  begin
    lpDevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
    lpDevMode.dmPelsWidth := x;
    lpDevMode.dmPelsHeight := y;
    Result := ChangeDisplaySettings(lpDevMode, 0) = DISP_CHANGE_SUCCESSFUL;
  end;
end;

procedure YzSetFontMapping;
begin
  SetLength(FontMapping, 3);

  { 800 x 600 }
  FontMapping[0].SWidth := 800;
  FontMapping[0].SHeight := 600;
  FontMapping[0].FName := '宋体';
  FontMapping[0].FSize := 7;

  { 1024 x 768 }
  FontMapping[1].SWidth := 1024;
  FontMapping[1].SHeight := 768;
  FontMapping[1].FName := '宋体';
  FontMapping[1].FSize := 9;

  { 1280 x 1024 }
  FontMapping[2].SWidth := 1280;
  FontMapping[2].SHeight := 1024;
  FontMapping[2].FName := '宋体';
  FontMapping[2].FSize := 11;
end;

{ 程序窗体及控件自适应分辨率(有问题) }
procedure YzFixForm(AForm: TForm);
var
  I, J: integer;
  T: TControl;
begin
  with AForm do
  begin
    for I := 0 to ComponentCount - 1 do
    begin
      try
        T := TControl(Components[I]);
        T.left := Trunc(T.left * (Screen.width / 1024));
        T.top := Trunc(T.Top * (Screen.Height / 768));
        T.Width := Trunc(T.Width * (Screen.Width / 1024));
        T.Height := Trunc(T.Height * (Screen.Height / 768));
      except
      end; { try }
    end; { for I }

    for I:= 0 to Length(FontMapping) - 1 do
    begin
      if (Screen.Width = FontMapping[I].SWidth) and (Screen.Height =
        FontMapping[I].SHeight) then
      begin
        for J := 0 to ComponentCount - 1 do
        begin
          try
            TFontedControl(Components[J]).Font.Name := FontMapping[I].FName;
            TFontedControl(Components[J]).FONT.Size := FontMapping[I].FSize;
          except
          end; { try }
        end; { for J }
      end; { if }
    end; { for I }
  end; { with }
end;

{ 检测系统屏幕分辨率 }
function YzCheckDisplayInfo(X, Y: Integer): Boolean;
begin
  Result := True;
  if (Screen.Width <> X) and (Screen.Height <> Y) then
  begin
    if MessageBox(Application.Handle, PChar( '系统检测到您的屏幕分辨率不是 '
      + IntToStr(X) + '×' + IntToStr(Y) + '，这将影响到系统的正常运行，'
      + '是否要自动调整屏幕分辨率？'), '提示', MB_YESNO + MB_ICONQUESTION
      + MB_TOPMOST) = 6 then YzDynamicResolution(1024, 768)
    else Result := False;
  end;
end;

function YzGetUninstallInfo: TUninstallInfo;
const
  Key = '/SOFTWARE/Microsoft/Windows/CurrentVersion/Uninstall/';
var
  S : TStrings;
  I : Integer;
  J : Integer;
begin
  with TRegistry.Create do
  begin
    S := TStringlist.Create;
    J := 0;
    try
      RootKey:= HKEY_LOCAL_MACHINE;
      OpenKeyReadOnly(Key);
      GetKeyNames(S);
      Setlength(Result, S.Count);
      for I:= 0 to S.Count - 1 do
      begin
        If OpenKeyReadOnly(Key + S[I]) then
        If ValueExists('DisplayName') and ValueExists('UninstallString') then
        begin
          Result[J].RegProgramName:= S[I];
          Result[J].ProgramName:= ReadString('DisplayName');
          Result[J].UninstallPath:= ReadString('UninstallString');
          If ValueExists('Publisher') then
            Result[J].Publisher:= ReadString('Publisher');
          If ValueExists('URLInfoAbout') then
            Result[J].PublisherURL:= ReadString('URLInfoAbout');
          If ValueExists('DisplayVersion') then
            Result[J].Version:= ReadString('DisplayVersion');
          If ValueExists('HelpLink') then
            Result[J].HelpLink:= ReadString('HelpLink');
          If ValueExists('URLUpdateInfo') then
            Result[J].UpdateInfoURL:= ReadString('URLUpdateInfo');
          If ValueExists('RegCompany') then
            Result[J].RegCompany:= ReadString('RegCompany');
          If ValueExists('RegOwner') then
            Result[J].RegOwner:= ReadString('RegOwner');
          Inc(J);
        end;
      end;
    finally
      Free;
      S.Free;
      SetLength(Result, J);
    end;
  end;
end;

{ 检测Java安装信息 }
function YzCheckJavaInfo(AUninstallInfo: TUninstallInfo;CheckJava6 : Boolean = False): Boolean;
var
  I: Integer;
  Java6Exist: Boolean;
  AUninstall: TUninstallInfo;
  AProgramList: TStringList;
  AJavaVersion, AFilePath: string;
begin
  Result := True;
  Java6Exist := False;
  AJavaVersion := 'J2SE Runtime Environment 5.0 Update 14';
  AUninstall := YzGetUninstallInfo;
  AProgramList := TStringList.Create;
  for I := Low(AUninstall) to High(AUninstall) do
  begin
    if Pos('J2SE', AUninstall[I].ProgramName) <> 0 then
      AProgramList.Add(AUninstall[I].ProgramName);
    if Pos('Java(TM)', AUninstall[I].ProgramName) <> 0 then
      Java6Exist := True;
  end;
  if Java6Exist then
  begin
    if CheckJava6 then
    begin
      MessageBox(Application.Handle, '系统检测到您机器上安装了Java6以上的版本，'
        + '如果影响到系统的正常运行请先将其卸载再重新启动系统！', '提示',
        MB_OK + MB_ICONINFORMATION + MB_TOPMOST);
      Result := False;
    end;
  end
  else if AProgramList.Count = 0 then
  begin
    MessageBox(Application.Handle, '系统检测到您机器上没有安装Java运行环境，'
      + '请点击 "确定" 安装Java运行环境后再重新运行程序！',
      '提示', MB_OK + MB_ICONINFORMATION + MB_TOPMOST);

    AFilePath := ExtractFilePath(ParamStr(0)) + 'java' + '/'
      + 'jre-1_5_0_14-windows-i586-p.exe';
    if FileExists(AFilePath) then  WinExec(PChar(AFilePath), SW_SHOWNORMAL)
    else
      MessageBox(Application.Handle, '找不到Java安装文件，请您手动安装！',
        '提示', MB_OK + MB_ICONINFORMATION  + MB_TOPMOST);
    Result := False;
  end;
  AProgramList.Free;
end;

{-------------------------------------------------------------
  功能:    窗口自适应屏幕大小
  参数:    Form: 需要调整的Form
           OrgWidth：开发时屏幕的宽度
           OrgHeight：开发时屏幕的高度
--------------------------------------------------------------}
procedure YzAdjustForm(Form: TForm;const OrgWidth, OrgHeight: integer);
begin
  with Form do
  begin
    if (Screen.width <> OrgWidth) then
    begin
      Scaled := True;
      Height := longint(Height) * longint(Screen.height) div OrgHeight;
      Width := longint(Width) * longint(Screen.Width) div OrgWidth;
      ScaleBy(Screen.Width, OrgWidth);
    end;
  end;
end;

{ 设置窗口为当前窗体 }
procedure YzBringMyAppToFront(AppHandle: THandle);
var
  Th1, Th2: Cardinal;
begin
  Th1 := GetCurrentThreadId;
  Th2 := GetWindowThreadProcessId(GetForegroundWindow, NIL);
  AttachThreadInput(Th2, Th1, TRUE);
  try
    SetForegroundWindow(AppHandle);
  finally
    AttachThreadInput(Th2, Th1, TRUE);
  end;
end;

{ 获取文件夹文件数量 }
function YzGetDirFiles(Dir: string;SubDir: Boolean): LongInt;
var
  SearchRec: TSearchRec;
  Founded: integer;
begin
  Result := 0;
  if Dir[length(Dir)] <> '/' then Dir := Dir + '/';
  Founded := FindFirst(Dir + '*.*', faAnyFile, SearchRec);
  while Founded = 0 do
  begin
    Inc(Result);
    if (SearchRec.Attr and faDirectory > 0) and (SearchRec.Name[1] <> '.') and
      (SubDir = True) then
      Inc(Result, YzGetDirFiles(Dir + SearchRec.Name, True));
      Founded := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
end;

{ 算术舍入法的四舍五入取整函数 }
function YzRoundEx (const Value: Real): LongInt;
var
  x: Real;
begin
  x := Value - Trunc(Value);
  if x >= 0.5 then
    Result := Trunc(Value) + 1
  else Result := Trunc(Value);
end;

{ 获取文件大小(KB) }
function YzGetFileSize(const FileName: String): LongInt;
var
  SearchRec: TSearchRec;
begin
  if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
    Result := SearchRec.Size
  else
    Result := -1;
  Result := YzRoundEx(Result / 1024);
end;

{ 获取文件大小(字节) }
function YzGetFileSize_Byte(const FileName: String): LongInt;
var
  SearchRec: TSearchRec;
begin
  if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
    Result := SearchRec.Size
  else
    Result := -1;
end;

{ 获取文件夹大小 }
function YzGetDirSize(Dir: string;SubDir: Boolean): LongInt;
var
  SearchRec: TSearchRec;
  Founded: integer;
begin
  Result := 0;
  if Dir[length(Dir)] <> '/' then Dir := Dir + '/';
  Founded := FindFirst(Dir + '*.*', faAnyFile, SearchRec);
  while Founded = 0 do
  begin
    Inc(Result, SearchRec.size);
    if (SearchRec.Attr and faDirectory > 0) and (SearchRec.Name[1] <> '.') and
      (SubDir = True) then
      Inc(Result, YzGetDirSize(Dir + SearchRec.Name, True));
      Founded := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
  Result := YzRoundEx(Result / 1024);
end;

{-------------------------------------------------------------
  功能:    弹出选择目录对话框
  参数:    const iMode: 选择模式
           const sInfo: 对话框提示信息
  返回值:  如果取消取返回为空，否则返回选中的路径
--------------------------------------------------------------}
function YzSelectDir(const iMode: integer;const sInfo: string): string;
var
  Info: TBrowseInfo;
  IDList: pItemIDList;
  Buffer: PChar;
begin
  Result:='';
  Buffer := StrAlloc(MAX_PATH);
  with Info do
  begin
    hwndOwner := application.mainform.Handle;  { 目录对话框所属的窗口句柄 }
    pidlRoot := nil;                           { 起始位置，缺省为我的电脑 }
    pszDisplayName := Buffer;                  { 用于存放选择目录的指针 }
    lpszTitle := PChar(sInfo);
    { 此处表示显示目录和文件，如果只显示目录则将后一个去掉即可 }
    if iMode = 1 then
      ulFlags := BIF_RETURNONLYFSDIRS or BIF_BROWSEINCLUDEFILES
    else
      ulFlags := BIF_RETURNONLYFSDIRS;
    lpfn := nil;                               { 指定回调函数指针 }
    lParam := 0;                               { 传递给回调函数参数 }
    IDList := SHBrowseForFolder(Info);         { 读取目录信息 }
  end;
  if IDList <> nil then
  begin
    SHGetPathFromIDList(IDList, Buffer);     { 将目录信息转化为路径字符串 }
    Result := strpas(Buffer);
  end;
  StrDispose(buffer);
end;

{ 获取指定路径下文件夹的个数 }
procedure YzListFolders(const Path: String; const ShowPath: Boolean;var List: TStrings);
var
  SRec: TSearchRec;
begin
 if not Assigned(List) then List:= TStringList.Create;
 FindFirst(Path + '*.*', faDirectory, SRec);
 if ShowPath then
    List.Add(Path + SRec.Name)
 else
    List.Add(SRec.Name);
 while FindNext(SRec) = 0 do
    if ShowPath then
       List.Add(Path + SRec.Name)
    else
       List.Add(SRec.Name);
 FindClose(SRec);
end;

{ 禁用窗器控件的所有子控件 }
procedure YzSetSubCtlState(AOwer: TWinControl;AState: Boolean);
var
  I: Integer;
begin
  for I := 0 to AOwer.ControlCount - 1 do
   AOwer.Controls[I].Enabled := AState;
end;

{ 模拟键盘按键操作(处理字节码) }
procedure YzFKeyent(byteCard: byte);
var
  vkkey: integer;
begin
  vkkey := VkKeyScan(chr(byteCard));
  if (chr(byteCard) in ['A'..'Z']) then
  begin
    keybd_event(VK_SHIFT, 0, 0, 0);
    keybd_event(byte(byteCard), 0, 0, 0);
    keybd_event(VK_SHIFT, 0, 2, 0);
  end
  else if chr(byteCard) in ['!', '@', '#', '$', '%', '^', '&', '*', '(', ')',
    '_', '+', '|', '{', '}', ':', '"', '<', '>', '?', '~'] then
  begin
    keybd_event(VK_SHIFT, 0, 0, 0);
    keybd_event(byte(vkkey), 0, 0, 0);
    keybd_event(VK_SHIFT, 0, 2, 0);
  end
  else { if byteCard in [8,13,27,32] }
  begin
    keybd_event(byte(vkkey), 0, 0, 0);
  end;
end;

{ 模拟键盘按键(处理字符) }
procedure YzFKeyent(strCard: string);
var
  str: string;
  strLength: integer;
  I: integer;
  byteSend: byte;
begin
  str := strCard;
  strLength := length(str);
  for I := 1 to strLength do
  begin
    byteSend := byte(str[I]);
    YzFKeyent(byteSend);
  end;
end;

{ 锁定窗口位置 }
procedure YzLockWindow(ClassName,WinName: PChar;poX,poY: Integer);
var
  CurWindow: THandle;
  _wndRect: TRect;
begin
  CurWindow := 0;
  while True do
  begin
    CurWindow := FindWindow(ClassName,WinName);
    if CurWindow <> 0 then Break;
    YzDelayTime(10);
    Application.ProcessMessages;
  end;
  GetWindowRect(CurWindow,_wndRect);
  if ( _wndRect.Left <> poX) or ( _wndRect.Top <> poY) then
  begin
       MoveWindow(CurWindow,
       poX,
       poY,
       (_wndRect.Right-_wndRect.Left),
       (_wndRect.Bottom-_wndRect.Top),
        TRUE);
  end;
  YzDelayTime(1000);
end;

{
  注册一个DLL形式或OCX形式的OLE/COM控件
  参数strOleFileName为一个DLL或OCX文件名，
  参数OleAction表示注册操作类型，1表示注册，0表示卸载
  返回值True表示操作执行成功，False表示操作执行失败
}
function YzRegisterOleFile (strOleFileName: STRING;OleAction: Byte): BOOLEAN;
const
  RegisterOle   =   1; { 注册 }
  UnRegisterOle =   0; { 卸载 }
type
  TOleRegisterFunction = function: HResult; { 注册或卸载函数的原型 }
var
  hLibraryHandle: THandle;    { 由LoadLibrary返回的DLL或OCX句柄 }
  hFunctionAddress: TFarProc; { DLL或OCX中的函数句柄，由GetProcAddress返回 }
  RegFunction: TOleRegisterFunction; { 注册或卸载函数指针 }
begin
  Result := FALSE;
  { 打开OLE/DCOM文件，返回的DLL或OCX句柄 }
  hLibraryHandle := LoadLibrary(PCHAR(strOleFileName));
  if (hLibraryHandle > 0) then        { DLL或OCX句柄正确 }
  try
    { 返回注册或卸载函数的指针 }
    if (OleAction = RegisterOle) then { 返回注册函数的指针 }
      hFunctionAddress := GetProcAddress(hLibraryHandle, pchar('DllRegisterServer'))
    { 返回卸载函数的指针 }
    else
      hFunctionAddress := GetProcAddress(hLibraryHandle, pchar('DllUnregisterServer'));
    if (hFunctionAddress <> NIL) then { 注册或卸载函数存在 }
    begin
      { 获取操作函数的指针 }
      RegFunction := TOleRegisterFunction(hFunctionAddress);
      { 执行注册或卸载操作，返回值>=0表示执行成功 }
      if RegFunction >= 0 then
        Result   :=   true;
    end;
  finally
    { 关闭已打开的OLE/DCOM文件 }
    FreeLibrary(hLibraryHandle);
  end;
end;

function YzListViewColumnCount(mHandle: THandle): Integer;
begin
  Result := Header_GetItemCount(ListView_GetHeader(mHandle));
end; { ListViewColumnCount }

function YzGetListViewText(mHandle: THandle; mStrings: TStrings): Boolean;
var
  vColumnCount: Integer;
  vItemCount: Integer;
  I, J: Integer;
  vBuffer: array[0..255] of Char;
  vProcessId: DWORD;
  vProcess: THandle;
  vPointer: Pointer;
  vNumberOfBytesRead: Cardinal;
  S: string;  vItem: TLVItem;
begin
  Result := False;
  if not Assigned(mStrings) then Exit;
  vColumnCount := YzListViewColumnCount(mHandle);
  if vColumnCount <= 0 then Exit;
  vItemCount := ListView_GetItemCount(mHandle);
  GetWindowThreadProcessId(mHandle, @vProcessId);
  vProcess := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ
    or  PROCESS_VM_WRITE, False, vProcessId);
  vPointer := VirtualAllocEx(vProcess, nil, 4096, MEM_RESERVE or MEM_COMMIT,
    PAGE_READWRITE);
  mStrings.BeginUpdate;
  try
    mStrings.Clear;
    for I := 0 to vItemCount - 1 do
    begin
      S := '';
      for J := 0 to vColumnCount - 1 do
      begin
        with vItem do
        begin
          mask := LVIF_TEXT;
          iItem := I;
          iSubItem := J;
          cchTextMax := SizeOf(vBuffer);
          pszText := Pointer(Cardinal(vPointer) + SizeOf(TLVItem));
        end;
        WriteProcessMemory(vProcess, vPointer, @vItem,
        SizeOf(TLVItem), vNumberOfBytesRead);
        SendMessage(mHandle, LVM_GETITEM, I, lparam(vPointer));
        ReadProcessMemory(vProcess, Pointer(Cardinal(vPointer) + SizeOf(TLVItem)),
          @vBuffer[0], SizeOf(vBuffer), vNumberOfBytesRead);
        S := S + #9 + vBuffer;
      end;
      Delete(S, 1, 1);
      mStrings.Add(S);
    end;
  finally
    VirtualFreeEx(vProcess, vPointer, 0, MEM_RELEASE);
    CloseHandle(vProcess);    mStrings.EndUpdate;
  end;
  Result := True;
end; { GetListViewText }

{ 删除目录树 }
function YzDeleteDirectoryTree(Path: string): boolean;
var
  SearchRec: TSearchRec;
  SFI: string;
begin
  Result := False;
  if (Path = '') or (not DirectoryExists(Path)) then exit;
  if Path[length(Path)] <> '/' then Path := Path + '/';
  SFI := Path + '*.*';
  if FindFirst(SFI, faAnyFile, SearchRec) = 0 then
  begin
    repeat
      begin
        if (SearchRec.Name = '.') or (SearchRec.Name = '..') then
          Continue;
        if (SearchRec.Attr and faDirectory <> 0) then
        begin
          if not YzDeleteDirectoryTree(Path + SearchRec.name) then
            Result := FALSE;
        end
        else
        begin
          FileSetAttr(Path + SearchRec.Name, 128);
          DeleteFile(Path + SearchRec.Name);
        end;
      end
    until FindNext(SearchRec) <> 0;
    FindClose(SearchRec);
  end;
  FileSetAttr(Path, 0);
  if RemoveDir(Path) then
    Result := TRUE
  else
    Result := FALSE;
end;

{ Jpg格式转换为bmp格式 }
function JpgToBmp(Jpg: TJpegImage): TBitmap;
begin
  Result := nil;
  if Assigned(Jpg) then
  begin
    Result := TBitmap.Create;
    Jpg.DIBNeeded;
    Result.Assign(Jpg);
  end;
end;

{ 设置程序自启动函数 }
function YzSetAutoRun(AFilePath: string;AFlag: Boolean): boolean;
var
  AMainFName: string;
  Reg: TRegistry;
begin
  Result := true;
  AMainFName := YzGetMainFileName(AFilePath);
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_LOCAL_MACHINE;
  try
    Reg.OpenKey('SOFTWARE/Microsoft/Windows/CurrentVersion/Run', True);
    if AFlag = False then  { 取消自启动 }
      Reg.DeleteValue(AMainFName)
    else                   { 设置自启动 }
      Reg.WriteString(AMainFName, '"' + AFilePath + '"')
  except
    Result := False;
  end;
  Reg.CloseKey;
  Reg.Free;
end;

{ 检测URL地址是否有效 }
function YzCheckUrl(url: string): Boolean;
var
  hSession, hfile, hRequest: HINTERNET;
  dwindex, dwcodelen: dword;
  dwcode: array[1..20] of Char;
  res: PChar;
begin
  Result := False;
  try
    if Pos('http://',LowerCase(url)) = 0 then url := 'http://' + url;
    { Open an internet session }
    hSession:=InternetOpen('InetURL:/1.0',INTERNET_OPEN_TYPE_PRECONFIG,nil,nil, 0);
    if Assigned(hsession) then
    begin
      hfile := InternetOpenUrl(hsession, PChar(url), nil, 0,INTERNET_FLAG_RELOAD, 0);
      dwIndex := 0;
      dwCodeLen := 10;
      HttpQueryInfo(hfile,HTTP_QUERY_STATUS_CODE,@dwcode,dwcodeLen,dwIndex);
      res := PChar(@dwcode);
      Result := (res = '200') or (res = '302');
      if Assigned(hfile) then InternetCloseHandle(hfile);
      InternetCloseHandle(hsession);
    end;
  except
  end;
end;

{ 获取程序可执行文件名 }
function YzGetExeFName: string;
begin
  Result := ExtractFileName(Application.ExeName);
end;

{ 目录浏览对话框函数 }
function YzBrowseFolder(AOwer: TWinControl;ATitle: string):string;
var
  Info: TBrowseInfo;
  Dir: array[0..260] of char;
  ItemId: PItemIDList;
begin
  with Info do
  begin
    hwndOwner := AOwer.Handle;
    pidlRoot := nil;
    pszDisplayName := nil;
    lpszTitle := PChar(ATitle);
    ulFlags := 0;
    lpfn := nil;
    lParam := 0;
    iImage := 0;
  end;
  ItemId := SHBrowseForFolder(Info);
  SHGetPathFromIDList(ItemId,@Dir);
  Result := string(Dir);
end;

{ 重启计算机 }
function YzShutDownSystem(AFlag: Integer):BOOL;
var
  hProcess,hAccessToken: THandle;
  LUID_AND_ATTRIBUTES: TLUIDAndAttributes;
  TOKEN_PRIVILEGES: TTokenPrivileges;
  BufferIsNull: DWORD;
Const
  SE_SHUTDOWN_NAME='SeShutdownPrivilege';
begin
  hProcess:=GetCurrentProcess();

  OpenProcessToken(hprocess, TOKEN_ADJUST_PRIVILEGES+TOKEN_QUERY, hAccessToken);
  LookupPrivilegeValue(Nil, SE_SHUTDOWN_NAME, LUID_AND_ATTRIBUTES.Luid);
  LUID_AND_ATTRIBUTES.Attributes := SE_PRIVILEGE_ENABLED;
  TOKEN_PRIVILEGES.PrivilegeCount := 1;
  TOKEN_PRIVILEGES.Privileges[0] := LUID_AND_ATTRIBUTES;
  BufferIsNull := 0;

  AdjustTokenPrivileges(hAccessToken, False, TOKEN_PRIVILEGES, sizeof(
    TOKEN_PRIVILEGES) ,Nil, BufferIsNull);
  Result := ExitWindowsEx(AFlag, 0);
end;

{ 程序运行后删除自身 }
procedure YzDeleteSelf;
var
  hModule: THandle;
  buff:    array[0..255] of Char;
  hKernel32: THandle;
  pExitProcess, pDeleteFileA, pUnmapViewOfFile: Pointer;
begin
  hModule := GetModuleHandle(nil);
  GetModuleFileName(hModule, buff, sizeof(buff));

  CloseHandle(THandle(4));

  hKernel32        := GetModuleHandle('KERNEL32');
  pExitProcess     := GetProcAddress(hKernel32, 'ExitProcess');
  pDeleteFileA     := GetProcAddress(hKernel32, 'DeleteFileA');
  pUnmapViewOfFile := GetProcAddress(hKernel32, 'UnmapViewOfFile');

  asm
    LEA         EAX, buff
    PUSH        0
    PUSH        0
    PUSH        EAX
    PUSH        pExitProcess
    PUSH        hModule
    PUSH        pDeleteFileA
    PUSH        pUnmapViewOfFile
    RET
  end;
end;

{ 程序重启 }
procedure YzAppRestart;
var
  AppName : PChar;
begin
  AppName := PChar(Application.ExeName) ;
  ShellExecute(Application.Handle,'open', AppName, nil, nil, SW_SHOWNORMAL);
  KillByPID(GetCurrentProcessId);
end;

{ 压缩Access数据库 }
function YzCompactAccessDB(const AFileName, APassWord: string): Boolean;
var
  SPath, FConStr, TmpConStr: string;
  SFile: array[0..254] of Char;
  STempFileName: string;
  JE: OleVariant;
  function GetTempDir: string;
  var
    Buffer: array[0..MAX_PATH] of Char;
  begin
    ZeroMemory(@Buffer, MAX_PATH);
    GetTempPath(MAX_PATH, Buffer);
    Result := IncludeTrailingBackslash(StrPas(Buffer));
  end;
begin
  Result := False;
  SPath := GetTempDir;  { 取得Windows的Temp路径 }

  { 取得Temp文件名,Windows将自动建立0字节文件 }
  GetTempFileName(PChar(SPath), '~ACP', 0, SFile);
  STempFileName := SFile;

  { 删除Windows建立的0字节文件 }
  if not DeleteFile(STempFileName) then Exit;
  try
    JE := CreateOleObject('JRO.JetEngine');

    { 压缩数据库 }
    FConStr := 'Provider=Microsoft.Jet.OLEDB.4.0;' + 'Data Source=' + AFileName
      + ';Jet OLEDB:DataBase PassWord=' + APassWord;

    TmpConStr := 'Provider=Microsoft.Jet.OLEDB.4.0;' + 'Data Source=' + STempFileName
      + ';Jet OLEDB:DataBase PassWord=' + APassWord;
    JE.CompactDatabase(FConStr, TmpConStr);

    { 覆盖源数据库文件 }
    Result := CopyFile(PChar(STempFileName), PChar(AFileName), False);

    { 删除临时文件 }
    DeleteFile(STempFileName);
  except
    Application.MessageBox('压缩数据库失败！', '提示', MB_OK +
      MB_ICONINFORMATION);
  end;
end;

{ 标题:获取其他进程中TreeView的文本 }
function YzTreeNodeGetNext(mHandle: THandle; mTreeItem: HTreeItem): HTreeItem;
var
  vParentID: HTreeItem;
begin
  Result := nil;
  if (mHandle <> 0) and (mTreeItem <> nil) then
  begin
    Result := TreeView_GetChild(mHandle, mTreeItem);
    if Result = nil then
      Result := TreeView_GetNextSibling(mHandle, mTreeItem);
    vParentID := mTreeItem;
    while (Result = nil) and (vParentID <> nil) do
    begin
      vParentID := TreeView_GetParent(mHandle, vParentID);
      Result := TreeView_GetNextSibling(mHandle, vParentID);
    end;
  end;
end; { TreeNodeGetNext }

function YzTreeNodeGetLevel(mHandle: THandle; mTreeItem: HTreeItem): Integer;
var
  vParentID: HTreeItem;
begin
  Result := -1;
  if (mHandle <> 0) and (mTreeItem <> nil) then
  begin
    vParentID := mTreeItem;
    repeat
      Inc(Result);
      vParentID := TreeView_GetParent(mHandle, vParentID);
    until vParentID = nil;
  end;
end; { TreeNodeGetLevel }

function YzGetTreeViewText(mHandle: THandle; mStrings: TStrings): Boolean;
var
  vItemCount: Integer;
  vBuffer: array[0..255] of Char;
  vProcessId: DWORD;
  vProcess: THandle;
  vPointer: Pointer;
  vNumberOfBytesRead: Cardinal;
  I: Integer;
  vItem: TTVItem;
  vTreeItem: HTreeItem;
begin
  Result := False;
  if not Assigned(mStrings) then Exit;
  GetWindowThreadProcessId(mHandle, @vProcessId);
  vProcess := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or
    PROCESS_VM_WRITE, False, vProcessId);
  vPointer := VirtualAllocEx(vProcess, nil, 4096, MEM_RESERVE or
    MEM_COMMIT, PAGE_READWRITE);
  mStrings.BeginUpdate;
  try
    mStrings.Clear;
    vItemCount := TreeView_GetCount(mHandle);
    vTreeItem := TreeView_GetRoot(mHandle);
    for I := 0 to vItemCount - 1 do
    begin
      with vItem do begin
        mask := TVIF_TEXT; cchTextMax := SizeOf(vBuffer);
        pszText := Pointer(Cardinal(vPointer) + SizeOf(vItem));
        hItem := vTreeItem;
      end;
      WriteProcessMemory(vProcess, vPointer, @vItem, SizeOf(vItem),
        vNumberOfBytesRead);
      SendMessage(mHandle, TVM_GETITEM, 0, lparam(vPointer));
      ReadProcessMemory(vProcess, Pointer(Cardinal(vPointer) + SizeOf(TLVItem)),
      @vBuffer[0], SizeOf(vBuffer), vNumberOfBytesRead);
      mStrings.Add(StringOfChar(#9, YzTreeNodeGetLevel(mHandle, vTreeItem)) + vBuffer);
      vTreeItem := YzTreeNodeGetNext(mHandle, vTreeItem);
    end;
  finally
    VirtualFreeEx(vProcess, vPointer, 0, MEM_RELEASE);
    CloseHandle(vProcess); mStrings.EndUpdate;
  end;
  Result := True;
end; { GetTreeViewText }

{ 获取其他进程中ListBox和ComboBox的内容 }
function YzGetListBoxText(mHandle: THandle; mStrings: TStrings): Boolean;
var
  vItemCount: Integer;
  I: Integer;
  S: string;
begin
  Result := False;
  if not Assigned(mStrings) then Exit;
  mStrings.BeginUpdate;
  try
    mStrings.Clear;
    vItemCount := SendMessage(mHandle, LB_GETCOUNT, 0, 0);
    for I := 0 to vItemCount - 1 do
    begin
      SetLength(S, SendMessage(mHandle, LB_GETTEXTLEN, I, 0));
      SendMessage(mHandle, LB_GETTEXT, I, Integer(@S[1]));
      mStrings.Add(S);
    end;
    SetLength(S, 0);
  finally
    mStrings.EndUpdate;
  end;
  Result := True;
end; { GetListBoxText }

function YzGetComboBoxText(mHandle: THandle; mStrings: TStrings): Boolean;
var
  vItemCount: Integer;
  I: Integer;
  S: string;
begin
  Result := False;
  if not Assigned(mStrings) then Exit;
  mStrings.BeginUpdate;
  try
    mStrings.Clear;
    vItemCount := SendMessage(mHandle, CB_GETCOUNT, 0, 0);
    for I := 0 to vItemCount - 1 do
    begin
      SetLength(S, SendMessage(mHandle, CB_GETLBTEXTLEN, I, 0));
      SendMessage(mHandle, CB_GETLBTEXT, I, Integer(@S[1]));
      mStrings.Add(S);
    end;
    SetLength(S, 0);
  finally
    mStrings.EndUpdate;
  end;
  Result := True;
end; { GetComboBoxText }

{ 获取本地Application Data目录路径 }
function YzLocalAppDataPath : string;
const
   SHGFP_TYPE_CURRENT = 0;
var
   Path: array [0..MAX_PATH] of char;
begin
   SHGetFolderPath(0, CSIDL_LOCAL_APPDATA, 0, SHGFP_TYPE_CURRENT, @path[0]) ;
   Result := Path;
end;

{ 获取Windows当前登录的用户名 }
function YzGetWindwosUserName: String;
var
  pcUser: PChar;
  dwUSize: DWORD;
begin
  dwUSize := 21;
  result  := '';
  GetMem(pcUser, dwUSize);
  try
    if Windows.GetUserName(pcUser, dwUSize) then
      Result := pcUser
  finally
    FreeMem(pcUser);
  end;
end;

{-------------------------------------------------------------
  功  能:  delphi 枚举托盘图标
  参  数:  AFindList: 返回找到的托盘列表信息
  返回值:  成功为True,反之为False
  备  注:  返回的格式为: 位置_名称_窗口句柄_进程ID
--------------------------------------------------------------}
function YzEnumTrayNotifyWnd(AFindList: TStringList;ADestStr: string): BOOL;
var
  wd: HWND;
  wtd: HWND;
  wd1: HWND;
  pid: DWORD;
  hd: THandle;
  num, i: integer;
  n: ULONG;
  p: TTBBUTTON;
  pp: ^TTBBUTTON;
  x: string;
  name: array[0..255] of WCHAR;
  whd, proid: ulong;
  temp: string;
  sp: ^TTBBUTTON;
  _sp: TTBButton;
begin
  Result := False;
  wd := FindWindow('Shell_TrayWnd', nil);
  if (wd = 0) then Exit;

  wtd := FindWindowEx(wd, 0, 'TrayNotifyWnd', nil);
  if (wtd = 0) then Exit;

  wtd := FindWindowEx(wtd, 0, 'SysPager', nil);
  if (wtd = 0) then Exit;

  wd1 := FindWindowEx(wtd, 0, 'ToolbarWindow32', nil);
  if (wd1 = 0) then Exit;

  pid := 0;
  GetWindowThreadProcessId(wd1, @pid);
  if (pid = 0) then Exit;

  hd := OpenProcess(PROCESS_ALL_ACCESS, true, pid);
  if (hd = 0) then Exit;
  num := SendMessage(wd1, TB_BUTTONCOUNT, 0, 0);
  sp := @_sp;
  for i := 0 to num do
  begin
    SendMessage(wd1, TB_GETBUTTON, i, integer(sp));
    pp := @p;
    ReadProcessMemory(hd, sp, pp, sizeof(p), n);
    name[0] := Char(0);
    if (Cardinal(p.iString) <> $FFFFFFFF) then
    begin
      try
        ReadProcessMemory(hd, pointer(p.iString), @name, 255, n);
        name[n] := Char(0);
      except
      end;
      temp := name;
      try
        whd := 0;
        ReadProcessMemory(hd, pointer(p.dwData), @whd, 4, n);
      except
      end;
      proid := 0;
      GetWindowThreadProcessId(whd, @proid);
      AFindList.Add(Format('%d_%s_%x_%x', [i, temp, whd, proid]));
      if CompareStr(temp, ADestStr) = 0 then Result := True;
    end;
  end;
end;

{ 获取SQL Server用户数据库列表 }
procedure YzGetSQLServerDBList(ADBHostIP, ALoginPwd: string;ADBList: TStringList);
var
  PQuery: TADOQuery;
  ConnectStr: string;
begin
  ConnectStr := 'Provider=SQLOLEDB.1;Password=' + ALoginPwd
    + ';Persist Security Info=True;User ID=sa;Initial Catalog=master'
    + ';Data Source=' + ADBHostIP;
  ADBList.Clear;
  PQuery := TADOQuery.Create(nil);
  try
    PQuery.ConnectionString := ConnectStr;
    PQuery.SQL.Text:='select name from sysdatabases where dbid > 6';
    PQuery.Open;
    while not PQuery.Eof do
    begin
      ADBList.add(PQuery.Fields[0].AsString);
      PQuery.Next;
    end;
  finally
    PQuery.Free;
  end;
end;

{ 检测数据库中是否存在给定的表 }
procedure YzGetTableList(ConncetStr: string;ATableList: TStringList);
var
  FConnection: TADOConnection;
begin
  FConnection := TADOConnection.Create(nil);
  try
    FConnection.LoginPrompt := False;
    FConnection.Connected := False;
    FConnection.ConnectionString := ConncetStr;
    FConnection.Connected := True;
    FConnection.GetTableNames(ATableList, False);
  finally
    FConnection.Free;
  end;
end;

{ 将域名解释成IP地址 }
function YzDomainToIP(HostName: string): string;
type
  tAddr = array[0..100] of PInAddr;
  pAddr = ^tAddr;
var
  I: Integer;
  WSA: TWSAData;
  PHE: PHostEnt;
  P: pAddr;
begin
  Result := '';
  WSAStartUp($101, WSA);
  try
    PHE := GetHostByName(pChar(HostName));
    if (PHE <> nil) then
    begin
      P := pAddr(PHE^.h_addr_list);
      I := 0;
      while (P^[I] <> nil) do
      begin
        Result := (inet_nToa(P^[I]^));
        Inc(I);
      end;
    end;
  except
  end;
  WSACleanUp;
end;

{ 移去系统托盘失效图标 }
procedure YzRemoveDeadIcons();
var
  hTrayWindow: HWND;
  rctTrayIcon: TRECT;
  nIconWidth, nIconHeight:integer;
  CursorPos: TPoint;
  nRow, nCol: Integer;
Begin
  //Get tray window handle and bounding rectangle
  hTrayWindow := FindWindowEx(FindWindow('Shell_TrayWnd ', nil), 0, 'TrayNotifyWnd ', nil);
  if Not (GetWindowRect(hTrayWindow, rctTrayIcon)) then Exit;
  //Get small icon metrics
  nIconWidth := GetSystemMetrics(SM_CXSMICON);
  nIconHeight := GetSystemMetrics(SM_CYSMICON);
  //Save current mouse position   }
  GetCursorPos(CursorPos);
  //Sweep the mouse cursor over each icon in the tray in both dimensions
  for nRow := 0 To ((rctTrayIcon.bottom - rctTrayIcon.top) div nIconHeight) Do
  Begin
    for nCol := 0 To ((rctTrayIcon.right - rctTrayIcon.left) div nIconWidth) Do
    Begin
      SetCursorPos(rctTrayIcon.left + nCol * nIconWidth + 5,
        rctTrayIcon.top + nRow * nIconHeight + 5);
      Sleep(0);
    end;
  end;
  //Restore mouse position
  SetCursorPos(CursorPos.x, CursorPos.x);
  //Redraw tray window(to fix bug in multi-line tray area)
  RedrawWindow(hTrayWindow, nil, 0, RDW_INVALIDATE Or RDW_ERASE Or RDW_UPDATENOW);
end;

{ 转移程序占用内存至虚拟内存 }
procedure YzClearMemory;
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    SetProcessWorkingSetSize(GetCurrentProcess, $FFFFFFFF, $FFFFFFFF);
    Application.ProcessMessages;
  end;
end;

{ 检测允许试用的天数是否已到期 }
function YzCheckTrialDays(AllowDays: Integer): Boolean;
var
  Reg_ID, Pre_ID: TDateTime;
  FRegister: TRegistry;
begin
  { 初始化为试用没有到期 }
  Result := True;
  FRegister := TRegistry.Create;
  try
    with FRegister do
    begin
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKey('Software/Microsoft/Windows/CurrentSoftware/'
        + YzGetMainFileName(Application.ExeName), True) then
      begin
        if ValueExists('DateTag') then
        begin
          Reg_ID := ReadDate('DateTag');
          if Reg_ID = 0 then Exit;
          Pre_ID := ReadDate('PreDate');
          { 允许使用的时间到 }
          if ((Reg_ID <> 0) and (Now - Reg_ID > AllowDays)) or
            (Pre_ID <> Reg_ID) or (Reg_ID > Now) then
          begin
            { 防止向前更改日期 }
            WriteDateTime('PreDate', Now + 20000);
            Result := False;
          end;
        end
        else
        begin
          { 首次运行时保存初始化数据 }
          WriteDateTime('PreDate', Now);
          WriteDateTime('DateTag', Now);
        end;
      end;
    end;
  finally
    FRegister.Free;
  end;
end;

{ 指定长度的随机小写字符串函数 }
function YzRandomStr(aLength: Longint): string;
var
  X: Longint;
begin
  if aLength <= 0 then exit;
  SetLength(Result, aLength);
  for X := 1 to aLength do
    Result[X] := Chr(Random(26) + 65);
  Result := LowerCase(Result);
end;

end.

 

转载于:https://www.cnblogs.com/leonkin/p/3534057.html

吃素的小动物
关注
delphi公用函数
靠别人不如靠自已。
06-18 9692
{*******************************************************}{ }{ Delphi公用函数单元 }{
公共函数单元
05-12
一些delphi编程常用的单元文件 来源于长期项目积累
我的公共函数单元（Delphi）
Hsu Chong 的专栏
03-13 2104
 
通用公共函数（Delphi）
java开发指南博客 【转载】
07-17 197
这是我自己前两年积攒的公共函数库（Delphi7下写的）：http://www.pudn.com/dl.asp?id=945956。新版本已经做了较大变化，以后再提供。
delphi的一个公用函数库
qhmao的专栏
05-08 2865
delphi的一个公用函数库   {*************************************************  Name: PublicFunc;***  Author: lyz 2004-3-17;******  Function: 公共函数；**********************************************}unit PublicFunc;
delphi公用函数.zip_delphi_existu64_公共函数_函数_拼音
07-15
系统公用函数及过程 ①: 扩展的字符串操作函数 ②: 扩展的日期时间操作函数 ③: 扩展的位操作函数 ④: 扩展的文件及目录操作函数 ⑤: 扩展的对话框函数 ⑥: 系统功能函数 ⑦: 硬件功能函数 ⑧: 网络...
Delphi常用公用函数
05-21
根据提供的文件标题、描述、标签以及部分内容，我们可以总结出一系列与Delphi编程语言相关的实用公共函数。这些函数涉及数据处理、界面操作、过滤查询等多种功能，对于开发基于Delphi的应用程序非常有用。下面将详细...
Delphi扩展公用函数集：字符串、日期、位操作等
资源摘要信息: "delphi公用函数.zip_delphi_existu64_公共函数_函数_拼音" 本资源是一组包含了多种功能的Delphi公用函数库，由标题、描述、标签以及压缩包内文件名组成，对应的核心知识点包括但不限于以下方面： 1...
Delphi网络公用函数
05-21
//判断Ip协议有没有安装 这个函数有问题 Function NetIsIPInstalled : boolean; //检测机器是否上网 Function NetInternetConnected: Boolean; //网络止 //窗口起 function FormCreateProcessFrm(MsgTitle: ...
Delphi单元--共50个函数
weixin_34123613的博客
01-07 324
unit tools;interfaceuses windows,Forms,mmsystem,winsock,sysutils,classes,controls,messages,activex, shlobj,menus,comobj,jpeg,graphics,extctrls,ShellApi,contnrs,dialogs;constSHFMT_ID_DEFAULT=...
delphi通用函数单元一
08-19
//▎============================================================▎// //▎================① 扩展的字符串操作函数 ===================▎// //▎============================================================▎// //从文件中返回Ado连接字串。 function GetConnectionString(DataBaseName:string):string; //返回服务器的机器名称. function GetRemoteServerName:string; function InStr(const sShort: string; const sLong: string): Boolean; {测试通过} {* 判断s1是否包含在s2中} function IntToStrEx(Value: Integer; Len: Integer; FillChar: Char = '0'): string; {测试通过} {* 扩展整数转字符串函数 Example: IntToStrEx(1,5,'0'); 返回："00001"} function IntToStrSp(Value: Integer; SpLen: Integer = 3; Sp: Char = ','): string; {测试通过} {* 带分隔符的整数－字符转换} function ByteToBin(Value: Byte): string; {测试通过} {* 字节转二进制串} function StrRight(Str: string; Len: Integer): string; {测试通过} {* 返回字符串右边的字符 Examples: StrRight('ABCEDFG',3); 返回:'DFG' } function StrLeft(Str: string; Len: Integer): string; {测试通过} {* 返回字符串左边的字符} function Spc(Len: Integer): string; {测试通过} {* 返回空格串} function Replace(Str,s1,s2:string;CaseSensitive:Boolean):string; {测试通过} {* 返回将指定字符s1用字符串s2替换后的字符串，可支持大小写敏感由CaseSensitive操作} {example: replace('We know what we want','we','I',false) = 'I Know what I want'} function Replicate(pcChar:Char; piCount:integer):string; {在一个字符串中查找某个字符串的位置} function StrNum(ShortStr:string;LongString:string):Integer; {测试通过} {* 返回某个字符串中某个字符串中出现的次数} function FindStr(ShortStr:String;LongStrIng:String):Integer; {测试通过} {* 返回某个字符串中查找某个字符串的位置} function SubStr(psInput:String; BeginPlace,CutLeng:Integer):String; {测试通过} {* 返回从位置BeginPlace开始切取长度为CatLeng字符串} function LeftStr(psInput:String; CutLeng:Integer):String; {测试通过} {* 返回从左边第一为开始切取 CutLeng长度的字符串} function RightStr(psInput:String; CutLeng:Integer):String; {测试通过} {* 返回从右边第一为开始切取 CutLeng长度的字符串} function PadLStr(psInput:String; piWidth:Integer; pcPadWith:Char):String; {测试通过} {* 返回从psInput字符串左边开始用pcPadWith填充后总长度为PiWidth的字符串} function PadRStr(psInput:String; piWidth:Integer; pcPadWith:Char):String; {测试通过} {* 返回从psInput字符串右边开始用pcPadWith填充后总长度为PiWidth的字符串} function PadCStr(psInput:String; piWidth:Integer; pcPadWith:Char):String; {测试通过} {* 返回从psInput字符串两边开始用pcPadWith填充后总长度为PiWidth的字符串} function ChrTran(psInput:String; pcSearch:Char; pcTranWith:Char):String; {测试通过} {* 返回替换后字符串[替换单个字符] Examples: ChrTran('abCdEgdlkh','d','#')； 返回'abC#Eg#lkh'} function StrTran(psInput:String; psSearch:String; psTranWith:String):String; {测试通过} {* 返回替换后字符串[替换字符串] Examples: StrTran('aruyfbn','ruy','=====');； 返回'a=====fbn'} function Stuff(psInput:String; piBeginPlace,piCount:Integer; psStuffWith:String):String; { *返回替换后字符串[替换字符串] Examples: Stuff('ABCDEFGHI',3,4,'12345')；返回'AB12345GHI'} procedure SwapStr(var s1, s2: string); {测试通过} {* 交换字串} function LinesToStr(const Lines: string): string; {测试通过} {* 多行文本转单行（换行符转'\n'）} function StrToLines(const Str: string): string; {测试通过} {* 单行文本转多行（'\n'转换行符）} function Encrypt(const S: String; Key: Word): String; {* 字符串加密函数} function Decrypt(const S: String; Key: Word): String; {* 字符串解密函数} function varIIF(aTest: Boolean; TrueValue, FalseValue: Variant): Variant; function varToStr(const V: Variant): string; {* VarIIF及VartoStr为变体函数} function IsDigital(Value: string): boolean; {功能说明：判断string是否全是数字} function RandomStr(aLength : Longint) : String; {随机字符串函数} //▎============================================================▎// //▎================② 扩展的日期时间操作函数 =================▎// //▎============================================================▎// function GetYear(Date: TDate): Integer; {测试通过} {* 取日期年份分量} function GetMonth(Date: TDate): Integer; {测试通过} {* 取日期月份分量} function GetDay(Date: TDate): Integer; {测试通过} {* 取日期天数分量} function GetHour(Time: TTime): Integer; {测试通过} {* 取时间小时分量} function GetMinute(Time: TTime): Integer; {测试通过} {* 取时间分钟分量} function GetSecond(Time: TTime): Integer; {测试通过} {* 取时间秒分量} function GetMSecond(Time: TTime): Integer; {测试通过} {* 取时间毫秒分量} function GetMonthLastDay(Cs_Year,Cs_Month:string):string; { *传入年、月，得到该月份最后一天} function IsLeapYear( nYear: Integer ): Boolean; {*/判断某年是否为闰年} function MaxDateTime(const Values: array of TDateTime): TDateTime; {//两个日期取较大的日期} function MinDateTime(const Values: array of TDateTime): TDateTime; {//两个日期取较小的日期} function dateBeginOfMonth(D: TDateTime): TDateTime; {//得到本月的第一天} function DateEndOfMonth(D: TDateTime): TDateTime; {//得到本月的最后一天} function DateEndOfYear(D: TDateTime): TDateTime; {//得到本年的最后一天} function DaysBetween(Date1, Date2: TDateTime): integer; {//得到两个日期相隔的天数} //▎============================================================▎// //▎===================③ 扩展的位操作函数 ====================▎// //▎============================================================▎// type TByteBit = 0..7; {* Byte类型位数范围} TWordBit = 0..15; {* Word类型位数范围} TDWordBit = 0..31; {* DWord类型位数范围} procedure SetBit(var Value: Byte; Bit: TByteBit; IsSet: Boolean); overload; {* 设置二进制位} procedure SetBit(var Value: WORD; Bit: TWordBit; IsSet: Boolean); overload; {* 设置二进制位} procedure SetBit(var Value: DWORD; Bit: TDWordBit; IsSet: Boolean); overload; {* 设置二进制位} function GetBit(Value: Byte; Bit: TByteBit): Boolean; overload; {* 取二进制位} function GetBit(Value: WORD; Bit: TWordBit): Boolean; overload; {* 取二进制位} function GetBit(Value: DWORD; Bit: TDWordBit): Boolean; overload; {* 取二进制位} //▎============================================================▎// //▎=================④扩展的文件及目录操作函数=================▎// //▎============================================================▎// function MoveFile(const sName, dName: string): Boolean; {测试通过} {* 移动文件、目录，参数为源、目标名} procedure FileProperties(const FName: string); {测试通过} {* 打开文件属性窗口} function CreatePath(path : string) : Boolean; function OpenDialog(var FileName: string; Title: string; Filter: string; Ext: string): Boolean; {* 打开文件框} function FormatPath(APath: string; Width: Integer): string; {测试通过} {* 缩短显示不下的长路径名} function GetRelativePath(Source, Dest: string): string; {测试通过} {* 取两个目录的相对路径,注意串尾不能是'\'字符！} procedure RunFile(const FName: string; Handle: THandle = 0; const Param: string = ''); {测试通过} {* 运行一个文件} function WinExecAndWait32(FileName: string; Visibility: Integer = SW_NORMAL): Integer; {测试通过} {* 运行一个文件并等待其结束} function AppPath: string; {测试通过} {* 应用程序路径} function GetDiskInfo(sFile : string; var nDiskFree,nDiskSize : Int64): boolean; {测试通过} {* 取sFile 所在磁盘空间状态 } function GetWindowsDir: string; {测试通过} {* 取Windows系统目录} function GetWinTempDir: string; {测试通过} {* 取临时文件目录} function AddDirSuffix(Dir: string): string; {测试通过} {* 目录尾加'\'修正} function MakePath(Dir: string): string; {测试通过} {* 目录尾加'\'修正} function IsFileInUse(FName: string): Boolean; {测试通过} {* 判断文件是否正在使用} function GetFileSize(FileName: string): Integer; {测试通过} {* 取文件长度} function SetFileDate(FileName: string; CreationTime, LastWriteTime, LastAccessTime: TFileTime): Boolean; {测试通过} {* 设置文件时间 Example: FileSetDate('c:\Test\Test1.exe',753160662); } function GetFileDate(FileName: string; var CreationTime, LastWriteTime, LastAccessTime: TFileTime): Boolean; {测试通过} {* 取文件时间} function FileTimeToLocalSystemTime(FTime: TFileTime): TSystemTime; {测试通过} {* 文件时间转本地时间} function LocalSystemTimeToFileTime(STime: TSystemTime): TFileTime; {测试通过} {* 本地时间转文件时间} function GetFileIcon(FileName: string; var Icon: TIcon): Boolean; {测试通过} {* 取得与文件相关的图标，成功则返回True} function CreateBakFile(FileName, Ext: string): Boolean; {测试通过} {* 创建备份文件} function Deltree(Dir: string): Boolean; {测试通过} {* 删除整个目录} function GetDirFiles(Dir: string): Integer; {测试通过} {* 取文件夹文件数} type TFindCallBack = procedure(const FileName: string; const Info: TSearchRec; var Abort: Boolean); {* 查找指定目录下文件的回调函数} procedure FindFile(const Path: string; const FileName: string = '*.*'; Proc: TFindCallBack = nil; bSub: Boolean = True; const bMsg: Boolean = True); {* 查找指定目录下文件} procedure FindFileList(Path:string;Filter,FileList:TStrings;ContainSubDir:Boolean; lb: TLabel=nil); { 功能说明：查找一个路径下的所有文件。 参数： path:路径,filter:文件扩展名过滤,FileList:文件列表, ContainSubDir:是否包含子目录} function Txtline(const txt: string): integer; {* 返回一文本文件的行数} function Html2Txt(htmlfilename: string): string; {* Html文件转化成文本文件} function OpenWith(const FileName: string): Integer; {测试通过} {* 文件打开方式} //▎============================================================▎// //▎====================⑤扩展的对话框函数======================▎// //▎============================================================▎// procedure InfoDlg(Mess: string; Caption: string = SCnInformation; Flags: Integer = MB_OK + MB_ICONINFORMATION); {测试通过} {* 显示提示窗口} function InfoOk(Mess: string; Caption: string = SCnInformation): Boolean; {测试通过} {* 显示提示确认窗口} procedure ErrorDlg(Mess: string; Caption: string = SCnError); {测试通过} {* 显示错误窗口} procedure WarningDlg(Mess: string; Caption: string = SCnWarning); {测试通过} {* 显示警告窗口} function QueryDlg(Mess: string; Caption: string = SCnInformation): Boolean; {测试通过} {* 显示查询是否窗口} procedure SetWindowAnimate(Sender : TForm; IsSetAni : bool); //▎============================================================▎// //▎=====================⑥系统功能函数=========================▎// //▎============================================================▎// procedure MoveMouseIntoControl(AWinControl: TControl); {测试通过} {* 移动鼠标到控件} function DynamicResolution(x, y: WORD): Boolean; {测试通过} {* 动态设置分辨率} procedure StayOnTop(Handle: HWND; OnTop: Boolean); {测试通过} {* 窗口最上方显示} procedure SetHidden(Hide: Boolean); {测试通过} {* 设置程序是否出现在任务栏} procedure SetTaskBarVisible(Visible: Boolean); {测试通过} {* 设置任务栏是否可见} procedure SetDesktopVisible(Visible: Boolean); {测试通过} {* 设置桌面是否可见} procedure BeginWait; {测试通过} {* 显示等待光标} procedure EndWait; {测试通过} {* 结束等待光标} function CheckWindows9598NT: string; {测试通过} {* 检测是否Win95/98/NT平台} function GetOSInfo : String; {测试通过} {* 取得当前操作平台是 Windows 95/98 还是NT} function GetCurrentUserName : string; {*获取当前Windows登录名的用户} function GetRegistryOrg_User(UserKeyType:string):string; {*获取当前注册的单位及用户名称} function GetSysVersion:string; {*//获取操作系统版本号} function WinBootMode:string; {//Windows启动模式} type PShutType = (UPowerOff, UShutdown, UReboot, ULogOff, USuspend, UHibernate); procedure WinShutDown(ShutWinType:PShutType; PForce:Boolean); {//Windows ShutDown等} //▎============================================================▎// //▎=====================⑦硬件功能函数=========================▎// //▎============================================================▎// function GetClientGUID:string; { 功能描述：在本机上得到一个GUID.去掉两端的大括号和中间的横线 返回值：去掉两端的大括号和中间的横线的一个GUID 适用范围：windows } function SoundCardExist: Boolean; {测试通过} {* 声卡是否存在} function GetDiskSerial(DiskChar: Char): string; {* 获取磁盘序列号} function DiskReady(Root: string) : Boolean; {*检查磁盘准备是否就绪} procedure WritePortB( wPort : Word; bValue : Byte ); {* 写串口} function ReadPortB( wPort : Word ) : Byte; {*读串口} function CPUSpeed: Double; {* 获知当前机器CPU的速率（MHz）} type TCPUID = array[1..4] of Longint; function GetCPUID : TCPUID; assembler; register; {*获取CPU的标识ID号*} function GetMemoryTotalPhys : Dword; {*获取计算机的物理内存} type TDriveState = (DSNODISK, DSUNFORMATTEDDISK, DSEMPTYDISK, DSDISK_WITHFILES); function DriveState (driveletter: Char) : TDriveState; {* 检查驱动器A中磁盘是否有效} //▎============================================================▎// //▎=====================⑧网络功能函数=========================▎// //▎============================================================▎// function GetComputerName:string; {* 获取网络计算机名称} function GetHostIP:string; {* 获取计算机的IP地址} function NetUserChangePassword(Domain:PWideChar; UserName:PWideChar; OldPassword:PWideChar; NewPassword:PWideChar): LongInt; stdcall; external 'netapi32.dll' name 'NetUserChangePassword'; {* // 运行平台：Windows NT/2000/XP {* // Windows 95/98/Me平台：可以用该函数修改用户的Windows登录密码} //▎============================================================▎// //▎=====================⑨汉字拼音功能函数=====================▎// //▎============================================================▎// function GetHzPy(const AHzStr: string): string; {测试通过} {* 取汉字的拼音} function HowManyChineseChar(Const s:String):Integer; {* 判断一个字符串中有多少各汉字} //▎============================================================▎// //▎===================⑩数据库功能函数及过程===================▎// //▎============================================================▎// {function PackDbDbf(Var StatusMsg: String): Boolean;} {* 物理删除数据库(Db，Dbf)中的数据[着了删除标记的记录]} procedure RepairDb(DbName: string); {* 修复Access表} function CreateODBCCfgInRegistry(ODBCSourceName:WideString;ServerName, DataBaseDescription:String):boolean; {* 通过注册表创建ODBC配置[创建在系统DSN页下]} function ADOConnectSysBase(Const Adocon:TadoConnection):boolean; {* 用Ado连接SysBase数据库函数} function ADOConnectLocalDB(Const Adocon:TadoConnection;Const Dbname,DbServerName:string;ValidateMode:Integer):boolean; {* 用Ado连接数据库函数} function ADOODBCConnectLocalDB(Const Adocon:TadoConnection;Const Dbname:string;ValidateMode:Integer):boolean; {* 用Ado与ODBC共同连接数据库函数} function CreatTable(LpDataBaseName,LpTableName,LpSentence:string):Boolean; {* //建立新表} function AddField(LpFieldName:string; LpDataType: TFieldType; LpSize: Word):string; {*//在表中添加字段} function KillField(LpFieldName:string):String; {* //在表中删除字段} function AlterTableExec(LpDataBaseName,LpSentence:string):Boolean; {* //修改表结构} function GetSQLSentence(LpTableName,LpSQLsentence:string): string; {* /修改、添加、删除表结构时的SQL句体} //▎============================================================▎// //▎======================⑾进制函数及过程======================▎// //▎============================================================▎// function StrToHex(AStr: string): string; {* 字符转化成十六进制} function HexToStr(AStr: string): string; {* 十六进制转化成字符} function TransChar(AChar: Char): Integer; //▎============================================================▎// //▎=====================⑿其它函数及过程=======================▎// //▎============================================================▎// function TrimInt(Value, Min, Max: Integer): Integer; overload; {测试通过} {* 输出限制在Min..Max之间} function IntToByte(Value: Integer): Byte; overload; {测试通过} {* 输出限制在0..255之间} function InBound(Value: Integer; Min, Max: Integer): Boolean; {测试通过} {* 判断整数Value是否在Min和Max之间} procedure CnSwap(var A, B: Byte); overload; {* 交换两个数} procedure CnSwap(var A, B: Integer); overload; {* 交换两个数} procedure CnSwap(var A, B: Single); overload; {* 交换两个数} procedure CnSwap(var A, B: Double); overload; {* 交换两个数} function RectEqu(Rect1, Rect2: TRect): Boolean; {* 比较两个Rect是否相等} procedure DeRect(Rect: TRect; var x, y, Width, Height: Integer); {* 分解一个TRect为左上角坐标x, y和宽度Width、高度Height} function EnSize(cx, cy: Integer): TSize; {* 返回一个TSize类型} function RectWidth(Rect: TRect): Integer; {* 计算TRect的宽度} function RectHeight(Rect: TRect): Integer; {* 计算TRect的高度} procedure Delay(const uDelay: DWORD); {测试通过} {* 延时} procedure BeepEx(const Freq: WORD = 1200; const Delay: WORD = 1); {Win9X下测试通过} {* 只能在Win9X下让喇叭发声} procedure ShowLastError; {测试通过} {* 显示Win32 Api运行结果信息} function writeFontStyle(FS: TFontStyles; inifile: string; write: boolean):string; {* 将字体Font.Style写入INI文件} function readFontStyle(inifile: string): TFontStyles; {* 从INI文件中读取字体Font.Style文件} //function ReadCursorPos(SourceMemo: TMemo): TPoint; function ReadCursorPos(SourceMemo: TMemo): string; {* 取得TMemo 控件当前光标的行和列信息到Tpoint中} function CanUndo(AMemo: TMemo): Boolean; {* 检查Tmemo控件能否Undo} procedure Undo(Amemo: Tmemo); {*实现Undo功能} procedure AutoListDisplay(ACombox:TComboBox); {* 实现ComBoBox自动下拉} function UpperMoney(small:real):string; {* 小写金额转换为大写 } function Myrandom(Num: Integer): integer; {*利用系统时间产生随机数)} procedure OpenIME(ImeName: string); {*打开输入法} procedure CloseIME; {*关闭输入法} procedure ToChinese(hWindows: THandle; bChinese: boolean); {*打开中文输入法} //数据备份 procedure BackUpData(LpBackDispMessTitle:String); procedure ImageLoadGif(Picture: TPicture; filename: string); procedure ImageLoadJpg(Picture: TPicture; filename: string);
Delphi自定义的多条件查询公共单元代码..rar
04-28
Delphi自定义的多条件查询公共单元代码..rar
Delphi自定义的多条件查询公共单元代码
05-16
内容索引:Delphi源码,控件组件,查询　　Delphi自定义的多条件查询公共单元代码，其它程序也可使用，部分代码摘要： 　　uses iunit; //还需要引用ComCtrls单元以供Tlistitem调用 　　procedure TeForm.S1Click(Sender: TObject); 　　 //以下是将查询关键字添加到列表中,格式:关键字,数据库中字段名,类型(分字符、数值、日期),最后一个不要加豆号 s := '学员证件号码,fcode,字符,学员准考证号,fexam,字符,缴款日期,fdate,日期,缴款金额,famount,数值';
Delphi 移除无效的托盘图标.rar
07-10
Delphi refreshtray移除无效的Windows系统托盘图标，非鼠标移动模拟方法，相关的代码： 　　begin 　　 hStatus := FindWindow('Shell_TrayWnd',nil); //得到任务栏句柄 　　 if not iswindow(hStatus) then exit; 　　 hNotify := FindWindowEx(hStatus,0,'TrayNotifyWnd',nil); //右下角区域 　　 if not iswindow(hNotify) then exit; 　　 hNotify1 := FindWindowEx(hNotify,0,'SysPager',nil); 　　 if not iswindow(hNotify1) then exit; 　　 hNotify1_0 := FindWindowEx(hNotify1,0,'ToolBarWindow32',nil);//右下角区域(不包括时间) 　　 if not iswindow(hNotify1_0) then exit; 　　//以上是得到任务栏右下脚一块地方的句柄 　　 GetWindowThreadProcessId(hNotify1_0,pid); 　　 if (pid = 0) then exit; 　　 hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_ALL_ACCESS,true,pid); 　　 if (hProcess = 0) then exit; 　　 SendMessage(hNotify1_0,WM_PAINT ,0,0); 　　 GetWindowRect(hNotify1_0,rect); 　　 InvalidateRect(hNotify1_0,@rect,false); 　　 iNum := SendMessage(hNotify1_0,TB_BUTTONCOUNT ,0,0); //获取任务栏上图标个数
我的公共函数单元（二）（Delphi）
Hsu Chong 的专栏
03-13 4624
{   This unit was generated on Sun, 10 Dec 2006 09:45:52 +0000   by the code snippets database at www.delphidabbler.com.   Check the site for updates.   The unit is freeware and may be freely distribu
Delphi常用系统函数 SysUtils单元
08-18 196
CompareText 比较两个字符串的大小，返回值为 -1 [ 当 a1<a2 时 ] 或 0 [ 当 a1=a2 时] 或 1 [当 a1>a2 时] function CompareText(const a1, a2: string): Integer; 比较时，不区分大小写； var a1,a2:string; begin a1:= 'H...
delphi 如何创建公共函数
10-22 1368
第一种方法类方法 第二种方法： //   公共函数库 //要先在implementation前面声明这个函数, //此单元中需要包括公用的pas文件， //如sysutils等。需要哪个就把哪个放进去。 //其它单元 引用Unit3后自接调用  test ; unit Unit3; interface  uses classes,sysutils,windows,Vcl.Dialogs; ...
Delphi.Math单元：高性能数学计算函数详解
"Delphi.Math单元包含了丰富的数学函数，旨在提供高性能的算术、三角、对数、统计和金融计算，补充了Delphi语言System.pas单元中的基础数学函数。这个单元适用于Delphi和Kylix跨平台运行时环境，并且部分函数的实现...
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值