delphi常用函数库.txt

delphi常用的函数库 再不用绞尽脑汁想一些已经存在的函数了

 end; 
end; 

// 窗口最上方显示 
procedure 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; 

var 
 WndLong: Integer; 

// 设置程序是否出现在任务栏 
procedure SetHidden(Hide: Boolean); 
begin 
 ShowWindow(Application.Handle, SW_HIDE); 
 if Hide then 
  SetWindowLong(Application.Handle, GWL_EXSTYLE, 
   WndLong or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW or WS_EX_TOPMOST) 
 else 
  SetWindowLong(Application.Handle, GWL_EXSTYLE, WndLong); 
 ShowWindow(Application.Handle, SW_SHOW); 
end; 

const 
 csWndShowFlag: array[Boolean] of DWORD = (SW_HIDE, SW_RESTORE); 

// 设置任务栏是否可见 
procedure SetTaskBarVisible(Visible: Boolean); 
var 
 wndHandle: THandle; 
begin 
 wndHandle := FindWindow('Shell_TrayWnd', nil); 
 ShowWindow(wndHandle, csWndShowFlag[Visible]); 
end; 

// 设置桌面是否可见 
procedure SetDesktopVisible(Visible: Boolean); 
var 
 hDesktop: THandle; 
begin 
 hDesktop := FindWindow('Progman', nil); 
 ShowWindow(hDesktop, csWndShowFlag[Visible]); 
end; 

// 显示等待光标 
procedure BeginWait; 
begin 
 Screen.Cursor := crHourGlass; 
end;  

// 结束等待光标 
procedure EndWait; 
begin 
 Screen.Cursor := crDefault; 
end; 

// 检测是否Win95/98平台 
function CheckWindows9598NT: String; 
var 
  V: TOSVersionInfo; 
begin 
  V.dwOSVersionInfoSize := SizeOf(V); 
  Result := '未知操作系统'; 
  if not GetVersionEx(V) then Exit; 
  if V.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS then 
   Result := 'Windows 95/98' 
  else 
   begin 
     if V.dwPlatformId = VER_PLATFORM_WIN32_NT then 
      Result := 'Windows NT' 
     else 
      Result :='Windows' 
   end; 
end; 

{* 取得当前操作平台是 Windows 95/98 还是NT} 
function GetOSInfo : String; 
begin 
  Result := ''; 
  case Win32Platform of 
   VER_PLATFORM_WIN32_WINDOWS: Result := 'Windows 95/98'; 
   VER_PLATFORM_WIN32_NT: Result := 'Windows NT'; 
  else 
   Result := 'Windows32'; 
  end; 
end; 

//*获取当前Windows登录名的用户 
function GetCurrentUserName : string; 
const 
  cnMaxUserNameLen = 254; 
var 
  sUserName : string; 
  dwUserNameLen : Dword; 
begin 
  dwUserNameLen := cnMaxUserNameLen-1; 
  SetLength( sUserName, cnMaxUserNameLen ); 
  GetUserName(Pchar( sUserName ), dwUserNameLen ); 
  SetLength( sUserName, dwUserNameLen ); 
  Result := sUserName; 
end; 

function GetRegistryOrg_User(UserKeyType:string):string; 
var 
  Myreg:Tregistry; 
  RegString:string; 
begin 
  MyReg:=Tregistry.Create; 
  MyReg.RootKey:=HKEY_LOCAL_MACHINE; 
  if (Win32Platform = VER_PLATFORM_WIN32_NT) then 
   RegString:='Software\Microsoft\Windows NT\CurrentVersion' 
  else 
   RegString:='Software\Microsoft\Windows\CurrentVersion'; 

  if MyReg.openkey(RegString,False) then 
  begin 
   if UpperCase(UserKeyType)='REGISTEREDORGANIZATION' then 
     Result:= MyReg.readstring('RegisteredOrganization') 
   else 
     begin 
      if UpperCase(UserKeyType)='REGISTEREDOWNER' then 
        Result:= MyReg.readstring('RegisteredOwner') 
      else 
        Result:=''; 
     end; 
  end; 
  MyReg.CloseKey; 
  MyReg.Free; 
