delphi公用函数

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

{                                                       }

{             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.
delphi公用函数的更多相关文章

delphi公共函数 UMyPubFuncFroc--版权所有 (C) 2008 勇者工作室
{*******************************************************} { } { Delphi公用函数单元 } { } { 版权所有 (C) 2008 勇 ...
delphi的一个公用函数库
delphi的一个公用函数库 {********************************************** *** Name: PublicFunc; *** Author: l ...
（转载）delphi 常用函数(数学)
delphi 常用函数(数学) Delphi中怎么将实数取整? floor 和 ceil 是 math unit 里的函数,使用前要先 Uses Math.trunc 和 round 是 system ...
Delphi回调函数及其使用
Delphi回调函数及其使用 1 回调函数的概述回调函数是这样一种机制:调用者在初始化一个对象(这里的对象是泛指,包括OOP中的对象.全局函数等)时,将一些参数传递给对象,同时将一个调用者可以访问的 ...
Delphi过程函数传递参数的八种方式
今天一同事问我为什么有些过程函数里面有Var而有些没有,不解,遂到网上百度,得解.快哉,快哉. 在Delphi过程.函数中传递参数几个修饰符为Const.Var.Out.另一种不加修饰符的为默认按值传 ...
delphi字符串函数大全
转帖:delphi字符串函数大全 2009-11-17 16:43:55 分类: delphi字符串函数大全 ━━━━━━━━━━━━━━━━━━━━━首部 function StringToGUID ...
Delphi 常用函数(数学函数）round、trunc、ceil和floor
源:Delphi 常用函数(数学函数)round.trunc.ceil和floor Delphi 常用函数(数学) Delphi中怎么将实数取整? floor 和 ceil 是 math unit 里 ...
wemall app商城源码Android之支付宝接口公用函数
wemall-mobile是基于WeMall的Android app商城,只需要在原商城目录下上传接口文件即可完成服务端的配置,客户端可定制修改.本文分享wemall app商城源码Android之 ...
MD5 与 SHA 在 Delphi 中函数实现，加密密码
MD5 与 SHA 在 Delphi 中函数实现. 为了加密密码,必须使用一种算法,查询资料,比较好的方法是使用:MD5等算法,参考:Delphi XE8 支持MD5 第一种方式是:引用 System ...
随机推荐

【学生成绩管理系统】大二c语言作业
几年前写的了,只能在命令行窗口运行,虽然比较挫,还是有一定参考价值... #include <cstdio> #include <conio.h> #include <i ...
关于js的一些基本知识（类,闭包，变量）
这里写的都是些杂知识,包括私有,类,闭包这些js不可避免的东西,感觉自己有可能会误人子弟.所以有觉得写错了的读者,希望可以及时评论告诉我.我可以及时更正.多谢大家了 1.关于类的创建类的创建大致可以 ...
led.c驱动框架
Makefile: obj-m += led.o ################################################ KERNEL = /home/linux--FS21 ...
js正则之零宽断言
我们学到的正则表达式匹配,都是有“宽度”的,使用 \w+. 匹配下面文本,会将 . 一同匹配: regular. expression. 如果不想匹配符号,只匹配一个位置,就要用到“零宽断言”(匹配宽 ...
ssl通信c实现
/*File:client.c *Auth:sjin *Date:2014-03-11 * */ #include <stdio.h>#include <string.h>#i ...
Smali文件语法解析
大家都应该知道APK文件其实就是一个MIME为ZIP的压缩包,我们修改ZIP后缀名方式可以看到内部的文件结构,例如修改后缀后用RAR打开鳄鱼小顽皮APK能看到的是(Google Play下载的完整版版 ...
ARM架构解析
ARM架构解析 (2014-11-23 21:56:53) 转载▼ 标签: francis_hao arm架构 arm核 soc 分类: MCU 先来谈一下ARM的发展史:1978年12月5日,物理学 ...
用php自动发邮件的简单实现
如何自动发送邮件? php自带mail方法,不过只能在linux下直接使用,windows下要配置smtp服务器,有点麻烦. 可以用一些现成的类来实现,比如很有名的phpmailer,功能很强大,代码 ...
strlen sizeof strcat strcpy区别
strlen(p): 能计算出p指向字符串的长度(以当前p的位置开始),不包含终止字符'\0': p可以声明为char* p或者char p[],这两种形式strlen均能正确计算. sizeof ...
iOS开发之圆角指定
如果需要将UIView的4个角全部都为圆角,做法相当简单,只需设置其Layer的cornerRadius属性即可(项目需要使用QuartzCore框架).而若要指定某几个角(小于4)为圆角而别的不变时 ...
delphi公用函数

delphi公用函数的更多相关文章

随机推荐

热门专题
