Delphi函数（网摘）

最新推荐文章于 2024-08-06 17:28:02 发布

UnkownState

最新推荐文章于 2024-08-06 17:28:02 发布

阅读量6.1k

点赞数

分类专栏：未分类文章标签： delphi function class string integer byte

未分类专栏收录该内容

31 篇文章 0 订阅

订阅专栏

//------------------------------------------------------------------------------
// Author      : Michael
// Date        : 2006-08-25
// Description :
// Version     : 2.0.0.0
// Update      : 2006-09-18
{
01. Add function:IsValidIP (2006-09-18)
02. Add function:IniDeleteSection *2 (2006-09-22)
03. Add function:JpgToBmp (2006-09-23)
04. Add function GetDisplayCardName//取得显卡名称(2006-09-26)
05. Add function GetHDDName//取得硬盘名称    (2006-09-26)
06. Add function GetCdromName//取得光驱名称 (2006-09-26)
07. Add function GetCPUName//取得CPU名称　　(2006-09-26)
08. Add function DateTimeTotime_t(dt:TDateTime):DWORD;//time_t时间　    　(2006-09-27)
09. Add function time_tToDateTime(iTime:DWORD):TDateTime;//time_t时间　　(2006-09-27)
11. Modify function Language LanguageCode                                 (2006-09-27)
12. Add function GetIPByHost   (2006-09-29)
13. Add procedure DelSelfAfterClose;//关闭应用程序后删除自己              (2006-10-02)
14. Add procedure DelSelfAfterReboot(aFileName:string='');//重启后删除自己(2006-10-02)
15. Add function CopyFile (2006-11-11)
}
//------------------------------------------------------------------------------
unit cmClass_Function;

interface

uses
Windows,Messages,SysUtils,Variants,Classes,Controls,Forms,Dialogs,
PsAPI,
Graphics,Jpeg,
StrUtils,
WinSock,ScktComp,WinInet,Nb30,UrlMon,
ActiveX,
ShellApi,IniFiles,Registry;

const
Enter=#13#10;//回车键值
Space=#32;

var
FixIniFileName:string='';

type
Int=integer;
time_t=DWORD;//unix linux中时间

type
TFun=class
private
protected
public
//路径
    class function WorkPath:string;//应用程序工作路径
    class function SysPath:string;// Windows/System32路径
    class function WinPath:string;//Windows路径
    class function ProgramPath:string;//Program files路径
    class function WindowsTempPath:string;//临时文件路径
    class function SysDownloadPath:string;//C:/WINDOWS/Downloaded Program Files

    class function IniFileName:string;//INI文件路径
//文件操作
    class function CopyFile(SrcFile,DstFile:string):boolean;
    class function WriteDebugInfo(Value:string):boolean;
    class function FileVersion:string;//应用程序版本
    class function GetFileVersion(AFileName:string):string;//
    class function GetFileProductVersion(AFileName:string):string;//
    class function GetFileSize(FileName:string):UINT;
    class function GetFileDate(FileName:string):TDateTime;//获到文件修改时间
    class function SetFileDate(FileName:string;DT:TDateTime):Boolean;//修改文件修改时间
    class procedure GetFileCreateModifyTime(FName:string;var CreateTime,ModifyTime:TDateTime);
    class function SetFileCreateModifyTime(FName:string;CreateTime,ModifyTime:TDateTime):boolean;
    class function MakeDir(Dir:string):boolean;
    class function Deltree(Dir:string):Boolean;// 删除整个目录
    class function GetDirAllFile(Path,FileExt:string):TStringList;
    class function GetDirSize(Path:string;SubDir:boolean=True):Int64;
    class procedure GetFileList(path,ext:string;var AList:TStrings);
    class function GetOldFileName(FileSpec:string):string;//取得目录下最老的文件
    class function CopyDirectory(Source,Target:PChar):boolean;//复制COPY目录
    class procedure RunFile(FileName:string;Param:string='');//运行一个文件
    class function RunFileWait(FileName:string;Visibility:Integer=SW_NORMAL):Integer;//运行一个文件并等待其结束
    class function CreateUnicodeTextFile(FileName:string):boolean;//创建一个Unicode Text文件

//系统相关
    class procedure DelSelfAfterClose;//关闭应用程序后删除自己
    class procedure DelSelfAfterReboot(aFileName:string='');//重启后删除自己
    class function GetDisplayCardName:string;//取得显卡名称
    class function GetDisplayCardNameEx:string;//取得显卡名称
    class function GetHDDName:string;//取得硬盘名称
    class function GetCdromName:string;//取得光驱名称
    class function GetCPUName:string;//取得CPU名称
    class function GetWindowsVersion:string;//获得WINDOWS版本
    class function GetWindowsType:string;//

    class function IsIDE:boolean;//是否运行在IDE环境
    class procedure HideTaskMgr;//任务条就看不当程序
    class function GetMemorySize:Dword;//物理內存
    class function GetWindowsUserName:string;
    class function GetComputerName:string;
    class function SetSystemTime(DT:TDateTime):boolean;
    class function DynamicResolution(x,y:WORD):Boolean;//动态设置分辨率
    class function InstallOcx(aFileName:string;bSetup:boolean):boolean;
    class procedure CloseComputer;//关闭计算机支持WIN98 WIN2000 WINXP
    class procedure ReBootComputer;//重啟计算机支持WIN98 WIN2000 WINXP
    class procedure CloseWindowEx(aWnd:hWnd=0);//强制关闭程序
    class function IsDoubleScreen:boolean;//系统是否使用双显示器
    class function Language:string;//当前系统语言类型
    class function LanguageCode:Integer;//当前系统语言类型
    class procedure DoBusy(Busy:Boolean=True);//使鼠标变忙和恢复正常
    class function GetProcessFileName(Wnd:hWnd):string;//取得句柄应用程序文件名
    class function GetWndFromProcessFileName(FileName:string):hWnd;//根据进程程序名取得句柄
//窗口相关
    class function FindForm(aName:string):TForm;//查找程序中已创建的窗口
    class function FindFormEx(aCaption:string):TForm;//查找程序中已创建的窗口
    class procedure StayOnTop(Handle:HWND;OnTop:Boolean=True); overload;// 窗口最上方显示
    class procedure StayOnTop(Form:TForm;OnTop:Boolean=True); overload;// 窗口最上方显示
    class procedure CreateEroseWindow(wHandle:THandle;wMask:TBitMap;wMaskColor:TColor);//创建不规格窗口
//消息
    class function ShowMsg(Text:string;Icon:boolean=False):integer; overload;//显示消息
    class function ShowMsg(Text:string;Warning1_Asterisk2_Question3_Error4,DefBtn012:integer):integer; overload;

    class procedure SleepEx(ms:integer);//自定义Sleep

    class function SendMsg(Msg:DWORD;wParam,lParam:Longint):boolean; overload;//发送应用程序消息
    class function SendMsg(Msg:DWORD):boolean; overload;//发送应用程序消息
    class function SendMsg(aWnd:HWND;Msg:DWORD;wParam,lParam:Longint):boolean; overload;//发送其它程序消息
    class function SendFormMsg(aName:string;Msg:DWORD;wParam,lParam:Longint):boolean;//发送给窗口的消息
    class function SendMsgBroadCast(Msg:DWORD;wParam,lParam:Longint):boolean;//广播消息
//注册表操作
    class function AddToStartUpRun(Key,Value:string;MACHINE0_USER1:integer=1):boolean;//增加到开始菜单

    class function RegDeleteSection(Section:string;MainKey:string=''):boolean;
    class function RegDeleteKey(Section,ident:string;MainKey:string=''):boolean;

    class function RegReadStr(Section,ident,Default:string;MainKey:string=''):string;
    class function RegReadInt(Section,ident:string;Default:integer;MainKey:string=''):integer;
    class function RegReadBool(Section,ident:string;Default:boolean;MainKey:string=''):boolean;
    class function RegReadFloat(Section,ident:string;Default:Double;MainKey:string=''):Double;
    class function RegWriteStr(Section,ident,Value:string;MainKey:string=''):boolean;
    class function RegWriteInt(Section,ident:string;Value:integer;MainKey:string=''):boolean;
    class function RegWriteBool(Section,ident:string;Value:boolean;MainKey:string=''):boolean;
    class function RegWriteFloat(Section,ident:string;Value:Double;MainKey:string=''):boolean;

//INI操作
    class function IniDeleteSection(FileName:string;Section:string):boolean; overload;
    class function IniDeleteSection(Section:string):boolean; overload;
    class function IniDeleteKey(Section,ident:string):boolean;
    class function IniReadStr(FileName:string;Section,ident,Default:string):string; overload;//读INI
    class function IniReadInt(FileName:string;Section,ident:string;Default:integer):integer; overload;
    class function IniReadBool(FileName:string;Section,ident:string;Default:boolean):boolean; overload;
    class function IniReadFloat(FileName:string;Section,ident:string;Default:Double):Double; overload;
    class function IniWriteStr(FileName:string;Section,ident,Value:string):boolean; overload;//写INi
    class function IniWriteInt(FileName:string;Section,ident:string;Value:integer):boolean; overload;
    class function IniWriteBool(FileName:string;Section,ident:string;Value:boolean):boolean; overload;
    class function IniWriteFloat(FileName:string;Section,ident:string;Value:Double):boolean; overload;

    class function IniReadStr(Section,ident,Default:string):string; overload;//读INI
    class function IniReadInt(Section,ident:string;Default:integer):integer; overload;
    class function IniReadBool(Section,ident:string;Default:boolean):boolean; overload;
    class function IniReadFloat(Section,ident:string;Default:Double):Double; overload;
    class function IniWriteStr(Section,ident,Value:string):boolean; overload;//写INi
    class function IniWriteInt(Section,ident:string;Value:integer):boolean; overload;
    class function IniWriteBool(Section,ident:string;Value:boolean):boolean; overload;
    class function IniWriteFloat(Section,ident:string;Value:Double):boolean; overload;

//网络操作
    class function IsValidEmail(const S:string):boolean;//是否有效的Email
    class function NetAdjustTime(aTime:TDateTime):boolean; overload;
    class function NetAdjustTime(ServerAddress:string='192.43.244.18';
      ServerPort:Integer=13):boolean; overload;//网络校时
    class function WaitNetActive(WaitTime:integer=5000):boolean;//等待网络
    class function Ping(IP:string):Boolean; overload;
    class function Ping(IP:string;TimeOut:integer):boolean; overload;//uses WinSock
    class function InternetConnected:Boolean;//是否连接互联岗
    class function GetLocalIP:string;//取得本机IP
    class function GetLocalAllIP:string;//取得本机所有IP
    class function GetHostByIP(AIP:string):string;//得到IP地址的主机名
    class function GetIPByHost(aHost:string):string;
    class function GetNetBIOSAddress:string;//取得网卡MAC
    class function IPToInt(IP:string):DWord;
    class function IntToIP(IP:DWORD;Reverse:boolean=False):string;
    class function IsValidIP(IP:string):boolean;//是否有效IP
    class function DownloadFile(Source,Dest:string):Boolean;//下载文件

    class function GetBroadCastIP(IP:string):string;
    class function IsBroadCaseIP(IP:string):boolean;
    class procedure DecodeIP(ip:string;var n1,n2,n3,n4:Byte);

//加密解密
    class function Encrypt(S:string):string;//字符串简单加密
    class function Decrypt(S:string):string;//字符串简单加密
    class function GetGuidID:string;//生成一个GUID字符串
    class function GetCPUID:string;
    class function GetOnlyID:string;
    class function GetHDDID:string;//获取Ide硬盘序列号
//数值操作
    class function Space(Count:Int=1):string;
    class function BIG5ToGB(Str:string):string;//繁->简
    class function GBToBIG5(Str:string):string;//简->繁

    class function HexToInt(Str:string):Integer;
    class function IntToHex(Value:Int;Digits:Int=8):string;

    class function StrToHex(AStr:string):string;//字符转化成十六进制
    class function HexToStr(AStr:string):string;//十六进制转化成字符

    class function IntToBin(TheVal:LongInt;const Count:integer=0):string;//十进制转二进制
    class function BinToInt(s:string):integer;//二进制转十进制
    class function HexToBin(AStr:string):string;//十六进制转二进制
    class function Max(a,b:integer):integer;//求最大值
    class function Min(a,b:integer):integer;//求最小值
    class function IntHighToLow(Value:DWORD):DWORD;//高位整型转成低位整型
    class function MakeFcc(ch0,ch1,ch2,ch3:Char):DWORD; overload;
    class function MakeFcc(ch:string):DWORD; overload;

//时间操作
    class function DateTimeToIntTime(dt:TDateTime):DWORD;
    class function IntTimeToDateTime(iTime:DWORD):TDateTime;

    class function DateTimeTotime_t(dt:TDateTime):DWORD;//time_t时间
    class function time_tToDateTime(iTime:DWORD):TDateTime;//time_t时间

//图像操作
    class procedure ScreenToJpg(LeftPos,TopPos,RightPos,BottomPos:integer;FileName:string);//保存屏幕到JPG文件
    class function PrintBmpTime(BmpFile:string;dt:TDateTime;x:integer=3;y:integer=3):boolean;//在BMP文件上打印时间
    class function PrintJpgTime(JpgFile:string;dt:TDateTime;x:integer=3;y:integer=3):boolean;//在JPG文件上打印时间
    class function PrintJpgString(JpgFile:string;Str:string;x:integer=3;y:integer=3):boolean;

    class function BmpToJpg(BmpFile,JpgFile:string):boolean;
    class function BmpMiniature(Src:TBitmap;var Dst:TBitMap;Width,Height:Int):boolean; overload;
    class function BmpMiniature(Src,Dst:string;Width,Height:Int):boolean; overload;

    class function JpgToBmp(JpgFile,BmpFile:string):boolean;
    class function JpgMiniature(Src:TJpegImage;var Dst:TJpegImage;Width,Height:Int):boolean; overload;
    class function JpgMiniature(Src,Dst:string;Width,Height:Int):boolean; overload;
