home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 January / Chip_2003-01_cd1.bin / zkuste / delphi / unity / d56 / FNDUTL.ZIP / Utils / cUtils.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2002-10-29  |  263.7 KB  |  8,963 lines
  1. {$INCLUDE ..\cDefines.inc}
  2. unit cUtils;
  3.  
  4. {                                                                              }
  5. {                    Miscellaneous utility functions v3.29                     }
  6. {                                                                              }
  7. {      This unit is copyright ⌐ 2000-2002 by David Butler (david@e.co.za)      }
  8. {                                                                              }
  9. {                  This unit is part of Delphi Fundamentals.                   }
  10. {                     Its original file name is cUtils.pas                     }
  11. {                     It was generated 29 Oct 2002 02:37.                      }
  12. {       The latest version is available from the Fundamentals home page        }
  13. {                     http://fundementals.sourceforge.net/                     }
  14. {                                                                              }
  15. {                I invite you to use this unit, free of charge.                }
  16. {        I invite you to distibute this unit, but it must be for free.         }
  17. {             I also invite you to contribute to its development,              }
  18. {             but do not distribute a modified copy of this file.              }
  19. {                                                                              }
  20. {          A forum is available on SourceForge for general discussion          }
  21. {             http://sourceforge.net/forum/forum.php?forum_id=2117             }
  22. {                                                                              }
  23. {                                                                              }
  24. { Revision history:                                                            }
  25. {   2000/02/02  v0.01  Initial version                                         }
  26. {   2000/03/08  v1.02  Moved RealArray / IntegerArray functions from cMaths.   }
  27. {   2000/04/10  v1.03  Added Append, Renamed Delete to Remove and added        }
  28. {                      StringArrays.                                           }
  29. {   2000/05/03  v1.04  Added Path functions.                                   }
  30. {                      Added locked integer manipulation functions.            }
  31. {   2000/05/08  v1.05  Cleaned up unit.                                        }
  32. {                      188 lines interface. 1171 lines implementation.         }
  33. {   2000/06/01  v1.06  Added Range and Dup constructors for dynamic arrays.    }
  34. {   2000/06/03  v1.07  Added ArrayInsert functions.                            }
  35. {   2000/06/06  v1.08  Moved bit functions from cMaths.                        }
  36. {   2000/06/08  v1.09  Removed TInteger, TReal, TRealArray, TIntegerArray.     }
  37. {                      299 lines interface. 2019 lines implementations.        }
  38. {   2000/06/10  v1.10  Added linked lists for Integer, Int64, Extended and     }
  39. {                      String.                                                 }
  40. {                      518 lines interface. 3396 lines implementation.         }
  41. {   2000/06/14  v1.11  cUtils now generated from a template using a source     }
  42. {                      pre-processor that uses cUtils.                         }
  43. {                      560 lines interface. 1328 lines implementation.         }
  44. {                      Produced source: 644 lines interface, 4716 lines        }
  45. {                      implementation.                                         }
  46. {   2000/07/04  v1.12  Revision for Fundamentals release.                      }
  47. {   2000/07/24  v1.13  Added TrimArray functions.                              }
  48. {   2000/07/26  v1.14  Added Difference functions.                             }
  49. {   2000/09/02  v1.15  Added RemoveDuplicates functions.                       }
  50. {                      Added Count functions.                                  }
  51. {                      Fixed bug in Sort.                                      }
  52. {   2000/09/27  v1.16  Fixed bug in ArrayInsert.                               }
  53. {   2000/11/29  v1.17  Moved SetFPUPrecision to cSysUtils.                     }
  54. {   2001/05/03  v1.18  Improved bit functions. Added Pascal versions of        }
  55. {                      assembly routines.                                      }
  56. {                      Templ: 867 lines interface, 2886 lines implementation.  }
  57. {                      Source: 939 lines interface, 9796 lines implementation. }
  58. {   2001/05/13  v1.19  Added CharCount.                                        }
  59. {   2001/05/15  v1.20  Added PosNext (ClassType, ObjectArray).                 }
  60. {   2001/05/18  v1.21  Added hashing functions from cMaths.                    }
  61. {   2001/07/07  v1.22  Added TBinaryTreeNode.                                  }
  62. {   2001/11/11  v2.23  Revision.                                               }
  63. {   2002/01/03  v2.24  Moved EncodeBase64, DecodeBase64 from cMaths and        }
  64. {                      optimized. Added LongWordToHex, HexToLongWord.          }
  65. {   2002/03/30  v2.25  Fixed bug in DecodeBase64.                              }
  66. {   2002/04/02  v2.26  Removed dependencies on all other units (incl. Delphi   )
  67. {                      units) to remove initialization code associated with    }
  68. {                      SysUtils. This allows usage of cUtils in projects       }
  69. {                      and still have very small binaries.                     }
  70. {                      Fixed bug in LongWordToHex.                             }
  71. {   2002/05/31  v3.27  Refactored for Fundamentals 3.                          }
  72. {                      Moved linked lists to cLinkedLists.                     }
  73. {   2002/08/09  v3.28  Added HashInteger.                                      }
  74. {   2002/10/06  v3.29  Renamed Cond to iif.                                    }
  75. {                                                                              }
  76. interface
  77.  
  78. const
  79.   UnitName      = 'cUtils';
  80.   UnitVersion   = '3.29';
  81.   UnitDesc      = 'Miscelleanous utility functions';
  82.   UnitCopyright = '(c) 2000-2002 David J Butler';
  83.  
  84.  
  85.  
  86. {                                                                              }
  87. { Integer types                                                                }
  88. {   Byte      unsigned 8 bits                                                  }
  89. {   Word      unsigned 16 bits                                                 }
  90. {   LongWord  unsigned 32 bits                                                 }
  91. {   ShortInt  signed 8 bits                                                    }
  92. {   SmallInt  signed 16 bits                                                   }
  93. {   LongInt   signed 32 bits                                                   }
  94. {   Int64     signed 64 bits                                                   }
  95. {   Integer   signed system word                                               }
  96. {   Cardinal  unsigned system word                                             }
  97. {                                                                              }
  98. type
  99.   Int8  = ShortInt;
  100.   Int16 = SmallInt;
  101.   Int32 = LongInt;
  102.  
  103.   {$IFNDEF DELPHI6_UP}
  104.   PBoolean  = ^Boolean;
  105.   PByte     = ^Byte;
  106.   PWord     = ^Word;
  107.   PLongWord = ^LongWord;
  108.   PShortInt = ^ShortInt;
  109.   PSmallInt = ^SmallInt;
  110.   PLongInt  = ^LongInt;
  111.   PInteger  = ^Integer;
  112.   PInt64    = ^Int64;
  113.   {$ENDIF}
  114.  
  115. const
  116.   MinByte     = Low (Byte);
  117.   MaxByte     = High (Byte);
  118.   MinWord     = Low (Word);
  119.   MaxWord     = High (Word);
  120.   MinLongWord = Low (LongWord);
  121.   MaxLongWord = High (LongWord);
  122.   MinShortInt = Low (ShortInt);
  123.   MaxShortInt = High (ShortInt);
  124.   MinSmallInt = Low (SmallInt);
  125.   MaxSmallInt = High (SmallInt);
  126.   MinLongInt  = Low (LongInt);
  127.   MaxLongInt  = High (LongInt);
  128.   MaxInt64    = High (Int64);
  129.   MinInt64    = Low (Int64);
  130.   MinInteger  = Low (Integer);
  131.   MaxInteger  = High (Integer);
  132.   MinCardinal = Low (Cardinal);
  133.   MaxCardinal = High (Cardinal);
  134.  
  135.   BitsPerByte      = 8;
  136.   BitsPerWord      = 16;
  137.   BitsPerLongWord  = 32;
  138.   BytesPerCardinal = Sizeof (Cardinal);
  139.   BitsPerCardinal  = BytesPerCardinal * 8;
  140.  
  141. Function  MinI (const A, B : Integer) : Integer;
  142. Function  MaxI (const A, B : Integer) : Integer;
  143.  
  144. Function  Clip (const Value : Integer; const Low, High : Integer) : Integer; overload;
  145. Function  ClipByte (const Value : Integer) : Integer;
  146. Function  ClipWord (const Value : Integer) : Integer;
  147.  
  148. Function  RangeAdjacent (const Low1, High1, Low2, High2 : Integer) : Boolean;
  149. Function  RangeOverlap (const Low1, High1, Low2, High2 : Integer) : Boolean;
  150.  
  151.  
  152.  
  153. {                                                                              }
  154. { Floating point types                                                         }
  155. {   Single    32 bits                                                          }
  156. {   Double    64 bits                                                          }
  157. {   Extended  80 bits                                                          }
  158. {                                                                              }
  159. const
  160.   MinSingle   = 1.5E-45;
  161.   MaxSingle   = 3.4E+38;
  162.   MinDouble   = 5.0E-324;
  163.   MaxDouble   = 1.7E+308;
  164.   MinExtended = 3.4E-4932;
  165.   MaxExtended = 1.1E+4932;
  166.  
  167. {$IFNDEF DELPHI6_UP}
  168. type
  169.   PSingle   = ^Single;
  170.   PDouble   = ^Double;
  171.   PExtended = ^Extended;
  172. {$ENDIF}
  173.  
  174. { Approximate comparison functions                                             }
  175. type
  176.   TCompareResult = (crLess,          // <
  177.                     crEqual,         // =
  178.                     crGreater,       // >
  179.                     crUndefined);
  180.   TCompareResultSet = Set of TCompareResult;
  181.  
  182. const
  183.   DefaultCompareEpsilon = 1E-9;
  184.  
  185. Function  ApproxZero (const Value : Extended; const CompareEpsilon : Double = DefaultCompareEpsilon) : Boolean;
  186. Function  ApproxEqual (const A, B : Extended; const CompareEpsilon : Double = DefaultCompareEpsilon) : Boolean;
  187. Function  ApproxCompare (const A, B : Extended; const CompareEpsilon : Double = DefaultCompareEpsilon) : TCompareResult;
  188.  
  189.  
  190.  
  191. {                                                                              }
  192. { Bit functions                                                                }
  193. {   All bit functions work on 32-bit values (LongWord).                        }
  194. {                                                                              }
  195. Function  ClearBit (const Value : LongWord; const BitIndex : LongWord) : LongWord;
  196. Function  SetBit (const Value : LongWord; const BitIndex : LongWord) : LongWord;
  197. Function  IsBitSet (const Value : LongWord; const BitIndex : LongWord) : Boolean;
  198. Function  ToggleBit (const Value : LongWord; const BitIndex : LongWord) : LongWord;
  199. Function  IsHighBitSet (const Value : LongWord) : Boolean;
  200.  
  201. Function  SetBitScanForward (const Value : LongWord) : Integer; overload;
  202. Function  SetBitScanForward (const Value : LongWord; const StartBitIndex : LongWord) : Integer; overload;
  203. Function  SetBitScanReverse (const Value : LongWord) : Integer; overload;
  204. Function  SetBitScanReverse (const Value : LongWord; const StartBitIndex : LongWord) : Integer; overload;
  205. Function  ClearBitScanForward (const Value : LongWord) : Integer; overload;
  206. Function  ClearBitScanForward (const Value : LongWord; const StartBitIndex : LongWord) : Integer; overload;
  207. Function  ClearBitScanReverse (const Value : LongWord) : Integer; overload;
  208. Function  ClearBitScanReverse (const Value : LongWord; const StartBitIndex : LongWord) : Integer; overload;
  209.  
  210. Function  ReverseBits (const Value : LongWord) : LongWord; overload;
  211. Function  ReverseBits (const Value : LongWord; const BitCount : Integer) : LongWord; overload;
  212. Function  SwapEndian (const Value : LongWord) : LongWord;
  213. Procedure SwapEndianBuf (var Buf; const Count : Integer);
  214. Function  TwosComplement (const Value : LongWord) : LongWord;
  215.  
  216. Function  RotateLeftBits (const Value : LongWord; const Bits : Byte) : LongWord;
  217. Function  RotateRightBits (const Value : LongWord; const Bits : Byte) : LongWord;
  218.  
  219. Function  BitCount (const Value : LongWord) : LongWord;
  220. Function  IsPowerOfTwo (const Value : LongWord) : Boolean;
  221.  
  222. Function  LowBitMask (const HighBitIndex : LongWord) : LongWord;
  223. Function  HighBitMask (const LowBitIndex : LongWord) : LongWord;
  224. Function  RangeBitMask (const LowBitIndex, HighBitIndex : LongWord) : LongWord;
  225.  
  226. Function  SetBitRange (const Value : LongWord; const LowBitIndex, HighBitIndex : LongWord) : LongWord;
  227. Function  ClearBitRange (const Value : LongWord; const LowBitIndex, HighBitIndex : LongWord) : LongWord;
  228. Function  ToggleBitRange (const Value : LongWord; const LowBitIndex, HighBitIndex : LongWord) : LongWord;
  229. Function  IsBitRangeSet (const Value : LongWord; const LowBitIndex, HighBitIndex : LongWord) : Boolean;
  230. Function  IsBitRangeClear (const Value : LongWord; const LowBitIndex, HighBitIndex : LongWord) : Boolean;
  231.  
  232. const
  233.   BitMaskTable : array [0..31] of LongWord =
  234.     ($00000001, $00000002, $00000004, $00000008, $00000010, $00000020, $00000040, $00000080,
  235.      $00000100, $00000200, $00000400, $00000800, $00001000, $00002000, $00004000, $00008000,
  236.      $00010000, $00020000, $00040000, $00080000, $00100000, $00200000, $00400000, $00800000,
  237.      $01000000, $02000000, $04000000, $08000000, $10000000, $20000000, $40000000, $80000000);
  238.  
  239.  
  240.  
  241. {                                                                              }
  242. { Sets                                                                         }
  243. {                                                                              }
  244. type
  245.   CharSet = Set of Char;
  246.   ByteSet = Set of Byte;
  247.   PCharSet = ^CharSet;
  248.   PByteSet = ^ByteSet;
  249.  
  250. const
  251.   CompleteCharSet = [#0..#255];
  252.   CompleteByteSet = [0..255];
  253.  
  254. Function  AsCharSet (const C : Array of Char) : CharSet;
  255. Function  AsByteSet (const C : Array of Byte) : ByteSet;
  256. Procedure ComplementChar (var C : CharSet; const Ch : Char);
  257. Procedure ClearCharSet (var C : CharSet);
  258. Procedure FillCharSet (var C : CharSet);
  259. Procedure ComplementCharSet (var C : CharSet);
  260. Procedure AssignCharSet (var DestSet : CharSet; const SourceSet : CharSet); overload;
  261. Procedure Union (var DestSet : CharSet; const SourceSet : CharSet); overload;
  262. Procedure Difference (var DestSet : CharSet; const SourceSet : CharSet); overload;
  263. Procedure Intersection (var DestSet : CharSet; const SourceSet : CharSet); overload;
  264. Procedure XORCharSet (var DestSet : CharSet; const SourceSet : CharSet);
  265. Function  IsSubSet (const A, B : CharSet) : Boolean;
  266. Function  IsEqual (const A, B : CharSet) : Boolean; overload;
  267. Function  IsEmpty (const C : CharSet) : Boolean;
  268. Function  IsComplete (const C : CharSet) : Boolean;
  269. Function  CharCount (const C : CharSet) : Integer; overload;
  270. Procedure ConvertCaseInsensitive (var C : CharSet);
  271. Function  CaseInsensitiveCharSet (const C : CharSet) : CharSet;
  272.  
  273.  
  274.  
  275. {                                                                              }
  276. { Swap                                                                         }
  277. {                                                                              }
  278. Procedure Swap (var X, Y : Boolean); overload;
  279. Procedure Swap (var X, Y : Byte); overload;
  280. Procedure Swap (var X, Y : Word); overload;
  281. Procedure Swap (var X, Y : LongWord); overload;
  282. Procedure Swap (var X, Y : ShortInt); overload;
  283. Procedure Swap (var X, Y : SmallInt); overload;
  284. Procedure Swap (var X, Y : LongInt); overload;
  285. Procedure Swap (var X, Y : Int64); overload;
  286. Procedure Swap (var X, Y : Single); overload;
  287. Procedure Swap (var X, Y : Double); overload;
  288. Procedure Swap (var X, Y : Extended); overload;
  289. Procedure Swap (var X, Y : String); overload;
  290. Procedure Swap (var X, Y : Pointer); overload;
  291. Procedure Swap (var X, Y : TObject); overload;
  292. Procedure SwapObjects (var X, Y);
  293.  
  294.  
  295.  
  296. {                                                                              }
  297. { iif                                                                          }
  298. {   iif (inline if) returns TrueValue if Expr is True, otherwise it returns    }
  299. {   FalseValue.                                                                }
  300. {                                                                              }
  301. Function  iif (const Expr : Boolean; const TrueValue : LongWord; const FalseValue : LongWord = 0) : LongWord; overload;
  302. Function  iif (const Expr : Boolean; const TrueValue : Int64; const FalseValue : Int64 = 0) : Int64; overload;
  303. Function  iif (const Expr : Boolean; const TrueValue : Single; const FalseValue : Single = 0.0) : Single; overload;
  304. Function  iif (const Expr : Boolean; const TrueValue : Double; const FalseValue : Double = 0.0) : Double; overload;
  305. Function  iif (const Expr : Boolean; const TrueValue : Extended; const FalseValue : Extended = 0.0) : Extended; overload;
  306. Function  iif (const Expr : Boolean; const TrueValue : String; const FalseValue : String = '') : String; overload;
  307. Function  iif (const Expr : Boolean; const TrueValue : Pointer; const FalseValue : Pointer = nil) : Pointer; overload;
  308. Function  iif (const Expr : Boolean; const TrueValue : TObject; const FalseValue : TObject = nil) : TObject; overload;
  309.  
  310.  
  311.  
  312. {                                                                              }
  313. { Compare                                                                      }
  314. {                                                                              }
  315. Function  Compare (const I1, I2 : Boolean) : TCompareResult; overload;
  316. Function  Compare (const I1, I2 : Integer) : TCompareResult; overload;
  317. Function  Compare (const I1, I2 : Int64) : TCompareResult; overload;
  318. Function  Compare (const I1, I2 : Single) : TCompareResult; overload;
  319. Function  Compare (const I1, I2 : Double) : TCompareResult; overload;
  320. Function  Compare (const I1, I2 : Extended) : TCompareResult; overload;
  321. Function  Compare (const I1, I2 : String) : TCompareResult; overload;
  322. Function  Compare (const I1, I2 : TObject) : TCompareResult; overload;
  323. Function  NegatedCompareResult (const C : TCompareResult) : TCompareResult;
  324.  
  325.  
  326.  
  327. {                                                                              }
  328. { Base Conversion                                                              }
  329. {   EncodeBase64 converts a binary string (S) to a base 64 string using        }
  330. {   Alphabet. if Pad is True, the result will be padded with PadChar to be a   }
  331. {   multiple of PadMultiple.                                                   }
  332. {   DecodeBase64 converts a base 64 string using Alphabet (64 characters for   }
  333. {   values 0-63) to a binary string.                                           }
  334. {                                                                              }
  335. const
  336.   s_HexDigitsUpper : String [16] = '0123456789ABCDEF';
  337.   s_HexDigitsLower : String [16] = '0123456789abcdef';
  338.  
  339. Function  HexCharValue (const Ch : Char) : Byte;
  340.  
  341. Function  LongWordToBin (const I : LongWord; const Digits : Byte = 0) : String;
  342. Function  LongWordToOct (const I : LongWord; const Digits : Byte = 0) : String;
  343. Function  LongWordToHex (const I : LongWord; const Digits : Byte = 0) : String;
  344. Function  LongWordToStr (const I : LongWord; const Digits : Byte = 0) : String;
  345.  
  346. Function  BinToLongWord (const S : String) : LongWord;
  347. Function  OctToLongWord (const S : String) : LongWord;
  348. Function  HexToLongWord (const S : String) : LongWord;
  349. Function  StrToLongWord (const S : String) : LongWord;
  350.  
  351. Function  EncodeBase64 (const S, Alphabet : String; const Pad : Boolean = False;
  352.           const PadMultiple : Integer = 4; const PadChar : Char = '=') : String;
  353. Function  DecodeBase64 (const S, Alphabet : String; const PadSet : CharSet = []) : String;
  354.  
  355. const
  356.   b64_MIMEBase64 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
  357.   b64_UUEncode   = ' !"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
  358.   b64_XXEncode   = '+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
  359.  
  360. Function  MIMEBase64Decode (const S : String) : String;
  361. Function  MIMEBase64Encode (const S : String) : String;
  362. Function  UUDecode (const S : String) : String;
  363. Function  XXDecode (const S : String) : String;
  364.  
  365. Function  BytesToHex (const P : Pointer; const Count : Integer) : String;
  366.  
  367.  
  368.  
  369. {                                                                              }
  370. { Type conversion                                                              }
  371. {                                                                              }
  372. Function  PointerToStr (const P : Pointer) : String;
  373. Function  StrToPointer (const S : String) : Pointer;
  374. Function  ObjectClassName (const O : TObject) : String;
  375. Function  ClassClassName (const C : TClass) : String;
  376. Function  ObjectToStr (const O : TObject) : String;
  377. Function  ClassToStr (const C : TClass) : String;
  378. Function  CharSetToStr (const C : CharSet) : String;
  379. Function  StrToCharSet (const S : String) : CharSet;
  380.  
  381.  
  382.  
  383. {                                                                              }
  384. { Hash functions                                                               }
  385. {                                                                              }
  386. Function  HashBuf (const Buf; const BufSize : Integer;
  387.           const Slots : LongWord = 0) : LongWord;
  388. Function  HashStr (const StrBuf : Pointer; const StrLength : Integer;
  389.           const Slots : LongWord = 0; const CaseSensitive : Boolean = True) : LongWord; overload;
  390. Function  HashStr (const S : String; const Slots : LongWord = 0;
  391.           const CaseSensitive : Boolean = True) : LongWord; overload;
  392. Function  HashInteger (const I : Integer; const Slots : LongWord = 0) : LongWord;
  393.  
  394.  
  395.  
  396. {                                                                              }
  397. { Memory                                                                       }
  398. {                                                                              }
  399. Procedure MoveMem (const Source; var Dest; const Count : Integer);
  400. Function  CompareMem (const Buf1; const Buf2; const Count : Integer) : Boolean;
  401. Function  CompareMemNoCase (const Buf1; const Buf2; const Count : Integer) : Boolean;
  402. Procedure ReverseMem (var Buf; const Size : Integer);
  403.  
  404.  
  405.  
  406. {                                                                              }
  407. { Dynamic Arrays                                                               }
  408. {                                                                              }
  409. type
  410.   ByteArray = Array of Byte;
  411.   WordArray = Array of Word;
  412.   LongWordArray = Array of LongWord;
  413.   ShortIntArray = Array of ShortInt;
  414.   SmallIntArray = Array of SmallInt;
  415.   LongIntArray = Array of LongInt;
  416.   Int64Array = Array of Int64;
  417.   SingleArray = Array of Single;
  418.   DoubleArray = Array of Double;
  419.   ExtendedArray = Array of Extended;
  420.   StringArray = Array of String;
  421.   PointerArray = Array of Pointer;
  422.   ObjectArray = Array of TObject;
  423.   BooleanArray = Array of Boolean;
  424.   CharSetArray = Array of CharSet;
  425.   ByteSetArray = Array of ByteSet;
  426.   IntegerArray = LongIntArray;
  427.   CardinalArray = LongWordArray;
  428.  
  429.  
  430. Function  Append (var V : ByteArray; const R : Byte) : Integer; overload;
  431. Function  Append (var V : WordArray; const R : Word) : Integer; overload;
  432. Function  Append (var V : LongWordArray; const R : LongWord) : Integer; overload;
  433. Function  Append (var V : ShortIntArray; const R : ShortInt) : Integer; overload;
  434. Function  Append (var V : SmallIntArray; const R : SmallInt) : Integer; overload;
  435. Function  Append (var V : LongIntArray; const R : LongInt) : Integer; overload;
  436. Function  Append (var V : Int64Array; const R : Int64) : Integer; overload;
  437. Function  Append (var V : SingleArray; const R : Single) : Integer; overload;
  438. Function  Append (var V : DoubleArray; const R : Double) : Integer; overload;
  439. Function  Append (var V : ExtendedArray; const R : Extended) : Integer; overload;
  440. Function  Append (var V : StringArray; const R : String) : Integer; overload;
  441. Function  Append (var V : BooleanArray; const R : Boolean) : Integer; overload;
  442. Function  Append (var V : PointerArray; const R : Pointer) : Integer; overload;
  443. Function  Append (var V : ObjectArray; const R : TObject) : Integer; overload;
  444. Function  Append (var V : ByteSetArray; const R : ByteSet) : Integer; overload;
  445. Function  Append (var V : CharSetArray; const R : CharSet) : Integer; overload;
  446. Function  AppendByteArray (var V : ByteArray; const R : Array of Byte) : Integer; overload;
  447. Function  AppendWordArray (var V : WordArray; const R : Array of Word) : Integer; overload;
  448. Function  AppendCardinalArray (var V : CardinalArray; const R : Array of LongWord) : Integer; overload;
  449. Function  AppendShortIntArray (var V : ShortIntArray; const R : Array of ShortInt) : Integer; overload;
  450. Function  AppendSmallIntArray (var V : SmallIntArray; const R : Array of SmallInt) : Integer; overload;
  451. Function  AppendIntegerArray (var V : IntegerArray; const R : Array of LongInt) : Integer; overload;
  452. Function  AppendInt64Array (var V : Int64Array; const R : Array of Int64) : Integer; overload;
  453. Function  AppendSingleArray (var V : SingleArray; const R : Array of Single) : Integer; overload;
  454. Function  AppendDoubleArray (var V : DoubleArray; const R : Array of Double) : Integer; overload;
  455. Function  AppendExtendedArray (var V : ExtendedArray; const R : Array of Extended) : Integer; overload;
  456. Function  AppendStringArray (var V : StringArray; const R : Array of String) : Integer; overload;
  457. Function  AppendPointerArray (var V : PointerArray; const R : Array of Pointer) : Integer; overload;
  458. Function  AppendObjectArray (var V : ObjectArray; const R : Array of TObject) : Integer; overload;
  459. Function  AppendCharSetArray (var V : CharSetArray; const R : Array of CharSet) : Integer; overload;
  460. Function  AppendByteSetArray (var V : ByteSetArray; const R : Array of ByteSet) : Integer; overload;
  461.  
  462.  
  463. Function  Remove (var V : ByteArray; const Idx : Integer; const Count : Integer = 1) : Integer; overload;
  464. Function  Remove (var V : WordArray; const Idx : Integer; const Count : Integer = 1) : Integer; overload;
  465. Function  Remove (var V : LongWordArray; const Idx : Integer; const Count : Integer = 1) : Integer; overload;
  466. Function  Remove (var V : ShortIntArray; const Idx : Integer; const Count : Integer = 1) : Integer; overload;
  467. Function  Remove (var V : SmallIntArray; const Idx : Integer; const Count : Integer = 1) : Integer; overload;
  468. Function  Remove (var V : LongIntArray; const Idx : Integer; const Count : Integer = 1) : Integer; overload;
  469. Function  Remove (var V : Int64Array; const Idx : Integer; const Count : Integer = 1) : Integer; overload;
  470. Function  Remove (var V : SingleArray; const Idx : Integer; const Count : Integer = 1) : Integer; overload;
  471. Function  Remove (var V : DoubleArray; const Idx : Integer; const Count : Integer = 1) : Integer; overload;
  472. Function  Remove (var V : ExtendedArray; const Idx : Integer; const Count : Integer = 1) : Integer; overload;
  473. Function  Remove (var V : StringArray; const Idx : Integer; const Count : Integer = 1) : Integer; overload;
  474. Function  Remove (var V : PointerArray; const Idx : Integer; const Count : Integer = 1) : Integer; overload;
  475. Function  Remove (var V : ObjectArray; const Idx : Integer; const Count : Integer = 1;
  476.           const FreeObjects : Boolean = False) : Integer; overload;
  477.  
  478. Procedure RemoveDuplicates (var V : ByteArray; const IsSorted : Boolean); overload;
  479. Procedure RemoveDuplicates (var V : WordArray; const IsSorted : Boolean); overload;
  480. Procedure RemoveDuplicates (var V : LongWordArray; const IsSorted : Boolean); overload;
  481. Procedure RemoveDuplicates (var V : ShortIntArray; const IsSorted : Boolean); overload;
  482. Procedure RemoveDuplicates (var V : SmallIntArray; const IsSorted : Boolean); overload;
  483. Procedure RemoveDuplicates (var V : LongIntArray; const IsSorted : Boolean); overload;
  484. Procedure RemoveDuplicates (var V : Int64Array; const IsSorted : Boolean); overload;
  485. Procedure RemoveDuplicates (var V : SingleArray; const IsSorted : Boolean); overload;
  486. Procedure RemoveDuplicates (var V : DoubleArray; const IsSorted : Boolean); overload;
  487. Procedure RemoveDuplicates (var V : ExtendedArray; const IsSorted : Boolean); overload;
  488. Procedure RemoveDuplicates (var V : StringArray; const IsSorted : Boolean); overload;
  489. Procedure RemoveDuplicates (var V : PointerArray; const IsSorted : Boolean); overload;
  490.  
  491. Procedure TrimArrayLeft (var S : ByteArray; const TrimList : Array of Byte); overload;
  492. Procedure TrimArrayLeft (var S : WordArray; const TrimList : Array of Word); overload;
  493. Procedure TrimArrayLeft (var S : LongWordArray; const TrimList : Array of LongWord); overload;
  494. Procedure TrimArrayLeft (var S : ShortIntArray; const TrimList : Array of ShortInt); overload;
  495. Procedure TrimArrayLeft (var S : SmallIntArray; const TrimList : Array of SmallInt); overload;
  496. Procedure TrimArrayLeft (var S : LongIntArray; const TrimList : Array of LongInt); overload;
  497. Procedure TrimArrayLeft (var S : Int64Array; const TrimList : Array of Int64); overload;
  498. Procedure TrimArrayLeft (var S : SingleArray; const TrimList : Array of Single); overload;
  499. Procedure TrimArrayLeft (var S : DoubleArray; const TrimList : Array of Double); overload;
  500. Procedure TrimArrayLeft (var S : ExtendedArray; const TrimList : Array of Extended); overload;
  501. Procedure TrimArrayLeft (var S : StringArray; const TrimList : Array of String); overload;
  502. Procedure TrimArrayLeft (var S : PointerArray; const TrimList : Array of Pointer); overload;
  503.  
  504. Procedure TrimArrayRight (var S : ByteArray; const TrimList : Array of Byte); overload;
  505. Procedure TrimArrayRight (var S : WordArray; const TrimList : Array of Word); overload;
  506. Procedure TrimArrayRight (var S : LongWordArray; const TrimList : Array of LongWord); overload;
  507. Procedure TrimArrayRight (var S : ShortIntArray; const TrimList : Array of ShortInt); overload;
  508. Procedure TrimArrayRight (var S : SmallIntArray; const TrimList : Array of SmallInt); overload;
  509. Procedure TrimArrayRight (var S : LongIntArray; const TrimList : Array of LongInt); overload;
  510. Procedure TrimArrayRight (var S : Int64Array; const TrimList : Array of Int64); overload;
  511. Procedure TrimArrayRight (var S : SingleArray; const TrimList : Array of Single); overload;
  512. Procedure TrimArrayRight (var S : DoubleArray; const TrimList : Array of Double); overload;
  513. Procedure TrimArrayRight (var S : ExtendedArray; const TrimList : Array of Extended); overload;
  514. Procedure TrimArrayRight (var S : StringArray; const TrimList : Array of String); overload;
  515. Procedure TrimArrayRight (var S : PointerArray; const TrimList : Array of Pointer); overload;
  516.  
  517. Function  ArrayInsert (var V : ByteArray; const Idx : Integer; const Count : Integer) : Integer; overload;
  518. Function  ArrayInsert (var V : WordArray; const Idx : Integer; const Count : Integer) : Integer; overload;
  519. Function  ArrayInsert (var V : LongWordArray; const Idx : Integer; const Count : Integer) : Integer; overload;
  520. Function  ArrayInsert (var V : ShortIntArray; const Idx : Integer; const Count : Integer) : Integer; overload;
  521. Function  ArrayInsert (var V : SmallIntArray; const Idx : Integer; const Count : Integer) : Integer; overload;
  522. Function  ArrayInsert (var V : LongIntArray; const Idx : Integer; const Count : Integer) : Integer; overload;
  523. Function  ArrayInsert (var V : Int64Array; const Idx : Integer; const Count : Integer) : Integer; overload;
  524. Function  ArrayInsert (var V : SingleArray; const Idx : Integer; const Count : Integer) : Integer; overload;
  525. Function  ArrayInsert (var V : DoubleArray; const Idx : Integer; const Count : Integer) : Integer; overload;
  526. Function  ArrayInsert (var V : ExtendedArray; const Idx : Integer; const Count : Integer) : Integer; overload;
  527. Function  ArrayInsert (var V : StringArray; const Idx : Integer; const Count : Integer) : Integer; overload;
  528. Function  ArrayInsert (var V : PointerArray; const Idx : Integer; const Count : Integer) : Integer; overload;
  529. Function  ArrayInsert (var V : ObjectArray; const Idx : Integer; const Count : Integer) : Integer; overload;
  530.  
  531. Procedure FreeObjectArray (var V); overload;
  532. Procedure FreeObjectArray (var V; const LoIdx, HiIdx : Integer); overload;
  533. Procedure FreeAndNilObjectArray (var V : ObjectArray);
  534.  
  535. Function  PosNext (const Find : Byte; const V : ByteArray; const PrevPos : Integer = -1;
  536.           const IsSortedAscending : Boolean = False) : Integer; overload;
  537. Function  PosNext (const Find : Word; const V : WordArray; const PrevPos : Integer = -1;
  538.           const IsSortedAscending : Boolean = False) : Integer; overload;
  539. Function  PosNext (const Find : LongWord; const V : LongWordArray; const PrevPos : Integer = -1;
  540.           const IsSortedAscending : Boolean = False) : Integer; overload;
  541. Function  PosNext (const Find : ShortInt; const V : ShortIntArray; const PrevPos : Integer = -1;
  542.           const IsSortedAscending : Boolean = False) : Integer; overload;
  543. Function  PosNext (const Find : SmallInt; const V : SmallIntArray; const PrevPos : Integer = -1;
  544.           const IsSortedAscending : Boolean = False) : Integer; overload;
  545. Function  PosNext (const Find : LongInt; const V : LongIntArray; const PrevPos : Integer = -1;
  546.           const IsSortedAscending : Boolean = False) : Integer; overload;
  547. Function  PosNext (const Find : Int64; const V : Int64Array; const PrevPos : Integer = -1;
  548.           const IsSortedAscending : Boolean = False) : Integer; overload;
  549. Function  PosNext (const Find : Single; const V : SingleArray; const PrevPos : Integer = -1;
  550.           const IsSortedAscending : Boolean = False) : Integer; overload;
  551. Function  PosNext (const Find : Double; const V : DoubleArray; const PrevPos : Integer = -1;
  552.           const IsSortedAscending : Boolean = False) : Integer; overload;
  553. Function  PosNext (const Find : Extended; const V : ExtendedArray; const PrevPos : Integer = -1;
  554.           const IsSortedAscending : Boolean = False) : Integer; overload;
  555. Function  PosNext (const Find : Boolean; const V : BooleanArray; const PrevPos : Integer = -1;
  556.           const IsSortedAscending : Boolean = False) : Integer; overload;
  557. Function  PosNext (const Find : String; const V : StringArray; const PrevPos : Integer = -1;
  558.           const IsSortedAscending : Boolean = False) : Integer; overload;
  559. Function  PosNext (const Find : Pointer; const V : PointerArray; const PrevPos : Integer = -1) : Integer; overload;
  560. Function  PosNext (const Find : TObject; const V : ObjectArray; const PrevPos : Integer = -1) : Integer; overload;
  561. Function  PosNext (const ClassType : TClass; const V : ObjectArray; const PrevPos : Integer = -1) : Integer; overload;
  562. Function  PosNext (const ClassName : String; const V : ObjectArray; const PrevPos : Integer = -1) : Integer; overload;
  563.  
  564. Function  Count (const Find : Byte; const V : ByteArray; const IsSortedAscending : Boolean = False) : Integer; overload;
  565. Function  Count (const Find : Word; const V : WordArray; const IsSortedAscending : Boolean = False) : Integer; overload;
  566. Function  Count (const Find : LongWord; const V : LongWordArray; const IsSortedAscending : Boolean = False) : Integer; overload;
  567. Function  Count (const Find : ShortInt; const V : ShortIntArray; const IsSortedAscending : Boolean = False) : Integer; overload;
  568. Function  Count (const Find : SmallInt; const V : SmallIntArray; const IsSortedAscending : Boolean = False) : Integer; overload;
  569. Function  Count (const Find : LongInt; const V : LongIntArray; const IsSortedAscending : Boolean = False) : Integer; overload;
  570. Function  Count (const Find : Int64; const V : Int64Array; const IsSortedAscending : Boolean = False) : Integer; overload;
  571. Function  Count (const Find : Single; const V : SingleArray; const IsSortedAscending : Boolean = False) : Integer; overload;
  572. Function  Count (const Find : Double; const V : DoubleArray; const IsSortedAscending : Boolean = False) : Integer; overload;
  573. Function  Count (const Find : Extended; const V : ExtendedArray; const IsSortedAscending : Boolean = False) : Integer; overload;
  574. Function  Count (const Find : String; const V : StringArray; const IsSortedAscending : Boolean = False) : Integer; overload;
  575. Function  Count (const Find : Boolean; const V : BooleanArray; const IsSortedAscending : Boolean = False) : Integer; overload;
  576.  
  577. Procedure RemoveAll (const Find : Byte; var V : ByteArray; const IsSortedAscending : Boolean = False); overload; 
  578. Procedure RemoveAll (const Find : Word; var V : WordArray; const IsSortedAscending : Boolean = False); overload; 
  579. Procedure RemoveAll (const Find : LongWord; var V : LongWordArray; const IsSortedAscending : Boolean = False); overload; 
  580. Procedure RemoveAll (const Find : ShortInt; var V : ShortIntArray; const IsSortedAscending : Boolean = False); overload; 
  581. Procedure RemoveAll (const Find : SmallInt; var V : SmallIntArray; const IsSortedAscending : Boolean = False); overload; 
  582. Procedure RemoveAll (const Find : LongInt; var V : LongIntArray; const IsSortedAscending : Boolean = False); overload; 
  583. Procedure RemoveAll (const Find : Int64; var V : Int64Array; const IsSortedAscending : Boolean = False); overload; 
  584. Procedure RemoveAll (const Find : Single; var V : SingleArray; const IsSortedAscending : Boolean = False); overload; 
  585. Procedure RemoveAll (const Find : Double; var V : DoubleArray; const IsSortedAscending : Boolean = False); overload; 
  586. Procedure RemoveAll (const Find : Extended; var V : ExtendedArray; const IsSortedAscending : Boolean = False); overload; 
  587. Procedure RemoveAll (const Find : String; var V : StringArray; const IsSortedAscending : Boolean = False); overload; 
  588.  
  589. Function  Intersection (const V1, V2 : ByteArray; const IsSortedAscending : Boolean = False) : ByteArray; overload;
  590. Function  Intersection (const V1, V2 : WordArray; const IsSortedAscending : Boolean = False) : WordArray; overload;
  591. Function  Intersection (const V1, V2 : LongWordArray; const IsSortedAscending : Boolean = False) : LongWordArray; overload;
  592. Function  Intersection (const V1, V2 : ShortIntArray; const IsSortedAscending : Boolean = False) : ShortIntArray; overload;
  593. Function  Intersection (const V1, V2 : SmallIntArray; const IsSortedAscending : Boolean = False) : SmallIntArray; overload;
  594. Function  Intersection (const V1, V2 : LongIntArray; const IsSortedAscending : Boolean = False) : LongIntArray; overload;
  595. Function  Intersection (const V1, V2 : Int64Array; const IsSortedAscending : Boolean = False) : Int64Array; overload;
  596. Function  Intersection (const V1, V2 : SingleArray; const IsSortedAscending : Boolean = False) : SingleArray; overload;
  597. Function  Intersection (const V1, V2 : DoubleArray; const IsSortedAscending : Boolean = False) : DoubleArray; overload;
  598. Function  Intersection (const V1, V2 : ExtendedArray; const IsSortedAscending : Boolean = False) : ExtendedArray; overload;
  599. Function  Intersection (const V1, V2 : StringArray; const IsSortedAscending : Boolean = False) : StringArray; overload;
  600.  
  601. Function  Difference (const V1, V2 : ByteArray; const IsSortedAscending : Boolean = False) : ByteArray; overload;
  602. Function  Difference (const V1, V2 : WordArray; const IsSortedAscending : Boolean = False) : WordArray; overload;
  603. Function  Difference (const V1, V2 : LongWordArray; const IsSortedAscending : Boolean = False) : LongWordArray; overload;
  604. Function  Difference (const V1, V2 : ShortIntArray; const IsSortedAscending : Boolean = False) : ShortIntArray; overload;
  605. Function  Difference (const V1, V2 : SmallIntArray; const IsSortedAscending : Boolean = False) : SmallIntArray; overload;
  606. Function  Difference (const V1, V2 : LongIntArray; const IsSortedAscending : Boolean = False) : LongIntArray; overload;
  607. Function  Difference (const V1, V2 : Int64Array; const IsSortedAscending : Boolean = False) : Int64Array; overload;
  608. Function  Difference (const V1, V2 : SingleArray; const IsSortedAscending : Boolean = False) : SingleArray; overload;
  609. Function  Difference (const V1, V2 : DoubleArray; const IsSortedAscending : Boolean = False) : DoubleArray; overload;
  610. Function  Difference (const V1, V2 : ExtendedArray; const IsSortedAscending : Boolean = False) : ExtendedArray; overload;
  611. Function  Difference (const V1, V2 : StringArray; const IsSortedAscending : Boolean = False) : StringArray; overload;
  612.  
  613. Procedure Reverse (var V : ByteArray); overload;
  614. Procedure Reverse (var V : WordArray); overload;
  615. Procedure Reverse (var V : LongWordArray); overload;
  616. Procedure Reverse (var V : ShortIntArray); overload;
  617. Procedure Reverse (var V : SmallIntArray); overload;
  618. Procedure Reverse (var V : LongIntArray); overload;
  619. Procedure Reverse (var V : Int64Array); overload;
  620. Procedure Reverse (var V : SingleArray); overload;
  621. Procedure Reverse (var V : DoubleArray); overload;
  622. Procedure Reverse (var V : ExtendedArray); overload;
  623. Procedure Reverse (var V : StringArray); overload;
  624. Procedure Reverse (var V : PointerArray); overload;
  625. Procedure Reverse (var V : ObjectArray); overload;
  626.  
  627. Function  AsBooleanArray (const V : Array of Boolean) : BooleanArray; overload;
  628. Function  AsByteArray (const V : Array of Byte) : ByteArray; overload;
  629. Function  AsWordArray (const V : Array of Word) : WordArray; overload;
  630. Function  AsLongWordArray (const V : Array of LongWord) : LongWordArray; overload;
  631. Function  AsCardinalArray (const V : Array of Cardinal) : CardinalArray; overload;
  632. Function  AsShortIntArray (const V : Array of ShortInt) : ShortIntArray; overload;
  633. Function  AsSmallIntArray (const V : Array of SmallInt) : SmallIntArray; overload;
  634. Function  AsLongIntArray (const V : Array of LongInt) : LongIntArray; overload;
  635. Function  AsIntegerArray (const V : Array of Integer) : IntegerArray; overload;
  636. Function  AsInt64Array (const V : Array of Int64) : Int64Array; overload;
  637. Function  AsSingleArray (const V : Array of Single) : SingleArray; overload;
  638. Function  AsDoubleArray (const V : Array of Double) : DoubleArray; overload;
  639. Function  AsExtendedArray (const V : Array of Extended) : ExtendedArray; overload;
  640. Function  AsStringArray (const V : Array of String) : StringArray; overload;
  641. Function  AsPointerArray (const V : Array of Pointer) : PointerArray; overload;
  642. Function  AsCharSetArray (const V : Array of CharSet) : CharSetArray; overload;
  643. Function  AsObjectArray (const V : Array of TObject) : ObjectArray; overload;
  644.  
  645. Function  RangeByte (const First : Byte; const Count : Integer; const Increment : Byte = 1) : ByteArray;
  646. Function  RangeWord (const First : Word; const Count : Integer; const Increment : Word = 1) : WordArray;
  647. Function  RangeLongWord (const First : LongWord; const Count : Integer; const Increment : LongWord = 1) : LongWordArray;
  648. Function  RangeCardinal (const First : Cardinal; const Count : Integer; const Increment : Cardinal = 1) : CardinalArray;
  649. Function  RangeShortInt (const First : ShortInt; const Count : Integer; const Increment : ShortInt = 1) : ShortIntArray;
  650. Function  RangeSmallInt (const First : SmallInt; const Count : Integer; const Increment : SmallInt = 1) : SmallIntArray;
  651. Function  RangeLongInt (const First : LongInt; const Count : Integer; const Increment : LongInt = 1) : LongIntArray;
  652. Function  RangeInteger (const First : Integer; const Count : Integer; const Increment : Integer = 1) : IntegerArray;
  653. Function  RangeInt64 (const First : Int64; const Count : Integer; const Increment : Int64 = 1) : Int64Array;
  654. Function  RangeSingle (const First : Single; const Count : Integer; const Increment : Single = 1) : SingleArray;
  655. Function  RangeDouble (const First : Double; const Count : Integer; const Increment : Double = 1) : DoubleArray;
  656. Function  RangeExtended (const First : Extended; const Count : Integer; const Increment : Extended = 1) : ExtendedArray;
  657.  
  658. Function  DupByte (const V : Byte; const Count : Integer) : ByteArray;
  659. Function  DupWord (const V : Word; const Count : Integer) : WordArray;
  660. Function  DupLongWord (const V : LongWord; const Count : Integer) : LongWordArray;
  661. Function  DupCardinal (const V : Cardinal; const Count : Integer) : CardinalArray;
  662. Function  DupShortInt (const V : ShortInt; const Count : Integer) : ShortIntArray;
  663. Function  DupSmallInt (const V : SmallInt; const Count : Integer) : SmallIntArray;
  664. Function  DupLongInt (const V : LongInt; const Count : Integer) : LongIntArray;
  665. Function  DupInteger (const V : Integer; const Count : Integer) : IntegerArray;
  666. Function  DupInt64 (const V : Int64; const Count : Integer) : Int64Array;
  667. Function  DupSingle (const V : Single; const Count : Integer) : SingleArray;
  668. Function  DupDouble (const V : Double; const Count : Integer) : DoubleArray;
  669. Function  DupExtended (const V : Extended; const Count : Integer) : ExtendedArray;
  670. Function  DupString (const V : String; const Count : Integer) : StringArray;
  671. Function  DupCharSet (const V : CharSet; const Count : Integer) : CharSetArray;
  672. Function  DupObject (const V : TObject; const Count : Integer) : ObjectArray;
  673.  
  674. Procedure SetLengthAndZero (var V : ByteArray; const NewLength : Integer); overload;
  675. Procedure SetLengthAndZero (var V : WordArray; const NewLength : Integer); overload;
  676. Procedure SetLengthAndZero (var V : LongWordArray; const NewLength : Integer); overload;
  677. Procedure SetLengthAndZero (var V : ShortIntArray; const NewLength : Integer); overload;
  678. Procedure SetLengthAndZero (var V : SmallIntArray; const NewLength : Integer); overload;
  679. Procedure SetLengthAndZero (var V : LongIntArray; const NewLength : Integer); overload;
  680. Procedure SetLengthAndZero (var V : Int64Array; const NewLength : Integer); overload;
  681. Procedure SetLengthAndZero (var V : SingleArray; const NewLength : Integer); overload;
  682. Procedure SetLengthAndZero (var V : DoubleArray; const NewLength : Integer); overload;
  683. Procedure SetLengthAndZero (var V : ExtendedArray; const NewLength : Integer); overload;
  684. Procedure SetLengthAndZero (var V : CharSetArray; const NewLength : Integer); overload;
  685. Procedure SetLengthAndZero (var V : BooleanArray; const NewLength : Integer); overload;
  686. Procedure SetLengthAndZero (var V : ObjectArray; const NewLength : Integer;
  687.     const FreeObjects : Boolean = False); overload;
  688.  
  689. Function  IsEqual (const V1, V2 : ByteArray) : Boolean; overload;
  690. Function  IsEqual (const V1, V2 : WordArray) : Boolean; overload;
  691. Function  IsEqual (const V1, V2 : LongWordArray) : Boolean; overload;
  692. Function  IsEqual (const V1, V2 : ShortIntArray) : Boolean; overload;
  693. Function  IsEqual (const V1, V2 : SmallIntArray) : Boolean; overload;
  694. Function  IsEqual (const V1, V2 : LongIntArray) : Boolean; overload;
  695. Function  IsEqual (const V1, V2 : Int64Array) : Boolean; overload;
  696. Function  IsEqual (const V1, V2 : SingleArray) : Boolean; overload;
  697. Function  IsEqual (const V1, V2 : DoubleArray) : Boolean; overload;
  698. Function  IsEqual (const V1, V2 : ExtendedArray) : Boolean; overload;
  699. Function  IsEqual (const V1, V2 : StringArray) : Boolean; overload;
  700. Function  IsEqual (const V1, V2 : CharSetArray) : Boolean; overload;
  701.  
  702. Function  ByteArrayToLongIntArray (const V : ByteArray) : LongIntArray;
  703. Function  WordArrayToLongIntArray (const V : WordArray) : LongIntArray;
  704. Function  ShortIntArrayToLongIntArray (const V : ShortIntArray) : LongIntArray;
  705. Function  SmallIntArrayToLongIntArray (const V : SmallIntArray) : LongIntArray;
  706. Function  LongIntArrayToInt64Array (const V : LongIntArray) : Int64Array;
  707. Function  LongIntArrayToSingleArray (const V : LongIntArray) : SingleArray;
  708. Function  LongIntArrayToDoubleArray (const V : LongIntArray) : DoubleArray;
  709. Function  LongIntArrayToExtendedArray (const V : LongIntArray) : ExtendedArray;
  710. Function  SingleArrayToExtendedArray (const V : SingleArray) : ExtendedArray;
  711. Function  SingleArrayToDoubleArray (const V : SingleArray) : DoubleArray;
  712. Function  SingleArrayToLongIntArray (const V : SingleArray) : LongIntArray;
  713. Function  SingleArrayToInt64Array (const V : SingleArray) : Int64Array;
  714. Function  DoubleArrayToSingleArray (const V : DoubleArray) : SingleArray;
  715. Function  DoubleArrayToExtendedArray (const V : DoubleArray) : ExtendedArray;
  716. Function  DoubleArrayToLongIntArray (const V : DoubleArray) : LongIntArray;
  717. Function  DoubleArrayToInt64Array (const V : DoubleArray) : Int64Array;
  718. Function  ExtendedArrayToSingleArray (const V : ExtendedArray) : SingleArray;
  719. Function  ExtendedArrayToDoubleArray (const V : ExtendedArray) : DoubleArray;
  720. Function  ExtendedArrayToLongIntArray (const V : ExtendedArray) : LongIntArray;
  721. Function  ExtendedArrayToInt64Array (const V : ExtendedArray) : Int64Array;
  722.  
  723. Function  ByteArrayFromIndexes (const V : ByteArray; const Indexes : IntegerArray) : ByteArray;
  724. Function  WordArrayFromIndexes (const V : WordArray; const Indexes : IntegerArray) : WordArray;
  725. Function  LongWordArrayFromIndexes (const V : LongWordArray; const Indexes : IntegerArray) : LongWordArray;
  726. Function  CardinalArrayFromIndexes (const V : CardinalArray; const Indexes : IntegerArray) : CardinalArray;
  727. Function  ShortIntArrayFromIndexes (const V : ShortIntArray; const Indexes : IntegerArray) : ShortIntArray;
  728. Function  SmallIntArrayFromIndexes (const V : SmallIntArray; const Indexes : IntegerArray) : SmallIntArray;
  729. Function  LongIntArrayFromIndexes (const V : LongIntArray; const Indexes : IntegerArray) : LongIntArray;
  730. Function  IntegerArrayFromIndexes (const V : IntegerArray; const Indexes : IntegerArray) : IntegerArray;
  731. Function  Int64ArrayFromIndexes (const V : Int64Array; const Indexes : IntegerArray) : Int64Array;
  732. Function  SingleArrayFromIndexes (const V : SingleArray; const Indexes : IntegerArray) : SingleArray;
  733. Function  DoubleArrayFromIndexes (const V : DoubleArray; const Indexes : IntegerArray) : DoubleArray;
  734. Function  ExtendedArrayFromIndexes (const V : ExtendedArray; const Indexes : IntegerArray) : ExtendedArray;
  735. Function  StringArrayFromIndexes (const V : StringArray; const Indexes : IntegerArray) : StringArray;
  736.  
  737. Procedure Sort (var V : ByteArray); overload;
  738. Procedure Sort (var V : WordArray); overload;
  739. Procedure Sort (var V : LongWordArray); overload;
  740. Procedure Sort (var V : ShortIntArray); overload;
  741. Procedure Sort (var V : SmallIntArray); overload;
  742. Procedure Sort (var V : LongIntArray); overload;
  743. Procedure Sort (var V : Int64Array); overload;
  744. Procedure Sort (var V : SingleArray); overload;
  745. Procedure Sort (var V : DoubleArray); overload;
  746. Procedure Sort (var V : ExtendedArray); overload;
  747. Procedure Sort (var V : StringArray); overload;
  748.  
  749. Procedure Sort (var Key : IntegerArray; var Data : IntegerArray); overload;
  750. Procedure Sort (var Key : IntegerArray; var Data : Int64Array); overload;
  751. Procedure Sort (var Key : IntegerArray; var Data : StringArray); overload;
  752. Procedure Sort (var Key : IntegerArray; var Data : ExtendedArray); overload;
  753. Procedure Sort (var Key : IntegerArray; var Data : PointerArray); overload;
  754. Procedure Sort (var Key : StringArray; var Data : IntegerArray); overload;
  755. Procedure Sort (var Key : StringArray; var Data : Int64Array); overload;
  756. Procedure Sort (var Key : StringArray; var Data : StringArray); overload;
  757. Procedure Sort (var Key : StringArray; var Data : ExtendedArray); overload;
  758. Procedure Sort (var Key : StringArray; var Data : PointerArray); overload;
  759. Procedure Sort (var Key : ExtendedArray; var Data : IntegerArray); overload;
  760. Procedure Sort (var Key : ExtendedArray; var Data : Int64Array); overload;
  761. Procedure Sort (var Key : ExtendedArray; var Data : StringArray); overload;
  762. Procedure Sort (var Key : ExtendedArray; var Data : ExtendedArray); overload;
  763. Procedure Sort (var Key : ExtendedArray; var Data : PointerArray); overload;
  764.  
  765.  
  766.  
  767. {                                                                              }
  768. { Self testing code                                                            }
  769. {                                                                              }
  770. Procedure SelfTest;
  771.  
  772.  
  773.  
  774. implementation
  775.  
  776.  
  777.  
  778. {                                                                              }
  779. { Integer                                                                      }
  780. {                                                                              }
  781. Function MinI (const A, B : Integer) : Integer;
  782.   Begin
  783.     if A < B then
  784.       Result := A else
  785.       Result := B;
  786.   End;
  787.  
  788. Function MaxI (const A, B : Integer) : Integer;
  789.   Begin
  790.     if A > B then
  791.       Result := A else
  792.       Result := B;
  793.   End;
  794.  
  795. Function Clip (const Value : Integer; const Low, High : Integer) : Integer;
  796.   Begin
  797.     if Value < Low then
  798.       Result := Low else
  799.     if Value > High then
  800.       Result := High else
  801.       Result := Value;
  802.   End;
  803.  
  804. Function ClipByte (const Value : Integer) : Integer;
  805.   Begin
  806.     if Value < MinByte then
  807.       Result := MinByte else
  808.     if Value > MaxByte then
  809.       Result := MaxByte else
  810.       Result := Value;
  811.   End;
  812.  
  813. Function ClipWord (const Value : Integer) : Integer;
  814.   Begin
  815.     if Value < MinWord then
  816.       Result := MinWord else
  817.     if Value > MaxWord then
  818.       Result := MaxWord else
  819.       Result := Value;
  820.   End;
  821.  
  822. Function RangeAdjacent (const Low1, High1, Low2, High2 : Integer) : Boolean;
  823.   Begin
  824.     Result := ((Low2 > MinInteger) and (High1 = Low2 - 1)) or
  825.               ((High2 < MaxInteger) and (Low1 = High2 + 1));
  826.   End;
  827.  
  828. Function RangeOverlap (const Low1, High1, Low2, High2 : Integer) : Boolean;
  829.   Begin
  830.     Result := ((Low1 >= Low2) and (Low1 <= High2)) or
  831.               ((Low2 >= Low1) and (Low2 <= High1));
  832.   End;
  833.  
  834.  
  835.  
  836. {                                                                              }
  837. { Float                                                                        }
  838. {                                                                              }
  839.  
  840. { Approximate comparison functions taken from FltMath by Tempest Software as   }
  841. { taken from Knuth, Seminumerical Algorithms, 2nd ed., Addison-Wesley,         }
  842. { 1981, pp. 217-20.                                                            }
  843. {$IFDEF CPU_INTEL386}
  844. type
  845.   TExtended = packed record
  846.     Case Boolean of
  847.     True : (
  848.       Mantissa : packed Array [0..1] of LongWord; { MSB of [1] is the normalized 1 bit }
  849.       Exponent : Word; { MSB is the sign bit }
  850.     );
  851.     False:
  852.       (Value: Extended);
  853.   end;
  854. {$ENDIF}
  855.  
  856. {$IFDEF CPU_INTEL386}
  857. Function ApproxEqual (const A, B : Extended; const CompareEpsilon : Double) : Boolean;
  858. var ExtA : TExtended absolute A;
  859.     ExtB : TExtended absolute B;
  860.     ExpA, ExpB : Word;
  861.     Exp : TExtended;
  862.   Begin
  863.     ExpA := ExtA.Exponent and $7FFF;
  864.     ExpB := ExtB.Exponent and $7FFF;
  865.     if (ExpA = $7FFF) and ((ExtA.Mantissa[1] <> $80000000) or (ExtA.Mantissa[0] <> 0)) then
  866.       { A is NaN }
  867.       Result := False else
  868.     if (ExpB = $7FFF) and ((ExtB.Mantissa[1] <> $80000000) or (ExtB.Mantissa[0] <> 0)) then
  869.       { B is NaN }
  870.       Result := False else
  871.     if (ExpA = $7FFF) or (ExpB = $7FFF) then
  872.       { A or B is infinity. Use the builtin comparison, which will       }
  873.       { properly account for signed infinities, comparing infinity with  }
  874.       { infinity, or comparing infinity with a finite value.             }
  875.       Result := A = B else
  876.     begin
  877.       { We are comparing two finite values, so take the difference and   }
  878.       { compare that against the scaled Epsilon.                         }
  879.       Exp.Value := 1.0;
  880.       if ExpA < ExpB then
  881.         Exp.Exponent := ExpB else
  882.         Exp.Exponent := ExpA;
  883.       Result := Abs (A - B) <= (CompareEpsilon * Exp.Value);
  884.     end;
  885.   End;
  886. {$ELSE}
  887. Function ApproxEqual (const A, B : Extended; const CompareEpsilon : Double) : Boolean;
  888.   Begin
  889.     Result := Abs (A - B) <= CompareEpsilon;
  890.   End;
  891. {$ENDIF}
  892.  
  893. {$IFDEF CPU_INTEL386}
  894. Function ApproxCompare (const A, B : Extended; const CompareEpsilon : Double = DefaultCompareEpsilon) : TCompareResult;
  895. var ExtA : TExtended absolute A;
  896.     ExtB : TExtended absolute B;
  897.     ExpA, ExpB : Word;
  898.     Exp : TExtended;
  899.     V : Extended;
  900.   Begin
  901.     ExpA := ExtA.Exponent and $7FFF;
  902.     ExpB := ExtB.Exponent and $7FFF;
  903.     if (ExpA = $7FFF) and ((ExtA.Mantissa[1] <> $80000000) or (ExtA.Mantissa[0] <> 0)) then
  904.       { A is NaN }
  905.       Result := crUndefined else
  906.     if (ExpB = $7FFF) and ((ExtB.Mantissa[1] <> $80000000) or (ExtB.Mantissa[0] <> 0)) then
  907.       { B is NaN }
  908.       Result := crUndefined else
  909.     if (ExpA = $7FFF) or (ExpB = $7FFF) then
  910.       { A or B is infinity. Use the builtin comparison, which will       }
  911.       { properly account for signed infinities, comparing infinity with  }
  912.       { infinity, or comparing infinity with a finite value.             }
  913.       Result := Compare (A, B) else
  914.     begin
  915.       { We are comparing two finite values, so take the difference and   }
  916.       { compare that against the scaled Epsilon.                         }
  917.       Exp.Value := 1.0;
  918.       if ExpA < ExpB then
  919.         Exp.Exponent := ExpB else
  920.         Exp.Exponent := ExpA;
  921.       V := CompareEpsilon * Exp.Value;
  922.       if Abs (A - B) <= V then
  923.         Result := crEqual else
  924.       if A - B >= V then
  925.         Result := crGreater else
  926.         Result := crLess;
  927.     end;
  928.   End;
  929. {$ELSE}
  930. Function ApproxCompare (const A, B : Extended; const CompareEpsilon : Double = DefaultCompareEpsilon) : TCompareResult;
  931. var V : Extended;
  932.   Begin
  933.     V := A - B;
  934.     if Abs (V) <= CompareEpsilon then
  935.       Result := crEqual else
  936.     if V >= CompareEpsilon
  937.       Result := crGreater else
  938.       Result := crLess;
  939.   End;
  940. {$ENDIF}
  941.  
  942. Function ApproxZero (const Value : Extended; const CompareEpsilon : Double) : Boolean;
  943.   Begin
  944.     Result := ApproxEqual (Value, 0.0, CompareEpsilon);
  945.   End;
  946.  
  947.  
  948.  
  949. {                                                                              }
  950. { Bit functions                                                                }
  951. {                                                                              }
  952.  
  953. { Assembly versions of ReverseBits and SwapEndian taken from the               }
  954. { Delphi Encryption Compendium 3.0 by Hagen Reddmann (HaReddmann@AOL.COM)      }
  955. {$IFDEF WINTEL}
  956. Function ReverseBits (const Value : LongWord) : LongWord;
  957.   Asm
  958.         BSWAP   EAX
  959.         MOV     EDX, EAX
  960.         AND     EAX, 0AAAAAAAAh
  961.         SHR     EAX, 1
  962.         AND     EDX, 055555555h
  963.         SHL     EDX, 1
  964.         OR      EAX, EDX
  965.         MOV     EDX, EAX
  966.         AND     EAX, 0CCCCCCCCh
  967.         SHR     EAX, 2
  968.         AND     EDX, 033333333h
  969.         SHL     EDX, 2
  970.         OR      EAX, EDX
  971.         MOV     EDX, EAX
  972.         AND     EAX, 0F0F0F0F0h
  973.         SHR     EAX, 4
  974.         AND     EDX, 00F0F0F0Fh
  975.         SHL     EDX, 4
  976.         OR      EAX, EDX
  977.   End;
  978. {$ELSE}
  979. Function ReverseBits (const Value : LongWord) : LongWord;
  980. var I : Byte;
  981.   Begin
  982.     Result := 0;
  983.     For I := 0 to 31 do
  984.       if Value and BitMaskTable [I] <> 0 then
  985.         Result := Result or BitMaskTable [31 - I];
  986.   End;
  987. {$ENDIF}
  988.  
  989. Function ReverseBits (const Value : LongWord; const BitCount : Integer) : LongWord;
  990. var I : Integer;
  991.     V : LongWord;
  992.   Begin
  993.     V := Value;
  994.     Result := 0;
  995.     For I := 0 to MinI (BitCount, BitsPerLongWord) - 1 do
  996.       begin
  997.         Result := (Result shl 1) or (V and 1);
  998.         V := V shr 1;
  999.       end;
  1000.   End;
  1001.  
  1002. {$IFDEF WINTEL}
  1003. Function SwapEndian (const Value : LongWord) : LongWord;
  1004.   Asm
  1005.         XCHG    AH, AL
  1006.         ROL     EAX, 16
  1007.         XCHG    AH, AL
  1008.   End;
  1009. {$ELSE}
  1010. Function SwapEndian (const Value : LongWord) : LongWord;
  1011. type Bytes4 = packed record
  1012.        B1, B2, B3, B4 : Byte;
  1013.      end;
  1014. var Val : Bytes4 absolute Value;
  1015.     Res : Bytes4 absolute Result;
  1016.   Begin
  1017.     Res.B4 := Val.B1;
  1018.     Res.B3 := Val.B2;
  1019.     Res.B2 := Val.B3;
  1020.     Res.B1 := Val.B4;
  1021.   End;
  1022. {$ENDIF}
  1023.  
  1024. Procedure SwapEndianBuf (var Buf; const Count : Integer);
  1025. var P : PLongWord;
  1026.     I : Integer;
  1027.   Begin
  1028.     P := @Buf;
  1029.     For I := 1 to Count do
  1030.       begin
  1031.         P^ := SwapEndian (P^);
  1032.         Inc (P);
  1033.       end;
  1034.   End;
  1035.  
  1036. {$IFDEF WINTEL}
  1037. Function TwosComplement (const Value : LongWord) : LongWord;
  1038.   Asm
  1039.         NEG EAX
  1040.   End;
  1041. {$ELSE}
  1042. Function TwosComplement (const Value : LongWord) : LongWord;
  1043.   Begin
  1044.     Result := not Value + 1;
  1045.   End;
  1046. {$ENDIF}
  1047.  
  1048. {$IFDEF WINTEL}
  1049. Function RotateLeftBits (const Value : LongWord; const Bits : Byte) : LongWord;
  1050.   Asm
  1051.      MOV   CL, DL
  1052.      ROL   EAX, CL
  1053.   End;
  1054. {$ELSE}
  1055. Function RotateLeftBits (const Value : LongWord; const Bits : Byte) : LongWord;
  1056. var I : Integer;
  1057.   Begin
  1058.     Result := Value;
  1059.     For I := 1 to Bits do
  1060.       if Value and $80000000 = 0 then
  1061.         Result := Value shl 1 else
  1062.         Result := (Value shl 1) or 1;
  1063.   End;
  1064. {$ENDIF}
  1065.  
  1066. {$IFDEF WINTEL}
  1067. Function RotateRightBits (const Value : LongWord; const Bits : Byte) : LongWord;
  1068.   Asm
  1069.      MOV   CL, DL
  1070.      ROL   EAX, CL
  1071.   End;
  1072. {$ELSE}
  1073. Function RotateRightBits (const Value : LongWord; const Bits : Byte) : LongWord;
  1074. var I : Integer;
  1075.   Begin
  1076.     Result := Value;
  1077.     For I := 1 to Bits do
  1078.       if Value and 1 = 0 then
  1079.         Result := Value shr 1 else
  1080.         Result := (Value shr 1) or $80000000;
  1081.   End;
  1082. {$ENDIF}
  1083.  
  1084. {$IFDEF WINTEL}
  1085. Function SetBit (const Value : LongWord; const BitIndex : LongWord) : LongWord;
  1086.   Asm
  1087.         {$IFOPT R+}
  1088.         CMP     BitIndex, BitsPerLongWord
  1089.         JAE     @Fin
  1090.         {$ENDIF}
  1091.         OR      EAX, DWORD PTR [BitIndex * 4 + BitMaskTable]
  1092.       @Fin:
  1093.   End;
  1094. {$ELSE}
  1095. Function SetBit (const Value : LongWord; const BitIndex : LongWord) : LongWord;
  1096.   Begin
  1097.     Result := Value or BitMaskTable [BitIndex];
  1098.   End;
  1099. {$ENDIF}
  1100.  
  1101. {$IFDEF WINTEL}
  1102. Function ClearBit (const Value : LongWord; const BitIndex : LongWord) : LongWord;
  1103.   Asm
  1104.         {$IFOPT R+}
  1105.         CMP     BitIndex, BitsPerLongWord
  1106.         JAE     @Fin
  1107.         {$ENDIF}
  1108.         MOV     ECX, DWORD PTR [BitIndex * 4 + BitMaskTable]
  1109.         NOT     ECX
  1110.         AND     EAX, ECX
  1111.       @Fin:
  1112.   End;
  1113. {$ELSE}
  1114. Function ClearBit (const Value : LongWord; const BitIndex : LongWord) : LongWord;
  1115.   Begin
  1116.     Result := Value and not BitMaskTable [BitIndex];
  1117.   End;
  1118. {$ENDIF}
  1119.  
  1120. {$IFDEF WINTEL}
  1121. Function ToggleBit (const Value : LongWord; const BitIndex : LongWord) : LongWord;
  1122.   Asm
  1123.         {$IFOPT R+}
  1124.         CMP     BitIndex, BitsPerLongWord
  1125.         JAE     @Fin
  1126.         {$ENDIF}
  1127.         XOR     EAX, DWORD PTR [BitIndex * 4 + BitMaskTable]
  1128.       @Fin:  
  1129.   End;
  1130. {$ELSE}
  1131. Function ToggleBit (const Value : LongWord; const BitIndex : LongWord) : LongWord;
  1132.   Begin
  1133.     Result := Value xor BitMaskTable [BitIndex];
  1134.   End;
  1135. {$ENDIF}
  1136.  
  1137. {$IFDEF WINTEL}
  1138. Function IsHighBitSet (const Value : LongWord) : Boolean;
  1139.   Asm
  1140.         TEST    Value, $80000000
  1141.         SETNZ   AL
  1142.   End;
  1143. {$ELSE}
  1144. Function IsHighBitSet (const Value : LongWord) : Boolean;
  1145.   Begin
  1146.     Result := Value and $80000000 <> 0;
  1147.   End;
  1148. {$ENDIF}
  1149.  
  1150. {$IFDEF WINTEL}
  1151. Function IsBitSet (const Value : LongWord; const BitIndex : LongWord) : Boolean;
  1152.   Asm
  1153.         {$IFOPT R+}
  1154.         CMP     BitIndex, BitsPerLongWord
  1155.         JAE     @Fin
  1156.         {$ENDIF}
  1157.         MOV     ECX, DWORD PTR BitMaskTable [BitIndex * 4]
  1158.         TEST    Value, ECX
  1159.         SETNZ   AL
  1160.       @Fin:
  1161.   End;
  1162. {$ELSE}
  1163. Function IsBitSet (const Value : LongWord; const BitIndex : LongWord) : Boolean;
  1164.   Begin
  1165.     Result := Value and BitMaskTable [BitIndex] <> 0;
  1166.   End;
  1167. {$ENDIF}
  1168.  
  1169. {$IFDEF WINTEL}
  1170. Function SetBitScanForward (const Value : LongWord) : Integer;
  1171.   Asm
  1172.         OR      EAX, EAX
  1173.         JZ      @NoBits
  1174.         BSF     EAX, EAX
  1175.         RET
  1176.     @NoBits:
  1177.         MOV     EAX, -1
  1178.   End;
  1179.  
  1180. Function SetBitScanForward (const Value : LongWord; const StartBitIndex : LongWord) : Integer;
  1181.   Asm
  1182.         {$IFOPT R+}
  1183.         CMP     StartBitIndex, BitsPerLongWord
  1184.         JAE     @@zq
  1185.         {$ENDIF}
  1186.         MOV     ECX, StartBitIndex
  1187.         MOV     EDX, $FFFFFFFF
  1188.         SHL     EDX, CL
  1189.         AND     EDX, EAX
  1190.         JE      @@zq
  1191.         BSF     EAX, EDX
  1192.         RET
  1193. @@zq:   MOV     EAX, -1
  1194.   End;
  1195. {$ELSE}
  1196. Function SetBitScanForward (const Value : LongWord; const StartBitIndex : LongWord) : Integer;
  1197. var I : Byte;
  1198.   Begin
  1199.     For I := StartBitIndex to 31 do
  1200.       if Value and BitMaskTable [I] <> 0 then
  1201.         begin
  1202.           Result := I;
  1203.           exit;
  1204.         end;
  1205.     Result := -1;
  1206.   End;
  1207.  
  1208. Function SetBitScanForward (const Value : LongWord) : Integer;
  1209.   Begin
  1210.     Result := SetBitScanForward (Value, 0);
  1211.   End;
  1212. {$ENDIF}
  1213.  
  1214. {$IFDEF WINTEL}
  1215. Function SetBitScanReverse (const Value : LongWord) : Integer;
  1216.   Asm
  1217.         OR      EAX, EAX
  1218.         JZ      @NoBits
  1219.         BSR     EAX, EAX
  1220.         RET
  1221.     @NoBits:
  1222.         MOV     EAX, -1
  1223.   End;
  1224.  
  1225. Function SetBitScanReverse (const Value : LongWord; const StartBitIndex : LongWord) : Integer;
  1226.   Asm
  1227.         {$IFOPT R+}
  1228.         CMP     EDX, BitsPerLongWord
  1229.         JAE     @@zq
  1230.         {$ENDIF}
  1231.         LEA     ECX, [EDX-31]
  1232.         MOV     EDX, $FFFFFFFF
  1233.         NEG     ECX
  1234.         SHR     EDX, CL
  1235.         AND     EDX, EAX
  1236.         JE      @@zq
  1237.         BSR     EAX, EDX
  1238.         RET
  1239. @@zq:   MOV     EAX, -1
  1240.   End;
  1241. {$ELSE}
  1242. Function SetBitScanReverse (const Value : LongWord; const StartBitIndex : LongWord) : Integer;
  1243. var I : Byte;
  1244.   Begin
  1245.     For I := StartBitIndex downto 0 do
  1246.       if Value and BitMaskTable [I] <> 0 then
  1247.         begin
  1248.           Result := I;
  1249.           exit;
  1250.         end;
  1251.     Result := -1;
  1252.   End;
  1253.  
  1254. Function SetBitScanReverse (const Value : LongWord) : Integer;
  1255.   Begin
  1256.     SetBitScanReverse (Value, 31);
  1257.   End;
  1258. {$ENDIF}
  1259.  
  1260. {$IFDEF WINTEL}
  1261. Function ClearBitScanForward (const Value : LongWord) : Integer;
  1262.   Asm
  1263.         NOT     EAX
  1264.         OR      EAX, EAX
  1265.         JZ      @NoBits
  1266.         BSF     EAX, EAX
  1267.         RET
  1268.     @NoBits:
  1269.         MOV     EAX, -1
  1270.   End;
  1271.  
  1272. Function ClearBitScanForward (const Value : LongWord; const StartBitIndex : LongWord) : Integer;
  1273.   Asm
  1274.         {$IFOPT R+}
  1275.         CMP     EDX, BitsPerLongWord
  1276.         JAE     @@zq
  1277.         {$ENDIF}
  1278.         MOV     ECX, EDX
  1279.         MOV     EDX, $FFFFFFFF
  1280.         NOT     EAX
  1281.         SHL     EDX, CL
  1282.         AND     EDX, EAX
  1283.         JE      @@zq
  1284.         BSF     EAX, EDX
  1285.         RET
  1286. @@zq:   MOV     EAX, -1
  1287.   End;
  1288. {$ELSE}
  1289. Function ClearBitScanForward (const Value : LongWord; const StartBitIndex : LongWord) : Integer;
  1290. var I : Byte;
  1291.   Begin
  1292.     For I := StartBitIndex to 31 do
  1293.       if Value and BitMaskTable [I] = 0 then
  1294.         begin
  1295.           Result := I;
  1296.           exit;
  1297.         end;
  1298.     Result := -1;
  1299.   End;
  1300.  
  1301. Function ClearBitScanForward (const Value : LongWord) : Integer;
  1302.   Begin
  1303.     ClearBitScanForward (Value, 0);
  1304.   End;
  1305. {$ENDIF}
  1306.  
  1307. {$IFDEF WINTEL}
  1308. Function ClearBitScanReverse (const Value : LongWord) : Integer;
  1309.   Asm
  1310.         NOT     EAX
  1311.         OR      EAX, EAX
  1312.         JZ      @NoBits
  1313.         BSR     EAX, EAX
  1314.         RET
  1315.     @NoBits:
  1316.         MOV     EAX, -1
  1317.   End;
  1318.  
  1319. Function ClearBitScanReverse (const Value : LongWord; const StartBitIndex : LongWord) : Integer;
  1320.   Asm
  1321.         {$IFOPT R+}
  1322.         CMP     EDX, BitsPerLongWord
  1323.         JAE     @@zq
  1324.         {$ENDIF}
  1325.         LEA     ECX, [EDX-31]
  1326.         MOV     EDX, $FFFFFFFF
  1327.         NEG     ECX
  1328.         NOT     EAX
  1329.         SHR     EDX, CL
  1330.         AND     EDX, EAX
  1331.         JE      @@zq
  1332.         BSR     EAX, EDX
  1333.         RET
  1334. @@zq:   MOV     EAX, -1
  1335.   End;
  1336. {$ELSE}
  1337. Function ClearBitScanReverse (const Value : LongWord; const StartBitIndex : LongWord) : Integer;
  1338. var I : Byte;
  1339.   Begin
  1340.     For I := StartBitIndex downto 0 do
  1341.       if Value and BitMaskTable [I] = 0 then
  1342.         begin
  1343.           Result := I;
  1344.           exit;
  1345.         end;
  1346.     Result := -1;
  1347.   End;
  1348.  
  1349. Function ClearBitScanReverse (const Value : LongWord) : Integer;
  1350.   Begin
  1351.     ClearBitScanReverse (Value, 31);
  1352.   End;
  1353. {$ENDIF}
  1354.  
  1355. const
  1356.   BitCountTable : array [0..255] of Byte =
  1357.     (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,
  1358.      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,
  1359.      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,
  1360.      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,
  1361.      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,
  1362.      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,
  1363.      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,
  1364.      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);
  1365.  
  1366. {$IFDEF WINTEL}
  1367. Function BitCount (const Value : LongWord) : LongWord;
  1368.   Asm
  1369.         MOVZX   EDX, AL
  1370.         MOVZX   EDX, BYTE PTR [EDX + BitCountTable]
  1371.         MOVZX   ECX, AH
  1372.         ADD     DL, BYTE PTR [ECX + BitCountTable]
  1373.         SHR     EAX, 16
  1374.         MOVZX   ECX, AH
  1375.         ADD     DL, BYTE PTR [ECX + BitCountTable]
  1376.         AND     EAX, $FF
  1377.         ADD     DL, BYTE PTR [EAX + BitCountTable]
  1378.         MOV     AL, DL
  1379.   End;
  1380. {$ELSE}
  1381. Function BitCount (const Value : LongWord) : LongWord;
  1382. var V : Array [0..3] of Byte absolute Value;
  1383.   Begin
  1384.     Result := BitCountTable [V [0]] + BitCountTable [V [1]] +
  1385.               BitCountTable [V [2]] + BitCountTable [V [3]];
  1386.   End;
  1387. {$ENDIF}
  1388.  
  1389. Function IsPowerOfTwo (const Value : LongWord) : Boolean;
  1390.   Begin
  1391.     Result := BitCount (Value) = 1;
  1392.   End;
  1393.  
  1394. Function LowBitMask (const HighBitIndex : LongWord) : LongWord;
  1395.   Begin
  1396.     {$IFOPT R+}
  1397.     if HighBitIndex >= BitsPerLongWord then
  1398.       Result := 0 else
  1399.     {$ENDIF}
  1400.     Result := BitMaskTable [HighBitIndex] - 1;
  1401.   End;
  1402.  
  1403. Function HighBitMask (const LowBitIndex : LongWord) : LongWord;
  1404.   Begin
  1405.     {$IFOPT R+}
  1406.     if LowBitIndex >= BitsPerLongWord then
  1407.       Result := 0 else
  1408.     {$ENDIF}
  1409.     Result := not BitMaskTable [LowBitIndex] + 1;
  1410.   End;
  1411.  
  1412. Function RangeBitMask (const LowBitIndex, HighBitIndex : LongWord) : LongWord;
  1413.   Begin
  1414.     {$IFOPT R+}
  1415.     if (LowBitIndex >= BitsPerLongWord) and (HighBitIndex >= BitsPerLongWord) then
  1416.       begin
  1417.         Result := 0;
  1418.         exit;
  1419.       end;
  1420.     {$ENDIF}
  1421.     Result := $FFFFFFFF;
  1422.     if LowBitIndex > 0 then
  1423.       Result := Result xor (BitMaskTable [LowBitIndex] - 1);
  1424.     if HighBitIndex < 31 then
  1425.       Result := Result xor (not BitMaskTable [HighBitIndex + 1] + 1);
  1426.   End;
  1427.  
  1428. Function SetBitRange (const Value : LongWord; const LowBitIndex, HighBitIndex : LongWord) : LongWord;
  1429.   Begin
  1430.     Result := Value or RangeBitMask (LowBitIndex, HighBitIndex);
  1431.   End;
  1432.  
  1433. Function ClearBitRange (const Value : LongWord; const LowBitIndex, HighBitIndex : LongWord) : LongWord;
  1434.   Begin
  1435.     Result := Value and not RangeBitMask (LowBitIndex, HighBitIndex);
  1436.   End;
  1437.  
  1438. Function ToggleBitRange (const Value : LongWord; const LowBitIndex, HighBitIndex : LongWord) : LongWord;
  1439.   Begin
  1440.     Result := Value xor RangeBitMask (LowBitIndex, HighBitIndex);
  1441.   End;
  1442.  
  1443. Function IsBitRangeSet (const Value : LongWord; const LowBitIndex, HighBitIndex : LongWord) : Boolean;
  1444. var M : LongWord;
  1445.   Begin
  1446.     M := RangeBitMask (LowBitIndex, HighBitIndex);
  1447.     Result := Value and M = M;
  1448.   End;
  1449.  
  1450. Function IsBitRangeClear (const Value : LongWord; const LowBitIndex, HighBitIndex : LongWord) : Boolean;
  1451.   Begin
  1452.     Result := Value and RangeBitMask (LowBitIndex, HighBitIndex) = 0;
  1453.   End;
  1454.  
  1455.  
  1456.  
  1457. {                                                                              }
  1458. { Sets                                                                         }
  1459. {                                                                              }
  1460. Function AsCharSet (const C : Array of Char) : CharSet;
  1461. var I : Integer;
  1462.   Begin
  1463.     Result := [];
  1464.     For I := 0 to High (C) do
  1465.       Result := Result + [C [I]];
  1466.   End;
  1467.  
  1468. Function AsByteSet (const C : Array of Byte) : ByteSet;
  1469. var I : Integer;
  1470.   Begin
  1471.     Result := [];
  1472.     For I := 0 to High (C) do
  1473.       Result := Result + [C [I]];
  1474.   End;
  1475.  
  1476. {$IFDEF WINTEL}
  1477. Procedure ComplementChar (var C : CharSet; const Ch : Char);
  1478.   Asm
  1479.         MOVZX   ECX, DL
  1480.         BTC     [EAX], ECX
  1481.   End;
  1482. {$ELSE}
  1483. Procedure ComplementChar (var C : CharSet; const Ch : Char);
  1484.   Begin
  1485.     if Ch in C then
  1486.       Exclude (C, Ch) else
  1487.       Include (C, Ch);
  1488.   End;
  1489. {$ENDIF}
  1490.  
  1491. {$IFDEF WINTEL}
  1492. Procedure ClearCharSet (var C : CharSet);
  1493.   Asm
  1494.         XOR     EDX, EDX
  1495.         MOV     [EAX], EDX
  1496.         MOV     [EAX + 4], EDX
  1497.         MOV     [EAX + 8], EDX
  1498.         MOV     [EAX + 12], EDX
  1499.         MOV     [EAX + 16], EDX
  1500.         MOV     [EAX + 20], EDX
  1501.         MOV     [EAX + 24], EDX
  1502.         MOV     [EAX + 28], EDX
  1503.   End;
  1504. {$ELSE}
  1505. Procedure ClearCharSet (var C : CharSet);
  1506.   Begin
  1507.     C := [];
  1508.   End;
  1509. {$ENDIF}
  1510.  
  1511. {$IFDEF WINTEL}
  1512. Procedure FillCharSet (var C : CharSet);
  1513.   Asm
  1514.         MOV     EDX, $FFFFFFFF
  1515.         MOV     [EAX], EDX
  1516.         MOV     [EAX + 4], EDX
  1517.         MOV     [EAX + 8], EDX
  1518.         MOV     [EAX + 12], EDX
  1519.         MOV     [EAX + 16], EDX
  1520.         MOV     [EAX + 20], EDX
  1521.         MOV     [EAX + 24], EDX
  1522.         MOV     [EAX + 28], EDX
  1523.   End;
  1524. {$ELSE}
  1525. Procedure FillCharSet (var C : CharSet);
  1526.   Begin
  1527.     C := [#0..#255];
  1528.   End;
  1529. {$ENDIF}
  1530.  
  1531. {$IFDEF WINTEL}
  1532. Procedure ComplementCharSet (var C : CharSet);
  1533.   Asm
  1534.         NOT     DWORD PTR [EAX]
  1535.         NOT     DWORD PTR [EAX + 4]
  1536.         NOT     DWORD PTR [EAX + 8]
  1537.         NOT     DWORD PTR [EAX + 12]
  1538.         NOT     DWORD PTR [EAX + 16]
  1539.         NOT     DWORD PTR [EAX + 20]
  1540.         NOT     DWORD PTR [EAX + 24]
  1541.         NOT     DWORD PTR [EAX + 28]
  1542.   End;
  1543. {$ELSE}
  1544. Procedure ComplementCharSet (var C : CharSet);
  1545.   Begin
  1546.     C := [#0..#255] - C;
  1547.   End;
  1548. {$ENDIF}
  1549.  
  1550. {$IFDEF WINTEL}
  1551. Procedure AssignCharSet (var DestSet : CharSet; const SourceSet : CharSet);
  1552.   Asm
  1553.         MOV     ECX, [EDX]
  1554.         MOV     [EAX], ECX
  1555.         MOV     ECX, [EDX + 4]
  1556.         MOV     [EAX + 4], ECX
  1557.         MOV     ECX, [EDX + 8]
  1558.         MOV     [EAX + 8], ECX
  1559.         MOV     ECX, [EDX + 12]
  1560.         MOV     [EAX + 12], ECX
  1561.         MOV     ECX, [EDX + 16]
  1562.         MOV     [EAX + 16], ECX
  1563.         MOV     ECX, [EDX + 20]
  1564.         MOV     [EAX + 20], ECX
  1565.         MOV     ECX, [EDX + 24]
  1566.         MOV     [EAX + 24], ECX
  1567.         MOV     ECX, [EDX + 28]
  1568.         MOV     [EAX + 28], ECX
  1569.   End;
  1570. {$ELSE}
  1571. Procedure AssignCharSet (var DestSet : CharSet; const SourceSet : CharSet);
  1572.   Begin
  1573.     DestSet := SourceSet;
  1574.   End;
  1575. {$ENDIF}
  1576.  
  1577. {$IFDEF WINTEL}
  1578. Procedure Union (var DestSet : CharSet; const SourceSet : CharSet);
  1579.   Asm
  1580.         MOV     ECX, [EDX]
  1581.         OR      [EAX], ECX
  1582.         MOV     ECX, [EDX + 4]
  1583.         OR      [EAX + 4], ECX
  1584.         MOV     ECX, [EDX + 8]
  1585.         OR      [EAX + 8], ECX
  1586.         MOV     ECX, [EDX + 12]
  1587.         OR      [EAX + 12], ECX
  1588.         MOV     ECX, [EDX + 16]
  1589.         OR      [EAX + 16], ECX
  1590.         MOV     ECX, [EDX + 20]
  1591.         OR      [EAX + 20], ECX
  1592.         MOV     ECX, [EDX + 24]
  1593.         OR      [EAX + 24], ECX
  1594.         MOV     ECX, [EDX + 28]
  1595.         OR      [EAX + 28], ECX
  1596.   End;
  1597. {$ELSE}
  1598. Procedure Union (var DestSet : CharSet; const SourceSet : CharSet);
  1599.   Begin
  1600.     DestSet := DestSet + SourceSet;
  1601.   End;
  1602. {$ENDIF}
  1603.  
  1604. {$IFDEF WINTEL}
  1605. Procedure Difference (var DestSet : CharSet; const SourceSet : CharSet);
  1606.   Asm
  1607.         MOV     ECX, [EDX]
  1608.         NOT     ECX
  1609.         AND     [EAX], ECX
  1610.         MOV     ECX, [EDX + 4]
  1611.         NOT     ECX
  1612.         AND     [EAX + 4], ECX
  1613.         MOV     ECX, [EDX + 8]
  1614.         NOT     ECX
  1615.         AND     [EAX + 8],ECX
  1616.         MOV     ECX, [EDX + 12]
  1617.         NOT     ECX
  1618.         AND     [EAX + 12], ECX
  1619.         MOV     ECX, [EDX + 16]
  1620.         NOT     ECX
  1621.         AND     [EAX + 16], ECX
  1622.         MOV     ECX, [EDX + 20]
  1623.         NOT     ECX
  1624.         AND     [EAX + 20], ECX
  1625.         MOV     ECX, [EDX + 24]
  1626.         NOT     ECX
  1627.         AND     [EAX + 24], ECX
  1628.         MOV     ECX, [EDX + 28]
  1629.         NOT     ECX
  1630.         AND     [EAX + 28], ECX
  1631.   End;
  1632. {$ELSE}
  1633. Procedure Difference (var DestSet : CharSet; const SourceSet : CharSet);
  1634.   Begin
  1635.     DestSet := DestSet - SourceSet;
  1636.   End;
  1637. {$ENDIF}
  1638.  
  1639. {$IFDEF WINTEL}
  1640. Procedure Intersection (var DestSet : CharSet; const SourceSet : CharSet);
  1641.   Asm
  1642.         MOV     ECX, [EDX]
  1643.         AND     [EAX], ECX
  1644.         MOV     ECX, [EDX + 4]
  1645.         AND     [EAX + 4], ECX
  1646.         MOV     ECX, [EDX + 8]
  1647.         AND     [EAX + 8], ECX
  1648.         MOV     ECX, [EDX + 12]
  1649.         AND     [EAX + 12], ECX
  1650.         MOV     ECX, [EDX + 16]
  1651.         AND     [EAX + 16], ECX
  1652.         MOV     ECX, [EDX + 20]
  1653.         AND     [EAX + 20], ECX
  1654.         MOV     ECX, [EDX + 24]
  1655.         AND     [EAX + 24], ECX
  1656.         MOV     ECX, [EDX + 28]
  1657.         AND     [EAX + 28], ECX
  1658.   End;
  1659. {$ELSE}
  1660. Procedure Intersection (var DestSet : CharSet; const SourceSet : CharSet);
  1661.   Begin
  1662.     DestSet := DestSet * SourceSet;
  1663.   End;
  1664. {$ENDIF}
  1665.  
  1666. {$IFDEF WINTEL}
  1667. Procedure XORCharSet (var DestSet : CharSet; const SourceSet : CharSet);
  1668.   Asm
  1669.         MOV     ECX, [EDX]
  1670.         XOR     [EAX], ECX
  1671.         MOV     ECX, [EDX + 4]
  1672.         XOR     [EAX + 4], ECX
  1673.         MOV     ECX, [EDX + 8]
  1674.         XOR     [EAX + 8], ECX
  1675.         MOV     ECX, [EDX + 12]
  1676.         XOR     [EAX + 12], ECX
  1677.         MOV     ECX, [EDX + 16]
  1678.         XOR     [EAX + 16], ECX
  1679.         MOV     ECX, [EDX + 20]
  1680.         XOR     [EAX + 20], ECX
  1681.         MOV     ECX, [EDX + 24]
  1682.         XOR     [EAX + 24], ECX
  1683.         MOV     ECX, [EDX + 28]
  1684.         XOR     [EAX + 28], ECX
  1685.   End;
  1686. {$ELSE}
  1687. Procedure XORCharSet (var DestSet : CharSet; const SourceSet : CharSet);
  1688. var Ch : Char;
  1689.   Begin
  1690.     For Ch := #0 to #255 do
  1691.       if Ch in DestSet then
  1692.         begin
  1693.           if Ch in SourceSet then
  1694.             Exclude (DestSet, Ch);
  1695.         end else
  1696.         if Ch in SourceSet then
  1697.           Include (DestSet, Ch);
  1698.   End;
  1699. {$ENDIF}
  1700.  
  1701. {$IFDEF WINTEL}
  1702. Function IsSubSet (const A, B : CharSet) : Boolean;
  1703.   Asm
  1704.         MOV     ECX, [EDX]
  1705.         NOT     ECX
  1706.         AND     ECX, [EAX]
  1707.         JNE     @Fin0
  1708.         MOV     ECX, [EDX + 4]
  1709.         NOT     ECX
  1710.         AND     ECX, [EAX + 4]
  1711.         JNE     @Fin0
  1712.         MOV     ECX, [EDX + 8]
  1713.         NOT     ECX
  1714.         AND     ECX, [EAX + 8]
  1715.         JNE     @Fin0
  1716.         MOV     ECX, [EDX + 12]
  1717.         NOT     ECX
  1718.         AND     ECX, [EAX + 12]
  1719.         JNE     @Fin0
  1720.         MOV     ECX, [EDX + 16]
  1721.         NOT     ECX
  1722.         AND     ECX, [EAX + 16]
  1723.         JNE     @Fin0
  1724.         MOV     ECX, [EDX + 20]
  1725.         NOT     ECX
  1726.         AND     ECX, [EAX + 20]
  1727.         JNE     @Fin0
  1728.         MOV     ECX, [EDX + 24]
  1729.         NOT     ECX
  1730.         AND     ECX, [EAX + 24]
  1731.         JNE     @Fin0
  1732.         MOV     ECX, [EDX + 28]
  1733.         NOT     ECX
  1734.         AND     ECX, [EAX + 28]
  1735.         JNE     @Fin0
  1736.         MOV     EAX, 1
  1737.         RET
  1738. @Fin0:  XOR     EAX, EAX
  1739.   End;
  1740. {$ELSE}
  1741. Function IsSubSet (const A, B : CharSet) : Boolean;
  1742.   Begin
  1743.     Result := A <= B;
  1744.   End;
  1745. {$ENDIF}
  1746.  
  1747. {$IFDEF WINTEL}
  1748. Function IsEqual (const A, B : CharSet) : Boolean;
  1749.   Asm
  1750.         MOV     ECX, [EDX]
  1751.         XOR     ECX, [EAX]
  1752.         JNE     @Fin0
  1753.         MOV     ECX, [EDX + 4]
  1754.         XOR     ECX, [EAX + 4]
  1755.         JNE     @Fin0
  1756.         MOV     ECX, [EDX + 8]
  1757.         XOR     ECX, [EAX + 8]
  1758.         JNE     @Fin0
  1759.         MOV     ECX, [EDX + 12]
  1760.         XOR     ECX, [EAX + 12]
  1761.         JNE     @Fin0
  1762.         MOV     ECX, [EDX + 16]
  1763.         XOR     ECX, [EAX + 16]
  1764.         JNE     @Fin0
  1765.         MOV     ECX, [EDX + 20]
  1766.         XOR     ECX, [EAX + 20]
  1767.         JNE     @Fin0
  1768.         MOV     ECX, [EDX + 24]
  1769.         XOR     ECX, [EAX + 24]
  1770.         JNE     @Fin0
  1771.         MOV     ECX, [EDX + 28]
  1772.         XOR     ECX, [EAX + 28]
  1773.         JNE     @Fin0
  1774.         MOV     EAX, 1
  1775.         RET
  1776. @Fin0:  XOR     EAX, EAX
  1777.   End;
  1778. {$ELSE}
  1779. Function IsEqual (const A, B : CharSet) : Boolean;
  1780.   Begin
  1781.     Result := A = B;
  1782.   End;
  1783. {$ENDIF}
  1784.  
  1785. {$IFDEF WINTEL}
  1786. Function IsEmpty (const C : CharSet) : Boolean;
  1787.   Asm
  1788.         MOV     EDX, [EAX]
  1789.         OR      EDX, [EAX + 4]
  1790.         OR      EDX, [EAX + 8]
  1791.         OR      EDX, [EAX + 12]
  1792.         OR      EDX, [EAX + 16]
  1793.         OR      EDX, [EAX + 20]
  1794.         OR      EDX, [EAX + 24]
  1795.         OR      EDX, [EAX + 28]
  1796.         JNE     @Fin0
  1797.         MOV     EAX, 1
  1798.         RET
  1799. @Fin0:  XOR     EAX,EAX
  1800.   End;
  1801. {$ELSE}
  1802. Function IsEmpty (const C : CharSet) : Boolean;
  1803.   Begin
  1804.     Result := C = [];
  1805.   End;
  1806. {$ENDIF}
  1807.  
  1808. {$IFDEF WINTEL}
  1809. Function IsComplete (const C : CharSet) : Boolean;
  1810.   Asm
  1811.         MOV     EDX, [EAX]
  1812.         AND     EDX, [EAX + 4]
  1813.         AND     EDX, [EAX + 8]
  1814.         AND     EDX, [EAX + 12]
  1815.         AND     EDX, [EAX + 16]
  1816.         AND     EDX, [EAX + 20]
  1817.         AND     EDX, [EAX + 24]
  1818.         AND     EDX, [EAX + 28]
  1819.         CMP     EDX, $FFFFFFFF
  1820.         JNE     @Fin0
  1821.         MOV     EAX, 1
  1822.         RET
  1823. @Fin0:  XOR     EAX, EAX
  1824.   End;
  1825. {$ELSE}
  1826. Function IsComplete (const C : CharSet) : Boolean;
  1827.   Begin
  1828.     Result := C = CompleteCharSet;
  1829.   End;
  1830. {$ENDIF}
  1831.  
  1832. {$IFDEF WINTEL}
  1833. Function CharCount (const C : CharSet) : Integer;
  1834.   Asm
  1835.         PUSH    EBX
  1836.         PUSH    ESI
  1837.         MOV     EBX, EAX
  1838.         XOR     ESI, ESI
  1839.         MOV     EAX, [EBX]
  1840.         CALL    BitCount
  1841.         ADD     ESI, EAX
  1842.         MOV     EAX, [EBX + 4]
  1843.         CALL    BitCount
  1844.         ADD     ESI, EAX
  1845.         MOV     EAX, [EBX + 8]
  1846.         CALL    BitCount
  1847.         ADD     ESI, EAX
  1848.         MOV     EAX, [EBX + 12]
  1849.         CALL    BitCount
  1850.         ADD     ESI, EAX
  1851.         MOV     EAX, [EBX + 16]
  1852.         CALL    BitCount
  1853.         ADD     ESI, EAX
  1854.         MOV     EAX, [EBX + 20]
  1855.         CALL    BitCount
  1856.         ADD     ESI, EAX
  1857.         MOV     EAX, [EBX + 24]
  1858.         CALL    BitCount
  1859.         ADD     ESI, EAX
  1860.         MOV     EAX, [EBX + 28]
  1861.         CALL    BitCount
  1862.         ADD     EAX, ESI
  1863.         POP     ESI
  1864.         POP     EBX
  1865.   End;
  1866. {$ELSE}
  1867. Function CharCount (const C : CharSet) : Integer;
  1868. var I : Char;
  1869.   Begin
  1870.     Result := 0;
  1871.     For I := #0 to #255 do
  1872.       if I in C then
  1873.         Inc (Result);
  1874.   End;
  1875. {$ENDIF}
  1876.  
  1877. {$IFDEF WINTEL}
  1878. Procedure ConvertCaseInsensitive (var C : CharSet);
  1879.   Asm
  1880.         MOV     ECX, [EAX + 12]
  1881.         AND     ECX, $3FFFFFF
  1882.         OR      [EAX + 8], ECX
  1883.         MOV     ECX, [EAX + 8]
  1884.         AND     ECX, $3FFFFFF
  1885.         OR      [EAX + 12], ECX
  1886.   End;
  1887. {$ELSE}
  1888. Procedure ConvertCaseInsensitive (var C : CharSet);
  1889. var Ch : Char;
  1890.   Begin
  1891.     For Ch := 'A' to 'Z' do
  1892.       if Ch in C then
  1893.         Include (C, Char (Byte (Ch) + 32));
  1894.     For Ch := 'a' to 'z' do
  1895.       if Ch in C then
  1896.         Include (C, Char (Byte (Ch) - 32));
  1897.   End;
  1898. {$ENDIF}
  1899.  
  1900. Function CaseInsensitiveCharSet (const C : CharSet) : CharSet;
  1901.   Begin
  1902.     AssignCharSet (Result, C);
  1903.     ConvertCaseInsensitive (Result);
  1904.   End;
  1905.  
  1906.  
  1907.  
  1908. {                                                                              }
  1909. { Swap                                                                         }
  1910. {                                                                              }
  1911. {$IFDEF WINTEL}
  1912. Procedure Swap (var X, Y : Boolean);
  1913.   Asm
  1914.       mov cl, [edx]
  1915.       xchg byte ptr [eax], cl
  1916.       mov [edx], cl
  1917.   End;
  1918. {$ELSE}
  1919. Procedure Swap (var X, Y : Boolean);
  1920. var F : Boolean;
  1921.   Begin
  1922.     F := X;
  1923.     X := Y;
  1924.     Y := F;
  1925.   End;
  1926. {$ENDIF}
  1927.  
  1928. {$IFDEF WINTEL}
  1929. Procedure Swap (var X, Y : Byte);
  1930.   Asm
  1931.       mov cl, [edx]
  1932.       xchg byte ptr [eax], cl
  1933.       mov [edx], cl
  1934.   End;
  1935. {$ELSE}
  1936. Procedure Swap (var X, Y : Byte);
  1937. var F : Byte;
  1938.   Begin
  1939.     F := X;
  1940.     X := Y;
  1941.     Y := F;
  1942.   End;
  1943. {$ENDIF}
  1944.  
  1945. {$IFDEF WINTEL}
  1946. Procedure Swap (var X, Y : ShortInt);
  1947.   Asm
  1948.       mov cl, [edx]
  1949.       xchg byte ptr [eax], cl
  1950.       mov [edx], cl
  1951.   End;
  1952. {$ELSE}
  1953. Procedure Swap (var X, Y : ShortInt);
  1954. var F : ShortInt;
  1955.   Begin
  1956.     F := X;
  1957.     X := Y;
  1958.     Y := F;
  1959.   End;
  1960. {$ENDIF}
  1961.  
  1962. {$IFDEF WINTEL}
  1963. Procedure Swap (var X, Y : Word);
  1964.   Asm
  1965.       mov cx, [edx]
  1966.       xchg word ptr [eax], cx
  1967.       mov [edx], cx
  1968.   End;
  1969. {$ELSE}
  1970. Procedure Swap (var X, Y : Word);
  1971. var F : Word;
  1972.   Begin
  1973.     F := X;
  1974.     X := Y;
  1975.     Y := F;
  1976.   End;
  1977. {$ENDIF}
  1978.  
  1979. {$IFDEF WINTEL}
  1980. Procedure Swap (var X, Y : SmallInt);
  1981.   Asm
  1982.       mov cx, [edx]
  1983.       xchg word ptr [eax], cx
  1984.       mov [edx], cx
  1985.   End;
  1986. {$ELSE}
  1987. Procedure Swap (var X, Y : SmallInt);
  1988. var F : SmallInt;
  1989.   Begin
  1990.     F := X;
  1991.     X := Y;
  1992.     Y := F;
  1993.   End;
  1994. {$ENDIF}
  1995.  
  1996. {$IFDEF WINTEL}
  1997. Procedure Swap (var X, Y : LongInt);
  1998.   Asm
  1999.       mov ecx, [edx]
  2000.       xchg [eax], ecx
  2001.       mov [edx], ecx
  2002.   End;
  2003. {$ELSE}
  2004. Procedure Swap (var X, Y : LongInt);
  2005. var F : LongInt;
  2006.   Begin
  2007.     F := X;
  2008.     X := Y;
  2009.     Y := F;
  2010.   End;
  2011. {$ENDIF}
  2012.  
  2013. {$IFDEF WINTEL}
  2014. Procedure Swap (var X, Y : LongWord);
  2015.   Asm
  2016.       mov ecx, [edx]
  2017.       xchg [eax], ecx
  2018.       mov [edx], ecx
  2019.   End;
  2020. {$ELSE}
  2021. Procedure Swap (var X, Y : LongWord);
  2022. var F : LongWord;
  2023.   Begin
  2024.     F := X;
  2025.     X := Y;
  2026.     Y := F;
  2027.   End;
  2028. {$ENDIF}
  2029.  
  2030. {$IFDEF WINTEL}
  2031. Procedure Swap (var X, Y : Pointer);
  2032.   Asm
  2033.       mov ecx, [edx]
  2034.       xchg [eax], ecx
  2035.       mov [edx], ecx
  2036.   End;
  2037. {$ELSE}
  2038. Procedure Swap (var X, Y : Pointer);
  2039. var F : Pointer;
  2040.   Begin
  2041.     F := X;
  2042.     X := Y;
  2043.     Y := F;
  2044.   End;
  2045. {$ENDIF}
  2046.  
  2047. {$IFDEF WINTEL}
  2048. Procedure Swap (var X, Y : TObject);
  2049.   Asm
  2050.       mov ecx, [edx]
  2051.       xchg [eax], ecx
  2052.       mov [edx], ecx
  2053.   End;
  2054. {$ELSE}
  2055. Procedure Swap (var X, Y : TObject);
  2056. var F : TObject;
  2057.   Begin
  2058.     F := X;
  2059.     X := Y;
  2060.     Y := F;
  2061.   End;
  2062. {$ENDIF}
  2063.  
  2064. Procedure Swap (var X, Y : Int64);
  2065. var F : Int64;
  2066.   Begin
  2067.     F := X;
  2068.     X := Y;
  2069.     Y := F;
  2070.   End;
  2071.  
  2072. Procedure Swap (var X, Y : Single);
  2073. var F : Single;
  2074.   Begin
  2075.     F := X;
  2076.     X := Y;
  2077.     Y := F;
  2078.   End;
  2079.  
  2080. Procedure Swap (var X, Y : Double);
  2081. var F : Double;
  2082.   Begin
  2083.     F := X;
  2084.     X := Y;
  2085.     Y := F;
  2086.   End;
  2087.  
  2088. Procedure Swap (var X, Y : Extended);
  2089. var F : Extended;
  2090.   Begin
  2091.     F := X;
  2092.     X := Y;
  2093.     Y := F;
  2094.   End;
  2095.  
  2096. Procedure Swap (var X, Y : String);
  2097. var F : String;
  2098.   Begin
  2099.     F := X;
  2100.     X := Y;
  2101.     Y := F;
  2102.   End;
  2103.  
  2104. {$IFDEF WINTEL}
  2105. Procedure SwapObjects (var X, Y);
  2106.   Asm
  2107.       mov ecx, [edx]
  2108.       xchg [eax], ecx
  2109.       mov [edx], ecx
  2110.   End;
  2111. {$ELSE}
  2112. Procedure SwapObjects (var X, Y);
  2113. var F : TObject;
  2114.   Begin
  2115.     F := TObject (X);
  2116.     TObject (X) := TObject (Y);
  2117.     TObject (Y) := F;
  2118.   End;
  2119. {$ENDIF}
  2120.  
  2121.  
  2122.  
  2123. {                                                                              }
  2124. { iif                                                                          }
  2125. {                                                                              }
  2126. Function iif (const Expr : Boolean; const TrueValue, FalseValue : LongWord) : LongWord;
  2127.   Begin
  2128.     if Expr then
  2129.       Result := TrueValue else
  2130.       Result := FalseValue;
  2131.   End;
  2132.  
  2133. Function iif (const Expr : Boolean; const TrueValue, FalseValue : Int64) : Int64;
  2134.   Begin
  2135.     if Expr then
  2136.       Result := TrueValue else
  2137.       Result := FalseValue;
  2138.   End;
  2139.  
  2140. Function iif (const Expr : Boolean; const TrueValue, FalseValue : Single) : Single;
  2141.   Begin
  2142.     if Expr then
  2143.       Result := TrueValue else
  2144.       Result := FalseValue;
  2145.   End;
  2146.  
  2147. Function iif (const Expr : Boolean; const TrueValue, FalseValue : Double) : Double;
  2148.   Begin
  2149.     if Expr then
  2150.       Result := TrueValue else
  2151.       Result := FalseValue;
  2152.   End;
  2153.  
  2154. Function iif (const Expr : Boolean; const TrueValue, FalseValue : Extended) : Extended;
  2155.   Begin
  2156.     if Expr then
  2157.       Result := TrueValue else
  2158.       Result := FalseValue;
  2159.   End;
  2160.  
  2161. Function iif (const Expr : Boolean; const TrueValue, FalseValue : String) : String;
  2162.   Begin
  2163.     if Expr then
  2164.       Result := TrueValue else
  2165.       Result := FalseValue;
  2166.   End;
  2167.  
  2168. Function iif (const Expr : Boolean; const TrueValue, FalseValue : Pointer) : Pointer;
  2169.   Begin
  2170.     if Expr then
  2171.       Result := TrueValue else
  2172.       Result := FalseValue;
  2173.   End;
  2174.  
  2175. Function iif (const Expr : Boolean; const TrueValue, FalseValue : TObject) : TObject;
  2176.   Begin
  2177.     if Expr then
  2178.       Result := TrueValue else
  2179.       Result := FalseValue;
  2180.   End;
  2181.  
  2182.  
  2183.  
  2184. {                                                                              }
  2185. { Compare                                                                      }
  2186. {                                                                              }
  2187. Function Compare (const I1, I2 : Integer) : TCompareResult;
  2188.   Begin
  2189.     if I1 < I2 then
  2190.       Result := crLess else
  2191.     if I1 > I2 then
  2192.       Result := crGreater else
  2193.       Result := crEqual;
  2194.   End;
  2195.  
  2196. Function Compare (const I1, I2 : Int64) : TCompareResult;
  2197.   Begin
  2198.     if I1 < I2 then
  2199.       Result := crLess else
  2200.     if I1 > I2 then
  2201.       Result := crGreater else
  2202.       Result := crEqual;
  2203.   End;
  2204.  
  2205. Function Compare (const I1, I2 : Single) : TCompareResult;
  2206.   Begin
  2207.     if I1 < I2 then
  2208.       Result := crLess else
  2209.     if I1 > I2 then
  2210.       Result := crGreater else
  2211.       Result := crEqual;
  2212.   End;
  2213.  
  2214. Function Compare (const I1, I2 : Double) : TCompareResult;
  2215.   Begin
  2216.     if I1 < I2 then
  2217.       Result := crLess else
  2218.     if I1 > I2 then
  2219.       Result := crGreater else
  2220.       Result := crEqual;
  2221.   End;
  2222.  
  2223. Function Compare (const I1, I2 : Extended) : TCompareResult;
  2224.   Begin
  2225.     if I1 < I2 then
  2226.       Result := crLess else
  2227.     if I1 > I2 then
  2228.       Result := crGreater else
  2229.       Result := crEqual;
  2230.   End;
  2231.  
  2232. Function Compare (const I1, I2 : Boolean) : TCompareResult;
  2233.   Begin
  2234.     if I1 = I2 then
  2235.       Result := crEqual else
  2236.     if I1 then
  2237.       Result := crGreater else
  2238.       Result := crLess;
  2239.   End;
  2240.  
  2241. Function Compare (const I1, I2 : String) : TCompareResult;
  2242.   Begin
  2243.     if I1 = I2 then
  2244.       Result := crEqual else
  2245.     if I1 > I2 then
  2246.       Result := crGreater else
  2247.       Result := crLess;
  2248.   End;
  2249.  
  2250. Function Compare (const I1, I2 : TObject) : TCompareResult;
  2251.   Begin
  2252.     Result := Compare (Integer (I1), Integer (I2));
  2253.   End;
  2254.  
  2255. Function NegatedCompareResult (const C : TCompareResult) : TCompareResult;
  2256.   Begin
  2257.     if C = crLess then
  2258.       Result := crGreater else
  2259.     if C = crGreater then
  2260.       Result := crLess else
  2261.       Result := C;
  2262.   End;
  2263.  
  2264.  
  2265.  
  2266. {                                                                              }
  2267. { Base Conversion                                                              }
  2268. {                                                                              }
  2269. Function LongWordToBase (const I : LongWord; const Digits, Base : Byte) : String;
  2270. var D : LongWord;
  2271.     L : Byte;
  2272.     P : PChar;
  2273.   Begin
  2274.     Assert (Base <= 16, 'Base <= 16');
  2275.     if I = 0 then
  2276.       begin
  2277.         if Digits = 0 then
  2278.           L := 1 else
  2279.           L := Digits;
  2280.         SetLength (Result, L);
  2281.         FillChar (Pointer (Result)^, L, '0');
  2282.         exit;
  2283.       end;
  2284.     L := 0;
  2285.     D := I;
  2286.     While D > 0 do
  2287.       begin
  2288.         Inc (L);
  2289.         D := D div Base;
  2290.       end;
  2291.     if L < Digits then
  2292.       L := Digits;
  2293.     SetLength (Result, L);
  2294.     P := Pointer (Result);
  2295.     Inc (P, L - 1);
  2296.     D := I;
  2297.     While D > 0 do
  2298.       begin
  2299.         P^ := s_HexDigitsUpper [D mod Base + 1];
  2300.         Dec (P);
  2301.         Dec (L);
  2302.         D := D div Base;
  2303.       end;
  2304.     While L > 0 do
  2305.       begin
  2306.         P^ := '0';
  2307.         Dec (P);
  2308.         Dec (L);
  2309.       end;
  2310.   End;
  2311.  
  2312. Function LongWordToBin (const I : LongWord; const Digits : Byte) : String;
  2313.   Begin
  2314.     Result := LongWordToBase (I, Digits, 2);
  2315.   End;
  2316.  
  2317. Function LongWordToOct (const I : LongWord; const Digits : Byte) : String;
  2318.   Begin
  2319.     Result := LongWordToBase (I, Digits, 8);
  2320.   End;
  2321.  
  2322. Function LongWordToHex (const I : LongWord; const Digits : Byte) : String;
  2323.   Begin
  2324.     Result := LongWordToBase (I, Digits, 16);
  2325.   End;
  2326.  
  2327. Function LongWordToStr (const I : LongWord; const Digits : Byte) : String;
  2328.   Begin
  2329.     Result := LongWordToBase (I, Digits, 10);
  2330.   End;
  2331.  
  2332. const
  2333.   HexLookup : Array [0..255] of Byte = (
  2334.       $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
  2335.       $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
  2336.       $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
  2337.       0,   1,   2,   3,   4,   5,   6,   7,   8,   9,   $FF, $FF, $FF, $FF, $FF, $FF,
  2338.       $FF, 10,  11,  12,  13,  14,  15,  $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
  2339.       $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
  2340.       $FF, 10,  11,  12,  13,  14,  15,  $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
  2341.       $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
  2342.       $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
  2343.       $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
  2344.       $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
  2345.       $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
  2346.       $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
  2347.       $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
  2348.       $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF,
  2349.       $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF);
  2350.  
  2351. Function HexCharValue (const Ch : Char) : Byte;
  2352.   Begin
  2353.     Result := HexLookup [Byte (Ch)];
  2354.   End;
  2355.  
  2356. Function BaseToLongWord (const S : String; const BaseLog2 : Byte) : LongWord;
  2357. var L : LongWord;
  2358.     P : Byte;
  2359.     C : Byte;
  2360.     Q : PChar;
  2361.   Begin
  2362.     Assert (BaseLog2 <= 4, 'BaseLog2 <= 4');
  2363.     P := Length (S);
  2364.     if P = 0 then
  2365.       begin
  2366.         Result := 0;
  2367.         exit;
  2368.       end;
  2369.     L := 0;
  2370.     Result := 0;
  2371.     Q := Pointer (S);
  2372.     Inc (Q, P - 1);
  2373.     Repeat
  2374.       C := HexLookup [Ord (Q^)];
  2375.       if C <> $FF then
  2376.         Inc (Result, LongWord (C) shl L);
  2377.       Inc (L, BaseLog2);
  2378.       Dec (P);
  2379.       Dec (Q);
  2380.     Until (P = 0) or (L = 32);
  2381.   End;
  2382.  
  2383. Function BinToLongWord (const S : String) : LongWord;
  2384.   Begin
  2385.     Result := BaseToLongWord (S, 1);
  2386.   End;
  2387.  
  2388. Function OctToLongWord (const S : String) : LongWord;
  2389.   Begin
  2390.     Result := BaseToLongWord (S, 3);
  2391.   End;
  2392.  
  2393. Function HexToLongWord (const S : String) : LongWord;
  2394.   Begin
  2395.     Result := BaseToLongWord (S, 4);
  2396.   End;
  2397.  
  2398. Function StrToLongWord (const S : String) : LongWord;
  2399. var L : Integer;
  2400.     P : PChar;
  2401.     C : Char;
  2402.     F : LongWord;
  2403.   Begin
  2404.     L := Length (S);
  2405.     if L = 0 then
  2406.       begin
  2407.         Result := 0;
  2408.         exit;
  2409.       end;
  2410.     Result := 0;
  2411.     F := 1;
  2412.     P := Pointer (S);
  2413.     Inc (P, L - 1);
  2414.     Repeat
  2415.       C := P^;
  2416.       if C in ['0'..'9'] then
  2417.         Inc (Result, Byte (Ord (C) - Ord ('0')) * F);
  2418.       if F = 1000000000 then
  2419.         exit;
  2420.       F := F * 10;
  2421.       Dec (P);
  2422.       Dec (L);
  2423.     Until L = 0;
  2424.   End;
  2425.  
  2426. Function EncodeBase64 (const S, Alphabet : String; const Pad : Boolean; const PadMultiple : Integer; const PadChar : Char) : String;
  2427. var R, C : Byte;
  2428.     F, L, M, N, U : Integer;
  2429.     P : PChar;
  2430.     T : Boolean;
  2431.   Begin
  2432.     Assert (Length (Alphabet) = 64, 'Alphabet must contain 64 characters.');
  2433.     L := Length (S);
  2434.     if L = 0 then
  2435.       begin
  2436.         Result := '';
  2437.         exit;
  2438.       end;
  2439.     M := L mod 3;
  2440.     N := (L div 3) * 4 + M;
  2441.     if M > 0 then
  2442.       Inc (N);
  2443.     T := Pad and (PadMultiple > 1);
  2444.     if T then
  2445.       begin
  2446.         U := N mod PadMultiple;
  2447.         if U > 0 then
  2448.           begin
  2449.             U := PadMultiple - U;
  2450.             Inc (N, U);
  2451.           end;
  2452.       end else
  2453.       U := 0;
  2454.     SetLength (Result, N);
  2455.     P := Pointer (Result);
  2456.     R := 0;
  2457.     For F := 0 to L - 1 do
  2458.       begin
  2459.         C := Byte (S [F + 1]);
  2460.         Case F mod 3 of
  2461.           0 : begin
  2462.                 P^ := Alphabet [C shr 2 + 1];
  2463.                 Inc (P);
  2464.                 R := (C and 3) shl 4;
  2465.               end;
  2466.           1 : begin
  2467.                 P^ := Alphabet [C shr 4 + R + 1];
  2468.                 Inc (P);
  2469.                 R := (C and $0F) shl 2;
  2470.               end;
  2471.           2 : begin
  2472.                 P^ := Alphabet [C shr 6 + R + 1];
  2473.                 Inc (P);
  2474.                 P^ := Alphabet [C and $3F + 1];
  2475.                 Inc (P);
  2476.               end;
  2477.         end;
  2478.       end;
  2479.     if M > 0 then
  2480.       begin
  2481.         P^ := Alphabet [R + 1];
  2482.         Inc (P);
  2483.       end;
  2484.     For F := 1 to U do
  2485.       begin
  2486.         P^ := PadChar;
  2487.         Inc (P);
  2488.       end;
  2489.   End;
  2490.  
  2491. Function DecodeBase64 (const S, Alphabet : String; const PadSet : CharSet) : String;
  2492. var F, L, M, P : Integer;
  2493.     B : Byte;
  2494.     OutPos : Byte;
  2495.     OutB : Array [1..3] of Byte;
  2496.     Lookup : Array [0..255] of Byte;
  2497.     R : PChar;
  2498.   Begin
  2499.     Assert (Length (Alphabet) = 64, 'Alphabet must contain 64 characters.');
  2500.     L := Length (S);
  2501.     P := 0;
  2502.     if PadSet <> [] then
  2503.       While (L - P > 0) and (S [L - P] in PadSet) do
  2504.         Inc (P);
  2505.     M := L - P;
  2506.     if M = 0 then
  2507.       begin
  2508.         Result := '';
  2509.         exit;
  2510.       end;
  2511.     SetLength (Result, (M * 3) div 4);
  2512.     FillChar (Lookup, Sizeof (Lookup), #0);
  2513.     For F := 0 to 63 do
  2514.       Lookup [Ord (Alphabet [F + 1])] := F;
  2515.     R := Pointer (Result);
  2516.     OutPos := 0;
  2517.     For F := 1 to L - P do
  2518.       begin
  2519.         B := Lookup [Ord (S [F])];
  2520.         Case OutPos of
  2521.             0 : OutB [1] := B shl 2;
  2522.             1 : begin
  2523.                   OutB [1] := OutB [1] or (B shr 4);
  2524.                   R^ := Char (OutB [1]);
  2525.                   Inc (R);
  2526.                   OutB [2] := (B shl 4) and $FF;
  2527.                 end;
  2528.             2 : begin
  2529.                   OutB [2] := OutB [2] or (B shr 2);
  2530.                   R^ := Char (OutB [2]);
  2531.                   Inc (R);
  2532.                   OutB [3] := (B shl 6) and $FF;
  2533.                 end;
  2534.             3 : begin
  2535.                   OutB [3] := OutB [3] or B;
  2536.                   R^ := Char (OutB [3]);
  2537.                   Inc (R);
  2538.                 end;
  2539.           end;
  2540.         OutPos := (OutPos + 1) mod 4;
  2541.       end;
  2542.     if (OutPos > 0) and (P = 0) then // incomplete encoding, add the partial byte if not 0
  2543.       if OutB [OutPos] <> 0 then
  2544.         Result := Result + Char (OutB [OutPos]);
  2545.   End;
  2546.  
  2547. Function MIMEBase64Encode (const S : String) : String;
  2548.   Begin
  2549.     Result := EncodeBase64 (S, b64_MIMEBase64, True, 4, '=');
  2550.   End;
  2551.  
  2552. Function UUDecode (const S : String) : String;
  2553.   Begin
  2554.     // Line without size indicator (first byte = length + 32)
  2555.     Result := DecodeBase64 (S, b64_UUEncode, ['`']);
  2556.   End;
  2557.  
  2558. Function MIMEBase64Decode (const S : String) : String;
  2559.   Begin
  2560.     Result := DecodeBase64 (S, b64_MIMEBase64, ['=']);
  2561.   End;
  2562.  
  2563. Function XXDecode (const S : String) : String;
  2564.   Begin
  2565.     Result := DecodeBase64 (S, b64_XXEncode, []);
  2566.   End;
  2567.  
  2568. Function BytesToHex (const P : Pointer; const Count : Integer) : String;
  2569. var Q : PByte;
  2570.     D : PChar;
  2571.     L : Integer;
  2572.   Begin
  2573.     Q := P;
  2574.     L := Count;
  2575.     if (L <= 0) or not Assigned (Q) then
  2576.       begin
  2577.         Result := '';
  2578.         exit;
  2579.       end;
  2580.     SetLength (Result, Count * 2);
  2581.     D := Pointer (Result);
  2582.     While L > 0 do
  2583.       begin
  2584.         D^ := s_HexDigitsUpper [Q^ shr 4 + 1];
  2585.         Inc (D);
  2586.         D^ := s_HexDigitsUpper [Q^ and $F + 1];
  2587.         Inc (D);
  2588.         Inc (Q);
  2589.         Dec (L);
  2590.       end;
  2591.   End;
  2592.  
  2593.  
  2594.  
  2595. {                                                                              }
  2596. { Type conversion                                                              }
  2597. {                                                                              }
  2598. Function PointerToStr (const P : Pointer) : String;
  2599.   Begin
  2600.     Result := '$' + LongWordToHex (LongWord (P), 8);
  2601.   End;
  2602.  
  2603. Function StrToPointer (const S : String) : Pointer;
  2604.   Begin
  2605.     Result := Pointer (HexToLongWord (S));
  2606.   End;
  2607.  
  2608. Function ObjectClassName (const O : TObject) : String;
  2609.   Begin
  2610.     if not Assigned (O) then
  2611.       Result := 'nil' else
  2612.       Result := O.ClassName;
  2613.   End;
  2614.  
  2615. Function ClassClassName (const C : TClass) : String;
  2616.   Begin
  2617.     if not Assigned (C) then
  2618.       Result := 'nil' else
  2619.       Result := C.ClassName;
  2620.   End;
  2621.  
  2622. Function ObjectToStr (const O : TObject) : String;
  2623.   Begin
  2624.     if not Assigned (O) then
  2625.       Result := 'nil' else
  2626.       Result := O.ClassName + '@' + LongWordToHex (LongWord (O), 8);
  2627.   End;
  2628.  
  2629. Function ClassToStr (const C : TClass) : String;
  2630.   Begin
  2631.     if not Assigned (C) then
  2632.       Result := 'nil' else
  2633.       Result := C.ClassName + '@' + LongWordToHex (LongWord (C), 8);
  2634.   End;
  2635.  
  2636. {$IFDEF WINTEL}
  2637. Function CharSetToStr (const C : CharSet) : String; // Andrew N. Driazgov
  2638.   Asm
  2639.         PUSH    EBX
  2640.         MOV     ECX, $100
  2641.         MOV     EBX, EAX
  2642.         PUSH    ESI
  2643.         MOV     EAX, EDX
  2644.         SUB     ESP, ECX
  2645.         XOR     ESI, ESI
  2646.         XOR     EDX, EDX
  2647. @@lp:   BT      [EBX], EDX
  2648.         JC      @@mm
  2649. @@nx:   INC     EDX
  2650.         DEC     ECX
  2651.         JNE     @@lp
  2652.         MOV     ECX, ESI
  2653.         MOV     EDX, ESP
  2654.         CALL    System.@LStrFromPCharLen
  2655.         ADD     ESP, $100
  2656.         POP     ESI
  2657.         POP     EBX
  2658.         RET
  2659. @@mm:   MOV     [ESP + ESI], DL
  2660.         INC     ESI
  2661.         JMP     @@nx
  2662.   End;
  2663. {$ELSE}
  2664. Function CharSetToStr (const C : CharSet) : String;
  2665. // Implemented recursively to avoid multiple memory allocations
  2666.   Procedure CharMatch (const Start : Char; const Count : Integer);
  2667.   var Ch : Char;
  2668.     Begin
  2669.       For Ch := Start to #255 do
  2670.         if Ch in C then
  2671.           begin
  2672.             if Ch = #255 then
  2673.               SetLength (Result, Count + 1) else
  2674.               CharMatch (Char (Byte (Ch) + 1), Count + 1);
  2675.             Result [Count + 1] := Ch;
  2676.             exit;
  2677.           end;
  2678.       SetLength (Result, Count);
  2679.     End;
  2680.   Begin
  2681.     CharMatch (#0, 0);
  2682.   End;
  2683. {$ENDIF}
  2684.  
  2685. {$IFDEF WINTEL}
  2686. Function StrToCharSet (const S : String) : CharSet; // Andrew N. Driazgov
  2687.   Asm
  2688.         XOR     ECX, ECX
  2689.         MOV     [EDX], ECX
  2690.         MOV     [EDX + 4], ECX
  2691.         MOV     [EDX + 8], ECX
  2692.         MOV     [EDX + 12], ECX
  2693.         MOV     [EDX + 16], ECX
  2694.         MOV     [EDX + 20], ECX
  2695.         MOV     [EDX + 24], ECX
  2696.         MOV     [EDX + 28], ECX
  2697.         TEST    EAX, EAX
  2698.         JE      @@qt
  2699.         MOV     ECX, [EAX - 4]
  2700.         PUSH    EBX
  2701.         SUB     ECX, 8
  2702.         JS      @@nx
  2703. @@lp:   MOVZX   EBX, BYTE PTR [EAX]
  2704.         BTS     [EDX], EBX
  2705.         MOVZX   EBX, BYTE PTR [EAX + 1]
  2706.         BTS     [EDX], EBX
  2707.         MOVZX   EBX, BYTE PTR [EAX + 2]
  2708.         BTS     [EDX], EBX
  2709.         MOVZX   EBX, BYTE PTR [EAX + 3]
  2710.         BTS     [EDX], EBX
  2711.         MOVZX   EBX, BYTE PTR [EAX + 4]
  2712.         BTS     [EDX], EBX
  2713.         MOVZX   EBX, BYTE PTR [EAX + 5]
  2714.         BTS     [EDX], EBX
  2715.         MOVZX   EBX, BYTE PTR [EAX + 6]
  2716.         BTS     [EDX], EBX
  2717.         MOVZX   EBX, BYTE PTR [EAX + 7]
  2718.         BTS     [EDX], EBX
  2719.         ADD     EAX, 8
  2720.         SUB     ECX, 8
  2721.         JNS     @@lp
  2722. @@nx:   JMP     DWORD PTR @@tV[ECX * 4 + 32]
  2723. @@tV:   DD      @@ex, @@t1, @@t2, @@t3
  2724.         DD      @@t4, @@t5, @@t6, @@t7
  2725. @@t7:   MOVZX   EBX, BYTE PTR [EAX + 6]
  2726.         BTS     [EDX], EBX
  2727. @@t6:   MOVZX   EBX, BYTE PTR [EAX + 5]
  2728.         BTS     [EDX], EBX
  2729. @@t5:   MOVZX   EBX, BYTE PTR [EAX + 4]
  2730.         BTS     [EDX], EBX
  2731. @@t4:   MOVZX   EBX, BYTE PTR [EAX + 3]
  2732.         BTS     [EDX], EBX
  2733. @@t3:   MOVZX   EBX, BYTE PTR [EAX + 2]
  2734.         BTS     [EDX], EBX
  2735. @@t2:   MOVZX   EBX, BYTE PTR [EAX + 1]
  2736.         BTS     [EDX], EBX
  2737. @@t1:   MOVZX   EBX, BYTE PTR [EAX]
  2738.         BTS     [EDX], EBX
  2739. @@ex:   POP     EBX
  2740. @@qt:
  2741.   End;
  2742. {$ELSE}
  2743. Function StrToCharSet (const S : String) : CharSet;
  2744. var I : Integer;
  2745.   Begin
  2746.     ClearCharSet (Result);
  2747.     For I := 1 to Length (S) do
  2748.       Include (Result, S [I]);
  2749.   End;
  2750. {$ENDIF}
  2751.  
  2752.  
  2753.  
  2754. {                                                                              }
  2755. { Hash functions                                                               }
  2756. {   Based on CRC32 algorithm                                                   }
  2757. {                                                                              }
  2758. var
  2759.   CRC32TableInit : Boolean = False;
  2760.   CRC32Table     : Array [Byte] of LongWord;
  2761.   CRC32Poly      : LongWord = $EDB88320;
  2762.  
  2763. Procedure InitCRC32Table;
  2764. var I, J : Byte;
  2765.     R    : LongWord;
  2766.   Begin
  2767.     For I := $00 to $FF do
  2768.       begin
  2769.         R := I;
  2770.         For J := 8 downto 1 do
  2771.           if R and 1 <> 0 then
  2772.             R := (R shr 1) xor CRC32Poly else
  2773.             R := R shr 1;
  2774.         CRC32Table [I] := R;
  2775.       end;
  2776.     CRC32TableInit := True;
  2777.   End;
  2778.  
  2779. Procedure SetCRC32Poly (const Poly : LongWord);
  2780.   Begin
  2781.     CRC32Poly := Poly;
  2782.     CRC32TableInit := False;
  2783.   End;
  2784.  
  2785. Function CalcCRC32Byte (const CRC32 : LongWord; const Octet : Byte) : LongWord;
  2786.   Begin
  2787.     Result := CRC32Table [Byte (CRC32) xor Octet] xor ((CRC32 shr 8) and $00FFFFFF);
  2788.   End;
  2789.  
  2790. Function CRC32Byte (const CRC32 : LongWord; const Octet : Byte) : LongWord;
  2791.   Begin
  2792.     if not CRC32TableInit then
  2793.       InitCRC32Table;
  2794.     Result := CalcCRC32Byte (CRC32, Octet);
  2795.   End;
  2796.  
  2797. Function CRC32Buf (const CRC32 : LongWord; const Buf; const BufSize : Integer) : LongWord;
  2798. var P : PByte;
  2799.     I : Integer;
  2800.   Begin
  2801.     if not CRC32TableInit then
  2802.       InitCRC32Table;
  2803.     P := @Buf;
  2804.     Result := CRC32;
  2805.     For I := 1 to BufSize do
  2806.       begin
  2807.         Result := CalcCRC32Byte (Result, P^);
  2808.         Inc (P);
  2809.       end;
  2810.   End;
  2811.  
  2812. Function CRC32BufNoCase (const CRC32 : LongWord; const Buf; const BufSize : Integer) : LongWord;
  2813. var P : PByte;
  2814.     I : Integer;
  2815.     C : Byte;
  2816.   Begin
  2817.     if not CRC32TableInit then
  2818.       InitCRC32Table;
  2819.     P := @Buf;
  2820.     Result := CRC32;
  2821.     For I := 1 to BufSize do
  2822.       begin
  2823.         C := P^;
  2824.         if Char (C) in ['A'..'Z'] then
  2825.           C := C or 32;
  2826.         Result := CalcCRC32Byte (Result, C);
  2827.         Inc (P);
  2828.       end;
  2829.   End;
  2830.  
  2831. Procedure CRC32Init (var CRC32 : LongWord);
  2832.   Begin
  2833.     CRC32 := $FFFFFFFF;
  2834.   End;
  2835.  
  2836. Function CalcCRC32 (const Buf; const BufSize : Integer) : LongWord; overload;
  2837.   Begin
  2838.     CRC32Init (Result);
  2839.     Result := not CRC32Buf (Result, Buf, BufSize);
  2840.   End;
  2841.  
  2842. Function CalcCRC32 (const Buf : String) : LongWord; overload;
  2843.   Begin
  2844.     Result := CalcCRC32 (Pointer (Buf)^, Length (Buf));
  2845.   End;
  2846.  
  2847. Function HashBuf (const Buf; const BufSize : Integer; const Slots : LongWord) : LongWord;
  2848.   Begin
  2849.     if BufSize <= 0 then
  2850.       Result := 0 else
  2851.       Result := CalcCRC32 (Buf, BufSize);
  2852.     // Mod into slots
  2853.     if (Slots <> 0) and (Slots <> High (LongWord)) then
  2854.       Result := Result mod Slots;
  2855.   End;
  2856.  
  2857. Function HashStr (const StrBuf : Pointer; const StrLength : Integer; const Slots : LongWord; const CaseSensitive : Boolean) : LongWord;
  2858. var P    : PChar;
  2859.     I, J : Integer;
  2860.  
  2861.   Procedure CRC32StrBuf (const Size : Integer);
  2862.     Begin
  2863.       if CaseSensitive then
  2864.         Result := CRC32Buf (Result, P^, Size) else
  2865.         Result := CRC32BufNoCase (Result, P^, Size);
  2866.     End;
  2867.  
  2868.   Begin
  2869.     // Return 0 for an empty string
  2870.     Result := 0;
  2871.     if (StrLength <= 0) or not Assigned (StrBuf) then
  2872.       exit;
  2873.  
  2874.     if not CRC32TableInit then
  2875.       InitCRC32Table;
  2876.     Result := $FFFFFFFF;
  2877.     P := StrBuf;
  2878.  
  2879.     if StrLength <= 48 then // Hash everything for short strings
  2880.       CRC32StrBuf (StrLength) else
  2881.       begin
  2882.         // Hash first 16 bytes
  2883.         CRC32StrBuf (16);
  2884.  
  2885.         // Hash last 16 bytes
  2886.         Inc (P, StrLength - 16);
  2887.         CRC32StrBuf (16);
  2888.  
  2889.         // Hash 16 bytes sampled from rest of string
  2890.         I := (StrLength - 48) div 16;
  2891.         P := StrBuf;
  2892.         Inc (P, 16);
  2893.         For J := 1 to 16 do
  2894.           begin
  2895.             CRC32StrBuf (1);
  2896.             Inc (P, I + 1);
  2897.           end;
  2898.       end;
  2899.  
  2900.     // Mod into slots
  2901.     if (Slots <> 0) and (Slots <> High (LongWord)) then
  2902.       Result := Result mod Slots;
  2903.   End;
  2904.  
  2905. Function HashStr (const S : String; const Slots : LongWord; const CaseSensitive : Boolean) : LongWord;
  2906.   Begin
  2907.     Result := HashStr (Pointer (S), Length (S), Slots, CaseSensitive);
  2908.   End;
  2909.  
  2910. { HashInteger based on the CRC32 algorithm. It is a very good all purpose hash }
  2911. { with a highly uniform distribution of results.                               }
  2912. Function HashInteger (const I : Integer; const Slots : LongWord) : LongWord;
  2913. var P    : PByte;
  2914.     F    : Integer;
  2915.     Hash : LongWord;
  2916.   Begin
  2917.     if not CRC32TableInit then
  2918.       InitCRC32Table;
  2919.     Hash := $FFFFFFFF;
  2920.     P := @I;
  2921.     For F := 1 to Sizeof (Integer) do
  2922.       begin
  2923.         Hash := CalcCRC32Byte (Hash, P^);
  2924.         Inc (P);
  2925.       end;
  2926.     Hash := not Hash;
  2927.     if (Slots <> 0) and (Slots <> High (LongWord)) then
  2928.       Hash := Hash mod Slots;
  2929.     Result := Hash;
  2930.   End;
  2931.  
  2932.  
  2933.  
  2934. {                                                                              }
  2935. { Memory                                                                       }
  2936. {                                                                              }
  2937. {$IFDEF WINTEL}
  2938. Procedure MoveMem (const Source; var Dest; const Count : Integer);
  2939.   Asm
  2940.       CMP    ECX, 4
  2941.       JA     @GeneralMove
  2942.       JE     @Move4
  2943.       TEST   ECX, ECX
  2944.       JLE    @Fin
  2945.       DEC    ECX
  2946.       JZ     @Move1
  2947.       DEC    ECX
  2948.       JZ     @Move2
  2949.     @Move3:
  2950.       MOV    CX, [EAX]
  2951.       MOV    AL, [EAX + 2]
  2952.       MOV    [EDX], CX
  2953.       MOV    [EDX + 2], AL
  2954.       RET
  2955.     @Move4:
  2956.       MOV    EAX, [EAX]
  2957.       MOV    [EDX], EAX
  2958.       RET
  2959.     @Move1:
  2960.       MOV    AL, [EAX]
  2961.       MOV    [EDX], AL
  2962.       RET
  2963.     @Move2:
  2964.       MOV    AX, [EAX]
  2965.       MOV    [EDX], AX
  2966.       RET
  2967.     @GeneralMove:
  2968.       CALL   Move
  2969.     @Fin:
  2970.       RET
  2971.   End;
  2972. {$ELSE}
  2973. Procedure MoveMem (const Source; var Dest; const Count : Integer);
  2974.   Begin
  2975.     if Count <= 0 then
  2976.       exit;
  2977.     if Count > 4 then
  2978.       Move (Source, Dest, Count) else
  2979.       Case Count of // optimization for small moves
  2980.         1 : PByte (@Source)^ := PByte (@Dest)^;
  2981.         2 : PWord (@Source)^ := PWord (@Dest)^;
  2982.         4 : PLongWord (@Source)^ := PLongWord (@Dest)^;
  2983.       else
  2984.         Move (Source, Dest, Count);
  2985.       end;
  2986.   End;
  2987. {$ENDIF}
  2988.  
  2989. {$IFDEF WINTEL}
  2990. Function CompareMem (const Buf1; const Buf2; const Count : Integer) : Boolean; assembler;
  2991.   Asm
  2992.       PUSH    ESI
  2993.       PUSH    EDI
  2994.       MOV     ESI, Buf1
  2995.       MOV     EDI, Buf2
  2996.       MOV     EDX, ECX
  2997.       XOR     EAX, EAX
  2998.       AND     EDX, 3
  2999.       SHR     ECX, 1
  3000.       SHR     ECX, 1
  3001.       REPE    CMPSD
  3002.       JNE     @Fin
  3003.       MOV     ECX, EDX
  3004.       REPE    CMPSB
  3005.       JNE     @Fin
  3006.       INC     EAX
  3007.     @Fin:
  3008.       POP     EDI
  3009.       POP     ESI
  3010.   End;
  3011. {$ELSE}
  3012. Function CompareMem (const Buf1; const Buf2; const Count : Integer) : Boolean;
  3013. var P, Q : Pointer;
  3014.     D, I : Integer;
  3015.   Begin
  3016.     if Count <= 0 then
  3017.       begin
  3018.         Result := True;
  3019.         exit;
  3020.       end;
  3021.     P := @Buf1;
  3022.     Q := @Buf2;
  3023.     D := LongWord (Count) div 4;
  3024.     For I := 1 to D do
  3025.       if PLongWord (P)^ = PLongWord (Q)^ then
  3026.         begin
  3027.           Inc (PLongWord (P));
  3028.           Inc (PLongWord (Q));
  3029.         end else
  3030.         begin
  3031.           Result := False;
  3032.           exit;
  3033.         end;
  3034.     D := LongWord (Count) and 3;
  3035.     For I := 1 to D do
  3036.       if PByte (P)^ = PByte (Q)^ then
  3037.         begin
  3038.           Inc (PByte (P));
  3039.           Inc (PByte (Q));
  3040.         end else
  3041.         begin
  3042.           Result := False;
  3043.           exit;
  3044.         end;
  3045.     Result := True;
  3046.   End;
  3047. {$ENDIF}
  3048.  
  3049. Function CompareMemNoCase (const Buf1; const Buf2; const Count : Integer) : Boolean;
  3050. var P, Q : Pointer;
  3051.     I : Integer;
  3052.     C, D : Byte;
  3053.   Begin
  3054.     if Count <= 0 then
  3055.       begin
  3056.         Result := True;
  3057.         exit;
  3058.       end;
  3059.     P := @Buf1;
  3060.     Q := @Buf2;
  3061.     For I := 1 to Count do
  3062.       begin
  3063.         C := PByte (P)^;
  3064.         D := PByte (Q)^;
  3065.         if C in [Ord ('A')..Ord ('Z')] then
  3066.           C := C or 32;
  3067.         if D in [Ord ('A')..Ord ('Z')] then
  3068.           D := D or 32;
  3069.         if C = D then
  3070.           begin
  3071.             Inc (PByte (P));
  3072.             Inc (PByte (Q));
  3073.           end else
  3074.           begin
  3075.             Result := False;
  3076.             exit;
  3077.           end;
  3078.       end;
  3079.     Result := True;
  3080.   End;
  3081.  
  3082. Procedure ReverseMem (var Buf; const Size : Integer);
  3083. var I : Integer;
  3084.     P : PByte;
  3085.     Q : PByte;
  3086.     T : Byte;
  3087.   Begin
  3088.     P := @Buf;
  3089.     Q := P;
  3090.     Inc (Q, Size - 1);
  3091.     For I := 1 to Size div 2 do
  3092.       begin
  3093.         T := P^;
  3094.         P^ := Q^;
  3095.         Q^ := T;
  3096.         Inc (P);
  3097.         Dec (Q);
  3098.       end;
  3099.   End;
  3100.  
  3101.  
  3102.  
  3103. {                                                                              }
  3104. { Append                                                                       }
  3105. {                                                                              }
  3106. Function Append (var V : ByteArray; const R : Byte) : Integer;
  3107.   Begin
  3108.     Result := Length (V);
  3109.     SetLength (V, Result + 1);
  3110.     V [Result] := R;
  3111.   End;
  3112.  
  3113. Function Append (var V : WordArray; const R : Word) : Integer;
  3114.   Begin
  3115.     Result := Length (V);
  3116.     SetLength (V, Result + 1);
  3117.     V [Result] := R;
  3118.   End;
  3119.  
  3120. Function Append (var V : LongWordArray; const R : LongWord) : Integer;
  3121.   Begin
  3122.     Result := Length (V);
  3123.     SetLength (V, Result + 1);
  3124.     V [Result] := R;
  3125.   End;
  3126.  
  3127. Function Append (var V : ShortIntArray; const R : ShortInt) : Integer;
  3128.   Begin
  3129.     Result := Length (V);
  3130.     SetLength (V, Result + 1);
  3131.     V [Result] := R;
  3132.   End;
  3133.  
  3134. Function Append (var V : SmallIntArray; const R : SmallInt) : Integer;
  3135.   Begin
  3136.     Result := Length (V);
  3137.     SetLength (V, Result + 1);
  3138.     V [Result] := R;
  3139.   End;
  3140.  
  3141. Function Append (var V : LongIntArray; const R : LongInt) : Integer;
  3142.   Begin
  3143.     Result := Length (V);
  3144.     SetLength (V, Result + 1);
  3145.     V [Result] := R;
  3146.   End;
  3147.  
  3148. Function Append (var V : Int64Array; const R : Int64) : Integer;
  3149.   Begin
  3150.     Result := Length (V);
  3151.     SetLength (V, Result + 1);
  3152.     V [Result] := R;
  3153.   End;
  3154.  
  3155. Function Append (var V : SingleArray; const R : Single) : Integer;
  3156.   Begin
  3157.     Result := Length (V);
  3158.     SetLength (V, Result + 1);
  3159.     V [Result] := R;
  3160.   End;
  3161.  
  3162. Function Append (var V : DoubleArray; const R : Double) : Integer;
  3163.   Begin
  3164.     Result := Length (V);
  3165.     SetLength (V, Result + 1);
  3166.     V [Result] := R;
  3167.   End;
  3168.  
  3169. Function Append (var V : ExtendedArray; const R : Extended) : Integer;
  3170.   Begin
  3171.     Result := Length (V);
  3172.     SetLength (V, Result + 1);
  3173.     V [Result] := R;
  3174.   End;
  3175.  
  3176. Function Append (var V : StringArray; const R : String) : Integer;
  3177.   Begin
  3178.     Result := Length (V);
  3179.     SetLength (V, Result + 1);
  3180.     V [Result] := R;
  3181.   End;
  3182.  
  3183. Function Append (var V : BooleanArray; const R : Boolean) : Integer;
  3184.   Begin
  3185.     Result := Length (V);
  3186.     SetLength (V, Result + 1);
  3187.     V [Result] := R;
  3188.   End;
  3189.  
  3190. Function Append (var V : PointerArray; const R : Pointer) : Integer;
  3191.   Begin
  3192.     Result := Length (V);
  3193.     SetLength (V, Result + 1);
  3194.     V [Result] := R;
  3195.   End;
  3196.  
  3197. Function Append (var V : ObjectArray; const R : TObject) : Integer;
  3198.   Begin
  3199.     Result := Length (V);
  3200.     SetLength (V, Result + 1);
  3201.     V [Result] := R;
  3202.   End;
  3203.  
  3204. Function Append (var V : ByteSetArray; const R : ByteSet) : Integer;
  3205.   Begin
  3206.     Result := Length (V);
  3207.     SetLength (V, Result + 1);
  3208.     V [Result] := R;
  3209.   End;
  3210.  
  3211. Function Append (var V : CharSetArray; const R : CharSet) : Integer;
  3212.   Begin
  3213.     Result := Length (V);
  3214.     SetLength (V, Result + 1);
  3215.     V [Result] := R;
  3216.   End;
  3217.  
  3218.  
  3219. Function AppendByteArray (var V : ByteArray; const R : Array of Byte) : Integer;
  3220. var L : Integer;
  3221.   Begin
  3222.     Result := Length (V);
  3223.     L := Length (R);
  3224.     if L > 0 then
  3225.       begin
  3226.         SetLength (V, Result + L);
  3227.         Move (R [0], V [Result], Sizeof (R [0]) * L);
  3228.       end;
  3229.   End;
  3230.  
  3231. Function AppendWordArray (var V : WordArray; const R : Array of Word) : Integer;
  3232. var L : Integer;
  3233.   Begin
  3234.     Result := Length (V);
  3235.     L := Length (R);
  3236.     if L > 0 then
  3237.       begin
  3238.         SetLength (V, Result + L);
  3239.         Move (R [0], V [Result], Sizeof (R [0]) * L);
  3240.       end;
  3241.   End;
  3242.  
  3243. Function AppendCardinalArray (var V : CardinalArray; const R : Array of LongWord) : Integer;
  3244. var L : Integer;
  3245.   Begin
  3246.     Result := Length (V);
  3247.     L := Length (R);
  3248.     if L > 0 then
  3249.       begin
  3250.         SetLength (V, Result + L);
  3251.         Move (R [0], V [Result], Sizeof (R [0]) * L);
  3252.       end;
  3253.   End;
  3254.  
  3255. Function AppendShortIntArray (var V : ShortIntArray; const R : Array of ShortInt) : Integer;
  3256. var L : Integer;
  3257.   Begin
  3258.     Result := Length (V);
  3259.     L := Length (R);
  3260.     if L > 0 then
  3261.       begin
  3262.         SetLength (V, Result + L);
  3263.         Move (R [0], V [Result], Sizeof (R [0]) * L);
  3264.       end;
  3265.   End;
  3266.  
  3267. Function AppendSmallIntArray (var V : SmallIntArray; const R : Array of SmallInt) : Integer;
  3268. var L : Integer;
  3269.   Begin
  3270.     Result := Length (V);
  3271.     L := Length (R);
  3272.     if L > 0 then
  3273.       begin
  3274.         SetLength (V, Result + L);
  3275.         Move (R [0], V [Result], Sizeof (R [0]) * L);
  3276.       end;
  3277.   End;
  3278.  
  3279. Function AppendIntegerArray (var V : IntegerArray; const R : Array of LongInt) : Integer;
  3280. var L : Integer;
  3281.   Begin
  3282.     Result := Length (V);
  3283.     L := Length (R);
  3284.     if L > 0 then
  3285.       begin
  3286.         SetLength (V, Result + L);
  3287.         Move (R [0], V [Result], Sizeof (R [0]) * L);
  3288.       end;
  3289.   End;
  3290.  
  3291. Function AppendInt64Array (var V : Int64Array; const R : Array of Int64) : Integer;
  3292. var L : Integer;
  3293.   Begin
  3294.     Result := Length (V);
  3295.     L := Length (R);
  3296.     if L > 0 then
  3297.       begin
  3298.         SetLength (V, Result + L);
  3299.         Move (R [0], V [Result], Sizeof (R [0]) * L);
  3300.       end;
  3301.   End;
  3302.  
  3303. Function AppendSingleArray (var V : SingleArray; const R : Array of Single) : Integer;
  3304. var L : Integer;
  3305.   Begin
  3306.     Result := Length (V);
  3307.     L := Length (R);
  3308.     if L > 0 then
  3309.       begin
  3310.         SetLength (V, Result + L);
  3311.         Move (R [0], V [Result], Sizeof (R [0]) * L);
  3312.       end;
  3313.   End;
  3314.  
  3315. Function AppendDoubleArray (var V : DoubleArray; const R : Array of Double) : Integer;
  3316. var L : Integer;
  3317.   Begin
  3318.     Result := Length (V);
  3319.     L := Length (R);
  3320.     if L > 0 then
  3321.       begin
  3322.         SetLength (V, Result + L);
  3323.         Move (R [0], V [Result], Sizeof (R [0]) * L);
  3324.       end;
  3325.   End;
  3326.  
  3327. Function AppendExtendedArray (var V : ExtendedArray; const R : Array of Extended) : Integer;
  3328. var L : Integer;
  3329.   Begin
  3330.     Result := Length (V);
  3331.     L := Length (R);
  3332.     if L > 0 then
  3333.       begin
  3334.         SetLength (V, Result + L);
  3335.         Move (R [0], V [Result], Sizeof (R [0]) * L);
  3336.       end;
  3337.   End;
  3338.  
  3339. Function AppendPointerArray (var V : PointerArray; const R : Array of Pointer) : Integer;
  3340. var L : Integer;
  3341.   Begin
  3342.     Result := Length (V);
  3343.     L := Length (R);
  3344.     if L > 0 then
  3345.       begin
  3346.         SetLength (V, Result + L);
  3347.         Move (R [0], V [Result], Sizeof (R [0]) * L);
  3348.       end;
  3349.   End;
  3350.  
  3351. Function AppendCharSetArray (var V : CharSetArray; const R : Array of CharSet) : Integer;
  3352. var L : Integer;
  3353.   Begin
  3354.     Result := Length (V);
  3355.     L := Length (R);
  3356.     if L > 0 then
  3357.       begin
  3358.         SetLength (V, Result + L);
  3359.         Move (R [0], V [Result], Sizeof (R [0]) * L);
  3360.       end;
  3361.   End;
  3362.  
  3363. Function AppendByteSetArray (var V : ByteSetArray; const R : Array of ByteSet) : Integer;
  3364. var L : Integer;
  3365.   Begin
  3366.     Result := Length (V);
  3367.     L := Length (R);
  3368.     if L > 0 then
  3369.       begin
  3370.         SetLength (V, Result + L);
  3371.         Move (R [0], V [Result], Sizeof (R [0]) * L);
  3372.       end;
  3373.   End;
  3374.  
  3375.  
  3376. Function AppendObjectArray (var V : ObjectArray; const R : Array of TObject) : Integer;
  3377. var I, LR : Integer;
  3378.   Begin
  3379.     Result := Length (V);
  3380.     LR := Length (R);
  3381.     if LR > 0 then
  3382.       begin
  3383.         SetLength (V, Result + LR);
  3384.         For I := 0 to LR - 1 do
  3385.           V [Result + I] := R [I];
  3386.       end;
  3387.   End;
  3388.  
  3389. Function AppendStringArray (var V : StringArray; const R : Array of String) : Integer;
  3390. var I, LR : Integer;
  3391.   Begin
  3392.     Result := Length (V);
  3393.     LR := Length (R);
  3394.     if LR > 0 then
  3395.       begin
  3396.         SetLength (V, Result + LR);
  3397.         For I := 0 to LR - 1 do
  3398.           V [Result + I] := R [I];
  3399.       end;
  3400.   End;
  3401.  
  3402.  
  3403.   
  3404. {                                                                              }
  3405. { FreeAndNil                                                                   }
  3406. {                                                                              }
  3407. Procedure FreeAndNil (var Obj);
  3408. var Temp : TObject;
  3409.   Begin
  3410.     Temp := TObject (Obj);
  3411.     Pointer (Obj) := nil;
  3412.     Temp.Free;
  3413.   End;
  3414.  
  3415.  
  3416.  
  3417. {                                                                              }
  3418. { Remove                                                                       }
  3419. {                                                                              }
  3420. Function Remove (var V : ByteArray; const Idx : Integer; const Count : Integer) : Integer;
  3421. var I, J, L, M : Integer;
  3422.   Begin
  3423.     L := Length (V);
  3424.     if (Idx >= L) or (Idx + Count <= 0) or (L = 0) or (Count = 0) then
  3425.       begin
  3426.         Result := 0;
  3427.         exit;
  3428.       end;
  3429.     I := MaxI (Idx, 0);
  3430.     J := MinI (Count, L - I);
  3431.     M := L - J - I;
  3432.     if M > 0 then
  3433.       Move (V [I + J], V [I], M * SizeOf (Byte));
  3434.     SetLength (V, L - J);
  3435.     Result := J;
  3436.   End;
  3437.  
  3438. Function Remove (var V : WordArray; const Idx : Integer; const Count : Integer) : Integer;
  3439. var I, J, L, M : Integer;
  3440.   Begin
  3441.     L := Length (V);
  3442.     if (Idx >= L) or (Idx + Count <= 0) or (L = 0) or (Count = 0) then
  3443.       begin
  3444.         Result := 0;
  3445.         exit;
  3446.       end;
  3447.     I := MaxI (Idx, 0);
  3448.     J := MinI (Count, L - I);
  3449.     M := L - J - I;
  3450.     if M > 0 then
  3451.       Move (V [I + J], V [I], M * SizeOf (Word));
  3452.     SetLength (V, L - J);
  3453.     Result := J;
  3454.   End;
  3455.  
  3456. Function Remove (var V : LongWordArray; const Idx : Integer; const Count : Integer) : Integer;
  3457. var I, J, L, M : Integer;
  3458.   Begin
  3459.     L := Length (V);
  3460.     if (Idx >= L) or (Idx + Count <= 0) or (L = 0) or (Count = 0) then
  3461.       begin
  3462.         Result := 0;
  3463.         exit;
  3464.       end;
  3465.     I := MaxI (Idx, 0);
  3466.     J := MinI (Count, L - I);
  3467.     M := L - J - I;
  3468.     if M > 0 then
  3469.       Move (V [I + J], V [I], M * SizeOf (LongWord));
  3470.     SetLength (V, L - J);
  3471.     Result := J;
  3472.   End;
  3473.  
  3474. Function Remove (var V : ShortIntArray; const Idx : Integer; const Count : Integer) : Integer;
  3475. var I, J, L, M : Integer;
  3476.   Begin
  3477.     L := Length (V);
  3478.     if (Idx >= L) or (Idx + Count <= 0) or (L = 0) or (Count = 0) then
  3479.       begin
  3480.         Result := 0;
  3481.         exit;
  3482.       end;
  3483.     I := MaxI (Idx, 0);
  3484.     J := MinI (Count, L - I);
  3485.     M := L - J - I;
  3486.     if M > 0 then
  3487.       Move (V [I + J], V [I], M * SizeOf (ShortInt));
  3488.     SetLength (V, L - J);
  3489.     Result := J;
  3490.   End;
  3491.  
  3492. Function Remove (var V : SmallIntArray; const Idx : Integer; const Count : Integer) : Integer;
  3493. var I, J, L, M : Integer;
  3494.   Begin
  3495.     L := Length (V);
  3496.     if (Idx >= L) or (Idx + Count <= 0) or (L = 0) or (Count = 0) then
  3497.       begin
  3498.         Result := 0;
  3499.         exit;
  3500.       end;
  3501.     I := MaxI (Idx, 0);
  3502.     J := MinI (Count, L - I);
  3503.     M := L - J - I;
  3504.     if M > 0 then
  3505.       Move (V [I + J], V [I], M * SizeOf (SmallInt));
  3506.     SetLength (V, L - J);
  3507.     Result := J;
  3508.   End;
  3509.  
  3510. Function Remove (var V : LongIntArray; const Idx : Integer; const Count : Integer) : Integer;
  3511. var I, J, L, M : Integer;
  3512.   Begin
  3513.     L := Length (V);
  3514.     if (Idx >= L) or (Idx + Count <= 0) or (L = 0) or (Count = 0) then
  3515.       begin
  3516.         Result := 0;
  3517.         exit;
  3518.       end;
  3519.     I := MaxI (Idx, 0);
  3520.     J := MinI (Count, L - I);
  3521.     M := L - J - I;
  3522.     if M > 0 then
  3523.       Move (V [I + J], V [I], M * SizeOf (LongInt));
  3524.     SetLength (V, L - J);
  3525.     Result := J;
  3526.   End;
  3527.  
  3528. Function Remove (var V : Int64Array; const Idx : Integer; const Count : Integer) : Integer;
  3529. var I, J, L, M : Integer;
  3530.   Begin
  3531.     L := Length (V);
  3532.     if (Idx >= L) or (Idx + Count <= 0) or (L = 0) or (Count = 0) then
  3533.       begin
  3534.         Result := 0;
  3535.         exit;
  3536.       end;
  3537.     I := MaxI (Idx, 0);
  3538.     J := MinI (Count, L - I);
  3539.     M := L - J - I;
  3540.     if M > 0 then
  3541.       Move (V [I + J], V [I], M * SizeOf (Int64));
  3542.     SetLength (V, L - J);
  3543.     Result := J;
  3544.   End;
  3545.  
  3546. Function Remove (var V : SingleArray; const Idx : Integer; const Count : Integer) : Integer;
  3547. var I, J, L, M : Integer;
  3548.   Begin
  3549.     L := Length (V);
  3550.     if (Idx >= L) or (Idx + Count <= 0) or (L = 0) or (Count = 0) then
  3551.       begin
  3552.         Result := 0;
  3553.         exit;
  3554.       end;
  3555.     I := MaxI (Idx, 0);
  3556.     J := MinI (Count, L - I);
  3557.     M := L - J - I;
  3558.     if M > 0 then
  3559.       Move (V [I + J], V [I], M * SizeOf (Single));
  3560.     SetLength (V, L - J);
  3561.     Result := J;
  3562.   End;
  3563.  
  3564. Function Remove (var V : DoubleArray; const Idx : Integer; const Count : Integer) : Integer;
  3565. var I, J, L, M : Integer;
  3566.   Begin
  3567.     L := Length (V);
  3568.     if (Idx >= L) or (Idx + Count <= 0) or (L = 0) or (Count = 0) then
  3569.       begin
  3570.         Result := 0;
  3571.         exit;
  3572.       end;
  3573.     I := MaxI (Idx, 0);
  3574.     J := MinI (Count, L - I);
  3575.     M := L - J - I;
  3576.     if M > 0 then
  3577.       Move (V [I + J], V [I], M * SizeOf (Double));
  3578.     SetLength (V, L - J);
  3579.     Result := J;
  3580.   End;
  3581.  
  3582. Function Remove (var V : ExtendedArray; const Idx : Integer; const Count : Integer) : Integer;
  3583. var I, J, L, M : Integer;
  3584.   Begin
  3585.     L := Length (V);
  3586.     if (Idx >= L) or (Idx + Count <= 0) or (L = 0) or (Count = 0) then
  3587.       begin
  3588.         Result := 0;
  3589.         exit;
  3590.       end;
  3591.     I := MaxI (Idx, 0);
  3592.     J := MinI (Count, L - I);
  3593.     M := L - J - I;
  3594.     if M > 0 then
  3595.       Move (V [I + J], V [I], M * SizeOf (Extended));
  3596.     SetLength (V, L - J);
  3597.     Result := J;
  3598.   End;
  3599.  
  3600. Function Remove (var V : PointerArray; const Idx : Integer; const Count : Integer) : Integer;
  3601. var I, J, L, M : Integer;
  3602.   Begin
  3603.     L := Length (V);
  3604.     if (Idx >= L) or (Idx + Count <= 0) or (L = 0) or (Count = 0) then
  3605.       begin
  3606.         Result := 0;
  3607.         exit;
  3608.       end;
  3609.     I := MaxI (Idx, 0);
  3610.     J := MinI (Count, L - I);
  3611.     M := L - J - I;
  3612.     if M > 0 then
  3613.       Move (V [I + J], V [I], M * SizeOf (Pointer));
  3614.     SetLength (V, L - J);
  3615.     Result := J;
  3616.   End;
  3617.  
  3618.  
  3619. Function Remove (var V : ObjectArray; const Idx : Integer; const Count : Integer; const FreeObjects : Boolean) : Integer;
  3620. var I, J, K, L, M : Integer;
  3621.   Begin
  3622.     L := Length (V);
  3623.     if (Idx >= L) or (Idx + Count <= 0) or (L = 0) or (Count = 0) then
  3624.       begin
  3625.         Result := 0;
  3626.         exit;
  3627.       end;
  3628.     I := MaxI (Idx, 0);
  3629.     J := MinI (Count, L - I);
  3630.     if FreeObjects then
  3631.       For K := I to I + J - 1 do
  3632.         FreeAndNil (V [K]);
  3633.     M := L - J - I;
  3634.     if M > 0 then
  3635.       Move (V [I + J], V [I], M * SizeOf (Pointer));
  3636.     SetLength (V, L - J);
  3637.     Result := J;
  3638.   End;
  3639.  
  3640. Function Remove (var V : StringArray; const Idx : Integer; const Count : Integer) : Integer;
  3641. var I, J, K, L : Integer;
  3642.   Begin
  3643.     L := Length (V);
  3644.     if (Idx >= L) or (Idx + Count <= 0) or (L = 0) or (Count = 0) then
  3645.       begin
  3646.         Result := 0;
  3647.         exit;
  3648.       end;
  3649.     I := MaxI (Idx, 0);
  3650.     J := MinI (Count, L - I);
  3651.     For K := I to L - J - 1 do
  3652.       V [K] := V [K + J];
  3653.     SetLength (V, L - J);
  3654.     Result := J;
  3655.   End;
  3656.  
  3657. Procedure FreeObjectArray (var V);
  3658. var I : Integer;
  3659.     A : ObjectArray absolute V;
  3660.   Begin
  3661.     For I := Length (A) - 1 downto 0 do
  3662.       FreeAndNil (A [I]);
  3663.   End;
  3664.  
  3665. Procedure FreeObjectArray (var V; const LoIdx, HiIdx : Integer);
  3666. var I : Integer;
  3667.     A : ObjectArray absolute V;
  3668.   Begin
  3669.     For I := HiIdx downto LoIdx do
  3670.       FreeAndNil (A [I]);
  3671.   End;
  3672.  
  3673. // Note: The parameter can not be changed to be untyped and then typecasted
  3674. // using an absolute variable, as in FreeObjectArray. The reference counting
  3675. // will be done incorrectly.
  3676. Procedure FreeAndNilObjectArray (var V : ObjectArray);
  3677. var W : ObjectArray;
  3678.   Begin
  3679.     W := V;
  3680.     V := nil;
  3681.     FreeObjectArray (W);
  3682.   End;
  3683.  
  3684.  
  3685. {                                                                              }
  3686. { RemoveDuplicates                                                             }
  3687. {                                                                              }
  3688. Procedure RemoveDuplicates (var V : ByteArray; const IsSorted : Boolean);
  3689. var I, C, J, L : Integer;
  3690.     F          : Byte;
  3691.   Begin
  3692.     L := Length (V);
  3693.     if L = 0 then
  3694.       exit;
  3695.  
  3696.     if IsSorted then
  3697.       begin
  3698.         J := 0;
  3699.         Repeat
  3700.           F := V [J];
  3701.           I := J + 1;
  3702.           While (I < L) and (V [I] = F) do
  3703.             Inc (I);
  3704.           C := I - J;
  3705.           if C > 1 then
  3706.             begin
  3707.               Remove (V, J + 1, C - 1);
  3708.               Dec (L, C - 1);
  3709.               Inc (J);
  3710.             end else
  3711.             J := I;
  3712.         Until J >= L;
  3713.       end else
  3714.       begin
  3715.         J := 0;
  3716.         Repeat
  3717.           Repeat
  3718.             I := PosNext (V [J], V, J);
  3719.             if I >= 0 then
  3720.               Remove (V, I, 1);
  3721.           Until I < 0;
  3722.           Inc (J);
  3723.         Until J >= Length (V);
  3724.       end;
  3725.   End;
  3726.  
  3727. Procedure RemoveDuplicates (var V : WordArray; const IsSorted : Boolean);
  3728. var I, C, J, L : Integer;
  3729.     F          : Word;
  3730.   Begin
  3731.     L := Length (V);
  3732.     if L = 0 then
  3733.       exit;
  3734.  
  3735.     if IsSorted then
  3736.       begin
  3737.         J := 0;
  3738.         Repeat
  3739.           F := V [J];
  3740.           I := J + 1;
  3741.           While (I < L) and (V [I] = F) do
  3742.             Inc (I);
  3743.           C := I - J;
  3744.           if C > 1 then
  3745.             begin
  3746.               Remove (V, J + 1, C - 1);
  3747.               Dec (L, C - 1);
  3748.               Inc (J);
  3749.             end else
  3750.             J := I;
  3751.         Until J >= L;
  3752.       end else
  3753.       begin
  3754.         J := 0;
  3755.         Repeat
  3756.           Repeat
  3757.             I := PosNext (V [J], V, J);
  3758.             if I >= 0 then
  3759.               Remove (V, I, 1);
  3760.           Until I < 0;
  3761.           Inc (J);
  3762.         Until J >= Length (V);
  3763.       end;
  3764.   End;
  3765.  
  3766. Procedure RemoveDuplicates (var V : LongWordArray; const IsSorted : Boolean);
  3767. var I, C, J, L : Integer;
  3768.     F          : LongWord;
  3769.   Begin
  3770.     L := Length (V);
  3771.     if L = 0 then
  3772.       exit;
  3773.  
  3774.     if IsSorted then
  3775.       begin
  3776.         J := 0;
  3777.         Repeat
  3778.           F := V [J];
  3779.           I := J + 1;
  3780.           While (I < L) and (V [I] = F) do
  3781.             Inc (I);
  3782.           C := I - J;
  3783.           if C > 1 then
  3784.             begin
  3785.               Remove (V, J + 1, C - 1);
  3786.               Dec (L, C - 1);
  3787.               Inc (J);
  3788.             end else
  3789.             J := I;
  3790.         Until J >= L;
  3791.       end else
  3792.       begin
  3793.         J := 0;
  3794.         Repeat
  3795.           Repeat
  3796.             I := PosNext (V [J], V, J);
  3797.             if I >= 0 then
  3798.               Remove (V, I, 1);
  3799.           Until I < 0;
  3800.           Inc (J);
  3801.         Until J >= Length (V);
  3802.       end;
  3803.   End;
  3804.  
  3805. Procedure RemoveDuplicates (var V : ShortIntArray; const IsSorted : Boolean);
  3806. var I, C, J, L : Integer;
  3807.     F          : ShortInt;
  3808.   Begin
  3809.     L := Length (V);
  3810.     if L = 0 then
  3811.       exit;
  3812.  
  3813.     if IsSorted then
  3814.       begin
  3815.         J := 0;
  3816.         Repeat
  3817.           F := V [J];
  3818.           I := J + 1;
  3819.           While (I < L) and (V [I] = F) do
  3820.             Inc (I);
  3821.           C := I - J;
  3822.           if C > 1 then
  3823.             begin
  3824.               Remove (V, J + 1, C - 1);
  3825.               Dec (L, C - 1);
  3826.               Inc (J);
  3827.             end else
  3828.             J := I;
  3829.         Until J >= L;
  3830.       end else
  3831.       begin
  3832.         J := 0;
  3833.         Repeat
  3834.           Repeat
  3835.             I := PosNext (V [J], V, J);
  3836.             if I >= 0 then
  3837.               Remove (V, I, 1);
  3838.           Until I < 0;
  3839.           Inc (J);
  3840.         Until J >= Length (V);
  3841.       end;
  3842.   End;
  3843.  
  3844. Procedure RemoveDuplicates (var V : SmallIntArray; const IsSorted : Boolean);
  3845. var I, C, J, L : Integer;
  3846.     F          : SmallInt;
  3847.   Begin
  3848.     L := Length (V);
  3849.     if L = 0 then
  3850.       exit;
  3851.  
  3852.     if IsSorted then
  3853.       begin
  3854.         J := 0;
  3855.         Repeat
  3856.           F := V [J];
  3857.           I := J + 1;
  3858.           While (I < L) and (V [I] = F) do
  3859.             Inc (I);
  3860.           C := I - J;
  3861.           if C > 1 then
  3862.             begin
  3863.               Remove (V, J + 1, C - 1);
  3864.               Dec (L, C - 1);
  3865.               Inc (J);
  3866.             end else
  3867.             J := I;
  3868.         Until J >= L;
  3869.       end else
  3870.       begin
  3871.         J := 0;
  3872.         Repeat
  3873.           Repeat
  3874.             I := PosNext (V [J], V, J);
  3875.             if I >= 0 then
  3876.               Remove (V, I, 1);
  3877.           Until I < 0;
  3878.           Inc (J);
  3879.         Until J >= Length (V);
  3880.       end;
  3881.   End;
  3882.  
  3883. Procedure RemoveDuplicates (var V : LongIntArray; const IsSorted : Boolean);
  3884. var I, C, J, L : Integer;
  3885.     F          : LongInt;
  3886.   Begin
  3887.     L := Length (V);
  3888.     if L = 0 then
  3889.       exit;
  3890.  
  3891.     if IsSorted then
  3892.       begin
  3893.         J := 0;
  3894.         Repeat
  3895.           F := V [J];
  3896.           I := J + 1;
  3897.           While (I < L) and (V [I] = F) do
  3898.             Inc (I);
  3899.           C := I - J;
  3900.           if C > 1 then
  3901.             begin
  3902.               Remove (V, J + 1, C - 1);
  3903.               Dec (L, C - 1);
  3904.               Inc (J);
  3905.             end else
  3906.             J := I;
  3907.         Until J >= L;
  3908.       end else
  3909.       begin
  3910.         J := 0;
  3911.         Repeat
  3912.           Repeat
  3913.             I := PosNext (V [J], V, J);
  3914.             if I >= 0 then
  3915.               Remove (V, I, 1);
  3916.           Until I < 0;
  3917.           Inc (J);
  3918.         Until J >= Length (V);
  3919.       end;
  3920.   End;
  3921.  
  3922. Procedure RemoveDuplicates (var V : Int64Array; const IsSorted : Boolean);
  3923. var I, C, J, L : Integer;
  3924.     F          : Int64;
  3925.   Begin
  3926.     L := Length (V);
  3927.     if L = 0 then
  3928.       exit;
  3929.  
  3930.     if IsSorted then
  3931.       begin
  3932.         J := 0;
  3933.         Repeat
  3934.           F := V [J];
  3935.           I := J + 1;
  3936.           While (I < L) and (V [I] = F) do
  3937.             Inc (I);
  3938.           C := I - J;
  3939.           if C > 1 then
  3940.             begin
  3941.               Remove (V, J + 1, C - 1);
  3942.               Dec (L, C - 1);
  3943.               Inc (J);
  3944.             end else
  3945.             J := I;
  3946.         Until J >= L;
  3947.       end else
  3948.       begin
  3949.         J := 0;
  3950.         Repeat
  3951.           Repeat
  3952.             I := PosNext (V [J], V, J);
  3953.             if I >= 0 then
  3954.               Remove (V, I, 1);
  3955.           Until I < 0;
  3956.           Inc (J);
  3957.         Until J >= Length (V);
  3958.       end;
  3959.   End;
  3960.  
  3961. Procedure RemoveDuplicates (var V : SingleArray; const IsSorted : Boolean);
  3962. var I, C, J, L : Integer;
  3963.     F          : Single;
  3964.   Begin
  3965.     L := Length (V);
  3966.     if L = 0 then
  3967.       exit;
  3968.  
  3969.     if IsSorted then
  3970.       begin
  3971.         J := 0;
  3972.         Repeat
  3973.           F := V [J];
  3974.           I := J + 1;
  3975.           While (I < L) and (V [I] = F) do
  3976.             Inc (I);
  3977.           C := I - J;
  3978.           if C > 1 then
  3979.             begin
  3980.               Remove (V, J + 1, C - 1);
  3981.               Dec (L, C - 1);
  3982.               Inc (J);
  3983.             end else
  3984.             J := I;
  3985.         Until J >= L;
  3986.       end else
  3987.       begin
  3988.         J := 0;
  3989.         Repeat
  3990.           Repeat
  3991.             I := PosNext (V [J], V, J);
  3992.             if I >= 0 then
  3993.               Remove (V, I, 1);
  3994.           Until I < 0;
  3995.           Inc (J);
  3996.         Until J >= Length (V);
  3997.       end;
  3998.   End;
  3999.  
  4000. Procedure RemoveDuplicates (var V : DoubleArray; const IsSorted : Boolean);
  4001. var I, C, J, L : Integer;
  4002.     F          : Double;
  4003.   Begin
  4004.     L := Length (V);
  4005.     if L = 0 then
  4006.       exit;
  4007.  
  4008.     if IsSorted then
  4009.       begin
  4010.         J := 0;
  4011.         Repeat
  4012.           F := V [J];
  4013.           I := J + 1;
  4014.           While (I < L) and (V [I] = F) do
  4015.             Inc (I);
  4016.           C := I - J;
  4017.           if C > 1 then
  4018.             begin
  4019.               Remove (V, J + 1, C - 1);
  4020.               Dec (L, C - 1);
  4021.               Inc (J);
  4022.             end else
  4023.             J := I;
  4024.         Until J >= L;
  4025.       end else
  4026.       begin
  4027.         J := 0;
  4028.         Repeat
  4029.           Repeat
  4030.             I := PosNext (V [J], V, J);
  4031.             if I >= 0 then
  4032.               Remove (V, I, 1);
  4033.           Until I < 0;
  4034.           Inc (J);
  4035.         Until J >= Length (V);
  4036.       end;
  4037.   End;
  4038.  
  4039. Procedure RemoveDuplicates (var V : ExtendedArray; const IsSorted : Boolean);
  4040. var I, C, J, L : Integer;
  4041.     F          : Extended;
  4042.   Begin
  4043.     L := Length (V);
  4044.     if L = 0 then
  4045.       exit;
  4046.  
  4047.     if IsSorted then
  4048.       begin
  4049.         J := 0;
  4050.         Repeat
  4051.           F := V [J];
  4052.           I := J + 1;
  4053.           While (I < L) and (V [I] = F) do
  4054.             Inc (I);
  4055.           C := I - J;
  4056.           if C > 1 then
  4057.             begin
  4058.               Remove (V, J + 1, C - 1);
  4059.               Dec (L, C - 1);
  4060.               Inc (J);
  4061.             end else
  4062.             J := I;
  4063.         Until J >= L;
  4064.       end else
  4065.       begin
  4066.         J := 0;
  4067.         Repeat
  4068.           Repeat
  4069.             I := PosNext (V [J], V, J);
  4070.             if I >= 0 then
  4071.               Remove (V, I, 1);
  4072.           Until I < 0;
  4073.           Inc (J);
  4074.         Until J >= Length (V);
  4075.       end;
  4076.   End;
  4077.  
  4078. Procedure RemoveDuplicates (var V : StringArray; const IsSorted : Boolean);
  4079. var I, C, J, L : Integer;
  4080.     F          : String;
  4081.   Begin
  4082.     L := Length (V);
  4083.     if L = 0 then
  4084.       exit;
  4085.  
  4086.     if IsSorted then
  4087.       begin
  4088.         J := 0;
  4089.         Repeat
  4090.           F := V [J];
  4091.           I := J + 1;
  4092.           While (I < L) and (V [I] = F) do
  4093.             Inc (I);
  4094.           C := I - J;
  4095.           if C > 1 then
  4096.             begin
  4097.               Remove (V, J + 1, C - 1);
  4098.               Dec (L, C - 1);
  4099.               Inc (J);
  4100.             end else
  4101.             J := I;
  4102.         Until J >= L;
  4103.       end else
  4104.       begin
  4105.         J := 0;
  4106.         Repeat
  4107.           Repeat
  4108.             I := PosNext (V [J], V, J);
  4109.             if I >= 0 then
  4110.               Remove (V, I, 1);
  4111.           Until I < 0;
  4112.           Inc (J);
  4113.         Until J >= Length (V);
  4114.       end;
  4115.   End;
  4116.  
  4117. Procedure RemoveDuplicates (var V : PointerArray; const IsSorted : Boolean);
  4118. var I, C, J, L : Integer;
  4119.     F          : Pointer;
  4120.   Begin
  4121.     L := Length (V);
  4122.     if L = 0 then
  4123.       exit;
  4124.  
  4125.     if IsSorted then
  4126.       begin
  4127.         J := 0;
  4128.         Repeat
  4129.           F := V [J];
  4130.           I := J + 1;
  4131.           While (I < L) and (V [I] = F) do
  4132.             Inc (I);
  4133.           C := I - J;
  4134.           if C > 1 then
  4135.             begin
  4136.               Remove (V, J + 1, C - 1);
  4137.               Dec (L, C - 1);
  4138.               Inc (J);
  4139.             end else
  4140.             J := I;
  4141.         Until J >= L;
  4142.       end else
  4143.       begin
  4144.         J := 0;
  4145.         Repeat
  4146.           Repeat
  4147.             I := PosNext (V [J], V, J);
  4148.             if I >= 0 then
  4149.               Remove (V, I, 1);
  4150.           Until I < 0;
  4151.           Inc (J);
  4152.         Until J >= Length (V);
  4153.       end;
  4154.   End;
  4155.  
  4156.  
  4157.  
  4158. Procedure TrimArrayLeft (var S : ByteArray; const TrimList : Array of Byte); overload;
  4159. var I, J : Integer;
  4160.     R    : Boolean;
  4161.   Begin
  4162.     I := 0;
  4163.     R := True;
  4164.     While R and (I < Length (S)) do
  4165.       begin
  4166.         R := False;
  4167.         For J := 0 to High (TrimList) do
  4168.           if S [I] = TrimList [J] then
  4169.             begin
  4170.               R := True;
  4171.               Inc (I);
  4172.               break;
  4173.             end;
  4174.       end;
  4175.     if I > 0 then
  4176.       Remove (S, 0, I - 1);
  4177.   End;
  4178.  
  4179.  
  4180. Procedure TrimArrayLeft (var S : WordArray; const TrimList : Array of Word); overload;
  4181. var I, J : Integer;
  4182.     R    : Boolean;
  4183.   Begin
  4184.     I := 0;
  4185.     R := True;
  4186.     While R and (I < Length (S)) do
  4187.       begin
  4188.         R := False;
  4189.         For J := 0 to High (TrimList) do
  4190.           if S [I] = TrimList [J] then
  4191.             begin
  4192.               R := True;
  4193.               Inc (I);
  4194.               break;
  4195.             end;
  4196.       end;
  4197.     if I > 0 then
  4198.       Remove (S, 0, I - 1);
  4199.   End;
  4200.  
  4201.  
  4202. Procedure TrimArrayLeft (var S : LongWordArray; const TrimList : Array of LongWord); overload;
  4203. var I, J : Integer;
  4204.     R    : Boolean;
  4205.   Begin
  4206.     I := 0;
  4207.     R := True;
  4208.     While R and (I < Length (S)) do
  4209.       begin
  4210.         R := False;
  4211.         For J := 0 to High (TrimList) do
  4212.           if S [I] = TrimList [J] then
  4213.             begin
  4214.               R := True;
  4215.               Inc (I);
  4216.               break;
  4217.             end;
  4218.       end;
  4219.     if I > 0 then
  4220.       Remove (S, 0, I - 1);
  4221.   End;
  4222.  
  4223.  
  4224. Procedure TrimArrayLeft (var S : ShortIntArray; const TrimList : Array of ShortInt); overload;
  4225. var I, J : Integer;
  4226.     R    : Boolean;
  4227.   Begin
  4228.     I := 0;
  4229.     R := True;
  4230.     While R and (I < Length (S)) do
  4231.       begin
  4232.         R := False;
  4233.         For J := 0 to High (TrimList) do
  4234.           if S [I] = TrimList [J] then
  4235.             begin
  4236.               R := True;
  4237.               Inc (I);
  4238.               break;
  4239.             end;
  4240.       end;
  4241.     if I > 0 then
  4242.       Remove (S, 0, I - 1);
  4243.   End;
  4244.  
  4245.  
  4246. Procedure TrimArrayLeft (var S : SmallIntArray; const TrimList : Array of SmallInt); overload;
  4247. var I, J : Integer;
  4248.     R    : Boolean;
  4249.   Begin
  4250.     I := 0;
  4251.     R := True;
  4252.     While R and (I < Length (S)) do
  4253.       begin
  4254.         R := False;
  4255.         For J := 0 to High (TrimList) do
  4256.           if S [I] = TrimList [J] then
  4257.             begin
  4258.               R := True;
  4259.               Inc (I);
  4260.               break;
  4261.             end;
  4262.       end;
  4263.     if I > 0 then
  4264.       Remove (S, 0, I - 1);
  4265.   End;
  4266.  
  4267.  
  4268. Procedure TrimArrayLeft (var S : LongIntArray; const TrimList : Array of LongInt); overload;
  4269. var I, J : Integer;
  4270.     R    : Boolean;
  4271.   Begin
  4272.     I := 0;
  4273.     R := True;
  4274.     While R and (I < Length (S)) do
  4275.       begin
  4276.         R := False;
  4277.         For J := 0 to High (TrimList) do
  4278.           if S [I] = TrimList [J] then
  4279.             begin
  4280.               R := True;
  4281.               Inc (I);
  4282.               break;
  4283.             end;
  4284.       end;
  4285.     if I > 0 then
  4286.       Remove (S, 0, I - 1);
  4287.   End;
  4288.  
  4289.  
  4290. Procedure TrimArrayLeft (var S : Int64Array; const TrimList : Array of Int64); overload;
  4291. var I, J : Integer;
  4292.     R    : Boolean;
  4293.   Begin
  4294.     I := 0;
  4295.     R := True;
  4296.     While R and (I < Length (S)) do
  4297.       begin
  4298.         R := False;
  4299.         For J := 0 to High (TrimList) do
  4300.           if S [I] = TrimList [J] then
  4301.             begin
  4302.               R := True;
  4303.               Inc (I);
  4304.               break;
  4305.             end;
  4306.       end;
  4307.     if I > 0 then
  4308.       Remove (S, 0, I - 1);
  4309.   End;
  4310.  
  4311.  
  4312. Procedure TrimArrayLeft (var S : SingleArray; const TrimList : Array of Single); overload;
  4313. var I, J : Integer;
  4314.     R    : Boolean;
  4315.   Begin
  4316.     I := 0;
  4317.     R := True;
  4318.     While R and (I < Length (S)) do
  4319.       begin
  4320.         R := False;
  4321.         For J := 0 to High (TrimList) do
  4322.           if S [I] = TrimList [J] then
  4323.             begin
  4324.               R := True;
  4325.               Inc (I);
  4326.               break;
  4327.             end;
  4328.       end;
  4329.     if I > 0 then
  4330.       Remove (S, 0, I - 1);
  4331.   End;
  4332.  
  4333.  
  4334. Procedure TrimArrayLeft (var S : DoubleArray; const TrimList : Array of Double); overload;
  4335. var I, J : Integer;
  4336.     R    : Boolean;
  4337.   Begin
  4338.     I := 0;
  4339.     R := True;
  4340.     While R and (I < Length (S)) do
  4341.       begin
  4342.         R := False;
  4343.         For J := 0 to High (TrimList) do
  4344.           if S [I] = TrimList [J] then
  4345.             begin
  4346.               R := True;
  4347.               Inc (I);
  4348.               break;
  4349.             end;
  4350.       end;
  4351.     if I > 0 then
  4352.       Remove (S, 0, I - 1);
  4353.   End;
  4354.  
  4355.  
  4356. Procedure TrimArrayLeft (var S : ExtendedArray; const TrimList : Array of Extended); overload;
  4357. var I, J : Integer;
  4358.     R    : Boolean;
  4359.   Begin
  4360.     I := 0;
  4361.     R := True;
  4362.     While R and (I < Length (S)) do
  4363.       begin
  4364.         R := False;
  4365.         For J := 0 to High (TrimList) do
  4366.           if S [I] = TrimList [J] then
  4367.             begin
  4368.               R := True;
  4369.               Inc (I);
  4370.               break;
  4371.             end;
  4372.       end;
  4373.     if I > 0 then
  4374.       Remove (S, 0, I - 1);
  4375.   End;
  4376.  
  4377.  
  4378. Procedure TrimArrayLeft (var S : StringArray; const TrimList : Array of String); overload;
  4379. var I, J : Integer;
  4380.     R    : Boolean;
  4381.   Begin
  4382.     I := 0;
  4383.     R := True;
  4384.     While R and (I < Length (S)) do
  4385.       begin
  4386.         R := False;
  4387.         For J := 0 to High (TrimList) do
  4388.           if S [I] = TrimList [J] then
  4389.             begin
  4390.               R := True;
  4391.               Inc (I);
  4392.               break;
  4393.             end;
  4394.       end;
  4395.     if I > 0 then
  4396.       Remove (S, 0, I - 1);
  4397.   End;
  4398.  
  4399.  
  4400. Procedure TrimArrayLeft (var S : PointerArray; const TrimList : Array of Pointer); overload;
  4401. var I, J : Integer;
  4402.     R    : Boolean;
  4403.   Begin
  4404.     I := 0;
  4405.     R := True;
  4406.     While R and (I < Length (S)) do
  4407.       begin
  4408.         R := False;
  4409.         For J := 0 to High (TrimList) do
  4410.           if S [I] = TrimList [J] then
  4411.             begin
  4412.               R := True;
  4413.               Inc (I);
  4414.               break;
  4415.             end;
  4416.       end;
  4417.     if I > 0 then
  4418.       Remove (S, 0, I - 1);
  4419.   End;
  4420.  
  4421.  
  4422.  
  4423. Procedure TrimArrayRight (var S : ByteArray; const TrimList : Array of Byte); overload;
  4424. var I, J : Integer;
  4425.     R    : Boolean;
  4426.   Begin
  4427.     I := Length (S) - 1;
  4428.     R := True;
  4429.     While R and (I >= 0) do
  4430.       begin
  4431.         R := False;
  4432.         For J := 0 to High (TrimList) do
  4433.           if S [I] = TrimList [J] then
  4434.             begin
  4435.               R := True;
  4436.               Dec (I);
  4437.               break;
  4438.             end;
  4439.       end;
  4440.     if I < Length (S) - 1 then
  4441.       SetLength (S, I + 1);
  4442.   End;
  4443.  
  4444.  
  4445. Procedure TrimArrayRight (var S : WordArray; const TrimList : Array of Word); overload;
  4446. var I, J : Integer;
  4447.     R    : Boolean;
  4448.   Begin
  4449.     I := Length (S) - 1;
  4450.     R := True;
  4451.     While R and (I >= 0) do
  4452.       begin
  4453.         R := False;
  4454.         For J := 0 to High (TrimList) do
  4455.           if S [I] = TrimList [J] then
  4456.             begin
  4457.               R := True;
  4458.               Dec (I);
  4459.               break;
  4460.             end;
  4461.       end;
  4462.     if I < Length (S) - 1 then
  4463.       SetLength (S, I + 1);
  4464.   End;
  4465.  
  4466.  
  4467. Procedure TrimArrayRight (var S : LongWordArray; const TrimList : Array of LongWord); overload;
  4468. var I, J : Integer;
  4469.     R    : Boolean;
  4470.   Begin
  4471.     I := Length (S) - 1;
  4472.     R := True;
  4473.     While R and (I >= 0) do
  4474.       begin
  4475.         R := False;
  4476.         For J := 0 to High (TrimList) do
  4477.           if S [I] = TrimList [J] then
  4478.             begin
  4479.               R := True;
  4480.               Dec (I);
  4481.               break;
  4482.             end;
  4483.       end;
  4484.     if I < Length (S) - 1 then
  4485.       SetLength (S, I + 1);
  4486.   End;
  4487.  
  4488.  
  4489. Procedure TrimArrayRight (var S : ShortIntArray; const TrimList : Array of ShortInt); overload;
  4490. var I, J : Integer;
  4491.     R    : Boolean;
  4492.   Begin
  4493.     I := Length (S) - 1;
  4494.     R := True;
  4495.     While R and (I >= 0) do
  4496.       begin
  4497.         R := False;
  4498.         For J := 0 to High (TrimList) do
  4499.           if S [I] = TrimList [J] then
  4500.             begin
  4501.               R := True;
  4502.               Dec (I);
  4503.               break;
  4504.             end;
  4505.       end;
  4506.     if I < Length (S) - 1 then
  4507.       SetLength (S, I + 1);
  4508.   End;
  4509.  
  4510.  
  4511. Procedure TrimArrayRight (var S : SmallIntArray; const TrimList : Array of SmallInt); overload;
  4512. var I, J : Integer;
  4513.     R    : Boolean;
  4514.   Begin
  4515.     I := Length (S) - 1;
  4516.     R := True;
  4517.     While R and (I >= 0) do
  4518.       begin
  4519.         R := False;
  4520.         For J := 0 to High (TrimList) do
  4521.           if S [I] = TrimList [J] then
  4522.             begin
  4523.               R := True;
  4524.               Dec (I);
  4525.               break;
  4526.             end;
  4527.       end;
  4528.     if I < Length (S) - 1 then
  4529.       SetLength (S, I + 1);
  4530.   End;
  4531.  
  4532.  
  4533. Procedure TrimArrayRight (var S : LongIntArray; const TrimList : Array of LongInt); overload;
  4534. var I, J : Integer;
  4535.     R    : Boolean;
  4536.   Begin
  4537.     I := Length (S) - 1;
  4538.     R := True;
  4539.     While R and (I >= 0) do
  4540.       begin
  4541.         R := False;
  4542.         For J := 0 to High (TrimList) do
  4543.           if S [I] = TrimList [J] then
  4544.             begin
  4545.               R := True;
  4546.               Dec (I);
  4547.               break;
  4548.             end;
  4549.       end;
  4550.     if I < Length (S) - 1 then
  4551.       SetLength (S, I + 1);
  4552.   End;
  4553.  
  4554.  
  4555. Procedure TrimArrayRight (var S : Int64Array; const TrimList : Array of Int64); overload;
  4556. var I, J : Integer;
  4557.     R    : Boolean;
  4558.   Begin
  4559.     I := Length (S) - 1;
  4560.     R := True;
  4561.     While R and (I >= 0) do
  4562.       begin
  4563.         R := False;
  4564.         For J := 0 to High (TrimList) do
  4565.           if S [I] = TrimList [J] then
  4566.             begin
  4567.               R := True;
  4568.               Dec (I);
  4569.               break;
  4570.             end;
  4571.       end;
  4572.     if I < Length (S) - 1 then
  4573.       SetLength (S, I + 1);
  4574.   End;
  4575.  
  4576.  
  4577. Procedure TrimArrayRight (var S : SingleArray; const TrimList : Array of Single); overload;
  4578. var I, J : Integer;
  4579.     R    : Boolean;
  4580.   Begin
  4581.     I := Length (S) - 1;
  4582.     R := True;
  4583.     While R and (I >= 0) do
  4584.       begin
  4585.         R := False;
  4586.         For J := 0 to High (TrimList) do
  4587.           if S [I] = TrimList [J] then
  4588.             begin
  4589.               R := True;
  4590.               Dec (I);
  4591.               break;
  4592.             end;
  4593.       end;
  4594.     if I < Length (S) - 1 then
  4595.       SetLength (S, I + 1);
  4596.   End;
  4597.  
  4598.  
  4599. Procedure TrimArrayRight (var S : DoubleArray; const TrimList : Array of Double); overload;
  4600. var I, J : Integer;
  4601.     R    : Boolean;
  4602.   Begin
  4603.     I := Length (S) - 1;
  4604.     R := True;
  4605.     While R and (I >= 0) do
  4606.       begin
  4607.         R := False;
  4608.         For J := 0 to High (TrimList) do
  4609.           if S [I] = TrimList [J] then
  4610.             begin
  4611.               R := True;
  4612.               Dec (I);
  4613.               break;
  4614.             end;
  4615.       end;
  4616.     if I < Length (S) - 1 then
  4617.       SetLength (S, I + 1);
  4618.   End;
  4619.  
  4620.  
  4621. Procedure TrimArrayRight (var S : ExtendedArray; const TrimList : Array of Extended); overload;
  4622. var I, J : Integer;
  4623.     R    : Boolean;
  4624.   Begin
  4625.     I := Length (S) - 1;
  4626.     R := True;
  4627.     While R and (I >= 0) do
  4628.       begin
  4629.         R := False;
  4630.         For J := 0 to High (TrimList) do
  4631.           if S [I] = TrimList [J] then
  4632.             begin
  4633.               R := True;
  4634.               Dec (I);
  4635.               break;
  4636.             end;
  4637.       end;
  4638.     if I < Length (S) - 1 then
  4639.       SetLength (S, I + 1);
  4640.   End;
  4641.  
  4642.  
  4643. Procedure TrimArrayRight (var S : StringArray; const TrimList : Array of String); overload;
  4644. var I, J : Integer;
  4645.     R    : Boolean;
  4646.   Begin
  4647.     I := Length (S) - 1;
  4648.     R := True;
  4649.     While R and (I >= 0) do
  4650.       begin
  4651.         R := False;
  4652.         For J := 0 to High (TrimList) do
  4653.           if S [I] = TrimList [J] then
  4654.             begin
  4655.               R := True;
  4656.               Dec (I);
  4657.               break;
  4658.             end;
  4659.       end;
  4660.     if I < Length (S) - 1 then
  4661.       SetLength (S, I + 1);
  4662.   End;
  4663.  
  4664.  
  4665. Procedure TrimArrayRight (var S : PointerArray; const TrimList : Array of Pointer); overload;
  4666. var I, J : Integer;
  4667.     R    : Boolean;
  4668.   Begin
  4669.     I := Length (S) - 1;
  4670.     R := True;
  4671.     While R and (I >= 0) do
  4672.       begin
  4673.         R := False;
  4674.         For J := 0 to High (TrimList) do
  4675.           if S [I] = TrimList [J] then
  4676.             begin
  4677.               R := True;
  4678.               Dec (I);
  4679.               break;
  4680.             end;
  4681.       end;
  4682.     if I < Length (S) - 1 then
  4683.       SetLength (S, I + 1);
  4684.   End;
  4685.  
  4686.  
  4687.  
  4688. {                                                                              }
  4689. { ArrayInsert                                                                  }
  4690. {                                                                              }
  4691. Function ArrayInsert (var V : ByteArray; const Idx : Integer; const Count : Integer) : Integer;
  4692. var I, L, C : Integer;
  4693.   Begin
  4694.     L := Length (V);
  4695.     if (Idx > L) or (Idx + Count <= 0) or (Count = 0) then
  4696.       begin
  4697.         Result := -1;
  4698.         exit;
  4699.       end;
  4700.     I := MaxI (Idx, 0);
  4701.     SetLength (V, L + Count);
  4702.     C := Count * Sizeof (Byte);
  4703.     if I < L then
  4704.       Move (V [I], V [I + Count], (L - I) * Sizeof (Byte));
  4705.     FillChar (V [I], C, #0);
  4706.     Result := I;
  4707.   End;
  4708.  
  4709. Function ArrayInsert (var V : WordArray; const Idx : Integer; const Count : Integer) : Integer;
  4710. var I, L, C : Integer;
  4711.   Begin
  4712.     L := Length (V);
  4713.     if (Idx > L) or (Idx + Count <= 0) or (Count = 0) then
  4714.       begin
  4715.         Result := -1;
  4716.         exit;
  4717.       end;
  4718.     I := MaxI (Idx, 0);
  4719.     SetLength (V, L + Count);
  4720.     C := Count * Sizeof (Word);
  4721.     if I < L then
  4722.       Move (V [I], V [I + Count], (L - I) * Sizeof (Word));
  4723.     FillChar (V [I], C, #0);
  4724.     Result := I;
  4725.   End;
  4726.  
  4727. Function ArrayInsert (var V : LongWordArray; const Idx : Integer; const Count : Integer) : Integer;
  4728. var I, L, C : Integer;
  4729.   Begin
  4730.     L := Length (V);
  4731.     if (Idx > L) or (Idx + Count <= 0) or (Count = 0) then
  4732.       begin
  4733.         Result := -1;
  4734.         exit;
  4735.       end;
  4736.     I := MaxI (Idx, 0);
  4737.     SetLength (V, L + Count);
  4738.     C := Count * Sizeof (LongWord);
  4739.     if I < L then
  4740.       Move (V [I], V [I + Count], (L - I) * Sizeof (LongWord));
  4741.     FillChar (V [I], C, #0);
  4742.     Result := I;
  4743.   End;
  4744.  
  4745. Function ArrayInsert (var V : ShortIntArray; const Idx : Integer; const Count : Integer) : Integer;
  4746. var I, L, C : Integer;
  4747.   Begin
  4748.     L := Length (V);
  4749.     if (Idx > L) or (Idx + Count <= 0) or (Count = 0) then
  4750.       begin
  4751.         Result := -1;
  4752.         exit;
  4753.       end;
  4754.     I := MaxI (Idx, 0);
  4755.     SetLength (V, L + Count);
  4756.     C := Count * Sizeof (ShortInt);
  4757.     if I < L then
  4758.       Move (V [I], V [I + Count], (L - I) * Sizeof (ShortInt));
  4759.     FillChar (V [I], C, #0);
  4760.     Result := I;
  4761.   End;
  4762.  
  4763. Function ArrayInsert (var V : SmallIntArray; const Idx : Integer; const Count : Integer) : Integer;
  4764. var I, L, C : Integer;
  4765.   Begin
  4766.     L := Length (V);
  4767.     if (Idx > L) or (Idx + Count <= 0) or (Count = 0) then
  4768.       begin
  4769.         Result := -1;
  4770.         exit;
  4771.       end;
  4772.     I := MaxI (Idx, 0);
  4773.     SetLength (V, L + Count);
  4774.     C := Count * Sizeof (SmallInt);
  4775.     if I < L then
  4776.       Move (V [I], V [I + Count], (L - I) * Sizeof (SmallInt));
  4777.     FillChar (V [I], C, #0);
  4778.     Result := I;
  4779.   End;
  4780.  
  4781. Function ArrayInsert (var V : LongIntArray; const Idx : Integer; const Count : Integer) : Integer;
  4782. var I, L, C : Integer;
  4783.   Begin
  4784.     L := Length (V);
  4785.     if (Idx > L) or (Idx + Count <= 0) or (Count = 0) then
  4786.       begin
  4787.         Result := -1;
  4788.         exit;
  4789.       end;
  4790.     I := MaxI (Idx, 0);
  4791.     SetLength (V, L + Count);
  4792.     C := Count * Sizeof (LongInt);
  4793.     if I < L then
  4794.       Move (V [I], V [I + Count], (L - I) * Sizeof (LongInt));
  4795.     FillChar (V [I], C, #0);
  4796.     Result := I;
  4797.   End;
  4798.  
  4799. Function ArrayInsert (var V : Int64Array; const Idx : Integer; const Count : Integer) : Integer;
  4800. var I, L, C : Integer;
  4801.   Begin
  4802.     L := Length (V);
  4803.     if (Idx > L) or (Idx + Count <= 0) or (Count = 0) then
  4804.       begin
  4805.         Result := -1;
  4806.         exit;
  4807.       end;
  4808.     I := MaxI (Idx, 0);
  4809.     SetLength (V, L + Count);
  4810.     C := Count * Sizeof (Int64);
  4811.     if I < L then
  4812.       Move (V [I], V [I + Count], (L - I) * Sizeof (Int64));
  4813.     FillChar (V [I], C, #0);
  4814.     Result := I;
  4815.   End;
  4816.  
  4817. Function ArrayInsert (var V : SingleArray; const Idx : Integer; const Count : Integer) : Integer;
  4818. var I, L, C : Integer;
  4819.   Begin
  4820.     L := Length (V);
  4821.     if (Idx > L) or (Idx + Count <= 0) or (Count = 0) then
  4822.       begin
  4823.         Result := -1;
  4824.         exit;
  4825.       end;
  4826.     I := MaxI (Idx, 0);
  4827.     SetLength (V, L + Count);
  4828.     C := Count * Sizeof (Single);
  4829.     if I < L then
  4830.       Move (V [I], V [I + Count], (L - I) * Sizeof (Single));
  4831.     FillChar (V [I], C, #0);
  4832.     Result := I;
  4833.   End;
  4834.  
  4835. Function ArrayInsert (var V : DoubleArray; const Idx : Integer; const Count : Integer) : Integer;
  4836. var I, L, C : Integer;
  4837.   Begin
  4838.     L := Length (V);
  4839.     if (Idx > L) or (Idx + Count <= 0) or (Count = 0) then
  4840.       begin
  4841.         Result := -1;
  4842.         exit;
  4843.       end;
  4844.     I := MaxI (Idx, 0);
  4845.     SetLength (V, L + Count);
  4846.     C := Count * Sizeof (Double);
  4847.     if I < L then
  4848.       Move (V [I], V [I + Count], (L - I) * Sizeof (Double));
  4849.     FillChar (V [I], C, #0);
  4850.     Result := I;
  4851.   End;
  4852.  
  4853. Function ArrayInsert (var V : ExtendedArray; const Idx : Integer; const Count : Integer) : Integer;
  4854. var I, L, C : Integer;
  4855.   Begin
  4856.     L := Length (V);
  4857.     if (Idx > L) or (Idx + Count <= 0) or (Count = 0) then
  4858.       begin
  4859.         Result := -1;
  4860.         exit;
  4861.       end;
  4862.     I := MaxI (Idx, 0);
  4863.     SetLength (V, L + Count);
  4864.     C := Count * Sizeof (Extended);
  4865.     if I < L then
  4866.       Move (V [I], V [I + Count], (L - I) * Sizeof (Extended));
  4867.     FillChar (V [I], C, #0);
  4868.     Result := I;
  4869.   End;
  4870.  
  4871. Function ArrayInsert (var V : StringArray; const Idx : Integer; const Count : Integer) : Integer;
  4872. var I, L, C : Integer;
  4873.   Begin
  4874.     L := Length (V);
  4875.     if (Idx > L) or (Idx + Count <= 0) or (Count = 0) then
  4876.       begin
  4877.         Result := -1;
  4878.         exit;
  4879.       end;
  4880.     I := MaxI (Idx, 0);
  4881.     SetLength (V, L + Count);
  4882.     C := Count * Sizeof (String);
  4883.     if I < L then
  4884.       Move (V [I], V [I + Count], (L - I) * Sizeof (String));
  4885.     FillChar (V [I], C, #0);
  4886.     Result := I;
  4887.   End;
  4888.  
  4889. Function ArrayInsert (var V : PointerArray; const Idx : Integer; const Count : Integer) : Integer;
  4890. var I, L, C : Integer;
  4891.   Begin
  4892.     L := Length (V);
  4893.     if (Idx > L) or (Idx + Count <= 0) or (Count = 0) then
  4894.       begin
  4895.         Result := -1;
  4896.         exit;
  4897.       end;
  4898.     I := MaxI (Idx, 0);
  4899.     SetLength (V, L + Count);
  4900.     C := Count * Sizeof (Pointer);
  4901.     if I < L then
  4902.       Move (V [I], V [I + Count], (L - I) * Sizeof (Pointer));
  4903.     FillChar (V [I], C, #0);
  4904.     Result := I;
  4905.   End;
  4906.  
  4907. Function ArrayInsert (var V : ObjectArray; const Idx : Integer; const Count : Integer) : Integer;
  4908. var I, L, C : Integer;
  4909.   Begin
  4910.     L := Length (V);
  4911.     if (Idx > L) or (Idx + Count <= 0) or (Count = 0) then
  4912.       begin
  4913.         Result := -1;
  4914.         exit;
  4915.       end;
  4916.     I := MaxI (Idx, 0);
  4917.     SetLength (V, L + Count);
  4918.     C := Count * Sizeof (Pointer);
  4919.     if I < L then
  4920.       Move (V [I], V [I + Count], (L - I) * Sizeof (Pointer));
  4921.     FillChar (V [I], C, #0);
  4922.     Result := I;
  4923.   End;
  4924.  
  4925.  
  4926.  
  4927. {                                                                              }
  4928. { PosNext                                                                      }
  4929. {   PosNext finds the next occurance of Find in V, -1 if it was not found.     }
  4930. {     Searches from item [PrevPos + 1], ie PrevPos = -1 to find first          }
  4931. {     occurance.                                                               }
  4932. {                                                                              }
  4933. Function PosNext (const Find : Byte; const V : ByteArray; const PrevPos : Integer; const IsSortedAscending : Boolean) : Integer;
  4934. var I, L, H : Integer;
  4935.     D       : Byte;
  4936.   Begin
  4937.     if IsSortedAscending then // binary search
  4938.       begin
  4939.         if MaxI (PrevPos + 1, 0) = 0 then // find first
  4940.           begin
  4941.             L := 0;
  4942.             H := Length (V) - 1;
  4943.             Repeat
  4944.               I := (L + H) div 2;
  4945.               D := V [I];
  4946.               if Find = D then
  4947.                 begin
  4948.                   While (I > 0) and (V [I - 1] = Find) do
  4949.                     Dec (I);
  4950.                   Result := I;
  4951.                   exit;
  4952.                 end else
  4953.               if D > Find then
  4954.                 H := I - 1 else
  4955.                 L := I + 1;
  4956.             Until L > H;
  4957.             Result := -1;
  4958.           end else // find next
  4959.           if PrevPos >= Length (V) - 1 then
  4960.             Result := -1 else
  4961.             if V [PrevPos + 1] = Find then
  4962.               Result := PrevPos + 1 else
  4963.               Result := -1;
  4964.       end else
  4965.       begin // linear search
  4966.         For I := MaxI (PrevPos + 1, 0) to Length (V) - 1 do
  4967.           if V [I] = Find then
  4968.             begin
  4969.               Result := I;
  4970.               exit;
  4971.             end;
  4972.         Result := -1;
  4973.       end;
  4974.   End;
  4975.  
  4976. Function PosNext (const Find : Word; const V : WordArray; const PrevPos : Integer; const IsSortedAscending : Boolean) : Integer;
  4977. var I, L, H : Integer;
  4978.     D       : Word;
  4979.   Begin
  4980.     if IsSortedAscending then // binary search
  4981.       begin
  4982.         if MaxI (PrevPos + 1, 0) = 0 then // find first
  4983.           begin
  4984.             L := 0;
  4985.             H := Length (V) - 1;
  4986.             Repeat
  4987.               I := (L + H) div 2;
  4988.               D := V [I];
  4989.               if Find = D then
  4990.                 begin
  4991.                   While (I > 0) and (V [I - 1] = Find) do
  4992.                     Dec (I);
  4993.                   Result := I;
  4994.                   exit;
  4995.                 end else
  4996.               if D > Find then
  4997.                 H := I - 1 else
  4998.                 L := I + 1;
  4999.             Until L > H;
  5000.             Result := -1;
  5001.           end else // find next
  5002.           if PrevPos >= Length (V) - 1 then
  5003.             Result := -1 else
  5004.             if V [PrevPos + 1] = Find then
  5005.               Result := PrevPos + 1 else
  5006.               Result := -1;
  5007.       end else
  5008.       begin // linear search
  5009.         For I := MaxI (PrevPos + 1, 0) to Length (V) - 1 do
  5010.           if V [I] = Find then
  5011.             begin
  5012.               Result := I;
  5013.               exit;
  5014.             end;
  5015.         Result := -1;
  5016.       end;
  5017.   End;
  5018.  
  5019. Function PosNext (const Find : LongWord; const V : LongWordArray; const PrevPos : Integer; const IsSortedAscending : Boolean) : Integer;
  5020. var I, L, H : Integer;
  5021.     D       : LongWord;
  5022.   Begin
  5023.     if IsSortedAscending then // binary search
  5024.       begin
  5025.         if MaxI (PrevPos + 1, 0) = 0 then // find first
  5026.           begin
  5027.             L := 0;
  5028.             H := Length (V) - 1;
  5029.             Repeat
  5030.               I := (L + H) div 2;
  5031.               D := V [I];
  5032.               if Find = D then
  5033.                 begin
  5034.                   While (I > 0) and (V [I - 1] = Find) do
  5035.                     Dec (I);
  5036.                   Result := I;
  5037.                   exit;
  5038.                 end else
  5039.               if D > Find then
  5040.                 H := I - 1 else
  5041.                 L := I + 1;
  5042.             Until L > H;
  5043.             Result := -1;
  5044.           end else // find next
  5045.           if PrevPos >= Length (V) - 1 then
  5046.             Result := -1 else
  5047.             if V [PrevPos + 1] = Find then
  5048.               Result := PrevPos + 1 else
  5049.               Result := -1;
  5050.       end else
  5051.       begin // linear search
  5052.         For I := MaxI (PrevPos + 1, 0) to Length (V) - 1 do
  5053.           if V [I] = Find then
  5054.             begin
  5055.               Result := I;
  5056.               exit;
  5057.             end;
  5058.         Result := -1;
  5059.       end;
  5060.   End;
  5061.  
  5062. Function PosNext (const Find : ShortInt; const V : ShortIntArray; const PrevPos : Integer; const IsSortedAscending : Boolean) : Integer;
  5063. var I, L, H : Integer;
  5064.     D       : ShortInt;
  5065.   Begin
  5066.     if IsSortedAscending then // binary search
  5067.       begin
  5068.         if MaxI (PrevPos + 1, 0) = 0 then // find first
  5069.           begin
  5070.             L := 0;
  5071.             H := Length (V) - 1;
  5072.             Repeat
  5073.               I := (L + H) div 2;
  5074.               D := V [I];
  5075.               if Find = D then
  5076.                 begin
  5077.                   While (I > 0) and (V [I - 1] = Find) do
  5078.                     Dec (I);
  5079.                   Result := I;
  5080.                   exit;
  5081.                 end else
  5082.               if D > Find then
  5083.                 H := I - 1 else
  5084.                 L := I + 1;
  5085.             Until L > H;
  5086.             Result := -1;
  5087.           end else // find next
  5088.           if PrevPos >= Length (V) - 1 then
  5089.             Result := -1 else
  5090.             if V [PrevPos + 1] = Find then
  5091.               Result := PrevPos + 1 else
  5092.               Result := -1;
  5093.       end else
  5094.       begin // linear search
  5095.         For I := MaxI (PrevPos + 1, 0) to Length (V) - 1 do
  5096.           if V [I] = Find then
  5097.             begin
  5098.               Result := I;
  5099.               exit;
  5100.             end;
  5101.         Result := -1;
  5102.       end;
  5103.   End;
  5104.  
  5105. Function PosNext (const Find : SmallInt; const V : SmallIntArray; const PrevPos : Integer; const IsSortedAscending : Boolean) : Integer;
  5106. var I, L, H : Integer;
  5107.     D       : SmallInt;
  5108.   Begin
  5109.     if IsSortedAscending then // binary search
  5110.       begin
  5111.         if MaxI (PrevPos + 1, 0) = 0 then // find first
  5112.           begin
  5113.             L := 0;
  5114.             H := Length (V) - 1;
  5115.             Repeat
  5116.               I := (L + H) div 2;
  5117.               D := V [I];
  5118.               if Find = D then
  5119.                 begin
  5120.                   While (I > 0) and (V [I - 1] = Find) do
  5121.                     Dec (I);
  5122.                   Result := I;
  5123.                   exit;
  5124.                 end else
  5125.               if D > Find then
  5126.                 H := I - 1 else
  5127.                 L := I + 1;
  5128.             Until L > H;
  5129.             Result := -1;
  5130.           end else // find next
  5131.           if PrevPos >= Length (V) - 1 then
  5132.             Result := -1 else
  5133.             if V [PrevPos + 1] = Find then
  5134.               Result := PrevPos + 1 else
  5135.               Result := -1;
  5136.       end else
  5137.       begin // linear search
  5138.         For I := MaxI (PrevPos + 1, 0) to Length (V) - 1 do
  5139.           if V [I] = Find then
  5140.             begin
  5141.               Result := I;
  5142.               exit;
  5143.             end;
  5144.         Result := -1;
  5145.       end;
  5146.   End;
  5147.  
  5148. Function PosNext (const Find : LongInt; const V : LongIntArray; const PrevPos : Integer; const IsSortedAscending : Boolean) : Integer;
  5149. var I, L, H : Integer;
  5150.     D       : LongInt;
  5151.   Begin
  5152.     if IsSortedAscending then // binary search
  5153.       begin
  5154.         if MaxI (PrevPos + 1, 0) = 0 then // find first
  5155.           begin
  5156.             L := 0;
  5157.             H := Length (V) - 1;
  5158.             Repeat
  5159.               I := (L + H) div 2;
  5160.               D := V [I];
  5161.               if Find = D then
  5162.                 begin
  5163.                   While (I > 0) and (V [I - 1] = Find) do
  5164.                     Dec (I);
  5165.                   Result := I;
  5166.                   exit;
  5167.                 end else
  5168.               if D > Find then
  5169.                 H := I - 1 else
  5170.                 L := I + 1;
  5171.             Until L > H;
  5172.             Result := -1;
  5173.           end else // find next
  5174.           if PrevPos >= Length (V) - 1 then
  5175.             Result := -1 else
  5176.             if V [PrevPos + 1] = Find then
  5177.               Result := PrevPos + 1 else
  5178.               Result := -1;
  5179.       end else
  5180.       begin // linear search
  5181.         For I := MaxI (PrevPos + 1, 0) to Length (V) - 1 do
  5182.           if V [I] = Find then
  5183.             begin
  5184.               Result := I;
  5185.               exit;
  5186.             end;
  5187.         Result := -1;
  5188.       end;
  5189.   End;
  5190.  
  5191. Function PosNext (const Find : Int64; const V : Int64Array; const PrevPos : Integer; const IsSortedAscending : Boolean) : Integer;
  5192. var I, L, H : Integer;
  5193.     D       : Int64;
  5194.   Begin
  5195.     if IsSortedAscending then // binary search
  5196.       begin
  5197.         if MaxI (PrevPos + 1, 0) = 0 then // find first
  5198.           begin
  5199.             L := 0;
  5200.             H := Length (V) - 1;
  5201.             Repeat
  5202.               I := (L + H) div 2;
  5203.               D := V [I];
  5204.               if Find = D then
  5205.                 begin
  5206.                   While (I > 0) and (V [I - 1] = Find) do
  5207.                     Dec (I);
  5208.                   Result := I;
  5209.                   exit;
  5210.                 end else
  5211.               if D > Find then
  5212.                 H := I - 1 else
  5213.                 L := I + 1;
  5214.             Until L > H;
  5215.             Result := -1;
  5216.           end else // find next
  5217.           if PrevPos >= Length (V) - 1 then
  5218.             Result := -1 else
  5219.             if V [PrevPos + 1] = Find then
  5220.               Result := PrevPos + 1 else
  5221.               Result := -1;
  5222.       end else
  5223.       begin // linear search
  5224.         For I := MaxI (PrevPos + 1, 0) to Length (V) - 1 do
  5225.           if V [I] = Find then
  5226.             begin
  5227.               Result := I;
  5228.               exit;
  5229.             end;
  5230.         Result := -1;
  5231.       end;
  5232.   End;
  5233.  
  5234. Function PosNext (const Find : Single; const V : SingleArray; const PrevPos : Integer; const IsSortedAscending : Boolean) : Integer;
  5235. var I, L, H : Integer;
  5236.     D       : Single;
  5237.   Begin
  5238.     if IsSortedAscending then // binary search
  5239.       begin
  5240.         if MaxI (PrevPos + 1, 0) = 0 then // find first
  5241.           begin
  5242.             L := 0;
  5243.             H := Length (V) - 1;
  5244.             Repeat
  5245.               I := (L + H) div 2;
  5246.               D := V [I];
  5247.               if Find = D then
  5248.                 begin
  5249.                   While (I > 0) and (V [I - 1] = Find) do
  5250.                     Dec (I);
  5251.                   Result := I;
  5252.                   exit;
  5253.                 end else
  5254.               if D > Find then
  5255.                 H := I - 1 else
  5256.                 L := I + 1;
  5257.             Until L > H;
  5258.             Result := -1;
  5259.           end else // find next
  5260.           if PrevPos >= Length (V) - 1 then
  5261.             Result := -1 else
  5262.             if V [PrevPos + 1] = Find then
  5263.               Result := PrevPos + 1 else
  5264.               Result := -1;
  5265.       end else
  5266.       begin // linear search
  5267.         For I := MaxI (PrevPos + 1, 0) to Length (V) - 1 do
  5268.           if V [I] = Find then
  5269.             begin
  5270.               Result := I;
  5271.               exit;
  5272.             end;
  5273.         Result := -1;
  5274.       end;
  5275.   End;
  5276.  
  5277. Function PosNext (const Find : Double; const V : DoubleArray; const PrevPos : Integer; const IsSortedAscending : Boolean) : Integer;
  5278. var I, L, H : Integer;
  5279.     D       : Double;
  5280.   Begin
  5281.     if IsSortedAscending then // binary search
  5282.       begin
  5283.         if MaxI (PrevPos + 1, 0) = 0 then // find first
  5284.           begin
  5285.             L := 0;
  5286.             H := Length (V) - 1;
  5287.             Repeat
  5288.               I := (L + H) div 2;
  5289.               D := V [I];
  5290.               if Find = D then
  5291.                 begin
  5292.                   While (I > 0) and (V [I - 1] = Find) do
  5293.                     Dec (I);
  5294.                   Result := I;
  5295.                   exit;
  5296.                 end else
  5297.               if D > Find then
  5298.                 H := I - 1 else
  5299.                 L := I + 1;
  5300.             Until L > H;
  5301.             Result := -1;
  5302.           end else // find next
  5303.           if PrevPos >= Length (V) - 1 then
  5304.             Result := -1 else
  5305.             if V [PrevPos + 1] = Find then
  5306.               Result := PrevPos + 1 else
  5307.               Result := -1;
  5308.       end else
  5309.       begin // linear search
  5310.         For I := MaxI (PrevPos + 1, 0) to Length (V) - 1 do
  5311.           if V [I] = Find then
  5312.             begin
  5313.               Result := I;
  5314.               exit;
  5315.             end;
  5316.         Result := -1;
  5317.       end;
  5318.   End;
  5319.  
  5320. Function PosNext (const Find : Extended; const V : ExtendedArray; const PrevPos : Integer; const IsSortedAscending : Boolean) : Integer;
  5321. var I, L, H : Integer;
  5322.     D       : Extended;
  5323.   Begin
  5324.     if IsSortedAscending then // binary search
  5325.       begin
  5326.         if MaxI (PrevPos + 1, 0) = 0 then // find first
  5327.           begin
  5328.             L := 0;
  5329.             H := Length (V) - 1;
  5330.             Repeat
  5331.               I := (L + H) div 2;
  5332.               D := V [I];
  5333.               if Find = D then
  5334.                 begin
  5335.                   While (I > 0) and (V [I - 1] = Find) do
  5336.                     Dec (I);
  5337.                   Result := I;
  5338.                   exit;
  5339.                 end else
  5340.               if D > Find then
  5341.                 H := I - 1 else
  5342.                 L := I + 1;
  5343.             Until L > H;
  5344.             Result := -1;
  5345.           end else // find next
  5346.           if PrevPos >= Length (V) - 1 then
  5347.             Result := -1 else
  5348.             if V [PrevPos + 1] = Find then
  5349.               Result := PrevPos + 1 else
  5350.               Result := -1;
  5351.       end else
  5352.       begin // linear search
  5353.         For I := MaxI (PrevPos + 1, 0) to Length (V) - 1 do
  5354.           if V [I] = Find then
  5355.             begin
  5356.               Result := I;
  5357.               exit;
  5358.             end;
  5359.         Result := -1;
  5360.       end;
  5361.   End;
  5362.  
  5363. Function PosNext (const Find : Boolean; const V : BooleanArray; const PrevPos : Integer; const IsSortedAscending : Boolean) : Integer;
  5364. var I, L, H : Integer;
  5365.     D       : Boolean;
  5366.   Begin
  5367.     if IsSortedAscending then // binary search
  5368.       begin
  5369.         if MaxI (PrevPos + 1, 0) = 0 then // find first
  5370.           begin
  5371.             L := 0;
  5372.             H := Length (V) - 1;
  5373.             Repeat
  5374.               I := (L + H) div 2;
  5375.               D := V [I];
  5376.               if Find = D then
  5377.                 begin
  5378.                   While (I > 0) and (V [I - 1] = Find) do
  5379.                     Dec (I);
  5380.                   Result := I;
  5381.                   exit;
  5382.                 end else
  5383.               if D > Find then
  5384.                 H := I - 1 else
  5385.                 L := I + 1;
  5386.             Until L > H;
  5387.             Result := -1;
  5388.           end else // find next
  5389.           if PrevPos >= Length (V) - 1 then
  5390.             Result := -1 else
  5391.             if V [PrevPos + 1] = Find then
  5392.               Result := PrevPos + 1 else
  5393.               Result := -1;
  5394.       end else
  5395.       begin // linear search
  5396.         For I := MaxI (PrevPos + 1, 0) to Length (V) - 1 do
  5397.           if V [I] = Find then
  5398.             begin
  5399.               Result := I;
  5400.               exit;
  5401.             end;
  5402.         Result := -1;
  5403.       end;
  5404.   End;
  5405.  
  5406. Function PosNext (const Find : String; const V : StringArray; const PrevPos : Integer; const IsSortedAscending : Boolean) : Integer;
  5407. var I, L, H : Integer;
  5408.     D       : String;
  5409.   Begin
  5410.     if IsSortedAscending then // binary search
  5411.       begin
  5412.         if MaxI (PrevPos + 1, 0) = 0 then // find first
  5413.           begin
  5414.             L := 0;
  5415.             H := Length (V) - 1;
  5416.             Repeat
  5417.               I := (L + H) div 2;
  5418.               D := V [I];
  5419.               if Find = D then
  5420.                 begin
  5421.                   While (I > 0) and (V [I - 1] = Find) do
  5422.                     Dec (I);
  5423.                   Result := I;
  5424.                   exit;
  5425.                 end else
  5426.               if D > Find then
  5427.                 H := I - 1 else
  5428.                 L := I + 1;
  5429.             Until L > H;
  5430.             Result := -1;
  5431.           end else // find next
  5432.           if PrevPos >= Length (V) - 1 then
  5433.             Result := -1 else
  5434.             if V [PrevPos + 1] = Find then
  5435.               Result := PrevPos + 1 else
  5436.               Result := -1;
  5437.       end else
  5438.       begin // linear search
  5439.         For I := MaxI (PrevPos + 1, 0) to Length (V) - 1 do
  5440.           if V [I] = Find then
  5441.             begin
  5442.               Result := I;
  5443.               exit;
  5444.             end;
  5445.         Result := -1;
  5446.       end;
  5447.   End;
  5448.  
  5449. Function PosNext (const Find : TObject; const V : ObjectArray; const PrevPos : Integer) : Integer;
  5450. var I : Integer;
  5451.   Begin
  5452.     For I := MaxI (PrevPos + 1, 0) to Length (V) - 1 do
  5453.       if V [I] = Find then
  5454.         begin
  5455.           Result := I;
  5456.           exit;
  5457.          end;
  5458.     Result := -1;
  5459.   End;
  5460.  
  5461. Function PosNext (const ClassType : TClass; const V : ObjectArray; const PrevPos : Integer) : Integer;
  5462. var I : Integer;
  5463.   Begin
  5464.     For I := MaxI (PrevPos + 1, 0) to Length (V) - 1 do
  5465.       if V [I] is ClassType then
  5466.         begin
  5467.           Result := I;
  5468.           exit;
  5469.          end;
  5470.     Result := -1;
  5471.   End;
  5472.  
  5473. Function PosNext (const ClassName : String; const V : ObjectArray; const PrevPos : Integer) : Integer;
  5474. var I : Integer;
  5475.     T : TObject;
  5476.   Begin
  5477.     For I := MaxI (PrevPos + 1, 0) to Length (V) - 1 do
  5478.       begin
  5479.         T := V [I];
  5480.         if Assigned (T) and (T.ClassName = ClassName) then
  5481.           begin
  5482.             Result := I;
  5483.             exit;
  5484.            end;
  5485.       end;
  5486.     Result := -1;
  5487.   End;
  5488.  
  5489. Function PosNext (const Find : Pointer; const V : PointerArray; const PrevPos : Integer) : Integer;
  5490. var I : Integer;
  5491.   Begin
  5492.     For I := MaxI (PrevPos + 1, 0) to Length (V) - 1 do
  5493.       if V [I] = Find then
  5494.         begin
  5495.           Result := I;
  5496.           exit;
  5497.          end;
  5498.     Result := -1;
  5499.   End;
  5500.  
  5501.  
  5502.  
  5503. {                                                                              }
  5504. { Count                                                                        }
  5505. {                                                                              }
  5506. Function Count (const Find : Byte; const V : ByteArray; const IsSortedAscending : Boolean = False) : Integer;
  5507. var I, J : Integer;
  5508.   Begin
  5509.     if IsSortedAscending then
  5510.       begin
  5511.         I := PosNext (Find, V, -1, True);
  5512.         if I = -1 then
  5513.           Result := 0 else
  5514.           begin
  5515.             Result := 1;
  5516.             J := Length (V);
  5517.             While (I + Result < J) and (V [I + Result] = Find) do
  5518.               Inc (Result);
  5519.           end;
  5520.       end else
  5521.       begin
  5522.         J := -1;
  5523.         Result := 0;
  5524.         Repeat
  5525.           I := PosNext (Find, V, J, False);
  5526.           if I >= 0 then
  5527.             begin
  5528.               Inc (Result);
  5529.               J := I;
  5530.             end;
  5531.         Until I < 0;
  5532.       end;
  5533.   End;
  5534.  
  5535. Function Count (const Find : Word; const V : WordArray; const IsSortedAscending : Boolean = False) : Integer;
  5536. var I, J : Integer;
  5537.   Begin
  5538.     if IsSortedAscending then
  5539.       begin
  5540.         I := PosNext (Find, V, -1, True);
  5541.         if I = -1 then
  5542.           Result := 0 else
  5543.           begin
  5544.             Result := 1;
  5545.             J := Length (V);
  5546.             While (I + Result < J) and (V [I + Result] = Find) do
  5547.               Inc (Result);
  5548.           end;
  5549.       end else
  5550.       begin
  5551.         J := -1;
  5552.         Result := 0;
  5553.         Repeat
  5554.           I := PosNext (Find, V, J, False);
  5555.           if I >= 0 then
  5556.             begin
  5557.               Inc (Result);
  5558.               J := I;
  5559.             end;
  5560.         Until I < 0;
  5561.       end;
  5562.   End;
  5563.  
  5564. Function Count (const Find : LongWord; const V : LongWordArray; const IsSortedAscending : Boolean = False) : Integer;
  5565. var I, J : Integer;
  5566.   Begin
  5567.     if IsSortedAscending then
  5568.       begin
  5569.         I := PosNext (Find, V, -1, True);
  5570.         if I = -1 then
  5571.           Result := 0 else
  5572.           begin
  5573.             Result := 1;
  5574.             J := Length (V);
  5575.             While (I + Result < J) and (V [I + Result] = Find) do
  5576.               Inc (Result);
  5577.           end;
  5578.       end else
  5579.       begin
  5580.         J := -1;
  5581.         Result := 0;
  5582.         Repeat
  5583.           I := PosNext (Find, V, J, False);
  5584.           if I >= 0 then
  5585.             begin
  5586.               Inc (Result);
  5587.               J := I;
  5588.             end;
  5589.         Until I < 0;
  5590.       end;
  5591.   End;
  5592.  
  5593. Function Count (const Find : ShortInt; const V : ShortIntArray; const IsSortedAscending : Boolean = False) : Integer;
  5594. var I, J : Integer;
  5595.   Begin
  5596.     if IsSortedAscending then
  5597.       begin
  5598.         I := PosNext (Find, V, -1, True);
  5599.         if I = -1 then
  5600.           Result := 0 else
  5601.           begin
  5602.             Result := 1;
  5603.             J := Length (V);
  5604.             While (I + Result < J) and (V [I + Result] = Find) do
  5605.               Inc (Result);
  5606.           end;
  5607.       end else
  5608.       begin
  5609.         J := -1;
  5610.         Result := 0;
  5611.         Repeat
  5612.           I := PosNext (Find, V, J, False);
  5613.           if I >= 0 then
  5614.             begin
  5615.               Inc (Result);
  5616.               J := I;
  5617.             end;
  5618.         Until I < 0;
  5619.       end;
  5620.   End;
  5621.  
  5622. Function Count (const Find : SmallInt; const V : SmallIntArray; const IsSortedAscending : Boolean = False) : Integer;
  5623. var I, J : Integer;
  5624.   Begin
  5625.     if IsSortedAscending then
  5626.       begin
  5627.         I := PosNext (Find, V, -1, True);
  5628.         if I = -1 then
  5629.           Result := 0 else
  5630.           begin
  5631.             Result := 1;
  5632.             J := Length (V);
  5633.             While (I + Result < J) and (V [I + Result] = Find) do
  5634.               Inc (Result);
  5635.           end;
  5636.       end else
  5637.       begin
  5638.         J := -1;
  5639.         Result := 0;
  5640.         Repeat
  5641.           I := PosNext (Find, V, J, False);
  5642.           if I >= 0 then
  5643.             begin
  5644.               Inc (Result);
  5645.               J := I;
  5646.             end;
  5647.         Until I < 0;
  5648.       end;
  5649.   End;
  5650.  
  5651. Function Count (const Find : LongInt; const V : LongIntArray; const IsSortedAscending : Boolean = False) : Integer;
  5652. var I, J : Integer;
  5653.   Begin
  5654.     if IsSortedAscending then
  5655.       begin
  5656.         I := PosNext (Find, V, -1, True);
  5657.         if I = -1 then
  5658.           Result := 0 else
  5659.           begin
  5660.             Result := 1;
  5661.             J := Length (V);
  5662.             While (I + Result < J) and (V [I + Result] = Find) do
  5663.               Inc (Result);
  5664.           end;
  5665.       end else
  5666.       begin
  5667.         J := -1;
  5668.         Result := 0;
  5669.         Repeat
  5670.           I := PosNext (Find, V, J, False);
  5671.           if I >= 0 then
  5672.             begin
  5673.               Inc (Result);
  5674.               J := I;
  5675.             end;
  5676.         Until I < 0;
  5677.       end;
  5678.   End;
  5679.  
  5680. Function Count (const Find : Int64; const V : Int64Array; const IsSortedAscending : Boolean = False) : Integer;
  5681. var I, J : Integer;
  5682.   Begin
  5683.     if IsSortedAscending then
  5684.       begin
  5685.         I := PosNext (Find, V, -1, True);
  5686.         if I = -1 then
  5687.           Result := 0 else
  5688.           begin
  5689.             Result := 1;
  5690.             J := Length (V);
  5691.             While (I + Result < J) and (V [I + Result] = Find) do
  5692.               Inc (Result);
  5693.           end;
  5694.       end else
  5695.       begin
  5696.         J := -1;
  5697.         Result := 0;
  5698.         Repeat
  5699.           I := PosNext (Find, V, J, False);
  5700.           if I >= 0 then
  5701.             begin
  5702.               Inc (Result);
  5703.               J := I;
  5704.             end;
  5705.         Until I < 0;
  5706.       end;
  5707.   End;
  5708.  
  5709. Function Count (const Find : Single; const V : SingleArray; const IsSortedAscending : Boolean = False) : Integer;
  5710. var I, J : Integer;
  5711.   Begin
  5712.     if IsSortedAscending then
  5713.       begin
  5714.         I := PosNext (Find, V, -1, True);
  5715.         if I = -1 then
  5716.           Result := 0 else
  5717.           begin
  5718.             Result := 1;
  5719.             J := Length (V);
  5720.             While (I + Result < J) and (V [I + Result] = Find) do
  5721.               Inc (Result);
  5722.           end;
  5723.       end else
  5724.       begin
  5725.         J := -1;
  5726.         Result := 0;
  5727.         Repeat
  5728.           I := PosNext (Find, V, J, False);
  5729.           if I >= 0 then
  5730.             begin
  5731.               Inc (Result);
  5732.               J := I;
  5733.             end;
  5734.         Until I < 0;
  5735.       end;
  5736.   End;
  5737.  
  5738. Function Count (const Find : Double; const V : DoubleArray; const IsSortedAscending : Boolean = False) : Integer;
  5739. var I, J : Integer;
  5740.   Begin
  5741.     if IsSortedAscending then
  5742.       begin
  5743.         I := PosNext (Find, V, -1, True);
  5744.         if I = -1 then
  5745.           Result := 0 else
  5746.           begin
  5747.             Result := 1;
  5748.             J := Length (V);
  5749.             While (I + Result < J) and (V [I + Result] = Find) do
  5750.               Inc (Result);
  5751.           end;
  5752.       end else
  5753.       begin
  5754.         J := -1;
  5755.         Result := 0;
  5756.         Repeat
  5757.           I := PosNext (Find, V, J, False);
  5758.           if I >= 0 then
  5759.             begin
  5760.               Inc (Result);
  5761.               J := I;
  5762.             end;
  5763.         Until I < 0;
  5764.       end;
  5765.   End;
  5766.  
  5767. Function Count (const Find : Extended; const V : ExtendedArray; const IsSortedAscending : Boolean = False) : Integer;
  5768. var I, J : Integer;
  5769.   Begin
  5770.     if IsSortedAscending then
  5771.       begin
  5772.         I := PosNext (Find, V, -1, True);
  5773.         if I = -1 then
  5774.           Result := 0 else
  5775.           begin
  5776.             Result := 1;
  5777.             J := Length (V);
  5778.             While (I + Result < J) and (V [I + Result] = Find) do
  5779.               Inc (Result);
  5780.           end;
  5781.       end else
  5782.       begin
  5783.         J := -1;
  5784.         Result := 0;
  5785.         Repeat
  5786.           I := PosNext (Find, V, J, False);
  5787.           if I >= 0 then
  5788.             begin
  5789.               Inc (Result);
  5790.               J := I;
  5791.             end;
  5792.         Until I < 0;
  5793.       end;
  5794.   End;
  5795.  
  5796. Function Count (const Find : String; const V : StringArray; const IsSortedAscending : Boolean = False) : Integer;
  5797. var I, J : Integer;
  5798.   Begin
  5799.     if IsSortedAscending then
  5800.       begin
  5801.         I := PosNext (Find, V, -1, True);
  5802.         if I = -1 then
  5803.           Result := 0 else
  5804.           begin
  5805.             Result := 1;
  5806.             J := Length (V);
  5807.             While (I + Result < J) and (V [I + Result] = Find) do
  5808.               Inc (Result);
  5809.           end;
  5810.       end else
  5811.       begin
  5812.         J := -1;
  5813.         Result := 0;
  5814.         Repeat
  5815.           I := PosNext (Find, V, J, False);
  5816.           if I >= 0 then
  5817.             begin
  5818.               Inc (Result);
  5819.               J := I;
  5820.             end;
  5821.         Until I < 0;
  5822.       end;
  5823.   End;
  5824.  
  5825. Function Count (const Find : Boolean; const V : BooleanArray; const IsSortedAscending : Boolean = False) : Integer;
  5826. var I, J : Integer;
  5827.   Begin
  5828.     if IsSortedAscending then
  5829.       begin
  5830.         I := PosNext (Find, V, -1, True);
  5831.         if I = -1 then
  5832.           Result := 0 else
  5833.           begin
  5834.             Result := 1;
  5835.             J := Length (V);
  5836.             While (I + Result < J) and (V [I + Result] = Find) do
  5837.               Inc (Result);
  5838.           end;
  5839.       end else
  5840.       begin
  5841.         J := -1;
  5842.         Result := 0;
  5843.         Repeat
  5844.           I := PosNext (Find, V, J, False);
  5845.           if I >= 0 then
  5846.             begin
  5847.               Inc (Result);
  5848.               J := I;
  5849.             end;
  5850.         Until I < 0;
  5851.       end;
  5852.   End;
  5853.  
  5854.  
  5855.  
  5856. {                                                                              }
  5857. { RemoveAll                                                                    }
  5858. {                                                                              }
  5859. Procedure RemoveAll (const Find : Byte; var V : ByteArray; const IsSortedAscending : Boolean = False);
  5860. var I, J : Integer;
  5861.   Begin
  5862.     I := PosNext (Find, V, -1, IsSortedAscending);
  5863.     While I >= 0 do
  5864.       begin
  5865.         J := 1;
  5866.         While (I + J < Length (V)) and (V [I + J] = Find) do
  5867.           Inc (J);
  5868.         Remove (V, I, J);
  5869.         I := PosNext (Find, V, I, IsSortedAscending);
  5870.       end;
  5871.   End;
  5872.  
  5873. Procedure RemoveAll (const Find : Word; var V : WordArray; const IsSortedAscending : Boolean = False);
  5874. var I, J : Integer;
  5875.   Begin
  5876.     I := PosNext (Find, V, -1, IsSortedAscending);
  5877.     While I >= 0 do
  5878.       begin
  5879.         J := 1;
  5880.         While (I + J < Length (V)) and (V [I + J] = Find) do
  5881.           Inc (J);
  5882.         Remove (V, I, J);
  5883.         I := PosNext (Find, V, I, IsSortedAscending);
  5884.       end;
  5885.   End;
  5886.  
  5887. Procedure RemoveAll (const Find : LongWord; var V : LongWordArray; const IsSortedAscending : Boolean = False);
  5888. var I, J : Integer;
  5889.   Begin
  5890.     I := PosNext (Find, V, -1, IsSortedAscending);
  5891.     While I >= 0 do
  5892.       begin
  5893.         J := 1;
  5894.         While (I + J < Length (V)) and (V [I + J] = Find) do
  5895.           Inc (J);
  5896.         Remove (V, I, J);
  5897.         I := PosNext (Find, V, I, IsSortedAscending);
  5898.       end;
  5899.   End;
  5900.  
  5901. Procedure RemoveAll (const Find : ShortInt; var V : ShortIntArray; const IsSortedAscending : Boolean = False);
  5902. var I, J : Integer;
  5903.   Begin
  5904.     I := PosNext (Find, V, -1, IsSortedAscending);
  5905.     While I >= 0 do
  5906.       begin
  5907.         J := 1;
  5908.         While (I + J < Length (V)) and (V [I + J] = Find) do
  5909.           Inc (J);
  5910.         Remove (V, I, J);
  5911.         I := PosNext (Find, V, I, IsSortedAscending);
  5912.       end;
  5913.   End;
  5914.  
  5915. Procedure RemoveAll (const Find : SmallInt; var V : SmallIntArray; const IsSortedAscending : Boolean = False);
  5916. var I, J : Integer;
  5917.   Begin
  5918.     I := PosNext (Find, V, -1, IsSortedAscending);
  5919.     While I >= 0 do
  5920.       begin
  5921.         J := 1;
  5922.         While (I + J < Length (V)) and (V [I + J] = Find) do
  5923.           Inc (J);
  5924.         Remove (V, I, J);
  5925.         I := PosNext (Find, V, I, IsSortedAscending);
  5926.       end;
  5927.   End;
  5928.  
  5929. Procedure RemoveAll (const Find : LongInt; var V : LongIntArray; const IsSortedAscending : Boolean = False);
  5930. var I, J : Integer;
  5931.   Begin
  5932.     I := PosNext (Find, V, -1, IsSortedAscending);
  5933.     While I >= 0 do
  5934.       begin
  5935.         J := 1;
  5936.         While (I + J < Length (V)) and (V [I + J] = Find) do
  5937.           Inc (J);
  5938.         Remove (V, I, J);
  5939.         I := PosNext (Find, V, I, IsSortedAscending);
  5940.       end;
  5941.   End;
  5942.  
  5943. Procedure RemoveAll (const Find : Int64; var V : Int64Array; const IsSortedAscending : Boolean = False);
  5944. var I, J : Integer;
  5945.   Begin
  5946.     I := PosNext (Find, V, -1, IsSortedAscending);
  5947.     While I >= 0 do
  5948.       begin
  5949.         J := 1;
  5950.         While (I + J < Length (V)) and (V [I + J] = Find) do
  5951.           Inc (J);
  5952.         Remove (V, I, J);
  5953.         I := PosNext (Find, V, I, IsSortedAscending);
  5954.       end;
  5955.   End;
  5956.  
  5957. Procedure RemoveAll (const Find : Single; var V : SingleArray; const IsSortedAscending : Boolean = False);
  5958. var I, J : Integer;
  5959.   Begin
  5960.     I := PosNext (Find, V, -1, IsSortedAscending);
  5961.     While I >= 0 do
  5962.       begin
  5963.         J := 1;
  5964.         While (I + J < Length (V)) and (V [I + J] = Find) do
  5965.           Inc (J);
  5966.         Remove (V, I, J);
  5967.         I := PosNext (Find, V, I, IsSortedAscending);
  5968.       end;
  5969.   End;
  5970.  
  5971. Procedure RemoveAll (const Find : Double; var V : DoubleArray; const IsSortedAscending : Boolean = False);
  5972. var I, J : Integer;
  5973.   Begin
  5974.     I := PosNext (Find, V, -1, IsSortedAscending);
  5975.     While I >= 0 do
  5976.       begin
  5977.         J := 1;
  5978.         While (I + J < Length (V)) and (V [I + J] = Find) do
  5979.           Inc (J);
  5980.         Remove (V, I, J);
  5981.         I := PosNext (Find, V, I, IsSortedAscending);
  5982.       end;
  5983.   End;
  5984.  
  5985. Procedure RemoveAll (const Find : Extended; var V : ExtendedArray; const IsSortedAscending : Boolean = False);
  5986. var I, J : Integer;
  5987.   Begin
  5988.     I := PosNext (Find, V, -1, IsSortedAscending);
  5989.     While I >= 0 do
  5990.       begin
  5991.         J := 1;
  5992.         While (I + J < Length (V)) and (V [I + J] = Find) do
  5993.           Inc (J);
  5994.         Remove (V, I, J);
  5995.         I := PosNext (Find, V, I, IsSortedAscending);
  5996.       end;
  5997.   End;
  5998.  
  5999. Procedure RemoveAll (const Find : String; var V : StringArray; const IsSortedAscending : Boolean = False);
  6000. var I, J : Integer;
  6001.   Begin
  6002.     I := PosNext (Find, V, -1, IsSortedAscending);
  6003.     While I >= 0 do
  6004.       begin
  6005.         J := 1;
  6006.         While (I + J < Length (V)) and (V [I + J] = Find) do
  6007.           Inc (J);
  6008.         Remove (V, I, J);
  6009.         I := PosNext (Find, V, I, IsSortedAscending);
  6010.       end;
  6011.   End;
  6012.  
  6013.  
  6014.  
  6015. {                                                                              }
  6016. { Intersection                                                                 }
  6017. {   If both arrays are sorted ascending then time is o(n) instead of o(n^2).   }
  6018. {                                                                              }
  6019. Function Intersection (const V1, V2 : SingleArray; const IsSortedAscending : Boolean) : SingleArray;
  6020. var I, J, L, LV : Integer;
  6021.   Begin
  6022.     SetLength (Result, 0);
  6023.     if IsSortedAscending then
  6024.       begin
  6025.         I := 0;
  6026.         J := 0;
  6027.         L := Length (V1);
  6028.         LV := Length (V2);
  6029.         While (I < L) and (J < LV) do
  6030.           begin
  6031.             While (I < L) and (V1 [I] < V2 [J]) do
  6032.               Inc (I);
  6033.             if I < L then
  6034.               begin
  6035.                 if V1 [I] = V2 [J] then
  6036.                   Append (Result, V1 [I]);
  6037.                 While (J < LV) and (V2 [J] <= V1 [I]) do
  6038.                   Inc (J);
  6039.               end;
  6040.           end;
  6041.       end else
  6042.       For I := 0 to Length (V1) - 1 do
  6043.         if (PosNext (V1 [I], V2) >= 0) and (PosNext (V1 [I], Result) = -1) then
  6044.           Append (Result, V1 [I]);
  6045.   End;
  6046.  
  6047. Function Intersection (const V1, V2 : DoubleArray; const IsSortedAscending : Boolean) : DoubleArray;
  6048. var I, J, L, LV : Integer;
  6049.   Begin
  6050.     SetLength (Result, 0);
  6051.     if IsSortedAscending then
  6052.       begin
  6053.         I := 0;
  6054.         J := 0;
  6055.         L := Length (V1);
  6056.         LV := Length (V2);
  6057.         While (I < L) and (J < LV) do
  6058.           begin
  6059.             While (I < L) and (V1 [I] < V2 [J]) do
  6060.               Inc (I);
  6061.             if I < L then
  6062.               begin
  6063.                 if V1 [I] = V2 [J] then
  6064.                   Append (Result, V1 [I]);
  6065.                 While (J < LV) and (V2 [J] <= V1 [I]) do
  6066.                   Inc (J);
  6067.               end;
  6068.           end;
  6069.       end else
  6070.       For I := 0 to Length (V1) - 1 do
  6071.         if (PosNext (V1 [I], V2) >= 0) and (PosNext (V1 [I], Result) = -1) then
  6072.           Append (Result, V1 [I]);
  6073.   End;
  6074.  
  6075. Function Intersection (const V1, V2 : ExtendedArray; const IsSortedAscending : Boolean) : ExtendedArray;
  6076. var I, J, L, LV : Integer;
  6077.   Begin
  6078.     SetLength (Result, 0);
  6079.     if IsSortedAscending then
  6080.       begin
  6081.         I := 0;
  6082.         J := 0;
  6083.         L := Length (V1);
  6084.         LV := Length (V2);
  6085.         While (I < L) and (J < LV) do
  6086.           begin
  6087.             While (I < L) and (V1 [I] < V2 [J]) do
  6088.               Inc (I);
  6089.             if I < L then
  6090.               begin
  6091.                 if V1 [I] = V2 [J] then
  6092.                   Append (Result, V1 [I]);
  6093.                 While (J < LV) and (V2 [J] <= V1 [I]) do
  6094.                   Inc (J);
  6095.               end;
  6096.           end;
  6097.       end else
  6098.       For I := 0 to Length (V1) - 1 do
  6099.         if (PosNext (V1 [I], V2) >= 0) and (PosNext (V1 [I], Result) = -1) then
  6100.           Append (Result, V1 [I]);
  6101.   End;
  6102.  
  6103. Function Intersection (const V1, V2 : ByteArray; const IsSortedAscending : Boolean) : ByteArray;
  6104. var I, J, L, LV : Integer;
  6105.   Begin
  6106.     SetLength (Result, 0);
  6107.     if IsSortedAscending then
  6108.       begin
  6109.         I := 0;
  6110.         J := 0;
  6111.         L := Length (V1);
  6112.         LV := Length (V2);
  6113.         While (I < L) and (J < LV) do
  6114.           begin
  6115.             While (I < L) and (V1 [I] < V2 [J]) do
  6116.               Inc (I);
  6117.             if I < L then
  6118.               begin
  6119.                 if V1 [I] = V2 [J] then
  6120.                   Append (Result, V1 [I]);
  6121.                 While (J < LV) and (V2 [J] <= V1 [I]) do
  6122.                   Inc (J);
  6123.               end;
  6124.           end;
  6125.       end else
  6126.       For I := 0 to Length (V1) - 1 do
  6127.         if (PosNext (V1 [I], V2) >= 0) and (PosNext (V1 [I], Result) = -1) then
  6128.           Append (Result, V1 [I]);
  6129.   End;
  6130.  
  6131. Function Intersection (const V1, V2 : WordArray; const IsSortedAscending : Boolean) : WordArray;
  6132. var I, J, L, LV : Integer;
  6133.   Begin
  6134.     SetLength (Result, 0);
  6135.     if IsSortedAscending then
  6136.       begin
  6137.         I := 0;
  6138.         J := 0;
  6139.         L := Length (V1);
  6140.         LV := Length (V2);
  6141.         While (I < L) and (J < LV) do
  6142.           begin
  6143.             While (I < L) and (V1 [I] < V2 [J]) do
  6144.               Inc (I);
  6145.             if I < L then
  6146.               begin
  6147.                 if V1 [I] = V2 [J] then
  6148.                   Append (Result, V1 [I]);
  6149.                 While (J < LV) and (V2 [J] <= V1 [I]) do
  6150.                   Inc (J);
  6151.               end;
  6152.           end;
  6153.       end else
  6154.       For I := 0 to Length (V1) - 1 do
  6155.         if (PosNext (V1 [I], V2) >= 0) and (PosNext (V1 [I], Result) = -1) then
  6156.           Append (Result, V1 [I]);
  6157.   End;
  6158.  
  6159. Function Intersection (const V1, V2 : LongWordArray; const IsSortedAscending : Boolean) : LongWordArray;
  6160. var I, J, L, LV : Integer;
  6161.   Begin
  6162.     SetLength (Result, 0);
  6163.     if IsSortedAscending then
  6164.       begin
  6165.         I := 0;
  6166.         J := 0;
  6167.         L := Length (V1);
  6168.         LV := Length (V2);
  6169.         While (I < L) and (J < LV) do
  6170.           begin
  6171.             While (I < L) and (V1 [I] < V2 [J]) do
  6172.               Inc (I);
  6173.             if I < L then
  6174.               begin
  6175.                 if V1 [I] = V2 [J] then
  6176.                   Append (Result, V1 [I]);
  6177.                 While (J < LV) and (V2 [J] <= V1 [I]) do
  6178.                   Inc (J);
  6179.               end;
  6180.           end;
  6181.       end else
  6182.       For I := 0 to Length (V1) - 1 do
  6183.         if (PosNext (V1 [I], V2) >= 0) and (PosNext (V1 [I], Result) = -1) then
  6184.           Append (Result, V1 [I]);
  6185.   End;
  6186.  
  6187. Function Intersection (const V1, V2 : ShortIntArray; const IsSortedAscending : Boolean) : ShortIntArray;
  6188. var I, J, L, LV : Integer;
  6189.   Begin
  6190.     SetLength (Result, 0);
  6191.     if IsSortedAscending then
  6192.       begin
  6193.         I := 0;
  6194.         J := 0;
  6195.         L := Length (V1);
  6196.         LV := Length (V2);
  6197.         While (I < L) and (J < LV) do
  6198.           begin
  6199.             While (I < L) and (V1 [I] < V2 [J]) do
  6200.               Inc (I);
  6201.             if I < L then
  6202.               begin
  6203.                 if V1 [I] = V2 [J] then
  6204.                   Append (Result, V1 [I]);
  6205.                 While (J < LV) and (V2 [J] <= V1 [I]) do
  6206.                   Inc (J);
  6207.               end;
  6208.           end;
  6209.       end else
  6210.       For I := 0 to Length (V1) - 1 do
  6211.         if (PosNext (V1 [I], V2) >= 0) and (PosNext (V1 [I], Result) = -1) then
  6212.           Append (Result, V1 [I]);
  6213.   End;
  6214.  
  6215. Function Intersection (const V1, V2 : SmallIntArray; const IsSortedAscending : Boolean) : SmallIntArray;
  6216. var I, J, L, LV : Integer;
  6217.   Begin
  6218.     SetLength (Result, 0);
  6219.     if IsSortedAscending then
  6220.       begin
  6221.         I := 0;
  6222.         J := 0;
  6223.         L := Length (V1);
  6224.         LV := Length (V2);
  6225.         While (I < L) and (J < LV) do
  6226.           begin
  6227.             While (I < L) and (V1 [I] < V2 [J]) do
  6228.               Inc (I);
  6229.             if I < L then
  6230.               begin
  6231.                 if V1 [I] = V2 [J] then
  6232.                   Append (Result, V1 [I]);
  6233.                 While (J < LV) and (V2 [J] <= V1 [I]) do
  6234.                   Inc (J);
  6235.               end;
  6236.           end;
  6237.       end else
  6238.       For I := 0 to Length (V1) - 1 do
  6239.         if (PosNext (V1 [I], V2) >= 0) and (PosNext (V1 [I], Result) = -1) then
  6240.           Append (Result, V1 [I]);
  6241.   End;
  6242.  
  6243. Function Intersection (const V1, V2 : LongIntArray; const IsSortedAscending : Boolean) : LongIntArray;
  6244. var I, J, L, LV : Integer;
  6245.   Begin
  6246.     SetLength (Result, 0);
  6247.     if IsSortedAscending then
  6248.       begin
  6249.         I := 0;
  6250.         J := 0;
  6251.         L := Length (V1);
  6252.         LV := Length (V2);
  6253.         While (I < L) and (J < LV) do
  6254.           begin
  6255.             While (I < L) and (V1 [I] < V2 [J]) do
  6256.               Inc (I);
  6257.             if I < L then
  6258.               begin
  6259.                 if V1 [I] = V2 [J] then
  6260.                   Append (Result, V1 [I]);
  6261.                 While (J < LV) and (V2 [J] <= V1 [I]) do
  6262.                   Inc (J);
  6263.               end;
  6264.           end;
  6265.       end else
  6266.       For I := 0 to Length (V1) - 1 do
  6267.         if (PosNext (V1 [I], V2) >= 0) and (PosNext (V1 [I], Result) = -1) then
  6268.           Append (Result, V1 [I]);
  6269.   End;
  6270.  
  6271. Function Intersection (const V1, V2 : Int64Array; const IsSortedAscending : Boolean) : Int64Array;
  6272. var I, J, L, LV : Integer;
  6273.   Begin
  6274.     SetLength (Result, 0);
  6275.     if IsSortedAscending then
  6276.       begin
  6277.         I := 0;
  6278.         J := 0;
  6279.         L := Length (V1);
  6280.         LV := Length (V2);
  6281.         While (I < L) and (J < LV) do
  6282.           begin
  6283.             While (I < L) and (V1 [I] < V2 [J]) do
  6284.               Inc (I);
  6285.             if I < L then
  6286.               begin
  6287.                 if V1 [I] = V2 [J] then
  6288.                   Append (Result, V1 [I]);
  6289.                 While (J < LV) and (V2 [J] <= V1 [I]) do
  6290.                   Inc (J);
  6291.               end;
  6292.           end;
  6293.       end else
  6294.       For I := 0 to Length (V1) - 1 do
  6295.         if (PosNext (V1 [I], V2) >= 0) and (PosNext (V1 [I], Result) = -1) then
  6296.           Append (Result, V1 [I]);
  6297.   End;
  6298.  
  6299. Function Intersection (const V1, V2 : StringArray; const IsSortedAscending : Boolean) : StringArray;
  6300. var I, J, L, LV : Integer;
  6301.   Begin
  6302.     SetLength (Result, 0);
  6303.     if IsSortedAscending then
  6304.       begin
  6305.         I := 0;
  6306.         J := 0;
  6307.         L := Length (V1);
  6308.         LV := Length (V2);
  6309.         While (I < L) and (J < LV) do
  6310.           begin
  6311.             While (I < L) and (V1 [I] < V2 [J]) do
  6312.               Inc (I);
  6313.             if I < L then
  6314.               begin
  6315.                 if V1 [I] = V2 [J] then
  6316.                   Append (Result, V1 [I]);
  6317.                 While (J < LV) and (V2 [J] <= V1 [I]) do
  6318.                   Inc (J);
  6319.               end;
  6320.           end;
  6321.       end else
  6322.       For I := 0 to Length (V1) - 1 do
  6323.         if (PosNext (V1 [I], V2) >= 0) and (PosNext (V1 [I], Result) = -1) then
  6324.           Append (Result, V1 [I]);
  6325.   End;
  6326.  
  6327.  
  6328.  
  6329. {                                                                              }
  6330. { Difference                                                                   }
  6331. {   Returns elements in V1 but not in V2.                                      }
  6332. {   If both arrays are sorted ascending then time is o(n) instead of o(n^2).   }
  6333. {                                                                              }
  6334. Function Difference (const V1, V2 : SingleArray; const IsSortedAscending : Boolean) : SingleArray;
  6335. var I, J, L, LV : Integer;
  6336.   Begin
  6337.     SetLength (Result, 0);
  6338.     if IsSortedAscending then
  6339.       begin
  6340.         I := 0;
  6341.         J := 0;
  6342.         L := Length (V1);
  6343.         LV := Length (V2);
  6344.         While (I < L) and (J < LV) do
  6345.           begin
  6346.             While (I < L) and (V1 [I] < V2 [J]) do
  6347.               Inc (I);
  6348.             if I < L then
  6349.               begin
  6350.                 if V1 [I] <> V2 [J] then
  6351.                   Append (Result, V1 [I]);
  6352.                 While (J < LV) and (V2 [J] <= V1 [I]) do
  6353.                   Inc (J);
  6354.               end;
  6355.           end;
  6356.       end else
  6357.       For I := 0 to Length (V1) - 1 do
  6358.         if (PosNext (V1 [I], V2) = -1) and (PosNext (V1 [I], Result) = -1) then
  6359.           Append (Result, V1 [I]);
  6360.   End;
  6361.  
  6362. Function Difference (const V1, V2 : DoubleArray; const IsSortedAscending : Boolean) : DoubleArray;
  6363. var I, J, L, LV : Integer;
  6364.   Begin
  6365.     SetLength (Result, 0);
  6366.     if IsSortedAscending then
  6367.       begin
  6368.         I := 0;
  6369.         J := 0;
  6370.         L := Length (V1);
  6371.         LV := Length (V2);
  6372.         While (I < L) and (J < LV) do
  6373.           begin
  6374.             While (I < L) and (V1 [I] < V2 [J]) do
  6375.               Inc (I);
  6376.             if I < L then
  6377.               begin
  6378.                 if V1 [I] <> V2 [J] then
  6379.                   Append (Result, V1 [I]);
  6380.                 While (J < LV) and (V2 [J] <= V1 [I]) do
  6381.                   Inc (J);
  6382.               end;
  6383.           end;
  6384.       end else
  6385.       For I := 0 to Length (V1) - 1 do
  6386.         if (PosNext (V1 [I], V2) = -1) and (PosNext (V1 [I], Result) = -1) then
  6387.           Append (Result, V1 [I]);
  6388.   End;
  6389.  
  6390. Function Difference (const V1, V2 : ExtendedArray; const IsSortedAscending : Boolean) : ExtendedArray;
  6391. var I, J, L, LV : Integer;
  6392.   Begin
  6393.     SetLength (Result, 0);
  6394.     if IsSortedAscending then
  6395.       begin
  6396.         I := 0;
  6397.         J := 0;
  6398.         L := Length (V1);
  6399.         LV := Length (V2);
  6400.         While (I < L) and (J < LV) do
  6401.           begin
  6402.             While (I < L) and (V1 [I] < V2 [J]) do
  6403.               Inc (I);
  6404.             if I < L then
  6405.               begin
  6406.                 if V1 [I] <> V2 [J] then
  6407.                   Append (Result, V1 [I]);
  6408.                 While (J < LV) and (V2 [J] <= V1 [I]) do
  6409.                   Inc (J);
  6410.               end;
  6411.           end;
  6412.       end else
  6413.       For I := 0 to Length (V1) - 1 do
  6414.         if (PosNext (V1 [I], V2) = -1) and (PosNext (V1 [I], Result) = -1) then
  6415.           Append (Result, V1 [I]);
  6416.   End;
  6417.  
  6418. Function Difference (const V1, V2 : ByteArray; const IsSortedAscending : Boolean) : ByteArray;
  6419. var I, J, L, LV : Integer;
  6420.   Begin
  6421.     SetLength (Result, 0);
  6422.     if IsSortedAscending then
  6423.       begin
  6424.         I := 0;
  6425.         J := 0;
  6426.         L := Length (V1);
  6427.         LV := Length (V2);
  6428.         While (I < L) and (J < LV) do
  6429.           begin
  6430.             While (I < L) and (V1 [I] < V2 [J]) do
  6431.               Inc (I);
  6432.             if I < L then
  6433.               begin
  6434.                 if V1 [I] <> V2 [J] then
  6435.                   Append (Result, V1 [I]);
  6436.                 While (J < LV) and (V2 [J] <= V1 [I]) do
  6437.                   Inc (J);
  6438.               end;
  6439.           end;
  6440.       end else
  6441.       For I := 0 to Length (V1) - 1 do
  6442.         if (PosNext (V1 [I], V2) = -1) and (PosNext (V1 [I], Result) = -1) then
  6443.           Append (Result, V1 [I]);
  6444.   End;
  6445.  
  6446. Function Difference (const V1, V2 : WordArray; const IsSortedAscending : Boolean) : WordArray;
  6447. var I, J, L, LV : Integer;
  6448.   Begin
  6449.     SetLength (Result, 0);
  6450.     if IsSortedAscending then
  6451.       begin
  6452.         I := 0;
  6453.         J := 0;
  6454.         L := Length (V1);
  6455.         LV := Length (V2);
  6456.         While (I < L) and (J < LV) do
  6457.           begin
  6458.             While (I < L) and (V1 [I] < V2 [J]) do
  6459.               Inc (I);
  6460.             if I < L then
  6461.               begin
  6462.                 if V1 [I] <> V2 [J] then
  6463.                   Append (Result, V1 [I]);
  6464.                 While (J < LV) and (V2 [J] <= V1 [I]) do
  6465.                   Inc (J);
  6466.               end;
  6467.           end;
  6468.       end else
  6469.       For I := 0 to Length (V1) - 1 do
  6470.         if (PosNext (V1 [I], V2) = -1) and (PosNext (V1 [I], Result) = -1) then
  6471.           Append (Result, V1 [I]);
  6472.   End;
  6473.  
  6474. Function Difference (const V1, V2 : LongWordArray; const IsSortedAscending : Boolean) : LongWordArray;
  6475. var I, J, L, LV : Integer;
  6476.   Begin
  6477.     SetLength (Result, 0);
  6478.     if IsSortedAscending then
  6479.       begin
  6480.         I := 0;
  6481.         J := 0;
  6482.         L := Length (V1);
  6483.         LV := Length (V2);
  6484.         While (I < L) and (J < LV) do
  6485.           begin
  6486.             While (I < L) and (V1 [I] < V2 [J]) do
  6487.               Inc (I);
  6488.             if I < L then
  6489.               begin
  6490.                 if V1 [I] <> V2 [J] then
  6491.                   Append (Result, V1 [I]);
  6492.                 While (J < LV) and (V2 [J] <= V1 [I]) do
  6493.                   Inc (J);
  6494.               end;
  6495.           end;
  6496.       end else
  6497.       For I := 0 to Length (V1) - 1 do
  6498.         if (PosNext (V1 [I], V2) = -1) and (PosNext (V1 [I], Result) = -1) then
  6499.           Append (Result, V1 [I]);
  6500.   End;
  6501.  
  6502. Function Difference (const V1, V2 : ShortIntArray; const IsSortedAscending : Boolean) : ShortIntArray;
  6503. var I, J, L, LV : Integer;
  6504.   Begin
  6505.     SetLength (Result, 0);
  6506.     if IsSortedAscending then
  6507.       begin
  6508.         I := 0;
  6509.         J := 0;
  6510.         L := Length (V1);
  6511.         LV := Length (V2);
  6512.         While (I < L) and (J < LV) do
  6513.           begin
  6514.             While (I < L) and (V1 [I] < V2 [J]) do
  6515.               Inc (I);
  6516.             if I < L then
  6517.               begin
  6518.                 if V1 [I] <> V2 [J] then
  6519.                   Append (Result, V1 [I]);
  6520.                 While (J < LV) and (V2 [J] <= V1 [I]) do
  6521.                   Inc (J);
  6522.               end;
  6523.           end;
  6524.       end else
  6525.       For I := 0 to Length (V1) - 1 do
  6526.         if (PosNext (V1 [I], V2) = -1) and (PosNext (V1 [I], Result) = -1) then
  6527.           Append (Result, V1 [I]);
  6528.   End;
  6529.  
  6530. Function Difference (const V1, V2 : SmallIntArray; const IsSortedAscending : Boolean) : SmallIntArray;
  6531. var I, J, L, LV : Integer;
  6532.   Begin
  6533.     SetLength (Result, 0);
  6534.     if IsSortedAscending then
  6535.       begin
  6536.         I := 0;
  6537.         J := 0;
  6538.         L := Length (V1);
  6539.         LV := Length (V2);
  6540.         While (I < L) and (J < LV) do
  6541.           begin
  6542.             While (I < L) and (V1 [I] < V2 [J]) do
  6543.               Inc (I);
  6544.             if I < L then
  6545.               begin
  6546.                 if V1 [I] <> V2 [J] then
  6547.                   Append (Result, V1 [I]);
  6548.                 While (J < LV) and (V2 [J] <= V1 [I]) do
  6549.                   Inc (J);
  6550.               end;
  6551.           end;
  6552.       end else
  6553.       For I := 0 to Length (V1) - 1 do
  6554.         if (PosNext (V1 [I], V2) = -1) and (PosNext (V1 [I], Result) = -1) then
  6555.           Append (Result, V1 [I]);
  6556.   End;
  6557.  
  6558. Function Difference (const V1, V2 : LongIntArray; const IsSortedAscending : Boolean) : LongIntArray;
  6559. var I, J, L, LV : Integer;
  6560.   Begin
  6561.     SetLength (Result, 0);
  6562.     if IsSortedAscending then
  6563.       begin
  6564.         I := 0;
  6565.         J := 0;
  6566.         L := Length (V1);
  6567.         LV := Length (V2);
  6568.         While (I < L) and (J < LV) do
  6569.           begin
  6570.             While (I < L) and (V1 [I] < V2 [J]) do
  6571.               Inc (I);
  6572.             if I < L then
  6573.               begin
  6574.                 if V1 [I] <> V2 [J] then
  6575.                   Append (Result, V1 [I]);
  6576.                 While (J < LV) and (V2 [J] <= V1 [I]) do
  6577.                   Inc (J);
  6578.               end;
  6579.           end;
  6580.       end else
  6581.       For I := 0 to Length (V1) - 1 do
  6582.         if (PosNext (V1 [I], V2) = -1) and (PosNext (V1 [I], Result) = -1) then
  6583.           Append (Result, V1 [I]);
  6584.   End;
  6585.  
  6586. Function Difference (const V1, V2 : Int64Array; const IsSortedAscending : Boolean) : Int64Array;
  6587. var I, J, L, LV : Integer;
  6588.   Begin
  6589.     SetLength (Result, 0);
  6590.     if IsSortedAscending then
  6591.       begin
  6592.         I := 0;
  6593.         J := 0;
  6594.         L := Length (V1);
  6595.         LV := Length (V2);
  6596.         While (I < L) and (J < LV) do
  6597.           begin
  6598.             While (I < L) and (V1 [I] < V2 [J]) do
  6599.               Inc (I);
  6600.             if I < L then
  6601.               begin
  6602.                 if V1 [I] <> V2 [J] then
  6603.                   Append (Result, V1 [I]);
  6604.                 While (J < LV) and (V2 [J] <= V1 [I]) do
  6605.                   Inc (J);
  6606.               end;
  6607.           end;
  6608.       end else
  6609.       For I := 0 to Length (V1) - 1 do
  6610.         if (PosNext (V1 [I], V2) = -1) and (PosNext (V1 [I], Result) = -1) then
  6611.           Append (Result, V1 [I]);
  6612.   End;
  6613.  
  6614. Function Difference (const V1, V2 : StringArray; const IsSortedAscending : Boolean) : StringArray;
  6615. var I, J, L, LV : Integer;
  6616.   Begin
  6617.     SetLength (Result, 0);
  6618.     if IsSortedAscending then
  6619.       begin
  6620.         I := 0;
  6621.         J := 0;
  6622.         L := Length (V1);
  6623.         LV := Length (V2);
  6624.         While (I < L) and (J < LV) do
  6625.           begin
  6626.             While (I < L) and (V1 [I] < V2 [J]) do
  6627.               Inc (I);
  6628.             if I < L then
  6629.               begin
  6630.                 if V1 [I] <> V2 [J] then
  6631.                   Append (Result, V1 [I]);
  6632.                 While (J < LV) and (V2 [J] <= V1 [I]) do
  6633.                   Inc (J);
  6634.               end;
  6635.           end;
  6636.       end else
  6637.       For I := 0 to Length (V1) - 1 do
  6638.         if (PosNext (V1 [I], V2) = -1) and (PosNext (V1 [I], Result) = -1) then
  6639.           Append (Result, V1 [I]);
  6640.   End;
  6641.  
  6642.  
  6643.  
  6644. {                                                                              }
  6645. { Reverse                                                                      }
  6646. {                                                                              }
  6647. Procedure Reverse (var V : ByteArray);
  6648. var I, L : Integer;
  6649.   Begin
  6650.     L := Length (V);
  6651.     For I := 1 to L div 2 do
  6652.       Swap (V [I - 1], V [L - I]);
  6653.   End;
  6654.  
  6655. Procedure Reverse (var V : WordArray);
  6656. var I, L : Integer;
  6657.   Begin
  6658.     L := Length (V);
  6659.     For I := 1 to L div 2 do
  6660.       Swap (V [I - 1], V [L - I]);
  6661.   End;
  6662.  
  6663. Procedure Reverse (var V : LongWordArray);
  6664. var I, L : Integer;
  6665.   Begin
  6666.     L := Length (V);
  6667.     For I := 1 to L div 2 do
  6668.       Swap (V [I - 1], V [L - I]);
  6669.   End;
  6670.  
  6671. Procedure Reverse (var V : ShortIntArray);
  6672. var I, L : Integer;
  6673.   Begin
  6674.     L := Length (V);
  6675.     For I := 1 to L div 2 do
  6676.       Swap (V [I - 1], V [L - I]);
  6677.   End;
  6678.  
  6679. Procedure Reverse (var V : SmallIntArray);
  6680. var I, L : Integer;
  6681.   Begin
  6682.     L := Length (V);
  6683.     For I := 1 to L div 2 do
  6684.       Swap (V [I - 1], V [L - I]);
  6685.   End;
  6686.  
  6687. Procedure Reverse (var V : LongIntArray);
  6688. var I, L : Integer;
  6689.   Begin
  6690.     L := Length (V);
  6691.     For I := 1 to L div 2 do
  6692.       Swap (V [I - 1], V [L - I]);
  6693.   End;
  6694.  
  6695. Procedure Reverse (var V : Int64Array);
  6696. var I, L : Integer;
  6697.   Begin
  6698.     L := Length (V);
  6699.     For I := 1 to L div 2 do
  6700.       Swap (V [I - 1], V [L - I]);
  6701.   End;
  6702.  
  6703. Procedure Reverse (var V : StringArray);
  6704. var I, L : Integer;
  6705.   Begin
  6706.     L := Length (V);
  6707.     For I := 1 to L div 2 do
  6708.       Swap (V [I - 1], V [L - I]);
  6709.   End;
  6710.  
  6711. Procedure Reverse (var V : PointerArray);
  6712. var I, L : Integer;
  6713.   Begin
  6714.     L := Length (V);
  6715.     For I := 1 to L div 2 do
  6716.       Swap (V [I - 1], V [L - I]);
  6717.   End;
  6718.  
  6719. Procedure Reverse (var V : ObjectArray);
  6720. var I, L : Integer;
  6721.   Begin
  6722.     L := Length (V);
  6723.     For I := 1 to L div 2 do
  6724.       Swap (V [I - 1], V [L - I]);
  6725.   End;
  6726.  
  6727. Procedure Reverse (var V : SingleArray);
  6728. var I, L : Integer;
  6729.   Begin
  6730.     L := Length (V);
  6731.     For I := 1 to L div 2 do
  6732.       Swap (V [I - 1], V [L - I]);
  6733.   End;
  6734.  
  6735. Procedure Reverse (var V : DoubleArray);
  6736. var I, L : Integer;
  6737.   Begin
  6738.     L := Length (V);
  6739.     For I := 1 to L div 2 do
  6740.       Swap (V [I - 1], V [L - I]);
  6741.   End;
  6742.  
  6743. Procedure Reverse (var V : ExtendedArray);
  6744. var I, L : Integer;
  6745.   Begin
  6746.     L := Length (V);
  6747.     For I := 1 to L div 2 do
  6748.       Swap (V [I - 1], V [L - I]);
  6749.   End;
  6750.  
  6751.  
  6752.  
  6753. {                                                                              }
  6754. { Returns an open array (V) as a dynamic array.                                }
  6755. {                                                                              }
  6756. Function AsBooleanArray (const V : Array of Boolean) : BooleanArray;
  6757. var I : Integer;
  6758.   Begin
  6759.     SetLength (Result, High (V) + 1);
  6760.     For I := 0 to High (V) do
  6761.       Result [I] := V [I];
  6762.   End;
  6763.  
  6764. Function AsByteArray (const V : Array of Byte) : ByteArray;
  6765. var I : Integer;
  6766.   Begin
  6767.     SetLength (Result, High (V) + 1);
  6768.     For I := 0 to High (V) do
  6769.       Result [I] := V [I];
  6770.   End;
  6771.  
  6772. Function AsWordArray (const V : Array of Word) : WordArray;
  6773. var I : Integer;
  6774.   Begin
  6775.     SetLength (Result, High (V) + 1);
  6776.     For I := 0 to High (V) do
  6777.       Result [I] := V [I];
  6778.   End;
  6779.  
  6780. Function AsLongWordArray (const V : Array of LongWord) : LongWordArray;
  6781. var I : Integer;
  6782.   Begin
  6783.     SetLength (Result, High (V) + 1);
  6784.     For I := 0 to High (V) do
  6785.       Result [I] := V [I];
  6786.   End;
  6787.  
  6788. Function AsCardinalArray (const V : Array of Cardinal) : CardinalArray;
  6789. var I : Integer;
  6790.   Begin
  6791.     SetLength (Result, High (V) + 1);
  6792.     For I := 0 to High (V) do
  6793.       Result [I] := V [I];
  6794.   End;
  6795.  
  6796. Function AsShortIntArray (const V : Array of ShortInt) : ShortIntArray;
  6797. var I : Integer;
  6798.   Begin
  6799.     SetLength (Result, High (V) + 1);
  6800.     For I := 0 to High (V) do
  6801.       Result [I] := V [I];
  6802.   End;
  6803.  
  6804. Function AsSmallIntArray (const V : Array of SmallInt) : SmallIntArray;
  6805. var I : Integer;
  6806.   Begin
  6807.     SetLength (Result, High (V) + 1);
  6808.     For I := 0 to High (V) do
  6809.       Result [I] := V [I];
  6810.   End;
  6811.  
  6812. Function AsLongIntArray (const V : Array of LongInt) : LongIntArray;
  6813. var I : Integer;
  6814.   Begin
  6815.     SetLength (Result, High (V) + 1);
  6816.     For I := 0 to High (V) do
  6817.       Result [I] := V [I];
  6818.   End;
  6819.  
  6820. Function AsIntegerArray (const V : Array of Integer) : IntegerArray;
  6821. var I : Integer;
  6822.   Begin
  6823.     SetLength (Result, High (V) + 1);
  6824.     For I := 0 to High (V) do
  6825.       Result [I] := V [I];
  6826.   End;
  6827.  
  6828. Function AsInt64Array (const V : Array of Int64) : Int64Array;
  6829. var I : Integer;
  6830.   Begin
  6831.     SetLength (Result, High (V) + 1);
  6832.     For I := 0 to High (V) do
  6833.       Result [I] := V [I];
  6834.   End;
  6835.  
  6836. Function AsSingleArray (const V : Array of Single) : SingleArray;
  6837. var I : Integer;
  6838.   Begin
  6839.     SetLength (Result, High (V) + 1);
  6840.     For I := 0 to High (V) do
  6841.       Result [I] := V [I];
  6842.   End;
  6843.  
  6844. Function AsDoubleArray (const V : Array of Double) : DoubleArray;
  6845. var I : Integer;
  6846.   Begin
  6847.     SetLength (Result, High (V) + 1);
  6848.     For I := 0 to High (V) do
  6849.       Result [I] := V [I];
  6850.   End;
  6851.  
  6852. Function AsExtendedArray (const V : Array of Extended) : ExtendedArray;
  6853. var I : Integer;
  6854.   Begin
  6855.     SetLength (Result, High (V) + 1);
  6856.     For I := 0 to High (V) do
  6857.       Result [I] := V [I];
  6858.   End;
  6859.  
  6860. Function AsStringArray (const V : Array of String) : StringArray;
  6861. var I : Integer;
  6862.   Begin
  6863.     SetLength (Result, High (V) + 1);
  6864.     For I := 0 to High (V) do
  6865.       Result [I] := V [I];
  6866.   End;
  6867.  
  6868. Function AsPointerArray (const V : Array of Pointer) : PointerArray;
  6869. var I : Integer;
  6870.   Begin
  6871.     SetLength (Result, High (V) + 1);
  6872.     For I := 0 to High (V) do
  6873.       Result [I] := V [I];
  6874.   End;
  6875.  
  6876. Function AsCharSetArray (const V : Array of CharSet) : CharSetArray;
  6877. var I : Integer;
  6878.   Begin
  6879.     SetLength (Result, High (V) + 1);
  6880.     For I := 0 to High (V) do
  6881.       Result [I] := V [I];
  6882.   End;
  6883.  
  6884. Function AsObjectArray (const V : Array of TObject) : ObjectArray;
  6885. var I : Integer;
  6886.   Begin
  6887.     SetLength (Result, High (V) + 1);
  6888.     For I := 0 to High (V) do
  6889.       Result [I] := V [I];
  6890.   End;
  6891.  
  6892.  
  6893.  
  6894. Function RangeByte (const First : Byte; const Count : Integer; const Increment : Byte) : ByteArray;
  6895. var I : Integer;
  6896.     J : Byte;
  6897.   Begin
  6898.     SetLength (Result, Count);
  6899.     J := First;
  6900.     For I := 0 to Count - 1 do
  6901.       begin
  6902.         Result [I] := J;
  6903.         J := J + Increment;
  6904.       end;
  6905.   End;
  6906.  
  6907. Function RangeWord (const First : Word; const Count : Integer; const Increment : Word) : WordArray;
  6908. var I : Integer;
  6909.     J : Word;
  6910.   Begin
  6911.     SetLength (Result, Count);
  6912.     J := First;
  6913.     For I := 0 to Count - 1 do
  6914.       begin
  6915.         Result [I] := J;
  6916.         J := J + Increment;
  6917.       end;
  6918.   End;
  6919.  
  6920. Function RangeLongWord (const First : LongWord; const Count : Integer; const Increment : LongWord) : LongWordArray;
  6921. var I : Integer;
  6922.     J : LongWord;
  6923.   Begin
  6924.     SetLength (Result, Count);
  6925.     J := First;
  6926.     For I := 0 to Count - 1 do
  6927.       begin
  6928.         Result [I] := J;
  6929.         J := J + Increment;
  6930.       end;
  6931.   End;
  6932.  
  6933. Function RangeCardinal (const First : Cardinal; const Count : Integer; const Increment : Cardinal) : CardinalArray;
  6934. var I : Integer;
  6935.     J : Cardinal;
  6936.   Begin
  6937.     SetLength (Result, Count);
  6938.     J := First;
  6939.     For I := 0 to Count - 1 do
  6940.       begin
  6941.         Result [I] := J;
  6942.         J := J + Increment;
  6943.       end;
  6944.   End;
  6945.  
  6946. Function RangeShortInt (const First : ShortInt; const Count : Integer; const Increment : ShortInt) : ShortIntArray;
  6947. var I : Integer;
  6948.     J : ShortInt;
  6949.   Begin
  6950.     SetLength (Result, Count);
  6951.     J := First;
  6952.     For I := 0 to Count - 1 do
  6953.       begin
  6954.         Result [I] := J;
  6955.         J := J + Increment;
  6956.       end;
  6957.   End;
  6958.  
  6959. Function RangeSmallInt (const First : SmallInt; const Count : Integer; const Increment : SmallInt) : SmallIntArray;
  6960. var I : Integer;
  6961.     J : SmallInt;
  6962.   Begin
  6963.     SetLength (Result, Count);
  6964.     J := First;
  6965.     For I := 0 to Count - 1 do
  6966.       begin
  6967.         Result [I] := J;
  6968.         J := J + Increment;
  6969.       end;
  6970.   End;
  6971.  
  6972. Function RangeLongInt (const First : LongInt; const Count : Integer; const Increment : LongInt) : LongIntArray;
  6973. var I : Integer;
  6974.     J : LongInt;
  6975.   Begin
  6976.     SetLength (Result, Count);
  6977.     J := First;
  6978.     For I := 0 to Count - 1 do
  6979.       begin
  6980.         Result [I] := J;
  6981.         J := J + Increment;
  6982.       end;
  6983.   End;
  6984.  
  6985. Function RangeInteger (const First : Integer; const Count : Integer; const Increment : Integer) : IntegerArray;
  6986. var I : Integer;
  6987.     J : Integer;
  6988.   Begin
  6989.     SetLength (Result, Count);
  6990.     J := First;
  6991.     For I := 0 to Count - 1 do
  6992.       begin
  6993.         Result [I] := J;
  6994.         J := J + Increment;
  6995.       end;
  6996.   End;
  6997.  
  6998. Function RangeInt64 (const First : Int64; const Count : Integer; const Increment : Int64) : Int64Array;
  6999. var I : Integer;
  7000.     J : Int64;
  7001.   Begin
  7002.     SetLength (Result, Count);
  7003.     J := First;
  7004.     For I := 0 to Count - 1 do
  7005.       begin
  7006.         Result [I] := J;
  7007.         J := J + Increment;
  7008.       end;
  7009.   End;
  7010.  
  7011. Function RangeSingle (const First : Single; const Count : Integer; const Increment : Single) : SingleArray;
  7012. var I : Integer;
  7013.     J : Single;
  7014.   Begin
  7015.     SetLength (Result, Count);
  7016.     J := First;
  7017.     For I := 0 to Count - 1 do
  7018.       begin
  7019.         Result [I] := J;
  7020.         J := J + Increment;
  7021.       end;
  7022.   End;
  7023.  
  7024. Function RangeDouble (const First : Double; const Count : Integer; const Increment : Double) : DoubleArray;
  7025. var I : Integer;
  7026.     J : Double;
  7027.   Begin
  7028.     SetLength (Result, Count);
  7029.     J := First;
  7030.     For I := 0 to Count - 1 do
  7031.       begin
  7032.         Result [I] := J;
  7033.         J := J + Increment;
  7034.       end;
  7035.   End;
  7036.  
  7037. Function RangeExtended (const First : Extended; const Count : Integer; const Increment : Extended) : ExtendedArray;
  7038. var I : Integer;
  7039.     J : Extended;
  7040.   Begin
  7041.     SetLength (Result, Count);
  7042.     J := First;
  7043.     For I := 0 to Count - 1 do
  7044.       begin
  7045.         Result [I] := J;
  7046.         J := J + Increment;
  7047.       end;
  7048.   End;
  7049.  
  7050.  
  7051.  
  7052. {                                                                              }
  7053. { Dup                                                                          }
  7054. {                                                                              }
  7055. Function DupByte (const V : Byte; const Count : Integer) : ByteArray;
  7056.   Begin
  7057.     SetLength (Result, Count);
  7058.     FillChar (Result [0], Count, V);
  7059.   End;
  7060.  
  7061. Function DupWord (const V : Word; const Count : Integer) : WordArray;
  7062. var I : Integer;
  7063.   Begin
  7064.     SetLength (Result, Count);
  7065.     For I := 0 to Count - 1 do
  7066.       Result [I] := V;
  7067.   End;
  7068.  
  7069. Function DupLongWord (const V : LongWord; const Count : Integer) : LongWordArray;
  7070. var I : Integer;
  7071.   Begin
  7072.     SetLength (Result, Count);
  7073.     For I := 0 to Count - 1 do
  7074.       Result [I] := V;
  7075.   End;
  7076.  
  7077. Function DupCardinal (const V : Cardinal; const Count : Integer) : CardinalArray;
  7078. var I : Integer;
  7079.   Begin
  7080.     SetLength (Result, Count);
  7081.     For I := 0 to Count - 1 do
  7082.       Result [I] := V;
  7083.   End;
  7084.  
  7085. Function DupShortInt (const V : ShortInt; const Count : Integer) : ShortIntArray;
  7086. var I : Integer;
  7087.   Begin
  7088.     SetLength (Result, Count);
  7089.     For I := 0 to Count - 1 do
  7090.       Result [I] := V;
  7091.   End;
  7092.  
  7093. Function DupSmallInt (const V : SmallInt; const Count : Integer) : SmallIntArray;
  7094. var I : Integer;
  7095.   Begin
  7096.     SetLength (Result, Count);
  7097.     For I := 0 to Count - 1 do
  7098.       Result [I] := V;
  7099.   End;
  7100.  
  7101. Function DupLongInt (const V : LongInt; const Count : Integer) : LongIntArray;
  7102. var I : Integer;
  7103.   Begin
  7104.     SetLength (Result, Count);
  7105.     For I := 0 to Count - 1 do
  7106.       Result [I] := V;
  7107.   End;
  7108.  
  7109. Function DupInteger (const V : Integer; const Count : Integer) : IntegerArray;
  7110. var I : Integer;
  7111.   Begin
  7112.     SetLength (Result, Count);
  7113.     For I := 0 to Count - 1 do
  7114.       Result [I] := V;
  7115.   End;
  7116.  
  7117. Function DupInt64 (const V : Int64; const Count : Integer) : Int64Array;
  7118. var I : Integer;
  7119.   Begin
  7120.     SetLength (Result, Count);
  7121.     For I := 0 to Count - 1 do
  7122.       Result [I] := V;
  7123.   End;
  7124.  
  7125. Function DupSingle (const V : Single; const Count : Integer) : SingleArray;
  7126. var I : Integer;
  7127.   Begin
  7128.     SetLength (Result, Count);
  7129.     For I := 0 to Count - 1 do
  7130.       Result [I] := V;
  7131.   End;
  7132.  
  7133. Function DupDouble (const V : Double; const Count : Integer) : DoubleArray;
  7134. var I : Integer;
  7135.   Begin
  7136.     SetLength (Result, Count);
  7137.     For I := 0 to Count - 1 do
  7138.       Result [I] := V;
  7139.   End;
  7140.  
  7141. Function DupExtended (const V : Extended; const Count : Integer) : ExtendedArray;
  7142. var I : Integer;
  7143.   Begin
  7144.     SetLength (Result, Count);
  7145.     For I := 0 to Count - 1 do
  7146.       Result [I] := V;
  7147.   End;
  7148.  
  7149. Function DupString (const V : String; const Count : Integer) : StringArray;
  7150. var I : Integer;
  7151.   Begin
  7152.     SetLength (Result, Count);
  7153.     For I := 0 to Count - 1 do
  7154.       Result [I] := V;
  7155.   End;
  7156.  
  7157. Function DupCharSet (const V : CharSet; const Count : Integer) : CharSetArray;
  7158. var I : Integer;
  7159.   Begin
  7160.     SetLength (Result, Count);
  7161.     For I := 0 to Count - 1 do
  7162.       Result [I] := V;
  7163.   End;
  7164.  
  7165. Function DupObject (const V : TObject; const Count : Integer) : ObjectArray;
  7166. var I : Integer;
  7167.   Begin
  7168.     SetLength (Result, Count);
  7169.     For I := 0 to Count - 1 do
  7170.       Result [I] := V;
  7171.   End;
  7172.  
  7173.  
  7174.  
  7175. {                                                                              }
  7176. { SetLengthAndZero                                                             }
  7177. {                                                                              }
  7178. Procedure SetLengthAndZero (var V : ByteArray; const NewLength : Integer);
  7179. var L : Integer;
  7180.   Begin
  7181.     L := Length (V);
  7182.     if L = NewLength then
  7183.       exit;
  7184.     SetLength (V, NewLength);
  7185.     if L > NewLength then
  7186.       exit;
  7187.     FillChar (V [L], Sizeof (Byte) * (NewLength - L), #0);
  7188.   End;
  7189.  
  7190. Procedure SetLengthAndZero (var V : WordArray; const NewLength : Integer);
  7191. var L : Integer;
  7192.   Begin
  7193.     L := Length (V);
  7194.     if L = NewLength then
  7195.       exit;
  7196.     SetLength (V, NewLength);
  7197.     if L > NewLength then
  7198.       exit;
  7199.     FillChar (V [L], Sizeof (Word) * (NewLength - L), #0);
  7200.   End;
  7201.  
  7202. Procedure SetLengthAndZero (var V : LongWordArray; const NewLength : Integer);
  7203. var L : Integer;
  7204.   Begin
  7205.     L := Length (V);
  7206.     if L = NewLength then
  7207.       exit;
  7208.     SetLength (V, NewLength);
  7209.     if L > NewLength then
  7210.       exit;
  7211.     FillChar (V [L], Sizeof (LongWord) * (NewLength - L), #0);
  7212.   End;
  7213.  
  7214. Procedure SetLengthAndZero (var V : ShortIntArray; const NewLength : Integer);
  7215. var L : Integer;
  7216.   Begin
  7217.     L := Length (V);
  7218.     if L = NewLength then
  7219.       exit;
  7220.     SetLength (V, NewLength);
  7221.     if L > NewLength then
  7222.       exit;
  7223.     FillChar (V [L], Sizeof (ShortInt) * (NewLength - L), #0);
  7224.   End;
  7225.  
  7226. Procedure SetLengthAndZero (var V : SmallIntArray; const NewLength : Integer);
  7227. var L : Integer;
  7228.   Begin
  7229.     L := Length (V);
  7230.     if L = NewLength then
  7231.       exit;
  7232.     SetLength (V, NewLength);
  7233.     if L > NewLength then
  7234.       exit;
  7235.     FillChar (V [L], Sizeof (SmallInt) * (NewLength - L), #0);
  7236.   End;
  7237.  
  7238. Procedure SetLengthAndZero (var V : LongIntArray; const NewLength : Integer);
  7239. var L : Integer;
  7240.   Begin
  7241.     L := Length (V);
  7242.     if L = NewLength then
  7243.       exit;
  7244.     SetLength (V, NewLength);
  7245.     if L > NewLength then
  7246.       exit;
  7247.     FillChar (V [L], Sizeof (LongInt) * (NewLength - L), #0);
  7248.   End;
  7249.  
  7250. Procedure SetLengthAndZero (var V : Int64Array; const NewLength : Integer);
  7251. var L : Integer;
  7252.   Begin
  7253.     L := Length (V);
  7254.     if L = NewLength then
  7255.       exit;
  7256.     SetLength (V, NewLength);
  7257.     if L > NewLength then
  7258.       exit;
  7259.     FillChar (V [L], Sizeof (Int64) * (NewLength - L), #0);
  7260.   End;
  7261.  
  7262. Procedure SetLengthAndZero (var V : SingleArray; const NewLength : Integer);
  7263. var L : Integer;
  7264.   Begin
  7265.     L := Length (V);
  7266.     if L = NewLength then
  7267.       exit;
  7268.     SetLength (V, NewLength);
  7269.     if L > NewLength then
  7270.       exit;
  7271.     FillChar (V [L], Sizeof (Single) * (NewLength - L), #0);
  7272.   End;
  7273.  
  7274. Procedure SetLengthAndZero (var V : DoubleArray; const NewLength : Integer);
  7275. var L : Integer;
  7276.   Begin
  7277.     L := Length (V);
  7278.     if L = NewLength then
  7279.       exit;
  7280.     SetLength (V, NewLength);
  7281.     if L > NewLength then
  7282.       exit;
  7283.     FillChar (V [L], Sizeof (Double) * (NewLength - L), #0);
  7284.   End;
  7285.  
  7286. Procedure SetLengthAndZero (var V : ExtendedArray; const NewLength : Integer);
  7287. var L : Integer;
  7288.   Begin
  7289.     L := Length (V);
  7290.     if L = NewLength then
  7291.       exit;
  7292.     SetLength (V, NewLength);
  7293.     if L > NewLength then
  7294.       exit;
  7295.     FillChar (V [L], Sizeof (Extended) * (NewLength - L), #0);
  7296.   End;
  7297.  
  7298. Procedure SetLengthAndZero (var V : CharSetArray; const NewLength : Integer);
  7299. var L : Integer;
  7300.   Begin
  7301.     L := Length (V);
  7302.     if L = NewLength then
  7303.       exit;
  7304.     SetLength (V, NewLength);
  7305.     if L > NewLength then
  7306.       exit;
  7307.     FillChar (V [L], Sizeof (CharSet) * (NewLength - L), #0);
  7308.   End;
  7309.  
  7310. Procedure SetLengthAndZero (var V : BooleanArray; const NewLength : Integer);
  7311. var L : Integer;
  7312.   Begin
  7313.     L := Length (V);
  7314.     if L = NewLength then
  7315.       exit;
  7316.     SetLength (V, NewLength);
  7317.     if L > NewLength then
  7318.       exit;
  7319.     FillChar (V [L], Sizeof (Boolean) * (NewLength - L), #0);
  7320.   End;
  7321.  
  7322. Procedure SetLengthAndZero (var V : ObjectArray; const NewLength : Integer; const FreeObjects : Boolean);
  7323. var I, L : Integer;
  7324.   Begin
  7325.     L := Length (V);
  7326.     if L = NewLength then
  7327.       exit;
  7328.     if (L > NewLength) and FreeObjects then
  7329.       For I := NewLength to L - 1 do
  7330.         FreeAndNil (V [I]);
  7331.     SetLength (V, NewLength);
  7332.     if L > NewLength then
  7333.       exit;
  7334.     FillChar (V [L], Sizeof (Pointer) * (NewLength - L), #0);
  7335.   End;
  7336.  
  7337.  
  7338.  
  7339. {                                                                              }
  7340. { IsEqual                                                                      }
  7341. {                                                                              }
  7342. Function IsEqual (const V1, V2 : ByteArray) : Boolean;
  7343. var L : Integer;
  7344.   Begin
  7345.     L := Length (V1);
  7346.     if L <> Length (V2) then
  7347.       begin
  7348.         Result := False;
  7349.         exit;
  7350.       end;
  7351.     Result := CompareMem (Pointer (V1)^, Pointer (V2)^, Sizeof (Byte) * L);
  7352.   End;
  7353.  
  7354. Function IsEqual (const V1, V2 : WordArray) : Boolean;
  7355. var L : Integer;
  7356.   Begin
  7357.     L := Length (V1);
  7358.     if L <> Length (V2) then
  7359.       begin
  7360.         Result := False;
  7361.         exit;
  7362.       end;
  7363.     Result := CompareMem (Pointer (V1)^, Pointer (V2)^, Sizeof (Word) * L);
  7364.   End;
  7365.  
  7366. Function IsEqual (const V1, V2 : LongWordArray) : Boolean;
  7367. var L : Integer;
  7368.   Begin
  7369.     L := Length (V1);
  7370.     if L <> Length (V2) then
  7371.       begin
  7372.         Result := False;
  7373.         exit;
  7374.       end;
  7375.     Result := CompareMem (Pointer (V1)^, Pointer (V2)^, Sizeof (LongWord) * L);
  7376.   End;
  7377.  
  7378. Function IsEqual (const V1, V2 : ShortIntArray) : Boolean;
  7379. var L : Integer;
  7380.   Begin
  7381.     L := Length (V1);
  7382.     if L <> Length (V2) then
  7383.       begin
  7384.         Result := False;
  7385.         exit;
  7386.       end;
  7387.     Result := CompareMem (Pointer (V1)^, Pointer (V2)^, Sizeof (ShortInt) * L);
  7388.   End;
  7389.  
  7390. Function IsEqual (const V1, V2 : SmallIntArray) : Boolean;
  7391. var L : Integer;
  7392.   Begin
  7393.     L := Length (V1);
  7394.     if L <> Length (V2) then
  7395.       begin
  7396.         Result := False;
  7397.         exit;
  7398.       end;
  7399.     Result := CompareMem (Pointer (V1)^, Pointer (V2)^, Sizeof (SmallInt) * L);
  7400.   End;
  7401.  
  7402. Function IsEqual (const V1, V2 : LongIntArray) : Boolean;
  7403. var L : Integer;
  7404.   Begin
  7405.     L := Length (V1);
  7406.     if L <> Length (V2) then
  7407.       begin
  7408.         Result := False;
  7409.         exit;
  7410.       end;
  7411.     Result := CompareMem (Pointer (V1)^, Pointer (V2)^, Sizeof (LongInt) * L);
  7412.   End;
  7413.  
  7414. Function IsEqual (const V1, V2 : Int64Array) : Boolean;
  7415. var L : Integer;
  7416.   Begin
  7417.     L := Length (V1);
  7418.     if L <> Length (V2) then
  7419.       begin
  7420.         Result := False;
  7421.         exit;
  7422.       end;
  7423.     Result := CompareMem (Pointer (V1)^, Pointer (V2)^, Sizeof (Int64) * L);
  7424.   End;
  7425.  
  7426. Function IsEqual (const V1, V2 : SingleArray) : Boolean;
  7427. var L : Integer;
  7428.   Begin
  7429.     L := Length (V1);
  7430.     if L <> Length (V2) then
  7431.       begin
  7432.         Result := False;
  7433.         exit;
  7434.       end;
  7435.     Result := CompareMem (Pointer (V1)^, Pointer (V2)^, Sizeof (Single) * L);
  7436.   End;
  7437.  
  7438. Function IsEqual (const V1, V2 : DoubleArray) : Boolean;
  7439. var L : Integer;
  7440.   Begin
  7441.     L := Length (V1);
  7442.     if L <> Length (V2) then
  7443.       begin
  7444.         Result := False;
  7445.         exit;
  7446.       end;
  7447.     Result := CompareMem (Pointer (V1)^, Pointer (V2)^, Sizeof (Double) * L);
  7448.   End;
  7449.  
  7450. Function IsEqual (const V1, V2 : ExtendedArray) : Boolean;
  7451. var L : Integer;
  7452.   Begin
  7453.     L := Length (V1);
  7454.     if L <> Length (V2) then
  7455.       begin
  7456.         Result := False;
  7457.         exit;
  7458.       end;
  7459.     Result := CompareMem (Pointer (V1)^, Pointer (V2)^, Sizeof (Extended) * L);
  7460.   End;
  7461.  
  7462. Function IsEqual (const V1, V2 : StringArray) : Boolean;
  7463. var I, L : Integer;
  7464.   Begin
  7465.     L := Length (V1);
  7466.     if L <> Length (V2) then
  7467.       begin
  7468.         Result := False;
  7469.         exit;
  7470.       end;
  7471.     For I := 0 to L - 1 do
  7472.       if V1 [I] <> V2 [I] then
  7473.         begin
  7474.           Result := False;
  7475.           exit;
  7476.         end;
  7477.     Result := True;
  7478.   End;
  7479.  
  7480. Function IsEqual (const V1, V2 : CharSetArray) : Boolean;
  7481. var I, L : Integer;
  7482.   Begin
  7483.     L := Length (V1);
  7484.     if L <> Length (V2) then
  7485.       begin
  7486.         Result := False;
  7487.         exit;
  7488.       end;
  7489.     For I := 0 to L - 1 do
  7490.       if V1 [I] <> V2 [I] then
  7491.         begin
  7492.           Result := False;
  7493.           exit;
  7494.         end;
  7495.     Result := True;
  7496.   End;
  7497.  
  7498.  
  7499.  
  7500. {                                                                              }
  7501. { Dynamic array to Dynamic array                                               }
  7502. {                                                                              }
  7503. Function ByteArrayToLongIntArray (const V : ByteArray) : LongIntArray;
  7504. var I, L : Integer;
  7505.   Begin
  7506.     L := Length (V);
  7507.     SetLength (Result, L);
  7508.     For I := 0 to L - 1 do
  7509.       Result [I] := V [I];
  7510.   End;
  7511.  
  7512. Function WordArrayToLongIntArray (const V : WordArray) : LongIntArray;
  7513. var I, L : Integer;
  7514.   Begin
  7515.     L := Length (V);
  7516.     SetLength (Result, L);
  7517.     For I := 0 to L - 1 do
  7518.       Result [I] := V [I];
  7519.   End;
  7520.  
  7521. Function ShortIntArrayToLongIntArray (const V : ShortIntArray) : LongIntArray;
  7522. var I, L : Integer;
  7523.   Begin
  7524.     L := Length (V);
  7525.     SetLength (Result, L);
  7526.     For I := 0 to L - 1 do
  7527.       Result [I] := V [I];
  7528.   End;
  7529.  
  7530. Function SmallIntArrayToLongIntArray (const V : SmallIntArray) : LongIntArray;
  7531. var I, L : Integer;
  7532.   Begin
  7533.     L := Length (V);
  7534.     SetLength (Result, L);
  7535.     For I := 0 to L - 1 do
  7536.       Result [I] := V [I];
  7537.   End;
  7538.  
  7539. Function LongIntArrayToInt64Array (const V : LongIntArray) : Int64Array;
  7540. var I, L : Integer;
  7541.   Begin
  7542.     L := Length (V);
  7543.     SetLength (Result, L);
  7544.     For I := 0 to L - 1 do
  7545.       Result [I] := V [I];
  7546.   End;
  7547.  
  7548. Function LongIntArrayToSingleArray (const V : LongIntArray) : SingleArray;
  7549. var I, L : Integer;
  7550.   Begin
  7551.     L := Length (V);
  7552.     SetLength (Result, L);
  7553.     For I := 0 to L - 1 do
  7554.       Result [I] := V [I];
  7555.   End;
  7556.  
  7557. Function LongIntArrayToDoubleArray (const V : LongIntArray) : DoubleArray;
  7558. var I, L : Integer;
  7559.   Begin
  7560.     L := Length (V);
  7561.     SetLength (Result, L);
  7562.     For I := 0 to L - 1 do
  7563.       Result [I] := V [I];
  7564.   End;
  7565.  
  7566. Function LongIntArrayToExtendedArray (const V : LongIntArray) : ExtendedArray;
  7567. var I, L : Integer;
  7568.   Begin
  7569.     L := Length (V);
  7570.     SetLength (Result, L);
  7571.     For I := 0 to L - 1 do
  7572.       Result [I] := V [I];
  7573.   End;
  7574.  
  7575. Function SingleArrayToExtendedArray (const V : SingleArray) : ExtendedArray;
  7576. var I, L : Integer;
  7577.   Begin
  7578.     L := Length (V);
  7579.     SetLength (Result, L);
  7580.     For I := 0 to L - 1 do
  7581.       Result [I] := V [I];
  7582.   End;
  7583.  
  7584. Function SingleArrayToDoubleArray (const V : SingleArray) : DoubleArray;
  7585. var I, L : Integer;
  7586.   Begin
  7587.     L := Length (V);
  7588.     SetLength (Result, L);
  7589.     For I := 0 to L - 1 do
  7590.       Result [I] := V [I];
  7591.   End;
  7592.  
  7593. Function SingleArrayToLongIntArray (const V : SingleArray) : LongIntArray;
  7594. var I, L : Integer;
  7595.   Begin
  7596.     L := Length (V);
  7597.     SetLength (Result, L);
  7598.     For I := 0 to L - 1 do
  7599.       Result [I] := Trunc (V [I]);
  7600.   End;
  7601.  
  7602. Function SingleArrayToInt64Array (const V : SingleArray) : Int64Array;
  7603. var I, L : Integer;
  7604.   Begin
  7605.     L := Length (V);
  7606.     SetLength (Result, L);
  7607.     For I := 0 to L - 1 do
  7608.       Result [I] := Trunc (V [I]);
  7609.   End;
  7610.  
  7611. Function DoubleArrayToSingleArray (const V : DoubleArray) : SingleArray;
  7612. var I, L : Integer;
  7613.   Begin
  7614.     L := Length (V);
  7615.     SetLength (Result, L);
  7616.     For I := 0 to L - 1 do
  7617.       Result [I] := V [I];
  7618.   End;
  7619.  
  7620. Function DoubleArrayToExtendedArray (const V : DoubleArray) : ExtendedArray;
  7621. var I, L : Integer;
  7622.   Begin
  7623.     L := Length (V);
  7624.     SetLength (Result, L);
  7625.     For I := 0 to L - 1 do
  7626.       Result [I] := V [I];
  7627.   End;
  7628.  
  7629. Function DoubleArrayToLongIntArray (const V : DoubleArray) : LongIntArray;
  7630. var I, L : Integer;
  7631.   Begin
  7632.     L := Length (V);
  7633.     SetLength (Result, L);
  7634.     For I := 0 to L - 1 do
  7635.       Result [I] := Trunc (V [I]);
  7636.   End;
  7637.  
  7638. Function DoubleArrayToInt64Array (const V : DoubleArray) : Int64Array;
  7639. var I, L : Integer;
  7640.   Begin
  7641.     L := Length (V);
  7642.     SetLength (Result, L);
  7643.     For I := 0 to L - 1 do
  7644.       Result [I] := Trunc (V [I]);
  7645.   End;
  7646.  
  7647. Function ExtendedArrayToSingleArray (const V : ExtendedArray) : SingleArray;
  7648. var I, L : Integer;
  7649.   Begin
  7650.     L := Length (V);
  7651.     SetLength (Result, L);
  7652.     For I := 0 to L - 1 do
  7653.       Result [I] := V [I];
  7654.   End;
  7655.  
  7656. Function ExtendedArrayToDoubleArray (const V : ExtendedArray) : DoubleArray;
  7657. var I, L : Integer;
  7658.   Begin
  7659.     L := Length (V);
  7660.     SetLength (Result, L);
  7661.     For I := 0 to L - 1 do
  7662.       Result [I] := V [I];
  7663.   End;
  7664.  
  7665. Function ExtendedArrayToLongIntArray (const V : ExtendedArray) : LongIntArray;
  7666. var I, L : Integer;
  7667.   Begin
  7668.     L := Length (V);
  7669.     SetLength (Result, L);
  7670.     For I := 0 to L - 1 do
  7671.       Result [I] := Trunc (V [I]);
  7672.   End;
  7673.  
  7674. Function ExtendedArrayToInt64Array (const V : ExtendedArray) : Int64Array;
  7675. var I, L : Integer;
  7676.   Begin
  7677.     L := Length (V);
  7678.     SetLength (Result, L);
  7679.     For I := 0 to L - 1 do
  7680.       Result [I] := Trunc (V [I]);
  7681.   End;
  7682.  
  7683.  
  7684.  
  7685. {                                                                              }
  7686. { Array from indexes                                                           }
  7687. {                                                                              }
  7688. Function ByteArrayFromIndexes (const V : ByteArray; const Indexes : IntegerArray) : ByteArray;
  7689. var I, L : Integer;
  7690.   Begin
  7691.     L := Length (Indexes);
  7692.     SetLength (Result, L);
  7693.     For I := 0 to L - 1 do
  7694.       Result [I] := V [Indexes [I]];
  7695.   End;
  7696.  
  7697. Function WordArrayFromIndexes (const V : WordArray; const Indexes : IntegerArray) : WordArray;
  7698. var I, L : Integer;
  7699.   Begin
  7700.     L := Length (Indexes);
  7701.     SetLength (Result, L);
  7702.     For I := 0 to L - 1 do
  7703.       Result [I] := V [Indexes [I]];
  7704.   End;
  7705.  
  7706. Function LongWordArrayFromIndexes (const V : LongWordArray; const Indexes : IntegerArray) : LongWordArray;
  7707. var I, L : Integer;
  7708.   Begin
  7709.     L := Length (Indexes);
  7710.     SetLength (Result, L);
  7711.     For I := 0 to L - 1 do
  7712.       Result [I] := V [Indexes [I]];
  7713.   End;
  7714.  
  7715. Function CardinalArrayFromIndexes (const V : CardinalArray; const Indexes : IntegerArray) : CardinalArray;
  7716. var I, L : Integer;
  7717.   Begin
  7718.     L := Length (Indexes);
  7719.     SetLength (Result, L);
  7720.     For I := 0 to L - 1 do
  7721.       Result [I] := V [Indexes [I]];
  7722.   End;
  7723.  
  7724. Function ShortIntArrayFromIndexes (const V : ShortIntArray; const Indexes : IntegerArray) : ShortIntArray;
  7725. var I, L : Integer;
  7726.   Begin
  7727.     L := Length (Indexes);
  7728.     SetLength (Result, L);
  7729.     For I := 0 to L - 1 do
  7730.       Result [I] := V [Indexes [I]];
  7731.   End;
  7732.  
  7733. Function SmallIntArrayFromIndexes (const V : SmallIntArray; const Indexes : IntegerArray) : SmallIntArray;
  7734. var I, L : Integer;
  7735.   Begin
  7736.     L := Length (Indexes);
  7737.     SetLength (Result, L);
  7738.     For I := 0 to L - 1 do
  7739.       Result [I] := V [Indexes [I]];
  7740.   End;
  7741.  
  7742. Function LongIntArrayFromIndexes (const V : LongIntArray; const Indexes : IntegerArray) : LongIntArray;
  7743. var I, L : Integer;
  7744.   Begin
  7745.     L := Length (Indexes);
  7746.     SetLength (Result, L);
  7747.     For I := 0 to L - 1 do
  7748.       Result [I] := V [Indexes [I]];
  7749.   End;
  7750.  
  7751. Function IntegerArrayFromIndexes (const V : IntegerArray; const Indexes : IntegerArray) : IntegerArray;
  7752. var I, L : Integer;
  7753.   Begin
  7754.     L := Length (Indexes);
  7755.     SetLength (Result, L);
  7756.     For I := 0 to L - 1 do
  7757.       Result [I] := V [Indexes [I]];
  7758.   End;
  7759.  
  7760. Function Int64ArrayFromIndexes (const V : Int64Array; const Indexes : IntegerArray) : Int64Array;
  7761. var I, L : Integer;
  7762.   Begin
  7763.     L := Length (Indexes);
  7764.     SetLength (Result, L);
  7765.     For I := 0 to L - 1 do
  7766.       Result [I] := V [Indexes [I]];
  7767.   End;
  7768.  
  7769. Function SingleArrayFromIndexes (const V : SingleArray; const Indexes : IntegerArray) : SingleArray;
  7770. var I, L : Integer;
  7771.   Begin
  7772.     L := Length (Indexes);
  7773.     SetLength (Result, L);
  7774.     For I := 0 to L - 1 do
  7775.       Result [I] := V [Indexes [I]];
  7776.   End;
  7777.  
  7778. Function DoubleArrayFromIndexes (const V : DoubleArray; const Indexes : IntegerArray) : DoubleArray;
  7779. var I, L : Integer;
  7780.   Begin
  7781.     L := Length (Indexes);
  7782.     SetLength (Result, L);
  7783.     For I := 0 to L - 1 do
  7784.       Result [I] := V [Indexes [I]];
  7785.   End;
  7786.  
  7787. Function ExtendedArrayFromIndexes (const V : ExtendedArray; const Indexes : IntegerArray) : ExtendedArray;
  7788. var I, L : Integer;
  7789.   Begin
  7790.     L := Length (Indexes);
  7791.     SetLength (Result, L);
  7792.     For I := 0 to L - 1 do
  7793.       Result [I] := V [Indexes [I]];
  7794.   End;
  7795.  
  7796. Function StringArrayFromIndexes (const V : StringArray; const Indexes : IntegerArray) : StringArray;
  7797. var I, L : Integer;
  7798.   Begin
  7799.     L := Length (Indexes);
  7800.     SetLength (Result, L);
  7801.     For I := 0 to L - 1 do
  7802.       Result [I] := V [Indexes [I]];
  7803.   End;
  7804.  
  7805.  
  7806.  
  7807. {                                                                              }
  7808. { Dynamic array Sort                                                           }
  7809. {                                                                              }
  7810. Procedure Sort (var V : ByteArray);
  7811.  
  7812.   Procedure QuickSort (L, R : Integer);
  7813.   var I, J, M : Integer;
  7814.     Begin
  7815.       Repeat
  7816.         I := L;
  7817.         J := R;
  7818.         M := (L + R) shr 1;
  7819.         Repeat
  7820.           While V [I] < V [M] do
  7821.             Inc (I);
  7822.           While V [J] > V [M] do
  7823.             Dec (J);
  7824.           if I <= J then
  7825.             begin
  7826.               Swap (V [I], V [J]);
  7827.               if M = I then
  7828.                 M := J else
  7829.                 if M = J then
  7830.                   M := I;
  7831.               Inc (I);
  7832.               Dec (J);
  7833.             end;
  7834.         Until I > J;
  7835.         if L < J then
  7836.           QuickSort (L, J);
  7837.         L := I;
  7838.       Until I >= R;
  7839.     End;
  7840.  
  7841. var I : Integer;
  7842.   Begin
  7843.     I := Length (V);
  7844.     if I > 0 then
  7845.       QuickSort (0, I - 1);
  7846.   End;
  7847.  
  7848. Procedure Sort (var V : WordArray);
  7849.  
  7850.   Procedure QuickSort (L, R : Integer);
  7851.   var I, J, M : Integer;
  7852.     Begin
  7853.       Repeat
  7854.         I := L;
  7855.         J := R;
  7856.         M := (L + R) shr 1;
  7857.         Repeat
  7858.           While V [I] < V [M] do
  7859.             Inc (I);
  7860.           While V [J] > V [M] do
  7861.             Dec (J);
  7862.           if I <= J then
  7863.             begin
  7864.               Swap (V [I], V [J]);
  7865.               if M = I then
  7866.                 M := J else
  7867.                 if M = J then
  7868.                   M := I;
  7869.               Inc (I);
  7870.               Dec (J);
  7871.             end;
  7872.         Until I > J;
  7873.         if L < J then
  7874.           QuickSort (L, J);
  7875.         L := I;
  7876.       Until I >= R;
  7877.     End;
  7878.  
  7879. var I : Integer;
  7880.   Begin
  7881.     I := Length (V);
  7882.     if I > 0 then
  7883.       QuickSort (0, I - 1);
  7884.   End;
  7885.  
  7886. Procedure Sort (var V : LongWordArray);
  7887.  
  7888.   Procedure QuickSort (L, R : Integer);
  7889.   var I, J, M : Integer;
  7890.     Begin
  7891.       Repeat
  7892.         I := L;
  7893.         J := R;
  7894.         M := (L + R) shr 1;
  7895.         Repeat
  7896.           While V [I] < V [M] do
  7897.             Inc (I);
  7898.           While V [J] > V [M] do
  7899.             Dec (J);
  7900.           if I <= J then
  7901.             begin
  7902.               Swap (V [I], V [J]);
  7903.               if M = I then
  7904.                 M := J else
  7905.                 if M = J then
  7906.                   M := I;
  7907.               Inc (I);
  7908.               Dec (J);
  7909.             end;
  7910.         Until I > J;
  7911.         if L < J then
  7912.           QuickSort (L, J);
  7913.         L := I;
  7914.       Until I >= R;
  7915.     End;
  7916.  
  7917. var I : Integer;
  7918.   Begin
  7919.     I := Length (V);
  7920.     if I > 0 then
  7921.       QuickSort (0, I - 1);
  7922.   End;
  7923.  
  7924. Procedure Sort (var V : ShortIntArray);
  7925.  
  7926.   Procedure QuickSort (L, R : Integer);
  7927.   var I, J, M : Integer;
  7928.     Begin
  7929.       Repeat
  7930.         I := L;
  7931.         J := R;
  7932.         M := (L + R) shr 1;
  7933.         Repeat
  7934.           While V [I] < V [M] do
  7935.             Inc (I);
  7936.           While V [J] > V [M] do
  7937.             Dec (J);
  7938.           if I <= J then
  7939.             begin
  7940.               Swap (V [I], V [J]);
  7941.               if M = I then
  7942.                 M := J else
  7943.                 if M = J then
  7944.                   M := I;
  7945.               Inc (I);
  7946.               Dec (J);
  7947.             end;
  7948.         Until I > J;
  7949.         if L < J then
  7950.           QuickSort (L, J);
  7951.         L := I;
  7952.       Until I >= R;
  7953.     End;
  7954.  
  7955. var I : Integer;
  7956.   Begin
  7957.     I := Length (V);
  7958.     if I > 0 then
  7959.       QuickSort (0, I - 1);
  7960.   End;
  7961.  
  7962. Procedure Sort (var V : SmallIntArray);
  7963.  
  7964.   Procedure QuickSort (L, R : Integer);
  7965.   var I, J, M : Integer;
  7966.     Begin
  7967.       Repeat
  7968.         I := L;
  7969.         J := R;
  7970.         M := (L + R) shr 1;
  7971.         Repeat
  7972.           While V [I] < V [M] do
  7973.             Inc (I);
  7974.           While V [J] > V [M] do
  7975.             Dec (J);
  7976.           if I <= J then
  7977.             begin
  7978.               Swap (V [I], V [J]);
  7979.               if M = I then
  7980.                 M := J else
  7981.                 if M = J then
  7982.                   M := I;
  7983.               Inc (I);
  7984.               Dec (J);
  7985.             end;
  7986.         Until I > J;
  7987.         if L < J then
  7988.           QuickSort (L, J);
  7989.         L := I;
  7990.       Until I >= R;
  7991.     End;
  7992.  
  7993. var I : Integer;
  7994.   Begin
  7995.     I := Length (V);
  7996.     if I > 0 then
  7997.       QuickSort (0, I - 1);
  7998.   End;
  7999.  
  8000. Procedure Sort (var V : LongIntArray);
  8001.  
  8002.   Procedure QuickSort (L, R : Integer);
  8003.   var I, J, M : Integer;
  8004.     Begin
  8005.       Repeat
  8006.         I := L;
  8007.         J := R;
  8008.         M := (L + R) shr 1;
  8009.         Repeat
  8010.           While V [I] < V [M] do
  8011.             Inc (I);
  8012.           While V [J] > V [M] do
  8013.             Dec (J);
  8014.           if I <= J then
  8015.             begin
  8016.               Swap (V [I], V [J]);
  8017.               if M = I then
  8018.                 M := J else
  8019.                 if M = J then
  8020.                   M := I;
  8021.               Inc (I);
  8022.               Dec (J);
  8023.             end;
  8024.         Until I > J;
  8025.         if L < J then
  8026.           QuickSort (L, J);
  8027.         L := I;
  8028.       Until I >= R;
  8029.     End;
  8030.  
  8031. var I : Integer;
  8032.   Begin
  8033.     I := Length (V);
  8034.     if I > 0 then
  8035.       QuickSort (0, I - 1);
  8036.   End;
  8037.  
  8038. Procedure Sort (var V : Int64Array);
  8039.  
  8040.   Procedure QuickSort (L, R : Integer);
  8041.   var I, J, M : Integer;
  8042.     Begin
  8043.       Repeat
  8044.         I := L;
  8045.         J := R;
  8046.         M := (L + R) shr 1;
  8047.         Repeat
  8048.           While V [I] < V [M] do
  8049.             Inc (I);
  8050.           While V [J] > V [M] do
  8051.             Dec (J);
  8052.           if I <= J then
  8053.             begin
  8054.               Swap (V [I], V [J]);
  8055.               if M = I then
  8056.                 M := J else
  8057.                 if M = J then
  8058.                   M := I;
  8059.               Inc (I);
  8060.               Dec (J);
  8061.             end;
  8062.         Until I > J;
  8063.         if L < J then
  8064.           QuickSort (L, J);
  8065.         L := I;
  8066.       Until I >= R;
  8067.     End;
  8068.  
  8069. var I : Integer;
  8070.   Begin
  8071.     I := Length (V);
  8072.     if I > 0 then
  8073.       QuickSort (0, I - 1);
  8074.   End;
  8075.  
  8076. Procedure Sort (var V : SingleArray);
  8077.  
  8078.   Procedure QuickSort (L, R : Integer);
  8079.   var I, J, M : Integer;
  8080.     Begin
  8081.       Repeat
  8082.         I := L;
  8083.         J := R;
  8084.         M := (L + R) shr 1;
  8085.         Repeat
  8086.           While V [I] < V [M] do
  8087.             Inc (I);
  8088.           While V [J] > V [M] do
  8089.             Dec (J);
  8090.           if I <= J then
  8091.             begin
  8092.               Swap (V [I], V [J]);
  8093.               if M = I then
  8094.                 M := J else
  8095.                 if M = J then
  8096.                   M := I;
  8097.               Inc (I);
  8098.               Dec (J);
  8099.             end;
  8100.         Until I > J;
  8101.         if L < J then
  8102.           QuickSort (L, J);
  8103.         L := I;
  8104.       Until I >= R;
  8105.     End;
  8106.  
  8107. var I : Integer;
  8108.   Begin
  8109.     I := Length (V);
  8110.     if I > 0 then
  8111.       QuickSort (0, I - 1);
  8112.   End;
  8113.  
  8114. Procedure Sort (var V : DoubleArray);
  8115.  
  8116.   Procedure QuickSort (L, R : Integer);
  8117.   var I, J, M : Integer;
  8118.     Begin
  8119.       Repeat
  8120.         I := L;
  8121.         J := R;
  8122.         M := (L + R) shr 1;
  8123.         Repeat
  8124.           While V [I] < V [M] do
  8125.             Inc (I);
  8126.           While V [J] > V [M] do
  8127.             Dec (J);
  8128.           if I <= J then
  8129.             begin
  8130.               Swap (V [I], V [J]);
  8131.               if M = I then
  8132.                 M := J else
  8133.                 if M = J then
  8134.                   M := I;
  8135.               Inc (I);
  8136.               Dec (J);
  8137.             end;
  8138.         Until I > J;
  8139.         if L < J then
  8140.           QuickSort (L, J);
  8141.         L := I;
  8142.       Until I >= R;
  8143.     End;
  8144.  
  8145. var I : Integer;
  8146.   Begin
  8147.     I := Length (V);
  8148.     if I > 0 then
  8149.       QuickSort (0, I - 1);
  8150.   End;
  8151.  
  8152. Procedure Sort (var V : ExtendedArray);
  8153.  
  8154.   Procedure QuickSort (L, R : Integer);
  8155.   var I, J, M : Integer;
  8156.     Begin
  8157.       Repeat
  8158.         I := L;
  8159.         J := R;
  8160.         M := (L + R) shr 1;
  8161.         Repeat
  8162.           While V [I] < V [M] do
  8163.             Inc (I);
  8164.           While V [J] > V [M] do
  8165.             Dec (J);
  8166.           if I <= J then
  8167.             begin
  8168.               Swap (V [I], V [J]);
  8169.               if M = I then
  8170.                 M := J else
  8171.                 if M = J then
  8172.                   M := I;
  8173.               Inc (I);
  8174.               Dec (J);
  8175.             end;
  8176.         Until I > J;
  8177.         if L < J then
  8178.           QuickSort (L, J);
  8179.         L := I;
  8180.       Until I >= R;
  8181.     End;
  8182.  
  8183. var I : Integer;
  8184.   Begin
  8185.     I := Length (V);
  8186.     if I > 0 then
  8187.       QuickSort (0, I - 1);
  8188.   End;
  8189.  
  8190. Procedure Sort (var V : StringArray);
  8191.  
  8192.   Procedure QuickSort (L, R : Integer);
  8193.   var I, J, M : Integer;
  8194.     Begin
  8195.       Repeat
  8196.         I := L;
  8197.         J := R;
  8198.         M := (L + R) shr 1;
  8199.         Repeat
  8200.           While V [I] < V [M] do
  8201.             Inc (I);
  8202.           While V [J] > V [M] do
  8203.             Dec (J);
  8204.           if I <= J then
  8205.             begin
  8206.               Swap (V [I], V [J]);
  8207.               if M = I then
  8208.                 M := J else
  8209.                 if M = J then
  8210.                   M := I;
  8211.               Inc (I);
  8212.               Dec (J);
  8213.             end;
  8214.         Until I > J;
  8215.         if L < J then
  8216.           QuickSort (L, J);
  8217.         L := I;
  8218.       Until I >= R;
  8219.     End;
  8220.  
  8221. var I : Integer;
  8222.   Begin
  8223.     I := Length (V);
  8224.     if I > 0 then
  8225.       QuickSort (0, I - 1);
  8226.   End;
  8227.  
  8228.  
  8229.  
  8230. Procedure Sort (var Key : IntegerArray; var Data : IntegerArray);
  8231.  
  8232.   Procedure QuickSort (L, R : Integer);
  8233.   var I, J, M : Integer;
  8234.     Begin
  8235.       Repeat
  8236.         I := L;
  8237.         J := R;
  8238.         M := (L + R) shr 1;
  8239.         Repeat
  8240.           While Key [I] < Key [M] do
  8241.             Inc (I);
  8242.           While Key [J] > Key [M] do
  8243.             Dec (J);
  8244.           if I <= J then
  8245.             begin
  8246.               Swap (Key [I], Key [J]);
  8247.               Swap (Data [I], Data [J]);
  8248.               if M = I then
  8249.                 M := J else
  8250.                 if M = J then
  8251.                   M := I;
  8252.               Inc (I);
  8253.               Dec (J);
  8254.             end;
  8255.         Until I > J;
  8256.         if L < J then
  8257.           QuickSort (L, J);
  8258.         L := I;
  8259.       Until I >= R;
  8260.     End;
  8261.  
  8262. var I : Integer;
  8263.   Begin
  8264.     Assert (Length (Key) = Length (Data), 'Sort pair must be of equal length.');
  8265.     I := Length (Key);
  8266.     if I > 0 then
  8267.       QuickSort (0, I - 1);
  8268.   End;
  8269.  
  8270. Procedure Sort (var Key : IntegerArray; var Data : Int64Array);
  8271.  
  8272.   Procedure QuickSort (L, R : Integer);
  8273.   var I, J, M : Integer;
  8274.     Begin
  8275.       Repeat
  8276.         I := L;
  8277.         J := R;
  8278.         M := (L + R) shr 1;
  8279.         Repeat
  8280.           While Key [I] < Key [M] do
  8281.             Inc (I);
  8282.           While Key [J] > Key [M] do
  8283.             Dec (J);
  8284.           if I <= J then
  8285.             begin
  8286.               Swap (Key [I], Key [J]);
  8287.               Swap (Data [I], Data [J]);
  8288.               if M = I then
  8289.                 M := J else
  8290.                 if M = J then
  8291.                   M := I;
  8292.               Inc (I);
  8293.               Dec (J);
  8294.             end;
  8295.         Until I > J;
  8296.         if L < J then
  8297.           QuickSort (L, J);
  8298.         L := I;
  8299.       Until I >= R;
  8300.     End;
  8301.  
  8302. var I : Integer;
  8303.   Begin
  8304.     Assert (Length (Key) = Length (Data), 'Sort pair must be of equal length.');
  8305.     I := Length (Key);
  8306.     if I > 0 then
  8307.       QuickSort (0, I - 1);
  8308.   End;
  8309.  
  8310. Procedure Sort (var Key : IntegerArray; var Data : StringArray);
  8311.  
  8312.   Procedure QuickSort (L, R : Integer);
  8313.   var I, J, M : Integer;
  8314.     Begin
  8315.       Repeat
  8316.         I := L;
  8317.         J := R;
  8318.         M := (L + R) shr 1;
  8319.         Repeat
  8320.           While Key [I] < Key [M] do
  8321.             Inc (I);
  8322.           While Key [J] > Key [M] do
  8323.             Dec (J);
  8324.           if I <= J then
  8325.             begin
  8326.               Swap (Key [I], Key [J]);
  8327.               Swap (Data [I], Data [J]);
  8328.               if M = I then
  8329.                 M := J else
  8330.                 if M = J then
  8331.                   M := I;
  8332.               Inc (I);
  8333.               Dec (J);
  8334.             end;
  8335.         Until I > J;
  8336.         if L < J then
  8337.           QuickSort (L, J);
  8338.         L := I;
  8339.       Until I >= R;
  8340.     End;
  8341.  
  8342. var I : Integer;
  8343.   Begin
  8344.     Assert (Length (Key) = Length (Data), 'Sort pair must be of equal length.');
  8345.     I := Length (Key);
  8346.     if I > 0 then
  8347.       QuickSort (0, I - 1);
  8348.   End;
  8349.  
  8350. Procedure Sort (var Key : IntegerArray; var Data : ExtendedArray);
  8351.  
  8352.   Procedure QuickSort (L, R : Integer);
  8353.   var I, J, M : Integer;
  8354.     Begin
  8355.       Repeat
  8356.         I := L;
  8357.         J := R;
  8358.         M := (L + R) shr 1;
  8359.         Repeat
  8360.           While Key [I] < Key [M] do
  8361.             Inc (I);
  8362.           While Key [J] > Key [M] do
  8363.             Dec (J);
  8364.           if I <= J then
  8365.             begin
  8366.               Swap (Key [I], Key [J]);
  8367.               Swap (Data [I], Data [J]);
  8368.               if M = I then
  8369.                 M := J else
  8370.                 if M = J then
  8371.                   M := I;
  8372.               Inc (I);
  8373.               Dec (J);
  8374.             end;
  8375.         Until I > J;
  8376.         if L < J then
  8377.           QuickSort (L, J);
  8378.         L := I;
  8379.       Until I >= R;
  8380.     End;
  8381.  
  8382. var I : Integer;
  8383.   Begin
  8384.     Assert (Length (Key) = Length (Data), 'Sort pair must be of equal length.');
  8385.     I := Length (Key);
  8386.     if I > 0 then
  8387.       QuickSort (0, I - 1);
  8388.   End;
  8389.  
  8390. Procedure Sort (var Key : IntegerArray; var Data : PointerArray);
  8391.  
  8392.   Procedure QuickSort (L, R : Integer);
  8393.   var I, J, M : Integer;
  8394.     Begin
  8395.       Repeat
  8396.         I := L;
  8397.         J := R;
  8398.         M := (L + R) shr 1;
  8399.         Repeat
  8400.           While Key [I] < Key [M] do
  8401.             Inc (I);
  8402.           While Key [J] > Key [M] do
  8403.             Dec (J);
  8404.           if I <= J then
  8405.             begin
  8406.               Swap (Key [I], Key [J]);
  8407.               Swap (Data [I], Data [J]);
  8408.               if M = I then
  8409.                 M := J else
  8410.                 if M = J then
  8411.                   M := I;
  8412.               Inc (I);
  8413.               Dec (J);
  8414.             end;
  8415.         Until I > J;
  8416.         if L < J then
  8417.           QuickSort (L, J);
  8418.         L := I;
  8419.       Until I >= R;
  8420.     End;
  8421.  
  8422. var I : Integer;
  8423.   Begin
  8424.     Assert (Length (Key) = Length (Data), 'Sort pair must be of equal length.');
  8425.     I := Length (Key);
  8426.     if I > 0 then
  8427.       QuickSort (0, I - 1);
  8428.   End;
  8429.  
  8430. Procedure Sort (var Key : StringArray; var Data : IntegerArray);
  8431.  
  8432.   Procedure QuickSort (L, R : Integer);
  8433.   var I, J, M : Integer;
  8434.     Begin
  8435.       Repeat
  8436.         I := L;
  8437.         J := R;
  8438.         M := (L + R) shr 1;
  8439.         Repeat
  8440.           While Key [I] < Key [M] do
  8441.             Inc (I);
  8442.           While Key [J] > Key [M] do
  8443.             Dec (J);
  8444.           if I <= J then
  8445.             begin
  8446.               Swap (Key [I], Key [J]);
  8447.               Swap (Data [I], Data [J]);
  8448.               if M = I then
  8449.                 M := J else
  8450.                 if M = J then
  8451.                   M := I;
  8452.               Inc (I);
  8453.               Dec (J);
  8454.             end;
  8455.         Until I > J;
  8456.         if L < J then
  8457.           QuickSort (L, J);
  8458.         L := I;
  8459.       Until I >= R;
  8460.     End;
  8461.  
  8462. var I : Integer;
  8463.   Begin
  8464.     Assert (Length (Key) = Length (Data), 'Sort pair must be of equal length.');
  8465.     I := Length (Key);
  8466.     if I > 0 then
  8467.       QuickSort (0, I - 1);
  8468.   End;
  8469.  
  8470. Procedure Sort (var Key : StringArray; var Data : Int64Array);
  8471.  
  8472.   Procedure QuickSort (L, R : Integer);
  8473.   var I, J, M : Integer;
  8474.     Begin
  8475.       Repeat
  8476.         I := L;
  8477.         J := R;
  8478.         M := (L + R) shr 1;
  8479.         Repeat
  8480.           While Key [I] < Key [M] do
  8481.             Inc (I);
  8482.           While Key [J] > Key [M] do
  8483.             Dec (J);
  8484.           if I <= J then
  8485.             begin
  8486.               Swap (Key [I], Key [J]);
  8487.               Swap (Data [I], Data [J]);
  8488.               if M = I then
  8489.                 M := J else
  8490.                 if M = J then
  8491.                   M := I;
  8492.               Inc (I);
  8493.               Dec (J);
  8494.             end;
  8495.         Until I > J;
  8496.         if L < J then
  8497.           QuickSort (L, J);
  8498.         L := I;
  8499.       Until I >= R;
  8500.     End;
  8501.  
  8502. var I : Integer;
  8503.   Begin
  8504.     Assert (Length (Key) = Length (Data), 'Sort pair must be of equal length.');
  8505.     I := Length (Key);
  8506.     if I > 0 then
  8507.       QuickSort (0, I - 1);
  8508.   End;
  8509.  
  8510. Procedure Sort (var Key : StringArray; var Data : StringArray);
  8511.  
  8512.   Procedure QuickSort (L, R : Integer);
  8513.   var I, J, M : Integer;
  8514.     Begin
  8515.       Repeat
  8516.         I := L;
  8517.         J := R;
  8518.         M := (L + R) shr 1;
  8519.         Repeat
  8520.           While Key [I] < Key [M] do
  8521.             Inc (I);
  8522.           While Key [J] > Key [M] do
  8523.             Dec (J);
  8524.           if I <= J then
  8525.             begin
  8526.               Swap (Key [I], Key [J]);
  8527.               Swap (Data [I], Data [J]);
  8528.               if M = I then
  8529.                 M := J else
  8530.                 if M = J then
  8531.                   M := I;
  8532.               Inc (I);
  8533.               Dec (J);
  8534.             end;
  8535.         Until I > J;
  8536.         if L < J then
  8537.           QuickSort (L, J);
  8538.         L := I;
  8539.       Until I >= R;
  8540.     End;
  8541.  
  8542. var I : Integer;
  8543.   Begin
  8544.     Assert (Length (Key) = Length (Data), 'Sort pair must be of equal length.');
  8545.     I := Length (Key);
  8546.     if I > 0 then
  8547.       QuickSort (0, I - 1);
  8548.   End;
  8549.  
  8550. Procedure Sort (var Key : StringArray; var Data : ExtendedArray);
  8551.  
  8552.   Procedure QuickSort (L, R : Integer);
  8553.   var I, J, M : Integer;
  8554.     Begin
  8555.       Repeat
  8556.         I := L;
  8557.         J := R;
  8558.         M := (L + R) shr 1;
  8559.         Repeat
  8560.           While Key [I] < Key [M] do
  8561.             Inc (I);
  8562.           While Key [J] > Key [M] do
  8563.             Dec (J);
  8564.           if I <= J then
  8565.             begin
  8566.               Swap (Key [I], Key [J]);
  8567.               Swap (Data [I], Data [J]);
  8568.               if M = I then
  8569.                 M := J else
  8570.                 if M = J then
  8571.                   M := I;
  8572.               Inc (I);
  8573.               Dec (J);
  8574.             end;
  8575.         Until I > J;
  8576.         if L < J then
  8577.           QuickSort (L, J);
  8578.         L := I;
  8579.       Until I >= R;
  8580.     End;
  8581.  
  8582. var I : Integer;
  8583.   Begin
  8584.     Assert (Length (Key) = Length (Data), 'Sort pair must be of equal length.');
  8585.     I := Length (Key);
  8586.     if I > 0 then
  8587.       QuickSort (0, I - 1);
  8588.   End;
  8589.  
  8590. Procedure Sort (var Key : StringArray; var Data : PointerArray);
  8591.  
  8592.   Procedure QuickSort (L, R : Integer);
  8593.   var I, J, M : Integer;
  8594.     Begin
  8595.       Repeat
  8596.         I := L;
  8597.         J := R;
  8598.         M := (L + R) shr 1;
  8599.         Repeat
  8600.           While Key [I] < Key [M] do
  8601.             Inc (I);
  8602.           While Key [J] > Key [M] do
  8603.             Dec (J);
  8604.           if I <= J then
  8605.             begin
  8606.               Swap (Key [I], Key [J]);
  8607.               Swap (Data [I], Data [J]);
  8608.               if M = I then
  8609.                 M := J else
  8610.                 if M = J then
  8611.                   M := I;
  8612.               Inc (I);
  8613.               Dec (J);
  8614.             end;
  8615.         Until I > J;
  8616.         if L < J then
  8617.           QuickSort (L, J);
  8618.         L := I;
  8619.       Until I >= R;
  8620.     End;
  8621.  
  8622. var I : Integer;
  8623.   Begin
  8624.     Assert (Length (Key) = Length (Data), 'Sort pair must be of equal length.');
  8625.     I := Length (Key);
  8626.     if I > 0 then
  8627.       QuickSort (0, I - 1);
  8628.   End;
  8629.  
  8630. Procedure Sort (var Key : ExtendedArray; var Data : IntegerArray);
  8631.  
  8632.   Procedure QuickSort (L, R : Integer);
  8633.   var I, J, M : Integer;
  8634.     Begin
  8635.       Repeat
  8636.         I := L;
  8637.         J := R;
  8638.         M := (L + R) shr 1;
  8639.         Repeat
  8640.           While Key [I] < Key [M] do
  8641.             Inc (I);
  8642.           While Key [J] > Key [M] do
  8643.             Dec (J);
  8644.           if I <= J then
  8645.             begin
  8646.               Swap (Key [I], Key [J]);
  8647.               Swap (Data [I], Data [J]);
  8648.               if M = I then
  8649.                 M := J else
  8650.                 if M = J then
  8651.                   M := I;
  8652.               Inc (I);
  8653.               Dec (J);
  8654.             end;
  8655.         Until I > J;
  8656.         if L < J then
  8657.           QuickSort (L, J);
  8658.         L := I;
  8659.       Until I >= R;
  8660.     End;
  8661.  
  8662. var I : Integer;
  8663.   Begin
  8664.     Assert (Length (Key) = Length (Data), 'Sort pair must be of equal length.');
  8665.     I := Length (Key);
  8666.     if I > 0 then
  8667.       QuickSort (0, I - 1);
  8668.   End;
  8669.  
  8670. Procedure Sort (var Key : ExtendedArray; var Data : Int64Array);
  8671.  
  8672.   Procedure QuickSort (L, R : Integer);
  8673.   var I, J, M : Integer;
  8674.     Begin
  8675.       Repeat
  8676.         I := L;
  8677.         J := R;
  8678.         M := (L + R) shr 1;
  8679.         Repeat
  8680.           While Key [I] < Key [M] do
  8681.             Inc (I);
  8682.           While Key [J] > Key [M] do
  8683.             Dec (J);
  8684.           if I <= J then
  8685.             begin
  8686.               Swap (Key [I], Key [J]);
  8687.               Swap (Data [I], Data [J]);
  8688.               if M = I then
  8689.                 M := J else
  8690.                 if M = J then
  8691.                   M := I;
  8692.               Inc (I);
  8693.               Dec (J);
  8694.             end;
  8695.         Until I > J;
  8696.         if L < J then
  8697.           QuickSort (L, J);
  8698.         L := I;
  8699.       Until I >= R;
  8700.     End;
  8701.  
  8702. var I : Integer;
  8703.   Begin
  8704.     Assert (Length (Key) = Length (Data), 'Sort pair must be of equal length.');
  8705.     I := Length (Key);
  8706.     if I > 0 then
  8707.       QuickSort (0, I - 1);
  8708.   End;
  8709.  
  8710. Procedure Sort (var Key : ExtendedArray; var Data : StringArray);
  8711.  
  8712.   Procedure QuickSort (L, R : Integer);
  8713.   var I, J, M : Integer;
  8714.     Begin
  8715.       Repeat
  8716.         I := L;
  8717.         J := R;
  8718.         M := (L + R) shr 1;
  8719.         Repeat
  8720.           While Key [I] < Key [M] do
  8721.             Inc (I);
  8722.           While Key [J] > Key [M] do
  8723.             Dec (J);
  8724.           if I <= J then
  8725.             begin
  8726.               Swap (Key [I], Key [J]);
  8727.               Swap (Data [I], Data [J]);
  8728.               if M = I then
  8729.                 M := J else
  8730.                 if M = J then
  8731.                   M := I;
  8732.               Inc (I);
  8733.               Dec (J);
  8734.             end;
  8735.         Until I > J;
  8736.         if L < J then
  8737.           QuickSort (L, J);
  8738.         L := I;
  8739.       Until I >= R;
  8740.     End;
  8741.  
  8742. var I : Integer;
  8743.   Begin
  8744.     Assert (Length (Key) = Length (Data), 'Sort pair must be of equal length.');
  8745.     I := Length (Key);
  8746.     if I > 0 then
  8747.       QuickSort (0, I - 1);
  8748.   End;
  8749.  
  8750. Procedure Sort (var Key : ExtendedArray; var Data : ExtendedArray);
  8751.  
  8752.   Procedure QuickSort (L, R : Integer);
  8753.   var I, J, M : Integer;
  8754.     Begin
  8755.       Repeat
  8756.         I := L;
  8757.         J := R;
  8758.         M := (L + R) shr 1;
  8759.         Repeat
  8760.           While Key [I] < Key [M] do
  8761.             Inc (I);
  8762.           While Key [J] > Key [M] do
  8763.             Dec (J);
  8764.           if I <= J then
  8765.             begin
  8766.               Swap (Key [I], Key [J]);
  8767.               Swap (Data [I], Data [J]);
  8768.               if M = I then
  8769.                 M := J else
  8770.                 if M = J then
  8771.                   M := I;
  8772.               Inc (I);
  8773.               Dec (J);
  8774.             end;
  8775.         Until I > J;
  8776.         if L < J then
  8777.           QuickSort (L, J);
  8778.         L := I;
  8779.       Until I >= R;
  8780.     End;
  8781.  
  8782. var I : Integer;
  8783.   Begin
  8784.     Assert (Length (Key) = Length (Data), 'Sort pair must be of equal length.');
  8785.     I := Length (Key);
  8786.     if I > 0 then
  8787.       QuickSort (0, I - 1);
  8788.   End;
  8789.  
  8790. Procedure Sort (var Key : ExtendedArray; var Data : PointerArray);
  8791.  
  8792.   Procedure QuickSort (L, R : Integer);
  8793.   var I, J, M : Integer;
  8794.     Begin
  8795.       Repeat
  8796.         I := L;
  8797.         J := R;
  8798.         M := (L + R) shr 1;
  8799.         Repeat
  8800.           While Key [I] < Key [M] do
  8801.             Inc (I);
  8802.           While Key [J] > Key [M] do
  8803.             Dec (J);
  8804.           if I <= J then
  8805.             begin
  8806.               Swap (Key [I], Key [J]);
  8807.               Swap (Data [I], Data [J]);
  8808.               if M = I then
  8809.                 M := J else
  8810.                 if M = J then
  8811.                   M := I;
  8812.               Inc (I);
  8813.               Dec (J);
  8814.             end;
  8815.         Until I > J;
  8816.         if L < J then
  8817.           QuickSort (L, J);
  8818.         L := I;
  8819.       Until I >= R;
  8820.     End;
  8821.  
  8822. var I : Integer;
  8823.   Begin
  8824.     Assert (Length (Key) = Length (Data), 'Sort pair must be of equal length.');
  8825.     I := Length (Key);
  8826.     if I > 0 then
  8827.       QuickSort (0, I - 1);
  8828.   End;
  8829.  
  8830.  
  8831.  
  8832.  
  8833. {                                                                              }
  8834. { Test cases                                                                   }
  8835. {                                                                              }
  8836. Procedure Test_Misc;
  8837. var A, B : String;
  8838.   Begin
  8839.     { iif                                                                 }
  8840.     Assert (iif (True, 1, 2) = 1, 'iif');
  8841.     Assert (iif (False, 1, 2) = 2, 'iif');
  8842.     Assert (iif (True, '1', '2') = '1', 'iif');
  8843.     Assert (iif (False, '1', '2') = '2', 'iif');
  8844.     Assert (iif (True, 1.1, 2.2) = 1.1, 'iif');
  8845.     Assert (iif (False, 1.1, 2.2) = 2.2, 'iif');
  8846.  
  8847.     { CharSet                                                              }
  8848.     Assert (CharCount ([]) = 0, 'CharCount');
  8849.     Assert (CharCount (['a'..'z']) = 26, 'CharCount');
  8850.     Assert (CharCount ([#0, #255]) = 2, 'CharCount');
  8851.  
  8852.     { MoveMem                                                              }
  8853.     A := '12345';
  8854.     B := '     ';
  8855.     MoveMem (A [1], B [1], 0);
  8856.     Assert (B = '     ', 'MoveMem');
  8857.     MoveMem (A [1], B [1], 1);
  8858.     Assert (B = '1    ', 'MoveMem');
  8859.     MoveMem (A [1], B [1], 2);
  8860.     Assert (B = '12   ', 'MoveMem');
  8861.     MoveMem (A [1], B [1], 3);
  8862.     Assert (B = '123  ', 'MoveMem');
  8863.     MoveMem (A [1], B [1], 4);
  8864.     Assert (B = '1234 ', 'MoveMem');
  8865.     MoveMem (A [1], B [1], 5);
  8866.     Assert (B = '12345', 'MoveMem');
  8867.   End;
  8868.  
  8869. Procedure Test_BitFunctions;
  8870.   Begin
  8871.     { Bits                                                                 }
  8872.     Assert (SetBit ($100F, 5) = $102F, 'SetBit');
  8873.     Assert (ClearBit ($102F, 5) = $100F, 'ClearBit');
  8874.     Assert (ToggleBit ($102F, 5) = $100F, 'ToggleBit');
  8875.     Assert (ToggleBit ($100F, 5) = $102F, 'ToggleBit');
  8876.     Assert (IsBitSet ($102F, 5), 'IsBitSet');
  8877.     Assert (not IsBitSet ($100F, 5), 'IsBitSet');
  8878.  
  8879.     Assert (SetBitScanForward (0) = -1, 'SetBitScanForward');
  8880.     Assert (SetBitScanForward ($1020) = 5, 'SetBitScanForward');
  8881.     Assert (SetBitScanReverse ($1020) = 12, 'SetBitScanForward');
  8882.     Assert (SetBitScanForward ($1020, 6) = 12, 'SetBitScanForward');
  8883.     Assert (SetBitScanReverse ($1020, 11) = 5, 'SetBitScanForward');
  8884.     Assert (ClearBitScanForward ($FFFFFFFF) = -1, 'ClearBitScanForward');
  8885.     Assert (ClearBitScanForward ($1020) = 0, 'ClearBitScanForward');
  8886.     Assert (ClearBitScanReverse ($1020) = 31, 'ClearBitScanForward');
  8887.     Assert (ClearBitScanForward ($1020, 5) = 6, 'ClearBitScanForward');
  8888.     Assert (ClearBitScanReverse ($1020, 12) = 11, 'ClearBitScanForward');
  8889.  
  8890.     Assert (ReverseBits ($12345678) = $1E6A2C48, 'ReverseBits');
  8891.     Assert (SwapEndian ($12345678) = $78563412, 'SwapEndian');
  8892.  
  8893.     Assert (BitCount ($12341234) = 10, 'BitCount');
  8894.  
  8895.     Assert (LowBitMask (10) = $3FF, 'LowBitMask');
  8896.     Assert (HighBitMask (28) = $F0000000, 'HighBitMask');
  8897.     Assert (RangeBitMask (2, 6) = $7C, 'RangeBitMask');
  8898.  
  8899.     Assert (SetBitRange ($101, 2, 6) = $17D, 'SetBitRange');
  8900.     Assert (ClearBitRange ($17D, 2, 6) = $101, 'ClearBitRange');
  8901.     Assert (ToggleBitRange ($17D, 2, 6) = $101, 'ToggleBitRange');
  8902.     Assert (IsBitRangeSet ($17D, 2, 6), 'IsBitRangeSet');
  8903.     Assert (not IsBitRangeSet ($101, 2, 6), 'IsBitRangeSet');
  8904.     Assert (not IsBitRangeClear ($17D, 2, 6), 'IsBitRangeClear');
  8905.     Assert (IsBitRangeClear ($101, 2, 6), 'IsBitRangeClear');
  8906.   End;
  8907.  
  8908. Procedure Test_IntegerArray;
  8909. var S, T : IntegerArray;
  8910.     F    : Integer;
  8911.   Begin
  8912.     { IntegerArray                                                         }
  8913.     S := nil;
  8914.     For F := 1 to 100 do
  8915.       begin
  8916.         Append (S, F);
  8917.         Assert (Length (S) = F,                 'Append');
  8918.         Assert (S [F - 1] = F,                  'Append');
  8919.       end;
  8920.  
  8921.     T := Copy (S);
  8922.     AppendIntegerArray (S, T);
  8923.     For F := 1 to 100 do
  8924.       Assert (S [F + 99] = F,                   'Append');
  8925.     Assert (PosNext (60, S) = 59,               'PosNext');
  8926.     Assert (PosNext (60, T) = 59,               'PosNext');
  8927.     Assert (PosNext (60, S, 59) = 159,          'PosNext');
  8928.     Assert (PosNext (60, T, 59) = -1,           'PosNext');
  8929.     Assert (PosNext (60, T, -1, True) = 59,     'PosNext');
  8930.     Assert (PosNext (60, T, 59, True) = -1,     'PosNext');
  8931.  
  8932.     For F := 1 to 100 do
  8933.       begin
  8934.         Remove (S, PosNext (F, S), 1);
  8935.         Assert (Length (S) = 200 - F,           'Remove');
  8936.       end;
  8937.     For F := 99 downto 0 do
  8938.       begin
  8939.         Remove (S, PosNext (F xor 3 + 1, S), 1);
  8940.         Assert (Length (S) = F,                 'Remove');
  8941.       end;
  8942.  
  8943.     S := AsIntegerArray ([3, 1, 2, 5, 4]);
  8944.     Sort (S);
  8945.     Assert (S [0] = 1, 'Sort');
  8946.     Assert (S [1] = 2, 'Sort');
  8947.     Assert (S [2] = 3, 'Sort');
  8948.     Assert (S [3] = 4, 'Sort');
  8949.     Assert (S [4] = 5, 'Sort');
  8950.   End;
  8951.  
  8952. Procedure SelfTest;
  8953.   Begin
  8954.     Test_Misc;
  8955.     Test_BitFunctions;
  8956.     Test_IntegerArray;
  8957.   End;
  8958.  
  8959.  
  8960.  
  8961. end.
  8962.  
  8963.