delphi公共函数 UMyPubFuncFroc--版权所有 (C) 2008 勇者工作室

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

{                                                       }

{             Delphi公用函数单元                        }

{                                                       }

{        版权所有 (C) 2008 勇者工作室                   }

{                                                       }

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

unit UMyPubFuncFroc;

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公共函数 UMyPubFuncFroc--版权所有 (C) 2008 勇者工作室的更多相关文章

delphi公用函数
{*******************************************************} { } { Delphi公用函数单元 } { } { 版权所有 (C) 2008 } ...
ThinkPHP 3.2.3 自动加载公共函数文件的方法
方法一.加载默认的公共函数文件在 ThinkPHP 3.2.3 中,默认的公共函数文件位于公共模块 ./Application/Common 下,访问所有的模块之前都会首先加载公共模块下面的配置文件 ...
CodeIgniter 引入自定义公共函数
CodeIgniter 中公共函数不能追加,可以通过 helper 辅助函数实现. 创建 common_helper.php 文件,定义所需公共函数,存放至 application/helpers 目 ...
（转载）delphi 常用函数(数学)
delphi 常用函数(数学) Delphi中怎么将实数取整? floor 和 ceil 是 math unit 里的函数,使用前要先 Uses Math.trunc 和 round 是 system ...
ThinkPHP第三天(公共函数Common加载，dump定义，模板文件，定义替换__PUBLIC__)
1.公共函数定义自动加载:在项目的common文件夹中定义,公共函数文件命名规则为common.php,只有命名成common.php才能被自动载入. 动态加载:可以修改配置项‘LOAD_EXT_F ...
Delphi回调函数及其使用
Delphi回调函数及其使用 1 回调函数的概述回调函数是这样一种机制:调用者在初始化一个对象(这里的对象是泛指,包括OOP中的对象.全局函数等)时,将一些参数传递给对象,同时将一个调用者可以访问的 ...
Delphi过程函数传递参数的八种方式
今天一同事问我为什么有些过程函数里面有Var而有些没有,不解,遂到网上百度,得解.快哉,快哉. 在Delphi过程.函数中传递参数几个修饰符为Const.Var.Out.另一种不加修饰符的为默认按值传 ...
【ASP.NET】怎样使用类创建公共函数，在不同ASP.NET页面间反复调用
为了降低代码冗余,应将公共函数写在类中,供不同ASP.NET页面调用. 1,先新建一个类,并在类中加入函数逻辑 namespace public_function_demo { public clas ...
delphi字符串函数大全
转帖:delphi字符串函数大全 2009-11-17 16:43:55 分类: delphi字符串函数大全 ━━━━━━━━━━━━━━━━━━━━━首部 function StringToGUID ...
随机推荐

【CCL】连通区域提取
根据朋友给的一份原理写的感觉还挺清楚 #include "cv.h" #include "highgui.h" #include <stdio.h> ...
IOS - Passbook
1. 什么是Passbook Passbook是苹果公司于北京时间2012年6月12日上午,在全球开发者大会(WWDC)上宣布了iOS 6系统将提供操作一个全新的应用——Passbook 这是一款可以 ...
Linear regression with multiple variables(多特征的线型回归)算法实例_梯度下降解法(Gradient DesentMulti)以及正规方程解法(Normal Equation)
,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, ,, , ...
CSS3与页面布局学习总结——Box Model、边距折叠、内联与块标签、CSSReset
目录一.盒子模型(Box Model) 1.1.宽度测试 1.2.溢出测试 1.3.box-sizing属性 1.4.利用CSS画图二.边距折叠 2.1.概要 2.2.垂直方向外边距合并计算三. ...
mysql入门语句10条
1,连接数据库服务器 mysql -h host -u root -p xxx(密码) 2,查看所有库 show databases; 3,选库 use 库名 4,查看库下面的表 show ...
python中的时间处理函数
Python提供了多个内置模块用于操作日期时间,像calendar,time,datetime.time模块我在之前的文章已经有所介绍,它提供的接口与C标准库time.h基本一致.相比于time模块 ...
Eclipse中怎么设置Add cast to Clazz 快捷键
方法如下:window => preferences => 搜索keys => 然后点击进去,搜索add cast => 看到如图所示Quick Fix , 点击进去 => ...
Unreal Engine4 学习笔记1 状态机动画蓝图
1.动画蓝图包含状态机包含混合空间BlendSpace,即状态机包含在动画蓝图的"动画图表中",而混合空间可用于在状态机中向某(没)一个状态输出最终POSE: 动画蓝 ...
DB2 日期相减
简单方法: 使用 days 字符型的日期:2012-01-01,2012-01-11 values days(date('2012-01-11')) - days(date('2012-01-01' ...
PGA
Server Process PGA 1.PGA作用 2.PGA構成 1)private sql area 2)session memory 3)sql ...
delphi公共函数 UMyPubFuncFroc--版权所有 (C) 2008 勇者工作室

delphi公共函数 UMyPubFuncFroc--版权所有 (C) 2008 勇者工作室的更多相关文章

随机推荐

热门专题