//串口操作
    class function CheckRs232(FCOM:PChar):boolean;//串口是否准备好

    constructor Create;
    destructor Destroy; override;

published

end;

implementation

class function TFun.GetLocalIP:string;
var
WSAData:TWSAData;
HostName:array[0..MAX_COMPUTERNAME_LENGTH] of Char;
HostEnt:PHostEnt;
LastIP:PInAddr;
IPList:^PInAddr;
begin
Result:='';
if 0=WSAStartup(MAKEWORD(1,1),WSAData) then
try
    if 0=gethostname(HostName,MAX_COMPUTERNAME_LENGTH+1) then
    begin
      HostEnt:=gethostbyname(HostName);
      if HostEnt<>nil then
      begin
        IPList:=Pointer(HostEnt^.h_addr_list);
        repeat
          LastIP:=IPList^;
          INC(IPList);
        until IPList^=nil;
        if LastIP<>nil then
          Result:=inet_ntoa(LastIP^);
      end;
    end;
finally
    WSACleanup;
end;
end;

class function TFun.GetFileVersion(AFileName:string):string;
var
V1,V2,V3,V4:Word;
VerInfoSize:DWORD;
VerInfo:Pointer;
VerValueSize:DWORD;
VerValue:PVSFixedFileInfo;
Dummy:DWORD;
FileName:string;
begin
FileName:=AFileName;
try
    VerInfoSize:=GetFileVersionInfoSize(PChar(FileName),Dummy);
    GetMem(VerInfo,VerInfoSize);
    GetFileVersionInfo(PChar(FileName),0,VerInfoSize,VerInfo);
    VerQueryValue(VerInfo,'/',Pointer(VerValue),VerValueSize);
    with VerValue^ do
    begin
      V1:=dwFileVersionMS shr 16;
      V2:=dwFileVersionMS and $FFFF;
      V3:=dwFileVersionLS shr 16;
      V4:=dwFileVersionLS and $FFFF;
    end;
    FreeMem(VerInfo,VerInfoSize);
    Result:=Format('%d.%d.%d.%d', [v1,v2,v3,v4]);// 2.0.0.0
except end;
end;

class function TFun.MakeDir(Dir:string):boolean;
begin
Result:=True;
if Dir<>'' then
begin
    if not DirectoryExists(Dir) then
      Result:=ForceDirectories(Dir);
end;
end;

class function TFun.InternetConnected:Boolean;
//=================================================================
//功能: 检测计算机是否上网
//备注: uses Wininet
//=================================================================
const
INTERNET_CONNECTION_MODEM=1;
INTERNET_CONNECTION_LAN=2;
INTERNET_CONNECTION_PROXY=4;
INTERNET_CONNECTION_MODEM_BUSY=8;
var
dwConnectionTypes:DWORD;
begin
dwConnectionTypes:=INTERNET_CONNECTION_MODEM+INTERNET_CONNECTION_LAN
    +INTERNET_CONNECTION_PROXY;
Result:=InternetGetConnectedState(@dwConnectionTypes,0);
end;

class function TFun.GetDirAllFile(Path,FileExt:string):TStringList;
var
f:TSearchRec;
R:Integer;
Ext:string;
// FileName:string;
begin
if RightStr(Path,1)<>'/' then Path:=Path+'/';

Result:=TStringList.Create;
// R:=FindFirst(Path+'/'+FileExt,faAnyFile,f);
R:=FindFirst(Path+FileExt,faAnyFile,f);
try
    while R=0 do
    begin
      if f.Attr=faDirectory then
      begin
        if (f.Name<>'.')and(f.Name<>'..') then
        begin
          Result.AddStrings(GetDirAllFile(Path+f.Name,FileExt));
        end;
      end else
      begin
        Ext:=ExtractFileExt(f.Name);
        if Pos(Ext,FileExt)>0 then
        begin
          Result.Append(Path+f.Name);
        end;
      end;
      try
        R:=FindNext(f);
      except
        R:=0;
      end;
    end;
finally
    FindClose(f);
end;
end;

class function TFun.GetOldFileName(FileSpec:string):string;
// caption:=GetOldFileName('G:/VS-Flower/Record/Normal/*.mpg');
function FileCount(FileSpec:string):longint;
var
    R:TSearchRec;
    i,Error:integer;
begin
    i:=0;
    Error:=FindFirst(FileSpec,faAnyFile,R);
    if Error=0 then
    begin
      if (R.Name<>'.')and(R.Name<>'..') then inc(i);
      while FindNext(R)=0 do
        if (R.Name<>'.')and(R.Name<>'..') then inc(i);
    end
    else i:=0;
    Result:=i;
end;
var
R:TSearchRec;
Count,Error:integer;
FileName:string;
OldTime:integer;
begin
Count:=FileCount(FileSpec);
if Count>1 then
begin
    Error:=FindFirst(FileSpec,faAnyFile-faDirectory,R);
    if Error=0 then
    begin
      FileName:=ExtractFilePath(FileSpec)+R.Name;
      OldTime:=R.Time;
      while FindNext(R)=0 do
      begin
        if R.Time<OldTime then
        begin
          FileName:=ExtractFilePath(FileSpec)+R.Name;
          OldTime:=R.Time;
        end;
      end;
      Result:=FileName;
    end;
end else
begin
    Error:=FindFirst(FileSpec,faAnyFile,R);
    if Error=0 then
    begin
      Result:=ExtractFilePath(FileSpec)+R.Name;
    end
    else
      Result:='';
end;
end;

class procedure TFun.GetFileList(path,ext:string;var AList:TStrings);
var
f:TSearchRec;
R,len:integer;
begin
AList.Clear;
len:=length(path);
if path[len]<>'/' then path:=path+'/';

R:=FindFirst(path+'*.'+ext,faAnyFile,f);
while R=0 do
begin
    AList.Add(f.Name);
    R:=FindNext(f);
end;
FindClose(f);
end;

class function TFun.GetGuidID:string;//生成一个GUID字符串
var
AGUID:TGUID;
begin
CreateGUID(AGUID);
Result:=GUIDToString(AGUID);
end;

class function TFun.GetCPUID:string;
type TCPUID=array[1..4] of Longint;
function GetID:TCPUID; assembler; register;
asm
PUSH   EBX
PUSH   EDI
MOV    EDI,EAX
MOV    EAX,1
DW     $A20F          // CPUID Command
STOSD                 // CPUID[1]
MOV    EAX,EBX
STOSD                 // CPUID[2]
MOV    EAX,ECX
STOSD                 // CPUID[3]
MOV    EAX,EDX
STOSD                 // CPUID[4]
POP    EDI
POP    EBX
end;
var CPUID:TCPUID;
i:integer;
S:array[1..4] of string;
begin
CPUID:=GetID;
for i:=1 to 4 do
begin
    s[i]:=IntToStr(Abs(CpuID[i]));
    if s[i]='0' then s[i]:='2425';
    if Length(s[i])>4 then s[i]:=Copy(s[i],Length(s[i])-3,4);
end;
Result:=s[1]+'-'+s[2]+'-'+s[3]+'-'+s[4];
end;

class function TFun.GetFileDate(FileName:string):TDateTime;
var i:integer;
begin
i:=FileOpen(FileName,0);
Result:=FileDateToDateTime(FileGetDate(i));
FileClose(i);
end;

class function TFun.SetFileDate(FileName:string;DT:TDateTime):Boolean;
begin
FileSetDate(FileName,DateTimeToFileDate(DT));
Result:=True;
end;

class procedure TFun.GetFileCreateModifyTime(FName:string;var CreateTime,ModifyTime:TDateTime);
var
Wnd:HFILE;
fStruct:_OFSTRUCT;
ftCreation,ftLastAccess,ftLastWrite:TFileTime;
ftCreation1,ftLastWrite1:TFileTime;
st:TSystemTime;
begin
Wnd:=OpenFile(PChar(FName),fStruct,OF_READ);
GetFileTime(Wnd,@ftCreation,@ftLastAccess,@ftLastWrite);

FileTimeToLocalFileTime(ftCreation,ftCreation1);
FileTimeToSystemTime(ftCreation1,st);//
CreateTime:=SystemTimeToDateTime(st);

FileTimeToLocalFileTime(ftLastWrite,ftLastWrite1);
FileTimeToSystemTime(ftLastWrite1,st);
ModifyTime:=SystemTimeToDateTime(st);
_lclose(Wnd);
end;

class function TFun.SetFileCreateModifyTime(FName:string;CreateTime,ModifyTime:TDateTime):boolean;
var
Wnd:HFILE;
fStruct:_OFSTRUCT;
ftCreation,ftLastWrite:TFileTime;
ftCreation1,ftLastWrite1:TFileTime;
st:TSystemTime;
begin
Result:=True;
DateTimeToSystemTime(CreateTime,st);
SystemTimeToFileTime(st,ftCreation);
LocalFileTimeToFileTime(ftCreation,ftCreation1);

DateTimeToSystemTime(ModifyTime,st);
SystemTimeToFileTime(st,ftLastWrite);
LocalFileTimeToFileTime(ftLastWrite,ftLastWrite1);

Wnd:=OpenFile(PChar(FName),fStruct,OF_READWRITE);
SetFileTime(Wnd,@ftCreation1,nil,@ftLastWrite1);

_lclose(Wnd);
end;

class function TFun.GetOnlyID:string;
var
S,S1,S2,S3:string;
m,n:Int64;
i:integer;
begin
try S1:=GetCpuID;except end;
try S2:=GetHDDID;except end;//'dfse3fds'
if S1='' then S1:='2397985356295141';
if S2='' then S2:='1415926535897932';

if Length(S1)>16 then S1:=Copy(S1,1,16);
if Length(S2)>16 then S2:=Copy(S2,1,16);

if TryStrToInt64(S1,m)=False then
begin
    S3:='';
    for i:=1 to Length(S1) do
    begin
      S3:=S3+IntToStr(Ord(S1[i]));
    end;
    if Length(S3)>16 then S3:=Copy(S3,1,16);
    m:=StrToInt64(S3);
end;

if TryStrToInt64(S2,n)=False then
begin
    S3:='';
    for i:=1 to Length(S2) do
    begin
      S3:=S3+IntToStr(Ord(S2[i]));
    end;
    if Length(S3)>16 then S3:=Copy(S3,1,16);
    n:=StrToInt64(S3);
end;
S:=IntToStr(m+n);

if Length(S)>16 then S:=Copy(S,1,16);
if Length(s)<16 then for i:=0 to 16-Length(s) do S:=S+'0';
Result:=S;
Result:=Copy(S,1,4)+'-'+Copy(S,5,4)+'-'+Copy(S,9,4)+'-'+Copy(S,13,4);
end;

class function TFun.GetHDDID:string;
type
TSrbIoControl=packed record
    HeaderLength:ULONG;
    Signature:array[0..7] of Char;
    Timeout:ULONG;
    ControlCode:ULONG;
    ReturnCode:ULONG;
    Length:ULONG;
end;
SRB_IO_CONTROL=TSrbIoControl;
PSrbIoControl=^TSrbIoControl;
TIDERegs=packed record
    bFeaturesReg:Byte;// Used for specifying SMART "commands".
    bSectorCountReg:Byte;// IDE sector count register
    bSectorNumberReg:Byte;// IDE sector number register
    bCylLowReg:Byte;// IDE low order cylinder value
    bCylHighReg:Byte;// IDE high order cylinder value
    bDriveHeadReg:Byte;// IDE drive/head register
    bCommandReg:Byte;// Actual IDE command.
    bReserved:Byte;// reserved. Must be zero.
end;
IDEREGS=TIDERegs;
PIDERegs=^TIDERegs;
TSendCmdInParams=packed record
    cBufferSize:DWORD;
    irDriveRegs:TIDERegs;
    bDriveNumber:Byte;
    bReserved:array[0..2] of Byte;
    dwReserved:array[0..3] of DWORD;
    bBuffer:array[0..0] of Byte;
end;
SENDCMDINPARAMS=TSendCmdInParams;
PSendCmdInParams=^TSendCmdInParams;
TIdSector=packed record
    wGenConfig:Word;
    wNumCyls:Word;
    wReserved:Word;
    wNumHeads:Word;
    wBytesPerTrack:Word;
    wBytesPerSector:Word;
    wSectorsPerTrack:Word;
    wVendorUnique:array[0..2] of Word;
    sSerialNumber:array[0..19] of Char;
    wBufferType:Word;
    wBufferSize:Word;
    wECCSize:Word;
    sFirmwareRev:array[0..7] of Char;
    sModelNumber:array[0..39] of Char;
    wMoreVendorUnique:Word;
    wDoubleWordIO:Word;
    wCapabilities:Word;
    wReserved1:Word;
    wPIOTiming:Word;
    wDMATiming:Word;
    wBS:Word;
    wNumCurrentCyls:Word;
    wNumCurrentHeads:Word;
    wNumCurrentSectorsPerTrack:Word;
    ulCurrentSectorCapacity:ULONG;
    wMultSectorStuff:Word;
    ulTotalAddressableSectors:ULONG;
    wSingleWordDMA:Word;
    wMultiWordDMA:Word;
    bReserved:array[0..127] of Byte;
