 | 
|
|
|
{$INCLUDE ..\cDefines.inc}
unit cUtils;
{ }
{ Miscellaneous utility functions v3.36 }
{ }
{ This unit is copyright © 2000-2004 by David J Butler }
{ }
{ This unit is part of Delphi Fundamentals. }
{ Its original file name is cUtils.pas }
{ It was generated 1 Aug 2004 23:29. }
{ The latest version is available from the Fundamentals home page }
{ http://fundementals.sourceforge.net/ }
{ }
{ I invite you to use this unit, free of charge. }
{ I invite you to distibute this unit, but it must be for free. }
{ I also invite you to contribute to its development, }
{ but do not distribute a modified copy of this file. }
{ }
{ A forum is available on SourceForge for general discussion }
{ http://sourceforge.net/forum/forum.php?forum_id=2117 }
{ }
{ }
{ Revision history: }
{ 2000/02/02 0.01 Initial version }
{ 2000/03/08 1.02 Added RealArray / IntegerArray functions. }
{ 2000/04/10 1.03 Added Append, Renamed Delete to Remove and added }
{ StringArrays. }
{ 2000/05/03 1.04 Added Path functions. }
{ 2000/05/08 1.05 Revision. }
{ 188 lines interface. 1171 lines implementation. }
{ 2000/06/01 1.06 Added Range and Dup constructors for dynamic arrays. }
{ 2000/06/03 1.07 Added ArrayInsert functions. }
{ 2000/06/06 1.08 Moved bit functions from cMaths. }
{ 2000/06/08 1.09 Removed TInteger, TReal, TRealArray, TIntegerArray. }
{ 299 lines interface. 2019 lines implementations. }
{ 2000/06/10 1.10 Added linked lists for Integer, Int64, Extended and }
{ String. }
{ 518 lines interface. 3396 lines implementation. }
{ 2000/06/14 1.11 cUtils now generated from a template using a source }
{ pre-processor that uses cUtils. }
{ 560 lines interface. 1328 lines implementation. }
{ Produced source: 644 lines interface, 4716 lines }
{ implementation. }
{ 2000/07/04 1.12 Revision for Fundamentals release. }
{ 2000/07/24 1.13 Added TrimArray functions. }
{ 2000/07/26 1.14 Added Difference functions. }
{ 2000/09/02 1.15 Added RemoveDuplicates functions. }
{ Added Count functions. }
{ Fixed bug in Sort. }
{ 2000/09/27 1.16 Fixed bug in ArrayInsert. }
{ 2000/11/29 1.17 Moved SetFPUPrecision to cSysUtils. }
{ 2001/05/03 1.18 Improved bit functions. Added Pascal versions of }
{ assembly routines. }
{ Templ: 867 lines interface, 2886 lines implementation. }
{ Source: 939 lines interface, 9796 lines implementation. }
{ 2001/05/13 1.19 Added CharCount. }
{ 2001/05/15 1.20 Added PosNext (ClassType, ObjectArray). }
{ 2001/05/18 1.21 Added hashing functions from cMaths. }
{ 2001/07/07 1.22 Added TBinaryTreeNode. }
{ 2001/11/11 2.23 Revision. }
{ 2002/01/03 2.24 Moved EncodeBase64, DecodeBase64 from cMaths and }
{ optimized. Added LongWordToHex, HexToLongWord. }
{ 2002/03/30 2.25 Fixed bug in DecodeBase64. }
{ 2002/04/02 2.26 Removed dependencies on all other units (incl. Delphi )
{ units) to remove initialization code associated with }
{ SysUtils. This allows usage of cUtils in projects }
{ and still have very small binaries. }
{ Fixed bug in LongWordToHex. }
{ 2002/05/31 3.27 Refactored for Fundamentals 3. }
{ Moved linked lists to cLinkedLists. }
{ 2002/08/09 3.28 Added HashInteger. }
{ 2002/10/06 3.29 Renamed Cond to iif. }
{ 2002/12/12 3.30 Small revisions. }
{ 2003/03/14 3.31 Removed ApproxZero. Added FloatZero, FloatsEqual and }
{ FloatsCompare. Added documentation and test cases for }
{ comparison functions. }
{ Added support for Currency type. }
{ 2003/07/27 3.32 Added fast ZeroMem and FillMem routines. }
{ 2003/09/11 3.33 Added InterfaceArray functions. }
{ 2004/01/18 3.34 Added WideStringArray functions. }
{ 2004/07/24 3.35 Optimizations of Sort functions. }
{ 2005/08/01 3.36 Improved validation in base conversion routines. }
{ }
interface
const
UnitName = 'cUtils';
UnitVersion = '3.36';
UnitDesc = 'Miscelleanous utility functions';
UnitCopyright = 'Copyright (c) 2000-2004 David J Butler';
FundamentalsMajorVersion = 3;
FundamentalsMinorVersion = 28;
{$WRITEABLECONST OFF}
{ }
{ Integer types }
{ Byte unsigned 8 bits }
{ Word unsigned 16 bits }
{ LongWord unsigned 32 bits }
{ ShortInt signed 8 bits }
{ SmallInt signed 16 bits }
{ LongInt signed 32 bits }
{ Int64 signed 64 bits }
{ Integer signed system word }
{ Cardinal unsigned system word }
{ }
type
Int8 = ShortInt;
Int16 = SmallInt;
Int32 = LongInt;
LargeInt = Int64;
PLargeInt = ^LargeInt;
Word8 = Byte;
Word16 = Word;
Word32 = LongWord;
{$IFDEF DELPHI5_DOWN}
PBoolean = ^Boolean;
PByte = ^Byte;
PWord = ^Word;
PLongWord = ^LongWord;
PShortInt = ^ShortInt;
PSmallInt = ^SmallInt;
PLongInt = ^LongInt;
PInteger = ^Integer;
PInt64 = ^Int64;
{$ENDIF}
LongIntRec = packed record
case Integer of
0 : (Lo, Hi : Word);
1 : (Words : Array[0..1] of Word);
2 : (Bytes : Array[0..3] of Byte);
end;
const
MinByte = Low(Byte);
MaxByte = High(Byte);
MinWord = Low(Word);
MaxWord = High(Word);
MinShortInt = Low(ShortInt);
MaxShortInt = High(ShortInt);
MinSmallInt = Low(SmallInt);
MaxSmallInt = High(SmallInt);
MinLongWord = LongWord(Low(LongWord));
MaxLongWord = LongWord(High(LongWord));
MinLongInt = LongInt(Low(LongInt));
MaxLongInt = LongInt(High(LongInt));
MaxInt64 = Int64(High(Int64));
MinInt64 = Int64(Low(Int64));
MinInteger = Integer(Low(Integer));
MaxInteger = Integer(High(Integer));
MinCardinal = Cardinal(Low(Cardinal));
MaxCardinal = Cardinal(High(Cardinal));
const
BitsPerByte = 8;
BitsPerWord = 16;
BitsPerLongWord = 32;
BytesPerCardinal = Sizeof(Cardinal);
BitsPerCardinal = BytesPerCardinal * 8;
{ Min returns smallest of A and B }
{ Max returns greatest of A and B }
function MinI(const A, B: Integer): Integer;
function MaxI(const A, B: Integer): Integer;
function MinC(const A, B: Cardinal): Cardinal;
function MaxC(const A, B: Cardinal): Cardinal;
{ Clip returns Value if in Low..High range, otherwise Low or High }
function Clip(const Value: Integer; const Low, High: Integer): Integer;
function ClipByte(const Value: Integer): Integer;
function ClipWord(const Value: Integer): Integer;
function ClipLongWord(const Value: Int64): LongWord;
function SumClipI(const A, I: Integer): Integer;
function SumClipC(const A: Cardinal; const I: Integer): Cardinal;
{ InXXXRange returns True if A in range of type XXX }
function InByteRange(const A: Int64): Boolean;
function InWordRange(const A: Int64): Boolean;
function InLongWordRange(const A: Int64): Boolean;
function InShortIntRange(const A: Int64): Boolean;
function InSmallIntRange(const A: Int64): Boolean;
function InLongIntRange(const A: Int64): Boolean;
{ }
{ Real types }
{ }
{ Floating point: }
{ Single 32 bits 7-8 significant digits }
{ Double 64 bits 15-16 significant digits }
{ Extended 80 bits 19-20 significant digits }
{ }
{ Fixed point: }
{ Currency 64 bits 19-20 significant digits, 4 after the decimal point. }
{ }
type
Float = Extended;
PFloat = ^Float;
const
MinSingle : Single = 1.5E-45;
MaxSingle : Single = 3.4E+38;
MinDouble : Double = 5.0E-324;
MaxDouble : Double = 1.7E+308;
MinExtended : Extended = 3.4E-4932;
MaxExtended : Extended = 1.1E+4932;
{$IFDEF FREEPASCAL}
MinCurrency = -922337203685477.5807;
MaxCurrency = 922337203685477.5807;
{$ELSE}
MinCurrency : Currency = -922337203685477.5807;
MaxCurrency : Currency = 922337203685477.5807;
{$ENDIF}
{$IFDEF DELPHI5_DOWN}
type
PSingle = ^Single;
PDouble = ^Double;
PExtended = ^Extended;
PCurrency = ^Currency;
{$ENDIF}
type
TExtended = packed record
Case Boolean of
True: (
Mantissa : packed Array[0..1] of LongWord; { MSB of [1] is the normalized 1 bit }
Exponent : Word; { MSB is the sign bit }
);
False: (Value: Extended);
end;
const
ExtendedNan : TExtended = (Mantissa:($FFFFFFFF, $FFFFFFFF); Exponent:$7FFF);
ExtendedInfinity : TExtended = (Mantissa:($00000000, $80000000); Exponent:$7FFF);
{ Min returns smallest of A and B }
{ Max returns greatest of A and B }
{ Clip returns Value if in Low..High range, otherwise Low or High }
function MinF(const A, B: Extended): Extended;
function MaxF(const A, B: Extended): Extended;
function ClipF(const Value: Extended; const Low, High: Extended): Extended;
{ InXXXRange returns True if A in range of type XXX }
function InSingleRange(const A: Extended): Boolean;
function InDoubleRange(const A: Extended): Boolean;
function InCurrencyRange(const A: Extended): Boolean; overload;
function InCurrencyRange(const A: Int64): Boolean; overload;
{ }
{ Bit functions }
{ All bit functions operate on 32-bit values (LongWord). }
{ }
function ClearBit(const Value, BitIndex: LongWord): LongWord;
function SetBit(const Value, BitIndex: LongWord): LongWord;
function IsBitSet(const Value, BitIndex: LongWord): Boolean;
function ToggleBit(const Value, BitIndex: LongWord): LongWord;
function IsHighBitSet(const Value: LongWord): Boolean;
function SetBitScanForward(const Value: LongWord): Integer; overload;
function SetBitScanForward(const Value, BitIndex: LongWord): Integer; overload;
function SetBitScanReverse(const Value: LongWord): Integer; overload;
function SetBitScanReverse(const Value, BitIndex: LongWord): Integer; overload;
function ClearBitScanForward(const Value: LongWord): Integer; overload;
function ClearBitScanForward(const Value, BitIndex: LongWord): Integer; overload;
function ClearBitScanReverse(const Value: LongWord): Integer; overload;
function ClearBitScanReverse(const Value, BitIndex: LongWord): Integer; overload;
function ReverseBits(const Value: LongWord): LongWord; overload;
function ReverseBits(const Value: LongWord; const BitCount: Integer): LongWord; overload;
function SwapEndian(const Value: LongWord): LongWord;
Procedure SwapEndianBuf(var Buf; const Count: Integer);
function TwosComplement(const Value: LongWord): LongWord;
function RotateLeftBits(const Value: LongWord; const Bits: Byte): LongWord;
function RotateRightBits(const Value: LongWord; const Bits: Byte): LongWord;
function BitCount(const Value: LongWord): LongWord;
function IsPowerOfTwo(const Value: LongWord): Boolean;
function LowBitMask(const HighBitIndex: LongWord): LongWord;
function HighBitMask(const LowBitIndex: LongWord): LongWord;
function RangeBitMask(const LowBitIndex, HighBitIndex: LongWord): LongWord;
function SetBitRange(const Value: LongWord;
const LowBitIndex, HighBitIndex: LongWord): LongWord;
function ClearBitRange(const Value: LongWord;
const LowBitIndex, HighBitIndex: LongWord): LongWord;
function ToggleBitRange(const Value: LongWord;
const LowBitIndex, HighBitIndex: LongWord): LongWord;
function IsBitRangeSet(const Value: LongWord;
const LowBitIndex, HighBitIndex: LongWord): Boolean;
function IsBitRangeClear(const Value: LongWord;
const LowBitIndex, HighBitIndex: LongWord): Boolean;
const
BitMaskTable: Array[0..31] of LongWord =
($00000001, $00000002, $00000004, $00000008,
$00000010, $00000020, $00000040, $00000080,
$00000100, $00000200, $00000400, $00000800,
$00001000, $00002000, $00004000, $00008000,
$00010000, $00020000, $00040000, $00080000,
$00100000, $00200000, $00400000, $00800000,
$01000000, $02000000, $04000000, $08000000,
$10000000, $20000000, $40000000, $80000000);
{ }
{ Sets }
{ }
type
CharSet = Set of Char;
ByteSet = Set of Byte;
PCharSet = ^CharSet;
PByteSet = ^ByteSet;
const
CompleteCharSet = [#0..#255];
CompleteByteSet = [0..255];
function AsCharSet(const C: Array of Char): CharSet;
function AsByteSet(const C: Array of Byte): ByteSet;
procedure ComplementChar(var C: CharSet; const Ch: Char);
procedure ClearCharSet(var C: CharSet);
procedure FillCharSet(var C: CharSet);
procedure ComplementCharSet(var C: CharSet);
procedure AssignCharSet(var DestSet: CharSet; const SourceSet: CharSet); overload;
procedure Union(var DestSet: CharSet; const SourceSet: CharSet); overload;
procedure Difference(var DestSet: CharSet; const SourceSet: CharSet); overload;
procedure Intersection(var DestSet: CharSet; const SourceSet: CharSet); overload;
procedure XORCharSet(var DestSet: CharSet; const SourceSet: CharSet);
function IsSubSet(const A, B: CharSet): Boolean;
function IsEqual(const A, B: CharSet): Boolean; overload;
function IsEmpty(const C: CharSet): Boolean;
function IsComplete(const C: CharSet): Boolean;
function CharCount(const C: CharSet): Integer; overload;
procedure ConvertCaseInsensitive(var C: CharSet);
function CaseInsensitiveCharSet(const C: CharSet): CharSet;
{ }
{ Range functions }
{ }
function IntRangeLength(const Low, High: Integer): Int64;
function IntRangeAdjacent(const Low1, High1, Low2, High2: Integer): Boolean;
function IntRangeOverlap(const Low1, High1, Low2, High2: Integer): Boolean;
function IntRangeHasElement(const Low, High, Element: Integer): Boolean;
function IntRangeIncludeElement(var Low, High: Integer;
const Element: Integer): Boolean;
function IntRangeIncludeElementRange(var Low, High: Integer;
const LowElement, HighElement: Integer): Boolean;
function CardinalRangeLength(const Low, High: Cardinal): Int64;
function CardinalRangeAdjacent(const Low1, High1, Low2, High2: Cardinal): Boolean;
function CardinalRangeOverlap(const Low1, High1, Low2, High2: Cardinal): Boolean;
function CardinalRangeHasElement(const Low, High, Element: Cardinal): Boolean;
function CardinalRangeIncludeElement(var Low, High: Cardinal;
const Element: Cardinal): Boolean;
function CardinalRangeIncludeElementRange(var Low, High: Cardinal;
const LowElement, HighElement: Cardinal): Boolean;
{ }
{ Swap }
{ }
procedure Swap(var X, Y: Boolean); overload;
procedure Swap(var X, Y: Byte); overload;
procedure Swap(var X, Y: Word); overload;
procedure Swap(var X, Y: LongWord); overload;
procedure Swap(var X, Y: ShortInt); overload;
procedure Swap(var X, Y: SmallInt); overload;
procedure Swap(var X, Y: LongInt); overload;
procedure Swap(var X, Y: Int64); overload;
procedure Swap(var X, Y: Single); overload;
procedure Swap(var X, Y: Double); overload;
procedure Swap(var X, Y: Extended); overload;
procedure Swap(var X, Y: Currency); overload;
procedure Swap(var X, Y: String); overload;
procedure Swap(var X, Y: WideString); overload;
procedure Swap(var X, Y: Pointer); overload;
procedure Swap(var X, Y: TObject); overload;
procedure SwapObjects(var X, Y);
{ }
{ Inline if }
{ }
{ iif returns TrueValue if Expr is True, otherwise it returns FalseValue. }
{ }
function iif(const Expr: Boolean; const TrueValue: Integer;
const FalseValue: Integer = 0): Integer; overload;
function iif(const Expr: Boolean; const TrueValue: Int64;
const FalseValue: Int64 = 0): Int64; overload;
function iif(const Expr: Boolean; const TrueValue: Extended;
const FalseValue: Extended = 0.0): Extended; overload;
function iif(const Expr: Boolean; const TrueValue: String;
const FalseValue: String = ''): String; overload;
function iif(const Expr: Boolean; const TrueValue: TObject;
const FalseValue: TObject = nil): TObject; overload;
{ }
{ Comparison }
{ }
type
TCompareResult = (
crLess,
crEqual,
crGreater,
crUndefined);
TCompareResultSet = Set of TCompareResult;
function ReverseCompareResult(const C: TCompareResult): TCompareResult;
{ }
{ Direct comparison }
{ }
{ Compare(I1, I2) returns crLess if I1 < I2, crEqual if I1 = I2 or }
{ crGreater if I1 > I2. }
{ }
function Compare(const I1, I2: Boolean): TCompareResult; overload;
function Compare(const I1, I2: Integer): TCompareResult; overload;
function Compare(const I1, I2: Int64): TCompareResult; overload;
function Compare(const I1, I2: Extended): TCompareResult; overload;
function Compare(const I1, I2: String): TCompareResult; overload;
function WideCompare(const I1, I2: WideString): TCompareResult;
{ }
{ Approximate comparison of floating point values }
{ }
{ FloatZero, FloatOne, FloatsEqual and FloatsCompare are functions for }
{ comparing floating point numbers based on a fixed CompareDelta difference }
{ between the values. This means that values are considered equal if the }
{ unsigned difference between the values are less than CompareDelta. }
{ }
const
// Minimum CompareDelta values for the different floating point types:
// The values were chosen to be slightly higher than the minimum value that
// the floating-point type can store.
SingleCompareDelta = 1.0E-34;
DoubleCompareDelta = 1.0E-280;
ExtendedCompareDelta = 1.0E-4400;
// Default CompareDelta is set to SingleCompareDelta. This allows any type
// of floating-point value to be compared with any other.
DefaultCompareDelta = SingleCompareDelta;
function FloatZero(const A: Extended;
const CompareDelta: Extended = DefaultCompareDelta): Boolean;
function FloatOne(const A: Extended;
const CompareDelta: Extended = DefaultCompareDelta): Boolean;
function FloatsEqual(const A, B: Extended;
const CompareDelta: Extended = DefaultCompareDelta): Boolean;
function FloatsCompare(const A, B: Extended;
const CompareDelta: Extended = DefaultCompareDelta): TCompareResult;
{ }
{ Scaled approximate comparison of floating point values }
{ }
{ ApproxEqual and ApproxCompare are functions for comparing floating point }
{ numbers based on a scaled order of magnitude difference between the }
{ values. CompareEpsilon is the ratio applied to the largest of the two }
{ exponents to give the maximum difference (CompareDelta) for comparison. }
{ }
{ For example: }
{ }
{ When the CompareEpsilon is 1.0E-9, the result of }
{ }
{ ApproxEqual(1.0E+20, 1.000000001E+20) = False, but the result of }
{ ApproxEqual(1.0E+20, 1.0000000001E+20) = True, ie the first 9 digits of }
{ the mantissas of the values must be the same. }
{ }
{ Note that for A <> 0.0, the value of ApproxEqual(A, 0.0) will always be }
{ False. Rather use the unscaled FloatZero, FloatsEqual and FloatsCompare }
{ functions when specifically testing for zero. }
{ }
const
// Smallest (most sensitive) CompareEpsilon values allowed for the different
// floating point types:
SingleCompareEpsilon = 1.0E-5;
DoubleCompareEpsilon = 1.0E-13;
ExtendedCompareEpsilon = 1.0E-17;
// Default CompareEpsilon is set for half the significant digits of the
// Extended type.
DefaultCompareEpsilon = 1.0E-10;
function ApproxEqual(const A, B: Extended;
const CompareEpsilon: Double = DefaultCompareEpsilon): Boolean;
function ApproxCompare(const A, B: Extended;
const CompareEpsilon: Double = DefaultCompareEpsilon): TCompareResult;
{ }
{ Special floating-point values }
{ }
{ FloatIsInfinity is True if A is a positive or negative infinity. }
{ FloatIsNaN is True if A is Not-a-Number. }
{ }
function FloatIsInfinity(const A: Extended): Boolean;
function FloatIsNaN(const A: Extended): Boolean;
{ }
{ Base Conversion }
{ }
{ EncodeBase64 converts a binary string (S) to a base 64 string using }
{ Alphabet. if Pad is True, the result will be padded with PadChar to be a }
{ multiple of PadMultiple. }
{ }
{ DecodeBase64 converts a base 64 string using Alphabet (64 characters for }
{ values 0-63) to a binary string. }
{ }
const
s_HexDigitsUpper: String[16] = '0123456789ABCDEF';
s_HexDigitsLower: String[16] = '0123456789abcdef';
function IsHexChar(const Ch: Char): Boolean;
function IsHexWideChar(const Ch: WideChar): Boolean;
function HexCharValue(const Ch: Char): Byte;
function HexWideCharValue(const Ch: WideChar): Byte;
function LongWordToBin(const I: LongWord; const Digits: Byte = 0): String;
function LongWordToOct(const I: LongWord; const Digits: Byte = 0): String;
function LongWordToHex(const I: LongWord; const Digits: Byte = 0;
const UpperCase: Boolean = True): String;
function LongWordToStr(const I: LongWord; const Digits: Byte = 0): String;
function IsValidBinStr(const S: String): Boolean;
function IsValidOctStr(const S: String): Boolean;
function IsValidDecStr(const S: String): Boolean;
function IsValidHexStr(const S: String): Boolean;
{ xxxStrToLongWord converts a number in a specific base to a LongWord value. }
{ Valid is False on return if the string could not be converted. }
function BinStrToLongWord(const S: String; var Valid: Boolean): LongWord;
function OctStrToLongWord(const S: String; var Valid: Boolean): LongWord;
function DecStrToLongWord(const S: String; var Valid: Boolean): LongWord;
function HexStrToLongWord(const S: String; var Valid: Boolean): LongWord;
function EncodeBase64(const S, Alphabet: String; const Pad: Boolean = False;
const PadMultiple: Integer = 4; const PadChar: Char = '='): String;
function DecodeBase64(const S, Alphabet: String; const PadSet: CharSet = []): String;
const
b64_MIMEBase64 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
b64_UUEncode = ' !"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
b64_XXEncode = '+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
function MIMEBase64Decode(const S: String): String;
function MIMEBase64Encode(const S: String): String;
function UUDecode(const S: String): String;
function XXDecode(const S: String): String;
function BytesToHex(const P: Pointer; const Count: Integer;
const UpperCase: Boolean = True): String;
{ }
{ Type conversion }
{ }
function PointerToStr(const P: Pointer): String;
function StrToPointer(const S: String): Pointer;
function ObjectClassName(const O: TObject): String;
function ClassClassName(const C: TClass): String;
function ObjectToStr(const O: TObject): String;
function ClassToStr(const C: TClass): String;
function CharSetToStr(const C: CharSet): String;
function StrToCharSet(const S: String): CharSet;
{ }
{ Hashing functions }
{ }
{ HashBuf uses a every byte in the buffer to calculate a hash. }
{ }
{ HashStrBuf/HashStr is a general purpose string hashing function. }
{ For large strings, HashStr will sample up to 48 bytes from the string. }
{ }
{ If Slots = 0 the hash value is in the LongWord range (0-$FFFFFFFF), }
{ otherwise the value is in the range from 0 to Slots-1. Note that the }
{ 'mod' operation, which is used when Slots <> 0, is comparitively slow. }
{ }
function HashBuf(const Buf; const BufSize: Integer;
const Slots: LongWord = 0): LongWord;
function HashStrBuf(const StrBuf: Pointer; const StrLength: Integer;
const Slots: LongWord = 0): LongWord;
function HashStrBufNoCase(const StrBuf: Pointer; const StrLength: Integer;
const Slots: LongWord = 0): LongWord;
function HashStr(const S: String; const Slots: LongWord = 0;
const CaseSensitive: Boolean = True): LongWord;
function HashInteger(const I: Integer; const Slots: LongWord = 0): LongWord;
function HashLongWord(const I: LongWord; const Slots: LongWord = 0): LongWord;
{ }
{ Memory operations }
{ }
{$IFDEF DELPHI5_DOWN}
type
PPointer = ^Pointer;
{$ENDIF}
const
Bytes1KB = 1024;
Bytes1MB = 1024 * Bytes1KB;
Bytes1GB = 1024 * Bytes1MB;
Bytes64KB = 64 * Bytes1KB;
Bytes64MB = 64 * Bytes1MB;
Bytes2GB = 2 * LongWord(Bytes1GB);
procedure FillMem(var Buf; const Count: Integer; const Value: Byte);
procedure ZeroMem(var Buf; const Count: Integer);
procedure MoveMem(const Source; var Dest; const Count: Integer);
function CompareMem(const Buf1; const Buf2; const Count: Integer): Boolean;
function CompareMemNoCase(const Buf1; const Buf2; const Count: Integer): TCompareResult;
procedure ReverseMem(var Buf; const Size: Integer);
{ }
{ IInterface }
{ }
{$IFDEF DELPHI5_DOWN}
type
IInterface = interface
['{00000000-0000-0000-C000-000000000046}']
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
end;
{$ENDIF}
{ }
{ Array pointers }
{ }
{ Maximum array elements }
const
MaxArraySize = $7FFFFFFF; // 2 Gigabytes
MaxByteArrayElements = MaxArraySize div Sizeof(Byte);
MaxWordArrayElements = MaxArraySize div Sizeof(Word);
MaxLongWordArrayElements = MaxArraySize div Sizeof(LongWord);
MaxCardinalArrayElements = MaxArraySize div Sizeof(Cardinal);
MaxShortIntArrayElements = MaxArraySize div Sizeof(ShortInt);
MaxSmallIntArrayElements = MaxArraySize div Sizeof(SmallInt);
MaxLongIntArrayElements = MaxArraySize div Sizeof(LongInt);
MaxIntegerArrayElements = MaxArraySize div Sizeof(Integer);
MaxInt64ArrayElements = MaxArraySize div Sizeof(Int64);
MaxSingleArrayElements = MaxArraySize div Sizeof(Single);
MaxDoubleArrayElements = MaxArraySize div Sizeof(Double);
MaxExtendedArrayElements = MaxArraySize div Sizeof(Extended);
MaxCurrencyArrayElements = MaxArraySize div Sizeof(Currency);
MaxStringArrayElements = MaxArraySize div Sizeof(String);
MaxWideStringArrayElements = MaxArraySize div Sizeof(WideString);
MaxPointerArrayElements = MaxArraySize div Sizeof(Pointer);
MaxObjectArrayElements = MaxArraySize div Sizeof(TObject);
MaxInterfaceArrayElements = MaxArraySize div Sizeof(IInterface);
MaxBooleanArrayElements = MaxArraySize div Sizeof(Boolean);
MaxCharSetArrayElements = MaxArraySize div Sizeof(CharSet);
MaxByteSetArrayElements = MaxArraySize div Sizeof(ByteSet);
{ Static array types }
type
TStaticByteArray = Array[0..MaxByteArrayElements - 1] of Byte;
TStaticWordArray = Array[0..MaxWordArrayElements - 1] of Word;
TStaticLongWordArray = Array[0..MaxLongWordArrayElements - 1] of LongWord;
TStaticShortIntArray = Array[0..MaxShortIntArrayElements - 1] of ShortInt;
TStaticSmallIntArray = Array[0..MaxSmallIntArrayElements - 1] of SmallInt;
TStaticLongIntArray = Array[0..MaxLongIntArrayElements - 1] of LongInt;
TStaticInt64Array = Array[0..MaxInt64ArrayElements - 1] of Int64;
TStaticSingleArray = Array[0..MaxSingleArrayElements - 1] of Single;
TStaticDoubleArray = Array[0..MaxDoubleArrayElements - 1] of Double;
TStaticExtendedArray = Array[0..MaxExtendedArrayElements - 1] of Extended;
TStaticCurrencyArray = Array[0..MaxCurrencyArrayElements - 1] of Currency;
TStaticStringArray = Array[0..MaxStringArrayElements - 1] of String;
TStaticWideStringArray = Array[0..MaxWideStringArrayElements - 1] of WideString;
TStaticPointerArray = Array[0..MaxPointerArrayElements - 1] of Pointer;
TStaticObjectArray = Array[0..MaxObjectArrayElements - 1] of TObject;
TStaticInterfaceArray = Array[0..MaxInterfaceArrayElements - 1] of IInterface;
TStaticBooleanArray = Array[0..MaxBooleanArrayElements - 1] of Boolean;
TStaticCharSetArray = Array[0..MaxCharSetArrayElements - 1] of CharSet;
TStaticByteSetArray = Array[0..MaxByteSetArrayElements - 1] of ByteSet;
TStaticCardinalArray = TStaticLongWordArray;
TStaticIntegerArray = TStaticLongIntArray;
{ Array pointers }
type
PByteArray = ^TStaticByteArray;
PWordArray = ^TStaticWordArray;
PLongWordArray = ^TStaticLongWordArray;
PCardinalArray = ^TStaticCardinalArray;
PShortIntArray = ^TStaticShortIntArray;
PSmallIntArray = ^TStaticSmallIntArray;
PLongIntArray = ^TStaticLongIntArray;
PIntegerArray = ^TStaticIntegerArray;
PInt64Array = ^TStaticInt64Array;
PSingleArray = ^TStaticSingleArray;
PDoubleArray = ^TStaticDoubleArray;
PExtendedArray = ^TStaticExtendedArray;
PCurrencyArray = ^TStaticCurrencyArray;
PStringArray = ^TStaticStringArray;
PWideStringArray = ^TStaticWideStringArray;
PPointerArray = ^TStaticPointerArray;
PObjectArray = ^TStaticObjectArray;
PInterfaceArray = ^TStaticInterfaceArray;
PBooleanArray = ^TStaticBooleanArray;
PCharSetArray = ^TStaticCharSetArray;
PByteSetArray = ^TStaticByteSetArray;
{ }
{ Dynamic arrays }
{ }
type
ByteArray = Array of Byte;
WordArray = Array of Word;
LongWordArray = Array of LongWord;
ShortIntArray = Array of ShortInt;
SmallIntArray = Array of SmallInt;
LongIntArray = Array of LongInt;
Int64Array = Array of Int64;
SingleArray = Array of Single;
DoubleArray = Array of Double;
ExtendedArray = Array of Extended;
CurrencyArray = Array of Currency;
StringArray = Array of String;
WideStringArray = Array of WideString;
PointerArray = Array of Pointer;
ObjectArray = Array of TObject;
InterfaceArray = Array of IInterface;
BooleanArray = Array of Boolean;
CharSetArray = Array of CharSet;
ByteSetArray = Array of ByteSet;
IntegerArray = LongIntArray;
CardinalArray = LongWordArray;
function Append(var V: ByteArray; const R: Byte): Integer; overload;
function Append(var V: WordArray; const R: Word): Integer; overload;
function Append(var V: LongWordArray; const R: LongWord): Integer; overload;
function Append(var V: ShortIntArray; const R: ShortInt): Integer; overload;
function Append(var V: SmallIntArray; const R: SmallInt): Integer; overload;
function Append(var V: LongIntArray; const R: LongInt): Integer; overload;
function Append(var V: Int64Array; const R: Int64): Integer; overload;
function Append(var V: SingleArray; const R: Single): Integer; overload;
function Append(var V: DoubleArray; const R: Double): Integer; overload;
function Append(var V: ExtendedArray; const R: Extended): Integer; overload;
function Append(var V: CurrencyArray; const R: Currency): Integer; overload;
function Append(var V: StringArray; const R: String): Integer; overload;
function Append(var V: WideStringArray; const R: WideString): Integer; overload;
function Append(var V: BooleanArray; const R: Boolean): Integer; overload;
function Append(var V: PointerArray; const R: Pointer): Integer; overload;
function Append(var V: ObjectArray; const R: TObject): Integer; overload;
function Append(var V: InterfaceArray; const R: IInterface): Integer; overload;
function Append(var V: ByteSetArray; const R: ByteSet): Integer; overload;
function Append(var V: CharSetArray; const R: CharSet): Integer; overload;
function AppendByteArray(var V: ByteArray; const R: Array of Byte): Integer; overload;
function AppendWordArray(var V: WordArray; const R: Array of Word): Integer; overload;
function AppendCardinalArray(var V: CardinalArray; const R: Array of LongWord): Integer; overload;
function AppendShortIntArray(var V: ShortIntArray; const R: Array of ShortInt): Integer; overload;
function AppendSmallIntArray(var V: SmallIntArray; const R: Array of SmallInt): Integer; overload;
function AppendIntegerArray(var V: IntegerArray; const R: Array of LongInt): Integer; overload;
function AppendInt64Array(var V: Int64Array; const R: Array of Int64): Integer; overload;
function AppendSingleArray(var V: SingleArray; const R: Array of Single): Integer; overload;
function AppendDoubleArray(var V: DoubleArray; const R: Array of Double): Integer; overload;
function AppendExtendedArray(var V: ExtendedArray; const R: Array of Extended): Integer; overload;
function AppendCurrencyArray(var V: CurrencyArray; const R: Array of Currency): Integer; overload;
function AppendStringArray(var V: StringArray; const R: Array of String): Integer; overload;
function AppendPointerArray(var V: PointerArray; const R: Array of Pointer): Integer; overload;
function AppendObjectArray(var V: ObjectArray; const R: ObjectArray): Integer; overload;
function AppendCharSetArray(var V: CharSetArray; const R: Array of CharSet): Integer; overload;
function AppendByteSetArray(var V: ByteSetArray; const R: Array of ByteSet): Integer; overload;
function Remove(var V: ByteArray; const Idx: Integer; const Count: Integer = 1): Integer; overload;
function Remove(var V: WordArray; const Idx: Integer; const Count: Integer = 1): Integer; overload;
function Remove(var V: LongWordArray; const Idx: Integer; const Count: Integer = 1): Integer; overload;
function Remove(var V: ShortIntArray; const Idx: Integer; const Count: Integer = 1): Integer; overload;
function Remove(var V: SmallIntArray; const Idx: Integer; const Count: Integer = 1): Integer; overload;
function Remove(var V: LongIntArray; const Idx: Integer; const Count: Integer = 1): Integer; overload;
function Remove(var V: Int64Array; const Idx: Integer; const Count: Integer = 1): Integer; overload;
function Remove(var V: SingleArray; const Idx: Integer; const Count: Integer = 1): Integer; overload;
function Remove(var V: DoubleArray; const Idx: Integer; const Count: Integer = 1): Integer; overload;
function Remove(var V: ExtendedArray; const Idx: Integer; const Count: Integer = 1): Integer; overload;
function Remove(var V: CurrencyArray; const Idx: Integer; const Count: Integer = 1): Integer; overload;
function Remove(var V: StringArray; const Idx: Integer; const Count: Integer = 1): Integer; overload;
function Remove(var V: WideStringArray; const Idx: Integer; const Count: Integer = 1): Integer; overload;
function Remove(var V: PointerArray; const Idx: Integer; const Count: Integer = 1): Integer; overload;
function Remove(var V: ObjectArray; const Idx: Integer; const Count: Integer = 1;
const FreeObjects: Boolean = False): Integer; overload;
function Remove(var V: InterfaceArray; const Idx: Integer; const Count: Integer = 1): Integer; overload;
procedure RemoveDuplicates(var V: ByteArray; const IsSorted: Boolean); overload;
procedure RemoveDuplicates(var V: WordArray; const IsSorted: Boolean); overload;
procedure RemoveDuplicates(var V: LongWordArray; const IsSorted: Boolean); overload;
procedure RemoveDuplicates(var V: ShortIntArray; const IsSorted: Boolean); overload;
procedure RemoveDuplicates(var V: SmallIntArray; const IsSorted: Boolean); overload;
procedure RemoveDuplicates(var V: LongIntArray; const IsSorted: Boolean); overload;
procedure RemoveDuplicates(var V: Int64Array; const IsSorted: Boolean); overload;
procedure RemoveDuplicates(var V: SingleArray; const IsSorted: Boolean); overload;
procedure RemoveDuplicates(var V: DoubleArray; const IsSorted: Boolean); overload;
procedure RemoveDuplicates(var V: ExtendedArray; const IsSorted: Boolean); overload;
procedure RemoveDuplicates(var V: StringArray; const IsSorted: Boolean); overload;
procedure RemoveDuplicates(var V: PointerArray; const IsSorted: Boolean); overload;
procedure TrimArrayLeft(var S: ByteArray; const TrimList: Array of Byte); overload;
procedure TrimArrayLeft(var S: WordArray; const TrimList: Array of Word); overload;
procedure TrimArrayLeft(var S: LongWordArray; const TrimList: Array of LongWord); overload;
procedure TrimArrayLeft(var S: ShortIntArray; const TrimList: Array of ShortInt); overload;
procedure TrimArrayLeft(var S: SmallIntArray; const TrimList: Array of SmallInt); overload;
procedure TrimArrayLeft(var S: LongIntArray; const TrimList: Array of LongInt); overload;
procedure TrimArrayLeft(var S: Int64Array; const TrimList: Array of Int64); overload;
procedure TrimArrayLeft(var S: SingleArray; const TrimList: Array of Single); overload;
procedure TrimArrayLeft(var S: DoubleArray; const TrimList: Array of Double); overload;
procedure TrimArrayLeft(var S: ExtendedArray; const TrimList: Array of Extended); overload;
procedure TrimArrayLeft(var S: StringArray; const TrimList: Array of String); overload;
procedure TrimArrayLeft(var S: PointerArray; const TrimList: Array of Pointer); overload;
procedure TrimArrayRight(var S: ByteArray; const TrimList: Array of Byte); overload;
procedure TrimArrayRight(var S: WordArray; const TrimList: Array of Word); overload;
procedure TrimArrayRight(var S: LongWordArray; const TrimList: Array of LongWord); overload;
procedure TrimArrayRight(var S: ShortIntArray; const TrimList: Array of ShortInt); overload;
procedure TrimArrayRight(var S: SmallIntArray; const TrimList: Array of SmallInt); overload;
procedure TrimArrayRight(var S: LongIntArray; const TrimList: Array of LongInt); overload;
procedure TrimArrayRight(var S: Int64Array; const TrimList: Array of Int64); overload;
procedure TrimArrayRight(var S: SingleArray; const TrimList: Array of Single); overload;
procedure TrimArrayRight(var S: DoubleArray; const TrimList: Array of Double); overload;
procedure TrimArrayRight(var S: ExtendedArray; const TrimList: Array of Extended); overload;
procedure TrimArrayRight(var S: StringArray; const TrimList: Array of String); overload;
procedure TrimArrayRight(var S: PointerArray; const TrimList: Array of Pointer); overload;
function ArrayInsert(var V: ByteArray; const Idx: Integer; const Count: Integer): Integer; overload;
function ArrayInsert(var V: WordArray; const Idx: Integer; const Count: Integer): Integer; overload;
function ArrayInsert(var V: LongWordArray; const Idx: Integer; const Count: Integer): Integer; overload;
function ArrayInsert(var V: ShortIntArray; const Idx: Integer; const Count: Integer): Integer; overload;
function ArrayInsert(var V: SmallIntArray; const Idx: Integer; const Count: Integer): Integer; overload;
function ArrayInsert(var V: LongIntArray; const Idx: Integer; const Count: Integer): Integer; overload;
function ArrayInsert(var V: Int64Array; const Idx: Integer; const Count: Integer): Integer; overload;
function ArrayInsert(var V: SingleArray; const Idx: Integer; const Count: Integer): Integer; overload;
function ArrayInsert(var V: DoubleArray; const Idx: Integer; const Count: Integer): Integer; overload;
function ArrayInsert(var V: ExtendedArray; const Idx: Integer; const Count: Integer): Integer; overload;
function ArrayInsert(var V: CurrencyArray; const Idx: Integer; const Count: Integer): Integer; overload;
function ArrayInsert(var V: StringArray; const Idx: Integer; const Count: Integer): Integer; overload;
function ArrayInsert(var V: WideStringArray; const Idx: Integer; const Count: Integer): Integer; overload;
function ArrayInsert(var V: PointerArray; const Idx: Integer; const Count: Integer): Integer; overload;
function ArrayInsert(var V: ObjectArray; const Idx: Integer; const Count: Integer): Integer; overload;
function ArrayInsert(var V: InterfaceArray; const Idx: Integer; const Count: Integer): Integer; overload;
procedure FreeObjectArray(var V); overload;
procedure FreeObjectArray(var V; const LoIdx, HiIdx: Integer); overload;
procedure FreeAndNilObjectArray(var V: ObjectArray);
function PosNext(const Find: Byte; const V: ByteArray; const PrevPos: Integer = -1;
const IsSortedAscending: Boolean = False): Integer; overload;
function PosNext(const Find: Word; const V: WordArray; const PrevPos: Integer = -1;
const IsSortedAscending: Boolean = False): Integer; overload;
function PosNext(const Find: LongWord; const V: LongWordArray; const PrevPos: Integer = -1;
const IsSortedAscending: Boolean = False): Integer; overload;
function PosNext(const Find: ShortInt; const V: ShortIntArray; const PrevPos: Integer = -1;
const IsSortedAscending: Boolean = False): Integer; overload;
function PosNext(const Find: SmallInt; const V: SmallIntArray; const PrevPos: Integer = -1;
const IsSortedAscending: Boolean = False): Integer; overload;
function PosNext(const Find: LongInt; const V: LongIntArray; const PrevPos: Integer = -1;
const IsSortedAscending: Boolean = False): Integer; overload;
function PosNext(const Find: Int64; const V: Int64Array; const PrevPos: Integer = -1;
const IsSortedAscending: Boolean = False): Integer; overload;
function PosNext(const Find: Single; const V: SingleArray; const PrevPos: Integer = -1;
const IsSortedAscending: Boolean = False): Integer; overload;
function PosNext(const Find: Double; const V: DoubleArray; const PrevPos: Integer = -1;
const IsSortedAscending: Boolean = False): Integer; overload;
function PosNext(const Find: Extended; const V: ExtendedArray; const PrevPos: Integer = -1;
const IsSortedAscending: Boolean = False): Integer; overload;
function PosNext(const Find: Boolean; const V: BooleanArray; const PrevPos: Integer = -1;
const IsSortedAscending: Boolean = False): Integer; overload;
function PosNext(const Find: String; const V: StringArray; const PrevPos: Integer = -1;
const IsSortedAscending: Boolean = False): Integer; overload;
function PosNext(const Find: Pointer; const V: PointerArray;
const PrevPos: Integer = -1): Integer; overload;
function PosNext(const Find: TObject; const V: ObjectArray;
const PrevPos: Integer = -1): Integer; overload;
function PosNext(const ClassType: TClass; const V: ObjectArray;
const PrevPos: Integer = -1): Integer; overload;
function PosNext(const ClassName: String; const V: ObjectArray;
const PrevPos: Integer = -1): Integer; overload;
function Count(const Find: Byte; const V: ByteArray;
const IsSortedAscending: Boolean = False): Integer; overload;
function Count(const Find: Word; const V: WordArray;
const IsSortedAscending: Boolean = False): Integer; overload;
function Count(const Find: LongWord; const V: LongWordArray;
const IsSortedAscending: Boolean = False): Integer; overload;
function Count(const Find: ShortInt; const V: ShortIntArray;
const IsSortedAscending: Boolean = False): Integer; overload;
function Count(const Find: SmallInt; const V: SmallIntArray;
const IsSortedAscending: Boolean = False): Integer; overload;
function Count(const Find: LongInt; const V: LongIntArray;
const IsSortedAscending: Boolean = False): Integer; overload;
function Count(const Find: Int64; const V: Int64Array;
const IsSortedAscending: Boolean = False): Integer; overload;
function Count(const Find: Single; const V: SingleArray;
const IsSortedAscending: Boolean = False): Integer; overload;
function Count(const Find: Double; const V: DoubleArray;
const IsSortedAscending: Boolean = False): Integer; overload;
function Count(const Find: Extended; const V: ExtendedArray;
const IsSortedAscending: Boolean = False): Integer; overload;
function Count(const Find: String; const V: StringArray;
const IsSortedAscending: Boolean = False): Integer; overload;
function Count(const Find: Boolean; const V: BooleanArray;
const IsSortedAscending: Boolean = False): Integer; overload;
procedure RemoveAll(const Find: Byte; var V: ByteArray;
const IsSortedAscending: Boolean = False); overload;
procedure RemoveAll(const Find: Word; var V: WordArray;
const IsSortedAscending: Boolean = False); overload;
procedure RemoveAll(const Find: LongWord; var V: LongWordArray;
const IsSortedAscending: Boolean = False); overload;
procedure RemoveAll(const Find: ShortInt; var V: ShortIntArray;
const IsSortedAscending: Boolean = False); overload;
procedure RemoveAll(const Find: SmallInt; var V: SmallIntArray;
const IsSortedAscending: Boolean = False); overload;
procedure RemoveAll(const Find: LongInt; var V: LongIntArray;
const IsSortedAscending: Boolean = False); overload;
procedure RemoveAll(const Find: Int64; var V: Int64Array;
const IsSortedAscending: Boolean = False); overload;
procedure RemoveAll(const Find: Single; var V: SingleArray;
const IsSortedAscending: Boolean = False); overload;
procedure RemoveAll(const Find: Double; var V: DoubleArray;
const IsSortedAscending: Boolean = False); overload;
procedure RemoveAll(const Find: Extended; var V: ExtendedArray;
const IsSortedAscending: Boolean = False); overload;
procedure RemoveAll(const Find: String; var V: StringArray;
const IsSortedAscending: Boolean = False); overload;
function Intersection(const V1, V2: ByteArray;
const IsSortedAscending: Boolean = False): ByteArray; overload;
function Intersection(const V1, V2: WordArray;
const IsSortedAscending: Boolean = False): WordArray; overload;
function Intersection(const V1, V2: LongWordArray;
const IsSortedAscending: Boolean = False): LongWordArray; overload;
function Intersection(const V1, V2: ShortIntArray;
const IsSortedAscending: Boolean = False): ShortIntArray; overload;
function Intersection(const V1, V2: SmallIntArray;
const IsSortedAscending: Boolean = False): SmallIntArray; overload;
function Intersection(const V1, V2: LongIntArray;
const IsSortedAscending: Boolean = False): LongIntArray; overload;
function Intersection(const V1, V2: Int64Array;
const IsSortedAscending: Boolean = False): Int64Array; overload;
function Intersection(const V1, V2: SingleArray;
const IsSortedAscending: Boolean = False): SingleArray; overload;
function Intersection(const V1, V2: DoubleArray;
const IsSortedAscending: Boolean = False): DoubleArray; overload;
function Intersection(const V1, V2: ExtendedArray;
const IsSortedAscending: Boolean = False): ExtendedArray; overload;
function Intersection(const V1, V2: StringArray;
const IsSortedAscending: Boolean = False): StringArray; overload;
function Difference(const V1, V2: ByteArray;
const IsSortedAscending: Boolean = False): ByteArray; overload;
function Difference(const V1, V2: WordArray;
const IsSortedAscending: Boolean = False): WordArray; overload;
function Difference(const V1, V2: LongWordArray;
const IsSortedAscending: Boolean = False): LongWordArray; overload;
function Difference(const V1, V2: ShortIntArray;
const IsSortedAscending: Boolean = False): ShortIntArray; overload;
function Difference(const V1, V2: SmallIntArray;
const IsSortedAscending: Boolean = False): SmallIntArray; overload;
function Difference(const V1, V2: LongIntArray;
const IsSortedAscending: Boolean = False): LongIntArray; overload;
function Difference(const V1, V2: Int64Array;
const IsSortedAscending: Boolean = False): Int64Array; overload;
function Difference(const V1, V2: SingleArray;
const IsSortedAscending: Boolean = False): SingleArray; overload;
function Difference(const V1, V2: DoubleArray;
const IsSortedAscending: Boolean = False): DoubleArray; overload;
function Difference(const V1, V2: ExtendedArray;
const IsSortedAscending: Boolean = False): ExtendedArray; overload;
function Difference(const V1, V2: StringArray;
const IsSortedAscending: Boolean = False): StringArray; overload;
procedure Reverse(var V: ByteArray); overload;
procedure Reverse(var V: WordArray); overload;
procedure Reverse(var V: LongWordArray); overload;
procedure Reverse(var V: ShortIntArray); overload;
procedure Reverse(var V: SmallIntArray); overload;
procedure Reverse(var V: LongIntArray); overload;
procedure Reverse(var V: Int64Array); overload;
procedure Reverse(var V: SingleArray); overload;
procedure Reverse(var V: DoubleArray); overload;
procedure Reverse(var V: ExtendedArray); overload;
procedure Reverse(var V: StringArray); overload;
procedure Reverse(var V: PointerArray); overload;
procedure Reverse(var V: ObjectArray); overload;
function AsBooleanArray(const V: Array of Boolean): BooleanArray; overload;
function AsByteArray(const V: Array of Byte): ByteArray; overload;
function AsWordArray(const V: Array of Word): WordArray; overload;
function AsLongWordArray(const V: Array of LongWord): LongWordArray; overload;
function AsCardinalArray(const V: Array of Cardinal): CardinalArray; overload;
function AsShortIntArray(const V: Array of ShortInt): ShortIntArray; overload;
function AsSmallIntArray(const V: Array of SmallInt): SmallIntArray; overload;
function AsLongIntArray(const V: Array of LongInt): LongIntArray; overload;
function AsIntegerArray(const V: Array of Integer): IntegerArray; overload;
function AsInt64Array(const V: Array of Int64): Int64Array; overload;
function AsSingleArray(const V: Array of Single): SingleArray; overload;
function AsDoubleArray(const V: Array of Double): DoubleArray; overload;
function AsExtendedArray(const V: Array of Extended): ExtendedArray; overload;
function AsCurrencyArray(const V: Array of Currency): CurrencyArray; overload;
function AsStringArray(const V: Array of String): StringArray; overload;
function AsWideStringArray(const V: Array of WideString): WideStringArray; overload;
function AsPointerArray(const V: Array of Pointer): PointerArray; overload;
function AsCharSetArray(const V: Array of CharSet): CharSetArray; overload;
function AsObjectArray(const V: Array of TObject): ObjectArray; overload;
function AsInterfaceArray(const V: Array of IInterface): InterfaceArray; overload;
function RangeByte(const First: Byte; const Count: Integer;
const Increment: Byte = 1): ByteArray;
function RangeWord(const First: Word; const Count: Integer;
const Increment: Word = 1): WordArray;
function RangeLongWord(const First: LongWord; const Count: Integer;
const Increment: LongWord = 1): LongWordArray;
function RangeCardinal(const First: Cardinal; const Count: Integer;
const Increment: Cardinal = 1): CardinalArray;
function RangeShortInt(const First: ShortInt; const Count: Integer;
const Increment: ShortInt = 1): ShortIntArray;
function RangeSmallInt(const First: SmallInt; const Count: Integer;
const Increment: SmallInt = 1): SmallIntArray;
function RangeLongInt(const First: LongInt; const Count: Integer;
const Increment: LongInt = 1): LongIntArray;
function RangeInteger(const First: Integer; const Count: Integer;
const Increment: Integer = 1): IntegerArray;
function RangeInt64(const First: Int64; const Count: Integer;
const Increment: Int64 = 1): Int64Array;
function RangeSingle(const First: Single; const Count: Integer;
const Increment: Single = 1): SingleArray;
function RangeDouble(const First: Double; const Count: Integer;
const Increment: Double = 1): DoubleArray;
function RangeExtended(const First: Extended; const Count: Integer;
const Increment: Extended = 1): ExtendedArray;
function DupByte(const V: Byte; const Count: Integer): ByteArray;
function DupWord(const V: Word; const Count: Integer): WordArray;
function DupLongWord(const V: LongWord; const Count: Integer): LongWordArray;
function DupCardinal(const V: Cardinal; const Count: Integer): CardinalArray;
function DupShortInt(const V: ShortInt; const Count: Integer): ShortIntArray;
function DupSmallInt(const V: SmallInt; const Count: Integer): SmallIntArray;
function DupLongInt(const V: LongInt; const Count: Integer): LongIntArray;
function DupInteger(const V: Integer; const Count: Integer): IntegerArray;
function DupInt64(const V: Int64; const Count: Integer): Int64Array;
function DupSingle(const V: Single; const Count: Integer): SingleArray;
function DupDouble(const V: Double; const Count: Integer): DoubleArray;
function DupExtended(const V: Extended; const Count: Integer): ExtendedArray;
function DupCurrency(const V: Currency; const Count: Integer): CurrencyArray;
function DupString(const V: String; const Count: Integer): StringArray;
function DupCharSet(const V: CharSet; const Count: Integer): CharSetArray;
function DupObject(const V: TObject; const Count: Integer): ObjectArray;
procedure SetLengthAndZero(var V: ByteArray; const NewLength: Integer); overload;
procedure SetLengthAndZero(var V: WordArray; const NewLength: Integer); overload;
procedure SetLengthAndZero(var V: LongWordArray; const NewLength: Integer); overload;
procedure SetLengthAndZero(var V: ShortIntArray; const NewLength: Integer); overload;
procedure SetLengthAndZero(var V: SmallIntArray; const NewLength: Integer); overload;
procedure SetLengthAndZero(var V: LongIntArray; const NewLength: Integer); overload;
procedure SetLengthAndZero(var V: Int64Array; const NewLength: Integer); overload;
procedure SetLengthAndZero(var V: SingleArray; const NewLength: Integer); overload;
procedure SetLengthAndZero(var V: DoubleArray; const NewLength: Integer); overload;
procedure SetLengthAndZero(var V: ExtendedArray; const NewLength: Integer); overload;
procedure SetLengthAndZero(var V: CurrencyArray; const NewLength: Integer); overload;
procedure SetLengthAndZero(var V: CharSetArray; const NewLength: Integer); overload;
procedure SetLengthAndZero(var V: BooleanArray; const NewLength: Integer); overload;
procedure SetLengthAndZero(var V: PointerArray; const NewLength: Integer); overload;
procedure SetLengthAndZero(var V: ObjectArray; const NewLength: Integer;
const FreeObjects: Boolean = False); overload;
function IsEqual(const V1, V2: ByteArray): Boolean; overload;
function IsEqual(const V1, V2: WordArray): Boolean; overload;
function IsEqual(const V1, V2: LongWordArray): Boolean; overload;
function IsEqual(const V1, V2: ShortIntArray): Boolean; overload;
function IsEqual(const V1, V2: SmallIntArray): Boolean; overload;
function IsEqual(const V1, V2: LongIntArray): Boolean; overload;
function IsEqual(const V1, V2: Int64Array): Boolean; overload;
function IsEqual(const V1, V2: SingleArray): Boolean; overload;
function IsEqual(const V1, V2: DoubleArray): Boolean; overload;
function IsEqual(const V1, V2: ExtendedArray): Boolean; overload;
function IsEqual(const V1, V2: CurrencyArray): Boolean; overload;
function IsEqual(const V1, V2: StringArray): Boolean; overload;
function IsEqual(const V1, V2: CharSetArray): Boolean; overload;
function ByteArrayToLongIntArray(const V: ByteArray): LongIntArray;
function WordArrayToLongIntArray(const V: WordArray): LongIntArray;
function ShortIntArrayToLongIntArray(const V: ShortIntArray): LongIntArray;
function SmallIntArrayToLongIntArray(const V: SmallIntArray): LongIntArray;
function LongIntArrayToInt64Array(const V: LongIntArray): Int64Array;
function LongIntArrayToSingleArray(const V: LongIntArray): SingleArray;
function LongIntArrayToDoubleArray(const V: LongIntArray): DoubleArray;
function LongIntArrayToExtendedArray(const V: LongIntArray): ExtendedArray;
function SingleArrayToDoubleArray(const V: SingleArray): DoubleArray;
function SingleArrayToExtendedArray(const V: SingleArray): ExtendedArray;
function SingleArrayToCurrencyArray(const V: SingleArray): CurrencyArray;
function SingleArrayToLongIntArray(const V: SingleArray): LongIntArray;
function SingleArrayToInt64Array(const V: SingleArray): Int64Array;
function DoubleArrayToExtendedArray(const V: DoubleArray): ExtendedArray;
function DoubleArrayToCurrencyArray(const V: DoubleArray): CurrencyArray;
function DoubleArrayToLongIntArray(const V: DoubleArray): LongIntArray;
function DoubleArrayToInt64Array(const V: DoubleArray): Int64Array;
function ExtendedArrayToCurrencyArray(const V: ExtendedArray): CurrencyArray;
function ExtendedArrayToLongIntArray(const V: ExtendedArray): LongIntArray;
function ExtendedArrayToInt64Array(const V: ExtendedArray): Int64Array;
function ByteArrayFromIndexes(const V: ByteArray;
const Indexes: IntegerArray): ByteArray;
function WordArrayFromIndexes(const V: WordArray;
const Indexes: IntegerArray): WordArray;
function LongWordArrayFromIndexes(const V: LongWordArray;
const Indexes: IntegerArray): LongWordArray;
function CardinalArrayFromIndexes(const V: CardinalArray;
const Indexes: IntegerArray): CardinalArray;
function ShortIntArrayFromIndexes(const V: ShortIntArray;
const Indexes: IntegerArray): ShortIntArray;
function SmallIntArrayFromIndexes(const V: SmallIntArray;
const Indexes: IntegerArray): SmallIntArray;
function LongIntArrayFromIndexes(const V: LongIntArray;
const Indexes: IntegerArray): LongIntArray;
function IntegerArrayFromIndexes(const V: IntegerArray;
const Indexes: IntegerArray): IntegerArray;
function Int64ArrayFromIndexes(const V: Int64Array;
const Indexes: IntegerArray): Int64Array;
function SingleArrayFromIndexes(const V: SingleArray;
const Indexes: IntegerArray): SingleArray;
function DoubleArrayFromIndexes(const V: DoubleArray;
const Indexes: IntegerArray): DoubleArray;
function ExtendedArrayFromIndexes(const V: ExtendedArray;
const Indexes: IntegerArray): ExtendedArray;
function StringArrayFromIndexes(const V: StringArray;
const Indexes: IntegerArray): StringArray;
procedure Sort(const V: ByteArray); overload;
procedure Sort(const V: WordArray); overload;
procedure Sort(const V: LongWordArray); overload;
procedure Sort(const V: ShortIntArray); overload;
procedure Sort(const V: SmallIntArray); overload;
procedure Sort(const V: LongIntArray); overload;
procedure Sort(const V: Int64Array); overload;
procedure Sort(const V: SingleArray); overload;
procedure Sort(const V: DoubleArray); overload;
procedure Sort(const V: ExtendedArray); overload;
procedure Sort(const V: StringArray); overload;
procedure Sort(const Key: IntegerArray; const Data: IntegerArray); overload;
procedure Sort(const Key: IntegerArray; const Data: Int64Array); overload;
procedure Sort(const Key: IntegerArray; const Data: StringArray); overload;
procedure Sort(const Key: IntegerArray; const Data: ExtendedArray); overload;
procedure Sort(const Key: IntegerArray; const Data: PointerArray); overload;
procedure Sort(const Key: StringArray; const Data: IntegerArray); overload;
procedure Sort(const Key: StringArray; const Data: Int64Array); overload;
procedure Sort(const Key: StringArray; const Data: StringArray); overload;
procedure Sort(const Key: StringArray; const Data: ExtendedArray); overload;
procedure Sort(const Key: StringArray; const Data: PointerArray); overload;
procedure Sort(const Key: ExtendedArray; const Data: IntegerArray); overload;
procedure Sort(const Key: ExtendedArray; const Data: Int64Array); overload;
procedure Sort(const Key: ExtendedArray; const Data: StringArray); overload;
procedure Sort(const Key: ExtendedArray; const Data: ExtendedArray); overload;
procedure Sort(const Key: ExtendedArray; const Data: PointerArray); overload;
{ }
{ Self testing code }
{ }
procedure SelfTest;
implementation
{$IFDEF DELPHI}{$IFDEF OS_WIN32}{$IFDEF CPU_INTEL386}
{$DEFINE USE_ASM386}
{$ENDIF}{$ENDIF}{$ENDIF}
{ }
{ Integer }
{ }
function MinI(const A, B: Integer): Integer;
begin
if A < B then
Result := A else
Result := B;
end;
function MaxI(const A, B: Integer): Integer;
begin
if A > B then
Result := A else
Result := B;
end;
function MinC(const A, B: Cardinal): Cardinal;
begin
if A < B then
Result := A else
Result := B;
end;
function MaxC(const A, B: Cardinal): Cardinal;
begin
if A > B then
Result := A else
Result := B;
end;
function Clip(const Value: Integer; const Low, High: Integer): Integer;
begin
if Value < Low then
Result := Low else
if Value > High then
Result := High else
Result := Value;
end;
function ClipByte(const Value: Integer): Integer;
begin
if Value < MinByte then
Result := MinByte else
if Value > MaxByte then
Result := MaxByte else
Result := Value;
end;
function ClipWord(const Value: Integer): Integer;
begin
if Value < MinWord then
Result := MinWord else
if Value > MaxWord then
Result := MaxWord else
Result := Value;
end;
function ClipLongWord(const Value: Int64): LongWord;
begin
if Value < MinLongWord then
Result := MinLongWord else
if Value > MaxLongWord then
Result := MaxLongWord else
Result := LongWord(Value);
end;
function SumClipI(const A, I: Integer): Integer;
begin
if I >= 0 then
if A >= MaxInteger - I then
Result := MaxInteger else
Result := A + I
else
if A <= MinInteger - I then
Result := MinInteger else
Result := A + I;
end;
function SumClipC(const A: Cardinal; const I: Integer): Cardinal;
var B : Cardinal;
begin
if I >= 0 then
if A >= MaxCardinal - Cardinal(I) then
Result := MaxCardinal else
Result := A + Cardinal(I)
else
begin
B := Cardinal(-I);
if A <= B then
Result := 0 else
Result := A - B;
end;
end;
function InByteRange(const A: Int64): Boolean;
begin
Result := (A >= MinByte) and (A <= MaxByte);
end;
function InWordRange(const A: Int64): Boolean;
begin
Result := (A >= MinWord) and (A <= MaxWord);
end;
function InLongWordRange(const A: Int64): Boolean;
begin
Result := (A >= MinLongWord) and (A <= MaxLongWord);
end;
function InShortIntRange(const A: Int64): Boolean;
begin
Result := (A >= MinShortInt) and (A <= MaxShortInt);
end;
function InSmallIntRange(const A: Int64): Boolean;
begin
Result := (A >= MinSmallInt) and (A <= MaxSmallInt);
end;
function InLongIntRange(const A: Int64): Boolean;
begin
Result := (A >= MinLongInt) and (A <= MaxLongInt);
end;
{ }
{ Real }
{ }
function MinF(const A, B: Extended): Extended;
begin
if A < B then
Result := A else
Result := B;
end;
function MaxF(const A, B: Extended): Extended;
begin
if A > B then
Result := A else
Result := B;
end;
function ClipF(const Value: Extended; const Low, High: Extended): Extended;
begin
if Value < Low then
Result := Low else
if Value > High then
Result := High else
Result := Value;
end;
function InSingleRange(const A: Extended): Boolean;
var B : Extended;
begin
B := Abs(A);
Result := (B >= MinSingle) and (B <= MaxSingle);
end;
function InDoubleRange(const A: Extended): Boolean;
var B : Extended;
begin
B := Abs(A);
Result := (B >= MinDouble) and (B <= MaxDouble);
end;
function InCurrencyRange(const A: Extended): Boolean;
begin
Result := (A >= MinCurrency) and (A <= MaxCurrency);
end;
function InCurrencyRange(const A: Int64): Boolean;
begin
Result := (A >= MinCurrency) and (A <= MaxCurrency);
end;
{ }
{ Bit functions }
{ }
{ Assembly versions of ReverseBits and SwapEndian taken from the }
{ Delphi Encryption Compendium by Hagen Reddmann (HaReddmann@aol.com) }
{$IFDEF USE_ASM386}
function ReverseBits(const Value: LongWord): LongWord;
asm
BSWAP EAX
MOV EDX, EAX
AND EAX, 0AAAAAAAAh
SHR EAX, 1
AND EDX, 055555555h
SHL EDX, 1
OR EAX, EDX
MOV EDX, EAX
AND EAX, 0CCCCCCCCh
SHR EAX, 2
AND EDX, 033333333h
SHL EDX, 2
OR EAX, EDX
MOV EDX, EAX
AND EAX, 0F0F0F0F0h
SHR EAX, 4
AND EDX, 00F0F0F0Fh
SHL EDX, 4
OR EAX, EDX
end;
{$ELSE}
function ReverseBits(const Value: LongWord): LongWord;
var I : Byte;
begin
Result := 0;
For I := 0 to 31 do
if Value and BitMaskTable[I] <> 0 then
Result := Result or BitMaskTable[31 - I];
end;
{$ENDIF}
function ReverseBits(const Value: LongWord; const BitCount: Integer): LongWord;
var I : Integer;
V : LongWord;
begin
V := Value;
Result := 0;
For I := 0 to MinI(BitCount, BitsPerLongWord) - 1 do
begin
Result := (Result shl 1) or (V and 1);
V := V shr 1;
end;
end;
{$IFDEF USE_ASM386}
function SwapEndian(const Value: LongWord): LongWord;
asm
XCHG AH, AL
ROL EAX, 16
XCHG AH, AL
end;
{$ELSE}
function SwapEndian(const Value: LongWord): LongWord;
type Bytes4 = packed record
B1, B2, B3, B4 : Byte;
end;
var Val : Bytes4 absolute Value;
Res : Bytes4 absolute Result;
begin
Res.B4 := Val.B1;
Res.B3 := Val.B2;
Res.B2 := Val.B3;
Res.B1 := Val.B4;
end;
{$ENDIF}
procedure SwapEndianBuf(var Buf; const Count: Integer);
var P : PLongWord;
I : Integer;
begin
P := @Buf;
For I := 1 to Count do
begin
P^ := SwapEndian(P^);
Inc(P);
end;
end;
{$IFDEF USE_ASM386}
function TwosComplement(const Value: LongWord): LongWord;
asm
NEG EAX
end;
{$ELSE}
function TwosComplement(const Value: LongWord): LongWord;
begin
Result := not Value + 1;
end;
{$ENDIF}
{$IFDEF USE_ASM386}
function RotateLeftBits(const Value: LongWord; const Bits: Byte): LongWord;
asm
MOV CL, DL
ROL EAX, CL
end;
{$ELSE}
function RotateLeftBits(const Value: LongWord; const Bits: Byte): LongWord;
var I : Integer;
begin
Result := Value;
For I := 1 to Bits do
if Value and $80000000 = 0 then
Result := Value shl 1 else
Result := (Value shl 1) or 1;
end;
{$ENDIF}
{$IFDEF USE_ASM386}
function RotateRightBits(const Value: LongWord; const Bits: Byte): LongWord;
asm
MOV CL, DL
ROL EAX, CL
end;
{$ELSE}
function RotateRightBits(const Value: LongWord; const Bits: Byte): LongWord;
var I : Integer;
begin
Result := Value;
For I := 1 to Bits do
if Value and 1 = 0 then
Result := Value shr 1 else
Result := (Value shr 1) or $80000000;
end;
{$ENDIF}
{$IFDEF USE_ASM386}
function SetBit(const Value, BitIndex: LongWord): LongWord;
asm
{$IFOPT R+}
CMP BitIndex, BitsPerLongWord
JAE @Fin
{$ENDIF}
OR EAX, DWORD PTR [BitIndex * 4 + BitMaskTable]
@Fin:
end;
{$ELSE}
function SetBit(const Value, BitIndex: LongWord): LongWord;
begin
Result := Value or BitMaskTable[BitIndex];
end;
{$ENDIF}
{$IFDEF USE_ASM386}
function ClearBit(const Value, BitIndex: LongWord): LongWord;
asm
{$IFOPT R+}
CMP BitIndex, BitsPerLongWord
JAE @Fin
{$ENDIF}
MOV ECX, DWORD PTR [BitIndex * 4 + BitMaskTable]
NOT ECX
AND EAX, ECX
@Fin:
end;
{$ELSE}
function ClearBit(const Value, BitIndex: LongWord): LongWord;
begin
Result := Value and not BitMaskTable[BitIndex];
end;
{$ENDIF}
{$IFDEF USE_ASM386}
function ToggleBit(const Value, BitIndex: LongWord): LongWord;
asm
{$IFOPT R+}
CMP BitIndex, BitsPerLongWord
JAE @Fin
{$ENDIF}
XOR EAX, DWORD PTR [BitIndex * 4 + BitMaskTable]
@Fin:
end;
{$ELSE}
function ToggleBit(const Value, BitIndex: LongWord): LongWord;
begin
Result := Value xor BitMaskTable[BitIndex];
end;
{$ENDIF}
{$IFDEF USE_ASM386}
function IsHighBitSet(const Value: LongWord): Boolean;
asm
TEST Value, $80000000
SETNZ AL
end;
{$ELSE}
function IsHighBitSet(const Value: LongWord): Boolean;
begin
Result := Value and $80000000 <> 0;
end;
{$ENDIF}
{$IFDEF USE_ASM386}
function IsBitSet(const Value, BitIndex: LongWord): Boolean;
asm
{$IFOPT R+}
CMP BitIndex, BitsPerLongWord
JAE @Fin
{$ENDIF}
MOV ECX, DWORD PTR BitMaskTable [BitIndex * 4]
TEST Value, ECX
SETNZ AL
@Fin:
end;
{$ELSE}
function IsBitSet(const Value, BitIndex: LongWord): Boolean;
begin
Result := Value and BitMaskTable[BitIndex] <> 0;
end;
{$ENDIF}
{$IFDEF USE_ASM386}
function SetBitScanForward(const Value: LongWord): Integer;
asm
OR EAX, EAX
JZ @NoBits
BSF EAX, EAX
RET
@NoBits:
MOV EAX, -1
end;
function SetBitScanForward(const Value, BitIndex: LongWord): Integer;
asm
{$IFOPT R+}
CMP BitIndex, BitsPerLongWord
JAE @@zq
{$ENDIF}
MOV ECX, BitIndex
MOV EDX, $FFFFFFFF
SHL EDX, CL
AND EDX, EAX
JE @@zq
BSF EAX, EDX
RET
@@zq: MOV EAX, -1
end;
{$ELSE}
function SetBitScanForward(const Value, BitIndex: LongWord): Integer;
var I : Byte;
begin
{$IFOPT R+}
if BitIndex < BitsPerLongWord then
{$ENDIF}
For I := Byte(BitIndex) to 31 do
if Value and BitMaskTable[I] <> 0 then
begin
Result := I;
exit;
end;
Result := -1;
end;
function SetBitScanForward(const Value: LongWord): Integer;
begin
Result := SetBitScanForward(Value, 0);
end;
{$ENDIF}
{$IFDEF USE_ASM386}
function SetBitScanReverse(const Value: LongWord): Integer;
asm
OR EAX, EAX
JZ @NoBits
BSR EAX, EAX
RET
@NoBits:
MOV EAX, -1
end;
function SetBitScanReverse(const Value, BitIndex: LongWord): Integer;
asm
{$IFOPT R+}
CMP EDX, BitsPerLongWord
JAE @@zq
{$ENDIF}
LEA ECX, [EDX-31]
MOV EDX, $FFFFFFFF
NEG ECX
SHR EDX, CL
AND EDX, EAX
JE @@zq
BSR EAX, EDX
RET
@@zq: MOV EAX, -1
end;
{$ELSE}
function SetBitScanReverse(const Value, BitIndex: LongWord): Integer;
var I : Byte;
begin
{$IFOPT R+}
if BitIndex < BitsPerLongWord then
{$ENDIF}
For I := Byte(BitIndex) downto 0 do
if Value and BitMaskTable[I] <> 0 then
begin
Result := I;
exit;
end;
Result := -1;
end;
function SetBitScanReverse(const Value: LongWord): Integer;
begin
Result := SetBitScanReverse(Value, 31);
end;
{$ENDIF}
{$IFDEF USE_ASM386}
function ClearBitScanForward(const Value: LongWord): Integer;
asm
NOT EAX
OR EAX, EAX
JZ @NoBits
BSF EAX, EAX
RET
@NoBits:
MOV EAX, -1
end;
function ClearBitScanForward(const Value, BitIndex: LongWord): Integer;
asm
{$IFOPT R+}
CMP EDX, BitsPerLongWord
JAE @@zq
{$ENDIF}
MOV ECX, EDX
MOV EDX, $FFFFFFFF
NOT EAX
SHL EDX, CL
AND EDX, EAX
JE @@zq
BSF EAX, EDX
RET
@@zq: MOV EAX, -1
end;
{$ELSE}
function ClearBitScanForward(const Value, BitIndex: LongWord): Integer;
var I : Byte;
begin
{$IFOPT R+}
if BitIndex < BitsPerLongWord then
{$ENDIF}
For I := Byte(BitIndex) to 31 do
if Value and BitMaskTable[I] = 0 then
begin
Result := I;
exit;
end;
Result := -1;
end;
function ClearBitScanForward(const Value: LongWord): Integer;
begin
Result := ClearBitScanForward(Value, 0);
end;
{$ENDIF}
{$IFDEF USE_ASM386}
function ClearBitScanReverse(const Value: LongWord): Integer;
asm
NOT EAX
OR EAX, EAX
JZ @NoBits
BSR EAX, EAX
RET
@NoBits:
MOV EAX, -1
end;
function ClearBitScanReverse(const Value, BitIndex: LongWord): Integer;
asm
{$IFOPT R+}
CMP EDX, BitsPerLongWord
JAE @@zq
{$ENDIF}
LEA ECX, [EDX-31]
MOV EDX, $FFFFFFFF
NEG ECX
NOT EAX
SHR EDX, CL
AND EDX, EAX
JE @@zq
BSR EAX, EDX
RET
@@zq: MOV EAX, -1
end;
{$ELSE}
function ClearBitScanReverse(const Value, BitIndex: LongWord): Integer;
var I : Byte;
begin
{$IFOPT R+}
if BitIndex < BitsPerLongWord then
{$ENDIF}
For I := Byte(BitIndex) downto 0 do
if Value and BitMaskTable[I] = 0 then
begin
Result := I;
exit;
end;
Result := -1;
end;
function ClearBitScanReverse(const Value: LongWord): Integer;
begin
Result := ClearBitScanReverse(Value, 31);
end;
{$ENDIF}
const
BitCountTable : Array[0..255] of Byte =
(0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4,
1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
4, 5, 5, 6, 5, 6, 6, 7, 5, 6, 6, 7, 6, 7, 7, 8);
{$IFDEF USE_ASM386}
function BitCount(const Value: LongWord): LongWord;
asm
MOVZX EDX, AL
MOVZX EDX, BYTE PTR [EDX + BitCountTable]
MOVZX ECX, AH
ADD DL, BYTE PTR [ECX + BitCountTable]
SHR EAX, 16
MOVZX ECX, AH
ADD DL, BYTE PTR [ECX + BitCountTable]
AND EAX, $FF
ADD DL, BYTE PTR [EAX + BitCountTable]
MOV AL, DL
end;
{$ELSE}
function BitCount(const Value: LongWord): LongWord;
var V : Array[0..3] of Byte absolute Value;
begin
Result := BitCountTable[V[0]] + BitCountTable[V[1]] +
BitCountTable[V[2]] + BitCountTable[V[3]];
end;
{$ENDIF}
function IsPowerOfTwo(const Value: LongWord): Boolean;
begin
Result := BitCount(Value) = 1;
end;
function LowBitMask(const HighBitIndex: LongWord): LongWord;
begin
{$IFOPT R+}
if HighBitIndex >= BitsPerLongWord then
Result := 0 else
{$ENDIF}
Result := BitMaskTable[HighBitIndex] - 1;
end;
function HighBitMask(const LowBitIndex: LongWord): LongWord;
begin
{$IFOPT R+}
if LowBitIndex >= BitsPerLongWord then
Result := 0 else
{$ENDIF}
Result := not BitMaskTable[LowBitIndex] + 1;
end;
function RangeBitMask(const LowBitIndex, HighBitIndex: LongWord): LongWord;
begin
{$IFOPT R+}
if (LowBitIndex >= BitsPerLongWord) and (HighBitIndex >= BitsPerLongWord) then
begin
Result := 0;
exit;
end;
{$ENDIF}
Result := $FFFFFFFF;
if LowBitIndex > 0 then
Result := Result xor (BitMaskTable[LowBitIndex] - 1);
if HighBitIndex < 31 then
Result := Result xor (not BitMaskTable[HighBitIndex + 1] + 1);
end;
function SetBitRange(const Value: LongWord; const LowBitIndex, HighBitIndex: LongWord): LongWord;
begin
Result := Value or RangeBitMask(LowBitIndex, HighBitIndex);
end;
function ClearBitRange(const Value: LongWord; const LowBitIndex, HighBitIndex: LongWord): LongWord;
begin
Result := Value and not RangeBitMask(LowBitIndex, HighBitIndex);
end;
function ToggleBitRange(const Value: LongWord; const LowBitIndex, HighBitIndex: LongWord): LongWord;
begin
Result := Value xor RangeBitMask(LowBitIndex, HighBitIndex);
end;
function IsBitRangeSet(const Value: LongWord; const LowBitIndex, HighBitIndex: LongWord): Boolean;
var M: LongWord;
begin
M := RangeBitMask(LowBitIndex, HighBitIndex);
Result := Value and M = M;
end;
function IsBitRangeClear(const Value: LongWord; const LowBitIndex, HighBitIndex: LongWord): Boolean;
begin
Result := Value and RangeBitMask(LowBitIndex, HighBitIndex) = 0;
end;
{ }
{ Sets }
{ }
function AsCharSet(const C: Array of Char): CharSet;
var I: Integer;
begin
Result := [];
For I := 0 to High(C) do
Include(Result, C[I]);
end;
function AsByteSet(const C: Array of Byte): ByteSet;
var I: Integer;
begin
Result := [];
For I := 0 to High(C) do
Include(Result, C[I]);
end;
{$IFDEF USE_ASM386}
procedure ComplementChar(var C: CharSet; const Ch: Char);
asm
MOVZX ECX, DL
BTC [EAX], ECX
end;
{$ELSE}
procedure ComplementChar(var C: CharSet; const Ch: Char);
begin
if Ch in C then
Exclude(C, Ch) else
Include(C, Ch);
end;
{$ENDIF}
{$IFDEF USE_ASM386}
procedure ClearCharSet(var C: CharSet);
asm
XOR EDX, EDX
MOV [EAX], EDX
MOV [EAX + 4], EDX
MOV [EAX + 8], EDX
MOV [EAX + 12], EDX
MOV [EAX + 16], EDX
MOV [EAX + 20], EDX
MOV [EAX + 24], EDX
MOV [EAX + 28], EDX
end;
{$ELSE}
procedure ClearCharSet(var C: CharSet);
begin
C := [];
end;
{$ENDIF}
{$IFDEF USE_ASM386}
procedure FillCharSet(var C: CharSet);
asm
MOV EDX, $FFFFFFFF
MOV [EAX], EDX
MOV [EAX + 4], EDX
MOV [EAX + 8], EDX
MOV [EAX + 12], EDX
MOV [EAX + 16], EDX
MOV [EAX + 20], EDX
MOV [EAX + 24], EDX
MOV [EAX + 28], EDX
end;
{$ELSE}
procedure FillCharSet(var C: CharSet);
begin
C := [