{------------------------------------------------------------------------------}
|
{ÏîÄ¿Ãû³Æ£º¹«¹²ÏîÄ¿ }
|
{µ¥ÔªÃû³Æ£º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])<StrToFloat(List[Index2]) then
|
result:=-1
|
else if StrToFloat(List[index1])=StrToFloat(List[Index2]) then
|
Result:=0
|
else
|
Result:=1;
|
end;
|
|
//------------------------------------------------------------------------------
|
//´«Í³µÄ"ËÄÉáÎåÈë"·½·¨
|
//------------------------------------------------------------------------------
|
function RoundEx(const Value: Extended; const Digit: Byte = 0): Extended;
|
var
|
tmp: Extended;
|
begin
|
tmp := Power(10, Digit);
|
if Value > 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.
|
