{------------------------------------------------------------------------------} {ÏîÄ¿Ãû³Æ£º¹«¹²ÏîÄ¿ } {µ¥ÔªÃû³Æ£ºPubUtils.pas } {°æ±¾°æ´Î£º3.3 } {Ä£¿éÃû³Æ£ºÈ«¾Ö¹«¹²º¯Êý¿â } {¹¦ÄÜÃèÊö£ºÎ¬»¤Í¨Óù«¹²º¯Êýµ÷Óà } {½¨Á¢ÈÕÆÚ£º2011-01-01 } {ÐÞ¸ÄÐ޸ģº2025-02-12 } {°æȨËùÓУºÀîÁ¼Í¥ } {------------------------------------------------------------------------------} //2011-10-26 ÐÂÔöComboBox_XPMan_KeyPressº¯Êý,½â¾öComboBox¿Ø¼þÊäÈëÂÒÂëÎÊÌâ, // ÔÚKeyPressʼþÖÐÖ´ÐÐComboBox_XPMan_KeyPress¼´¿É½â¾ö¡£ //2015-12-01 ÐÂÔöBase16Encode¡¢Base16Decode¡¢Delay¡¢GetVersionInfoµÈ¹¦Äܺ¯Êý¡£ //2015-12-24 ÐÂÔöExcel²Ù×÷º¯Êý£¬Ê¹ÓÃADO·½Ê½Á¬½ÓExcelÎļþ¶Áд¡£ //2017-10-15 ÐÂÔöÆÁÄ»½Øͼ±£´æΪpngÎļþ£¬´«ÈëÎļþ·¾¶£¬¾²Ä¬±£´æÖÁ±¾µØ£¬Ê¹ÓÃTpngimage×é¼þ. //2018-04-01 ÐÂÔö¸ù¾Ý³ÌÐòÃû³Æ»ñÈ¡¾ä±úµÄ·½·¨£¬Ö§³Ö¿ç½ø³Ì·¢ËÍÏûÏ¢¡£ //2018-10-20 ΪÊý²É¿ª·¢Æ½Ì¨ÐÂÔöDllµ÷Óú¯Êý¡£ //2018-10-30 ÓÅ»¯¹«¹²º¯Êý¿â£¬È¥µô²¿·ÖÖظ´º¯Êý¡£ //2019-01-17 »ùÓÚDateUtils¿â£¬À©³ä DateTimeToUnix()º¯Êý£¬¼õ8Сʱ±ä³É¸ñÁÖÍþÖÎʱ¼ä //2022-09-20 Ôö¼Ó¿Æѧ¼ÆÊý·¨ºÍ¸¡µãÐÍÊý×Ö»¥×ª£¬ÊäÈëÊä³ö¾ùʹÓÃstringÀàÐÍ¡£ //2023-11-01 Ôö¼Ó¼ì²é´®¿ÚÊÇ·ñ´æÔڵĺ¯Êý¡£ //2025-02-12 Ôö¼ÓÕûÐÎתΪ²¼¶ûÖµµÄº¯Êý¡£ unit PubUtils; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, Masks, Math, ShellApi, ShlObj, ComObj, ActiveX, Registry, Dialogs, StrUtils, Printers, Winsock, TLHelp32, PsAPI, DateUtils, Global; // ×Ö·û´®Ïà¹Ø function IsInt(const S: string): Boolean; function IsFloat(const S: string): Boolean; function IsEmail(const S: string): Boolean; function PathWithSlash(const Path: string): string; function PathWithoutSlash(const Path: string): string; function CombineFileName(const Path, FileName: string): string; function FileExtWithDot(const FileExt: string): string; function FileExtWithoutDot(const FileExt: string): string; function AddNumberComma(Number: Int64): string; function ExtractFileMainName(const FileName: string): string; function ExtractUrlFilePath(const Url: string): string; function ExtractUrlFileName(const Url: string): string; function ValidateFileName(const FileName: string): string; function GetSizeString(Bytes: Int64; const Postfix: string = ' KB'): string; function GetPercentString(Position, Max: Int64; const Postfix: string = ' %'): string; function RestrictStrWidth(const S: WideString; Canvas: TCanvas; Width: Integer; const Suffix: string = '...'): WideString; function RestrictFileNameWidth(const FileName: string; MaxBytes: Integer): string; function LikeString(Value, Pattern: WideString; CaseInsensitive: Boolean): Boolean; procedure SplitString(S: string; Delimiter: Char; List: TStrings); function StartWith(const Source: string; const Left: string): Boolean; function EndWith(const Source: string; const Right: string): Boolean; function MyPos(c: Char; const str: string): Integer; // ϵͳÏà¹Ø function GetComputerName: string; function GetWinUserName: string; function GetWindowsDir: string; function GetWinTempDir: string; function GetWinTempFile(const PrefixStr: string = ''): string; function GetFullFileName(const FileName: string): string; function GetShortFileName(const FileName: string): string; function GetLongFileName(const FileName: string): string; function GetSpecialFolder(FolderID: Integer): string; function GetQuickLaunchPath: string; function GetSystemDrivePath: string; function GetEnvVar(const EnvVar: string): string; function GetWorkAreaRect: TRect; function SelectDir(ParentHWnd: HWND; const Caption: string; const Root: WideString; var Path: string): Boolean; function ExecuteFile(const FileName, Params, DefaultDir: string; ShowCmd: Integer): HWND; function OpenURL(const URL: string): Boolean; function OpenEmail(const Email: string): Boolean; procedure SetStayOnTop(Form : TCustomForm; StayOnTop: Boolean); procedure HideAppFromTaskBar; function CheckLangChinesePR: Boolean; function ShutdownWindows: Boolean; function RebootWindows: Boolean; function GetMouseCursorPos: TPoint; function CreateShortCut(const OriginalFileName, ShortcutFileName, Arguments, WorkingDir, Description: string; ShowCmd: Integer; IsFolderShortcut: Boolean): Boolean; // ÎļþÏà¹Ø function GetFileSize(const FileName: string): Int64; function GetFolderSize(FolderName: string): Int64; function GetFileDate(const FileName: string): TDateTime; function SetFileDate(const FileName: string; CreationTime, LastWriteTime, LastAccessTime: TFileTime): Boolean; function CopyFileToFolder(FileName, BackupFolder: string): Boolean; function AutoRenameFileName(const FullName: string): string; function GetTempFileAtPath(const Path: string; const PrefixStr: string = ''): string; function IsFileReadOnly(const FileName: string): Boolean; function DeleteFileToRecycle(const FileName: string): Boolean; procedure DeleteFileEx(FileName:string); function DeleteDirectory(const Dir: string): Boolean; function IsEmptyDir(sDir: String): Boolean; function ReadFile(const sFile:String):String; //¶ÁÎı¾Îļþ,liliangting 2016-01-18 function ReadLogFile(const sFile:String):String; //¶ÁÎı¾Îļþ,liliangting 2016-01-18 procedure WriteLogFile(const sFile,sMsg: string); //дÎı¾Îļþ,liliangting 2016-01-18 // ×¢²á±íÏà¹Ø, Ôö¼Ó×¢²á±í¶Áдº¯Êý function SetAutoRunOnStartup(AutoRun, CurrentUser: Boolean; AppTitle: string = ''; AppName: string = ''; AppPara: string = ''): Boolean; procedure AutoRun(Flag: Boolean; title:String); function ReadReg(const Name: String; CurrentUser: Boolean=true):String; function WriteReg(const Name,Value: String; CurrentUser: Boolean=true):Boolean; function AssociateFile(const FileExt, FileKey, SoftName, FileDesc: string; IconIndex: Integer = 0; Flush: Boolean = False): Boolean; function SaveAppPath(const CompanyName, SoftName, Version: string): Boolean; function ReadAppPath(const CompanyName, SoftName, Version: string; var Path: string): Boolean; // ÈÕÆÚʱ¼äÏà¹Ø function FileTimeToLocalSystemTime(FTime: TFileTime): TSystemTime; function LocalSystemTimeToFileTime(STime: TSystemTime): TFileTime; function GetDatePart(DateTime: TDateTime): TDate; function GetTimePart(DateTime: TDateTime): TTime; //»ñÈ¡Ó²¼þÐÅϢģ¿é function GetCPUIDStr:String; //»ñÈ¡CPUID²¢Êä³ö×Ö·û´® function GetMacAddress: string; //»ñÈ¡Íø¿¨MACµØÖ· function GetMemUse: Cardinal; //»ñÈ¡ÄÚ´æʹÓÃÁ¿ // ÆäËüº¯Êý procedure BeginWait; procedure EndWait; function Iif(Value: Boolean; Value1, Value2: Variant): Variant; function Min(V1, V2: Integer): Integer; function Max(V1, V2: Integer): Integer; function TrimValue(Value, Min, Max: Integer): Integer; procedure Swap(var V1, V2: Integer); function GetTickDiff(const OldTickCount, NewTickCount: Cardinal): Cardinal; function RestrictRectInScr(Rect: TRect; AllVisible: Boolean): TRect; function GetModulePath: string; function GetModuleSubPath(const SubFolder: string = ''): string; function GetAppPath: string; function GetAppSubPath(const SubFolder: string = ''): string; function GetRectWidth(const R: TRect): Integer; function GetRectHeight(const R: TRect): Integer; procedure DrawStrokedText(Canvas: TCanvas; X, Y: Integer; const Text: string; FontColor, StrokedColor, SmoothColor: TColor); //ϵͳBugÐÞÕý function GetScreenWidth:Integer; //»ñÈ¡ÆÁÄ»¿í¶ÈºÍ¸ß¶È£¬¼´·Ö±æÂÊ function GetScreenHeight:Integer; function GetDesktopWidth:Integer; //»ñÈ¡×ÀÃæ¿í¶ÈºÍ¸ß¶È function GetDesktopHeight:Integer; function IsBigInt(const S:String): Boolean; //2012-04-12Ôö¼Ó function IsNTSystem:Boolean; //ÅжÏÊÇ·ñNTϵͳ procedure ComboBox_XPMan_KeyPress(Sender:TObject;var Key: Char);//ÐÞÕýÏÂÀ­Ñ¡Ôñ¿òÊäÈëÂÒÂë Function formatNum(Number, Length: Integer): string; //À©Õ¹²¢×ª»»×Ö·û³¤¶È Function Q(s1:string):string; //¼Óµ¥ÒýºÅ procedure Delay(MSecs: Longint); //ÎÞË¢ÐÂÑÓʱº¯Êý procedure PreparePrinter(Width,Height:Integer); //×Ô¶¨ÒåÖ½ÕÅ´òÓ¡³ÌÐò procedure DeleteMe; procedure SetSystemDateFormat(sFormat:string='yyyy-MM-dd'); //ÉèÖÃϵͳÈÕÆÚ¸ñʽ //ÆäËûº¯Êý£¬liliangting 2015-12-01 function Base16Encode(const Src: AnsiString): AnsiString; //Base±àÂë×Ö·û´® function Base16Decode(const Src: AnsiString): AnsiString; //Base½âÂë×Ö·û´® function GetGUID:string; //×Ô¶¯Éú³ÉÒ»ÌõGUID procedure Delay1(MSecs: Longint); //¶¨Ê±Æ÷1 procedure Delay2(MSecs: Longint); //¶¨Ê±Æ÷2 procedure GetVersionInfo(AppExeName:string); procedure EnumComPorts(Ports: TStrings); //ö¾ÙϵͳCOM¿Ú function CheckComPort(ComPortName: string; var ComPortList: Tstrings): boolean; function StrToHexStr(const S:string):string; //×Ö·û´®×ª16½øÖÆ×Ö·û´® function StrToHexStr1(const S:string):string; function HexStrToStr(const S:string; bFlag:boolean=false):string; //16½øÖÆ×Ö·û´®×ªASCII(Ö§³ÖÖÐÓ¢ÎÄ) function GetMemBytes(var X; size: Integer): string; //ÒÔÊ®Áù½øÖÆ·½Ê½²é¿´ÄÚ´æµÄº¯Êý procedure GetFileList(FilePath, ExtMask: string; FileList: TStrings; SubDir: Boolean = True); procedure GetFileListEx(FilePath, ExtMask: string; FileList: TStrings; SubDir: Boolean = True); function DeleteDir(Path: string;IsDelDir: Boolean = False): Boolean; //Excelº¯Êý£¬liliangting 2015-12-24 function GetInstalledWordVersion: Integer; //»ñÈ¡Office°æ±¾ function RandomNum:String; //Éú³É18λËæ»úÊý //TStringList×Ô¶¨ÒåÅÅÐò²ÎÊý£¬liliangting 2017-9-1 function SortParam(List: TStringList; Index1, Index2: Integer): Integer; function RoundEx(const Value: Extended; const Digit: Byte = 0): Extended; //´øÖÐÎĵÄStringתbyte function UniCode2GB(S: string): string; function GB2UniCode(GB: string): string; //ÖØдBoolToStrº¯Êý£¬True-1£¬liliangting 2022-11-14 function BoolToHexStr(B: Boolean; UseBoolStrs: Boolean = False): string; function BoolToString(B: Boolean; UseBoolStrs: Boolean = False): string; function BoolToString1(B: Boolean; UseBoolStrs: Boolean = False): string; function BoolToString2(B: Boolean; UseBoolStrs: Boolean = False): string; function BoolToString3(B: Boolean; UseBoolStrs: Boolean = False): string; function BoolToString4(B: Boolean; UseBoolStrs: Boolean = False): string; //Int-->boolean£¬0-False£¬ÆäËû-True£¬liliangting 2025-02-12 function IntToBool(AValue: Integer): Boolean; //½«ÈÕÆÚ¸ñʽת»»³ÉUnixʱ¼ä´Á , ³¤¶È8×Ö½Ú£¬liliangting 2017-10-19 function DateTimeToUnixDate(const ADate: TDateTime): Longint; //½«Êýֵת³ÉKB¡¢MB¡¢GB function FormatFileSize(size:Int64):String; //½«Êýֵת³É#.##Íò¡¢#.##ÒÚ function FormatNumberSize(num:Int64):String; function SplitStr(str:string;chr:char;i:Integer):string; function SplitStrCount(str:string; chr:char):Integer; //windowsɱ½ø³ÌµÄÁ½ÖÖ·½·¨ procedure KillProgram(WindowTitle: string); function KillTask(ExeFileName: string): integer; //Ë¢ÐÂÈÎÎñÀ¸Í¼±êµÄÁ½ÖÖ·½·¨ procedure RefreshTaskbarIcon; procedure RefreshTaskbarIcon2; //Ç¿ÐйرռÆËã»úϵͳµÄ·½·¨£¬liliangting 2018-1-4 function GetOperatingSystem(): string; //¿ç½ø³Ì´«µÝÏûÏ¢µÄ¹ý³Ì·½·¨£¬liliangting 2018-04-01 function GetHWndByPID(const hPID: THandle): THandle; function GetHwndByAppName(const AppName: String): THandle; //----------------------------------------------------------------------------- //Êý²É¿ª·¢Æ½Ì¨×¨Ó÷½·¨ //liliangting 2018-10-20 //----------------------------------------------------------------------------- //·â×°µÄ¶¯Ì¬Dllº¯Êýµ÷Ó÷½·¨ function CallFunc(dllname,funcname:string; const param:array of const):DWORD; //ͨÓÃDllµ÷Ó÷½·¨ function PingHost(HostIP: String): Boolean; //ping²âÊÔÍøÂç function SecondToTime(sec:Integer):String; //Ãëתʱ¼ä×Ö·û´® function SecondToTime1(second: Word): TDateTime; //Ãëתʱ¼ä //À©³äDateUtils¿â£¬Ôö¼Ó±±¾©Ê±¼äתInt64ʱ¼ä¸ñʽ£¬×¢Òâ¼õȥʱÇø function DateTimeToUnixPro(const AValue: TDateTime): Int64; function UnixToDateTimePro(const AValue: Int64): TDateTime; //¿Æѧ¼ÆÊýÓ븡µãÐÍÊý»¥×ª£¬'-1.4857E-02' <--> '-0.014857' function ExpToFloat(s:String):String; function FloatToExp(s:String):String; //------ ¼¸ÖÖ²åÖµËã·¨ --------------------------------------------------------- function LinearInterpolation(x0, y0, x1, y1, x: Double): Double; //ÏßÐÔ²åÖµËã·¨ function LagrangeInterpolation(x, y: array of Double; n: Integer; xi: Double): Double; //À­¸ñÀÊÈÕ²åÖµËã·¨ function NewtonInterpolation(x, fx: array of Double; n: Integer; t: Double): Double; //Å£¶Ù²åÖµËã·¨ function LeastSquaresInterpolation(x, y: array of Double; n: Integer; t: Double): Double;//×îС¶þ³Ë·¨²åÖµËã·¨ function BayesianInterpolation(x,y: array of Double; xi: Double; sigma: Double): Double; //±´Ò¶Ë¹²åÖµËã·¨ //----------------------------------------------------------------------------- function GetMillisecondTimeStamp: Int64; function SwapHighLowWord(Value: Word): Word; implementation {$WARN SYMBOL_PLATFORM OFF} {$WARN SYMBOL_DEPRECATED OFF} type TCPUID = array[1..4] of Longint;//ʹÓÃCPUÄÚÖÃÖ¸Áî»ñÈ¡CPU±àºÅµÄ¶þ½øÖÆ //----------------------------------------------------------------------------- // ÃèÊö: ÅжÏ×Ö·û´® S ÊDz»ÊÇÒ»¸öÕûÐÍÊý×Ö //----------------------------------------------------------------------------- function IsInt(const S: string): Boolean; var E, R: Integer; begin Val(S, R, E); Result := E = 0; E := R; // avoid hints end; //----------------------------------------------------------------------------- // ÃèÊö: ÅжÏ×Ö·û´® S ÊDz»ÊÇÒ»¸ö¸¡µãÐÍÊý×Ö //----------------------------------------------------------------------------- function IsFloat(const S: string): boolean; var V: Extended; begin Result := TextToFloat(PChar(S), V, fvExtended); end; //----------------------------------------------------------------------------- // ÃèÊö: ÅжÏ×Ö·û´® S ÊDz»ÊÇÒ»¸ö Email µØÖ· //----------------------------------------------------------------------------- function IsEmail(const S: string): Boolean; begin Result := True; if Pos('@', S) = 0 then Result := False; if Pos('.', S) = 0 then Result := False; end; //----------------------------------------------------------------------------- // ÃèÊö: ²¹È«Â·¾¶×Ö·û´®ºóÃæµÄ "\" //----------------------------------------------------------------------------- function PathWithSlash(const Path: string): string; begin Result := Trim(Path); if Length(Result) > 0 then Result := IncludeTrailingPathDelimiter(Result); end; //----------------------------------------------------------------------------- // ÃèÊö: È¥µô·¾¶×Ö·û´®ºóÃæµÄ "\" //----------------------------------------------------------------------------- function PathWithoutSlash(const Path: string): string; begin Result := Trim(Path); if Length(Result) > 0 then Result := ExcludeTrailingPathDelimiter(Result); end; //----------------------------------------------------------------------------- // ÃèÊö: ½«Â·¾¶ºÍÎļþÃû×éºÏÔÚÒ»Æð //----------------------------------------------------------------------------- function CombineFileName(const Path, FileName: string): string; begin Result := PathWithSlash(Path) + FileName; end; //----------------------------------------------------------------------------- // ÃèÊö: ²¹È«ÎļþÀ©Õ¹ÃûÇ°ÃæµÄ "." //----------------------------------------------------------------------------- function FileExtWithDot(const FileExt: string): string; begin Result := FileExt; if Length(Result) > 0 then if Copy(Result, 1, 1) <> '.' then Result := '.' + Result; end; //----------------------------------------------------------------------------- // ÃèÊö: È¥µôÎļþÀ©Õ¹ÃûÇ°ÃæµÄ "." //----------------------------------------------------------------------------- function FileExtWithoutDot(const FileExt: string): string; begin Result := FileExt; if Length(Result) > 0 then if Copy(Result, 1, 1) = '.' then Delete(Result, 1, 1); end; //----------------------------------------------------------------------------- // ÃèÊö: ¸øÊý×Ö¼ÓÉÏ·Ö¸ô¶ººÅ // ʾÀý: 1234567 -> 1,234,567 //----------------------------------------------------------------------------- function AddNumberComma(Number: Int64): string; var Temp: Double; begin Temp := Number; Result := Format('%.0n', [Temp]); end; //----------------------------------------------------------------------------- // ÃèÊö: È¡µÃÎļþÃûµÄÖ÷ÎļþÃû // ʾÀý: "C:\test.dat" -> "test" //----------------------------------------------------------------------------- function ExtractFileMainName(const FileName: string): string; var Ext: string; begin Ext := ExtractFileExt(FileName); Result := ExtractFileName(FileName); Result := Copy(Result, 1, Length(Result) - Length(Ext)); end; //----------------------------------------------------------------------------- // ÃèÊö: ·µ»ØURLÖеÄÎļþ·¾¶ // ʾÀý: // ExtractUrlFileName('http://www.download.com/file.zip'); // ´Ëµ÷Óý«·µ»Ø 'http://www.download.com/'. //----------------------------------------------------------------------------- function ExtractUrlFilePath(const Url: string): string; var I: Integer; begin I := LastDelimiter('/\:', Url); Result := Copy(Url, 1, I); end; //----------------------------------------------------------------------------- // ÃèÊö: ·µ»ØURLÖеÄÎļþÃû // ʾÀý: // ExtractUrlFileName('http://www.download.com/file.zip'); // ´Ëµ÷Óý«·µ»Ø 'file.zip'. //----------------------------------------------------------------------------- function ExtractUrlFileName(const Url: string): string; var I: Integer; begin I := LastDelimiter('/\:', Url); Result := Copy(Url, I + 1, MaxInt); end; //----------------------------------------------------------------------------- // ÃèÊö: È¥µôÎļþÃûÖв»ºÏ·¨µÄ×Ö·û // ʾÀý: "tes*t.dat?" -> "test.dat" //----------------------------------------------------------------------------- function ValidateFileName(const FileName: string): string; var I: Integer; begin Result := ''; for I := 1 to Length(FileName) do begin if not (AnsiChar(FileName[I]) in ['\', '/', ':', '*', '?', '"', '<', '>', '|']) and not (Ord(FileName[I]) < 32) then Result := Result + FileName[I]; end; end; //----------------------------------------------------------------------------- // ÃèÊö: È¡µÃÒ»¸öÓÃÀ´ÃèÊö×Ö½ÚÊýµÄ×Ö·û´® // ²ÎÊý: // Bytes - ×Ö½ÚÊý // Postfix - µ¥Î»ºó׺£¬È±Ê¡Îª " KB" //----------------------------------------------------------------------------- function GetSizeString(Bytes: Int64; const Postfix: string): string; var Temp: Double; begin if Bytes > 0 then begin Temp := Bytes div 1024; if Bytes mod 1024 <> 0 then Temp := Temp + 1; end else Temp := 0; Result := Format('%s%s', [Format('%.0n', [Temp]), Postfix]); end; //----------------------------------------------------------------------------- // ÃèÊö: È¡µÃÒ»¸öÓÃÀ´ÃèÊö°Ù·Ö±ÈµÄ×Ö·û´® // ²ÎÊý: // Position, Max - µ±Ç°Öµ ºÍ ×î´óÖµ // Postfix - ºó׺×Ö·û´®£¬È±Ê¡Îª " %" //----------------------------------------------------------------------------- function GetPercentString(Position, Max: Int64; const Postfix: string): string; begin if Max > 0 then Result := IntToStr(Trunc((Position / Max) * 100)) + Postfix else Result := '100' + Postfix; end; //----------------------------------------------------------------------------- // ÃèÊö: Ëõ¶Ì×Ö·û´®µÄ³¤¶ÈÒÔÊÊÓ¦ÏÔʾ¿í¶È // ²ÎÊý: // S - ´ýËõ¶ÌµÄ×Ö·û´®. // Canvas - ×Ö·û´®ËùÔÚµÄCanvas. // Width - ×î´óÏóËØ¿í¶È // Suffix - Èç¹û×Ö·û´®±»½Ø¶Ï£¬ÔòÌí¼Óʲôºó׺ // ·µ»Ø: // Ëõ¶ÌÖ®ºóµÄ×Ö·û´® //----------------------------------------------------------------------------- function RestrictStrWidth(const S: WideString; Canvas: TCanvas; Width: Integer; const Suffix: string): WideString; var Src: WideString; begin Src := S; Result := S; while (Canvas.TextWidth(Result) > Width) and (Length(Result) > 0) do begin if Length(Src) > 1 then begin Delete(Src, Length(Src), 1); Result := Src + Suffix; end else Delete(Result, Length(Result), 1); end; end; //----------------------------------------------------------------------------- // ÃèÊö: Ëõ¶ÌÎļþÃûµÄ³¤¶ÈÒÔÊÊÓ¦×î´ó×Ö½ÚÊýÏÞÖÆ // ²ÎÊý: // FileName - ´ýËõ¶ÌµÄÎļþÃû(¿ÉÒÔ°üº¬Â·¾¶) // MaxBytes - ×î´ó×Ö½ÚÊý // ·µ»Ø: // Ëõ¶ÌÖ®ºóµÄÎļþÃû×Ö·û´® //----------------------------------------------------------------------------- function RestrictFileNameWidth(const FileName: string; MaxBytes: Integer): string; function GetBytes(const S: WideString): Integer; var AnsiStr: string; begin AnsiStr := S; Result := Length(AnsiStr); end; var MainName, NewMainName: WideString; Ext: string; ExtLen: Integer; begin if Length(FileName) <= MaxBytes then begin Result := FileName; end else begin Ext := ExtractFileExt(FileName); MainName := Copy(FileName, 1, Length(FileName) - Length(Ext)); ExtLen := Length(Ext); NewMainName := MainName; while (GetBytes(NewMainName) + ExtLen > MaxBytes) and (Length(NewMainName) > 0) do begin if Length(MainName) > 1 then begin Delete(MainName, Length(MainName), 1); NewMainName := MainName + '...'; end else Delete(NewMainName, Length(NewMainName), 1); end; Result := NewMainName + Ext; if Length(Result) > MaxBytes then Result := Copy(Result, 1, MaxBytes); end; end; //----------------------------------------------------------------------------- // ÃèÊö£º¼ÆËãͨÅä·û±í´ïʽ£¬Ö§³ÖͨÅä·û'*' ºÍ '?' // ²ÎÊý£º // Value - ĸ´® // Pattern - ×Ó´® // CaseInsensitive - ÊÇ·ñºöÂÔ´óСд // ·µ»Ø£º // True - Æ¥Åä // False - ²»Æ¥Åä // ʾÀý£º // LikeString('abcdefg', 'abc*', True); //----------------------------------------------------------------------------- function LikeString(Value, Pattern: WideString; CaseInsensitive: Boolean): Boolean; const MultiWildChar = '*'; SingleWildChar = '?'; var ValuePtr, PatternPtr: PWideChar; I: Integer; B: Boolean; begin ValuePtr := PWideChar(Value); PatternPtr := PWideChar(Pattern); while True do begin if (CompareStringW(LOCALE_USER_DEFAULT, NORM_IGNORECASE + SORT_STRINGSORT, PatternPtr, Length(PatternPtr), WideChar(MultiWildChar), 1) - 2 = 0) then begin Result := True; Exit; end else if (ValuePtr^ = #0) and (PatternPtr^ <> #0) then begin Result := False; Exit; end else if (ValuePtr^ = #0) then begin Result := True; Exit; end else begin case PatternPtr^ of MultiWildChar: begin for I := 0 to Length(ValuePtr) - 1 do begin if LikeString(ValuePtr + I, PatternPtr + 1, CaseInsensitive) then begin Result := True; Exit; end; end; Result := False; Exit; end; SingleWildChar: begin Inc(ValuePtr); Inc(PatternPtr); end; else begin B := False; if CaseInsensitive then begin if (CompareStringW(LOCALE_USER_DEFAULT, NORM_IGNORECASE + SORT_STRINGSORT, PatternPtr, 1, ValuePtr, 1) - 2 = 0) then B := True; end else begin if (CompareStringW(LOCALE_USER_DEFAULT, SORT_STRINGSORT, PatternPtr, 1, ValuePtr, 1) - 2 = 0) then B := True; end; if B then begin Inc(ValuePtr); Inc(PatternPtr); end else begin Result := False; Exit; end; end; end; // case end; end; end; //----------------------------------------------------------------------------- // ÃèÊö: ·Ö¸î×Ö·û´® //----------------------------------------------------------------------------- procedure SplitString(S: string; Delimiter: Char; List: TStrings); var I: Integer; begin List.Clear; while Length(S) > 0 do begin I := Pos(Delimiter, S); if I > 0 then begin List.Add(Copy(S, 1, I - 1)); Delete(S, 1, I); end else begin List.Add(S); Break; end; end; end; //----------------------------------------------------------------------------- // ÃèÊö: ÅжÏ×Ö·û´® Source ÊDz»ÊÇÒÔ Left ¿ªÊ¼ //----------------------------------------------------------------------------- function StartWith(const Source: string; const Left: string): Boolean; var Start: string; Len: Integer; begin Len := Length(Left); if (Source = '') or (Left = '') or (Length(Source) < Len) then begin Result := False; end else begin Start := Copy(Source, 1, Len); Result := Start = Left; end; end; //----------------------------------------------------------------------------- // ÃèÊö: ÅжÏ×Ö·û´® Source ÊDz»ÊÇÒÔ Right ½áÊø //----------------------------------------------------------------------------- function EndWith(const Source: string; const Right: string): Boolean; var EndStr: string; RightLen: Integer; SourceLen: Integer; begin RightLen := Length(Right); SourceLen := Length(Source); if (Source = '') or (Right = '') or (SourceLen < RightLen) then begin Result := False; end else begin EndStr := Copy(Source, SourceLen - RightLen + 1, RightLen); Result := EndStr = Right; end; end; //------------------------------------------------------------------------------ // ÃèÊö£ºPos º¯Êý£¬·µ»Ø²éÕÒ×Ö·û³öÏÖ´ÎÊý //------------------------------------------------------------------------------ function MyPos(c: Char; const str: string): Integer; var i,j: Integer; begin j := 0; for i := 1 to Length(str) do if c = str[i] then inc(j); Result:=j; end; //----------------------------------------------------------------------------- // ÃèÊö: È¡µÃ¼ÆËã»úÃû //----------------------------------------------------------------------------- function GetComputerName: string; const MaxSize = 256; var Buffer: array[0..MaxSize-1] of Char; Size: Cardinal; begin Size := MaxSize; Windows.GetComputerName(PChar(@Buffer[0]), Size); Result := Buffer; end; //----------------------------------------------------------------------------- // ÃèÊö: È¡µÃµ±Ç°ÏµÍ³Óû§Ãû //----------------------------------------------------------------------------- function GetWinUserName: string; const Size = 255; var Buffer: array[0..Size] of Char; Len: DWord; begin Len := Size; GetUserName(Buffer, Len); Result := Buffer; end; //----------------------------------------------------------------------------- // ÃèÊö: È¡µÃ Windows Ŀ¼ //----------------------------------------------------------------------------- function GetWindowsDir: string; var Buffer: array[0..MAX_PATH] of Char; begin GetWindowsDirectory(Buffer, MAX_PATH); Result := PathWithSlash(Buffer); end; //----------------------------------------------------------------------------- // ÃèÊö: È¡µÃϵͳÁÙʱÎļþĿ¼ //----------------------------------------------------------------------------- function GetWinTempDir: string; const Size = 1024; var Buffer: array[0..Size] of Char; LongName: string; begin GetTempPath(Size, Buffer); Result := PathWithSlash(Buffer); LongName := GetLongFileName(Result); if Length(LongName) >= Length(Result) then Result := LongName; end; //----------------------------------------------------------------------------- // ÃèÊö: È¡µÃÒ»¸öÁÙʱÎļþÃû(·¾¶ÎªÏµÍ³ÁÙʱĿ¼) // ²ÎÊý: // PrefixStr - ÎļþÃûǰ׺£¬Ç°Èý¸ö×Ö·ûÓÐЧ //----------------------------------------------------------------------------- function GetWinTempFile(const PrefixStr: string): string; var FileName: array[0..MAX_PATH] of Char; LongName: string; begin Windows.GetTempFileName(PChar(GetWinTempDir), PChar(PrefixStr), 0, FileName); Result := FileName; LongName := GetLongFileName(Result); if Length(LongName) >= Length(Result) then Result := LongName; end; //----------------------------------------------------------------------------- // ÃèÊö: ÎļþµÄÈ«Ãû(°üº¬Â·¾¶) // ʾÀý: // "test.dat" -> "C:\test.dat" // "C:\a\..\test.dat" -> "C:\test.dat" //----------------------------------------------------------------------------- function GetFullFileName(const FileName: string): string; const Size = 1024; var Buffer: array[0..Size] of Char; FileNamePtr: PChar; Len: DWord; begin Len := Size; GetFullPathName(PChar(FileName), Len, Buffer, FileNamePtr); Result := Buffer; end; //----------------------------------------------------------------------------- // ÃèÊö: ³¤ÎļþÃû -> ¶ÌÎļþÃû(8.3) // ±¸×¢: FileName ¿ÉÒÔÊÇ·¾¶£¬Ò²¿ÉÒÔÊÇÎļþÃû¡£ // ʾÀý: // "C:\Program Files" -> "C:\PROGRA~1" //----------------------------------------------------------------------------- function GetShortFileName(const FileName: string): string; const Size = 1024; var Buffer: array[0..Size] of Char; begin GetShortPathName(PChar(FileName), Buffer, Size); Result := Buffer; end; //----------------------------------------------------------------------------- // ÃèÊö: ¶ÌÎļþÃû(8.3) -> ³¤ÎļþÃû // ±¸×¢: FileName ¿ÉÒÔÊÇ·¾¶£¬Ò²¿ÉÒÔÊÇÎļþÃû¡£ // ʾÀý: // "C:\PROGRA~1\COMMON~1\" -> "C:\Program Files\Common Files\" //----------------------------------------------------------------------------- function GetLongFileName(const FileName: string): string; var Name, S: string; SearchRec : TSearchRec; begin S := ExcludeTrailingPathDelimiter(FileName); if (Length(S) < 3) or (ExtractFilePath(S) = S) then begin Result := FileName; Exit; end; if FindFirst(S, faAnyFile, SearchRec) = 0 then Name := SearchRec.Name else Name := ExtractFileName(S); FindClose(SearchRec); Result := GetLongFileName(ExtractFilePath(S)) + Name; if Length(S) <> Length(FileName) then Result := Result + '\'; end; //----------------------------------------------------------------------------- // ÃèÊö: È¡µÃÌØÊâÎļþ¼Ð·¾¶ // ²ÎÊý: // FolderID - // CSIDL_DESKTOP // CSIDL_PROGRAMS // CSIDL_RECENT // CSIDL_SENDTO // CSIDL_STARTMENU // CSIDL_STARTUP // CSIDL_TEMPLATES // CSIDL_APPDATA // ·µ»Ø: // Èô³É¹¦£¬·µ»Ø´ø×îºóбÏß(\)µÄ·¾¶£» // Èôʧ°Ü£¬·µ»Ø¿Õ×Ö·û´®¡£ // ±¸×¢: // ÈôҪȡ"¿ìËÙÆô¶¯"µÄ·¾¶£¬¿É: // GetSpecialFolder(CSIDL_APPDATA) + 'Microsoft\Internet Explorer\Quick Launch\'. //----------------------------------------------------------------------------- function GetSpecialFolder(FolderID: Integer): string; var PidL: PItemIDList; Buffer: array[0..MAX_PATH] of Char; Malloc: IMalloc; begin Result := ''; if Failed(SHGetMalloc(Malloc)) then Malloc := nil; if Succeeded(SHGetSpecialFolderLocation(0, FolderID, PidL)) then begin if SHGetPathFromIDList(PidL, Buffer) then Result := Buffer; if Assigned(Malloc) then Malloc.Free(PidL); Result := PathWithSlash(Result); end; end; //----------------------------------------------------------------------------- // ÃèÊö: È¡µÃ "¿ìËÙÆô¶¯" µÄ·¾¶ //----------------------------------------------------------------------------- function GetQuickLaunchPath: string; begin Result := GetSpecialFolder(CSIDL_APPDATA) + 'Microsoft\Internet Explorer\Quick Launch\'; end; //----------------------------------------------------------------------------- // ÃèÊö: È¡µÃ SystemDrive µÄ·¾¶ //----------------------------------------------------------------------------- function GetSystemDrivePath: string; begin if Win32Platform = VER_PLATFORM_WIN32_NT then Result := GetEnvVar('SystemDrive') {don't localize} else Result := ''; if Result = '' then begin Result := ExtractFileDrive(GetWindowsDir); if Result = '' then Result := 'C:'; end; Result := PathWithSlash(Result); end; //----------------------------------------------------------------------------- // ÃèÊö: È¡µÃ»·¾³±äÁ¿µÄÖµ //----------------------------------------------------------------------------- function GetEnvVar(const EnvVar: string): string; function AdjustLength(var S: string; const R: Cardinal): Boolean; begin Result := Integer(R) < Length(S); SetLength(S, R); end; const MaxSize = 255; var R: DWORD; begin SetLength(Result, MaxSize); repeat R := GetEnvironmentVariable(PChar(EnvVar), PChar(Result), Length(Result)); if R = 0 then begin Result := ''; Break; end; until AdjustLength(Result, R); end; //----------------------------------------------------------------------------- // ÃèÊö: È¡µÃ×ÀÃæÉϳýÈÎÎñÀ¸ÒÔÍâµÄÇøÓò //----------------------------------------------------------------------------- function GetWorkAreaRect: TRect; begin SystemParametersInfo(SPI_GETWORKAREA, 0, @Result, 0); end; //----------------------------------------------------------------------------- // ÃèÊö: ä¯ÀÀÎļþ¼Ð£¬¿É¶¨Î»Îļþ¼Ð // ²ÎÊý: // ParentHWnd - ¸¸´°¿ÚµÄ¾ä±ú // Caption - ä¯ÀÀ¶Ô»°¿òµÄÌáʾ±êÌâ // Root - ¸ùĿ¼ // Path - ´æ·ÅÓû§×îÖÕÑ¡ÔñµÄĿ¼ // ·µ»Ø: // True - Óû§µãÁËÈ·¶¨ // False - Óû§µãÁËÈ¡Ïû //----------------------------------------------------------------------------- function SelectDir(ParentHWnd: HWND; const Caption: string; const Root: WideString; var Path: string): Boolean; const {$WRITEABLECONST ON} InitPath: string = ''; {$WRITEABLECONST OFF} var WindowList: Pointer; BrowseInfo: TBrowseInfo; Buffer: PChar; RootItemIDList, ItemIDList: PItemIDList; ShellMalloc: IMalloc; IDesktopFolder: IShellFolder; Eaten, Flags: LongWord; function BrowseCallbackProc(hwnd: HWND; uMsg: UINT; lParam: Cardinal; lpData: Cardinal):Integer; stdcall; var R: TRect; begin if uMsg = BFFM_INITIALIZED then begin GetWindowRect(hwnd, R); MoveWindow(hwnd, (Screen.Width - (R.Right - R.Left)) div 2, (Screen.Height - (R.Bottom - R.Top)) div 2, R.Right - R.Left, R.Bottom - R.Top, True); Result := SendMessage(hwnd, BFFM_SETSELECTION, Ord(TRUE), Longint(PChar(InitPath))) end else Result := 1; end; begin Result := False; InitPath := Path; FillChar(BrowseInfo, SizeOf(BrowseInfo), 0); if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then begin Buffer := ShellMalloc.Alloc(MAX_PATH); try RootItemIDList := nil; if Root <> '' then begin SHGetDesktopFolder(IDesktopFolder); IDesktopFolder.ParseDisplayName(Application.Handle, nil, POleStr(Root), Eaten, RootItemIDList, Flags); end; with BrowseInfo do begin hwndOwner := ParentHWnd; pidlRoot := RootItemIDList; pszDisplayName := Buffer; lpszTitle := PChar(Caption); ulFlags := BIF_RETURNONLYFSDIRS; lpfn :=@BrowseCallbackProc; lParam :=BFFM_INITIALIZED; end; WindowList := DisableTaskWindows(0); try ItemIDList := ShBrowseForFolder(BrowseInfo); finally EnableTaskWindows(WindowList); end; Result := ItemIDList <> nil; if Result then begin ShGetPathFromIDList(ItemIDList, Buffer); ShellMalloc.Free(ItemIDList); Path := Buffer; end; finally ShellMalloc.Free(Buffer); end; end; end; //----------------------------------------------------------------------------- // ÃèÊö: ÓÃϵͳ Shell µ÷ÓÃÀ´´ò¿ªÒ»¸öÎļþ //----------------------------------------------------------------------------- function ExecuteFile(const FileName, Params, DefaultDir: string; ShowCmd: Integer): HWND; begin Result := ShellExecute(Application.Handle, nil, PChar(FileName), PChar(Params), PChar(DefaultDir), ShowCmd); end; //----------------------------------------------------------------------------- // ÃèÊö: ´ò¿ªÒ»¸ö URL // ʾÀý: // OpenURL('http://www.abc.com'); // OpenURL('www.abc.com'); // OpenURL('file:///c:\'); //----------------------------------------------------------------------------- function OpenURL(const URL: string): Boolean; begin Result := ShellExecute(Application.Handle, 'Open', PChar(Trim(URL)), '', '', SW_SHOW) > 32; end; //----------------------------------------------------------------------------- // ÃèÊö: ´ò¿ªÒ»¸ö Email ·¢ËÍ¿Í»§¶Ë //----------------------------------------------------------------------------- function OpenEmail(const Email: string): Boolean; const SPrefix = 'mailto:'; var S: string; begin S := Trim(Email); if Pos(SPrefix, S) <> 1 then S := SPrefix + S; Result := OpenURL(S); end; //----------------------------------------------------------------------------- // ÃèÊö: Èô°¿Ú±£³ÖÔÚ×îÉϲã //----------------------------------------------------------------------------- procedure SetStayOnTop(Form : TCustomForm; StayOnTop: Boolean); begin if StayOnTop Then SetWindowPos(Form.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE) else SetWindowPos(Form.Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE); end; //----------------------------------------------------------------------------- // ÃèÊö: Òþ²ØÓ¦ÓóÌÐòÔÚÈÎÎñÀ¸ÉϵÄÑ¡Ôñ°´Å¥ //----------------------------------------------------------------------------- procedure HideAppFromTaskBar; 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; //----------------------------------------------------------------------------- // ÃèÊö: ¼ì²éµ±Ç°ÏµÍ³ÓïÑÔÊÇ·ñ¼òÌåÖÐÎÄ //----------------------------------------------------------------------------- function CheckLangChinesePR: Boolean; const // LCID Consts LangChinesePR = (SUBLANG_CHINESE_SIMPLIFIED shl 10) or LANG_CHINESE; begin Result := SysLocale.DefaultLCID = LangChinesePR; end; //----------------------------------------------------------------------------- // ÃèÊö: ¹Ø»ú //----------------------------------------------------------------------------- function ShutdownWindows: Boolean; const SE_SHUTDOWN_NAME = 'SeShutdownPrivilege'; var hToken: THandle; tkp: TTokenPrivileges; tkpo: TTokenPrivileges; Zero: DWORD; begin Result := True; if Win32Platform = VER_PLATFORM_WIN32_NT then begin Zero := 0; if not OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then begin Result := False; Exit; end; if not LookupPrivilegeValue(nil, SE_SHUTDOWN_NAME, tkp.Privileges[0].Luid) then begin Result := False; Exit; end; tkp.PrivilegeCount := 1; tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; AdjustTokenPrivileges(hToken, False, tkp, SizeOf(TTokenPrivileges), tkpo, Zero); if Boolean(GetLastError()) then begin Result := False; Exit; end else ExitWindowsEx(EWX_SHUTDOWN or EWX_POWEROFF, 0); end else ExitWindowsEx(EWX_SHUTDOWN or EWX_POWEROFF, 0); end; //------------------------------------------------------------------------------ // ÃèÊö£ºÖØÆô //------------------------------------------------------------------------------ function RebootWindows: Boolean; const SE_SHUTDOWN_NAME = 'SeShutdownPrivilege'; var hToken: THandle; tkp: TTokenPrivileges; tkpo: TTokenPrivileges; Zero: DWORD; begin Result := True; if Win32Platform = VER_PLATFORM_WIN32_NT then begin Zero := 0; if not OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then begin Result := False; Exit; end; if not LookupPrivilegeValue(nil, SE_SHUTDOWN_NAME, tkp.Privileges[0].Luid) then begin Result := False; Exit; end; tkp.PrivilegeCount := 1; tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; AdjustTokenPrivileges(hToken, False, tkp, SizeOf(TTokenPrivileges), tkpo, Zero); if Boolean(GetLastError()) then begin Result := False; Exit; end else ExitWindowsEx(EWX_SHUTDOWN or EWX_REBOOT, 0); end else ExitWindowsEx(EWX_SHUTDOWN or EWX_REBOOT, 0); end; //----------------------------------------------------------------------------- // ÃèÊö: È¡Êó±êµÄµ±Ç°Î»Öà // ×¢Òâ: Mouse.CursorPos »áÔÚ´øÃÜÂë±£»¤µÄÆÁ±£Æô¶¯Ê±Å׳öÒì³£¡£ //----------------------------------------------------------------------------- function GetMouseCursorPos: TPoint; begin if not Windows.GetCursorPos(Result) then Result := Point(0, 0); end; //----------------------------------------------------------------------------- // ÃèÊö: ´´½¨¿ì½Ý·½Ê½ // ²ÎÊý: // OriginalFileName - ԭʼÎļþÃû£¬º¬Â·¾¶ (¼´¿ì½Ý·½Ê½Ö¸ÏòµÄÎļþ) // ShortcutFileName - ¿ì½Ý·½Ê½ÎļþÃû£¬º¬Â·¾¶£¬º¬À©Õ¹Ãû(.lnk) // Arguments - ÔËÐвÎÊý // WorkingDir - ¹¤×÷Ŀ¼ // Description - ¿ì½Ý·½Ê½ÃèÊö // ShowCmd - ÔËÐз½Ê½ (SW_SHOW, SW_MINIMIZE, SW_MAXIMIZE) // IsFolderShortcut - ÊÇ·ñÎļþ¼Ð¿ì½Ý·½Ê½ // ·µ»Ø: // True - ³É¹¦ // False - ʧ°Ü //----------------------------------------------------------------------------- function CreateShortCut(const OriginalFileName, ShortcutFileName, Arguments, WorkingDir, Description: string; ShowCmd: Integer; IsFolderShortcut: Boolean): Boolean; function IsWindowsXP: Boolean; begin Result := (Win32Platform >= VER_PLATFORM_WIN32_NT) and (Win32MajorVersion >= 5) and (Win32MinorVersion >= 1); end; const CLSID_FolderShortcut: TGUID = ( D1:$0AFACED1; D2:$E828; D3:$11D1; D4:($91,$87,$B5,$32,$F1,$E9,$57,$5D)); var OleResult: HRESULT; Obj: IUnknown; SL: IShellLink; PF: IPersistFile; WideFileName: WideString; begin if IsFolderShortcut then begin try Obj := CreateComObject(CLSID_FolderShortcut); except { Folder shortcuts aren't supported prior to Windows 2000/Me. Fall back to creating a normal shell link. } Obj := nil; end; end; if Obj = nil then begin IsFolderShortcut := False; Obj := CreateComObject(CLSID_ShellLink); end; SL := Obj as IShellLink; SL.SetPath(PChar(OriginalFileName)); SL.SetArguments(PChar(Arguments)); if WorkingDir <> '' then SL.SetWorkingDirectory(PChar(WorkingDir)); SL.SetShowCmd(ShowCmd); if Description <> '' then SL.SetDescription(PChar(Description)); PF := SL as IPersistFile; { When creating a folder shortcut on 2000/Me, IPersistFile::Save will strip off everything past the last '.' in the ShortcutFileName, so we keep the .lnk extension on to give it something harmless to strip off. XP doesn't do that, so we must remove the .lnk extension ourself. } if IsFolderShortcut and IsWindowsXP then WideFileName := ChangeFileExt(ShortcutFileName, '') else WideFileName := ShortcutFileName; OleResult := PF.Save(PWideChar(WideFileName), True); Result := OleResult = S_OK; end; //----------------------------------------------------------------------------- // ÃèÊö: È¡µÃÎļþ´óС //----------------------------------------------------------------------------- function GetFileSize(const FileName: string): Int64; var Handle: THandle; FindData: TWin32FindData; begin Result := -1; Handle := FindFirstFile(PChar(FileName), FindData); if Handle <> INVALID_HANDLE_VALUE then begin Windows.FindClose(Handle); if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then begin Int64Rec(Result).Lo := FindData.nFileSizeLow; Int64Rec(Result).Hi := FindData.nFileSizeHigh; end; end; end; //----------------------------------------------------------------------------- // ÃèÊö: È¡µÃÎļþ¼Ð´óС //----------------------------------------------------------------------------- function GetFolderSize(FolderName: string): Int64; var sr: TSearchRec; begin Result := 0; if RightStr(FolderName, 1) <> '\' then FolderName := FolderName + '\'; if FindFirst(FolderName + '*.* ', faAnyFile, sr) = 0 then repeat if (sr.Name <> '.') and (sr.Name <> '..') then begin Result := Result + GetFileSize(FolderName + sr.Name); if (sr.Attr and faDirectory) <> 0 then Result := Result + GetFolderSize(FolderName + sr.Name + '\'); end; until FindNext(sr) <> 0; FindClose(sr); end; //----------------------------------------------------------------------------- // ÃèÊö: È¡µÃÎļþµÄÐÞ¸Äʱ¼ä //----------------------------------------------------------------------------- function GetFileDate(const FileName: string): TDateTime; var FileDate: Integer; begin FileDate := FileAge(FileName); if FileDate = -1 then Result := 0 else Result := FileDateToDateTime(FileDate); end; //----------------------------------------------------------------------------- // ÃèÊö: ÉèÖÃÎļþµÄʱ¼ä //----------------------------------------------------------------------------- function SetFileDate(const FileName: string; CreationTime, LastWriteTime, LastAccessTime: TFileTime): Boolean; var FileHandle : Integer; begin FileHandle := FileOpen(FileName, fmOpenWrite or fmShareDenyNone); try if FileHandle <> Integer(INVALID_HANDLE_VALUE) then begin SetFileTime(FileHandle, @CreationTime, @LastAccessTime, @LastWriteTime); Result := True; end else Result := False; finally FileClose(FileHandle); end; end; //----------------------------------------------------------------------------- // ÃèÊö: ¸´ÖÆÎļþµ½Ò»¸öÎļþ¼Ð //----------------------------------------------------------------------------- function CopyFileToFolder(FileName, BackupFolder: string): Boolean; var MainFileName: string; begin BackupFolder := PathWithSlash(BackupFolder); MainFileName := ExtractFileName(FileName); ForceDirectories(BackupFolder); Result := CopyFile(PChar(FileName), PChar(BackupFolder + MainFileName), False); end; //----------------------------------------------------------------------------- // ÃèÊö: ×Ô¶¯µ÷ÕûÎļþÃû£¬·ÀÖ¹ÎļþÃûÖظ´ // ²ÎÊý: // FullName - ÎļþµÄȫ·¾¶Ãû // ʾÀý£º // NewName := AutoRenameFileName('C:\Downloads\test.dat'); // Èç¹û "C:\Downloads\" ÏÂÒѾ­´æÔÚtest.dat£¬Ôòº¯Êý·µ»Ø "C:\Downloads\test(1).dat". //----------------------------------------------------------------------------- function AutoRenameFileName(const FullName: string): string; const SLeftSym = '('; SRightSym = ')'; // ÈôS='test(1)'£¬Ôò·µ»Ø'(1)'£» ÈôS='test(a)'£¬Ôò·µ»Ø''¡£ function GetNumberSection(const S: string): string; var I: Integer; begin Result := ''; if Length(S) < 3 then Exit; if S[Length(S)] = SRightSym then begin for I := Length(S) - 2 downto 1 do if S[I] = SLeftSym then begin Result := Copy(S, I, MaxInt); Break; end; end; if Length(Result) > 0 then begin if not IsInt(Copy(Result, 2, Length(Result)-2)) then Result := ''; end; end; var Number: Integer; Name, Ext, NumSec: string; begin Ext := ExtractFileExt(FullName); Result := FullName; while FileExists(Result) do begin Name := Copy(Result, 1, Length(Result) - Length(Ext)); NumSec := GetNumberSection(Name); if Length(NumSec) = 0 then begin Result := Name + SLeftSym + '1' + SRightSym + Ext; end else begin Number := StrToInt(Copy(NumSec, 2, Length(NumSec)-2)); Inc(Number); Result := Copy(Name, 1, Length(Name) - Length(NumSec)) + SLeftSym + IntToStr(Number) + SRightSym + Ext; end; end; end; //----------------------------------------------------------------------------- // ÃèÊö: È¡µÃÒ»¸öÁÙʱÎļþÃû // ²ÎÊý: // Path - ÁÙʱÎļþËùÔÚ·¾¶ // PrefixStr - ÎļþÃûǰ׺£¬Ç°Èý¸ö×Ö·ûÓÐЧ //----------------------------------------------------------------------------- function GetTempFileAtPath(const Path: string; const PrefixStr: string): string; var I: Integer; begin I := 1; while True do begin Result := PathWithSlash(Path) + Copy(PrefixStr, 1, 3) + IntToStr(I) + '.tmp'; if FileExists(Result) then Inc(I) else Break; end; end; //----------------------------------------------------------------------------- // ÃèÊö: ÅжÏÎļþÊÇ·ñ¾ßÓÐÖ»¶ÁÊôÐÔ //----------------------------------------------------------------------------- function IsFileReadOnly(const FileName: string): Boolean; begin Result := (GetFileAttributes(PChar(FileName)) and FILE_ATTRIBUTE_READONLY) <> 0; end; //----------------------------------------------------------------------------- // ÃèÊö: ɾ³ýÎļþµ½»ØÊÕÕ¾ //----------------------------------------------------------------------------- function DeleteFileToRecycle(const FileName: string): Boolean; var OpStruct: TSHFileOpStruct; begin FillChar(OpStruct, SizeOf(OpStruct), 0); with OpStruct do begin Wnd := 0; wFunc := FO_DELETE; pFrom := PChar(FileName); fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT; end; Result := SHFileOperation(OpStruct) = 0; end; //------------------------------------------------------------------------------ // ÃèÊö£ºÄ£ºýÆ¥Åäɾ³ýÎļþ //------------------------------------------------------------------------------ procedure DeleteFileEx(FileName:string); var FileDir:string; FileStruct:TSHFileOpStruct; begin FileDir := FileName;// 'C:\temp\*.txt'; FileStruct.Wnd :=0; FileStruct.wFunc := FO_delete; FileStruct.pFrom := Pchar(FileDir+#0); FileStruct.fFlags:= FOF_NOCONFIRMATION; FileStruct.pTo := ' '; if SHFileOperation(FileStruct)=0 then MessageBox(0,'×¢Òâ: ×ۺϲâÊǪ̂ÒÇÆ÷²âÁ¿Êý¾ÝÒѾ­Çå¿Õ!','Ìáʾ',MB_OK+MB_ICONINFORMATION); end; //----------------------------------------------------------------------------- // ÃèÊö: ɾ³ý¿Õ»ò·Ç¿ÕĿ¼ //----------------------------------------------------------------------------- function DeleteDirectory(const Dir: string): Boolean; var FileOp: TSHFileOpStruct; begin FillChar(FileOp, SizeOf(FileOp), 0); with FileOp do begin Wnd := 0; wFunc := FO_DELETE; pFrom := PChar(Dir + #0); pTo := #0#0; fFlags := FOF_NOCONFIRMATION + FOF_SILENT; end; Result := (SHFileOperation(FileOp) = 0); end; //----------------------------------------------------------------------------- // ÃèÊö: ÅжÏĿ¼ÊÇ·ñΪ¿Õ //----------------------------------------------------------------------------- function IsEmptyDir(sDir: String): Boolean; var sr: TsearchRec; begin Result := True; if Copy(sDir, Length(sDir) - 1, 1) <> '\' then sDir := sDir + '\'; if FindFirst(sDir + '*.*', faAnyFile, sr) = 0 then repeat if (sr.Name <> '.') and (sr.Name <> '..') then begin Result := False; break; end; until FindNext(sr) <> 0; FindClose(sr); end; //------------------------------------------------------------------------------ // ¶ÁÈ¡Îı¾ÎļþµÄÒ»ÖÖ·½·¨ //------------------------------------------------------------------------------ function ReadFile(const sFile:String):String; var sList: TStringlist; begin sList := TStringList.Create; try if FileExists(sFile) then begin sList.LoadFromFile(sFile); Result := sList.GetText; end; finally sList.Free; end; end; //------------------------------------------------------------------------------ // ¶ÁÈ¡Îļþ£º //1£¬¹ØÁªÎļþ£ºAssignFile(pMyFile,'c:\ttt.csv'); //2£¬´ò¿ªÎļþ£ºReset(pMyFile); //3£¬¶ÁÈ¡Ò»ÐУºReadln(pMyFile,pStr); //4£¬¹Ø±ÕÎļþ£ºCloseFile(pMyFile); //------------------------------------------------------------------------------ function ReadLogFile(const sFile:String):String; var pMyFile:textfile; pStr : string; begin try Assignfile(pMyFile,sFile); if FileExists(sFile) then begin Reset(pMyFile); while not Eof(pMyFile) do begin Readln(pMyFile,pStr); //next; end; end; finally CloseFile(pMyFile); end; Result := pStr; end; //------------------------------------------------------------------------------ // дÈëÎļþ£º //1£¬¹ØÁªÎļþ£ºAssignFile(pMyFile,'c:\ttt.csv'); //2£¬´ò¿ªÎļþ£ºReWrite(pMyFile); //Èç¹ûÎļþ²»´æÔÚ,ÓÃReWrite´ò¿ª // Append(pMyFile); //Èç¹ûÎļþÒѾ­´æÔÚ,×·¼ÓÄÚÈÝ£¬ÓÃAppend´ò¿ª //3£¬Ð´ÈëÒ»ÐУºWriteLn(pMyFile,pStr); //4£¬¹Ø±ÕÎļþ£ºCloseFile(pMyFile); //------------------------------------------------------------------------------ procedure WriteLogFile(const sFile,sMsg: string); var pMyFile: textFile; begin try AssignFile(pMyFile,sFile); if FileExists(sFile) then Append(pMyFile) else ReWrite(pMyFile); WriteLn(pMyFile,sMsg); finally CloseFile(pMyFile); end; end; //----------------------------------------------------------------------------- // ÃèÊö: ÉèÖÃ×ÔÆô¶¯ // ²ÎÊý: // AutoRun - ÊÇ·ñ×ÔÆô¶¯ // CurrentUser - ÊÇ·ñÖ»¶Ôµ±Ç°Óû§ÓÐЧ // AppTitle - Ó¦ÓóÌÐòµÄ±êÌ⣬Èç "MSN" // AppPara - ×ÔÆô¶¯µÄÃüÁîÐвÎÊý£¬Èç "/min" //----------------------------------------------------------------------------- function SetAutoRunOnStartup(AutoRun, CurrentUser: Boolean; AppTitle, AppName, AppPara: string): Boolean; var R: TRegistry; Key : string; begin Result := True; try R := TRegistry.Create; try if CurrentUser then R.RootKey := HKEY_CURRENT_USER else R.RootKey := HKEY_LOCAL_MACHINE; Key := '\Software\Microsoft\Windows\CurrentVersion\Run\'; if AppTitle = '' then AppTitle := Application.Title; if AppName = '' then AppName := Application.ExeName; if AppPara <> '' then AppName := AppName + ' ' + AppPara; if R.OpenKey(Key, True) then begin if AutoRun then R.WriteString(AppTitle, AppName) else R.DeleteValue(AppTitle); end; finally R.Free; end; except Result := False; end; end; {¿ª»úÔËÐС£} procedure AutoRun(Flag: Boolean; title:String); var tempreg: TRegistry; begin tempreg := TRegistry.Create; try tempreg.RootKey := HKEY_CURRENT_USER; tempreg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run', True); if Flag then tempreg.WriteString(title, '"' + ParamStr(0) + '"') else begin tempreg.DeleteValue(title); end; finally tempreg.Closekey; tempreg.Free; end; end; //----------------------------------------------------------------------------- // ÃèÊö: ¶Á×¢²á±íÖ¸¶¨¼ü // ²ÎÊý: // CurrentUser - ÊÇ·ñÖ»¶Ôµ±Ç°Óû§ÓÐЧ // Name - Ó¦ÓóÌÐòµÄ±êÌ⣬Èç "MSN" // ·µ»Ø£ºValue - ·µ»ØName¶ÔÓ¦Öµ //----------------------------------------------------------------------------- function ReadReg(const Name: String; CurrentUser: Boolean=true):String; var R: TRegistry; Key : String; begin Result := ''; R := TRegistry.Create; try if CurrentUser then R.RootKey := HKEY_CURRENT_USER else R.RootKey := HKEY_LOCAL_MACHINE; Key := '\Software\liliangting\'; if R.OpenKey(Key,True) then Result := R.ReadString(Name); finally R.Free; end; end; //дע²á±íÖ¸¶¨Öµ function WriteReg(const Name,Value: String; CurrentUser: Boolean=true):Boolean; var R: TRegistry; Key : String; begin Result := false; R := TRegistry.Create; try if CurrentUser then R.RootKey := HKEY_CURRENT_USER else R.RootKey := HKEY_LOCAL_MACHINE; Key := '\Software\liliangting\'; if R.OpenKey(Key,True) then begin R.WriteString(Name, Value); Result := true; end; finally R.Free; end; end; //----------------------------------------------------------------------------- // ÃèÊö: Îļþ¹ØÁª // ²ÎÊý: // FileExt - ÎļþÀ©Õ¹Ãû // FileKey - ¸ÃÎļþÀàÐ͵ÄÓ¢ÎÄ·ûºÅ // SoftName - Èí¼þµÄÃû×Ö (ÓÃÓÚÏÔʾÔÚ×ÊÔ´¹ÜÀíÆ÷µÄÓÒ¼ü²Ëµ¥ÉÏ) // FileDesc - ÎļþÀàÐ͵ÄÃèÊö // IconIndex - ͼ±êÐòºÅ(0-based) // Flush - ÊÇ·ñË¢ÐÂWindows»º³å // ʾÀý: // AssociateFile('.edf', 'EDiaryFile', 'EDiary', 'µç×ÓÈռDZ¾Îļþ'); //----------------------------------------------------------------------------- function AssociateFile(const FileExt, FileKey, SoftName, FileDesc: string; IconIndex: Integer; Flush: Boolean): Boolean; var R: TRegistry; begin Result := True; try // Win2000ÏÂÊÜÏÞÓû§Ö´Ðд˲Ù×÷½«»á±¨´í R := TRegistry.Create; try R.RootKey := HKEY_CLASSES_ROOT; R.OpenKey('\' + FileExt, True); R.WriteString('', FileKey); R.OpenKey('\' + FileKey, True); R.WriteString('', FileDesc); R.OpenKey('\' + FileKey + '\Shell\Open\Command', True); R.WriteString('', Application.ExeName + ' "%1"'); R.OpenKey('\' + FileKey + '\Shell\Open with ' + SoftName + '\Command', True); R.WriteString('', Application.ExeName + ' "%1"'); R.OpenKey('\' + FileKey + '\DefaultIcon', True); R.WriteString('', Application.ExeName + ',' + IntToStr(IconIndex)); finally R.Free; end; if Flush then SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil); except Result := False; end; end; //----------------------------------------------------------------------------- // ÃèÊö: ÔÚ×¢²á±íÖмÇϳÌÐò·¾¶ //----------------------------------------------------------------------------- function SaveAppPath(const CompanyName, SoftName, Version: string): Boolean; const SPathKey = 'Path'; var R: TRegistry; Key: string; begin Result := True; try R := TRegistry.Create; try R.RootKey := HKEY_CURRENT_USER; Key := '\Software\' + CompanyName + '\' + SoftName + '\' + Version + '\'; if R.OpenKey(Key, True) then R.WriteString(SPathKey, GetModulePath); finally R.Free; end; except Result := False; end; end; //----------------------------------------------------------------------------- // ÃèÊö: ´Ó×¢²á±íÖжÁÈ¡³ÌÐò·¾¶ //----------------------------------------------------------------------------- function ReadAppPath(const CompanyName, SoftName, Version: string; var Path: string): Boolean; const SPathKey = 'Path'; var R: TRegistry; Key: string; begin try R := TRegistry.Create; try R.RootKey := HKEY_CURRENT_USER; Key := '\Software\' + CompanyName + '\' + SoftName + '\' + Version + '\'; Result := R.OpenKey(Key, False); if Result then Path := R.ReadString(SPathKey); finally R.Free; end; except Result := False; end; end; //----------------------------------------------------------------------------- // ÃèÊö: FileTime -> LocalSystemTime //----------------------------------------------------------------------------- function FileTimeToLocalSystemTime(FTime: TFileTime): TSystemTime; var STime: TSystemTime; begin FileTimeToLocalFileTime(FTime, FTime); FileTimeToSystemTime(FTime, STime); Result := STime; end; //----------------------------------------------------------------------------- // ÃèÊö: LocalSystemTime -> FileTime //----------------------------------------------------------------------------- function LocalSystemTimeToFileTime(STime: TSystemTime): TFileTime; var FTime: TFileTime; begin SystemTimeToFileTime(STime, FTime); LocalFileTimeToFileTime(FTime, FTime); Result := FTime; end; //----------------------------------------------------------------------------- // ÃèÊö: ·µ»Ø TDateTime ÖеÄÈÕÆÚ²¿·Ö //----------------------------------------------------------------------------- function GetDatePart(DateTime: TDateTime): TDate; begin Result := Trunc(DateTime); end; //----------------------------------------------------------------------------- // ÃèÊö: ·µ»Ø TDateTime ÖеÄʱ¼ä²¿·Ö //----------------------------------------------------------------------------- function GetTimePart(DateTime: TDateTime): TTime; begin Result := DateTime - Trunc(DateTime); end; //----------------------------------------------------------------------------- //»ñÈ¡CPUID²¢Êä³ö×Ö·û´® //----------------------------------------------------------------------------- function GetCPUID: TCPUID; assembler; register; asm PUSH EBX {Save affected register} PUSH EDI MOV EDI,EAX {@Resukt} 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 {Restore registers} POP EBX end; //Êä³öº¯Êý: »ñÈ¡CPUID²¢Êä³ö×Ö·û´® function GetCPUIDStr:String; var CPUID:TCPUID; begin CPUID:=GetCPUID; Result:=IntToStr(CPUID[1])+IntToStr(CPUID[2])+IntToStr(CPUID[3])+IntToStr(CPUID[4]); end; //»ñÈ¡Íø¿¨MACµØÖ·²¿·Ö //µ÷ÓÃϵͳº¯Êý»ñÈ¡µ±Ç°¿ÉÓõÄmac function GetMacAddress: string; var Lib: Cardinal; Func: function(GUID: PGUID): Longint; stdcall; GUID1, GUID2: TGUID; begin Result := '000000000000'; Lib := LoadLibrary('rpcrt4.dll'); if Lib <> 0 then begin if Win32Platform <>VER_PLATFORM_WIN32_NT then @Func := GetProcAddress(Lib, 'UuidCreate') else @Func := GetProcAddress(Lib, 'UuidCreateSequential'); if Assigned(Func) then begin if (Func(@GUID1) = 0) and (Func(@GUID2) = 0) and (GUID1.D4[2] = GUID2.D4[2]) and (GUID1.D4[3] = GUID2.D4[3]) and (GUID1.D4[4] = GUID2.D4[4]) and (GUID1.D4[5] = GUID2.D4[5]) and (GUID1.D4[6] = GUID2.D4[6]) and (GUID1.D4[7] = GUID2.D4[7]) then begin Result :=IntToHex(GUID1.D4[2], 2) + IntToHex(GUID1.D4[3], 2) + IntToHex(GUID1.D4[4], 2) + IntToHex(GUID1.D4[5], 2) + IntToHex(GUID1.D4[6], 2) + IntToHex(GUID1.D4[7], 2); end; end; FreeLibrary(Lib); end; end; //»ñȡʵʱÄÚ´æʹÓÃÁ¿ function GetMemUse: Cardinal; function GetProcessMemUse(PID: Cardinal): Cardinal; var pmc: pprocess_memory_counters;//uses psApi ProcHandle: HWND; iSize: DWORD; begin Result := 0; iSize := SizeOf(_PROCESS_MEMORY_COUNTERS); GetMem(pmc, iSize); try pmc^.cb := iSize; ProcHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, PID); if GetProcessMemoryInfo(ProcHandle, pmc, iSize) then Result := pmc^.WorkingSetSize; finally FreeMem(pmc); end; end; begin Result := GetProcessMemUse(GetCurrentProcessId); end; //----------------------------------------------------------------------------- // ÃèÊö: ¿ªÊ¼µÈ´ý //----------------------------------------------------------------------------- procedure BeginWait; begin Screen.Cursor := crHourGlass; end; //----------------------------------------------------------------------------- // ÃèÊö: Í£Ö¹µÈ´ý //----------------------------------------------------------------------------- procedure EndWait; begin Screen.Cursor := crDefault; end; //----------------------------------------------------------------------------- // ÃèÊö: Ï൱ÓÚCÓïÑÔÖÐµÄ exp ? v1 : v2 //----------------------------------------------------------------------------- function Iif(Value: Boolean; Value1, Value2: Variant): Variant; begin if Value then Result := Value1 else Result := Value2; end; //----------------------------------------------------------------------------- // ÃèÊö: È¡ V1, V2 ÖеÄ×îСֵ //----------------------------------------------------------------------------- function Min(V1, V2: Integer): Integer; begin if V1 > V2 then Result := V2 else Result := V1; end; //----------------------------------------------------------------------------- // ÃèÊö: È¡ V1, V2 ÖеÄ×î´óÖµ //----------------------------------------------------------------------------- function Max(V1, V2: Integer): Integer; begin if V1 > V2 then Result := V1 else Result := V2; end; //----------------------------------------------------------------------------- // ÃèÊö: µ÷Õû Value£¬Ê¹ (Value >= Min) and (Value <= Max) //----------------------------------------------------------------------------- function TrimValue(Value, Min, Max: Integer): Integer; begin if Value < Min then Value := Min; if Value > Max then Value := Max; Result := Value; end; //----------------------------------------------------------------------------- // ÃèÊö: ½»»» V1, V2 //----------------------------------------------------------------------------- procedure Swap(var V1, V2: Integer); var Temp: Integer; begin Temp := V1; V1 := V2; V2 := Temp; end; //----------------------------------------------------------------------------- // ÃèÊö: È¡µÃÁ½¸ö Ticks Ö®²î //----------------------------------------------------------------------------- function GetTickDiff(const OldTickCount, NewTickCount: Cardinal): Cardinal; begin if NewTickCount >= OldTickCount then begin Result := NewTickCount - OldTickCount; end else begin Result := High(Cardinal) - OldTickCount + NewTickCount; end; end; //----------------------------------------------------------------------------- // ÃèÊö: ÏÞÖƾØÐÎÇøÓò²»Òª³¬³öÆÁÄ»·¶Î§ // ²ÎÊý: // Rect - ´ýµ÷ÕûµÄ¾ØÐÎÇøÓò // AllVisible - ¾ØÐÎÇøÓòÊDz»ÊÇҪȫ²¿¿É¼û // ·µ»Ø: // µ÷ÕûºóµÄ¾ØÐÎÇøÓò (¿í¡¢¸ß²»±ä) //----------------------------------------------------------------------------- function RestrictRectInScr(Rect: TRect; AllVisible: Boolean): TRect; const Space = 100; var ScrRect: TRect; W, H: Integer; begin ScrRect := Screen.WorkAreaRect; W := Rect.Right - Rect.Left; H := Rect.Bottom - Rect.Top; if AllVisible then begin if W > (ScrRect.Right - ScrRect.Left) then W := (ScrRect.Right - ScrRect.Left); if H > (ScrRect.Bottom - ScrRect.Top) then H := (ScrRect.Bottom - ScrRect.Top); if Rect.Right > ScrRect.Right then Rect.Left := ScrRect.Right - W; if Rect.Bottom > ScrRect.Bottom then Rect.Top := ScrRect.Bottom - H; if Rect.Left < ScrRect.Left then Rect.Left := ScrRect.Left; if Rect.Top < ScrRect.Top then Rect.Top := ScrRect.Top; Rect.Right := Rect.Left + W; Rect.Bottom := Rect.Top + H; end else begin if Rect.Left >= ScrRect.Right - Space then Rect.Left := ScrRect.Right - Space; if Rect.Top >= ScrRect.Bottom - Space then Rect.Top := ScrRect.Bottom - Space; if Rect.Right <= ScrRect.Left + Space then Rect.Left := ScrRect.Left - (Rect.Right - Rect.Left) + Space; if Rect.Top < ScrRect.Top then Rect.Top := ScrRect.Top; Rect.Right := Rect.Left + W; Rect.Bottom := Rect.Top + H; end; Result := Rect; end; //----------------------------------------------------------------------------- // ÃèÊö: È¡µÃ×ÔÉí DLL»òOCX»òEXE ËùÔڵķ¾¶ // ×¢Òâ: Óà Application.ExeName ÎÞ·¨È¡µÃ ActiveX µÄ·¾¶¡£ //----------------------------------------------------------------------------- function GetModulePath: string; var S: array[0..MAX_PATH] of Char; begin GetModuleFileName(HInstance, S, MAX_PATH); Result := PathWithSlash(ExtractFilePath(S)); end; //----------------------------------------------------------------------------- // ÃèÊö: È¡µÃ×ÔÉí DLL»òOCX»òEXE ËùÔÚ·¾¶µÄ×ÓĿ¼·¾¶ //----------------------------------------------------------------------------- function GetModuleSubPath(const SubFolder: string = ''): string; begin Result := GetModulePath + SubFolder; Result := PathWithSlash(Result); end; //----------------------------------------------------------------------------- // ÃèÊö: È¡µÃ×ÔÉí EXE ËùÔÚ·¾¶ //----------------------------------------------------------------------------- function GetAppPath: string; begin Result := ExtractFilePath(Application.ExeName); end; //----------------------------------------------------------------------------- // ÃèÊö: È¡µÃ×ÔÉí EXE ËùÔÚ·¾¶µÄ×ÓĿ¼·¾¶ //----------------------------------------------------------------------------- function GetAppSubPath(const SubFolder: string): string; begin Result := GetAppPath + SubFolder; Result := PathWithSlash(Result); end; //----------------------------------------------------------------------------- // ÃèÊö: ·µ»Ø¾ØÐÎ R µÄ¿í¶È //----------------------------------------------------------------------------- function GetRectWidth(const R: TRect): Integer; begin Result := R.Right - R.Left; end; //----------------------------------------------------------------------------- // ÃèÊö: ·µ»Ø¾ØÐÎ R µÄ¸ß¶È //----------------------------------------------------------------------------- function GetRectHeight(const R: TRect): Integer; begin Result := R.Bottom - R.Top; end; //----------------------------------------------------------------------------- // ÃèÊö: »æÖÆÓб߿òµÄÎÄ×Ö //----------------------------------------------------------------------------- procedure DrawStrokedText(Canvas: TCanvas; X, Y: Integer; const Text: string; FontColor, StrokedColor, SmoothColor: TColor); var SaveStyle: TBrushStyle; SaveFontColor: TColor; begin SaveStyle := Canvas.Brush.Style; SaveFontColor := Canvas.Font.Color; try Canvas.Brush.Style := bsClear; Canvas.Font.Color := SmoothColor; Canvas.TextOut(X - 1, Y - 1, Text); Canvas.TextOut(X - 1, Y + 1, Text); Canvas.TextOut(X + 1, Y - 1, Text); Canvas.TextOut(X + 1, Y + 1, Text); Canvas.Font.Color := StrokedColor; Canvas.TextOut(X, Y - 1, Text); Canvas.TextOut(X, Y + 1, Text); Canvas.TextOut(X + 1, Y, Text); Canvas.TextOut(X - 1, Y, Text); Canvas.Font.Color := FontColor; Canvas.TextOut(X, Y, Text); finally Canvas.Font.Color := SaveFontColor; Canvas.Brush.Style := SaveStyle; end; end; //------------------------------------------------------------------------------ //·µ»ØÆÁÄ»·Ö±æÂÊ¿í¶È //------------------------------------------------------------------------------ function GetScreenWidth:Integer; var sysinfo: TSystemInfo; begin GetSystemInfo(sysinfo); Result:= GetSystemMetrics(SM_CXSCREEN); //·Ö±æÂÊ¿í //y:= GetSystemMetrics(SM_CYSCREEN); //·Ö±æÂÊ¸ß end; //·µ»ØÆÁÄ»·Ö±æÂÊ¸ß¶È function GetScreenHeight:Integer; var sysinfo: TSystemInfo; begin GetSystemInfo(sysinfo); //x:= GetSystemMetrics(SM_CXSCREEN); //·Ö±æÂÊ¿í Result:= GetSystemMetrics(SM_CYSCREEN); //·Ö±æÂÊ¸ß end; //------------------------------------------------------------------------------ //·µ»Ø×ÀÃæ¸ß¶ÈºÍ¿í¶È //------------------------------------------------------------------------------ function GetDesktopWidth:Integer; var hRect : TRect; begin SystemParametersInfo(SPI_GETWORKAREA,0,@hRect, 0); Result:= hRect.Right; //·µ»Ø¿í¶È end; function GetDesktopHeight:Integer; var hRect : TRect; begin SystemParametersInfo(SPI_GETWORKAREA,0,@hRect, 0); Result:= hRect.Bottom; //·µ»Ø¿í¶È end; //----------------------------------------------------------------------------- // ÃèÊö: ÅжÏ×Ö·û´®ÊÇ·ñΪÈÎÒⳤ¶È´øÕûÊý //----------------------------------------------------------------------------- function IsBigInt(const S:String): Boolean; //±äÁ¿SΪҪÅжϵÄ×Ö·û´®,·µ»ØtrueÔòÕýÈ· var i : integer; begin Result:=True; for i :=1 to length(s) do if not (s[i] in ['0'..'9']) then //ÅжÏ×Ö·û´®Ã¿¸ö×Ö·û¼´s[i],ÊÇ·ñΪ"0"µ½'9"Êý×Ö Result:=False; end; //------------------------------------------------------------------------------ //2011-10-26 ÐÂÔöComboBox_XPMan_KeyPressº¯Êý,½â¾öComboBox¿Ø¼þÊäÈëÂÒÂëÎÊÌâ, // ÔÚKeyPressʼþÖÐÖ´ÐÐComboBox_XPMan_KeyPress¼´¿É½â¾ö¡£ //------------------------------------------------------------------------------ Function IsNTSystem:Boolean; var info:OSVERSIONINFO; begin info.dwOSVersionInfoSize:=sizeof(info); GetVersionEx(info); Result:=info.dwPlatformId=VER_PLATFORM_WIN32_NT; end; procedure ComboBox_XPMan_KeyPress(Sender:TObject;var Key: Char); {×Óº¯Êý,´¦ÀíÏûÏ¢} function HasSelectedText(CB_HWND:HWND; var StartPos, EndPos: DWORD): Boolean; begin SendMessage(CB_HWND, CB_GETEDITSEL, Integer(@StartPos), Integer(@EndPos)); Result := EndPos > StartPos; end; var StartPos, EndPos: DWORD; OldText, SaveText: WideString; //¹Ø¼üÔÚ´Ë£¬Öмä×Ö·û´®ÒªÉèΪ¿í×Ö·û´®ÐÍ LastByte: Integer; TheCB:TComboBox; CBHandle:HWND; begin if not IsNTSystem then Exit; //·ÇNTϵͳÔòÍ˳ö TheCB:=TComboBox(Sender); CBHandle:=TheCB.Handle; if not TheCB.AutoComplete then exit; if ord(Key) = VK_BACK then begin SaveText := TheCB.Text; if HasSelectedText(CBHandle, StartPos, EndPos) then begin SendMessage(CBHandle,CB_GETEDITSEL,Integer(@StartPos),Integer(@EndPos)); Delete(SaveText, StartPos + 1, EndPos - StartPos); SendMessage(CBHandle, CB_SETCURSEL, -1, 0); TheCB.Text := SaveText; SendMessage(CBHandle,CB_SETEDITSEL,0,MakeLParam(StartPos,StartPos)); Key := #0; end else if(TheCB.Style in [csDropDown,csSimple]) and (Length(SaveText)>0) then begin LastByte := StartPos; OldText := Copy(SaveText, 1, LastByte - 1); SendMessage(CBHandle, CB_SETCURSEL, -1, 0); TheCB.Text := OldText + Copy(SaveText, EndPos + 1, MaxInt); SendMessage(CBHandle, CB_SETEDITSEL, 0, MakeLParam(LastByte - 1,LastByte - 1)); Key := #0; end; end; end; //-------------------------------------------------- // º¯Êý: ¸ñʽ»¯Êý×Ö, °´Ö¸¶¨Î»ÊýÀ©Õ¹Êý×Ö,ת»»×Ö·û´® // Èë²Î: ´ý¸ñʽ»¯µÄÊý×Ö,À©Õ¹Î»Êý // ·µ»Ø: ת»»µÄ×Ö·û´® // ÀýÈç: formatNum(12,4) = '0012' //-------------------------------------------------- Function formatNum(Number, Length: Integer): string; var i : Integer; s1: string; begin s1:=''; for i:=0 to Length-1 do s1:=s1+'0'; Result:=RightStr(s1+IntToStr(Number), Length); end; //------------------------------------------------------------------------------ // º¯Êý£º¸ñʽ»¯×Ö·û´®£¬¼Óµ¥ÒýºÅ // Èë²Î£º´ý¸ñʽ»¯µÄ×Ö·û´® // ·µ»Ø£º×ª»»µÄ×Ö·û´® // ÀýÈ磺Q('abc') = ''abc'' //------------------------------------------------------------------------------ Function Q(s1:string):string; begin Result:=Quotedstr(s1); end; //ÎÞË¢ÐÂÑÓʱº¯Êý procedure Delay(MSecs: Longint); var FirstTickCount, Now: Longint; begin FirstTickCount := GetTickCount(); repeat Application.ProcessMessages; Now := GetTickCount(); until (Now - FirstTickCount >= MSecs) or (Now < FirstTickCount); end; //------------------------------------------------------------------------------ // º¯Êý: ×Ô¶¨ÒåÖ½ÕÅ´òÓ¡º¯Êý // ÒÔϳÌÐò½«´òÓ¡»úÖ½ÕÅÉèΪ£º114mm*190mm£º // Uses Printers; //------------------------------------------------------------------------------ procedure PreparePrinter(Width,Height:Integer); var aDevice: array[0..CCHDEVICENAME-1] of Char; aDriver: array[0..MAX_PATH-1] of Char; aPort: array[0..31] of Char; hDevMode: THandle; pDevMode: PDeviceMode; begin //»ñÈ¡´òÓ¡»úDeviceModeµÄ¾ä±ú Printer.GetPrinter(aDevice, aDriver, aPort, hDevMode); if hDevMode <> 0 then begin //»ñÈ¡Ö¸ÏòDeviceModeµÄÖ¸Õë pDevMode:=GlobalLock(hDevMode); if pDevMode <> nil then begin pDevMode^.dmPaperSize:= DMPAPER_USER; //×Ô¶¨ÒåÖ½ÕÅ:256 pDevMode^.dmPaperLength:=Width*10; pDevMode^.dmPaperWidth:= Height*10; pDevMode^.dmFields:=pDevMode^.dmFields or DM_PAPERSIZE;//ÒÔÏÂÈý¾äÊǶÔÓ¦dmFields³ÉÔ±ÖÃλ pDevMode^.dmFields:=pDevMode^.dmFields or DM_PAPERLENGTH; pDevMode^.dmFields:=pDevMode^.dmFields or DM_PAPERWIDTH; ResetDC(Printer.Handle, pDevMode^); //ÉèÖôòÓ¡»úÉ豸¾ä±ú GlobalUnlock(hDevMode); end; end; end; //------------------------------------------------------------------------------ // ÃèÊö£º³ÌÐò·ûºÏÒªÇóʱ×Ô¶¯Ïú»ÙÖ÷³ÌÐò //------------------------------------------------------------------------------ procedure DeleteMe; var BatchFile: TextFile; BatchFileName: string; ProcessInfo: TProcessInformation; StartUpInfo: TStartupInfo; begin BatchFileName := ExtractFilePath(ParamStr(0)) + '_deleteme.bat'; AssignFile(BatchFile, BatchFileName); Rewrite(BatchFile); Writeln(BatchFile, ':try'); Writeln(BatchFile, 'del "' + ParamStr(0) + '"'); Writeln(BatchFile, 'if exist "' + ParamStr(0) + '"' + ' goto try'); Writeln(BatchFile, 'del %0'); CloseFile(BatchFile); FillChar(StartUpInfo, SizeOf(StartUpInfo), $00); StartUpInfo.dwFlags := STARTF_USESHOWWINDOW; StartUpInfo.wShowWindow := SW_HIDE; if CreateProcess(nil, PChar(BatchFileName), nil, nil, False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo, ProcessInfo) then begin CloseHandle(ProcessInfo.hThread); CloseHandle(ProcessInfo.hProcess); end; end; //------------------------------------------------------------------------------ // ÔÚϵͳÔËÐÐʱ×Ô¶¯¸Ä±äϵͳµÄÈÕÆÚ¸ñʽ // Èë²Î: ÈÕÆÚ¸ñʽ,Èç yyyy-MM-dd //------------------------------------------------------------------------------ procedure SetSystemDateFormat(sFormat:string='yyyy-MM-dd'); begin SetLocaleInfo(LOCALE_SLONGDATE,LOCALE_SDATE,'- '); SetLocaleInfo(LOCALE_SLONGDATE,LOCALE_SSHORTDATE, PChar(sFormat)); SendMessage(HWND_BROADCAST,WM_SETTINGCHANGE,0,0); end; //----------------------------------------------------------------------------- // ÃèÊö: ¶Ô×Ö·û´®½øÐÐ base16 ±àÂë // ²ÎÊý: // Value - ´ý±àÂëµÄ×Ö·û´® // ·µ»Ø: // ±àÂëºóµÄ×Ö·û´® //----------------------------------------------------------------------------- function Base16Encode(const Src: AnsiString): AnsiString; const H: array[0..15] of AnsiChar = '0123456789ABCDEF'; var S: PByte; D: PAnsiChar; SrcBytes: Integer; begin Result := ''; SrcBytes := Length(Src); SetLength(Result, SrcBytes * 2); if SrcBytes = 0 then Exit; D := PAnsiChar(Result); S := PByte(Src); while SrcBytes > 0 do begin D^ := H[S^ shr 4]; Inc(D); D^ := H[S^ and $F]; Inc(D); Inc(S); Dec(SrcBytes); end; end; //----------------------------------------------------------------------------- // ÃèÊö: ½« base16 ±àÂëµÄÄÚÈÝ»¹Ô­³É×Ö·û´® // ²ÎÊý: // Value - ´ý½âÂëµÄ×Ö·û´® // ·µ»Ø: // ½âÂëºóµÄ×Ö·û´® //----------------------------------------------------------------------------- function Base16Decode(const Src: AnsiString): AnsiString; var D: PByte; V: Byte; S: PAnsiChar; SrcBytes: Integer; begin Result := ''; SrcBytes := Length(Src); SetLength(Result, (SrcBytes +1) div 2); D := PByte(Result); S := PAnsiChar(Src); while SrcBytes > 0 do begin V := Byte(UpCase(S^)); Inc(S); if V > Byte('9') then D^ := V - Byte('A') + 10 else D^ := V - Byte('0'); V := Byte(UpCase(S^)); Inc(S); D^ := D^ shl 4; if V > Byte('9') then D^ := D^ or (V - Byte('A') + 10) else D^ := D^ or (V - Byte('0')); Dec(SrcBytes, 2); Inc(D); end; SetLength(Result, PAnsiChar(D) - PAnsiChar(Result)); end; //------------------------------------------------------------------------------ //Ò»¸öͨ¹ýActiveX»ñÈ¡GUIDµÄº¯Êý //·µ»ØÖµ£ºGUID×Ö·û´® //------------------------------------------------------------------------------ Function GetGUID:string; var sGUID : string; TmpGUID: TGUID; begin if CoCreateGUID(TmpGUID) = S_OK then sGUID := GUIDToString(TmpGUID) else sGUID := '0'; Result:=sGUID; end; //------------------------------------------------------------------------------ //ÑÓʱº¯Êý£¬MSecsµ¥Î»ÎªºÁÃë(ǧ·ÖÖ®1Ãë) //ÊäÈëÖµ£ººÁÃë,ÑÓʱʱ¼ä //------------------------------------------------------------------------------ procedure Delay1(MSecs: Longint); var First: Longint; begin for First:=1 to 10 do begin Sleep(Trunc(Msecs/10)); //Application.ProcessMessages; end; end; procedure Delay2(MSecs: Longint); var FirstTickCount, Now: Longint; begin FirstTickCount := GetTickCount(); repeat Application.ProcessMessages; Now := GetTickCount(); until (Now - FirstTickCount >= MSecs) or (Now < FirstTickCount); end; //------------------------------------------------------------------------------ //»ñÈ¡Èí¼þ°æȨÐÅÏ¢ //ÊäÈëÖµ£ºÓ¦ÓóÌÐòÃû //·µ»ØÖµ£º³õʼ»¯È«¾Ö±äÁ¿glxxx , °üÀ¨²úÆ·Ãû³Æ£¬²úÆ·°æ±¾£¬ÎļþÃèÊö£¬°æȨ£¬Îļþ°æ±¾£¬ // ¹«Ë¾Ãû³Æ£¬×¢²áÉ̱꣬ÍⲿÃû³Æ£¬Ô­Ê¼Ãû³ÆµÈ //------------------------------------------------------------------------------ procedure GetVersionInfo(AppExeName:string); var BufSize, Len:DWORD; Buf, Value:PChar; begin BufSize:=GetFileVersionInfoSize(PChar(AppExeName), BufSize); if BufSize>0 then begin Buf:=AllocMem(BufSize); GetFileVersionInfo(PChar(Application.ExeName), 0, BufSize, Buf); if VerQueryValue(Buf,PChar('StringFileInfo\080403A8\'+glVerInfo[1]),Pointer(Value),Len) then glProductName:=Value; if VerQueryValue(Buf,PChar('StringFileInfo\080403A8\'+glVerInfo[2]),Pointer(Value),Len) then glProductVersion:=Value; if VerQueryValue(Buf,PChar('StringFileInfo\080403A8\'+glVerInfo[3]),Pointer(Value),Len) then glFileDescription:=Value; if VerQueryValue(Buf,PChar('StringFileInfo\080403A8\'+glVerInfo[4]),Pointer(Value),Len) then glLegalCopyright:=Value; if VerQueryValue(Buf,PChar('StringFileInfo\080403A8\'+glVerInfo[5]),Pointer(Value),Len) then glFileVersion:=Value; if VerQueryValue(Buf,PChar('StringFileInfo\080403A8\'+glVerInfo[6]),Pointer(Value),Len) then glCompanyName:=Value; if VerQueryValue(Buf,PChar('StringFileInfo\080403A8\'+glVerInfo[7]),Pointer(Value),Len) then glLegalTrademarks:=Value; if VerQueryValue(Buf,PChar('StringFileInfo\080403A8\'+glVerInfo[8]),Pointer(Value),Len) then glInternalName:=Value; if VerQueryValue(Buf,PChar('StringFileInfo\080403A8\'+glVerInfo[9]),Pointer(Value),Len) then glOriginalFilename:=Value; FreeMem(Buf,BufSize); end; end; //------------------------------------------------------------------------------ // ö¾ÙϵͳCOM¿Ú£¬¼Óµ½COMÁбí // ÊäÈëÖµ£º¶Ë¿ÚÁбí // ·µ»ØÖµ£ºnil //------------------------------------------------------------------------------ procedure EnumComPorts(Ports: TStrings); var KeyHandle: HKEY; ErrCode, Index: Integer; ValueName, Data: string; ValueLen, DataLen, ValueType: DWORD; TmpPorts: TStringList; begin ErrCode := RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'HARDWARE\DEVICEMAP\SERIALCOMM', 0, KEY_READ, KeyHandle); if ErrCode <> ERROR_SUCCESS then Exit; // raise EComPort.Create(CError_RegError, ErrCode); TmpPorts := TStringList.Create; try Index := 0; repeat ValueLen := 256; DataLen := 256; SetLength(ValueName, ValueLen); SetLength(Data, DataLen); ErrCode := RegEnumValue(KeyHandle, Index, PChar(ValueName), Cardinal(ValueLen), nil, @ValueType, PByte(PChar(Data)), @DataLen); if ErrCode = ERROR_SUCCESS then begin SetLength(Data, DataLen); TmpPorts.Add(Data); Inc(Index); end else if ErrCode <> ERROR_NO_MORE_ITEMS then exit; //raise EComPort.Create(CError_RegError, ErrCode); until (ErrCode <> ERROR_SUCCESS) ; TmpPorts.Sort; Ports.Assign(TmpPorts); finally RegCloseKey(KeyHandle); TmpPorts.Free; end; end; function CheckComPort(ComPortName: string; var ComPortList: Tstrings): boolean; var reg: TRegistry; //uses µ¥ÔªÎļþRegistry ts: TStrings; //¼üÃû i: Integer; tl: TStringList; //´®¿ÚÃû³Æ nIndex: Integer; begin reg := TRegistry.Create; ts := TStringList.Create; try reg.RootKey := HKEY_LOCAL_MACHINE; reg.OpenKey('hardware\devicemap\serialcomm', False); reg.GetValueNames(ts); //»ñȡע²á±íÖд®¿ÚµÄ ¼üÃû tl := TStringList.Create; for i := 0 to ts.Count - 1 do begin tl.Add(reg.ReadString(ts.Strings[i])); //¸ù¾Ý¼üÃû£¬¶Áȡע²á±íÖжÔÓ¦µÄ´®¿ÚÃû³Æ£¨ÀýÈçCOM1£© end; tl.Sort; ComPortList := tl; Result := tl.Find(ComPortName, nIndex);//²éѯÊÇ·ñ´æÔÚ //ShowMessage(IntToStr((nIndex))); finally // tl.Free; ts.Free; reg.CloseKey; reg.Free; end; end; //------------------------------------------------------------------------------ // ×Ö·û´®×ª»»³É16½øÖÆ×Ö·û´® // ÊäÈëÖµ£ºASCII×Ö·û´® // ·µ»ØÖµ£ºASCIIת³É16½øÖÆÊý£¬²¢ÓÃstringÏÔʾ //------------------------------------------------------------------------------ function StrToHexStr(const S:string):string; var I:Integer; begin for I:=1 to Length(S) do begin if I=1 then Result:=IntToHex(Ord(S[1]),2) else Result:=Result+' '+IntToHex(Ord(S[I]),2); end; end; //×Ö·û´®×ª»»³ÉÊ®Áù½øÖÆ×Ö·û´®£¬ÖмäÎÞ¿Õ¸ñ£¡£¡£¡ function StrToHexStr1(const S:string):string; var I:Integer; ss:String; begin for I:=1 to Length(S) do ss:=ss+IntToHex(Integer(S[I]),2); Result:=ss; end; //------------------------------------------------------------------------------ // 16½øÖÆ×Ö·û´®×ª»»³É×Ö·û´® // ÊäÈëÖµ£º´ýת»»µÄ16½øÖÆ×Ö·û´® // ·µ»ØÖµ£ºASCII×Ö·û´® //------------------------------------------------------------------------------ function HexStrToStr(const S:string; bFlag:boolean=false):string; var t:Integer; ts, SS:string; M,Code:Integer; begin t:=1; Result:=''; //´¦Àí×Ö·û´® '00'-->'20' (¼´½«nullתΪ¿Õ¸ñ£¬·ÀÖ¹ÐнâÎöÖÕÖ¹) if bFlag then SS := StringReplace(S, '00', '20', [rfReplaceAll, rfIgnoreCase]) else SS := S ; while t<=Length(SS) do begin while (t<=Length(SS)) and (not (SS[t] in ['0'..'9','A'..'F','a'..'f'])) do inc(t); if (t+1>Length(SS))or(not (SS[t+1] in ['0'..'9','A'..'F','a'..'f'])) then ts:='$'+SS[t] else ts:='$'+SS[t]+SS[t+1]; Val(ts,M,Code); if Code=0 then Result:=Result+Chr(M); inc(t,2); end; end; //------------------------------------------------------------------------------ // ÒÔÊ®Áù½øÖÆ·½Ê½²é¿´ÄÚ´æµÄº¯Êý // ÊäÈëÖµ£ºÈÎÒâÀàÐÍÖµ¡¢ÖµµÄ³¤¶È // ·µ»ØÖµ£º16½øÖÆASCII£¬²¢ÓÃstringÏÔʾ //------------------------------------------------------------------------------ function GetMemBytes(var X; size: Integer): string; var pb: PByte; i: Integer; begin pb := PByte(X); for i := 0 to size - 1 do begin Result := Result + IntToHex(pb^, 2) + #32; Inc(pb); end; end; //------------------------------------------------------------------------------ // ±éÀúĿ¼ºÍ×ÓĿ¼ÏµÄÎļþÃû£¨¿É°´ºó׺Ãû±éÀú£© // ÊäÈëÖµ£ºFilePath-·¾¶Èç'C:\DIR'£¬ExtMask-Îļþºó׺Èç'*.*'£¬FileList-×Ö·û´®Áбí // SubDir-ÊÇ·ñ±éÀú×ÓĿ¼ // ·µ»ØÖµ£ºÎÞ£¬Ö±½Ó·ÃÎÊfileList×Ö·û´®Áбí // °üº¬Îļþ£ºContnrs £¨TQueueÀàʹÓã© // eg£ºGetFileListEx(dir, '*.tst', clbSodimFile.Items, False); //------------------------------------------------------------------------------ procedure GetFileListEx(FilePath, ExtMask: string; FileList: TStrings; SubDir: Boolean = True); function Match(FileName: string; MaskList: TStrings): Boolean; var i: integer; begin Result := False; for i := 0 to MaskList.Count - 1 do begin if MatchesMask(FileName, MaskList[i]) then begin Result := True; break; end; end; end; var FileRec: TSearchRec; MaskList: TStringList; begin if DirectoryExists(FilePath) then begin if FilePath[Length(FilePath)] <> '\' then FilePath := FilePath + '\'; if FindFirst(FilePath + '*.*', faAnyFile, FileRec) = 0 then begin MaskList := TStringList.Create; try ExtractStrings([';'], [], PChar(ExtMask), MaskList); FileList.BeginUpdate; repeat if ((FileRec.Attr and faDirectory) <> 0) and SubDir then begin if (FileRec.Name <> '.') and (FileRec.Name <> '..') then GetFileListEx(FilePath + FileRec.Name + '\', ExtMask, FileList); end else begin if Match(FilePath + FileRec.Name, MaskList) then //ÕâÀïÈç¹ûÖ»·µ»ØÎļþÃû£¬Ôò×¢Ê͵ô·¾¶¼´¿É // FileList.Add( { FilePath + } FileRec.Name); FileList.Add( FilePath + FileRec.Name); end; until FindNext(FileRec) <> 0; FileList.EndUpdate; finally MaskList.Free; end; end; FindClose(FileRec); end; end; //·µ»Ø²»´ø·¾¶µÄÎļþ¼¯ºÏ procedure GetFileList(FilePath, ExtMask: string; FileList: TStrings; SubDir: Boolean = True); function Match(FileName: string; MaskList: TStrings): Boolean; var i: integer; begin Result := False; for i := 0 to MaskList.Count - 1 do begin if MatchesMask(FileName, MaskList[i]) then begin Result := True; break; end; end; end; var FileRec: TSearchRec; MaskList: TStringList; begin if DirectoryExists(FilePath) then begin if FilePath[Length(FilePath)] <> '\' then FilePath := FilePath + '\'; if FindFirst(FilePath + '*.*', faAnyFile, FileRec) = 0 then begin MaskList := TStringList.Create; try ExtractStrings([';'], [], PChar(ExtMask), MaskList); FileList.BeginUpdate; repeat if ((FileRec.Attr and faDirectory) <> 0) and SubDir then begin if (FileRec.Name <> '.') and (FileRec.Name <> '..') then GetFileListEx(FilePath + FileRec.Name + '\', ExtMask, FileList); end else begin if Match(FilePath + FileRec.Name, MaskList) then //ÕâÀïÈç¹ûÖ»·µ»ØÎļþÃû£¬Ôò×¢Ê͵ô·¾¶¼´¿É FileList.Add( { FilePath + } FileRec.Name); //FileList.Add( FilePath + FileRec.Name); end; until FindNext(FileRec) <> 0; FileList.EndUpdate; finally MaskList.Free; end; end; FindClose(FileRec); end; end; //------------------------------------------------------------------------------ // ɾ³ýÕû¸öĿ¼ÏµÄÎļþ£¬°üÀ¨Ä¿Â¼ // ÊäÈëÖµ£ºPath-·¾¶Èç'C:\DIR'£¬IsDelDir-ÊÇ·ñɾ³ýĿ¼ // ·µ»ØÖµ£ºTrue-²Ù×÷³É¹¦ // eg£ºDeleteDirectory(dir, True); //------------------------------------------------------------------------------ function DeleteDir(Path: string;IsDelDir: Boolean = False): Boolean; var search: TSearchRec; ret: integer; key: string; begin if Path[Length(Path)] <> '\' then Path := Path + '\'; key := Path + '*.*'; ret := findFirst(key, faanyfile, search); while ret = 0 do begin if ((search.Attr and fadirectory) = fadirectory) then begin if (search.Name <> '.') and (search.name <> '..') then DeleteDirectory(Path + search.name); end else begin if ((search.Attr and fadirectory) <> fadirectory) then begin deletefile(Path + search.name); end; end; ret := FindNext(search); end; findClose(search); if IsDelDir then //Èç¹ûÐèҪɾ³ýÎļþ¼ÐÔòÌí¼Ó removedir(Path); result := True; end; //------------------------------------------------------------------------------ // ²Ù×÷ExcelµÄÏà¹Øº¯Êý // »ñÈ¡Excel°æ±¾£¬·µ»ØÖµ£º°æ±¾ºÅ11-2003£¬12-2007 {const Wordversion97 = 8; Wordversion2000 = 9; WordversionXP = 10; Wordversion2003 = 11; Wordversion2007 = 12;} //------------------------------------------------------------------------------ function GetInstalledWordVersion: Integer; var Excel: OLEVariant; begin try Excel:=CreateOLEObject('Excel.Application'); except on E: Exception do showmessage('»ñÈ¡Excle°æ±¾Ê±·¢Éú´íÎó£¡' + #13#10 + 'Òì³£ÀàÃû³Æ:' + E.ClassName + #13#10 + 'Òì³£ÐÅÏ¢:' + E.Message); end; result := Excel.version; Excel.Quit; FreeAndNil(Excel); end; //------------------------------------------------------------------------------ // Éú³ÉËæ»úÊý //------------------------------------------------------------------------------ function RandomNum:String; begin //Éú³ÉËæ»úÊý Result := FormatDateTime('yyyymmddhhnnss',Now) + IntToStr(Random(10))+IntToStr(Random(10))+IntToStr(Random(10))+IntToStr(Random(10)); end; //------------------------------------------------------------------------------ // TStringlist×Ô¶¨ÒåÅÅÐò²ÎÊý // Ó¦Ó÷¶Àý£º { sl := TStringList.Create; try sl.DelimitedText:='12,9.123,0.5,30'; //³õʼ»¯ÅÅÐòsl sl.Sorted:=false; //×Ô¶¨ÒåÅÅÐò sl.CustomSort(SortParam); //°´×Ô¶¨ÒåÅÅÐò²ÎÊýÖØÐÂÅÅÐò showmessage(sl.Text); //´òÓ¡ÅÅÐòºóµÄ½á¹û showmessage(sl.Strings[0]); //´òÓ¡×îСֵ showmessage(sl.Strings[sl.Count-1]); //´òÓ¡×î´óÖµ finally FreeAndNil(sl); end; } //------------------------------------------------------------------------------ function SortParam(List: TStringList; Index1, Index2: Integer): Integer; begin if StrToFloat(List[index1]) 0 then Result := Value * tmp + 0.5 else Result := Value * tmp - 0.5; Result := Trunc(Result) / tmp; end; {//Math //RoundMode²ÎÊý£ºÏòÏÂÉáÈë-rmTruncate£»ÏòÉÏÉáÈë-rmUp function RoundEx(const Value: Extended; const Digit: int = 0; RoundMode: TFPURoundingMode = rmUp): Extended; var RM: TFPURoundingMode; begin RM := GetRoundMode; try SetRoundMode(RoundMode); Result := Round(Value); finally SetRoundMode(RM); end; end; } //------------------------------------------------------------------------------ //ÖÐÎÄת³É array of byte Ó¦¸Ã¾ÍÊÇÄãÏëÒªµÄ½á¹û //ÓÃ×Ö½Ú·¢Ë͵½ÍøÂçÉϺͽÓÊÕµÄ //´øÖÐÎĵÄString תbyte //------------------------------------------------------------------------------ function UniCode2GB(S: string): string; var I: Integer; begin I := Length(S); while I >= 4 do begin try Result := WideChar(StrToInt('$' + S[I - 3] + S[I - 2] + S[I - 1] + S[I])) + Result; except end; I := I - 4; end; end; function GB2UniCode(GB: string): string; var s: string; i, j, k: integer; a: array[1..160] of char; begin s := ''; StringToWideChar(GB, @(a[1]), 500); i := 1; while ((a[i] <> #0) or (a[i + 1] <> #0)) do begin j := Integer(a[i]); k := Integer(a[i + 1]); s := s + Copy(Format('%X ', [k * $100 + j + $10000]), 2, 4); //S := S + Char(k)+Char(j); i := i + 2; end; Result := s; end; //------------------------------------------------------------------------------ //ÖØдSysUtilsµ¥ÔªµÄBoolToStr-->BoolToHexStr //Èë²Î£ºboolÖµ //·µ»Ø£º×Ö·û´®£¬False-0£¬True-1 //------------------------------------------------------------------------------ function BoolToHexStr(B: Boolean; UseBoolStrs: Boolean = False): string; const cSimpleBoolStrs: array [boolean] of String = ('00', '01'); begin if UseBoolStrs then begin if Length(TrueBoolStrs) = 0 then begin SetLength(TrueBoolStrs, 1); TrueBoolStrs[0] := DefaultTrueBoolStr; end; if Length(FalseBoolStrs) = 0 then begin SetLength(FalseBoolStrs, 1); FalseBoolStrs[0] := DefaultFalseBoolStr; end; if B then Result := TrueBoolStrs[0] else Result := FalseBoolStrs[0]; end else Result := cSimpleBoolStrs[B]; end; //------------------------------------------------------------------------------ // ½«Boolֵת³É×Ö·û´® // Èë²Î£ºbool // ·µ»Ø£ºFalse,True×Ö·û´® //------------------------------------------------------------------------------ function BoolToString(B: Boolean; UseBoolStrs: Boolean = False): string; const cSimpleBoolStrs: array [boolean] of String = ('False', 'True'); begin if UseBoolStrs then begin if Length(TrueBoolStrs) = 0 then begin SetLength(TrueBoolStrs, 1); TrueBoolStrs[0] := DefaultTrueBoolStr; end; if Length(FalseBoolStrs) = 0 then begin SetLength(FalseBoolStrs, 1); FalseBoolStrs[0] := DefaultFalseBoolStr; end; if B then Result := TrueBoolStrs[0] else Result := FalseBoolStrs[0]; end else Result := cSimpleBoolStrs[B]; end; //------------------------------------------------------------------------------ //½«ÈÕÆÚ¸ñʽת»»³ÉUnixʱ¼ä´Á , ³¤¶È8×Ö½Ú //Èë²Î£ºDelphiÈÕÆÚʱ¼ä //·µ»Ø£º³¤ÕûÐÎÊýÖµ£¬´Ó1970-01-01 00:00:00 µ½ADateµÄÃëÊý //------------------------------------------------------------------------------ function DateTimeToUnixDate(const ADate: TDateTime): Longint; const cUnixStartDate: TDateTime = 25569.0; // 1970/01/01 begin Result := Round((ADate - cUnixStartDate) * 86400) - 8*3600;//¶«°ËÇøÐÞÕý8Сʱ end; //------------------------------------------------------------------------------ // ½«ÕûÊý10241ת³É '10.1KB' ×Ö·û´® // Èë²Î£ºÕûÊý // ·µ»Ø£º×Ö·û´® //------------------------------------------------------------------------------ function FormatFileSize(size:Int64):String; var size1 : String; begin //²»×ã1KBµÄÊý¾Ý£¬°´1KÏÔʾ if size<1024 then size:=1 else size := floor(size/1024); //´ÓKB¿ªÊ¼£¬Ìí¼Óµ¥Î»ºó·µ»Ø×Ö·û´® if size<1024 then size1 := IntToStr(size) + ' KB' else if (size>=1024)and(size<1048576) then size1 := FormatFloat('#.#',size/1024) + ' MB' else if (size>=1048576)and(size<1073741824) then size1 := FormatFloat('#.##',size/1048576) + ' GB' else size1 := FormatFloat('#.##',size/1073741824) + ' TB'; Result := size1; end; //------------------------------------------------------------------------------ // ½«ÕûÊý10241ת³É '1.02Íò'£¬120000000ת³É '1.2ÒÚ' ×Ö·û´® // Èë²Î£ºÕûÊý // ·µ»Ø£º×Ö·û´® //------------------------------------------------------------------------------ function FormatNumberSize(num:Int64):String; var new : String; begin if num<10000 then new := IntToStr(num)+' ' else if (num>=10000)and(num<100000000) then new := FormatFloat('#.##',num/10000) + ' Íò' else new := FormatFloat('#.##',num/100000000) + ' ÒÚ'; Result := new; end; //------------------------------------------------------------------------------ // ´Ó×Ö·û´®strÖа´·Ö¸ô·ûchr½ØÈ¡µÚi¸ö×Ö·û´®£¬·µ»Ø½ØÈ¡µ½µÄ×Ö·û´® //------------------------------------------------------------------------------ function SplitStr(str:string;chr:char;i:Integer):string; var sltemp : TStringlist; begin sltemp := TStringlist.Create(); try SplitString(str,chr,sltemp); Result := sltemp.Strings[i]; finally FreeAndNil(sltemp); end; end; //·µ»Ø·Ö¸îºóµÄ¼Ç¼ÌõÊý function SplitStrCount(str:string; chr:char):Integer; var sltemp : TStringlist; begin sltemp := TStringlist.Create(); try SplitString(str,chr,sltemp); Result := sltemp.Count; finally FreeAndNil(sltemp); end; end; //------------------------------------------------------------------------------ // WindowsÏÂɱ½ø³Ì£¬¸ù¾Ý±êÌâ²éɱ //------------------------------------------------------------------------------ procedure KillProgram(WindowTitle: string); const PROCESS_TERMINATE = $0001; var ProcessHandle : THandle; ProcessID: Integer; TheWindow : HWND; begin TheWindow := FindWindow(nil, PChar(WindowTitle)); GetWindowThreadProcessID(TheWindow, @ProcessID); ProcessHandle := OpenProcess(PROCESS_TERMINATE, FALSE, ProcessId); TerminateProcess(ProcessHandle,4); end; //------------------------------------------------------------------------------ // WindowsÏÂɱ½ø³Ì£¬¸ù¾ÝexeÃû³Æ²éɱ //------------------------------------------------------------------------------ function KillTask(ExeFileName: string): integer; const PROCESS_TERMINATE=$0001; var ContinueLoop: BOOL; FSnapshotHandle: THandle; FProcessEntry32: TProcessEntry32; begin result := 0; FSnapshotHandle := CreateToolhelp32Snapshot (TH32CS_SNAPPROCESS, 0); FProcessEntry32.dwSize := Sizeof(FProcessEntry32); ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); while integer(ContinueLoop) <> 0 do begin if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) then Result := Integer(TerminateProcess(OpenProcess( PROCESS_TERMINATE, BOOL(0), FProcessEntry32.th32ProcessID), 0)); ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); end; CloseHandle(FSnapshotHandle); end; //------------------------------------------------------------------------------ //Ë¢ÐÂÈÎÎñÀ¸Òò½ø³Ì¹Ø±Õ¶ø²ÐÁôµÄͼ±ê //------------------------------------------------------------------------------ procedure RefreshTaskbarIcon; var hShellTrayWnd: HWND; //ÈÎÎñÀ¸´°¿Ú hTrayNotifyWnd: HWND; //ÈÎÎñÀ¸ÓÒ±ßÍÐÅÌͼ±ê+ʱ¼äÇø hSysPager: HWND; //²»Í¬ÏµÍ³¿ÉÄÜÓпÉÄÜûÓÐÕâ²ã hToolbarWindow32: HWND; //ÍÐÅÌͼ±ê´°¿Ú r: TRECT; width, height: integer; x: Integer; begin hShellTrayWnd := FindWindow('Shell_TrayWnd',nil); hTrayNotifyWnd := FindWindowEx(hShellTrayWnd,0,'TrayNotifyWnd',nil); hSysPager := FindWindowEx(hTrayNotifyWnd,0,'SysPager',nil); if (hSysPager <> 0) then hToolbarWindow32 := FindWindowEx(hSysPager,0,'ToolbarWindow32',nil) else hToolbarWindow32 := FindWindowEx(hTrayNotifyWnd,0,'ToolbarWindow32',nil); if (hToolbarWindow32 <> 0) then begin GetWindowRect(hToolbarWindow32,r); width := r.right - r.left; height := r.bottom - r.top; //´ÓÈÎÎñÀ¸Öмä´Ó×óµ½ÓÒ MOUSEMOVEÒ»±é£¬ËùÓÐͼ±ê״̬»á±»¸üРfor x := 1 to width-1 do SendMessage(hToolbarWindow32,WM_MOUSEMOVE,0,MAKELPARAM(x,trunc(height/2))); end; end; //ÁíÒ»ÖÖË¢ÐÂÈÎÎñÀ¸Í¼±êµÄ·½·¨ procedure RefreshTaskbarIcon2; var TrayWindow : HWnd; WindowRect : TRect; SmallIconWidth : Integer; SmallIconHeight : Integer; CursorPos : TPoint; Row : Integer; Col : Integer; begin { »ñµÃÈÎÎñÀ¸¾ä±úºÍ±ß¿ò} TrayWindow := FindWindowEx(FindWindow('Shell_TrayWnd',NIL),0,'TrayNotifyWnd',NIL); if not GetWindowRect(TrayWindow,WindowRect) then Exit; { »ñµÃСͼ±ê´óС} SmallIconWidth := GetSystemMetrics(SM_CXSMICON); SmallIconHeight := GetSystemMetrics(SM_CYSMICON); { ±£´æµ±Ç°Êó±êλÖÃ} GetCursorPos(CursorPos); { ʹÊó±ê¿ìËÙ»®¹ýÿ¸öͼ±ê } with WindowRect do begin for Row := 0 to (Bottom - Top) DIV SmallIconHeight do begin for Col := 0 to (Right - Left) DIV SmallIconWidth do begin SetCursorPos(Left + Col * SmallIconWidth, Top + Row * SmallIconHeight); Sleep(10); //·¢ÏÖÕâ¸öµØ·½²ÎÊýΪ 0 µÄʱºò£¬ÓÐʱºòÊDz»¹»µÄ end; end; end; {»Ö¸´Êó±êλÖÃ} SetCursorPos(CursorPos.X,CursorPos.Y); { ÖØ»­ÈÎÎñÀ¸ } RedrawWindow(TrayWindow,NIL,0,RDW_INVALIDATE OR RDW_ERASE OR RDW_UPDATENOW); end; //------------------------------------------------------------------------------ //Ç¿ÐйرղÙ×÷ϵͳµÄº¯Êý //------------------------------------------------------------------------------ {procedure RebootSystem(); begin if GetOperatingSystem() = 'Windows NT/2000/XP' then begin Get_Shutdown_Privilege(); //µ÷Óô˺¯Êý»á³öÏÖϵͳ¹Ø»úÌáʾ´°¿Ú£¬²¢ÔÊÐíÓû§È¡Ïû¹Ø»ú¶¯×÷£¬È¥µô¾Í²»ÏÔʾÌáʾ´°¿Ú //InitiateSystemShutDown(nil, '¹Ø»úÌáʾ', 3, True, False); //ExitWindowsEx(EWX_SHUTDOWN+EWX_FORCE+EWX_POWEROFF+EWX_FORCEIFHUNG,0); ExitWindowsEx(EWX_REBOOT+EWX_FORCE+EWX_POWEROFF+EWX_FORCEIFHUNG, $FFFF); end else begin ExitWindowsEx(EWX_REBOOT+EWX_FORCE+EWX_POWEROFF+EWX_FORCEIFHUNG, $FFFF); end; end; } //»ñÈ¡²Ù×÷ϵͳÐÅÏ¢ function GetOperatingSystem(): string; var osVerInfo: TOSVersionInfo; begin Result:= ''; osVerInfo.dwOSVersionInfoSize:= SizeOf(TOSVersionInfo); if GetVersionEx(osVerInfo) then case osVerInfo.dwPlatformId of VER_PLATFORM_WIN32_NT: begin Result:= 'Windows NT/2000/XP' end; VER_PLATFORM_WIN32_WINDOWS: begin Result := 'Windows 95/98/98SE/Me'; end; end; end; //»ñµÃÓû§¹Ø»úÌØȨ£¬½ö¶ÔWindows NT/2000/XP {procedure Get_Shutdown_Privilege(); var rl: Cardinal; hToken: Cardinal; tkp: TOKEN_PRIVILEGES; begin OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken); if LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid) then begin tkp.Privileges[0].Attributes:= SE_PRIVILEGE_ENABLED; tkp.PrivilegeCount:= 1; AdjustTokenPrivileges(hToken, False, tkp, 0, nil, rl); end; end; } //----------------------------------------------------------------------------// // ¸ù¾Ý³ÌÐòÃû³Æ»ñÈ¡ HWNDµÄ·½·¨ // // 1.GetHWndByPID()»ñÈ¡PID£»2.GetHwndByAppName()»ñÈ¡HWND // //----------------------------------------------------------------------------// //¸ù¾Ý ProcessId»ñÈ¡½ø³ÌµÄ´°¿Ú¾ä±úÈçÏ£º //1.ͨ¹ýEnumWindowsö¾ÙËùÓд°¿Ú //2.ʹÓÃGetWindowThreadProcessID£¬Í¨¹ý´°¿Ú¾ä±ú»ñÈ¡½ø³ÌID //3.±È½Ï»ñÈ¡µÄ½ø³ÌIDÓ뵱ǰÒÑÖªµÄ½ø³ÌID£¬ÅжÏÊÇ·ñΪÐèÒªµÄ´°¿Ú //¸ú¾ÝProcessId»ñÈ¡½ø³ÌµÄ´°¿Ú¾ä±ú function GetHWndByPID(const hPID: THandle): THandle; type PEnumInfo = ^TEnumInfo; TEnumInfo = record ProcessID: DWORD; HWND: THandle; end; function EnumWindowsProc(Wnd: DWORD; var EI: TEnumInfo): Bool; stdcall; var PID: DWORD; begin GetWindowThreadProcessID(Wnd, @PID); Result := (PID <> EI.ProcessID) or (not IsWindowVisible(WND)) or (not IsWindowEnabled(WND)); if not Result then EI.HWND := WND; end; function FindMainWindow(PID: DWORD): DWORD; var EI: TEnumInfo; begin EI.ProcessID := PID; EI.HWND := 0; EnumWindows(@EnumWindowsProc, Integer(@EI)); Result := EI.HWND; end; begin if hPID<>0 then Result:=FindMainWindow(hPID) else Result:=0; end; //----------------------------------------------------------------------------- //¸ù¾Ý AppName»ñÈ¡³ÌÐòHWND //Èë²Î = 'Ó¦ÓóÌÐòÃû.exe' //·µ»Ø = ³ÌÐò¾ä±ú //----------------------------------------------------------------------------- function GetHwndByAppName(const AppName: String): THandle; var pName : string; //½ø³ÌÃû hSnapshot : THandle; //½ø³Ì¿ìÕÕ¾ä±ú tPE : TProcessEntry32; //½ø³ÌÈë¿ÚµÄ½á¹¹ÌåÐÅÏ¢ flag : BOOL; begin Result := 0; hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0); //´´½¨Ò»¸ö½ø³Ì¿ìÕÕ tPE.dwSize:= Sizeof(tPE); flag := Process32First(hSnapshot, tPE); //µÃµ½ÏµÍ³ÖеÚÒ»¸ö½ø³Ì //Ñ­»·Àý¾Ù while flag do begin pName := tPE.szExeFile; if(pName = AppName) then Result := GetHWndByPID(tPE.th32ProcessID); flag := Process32Next(hSnapshot, tPE); end; CloseHandle(hSnapshot); // ÊÍ·Å¿ìÕÕ¾ä±ú end; //----------------------------------------------------------------------------- //·â×°µÄ¶¯Ì¬Dllº¯Êýµ÷Ó÷½·¨ //CallFunc('user32.dll', 'MessageBoxA', [0, 'hello world', 'title', MB_OK]); //CallFunc('user32.dll', 'MessageBeep', []); //CallFunc('kernel32.dll', 'Sleep', [1000]); //----------------------------------------------------------------------------- function CallFunc(dllname, funcname: string; const param: array of const): DWORD; var hLib: THandle; pFunc: Pointer; intSize: Integer; begin Result := 0; hLib := LoadLibrary(PChar(dllname)); if hLib <> 0 then begin pFunc := GetProcAddress(hLib, PChar(funcname)); if pFunc <> nil then begin // »ñÈ¡²ÎÊý´óС intSize := Length(param); // ×Ô¶¯Íê³Éº¯Êýµ÷ÓÃ, asmʵÏÖ asm push ecx push esi mov ecx, intSize; // ²ÎÊýµÄ¸öÊý mov esi, param test ecx, ecx // ÅжÏÊÇ·ñÓвÎÊý je @call // Èç¹ûûÓвÎÊýÔòÌøתµ½º¯Êýµ÷Óô¦ @again: dec ecx push dword ptr [esi + ecx * 8] // Ñ­»·°Ñ²ÎÊýѹÈë¶ÑÕ» cmp ecx, 0 jnz @again // һֱѭ»·µ½ ecx Ϊ0 @call: call pFunc // µ÷Óú¯Êý mov @Result, eax // ·µ»ØÖµ pop esi pop ecx end; end; FreeLibrary(hLib); end; end; //------------------------------------------------------------------------------ // µ÷ÓÃwindowsϵͳ ping ²âÊÔÍøÂçÊÇ·ñͨ³© // °üº¬Îļþ Winsock // Èë²Î£ºIPµØÖ· // ·µ»Ø£ºfalse or true //------------------------------------------------------------------------------ function PingHost(HostIP: String): Boolean; type PIPOptionInformation = ^TIPOptionInformation; TIPOptionInformation = packed record TTL:Byte; TOS:Byte; Flags:Byte; OptionsSize:Byte; OptionsData:PChar; end; 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 hICMP:THandle; hICMPdll:THandle; IcmpCreateFile:TIcmpCreateFile; IcmpCloseHandle:TIcmpCloseHandle; IcmpSendEcho:TIcmpSendEcho; pIPE:PIcmpEchoReply;// ICMP Echo reply buffer FIPAddress:DWORD; FSize:DWORD; FTimeOut:DWORD; BufferSize:DWORD; pReqData,pRevData:PChar; MyString:string; begin Result:=False; hICMPdll:=LoadLibrary('icmp.dll'); if hICMPdll=0 then exit; @ICMPCreateFile:=GetProcAddress(hICMPdll,'IcmpCreateFile'); @IcmpCloseHandle:=GetProcAddress(hICMPdll,'IcmpCloseHandle'); @IcmpSendEcho:=GetProcAddress(hICMPdll, 'IcmpSendEcho'); hICMP := IcmpCreateFile; if (hICMP=INVALID_HANDLE_VALUE) then exit; FIPAddress:=inet_addr(PChar(HostIP)); MyString := 'Hello,World'; //send data buffer pReqData:=PChar(MyString); FSize:=40; //receive data buffer BufferSize:=SizeOf(TICMPEchoReply)+FSize; GetMem(pIPE,BufferSize); FillChar(pIPE^,SizeOf(pIPE^), 0); GetMem(pRevData,FSize); pIPE^.Data:=pRevData; FTimeOut:=500; try Result:=IcmpSendEcho(hICMP, FIPAddress, pReqData, Length(MyString), nil, pIPE, BufferSize, FTimeOut)>0; finally IcmpCloseHandle(hICMP); FreeLibrary(hICMPdll); FreeMem(pRevData); FreeMem(pIPE); end; end; //------------------------------------------------------------------------------ // ÃèÊö£ºÃëתʱ¼ä×Ö·û´® // Èë²Î£ºInteger-Ãë // ·µ»Ø£ºString-HH:MM:SS¸ñʽ×Ö·û´® //------------------------------------------------------------------------------ function SecondToTime(sec:Integer):String; begin Result := TimeToStr(sec/86400); end; // ÃèÊö£ºÃëת»»³ÉTDateTIme¸ñʽ function SecondToTime1(second: Word): TDateTime; var Hour, Min, Sec: Word; begin Hour := second div 3600; Min := (second div 60) mod 60; Sec := second mod 60; Result := EncodeTime(Hour, Min, Sec, 0); end; //------------------------------------------------------------------------------ // À©³äDateUtils¿â£¬Ôö¼Ó±±¾©Ê±¼äתInt64ʱ¼ä¸ñʽ£¬×¢Òâ¼õȥʱÇø // ˵Ã÷£º {uses DateUtils; DateTimeToUnix(Now)¿ÉÒÔת»»µ½unixʱ¼ä£¬µ«ÊÇ×¢ÒâµÄÊÇ£¬ËüµÃµ½µÄʱ¼ä ±ÈcÓïÑÔÖÐtime()µÃµ½µÄʱ¼ä´óÁË8*60*60 ÒòΪNowÊǵ±Ç°Ê±ÇøµÄʱ¼ä£¬cÓïÑÔÖÐtime()ÊÇ°´¸ñÁÖÍþÖÎʱ¼ä¼ÆËãµÄ£¬ ±±¾©Ê±¼ä±È¸ñÁÖÍþÖÎʱ¼ä¶àÁË8Сʱ DateTimeToUnix(Now)-8*60*60 ¾ÍºÍcÓïÑÔÖÐtime()µÃµ½µÄÒ»ÑùÁË} //------------------------------------------------------------------------------ // ʹÓÃʾÀý£ºDateTimeToUnixPro(VarToDateTime(edit1.Text)) function DateTimeToUnixPro(const AValue: TDateTime): Int64; begin Result := DateTimeToUnix(AValue)- 8*60*60 ; end; function UnixToDateTimePro(const AValue: Int64): TDateTime; begin Result := UnixToDateTime(floor(AValue/1000) + 8*60*60); end; //------------------------------------------------------------------------------ // ¿Æѧ¼ÆÊý·¨Ó븡µãÐÍÊý×Ö»¥×ª£¬²ÉÓÃ×Ö·û´®ÊäÈëÊä³ö // uses SysUtils // // eg: '-1.4857E-02' --> '-0.014857' //------------------------------------------------------------------------------ //¿Æѧ¼ÆÊýת¸¡µãÐÍ£¬'-1.4857E-02' --> '-0.014857' function ExpToFloat(s:String):String; var f : Extended; begin f := StrToFloatDef(s,0); Result := FloatToStr(f); end; //¸¡µãÐÍת¿Æѧ¼ÆÊý£¬'-0.014857' --> '-1.4857E-02' function FloatToExp(s:String):String; var f : Extended; begin f := StrToFloatDef(s,0); Result := FloatToStrF(f, ffExponent,7,2); end; //------------------------------------------------------------------------------ // ½«Boolֵת³É¿ª¹Ø×Ö·û // Èë²Î£ºbool // ·µ»Ø£º¿ªÆô,¹Ø±Õ×Ö·û´® //------------------------------------------------------------------------------ function BoolToString1(B: Boolean; UseBoolStrs: Boolean = False): string; const cSimpleBoolStrs: array [boolean] of String = ('¹Ø±Õ', '¿ªÆô'); begin if UseBoolStrs then begin if Length(TrueBoolStrs) = 0 then begin SetLength(TrueBoolStrs, 1); TrueBoolStrs[0] := '¿ªÆô'; end; if Length(FalseBoolStrs) = 0 then begin SetLength(FalseBoolStrs, 1); FalseBoolStrs[0] := '¹Ø±Õ'; end; if B then Result := TrueBoolStrs[0] else Result := FalseBoolStrs[0]; end else Result := cSimpleBoolStrs[B]; end; //------------------------------------------------------------------------------ // ½«Boolֵת³É¿ª¹Ø×Ö·û // Èë²Î£ºbool // ·µ»Ø£º¿ª,¹Ø×Ö·û´® //------------------------------------------------------------------------------ function BoolToString3(B: Boolean; UseBoolStrs: Boolean = False): string; const cSimpleBoolStrs: array [boolean] of String = ('¹Ø', '¿ª'); begin if UseBoolStrs then begin if Length(TrueBoolStrs) = 0 then begin SetLength(TrueBoolStrs, 1); TrueBoolStrs[0] := '¿ª'; end; if Length(FalseBoolStrs) = 0 then begin SetLength(FalseBoolStrs, 1); FalseBoolStrs[0] := '¹Ø'; end; if B then Result := TrueBoolStrs[0] else Result := FalseBoolStrs[0]; end else Result := cSimpleBoolStrs[B]; end; //------------------------------------------------------------------------------ // ½«Boolֵת³É¿ª¹Ø×Ö·û // Èë²Î£ºbool // ·µ»Ø£º0,1×Ö·û´® //------------------------------------------------------------------------------ function BoolToString2(B: Boolean; UseBoolStrs: Boolean = False): string; const cSimpleBoolStrs: array [boolean] of String = ('0', '1'); begin if UseBoolStrs then begin if Length(TrueBoolStrs) = 0 then begin SetLength(TrueBoolStrs, 1); TrueBoolStrs[0] := '1'; end; if Length(FalseBoolStrs) = 0 then begin SetLength(FalseBoolStrs, 1); FalseBoolStrs[0] := '0'; end; if B then Result := TrueBoolStrs[0] else Result := FalseBoolStrs[0]; end else Result := cSimpleBoolStrs[B]; end; function BoolToString4(B: Boolean; UseBoolStrs: Boolean = False): string; const cSimpleBoolStrs: array [boolean] of String = ('false', 'true'); begin if UseBoolStrs then begin if Length(TrueBoolStrs) = 0 then begin SetLength(TrueBoolStrs, 1); TrueBoolStrs[0] := DefaultTrueBoolStr; end; if Length(FalseBoolStrs) = 0 then begin SetLength(FalseBoolStrs, 1); FalseBoolStrs[0] := DefaultFalseBoolStr; end; if B then Result := TrueBoolStrs[0] else Result := FalseBoolStrs[0]; end else Result := cSimpleBoolStrs[B]; end; //------------------------------------------------------------------------ // ÕûÐÎתΪ²¼¶ûÖµ // ÊäÈ룺integer // Êä³ö£ºTrue/False // ˵Ã÷£ºÈç¹ûAValue²»µÈÓÚ0£¬ÔòResultΪTrue£¬·ñÔòΪFalse¡£ //------------------------------------------------------------------------ function IntToBool(AValue: Integer): Boolean; begin Result := AValue <> 0; // Èç¹ûAValue²»µÈÓÚ0£¬ÔòResultΪTrue£¬·ñÔòΪFalse¡£ end; //------------------------------------------------------------------------ // ÏßÐÔ²åÖµËã·¨ // ÊäÈ룺£¨x0¡¢y0)(x1¡¢y1)£¬¼°ÐèÒª²åÖµµÄÄ¿±êµãxµÄÖµ // Êä³ö£ºx¶ÔÓ¦µÄ²åÖµyÖµ // ˵Ã÷£º¸Ãº¯ÊýµÄʵÏÖÔ­ÀíÊǸù¾ÝÏßÐÔ²åÖµµÄ¹«Ê½£¬¼ÆËãÄ¿±êµãx¶ÔÓ¦µÄyÖµ¡£ // º¯ÊýÊ×ÏȼÆËã³öÄ¿±êµãxÔÚÊý¾Ýµãx0ºÍx1Ö®¼äµÄλÖÃÕ¼±È£¬¼´(x - x0) / (x1 - x0)£¬ // È»ºó½«¸Ã±ÈÀý³ËÒÔy1 - y0£¬²¢¼ÓÉÏy0£¬¼´¿ÉµÃµ½Ä¿±êµãx¶ÔÓ¦µÄ²åÖµyÖµ¡£ //------------------------------------------------------------------------ function LinearInterpolation(x0, y0, x1, y1, x: Double): Double; begin Result := y0 + (y1 - y0) * (x - x0) / (x1 - x0); end; //------------------------------------------------------------------------------ // À­¸ñÀÊÈÕ²åÖµËã·¨ // Èë²Î£ºx£º±íʾ¸ø¶¨µÄÒ»×é x ×ø±ê£¬ÊÇÒ»¸öʵÊýÊý×é¡£ // y£º±íʾ¸ø¶¨µÄÒ»×é y ×ø±ê£¬Ò²ÊÇÒ»¸öʵÊýÊý×飬Óë x Êý×éÒ»Ò»¶ÔÓ¦¡£ // n£º±íʾ x ºÍ y Êý×éÖеÄÊý¾Ýµã¸öÊý¡£ // xi£º±íʾҪÇó½âµÄ x ×ø±ê£¬¼´ÒªÇóÔÚ x ÖáÉÏÕÒµ½ÓëÖ®¶ÔÓ¦µÄ y ×ø±ê¡£ // ·µ»ØÖµ£º·µ»Ø xi ¶ÔÓ¦µÄ y ×ø±ê¡£ // º¯ÊýʵÏÖ£º¶¨ÁËÁ½¸öÑ­»·±äÁ¿ i ºÍ j£¬ÓÃÓÚ±éÀú x ºÍ y Êý×顣ȻºóÔÚÍâ²ãÑ­»·ÖУ¬ // ±éÀúÿ¸öÊý¾Ýµã i£¬¼ÆËã¶ÔÓ¦µÄ Lagrange ²åÖµ¶àÏîʽ L£¬½«Ã¿¸öÊý¾Ýµã // Lagrange ¶àÏîʽ L Óë¶ÔÓ¦µÄ y ×ø±êÏà³Ë£¬²¢ÇóºÍµÃµ½ p¡£ // ×îºó·µ»Ø p£¬¼´ÎªËùÇóµÄ xi ¶ÔÓ¦µÄ y ×ø±ê¡£ //------------------------------------------------------------------------------ function LagrangeInterpolation(x, y: array of Double; n: Integer; xi: Double): Double; var i, j: Integer; p, L: Double; begin p := 0.0; for i := 0 to n do begin L := 1.0; for j := 0 to n do if j <> i then L := L * (xi - x[j]) / (x[i] - x[j]); p := p + y[i] * L; end; Result := p; end; //------------------------------------------------------------------------------ // Å£¶Ù²åÖµËã·¨ // Èë²Î£ºx£º±íʾ¸ø¶¨µÄÒ»×é x ×ø±ê£¬ÊÇÒ»¸öʵÊýÊý×é¡£ // fx£º±íʾ¸ø¶¨µÄÒ»×é y ×ø±ê£¬Ò²ÊÇÒ»¸öʵÊýÊý×飬Óë x Êý×éÒ»Ò»¶ÔÓ¦¡£ // n£º±íʾ x ºÍ y Êý×éÖеÄÊý¾Ýµã¸öÊý¡£ // t£º±íʾҪÇó½âµÄ x ×ø±ê£¬¼´ÒªÇóÔÚ x ÖáÉÏÕÒµ½ÓëÖ®¶ÔÓ¦µÄ y ×ø±ê¡£ // ·µ»ØÖµ£º·µ»Ø t ¶ÔÓ¦µÄ y ×ø±ê¡£ //------------------------------------------------------------------------------ function NewtonInterpolation(x, fx: array of Double; n: Integer; t: Double): Double; var i, j: Integer; c: array of Double; sum: Double; begin SetLength(c, n); for i := 0 to n - 1 do c[i] := fx[i]; for i := 1 to n - 1 do begin for j := n - 1 downto i do c[j] := (c[j] - c[j - 1]) / (x[j] - x[j - i]); end; sum := c[n - 1]; for i := n - 2 downto 0 do begin sum := c[i] + (t - x[i]) * sum; end; Result := sum; end; //------------------------------------------------------------------------------ // ×îС¶þ³Ë·¨²åÖµËã·¨ // Èë²Î£ºÊý×é x ºÍ y // Êý×鳤¶È n // ²ÎÊý t±íʾҪ²åÖµµÄλÖà // ·µ»Ø£º²åÖµ½á¹û // ¹«Ê½£ºf(t) = a * t + b + (y[i] - a * x[i] - b) * sum[(x[i] - t)^2] / sum[(x[i] - t)^2] // ½âÊÍ£ºÆäÖУ¬a ºÍ b ÊÇ×îС¶þ³Ë·¨µÄϵÊý£¬y[i] ºÍ x[i] ·Ö±ðÊÇÊäÈëÊý×éµÄµÚ i ¸ö // ÔªËصÄÖµ¡£sum[] ±íʾÇóºÍ·ûºÅ¡£º¯Êýͨ¹ý¼ÆËã a ºÍ b£¬È»ºó¼ÆËã f(t) À´»ñµÃ²åÖµ½á¹û¡£ //------------------------------------------------------------------------------ function LeastSquaresInterpolation(x, y: array of Double; n: Integer; t: Double): Double; function dot2(a, b: array of Double): Double; var i: Integer; begin Result := 0; for i := 0 to Length(a) - 1 do Result := Result + a[i] * b[i]; end; function dot1(a: array of Double): Double; begin Result := dot2(a, a); end; var i : Integer; a, b, c, d, s, ss: Double; begin if n < 2 then begin Result := 0; Exit; end; s := 0; ss := 0; for i := 0 to n - 1 do begin s := s + y[i]; ss := ss + sqr(y[i]); end; a := (n * dot2(x, y) - dot1(x) * s) / (n * dot2(x, x) - sqr(dot1(x))); b := (s - a * dot1(x)) / n; c := 0; d := 0; for i := 0 to n - 1 do begin c := c + (y[i] - a * x[i] - b) * sqr(x[i] - t); d := d + sqr(x[i] - t); end; Result := a * t + b + c / d; end; //------------------------------------------------------------------------ // ±´Ò¶Ë¹²åÖµËã·¨ // Èë²Î£ºxºÍyÊÇÒÑÖªµÄÊý¾Ýµã£¬xiÊDzåÖµµÄλÖã¬sigmaÊǸß˹ºËº¯ÊýµÄ´ø¿í²ÎÊý // Êä³ö£º // ˵Ã÷£º¸ÃË㷨ʹÓøß˹ºËº¯ÊýÀ´¶ÔÊäÈëÊý¾Ý½øÐмÓȨ£¬ÒÔ±ãÉú³É²åÖµ½á¹û¡£ÆäÖУ¬ // GaussianKernel()¼ÆËãÁ½µãÖ®¼äµÄ¸ß˹ºËº¯ÊýÖµ£¬BayesianInterpolation() // ¼ÆËã¼ÓȨƽ¾ùÖµ²¢·µ»Ø²åÖµ½á¹û¡£ //------------------------------------------------------------------------ function BayesianInterpolation(x,y: array of Double; xi: Double; sigma: Double): Double; function GaussianKernel(x, xi, sigma: Double): Double; begin GaussianKernel := exp(-(x - xi) * (x - xi) / (2 * sigma * sigma)); end; var n, i: Integer; k, W, Wsum, yfit: Double; begin n := Length(x); Wsum := 0; yfit := 0; for i := 0 to n - 1 do begin k := GaussianKernel(x[i], xi, sigma); W := k / sigma; Wsum := Wsum + W; yfit := yfit + W * y[i]; end; BayesianInterpolation := yfit / Wsum; end; //------------------------------------------------------------------------------ // »ñÈ¡13λInt64¸ñʽºÁÃë // Èë²Î£ºµ±Ç°Ê±¼ä-1970-1-1 00:00:00 // ·µ»Ø£ºInt64¸ñʽºÁÃë //------------------------------------------------------------------------------ function GetTimeStampMilliseconds:string; var SysTime:TsystemTime; timen,time2:TDateTime; ss2,ss3:int64; str2:string; begin GetLocalTime(SysTime); timen:= SystemTimeToDateTime(SysTime); time2 := EncodeDateTime( 1970, 1, 1, 0, 0, 0, 0 ); ss2 := 28800000; ss3 := MilliSecondsBetween( timen, time2 ); ss3 :=ss3- ss2; str2 := IntToStr(ss3); result:=str2; end; function GetMillisecondTimeStamp: Int64; var st: TDateTime; begin st := EncodeDateTime( 1970, 1, 1, 0, 0, 0, 0 ); Result := MilliSecondsBetween( Now, st )-8*60*60*1000; end; //½»»»16½øÖÆÊýµÄ¸ßµÍλ // ABCD--> CDAB function SwapHighLowWord(Value: Word): Word; begin // ½»»»¸ßµÍλ Result := (Value and $FF) shl 8 or (Value and $FF00) shr 8; end; end.