end;
PIdSector=^TIdSector;
const
IDE_ID_FUNCTION=$EC;
IDENTIFY_BUFFER_SIZE=512;
DFP_RECEIVE_DRIVE_DATA=$0007C088;
IOCTL_SCSI_MINIPORT=$0004D008;
IOCTL_SCSI_MINIPORT_IDENTIFY=$001B0501;
DataSize=sizeof(TSendCmdInParams)-1+IDENTIFY_BUFFER_SIZE;
BufferSize=SizeOf(SRB_IO_CONTROL)+DataSize;
W9xBufferSize=IDENTIFY_BUFFER_SIZE+16;
var
hDevice:THandle;
cbBytesReturned:DWORD;
pInData:PSendCmdInParams;
pOutData:Pointer;// PSendCmdOutParams
Buffer:array[0..BufferSize-1] of Byte;
srbControl:TSrbIoControl absolute Buffer;

procedure ChangeByteOrder(var Data;Size:Integer);
var
    ptr:PChar;
    i:Integer;
    c:Char;
begin
    ptr:=@Data;
    for i:=0 to(Size shr 1)-1 do
    begin
      c:=ptr^;
      ptr^:=(ptr+1)^;
      (ptr+1)^:=c;
      Inc(ptr,2);
    end;
end;

begin
Result:='';
FillChar(Buffer,BufferSize,#0);
if Win32Platform=VER_PLATFORM_WIN32_NT then
begin// Windows NT, Windows 2000
    // Get SCSI port handle
    hDevice:=CreateFile('//./Scsi0:',
      GENERIC_READ or GENERIC_WRITE,
      FILE_SHARE_READ or FILE_SHARE_WRITE,
      nil,OPEN_EXISTING,0,0);
    if hDevice=INVALID_HANDLE_VALUE then Exit;
    try
      srbControl.HeaderLength:=SizeOf(SRB_IO_CONTROL);
      System.Move('SCSIDISK',srbControl.Signature,8);
      srbControl.Timeout:=2;
      srbControl.Length:=DataSize;
      srbControl.ControlCode:=IOCTL_SCSI_MINIPORT_IDENTIFY;
      pInData:=PSendCmdInParams(PChar(@Buffer)
        +SizeOf(SRB_IO_CONTROL));
      pOutData:=pInData;
      with pInData^ do
      begin
        cBufferSize:=IDENTIFY_BUFFER_SIZE;
        bDriveNumber:=0;
        with irDriveRegs do
        begin
          bFeaturesReg:=0;
          bSectorCountReg:=1;
          bSectorNumberReg:=1;
          bCylLowReg:=0;
          bCylHighReg:=0;
          bDriveHeadReg:=$A0;
          bCommandReg:=IDE_ID_FUNCTION;
        end;
      end;
      if not DeviceIoControl(hDevice,IOCTL_SCSI_MINIPORT,
        @Buffer,BufferSize,@Buffer,BufferSize,
        cbBytesReturned,nil) then Exit;
    finally
      CloseHandle(hDevice);
    end;
end else
begin// Windows 95 OSR2, Windows 98
    hDevice:=CreateFile('//./SMARTVSD',0,0,nil,
      CREATE_NEW,0,0);
    if hDevice=INVALID_HANDLE_VALUE then Exit;
    try
      pInData:=PSendCmdInParams(@Buffer);
      pOutData:=@pInData^.bBuffer;
      with pInData^ do
      begin
        cBufferSize:=IDENTIFY_BUFFER_SIZE;
        bDriveNumber:=0;
        with irDriveRegs do
        begin
          bFeaturesReg:=0;
          bSectorCountReg:=1;
          bSectorNumberReg:=1;
          bCylLowReg:=0;
          bCylHighReg:=0;
          bDriveHeadReg:=$A0;
          bCommandReg:=IDE_ID_FUNCTION;
        end;
      end;
      if not DeviceIoControl(hDevice,DFP_RECEIVE_DRIVE_DATA,
        pInData,SizeOf(TSendCmdInParams)-1,pOutData,
        W9xBufferSize,cbBytesReturned,nil) then Exit;
    finally
      CloseHandle(hDevice);
    end;
end;
with PIdSector(PChar(pOutData)+16)^ do
begin
    ChangeByteOrder(sSerialNumber,SizeOf(sSerialNumber));
    SetString(Result,sSerialNumber,SizeOf(sSerialNumber));
end;
Result:=Trim(Result);
end;

class function TFun.GetWindowsType:string;
var
Info:OSVERSIONINFO;
Ver:Currency;
begin
Info.dwOSVersionInfoSize:=sizeof(OSVERSIONINFO);
GetVersionEx(Info);
Ver:=StrToFloat(IntToStr(Info.dwMajorVersion)+'.'+IntToStr(Info.dwMinorVersion));
Result:='Other';
if Ver=4.0 then Result:='Win95';
if Ver=4.1 then Result:='Win98';
if Ver=4.90 then Result:='WinME';
if Ver=5.0 then Result:='Win2000';
if Ver=5.1 then Result:='WinXP';
if Ver=5.2 then Result:='Win2003';
if Ver>5.2 then Result:='>2003';
end;

class function TFun.GetWindowsVersion:string;
var
Info:OSVERSIONINFO;
begin
FillChar(Info,SizeOf(Info),0);
Info.dwOSVersionInfoSize:=sizeof(OSVERSIONINFO);
GetVersionEx(Info);
{ Result:=Format('%d.%d.%d.%d', [Info.dwMajorVersion,
    Info.dwMinorVersion,
      Info.dwBuildNumber,
      Info.dwPlatformId]);}
Result:=Format('%d.%d.%d', [Info.dwMajorVersion,
    Info.dwMinorVersion,
      Info.dwBuildNumber]);
end;

class function TFun.IPToInt(IP:string):DWord;
begin
if IP<>'' then
    Result:=inet_addr(PChar(IP))
else
    Result:=0;
end;

class function TFun.IntToIP(IP:DWORD;Reverse:boolean=False):string;
type
TPkt=record
    a,b,c,d:Byte;
end;
var
Pkt:TPkt;
begin
Pkt:=TPkt(IP);
if Reverse then //相反 '111.1.168.192'
    Result:=Format('%d.%d.%d.%d', [Pkt.d,Pkt.c,Pkt.b,Pkt.a])
else //'192.168.1.111'
    Result:=Format('%d.%d.%d.%d', [Pkt.a,Pkt.b,Pkt.c,Pkt.d]);
end;

class function TFun.IsValidIP(IP:string):boolean;
type
TPkt=record
    a,b,c,d:Integer;
end;
var
StrLst:TStringList;
Pkt:TPkt;
begin
Result:=False;
StrLst:=TStringList.Create;
try
    StrLst.Delimiter:='.';
    StrLst.DelimitedText:=IP;
    if StrLst.Count<4 then exit;
    if StrLst.Count>4 then exit;
    Pkt.a:=StrToIntDef(StrLst.Strings[0],256);//256为无效的IP
    Pkt.b:=StrToIntDef(StrLst.Strings[1],256);//256为无效的IP
    Pkt.c:=StrToIntDef(StrLst.Strings[2],256);//256为无效的IP
    Pkt.d:=StrToIntDef(StrLst.Strings[3],256);//256为无效的IP
    if (Pkt.a<=255)and(Pkt.a>=0)
      and(Pkt.b<=255)and(Pkt.a>=0)
      and(Pkt.c<=255)and(Pkt.a>=0)
      and(Pkt.d<=255)and(Pkt.a>=0) then
    begin
      Result:=True;
    end;
finally
    StrLst.Free;
end;
end;

class procedure TFun.DecodeIP(ip:string;var n1,n2,n3,n4:Byte);
var
n:DWORD;
begin
if ip<>'' then
begin
    try
      n:=ntohl(inet_addr(pchar(ip)));
    except n:=0 end;
    n1:=(n shr 24)and $FF;
    n2:=(n shr 16)and $FF;
    n3:=(n shr 08)and $FF;
    n4:=(n shr 00)and $FF;
end else
begin
    n1:=$FF;
    n2:=$FF;
    n3:=$FF;
    n4:=$FF;
end;
end;

class function TFun.GetLocalAllIP:string;
type
TAddrList=array[0..20] of PInAddr;
PAddrList=^TAddrList;
var
WSAData:TWSAData;
phent:PHostEnt;
P:PAddrList;
I:Integer;
Host:array[0..128] of char;
begin
WSAStartup(MAKEWORD(2,0),wsaData);
GetHostName(@Host,128);
phent:=GetHostByName(Host);
if phent<>nil then
begin
    I:=0;
    P:=PAddrList(phent^.h_Addr_list);
    while P[I]<>nil do
    begin
      Result:=Result+StrPas(inet_ntoa(P[I]^))+Enter;
      Inc(I);
    end;
end;
WSACleanUP;
if Result<>'' then Result:=LeftStr(Result,Length(Result)-2);
end;

class function TFun.Encrypt(S:string):string;
var
i,Key:integer;
Str:string;
begin
key:=12345;
for I:=1 to Length(S) do
    Str:=Str+char(byte(S[I])xor(Key shr 8));
Result:=Str;
end;

class function TFun.SetSystemTime(DT:TDateTime):boolean;
//设置计算机日期时间
var
ADateTime:TSystemTime;
yy,mon,dd,hh,min,ss,ms:Word;
begin
decodedate(DT,yy,mon,dd);
decodetime(DT,hh,min,ss,ms);
with ADateTime do
begin
    wYear:=yy;
    wMonth:=mon;
    wDay:=dd;
    wHour:=hh;
    wMinute:=min;
    wSecond:=ss;
    wMilliseconds:=ms;
end;
Result:=SetLocalTime(ADateTime);
PostMessage(HWND_BROADCAST,WM_TIMECHANGE,0,0);
end;

class function TFun.DynamicResolution(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;

class function TFun.CopyDirectory(Source,Target:PChar):boolean;//复制COPY目录
var
OpStruc:TSHFileOpStruct;
FromBuf,ToBuf:array[0..128] of Char;
begin
Result:=False;
FillChar(FromBuf,Sizeof(FromBuf),0);
FillChar(ToBuf,Sizeof(ToBuf),0);
StrPCopy(FromBuf,Source);
StrPCopy(ToBuf,Target);
with OpStruc do
begin
    wFunc:=FO_COPY;
    pFrom:=@FromBuf;
    pTo:=@ToBuf;
    fFlags:=FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION;
    fAnyOperationsAborted:=False;
    hNameMappings:=nil;
    lpszProgressTitle:=nil;
end;
if ShFileOperation(OpStruc)=0 then Result:=True;
end;

class function TFun.GetIPByHost(aHost:string):string;
var
wsdata:TWSAData;
hostName:array[0..255] of char;
hostEnt:PHostEnt;
addr:PChar;
begin
Result:='';
WSAStartup($0101,wsdata);
try
    FillChar(hostName,SizeOf(hostName),0);
    StrPCopy(hostName,aHost);
    hostEnt:=gethostbyname(hostName);
    if hostEnt=nil then exit;
    if hostEnt^.h_addr_list=nil then exit;
    addr:=hostEnt^.h_addr_list^;
    if addr=nil then exit;
    Result:=Format('%d.%d.%d.%d', [byte(addr[0]),byte(addr[1]),byte(addr[2]),byte(addr[3])]);
finally
    WSACleanup;
end
end;

class function TFun.GetHostByIP(AIP:string):string;//得到IP地址的主机名
var
pH:PHostent;
data:twsadata;
ii:dword;//即ii 为LongWord类型
begin
Result:='';
WSAStartup($101,Data);
try
    ii:=inet_addr(pchar(AIP));// 返回一个适合Internet的数字化地址
    pH:=gethostbyaddr(@ii,sizeof(ii),PF_INET);//返回一个指向主机信息结构的指针
    if pH<>nil then Result:=pH.h_name//返回该结构的主机名
finally
    WSACleanup;
end;
end;

class function TFun.GetNetBIOSAddress:string;
var ncb:TNCB;
status:TAdapterStatus;
lanenum:TLanaEnum;
procedure ResetAdapter(num:char);
begin
    fillchar(ncb,sizeof(ncb),0);
    ncb.ncb_command:=char(NCBRESET);
    ncb.ncb_lana_num:=num;
    Netbios(@ncb);
end;
var
lanNum:char;
address:record
    part1:Longint;
    part2:Word;//Smallint;
end absolute status;
begin
Result:='';
fillchar(ncb,sizeof(ncb),0);
ncb.ncb_command:=char(NCBENUM);
ncb.ncb_buffer:=@lanenum;
ncb.ncb_length:=sizeof(lanenum);
Netbios(@ncb);
if lanenum.length=#0 then exit;
lanNum:=lanenum.lana[0];
ResetAdapter(lanNum);
fillchar(ncb,sizeof(ncb),0);
ncb.ncb_command:=char(NCBASTAT);
ncb.ncb_lana_num:=lanNum;
ncb.ncb_callname[0]:='*';
ncb.ncb_buffer:=@status;
ncb.ncb_length:=sizeof(status);
Netbios(@ncb);
ResetAdapter(lanNum);
Result:=Format('%x%x', [address.part1,address.part2]);
end;

class function TFun.InstallOcx(aFileName:string;bSetup:boolean):boolean;
//注册、注销 DLL、OCX bSetup为TRUE 注册 bSetup为FALSE注销
var
hOcx:THandle;
funcRegister:TDllRegisterServer;
funcUnRegister:TDllUnRegisterServer;
begin
Result:=False;
if not FileExists(aFileName) then exit;
hOcx:=LoadLibrary(pchar(aFileName));
try
    if hOcx<32 then exit;
    if bSetup then
    begin//注册
      funcRegister:=GetProcAddress(hOcx,'DllRegisterServer');
      if @funcRegister=nil then exit;
      Result:=(funcRegister=S_OK);
    end
    else begin//注销
      funcUnRegister:=GetProcAddress(hOcx,'DllUnregisterServer');
      if @funcUnRegister=nil then exit;
      Result:=(funcUnRegister=S_OK);
    end;
finally
    FreeLibrary(hOcx);
end;
end;

class function TFun.GetComputerName: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;

class function TFun.GetWindowsUserName:string;
var
lpName:PAnsiChar;
lpUserName:PAnsiChar;
lpnLength:DWORD;
begin
Result:='';
lpName:=nil;
lpnLength:=0;
WNetGetUser(nil,nil,lpnLength);// 取得字串长度
if lpnLength>0 then
begin
    GetMem(lpUserName,lpnLength);
    if WNetGetUser(lpName,lpUserName,lpnLength)=NO_ERROR then Result:=lpUserName;
    FreeMem(lpUserName,lpnLength);
end;
end;

class procedure TFun.CloseComputer;//关闭计算机支持WIN98 WIN2000 WINXP
procedure ExitWindowsNT(uFlags:Integer);//Win2000 WINXP关机过程
var
    hToken:THandle;
    tkp,tkDumb:TTokenPrivileges;
    DumbInt:DWORD;
begin
    FillChar(tkp,sizeof(tkp),0);
    if not(OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,hToken)) then
      Exit;
    LookupPrivilegeValue(nil,'SeShutdownPrivilege',tkp.Privileges[0].Luid);
    tkp.PrivilegeCount:=1;
    tkp.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED;

    AdjustTokenPrivileges(hToken,False,tkp,sizeof(tkDumb),tkDumb,DumbInt);
    if GetLastError<>ERROR_SUCCESS then Exit;
    if not ExitWindowsEx(uFlags,0) then Exit;
end;
function WindowsVer:string;//获得WINDOWS版本
var
    pOSVI:OSVERSIONINFO;
    Str:string;
begin
    pOSVI.dwOSVersionInfoSize:=sizeof(OSVERSIONINFO);
    GetVersionEx(pOSVI);
    if StrToFloat(IntToStr(pOSVI.dwMajorVersion)+'.'+IntToStr(pOSVI.dwMinorVersion))=4.1 then
      Str:='Win98';
    if StrToFloat(IntToStr(pOSVI.dwMajorVersion)+'.'+IntToStr(pOSVI.dwMinorVersion))=5.0 then
      Str:='Win2000';
    if StrToFloat(IntToStr(pOSVI.dwMajorVersion)+'.'+IntToStr(pOSVI.dwMinorVersion))>=5.1 then
      Str:='WinXP';
    Result:=Str;
end;
begin
if WindowsVer='Win98' then
begin
    ExitWindowsEx(EWX_SHUTDOWN,0)//不能是EWX_POWEROFF
end
else begin
    ExitWindowsNT(EWX_POWEROFF);
end;
end;

class procedure TFun.ReBootComputer;
procedure ExitWindowsNT(uFlags:Integer);//Win2000 WINXP关机过程
var
    hToken:THandle;
    tkp,tkDumb:TTokenPrivileges;
    DumbInt:DWORD;
begin
    FillChar(tkp,sizeof(tkp),0);
    if not(OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,hToken)) then
      Exit;
    LookupPrivilegeValue(nil,'SeShutdownPrivilege',tkp.Privileges[0].Luid);
    tkp.PrivilegeCount:=1;
    tkp.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED;

    AdjustTokenPrivileges(hToken,False,tkp,sizeof(tkDumb),tkDumb,DumbInt);
    if GetLastError<>ERROR_SUCCESS then Exit;
    if not ExitWindowsEx(uFlags,0) then Exit;
