本人多年来编写的一些给自己用的常用函数类，希望对大家有点帮助 ( 积分: 4 )

//------------------------------------------------------------------------------
// 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)WORD;//time_t时间 (2006-09-27)
09. Add function time_tToDateTime(iTimeWORD):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,TargetChar):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 GetMemorySizeword;//物理內存
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(MsgWORD;wParam,lParam:Longint):boolean; overload;//发送应用程序消息
class function SendMsg(MsgWORD):boolean; overload;//发送应用程序消息
class function SendMsg(aWnd:HWND;MsgWORD;wParam,lParam:Longint):boolean; overload;//发送其它程序消息
class function SendFormMsg(aName:string;MsgWORD;wParam,lParam:Longint):boolean;//发送给窗口的消息
class function SendMsgBroadCast(MsgWORD;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;Defaultouble;MainKey:string='')ouble;
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;Valueouble;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;Defaultouble)ouble; 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;Valueouble):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;Defaultouble)ouble; 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;Valueouble):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)Word;
class function IntToIP(IPWORD;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(ValueWORD)WORD;//高位整型转成低位整型
class function MakeFcc(ch0,ch1,ch2,ch3:Char)WORD; overload;
class function MakeFcc(ch:string)WORD; overload;

//时间操作
class function DateTimeToIntTime(dt:TDateTime)WORD;
class function IntTimeToDateTime(iTimeWORD):TDateTime;

class function DateTimeTotime_t(dt:TDateTime)WORD;//time_t时间
class function time_tToDateTime(iTimeWORD):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(FCOMChar):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;
HostEntHostEnt;
LastIPInAddr;
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;
VerInfoSizeWORD;
VerInfoointer;
VerValueSizeWORD;
VerValueVSFixedFileInfo;
DummyWORD;
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
dwConnectionTypesWORD;
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:=IntToStr(Abs(CpuID));
if s='0' then s:='2425';
if Length(s)>4 then s:=Copy(s,Length(s)-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));
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));
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
cBufferSizeWORD;
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;
cbBytesReturnedWORD;
pInDataSendCmdInParams;
pOutDataointer;// PSendCmdOutParams
Buffer:array[0..BufferSize-1] of Byte;
srbControl:TSrbIoControl absolute Buffer;

procedure ChangeByteOrder(var Data;Size:Integer);
var
ptrChar;
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)Word;
begin
if IP<>'' then
Result:=inet_addr(PChar(IP))
else
Result:=0;
end;

class function TFun.IntToIP(IPWORD;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
nWORD;
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;
phentHostEnt;
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<>nil do
begin
Result:=Result+StrPas(inet_ntoa(P^))+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)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,TargetChar):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;
hostEntHostEnt;
addrChar;
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
pHHostent;
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
pcComputerChar;
dwCSizeWORD;
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
lpNameAnsiChar;
lpUserNameAnsiChar;
lpnLengthWORD;
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;
DumbIntWORD;
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;
DumbIntWORD;
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='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)]+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.GetMemorySizeword;
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)]);
end;
I:=Pos(' ',Result);
while I<>0 do
begin
Result:='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:=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;
DestinationAddressWORD;
RequestDataointer;
RequestSize:Word;
RequestOptionsointer;
ReplyBufferointer;
ReplySizeWord;
TimeoutWord
)Word;stdcall;
var
hICMPdll:HModule;// Handle for ICMP.DLL
hICMP:THandle;
IcmpCreateFile:TIcmpCreateFile;
IcmpCloseHandle:TIcmpCloseHandle;
IcmpSendEcho:TIcmpSendEcho;
wsa:TWSAData;
rep:array[1..128] of byte;
InAddr2WORD;//InAddr1: TInAddr;
pheHostEnt;// HostEntry buffer for name lookup
pacChar;
dwRetWORD;
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;
DestinationAddressWORD;
RequestDataointer;
RequestSize:Word;
RequestOptionsointer;
ReplyBufferointer;
ReplySizeWord;
TimeoutWord
)Word;stdcall;
var
hICMPdll:HModule;// Handle for ICMP.DLL
hICMP:THandle;
IcmpCreateFile:TIcmpCreateFile;
IcmpCloseHandle:TIcmpCloseHandle;
IcmpSendEcho:TIcmpSendEcho;
wsa:TWSAData;
rep:array[1..128] of byte;
InAddr2WORD;//InAddr1: TInAddr;
pheHostEnt;// HostEntry buffer for name lookup
pacChar;
dwRetWORD;
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;
OptionsDataChar;
end;
type
PIcmpEchoReply=^TIcmpEchoReply;
TIcmpEchoReply=packed record
AddressWORD;
StatusWORD;
RTTWORD;
DataSize:Word;
Reserved:Word;
Dataointer;
Options:TIPOptionInformation;
end;
TIcmpCreateFile=function:THandle;stdcall;
TIcmpCloseHandle=function(IcmpHandle:THandle):Boolean;stdcall;