end; 

//获取操作系统版本号 
function GetSysVersion:string; 
Var 
  OSVI:OSVERSIONINFO; 
  ObjSysVersion:string; 
begin 
  OSVI.dwOSversioninfoSize:=Sizeof(OSVERSIONINFO); 
  GetVersionEx(OSVI); 
  
ObjSysVersion:=IntToStr(OSVI.dwMinorVersion)+','+IntToStr(OSVI.dwMinorVersion)+',' 

      +IntToStr(OSVI.dwBuildNumber)+','+IntToStr(OSVI.dwPlatformId)+',' 
      +OSVI.szCSDVersion; 
  if rightstr(ObjSysVersion,1)=',' then 
   ObjSysVersion:=Substr(ObjSysVersion,1,length(ObjSysVersion)-1); 
  Result:=ObjSysVersion; 
end; 

//Windows启动模式 
function WinBootMode:string; 
begin 
  case(GetSystemMetrics(SM_CLEANBOOT)) of 
   0:Result:='正常模式启动'; 
   1:Result:='安全模式启动'; 
   2:Result:='安全模式启动，但附带网络功能'; 
  else 
   Result:='错误：系统启动有问题。'; 
  end; 
end; 

////Windows ShutDown等 
procedure WinShutDown(ShutWinType:PShutType; PForce:Boolean); 
var 
 hToken, hProcess: THandle; 
 tp, prev_tp: TTokenPrivileges; 
 Len, Flags: DWORD; 
 CanShutdown: Boolean; 
begin 
 if Win32Platform = VER_PLATFORM_WIN32_NT then 
 begin 
  hProcess := OpenProcess(PROCESS_ALL_ACCESS, True, GetCurrentProcessID); 
  try 
   if not OpenProcessToken(hProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, 
hToken) then 
     Exit; 
  finally 
   CloseHandle(hProcess); 
  end; 
  try 
   if not LookupPrivilegeValue('', 'SeShutdownPrivilege', 
    tp.Privileges[0].Luid) then Exit; 
   tp.PrivilegeCount := 1; 
   tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; 
   if not AdjustTokenPrivileges(hToken, False, tp, SizeOf(prev_tp), 
    prev_tp, Len) then Exit; 
  finally 
   CloseHandle(hToken); 
  end; 
 end; 
 CanShutdown := True; 
// DoQueryShutdown(CanShutdown); 
 if not CanShutdown then Exit; 
 if PForce then Flags := EWX_FORCE else Flags := 0; 
 case ShutWinType of 
  UPowerOff: ExitWindowsEx(Flags or EWX_POWEROFF, 0); 
  UShutdown: ExitWindowsEx(Flags or EWX_SHUTDOWN, 0); 
  UReboot:  ExitWindowsEx(Flags or EWX_REBOOT, 0); 
  ULogoff:  ExitWindowsEx(Flags or EWX_LOGOFF, 0); 
  USuspend:  SetSystemPowerState(True, PForce); 
  UHibernate: SetSystemPowerState(False, PForce); 
 end; 
end; 


//▎============================================================▎// 
//▎=====================⑦硬件功能函数=========================▎// 
//▎============================================================▎// 

function GetClientGUID:string; 
var 
 myGuid:TGUID; 
 ResultStr:string; 
begin 
 CreateGuid(myGuid); 
 ResultStr:=GUIDToString(myGuid); 
 ResultStr:=Communal.Replace(ResultStr,'-','',False); 
 ResultStr:=Communal.Replace(ResultStr,'{','',False); 
 ResultStr:=Communal.Replace(ResultStr,'}','',False); 
 Result:=Substr(ResultStr,1,30); 