end;
function WindowsVer:string;//获得WINDOWS版本
var
    pOSVI:OSVERSIONINFO;
    Str:string;
begin
    pOSVI.dwOSVersionInfoSize:=sizeof(OSVERSIONINFO);
    GetVersionEx(pOSVI);
    if StrToFloat(IntToStr(pOSVI.dwMajorVersion)+'.'+IntToStr(pOSVI.dwMinorVersion))=4.1 then
      Str:='Win98';
    if StrToFloat(IntToStr(pOSVI.dwMajorVersion)+'.'+IntToStr(pOSVI.dwMinorVersion))=5.0 then
      Str:='Win2000';
    if StrToFloat(IntToStr(pOSVI.dwMajorVersion)+'.'+IntToStr(pOSVI.dwMinorVersion))>=5.1 then
      Str:='WinXP';
    Result:=Str;
end;
begin
if WindowsVer='Win98' then
begin
    ExitWindowsEx(EWX_REBOOT,0)//不能是EWX_POWEROFF
end else
begin
    ExitWindowsNT(EWX_REBOOT);
end;
end;

class function TFun.AddToStartUpRun(Key,Value:string;MACHINE0_USER1:integer=1):boolean;
//把程序放到注册表的启动组里,
//key:名称 value:程序名,
//MACHINE_True_USER_False:true HKEY_LOCAL_MACHINE False HKEY_CURRENT_USER}
var Reg:TRegistry;
begin
Reg:=TRegistry.Create;
if MACHINE0_USER1=0 then
    Reg.RootKey:=HKEY_LOCAL_MACHINE
else
    Reg.RootKey:=HKEY_CURRENT_USER;

Reg.OpenKey('/SOFTWARE/Microsoft/Windows/CurrentVersion/Run',False);
Reg.WriteString(Key,Value);
Reg.Free;
Result:=True;
end;

class function TFun.Decrypt(S:string):string;
begin
Result:=Encrypt(s);
end;

class function TFun.BinToInt(s:string):integer;
var
v:Real;
len,n,i:integer;
begin
v:=0;
len:=Length(s);
for i:=len downto 1 do
begin
    if s[i]='1' then n:=1 else n:=0;
    v:=v+Exp(ln(2)*(len-i))*n;
end;
Result:=Trunc(v);
end;

class function TFun.HexToBin(AStr:string):string;
const
BCD:array[0..15] of string=(
    '0000','0001','0010','0011',
    '0100','0101','0110','0111',
    '1000','1001','1010','1011',
    '1100','1101','1110','1111'
    );
var
i:integer;
begin
for i:=Length(AStr)downto 1 do
    Result:=BCD[StrToInt('$'+AStr[i])]+Result;
end;

class function TFun.Max(a,b:integer):integer;//=== 求最大值
begin
if a<b then Result:=b else Result:=a;
end;

class function TFun.Min(a,b:integer):integer;//=== 求最小值
begin
if a>b then Result:=b else Result:=a;
end;

class function TFun.IntToBin(TheVal:Integer;const Count:integer):string;
var
counter:LongWord;
begin
if TheVal=0 then
begin
    Result:='0';
    exit;
end;
Result:='';
counter:=$80000000;
while ((counter and TheVal)=0) do
begin
    counter:=counter shr 1;
    if (counter=0) then break;
end;

while counter>0 do
begin
    if (counter and TheVal)=0 then
      Result:=Result+'0'
    else
      Result:=Result+'1';
    counter:=counter shr 1;
end;
Result:=StringOfChar('0',Count-Length(Result))+Result;
end;

class procedure TFun.RunFile(FileName:string;Param:string='');//运行一个文件
var
Path:string;
begin
if FileName<>'' then
begin
    Path:=ExtractFilePath(FileName);
    ShellExecute(0,nil,PChar(FileName),PChar(Param),PChar(Path),SW_SHOWNORMAL);
end;
end;