TIcmpSendEcho=function(IcmpHandle:THandle;DestinationAddressWORD;
RequestDataointer;RequestSize:Word;RequestOptionsIPOptionInformation;
ReplyBufferointer;ReplySizeWord;TimeoutWord)Word;stdcall;

var
hICMPdll:HMODULE;
IPOpt:TIPOptionInformation;
FIPAddressWORD;
pReqData,pRevDataChar;//
pIPEIcmpEchoReply;
FSizeWORD;
SendStr:string;
BufferSizeWORD;

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(FCOMChar):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
// dwThreadIdWORD;
dwProcessIdWORD;
hProcess:hWnd;
// DWResultWORD;
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
TmpDirChar;
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;
Defaultouble)ouble;
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;
Valueouble):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(MsgWORD;wParam,lParam:Longint):boolean;
begin
Result:=TFun.SendMsg(Application.Handle,Msg,wParam,lParam);
end;

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

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

class function TFun.SendFormMsg(aName:string;MsgWORD;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(MsgWORD;wParam,lParam:Longint):boolean;//广播消息
var
i:integer;
Form:TWinControl;
begin
for i:=0 to Application.ComponentCount-1 do
begin
try
Form:=TWinControl(Application.Components);
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);
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;Defaultouble)ouble;
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;Valueouble):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)WORD;
begin
Result:=Trunc(dt*86400);
end;

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

class function TFun.DateTimeTotime_t(dt:TDateTime)WORD;
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(iTimeWORD):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(ValueWORD)WORD;//由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
PIDWORD;
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
VerInfoSizeWORD;
VerInfoointer;
TransInfoointer;
lsDescChar;
Str,lsTemp:string;
VerValueSizeWORD;
DummyWORD;
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;Valueouble;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;Defaultouble;MainKey:string='')ouble;
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)WORD;
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)WORD;
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.

收藏了

谢谢分享 我也有个BLFunc.pas 我有的你基本没有 你有的我基本都有 不过你能够无私分享 比我伟大 谢谢!

冰力，你这样说什么意思啊？

他的东西你基本都有，根本不需要，谢人家干什么？

把你的东东也拿出来撒。

嘿嘿。。。。

to 冰力不足:
这种话你以后还是少说吧，把你的那出来再说吧。

不错，收藏了

我提议大家可以在这里加其它函数..使这个Pas.....更完整...这样可以提高很多人的水平

只要自己觉得有用都可以贴上来...保守的就不说了...人家不想共享..那是人家的事.

学习了你的风格，一些函数我也有类似的了，还是谢谢分享啦

[]开源了

冰力，你吹什么吹。

请教一下,为什么要用类函数（class function）？

类函数 可以在不创建类的情况下直接调用，如:
var
Path:string;
begin
Path:=TFun.WorkPath + 'bin/';
end;

我的意思是没有必要封装成类，直接写成一般函数和过程就行了（因为你的类除了方法，没有任何其它成员）。

好东西。多谢楼主无私奉献。

TFun.是有点麻烦,楼主采用太多类方法和类过程,估计是怕一些函数与别的pas的函数同名吧.

同意kaida

收藏了，感谢

好贴。厉害。

谢谢版主！收藏了。