end; 

// 声卡是否存在 
function SoundCardExist: Boolean; 
begin 
 Result := WaveOutGetNumDevs > 0; 
end; 

//* 获取磁盘序列号 
function GetDiskSerial(DiskChar: Char): string; 
var 
  SerialNum : pdword; 
  a, b : dword; 
  Buffer : array [0..255] of char; 
begin 
  result := ''; 
  if GetVolumeInformation(PChar(diskchar+':\'), Buffer, SizeOf(Buffer), 
SerialNum,a, b, nil, 0) then 
   Result := IntToStr(SerialNum^); 
end; 

//*检查磁盘准备是否就绪 
function DiskReady(Root: string) : Boolean; 
var 
  Oem : CARDINAL ; 
  Dw1,Dw2 : DWORD ; 
begin 
  Oem := SetErrorMode( SEM_FAILCRITICALERRORS ) ; 
  if LENGTH(Root) = 1 then Root := Root + ':\'; 
   Result := GetVolumeInformation( PCHAR( Root ), NIL,0,NIL, Dw1,Dw2, NIL,0 ) ; 
  SetErrorMode( Oem ) ; 
end; 

//*检查驱动器A中磁盘的是否有文件及文件状态 
function DriveState (driveletter: Char) : TDriveState; 
var 
  mask: String[6]; 
  sRec: TSearchRec; 
  oldMode: Cardinal; 
  retcode: Integer; 
begin 
  oldMode := SetErrorMode(SEM_FAILCRITICALERRORS); 
  mask:= '?:\*.*'; 
  mask[1] := driveletter; 
  
  retcode := FindFirst (mask, faAnyfile, Srec); 
  FindClose(Srec); 
  
  case retcode of 
  0 : Result := DSDISK_WITHFILES; //磁盘有文件 
  -18 : Result := DSEMPTYDISK; //好的空磁盘 
  -21, -3: Result := DSNODISK; //NT,Win31的错误代号 
  else 
   Result := DSUNFORMATTEDDISK; 
  end; 
  SetErrorMode(oldMode); 
end; 

//写串口 
procedure WritePortB( wPort : Word; bValue : Byte ); 
begin 
  asm 
  mov dx, wPort 
  mov al, bValue 
  out dx, al 
  end; 
end; 

//读串口 
function ReadPortB( wPort : Word ):Byte; 
begin 
  asm 
  mov dx, wPort 
  in al, dx 
  mov result, al 
  end; 
end; 

//获知当前机器CPU的速率（MHz） 
function CPUSpeed: Double; 
const 
  DelayTime = 500; 
  var 
  TimerHi, TimerLo: DWORD; 
  PriorityClass, Priority: Integer; 
begin 
  PriorityClass := GetPriorityClass(GetCurrentProcess); 
  Priority := GetThreadPriority(GetCurrentThread); 
  SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS); 
  SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL); 
  Sleep(10); 
  asm 
  dw 310Fh 
  mov TimerLo, eax 
  mov TimerHi, edx 
  end; 
  Sleep(DelayTime); 
  asm 
  dw 310Fh 
  sub eax, TimerLo 
  sbb edx, TimerHi 
  mov TimerLo, eax 
  mov TimerHi, edx 
  end; 
  SetThreadPriority(GetCurrentThread, Priority); 
  SetPriorityClass(GetCurrentProcess, PriorityClass); 
  Result := TimerLo / (1000.0 * DelayTime); 
end; 

//获取CPU的标识ID号 
function GetCPUID : TCPUID; assembler; register; 
asm 
 PUSH  EBX     {Save affected register} 
 PUSH  EDI 
 MOV   EDI,EAX   
 MOV   EAX,1 
 DW   $A20F    {CPUID Command} 
 STOSD       
 MOV   EAX,EBX 
 STOSD        
 MOV   EAX,ECX 
 STOSD        
 MOV   EAX,EDX 
 STOSD        
 POP   EDI {Restore registers} 
 POP   EBX 