class function TFun.RunFileWait(FileName:string;Visibility:Integer):Integer;
var
zAppName:array[0..512] of Char;
zCurDir:array[0..255] of Char;
WorkDir:string;
StartupInfo:TStartupInfo;
ProcessInfo:TProcessInformation;
begin
StrPCopy(zAppName,FileName);
GetDir(0,WorkDir);
StrPCopy(zCurDir,WorkDir);
FillChar(StartupInfo,SizeOf(StartupInfo),#0);
StartupInfo.cb:=SizeOf(StartupInfo);

StartupInfo.dwFlags:=STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow:=Visibility;
if not CreateProcess(nil,
    zAppName,{ pointer to command line string }
    nil,{ pointer to process security attributes }
    nil,{ pointer to thread security attributes }
    False,{ handle inheritance flag }
    CREATE_NEW_CONSOLE or{ creation flags }
    NORMAL_PRIORITY_CLASS,
    nil,{ pointer to new environment block }
    nil,{ pointer to current directory name }
    StartupInfo,{ pointer to STARTUPINFO }
    ProcessInfo) then
    Result:=-1{ pointer to PROCESS_INF }

else
begin
    WaitforSingleObject(ProcessInfo.hProcess,INFINITE);
    GetExitCodeProcess(ProcessInfo.hProcess,Cardinal(Result));
end;
end;

class function TFun.GetFileSize(FileName:string):UINT;
var
FileVar:file of Byte;
begin
{$I-}
try
    AssignFile(FileVar,FileName);
    Reset(FileVar);
    Result:=FileSize(FileVar);
    CloseFile(FileVar);
except
    Result:=0;
end;
{$I+}
end;

class function TFun.Deltree(Dir:string):Boolean;
function AddDirSuffix(Dir:string):string;
begin
    Result:=Trim(Dir);
    if Result='' then Exit;
    if Result[Length(Result)]<>'/' then Result:=Result+'/';
end;
var
sr:TSearchRec;
fr:Integer;
begin
if not DirectoryExists(Dir) then
begin
    Result:=True;
    Exit;
end;
fr:=FindFirst(AddDirSuffix(Dir)+'*.*',faAnyFile,sr);
try
    while fr=0 do
    begin
      if (sr.Name<>'.')and(sr.Name<>'..') then
      begin
        if sr.Attr and faDirectory=faDirectory then
          Result:=Deltree(AddDirSuffix(Dir)+sr.Name)
        else
          Result:=DeleteFile(AddDirSuffix(Dir)+sr.Name);
        if not Result then
          Exit;
      end;
      fr:=FindNext(sr);
    end;
finally
    FindClose(sr);
end;
Result:=RemoveDir(Dir);
end;

class function TFun.GetMemorySize:Dword;
var
memStatus:TMemoryStatus;
begin
memStatus.dwLength:=sizeOf(memStatus);
GlobalMemoryStatus(memStatus);
Result:=memStatus.dwTotalPhys div 1024;
end;

class function TFun.HexToStr(AStr:string):string;
var
I:Integer;
begin
Result:='';
for I:=1 to Length(AStr) do
begin
    Result:=Result+Format('%2x', [Byte(AStr[I])]);
end;
I:=Pos(' ',Result);
while I<>0 do
begin
    Result[I]:='0';
    I:=Pos(' ',Result);
end;
end;

class function TFun.StrToHex(AStr:string):string;
function TransChar(AChar:Char):Integer;
begin
    if AChar in ['0'..'9'] then
      Result:=Ord(AChar)-Ord('0')
    else
      Result:=10+Ord(AChar)-Ord('A');
end;
var
I:Integer;
CharValue:Word;
begin
Result:='';
for I:=1 to Trunc(Length(Astr)/2) do
begin
    Result:=Result+' ';
    CharValue:=TransChar(AStr[2*I-1])*16+TransChar(AStr[2*I]);
    Result[I]:=Char(CharValue);
end;
end;

class function TFun.HexToInt(Str:string):Int;
var
S:string;
begin
S:=Str;
if LeftStr(S,1)<>'$' then
    S:='$'+S;
Result:=StrToIntDef(S,0);
end;

class function TFun.IntToHex(Value:Int;Digits:Int=8):string;
begin
FmtStr(Result,'%.*x', [Digits,Value]);
end;

class function TFun.DownloadFile(Source,Dest:string):Boolean;
begin
try
    Result:=UrlDownloadToFile(nil,PChar(source),PChar(Dest),0,nil)=0;
except
    Result:=False;
end;
end;

class function TFun.GetBroadCastIP(IP:string):string;
var
S,S1,S2,S3,S4:string;
begin
S:=IP;
S1:=Copy(S,1,Pos('.',S)-1);
Delete(S,1,Pos('.',S));
S2:=Copy(S,1,Pos('.',S)-1);
Delete(S,1,Pos('.',S));
S3:=Copy(S,1,Pos('.',S)-1);
Delete(S,1,Pos('.',S));
S4:=S;
S:=S1+'.'+s2+'.'+S3+'.255';
Result:=S;
end;

class function TFun.IsBroadCaseIP(IP:string):boolean;
var S:string;
begin
S:=IP;
Delete(S,1,Pos('.',S));
Delete(S,1,Pos('.',S));
Delete(S,1,Pos('.',S));
Result:=(S='255');
end;

class procedure TFun.ScreenToJpg(LeftPos,TopPos,RightPos,BottomPos:integer;FileName:string);
var
RectWidth,RectHeight:integer;
SourceDC,DestDC,Bhandle:integer;
Bmp:TBitmap;
Jpg:TJpegImage;
begin
RectWidth:=RightPos-LeftPos;
RectHeight:=BottomPos-TopPos;
SourceDC:=CreateDC('DISPLAY','','',nil);
DestDC:=CreateCompatibleDC(SourceDC);
Bhandle:=CreateCompatibleBitmap(SourceDC,RectWidth,RectHeight);
Bmp:=TBitmap.Create;
Jpg:=TJpegImage.Create;
try
    SelectObject(DestDC,Bhandle);
    BitBlt(DestDC,0,0,RectWidth,RectHeight,SourceDC,LeftPos,TopPos,SRCCOPY);
    Bmp.Handle:=BHandle;
    Bmp.SaveToFile('c:/temp.bmp');
    bmp.LoadFromFile('c:/temp.bmp');
    DeleteFile('c:/temp.bmp');
    Jpg.Assign(bmp);
    Jpg.CompressionQuality:=80;
    Jpg.Compress;
    Jpg.SaveToFile(FileName);
finally
    Bmp.Free;
    Jpg.Free;
    DeleteDC(DestDC);
    ReleaseDC(Bhandle,SourceDC);
end;
end;

class function TFun.PrintJpgTime(JpgFile:string;dt:TDateTime;x:integer=3;y:integer=3):boolean;
var
bmp:TBitMap;
Jpg:TJpegImage;
Str,BmpFile:string;
begin
Str:=FormatDateTime('yyyy-mm-dd hh:mm:ss',dt);
BmpFile:=ChangeFileExt(JpgFile,'.bmp');
bmp:=TBitMap.Create;
Jpg:=TJpegImage.Create;
try
    Jpg.LoadFromFile(JpgFile);
    bmp.Assign(Jpg);
    bmp.Canvas.Brush.Style:=bsClear;
    bmp.Canvas.Font.Name:='System';
    bmp.Canvas.Font.Size:=12;
    bmp.Canvas.Font.Color:=clBlack;
    bmp.Canvas.TextOut(x+1,y+1,Str);
    bmp.Canvas.Font.Color:=clWhite;
    bmp.Canvas.TextOut(x,y,Str);
    Jpg.Assign(bmp);
    Jpg.SaveToFile(JpgFile);
finally
    bmp.Free;
    Jpg.Free;
end;
Result:=True;
end;

class function TFun.PrintJpgString(JpgFile,Str:string;x,
y:integer):boolean;
var
bmp:TBitMap;
Jpg:TJpegImage;
BmpFile:string;
begin
BmpFile:=ChangeFileExt(JpgFile,'.bmp');
bmp:=TBitMap.Create;
Jpg:=TJpegImage.Create;
try
    Jpg.LoadFromFile(JpgFile);
    bmp.Assign(Jpg);
    bmp.Canvas.Brush.Style:=bsClear;
    bmp.Canvas.Font.Name:='System';
    bmp.Canvas.Font.Size:=12;
    bmp.Canvas.Font.Color:=clBlack;
    bmp.Canvas.TextOut(x+1,y+1,Str);
    bmp.Canvas.Font.Color:=clWhite;
    bmp.Canvas.TextOut(x,y,Str);
    Jpg.Assign(bmp);
    Jpg.SaveToFile(JpgFile);
finally
    bmp.Free;
    Jpg.Free;
end;
Result:=True;
end;

class function TFun.PrintBmpTime(BmpFile:string;dt:TDateTime;x:integer=3;y:integer=3):boolean;
var
bmp:TBitMap;
Str:string;
begin
Str:=FormatDateTime('yyyy-mm-dd hh:mm:ss',dt);
bmp:=TBitMap.Create;
try
    bmp.LoadFromFile(BmpFile);
    bmp.Canvas.Brush.Style:=bsClear;
    bmp.Canvas.Font.Name:='System';
    bmp.Canvas.Font.Size:=12;
    bmp.Canvas.Font.Color:=clBlack;
    bmp.Canvas.TextOut(x+1,y+1,Str);
    bmp.Canvas.Font.Color:=clWhite;
    bmp.Canvas.TextOut(x,y,Str);
    bmp.SaveToFile(BmpFile);
finally
    bmp.Free;
end;
Result:=True;
end;

class function TFun.BmpToJpg(BmpFile,JpgFile:string):boolean;
var
bmp:TBitMap;
Jpg:TJpegImage;
begin
bmp:=TBitMap.Create;
Jpg:=TJpegImage.Create;
try
    Bmp.LoadFromFile(BmpFile);
    Jpg.Assign(bmp);
    Jpg.SaveToFile(JpgFile);
finally
    bmp.Free;
    Jpg.Free;
    Result:=True;
end;
end;

class function TFun.JpgToBmp(JpgFile,BmpFile:string):boolean;
var
Jpg:TJpegImage;
Bmp:TBitMap;
begin
Jpg:=TJpegImage.Create;
bmp:=TBitMap.Create;
try
    Jpg.LoadFromFile(JpgFile);
    Bmp.Assign(Jpg);
    Bmp.SaveToFile(BmpFile);
finally
    Jpg.Free;
    Bmp.Free;
    Result:=True;
end;
end;

class function TFun.Ping(IP:string):Boolean;
const
IcmpVersion=102;
IcmpDLL='icmp.dll';
type
TIcmpCreateFile=function:THandle;stdcall;
TIcmpCloseHandle=function(IcmpHandle:THandle):Boolean;stdcall;
TIcmpSendEcho=function(IcmpHandle:THandle;
    DestinationAddress:DWORD;
    RequestData:Pointer;
    RequestSize:Word;
    RequestOptions:Pointer;
    ReplyBuffer:Pointer;
    ReplySize:DWord;
    Timeout:DWord
    ):DWord;stdcall;
var
hICMPdll:HModule;// Handle for ICMP.DLL
hICMP:THandle;
IcmpCreateFile:TIcmpCreateFile;
IcmpCloseHandle:TIcmpCloseHandle;
IcmpSendEcho:TIcmpSendEcho;
wsa:TWSAData;
rep:array[1..128] of byte;
InAddr2:DWORD;//InAddr1: TInAddr;
phe:PHostEnt;// HostEntry buffer for name lookup
pac:PChar;
dwRet:DWORD;
bValidIP:Boolean;
begin
Result:=False;
try
    if WSAStartup($101,wsa)<>0 then exit;
    bValidIP:=False;
    InAddr2:=0;
    phe:=GetHostByName(PChar(IP));
    if Assigned(phe) then
    begin
      pac:=phe^.h_addr_list^;
      if Assigned(pac) then
      begin
        InAddr2:=LongInt(PLongInt(phe^.h_addr_list^)^);
        bValidIP:=True;
      end;
    end;
    if bValidIP then
    begin
      hICMPdll:=LoadLibrary(icmpDLL);
      if hICMPdll>0 then
      begin
        @ICMPCreateFile:=GetProcAddress(hICMPdll,'IcmpCreateFile');
        @IcmpCloseHandle:=GetProcAddress(hICMPdll,'IcmpCloseHandle');
        @IcmpSendEcho:=GetProcAddress(hICMPdll,'IcmpSendEcho');
        if (@ICMPCreateFile<>nil)and(@IcmpCloseHandle<>nil)and(@IcmpSendEcho<>nil) then
        begin
          hICMP:=IcmpCreateFile;
          if hICMP<>INVALID_HANDLE_VALUE then
          begin
            dwRet:=IcmpSendEcho(hICMP,InAddr2,nil,0,nil,@rep,128,0);
            Result:=(dwRet<>0);
//            if hICMP<>INVALID_HANDLE_VALUE then
            IcmpCloseHandle(hICMP);
          end;
         // if hICMPdll<>0 then
          FreeLibrary(hICMPdll);
        end;
      end;
    end;
finally
    WSACleanup;
end;
end;

class function TFun.WaitNetActive(WaitTime:integer=5000):boolean;
var
m:Integer;
begin
m:=0;
Result:=True;
while TFun.GetLocalIP='127.0.0.1' do
begin
    Application.ProcessMessages;
    Sleep(1);
    if m>WaitTime then
    begin
      Result:=False;
      Break;
    end;
    Inc(m);
end;
end;

class function TFun.Ping(IP:string;TimeOut:integer):boolean;
const
IcmpVersion=102;
IcmpDLL='icmp.dll';
type
TIcmpCreateFile=function:THandle;stdcall;
TIcmpCloseHandle=function(IcmpHandle:THandle):Boolean;stdcall;
TIcmpSendEcho=function(IcmpHandle:THandle;
    DestinationAddress:DWORD;
    RequestData:Pointer;
    RequestSize:Word;
    RequestOptions:Pointer;
    ReplyBuffer:Pointer;
    ReplySize:DWord;
    Timeout:DWord
    ):DWord;stdcall;
var
hICMPdll:HModule;// Handle for ICMP.DLL
hICMP:THandle;
IcmpCreateFile:TIcmpCreateFile;
IcmpCloseHandle:TIcmpCloseHandle;
IcmpSendEcho:TIcmpSendEcho;
wsa:TWSAData;
rep:array[1..128] of byte;
InAddr2:DWORD;//InAddr1: TInAddr;
phe:PHostEnt;// HostEntry buffer for name lookup
pac:PChar;
dwRet:DWORD;
bValidIP:Boolean;
begin
Result:=False;
try
    if WSAStartup($101,wsa)<>0 then exit;
    bValidIP:=False;
    InAddr2:=0;
    phe:=GetHostByName(PChar(IP));
    if Assigned(phe) then
    begin
      pac:=phe^.h_addr_list^;
      if Assigned(pac) then
      begin
        InAddr2:=LongInt(PLongInt(phe^.h_addr_list^)^);
        bValidIP:=True;
      end;
    end;
    if bValidIP then
    begin
      hICMPdll:=LoadLibrary(icmpDLL);
      if hICMPdll>0 then
      begin
        @ICMPCreateFile:=GetProcAddress(hICMPdll,'IcmpCreateFile');
        @IcmpCloseHandle:=GetProcAddress(hICMPdll,'IcmpCloseHandle');
        @IcmpSendEcho:=GetProcAddress(hICMPdll,'IcmpSendEcho');
        if (@ICMPCreateFile<>nil)and(@IcmpCloseHandle<>nil)and(@IcmpSendEcho<>nil) then
        begin
          hICMP:=IcmpCreateFile;
          if hICMP<>INVALID_HANDLE_VALUE then
          begin
            dwRet:=IcmpSendEcho(hICMP,InAddr2,nil,0,nil,@rep,128,TimeOut);
            Result:=(dwRet<>0);
//            if hICMP<>INVALID_HANDLE_VALUE then
            IcmpCloseHandle(hICMP);
          end;
         // if hICMPdll<>0 then
          FreeLibrary(hICMPdll);
        end;
      end;
    end;
finally
    WSACleanup;
end;
end;

{class function TFun.Ping(IP:string;TimeOut:integer):boolean;
type
PIPOptionInformation=^TIPOptionInformation;
TIPOptionInformation=packed record
    TTL:Byte;
    TOS:Byte;
    Flags:Byte;
    OptionsSize:Byte;
    OptionsData:PChar;
end;
type
PIcmpEchoReply=^TIcmpEchoReply;
TIcmpEchoReply=packed record
    Address:DWORD;
    Status:DWORD;
    RTT:DWORD;
    DataSize:Word;
    Reserved:Word;
    Data:Pointer;
    Options:TIPOptionInformation;
end;
TIcmpCreateFile=function:THandle;stdcall;
TIcmpCloseHandle=function(IcmpHandle:THandle):Boolean;stdcall;

TIcmpSendEcho=function(IcmpHandle:THandle;DestinationAddress:DWORD;
    RequestData:Pointer;RequestSize:Word;RequestOptions:PIPOptionInformation;
    ReplyBuffer:Pointer;ReplySize:DWord;Timeout:DWord):DWord;stdcall;

var
hICMPdll:HMODULE;
IPOpt:TIPOptionInformation;
FIPAddress:DWORD;
pReqData,pRevData:PChar;//
pIPE:PIcmpEchoReply;
FSize:DWORD;
SendStr:string;
BufferSize:DWORD;

hICMP:THANDLE;
IcmpCreateFile:TIcmpCreateFile;
IcmpCloseHandle:TIcmpCloseHandle;
IcmpSendEcho:TIcmpSendEcho;
begin
Result:=False;
if IP='' then Exit;
hICMPdll:=LoadLibrary('icmp.dll');
try
    @ICMPCreateFile:=GetProcAddress(hICMPdll,'IcmpCreateFile');
    @IcmpCloseHandle:=GetProcAddress(hICMPdll,'IcmpCloseHandle');
    @IcmpSendEcho:=GetProcAddress(hICMPdll,'IcmpSendEcho');
    hICMP:=IcmpCreateFile;
    FIPAddress:=inet_addr(PChar(IP));
    FSize:=40;
    BufferSize:=SizeOf(TICMPEchoReply)+FSize;
    GetMem(pRevData,FSize);
    GetMem(pIPE,BufferSize);
    try
      FillChar(pIPE^,SizeOf(pIPE^),0);
      pIPE^.Data:=pRevData;
      SendStr:='Hello,World';
      pReqData:=PChar(SendStr);
      FillChar(IPOpt,Sizeof(IPOpt),0);
      IPOpt.TTL:=64;
      IcmpSendEcho(hICMP,FIPAddress,pReqData,Length(SendStr),@IPOpt,pIPE,BufferSize,TimeOut);
      try
        if pReqData^=pIPE^.Options.OptionsData^ then Result:=True;
      except
        Result:=False;
      end;
    finally
      FreeMem(pRevData);
      FreeMem(pIPE);
    end;
finally
    FreeLibrary(hIcmpDll);
end;
end;
}

constructor TFun.Create;
begin
inherited;
end;

destructor TFun.Destroy;
begin
inherited;
end;

class procedure TFun.HideTaskMgr;
var
ExtendedStyle:Integer;
begin
ExtendedStyle:=GetWindowLong(Application.Handle,GWL_EXSTYLE);
SetWindowLong(Application.Handle,GWL_EXSTYLE,ExtendedStyle or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);
end;

class function TFun.CheckRs232(FCOM:PChar):boolean;
var Hnd:THandle;
begin
Hnd:=CreateFile(FCOM,GENERIC_READ and GENERIC_WRITE,0,nil,
    OPEN_EXISTING,FILE_FLAG_OVERLAPPED,0);

if Hnd=INVALID_HANDLE_VALUE then
    Result:=False
else
    Result:=True;
CloseHandle(Hnd);
end;

class procedure TFun.CloseWindowEx(aWnd:hWnd=0);//强制关闭程序
var
// dwThreadId:DWORD;
dwProcessId:DWORD;
hProcess:hWnd;
// DWResult:DWORD;
Wnd:HWnd;
begin
Wnd:=aWnd;
if aWnd=0 then Wnd:=Application.Handle;
if IsWindow(Wnd) then
begin
// SendMessageTimeout(Wnd,WM_CLOSE,0,0,SMTO_ABORTIFHUNG or SMTO_NORMAL,5000,DWResult);
// dwThreadId:=GetWindowThreadProcessId(Wnd,dwProcessId);
    GetWindowThreadProcessId(Wnd,dwProcessId);
    hProcess:=OpenProcess(PROCESS_TERMINATE or PROCESS_QUERY_INFORMATION,False,dwProcessId);
    if (hProcess<>0) then
    begin
      TerminateProcess(hProcess,0);//$FFFFFFFF);
      CloseHandle(hProcess);
    end;
end;
end;

//******************************************************************************

class function TFun.GBToBIG5(Str:string):string;
function UnicodeEncode(Str:string;CodePage:integer):WideString;
var
    Len:integer;
begin
    Len:=Length(Str)+1;
    SetLength(Result,Len);
    Len:=MultiByteToWideChar(CodePage,0,PChar(Str),-1,PWideChar(Result),Len);
    SetLength(Result,Len-1);//end is #0
end;
function UnicodeDecode(Str:WideString;CodePage:integer):string;
var
    Len:integer;
begin
    Len:=Length(Str)*2+1;//one for #0
    SetLength(Result,Len);
    Len:=WideCharToMultiByte(CodePage,0,PWideChar(Str),-1,PChar(Result),Len,nil,nil);
    SetLength(Result,Len-1);
end;
//******
begin
SetLength(Result,Length(Str));
LCMapString(GetUserDefaultLCID,LCMAP_TRADITIONAL_CHINESE,
    PChar(Str),Length(Str),
    PChar(Result),Length(Result));
Result:=UnicodeDecode(UnicodeEncode(Result,936),950);
end;

class function TFun.BIG5ToGB(Str:string):string;
function UnicodeEncode(Str:string;CodePage:integer):WideString;
var
    Len:integer;
begin
    Len:=Length(Str)+1;
    SetLength(Result,Len);
    Len:=MultiByteToWideChar(CodePage,0,PChar(Str),-1,PWideChar(Result),Len);
    SetLength(Result,Len-1);//end is #0
end;
function UnicodeDecode(Str:WideString;CodePage:integer):string;
var
    Len:integer;
begin
    Len:=Length(Str)*2+1;//one for #0
    SetLength(Result,Len);
    Len:=WideCharToMultiByte(CodePage,0,PWideChar(Str),-1,PChar(Result),Len,nil,nil);
    SetLength(Result,Len-1);
end;
//******
begin
Str:=UnicodeDecode(UnicodeEncode(Str,950),936);
SetLength(Result,Length(Str));
LCMapString(GetUserDefaultLCID,LCMAP_SIMPLIFIED_CHINESE,
    PChar(Str),Length(Str),
    PChar(Result),Length(Result));
end;

class function TFun.IniFileName:string;
begin
if FixIniFileName<>'' then
    Result:=FixIniFileName
else
    Result:=ChangeFileExt(Application.ExeName,'.ini');
end;

class function TFun.ProgramPath:string;
var
Reg:TRegistry;
Key:string;
begin
Key:='/SOFTWARE/Microsoft/Windows/CurrentVersion';
Reg:=TRegistry.Create;
try
    Reg.RootKey:=HKEY_LOCAL_MACHINE;
    if (Reg.OpenKey(Key,False))=False then Reg.CreateKey(Key);
    Reg.OpenKey(Key,True);
    Result:=Reg.ReadString('ProgramFilesDir')+'/';
finally
    Reg.CloseKey;
    Reg.Free;
end;
end;

class function TFun.SysPath:string;
var
SysDir:array[0..255] of char;
begin
GetSystemDirectory(SysDir,255);
Result:=SysDir;
Result:=Result+'/';
end;

class function TFun.WinPath:string;
var
SysDir:array[0..255] of char;
begin
GetWindowsDirectory(SysDir,255);
Result:=SysDir;
Result:=Result+'/';
end;

class function TFun.WorkPath:string;
begin
Result:=ExtractFilePath(ParamStr(0));
end;

class function TFun.WindowsTempPath:string;
var
TmpDir:PChar;
begin
GetMem(TmpDir,255);
GetTempPath(255,TmpDir);
Result:=(TmpDir);
if Result[Length(Result)]<>'/' then Result:=Result+'/';
FreeMem(TmpDir);
end;

class function TFun.IsDoubleScreen:boolean;//是否连接有双显示器
begin
Result:=(Screen.MonitorCount>1);
end;

class function TFun.LanguageCode:integer;
//=================================================================
//过程函数：判断操作系统语言
{"0404"="zh-tw;中文 (台湾)" "0804"="zh-cn;中文 (中国)"
"0C04"="zh-hk;中文 (香港)" "1004"="zh-sg;中文 (新加坡)"
"0409"="en-us;英语 (美国)" "0809"="en-gb;英语 (英国)"}
//=================================================================
var
pcLCA:array[0..20] of Char;
Str:string;
begin
if (GetLocaleInfo(LOCALE_SYSTEM_DEFAULT,LOCALE_ILANGUAGE,pcLCA,19)<=0) then
    pcLCA[0]:=#0;
Str:=pcLCA;
Result:=TFun.HexToInt(Str);
end;

class function TFun.Language:string;
begin
case LanguageCode of
    $0804:Result:='cn';//简体中文
    $0404:Result:='tw';//繁体中文
    $0C04:Result:='tw';//香港繁体
    $0009:Result:='en';//英语
    $0412:Result:='ko';//朝鲜语
    $0001:Result:='ar';//阿拉伯语
    $0436:Result:='af';//南非语
    $041C:Result:='sq';//阿尔巴尼亚语
    $042D:Result:='eu';//巴士克语
    $0402:Result:='bg';//保加利亚语
    $0423:Result:='be';//白俄罗斯语
    $0403:Result:='ca';//加泰隆语
    $041A:Result:='hr';//克罗地亚语
    $0405:Result:='cs';//捷克语
    $0406:Result:='da';//丹麦语
    $0413:Result:='nl';//荷兰语
    $0425:Result:='et';//爱沙尼亚语
    $0438:Result:='fo';//法罗语
    $0429:Result:='fa';//法斯语
    $040B:Result:='fi';//芬兰语
    $040C:Result:='fr';//法语
    $043C:Result:='gd';//盖尔语
    $0407:Result:='de';//德语
    $0408:Result:='el';//希腊语
    $040D:Result:='he';//希伯来语
    $0439:Result:='hi';//印地语
    $040E:Result:='hu';//匈牙利语
    $040F:Result:='is';//冰岛语
    $0421:Result:='in';//印度尼西亚语
    $0410:Result:='it';//意大利语
    $0411:Result:='ja';//日语
    $0426:Result:='lv';//拉脱维亚语
    $0427:Result:='lt';//立陶宛语
    $042F:Result:='mk';//FYRO 马其顿语
    $043E:Result:='ms';//马来语
    $043A:Result:='mt';//马耳他语
    $0414:Result:='no';//挪威语
    $0415:Result:='pl';//波兰语
    $0816:Result:='pt';//葡萄牙语
    $0417:Result:='rm';//列托-罗马语
    $0418:Result:='ro';//罗马尼亚语
    $0419:Result:='ru';//俄语
    $0C1A:Result:='sr';//塞尔维亚语
    $041B:Result:='sk';//斯洛伐克语
    $0424:Result:='sl';//斯洛文尼亚语
    $042E:Result:='sb';//塞尔维亚语
    $040A:Result:='es';//西班牙语
    $0430:Result:='sx';//索托语
    $041D:Result:='sv';//瑞典语
    $041E:Result:='th';//泰语
    $0431:Result:='ts';//聪加语
    $0432:Result:='tn';//茨瓦纳语
    $041F:Result:='tr';//土耳其语
    $0422:Result:='uk';//乌克兰语
    $0420:Result:='ur';//乌都语
    $042A:Result:='vi';//越南语
    $0434:Result:='xh';//科萨语
    $043D:Result:='ji';//意第绪语
    $0435:Result:='zu';//祖鲁语
else
    Result:='en';
end;
end;

class procedure TFun.DoBusy(Busy:Boolean=True);
{使鼠标变忙和恢复正常}
begin
if busy then
    Screen.Cursor:=crHourGlass
else
    Screen.Cursor:=crDefault;
end;

class function TFun.ShowMsg(Text:string;Warning1_Asterisk2_Question3_Error4,
DefBtn012:integer):integer;
var//Result= 1 or 2
Title:string;
Flag:integer;
begin
Title:=Application.Title;// AppName;
Flag:=MB_OKCANCEL;
case Warning1_Asterisk2_Question3_Error4 of
    1:Flag:=Flag+MB_ICONWARNING;
    2:Flag:=Flag+MB_ICONASTERISK;
    3:Flag:=Flag+MB_ICONQUESTION;
    4:Flag:=Flag+MB_ICONERROR;
else
    Flag:=Flag+MB_ICONQUESTION;
end;
case DefBtn012 of
    0:Flag:=Flag-MB_OKCANCEL+MB_OK;
    1:Flag:=Flag+MB_DEFBUTTON1;
    2:Flag:=Flag+MB_DEFBUTTON2;
else Flag:=Flag+MB_DEFBUTTON1;
end;
// Result:=Application.MessageBox(PChar(Text),PChar(Title),Flag);
Result:=Application.MessageBox(PChar(Text),PChar(Title),$00001000+Flag);//最頂層顯示
end;

class function TFun.ShowMsg(Text:string;Icon:boolean=False):integer;
begin
if not Icon then
begin
    ShowMessage(Text);
end else
begin
    ShowMsg(Text,2,0);
end;
Result:=0;
end;

class procedure TFun.SleepEx(ms:integer);
var
cur,pre:integer;
begin
pre:=GetTickCount;
cur:=GetTickCount;
while (cur-pre)<ms do
begin
    cur:=GetTickCount;
    Application.ProcessMessages;//让系统转移控制权
end;
end;

class procedure TFun.StayOnTop(Handle:HWND;OnTop:Boolean);
const
csOnTop:array[Boolean] of HWND=(HWND_NOTOPMOST,HWND_TOPMOST);
begin
SetWindowPos(Handle,csOnTop[OnTop],0,0,0,0,SWP_NOMOVE or SWP_NOSIZE);
end;

class procedure TFun.StayOnTop(Form:TForm;OnTop:Boolean);
begin
StayOnTop(Form.Handle,OnTop);
end;

class function TFun.IniDeleteSection(FileName,Section:string):boolean;
var
ini:TIniFile;
IniFile:string;
begin
Result:=True;
iniFile:=FileName;
ini:=TIniFile.Create(iniFile);
try
    ini.EraseSection(Section);
finally
    ini.Free;
end;
end;

class function TFun.IniDeleteSection(Section:string):boolean;
begin
Result:=IniDeleteSection(IniFileName,Section);
end;

class function TFun.IniReadStr(FileName:string;Section,ident,Default:string):string;
var
ini:TIniFile;
IniFile:string;
begin
iniFile:=FileName;
ini:=TIniFile.Create(iniFile);
try
    Result:=ini.ReadString(Section,ident,Default);
finally
    ini.Free;
end;
end;

class function TFun.IniReadBool(FileName:string;Section,ident:string;Default:boolean):boolean;
var
ini:TIniFile;
IniFile:string;
begin
iniFile:=FileName;
ini:=TIniFile.Create(iniFile);
try
    Result:=ini.ReadBool(Section,ident,Default);
finally
    ini.Free;
end;
end;

class function TFun.IniReadInt(FileName:string;Section,ident:string;Default:integer):integer;
var
ini:TIniFile;
IniFile:string;
begin
iniFile:=FileName;
ini:=TIniFile.Create(iniFile);
try
    Result:=ini.ReadInteger(Section,ident,Default);
finally
    ini.Free;
end;
end;

class function TFun.IniReadFloat(FileName,Section,ident:string;
Default:Double):Double;
var
ini:TIniFile;
IniFile:string;
begin
iniFile:=FileName;
ini:=TIniFile.Create(iniFile);
try
    Result:=ini.ReadFloat(Section,ident,Default);
finally
    ini.Free;
end;
end;

class function TFun.IniWriteBool(FileName,Section,ident:string;
Value:boolean):boolean;
var
ini:TIniFile;
IniFile:string;
begin
Result:=True;
iniFile:=FileName;
ini:=TIniFile.Create(iniFile);
try
    ini.WriteBool(Section,ident,Value);
finally
    ini.Free;
end;
end;

class function TFun.IniWriteFloat(FileName,Section,ident:string;
Value:Double):boolean;
var
ini:TIniFile;
IniFile:string;
begin
Result:=True;
iniFile:=FileName;
ini:=TIniFile.Create(iniFile);
try
    ini.WriteFloat(Section,ident,Value);
finally
    ini.Free;
end;
end;

class function TFun.IniWriteInt(FileName,Section,ident:string;
Value:integer):boolean;
var
ini:TIniFile;
IniFile:string;
begin
Result:=True;
iniFile:=FileName;
ini:=TIniFile.Create(iniFile);
try
    ini.WriteInteger(Section,ident,Value);
finally
    ini.Free;
end;
end;

class function TFun.IniWriteStr(FileName,Section,ident,
Value:string):boolean;
var
ini:TIniFile;
IniFile:string;
begin
Result:=True;
iniFile:=FileName;
ini:=TIniFile.Create(iniFile);
try
    ini.WriteString(Section,ident,Value);
finally
    ini.Free;
end;
end;

class function TFun.FileVersion:string;
begin
Result:=TFun.GetFileVersion(Application.ExeName);
end;

class function TFun.SendMsg(Msg:DWORD;wParam,lParam:Longint):boolean;
begin
Result:=TFun.SendMsg(Application.Handle,Msg,wParam,lParam);
end;

class function TFun.SendMsg(Msg:DWORD):boolean;
begin
Result:=TFun.SendMsg(Application.Handle,Msg,0,0);
end;

class function TFun.SendMsg(aWnd:HWND;Msg:DWORD;wParam,lParam:Longint):boolean;
begin
Result:=PostMessage(aWnd,Msg,wParam,lParam);
end;

class function TFun.SendFormMsg(aName:string;Msg:DWORD;wParam,lParam:Integer):boolean;
var
Form:TForm;
begin
Result:=False;
Form:=TForm(Application.FindComponent(aName));
if Form<>nil then
    Result:=PostMessage(Form.Handle,Msg,wParam,lParam);
end;

class function TFun.SendMsgBroadCast(Msg:DWORD;wParam,lParam:Longint):boolean;//广播消息
var
i:integer;
Form:TWinControl;
begin
for i:=0 to Application.ComponentCount-1 do
begin
    try
      Form:=TWinControl(Application.Components[i]);
      SendMessage(Form.Handle,Msg,wParam,lParam);
    except end;
end;
Result:=True;
end;

class function TFun.FindForm(aName:string):TForm;
begin
Result:=TForm(Application.FindComponent(aName));
end;

class function TFun.FindFormEx(aCaption:string):TForm;
var
i:integer;
Form:TForm;
begin
Result:=nil;
for i:=0 to Application.ComponentCount-1 do
begin
    Form:=TForm(Application.Components[i]);
    if Form.Caption=ACaption then
    begin
      Result:=TForm(Form);
      Break;
    end;
end;
end;

class function TFun.IniReadBool(Section,ident:string;Default:boolean):boolean;
begin
Result:=IniReadBool(IniFileName,Section,ident,Default);
end;

class function TFun.IniReadFloat(Section,ident:string;Default:Double):Double;
begin
Result:=IniReadFloat(IniFileName,Section,ident,Default);
end;

class function TFun.IniReadInt(Section,ident:string;Default:integer):integer;
begin
Result:=IniReadInt(IniFileName,Section,ident,Default);
end;

class function TFun.IniReadStr(Section,ident,Default:string):string;
begin
Result:=IniReadStr(IniFileName,Section,ident,Default);
end;

class function TFun.IniWriteBool(Section,ident:string;Value:boolean):boolean;
begin
Result:=IniWriteBool(IniFileName,Section,ident,Value);
end;

class function TFun.IniWriteFloat(Section,ident:string;Value:Double):boolean;
begin
Result:=IniWriteFloat(IniFileName,Section,ident,Value);
end;

class function TFun.IniWriteInt(Section,ident:string;Value:integer):boolean;
begin
Result:=IniWriteInt(IniFileName,Section,ident,Value);
end;

class function TFun.IniWriteStr(Section,ident,Value:string):boolean;
begin
Result:=IniWriteStr(IniFileName,Section,ident,Value);
end;

class function TFun.IniDeleteKey(Section,ident:string):boolean;
var
ini:TIniFile;
begin
Result:=True;
ini:=TIniFile.Create(IniFileName);
try
    Ini.DeleteKey(Section,ident);
finally
    ini.Free;
end;
end;

class function TFun.SysDownloadPath:string;
begin
Result:=WinPath+'Downloaded Program Files/';
end;

class function TFun.CreateUnicodeTextFile(FileName:string):boolean;
var
FFile:THandle;
a,b:byte;
begin
a:=$FF;
b:=$FE;
FFile:=FileCreate(FileName);
FileWrite(FFile,a,SizeOf(Byte));
FileWrite(FFile,b,SizeOf(Byte));
FileClose(FFile);
Result:=True;
end;
class function TFun.DateTimeToIntTime(dt:TDateTime):DWORD;
begin
Result:=Trunc(dt*86400);
end;

class function TFun.IntTimeToDateTime(iTime:DWORD):TDateTime;
begin
Result:=iTime/86400;
end;

class function TFun.DateTimeTotime_t(dt:TDateTime):DWORD;
var
TimeDec:Integer;
Info:TTimeZoneInformation;
begin
GetTimeZoneInformation(Info);
TimeDec:=Info.Bias*60;//分->秒
//25569;//='1970-01-01 00:00:00'
Result:=Round((dt-25569)*86400)+TimeDec;
end;

class function TFun.time_tToDateTime(iTime:DWORD):TDateTime;
var
dt:TDateTime;
TimeDec:Integer;
iiTime:Int64;
Info:TTimeZoneInformation;
begin
iiTime:=iTime;
GetTimeZoneInformation(Info);
TimeDec:=Info.Bias*60;//分->秒
dt:=(iiTime-TimeDec)/86400+25569;
Result:=dt;
end;

class function TFun.IntHighToLow(Value:DWORD):DWORD;//由DELPHI的高位整型转成低位整型
type Ta=record a1,a2,a3,a4:byte; end;
var
a,b:Ta;
begin
//aa[0]:=char(Hi(HIWORD(TTL)));
//aa[1]:=char(Lo(HIWORD(TTL)));
//aa[2]:=char(Hi(LOWORD(TTL)));
//aa[3]:=char(Lo(LoWord(TTL)));
a:=Ta(Value);
b.a1:=a.a4;
b.a2:=a.a3;
b.a3:=a.a2;
b.a4:=a.a1;
Result:=DWORD(B);
end;

class function TFun.GetProcessFileName(Wnd:hWnd):string;
var
PID:DWORD;
hProcess:hWnd;
Buf:array[0..255] of char;
begin
Result:='';
GetWindowThreadProcessId(Wnd,PID);
hProcess:=OpenProcess(PROCESS_ALL_ACCESS or PROCESS_QUERY_INFORMATION,False,PID);
if (hProcess<>0) then
begin
    if (GetModuleFileNameEx(hProcess,0,Buf,SizeOf(Buf))>0) then
    begin
      Result:=Buf;
    end;
    CloseHandle(hProcess);
end;
end;

class function TFun.GetWndFromProcessFileName(FileName:string):hWnd;
var
Wnd:HWnd;// 窗口句柄
WinText:array[0..255] of char;
Str:string;
begin
Result:=0;
Wnd:=GetWindow(Application.Handle,GW_HWNDFIRST);
while Wnd<>0 do
begin
    Str:=GetProcessFileName(wnd);
    if Pos(FileName,Str)>0 then
//    if Str=FileName then
    begin
      Result:=Wnd;
      if GetWindowText(Wnd,@WinText,255)>0 then
        if WinText<>'Default IME' then //IME
          Break;
    end;
    Wnd:=GetWindow(Wnd,GW_HWNDNEXT);
end;
end;

class function TFun.GetDirSize(Path:string;SubDir:boolean=True):Int64;
var
Rec:TSearchRec;
Found:integer;
begin
Result:=0;
if Path[length(Path)]<>'/' then Path:=Path+'/';
Found:=FindFirst(Path+'*.*',faAnyFile,Rec);
while Found=0 do begin
    inc(Result,Rec.Size);
    if (Rec.Attr and faDirectory>0)and(Rec.Name[1]<>'.')and(SubDir=True) then
      inc(Result,GetDirSize(Path+Rec.Name,True));
    found:=FindNext(Rec);
end;
FindClose(Rec);
end;

class function TFun.NetAdjustTime(aTime:TDateTime):boolean;
var
ST:TSystemTime;
begin
DateTimeToSystemTime(aTime,ST);
Result:=Windows.SetLocalTime(ST);//修正本机系统时间
end;

class function TFun.NetAdjustTime(ServerAddress:string='192.43.244.18';
ServerPort:Integer=13):boolean;
var
Skt:TClientSocket;
i:Integer;
StandardTime:TDateTime;
ST:TSystemTime;
Str:string;
begin
Result:=False;
Skt:=TClientSocket.Create(nil);
try
    try
      Skt.Host:=ServerAddress;
      Skt.Port:=ServerPort;
      Skt.Active:=True;
      for i:=0 to 200 do
      begin
        Application.ProcessMessages;
        Sleep(1);
        if Skt.Active then Break;
      end;
      if not Skt.Active then exit;

      FillChar(Str,SizeOf(Str),0);
      for i:=0 to 200 do
      begin
        Application.ProcessMessages;
        Sleep(1);
        Str:=Skt.Socket.ReceiveText;
        if Str<>'' then Break;
      end;
      if Str<>'' then
      begin
        Str:=Copy(Str,8,17);// 取得日期时间部分;
        if Length(Str)=17 then
          Str:='20'+Str;// 年份转换为四位;
        StandardTime:=StrToDateTime(Str);//标准时间
        DateTimeToSystemTime(StandardTime,ST);
        Windows.SetSystemTime(ST);//修正本机系统时间
        Result:=True;
      end;
    except end;
finally
    Skt.Active:=False;
    Skt.Free;
end;
end;

class function TFun.IsIDE:boolean;
begin//uses System
{$WARN SYMBOL_PLATFORM OFF}
Result:=(DebugHook>0);
end;

class function TFun.IsValidEmail(const S:string):boolean;
var
i:Integer;
c:string;
R:boolean;
begin// ' ', ?, ?, ü, ?, [, ], (, ), : in EMail-Address
R:=False;
Result:=False;
try
    R:=(Trim(s)='')or(Pos(' ',AnsiLowerCase(s))>0)or
      (Pos('?',AnsiLowerCase(s))>0)or(Pos('?',AnsiLowerCase(s))>0)or
      (Pos('ü',AnsiLowerCase(s))>0)or(Pos('?',AnsiLowerCase(s))>0)or
      (Pos('[',AnsiLowerCase(s))>0)or(Pos(']',AnsiLowerCase(s))>0)or
      (Pos('(',AnsiLowerCase(s))>0)or(Pos(')',AnsiLowerCase(s))>0)or
      (Pos(':',AnsiLowerCase(s))>0);
    if R then Exit;// @ not in EMail-Address;
    i:=Pos('@',s);
    R:=(i=0)or(i=1)or(i=Length(s));
    if R then Exit;
    R:=(Pos('@',Copy(s,i+1,Length(s)-1))>0);
    if R then Exit;// Domain <= 1
    c:=Copy(s,i+1,Length(s));
    R:=Length(c)<=1;
    if R then Exit;
    i:=Pos('.',c);
    R:=(i=0)or(i=1)or(i=Length(c));
finally
    Result:=not R;
end;
end;

class function TFun.GetDisplayCardNameEx:string;
begin

end;

class function TFun.GetDisplayCardName:string;
{var
lpDD:IDirectDraw;
lpDD7:IDirectDraw7;
Info:TDDDeviceIdentifier2;}
begin
Result:='';
{ try
    DirectDrawCreate(nil,lpDD,nil);
    lpDD.QueryInterface(IDirectDraw7,lpDD7);
    lpDD7.GetDeviceIdentifier(Info,0);
    Result:=string(Info.szDescription);
finally
    lpDD7:=nil;
    lpDD:=nil;
end;}
end;

class function TFun.GetHDDName:string;
var
Reg:TRegistry;
Key:string;
i,k,m,n:Integer;
Str:string;
begin
Str:='';
Reg:=TRegistry.Create;
try
    Reg.RootKey:=HKEY_LOCAL_MACHINE;
    Key:='/HARDWARE/DEVICEMAP/Scsi/Scsi Port 0/Scsi Bus 0/Target Id 0/Logical Unit Id 0';
    for i:=0 to 9 do
      for k:=0 to 9 do
        for m:=0 to 9 do
          for n:=0 to 9 do
          begin
            Key:=Format('/HARDWARE/DEVICEMAP/Scsi/Scsi Port %D/Scsi Bus %D/Target Id %D/Logical Unit Id %D', [i,k,m,n]);
            Reg.OpenKey(Key,False);
            if Reg.ReadString('Type')='DiskPeripheral' then
            begin
              Str:=Str+Reg.ReadString('Identifier')+Enter;
            end;
            Reg.CloseKey;
          end;
finally
    Reg.Free;
    if Str<>'' then Str:=LeftStr(Str,Length(Str)-2);
    Result:=Str;
end;
end;

class function TFun.GetCdromName:string;
var
Reg:TRegistry;
Key:string;
i,k,m,n:Integer;
Str:string;
begin
Str:='';
Reg:=TRegistry.Create;
try
    Reg.RootKey:=HKEY_LOCAL_MACHINE;
    Key:='/HARDWARE/DEVICEMAP/Scsi/Scsi Port 0/Scsi Bus 0/Target Id 0/Logical Unit Id 0';
    for i:=0 to 9 do
      for k:=0 to 9 do
        for m:=0 to 9 do
          for n:=0 to 9 do
          begin
            Key:=Format('/HARDWARE/DEVICEMAP/Scsi/Scsi Port %D/Scsi Bus %D/Target Id %D/Logical Unit Id %D', [i,k,m,n]);
            Reg.OpenKey(Key,False);
            if Reg.ReadString('Type')='CdRomPeripheral' then
            begin
              Str:=Str+Reg.ReadString('Identifier')+Enter;
            end;
            Reg.CloseKey;
          end;
finally
    Reg.Free;
    if Str<>'' then Str:=LeftStr(Str,Length(Str)-2);
    Result:=Str;
end;
end;

class function TFun.GetCPUName:string;//取得CPU名称
var
Reg:TRegistry;
Key:string;
begin
Reg:=TRegistry.Create;
try
    Reg.RootKey:=HKEY_LOCAL_MACHINE;
    Key:='/HARDWARE/DESCRIPTION/System/CentralProcessor/0';
    Reg.OpenKey(Key,False);
    Result:=Trim(Reg.ReadString('ProcessorNameString'));
finally
    Reg.Free;
end;
end;

class procedure TFun.DelSelfAfterClose;
var
F:TextFile;
begin
AssignFile(F,'./DelMe.bat');
ReWrite(F);
WriteLn(F,'@echo off');
WriteLn(F,':loop');
WriteLn(F,'del "'+Application.ExeName+'"');
WriteLn(F,'if exist ./file.exe goto loop');
WriteLn(F,'del ./DelMe.bat');
CloseFile(F);
WinExec('./DelMe.bat',SW_HIDE);
TFun.CloseWindowEx;
end;

class procedure TFun.DelSelfAfterReboot(aFileName:string='');
var
FileName:string;
begin
FileName:=aFileName;
if FileName='' then FileName:=ParamStr(0);
MoveFileEx(PChar(FileName),nil,MoveFile_Delay_Until_Reboot);
end;

class function TFun.WriteDebugInfo(Value:string):boolean;
var
FileName:string;
Wnd:hWnd;
dt:array[0..21] of char;
buf:array[0..255] of char;
Str:string;
begin
Result:=False;
exit;
FileName:=ChangeFileExt(Application.ExeName,'.txt');
try
    if not FileExists(FileName) then
      Wnd:=CreateFile(PChar(FileName),
        GENERIC_READ or GENERIC_WRITE,
        FILE_SHARE_READ,nil,OPEN_ALWAYS,FILE_ATTRIBUTE_NORMAL,0)
    else
      Wnd:=FileOpen(FileName,fmOpenWrite);

    try
      FileSeek(Wnd,0,2);

      Str:=FormatDateTime('yyyy-mm-dd hh:mm:ss',Now)+' | ';
      StrPCopy(dt,Str);
      FileWrite(Wnd,dt,Length(dt));
      StrPCopy(buf,Value);
      FileWrite(Wnd,buf,Length(Value));
      FileWrite(Wnd,#13#10,2);
    finally
      FileClose(Wnd);
      Result:=True;
    end;
except
    ShowMessage('TFun.WriteDebugInfo');
end;
end;

class function TFun.GetFileProductVersion(AFileName:string):string;
var
VerInfoSize:DWORD;
VerInfo:Pointer;
TransInfo:Pointer;
lsDesc:PChar;
Str,lsTemp:string;
VerValueSize:DWORD;
Dummy:DWORD;
begin
try
    VerInfoSize:=GetFileVersionInfoSize(PChar(AFileName),Dummy);
    GetMem(VerInfo,VerInfoSize);
    GetFileVersionInfo(PChar(AFileName),0,VerInfoSize,VerInfo);

    if VerQueryValue(VerInfo,'/VarFileInfo/Translation',Pointer(TransInfo),VerValueSize) then
    begin
      lsTemp:='/StringFileInfo/'+IntToHex(LoWord(Longint(TransInfo^)),4)+IntToHex(HiWord(Longint(TransInfo^)),4)+'/ProductVersion';
      if VerQueryValue(VerInfo,PChar(lsTemp),Pointer(lsDesc),VerValueSize) then
        Str:=lsDesc;
    end;
    FreeMem(VerInfo,VerInfoSize);
except
end;
Result:=Str;
end;

class function TFun.CopyFile(SrcFile,DstFile:string):boolean;
var
fSrc,fDst:TFileStream;
f:THandle;
begin
Result:=False;
if not FileExists(SrcFile) then exit;

fSrc:=TFileStream.Create(SrcFile,fmOpenRead);
f:=FileCreate(DstFile);
FileClose(f);
fDst:=TFileStream.Create(DstFile,fmOpenWrite);
fDst.Size:=FSrc.Size;
fDst.Position:=0;
try
    fDst.CopyFrom(fSrc,fSrc.Size);
    Result:=True;
finally
    fSrc.Free;
    fDst.Free;
end;
end;

class function TFun.Space(Count:Int=1):string;
var
i:Int;
begin
Result:='';
for i:=0 to Count-1 do Result:=Result+#32;
end;

class function TFun.RegWriteStr(Section,ident,Value:string;MainKey:string=''):boolean;
var
ini:TRegistryIniFile;
FileName:string;
begin
Result:=True;
if MainKey='' then FileName:='SoftWare/'+ChangeFileExt(ExtractFileName(Application.ExeName),'')
else FileName:=MainKey;
ini:=TRegistryIniFile.Create(FileName);
try
    ini.WriteString(Section,ident,Value);
finally
    ini.Free;
end;
end;

class function TFun.RegWriteBool(Section,ident:string;Value:boolean;MainKey:string=''):boolean;
var
ini:TRegistryIniFile;
FileName:string;
begin
Result:=True;
if MainKey='' then FileName:='SoftWare/'+ChangeFileExt(ExtractFileName(Application.ExeName),'')
else FileName:=MainKey;
ini:=TRegistryIniFile.Create(FileName);
try
    ini.WriteBool(Section,ident,Value);
finally
    ini.Free;
end;
end;

class function TFun.RegWriteFloat(Section,ident:string;Value:Double;MainKey:string=''):boolean;
var
ini:TRegistryIniFile;
FileName:string;
begin
Result:=True;
if MainKey='' then FileName:='SoftWare/'+ChangeFileExt(ExtractFileName(Application.ExeName),'')
else FileName:=MainKey;
ini:=TRegistryIniFile.Create(FileName);
try
    Ini.WriteFloat(Section,ident,Value);
finally
    ini.Free;
end;
end;

class function TFun.RegWriteInt(Section,ident:string;Value:integer;MainKey:string=''):boolean;
var
ini:TRegistryIniFile;
FileName:string;
begin
Result:=True;
if MainKey='' then FileName:='SoftWare/'+ChangeFileExt(ExtractFileName(Application.ExeName),'')
else FileName:=MainKey;
ini:=TRegistryIniFile.Create(FileName);
try
    ini.WriteInteger(Section,ident,Value);
finally
    ini.Free;
end;
end;

class function TFun.RegReadBool(Section,ident:string;Default:boolean;MainKey:string=''):boolean;
var
ini:TRegistryIniFile;
FileName:string;
begin
if MainKey='' then FileName:='SoftWare/'+ChangeFileExt(ExtractFileName(Application.ExeName),'')
else FileName:=MainKey;
ini:=TRegistryIniFile.Create(FileName);
try
    Result:=ini.ReadBool(Section,ident,Default);
finally
    ini.Free;
end;
end;

class function TFun.RegReadFloat(Section,ident:string;Default:Double;MainKey:string=''):Double;
var
ini:TRegistryIniFile;
FileName:string;
begin
if MainKey='' then FileName:='SoftWare/'+ChangeFileExt(ExtractFileName(Application.ExeName),'')
else FileName:=MainKey;
ini:=TRegistryIniFile.Create(FileName);
try
    Result:=ini.ReadFloat(Section,ident,Default);
finally
    ini.Free;
end;
end;

class function TFun.RegReadInt(Section,ident:string;Default:integer;MainKey:string=''):integer;
var
ini:TRegistryIniFile;
FileName:string;
begin
if MainKey='' then FileName:='SoftWare/'+ChangeFileExt(ExtractFileName(Application.ExeName),'')
else FileName:=MainKey;
ini:=TRegistryIniFile.Create(FileName);
try
    Result:=ini.ReadInteger(Section,ident,Default);
finally
    ini.Free;
end;
end;

class function TFun.RegReadStr(Section,ident,Default:string;MainKey:string=''):string;
var
ini:TRegistryIniFile;
FileName:string;
begin
if MainKey='' then FileName:='SoftWare/'+ChangeFileExt(ExtractFileName(Application.ExeName),'')
else FileName:=MainKey;
ini:=TRegistryIniFile.Create(FileName);
try
    Result:=ini.ReadString(Section,ident,Default);
finally
    ini.Free;
end;
end;

class function TFun.RegDeleteKey(Section,ident:string;MainKey:string=''):boolean;
var
ini:TRegistryIniFile;
FileName:string;
begin
if MainKey='' then FileName:='SoftWare/'+ChangeFileExt(ExtractFileName(Application.ExeName),'')
else FileName:=MainKey;
ini:=TRegistryIniFile.Create(FileName);
try
    ini.DeleteKey(Section,ident);
finally
    ini.Free;
end;
Result:=True;
end;

class function TFun.RegDeleteSection(Section:string;MainKey:string=''):boolean;
var
ini:TRegistryIniFile;
FileName:string;
begin
if MainKey='' then FileName:='SoftWare/'+ChangeFileExt(ExtractFileName(Application.ExeName),'')
else FileName:=MainKey;
ini:=TRegistryIniFile.Create(FileName);
try
    ini.EraseSection(Section);
finally
    ini.Free;
end;
Result:=True;
end;

class function TFun.BmpMiniature(Src:TBitmap;var Dst:TBitMap;Width,Height:Int):boolean;
begin
Dst.Assign(Src);
Dst.Width:=Width;
Dst.Height:=Height;
SetStretchBltMode(Dst.Canvas.Handle,HALFTONE);
Result:=StretchBlt(Dst.Canvas.Handle,
    0,
    0,
    Dst.Width,
    Dst.Height,
    Src.Canvas.Handle,
    0,
    0,
    Src.Width,
    Src.Height,
    SRCCOPY);
end;

class function TFun.BmpMiniature(Src,Dst:string;Width,Height:Int):boolean;
var
BmpSrc,BmpDst:TBitMap;
begin
Result:=False;
if not FileExists(Src) then exit;
BmpSrc:=TBitMap.Create;
BmpDst:=TBitMap.Create;
try
    BmpSrc.LoadFromFile(Src);
    Result:=BmpMiniature(BmpSrc,BmpDst,Width,Height);
    BmpDst.SaveToFile(Dst);
finally
    BmpSrc.Free;
    bmpDst.Free;
end;
end;

class function TFun.JpgMiniature(Src:TJpegImage;var Dst:TJpegImage;Width,Height:Int):boolean;
var
BmpSrc,BmpDst:TBitMap;
begin
BmpSrc:=TBitMap.Create;
BmpDst:=TBitMap.Create;
try
    BmpSrc.Assign(Src);
    Result:=BmpMiniature(BmpSrc,BmpDst,Width,Height);
    Dst.Assign(BmpDst);
finally
    BmpSrc.Free;
    BmpDst.Free;
end;
end;

class function TFun.JpgMiniature(Src,Dst:string;Width,Height:Int):boolean;
var
JpgSrc,JpgDst:TJpegImage;
begin
Result:=False;
if not FileExists(Src) then exit;
JpgSrc:=TJpegImage.Create;
JpgDst:=TJpegImage.Create;
try
    JpgSrc.LoadFromFile(Src);
    Result:=JpgMiniature(JpgSrc,JpgDst,Width,Height);
    JpgDst.SaveToFile(Dst);
finally
    JpgSrc.Free;
    JpgDst.Free;
end;
end;

class procedure TFun.CreateEroseWindow(wHandle:THandle;wMask:TBitMap;wMaskColor:TColor);

function CreateRegion(wHandle:THandle;wMask:TBitmap;wColor:TColor):HRGN;
var
    dc,dc_c:HDC;
    Rgn:HRGN;
    x,y:integer;
    coord:TPoint;
    line:boolean;
    color:TColor;
begin
    dc:=GetWindowDC(wHandle);
    dc_c:=CreateCompatibleDC(dc);
    SelectObject(dc_c,wMask.Handle);
    BeginPath(dc);
    for x:=0 to wMask.Width-1 do
    begin
      line:=False;
      for y:=0 to wMask.Height-1 do
      begin
        color:=GetPixel(dc_c,x,y);
        if (not(color=wColor))and(not line) then
        begin
          line:=True;
          coord.x:=x;
          coord.y:=y;
        end;
        if ((color=wColor)or(y=wMask.Height-1))and line then
        begin
          line:=false;
          MoveToEx(dc,coord.x,coord.y,nil);
          LineTo(dc,coord.x,y);
          LineTo(dc,coord.x+1,y);
          LineTo(dc,coord.x+1,coord.y);
          CloseFigure(dc);
        end;
      end;
    end;
    EndPath(dc);
    Rgn:=PathToRegion(dc);
    ReleaseDC(wHandle,dc);
    Result:=Rgn;
end;

var
Rgn:HRGN;
begin
// Color:=wMask.Canvas.Pixels[0,0];
Rgn:=CreateRegion(wHandle,wMask,wMaskColor);
if Rgn<>0 then SetWindowRgn(wHandle,Rgn,True);
end;

class function TFun.MakeFcc(ch0,ch1,ch2,ch3:Char):DWORD;
begin
Result:=
    DWORD(Byte(ch0)shl 0)or
    DWORD(Byte(ch1)shl 8)or
    DWORD(Byte(ch2)shl 16)or
    DWORD(Byte(ch3)shl 24);
end;

class function TFun.MakeFcc(ch:string):DWORD;
begin
Result:=0;
if ch='' then exit;
if Length(ch)<4 then exit;
Result:=
    DWORD(Byte(ch[1])shl 0)or
    DWORD(Byte(ch[2])shl 8)or
    DWORD(Byte(ch[3])shl 16)or
    DWORD(Byte(ch[4])shl 24);
end;

initialization
//************************************************************开始初始化时间格式
//Unit SysUtils
ShortDateFormat:='yyyy-MM-dd';
LongDateFormat:='yyyy-MM-dd';
ShortTimeFormat:='HH:mm:ss';//tt hh:mm:ss
LongTimeFormat:='HH:mm:ss';
// ShortTimeFormat:='HH:mm:ss AMPM';//tt hh:mm:ss
// LongTimeFormat:='HH:mm:ss AMPM';//tt hh:mm:ss
DateSeparator:='-';
TimeSeparator:=':';
//************************************************************结束初始化时间格式

finalization

end.