end; 

//获取计算机的物理内存 
function GetMemoryTotalPhys : Dword; 
var 
  memStatus: TMemoryStatus; 
begin 
  memStatus.dwLength := sizeOf ( memStatus ); 
  GlobalMemoryStatus ( memStatus ); 
  Result := memStatus.dwTotalPhys div 1024; 
end; 

//▎============================================================▎// 
//▎=====================⑧网络功能函数=========================▎// 
//▎============================================================▎// 

{* 获取网络计算机名称} 
function GetComputerName:string; 
var 
  wVersionRequested : WORD; 
  wsaData : TWSAData; 
  p : PHostEnt; s : array[0..128] of char; 
begin 
  try 
   wVersionRequested := MAKEWORD(1, 1); //创建 WinSock 
   WSAStartup(wVersionRequested, wsaData); //创建 WinSock 
   GetHostName(@s,128); 
   p:=GetHostByName(@s); 
   Result:=p^.h_Name; 
  finally 
   WSACleanup; //释放 WinSock 
  end; 
end; 

{* 获取计算机的IP地址} 
function GetHostIP:string; 
var 
  wVersionRequested : WORD; 
  wsaData : TWSAData; 
  p : PHostEnt; s : array[0..128] of char; p2 : pchar; 
begin 
  try 
   wVersionRequested := MAKEWORD(1, 1); //创建 WinSock 
   WSAStartup(wVersionRequested, wsaData); //创建 WinSock 
   GetHostName(@s,128); 
   p:=GetHostByName(@s); 
   p2 := iNet_ntoa(PInAddr(p^.h_addr_list^)^); 
   Result:= P2; 
  finally 
   WSACleanup; //释放 WinSock 
  end; 
end; 

//▎============================================================▎// 
//▎=====================⑨汉字拼音功能函数=====================▎// 
//▎============================================================▎// 
// 取汉字的拼音 
function GetHzPy(const AHzStr: string): string; 
const 
 ChinaCode: array[0..25, 0..1] of Integer = ((1601, 1636), (1637, 1832), (1833, 
2077), 
  (2078, 2273), (2274, 2301), (2302, 2432), (2433, 2593), (2594, 2786), (9999, 
0000), 
  (2787, 3105), (3106, 3211), (3212, 3471), (3472, 3634), (3635, 3722), (3723, 
3729), 
  (3730, 3857), (3858, 4026), (4027, 4085), (4086, 4389), (4390, 4557), (9999, 
0000), 
  (9999, 0000), (4558, 4683), (4684, 4924), (4925, 5248), (5249, 5589)); 
var 
 i, j, HzOrd: Integer; 
begin 
 Result:=''; 
 i := 1; 
 while i <= Length(AHzStr) do 
 begin 
  if (AHzStr[i] >= #160) and (AHzStr[i + 1] >= #160) then 
  begin 
   HzOrd := (Ord(AHzStr[i]) - 160) * 100 + ord(AHzStr[i + 1]) - 160; 
   for j := 0 to 25 do 
   begin 
    if (HzOrd >= ChinaCode[j][0]) and (HzOrd <= ChinaCode[j][1]) then 
    begin 
     Result := Result + Char(Byte('A') + j); 
     Break; 
    end; 
   end; 
   Inc(i); 
  end else Result := Result + AHzStr[i]; 
  Inc(i); 
 end; 
end; 

{* 判断一个字符串中有多少各汉字} 
function HowManyChineseChar(Const s:String):Integer; 
var 
  SW:WideString; 
  C:String; 
  i, WCount:Integer; 
begin 
  SW:=s; 
  WCount:=0; 
  For i:=1 to Length(SW) do 
  begin 
   c:=SW[i]; 
   if Length(c)>1 then 
     Inc(WCount); 
  end; 
  Resu